\ Copyright 1988 Phil Burk
\ Revised 2001 for pForth
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 )
\ 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
\ 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 )
variable KH-LOOK ( cursor offset into history, point to 1st count byte of line )
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)
kh-history dup r@ + ( source dest )
kh_history_size r> - 0 max move
: KH.NEWEST.LINE ( -- addr count , most recent line )
: KH.REWIND ( -- , move cursor to most recent line )
: KH.CURRENT.ADDR ( -- $addr , count byte of current line )
: KH.CURRENT.LINE ( -- 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.NUM ( -- # , number of current line )
: KH.ADDR++ ( $addr -- $addr' , convert one kh to previous )
: 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.ADD.LINE ( addr count -- )
IF ." KH.ADD.LINE - Too big for history!" 2drop
\ Compare with most recent line.
\ Set look pointer to point to first count byte of last string.
\ 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 )
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 )
: 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?
kh.current.addr kh.addr++ -> addr'
addr' kh-end U< \ within bounds?
addr' c@ \ older line has chars?
addr' kh-history - kh-look !
: KH.FORWARD.LINE ( -- cantmove? )
IF kh.current.addr kh.addr--
: KH.OLDEST.LINE ( -- addr count | 0, oldest in buffer )
: KH.FIND.LINE ( line# -- $addr )
BEGIN kh.current.num over -
IF ." Line not in History Buffer!" cr drop 0 exit
: KH-BUFFER ( -- buffer )
: KH.RETURN ( -- , move to beginning of line )
: KH.REPLACE.LINE ( addr count -- , make this the current line of input )
2dup kh-buffer swap cmove
: KH.GET.MATCH ( -- , search for line with same start )
kh-match-span @ 0= ( keep length for multiple matches )
IF kh-span @ kh-match-span !
kh-buffer kh-match-span @ text=
IF kh.current.line kh.replace.line
kh-span @ kh-cursor @ - dup 0>
: KH.GET.OLDER ( -- , goto previous line )
kh.current.line kh.replace.line
: KH.GET.NEWER ( -- , next line )
: KH.CLEAR.LINE ( -- , rewind history scrolling and clear line )
: KH.REFRESH ( -- , redraw current line as is )
: KH.BACKSPACE ( -- , backspace character from buffer and screen )
kh-cursor @ ?dup ( past 0? )
kh-buffer kh-cursor @ + ( -- source )
dup 1- ( -- source dest )
kh-span @ kh-cursor @ - cmove
: KH.DELETE ( -- , forward delete )
kh-cursor @ kh-span @ < ( before end )
kh-buffer kh-cursor @ + 1+ ( -- source )
dup 1- ( -- source dest )
kh-span @ kh-cursor @ - 0 max cmove
: KH.HANDLE.WINDOWS.KEY ( char -- , handle fkeys or arrows used by Windows ANSI.SYS )
$ 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
$ 91 OF kh.clear.line ENDOF
$ 74 OF kh.far.right ENDOF
$ 73 OF kh.far.left ENDOF
: KH.HANDLE.ANSI.KEY ( char -- , handle fkeys or arrows used by ANSI terminal )
$ 41 OF kh.get.older ENDOF
$ 42 OF kh.get.newer ENDOF
$ 43 OF kh.go.right ENDOF
: KH.SPECIAL.KEY ( char -- true | false , handle fkeys or arrows, true if handled )
$ E0 OF key kh.handle.windows.key
key dup $ 4F = \ for TELNET
$ 5B = OR \ for regular ANSI terminals
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
: KH.SMART.KEY ( -- char )
: KH.INSCHAR { charc | repaint -- }
kh-buffer kh-cursor @ + ( -- source )
dup 1+ ( -- source dest )
kh-span @ kh-cursor @ - cmove>
\ write character to buffer
charc kh-buffer kh-cursor @ + c!
: EOL? ( char -- flag , true if an end of line character )
kh-span @ kh-cursor @ - ?dup
IF tio.forwards ( move to end of line )
: KH.ACCEPT ( addr max -- numChars )
IF kh-buffer kh-span @ kh.add.line
: HISTORY# ( -- , dump history buffer with numbers)
BEGIN kh.current.num 3 .r ." ) " type ?pause cr
: HISTORY ( -- , dump history buffer )
: XX ( line# -- , execute line x of history )
: HISTORY.RESET ( -- , clear history tables )
kh-history kh_history_size erase
: HISTORY.ON ( -- , install history vectors )
what's accept ['] (accept) =
IF ['] kh.accept is accept
: HISTORY.OFF ( -- , uninstall history vectors )
what's accept ['] kh.accept =
IF ['] (accept) is accept