Term-ReadLine-Perl-1.0303/0000700000000000000000000000000011272001272011736 5ustar Term-ReadLine-Perl-1.0303/CHANGES0000700000000000000000000002404111272000026012731 0ustar 0.2: Test added. 0.3: Filehandles changed to \* from *, MinLine works, works with debugger. 0.4: Some bugs with $| corrected. Application name is set. Works under OS/2 without ReadKey. Should work under DOS with minimal changes (see $inDOS in ReadLine/readline.pl). 0.5: Code to support ReadLine'less debugger moved to debugger. One user reported that having .inputrc triggers the same bug that buggered earlier versions of the package. Request for a second readline is tried to be executed first, dying only if should work on a different terminal. 0.6: The above bug was due to missing vi keymap. Dirty workaround added. 0.7: We made ReadMode on term_OUT ;-( Better workaround for return of globs from a sub. Word break chars more suitable for Perl. 0.8: Insert, Operate, HistorySearch added. Rudimental support for tk being active during ReadLine. Should work better if ReadKey is present, but did not bootstrap. SelfLoader (and AutoLoader) supported (uncomment the lines with SelfLoader, ISA, and __DATA__). 0.9: tkRunning corrected. New attributes in Features: getHistory, setHistory, and new methods: GetHistory and SetHistory. After 0.9: Optional second argument to ->readline; [sg]etHistory, tkRunning features documented; Operate overwriting parameter fixed; AddHistory copied to addhistory in T::R::Perl; [SG]etHistory documented; tkRunning feature documented. eval "" => eval {} local => my After 0.91: Couple of bugs with my $var = @_; use SelfLoader; moved to DATA. Works in XTERM on OS/2. 0.93: Updates to Operate, couple of keybindings added. $rl_completer_terminator_character, $rl_correct_sw added. Reload-init-file moved to C-x C-x. C-x ? and C-x * list/insert possible completions (similar to tcsh globbing). For a second ReadLine interface ReadLine::Stub is used (unsuccessfully)? C-x * moves cursor correctly. 0.94: Should work everywhere where stty works (possibly with a warning). Warning says where to find TRK, switchable off. ReadLine.pm removed from distribution. 0.95: (from Jim Meyering): * readline.pm (preinit): Recognize bash's `input-meta' as a valid variable name. (F_ReReadInitFile): Recognize key binding directives in which the double-quoted RHS contains white space. (rl_set): Treat bash's `visible-stats' as a synonym of CompleteAddsuffix. Workaround against Term::ReadKey::ReadMode returning undef (thanks to Helmut Jarausch). 0.96: tkRunning support unrolled, now needs newer Term/ReadLine.pm to use it. Warnings from inputrc come only if -w. 0.97: Wrong version of Perl.pm was included, did not work with older Perls. 0.98: newTTY added. ornaments added. no longer installs into PERL dirs. Name of interface is now Term::ReadLine::Perl. Meta-flag tolerated (thanks to Honza Pazdziora). Bindings to \C-letter work again. 0.99: Buglet with -w corrected. 0.9901: Support for ornaments busted editing of long lines. 0.9902: Do not test TRL::Gnu in test.pl! Allow control-? in assignments. \M-\C- should work, as well as \x7F. (Thanks to Neil Bird!) 0.9903: Enable ornaments by default. Disable explicit ornaments in the test.pl. 0.9904: (thanks to Alexander Kourakos ) gave warnings for blank lines in my .inputrc showed underlined spaces in prompts (in xterm) which look ugly. 0.9905: (thanks to Wilson P. Snyder II wsnyder@maker.com) Fix reverse search. 0.9906: $readline::rl_getc added with the default value \&readline::rl_getc 0.9907: remove defined() noise. 0.9908: support $ENV{INPUTRC}. Advice users to look into *this* file for features... Joe.Petolino@Eng.Sun.COM added vi support (untested). Remove .gz-ness from Makefile.PL. 1.00: Ignore $/, $\, $,. Handle $include in RC file (by Roland Walker and Alexander Kourakos). Support "unsupported ioctl()". $rl_vi_replace_default_on_insert (by Russ Southern). Now we closely match the new syntax of .inputrc (by David Wollmann). Allow setenv PERL_RL_USE_TRK=0 to disable usage of Term::ReadKey. With $inDOS vicmd_map had conflicting definitions for #27. Removed spurious warnings from failing ioctl and stty. 1.01: Allow unset TERM. Wrong display and warnings if UP/DOWN reach a short line from a scrolled line Highlight the h-scroll indicators "<" ">" same as the prompt. Draw h-scroll indicator "<" even if a part of the prompt is shown. Scroll right if more than $rl_margin empty space is on the right. 1.02: Move reread-init to C-x C-r. Make C-x u and C-x C-u do undo. Set-mark: C-@, Control-Space on PC. Exchange-point-and-mark: C-x C-x. Kill-region: C-x C-w (as in lynx). Copy-region-as-kill: C-x w (kinda similar to Emacs). On PC, the last 2 and yank also available on Shift-Del, Control-Insert, Shift-Insert. Kill buffer is prepended or appended in natural manner. Disable detection of Japanese multibyte characters - conflicts with single-byte scripts. Reenable by $readline::_rl_japanese_mb = 1. 1.0201: Warnings due to a misprint fixed (thanks to Tatsuhiko Miyagawa). 1.0202: Warnings on highlight of the right scroll mark '<' fixed (thanks to Slaven Rezic). 1.0203: Unconditional titlecasing of .inputrc "values" broke settings with values such as 'vi' etc (thanks to Russ Southern for a report). 1.0204: Applied patches from Gurusamy and Slaven for vi mode: Logic to move insertion point one char back was wrong; Disable (YES!) choice of vi-mode based on $ENV{EDITOR}. Just in case: generate proper warning if an old $ket-bug resurrects. If readkey() returns undef, behave as on EOF. New option --no-print to test.pl. Try to move prompt to the next line if something is already on the current line (controlled by $rl_scroll_nextline, $rl_last_pos_can_backspace); Wrong setting of $rl_last_pos_can_backspace will result: a) 1 and wrong: empty line before the prompt; b) 0 and wrong: if the line contains 1 char only, (and no NL), the prompt will overwrite it; test with `perl -Mblib test.pl --no-print', type `print 1'. [This is not the same as termcap/am!]. New variable $readline::rl_default_selected; if true, default string is removed if the first keystroke is self-insert or BackSpace; test.pl modified to test this too; uses mr,me capabilities to highlight the default string. New command: SaveLine (on M-#). New command: PrintHistory (on M-h), PreviousHistory and NextHistory take count. The edited line is saved when one moves to history. 1.0205: Do not touch $ENV{HOME} unless defined. $ENV{AUTOMATED_TESTING} to skip interactive tests. 1.0206: Shift-Ins, Control-Ins, Shift-Del operate on clipboard (if available) (currently native on OS/2 only, otherwise uses commands $ENV{RL_PASTE_CMD}, $ENV{RL_CLCOPY_CMD}, or file $ENV{HOME}/.rl_cutandpaste). In absense of mark, CopyRegionAsKillClipboard operates on the whole line Completely ignore unknown variables in .inputrc. Moving cursor should remove the highlight of initial string too. Change some local() to my(). Region between point and mark is highlighted. Commands SelfInsert, Yank*, *DeleteChar remove this region if $rl_delete_selection is TRUE (default). (Set mark again to insert without removing.) 1.0207: If mark was active, redraw could be performed after Enter. Untested Win32 support for cut&paste. Alias $var_DeleteSelection for $rl_delete_selection (thus accessible via .inputrc). 1.0208: Allow 2-arg form for test.pl Open CONIN$ on Win (if asked for CON), and open RW (bug in Win devdriver). Allow non-first Digit-Arguments to be escaped too. Allow Alt-char translation to \M-char on DOSISH. Apparently, self-loaded empty subroutines crash 5.8.2; 5.8.7 OK. Work-around: put "1;" into non-implemented stuff. 1.03: Support for numeric arguments missed setting $lastcommand. MinLine would not return the old value etc. On MSWin32 without ReadKey, but with cygwin stty.exe: do binmode (since Enter sends \r in these settings) (XXXX we don't undo binmode; is it needed?) (Only Control-Key work; do "Control-[ key" for Meta) When optimizing "cursor" movement, take into account ornaments. Optimize "cursor" movement even if we redraw the line. Would display the string twice, even if cursor was at the end of the line. Add key binding for Control-Movement keys in xterm; and some OSX xterm. Do not prefer HPUX xterm bindings to "normal" XTerm bindings. New functions F_BeginUndoGroup F_EndUndoGroup F_DoNothing F_MemorizeDigitArgument F_ForceMemorizeDigitArgument F_UnmemorizeDigitArgument F_ResetDigitArgument F_MergeInserts F_MemorizePos (for better mouse support; untested) Undo list merges together states where the only change is position 1.0301: F_TransposeWords implemented Enable binmode() on MSWin32 if ReadMode succeeds. Since "normal" getc() returns 0 on "special keys" (as opposed to behaviour with reasonable CRT library, which would return a pair of keypresses 0 "keynumber"), to access special keys one needs something like C-[ for Esc, and C-[ c for Alt-c. Support \key with key in "abfnrtvd" in init files (\b/\d as C-?/C-d) and \ooo for octal. Allow single quotes in macro specifications, and backwacked quotes. Support macros (propagate numeric arguments). New functions F_BeginPasteGroup; F_EndPasteGroup; F_BeginEditGroup; F_EndEditGroup; bound to XTerm mouse editing Support ~/ in INPUTRC name and $include; $ENV{TRP_INPUTRC} overrides $ENV{INPUTRC}. New functions F_DoMetaVersion; F_DoControlVersion; bound as in Emacs: C-x Esc m and C-x Esc c. 1.0302: C-@ was incorrectly bound to a missing function SetPoint. C-x Esc c @ and C-x Esc c Space are now bound to SetMark, so do this if $inDOS too. Bind C-x @ c and C-x @ m too (as in Emacs). 1.0303: Would not allow macros with space in them. Never try to display the whole prompt unless it is shorter than screen width ;-). Test supports PERL_RL_TEST_PROMPT_MINLEN in environment. Test hints at special significance of the word `exit'. Avoid a warning on unexpected variable assign (thanks to Robin Barker). Change error message for unknown method. Protect global variables during WINCH processing. F_ReverseSearchHistory was not -w-safe (thanks to Peter Valdemar) Test for $ENV{PERL_MM_NONINTERACTIVE} also to abort tests. Term-ReadLine-Perl-1.0303/Makefile.PL0000700000000000000000000000064707111417732013733 0ustar use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( DISTNAME => 'Term-ReadLine-Perl', NAME => 'Term::ReadLine', VERSION_FROM => 'ReadLine/readline.pm', linkext => {LINKTYPE => '' }, # dist => {COMPRESS=>'gzip -9f', SUFFIX=>'gz', # DIST_DEFAULT => 'all uutardist'}, ); Term-ReadLine-Perl-1.0303/MANIFEST0000700000000000000000000000012206266401640013077 0ustar CHANGES MANIFEST Makefile.PL ReadLine/Perl.pm ReadLine/readline.pm README test.pl Term-ReadLine-Perl-1.0303/META.yml0000700000000000000000000000073611272001276013224 0ustar --- #YAML:1.0 name: Term-ReadLine-Perl version: 1.0303 abstract: ~ author: [] license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.54 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Term-ReadLine-Perl-1.0303/ReadLine/0000700000000000000000000000000011272001272013421 5ustar Term-ReadLine-Perl-1.0303/ReadLine/Perl.pm0000700000000000000000000001002511271775222014676 0ustar package Term::ReadLine::Perl; use Carp; @ISA = qw(Term::ReadLine::Stub Term::ReadLine::Compa Term::ReadLine::Perl::AU); #require 'readline.pl'; $VERSION = $VERSION = 1.0303; sub readline { shift; #my $in = &readline::readline(@_); #$loaded = defined &Term::ReadKey::ReadKey; #print STDOUT "\nrl=`$in', loaded = `$loaded'\n"; #if (ref \$in eq 'GLOB') { # Bug under debugger # ($in = "$in") =~ s/^\*(\w+::)+//; #} #print STDOUT "rl=`$in'\n"; #$in; } #sub addhistory {} *addhistory = \&AddHistory; #$term; $readline::minlength = 1; # To peacify -w $readline::rl_readline_name = undef; # To peacify -w $readline::rl_basic_word_break_characters = undef; # To peacify -w sub new { if (defined $term) { warn "Cannot create second readline interface, falling back to dumb.\n"; return Term::ReadLine::Stub::new(@_); } shift; # Package if (@_) { if ($term) { warn "Ignoring name of second readline interface.\n" if defined $term; shift; } else { $readline::rl_readline_name = shift; # Name } } if (!@_) { if (!defined $term) { ($IN,$OUT) = Term::ReadLine->findConsole(); # Old Term::ReadLine did not have a workaround for a bug in Win devdriver $IN = 'CONIN$' if $^O eq 'MSWin32' and "\U$IN" eq 'CON'; open IN, # A workaround for another bug in Win device driver (($IN eq 'CONIN$' and $^O eq 'MSWin32') ? "+< $IN" : "< $IN") or croak "Cannot open $IN for read"; open(OUT,">$OUT") || croak "Cannot open $OUT for write"; $readline::term_IN = \*IN; $readline::term_OUT = \*OUT; } } else { if (defined $term and ($term->IN ne $_[0] or $term->OUT ne $_[1]) ) { croak "Request for a second readline interface with different terminal"; } $readline::term_IN = shift; $readline::term_OUT = shift; } eval {require Term::ReadLine::readline}; die $@ if $@; # The following is here since it is mostly used for perl input: # $readline::rl_basic_word_break_characters .= '-:+/*,[])}'; $term = bless [$readline::term_IN,$readline::term_OUT]; unless ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/) { local $Term::ReadLine::termcap_nowarn = 1; # With newer Perls local $SIG{__WARN__} = sub {}; # With older Perls $term->ornaments(1); } return $term; } sub newTTY { my ($self, $in, $out) = @_; $readline::term_IN = $self->[0] = $in; $readline::term_OUT = $self->[1] = $out; my $sel = select($out); $| = 1; # for DB::OUT select($sel); } sub ReadLine {'Term::ReadLine::Perl'} sub MinLine { my $old = $readline::minlength; $readline::minlength = $_[1] if @_ == 2; return $old; } sub SetHistory { shift; @readline::rl_History = @_; $readline::rl_HistoryIndex = @readline::rl_History; } sub GetHistory { @readline::rl_History; } sub AddHistory { shift; push @readline::rl_History, @_; $readline::rl_HistoryIndex = @readline::rl_History + @_; } %features = (appname => 1, minline => 1, autohistory => 1, getHistory => 1, setHistory => 1, addHistory => 1, preput => 1, attribs => 1, 'newTTY' => 1, tkRunning => Term::ReadLine::Stub->Features->{'tkRunning'}, ornaments => Term::ReadLine::Stub->Features->{'ornaments'}, ); sub Features { \%features; } # my %attribs; tie %attribs, 'Term::ReadLine::Perl::Tie' or die ; sub Attribs { \%attribs; } sub DESTROY {} package Term::ReadLine::Perl::AU; sub AUTOLOAD { { $AUTOLOAD =~ s/.*:://; } # preserve match data my $name = "readline::rl_$AUTOLOAD"; die "Unknown method `$AUTOLOAD' in Term::ReadLine::Perl" unless exists $readline::{"rl_$AUTOLOAD"}; *$AUTOLOAD = sub { shift; &$name }; goto &$AUTOLOAD; } package Term::ReadLine::Perl::Tie; sub TIEHASH { bless {} } sub DESTROY {} sub STORE { my ($self, $name) = (shift, shift); $ {'readline::rl_' . $name} = shift; } sub FETCH { my ($self, $name) = (shift, shift); $ {'readline::rl_' . $name}; } package Term::ReadLine::Compa; sub get_c { my $self = shift; getc($self->[0]); } sub get_line { my $self = shift; my $fh = $self->[0]; scalar <$fh>; } 1; Term-ReadLine-Perl-1.0303/ReadLine/readline.pm0000700000000000000000000040456211271777046015602 0ustar ## ## Perl Readline -- The Quick Help ## (see the manual for complete info) ## ## Once this package is included (require'd), you can then call ## $text = &readline'readline($input); ## to get lines of input from the user. ## ## Normally, it reads ~/.inputrc when loaded... to suppress this, set ## $readline'rl_NoInitFromFile = 1; ## before requiring the package. ## ## Call rl_bind to add your own key bindings, as in ## &readline'rl_bind('C-L', 'possible-completions'); ## ## Call rl_set to set mode variables yourself, as in ## &readline'rl_set('TcshCompleteMode', 'On'); ## ## To change the input mode (emacs or vi) use ~/.inputrc or call ## &readline::rl_set('EditingMode', 'vi'); ## or &readline::rl_set('EditingMode', 'emacs'); ## ## Call rl_basic_commands to set your own command completion, as in ## &readline'rl_basic_commands('print', 'list', 'quit', 'run', 'status'); ## ## # Wrap the code below (initially Perl4, now partially Perl4) into a fake # Perl5 pseudo-module; mismatch of package and file name is intentional # to make is harder to abuse this (very fragile) code... package readline; my $autoload_broken = 1; # currently: defined does not work with a-l my $useioctl = 1; my $usestty = 1; my $max_include_depth = 10; # follow $include's in init files this deep BEGIN { # Some old systems have ioctl "unsupported" *ioctl = sub ($$$) { eval { ioctl $_[0], $_[1], $_[2] } }; } ## ## BLURB: ## A pretty full-function package similar to GNU's readline. ## Includes support for EUC-encoded Japanese text. ## ## Written by Jeffrey Friedl, Omron Corporation (jfriedl@omron.co.jp) ## ## Comments, corrections welcome. ## ## Thanks to the people at FSF for readline (and the code I referenced ## while writing this), and for Roland Schemers whose line_edit.pl I used ## as an early basis for this. ## $VERSION = $VERSION = '1.0303'; ## - Changes from Slaven Rezic (slaven@rezic.de): ## * reverted the usage of $ENV{EDITOR} to set startup mode ## only ~/.inputrc or an explicit call to rl_set should ## be used to set startup mode ## # 1011109.011 - Changes from Russ Southern (russ@dvns.com): ## * Added $rl_vi_replace_default_on_insert # 1000510.010 - Changes from Joe Petolino (petolino@eng.sun.com), requested ## by Ilya: ## ## * Make it compatible with perl 5.003. ## * Rename getc() to getc_with_pending(). ## * Change unshift(@Pending) to push(@Pending). ## ## 991109.009 - Changes from Joe Petolino (petolino@eng.sun.com): ## Added vi mode. Also added a way to set the keymap default ## action for multi-character keymaps, so that a 2-character ## sequence (e.g. A) can be treated as two one-character ## commands (, then A) if the sequence is not explicitly ## mapped. ## ## Changed subs: ## ## * preinit(): Initialize new keymaps and other data structures. ## Use $ENV{EDITOR} to set startup mode. ## ## * init(): Sets the global *KeyMap, since &F_ReReadInitFile ## may have changed the key map. ## ## * InitKeymap(): $KeyMap{default} is now optional - don't ## set it if $_[1] eq ''; ## ## * actually_do_binding(): Set $KeyMap{default} for '\*' key; ## warning if double-defined. ## ## * rl_bind(): Implement \* to set the keymap default. Also fix ## some existing regex bugs that I happened to notice. ## ## * readline(): No longer takes input from $pending before ## calling &$rl_getc(); instead, it calls getc_with_pending(), ## which takes input from the new array @Pending ## before calling &$rl_getc(). Sets the global ## *KeyMap after do_command(), since do_command() ## may change the keymap now. Does some cursor ## manipulation after do_command() when at the end ## of the line in vi command mode, to match the ## behavior of vi. ## ## * rl_getc(): Added a my declaration for $key, which was ## apparently omitted by the author. rl_getc() is ## no longer called directly; instead, getc_with_pending() calls ## it only after exhausting any requeued characters ## in @Pending. @Pending is used to implement the ## vi '.' command, as well as the emacs DoSearch ## functionality. ## ## * do_command(): Now defaults the command to 'F_Ding' if ## $KeyMap{default} is undefined. This is part ## of the new \* feature. ## ## * savestate()/getstate(): Now use an anonymous array instead ## of packing the fields into a string. ## ## * F_AcceptLine(): Code moved to new sub add_line_to_history(), ## so that it may be called by F_SaveLine() ## as well as by F_AcceptLine(). ## ## * F_QuotedInsert(): Calls getc_with_pending() instead of &$rl_getc(). ## ## * F_UnixWordRubout(): Fixed bug: changed 'my' declaration of ## global $rl_basic_word_break_characters to 'local'. ## ## * DoSearch(): Calls getc_with_pending() instead of &$rl_getc(). Ungets ## character onto @Pending instead of $pending. ## ## * F_EmacsEditingMode(): Resets global $Vi_mode; ## ## * F_ToggleEditingMode(): Deleted. We use F_ViInput() and ## F_EmacsEditingMode() instead. ## ## * F_PrefixMeta(): Calls getc_with_pending() instead of &$rl_getc(). ## ## * F_DigitArgument(): Calls getc_with_pending() instead of &$rl_getc(). ## ## * F_Ding(): Returns undef, for testing by vi commands. ## ## * F_Complete(): Returns true if a completion was done, false ## otherwise, so vi completion routines can test it. ## ## * complete_internal(): Returns true if a completion was done, ## false otherwise, so vi completion routines can ## test it. Does a little cursor massaging in vi ## mode, to match the behavior of ksh vi mode. ## ## Disclaimer: the original code dates from the perl 4 days, and ## isn't very pretty by today's standards (for example, ## extensive use of typeglobs and localized globals). In the ## interests of not breaking anything, I've tried to preserve ## the old code as much as possible, and I've avoided making ## major stylistic changes. Since I'm not a regular emacs user, ## I haven't done much testing to see that all the emacs-mode ## features still work. ## ## 940817.008 - Added $var_CompleteAddsuffix. ## Now recognizes window-change signals (at least on BSD). ## Various typos and bug fixes. ## Changes from Chris Arthur (csa@halcyon.com): ## Added a few new keybindings. ## Various typos and bug fixes. ## Support for use from a dumb terminal. ## Pretty-printing of filename-completion matches. ## ## 930306.007 - Added rl_start_default_at_beginning. ## Added optional message arg to &redisplay. ## Added explicit numeric argument var to functions that use it. ## Redid many commands to simplify. ## Added TransposeChars, UpcaseWord, CapitalizeWord, DownCaseWord. ## Redid key binding specs to better match GNU.. added ## undocumented "new-style" bindings.... can now bind ## arrow keys and other arbitrairly long key sequences. ## Added if/else/then to .inputrc. ## ## 930305.006 - optional "default" added (from mmuegel@cssmp.corp.mot.com). ## ## 930211.005 - fixed strange problem with eval while keybinding ## ## ## Ilya: ## ## Added support for ReadKey, ## ## Added customization variable $minlength ## to denote minimal lenth of a string to be put into history buffer. ## ## Added support for a bug in debugger: preinit cannot be a subroutine ?!!! ## (See immendiately below) ## ## Added support for WINCH hooks. The subroutine references should be put into ## @winchhooks. ## ## Added F_ToggleInsertMode, F_HistorySearchBackward, ## F_HistorySearchForward, PC keyboard bindings. ## 0.93: Updates to Operate, couple of keybindings added. ## $rl_completer_terminator_character, $rl_correct_sw added. ## Reload-init-file moved to C-x C-x. ## C-x ? and C-x * list/insert possible completions. $rl_getc = \&rl_getc; &preinit; &init; # # # # use strict 'vars'; # # # # # Separation into my and vars needs some thought... # # # # use vars qw(@KeyMap %KeyMap $rl_screen_width $rl_start_default_at_beginning # # # # $rl_completion_function $rl_basic_word_break_characters # # # # $rl_completer_word_break_characters $rl_special_prefixes # # # # $rl_readline_name @rl_History $rl_MaxHistorySize # # # # $rl_max_numeric_arg $rl_OperateCount # # # # $KillBuffer $dumb_term $stdin_not_tty $InsertMode # # # # $rl_NoInitFromFile); # # # # my ($InputLocMsg, $term_OUT, $term_IN); # # # # my ($winsz_t, $TIOCGWINSZ, $winsz, $rl_margin, $hooj, $force_redraw); # # # # my ($hook, %var_HorizontalScrollMode, %var_EditingMode, %var_OutputMeta); # # # # my ($var_HorizontalScrollMode, $var_EditingMode, $var_OutputMeta); # # # # my (%var_ConvertMeta, $var_ConvertMeta, %var_MarkModifiedLines, $var_MarkModifiedLines); # # # # my ($term_readkey, $inDOS); # # # # my (%var_PreferVisibleBell, $var_PreferVisibleBell); # # # # my (%var_TcshCompleteMode, $var_TcshCompleteMode); # # # # my (%var_CompleteAddsuffix, $var_CompleteAddsuffix); # # # # my ($minlength, @winchhooks); # # # # my ($BRKINT, $ECHO, $FIONREAD, $ICANON, $ICRNL, $IGNBRK, $IGNCR, $INLCR, # # # # $ISIG, $ISTRIP, $NCCS, $OPOST, $RAW, $TCGETS, $TCOON, $TCSETS, $TCXONC, # # # # $TERMIOS_CFLAG, $TERMIOS_IFLAG, $TERMIOS_LFLAG, $TERMIOS_NORMAL_IOFF, # # # # $TERMIOS_NORMAL_ION, $TERMIOS_NORMAL_LOFF, $TERMIOS_NORMAL_LON, # # # # $TERMIOS_NORMAL_OOFF, $TERMIOS_NORMAL_OON, $TERMIOS_OFLAG, # # # # $TERMIOS_READLINE_IOFF, $TERMIOS_READLINE_ION, $TERMIOS_READLINE_LOFF, # # # # $TERMIOS_READLINE_LON, $TERMIOS_READLINE_OOFF, $TERMIOS_READLINE_OON, # # # # $TERMIOS_VMIN, $TERMIOS_VTIME, $TIOCGETP, $TIOCGWINSZ, $TIOCSETP, # # # # $fion, $fionread_t, $mode, $sgttyb_t, # # # # $termios, $termios_t, $winsz, $winsz_t); # # # # my ($line, $initialized, $term_readkey); # # # # # Global variables added for vi mode (I'm leaving them all commented # # # # # out, like the declarations above, until SelfLoader issues # # # # # are resolved). # # # # # True when we're in one of the vi modes. # # # # my $Vi_mode; # # # # # Array refs: saves keystrokes for '.' command. Undefined when we're # # # # # not doing a '.'-able command. # # # # my $Dot_buf; # Working buffer # # # # my $Last_vi_command; # Gets $Dot_buf when a command is parsed # # # # # These hold state for vi 'u' and 'U'. # # # # my($Dot_state, $Vi_undo_state, $Vi_undo_all_state); # # # # # Refs to hashes used for cursor movement # # # # my($Vi_delete_patterns, $Vi_move_patterns, # # # # $Vi_change_patterns, $Vi_yank_patterns); # # # # # Array ref: holds parameters from the last [fFtT] command, for ';' # # # # # and ','. # # # # my $Last_findchar; # # # # # Globals for history search commands (/, ?, n, N) # # # # my $Vi_search_re; # Regular expression (compiled by qr{}) # # # # my $Vi_search_reverse; # True for '?' search, false for '/' ## ## What's Cool ## ---------------------------------------------------------------------- ## * hey, it's in perl. ## * Pretty full GNU readline like library... ## * support for ~/.inputrc ## * horizontal scrolling ## * command/file completion ## * rebinding ## * history (with search) ## * undo ## * numeric prefixes ## * supports multi-byte characters (at least for the Japanese I use). ## * Has a tcsh-like completion-function mode. ## call &readline'rl_set('tcsh-complete-mode', 'On') to turn on. ## ## ## What's not Cool ## ---------------------------------------------------------------------- ## Can you say HUGE? ## I can't spell, so comments riddled with misspellings. ## Written by someone that has never really used readline. ## History mechanism is slightly different than GNU... may get fixed ## someday, but I like it as it is now... ## Killbuffer not a ring.. just one level. ## Obviously not well tested yet. ## Written by someone that doesn't have a bell on his terminal, so ## proper readline use of the bell may not be here. ## ## ## Functions beginning with F_ are functions that are mapped to keys. ## Variables and functions beginning rl_ may be accessed/set/called/read ## from outside the package. Other things are internal. ## ## Some notable internal-only variables of global proportions: ## $prompt -- line prompt (passed from user) ## $line -- the line being input ## $D -- ``Dot'' -- index into $line of the cursor's location. ## $InsertMode -- usually true. False means overwrite mode. ## $InputLocMsg -- string for error messages, such as "[~/.inputrc line 2]" ## *emacs_keymap -- keymap for emacs-mode bindings: ## @emacs_keymap - bindings indexed by ASCII ordinal ## $emacs_keymap{'name'} = "emacs_keymap" ## $emacs_keymap{'default'} = "SelfInsert" (default binding) ## *vi_keymap -- keymap for vi input mode bindings ## *vicmd_keymap -- keymap for vi command mode bindings ## *vipos_keymap -- keymap for vi positioning command bindings ## *visearch_keymap -- keymap for vi search pattern input mode bindings ## *KeyMap -- current keymap in effect. ## $LastCommandKilledText -- needed so that subsequent kills accumulate ## $lastcommand -- name of command previously run ## $lastredisplay -- text placed upon screen during previous &redisplay ## $si -- ``screen index''; index into $line of leftmost char &redisplay'ed ## $force_redraw -- if set to true, causes &redisplay to be verbose. ## $AcceptLine -- when set, its value is returned from &readline. ## $ReturnEOF -- unless this also set, in which case undef is returned. ## @Pending -- characters to be used as input. ## @undo -- array holding all states of current line, for undoing. ## $KillBuffer -- top of kill ring (well, don't have a kill ring yet) ## @tcsh_complete_selections -- for tcsh mode, possible selections ## ## Some internal variables modified by &rl_set (see comment at &rl_set for ## info about how these set'able variables work) ## $var_EditingMode -- a keymap typeglob like *emacs_keymap or *vi_keymap ## $var_TcshCompleteMode -- if true, the completion function works like ## in tcsh. That is, the first time you try to complete something, ## the common prefix is completed for you. Subsequent completion tries ## (without other commands in between) cycles the command line through ## the various possibilities. If/when you get the one you want, just ## continue typing. ## Other $var_ things not supported yet. ## ## Some variables used internally, but may be accessed from outside... ## $VERSION -- just for good looks. ## $rl_readline_name = name of program -- for .initrc if/endif stuff. ## $rl_NoInitFromFile -- if defined when package is require'd, ~/.inputrc ## will not be read. ## @rl_History -- array of previous lines input ## $rl_HistoryIndex -- history pointer (for moving about history array) ## $rl_completion_function -- see "How Command Completion Works" (way) below. ## $rl_basic_word_break_characters -- string of characters that can cause ## a word break for forward-word, etc. ## $rl_start_default_at_beginning -- ## Normally, the user's cursor starts at the end of any default text ## passed to readline. If this variable is true, it starts at the ## beginning. ## $rl_completer_word_break_characters -- ## like $rl_basic_word_break_characters (and in fact defaults to it), ## but for the completion function. ## $rl_completer_terminator_character -- what to insert to separate ## a completed token from the rest. Reset at beginning of ## completion to ' ' so completion function can change it. ## $rl_special_prefixes -- characters that are part of this string as well ## as of $rl_completer_word_break_characters cause a word break for the ## completer function, but remain part of the word. An example: consider ## when the input might be perl code, and one wants to be able to ## complete on variable and function names, yet still have the '$', ## '&', '@',etc. part of the $text to be completed. Then set this var ## to '&@$%' and make sure each of these characters is in ## $rl_completer_word_break_characters as well.... ## $rl_MaxHistorySize -- maximum size that the history array may grow. ## $rl_screen_width -- width readline thinks it can use on the screen. ## $rl_correct_sw -- is substructed from the real width of the terminal ## $rl_margin -- scroll by moving to within this far from a margin. ## $rl_CLEAR -- what to output to clear the screen. ## $rl_max_numeric_arg -- maximum numeric arg allowed. ## $rl_vi_replace_default_on_insert ## Normally, the text you enter is added to any default text passed to ## readline. If this variable is true, default text will start out ## highlighted (if supported by your terminal) and text entered while the ## default is highlighted (during the _first_ insert mode only) will ## replace the entire default line. Once you have left insert mode (hit ## escape), everything works as normal. ## - This is similar to many GUI controls' behavior, which select the ## default text so that new text replaces the old. ## - Use with $rl_start_default_at_beginning for normal-looking behavior ## (though it works just fine without it). ## Notes/Bugs: ## - Control characters (like C-w) do not actually terminate this replace ## mode, for the same reason it does not work in emacs mode. ## - Spine-crawlingly scary subroutine redefinitions ## $rl_mark - start of the region ## $line_rl_mark - the line on which $rl_mark is active ## $_rl_japanese_mb - For character movement suppose Japanese (which?!) ## multi-byte encoding. (How to make a sane default?) ## sub get_window_size { my $sig = shift; local($., $@, $!, $^E, $?); # Preserve $! etc; the rest for hooks my ($num_cols,$num_rows); if (defined $term_readkey) { ($num_cols,$num_rows) = Term::ReadKey::GetTerminalSize($term_OUT); $rl_screen_width = $num_cols - $rl_correct_sw if defined($num_cols) && $num_cols; } elsif (defined $TIOCGWINSZ and &ioctl($term_IN,$TIOCGWINSZ,$winsz)) { ($num_rows,$num_cols) = unpack($winsz_t,$winsz); $rl_screen_width = $num_cols - $rl_correct_sw if defined($num_cols) && $num_cols; } $rl_margin = int($rl_screen_width/3); if (defined $sig) { $force_redraw = 1; &redisplay(); } for $hook (@winchhooks) { eval {&$hook()}; warn $@ if $@ and $^W; } local $^W = 0; # WINCH may be illegal... $SIG{'WINCH'} = "readline::get_window_size"; } # Fix: case-sensitivity of inputrc on/off keywords in # `set' commands. readline lib doesn't care about case. # changed case of keys 'On' and 'Off' to 'on' and 'off' # &rl_set changed so that it converts the value to # lower case before hash lookup. sub preinit { ## Set up the input and output handles $term_IN = \*STDIN unless defined $term_IN; $term_OUT = \*STDOUT unless defined $term_OUT; ## not yet supported... always on. $var_HorizontalScrollMode = 1; $var_HorizontalScrollMode{'On'} = 1; $var_HorizontalScrollMode{'Off'} = 0; $var_EditingMode{'emacs'} = *emacs_keymap; $var_EditingMode{'vi'} = *vi_keymap; $var_EditingMode{'vicmd'} = *vicmd_keymap; $var_EditingMode{'vipos'} = *vipos_keymap; $var_EditingMode{'visearch'} = *visearch_keymap; ## this is an addition. Very nice. $var_TcshCompleteMode = 0; $var_TcshCompleteMode{'On'} = 1; $var_TcshCompleteMode{'Off'} = 0; $var_CompleteAddsuffix = 1; $var_CompleteAddsuffix{'On'} = 1; $var_CompleteAddsuffix{'Off'} = 0; $var_DeleteSelection = $var_DeleteSelection{'On'} = 1; $var_DeleteSelection{'Off'} = 0; *rl_delete_selection = \$var_DeleteSelection; # Alias ## not yet supported... always on for ('InputMeta', 'OutputMeta') { ${"var_$_"} = 1; ${"var_$_"}{'Off'} = 0; ${"var_$_"}{'On'} = 1; } ## not yet supported... always off for ('ConvertMeta', 'MetaFlag', 'MarkModifiedLines', 'PreferVisibleBell', 'BlinkMatchingParen', 'VisibleStats', 'ShowAllIfAmbiguous', 'PrintCompletionsHorizontally', 'MarkDirectories', 'ExpandTilde', 'EnableKeypad', 'DisableCompletion', 'CompletionIgnoreCase') { ${"var_$_"} = 0; ${"var_$_"}{'Off'} = 0; ${"var_$_"}{'On'} = 1; } # To conform to interface $minlength = 1 unless defined $minlength; # WINCH hooks @winchhooks = (); $inDOS = $^O eq 'os2' || defined $ENV{OS2_SHELL} unless defined $inDOS; eval { require Term::ReadKey; $term_readkey++; } unless defined $ENV{PERL_RL_USE_TRK} and not $ENV{PERL_RL_USE_TRK}; unless ($term_readkey) { eval {require "ioctl.pl"}; ## try to get, don't die if not found. eval {require "sys/ioctl.ph"}; ## try to get, don't die if not found. eval {require "sgtty.ph"}; ## try to get, don't die if not found. if ($inDOS and !defined $TIOCGWINSZ) { $TIOCGWINSZ=0; $TIOCGETP=1; $TIOCSETP=2; $sgttyb_t="I5 C8"; $winsz_t=""; $RAW=0xf002; $ECHO=0x0008; } $TIOCGETP = &TIOCGETP if defined(&TIOCGETP); $TIOCSETP = &TIOCSETP if defined(&TIOCSETP); $TIOCGWINSZ = &TIOCGWINSZ if defined(&TIOCGWINSZ); $FIONREAD = &FIONREAD if defined(&FIONREAD); $TCGETS = &TCGETS if defined(&TCGETS); $TCSETS = &TCSETS if defined(&TCSETS); $TCXONC = &TCXONC if defined(&TCXONC); $TIOCGETP = 0x40067408 if !defined($TIOCGETP); $TIOCSETP = 0x80067409 if !defined($TIOCSETP); $TIOCGWINSZ = 0x40087468 if !defined($TIOCGWINSZ); $FIONREAD = 0x4004667f if !defined($FIONREAD); $TCGETS = 0x40245408 if !defined($TCGETS); $TCSETS = 0x80245409 if !defined($TCSETS); $TCXONC = 0x20005406 if !defined($TCXONC); ## TTY modes $ECHO = &ECHO if defined(&ECHO); $RAW = &RAW if defined(&RAW); $RAW = 040 if !defined($RAW); $ECHO = 010 if !defined($ECHO); #$CBREAK = 002 if !defined($CBREAK); $mode = $RAW; ## could choose CBREAK for testing.... $IGNBRK = 1 if !defined($IGNBRK); $BRKINT = 2 if !defined($BRKINT); $ISTRIP = 040 if !defined($ISTRIP); $INLCR = 0100 if !defined($INLCR); $IGNCR = 0200 if !defined($IGNCR); $ICRNL = 0400 if !defined($ICRNL); $OPOST = 1 if !defined($OPOST); $ISIG = 1 if !defined($ISIG); $ICANON = 2 if !defined($ICANON); $TCOON = 1 if !defined($TCOON); $TERMIOS_READLINE_ION = $BRKINT; $TERMIOS_READLINE_IOFF = $IGNBRK | $ISTRIP | $INLCR | $IGNCR | $ICRNL; $TERMIOS_READLINE_OON = 0; $TERMIOS_READLINE_OOFF = $OPOST; $TERMIOS_READLINE_LON = 0; $TERMIOS_READLINE_LOFF = $ISIG | $ICANON | $ECHO; $TERMIOS_NORMAL_ION = $BRKINT; $TERMIOS_NORMAL_IOFF = $IGNBRK; $TERMIOS_NORMAL_OON = $OPOST; $TERMIOS_NORMAL_OOFF = 0; $TERMIOS_NORMAL_LON = $ISIG | $ICANON | $ECHO; $TERMIOS_NORMAL_LOFF = 0; #$sgttyb_t = 'C4 S'; #$winsz_t = "S S S S"; # rows,cols, xpixel, ypixel $sgttyb_t = 'C4 S' if !defined($sgttyb_t); $winsz_t = "S S S S" if !defined($winsz_t); # rows,cols, xpixel, ypixel $winsz = pack($winsz_t,0,0,0,0); $fionread_t = "L"; $fion = pack($fionread_t, 0); $NCCS = 17; $termios_t = "LLLLc" . ("c" x $NCCS); # true for SunOS 4.1.3, at least... $termios = ''; ## just to shut up "perl -w". $termios = pack($termios, 0); # who cares, just make it long enough $TERMIOS_IFLAG = 0; $TERMIOS_OFLAG = 1; $TERMIOS_CFLAG = 2; $TERMIOS_LFLAG = 3; $TERMIOS_VMIN = 5 + 4; $TERMIOS_VTIME = 5 + 5; } $rl_delete_selection = 1; $rl_correct_sw = ($inDOS ? 1 : 0); $rl_scroll_nextline = 1 unless defined $rl_scroll_nextline; $rl_last_pos_can_backspace = ($inDOS ? 0 : 1) # Can backspace when the unless defined $rl_last_pos_can_backspace; # whole line is filled? $rl_start_default_at_beginning = 0; $rl_vi_replace_default_on_insert = 0; $rl_screen_width = 79; ## default $rl_completion_function = "rl_filename_list" unless defined($rl_completion_function); $rl_basic_word_break_characters = "\\\t\n' \"`\@\$><=;|&{("; $rl_completer_word_break_characters = $rl_basic_word_break_characters; $rl_special_prefixes = ''; ($rl_readline_name = $0) =~ s#.*[/\\]## if !defined($rl_readline_name); @rl_History=() if !(@rl_History); $rl_MaxHistorySize = 100 if !defined($rl_MaxHistorySize); $rl_max_numeric_arg = 200 if !defined($rl_max_numeric_arg); $rl_OperateCount = 0 if !defined($rl_OperateCount); $rl_term_set = \@Term::ReadLine::TermCap::rl_term_set; @$rl_term_set or $rl_term_set = ["","","",""]; $InsertMode=1; $KillBuffer=''; $line=''; $D = 0; $InputLocMsg = ' [initialization]'; &InitKeymap(*emacs_keymap, 'SelfInsert', 'emacs_keymap', ($inDOS ? () : ('C-@', 'SetMark') ), 'C-a', 'BeginningOfLine', 'C-b', 'BackwardChar', 'C-c', 'Interrupt', 'C-d', 'DeleteChar', 'C-e', 'EndOfLine', 'C-f', 'ForwardChar', 'C-g', 'Abort', 'M-C-g', 'Abort', 'C-h', 'BackwardDeleteChar', "TAB" , 'Complete', "C-j" , 'AcceptLine', 'C-k', 'KillLine', 'C-l', 'ClearScreen', "C-m" , 'AcceptLine', 'C-n', 'NextHistory', 'C-o', 'OperateAndGetNext', 'C-p', 'PreviousHistory', 'C-q', 'QuotedInsert', 'C-r', 'ReverseSearchHistory', 'C-s', 'ForwardSearchHistory', 'C-t', 'TransposeChars', 'C-u', 'UnixLineDiscard', ##'C-v', 'QuotedInsert', 'C-v', 'HistorySearchForward', 'C-w', 'UnixWordRubout', qq/"\cX\cX"/, 'ExchangePointAndMark', qq/"\cX\cR"/, 'ReReadInitFile', qq/"\cX?"/, 'PossibleCompletions', qq/"\cX*"/, 'InsertPossibleCompletions', qq/"\cX\cU"/, 'Undo', qq/"\cXu"/, 'Undo', qq/"\cX\cW"/, 'KillRegion', qq/"\cXw"/, 'CopyRegionAsKill', qq/"\cX\ec\\*"/, 'DoControlVersion', qq/"\cX\ec\0"/, 'SetMark', qq/"\cX\ec\@"/, 'SetMark', qq/"\cX\ec "/, 'SetMark', qq/"\cX\em\\*"/, 'DoMetaVersion', qq/"\cX\@c\\*"/, 'DoControlVersion', qq/"\cX\@c\0"/, 'SetMark', qq/"\cX\@c\@"/, 'SetMark', qq/"\cX\@c "/, 'SetMark', qq/"\cX\@m\\*"/, 'DoMetaVersion', 'C-y', 'Yank', 'C-z', 'Suspend', 'C-\\', 'Ding', 'C-^', 'Ding', 'C-_', 'Undo', 'DEL', ($inDOS ? 'BackwardKillWord' : # + 'BackwardDeleteChar' ), 'M-<', 'BeginningOfHistory', 'M->', 'EndOfHistory', 'M-DEL', 'BackwardKillWord', 'M-C-h', 'BackwardKillWord', 'M-C-j', 'ViInput', 'M-C-v', 'QuotedInsert', 'M-b', 'BackwardWord', 'M-c', 'CapitalizeWord', 'M-d', 'KillWord', 'M-f', 'ForwardWord', 'M-h', 'PrintHistory', 'M-l', 'DownCaseWord', 'M-r', 'RevertLine', 'M-t', 'TransposeWords', 'M-u', 'UpcaseWord', 'M-v', 'HistorySearchBackward', 'M-y', 'YankPop', "M-?", 'PossibleCompletions', "M-TAB", 'TabInsert', 'M-#', 'SaveLine', qq/"\e[A"/, 'previous-history', qq/"\e[B"/, 'next-history', qq/"\e[C"/, 'forward-char', qq/"\e[D"/, 'backward-char', qq/"\eOA"/, 'previous-history', qq/"\eOB"/, 'next-history', qq/"\eOC"/, 'forward-char', qq/"\eOD"/, 'backward-char', qq/"\eOy"/, 'HistorySearchBackward', # vt: PageUp qq/"\eOs"/, 'HistorySearchForward', # vt: PageDown qq/"\e[[A"/, 'previous-history', qq/"\e[[B"/, 'next-history', qq/"\e[[C"/, 'forward-char', qq/"\e[[D"/, 'backward-char', qq/"\e[2~"/, 'ToggleInsertMode', # X: # Mods: 1 + bitmask: 1 Shift, 2 Alt, 4 Control, 8 (sometimes) Meta qq/"\e[2;2~"/, 'YankClipboard', # + qq/"\e[3;2~"/, 'KillRegionClipboard', # + #qq/"\0\16"/, 'Undo', # + qq/"\eO5D"/, 'BackwardWord', # + qq/"\eO5C"/, 'ForwardWord', # + qq/"\e[5D"/, 'BackwardWord', # + qq/"\e[5C"/, 'ForwardWord', # + qq/"\eO5F"/, 'KillLine', # + qq/"\e[5F"/, 'KillLine', # + qq/"\e[4;5~"/, 'KillLine', # + qq/"\eO5s"/, 'EndOfHistory', # + qq/"\e[6;5~"/, 'EndOfHistory', # + qq/"\e[5H"/, 'BackwardKillLine', # + qq/"\eO5H"/, 'BackwardKillLine', # + qq/"\e[1;5~"/, 'BackwardKillLine', # + qq/"\eO5y"/, 'BeginningOfHistory', # + qq/"\e[5;5y"/, 'BeginningOfHistory', # + qq/"\e[2;5~"/, 'CopyRegionAsKillClipboard', # + qq/"\e[3;5~"/, 'KillWord', # + # XTerm mouse editing (f202/f203 not in mainstream yet): # Paste may be: move f200 STRING f201 # or f202 move f200 STRING f201 f203; # and Cut may be f202 move delete f203 qq/"\e[200~"/, 'BeginPasteGroup', # Pre-paste qq/"\e[201~"/, 'EndPasteGroup', # Post-paste qq/"\e[202~"/, 'BeginEditGroup', # Pre-edit qq/"\e[203~"/, 'EndEditGroup', # Post-edit # OSX xterm: # OSX xterm: home \eOH end \eOF delete \e[3~ help \e[28~ f13 \e[25~ # gray- \eOm gray+ \eOk gray-enter \eOM gray* \eOj gray/ \eOo gray= \eO # grayClear \e\e. qq/"\eOH"/, 'BeginningOfLine', # home qq/"\eOF"/, 'EndOfLine', # end # HP xterm #qq/"\e[A"/, 'PreviousHistory', # up arrow #qq/"\e[B"/, 'NextHistory', # down arrow #qq/"\e[C"/, 'ForwardChar', # right arrow #qq/"\e[D"/, 'BackwardChar', # left arrow qq/"\e[H"/, 'BeginningOfLine', # home #'C-k', 'KillLine', # clear display qq/"\e[5~"/, 'HistorySearchBackward', # prev qq/"\e[6~"/, 'HistorySearchForward', # next qq/"\e[\0"/, 'BeginningOfLine', # home # These contradict: ($^O =~ /^hp\W?ux/i ? ( qq/"\e[1~"/, 'HistorySearchForward', # find qq/"\e[3~"/, 'ToggleInsertMode', # insert char qq/"\e[4~"/, 'ToggleInsertMode', # select ) : ( # "Normal" xterm qq/"\e[1~"/, 'BeginningOfLine', # home qq/"\e[3~"/, 'DeleteChar', # delete qq/"\e[4~"/, 'EndOfLine', # end )), # hpterm (($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ? ( qq/"\eA"/, 'PreviousHistory', # up arrow qq/"\eB"/, 'NextHistory', # down arrow qq/"\eC"/, 'ForwardChar', # right arrow qq/"\eD"/, 'BackwardChar', # left arrow qq/"\eS"/, 'BeginningOfHistory', # shift up arrow qq/"\eT"/, 'EndOfHistory', # shift down arrow qq/"\e&r1R"/, 'EndOfLine', # shift right arrow qq/"\e&r1L"/, 'BeginningOfLine', # shift left arrow qq/"\eJ"/, 'ClearScreen', # clear display qq/"\eM"/, 'UnixLineDiscard', # delete line qq/"\eK"/, 'KillLine', # clear line qq/"\eG\eK"/, 'BackwardKillLine', # shift clear line qq/"\eP"/, 'DeleteChar', # delete char qq/"\eL"/, 'Yank', # insert line qq/"\eQ"/, 'ToggleInsertMode', # insert char qq/"\eV"/, 'HistorySearchBackward',# prev qq/"\eU"/, 'HistorySearchForward',# next qq/"\eh"/, 'BeginningOfLine', # home qq/"\eF"/, 'EndOfLine', # shift home qq/"\ei"/, 'Suspend', # shift tab ) : () ), ($inDOS ? ( qq/"\0\2"/, 'SetMark', # 2: + qq/"\0\3"/, 'SetMark', # 3: +<@> qq/"\0\4"/, 'YankClipboard', # 4: + qq/"\0\5"/, 'KillRegionClipboard', # 5: + qq/"\0\16"/, 'Undo', # 14: + # qq/"\0\23"/, 'RevertLine', # 19: + # qq/"\0\24"/, 'TransposeWords', # 20: + # qq/"\0\25"/, 'YankPop', # 21: + # qq/"\0\26"/, 'UpcaseWord', # 22: + # qq/"\0\31"/, 'ReverseSearchHistory', # 25: +

# qq/"\0\40"/, 'KillWord', # 32: + # qq/"\0\41"/, 'ForwardWord', # 33: + # qq/"\0\46"/, 'DownCaseWord', # 38: + #qq/"\0\51"/, 'TildeExpand', # 41: +<\'> # qq/"\0\56"/, 'CapitalizeWord', # 46: + # qq/"\0\60"/, 'BackwardWord', # 48: + # qq/"\0\61"/, 'ForwardSearchHistory', # 49: + #qq/"\0\64"/, 'YankLastArg', # 52: +<.> qq/"\0\65"/, 'PossibleCompletions', # 53: + qq/"\0\107"/, 'BeginningOfLine', # 71: qq/"\0\110"/, 'previous-history', # 72: qq/"\0\111"/, 'HistorySearchBackward', # 73: qq/"\0\113"/, 'backward-char', # 75: qq/"\0\115"/, 'forward-char', # 77: qq/"\0\117"/, 'EndOfLine', # 79: qq/"\0\120"/, 'next-history', # 80: qq/"\0\121"/, 'HistorySearchForward', # 81: qq/"\0\122"/, 'ToggleInsertMode', # 82: qq/"\0\123"/, 'DeleteChar', # 83: qq/"\0\163"/, 'BackwardWord', # 115: + qq/"\0\164"/, 'ForwardWord', # 116: + qq/"\0\165"/, 'KillLine', # 117: + qq/"\0\166"/, 'EndOfHistory', # 118: + qq/"\0\167"/, 'BackwardKillLine', # 119: + qq/"\0\204"/, 'BeginningOfHistory', # 132: + qq/"\0\x92"/, 'CopyRegionAsKillClipboard', # 146: + qq/"\0\223"/, 'KillWord', # 147: + qq/"\0#"/, 'PrintHistory', # Alt-H ) : ( 'C-@', 'Ding') ) ); *KeyMap = *emacs_keymap; my @add_bindings = (); foreach ('-', '0' .. '9') { push(@add_bindings, "M-$_", 'DigitArgument'); } foreach ("A" .. "Z") { next if # defined($KeyMap[27]) && defined (%{"$KeyMap{name}_27"}) && defined $ {"$KeyMap{name}_27"}[ord $_]; push(@add_bindings, "M-$_", 'DoLowercaseVersion'); } if ($inDOS) { # Default translation of Alt-char $ {"$KeyMap{name}_0"}{'Esc'} = *{"$KeyMap{name}_27"}; $ {"$KeyMap{name}_0"}{'default'} = 'F_DoEscVersion'; } &rl_bind(@add_bindings); # Vi input mode. &InitKeymap(*vi_keymap, 'SelfInsert', 'vi_keymap', "\e", 'ViEndInsert', 'C-c', 'Interrupt', 'C-h', 'BackwardDeleteChar', 'C-w', 'UnixWordRubout', 'C-u', 'UnixLineDiscard', 'C-v', 'QuotedInsert', 'DEL', 'BackwardDeleteChar', "\n", 'ViAcceptInsert', "\r", 'ViAcceptInsert', ); # Vi command mode. &InitKeymap(*vicmd_keymap, 'Ding', 'vicmd_keymap', 'C-c', 'Interrupt', 'C-e', 'EmacsEditingMode', 'C-h', 'ViMoveCursor', 'C-l', 'ClearScreen', "\n", 'ViAcceptLine', "\r", 'ViAcceptLine', ' ', 'ViMoveCursor', '#', 'SaveLine', '$', 'ViMoveCursor', '%', 'ViMoveCursor', '*', 'ViInsertPossibleCompletions', '+', 'NextHistory', ',', 'ViMoveCursor', '-', 'PreviousHistory', '.', 'ViRepeatLastCommand', '/', 'ViSearch', '0', 'ViMoveCursor', '1', 'ViDigit', '2', 'ViDigit', '3', 'ViDigit', '4', 'ViDigit', '5', 'ViDigit', '6', 'ViDigit', '7', 'ViDigit', '8', 'ViDigit', '9', 'ViDigit', ';', 'ViMoveCursor', '=', 'ViPossibleCompletions', '?', 'ViSearch', 'A', 'ViAppendLine', 'B', 'ViMoveCursor', 'C', 'ViChangeLine', 'D', 'ViDeleteLine', 'E', 'ViMoveCursor', 'F', 'ViMoveCursor', 'G', 'ViHistoryLine', 'H', 'PrintHistory', 'I', 'ViBeginInput', 'N', 'ViRepeatSearch', 'P', 'ViPutBefore', 'R', 'ViReplaceMode', 'S', 'ViChangeEntireLine', 'T', 'ViMoveCursor', 'U', 'ViUndoAll', 'W', 'ViMoveCursor', 'X', 'ViBackwardDeleteChar', 'Y', 'ViYankLine', '\\', 'ViComplete', '^', 'ViMoveCursor', 'a', 'ViAppend', 'b', 'ViMoveCursor', 'c', 'ViChange', 'd', 'ViDelete', 'e', 'ViMoveCursor', 'f', 'ViMoveCursorFind', 'h', 'ViMoveCursor', 'i', 'ViInput', 'j', 'NextHistory', 'k', 'PreviousHistory', 'l', 'ViMoveCursor', 'n', 'ViRepeatSearch', 'p', 'ViPut', 'r', 'ViReplaceChar', 's', 'ViChangeChar', 't', 'ViMoveCursorTo', 'u', 'ViUndo', 'w', 'ViMoveCursor', 'x', 'ViDeleteChar', 'y', 'ViYank', '|', 'ViMoveCursor', '~', 'ViToggleCase', (($inDOS and (not $ENV{'TERM'} or $ENV{'TERM'} !~ /^(vt|xterm)/i)) ? ( qq/"\0\110"/, 'PreviousHistory', # 72: qq/"\0\120"/, 'NextHistory', # 80: qq/"\0\113"/, 'BackwardChar', # 75: qq/"\0\115"/, 'ForwardChar', # 77: "\e", 'ViCommandMode', ) : (('M-C-j','EmacsEditingMode'), # Conflicts with \e otherwise (($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ? ( qq/"\eA"/, 'PreviousHistory', # up arrow qq/"\eB"/, 'NextHistory', # down arrow qq/"\eC"/, 'ForwardChar', # right arrow qq/"\eD"/, 'BackwardChar', # left arrow qq/"\e\\*"/, 'ViAfterEsc', ) : # Default ( qq/"\e[A"/, 'PreviousHistory', # up arrow qq/"\e[B"/, 'NextHistory', # down arrow qq/"\e[C"/, 'ForwardChar', # right arrow qq/"\e[D"/, 'BackwardChar', # left arrow qq/"\e\\*"/, 'ViAfterEsc', qq/"\e[\\*"/, 'ViAfterEsc', ) ))), ); # Vi positioning commands (suffixed to vi commands like 'd'). &InitKeymap(*vipos_keymap, 'ViNonPosition', 'vipos_keymap', '^', 'ViFirstWord', '0', 'BeginningOfLine', '1', 'ViDigit', '2', 'ViDigit', '3', 'ViDigit', '4', 'ViDigit', '5', 'ViDigit', '6', 'ViDigit', '7', 'ViDigit', '8', 'ViDigit', '9', 'ViDigit', '$', 'EndOfLine', 'h', 'BackwardChar', 'l', 'ForwardChar', ' ', 'ForwardChar', 'C-h', 'BackwardChar', 'f', 'ViForwardFindChar', 'F', 'ViBackwardFindChar', 't', 'ViForwardToChar', 'T', 'ViBackwardToChar', ';', 'ViRepeatFindChar', ',', 'ViInverseRepeatFindChar', '%', 'ViFindMatchingParens', '|', 'ViMoveToColumn', # Arrow keys ($inDOS ? ( qq/"\0\115"/, 'ForwardChar', # 77: qq/"\0\113"/, 'BackwardChar', # 75: "\e", 'ViPositionEsc', ) : ($ENV{'TERM'} and $ENV{'TERM'} eq 'hpterm') ? ( qq/"\eC"/, 'ForwardChar', # right arrow qq/"\eD"/, 'BackwardChar', # left arrow qq/"\e\\*"/, 'ViPositionEsc', ) : # Default ( qq/"\e[C"/, 'ForwardChar', # right arrow qq/"\e[D"/, 'BackwardChar', # left arrow qq/"\e\\*"/, 'ViPositionEsc', qq/"\e[\\*"/, 'ViPositionEsc', ) ), ); # Vi search string input mode for '/' and '?'. &InitKeymap(*visearch_keymap, 'SelfInsert', 'visearch_keymap', "\e", 'Ding', 'C-c', 'Interrupt', 'C-h', 'ViSearchBackwardDeleteChar', 'C-w', 'UnixWordRubout', 'C-u', 'UnixLineDiscard', 'C-v', 'QuotedInsert', 'DEL', 'ViSearchBackwardDeleteChar', "\n", 'ViEndSearch', "\r", 'ViEndSearch', ); # These constant hashes hold the arguments to &forward_scan() or # &backward_scan() for vi positioning commands, which all # behave a little differently for delete, move, change, and yank. # # Note: I originally coded these as qr{}, but changed them to q{} for # compatibility with older perls at the expense of some performance. # # Note: Some of the more obscure key combinations behave slightly # differently in different vi implementation. This module matches # the behavior of /usr/ucb/vi, which is different from the # behavior of vim, nvi, and the ksh command line. One example is # the command '2de', when applied to the string ('^' represents the # cursor, not a character of the string): # # ^5.6 7...88888888 # # With /usr/ucb/vi and with this module, the result is # # ^...88888888 # # but with the other three vi implementations, the result is # # ^ 7...88888888 $Vi_delete_patterns = { ord('w') => q{(?:\w+|[^\w\s]+|)\s*}, ord('W') => q{\S*\s*}, ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+}, ord('B') => q{\S+\s*|^\s+}, ord('e') => q{.\s*\w+|.\s*[^\w\s]+|.\s*$}, ord('E') => q{.\s*\S+|.\s*$}, }; $Vi_move_patterns = { ord('w') => q{(?:\w+|[^\w\s]+|)\s*}, ord('W') => q{\S*\s*}, ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+}, ord('B') => q{\S+\s*|^\s+}, ord('e') => q{.\s*\w*(?=\w)|.\s*[^\w\s]*(?=[^\w\s])|.?\s*(?=\s$)}, ord('E') => q{.\s*\S*(?=\S)|.?\s*(?=\s$)}, }; $Vi_change_patterns = { ord('w') => q{\w+|[^\w\s]+|\s}, ord('W') => q{\S+|\s}, ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+}, ord('B') => q{\S+\s*|^\s+}, ord('e') => q{.\s*\w+|.\s*[^\w\s]+|.\s*$}, ord('E') => q{.\s*\S+|.\s*$}, }; $Vi_yank_patterns = { ord('w') => q{(?:\w+|[^\w\s]+|)\s*}, ord('W') => q{\S*\s*}, ord('b') => q{\w+\s*|[^\w\s]+\s*|^\s+}, ord('B') => q{\S+\s*|^\s+}, ord('e') => q{.\s*\w*(?=\w)|.\s*[^\w\s]*(?=[^\w\s])|.?\s*(?=\s$)}, ord('E') => q{.\s*\S*(?=\S)|.?\s*(?=\s$)}, }; my $default_mode = 'emacs'; *KeyMap = $var_EditingMode = $var_EditingMode{$default_mode}; ## my $name; ## for $name ( keys %{'readline::'} ) { ## # Create aliases accessible via tied interface ## *{"rl_$1"} = \$ {"var_$1"} if $name =~ /$var_(.*)/; ## } 1; # Returning a glob causes a bug in db5.001m } sub init { if ($ENV{'TERM'} and ($ENV{'TERM'} eq 'emacs' || $ENV{'TERM'} eq 'dumb')) { $dumb_term = 1; } elsif (! -c $term_IN && $term_IN eq \*STDIN) { # Believe if it is given $stdin_not_tty = 1; } else { &get_window_size; &F_ReReadInitFile if !defined($rl_NoInitFromFile); $InputLocMsg = ''; *KeyMap = $var_EditingMode; } $initialized = 1; } ## ## InitKeymap(*keymap, 'default', 'name', bindings.....) ## sub InitKeymap { local(*KeyMap) = shift(@_); my $default = shift(@_); my $name = $KeyMap{'name'} = shift(@_); # 'default' is now optional - if '', &do_command() defaults it to # 'F_Ding'. Meta-maps now don't set a default - this lets # us detect multiple '\*' default declarations. JP if ($default ne '') { my $func = $KeyMap{'default'} = "F_$default"; ### Temporarily disabled die qq/Bad default function [$func] for keymap "$name"/ if !$autoload_broken and !defined(&$func); } &rl_bind if @_ > 0; ## The rest of @_ gets passed silently. } ## ## Accepts an array as pairs ($keyspec, $function, [$keyspec, $function]...). ## and maps the associated bindings to the current KeyMap. ## ## keyspec should be the name of key sequence in one of two forms: ## ## Old (GNU readline documented) form: ## M-x to indicate Meta-x ## C-x to indicate Ctrl-x ## M-C-x to indicate Meta-Ctrl-x ## x simple char x ## where 'x' above can be a single character, or the special: ## special means ## -------- ----- ## space space ( ) ## spc space ( ) ## tab tab (\t) ## del delete (0x7f) ## rubout delete (0x7f) ## newline newline (\n) ## lfd newline (\n) ## ret return (\r) ## return return (\r) ## escape escape (\e) ## esc escape (\e) ## ## New form: ## "chars" (note the required double-quotes) ## where each char in the list represents a character in the sequence, except ## for the special sequences: ## \\C-x Ctrl-x ## \\M-x Meta-x ## \\M-C-x Meta-Ctrl-x ## \\e escape. ## \\x x (if not one of the above) ## ## ## FUNCTION should be in the form 'BeginningOfLine' or 'beginning-of-line'. ## It is an error for the function to not be known.... ## ## As an example, the following lines in .inputrc will bind one's xterm ## arrow keys: ## "\e[[A": previous-history ## "\e[[B": next-history ## "\e[[C": forward-char ## "\e[[D": backward-char ## sub filler_Pending ($) { my $keys = shift; sub { my $c = shift; push @Pending, map chr, @$keys; return if not @$keys or $c == 1 or not defined(my $in = &getc_with_pending); # provide the numeric argument local(*KeyMap) = $var_EditingMode; $doingNumArg = 1; # Allow NumArg inside NumArg &do_command(*KeyMap, $c, ord $in); return; } } sub _unescape ($) { my($key, @keys) = shift; ## New-style bindings are enclosed in double-quotes. ## Characters are taken verbatim except the special cases: ## \C-x Control x (for any x) ## \M-x Meta x (for any x) ## \e Escape ## \* Set the keymap default (JP: added this) ## (must be the last character of the sequence) ## ## \x x (unless it fits the above pattern) ## ## Look for special case of "\C-\M-x", which should be treated ## like "\M-\C-x". while (length($key) > 0) { # JP: fixed regex bugs below: changed all 's#' to 's#^' if ($key =~ s#^\\C-\\M-(.)##) { push(@keys, ord("\e"), &ctrl(ord($1))); } elsif ($key =~ s#^\\(M-|e)##) { push(@keys, ord("\e")); } elsif ($key =~ s#^\\C-(.)##) { push(@keys, &ctrl(ord($1))); } elsif ($key =~ s#^\\x([0-9a-fA-F]{2})##) { push(@keys, eval('0x'.$1)); } elsif ($key =~ s#^\\([0-7]{3})##) { push(@keys, eval('0'.$1)); } elsif ($key =~ s#^\\\*$##) { # JP: added push(@keys, 'default'); } elsif ($key =~ s#^\\([afnrtv])##) { push(@keys, ord(eval(qq("\\$1")))); } elsif ($key =~ s#^\\d##) { push(@keys, 4); # C-d } elsif ($key =~ s#^\\b##) { push(@keys, 0x7f); # Backspace } elsif ($key =~ s#^\\(.)##) { push(@keys, ord($1)); } else { push(@keys, ord($key)); substr($key,0,1) = ''; } } @keys } sub RL_func ($) { my $name_or_macro = shift; if ($name_or_macro =~ /^"((?:\\.|[^\\\"])*)"|^'((?:\\.|[^\\\'])*)'/s) { filler_Pending [_unescape "$+"]; } else { "F_$name_or_macro"; } } sub actually_do_binding { ## ## actually_do_binding($function1, \@sequence1, ...) ## ## Actually inserts the binding for @sequence to $function into the ## current map. @sequence is an array of character ordinals. ## ## If @sequence is more than one element long, all but the last will ## cause meta maps to be created. ## ## $Function will have an implicit "F_" prepended to it. ## while (@_) { my $func = shift; my ($key, @keys) = @{shift()}; $key += 0; local(*KeyMap) = *KeyMap; my $map; while (@keys) { if (defined($KeyMap[$key]) && ($KeyMap[$key] ne 'F_PrefixMeta')) { warn "Warning$InputLocMsg: ". "Re-binding char #$key from [$KeyMap[$key]] to meta for [@keys] => $func.\n" if $^W; } $KeyMap[$key] = 'F_PrefixMeta'; $map = "$KeyMap{'name'}_$key"; InitKeymap(*$map, '', $map) if !(%$map); *KeyMap = *$map; $key = shift @keys; #&actually_do_binding($func, \@keys); } my $name = $KeyMap{'name'}; if ($key eq 'default') { # JP: added warn "Warning$InputLocMsg: ". " changing default action to $func in $name key map\n" if $^W && defined $KeyMap{'default'}; $KeyMap{'default'} = RL_func $func; } else { if (defined($KeyMap[$key]) && $KeyMap[$key] eq 'F_PrefixMeta' && $func ne 'PrefixMeta') { warn "Warning$InputLocMsg: ". " Re-binding char #$key to non-meta ($func) in $name key map\n" if $^W; } $KeyMap[$key] = RL_func $func; } } } sub rl_bind { my (@keys, $key, $func, $ord, @arr); while (defined($key = shift(@_)) && defined($func = shift(@_))) { ## ## Change the function name from something like ## backward-kill-line ## to ## BackwardKillLine ## if not already there. ## unless ($func =~ /^[\"\']/) { $func = "\u$func"; $func =~ s/-(.)/\u$1/g; # Temporary disabled if (!$autoload_broken and !defined($ {'readline::'}{"F_$func"})) { warn "Warning$InputLocMsg: bad bind function [$func]\n" if $^W; next; } } ## print "sequence [$key] func [$func]\n"; ##DEBUG @keys = (); ## See if it's a new-style binding. if ($key =~ m/"((?:\\.|[^\\])*)"/s) { @keys = _unescape "$1"; } else { ## ol-dstyle binding... only one key (or Meta+key) my ($isctrl, $orig) = (0, $key); $isctrl = $key =~ s/\b(C|Control|CTRL)-//i; push(@keys, ord("\e")) if $key =~ s/\b(M|Meta)-//i; ## is meta? ## Isolate key part. This matches GNU's implementation. ## If the key is '-', be careful not to delete it! $key =~ s/.*-(.)/$1/; if ($key =~ /^(space|spc)$/i) { $key = ' '; } elsif ($key =~ /^(rubout|del)$/i) { $key = "\x7f"; } elsif ($key =~ /^tab$/i) { $key = "\t"; } elsif ($key =~ /^(return|ret)$/i) { $key = "\r"; } elsif ($key =~ /^(newline|lfd)$/i) { $key = "\n"; } elsif ($key =~ /^(escape|esc)$/i) { $key = "\e"; } elsif (length($key) > 1) { warn "Warning$InputLocMsg: strange binding [$orig]\n" if $^W; } $key = ord($key); $key = &ctrl($key) if $isctrl; push(@keys, $key); } # ## Now do the mapping of the sequence represented in @keys # # print "&actually_do_binding($func, @keys)\n"; ##DEBUG push @arr, $func, [@keys]; #&actually_do_binding($func, \@keys); } &actually_do_binding(@arr); } sub read_an_init_file { my $file = shift; my $include_depth = shift; local *RC; $file =~ s/^~([\\\/])/$ENV{HOME}$1/ if not -f $file and exists $ENV{HOME}; return unless open RC, "< $file"; my (@action) = ('exec'); ## exec, skip, ignore (until appropriate endif) my (@level) = (); ## if, else local $/ = "\n"; while () { s/^\s+//; next if m/^\s*(#|$)/; $InputLocMsg = " [$file line $.]"; if (/^\$if\s+(.*)/) { my($test) = $1; push(@level, 'if'); if ($action[$#action] ne 'exec') { ## We're supposed to be skipping or ignoring this level, ## so for subsequent levels we really ignore completely. push(@action, 'ignore'); } else { ## We're executing this IF... do the test. ## The test is either "term=xxxx", or just a string that ## we compare to $rl_readline_name; if ($test =~ /term=([a-z0-9]+)/) { $test = ($ENV{'TERM'} && $1 eq $ENV{'TERM'}); } else { $test = $test =~ /^(perl|$rl_readline_name)\s*$/i; } push(@action, $test ? 'exec' : 'skip'); } next; } elsif (/^\$endif\b/) { die qq/\rWarning$InputLocMsg: unmatched endif\n/ if @level == 0; pop(@level); pop(@action); next; } elsif (/^\$else\b/) { die qq/\rWarning$InputLocMsg: unmatched else\n/ if @level == 0 || $level[$#level] ne 'if'; $level[$#level] = 'else'; ## an IF turns into an ELSE if ($action[$#action] eq 'skip') { $action[$#action] = 'exec'; ## if were SKIPing, now EXEC } else { $action[$#action] = 'ignore'; ## otherwise, just IGNORE. } next; } elsif (/^\$include\s+(\S+)/) { if ($include_depth > $max_include_depth) { warn "Deep recursion in \$include directives in $file.\n"; } else { read_an_init_file($1, $include_depth + 1); } } elsif ($action[$#action] ne 'exec') { ## skipping this one.... # readline permits trailing comments in inputrc # this seems to solve the warnings caused by trailing comments in the # default /etc/inputrc on Mandrake Linux boxes. } elsif (m/\s*set\s+(\S+)\s+(\S*)/) { # Allow trailing comment &rl_set($1, $2, $file); } elsif (m/^\s*(\S+):\s+("(?:\\.|[^\\\"])*"|'(\\.|[^\\\'])*')/) { # Allow trailing comment &rl_bind($1, $2); } elsif (m/^\s*(\S+|"[^\"]+"):\s+(\S+)/) { # Allow trailing comment &rl_bind($1, $2); } else { chomp; warn "\rWarning$InputLocMsg: Bad line [$_]\n" if $^W; } } close(RC); } sub F_ReReadInitFile { my ($file) = $ENV{'TRP_INPUTRC'}; $file = $ENV{'INPUTRC'} unless defined $file; unless (defined $file) { return unless defined $ENV{'HOME'}; $file = "$ENV{'HOME'}/.inputrc"; } read_an_init_file($file, 0); } sub get_ornaments_selected { return if @$rl_term_set >= 6; local $^W=0; my $Orig = $Term::ReadLine::Perl::term->ornaments(); eval { # Term::ReadLine does not expose its $terminal, so make another require Term::Cap; my $terminal = Tgetent Term::Cap ({OSPEED=>9600}); # and be sure the terminal supports highlighting $terminal->Trequire('mr'); }; if (!$@ and $Orig ne ',,,'){ my @set = @$rl_term_set; $Term::ReadLine::Perl::term->ornaments (join(',', (split(/,/, $Orig))[0,1]) . ',mr,me') ; @set[4,5] = @$rl_term_set[2,3]; $Term::ReadLine::Perl::term->ornaments($Orig); @$rl_term_set = @set; } else { @$rl_term_set[4,5] = @$rl_term_set[2,3]; } } sub readline_dumb { local $\ = ''; print $term_OUT $prompt; local $/ = "\n"; return undef if !defined($line = $Term::ReadLine::Perl::term->get_line); chomp($line); $| = $oldbar; select $old; return $line; } ## ## This is it. Called as &readline'readline($prompt, $default), ## (DEFAULT can be omitted) the next input line is returned (undef on EOF). ## sub readline { $Term::ReadLine::Perl::term->register_Tk if not $Term::ReadLine::registered and $Term::ReadLine::toloop and defined &Tk::DoOneEvent; if ($stdin_not_tty) { local $/ = "\n"; return undef if !defined($line = <$term_IN>); chomp($line); return $line; } $old = select $term_OUT; $oldbar = $|; local($|) = 1; local($input); ## prompt should be given to us.... $prompt = defined($_[0]) ? $_[0] : 'INPUT> '; # Try to move cursor to the beginning of the next line if this line # contains anything. # On DOSish 80-wide console # perl -we "print 1 x shift, qq(\b2\r3); sleep 2" 79 # prints 3 on the same line, # perl -we "print 1 x shift, qq(\b2\r3); sleep 2" 80 # on the next; $rl_screen_width is 79. # on XTerm one needs to increase the number by 1. print $term_OUT ' ' x ($rl_screen_width - !$rl_last_pos_can_backspace) . "\b \r" if $rl_scroll_nextline; if ($dumb_term) { return readline_dumb; } # test if we resume an 'Operate' command if ($rl_OperateCount > 0 && (!defined $_[1] || $_[1] eq '')) { ## it's from a valid previous 'Operate' command and ## user didn't give a default line ## we leave $rl_HistoryIndex untouched $line = $rl_History[$rl_HistoryIndex]; } else { ## set history pointer at the end of history $rl_HistoryIndex = $#rl_History + 1; $rl_OperateCount = 0; $line = defined $_[1] ? $_[1] : ''; } $rl_OperateCount-- if $rl_OperateCount > 0; $line_for_revert = $line; # I don't think we need to do this, actually... # while (&ioctl(STDIN,$FIONREAD,$fion)) # { # local($n_chars_available) = unpack ($fionread_t, $fion); # ## print "n_chars = $n_chars_available\n"; # last if $n_chars_available == 0; # $line .= getc_with_pending; # should we prepend if $rl_start_default_at_beginning? # } $D = $rl_start_default_at_beginning ? 0 : length($line); ## set dot. $LastCommandKilledText = 0; ## heck, was no last command. $lastcommand = ''; ## Well, there you go. $line_rl_mark = -1; ## ## some stuff for &redisplay. ## $lastredisplay = ''; ## Was no last redisplay for this time. $lastlen = length($lastredisplay); $lastpromptlen = 0; $lastdelta = 0; ## Cursor was nowhere $si = 0; ## Want line to start left-justified $force_redraw = 1; ## Want to display with brute force. if (!eval {SetTTY()}) { ## Put into raw mode. warn $@ if $@; $dumb_term = 1; return readline_dumb; } *KeyMap = $var_EditingMode; undef($AcceptLine); ## When set, will return its value. undef($ReturnEOF); ## ...unless this on, then return undef. @Pending = (); ## Contains characters to use as input. @undo = (); ## Undo history starts empty for each line. @undoGroupS = (); ## Undo groups start empty for each line. undef $memorizedArg; ## No digitArgument memorized undef $memorizedPos; ## No position memorized undef $Vi_undo_state; undef $Vi_undo_all_state; # We need to do some additional initialization for vi mode. # RS: bug reports/platform issues are welcome: russ@dvns.com if ($KeyMap{'name'} eq 'vi_keymap'){ &F_ViInput(); if ($rl_vi_replace_default_on_insert){ local $^W=0; my $Orig = $Term::ReadLine::Perl::term->ornaments(); eval { # Term::ReadLine does not expose its $terminal, so make another require Term::Cap; my $terminal = Tgetent Term::Cap ({OSPEED=>9600}); # and be sure the terminal supports highlighting $terminal->Trequire('mr'); }; if (!$@ and $Orig ne ',,,'){ $Term::ReadLine::Perl::term->ornaments (join(',', (split(/,/, $Orig))[0,1]) . ',mr,me') } my $F_SelfInsert_Real = \&F_SelfInsert; *F_SelfInsert = sub { $Term::ReadLine::Perl::term->ornaments($Orig); &F_ViChangeEntireLine; local $^W=0; *F_SelfInsert = $F_SelfInsert_Real; &F_SelfInsert; }; my $F_ViEndInsert_Real = \&F_ViEndInsert; *F_ViEndInsert = sub { $Term::ReadLine::Perl::term->ornaments($Orig); local $^W=0; *F_SelfInsert = $F_SelfInsert_Real; *F_ViEndInsert = $F_ViEndInsert_Real; &F_ViEndInsert; $force_redraw = 1; redisplay(); }; } } if ($rl_default_selected) { redisplay_high(); } else { &redisplay(); ## Show the line (prompt+default at this point). } # pretend input if we 'Operate' on more than one line &F_OperateAndGetNext($rl_OperateCount) if $rl_OperateCount > 0; $rl_first_char = 1; while (!defined($AcceptLine)) { ## get a character of input $input = &getc_with_pending(); # bug in debugger, returns 42. - No more! unless (defined $input) { # XXX What to do??? Until this is clear, just pretend we got EOF $AcceptLine = $ReturnEOF = 1; last; } preserve_state(); $ThisCommandKilledText = 0; ##print "\n\rline is @$D:[$line]\n\r"; ##DEBUG my $cmd = get_command($var_EditingMode, ord($input)); if ( $rl_first_char && $cmd =~ /^F_(SelfInsert$|Yank)/ && length $line && $rl_default_selected ) { # (Backward)?DeleteChar specialcased in the code $line = ''; $D = 0; $cmd = 'F_BackwardDeleteChar' if $cmd eq 'F_DeleteChar'; } undef $doingNumArg; &$cmd(1, ord($input)); ## actually execute input $rl_first_char = 0; $lastcommand = $cmd; *KeyMap = $var_EditingMode; # JP: added # In Vi command mode, don't position the cursor beyond the last # character of the line buffer. &F_BackwardChar(1) if $Vi_mode and $line ne '' and &at_end_of_line and $KeyMap{'name'} eq 'vicmd_keymap'; &redisplay(); $LastCommandKilledText = $ThisCommandKilledText; } undef @undo; ## Release the memory. undef @undoGroupS; ## Release the memory. &ResetTTY; ## Restore the tty state. $| = $oldbar; select $old; return undef if defined($ReturnEOF); #print STDOUT "|al=`$AcceptLine'"; $AcceptLine; ## return the line accepted. } ## ctrl(ord('a')) will return the ordinal for Ctrl-A. sub ctrl { $_[0] ^ (($_[0]>=ord('a') && $_[0]<=ord('z')) ? 0x60 : 0x40); } sub SetTTY { return if $dumb_term || $stdin_not_tty; #return system 'stty raw -echo' if defined &DB::DB; if (defined $term_readkey) { Term::ReadKey::ReadMode(4, $term_IN); if ($^O eq 'MSWin32') { # If we reached this, Perl isn't cygwin; Enter sends \r; thus we need binmode # XXXX Do we need to undo??? $term_IN is most probably private now... binmode $term_IN; } return 1; } # system 'stty raw -echo'; $sgttyb = ''; ## just to quiet "perl -w"; if ($useioctl && $^O ne 'solaris' && defined $TIOCGETP && &ioctl($term_IN,$TIOCGETP,$sgttyb)) { @tty_buf = unpack($sgttyb_t,$sgttyb); if (defined $ENV{OS2_SHELL}) { $tty_buf[3] &= ~$mode; $tty_buf[3] &= ~$ECHO; } else { $tty_buf[4] |= $mode; $tty_buf[4] &= ~$ECHO; } $sgttyb = pack($sgttyb_t,@tty_buf); &ioctl($term_IN,$TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!"; } elsif (!$usestty) { return 0; } else { warn < cygwin # The symptoms: now Enter sends \r; thus we need binmode # XXXX Do we need to undo??? $term_IN is most probably private now... binmode $term_IN; } } return 1; } sub ResetTTY { return if $dumb_term || $stdin_not_tty; #return system 'stty -raw echo' if defined &DB::DB; if (defined $term_readkey) { return Term::ReadKey::ReadMode(0, $term_IN); } # system 'stty -raw echo'; if ($useioctl) { &ioctl($term_IN,$TIOCGETP,$sgttyb) || die "Can't ioctl TIOCGETP: $!"; @tty_buf = unpack($sgttyb_t,$sgttyb); if (defined $ENV{OS2_SHELL}) { $tty_buf[3] |= $mode; $tty_buf[3] |= $ECHO; } else { $tty_buf[4] &= ~$mode; $tty_buf[4] |= $ECHO; } $sgttyb = pack($sgttyb_t,@tty_buf); &ioctl($term_IN,$TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!"; } elsif ($usestty) { system 'stty -raw echo' and die "Cannot call `stty': $!"; } } # Substr_with_props: gives the substr of prompt+string with embedded # face-change commands sub substr_with_props { my ($p, $s, $from, $len, $ket, $bsel, $esel) = @_; my $lp = length $p; defined $from or $from = 0; defined $len or $len = length($p) + length($s) - $from; unless (defined $ket) { warn 'bug in Term::ReadLine::Perl, please report to its author cpan@ilyaz.org'; $ket = ''; } # We may draw over to put cursor in a correct position: $ket = '' if $len < length($p) + length($s) - $from; # Not redrawn if ($from >= $lp) { $p = ''; $s = substr $s, $from - $lp; $lp = 0; } else { $p = substr $p, $from; $lp -= $from; $from = 0; } $s = substr $s, 0, $len - $lp; $p =~ s/^(\s*)//; my $bs = $1; $p =~ s/(\s*)$//; my $as = $1; $p = $rl_term_set->[0] . $p . $rl_term_set->[1] if length $p; $p = "$bs$p$as"; $ket = chop $s if $ket; if (defined $bsel and $bsel != $esel) { $bsel = $len if $bsel > $len; $esel = $len if $esel > $len; } if (defined $bsel and $bsel != $esel) { get_ornaments_selected; $bsel -= $lp; $esel -= $lp; my ($pre, $sel, $post) = (substr($s, 0, $bsel), substr($s, $bsel, $esel-$bsel), substr($s, $esel)); $pre = $rl_term_set->[2] . $pre . $rl_term_set->[3] if length $pre; $sel = $rl_term_set->[4] . $sel . $rl_term_set->[5] if length $sel; $post = $rl_term_set->[2] . $post . $rl_term_set->[3] if length $post; $s = "$pre$sel$post" } else { $s = $rl_term_set->[2] . $s . $rl_term_set->[3] if length $s; } if (!$lp) { # Should not happen... return $s; } elsif (!length $s) { # Should not happen return $p; } else { # Do not underline spaces in the prompt return "$p$s" . (length $ket ? ($rl_term_set->[0] . $ket . $rl_term_set->[1]) : ''); } } sub redisplay_high { get_ornaments_selected(); @$rl_term_set[2,3,4,5] = @$rl_term_set[4,5,2,3]; &redisplay(); ## Show the line, default inverted. @$rl_term_set[2,3,4,5] = @$rl_term_set[4,5,2,3]; $force_redraw = 1; } ## ## redisplay() ## ## Updates the screen to reflect the current $line. ## ## For the purposes of this routine, we prepend the prompt to a local copy of ## $line so that we display the prompt as well. We then modify it to reflect ## that some characters have different sizes (i.e. control-C is represented ## as ^C, tabs are expanded, etc.) ## ## This routine is somewhat complicated by two-byte characters.... must ## make sure never to try do display just half of one. ## ## NOTE: If an argument is given, it is used instead of the prompt. ## ## This is some nasty code. ## sub redisplay { ## local $line has prompt also; take that into account with $D. local($prompt) = defined($_[0]) ? $_[0] : $prompt; my ($thislen, $have_bra); my($dline) = $prompt . $line; local($D) = $D + length($prompt); my ($bsel, $esel); if (defined pos $line) { $bsel = (pos $line) + length $prompt; } my ($have_ket) = ''; ## ## If the line contains anything that might require special processing ## for displaying (such as tabs, control characters, etc.), we will ## take care of that now.... ## if ($dline =~ m/[^\x20-\x7e]/) { local($new, $Dinc, $c) = ('', 0); ## Look at each character of $dline in turn..... for ($i = 0; $i < length($dline); $i++) { $c = substr($dline, $i, 1); ## A tab to expand... if ($c eq "\t") { $c = ' ' x (8 - (($i-length($prompt)) % 8)); ## A control character.... } elsif ($c =~ tr/\000-\037//) { $c = sprintf("^%c", ord($c)+ord('@')); ## the delete character.... } elsif (ord($c) == 127) { $c = '^?'; } $new .= $c; ## Bump over $D if this char is expanded and left of $D. $Dinc += length($c) - 1 if (length($c) > 1 && $i < $D); ## Bump over $bsel if this char is expanded and left of $bsel. $bsel += length($c) - 1 if (defined $bsel && length($c) > 1 && $i < $bsel); } $dline = $new; $D += $Dinc; } ## ## Now $dline is what we'd like to display (with a prepended prompt) ## $D is the position of the cursor on it. ## ## If it's too long to fit on the line, we must decide what we can fit. ## ## If we end up moving the screen index ($si) [index of the leftmost ## character on the screen], to some place other than the front of the ## the line, we'll have to make sure that it's not on the first byte of ## a 2-byte character, 'cause we'll be placing a '<' marker there, and ## that would screw up the 2-byte character. ## ## $si is preserved between several displays (if possible). ## ## Similarly, if the line needs chopped off, we make sure that the ## placement of the tailing '>' won't screw up any 2-byte character in ## the vicinity. # Now $si keeps the value from previous display if ($D == length($prompt) # If prompts fits exactly, show only if need not show trailing '>' and length($prompt) < $rl_screen_width - (0 != length $dline)) { $si = 0; ## prefer displaying the whole prompt } elsif ($si >= $D) { # point to the left of what was displayed $si = &max(0, $D - $rl_margin); $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si); } elsif ($si + $rl_screen_width <= $D) { # Point to the right of ... $si = &min(length($dline), ($D - $rl_screen_width) + $rl_margin); $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si); } elsif (length($dline) - $si < $rl_screen_width - $rl_margin and $si) { # Too little of the line shown $si = &max(0, length($dline) - $rl_screen_width + 3); $si-- if $si > 0 && $si != length($prompt) && !&OnSecondByte($si); } else { ## Fine as-is.... don't need to change $si. } $have_bra = 1 if $si != 0; # Need the "chopped-off" marker $thislen = &min(length($dline) - $si, $rl_screen_width); if ($si + $thislen < length($dline)) { ## need to place a '>'... make sure to place on first byte. $thislen-- if &OnSecondByte($si+$thislen-1); substr($dline, $si+$thislen-1,1) = '>'; $have_ket = 1; } ## ## Now know what to display. ## Must get substr($dline, $si, $thislen) on the screen, ## with the cursor at $D-$si characters from the left edge. ## $dline = substr($dline, $si, $thislen); $delta = $D - $si; ## delta is cursor distance from beginning of $dline. if (defined $bsel) { # Highlight the selected part $bsel -= $si; $esel = $delta; ($bsel, $esel) = ($esel, $bsel) if $bsel > $esel; $bsel = 0 if $bsel < 0; if ($have_ket) { $esel = $thislen - 1 if $esel > $thislen - 1; } else { $esel = $thislen if $esel > $thislen; } } if ($si >= length($prompt)) { # Keep $dline for $lastredisplay... $prompt = ($have_bra ? "<" : ""); $dline = substr $dline, 1; # After prompt $bsel = 1 if defined $bsel and $bsel == 0; } else { $dline = substr($dline, (length $prompt) - $si); $prompt = substr($prompt,$si); substr($prompt, 0, 1) = '<' if $si > 0; } # Now $dline is the part after the prompt... ## ## Now must output $dline, with cursor $delta spaces from left of TTY ## local ($\, $,) = ('',''); ## ## If $force_redraw is not set, we can attempt to optimize the redisplay ## However, if we don't happen to find an easy way to optimize, we just ## fall through to the brute-force method of re-drawing the whole line. ## if (not $force_redraw and not defined $bsel) { ## can try to optimize here a bit. ## For when we only need to move the cursor if ($lastredisplay eq $dline and $lastpromptlen == length $prompt) { ## If we need to move forward, just overwrite as far as we need. if ($lastdelta < $delta) { print $term_OUT substr_with_props($prompt, $dline, $lastdelta, $delta-$lastdelta, $have_ket); ## Need to move back. } elsif($lastdelta > $delta) { ## Two ways to move back... use the fastest. One is to just ## backspace the proper amount. The other is to jump to the ## the beginning of the line and overwrite from there.... my $out = substr_with_props($prompt, $dline, 0, $delta, $have_ket); if ($lastdelta - $delta <= length $out) { print $term_OUT "\b" x ($lastdelta - $delta); } else { print $term_OUT "\r", $out; } } ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen) = ($thislen, $dline, $delta, length $prompt); # print $term_OUT "\a"; # Debugging return; } ## for when we've just added stuff to the end if ($thislen > $lastlen && $lastdelta == $lastlen && $delta == $thislen && $lastpromptlen == length($prompt) && substr($dline, 0, $lastlen - $lastpromptlen) eq $lastredisplay) { print $term_OUT substr_with_props($prompt, $dline, $lastdelta, undef, $have_ket); # print $term_OUT "\a"; # Debugging ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen) = ($thislen, $dline, $delta, length $prompt); return; } ## There is much more opportunity for optimizing..... ## something to work on later..... } ## ## Brute force method of redisplaying... redraw the whole thing. ## print $term_OUT "\r", substr_with_props($prompt, $dline, 0, undef, $have_ket, $bsel, $esel); my $back = length ($dline) + length ($prompt) - $delta; $back += $lastlen - $thislen, print $term_OUT ' ' x ($lastlen - $thislen) if $lastlen > $thislen; if ($back) { my $out = substr_with_props($prompt, $dline, 0, $delta, $have_ket, $bsel, $esel); if ($back <= length $out and not defined $bsel) { print $term_OUT "\b" x $back; } else { print $term_OUT "\r", $out; } } ($lastlen, $lastredisplay, $lastdelta, $lastpromptlen) = ($thislen, $dline, $delta, length $prompt); $force_redraw = 0; } sub min { $_[0] < $_[1] ? $_[0] : $_[1]; } sub getc_with_pending { my $key = @Pending ? shift(@Pending) : &$rl_getc; # Save keystrokes for vi '.' command push(@$Dot_buf, $key) if $Dot_buf; $key; } sub rl_getc { my $key; # JP: Added missing declaration if (defined $term_readkey) { # XXXX ??? $Term::ReadLine::Perl::term->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent; $key = Term::ReadKey::ReadKey(0, $term_IN); } else { $key = $Term::ReadLine::Perl::term->get_c; } } ## ## get_command(keymap, ord_command_char) ## ## If the KEYMAP has an entry for COMMAND, it is returned. ## Otherwise, the default command is returned. ## sub get_command { local *KeyMap = shift; my ($key) = @_; my $cmd = defined($KeyMap[$key]) ? $KeyMap[$key] : ($KeyMap{'default'} || 'F_Ding'); if (!defined($cmd) || $cmd eq ''){ warn "internal error (key=$key)"; $cmd = 'F_Ding'; } $cmd } ## ## do_command(keymap, numericarg, command) ## ## If the KEYMAP has an entry for COMMAND, it is executed. ## Otherwise, the default command for the keymap is executed. ## sub do_command { my ($keymap, $count, $key) = @_; my $cmd = get_command($keymap, $key); local *KeyMap = $keymap; # &$cmd may expect it... &$cmd($count, $key); $lastcommand = $cmd; } ## ## Save whatever state we wish to save as an anonymous array. ## The only other function that needs to know about its encoding is getstate/preserve_state. ## sub savestate { [$D, $si, $LastCommandKilledText, $KillBuffer, $line, @_]; } # consolidate only-movement changes together... sub preserve_state { return if $Vi_mode; push(@undo, savestate()), return unless @undo; my $last = $undo[-1]; my @only_movement; if ( #$last->[1] == $si and $last->[2] eq $LastCommandKilledText # and $last->[3] eq $KillBuffer and $last->[4] eq $line ) { # Only position changed; remove old only-position-changed records pop @undo if $undo[-1]->[5]; @only_movement = 1; } push(@undo, savestate(@only_movement)); } ## ## $_[1] is an ASCII ordinal; inserts as per $count. ## sub F_SelfInsert { remove_selection(); my ($count, $ord) = @_; my $text2add = pack('C', $ord) x $count; if ($InsertMode) { substr($line,$D,0) .= $text2add; } else { ## note: this can screw up with 2-byte characters. substr($line,$D,length($text2add)) = $text2add; } $D += length($text2add); } ## ## Return the line as-is to the user. ## sub F_AcceptLine { &add_line_to_history; $AcceptLine = $line; local $\ = ''; print $term_OUT "\r\n"; $force_redraw = 0; (pos $line) = undef; # Another way to force redraw... } sub add_line_to_history { ## Insert into history list if: ## * bigger than the minimal length ## * not same as last entry ## if (length($line) >= $minlength && (!@rl_History || $rl_History[$#rl_History] ne $line) ) { ## if the history list is full, shift out an old one first.... while (@rl_History >= $rl_MaxHistorySize) { shift(@rl_History); $rl_HistoryIndex--; } push(@rl_History, $line); ## tack new one on the end } } sub remove_selection { if ( $rl_first_char && length $line && $rl_default_selected ) { $line = ''; $D = 0; return 1; } if ($rl_delete_selection and defined pos $line and $D != pos $line) { kill_text(pos $line, $D); return 1; } return; } #sub F_ReReadInitFile; #sub rl_getc; sub F_ForwardChar; sub F_BackwardChar; sub F_BeginningOfLine; sub F_EndOfLine; sub F_ForwardWord; sub F_BackwardWord; sub F_RedrawCurrentLine; sub F_ClearScreen; # sub F_SelfInsert; sub F_QuotedInsert; sub F_TabInsert; #sub F_AcceptLine; sub F_OperateAndGetNext; sub F_BackwardDeleteChar; sub F_DeleteChar; sub F_UnixWordRubout; sub F_UnixLineDiscard; sub F_UpcaseWord; sub F_DownCaseWord; sub F_CapitalizeWord; sub F_TransposeWords; sub F_TransposeChars; sub F_PreviousHistory; sub F_NextHistory; sub F_BeginningOfHistory; sub F_EndOfHistory; sub F_ReverseSearchHistory; sub F_ForwardSearchHistory; sub F_HistorySearchBackward; sub F_HistorySearchForward; sub F_KillLine; sub F_BackwardKillLine; sub F_Yank; sub F_YankPop; sub F_YankNthArg; sub F_KillWord; sub F_BackwardKillWord; sub F_Abort; sub F_DoLowercaseVersion; sub F_DoMetaVersion; sub F_DoControlVersion; sub F_Undo; sub F_RevertLine; sub F_EmacsEditingMode; sub F_Interrupt; sub F_PrefixMeta; sub F_UniversalArgument; sub F_DigitArgument; sub F_OverwriteMode; sub F_InsertMode; sub F_ToggleInsertMode; sub F_Suspend; sub F_Ding; sub F_PossibleCompletions; sub F_Complete; sub F_YankClipboard; sub F_CopyRegionAsKillClipboard; sub F_KillRegionClipboard; sub clipboard_set; sub F_BeginUndoGroup; sub F_EndUndoGroup; sub F_DoNothing; sub F_ForceMemorizeDigitArgument; sub F_MemorizeDigitArgument; sub F_UnmemorizeDigitArgument; sub F_ResetDigitArgument; sub F_MergeInserts; sub F_MemorizePos; sub F_BeginPasteGroup; sub F_EndPasteGroup; sub F_BeginEditGroup; sub F_EndEditGroup; # Comment next line and __DATA__ line below to disable the selfloader. use SelfLoader; 1; __DATA__ # From here on anything may be autoloaded sub max { $_[0] > $_[1] ? $_[0] : $_[1]; } sub isupper { ord($_[0]) >= ord('A') && ord($_[0]) <= ord('Z'); } sub islower { ord($_[0]) >= ord('a') && ord($_[0]) <= ord('z'); } sub toupper { &islower ? pack('c', ord($_[0])-ord('a')+ord('A')) : $_[0];} sub tolower { &isupper ? pack('c', ord($_[0])-ord('A')+ord('a')) : $_[0];} ## ## rl_set(var_name, value_string) ## ## Sets the named variable as per the given value, if both are appropriate. ## Allows the user of the package to set such things as HorizontalScrollMode ## and EditingMode. Value_string may be of the form ## HorizontalScrollMode ## horizontal-scroll-mode ## ## Also called during the parsing of ~/.inputrc for "set var value" lines. ## ## The previous value is returned, or undef on error. ########################################################################### ## Consider the following example for how to add additional variables ## accessible via rl_set (and hence via ~/.inputrc). ## ## Want: ## We want an external variable called "FooTime" (or "foo-time"). ## It may have values "January", "Monday", or "Noon". ## Internally, we'll want those values to translate to 1, 2, and 12. ## ## How: ## Have an internal variable $var_FooTime that will represent the current ## internal value, and initialize it to the default value. ## Make an array %var_FooTime whose keys and values are are the external ## (January, Monday, Noon) and internal (1, 2, 12) values: ## ## $var_FooTime = $var_FooTime{'January'} = 1; #default ## $var_FooTime{'Monday'} = 2; ## $var_FooTime{'Noon'} = 12; ## sub rl_set { local($var, $val) = @_; # &preinit's keys are all Capitalized $val = ucfirst lc $val if $val =~ /^(on|off)$/i; $var = 'CompleteAddsuffix' if $var eq 'visible-stats'; ## if the variable is in the form "some-name", change to "SomeName" local($_) = "\u$var"; local($return) = undef; s/-(.)/\u$1/g; # Skip unknown variables: return unless defined $ {'readline::'}{"var_$_"}; local(*V); # avoid warning { local $^W; *V = $ {'readline::'}{"var_$_"}; } if (!defined($V)) { # XXX Duplicate check? warn("Warning$InputLocMsg:\n". " Invalid variable `$var'\n") if $^W; } elsif (!defined($V{$val})) { local(@selections) = keys(%V); warn("Warning$InputLocMsg:\n". " Invalid value `$val' for variable `$var'.\n". " Choose from [@selections].\n") if $^W; } else { $return = $V; $V = $V{$val}; ## make the setting } $return; } ## ## OnSecondByte($index) ## ## Returns true if the byte at $index into $line is the second byte ## of a two-byte character. ## sub OnSecondByte { return 0 if !$_rl_japanese_mb || $_[0] == 0 || $_[0] == length($line); die 'internal error' if $_[0] > length($line); ## ## must start looking from the beginning of the line .... can ## have one- and two-byte characters interspersed, so can't tell ## without starting from some know location..... ## local($i); for ($i = 0; $i < $_[0]; $i++) { next if ord(substr($line, $i, 1)) < 0x80; ## We have the first byte... must bump up $i to skip past the 2nd. ## If that one we're skipping past is the index, it should be changed ## to point to the first byte of the pair (therefore, decremented). return 1 if ++$i == $_[0]; } 0; ## seemed to be OK. } ## ## CharSize(index) ## ## Returns the size of the character at the given INDEX in the ## current line. Most characters are just one byte in length, ## but if the byte at the index and the one after has the high ## bit set those two bytes are one character of size=2. ## ## Assumes that index points to the first of a 2-byte char if not ## pointing to a 2-byte char. ## sub CharSize { return 2 if $_rl_japanese_mb && ord(substr($line, $_[0], 1)) >= 0x80 && ord(substr($line, $_[0]+1, 1)) >= 0x80; 1; } sub GetTTY { $base_termios = $termios; # make it long enough &ioctl($term_IN,$TCGETS,$base_termios) || die "Can't ioctl TCGETS: $!"; } sub XonTTY { # I don't know which of these I actually need to do this to, so we'll # just cover all bases. &ioctl($term_IN,$TCXONC,$TCOON); # || die "Can't ioctl TCXONC STDIN: $!"; &ioctl($term_OUT,$TCXONC,$TCOON); # || die "Can't ioctl TCXONC STDOUT: $!"; } sub ___SetTTY { # print "before SetTTY\n\r"; # system 'stty -a'; &XonTTY; &GetTTY if !defined($base_termios); @termios = unpack($termios_t,$base_termios); $termios[$TERMIOS_IFLAG] |= $TERMIOS_READLINE_ION; $termios[$TERMIOS_IFLAG] &= ~$TERMIOS_READLINE_IOFF; $termios[$TERMIOS_OFLAG] |= $TERMIOS_READLINE_OON; $termios[$TERMIOS_OFLAG] &= ~$TERMIOS_READLINE_OOFF; $termios[$TERMIOS_LFLAG] |= $TERMIOS_READLINE_LON; $termios[$TERMIOS_LFLAG] &= ~$TERMIOS_READLINE_LOFF; $termios[$TERMIOS_VMIN] = 1; $termios[$TERMIOS_VTIME] = 0; $termios = pack($termios_t,@termios); &ioctl($term_IN,$TCSETS,$termios) || die "Can't ioctl TCSETS: $!"; # print "after SetTTY\n\r"; # system 'stty -a'; } sub normal_tty_mode { return if $stdin_not_tty || $dumb_term || !$initialized; &XonTTY; &GetTTY if !defined($base_termios); &ResetTTY; } sub ___ResetTTY { # print "before ResetTTY\n\r"; # system 'stty -a'; @termios = unpack($termios_t,$base_termios); $termios[$TERMIOS_IFLAG] |= $TERMIOS_NORMAL_ION; $termios[$TERMIOS_IFLAG] &= ~$TERMIOS_NORMAL_IOFF; $termios[$TERMIOS_OFLAG] |= $TERMIOS_NORMAL_OON; $termios[$TERMIOS_OFLAG] &= ~$TERMIOS_NORMAL_OOFF; $termios[$TERMIOS_LFLAG] |= $TERMIOS_NORMAL_LON; $termios[$TERMIOS_LFLAG] &= ~$TERMIOS_NORMAL_LOFF; $termios = pack($termios_t,@termios); &ioctl($term_IN,$TCSETS,$termios) || die "Can't ioctl TCSETS: $!"; # print "after ResetTTY\n\r"; # system 'stty -a'; } ## ## WordBreak(index) ## ## Returns true if the character at INDEX into $line is a basic word break ## character, false otherwise. ## sub WordBreak { index($rl_basic_word_break_characters, substr($line,$_[0],1)) != -1; } sub getstate { ($D, $si, $LastCommandKilledText, $KillBuffer, $line) = @{$_[0]}; $ThisCommandKilledText = $LastCommandKilledText; } ## ## kills from D=$_[0] to $_[1] (to the killbuffer if $_[2] is true) ## sub kill_text { my($from, $to, $save) = (&min($_[0], $_[1]), &max($_[0], $_[1]), $_[2]); my $len = $to - $from; if ($save) { $KillBuffer = '' if !$LastCommandKilledText; if ($from < $LastCommandKilledText - 1) { $KillBuffer = substr($line, $from, $len) . $KillBuffer; } else { $KillBuffer .= substr($line, $from, $len); } $ThisCommandKilledText = 1 + $from; } substr($line, $from, $len) = ''; ## adjust $D if ($D > $from) { $D -= $len; $D = $from if $D < $from; } } ########################################################################### ## Bindable functions... pretty much in the same order as in readline.c ### ########################################################################### ## ## Returns true if $D at the end of the line. ## sub at_end_of_line { ($D + &CharSize($D)) == (length($line) + 1); } ## ## Move forward (right) $count characters. ## sub F_ForwardChar { my $count = shift; return &F_BackwardChar(-$count) if $count < 0; while (!&at_end_of_line && $count-- > 0) { $D += &CharSize($D); } } ## ## Move backward (left) $count characters. ## sub F_BackwardChar { my $count = shift; return &F_ForwardChar(-$count) if $count < 0; while (($D > 0) && ($count-- > 0)) { $D--; ## Move back one regardless, $D-- if &OnSecondByte($D); ## another if over a big char. } } ## ## Go to beginning of line. ## sub F_BeginningOfLine { $D = 0; } ## ## Move to the end of the line. ## sub F_EndOfLine { &F_ForwardChar(100) while !&at_end_of_line; } ## ## Move to the end of this/next word. ## Done as many times as $count says. ## sub F_ForwardWord { my $count = shift; return &F_BackwardWord(-$count) if $count < 0; while (!&at_end_of_line && $count-- > 0) { ## skip forward to the next word (if not already on one) &F_ForwardChar(1) while !&at_end_of_line && &WordBreak($D); ## skip forward to end of word &F_ForwardChar(1) while !&at_end_of_line && !&WordBreak($D); } } ## ## ## Move to the beginning of this/next word. ## Done as many times as $count says. ## sub F_BackwardWord { my $count = shift; return &F_ForwardWord(-$count) if $count < 0; while ($D > 0 && $count-- > 0) { ## skip backward to the next word (if not already on one) &F_BackwardChar(1) while (($D > 0) && &WordBreak($D-1)); ## skip backward to start of word &F_BackwardChar(1) while (($D > 0) && !&WordBreak($D-1)); } } ## ## Refresh the input line. ## sub F_RedrawCurrentLine { $force_redraw = 1; } ## ## Clear the screen and refresh the line. ## If given a numeric arg other than 1, simply refreshes the line. ## sub F_ClearScreen { my $count = shift; return &F_RedrawCurrentLine if $count != 1; $rl_CLEAR = `clear` if !defined($rl_CLEAR); local $\ = ''; print $term_OUT $rl_CLEAR; $force_redraw = 1; } ## ## Insert the next character read verbatim. ## sub F_QuotedInsert { my $count = shift; &F_SelfInsert($count, ord(&getc_with_pending)); } ## ## Insert a tab. ## sub F_TabInsert { my $count = shift; &F_SelfInsert($count, ord("\t")); } ## Operate - accept the current line and fetch from the ## history the next line relative to current line for default. sub F_OperateAndGetNext { my $count = shift; &F_AcceptLine; my $remainingEntries = $#rl_History - $rl_HistoryIndex; if ($count > 0 && $remainingEntries >= 0) { # there is something to repeat if ($remainingEntries > 0) { # if we are not on last line $rl_HistoryIndex++; # fetch next one $count = $remainingEntries if $count > $remainingEntries; } $rl_OperateCount = $count; } } ## ## Removes $count chars to left of cursor (if not at beginning of line). ## If $count > 1, deleted chars saved to kill buffer. ## sub F_BackwardDeleteChar { return if remove_selection(); my $count = shift; return F_DeleteChar(-$count) if $count < 0; my $oldD = $D; &F_BackwardChar($count); return if $D == $oldD; &kill_text($oldD, $D, $count > 1); } ## ## Removes the $count chars from under the cursor. ## If there is no line and the last command was different, tells ## readline to return EOF. ## If there is a line, and the cursor is at the end of it, and we're in ## tcsh completion mode, then list possible completions. ## If $count > 1, deleted chars saved to kill buffer. ## sub F_DeleteChar { return if remove_selection(); my $count = shift; return F_DeleteBackwardChar(-$count) if $count < 0; if (length($line) == 0) { # EOF sent (probably OK in DOS too) $AcceptLine = $ReturnEOF = 1 if $lastcommand ne 'F_DeleteChar'; return; } if ($D == length ($line)) { &complete_internal('?') if $var_TcshCompleteMode; return; } my $oldD = $D; &F_ForwardChar($count); return if $D == $oldD; &kill_text($oldD, $D, $count > 1); } ## ## Kill to previous whitespace. ## sub F_UnixWordRubout { return &F_Ding if $D == 0; (my $oldD, local $rl_basic_word_break_characters) = ($D, "\t "); # JP: Fixed a bug here - both were 'my' F_BackwardWord(1); kill_text($D, $oldD, 1); } ## ## Kill line from cursor to beginning of line. ## sub F_UnixLineDiscard { return &F_Ding if $D == 0; kill_text(0, $D, 1); } sub F_UpcaseWord { &changecase($_[0], 'up'); } sub F_DownCaseWord { &changecase($_[0], 'down'); } sub F_CapitalizeWord { &changecase($_[0], 'cap'); } ## ## Translated from GNUs readline.c ## One arg is 'up' to upcase $_[0] words, ## 'down' to downcase them, ## or something else to capitolize them. ## If $_[0] is negative, the dot is not moved. ## sub changecase { my $op = $_[1]; my ($start, $state, $c, $olddot) = ($D, 0); if ($_[0] < 0) { $olddot = $D; $_[0] = -$_[0]; } &F_ForwardWord; ## goes forward $_[0] words. while ($start < $D) { $c = substr($line, $start, 1); if ($op eq 'up') { $c = &toupper($c); } elsif ($op eq 'down') { $c = &tolower($c); } else { ## must be 'cap' if ($state == 1) { $c = &tolower($c); } else { $c = &toupper($c); $state = 1; } $state = 0 if $c !~ tr/a-zA-Z//; } substr($line, $start, 1) = $c; $start++; } $D = $olddot if defined($olddot); } sub F_TransposeWords { my $c = shift; return F_Ding() unless $c; # Find "this" word F_BackwardWord(1); my $p0 = $D; F_ForwardWord(1); my $p1 = $D; return F_Ding() if $p1 == $p0; my ($p2, $p3) = ($p0, $p1); if ($c > 0) { F_ForwardWord($c); $p3 = $D; F_BackwardWord(1); $p2 = $D; } else { F_BackwardWord(1 - $c); $p0 = $D; F_ForwardWord(1); $p1 = $D; } return F_Ding() if $p3 == $p2 or $p2 < $p1; my $r = substr $line, $p2, $p3 - $p2; substr($line, $p2, $p3 - $p2) = substr $line, $p0, $p1 - $p0; substr($line, $p0, $p1 - $p0) = $r; $D = $c > 0 ? $p3 : $p0 + $p3 - $p2; # End of "this" word after edit return 1; ## Exchange words: C-Left, C-right, C-right, C-left. If positions do ## not overlap, we get two things to transpose. Repeat count? } ## ## Switch char at dot with char before it. ## If at the end of the line, switch the previous two... ## (NOTE: this could screw up multibyte characters.. should do correctly) sub F_TransposeChars { if ($D == length($line) && $D >= 2) { substr($line,$D-2,2) = substr($line,$D-1,1).substr($line,$D-2,1); } elsif ($D >= 1) { substr($line,$D-1,2) = substr($line,$D,1) .substr($line,$D-1,1); } else { &F_Ding; } } sub F_PreviousHistory { &get_line_from_history($rl_HistoryIndex - shift); } sub F_NextHistory { &get_line_from_history($rl_HistoryIndex + shift); } sub F_BeginningOfHistory { &get_line_from_history(0); } sub F_EndOfHistory { &get_line_from_history(@rl_History); } sub F_ReverseSearchHistory { &DoSearch($_[0] >= 0 ? 1 : 0); } sub F_ForwardSearchHistory { &DoSearch($_[0] >= 0 ? 0 : 1); } sub F_HistorySearchBackward { &DoSearchStart(($_[0] >= 0 ? 1 : 0),substr($line,0,$D)); } sub F_HistorySearchForward { &DoSearchStart(($_[0] >= 0 ? 0 : 1),substr($line,0,$D)); } ## returns a new $i or -1 if not found. sub search { my ($i, $str) = @_; return -1 if $i < 0 || $i > $#rl_History; ## for safety while (1) { return $i if rindex($rl_History[$i], $str) >= 0; if ($reverse) { return -1 if $i-- == 0; } else { return -1 if $i++ == $#rl_History; } } } sub DoSearch { local $reverse = shift; # Used in search() my $oldline = $line; my $oldD = $D; my $searchstr = ''; ## string we're searching for my $I = -1; ## which history line $si = 0; while (1) { if ($I != -1) { $line = $rl_History[$I]; $D += index($rl_History[$I], $searchstr); } &redisplay( '('.($reverse?'reverse-':'') ."i-search) `$searchstr': "); $c = &getc_with_pending; if (($KeyMap[ord($c)] || 0) eq 'F_ReverseSearchHistory') { if ($reverse && $I != -1) { if ($tmp = &search($I-1,$searchstr), $tmp >= 0) { $I = $tmp; } else { &F_Ding; } } $reverse = 1; } elsif (($KeyMap[ord($c)] || 0) eq 'F_ForwardSearchHistory') { if (!$reverse && $I != -1) { if ($tmp = &search($I+1,$searchstr), $tmp >= 0) { $I = $tmp; } else { &F_Ding; } } $reverse = 0; } elsif ($c eq "\007") { ## abort search... restore line and return $line = $oldline; $D = $oldD; return; } elsif (ord($c) < 32 || ord($c) > 126) { push(@Pending, $c) if $c ne "\e"; if ($I < 0) { ## just restore $line = $oldline; $D = $oldD; } else { #chose this line $line = $rl_History[$I]; $D = index($rl_History[$I], $searchstr); } &redisplay(); last; } else { ## Add this character to the end of the search string and ## see if that'll match anything. $tmp = &search($I < 0 ? $rl_HistoryIndex-$reverse: $I, $searchstr.$c); if ($tmp == -1) { &F_Ding; } else { $searchstr .= $c; $I = $tmp; } } } } ## returns a new $i or -1 if not found. sub searchStart { my ($i, $reverse, $str) = @_; $i += $reverse ? - 1: +1; return -1 if $i < 0 || $i > $#rl_History; ## for safety while (1) { return $i if index($rl_History[$i], $str) == 0; if ($reverse) { return -1 if $i-- == 0; } else { return -1 if $i++ == $#rl_History; } } } sub DoSearchStart { my ($reverse,$what) = @_; my $i = searchStart($rl_HistoryIndex, $reverse, $what); return if $i == -1; $rl_HistoryIndex = $i; ($D, $line) = (0, $rl_History[$rl_HistoryIndex]); F_BeginningOfLine(); F_ForwardChar(length($what)); } ########################################################################### ########################################################################### ## ## Kill from cursor to end of line. ## sub F_KillLine { my $count = shift; return F_BackwardKillLine(-$count) if $count < 0; kill_text($D, length($line), 1); } ## ## Delete from cursor to beginning of line. ## sub F_BackwardKillLine { my $count = shift; return F_KillLine(-$count) if $count < 0; return F_Ding if $D == 0; kill_text(0, $D, 1); } ## ## TextInsert(count, string) ## sub TextInsert { my $count = shift; my $text2add = shift(@_) x $count; if ($InsertMode) { substr($line,$D,0) .= $text2add; } else { substr($line,$D,length($text2add)) = $text2add; } $D += length($text2add); } sub F_Yank { remove_selection(); &TextInsert($_[0], $KillBuffer); } sub F_YankPop { 1; ## not implemented yet } sub F_YankNthArg { 1; ## not implemented yet } ## ## Kill to the end of the current word. If not on a word, kill to ## the end of the next word. ## sub F_KillWord { my $count = shift; return &F_BackwardKillWord(-$count) if $count < 0; my $oldD = $D; &F_ForwardWord($count); ## moves forward $count words. kill_text($oldD, $D, 1); } ## ## Kill backward to the start of the current word, or, if currently ## not on a word (or just at the start of a word), to the start of the ## previous word. ## sub F_BackwardKillWord { my $count = shift; return F_KillWord(-$count) if $count < 0; my $oldD = $D; &F_BackwardWord($count); ## moves backward $count words. kill_text($D, $oldD, 1); } ########################################################################### ########################################################################### ## ## Abort the current input. ## sub F_Abort { &F_Ding; } ## ## If the character that got us here is upper case, ## do the lower-case equiv... ## sub F_DoLowercaseVersion { if ($_[1] >= ord('A') && $_[1] <= ord('Z')) { &do_command(*KeyMap, $_[0], $_[1] - ord('A') + ord('a')); } else { &F_Ding; } } ## ## do the equiv with control key... ## sub F_DoControlVersion { local *KeyMap = $var_EditingMode; my $key = $_[1]; if ($key == ord('?')) { $key = 0x7F; } else { $key &= ~(0x80 | 0x60); } &do_command(*KeyMap, $_[0], $key); } ## ## do the equiv with meta key... ## sub F_DoMetaVersion { local *KeyMap = $var_EditingMode; unshift @Pending, chr $_[1]; &do_command(*KeyMap, $_[0], ord "\e"); } ## ## If the character that got us here is Alt-Char, ## do the Esc Char equiv... ## sub F_DoEscVersion { my ($ord, $t) = $_[1]; &F_Ding unless $KeyMap{'Esc'}; for $t (([ord 'w', '`1234567890-='], [ord ',', 'zxcvbnm,./\\'], [16, 'qwertyuiop[]'], [ord(' ') - 2, 'asdfghjkl;\''])) { next unless $ord >= $t->[0] and $ord < $t->[0] + length($t->[1]); $ord = ord substr $t->[1], $ord - $t->[0], 1; return &do_command($KeyMap{'Esc'}, $_[0], $ord); } &F_Ding; } ## ## Undo one level. ## sub F_Undo { pop(@undo); # unless $undo[-1]->[5]; ## get rid of the state we just put on, so we can go back one. if (@undo) { &getstate(pop(@undo)); } else { &F_Ding; } } ## ## Replace the current line to some "before" state. ## sub F_RevertLine { if ($rl_HistoryIndex >= $#rl_History+1) { $line = $line_for_revert; } else { $line = $rl_History[$rl_HistoryIndex]; } $D = length($line); } sub F_EmacsEditingMode { $var_EditingMode = $var_EditingMode{'emacs'}; $Vi_mode = 0; } ########################################################################### ########################################################################### ## ## (Attempt to) interrupt the current program. ## sub F_Interrupt { local $\ = ''; print $term_OUT "\r\n"; &ResetTTY; kill ("INT", 0); ## We're back.... must not have died. $force_redraw = 1; } ## ## Execute the next character input as a command in a meta keymap. ## sub F_PrefixMeta { my($count, $keymap) = ($_[0], "$KeyMap{'name'}_$_[1]"); ##print "F_PrefixMeta [$keymap]\n\r"; die "" unless %$keymap; do_command(*$keymap, $count, ord(&getc_with_pending)); } sub F_UniversalArgument { &F_DigitArgument; } ## ## For typing a numeric prefix to a command.... ## sub F_DigitArgument { my $in = chr $_[1]; my ($NumericArg, $sawDigit) = (1, 0); my ($increment, $ord); ($NumericArg, $sawDigit) = ($_[0], $_[0] !~ /e0$/i) if $doingNumArg; # XXX What if Esc-- 1 ? do { $ord = ord $in; if (defined($KeyMap[$ord]) && $KeyMap[$ord] eq 'F_UniversalArgument') { $NumericArg *= 4; } elsif ($ord == ord('-') && !$sawDigit) { $NumericArg = -$NumericArg; } elsif ($ord >= ord('0') && $ord <= ord('9')) { $increment = ($ord - ord('0')) * ($NumericArg < 0 ? -1 : 1); if ($sawDigit) { $NumericArg = $NumericArg * 10 + $increment; } else { $NumericArg = $increment; $sawDigit = 1; } } else { local(*KeyMap) = $var_EditingMode; &redisplay(); $doingNumArg = 1; # Allow NumArg inside NumArg &do_command(*KeyMap, $NumericArg . ($sawDigit ? '': 'e0'), $ord); return; } ## make sure it's not toooo big. if ($NumericArg > $rl_max_numeric_arg) { $NumericArg = $rl_max_numeric_arg; } elsif ($NumericArg < -$rl_max_numeric_arg) { $NumericArg = -$rl_max_numeric_arg; } &redisplay(sprintf("(arg %d) ", $NumericArg)); } while defined($in = &getc_with_pending); } sub F_OverwriteMode { $InsertMode = 0; } sub F_InsertMode { $InsertMode = 1; } sub F_ToggleInsertMode { $InsertMode = !$InsertMode; } ## ## (Attempt to) suspend the program. ## sub F_Suspend { if ($inDOS && length($line)==0) { # EOF sent $AcceptLine = $ReturnEOF = 1 if $lastcommand ne 'F_DeleteChar'; return; } local $\ = ''; print $term_OUT "\r\n"; &ResetTTY; eval { kill ("TSTP", 0) }; ## We're back.... &SetTTY; $force_redraw = 1; } ## ## Ring the bell. ## Should do something with $var_PreferVisibleBell here, but what? ## sub F_Ding { local $\ = ''; print $term_OUT "\007"; return; # Undefined return value } ########################################################################## #### command/file completion ############################################ ########################################################################## ## ## How Command Completion Works ## ## When asked to do a completion operation, readline isolates the word ## to the immediate left of the cursor (i.e. what's just been typed). ## This information is then passed to some function (which may be supplied ## by the user of this package) which will return an array of possible ## completions. ## ## If there is just one, that one is used. Otherwise, they are listed ## in some way (depends upon $var_TcshCompleteMode). ## ## The default is to do filename completion. The function that performs ## this task is readline'rl_filename_list. ## ## A minimal-trouble way to have command-completion is to call ## readline'rl_basic_commands with an array of command names, such as ## &readline'rl_basic_commands('quit', 'run', 'set', 'list') ## Those command names will then be used for completion if the word being ## completed begins the line. Otherwise, completion is disallowed. ## ## The way to have the most power is to provide a function to readline ## which will accept information about a partial word that needs completed, ## and will return the appropriate list of possibilities. ## This is done by setting $readline'rl_completion_function to the name of ## the function to run. ## ## That function will be called with three args ($text, $line, $start). ## TEXT is the partial word that should be completed. LINE is the entire ## input line as it stands, and START is the index of the TEXT in LINE ## (i.e. zero if TEXT is at the beginning of LINE). ## ## A cool completion function will look at LINE and START and give context- ## sensitive completion lists. Consider something that will do completion ## for two commands ## cat FILENAME ## finger USERNAME ## status [this|that|other] ## ## It (untested) might look like: ## ## $readline'rl_completion_function = "main'complete"; ## sub complete { local($text, $_, $start) = @_; ## ## return commands which may match if at the beginning.... ## return grep(/^$text/, 'cat', 'finger') if $start == 0; ## return &rl_filename_list($text) if /^cat\b/; ## return &my_namelist($text) if /^finger\b/; ## return grep(/^text/, 'this', 'that','other') if /^status\b/; ## (); ## } ## Of course, a real completion function would be more robust, but you ## get the idea (I hope). ## ## ## List possible completions ## sub F_PossibleCompletions { &complete_internal('?'); } ## ## List possible completions ## sub F_InsertPossibleCompletions { &complete_internal('*'); } ## ## Do a completion operation. ## If the last thing we did was a completion operation, we'll ## now list the options available (under normal emacs mode). ## ## Under TcshCompleteMode, each contiguous subsequent completion operation ## lists another of the possible options. ## ## Returns true if a completion was done, false otherwise, so vi completion ## routines can test it. ## sub F_Complete { if ($lastcommand eq 'F_Complete') { if ($var_TcshCompleteMode && @tcsh_complete_selections > 0) { substr($line, $tcsh_complete_start, $tcsh_complete_len) = $tcsh_complete_selections[0]; $D -= $tcsh_complete_len; $tcsh_complete_len = length($tcsh_complete_selections[0]); $D += $tcsh_complete_len; push(@tcsh_complete_selections, shift(@tcsh_complete_selections)); } else { &complete_internal('?') or return; } } else { @tcsh_complete_selections = (); &complete_internal("\t") or return; } 1; } ## ## The meat of command completion. Patterned closely after GNU's. ## ## The supposedly partial word at the cursor is "completed" as per the ## single argument: ## "\t" complete as much of the word as is unambiguous ## "?" list possibilities. ## "*" replace word with all possibilities. (who would use this?) ## ## A few notable variables used: ## $rl_completer_word_break_characters ## -- characters in this string break a word. ## $rl_special_prefixes ## -- but if in this string as well, remain part of that word. ## ## Returns true if a completion was done, false otherwise, so vi completion ## routines can test it. ## sub complete_internal { my $what_to_do = shift; my ($point, $end) = ($D, $D); # In vi mode, complete if the cursor is at the *end* of a word, not # after it. ($point++, $end++) if $Vi_mode; if ($point) { ## Not at the beginning of the line; Isolate the word to be completed. 1 while (--$point && (-1 == index($rl_completer_word_break_characters, substr($line, $point, 1)))); # Either at beginning of line or at a word break. # If at a word break (that we don't want to save), skip it. $point++ if ( (index($rl_completer_word_break_characters, substr($line, $point, 1)) != -1) && (index($rl_special_prefixes, substr($line, $point, 1)) == -1) ); } my $text = substr($line, $point, $end - $point); $rl_completer_terminator_character = ' '; @matches = &completion_matches($rl_completion_function,$text,$line,$point); if (@matches == 0) { return &F_Ding; } elsif ($what_to_do eq "\t") { my $replacement = shift(@matches); $replacement .= $rl_completer_terminator_character if @matches == 1; &F_Ding if @matches != 1; if ($var_TcshCompleteMode) { @tcsh_complete_selections = (@matches, $text); $tcsh_complete_start = $point; $tcsh_complete_len = length($replacement); } if ($replacement ne '') { substr($line, $point, $end-$point) = $replacement; $D = $D - ($end - $point) + length($replacement); } } elsif ($what_to_do eq '?') { shift(@matches); ## remove prepended common prefix local $\ = ''; print $term_OUT "\n\r"; # print "@matches\n\r"; &pretty_print_list (@matches); $force_redraw = 1; } elsif ($what_to_do eq '*') { shift(@matches); ## remove common prefix. local $" = $rl_completer_terminator_character; my $replacement = "@matches$rl_completer_terminator_character"; substr($line, $point, $end-$point) = $replacement; ## insert all. $D = $D - ($end - $point) + length($replacement); } else { warn "\r\n[Internal error]"; return &F_Ding; } 1; } ## ## completion_matches(func, text, line, start) ## ## FUNC is a function to call as FUNC(TEXT, LINE, START) ## where TEXT is the item to be completed ## LINE is the whole command line, and ## START is the starting index of TEXT in LINE. ## The FUNC should return a list of items that might match. ## ## completion_matches will return that list, with the longest common ## prefix prepended as the first item of the list. Therefor, the list ## will either be of zero length (meaning no matches) or of 2 or more..... ## ## Works with &rl_basic_commands. Return items from @rl_basic_commands ## that start with the pattern in $text. sub use_basic_commands { my ($text, $line, $start) = @_; return () if $start != 0; grep(/^$text/, @rl_basic_commands); } sub completion_matches { my ($func, $text, $line, $start) = @_; ## get the raw list my @matches; #print qq/\r\neval("\@matches = &$func(\$text, \$line, \$start)\n\r/;#DEBUG #eval("\@matches = &$func(\$text, \$line, \$start);1") || warn "$@ "; @matches = &$func($text, $line, $start); ## if anything returned , find the common prefix among them if (@matches) { my $prefix = $matches[0]; my $len = length($prefix); for ($i = 1; $i < @matches; $i++) { next if substr($matches[$i], 0, $len) eq $prefix; $prefix = substr($prefix, 0, --$len); last if $len == 0; $i--; ## retry this one to see if the shorter one matches. } unshift(@matches, $prefix); ## make common prefix the first thing. } @matches; } ## ## For use in passing to completion_matches(), returns a list of ## filenames that begin with the given pattern. The user of this package ## can set $rl_completion_function to 'rl_filename_list' to restore the ## default of filename matching if they'd changed it earlier, either ## directly or via &rl_basic_commands. ## sub rl_filename_list { my $pattern = $_[0]; my @files = (<$pattern*>); if ($var_CompleteAddsuffix) { foreach (@files) { if (-l $_) { $_ .= '@'; } elsif (-d _) { $_ .= '/'; } elsif (-x _) { $_ .= '*'; } elsif (-S _ || -p _) { $_ .= '='; } } } return @files; } ## ## For use by the user of the package. Called with a list of possible ## commands, will allow command completion on those commands, but only ## for the first word on a line. ## For example: &rl_basic_commands('set', 'quit', 'type', 'run'); ## ## This is for people that want quick and simple command completion. ## A more thoughtful implementation would set $rl_completion_function ## to a routine that would look at the context of the word being completed ## and return the appropriate possibilities. ## sub rl_basic_commands { @rl_basic_commands = @_; $rl_completion_function = 'use_basic_commands'; } ## ## Print an array in columns like ls -C. Originally based on stuff ## (lsC2.pl) by utashiro@sran230.sra.co.jp (Kazumasa Utashiro). ## sub pretty_print_list { my @list = @_; return unless @list; my ($lines, $columns, $mark, $index); ## find width of widest entry my $maxwidth = 0; grep(length > $maxwidth && ($maxwidth = length), @list); $maxwidth++; $columns = $maxwidth >= $rl_screen_width ? 1 : int($rl_screen_width / $maxwidth); ## if there's enough margin to interspurse among the columns, do so. $maxwidth += int(($rl_screen_width % $maxwidth) / $columns); $lines = int((@list + $columns - 1) / $columns); $columns-- while ((($lines * $columns) - @list + 1) > $lines); $mark = $#list - $lines; local $\ = ''; for ($l = 0; $l < $lines; $l++) { for ($index = $l; $index <= $mark; $index += $lines) { printf("%-$ {maxwidth}s", $list[$index]); } print $term_OUT $list[$index] if $index <= $#list; print $term_OUT "\n\r"; } } ##----------------- Vi Routines -------------------------------- sub F_ViAcceptLine { &F_AcceptLine(); &F_ViInput(); } # Repeat the most recent one of these vi commands: # # a A c C d D i I p P r R s S x X ~ # sub F_ViRepeatLastCommand { my($count) = @_; return &F_Ding if !$Last_vi_command; my @lastcmd = @$Last_vi_command; # Multiply @lastcmd's numeric arg by $count. unless ($count == 1) { my $n = ''; while (@lastcmd and $lastcmd[0] =~ /^\d$/) { $n *= 10; $n += shift(@lastcmd); } $count *= $n unless $n eq ''; unshift(@lastcmd, split(//, $count)); } push(@Pending, @lastcmd); } sub F_ViMoveCursor { my($count, $ord) = @_; my $new_cursor = &get_position($count, $ord, undef, $Vi_move_patterns); return &F_Ding if !defined $new_cursor; $D = $new_cursor; } sub F_ViFindMatchingParens { # Move to the first parens at or after $D my $old_d = $D; &forward_scan(1, q/[^[\](){}]*/); my $parens = substr($line, $D, 1); my $mate_direction = { '(' => [ ')', 1 ], '[' => [ ']', 1 ], '{' => [ '}', 1 ], ')' => [ '(', -1 ], ']' => [ '[', -1 ], '}' => [ '{', -1 ], }->{$parens}; return &F_Ding() unless $mate_direction; my($mate, $direction) = @$mate_direction; my $lvl = 1; while ($lvl) { last if !$D && ($direction < 0); &F_ForwardChar($direction); last if &at_end_of_line; my $c = substr($line, $D, 1); if ($c eq $parens) { $lvl++; } elsif ($c eq $mate) { $lvl--; } } if ($lvl) { # We didn't find a match $D = $old_d; return &F_Ding(); } } sub F_ViForwardFindChar { &do_findchar(1, 1, @_); } sub F_ViBackwardFindChar { &do_findchar(-1, 0, @_); } sub F_ViForwardToChar { &do_findchar(1, 0, @_); } sub F_ViBackwardToChar { &do_findchar(-1, 1, @_); } sub F_ViMoveCursorTo { &do_findchar(1, -1, @_); } sub F_ViMoveCursorFind { &do_findchar(1, 0, @_); } sub F_ViRepeatFindChar { my($n) = @_; return &F_Ding if !defined $Last_findchar; &findchar(@$Last_findchar, $n); } sub F_ViInverseRepeatFindChar { my($n) = @_; return &F_Ding if !defined $Last_findchar; my($c, $direction, $offset) = @$Last_findchar; &findchar($c, -$direction, $offset, $n); } sub do_findchar { my($direction, $offset, $n) = @_; my $c = &getc_with_pending; $c = &getc_with_pending if $c eq "\cV"; return &F_ViCommandMode if $c eq "\e"; $Last_findchar = [$c, $direction, $offset]; &findchar($c, $direction, $offset, $n); } sub findchar { my($c, $direction, $offset, $n) = @_; my $old_d = $D; while ($n) { last if !$D && ($direction < 0); &F_ForwardChar($direction); last if &at_end_of_line; my $char = substr($line, $D, 1); $n-- if substr($line, $D, 1) eq $c; } if ($n) { # Not found $D = $old_d; return &F_Ding; } &F_ForwardChar($offset); } sub F_ViMoveToColumn { my($n) = @_; $D = 0; my $col = 1; while (!&at_end_of_line and $col < $n) { my $c = substr($line, $D, 1); if ($c eq "\t") { $col += 7; $col -= ($col % 8) - 1; } else { $col++; } $D += &CharSize($D); } } sub start_dot_buf { my($count, $ord) = @_; $Dot_buf = [pack('c', $ord)]; unshift(@$Dot_buf, split(//, $count)) if $count > 1; $Dot_state = savestate(); } sub end_dot_buf { # We've recognized an editing command # Save the command keystrokes for use by '.' $Last_vi_command = $Dot_buf; undef $Dot_buf; # Save the pre-command state for use by 'u' and 'U'; $Vi_undo_state = $Dot_state; $Vi_undo_all_state = $Dot_state if !$Vi_undo_all_state; # Make sure the current line is treated as new line for history purposes. $rl_HistoryIndex = $#rl_History + 1; } sub save_dot_buf { &start_dot_buf(@_); &end_dot_buf; } sub F_ViUndo { return &F_Ding unless defined $Vi_undo_state; my $state = savestate(); &getstate($Vi_undo_state); $Vi_undo_state = $state; } sub F_ViUndoAll { $Vi_undo_state = $Vi_undo_all_state; &F_ViUndo; } sub F_ViChange { my($count, $ord) = @_; &start_dot_buf(@_); &do_delete($count, $ord, $Vi_change_patterns) || return(); &vi_input_mode; } sub F_ViDelete { my($count, $ord) = @_; &start_dot_buf(@_); &do_delete($count, $ord, $Vi_delete_patterns); &end_dot_buf; } sub do_delete { my($count, $ord, $poshash) = @_; my $other_end = &get_position($count, undef, $ord, $poshash); return &F_Ding if !defined $other_end; if ($other_end < 0) { # dd - delete entire line &kill_text(0, length($line), 1); } else { &kill_text($D, $other_end, 1); } 1; # True return value } sub F_ViDeleteChar { my($count) = @_; &save_dot_buf(@_); my $other_end = $D + $count; $other_end = length($line) if $other_end > length($line); &kill_text($D, $other_end, 1); } sub F_ViBackwardDeleteChar { my($count) = @_; &save_dot_buf(@_); my $other_end = $D - $count; $other_end = 0 if $other_end < 0; &kill_text($other_end, $D, 1); $D = $other_end; } ## ## Prepend line with '#', add to history, and clear the input buffer ## (this feature was borrowed from ksh). ## sub F_SaveLine { local $\ = ''; $line = '#'.$line; &redisplay(); print $term_OUT "\r\n"; &add_line_to_history; $line_for_revert = ''; &get_line_from_history(scalar @rl_History); &F_ViInput() if $Vi_mode; } # # Come here if we see a non-positioning keystroke when a positioning # keystroke is expected. # sub F_ViNonPosition { # Not a positioning command - undefine the cursor to indicate the error # to get_position(). undef $D; } # # Come here if we see , but *not* an arrow key or other # mapped sequence, when a positioning keystroke is expected. # sub F_ViPositionEsc { my($count, $ord) = @_; # We got in vipos mode. Put back onto the # input stream and terminate the positioning command. unshift(@Pending, pack('c', $ord)); &F_ViNonPosition; } # Interpret vi positioning commands sub get_position { my ($count, $ord, $fullline_ord, $poshash) = @_; # Manipulate a copy of the cursor, not the real thing local $D = $D; # $ord (first character of positioning command) is an optional argument. $ord = ord(&getc_with_pending) if !defined $ord; # Detect double character (for full-line operation, e.g. dd) return -1 if defined $fullline_ord and $ord == $fullline_ord; my $re = $poshash->{$ord}; if ($re) { my $c = pack('c', $ord); if (lc($c) eq 'b') { &backward_scan($count, $re); } else { &forward_scan($count, $re); } } else { # Move the local copy of the cursor &do_command($var_EditingMode{'vipos'}, $count, $ord); } # Return the new cursor (undef if illegal command) $D; } ## ## Go to first non-space character of line. ## sub F_ViFirstWord { $D = 0; &forward_scan(1, q{\s+}); } sub forward_scan { my($count, $re) = @_; while ($count--) { last unless substr($line, $D) =~ m{^($re)}; $D += length($1); } } sub backward_scan { my($count, $re) = @_; while ($count--) { last unless substr($line, 0, $D) =~ m{($re)$}; $D -= length($1); } } # Note: like the emacs case transforms, this doesn't work for # two-byte characters. sub F_ViToggleCase { my($count) = @_; &save_dot_buf(@_); while ($count-- > 0) { substr($line, $D, 1) =~ tr/A-Za-z/a-zA-Z/; &F_ForwardChar(1); if (&at_end_of_line) { &F_BackwardChar(1); last; } } } # Go to the numbered history line, as listed by the 'H' command, i.e. the # current $line is line 1, the youngest line in @rl_History is 2, etc. sub F_ViHistoryLine { my($n) = @_; &get_line_from_history(@rl_History - $n + 1); } sub get_line_from_history { my($n) = @_; return &F_Ding if $n < 0 or $n > @rl_History; return if $n == $rl_HistoryIndex; # If we're moving from the currently-edited line, save it for later. $line_for_revert = $line if $rl_HistoryIndex == @rl_History; # Get line from history buffer (or from saved edit line). $line = ($n == @rl_History) ? $line_for_revert : $rl_History[$n]; $D = $Vi_mode ? 0 : length $line; # Subsequent 'U' will bring us back to this point. $Vi_undo_all_state = savestate() if $Vi_mode; $rl_HistoryIndex = $n; } sub F_PrintHistory { my($count) = @_; $count = 20 if $count == 1; # Default - assume 'H', not '1H' my $end = $rl_HistoryIndex + $count/2; $end = @rl_History if $end > @rl_History; my $start = $end - $count + 1; $start = 0 if $start < 0; my $lmh = length $rl_MaxHistorySize; my $lspace = ' ' x ($lmh+3); my $hdr = "$lspace-----"; $hdr .= " (Use ESC UP to retrieve command ) -----" unless $Vi_mode; $hdr .= " (Use 'G' to retrieve command ) -----" if $Vi_mode; local ($\, $,) = ('',''); print "\n$hdr\n"; print $lspace, ". . .\n" if $start > 0; my $i; my $shift = ($Vi_mode != 0); for $i ($start .. $end) { print + ($i == $rl_HistoryIndex) ? '>' : ' ', sprintf("%${lmh}d: ", @rl_History - $i + $shift), ($i < @rl_History) ? $rl_History[$i] : ($i == $rl_HistoryIndex) ? $line : $line_for_revert, "\n"; } print $lspace, ". . .\n" if $end < @rl_History; print "$hdr\n"; &force_redisplay(); &F_ViInput() if $line eq '' && $Vi_mode; } # Redisplay the line, without attempting any optimization sub force_redisplay { local $force_redraw = 1; &redisplay(@_); } # Search history for matching string. As with vi in nomagic mode, the # ^, $, \<, and \> positional assertions, the \* quantifier, the \. # character class, and the \[ character class delimiter all have special # meaning here. sub F_ViSearch { my($n, $ord) = @_; my $c = pack('c', $ord); my $str = &get_vi_search_str($c); if (!defined $str) { # Search aborted by deleting the '/' at the beginning of the line return &F_ViInput() if $line eq ''; return(); } # Null string repeats last search if ($str eq '') { return &F_Ding unless defined $Vi_search_re; } else { # Convert to a regular expression. Interpret $str Like vi in nomagic # mode: '^', '$', '\<', and '\>' positional assertions, '\*' # quantifier, '\.' and '\[]' character classes. my @chars = ($str =~ m{(\\?.)}g); my(@re, @tail); unshift(@re, shift(@chars)) if @chars and $chars[0] eq '^'; push (@tail, pop(@chars)) if @chars and $chars[-1] eq '$'; my $in_chclass; my %chmap = ( '\<' => '\b(?=\w)', '\>' => '(?<=\w)\b', '\*' => '*', '\[' => '[', '\.' => '.', ); my $ch; foreach $ch (@chars) { if ($in_chclass) { # Any backslashes in vi char classes are literal push(@re, "\\") if length($ch) > 1; push(@re, $ch); $in_chclass = 0 if $ch =~ /\]$/; } else { push(@re, (length $ch == 2) ? ($chmap{$ch} || $ch) : ($ch =~ /^\w$/) ? $ch : ("\\", $ch)); $in_chclass = 1 if $ch eq '\['; } } my $re = join('', @re, @tail); $Vi_search_re = q{$re}; } local $reverse = $Vi_search_reverse = ($c eq '/') ? 1 : 0; &do_vi_search(); } sub F_ViRepeatSearch { my($n, $ord) = @_; my $c = pack('c', $ord); return &F_Ding unless defined $Vi_search_re; local $reverse = $Vi_search_reverse; $reverse ^= 1 if $c eq 'N'; &do_vi_search(); } ## returns a new $i or -1 if not found. sub vi_search { my ($i) = @_; return -1 if $i < 0 || $i > $#rl_History; ## for safety while (1) { return $i if $rl_History[$i] =~ /$Vi_search_re/; if ($reverse) { return -1 if $i-- == 0; } else { return -1 if $i++ == $#rl_History; } } } sub do_vi_search { my $incr = $reverse ? -1 : 1; my $i = &vi_search($rl_HistoryIndex + $incr); return &F_Ding if $i < 0; # Not found. $rl_HistoryIndex = $i; ($D, $line) = (0, $rl_History[$rl_HistoryIndex]); } # Using local $line, $D, and $prompt, get and return the string to search for. sub get_vi_search_str { my($c) = @_; local $prompt = $prompt . $c; local ($line, $D) = ('', 0); &redisplay(); # Gather a search string in our local $line. while ($lastcommand ne 'F_ViEndSearch') { &do_command($var_EditingMode{'visearch'}, 1, ord(&getc_with_pending)); &redisplay(); # We've backspaced past beginning of line return undef if !defined $line; } $line; } sub F_ViEndSearch {} sub F_ViSearchBackwardDeleteChar { if ($line eq '') { # Backspaced past beginning of line - terminate search mode undef $line; } else { &F_BackwardDeleteChar(@_); } } ## ## Kill entire line and enter input mode ## sub F_ViChangeEntireLine { &start_dot_buf(@_); kill_text(0, length($line), 1); &vi_input_mode; } ## ## Kill characters and enter input mode ## sub F_ViChangeChar { &start_dot_buf(@_); &F_DeleteChar(@_); &vi_input_mode; } sub F_ViReplaceChar { &start_dot_buf(@_); my $c = &getc_with_pending; $c = &getc_with_pending if $c eq "\cV"; # ctrl-V return &F_ViCommandMode if $c eq "\e"; &end_dot_buf; local $InsertMode = 0; local $D = $D; # Preserve cursor position &F_SelfInsert(1, ord($c)); } ## ## Kill from cursor to end of line and enter input mode ## sub F_ViChangeLine { &start_dot_buf(@_); &F_KillLine(@_); &vi_input_mode; } sub F_ViDeleteLine { &save_dot_buf(@_); &F_KillLine(@_); } sub F_ViPut { my($count) = @_; &save_dot_buf(@_); my $text2add = $KillBuffer x $count; my $ll = length($line); $D++; $D = $ll if $D > $ll; substr($line, $D, 0) = $KillBuffer x $count; $D += length($text2add) - 1; } sub F_ViPutBefore { &save_dot_buf(@_); &TextInsert($_[0], $KillBuffer); } sub F_ViYank { my($count, $ord) = @_; my $pos = &get_position($count, undef, $ord, $Vi_yank_patterns); &F_Ding if !defined $pos; if ($pos < 0) { # yy &F_ViYankLine; } else { my($from, $to) = ($pos > $D) ? ($D, $pos) : ($pos, $D); $KillBuffer = substr($line, $from, $to-$from); } } sub F_ViYankLine { $KillBuffer = $line; } sub F_ViInput { @_ = (1, ord('i')) if !@_; &start_dot_buf(@_); &vi_input_mode; } sub F_ViBeginInput { &start_dot_buf(@_); &F_BeginningOfLine; &vi_input_mode; } sub F_ViReplaceMode { &start_dot_buf(@_); $InsertMode = 0; $var_EditingMode = $var_EditingMode{'vi'}; $Vi_mode = 1; } sub vi_input_mode { $InsertMode = 1; $var_EditingMode = $var_EditingMode{'vi'}; $Vi_mode = 1; } # The previous keystroke was an escape, but the sequence was not recognized # as a mapped sequence (like an arrow key). Enter vi comand mode and # process this keystroke. sub F_ViAfterEsc { my($n, $ord) = @_; &F_ViCommandMode; &do_command($var_EditingMode, 1, $ord); } sub F_ViAppend { &start_dot_buf(@_); &vi_input_mode; &F_ForwardChar; } sub F_ViAppendLine { &start_dot_buf(@_); &vi_input_mode; &F_EndOfLine; } sub F_ViCommandMode { $var_EditingMode = $var_EditingMode{'vicmd'}; $Vi_mode = 1; } sub F_ViAcceptInsert { local $in_accept_line = 1; &F_ViEndInsert; &F_ViAcceptLine; } sub F_ViEndInsert { if ($Dot_buf) { if ($line eq '' and $Dot_buf->[0] eq 'i') { # We inserted nothing into an empty $line - assume it was a # &F_ViInput() call with no arguments, and don't save command. undef $Dot_buf; } else { # Regardless of which keystroke actually terminated this insert # command, replace it with an in the dot buffer. @{$Dot_buf}[-1] = "\e"; &end_dot_buf; } } &F_ViCommandMode; # Move cursor back to the last inserted character, but not when # we're about to accept a line of input &F_BackwardChar(1) unless $in_accept_line; } sub F_ViDigit { my($count, $ord) = @_; my $n = 0; my $ord0 = ord('0'); while (1) { $n *= 10; $n += $ord - $ord0; my $c = &getc_with_pending; return unless defined $c; $ord = ord($c); last unless $c =~ /^\d$/; } $n *= $count; # So 2d3w deletes six words $n = $rl_max_numeric_arg if $n > $rl_max_numeric_arg; &do_command($var_EditingMode, $n, $ord); } sub F_ViComplete { my($n, $ord) = @_; $Dot_state = savestate(); # Completion is undo-able undef $Dot_buf; # but not redo-able my $ch; while (1) { &F_Complete() or return; # Vi likes the cursor one character right of where emacs like it. &F_ForwardChar(1); &force_redisplay(); # Look ahead to the next input keystroke. $ch = &getc_with_pending(); last unless ord($ch) == $ord; # Not a '\' - quit. # Another '\' was typed - put the cursor back where &F_Complete left # it, and try again. &F_BackwardChar(1); $lastcommand = 'F_Complete'; # Play along with &F_Complete's kludge } unshift(@Pending, $ch); # Unget the lookahead keystroke # Successful completion - enter input mode with cursor beyond end of word. &vi_input_mode; } sub F_ViInsertPossibleCompletions { $Dot_state = savestate(); # Completion is undo-able undef $Dot_buf; # but not redo-able &complete_internal('*') or return; # Successful completion - enter input mode with cursor beyond end of word. &F_ForwardChar(1); &vi_input_mode; } sub F_ViPossibleCompletions { # List possible completions &complete_internal('?'); # Enter input mode with cursor where we left off. &F_ForwardChar(1); &vi_input_mode; } sub F_SetMark { $rl_mark = $D; pos $line = $rl_mark; $line_rl_mark = $rl_HistoryIndex; $force_redraw = 1; } sub F_ExchangePointAndMark { return F_Ding unless $line_rl_mark == $rl_HistoryIndex; ($rl_mark, $D) = ($D, $rl_mark); pos $line = $rl_mark; $D = length $line if $D > length $line; $force_redraw = 1; } sub F_KillRegion { return F_Ding unless $line_rl_mark == $rl_HistoryIndex; $rl_mark = length $line if $rl_mark > length $line; kill_text($rl_mark, $D, 1); $line_rl_mark = -1; # Disable mark } sub F_CopyRegionAsKill { return F_Ding unless $line_rl_mark == $rl_HistoryIndex; $rl_mark = length $line if $rl_mark > length $line; my ($s, $e) = ($rl_mark, $D); ($s, $e) = ($e, $s) if $s > $e; $ThisCommandKilledText = 1 + $s; $KillBuffer = '' if !$LastCommandKilledText; $KillBuffer .= substr($line, $s, $e - $s); } sub clipboard_set { my $in = shift; if ($^O eq 'os2') { eval { require OS2::Process; OS2::Process::ClipbrdText_set($in); # Do not disable \r\n-conversion 1 } and return; } elsif ($^O eq 'MSWin32') { eval { require Win32::Clipboard; Win32::Clipboard::Set($in); 1 } and return; } my $mess; if ($ENV{RL_CLCOPY_CMD}) { $mess = "Writing to pipe `$ENV{RL_CLCOPY_CMD}'"; open COPY, "| $ENV{RL_CLCOPY_CMD}" or warn("$mess: $!"), return; } elsif (defined $ENV{HOME}) { $mess = "Writing to file `$ENV{HOME}/.rl_cutandpaste'"; open COPY, "> $ENV{HOME}/.rl_cutandpaste" or warn("$mess: $!"), return; } else { return; } print COPY $in; close COPY or warn("$mess: closing $!"); } sub F_CopyRegionAsKillClipboard { return clipboard_set($line) unless $line_rl_mark == $rl_HistoryIndex; &F_CopyRegionAsKill; clipboard_set($KillBuffer); } sub F_KillRegionClipboard { &F_KillRegion; clipboard_set($KillBuffer); } sub F_YankClipboard { remove_selection(); my $in; if ($^O eq 'os2') { eval { require OS2::Process; $in = OS2::Process::ClipbrdText(); $in =~ s/\r\n/\n/g; # With old versions, or what? } } elsif ($^O eq 'MSWin32') { eval { require Win32::Clipboard; $in = Win32::Clipboard::GetText(); $in =~ s/\r\n/\n/g; # is this needed? } } else { my $mess; if ($ENV{RL_PASTE_CMD}) { $mess = "Reading from pipe `$ENV{RL_PASTE_CMD}'"; open PASTE, "$ENV{RL_PASTE_CMD} |" or warn("$mess: $!"), return; } elsif (defined $ENV{HOME}) { $mess = "Reading from file `$ENV{HOME}/.rl_cutandpaste'"; open PASTE, "< $ENV{HOME}/.rl_cutandpaste" or warn("$mess: $!"), return; } if ($mess) { local $/; $in = ; close PASTE or warn("$mess, closing: $!"); } } if (defined $in) { $in =~ s/\n+$//; return &TextInsert($_[0], $in); } &TextInsert($_[0], $KillBuffer); } sub F_BeginUndoGroup { push @undoGroupS, $#undo; } sub F_EndUndoGroup { return F_Ding unless @undoGroupS; my $last = pop @undoGroupS; return unless $#undo > $last + 1; my $now = pop @undo; $#undo = $last; push @undo, $now; } sub F_DoNothing { # E.g., reset digit-argument 1; } sub F_ForceMemorizeDigitArgument { $memorizedArg = shift; } sub F_MemorizeDigitArgument { return if defined $memorizedArg; $memorizedArg = shift; } sub F_UnmemorizeDigitArgument { $memorizedArg = undef; } sub F_MemorizePos { $memorizedPos = $D; } # It is assumed that F_MemorizePos was called, then something was inserted, # then F_MergeInserts is called with a prefix argument to multiply # insertion by sub F_MergeInserts { my $n = shift; return F_Ding unless defined $memorizedPos and $n > 0; my ($b, $e) = ($memorizedPos, $D); ($b, $e) = ($e, $b) if $e < $b; if ($n) { substr($line, $e, 0) = substr($line, $b, $e - $b) x ($n - 1); } else { substr($line, $b, $e - $b) = ''; } $D = $b + ($e - $b) * $n; } sub F_ResetDigitArgument { return F_Ding unless defined $memorizedArg; my $in = &getc_with_pending; return unless defined $in; my $ord = ord $in; local(*KeyMap) = $var_EditingMode; &do_command(*KeyMap, $memorizedArg, $ord); } sub F_BeginPasteGroup { my $c = shift; $memorizedArg = $c unless defined $memorizedArg; F_BeginUndoGroup(1); $memorizedPos = $D; } sub F_EndPasteGroup { my $c = $memorizedArg; undef $memorizedArg; $c = 1 unless defined $c; F_MergeInserts($c); F_EndUndoGroup(1); } sub F_BeginEditGroup { $memorizedArg = shift; F_BeginUndoGroup(1); } sub F_EndEditGroup { undef $memorizedArg; F_EndUndoGroup(1); } 1; __END__ Term-ReadLine-Perl-1.0303/README0000700000000000000000000000470007451730564012643 0ustar LEGALESE ~~~~~~~~ Copyright (c) 1995 Ilya Zakharevich. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. You should have received a copy of the Perl license along with Perl; see the file README in Perl distribution. You should have received a copy of the GNU General Public License along with Perl; see the file Copying. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. You should have received a copy of the Artistic License along with Perl; see the file Artistic. Author of this software makes no claim whatsoever about suitability, reliability, edability, editability or usability of this product, and should not be kept liable for any damage resulting from the use of it. If you can use it, you are in luck, if not, I should not be kept responsible. Keep a handy copy of your backup tape at hand. WHAT ~~~~ This is a quick implementation of the minimal interface to Readline libraries. The implementation is made in Perl (mostly) by Jeffrey Friedl. The only thing this library does is to make it conformant (and add some minimal changes, like using Term::ReadKey if present, and correct work under xterm). (In fact this is an understatement now, a lot of additions are made, see CHANGES...) INSTALL ~~~~~~~ To install this module type perl Makefile.PL make make test or (with newer makemaker) make test_dynamic (Check whether you are satisfied with the results. Try to redirect stdin and/or stdout.) make install You may need to install Term::ReadKey first if your system is new (Solaris is ;-(). (Available in standard places, checked with 1.98.) If you see something like Can't ioctl TIOCGETP: Invalid argument at ... this means you need ReadKey. Note that as of 0.95 Term/ReadLine.pm is unbundled to make CPAN.pm happier. On the other hand, if you get newer Term/ReadLine.pm (say, by installing newer Perl) you may get more features enabled. For most features of T::R::P one needs to look in the CHANGES file, and the comments at the start of of readline/readline.pm. Volunteers to make the corresponding OO interface into POD are welcome (wrappers are available in Term::ReadLine::Perl; see perl5db.pl for a sample usage of hairier features, such as accessing Readline variables and methods). AUTHOR BUGS ~~~~~~~~~~~ Ilya Zakharevich cpan@ilyaz.org Std dstribution site: http://www.ilyaz.org/software/perl/modules Term-ReadLine-Perl-1.0303/test.pl0000700000000000000000000000346111271777762013310 0ustar #! /usr/bin/perl -w # Give an argument to use stdin, stdout instead of console # If argument starts with /dev, use it as console # If argument is '--no-print', do not print the result. BEGIN{ $ENV{PERL_RL} = 'Perl' }; # Do not test TR::Gnu ! use Term::ReadLine; use Carp; $SIG{__WARN__} = sub { warn Carp::longmess(@_) }; my $ev; if ($ENV{$ev = 'AUTOMATED_TESTING'} or $ENV{$ev = 'PERL_MM_NONINTERACTIVE'}) { print "1..0 # skip: \$ENV{$ev} is TRUE\n"; exit; } if (!@ARGV) { $term = new Term::ReadLine 'Simple Perl calc'; } elsif (@ARGV == 2) { open(IN,"<$ARGV[0]"); open(OUT,">$ARGV[1]"); $term = new Term::ReadLine 'Simple Perl calc', \*IN, \*OUT; } elsif ($ARGV[0] =~ m|^/dev|) { open(IN,"<$ARGV[0]"); open(OUT,">$ARGV[0]"); $term = new Term::ReadLine 'Simple Perl calc', \*IN, \*OUT; } else { $term = new Term::ReadLine 'Simple Perl calc', \*STDIN, \*STDOUT; $no_print = $ARGV[0] eq '--no-print'; } $prompt = "Enter arithmetic or Perl expression: "; if ((my $l = $ENV{PERL_RL_TEST_PROMPT_MINLEN} | 0) > length $prompt) { $prompt =~ s/(?=:)/ ' ' x ($l - length $prompt)/e; } $OUT = $term->OUT || STDOUT; %features = %{ $term->Features }; if (%features) { @f = %features; print $OUT "Features present: @f\n"; #$term->ornaments(1) if $features{ornaments}; } else { print $OUT "No additional features present.\n"; } print $OUT "\n Flipping rl_default_selected each line.\n"; print $OUT <readline($prompt, "exit")) ) { $res = eval($_); warn $@ if $@; print $OUT $res, "\n" unless $@ or $no_print; $term->addhistory($_) if /\S/ and !$features{autohistory}; $readline::rl_default_selected = !$readline::rl_default_selected; }