Annotation of gforth/ekey.fs, revision 1.4
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
61: \ shifted function/keypad keys have the same key sequences (in xterm)
62: \ and pfe gives the same keycodes; so what are these keycodes good for?
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
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.1 anton 187:
188: set-current
1.2 crook 189: [ENDIF]
1.1 anton 190:
191: : clear-ekey-buffer ( -- )
192: ekey-buffer 0 ekey-buffered 2! ;
193:
1.2 crook 194: : ekey ( -- u ) \ facility-ext e-key
1.1 anton 195: key dup #esc =
196: if
197: drop clear-ekey-buffer
198: esc-prefix
199: then ;
200:
1.2 crook 201: : ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char
1.1 anton 202: dup 256 u< ;
203:
204: : esc? ( -- flag ) recursive
205: key? 0=
206: if
207: false exit
208: then
209: key ekey-buffered char-append-buffer
210: ekey-buffered 2@ esc-sequences search-wordlist
211: if
212: ['] esc-prefix =
213: if
214: esc? exit
215: then
216: then
217: true ;
218:
1.2 crook 219: : ekey? ( -- flag ) \ facility-ext e-key-question
220: \G Return @code{true} if a keyboard event is available (use
221: \G @code{ekey} to receive the event), @code{false} otherwise.
1.1 anton 222: key?
223: if
224: key dup #esc =
225: if
226: clear-ekey-buffer esc?
227: ekey-buffered 2@ unkeys
228: else
229: true
230: then
231: swap unkey
232: else
233: false
234: then ;
235:
236: \ : test-ekey?
237: \ begin
238: \ begin
239: \ begin
240: \ key? until
241: \ ekey? until
242: \ .s ekey .s drop
243: \ again ;
244: \ test-ekey?
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>