version 1.19, 2007/12/31 18:40:24
|
version 1.25, 2009/01/21 18:08:11
|
Line 1
|
Line 1
|
\ ekey etc. |
\ ekey etc. |
|
|
\ Copyright (C) 1999,2002,2003,2004,2005,2006,2007 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. |
|
|
Line 31
|
Line 31
|
|
|
\ The keycode names are compatible with pfe-0.9.14 |
\ The keycode names are compatible with pfe-0.9.14 |
|
|
|
$80000000 constant keycode-start |
|
$80000016 constant keycode-limit |
|
|
|
create keycode-table keycode-limit keycode-start - cells allot |
|
|
: keycode ( u1 "name" -- u2 ; name execution: -- u ) |
: keycode ( u1 "name" -- u2 ; name execution: -- u ) |
dup constant 1+ ; |
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 |
Line 41 $40000000 constant k-shift-mask ( -- u )
|
Line 49 $40000000 constant k-shift-mask ( -- u )
|
$20000000 constant k-ctrl-mask ( -- u ) \ X:ekeys |
$20000000 constant k-ctrl-mask ( -- u ) \ X:ekeys |
$10000000 constant k-alt-mask ( -- u ) \ X:ekeys |
$10000000 constant k-alt-mask ( -- u ) \ X:ekeys |
|
|
$80000000 |
: 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-left ( -- u ) \ X:ekeys |
keycode k-right ( -- u ) \ X:ekeys |
keycode k-right ( -- u ) \ X:ekeys |
keycode k-up ( -- u ) \ X:ekeys |
keycode k-up ( -- u ) \ X:ekeys |
Line 149 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 ) |
Line 306 s-k6 s" [32~" esc-sequence
|
Line 331 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 |
|
|
|
\ esc sequences for MacOS X iterm <e7a7c785-3bea-408b-94e9-4b59b008546f@x16g2000prn.googlegroups.com> |
|
k-left s" OD" esc-sequence |
|
k-right s" OC" esc-sequence |
|
k-up s" OA" esc-sequence |
|
k-down s" OB" esc-sequence |
|
|
set-current |
set-current |
[ENDIF] |
[ENDIF] |
|
|
: clear-ekey-buffer ( -- ) |
: clear-ekey-buffer ( -- ) |
ekey-buffer 0 ekey-buffered 2! ; |
ekey-buffer 0 ekey-buffered 2! ; |
|
|
|
[IFDEF] max-single-byte |
|
: read-xkey ( key -- flag ) |
|
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 @ = ; |
|
: get-xkey ( u -- xc ) |
|
dup max-single-byte u>= if |
|
read-xkey if |
|
ekey-buffer xc@+ nip else |
|
ekey-buffered 2@ unkeys key then |
|
then ; |
|
: xkey? ( -- flag ) |
|
key? dup if |
|
drop key read-xkey ekey-buffered 2@ unkeys |
|
clear-ekey-buffer then ; |
|
[THEN] |
|
|
: ekey ( -- u ) \ facility-ext e-key |
: ekey ( -- u ) \ facility-ext e-key |
\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 exit |
then ; |
then |
|
[IFDEF] max-single-byte |
|
get-xkey |
|
[THEN] |
|
; |
|
|
|
[IFDEF] max-single-byte |
: 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 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! |
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= ; |
|
|
|
' xkey? alias ekey? ( -- flag ) \ facility-ext e-key-question |
|
[ELSE] |
|
: 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 k-left u< ; \ k-left must be first! |
: ekey>fkey ( u1 -- u2 f ) \ X:ekeys |
: ekey>fkey ( u1 -- u2 f ) \ X:ekeys |
\G If u1 is a keyboard event in the special key set, convert |
\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 keyboard event @var{u1} into key id @var{u2} and return true; |
Line 331 set-current
|
Line 401 set-current
|
ekey>char 0= ; |
ekey>char 0= ; |
|
|
' key? alias ekey? ( -- flag ) \ facility-ext e-key-question |
' key? alias ekey? ( -- flag ) \ facility-ext e-key-question |
|
[THEN] |
|
|
\G True if a keyboard event is available. |
\G True if a keyboard event is available. |
|
|
\ : esc? ( -- flag ) recursive |
\ : esc? ( -- flag ) recursive |