--- tarballs/Term-Visual-0.04/Visual.pm Wed Mar 19 13:48:24 2003 +++ Visual.pm Tue Feb 24 14:18:01 2004 @@ -1,30 +1,41 @@ -# $Id: Visual.pm,v 0.04 2003/01/14 23:00:18 lunartear Exp $ +# $Id: Visual.pm,v 0.05 2003/01/14 23:00:18 lunartear Exp $ # Copyrights and documentation are after __END__. package Term::Visual; - use strict; use warnings; -use vars qw($VERSION $console); -$VERSION = (qw($Revision: 0.04 $ ))[1]; +use vars qw($VERSION $REVISION $console); +$VERSION = '0.05'; +$REVISION = do {my@r=(q$Revision: 0.05 $=~/\d+/g);sprintf"%d."."%02d"x$#r,@r}; use Term::Visual::StatusBar; use POE qw(Wheel::Curses Wheel::ReadWrite ); use Curses; use Carp; -sub DEBUG () { 0 } -sub TESTING () { 0 } +BEGIN { + my $debug_default = 0; + + $debug_default++ if defined $ENV{TV_DEBUG}; + defined &DEBUG or eval "sub DEBUG () { $debug_default }"; -if (DEBUG) { open ERRS, ">error_file"; } + if (&DEBUG) { + my $debug_file = $ENV{TV_LOG_FILE} || 'term_visual.log'; + defined &DEBUG_FILE or eval "sub DEBUG_FILE () { '$debug_file' }"; + open ERRS, ">" . &DEBUG_FILE or croak "Can't open Debug file: $!"; + } +} ### Term::Visual Constants. -sub WINDOW () { 0 } # hash of windows and there properties -sub WINDOW_REV () { 1 } # window name => id key value pair for reverse lookups -sub PALETTE () { 2 } # Palette Element -sub PAL_COL_SEQ () { 3 } # Palette Color Sequence -sub CUR_WIN () { 4 } # holds the current window id -sub ERRLEVEL () { 5 } # Visterm's Error Level boolean +sub WINDOW () { 0 } # hash of windows and there properties +sub WINDOW_REV () { 1 } # window name => id key value pair for reverse lookups +sub PALETTE () { 2 } # Palette Element +sub PAL_COL_SEQ () { 3 } # Palette Color Sequence +sub CUR_WIN () { 4 } # holds the current window id +sub ERRLEVEL () { 5 } # Error Level boolean +sub ALIAS () { 6 } # Visterm's Alias +sub BINDINGS () { 7 } # key bindings +sub COMMON_INPUT () { 8 } # Common input boolean ### Palette Constants. @@ -38,14 +49,9 @@ sub TITLE_COL () { 0 } -sub current_window { # should this be seperated into 2 functions +sub current_window { if (DEBUG) { print ERRS " Enter current_window\n"; } my $self = shift; - if (@_) { - my $query = shift; - my $validity = validate_window($self, $query); - if ($validity) { $self->[CUR_WIN] = $query; } - } return $self->[CUR_WIN]; } @@ -76,13 +82,32 @@ my $errlevel = delete $params{Errlevel} || 0; my $current_window = -1; + my $common_input = delete $params{Common_Input}; + # These options only make sense if Common_Input is specified + my $tabcomplete = delete $params{Tab_Complete}; + my $history_size = delete $params{History_Size}; + my $self = bless [ { }, # WINDOW stores window properties under each window id. { }, # WINDOW_REV reverse window lookups. { }, # Palette 0, # Palette Color Sequence $current_window, - $errlevel # Visterms error level. + $errlevel, # Visterms error level. + $alias, + { }, # BINDINGS + $common_input ? { + History_Position => -1, + History_Size => $history_size, + Command_History => [ ], + Data => "", + Data_Save => "", + Cursor => 0, + Cursor_Save => 0, + Tab_Complete => $tabcomplete, + Insert => 1, + Edit_Position => 0, + } : undef, ], $package; POE::Session->create @@ -93,6 +118,7 @@ send_me_input => "register_input", private_input => "got_curses_input", got_stderr => "got_stderr", + shutdown => "shutdown", } ], args => [ $alias ], @@ -108,7 +134,7 @@ if (DEBUG) { print ERRS $stderr_line, "\n"; } &print($self, $window_id, - "\0(stderr_bullet)" . + "\0(stderr_bullet)" . "2>" . "\0(ncolor)" . " " . @@ -122,6 +148,11 @@ $kernel->alias_set( $alias ); $console = POE::Wheel::Curses->new( InputEvent => 'private_input'); + my $old_mouse_events = 0; + mousemask(0, $old_mouse_events); + + #TODO See about adding support for a wheel mouse after defining old mouse + # events above, so that copy/paste will work as expected. ### Set Colors used by Visterm _set_color( $object, stderr_bullet => "bright white on red", @@ -163,21 +194,40 @@ my $use_status = 1 unless defined $params{Use_Status}; my $new_window_id = CREATE_WINDOW_ID($self); my $window_name = $params{Window_Name} || $new_window_id; + + my $input; + if ($self->[COMMON_INPUT]) { + $input = $self->[COMMON_INPUT]; + } + else { + $input = { + History_Position => -1, + History_Size => 50, + Command_History => [ ], + Data => "", + Data_Save => "", + Cursor => 0, + Cursor_Save => 0, + Tab_Complete => undef, + Insert => 1, + Edit_Position => 0, + }; + } + # Allow override of possible global options + if ($params{History_Size}) { + $input->{History_Size} = $params{History_Size}; + } + if ($params{Tab_Complete}) { + $input->{Tab_Complete} = $params{Tab_Complete}; + } + if (defined $new_window_id) { if (DEBUG) { print ERRS "new_window_id is defined: $new_window_id\n"; } if (!$self->[WINDOW]->{$new_window_id}) { $self->[WINDOW]->{$new_window_id} = { Buffer => [ ], Buffer_Size => $params{Buffer_Size} || 500, - Command_History => [ ], - Cursor => 0, - Cursor_Save => 0, - Edit_Position => 0, - History_Position => -1, - History_Size => $params{History_Size} || 50, - Input => "", - Input_Save => "", - Insert => 1, + Input => $input, Use_Title => $use_title, Use_Status => $use_status, Scrolled_Lines => 0, @@ -205,6 +255,8 @@ $COLS, $winref->{Title_Start}, 0 ); + # Should we die here?? + die "No title!!" unless defined $winref->{Window_Title}; my $title = $winref->{Window_Title}; @@ -216,7 +268,10 @@ if ($winref->{Use_Status}) { $winref->{Status_Height} = $params{Status_Height} || 2; $winref->{Status_Start} = $LINES - $winref->{Status_Height} - 1; + + #FIXME I think this got lost when the new design was implemented. $winref->{Def_Status_Field} = [ ]; + $winref->{Screen_End} = $winref->{Status_Start} - 1; $winref->{Window_Status} = newwin( $winref->{Status_Height}, @@ -224,7 +279,7 @@ $winref->{Status_Start}, 0 ); my $status = $winref->{Window_Status}; -if (DEBUG) { print ERRS $status, " <-status in create_window\n"; } + if (DEBUG) { print ERRS $status, " <-status in create_window\n"; } $status->bkgd($self->[PALETTE]->{st_frames}->[PAL_PAIR]); $status->erase(); $status->noutrefresh(); @@ -275,29 +330,14 @@ $winref->{Buffer_Row} = $winref->{Buffer_Last}; - my $scrollback_a = ("# " x 39) . "12"; - my $scrollback_b = (" #" x 39) . "12"; - $winref->{Buffer} = - [($scrollback_a, $scrollback_b) x ($winref->{Buffer_Size} / 2)]; + $winref->{Buffer} = [("") x $winref->{Buffer_Size}]; _refresh_edit($self, $new_window_id); - # Fill the buffer with line numbers to test scrollback. - - if (TESTING) { - my @lines = (1..$winref->{Buffer_Size}); - $lines[0] .= " *** FIRST LINE ***"; - $lines[-1] .= " *** LAST LINE ***"; - &print($self, $new_window_id, @lines); - } - else { - &print($self, $new_window_id, "Geometry = $COLS columns and $LINES lines" ); - } # Flush updates. doupdate(); - return $new_window_id; } @@ -316,15 +356,42 @@ ### delete one or more windows ##TODO add error handling ### $vt->delete_window($window_id); -### TODO update screen to the next or previous window. change in current window too sub delete_window { if (DEBUG) { print ERRS "Enter delete_window\n"; } my $self = shift; + my $win; for (@_) { + $win = $_; my $name = get_window_name($self, $_); delete $self->[WINDOW]->{$_}; delete $self->[WINDOW_REV]->{$name}; } + return unless defined $win; + my $new_win; + my $cur_win = $win; + # Select previous window + while (--$cur_win > 0) { + if (exists $self->[WINDOW]{$cur_win}) { + $new_win = $cur_win; + last; + } + } + # No previous window, select next window + unless (defined $new_win) { + $cur_win = $win; + while (++$cur_win <= keys %{$self->[WINDOW]}) { + if (exists $self->[WINDOW]{$cur_win}) { + $new_win = $cur_win; + last; + } + } + } + if (defined $new_win) { + change_window($self, $new_win); + } + elsif (DEBUG) { + print ERRS "We have no more windows!\n" + } } ### check if a window exists @@ -437,68 +504,141 @@ if (DEBUG) { print ERRS "Enter print\n"; } my $self = shift; my $window_id = shift; - my $validity = validate_window($self, $window_id); - if ($validity) { - my @lines = @_; - my $winref = $self->[WINDOW]->{$window_id}; + if (!validate_window($self, $window_id)) { + if (DEBUG) { print ERRS "Can't print to nonexistant Window $window_id\n"; } + croak "Can't print to nonexistant Window $window_id"; + } - foreach (@lines) { + my @lines; + foreach my $l (@_) { + foreach my $ll (split(/\n/,$l)) { + $ll =~ s/\r//g; + push(@lines,$ll); + } + } - # Start a new line in the scrollback buffer. + my $winref = $self->[WINDOW]->{$window_id}; - push @{$winref->{Buffer}}, ""; - $winref->{Scrolled_Lines}++; - my $column = 1; + foreach (@lines) { - # Build a scrollback line. Stuff surrounded by \0() does not take - # up screen space, so account for that while wrapping lines. + # Start a new line in the scrollback buffer. - my $last_color = "\0(ncolor)"; - while (length) { + push @{$winref->{Buffer}}, ""; + $winref->{Scrolled_Lines}++; + my $column = 1; - # Unprintable color codes. - if (s/^(\0\([^\)]+\))//) { - $winref->{Buffer}->[-1] .= $last_color = $1; - next; - } + # Build a scrollback line. Stuff surrounded by \0() does not take + # up screen space, so account for that while wrapping lines. - # Wordwrap visible stuff. - if (s/^([^\0]+)//) { - my @words = split /(\s+)/, $1; - foreach my $word (@words) { - unless (defined $word) { - warn "undefined word"; - next; - } - - if ($column + length($word) >= $COLS) { - $winref->{Buffer}->[-1] .= "\0(ncolor)"; - push @{$winref->{Buffer}}, "$last_color "; - $winref->{Scrolled_Lines}++; - $column = 5; - next if $word =~ /^\s+$/; - } + my $last_color = "\0(ncolor)"; + while (length) { - $winref->{Buffer}->[-1] .= $word; - $column += length($word); + # Unprintable color codes. + if (s/^(\0\([^\)]+\))//) { + $winref->{Buffer}->[-1] .= $last_color = $1; + next; + } + + # Wordwrap visible stuff. + if (s/^([^\0]+)//) { + my @words = split /(\s+)/, $1; + foreach my $word (@words) { + unless (defined $word) { + warn "undefined word"; + next; } + + while ($column + length($word) >= $COLS) { + # maybe this word length should be configurable + if (length($word) > 20) { + # save the word + my $preword = $word; + # shorten the word to the end of the line + $word = substr($word,0,($COLS - $column)); + # add the word + $winref->{Buffer}->[-1] .= "$word\0(ncolor)"; + $word = ''; + + # put the last color on the next line and wrap + push @{$winref->{Buffer}}, $last_color; + $winref->{Scrolled_Lines}++; + # slice the unmodified word + $word = substr($preword,($COLS - $column)); + $column = 1; + next; + } else { + $winref->{Buffer}->[-1] .= "\0(ncolor)"; + push @{$winref->{Buffer}}, $last_color; + } + $winref->{Scrolled_Lines}++; + $column = 1; + next if $word =~ /^\s+$/; + } + $winref->{Buffer}->[-1] .= $word; + $column += length($word); + $word = ''; } - } - } + } + } + } # Keep the scrollback buffer a tidy length. splice(@{$winref->{Buffer}}, 0, @{$winref->{Buffer}} - $winref->{Buffer_Size}) if @{$winref->{Buffer}} > $winref->{Buffer_Size}; # Refresh the buffer when it's all done. - _refresh_buffer($self, $window_id); - _refresh_edit($self, $window_id); - doupdate(); + if ($self->[CUR_WIN] == $window_id) { + _refresh_buffer($self, $window_id); + _refresh_edit($self, $window_id); + doupdate(); + } +} + +## Register key bindings - } # end brace of if ($validity) +sub bind { + my $self = shift; + carp "invalid arugments to ->bindings()" if @_ & 1; + my %bindings = @_; + for (keys %bindings) { + my $key = _parse_key($_) + or carp "Invalid escape sequence $_"; + $self->[BINDINGS]{$key} = $bindings{$_}; + } +} + +## UnRegister key bindings + +sub unbind { + my $self = shift; + for (@_) { + my $key = _parse_key($_) + or carp "Invalid escape sequence $_"; + delete $self->[BINDINGS]{$key}; + } +} + +sub _parse_key { + my ($key) = @_; + my $esc = ''; + while ($key =~ s/^(A(?:lt)|C(?:trl)?)-//i) { + my $in = uc $1; + if (substr($in, 0, 1) eq 'C') { + $esc .= '^' + } + elsif (substr($in, 0, 1) eq 'A') { + $esc .= '^['; + } + else { + die "We should not get here: $_"; + } + } + + if (length($key) == 1) { + return $esc . $key; + } else { - if (DEBUG) { print ERRS "Can't print to nonexistant Window $window_id\n"; } - croak "Can't print to nonexistant Window $window_id"; + return $esc . "KEY_" . uc($key); } } @@ -514,12 +654,6 @@ $heap->{input_session} = $sender->ID(); $heap->{input_event} = $event; - - # Increase the sender's reference count so the session stays alive - # while the terminal is active. We'll decrease the reference count - # in _stop so it can go away when the terminal does. - - $kernel->refcount_increment( $sender->ID(), "terminal link" ); } ### Get input from the Curses thing. @@ -531,26 +665,34 @@ my $window_id = $self->[CUR_WIN]; my $winref = $self->[WINDOW]->{$window_id}; $key = uc(keyname($key)) if $key =~ /^\d{2,}$/; - $key = uc(unctrl($key)) if $key lt " "; + $key = uc(unctrl($key)) if $key lt " " or $key gt "~"; # If it's a meta key, save it. if ($key eq '^[') { - $winref->{Prefix} .= $key; + $winref->{Input}{Prefix} .= $key; return; } # If there was a saved prefix, recall it. - if ($winref->{Prefix}) { - $key = $winref->{Prefix} . $key; - $winref->{Prefix} = ''; + if ($winref->{Input}{Prefix}) { + $key = $winref->{Input}{Prefix} . $key; + $winref->{Input}{Prefix} = ''; } ### Handle internal keystrokes here. Page up, down, arrow keys, etc. + # key bindings + if (exists $self->[BINDINGS]{$key} and $heap->{input_session}) { + $kernel->post( $heap->{input_session}, $self->[BINDINGS]{$key}, + $key, $winref, $window_id + ); + return; + } + # Beginning of line. if ($key eq '^A' or $key eq 'KEY_HOME') { - if ($winref->{Cursor}) { - $winref->{Cursor} = 0; + if ($winref->{Input}{Cursor}) { + $winref->{Input}{Cursor} = 0; _refresh_edit($self, $window_id); doupdate(); } @@ -559,8 +701,8 @@ # Back one character. if ($key eq 'KEY_LEFT') { - if ($winref->{Cursor}) { - $winref->{Cursor}--; + if ($winref->{Input}{Cursor}) { + $winref->{Input}{Cursor}--; _refresh_edit($self, $window_id); doupdate(); } @@ -568,6 +710,7 @@ } if (DEBUG) { print ERRS $key, "\n"; } # Switch Windows to the left Shifted left arrow + #FIXME come up with a better fix. KEY_LEFT didnt work for me. if ($key eq 'ð' or $key eq '^[KEY_LEFT') { $window_id--; change_window($self, $window_id ); @@ -575,42 +718,23 @@ } # Switch Windows to the right Shifted right arrow + #FIXME come up with a better fix. KEY_RIGHT didnt work for me. if ($key eq 'î' or $key eq '^[KEY_RIGHT') { - $window_id++; + $window_id++; change_window($self, $window_id ); return; } # Interrupt. if ($key eq '^\\') { - if (defined $heap->{input_session}) { - $kernel->post( $heap->{input_session}, $heap->{input_event}, - undef, 'interrupt' - ); - return; - } - - # Ungraceful emergency exit. - exit; - } - - # Quit. - if ($key eq '^\\') { - if (defined $heap->{input_session}) { - $kernel->post( $heap->{input_session}, $heap->{input_event}, - undef, 'quit' - ); - return; - } - - # Ungraceful emergency exit. - exit; + &shutdown; + return; } # Delete a character. if ($key eq '^D' or $key eq 'KEY_DC') { - if ($winref->{Cursor} < length($winref->{Input})) { - substr($winref->{Input}, $winref->{Cursor}, 1) = ''; + if ($winref->{Input}{Cursor} < length($winref->{Input}{Data})) { + substr($winref->{Input}{Data}, $winref->{Input}{Cursor}, 1) = ''; _refresh_edit($self, $window_id); doupdate(); } @@ -619,8 +743,8 @@ # End of line. if ($key eq '^E' or $key eq 'KEY_LL') { - if ($winref->{Cursor} < length($winref->{Input})) { - $winref->{Cursor} = length($winref->{Input}); + if ($winref->{Input}{Cursor} < length($winref->{Input}{Data})) { + $winref->{Input}{Cursor} = length($winref->{Input}{Data}); _refresh_edit($self, $window_id); doupdate(); } @@ -629,8 +753,8 @@ # Forward character. if ($key eq '^F' or $key eq 'KEY_RIGHT') { - if ($winref->{Cursor} < length($winref->{Input})) { - $winref->{Cursor}++; + if ($winref->{Input}{Cursor} < length($winref->{Input}{Data})) { + $winref->{Input}{Cursor}++; _refresh_edit($self, $window_id); doupdate(); } @@ -638,10 +762,10 @@ } # Backward delete character. - if ($key eq '^H' or $key eq 'KEY_BACKSPACE') { - if ($winref->{Cursor}) { - $winref->{Cursor}--; - substr($winref->{Input}, $winref->{Cursor}, 1) = ''; + if ($key eq '^H' or $key eq "^?" or $key eq 'KEY_BACKSPACE') { + if ($winref->{Input}{Cursor}) { + $winref->{Input}{Cursor}--; + substr($winref->{Input}{Data}, $winref->{Input}{Cursor}, 1) = ''; _refresh_edit($self, $window_id); doupdate(); } @@ -651,7 +775,7 @@ # Accept line. if ($key eq '^J' or $key eq '^M') { $kernel->post( $heap->{input_session}, $heap->{input_event}, - $winref->{Input}, undef + $winref->{Input}{Data}, undef ); # And enter the line into the command history. @@ -661,8 +785,8 @@ # Kill to EOL. if ($key eq '^K') { - if ($winref->{Cursor} < length($winref->{Input})) { - substr($winref->{Input}, $winref->{Cursor}) = ''; + if ($winref->{Input}{Cursor} < length($winref->{Input}{Data})) { + substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) = ''; _refresh_edit($self, $window_id); doupdate(); } @@ -706,8 +830,8 @@ if ($key eq '^Q') { &print( $self, $window_id, # <- can I do this better? "\0(statcolor)******", - "\0(statcolor)*** cursor is at $winref->{Cursor}", - "\0(statcolor)*** input is: ``$winref->{Input}''", + "\0(statcolor)*** cursor is at $winref->{Input}{Cursor}", + "\0(statcolor)*** input is: ``$winref->{Input}{Data}''", "\0(statcolor)*** scrolled lines: $winref->{Scrolled_Lines}", "\0(statcolor)*** screen height: " . $winref->{Screen_Height}, "\0(statcolor)*** buffer row: $winref->{Buffer_Row}", @@ -719,9 +843,9 @@ # Transpose characters. if ($key eq '^T') { - if ($winref->{Cursor} > 0 and $winref->{Cursor} < length($winref->{Input})) { - substr($winref->{Input}, $winref->{Cursor}-1, 2) = - reverse substr($winref->{Input}, $winref->{Cursor}-1, 2); + if ($winref->{Input}{Cursor} > 0 and $winref->{Input}{Cursor} < length($winref->{Input}{Data})) { + substr($winref->{Input}{Data}, $winref->{Input}{Cursor}-1, 2) = + reverse substr($winref->{Input}{Data}, $winref->{Input}{Cursor}-1, 2); _refresh_edit($self, $window_id); doupdate(); } @@ -730,9 +854,9 @@ # Discard line. if ($key eq '^U') { - if (length($winref->{Input})) { - $winref->{Input} = ''; - $winref->{Cursor} = 0; + if (length($winref->{Input}{Data})) { + $winref->{Input}{Data} = ''; + $winref->{Input}{Cursor} = 0; _refresh_edit($self, $window_id); doupdate(); } @@ -741,9 +865,9 @@ # Word rubout. if ($key eq '^W' or $key eq '^[^H') { - if ($winref->{Cursor}) { - substr($winref->{Input}, 0, $winref->{Cursor}) =~ s/(\S*\s*)$//; - $winref->{Cursor} -= length($1); + if ($winref->{Input}{Cursor}) { + substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}) =~ s/(\S*\s*)$//; + $winref->{Input}{Cursor} -= length($1); _refresh_edit($self, $window_id); doupdate(); } @@ -766,18 +890,18 @@ if (uc($key) eq '^[C') { # If there's text to capitalize. - if (substr($winref->{Input}, $winref->{Cursor}) =~ /^(\s*)(\S+)/) { + if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\s*)(\S+)/) { # Track leading space, and uppercase word. my $space = $1; $space = '' unless defined $space; my $word = ucfirst(lc($2)); # Replace text with the uppercase version. - substr( $winref->{Input}, - $winref->{Cursor} + length($space), length($word) + substr( $winref->{Input}{Data}, + $winref->{Input}{Cursor} + length($space), length($word) ) = $word; - $winref->{Cursor} += length($space . $word); + $winref->{Input}{Cursor} += length($space . $word); _refresh_edit($self, $window_id); doupdate(); } @@ -788,18 +912,18 @@ if (uc($key) eq '^[U') { # If there's text to uppercase. - if (substr($winref->{Input}, $winref->{Cursor}) =~ /^(\s*)(\S+)/) { + if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\s*)(\S+)/) { # Track leading space, and uppercase word. my $space = $1; $space = '' unless defined $space; my $word = uc($2); # Replace text with the uppercase version. - substr( $winref->{Input}, - $winref->{Cursor} + length($space), length($word) + substr( $winref->{Input}{Data}, + $winref->{Input}{Cursor} + length($space), length($word) ) = $word; - $winref->{Cursor} += length($space . $word); + $winref->{Input}{Cursor} += length($space . $word); _refresh_edit($self, $window_id); doupdate(); } @@ -810,18 +934,18 @@ if (uc($key) eq '^[L') { # If there's text to uppercase. - if (substr($winref->{Input}, $winref->{Cursor}) =~ /^(\s*)(\S+)/) { + if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\s*)(\S+)/) { # Track leading space, and uppercase word. my $space = $1; $space = '' unless defined $space; my $word = lc($2); # Replace text with the uppercase version. - substr( $winref->{Input}, - $winref->{Cursor} + length($space), length($word) + substr( $winref->{Input}{Data}, + $winref->{Input}{Cursor} + length($space), length($word) ) = $word; - $winref->{Cursor} += length($space . $word); + $winref->{Input}{Cursor} += length($space . $word); _refresh_edit($self, $window_id); doupdate(); } @@ -830,8 +954,8 @@ # Forward one word. Requires uc($key) if (uc($key) eq '^[F') { - if (substr($winref->{Input}, $winref->{Cursor}) =~ /^(\s*\S+)/) { - $winref->{Cursor} += length($1); + if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\s*\S+)/) { + $winref->{Input}{Cursor} += length($1); _refresh_edit($self, $window_id); doupdate(); } @@ -840,8 +964,8 @@ # Backward one word. This needs uc($key). if (uc($key) eq '^[B') { - if (substr($winref->{Input}, 0, $winref->{Cursor}) =~ /(\S+\s*)$/) { - $winref->{Cursor} -= length($1); + if (substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}) =~ /(\S+\s*)$/) { + $winref->{Input}{Cursor} -= length($1); _refresh_edit($self, $window_id); doupdate(); } @@ -850,8 +974,8 @@ # Delete a word forward. This needs uc($key). if (uc($key) eq '^[D') { - if ($winref->{Cursor} < length($winref->{Input})) { - substr($winref->{Input}, $winref->{Cursor}) =~ s/^(\s*\S*\s*)//; + if ($winref->{Input}{Cursor} < length($winref->{Input}{Data})) { + substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ s/^(\s*\S*\s*)//; _refresh_edit($self, $window_id); doupdate(); } @@ -862,29 +986,29 @@ if (uc($key) eq '^[T') { my ($previous, $left, $space, $right, $rest); - if (substr($winref->{Input}, $winref->{Cursor}, 1) =~ /\s/) { + if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}, 1) =~ /\s/) { my ($left_space, $right_space); ($previous, $left, $left_space) = - ( substr($winref->{Input}, 0, $winref->{Cursor}) =~ /^(.*?)(\S+)(\s*)$/ + ( substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}) =~ /^(.*?)(\S+)(\s*)$/ ); ($right_space, $right, $rest) = - ( substr($winref->{Input}, $winref->{Cursor}) =~ /^(\s+)(\S+)(.*)$/ + ( substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\s+)(\S+)(.*)$/ ); $space = $left_space . $right_space; } - elsif ( substr($winref->{Input}, 0, $winref->{Cursor}) =~ + elsif ( substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}) =~ /^(.*?)(\S+)(\s+)(\S*)$/ ) { ($previous, $left, $space, $right) = ($1, $2, $3, $4); - if (substr($winref->{Input}, $winref->{Cursor}) =~ /^(\S*)(.*)$/) { + if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\S*)(.*)$/) { $right .= $1 if defined $1; $rest = $2; } } - elsif (substr($winref->{Input}, $winref->{Cursor}) =~ /^(\S+)(\s+)(\S+)(.*)$/ + elsif (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\S+)(\s+)(\S+)(.*)$/ ) { ($left, $space, $right, $rest) = ($1, $2, $3, $4); - if ( substr($winref->{Input}, 0, $winref->{Cursor}) =~ /^(.*?)(\S+)$/ ) { + if ( substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}) =~ /^(.*?)(\S+)$/ ) { $previous = $1; $left = $2 . $left; } @@ -896,8 +1020,8 @@ $previous = '' unless defined $previous; $rest = '' unless defined $rest; - $winref->{Input} = $previous . $right . $space . $left . $rest; - $winref->{Cursor} = length($previous. $left . $space . $right); + $winref->{Input}{Data} = $previous . $right . $space . $left . $rest; + $winref->{Input}{Cursor} = length($previous. $left . $space . $right); _refresh_edit($self, $window_id); doupdate(); @@ -906,7 +1030,15 @@ # Toggle insert mode. if ($key eq 'KEY_IC') { - $winref->{Insert} = !$winref->{Insert}; + $winref->{Input}{Insert} = !$winref->{Input}{Insert}; + return; + } + # If the window is scrolled up go back to the beginning. + if ($key eq 'KEY_SELECT') { + $winref->{Buffer_Row} = $winref->{Buffer_Last}; + _refresh_buffer($self, $window_id); + _refresh_edit($self, $window_id); + doupdate(); return; } @@ -960,31 +1092,139 @@ return; } + if ($key eq "^I") { + if ($winref->{Input}{Tab_Complete}) { + my $left = substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}); + my $right = substr($winref->{Input}{Data}, $winref->{Input}{Cursor}); + my @str = $winref->{Input}{Tab_Complete}->($left, $right); + my $complete_word = $1 if $left =~ /(\S+)\s*\z/; + $left =~ s/\Q$complete_word\E\s*\z// if $complete_word; + if (@str == 1) { + my $data = $left . $str[0]; + $winref->{Input}{Data} = $data . $right; + $winref->{Input}{Cursor} = length $data; + _refresh_edit($self, $window_id); + doupdate(); + } + elsif (@str) { + # complete to something they all have in common + my $shortest = ''; + for (@str) { + if (!length($shortest) or length($_) < length $shortest) { + $shortest = $_; + } + } + my $i = length $shortest; + for (@str) { + while (substr($shortest, 0, $i) ne substr($_, 0, $i) and $i) { + $i--; + } + last unless $i; + } + if ($i) { + $winref->{Input}{Data} = $left . substr($shortest, 0, $i) . $right; + $winref->{Input}{Cursor} = length($left) + $i; + } + my $table = columnize( + Items => \@str, + MaxWidth => $COLS + ); + for (split /\n/, $table) { + &print($self, $window_id, $_); + } + } + } + return; + } + ### Not an internal keystroke. Add it to the input buffer. - # double check if this is needed... + #FIXME double check if this is needed... $key = chr(ord($1)-64) if $key =~ /^\^([@-_BC])$/; # Inserting or overwriting in the middle of the input. - if ($winref->{Cursor} < length($winref->{Input})) { - if ($winref->{Insert}) { - substr($winref->{Input}, $winref->{Cursor}, 0) = $key; + if ($winref->{Input}{Cursor} < length($winref->{Input}{Data})) { + if ($winref->{Input}{Insert}) { + substr($winref->{Input}{Data}, $winref->{Input}{Cursor}, 0) = $key; } else { - substr($winref->{Input}, $winref->{Cursor}, length($key)) = $key; + substr($winref->{Input}{Data}, $winref->{Input}{Cursor}, length($key)) = $key; } } # Appending. else { - $winref->{Input} .= $key; + $winref->{Input}{Data} .= $key; } - $winref->{Cursor} += length($key); + $winref->{Input}{Cursor} += length($key); _refresh_edit($self, $window_id); doupdate(); return; } +sub columnize { + croak "Arguments to columnize must be a hash" if @_ & 1; + my %opts = @_; + + my $width = delete $opts{MaxWidth}; + $width = 80 unless defined $width; + croak "Invalid width $width" if $width <= 0; + + my $padding = delete $opts{Padding}; + $padding = 2 unless defined $padding; + croak "Invalid padding $padding" if $padding < 0; + + my $max_columns = delete $opts{MaxColumns}; + $max_columns = 10 unless defined $max_columns; + croak "Invalid max columns $max_columns" if $max_columns <= 0; + + my $items = delete $opts{Items}; + croak "Items must be an array reference" + unless ref($items) eq 'ARRAY'; + + croak "Unknown arguments: '", join("', '", sort keys %opts), "'" + if keys %opts; + + for my $i (reverse 2 .. $max_columns) { + my $n = 0; + my @cols; + my $num_rows = 0; + for (0 .. $#{$items}) { + push @{$cols[$n++]}, $items->[$_]; + unless (($_ + 1) % $i) { + $n = 0; + $num_rows++; + } + } + my @long; + for $n (0 .. $#cols) { + for my $item (@{$cols[$n]}) { + if (!$long[$n] or length($item) > $long[$n]) { + $long[$n] = length $item; + } + } + } + my $total = 0; + for (@long) { + $total += $_ + $padding; + } + next if $total > $width; + my $table = ''; + for (0 .. $num_rows) { + my $row; + for $n (0 .. $#cols) { + my $item = $cols[$n][$_]; + last unless defined $item; + $row .= $item . (' ' x ($long[$n] - length($item) + $padding)); + } + $table .= $row . "\n"; + } + return $table; + last; + } + return join("\n", @$items) . "\n"; +} +##FIXME Has this been replaced with _parse_key() ?? my %ctrl_to_visible; BEGIN { for (0..31) { @@ -1068,7 +1308,7 @@ # TODO: This needs to be revised so it cuts off the last word, # not omits it entirely. - + # Has this been fixed already?? next if $column >= $COLS; if ($column + length($1) > $COLS) { my $word = $1; @@ -1226,7 +1466,6 @@ my ($kernel, $heap) = @_[KERNEL, HEAP]; if (defined $heap->{input_session}) { - $kernel->refcount_decrement( $heap->{input_session}, "terminal link" ); delete $heap->{input_session}; } } @@ -1288,32 +1527,32 @@ my $window_id = shift; my $winref = $self->[WINDOW]->{$window_id}; my $edit = $winref->{Window_Edit}; - my $visible_input = $winref->{Input}; + my $visible_input = $winref->{Input}{Data}; # If the cursor is after the last visible edit position, scroll the # edit window left so the cursor is back on-screen. - if ($winref->{Cursor} - $winref->{Edit_Position} >= $COLS) { - $winref->{Edit_Position} = $winref->{Cursor} - $COLS + 1; + if ($winref->{Input}{Cursor} - $winref->{Input}{Edit_Position} >= $COLS) { + $winref->{Input}{Edit_Position} = $winref->{Input}{Cursor} - $COLS + 1; } # If the cursor is moving left of the middle of the screen, scroll # things to the right so that both sides of the cursor may be seen. - elsif ($winref->{Cursor} - $winref->{Edit_Position} < ($COLS >> 1)) { - $winref->{Edit_Position} = $winref->{Cursor} - ($COLS >> 1); - $winref->{Edit_Position} = 0 if $winref->{Edit_Position} < 0; + elsif ($winref->{Input}{Cursor} - $winref->{Input}{Edit_Position} < ($COLS >> 1)) { + $winref->{Input}{Edit_Position} = $winref->{Input}{Cursor} - ($COLS >> 1); + $winref->{Input}{Edit_Position} = 0 if $winref->{Input}{Edit_Position} < 0; } # If the cursor is moving right of the middle of the screen, scroll # things to the left so that both sides of the cursor may be seen. - elsif ( $winref->{Cursor} <= length($winref->{Input}) - ($COLS >> 1) + 1 ){ - $winref->{Edit_Position} = $winref->{Cursor} - ($COLS >> 1); + elsif ( $winref->{Input}{Cursor} <= length($winref->{Input}{Data}) - ($COLS >> 1) + 1 ){ + $winref->{Input}{Edit_Position} = $winref->{Input}{Cursor} - ($COLS >> 1); } # Condition $visible_input so it really is. - $visible_input = substr($visible_input, $winref->{Edit_Position}, $COLS-1); + $visible_input = substr($visible_input, $winref->{Input}{Edit_Position}, $COLS-1); $edit->attron(A_NORMAL); $edit->erase(); @@ -1333,7 +1572,7 @@ } $edit->noutrefresh(); - $edit->move( 0, $winref->{Cursor} - $winref->{Edit_Position} ); + $edit->move( 0, $winref->{Input}{Cursor} - $winref->{Input}{Edit_Position} ); $edit->noutrefresh(); } @@ -1351,15 +1590,15 @@ # Add to the command history. Discard the oldest item if the # history size is bigger than our maximum length. - unshift(@{$winref->{Command_History}}, $winref->{Input}); - pop(@{$winref->{Command_History}}) if @{$winref->{Command_History}} > $winref->{History_Size}; + unshift(@{$winref->{Input}{Command_History}}, $winref->{Input}{Data}); + pop(@{$winref->{Input}{Command_History}}) if @{$winref->{Input}{Command_History}} > $winref->{Input}{History_Size}; # Reset the input, saved input, and history position. Repaint the # edit box. - $winref->{Input_Save} = $winref->{Input} = ""; - $winref->{Cursor_Save} = $winref->{Cursor} = 0; - $winref->{History_Position} = -1; + $winref->{Input}{Data_Save} = $winref->{Input}{Data} = ""; + $winref->{Input}{Cursor_Save} = $winref->{Input}{Cursor} = 0; + $winref->{Input}{History_Position} = -1; _refresh_edit($self, $window_id); doupdate(); @@ -1373,13 +1612,13 @@ # command history. The saved input will be used in case we come # back. - if ($winref->{History_Position} < 0) { - if (@{$winref->{Command_History}}) { - $winref->{Input_Save} = $winref->{Input}; - $winref->{Cursor_Save} = $winref->{Cursor}; - $winref->{Input} = - $winref->{Command_History}->[++$winref->{History_Position}]; - $winref->{Cursor} = length($winref->{Input}); + if ($winref->{Input}{History_Position} < 0) { + if (@{$winref->{Input}{Command_History}}) { + $winref->{Input}{Data_Save} = $winref->{Input}{Data}; + $winref->{Input}{Cursor_Save} = $winref->{Input}{Cursor}; + $winref->{Input}{Data} = + $winref->{Input}{Command_History}->[++$winref->{Input}{History_Position}]; + $winref->{Input}{Cursor} = length($winref->{Input}{Data}); _refresh_edit($self, $window_id); doupdate(); @@ -1389,9 +1628,9 @@ # If we're not at the end of the command history, then we go # farther back. - elsif ($winref->{History_Position} < @{$winref->{Command_History}} - 1) { - $winref->{Input} = $winref->{Command_History}->[++$winref->{History_Position}]; - $winref->{Cursor} = length($winref->{Input}); + elsif ($winref->{Input}{History_Position} < @{$winref->{Input}{Command_History}} - 1) { + $winref->{Input}{Data} = $winref->{Input}{Command_History}->[++$winref->{Input}{History_Position}]; + $winref->{Input}{Cursor} = length($winref->{Input}{Data}); _refresh_edit($self, $window_id); doupdate(); @@ -1403,18 +1642,18 @@ if ($flag == 2) { # get next history 'KEY_DOWN' # At 0th command history. Switch to saved input. - unless ($winref->{History_Position}) { - $winref->{Input} = $winref->{Input_Save}; - $winref->{Cursor} = $winref->{Cursor_Save}; - $winref->{History_Position}--; + unless ($winref->{Input}{History_Position}) { + $winref->{Input}{Data} = $winref->{Input}{Data_Save}; + $winref->{Input}{Cursor} = $winref->{Input}{Cursor_Save}; + $winref->{Input}{History_Position}--; _refresh_edit($self, $window_id); doupdate(); } # At >0 command history. Move towards 0. - elsif ($winref->{History_Position} > 0) { - $winref->{Input} = $winref->{Command_History}->[--$winref->{History_Position}]; - $winref->{Cursor} = length($winref->{Input}); + elsif ($winref->{Input}{History_Position} > 0) { + $winref->{Input}{Data} = $winref->{Input}{Command_History}->[--$winref->{Input}{History_Position}]; + $winref->{Input}{Cursor} = length($winref->{Input}{Data}); _refresh_edit($self, $window_id); doupdate(); } @@ -1512,9 +1751,22 @@ sub set_errlevel {} sub get_errlevel {} -sub error {} +sub debug { + my $self = shift; + if (DEBUG) { for (@_) { print ERRS "$_\n";} } + else { carp "turn on debugging in Term::Visual or define sub Term::Visual::DEBUG () { 1 }; before use Term::Visual; in your program"; } -sub shutdown {} +} + +sub shutdown { + $_[KERNEL]->alias_remove($_[OBJECT][ALIAS]); + delete $_[HEAP]->{stderr_reader}; + undef $console; + if (defined $_[HEAP]->{input_session}) { + $_[KERNEL]->post( $_[HEAP]->{input_session}, $_[HEAP]->{input_event}, + undef, 'interrupt' ); + } +} 1; @@ -1566,6 +1818,16 @@ $vt->delete_window( $window_id ); +=head1 DESCRIPTION + +Term::Visual is a "visual" terminal interface for curses applications. +It provides the split-screen interface you may have seen in console +based IRC and MUD clients. + +Term::Visual uses the POE networking and multitasking framework to support +concurrent input from network sockets and the console, multiple +timers, and more. + =head1 PUBLIC METHODS Term::Visual->method(); @@ -1576,11 +1838,42 @@ Create and initialize a new instance of Term::Visual. - my $vt = Term::Visual->new( Alias => "interface", - Errlevel => 0 ); + my $vt = Term::Visual->new( + Alias => "interface", + Common_Input => 1, + Tab_Complete => sub { ... }, + Errlevel => 0 ); Alias is a session alias for POE. +Common_Input is an optional flag used + to globalize History_Position, + History_Size, + Command_History, + Data, + Data_Save, + Cursor, + Cursor_Save, + Tab_Complete, + Insert, + Edit_Position + in create_window(); +Thus all windows created will have common input. + +Tab_Complete is a handler for tab completion. + + Tab_Complete => sub { + my $left = shift; + my @return; + my %complete = ( + foo => "foobar ", + biz => "bizbaz ", + ); + return $complete{$left}; + } + +Tab_Complete is covered more indepth in the examples directory. + Errlevel not implemented yet. Errlevel sets Term::Visual's error level. @@ -1721,9 +2014,9 @@ $vt->set_status_format( $window_id, 0 => { format => "template for status line 1", - field => [ qw( foo bar ) ] }, + fields => [ qw( foo bar ) ] }, 1 => { format => "template for status line 2", - field => [ qw( biz baz ) ] }, ); + fields => [ qw( biz baz ) ] }, ); =item set_status_field @@ -1731,6 +2024,78 @@ $vt->set_status_field( $window_id, foo => "bar", biz => "baz" ); +=item columnize + columnize takes a list of text and formats it into + a columnized table. + + columnize is used internally, but might be of use + externally as well. + + Arguments given to columnize must be a hash. + key 'Items' must be an array reference. + The default value for Maxwidth may change to $COLS. + + my $table = $vt->columnize( + Items => \@list, + Padding => 2, # default value and optional + MaxColumns => 10, # default value and optional + MaxWidth => 80 # default value and optional + ); + +=item bind + + bind is used for key bindings. + our %Bindings = ( + Up => 'history', + Down => 'history', + ... + ); + + $vt->bind(%Bindings); + + sub handler_history { + my ($kernel, $heap, $key, $win) = @_[KERNEL, HEAP, ARG0, ARG2]; + if ($key eq 'KEY_UP') { + $vt->command_history($win, 1); + } + else { + $vt->command_history($win, 2); + } + } + + POE::Session->create( + inline_states => { + _start => \&handler_start, + _stop => \&handler_stop, + history => \&handler_history, + ... + } + ); + + +=item unbind + unbind a key + + $vt->unbind('Up', 'Down'); + $vt->unbind(keys %Bindings); + +=item debug + write to the debug file + + $vt->debug("message"); + + Debugging must be turned on before using this. + + change sub DEBUG () { 0 } to 1 or + add this to your program: + sub Term::Visual::DEBUG () { 1 } + use Term::Visual; + +=item shutdown + shutdown Term::Visual + + $vt->shutdown(); + =back =head1 Internal Keystrokes @@ -1847,6 +2212,10 @@ Toggle Insert mode. +=item KEY_SELECT 'Home' + +If window is scrolled up, page all the way down. + =item KEY_PPAGE 'Page Down' Scroll down a page. @@ -1873,7 +2242,7 @@ Except where otherwise noted, -Term::Visual is Copyright 2002, 2003 Charles Ayres. All rights reserved. +Term::Visual is Copyright 2002, 2003, 2004 Charles Ayres. All rights reserved. Term::Visual is free software; you may redistribute it and/or modify it under the same terms as Perl itself.