Annotation of gforth/ekey.fs, revision 1.7
1.1 anton 1: \ ekey etc.
2:
3: \ Copyright (C) 1999 Free Software Foundation, Inc.
4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation; either version 2
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program; if not, write to the Free Software
1.3 anton 19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
1.1 anton 20:
21:
22: \ this implementation of EKEY just translates VT100/ANSI escape
23: \ sequences to ekeys.
24:
25: \ Caveats: It also translates the sequences if they were not generated
26: \ by pressing the key; moreover, it waits until a complete sequence or
27: \ an invalid prefix to a sequence has arrived before reporting true in
28: \ EKEY? and before completing EKEY. One way to fix this would be to
29: \ use timeouts when waiting for the next key; however, this may lead
30: \ to situations in slow networks where single events result in several
31: \ EKEYs, which appears less desirable to me.
32:
33: \ The keycode names are compatible with pfe-0.9.14
34:
35: : keycode ( "name" -- ; name execution: -- u )
36: create ;
37:
38: keycode k-left
39: keycode k-right
40: keycode k-up
41: keycode k-down
42: keycode k-home
43: keycode k-end
1.4 anton 44: keycode k-prior \ note: captured by xterm
45: keycode k-next \ note: captured by xterm
1.1 anton 46: keycode k-insert \ not in pfe
1.4 anton 47: 127 constant k-delete \ not an escape sequence on my xterm, so use ASCII code
1.1 anton 48: \ function/keypad keys
49: keycode k1
50: keycode k2
51: keycode k3
52: keycode k4
53: keycode k5
54: keycode k6
55: keycode k7
56: keycode k8
57: keycode k9
58: keycode k10
59: keycode k11 \ not in pfe
60: keycode k12 \ not in pfe
1.5 anton 61: \ shifted fuinction keys (don't work in xterm (same as unshifted, but
62: \ s-k1..s-k8 work in the Linux console)
63: keycode s-k1
64: keycode s-k2
65: keycode s-k3
66: keycode s-k4
67: keycode s-k5
68: keycode s-k6
69: keycode s-k7
70: keycode s-k8
71: keycode s-k9
72: keycode s-k10
73: keycode s-k11 \ not in pfe
74: keycode s-k12 \ not in pfe
1.1 anton 75:
76: \ helper word
77: \ print a key sequence:
78: \ : key-sequence ( -- )
79: \ key begin
80: \ cr dup . emit
81: \ key? while
82: \ key
83: \ repeat ;
84:
85: create key-buffer 8 chars allot
86: 2variable key-buffered key-buffer 0 key-buffered 2!
87:
88: : char-append-buffer ( c addr -- )
89: tuck 2@ chars + c!
90: dup 2@ 1+ rot 2! ;
91:
92: :noname ( -- c )
93: \ buffered key
94: key-buffered 2@ dup if
95: 1- 2dup key-buffered 2!
96: chars + c@
97: else
98: 2drop defers key
99: then ;
100: is key
101:
102: : unkey ( c -- )
103: key-buffered char-append-buffer ;
104:
105: : unkeys ( addr u -- )
106: -1 swap 1- -do
107: dup i chars + c@ unkey
108: 1 -loop
109: drop ;
110:
111: :noname ( -- flag )
112: key-buffered 2@ nip 0<> defers key? or ;
113: is key?
114:
115: table constant esc-sequences \ and prefixes
116:
117: create ekey-buffer 8 chars allot
118: 2variable ekey-buffered
119:
120: 27 constant #esc
121:
122: : esc-prefix ( -- u )
1.6 anton 123: key? if
124: key ekey-buffered char-append-buffer
125: ekey-buffered 2@ esc-sequences search-wordlist
126: if
127: execute exit
128: endif
129: endif
130: ekey-buffered 2@ unkeys #esc ;
1.1 anton 131:
132: : esc-sequence ( xt addr u -- ; name execution: -- u ) recursive
133: \ define key "name" and all prefixes
134: 2dup 1- dup
135: if
136: 2dup esc-sequences search-wordlist
137: if
138: drop 2drop
139: else
140: ['] esc-prefix -rot esc-sequence
141: then
142: else
143: 2drop
144: then ( xt addr u )
145: nextname alias ;
146:
1.2 crook 147: \ nac02dec1999 exclude the escape sequences if we are using crossdoc.fs to generate
148: \ a documentation file. Do this because key sequences [ and OR here clash with
149: \ standard names and so prevent them appearing in the documentation.
150: [IFUNDEF] put-doc-entry
1.1 anton 151: get-current esc-sequences set-current
152:
153: \ esc sequences (derived by using key-sequence in an xterm)
154:
155: ' k-left s" [D" esc-sequence
156: ' k-right s" [C" esc-sequence
157: ' k-up s" [A" esc-sequence
158: ' k-down s" [B" esc-sequence
159: ' k-home s" [H" esc-sequence
160: ' k-end s" [F" esc-sequence
1.4 anton 161: ' k-prior s" [5~" esc-sequence
162: ' k-next s" [6~" esc-sequence
1.1 anton 163: ' k-insert s" [2~" esc-sequence
164:
165: ' k1 s" OP" esc-sequence
166: ' k2 s" OQ" esc-sequence
167: ' k3 s" OR" esc-sequence
168: ' k4 s" OS" esc-sequence
169: ' k5 s" [15~" esc-sequence
170: ' k6 s" [17~" esc-sequence
171: ' k7 s" [18~" esc-sequence
172: ' k8 s" [19~" esc-sequence
173: ' k9 s" [20~" esc-sequence
174: ' k10 s" [21~" esc-sequence
175: ' k11 s" [23~" esc-sequence
176: ' k12 s" [24~" esc-sequence
1.4 anton 177:
178: \ esc sequences from Linux console:
179:
180: ' k1 s" [[A" esc-sequence
181: ' k2 s" [[B" esc-sequence
182: ' k3 s" [[C" esc-sequence
183: ' k4 s" [[D" esc-sequence
184: ' k5 s" [[E" esc-sequence
185: ' k-delete s" [3~" esc-sequence
186: ' k-home s" [1~" esc-sequence
187: ' k-end s" [4~" esc-sequence
1.5 anton 188:
189: ' s-k1 s" [25~" esc-sequence
190: ' s-k2 s" [26~" esc-sequence
191: ' s-k3 s" [28~" esc-sequence
192: ' s-k4 s" [29~" esc-sequence
193: ' s-k5 s" [31~" esc-sequence
194: ' s-k6 s" [32~" esc-sequence
195: ' s-k7 s" [33~" esc-sequence
196: ' s-k8 s" [34~" esc-sequence
1.1 anton 197:
198: set-current
1.2 crook 199: [ENDIF]
1.1 anton 200:
201: : clear-ekey-buffer ( -- )
202: ekey-buffer 0 ekey-buffered 2! ;
203:
1.2 crook 204: : ekey ( -- u ) \ facility-ext e-key
1.1 anton 205: key dup #esc =
206: if
207: drop clear-ekey-buffer
208: esc-prefix
209: then ;
210:
1.2 crook 211: : ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char
1.1 anton 212: dup 256 u< ;
213:
1.7 ! anton 214: ' key? alias ekey? ( -- flag )
1.1 anton 215:
1.7 ! anton 216: \ : esc? ( -- flag ) recursive
! 217: \ key? 0=
! 218: \ if
! 219: \ false exit
! 220: \ then
! 221: \ key ekey-buffered char-append-buffer
! 222: \ ekey-buffered 2@ esc-sequences search-wordlist
! 223: \ if
! 224: \ ['] esc-prefix =
! 225: \ if
! 226: \ esc? exit
! 227: \ then
! 228: \ then
! 229: \ true ;
! 230:
! 231: \ : ekey? ( -- flag ) \ facility-ext e-key-question
! 232: \ \G Return @code{true} if a keyboard event is available (use
! 233: \ \G @code{ekey} to receive the event), @code{false} otherwise.
! 234: \ key?
! 235: \ if
! 236: \ key dup #esc =
! 237: \ if
! 238: \ clear-ekey-buffer esc?
! 239: \ ekey-buffered 2@ unkeys
! 240: \ else
! 241: \ true
! 242: \ then
! 243: \ swap unkey
! 244: \ else
! 245: \ false
! 246: \ then ;
1.1 anton 247:
248: \ : test-ekey?
249: \ begin
250: \ begin
251: \ begin
252: \ key? until
253: \ ekey? until
254: \ .s ekey .s drop
255: \ again ;
256: \ test-ekey?
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>