\ Command Line History
\
\ Author: Phil Burk
\ Copyright 1988 Phil Burk
\ Revised 2001 for pForth
0 [IF]
Requires an ANSI compatible terminal.
To get Windows computers to use ANSI mode in their DOS windows,
Add this line to "C:\CONFIG.SYS" then reboot.
device=c:\windows\command\ansi.sys
When command line history is on, you can use the UP and DOWN arrow to scroll
through previous commands. Use the LEFT and RIGHT arrows to edit within a line.
CONTROL-A moves to beginning of line.
CONTROL-E moves to end of line.
CONTROL-X erases entire line.
HISTORY# ( -- , dump history buffer with numbers)
HISTORY ( -- , dump history buffer )
XX ( line# -- , execute line x of history )
HISTORY.RESET ( -- , clear history tables )
HISTORY.ON ( -- , install history vectors )
HISTORY.OFF ( -- , uninstall history vectors )
[THEN]
include? ESC[ termio.fth
ANEW TASK-HISTORY.FTH
decimal
private{
\ You can expand the history buffer by increasing this constant!!!!!!!!!!
2048 constant KH_HISTORY_SIZE
create KH-HISTORY kh_history_size allot
KH-HISTORY kh_history_size erase
\ An entry in the history buffer consists of
\ byte - Count byte = N,
\ chars - N chars,
\ short - line number in Big Endian format,
\ byte - another Count byte = N, for reverse scan
\
\ The most recent entry is put at the beginning,
\ older entries are shifted up.
4 constant KH_LINE_EXTRA_SIZE ( 2 count bytes plus 2 line_number bytes )
: KH-END ( -- addr , end of history buffer )
kh-history kh_history_size +
;
: LINENUM@ ( addr -- w , stores in BigEndian format )
dup c@ 8 shift
swap 1+ c@ or
;
: LINENUM! ( w addr -- )
over -8 shift over c!
1+ c!
;
variable KH-LOOK ( cursor offset into history, point to 1st count byte of line )
variable KH-MAX
variable KH-COUNTER ( 16 bit counter for line # )
variable KH-SPAN ( total number of characters in line )
variable KH-MATCH-SPAN ( span for matching on shift-up )
variable KH-CURSOR ( points to next insertion point )
variable KH-ADDRESS ( address to store chars )
variable KH-INSIDE ( true if we are scrolling inside the history buffer )
: KH.MAKE.ROOM ( N -- , make room for N more bytes at beginning)
>r ( save N )
kh-history dup r@ + ( source dest )
kh_history_size r> - 0 max move
;
: KH.NEWEST.LINE ( -- addr count , most recent line )
kh-history count
;
: KH.REWIND ( -- , move cursor to most recent line )
0 kh-look !
;
: KH.CURRENT.ADDR ( -- $addr , count byte of current line )
kh-look @ kh-history +
;
: KH.CURRENT.LINE ( -- addr count )
kh.current.addr count
;
: KH.COMPARE ( addr count -- flag , true if redundant )
kh.newest.line compare 0= \ note: ANSI COMPARE is different than JForth days
;
: KH.NUM.ADDR ( -- addr , address of current line's line count )
kh.current.line +
;
: KH.CURRENT.NUM ( -- # , number of current line )
kh.num.addr LINENUM@
;
: KH.ADDR++ ( $addr -- $addr' , convert one kh to previous )
count + 3 +
;
: KH.ADDR-- ( $addr -- $addr' , convert one kh to next )
dup 1- c@ \ get next lines endcount
4 + \ account for lineNum and two count bytes
- \ calc previous address
;
: KH.ENDCOUNT.ADDR ( -- addr , address of current end count )
kh.num.addr 2+
;
: KH.ADD.LINE ( addr count -- )
dup 256 >
IF ." KH.ADD.LINE - Too big for history!" 2drop
ELSE ( add to end )
\ Compare with most recent line.
2dup kh.compare
IF 2drop
ELSE
>r ( save count )
\ Set look pointer to point to first count byte of last string.
0 kh-look !
\ Make room for this line of text and line header.
\ PLB20100823 Was cell+ which broke on 64-bit code.
r@ KH_LINE_EXTRA_SIZE + kh.make.room
\ Set count bytes at beginning and end.
r@ kh-history c! ( start count )
r@ kh.endcount.addr c!
kh-counter @ kh.num.addr LINENUM! ( line )
\ Number lines modulo 1024
kh-counter @ 1+ $ 3FF and kh-counter !
kh-history 1+ ( calc destination )
r> cmove ( copy chars into space )
THEN
THEN
;
: KH.BACKUP.LINE { | cantmove addr' -- cantmove , advance KH-LOOK if in bounds }
true -> cantmove ( default flag, at end of history )
\ KH-LOOK points to count at start of current line
kh.current.addr c@ \ do we have any lines?
IF
kh.current.addr kh.addr++ -> addr'
addr' kh-end U< \ within bounds?
IF
addr' c@ \ older line has chars?
IF
addr' kh-history - kh-look !
false -> cantmove
THEN
THEN
THEN
cantmove
;
: KH.FORWARD.LINE ( -- cantmove? )
kh-look @ 0= dup not
IF kh.current.addr kh.addr--
kh-history - kh-look !
THEN
;
: KH.OLDEST.LINE ( -- addr count | 0, oldest in buffer )
BEGIN kh.backup.line
UNTIL
kh.current.line dup 0=
IF
nip
THEN
;
: KH.FIND.LINE ( line# -- $addr )
kh.rewind
BEGIN kh.current.num over -
WHILE kh.backup.line
IF ." Line not in History Buffer!" cr drop 0 exit
THEN
REPEAT
drop kh.current.addr
;
: KH-BUFFER ( -- buffer )
kh-address @
;
: KH.RETURN ( -- , move to beginning of line )
0 out !
13 emit
;
: KH.REPLACE.LINE ( addr count -- , make this the current line of input )
kh.return
tio.erase.eol
dup kh-span !
dup kh-cursor !
2dup kh-buffer swap cmove
type
;
: KH.GET.MATCH ( -- , search for line with same start )
kh-match-span @ 0= ( keep length for multiple matches )
IF kh-span @ kh-match-span !
THEN
BEGIN
kh.backup.line not
WHILE
kh.current.line drop
kh-buffer kh-match-span @ text=
IF kh.current.line kh.replace.line
exit
THEN
REPEAT
;
: KH.FAR.RIGHT
kh-span @ kh-cursor @ - dup 0>
IF
tio.forwards
kh-span @ kh-cursor !
ELSE drop
THEN
;
: KH.FAR.LEFT ( -- )
kh.return
kh-cursor off
;
: KH.GET.OLDER ( -- , goto previous line )
kh-inside @
IF kh.backup.line drop
THEN
kh.current.line kh.replace.line
kh-inside on
;
: KH.GET.NEWER ( -- , next line )
kh.forward.line
IF
kh-inside off
tib 0
ELSE kh.current.line
THEN
kh.replace.line
;
: KH.CLEAR.LINE ( -- , rewind history scrolling and clear line )
kh.rewind
tib 0 kh.replace.line
kh-inside off
;
: KH.GO.RIGHT ( -- )
kh-cursor @ kh-span @ <
IF 1 kh-cursor +!
1 tio.forwards
THEN
;
: KH.GO.LEFT ( -- )
kh-cursor @ ?dup
IF 1- kh-cursor !
1 tio.backwards
THEN
;
: KH.REFRESH ( -- , redraw current line as is )
kh.return
kh-buffer kh-span @ type
tio.erase.eol
kh.return
kh-cursor @ ?dup
IF tio.forwards
THEN
kh-span @ out !
;
: KH.BACKSPACE ( -- , backspace character from buffer and screen )
kh-cursor @ ?dup ( past 0? )
IF kh-span @ <
IF ( inside line )
kh-buffer kh-cursor @ + ( -- source )
dup 1- ( -- source dest )
kh-span @ kh-cursor @ - cmove
\ ." Deleted!" cr
ELSE
backspace
THEN
-1 kh-span +!
-1 kh-cursor +!
ELSE bell
THEN
kh.refresh
;
: KH.DELETE ( -- , forward delete )
kh-cursor @ kh-span @ < ( before end )
IF ( inside line )
kh-buffer kh-cursor @ + 1+ ( -- source )
dup 1- ( -- source dest )
kh-span @ kh-cursor @ - 0 max cmove
-1 kh-span +!
kh.refresh
THEN
;
: KH.HANDLE.WINDOWS.KEY ( char -- , handle fkeys or arrows used by Windows ANSI.SYS )
CASE
$ 8D OF kh.get.match ENDOF
0 kh-match-span ! ( reset if any other key )
$ 48 OF kh.get.older ENDOF
$ 50 OF kh.get.newer ENDOF
$ 4D OF kh.go.right ENDOF
$ 4B OF kh.go.left ENDOF
$ 91 OF kh.clear.line ENDOF
$ 74 OF kh.far.right ENDOF
$ 73 OF kh.far.left ENDOF
$ 53 OF kh.delete ENDOF
ENDCASE
;
: KH.HANDLE.ANSI.KEY ( char -- , handle fkeys or arrows used by ANSI terminal )
CASE
$ 41 OF kh.get.older ENDOF
$ 42 OF kh.get.newer ENDOF
$ 43 OF kh.go.right ENDOF
$ 44 OF kh.go.left ENDOF
ENDCASE
;
: KH.SPECIAL.KEY ( char -- true | false , handle fkeys or arrows, true if handled )
true >r
CASE
$ E0 OF key kh.handle.windows.key
ENDOF
ASCII_ESCAPE OF
key dup $ 4F = \ for TELNET
$ 5B = OR \ for regular ANSI terminals
IF
key kh.handle.ansi.key
ELSE
rdrop false >r
THEN
ENDOF
ASCII_BACKSPACE OF kh.backspace ENDOF
ASCII_DELETE OF kh.backspace ENDOF
ASCII_CTRL_X OF kh.clear.line ENDOF
ASCII_CTRL_A OF kh.far.left ENDOF
ASCII_CTRL_E OF kh.far.right ENDOF
rdrop false >r
ENDCASE
r>
;
: KH.SMART.KEY ( -- char )
BEGIN
key dup kh.special.key
WHILE
drop
REPEAT
;
: KH.INSCHAR { charc | repaint -- }
false -> repaint
kh-cursor @ kh-span @ <
IF
\ Move characters up
kh-buffer kh-cursor @ + ( -- source )
dup 1+ ( -- source dest )
kh-span @ kh-cursor @ - cmove>
true -> repaint
THEN
\ write character to buffer
charc kh-buffer kh-cursor @ + c!
1 kh-cursor +!
1 kh-span +!
repaint
IF kh.refresh
ELSE charc emit
THEN
;
: EOL? ( char -- flag , true if an end of line character )
dup 13 =
swap 10 = OR
;
: KH.GETLINE ( max -- )
kh-max !
kh-span off
kh-cursor off
kh-inside off
kh.rewind
0 kh-match-span !
BEGIN
kh-max @ kh-span @ >
IF kh.smart.key
dup EOL? not ( <cr?> )
ELSE 0 false
THEN ( -- char flag )
WHILE ( -- char )
kh.inschar
REPEAT drop
kh-span @ kh-cursor @ - ?dup
IF tio.forwards ( move to end of line )
THEN
space
flushemit
;
: KH.ACCEPT ( addr max -- numChars )
swap kh-address !
kh.getline
kh-span @ 0>
IF kh-buffer kh-span @ kh.add.line
THEN
kh-span @
;
: TEST.HISTORY
4 0 DO
pad 128 kh.accept
cr pad swap type cr
LOOP
;
}private
: HISTORY# ( -- , dump history buffer with numbers)
cr kh.oldest.line ?dup
IF
BEGIN kh.current.num 3 .r ." ) " type ?pause cr
kh.forward.line 0=
WHILE kh.current.line
REPEAT
THEN
;
: HISTORY ( -- , dump history buffer )
cr kh.oldest.line ?dup
IF
BEGIN type ?pause cr
kh.forward.line 0=
WHILE kh.current.line
REPEAT
THEN
;
: XX ( line# -- , execute line x of history )
kh.find.line ?dup
IF count evaluate
THEN
;
: HISTORY.RESET ( -- , clear history tables )
kh-history kh_history_size erase
kh-counter off
;
: HISTORY.ON ( -- , install history vectors )
history.reset
what's accept ['] (accept) =
IF ['] kh.accept is accept
THEN
;
: HISTORY.OFF ( -- , uninstall history vectors )
what's accept ['] kh.accept =
IF ['] (accept) is accept
THEN
;
: AUTO.INIT
auto.init
history.on
;
: AUTO.TERM
history.off
auto.term
;
if.forgotten history.off
0 [IF]
history.reset
history.on
[THEN]