gforth/history.fs - diff

Return to history.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/history.fs between versions 1.54 and 1.55

version 1.54, 2007/06/07 20:57:13	version 1.55, 2007/06/09 21:41:29
Line 70 s" os-class" environment? [IF] s" unix"	Line 70 s" os-class" environment? [IF] s" unix"
\ moving in history file 16oct94py	\ moving in history file 16oct94py

defer back-restore ( u -- )	defer back-restore ( u -- )
' backspaces is back-restore	defer cur-correct ( addr u -- )
	' backspaces IS back-restore
	' 2drop IS cur-correct

[IFDEF] x-width	[IFDEF] x-width
: clear-line ( max span addr pos1 -- max addr )	: clear-line ( max span addr pos1 -- max addr )
Line 93 defer back-restore ( u -- )	Line 95 defer back-restore ( u -- )
forward^ 2@ 2dup hist-setpos backward^ 2!	forward^ 2@ 2dup hist-setpos backward^ 2!
2dup get-line drop	2dup get-line drop
hist-pos forward^ 2!	hist-pos forward^ 2!
tuck 2dup type 0 ;	tuck 2dup type 2dup cur-correct 0 ;

: find-prev-line ( max addr -- max span addr pos2 )	: find-prev-line ( max addr -- max span addr pos2 )
backward^ 2@ forward^ 2!	backward^ 2@ forward^ 2!
Line 105 defer back-restore ( u -- )	Line 107 defer back-restore ( u -- )
REPEAT 2drop THEN tuck ;	REPEAT 2drop THEN tuck ;

: prev-line ( max span addr pos1 -- max span addr pos2 false )	: prev-line ( max span addr pos1 -- max span addr pos2 false )
clear-line find-prev-line 2dup type 0 ;	clear-line find-prev-line 2dup type 2dup cur-correct 0 ;

\ Create lfpad #lf c,	\ Create lfpad #lf c,

Line 201 require utf-8.fs	Line 203 require utf-8.fs
Variable curpos	Variable curpos

s" os-type" environment? [IF] s" cygwin" str= [IF]	s" os-type" environment? [IF] s" cygwin" str= [IF]
: save-cursor ( -- ) #esc emit '7 emit ;	: cygwin? ( -- flag ) s" TERM" getenv s" cygwin" str= ;
: restore-cursor ( -- ) #esc emit '8 emit ;	: at-xy? ( -- x y )
: cur-correct ( addr u -- ) 2drop ;	key? drop
	#esc emit ." [6n" 0 0
	BEGIN key dup 'R <> WHILE
	dup '; = IF drop swap ELSE
	dup '0 '9 1+ within IF '0 - swap 10 * + ELSE
	drop THEN THEN
	REPEAT drop 1- swap 1- ;
	: cursor@ ( -- n ) at-xy? form nip * + ;
	: cursor! ( n -- ) form nip /mod at-xy ;
	: xcur-correct ( addr u -- )
	cygwin? IF 2drop EXIT THEN
	x-width curpos @ + cursor@ -
	form nip >r r@ 2/ + r@ / r> * negate curpos +! ;
	: save-cursor ( -- )
	cygwin? IF #esc emit '7 emit ELSE cursor@ curpos ! THEN ;
	: restore-cursor ( -- )
	cygwin? IF #esc emit '8 emit ELSE curpos @ cursor! THEN ;
[ELSE]	[ELSE]
: at-xy? ( -- x y )	: at-xy? ( -- x y )
key? drop	key? drop
Line 215 s" os-type" environment? [IF] s" cygwin"	Line 233 s" os-type" environment? [IF] s" cygwin"
REPEAT drop 1- swap 1- ;	REPEAT drop 1- swap 1- ;
: cursor@ ( -- n ) at-xy? form nip * + ;	: cursor@ ( -- n ) at-xy? form nip * + ;
: cursor! ( n -- ) form nip /mod at-xy ;	: cursor! ( n -- ) form nip /mod at-xy ;
: cur-correct ( addr u -- ) x-width curpos @ + cursor@ -	: xcur-correct ( addr u -- ) x-width curpos @ + cursor@ -
form nip >r r@ 2/ + r@ / r> * negate curpos +! ;	form nip >r r@ 2/ + r@ / r> * negate curpos +! ;
: save-cursor ( -- ) cursor@ curpos ! ;	: save-cursor ( -- ) cursor@ curpos ! ;
: restore-cursor ( -- ) curpos @ cursor! ;	: restore-cursor ( -- ) curpos @ cursor! ;
[THEN]	[THEN] [THEN]
	' xcur-correct IS cur-correct

: .rest ( addr pos1 -- addr pos1 )	: .rest ( addr pos1 -- addr pos1 )
key? ?EXIT	key? ?EXIT
restore-cursor 2dup type 2dup cur-correct ;	restore-cursor 2dup type 2dup cur-correct ;
Line 311 s" os-type" environment? [IF] s" cygwin"	Line 331 s" os-type" environment? [IF] s" cygwin"
['] kill-prefix IS everychar	['] kill-prefix IS everychar
['] save-cursor IS everyline	['] save-cursor IS everyline
['] xback-restore IS back-restore	['] xback-restore IS back-restore
	['] xcur-correct IS cur-correct
;	;

xchar-history	xchar-history

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

Removed from v.1.54
changed lines
	Added in v.1.55