gforth/history.fs - diff

Return to history.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/history.fs between versions 1.16 and 1.26

version 1.16, 1997/12/01 21:15:03	version 1.26, 2000/09/23 15:46:57
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 ;

' forw ctrl F cells ctrlkeys + !	' forw ctrl F cells ctrlkeys + !
' back ctrl B cells ctrlkeys + !	' back ctrl B cells ctrlkeys + !
' ?del ctrl H cells ctrlkeys + !	' ?del ctrl H cells ctrlkeys + !
' eof ctrl D cells ctrlkeys + !	' eof ctrl D cells ctrlkeys + !
	' <del> ctrl X cells ctrlkeys + !

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

Line 63 interpret/compile: ctrl ( "<char>" -- c	Line 63 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	IF
throw ELSE nip nip THEN ;	drop r/w create-file throw
	ELSE
	nip nip
	THEN ;

s" os-class" environment? [IF] s" unix" compare 0= [ELSE] true [THEN]	s" os-class" environment? [IF] s" unix" compare 0= [ELSE] true [THEN]
[IF]	[IF]
Line 87 s" os-class" environment? [IF] s" unix"	Line 90 s" os-class" environment? [IF] s" unix"
s" /ghist.fs" pad +place pad count ;	s" /ghist.fs" pad +place pad count ;
[THEN]	[THEN]

: get-history ( addr len -- )
['] force-open catch
dup 0< IF ." can't open " history-file type cr throw THEN drop
to history
history file-size throw
2dup forward^ 2! 2dup backward^ 2! end^ 2! ;

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

' history-cold INIT8 chained
history-cold

\ moving in history file 16oct94py	\ moving in history file 16oct94py

: clear-line ( max span addr pos1 -- max addr )	: clear-line ( max span addr pos1 -- max addr )
Line 121 history-cold	Line 111 history-cold
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 201 Create prefix-found 0 , 0 ,	Line 193 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 212 Create prefix-found 0 , 0 ,	Line 204 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	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 ;
Line 231 Create prefix-found 0 , 0 ,	Line 223 Create prefix-found 0 , 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

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

Removed from v.1.16
changed lines
	Added in v.1.26