--- gforth/history.fs 2005/12/31 15:46:08 1.43 +++ gforth/history.fs 2006/12/31 13:39:13 1.50 @@ -1,6 +1,6 @@ \ command line edit and history support 16oct94py -\ Copyright (C) 1995,2000,2003,2004,2005 Free Software Foundation, Inc. +\ Copyright (C) 1995,2000,2003,2004,2005,2006 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -69,9 +69,16 @@ s" os-class" environment? [IF] s" unix" \ moving in history file 16oct94py -: clear-line ( max span addr pos1 -- max addr ) - backspaces over spaces swap backspaces ; +defer back-restore ( u -- ) +' backspaces is back-restore +[IFDEF] x-width +: clear-line ( max span addr pos1 -- max addr ) + back-restore over over swap x-width spaces swap back-restore ; +[ELSE] +: clear-line ( max span addr pos1 -- max addr ) + back-restore over spaces swap back-restore ; +[THEN] \ : clear-tib ( max span addr pos -- max 0 addr 0 false ) \ clear-line 0 tuck dup ; @@ -197,6 +204,11 @@ require utf-8.fs restore-cursor 2dup type ; : .all ( span addr pos1 -- span addr pos1 ) restore-cursor >r 2dup swap type r> ; +: xback-restore ( u -- ) + drop restore-cursor ; + +\ In the following, addr max is the buffer, addr span is the current +\ string in the buffer, and pos1 is the cursor position in the buffer. : ( max span addr pos1 xc -- max span addr pos2 ) >r 2over r@ xc-size + u< IF ( max span addr pos1 R:xc ) @@ -269,12 +281,14 @@ require utf-8.fs ['] xclear-tib ctrl K bindkey ['] xfirst-pos ctrl A bindkey ['] xend-pos ctrl E bindkey - ['] (xenter) #lf bindkey - ['] (xenter) #cr bindkey + history IF ['] (xenter) #lf bindkey THEN + history IF ['] (xenter) #cr bindkey THEN ['] xtab-expand #tab bindkey ['] (xins) IS insert-char ['] kill-prefix IS everychar - ['] save-cursor IS everyline ; + ['] save-cursor IS everyline + ['] xback-restore IS back-restore +; xchar-history @@ -285,7 +299,7 @@ xchar-history ?dup-if \ !! >stderr \ history-file type ." : " .error cr - drop 2drop + drop 2drop 0 to history ['] false ['] false ['] (ret) else to history @@ -302,6 +316,10 @@ xchar-history : history-cold ( -- ) history-file get-history xchar-history ; -' history-cold INIT8 chained +:noname ( -- ) + defers 'cold + history-cold +; is 'cold + history-cold