--- gforth/history.fs 1995/09/06 21:00:17 1.7 +++ gforth/history.fs 1996/08/21 14:58:41 1.12 @@ -1,4 +1,60 @@ -\ History file support 16oct94py +\ command line edit and history support 16oct94py + +\ Copyright (C) 1995 Free Software Foundation, Inc. + +\ This file is part of Gforth. + +\ Gforth is free software; you can redistribute it and/or +\ modify it under the terms of the GNU General Public License +\ as published by the Free Software Foundation; either version 2 +\ of the License, or (at your option) any later version. + +\ This program is distributed in the hope that it will be useful, +\ but WITHOUT ANY WARRANTY; without even the implied warranty of +\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +\ GNU General Public License for more details. + +\ You should have received a copy of the GNU General Public License +\ along with this program; if not, write to the Free Software +\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +:noname + char [char] @ - ; +:noname + char [char] @ - postpone Literal ; +interpret/compile: ctrl ( "" -- ctrl-code ) + +\ command line editing 16oct94py + +: >string ( span addr pos1 -- span addr pos1 addr2 len ) + over 3 pick 2 pick chars /string ; +: type-rest ( span addr pos1 -- span addr pos1 back ) + >string tuck type ; +: (del) ( max span addr pos1 -- max span addr pos2 ) + 1- >string over 1+ -rot move + rot 1- -rot #bs emit type-rest bl emit 1+ backspaces ; +: (ins) ( max span addr pos1 char -- max span addr pos2 ) + >r >string over 1+ swap move 2dup chars + r> swap c! + rot 1+ -rot type-rest 1- backspaces 1+ ; +: ?del ( max span addr pos1 -- max span addr pos2 0 ) + dup IF (del) THEN 0 ; +: (ret) type-rest drop true space ; +: back dup IF 1- #bs emit ELSE #bell emit THEN 0 ; +: forw 2 pick over <> IF 2dup + c@ emit 1+ ELSE #bell emit THEN 0 ; +: eof 2 pick over or 0= IF + bye + ELSE 2 pick over <> + IF forw drop (del) ELSE #bell emit THEN 0 + THEN ; + +' forw ctrl F cells ctrlkeys + ! +' back ctrl B cells ctrlkeys + ! +' ?del ctrl H cells ctrlkeys + ! +' eof ctrl D cells ctrlkeys + ! + +' (ins) IS insert-char + +\ history support 16oct94py 0 Value history @@ -54,9 +110,6 @@ s" ~/.gforth-history" get-history REPEAT 2drop THEN tuck 2dup type 0 ; -: ctrl ( "" -- ctrl-code ) - char [char] @ - postpone Literal ; immediate - Create lfpad #lf c, : (enter) ( max span addr pos1 -- max span addr pos2 true ) @@ -79,26 +132,46 @@ Create lfpad #lf c, Create prefix-found 0 , 0 , : word-lex ( nfa1 nfa2 -- -1/0/1 ) - dup 0= IF 2drop 1 EXIT THEN - cell+ >r cell+ count $1F and - dup r@ c@ $1F and = - IF r> char+ capscomp 0<= EXIT THEN - nip r> c@ $1F and < ; - -: search-voc ( addr len nfa1 nfa2 -- addr len nfa3 ) >r - BEGIN dup WHILE >r dup r@ cell+ c@ $1F and <= - IF 2dup r@ cell+ char+ capscomp 0= - IF r> dup r@ word-lex - IF dup prefix-found @ word-lex - 0>= IF rdrop dup >r THEN - THEN >r + dup 0= + IF + 2drop 1 EXIT + THEN + name>string 2>r name>string + dup r@ = + IF + rdrop r> capscomp 0<= EXIT + THEN + r> < + nip rdrop ; + +: search-voc ( addr len nfa1 nfa2 -- addr len nfa3 ) + >r + BEGIN + dup + WHILE + >r dup r@ name>string nip <= + IF + 2dup r@ name>string drop capscomp 0= + IF + r> dup r@ word-lex + IF + dup prefix-found @ word-lex + 0>= + IF + rdrop dup >r + THEN + THEN + >r THEN - THEN r> @ - REPEAT drop r> ; + THEN + r> @ + REPEAT + drop r> ; : prefix-string ( addr len nfa -- addr' len' ) dup prefix-found ! ?dup - IF cell+ count $1F and rot /string rot drop + IF + name>string rot /string rot drop dup 1+ prefix-found cell+ ! ELSE 2drop s" " prefix-found cell+ off