X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=lib%2FCmdLine.pm;h=0e1002f9c1eccd3c74dbd679a5a9c2594ae054af;hb=fc0e2c7f3fce9e64608d0aa13399d62f24000784;hp=6920f0bde85a75faa309dd3312aff1a71b3fe96c;hpb=bdb1e0c845a6921e22d52fbff3404d5c1dfae520;p=clearscm.git diff --git a/lib/CmdLine.pm b/lib/CmdLine.pm index 6920f0b..0e1002f 100644 --- a/lib/CmdLine.pm +++ b/lib/CmdLine.pm @@ -93,19 +93,13 @@ use Display; use Utils; use Term::ReadLine; -use Term::ANSIColor qw(color); +use Term::ANSIColor qw (color); # Package globals my $_pos = 0; my $_haveGnu; -my $promptColor = color('bold yellow'); -my $inputColor = color('underline'); -my $resetColor = color('reset'); - -my (%_cmds, $_attribs); - -our $_cmdline; +my (%_cmds, $_cmdline, $_attribs); BEGIN { # See if we can load Term::ReadLine::Gnu @@ -120,16 +114,15 @@ BEGIN { } # BEGIN # Share %opts -our %opts = ( - color => 1, -); +our %opts; my %builtin_cmds = ( history => { - help => 'history [ ]', - description => 'Displays cmd history. You can specify where to and where to . -Default is to list only the last screen full lines of history -(as denoted by $LINES).' + help => 'history [[start] [end]]', + description => + "Displays cmd history. You can specify where to and where to \n" + . "Default is to list only the last screen full lines of history (as denoted\n" + . "by \$LINES).", }, help => { @@ -137,41 +130,52 @@ Default is to list only the last screen full lines of history description => 'Displays help.', }, + helpall => { + help => 'helpall', + description => 'Display all help, including builtin commands', + }, + savehist => { - help => 'savehist [ ]', - description => 'Saves a section of the history to a file. You can specify where to -and where to . Default is to save all of the history to -the specified file.', + help => 'savehist [file] [[start] [end]]', + description => + "Saves a section of the history to a file. You can specify where to \n" + . "and where to . Default is to save all of the history to the specified\n" + . "file.", }, get => { - help => 'get ', + help => 'get [var]', description => 'Gets a variable.', }, set => { - help => 'set =', - description => 'Sets a variable. Note that expression can be any valid expression.', + help => 'set [var]=[expression]', + description => + 'Sets a variable. Note that expression can be any valid expression.', }, vars => { help => 'vars', - description => 'Displays all known variables.', + description => + 'Displays all known variables.', }, source => { - help => 'source ', - description => 'Run commands from a file.', + help => 'source [file]', + description => + 'Run commands from a file.', }, color => { - help => 'color []', - description => 'Turn on|off color. With no options displays status of color.', + help => 'color [(on|off)]', + description => + 'Turn on|off color. With no options displays status of color.', }, trace => { - help => 'trace []', - description => 'Turn on|off tracing. With no options displays status of trace.', + help => 'trace [(on|off)]', + description => + 'Turn on|off tracing. With no options displays status of trace.', }, ); @@ -195,7 +199,7 @@ sub _cmdCompletion($$) { sub _complete($$$$) { my ($text, $line, $start, $end) = @_; - return $_cmdline->completion_matches ($text, \&CmdLine::_cmdCompletion); + return $_cmdline->completion_matches($text, \&CmdLine::_cmdCompletion); } # _complete sub _gethelp() { @@ -216,29 +220,32 @@ sub _gethelp() { $self->help($line); } else { $CmdLine::cmdline->help($line); - } # if + } # if $_cmdline->on_new_line; + + return; } # _gethelp -sub _interpolate ($) { +sub _interpolate($) { my ($self, $str) = @_; # Skip interpolation for the perl command (Note this is raid specific) - return $str if $str =~ /^\s*perl\s*/i; + return $str + if $str =~ /^\s*perl\s*/i; while ($str =~ /\$/) { if ($str =~ /\$(\w+)/) { my $varname = $1; - if ($self->{vars}{$varname}) { + if (defined $self->{vars}{$varname}) { if ($self->{vars}{$varname} =~ / /) { $str =~ s/\$$varname/\'$self->{vars}{$varname}\'/; } else { $str =~ s/\$$varname/$self->{vars}{$varname}/; } # if } else { - $str =~ s/\$$varname//; + $str =~ s/\$$varname//; } # if } # if } # while @@ -249,7 +256,7 @@ sub _interpolate ($) { sub _builtinCmds($) { my ($self, $line) = @_; - unless (defined $line) { + unless ($line) { display ''; return 'exit'; } # unless @@ -266,7 +273,7 @@ sub _builtinCmds($) { system $1; } # if - #$_cmdline->remove_history($_cmdline->where_history); + #$_cmdline->remove_history ($_cmdline->where_history); return; } # if @@ -275,9 +282,8 @@ sub _builtinCmds($) { $cmd = $1; } # if - return unless $cmd; - - my @parms; + return + unless $cmd; # Search for matches of partial commands my $foundCmd; @@ -307,7 +313,9 @@ sub _builtinCmds($) { } # if if ($builtin_cmds{$cmd}) { - if ($line =~ /^\s*help\s*(.*)/i) { + if ($line =~ /^\s*helpall\s*$/i) { + $self->help('', 1); + } elsif ($line =~ /^\s*help\s*(.*)/i) { if ($1 =~ /(.+)$/) { $self->help($1); } else { @@ -315,7 +323,7 @@ sub _builtinCmds($) { } # if } elsif ($line =~ /^\s*history\s*(.*)/i) { if ($1 =~ /(\d+)\s+(\d+)\s*$/) { - $self->history ('list', $1, $2); + $self->history('list', $1, $2); } elsif ($1 =~ /^\s*$/) { $self->history('list'); } else { @@ -350,18 +358,17 @@ sub _builtinCmds($) { $self->help('set'); } # if } elsif ($line =~ /^\s*source\s+(\S+)/i) { - $result = $self->source ($1); + $result = $self->source($1); } elsif ($line =~ /^\s*vars\s*/) { - $self->vars ($line); + $self->vars($line); } elsif ($line =~ /^\s*color\s*(.*)/i) { if ($1 =~ /(1|on)/i) { $opts{color} = 1; - delete $ENV{ANSI_COLORS_DISABLED} if $ENV{ANSI_COLORS_DISABLED}; - $self->set_prompt; + delete $ENV{ANSI_COLORS_DISABLED} + if $ENV{ANSI_COLORS_DISABLED}; } elsif ($1 =~ /(0|off)/i) { - $opts{color} = 0; - $ENV{ANSI_COLORS_DISABLED} = 1; - $self->set_prompt; + $opts{trace} = 0; + local $ENV{ANSI_COLORS_DISABLED} = 1; } elsif ($1 =~ /\s*$/) { if ($ENV{ANSI_COLORS_DISABLED}) { display 'Color is currently off'; @@ -393,9 +400,9 @@ sub _builtinCmds($) { return ($cmd, $line, $result); } # _builtinCmds -sub _interrupt () { +sub _interrupt() { # Announce that we have hit an interrupt - print color('yellow') . "\n" . color('reset'); + print color ('yellow') . "\n" . color ('reset'); # Free up all of the line state info $_cmdline->free_line_state; @@ -418,7 +425,7 @@ sub _displayMatches($$$) { # scalar" internal errors from perl) my @Matches; - push @Matches, $_ for (@$matches); + push @Matches, $_ for (@$matches); my $match = shift @Matches; @@ -443,7 +450,7 @@ sub _displayMatches($$$) { unshift @newMatches, $match; - $_cmdline->display_match_list(\@newMatches); + $_cmdline->display_match_list (\@newMatches); $_cmdline->on_new_line; $_cmdline->redisplay; @@ -508,14 +515,14 @@ Returns: =cut - my $self = bless { - histfile => $histfile, - }, $class; - my $me = get_me; $histfile ||= "$ENV{HOME}/.${me}_hist"; + my $self = bless { + histfile => $histfile, + }, $class; + error "Creating bogus .${me}_hist file!" if $me eq '-' or $me eq ''; @@ -527,7 +534,7 @@ Returns: } # unless # Instantiate a commandline - $_cmdline = Term::ReadLine->new($me); + $_cmdline = Term::ReadLine->new ($me); # Store the function pointer of what to call when sourcing a file or # evaluating an expression. @@ -539,18 +546,14 @@ Returns: } # if } # if - $self->{promptColor} = $promptColor; - $self->{inputColor} = $inputColor; - $self->{resetColor} = $resetColor; - # Default prompt is "$me:" - $self->set_prompt("$me:"); + $self->{prompt} = "$me:"; # Set commands $self->set_cmds(%cmds); # Set some ornamentation - $_cmdline->ornaments('e,,u') unless $Config{cppflags} =~ /win32/i; + $_cmdline->ornaments ('s,e,u,') unless $Config{cppflags} =~ /win32/i; # Read in history $self->set_histfile($histfile); @@ -575,7 +578,7 @@ Returns: if ($Config{cppflags} =~ /win32/i) { $opts{trace} = 0; - $ENV{ANSI_COLORS_DISABLED} = 1; + local $ENV{ANSI_COLORS_DISABLED} = 1; } # if return $self; @@ -624,9 +627,6 @@ Returns: $prompt =~ s/\\\#/$self->{cmdnbr}/g; - # Now color it if color is on - $prompt = "$self->{resetColor}$self->{promptColor}$prompt$self->{resetColor}$self->{inputColor}" if $self->{promptColor}; - use POSIX; # Term::ReadLine::Gnu restarts whatever system call it is using, such that @@ -647,19 +647,18 @@ Returns: $oldaction = POSIX::SigAction->new; # Set up our unsafe signal handler - POSIX::sigaction(&POSIX::SIGINT, $sigaction, $oldaction); + POSIX::sigaction (&POSIX::SIGINT, $sigaction, $oldaction); } # if - $line = $_cmdline->readline($prompt); - - display_nolf $resetColor; + $line = $_cmdline->readline ($prompt); # Restore the old signal handler if ($Config{cppflags} !~ /win32/i) { - POSIX::sigaction(&POSIX::SIGINT, $oldaction); + POSIX::sigaction (&POSIX::SIGINT, $oldaction); } # if - $line = $self->_interpolate($line) if $line; + $line = $self->_interpolate($line) + if $line; $self->{cmdnbr}++ unless $self->{sourcing}; @@ -668,14 +667,10 @@ Returns: $line = '' unless $cmd; } while ($cmd and $builtin_cmds{$cmd}); - if (wantarray) { - return ($line, $result); - } else { - return $result || $line; - } # if + return ($line, $result); } # get -sub set_cmds (%) { +sub set_cmds(%) { my ($self, %cmds) = @_; =pod @@ -723,7 +718,7 @@ Returns: return; } # set_cmds -sub set_prompt ($) { +sub set_prompt($) { my ($self, $prompt) = @_; =pod @@ -760,19 +755,11 @@ Returns: =cut - my $oldPrompt = $self->{prompt}; + my $return = $self->{prompt}; - $self->{prompt} = $prompt if $prompt; + $self->{prompt} = $prompt; - if ($opts{color}) { - $self->{promptColor} = $promptColor; - $self->{resetColor} = $resetColor; - } else { - undef $self->{promptColor}; - undef $self->{resetColor}; - } # if - - return $oldPrompt; + return $return; } # set_prompt sub set_histfile($) { @@ -820,11 +807,12 @@ Returns: $_cmdline->clear_history; # Now read histfile - $_cmdline->ReadHistory($histfile); + $_cmdline->ReadHistory ($histfile); } # if # Determine the number of lines in the history file - open my $hist, '<', $histfile; + open my $hist, '<', $histfile + or croak "Unable to open history file $histfile"; # Set cmdnbr for (<$hist>) {} @@ -881,8 +869,8 @@ Returns: return $returnEval; } # set_eval -sub help(;$) { - my ($self, $cmd) = @_; +sub help(;$$) { + my ($self, $cmd, $builtins) = @_; =pod @@ -925,6 +913,8 @@ Returns: my @help; + $builtins ||= 0; + $cmd ||= ''; $cmd =~ s/^\s+//; $cmd =~ s/\s+$//; @@ -938,15 +928,12 @@ Returns: if (/$searchStr/i) { $helpFound = 1; - my $cmdcolor = $builtin_cmds{$_} ? color('cyan') : color ('magenta'); - my $boldOn = $builtin_cmds{$_} ? color('white on_cyan') : color ('white on_magenta'); - my $boldOff = color('reset') . $cmdcolor; + my $cmdcolor = $builtin_cmds{$_} ? color('cyan') : color('magenta'); - $cmd = "$cmdcolor$_"; - $cmd =~ s/($searchStr)/$boldOn$1$boldOff/g; - $cmd .= " $_cmds{$_}{parms}" if $_cmds{$_}{parms}; - $cmd .= color ('reset'); - $cmd .= " - $_cmds{$_}{help}" if $_cmds{$_}{help}; + $cmd = "$cmdcolor$_"; + $cmd .= " $_cmds{$_}{parms}" if $_cmds{$_}{parms}; + $cmd .= color('reset'); + $cmd .= " - $_cmds{$_}{help}" if $_cmds{$_}{help}; push @help, $cmd; @@ -964,6 +951,8 @@ Returns: } # if } else { for (sort keys %_cmds) { + next if $builtin_cmds{$_} and not $builtins; + my $cmdcolor = $builtin_cmds{$_} ? color ('cyan') : color ('magenta'); my $cmd = "$cmdcolor$_"; @@ -1048,12 +1037,12 @@ Returns: $start = $_[3]; $end = $_[4]; } elsif ($action eq 'redo') { - $_cmdline->remove_history($_cmdline->where_history); + $_cmdline->remove_history ($_cmdline->where_history); my $nbr = $_[2]; - my $line = $_cmdline->history_get($nbr); + my $line = $_cmdline->history_get ($nbr); - $_cmdline->add_history($line); + $_cmdline->add_history ($line); display $line; my ($cmd, $result) = $self->_builtinCmds($line); @@ -1136,7 +1125,7 @@ sub _get($$) { =pod -=head2 _get($name) +=head2 _get ($name) This method gets a variable to a value stored in the CmdLine object. @@ -1216,15 +1205,14 @@ Returns: my $returnValue = $self->{vars}{$name}; - if ($value) { + if (defined $value) { $value = $self->_interpolate($value); # Do not call eval if we are setting result - otherwise we recurse # infinitely. unless ($name eq 'result') { no strict; - $value = $self->{eval}($value) - if $self->{eval}; + $value = $self->{eval}($value) if $self->{eval}; use strict; } # unless @@ -1241,7 +1229,7 @@ sub vars($) { =pod -=head2 vars($name) +=head2 vars ($name) This method will print out all known variables @@ -1277,6 +1265,8 @@ Returns: for (keys %{$self->{vars}}); $self->handleOutput($cmd, @output); + + return; } # vars sub handleOutput($@) { @@ -1346,14 +1336,17 @@ Returns: local $SIG{PIPE} = 'IGNORE'; - open $pipe, '|', $pipeToCmd or undef $pipe; + open $pipe, '|', $pipeToCmd + or undef $pipe; # TODO: Not handling the output here. Need open2 and then recursively call # handleOutput. if ($pipe) { - print $pipe "$_\n" for (@output); + print $pipe "$_\n" + for (@output); - close $pipe or error "Unable to close pipe for $pipeToCmd - $!"; + close $pipe + or error "Unable to close pipe for $pipeToCmd - $!"; } else { error "Unable to open pipe for $pipeToCmd - $!"; } # if @@ -1364,7 +1357,8 @@ Returns: open my $output, '>', $outToFile; if ($output) { - print $output "$_\n" for (@output); + print $output "$_\n" + for (@output); close $output; @@ -1453,7 +1447,7 @@ Returns: $_ = $self->_interpolate ($_); # Check to see if it's a builtin - my ($cmd, $line, $result) = $self->_builtinCmds($_); + my ($cmd, $line, $result) = $self->_builtinCmds ($_); next if $builtin_cmds{$cmd};