File:  [gforth] / gforth / ekey.fs
Revision 1.2: download - view: text, annotated - select for diffs
Fri Dec 3 18:35:15 1999 UTC (18 years, 11 months ago) by crook
Branches: MAIN
CVS tags: HEAD
documentation tweaks plus bug-fix: the introduction of this file messed up
the documentation of [ and OR in the manual. The reason is that the
esc-sequences table contains words [ and OR and these were getting put into
doc/doc.fd and then slipped into the .tex file in preference to the correct
entries from doc/crossdoc.fd
My less-than-ideal fix to this is to add "[IFNDEF] put-doc-entry" around
the definition of the esc-sequences so that it gets omitted completely
during a documentation build. The ideal fix would be for crossdoc.fs and
the prim->index process to each support optional "prefix-" in the same
way that doc/makedoc.fs does.

    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: \ nac02dec1999 exclude the escape sequences if we are using crossdoc.fs to generate
  146: \ a documentation file. Do this because key sequences [ and OR here clash with
  147: \ standard names and so prevent them appearing in the documentation. 
  148: [IFUNDEF] put-doc-entry
  149: get-current esc-sequences set-current
  150: 
  151: \ esc sequences (derived by using key-sequence in an xterm)
  152: 
  153: ' k-left	s" [D"	esc-sequence
  154: ' k-right	s" [C"	esc-sequence
  155: ' k-up		s" [A"	esc-sequence
  156: ' k-down	s" [B"	esc-sequence
  157: ' k-home	s" [H"	esc-sequence
  158: ' k-end		s" [F"	esc-sequence
  159: \ ' k-prior	s" [5~"	esc-sequence \ from linux console
  160: \ ' k-next	s" [6~"	esc-sequence \ from linux console
  161: ' k-insert	s" [2~"	esc-sequence
  162: 
  163: ' k1	s" OP"	esc-sequence
  164: ' k2	s" OQ"	esc-sequence
  165: ' k3	s" OR"	esc-sequence
  166: ' k4	s" OS"	esc-sequence
  167: ' k5	s" [15~" esc-sequence
  168: ' k6	s" [17~" esc-sequence
  169: ' k7	s" [18~" esc-sequence
  170: ' k8	s" [19~" esc-sequence
  171: ' k9	s" [20~" esc-sequence
  172: ' k10	s" [21~" esc-sequence
  173: ' k11	s" [23~" esc-sequence
  174: ' k12	s" [24~" esc-sequence
  175: 
  176: set-current
  177: [ENDIF]
  178: 
  179: : clear-ekey-buffer ( -- )
  180:       ekey-buffer 0 ekey-buffered 2! ;
  181: 
  182: : ekey ( -- u ) \ facility-ext e-key
  183:     key dup #esc =
  184:     if
  185: 	drop clear-ekey-buffer
  186: 	esc-prefix
  187:     then ;
  188: 
  189: : ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char
  190:     dup 256 u< ;
  191: 
  192: : esc? ( -- flag ) recursive
  193:     key? 0=
  194:     if
  195: 	false exit
  196:     then
  197:     key ekey-buffered char-append-buffer
  198:     ekey-buffered 2@ esc-sequences search-wordlist
  199:     if
  200: 	['] esc-prefix =
  201: 	if
  202: 	    esc? exit
  203: 	then
  204:     then
  205:     true ;
  206: 
  207: : ekey? ( -- flag ) \ facility-ext e-key-question
  208:     \G Return @code{true} if a keyboard event is available (use
  209:     \G @code{ekey} to receive the event), @code{false} otherwise.
  210:     key?
  211:     if
  212: 	key dup #esc =
  213: 	if
  214: 	    clear-ekey-buffer esc?
  215: 	    ekey-buffered 2@ unkeys
  216: 	else
  217: 	    true
  218: 	then
  219: 	swap unkey
  220:     else
  221: 	false
  222:     then ;
  223: 
  224: \ : test-ekey?
  225: \     begin
  226: \ 	begin
  227: \ 	    begin
  228: \ 		key? until
  229: \ 	    ekey? until
  230: \ 	.s ekey .s drop
  231: \     again ;
  232: \ test-ekey?

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>