--- gforth/history.fs 1996/01/07 17:22:11 1.9 +++ gforth/history.fs 1997/12/01 21:15:03 1.16 @@ -1,4 +1,4 @@ -\ History file support 16oct94py +\ command line edit and history support 16oct94py \ Copyright (C) 1995 Free Software Foundation, Inc. @@ -18,28 +18,87 @@ \ along with this program; if not, write to the Free Software \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -0 Value history +:noname + char [char] @ - ; +:noname + char [char] @ - postpone Literal ; +interpret/compile: ctrl ( "" -- ctrl-code ) + +\ command line editing 16oct94py + +: >string ( span addr pos1 -- span addr pos1 addr2 len ) + over 3 pick 2 pick chars /string ; +: type-rest ( span addr pos1 -- span addr pos1 back ) + >string tuck type ; +: (del) ( max span addr pos1 -- max span addr pos2 ) + 1- >string over 1+ -rot move + rot 1- -rot #bs emit type-rest bl emit 1+ backspaces ; +: (ins) ( max span addr pos1 char -- max span addr pos2 ) + >r >string over 1+ swap move 2dup chars + r> swap c! + rot 1+ -rot type-rest 1- backspaces 1+ ; +: ?del ( max span addr pos1 -- max span addr pos2 0 ) + dup IF (del) THEN 0 ; +: (ret) type-rest drop true space ; +: back dup IF 1- #bs emit ELSE #bell emit THEN 0 ; +: forw 2 pick over <> IF 2dup + c@ emit 1+ ELSE #bell emit THEN 0 ; +: eof 2 pick over or 0= IF + bye + ELSE 2 pick over <> + IF forw drop (del) ELSE #bell emit THEN 0 + THEN ; + +' forw ctrl F cells ctrlkeys + ! +' back ctrl B cells ctrlkeys + ! +' ?del ctrl H cells ctrlkeys + ! +' eof ctrl D cells ctrlkeys + ! + +' (ins) IS insert-char + +\ history support 16oct94py + +0 Value history \ history file fid 2Variable forward^ 2Variable backward^ 2Variable end^ -: force-open ( addr len -- handle ) +: force-open ( addr len -- fid ) 2dup r/w open-file 0< - IF drop r/w create-file throw ELSE nip nip THEN ; + IF drop r/w create-file + throw ELSE nip nip THEN ; -: get-history ( addr len -- wid ) - force-open to history - history file-size throw - 2dup forward^ 2! 2dup backward^ 2! end^ 2! ; +s" os-class" environment? [IF] s" unix" compare 0= [ELSE] true [THEN] +[IF] +: history-file ( -- addr u ) + s" GFORTHHIST" getenv dup 0= IF + 2drop s" ~/.gforth-history" + THEN ; +[ELSE] + +: history-dir ( -- addr u ) + s" TMP" getenv ?dup ?EXIT drop + s" TEMP" getenv ?dup ?EXIT drop + s" c:/" ; + +: history-file ( -- addr u ) + s" GFORTHHIST" getenv ?dup ?EXIT + drop + history-dir pad place + s" /ghist.fs" pad +place pad count ; +[THEN] + +: get-history ( addr len -- ) + ['] force-open catch + dup 0< IF ." can't open " history-file type cr throw THEN drop + to history + history file-size throw + 2dup forward^ 2! 2dup backward^ 2! end^ 2! ; -s" ~/.gforth-history" get-history +: history-cold ( -- ) + history-file get-history ; -: history-cold - Defers 'cold - s" ~/.gforth-history" get-history ; - -' history-cold IS 'cold +' history-cold INIT8 chained +history-cold \ moving in history file 16oct94py @@ -72,9 +131,6 @@ s" ~/.gforth-history" get-history REPEAT 2drop THEN tuck 2dup type 0 ; -: ctrl ( "" -- ctrl-code ) - char [char] @ - postpone Literal ; immediate - Create lfpad #lf c, : (enter) ( max span addr pos1 -- max span addr pos2 true )