version 1.1, 1994/10/18 15:57:17
|
version 1.6, 1995/06/07 10:05:05
|
Line 7
|
Line 7
|
2Variable end^ |
2Variable end^ |
|
|
: get-history ( addr len -- wid ) |
: get-history ( addr len -- wid ) |
|
\ check-file-prefix drop |
2dup r/w open-file 0< |
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 |
to history |
to history |
history file-size throw |
history file-size throw |
2dup forward^ 2! 2dup backward^ 2! end^ 2! ; |
2dup forward^ 2! 2dup backward^ 2! end^ 2! ; |
|
|
s" gforth.history" get-history |
s" ~/.gforth-history" get-history |
|
|
|
: history-cold |
|
Defers 'cold |
|
s" ~/.gforth-history" get-history ; |
|
|
|
' history-cold IS 'cold |
|
|
\ moving in history file 16oct94py |
\ moving in history file 16oct94py |
|
|
Line 36 s" gforth.history" get-history
|
Line 43 s" gforth.history" get-history
|
|
|
: prev-line ( max span addr pos1 -- max span addr pos2 false ) |
: prev-line ( max span addr pos1 -- max span addr pos2 false ) |
clear-line over 2 + negate s>d backward^ 2@ d+ 0. dmax |
clear-line over 2 + negate s>d backward^ 2@ d+ 0. dmax |
history reposition-file throw 0. |
2dup history reposition-file throw |
BEGIN 2over swap history read-line throw nip WHILE |
BEGIN 2over swap history read-line throw WHILE |
history file-position throw |
>r history file-position throw |
2dup backward^ 2@ d< WHILE 2swap 2drop |
2dup backward^ 2@ d< WHILE 2swap 2drop rdrop |
REPEAT 2drop THEN |
REPEAT ELSE >r history file-position throw THEN |
history reposition-file throw get-line 0 ; |
forward^ 2! backward^ 2! r> tuck 2dup type 0 ; |
|
|
: ctrl ( "<char>" -- ctrl-code ) |
: ctrl ( "<char>" -- ctrl-code ) |
char [char] @ - postpone Literal ; immediate |
char [char] @ - postpone Literal ; immediate |
Line 75 Create prefix-found 0 , 0 ,
|
Line 82 Create prefix-found 0 , 0 ,
|
IF r> char+ capscomp 0<= EXIT THEN |
IF r> char+ capscomp 0<= EXIT THEN |
nip r> c@ $1F and < ; |
nip r> c@ $1F and < ; |
|
|
: search-prefix ( addr len1 -- suffix len2 ) |
: search-prefix ( addr len1 -- suffix len2 ) 0 >r context |
context @ @ 0 >r |
BEGIN BEGIN dup @ over cell - @ = WHILE cell - REPEAT |
BEGIN dup WHILE |
dup >r -rot r> @ @ |
>r dup r@ cell+ c@ $1F and <= |
BEGIN dup WHILE >r dup r@ cell+ c@ $1F and <= |
IF 2dup r@ cell+ char+ capscomp 0= |
IF 2dup r@ cell+ char+ capscomp 0= |
IF r> dup r@ word-lex |
IF r> dup r@ word-lex |
IF dup prefix-found @ word-lex |
IF dup prefix-found @ word-lex |
0>= IF rdrop dup >r THEN |
0>= IF rdrop dup >r THEN |
THEN >r |
THEN >r |
THEN |
THEN |
THEN r> @ |
THEN r> @ |
REPEAT drop r> dup prefix-found ! ?dup |
REPEAT drop rot cell - dup vp u> 0= |
|
UNTIL drop r> dup prefix-found ! ?dup |
IF cell+ count $1F and rot /string rot drop |
IF cell+ count $1F and rot /string rot drop |
ELSE 2drop s" " THEN ; |
ELSE 2drop s" " THEN ; |
|
|