--- gforth/history.fs 1995/06/07 10:05:05 1.6 +++ gforth/history.fs 1995/09/06 21:00:17 1.7 @@ -6,11 +6,12 @@ 2Variable backward^ 2Variable end^ -: get-history ( addr len -- wid ) -\ check-file-prefix drop +: force-open ( addr len -- handle ) 2dup r/w open-file 0< - IF drop r/w create-file throw ELSE nip nip THEN - to history + 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! ; @@ -30,25 +31,28 @@ s" ~/.gforth-history" get-history : clear-tib ( max span addr pos -- max 0 addr 0 false ) clear-line 0 tuck dup ; -: get-line ( max addr -- max span addr pos dpos ) - history file-position throw backward^ 2! - 2dup swap history read-line throw drop - 2dup type tuck - history file-position throw forward^ 2! ; +: hist-pos ( -- ud ) history file-position throw ; +: hist-setpos ( ud -- ) history reposition-file throw ; + +: get-line ( addr len -- len' flag ) + swap history read-line throw ; : next-line ( max span addr pos1 -- max span addr pos2 false ) clear-line - forward^ 2@ history reposition-file throw - get-line 0 ; + forward^ 2@ 2dup hist-setpos backward^ 2! + 2dup get-line drop + hist-pos forward^ 2! + tuck 2dup type 0 ; : prev-line ( max span addr pos1 -- max span addr pos2 false ) - clear-line over 2 + negate s>d backward^ 2@ d+ 0. dmax - 2dup history reposition-file throw - BEGIN 2over swap history read-line throw WHILE - >r history file-position throw - 2dup backward^ 2@ d< WHILE 2swap 2drop rdrop - REPEAT ELSE >r history file-position throw THEN - forward^ 2! backward^ 2! r> tuck 2dup type 0 ; + clear-line backward^ 2@ forward^ 2! + over 2 + negate s>d backward^ 2@ d+ 0. dmax 2dup hist-setpos + BEGIN + backward^ 2! 2dup get-line WHILE + hist-pos 2dup forward^ 2@ d< WHILE + rot drop + REPEAT 2drop THEN + tuck 2dup type 0 ; : ctrl ( "" -- ctrl-code ) char [char] @ - postpone Literal ; immediate @@ -56,10 +60,9 @@ s" ~/.gforth-history" get-history Create lfpad #lf c, : (enter) ( max span addr pos1 -- max span addr pos2 true ) - >r end^ 2@ history reposition-file throw - 2dup swap history write-file throw - lfpad 1 history write-file throw - history file-position throw 2dup backward^ 2! end^ 2! + >r end^ 2@ hist-setpos + 2dup swap history write-line throw + hist-pos 2dup backward^ 2! end^ 2! r> (ret) ; \ some other key commands 16oct94py @@ -82,28 +85,44 @@ Create prefix-found 0 , 0 , IF r> char+ capscomp 0<= EXIT THEN nip r> c@ $1F and < ; -: search-prefix ( addr len1 -- suffix len2 ) 0 >r context - BEGIN BEGIN dup @ over cell - @ = WHILE cell - REPEAT - dup >r -rot r> @ @ - BEGIN dup WHILE >r dup r@ cell+ c@ $1F and <= - IF 2dup r@ cell+ char+ capscomp 0= - IF r> dup r@ word-lex - IF dup prefix-found @ word-lex - 0>= IF rdrop dup >r THEN - THEN >r - THEN - THEN r> @ - REPEAT drop rot cell - dup vp u> 0= - UNTIL drop r> dup prefix-found ! ?dup - IF cell+ count $1F and rot /string rot drop - ELSE 2drop s" " THEN ; +: search-voc ( addr len nfa1 nfa2 -- addr len nfa3 ) >r + BEGIN dup WHILE >r dup r@ cell+ c@ $1F and <= + IF 2dup r@ cell+ char+ capscomp 0= + IF r> dup r@ word-lex + IF dup prefix-found @ word-lex + 0>= IF rdrop dup >r THEN + THEN >r + THEN + THEN r> @ + REPEAT drop r> ; + +: prefix-string ( addr len nfa -- addr' len' ) + dup prefix-found ! ?dup + IF cell+ count $1F and rot /string rot drop + dup 1+ prefix-found cell+ ! + ELSE + 2drop s" " prefix-found cell+ off + THEN ; + +: search-prefix ( addr1 len1 -- addr2 len2 ) + 0 vp dup @ 1- cells over + + DO I 2@ <> + IF I cell+ @ @ swap search-voc THEN + [ -1 cells ] Literal +LOOP + prefix-string ; + +: kill-expand ( max span addr pos1 -- max span addr pos2 ) + prefix-found cell+ @ 0 ?DO (del) LOOP ; + +: tib-full? ( max span addr pos addr' len' -- max span addr pos addr1 u flag ) + 5 pick over 4 pick + prefix-found @ 0<> - < ; : tab-expand ( max span addr pos1 -- max span addr pos2 0 ) - prefix-found cell+ @ 0 ?DO (del) LOOP - 2dup extract-word search-prefix - dup prefix-found @ 0<> - prefix-found cell+ ! - bounds ?DO I c@ (ins) LOOP - prefix-found @ IF bl (ins) THEN 0 ; + kill-expand 2dup extract-word search-prefix + tib-full? + IF 7 emit 2drop 0 0 prefix-found 2! + ELSE bounds ?DO I c@ (ins) LOOP THEN + prefix-found @ IF bl (ins) THEN 0 ; : kill-prefix ( key -- key ) dup #tab <> IF 0 0 prefix-found 2! THEN ;