modules/FvwmConsole/FvwmConsoleC.pl.in

   1 #! @PERL@
   2 #    $0 - Front end of FvwmConsole
   3 #    FvwmConsole server must be running
   4
   5 # Copyright 1997, Toshi Isogai
   6 # You may use this code for any purpose, as long as the original
   7 # copyright remains in the source code and all documentation
   8
   9 # This program is free software; you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 2 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # This program is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program; if not, write to the Free Software
  21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22
  23 # If you change this, be sure to change the test in configure.in
  24 require 5.002;
  25
  26 use Socket;
  27
  28 $ESC = "\e";
  29 $HISTFILE = "$ENV{FVWM_USERDIR}/.FvwmConsole-History0";
  30 $SOCKET_NAME = "$ENV{FVWM_USERDIR}/.FvwmConsole-Socket";
  31 #$VERSION = '1.2';
  32 $VERSION = '@VERSION@';
  33
  34
  35
  36 if (-c "/dev/console" && -w "/dev/console") {
  37         close STDERR;
  38         if (!open (STDERR, ">/dev/console")) {
  39                 print "Can't redirect STDERR to /dev/console: $!\n";
  40                 sleep 3;
  41                 exit;
  42         }
  43 }
  44
  45 ($Filename = $0) =~ s@.*/@@;
  46 ($Sname = $Filename) =~ s/C(\.pl)?$//;
  47
  48
  49 $tty = `tty`;
  50 $tty =~ s/\n//;
  51 $org_stty = &stty('-g');
  52
  53 @Hist = ();
  54 @Histall = ();
  55 $HIST_SIZE = 100;
  56 $MAX_COMMAND_SIZE = 1000;
  57
  58 main();
  59 exit;
  60
  61
  62 sub main::default_key {
  63 #------------ default key bindings ----------
  64 # these can be overidden by config lines
  65 #
  66 # It may need these lines in .Xdefault to make home and end key work
  67 # FvwmConsole*VT100*Translations: #override \n \
  68 #       <Key> Home: string(0x1b) string("[1~" ) \n \
  69 #       <Key> Delete:  string(0x1b) string("[3~" ) \n
  70 #       <Key> End:  string(0x1b) string("[4~" ) \n
  71
  72         package User;
  73
  74         $ESC = $main::ESC;
  75         $Key{"$ESC\[1~"} = 'bol';  #home Key
  76         $Key{"$ESC\[3~"} = 'del_char';
  77         $Key{"$ESC\[4~"} = 'eol';  #end key
  78         $Key{"$ESC\[A"}= 'prev_line'; #up
  79         $Key{"$ESC\[B"}= 'next_line'; #down
  80         $Key{"$ESC\[C"}= 'next_char'; #right
  81         $Key{"$ESC\[D"}= 'prev_char'; #left
  82         $Key{"${ESC}f"}= 'next_word';
  83         $Key{"${ESC}b"} = 'prev_word';
  84
  85         $Key{"$ESC"} = 'prefix';
  86         $Key{"\cD"} = 'del_char';
  87         $Key{"\c?"} = 'del_char';
  88         $Key{"\cH"} = 'bs';
  89         $Key{"\cq"} = 'quote';
  90         $Key{"\cU"} = 'del_line';
  91         $Key{"\cs"} = 'search';
  92         $Key{"\cR"} = 'search_rev';
  93         $Key{"\cK"} = 'del_forw_line';
  94         $Key{"\ca"} = 'bol';
  95         $Key{"\ce"} = 'eol';
  96         $Key{"\cp"} = 'prev_line';
  97         $Key{"\cn"} = 'next_line';
  98         $Key{"\cf"} = 'next_char';
  99         $Key{"\cb"} = 'prev_char';
 100         $Key{"\cx"} = 'prefix';
 101         $Key{"\cx\cb"} = 'bind';
 102         $Key{"\cx\ck"} = 'cancel';
 103         $Key{"\cw"} = 'del_back_word';
 104         $Key{"\x8d"} = 'enter_wo_subst'; # alt enter
 105         $Key{"\n"} = 'enter';
 106         $Key{"\ci"} = 'ins_char (" ")';
 107         $Key{"\xE4"} = 'del_forw_word'; # alt_d
 108         $Key{"\xE6"} = 'next_word'; # alt_f
 109         $Key{"\xEB"} = 'bind'; # alt_k
 110         $Key{"\xEC"} = 'list_func'; # alt_k
 111         $Key{"\xF3"} = 'subst'; # alt_s
 112         $Key{"\xF4"} = 'termsize'; # alt_t
 113         $Key{"\xE2"} = 'prev_word'; # alt_b
 114         $Key{"\xb1"} = 'ins_nth_word(1)';
 115         $Key{"\xb2"} = 'ins_nth_word(2)';
 116         $Key{"\xb3"} = 'ins_nth_word(3)';
 117         $Key{"\xb4"} = 'ins_nth_word(4)';
 118         $Key{"\xb5"} = 'ins_nth_word(5)';
 119         $Key{"\xb6"} = 'ins_nth_word(6)';
 120         $Key{"\xb7"} = 'ins_nth_word(7)';
 121         $Key{"\xb8"} = 'ins_nth_word(8)';
 122         $Key{"\xb9"} = 'ins_nth_word(9)';
 123         $Key{"${ESC}b"} = 'prev_word'; # esc_b
 124         $Key{"${ESC}f"} = 'next_word'; # esc_f
 125         $Key{"${ESC}>"} = 'eoh_ign_mode'; # end of history, ignore mode
 126         $Key{"${ESC}<"} = 'boh_ign_mode'; # begining of history, ignore mode
 127         $Key{"${ESC}."} = 'ins_last_word';
 128
 129         $Key{EOF} = "\cD"; #eof work only when line is empty
 130     $Subst{'^#.*'} = ''; # ignore comments
 131 #---------------- end of key binding -----------------
 132
 133 #---------------- Terminal control -------------------
 134         $TERM_EEOL = "$ESC\[K";         # erase to end of line
 135         $TERM_RIGHT = "$ESC\[C";      # move cursor right
 136         $TERM_LEFT = "$ESC\[D";      # move cursor left
 137         $TERM_DOWN = "$ESC\[B";        # move cursor up
 138         $TERM_UP = "$ESC\[A";        # move cursor up
 139 }
 140
 141 sub read_config {
 142         my( $hash,@keys,$key,@vals,$val);
 143         while(<SH>) {
 144                 last if $_ eq "_C_Config_Line_End_\n";
 145                 next if !s/^\*${Sname}//;
 146             ($hash,@keys[0..3],@vals) =
 147                         (/
 148                          ^(\w+)\s+    #hash name
 149                          ('([^\']*)'|"([^\"]*)"|(\S+))  #key quoted or bare word
 150                          (\s+('([^\']*)'|"([^\"]*)"|(\S+)))? #value
 151                          /x);
 152             $key = $keys[1].$keys[2].$keys[3];
 153             $val = $vals[2].$vals[3].$vals[4];
 154
 155             if( defined %{$User::{$hash}} ) {
 156             User::bind( $hash, $key, $val );
 157                   }
 158     }
 159 }
 160
 161 sub main {
 162         my($sin, $cmd);
 163         my($name, $ppid, $cpid);
 164
 165         socket(SH, PF_UNIX, SOCK_STREAM, 0) || die "$!\n";
 166         $sun = sockaddr_un($SOCKET_NAME);
 167         connect(SH, $sun) || die "$sun: $!\n";
 168         print "$Filename $VERSION\n";
 169         default_key();
 170         read_config();  #must be done before forking
 171
 172         $ppid = $$;
 173         if( $cpid = fork()  ) {
 174                 &input_open($tty,$tty,$HISTFILE,1);
 175                 while( $cmd = &input('','',1) ) {
 176                         next if $cmd =~/^\s*$/;
 177                         last if $cmd eq "\0";
 178                         if( length($cmd) > $MAX_COMMMAND_SIZE ) {
 179                                 print User::OUT "\a";
 180                         }
 181                         send( SH, $cmd."\0", 0 );
 182                 }
 183                 dokill( $cpid );
 184         } else {
 185                 #child handles output
 186                 while(<SH>) {
 187                         last if $_ eq '';
 188                         if( $_  eq "_C_Socket_Close_\n" ) {
 189                                 dokill( $ppid );
 190                         }
 191                         print;
 192                 }
 193                 dokill( $ppid );
 194         }
 195
 196 }
 197
 198 sub dokill {
 199         my($pid) = @_;
 200         unlink SH;
 201         kill -9,$pid if $pid;
 202         exit;
 203 }
 204
 205 sub input_open {
 206         # arg0 input device
 207         # arg1 output device
 208         # arg2 history file
 209         # arg3 key selection - bit0
 210         #                      bit1
 211         #                      bit2 return undef esc code as it is
 212
 213         ($Dev_in,$Dev_out,$File,$Ksel) = @_;
 214         if( !$Dev_in ) {$Dev_in = $tty;}
 215         elsif( $Dev_in eq "not a tty" ) { $Dev_in = $ENV{'TTY'};}
 216         if( !$Dev_out ) {$Dev_out = $tty;}
 217         if( !$File ) { $File = '/tmp/input.tmp';}
 218         open(User::IN,"<$Dev_in") || die "open in at input_open '$Dev_in' $!\n";
 219         open(User::OUT,">$Dev_out") || die "can't open input at 'input_open' $!\n";
 220         select((select(User::OUT), $| = 1)[0]); # unbuffer pipe
 221         if( defined $File ) {
 222                 if( open(INITF,"$File") ) {
 223                         do "$File";
 224                         @Histall=<INITF>; close(INITF); $#Histall--;
 225                 }else{
 226                         print STDERR "Can't open history file $File\n";
 227                 }
 228         }
 229 }
 230
 231 sub input_close  {
 232         close(User::IN);
 233         close(User::OUT);
 234 }
 235
 236 sub getchar  {
 237         # get char from input
 238     # if esc , check for more char
 239     my($c,$s,$rin,$rout);
 240         sysread(User::IN, $c, 1);
 241         if( $c ne $ESC ) {
 242                 $s = $c;
 243         }else {
 244                 $rin = '';
 245                 vec( $rin, fileno(User::IN),1) = 1;
 246                 $n= select( $rout=$rin, undef, undef, 0.1 );
 247                 $s = $ESC;
 248                 if($n) {
 249                         while($n= select( $rout=$rin, undef, undef, 0.1 ) ) {
 250                                 sysread( User::IN, $c, 1 );
 251                                 $s .= $c;
 252                                 last if $c =~ /[A-Dz~]/;     # end of escape seq
 253                         }
 254                 }
 255         }
 256     $s;
 257 }
 258
 259 sub insert_char {
 260         local($c,*len,*ix,*hist) =@_;
 261         local($clen);
 262         $clen = length $c;
 263         if( $init_in ) {
 264                 $len = $ix = $clen; # new hist - clear old one
 265                 $hist[$#hist] = $c;
 266         }else{
 267                 substr($hist[$#hist],$ix,0) = $c;   #insert char
 268                 $len += $clen;
 269                 $ix += $clen;
 270         }
 271 }
 272 sub stty    {
 273         my($arg) = @_;
 274         `/bin/stty $arg <$tty 2>&1`;
 275 #       if( -x "/usr/5bin/stty" ) {
 276 #               `/usr/5bin/stty $arg <$tty`;
 277 #       }elsif( -x "/usr/bin/stty" ) {
 278 #               `/usr/bin/stty $arg `;
 279 #       }else {
 280 #               `/bin/stty $arg `;
 281 #       }
 282 }
 283
 284 sub add_hist {
 285   # add input into history file
 286         local($type,*cmd) = @_; #not my
 287         my( $t )= sprintf("%s",$type);
 288         my($h) = $cmd[$#cmd];
 289         return if !defined $File;
 290         if( $#cmd ==0 || $h ne $cmd[$#cmd-1] )        {
 291                 $h =~ s/([\"@\$\\])/\\$1/g;
 292                 $t =~ s/^\*//;
 293                 push(@Histall, "push  (\@$t, \"$h\");\n" );
 294                 @Histall = splice( @Histall, -$HIST_SIZE, $HIST_SIZE ); # take last HIST_SIZE commands
 295                 if( open( FILE, ">$File" ) ){
 296                         print FILE @Histall;
 297                         print FILE "1;\n";
 298                         close(FILE);
 299                 }
 300         }else {
 301                 $#cmd--;
 302         }
 303 }
 304
 305 #----------------
 306 # print mini help
 307 #----------------
 308 sub usage_error {
 309         open( THIS, "$0");
 310     while(<THIS>) {
 311                 s/\$0/$Filename/;
 312                 if( /^\#/ ) {
 313                         print STDERR $_;
 314                 }else{
 315                         last;
 316                 }
 317         }
 318         close THIS;
 319 sleep 3;
 320 exit 1;
 321 }
 322
 323 sub search_mode {
 324         local(*c, *s, *prompt, *mode, *isp, *hist ) =@_;
 325         my($p_save, $isp_cur);
 326         if($c eq "\n"){
 327                 $prompt = $p_save;
 328                 $mode = 'normal';
 329                 last IN_STACK;
 330         }
 331         $isp_cur = $isp;
 332         if( $User::Key{$c} =~ /^search/ ) {
 333                 #search furthur
 334                 $mode = $User::Key{$c};
 335                 while(1) {
 336                         if( $mode eq 'search_rev' && --$isp<0 ||
 337                            $mode eq 'search' && ++$isp>$#hist-1 ) {
 338                                 print User::OUT "\a"; # couldn't find one
 339                                 $isp = $isp_cur;
 340                                 last;
 341                         }
 342                         last if( index($hist[$isp],$s) >=0);
 343                 }
 344         }elsif( $User::Key{$c} eq 'bs' ) {
 345                 $s =~ s/.$//;
 346         }elsif( ord($c) < 32 ) {
 347                 #non-printable char, get back to normal mode
 348                 print User::OUT "\a";
 349                 $prompt = $p_save;
 350                 $mode = 'normal';
 351                 return;
 352         }else{
 353                 $s .= $c;
 354                 while(1) {
 355                         last if (index($hist[$isp],$s) >=0);
 356                         if( $mode eq 'search_rev' && --$isp<0 ||
 357                            $mode eq 'search' && ++$isp>$#hist ) {
 358                                 print User::OUT "\a";   #couldn't find one
 359                                 chop($s);
 360                                 $isp = $isp_cur;
 361                                 last;
 362                         }
 363                 }
 364         }
 365         $prompt = "($mode)'$s':";
 366 }
 367
 368 sub calcxy {
 369         my( $mode, $prompt, $len, $ix, $off, $wd ) = @_;
 370         my($plen);
 371         my(     $y_len, $y_ix, $col);
 372         my($adjust);  # 1 when the last char is on right edge
 373
 374         $plen = length($prompt);
 375         $y_len = int (($plen+$len+$off) / $wd );
 376         $adjust = ( (($plen+$len+$off) % $wd == 0) && ($y_len > 0 )) ? 1:0;
 377         if( $mode =~ /^search/ ) {
 378                 #move cursor to search string
 379                 $y_ix = int (($plen-2+$off) / $wd );
 380                 $col = ($plen-2+$off) % $wd;
 381         }else{
 382                 #normal mode - move cursor back to $ix
 383                 $y_ix = int (($plen+$ix+$off) / $wd );
 384                 $col = ($plen+$ix+$off) % $wd;
 385         }
 386         ($y_len, $y_ix, $col, $adjust);
 387 }
 388
 389 package User;
 390
 391 sub move_cursor {
 392         my($x,$y, $x_prev,$y_prev) = @_;
 393         my($termcode);
 394
 395         $termcode = '';
 396         if($y > $y_prev ) {
 397                 $termcode = $TERM_DOWN x ($y-$y_prev);
 398         }elsif( $y < $y_prev ) {
 399                 $termcode = $TERM_UP x ($y_prev-$y);
 400         }
 401         if( $x > $x_prev ) {
 402                 $termcode .= $TERM_RIGHT x ($x-$x_prev);
 403         }elsif( $x < $x_prev ) {
 404                 $termcode .= $TERM_LEFT x ($x_prev-$x);
 405         }
 406         print OUT $termcode;
 407 }
 408
 409 sub another_line {
 410         $init_in = 1-$app;
 411         ($hist[$#hist] = $hist[$isp]) =~ s/\n//;
 412         $ix = length($hist[$#hist]);
 413 }
 414
 415 sub main::input {
 416         # arg0 - prompt
 417         # arg1 - input stack
 418         # arg2 - append input to command if 1
 419         # arg3 - # of column offset
 420         local($prompt,*hist,$app,$off) = @_;
 421         local($len,$ix);
 422         local($c,$isp,$s,$wisp);
 423         local($mode);
 424         local(%lastop);
 425
 426         local($init_in);
 427         local($print_line);  #0-none, 1-whole, 2-from cursor
 428         my($y_ix,$y_ix0,$y_len,$wd,$ht,$col,$col0);
 429         my($term);
 430         my($init_in,$op);
 431
 432         $off = 0 if( !defined $off );
 433         *hist = *main::Hist if( ! defined @hist );
 434         $isp = ++$#hist ;
 435         $wisp = $isp;
 436         if( -f "/vmunix" ) {
 437                 &main::stty("-echo -icanon min 1 time 0 stop ''");
 438         }else {
 439                 &main::stty(" -echo -icanon eol \001 stop ''");
 440         }
 441         ($ht,$wd) = &termsize();
 442         $y_ix = $y_len = 0;
 443         $mode = 'normal';
 444         another_line();
 445         $print_line = 1;
 446
 447         IN_STACK:while(1){
 448
 449                   if( $print_line==0 ) {
 450                           #just move cursor
 451                           ($y_len,$y_ix,$col,$adjust) =
 452                                 &main::calcxy($mode,$prompt,$len,$ix,$off,$wd);
 453                           move_cursor( $col,$y_ix, $col0,$y_ix0);
 454
 455                   }elsif($print_line==2 || $print_line==3 ) {
 456                           # delete - print cursor to eol
 457                           $len = length($hist[$#hist]);
 458                           ($y_len,$y_ix,$col,$adjust) =
 459                                 &main::calcxy($mode,$prompt,$len,$ix,$off,$wd);
 460
 461                           if( $print_line==3 ) {
 462                                   # delete backward
 463                                   move_cursor( $col,$y_ix, $col0,$y_ix0);
 464                           }
 465
 466                           if( $y_len0 > $y_ix && ($adjust || $y_len0 > $y_len) ) {
 467                                   print( OUT "\n$TERM_EEOL" x ($y_len0-$y_ix),
 468                                                  $TERM_UP x ($y_len0-$y_ix),
 469                                                  "\r", $TERM_RIGHT x $col,  );
 470                           }
 471                           print( OUT substr("$prompt$hist[$#hist]", $ix),
 472                                          $adjust ? '':$TERM_EEOL,
 473                                          "\r", $TERM_RIGHT x $col,
 474                                          $TERM_UP x ($y_len-$y_ix) ,
 475                                          ($adjust && $ix!=$len)? $TERM_DOWN : '' );
 476
 477
 478                   }elsif($print_line==4) {
 479                           # insert
 480                           $len = length($hist[$#hist]);
 481                           ($y_len,$y_ix,$col,$adjust) =
 482                                 &main::calcxy($mode,$prompt,$len,$ix,$off,$wd);
 483
 484                           print( OUT substr("$prompt$hist[$#hist]", $ix),
 485                                          $TERM_UP x ($y_len-$y_ix) ,"\r", $TERM_RIGHT x $col,
 486                                          $TERM_DOWN x $adjust );
 487
 488                   }else{
 489                           # print whole line
 490                           $len = length($hist[$#hist]);
 491                           #move cursor to bol on screen, erase prev printout
 492                           print (OUT $TERM_DOWN x ($y_len-$y_ix),
 493                                          "\r$TERM_EEOL$TERM_UP" x ($y_len),
 494                                          "\r$TERM_EEOL\r",
 495                                          $TERM_RIGHT x $off,"$prompt$hist[$#hist]");
 496                           ($y_len,$y_ix,$col,$adjust) =
 497                                 &main::calcxy($mode,$prompt,$len,$ix,$off,$wd);
 498
 499                           #mv cursor to cur pos
 500                           print( OUT $TERM_UP x ($y_len-$y_ix) ,"\r", $TERM_RIGHT x $col,
 501                                          $TERM_DOWN x $adjust);
 502                   }
 503
 504
 505         GETC:{
 506                           ($col0, $y_ix0, $y_len0) = ($col, $y_ix, $y_len);
 507                           $print_line=1;
 508
 509                           $c = main::getchar();
 510                           while($Key{$c} eq "prefix" ) {
 511                                   $c .= main::getchar();
 512                           }
 513
 514                           ($op = $Key{$c}) =~ s/(.*)\s*[\(;].*/$1/;
 515                           $op =~ /(\w+)$/;
 516                           $op = $1;
 517
 518                         if( $Key{$c} =~ /ign_mode/ ) {
 519                                 # ignore mode and execute command
 520                                 eval "&{$Key{$c}}";
 521                         }elsif( $mode =~ /^search/ ) {
 522                           main::search_mode(*c,*s,*prompt,*mode,*isp, *hist);
 523                                 another_line();
 524                         }elsif( $c eq $Key{EOF} && $len==0 ) {
 525                                 return '';      # eof return null
 526                         }elsif( defined $Key{$c} ) {
 527                                 eval "&{$Key{$c}}";
 528                                 $lastop{op} = $op;
 529                         }elsif( ord ($c) < 32 ) {
 530                                 #undefined control char
 531                                 print OUT "\a";
 532                                 $print_line = 0;
 533                         }else {
 534                                 $lastop{op} = 'ins_char';
 535                                 &ins_char( $c );
 536                                 print OUT $c;
 537                         }
 538                         $init_in = 0;
 539                 }
 540         }
 541
 542     if( $y_ix != $y_len ) {
 543                 print OUT "\n" x ($y_len-$y_ix);
 544     }
 545     &main::stty($org_stty);
 546
 547         print OUT "\n";
 548         if( $hist[$#hist] eq '' ) {
 549                 pop(@hist);
 550                 return "\n";
 551         }
 552         if( $#hist>0 && $hist[$#hist] eq $hist[$#hist-1] ) {
 553                 pop(@hist);    # if it is the same, delete
 554         }else{
 555                 &main::add_hist( *hist, *hist );
 556         }
 557         $hist[$#hist]."\n";
 558 }
 559
 560 #-----------------------------
 561 # editinig command functions
 562 #
 563 #   functions must be below here to be listed by list_func
 564 #
 565 #   the variables below are local to sub input
 566 #       $prompt,$hist,$app,$off
 567 #       $len,$ix
 568 #       $c,$isp,$wisp,$s
 569 #   $mode
 570 #-----------------------------
 571 sub prefix { } # it's only here to be listed by list_func
 572 sub boh {
 573         $isp = 0;
 574         another_line();
 575 }
 576 sub boh_ign_mode {
 577         boh();
 578 }
 579 sub bol {
 580         $ix = 0 ;
 581         $print_line=0;
 582 }
 583 sub bs  {
 584         my($l) = @_;
 585         $l = 1 if $l eq '';
 586         if( $len && $ix ) {
 587                 $ix-=$l;        # mv left
 588                 substr($hist[$#hist],$ix,$l) = "";   # del char
 589         }
 590         $print_line = 3;
 591 }
 592 sub del_back_line {
 593         substr($hist[$#hist],0,$ix) = "";
 594         $ix = 0;
 595         $print_line = 3;
 596 }
 597 sub del_forw_line {
 598         substr($hist[$#hist],$ix) = "";
 599         $print_line = 2;
 600 }
 601 sub del_char {
 602         my($l) = @_;
 603         $l = 1 if $l eq '';
 604         if( $len > $ix ) {
 605                 substr($hist[$#hist],$ix,$l) = "";   # del char
 606         }
 607         $print_line = 2;
 608 }
 609 sub del_line {
 610         $ix = 0;
 611         $hist[$#hist] = "";
 612         $print_line = 3;
 613 }
 614 sub del_back_word {
 615         my($tmp);
 616         $tmp = substr($hist[$#hist],0,$ix);
 617         $tmp =~ s/(^|\S+)\s*$//;
 618         $tmp = length $tmp;
 619         substr($hist[$#hist],$tmp,$ix-$tmp) = "";
 620         $ix = $tmp;
 621         $print_line = 3;
 622 }
 623 sub del_forw_word {
 624         $hist[$#hist] =~ s/^(.{$ix})\s*\S+/$1/;
 625         $print_line = 2;
 626 }
 627 sub enter {
 628         subst();
 629         enter_wo_subst();
 630 }
 631 sub eoh          {
 632         if( $isp==$#hist ) {
 633                 print OUT "\a";
 634         }else{
 635                 $hist[$#hist] = ''
 636         }
 637         $isp = $#hist;
 638         another_line();
 639         $print_line = 1;
 640 }
 641 sub eoh_ign_mode {
 642         eoh();
 643         $print_line = 1;
 644 }
 645 sub eol {
 646         $ix = $len;
 647         $print_line=0;
 648 }
 649 sub execute {
 650     eval "$hist[$#hist]";
 651         if( $#hist>0 && $hist[$#hist] eq $hist[$#hist-1] ) {
 652                 pop(@hist);    # if it is the same, delete
 653         }else{
 654                 &main::add_hist( *hist, *hist );
 655         }
 656         push( @hist, ''); # deceive 'input' it is an empty line
 657         last IN_STACK;
 658 }
 659 sub ins_char {
 660         my($c) = @_;
 661         &main::insert_char($c,*len,*ix,*hist);
 662         $print_line = 4;
 663 }
 664 sub ins_last_word {
 665         if( $lastop{op} =~ /^ins_(nth|last)_word/ ) {
 666                 return if $wisp < 1;
 667                 #delete last last_word
 668                 bs(length $lastop{word});
 669         }else {
 670                 $wisp = $#hist;
 671                 return if $wisp < 1;
 672         }
 673         $hist[--$wisp] =~ /(\S+)\s*$/;
 674         $lastop{word} = $1;
 675         ins_char($lastop{word});
 676 }
 677 sub ins_nth_word {
 678         my($n) = @_;
 679         if( $lastop{op} =~ /^ins_(nth|last)_word/ ) {
 680                 return if $wisp < 1;
 681                 #delete last last_word
 682                 bs(length $lastop{word});
 683         }else {
 684                 $wisp = $#hist;
 685                 return if $wisp < 1;
 686         }
 687         $hist[--$wisp] =~ /((\S+)\s*){1,$n}/;
 688         $lastop{word} = $2;
 689         ins_char($lastop{word});
 690 }
 691 sub list_func {
 692         my( $s, @cmds, $cmd, $func);
 693         $func = 0;
 694         open( THIS, "$0" ) || return; #shouldn't occur
 695         while( $s = <THIS> ) {
 696                 if( $s =~ /^\s*sub\s+main::input\s*\{/ ) {
 697                         $func = 1;
 698                         next;
 699                 }
 700                 next if !$func;
 701                 if( $s =~ s/^\s*sub\s+// ) {
 702                         $s =~ s/\s*[\{].*//;
 703                         push @cmds,$s;
 704                 }
 705         }
 706         close THIS;
 707         foreach $cmd (sort @cmds) {
 708                 print OUT $cmd;
 709         }
 710 }
 711
 712 sub bind {
 713         # bind Key or Subst
 714     # if there is no arguments, then list them
 715         my($hash,$key,$val) = @_;
 716         my( $mod,$chr,$v2,$k,$cnt );
 717         if( defined %{$hash} ) {
 718                 $k = $key;
 719             if( $hash eq "Key" ) {
 720                         ($v2 = $val) =~ s/\s*[\(;].*//;
 721                         if( !defined &{$v2} ) {
 722                                 print STDERR "Unknown function $v2\n";
 723                                 return;
 724                         }
 725                         $mod = 0; $cnt =0; $k = '';
 726                         for( $i=0; $i<length $key; $i++ ) {
 727                                 $chr = substr($key,$i,1);
 728                                 if( $chr eq "\\" ) {
 729                                         $chr = substr($key,++$i,1);
 730                                         if( $chr=~/m/i ) {
 731                                                 $mod = 0x80;
 732                                         }elsif( $chr=~/c/i ) {
 733                                                 $cnt = 1;
 734                                         }elsif( $chr=~/e/i ) {
 735                                                 $chr = $ESC;
 736                                                 $chr = pack("c",ord($chr)+$mod);
 737                                                 $mod = 0 ; $cnt = 0;
 738                                                 $k .= $chr;
 739                                         }else {
 740                                                 print "Unknown char $key\n";
 741                                         }
 742                                 }else {
 743                                         if( $cnt ) {
 744                                                 eval "\$chr = \"\\c$chr\" ";
 745                                         }
 746                                         $chr = pack("c",ord($chr)+$mod);
 747                                         $mod = 0 ; $cnt = 0;
 748                                         $k .= $chr;
 749                                 }
 750                         }
 751                 }
 752                 if( $val eq '' ) {
 753                         delete ${$hash}{$k};
 754             }else {
 755                         ${$hash}{$k} = $val;
 756         }
 757
 758
 759     }else {
 760                 foreach $key (sort(keys(%Key) )){
 761                         $val = $Key{$key};
 762                         $mod = '';
 763                         while( $key =~ s/(.|\s)// ) {
 764                                 $chr = $1;
 765                                 if( ord($chr) >= 0x80 ) {
 766                                         $mod .= '\M';
 767                                         $chr = pack("c", ord($chr)-0x80);
 768                                 }
 769                                 if( $chr eq $ESC ) {
 770                                         $chr = '\E';
 771                                 }elsif( ord($chr) < 0x20 ) {
 772                                         $mod .= '\C';
 773                                         $chr = pack("c", ord($chr)+0x40);
 774                                 }elsif( ord($chr) == 0x7f ) {
 775                                         $chr = '\C?';
 776                                 }
 777                                 $mod .= $chr;
 778                         }
 779                         if( ord($val) < 0x20 ) {
 780                                 $val = '\C'.pack("c", ord($val)+0x40);
 781                         }
 782                         print OUT "Key $mod   $val\n";
 783                 }
 784         while( ($key,$val) = each(%Subst) ) {
 785                     print OUT "Subst $key   $val\n";
 786         }
 787         }
 788 }
 789 sub next_char {
 790         $ix++ if ($ix<$len);
 791         $print_line=0;
 792 }
 793
 794 sub next_line {
 795         if($isp<$#hist) {
 796                 $isp++;
 797                 if( $isp==$#hist ) {
 798                         $hist[$isp] = '';
 799                 }
 800         }else {
 801                 $isp = $#hist;
 802                 print OUT "\a";
 803         }
 804         another_line();
 805 }
 806
 807 sub next_word {
 808         $hist[$#hist] =~ /^(.{$ix}\S*(\s+|$))/;
 809         $ix = length($1);
 810         $print_line=0;
 811 }
 812
 813 sub enter_wo_subst {
 814         last IN_STACK;
 815 }
 816
 817 sub prev_char {
 818         $ix-- if $ix>0;
 819         $print_line=0;
 820 }
 821
 822 sub prev_line {
 823         if($isp>0) {
 824                 $isp--;
 825         }else {
 826                 $isp = 0;
 827                 print OUT "\a";
 828         }
 829         another_line();
 830 }
 831
 832 sub prev_word {
 833         my($tmp);
 834         $tmp = substr($hist[$#hist],0,$ix);
 835         $tmp =~ s/(^|\S+)\s*$//;
 836         $ix = length($tmp);
 837         $print_line=0;
 838 }
 839
 840 sub cancel {
 841         $hist[$#hist] = "";
 842         $len = 0;
 843         last IN_STACK;
 844 }
 845 sub quote {
 846         my($c);
 847         sysread(IN, $c, 1);
 848 #       $c = getc(IN);
 849         ins_char($c);
 850 }
 851
 852 sub search_rev {
 853         $s = '';
 854         $mode = 'search_rev';
 855         $p_save = $prompt;
 856         $prompt = "($mode)'$s':";
 857         $hist[$#hist] = $hist[$isp];
 858         another_line();
 859 }
 860
 861 sub search {
 862         $s = '';
 863         $mode = 'search';
 864         $p_save = $prompt;
 865         $prompt = "($mode)'$s':";
 866         $hist[$#hist] = $hist[$isp];
 867         another_line();
 868 }
 869
 870 sub subst {
 871         my($key,$val);
 872         $done = 0;
 873         while( ($key,$val) = each(%Subst) ) {
 874                 last if( eval "\$hist[\$#hist] =~ s\x05\$key\x05$val\x05" ) ;
 875         }
 876         $ix = $len = length($hist[$#hist]);
 877 }
 878
 879 sub termsize {
 880         my($row, $col,$s);
 881         if( -f "/vmunix" ) {
 882                 $s =&main::stty ("everything");
 883                 ($row,$col) = ($s =~ /(\d+)\s+rows[,\s]+(\d+)\s+columns/ );
 884         } else {
 885                 $s =&main::stty ("-a");
 886                 ($row,$col) = ($s =~ /rows[=\s]+(\d+)[,;\s]+columns[=\s]+(\d+)/ );
 887         }
 888         ($row,$col);
 889 }
 890