Annotation of gforth/ekey.fs, revision 1.1
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
! 19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
! 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
! 44: \ keycode k-prior \ note: captured by xterm
! 45: \ keycode k-next \ note: captured by xterm
! 46: keycode k-insert \ not in pfe
! 47: \ function/keypad keys
! 48: keycode k1
! 49: keycode k2
! 50: keycode k3
! 51: keycode k4
! 52: keycode k5
! 53: keycode k6
! 54: keycode k7
! 55: keycode k8
! 56: keycode k9
! 57: keycode k10
! 58: keycode k11 \ not in pfe
! 59: keycode k12 \ not in pfe
! 60: \ shifted function/keypad keys have the same key sequences (in xterm)
! 61: \ and pfe gives the same keycodes; so what are these keycodes good for?
! 62: \ keycode s-k1
! 63: \ keycode s-k2
! 64: \ keycode s-k3
! 65: \ keycode s-k4
! 66: \ keycode s-k5
! 67: \ keycode s-k6
! 68: \ keycode s-k7
! 69: \ keycode s-k8
! 70: \ keycode s-k9
! 71: \ keycode s-k10
! 72: \ keycode s-k11 \ not in pfe
! 73: \ keycode s-k12 \ not in pfe
! 74:
! 75: \ helper word
! 76: \ print a key sequence:
! 77: \ : key-sequence ( -- )
! 78: \ key begin
! 79: \ cr dup . emit
! 80: \ key? while
! 81: \ key
! 82: \ repeat ;
! 83:
! 84: create key-buffer 8 chars allot
! 85: 2variable key-buffered key-buffer 0 key-buffered 2!
! 86:
! 87: : char-append-buffer ( c addr -- )
! 88: tuck 2@ chars + c!
! 89: dup 2@ 1+ rot 2! ;
! 90:
! 91: :noname ( -- c )
! 92: \ buffered key
! 93: key-buffered 2@ dup if
! 94: 1- 2dup key-buffered 2!
! 95: chars + c@
! 96: else
! 97: 2drop defers key
! 98: then ;
! 99: is key
! 100:
! 101: : unkey ( c -- )
! 102: key-buffered char-append-buffer ;
! 103:
! 104: : unkeys ( addr u -- )
! 105: -1 swap 1- -do
! 106: dup i chars + c@ unkey
! 107: 1 -loop
! 108: drop ;
! 109:
! 110: :noname ( -- flag )
! 111: key-buffered 2@ nip 0<> defers key? or ;
! 112: is key?
! 113:
! 114: table constant esc-sequences \ and prefixes
! 115:
! 116: create ekey-buffer 8 chars allot
! 117: 2variable ekey-buffered
! 118:
! 119: 27 constant #esc
! 120:
! 121: : esc-prefix ( -- u )
! 122: key ekey-buffered char-append-buffer
! 123: ekey-buffered 2@ esc-sequences search-wordlist
! 124: if
! 125: execute exit
! 126: else
! 127: ekey-buffered 2@ unkeys #esc
! 128: then ;
! 129:
! 130: : esc-sequence ( xt addr u -- ; name execution: -- u ) recursive
! 131: \ define key "name" and all prefixes
! 132: 2dup 1- dup
! 133: if
! 134: 2dup esc-sequences search-wordlist
! 135: if
! 136: drop 2drop
! 137: else
! 138: ['] esc-prefix -rot esc-sequence
! 139: then
! 140: else
! 141: 2drop
! 142: then ( xt addr u )
! 143: nextname alias ;
! 144:
! 145: get-current esc-sequences set-current
! 146:
! 147: \ esc sequences (derived by using key-sequence in an xterm)
! 148:
! 149: ' k-left s" [D" esc-sequence
! 150: ' k-right s" [C" esc-sequence
! 151: ' k-up s" [A" esc-sequence
! 152: ' k-down s" [B" esc-sequence
! 153: ' k-home s" [H" esc-sequence
! 154: ' k-end s" [F" esc-sequence
! 155: \ ' k-prior s" [5~" esc-sequence \ from linux console
! 156: \ ' k-next s" [6~" esc-sequence \ from linux console
! 157: ' k-insert s" [2~" esc-sequence
! 158:
! 159: ' k1 s" OP" esc-sequence
! 160: ' k2 s" OQ" esc-sequence
! 161: ' k3 s" OR" esc-sequence
! 162: ' k4 s" OS" esc-sequence
! 163: ' k5 s" [15~" esc-sequence
! 164: ' k6 s" [17~" esc-sequence
! 165: ' k7 s" [18~" esc-sequence
! 166: ' k8 s" [19~" esc-sequence
! 167: ' k9 s" [20~" esc-sequence
! 168: ' k10 s" [21~" esc-sequence
! 169: ' k11 s" [23~" esc-sequence
! 170: ' k12 s" [24~" esc-sequence
! 171:
! 172: set-current
! 173:
! 174: : clear-ekey-buffer ( -- )
! 175: ekey-buffer 0 ekey-buffered 2! ;
! 176:
! 177: : ekey ( -- u )
! 178: key dup #esc =
! 179: if
! 180: drop clear-ekey-buffer
! 181: esc-prefix
! 182: then ;
! 183:
! 184: : ekey>char ( u -- u false | c true )
! 185: dup 256 u< ;
! 186:
! 187: : esc? ( -- flag ) recursive
! 188: key? 0=
! 189: if
! 190: false exit
! 191: then
! 192: key ekey-buffered char-append-buffer
! 193: ekey-buffered 2@ esc-sequences search-wordlist
! 194: if
! 195: ['] esc-prefix =
! 196: if
! 197: esc? exit
! 198: then
! 199: then
! 200: true ;
! 201:
! 202: : ekey? ( -- flag )
! 203: key?
! 204: if
! 205: key dup #esc =
! 206: if
! 207: clear-ekey-buffer esc?
! 208: ekey-buffered 2@ unkeys
! 209: else
! 210: true
! 211: then
! 212: swap unkey
! 213: else
! 214: false
! 215: then ;
! 216:
! 217: \ : test-ekey?
! 218: \ begin
! 219: \ begin
! 220: \ begin
! 221: \ key? until
! 222: \ ekey? until
! 223: \ .s ekey .s drop
! 224: \ again ;
! 225: \ test-ekey?
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ekey.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth