Fix REPOSITION-FILE, HISTORY, locked file handle and other problems.

[pforth] / fth / history.fth

\ Command Line History\r
\\r
\ Author: Phil Burk\r
\ Copyright 1988 Phil Burk\r
\ Revised 2001 for pForth\r
\r
0 [IF]\r
\r
Requires an ANSI compatible terminal.\r
\r
To get Windows computers to use ANSI mode in their DOS windows,\r
Add this line to "C:\CONFIG.SYS" then reboot.\r
  \r
  device=c:\windows\command\ansi.sys\r
\r
When command line history is on, you can use the UP and DOWN arrow to scroll\r
through previous commands. Use the LEFT and RIGHT arrows to edit within a line.\r
   CONTROL-A moves to beginning of line.\r
   CONTROL-E moves to end of line.\r
   CONTROL-X erases entire line.\r
\r
\r
HISTORY#       ( -- , dump history buffer with numbers)\r
HISTORY        ( -- , dump history buffer )\r
XX             ( line# -- , execute line x of history )\r
HISTORY.RESET  ( -- , clear history tables )\r
HISTORY.ON     ( -- , install history vectors )\r
HISTORY.OFF    ( -- , uninstall history vectors )\r
\r
[THEN]\r
\r
include? ESC[ termio.fth\r
\r
ANEW TASK-HISTORY.FTH\r
decimal\r
\r
private{\r
\r
\ You can expand the history buffer by increasing this constant!!!!!!!!!!\r
2048 constant KH_HISTORY_SIZE\r
\r
create KH-HISTORY kh_history_size allot\r
KH-HISTORY kh_history_size erase\r
\r
\ An entry in the history buffer consists of\r
\   byte  - Count byte = N,\r
\   chars - N chars,\r
\   short -  line number in Big Endian format,\r
\   byte  - another Count byte = N, for reverse scan\r
\\r
\ The most recent entry is put at the beginning,\r
\ older entries are shifted up.\r

4 constant KH_LINE_EXTRA_SIZE ( 2 count bytes plus 2 size bytes )
\r
: KH-END ( -- addr , end of history buffer )\r
	kh-history kh_history_size +\r
;\r
\r
: LINENUM@ ( addr -- w , stores in BigEndian format )\r
	dup c@ 8 shift\r
	swap 1+ c@ or\r
;\r
\r
: LINENUM! ( w addr -- )\r
	over -8 shift over c!\r
	1+ c!\r
;\r
\r
variable KH-LOOK      ( cursor offset into history, point to 1st count byte of line )\r
variable KH-MAX\r
variable KH-COUNTER       ( 16 bit counter for line # )\r
variable KH-SPAN          ( total number of characters in line )\r
variable KH-MATCH-SPAN    ( span for matching on shift-up )\r
variable KH-CURSOR        ( points to next insertion point )\r
variable KH-ADDRESS       ( address to store chars )\r
variable KH-INSIDE        ( true if we are scrolling inside the history buffer )\r
\r
: KH.MAKE.ROOM ( N -- , make room for N more bytes at beginning)\r
	>r  ( save N )\r
	kh-history dup r@ + ( source dest )\r
	kh_history_size r> - 0 max move\r
;\r
\r
: KH.NEWEST.LINE  ( -- addr count , most recent line )\r
	kh-history count\r
;\r
\r
: KH.REWIND ( -- , move cursor to most recent line )\r
	0 kh-look !\r
;\r
\r
: KH.CURRENT.ADDR ( -- $addr , count byte of current line )\r
	kh-look @ kh-history +\r
;\r
\r
: KH.CURRENT.LINE ( -- addr count )\r
	kh.current.addr count\r
;\r
\r
: KH.COMPARE ( addr count -- flag , true if redundant )\r
	kh.newest.line compare 0=   \ note: ANSI COMPARE is different than JForth days\r
;\r
\r
: KH.NUM.ADDR ( -- addr , address of current line's line count )\r
	kh.current.line +\r
;\r
\r
: KH.CURRENT.NUM ( -- # , number of current line )\r
	kh.num.addr LINENUM@\r
;\r
\r
: KH.ADDR++  ( $addr -- $addr' , convert one kh to previous )\r
	count + 3 +\r
;\r
: KH.ADDR--  ( $addr -- $addr' , convert one kh to next )\r
	dup 1- c@   \ get next lines endcount\r
	4 +	 \ account for lineNum and two count bytes\r
	-       \ calc previous address\r
;\r
\r
: KH.ENDCOUNT.ADDR ( -- addr , address of current end count )\r
	kh.num.addr 2+\r
;\r
\r
: KH.ADD.LINE ( addr count -- )\r
	dup 256 >\r
	IF ." KH.ADD.LINE - Too big for history!" 2drop\r
	ELSE   ( add to end )\r
\ Compare with most recent line.\r
		2dup kh.compare\r
		IF 2drop\r
		ELSE\r
			>r ( save count )\r
\ Set look pointer to point to first count byte of last string.\r
			0 kh-look !
\ Make room for this line of text and line header. 
\ PLB20100823 Was cell+ which broke on 64-bit code.\r
			r@ KH_LINE_EXTRA_SIZE + kh.make.room\r
\ Set count bytes at beginning and end.\r
			r@ kh-history c!  ( start count )\r
			r@ kh.endcount.addr c!\r
			kh-counter @ kh.num.addr LINENUM!  ( line )\r
\ Number lines modulo 1024\r
			kh-counter @ 1+ $ 3FF and kh-counter !\r
			kh-history 1+   ( calc destination )\r
			r> cmove  ( copy chars into space )\r
		THEN\r
	THEN\r
;\r
\r
: KH.BACKUP.LINE  { | cantmove addr' -- cantmove , advance KH-LOOK if in bounds }\r
	true -> cantmove ( default flag, at end of history )\r
\ KH-LOOK points to count at start of current line\r
	kh.current.addr c@       \ do we have any lines?\r
	IF\r
		kh.current.addr kh.addr++ -> addr'\r
		addr' kh-end U<      \ within bounds?\r
		IF  \r
			addr' c@     \ older line has chars?\r
			IF\r
				addr' kh-history - kh-look !\r
				false -> cantmove\r
			THEN\r
		THEN\r
	THEN\r
	cantmove\r
;\r
\r
: KH.FORWARD.LINE ( -- cantmove? )\r
    kh-look @ 0= dup not\r
    IF  kh.current.addr kh.addr--\r
	kh-history - kh-look !\r
    THEN\r
;\r
\r
: KH.OLDEST.LINE   ( -- addr count | 0, oldest in buffer )\r
    BEGIN kh.backup.line\r
    UNTIL\r
    kh.current.line dup 0=\r
    IF\r
    	nip\r
    THEN\r
;\r
\r
: KH.FIND.LINE ( line# -- $addr )\r
	kh.rewind\r
    BEGIN kh.current.num over -\r
    WHILE kh.backup.line\r
        IF ." Line not in History Buffer!" cr drop 0 exit\r
        THEN\r
    REPEAT\r
    drop kh.current.addr\r
;\r
\r
\r
: KH-BUFFER ( -- buffer )\r
    kh-address @\r
;\r
\r
: KH.RETURN ( -- , move to beginning of line )\r
    0 out !\r
    13 emit\r
;\r
\r
: KH.REPLACE.LINE  ( addr count -- , make this the current line of input )\r
    kh.return\r
    tio.erase.eol\r
    dup kh-span !\r
    dup kh-cursor !\r
    2dup kh-buffer swap cmove\r
    type\r
;\r
\r
: KH.GET.MATCH ( -- , search for line with same start )\r
    kh-match-span @ 0=  ( keep length for multiple matches )\r
    IF kh-span @ kh-match-span !\r
    THEN\r
    BEGIN\r
    	kh.backup.line not\r
    WHILE\r
    	kh.current.line drop\r
    	kh-buffer kh-match-span @ text=\r
        IF kh.current.line kh.replace.line\r
           exit\r
        THEN\r
    REPEAT\r
;\r
\r
: KH.FAR.RIGHT\r
    kh-span @ kh-cursor @ - dup 0>\r
    IF\r
    	tio.forwards\r
        kh-span @ kh-cursor !\r
    ELSE drop\r
    THEN\r
;\r
\r
: KH.FAR.LEFT ( -- )\r
    kh.return\r
    kh-cursor off\r
;\r
\r
: KH.GET.OLDER ( -- , goto previous line )\r
	kh-inside @\r
	IF kh.backup.line drop\r
	THEN\r
	kh.current.line kh.replace.line\r
	kh-inside on\r
;\r
\r
: KH.GET.NEWER ( -- , next line )\r
	kh.forward.line\r
	IF\r
		kh-inside off\r
		tib 0\r
	ELSE  kh.current.line\r
	THEN\r
	kh.replace.line\r
;\r
\r
: KH.CLEAR.LINE ( -- , rewind history scrolling and clear line )\r
	kh.rewind\r
	tib 0 kh.replace.line\r
	kh-inside off\r
;\r
\r
: KH.GO.RIGHT  ( -- )\r
    kh-cursor @ kh-span @ <\r
    IF 1 kh-cursor +!\r
       1 tio.forwards\r
    THEN\r
;\r
\r
: KH.GO.LEFT ( -- )\r
    kh-cursor @ ?dup\r
    IF 1- kh-cursor !\r
       1 tio.backwards\r
    THEN\r
;\r
\r
: KH.REFRESH  ( -- , redraw current line as is )\r
	kh.return\r
	kh-buffer kh-span @ type\r
	tio.erase.eol\r
	\r
	kh.return\r
	kh-cursor @ ?dup \r
	IF tio.forwards\r
	THEN\r
	\r
	kh-span @ out !\r
;\r
\r
: KH.BACKSPACE ( -- , backspace character from buffer and screen )\r
    kh-cursor @ ?dup  ( past 0? )\r
    IF  kh-span @ <\r
        IF  ( inside line )\r
            kh-buffer kh-cursor @ +  ( -- source )\r
            dup 1- ( -- source dest )\r
            kh-span @ kh-cursor @ - cmove\r
\            ." Deleted!" cr \r
        ELSE\r
            backspace\r
        THEN\r
        -1 kh-span +!\r
        -1 kh-cursor +!\r
    ELSE bell\r
    THEN\r
    kh.refresh\r
;\r
\r
: KH.DELETE ( -- , forward delete )\r
    kh-cursor @ kh-span @ <  ( before end )\r
    IF  ( inside line )\r
        kh-buffer kh-cursor @ + 1+ ( -- source )\r
        dup 1- ( -- source dest )\r
        kh-span @ kh-cursor @ - 0 max cmove\r
        -1 kh-span +!\r
        kh.refresh\r
    THEN\r
;\r
    \r
: KH.HANDLE.WINDOWS.KEY ( char -- , handle fkeys or arrows used by Windows ANSI.SYS )\r
	CASE\r
		$ 8D OF kh.get.match    ENDOF\r
			0 kh-match-span ! ( reset if any other key )\r
		$ 48 OF kh.get.older    ENDOF\r
		$ 50 OF kh.get.newer  ENDOF\r
		$ 4D OF kh.go.right ENDOF\r
		$ 4B OF kh.go.left  ENDOF\r
		$ 91 OF kh.clear.line  ENDOF\r
		$ 74 OF kh.far.right ENDOF\r
		$ 73 OF kh.far.left  ENDOF\r
		$ 53 OF kh.delete  ENDOF\r
	ENDCASE\r
;\r
\r
: KH.HANDLE.ANSI.KEY ( char -- , handle fkeys or arrows used by ANSI terminal )\r
	CASE\r
		$ 41 OF kh.get.older    ENDOF\r
		$ 42 OF kh.get.newer  ENDOF\r
		$ 43 OF kh.go.right ENDOF\r
		$ 44 OF kh.go.left  ENDOF\r
	ENDCASE\r
;\r
\r
\r
: KH.SPECIAL.KEY ( char  -- true | false , handle fkeys or arrows, true if handled )\r
	true >r\r
	CASE\r
	\r
	$ E0 OF key kh.handle.windows.key\r
	ENDOF\r
	\r
	ASCII_ESCAPE OF\r
		key dup $ 4F = \ for TELNET\r
		$ 5B = OR \ for regular ANSI terminals\r
		IF\r
			key kh.handle.ansi.key\r
		ELSE\r
			rdrop false >r\r
		THEN\r
	ENDOF\r
	\r
        ASCII_BACKSPACE OF kh.backspace ENDOF\r
        ASCII_DELETE    OF kh.backspace ENDOF\r
        ASCII_CTRL_X    OF kh.clear.line ENDOF\r
        ASCII_CTRL_A    OF kh.far.left ENDOF\r
        ASCII_CTRL_E    OF kh.far.right ENDOF\r
	\r
	rdrop false >r\r
	\r
	ENDCASE\r
	r>\r
;\r
		\r
: KH.SMART.KEY ( -- char )\r
    BEGIN\r
    	key dup kh.special.key\r
    WHILE\r
    	drop\r
    REPEAT\r
;\r
        \r
: KH.INSCHAR  { charc | repaint -- }\r
	false -> repaint\r
	kh-cursor @ kh-span @ <\r
	IF \r
\ Move characters up\r
		kh-buffer kh-cursor @ +  ( -- source )\r
		dup 1+ ( -- source dest )\r
		kh-span @ kh-cursor @ - cmove>\r
		true -> repaint\r
	THEN\r
\ write character to buffer\r
	charc kh-buffer kh-cursor @ + c!\r
	1 kh-cursor +!\r
	1 kh-span +!\r
	repaint\r
	IF kh.refresh\r
	ELSE charc emit\r
	THEN\r
;\r
\r
: EOL? ( char -- flag , true if an end of line character )\r
	dup 13 =\r
	swap 10 = OR\r
;\r
\r
: KH.GETLINE ( max -- )\r
	kh-max !\r
	kh-span off\r
	kh-cursor off\r
	kh-inside off\r
	kh.rewind\r
	0 kh-match-span !\r
	BEGIN\r
		kh-max @ kh-span @ >\r
		IF  kh.smart.key\r
			dup EOL? not  ( <cr?> )\r
		ELSE 0 false\r
		THEN  ( -- char flag )\r
	WHILE ( -- char )\r
		kh.inschar\r
	REPEAT drop\r
	kh-span @ kh-cursor @ - ?dup\r
	IF tio.forwards  ( move to end of line )\r
	THEN\r
	space\r
	flushemit\r
;\r
\r
: KH.ACCEPT ( addr max -- numChars )\r
	swap kh-address !\r
	kh.getline\r
	kh-span @ 0>\r
	IF kh-buffer kh-span @ kh.add.line\r
	THEN\r
	kh-span @\r
;\r
\r
: TEST.HISTORY\r
	4 0 DO\r
		pad 128 kh.accept\r
		cr pad swap type cr\r
	LOOP\r
;\r
\r
}private\r
\r
\r
: HISTORY# ( -- , dump history buffer with numbers)\r
	cr kh.oldest.line ?dup\r
	IF\r
		BEGIN kh.current.num 3 .r ." ) " type ?pause cr\r
			kh.forward.line 0=\r
		WHILE kh.current.line\r
		REPEAT\r
	THEN\r
;\r
\r
: HISTORY ( -- , dump history buffer )\r
	cr kh.oldest.line ?dup\r
	IF\r
		BEGIN type ?pause cr\r
			kh.forward.line 0=\r
		WHILE kh.current.line\r
		REPEAT\r
	THEN\r
;\r
\r
: XX  ( line# -- , execute line x of history )\r
	kh.find.line ?dup\r
	IF count evaluate\r
	THEN\r
;\r
\r
\r
: HISTORY.RESET  ( -- , clear history tables )\r
	kh-history kh_history_size erase\r
	kh-counter off\r
;\r
\r
: HISTORY.ON ( -- , install history vectors )\r
	history.reset\r
	what's accept ['] (accept) =\r
	IF ['] kh.accept is accept\r
	THEN\r
;\r
\r
: HISTORY.OFF ( -- , uninstall history vectors )\r
	what's accept ['] kh.accept =\r
	IF ['] (accept) is accept\r
	THEN\r
;\r
\r
\r
: AUTO.INIT\r
	auto.init\r
	history.on\r
;\r
: AUTO.TERM\r
	history.off\r
	auto.init\r
;\r
\r
if.forgotten history.off\r
\r
0 [IF]\r
history.reset\r
history.on\r
[THEN]\r