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