--- gforth/history.fs 1997/03/04 22:09:53 1.14 +++ gforth/history.fs 2000/04/02 20:18:27 1.20 @@ -63,25 +63,32 @@ interpret/compile: ctrl ( "" -- c 2Variable end^ : force-open ( addr len -- fid ) - 2dup r/w open-file 0< - IF drop r/w create-file throw ELSE nip nip THEN ; - -: get-history ( addr len -- ) - force-open to history - history file-size throw - 2dup forward^ 2! 2dup backward^ 2! end^ 2! ; - -s" GFORTHHIST" getenv dup 0= [IF] - 2drop s" ~/.gforth-history" -[THEN] get-history + 2dup r/w open-file + IF + drop r/w create-file throw + ELSE + nip nip + THEN ; -: history-cold - Defers 'cold +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 get-history ; + THEN ; +[ELSE] -' history-cold IS 'cold +: 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] \ moving in history file 16oct94py @@ -104,15 +111,17 @@ s" GFORTHHIST" getenv dup 0= [IF] hist-pos forward^ 2! tuck 2dup type 0 ; -: prev-line ( max span addr pos1 -- max span addr pos2 false ) - clear-line backward^ 2@ forward^ 2! +: find-prev-line ( max addr -- max span addr pos2 ) + 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 ; + REPEAT 2drop THEN tuck ; + +: prev-line ( max span addr pos1 -- max span addr pos2 false ) + clear-line find-prev-line 2dup type 0 ; Create lfpad #lf c, @@ -184,7 +193,7 @@ Create prefix-found 0 , 0 , : search-prefix ( addr1 len1 -- addr2 len2 ) 0 vp dup @ 1- cells over + DO I 2@ <> - IF I cell+ @ @ swap search-voc THEN + IF I cell+ @ wordlist-id @ swap search-voc THEN [ -1 cells ] Literal +LOOP prefix-string ; @@ -214,3 +223,31 @@ Create prefix-found 0 , 0 , ' (enter) #lf cells ctrlkeys + ! ' (enter) #cr cells ctrlkeys + ! ' tab-expand #tab cells ctrlkeys + ! + +\ initializing history + +: get-history ( addr len -- ) + ['] force-open catch + ?dup-if + \ !! >stderr + history-file type ." : " .error cr 2drop + ['] false ['] false ['] (ret) + else + to history + history file-size throw + 2dup forward^ 2! 2dup backward^ 2! end^ 2! + ['] next-line ['] prev-line ['] (enter) + endif + dup + [ #lf cells ctrlkeys + ]L ! + [ #cr cells ctrlkeys + ]L ! + [ ctrl P cells ctrlkeys + ]L ! + [ ctrl N cells ctrlkeys + ]L ! +; + +: history-cold ( -- ) + history-file get-history ; + +' history-cold INIT8 chained +history-cold +