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