Annotation of gforth/ekey.fs, revision 1.5
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 )
123: key ekey-buffered char-append-buffer
124: ekey-buffered 2@ esc-sequences search-wordlist
125: if
126: execute exit
127: else
128: ekey-buffered 2@ unkeys #esc
129: then ;
130:
131: : esc-sequence ( xt addr u -- ; name execution: -- u ) recursive
132: \ define key "name" and all prefixes
133: 2dup 1- dup
134: if
135: 2dup esc-sequences search-wordlist
136: if
137: drop 2drop
138: else
139: ['] esc-prefix -rot esc-sequence
140: then
141: else
142: 2drop
143: then ( xt addr u )
144: nextname alias ;
145:
1.2 crook 146: \ nac02dec1999 exclude the escape sequences if we are using crossdoc.fs to generate
147: \ a documentation file. Do this because key sequences [ and OR here clash with
148: \ standard names and so prevent them appearing in the documentation.
149: [IFUNDEF] put-doc-entry
1.1 anton 150: get-current esc-sequences set-current
151:
152: \ esc sequences (derived by using key-sequence in an xterm)
153:
154: ' k-left s" [D" esc-sequence
155: ' k-right s" [C" esc-sequence
156: ' k-up s" [A" esc-sequence
157: ' k-down s" [B" esc-sequence
158: ' k-home s" [H" esc-sequence
159: ' k-end s" [F" esc-sequence
1.4 anton 160: ' k-prior s" [5~" esc-sequence
161: ' k-next s" [6~" esc-sequence
1.1 anton 162: ' k-insert s" [2~" esc-sequence
163:
164: ' k1 s" OP" esc-sequence
165: ' k2 s" OQ" esc-sequence
166: ' k3 s" OR" esc-sequence
167: ' k4 s" OS" esc-sequence
168: ' k5 s" [15~" esc-sequence
169: ' k6 s" [17~" esc-sequence
170: ' k7 s" [18~" esc-sequence
171: ' k8 s" [19~" esc-sequence
172: ' k9 s" [20~" esc-sequence
173: ' k10 s" [21~" esc-sequence
174: ' k11 s" [23~" esc-sequence
175: ' k12 s" [24~" esc-sequence
1.4 anton 176:
177: \ esc sequences from Linux console:
178:
179: ' k1 s" [[A" esc-sequence
180: ' k2 s" [[B" esc-sequence
181: ' k3 s" [[C" esc-sequence
182: ' k4 s" [[D" esc-sequence
183: ' k5 s" [[E" esc-sequence
184: ' k-delete s" [3~" esc-sequence
185: ' k-home s" [1~" esc-sequence
186: ' k-end s" [4~" esc-sequence
1.5 ! anton 187:
! 188: ' s-k1 s" [25~" esc-sequence
! 189: ' s-k2 s" [26~" esc-sequence
! 190: ' s-k3 s" [28~" esc-sequence
! 191: ' s-k4 s" [29~" esc-sequence
! 192: ' s-k5 s" [31~" esc-sequence
! 193: ' s-k6 s" [32~" esc-sequence
! 194: ' s-k7 s" [33~" esc-sequence
! 195: ' s-k8 s" [34~" esc-sequence
1.1 anton 196:
197: set-current
1.2 crook 198: [ENDIF]
1.1 anton 199:
200: : clear-ekey-buffer ( -- )
201: ekey-buffer 0 ekey-buffered 2! ;
202:
1.2 crook 203: : ekey ( -- u ) \ facility-ext e-key
1.1 anton 204: key dup #esc =
205: if
206: drop clear-ekey-buffer
207: esc-prefix
208: then ;
209:
1.2 crook 210: : ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char
1.1 anton 211: dup 256 u< ;
212:
213: : esc? ( -- flag ) recursive
214: key? 0=
215: if
216: false exit
217: then
218: key ekey-buffered char-append-buffer
219: ekey-buffered 2@ esc-sequences search-wordlist
220: if
221: ['] esc-prefix =
222: if
223: esc? exit
224: then
225: then
226: true ;
227:
1.2 crook 228: : ekey? ( -- flag ) \ facility-ext e-key-question
229: \G Return @code{true} if a keyboard event is available (use
230: \G @code{ekey} to receive the event), @code{false} otherwise.
1.1 anton 231: key?
232: if
233: key dup #esc =
234: if
235: clear-ekey-buffer esc?
236: ekey-buffered 2@ unkeys
237: else
238: true
239: then
240: swap unkey
241: else
242: false
243: then ;
244:
245: \ : test-ekey?
246: \ begin
247: \ begin
248: \ begin
249: \ key? until
250: \ ekey? until
251: \ .s ekey .s drop
252: \ again ;
253: \ test-ekey?
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>