version 1.4, 2000/12/28 11:33:02
|
version 1.10, 2004/12/28 21:09:46
|
Line 1
|
Line 1
|
\ ekey etc. |
\ ekey etc. |
|
|
\ Copyright (C) 1999 Free Software Foundation, Inc. |
\ Copyright (C) 1999,2002,2003 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 58 keycode k9
|
Line 58 keycode k9
|
keycode k10 |
keycode k10 |
keycode k11 \ not in pfe |
keycode k11 \ not in pfe |
keycode k12 \ not in pfe |
keycode k12 \ not in pfe |
\ shifted function/keypad keys have the same key sequences (in xterm) |
\ shifted fuinction keys (don't work in xterm (same as unshifted, but |
\ and pfe gives the same keycodes; so what are these keycodes good for? |
\ s-k1..s-k8 work in the Linux console) |
\ keycode s-k1 |
keycode s-k1 |
\ keycode s-k2 |
keycode s-k2 |
\ keycode s-k3 |
keycode s-k3 |
\ keycode s-k4 |
keycode s-k4 |
\ keycode s-k5 |
keycode s-k5 |
\ keycode s-k6 |
keycode s-k6 |
\ keycode s-k7 |
keycode s-k7 |
\ keycode s-k8 |
keycode s-k8 |
\ keycode s-k9 |
keycode s-k9 |
\ keycode s-k10 |
keycode s-k10 |
\ keycode s-k11 \ not in pfe |
keycode s-k11 \ not in pfe |
\ keycode s-k12 \ not in pfe |
keycode s-k12 \ not in pfe |
|
|
\ helper word |
\ helper word |
\ print a key sequence: |
\ print a key sequence: |
Line 117 table constant esc-sequences \ and prefi
|
Line 117 table constant esc-sequences \ and prefi
|
create ekey-buffer 8 chars allot |
create ekey-buffer 8 chars allot |
2variable ekey-buffered |
2variable ekey-buffered |
|
|
27 constant #esc |
[IFUNDEF] #esc 27 Constant #esc [THEN] |
|
|
: esc-prefix ( -- u ) |
: esc-prefix ( -- u ) |
key ekey-buffered char-append-buffer |
key? if |
ekey-buffered 2@ esc-sequences search-wordlist |
key ekey-buffered char-append-buffer |
if |
ekey-buffered 2@ esc-sequences search-wordlist |
execute exit |
if |
else |
execute exit |
ekey-buffered 2@ unkeys #esc |
endif |
then ; |
endif |
|
ekey-buffered 2@ unkeys #esc ; |
|
|
: esc-sequence ( xt addr u -- ; name execution: -- u ) recursive |
: esc-sequence ( xt addr u -- ; name execution: -- u ) recursive |
\ define key "name" and all prefixes |
\ define key "name" and all prefixes |
Line 185 get-current esc-sequences set-current
|
Line 186 get-current esc-sequences set-current
|
' 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-k2 s" [26~" esc-sequence |
|
' s-k3 s" [28~" esc-sequence |
|
' s-k4 s" [29~" esc-sequence |
|
' s-k5 s" [31~" esc-sequence |
|
' s-k6 s" [32~" esc-sequence |
|
' s-k7 s" [33~" esc-sequence |
|
' s-k8 s" [34~" esc-sequence |
|
|
set-current |
set-current |
[ENDIF] |
[ENDIF] |
|
|
Line 201 set-current
|
Line 211 set-current
|
: 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 |
dup 256 u< ; |
dup 256 u< ; |
|
|
: esc? ( -- flag ) recursive |
' key? alias ekey? ( -- flag ) |
key? 0= |
|
if |
|
false exit |
|
then |
|
key ekey-buffered char-append-buffer |
|
ekey-buffered 2@ esc-sequences search-wordlist |
|
if |
|
['] esc-prefix = |
|
if |
|
esc? exit |
|
then |
|
then |
|
true ; |
|
|
|
: ekey? ( -- flag ) \ facility-ext e-key-question |
\ : esc? ( -- flag ) recursive |
\G Return @code{true} if a keyboard event is available (use |
\ key? 0= |
\G @code{ekey} to receive the event), @code{false} otherwise. |
\ if |
key? |
\ false exit |
if |
\ then |
key dup #esc = |
\ key ekey-buffered char-append-buffer |
if |
\ ekey-buffered 2@ esc-sequences search-wordlist |
clear-ekey-buffer esc? |
\ if |
ekey-buffered 2@ unkeys |
\ ['] esc-prefix = |
else |
\ if |
true |
\ esc? exit |
then |
\ then |
swap unkey |
\ then |
else |
\ true ; |
false |
|
then ; |
\ : ekey? ( -- flag ) \ facility-ext e-key-question |
|
\ \G Return @code{true} if a keyboard event is available (use |
|
\ \G @code{ekey} to receive the event), @code{false} otherwise. |
|
\ key? |
|
\ if |
|
\ key dup #esc = |
|
\ if |
|
\ clear-ekey-buffer esc? |
|
\ ekey-buffered 2@ unkeys |
|
\ else |
|
\ true |
|
\ then |
|
\ swap unkey |
|
\ else |
|
\ false |
|
\ then ; |
|
|
\ : test-ekey? |
\ : test-ekey? |
\ begin |
\ begin |