4 \ Copyright 1988 Phil Burk
5 \ Revised 2001 for pForth
9 Requires an ANSI compatible terminal.
11 To get Windows computers to use ANSI mode in their DOS windows,
12 Add this line to "C:\CONFIG.SYS" then reboot.
14 device=c:\windows\command\ansi.sys
16 When command line history is on, you can use the UP and DOWN arrow to scroll
17 through previous commands. Use the LEFT and RIGHT arrows to edit within a line.
18 CONTROL-A moves to beginning of line.
19 CONTROL-E moves to end of line.
20 CONTROL-X erases entire line.
23 HISTORY# ( -- , dump history buffer with numbers)
24 HISTORY ( -- , dump history buffer )
25 XX ( line# -- , execute line x of history )
26 HISTORY.RESET ( -- , clear history tables )
27 HISTORY.ON ( -- , install history vectors )
28 HISTORY.OFF ( -- , uninstall history vectors )
32 include? ESC[ termio.fth
39 \ You can expand the history buffer by increasing this constant!!!!!!!!!!
40 2048 constant KH_HISTORY_SIZE
42 create KH-HISTORY kh_history_size allot
43 KH-HISTORY kh_history_size erase
45 \ An entry in the history buffer consists of
46 \ byte - Count byte = N,
48 \ short - line number in Big Endian format,
49 \ byte - another Count byte = N, for reverse scan
51 \ The most recent entry is put at the beginning,
52 \ older entries are shifted up.
54 4 constant KH_LINE_EXTRA_SIZE ( 2 count bytes plus 2 size bytes )
56 : KH-END ( -- addr , end of history buffer )
57 kh-history kh_history_size +
60 : LINENUM@ ( addr -- w , stores in BigEndian format )
65 : LINENUM! ( w addr -- )
70 variable KH-LOOK ( cursor offset into history, point to 1st count byte of line )
72 variable KH-COUNTER ( 16 bit counter for line # )
73 variable KH-SPAN ( total number of characters in line )
74 variable KH-MATCH-SPAN ( span for matching on shift-up )
75 variable KH-CURSOR ( points to next insertion point )
76 variable KH-ADDRESS ( address to store chars )
77 variable KH-INSIDE ( true if we are scrolling inside the history buffer )
79 : KH.MAKE.ROOM ( N -- , make room for N more bytes at beginning)
81 kh-history dup r@ + ( source dest )
82 kh_history_size r> - 0 max move
85 : KH.NEWEST.LINE ( -- addr count , most recent line )
89 : KH.REWIND ( -- , move cursor to most recent line )
93 : KH.CURRENT.ADDR ( -- $addr , count byte of current line )
94 kh-look @ kh-history +
97 : KH.CURRENT.LINE ( -- addr count )
101 : KH.COMPARE ( addr count -- flag , true if redundant )
102 kh.newest.line compare 0= \ note: ANSI COMPARE is different than JForth days
105 : KH.NUM.ADDR ( -- addr , address of current line's line count )
109 : KH.CURRENT.NUM ( -- # , number of current line )
113 : KH.ADDR++ ( $addr -- $addr' , convert one kh to previous )
116 : KH.ADDR-- ( $addr -- $addr' , convert one kh to next )
117 dup 1- c@ \ get next lines endcount
118 4 + \ account for lineNum and two count bytes
119 - \ calc previous address
122 : KH.ENDCOUNT.ADDR ( -- addr , address of current end count )
126 : KH.ADD.LINE ( addr count -- )
128 IF ." KH.ADD.LINE - Too big for history!" 2drop
130 \ Compare with most recent line.
135 \ Set look pointer to point to first count byte of last string.
137 \ Make room for this line of text and line header.
138 \ PLB20100823 Was cell+ which broke on 64-bit code.
139 r@ KH_LINE_EXTRA_SIZE + kh.make.room
140 \ Set count bytes at beginning and end.
141 r@ kh-history c! ( start count )
142 r@ kh.endcount.addr c!
143 kh-counter @ kh.num.addr LINENUM! ( line )
144 \ Number lines modulo 1024
145 kh-counter @ 1+ $ 3FF and kh-counter !
146 kh-history 1+ ( calc destination )
147 r> cmove ( copy chars into space )
152 : KH.BACKUP.LINE { | cantmove addr' -- cantmove , advance KH-LOOK if in bounds }
153 true -> cantmove ( default flag, at end of history )
154 \ KH-LOOK points to count at start of current line
155 kh.current.addr c@ \ do we have any lines?
157 kh.current.addr kh.addr++ -> addr'
158 addr' kh-end U< \ within bounds?
160 addr' c@ \ older line has chars?
162 addr' kh-history - kh-look !
170 : KH.FORWARD.LINE ( -- cantmove? )
172 IF kh.current.addr kh.addr--
173 kh-history - kh-look !
177 : KH.OLDEST.LINE ( -- addr count | 0, oldest in buffer )
180 kh.current.line dup 0=
186 : KH.FIND.LINE ( line# -- $addr )
188 BEGIN kh.current.num over -
190 IF ." Line not in History Buffer!" cr drop 0 exit
197 : KH-BUFFER ( -- buffer )
201 : KH.RETURN ( -- , move to beginning of line )
206 : KH.REPLACE.LINE ( addr count -- , make this the current line of input )
211 2dup kh-buffer swap cmove
215 : KH.GET.MATCH ( -- , search for line with same start )
216 kh-match-span @ 0= ( keep length for multiple matches )
217 IF kh-span @ kh-match-span !
223 kh-buffer kh-match-span @ text=
224 IF kh.current.line kh.replace.line
231 kh-span @ kh-cursor @ - dup 0>
234 kh-span @ kh-cursor !
244 : KH.GET.OLDER ( -- , goto previous line )
246 IF kh.backup.line drop
248 kh.current.line kh.replace.line
252 : KH.GET.NEWER ( -- , next line )
262 : KH.CLEAR.LINE ( -- , rewind history scrolling and clear line )
264 tib 0 kh.replace.line
269 kh-cursor @ kh-span @ <
282 : KH.REFRESH ( -- , redraw current line as is )
284 kh-buffer kh-span @ type
295 : KH.BACKSPACE ( -- , backspace character from buffer and screen )
296 kh-cursor @ ?dup ( past 0? )
299 kh-buffer kh-cursor @ + ( -- source )
300 dup 1- ( -- source dest )
301 kh-span @ kh-cursor @ - cmove
313 : KH.DELETE ( -- , forward delete )
314 kh-cursor @ kh-span @ < ( before end )
316 kh-buffer kh-cursor @ + 1+ ( -- source )
317 dup 1- ( -- source dest )
318 kh-span @ kh-cursor @ - 0 max cmove
324 : KH.HANDLE.WINDOWS.KEY ( char -- , handle fkeys or arrows used by Windows ANSI.SYS )
326 $ 8D OF kh.get.match ENDOF
327 0 kh-match-span ! ( reset if any other key )
328 $ 48 OF kh.get.older ENDOF
329 $ 50 OF kh.get.newer ENDOF
330 $ 4D OF kh.go.right ENDOF
331 $ 4B OF kh.go.left ENDOF
332 $ 91 OF kh.clear.line ENDOF
333 $ 74 OF kh.far.right ENDOF
334 $ 73 OF kh.far.left ENDOF
335 $ 53 OF kh.delete ENDOF
339 : KH.HANDLE.ANSI.KEY ( char -- , handle fkeys or arrows used by ANSI terminal )
341 $ 41 OF kh.get.older ENDOF
342 $ 42 OF kh.get.newer ENDOF
343 $ 43 OF kh.go.right ENDOF
344 $ 44 OF kh.go.left ENDOF
349 : KH.SPECIAL.KEY ( char -- true | false , handle fkeys or arrows, true if handled )
353 $ E0 OF key kh.handle.windows.key
357 key dup $ 4F = \ for TELNET
358 $ 5B = OR \ for regular ANSI terminals
360 key kh.handle.ansi.key
366 ASCII_BACKSPACE OF kh.backspace ENDOF
367 ASCII_DELETE OF kh.backspace ENDOF
368 ASCII_CTRL_X OF kh.clear.line ENDOF
369 ASCII_CTRL_A OF kh.far.left ENDOF
370 ASCII_CTRL_E OF kh.far.right ENDOF
378 : KH.SMART.KEY ( -- char )
380 key dup kh.special.key
386 : KH.INSCHAR { charc | repaint -- }
388 kh-cursor @ kh-span @ <
391 kh-buffer kh-cursor @ + ( -- source )
392 dup 1+ ( -- source dest )
393 kh-span @ kh-cursor @ - cmove>
396 \ write character to buffer
397 charc kh-buffer kh-cursor @ + c!
406 : EOL? ( char -- flag , true if an end of line character )
411 : KH.GETLINE ( max -- )
421 dup EOL? not ( <cr?> )
423 THEN ( -- char flag )
427 kh-span @ kh-cursor @ - ?dup
428 IF tio.forwards ( move to end of line )
434 : KH.ACCEPT ( addr max -- numChars )
438 IF kh-buffer kh-span @ kh.add.line
453 : HISTORY# ( -- , dump history buffer with numbers)
454 cr kh.oldest.line ?dup
456 BEGIN kh.current.num 3 .r ." ) " type ?pause cr
458 WHILE kh.current.line
463 : HISTORY ( -- , dump history buffer )
464 cr kh.oldest.line ?dup
468 WHILE kh.current.line
473 : XX ( line# -- , execute line x of history )
480 : HISTORY.RESET ( -- , clear history tables )
481 kh-history kh_history_size erase
485 : HISTORY.ON ( -- , install history vectors )
487 what's accept ['] (accept) =
488 IF ['] kh.accept is accept
492 : HISTORY.OFF ( -- , uninstall history vectors )
493 what's accept ['] kh.accept =
494 IF ['] (accept) is accept
508 if.forgotten history.off