| : (ret) type-rest drop true space ; |
: (ret) type-rest drop true space ; |
| : back dup IF 1- #bs emit ELSE #bell emit THEN 0 ; |
: 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 ; |
: forw 2 pick over <> IF 2dup + c@ emit 1+ ELSE #bell emit THEN 0 ; |
| : eof 2 pick over or 0= IF |
: <del> ( max span addr pos1 -- max span addr pos2 0 ) |
| bye |
2 pick over <> |
| ELSE 2 pick over <> |
IF forw drop (del) ELSE #bell emit THEN 0 ; |
| IF forw drop (del) ELSE #bell emit THEN 0 |
: eof 2 pick over or 0= IF bye ELSE <del> THEN ; |
| THEN ; |
|
| |
|
| ' forw ctrl F cells ctrlkeys + ! |
' forw ctrl F cells ctrlkeys + ! |
| ' back ctrl B cells ctrlkeys + ! |
' back ctrl B cells ctrlkeys + ! |
| |
|
| \ history support 16oct94py |
\ history support 16oct94py |
| |
|
| 0 Value history |
0 Value history \ history file fid |
| |
|
| 2Variable forward^ |
2Variable forward^ |
| 2Variable backward^ |
2Variable backward^ |
| 2Variable end^ |
2Variable end^ |
| |
|
| : force-open ( addr len -- handle ) |
: force-open ( addr len -- fid ) |
| 2dup r/w open-file 0< |
2dup r/w open-file |
| IF drop r/w create-file throw ELSE nip nip THEN ; |
IF |
| |
drop r/w create-file throw |
| : get-history ( addr len -- wid ) |
ELSE |
| force-open to history |
nip nip |
| history file-size throw |
THEN ; |
| 2dup forward^ 2! 2dup backward^ 2! end^ 2! ; |
|
| |
|
| s" ~/.gforth-history" get-history |
|
| |
|
| : history-cold |
s" os-class" environment? [IF] s" unix" compare 0= [ELSE] true [THEN] |
| Defers 'cold |
[IF] |
| s" ~/.gforth-history" get-history ; |
: history-file ( -- addr u ) |
| |
s" GFORTHHIST" getenv dup 0= IF |
| |
2drop s" ~/.gforth-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 |
\ moving in history file 16oct94py |
| |
|
| hist-pos forward^ 2! |
hist-pos forward^ 2! |
| tuck 2dup type 0 ; |
tuck 2dup type 0 ; |
| |
|
| : prev-line ( max span addr pos1 -- max span addr pos2 false ) |
: find-prev-line ( max addr -- max span addr pos2 ) |
| clear-line backward^ 2@ forward^ 2! |
backward^ 2@ forward^ 2! |
| over 2 + negate s>d backward^ 2@ d+ 0. dmax 2dup hist-setpos |
over 2 + negate s>d backward^ 2@ d+ 0. dmax 2dup hist-setpos |
| BEGIN |
BEGIN |
| backward^ 2! 2dup get-line WHILE |
backward^ 2! 2dup get-line WHILE |
| hist-pos 2dup forward^ 2@ d< WHILE |
hist-pos 2dup forward^ 2@ d< WHILE |
| rot drop |
rot drop |
| REPEAT 2drop THEN |
REPEAT 2drop THEN tuck ; |
| tuck 2dup type 0 ; |
|
| |
: prev-line ( max span addr pos1 -- max span addr pos2 false ) |
| |
clear-line find-prev-line 2dup type 0 ; |
| |
|
| Create lfpad #lf c, |
Create lfpad #lf c, |
| |
|
| : search-prefix ( addr1 len1 -- addr2 len2 ) |
: search-prefix ( addr1 len1 -- addr2 len2 ) |
| 0 vp dup @ 1- cells over + |
0 vp dup @ 1- cells over + |
| DO I 2@ <> |
DO I 2@ <> |
| IF I cell+ @ @ swap search-voc THEN |
IF I cell+ @ wordlist-id @ swap search-voc THEN |
| [ -1 cells ] Literal +LOOP |
[ -1 cells ] Literal +LOOP |
| prefix-string ; |
prefix-string ; |
| |
|
| 5 pick over 4 pick + prefix-found @ 0<> - < ; |
5 pick over 4 pick + prefix-found @ 0<> - < ; |
| |
|
| : tab-expand ( max span addr pos1 -- max span addr pos2 0 ) |
: tab-expand ( max span addr pos1 -- max span addr pos2 0 ) |
| kill-expand 2dup extract-word search-prefix |
kill-expand 2dup extract-word dup 0= IF nip EXIT THEN |
| tib-full? |
search-prefix tib-full? |
| IF 7 emit 2drop 0 0 prefix-found 2! |
IF 7 emit 2drop 0 0 prefix-found 2! |
| ELSE bounds ?DO I c@ (ins) LOOP THEN |
ELSE bounds ?DO I c@ (ins) LOOP THEN |
| prefix-found @ IF bl (ins) THEN 0 ; |
prefix-found @ IF bl (ins) THEN 0 ; |
| ' (enter) #lf cells ctrlkeys + ! |
' (enter) #lf cells ctrlkeys + ! |
| ' (enter) #cr cells ctrlkeys + ! |
' (enter) #cr cells ctrlkeys + ! |
| ' tab-expand #tab cells ctrlkeys + ! |
' tab-expand #tab cells ctrlkeys + ! |
| |
|
| |
\ initializing history |
| |
|
| |
: get-history ( addr len -- ) |
| |
['] force-open catch |
| |
?dup-if |
| |
\ !! >stderr |
| |
\ history-file type ." : " .error cr |
| |
drop 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 |
| |
|