Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Psh / Builtins / Theme.pm

package Psh::Builtins::Theme;

require Psh::OS;
require Psh::Util;
require Psh::Parser;

=item * C<theme list>

Displays a list of available themes.

=item * C<theme NAME>

Activates the theme.

If your themes look strange try C<option encoding=iso8859-1> - this
will switch to an alternative usage of graphical characters.

=cut

sub _parse_error {
       my $file= shift;
       my $line= shift;
       Psh::Util::print_error("Error parsing themefile $file.\n");
       Psh::Util::print_error("Do not understand: $line\n") if $line;
       return (0,undef);
}

sub _set_theme {
       my $file= shift;
       my @lines;
       if ($file=~/\.bt$/) {
               eval {
                       require Archive::Tar;
               };
               if ($@) {
                       Psh::Util::print_error("Please install Archive::Tar to handle .bt files!\n");
                       return (0,undef);
               }
               my $tar= Archive::Tar->new();
               $tar->read($file,1);
               @lines= split /\n/, $tar->get_content('theme');
       } else {
               open(THEME,"< $file");
               @lines= <THEME>;
               close(THEME);
       }
       if (!@lines) {
               Psh::Util::print_error("Could not find theme '$file'.\n");
               return (0,undef);
       }
       if ($lines[0]=~/^\#\!.*psh/) { # psh-script
               Psh::process_variable(join("\n",@lines));
               return (1,undef);
       } else { # try to parse it as a simple bashish theme
               my @ps;
               my $title='\w';
               my $bashish_compat=0;
               foreach my $line (@lines) {
                       next if substr($line,0,1) eq '#';
                       if ($line=~/^\s*needmod\s+themecompat\s*$/) {
                               $bashish_compat=1;
                       } elsif ($line=~/^\s*PS(\d)\s*\=\s*(.*)$/) {
                               my ($num,$text)= ($1,$2);
                               if ($num>0 and $num<5) {
                                       $ps[$num]= Psh::Parser::unquote($text);
                               } else {
                                       return _parse_error($file);
                               }
                       } elsif ($line=~/^\s*PROMPT\s*\=\s*(.*)$/) {
                               $ps[1]= Psh::Parser::unquote($1);
                       } elsif ($line=~/^\s*TITLE\s*\=\s*(.*)$/) {
                               $title= Psh::Parser::unquote($1);
                       } elsif ($line=~/^\s*X\w+\=/ or
                                        $line=~/^\s*needmod\s+/ or
                                        $line=~/^\s*THEME_.*\=/ or
                                        $line=~/^\s*SUPERPROMPT/ or
                                        $line=~/^\s*CURCOLOR/ or
                                        $line=~/^\s*$/) {
                               # ignore
                       } else {
                               return _parse_error($file,$line);
                       }
               }
               if ($bashish_compat) {
                       for (my $i=1; $i<=4; $i++) {
                               next unless defined $ps[$i];
                               $ps[$i]=~s/\$n/\\n/g; $ps[$i]=~s/\$t/\\t/g;
                               $ps[$i]=~s/\$w/\\w/g; $ps[$i]=~s/\$W/\\W/g;
                               $ps[$i]=~s/\$u/\\u/g; $ps[$i]=~s/\$c/\\!/g;
                               $ps[$i]=~s/\$b/\\\$/g; $ps[$i]=~s/\$s/\\s/g;
                               $ps[$i]=~s/\$h/\\h/g; $ps[$i]=~s/\$i/\\#/g;
                               $ps[$i]=~s/\$d/\\d/g; $ps[$i]=~s/\$x/%/g;
                               $ps[$i]=~s/\$e/\!/g;  $ps[$i]=~s/\$m/\$/g;
                               $ps[$i]=~s/\$z/\\\$/g;
                       }
               }
               Psh::Options::set_option('window_title',$title) if defined $title;
               for (my $i=1; $i<=4; $i++) {
                       next unless defined $ps[$i];
                       Psh::Options::set_option("ps$i",$ps[$i]);
               }
               Psh::Options::del_option('ps3') unless defined $ps[3];
               Psh::Options::del_option('ps4') unless defined $ps[4];
               Psh::Options::del_option('promp_command');
               return (1,undef);
       }
}

sub bi_theme {
       my $line= shift;
       my @dirs= (Psh::OS::catdir(Psh::OS::rootdir(),'usr','share',
                                                                 'psh','themes'),
                          Psh::OS::catdir(Psh::OS::rootdir(),'usr','local','share',
                                                                 'psh','themes'),
                          Psh::OS::catdir(Psh::OS::get_home_dir(),'.psh','share','themes'),
                          Psh::OS::catdir(Psh::OS::rootdir(),'psh','themes'));
       if ($line eq 'list') {
               my @result=();
               foreach my $dir (@dirs) {
                       next unless -r $dir;
                       my @tmp= Psh::OS::glob('*',$dir,1);
                       foreach my $file (@tmp) {
                               my $full= Psh::OS::catfile($dir,$file);
                               next if !-r $full or -d _;
                               next if $file =~ /\~$/;
                               $file=~ s/\.bt$//;
                               push @result, $file;
                       }
               }
               @result= sort @result;
               Psh::Util::print_list(@result);
               return (1,undef);
       } else {
               if ($line) {
                       if ($line=~/$Psh::OS::FILE_SEPARATOR/) { # abs path specified
                               my $tmp= Psh::Util::abs_path($line);
                               return _set_theme($tmp) if $tmp;
                       } else {
                               foreach my $dir (@dirs) {
                                       next unless -r $dir;
                                       my $file= Psh::OS::catfile($dir,$line);
                                       if (-r "$file.bt") {
                                               return _set_theme("$file.bt");
                                       } elsif (-r $file) {
                                               return _set_theme($file);
                                       }
                               }
                       }
                       Psh::Util::print_error("Could not find theme '$line'.\n");
               }
       }
       return (0,undef);
}

{

       sub get_color {
               my $name= shift;
               return $color_table{$name};
       }
}

1;