------------------------------------------------------------------------------ -- Reading the keyboard, writing to the terminal/console -- -- -- -- Part of BUSH -- ------------------------------------------------------------------------------ -- -- -- Copyright (C) 2001-2005 Ken O. Burtch & FSF -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. This is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with this; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- This is maintained at http://www.pegasoft.ca -- -- -- ------------------------------------------------------------------------------ -- CVS: $Id: user_io.adb,v 1.2 2005/02/11 02:59:32 ken Exp $ with ada.text_io, ada.strings.unbounded.text_io, --bush_os.spawn, ada.calendar, bush_os.tty, gnat.regexp, gnat.os_lib, gnat.directory_operations, world, signal_flags, string_util; use ada.text_io, ada.strings.unbounded.text_io, bush_os, --bush_os.spawn, ada.calendar, bush_os.tty, gnat.regexp, gnat.os_lib, gnat.directory_operations, signal_flags, world, string_util; package body user_io is procedure beep is -- beep the terminal begin simpleBeep; end beep; procedure getKey( ch : out character ) is -- read a single keypress and don't show the character to user begin simpleGetKey( ch ); -- constrain to lower ASCII if ch > ASCII.DEL then ch := character'val( character'pos( ch ) - 128 ); end if; end getKey; function getPromptIndent return natural is -- determine how far the command prompt indents from the -- left hand side of the screen, taking into account -- control characters and carriage returns / line feeds len : natural := 0; begin for i in 1..length( prompt ) loop if element( prompt, i ) = ASCII.CR then -- carriage return? len := 0; -- back to left side elsif element( prompt, i ) = ASCII.LF then -- line feed? len := 0; -- back to left side elsif element( prompt, i ) >= ' ' then -- not a control char? len := len + 1; -- count it end if; end loop; return len; end getPromptIndent; function getPromptExtraLines return natural is -- determine how far the command prompt indents from the -- left hand side of the screen, taking into account -- control characters and carriage returns / line feeds last : character := ASCII.NUL; extra : natural := 0; begin for i in 1..length( prompt ) loop if element( prompt, i ) = ASCII.CR then -- carriage return? extra := extra + 1; -- back to left side elsif element( prompt, i ) = ASCII.LF then -- line feed? if last /= ASCII.CR then -- for MS-DOS extra := extra + 1; -- back to left side end if; end if; last := element( prompt, i ); end loop; return extra; end getPromptExtraLines; procedure getLine( line : out unbounded_string; keepHistory : boolean := false ) is -- read a line from the keyboard -- Note: the keymap is hard-coded, but really should be taken from -- current terminal settings. procedure redrawLine( oldPos : natural; newPos : natural := 0 ) is -- redraw the command line oldLines : integer; -- number of lines of old text oldChars : integer; -- number of characters from margin begin -- these two formulas are not quite right -- oldChars and oldLines are the coordinates of the cursor if keepHistory then -- if keepHistory, then we're at the command line --oldLines := ( getPromptIndent+oldPos ) / -- integer( displayInfo.col ) + getPromptExtraLines; oldLines := ( getPromptIndent+oldPos-2 ) / integer( displayInfo.col ) + getPromptExtraLines+1; oldChars := (getPromptIndent + oldPos) - ( ( oldLines-1-getPromptExtraLines) * integer( displayInfo.col ) ); else -- otherwise in the get_line function or someplace w/out a prompt oldLines := (oldPos-1) / integer( displayInfo.col )+1; oldChars := oldPos - ( (oldLines-1) * integer( displayInfo.col ) ); end if; -- position at start of old line for i in 1..oldChars-1 loop put( ASCII.BS ); end loop; for i in 1..oldLines-1 loop put( term( cleol ) ); put( term( up ) ); end loop; -- draw new line if keepHistory then put_bold( prompt ); end if; put( line ); -- the final character on the bottom-right of the screen has special -- properties (ie. it triggers the scrolling). We need to compensate -- or the final character won't appear. If we don't scroll the screen -- by writing another character, the final character of the line won't -- be displayed! if getPromptIndent + length( line ) = 80 then put( ' ' ); put( ASCII.BS ); end if; put( term( cleol ) ); -- reposition cursor, if desired if newPos > 0 then for i in newPos..length( line ) loop -- reposition cursor put( ASCII.BS ); -- (not very efficient) end loop; end if; --put( " - " ); --put( oldchars'img ); --put( displayInfo.col'img ); end redrawLine; function slashifyPath( dir, path : unbounded_string ) return string is -- Add a trailing character for a path. If a directory, add a trailing /. -- If a file, add a trailing space. If both, add nothing. f : file_type; ch : character := ASCII.NUL; begin begin Ada.Text_IO.Open( f, in_file, to_string( dir & "/" & path ) ); Ada.Text_IO.Close( f ); -- should do a stat() declare -- if a dir, add a '/' f : dir_type; begin GNAT.Directory_Operations.Open( f, to_string( dir & "/" & path ) ); GNAT.Directory_Operations.Close( f ); -- should do a stat() ch := '/'; exception when others => ch := ' '; end; exception when others => null; end; if ch /= ASCII.NUL then return "" & ch; end if; return ""; end slashifyPath; procedure completePathname( dir : unbounded_string; s : unbounded_string; result : out unbounded_string; list : boolean := false ) is globCriteria : regexp; count : natural := 0; dir2test : Dir_Type; fileName : string(1..256); fileNameLen : natural; noPWD : boolean := false; bestCommon : unbounded_string; -- longest common part listCount : natural := 0; isListing : boolean := list; expandedDir : unbounded_string; home_id : identifier; begin -- Show a list of possible matches? Move down a line. if isListing then New_Line; put( term( cleop ) ); end if; -- A tilde? Then substitute in the home directory. if length( dir ) > 0 and element( dir, 1) = '~' then findIdent( to_unbounded_string( "HOME" ), home_id ); expandedDir := identifiers( home_id ).value & slice( dir, 2, length(dir)); else expandedDir := dir; end if; -- put_line( " " & expandedDir & ":" & s ); bestCommon := null_unbounded_string; globCriteria := Compile( to_string( s ), Glob => true, Case_Sensitive => true ); begin open( dir2test, to_string( expandedDir ) ); exception when others => noPWD := true; end; if noPWD then beep; result := null_unbounded_string; return; end if; read( dir2test, fileName, fileNameLen ); -- skip "." read( dir2test, fileName, fileNameLen ); -- skip ".." loop read( dir2test, fileName, fileNameLen ); exit when fileNameLen = 0; if Match( fileName(1..fileNameLen ) , globCriteria ) then count := count + 1; if isListing then put_line( fileName(1..fileNameLen) & slashifyPath( dir, to_unbounded_string( fileName(1..fileNameLen) ) ) ); listCount := listCount + 1; isListing := listCount /= 10; -- no more than 10 if not isListing then put_line( optional_bold( "[Maybe More]" ) ); end if; end if; if count = 1 then result := to_unbounded_string( fileName( 1..fileNameLen ) ); bestCommon := result; else -- more than 1 hit? trim bestCommon start to fit the -- result. If bestCommon is null, no common starting -- characters. for i in 1..fileNameLen loop exit when i > length( bestCommon ); if i = fileNameLen then bestCommon := head( bestCommon, i ); elsif element( bestcommon, i ) /= fileName(i) then if i = 1 then bestCommon := null_unbounded_string; else bestCommon := head( bestCommon, i-1 ); end if; end if; end loop; end if; end if; end loop; close( dir2test ); if count > 1 then beep; result := bestCommon; elsif count = 0 then beep; result := null_unbounded_string; end if; end completePathname; procedure lastWord( s : unbounded_string; lw : out unbounded_string; lp : out natural ) is -- remove the last "word" delinated by a space from the string -- return the ending character of the rest of the string begin lp := 0; for i in reverse 1..length( s )-1 loop if element( s, i ) = ' ' then lp := i; exit; end if; end loop; lw := to_unbounded_string( slice( s, lp+1, length( s ) ) ); end lastWord; vi_escape : boolean := false; -- true if expecting vi-mode command arrow_escape : boolean := false; -- true if expecting VT-100 arrow last_was_esc : boolean := false; -- true if last char was ESC ch : character; -- last character read pos : natural; -- position to insert next character old_pos : natural; -- for redrawing lines histpos : integer; -- position in history crit_pos : natural; -- for searching history criteria : unbounded_string; justCompleted : boolean := false; pwd_id : identifier; begin line := null_unbounded_string; criteria := null_unbounded_string; pos := 1; histpos := historyNext; loop <> getKey( ch ); if wasSIGINT then -- if SIGINT raised return; -- let caller determine what to do end if; -- VI ESCAPE MODE HANDLING -- -- process sequence and convert to its emacs mode equivalent if ch = ASCII.ESC then if last_was_esc then -- two escapes? ch := ASCII.HT; -- cmdline completion last_was_esc := false; -- cancel vi mode vi_escape := false; -- exit vi escape else -- first escape? vi_escape := not vi_escape; -- enter/exit vi escape mode if vi_escape then last_was_esc := true; -- remember in case double esc end if; goto retry; -- and go get next key end if; elsif arrow_escape then -- ESC + [ + ...? last_was_esc := false; arrow_escape := false; -- got our arrow code if ch = 'A' then -- A = up ch := ASCII.DLE; elsif ch = 'B' then -- B = down ch := ASCII.SO; elsif ch = 'C' then -- C = right ch := ASCII.ACK; elsif ch = 'D' then -- D = left ch := ASCII.STX; else beep; -- otherwise unknown end if; elsif vi_escape then last_was_esc := false; if ch ='[' then -- same as control-n arrow_escape := true; vi_escape := false; -- cancel vi mode goto retry; elsif ch ='j' then -- same as control-n ch := ASCII.SO; elsif ch = 'k' then -- same as control-p ch := ASCII.DLE; elsif ch = 'h' then -- same as control-b ch := ASCII.STX; elsif ch = 'l' then -- same as control-f ch := ASCII.ACK; elsif ch = '^' then -- same as control-a ch := ASCII.SOH; elsif ch = '$' then -- same as control-e ch := ASCII.ENQ; else -- else not supported vi_escape := false; -- drop out of vi escape mode beep; -- beep at illegal character goto retry; -- and get next key end if; elsif ch = ASCII.EOT then -- control-d / end of file? if length( line ) = 0 and keepHistory then -- nothing at prompt? line := to_unbounded_string( "return" ); -- treat as "return" pos := 5; put( line ); end if; -- otherwise ch := ASCII.CR; -- treat as end of input end if; if ch /= ASCII.HT then justCompleted := false; end if; -- EMACS MODE HANDLING case ch is when ASCII.HT => -- TAB = pathname completion declare path : unbounded_string; dir : unbounded_string; file : unbounded_string; lp : natural; listFiles : boolean := false; begin if justCompleted then listFiles := true; else justCompleted := true; end if; lastWord( line, path, lp ); if length( path ) = 0 then beep; goto retry; end if; dir := dirname( path ); file := basename( path ); file := file & "*"; if listFiles then completePathname( dir, file, path, list => true ); else completePathname( dir, file, path ); end if; if length( path ) > 0 then if to_string( dir ) = "." then line := slice( line, 1, lp ) & path; else line := slice( line, 1, lp ) & dir & '/' & path; end if; declare -- if a file, add a ' '. f : file_type; begin Ada.Text_IO.Open( f, in_file, to_string( dir & "/" & path ) ); Ada.Text_IO.Close( f ); -- should do a stat() declare -- if a dir, add a '/' f : dir_type; begin GNAT.Directory_Operations.Open( f, to_string( dir & "/" & path ) ); GNAT.Directory_Operations.Close( f ); -- should do a stat() line := line & "/"; exception when others => line := line & " "; end; exception when others => null; end; old_pos := pos; -- remember old position pos := length( line ) + 1; -- new position at end redrawLine( old_pos, pos ); end if; end; when ASCII.CR | ASCII.LF => new_line; if length( line ) > 0 and keepHistory then -- don't save empty history( historyNext ).line := line; -- lines findIdent( to_unbounded_string( "PWD" ), pwd_id ); -- SLOW! if pwd_t /= eof_t then history( historyNext ).pwd:= identifiers( pwd_id ).value; end if; history( historyNext ).time := Ada.Calendar.Clock; -- time historyNext := historyNext + 1; if historyNext > historyArray'last then historyNext := 1; end if; end if; exit; when ASCII.BS | ASCII.DEL => -- control-h or delete key if pos > 1 then delete( line, pos-1, pos-1 ); -- delete char to left of cursor old_pos := pos; -- remember old position pos := pos - 1; -- new position is one to left redrawLine( old_pos, pos ); -- redraw line, cursor at end else -- nothing to delete? beep; -- beep end if; when ASCII.STX => -- control-b if pos > 1 then old_pos := pos; -- remember old position pos := pos - 1; -- new position is one to left put( ASCII.BS ); -- move cursor else -- no place to go? beep; -- beep end if; when ASCII.ACK => -- control-f if pos <= length( line ) then old_pos := pos; -- remember old position pos := pos + 1; -- new position is one to right put( term( right ) ); -- move cursor else -- no place to go? beep; -- beep end if; when ASCII.SO => -- control-n if histpos = historyNext or not keepHistory then beep; else histpos := histpos + 1; if histpos > historyArray'last then histpos := 1; end if; old_pos := pos; -- remember old position line := history( histpos ).line; pos := length( line ) + 1; -- new position at end of string redrawLine( old_pos, pos ); -- redraw line, cursor at end end if; when ASCII.DLE => -- control-p if not keepHistory then beep; else old_pos := histpos; histpos := histpos - 1; if histpos < 1 then histpos := historyArray'last; end if; if histpos = historyNext then histpos := old_pos; beep; else old_pos := pos; -- remember old position line := history( histpos ).line; pos := length( line ) + 1; -- new position at end of string redrawLine( old_pos, pos ); -- redraw line, cursor at end end if; end if; when ASCII.CAN => -- control-x/c old_pos := pos; -- remember old position pos := 1; -- empty string now line := null_unbounded_string; redrawLine( old_pos ); -- redraw line when ASCII.SOH => -- control-a redrawLine( pos, 1 ); pos := 1; -- fix position when ASCII.ENQ => -- control-e old_pos := pos; -- remember old position pos := length( line ) + 1; -- new position at end of string redrawLine( old_pos, pos ); -- redraw line, cursor at end when ASCII.DC2 => -- control-r if pos = 1 then beep; goto retry; elsif pos > length( line ) then criteria := line; else criteria := Delete( line, pos, length( line ) ); end if; old_pos := histpos; crit_pos := pos; loop histpos := histpos - 1; if histpos < 1 then histpos := historyArray'last; end if; if histpos = historyNext then -- out of history? line := criteria; -- restore old line histpos := old_pos; -- that's all folks beep; exit; end if; line := history( histpos ).line; -- next history line if Index( line, To_String( Criteria ) ) = 1 then -- matches criteria? pos := length( line ) + 1; -- new position at end of string redrawLine( crit_pos, pos ); -- redraw line, cursor at end exit; end if; end loop; when ASCII.GS => -- control-] (forward char search) old_pos := pos; getKey( ch ); for i in pos+1..length( line ) loop if Element( line, i ) = ch then pos := i; exit; end if; end loop; if pos = old_pos then beep; else redrawLine( old_pos, pos ); end if; when others => if pos > length( line ) then -- adding at end of line? line := line & ch; -- append character pos := pos + 1; -- new position is one to right put( ch ); -- display character else insert( line, pos, ch & "" ); -- insert the character old_pos := pos; -- remember old position pos := pos + 1; -- new position is one to right redrawLine( old_pos, pos ); -- redraw line, cursor at end end if; end case; end loop; end getLine; function bold( s : string ) return string is begin return to_string( term( bold ) ) & s & to_string( term( normal ) ); end bold; function optional_bold( s : string ) return string is begin if gccOpt then return s; end if; return to_string( term( bold ) ) & s & to_string( term( normal ) ); end optional_bold; procedure put_bold( s : string ) is begin put( bold( s ) ); end put_bold; procedure put_bold( s : unbounded_string ) is begin put( term( bold ) & s & term( normal ) ); end put_bold; function inverse( s : string ) return string is begin return to_string( term( inverse ) ) & s & to_string( term( normal ) ); end inverse; function optional_inverse( s : string ) return string is begin if gccOpt then return s; end if; return to_string( term( inverse ) ) & s & to_string( term( normal ) ); end optional_inverse; procedure put_inverse( s : string ) is begin put( bold( s ) ); end put_inverse; procedure put_inverse( s : unbounded_string ) is begin put( term( bold ) & s & term( normal ) ); end put_inverse; procedure checkDisplay( ttype : unbounded_string ) is begin updateTtyAttributes( ttype ); updateDisplayInfo; end checkDisplay; procedure terminalReset( ttype : unbounded_string ) is begin if isatty( stdout ) then put( term( reset ) ); checkDisplay( ttype ); end if; end terminalReset; procedure terminalClear( ttype : unbounded_string ) is begin if isatty( stdout ) then put( term( reset ) ); put( term( clear ) ); checkDisplay( ttype ); end if; end terminalClear; procedure clearHistory is -- Clear the command line history begin historyNext := 1; for i in historyArray'range loop history(i).line := null_unbounded_string; end loop; end clearHistory; procedure displayVersionSplash is -- display --version message. This is located here because it -- uses term attributes. begin if isatty( stdout ) then Put( "PegaSoft Business Shell (BUSH) version " ); Put_Line( version ); Put_Line( "Copyright (c)2001-2005 PegaSoft Canada & Free Software Foundation"); end if; end displayVersionSplash; procedure displayCopyrightSplash is -- display copyright message. This is located here because it -- uses term attributes. begin if isatty( stdout ) then Put( "BUSH " ); Put( version ); Put_Line( " Copyright (c)2001-2005 PegaSoft Canada & Free Software Foundation"); Put_Line( "AdaCGI 1.6 Copyright (c)2000 David A. Wheeler & Free Software Foundation"); Put_Line( "APQ 2.1 Copyright (c)2002-2003 Warren W. Gay & Free Software Foundation"); Put_Line( "MD5 Copyright RSA Data Security, Inc. -- Message-Digest Algorithm" ); Put_Line( "Type ""help"" for help" ); New_Line; end if; end displayCopyrightSplash; end user_io;