#!/usr/local/bin/perl # $0 - Front end of FvwmConsole # FvwmConsole server must be running # Copyright 1997, Toshi Isogai # You may use this code for any purpose, as long as the original # copyright remains in the source code and all documentation require 5.002; use Socket; $ESC = "\e"; $HISTFILE = "$ENV{HOME}/.FvConHist0"; $SOCKET_NAME = "$ENV{HOME}/.FvConSocket"; $VERSION = '1.2'; if( -c "/dev/console" ) { close STDERR; open (STDERR,">/dev/console") || die "/dev/console: ",$!; } ($Filename = $0) =~ s@.*/@@; ($Sname = $Filename) =~ s/C(\.pl)?$//; $tty = `tty`; $tty =~ s/\n//; $org_stty = &stty('-g'); @Hist = (); @Histall = (); $HIST_SIZE = 50; $MAX_COMMAND_SIZE = 1000; main(); exit; sub main::default_key { #------------ default key bindings ---------- # these can be overidden by config lines # # It may need these lines in .Xdefault to make home and end key work # FvwmConsole*VT100*Translations: #override \n \ # Home: string(0x1b) string("[1~" ) \n \ # Delete: string(0x1b) string("[3~" ) \n # End: string(0x1b) string("[4~" ) \n package User; $ESC = $main::ESC; $Key{"$ESC\[1~"} = 'bol'; #home Key $Key{"$ESC\[3~"} = 'del_char'; $Key{"$ESC\[4~"} = 'eol'; #end key $Key{"$ESC\[A"}= 'prev_line'; #up $Key{"$ESC\[B"}= 'next_line'; #down $Key{"$ESC\[C"}= 'next_char'; #right $Key{"$ESC\[D"}= 'prev_char'; #left $Key{"${ESC}f"}= 'next_word'; $Key{"${ESC}b"} = 'prev_word'; $Key{"$ESC"} = 'prefix'; $Key{"\cD"} = 'del_char'; $Key{"\c?"} = 'del_char'; $Key{"\cH"} = 'bs'; $Key{"\cq"} = 'quote'; $Key{"\cU"} = 'del_line'; $Key{"\cs"} = 'search'; $Key{"\cR"} = 'search_rev'; $Key{"\cK"} = 'del_forw_line'; $Key{"\ca"} = 'bol'; $Key{"\ce"} = 'eol'; $Key{"\cp"} = 'prev_line'; $Key{"\cn"} = 'next_line'; $Key{"\cf"} = 'next_char'; $Key{"\cb"} = 'prev_char'; $Key{"\cx"} = 'prefix'; $Key{"\cx\cb"} = 'bind'; $Key{"\cx\ck"} = 'cancel'; $Key{"\cw"} = 'del_back_word'; $Key{"\x8d"} = 'enter_wo_subst'; # alt enter $Key{"\n"} = 'enter'; $Key{"\ci"} = 'ins_char (" ")'; $Key{"\xE4"} = 'del_forw_word'; # alt_d $Key{"\xE6"} = 'next_word'; # alt_f $Key{"\xEB"} = 'bind'; # alt_k $Key{"\xEC"} = 'list_func'; # alt_k $Key{"\xF3"} = 'subst'; # alt_s $Key{"\xF4"} = 'termsize'; # alt_t $Key{"\xE2"} = 'prev_word'; # alt_b $Key{"\xb1"} = 'ins_nth_word(1)'; $Key{"\xb2"} = 'ins_nth_word(2)'; $Key{"\xb3"} = 'ins_nth_word(3)'; $Key{"\xb4"} = 'ins_nth_word(4)'; $Key{"\xb5"} = 'ins_nth_word(5)'; $Key{"\xb6"} = 'ins_nth_word(6)'; $Key{"\xb7"} = 'ins_nth_word(7)'; $Key{"\xb8"} = 'ins_nth_word(8)'; $Key{"\xb9"} = 'ins_nth_word(9)'; $Key{"${ESC}b"} = 'prev_word'; # esc_b $Key{"${ESC}f"} = 'next_word'; # esc_f $Key{"${ESC}>"} = 'eoh_ign_mode'; # end of history, ignore mode $Key{"${ESC}<"} = 'boh_ign_mode'; # begining of history, ignore mode $Key{"${ESC}."} = 'ins_last_word'; $Key{EOF} = "\cD"; #eof work only when line is empty $Subst{'^#.*'} = ''; # ignore comments #---------------- end of key binding ----------------- #---------------- Terminal control ------------------- $TERM_EEOL = "$ESC\[K"; # erase to end of line $TERM_RIGHT = "$ESC\[C"; # move cursor right $TERM_LEFT = "$ESC\[D"; # move cursor left $TERM_DOWN = "$ESC\[B"; # move cursor up $TERM_UP = "$ESC\[A"; # move cursor up } sub read_config { my( $hash,@keys,$key,@vals,$val); while() { last if $_ eq "_C_Config_Line_End_\n"; next if !s/^\*${Sname}//; ($hash,@keys[0..3],@vals) = (/ ^(\w+)\s+ #hash name ('([^\']*)'|"([^\"]*)"|(\S+)) #key quoted or bare word (\s+('([^\']*)'|"([^\"]*)"|(\S+)))? #value /x); $key = $keys[1].$keys[2].$keys[3]; $val = $vals[2].$vals[3].$vals[4]; if( defined %{$User::{$hash}} ) { User::bind( $hash, $key, $val ); } } } sub main { my($sin, $cmd); my($name, $ppid, $cpid); socket(SH, PF_UNIX, SOCK_STREAM, 0) || die "$! "; $sun = sockaddr_un($SOCKET_NAME); connect(SH,$sun) || die "$sun:", $!; print "$Filename $VERSION\n"; default_key(); read_config(); #must be done before forking $ppid = $$; if( $cpid = fork() ) { &input_open($tty,$tty,$HISTFILE,1); while( $cmd = &input('','',1) ) { next if $cmd =~/^\s*$/; last if $cmd eq "\0"; if( length($cmd) > $MAX_COMMMAND_SIZE ) { print User::OUT "\a"; } send( SH, $cmd."\0", 0 ); } dokill( $cpid ); } else { #child handles output while() { last if $_ eq ''; if( $_ eq "_C_Socket_Close_\n" ) { dokill( $ppid ); } print; } dokill( $ppid ); } } sub dokill { my($pid) = @_; unlink SH; kill -9,$pid if $pid; exit; } sub input_open { # arg0 input device # arg1 output device # arg2 history file # arg3 key selection - bit0 # bit1 # bit2 return undef esc code as it is ($Dev_in,$Dev_out,$File,$Ksel) = @_; if( !$Dev_in ) {$Dev_in = $tty;} elsif( $Dev_in eq "not a tty" ) { $Dev_in = $ENV{'TTY'};} if( !$Dev_out ) {$Dev_out = $tty;} if( !$File ) { $File = '/tmp/input.tmp';} open(User::IN,"<$Dev_in") || die "open in at input_open '$Dev_in' $!\n"; open(User::OUT,">$Dev_out") || die "can't open input at 'input_open' $!\n"; select((select(User::OUT), $| = 1)[0]); # unbuffer pipe if( defined $File ) { if( open(INITF,"$File") ) { do "$File"; @Histall=; close(INITF); $#Histall--; }else{ print STDERR "Can't open history file $File\n"; } } } sub input_close { close(User::IN); close(User::OUT); } sub getchar { # get char from input # if esc , check for more char my($c,$s,$rin,$rout); sysread(User::IN, $c, 1); if( $c ne $ESC ) { $s = $c; }else { $rin = ''; vec( $rin, fileno(User::IN),1) = 1; $n= select( $rout=$rin, undef, undef, 0.1 ); $s = $ESC; if($n) { while($n= select( $rout=$rin, undef, undef, 0.1 ) ) { sysread( User::IN, $c, 1 ); $s .= $c; last if $c =~ /[A-Dz~]/; # end of escape seq } } } $s; } sub insert_char { local($c,*len,*ix,*hist) =@_; local($clen); $clen = length $c; if( $init_in ) { $len = $ix = $clen; # new hist - clear old one $hist[$#hist] = $c; }else{ substr($hist[$#hist],$ix,0) = $c; #insert char $len += $clen; $ix += $clen; } } sub stty { my($arg) = @_; `/bin/stty $arg <$tty 2>&1`; # if( -x "/usr/5bin/stty" ) { # `/usr/5bin/stty $arg <$tty`; # }elsif( -x "/usr/bin/stty" ) { # `/usr/bin/stty $arg `; # }else { # `/bin/stty $arg `; # } } sub add_hist { # add input into history file local($type,*cmd) = @_; #not my my( $t )= sprintf("%s",$type); my($h) = $cmd[$#cmd]; return if !defined $File; if( $#cmd ==0 || $h ne $cmd[$#cmd-1] ) { $h =~ s/([\"@\$\\])/\\$1/g; $t =~ s/^\*//; push(@Histall, "push (\@$t, \"$h\");\n" ); @Histall = splice( @Histall, -$HIST_SIZE, $HIST_SIZE ); # take last HIST_SIZE commands if( open( FILE, ">$File" ) ){ print FILE @Histall; print FILE "1;\n"; close(FILE); } }else { $#cmd--; } } #---------------- # print mini help #---------------- sub usage_error { open( THIS, "$0"); while() { s/\$0/$Filename/; if( /^\#/ ) { print STDERR $_; }else{ last; } } close THIS; sleep 3; exit 1; } sub search_mode { local(*c, *s, *prompt, *mode, *isp, *hist ) =@_; my($p_save, $isp_cur); if($c eq "\n"){ $prompt = $p_save; $mode = 'normal'; last IN_STACK; } $isp_cur = $isp; if( $User::Key{$c} =~ /^search/ ) { #search furthur $mode = $User::Key{$c}; while(1) { if( $mode eq 'search_rev' && --$isp<0 || $mode eq 'search' && ++$isp>$#hist-1 ) { print User::OUT "\a"; # couldn't find one $isp = $isp_cur; last; } last if( index($hist[$isp],$s) >=0); } }elsif( $User::Key{$c} eq 'bs' ) { $s =~ s/.$//; }elsif( ord($c) < 32 ) { #non-printable char, get back to normal mode print User::OUT "\a"; $prompt = $p_save; $mode = 'normal'; return; }else{ $s .= $c; while(1) { last if (index($hist[$isp],$s) >=0); if( $mode eq 'search_rev' && --$isp<0 || $mode eq 'search' && ++$isp>$#hist ) { print User::OUT "\a"; #couldn't find one chop($s); $isp = $isp_cur; last; } } } $prompt = "($mode)'$s':"; } sub calcxy { my( $mode, $prompt, $len, $ix, $off, $wd ) = @_; my($plen); my( $y_len, $y_ix, $col); my($adjust); # 1 when the last char is on right edge $plen = length($prompt); $y_len = int (($plen+$len+$off) / $wd ); $adjust = ( (($plen+$len+$off) % $wd == 0) && ($y_len > 0 )) ? 1:0; if( $mode =~ /^search/ ) { #move cursor to search string $y_ix = int (($plen-2+$off) / $wd ); $col = ($plen-2+$off) % $wd; }else{ #normal mode - move cursor back to $ix $y_ix = int (($plen+$ix+$off) / $wd ); $col = ($plen+$ix+$off) % $wd; } ($y_len, $y_ix, $col, $adjust); } package User; sub move_cursor { my($x,$y, $x_prev,$y_prev) = @_; my($termcode); $termcode = ''; if($y > $y_prev ) { $termcode = $TERM_DOWN x ($y-$y_prev); }elsif( $y < $y_prev ) { $termcode = $TERM_UP x ($y_prev-$y); } if( $x > $x_prev ) { $termcode .= $TERM_RIGHT x ($x-$x_prev); }elsif( $x < $x_prev ) { $termcode .= $TERM_LEFT x ($x_prev-$x); } print OUT $termcode; } sub another_line { $init_in = 1-$app; ($hist[$#hist] = $hist[$isp]) =~ s/\n//; $ix = length($hist[$#hist]); } sub main::input { # arg0 - prompt # arg1 - input stack # arg2 - append input to command if 1 # arg3 - # of column offset local($prompt,*hist,$app,$off) = @_; local($len,$ix); local($c,$isp,$s,$wisp); local($mode); local(%lastop); local($init_in); local($print_line); #0-none, 1-whole, 2-from cursor my($y_ix,$y_ix0,$y_len,$wd,$ht,$col,$col0); my($term); my($init_in,$op); $off = 0 if( !defined $off ); *hist = *main::Hist if( ! defined @hist ); $isp = ++$#hist ; $wisp = $isp; if( -f "/vmunix" ) { &main::stty("-echo -icanon min 1 time 0 stop ''"); }else { &main::stty(" -echo -icanon eol \001 stop ''"); } ($ht,$wd) = &termsize(); $y_ix = $y_len = 0; $mode = 'normal'; another_line(); $print_line = 1; IN_STACK:while(1){ if( $print_line==0 ) { #just move cursor ($y_len,$y_ix,$col,$adjust) = &main::calcxy($mode,$prompt,$len,$ix,$off,$wd); move_cursor( $col,$y_ix, $col0,$y_ix0); }elsif($print_line==2 || $print_line==3 ) { # delete - print cursor to eol $len = length($hist[$#hist]); ($y_len,$y_ix,$col,$adjust) = &main::calcxy($mode,$prompt,$len,$ix,$off,$wd); if( $print_line==3 ) { # delete backward move_cursor( $col,$y_ix, $col0,$y_ix0); } if( $y_len0 > $y_ix && ($adjust || $y_len0 > $y_len) ) { print( OUT "\n$TERM_EEOL" x ($y_len0-$y_ix), $TERM_UP x ($y_len0-$y_ix), "\r", $TERM_RIGHT x $col, ); } print( OUT substr("$prompt$hist[$#hist]", $ix), $adjust ? '':$TERM_EEOL, "\r", $TERM_RIGHT x $col, $TERM_UP x ($y_len-$y_ix) , ($adjust && $ix!=$len)? $TERM_DOWN : '' ); }elsif($print_line==4) { # insert $len = length($hist[$#hist]); ($y_len,$y_ix,$col,$adjust) = &main::calcxy($mode,$prompt,$len,$ix,$off,$wd); print( OUT substr("$prompt$hist[$#hist]", $ix), $TERM_UP x ($y_len-$y_ix) ,"\r", $TERM_RIGHT x $col, $TERM_DOWN x $adjust ); }else{ # print whole line $len = length($hist[$#hist]); #move cursor to bol on screen, erase prev printout print (OUT $TERM_DOWN x ($y_len-$y_ix), "\r$TERM_EEOL$TERM_UP" x ($y_len), "\r$TERM_EEOL\r", $TERM_RIGHT x $off,"$prompt$hist[$#hist]"); ($y_len,$y_ix,$col,$adjust) = &main::calcxy($mode,$prompt,$len,$ix,$off,$wd); #mv cursor to cur pos print( OUT $TERM_UP x ($y_len-$y_ix) ,"\r", $TERM_RIGHT x $col, $TERM_DOWN x $adjust); } GETC:{ ($col0, $y_ix0, $y_len0) = ($col, $y_ix, $y_len); $print_line=1; $c = main::getchar(); while($Key{$c} eq "prefix" ) { $c .= main::getchar(); } ($op = $Key{$c}) =~ s/(.*)\s*[\(;].*/$1/; $op =~ /(\w+)$/; $op = $1; if( $Key{$c} =~ /ign_mode/ ) { # ignore mode and execute command eval "&{$Key{$c}}"; }elsif( $mode =~ /^search/ ) { main::search_mode(*c,*s,*prompt,*mode,*isp, *hist); another_line(); }elsif( $c eq $Key{EOF} && $len==0 ) { return ''; # eof return null }elsif( defined $Key{$c} ) { eval "&{$Key{$c}}"; $lastop{op} = $op; }elsif( ord ($c) < 32 ) { #undefined control char print OUT "\a"; $print_line = 0; }else { $lastop{op} = 'ins_char'; &ins_char( $c ); print OUT $c; } $init_in = 0; } } if( $y_ix != $y_len ) { print OUT "\n" x ($y_len-$y_ix); } &main::stty($org_stty); print OUT "\n"; if( $hist[$#hist] eq '' ) { pop(@hist); return "\n"; } if( $#hist>0 && $hist[$#hist] eq $hist[$#hist-1] ) { pop(@hist); # if it is the same, delete }else{ &main::add_hist( *hist, *hist ); } $hist[$#hist]."\n"; } #----------------------------- # editinig command functions # # functions must be below here to be listed by list_func # # the variables below are local to sub input # $prompt,$hist,$app,$off # $len,$ix # $c,$isp,$wisp,$s # $mode #----------------------------- sub prefix { } # it's only here to be listed by list_func sub boh { $isp = 0; another_line(); } sub boh_ign_mode { boh(); } sub bol { $ix = 0 ; $print_line=0; } sub bs { my($l) = @_; $l = 1 if $l eq ''; if( $len && $ix ) { $ix-=$l; # mv left substr($hist[$#hist],$ix,$l) = ""; # del char } $print_line = 3; } sub del_back_line { substr($hist[$#hist],0,$ix) = ""; $ix = 0; $print_line = 3; } sub del_forw_line { substr($hist[$#hist],$ix) = ""; $print_line = 2; } sub del_char { my($l) = @_; $l = 1 if $l eq ''; if( $len > $ix ) { substr($hist[$#hist],$ix,$l) = ""; # del char } $print_line = 2; } sub del_line { $ix = 0; $hist[$#hist] = ""; $print_line = 3; } sub del_back_word { my($tmp); $tmp = substr($hist[$#hist],0,$ix); $tmp =~ s/(^|\S+)\s*$//; $tmp = length $tmp; substr($hist[$#hist],$tmp,$ix-$tmp) = ""; $ix = $tmp; $print_line = 3; } sub del_forw_word { $hist[$#hist] =~ s/^(.{$ix})\s*\S+/$1/; $print_line = 2; } sub enter { subst(); enter_wo_subst(); } sub eoh { if( $isp==$#hist ) { print OUT "\a"; }else{ $hist[$#hist] = '' } $isp = $#hist; another_line(); $print_line = 1; } sub eoh_ign_mode { eoh(); $print_line = 1; } sub eol { $ix = $len; $print_line=0; } sub execute { eval "$hist[$#hist]"; if( $#hist>0 && $hist[$#hist] eq $hist[$#hist-1] ) { pop(@hist); # if it is the same, delete }else{ &main::add_hist( *hist, *hist ); } push( @hist, ''); # deceive 'input' it is an empty line last IN_STACK; } sub ins_char { my($c) = @_; &main::insert_char($c,*len,*ix,*hist); $print_line = 4; } sub ins_last_word { if( $lastop{op} =~ /^ins_(nth|last)_word/ ) { return if $wisp < 1; #delete last last_word bs(length $lastop{word}); }else { $wisp = $#hist; return if $wisp < 1; } $hist[--$wisp] =~ /(\S+)\s*$/; $lastop{word} = $1; ins_char($lastop{word}); } sub ins_nth_word { my($n) = @_; if( $lastop{op} =~ /^ins_(nth|last)_word/ ) { return if $wisp < 1; #delete last last_word bs(length $lastop{word}); }else { $wisp = $#hist; return if $wisp < 1; } $hist[--$wisp] =~ /((\S+)\s*){1,$n}/; $lastop{word} = $2; ins_char($lastop{word}); } sub list_func { my( $s, @cmds, $cmd, $func); $func = 0; open( THIS, "$0" ) || return; #shouldn't occur while( $s = ) { if( $s =~ /^\s*sub\s+main::input\s*\{/ ) { $func = 1; next; } next if !$func; if( $s =~ s/^\s*sub\s+// ) { $s =~ s/\s*[\{].*//; push @cmds,$s; } } close THIS; foreach $cmd (sort @cmds) { print OUT $cmd; } } sub bind { # bind Key or Subst # if there is no arguments, then list them my($hash,$key,$val) = @_; my( $mod,$chr,$v2,$k,$cnt ); if( defined %{$hash} ) { $k = $key; if( $hash eq "Key" ) { ($v2 = $val) =~ s/\s*[\(;].*//; if( !defined &{$v2} ) { print STDERR "Unknown function $v2\n"; return; } $mod = 0; $cnt =0; $k = ''; for( $i=0; $i= 0x80 ) { $mod .= '\M'; $chr = pack("c", ord($chr)-0x80); } if( $chr eq $ESC ) { $chr = '\E'; }elsif( ord($chr) < 0x20 ) { $mod .= '\C'; $chr = pack("c", ord($chr)+0x40); }elsif( ord($chr) == 0x7f ) { $chr = '\C?'; } $mod .= $chr; } if( ord($val) < 0x20 ) { $val = '\C'.pack("c", ord($val)+0x40); } print OUT "Key $mod $val\n"; } while( ($key,$val) = each(%Subst) ) { print OUT "Subst $key $val\n"; } } } sub next_char { $ix++ if ($ix<$len); $print_line=0; } sub next_line { if($isp<$#hist) { $isp++; if( $isp==$#hist ) { $hist[$isp] = ''; } }else { $isp = $#hist; print OUT "\a"; } another_line(); } sub next_word { $hist[$#hist] =~ /^(.{$ix}\S*(\s+|$))/; $ix = length($1); $print_line=0; } sub enter_wo_subst { last IN_STACK; } sub prev_char { $ix-- if $ix>0; $print_line=0; } sub prev_line { if($isp>0) { $isp--; }else { $isp = 0; print OUT "\a"; } another_line(); } sub prev_word { my($tmp); $tmp = substr($hist[$#hist],0,$ix); $tmp =~ s/(^|\S+)\s*$//; $ix = length($tmp); $print_line=0; } sub cancel { $hist[$#hist] = ""; $len = 0; last IN_STACK; } sub quote { my($c); sysread(IN, $c, 1); # $c = getc(IN); ins_char($c); } sub search_rev { $s = ''; $mode = 'search_rev'; $p_save = $prompt; $prompt = "($mode)'$s':"; $hist[$#hist] = $hist[$isp]; another_line(); } sub search { $s = ''; $mode = 'search'; $p_save = $prompt; $prompt = "($mode)'$s':"; $hist[$#hist] = $hist[$isp]; another_line(); } sub subst { my($key,$val); $done = 0; while( ($key,$val) = each(%Subst) ) { last if( eval "\$hist[\$#hist] =~ s\$key$val" ) ; } $ix = $len = length($hist[$#hist]); } sub termsize { my($row, $col,$s); if( -f "/vmunix" ) { $s =&main::stty ("everything"); ($row,$col) = ($s =~ /(\d+)\s+rows[,\s]+(\d+)\s+columns/ ); } else { $s =&main::stty ("-a"); ($row,$col) = ($s =~ /rows[=\s]+(\d+)[,;\s]+columns[=\s]+(\d+)/ ); } ($row,$col); }