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