/[cwmp]/google/lib/Term/Shelly.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /google/lib/Term/Shelly.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 87 by dpavlin, Fri Jun 22 20:05:30 2007 UTC revision 88 by dpavlin, Fri Jun 22 20:06:22 2007 UTC
# Line 6  Term::Shelly - Yet Another Shell Kit for Line 6  Term::Shelly - Yet Another Shell Kit for
6    
7  =head1 VERSION  =head1 VERSION
8    
9  $Id: Shelly.pm,v 1.5 2004/06/04 04:21:23 psionic Exp $  $Id$
10    
11  =head1 GOAL  =head1 GOAL
12    
# Line 14  I needed a shell kit for an aim client I Line 14  I needed a shell kit for an aim client I
14    
15  =head1 NEEDS  =head1 NEEDS
16    
17  - Settable key bindings   - Settable key bindings
18  - Tab completion   - history
19  - Support for window size changes (sigwinch)   - vi mode (Yeah, I lub vi)
20  - movement in-line editing.  
21  - vi mode (Yeah, I lub vi)  =head1 DONE
22  - history  
23  - Completion function calls   - Callback for 'anykey'
24     - Tab completion
25  - Settable callbacks for when we have an end-of-line (EOL binding?)   - Support for window size changes (sigwinch)
26     - movement/in-line editing.
27     - Completion function calls
28     - Settable callbacks for when we have an end-of-line (EOL binding?)
29    
30  =cut  =cut
31    
# Line 32  use strict; Line 35  use strict;
35  use warnings;  use warnings;
36    
37  use vars qw($VERSION);  use vars qw($VERSION);
38  $VERSION = '0.01';  $VERSION = '0.2';
39    
40  # Default perl modules...  # Default perl modules...
41    use IO::Select;
42  use IO::Handle; # I need flush()... or do i?;  use IO::Handle; # I need flush()... or do i?;
43    
44  # Get these from CPAN  # Get these from CPAN
# Line 43  use Term::ReadKey; Line 47  use Term::ReadKey;
47  # Useful constants we need...  # Useful constants we need...
48    
49  # for find_word_bound()  # for find_word_bound()
50  use constant WORD_BEGINNING => 0;     # I want the beginning of this word.  use constant WORD_BEGINNING => 1;     # look for the beginning of this word.
51  use constant WORD_END => 1;           # I want the end of the word.  use constant WORD_END => 2;           # look for end of the word.
52  use constant WORD_ONLY => 2;          # Trailing spaces are important.  use constant WORD_NEXT => 4;          # look for beginning of next word
53  use constant WORD_REGEX => 4;         # I want to specify my own regexp  use constant WORD_ONLY => 8;          # Trailing spaces are important.
54    use constant WORD_REGEX => 16;         # I want to specify my own regexp
55    
56    # for vi_jumpchar()
57    use constant JUMP_BACKCHARTO => 000;  # 'T' in vi (backwards)
58    use constant JUMP_BACKCHAR   => 001;  # 'F' in vi (backwards)
59    use constant JUMP_CHARTO     => 010;  # 't' in vi (forwards)
60    use constant JUMP_CHAR       => 011;  # 'f' in vi (forwards)
61    
62  # Some key constant name mappings.  # Some key constant name mappings.
63    # I definately need a function to do this and some sort of hash returned which
64    # specifies the key pressed and any modifiers too.
65    # Like... ctrl+f5 is \e[15;5~ ... and not on all systems.
66  my %KEY_CONSTANTS = (  my %KEY_CONSTANTS = (
67                                                          "\e[A"      => "UP",                                                          "\e[A"      => "UP",
68                                                          "\e[B"      => "DOWN",                                                          "\e[B"      => "DOWN",
# Line 75  sub new ($) { Line 89  sub new ($) {
89          my $self = {          my $self = {
90                  "input_line" => "",                  "input_line" => "",
91                  "input_position" => 0,                  "input_position" => 0,
92                    "input_prompt" => "",
93                  "leftcol" => 0,                  "leftcol" => 0,
94                    "echo" => 1,
95                    "vi_mode" => 0,
96                    "mode" => "insert",
97          };          };
98    
99          bless $self, $class;          bless $self, $class;
100    
101          ($self->{"termcols"}) = GetTerminalSize();          ($self->{"termcols"}) = GetTerminalSize();
102          $SIG{WINCH} = sub { ($self->{"termcols"}) = GetTerminalSize(); $self->fix_inputline() };          $SIG{WINCH} = sub { ($self->{"termcols"}) = GetTerminalSize(); $self->fix_inputline() };
103            $SIG{CONT} = sub { ReadMode 3; $self->fix_inputline; };
104    
105            $self->{"select"} = new IO::Select(\*STDIN);
106    
107          my $bindings = {          my $bindings = {
108                    "ANYKEY"      => "anykey",
109                  "LEFT"        => "backward-char",                  "LEFT"        => "backward-char",
110                  "RIGHT"       => "forward-char",                  "RIGHT"       => "forward-char",
111                  "UP"          => "up-history",                  "UP"          => "up-history",
# Line 107  sub new ($) { Line 130  sub new ($) {
130                  "TAB"         => "complete-word",                  "TAB"         => "complete-word",
131    
132                  #"^T"          => "expand-line",                  #"^T"          => "expand-line",
133    
134                    #--------------------------------
135                    # vi bindings
136                    #
137    
138                    # -------- DIRECTIONS
139    
140                    "vi_h"           => "vi-backward-char",                  # DONE
141                    "vi_l"           => "vi-forward-char",                   # DONE
142                    "vi_k"           => "vi-up-history",
143                    "vi_j"           => "vi-down-history",
144    
145                    "vi_w"           => "vi-forward-word",                   # DONE
146                    "vi_W"           => "vi-forward-whole-word",             # DONE
147                    "vi_e"           => "vi-end-word",                       # DONE
148                    "vi_E"           => "vi-end-whole-word",                 # DONE
149                    "vi_t"           => "vi-forward-charto",
150                    "vi_T"           => "vi-backward-charto",
151                    "vi_f"           => "vi-forward-charat",
152                    "vi_F"           => "vi-backward-charat",
153                    "vi_G"           => "vi-history-goto",
154                    "vi_b"           => "vi-beginning-word",
155                    "vi_B"           => "vi-beginning-whole-word",,
156                    "vi_n"           => "vi-search-next",
157                    "vi_N"           => "vi-search-prev",
158                    "vi_'"           => "vi-mark-goto",
159                    'vi_$'           => "vi-end-of-line",
160                    "vi_^"           => "vi-beginning-of-line",
161    
162                    # -------- INSERTION
163      
164                    "vi_i"           => "vi-insert",
165                    "vi_I"           => "vi-insert-at-bol",
166                    "vi_a"           => "vi-add",
167                    "vi_A"           => "vi-add-at-eol",
168                    "vi_r"           => "vi-replace-char",
169                    "vi_R"           => "vi-replace-mode",
170                    "vi_s"           => "vi-substitute-char",
171                    "vi_S"           => "vi-substitute-line",
172                    #"vi_o"
173                    #"vi_O"
174                    "vi_c"           => "vi-change",
175                    "vi_C"           => "vi-change-to-eol",
176    
177                    #"vi_y"           => "vi-yank-direction",
178                    #"vi_Y"           => "vi-yank-to-eol",
179                    #"vi_u"           => "vi-undo",
180                    #"vi_p"           => "vi-paste-at",
181                    #"vi_P"           => "vi-paste-before",
182                    "vi_x"           => "vi-delete-char-backward",
183                    "vi_X"           => "vi-delete-char-forward",
184                    "vi_d"           => "vi-delete",
185    
186                    # -------- OTHER COMMANDS
187    
188                    "vi_m"           => "vi-mark",
189    
190          };          };
191    
192          my $mappings = {          my $mappings = {
193                  "backward-char"          => \&backward_char,                  "anykey"                 => [ \&anykey ],
194                  "forward-char"           => \&forward_char,                  "backward-char"          => [ \&backward_char ],
195                  "delete-char-backward"   => \&delete_char_backward,                  "forward-char"           => [ \&forward_char ],
196                  "kill-line"              => \&kill_line,                  "delete-char-backward"   => [ \&delete_char_backward ],
197                  "newline"                => \&newline,                  "kill-line"              => [ \&kill_line ],
198                  "redraw"                 => \&fix_inputline,                  "newline"                => [ \&newline ],
199                  "beginning-of-line"      => \&beginning_of_line,                  "redraw"                 => [ \&fix_inputline ],
200                  "end-of-line"            => \&end_of_line,                  "beginning-of-line"      => [ \&beginning_of_line ],
201                  "delete-word-backward"   => \&delete_word_backward,                  "end-of-line"            => [ \&end_of_line ],
202                    "delete-word-backward"   => [ \&delete_word_backward ],
203    
204                    "complete-word"          => [ \&complete_word ],
205                    #"expand-line"            => [ \&expand_line ],
206    
207                    # ----------------------------------------------------------- vi mappings
208                    "vi-backward-char"       => [ \&vi_backward_char ],
209                    "vi-forward-char"        => [ \&vi_forward_char ],
210                    "vi-forward-word"        => [ \&vi_forward_word ],
211                    "vi-forward-whole-word"  => [ \&vi_forward_whole_word ],
212                    "vi-beginning-word"      => [ \&vi_beginning_word ],
213                    "vi-beginning-whole-word" => [ \&vi_beginning_whole_word ],
214                    "vi-end-of-line"         => [ \&vi_eol ],
215                    "vi-beginning-of-line"   => [ \&vi_bol ],
216                    "vi-forward-charto"      => [ \&vi_forward_charto ],
217                    "vi-forward-charat"        => [ \&vi_forward_charat ],
218                    "vi-backward-charto"     => [ \&vi_backward_charto ],
219                    "vi-backward-charat"       => [ \&vi_backward_charat ],
220    
221                    "vi-end-word"            => [ \&vi_end_word ],
222                    "vi-end-whole-word"      => [ \&vi_end_whole_word ],
223                    "vi-insert"              => [ \&vi_insert ],
224                    "vi-insert-at-bol"       => [ \&vi_insert_at_bol ],,
225                    "vi-add"                 => [ \&vi_add ],
226                    "vi-add-at-eol"          => [ \&vi_add_at_eol ],
227    
228                    "vi-delete-char-backward" => [ \&vi_delete_char_backward ],
229                    "vi-delete-char-forward"  => [ \&vi_delete_char_forward ],
230                    "vi-delete"               => [ \&vi_delete ],
231    
                 "complete-word"          => \&complete_word,  
                 #"expand-line"            => \&expand_line,  
232          };          };
233    
234          $self->{"bindings"} = $bindings;          $self->{"bindings"} = $bindings;
# Line 129  sub new ($) { Line 236  sub new ($) {
236          return $self;          return $self;
237  }  }
238    
239    sub DESTROY {
240            my $self = shift;
241            $self->real_out("\n");
242            ReadMode 0;
243    }
244    
245  =pod  =pod
246    
247  =item $sh->do_one_loop()  =item $sh->do_one_loop()
# Line 142  It will handle event processing, etc. Line 255  It will handle event processing, etc.
255  # Nonblocking readline  # Nonblocking readline
256  sub do_one_loop ($) {  sub do_one_loop ($) {
257          my $self = shift;          my $self = shift;
258            my $text;
259          my $char;          my $char;
260    
261          # ReadKey(.1) means no timeout waiting for data, thus is nonblocking          # Select for .01
262          while (defined($char = ReadKey(.1))) {          #
263                  $self->handle_key($char);          if ($self->{"select"}->can_read(.01)) {
264                    my $bytes = sysread(STDIN, $text, 4096);
265                    for (my $i = 0; $i < length($text); $i++) {
266                            $char = substr($text,$i,1);
267                            $self->handle_key($char);
268                    }
269          }          }
270                    
271  }  }
# Line 167  sub handle_key($$) { Line 286  sub handle_key($$) {
286          my $line = $self->{"input_line"} || "";          my $line = $self->{"input_line"} || "";
287          my $pos = $self->{"input_position"} || 0;          my $pos = $self->{"input_position"} || 0;
288    
289            if (defined($self->{"input_slurper"})) {
290                    &{$self->{"input_slurper"}}($self, $char);
291                    return;
292            }
293    
294          if ($self->{"escape"}) {          if ($self->{"escape"}) {
295                  $self->{"escape_string"} .= $char;                  $self->{"escape_string"} .= $char;
296                  if ($self->{"escape_expect_ansi"}) {                  if ($self->{"escape_expect_ansi"}) {
297                          $self->{"escape_expect_ansi"} = 0 if ($char =~ m/[a-zA-Z]/);                          $self->{"escape_expect_ansi"} = 0 if ($char =~ m/[a-zA-Z~]/);
298                  }                  }
299    
300                  $self->{"escape_expect_ansi"} = 1 if ($char eq '[');                  $self->{"escape_expect_ansi"} = 1 if ($char eq '[');
# Line 180  sub handle_key($$) { Line 304  sub handle_key($$) {
304                          my $estring = $self->{"escape_string"};                          my $estring = $self->{"escape_string"};
305    
306                          $self->{"escape_string"} = undef;                          $self->{"escape_string"} = undef;
307                          return $self->execute_binding("\e".$estring);                          $self->execute_binding("\e".$estring);
308                    } else {
309                            return;
310                  }                  }
311            } elsif ($char eq "\e") {      # Trap escapes, they're speshul.
312                  return 0;                  if ($self->{"vi_mode"}) {
313          }                          if ($self->{"mode"} eq 'insert') {
314                                    $self->{"input_position"}-- if ($self->{"input_position"} > 1);
315          if ($char eq "\e") {      # Trap escapes, they're speshul.                                  $self->{"mode"} = "command";
316                  $self->{"escape"} = 1;                          }
317                  $self->{"escape_string"} = undef;                  } else {
318                                            $self->{"escape"} = 1;
319                  # What now?                          $self->{"escape_string"} = undef;
320                  return 0;                          return;
321          }                  }
322            } elsif ((ord($char) < 32) || (ord($char) > 126)) {   # Control character
         if ((ord($char) < 32) || (ord($char) > 126)) {   # Control character  
323                  $self->execute_binding($char);                  $self->execute_binding($char);
324                  return 0;          } elsif ((defined($char)) && (ord($char) >= 32)) {
325          }                  if (defined($self->{"mode"}) && $self->{"mode"} eq "command") {
326                            if ($char =~ m/[0-9]/) {
327          if ((defined($char)) && (ord($char) >= 32)) {                                  $self->{"vi_count"} .= $char;
328                  substr($line, $pos, 0) = $char;                          } else {
329                  $self->{"input_position"}++;                                  my $cmdwait = defined($self->{"vi_command_waiting"});
330    
331                                    $self->{"vi_count"} ||= 1;
332                                    while ($self->{"vi_count"} > 0) {
333                                            $self->execute_binding("vi_$char");
334                                            $self->{"vi_count"}--;
335                                    }
336                                    if ($cmdwait) {
337                                            &{$self->{"vi_command_waiting"}}($self, 1);
338                                            $self->{"input_position"} = $self->{"vi_input_position"};
339                                            delete $self->{"vi_command_waiting"};
340                                    }
341                            }
342                    } else {
343                            if (defined($self->{"bindings"}->{"$char"})) {
344                                    $self->execute_binding($char);
345                            } else  {
346                                    # Insert the character in our string, wherever we are.
347                                    #substr($line, $pos, 0) = $char;
348                                    #$self->{"input_position"}++;
349                                    $self->insert_at_cursor($char);
350                            }
351                    }
352    
353                  # If we just did a tab completion, kill the state.                  # If we just did a tab completion, kill the state.
354                  delete($self->{"completion"}) if (defined($self->{"completion"}));                  delete($self->{"completion"}) if (defined($self->{"completion"}));
355                    $self->fix_inputline();
356          }          }
357    
358          $self->{"input_line"} = $line;          # This is sometimes a nice feature to have...
359          $self->fix_inputline();          # Press the any key!!!
360            $self->{"lastchar"} = $char;
361            $self->execute_binding("ANYKEY");
362    
363            #$self->fix_inputline();
364  }  }
365    
366  =pod  =pod
# Line 228  sub execute_binding ($$) { Line 380  sub execute_binding ($$) {
380          my $str = shift;          my $str = shift;
381          my $key = $self->prettify_key($str);          my $key = $self->prettify_key($str);
382    
383            #$self->out("Key: $key");
384    
385          my $bindings = $self->{"bindings"};          my $bindings = $self->{"bindings"};
386          my $mappings = $self->{"mappings"};          my $mappings = $self->{"mappings"};
387    
# Line 235  sub execute_binding ($$) { Line 389  sub execute_binding ($$) {
389    
390                  # Check if we have stored completion state and the next binding is                  # Check if we have stored completion state and the next binding is
391                  # not complete-word. If it isn't, then kill the completion state.                  # not complete-word. If it isn't, then kill the completion state.
392                  if (defined($self->{"completion"}) &&                  if (defined($self->{"completion"}) && $key ne 'ANYKEY' &&
393                           $bindings->{$key} ne 'complete-word') {                           $bindings->{$key} ne 'complete-word') {
394                          delete($self->{"completion"});                          delete($self->{"completion"});
395                  }                  }
396    
397                  if (ref($mappings->{$bindings->{$key}}) eq 'CODE') {                  if (ref($mappings->{$bindings->{$key}}) =~ m/(CODE|ARRAY)/) {
398    
399                          # This is a hack, passing $self instead of doing:                          # This is a hack, passing $self instead of doing:
400                          # $self->function, becuase I don't want to do an eval.                          # $self->function, becuase I don't want to do an eval.
401    
402                          return &{$mappings->{$bindings->{$key}}}($self);                          if ($1 eq 'ARRAY') {
403                                    map { &{$_}($self) } @{$mappings->{$bindings->{$key}}};
404                            } else {
405                                    &{$mappings->{$bindings->{$key}}}($self);
406                            }
407    
408                  } else {                  } else {
409                          error("Unimplemented function, " . $bindings->{$key});                          $self->error("Unimplemented function, " . $bindings->{$key});
410                  }                  }
411          }          }
   
         return 0;  
412  }  }
413    
414  =pod  =pod
# Line 290  sub prettify_key ($$) { Line 446  sub prettify_key ($$) {
446                  }                  }
447          }          }
448    
449          # Ok, so it's not ^X or ESC-X, it's gotta be some ansi funk.          # Ok, so it's not ^X or ESC-X, it's gotta be some ansi funk or a normal char.
450          return $KEY_CONSTANTS{$key};          return $KEY_CONSTANTS{$key} || $key;
451  }  }
452    
453  =pod  =pod
# Line 317  sub out ($;$) { Line 473  sub out ($;$) {
473    
474  sub error ($$) {  sub error ($$) {
475          my $self = shift;          my $self = shift;
476            $self->real_out("\r\e[2K");
477          print STDERR "*> ", @_, "\n";          print STDERR "*> ", @_, "\n";
478          $self->fix_inputline();          $self->fix_inputline();
479  }  }
# Line 329  This super-happy function redraws the in Line 486  This super-happy function redraws the in
486    
487  =cut  =cut
488    
489  sub fix_inputline {  sub fix_inputline ($) {
490          my $self = shift;          my $self = shift;
491    
492          print "\r\e[2K";          print "\r\e[2K";
493    
494          # If we're past the end of the terminal line, shuffle back!          if ($self->{"echo"} == 0) {
495                    #print "Echo is off...\n";
496                    print $self->{"input_prompt"};
497                    return;
498            }
499    
500            # If we're before the beginning of the terminal line, shuffle over!
501          if ($self->{"input_position"} - $self->{"leftcol"} <= 0) {          if ($self->{"input_position"} - $self->{"leftcol"} <= 0) {
502                  $self->{"leftcol"} -= 30;                  $self->{"leftcol"} -= 30;
503                  $self->{"leftcol"} = 0 if ($self->{"leftcol"} < 0);                  $self->{"leftcol"} = 0 if ($self->{"leftcol"} < 0);
504          }          }
505    
506          # If we're before the beginning of the terminal line, shuffle over!          # If we're past the end of the terminal line, shuffle back!
507          if ($self->{"input_position"} - $self->{"leftcol"} > $self->{"termcols"}) {          # length = input_position - leftcol + input_prompt - leftcol
508            my $pl = length($self->{"input_prompt"}) - $self->{"leftcol"};
509            $pl = 0 if ($pl < 0);
510            if ($self->{"input_position"} - $self->{"leftcol"} + $pl > $self->{"termcols"}) {
511                  $self->{"leftcol"} += 30;                  $self->{"leftcol"} += 30;
512          }          }
513    
514          # Can se show the whole line? If so, do it!          # Can se show the whole line? If so, do it!
515          if (length($self->{"input_line"}) < $self->{"termcols"}) {          if (length($self->{"input_line"}) + length($self->{"input_prompt"}) < $self->{"termcols"}) {
516                  $self->{"leftcol"} = 0;                  $self->{"leftcol"} = 0;
517          }          }
518    
519          # only print as much as we can in this one line.          # only print as much as we can in this one line.
520          print substr($self->{"input_line"}, $self->{"leftcol"}, $self->{"termcols"});          my $prompt = $self->{"input_prompt"};
521            my $offset = 0;
522            if ($self->{"leftcol"} <= length($self->{"input_prompt"})) {
523                    print substr($prompt,$self->{"leftcol"});
524                    $offset = length(substr($prompt,$self->{"leftcol"}));
525            }
526    
527            print substr($self->{"input_line"}, $self->{"leftcol"}, $self->{"termcols"} - $offset);
528          print "\r";          print "\r";
529          print "\e[" . ($self->{"input_position"} - $self->{"leftcol"}) .          print "\e[" . ($self->{"input_position"} - $self->{"leftcol"} + $offset) .
530                "C" if ($self->{"input_position"} > 0);                "C" if (($self->{"input_position"} + $offset) > 0);
531          STDOUT->flush();          STDOUT->flush();
532  }  }
533    
# Line 362  sub newline { Line 535  sub newline {
535          my $self = shift;          my $self = shift;
536          # Process the input line.          # Process the input line.
537    
538          $self->real_out("\n");          if ($self->{"supress_newline_echo"}) {
539          print "You wrote: " . $self->{"input_line"} . "\n";                  # Clear the line
540                    $self->real_out("\e[2K");
541            } else {
542                    $self->real_out("\n");
543            }
544    
545            my $line = $self->{"input_line"};
546    
547          $self->{"input_line"} = "";          $self->{"input_line"} = "";
548          $self->{"input_position"} = 0;          $self->{"input_position"} = 0;
549            $self->{"leftcol"} = 0;
550    
551            $self->callback("readline", $line);
552            #if (ref($self->{"readline_callback"}) eq 'CODE') {
553                    #&{$self->{"readline_callback"}}($line);
554            #}
555    
556            $self->fix_inputline();
557  }  }
558    
559  sub kill_line {  sub kill_line {
560          my $self = shift;          my $self = shift;
561    
562            # Ask for more data perhaps...
563            $self->callback("fardelete");# if (length($self->{"input_line"}) == 0);
564    
565          $self->{"input_line"} = "";          $self->{"input_line"} = "";
566          $self->{"input_position"} = 0;          $self->{"input_position"} = 0;
567          $self->{"leftcol"} = 0;          $self->{"leftcol"} = 0;
# Line 400  sub backward_char { Line 591  sub backward_char {
591    
592  sub delete_char_backward {  sub delete_char_backward {
593          my $self = shift;          my $self = shift;
594          #"delete-char-backward"   => \&delete_char_backward,  
595            $self->callback("fardelete") if (length($self->{"input_line"}) == 0);
596    
597          if ($self->{"input_position"} > 0) {          if ($self->{"input_position"} > 0) {
598                  substr($self->{"input_line"}, $self->{"input_position"} - 1, 1) = '';                  substr($self->{"input_line"}, $self->{"input_position"} - 1, 1) = '';
599                  $self->{"input_position"}--;                  $self->{"input_position"}--;
   
600                  $self->fix_inputline();                  $self->fix_inputline();
601          }          }
602  }  }
# Line 426  sub delete_word_backward { Line 618  sub delete_word_backward {
618          my $self = shift;          my $self = shift;
619          my $pos = $self->{"input_position"};          my $pos = $self->{"input_position"};
620          my $line = $self->{"input_line"};          my $line = $self->{"input_line"};
621          my $regex = "[A-Za-z0-9]";          #my $regex = '[A-Za-z0-9]';
622            my $regex = '\S';
623          my $bword;          my $bword;
624    
625          $bword = $self->find_word_bound($line, $pos, WORD_BEGINNING);          $self->callback("fardelete") if (length($self->{"input_line"}) == 0);
626            $bword = $self->find_word_bound($line, $pos, WORD_BEGINNING | WORD_REGEX, $regex);
627    
628            #$self->error("Testing $bword $pos");
629          # Delete whatever word we just found.          # Delete whatever word we just found.
630          substr($line, $bword, $pos - $bword) = '';          substr($line, $bword, $pos - $bword) = '';
631    
# Line 441  sub delete_word_backward { Line 636  sub delete_word_backward {
636          $self->fix_inputline();          $self->fix_inputline();
637  }  }
638    
639    sub vi_backward_char {
640            my $self = shift;
641    
642            $self->backward_char();
643            $self->{"vi_done"} = 1;
644    }
645    
646    sub vi_forward_char {
647            my $self = shift;
648    
649            $self->forward_char();
650            $self->{"vi_done"} = 1;
651    }
652    
653    sub vi_forward_word {
654            my $self = shift;
655            my $pos = $self->{"input_position"};
656            my $line = $self->{"input_line"};
657            my $bword = $pos;
658            my $BITS = WORD_NEXT;
659            my $regex = shift;
660    
661            $BITS |= WORD_REGEX if (defined($regex));
662            $bword = $self->find_word_bound($line, $pos, $BITS, $regex);
663    
664            $self->{"input_position"} = $bword;
665    
666            $self->{"vi_done"};
667    }
668    
669    sub vi_forward_whole_word {
670            my $self = shift;
671            $self->vi_forward_word('\S');
672            $self->{"vi_done"} = 1;
673    }
674    
675    sub vi_beginning_word {
676            my $self = shift;
677            my $pos = $self->{"input_position"};
678            my $line = $self->{"input_line"};
679            my $bword = $pos;
680            my $BITS = WORD_BEGINNING;
681            my $regex = shift;
682    
683            $BITS |= WORD_REGEX if (defined($regex));
684            $bword = $self->find_word_bound($line, $pos, $BITS, $regex);
685    
686            $self->{"input_position"} = $bword;
687    
688            $self->{"vi_done"};
689    }
690    
691    sub vi_beginning_whole_word {
692            my $self = shift;
693            $self->vi_beginning_word('\S');
694            $self->{"vi_done"} = 1;
695    }
696    
697    sub vi_end_word {
698            my $self = shift;
699            my $pos = $self->{"input_position"};
700            my $line = $self->{"input_line"};
701            my $bword = $pos;
702            my $BITS = WORD_END;
703            my $regex = shift;
704    
705            $BITS |= WORD_REGEX if (defined($regex));
706            $bword = $self->find_word_bound($line, $pos, $BITS, $regex);
707    
708            $self->{"input_position"} = $bword;
709    
710            $self->{"vi_done"};
711    }
712    
713    sub vi_end_whole_word {
714            my $self = shift;
715            $self->vi_end_word('\S');
716            $self->{"vi_done"} = 1;
717    }
718    
719    sub vi_forward_charto {
720            my $self = shift;
721    
722            # We need to wait for another character input...
723            $self->{"jumpchardir"} = JUMP_CHARTO;
724            $self->{"input_slurper"} = \&vi_jumpchar;
725    }
726    
727    sub vi_forward_charat {
728            my $self = shift;
729    
730            # We need to wait for another character input...
731            $self->{"jumpchardir"} = JUMP_CHAR;
732            $self->{"input_slurper"} = \&vi_jumpchar;
733    }
734    
735    sub vi_backward_charto {
736            my $self = shift;
737    
738            $self->{"jumpchardir"} = JUMP_BACKCHARTO;
739            $self->{"input_slurper"} = \&vi_jumpchar;
740    }
741    
742    sub vi_backward_charat {
743            my $self = shift;
744    
745            $self->{"jumpchardir"} = JUMP_BACKCHAR;
746            $self->{"input_slurper"} = \&vi_jumpchar;
747    }
748    
749    sub vi_jumpchar {
750            my $self = shift;
751            my $char = shift;
752            my $pos = $self->{"input_position"};
753            my $line = $self->{"input_line"};
754            my $newpos;
755            my $mod = 0;
756    
757            delete $self->{"input_slurper"};
758    
759            $mod = ($self->{"jumpchardir"} & JUMP_CHARTO ? 1 : -1);
760    
761            if ($mod == 1) {
762                    #$self->out("F: $line / $pos / " . $line =~ m/^(.{$pos}[^$char]*)$char/);
763                    #$self->out("   " . " " x ($pos) . "^                   / $1");
764                    $pos = length($1) if (defined($1));
765            } else {
766                    #$self->out("B: $line / $pos / " . $line =~ m/$char([^$char]*.{$pos})$/);
767                    #$self->out("   " . " " x ($pos - 1) . "^              / $1");
768                    $pos = length($line) - length($1) if (defined($1));
769            }
770            $self->{"input_position"} = $pos;
771    
772            $self->fix_inputline();
773    }
774    
775    sub vi_bol {
776            my $self = shift;
777            $self->{"input_position"} = 0;
778            $self->{"vi_done"} = 1;
779    }
780    
781    sub vi_eol {
782            my $self = shift;
783            $self->{"input_position"} = length($self->{"input_line"});
784            $self->{"vi_done"} = 1;
785    }
786    sub vi_insert {
787            my $self = shift;
788    
789            $self->{"mode"} = "insert";
790            $self->{"vi_done"} = 1;
791    }
792    
793    sub vi_insert_at_bol {
794            my $self = shift;
795    
796            $self->vi_bol();
797            $self->vi_insert();
798            $self->{"vi_done"} = 1;
799    }
800    
801    sub vi_add {
802            my $self = shift;
803    
804            $self->{"input_position"}++ if ($self->{"input_position"} < length($self->{"input_line"}));
805    
806            $self->vi_insert();
807            $self->{"vi_done"} = 1;
808    }
809    
810    sub vi_add_at_eol {
811            my $self = shift;
812    
813            $self->vi_eol();
814            $self->vi_add();
815            $self->{"vi_done"} = 1;
816    }
817    
818    sub vi_delete_char_forward {
819            my $self = shift;
820            unless ($self->{"input_position"} == 0) {
821                    substr($self->{"input_line"}, $self->{"input_position"} - 1, 1) = '';
822                    $self->{"input_position"}--;
823            }
824    }
825    
826    sub vi_delete_char_backward {
827            my $self = shift;
828    
829            $self->callback("fardelete") if (length($self->{"input_line"}) == 0);
830    
831            substr($self->{"input_line"}, $self->{"input_position"}, 1) = '';
832            $self->{"input_position"}-- if ($self->{"input_position"} == length($self->{"input_line"}) && $self->{"input_position"} > 0);
833    }
834    
835    sub vi_delete {
836            my $self = shift;
837            my $exec = shift || 0;
838    
839            if ($exec == 1) {
840                    my ($start, $end);
841    
842                    $self->callback("fardelete") if (length($self->{"input_line"}) == 0);
843    
844                    if ($self->{"input_position"} < $self->{"vi_input_position"}) {
845                            $start = $self->{"input_position"};
846                            $end = $self->{"vi_input_position"};
847                    } else {
848                            $start = $self->{"vi_input_position"};
849                            $end = $self->{"input_position"};
850                    }
851                    substr($self->{"input_line"}, $start, ($end - $start)) = '';
852            } else {
853                    # Mark such that we remember what command we're doing at the time
854                    # and set ourselves as the call back for the end of the next valid
855                    # command. soo.... something like:
856                    $self->{"vi_command_waiting"} = \&vi_delete;
857                    $self->{"vi_input_position"} = $self->{"input_position"};
858            }
859            
860    }
861    
862  =pod  =pod
863    
864  =item $sh->complete_word  =item $sh->complete_word
# Line 470  RECHECK: Line 888  RECHECK:
888                          $bword = $self->find_word_bound($line, $pos, WORD_BEGINNING | WORD_REGEX, '\S');                          $bword = $self->find_word_bound($line, $pos, WORD_BEGINNING | WORD_REGEX, '\S');
889                          $complete = substr($line,$bword,$pos - $bword);                          $complete = substr($line,$bword,$pos - $bword);
890                          #$self->out("Complete: $complete");                          #$self->out("Complete: $complete");
891                            #$self->out(length($line) . " / $bword / $pos");
892    
893                            # Make sure we can actually do this ?
894    
895                          #$self->out("First time completing $complete");                          #$self->out("First time completing $complete");
896                          $self->{"completion"} = {                          $self->{"completion"} = {
# Line 482  RECHECK: Line 903  RECHECK:
903                          };                          };
904                  } else {                  } else {
905                          $bword = $self->{"completion"}->{"bword"};                          $bword = $self->{"completion"}->{"bword"};
906                            #$self->out(length($line) . " / $bword / $pos");
907                          $complete = substr($line,$bword,$pos - $bword);                          $complete = substr($line,$bword,$pos - $bword);
908                  }                  }
909    
# Line 498  RECHECK: Line 920  RECHECK:
920    
921                  return unless (defined($match));                  return unless (defined($match));
922    
                 #$self->out("Match: $match / " . $self->{"completion"}->{"index"} . " / " . @matches);  
   
923                  $self->{"completion"}->{"index"}++;                  $self->{"completion"}->{"index"}++;
924                  $self->{"completion"}->{"index"} = 0 if ($self->{"completion"}->{"index"} == scalar(@matches));                  $self->{"completion"}->{"index"} = 0 if ($self->{"completion"}->{"index"} == scalar(@matches));
925    
926                  substr($line, $bword, $pos - $bword) = $match;                  #$self->out(length($line) . " / $bword / $pos");
927                    substr($line, $bword, $pos - $bword) = $match . " ";
928    
929                  $self->{"completion"}->{"endpos"} = $pos;                  $self->{"completion"}->{"endpos"} = $pos;
930    
931                  $pos = $bword + length($match);                  $pos = $bword + length($match) + 1;
932                  $self->{"input_position"} = $pos;                  $self->{"input_position"} = $pos;
933                  $self->{"input_line"} = $line;                  $self->{"input_line"} = $line;
934    
935                  $self->fix_inputline();                  $self->fix_inputline();
936            }
937    }
938    
939    sub anykey {
940            my $self = shift;
941    
942            $self->callback("anykey");
943            #if (ref($self->{"anykey_callback"}) eq 'CODE') {
944                    #&{$self->{"anykey_callback"}};
945            #}
946    }
947    
948    
949    
950    #------------------------------------------------------------------------------
951    # Useful functions to set prompt and other things.
952    
953    =pod
954    
955    =item $sh->prompt([$prompt])
956    
957    Get or set the prompt
958    
959    =cut
960    
961    sub prompt ($;$) {
962            my $self = shift;
963    
964            if (@_) {
965                    $self->{"input_prompt"} = shift;
966                    $self->fix_inputline();
967          }          }
968            return $self->{"input_prompt"};
969  }  }
970    
971    sub echo ($;$) {
972            my $self = shift;
973    
974            if (@_) {
975                    $self->{"echo"} = shift;
976            }
977            return $self->{"echo"};
978    }
979    
980  # --------------------------------------------------------------------  # --------------------------------------------------------------------
981  # Helper functions  # Helper functions
982    #
983    
984  # Go from a position and find the beginning of the word we're on.  sub callback($$;$) {
 sub find_word_bound ($$$;$) {  
985          my $self = shift;          my $self = shift;
986          my $line = shift;          my $callback = shift() . "_callback";
987          my $pos = shift;          if (ref($self->{$callback}) eq 'CODE') {
988          my $opts = shift || 0;                  $self->{$callback}->(@_);
989          my $regex = "[A-Za-z0-9]";          }
990          my $bword;  }
991    
992          $regex = shift if ($opts & WORD_REGEX);  # Go from a position and find the beginning of the word we're on.
993    sub find_word_bound ($$$$;$) {
994            my ($self, $line, $pos, $opts, $rx) = @_;
995            my $nrx;
996            $rx = '\\w' if (!($opts & WORD_REGEX));
997    
998          # Mod? This is either -1 or +1 depending on if we're looking behind or          # Mod? This is either -1 or +1 depending on if we're looking behind or
999          # if we're looking ahead.          # if we're looking ahead.
1000          my $mod = -1;          my $mod = ($opts & WORD_BEGINNING) ? -1 : 1;
1001          $mod = 1 if ($opts & WORD_END);          $nrx = qr/[^$rx]/;
1002            $rx = qr/[$rx]/;
1003    
1004            if ($opts & WORD_NEXT) {
1005                    #$regex = qr/^.{$pos}(.+?)(?<!$regex)$regex/;
1006                    $rx = qr/^.{$pos}(.+?)(?<!$rx)$rx/;
1007            } elsif ($opts & WORD_BEGINNING) {
1008                    #$regex = qr/($regex+[^$regex]*)(?<=^.{$pos})/;
1009                    $rx = qr/($rx+$nrx*)(?<=^.{$pos})/;
1010            } elsif ($opts & WORD_END) {
1011                    #$regex = qr/^.{$pos}(.+?)$regex(?:[^$regex]|$)/;
1012                    $rx = qr/^.{$pos}(.+?)$rx(?:$nrx|$)/;
1013            }
1014    
1015          # What are we doing?          #$self->out("$rx");
         # If we're in a word, go to the beginning of the word  
         # If we're on a space, go to end of previous word.  
         # If we're on a nonspace/nonword, go to beginning of nonword chars  
           
         $bword = $pos - 1;  
1016    
1017          # If we're at the end of the string, ignore all trailing whitespace.          if ($line =~ $rx) {
1018          # unless WORD_ONLY is set.                  $pos += length($1) * $mod;
1019          #out("          } else {
1020          if (($bword + 1 == $pos) && (! $opts & WORD_ONLY)) {                  $pos = ($mod == 1 ? length($line) : 0);
                 $bword += $mod while (substr($line,$bword,1) =~ m/^\s$/);  
1021          }          }
1022    
1023          # If we're not on an ALPHANUM, then we want to reverse the match.          return $pos;
1024          # that is, if we are:  }
         # "testing here hello .......there"  
         #                           ^-- here  
         # Then we want to delete (match) all the periods (nonalphanums)  
         substr($regex, 1, 0) = "^" if (substr($line,$bword,1) !~ m/$regex/);  
1025    
1026          # Back up until we hit the end of our "word"  # -----------------------------------------------------------------------------
1027          $bword += $mod while (substr($line,$bword,1) =~ m/$regex/ && $bword >= 0);  # Functions people might call on us...
1028    #
1029    
1030          # Whoops, one too far...  sub insert_at_cursor($$) {
1031          $bword -= $mod;          my $self = shift;
1032            my $string = shift;
1033    
1034          return $bword;          substr($self->{"input_line"}, $self->{"input_position"}, 0) = $string;
1035            $self->{"input_position"} += length($string)
1036  }  }
1037    
1038  =pod  =pod
Legend:
Removed from v.87  
changed lines
  Added in v.88
  ViewVC Help
Powered by ViewVC 1.1.26