1package Term::ReadLine::Zoid::ViCommand; 2 3use strict; 4use vars '$AUTOLOAD'; 5no strict 'refs'; 6use AutoLoader; 7use base 'Term::ReadLine::Zoid'; 8no warnings; # undef == '' down here 9 10our $VERSION = 0.05; 11 12sub 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 22Term::ReadLine::Zoid::ViCommand - a readline command mode 23 24=head1 SYNOPSIS 25 26This class is used as a mode under L<Term::ReadLine::Zoid>, 27see there for usage details. 28 29=head1 DESCRIPTION 30 31This mode provides a "vi command mode" as specified by the posix spec for the sh(1) 32utility. It intends to include at least all key-bindings 33mentioned by the posix spec for the vi mode in sh(1). 34It also contains some extensions borrowed from vim(1) and some private extensions. 35 36This mode has a "kill buffer" that stores the last killed text so it can 37be yanked again. This buffer has only one value, it isn't a "kill ring". 38 39=head1 KEY MAPPING 40 41Since ViCommand inherits from MultiLine, which in turn inherits 42from Term::ReadLine::Zoid, key bindings are also inherited unless explicitly overloaded. 43 44Control-d is ignored in this mode. 45 46=over 4 47 48=cut 49 50our %_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 62sub keymap { return \%_keymap } 63 64sub 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 72our @vi_motions = (' ', ',', qw/0 b F l W ^ $ ; E f T w | B e h t/); 73our %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); 87our %vi_commands = ( 88 '/' => 'bsearch', 89 '?' => 'fsearch', 90 '!' => 'shell', 91 'q' => 'quit', 92); 93 94sub 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 139sub vi_reset { $_[0]{vi_command} = ''; return 0 } 140 141sub sigtstp { kill 20, $$ } # SIGTSTP 142 143=item escape 144 145Reset the command mode. 146 147=item return 148 149=item ^J 150 151Return the current edit line to the application for execution. 152 153=item ^Z 154 155Send a SIGSTOP to the process of the application. Might not work when the application 156ignores those, which is something shells tend to do. 157 158=item i 159 160Switch back to insert mode. 161 162=item I 163 164Switch back to insert mode at the begin of the edit line. 165 166=item a 167 168Enter insert mode after the current cursor position. 169 170=item A 171 172Enter insert mode at the end of the edit line. 173 174=cut 175 176sub vi_I { 177 $_[0]{pos}[0] = 0 if $_[1] eq 'I'; 178 $_[0]->switch_mode(); 179} 180 181sub vi_A { 182 ($_[1] eq 'A') ? $_[0]->end_of_line : $_[0]->forward_char ; 183 $_[0]->switch_mode(); 184} 185 186=item m 187 188Switch to multiline insert mode, see L<Term::ReadLine::Zoid::MultiLine>. 189(private extension) 190 191=item M 192 193Switch to multiline insert mode at the end of the edit buffer. 194(private extension) 195 196=cut 197 198sub 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 209Enter insert mode with replace toggled on. 210(vim extension) 211 212=cut 213 214sub 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 227sub _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 237sub _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 261Makes current edit line a comment that will be listed in the history, 262but won't be executed. 263 264Only works if the 'comment_begin' option is set. 265 266=cut 267 268sub 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 276Display possible shell word completions, does not modify the edit line. 277 278=item \ 279 280Do pathname completion (using File::Glob) and insert the largest matching 281part in the edit line. 282 283=item * 284 285Do pathname completion but inserts B<all> matches. 286 287=cut 288 289sub 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 320Regard the contents of the alias _char as a macro with editing commands. 321This seems a rather obfuscated feature of the posix spec to me. See also below 322for the L<alias> command. 323 324Note that the I<count> argument is not posix compliant, but it seems silly not 325to use it. 326 327=cut 328 329sub 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 344Reverse case for I<count> characters. 345 346=cut 347 348sub 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 358Repeat the last non-motion command. 359If no count is specified the original count of the command is used. 360 361=cut 362 363sub 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 377Edit the buffer with the editor specified by the C<EDITOR> environment variable 378or the L<editor> option, defaults to 'vi'. 379 380This function requires the L<File::Temp> module from cpan, which in turn needs 381File::Spec and other packages. If these are not available this functions is 382disabled. 383 384=cut 385 386sub 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 397Move the cursor to the right. 398 399=item [I<count>] h 400 401Move 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 411Move the cursor to the begin of the next word or bigword. 412 413(A bigword exists of non-whitespace chars, while a word 414exists of alphanumeric chars only.) 415 416=cut 417 418sub 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 436Move the cursor to the end of the current word or bigword. 437 438=cut 439 440sub 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 458Move the cursor to the begin of the current word or bigword. 459 460=cut 461 462sub 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 479Move the cursor to the first non-whitespace on the edit line. 480 481=item $ 482 483Move the cursor to the end of the edit line. 484 485=item 0 486 487Move the cursor to the begin of the edit line. 488 489=cut 490 491sub 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 500Set the cursor to position I<count> (1-based). 501 502=cut 503 504sub vi_cursor { $_[0]{pos}[0] = $_[2] - 1; 1; } 505 506=item [I<count>] f I<char> 507 508Set cursor to I<count>'th occurrence of I<char> to the right. 509The cursor is placed on I<char>. 510 511=item [I<count>] F I<char> 512 513Set cursor to I<count>'th occurrence of I<char> to the left. 514The cursor is placed on I<char>. 515 516=item [I<count>] t I<char> 517 518Set cursor to I<count>'th occurrence of I<char> to the right. 519The cursor is placed before I<char>. 520 521=item [I<count>] T I<char> 522 523Set cursor to I<count>'th occurrence of I<char> to the left. 524The cursor is placed after I<char>. 525 526=cut 527 528sub 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 555Repeat the last 'f', 'F', 't', or 'T' command. Count of last command is ignored. 556 557=item [I<count>] , 558 559Like ';' but with direction reversed. 560 561=cut 562 563sub 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 573Delete characters between the current position and the position after the 574I<motion>, I<count> applies to I<motion>. 575After the deletion enter insert mode. 576 577The "motion" 'c' deletes the current edit line. 578 579=item C 580 581Delete from cursor to end of line and enter insert mode. 582 583=cut 584 585sub 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 597Delete current line and enter insert mode. 598 599=cut 600 601sub 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 610Replace the character under the cursor (and the I<count> 611characters next to it) with I<char>. 612 613=cut 614 615sub 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 624Insert a white space followed by the last (or I<count>'th) bigword 625from the previous history entry ans enter insert mode. 626 627Quotes are not respected by this function. 628 629=cut 630 631sub 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 646Delete I<count> characters and place them in the save buffer. 647 648=item [I<count>] X 649 650Delete I<count> characters before the cursor position 651and place them in the save buffer. 652 653('x' is like 'delete', 'X' like backspace) 654 655=cut 656 657sub 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 668Delete from the current cursor position to the position resulting from I<count> 669times I<motion>. The deleted part will be placed in the save buffer. 670 671The "motion" 'd' deletes the current line. 672 673=item D 674 675Delete from the cursor position until the end of the line and put the deleted 676part in the save buffer. 677 678=cut 679 680sub 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 693Yank (copy) characters from the current cursor position to the position resulting from I<count> 694times I<motion> to the save buffer. 695 696the "motion" 'y' yanks the current line. 697 698=item Y 699 700Like y but from cursor till end of line. 701 702=cut 703 704sub 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 718Insert I<count> copies of the the save buffer after the cursor. 719 720=item [I<count>] P 721 722Insert I<count> copies of the the save buffer before the cursor. 723 724=cut 725 726sub 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 735Undo the last command that changed the edit line. 736 737=item U 738 739Undo all changes. 740 741TODO all changes since when ? since entering the command mode ? 742 743=cut 744 745sub 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 755Go I<count> lines backward in history. 756 757=cut 758 759sub 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 768Go I<count> lines forward in history. 769 770=cut 771 772sub vi_J { 773 $_[0]->next_history || last for 1 .. $_[2]; 774 $_[0]->beginning_of_line; 775} 776 777=item [I<number>] G 778 779Go to history entry number I<number>, or to the first history entry. 780 781=cut 782 783sub 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 791Repeat the last history search by either the '/' or '?' minibuffers 792or the incremental search mode. 793 794=item N 795 796Repeat the last history search in the oposite direction. 797 798=cut 799 800sub 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 840Opens a command mini buffer. This is a very minimalistic execution environment 841that can for instance be used to modify options if the application doesn't 842provide a method to do so. Also it is used for quick hacks ;) 843 844The execution of this buffer happens entirely without returning to the application. 845 846(This is a vim extension) 847 848=cut 849 850sub 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 875Opens a mini buffer where you can type a pattern to search backward through 876the history. 877 878The search patterns are not globs (as posix would have them), but 879are evaluated as perl regexes. 880 881An empty pattern repeats the previous search. 882 883=item ? 884 885Like '/' but searches in the forward direction. 886 887=cut 888 889sub 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 904sub 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 921If cursor is on a number, increment it. (This is a vim extension) 922 923FIXME bit buggy 924 925=item ^X 926 927If cursor is on a number, decrement it. (This is a vim extension) 928 929FIXME bit buggy 930 931=cut 932 933sub 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 954These can be used from the ":" mini buffer. Some commands are borrowed from vim, 955but no guarantee what so ever. 956 957=over 4 958 959=item B<quit> 960 961Return undef to the application (like '^D' in insert mode). 962 963=item B<set> [I<+o>|I<-o>] [I<option>=I<value>] 964 965Set a key-value pair in the options hash 966When the arg '+o' is given (or the option is preceded by 'no') 967the option is deleted. 968 969Can be used to change the ReadLine behaviour independent from the application. 970 971=cut 972 973sub quit { $_[0]{_loop} = undef } 974 975sub 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 989Output ascii values for the char in the edit line on the cursor position. 990 991=cut 992 993sub 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 1005Wait for a character input and output ascii values for it. 1006 1007=cut 1008 1009sub 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 1020Map a char (or char sequence) to a key name. 1021 1022=cut 1023 1024sub 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 1032Map a char (or char sequence) to a key name. 1033 1034=cut 1035 1036sub 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 1048Eval a system command. 1049The '%' character in this string will be replace with the name of a tmp file 1050containing the edit buffer. 1051After execution this tmp file will be read back into the edit buffer. 1052Of course you can use an backslash to escape a literal '%'. 1053 1054Note that this tmp file feature only works if you have L<File::Temp> installed. 1055 1056=cut 1057 1058sub 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 1090Eval some perlcode for the most evil instant hacks. 1091The ReadLine object can be called as C<$self>. 1092 1093=cut 1094 1095sub 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 1106Define a macro in an alias with a one character name. 1107These can be executed with the '@' command. 1108Non alphanumeric keys like "\n" and "\e" can be inserted with the standard perl 1109escape sequences. You need to use "\\" for a literal '\'. 1110 1111=back 1112 1113=cut 1114 1115sub 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 1122sub _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 1130These can be accessed through the C<Attribs> method (defined by the parent class). 1131 1132=over 4 1133 1134=item aliases 1135 1136This option is refers to a hash with aliases, used for the key binding for '@'. 1137Note that all aliases have a one character name prefixed with a "_", this is due to 1138historic implementations where the same hash is used for system aliases. 1139We B<don't> support aliases for the shell command, to have that you should 1140define your own shell subroutine (see below). 1141 1142=item editor 1143 1144Editor command used for the 'v' binding. The string is run by the L<shell> command. 1145This option defaults to the EDITOR enviroment variable or to "vi %". 1146 1147=item shell 1148 1149The value can be set to a CODE ref to handle the L<shell> command from the 1150mini-buffer and the 'v' key binding. It should return the exit status of the 1151command (like the perlfunc C<system()>). 1152 1153=back 1154 1155=head1 AUTHOR 1156 1157Jaap Karssenberg || Pardus [Larus] E<lt>pardus@cpan.orgE<gt> 1158 1159Copyright (c) 2004 Jaap G Karssenberg. All rights reserved. 1160This program is free software; you can redistribute it and/or 1161modify it under the same terms as Perl itself. 1162 1163=head1 SEE ALSO 1164 1165L<Term::ReadLine::Zoid> 1166 1167=cut 1168 1169