Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 13a7879c

Von Moritz Bunkus vor mehr als 10 Jahren hinzugefügt

  • ID 13a7879c8ccbd967869e2eeeae76065c6cb4c4f0
  • Vorgänger d7fddb8d
  • Nachfolger 1192822f

Term::ReadLine::Perl::Bind in Console nicht nutzen

Fixt zwar unter RXVT, macht aber unter anderen Emulatoren die Bindings
ziemlich kaputt.

Unterschiede anzeigen:

modules/override/Term/ReadLine/Perl/Bind.pm
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)
4

  
5
### Set readline bindkeys for common terminals
6

  
7
use warnings;
8
use strict;
9

  
10
BEGIN {
11
    require Exporter;
12
    *import = \&Exporter::import; # just inherit import() only
13

  
14
    our $VERSION   = 1.001;
15
    our @EXPORT_OK = qw(rl_bind_action $action2key $key2codes);
16
}
17

  
18
use Term::ReadLine;
19

  
20
# http://cpansearch.perl.org/src/ILYAZ/Term-ReadLine-Perl-1.0302/ReadLine
21
my $got_rl_perl;
22

  
23
BEGIN {
24
    $got_rl_perl = eval {
25
        require Term::ReadLine::Perl;
26
        require Term::ReadLine::readline;
27
    };
28
}
29

  
30
# bindkey actions for terminals
31
our $action2key = {
32
    Complete               => "Tab",
33
    PossibleCompletions    => "C-d",
34
    QuotedInsert           => "C-v",
35

  
36
    ToggleInsertMode       => "Insert",
37
    DeleteChar             => "Del",
38
    UpcaseWord             => "PageUp",
39
    DownCaseWord           => "PageDown",
40
    BeginningOfLine        => "Home",
41
    EndOfLine              => "End",
42

  
43
    ReverseSearchHistory   => "C-Up",
44
    ForwardSearchHistory   => "C-Down",
45
    ForwardWord            => "C-Right",
46
    BackwardWord           => "C-Left",
47

  
48
    HistorySearchBackward  => "S-Up",
49
    HistorySearchForward   => "S-Down",
50
    KillWord               => "S-Right",
51
    BackwardKillWord       => "S-Left",
52

  
53
    Yank                   => "A-Down", # paste
54
    KillLine               => "A-Right",
55
    BackwardKillLine       => "A-Left",
56
};
57

  
58
our $key2codes = {
59
    "Tab"                  => [ "TAB", ],
60
    "C-d"                  => [ "C-d", ],
61
    "C-v"                  => [ "C-v", ],
62

  
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"), ],
69

  
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"), ],
74

  
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"), ],
79

  
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"), ],
83
};
84

  
85
# warn if any keycode is clobbered
86
our $debug = 0;
87

  
88
# check ref type
89
sub _is_array { ref($_[0]) && eval { @{ $_[0] } or 1 } }
90
sub _is_hash  { ref($_[0]) && eval { %{ $_[0] } or 1 } }
91

  
92
# set bindkey actions for each terminal
93
my %code2action;
94

  
95
sub rl_bind_action {
96
    if ($got_rl_perl)
97
    {
98
        my $a2k = shift();
99
        return () unless _is_hash($a2k);
100

  
101
        while (my ($action, $bindkey) = each %{ $a2k })
102
        {
103
            # use default keycodes if none provided
104
            my @keycodes = @_ ? @_ : $key2codes;
105

  
106
            for my $k2c (@keycodes)
107
            {
108
                next unless _is_hash($k2c);
109

  
110
                my $codes = $k2c->{$bindkey};
111
                next unless defined($codes);
112
                $codes = [ $codes ] unless _is_array($codes);
113

  
114
                for my $code (@{ $codes })
115
                {
116
                    if ($debug && $code2action{$code})
117
                    {
118
                        my $hexcode = $code;
119
                        $hexcode =~ s/^"(.*)"$/$1/;
120
                        $hexcode = join(" ", map { uc } unpack("(H2)*", $hexcode));
121

  
122
                        warn <<"EOT";
123
rl_bind_action(): re-binding keycode [ $hexcode ] from '$code2action{$code}' to '$action'
124
EOT
125
                    }
126

  
127
                    readline::rl_bind($code, $action);
128
                    $code2action{$code} = $action;
129
                }
130
            }
131
        }
132
    }
133
    else
134
    {
135
        warn <<"EOT";
136
rl_bind_action(): Term::ReadLine::Perl is not available. No bindkeys were set.
137
EOT
138
    }
139

  
140
    return $got_rl_perl;
141
}
142

  
143
# default bind
144
rl_bind_action($action2key);
145

  
146
# bind Delete key for 'xterm'
147
if ($got_rl_perl && defined($ENV{TERM}) && $ENV{TERM} =~ /xterm/)
148
{
149
    rl_bind_action($action2key, +{ "Del" => qq("\x7F") });
150
}
151

  
152
'Term::ReadLine::Perl::Bind';
153

  
scripts/console
14 14
use File::Slurp;
15 15
use Getopt::Long;
16 16
use Pod::Usage;
17
use Term::ReadLine::Perl::Bind;     # use sane key binding for rxvt users
18 17

  
19 18
use SL::LxOfficeConf;
20 19
SL::LxOfficeConf->read;

Auch abrufbar als: Unified diff