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