version 1.32, 2003/09/01 22:12:46
|
version 1.35, 2004/12/27 20:05:53
|
Line 48 interpret/compile: ctrl ( "<char>" -- c
|
Line 48 interpret/compile: ctrl ( "<char>" -- c
|
|
|
: 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 |
Line 193 Create prefix-found 0 , 0 ,
|
Line 185 Create prefix-found 0 , 0 ,
|
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 ) |
Line 226 Create prefix-found 0 , 0 ,
|
Line 220 Create prefix-found 0 , 0 ,
|
: kill-prefix ( key -- key ) |
: kill-prefix ( key -- key ) |
dup #tab <> IF 0 0 prefix-found 2! THEN ; |
dup #tab <> IF 0 0 prefix-found 2! THEN ; |
|
|
' kill-prefix IS everychar |
[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 |
|
|
|
include utf-8.fs |
|
|
|
: utf-8-cold ( -- ) |
|
s" LANG" getenv s" .UTF-8" search nip nip |
|
IF utf-8-io ELSE 8-bit-io THEN ; |
|
|
|
' 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 |
|
|