version 1.14, 2006/04/02 09:18:56
|
version 1.22, 2008/11/23 20:49:37
|
Line 1
|
Line 1
|
\ ekey etc. |
\ ekey etc. |
|
|
\ Copyright (C) 1999,2002,2003,2004,2005 Free Software Foundation, Inc. |
\ Copyright (C) 1999,2002,2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
\ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
\ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 15
|
Line 15
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
|
|
\ this implementation of EKEY just translates VT100/ANSI escape |
\ this implementation of EKEY just translates VT100/ANSI escape |
Line 32
|
Line 31
|
|
|
\ The keycode names are compatible with pfe-0.9.14 |
\ The keycode names are compatible with pfe-0.9.14 |
|
|
: keycode ( "name" -- ; name execution: -- u ) |
$80000000 constant keycode-start |
create ; |
$80000016 constant keycode-limit |
|
|
|
create keycode-table keycode-limit keycode-start - cells allot |
|
|
|
: keycode ( u1 "name" -- u2 ; name execution: -- u ) |
|
dup keycode-limit keycode-start within -11 and throw |
|
dup constant |
|
dup latest keycode-table rot keycode-start - th ! |
|
1+ ; |
|
|
\ most of the keys are also in pfe, except: |
\ most of the keys are also in pfe, except: |
\ k-insert, k-delete, k11, k12, s-k11, s-k12 |
\ k-insert, k-delete, k11, k12, s-k11, s-k12 |
|
|
keycode k-left ( -- u ) \ gforth |
$40000000 constant k-shift-mask ( -- u ) \ X:ekeys |
keycode k-right ( -- u ) \ gforth |
$20000000 constant k-ctrl-mask ( -- u ) \ X:ekeys |
keycode k-up ( -- u ) \ gforth |
$10000000 constant k-alt-mask ( -- u ) \ X:ekeys |
keycode k-down ( -- u ) \ gforth |
|
keycode k-home ( -- u ) \ gforth |
: simple-fkey-string ( u1 -- c-addr u ) \ gforth |
|
\G @i{c-addr u} is the string name of the function key @i{u1}. |
|
\G Only works for simple function keys without modifier masks. |
|
\G Any @i{u1} that does not correspond to a simple function key |
|
\G currently produces an exception. |
|
dup keycode-limit keycode-start within -24 and throw |
|
keycode-table swap keycode-start - th @ name>string ; |
|
|
|
: fkey. ( u -- ) \ gforth fkey-dot |
|
\G Print a string representation for the function key @i{u}. |
|
\G @i{U} must be a function key (possibly with modifier masks), |
|
\G otherwise there may be an exception. |
|
dup [ k-shift-mask k-ctrl-mask k-alt-mask or or invert ] literal and |
|
simple-fkey-string type |
|
dup k-shift-mask and if ." k-shift-mask or" then |
|
dup k-ctrl-mask and if ." k-ctrl-mask or" then |
|
k-alt-mask and if ." k-alt-mask or" then ; |
|
|
|
keycode-start |
|
keycode k-left ( -- u ) \ X:ekeys |
|
keycode k-right ( -- u ) \ X:ekeys |
|
keycode k-up ( -- u ) \ X:ekeys |
|
keycode k-down ( -- u ) \ X:ekeys |
|
keycode k-home ( -- u ) \ X:ekeys |
\G aka Pos1 |
\G aka Pos1 |
keycode k-end ( -- u ) \ gforth |
keycode k-end ( -- u ) \ X:ekeys |
keycode k-prior ( -- u ) \ gforth |
keycode k-prior ( -- u ) \ X:ekeys |
\G aka PgUp |
\G aka PgUp |
keycode k-next ( -- u ) \ gforth |
keycode k-next ( -- u ) \ X:ekeys |
\G aka PgDn |
\G aka PgDn |
keycode k-insert ( -- u ) \ gforth |
keycode k-insert ( -- u ) \ X:ekeys |
127 constant k-delete ( -- u ) \ gforth |
keycode k-delete ( -- u ) \ X:ekeys |
\ not an escape sequence on my xterm, so use ASCII code |
\ the DEL key on my xterm, not backspace |
|
|
\ function/keypad keys |
\ function/keypad keys |
keycode k1 ( -- u ) \ gforth |
keycode k-f1 ( -- u ) \ X:ekeys |
keycode k2 ( -- u ) \ gforth |
keycode k-f2 ( -- u ) \ X:ekeys |
keycode k3 ( -- u ) \ gforth |
keycode k-f3 ( -- u ) \ X:ekeys |
keycode k4 ( -- u ) \ gforth |
keycode k-f4 ( -- u ) \ X:ekeys |
keycode k5 ( -- u ) \ gforth |
keycode k-f5 ( -- u ) \ X:ekeys |
keycode k6 ( -- u ) \ gforth |
keycode k-f6 ( -- u ) \ X:ekeys |
keycode k7 ( -- u ) \ gforth |
keycode k-f7 ( -- u ) \ X:ekeys |
keycode k8 ( -- u ) \ gforth |
keycode k-f8 ( -- u ) \ X:ekeys |
keycode k9 ( -- u ) \ gforth |
keycode k-f9 ( -- u ) \ X:ekeys |
keycode k10 ( -- u ) \ gforth |
keycode k-f10 ( -- u ) \ X:ekeys |
keycode k11 ( -- u ) \ gforth |
keycode k-f11 ( -- u ) \ X:ekeys |
keycode k12 ( -- u ) \ gforth |
keycode k-f12 ( -- u ) \ X:ekeys |
|
drop |
|
|
|
' k-f1 alias k1 ( -- u ) \ gforth-obsolete |
|
' k-f2 alias k2 ( -- u ) \ gforth-obsolete |
|
' k-f3 alias k3 ( -- u ) \ gforth-obsolete |
|
' k-f4 alias k4 ( -- u ) \ gforth-obsolete |
|
' k-f5 alias k5 ( -- u ) \ gforth-obsolete |
|
' k-f6 alias k6 ( -- u ) \ gforth-obsolete |
|
' k-f7 alias k7 ( -- u ) \ gforth-obsolete |
|
' k-f8 alias k8 ( -- u ) \ gforth-obsolete |
|
' k-f9 alias k9 ( -- u ) \ gforth-obsolete |
|
' k-f10 alias k10 ( -- u ) \ gforth-obsolete |
|
' k-f11 alias k11 ( -- u ) \ gforth-obsolete |
|
' k-f12 alias k12 ( -- u ) \ gforth-obsolete |
\ shifted fuinction keys (don't work in xterm (same as unshifted, but |
\ shifted fuinction keys (don't work in xterm (same as unshifted, but |
\ s-k1..s-k8 work in the Linux console) |
\ s-k1..s-k8 work in the Linux console) |
keycode s-k1 ( -- u ) \ gforth |
k-f1 k-shift-mask or constant s-k1 ( -- u ) \ gforth-obsolete |
keycode s-k2 ( -- u ) \ gforth |
k-f2 k-shift-mask or constant s-k2 ( -- u ) \ gforth-obsolete |
keycode s-k3 ( -- u ) \ gforth |
k-f3 k-shift-mask or constant s-k3 ( -- u ) \ gforth-obsolete |
keycode s-k4 ( -- u ) \ gforth |
k-f4 k-shift-mask or constant s-k4 ( -- u ) \ gforth-obsolete |
keycode s-k5 ( -- u ) \ gforth |
k-f5 k-shift-mask or constant s-k5 ( -- u ) \ gforth-obsolete |
keycode s-k6 ( -- u ) \ gforth |
k-f6 k-shift-mask or constant s-k6 ( -- u ) \ gforth-obsolete |
keycode s-k7 ( -- u ) \ gforth |
k-f7 k-shift-mask or constant s-k7 ( -- u ) \ gforth-obsolete |
keycode s-k8 ( -- u ) \ gforth |
k-f8 k-shift-mask or constant s-k8 ( -- u ) \ gforth-obsolete |
keycode s-k9 ( -- u ) \ gforth |
k-f9 k-shift-mask or constant s-k9 ( -- u ) \ gforth-obsolete |
keycode s-k10 ( -- u ) \ gforth |
k-f10 k-shift-mask or constant s-k10 ( -- u ) \ gforth-obsolete |
keycode s-k11 ( -- u ) \ gforth |
k-f11 k-shift-mask or constant s-k11 ( -- u ) \ gforth-obsolete |
keycode s-k12 ( -- u ) \ gforth |
k-f12 k-shift-mask or constant s-k12 ( -- u ) \ gforth-obsolete |
|
|
\ helper word |
\ helper word |
\ print a key sequence: |
\ print a key sequence: |
\ : key-sequence ( -- ) |
0 [IF] |
\ key begin |
: key-sequence ( -- ) |
\ cr dup . emit |
key begin |
\ key? while |
cr dup . emit |
\ key |
key? while |
\ repeat ; |
key |
|
repeat ; |
|
|
|
: key-sequences ( -- ) |
|
begin |
|
key-sequence cr |
|
again ; |
|
[THEN] |
|
|
create key-buffer 8 chars allot |
create key-buffer 8 chars allot |
2variable key-buffered key-buffer 0 key-buffered 2! |
2variable key-buffered key-buffer 0 key-buffered 2! |
Line 100 create key-buffer 8 chars allot
|
Line 151 create key-buffer 8 chars allot
|
:noname ( -- c ) |
:noname ( -- c ) |
\ buffered key |
\ buffered key |
key-buffered 2@ dup if |
key-buffered 2@ dup if |
1- 2dup key-buffered 2! |
1- 2dup key-buffered 2! |
chars + c@ |
chars + c@ |
else |
else |
2drop defers key |
2drop defers key |
then ; |
then ; |
is key |
is key |
|
|
Line 112 is key
|
Line 163 is key
|
|
|
: unkeys ( addr u -- ) |
: unkeys ( addr u -- ) |
-1 swap 1- -do |
-1 swap 1- -do |
dup i chars + c@ unkey |
dup i chars + c@ unkey |
1 -loop |
1 -loop |
drop ; |
drop ; |
|
|
:noname ( -- flag ) |
:noname ( -- flag ) |
Line 124 table constant esc-sequences \ and prefi
|
Line 175 table constant esc-sequences \ and prefi
|
|
|
create ekey-buffer 8 chars allot |
create ekey-buffer 8 chars allot |
2variable ekey-buffered |
2variable ekey-buffered |
|
|
[IFUNDEF] #esc 27 Constant #esc [THEN] |
[IFUNDEF] #esc 27 Constant #esc [THEN] |
|
|
: esc-prefix ( -- u ) |
: esc-prefix ( -- u ) |
key? if |
key? if |
key ekey-buffered char-append-buffer |
key ekey-buffered char-append-buffer |
ekey-buffered 2@ esc-sequences search-wordlist |
ekey-buffered 2@ esc-sequences search-wordlist |
if |
if |
execute exit |
execute exit |
endif |
endif |
endif |
endif |
ekey-buffered 2@ unkeys #esc ; |
ekey-buffered 2@ unkeys #esc ; |
|
|
: esc-sequence ( xt addr u -- ; name execution: -- u ) recursive |
: esc-sequence ( u1 addr u -- ; name execution: -- u2 ) recursive |
\ define key "name" and all prefixes |
\ define escape sequence addr u (=name) to have value u1; if u1=0, |
|
\ addr u is a prefix of some other sequence (with key code u2); |
|
\ also, define all prefixes of addr u if necessary. |
2dup 1- dup |
2dup 1- dup |
if |
if |
2dup esc-sequences search-wordlist |
2dup esc-sequences search-wordlist |
if |
if |
drop 2drop |
drop 2drop |
else |
else |
['] esc-prefix -rot esc-sequence |
0 -rot esc-sequence \ define the prefixes |
then |
then |
|
else |
|
2drop |
|
then ( u1 addr u ) |
|
nextname dup if ( u1 ) |
|
constant \ full sequence for a key |
else |
else |
2drop |
drop ['] esc-prefix alias |
then ( xt addr u ) |
endif ; |
nextname alias ; |
|
|
|
\ nac02dec1999 exclude the escape sequences if we are using crossdoc.fs to generate |
\ nac02dec1999 exclude the escape sequences if we are using crossdoc.fs to generate |
\ a documentation file. Do this because key sequences [ and OR here clash with |
\ a documentation file. Do this because key sequences [ and OR here clash with |
Line 159 create ekey-buffer 8 chars allot
|
Line 215 create ekey-buffer 8 chars allot
|
get-current esc-sequences set-current |
get-current esc-sequences set-current |
|
|
\ esc sequences (derived by using key-sequence in an xterm) |
\ esc sequences (derived by using key-sequence in an xterm) |
|
k-left s" [D" esc-sequence |
' k-left s" [D" esc-sequence |
k-right s" [C" esc-sequence |
' k-right s" [C" esc-sequence |
k-up s" [A" esc-sequence |
' k-up s" [A" esc-sequence |
k-down s" [B" esc-sequence |
' k-down s" [B" esc-sequence |
k-home s" [H" esc-sequence |
' k-home s" [H" esc-sequence |
k-end s" [F" esc-sequence |
' k-end s" [F" esc-sequence |
k-prior s" [5~" esc-sequence |
' k-prior s" [5~" esc-sequence |
k-next s" [6~" esc-sequence |
' k-next s" [6~" esc-sequence |
k-insert s" [2~" esc-sequence |
' k-insert s" [2~" esc-sequence |
k-delete s" [3~" esc-sequence |
|
|
' k1 s" OP" esc-sequence |
k-left k-shift-mask or s" [1;2D" esc-sequence |
' k2 s" OQ" esc-sequence |
k-right k-shift-mask or s" [1;2C" esc-sequence |
' k3 s" OR" esc-sequence |
k-up k-shift-mask or s" [1;2A" esc-sequence |
' k4 s" OS" esc-sequence |
k-down k-shift-mask or s" [1;2B" esc-sequence |
' k5 s" [15~" esc-sequence |
k-home k-shift-mask or s" [1;2H" esc-sequence |
' k6 s" [17~" esc-sequence |
k-end k-shift-mask or s" [1;2F" esc-sequence |
' k7 s" [18~" esc-sequence |
k-prior k-shift-mask or s" [5;2~" esc-sequence |
' k8 s" [19~" esc-sequence |
k-next k-shift-mask or s" [6;2~" esc-sequence |
' k9 s" [20~" esc-sequence |
k-insert k-shift-mask or s" [2;2~" esc-sequence |
' k10 s" [21~" esc-sequence |
k-delete k-shift-mask or s" [3;2~" esc-sequence |
' k11 s" [23~" esc-sequence |
|
' k12 s" [24~" esc-sequence |
k-left k-ctrl-mask or s" [1;5D" esc-sequence |
|
k-right k-ctrl-mask or s" [1;5C" esc-sequence |
|
k-up k-ctrl-mask or s" [1;5A" esc-sequence |
|
k-down k-ctrl-mask or s" [1;5B" esc-sequence |
|
k-home k-ctrl-mask or s" [1;5H" esc-sequence |
|
k-end k-ctrl-mask or s" [1;5F" esc-sequence |
|
k-prior k-ctrl-mask or s" [5;5~" esc-sequence |
|
k-next k-ctrl-mask or s" [6;5~" esc-sequence |
|
k-insert k-ctrl-mask or s" [2;5~" esc-sequence |
|
k-delete k-ctrl-mask or s" [3;5~" esc-sequence |
|
|
|
k-left k-alt-mask or s" [1;3D" esc-sequence |
|
k-right k-alt-mask or s" [1;3C" esc-sequence |
|
k-up k-alt-mask or s" [1;3A" esc-sequence |
|
k-down k-alt-mask or s" [1;3B" esc-sequence |
|
k-home k-alt-mask or s" [1;3H" esc-sequence |
|
k-end k-alt-mask or s" [1;3F" esc-sequence |
|
k-prior k-alt-mask or s" [5;3~" esc-sequence |
|
k-next k-alt-mask or s" [6;3~" esc-sequence |
|
k-insert k-alt-mask or s" [2;3~" esc-sequence |
|
k-delete k-alt-mask or s" [3;3~" esc-sequence |
|
|
|
k1 s" OP" esc-sequence |
|
k2 s" OQ" esc-sequence |
|
k3 s" OR" esc-sequence |
|
k4 s" OS" esc-sequence |
|
k5 s" [15~" esc-sequence |
|
k6 s" [17~" esc-sequence |
|
k7 s" [18~" esc-sequence |
|
k8 s" [19~" esc-sequence |
|
k9 s" [20~" esc-sequence |
|
k10 s" [21~" esc-sequence |
|
k11 s" [23~" esc-sequence |
|
k12 s" [24~" esc-sequence |
|
|
|
s-k1 s" [1;2P" esc-sequence |
|
s-k2 s" [1;2Q" esc-sequence |
|
s-k3 s" [1;2R" esc-sequence |
|
s-k4 s" [1;2S" esc-sequence |
|
s-k5 s" [15;2~" esc-sequence |
|
s-k6 s" [17;2~" esc-sequence |
|
s-k7 s" [18;2~" esc-sequence |
|
s-k8 s" [19;2~" esc-sequence |
|
s-k9 s" [20;2~" esc-sequence |
|
s-k10 s" [21;2~" esc-sequence |
|
s-k11 s" [23;2~" esc-sequence |
|
s-k12 s" [24;2~" esc-sequence |
|
|
|
k-f1 k-ctrl-mask or s" [1;5P" esc-sequence |
|
k-f2 k-ctrl-mask or s" [1;5Q" esc-sequence |
|
k-f3 k-ctrl-mask or s" [1;5R" esc-sequence |
|
k-f4 k-ctrl-mask or s" [1;5S" esc-sequence |
|
k-f5 k-ctrl-mask or s" [15;5~" esc-sequence |
|
k-f6 k-ctrl-mask or s" [17;5~" esc-sequence |
|
k-f7 k-ctrl-mask or s" [18;5~" esc-sequence |
|
k-f8 k-ctrl-mask or s" [19;5~" esc-sequence |
|
k-f9 k-ctrl-mask or s" [20;5~" esc-sequence |
|
k-f10 k-ctrl-mask or s" [21;5~" esc-sequence |
|
k-f11 k-ctrl-mask or s" [23;5~" esc-sequence |
|
k-f12 k-ctrl-mask or s" [24;5~" esc-sequence |
|
|
|
k-f1 k-alt-mask or s" [1;3P" esc-sequence |
|
k-f2 k-alt-mask or s" [1;3Q" esc-sequence |
|
k-f3 k-alt-mask or s" [1;3R" esc-sequence |
|
k-f4 k-alt-mask or s" [1;3S" esc-sequence |
|
k-f5 k-alt-mask or s" [15;3~" esc-sequence |
|
k-f6 k-alt-mask or s" [17;3~" esc-sequence |
|
k-f7 k-alt-mask or s" [18;3~" esc-sequence |
|
k-f8 k-alt-mask or s" [19;3~" esc-sequence |
|
k-f9 k-alt-mask or s" [20;3~" esc-sequence |
|
k-f10 k-alt-mask or s" [21;3~" esc-sequence |
|
k-f11 k-alt-mask or s" [23;3~" esc-sequence |
|
k-f12 k-alt-mask or s" [24;3~" esc-sequence |
|
|
\ esc sequences from Linux console: |
\ esc sequences from Linux console: |
|
|
' k1 s" [[A" esc-sequence |
k1 s" [[A" esc-sequence |
' k2 s" [[B" esc-sequence |
k2 s" [[B" esc-sequence |
' k3 s" [[C" esc-sequence |
k3 s" [[C" esc-sequence |
' k4 s" [[D" esc-sequence |
k4 s" [[D" esc-sequence |
' k5 s" [[E" esc-sequence |
k5 s" [[E" esc-sequence |
' k-delete s" [3~" esc-sequence |
\ k-delete s" [3~" esc-sequence \ duplicate from above |
' k-home s" [1~" esc-sequence |
k-home s" [1~" esc-sequence |
' k-end s" [4~" esc-sequence |
k-end s" [4~" esc-sequence |
|
|
' s-k1 s" [25~" esc-sequence |
s-k1 s" [25~" esc-sequence |
' s-k2 s" [26~" esc-sequence |
s-k2 s" [26~" esc-sequence |
' s-k3 s" [28~" esc-sequence |
s-k3 s" [28~" esc-sequence |
' s-k4 s" [29~" esc-sequence |
s-k4 s" [29~" esc-sequence |
' s-k5 s" [31~" esc-sequence |
s-k5 s" [31~" esc-sequence |
' s-k6 s" [32~" esc-sequence |
s-k6 s" [32~" esc-sequence |
' s-k7 s" [33~" esc-sequence |
s-k7 s" [33~" esc-sequence |
' s-k8 s" [34~" esc-sequence |
s-k8 s" [34~" esc-sequence |
|
|
set-current |
set-current |
[ENDIF] |
[ENDIF] |
Line 213 set-current
|
Line 341 set-current
|
\G Receive a keyboard event @var{u} (encoding implementation-defined). |
\G Receive a keyboard event @var{u} (encoding implementation-defined). |
key dup #esc = |
key dup #esc = |
if |
if |
drop clear-ekey-buffer |
drop clear-ekey-buffer |
esc-prefix |
esc-prefix |
then ; |
then |
|
[IFDEF] max-single-byte |
|
dup max-single-byte u>= if |
|
clear-ekey-buffer |
|
ekey-buffered char-append-buffer |
|
ekey-buffer 1 u8addrlen 1 +do |
|
key? 0= ?leave |
|
key ekey-buffered char-append-buffer |
|
loop |
|
ekey-buffer 1 u8addrlen ekey-buffered @ = if |
|
ekey-buffer xc@+ nip else |
|
ekey-buffered 2@ unkeys key then |
|
then |
|
[THEN] |
|
; |
|
|
|
[IFDEF] max-single-byte |
|
: ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char |
|
\G Convert keyboard event @var{u} into character @code{c} if possible. |
|
dup max-single-byte u< ; \ k-left must be first! |
|
: ekey>xchar ( u -- u false | xc true ) \ xchar-ext e-key-to-xchar |
|
\G Convert keyboard event @var{u} into xchar @code{xc} if possible. |
|
dup k-left u< ; \ k-left must be first! |
|
: ekey>fkey ( u1 -- u2 f ) \ X:ekeys |
|
\G If u1 is a keyboard event in the special key set, convert |
|
\G keyboard event @var{u1} into key id @var{u2} and return true; |
|
\G otherwise return @var{u1} and false. |
|
ekey>xchar 0= ; |
|
[ELSE] |
: ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char |
: ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char |
\G Convert keyboard event @var{u} into character @code{c} if possible. |
\G Convert keyboard event @var{u} into character @code{c} if possible. |
dup 256 u< ; |
dup k-left u< ; \ k-left must be first! |
|
: ekey>fkey ( u1 -- u2 f ) \ X:ekeys |
|
\G If u1 is a keyboard event in the special key set, convert |
|
\G keyboard event @var{u1} into key id @var{u2} and return true; |
|
\G otherwise return @var{u1} and false. |
|
ekey>char 0= ; |
|
[THEN] |
|
|
' key? alias ekey? ( -- flag ) \ facility-ext e-key-question |
' key? alias ekey? ( -- flag ) \ facility-ext e-key-question |
\G True if a keyboard event is available. |
\G True if a keyboard event is available. |
Line 227 set-current
|
Line 388 set-current
|
\ : esc? ( -- flag ) recursive |
\ : esc? ( -- flag ) recursive |
\ key? 0= |
\ key? 0= |
\ if |
\ if |
\ false exit |
\ false exit |
\ then |
\ then |
\ key ekey-buffered char-append-buffer |
\ key ekey-buffered char-append-buffer |
\ ekey-buffered 2@ esc-sequences search-wordlist |
\ ekey-buffered 2@ esc-sequences search-wordlist |
\ if |
\ if |
\ ['] esc-prefix = |
\ ['] esc-prefix = |
\ if |
\ if |
\ esc? exit |
\ esc? exit |
\ then |
\ then |
\ then |
\ then |
\ true ; |
\ true ; |
|
|
Line 244 set-current
|
Line 405 set-current
|
\ \G @code{ekey} to receive the event), @code{false} otherwise. |
\ \G @code{ekey} to receive the event), @code{false} otherwise. |
\ key? |
\ key? |
\ if |
\ if |
\ key dup #esc = |
\ key dup #esc = |
\ if |
\ if |
\ clear-ekey-buffer esc? |
\ clear-ekey-buffer esc? |
\ ekey-buffered 2@ unkeys |
\ ekey-buffered 2@ unkeys |
\ else |
\ else |
\ true |
\ true |
\ then |
\ then |
\ swap unkey |
\ swap unkey |
\ else |
\ else |
\ false |
\ false |
\ then ; |
\ then ; |
|
|
\ : test-ekey? |
0 [if] |
\ begin |
: test-ekey? |
\ begin |
begin |
\ begin |
begin |
\ key? until |
begin |
\ ekey? until |
key? until |
\ .s ekey .s drop |
ekey? until |
\ again ; |
.s ekey .s drop |
|
again ; |
\ test-ekey? |
\ test-ekey? |
|
[then] |
|
|