home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / ViCommand.pm < prev    next >
Text File  |  2005-04-27  |  27KB  |  1,169 lines
  1. package Term::ReadLine::Zoid::ViCommand;
  2.  
  3. use strict;
  4. use vars '$AUTOLOAD';
  5. no strict 'refs';
  6. use AutoLoader;
  7. use base 'Term::ReadLine::Zoid';
  8. no warnings; # undef == '' down here
  9.  
  10. our $VERSION = 0.05;
  11.  
  12. sub AUTOLOAD { # more intelligent inheritance
  13.     my $sub = $AUTOLOAD;
  14.     $sub =~ s/.*:://;
  15.     my $m = $_[0]->can($sub) ? 'AutoLoader' : 'Term::ReadLine::Zoid';
  16.     ${$m.'::AUTOLOAD'} = $AUTOLOAD;
  17.     goto &{$m.'::AUTOLOAD'};
  18. }
  19.  
  20. =head1 NAME
  21.  
  22. Term::ReadLine::Zoid::ViCommand - a readline command mode
  23.  
  24. =head1 SYNOPSIS
  25.  
  26. This class is used as a mode under L<Term::ReadLine::Zoid>,
  27. see there for usage details.
  28.  
  29. =head1 DESCRIPTION
  30.  
  31. This mode provides a "vi command mode" as specified by the posix spec for the sh(1)
  32. utility. It intends to include at least all key-bindings
  33. mentioned by the posix spec for the vi mode in sh(1).
  34. It also contains some extensions borrowed from vim(1) and some private extensions.
  35.  
  36. This mode has a "kill buffer" that stores the last killed text so it can
  37. be yanked again. This buffer has only one value, it isn't a "kill ring".
  38.  
  39. =head1 KEY MAPPING
  40.  
  41. Since ViCommand inherits from MultiLine, which in turn inherits 
  42. from Term::ReadLine::Zoid, key bindings are also inherited unless explicitly overloaded.
  43.  
  44. Control-d is ignored in this mode.
  45.  
  46. =over 4
  47.  
  48. =cut
  49.  
  50. our %_keymap = (
  51.     return  => 'accept_line',
  52.     ctrl_D    => 'bell',
  53.     ctrl_Z    => 'sigtstp',
  54.     backspace => 'backward_char',
  55.     escape    => 'vi_reset',
  56.     ctrl_A    => 'vi_increment',
  57.     ctrl_X    => 'vi_increment',
  58.     _on_switch => 'vi_switch',
  59.     _isa    => 'multiline', # but wait .. self_insert is overloaded
  60. );
  61.  
  62. sub keymap { return \%_keymap }
  63.  
  64. sub vi_switch {
  65.     my $self = shift;
  66.     return $$self{_loop} = undef if $$self{_vi_mini_b};
  67.     $$self{vi_command}   = '';
  68.     $$self{vi_history} ||= [];
  69.     $self->backward_char unless $_[1] or $$self{pos}[0] == 0;
  70. }
  71.  
  72. our @vi_motions = (' ', ',', qw/0 b F l W ^ $ ; E f T w | B e h t/);
  73. our %vi_subs = (
  74.     '#'  => 'vi_comment',        '='  => 'vi_complete',
  75.     '\\' => 'vi_complete',        '*'  => 'vi_complete',
  76.     '@'  => 'vi_macro',        '~'  => 'vi_case',
  77.     '.'  => 'vi_repeat',        ' '  => 'forward_char',
  78.     '^'  => 'vi_home',        '$'  => 'end_of_line',
  79.     '0'  => 'beginning_of_line',    '|'  => 'vi_cursor',
  80.     ';'  => 'vi_c_repeat',        ','  => 'vi_c_repeat',
  81.     '_'  => 'vi_topic',        '-'  => 'vi_K',
  82.     '+'  => 'vi_J',
  83.     
  84.     'l'  => 'forward_char',        'h' => 'backward_char',
  85.     't'  => 'vi_F',            'T' => 'vi_F',
  86. );
  87. our %vi_commands = (
  88.     '/' => 'bsearch',
  89.     '?' => 'fsearch',
  90.     '!' => 'shell',
  91.     'q' => 'quit',
  92. );
  93.  
  94. sub self_insert {
  95.     my ($self, $key) = @_;
  96.  
  97.     if (length($key) > 1) { # no vague chars
  98.         $self->bell;
  99.         $$self{vi_command} = '';
  100.     }
  101.     else { $$self{vi_command} .= $key }
  102.  
  103.     if ($$self{vi_command} =~ /^[\/\?\:]/) {
  104.         $self->vi_mini_buffer($key)
  105.     }
  106.     elsif ($$self{vi_command} =~ /^0|^(\d*)(\D)/) { # this is where a command gets executed
  107.         my ($cnt, $cmd) = ($1||1, $2||'0');
  108.         my $sub = $vi_subs{$cmd} || 'vi_'.uc($cmd);
  109.         #print STDERR "string: $$self{vi_command} cnt: $cnt sub: $sub\n";
  110.         my $r;
  111.         if ($self->can($sub)) {
  112.             my $s = $self->save();
  113.             $r = $self->$sub($cmd, $cnt); # key, count
  114.             push @{$$self{undostack}}, $s unless lc($cmd) eq 'u'
  115.                 or join("\n", @{$$s{lines}}) eq join("\n", @{$$self{lines}});
  116.         }
  117.         else { $self->bell() }
  118.         $$self{vi_last_cmd} = $$self{vi_command}
  119.             if $$self{vi_command} && ! grep( {$_ eq $cmd} @vi_motions, '.'); # for repeat ('.')
  120.         $$self{vi_command} = '';
  121.         #print STDERR "return: $r vi_last_cmd: $$self{vi_last_cmd}\n";
  122.         return $r;
  123.     }
  124.     else {
  125.         return if $$self{vi_command} =~ /^\d+$/;
  126.         #print STDERR "string: $$self{vi_command} rejected\n";
  127.         $self->bell;
  128.         $$self{vi_command} = '';
  129.     }
  130.     return 0;
  131. }
  132.  
  133. # ############ #
  134. # Key bindings #
  135. # ############ #
  136.  
  137. # Subs get args ($self, $key, $count)
  138.  
  139. sub vi_reset { $_[0]{vi_command} = ''; return 0 }
  140.  
  141. sub sigtstp { kill 20, $$ } # SIGTSTP
  142.  
  143. =item escape
  144.  
  145. Reset the command mode.
  146.  
  147. =item return
  148.  
  149. =item ^J
  150.  
  151. Return the current edit line to the application for execution.
  152.  
  153. =item ^Z
  154.  
  155. Send a SIGSTOP to the process of the application. Might not work when the application
  156. ignores those, which is something shells tend to do.
  157.  
  158. =item i
  159.  
  160. Switch back to insert mode.
  161.  
  162. =item I
  163.  
  164. Switch back to insert mode at the begin of the edit line.
  165.  
  166. =item a
  167.  
  168. Enter insert mode after the current cursor position.
  169.  
  170. =item A
  171.  
  172. Enter insert mode at the end of the edit line.
  173.  
  174. =cut
  175.  
  176. sub vi_I {
  177.     $_[0]{pos}[0] = 0 if $_[1] eq 'I';
  178.     $_[0]->switch_mode();
  179. }
  180.  
  181. sub vi_A {
  182.     ($_[1] eq 'A') ? $_[0]->end_of_line : $_[0]->forward_char ;
  183.     $_[0]->switch_mode();
  184. }
  185.  
  186. =item m
  187.  
  188. Switch to multiline insert mode, see L<Term::ReadLine::Zoid::MultiLine>.
  189. (private extension)
  190.  
  191. =item M
  192.  
  193. Switch to multiline insert mode at the end of the edit buffer.
  194. (private extension)
  195.  
  196. =cut
  197.  
  198. sub vi_M {
  199.     if ($_[1] eq 'M') {
  200.         $_[0]{pos}[1] = $#{$_[0]{lines}};
  201.         $_[0]->end_of_line;
  202.     }
  203.     else { $_[0]->forward_char }
  204.     $_[0]->switch_mode('multiline')
  205. }
  206.  
  207. =item R
  208.  
  209. Enter insert mode with replace toggled on.
  210. (vim extension)
  211.  
  212. =cut
  213.  
  214. sub vi_R {
  215.     my $self = shift;
  216.     return $self->vi_r(@_) if $_[0] eq 'r';
  217.     $self->switch_mode();
  218.     $$self{replace} = 1;
  219. }
  220.  
  221. ## more bindings are defined in __END__ section for autosplit ##
  222.  
  223. __END__
  224.  
  225. ## Two helper subs ##
  226.  
  227. sub _get_chr { # get extra argument
  228.     my $self = shift;
  229.     my $chr =  $self->key_name( $self->read_key );
  230.     return $self->vi_reset if $chr eq 'escape';
  231.     return undef if length $chr > 1;
  232.     #print STDERR "got argument chr: $chr\n";
  233.     $$self{vi_command} .= $chr;
  234.     return $chr;
  235. }
  236.  
  237. sub _do_motion { # get and do a motion
  238.     my ($self, $ignore, $cnt) = @_;
  239.     my $key =  $self->key_name( $self->read_key );
  240.     return $self->vi_reset if $key eq 'escape';
  241.     return $self->bell
  242.         unless grep {$_ eq $key} @vi_motions, $ignore, qw/left right up down home end/;
  243.     my $vi_cmd = $$self{vi_command};
  244.     #print STDERR "got argument motion: $key\n";
  245.     my $re = 1;
  246.     unless ($key eq $ignore) {
  247.         my $pos = [@{$$self{pos}}]; # force copy
  248.         $$self{vi_command} = (grep {$_ eq $key} qw/0 ^ $/) ? '' : $cnt ;
  249.         $re = $self->do_key($key, $cnt);
  250.         $$self{pos} = $pos unless $re; # reset pos if unsuccessfull
  251.         $$self{pos}[0]++  if lc($key) eq 'e'
  252.             and $$self{pos}[0] < length $$self{lines}[ $$self{pos}[1] ];
  253.             # always one exception :S
  254.     }
  255.     $$self{vi_command} = $vi_cmd . $key;
  256.     return $re;
  257. }
  258.  
  259. =item #
  260.  
  261. Makes current edit line a comment that will be listed in the history,
  262. but won't be executed.
  263.  
  264. Only works if the 'comment_begin' option is set.
  265.  
  266. =cut
  267.  
  268. sub vi_comment {
  269.     $_[0]{lines}[ $_[0]{pos}[1] ] = $_[0]{config}{comment_begin}
  270.         . ' ' . $_[0]{lines}[ $_[0]{pos}[1] ];
  271.     $_[0]{poss}[0] += 2 unless $_[0]{poss}[1];
  272. }
  273.  
  274. =item =
  275.  
  276. Display possible shell word completions, does not modify the edit line.
  277.  
  278. =item \
  279.  
  280. Do pathname completion (using File::Glob) and insert the largest matching
  281. part in the edit line.
  282.  
  283. =item *
  284.  
  285. Do pathname completion but inserts B<all> matches.
  286.  
  287. =cut
  288.  
  289. sub vi_complete {
  290.     my ($self, $key) = @_;
  291.  
  292.     return $self->possible_completions() if $key eq '=';
  293.  
  294.     my $buffer = join "\n", @{$$self{lines}};
  295.     my $begin = substr $buffer, 0, $self->pos2off($$self{pos}), '';
  296.     $begin =~ s/(\S*)$//;
  297.     my $glob = $1;
  298.     $$self{pos}[0] -= length $1;
  299.  
  300.     use File::Glob ':glob';
  301.     $glob .= '*' unless $glob =~ /[\*\?\[]/;
  302.     my @list = bsd_glob($glob, GLOB_TILDE | GLOB_BRACE);
  303.  
  304.     my $string;
  305.     if ($key eq '\\') {
  306.         @list = $self->longest_match(@list);
  307.         $string = shift(@list);
  308.         $self->output(@list);
  309.     }
  310.     elsif ($key eq '*') { $string = join ' ', @list }
  311.  
  312.     $$self{pos}[0] += length $string;
  313.     @{$$self{lines}} = split /\n/, $begin . $string . $buffer;
  314.     
  315.     $self->switch_mode() if $key eq '*';
  316. }
  317.  
  318. =item [I<count>] @ I<char>
  319.  
  320. Regard the contents of the alias _char as a macro with editing commands.
  321. This seems a rather obfuscated feature of the posix spec to me. See also below
  322. for the L<alias> command.
  323.  
  324. Note that the I<count> argument is not posix compliant, but it seems silly not
  325. to use it.
  326.  
  327. =cut
  328.  
  329. sub vi_macro {
  330.     my ($self, undef, $cnt) = @_;
  331.     my $n = $self->_get_chr;
  332.     #print STDERR "macro arg was: $n\n";
  333.     return $self->bell unless $n =~ /^\w$/;
  334.     return unless exists $$self{config}{aliases}{'_'.$n};
  335.     my $macro = $$self{config}{aliases}{"_$n"};
  336.     for (1..$cnt) {
  337.         $self->switch_mode();
  338.         $self->press($macro);
  339.     }
  340. }
  341.  
  342. =item [I<count>] ~
  343.  
  344. Reverse case for I<count> characters.
  345.  
  346. =cut
  347.  
  348. sub vi_case { # reverse case
  349.     my ($self, undef, $cnt) = @_;
  350.     my $str = substr $$self{lines}[ $$self{pos}[1] ], $$self{pos}[0], $cnt, '';
  351.     $str =~ s/(([[:lower:]]+)|[[:upper:]]+)/$2 ? uc($1) : lc($1)/eg;
  352.     substr $$self{lines}[ $$self{pos}[1] ], $$self{pos}[0], 0, $str;
  353.     $$self{pos}[0] += length $str;
  354. }
  355.  
  356. =item [I<count>] .
  357.  
  358. Repeat the last non-motion command.
  359. If no count is specified the original count of the command is used.
  360.  
  361. =cut
  362.  
  363. sub vi_repeat {
  364.     my ($self, undef, $cnt) = @_;
  365.     undef $cnt if $$self{vi_command} !~ /^$cnt/;
  366.     return $self->bell if ! length $$self{vi_last_cmd};
  367.     #print STDERR "repeat last command: $$self{vi_last_cmd}\n";
  368.     $$self{vi_last_cmd} =~ /^(\d*)(.)(.*)/;
  369.     die "BUG: we ain't gonna loop all day !" if $2 eq '.';
  370.     $$self{vi_command} = defined $cnt ? $cnt : $1 || '';
  371.     $self->unread_key($3);
  372.     $self->self_insert($2);
  373. }
  374.  
  375. =item v
  376.  
  377. Edit the buffer with the editor specified by the C<EDITOR> environment variable
  378. or the L<editor> option, defaults to 'vi'.
  379.  
  380. This function requires the L<File::Temp> module from cpan, which in turn needs 
  381. File::Spec and other packages. If these are not available this functions is
  382. disabled.
  383.  
  384. =cut
  385.  
  386. sub vi_V { 
  387.     my $self = shift;
  388.     my $string = $$self{config}{editor} || $ENV{EDITOR} || 'vi %';
  389.     $string .= ' %' unless $string =~ /\%/;
  390.     $self->shell($string);
  391. }
  392.  
  393. =item [I<count>] l 
  394.  
  395. =item [I<count>] I<space>
  396.  
  397. Move the cursor to the right.
  398.  
  399. =item [I<count>] h 
  400.  
  401. Move the cursor to the left.
  402.  
  403. =cut
  404.  
  405. ## vi_L and vi_H are implemented by parent left n right
  406.  
  407. =item [I<count>] w
  408.  
  409. =item [I<count>] W
  410.  
  411. Move the cursor to the begin of the next word or bigword.
  412.  
  413. (A bigword exists of non-whitespace chars, while a word
  414. exists of alphanumeric chars only.)
  415.  
  416. =cut
  417.  
  418. sub vi_W { # no error, just end of line
  419.     my ($self, $key, $cnt) = @_;
  420.     my $w = ($key eq 'W') ? '\\S' : '\\w';
  421.     my $l = $$self{lines}[ $$self{pos}[1] ];
  422.     for (1..$cnt) {
  423.         if ($l =~ /^.{$$self{pos}[0]}(.+?)(?<!$w)$w/) { $$self{pos}[0] += length $1 }
  424.         else {
  425.             $self->end_of_line;
  426.             last;
  427.         }
  428.     }
  429.     return 1;
  430. }
  431.  
  432. =item [I<count>] e 
  433.  
  434. =item [I<count>] E 
  435.  
  436. Move the cursor to the end of the current word or bigword.
  437.  
  438. =cut
  439.  
  440. sub vi_E { # no error, just end of line
  441.     my ($self, $key, $cnt) = @_;
  442.     my $w = ($key eq 'E') ? '\\S' : '\\w';
  443.     my $l = $$self{lines}[ $$self{pos}[1] ];
  444.     for (1..$cnt) {
  445.         if ($l =~ /^.{$$self{pos}[0]}($w?.*?$w+)/) { $$self{pos}[0] += length($1) - 1 }
  446.         else {
  447.             $self->end_of_line;
  448.             last;
  449.         }
  450.     }
  451.     return 1;
  452. }
  453.  
  454. =item [I<count>] b 
  455.  
  456. =item [I<count>] B 
  457.  
  458. Move the cursor to the begin of the current word or bigword.
  459.  
  460. =cut
  461.  
  462. sub vi_B { # no error, just begin of line
  463.     my ($self, $key, $cnt) = @_;
  464.     my $w = ($key eq 'B') ? '\\S' : '\\w';
  465.     my $l = $$self{lines}[ $$self{pos}[1] ];
  466.     for (1..$cnt) {
  467.         $l = substr($l, 0, $$self{pos}[0]);
  468.         if ($l =~ /($w+[^$w]*)$/) { $$self{pos}[0] -= length $1 }
  469.         else {
  470.             $self->beginning_of_line;
  471.             last;
  472.         }
  473.     }
  474.     return 1;
  475. }
  476.  
  477. =item ^
  478.  
  479. Move the cursor to the first non-whitespace on the edit line.
  480.  
  481. =item $
  482.  
  483. Move the cursor to the end of the edit line.
  484.  
  485. =item 0
  486.  
  487. Move the cursor to the begin of the edit line.
  488.  
  489. =cut
  490.  
  491. sub vi_home {
  492.     my $self = shift;
  493.     $$self{lines}[ $$self{pos}[1] ] =~ /^(\s*)/;
  494.     $$self{pos}[0] = length $1;
  495.     return 1;
  496. }
  497.  
  498. =item [I<count>] |
  499.  
  500. Set the cursor to position I<count> (1-based).
  501.  
  502. =cut
  503.  
  504. sub vi_cursor { $_[0]{pos}[0] = $_[2] - 1; 1; }
  505.  
  506. =item [I<count>] f I<char>
  507.  
  508. Set cursor to I<count>'th occurrence of I<char> to the right.
  509. The cursor is placed on I<char>.
  510.  
  511. =item [I<count>] F I<char>
  512.  
  513. Set cursor to I<count>'th occurrence of I<char> to the left.
  514. The cursor is placed on I<char>.
  515.  
  516. =item [I<count>] t I<char>
  517.  
  518. Set cursor to I<count>'th occurrence of I<char> to the right.
  519. The cursor is placed before I<char>.
  520.  
  521. =item [I<count>] T I<char>
  522.  
  523. Set cursor to I<count>'th occurrence of I<char> to the left.
  524. The cursor is placed after I<char>.
  525.  
  526. =cut
  527.  
  528. sub vi_F {
  529.     my ($self, $key, $cnt, $chr) = @_;
  530.  
  531.     unless ($chr) {
  532.         $chr = $self->_get_chr();
  533.         return $self->bell if length $chr > 1;
  534.         $$self{vi_last_c_move} = [$key, $chr];
  535.     }
  536.  
  537.     my ($l, $x) = ( $$self{lines}[ $$self{pos}[1] ], $$self{pos}[0] );
  538.     if ($key eq 'T' or $key eq 'F') {
  539.         $l = substr($l, 0, $x);
  540.         return $self->bell unless $l =~ /.*((?:$chr.*){$cnt})$/;
  541.         $$self{pos}[0] -= length($1) - (($key eq 'T') ? 1 : 0);
  542.         return length($1);
  543.     }
  544.     else { # ($key eq 't' || $key eq 'f')
  545.         return $self->bell unless $l =~ /^..{$x}((?:.*?$chr){$cnt})/;
  546.         $$self{pos}[0] += length($1) - (($key eq 't') ? 1 : 0);
  547.         return length($1);
  548.     }
  549. }
  550.  
  551. ## vi_T is aliased to vi_F in %vi_subs 
  552.  
  553. =item [I<count>] ;
  554.  
  555. Repeat the last 'f', 'F', 't', or 'T' command. Count of last command is ignored.
  556.  
  557. =item [I<count>] ,
  558.  
  559. Like ';' but with direction reversed.
  560.  
  561. =cut
  562.  
  563. sub vi_c_repeat {
  564.     my ($self, $key, $cnt) = @_;
  565.     return $self->bell unless $$self{vi_last_c_move};
  566.     my ($ckey, $chr) = @{ $$self{vi_last_c_move} };
  567.     $ckey = ($ckey eq 't' or $ckey eq 'f') ? uc($ckey) : lc($ckey) if $key eq ',';
  568.     $self->vi_F($ckey, $cnt, $chr);
  569. }
  570.  
  571. =item [I<count>] c I<motion>
  572.  
  573. Delete characters between the current position and the position after the
  574. I<motion>, I<count> applies to I<motion>. 
  575. After the deletion enter insert mode.
  576.  
  577. The "motion" 'c' deletes the current edit line.
  578.  
  579. =item C
  580.  
  581. Delete from cursor to end of line and enter insert mode.
  582.  
  583. =cut
  584.  
  585. sub vi_C { # like vi_D but without killbuf and with insert mode
  586.     my ($self, $key, $cnt) = @_;
  587.     my $pos = [ @{$$self{pos}} ]; # force copy
  588.     if ($key eq 'C') { $self->end_of_line }
  589.     else { return unless $self->_do_motion('c', $cnt) }
  590.     if ($$self{vi_command} =~ /cc$/) { splice(@{$$self{lines}}, $$self{pos}[1], 1) }
  591.     else { $self->substring('', $pos, $$self{pos}) }
  592.     $self->switch_mode();
  593. }
  594.  
  595. =item S
  596.  
  597. Delete current line and enter insert mode.
  598.  
  599. =cut
  600.  
  601. sub vi_S { 
  602.     my $self = shift;
  603.     $$self{lines}[ $$self{pos}[1] ] = '';
  604.     $self->{pos}[0] = 0;
  605.     $self->switch_mode();
  606. }
  607.  
  608. =item [I<count>] r I<char>
  609.  
  610. Replace the character under the cursor (and the I<count>
  611. characters next to it) with I<char>.
  612.  
  613. =cut
  614.  
  615. sub vi_r { # this sub is an exception in the naming scheme
  616.     my ($self, undef, $cnt) = @_;
  617.     my $chr = $self->_get_chr();
  618.     substr $$self{lines}[ $$self{pos}[1] ], $$self{pos}[0], $cnt, $chr x $cnt;
  619.     $$self{pos}[0] += $cnt - 1;
  620. }
  621.  
  622. =item [I<count>] _
  623.  
  624. Insert a white space followed by the last (or I<count>'th) bigword
  625. from the previous history entry ans enter insert mode.
  626.  
  627. Quotes are not respected by this function.
  628.  
  629. =cut
  630.  
  631. sub vi_topic {
  632.     my ($self, undef, $cnt) = @_;
  633.     $cnt = ($cnt == 1 and $$self{vi_command} !~ /^1/) ? -1 : $cnt-1;
  634.     return $self->bell unless @{$$self{history}};
  635.     my $buffer = join "\n", $$self{history}[0];
  636.     $buffer =~ s/^\s+|\s+$//g;
  637.     my @words = split /\s+/, $buffer;
  638.     my $string = " $words[$cnt]";
  639.     $self->substring($string);
  640.     $$self{pos}[0] .= length $string;
  641.     $self->switch_mode();
  642. }
  643.  
  644. =item [I<count>] x
  645.  
  646. Delete I<count> characters and place them in the save buffer.
  647.  
  648. =item [I<count>] X
  649.  
  650. Delete I<count> characters before the cursor position
  651. and place them in the save buffer.
  652.  
  653. ('x' is like 'delete', 'X' like backspace)
  654.  
  655. =cut
  656.  
  657. sub vi_X {
  658.     my ($self, $key, $cnt) = @_;
  659.     if ($key eq 'X') {
  660.         return $self->bell if $$self{pos}[0] < $cnt;
  661.         $$self{pos}[0] -= $cnt;
  662.     }
  663.     $$self{killbuf} = substr $$self{lines}[ $$self{pos}[1] ], $$self{pos}[0], $cnt, '';
  664. }
  665.  
  666. =item [I<count>] d I<motion>
  667.  
  668. Delete from the current cursor position to the position resulting from I<count>
  669. times I<motion>. The deleted part will be placed in the save buffer.
  670.  
  671. The "motion" 'd' deletes the current line.
  672.  
  673. =item D
  674.  
  675. Delete from the cursor position until the end of the line and put the deleted
  676. part in the save buffer.
  677.  
  678. =cut
  679.  
  680. sub vi_D {
  681.     my ($self, $key, $cnt) = @_;
  682.     my $pos = [ @{$$self{pos}} ]; # force copy
  683.     if ($key eq 'D') { $self->end_of_line }
  684.     else { return unless $self->_do_motion('d', $cnt) }
  685.     if ($$self{vi_command} =~ /dd$/) {
  686.         $$self{killbuf} = splice(@{$$self{lines}}, $$self{pos}[1], 1)."\n";
  687.     }
  688.     else { $$self{killbuf} = $self->substring('', $pos, $$self{pos}) }
  689. }
  690.  
  691. =item [I<count>] y I<motion>
  692.  
  693. Yank (copy) characters from the current cursor position to the position resulting from I<count>
  694. times I<motion> to the save buffer.
  695.  
  696. the "motion" 'y' yanks the current line.
  697.  
  698. =item Y
  699.  
  700. Like y but from cursor till end of line.
  701.  
  702. =cut
  703.  
  704. sub vi_Y { # like vi_D but only copies, doesn't delete
  705.     my ($self, $key, $cnt) = @_;
  706.     my $pos = [ @{$$self{pos}} ]; # force copy
  707.     if ($key eq 'Y') { $self->end_of_line }
  708.     else { return unless $self->_do_motion('y', $cnt) }
  709.     if ($$self{vi_command} =~ /yy$/) {
  710.         $$self{killbuf} = $$self{lines}[ $$self{pos}[1] ]."\n";
  711.     }
  712.     else { $$self{killbuf} = $self->substring(undef, $pos, $$self{pos}) }
  713.     $$self{pos} = $pos; # reset pos
  714. }
  715.  
  716. =item [I<count>] p
  717.  
  718. Insert I<count> copies of the the save buffer after the cursor.
  719.  
  720. =item [I<count>] P
  721.  
  722. Insert I<count> copies of the the save buffer before the cursor.
  723.  
  724. =cut
  725.  
  726. sub vi_P {
  727.     my ($self, $key, $cnt) = @_;
  728.     return unless length $$self{killbuf};
  729.     $self->forward_char if $key eq 'p';
  730.     $self->substring($$self{killbuf} x $cnt);
  731. }
  732.  
  733. =item u
  734.  
  735. Undo the last command that changed the edit line.
  736.  
  737. =item U
  738.  
  739. Undo all changes.
  740.  
  741. TODO all changes since when ? since entering the command mode ?
  742.  
  743. =cut
  744.  
  745. sub vi_U {
  746.     my ($self, $key, $cnt) = @_;
  747.     return $self->bell() unless @{$$self{undostack}};
  748.     $self->restore(pop @{$$self{undostack}});
  749. }
  750.  
  751. =item [I<count>] k
  752.  
  753. =item [I<count>] -
  754.  
  755. Go I<count> lines backward in history.
  756.  
  757. =cut
  758.  
  759. sub vi_K {
  760.     $_[0]->previous_history || last for 1 .. $_[2];
  761.     $_[0]->beginning_of_line;
  762. }
  763.  
  764. =item [I<count>] j
  765.  
  766. =item [I<count>] +
  767.  
  768. Go I<count> lines forward in history.
  769.  
  770. =cut
  771.  
  772. sub vi_J {
  773.     $_[0]->next_history || last for 1 .. $_[2];
  774.     $_[0]->beginning_of_line;
  775. }
  776.  
  777. =item [I<number>] G
  778.  
  779. Go to history entry number I<number>, or to the first history entry.
  780.  
  781. =cut
  782.  
  783. sub vi_G {
  784.     return $_[0]->bell if $_[2] > @{$_[0]{history}};
  785.     $_[0]->set_history( @{$_[0]{history}} - $_[2] );
  786.     # we keep the history in the reversed direction
  787. }
  788.  
  789. =item n
  790.  
  791. Repeat the last history search by either the '/' or '?' minibuffers
  792. or the incremental search mode.
  793.  
  794. =item N
  795.  
  796. Repeat the last history search in the oposite direction.
  797.  
  798. =cut
  799.  
  800. sub vi_N { # last_search = [ dir, string, hist_p ]
  801.     my ($self, $key, undef, $dir) = @_; # dir == direction
  802.     return $self->bell unless $$self{last_search};
  803.     $dir ||= $$self{last_search}[0];
  804.     $dir =~ tr/bf/fb/ if $key eq 'N'; # reverse dir
  805.  
  806.     my $reg = eval { qr/$$self{last_search}[1]/ };
  807.     return $self->bell if $@;
  808.  
  809.     my ($succes, $hist_p) = (0, $$self{last_search}[2]);
  810.     #print STDERR "lookign from $hist_p for: $reg\n";
  811.     if ($dir eq 'b') {
  812.         while ($hist_p < $#{$$self{history}}) {
  813.             $hist_p++;
  814.             next unless $$self{history}[$hist_p] =~ $reg;
  815.             $succes++;
  816.             last;
  817.         }
  818.     }
  819.     else { # $dir eq 'f'
  820.         $hist_p = scalar @{$$self{history}} if $hist_p < 0;
  821.         while ($hist_p > 0) {
  822.             $hist_p--;
  823.             next unless $$self{history}[$hist_p] =~ $reg;
  824.             $succes++;
  825.             last;
  826.         }
  827.     }
  828.     #print STDERR "succes: $succes at: $hist_p\n";
  829.  
  830.     if ($succes) {
  831.         $self->set_history($hist_p);
  832.         $$self{last_search}[2] = $hist_p;
  833.         return 1;
  834.     }
  835.     else { return $self->bell }
  836. }
  837.  
  838. =item :
  839.  
  840. Opens a command mini buffer. This is a very minimalistic execution environment
  841. that can for instance be used to modify options if the application doesn't
  842. provide a method to do so. Also it is used for quick hacks ;)
  843.  
  844. The execution of this buffer happens entirely without returning to the application.
  845.  
  846. (This is a vim extension)
  847.  
  848. =cut
  849.  
  850. sub vi_mini_buffer { 
  851.     my ($self, $key) = @_;
  852.  
  853.     $self->switch_mode('insert');
  854.     my $save = $self->save();
  855.     @$self{qw/_vi_mini_b prompt lines pos/} = (1, $key, [''], [0,0]);
  856.     $self->loop();
  857.     my $str = join "\n", @{$$self{lines}};
  858.     @$self{qw/_vi_mini_b _loop/} = (undef, 1);
  859.     $self->restore($save);
  860.     $self->switch_mode('command', 'no_left');
  861.  
  862.     my $cmd = $key;
  863.     if ($key eq ':') {
  864.         $str =~ s/^([!\/?])|^\s*(\S+)(\s+|$)// or return $self->bell;
  865.         $cmd = $1 || $2;
  866.     }
  867.     $cmd = exists($vi_commands{$cmd}) ? $vi_commands{$cmd} : $cmd;
  868.     #print STDERR "mini buffer got cmd, string: $cmd, $str\n";
  869.     return $self->bell unless $self->can($cmd);
  870.     return $self->$cmd($str);
  871. }
  872.  
  873. =item /
  874.  
  875. Opens a mini buffer where you can type a pattern to search backward through
  876. the history.
  877.  
  878. The search patterns are not globs (as posix would have them), but
  879. are evaluated as perl regexes.
  880.  
  881. An empty pattern repeats the previous search.
  882.  
  883. =item ?
  884.  
  885. Like '/' but searches in the forward direction.
  886.  
  887. =cut
  888.  
  889. sub bsearch {
  890.     my ($self, $string) = @_;
  891.  
  892.     if (length $string) {
  893.         $$self{last_search} = ['b', $string, -1];
  894.         eval { qr/$string/ };
  895.         if ($@) {
  896.             $self->output($@);
  897.             return $self->bell;
  898.         }
  899.     }
  900.  
  901.     return $self->vi_N('n', undef, 'b');
  902. }
  903.  
  904. sub fsearch {
  905.     my ($self, $string) = @_;
  906.  
  907.     if (length $string) {
  908.         $$self{last_search} = ['f', $string, -1];
  909.         eval { qr/$string/ };
  910.         if ($@) {
  911.             $self->output($@);
  912.             return $self->bell;
  913.         }
  914.     }
  915.  
  916.     return $self->vi_N('n', undef, 'f');
  917. }
  918.  
  919. =item ^A
  920.  
  921. If cursor is on a number, increment it. (This is a vim extension)
  922.  
  923. FIXME bit buggy
  924.  
  925. =item ^X
  926.  
  927. If cursor is on a number, decrement it. (This is a vim extension)
  928.  
  929. FIXME bit buggy
  930.  
  931. =cut
  932.  
  933. sub vi_increment {
  934.     my ($self, $key) = @_;
  935.     my ($l, $x) = ( $$self{lines}[ $$self{pos}[1] ], $$self{pos}[0] );
  936.     my $add = ($key eq 'ctrl_A') ? 1 : -1;
  937.  
  938.     return $self->bell unless $l =~ /^(.{0,$x}?)(0x(?i:[a-f\d])+|\d+)(.*?)$/; # FIXME triple check this regexp
  939.     my ($pre, $int, $post) = ($1, $2, $3);
  940.  
  941.     $int = ($int =~ /^0x/) ? sprintf("0x%x", hex($int) + $add) : ($int + $add) ;
  942.  
  943.     $$self{lines}[ $$self{pos}[1] ] = $pre . $int . $post;
  944. }
  945.  
  946. # ######## #
  947. # Commands #
  948. # ######## #
  949.  
  950. =back
  951.  
  952. =head1 COMMANDS
  953.  
  954. These can be used from the ":" mini buffer. Some commands are borrowed from vim,
  955. but no guarantee what so ever.
  956.  
  957. =over 4
  958.  
  959. =item B<quit>
  960.  
  961. Return undef to the application (like '^D' in insert mode).
  962.  
  963. =item B<set> [I<+o>|I<-o>] [I<option>=I<value>]
  964.  
  965. Set a key-value pair in the options hash
  966. When the arg '+o' is given (or the option is preceded by 'no')
  967. the option is deleted.
  968.  
  969. Can be used to change the ReadLine behaviour independent from the application.
  970.  
  971. =cut
  972.  
  973. sub quit { $_[0]{_loop} = undef }
  974.  
  975. sub set {
  976.     my ($self, $string) = @_;
  977.     $string =~ s/^\-o\s+|(\+o\s+|no(?=\w))//;
  978.     my $switch_off = $1;
  979.     $string =~ s/^(\w+)(=|\s*$)// or return $self->bell;
  980.     my ($opt, $val) = ($1, ($2 eq '=') ? $string : 1);
  981.     $val =~ s/^['"]|["']$//g;
  982.     if ($switch_off) { delete $$self{config}{$opt} }
  983.     else { $$self{config}{$opt} = $val }
  984.     return 1;
  985. }
  986.  
  987. =item B<ascii>
  988.  
  989. Output ascii values for the char in the edit line on the cursor position.
  990.  
  991. =cut
  992.  
  993. sub ascii {
  994.     my $self = shift;
  995.     my $chr = shift || substr( $$self{lines}[ $$self{pos}[1] ], $$self{pos}[0], 1);
  996.     $chr =~ s/^\s*(\S).*/$1/;
  997.     my $ord = ord $chr;
  998.     $self->output( sprintf "<%s> %d, Hex %x, Octal 0%o\n", $chr, $ord, $ord, $ord );
  999.     # <">  34,  Hex 22,  Octal 042
  1000.     return 1;
  1001. }
  1002.  
  1003. =item B<testchr>
  1004.  
  1005. Wait for a character input and output ascii values for it.
  1006.  
  1007. =cut
  1008.  
  1009. sub testchr { # FIXME needs more magic for non printable chars
  1010.     my $self = shift;
  1011.     print { $self->{OUT} } "Press any key\n";
  1012.     my $chr = $self->_get_chr;
  1013.     my $ord = ord $chr;
  1014.     $$self{_buffer} -= 1;
  1015.     return 1;
  1016. }
  1017.  
  1018. =item B<bindchr> I<chr>=I<keyname>
  1019.  
  1020. Map a char (or char sequence) to a key name.
  1021.  
  1022. =cut
  1023.  
  1024. sub bindchr {
  1025.     my $self = shift;
  1026.     my @args = (@_ == 1) ? (split /=/, $_[0]) : (@_);
  1027.     $self->SUPER::bindchr(@args);
  1028. }
  1029.  
  1030. =item B<bindkey> I<chr>=sub { I<code> }
  1031.  
  1032. Map a char (or char sequence) to a key name.
  1033.  
  1034. =cut
  1035.  
  1036. sub bindkey {
  1037.     my $self = shift;
  1038.     $self->SUPER::bindkey(@_) if @_ == 2;
  1039.     my @arg = split /=/, $_[0], 2;
  1040.     $arg[1] = eval $arg[1];
  1041.     return warn $@."\n\n" if $@;
  1042.     $self->SUPER::bindkey(@arg);
  1043. }
  1044.  
  1045.  
  1046. =item B<!>, B<shell> I<shellcode>
  1047.  
  1048. Eval a system command.
  1049. The '%' character in this string will be replace with the name of a tmp file
  1050. containing the edit buffer.
  1051. After execution this tmp file will be read back into the edit buffer.
  1052. Of course you can use an backslash to escape a literal '%'.
  1053.  
  1054. Note that this tmp file feature only works if you have L<File::Temp> installed.
  1055.  
  1056. =cut
  1057.  
  1058. sub shell {
  1059.     my ($self, $string) = @_;
  1060.  
  1061.     my ($fh, $file);
  1062.     if ($string =~ /(?<!\\)%/) {
  1063.         eval 'require File::Temp' || return $self->bell;
  1064.         ($fh, $file) = File::Temp::tempfile('PERL_RL_Zoid_XXXXX', DIR => File::Spec->tmpdir);
  1065.         print $fh join "\n", @{$$self{lines}};
  1066.         close $fh;
  1067.         $string =~ s/(\\)\%|\%/$1 ? '%' : $file/ge;
  1068.     }
  1069.  
  1070.     #print STDERR "system: $string\n";
  1071.     print { $$self{OUT} } "\n";
  1072.     my $error = (exists $$self{config}{shell})
  1073.         ? $$self{config}{shell}->($string) : system( $string ) ;
  1074.  
  1075.     if ($error) { printf { $$self{OUT} } "\nshell returned %s\n\n", $error >> 8  }
  1076.     elsif ($file) {
  1077.         open TMP, $file or return $self->bell;
  1078.         @{$$self{lines}} = map {chomp; $_} (<TMP>);
  1079.         close TMP;
  1080.         $$self{pos} = [ length($$self{lines}[-1]), $#{$$self{lines}} ];
  1081.     }
  1082.     $$self{_buffer} = 0;
  1083.     unlink $file if $file;
  1084.  
  1085.     return 1;
  1086. }
  1087.  
  1088. =item B<eval> I<perlcode>
  1089.  
  1090. Eval some perlcode for the most evil instant hacks.
  1091. The ReadLine object can be called as C<$self>.
  1092.  
  1093. =cut
  1094.  
  1095. sub eval {
  1096.     my ($self, $_code) = @_;
  1097.     print { $$self{OUT} } "\n";
  1098.     my $_re = eval $_code;
  1099.     print { $$self{OUT} } ($@ ? $@ : "$_re\n");
  1100.     $$self{_buffer} = 0;
  1101.     return 1;
  1102. }
  1103.  
  1104. =item B<alias> I<char>=I<macro>
  1105.  
  1106. Define a macro in an alias with a one character name.
  1107. These can be executed with the '@' command.
  1108. Non alphanumeric keys like "\n" and "\e" can be inserted with the standard perl 
  1109. escape sequences. You need to use "\\" for a literal '\'.
  1110.  
  1111. =back
  1112.  
  1113. =cut
  1114.  
  1115. sub alias {
  1116.     my ($self, $string) = @_;
  1117.     return $self->bell unless $string =~ /^(\w)=(.*)/;
  1118.     $$self{config}{aliases}{"_$1"} = $self->_parse_chrs($2);
  1119.     return 1;
  1120. }
  1121.  
  1122. sub _parse_chrs { # parse escape sequences do not eval entire string, might contain $ etc.
  1123.     my $string = pop;
  1124.     $string =~ s/(\\\\)||(\\0\d{2}|\\x\w{2}|\\c.|\\\w)/$1 ? '\\' : eval qq("$2")/eg;
  1125.     return $string;
  1126. }
  1127.  
  1128. =head1 ATTRIBS
  1129.  
  1130. These can be accessed through the C<Attribs> method (defined by the parent class). 
  1131.  
  1132. =over 4
  1133.  
  1134. =item aliases
  1135.  
  1136. This option is refers to a hash with aliases, used for the key binding for '@'.
  1137. Note that all aliases have a one character name prefixed with a "_", this is due to
  1138. historic implementations where the same hash is used for system aliases.
  1139. We B<don't> support aliases for the shell command, to have that you should
  1140. define your own shell subroutine (see below).
  1141.  
  1142. =item editor
  1143.  
  1144. Editor command used for the 'v' binding. The string is run by the L<shell> command.
  1145. This option defaults to the EDITOR enviroment variable or to "vi %".
  1146.  
  1147. =item shell
  1148.  
  1149. The value can be set to a CODE ref to handle the L<shell> command from the
  1150. mini-buffer and the 'v' key binding. It should return the exit status of the
  1151. command (like the perlfunc C<system()>).
  1152.  
  1153. =back
  1154.  
  1155. =head1 AUTHOR
  1156.  
  1157. Jaap Karssenberg || Pardus [Larus] E<lt>pardus@cpan.orgE<gt>
  1158.  
  1159. Copyright (c) 2004 Jaap G Karssenberg. All rights reserved.
  1160. This program is free software; you can redistribute it and/or
  1161. modify it under the same terms as Perl itself.
  1162.  
  1163. =head1 SEE ALSO
  1164.  
  1165. L<Term::ReadLine::Zoid>
  1166.  
  1167. =cut
  1168.  
  1169.