1 \ Command Line History
\r
4 \ Copyright 1988 Phil Burk
\r
5 \ Revised 2001 for pForth
\r
9 Requires an ANSI compatible terminal.
\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
14 device=c:\windows\command\ansi.sys
\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
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
32 include? ESC[ termio.fth
\r
34 ANEW TASK-HISTORY.FTH
\r
39 \ You can expand the history buffer by increasing this constant!!!!!!!!!!
\r
40 2048 constant KH_HISTORY_SIZE
\r
42 create KH-HISTORY kh_history_size allot
\r
43 KH-HISTORY kh_history_size erase
\r
45 \ An entry in the history buffer consists of
\r
46 \ byte - Count byte = N,
\r
48 \ short - line number in Big Endian format,
\r
49 \ byte - another Count byte = N, for reverse scan
\r
51 \ The most recent entry is put at the beginning,
\r
52 \ older entries are shifted up.
\r
54 : KH-END ( -- addr , end of history buffer )
\r
55 kh-history kh_history_size +
\r
58 : LINENUM@ ( addr -- w , stores in BigEndian format )
\r
63 : LINENUM! ( w addr -- )
\r
64 over -8 shift over c!
\r
68 variable KH-LOOK ( cursor offset into history, point to 1st count byte of line )
\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
77 : KH.MAKE.ROOM ( N -- , make room for N more bytes at beginning)
\r
79 kh-history dup r@ + ( source dest )
\r
80 kh_history_size r> - 0 max move
\r
83 : KH.NEWEST.LINE ( -- addr count , most recent line )
\r
87 : KH.REWIND ( -- , move cursor to most recent line )
\r
91 : KH.CURRENT.ADDR ( -- $addr , count byte of current line )
\r
92 kh-look @ kh-history +
\r
95 : KH.CURRENT.LINE ( -- addr count )
\r
96 kh.current.addr count
\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
103 : KH.NUM.ADDR ( -- addr , address of current line's line count )
\r
107 : KH.CURRENT.NUM ( -- # , number of current line )
\r
108 kh.num.addr LINENUM@
\r
111 : KH.ADDR++ ( $addr -- $addr' , convert one kh to previous )
\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
120 : KH.ENDCOUNT.ADDR ( -- addr , address of current end count )
\r
124 : KH.ADD.LINE ( addr count -- )
\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
133 \ Set look pointer to point to first count byte of last string.
\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
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
153 kh.current.addr kh.addr++ -> addr'
\r
154 addr' kh-end U< \ within bounds?
\r
156 addr' c@ \ older line has chars?
\r
158 addr' kh-history - kh-look !
\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
173 : KH.OLDEST.LINE ( -- addr count | 0, oldest in buffer )
\r
174 BEGIN kh.backup.line
\r
176 kh.current.line dup 0=
\r
182 : KH.FIND.LINE ( line# -- $addr )
\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
189 drop kh.current.addr
\r
193 : KH-BUFFER ( -- buffer )
\r
197 : KH.RETURN ( -- , move to beginning of line )
\r
202 : KH.REPLACE.LINE ( addr count -- , make this the current line of input )
\r
207 2dup kh-buffer swap cmove
\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
218 kh.current.line drop
\r
219 kh-buffer kh-match-span @ text=
\r
220 IF kh.current.line kh.replace.line
\r
227 kh-span @ kh-cursor @ - dup 0>
\r
230 kh-span @ kh-cursor !
\r
235 : KH.FAR.LEFT ( -- )
\r
240 : KH.GET.OLDER ( -- , goto previous line )
\r
242 IF kh.backup.line drop
\r
244 kh.current.line kh.replace.line
\r
248 : KH.GET.NEWER ( -- , next line )
\r
253 ELSE kh.current.line
\r
258 : KH.CLEAR.LINE ( -- , rewind history scrolling and clear line )
\r
260 tib 0 kh.replace.line
\r
264 : KH.GO.RIGHT ( -- )
\r
265 kh-cursor @ kh-span @ <
\r
271 : KH.GO.LEFT ( -- )
\r
278 : KH.REFRESH ( -- , redraw current line as is )
\r
280 kh-buffer kh-span @ type
\r
291 : KH.BACKSPACE ( -- , backspace character from buffer and screen )
\r
292 kh-cursor @ ?dup ( past 0? )
\r
295 kh-buffer kh-cursor @ + ( -- source )
\r
296 dup 1- ( -- source dest )
\r
297 kh-span @ kh-cursor @ - cmove
\r
309 : KH.DELETE ( -- , forward delete )
\r
310 kh-cursor @ kh-span @ < ( before end )
\r
312 kh-buffer kh-cursor @ + 1+ ( -- source )
\r
313 dup 1- ( -- source dest )
\r
314 kh-span @ kh-cursor @ - 0 max cmove
\r
320 : KH.HANDLE.WINDOWS.KEY ( char -- , handle fkeys or arrows used by Windows ANSI.SYS )
\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
335 : KH.HANDLE.ANSI.KEY ( char -- , handle fkeys or arrows used by ANSI terminal )
\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
345 : KH.SPECIAL.KEY ( char -- true | false , handle fkeys or arrows, true if handled )
\r
349 $ E0 OF key kh.handle.windows.key
\r
353 key dup $ 4F = \ for TELNET
\r
354 $ 5B = OR \ for regular ANSI terminals
\r
356 key kh.handle.ansi.key
\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
374 : KH.SMART.KEY ( -- char )
\r
376 key dup kh.special.key
\r
382 : KH.INSCHAR { charc | repaint -- }
\r
384 kh-cursor @ kh-span @ <
\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
392 \ write character to buffer
\r
393 charc kh-buffer kh-cursor @ + c!
\r
402 : EOL? ( char -- flag , true if an end of line character )
\r
407 : KH.GETLINE ( max -- )
\r
415 kh-max @ kh-span @ >
\r
417 dup EOL? not ( <cr?> )
\r
419 THEN ( -- char flag )
\r
423 kh-span @ kh-cursor @ - ?dup
\r
424 IF 1+ tio.forwards ( move to end of line )
\r
430 : KH.ACCEPT ( addr max -- numChars )
\r
434 IF kh-buffer kh-span @ kh.add.line
\r
442 cr pad swap type cr
\r
449 : HISTORY# ( -- , dump history buffer with numbers)
\r
450 cr kh.oldest.line ?dup
\r
452 BEGIN kh.current.num 3 .r ." ) " type ?pause cr
\r
454 WHILE kh.current.line
\r
459 : HISTORY ( -- , dump history buffer )
\r
460 cr kh.oldest.line ?dup
\r
462 BEGIN type ?pause cr
\r
464 WHILE kh.current.line
\r
469 : XX ( line# -- , execute line x of history )
\r
476 : HISTORY.RESET ( -- , clear history tables )
\r
477 kh-history kh_history_size erase
\r
481 : HISTORY.ON ( -- , install history vectors )
\r
483 what's accept ['] (accept) =
\r
484 IF ['] kh.accept is accept
\r
488 : HISTORY.OFF ( -- , uninstall history vectors )
\r
489 what's accept ['] kh.accept =
\r
490 IF ['] (accept) is accept
\r
504 if.forgotten history.off
\r