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