gforth/history.fs - diff

Return to history.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/history.fs between versions 1.13 and 1.29

version 1.13, 1996/09/30 13:16:11	version 1.29, 2002/09/14 08:20:19
Line 1	Line 1
\ command line edit and history support 16oct94py	\ command line edit and history support 16oct94py

\ Copyright (C) 1995 Free Software Foundation, Inc.	\ Copyright (C) 1995,2000 Free Software Foundation, Inc.

\ This file is part of Gforth.	\ This file is part of Gforth.

Line 16	Line 16

\ You should have received a copy of the GNU General Public License	\ You should have received a copy of the GNU General Public License
\ along with this program; if not, write to the Free Software	\ along with this program; if not, write to the Free Software
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.	\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.

:noname	:noname
char [char] @ - ;	char [char] @ - ;
Line 41 interpret/compile: ctrl ( "<char>" -- c	Line 41 interpret/compile: ctrl ( "<char>" -- c
: (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 ;
	: bindkey ( xt key -- ) cells ctrlkeys + ! ;
' forw ctrl F cells ctrlkeys + !
' back ctrl B cells ctrlkeys + !	' forw ctrl F bindkey
' ?del ctrl H cells ctrlkeys + !	' back ctrl B bindkey
' eof ctrl D cells ctrlkeys + !	' ?del ctrl H bindkey
	' eof ctrl D bindkey
	' <del> ctrl X bindkey

' (ins) IS insert-char	' (ins) IS insert-char

Line 63 interpret/compile: ctrl ( "<char>" -- c	Line 65 interpret/compile: ctrl ( "<char>" -- c
2Variable end^	2Variable end^

: force-open ( addr len -- fid )	: 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" str= [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

Line 100 s" ~/.gforth-history" get-history	Line 113 s" ~/.gforth-history" get-history
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,

Line 180 Create prefix-found 0 , 0 ,	Line 195 Create prefix-found 0 , 0 ,
: 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 ;

Line 191 Create prefix-found 0 , 0 ,	Line 206 Create prefix-found 0 , 0 ,
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	key? IF #tab (ins) 0 EXIT THEN
tib-full?	kill-expand 2dup extract-word dup 0= IF nip EXIT THEN
	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 ;
Line 202 Create prefix-found 0 , 0 ,	Line 218 Create prefix-found 0 , 0 ,

' kill-prefix IS everychar	' kill-prefix IS everychar

' next-line ctrl N cells ctrlkeys + !	' next-line ctrl N bindkey
' prev-line ctrl P cells ctrlkeys + !	' prev-line ctrl P bindkey
' clear-tib ctrl K cells ctrlkeys + !	' clear-tib ctrl K bindkey
' first-pos ctrl A cells ctrlkeys + !	' first-pos ctrl A bindkey
' end-pos ctrl E cells ctrlkeys + !	' end-pos ctrl E bindkey
' (enter) #lf cells ctrlkeys + !	' (enter) #lf bindkey
' (enter) #cr cells ctrlkeys + !	' (enter) #cr bindkey
' tab-expand #tab cells ctrlkeys + !	' tab-expand #tab bindkey

	\ 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 bindkey
	#cr bindkey
	ctrl P bindkey
	ctrl N bindkey
	;

	: history-cold ( -- )
	history-file get-history ;

	' history-cold INIT8 chained
	history-cold

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.13
changed lines
	Added in v.1.29