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 line_number 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
348 : KH.SPECIAL.KEY ( char -- true | false , handle fkeys or arrows, true if handled )
352 $ E0 OF key kh.handle.windows.key
356 key dup $ 4F = \ for TELNET
357 $ 5B = OR \ for regular ANSI terminals
359 key kh.handle.ansi.key
365 ASCII_BACKSPACE OF kh.backspace ENDOF
366 ASCII_DELETE OF kh.backspace ENDOF
367 ASCII_CTRL_X OF kh.clear.line ENDOF
368 ASCII_CTRL_A OF kh.far.left ENDOF
369 ASCII_CTRL_E OF kh.far.right ENDOF
377 : KH.SMART.KEY ( -- char )
379 key dup kh.special.key
385 : KH.INSCHAR { charc | repaint -- }
387 kh-cursor @ kh-span @ <
390 kh-buffer kh-cursor @ + ( -- source )
391 dup 1+ ( -- source dest )
392 kh-span @ kh-cursor @ - cmove>
395 \ write character to buffer
396 charc kh-buffer kh-cursor @ + c!
405 : EOL? ( char -- flag , true if an end of line character )
410 : KH.GETLINE ( max -- )
420 dup EOL? not ( <cr?> )
422 THEN ( -- char flag )
426 kh-span @ kh-cursor @ - ?dup
427 IF tio.forwards ( move to end of line )
433 : KH.ACCEPT ( addr max -- numChars )
437 IF kh-buffer kh-span @ kh.add.line
452 : HISTORY# ( -- , dump history buffer with numbers)
453 cr kh.oldest.line ?dup
455 BEGIN kh.current.num 3 .r ." ) " type ?pause cr
457 WHILE kh.current.line
462 : HISTORY ( -- , dump history buffer )
463 cr kh.oldest.line ?dup
467 WHILE kh.current.line
472 : XX ( line# -- , execute line x of history )
479 : HISTORY.RESET ( -- , clear history tables )
480 kh-history kh_history_size erase
484 : HISTORY.ON ( -- , install history vectors )
486 what's accept ['] (accept) =
487 IF ['] kh.accept is accept
491 : HISTORY.OFF ( -- , uninstall history vectors )
492 what's accept ['] kh.accept =
493 IF ['] (accept) is accept
508 if.forgotten history.off