1 package Term::ReadLine::Perl::Bind;
2 ### From http://www.perlmonks.org/?node_id=751611
3 ### Posted by repellant (http://www.perlmonks.org/?node_id=665462)
5 ### Set readline bindkeys for common terminals
12 *import = \&Exporter::import; # just inherit import() only
15 our @EXPORT_OK = qw(rl_bind_action $action2key $key2codes);
20 # http://cpansearch.perl.org/src/ILYAZ/Term-ReadLine-Perl-1.0302/ReadLine
25 require Term::ReadLine::Perl;
26 require Term::ReadLine::readline;
30 # bindkey actions for terminals
33 PossibleCompletions => "C-d",
34 QuotedInsert => "C-v",
36 ToggleInsertMode => "Insert",
38 UpcaseWord => "PageUp",
39 DownCaseWord => "PageDown",
40 BeginningOfLine => "Home",
43 ReverseSearchHistory => "C-Up",
44 ForwardSearchHistory => "C-Down",
45 ForwardWord => "C-Right",
46 BackwardWord => "C-Left",
48 HistorySearchBackward => "S-Up",
49 HistorySearchForward => "S-Down",
50 KillWord => "S-Right",
51 BackwardKillWord => "S-Left",
53 Yank => "A-Down", # paste
54 KillLine => "A-Right",
55 BackwardKillLine => "A-Left",
63 "Insert" => [ qq("\e[2~"), qq("\e[2z"), qq("\e[L"), ],
64 "Del" => [ qq("\e[3~"), ],
65 "PageUp" => [ qq("\e[5~"), qq("\e[5z"), qq("\e[I"), ],
66 "PageDown" => [ qq("\e[6~"), qq("\e[6z"), qq("\e[G"), ],
67 "Home" => [ qq("\e[7~"), qq("\e[1~"), qq("\e[H"), ],
68 "End" => [ qq("\e[8~"), qq("\e[4~"), qq("\e[F"), ],
70 "C-Up" => [ qq("\eOa"), qq("\eOA"), qq("\e[1;5A"), ],
71 "C-Down" => [ qq("\eOb"), qq("\eOB"), qq("\e[1;5B"), ],
72 "C-Right" => [ qq("\eOc"), qq("\eOC"), qq("\e[1;5C"), ],
73 "C-Left" => [ qq("\eOd"), qq("\eOD"), qq("\e[1;5D"), ],
75 "S-Up" => [ qq("\e[a"), qq("\e[1;2A"), ],
76 "S-Down" => [ qq("\e[b"), qq("\e[1;2B"), ],
77 "S-Right" => [ qq("\e[c"), qq("\e[1;2C"), ],
78 "S-Left" => [ qq("\e[d"), qq("\e[1;2D"), ],
80 "A-Down" => [ qq("\e\e[B"), qq("\e[1;3B"), ],
81 "A-Right" => [ qq("\e\e[C"), qq("\e[1;3C"), ],
82 "A-Left" => [ qq("\e\e[D"), qq("\e[1;3D"), ],
85 # warn if any keycode is clobbered
89 sub _is_array { ref($_[0]) && eval { @{ $_[0] } or 1 } }
90 sub _is_hash { ref($_[0]) && eval { %{ $_[0] } or 1 } }
92 # set bindkey actions for each terminal
99 return () unless _is_hash($a2k);
101 while (my ($action, $bindkey) = each %{ $a2k })
103 # use default keycodes if none provided
104 my @keycodes = @_ ? @_ : $key2codes;
106 for my $k2c (@keycodes)
108 next unless _is_hash($k2c);
110 my $codes = $k2c->{$bindkey};
111 next unless defined($codes);
112 $codes = [ $codes ] unless _is_array($codes);
114 for my $code (@{ $codes })
116 if ($debug && $code2action{$code})
119 $hexcode =~ s/^"(.*)"$/$1/;
120 $hexcode = join(" ", map { uc } unpack("(H2)*", $hexcode));
123 rl_bind_action(): re-binding keycode [ $hexcode ] from '$code2action{$code}' to '$action'
127 readline::rl_bind($code, $action);
128 $code2action{$code} = $action;
136 rl_bind_action(): Term::ReadLine::Perl is not available. No bindkeys were set.
144 rl_bind_action($action2key);
146 # bind Delete key for 'xterm'
147 if ($got_rl_perl && defined($ENV{TERM}) && $ENV{TERM} =~ /xterm/)
149 rl_bind_action($action2key, +{ "Del" => qq("\x7F") });
152 'Term::ReadLine::Perl::Bind';