| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # $Id: Visual.pm,v 0.06 2003/01/14 23:00:18 lunartear Exp $ | 
| 2 |  |  |  |  |  |  | # Copyrights and documentation are after __END__. | 
| 3 |  |  |  |  |  |  | package Term::Visual; | 
| 4 | 1 |  |  | 1 |  | 5379 | use strict; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 29 |  | 
| 5 | 1 |  |  | 1 |  | 29 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 30 |  | 
| 6 | 1 |  |  | 1 |  | 4 | use vars qw($VERSION $REVISION $console); | 
|  | 1 |  |  |  |  | 5 |  | 
|  | 1 |  |  |  |  | 98 |  | 
| 7 |  |  |  |  |  |  | $VERSION = '0.08'; | 
| 8 |  |  |  |  |  |  | $REVISION = do {my@r=(q$Revision: 0.08 $=~/\d+/g);sprintf"%d."."%02d"x$#r,@r}; | 
| 9 |  |  |  |  |  |  | #use Visual::StatusBar; | 
| 10 | 1 |  |  | 1 |  | 472 | use Term::Visual::StatusBar; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 24 |  | 
| 11 | 1 |  |  | 1 |  | 795 | use POE qw(Wheel::Curses Wheel::ReadWrite ); | 
|  | 1 |  |  |  |  | 48915 |  | 
|  | 1 |  |  |  |  | 8 |  | 
| 12 |  |  |  |  |  |  | use Curses; | 
| 13 |  |  |  |  |  |  | use Carp; | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | BEGIN { | 
| 16 |  |  |  |  |  |  | my $debug_default = 0; | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | $debug_default++ if defined $ENV{TV_DEBUG}; | 
| 19 |  |  |  |  |  |  | defined &DEBUG or eval "sub DEBUG () { $debug_default }"; | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | if (&DEBUG) { | 
| 22 |  |  |  |  |  |  | my $debug_file = $ENV{TV_LOG_FILE} || 'term_visual.log'; | 
| 23 |  |  |  |  |  |  | defined &DEBUG_FILE or eval "sub DEBUG_FILE () { '$debug_file' }"; | 
| 24 |  |  |  |  |  |  | open ERRS, ">" . &DEBUG_FILE or croak "Can't open Debug file: $!"; | 
| 25 |  |  |  |  |  |  | } | 
| 26 |  |  |  |  |  |  | } | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  | ### Term::Visual Constants. | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | sub WINDOW       () { 0 } # hash of windows and there properties | 
| 31 |  |  |  |  |  |  | sub WINDOW_REV   () { 1 } # window name => id key value pair for reverse lookups | 
| 32 |  |  |  |  |  |  | sub PALETTE      () { 2 } # Palette Element | 
| 33 |  |  |  |  |  |  | sub PAL_COL_SEQ  () { 3 } # Palette Color Sequence | 
| 34 |  |  |  |  |  |  | sub CUR_WIN      () { 4 } # holds the current window id | 
| 35 |  |  |  |  |  |  | sub ERRLEVEL     () { 5 } # Error Level boolean | 
| 36 |  |  |  |  |  |  | sub ALIAS        () { 6 } # Visterm's Alias | 
| 37 |  |  |  |  |  |  | sub BINDINGS     () { 7 } # key bindings | 
| 38 |  |  |  |  |  |  | sub COMMON_INPUT () { 8 } # Common input boolean | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | ### Palette Constants. | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | sub PAL_PAIR    () { 0 }  # Index of the COLOR_PAIR in the palette. | 
| 43 |  |  |  |  |  |  | sub PAL_NUMBER  () { 1 }  # Index of the color number in the palette. | 
| 44 |  |  |  |  |  |  | sub PAL_DESC    () { 2 }  # Text description of the color. | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | ### Title line constants. | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | sub TITLE_LINE  () { 0 }  # Where the title goes. | 
| 49 |  |  |  |  |  |  | sub TITLE_COL   () { 0 } | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | sub current_window { | 
| 53 |  |  |  |  |  |  | if (DEBUG) { print ERRS " Enter current_window\n"; } | 
| 54 |  |  |  |  |  |  | my $self = shift; | 
| 55 |  |  |  |  |  |  | return $self->[CUR_WIN]; | 
| 56 |  |  |  |  |  |  | } | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  | sub CREATE_WINDOW_ID { | 
| 60 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter CREATE_WINDOW_ID\n"; } | 
| 61 |  |  |  |  |  |  | my $self = shift; | 
| 62 |  |  |  |  |  |  | my $id = 0; | 
| 63 |  |  |  |  |  |  | my @list = sort {$a <=> $b} keys %{$self->[WINDOW]}; | 
| 64 |  |  |  |  |  |  | if (@list) { | 
| 65 |  |  |  |  |  |  | my $high_number = $list[$#list] + 1; | 
| 66 |  |  |  |  |  |  | for my $i (0..$high_number) { | 
| 67 |  |  |  |  |  |  | next if (defined $list[$i] && $i == $list[$i]); | 
| 68 |  |  |  |  |  |  | $id = $i; last; | 
| 69 |  |  |  |  |  |  | } | 
| 70 |  |  |  |  |  |  | } | 
| 71 |  |  |  |  |  |  | return $id; | 
| 72 |  |  |  |  |  |  | } | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | ### Mold the Object. | 
| 76 |  |  |  |  |  |  |  | 
| 77 |  |  |  |  |  |  | sub new { | 
| 78 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter Visterm->new\n"; } | 
| 79 |  |  |  |  |  |  | my $package = shift; | 
| 80 |  |  |  |  |  |  | my %params = @_; | 
| 81 |  |  |  |  |  |  | my $alias = delete $params{Alias}; | 
| 82 |  |  |  |  |  |  | my $errlevel = delete $params{Errlevel} || 0; | 
| 83 |  |  |  |  |  |  | my $current_window = -1; | 
| 84 |  |  |  |  |  |  |  | 
| 85 |  |  |  |  |  |  | my $common_input = delete $params{Common_Input}; | 
| 86 |  |  |  |  |  |  | # These options only make sense if Common_Input is specified | 
| 87 |  |  |  |  |  |  | my $tabcomplete = delete $params{Tab_Complete}; | 
| 88 |  |  |  |  |  |  | my $history_size = delete $params{History_Size}; | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | my $self = | 
| 91 |  |  |  |  |  |  | bless [ { }, # WINDOW stores window properties under each window id. | 
| 92 |  |  |  |  |  |  | { }, # WINDOW_REV reverse window lookups. | 
| 93 |  |  |  |  |  |  | { }, # Palette | 
| 94 |  |  |  |  |  |  | 0, # Palette Color Sequence | 
| 95 |  |  |  |  |  |  | $current_window, | 
| 96 |  |  |  |  |  |  | $errlevel, # Visterms error level. | 
| 97 |  |  |  |  |  |  | $alias, | 
| 98 |  |  |  |  |  |  | { }, # BINDINGS | 
| 99 |  |  |  |  |  |  | $common_input ? { | 
| 100 |  |  |  |  |  |  | History_Position => -1, | 
| 101 |  |  |  |  |  |  | History_Size     => $history_size, | 
| 102 |  |  |  |  |  |  | Command_History  => [ ], | 
| 103 |  |  |  |  |  |  | Data             => "", | 
| 104 |  |  |  |  |  |  | Data_Save        => "", | 
| 105 |  |  |  |  |  |  | Cursor           => 0, | 
| 106 |  |  |  |  |  |  | Cursor_Save      => 0, | 
| 107 |  |  |  |  |  |  | Tab_Complete     => $tabcomplete, | 
| 108 |  |  |  |  |  |  | Insert           => 1, | 
| 109 |  |  |  |  |  |  | Edit_Position    => 0, | 
| 110 |  |  |  |  |  |  | } : undef, | 
| 111 |  |  |  |  |  |  | ], $package; | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | POE::Session->create | 
| 114 |  |  |  |  |  |  | ( object_states => | 
| 115 |  |  |  |  |  |  | [ $self =>   # $_[OBJECT] | 
| 116 |  |  |  |  |  |  | {                 _start => "start_terminal", | 
| 117 |  |  |  |  |  |  | _stop => "terminal_stopped", | 
| 118 |  |  |  |  |  |  | send_me_input => "register_input", | 
| 119 |  |  |  |  |  |  | private_input => "got_curses_input", | 
| 120 |  |  |  |  |  |  | got_stderr => "got_stderr", | 
| 121 |  |  |  |  |  |  | shutdown => "shutdown", | 
| 122 |  |  |  |  |  |  | } ], | 
| 123 |  |  |  |  |  |  | args => [ $alias ], | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | ); | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | return $self; | 
| 128 |  |  |  |  |  |  | } | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  | sub got_stderr { | 
| 131 |  |  |  |  |  |  | my ($self, $kernel, $stderr_line) = @_[OBJECT, KERNEL, ARG0]; | 
| 132 |  |  |  |  |  |  | my $window_id = $self->[CUR_WIN]; | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | if (DEBUG) {  print ERRS $stderr_line, "\n"; } | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | &print($self, $window_id, | 
| 137 |  |  |  |  |  |  | "\0(stderr_bullet)" . | 
| 138 |  |  |  |  |  |  | "2>" . | 
| 139 |  |  |  |  |  |  | "\0(ncolor)" . | 
| 140 |  |  |  |  |  |  | " " . | 
| 141 |  |  |  |  |  |  | "\0(stderr_text)" . | 
| 142 |  |  |  |  |  |  | $stderr_line ); | 
| 143 |  |  |  |  |  |  | } | 
| 144 |  |  |  |  |  |  |  | 
| 145 |  |  |  |  |  |  | sub start_terminal { | 
| 146 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter start_terminal\n"; } | 
| 147 |  |  |  |  |  |  | my ($kernel, $heap, $object, $alias) = @_[KERNEL, HEAP, OBJECT, ARG0]; | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | $kernel->alias_set( $alias ); | 
| 150 |  |  |  |  |  |  | $console = POE::Wheel::Curses->new( InputEvent => 'private_input'); | 
| 151 |  |  |  |  |  |  | use_default_colors(); | 
| 152 |  |  |  |  |  |  | my $old_mouse_events = 0; | 
| 153 |  |  |  |  |  |  | mousemask(0, $old_mouse_events); | 
| 154 |  |  |  |  |  |  |  | 
| 155 |  |  |  |  |  |  | #TODO See about adding support for a wheel mouse after defining old mouse | 
| 156 |  |  |  |  |  |  | #     events above, so that copy/paste will work as expected. | 
| 157 |  |  |  |  |  |  |  | 
| 158 |  |  |  |  |  |  | ### Set Colors used by Visterm | 
| 159 |  |  |  |  |  |  | _set_color( $object,  stderr_bullet => "bright white on red", | 
| 160 |  |  |  |  |  |  | stderr_text   => "bright yellow on black", | 
| 161 |  |  |  |  |  |  | ncolor        => "white on black", | 
| 162 |  |  |  |  |  |  | statcolor     => "green on black", | 
| 163 |  |  |  |  |  |  | st_frames     => "bright cyan on blue", | 
| 164 |  |  |  |  |  |  | st_values     => "bright white on blue", ); | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | ### Redirect STDERR into the terminal buffer. | 
| 168 |  |  |  |  |  |  | use Symbol qw(gensym); | 
| 169 |  |  |  |  |  |  |  | 
| 170 |  |  |  |  |  |  | # Pipe STDERR to a readable handle. | 
| 171 |  |  |  |  |  |  | my $read_stderr = gensym(); | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | pipe($read_stderr, STDERR) or do | 
| 174 |  |  |  |  |  |  | { open STDERR, ">&=2"; | 
| 175 |  |  |  |  |  |  | die "can't pipe STDERR: $!"; | 
| 176 |  |  |  |  |  |  | }; | 
| 177 |  |  |  |  |  |  |  | 
| 178 |  |  |  |  |  |  | $heap->{stderr_reader} = POE::Wheel::ReadWrite->new | 
| 179 |  |  |  |  |  |  | ( Handle      => $read_stderr, | 
| 180 |  |  |  |  |  |  | Filter      => POE::Filter::Line->new(), | 
| 181 |  |  |  |  |  |  | Driver      => POE::Driver::SysRW->new(), | 
| 182 |  |  |  |  |  |  | InputEvent  => "got_stderr", | 
| 183 |  |  |  |  |  |  | ); | 
| 184 |  |  |  |  |  |  |  | 
| 185 |  |  |  |  |  |  | } | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | ### create a curses window | 
| 188 |  |  |  |  |  |  | ### TODO add error handling | 
| 189 |  |  |  |  |  |  |  | 
| 190 |  |  |  |  |  |  | sub create_window { | 
| 191 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter create_window\n"; } | 
| 192 |  |  |  |  |  |  | my $self = shift; | 
| 193 |  |  |  |  |  |  | my %params = @_; | 
| 194 |  |  |  |  |  |  | my $use_title = 1 unless defined $params{Use_Title}; | 
| 195 |  |  |  |  |  |  | my $use_status = 1 unless defined $params{Use_Status}; | 
| 196 |  |  |  |  |  |  | my $new_window_id = CREATE_WINDOW_ID($self); | 
| 197 |  |  |  |  |  |  | my $window_name = $params{Window_Name} || $new_window_id; | 
| 198 |  |  |  |  |  |  | my $input_prompt = $params{Input_Prompt} || ""; | 
| 199 |  |  |  |  |  |  | my $prompt_size = 0; | 
| 200 |  |  |  |  |  |  | if (length $input_prompt) { | 
| 201 |  |  |  |  |  |  | $prompt_size = length( $input_prompt ) ; | 
| 202 |  |  |  |  |  |  | } | 
| 203 |  |  |  |  |  |  | my $input; | 
| 204 |  |  |  |  |  |  | if ($self->[COMMON_INPUT]) { | 
| 205 |  |  |  |  |  |  | $input = $self->[COMMON_INPUT]; | 
| 206 |  |  |  |  |  |  | } | 
| 207 |  |  |  |  |  |  | else { | 
| 208 |  |  |  |  |  |  | $input = { | 
| 209 |  |  |  |  |  |  | History_Position => -1, | 
| 210 |  |  |  |  |  |  | History_Size     => 50, | 
| 211 |  |  |  |  |  |  | Command_History  => [ ], | 
| 212 |  |  |  |  |  |  | Data             => "", | 
| 213 |  |  |  |  |  |  | Data_Save        => "", | 
| 214 |  |  |  |  |  |  | Cursor           => $prompt_size || 0, | 
| 215 |  |  |  |  |  |  | Cursor_Save      => 0, | 
| 216 |  |  |  |  |  |  | Tab_Complete     => undef, | 
| 217 |  |  |  |  |  |  | Insert           => 1, | 
| 218 |  |  |  |  |  |  | Edit_Position    => 0, | 
| 219 |  |  |  |  |  |  | Prompt           => $input_prompt, | 
| 220 |  |  |  |  |  |  | Prompt_Size      => $prompt_size, | 
| 221 |  |  |  |  |  |  | }; | 
| 222 |  |  |  |  |  |  | } | 
| 223 |  |  |  |  |  |  | # Allow override of possible global options | 
| 224 |  |  |  |  |  |  | if ($params{History_Size}) { | 
| 225 |  |  |  |  |  |  | $input->{History_Size} = $params{History_Size}; | 
| 226 |  |  |  |  |  |  | } | 
| 227 |  |  |  |  |  |  | if ($params{Tab_Complete}) { | 
| 228 |  |  |  |  |  |  | $input->{Tab_Complete} = $params{Tab_Complete}; | 
| 229 |  |  |  |  |  |  | } | 
| 230 |  |  |  |  |  |  |  | 
| 231 |  |  |  |  |  |  | if (defined $new_window_id) { | 
| 232 |  |  |  |  |  |  | if (DEBUG) { print ERRS "new_window_id is defined: $new_window_id\n"; } | 
| 233 |  |  |  |  |  |  | if (!$self->[WINDOW]->{$new_window_id}) { | 
| 234 |  |  |  |  |  |  | $self->[WINDOW]->{$new_window_id} = | 
| 235 |  |  |  |  |  |  | { Buffer           => [ ], | 
| 236 |  |  |  |  |  |  | Buffer_Size      => $params{Buffer_Size} || 500, | 
| 237 |  |  |  |  |  |  | Input            => $input, | 
| 238 |  |  |  |  |  |  | Use_Title        => $use_title, | 
| 239 |  |  |  |  |  |  | Use_Status       => $use_status, | 
| 240 |  |  |  |  |  |  | Scrolled_Lines   => 0, | 
| 241 |  |  |  |  |  |  | Window_Id        => $new_window_id, | 
| 242 |  |  |  |  |  |  | Window_Name      => $window_name }; | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$new_window_id}; | 
| 245 |  |  |  |  |  |  |  | 
| 246 |  |  |  |  |  |  | # Set the newly created window as the current window | 
| 247 |  |  |  |  |  |  | $self->[CUR_WIN] = $new_window_id; | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | $self->[WINDOW_REV]->{$window_name} = $new_window_id; | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | # create the screen, statusbar, title, and entryline | 
| 252 |  |  |  |  |  |  | # for this window instance | 
| 253 |  |  |  |  |  |  |  | 
| 254 |  |  |  |  |  |  | if ($winref->{Use_Title}) { | 
| 255 |  |  |  |  |  |  | $winref->{Title_Start} = 0; | 
| 256 |  |  |  |  |  |  | $winref->{Title_Height} = 1; | 
| 257 |  |  |  |  |  |  | $winref->{Title} = $params{Title} || ""; | 
| 258 |  |  |  |  |  |  |  | 
| 259 |  |  |  |  |  |  | $winref->{Screen_Start} = $winref->{Title_Start} + 1; | 
| 260 |  |  |  |  |  |  |  | 
| 261 |  |  |  |  |  |  | $winref->{Window_Title} =  newwin( $winref->{Title_Height}, | 
| 262 |  |  |  |  |  |  | $COLS, | 
| 263 |  |  |  |  |  |  | $winref->{Title_Start}, | 
| 264 |  |  |  |  |  |  | 0 ); | 
| 265 |  |  |  |  |  |  | # Should we die here?? | 
| 266 |  |  |  |  |  |  | die "No title!!" unless defined $winref->{Window_Title}; | 
| 267 |  |  |  |  |  |  |  | 
| 268 |  |  |  |  |  |  | my $title = $winref->{Window_Title}; | 
| 269 |  |  |  |  |  |  |  | 
| 270 |  |  |  |  |  |  | $title->bkgd($self->[PALETTE]->{st_frames}->[PAL_PAIR]); | 
| 271 |  |  |  |  |  |  | $title->erase(); | 
| 272 |  |  |  |  |  |  | _refresh_title( $self, $new_window_id); | 
| 273 |  |  |  |  |  |  | } | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | if ($winref->{Use_Status}) { | 
| 276 |  |  |  |  |  |  | $winref->{Status_Height} = $params{Status_Height} || 2; | 
| 277 |  |  |  |  |  |  | $winref->{Status_Start} = $LINES - $winref->{Status_Height} - 1; | 
| 278 |  |  |  |  |  |  |  | 
| 279 |  |  |  |  |  |  | #FIXME I think this got lost when the new design was implemented. | 
| 280 |  |  |  |  |  |  | $winref->{Def_Status_Field} = [ ]; | 
| 281 |  |  |  |  |  |  |  | 
| 282 |  |  |  |  |  |  | $winref->{Screen_End} = $winref->{Status_Start} - 1; | 
| 283 |  |  |  |  |  |  |  | 
| 284 |  |  |  |  |  |  | $winref->{Window_Status} = newwin( $winref->{Status_Height}, | 
| 285 |  |  |  |  |  |  | $COLS, | 
| 286 |  |  |  |  |  |  | $winref->{Status_Start}, | 
| 287 |  |  |  |  |  |  | 0 ); | 
| 288 |  |  |  |  |  |  | my $status = $winref->{Window_Status}; | 
| 289 |  |  |  |  |  |  | if (DEBUG) { print ERRS $status, " <-status in create_window\n"; } | 
| 290 |  |  |  |  |  |  | $status->bkgd($self->[PALETTE]->{st_frames}->[PAL_PAIR]); | 
| 291 |  |  |  |  |  |  | $status->erase(); | 
| 292 |  |  |  |  |  |  | $status->noutrefresh(); | 
| 293 |  |  |  |  |  |  |  | 
| 294 |  |  |  |  |  |  | $winref->{Status_Object} = Term::Visual::StatusBar->new(); | 
| 295 |  |  |  |  |  |  | set_status_format( $self, $new_window_id, %{$params{Status}}); | 
| 296 |  |  |  |  |  |  | $winref->{Status_Lines} = $winref->{Status_Object}->get(); | 
| 297 |  |  |  |  |  |  | if (DEBUG) { print ERRS "passed set_status_format in create_window\n"; } | 
| 298 |  |  |  |  |  |  | } | 
| 299 |  |  |  |  |  |  |  | 
| 300 |  |  |  |  |  |  | if ($winref->{Use_Title} && $winref->{Use_Status}) { | 
| 301 |  |  |  |  |  |  | $winref->{Screen_Height} = | 
| 302 |  |  |  |  |  |  | $winref->{Screen_End} - $winref->{Screen_Start} + 1; | 
| 303 |  |  |  |  |  |  | } | 
| 304 |  |  |  |  |  |  |  | 
| 305 |  |  |  |  |  |  | else { | 
| 306 |  |  |  |  |  |  | $winref->{Screen_Start} = 0 unless defined $winref->{Screen_Start}; | 
| 307 |  |  |  |  |  |  | $winref->{Screen_End} = $LINES - 2 unless defined $winref->{Screen_End}; | 
| 308 |  |  |  |  |  |  | $winref->{Screen_Height} = | 
| 309 |  |  |  |  |  |  | $winref->{Screen_End} - $winref->{Screen_Start} + 1 | 
| 310 |  |  |  |  |  |  | unless defined $winref->{Screen_Height}; | 
| 311 |  |  |  |  |  |  | } | 
| 312 |  |  |  |  |  |  |  | 
| 313 |  |  |  |  |  |  | $winref->{Edit_Height} = 1; | 
| 314 |  |  |  |  |  |  | $winref->{Edit_Start} = $LINES - 1; | 
| 315 |  |  |  |  |  |  |  | 
| 316 |  |  |  |  |  |  | $winref->{Buffer_Last} = $winref->{Buffer_Size} - 1; | 
| 317 |  |  |  |  |  |  | $winref->{Buffer_First} = $winref->{Screen_Height} - 1; | 
| 318 |  |  |  |  |  |  | $winref->{Buffer_Visible} = $winref->{Screen_Height} - 1; | 
| 319 |  |  |  |  |  |  |  | 
| 320 |  |  |  |  |  |  |  | 
| 321 |  |  |  |  |  |  | $winref->{Window_Edit} = newwin( $winref->{Edit_Height}, | 
| 322 |  |  |  |  |  |  | $COLS, | 
| 323 |  |  |  |  |  |  | $winref->{Edit_Start}, | 
| 324 |  |  |  |  |  |  | 0 ); | 
| 325 |  |  |  |  |  |  | my $edit = $winref->{Window_Edit}; | 
| 326 |  |  |  |  |  |  | $edit->scrollok(1); | 
| 327 |  |  |  |  |  |  |  | 
| 328 |  |  |  |  |  |  | $winref->{Window_Screen} = newwin( $winref->{Screen_Height}, | 
| 329 |  |  |  |  |  |  | $COLS, | 
| 330 |  |  |  |  |  |  | $winref->{Screen_Start}, | 
| 331 |  |  |  |  |  |  | 0 ); | 
| 332 |  |  |  |  |  |  | my $screen = $winref->{Window_Screen}; | 
| 333 |  |  |  |  |  |  |  | 
| 334 |  |  |  |  |  |  | $screen->bkgd($self->[PALETTE]->{ncolor}->[PAL_PAIR]); | 
| 335 |  |  |  |  |  |  | $screen->erase(); | 
| 336 |  |  |  |  |  |  | $screen->noutrefresh(); | 
| 337 |  |  |  |  |  |  |  | 
| 338 |  |  |  |  |  |  | $winref->{Buffer_Row} = $winref->{Buffer_Last}; | 
| 339 |  |  |  |  |  |  |  | 
| 340 |  |  |  |  |  |  | $winref->{Buffer} = [("") x $winref->{Buffer_Size}]; | 
| 341 |  |  |  |  |  |  |  | 
| 342 |  |  |  |  |  |  | _refresh_edit($self, $new_window_id); | 
| 343 |  |  |  |  |  |  |  | 
| 344 |  |  |  |  |  |  |  | 
| 345 |  |  |  |  |  |  | # Flush updates. | 
| 346 |  |  |  |  |  |  | doupdate(); | 
| 347 |  |  |  |  |  |  |  | 
| 348 |  |  |  |  |  |  | return $new_window_id; | 
| 349 |  |  |  |  |  |  |  | 
| 350 |  |  |  |  |  |  | } | 
| 351 |  |  |  |  |  |  | else { | 
| 352 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Window $params{Window_Name} already exists\n"; } | 
| 353 |  |  |  |  |  |  | carp "Window $params{Window_Name} already exists"; | 
| 354 |  |  |  |  |  |  | } | 
| 355 |  |  |  |  |  |  | } | 
| 356 |  |  |  |  |  |  | else { | 
| 357 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Window $params{Window_Name} couldn't be created\n"; } | 
| 358 |  |  |  |  |  |  | croak "Window $params{Window_Name} couldn't be created"; | 
| 359 |  |  |  |  |  |  | } | 
| 360 |  |  |  |  |  |  | } | 
| 361 |  |  |  |  |  |  |  | 
| 362 |  |  |  |  |  |  |  | 
| 363 |  |  |  |  |  |  | ### delete one or more windows  ##TODO add error handling | 
| 364 |  |  |  |  |  |  | ### $vt->delete_window($window_id); | 
| 365 |  |  |  |  |  |  |  | 
| 366 |  |  |  |  |  |  | sub delete_window { | 
| 367 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter delete_window\n"; } | 
| 368 |  |  |  |  |  |  | my $self = shift; | 
| 369 |  |  |  |  |  |  | my $win; | 
| 370 |  |  |  |  |  |  | for (@_) { | 
| 371 |  |  |  |  |  |  | $win = $_; | 
| 372 |  |  |  |  |  |  | my $name = get_window_name($self, $_); | 
| 373 |  |  |  |  |  |  | delete $self->[WINDOW]->{$_}; | 
| 374 |  |  |  |  |  |  | delete $self->[WINDOW_REV]->{$name}; | 
| 375 |  |  |  |  |  |  | } | 
| 376 |  |  |  |  |  |  | return unless defined $win; | 
| 377 |  |  |  |  |  |  | my $new_win; | 
| 378 |  |  |  |  |  |  | my $cur_win = $win; | 
| 379 |  |  |  |  |  |  | # Select previous window | 
| 380 |  |  |  |  |  |  | while (--$cur_win > 0) { | 
| 381 |  |  |  |  |  |  | if (exists $self->[WINDOW]{$cur_win}) { | 
| 382 |  |  |  |  |  |  | $new_win = $cur_win; | 
| 383 |  |  |  |  |  |  | last; | 
| 384 |  |  |  |  |  |  | } | 
| 385 |  |  |  |  |  |  | } | 
| 386 |  |  |  |  |  |  | # No previous window, select next window | 
| 387 |  |  |  |  |  |  | unless (defined $new_win) { | 
| 388 |  |  |  |  |  |  | $cur_win = $win; | 
| 389 |  |  |  |  |  |  | while (++$cur_win <= keys %{$self->[WINDOW]}) { | 
| 390 |  |  |  |  |  |  | if (exists $self->[WINDOW]{$cur_win}) { | 
| 391 |  |  |  |  |  |  | $new_win = $cur_win; | 
| 392 |  |  |  |  |  |  | last; | 
| 393 |  |  |  |  |  |  | } | 
| 394 |  |  |  |  |  |  | } | 
| 395 |  |  |  |  |  |  | } | 
| 396 |  |  |  |  |  |  | if (defined $new_win) { | 
| 397 |  |  |  |  |  |  | change_window($self, $new_win); | 
| 398 |  |  |  |  |  |  | } | 
| 399 |  |  |  |  |  |  | elsif (DEBUG) { | 
| 400 |  |  |  |  |  |  | print ERRS "We have no more windows!\n" | 
| 401 |  |  |  |  |  |  | } | 
| 402 |  |  |  |  |  |  | } | 
| 403 |  |  |  |  |  |  |  | 
| 404 |  |  |  |  |  |  | ### check if a window exists | 
| 405 |  |  |  |  |  |  |  | 
| 406 |  |  |  |  |  |  | sub validate_window { | 
| 407 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter validate_window\n"; } | 
| 408 |  |  |  |  |  |  | my $self = shift; | 
| 409 |  |  |  |  |  |  | my $query = shift; | 
| 410 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Validating: $query\n"; } | 
| 411 |  |  |  |  |  |  | if ($query =~ /^\d+$/ && defined $self->[WINDOW]->{$query}) { return 1; } | 
| 412 |  |  |  |  |  |  | elsif (defined $self->[WINDOW_REV]->{$query}) { return 1; } | 
| 413 |  |  |  |  |  |  | else { return 0; } | 
| 414 |  |  |  |  |  |  | } | 
| 415 |  |  |  |  |  |  |  | 
| 416 |  |  |  |  |  |  | ### return a windows palette or a specific colorname's description | 
| 417 |  |  |  |  |  |  | ### my %palette = $vt->get_palette(); # entire palette. | 
| 418 |  |  |  |  |  |  | ### my ($color_desc, $another_desc) = $vt->get_palette($colorname, $somecolor); # color desc. | 
| 419 |  |  |  |  |  |  |  | 
| 420 |  |  |  |  |  |  | sub get_palette { | 
| 421 |  |  |  |  |  |  | my $self = shift; | 
| 422 |  |  |  |  |  |  | my @result; | 
| 423 |  |  |  |  |  |  | if ($#_ >= 0) { | 
| 424 |  |  |  |  |  |  | for (@_) { push( @result, $self->[PALETTE]->{$_}->[PAL_DESC] ); } | 
| 425 |  |  |  |  |  |  | return @result; | 
| 426 |  |  |  |  |  |  | } | 
| 427 |  |  |  |  |  |  | else { | 
| 428 |  |  |  |  |  |  | for my $key (keys %{$self->[PALETTE]}) { | 
| 429 |  |  |  |  |  |  | push( @result, $key, $self->[PALETTE]->{$key}->[PAL_DESC]); | 
| 430 |  |  |  |  |  |  | } | 
| 431 |  |  |  |  |  |  | return @result; | 
| 432 |  |  |  |  |  |  | } | 
| 433 |  |  |  |  |  |  |  | 
| 434 |  |  |  |  |  |  | } | 
| 435 |  |  |  |  |  |  |  | 
| 436 |  |  |  |  |  |  | ### set the palette for a window | 
| 437 |  |  |  |  |  |  |  | 
| 438 |  |  |  |  |  |  | sub set_palette { | 
| 439 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter set_palette\n"; } | 
| 440 |  |  |  |  |  |  | my $self = shift; | 
| 441 |  |  |  |  |  |  | if (DEBUG) { print ERRS "palette needs an even number of parameters\n" if @_ & 1; } | 
| 442 |  |  |  |  |  |  | croak "palette needs an even number of parameters" if @_ & 1; | 
| 443 |  |  |  |  |  |  | my %params = @_; | 
| 444 |  |  |  |  |  |  | _set_color($self, %params); | 
| 445 |  |  |  |  |  |  | } | 
| 446 |  |  |  |  |  |  |  | 
| 447 |  |  |  |  |  |  | sub get_window_name { | 
| 448 |  |  |  |  |  |  | my $self = shift; | 
| 449 |  |  |  |  |  |  | my $id = shift; | 
| 450 |  |  |  |  |  |  | if ($id =~ /^\d+$/) { | 
| 451 |  |  |  |  |  |  | return $self->[WINDOW]->{$id}->{Window_Name}; | 
| 452 |  |  |  |  |  |  | } | 
| 453 |  |  |  |  |  |  | else { | 
| 454 |  |  |  |  |  |  | if (DEBUG) { print ERRS "$id is not a Window ID\n"; } | 
| 455 |  |  |  |  |  |  | croak "$id is not a Window ID"; | 
| 456 |  |  |  |  |  |  | } | 
| 457 |  |  |  |  |  |  | } | 
| 458 |  |  |  |  |  |  |  | 
| 459 |  |  |  |  |  |  | sub get_window_id { | 
| 460 |  |  |  |  |  |  | my $self = shift; | 
| 461 |  |  |  |  |  |  | my $query = shift; | 
| 462 |  |  |  |  |  |  | my $validity = validate_window($self, $query); | 
| 463 |  |  |  |  |  |  | if ($validity) { | 
| 464 |  |  |  |  |  |  | return $self->[WINDOW_REV]->{$query}; | 
| 465 |  |  |  |  |  |  | } | 
| 466 |  |  |  |  |  |  | else { | 
| 467 |  |  |  |  |  |  | if (DEBUG) { print ERRS "$query is not a Window Name\n"; } | 
| 468 |  |  |  |  |  |  | croak "$query is not a Window Name"; | 
| 469 |  |  |  |  |  |  | } | 
| 470 |  |  |  |  |  |  | } | 
| 471 |  |  |  |  |  |  |  | 
| 472 |  |  |  |  |  |  | ### set the Title for a Window. | 
| 473 |  |  |  |  |  |  |  | 
| 474 |  |  |  |  |  |  | sub set_title { | 
| 475 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter set_title\n"; } | 
| 476 |  |  |  |  |  |  | my $self = shift; | 
| 477 |  |  |  |  |  |  | my ($window_id, $title) = @_; | 
| 478 |  |  |  |  |  |  | my $validity = validate_window($self, $window_id); | 
| 479 |  |  |  |  |  |  | if ($validity) { | 
| 480 |  |  |  |  |  |  | $self->[WINDOW]->{$window_id}->{Title} = $title; | 
| 481 |  |  |  |  |  |  | if ($window_id == $self->[CUR_WIN]) { | 
| 482 |  |  |  |  |  |  | _refresh_title( $self, $window_id ); | 
| 483 |  |  |  |  |  |  | doupdate(); | 
| 484 |  |  |  |  |  |  | } | 
| 485 |  |  |  |  |  |  | } | 
| 486 |  |  |  |  |  |  | else { | 
| 487 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Window $window_id is nonexistant\n"; } | 
| 488 |  |  |  |  |  |  | croak "Window $window_id is nonexistant"; | 
| 489 |  |  |  |  |  |  | } | 
| 490 |  |  |  |  |  |  | } | 
| 491 |  |  |  |  |  |  |  | 
| 492 |  |  |  |  |  |  | ### get the Title for a Window. | 
| 493 |  |  |  |  |  |  |  | 
| 494 |  |  |  |  |  |  | sub get_title { | 
| 495 |  |  |  |  |  |  | my $self = shift; | 
| 496 |  |  |  |  |  |  | my $window_id = shift; | 
| 497 |  |  |  |  |  |  | my $validity = validate_window($self, $window_id); | 
| 498 |  |  |  |  |  |  | if ($validity) { | 
| 499 |  |  |  |  |  |  | return $self->[WINDOW]->{$window_id}->{Title}; | 
| 500 |  |  |  |  |  |  | } | 
| 501 |  |  |  |  |  |  | else { | 
| 502 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Window $window_id is nonexistant\n"; } | 
| 503 |  |  |  |  |  |  | croak "Window $window_id is nonexistant"; | 
| 504 |  |  |  |  |  |  | } | 
| 505 |  |  |  |  |  |  | } | 
| 506 |  |  |  |  |  |  |  | 
| 507 |  |  |  |  |  |  | ### print lines to window | 
| 508 |  |  |  |  |  |  | ### a window_id must be given as the first argument. | 
| 509 |  |  |  |  |  |  |  | 
| 510 |  |  |  |  |  |  | sub print { | 
| 511 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter print\n"; } | 
| 512 |  |  |  |  |  |  | my $self = shift; | 
| 513 |  |  |  |  |  |  | my $window_id = shift; | 
| 514 |  |  |  |  |  |  | if (!validate_window($self, $window_id)) { | 
| 515 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Can't print to nonexistant Window $window_id\n"; } | 
| 516 |  |  |  |  |  |  | croak "Can't print to nonexistant Window $window_id"; | 
| 517 |  |  |  |  |  |  | } | 
| 518 |  |  |  |  |  |  |  | 
| 519 |  |  |  |  |  |  | my @lines; | 
| 520 |  |  |  |  |  |  | foreach my $l (@_) { | 
| 521 |  |  |  |  |  |  | foreach my $ll (split(/\n/,$l)) { | 
| 522 |  |  |  |  |  |  | $ll =~ s/\r//g; | 
| 523 |  |  |  |  |  |  | push(@lines,$ll); | 
| 524 |  |  |  |  |  |  | } | 
| 525 |  |  |  |  |  |  | } | 
| 526 |  |  |  |  |  |  |  | 
| 527 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$window_id}; | 
| 528 |  |  |  |  |  |  |  | 
| 529 |  |  |  |  |  |  | foreach (@lines) { | 
| 530 |  |  |  |  |  |  |  | 
| 531 |  |  |  |  |  |  | # Start a new line in the scrollback buffer. | 
| 532 |  |  |  |  |  |  |  | 
| 533 |  |  |  |  |  |  | push @{$winref->{Buffer}}, ""; | 
| 534 |  |  |  |  |  |  | $winref->{Scrolled_Lines}++; | 
| 535 |  |  |  |  |  |  | my $column = 1; | 
| 536 |  |  |  |  |  |  |  | 
| 537 |  |  |  |  |  |  | # Build a scrollback line.  Stuff surrounded by \0() does not take | 
| 538 |  |  |  |  |  |  | # up screen space, so account for that while wrapping lines. | 
| 539 |  |  |  |  |  |  |  | 
| 540 |  |  |  |  |  |  | my $last_color = "\0(ncolor)"; | 
| 541 |  |  |  |  |  |  | while (length) { | 
| 542 |  |  |  |  |  |  |  | 
| 543 |  |  |  |  |  |  | # Unprintable color codes. | 
| 544 |  |  |  |  |  |  | if (s/^(\0\([^\)]+\))//) { | 
| 545 |  |  |  |  |  |  | $winref->{Buffer}->[-1] .= $last_color = $1; | 
| 546 |  |  |  |  |  |  | next; | 
| 547 |  |  |  |  |  |  | } | 
| 548 |  |  |  |  |  |  |  | 
| 549 |  |  |  |  |  |  | # Wordwrap visible stuff. | 
| 550 |  |  |  |  |  |  | if (s/^([^\0]+)//) { | 
| 551 |  |  |  |  |  |  | my @words = split /(\s+)/, $1; | 
| 552 |  |  |  |  |  |  | foreach my $word (@words) { | 
| 553 |  |  |  |  |  |  | unless (defined $word) { | 
| 554 |  |  |  |  |  |  | warn "undefined word"; | 
| 555 |  |  |  |  |  |  | next; | 
| 556 |  |  |  |  |  |  | } | 
| 557 |  |  |  |  |  |  |  | 
| 558 |  |  |  |  |  |  | while ($column + length($word) >= $COLS) { | 
| 559 |  |  |  |  |  |  | # maybe this word length should be configurable | 
| 560 |  |  |  |  |  |  | if (length($word) > 20) { | 
| 561 |  |  |  |  |  |  | # save the word | 
| 562 |  |  |  |  |  |  | my $preword = $word; | 
| 563 |  |  |  |  |  |  | # shorten the word to the end of the line | 
| 564 |  |  |  |  |  |  | $word = substr($word,0,($COLS - $column)); | 
| 565 |  |  |  |  |  |  | # add the word | 
| 566 |  |  |  |  |  |  | $winref->{Buffer}->[-1] .= "$word\0(ncolor)"; | 
| 567 |  |  |  |  |  |  | $word = ''; | 
| 568 |  |  |  |  |  |  |  | 
| 569 |  |  |  |  |  |  | # put the last color on the next line and wrap | 
| 570 |  |  |  |  |  |  | push @{$winref->{Buffer}}, $last_color; | 
| 571 |  |  |  |  |  |  | $winref->{Scrolled_Lines}++; | 
| 572 |  |  |  |  |  |  | # slice the unmodified word | 
| 573 |  |  |  |  |  |  | $word = substr($preword,($COLS - $column)); | 
| 574 |  |  |  |  |  |  | $column = 1; | 
| 575 |  |  |  |  |  |  | next; | 
| 576 |  |  |  |  |  |  | } else { | 
| 577 |  |  |  |  |  |  | $winref->{Buffer}->[-1] .= "\0(ncolor)"; | 
| 578 |  |  |  |  |  |  | push @{$winref->{Buffer}}, $last_color; | 
| 579 |  |  |  |  |  |  | } | 
| 580 |  |  |  |  |  |  | $winref->{Scrolled_Lines}++; | 
| 581 |  |  |  |  |  |  | $column = 1; | 
| 582 |  |  |  |  |  |  | next if $word =~ /^\s+$/; | 
| 583 |  |  |  |  |  |  | } | 
| 584 |  |  |  |  |  |  | $winref->{Buffer}->[-1] .= $word; | 
| 585 |  |  |  |  |  |  | $column += length($word); | 
| 586 |  |  |  |  |  |  | $word = ''; | 
| 587 |  |  |  |  |  |  | } | 
| 588 |  |  |  |  |  |  | } | 
| 589 |  |  |  |  |  |  | } | 
| 590 |  |  |  |  |  |  | } | 
| 591 |  |  |  |  |  |  |  | 
| 592 |  |  |  |  |  |  | # Keep the scrollback buffer a tidy length. | 
| 593 |  |  |  |  |  |  | splice(@{$winref->{Buffer}}, 0, @{$winref->{Buffer}} - $winref->{Buffer_Size}) | 
| 594 |  |  |  |  |  |  | if @{$winref->{Buffer}} > $winref->{Buffer_Size}; | 
| 595 |  |  |  |  |  |  |  | 
| 596 |  |  |  |  |  |  | # Refresh the buffer when it's all done. | 
| 597 |  |  |  |  |  |  | if ($self->[CUR_WIN] == $window_id) { | 
| 598 |  |  |  |  |  |  | _refresh_buffer($self, $window_id); | 
| 599 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 600 |  |  |  |  |  |  | doupdate(); | 
| 601 |  |  |  |  |  |  | } | 
| 602 |  |  |  |  |  |  | } | 
| 603 |  |  |  |  |  |  |  | 
| 604 |  |  |  |  |  |  | ## Register key bindings | 
| 605 |  |  |  |  |  |  |  | 
| 606 |  |  |  |  |  |  | sub bind { | 
| 607 |  |  |  |  |  |  | my $self = shift; | 
| 608 |  |  |  |  |  |  | carp "invalid arugments to ->bindings()" if @_ & 1; | 
| 609 |  |  |  |  |  |  | my %bindings = @_; | 
| 610 |  |  |  |  |  |  | for (keys %bindings) { | 
| 611 |  |  |  |  |  |  | my $key = _parse_key($_) | 
| 612 |  |  |  |  |  |  | or carp "Invalid escape sequence $_"; | 
| 613 |  |  |  |  |  |  | $self->[BINDINGS]{$key} = $bindings{$_}; | 
| 614 |  |  |  |  |  |  | } | 
| 615 |  |  |  |  |  |  | } | 
| 616 |  |  |  |  |  |  |  | 
| 617 |  |  |  |  |  |  | ## UnRegister key bindings | 
| 618 |  |  |  |  |  |  |  | 
| 619 |  |  |  |  |  |  | sub unbind { | 
| 620 |  |  |  |  |  |  | my $self = shift; | 
| 621 |  |  |  |  |  |  | for (@_) { | 
| 622 |  |  |  |  |  |  | my $key = _parse_key($_) | 
| 623 |  |  |  |  |  |  | or carp "Invalid escape sequence $_"; | 
| 624 |  |  |  |  |  |  | delete $self->[BINDINGS]{$key}; | 
| 625 |  |  |  |  |  |  | } | 
| 626 |  |  |  |  |  |  | } | 
| 627 |  |  |  |  |  |  |  | 
| 628 |  |  |  |  |  |  | sub _parse_key { | 
| 629 |  |  |  |  |  |  | my ($key) = @_; | 
| 630 |  |  |  |  |  |  | my $esc = ''; | 
| 631 |  |  |  |  |  |  | while ($key =~ s/^(A(?:lt)|C(?:trl)?)-//i) { | 
| 632 |  |  |  |  |  |  | my $in = uc $1; | 
| 633 |  |  |  |  |  |  | if (substr($in, 0, 1) eq 'C') { | 
| 634 |  |  |  |  |  |  | $esc .= '^' | 
| 635 |  |  |  |  |  |  | } | 
| 636 |  |  |  |  |  |  | elsif (substr($in, 0, 1) eq 'A') { | 
| 637 |  |  |  |  |  |  | $esc .= '^['; | 
| 638 |  |  |  |  |  |  | } | 
| 639 |  |  |  |  |  |  | else { | 
| 640 |  |  |  |  |  |  | die "We should not get here: $_"; | 
| 641 |  |  |  |  |  |  | } | 
| 642 |  |  |  |  |  |  | } | 
| 643 |  |  |  |  |  |  |  | 
| 644 |  |  |  |  |  |  | if (length($key) == 1) { | 
| 645 |  |  |  |  |  |  | return $esc . $key; | 
| 646 |  |  |  |  |  |  | } | 
| 647 |  |  |  |  |  |  | else { | 
| 648 |  |  |  |  |  |  | return $esc . "KEY_" . uc($key); | 
| 649 |  |  |  |  |  |  | } | 
| 650 |  |  |  |  |  |  | } | 
| 651 |  |  |  |  |  |  |  | 
| 652 |  |  |  |  |  |  | ### Register an input handler thing. | 
| 653 |  |  |  |  |  |  |  | 
| 654 |  |  |  |  |  |  | sub register_input { | 
| 655 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter register_input\n"; } | 
| 656 |  |  |  |  |  |  | my ($kernel, $heap, $sender, $event) = @_[KERNEL, HEAP, SENDER, ARG0]; | 
| 657 |  |  |  |  |  |  |  | 
| 658 |  |  |  |  |  |  | # Remember the remote session and the event it wants to receive with | 
| 659 |  |  |  |  |  |  | # input.  This saves the sender's ID (instead of a reference) | 
| 660 |  |  |  |  |  |  | # because references mess with Perl's garbage collection. | 
| 661 |  |  |  |  |  |  |  | 
| 662 |  |  |  |  |  |  | $heap->{input_session} = $sender->ID(); | 
| 663 |  |  |  |  |  |  | $heap->{input_event}   = $event; | 
| 664 |  |  |  |  |  |  |  | 
| 665 |  |  |  |  |  |  | # Increase the sender's reference count so the session stays alive | 
| 666 |  |  |  |  |  |  | # while the terminal is active.  We'll decrease the reference count | 
| 667 |  |  |  |  |  |  | # in _stop so it can go away when the terminal does. | 
| 668 |  |  |  |  |  |  |  | 
| 669 |  |  |  |  |  |  | $kernel->refcount_increment( $sender->ID(), "terminal link" ); | 
| 670 |  |  |  |  |  |  |  | 
| 671 |  |  |  |  |  |  | } | 
| 672 |  |  |  |  |  |  |  | 
| 673 |  |  |  |  |  |  | ### Get input from the Curses thing. | 
| 674 |  |  |  |  |  |  |  | 
| 675 |  |  |  |  |  |  | sub got_curses_input { | 
| 676 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter got_curses_input\n"; } | 
| 677 |  |  |  |  |  |  | my ($self, $kernel, $heap, $key) = @_[OBJECT, KERNEL, HEAP, ARG0]; | 
| 678 |  |  |  |  |  |  |  | 
| 679 |  |  |  |  |  |  | my $window_id = $self->[CUR_WIN]; | 
| 680 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$window_id}; | 
| 681 |  |  |  |  |  |  | $key = uc(keyname($key)) if $key =~ /^\d{2,}$/; | 
| 682 |  |  |  |  |  |  | $key = uc(unctrl($key))  if $key lt " " or $key gt "~"; | 
| 683 |  |  |  |  |  |  |  | 
| 684 |  |  |  |  |  |  | # If it's a meta key, save it. | 
| 685 |  |  |  |  |  |  | if ($key eq '^[') { | 
| 686 |  |  |  |  |  |  | $winref->{Input}{Prefix} .= $key; | 
| 687 |  |  |  |  |  |  | return; | 
| 688 |  |  |  |  |  |  | } | 
| 689 |  |  |  |  |  |  |  | 
| 690 |  |  |  |  |  |  | # If there was a saved prefix, recall it. | 
| 691 |  |  |  |  |  |  | if ($winref->{Input}{Prefix}) { | 
| 692 |  |  |  |  |  |  | $key = $winref->{Input}{Prefix} . $key; | 
| 693 |  |  |  |  |  |  | $winref->{Input}{Prefix} = ''; | 
| 694 |  |  |  |  |  |  | } | 
| 695 |  |  |  |  |  |  |  | 
| 696 |  |  |  |  |  |  | ### Handle internal keystrokes here.  Page up, down, arrow keys, etc. | 
| 697 |  |  |  |  |  |  |  | 
| 698 |  |  |  |  |  |  | # key bindings | 
| 699 |  |  |  |  |  |  | if (exists $self->[BINDINGS]{$key} and $heap->{input_session}) { | 
| 700 |  |  |  |  |  |  | $kernel->post( $heap->{input_session}, $self->[BINDINGS]{$key}, | 
| 701 |  |  |  |  |  |  | $key, $winref, $window_id | 
| 702 |  |  |  |  |  |  | ); | 
| 703 |  |  |  |  |  |  | return; | 
| 704 |  |  |  |  |  |  | } | 
| 705 |  |  |  |  |  |  |  | 
| 706 |  |  |  |  |  |  | # Beginning of line. | 
| 707 |  |  |  |  |  |  | if ($key eq '^A' or $key eq 'KEY_HOME') { | 
| 708 |  |  |  |  |  |  | if ($winref->{Input}{Cursor}) { | 
| 709 |  |  |  |  |  |  | if ($winref->{Input}{Prompt_Size}) { | 
| 710 |  |  |  |  |  |  | $winref->{Input}{Cursor} = $winref->{Input}{Prompt_Size}; | 
| 711 |  |  |  |  |  |  | } else { | 
| 712 |  |  |  |  |  |  | $winref->{Input}{Cursor} = 0; | 
| 713 |  |  |  |  |  |  | } | 
| 714 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 715 |  |  |  |  |  |  | doupdate(); | 
| 716 |  |  |  |  |  |  | } | 
| 717 |  |  |  |  |  |  | return; | 
| 718 |  |  |  |  |  |  | } | 
| 719 |  |  |  |  |  |  |  | 
| 720 |  |  |  |  |  |  | # Back one character. | 
| 721 |  |  |  |  |  |  | if ($key eq 'KEY_LEFT') { | 
| 722 |  |  |  |  |  |  | if ($winref->{Input}{Cursor}) { | 
| 723 |  |  |  |  |  |  | if($winref->{Input}{Prompt}) { | 
| 724 |  |  |  |  |  |  | if($winref->{Input}{Cursor} > $winref->{Input}{Prompt_Size}) { | 
| 725 |  |  |  |  |  |  | $winref->{Input}{Cursor}--; | 
| 726 |  |  |  |  |  |  | } | 
| 727 |  |  |  |  |  |  | } else { | 
| 728 |  |  |  |  |  |  | $winref->{Input}{Cursor}--; | 
| 729 |  |  |  |  |  |  | } | 
| 730 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 731 |  |  |  |  |  |  | doupdate(); | 
| 732 |  |  |  |  |  |  | } | 
| 733 |  |  |  |  |  |  | return; | 
| 734 |  |  |  |  |  |  | } | 
| 735 |  |  |  |  |  |  | if (DEBUG) { print ERRS $key, "\n"; } | 
| 736 |  |  |  |  |  |  | # Switch Windows to the left  Shifted left arrow | 
| 737 |  |  |  |  |  |  | #FIXME come up with a better fix. KEY_LEFT didnt work for me. | 
| 738 |  |  |  |  |  |  | if ($key eq 'ð' or $key eq '^[KEY_LEFT') { | 
| 739 |  |  |  |  |  |  | $window_id--; | 
| 740 |  |  |  |  |  |  | change_window($self, $window_id ); | 
| 741 |  |  |  |  |  |  | return; | 
| 742 |  |  |  |  |  |  | } | 
| 743 |  |  |  |  |  |  |  | 
| 744 |  |  |  |  |  |  | # Switch Windows to the right  Shifted right arrow | 
| 745 |  |  |  |  |  |  | #FIXME come up with a better fix. KEY_RIGHT didnt work for me. | 
| 746 |  |  |  |  |  |  | if ($key eq 'î' or $key eq '^[KEY_RIGHT') { | 
| 747 |  |  |  |  |  |  | $window_id++; | 
| 748 |  |  |  |  |  |  | change_window($self, $window_id ); | 
| 749 |  |  |  |  |  |  | return; | 
| 750 |  |  |  |  |  |  | } | 
| 751 |  |  |  |  |  |  |  | 
| 752 |  |  |  |  |  |  | # Interrupt. | 
| 753 |  |  |  |  |  |  | if ($key eq '^\\') { | 
| 754 |  |  |  |  |  |  |  | 
| 755 |  |  |  |  |  |  | $kernel->alias_remove($self->[ALIAS]); | 
| 756 |  |  |  |  |  |  | delete $heap->{stderr_reader}; | 
| 757 |  |  |  |  |  |  | undef $console; | 
| 758 |  |  |  |  |  |  | if (defined $heap->{input_session}) { | 
| 759 |  |  |  |  |  |  | delete $heap->{input_session}; | 
| 760 |  |  |  |  |  |  | } | 
| 761 |  |  |  |  |  |  | $kernel->signal($kernel, "UIDESTROY"); | 
| 762 |  |  |  |  |  |  | return; | 
| 763 |  |  |  |  |  |  | } | 
| 764 |  |  |  |  |  |  |  | 
| 765 |  |  |  |  |  |  | # Delete a character. | 
| 766 |  |  |  |  |  |  | if ($key eq '^D' or $key eq 'KEY_DC') { | 
| 767 |  |  |  |  |  |  | my $csize = $winref->{Input}{Cursor} - $winref->{Input}{Prompt_Size}; | 
| 768 |  |  |  |  |  |  | if ($csize < length($winref->{Input}{Data})) { | 
| 769 |  |  |  |  |  |  | substr($winref->{Input}{Data}, $winref->{Input}{Cursor} - $winref->{Input}{Prompt_Size}, 1) = ''; | 
| 770 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 771 |  |  |  |  |  |  | doupdate(); | 
| 772 |  |  |  |  |  |  | } | 
| 773 |  |  |  |  |  |  | return; | 
| 774 |  |  |  |  |  |  | } | 
| 775 |  |  |  |  |  |  |  | 
| 776 |  |  |  |  |  |  | # End of line. | 
| 777 |  |  |  |  |  |  | if ($key eq '^E' or $key eq 'KEY_LL') { | 
| 778 |  |  |  |  |  |  | if ($winref->{Input}{Cursor} < length($winref->{Input}{Data})) { | 
| 779 |  |  |  |  |  |  | $winref->{Input}{Cursor} = length($winref->{Input}{Data}); | 
| 780 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 781 |  |  |  |  |  |  | doupdate(); | 
| 782 |  |  |  |  |  |  | } | 
| 783 |  |  |  |  |  |  | return; | 
| 784 |  |  |  |  |  |  | } | 
| 785 |  |  |  |  |  |  |  | 
| 786 |  |  |  |  |  |  | # Forward character. | 
| 787 |  |  |  |  |  |  | if ($key eq '^F' or $key eq 'KEY_RIGHT') { | 
| 788 |  |  |  |  |  |  | if (($winref->{Input}{Cursor} - $winref->{Input}{Prompt_Size}) < length($winref->{Input}{Data})) { | 
| 789 |  |  |  |  |  |  | $winref->{Input}{Cursor}++; | 
| 790 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 791 |  |  |  |  |  |  | doupdate(); | 
| 792 |  |  |  |  |  |  | } | 
| 793 |  |  |  |  |  |  | return; | 
| 794 |  |  |  |  |  |  | } | 
| 795 |  |  |  |  |  |  |  | 
| 796 |  |  |  |  |  |  | # Backward delete character. | 
| 797 |  |  |  |  |  |  | if ($key eq '^H' or $key eq "^?" or $key eq 'KEY_BACKSPACE') { | 
| 798 |  |  |  |  |  |  | if ($winref->{Input}{Cursor}) { | 
| 799 |  |  |  |  |  |  | if ($winref->{Input}{Cursor} > ($winref->{Input}{Prompt_Size} )) { | 
| 800 |  |  |  |  |  |  | $winref->{Input}{Cursor}--; | 
| 801 |  |  |  |  |  |  | substr($winref->{Input}{Data}, $winref->{Input}{Cursor} - $winref->{Input}{Prompt_Size}, 1) = ''; | 
| 802 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 803 |  |  |  |  |  |  | doupdate(); | 
| 804 |  |  |  |  |  |  | } | 
| 805 |  |  |  |  |  |  | } | 
| 806 |  |  |  |  |  |  | return; | 
| 807 |  |  |  |  |  |  | } | 
| 808 |  |  |  |  |  |  |  | 
| 809 |  |  |  |  |  |  | # Accept line. | 
| 810 |  |  |  |  |  |  | if ($key eq '^J' or $key eq '^M') { | 
| 811 |  |  |  |  |  |  | $kernel->post( $heap->{input_session}, $heap->{input_event}, | 
| 812 |  |  |  |  |  |  | $winref->{Input}{Data}, undef | 
| 813 |  |  |  |  |  |  | ); | 
| 814 |  |  |  |  |  |  |  | 
| 815 |  |  |  |  |  |  | # And enter the line into the command history. | 
| 816 |  |  |  |  |  |  | command_history( $self, $window_id, 0 ); | 
| 817 |  |  |  |  |  |  | return; | 
| 818 |  |  |  |  |  |  | } | 
| 819 |  |  |  |  |  |  |  | 
| 820 |  |  |  |  |  |  | # Kill to EOL. | 
| 821 |  |  |  |  |  |  | if ($key eq '^K') { | 
| 822 |  |  |  |  |  |  | if ($winref->{Input}{Cursor} < length($winref->{Input}{Data})) { | 
| 823 |  |  |  |  |  |  | substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) = ''; | 
| 824 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 825 |  |  |  |  |  |  | doupdate(); | 
| 826 |  |  |  |  |  |  | } | 
| 827 |  |  |  |  |  |  | return; | 
| 828 |  |  |  |  |  |  | } | 
| 829 |  |  |  |  |  |  |  | 
| 830 |  |  |  |  |  |  | # Refresh screen. | 
| 831 |  |  |  |  |  |  | if ($key eq '^L' or $key eq 'KEY_RESIZE') { | 
| 832 |  |  |  |  |  |  |  | 
| 833 |  |  |  |  |  |  | # Refresh the title line. | 
| 834 |  |  |  |  |  |  | _refresh_title($self, $window_id); | 
| 835 |  |  |  |  |  |  |  | 
| 836 |  |  |  |  |  |  | # Refresh the status lines. | 
| 837 |  |  |  |  |  |  | _refresh_status( $self, $window_id); | 
| 838 |  |  |  |  |  |  |  | 
| 839 |  |  |  |  |  |  | # Refresh the buffer. | 
| 840 |  |  |  |  |  |  | _refresh_buffer($self, $window_id); | 
| 841 |  |  |  |  |  |  |  | 
| 842 |  |  |  |  |  |  | # Refresh the edit line. | 
| 843 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 844 |  |  |  |  |  |  |  | 
| 845 |  |  |  |  |  |  | # Flush updates. | 
| 846 |  |  |  |  |  |  | doupdate(); | 
| 847 |  |  |  |  |  |  |  | 
| 848 |  |  |  |  |  |  | return; | 
| 849 |  |  |  |  |  |  | } | 
| 850 |  |  |  |  |  |  |  | 
| 851 |  |  |  |  |  |  | # Next in history. | 
| 852 |  |  |  |  |  |  | if ($key eq '^N'  ) { | 
| 853 |  |  |  |  |  |  | command_history( $self, $window_id, 2 ); | 
| 854 |  |  |  |  |  |  | return; | 
| 855 |  |  |  |  |  |  | } | 
| 856 |  |  |  |  |  |  |  | 
| 857 |  |  |  |  |  |  | # Previous in history. | 
| 858 |  |  |  |  |  |  | if ($key eq '^P' ) { | 
| 859 |  |  |  |  |  |  | command_history( $self, $window_id, 1 ); | 
| 860 |  |  |  |  |  |  | return; | 
| 861 |  |  |  |  |  |  | } | 
| 862 |  |  |  |  |  |  |  | 
| 863 |  |  |  |  |  |  | # Display input status. | 
| 864 |  |  |  |  |  |  | if ($key eq '^Q') { | 
| 865 |  |  |  |  |  |  | &print( $self, $window_id,  # <- can I do this better? | 
| 866 |  |  |  |  |  |  | "\0(statcolor)******", | 
| 867 |  |  |  |  |  |  | "\0(statcolor)*** cursor is at $winref->{Input}{Cursor}", | 
| 868 |  |  |  |  |  |  | "\0(statcolor)*** input is: ``$winref->{Input}{Data}''", | 
| 869 |  |  |  |  |  |  | "\0(statcolor)*** scrolled lines: $winref->{Scrolled_Lines}", | 
| 870 |  |  |  |  |  |  | "\0(statcolor)*** screen height: " . $winref->{Screen_Height}, | 
| 871 |  |  |  |  |  |  | "\0(statcolor)*** buffer row: $winref->{Buffer_Row}", | 
| 872 |  |  |  |  |  |  | "\0(statcolor)*** scrollback height: " . scalar(@{$winref->{Buffer}}), | 
| 873 |  |  |  |  |  |  | "\0(statcolor)******" | 
| 874 |  |  |  |  |  |  | ); | 
| 875 |  |  |  |  |  |  | return; | 
| 876 |  |  |  |  |  |  | } | 
| 877 |  |  |  |  |  |  |  | 
| 878 |  |  |  |  |  |  | # Transpose characters. | 
| 879 |  |  |  |  |  |  | if ($key eq '^T') { | 
| 880 |  |  |  |  |  |  | if ($winref->{Input}{Cursor} > 0 and $winref->{Input}{Cursor} < length($winref->{Input}{Data})) { | 
| 881 |  |  |  |  |  |  | substr($winref->{Input}{Data}, $winref->{Input}{Cursor}-1, 2) = | 
| 882 |  |  |  |  |  |  | reverse substr($winref->{Input}{Data}, $winref->{Input}{Cursor}-1, 2); | 
| 883 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 884 |  |  |  |  |  |  | doupdate(); | 
| 885 |  |  |  |  |  |  | } | 
| 886 |  |  |  |  |  |  | return; | 
| 887 |  |  |  |  |  |  | } | 
| 888 |  |  |  |  |  |  |  | 
| 889 |  |  |  |  |  |  | # Discard line. | 
| 890 |  |  |  |  |  |  | if ($key eq '^U') { | 
| 891 |  |  |  |  |  |  | if (length($winref->{Input}{Data})) { | 
| 892 |  |  |  |  |  |  | $winref->{Input}{Data} = ''; | 
| 893 |  |  |  |  |  |  | $winref->{Input}{Cursor} = 0; | 
| 894 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 895 |  |  |  |  |  |  | doupdate(); | 
| 896 |  |  |  |  |  |  | } | 
| 897 |  |  |  |  |  |  | return; | 
| 898 |  |  |  |  |  |  | } | 
| 899 |  |  |  |  |  |  |  | 
| 900 |  |  |  |  |  |  | # Word rubout. | 
| 901 |  |  |  |  |  |  | if ($key eq '^W' or $key eq '^[^H') { | 
| 902 |  |  |  |  |  |  | if ($winref->{Input}{Cursor}) { | 
| 903 |  |  |  |  |  |  | substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}) =~ s/(\S*\s*)$//; | 
| 904 |  |  |  |  |  |  | $winref->{Input}{Cursor} -= length($1); | 
| 905 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 906 |  |  |  |  |  |  | doupdate(); | 
| 907 |  |  |  |  |  |  | } | 
| 908 |  |  |  |  |  |  | return; | 
| 909 |  |  |  |  |  |  | } | 
| 910 |  |  |  |  |  |  |  | 
| 911 |  |  |  |  |  |  | # First in history. | 
| 912 |  |  |  |  |  |  | if ($key eq '^[<') { | 
| 913 |  |  |  |  |  |  | # TODO | 
| 914 |  |  |  |  |  |  | return; | 
| 915 |  |  |  |  |  |  | } | 
| 916 |  |  |  |  |  |  |  | 
| 917 |  |  |  |  |  |  | # Last in history. | 
| 918 |  |  |  |  |  |  | if ($key eq '^[>') { | 
| 919 |  |  |  |  |  |  | # TODO | 
| 920 |  |  |  |  |  |  | return; | 
| 921 |  |  |  |  |  |  | } | 
| 922 |  |  |  |  |  |  |  | 
| 923 |  |  |  |  |  |  | # Capitalize from cursor on.  Requires uc($key) | 
| 924 |  |  |  |  |  |  | if (uc($key) eq '^[C') { | 
| 925 |  |  |  |  |  |  |  | 
| 926 |  |  |  |  |  |  | # If there's text to capitalize. | 
| 927 |  |  |  |  |  |  | if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\s*)(\S+)/) { | 
| 928 |  |  |  |  |  |  |  | 
| 929 |  |  |  |  |  |  | # Track leading space, and uppercase word. | 
| 930 |  |  |  |  |  |  | my $space = $1; $space = '' unless defined $space; | 
| 931 |  |  |  |  |  |  | my $word  = ucfirst(lc($2)); | 
| 932 |  |  |  |  |  |  |  | 
| 933 |  |  |  |  |  |  | # Replace text with the uppercase version. | 
| 934 |  |  |  |  |  |  | substr( $winref->{Input}{Data}, | 
| 935 |  |  |  |  |  |  | $winref->{Input}{Cursor} + length($space), length($word) | 
| 936 |  |  |  |  |  |  | ) = $word; | 
| 937 |  |  |  |  |  |  |  | 
| 938 |  |  |  |  |  |  | $winref->{Input}{Cursor} += length($space . $word); | 
| 939 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 940 |  |  |  |  |  |  | doupdate(); | 
| 941 |  |  |  |  |  |  | } | 
| 942 |  |  |  |  |  |  | return; | 
| 943 |  |  |  |  |  |  | } | 
| 944 |  |  |  |  |  |  |  | 
| 945 |  |  |  |  |  |  | # Uppercase from cursor on.  Requires uc($key) | 
| 946 |  |  |  |  |  |  | if (uc($key) eq '^[U') { | 
| 947 |  |  |  |  |  |  |  | 
| 948 |  |  |  |  |  |  | # If there's text to uppercase. | 
| 949 |  |  |  |  |  |  | if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\s*)(\S+)/) { | 
| 950 |  |  |  |  |  |  |  | 
| 951 |  |  |  |  |  |  | # Track leading space, and uppercase word. | 
| 952 |  |  |  |  |  |  | my $space = $1; $space = '' unless defined $space; | 
| 953 |  |  |  |  |  |  | my $word  = uc($2); | 
| 954 |  |  |  |  |  |  |  | 
| 955 |  |  |  |  |  |  | # Replace text with the uppercase version. | 
| 956 |  |  |  |  |  |  | substr( $winref->{Input}{Data}, | 
| 957 |  |  |  |  |  |  | $winref->{Input}{Cursor} + length($space), length($word) | 
| 958 |  |  |  |  |  |  | ) = $word; | 
| 959 |  |  |  |  |  |  |  | 
| 960 |  |  |  |  |  |  | $winref->{Input}{Cursor} += length($space . $word); | 
| 961 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 962 |  |  |  |  |  |  | doupdate(); | 
| 963 |  |  |  |  |  |  | } | 
| 964 |  |  |  |  |  |  | return; | 
| 965 |  |  |  |  |  |  | } | 
| 966 |  |  |  |  |  |  |  | 
| 967 |  |  |  |  |  |  | # Lowercase from cursor on.  Requires uc($key) | 
| 968 |  |  |  |  |  |  | if (uc($key) eq '^[L') { | 
| 969 |  |  |  |  |  |  |  | 
| 970 |  |  |  |  |  |  | # If there's text to uppercase. | 
| 971 |  |  |  |  |  |  | if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\s*)(\S+)/) { | 
| 972 |  |  |  |  |  |  |  | 
| 973 |  |  |  |  |  |  | # Track leading space, and uppercase word. | 
| 974 |  |  |  |  |  |  | my $space = $1; $space = '' unless defined $space; | 
| 975 |  |  |  |  |  |  | my $word  = lc($2); | 
| 976 |  |  |  |  |  |  |  | 
| 977 |  |  |  |  |  |  | # Replace text with the uppercase version. | 
| 978 |  |  |  |  |  |  | substr( $winref->{Input}{Data}, | 
| 979 |  |  |  |  |  |  | $winref->{Input}{Cursor} + length($space), length($word) | 
| 980 |  |  |  |  |  |  | ) = $word; | 
| 981 |  |  |  |  |  |  |  | 
| 982 |  |  |  |  |  |  | $winref->{Input}{Cursor} += length($space . $word); | 
| 983 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 984 |  |  |  |  |  |  | doupdate(); | 
| 985 |  |  |  |  |  |  | } | 
| 986 |  |  |  |  |  |  | return; | 
| 987 |  |  |  |  |  |  | } | 
| 988 |  |  |  |  |  |  |  | 
| 989 |  |  |  |  |  |  | # Forward one word.  Requires uc($key) | 
| 990 |  |  |  |  |  |  | if (uc($key) eq '^[F') { | 
| 991 |  |  |  |  |  |  | if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\s*\S+)/) { | 
| 992 |  |  |  |  |  |  | $winref->{Input}{Cursor} += length($1); | 
| 993 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 994 |  |  |  |  |  |  | doupdate(); | 
| 995 |  |  |  |  |  |  | } | 
| 996 |  |  |  |  |  |  | return; | 
| 997 |  |  |  |  |  |  | } | 
| 998 |  |  |  |  |  |  |  | 
| 999 |  |  |  |  |  |  | # Backward one word.  This needs uc($key). | 
| 1000 |  |  |  |  |  |  | if (uc($key) eq '^[B') { | 
| 1001 |  |  |  |  |  |  | if (substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}) =~ /(\S+\s*)$/) { | 
| 1002 |  |  |  |  |  |  | $winref->{Input}{Cursor} -= length($1); | 
| 1003 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1004 |  |  |  |  |  |  | doupdate(); | 
| 1005 |  |  |  |  |  |  | } | 
| 1006 |  |  |  |  |  |  | return; | 
| 1007 |  |  |  |  |  |  | } | 
| 1008 |  |  |  |  |  |  |  | 
| 1009 |  |  |  |  |  |  | # Delete a word forward.  This needs uc($key). | 
| 1010 |  |  |  |  |  |  | if (uc($key) eq '^[D') { | 
| 1011 |  |  |  |  |  |  | if ($winref->{Input}{Cursor} < length($winref->{Input}{Data})) { | 
| 1012 |  |  |  |  |  |  | substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ s/^(\s*\S*\s*)//; | 
| 1013 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1014 |  |  |  |  |  |  | doupdate(); | 
| 1015 |  |  |  |  |  |  | } | 
| 1016 |  |  |  |  |  |  | return; | 
| 1017 |  |  |  |  |  |  | } | 
| 1018 |  |  |  |  |  |  |  | 
| 1019 |  |  |  |  |  |  | # Transpose words.  This needs uc($key). | 
| 1020 |  |  |  |  |  |  | if (uc($key) eq '^[T') { | 
| 1021 |  |  |  |  |  |  | my ($previous, $left, $space, $right, $rest); | 
| 1022 |  |  |  |  |  |  |  | 
| 1023 |  |  |  |  |  |  | if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}, 1) =~ /\s/) { | 
| 1024 |  |  |  |  |  |  | my ($left_space, $right_space); | 
| 1025 |  |  |  |  |  |  | ($previous, $left, $left_space) = | 
| 1026 |  |  |  |  |  |  | ( substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}) =~ /^(.*?)(\S+)(\s*)$/ | 
| 1027 |  |  |  |  |  |  | ); | 
| 1028 |  |  |  |  |  |  | ($right_space, $right, $rest) = | 
| 1029 |  |  |  |  |  |  | ( substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\s+)(\S+)(.*)$/ | 
| 1030 |  |  |  |  |  |  | ); | 
| 1031 |  |  |  |  |  |  | $space = $left_space . $right_space; | 
| 1032 |  |  |  |  |  |  | } | 
| 1033 |  |  |  |  |  |  | elsif ( substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}) =~ | 
| 1034 |  |  |  |  |  |  | /^(.*?)(\S+)(\s+)(\S*)$/ | 
| 1035 |  |  |  |  |  |  | ) { | 
| 1036 |  |  |  |  |  |  | ($previous, $left, $space, $right) = ($1, $2, $3, $4); | 
| 1037 |  |  |  |  |  |  | if (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\S*)(.*)$/) { | 
| 1038 |  |  |  |  |  |  | $right .= $1 if defined $1; | 
| 1039 |  |  |  |  |  |  | $rest = $2; | 
| 1040 |  |  |  |  |  |  | } | 
| 1041 |  |  |  |  |  |  | } | 
| 1042 |  |  |  |  |  |  | elsif (substr($winref->{Input}{Data}, $winref->{Input}{Cursor}) =~ /^(\S+)(\s+)(\S+)(.*)$/ | 
| 1043 |  |  |  |  |  |  | ) { | 
| 1044 |  |  |  |  |  |  | ($left, $space, $right, $rest) = ($1, $2, $3, $4); | 
| 1045 |  |  |  |  |  |  | if ( substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}) =~ /^(.*?)(\S+)$/ ) { | 
| 1046 |  |  |  |  |  |  | $previous = $1; | 
| 1047 |  |  |  |  |  |  | $left = $2 . $left; | 
| 1048 |  |  |  |  |  |  | } | 
| 1049 |  |  |  |  |  |  | } | 
| 1050 |  |  |  |  |  |  | else { | 
| 1051 |  |  |  |  |  |  | return; | 
| 1052 |  |  |  |  |  |  | } | 
| 1053 |  |  |  |  |  |  |  | 
| 1054 |  |  |  |  |  |  | $previous = '' unless defined $previous; | 
| 1055 |  |  |  |  |  |  | $rest     = '' unless defined $rest; | 
| 1056 |  |  |  |  |  |  |  | 
| 1057 |  |  |  |  |  |  | $winref->{Input}{Data}  = $previous . $right . $space . $left . $rest; | 
| 1058 |  |  |  |  |  |  | $winref->{Input}{Cursor} = length($previous. $left . $space . $right); | 
| 1059 |  |  |  |  |  |  |  | 
| 1060 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1061 |  |  |  |  |  |  | doupdate(); | 
| 1062 |  |  |  |  |  |  | return; | 
| 1063 |  |  |  |  |  |  | } | 
| 1064 |  |  |  |  |  |  |  | 
| 1065 |  |  |  |  |  |  | # Toggle insert mode. | 
| 1066 |  |  |  |  |  |  | if ($key eq 'KEY_IC') { | 
| 1067 |  |  |  |  |  |  | $winref->{Input}{Insert} = !$winref->{Input}{Insert}; | 
| 1068 |  |  |  |  |  |  | return; | 
| 1069 |  |  |  |  |  |  | } | 
| 1070 |  |  |  |  |  |  | # If the window is scrolled up go back to the beginning. | 
| 1071 |  |  |  |  |  |  | if ($key eq 'KEY_SELECT') { | 
| 1072 |  |  |  |  |  |  | $winref->{Buffer_Row} = $winref->{Buffer_Last}; | 
| 1073 |  |  |  |  |  |  | _refresh_buffer($self, $window_id); | 
| 1074 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1075 |  |  |  |  |  |  | doupdate(); | 
| 1076 |  |  |  |  |  |  | return; | 
| 1077 |  |  |  |  |  |  | } | 
| 1078 |  |  |  |  |  |  |  | 
| 1079 |  |  |  |  |  |  | # Scroll back a page. | 
| 1080 |  |  |  |  |  |  | if ($key eq 'KEY_PPAGE') { | 
| 1081 |  |  |  |  |  |  | if ($winref->{Buffer_Row} > $winref->{Buffer_First}) { | 
| 1082 |  |  |  |  |  |  | $winref->{Buffer_Row} -= $winref->{Screen_Height}; | 
| 1083 |  |  |  |  |  |  | if ($winref->{Buffer_Row} < $winref->{Buffer_First}) { | 
| 1084 |  |  |  |  |  |  | $winref->{Buffer_Row} = $winref->{Buffer_First} | 
| 1085 |  |  |  |  |  |  | } | 
| 1086 |  |  |  |  |  |  | _refresh_buffer($self, $window_id); | 
| 1087 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1088 |  |  |  |  |  |  | doupdate(); | 
| 1089 |  |  |  |  |  |  | } | 
| 1090 |  |  |  |  |  |  | return; | 
| 1091 |  |  |  |  |  |  | } | 
| 1092 |  |  |  |  |  |  |  | 
| 1093 |  |  |  |  |  |  | # Scroll forward a page. | 
| 1094 |  |  |  |  |  |  | if ($key eq 'KEY_NPAGE') { | 
| 1095 |  |  |  |  |  |  | if ($winref->{Buffer_Row} < $winref->{Buffer_Last}) { | 
| 1096 |  |  |  |  |  |  | $winref->{Buffer_Row} += $winref->{Screen_Height}; | 
| 1097 |  |  |  |  |  |  | if ($winref->{Buffer_Row} > $winref->{Buffer_Last}) { | 
| 1098 |  |  |  |  |  |  | $winref->{Buffer_Row} = $winref->{Buffer_Last}; | 
| 1099 |  |  |  |  |  |  | } | 
| 1100 |  |  |  |  |  |  | _refresh_buffer($self, $window_id); | 
| 1101 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1102 |  |  |  |  |  |  | doupdate(); | 
| 1103 |  |  |  |  |  |  | } | 
| 1104 |  |  |  |  |  |  | return; | 
| 1105 |  |  |  |  |  |  | } | 
| 1106 |  |  |  |  |  |  |  | 
| 1107 |  |  |  |  |  |  | # Scroll back a line. | 
| 1108 |  |  |  |  |  |  | if ($key eq 'KEY_UP') { | 
| 1109 |  |  |  |  |  |  | if ($winref->{Buffer_Row} > $winref->{Buffer_First}) { | 
| 1110 |  |  |  |  |  |  | $winref->{Buffer_Row}--; | 
| 1111 |  |  |  |  |  |  | _refresh_buffer($self, $window_id); | 
| 1112 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1113 |  |  |  |  |  |  | doupdate(); | 
| 1114 |  |  |  |  |  |  | } | 
| 1115 |  |  |  |  |  |  | return; | 
| 1116 |  |  |  |  |  |  | } | 
| 1117 |  |  |  |  |  |  |  | 
| 1118 |  |  |  |  |  |  | # Scroll forward a line. | 
| 1119 |  |  |  |  |  |  | if ($key eq 'KEY_DOWN') { | 
| 1120 |  |  |  |  |  |  | if ($winref->{Buffer_Row} < $winref->{Buffer_Last}) { | 
| 1121 |  |  |  |  |  |  | $winref->{Buffer_Row}++; | 
| 1122 |  |  |  |  |  |  | _refresh_buffer($self, $window_id); | 
| 1123 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1124 |  |  |  |  |  |  | doupdate(); | 
| 1125 |  |  |  |  |  |  | } | 
| 1126 |  |  |  |  |  |  | return; | 
| 1127 |  |  |  |  |  |  | } | 
| 1128 |  |  |  |  |  |  |  | 
| 1129 |  |  |  |  |  |  | if ($key eq "^I") { | 
| 1130 |  |  |  |  |  |  | if ($winref->{Input}{Tab_Complete}) { | 
| 1131 |  |  |  |  |  |  | my $left = substr($winref->{Input}{Data}, 0, $winref->{Input}{Cursor}); | 
| 1132 |  |  |  |  |  |  | my $right = substr($winref->{Input}{Data}, $winref->{Input}{Cursor}); | 
| 1133 |  |  |  |  |  |  | my @str = $winref->{Input}{Tab_Complete}->($left, $right); | 
| 1134 |  |  |  |  |  |  | my $complete_word = $1 if $left =~ /(\S+)\s*\z/; | 
| 1135 |  |  |  |  |  |  | $left =~ s/\Q$complete_word\E\s*\z// if $complete_word; | 
| 1136 |  |  |  |  |  |  | if (@str == 1) { | 
| 1137 |  |  |  |  |  |  | my $data = $left . $str[0]; | 
| 1138 |  |  |  |  |  |  | $winref->{Input}{Data} = $data . $right; | 
| 1139 |  |  |  |  |  |  | $winref->{Input}{Cursor} = length $data; | 
| 1140 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1141 |  |  |  |  |  |  | doupdate(); | 
| 1142 |  |  |  |  |  |  | } | 
| 1143 |  |  |  |  |  |  | elsif (@str) { | 
| 1144 |  |  |  |  |  |  | # complete to something they all have in common | 
| 1145 |  |  |  |  |  |  | my $shortest = ''; | 
| 1146 |  |  |  |  |  |  | for (@str) { | 
| 1147 |  |  |  |  |  |  | if (!length($shortest) or length($_) < length $shortest) { | 
| 1148 |  |  |  |  |  |  | $shortest = $_; | 
| 1149 |  |  |  |  |  |  | } | 
| 1150 |  |  |  |  |  |  | } | 
| 1151 |  |  |  |  |  |  | my $i = length $shortest; | 
| 1152 |  |  |  |  |  |  | for (@str) { | 
| 1153 |  |  |  |  |  |  | while (substr($shortest, 0, $i) ne substr($_, 0, $i) and $i) { | 
| 1154 |  |  |  |  |  |  | $i--; | 
| 1155 |  |  |  |  |  |  | } | 
| 1156 |  |  |  |  |  |  | last unless $i; | 
| 1157 |  |  |  |  |  |  | } | 
| 1158 |  |  |  |  |  |  | if ($i) { | 
| 1159 |  |  |  |  |  |  | $winref->{Input}{Data} = $left . substr($shortest, 0, $i) . $right; | 
| 1160 |  |  |  |  |  |  | $winref->{Input}{Cursor} = length($left) + $i; | 
| 1161 |  |  |  |  |  |  | } | 
| 1162 |  |  |  |  |  |  | my $table = columnize( | 
| 1163 |  |  |  |  |  |  | Items    => \@str, | 
| 1164 |  |  |  |  |  |  | MaxWidth => $COLS | 
| 1165 |  |  |  |  |  |  | ); | 
| 1166 |  |  |  |  |  |  | for (split /\n/, $table) { | 
| 1167 |  |  |  |  |  |  | &print($self, $window_id, $_); | 
| 1168 |  |  |  |  |  |  | } | 
| 1169 |  |  |  |  |  |  | } | 
| 1170 |  |  |  |  |  |  | } | 
| 1171 |  |  |  |  |  |  | return; | 
| 1172 |  |  |  |  |  |  | } | 
| 1173 |  |  |  |  |  |  |  | 
| 1174 |  |  |  |  |  |  | ### Not an internal keystroke.  Add it to the input buffer. | 
| 1175 |  |  |  |  |  |  | #FIXME double check if this is needed... | 
| 1176 |  |  |  |  |  |  | $key = chr(ord($1)-64) if $key =~ /^\^([@-_BC])$/; | 
| 1177 |  |  |  |  |  |  |  | 
| 1178 |  |  |  |  |  |  | # Inserting or overwriting in the middle of the input. | 
| 1179 |  |  |  |  |  |  | if ($winref->{Input}{Cursor} < length($winref->{Input}{Data})) { | 
| 1180 |  |  |  |  |  |  | if ($winref->{Input}{Insert}) { | 
| 1181 |  |  |  |  |  |  | substr($winref->{Input}{Data}, $winref->{Input}{Cursor}, 0) = $key; | 
| 1182 |  |  |  |  |  |  | } | 
| 1183 |  |  |  |  |  |  | else { | 
| 1184 |  |  |  |  |  |  | substr($winref->{Input}{Data}, $winref->{Input}{Cursor}, length($key)) = $key; | 
| 1185 |  |  |  |  |  |  | } | 
| 1186 |  |  |  |  |  |  | } | 
| 1187 |  |  |  |  |  |  |  | 
| 1188 |  |  |  |  |  |  | # Appending. | 
| 1189 |  |  |  |  |  |  | else { | 
| 1190 |  |  |  |  |  |  | $winref->{Input}{Data} .= $key; | 
| 1191 |  |  |  |  |  |  | } | 
| 1192 |  |  |  |  |  |  |  | 
| 1193 |  |  |  |  |  |  | $winref->{Input}{Cursor} += length($key); | 
| 1194 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1195 |  |  |  |  |  |  | doupdate(); | 
| 1196 |  |  |  |  |  |  | return; | 
| 1197 |  |  |  |  |  |  | } | 
| 1198 |  |  |  |  |  |  |  | 
| 1199 |  |  |  |  |  |  | sub columnize { | 
| 1200 |  |  |  |  |  |  | croak "Arguments to columnize must be a hash" if @_ & 1; | 
| 1201 |  |  |  |  |  |  | my %opts = @_; | 
| 1202 |  |  |  |  |  |  |  | 
| 1203 |  |  |  |  |  |  | my $width = delete $opts{MaxWidth}; | 
| 1204 |  |  |  |  |  |  | $width = 80 unless defined $width; | 
| 1205 |  |  |  |  |  |  | croak "Invalid width $width" if $width <= 0; | 
| 1206 |  |  |  |  |  |  |  | 
| 1207 |  |  |  |  |  |  | my $padding = delete $opts{Padding}; | 
| 1208 |  |  |  |  |  |  | $padding = 2 unless defined $padding; | 
| 1209 |  |  |  |  |  |  | croak "Invalid padding $padding" if $padding < 0; | 
| 1210 |  |  |  |  |  |  |  | 
| 1211 |  |  |  |  |  |  | my $max_columns = delete $opts{MaxColumns}; | 
| 1212 |  |  |  |  |  |  | $max_columns = 10 unless defined $max_columns; | 
| 1213 |  |  |  |  |  |  | croak "Invalid max columns $max_columns" if $max_columns <= 0; | 
| 1214 |  |  |  |  |  |  |  | 
| 1215 |  |  |  |  |  |  | my $items = delete $opts{Items}; | 
| 1216 |  |  |  |  |  |  | croak "Items must be an array reference" | 
| 1217 |  |  |  |  |  |  | unless ref($items) eq 'ARRAY'; | 
| 1218 |  |  |  |  |  |  |  | 
| 1219 |  |  |  |  |  |  | croak "Unknown arguments: '", join("', '", sort keys %opts), "'" | 
| 1220 |  |  |  |  |  |  | if keys %opts; | 
| 1221 |  |  |  |  |  |  |  | 
| 1222 |  |  |  |  |  |  | for my $i (reverse 2 .. $max_columns) { | 
| 1223 |  |  |  |  |  |  | my $n = 0; | 
| 1224 |  |  |  |  |  |  | my @cols; | 
| 1225 |  |  |  |  |  |  | my $num_rows = 0; | 
| 1226 |  |  |  |  |  |  | for (0 .. $#{$items}) { | 
| 1227 |  |  |  |  |  |  | push @{$cols[$n++]}, $items->[$_]; | 
| 1228 |  |  |  |  |  |  | unless (($_ + 1) % $i) { | 
| 1229 |  |  |  |  |  |  | $n = 0; | 
| 1230 |  |  |  |  |  |  | $num_rows++; | 
| 1231 |  |  |  |  |  |  | } | 
| 1232 |  |  |  |  |  |  | } | 
| 1233 |  |  |  |  |  |  | my @long; | 
| 1234 |  |  |  |  |  |  | for $n (0 .. $#cols) { | 
| 1235 |  |  |  |  |  |  | for my $item (@{$cols[$n]}) { | 
| 1236 |  |  |  |  |  |  | if (!$long[$n] or length($item) > $long[$n]) { | 
| 1237 |  |  |  |  |  |  | $long[$n] = length $item; | 
| 1238 |  |  |  |  |  |  | } | 
| 1239 |  |  |  |  |  |  | } | 
| 1240 |  |  |  |  |  |  | } | 
| 1241 |  |  |  |  |  |  | my $total = 0; | 
| 1242 |  |  |  |  |  |  | for (@long) { | 
| 1243 |  |  |  |  |  |  | $total += $_ + $padding; | 
| 1244 |  |  |  |  |  |  | } | 
| 1245 |  |  |  |  |  |  | next if $total > $width; | 
| 1246 |  |  |  |  |  |  | my $table = ''; | 
| 1247 |  |  |  |  |  |  | for (0 .. $num_rows) { | 
| 1248 |  |  |  |  |  |  | my $row; | 
| 1249 |  |  |  |  |  |  | for $n (0 .. $#cols) { | 
| 1250 |  |  |  |  |  |  | my $item = $cols[$n][$_]; | 
| 1251 |  |  |  |  |  |  | last unless defined $item; | 
| 1252 |  |  |  |  |  |  | $row .= $item . (' ' x ($long[$n] - length($item) + $padding)); | 
| 1253 |  |  |  |  |  |  | } | 
| 1254 |  |  |  |  |  |  | $table .= $row . "\n"; | 
| 1255 |  |  |  |  |  |  | } | 
| 1256 |  |  |  |  |  |  | return $table; | 
| 1257 |  |  |  |  |  |  | last; | 
| 1258 |  |  |  |  |  |  | } | 
| 1259 |  |  |  |  |  |  | return join("\n", @$items) . "\n"; | 
| 1260 |  |  |  |  |  |  | } | 
| 1261 |  |  |  |  |  |  | ##FIXME Has this been replaced with _parse_key() ?? | 
| 1262 |  |  |  |  |  |  | my %ctrl_to_visible; | 
| 1263 |  |  |  |  |  |  | BEGIN { | 
| 1264 |  |  |  |  |  |  | for (0..31) { | 
| 1265 |  |  |  |  |  |  | $ctrl_to_visible{chr($_)} = chr($_+64); | 
| 1266 |  |  |  |  |  |  | } | 
| 1267 |  |  |  |  |  |  | } | 
| 1268 |  |  |  |  |  |  |  | 
| 1269 |  |  |  |  |  |  | ### Common thing.  Refresh the buffer on the screen. | 
| 1270 |  |  |  |  |  |  | ##  Pass in $self and a window_id | 
| 1271 |  |  |  |  |  |  |  | 
| 1272 |  |  |  |  |  |  | sub _refresh_buffer { | 
| 1273 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter _refresh_buffer\n"; } | 
| 1274 |  |  |  |  |  |  | my $self = shift; | 
| 1275 |  |  |  |  |  |  | my $window_id = shift; | 
| 1276 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$window_id}; | 
| 1277 |  |  |  |  |  |  | my $screen = $winref->{Window_Screen}; | 
| 1278 |  |  |  |  |  |  |  | 
| 1279 |  |  |  |  |  |  | if ($window_id != $self->[CUR_WIN]) { return; } | 
| 1280 |  |  |  |  |  |  | # Adjust the buffer row to compensate for any scrolling we encounter | 
| 1281 |  |  |  |  |  |  | # while in scrollback. | 
| 1282 |  |  |  |  |  |  |  | 
| 1283 |  |  |  |  |  |  | if ($winref->{Buffer_Row} < $winref->{Buffer_Last}) { | 
| 1284 |  |  |  |  |  |  | $winref->{Buffer_Row} -= $winref->{Scrolled_Lines}; | 
| 1285 |  |  |  |  |  |  | } | 
| 1286 |  |  |  |  |  |  |  | 
| 1287 |  |  |  |  |  |  | # Don't scroll up past the start of the buffer. | 
| 1288 |  |  |  |  |  |  |  | 
| 1289 |  |  |  |  |  |  | if ($winref->{Buffer_Row} < $winref->{Buffer_First}) { | 
| 1290 |  |  |  |  |  |  | $winref->{Buffer_Row} = $winref->{Buffer_First}; | 
| 1291 |  |  |  |  |  |  | } | 
| 1292 |  |  |  |  |  |  |  | 
| 1293 |  |  |  |  |  |  | # Don't scroll down past the bottom of the buffer. | 
| 1294 |  |  |  |  |  |  |  | 
| 1295 |  |  |  |  |  |  | if ($winref->{Buffer_Row} > $winref->{Buffer_Last}) { | 
| 1296 |  |  |  |  |  |  | $winref->{Buffer_Row} = $winref->{Buffer_Last}; | 
| 1297 |  |  |  |  |  |  | } | 
| 1298 |  |  |  |  |  |  |  | 
| 1299 |  |  |  |  |  |  | # Now splat the last N lines onto the screen. | 
| 1300 |  |  |  |  |  |  |  | 
| 1301 |  |  |  |  |  |  | $screen->erase(); | 
| 1302 |  |  |  |  |  |  | $screen->noutrefresh(); | 
| 1303 |  |  |  |  |  |  |  | 
| 1304 |  |  |  |  |  |  | $winref->{Scrolled_Lines} = 0; | 
| 1305 |  |  |  |  |  |  |  | 
| 1306 |  |  |  |  |  |  | my $screen_y = 0; | 
| 1307 |  |  |  |  |  |  | my $buffer_y = $winref->{Buffer_Row} - $winref->{Buffer_Visible}; | 
| 1308 |  |  |  |  |  |  | while ($screen_y < $winref->{Screen_Height}) { | 
| 1309 |  |  |  |  |  |  | $screen->move($screen_y, 0); | 
| 1310 |  |  |  |  |  |  | $screen->clrtoeol(); | 
| 1311 |  |  |  |  |  |  | $screen->noutrefresh(); | 
| 1312 |  |  |  |  |  |  |  | 
| 1313 |  |  |  |  |  |  | next if $buffer_y < 0; | 
| 1314 |  |  |  |  |  |  | next if $buffer_y > $winref->{Buffer_Last}; | 
| 1315 |  |  |  |  |  |  |  | 
| 1316 |  |  |  |  |  |  | my $line = $winref->{Buffer}->[$buffer_y]; # does this work? | 
| 1317 |  |  |  |  |  |  | my $column = 1; | 
| 1318 |  |  |  |  |  |  | while (length $line) { | 
| 1319 |  |  |  |  |  |  | while ($line =~ s/^\0\(([^)]+)\)//) { | 
| 1320 |  |  |  |  |  |  | my $cmd = $1; | 
| 1321 |  |  |  |  |  |  | if ($cmd =~ /blink_(on|off)/) { | 
| 1322 |  |  |  |  |  |  | if ($1 eq 'on') { $screen->attron(A_BLINK); } | 
| 1323 |  |  |  |  |  |  | if ($1 eq 'off') { $screen->attroff(A_BLINK); } | 
| 1324 |  |  |  |  |  |  | $screen->noutrefresh(); | 
| 1325 |  |  |  |  |  |  | } | 
| 1326 |  |  |  |  |  |  | elsif ($cmd =~ /bold_(on|off)/) { | 
| 1327 |  |  |  |  |  |  | if ($1 eq 'on') { $screen->attron(A_BOLD); } | 
| 1328 |  |  |  |  |  |  | if ($1 eq 'off') { $screen->attroff(A_BOLD); } | 
| 1329 |  |  |  |  |  |  | $screen->noutrefresh(); | 
| 1330 |  |  |  |  |  |  | } | 
| 1331 |  |  |  |  |  |  | elsif ($cmd =~ /underline_(on|off)/) { | 
| 1332 |  |  |  |  |  |  | if ($1 eq 'on') { $screen->attron(A_UNDERLINE); } | 
| 1333 |  |  |  |  |  |  | if ($1 eq 'off') { $screen->attroff(A_UNDERLINE); } | 
| 1334 |  |  |  |  |  |  | $screen->noutrefresh(); | 
| 1335 |  |  |  |  |  |  | } | 
| 1336 |  |  |  |  |  |  | else { | 
| 1337 |  |  |  |  |  |  | $screen->attrset($self->[PALETTE]->{$cmd}->[PAL_PAIR]); | 
| 1338 |  |  |  |  |  |  | $screen->noutrefresh(); | 
| 1339 |  |  |  |  |  |  | } | 
| 1340 |  |  |  |  |  |  | } | 
| 1341 |  |  |  |  |  |  |  | 
| 1342 |  |  |  |  |  |  | if ($line =~ s/^([^\0]+)//x) { | 
| 1343 |  |  |  |  |  |  |  | 
| 1344 |  |  |  |  |  |  | # TODO: This needs to be revised so it cuts off the last word, | 
| 1345 |  |  |  |  |  |  | # not omits it entirely. | 
| 1346 |  |  |  |  |  |  | # Has this been fixed already?? | 
| 1347 |  |  |  |  |  |  | next if $column >= $COLS; | 
| 1348 |  |  |  |  |  |  | if ($column + length($1) > $COLS) { | 
| 1349 |  |  |  |  |  |  | my $word = $1; | 
| 1350 |  |  |  |  |  |  | substr($word, ($column + length($1)) - $COLS - 1) = ''; | 
| 1351 |  |  |  |  |  |  | $screen->addstr($word); | 
| 1352 |  |  |  |  |  |  | } | 
| 1353 |  |  |  |  |  |  | else { | 
| 1354 |  |  |  |  |  |  | $screen->addstr($1); | 
| 1355 |  |  |  |  |  |  | } | 
| 1356 |  |  |  |  |  |  | $column += length($1); | 
| 1357 |  |  |  |  |  |  | $screen->noutrefresh(); | 
| 1358 |  |  |  |  |  |  | } | 
| 1359 |  |  |  |  |  |  | } | 
| 1360 |  |  |  |  |  |  |  | 
| 1361 |  |  |  |  |  |  | $screen->attrset($self->[PALETTE]->{ncolor}->[PAL_PAIR]); | 
| 1362 |  |  |  |  |  |  | $screen->noutrefresh(); | 
| 1363 |  |  |  |  |  |  | $screen->clrtoeol(); | 
| 1364 |  |  |  |  |  |  | $screen->noutrefresh(); | 
| 1365 |  |  |  |  |  |  | } | 
| 1366 |  |  |  |  |  |  | continue { | 
| 1367 |  |  |  |  |  |  | $screen_y++; | 
| 1368 |  |  |  |  |  |  | $buffer_y++; | 
| 1369 |  |  |  |  |  |  | } | 
| 1370 |  |  |  |  |  |  | } | 
| 1371 |  |  |  |  |  |  |  | 
| 1372 |  |  |  |  |  |  | # Internal function to set the color palette for a window. | 
| 1373 |  |  |  |  |  |  |  | 
| 1374 |  |  |  |  |  |  | sub _set_color { | 
| 1375 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter _set_color\n"; } | 
| 1376 |  |  |  |  |  |  | my $self= shift; | 
| 1377 |  |  |  |  |  |  | #  my $window_id = shift; | 
| 1378 |  |  |  |  |  |  | #  my $winref = $self->[WINDOW]->{$window_id}; | 
| 1379 |  |  |  |  |  |  | my %params = @_; | 
| 1380 |  |  |  |  |  |  |  | 
| 1381 |  |  |  |  |  |  | my %color_table = | 
| 1382 |  |  |  |  |  |  | ( bk      => COLOR_BLACK,    black   => COLOR_BLACK, | 
| 1383 |  |  |  |  |  |  | bl      => COLOR_BLUE,     blue    => COLOR_BLUE, | 
| 1384 |  |  |  |  |  |  | br      => COLOR_YELLOW,   brown   => COLOR_YELLOW, | 
| 1385 |  |  |  |  |  |  | fu      => COLOR_MAGENTA,  fuschia => COLOR_MAGENTA, | 
| 1386 |  |  |  |  |  |  | cy      => COLOR_CYAN,     cyan    => COLOR_CYAN, | 
| 1387 |  |  |  |  |  |  | gr      => COLOR_GREEN,    green   => COLOR_GREEN, | 
| 1388 |  |  |  |  |  |  | ma      => COLOR_MAGENTA,  magenta => COLOR_MAGENTA, | 
| 1389 |  |  |  |  |  |  | re      => COLOR_RED,      red     => COLOR_RED, | 
| 1390 |  |  |  |  |  |  | wh      => COLOR_WHITE,    white   => COLOR_WHITE, | 
| 1391 |  |  |  |  |  |  | ye      => COLOR_YELLOW,   yellow  => COLOR_YELLOW, | 
| 1392 |  |  |  |  |  |  | de      => -1,             default => -1, | 
| 1393 |  |  |  |  |  |  | ); | 
| 1394 |  |  |  |  |  |  |  | 
| 1395 |  |  |  |  |  |  | my %attribute_table = | 
| 1396 |  |  |  |  |  |  | ( al         => A_ALTCHARSET, | 
| 1397 |  |  |  |  |  |  | alt        => A_ALTCHARSET, | 
| 1398 |  |  |  |  |  |  | alternate  => A_ALTCHARSET, | 
| 1399 |  |  |  |  |  |  | blink      => A_BLINK, | 
| 1400 |  |  |  |  |  |  | blinking   => A_BLINK, | 
| 1401 |  |  |  |  |  |  | bo         => A_BOLD, | 
| 1402 |  |  |  |  |  |  | bold       => A_BOLD, | 
| 1403 |  |  |  |  |  |  | bright     => A_BOLD, | 
| 1404 |  |  |  |  |  |  | dim        => A_DIM, | 
| 1405 |  |  |  |  |  |  | fl         => A_BLINK, | 
| 1406 |  |  |  |  |  |  | flash      => A_BLINK, | 
| 1407 |  |  |  |  |  |  | flashing   => A_BLINK, | 
| 1408 |  |  |  |  |  |  | hi         => A_BOLD, | 
| 1409 |  |  |  |  |  |  | in         => A_INVIS, | 
| 1410 |  |  |  |  |  |  | inverse    => A_REVERSE, | 
| 1411 |  |  |  |  |  |  | inverted   => A_REVERSE, | 
| 1412 |  |  |  |  |  |  | invisible  => A_INVIS, | 
| 1413 |  |  |  |  |  |  | inviso     => A_INVIS, | 
| 1414 |  |  |  |  |  |  | lo         => A_DIM, | 
| 1415 |  |  |  |  |  |  | low        => A_DIM, | 
| 1416 |  |  |  |  |  |  | no         => A_NORMAL, | 
| 1417 |  |  |  |  |  |  | norm       => A_NORMAL, | 
| 1418 |  |  |  |  |  |  | normal     => A_NORMAL, | 
| 1419 |  |  |  |  |  |  | pr         => A_PROTECT, | 
| 1420 |  |  |  |  |  |  | prot       => A_PROTECT, | 
| 1421 |  |  |  |  |  |  | protected  => A_PROTECT, | 
| 1422 |  |  |  |  |  |  | reverse    => A_REVERSE, | 
| 1423 |  |  |  |  |  |  | rv         => A_REVERSE, | 
| 1424 |  |  |  |  |  |  | st         => A_STANDOUT, | 
| 1425 |  |  |  |  |  |  | stand      => A_STANDOUT, | 
| 1426 |  |  |  |  |  |  | standout   => A_STANDOUT, | 
| 1427 |  |  |  |  |  |  | un         => A_UNDERLINE, | 
| 1428 |  |  |  |  |  |  | under      => A_UNDERLINE, | 
| 1429 |  |  |  |  |  |  | underline  => A_UNDERLINE, | 
| 1430 |  |  |  |  |  |  | underlined => A_UNDERLINE, | 
| 1431 |  |  |  |  |  |  | underscore => A_UNDERLINE, | 
| 1432 |  |  |  |  |  |  | ); | 
| 1433 |  |  |  |  |  |  |  | 
| 1434 |  |  |  |  |  |  |  | 
| 1435 |  |  |  |  |  |  | for my $color_name (keys %params) { | 
| 1436 |  |  |  |  |  |  |  | 
| 1437 |  |  |  |  |  |  | my $description = $params{$color_name}; | 
| 1438 |  |  |  |  |  |  | my $foreground = 0; | 
| 1439 |  |  |  |  |  |  | my $background = 0; | 
| 1440 |  |  |  |  |  |  | my $attributes = 0; | 
| 1441 |  |  |  |  |  |  |  | 
| 1442 |  |  |  |  |  |  | # Which is an alias to foreground or background depending on what | 
| 1443 |  |  |  |  |  |  | # state we're in. | 
| 1444 |  |  |  |  |  |  | my $which = \$foreground; | 
| 1445 |  |  |  |  |  |  |  | 
| 1446 |  |  |  |  |  |  | # Clean up the color description. | 
| 1447 |  |  |  |  |  |  | $description =~ s/^\s+//; | 
| 1448 |  |  |  |  |  |  | $description =~ s/\s+$//; | 
| 1449 |  |  |  |  |  |  | $description = lc($description); | 
| 1450 |  |  |  |  |  |  |  | 
| 1451 |  |  |  |  |  |  | # Parse the description. | 
| 1452 |  |  |  |  |  |  | foreach my $word (split /\s+/, $description) { | 
| 1453 |  |  |  |  |  |  |  | 
| 1454 |  |  |  |  |  |  | # The word "on" means we're switching to background. | 
| 1455 |  |  |  |  |  |  | if ($word eq 'on') { | 
| 1456 |  |  |  |  |  |  | $which = \$background; | 
| 1457 |  |  |  |  |  |  | next; | 
| 1458 |  |  |  |  |  |  | } | 
| 1459 |  |  |  |  |  |  |  | 
| 1460 |  |  |  |  |  |  | # If it's a color name, combine its value with the foreground or | 
| 1461 |  |  |  |  |  |  | # background, whichever is currently selected. | 
| 1462 |  |  |  |  |  |  | if (exists $color_table{$word}) { | 
| 1463 |  |  |  |  |  |  | $$which |= $color_table{$word}; | 
| 1464 |  |  |  |  |  |  | next; | 
| 1465 |  |  |  |  |  |  | } | 
| 1466 |  |  |  |  |  |  |  | 
| 1467 |  |  |  |  |  |  | # If it's an attribute, it goes with attributes. | 
| 1468 |  |  |  |  |  |  | if (exists $attribute_table{$word}) { | 
| 1469 |  |  |  |  |  |  | $attributes |= $attribute_table{$word}; | 
| 1470 |  |  |  |  |  |  | next; | 
| 1471 |  |  |  |  |  |  | } | 
| 1472 |  |  |  |  |  |  |  | 
| 1473 |  |  |  |  |  |  | # Otherwise it's an error. | 
| 1474 |  |  |  |  |  |  | if (DEBUG) { print ERRS "unknown color keyword \"$word\"\n"; } | 
| 1475 |  |  |  |  |  |  | croak "unknown color keyword \"$word\""; | 
| 1476 |  |  |  |  |  |  | } | 
| 1477 |  |  |  |  |  |  |  | 
| 1478 |  |  |  |  |  |  | # If the palette already has that color, redefine it. | 
| 1479 |  |  |  |  |  |  | if (exists $self->[PALETTE]->{$color_name}) { | 
| 1480 |  |  |  |  |  |  | my $old_color_number = $self->[PALETTE]->{$color_name}->[PAL_NUMBER]; | 
| 1481 |  |  |  |  |  |  | init_pair($old_color_number, $foreground, $background); | 
| 1482 |  |  |  |  |  |  | $self->[PALETTE]->{$color_name}->[PAL_PAIR] = | 
| 1483 |  |  |  |  |  |  | COLOR_PAIR($old_color_number) | $attributes; | 
| 1484 |  |  |  |  |  |  | } | 
| 1485 |  |  |  |  |  |  | else { | 
| 1486 |  |  |  |  |  |  | my $new_color_number = ++$self->[PAL_COL_SEQ]; | 
| 1487 |  |  |  |  |  |  | init_pair($new_color_number, $foreground, $background); | 
| 1488 |  |  |  |  |  |  | $self->[PALETTE]->{$color_name} = | 
| 1489 |  |  |  |  |  |  | [ COLOR_PAIR($new_color_number) | $attributes,  # PAL_PAIR | 
| 1490 |  |  |  |  |  |  | $new_color_number,                            # PAL_NUMBER | 
| 1491 |  |  |  |  |  |  | $description,                                 # PAL_DESC | 
| 1492 |  |  |  |  |  |  | ]; | 
| 1493 |  |  |  |  |  |  | } | 
| 1494 |  |  |  |  |  |  | } | 
| 1495 |  |  |  |  |  |  | } | 
| 1496 |  |  |  |  |  |  |  | 
| 1497 |  |  |  |  |  |  | ### The terminal stopped.  Remove the reference count for the remote | 
| 1498 |  |  |  |  |  |  | ### session. | 
| 1499 |  |  |  |  |  |  |  | 
| 1500 |  |  |  |  |  |  | sub terminal_stopped { | 
| 1501 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter terminal_stopped\n"; } | 
| 1502 |  |  |  |  |  |  | my ($kernel, $heap) = @_[KERNEL, HEAP]; | 
| 1503 |  |  |  |  |  |  | $kernel->alias_remove($_[OBJECT][ALIAS]); | 
| 1504 |  |  |  |  |  |  | delete $heap->{stderr_reader}; | 
| 1505 |  |  |  |  |  |  | undef $console; | 
| 1506 |  |  |  |  |  |  |  | 
| 1507 |  |  |  |  |  |  | if (defined $heap->{input_session}) { | 
| 1508 |  |  |  |  |  |  | $kernel->refcount_decrement( $heap->{input_session}, "terminal link" ); | 
| 1509 |  |  |  |  |  |  | delete $heap->{input_session}; | 
| 1510 |  |  |  |  |  |  | } | 
| 1511 |  |  |  |  |  |  | } | 
| 1512 |  |  |  |  |  |  |  | 
| 1513 |  |  |  |  |  |  | sub change_window { | 
| 1514 |  |  |  |  |  |  | if (DEBUG) { print ERRS "change_window called\n"; } | 
| 1515 |  |  |  |  |  |  | my $self = shift; | 
| 1516 |  |  |  |  |  |  | my $window_id = shift; | 
| 1517 |  |  |  |  |  |  | my @list = sort {$a <=> $b} keys %{$self->[WINDOW]}; | 
| 1518 |  |  |  |  |  |  |  | 
| 1519 |  |  |  |  |  |  | if (@list) { | 
| 1520 |  |  |  |  |  |  | if ($window_id == -1) { | 
| 1521 |  |  |  |  |  |  | $window_id = $list[$#list]; | 
| 1522 |  |  |  |  |  |  | } | 
| 1523 |  |  |  |  |  |  | elsif ($window_id > $list[$#list]) { | 
| 1524 |  |  |  |  |  |  | $window_id = 0; | 
| 1525 |  |  |  |  |  |  | } | 
| 1526 |  |  |  |  |  |  | } | 
| 1527 |  |  |  |  |  |  |  | 
| 1528 |  |  |  |  |  |  | my $validity = validate_window($self, $window_id); | 
| 1529 |  |  |  |  |  |  | if ($validity) { | 
| 1530 |  |  |  |  |  |  | $self->[CUR_WIN] = $window_id; | 
| 1531 |  |  |  |  |  |  | update_window( $self, $window_id ); | 
| 1532 |  |  |  |  |  |  | } | 
| 1533 |  |  |  |  |  |  | } | 
| 1534 |  |  |  |  |  |  |  | 
| 1535 |  |  |  |  |  |  | sub update_window { | 
| 1536 |  |  |  |  |  |  | my $self = shift; | 
| 1537 |  |  |  |  |  |  | my $window_id = shift; | 
| 1538 |  |  |  |  |  |  |  | 
| 1539 |  |  |  |  |  |  | _refresh_title( $self, $window_id ); | 
| 1540 |  |  |  |  |  |  | _refresh_buffer( $self, $window_id ); | 
| 1541 |  |  |  |  |  |  | _refresh_status( $self, $window_id ); | 
| 1542 |  |  |  |  |  |  | _refresh_edit( $self, $window_id ); | 
| 1543 |  |  |  |  |  |  | doupdate(); | 
| 1544 |  |  |  |  |  |  | } | 
| 1545 |  |  |  |  |  |  |  | 
| 1546 |  |  |  |  |  |  | sub _refresh_title { | 
| 1547 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter _refresh_title\n"; } | 
| 1548 |  |  |  |  |  |  | my ($self, $window_id) = @_; | 
| 1549 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$window_id}; | 
| 1550 |  |  |  |  |  |  | my $title = $winref->{Window_Title}; | 
| 1551 |  |  |  |  |  |  |  | 
| 1552 |  |  |  |  |  |  | if ($window_id != $self->[CUR_WIN]) { return; } | 
| 1553 |  |  |  |  |  |  |  | 
| 1554 |  |  |  |  |  |  | $title->move(TITLE_LINE, TITLE_COL); | 
| 1555 |  |  |  |  |  |  | $title->attrset($self->[PALETTE]->{st_values}->[PAL_PAIR]); | 
| 1556 |  |  |  |  |  |  | $title->noutrefresh(); | 
| 1557 |  |  |  |  |  |  | $title->addstr($winref->{Title}) unless !$winref->{Title}; | 
| 1558 |  |  |  |  |  |  | $title->noutrefresh(); | 
| 1559 |  |  |  |  |  |  | $title->clrtoeol(); | 
| 1560 |  |  |  |  |  |  | $title->noutrefresh(); | 
| 1561 |  |  |  |  |  |  | doupdate(); | 
| 1562 |  |  |  |  |  |  | } | 
| 1563 |  |  |  |  |  |  |  | 
| 1564 |  |  |  |  |  |  | sub _refresh_edit { | 
| 1565 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter _refresh_edit\n"; } | 
| 1566 |  |  |  |  |  |  | my $self = shift; | 
| 1567 |  |  |  |  |  |  | my $window_id = shift; | 
| 1568 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$window_id}; | 
| 1569 |  |  |  |  |  |  | my $edit = $winref->{Window_Edit}; | 
| 1570 |  |  |  |  |  |  | my $visible_input = $winref->{Input}{Data}; | 
| 1571 |  |  |  |  |  |  |  | 
| 1572 |  |  |  |  |  |  | # If the cursor is after the last visible edit position, scroll the | 
| 1573 |  |  |  |  |  |  | # edit window left so the cursor is back on-screen. | 
| 1574 |  |  |  |  |  |  |  | 
| 1575 |  |  |  |  |  |  | if ($winref->{Input}{Cursor} - $winref->{Input}{Edit_Position} >= $COLS) { | 
| 1576 |  |  |  |  |  |  | $winref->{Input}{Edit_Position} = $winref->{Input}{Cursor} - $COLS + 1; | 
| 1577 |  |  |  |  |  |  | } | 
| 1578 |  |  |  |  |  |  |  | 
| 1579 |  |  |  |  |  |  | # If the cursor is moving left of the middle of the screen, scroll | 
| 1580 |  |  |  |  |  |  | # things to the right so that both sides of the cursor may be seen. | 
| 1581 |  |  |  |  |  |  |  | 
| 1582 |  |  |  |  |  |  | elsif ($winref->{Input}{Cursor} - $winref->{Input}{Edit_Position} < ($COLS >> 1)) { | 
| 1583 |  |  |  |  |  |  | $winref->{Input}{Edit_Position} = $winref->{Input}{Cursor} - ($COLS >> 1); | 
| 1584 |  |  |  |  |  |  | $winref->{Input}{Edit_Position} = 0 if $winref->{Input}{Edit_Position} < 0; | 
| 1585 |  |  |  |  |  |  | } | 
| 1586 |  |  |  |  |  |  |  | 
| 1587 |  |  |  |  |  |  | # If the cursor is moving right of the middle of the screen, scroll | 
| 1588 |  |  |  |  |  |  | # things to the left so that both sides of the cursor may be seen. | 
| 1589 |  |  |  |  |  |  |  | 
| 1590 |  |  |  |  |  |  | elsif ( $winref->{Input}{Cursor} <= length($winref->{Input}{Data}) - ($COLS >> 1) + 1 ){ | 
| 1591 |  |  |  |  |  |  | $winref->{Input}{Edit_Position} = $winref->{Input}{Cursor} - ($COLS >> 1); | 
| 1592 |  |  |  |  |  |  | } | 
| 1593 |  |  |  |  |  |  |  | 
| 1594 |  |  |  |  |  |  | # Condition $visible_input so it really is. | 
| 1595 |  |  |  |  |  |  | $visible_input = substr($visible_input, $winref->{Input}{Edit_Position}, $COLS-1); | 
| 1596 |  |  |  |  |  |  |  | 
| 1597 |  |  |  |  |  |  | $edit->attron(A_NORMAL); | 
| 1598 |  |  |  |  |  |  | $edit->erase(); | 
| 1599 |  |  |  |  |  |  | $edit->noutrefresh(); | 
| 1600 |  |  |  |  |  |  | if ($winref->{Input}{Prompt}) { | 
| 1601 |  |  |  |  |  |  | $visible_input = $winref->{Input}{Prompt} . $visible_input; | 
| 1602 |  |  |  |  |  |  | } | 
| 1603 |  |  |  |  |  |  | while (length($visible_input)) { | 
| 1604 |  |  |  |  |  |  | if ($visible_input =~ /^[\x00-\x1f]/) { | 
| 1605 |  |  |  |  |  |  | $edit->attron(A_UNDERLINE); | 
| 1606 |  |  |  |  |  |  | while ($visible_input =~ s/^([\x00-\x1f])//) { | 
| 1607 |  |  |  |  |  |  | $edit->addstr($ctrl_to_visible{$1}); | 
| 1608 |  |  |  |  |  |  | } | 
| 1609 |  |  |  |  |  |  | } | 
| 1610 |  |  |  |  |  |  | if ($visible_input =~ s/^([^\x00-\x1f]+)//) { | 
| 1611 |  |  |  |  |  |  | $edit->attroff(A_UNDERLINE); | 
| 1612 |  |  |  |  |  |  | $edit->addstr($1); | 
| 1613 |  |  |  |  |  |  | } | 
| 1614 |  |  |  |  |  |  | } | 
| 1615 |  |  |  |  |  |  |  | 
| 1616 |  |  |  |  |  |  | $edit->noutrefresh(); | 
| 1617 |  |  |  |  |  |  | $edit->move( 0, $winref->{Input}{Cursor} - $winref->{Input}{Edit_Position} ); | 
| 1618 |  |  |  |  |  |  | $edit->noutrefresh(); | 
| 1619 |  |  |  |  |  |  | } | 
| 1620 |  |  |  |  |  |  |  | 
| 1621 |  |  |  |  |  |  | ### Set or call command history lines. | 
| 1622 |  |  |  |  |  |  |  | 
| 1623 |  |  |  |  |  |  | sub command_history { | 
| 1624 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter command_history\n"; } | 
| 1625 |  |  |  |  |  |  | my $self = shift; | 
| 1626 |  |  |  |  |  |  | my $window_id = shift; | 
| 1627 |  |  |  |  |  |  | my $flag = shift; | 
| 1628 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$window_id}; | 
| 1629 |  |  |  |  |  |  |  | 
| 1630 |  |  |  |  |  |  | if ($flag == 0) { #add to command history | 
| 1631 |  |  |  |  |  |  |  | 
| 1632 |  |  |  |  |  |  | # Add to the command history.  Discard the oldest item if the | 
| 1633 |  |  |  |  |  |  | # history size is bigger than our maximum length. | 
| 1634 |  |  |  |  |  |  |  | 
| 1635 |  |  |  |  |  |  | unshift(@{$winref->{Input}{Command_History}}, $winref->{Input}{Data}); | 
| 1636 |  |  |  |  |  |  | pop(@{$winref->{Input}{Command_History}}) if @{$winref->{Input}{Command_History}} > $winref->{Input}{History_Size}; | 
| 1637 |  |  |  |  |  |  |  | 
| 1638 |  |  |  |  |  |  | # Reset the input, saved input, and history position.  Repaint the | 
| 1639 |  |  |  |  |  |  | # edit box. | 
| 1640 |  |  |  |  |  |  |  | 
| 1641 |  |  |  |  |  |  | $winref->{Input}{Data_Save} = $winref->{Input}{Data} = ""; | 
| 1642 |  |  |  |  |  |  | $winref->{Input}{Cursor_Save} = $winref->{Input}{Cursor} = $winref->{Input}{Prompt_Size} || 0; | 
| 1643 |  |  |  |  |  |  | $winref->{Input}{History_Position} = -1; | 
| 1644 |  |  |  |  |  |  |  | 
| 1645 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1646 |  |  |  |  |  |  | doupdate(); | 
| 1647 |  |  |  |  |  |  |  | 
| 1648 |  |  |  |  |  |  | return; | 
| 1649 |  |  |  |  |  |  | } | 
| 1650 |  |  |  |  |  |  |  | 
| 1651 |  |  |  |  |  |  | if ($flag == 1) { # get last history 'KEY_UP' | 
| 1652 |  |  |  |  |  |  |  | 
| 1653 |  |  |  |  |  |  | # At <0 command history, we save the input and move into the | 
| 1654 |  |  |  |  |  |  | # command history.  The saved input will be used in case we come | 
| 1655 |  |  |  |  |  |  | # back. | 
| 1656 |  |  |  |  |  |  |  | 
| 1657 |  |  |  |  |  |  | if ($winref->{Input}{History_Position} < 0) { | 
| 1658 |  |  |  |  |  |  | if (@{$winref->{Input}{Command_History}}) { | 
| 1659 |  |  |  |  |  |  | $winref->{Input}{Data_Save} = $winref->{Input}{Data}; | 
| 1660 |  |  |  |  |  |  | $winref->{Input}{Cursor_Save} = $winref->{Input}{Cursor}; | 
| 1661 |  |  |  |  |  |  | $winref->{Input}{Data} = | 
| 1662 |  |  |  |  |  |  | $winref->{Input}{Command_History}->[++$winref->{Input}{History_Position}]; | 
| 1663 |  |  |  |  |  |  | $winref->{Input}{Cursor} = length($winref->{Input}{Data}); | 
| 1664 |  |  |  |  |  |  | if ($winref->{Input}{Prompt_Size}) { | 
| 1665 |  |  |  |  |  |  | $winref->{Input}{Cursor} += $winref->{Input}{Prompt_Size}; | 
| 1666 |  |  |  |  |  |  | } | 
| 1667 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1668 |  |  |  |  |  |  | doupdate(); | 
| 1669 |  |  |  |  |  |  | } | 
| 1670 |  |  |  |  |  |  | } | 
| 1671 |  |  |  |  |  |  |  | 
| 1672 |  |  |  |  |  |  | # If we're not at the end of the command history, then we go | 
| 1673 |  |  |  |  |  |  | # farther back. | 
| 1674 |  |  |  |  |  |  |  | 
| 1675 |  |  |  |  |  |  | elsif ($winref->{Input}{History_Position} < @{$winref->{Input}{Command_History}} - 1) { | 
| 1676 |  |  |  |  |  |  | $winref->{Input}{Data} = $winref->{Input}{Command_History}->[++$winref->{Input}{History_Position}]; | 
| 1677 |  |  |  |  |  |  | $winref->{Input}{Cursor} = length($winref->{Input}{Data}); | 
| 1678 |  |  |  |  |  |  | if ($winref->{Input}{Prompt_Size}) { | 
| 1679 |  |  |  |  |  |  | $winref->{Input}{Cursor} += $winref->{Input}{Prompt_Size}; | 
| 1680 |  |  |  |  |  |  | } | 
| 1681 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1682 |  |  |  |  |  |  | doupdate(); | 
| 1683 |  |  |  |  |  |  | } | 
| 1684 |  |  |  |  |  |  |  | 
| 1685 |  |  |  |  |  |  | return; | 
| 1686 |  |  |  |  |  |  | } | 
| 1687 |  |  |  |  |  |  |  | 
| 1688 |  |  |  |  |  |  | if ($flag == 2) { # get next history 'KEY_DOWN' | 
| 1689 |  |  |  |  |  |  |  | 
| 1690 |  |  |  |  |  |  | # At 0th command history.  Switch to saved input. | 
| 1691 |  |  |  |  |  |  | unless ($winref->{Input}{History_Position}) { | 
| 1692 |  |  |  |  |  |  | $winref->{Input}{Data} = $winref->{Input}{Data_Save}; | 
| 1693 |  |  |  |  |  |  | $winref->{Input}{Cursor} = $winref->{Input}{Cursor_Save}; | 
| 1694 |  |  |  |  |  |  | $winref->{Input}{History_Position}--; | 
| 1695 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1696 |  |  |  |  |  |  | doupdate(); | 
| 1697 |  |  |  |  |  |  | } | 
| 1698 |  |  |  |  |  |  |  | 
| 1699 |  |  |  |  |  |  | # At >0 command history.  Move towards 0. | 
| 1700 |  |  |  |  |  |  | elsif ($winref->{Input}{History_Position} > 0) { | 
| 1701 |  |  |  |  |  |  | $winref->{Input}{Data} = $winref->{Input}{Command_History}->[--$winref->{Input}{History_Position}]; | 
| 1702 |  |  |  |  |  |  | $winref->{Input}{Cursor} = length($winref->{Input}{Data}); | 
| 1703 |  |  |  |  |  |  | if ($winref->{Input}{Prompt_Size}) { | 
| 1704 |  |  |  |  |  |  | $winref->{Input}{Cursor} += $winref->{Input}{Prompt_Size}; | 
| 1705 |  |  |  |  |  |  | } | 
| 1706 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1707 |  |  |  |  |  |  | doupdate(); | 
| 1708 |  |  |  |  |  |  | } | 
| 1709 |  |  |  |  |  |  |  | 
| 1710 |  |  |  |  |  |  | return; | 
| 1711 |  |  |  |  |  |  | } | 
| 1712 |  |  |  |  |  |  |  | 
| 1713 |  |  |  |  |  |  | warn "unknown flag $flag"; | 
| 1714 |  |  |  |  |  |  | } | 
| 1715 |  |  |  |  |  |  |  | 
| 1716 |  |  |  |  |  |  | sub set_status_field { | 
| 1717 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter set_status_field\n"; } | 
| 1718 |  |  |  |  |  |  | my $self = shift; | 
| 1719 |  |  |  |  |  |  | my $window_id = shift; | 
| 1720 |  |  |  |  |  |  | my $validity = validate_window($self, $window_id); | 
| 1721 |  |  |  |  |  |  | if ($validity) { | 
| 1722 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$window_id}; | 
| 1723 |  |  |  |  |  |  | my $status_obj = $winref->{Status_Object}; | 
| 1724 |  |  |  |  |  |  | $winref->{Status_Lines} = $status_obj->set(@_); | 
| 1725 |  |  |  |  |  |  | _refresh_status($self, $window_id); | 
| 1726 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1727 |  |  |  |  |  |  | doupdate(); | 
| 1728 |  |  |  |  |  |  |  | 
| 1729 |  |  |  |  |  |  | } | 
| 1730 |  |  |  |  |  |  | } | 
| 1731 |  |  |  |  |  |  |  | 
| 1732 |  |  |  |  |  |  | sub set_status_format { | 
| 1733 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter set_status_format\n"; } | 
| 1734 |  |  |  |  |  |  | my $self = shift; | 
| 1735 |  |  |  |  |  |  | my $window_id = shift; | 
| 1736 |  |  |  |  |  |  | my %status_formats = @_; | 
| 1737 |  |  |  |  |  |  | if (DEBUG) { print ERRS %status_formats, " <-status_formats\n"; } | 
| 1738 |  |  |  |  |  |  | my $validity = validate_window($self, $window_id); | 
| 1739 |  |  |  |  |  |  | if ($validity) { | 
| 1740 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$window_id}; | 
| 1741 |  |  |  |  |  |  | my $status_obj = $winref->{Status_Object}; | 
| 1742 |  |  |  |  |  |  | if (DEBUG) { print ERRS "calling status_obj->set_format\n"; } | 
| 1743 |  |  |  |  |  |  | $status_obj->set_format(%status_formats); | 
| 1744 |  |  |  |  |  |  | if (DEBUG) { print ERRS "calling status_obj->get\n"; } | 
| 1745 |  |  |  |  |  |  | $winref->{Status_Lines} = $status_obj->get(); | 
| 1746 |  |  |  |  |  |  | if (DEBUG) { print ERRS "calling refresh_status\n"; } | 
| 1747 |  |  |  |  |  |  | # Update the status line. | 
| 1748 |  |  |  |  |  |  | _refresh_status( $self, $window_id ); | 
| 1749 |  |  |  |  |  |  | if (DEBUG) { print ERRS "returned from refresh_status\n"; } | 
| 1750 |  |  |  |  |  |  | doupdate(); | 
| 1751 |  |  |  |  |  |  | } | 
| 1752 |  |  |  |  |  |  | } | 
| 1753 |  |  |  |  |  |  |  | 
| 1754 |  |  |  |  |  |  | sub _refresh_status { | 
| 1755 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter _refresh_status\n"; } | 
| 1756 |  |  |  |  |  |  | my ($self, $window_id) = (shift, shift); | 
| 1757 |  |  |  |  |  |  |  | 
| 1758 |  |  |  |  |  |  | if ($window_id != $self->[CUR_WIN]) { return; } | 
| 1759 |  |  |  |  |  |  |  | 
| 1760 |  |  |  |  |  |  | my ($row, $value); | 
| 1761 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$window_id}; | 
| 1762 |  |  |  |  |  |  | my $status = $winref->{Window_Status}; | 
| 1763 |  |  |  |  |  |  | my @status_lines = @{$winref->{Status_Lines}}; | 
| 1764 |  |  |  |  |  |  | while (@status_lines) { | 
| 1765 |  |  |  |  |  |  | if (DEBUG) { print ERRS "in main while loop of refresh_status\n"; } | 
| 1766 |  |  |  |  |  |  | $row = shift @status_lines; | 
| 1767 |  |  |  |  |  |  | $value = shift @status_lines; | 
| 1768 |  |  |  |  |  |  | if (DEBUG) { print ERRS "$row <-row value-> $value\n"; } | 
| 1769 |  |  |  |  |  |  | if (DEBUG) { print ERRS $status, "<-status ref\n"; } | 
| 1770 |  |  |  |  |  |  | $status->move( $row, 0 ); | 
| 1771 |  |  |  |  |  |  |  | 
| 1772 |  |  |  |  |  |  | # Parse the value.  Stuff surrounded by ^C is considered color | 
| 1773 |  |  |  |  |  |  | # names.  This interferes with epic/mirc colors. | 
| 1774 |  |  |  |  |  |  |  | 
| 1775 |  |  |  |  |  |  | while (defined $value and length $value) { | 
| 1776 |  |  |  |  |  |  | if (DEBUG) { print ERRS "while defined value and length value in refresh_status\n"; } | 
| 1777 |  |  |  |  |  |  | if ($value =~ s/^\0\(([^\)]+)\)//) { | 
| 1778 |  |  |  |  |  |  | if (DEBUG) { print ERRS "value matched", '^\0\(([^\)]+)\)', "\n"; } | 
| 1779 |  |  |  |  |  |  | $status->attrset($self->[PALETTE]->{$1}->[PAL_PAIR]); | 
| 1780 |  |  |  |  |  |  | $status->noutrefresh(); | 
| 1781 |  |  |  |  |  |  | } | 
| 1782 |  |  |  |  |  |  | if ($value =~ s/^([^\0]+)//) { | 
| 1783 |  |  |  |  |  |  | if (DEBUG) { print ERRS "value matched", '^([^\0]+)', "\n"; } | 
| 1784 |  |  |  |  |  |  | $status->addstr($1); | 
| 1785 |  |  |  |  |  |  | $status->noutrefresh(); | 
| 1786 |  |  |  |  |  |  | } | 
| 1787 |  |  |  |  |  |  | } | 
| 1788 |  |  |  |  |  |  | } | 
| 1789 |  |  |  |  |  |  |  | 
| 1790 |  |  |  |  |  |  | # Clear to the end of the line, and refresh the status bar. | 
| 1791 |  |  |  |  |  |  | $status->attrset($self->[PALETTE]->{st_frames}->[PAL_PAIR]); | 
| 1792 |  |  |  |  |  |  | $status->noutrefresh(); | 
| 1793 |  |  |  |  |  |  | $status->clrtoeol(); | 
| 1794 |  |  |  |  |  |  | $status->noutrefresh(); | 
| 1795 |  |  |  |  |  |  |  | 
| 1796 |  |  |  |  |  |  | } | 
| 1797 |  |  |  |  |  |  |  | 
| 1798 |  |  |  |  |  |  | sub set_input_prompt { | 
| 1799 |  |  |  |  |  |  | if (DEBUG) { print ERRS "Enter set_input_prompt\n"; } | 
| 1800 |  |  |  |  |  |  | my $self = shift; | 
| 1801 |  |  |  |  |  |  | my $window_id = shift; | 
| 1802 |  |  |  |  |  |  | my $prompt = shift; | 
| 1803 |  |  |  |  |  |  | my $validity = validate_window($self, $window_id); | 
| 1804 |  |  |  |  |  |  | if ($validity) { | 
| 1805 |  |  |  |  |  |  | my $winref = $self->[WINDOW]->{$window_id}; | 
| 1806 |  |  |  |  |  |  | $winref->{Input}{Cursor} -= $winref->{Input}{Prompt_Size}; | 
| 1807 |  |  |  |  |  |  | $winref->{Input}{Prompt} = $prompt; | 
| 1808 |  |  |  |  |  |  | $winref->{Input}{Cursor} = $winref->{Input}{Prompt_Size} = length $prompt; | 
| 1809 |  |  |  |  |  |  | _refresh_edit($self, $window_id); | 
| 1810 |  |  |  |  |  |  | doupdate(); | 
| 1811 |  |  |  |  |  |  | } | 
| 1812 |  |  |  |  |  |  | } | 
| 1813 |  |  |  |  |  |  |  | 
| 1814 |  |  |  |  |  |  | sub set_errlevel {} | 
| 1815 |  |  |  |  |  |  | sub get_errlevel {} | 
| 1816 |  |  |  |  |  |  |  | 
| 1817 |  |  |  |  |  |  | sub debug { | 
| 1818 |  |  |  |  |  |  | my $self = shift; | 
| 1819 |  |  |  |  |  |  | if (DEBUG) { for (@_) { print ERRS "$_\n";} } | 
| 1820 |  |  |  |  |  |  | else { carp "turn on debugging in Term::Visual or define sub Term::Visual::DEBUG () { 1 }; before use Term::Visual; in your program"; } | 
| 1821 |  |  |  |  |  |  |  | 
| 1822 |  |  |  |  |  |  | } | 
| 1823 |  |  |  |  |  |  |  | 
| 1824 |  |  |  |  |  |  | sub shutdown { | 
| 1825 |  |  |  |  |  |  | my $self = shift; | 
| 1826 |  |  |  |  |  |  |  | 
| 1827 |  |  |  |  |  |  | $poe_kernel->post($self->[ALIAS], "_stop"); | 
| 1828 |  |  |  |  |  |  |  | 
| 1829 |  |  |  |  |  |  | #    $_[KERNEL]->alias_remove($_[OBJECT][ALIAS]); | 
| 1830 |  |  |  |  |  |  | #    delete $_[HEAP]->{stderr_reader}; | 
| 1831 |  |  |  |  |  |  | #    undef $console; | 
| 1832 |  |  |  |  |  |  | #    if (defined $_[HEAP]->{input_session}) { | 
| 1833 |  |  |  |  |  |  | #      $_[KERNEL]->post( $_[HEAP]->{input_session}, $_[HEAP]->{input_event}, | 
| 1834 |  |  |  |  |  |  | #                        undef, 'interrupt' ); | 
| 1835 |  |  |  |  |  |  |  | 
| 1836 |  |  |  |  |  |  | #clean up, and close Term::Visual's session so that the only thing that is left is client side, and when ^\ is punched in, clean up things that would leak otherwise, and interrupt? | 
| 1837 |  |  |  |  |  |  |  | 
| 1838 |  |  |  |  |  |  | #    } | 
| 1839 |  |  |  |  |  |  | } | 
| 1840 |  |  |  |  |  |  |  | 
| 1841 |  |  |  |  |  |  | 1; | 
| 1842 |  |  |  |  |  |  |  | 
| 1843 |  |  |  |  |  |  | __END__ |