[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
\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 !\r
			r@ cell+ 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
Commit	Line	Data
bb6b2dcd	1	\ Command Line History\r
	2	\\r
	3	\ Author: Phil Burk\r
	4	\ Copyright 1988 Phil Burk\r
	5	\ Revised 2001 for pForth\r
	6	\r
	7	0 [IF]\r
	8	\r
	9	Requires an ANSI compatible terminal.\r
	10	\r
	11	To get Windows computers to use ANSI mode in their DOS windows,\r
	12	Add this line to "C:\CONFIG.SYS" then reboot.\r
	13	\r
	14	device=c:\windows\command\ansi.sys\r
	15	\r
	16	When command line history is on, you can use the UP and DOWN arrow to scroll\r
	17	through previous commands. Use the LEFT and RIGHT arrows to edit within a line.\r
	18	CONTROL-A moves to beginning of line.\r
	19	CONTROL-E moves to end of line.\r
	20	CONTROL-X erases entire line.\r
	21	\r
	22	\r
	23	HISTORY# ( -- , dump history buffer with numbers)\r
	24	HISTORY ( -- , dump history buffer )\r
	25	XX ( line# -- , execute line x of history )\r
	26	HISTORY.RESET ( -- , clear history tables )\r
	27	HISTORY.ON ( -- , install history vectors )\r
	28	HISTORY.OFF ( -- , uninstall history vectors )\r
	29	\r
	30	[THEN]\r
	31	\r
	32	include? ESC[ termio.fth\r
	33	\r
	34	ANEW TASK-HISTORY.FTH\r
	35	decimal\r
	36	\r
	37	private{\r
	38	\r
	39	\ You can expand the history buffer by increasing this constant!!!!!!!!!!\r
	40	2048 constant KH_HISTORY_SIZE\r
	41	\r
	42	create KH-HISTORY kh_history_size allot\r
	43	KH-HISTORY kh_history_size erase\r
	44	\r
	45	\ An entry in the history buffer consists of\r
	46	\ byte - Count byte = N,\r
	47	\ chars - N chars,\r
	48	\ short - line number in Big Endian format,\r
	49	\ byte - another Count byte = N, for reverse scan\r
	50	\\r
	51	\ The most recent entry is put at the beginning,\r
	52	\ older entries are shifted up.\r
	53	\r
	54	: KH-END ( -- addr , end of history buffer )\r
	55	kh-history kh_history_size +\r
	56	;\r
	57	\r
	58	: LINENUM@ ( addr -- w , stores in BigEndian format )\r
	59	dup c@ 8 shift\r
	60	swap 1+ c@ or\r
	61	;\r
	62	\r
	63	: LINENUM! ( w addr -- )\r
	64	over -8 shift over c!\r
65	1+ c!\r
66	;\r
67	\r
68	variable KH-LOOK ( cursor offset into history, point to 1st count byte of line )\r
69	variable KH-MAX\r
70	variable KH-COUNTER ( 16 bit counter for line # )\r
71	variable KH-SPAN ( total number of characters in line )\r
72	variable KH-MATCH-SPAN ( span for matching on shift-up )\r
73	variable KH-CURSOR ( points to next insertion point )\r
74	variable KH-ADDRESS ( address to store chars )\r
75	variable KH-INSIDE ( true if we are scrolling inside the history buffer )\r
76	\r
77	: KH.MAKE.ROOM ( N -- , make room for N more bytes at beginning)\r
78	>r ( save N )\r
79	kh-history dup r@ + ( source dest )\r
80	kh_history_size r> - 0 max move\r
81	;\r
82	\r
83	: KH.NEWEST.LINE ( -- addr count , most recent line )\r
84	kh-history count\r
85	;\r
86	\r
87	: KH.REWIND ( -- , move cursor to most recent line )\r
88	0 kh-look !\r
89	;\r
90	\r
91	: KH.CURRENT.ADDR ( -- $addr , count byte of current line )\r
92	kh-look @ kh-history +\r
93	;\r
94	\r
95	: KH.CURRENT.LINE ( -- addr count )\r
96	kh.current.addr count\r
97	;\r
98	\r
99	: KH.COMPARE ( addr count -- flag , true if redundant )\r
100	kh.newest.line compare 0= \ note: ANSI COMPARE is different than JForth days\r
101	;\r
102	\r
103	: KH.NUM.ADDR ( -- addr , address of current line's line count )\r
104	kh.current.line +\r
105	;\r
106	\r
107	: KH.CURRENT.NUM ( -- # , number of current line )\r
108	kh.num.addr LINENUM@\r
109	;\r
110	\r
111	: KH.ADDR++ ( $addr -- $addr' , convert one kh to previous )\r
112	count + 3 +\r
113	;\r
114	: KH.ADDR-- ( $addr -- $addr' , convert one kh to next )\r
115	dup 1- c@ \ get next lines endcount\r
116	4 + \ account for lineNum and two count bytes\r
117	- \ calc previous address\r
118	;\r
119	\r
120	: KH.ENDCOUNT.ADDR ( -- addr , address of current end count )\r
121	kh.num.addr 2+\r
122	;\r
123	\r
124	: KH.ADD.LINE ( addr count -- )\r
125	dup 256 >\r
126	IF ." KH.ADD.LINE - Too big for history!" 2drop\r
127	ELSE ( add to end )\r
128	\ Compare with most recent line.\r
129	2dup kh.compare\r
130	IF 2drop\r
131	ELSE\r
132	>r ( save count )\r
133	\ Set look pointer to point to first count byte of last string.\r
134	0 kh-look !\r
135	r@ cell+ kh.make.room\r
136	\ Set count bytes at beginning and end.\r
137	r@ kh-history c! ( start count )\r
138	r@ kh.endcount.addr c!\r
139	kh-counter @ kh.num.addr LINENUM! ( line )\r
140	\ Number lines modulo 1024\r
141	kh-counter @ 1+ $ 3FF and kh-counter !\r
142	kh-history 1+ ( calc destination )\r
143	r> cmove ( copy chars into space )\r
144	THEN\r
145	THEN\r
146	;\r
147	\r
148	: KH.BACKUP.LINE { \| cantmove addr' -- cantmove , advance KH-LOOK if in bounds }\r
149	true -> cantmove ( default flag, at end of history )\r
150	\ KH-LOOK points to count at start of current line\r
151	kh.current.addr c@ \ do we have any lines?\r
152	IF\r
153	kh.current.addr kh.addr++ -> addr'\r
154	addr' kh-end U< \ within bounds?\r
155	IF \r
156	addr' c@ \ older line has chars?\r
157	IF\r
158	addr' kh-history - kh-look !\r
159	false -> cantmove\r
160	THEN\r
161	THEN\r
162	THEN\r
163	cantmove\r
164	;\r
165	\r
166	: KH.FORWARD.LINE ( -- cantmove? )\r
167	kh-look @ 0= dup not\r
168	IF kh.current.addr kh.addr--\r
169	kh-history - kh-look !\r
170	THEN\r
171	;\r
172	\r
173	: KH.OLDEST.LINE ( -- addr count \| 0, oldest in buffer )\r
174	BEGIN kh.backup.line\r
175	UNTIL\r
176	kh.current.line dup 0=\r
177	IF\r
178	nip\r
179	THEN\r
180	;\r
181	\r
182	: KH.FIND.LINE ( line# -- $addr )\r
183	kh.rewind\r
184	BEGIN kh.current.num over -\r
185	WHILE kh.backup.line\r
186	IF ." Line not in History Buffer!" cr drop 0 exit\r
187	THEN\r
188	REPEAT\r
189	drop kh.current.addr\r
190	;\r
191	\r
192	\r
193	: KH-BUFFER ( -- buffer )\r
194	kh-address @\r
195	;\r
196	\r
197	: KH.RETURN ( -- , move to beginning of line )\r
198	0 out !\r
199	13 emit\r
200	;\r
201	\r
202	: KH.REPLACE.LINE ( addr count -- , make this the current line of input )\r
203	kh.return\r
204	tio.erase.eol\r
205	dup kh-span !\r
206	dup kh-cursor !\r
207	2dup kh-buffer swap cmove\r
208	type\r
209	;\r
210	\r
211	: KH.GET.MATCH ( -- , search for line with same start )\r
212	kh-match-span @ 0= ( keep length for multiple matches )\r
213	IF kh-span @ kh-match-span !\r
214	THEN\r
215	BEGIN\r
216	kh.backup.line not\r
217	WHILE\r
218	kh.current.line drop\r
219	kh-buffer kh-match-span @ text=\r
220	IF kh.current.line kh.replace.line\r
221	exit\r
222	THEN\r
223	REPEAT\r
224	;\r
225	\r
226	: KH.FAR.RIGHT\r
227	kh-span @ kh-cursor @ - dup 0>\r
228	IF\r
229	tio.forwards\r
230	kh-span @ kh-cursor !\r
231	ELSE drop\r
232	THEN\r
233	;\r
234	\r
235	: KH.FAR.LEFT ( -- )\r
236	kh.return\r
237	kh-cursor off\r
238	;\r
239	\r
240	: KH.GET.OLDER ( -- , goto previous line )\r
241	kh-inside @\r
242	IF kh.backup.line drop\r
243	THEN\r
244	kh.current.line kh.replace.line\r
245	kh-inside on\r
246	;\r
247	\r
248	: KH.GET.NEWER ( -- , next line )\r
249	kh.forward.line\r
250	IF\r
251	kh-inside off\r
252	tib 0\r
253	ELSE kh.current.line\r
254	THEN\r
255	kh.replace.line\r
256	;\r
257	\r
258	: KH.CLEAR.LINE ( -- , rewind history scrolling and clear line )\r
259	kh.rewind\r
260	tib 0 kh.replace.line\r
261	kh-inside off\r
262	;\r
263	\r
264	: KH.GO.RIGHT ( -- )\r
265	kh-cursor @ kh-span @ <\r
266	IF 1 kh-cursor +!\r
267	1 tio.forwards\r
268	THEN\r
269	;\r
270	\r
271	: KH.GO.LEFT ( -- )\r
272	kh-cursor @ ?dup\r
273	IF 1- kh-cursor !\r
274	1 tio.backwards\r
275	THEN\r
276	;\r
277	\r
278	: KH.REFRESH ( -- , redraw current line as is )\r
279	kh.return\r
280	kh-buffer kh-span @ type\r
281	tio.erase.eol\r
282	\r
283	kh.return\r
284	kh-cursor @ ?dup \r
285	IF tio.forwards\r
286	THEN\r
287	\r
288	kh-span @ out !\r
289	;\r
290	\r
291	: KH.BACKSPACE ( -- , backspace character from buffer and screen )\r
292	kh-cursor @ ?dup ( past 0? )\r
293	IF kh-span @ <\r
294	IF ( inside line )\r
295	kh-buffer kh-cursor @ + ( -- source )\r
296	dup 1- ( -- source dest )\r
297	kh-span @ kh-cursor @ - cmove\r
298	\ ." Deleted!" cr \r
299	ELSE\r
300	backspace\r
301	THEN\r
302	-1 kh-span +!\r
303	-1 kh-cursor +!\r
304	ELSE bell\r
305	THEN\r
306	kh.refresh\r
307	;\r
308	\r
309	: KH.DELETE ( -- , forward delete )\r
310	kh-cursor @ kh-span @ < ( before end )\r
311	IF ( inside line )\r
312	kh-buffer kh-cursor @ + 1+ ( -- source )\r
313	dup 1- ( -- source dest )\r
314	kh-span @ kh-cursor @ - 0 max cmove\r
315	-1 kh-span +!\r
316	kh.refresh\r
317	THEN\r
318	;\r
319	\r
320	: KH.HANDLE.WINDOWS.KEY ( char -- , handle fkeys or arrows used by Windows ANSI.SYS )\r
321	CASE\r
322	$ 8D OF kh.get.match ENDOF\r
323	0 kh-match-span ! ( reset if any other key )\r
324	$ 48 OF kh.get.older ENDOF\r
325	$ 50 OF kh.get.newer ENDOF\r
326	$ 4D OF kh.go.right ENDOF\r
327	$ 4B OF kh.go.left ENDOF\r
328	$ 91 OF kh.clear.line ENDOF\r
329	$ 74 OF kh.far.right ENDOF\r
330	$ 73 OF kh.far.left ENDOF\r
331	$ 53 OF kh.delete ENDOF\r
332	ENDCASE\r
333	;\r
334	\r
335	: KH.HANDLE.ANSI.KEY ( char -- , handle fkeys or arrows used by ANSI terminal )\r
336	CASE\r
337	$ 41 OF kh.get.older ENDOF\r
338	$ 42 OF kh.get.newer ENDOF\r
339	$ 43 OF kh.go.right ENDOF\r
340	$ 44 OF kh.go.left ENDOF\r
341	ENDCASE\r
342	;\r
343	\r
344	\r
345	: KH.SPECIAL.KEY ( char -- true \| false , handle fkeys or arrows, true if handled )\r
346	true >r\r
347	CASE\r
348	\r
349	$ E0 OF key kh.handle.windows.key\r
350	ENDOF\r
351	\r
352	ASCII_ESCAPE OF\r
353	key dup $ 4F = \ for TELNET\r
354	$ 5B = OR \ for regular ANSI terminals\r
355	IF\r
356	key kh.handle.ansi.key\r
357	ELSE\r
358	rdrop false >r\r
359	THEN\r
360	ENDOF\r
361	\r
362	ASCII_BACKSPACE OF kh.backspace ENDOF\r
363	ASCII_DELETE OF kh.backspace ENDOF\r
364	ASCII_CTRL_X OF kh.clear.line ENDOF\r
365	ASCII_CTRL_A OF kh.far.left ENDOF\r
366	ASCII_CTRL_E OF kh.far.right ENDOF\r
367	\r
368	rdrop false >r\r
369	\r
370	ENDCASE\r
371	r>\r
372	;\r
373	\r
374	: KH.SMART.KEY ( -- char )\r
375	BEGIN\r
376	key dup kh.special.key\r
377	WHILE\r
378	drop\r
379	REPEAT\r
380	;\r
381	\r
382	: KH.INSCHAR { charc \| repaint -- }\r
383	false -> repaint\r
384	kh-cursor @ kh-span @ <\r
385	IF \r
386	\ Move characters up\r
387	kh-buffer kh-cursor @ + ( -- source )\r
388	dup 1+ ( -- source dest )\r
389	kh-span @ kh-cursor @ - cmove>\r
390	true -> repaint\r
391	THEN\r
392	\ write character to buffer\r
393	charc kh-buffer kh-cursor @ + c!\r
394	1 kh-cursor +!\r
395	1 kh-span +!\r
396	repaint\r
397	IF kh.refresh\r
398	ELSE charc emit\r
399	THEN\r
400	;\r
401	\r
402	: EOL? ( char -- flag , true if an end of line character )\r
403	dup 13 =\r
404	swap 10 = OR\r
405	;\r
406	\r
407	: KH.GETLINE ( max -- )\r
408	kh-max !\r
409	kh-span off\r
410	kh-cursor off\r
411	kh-inside off\r
412	kh.rewind\r
413	0 kh-match-span !\r
414	BEGIN\r
415	kh-max @ kh-span @ >\r
416	IF kh.smart.key\r
417	dup EOL? not ( <cr?> )\r
418	ELSE 0 false\r
419	THEN ( -- char flag )\r
420	WHILE ( -- char )\r
421	kh.inschar\r
422	REPEAT drop\r
423	kh-span @ kh-cursor @ - ?dup\r
6b91cb54	424	IF tio.forwards ( move to end of line )\r
bb6b2dcd	425	THEN\r
6b91cb54	426	space\r
bb6b2dcd	427	flushemit\r
	428	;\r
	429	\r
	430	: KH.ACCEPT ( addr max -- numChars )\r
	431	swap kh-address !\r
	432	kh.getline\r
	433	kh-span @ 0>\r
	434	IF kh-buffer kh-span @ kh.add.line\r
	435	THEN\r
	436	kh-span @\r
	437	;\r
	438	\r
	439	: TEST.HISTORY\r
	440	4 0 DO\r
	441	pad 128 kh.accept\r
	442	cr pad swap type cr\r
	443	LOOP\r
	444	;\r
	445	\r
	446	}private\r
	447	\r
	448	\r
	449	: HISTORY# ( -- , dump history buffer with numbers)\r
	450	cr kh.oldest.line ?dup\r
	451	IF\r
	452	BEGIN kh.current.num 3 .r ." ) " type ?pause cr\r
	453	kh.forward.line 0=\r
	454	WHILE kh.current.line\r
	455	REPEAT\r
	456	THEN\r
	457	;\r
	458	\r
	459	: HISTORY ( -- , dump history buffer )\r
	460	cr kh.oldest.line ?dup\r
	461	IF\r
	462	BEGIN type ?pause cr\r
	463	kh.forward.line 0=\r
	464	WHILE kh.current.line\r
	465	REPEAT\r
	466	THEN\r
	467	;\r
	468	\r
	469	: XX ( line# -- , execute line x of history )\r
	470	kh.find.line ?dup\r
	471	IF count evaluate\r
	472	THEN\r
	473	;\r
	474	\r
	475	\r
	476	: HISTORY.RESET ( -- , clear history tables )\r
	477	kh-history kh_history_size erase\r
	478	kh-counter off\r
	479	;\r
	480	\r
	481	: HISTORY.ON ( -- , install history vectors )\r
	482	history.reset\r
	483	what's accept ['] (accept) =\r
	484	IF ['] kh.accept is accept\r
	485	THEN\r
	486	;\r
	487	\r
	488	: HISTORY.OFF ( -- , uninstall history vectors )\r
	489	what's accept ['] kh.accept =\r
	490	IF ['] (accept) is accept\r
491	THEN\r
492	;\r
493	\r
494	\r
495	: AUTO.INIT\r
496	auto.init\r
497	history.on\r
498	;\r
499	: AUTO.TERM\r
500	history.off\r
501	auto.init\r
502	;\r
503	\r
504	if.forgotten history.off\r
505	\r
506	0 [IF]\r
507	history.reset\r
508	history.on\r
509	[THEN]\r