| \ command line edit and history support 16oct94py |
\ command line edit and history support 16oct94py |
| |
|
| \ Copyright (C) 1995,2000 Free Software Foundation, Inc. |
\ Copyright (C) 1995,2000,2003,2004 Free Software Foundation, Inc. |
| |
|
| \ This file is part of Gforth. |
\ This file is part of Gforth. |
| |
|
| |
|
| : bindkey ( xt key -- ) cells ctrlkeys + ! ; |
: bindkey ( xt key -- ) cells ctrlkeys + ! ; |
| |
|
| ' forw ctrl F bindkey |
|
| ' back ctrl B bindkey |
|
| ' ?del ctrl H bindkey |
|
| ' eof ctrl D bindkey |
|
| ' <del> ctrl X bindkey |
|
| |
|
| ' (ins) IS insert-char |
|
| |
|
| \ history support 16oct94py |
\ history support 16oct94py |
| |
|
| 0 Value history \ history file fid |
0 Value history \ history file fid |
| : clear-tib ( max span addr pos -- max 0 addr 0 false ) |
: clear-tib ( max span addr pos -- max 0 addr 0 false ) |
| clear-line 0 tuck dup ; |
clear-line 0 tuck dup ; |
| |
|
| : hist-pos ( -- ud ) history file-position throw ; |
: hist-pos ( -- ud ) history file-position drop ( throw ) ; |
| : hist-setpos ( ud -- ) history reposition-file throw ; |
: hist-setpos ( ud -- ) history reposition-file drop ( throw ) ; |
| |
|
| : get-line ( addr len -- len' flag ) |
: get-line ( addr len -- len' flag ) |
| swap history read-line throw ; |
swap history read-line throw ; |
| |
|
| : (enter) ( max span addr pos1 -- max span addr pos2 true ) |
: (enter) ( max span addr pos1 -- max span addr pos2 true ) |
| >r end^ 2@ hist-setpos |
>r end^ 2@ hist-setpos |
| 2dup swap history write-line throw |
2dup swap history write-line drop ( throw ) \ don't worry about errors |
| hist-pos 2dup backward^ 2! end^ 2! |
hist-pos 2dup backward^ 2! end^ 2! |
| r> (ret) ; |
r> (ret) ; |
| |
|
| REPEAT |
REPEAT |
| drop r> ; |
drop r> ; |
| |
|
| |
: prefix-off ( -- ) 0 0 prefix-found 2! ; |
| |
|
| : prefix-string ( addr len nfa -- addr' len' ) |
: prefix-string ( addr len nfa -- addr' len' ) |
| dup prefix-found ! ?dup |
dup prefix-found ! ?dup |
| IF |
IF |
| name>string rot /string rot drop |
name>string rot /string rot drop |
| dup 1+ prefix-found cell+ ! |
dup 1+ prefix-found cell+ ! |
| ELSE |
ELSE |
| 2drop s" " prefix-found cell+ off |
2drop s" " prefix-off |
| THEN ; |
THEN ; |
| |
|
| : search-prefix ( addr1 len1 -- addr2 len2 ) |
: search-prefix ( addr1 len1 -- addr2 len2 ) |
| prefix-found @ IF bl (ins) THEN 0 ; |
prefix-found @ IF bl (ins) THEN 0 ; |
| |
|
| : kill-prefix ( key -- key ) |
: kill-prefix ( key -- key ) |
| dup #tab <> IF 0 0 prefix-found 2! THEN ; |
dup #tab <> IF prefix-off THEN ; |
| |
|
| |
[IFUNDEF] everyline defer everyline [THEN] |
| |
|
| |
: 8-bit-io ( -- ) |
| |
['] forw ctrl F bindkey |
| |
['] back ctrl B bindkey |
| |
['] ?del ctrl H bindkey |
| |
['] eof ctrl D bindkey |
| |
['] <del> ctrl X bindkey |
| |
['] next-line ctrl N bindkey |
| |
['] prev-line ctrl P bindkey |
| |
['] clear-tib ctrl K bindkey |
| |
['] first-pos ctrl A bindkey |
| |
['] end-pos ctrl E bindkey |
| |
['] (enter) #lf bindkey |
| |
['] (enter) #cr bindkey |
| |
['] tab-expand #tab bindkey |
| |
['] (ins) IS insert-char |
| |
['] kill-prefix IS everychar |
| |
['] noop IS everyline |
| |
[ action-of key ] Literal IS key |
| |
[ action-of emit ] Literal IS emit ; |
| |
|
| |
\ UTF-8 support |
| |
|
| |
require utf-8.fs |
| |
|
| |
: utf-8-cold ( -- ) |
| |
s" LANG" getenv s" .UTF-8" search nip nip |
| |
IF utf-8-io ELSE 8-bit-io THEN ; |
| |
|
| ' kill-prefix IS everychar |
' utf-8-cold INIT8 chained |
| |
|
| ' next-line ctrl N bindkey |
utf-8-cold |
| ' prev-line ctrl P bindkey |
|
| ' clear-tib ctrl K bindkey |
|
| ' first-pos ctrl A bindkey |
|
| ' end-pos ctrl E bindkey |
|
| ' (enter) #lf bindkey |
|
| ' (enter) #cr bindkey |
|
| ' tab-expand #tab bindkey |
|
| |
|
| \ initializing history |
\ initializing history |
| |
|
