1## 2## Perl Readline -- The Quick Help 3## (see the manual for complete info) 4## 5## Once this package is included (require'd), you can then call 6## $text = &readline'readline($input); 7## to get lines of input from the user. 8## 9## Normally, it reads ~/.inputrc when loaded... to suppress this, set 10## $readline'rl_NoInitFromFile = 1; 11## before requiring the package. 12## 13## Call rl_bind to add your own key bindings, as in 14## &readline'rl_bind('C-L', 'possible-completions'); 15## 16## Call rl_set to set mode variables yourself, as in 17## &readline'rl_set('TcshCompleteMode', 'On'); 18## 19## To change the input mode (emacs or vi) use ~/.inputrc or call 20## &readline::rl_set('EditingMode', 'vi'); 21## or &readline::rl_set('EditingMode', 'emacs'); 22## 23## Call rl_basic_commands to set your own command completion, as in 24## &readline'rl_basic_commands('print', 'list', 'quit', 'run', 'status'); 25## 26## 27 28# Wrap the code below (initially Perl4, now partially Perl4) into a fake 29# Perl5 pseudo-module; mismatch of package and file name is intentional 30# to make is harder to abuse this (very fragile) code... 31package readline; 32 33my $autoload_broken = 1; # currently: defined does not work with a-l 34my $useioctl = 1; 35my $usestty = 1; 36my $max_include_depth = 10; # follow $include's in init files this deep 37 38BEGIN { # Some old systems have ioctl "unsupported" 39 *ioctl = sub ($$$) { eval { ioctl $_[0], $_[1], $_[2] } }; 40} 41 42## 43## BLURB: 44## A pretty full-function package similar to GNU's readline. 45## Includes support for EUC-encoded Japanese text. 46## 47## Written by Jeffrey Friedl, Omron Corporation (jfriedl@omron.co.jp) 48## 49## Comments, corrections welcome. 50## 51## Thanks to the people at FSF for readline (and the code I referenced 52## while writing this), and for Roland Schemers whose line_edit.pl I used 53## as an early basis for this. 54## 55$VERSION = $VERSION = '1.0302'; 56 57## - Changes from Slaven Rezic (slaven@rezic.de): 58## * reverted the usage of $ENV{EDITOR} to set startup mode 59## only ~/.inputrc or an explicit call to rl_set should 60## be used to set startup mode 61## 62# 1011109.011 - Changes from Russ Southern (russ@dvns.com): 63## * Added $rl_vi_replace_default_on_insert 64# 1000510.010 - Changes from Joe Petolino (petolino@eng.sun.com), requested 65## by Ilya: 66## 67## * Make it compatible with perl 5.003. 68## * Rename getc() to getc_with_pending(). 69## * Change unshift(@Pending) to push(@Pending). 70## 71## 991109.009 - Changes from Joe Petolino (petolino@eng.sun.com): 72## Added vi mode. Also added a way to set the keymap default 73## action for multi-character keymaps, so that a 2-character 74## sequence (e.g. <esc>A) can be treated as two one-character 75## commands (<esc>, then A) if the sequence is not explicitly 76## mapped. 77## 78## Changed subs: 79## 80## * preinit(): Initialize new keymaps and other data structures. 81## Use $ENV{EDITOR} to set startup mode. 82## 83## * init(): Sets the global *KeyMap, since &F_ReReadInitFile 84## may have changed the key map. 85## 86## * InitKeymap(): $KeyMap{default} is now optional - don't 87## set it if $_[1] eq ''; 88## 89## * actually_do_binding(): Set $KeyMap{default} for '\*' key; 90## warning if double-defined. 91## 92## * rl_bind(): Implement \* to set the keymap default. Also fix 93## some existing regex bugs that I happened to notice. 94## 95## * readline(): No longer takes input from $pending before 96## calling &$rl_getc(); instead, it calls getc_with_pending(), 97## which takes input from the new array @Pending 98## before calling &$rl_getc(). Sets the global 99## *KeyMap after do_command(), since do_command() 100## may change the keymap now. Does some cursor 101## manipulation after do_command() when at the end 102## of the line in vi command mode, to match the 103## behavior of vi. 104## 105## * rl_getc(): Added a my declaration for $key, which was 106## apparently omitted by the author. rl_getc() is 107## no longer called directly; instead, getc_with_pending() calls 108## it only after exhausting any requeued characters 109## in @Pending. @Pending is used to implement the 110## vi '.' command, as well as the emacs DoSearch 111## functionality. 112## 113## * do_command(): Now defaults the command to 'F_Ding' if 114## $KeyMap{default} is undefined. This is part 115## of the new \* feature. 116## 117## * savestate()/getstate(): Now use an anonymous array instead 118## of packing the fields into a string. 119## 120## * F_AcceptLine(): Code moved to new sub add_line_to_history(), 121## so that it may be called by F_SaveLine() 122## as well as by F_AcceptLine(). 123## 124## * F_QuotedInsert(): Calls getc_with_pending() instead of &$rl_getc(). 125## 126## * F_UnixWordRubout(): Fixed bug: changed 'my' declaration of 127## global $rl_basic_word_break_characters to 'local'. 128## 129## * DoSearch(): Calls getc_with_pending() instead of &$rl_getc(). Ungets 130## character onto @Pending instead of $pending. 131## 132## * F_EmacsEditingMode(): Resets global $Vi_mode; 133## 134## * F_ToggleEditingMode(): Deleted. We use F_ViInput() and 135## F_EmacsEditingMode() instead. 136## 137## * F_PrefixMeta(): Calls getc_with_pending() instead of &$rl_getc(). 138## 139## * F_DigitArgument(): Calls getc_with_pending() instead of &$rl_getc(). 140## 141## * F_Ding(): Returns undef, for testing by vi commands. 142## 143## * F_Complete(): Returns true if a completion was done, false 144## otherwise, so vi completion routines can test it. 145## 146## * complete_internal(): Returns true if a completion was done, 147## false otherwise, so vi completion routines can 148## test it. Does a little cursor massaging in vi 149## mode, to match the behavior of ksh vi mode. 150## 151## Disclaimer: the original code dates from the perl 4 days, and 152## isn't very pretty by today's standards (for example, 153## extensive use of typeglobs and localized globals). In the 154## interests of not breaking anything, I've tried to preserve 155## the old code as much as possible, and I've avoided making 156## major stylistic changes. Since I'm not a regular emacs user, 157## I haven't done much testing to see that all the emacs-mode 158## features still work. 159## 160## 940817.008 - Added $var_CompleteAddsuffix. 161## Now recognizes window-change signals (at least on BSD). 162## Various typos and bug fixes. 163## Changes from Chris Arthur (csa@halcyon.com): 164## Added a few new keybindings. 165## Various typos and bug fixes. 166## Support for use from a dumb terminal. 167## Pretty-printing of filename-completion matches. 168## 169## 930306.007 - Added rl_start_default_at_beginning. 170## Added optional message arg to &redisplay. 171## Added explicit numeric argument var to functions that use it. 172## Redid many commands to simplify. 173## Added TransposeChars, UpcaseWord, CapitalizeWord, DownCaseWord. 174## Redid key binding specs to better match GNU.. added 175## undocumented "new-style" bindings.... can now bind 176## arrow keys and other arbitrairly long key sequences. 177## Added if/else/then to .inputrc. 178## 179## 930305.006 - optional "default" added (from mmuegel@cssmp.corp.mot.com). 180## 181## 930211.005 - fixed strange problem with eval while keybinding 182## 183 184## 185## Ilya: 186## 187## Added support for ReadKey, 188## 189## Added customization variable $minlength 190## to denote minimal lenth of a string to be put into history buffer. 191## 192## Added support for a bug in debugger: preinit cannot be a subroutine ?!!! 193## (See immendiately below) 194## 195## Added support for WINCH hooks. The subroutine references should be put into 196## @winchhooks. 197## 198## Added F_ToggleInsertMode, F_HistorySearchBackward, 199## F_HistorySearchForward, PC keyboard bindings. 200## 0.93: Updates to Operate, couple of keybindings added. 201## $rl_completer_terminator_character, $rl_correct_sw added. 202## Reload-init-file moved to C-x C-x. 203## C-x ? and C-x * list/insert possible completions. 204 205$rl_getc = \&rl_getc; 206 207&preinit; 208&init; 209 210# # # # use strict 'vars'; 211 212# # # # # Separation into my and vars needs some thought... 213 214# # # # use vars qw(@KeyMap %KeyMap $rl_screen_width $rl_start_default_at_beginning 215# # # # $rl_completion_function $rl_basic_word_break_characters 216# # # # $rl_completer_word_break_characters $rl_special_prefixes 217# # # # $rl_readline_name @rl_History $rl_MaxHistorySize 218# # # # $rl_max_numeric_arg $rl_OperateCount 219# # # # $KillBuffer $dumb_term $stdin_not_tty $InsertMode 220# # # # $rl_NoInitFromFile); 221 222# # # # my ($InputLocMsg, $term_OUT, $term_IN); 223# # # # my ($winsz_t, $TIOCGWINSZ, $winsz, $rl_margin, $hooj, $force_redraw); 224# # # # my ($hook, %var_HorizontalScrollMode, %var_EditingMode, %var_OutputMeta); 225# # # # my ($var_HorizontalScrollMode, $var_EditingMode, $var_OutputMeta); 226# # # # my (%var_ConvertMeta, $var_ConvertMeta, %var_MarkModifiedLines, $var_MarkModifiedLines); 227# # # # my ($term_readkey, $inDOS); 228# # # # my (%var_PreferVisibleBell, $var_PreferVisibleBell); 229# # # # my (%var_TcshCompleteMode, $var_TcshCompleteMode); 230# # # # my (%var_CompleteAddsuffix, $var_CompleteAddsuffix); 231# # # # my ($minlength, @winchhooks); 232# # # # my ($BRKINT, $ECHO, $FIONREAD, $ICANON, $ICRNL, $IGNBRK, $IGNCR, $INLCR, 233# # # # $ISIG, $ISTRIP, $NCCS, $OPOST, $RAW, $TCGETS, $TCOON, $TCSETS, $TCXONC, 234# # # # $TERMIOS_CFLAG, $TERMIOS_IFLAG, $TERMIOS_LFLAG, $TERMIOS_NORMAL_IOFF, 235# # # # $TERMIOS_NORMAL_ION, $TERMIOS_NORMAL_LOFF, $TERMIOS_NORMAL_LON, 236# # # # $TERMIOS_NORMAL_OOFF, $TERMIOS_NORMAL_OON, $TERMIOS_OFLAG, 237# # # # $TERMIOS_READLINE_IOFF, $TERMIOS_READLINE_ION, $TERMIOS_READLINE_LOFF, 238# # # # $TERMIOS_READLINE_LON, $TERMIOS_READLINE_OOFF, $TERMIOS_READLINE_OON, 239# # # # $TERMIOS_VMIN, $TERMIOS_VTIME, $TIOCGETP, $TIOCGWINSZ, $TIOCSETP, 240# # # # $fion, $fionread_t, $mode, $sgttyb_t, 241# # # # $termios, $termios_t, $winsz, $winsz_t); 242# # # # my ($line, $initialized, $term_readkey); 243 244 245# # # # # Global variables added for vi mode (I'm leaving them all commented 246# # # # # out, like the declarations above, until SelfLoader issues 247# # # # # are resolved). 248 249# # # # # True when we're in one of the vi modes. 250# # # # my $Vi_mode; 251 252# # # # # Array refs: saves keystrokes for '.' command. Undefined when we're 253# # # # # not doing a '.'-able command. 254# # # # my $Dot_buf; # Working buffer 255# # # # my $Last_vi_command; # Gets $Dot_buf when a command is parsed 256 257# # # # # These hold state for vi 'u' and 'U'. 258# # # # my($Dot_state, $Vi_undo_state, $Vi_undo_all_state); 259 260# # # # # Refs to hashes used for cursor movement 261# # # # my($Vi_delete_patterns, $Vi_move_patterns, 262# # # # $Vi_change_patterns, $Vi_yank_patterns); 263 264# # # # # Array ref: holds parameters from the last [fFtT] command, for ';' 265# # # # # and ','. 266# # # # my $Last_findchar; 267 268# # # # # Globals for history search commands (/, ?, n, N) 269# # # # my $Vi_search_re; # Regular expression (compiled by qr{}) 270# # # # my $Vi_search_reverse; # True for '?' search, false for '/' 271 272 273## 274## What's Cool 275## ---------------------------------------------------------------------- 276## * hey, it's in perl. 277## * Pretty full GNU readline like library... 278## * support for ~/.inputrc 279## * horizontal scrolling 280## * command/file completion 281## * rebinding 282## * history (with search) 283## * undo 284## * numeric prefixes 285## * supports multi-byte characters (at least for the Japanese I use). 286## * Has a tcsh-like completion-function mode. 287## call &readline'rl_set('tcsh-complete-mode', 'On') to turn on. 288## 289 290## 291## What's not Cool 292## ---------------------------------------------------------------------- 293## Can you say HUGE? 294## I can't spell, so comments riddled with misspellings. 295## Written by someone that has never really used readline. 296## History mechanism is slightly different than GNU... may get fixed 297## someday, but I like it as it is now... 298## Killbuffer not a ring.. just one level. 299## Obviously not well tested yet. 300## Written by someone that doesn't have a bell on his terminal, so 301## proper readline use of the bell may not be here. 302## 303 304 305## 306## Functions beginning with F_ are functions that are mapped to keys. 307## Variables and functions beginning rl_ may be accessed/set/called/read 308## from outside the package. Other things are internal. 309## 310## Some notable internal-only variables of global proportions: 311## $prompt -- line prompt (passed from user) 312## $line -- the line being input 313## $D -- ``Dot'' -- index into $line of the cursor's location. 314## $InsertMode -- usually true. False means overwrite mode. 315## $InputLocMsg -- string for error messages, such as "[~/.inputrc line 2]" 316## *emacs_keymap -- keymap for emacs-mode bindings: 317## @emacs_keymap - bindings indexed by ASCII ordinal 318## $emacs_keymap{'name'} = "emacs_keymap" 319## $emacs_keymap{'default'} = "SelfInsert" (default binding) 320## *vi_keymap -- keymap for vi input mode bindings 321## *vicmd_keymap -- keymap for vi command mode bindings 322## *vipos_keymap -- keymap for vi positioning command bindings 323## *visearch_keymap -- keymap for vi search pattern input mode bindings 324## *KeyMap -- current keymap in effect. 325## $LastCommandKilledText -- needed so that subsequent kills accumulate 326## $lastcommand -- name of command previously run 327## $lastredisplay -- text placed upon screen during previous &redisplay 328## $si -- ``screen index''; index into $line of leftmost char &redisplay'ed 329## $force_redraw -- if set to true, causes &redisplay to be verbose. 330## $AcceptLine -- when set, its value is returned from &readline. 331## $ReturnEOF -- unless this also set, in which case undef is returned. 332## @Pending -- characters to be used as input. 333## @undo -- array holding all states of current line, for undoing. 334## $KillBuffer -- top of kill ring (well, don't have a kill ring yet) 335## @tcsh_complete_selections -- for tcsh mode, possible selections 336## 337## Some internal variables modified by &rl_set (see comment at &rl_set for 338## info about how these set'able variables work) 339## $var_EditingMode -- a keymap typeglob like *emacs_keymap or *vi_keymap 340## $var_TcshCompleteMode -- if true, the completion function works like 341## in tcsh. That is, the first time you try to complete something, 342## the common prefix is completed for you. Subsequent completion tries 343## (without other commands in between) cycles the command line through 344## the various possibilities. If/when you get the one you want, just 345## continue typing. 346## Other $var_ things not supported yet. 347## 348## Some variables used internally, but may be accessed from outside... 349## $VERSION -- just for good looks. 350## $rl_readline_name = name of program -- for .initrc if/endif stuff. 351## $rl_NoInitFromFile -- if defined when package is require'd, ~/.inputrc 352## will not be read. 353## @rl_History -- array of previous lines input 354## $rl_HistoryIndex -- history pointer (for moving about history array) 355## $rl_completion_function -- see "How Command Completion Works" (way) below. 356## $rl_basic_word_break_characters -- string of characters that can cause 357## a word break for forward-word, etc. 358## $rl_start_default_at_beginning -- 359## Normally, the user's cursor starts at the end of any default text 360## passed to readline. If this variable is true, it starts at the 361## beginning. 362## $rl_completer_word_break_characters -- 363## like $rl_basic_word_break_characters (and in fact defaults to it), 364## but for the completion function. 365## $rl_completer_terminator_character -- what to insert to separate 366## a completed token from the rest. Reset at beginning of 367## completion to ' ' so completion function can change it. 368## $rl_special_prefixes -- characters that are part of this string as well 369## as of $rl_completer_word_break_characters cause a word break for the 370## completer function, but remain part of the word. An example: consider 371## when the input might be perl code, and one wants to be able to 372## complete on variable and function names, yet still have the '$', 373## '&', '@',etc. part of the $text to be completed. Then set this var 374## to '&@$%' and make sure each of these characters is in 375## $rl_completer_word_break_characters as well.... 376## $rl_MaxHistorySize -- maximum size that the history array may grow. 377## $rl_screen_width -- width readline thinks it can use on the screen. 378## $rl_correct_sw -- is substructed from the real width of the terminal 379## $rl_margin -- scroll by moving to within this far from a margin. 380## $rl_CLEAR -- what to output to clear the screen. 381## $rl_max_numeric_arg -- maximum numeric arg allowed. 382## $rl_vi_replace_default_on_insert 383## Normally, the text you enter is added to any default text passed to 384## readline. If this variable is true, default text will start out 385## highlighted (if supported by your terminal) and text entered while the 386## default is highlighted (during the _first_ insert mode only) will 387## replace the entire default line. Once you have left insert mode (hit 388## escape), everything works as normal. 389## - This is similar to many GUI controls' behavior, which select the 390## default text so that new text replaces the old. 391## - Use with $rl_start_default_at_beginning for normal-looking behavior 392## (though it works just fine without it). 393## Notes/Bugs: 394## - Control characters (like C-w) do not actually terminate this replace 395## mode, for the same reason it does not work in emacs mode. 396## - Spine-crawlingly scary subroutine redefinitions 397## $rl_mark - start of the region 398## $line_rl_mark - the line on which $rl_mark is active 399## $_rl_japanese_mb - For character movement suppose Japanese (which?!) 400## multi-byte encoding. (How to make a sane default?) 401## 402 403sub get_window_size 404{ 405 my $sig = shift; 406 my ($num_cols,$num_rows); 407 408 if (defined $term_readkey) { 409 ($num_cols,$num_rows) = Term::ReadKey::GetTerminalSize($term_OUT); 410 $rl_screen_width = $num_cols - $rl_correct_sw 411 if defined($num_cols) && $num_cols; 412 } elsif (defined $TIOCGWINSZ and &ioctl($term_IN,$TIOCGWINSZ,$winsz)) { 413 ($num_rows,$num_cols) = unpack($winsz_t,$winsz); 414 $rl_screen_width = $num_cols - $rl_correct_sw 415 if defined($num_cols) && $num_cols; 416 } 417 $rl_margin = int($rl_screen_width/3); 418 if (defined $sig) { 419 $force_redraw = 1; 420 &redisplay(); 421 } 422 423 for $hook (@winchhooks) { 424 eval {&$hook()}; warn $@ if $@ and $^W; 425 } 426 local $^W = 0; # WINCH may be illegal... 427 $SIG{'WINCH'} = "readline::get_window_size"; 428} 429 430# Fix: case-sensitivity of inputrc on/off keywords in 431# `set' commands. readline lib doesn't care about case. 432# changed case of keys 'On' and 'Off' to 'on' and 'off' 433# &rl_set changed so that it converts the value to 434# lower case before hash lookup. 435sub preinit 436{ 437 ## Set up the input and output handles 438 439 $term_IN = \*STDIN unless defined $term_IN; 440 $term_OUT = \*STDOUT unless defined $term_OUT; 441 ## not yet supported... always on. 442 $var_HorizontalScrollMode = 1; 443 $var_HorizontalScrollMode{'On'} = 1; 444 $var_HorizontalScrollMode{'Off'} = 0; 445 446 $var_EditingMode{'emacs'} = *emacs_keymap; 447 $var_EditingMode{'vi'} = *vi_keymap; 448 $var_EditingMode{'vicmd'} = *vicmd_keymap; 449 $var_EditingMode{'vipos'} = *vipos_keymap; 450 $var_EditingMode{'visearch'} = *visearch_keymap; 451 452 ## this is an addition. Very nice. 453 $var_TcshCompleteMode = 0; 454 $var_TcshCompleteMode{'On'} = 1; 455 $var_TcshCompleteMode{'Off'} = 0; 456 457 $var_CompleteAddsuffix = 1; 458 $var_CompleteAddsuffix{'On'} = 1; 459 $var_CompleteAddsuffix{'Off'} = 0; 460 461 $var_DeleteSelection = $var_DeleteSelection{'On'} = 1; 462 $var_DeleteSelection{'Off'} = 0; 463 *rl_delete_selection = \$var_DeleteSelection; # Alias 464 465 ## not yet supported... always on 466 for ('InputMeta', 'OutputMeta') { 467 ${"var_$_"} = 1; 468 ${"var_$_"}{'Off'} = 0; 469 ${"var_$_"}{'On'} = 1; 470 } 471 472 ## not yet supported... always off 473 for ('ConvertMeta', 'MetaFlag', 'MarkModifiedLines', 'PreferVisibleBell', 474 'BlinkMatchingParen', 'VisibleStats', 'ShowAllIfAmbiguous', 475 'PrintCompletionsHorizontally', 'MarkDirectories', 'ExpandTilde', 476 'EnableKeypad', 'DisableCompletion', 'CompletionIgnoreCase') { 477 ${"var_$_"} = 0; 478 ${"var_$_"}{'Off'} = 0; 479 ${"var_$_"}{'On'} = 1; 480 } 481 482 # To conform to interface 483 $minlength = 1 unless defined $minlength; 484 485 # WINCH hooks 486 @winchhooks = (); 487 488 $inDOS = $^O eq 'os2' || defined $ENV{OS2_SHELL} unless defined $inDOS; 489 eval { 490 require Term::ReadKey; $term_readkey++; 491 } unless defined $ENV{PERL_RL_USE_TRK} 492 and not $ENV{PERL_RL_USE_TRK}; 493 unless ($term_readkey) { 494 eval {require "ioctl.pl"}; ## try to get, don't die if not found. 495 eval {require "sys/ioctl.ph"}; ## try to get, don't die if not found. 496 eval {require "sgtty.ph"}; ## try to get, don't die if not found. 497 if ($inDOS and !defined $TIOCGWINSZ) { 498 $TIOCGWINSZ=0; 499 $TIOCGETP=1; 500 $TIOCSETP=2; 501 $sgttyb_t="I5 C8"; 502 $winsz_t=""; 503 $RAW=0xf002; 504 $ECHO=0x0008; 505 } 506 $TIOCGETP = &TIOCGETP if defined(&TIOCGETP); 507 $TIOCSETP = &TIOCSETP if defined(&TIOCSETP); 508 $TIOCGWINSZ = &TIOCGWINSZ if defined(&TIOCGWINSZ); 509 $FIONREAD = &FIONREAD if defined(&FIONREAD); 510 $TCGETS = &TCGETS if defined(&TCGETS); 511 $TCSETS = &TCSETS if defined(&TCSETS); 512 $TCXONC = &TCXONC if defined(&TCXONC); 513 $TIOCGETP = 0x40067408 if !defined($TIOCGETP); 514 $TIOCSETP = 0x80067409 if !defined($TIOCSETP); 515 $TIOCGWINSZ = 0x40087468 if !defined($TIOCGWINSZ); 516 $FIONREAD = 0x4004667f if !defined($FIONREAD); 517 $TCGETS = 0x40245408 if !defined($TCGETS); 518 $TCSETS = 0x80245409 if !defined($TCSETS); 519 $TCXONC = 0x20005406 if !defined($TCXONC); 520 521 ## TTY modes 522 $ECHO = &ECHO if defined(&ECHO); 523 $RAW = &RAW if defined(&RAW); 524 $RAW = 040 if !defined($RAW); 525 $ECHO = 010 if !defined($ECHO); 526 #$CBREAK = 002 if !defined($CBREAK); 527 $mode = $RAW; ## could choose CBREAK for testing.... 528 529 $IGNBRK = 1 if !defined($IGNBRK); 530 $BRKINT = 2 if !defined($BRKINT); 531 $ISTRIP = 040 if !defined($ISTRIP); 532 $INLCR = 0100 if !defined($INLCR); 533 $IGNCR = 0200 if !defined($IGNCR); 534 $ICRNL = 0400 if !defined($ICRNL); 535 $OPOST = 1 if !defined($OPOST); 536 $ISIG = 1 if !defined($ISIG); 537 $ICANON = 2 if !defined($ICANON); 538 $TCOON = 1 if !defined($TCOON); 539 $TERMIOS_READLINE_ION = $BRKINT; 540 $TERMIOS_READLINE_IOFF = $IGNBRK | $ISTRIP | $INLCR | $IGNCR | $ICRNL; 541 $TERMIOS_READLINE_OON = 0; 542 $TERMIOS_READLINE_OOFF = $OPOST; 543 $TERMIOS_READLINE_LON = 0; 544 $TERMIOS_READLINE_LOFF = $ISIG | $ICANON | $ECHO; 545 $TERMIOS_NORMAL_ION = $BRKINT; 546 $TERMIOS_NORMAL_IOFF = $IGNBRK; 547 $TERMIOS_NORMAL_OON = $OPOST; 548 $TERMIOS_NORMAL_OOFF = 0; 549 $TERMIOS_NORMAL_LON = $ISIG | $ICANON | $ECHO; 550 $TERMIOS_NORMAL_LOFF = 0; 551 552 #$sgttyb_t = 'C4 S'; 553 #$winsz_t = "S S S S"; # rows,cols, xpixel, ypixel 554 $sgttyb_t = 'C4 S' if !defined($sgttyb_t); 555 $winsz_t = "S S S S" if !defined($winsz_t); 556 # rows,cols, xpixel, ypixel 557 $winsz = pack($winsz_t,0,0,0,0); 558 $fionread_t = "L"; 559 $fion = pack($fionread_t, 0); 560 $NCCS = 17; 561 $termios_t = "LLLLc" . ("c" x $NCCS); # true for SunOS 4.1.3, at least... 562 $termios = ''; ## just to shut up "perl -w". 563 $termios = pack($termios, 0); # who cares, just make it long enough 564 $TERMIOS_IFLAG = 0; 565 $TERMIOS_OFLAG = 1; 566 $TERMIOS_CFLAG = 2; 567 $TERMIOS_LFLAG = 3; 568 $TERMIOS_VMIN = 5 + 4; 569 $TERMIOS_VTIME = 5 + 5; 570 } 571 $rl_delete_selection = 1; 572 $rl_correct_sw = ($inDOS ? 1 : 0); 573 $rl_scroll_nextline = 1 unless defined $rl_scroll_nextline; 574 $rl_last_pos_can_backspace = ($inDOS ? 0 : 1) # Can backspace when the 575 unless defined $rl_last_pos_can_backspace; # whole line is filled? 576 577 $rl_start_default_at_beginning = 0; 578 $rl_vi_replace_default_on_insert = 0; 579 $rl_screen_width = 79; ## default 580 581 $rl_completion_function = "rl_filename_list" 582 unless defined($rl_completion_function); 583 $rl_basic_word_break_characters = "\\\t\n' \"`\@\$><=;|&{("; 584 $rl_completer_word_break_characters = $rl_basic_word_break_characters; 585 $rl_special_prefixes = ''; 586 ($rl_readline_name = $0) =~ s#.*[/\\]## if !defined($rl_readline_name); 587 588 @rl_History=() if !(@rl_History); 589 $rl_MaxHistorySize = 100 if !defined($rl_MaxHistorySize); 590 $rl_max_numeric_arg = 200 if !defined($rl_max_numeric_arg); 591 $rl_OperateCount = 0 if !defined($rl_OperateCount); 592 593 $rl_term_set = \@Term::ReadLine::TermCap::rl_term_set; 594 @$rl_term_set or $rl_term_set = ["","","",""]; 595 596 $InsertMode=1; 597 $KillBuffer=''; 598 $line=''; 599 $D = 0; 600 $InputLocMsg = ' [initialization]'; 601 602 &InitKeymap(*emacs_keymap, 'SelfInsert', 'emacs_keymap', 603 ($inDOS ? () : ('C-@', 'SetMark') ), 604 'C-a', 'BeginningOfLine', 605 'C-b', 'BackwardChar', 606 'C-c', 'Interrupt', 607 'C-d', 'DeleteChar', 608 'C-e', 'EndOfLine', 609 'C-f', 'ForwardChar', 610 'C-g', 'Abort', 611 'M-C-g', 'Abort', 612 'C-h', 'BackwardDeleteChar', 613 "TAB" , 'Complete', 614 "C-j" , 'AcceptLine', 615 'C-k', 'KillLine', 616 'C-l', 'ClearScreen', 617 "C-m" , 'AcceptLine', 618 'C-n', 'NextHistory', 619 'C-o', 'OperateAndGetNext', 620 'C-p', 'PreviousHistory', 621 'C-q', 'QuotedInsert', 622 'C-r', 'ReverseSearchHistory', 623 'C-s', 'ForwardSearchHistory', 624 'C-t', 'TransposeChars', 625 'C-u', 'UnixLineDiscard', 626 ##'C-v', 'QuotedInsert', 627 'C-v', 'HistorySearchForward', 628 'C-w', 'UnixWordRubout', 629 qq/"\cX\cX"/, 'ExchangePointAndMark', 630 qq/"\cX\cR"/, 'ReReadInitFile', 631 qq/"\cX?"/, 'PossibleCompletions', 632 qq/"\cX*"/, 'InsertPossibleCompletions', 633 qq/"\cX\cU"/, 'Undo', 634 qq/"\cXu"/, 'Undo', 635 qq/"\cX\cW"/, 'KillRegion', 636 qq/"\cXw"/, 'CopyRegionAsKill', 637 qq/"\cX\ec\\*"/, 'DoControlVersion', 638 qq/"\cX\ec\0"/, 'SetMark', 639 qq/"\cX\ec\@"/, 'SetMark', 640 qq/"\cX\ec "/, 'SetMark', 641 qq/"\cX\em\\*"/, 'DoMetaVersion', 642 qq/"\cX\@c\\*"/, 'DoControlVersion', 643 qq/"\cX\@c\0"/, 'SetMark', 644 qq/"\cX\@c\@"/, 'SetMark', 645 qq/"\cX\@c "/, 'SetMark', 646 qq/"\cX\@m\\*"/, 'DoMetaVersion', 647 'C-y', 'Yank', 648 'C-z', 'Suspend', 649 'C-\\', 'Ding', 650 'C-^', 'Ding', 651 'C-_', 'Undo', 652 'DEL', ($inDOS ? 653 'BackwardKillWord' : # <Control>+<Backspace> 654 'BackwardDeleteChar' 655 ), 656 'M-<', 'BeginningOfHistory', 657 'M->', 'EndOfHistory', 658 'M-DEL', 'BackwardKillWord', 659 'M-C-h', 'BackwardKillWord', 660 'M-C-j', 'ViInput', 661 'M-C-v', 'QuotedInsert', 662 'M-b', 'BackwardWord', 663 'M-c', 'CapitalizeWord', 664 'M-d', 'KillWord', 665 'M-f', 'ForwardWord', 666 'M-h', 'PrintHistory', 667 'M-l', 'DownCaseWord', 668 'M-r', 'RevertLine', 669 'M-t', 'TransposeWords', 670 'M-u', 'UpcaseWord', 671 'M-v', 'HistorySearchBackward', 672 'M-y', 'YankPop', 673 "M-?", 'PossibleCompletions', 674 "M-TAB", 'TabInsert', 675 'M-#', 'SaveLine', 676 qq/"\e[A"/, 'previous-history', 677 qq/"\e[B"/, 'next-history', 678 qq/"\e[C"/, 'forward-char', 679 qq/"\e[D"/, 'backward-char', 680 qq/"\eOA"/, 'previous-history', 681 qq/"\eOB"/, 'next-history', 682 qq/"\eOC"/, 'forward-char', 683 qq/"\eOD"/, 'backward-char', 684 qq/"\eOy"/, 'HistorySearchBackward', # vt: PageUp 685 qq/"\eOs"/, 'HistorySearchForward', # vt: PageDown 686 qq/"\e[[A"/, 'previous-history', 687 qq/"\e[[B"/, 'next-history', 688 qq/"\e[[C"/, 'forward-char', 689 qq/"\e[[D"/, 'backward-char', 690 qq/"\e[2~"/, 'ToggleInsertMode', # X: <Insert> 691 # Mods: 1 + bitmask: 1 Shift, 2 Alt, 4 Control, 8 (sometimes) Meta 692 qq/"\e[2;2~"/, 'YankClipboard', # <Shift>+<Insert> 693 qq/"\e[3;2~"/, 'KillRegionClipboard', # <Shift>+<Delete> 694 #qq/"\0\16"/, 'Undo', # <Alt>+<Backspace> 695 qq/"\eO5D"/, 'BackwardWord', # <Ctrl>+<Left arrow> 696 qq/"\eO5C"/, 'ForwardWord', # <Ctrl>+<Right arrow> 697 qq/"\e[5D"/, 'BackwardWord', # <Ctrl>+<Left arrow> 698 qq/"\e[5C"/, 'ForwardWord', # <Ctrl>+<Right arrow> 699 qq/"\eO5F"/, 'KillLine', # <Ctrl>+<End> 700 qq/"\e[5F"/, 'KillLine', # <Ctrl>+<End> 701 qq/"\e[4;5~"/, 'KillLine', # <Ctrl>+<End> 702 qq/"\eO5s"/, 'EndOfHistory', # <Ctrl>+<Page Down> 703 qq/"\e[6;5~"/, 'EndOfHistory', # <Ctrl>+<Page Down> 704 qq/"\e[5H"/, 'BackwardKillLine', # <Ctrl>+<Home> 705 qq/"\eO5H"/, 'BackwardKillLine', # <Ctrl>+<Home> 706 qq/"\e[1;5~"/, 'BackwardKillLine', # <Ctrl>+<Home> 707 qq/"\eO5y"/, 'BeginningOfHistory', # <Ctrl>+<Page Up> 708 qq/"\e[5;5y"/, 'BeginningOfHistory', # <Ctrl>+<Page Up> 709 qq/"\e[2;5~"/, 'CopyRegionAsKillClipboard', # <Ctrl>+<Insert> 710 qq/"\e[3;5~"/, 'KillWord', # <Ctrl>+<Delete> 711 712 # XTerm mouse editing (f202/f203 not in mainstream yet): 713 # Paste may be: move f200 STRING f201 714 # or f202 move f200 STRING f201 f203; 715 # and Cut may be f202 move delete f203 716 qq/"\e[200~"/, 'BeginPasteGroup', # Pre-paste 717 qq/"\e[201~"/, 'EndPasteGroup', # Post-paste 718 qq/"\e[202~"/, 'BeginEditGroup', # Pre-edit 719 qq/"\e[203~"/, 'EndEditGroup', # Post-edit 720 721 # OSX xterm: 722 # OSX xterm: home \eOH end \eOF delete \e[3~ help \e[28~ f13 \e[25~ 723 # gray- \eOm gray+ \eOk gray-enter \eOM gray* \eOj gray/ \eOo gray= \eO 724 # grayClear \e\e. 725 726 qq/"\eOH"/, 'BeginningOfLine', # home 727 qq/"\eOF"/, 'EndOfLine', # end 728 729 # HP xterm 730 #qq/"\e[A"/, 'PreviousHistory', # up arrow 731 #qq/"\e[B"/, 'NextHistory', # down arrow 732 #qq/"\e[C"/, 'ForwardChar', # right arrow 733 #qq/"\e[D"/, 'BackwardChar', # left arrow 734 qq/"\e[H"/, 'BeginningOfLine', # home 735 #'C-k', 'KillLine', # clear display 736 qq/"\e[5~"/, 'HistorySearchBackward', # prev 737 qq/"\e[6~"/, 'HistorySearchForward', # next 738 qq/"\e[\0"/, 'BeginningOfLine', # home 739 740 # These contradict: 741 ($^O =~ /^hp\W?ux/i ? ( 742 qq/"\e[1~"/, 'HistorySearchForward', # find 743 qq/"\e[3~"/, 'ToggleInsertMode', # insert char 744 qq/"\e[4~"/, 'ToggleInsertMode', # select 745 ) : ( # "Normal" xterm 746 qq/"\e[1~"/, 'BeginningOfLine', # home 747 qq/"\e[3~"/, 'DeleteChar', # delete 748 qq/"\e[4~"/, 'EndOfLine', # end 749 )), 750 751 # hpterm 752 753 (($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ? 754 ( 755 qq/"\eA"/, 'PreviousHistory', # up arrow 756 qq/"\eB"/, 'NextHistory', # down arrow 757 qq/"\eC"/, 'ForwardChar', # right arrow 758 qq/"\eD"/, 'BackwardChar', # left arrow 759 qq/"\eS"/, 'BeginningOfHistory', # shift up arrow 760 qq/"\eT"/, 'EndOfHistory', # shift down arrow 761 qq/"\e&r1R"/, 'EndOfLine', # shift right arrow 762 qq/"\e&r1L"/, 'BeginningOfLine', # shift left arrow 763 qq/"\eJ"/, 'ClearScreen', # clear display 764 qq/"\eM"/, 'UnixLineDiscard', # delete line 765 qq/"\eK"/, 'KillLine', # clear line 766 qq/"\eG\eK"/, 'BackwardKillLine', # shift clear line 767 qq/"\eP"/, 'DeleteChar', # delete char 768 qq/"\eL"/, 'Yank', # insert line 769 qq/"\eQ"/, 'ToggleInsertMode', # insert char 770 qq/"\eV"/, 'HistorySearchBackward',# prev 771 qq/"\eU"/, 'HistorySearchForward',# next 772 qq/"\eh"/, 'BeginningOfLine', # home 773 qq/"\eF"/, 'EndOfLine', # shift home 774 qq/"\ei"/, 'Suspend', # shift tab 775 ) : 776 () 777 ), 778 ($inDOS ? 779 ( 780 qq/"\0\2"/, 'SetMark', # 2: <Control>+<Space> 781 qq/"\0\3"/, 'SetMark', # 3: <Control>+<@> 782 qq/"\0\4"/, 'YankClipboard', # 4: <Shift>+<Insert> 783 qq/"\0\5"/, 'KillRegionClipboard', # 5: <Shift>+<Delete> 784 qq/"\0\16"/, 'Undo', # 14: <Alt>+<Backspace> 785# qq/"\0\23"/, 'RevertLine', # 19: <Alt>+<R> 786# qq/"\0\24"/, 'TransposeWords', # 20: <Alt>+<T> 787# qq/"\0\25"/, 'YankPop', # 21: <Alt>+<Y> 788# qq/"\0\26"/, 'UpcaseWord', # 22: <Alt>+<U> 789# qq/"\0\31"/, 'ReverseSearchHistory', # 25: <Alt>+<P> 790# qq/"\0\40"/, 'KillWord', # 32: <Alt>+<D> 791# qq/"\0\41"/, 'ForwardWord', # 33: <Alt>+<F> 792# qq/"\0\46"/, 'DownCaseWord', # 38: <Alt>+<L> 793 #qq/"\0\51"/, 'TildeExpand', # 41: <Alt>+<\'> 794# qq/"\0\56"/, 'CapitalizeWord', # 46: <Alt>+<C> 795# qq/"\0\60"/, 'BackwardWord', # 48: <Alt>+<B> 796# qq/"\0\61"/, 'ForwardSearchHistory', # 49: <Alt>+<N> 797 #qq/"\0\64"/, 'YankLastArg', # 52: <Alt>+<.> 798 qq/"\0\65"/, 'PossibleCompletions', # 53: <Alt>+</> 799 qq/"\0\107"/, 'BeginningOfLine', # 71: <Home> 800 qq/"\0\110"/, 'previous-history', # 72: <Up arrow> 801 qq/"\0\111"/, 'HistorySearchBackward', # 73: <Page Up> 802 qq/"\0\113"/, 'backward-char', # 75: <Left arrow> 803 qq/"\0\115"/, 'forward-char', # 77: <Right arrow> 804 qq/"\0\117"/, 'EndOfLine', # 79: <End> 805 qq/"\0\120"/, 'next-history', # 80: <Down arrow> 806 qq/"\0\121"/, 'HistorySearchForward', # 81: <Page Down> 807 qq/"\0\122"/, 'ToggleInsertMode', # 82: <Insert> 808 qq/"\0\123"/, 'DeleteChar', # 83: <Delete> 809 qq/"\0\163"/, 'BackwardWord', # 115: <Ctrl>+<Left arrow> 810 qq/"\0\164"/, 'ForwardWord', # 116: <Ctrl>+<Right arrow> 811 qq/"\0\165"/, 'KillLine', # 117: <Ctrl>+<End> 812 qq/"\0\166"/, 'EndOfHistory', # 118: <Ctrl>+<Page Down> 813 qq/"\0\167"/, 'BackwardKillLine', # 119: <Ctrl>+<Home> 814 qq/"\0\204"/, 'BeginningOfHistory', # 132: <Ctrl>+<Page Up> 815 qq/"\0\x92"/, 'CopyRegionAsKillClipboard', # 146: <Ctrl>+<Insert> 816 qq/"\0\223"/, 'KillWord', # 147: <Ctrl>+<Delete> 817 qq/"\0#"/, 'PrintHistory', # Alt-H 818 ) 819 : ( 'C-@', 'Ding') 820 ) 821 ); 822 823 *KeyMap = *emacs_keymap; 824 my @add_bindings = (); 825 foreach ('-', '0' .. '9') { push(@add_bindings, "M-$_", 'DigitArgument'); } 826 foreach ("A" .. "Z") { 827 next if # defined($KeyMap[27]) && defined (%{"$KeyMap{name}_27"}) && 828 defined $ {"$KeyMap{name}_27"}[ord $_]; 829 push(@add_bindings, "M-$_", 'DoLowercaseVersion'); 830 } 831 if ($inDOS) { 832 # Default translation of Alt-char 833 $ {"$KeyMap{name}_0"}{'Esc'} = *{"$KeyMap{name}_27"}; 834 $ {"$KeyMap{name}_0"}{'default'} = 'F_DoEscVersion'; 835 } 836 &rl_bind(@add_bindings); 837 838 # Vi input mode. 839 &InitKeymap(*vi_keymap, 'SelfInsert', 'vi_keymap', 840 841 "\e", 'ViEndInsert', 842 'C-c', 'Interrupt', 843 'C-h', 'BackwardDeleteChar', 844 'C-w', 'UnixWordRubout', 845 'C-u', 'UnixLineDiscard', 846 'C-v', 'QuotedInsert', 847 'DEL', 'BackwardDeleteChar', 848 "\n", 'ViAcceptInsert', 849 "\r", 'ViAcceptInsert', 850 ); 851 852 # Vi command mode. 853 &InitKeymap(*vicmd_keymap, 'Ding', 'vicmd_keymap', 854 855 'C-c', 'Interrupt', 856 'C-e', 'EmacsEditingMode', 857 'C-h', 'ViMoveCursor', 858 'C-l', 'ClearScreen', 859 "\n", 'ViAcceptLine', 860 "\r", 'ViAcceptLine', 861 862 ' ', 'ViMoveCursor', 863 '#', 'SaveLine', 864 '$', 'ViMoveCursor', 865 '%', 'ViMoveCursor', 866 '*', 'ViInsertPossibleCompletions', 867 '+', 'NextHistory', 868 ',', 'ViMoveCursor', 869 '-', 'PreviousHistory', 870 '.', 'ViRepeatLastCommand', 871 '/', 'ViSearch', 872 873 '0', 'ViMoveCursor', 874 '1', 'ViDigit', 875 '2', 'ViDigit', 876 '3', 'ViDigit', 877 '4', 'ViDigit', 878 '5', 'ViDigit', 879 '6', 'ViDigit', 880 '7', 'ViDigit', 881 '8', 'ViDigit', 882 '9', 'ViDigit', 883 884 ';', 'ViMoveCursor', 885 '=', 'ViPossibleCompletions', 886 '?', 'ViSearch', 887 888 'A', 'ViAppendLine', 889 'B', 'ViMoveCursor', 890 'C', 'ViChangeLine', 891 'D', 'ViDeleteLine', 892 'E', 'ViMoveCursor', 893 'F', 'ViMoveCursor', 894 'G', 'ViHistoryLine', 895 'H', 'PrintHistory', 896 'I', 'ViBeginInput', 897 'N', 'ViRepeatSearch', 898 'P', 'ViPutBefore', 899 'R', 'ViReplaceMode', 900 'S', 'ViChangeEntireLine', 901 'T', 'ViMoveCursor', 902 'U', 'ViUndoAll', 903 'W', 'ViMoveCursor', 904 'X', 'ViBackwardDeleteChar', 905 'Y', 'ViYankLine', 906 907 '\\', 'ViComplete', 908 '^', 'ViMoveCursor', 909 910 'a', 'ViAppend', 911 'b', 'ViMoveCursor', 912 'c', 'ViChange', 913 'd', 'ViDelete', 914 'e', 'ViMoveCursor', 915 'f', 'ViMoveCursorFind', 916 'h', 'ViMoveCursor', 917 'i', 'ViInput', 918 'j', 'NextHistory', 919 'k', 'PreviousHistory', 920 'l', 'ViMoveCursor', 921 'n', 'ViRepeatSearch', 922 'p', 'ViPut', 923 'r', 'ViReplaceChar', 924 's', 'ViChangeChar', 925 't', 'ViMoveCursorTo', 926 'u', 'ViUndo', 927 'w', 'ViMoveCursor', 928 'x', 'ViDeleteChar', 929 'y', 'ViYank', 930 931 '|', 'ViMoveCursor', 932 '~', 'ViToggleCase', 933 934 (($inDOS 935 and (not $ENV{'TERM'} or $ENV{'TERM'} !~ /^(vt|xterm)/i)) ? 936 ( 937 qq/"\0\110"/, 'PreviousHistory', # 72: <Up arrow> 938 qq/"\0\120"/, 'NextHistory', # 80: <Down arrow> 939 qq/"\0\113"/, 'BackwardChar', # 75: <Left arrow> 940 qq/"\0\115"/, 'ForwardChar', # 77: <Right arrow> 941 "\e", 'ViCommandMode', 942 ) : 943 944 (('M-C-j','EmacsEditingMode'), # Conflicts with \e otherwise 945 (($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ? 946 ( 947 qq/"\eA"/, 'PreviousHistory', # up arrow 948 qq/"\eB"/, 'NextHistory', # down arrow 949 qq/"\eC"/, 'ForwardChar', # right arrow 950 qq/"\eD"/, 'BackwardChar', # left arrow 951 qq/"\e\\*"/, 'ViAfterEsc', 952 ) : 953 954 # Default 955 ( 956 qq/"\e[A"/, 'PreviousHistory', # up arrow 957 qq/"\e[B"/, 'NextHistory', # down arrow 958 qq/"\e[C"/, 'ForwardChar', # right arrow 959 qq/"\e[D"/, 'BackwardChar', # left arrow 960 qq/"\e\\*"/, 'ViAfterEsc', 961 qq/"\e[\\*"/, 'ViAfterEsc', 962 ) 963 ))), 964 ); 965 966 # Vi positioning commands (suffixed to vi commands like 'd'). 967 &InitKeymap(*vipos_keymap, 'ViNonPosition', 'vipos_keymap', 968 969 '^', 'ViFirstWord', 970 '0', 'BeginningOfLine', 971 '1', 'ViDigit', 972 '2', 'ViDigit', 973 '3', 'ViDigit', 974 '4', 'ViDigit', 975 '5', 'ViDigit', 976 '6', 'ViDigit', 977 '7', 'ViDigit', 978 '8', 'ViDigit', 979 '9', 'ViDigit', 980 '$', 'EndOfLine', 981 'h', 'BackwardChar', 982 'l', 'ForwardChar', 983 ' ', 'ForwardChar', 984 'C-h', 'BackwardChar', 985 'f', 'ViForwardFindChar', 986 'F', 'ViBackwardFindChar', 987 't', 'ViForwardToChar', 988 'T', 'ViBackwardToChar', 989 ';', 'ViRepeatFindChar', 990 ',', 'ViInverseRepeatFindChar', 991 '%', 'ViFindMatchingParens', 992 '|', 'ViMoveToColumn', 993 994 # Arrow keys 995 ($inDOS ? 996 ( 997 qq/"\0\115"/, 'ForwardChar', # 77: <Right arrow> 998 qq/"\0\113"/, 'BackwardChar', # 75: <Left arrow> 999 "\e", 'ViPositionEsc', 1000 ) : 1001 1002 ($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ? 1003 ( 1004 qq/"\eC"/, 'ForwardChar', # right arrow 1005 qq/"\eD"/, 'BackwardChar', # left arrow 1006 qq/"\e\\*"/, 'ViPositionEsc', 1007 ) : 1008 1009 # Default 1010 ( 1011 qq/"\e[C"/, 'ForwardChar', # right arrow 1012 qq/"\e[D"/, 'BackwardChar', # left arrow 1013 qq/"\e\\*"/, 'ViPositionEsc', 1014 qq/"\e[\\*"/, 'ViPositionEsc', 1015 ) 1016 ), 1017 ); 1018 1019 # Vi search string input mode for '/' and '?'. 1020 &InitKeymap(*visearch_keymap, 'SelfInsert', 'visearch_keymap', 1021 1022 "\e", 'Ding', 1023 'C-c', 'Interrupt', 1024 'C-h', 'ViSearchBackwardDeleteChar', 1025 'C-w', 'UnixWordRubout', 1026 'C-u', 'UnixLineDiscard', 1027 'C-v', 'QuotedInsert', 1028 'DEL', 'ViSearchBackwardDeleteChar', 1029 "\n", 'ViEndSearch', 1030 "\r", 'ViEndSearch', 1031 ); 1032 1033 # These constant hashes hold the arguments to &forward_scan() or 1034 # &backward_scan() for vi positioning commands, which all 1035 # behave a little differently for delete, move, change, and yank. 1036 # 1037 # Note: I originally coded these as qr{}, but changed them to q{} for 1038 # compatibility with older perls at the expense of some performance. 1039 # 1040 # Note: Some of the more obscure key combinations behave slightly 1041 # differently in different vi implementation. This module matches 1042 # the behavior of /usr/ucb/vi, which is different from the 1043 # behavior of vim, nvi, and the ksh command line. One example is 1044 # the command '2de', when applied to the string ('^' represents the 1045 # cursor, not a character of the string): 1046 # 1047 # ^5.6 7...88888888 1048 # 1049 # With /usr/ucb/vi and with this module, the result is 1050 # 1051 # ^...88888888 1052 # 1053 # but with the other three vi implementations, the result is 1054 # 1055 # ^ 7...88888888 1056 1057 $Vi_delete_patterns = { 1058 ord('w') => q{(?:\w+|[^\w\s]+|)\s*}, 1059 ord('W') => q{\S*\s*}, 1060 ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+}, 1061 ord('B') => q{\S+\s*|^\s+}, 1062 ord('e') => q{.\s*\w+|.\s*[^\w\s]+|.\s*$}, 1063 ord('E') => q{.\s*\S+|.\s*$}, 1064 }; 1065 1066 $Vi_move_patterns = { 1067 ord('w') => q{(?:\w+|[^\w\s]+|)\s*}, 1068 ord('W') => q{\S*\s*}, 1069 ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+}, 1070 ord('B') => q{\S+\s*|^\s+}, 1071 ord('e') => q{.\s*\w*(?=\w)|.\s*[^\w\s]*(?=[^\w\s])|.?\s*(?=\s$)}, 1072 ord('E') => q{.\s*\S*(?=\S)|.?\s*(?=\s$)}, 1073 }; 1074 1075 $Vi_change_patterns = { 1076 ord('w') => q{\w+|[^\w\s]+|\s}, 1077 ord('W') => q{\S+|\s}, 1078 ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+}, 1079 ord('B') => q{\S+\s*|^\s+}, 1080 ord('e') => q{.\s*\w+|.\s*[^\w\s]+|.\s*$}, 1081 ord('E') => q{.\s*\S+|.\s*$}, 1082 }; 1083 1084 $Vi_yank_patterns = { 1085 ord('w') => q{(?:\w+|[^\w\s]+|)\s*}, 1086 ord('W') => q{\S*\s*}, 1087 ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+}, 1088 ord('B') => q{\S+\s*|^\s+}, 1089 ord('e') => q{.\s*\w*(?=\w)|.\s*[^\w\s]*(?=[^\w\s])|.?\s*(?=\s$)}, 1090 ord('E') => q{.\s*\S*(?=\S)|.?\s*(?=\s$)}, 1091 }; 1092 1093 my $default_mode = 'emacs'; 1094 1095 *KeyMap = $var_EditingMode = $var_EditingMode{$default_mode}; 1096 1097## my $name; 1098## for $name ( keys %{'readline::'} ) { 1099## # Create aliases accessible via tied interface 1100## *{"rl_$1"} = \$ {"var_$1"} if $name =~ /$var_(.*)/; 1101## } 1102 1103 1; # Returning a glob causes a bug in db5.001m 1104} 1105 1106sub init 1107{ 1108 if ($ENV{'TERM'} and ($ENV{'TERM'} eq 'emacs' || $ENV{'TERM'} eq 'dumb')) { 1109 $dumb_term = 1; 1110 } elsif (! -c $term_IN && $term_IN eq \*STDIN) { # Believe if it is given 1111 $stdin_not_tty = 1; 1112 } else { 1113 &get_window_size; 1114 &F_ReReadInitFile if !defined($rl_NoInitFromFile); 1115 $InputLocMsg = ''; 1116 *KeyMap = $var_EditingMode; 1117 } 1118 1119 $initialized = 1; 1120} 1121 1122 1123## 1124## InitKeymap(*keymap, 'default', 'name', bindings.....) 1125## 1126sub InitKeymap 1127{ 1128 local(*KeyMap) = shift(@_); 1129 my $default = shift(@_); 1130 my $name = $KeyMap{'name'} = shift(@_); 1131 1132 # 'default' is now optional - if '', &do_command() defaults it to 1133 # 'F_Ding'. Meta-maps now don't set a default - this lets 1134 # us detect multiple '\*' default declarations. JP 1135 if ($default ne '') { 1136 my $func = $KeyMap{'default'} = "F_$default"; 1137 ### Temporarily disabled 1138 die qq/Bad default function [$func] for keymap "$name"/ 1139 if !$autoload_broken and !defined(&$func); 1140 } 1141 1142 &rl_bind if @_ > 0; ## The rest of @_ gets passed silently. 1143} 1144 1145## 1146## Accepts an array as pairs ($keyspec, $function, [$keyspec, $function]...). 1147## and maps the associated bindings to the current KeyMap. 1148## 1149## keyspec should be the name of key sequence in one of two forms: 1150## 1151## Old (GNU readline documented) form: 1152## M-x to indicate Meta-x 1153## C-x to indicate Ctrl-x 1154## M-C-x to indicate Meta-Ctrl-x 1155## x simple char x 1156## where 'x' above can be a single character, or the special: 1157## special means 1158## -------- ----- 1159## space space ( ) 1160## spc space ( ) 1161## tab tab (\t) 1162## del delete (0x7f) 1163## rubout delete (0x7f) 1164## newline newline (\n) 1165## lfd newline (\n) 1166## ret return (\r) 1167## return return (\r) 1168## escape escape (\e) 1169## esc escape (\e) 1170## 1171## New form: 1172## "chars" (note the required double-quotes) 1173## where each char in the list represents a character in the sequence, except 1174## for the special sequences: 1175## \\C-x Ctrl-x 1176## \\M-x Meta-x 1177## \\M-C-x Meta-Ctrl-x 1178## \\e escape. 1179## \\x x (if not one of the above) 1180## 1181## 1182## FUNCTION should be in the form 'BeginningOfLine' or 'beginning-of-line'. 1183## It is an error for the function to not be known.... 1184## 1185## As an example, the following lines in .inputrc will bind one's xterm 1186## arrow keys: 1187## "\e[[A": previous-history 1188## "\e[[B": next-history 1189## "\e[[C": forward-char 1190## "\e[[D": backward-char 1191## 1192 1193sub filler_Pending ($) { 1194 my $keys = shift; 1195 sub { 1196 my $c = shift; 1197 push @Pending, map chr, @$keys; 1198 return if not @$keys or $c == 1 or not defined(my $in = &getc_with_pending); 1199 # provide the numeric argument 1200 local(*KeyMap) = $var_EditingMode; 1201 $doingNumArg = 1; # Allow NumArg inside NumArg 1202 &do_command(*KeyMap, $c, ord $in); 1203 return; 1204 } 1205} 1206 1207sub _unescape ($) { 1208 my($key, @keys) = shift; 1209 ## New-style bindings are enclosed in double-quotes. 1210 ## Characters are taken verbatim except the special cases: 1211 ## \C-x Control x (for any x) 1212 ## \M-x Meta x (for any x) 1213 ## \e Escape 1214 ## \* Set the keymap default (JP: added this) 1215 ## (must be the last character of the sequence) 1216 ## 1217 ## \x x (unless it fits the above pattern) 1218 ## 1219 ## Look for special case of "\C-\M-x", which should be treated 1220 ## like "\M-\C-x". 1221 1222 while (length($key) > 0) { 1223 1224 # JP: fixed regex bugs below: changed all 's#' to 's#^' 1225 1226 if ($key =~ s#^\\C-\\M-(.)##) { 1227 push(@keys, ord("\e"), &ctrl(ord($1))); 1228 } elsif ($key =~ s#^\\(M-|e)##) { 1229 push(@keys, ord("\e")); 1230 } elsif ($key =~ s#^\\C-(.)##) { 1231 push(@keys, &ctrl(ord($1))); 1232 } elsif ($key =~ s#^\\x([0-9a-fA-F]{2})##) { 1233 push(@keys, eval('0x'.$1)); 1234 } elsif ($key =~ s#^\\([0-7]{3})##) { 1235 push(@keys, eval('0'.$1)); 1236 } elsif ($key =~ s#^\\\*$##) { # JP: added 1237 push(@keys, 'default'); 1238 } elsif ($key =~ s#^\\([afnrtv])##) { 1239 push(@keys, ord(eval(qq("\\$1")))); 1240 } elsif ($key =~ s#^\\d##) { 1241 push(@keys, 4); # C-d 1242 } elsif ($key =~ s#^\\b##) { 1243 push(@keys, 0x7f); # Backspace 1244 } elsif ($key =~ s#^\\(.)##) { 1245 push(@keys, ord($1)); 1246 } else { 1247 push(@keys, ord($key)); 1248 substr($key,0,1) = ''; 1249 } 1250 } 1251 @keys 1252} 1253 1254sub RL_func ($) { 1255 my $name_or_macro = shift; 1256 if ($name_or_macro =~ /^"((?:\\.|[^\\\"])*)"|^'((?:\\.|[^\\\'])*)'/s) { 1257 filler_Pending [_unescape "$+"]; 1258 } else { 1259 "F_$name_or_macro"; 1260 } 1261} 1262 1263sub actually_do_binding 1264{ 1265 ## 1266 ## actually_do_binding($function1, \@sequence1, ...) 1267 ## 1268 ## Actually inserts the binding for @sequence to $function into the 1269 ## current map. @sequence is an array of character ordinals. 1270 ## 1271 ## If @sequence is more than one element long, all but the last will 1272 ## cause meta maps to be created. 1273 ## 1274 ## $Function will have an implicit "F_" prepended to it. 1275 ## 1276 while (@_) { 1277 my $func = shift; 1278 my ($key, @keys) = @{shift()}; 1279 $key += 0; 1280 local(*KeyMap) = *KeyMap; 1281 my $map; 1282 while (@keys) { 1283 if (defined($KeyMap[$key]) && ($KeyMap[$key] ne 'F_PrefixMeta')) { 1284 warn "Warning$InputLocMsg: ". 1285 "Re-binding char #$key from [$KeyMap[$key]] to meta for [@keys] => $func.\n" if $^W; 1286 } 1287 $KeyMap[$key] = 'F_PrefixMeta'; 1288 $map = "$KeyMap{'name'}_$key"; 1289 InitKeymap(*$map, '', $map) if !(%$map); 1290 *KeyMap = *$map; 1291 $key = shift @keys; 1292 #&actually_do_binding($func, \@keys); 1293 } 1294 1295 my $name = $KeyMap{'name'}; 1296 if ($key eq 'default') { # JP: added 1297 warn "Warning$InputLocMsg: ". 1298 " changing default action to $func in $name key map\n" 1299 if $^W && defined $KeyMap{'default'}; 1300 1301 $KeyMap{'default'} = RL_func $func; 1302 } 1303 else { 1304 if (defined($KeyMap[$key]) && $KeyMap[$key] eq 'F_PrefixMeta' 1305 && $func ne 'PrefixMeta') 1306 { 1307 warn "Warning$InputLocMsg: ". 1308 " Re-binding char #$key to non-meta ($func) in $name key map\n" 1309 if $^W; 1310 } 1311 $KeyMap[$key] = RL_func $func; 1312 } 1313 } 1314} 1315 1316sub rl_bind 1317{ 1318 my (@keys, $key, $func, $ord, @arr); 1319 1320 while (defined($key = shift(@_)) && defined($func = shift(@_))) 1321 { 1322 ## 1323 ## Change the function name from something like 1324 ## backward-kill-line 1325 ## to 1326 ## BackwardKillLine 1327 ## if not already there. 1328 ## 1329 unless ($func =~ /^[\"\']/) { 1330 $func = "\u$func"; 1331 $func =~ s/-(.)/\u$1/g; 1332 1333 # Temporary disabled 1334 if (!$autoload_broken and !defined($ {'readline::'}{"F_$func"})) { 1335 warn "Warning$InputLocMsg: bad bind function [$func]\n" if $^W; 1336 next; 1337 } 1338 } 1339 1340 ## print "sequence [$key] func [$func]\n"; ##DEBUG 1341 1342 @keys = (); 1343 ## See if it's a new-style binding. 1344 if ($key =~ m/"((?:\\.|[^\\])*)"/s) { 1345 @keys = _unescape "$1"; 1346 } else { 1347 ## ol-dstyle binding... only one key (or Meta+key) 1348 my ($isctrl, $orig) = (0, $key); 1349 $isctrl = $key =~ s/\b(C|Control|CTRL)-//i; 1350 push(@keys, ord("\e")) if $key =~ s/\b(M|Meta)-//i; ## is meta? 1351 ## Isolate key part. This matches GNU's implementation. 1352 ## If the key is '-', be careful not to delete it! 1353 $key =~ s/.*-(.)/$1/; 1354 if ($key =~ /^(space|spc)$/i) { $key = ' '; } 1355 elsif ($key =~ /^(rubout|del)$/i) { $key = "\x7f"; } 1356 elsif ($key =~ /^tab$/i) { $key = "\t"; } 1357 elsif ($key =~ /^(return|ret)$/i) { $key = "\r"; } 1358 elsif ($key =~ /^(newline|lfd)$/i) { $key = "\n"; } 1359 elsif ($key =~ /^(escape|esc)$/i) { $key = "\e"; } 1360 elsif (length($key) > 1) { 1361 warn "Warning$InputLocMsg: strange binding [$orig]\n" if $^W; 1362 } 1363 $key = ord($key); 1364 $key = &ctrl($key) if $isctrl; 1365 push(@keys, $key); 1366 } 1367 1368 # 1369 ## Now do the mapping of the sequence represented in @keys 1370 # 1371 # print "&actually_do_binding($func, @keys)\n"; ##DEBUG 1372 push @arr, $func, [@keys]; 1373 #&actually_do_binding($func, \@keys); 1374 } 1375 &actually_do_binding(@arr); 1376} 1377 1378sub read_an_init_file { 1379 my $file = shift; 1380 my $include_depth = shift; 1381 local *RC; 1382 $file =~ s/^~([\\\/])/$ENV{HOME}$1/ if not -f $file and exists $ENV{HOME}; 1383 return unless open RC, "< $file"; 1384 my (@action) = ('exec'); ## exec, skip, ignore (until appropriate endif) 1385 my (@level) = (); ## if, else 1386 1387 local $/ = "\n"; 1388 while (<RC>) { 1389 s/^\s+//; 1390 next if m/^\s*(#|$)/; 1391 $InputLocMsg = " [$file line $.]"; 1392 if (/^\$if\s+(.*)/) { 1393 my($test) = $1; 1394 push(@level, 'if'); 1395 if ($action[$#action] ne 'exec') { 1396 ## We're supposed to be skipping or ignoring this level, 1397 ## so for subsequent levels we really ignore completely. 1398 push(@action, 'ignore'); 1399 } else { 1400 ## We're executing this IF... do the test. 1401 ## The test is either "term=xxxx", or just a string that 1402 ## we compare to $rl_readline_name; 1403 if ($test =~ /term=([a-z0-9]+)/) { 1404 $test = ($ENV{'TERM'} && $1 eq $ENV{'TERM'}); 1405 } else { 1406 $test = $test =~ /^(perl|$rl_readline_name)\s*$/i; 1407 } 1408 push(@action, $test ? 'exec' : 'skip'); 1409 } 1410 next; 1411 } elsif (/^\$endif\b/) { 1412 die qq/\rWarning$InputLocMsg: unmatched endif\n/ if @level == 0; 1413 pop(@level); 1414 pop(@action); 1415 next; 1416 } elsif (/^\$else\b/) { 1417 die qq/\rWarning$InputLocMsg: unmatched else\n/ if 1418 @level == 0 || $level[$#level] ne 'if'; 1419 $level[$#level] = 'else'; ## an IF turns into an ELSE 1420 if ($action[$#action] eq 'skip') { 1421 $action[$#action] = 'exec'; ## if were SKIPing, now EXEC 1422 } else { 1423 $action[$#action] = 'ignore'; ## otherwise, just IGNORE. 1424 } 1425 next; 1426 } elsif (/^\$include\s+(\S+)/) { 1427 if ($include_depth > $max_include_depth) { 1428 warn "Deep recursion in \$include directives in $file.\n"; 1429 } else { 1430 read_an_init_file($1, $include_depth + 1); 1431 } 1432 } elsif ($action[$#action] ne 'exec') { 1433 ## skipping this one.... 1434 # readline permits trailing comments in inputrc 1435 # this seems to solve the warnings caused by trailing comments in the 1436 # default /etc/inputrc on Mandrake Linux boxes. 1437 } elsif (m/\s*set\s+(\S+)\s+(\S*)/) { # Allow trailing comment 1438 &rl_set($1, $2, $file); 1439 } elsif (m/^\s*(\S+):\s+("(?:\\.|[^\\\"])*"|'(\\.|[^\\\'])*')/) { # Allow trailing comment 1440 &rl_bind($1, $2); 1441 } elsif (m/^\s*(\S+):\s+(\S+)/) { # Allow trailing comment 1442 &rl_bind($1, $2); 1443 } else { 1444 chomp; 1445 warn "\rWarning$InputLocMsg: Bad line [$_]\n" if $^W; 1446 } 1447 } 1448 close(RC); 1449} 1450 1451sub F_ReReadInitFile 1452{ 1453 my ($file) = $ENV{'TRP_INPUTRC'}; 1454 $file = $ENV{'INPUTRC'} unless defined $file; 1455 unless (defined $file) { 1456 return unless defined $ENV{'HOME'}; 1457 $file = "$ENV{'HOME'}/.inputrc"; 1458 } 1459 read_an_init_file($file, 0); 1460} 1461 1462sub get_ornaments_selected { 1463 return if @$rl_term_set >= 6; 1464 local $^W=0; 1465 my $Orig = $Term::ReadLine::Perl::term->ornaments(); 1466 eval { 1467 # Term::ReadLine does not expose its $terminal, so make another 1468 require Term::Cap; 1469 my $terminal = Tgetent Term::Cap ({OSPEED=>9600}); 1470 # and be sure the terminal supports highlighting 1471 $terminal->Trequire('mr'); 1472 }; 1473 if (!$@ and $Orig ne ',,,'){ 1474 my @set = @$rl_term_set; 1475 1476 $Term::ReadLine::Perl::term->ornaments 1477 (join(',', (split(/,/, $Orig))[0,1]) . ',mr,me') ; 1478 @set[4,5] = @$rl_term_set[2,3]; 1479 $Term::ReadLine::Perl::term->ornaments($Orig); 1480 @$rl_term_set = @set; 1481 } else { 1482 @$rl_term_set[4,5] = @$rl_term_set[2,3]; 1483 } 1484} 1485 1486sub readline_dumb { 1487 local $\ = ''; 1488 print $term_OUT $prompt; 1489 local $/ = "\n"; 1490 return undef 1491 if !defined($line = $Term::ReadLine::Perl::term->get_line); 1492 chomp($line); 1493 $| = $oldbar; 1494 select $old; 1495 return $line; 1496} 1497 1498## 1499## This is it. Called as &readline'readline($prompt, $default), 1500## (DEFAULT can be omitted) the next input line is returned (undef on EOF). 1501## 1502sub readline 1503{ 1504 $Term::ReadLine::Perl::term->register_Tk 1505 if not $Term::ReadLine::registered and $Term::ReadLine::toloop 1506 and defined &Tk::DoOneEvent; 1507 if ($stdin_not_tty) { 1508 local $/ = "\n"; 1509 return undef if !defined($line = <$term_IN>); 1510 chomp($line); 1511 return $line; 1512 } 1513 1514 $old = select $term_OUT; 1515 $oldbar = $|; 1516 local($|) = 1; 1517 local($input); 1518 1519 ## prompt should be given to us.... 1520 $prompt = defined($_[0]) ? $_[0] : 'INPUT> '; 1521 1522 # Try to move cursor to the beginning of the next line if this line 1523 # contains anything. 1524 1525 # On DOSish 80-wide console 1526 # perl -we "print 1 x shift, qq(\b2\r3); sleep 2" 79 1527 # prints 3 on the same line, 1528 # perl -we "print 1 x shift, qq(\b2\r3); sleep 2" 80 1529 # on the next; $rl_screen_width is 79. 1530 1531 # on XTerm one needs to increase the number by 1. 1532 1533 print $term_OUT ' ' x ($rl_screen_width - !$rl_last_pos_can_backspace) . "\b \r" 1534 if $rl_scroll_nextline; 1535 1536 if ($dumb_term) { 1537 return readline_dumb; 1538 } 1539 1540 # test if we resume an 'Operate' command 1541 if ($rl_OperateCount > 0 && (!defined $_[1] || $_[1] eq '')) { 1542 ## it's from a valid previous 'Operate' command and 1543 ## user didn't give a default line 1544 ## we leave $rl_HistoryIndex untouched 1545 $line = $rl_History[$rl_HistoryIndex]; 1546 } else { 1547 ## set history pointer at the end of history 1548 $rl_HistoryIndex = $#rl_History + 1; 1549 $rl_OperateCount = 0; 1550 $line = defined $_[1] ? $_[1] : ''; 1551 } 1552 $rl_OperateCount-- if $rl_OperateCount > 0; 1553 1554 $line_for_revert = $line; 1555 1556# I don't think we need to do this, actually... 1557# while (&ioctl(STDIN,$FIONREAD,$fion)) 1558# { 1559# local($n_chars_available) = unpack ($fionread_t, $fion); 1560# ## print "n_chars = $n_chars_available\n"; 1561# last if $n_chars_available == 0; 1562# $line .= getc_with_pending; # should we prepend if $rl_start_default_at_beginning? 1563# } 1564 1565 $D = $rl_start_default_at_beginning ? 0 : length($line); ## set dot. 1566 $LastCommandKilledText = 0; ## heck, was no last command. 1567 $lastcommand = ''; ## Well, there you go. 1568 $line_rl_mark = -1; 1569 1570 ## 1571 ## some stuff for &redisplay. 1572 ## 1573 $lastredisplay = ''; ## Was no last redisplay for this time. 1574 $lastlen = length($lastredisplay); 1575 $lastpromptlen = 0; 1576 $lastdelta = 0; ## Cursor was nowhere 1577 $si = 0; ## Want line to start left-justified 1578 $force_redraw = 1; ## Want to display with brute force. 1579 if (!eval {SetTTY()}) { ## Put into raw mode. 1580 warn $@ if $@; 1581 $dumb_term = 1; 1582 return readline_dumb; 1583 } 1584 1585 *KeyMap = $var_EditingMode; 1586 undef($AcceptLine); ## When set, will return its value. 1587 undef($ReturnEOF); ## ...unless this on, then return undef. 1588 @Pending = (); ## Contains characters to use as input. 1589 @undo = (); ## Undo history starts empty for each line. 1590 @undoGroupS = (); ## Undo groups start empty for each line. 1591 undef $memorizedArg; ## No digitArgument memorized 1592 undef $memorizedPos; ## No position memorized 1593 1594 undef $Vi_undo_state; 1595 undef $Vi_undo_all_state; 1596 1597 # We need to do some additional initialization for vi mode. 1598 # RS: bug reports/platform issues are welcome: russ@dvns.com 1599 if ($KeyMap{'name'} eq 'vi_keymap'){ 1600 &F_ViInput(); 1601 if ($rl_vi_replace_default_on_insert){ 1602 local $^W=0; 1603 my $Orig = $Term::ReadLine::Perl::term->ornaments(); 1604 eval { 1605 # Term::ReadLine does not expose its $terminal, so make another 1606 require Term::Cap; 1607 my $terminal = Tgetent Term::Cap ({OSPEED=>9600}); 1608 # and be sure the terminal supports highlighting 1609 $terminal->Trequire('mr'); 1610 }; 1611 if (!$@ and $Orig ne ',,,'){ 1612 $Term::ReadLine::Perl::term->ornaments 1613 (join(',', (split(/,/, $Orig))[0,1]) . ',mr,me') 1614 } 1615 my $F_SelfInsert_Real = \&F_SelfInsert; 1616 *F_SelfInsert = sub { 1617 $Term::ReadLine::Perl::term->ornaments($Orig); 1618 &F_ViChangeEntireLine; 1619 local $^W=0; 1620 *F_SelfInsert = $F_SelfInsert_Real; 1621 &F_SelfInsert; 1622 }; 1623 my $F_ViEndInsert_Real = \&F_ViEndInsert; 1624 *F_ViEndInsert = sub { 1625 $Term::ReadLine::Perl::term->ornaments($Orig); 1626 local $^W=0; 1627 *F_SelfInsert = $F_SelfInsert_Real; 1628 *F_ViEndInsert = $F_ViEndInsert_Real; 1629 &F_ViEndInsert; 1630 $force_redraw = 1; 1631 redisplay(); 1632 }; 1633 } 1634 } 1635 1636 if ($rl_default_selected) { 1637 redisplay_high(); 1638 } else { 1639 &redisplay(); ## Show the line (prompt+default at this point). 1640 } 1641 1642 # pretend input if we 'Operate' on more than one line 1643 &F_OperateAndGetNext($rl_OperateCount) if $rl_OperateCount > 0; 1644 1645 $rl_first_char = 1; 1646 while (!defined($AcceptLine)) { 1647 ## get a character of input 1648 $input = &getc_with_pending(); # bug in debugger, returns 42. - No more! 1649 1650 unless (defined $input) { 1651 # XXX What to do??? Until this is clear, just pretend we got EOF 1652 $AcceptLine = $ReturnEOF = 1; 1653 last; 1654 } 1655 preserve_state(); 1656 1657 $ThisCommandKilledText = 0; 1658 ##print "\n\rline is @$D:[$line]\n\r"; ##DEBUG 1659 my $cmd = get_command($var_EditingMode, ord($input)); 1660 if ( $rl_first_char && $cmd =~ /^F_(SelfInsert$|Yank)/ 1661 && length $line && $rl_default_selected ) { 1662 # (Backward)?DeleteChar specialcased in the code 1663 $line = ''; 1664 $D = 0; 1665 $cmd = 'F_BackwardDeleteChar' if $cmd eq 'F_DeleteChar'; 1666 } 1667 undef $doingNumArg; 1668 &$cmd(1, ord($input)); ## actually execute input 1669 $rl_first_char = 0; 1670 $lastcommand = $cmd; 1671 *KeyMap = $var_EditingMode; # JP: added 1672 1673 # In Vi command mode, don't position the cursor beyond the last 1674 # character of the line buffer. 1675 &F_BackwardChar(1) if $Vi_mode and $line ne '' 1676 and &at_end_of_line and $KeyMap{'name'} eq 'vicmd_keymap'; 1677 1678 &redisplay(); 1679 $LastCommandKilledText = $ThisCommandKilledText; 1680 } 1681 1682 undef @undo; ## Release the memory. 1683 undef @undoGroupS; ## Release the memory. 1684 &ResetTTY; ## Restore the tty state. 1685 $| = $oldbar; 1686 select $old; 1687 return undef if defined($ReturnEOF); 1688 #print STDOUT "|al=`$AcceptLine'"; 1689 $AcceptLine; ## return the line accepted. 1690} 1691 1692## ctrl(ord('a')) will return the ordinal for Ctrl-A. 1693sub ctrl { 1694 $_[0] ^ (($_[0]>=ord('a') && $_[0]<=ord('z')) ? 0x60 : 0x40); 1695} 1696 1697 1698 1699sub SetTTY { 1700 return if $dumb_term || $stdin_not_tty; 1701 #return system 'stty raw -echo' if defined &DB::DB; 1702 if (defined $term_readkey) { 1703 Term::ReadKey::ReadMode(4, $term_IN); 1704 if ($^O eq 'MSWin32') { 1705 # If we reached this, Perl isn't cygwin; Enter sends \r; thus we need binmode 1706 # XXXX Do we need to undo??? $term_IN is most probably private now... 1707 binmode $term_IN; 1708 } 1709 return 1; 1710 } 1711# system 'stty raw -echo'; 1712 1713 $sgttyb = ''; ## just to quiet "perl -w"; 1714 if ($useioctl && $^O ne 'solaris' && defined $TIOCGETP 1715 && &ioctl($term_IN,$TIOCGETP,$sgttyb)) { 1716 @tty_buf = unpack($sgttyb_t,$sgttyb); 1717 if (defined $ENV{OS2_SHELL}) { 1718 $tty_buf[3] &= ~$mode; 1719 $tty_buf[3] &= ~$ECHO; 1720 } else { 1721 $tty_buf[4] |= $mode; 1722 $tty_buf[4] &= ~$ECHO; 1723 } 1724 $sgttyb = pack($sgttyb_t,@tty_buf); 1725 &ioctl($term_IN,$TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!"; 1726 } elsif (!$usestty) { 1727 return 0; 1728 } else { 1729 warn <<EOW if $useioctl and not defined $ENV{PERL_READLINE_NOWARN}; 1730Can't ioctl TIOCGETP: $! 1731Consider installing Term::ReadKey from CPAN site nearby 1732 at http://www.perl.com/CPAN 1733Or use 1734 perl -MCPAN -e shell 1735to reach CPAN. Falling back to 'stty'. 1736 If you do not want to see this warning, set PERL_READLINE_NOWARN 1737in your environment. 1738EOW 1739 # '; # For Emacs. 1740 $useioctl = 0; 1741 system 'stty raw -echo' and ($usestty = 0, die "Cannot call `stty': $!"); 1742 if ($^O eq 'MSWin32') { 1743 # If we reached this, Perl isn't cygwin, but STTY is present ==> cygwin 1744 # The symptoms: now Enter sends \r; thus we need binmode 1745 # XXXX Do we need to undo??? $term_IN is most probably private now... 1746 binmode $term_IN; 1747 } 1748 } 1749 return 1; 1750} 1751 1752sub ResetTTY { 1753 return if $dumb_term || $stdin_not_tty; 1754 #return system 'stty -raw echo' if defined &DB::DB; 1755 if (defined $term_readkey) { 1756 return Term::ReadKey::ReadMode(0, $term_IN); 1757 } 1758 1759# system 'stty -raw echo'; 1760 if ($useioctl) { 1761 &ioctl($term_IN,$TIOCGETP,$sgttyb) || die "Can't ioctl TIOCGETP: $!"; 1762 @tty_buf = unpack($sgttyb_t,$sgttyb); 1763 if (defined $ENV{OS2_SHELL}) { 1764 $tty_buf[3] |= $mode; 1765 $tty_buf[3] |= $ECHO; 1766 } else { 1767 $tty_buf[4] &= ~$mode; 1768 $tty_buf[4] |= $ECHO; 1769 } 1770 $sgttyb = pack($sgttyb_t,@tty_buf); 1771 &ioctl($term_IN,$TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!"; 1772 } elsif ($usestty) { 1773 system 'stty -raw echo' and die "Cannot call `stty': $!"; 1774 } 1775} 1776 1777# Substr_with_props: gives the substr of prompt+string with embedded 1778# face-change commands 1779 1780sub substr_with_props { 1781 my ($p, $s, $from, $len, $ket, $bsel, $esel) = @_; 1782 my $lp = length $p; 1783 1784 defined $from or $from = 0; 1785 defined $len or $len = length($p) + length($s) - $from; 1786 unless (defined $ket) { 1787 warn 'bug in Term::ReadLine::Perl, please report to its author cpan@ilyaz.org'; 1788 $ket = ''; 1789 } 1790 # We may draw over to put cursor in a correct position: 1791 $ket = '' if $len < length($p) + length($s) - $from; # Not redrawn 1792 1793 if ($from >= $lp) { 1794 $p = ''; 1795 $s = substr $s, $from - $lp; 1796 $lp = 0; 1797 } else { 1798 $p = substr $p, $from; 1799 $lp -= $from; 1800 $from = 0; 1801 } 1802 $s = substr $s, 0, $len - $lp; 1803 $p =~ s/^(\s*)//; my $bs = $1; 1804 $p =~ s/(\s*)$//; my $as = $1; 1805 $p = $rl_term_set->[0] . $p . $rl_term_set->[1] if length $p; 1806 $p = "$bs$p$as"; 1807 $ket = chop $s if $ket; 1808 if (defined $bsel and $bsel != $esel) { 1809 $bsel = $len if $bsel > $len; 1810 $esel = $len if $esel > $len; 1811 } 1812 if (defined $bsel and $bsel != $esel) { 1813 get_ornaments_selected; 1814 $bsel -= $lp; $esel -= $lp; 1815 my ($pre, $sel, $post) = 1816 (substr($s, 0, $bsel), 1817 substr($s, $bsel, $esel-$bsel), 1818 substr($s, $esel)); 1819 $pre = $rl_term_set->[2] . $pre . $rl_term_set->[3] if length $pre; 1820 $sel = $rl_term_set->[4] . $sel . $rl_term_set->[5] if length $sel; 1821 $post = $rl_term_set->[2] . $post . $rl_term_set->[3] if length $post; 1822 $s = "$pre$sel$post" 1823 } else { 1824 $s = $rl_term_set->[2] . $s . $rl_term_set->[3] if length $s; 1825 } 1826 1827 if (!$lp) { # Should not happen... 1828 return $s; 1829 } elsif (!length $s) { # Should not happen 1830 return $p; 1831 } else { # Do not underline spaces in the prompt 1832 return "$p$s" 1833 . (length $ket ? ($rl_term_set->[0] . $ket . $rl_term_set->[1]) : ''); 1834 } 1835} 1836 1837sub redisplay_high { 1838 get_ornaments_selected(); 1839 @$rl_term_set[2,3,4,5] = @$rl_term_set[4,5,2,3]; 1840 &redisplay(); ## Show the line, default inverted. 1841 @$rl_term_set[2,3,4,5] = @$rl_term_set[4,5,2,3]; 1842 $force_redraw = 1; 1843} 1844 1845## 1846## redisplay() 1847## 1848## Updates the screen to reflect the current $line. 1849## 1850## For the purposes of this routine, we prepend the prompt to a local copy of 1851## $line so that we display the prompt as well. We then modify it to reflect 1852## that some characters have different sizes (i.e. control-C is represented 1853## as ^C, tabs are expanded, etc.) 1854## 1855## This routine is somewhat complicated by two-byte characters.... must 1856## make sure never to try do display just half of one. 1857## 1858## NOTE: If an argument is given, it is used instead of the prompt. 1859## 1860## This is some nasty code. 1861## 1862sub redisplay 1863{ 1864 ## local $line has prompt also; take that into account with $D. 1865 local($prompt) = defined($_[0]) ? $_[0] : $prompt; 1866 my ($thislen, $have_bra); 1867 my($dline) = $prompt . $line; 1868 local($D) = $D + length($prompt); 1869 my ($bsel, $esel); 1870 if (defined pos $line) { 1871 $bsel = (pos $line) + length $prompt; 1872 } 1873 my ($have_ket) = ''; 1874 1875 ## 1876 ## If the line contains anything that might require special processing 1877 ## for displaying (such as tabs, control characters, etc.), we will 1878 ## take care of that now.... 1879 ## 1880 if ($dline =~ m/[^\x20-\x7e]/) 1881 { 1882 local($new, $Dinc, $c) = ('', 0); 1883 1884 ## Look at each character of $dline in turn..... 1885 for ($i = 0; $i < length($dline); $i++) { 1886 $c = substr($dline, $i, 1); 1887 1888 ## A tab to expand... 1889 if ($c eq "\t") { 1890 $c = ' ' x (8 - (($i-length($prompt)) % 8)); 1891 1892 ## A control character.... 1893 } elsif ($c =~ tr/\000-\037//) { 1894 $c = sprintf("^%c", ord($c)+ord('@')); 1895 1896 ## the delete character.... 1897 } elsif (ord($c) == 127) { 1898 $c = '^?'; 1899 } 1900 $new .= $c; 1901 1902 ## Bump over $D if this char is expanded and left of $D. 1903 $Dinc += length($c) - 1 if (length($c) > 1 && $i < $D); 1904 ## Bump over $bsel if this char is expanded and left of $bsel. 1905 $bsel += length($c) - 1 if (defined $bsel && length($c) > 1 && $i < $bsel); 1906 } 1907 $dline = $new; 1908 $D += $Dinc; 1909 } 1910 1911 ## 1912 ## Now $dline is what we'd like to display. 1913 ## 1914 ## If it's too long to fit on the line, we must decide what we can fit. 1915 ## 1916 ## If we end up moving the screen index ($si) [index of the leftmost 1917 ## character on the screen], to some place other than the front of the 1918 ## the line, we'll have to make sure that it's not on the first byte of 1919 ## a 2-byte character, 'cause we'll be placing a '<' marker there, and 1920 ## that would screw up the 2-byte character. 1921 ## 1922 ## $si is preserved between several displays (if possible). 1923 ## 1924 ## Similarly, if the line needs chopped off, we make sure that the 1925 ## placement of the tailing '>' won't screw up any 2-byte character in 1926 ## the vicinity. 1927 ## 1928 if ($D == length($prompt)) { 1929 $si = 0; ## display from the beginning.... 1930 } elsif ($si >= $D) { # point to the left 1931 $si = &max(0, $D - $rl_margin); 1932 $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si); 1933 } elsif ($si + $rl_screen_width <= $D) { # Point to the right 1934 $si = &min(length($dline), ($D - $rl_screen_width) + $rl_margin); 1935 $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si); 1936 } elsif (length($dline) - $si < $rl_screen_width - $rl_margin and $si) { 1937 # Too little of the line shown 1938 $si = &max(0, length($dline) - $rl_screen_width + 3); 1939 $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si); 1940 } else { 1941 ## Fine as-is.... don't need to change $si. 1942 } 1943 $have_bra = 1 if $si != 0; # Need the "chopped-off" marker 1944 1945 $thislen = &min(length($dline) - $si, $rl_screen_width); 1946 if ($si + $thislen < length($dline)) { 1947 ## need to place a '>'... make sure to place on first byte. 1948 $thislen-- if &OnSecondByte($si+$thislen-1); 1949 substr($dline, $si+$thislen-1,1) = '>'; 1950 $have_ket = 1; 1951 } 1952 1953 ## 1954 ## Now know what to display. 1955 ## Must get substr($dline, $si, $thislen) on the screen, 1956 ## with the cursor at $D-$si characters from the left edge. 1957 ## 1958 $dline = substr($dline, $si, $thislen); 1959 $delta = $D - $si; ## delta is cursor distance from beginning of $dline. 1960 if (defined $bsel) { 1961 $bsel -= $si; 1962 $esel = $delta; 1963 ($bsel, $esel) = ($esel, $bsel) if $bsel > $esel; 1964 $bsel = 0 if $bsel < 0; 1965 if ($have_ket) { 1966 $esel = $thislen - 1 if $esel > $thislen - 1; 1967 } else { 1968 $esel = $thislen if $esel > $thislen; 1969 } 1970 } 1971 if ($si >= length($prompt)) { # Keep $dline for $lastredisplay... 1972 $prompt = ($have_bra ? "<" : ""); 1973 $dline = substr $dline, 1; # After prompt 1974 $bsel = 1 if defined $bsel and $bsel == 0; 1975 } else { 1976 $dline = substr($dline, (length $prompt) - $si); 1977 $prompt = substr($prompt,$si); 1978 substr($prompt, 0, 1) = '<' if $si > 0; 1979 } 1980 # Now $dline is the part after the prompt... 1981 1982 ## 1983 ## Now must output $dline, with cursor $delta spaces from left of TTY 1984 ## 1985 1986 local ($\, $,) = ('',''); 1987 1988 ## 1989 ## If $force_redraw is not set, we can attempt to optimize the redisplay 1990 ## However, if we don't happen to find an easy way to optimize, we just 1991 ## fall through to the brute-force method of re-drawing the whole line. 1992 ## 1993 if (not $force_redraw and not defined $bsel) 1994 { 1995 ## can try to optimize here a bit. 1996 1997 ## For when we only need to move the cursor 1998 if ($lastredisplay eq $dline and $lastpromptlen == length $prompt) { 1999 ## If we need to move forward, just overwrite as far as we need. 2000 if ($lastdelta < $delta) { 2001 print $term_OUT 2002 substr_with_props($prompt, $dline, 2003 $lastdelta, $delta-$lastdelta, $have_ket); 2004 ## Need to move back. 2005 } elsif($lastdelta > $delta) { 2006 ## Two ways to move back... use the fastest. One is to just 2007 ## backspace the proper amount. The other is to jump to the 2008 ## the beginning of the line and overwrite from there.... 2009 my $out = substr_with_props($prompt, $dline, 0, $delta, $have_ket); 2010 if ($lastdelta - $delta <= length $out) { 2011 print $term_OUT "\b" x ($lastdelta - $delta); 2012 } else { 2013 print $term_OUT "\r", $out; 2014 } 2015 } 2016 ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen) 2017 = ($thislen, $dline, $delta, length $prompt); 2018 # print $term_OUT "\a"; # Debugging 2019 return; 2020 } 2021 2022 ## for when we've just added stuff to the end 2023 if ($thislen > $lastlen && 2024 $lastdelta == $lastlen && 2025 $delta == $thislen && 2026 $lastpromptlen == length($prompt) && 2027 substr($dline, 0, $lastlen - $lastpromptlen) eq $lastredisplay) 2028 { 2029 print $term_OUT substr_with_props($prompt, $dline, 2030 $lastdelta, undef, $have_ket); 2031 # print $term_OUT "\a"; # Debugging 2032 ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen) 2033 = ($thislen, $dline, $delta, length $prompt); 2034 return; 2035 } 2036 2037 ## There is much more opportunity for optimizing..... 2038 ## something to work on later..... 2039 } 2040 2041 ## 2042 ## Brute force method of redisplaying... redraw the whole thing. 2043 ## 2044 2045 print $term_OUT "\r", substr_with_props($prompt, $dline, 0, undef, $have_ket, $bsel, $esel); 2046 my $back = length ($dline) + length ($prompt) - $delta; 2047 $back += $lastlen - $thislen, 2048 print $term_OUT ' ' x ($lastlen - $thislen) if $lastlen > $thislen; 2049 2050 if ($back) { 2051 my $out = substr_with_props($prompt, $dline, 0, $delta, $have_ket, $bsel, $esel); 2052 if ($back <= length $out and not defined $bsel) { 2053 print $term_OUT "\b" x $back; 2054 } else { 2055 print $term_OUT "\r", $out; 2056 } 2057 } 2058 2059 ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen) 2060 = ($thislen, $dline, $delta, length $prompt); 2061 2062 $force_redraw = 0; 2063} 2064 2065sub min { $_[0] < $_[1] ? $_[0] : $_[1]; } 2066 2067sub getc_with_pending { 2068 2069 my $key = @Pending ? shift(@Pending) : &$rl_getc; 2070 2071 # Save keystrokes for vi '.' command 2072 push(@$Dot_buf, $key) if $Dot_buf; 2073 2074 $key; 2075} 2076 2077sub rl_getc { 2078 my $key; # JP: Added missing declaration 2079 if (defined $term_readkey) { # XXXX ??? 2080 $Term::ReadLine::Perl::term->Tk_loop 2081 if $Term::ReadLine::toloop && defined &Tk::DoOneEvent; 2082 $key = Term::ReadKey::ReadKey(0, $term_IN); 2083 } else { 2084 $key = $Term::ReadLine::Perl::term->get_c; 2085 } 2086} 2087 2088## 2089## get_command(keymap, ord_command_char) 2090## 2091## If the KEYMAP has an entry for COMMAND, it is returned. 2092## Otherwise, the default command is returned. 2093## 2094sub get_command 2095{ 2096 local *KeyMap = shift; 2097 my ($key) = @_; 2098 my $cmd = defined($KeyMap[$key]) ? $KeyMap[$key] 2099 : ($KeyMap{'default'} || 'F_Ding'); 2100 if (!defined($cmd) || $cmd eq ''){ 2101 warn "internal error (key=$key)"; 2102 $cmd = 'F_Ding'; 2103 } 2104 $cmd 2105} 2106 2107## 2108## do_command(keymap, numericarg, command) 2109## 2110## If the KEYMAP has an entry for COMMAND, it is executed. 2111## Otherwise, the default command for the keymap is executed. 2112## 2113sub do_command 2114{ 2115 my ($keymap, $count, $key) = @_; 2116 my $cmd = get_command($keymap, $key); 2117 2118 local *KeyMap = $keymap; # &$cmd may expect it... 2119 &$cmd($count, $key); 2120 $lastcommand = $cmd; 2121} 2122 2123## 2124## Save whatever state we wish to save as an anonymous array. 2125## The only other function that needs to know about its encoding is getstate/preserve_state. 2126## 2127sub savestate 2128{ 2129 [$D, $si, $LastCommandKilledText, $KillBuffer, $line, @_]; 2130} 2131 2132# consolidate only-movement changes together... 2133sub preserve_state { 2134 return if $Vi_mode; 2135 push(@undo, savestate()), return unless @undo; 2136 my $last = $undo[-1]; 2137 my @only_movement; 2138 if ( #$last->[1] == $si and $last->[2] eq $LastCommandKilledText 2139 # and $last->[3] eq $KillBuffer and 2140 $last->[4] eq $line ) { 2141 # Only position changed; remove old only-position-changed records 2142 pop @undo if $undo[-1]->[5]; 2143 @only_movement = 1; 2144 } 2145 push(@undo, savestate(@only_movement)); 2146} 2147 2148## 2149## $_[1] is an ASCII ordinal; inserts as per $count. 2150## 2151sub F_SelfInsert 2152{ 2153 remove_selection(); 2154 my ($count, $ord) = @_; 2155 my $text2add = pack('C', $ord) x $count; 2156 if ($InsertMode) { 2157 substr($line,$D,0) .= $text2add; 2158 } else { 2159 ## note: this can screw up with 2-byte characters. 2160 substr($line,$D,length($text2add)) = $text2add; 2161 } 2162 $D += length($text2add); 2163} 2164 2165## 2166## Return the line as-is to the user. 2167## 2168sub F_AcceptLine 2169{ 2170 &add_line_to_history; 2171 $AcceptLine = $line; 2172 local $\ = ''; 2173 print $term_OUT "\r\n"; 2174 $force_redraw = 0; 2175 (pos $line) = undef; # Another way to force redraw... 2176} 2177 2178sub add_line_to_history 2179{ 2180 ## Insert into history list if: 2181 ## * bigger than the minimal length 2182 ## * not same as last entry 2183 ## 2184 if (length($line) >= $minlength 2185 && (!@rl_History || $rl_History[$#rl_History] ne $line) 2186 ) { 2187 ## if the history list is full, shift out an old one first.... 2188 while (@rl_History >= $rl_MaxHistorySize) { 2189 shift(@rl_History); 2190 $rl_HistoryIndex--; 2191 } 2192 2193 push(@rl_History, $line); ## tack new one on the end 2194 } 2195} 2196 2197 2198sub remove_selection { 2199 if ( $rl_first_char && length $line && $rl_default_selected ) { 2200 $line = ''; 2201 $D = 0; 2202 return 1; 2203 } 2204 if ($rl_delete_selection and defined pos $line and $D != pos $line) { 2205 kill_text(pos $line, $D); 2206 return 1; 2207 } 2208 return; 2209} 2210 2211#sub F_ReReadInitFile; 2212#sub rl_getc; 2213sub F_ForwardChar; 2214sub F_BackwardChar; 2215sub F_BeginningOfLine; 2216sub F_EndOfLine; 2217sub F_ForwardWord; 2218sub F_BackwardWord; 2219sub F_RedrawCurrentLine; 2220sub F_ClearScreen; 2221# sub F_SelfInsert; 2222sub F_QuotedInsert; 2223sub F_TabInsert; 2224#sub F_AcceptLine; 2225sub F_OperateAndGetNext; 2226sub F_BackwardDeleteChar; 2227sub F_DeleteChar; 2228sub F_UnixWordRubout; 2229sub F_UnixLineDiscard; 2230sub F_UpcaseWord; 2231sub F_DownCaseWord; 2232sub F_CapitalizeWord; 2233sub F_TransposeWords; 2234sub F_TransposeChars; 2235sub F_PreviousHistory; 2236sub F_NextHistory; 2237sub F_BeginningOfHistory; 2238sub F_EndOfHistory; 2239sub F_ReverseSearchHistory; 2240sub F_ForwardSearchHistory; 2241sub F_HistorySearchBackward; 2242sub F_HistorySearchForward; 2243sub F_KillLine; 2244sub F_BackwardKillLine; 2245sub F_Yank; 2246sub F_YankPop; 2247sub F_YankNthArg; 2248sub F_KillWord; 2249sub F_BackwardKillWord; 2250sub F_Abort; 2251sub F_DoLowercaseVersion; 2252sub F_DoMetaVersion; 2253sub F_DoControlVersion; 2254sub F_Undo; 2255sub F_RevertLine; 2256sub F_EmacsEditingMode; 2257sub F_Interrupt; 2258sub F_PrefixMeta; 2259sub F_UniversalArgument; 2260sub F_DigitArgument; 2261sub F_OverwriteMode; 2262sub F_InsertMode; 2263sub F_ToggleInsertMode; 2264sub F_Suspend; 2265sub F_Ding; 2266sub F_PossibleCompletions; 2267sub F_Complete; 2268sub F_YankClipboard; 2269sub F_CopyRegionAsKillClipboard; 2270sub F_KillRegionClipboard; 2271sub clipboard_set; 2272sub F_BeginUndoGroup; 2273sub F_EndUndoGroup; 2274sub F_DoNothing; 2275sub F_ForceMemorizeDigitArgument; 2276sub F_MemorizeDigitArgument; 2277sub F_UnmemorizeDigitArgument; 2278sub F_ResetDigitArgument; 2279sub F_MergeInserts; 2280sub F_MemorizePos; 2281sub F_BeginPasteGroup; 2282sub F_EndPasteGroup; 2283sub F_BeginEditGroup; 2284sub F_EndEditGroup; 2285 2286# Comment next line and __DATA__ line below to disable the selfloader. 2287 2288use SelfLoader; 2289 22901; 2291 2292__DATA__ 2293 2294# From here on anything may be autoloaded 2295 2296sub max { $_[0] > $_[1] ? $_[0] : $_[1]; } 2297sub isupper { ord($_[0]) >= ord('A') && ord($_[0]) <= ord('Z'); } 2298sub islower { ord($_[0]) >= ord('a') && ord($_[0]) <= ord('z'); } 2299sub toupper { &islower ? pack('c', ord($_[0])-ord('a')+ord('A')) : $_[0];} 2300sub tolower { &isupper ? pack('c', ord($_[0])-ord('A')+ord('a')) : $_[0];} 2301 2302## 2303## rl_set(var_name, value_string) 2304## 2305## Sets the named variable as per the given value, if both are appropriate. 2306## Allows the user of the package to set such things as HorizontalScrollMode 2307## and EditingMode. Value_string may be of the form 2308## HorizontalScrollMode 2309## horizontal-scroll-mode 2310## 2311## Also called during the parsing of ~/.inputrc for "set var value" lines. 2312## 2313## The previous value is returned, or undef on error. 2314########################################################################### 2315## Consider the following example for how to add additional variables 2316## accessible via rl_set (and hence via ~/.inputrc). 2317## 2318## Want: 2319## We want an external variable called "FooTime" (or "foo-time"). 2320## It may have values "January", "Monday", or "Noon". 2321## Internally, we'll want those values to translate to 1, 2, and 12. 2322## 2323## How: 2324## Have an internal variable $var_FooTime that will represent the current 2325## internal value, and initialize it to the default value. 2326## Make an array %var_FooTime whose keys and values are are the external 2327## (January, Monday, Noon) and internal (1, 2, 12) values: 2328## 2329## $var_FooTime = $var_FooTime{'January'} = 1; #default 2330## $var_FooTime{'Monday'} = 2; 2331## $var_FooTime{'Noon'} = 12; 2332## 2333sub rl_set 2334{ 2335 local($var, $val) = @_; 2336 2337 # &preinit's keys are all Capitalized 2338 $val = ucfirst lc $val if $val =~ /^(on|off)$/i; 2339 2340 $var = 'CompleteAddsuffix' if $var eq 'visible-stats'; 2341 2342 ## if the variable is in the form "some-name", change to "SomeName" 2343 local($_) = "\u$var"; 2344 local($return) = undef; 2345 s/-(.)/\u$1/g; 2346 2347 # Skip unknown variables: 2348 return unless defined $ {'readline::'}{"var_$_"}; 2349 local(*V) = $ {'readline::'}{"var_$_"}; 2350 if (!defined($V)) { # XXX Duplicate check? 2351 warn("Warning$InputLocMsg:\n". 2352 " Invalid variable `$var'\n") if $^W; 2353 } elsif (!defined($V{$val})) { 2354 local(@selections) = keys(%V); 2355 warn("Warning$InputLocMsg:\n". 2356 " Invalid value `$val' for variable `$var'.\n". 2357 " Choose from [@selections].\n") if $^W; 2358 } else { 2359 $return = $V; 2360 $V = $V{$val}; ## make the setting 2361 } 2362 $return; 2363} 2364 2365## 2366## OnSecondByte($index) 2367## 2368## Returns true if the byte at $index into $line is the second byte 2369## of a two-byte character. 2370## 2371sub OnSecondByte 2372{ 2373 return 0 if !$_rl_japanese_mb || $_[0] == 0 || $_[0] == length($line); 2374 2375 die 'internal error' if $_[0] > length($line); 2376 2377 ## 2378 ## must start looking from the beginning of the line .... can 2379 ## have one- and two-byte characters interspersed, so can't tell 2380 ## without starting from some know location..... 2381 ## 2382 local($i); 2383 for ($i = 0; $i < $_[0]; $i++) { 2384 next if ord(substr($line, $i, 1)) < 0x80; 2385 ## We have the first byte... must bump up $i to skip past the 2nd. 2386 ## If that one we're skipping past is the index, it should be changed 2387 ## to point to the first byte of the pair (therefore, decremented). 2388 return 1 if ++$i == $_[0]; 2389 } 2390 0; ## seemed to be OK. 2391} 2392 2393## 2394## CharSize(index) 2395## 2396## Returns the size of the character at the given INDEX in the 2397## current line. Most characters are just one byte in length, 2398## but if the byte at the index and the one after has the high 2399## bit set those two bytes are one character of size=2. 2400## 2401## Assumes that index points to the first of a 2-byte char if not 2402## pointing to a 2-byte char. 2403## 2404sub CharSize 2405{ 2406 return 2 if $_rl_japanese_mb && 2407 ord(substr($line, $_[0], 1)) >= 0x80 && 2408 ord(substr($line, $_[0]+1, 1)) >= 0x80; 2409 1; 2410} 2411 2412sub GetTTY 2413{ 2414 $base_termios = $termios; # make it long enough 2415 &ioctl($term_IN,$TCGETS,$base_termios) || die "Can't ioctl TCGETS: $!"; 2416} 2417 2418sub XonTTY 2419{ 2420 # I don't know which of these I actually need to do this to, so we'll 2421 # just cover all bases. 2422 2423 &ioctl($term_IN,$TCXONC,$TCOON); # || die "Can't ioctl TCXONC STDIN: $!"; 2424 &ioctl($term_OUT,$TCXONC,$TCOON); # || die "Can't ioctl TCXONC STDOUT: $!"; 2425} 2426 2427sub ___SetTTY 2428{ 2429# print "before SetTTY\n\r"; 2430# system 'stty -a'; 2431 2432 &XonTTY; 2433 2434 &GetTTY 2435 if !defined($base_termios); 2436 2437 @termios = unpack($termios_t,$base_termios); 2438 $termios[$TERMIOS_IFLAG] |= $TERMIOS_READLINE_ION; 2439 $termios[$TERMIOS_IFLAG] &= ~$TERMIOS_READLINE_IOFF; 2440 $termios[$TERMIOS_OFLAG] |= $TERMIOS_READLINE_OON; 2441 $termios[$TERMIOS_OFLAG] &= ~$TERMIOS_READLINE_OOFF; 2442 $termios[$TERMIOS_LFLAG] |= $TERMIOS_READLINE_LON; 2443 $termios[$TERMIOS_LFLAG] &= ~$TERMIOS_READLINE_LOFF; 2444 $termios[$TERMIOS_VMIN] = 1; 2445 $termios[$TERMIOS_VTIME] = 0; 2446 $termios = pack($termios_t,@termios); 2447 &ioctl($term_IN,$TCSETS,$termios) || die "Can't ioctl TCSETS: $!"; 2448 2449# print "after SetTTY\n\r"; 2450# system 'stty -a'; 2451} 2452 2453sub normal_tty_mode 2454{ 2455 return if $stdin_not_tty || $dumb_term || !$initialized; 2456 &XonTTY; 2457 &GetTTY if !defined($base_termios); 2458 &ResetTTY; 2459} 2460 2461sub ___ResetTTY 2462{ 2463# print "before ResetTTY\n\r"; 2464# system 'stty -a'; 2465 2466 @termios = unpack($termios_t,$base_termios); 2467 $termios[$TERMIOS_IFLAG] |= $TERMIOS_NORMAL_ION; 2468 $termios[$TERMIOS_IFLAG] &= ~$TERMIOS_NORMAL_IOFF; 2469 $termios[$TERMIOS_OFLAG] |= $TERMIOS_NORMAL_OON; 2470 $termios[$TERMIOS_OFLAG] &= ~$TERMIOS_NORMAL_OOFF; 2471 $termios[$TERMIOS_LFLAG] |= $TERMIOS_NORMAL_LON; 2472 $termios[$TERMIOS_LFLAG] &= ~$TERMIOS_NORMAL_LOFF; 2473 $termios = pack($termios_t,@termios); 2474 &ioctl($term_IN,$TCSETS,$termios) || die "Can't ioctl TCSETS: $!"; 2475 2476# print "after ResetTTY\n\r"; 2477# system 'stty -a'; 2478} 2479 2480## 2481## WordBreak(index) 2482## 2483## Returns true if the character at INDEX into $line is a basic word break 2484## character, false otherwise. 2485## 2486sub WordBreak 2487{ 2488 index($rl_basic_word_break_characters, substr($line,$_[0],1)) != -1; 2489} 2490 2491sub getstate 2492{ 2493 ($D, $si, $LastCommandKilledText, $KillBuffer, $line) = @{$_[0]}; 2494 $ThisCommandKilledText = $LastCommandKilledText; 2495} 2496 2497## 2498## kills from D=$_[0] to $_[1] (to the killbuffer if $_[2] is true) 2499## 2500sub kill_text 2501{ 2502 my($from, $to, $save) = (&min($_[0], $_[1]), &max($_[0], $_[1]), $_[2]); 2503 my $len = $to - $from; 2504 if ($save) { 2505 $KillBuffer = '' if !$LastCommandKilledText; 2506 if ($from < $LastCommandKilledText - 1) { 2507 $KillBuffer = substr($line, $from, $len) . $KillBuffer; 2508 } else { 2509 $KillBuffer .= substr($line, $from, $len); 2510 } 2511 $ThisCommandKilledText = 1 + $from; 2512 } 2513 substr($line, $from, $len) = ''; 2514 2515 ## adjust $D 2516 if ($D > $from) { 2517 $D -= $len; 2518 $D = $from if $D < $from; 2519 } 2520} 2521 2522 2523########################################################################### 2524## Bindable functions... pretty much in the same order as in readline.c ### 2525########################################################################### 2526 2527## 2528## Returns true if $D at the end of the line. 2529## 2530sub at_end_of_line 2531{ 2532 ($D + &CharSize($D)) == (length($line) + 1); 2533} 2534 2535 2536## 2537## Move forward (right) $count characters. 2538## 2539sub F_ForwardChar 2540{ 2541 my $count = shift; 2542 return &F_BackwardChar(-$count) if $count < 0; 2543 2544 while (!&at_end_of_line && $count-- > 0) { 2545 $D += &CharSize($D); 2546 } 2547} 2548 2549## 2550## Move backward (left) $count characters. 2551## 2552sub F_BackwardChar 2553{ 2554 my $count = shift; 2555 return &F_ForwardChar(-$count) if $count < 0; 2556 2557 while (($D > 0) && ($count-- > 0)) { 2558 $D--; ## Move back one regardless, 2559 $D-- if &OnSecondByte($D); ## another if over a big char. 2560 } 2561} 2562 2563## 2564## Go to beginning of line. 2565## 2566sub F_BeginningOfLine 2567{ 2568 $D = 0; 2569} 2570 2571## 2572## Move to the end of the line. 2573## 2574sub F_EndOfLine 2575{ 2576 &F_ForwardChar(100) while !&at_end_of_line; 2577} 2578 2579## 2580## Move to the end of this/next word. 2581## Done as many times as $count says. 2582## 2583sub F_ForwardWord 2584{ 2585 my $count = shift; 2586 return &F_BackwardWord(-$count) if $count < 0; 2587 2588 while (!&at_end_of_line && $count-- > 0) 2589 { 2590 ## skip forward to the next word (if not already on one) 2591 &F_ForwardChar(1) while !&at_end_of_line && &WordBreak($D); 2592 ## skip forward to end of word 2593 &F_ForwardChar(1) while !&at_end_of_line && !&WordBreak($D); 2594 } 2595} 2596 2597## 2598## 2599## Move to the beginning of this/next word. 2600## Done as many times as $count says. 2601## 2602sub F_BackwardWord 2603{ 2604 my $count = shift; 2605 return &F_ForwardWord(-$count) if $count < 0; 2606 2607 while ($D > 0 && $count-- > 0) { 2608 ## skip backward to the next word (if not already on one) 2609 &F_BackwardChar(1) while (($D > 0) && &WordBreak($D-1)); 2610 ## skip backward to start of word 2611 &F_BackwardChar(1) while (($D > 0) && !&WordBreak($D-1)); 2612 } 2613} 2614 2615## 2616## Refresh the input line. 2617## 2618sub F_RedrawCurrentLine 2619{ 2620 $force_redraw = 1; 2621} 2622 2623## 2624## Clear the screen and refresh the line. 2625## If given a numeric arg other than 1, simply refreshes the line. 2626## 2627sub F_ClearScreen 2628{ 2629 my $count = shift; 2630 return &F_RedrawCurrentLine if $count != 1; 2631 2632 $rl_CLEAR = `clear` if !defined($rl_CLEAR); 2633 local $\ = ''; 2634 print $term_OUT $rl_CLEAR; 2635 $force_redraw = 1; 2636} 2637 2638## 2639## Insert the next character read verbatim. 2640## 2641sub F_QuotedInsert 2642{ 2643 my $count = shift; 2644 &F_SelfInsert($count, ord(&getc_with_pending)); 2645} 2646 2647## 2648## Insert a tab. 2649## 2650sub F_TabInsert 2651{ 2652 my $count = shift; 2653 &F_SelfInsert($count, ord("\t")); 2654} 2655 2656## Operate - accept the current line and fetch from the 2657## history the next line relative to current line for default. 2658sub F_OperateAndGetNext 2659{ 2660 my $count = shift; 2661 2662 &F_AcceptLine; 2663 2664 my $remainingEntries = $#rl_History - $rl_HistoryIndex; 2665 if ($count > 0 && $remainingEntries >= 0) { # there is something to repeat 2666 if ($remainingEntries > 0) { # if we are not on last line 2667 $rl_HistoryIndex++; # fetch next one 2668 $count = $remainingEntries if $count > $remainingEntries; 2669 } 2670 $rl_OperateCount = $count; 2671 } 2672} 2673 2674## 2675## Removes $count chars to left of cursor (if not at beginning of line). 2676## If $count > 1, deleted chars saved to kill buffer. 2677## 2678sub F_BackwardDeleteChar 2679{ 2680 return if remove_selection(); 2681 2682 my $count = shift; 2683 return F_DeleteChar(-$count) if $count < 0; 2684 my $oldD = $D; 2685 &F_BackwardChar($count); 2686 return if $D == $oldD; 2687 &kill_text($oldD, $D, $count > 1); 2688} 2689 2690## 2691## Removes the $count chars from under the cursor. 2692## If there is no line and the last command was different, tells 2693## readline to return EOF. 2694## If there is a line, and the cursor is at the end of it, and we're in 2695## tcsh completion mode, then list possible completions. 2696## If $count > 1, deleted chars saved to kill buffer. 2697## 2698sub F_DeleteChar 2699{ 2700 return if remove_selection(); 2701 2702 my $count = shift; 2703 return F_DeleteBackwardChar(-$count) if $count < 0; 2704 if (length($line) == 0) { # EOF sent (probably OK in DOS too) 2705 $AcceptLine = $ReturnEOF = 1 if $lastcommand ne 'F_DeleteChar'; 2706 return; 2707 } 2708 if ($D == length ($line)) 2709 { 2710 &complete_internal('?') if $var_TcshCompleteMode; 2711 return; 2712 } 2713 my $oldD = $D; 2714 &F_ForwardChar($count); 2715 return if $D == $oldD; 2716 &kill_text($oldD, $D, $count > 1); 2717} 2718 2719## 2720## Kill to previous whitespace. 2721## 2722sub F_UnixWordRubout 2723{ 2724 return &F_Ding if $D == 0; 2725 (my $oldD, local $rl_basic_word_break_characters) = ($D, "\t "); 2726 # JP: Fixed a bug here - both were 'my' 2727 F_BackwardWord(1); 2728 kill_text($D, $oldD, 1); 2729} 2730 2731## 2732## Kill line from cursor to beginning of line. 2733## 2734sub F_UnixLineDiscard 2735{ 2736 return &F_Ding if $D == 0; 2737 kill_text(0, $D, 1); 2738} 2739 2740sub F_UpcaseWord { &changecase($_[0], 'up'); } 2741sub F_DownCaseWord { &changecase($_[0], 'down'); } 2742sub F_CapitalizeWord { &changecase($_[0], 'cap'); } 2743 2744## 2745## Translated from GNUs readline.c 2746## One arg is 'up' to upcase $_[0] words, 2747## 'down' to downcase them, 2748## or something else to capitolize them. 2749## If $_[0] is negative, the dot is not moved. 2750## 2751sub changecase 2752{ 2753 my $op = $_[1]; 2754 2755 my ($start, $state, $c, $olddot) = ($D, 0); 2756 if ($_[0] < 0) 2757 { 2758 $olddot = $D; 2759 $_[0] = -$_[0]; 2760 } 2761 2762 &F_ForwardWord; ## goes forward $_[0] words. 2763 2764 while ($start < $D) { 2765 $c = substr($line, $start, 1); 2766 2767 if ($op eq 'up') { 2768 $c = &toupper($c); 2769 } elsif ($op eq 'down') { 2770 $c = &tolower($c); 2771 } else { ## must be 'cap' 2772 if ($state == 1) { 2773 $c = &tolower($c); 2774 } else { 2775 $c = &toupper($c); 2776 $state = 1; 2777 } 2778 $state = 0 if $c !~ tr/a-zA-Z//; 2779 } 2780 2781 substr($line, $start, 1) = $c; 2782 $start++; 2783 } 2784 $D = $olddot if defined($olddot); 2785} 2786 2787sub F_TransposeWords { 2788 my $c = shift; 2789 return F_Ding() unless $c; 2790 # Find "this" word 2791 F_BackwardWord(1); 2792 my $p0 = $D; 2793 F_ForwardWord(1); 2794 my $p1 = $D; 2795 return F_Ding() if $p1 == $p0; 2796 my ($p2, $p3) = ($p0, $p1); 2797 if ($c > 0) { 2798 F_ForwardWord($c); 2799 $p3 = $D; 2800 F_BackwardWord(1); 2801 $p2 = $D; 2802 } else { 2803 F_BackwardWord(1 - $c); 2804 $p0 = $D; 2805 F_ForwardWord(1); 2806 $p1 = $D; 2807 } 2808 return F_Ding() if $p3 == $p2 or $p2 < $p1; 2809 my $r = substr $line, $p2, $p3 - $p2; 2810 substr($line, $p2, $p3 - $p2) = substr $line, $p0, $p1 - $p0; 2811 substr($line, $p0, $p1 - $p0) = $r; 2812 $D = $c > 0 ? $p3 : $p0 + $p3 - $p2; # End of "this" word after edit 2813 return 1; 2814## Exchange words: C-Left, C-right, C-right, C-left. If positions do 2815## not overlap, we get two things to transpose. Repeat count? 2816} 2817 2818## 2819## Switch char at dot with char before it. 2820## If at the end of the line, switch the previous two... 2821## (NOTE: this could screw up multibyte characters.. should do correctly) 2822sub F_TransposeChars 2823{ 2824 if ($D == length($line) && $D >= 2) { 2825 substr($line,$D-2,2) = substr($line,$D-1,1).substr($line,$D-2,1); 2826 } elsif ($D >= 1) { 2827 substr($line,$D-1,2) = substr($line,$D,1) .substr($line,$D-1,1); 2828 } else { 2829 &F_Ding; 2830 } 2831} 2832 2833sub F_PreviousHistory { 2834 &get_line_from_history($rl_HistoryIndex - shift); 2835} 2836 2837sub F_NextHistory { 2838 &get_line_from_history($rl_HistoryIndex + shift); 2839} 2840 2841 2842 2843sub F_BeginningOfHistory 2844{ 2845 &get_line_from_history(0); 2846} 2847 2848sub F_EndOfHistory 2849{ 2850 &get_line_from_history(@rl_History); 2851} 2852 2853sub F_ReverseSearchHistory 2854{ 2855 &DoSearch($_[0] >= 0 ? 1 : 0); 2856} 2857 2858sub F_ForwardSearchHistory 2859{ 2860 &DoSearch($_[0] >= 0 ? 0 : 1); 2861} 2862 2863sub F_HistorySearchBackward 2864{ 2865 &DoSearchStart(($_[0] >= 0 ? 1 : 0),substr($line,0,$D)); 2866} 2867 2868sub F_HistorySearchForward 2869{ 2870 &DoSearchStart(($_[0] >= 0 ? 0 : 1),substr($line,0,$D)); 2871} 2872 2873## returns a new $i or -1 if not found. 2874sub search { 2875 my ($i, $str) = @_; 2876 return -1 if $i < 0 || $i > $#rl_History; ## for safety 2877 while (1) { 2878 return $i if rindex($rl_History[$i], $str) >= 0; 2879 if ($reverse) { 2880 return -1 if $i-- == 0; 2881 } else { 2882 return -1 if $i++ == $#rl_History; 2883 } 2884 } 2885} 2886 2887sub DoSearch 2888{ 2889 local $reverse = shift; # Used in search() 2890 my $oldline = $line; 2891 my $oldD = $D; 2892 2893 my $searchstr = ''; ## string we're searching for 2894 my $I = -1; ## which history line 2895 2896 $si = 0; 2897 2898 while (1) 2899 { 2900 if ($I != -1) { 2901 $line = $rl_History[$I]; 2902 $D += index($rl_History[$I], $searchstr); 2903 } 2904 &redisplay( '('.($reverse?'reverse-':'') ."i-search) `$searchstr': "); 2905 2906 $c = &getc_with_pending; 2907 if ($KeyMap[ord($c)] eq 'F_ReverseSearchHistory') { 2908 if ($reverse && $I != -1) { 2909 if ($tmp = &search($I-1,$searchstr), $tmp >= 0) { 2910 $I = $tmp; 2911 } else { 2912 &F_Ding; 2913 } 2914 } 2915 $reverse = 1; 2916 } elsif ($KeyMap[ord($c)] eq 'F_ForwardSearchHistory') { 2917 if (!$reverse && $I != -1) { 2918 if ($tmp = &search($I+1,$searchstr), $tmp >= 0) { 2919 $I = $tmp; 2920 } else { 2921 &F_Ding; 2922 } 2923 } 2924 $reverse = 0; 2925 } elsif ($c eq "\007") { ## abort search... restore line and return 2926 $line = $oldline; 2927 $D = $oldD; 2928 return; 2929 } elsif (ord($c) < 32 || ord($c) > 126) { 2930 push(@Pending, $c) if $c ne "\e"; 2931 if ($I < 0) { 2932 ## just restore 2933 $line = $oldline; 2934 $D = $oldD; 2935 } else { 2936 #chose this line 2937 $line = $rl_History[$I]; 2938 $D = index($rl_History[$I], $searchstr); 2939 } 2940 &redisplay(); 2941 last; 2942 } else { 2943 ## Add this character to the end of the search string and 2944 ## see if that'll match anything. 2945 $tmp = &search($I < 0 ? $rl_HistoryIndex-$reverse: $I, $searchstr.$c); 2946 if ($tmp == -1) { 2947 &F_Ding; 2948 } else { 2949 $searchstr .= $c; 2950 $I = $tmp; 2951 } 2952 } 2953 } 2954} 2955 2956## returns a new $i or -1 if not found. 2957sub searchStart { 2958 my ($i, $reverse, $str) = @_; 2959 $i += $reverse ? - 1: +1; 2960 return -1 if $i < 0 || $i > $#rl_History; ## for safety 2961 while (1) { 2962 return $i if index($rl_History[$i], $str) == 0; 2963 if ($reverse) { 2964 return -1 if $i-- == 0; 2965 } else { 2966 return -1 if $i++ == $#rl_History; 2967 } 2968 } 2969} 2970 2971sub DoSearchStart 2972{ 2973 my ($reverse,$what) = @_; 2974 my $i = searchStart($rl_HistoryIndex, $reverse, $what); 2975 return if $i == -1; 2976 $rl_HistoryIndex = $i; 2977 ($D, $line) = (0, $rl_History[$rl_HistoryIndex]); 2978 F_BeginningOfLine(); 2979 F_ForwardChar(length($what)); 2980 2981} 2982 2983########################################################################### 2984########################################################################### 2985 2986## 2987## Kill from cursor to end of line. 2988## 2989sub F_KillLine 2990{ 2991 my $count = shift; 2992 return F_BackwardKillLine(-$count) if $count < 0; 2993 kill_text($D, length($line), 1); 2994} 2995 2996## 2997## Delete from cursor to beginning of line. 2998## 2999sub F_BackwardKillLine 3000{ 3001 my $count = shift; 3002 return F_KillLine(-$count) if $count < 0; 3003 return F_Ding if $D == 0; 3004 kill_text(0, $D, 1); 3005} 3006 3007## 3008## TextInsert(count, string) 3009## 3010sub TextInsert { 3011 my $count = shift; 3012 my $text2add = shift(@_) x $count; 3013 if ($InsertMode) { 3014 substr($line,$D,0) .= $text2add; 3015 } else { 3016 substr($line,$D,length($text2add)) = $text2add; 3017 } 3018 $D += length($text2add); 3019} 3020 3021sub F_Yank 3022{ 3023 remove_selection(); 3024 &TextInsert($_[0], $KillBuffer); 3025} 3026 3027sub F_YankPop { 3028 1; 3029 ## not implemented yet 3030} 3031 3032sub F_YankNthArg { 3033 1; 3034 ## not implemented yet 3035} 3036 3037## 3038## Kill to the end of the current word. If not on a word, kill to 3039## the end of the next word. 3040## 3041sub F_KillWord 3042{ 3043 my $count = shift; 3044 return &F_BackwardKillWord(-$count) if $count < 0; 3045 my $oldD = $D; 3046 &F_ForwardWord($count); ## moves forward $count words. 3047 kill_text($oldD, $D, 1); 3048} 3049 3050## 3051## Kill backward to the start of the current word, or, if currently 3052## not on a word (or just at the start of a word), to the start of the 3053## previous word. 3054## 3055sub F_BackwardKillWord 3056{ 3057 my $count = shift; 3058 return F_KillWord(-$count) if $count < 0; 3059 my $oldD = $D; 3060 &F_BackwardWord($count); ## moves backward $count words. 3061 kill_text($D, $oldD, 1); 3062} 3063 3064########################################################################### 3065########################################################################### 3066 3067 3068## 3069## Abort the current input. 3070## 3071sub F_Abort 3072{ 3073 &F_Ding; 3074} 3075 3076 3077## 3078## If the character that got us here is upper case, 3079## do the lower-case equiv... 3080## 3081sub F_DoLowercaseVersion 3082{ 3083 if ($_[1] >= ord('A') && $_[1] <= ord('Z')) { 3084 &do_command(*KeyMap, $_[0], $_[1] - ord('A') + ord('a')); 3085 } else { 3086 &F_Ding; 3087 } 3088} 3089 3090## 3091## do the equiv with control key... 3092## 3093sub F_DoControlVersion 3094{ 3095 local *KeyMap = $var_EditingMode; 3096 my $key = $_[1]; 3097 3098 if ($key == ord('?')) { 3099 $key = 0x7F; 3100 } else { 3101 $key &= ~(0x80 | 0x60); 3102 } 3103 &do_command(*KeyMap, $_[0], $key); 3104} 3105 3106## 3107## do the equiv with meta key... 3108## 3109sub F_DoMetaVersion 3110{ 3111 local *KeyMap = $var_EditingMode; 3112 unshift @Pending, chr $_[1]; 3113 3114 &do_command(*KeyMap, $_[0], ord "\e"); 3115} 3116 3117## 3118## If the character that got us here is Alt-Char, 3119## do the Esc Char equiv... 3120## 3121sub F_DoEscVersion 3122{ 3123 my ($ord, $t) = $_[1]; 3124 &F_Ding unless $KeyMap{'Esc'}; 3125 for $t (([ord 'w', '`1234567890-='], 3126 [ord ',', 'zxcvbnm,./\\'], 3127 [16, 'qwertyuiop[]'], 3128 [ord(' ') - 2, 'asdfghjkl;\''])) { 3129 next unless $ord >= $t->[0] and $ord < $t->[0] + length($t->[1]); 3130 $ord = ord substr $t->[1], $ord - $t->[0], 1; 3131 return &do_command($KeyMap{'Esc'}, $_[0], $ord); 3132 } 3133 &F_Ding; 3134} 3135 3136## 3137## Undo one level. 3138## 3139sub F_Undo 3140{ 3141 pop(@undo); # unless $undo[-1]->[5]; ## get rid of the state we just put on, so we can go back one. 3142 if (@undo) { 3143 &getstate(pop(@undo)); 3144 } else { 3145 &F_Ding; 3146 } 3147} 3148 3149## 3150## Replace the current line to some "before" state. 3151## 3152sub F_RevertLine 3153{ 3154 if ($rl_HistoryIndex >= $#rl_History+1) { 3155 $line = $line_for_revert; 3156 } else { 3157 $line = $rl_History[$rl_HistoryIndex]; 3158 } 3159 $D = length($line); 3160} 3161 3162sub F_EmacsEditingMode 3163{ 3164 $var_EditingMode = $var_EditingMode{'emacs'}; 3165 $Vi_mode = 0; 3166} 3167 3168########################################################################### 3169########################################################################### 3170 3171 3172## 3173## (Attempt to) interrupt the current program. 3174## 3175sub F_Interrupt 3176{ 3177 local $\ = ''; 3178 print $term_OUT "\r\n"; 3179 &ResetTTY; 3180 kill ("INT", 0); 3181 3182 ## We're back.... must not have died. 3183 $force_redraw = 1; 3184} 3185 3186## 3187## Execute the next character input as a command in a meta keymap. 3188## 3189sub F_PrefixMeta 3190{ 3191 my($count, $keymap) = ($_[0], "$KeyMap{'name'}_$_[1]"); 3192 ##print "F_PrefixMeta [$keymap]\n\r"; 3193 die "<internal error, $_[1]>" unless %$keymap; 3194 do_command(*$keymap, $count, ord(&getc_with_pending)); 3195} 3196 3197sub F_UniversalArgument 3198{ 3199 &F_DigitArgument; 3200} 3201 3202## 3203## For typing a numeric prefix to a command.... 3204## 3205sub F_DigitArgument 3206{ 3207 my $in = chr $_[1]; 3208 my ($NumericArg, $sawDigit) = (1, 0); 3209 my ($increment, $ord); 3210 ($NumericArg, $sawDigit) = ($_[0], $_[0] !~ /e0$/i) 3211 if $doingNumArg; # XXX What if Esc-- 1 ? 3212 3213 do 3214 { 3215 $ord = ord $in; 3216 if (defined($KeyMap[$ord]) && $KeyMap[$ord] eq 'F_UniversalArgument') { 3217 $NumericArg *= 4; 3218 } elsif ($ord == ord('-') && !$sawDigit) { 3219 $NumericArg = -$NumericArg; 3220 } elsif ($ord >= ord('0') && $ord <= ord('9')) { 3221 $increment = ($ord - ord('0')) * ($NumericArg < 0 ? -1 : 1); 3222 if ($sawDigit) { 3223 $NumericArg = $NumericArg * 10 + $increment; 3224 } else { 3225 $NumericArg = $increment; 3226 $sawDigit = 1; 3227 } 3228 } else { 3229 local(*KeyMap) = $var_EditingMode; 3230 &redisplay(); 3231 $doingNumArg = 1; # Allow NumArg inside NumArg 3232 &do_command(*KeyMap, $NumericArg . ($sawDigit ? '': 'e0'), $ord); 3233 return; 3234 } 3235 ## make sure it's not toooo big. 3236 if ($NumericArg > $rl_max_numeric_arg) { 3237 $NumericArg = $rl_max_numeric_arg; 3238 } elsif ($NumericArg < -$rl_max_numeric_arg) { 3239 $NumericArg = -$rl_max_numeric_arg; 3240 } 3241 &redisplay(sprintf("(arg %d) ", $NumericArg)); 3242 } while defined($in = &getc_with_pending); 3243} 3244 3245sub F_OverwriteMode 3246{ 3247 $InsertMode = 0; 3248} 3249 3250sub F_InsertMode 3251{ 3252 $InsertMode = 1; 3253} 3254 3255sub F_ToggleInsertMode 3256{ 3257 $InsertMode = !$InsertMode; 3258} 3259 3260## 3261## (Attempt to) suspend the program. 3262## 3263sub F_Suspend 3264{ 3265 if ($inDOS && length($line)==0) { # EOF sent 3266 $AcceptLine = $ReturnEOF = 1 if $lastcommand ne 'F_DeleteChar'; 3267 return; 3268 } 3269 local $\ = ''; 3270 print $term_OUT "\r\n"; 3271 &ResetTTY; 3272 eval { kill ("TSTP", 0) }; 3273 ## We're back.... 3274 &SetTTY; 3275 $force_redraw = 1; 3276} 3277 3278## 3279## Ring the bell. 3280## Should do something with $var_PreferVisibleBell here, but what? 3281## 3282sub F_Ding { 3283 local $\ = ''; 3284 print $term_OUT "\007"; 3285 return; # Undefined return value 3286} 3287 3288########################################################################## 3289#### command/file completion ############################################ 3290########################################################################## 3291 3292## 3293## How Command Completion Works 3294## 3295## When asked to do a completion operation, readline isolates the word 3296## to the immediate left of the cursor (i.e. what's just been typed). 3297## This information is then passed to some function (which may be supplied 3298## by the user of this package) which will return an array of possible 3299## completions. 3300## 3301## If there is just one, that one is used. Otherwise, they are listed 3302## in some way (depends upon $var_TcshCompleteMode). 3303## 3304## The default is to do filename completion. The function that performs 3305## this task is readline'rl_filename_list. 3306## 3307## A minimal-trouble way to have command-completion is to call 3308## readline'rl_basic_commands with an array of command names, such as 3309## &readline'rl_basic_commands('quit', 'run', 'set', 'list') 3310## Those command names will then be used for completion if the word being 3311## completed begins the line. Otherwise, completion is disallowed. 3312## 3313## The way to have the most power is to provide a function to readline 3314## which will accept information about a partial word that needs completed, 3315## and will return the appropriate list of possibilities. 3316## This is done by setting $readline'rl_completion_function to the name of 3317## the function to run. 3318## 3319## That function will be called with three args ($text, $line, $start). 3320## TEXT is the partial word that should be completed. LINE is the entire 3321## input line as it stands, and START is the index of the TEXT in LINE 3322## (i.e. zero if TEXT is at the beginning of LINE). 3323## 3324## A cool completion function will look at LINE and START and give context- 3325## sensitive completion lists. Consider something that will do completion 3326## for two commands 3327## cat FILENAME 3328## finger USERNAME 3329## status [this|that|other] 3330## 3331## It (untested) might look like: 3332## 3333## $readline'rl_completion_function = "main'complete"; 3334## sub complete { local($text, $_, $start) = @_; 3335## ## return commands which may match if at the beginning.... 3336## return grep(/^$text/, 'cat', 'finger') if $start == 0; 3337## return &rl_filename_list($text) if /^cat\b/; 3338## return &my_namelist($text) if /^finger\b/; 3339## return grep(/^text/, 'this', 'that','other') if /^status\b/; 3340## (); 3341## } 3342## Of course, a real completion function would be more robust, but you 3343## get the idea (I hope). 3344## 3345 3346## 3347## List possible completions 3348## 3349sub F_PossibleCompletions 3350{ 3351 &complete_internal('?'); 3352} 3353 3354## 3355## List possible completions 3356## 3357sub F_InsertPossibleCompletions 3358{ 3359 &complete_internal('*'); 3360} 3361 3362## 3363## Do a completion operation. 3364## If the last thing we did was a completion operation, we'll 3365## now list the options available (under normal emacs mode). 3366## 3367## Under TcshCompleteMode, each contiguous subsequent completion operation 3368## lists another of the possible options. 3369## 3370## Returns true if a completion was done, false otherwise, so vi completion 3371## routines can test it. 3372## 3373sub F_Complete 3374{ 3375 if ($lastcommand eq 'F_Complete') { 3376 if ($var_TcshCompleteMode && @tcsh_complete_selections > 0) { 3377 substr($line, $tcsh_complete_start, $tcsh_complete_len) 3378 = $tcsh_complete_selections[0]; 3379 $D -= $tcsh_complete_len; 3380 $tcsh_complete_len = length($tcsh_complete_selections[0]); 3381 $D += $tcsh_complete_len; 3382 push(@tcsh_complete_selections, shift(@tcsh_complete_selections)); 3383 } else { 3384 &complete_internal('?') or return; 3385 } 3386 } else { 3387 @tcsh_complete_selections = (); 3388 &complete_internal("\t") or return; 3389 } 3390 3391 1; 3392} 3393 3394## 3395## The meat of command completion. Patterned closely after GNU's. 3396## 3397## The supposedly partial word at the cursor is "completed" as per the 3398## single argument: 3399## "\t" complete as much of the word as is unambiguous 3400## "?" list possibilities. 3401## "*" replace word with all possibilities. (who would use this?) 3402## 3403## A few notable variables used: 3404## $rl_completer_word_break_characters 3405## -- characters in this string break a word. 3406## $rl_special_prefixes 3407## -- but if in this string as well, remain part of that word. 3408## 3409## Returns true if a completion was done, false otherwise, so vi completion 3410## routines can test it. 3411## 3412sub complete_internal 3413{ 3414 my $what_to_do = shift; 3415 my ($point, $end) = ($D, $D); 3416 3417 # In vi mode, complete if the cursor is at the *end* of a word, not 3418 # after it. 3419 ($point++, $end++) if $Vi_mode; 3420 3421 if ($point) 3422 { 3423 ## Not at the beginning of the line; Isolate the word to be completed. 3424 1 while (--$point && (-1 == index($rl_completer_word_break_characters, 3425 substr($line, $point, 1)))); 3426 3427 # Either at beginning of line or at a word break. 3428 # If at a word break (that we don't want to save), skip it. 3429 $point++ if ( 3430 (index($rl_completer_word_break_characters, 3431 substr($line, $point, 1)) != -1) && 3432 (index($rl_special_prefixes, substr($line, $point, 1)) == -1) 3433 ); 3434 } 3435 3436 my $text = substr($line, $point, $end - $point); 3437 $rl_completer_terminator_character = ' '; 3438 @matches = &completion_matches($rl_completion_function,$text,$line,$point); 3439 3440 if (@matches == 0) { 3441 return &F_Ding; 3442 } elsif ($what_to_do eq "\t") { 3443 my $replacement = shift(@matches); 3444 $replacement .= $rl_completer_terminator_character if @matches == 1; 3445 &F_Ding if @matches != 1; 3446 if ($var_TcshCompleteMode) { 3447 @tcsh_complete_selections = (@matches, $text); 3448 $tcsh_complete_start = $point; 3449 $tcsh_complete_len = length($replacement); 3450 } 3451 if ($replacement ne '') { 3452 substr($line, $point, $end-$point) = $replacement; 3453 $D = $D - ($end - $point) + length($replacement); 3454 } 3455 } elsif ($what_to_do eq '?') { 3456 shift(@matches); ## remove prepended common prefix 3457 local $\ = ''; 3458 print $term_OUT "\n\r"; 3459 # print "@matches\n\r"; 3460 &pretty_print_list (@matches); 3461 $force_redraw = 1; 3462 } elsif ($what_to_do eq '*') { 3463 shift(@matches); ## remove common prefix. 3464 local $" = $rl_completer_terminator_character; 3465 my $replacement = "@matches$rl_completer_terminator_character"; 3466 substr($line, $point, $end-$point) = $replacement; ## insert all. 3467 $D = $D - ($end - $point) + length($replacement); 3468 } else { 3469 warn "\r\n[Internal error]"; 3470 return &F_Ding; 3471 } 3472 3473 1; 3474} 3475 3476## 3477## completion_matches(func, text, line, start) 3478## 3479## FUNC is a function to call as FUNC(TEXT, LINE, START) 3480## where TEXT is the item to be completed 3481## LINE is the whole command line, and 3482## START is the starting index of TEXT in LINE. 3483## The FUNC should return a list of items that might match. 3484## 3485## completion_matches will return that list, with the longest common 3486## prefix prepended as the first item of the list. Therefor, the list 3487## will either be of zero length (meaning no matches) or of 2 or more..... 3488## 3489 3490## Works with &rl_basic_commands. Return items from @rl_basic_commands 3491## that start with the pattern in $text. 3492sub use_basic_commands { 3493 my ($text, $line, $start) = @_; 3494 return () if $start != 0; 3495 grep(/^$text/, @rl_basic_commands); 3496} 3497 3498sub completion_matches 3499{ 3500 my ($func, $text, $line, $start) = @_; 3501 3502 ## get the raw list 3503 my @matches; 3504 3505 #print qq/\r\neval("\@matches = &$func(\$text, \$line, \$start)\n\r/;#DEBUG 3506 #eval("\@matches = &$func(\$text, \$line, \$start);1") || warn "$@ "; 3507 @matches = &$func($text, $line, $start); 3508 3509 ## if anything returned , find the common prefix among them 3510 if (@matches) { 3511 my $prefix = $matches[0]; 3512 my $len = length($prefix); 3513 for ($i = 1; $i < @matches; $i++) { 3514 next if substr($matches[$i], 0, $len) eq $prefix; 3515 $prefix = substr($prefix, 0, --$len); 3516 last if $len == 0; 3517 $i--; ## retry this one to see if the shorter one matches. 3518 } 3519 unshift(@matches, $prefix); ## make common prefix the first thing. 3520 } 3521 @matches; 3522} 3523 3524## 3525## For use in passing to completion_matches(), returns a list of 3526## filenames that begin with the given pattern. The user of this package 3527## can set $rl_completion_function to 'rl_filename_list' to restore the 3528## default of filename matching if they'd changed it earlier, either 3529## directly or via &rl_basic_commands. 3530## 3531sub rl_filename_list 3532{ 3533 my $pattern = $_[0]; 3534 my @files = (<$pattern*>); 3535 if ($var_CompleteAddsuffix) { 3536 foreach (@files) { 3537 if (-l $_) { 3538 $_ .= '@'; 3539 } elsif (-d _) { 3540 $_ .= '/'; 3541 } elsif (-x _) { 3542 $_ .= '*'; 3543 } elsif (-S _ || -p _) { 3544 $_ .= '='; 3545 } 3546 } 3547 } 3548 return @files; 3549} 3550 3551## 3552## For use by the user of the package. Called with a list of possible 3553## commands, will allow command completion on those commands, but only 3554## for the first word on a line. 3555## For example: &rl_basic_commands('set', 'quit', 'type', 'run'); 3556## 3557## This is for people that want quick and simple command completion. 3558## A more thoughtful implementation would set $rl_completion_function 3559## to a routine that would look at the context of the word being completed 3560## and return the appropriate possibilities. 3561## 3562sub rl_basic_commands 3563{ 3564 @rl_basic_commands = @_; 3565 $rl_completion_function = 'use_basic_commands'; 3566} 3567 3568## 3569## Print an array in columns like ls -C. Originally based on stuff 3570## (lsC2.pl) by utashiro@sran230.sra.co.jp (Kazumasa Utashiro). 3571## 3572sub pretty_print_list 3573{ 3574 my @list = @_; 3575 return unless @list; 3576 my ($lines, $columns, $mark, $index); 3577 3578 ## find width of widest entry 3579 my $maxwidth = 0; 3580 grep(length > $maxwidth && ($maxwidth = length), @list); 3581 $maxwidth++; 3582 3583 $columns = $maxwidth >= $rl_screen_width 3584 ? 1 : int($rl_screen_width / $maxwidth); 3585 3586 ## if there's enough margin to interspurse among the columns, do so. 3587 $maxwidth += int(($rl_screen_width % $maxwidth) / $columns); 3588 3589 $lines = int((@list + $columns - 1) / $columns); 3590 $columns-- while ((($lines * $columns) - @list + 1) > $lines); 3591 3592 $mark = $#list - $lines; 3593 local $\ = ''; 3594 for ($l = 0; $l < $lines; $l++) { 3595 for ($index = $l; $index <= $mark; $index += $lines) { 3596 printf("%-$ {maxwidth}s", $list[$index]); 3597 } 3598 print $term_OUT $list[$index] if $index <= $#list; 3599 print $term_OUT "\n\r"; 3600 } 3601} 3602 3603##----------------- Vi Routines -------------------------------- 3604 3605sub F_ViAcceptLine 3606{ 3607 &F_AcceptLine(); 3608 &F_ViInput(); 3609} 3610 3611# Repeat the most recent one of these vi commands: 3612# 3613# a A c C d D i I p P r R s S x X ~ 3614# 3615sub F_ViRepeatLastCommand { 3616 my($count) = @_; 3617 return &F_Ding if !$Last_vi_command; 3618 3619 my @lastcmd = @$Last_vi_command; 3620 3621 # Multiply @lastcmd's numeric arg by $count. 3622 unless ($count == 1) { 3623 3624 my $n = ''; 3625 while (@lastcmd and $lastcmd[0] =~ /^\d$/) { 3626 $n *= 10; 3627 $n += shift(@lastcmd); 3628 } 3629 $count *= $n unless $n eq ''; 3630 unshift(@lastcmd, split(//, $count)); 3631 } 3632 3633 push(@Pending, @lastcmd); 3634} 3635 3636sub F_ViMoveCursor 3637{ 3638 my($count, $ord) = @_; 3639 3640 my $new_cursor = &get_position($count, $ord, undef, $Vi_move_patterns); 3641 return &F_Ding if !defined $new_cursor; 3642 3643 $D = $new_cursor; 3644} 3645 3646sub F_ViFindMatchingParens { 3647 3648 # Move to the first parens at or after $D 3649 my $old_d = $D; 3650 &forward_scan(1, q/[^[\](){}]*/); 3651 my $parens = substr($line, $D, 1); 3652 3653 my $mate_direction = { 3654 '(' => [ ')', 1 ], 3655 '[' => [ ']', 1 ], 3656 '{' => [ '}', 1 ], 3657 ')' => [ '(', -1 ], 3658 ']' => [ '[', -1 ], 3659 '}' => [ '{', -1 ], 3660 3661 }->{$parens}; 3662 3663 return &F_Ding() unless $mate_direction; 3664 3665 my($mate, $direction) = @$mate_direction; 3666 3667 my $lvl = 1; 3668 while ($lvl) { 3669 last if !$D && ($direction < 0); 3670 &F_ForwardChar($direction); 3671 last if &at_end_of_line; 3672 my $c = substr($line, $D, 1); 3673 if ($c eq $parens) { 3674 $lvl++; 3675 } 3676 elsif ($c eq $mate) { 3677 $lvl--; 3678 } 3679 } 3680 3681 if ($lvl) { 3682 # We didn't find a match 3683 $D = $old_d; 3684 return &F_Ding(); 3685 } 3686} 3687 3688sub F_ViForwardFindChar { 3689 &do_findchar(1, 1, @_); 3690} 3691 3692sub F_ViBackwardFindChar { 3693 &do_findchar(-1, 0, @_); 3694} 3695 3696sub F_ViForwardToChar { 3697 &do_findchar(1, 0, @_); 3698} 3699 3700sub F_ViBackwardToChar { 3701 &do_findchar(-1, 1, @_); 3702} 3703 3704sub F_ViMoveCursorTo 3705{ 3706 &do_findchar(1, -1, @_); 3707} 3708 3709sub F_ViMoveCursorFind 3710{ 3711 &do_findchar(1, 0, @_); 3712} 3713 3714 3715sub F_ViRepeatFindChar { 3716 my($n) = @_; 3717 return &F_Ding if !defined $Last_findchar; 3718 &findchar(@$Last_findchar, $n); 3719} 3720 3721sub F_ViInverseRepeatFindChar { 3722 my($n) = @_; 3723 return &F_Ding if !defined $Last_findchar; 3724 my($c, $direction, $offset) = @$Last_findchar; 3725 &findchar($c, -$direction, $offset, $n); 3726} 3727 3728sub do_findchar { 3729 my($direction, $offset, $n) = @_; 3730 my $c = &getc_with_pending; 3731 $c = &getc_with_pending if $c eq "\cV"; 3732 return &F_ViCommandMode if $c eq "\e"; 3733 $Last_findchar = [$c, $direction, $offset]; 3734 &findchar($c, $direction, $offset, $n); 3735} 3736 3737sub findchar { 3738 my($c, $direction, $offset, $n) = @_; 3739 my $old_d = $D; 3740 while ($n) { 3741 last if !$D && ($direction < 0); 3742 &F_ForwardChar($direction); 3743 last if &at_end_of_line; 3744 my $char = substr($line, $D, 1); 3745 $n-- if substr($line, $D, 1) eq $c; 3746 } 3747 if ($n) { 3748 # Not found 3749 $D = $old_d; 3750 return &F_Ding; 3751 } 3752 &F_ForwardChar($offset); 3753} 3754 3755sub F_ViMoveToColumn { 3756 my($n) = @_; 3757 $D = 0; 3758 my $col = 1; 3759 while (!&at_end_of_line and $col < $n) { 3760 my $c = substr($line, $D, 1); 3761 if ($c eq "\t") { 3762 $col += 7; 3763 $col -= ($col % 8) - 1; 3764 } 3765 else { 3766 $col++; 3767 } 3768 $D += &CharSize($D); 3769 } 3770} 3771 3772sub start_dot_buf { 3773 my($count, $ord) = @_; 3774 $Dot_buf = [pack('c', $ord)]; 3775 unshift(@$Dot_buf, split(//, $count)) if $count > 1; 3776 $Dot_state = savestate(); 3777} 3778 3779sub end_dot_buf { 3780 # We've recognized an editing command 3781 3782 # Save the command keystrokes for use by '.' 3783 $Last_vi_command = $Dot_buf; 3784 undef $Dot_buf; 3785 3786 # Save the pre-command state for use by 'u' and 'U'; 3787 $Vi_undo_state = $Dot_state; 3788 $Vi_undo_all_state = $Dot_state if !$Vi_undo_all_state; 3789 3790 # Make sure the current line is treated as new line for history purposes. 3791 $rl_HistoryIndex = $#rl_History + 1; 3792} 3793 3794sub save_dot_buf { 3795 &start_dot_buf(@_); 3796 &end_dot_buf; 3797} 3798 3799sub F_ViUndo { 3800 return &F_Ding unless defined $Vi_undo_state; 3801 my $state = savestate(); 3802 &getstate($Vi_undo_state); 3803 $Vi_undo_state = $state; 3804} 3805 3806sub F_ViUndoAll { 3807 $Vi_undo_state = $Vi_undo_all_state; 3808 &F_ViUndo; 3809} 3810 3811sub F_ViChange 3812{ 3813 my($count, $ord) = @_; 3814 &start_dot_buf(@_); 3815 &do_delete($count, $ord, $Vi_change_patterns) || return(); 3816 &vi_input_mode; 3817} 3818 3819sub F_ViDelete 3820{ 3821 my($count, $ord) = @_; 3822 &start_dot_buf(@_); 3823 &do_delete($count, $ord, $Vi_delete_patterns); 3824 &end_dot_buf; 3825} 3826 3827sub do_delete { 3828 3829 my($count, $ord, $poshash) = @_; 3830 3831 my $other_end = &get_position($count, undef, $ord, $poshash); 3832 return &F_Ding if !defined $other_end; 3833 3834 if ($other_end < 0) { 3835 # dd - delete entire line 3836 &kill_text(0, length($line), 1); 3837 } 3838 else { 3839 &kill_text($D, $other_end, 1); 3840 } 3841 3842 1; # True return value 3843} 3844 3845sub F_ViDeleteChar { 3846 my($count) = @_; 3847 &save_dot_buf(@_); 3848 my $other_end = $D + $count; 3849 $other_end = length($line) if $other_end > length($line); 3850 &kill_text($D, $other_end, 1); 3851} 3852 3853sub F_ViBackwardDeleteChar { 3854 my($count) = @_; 3855 &save_dot_buf(@_); 3856 my $other_end = $D - $count; 3857 $other_end = 0 if $other_end < 0; 3858 &kill_text($other_end, $D, 1); 3859 $D = $other_end; 3860} 3861 3862## 3863## Prepend line with '#', add to history, and clear the input buffer 3864## (this feature was borrowed from ksh). 3865## 3866sub F_SaveLine 3867{ 3868 local $\ = ''; 3869 $line = '#'.$line; 3870 &redisplay(); 3871 print $term_OUT "\r\n"; 3872 &add_line_to_history; 3873 $line_for_revert = ''; 3874 &get_line_from_history(scalar @rl_History); 3875 &F_ViInput() if $Vi_mode; 3876} 3877 3878# 3879# Come here if we see a non-positioning keystroke when a positioning 3880# keystroke is expected. 3881# 3882sub F_ViNonPosition { 3883 # Not a positioning command - undefine the cursor to indicate the error 3884 # to get_position(). 3885 undef $D; 3886} 3887 3888# 3889# Come here if we see <esc><char>, but *not* an arrow key or other 3890# mapped sequence, when a positioning keystroke is expected. 3891# 3892sub F_ViPositionEsc { 3893 my($count, $ord) = @_; 3894 3895 # We got <esc><char> in vipos mode. Put <char> back onto the 3896 # input stream and terminate the positioning command. 3897 unshift(@Pending, pack('c', $ord)); 3898 &F_ViNonPosition; 3899} 3900 3901# Interpret vi positioning commands 3902sub get_position { 3903 my ($count, $ord, $fullline_ord, $poshash) = @_; 3904 3905 # Manipulate a copy of the cursor, not the real thing 3906 local $D = $D; 3907 3908 # $ord (first character of positioning command) is an optional argument. 3909 $ord = ord(&getc_with_pending) if !defined $ord; 3910 3911 # Detect double character (for full-line operation, e.g. dd) 3912 return -1 if defined $fullline_ord and $ord == $fullline_ord; 3913 3914 my $re = $poshash->{$ord}; 3915 3916 if ($re) { 3917 my $c = pack('c', $ord); 3918 if (lc($c) eq 'b') { 3919 &backward_scan($count, $re); 3920 } 3921 else { 3922 &forward_scan($count, $re); 3923 } 3924 } 3925 else { 3926 # Move the local copy of the cursor 3927 &do_command($var_EditingMode{'vipos'}, $count, $ord); 3928 } 3929 3930 # Return the new cursor (undef if illegal command) 3931 $D; 3932} 3933 3934## 3935## Go to first non-space character of line. 3936## 3937sub F_ViFirstWord 3938{ 3939 $D = 0; 3940 &forward_scan(1, q{\s+}); 3941} 3942 3943sub forward_scan { 3944 my($count, $re) = @_; 3945 while ($count--) { 3946 last unless substr($line, $D) =~ m{^($re)}; 3947 $D += length($1); 3948 } 3949} 3950 3951sub backward_scan { 3952 my($count, $re) = @_; 3953 while ($count--) { 3954 last unless substr($line, 0, $D) =~ m{($re)$}; 3955 $D -= length($1); 3956 } 3957} 3958 3959# Note: like the emacs case transforms, this doesn't work for 3960# two-byte characters. 3961sub F_ViToggleCase { 3962 my($count) = @_; 3963 &save_dot_buf(@_); 3964 while ($count-- > 0) { 3965 substr($line, $D, 1) =~ tr/A-Za-z/a-zA-Z/; 3966 &F_ForwardChar(1); 3967 if (&at_end_of_line) { 3968 &F_BackwardChar(1); 3969 last; 3970 } 3971 } 3972} 3973 3974# Go to the numbered history line, as listed by the 'H' command, i.e. the 3975# current $line is line 1, the youngest line in @rl_History is 2, etc. 3976sub F_ViHistoryLine { 3977 my($n) = @_; 3978 &get_line_from_history(@rl_History - $n + 1); 3979} 3980 3981sub get_line_from_history { 3982 my($n) = @_; 3983 return &F_Ding if $n < 0 or $n > @rl_History; 3984 return if $n == $rl_HistoryIndex; 3985 3986 # If we're moving from the currently-edited line, save it for later. 3987 $line_for_revert = $line if $rl_HistoryIndex == @rl_History; 3988 3989 # Get line from history buffer (or from saved edit line). 3990 $line = ($n == @rl_History) ? $line_for_revert : $rl_History[$n]; 3991 $D = $Vi_mode ? 0 : length $line; 3992 3993 # Subsequent 'U' will bring us back to this point. 3994 $Vi_undo_all_state = savestate() if $Vi_mode; 3995 3996 $rl_HistoryIndex = $n; 3997} 3998 3999sub F_PrintHistory { 4000 my($count) = @_; 4001 4002 $count = 20 if $count == 1; # Default - assume 'H', not '1H' 4003 my $end = $rl_HistoryIndex + $count/2; 4004 $end = @rl_History if $end > @rl_History; 4005 my $start = $end - $count + 1; 4006 $start = 0 if $start < 0; 4007 4008 my $lmh = length $rl_MaxHistorySize; 4009 4010 my $lspace = ' ' x ($lmh+3); 4011 my $hdr = "$lspace-----"; 4012 $hdr .= " (Use ESC <num> UP to retrieve command <num>) -----" unless $Vi_mode; 4013 $hdr .= " (Use '<num>G' to retrieve command <num>) -----" if $Vi_mode; 4014 4015 local ($\, $,) = ('',''); 4016 print "\n$hdr\n"; 4017 print $lspace, ". . .\n" if $start > 0; 4018 my $i; 4019 my $shift = ($Vi_mode != 0); 4020 for $i ($start .. $end) { 4021 print + ($i == $rl_HistoryIndex) ? '>' : ' ', 4022 4023 sprintf("%${lmh}d: ", @rl_History - $i + $shift), 4024 4025 ($i < @rl_History) ? $rl_History[$i] : 4026 ($i == $rl_HistoryIndex) ? $line : 4027 $line_for_revert, 4028 4029 "\n"; 4030 } 4031 print $lspace, ". . .\n" if $end < @rl_History; 4032 print "$hdr\n"; 4033 4034 &force_redisplay(); 4035 4036 &F_ViInput() if $line eq '' && $Vi_mode; 4037} 4038 4039# Redisplay the line, without attempting any optimization 4040sub force_redisplay { 4041 local $force_redraw = 1; 4042 &redisplay(@_); 4043} 4044 4045# Search history for matching string. As with vi in nomagic mode, the 4046# ^, $, \<, and \> positional assertions, the \* quantifier, the \. 4047# character class, and the \[ character class delimiter all have special 4048# meaning here. 4049sub F_ViSearch { 4050 my($n, $ord) = @_; 4051 4052 my $c = pack('c', $ord); 4053 4054 my $str = &get_vi_search_str($c); 4055 if (!defined $str) { 4056 # Search aborted by deleting the '/' at the beginning of the line 4057 return &F_ViInput() if $line eq ''; 4058 return(); 4059 } 4060 4061 # Null string repeats last search 4062 if ($str eq '') { 4063 return &F_Ding unless defined $Vi_search_re; 4064 } 4065 else { 4066 # Convert to a regular expression. Interpret $str Like vi in nomagic 4067 # mode: '^', '$', '\<', and '\>' positional assertions, '\*' 4068 # quantifier, '\.' and '\[]' character classes. 4069 4070 my @chars = ($str =~ m{(\\?.)}g); 4071 my(@re, @tail); 4072 unshift(@re, shift(@chars)) if @chars and $chars[0] eq '^'; 4073 push (@tail, pop(@chars)) if @chars and $chars[-1] eq '$'; 4074 my $in_chclass; 4075 my %chmap = ( 4076 '\<' => '\b(?=\w)', 4077 '\>' => '(?<=\w)\b', 4078 '\*' => '*', 4079 '\[' => '[', 4080 '\.' => '.', 4081 ); 4082 my $ch; 4083 foreach $ch (@chars) { 4084 if ($in_chclass) { 4085 # Any backslashes in vi char classes are literal 4086 push(@re, "\\") if length($ch) > 1; 4087 push(@re, $ch); 4088 $in_chclass = 0 if $ch =~ /\]$/; 4089 } 4090 else { 4091 push(@re, (length $ch == 2) ? ($chmap{$ch} || $ch) : 4092 ($ch =~ /^\w$/) ? $ch : 4093 ("\\", $ch)); 4094 $in_chclass = 1 if $ch eq '\['; 4095 } 4096 } 4097 my $re = join('', @re, @tail); 4098 $Vi_search_re = q{$re}; 4099 } 4100 4101 local $reverse = $Vi_search_reverse = ($c eq '/') ? 1 : 0; 4102 &do_vi_search(); 4103} 4104 4105sub F_ViRepeatSearch { 4106 my($n, $ord) = @_; 4107 my $c = pack('c', $ord); 4108 return &F_Ding unless defined $Vi_search_re; 4109 local $reverse = $Vi_search_reverse; 4110 $reverse ^= 1 if $c eq 'N'; 4111 &do_vi_search(); 4112} 4113 4114## returns a new $i or -1 if not found. 4115sub vi_search { 4116 my ($i) = @_; 4117 return -1 if $i < 0 || $i > $#rl_History; ## for safety 4118 while (1) { 4119 return $i if $rl_History[$i] =~ /$Vi_search_re/; 4120 if ($reverse) { 4121 return -1 if $i-- == 0; 4122 } else { 4123 return -1 if $i++ == $#rl_History; 4124 } 4125 } 4126} 4127 4128sub do_vi_search { 4129 my $incr = $reverse ? -1 : 1; 4130 4131 my $i = &vi_search($rl_HistoryIndex + $incr); 4132 return &F_Ding if $i < 0; # Not found. 4133 4134 $rl_HistoryIndex = $i; 4135 ($D, $line) = (0, $rl_History[$rl_HistoryIndex]); 4136} 4137 4138# Using local $line, $D, and $prompt, get and return the string to search for. 4139sub get_vi_search_str { 4140 my($c) = @_; 4141 4142 local $prompt = $prompt . $c; 4143 local ($line, $D) = ('', 0); 4144 &redisplay(); 4145 4146 # Gather a search string in our local $line. 4147 while ($lastcommand ne 'F_ViEndSearch') { 4148 &do_command($var_EditingMode{'visearch'}, 1, ord(&getc_with_pending)); 4149 &redisplay(); 4150 4151 # We've backspaced past beginning of line 4152 return undef if !defined $line; 4153 } 4154 $line; 4155} 4156 4157sub F_ViEndSearch {} 4158 4159sub F_ViSearchBackwardDeleteChar { 4160 if ($line eq '') { 4161 # Backspaced past beginning of line - terminate search mode 4162 undef $line; 4163 } 4164 else { 4165 &F_BackwardDeleteChar(@_); 4166 } 4167} 4168 4169## 4170## Kill entire line and enter input mode 4171## 4172sub F_ViChangeEntireLine 4173{ 4174 &start_dot_buf(@_); 4175 kill_text(0, length($line), 1); 4176 &vi_input_mode; 4177} 4178 4179## 4180## Kill characters and enter input mode 4181## 4182sub F_ViChangeChar 4183{ 4184 &start_dot_buf(@_); 4185 &F_DeleteChar(@_); 4186 &vi_input_mode; 4187} 4188 4189sub F_ViReplaceChar 4190{ 4191 &start_dot_buf(@_); 4192 my $c = &getc_with_pending; 4193 $c = &getc_with_pending if $c eq "\cV"; # ctrl-V 4194 return &F_ViCommandMode if $c eq "\e"; 4195 &end_dot_buf; 4196 4197 local $InsertMode = 0; 4198 local $D = $D; # Preserve cursor position 4199 &F_SelfInsert(1, ord($c)); 4200} 4201 4202## 4203## Kill from cursor to end of line and enter input mode 4204## 4205sub F_ViChangeLine 4206{ 4207 &start_dot_buf(@_); 4208 &F_KillLine(@_); 4209 &vi_input_mode; 4210} 4211 4212sub F_ViDeleteLine 4213{ 4214 &save_dot_buf(@_); 4215 &F_KillLine(@_); 4216} 4217 4218sub F_ViPut 4219{ 4220 my($count) = @_; 4221 &save_dot_buf(@_); 4222 my $text2add = $KillBuffer x $count; 4223 my $ll = length($line); 4224 $D++; 4225 $D = $ll if $D > $ll; 4226 substr($line, $D, 0) = $KillBuffer x $count; 4227 $D += length($text2add) - 1; 4228} 4229 4230sub F_ViPutBefore 4231{ 4232 &save_dot_buf(@_); 4233 &TextInsert($_[0], $KillBuffer); 4234} 4235 4236sub F_ViYank 4237{ 4238 my($count, $ord) = @_; 4239 my $pos = &get_position($count, undef, $ord, $Vi_yank_patterns); 4240 &F_Ding if !defined $pos; 4241 if ($pos < 0) { 4242 # yy 4243 &F_ViYankLine; 4244 } 4245 else { 4246 my($from, $to) = ($pos > $D) ? ($D, $pos) : ($pos, $D); 4247 $KillBuffer = substr($line, $from, $to-$from); 4248 } 4249} 4250 4251sub F_ViYankLine 4252{ 4253 $KillBuffer = $line; 4254} 4255 4256sub F_ViInput 4257{ 4258 @_ = (1, ord('i')) if !@_; 4259 &start_dot_buf(@_); 4260 &vi_input_mode; 4261} 4262 4263sub F_ViBeginInput 4264{ 4265 &start_dot_buf(@_); 4266 &F_BeginningOfLine; 4267 &vi_input_mode; 4268} 4269 4270sub F_ViReplaceMode 4271{ 4272 &start_dot_buf(@_); 4273 $InsertMode = 0; 4274 $var_EditingMode = $var_EditingMode{'vi'}; 4275 $Vi_mode = 1; 4276} 4277 4278sub vi_input_mode 4279{ 4280 $InsertMode = 1; 4281 $var_EditingMode = $var_EditingMode{'vi'}; 4282 $Vi_mode = 1; 4283} 4284 4285# The previous keystroke was an escape, but the sequence was not recognized 4286# as a mapped sequence (like an arrow key). Enter vi comand mode and 4287# process this keystroke. 4288sub F_ViAfterEsc { 4289 my($n, $ord) = @_; 4290 &F_ViCommandMode; 4291 &do_command($var_EditingMode, 1, $ord); 4292} 4293 4294sub F_ViAppend 4295{ 4296 &start_dot_buf(@_); 4297 &vi_input_mode; 4298 &F_ForwardChar; 4299} 4300 4301sub F_ViAppendLine 4302{ 4303 &start_dot_buf(@_); 4304 &vi_input_mode; 4305 &F_EndOfLine; 4306} 4307 4308sub F_ViCommandMode 4309{ 4310 $var_EditingMode = $var_EditingMode{'vicmd'}; 4311 $Vi_mode = 1; 4312} 4313 4314sub F_ViAcceptInsert { 4315 local $in_accept_line = 1; 4316 &F_ViEndInsert; 4317 &F_ViAcceptLine; 4318} 4319 4320sub F_ViEndInsert 4321{ 4322 if ($Dot_buf) { 4323 if ($line eq '' and $Dot_buf->[0] eq 'i') { 4324 # We inserted nothing into an empty $line - assume it was a 4325 # &F_ViInput() call with no arguments, and don't save command. 4326 undef $Dot_buf; 4327 } 4328 else { 4329 # Regardless of which keystroke actually terminated this insert 4330 # command, replace it with an <esc> in the dot buffer. 4331 @{$Dot_buf}[-1] = "\e"; 4332 &end_dot_buf; 4333 } 4334 } 4335 &F_ViCommandMode; 4336 # Move cursor back to the last inserted character, but not when 4337 # we're about to accept a line of input 4338 &F_BackwardChar(1) unless $in_accept_line; 4339} 4340 4341sub F_ViDigit { 4342 my($count, $ord) = @_; 4343 4344 my $n = 0; 4345 my $ord0 = ord('0'); 4346 while (1) { 4347 4348 $n *= 10; 4349 $n += $ord - $ord0; 4350 4351 my $c = &getc_with_pending; 4352 return unless defined $c; 4353 $ord = ord($c); 4354 last unless $c =~ /^\d$/; 4355 } 4356 4357 $n *= $count; # So 2d3w deletes six words 4358 $n = $rl_max_numeric_arg if $n > $rl_max_numeric_arg; 4359 4360 &do_command($var_EditingMode, $n, $ord); 4361} 4362 4363sub F_ViComplete { 4364 my($n, $ord) = @_; 4365 4366 $Dot_state = savestate(); # Completion is undo-able 4367 undef $Dot_buf; # but not redo-able 4368 4369 my $ch; 4370 while (1) { 4371 4372 &F_Complete() or return; 4373 4374 # Vi likes the cursor one character right of where emacs like it. 4375 &F_ForwardChar(1); 4376 &force_redisplay(); 4377 4378 # Look ahead to the next input keystroke. 4379 $ch = &getc_with_pending(); 4380 last unless ord($ch) == $ord; # Not a '\' - quit. 4381 4382 # Another '\' was typed - put the cursor back where &F_Complete left 4383 # it, and try again. 4384 &F_BackwardChar(1); 4385 $lastcommand = 'F_Complete'; # Play along with &F_Complete's kludge 4386 } 4387 unshift(@Pending, $ch); # Unget the lookahead keystroke 4388 4389 # Successful completion - enter input mode with cursor beyond end of word. 4390 &vi_input_mode; 4391} 4392 4393sub F_ViInsertPossibleCompletions { 4394 $Dot_state = savestate(); # Completion is undo-able 4395 undef $Dot_buf; # but not redo-able 4396 4397 &complete_internal('*') or return; 4398 4399 # Successful completion - enter input mode with cursor beyond end of word. 4400 &F_ForwardChar(1); 4401 &vi_input_mode; 4402} 4403 4404sub F_ViPossibleCompletions { 4405 4406 # List possible completions 4407 &complete_internal('?'); 4408 4409 # Enter input mode with cursor where we left off. 4410 &F_ForwardChar(1); 4411 &vi_input_mode; 4412} 4413 4414sub F_SetMark { 4415 $rl_mark = $D; 4416 pos $line = $rl_mark; 4417 $line_rl_mark = $rl_HistoryIndex; 4418 $force_redraw = 1; 4419} 4420 4421sub F_ExchangePointAndMark { 4422 return F_Ding unless $line_rl_mark == $rl_HistoryIndex; 4423 ($rl_mark, $D) = ($D, $rl_mark); 4424 pos $line = $rl_mark; 4425 $D = length $line if $D > length $line; 4426 $force_redraw = 1; 4427} 4428 4429sub F_KillRegion { 4430 return F_Ding unless $line_rl_mark == $rl_HistoryIndex; 4431 $rl_mark = length $line if $rl_mark > length $line; 4432 kill_text($rl_mark, $D, 1); 4433 $line_rl_mark = -1; # Disable mark 4434} 4435 4436sub F_CopyRegionAsKill { 4437 return F_Ding unless $line_rl_mark == $rl_HistoryIndex; 4438 $rl_mark = length $line if $rl_mark > length $line; 4439 my ($s, $e) = ($rl_mark, $D); 4440 ($s, $e) = ($e, $s) if $s > $e; 4441 $ThisCommandKilledText = 1 + $s; 4442 $KillBuffer = '' if !$LastCommandKilledText; 4443 $KillBuffer .= substr($line, $s, $e - $s); 4444} 4445 4446sub clipboard_set { 4447 my $in = shift; 4448 if ($^O eq 'os2') { 4449 eval { 4450 require OS2::Process; 4451 OS2::Process::ClipbrdText_set($in); # Do not disable \r\n-conversion 4452 1 4453 } and return; 4454 } elsif ($^O eq 'MSWin32') { 4455 eval { 4456 require Win32::Clipboard; 4457 Win32::Clipboard::Set($in); 4458 1 4459 } and return; 4460 } 4461 my $mess; 4462 if ($ENV{RL_CLCOPY_CMD}) { 4463 $mess = "Writing to pipe `$ENV{RL_CLCOPY_CMD}'"; 4464 open COPY, "| $ENV{RL_CLCOPY_CMD}" or warn("$mess: $!"), return; 4465 } elsif (defined $ENV{HOME}) { 4466 $mess = "Writing to file `$ENV{HOME}/.rl_cutandpaste'"; 4467 open COPY, "> $ENV{HOME}/.rl_cutandpaste" or warn("$mess: $!"), return; 4468 } else { 4469 return; 4470 } 4471 print COPY $in; 4472 close COPY or warn("$mess: closing $!"); 4473} 4474 4475sub F_CopyRegionAsKillClipboard { 4476 return clipboard_set($line) unless $line_rl_mark == $rl_HistoryIndex; 4477 &F_CopyRegionAsKill; 4478 clipboard_set($KillBuffer); 4479} 4480 4481sub F_KillRegionClipboard { 4482 &F_KillRegion; 4483 clipboard_set($KillBuffer); 4484} 4485 4486sub F_YankClipboard 4487{ 4488 remove_selection(); 4489 my $in; 4490 if ($^O eq 'os2') { 4491 eval { 4492 require OS2::Process; 4493 $in = OS2::Process::ClipbrdText(); 4494 $in =~ s/\r\n/\n/g; # With old versions, or what? 4495 } 4496 } elsif ($^O eq 'MSWin32') { 4497 eval { 4498 require Win32::Clipboard; 4499 $in = Win32::Clipboard::GetText(); 4500 $in =~ s/\r\n/\n/g; # is this needed? 4501 } 4502 } else { 4503 my $mess; 4504 if ($ENV{RL_PASTE_CMD}) { 4505 $mess = "Reading from pipe `$ENV{RL_PASTE_CMD}'"; 4506 open PASTE, "$ENV{RL_PASTE_CMD} |" or warn("$mess: $!"), return; 4507 } elsif (defined $ENV{HOME}) { 4508 $mess = "Reading from file `$ENV{HOME}/.rl_cutandpaste'"; 4509 open PASTE, "< $ENV{HOME}/.rl_cutandpaste" or warn("$mess: $!"), return; 4510 } 4511 if ($mess) { 4512 local $/; 4513 $in = <PASTE>; 4514 close PASTE or warn("$mess, closing: $!"); 4515 } 4516 } 4517 if (defined $in) { 4518 $in =~ s/\n+$//; 4519 return &TextInsert($_[0], $in); 4520 } 4521 &TextInsert($_[0], $KillBuffer); 4522} 4523 4524sub F_BeginUndoGroup { 4525 push @undoGroupS, $#undo; 4526} 4527 4528sub F_EndUndoGroup { 4529 return F_Ding unless @undoGroupS; 4530 my $last = pop @undoGroupS; 4531 return unless $#undo > $last + 1; 4532 my $now = pop @undo; 4533 $#undo = $last; 4534 push @undo, $now; 4535} 4536 4537sub F_DoNothing { # E.g., reset digit-argument 4538 1; 4539} 4540 4541sub F_ForceMemorizeDigitArgument { 4542 $memorizedArg = shift; 4543} 4544 4545sub F_MemorizeDigitArgument { 4546 return if defined $memorizedArg; 4547 $memorizedArg = shift; 4548} 4549 4550sub F_UnmemorizeDigitArgument { 4551 $memorizedArg = undef; 4552} 4553 4554sub F_MemorizePos { 4555 $memorizedPos = $D; 4556} 4557 4558# It is assumed that F_MemorizePos was called, then something was inserted, 4559# then F_MergeInserts is called with a prefix argument to multiply 4560# insertion by 4561 4562sub F_MergeInserts { 4563 my $n = shift; 4564 return F_Ding unless defined $memorizedPos and $n > 0; 4565 my ($b, $e) = ($memorizedPos, $D); 4566 ($b, $e) = ($e, $b) if $e < $b; 4567 if ($n) { 4568 substr($line, $e, 0) = substr($line, $b, $e - $b) x ($n - 1); 4569 } else { 4570 substr($line, $b, $e - $b) = ''; 4571 } 4572 $D = $b + ($e - $b) * $n; 4573} 4574 4575sub F_ResetDigitArgument { 4576 return F_Ding unless defined $memorizedArg; 4577 my $in = &getc_with_pending; 4578 return unless defined $in; 4579 my $ord = ord $in; 4580 local(*KeyMap) = $var_EditingMode; 4581 &do_command(*KeyMap, $memorizedArg, $ord); 4582} 4583 4584sub F_BeginPasteGroup { 4585 my $c = shift; 4586 $memorizedArg = $c unless defined $memorizedArg; 4587 F_BeginUndoGroup(1); 4588 $memorizedPos = $D; 4589} 4590 4591sub F_EndPasteGroup { 4592 my $c = $memorizedArg; 4593 undef $memorizedArg; 4594 $c = 1 unless defined $c; 4595 F_MergeInserts($c); 4596 F_EndUndoGroup(1); 4597} 4598 4599sub F_BeginEditGroup { 4600 $memorizedArg = shift; 4601 F_BeginUndoGroup(1); 4602} 4603 4604sub F_EndEditGroup { 4605 undef $memorizedArg; 4606 F_EndUndoGroup(1); 4607} 4608 46091; 4610__END__ 4611