--- 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.