Diff for /gforth/ekey.fs between versions 1.1 and 1.16

version 1.1, 1999/08/29 15:45:19 version 1.16, 2006/12/31 13:39:12
Line 1 Line 1
 \ ekey etc.  \ ekey etc.
   
 \ Copyright (C) 1999 Free Software Foundation, Inc.  \ Copyright (C) 1999,2002,2003,2004,2005,2006 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 16 Line 16
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program; if not, write to the Free Software
 \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   
   
 \ this implementation of EKEY just translates VT100/ANSI escape  \ this implementation of EKEY just translates VT100/ANSI escape
Line 35 Line 35
 : keycode ( "name" -- ; name execution: -- u )  : keycode ( "name" -- ; name execution: -- u )
     create ;      create ;
   
 keycode k-left  \ most of the keys are also in pfe, except:
 keycode k-right  \ k-insert, k-delete, k11, k12, s-k11, s-k12
 keycode k-up  
 keycode k-down  keycode k-left   ( -- u ) \ gforth  
 keycode k-home  keycode k-right  ( -- u ) \ gforth
 keycode k-end  keycode k-up     ( -- u ) \ gforth
 \ keycode k-prior \ note: captured by xterm  keycode k-down   ( -- u ) \ gforth
 \ keycode k-next \ note: captured by xterm  keycode k-home   ( -- u ) \ gforth
 keycode k-insert \ not in pfe  \G aka Pos1
   keycode k-end    ( -- u ) \ gforth
   keycode k-prior  ( -- u ) \ gforth
   \G aka PgUp
   keycode k-next   ( -- u ) \ gforth
   \G aka PgDn    
   keycode k-insert ( -- u ) \ gforth
   127 constant k-delete ( -- u ) \ gforth
   \ not an escape sequence on my xterm, so use ASCII code
   
 \ function/keypad keys  \ function/keypad keys
 keycode k1  keycode k1  ( -- u ) \ gforth
 keycode k2  keycode k2  ( -- u ) \ gforth
 keycode k3  keycode k3  ( -- u ) \ gforth
 keycode k4  keycode k4  ( -- u ) \ gforth
 keycode k5  keycode k5  ( -- u ) \ gforth
 keycode k6  keycode k6  ( -- u ) \ gforth
 keycode k7  keycode k7  ( -- u ) \ gforth
 keycode k8  keycode k8  ( -- u ) \ gforth
 keycode k9  keycode k9  ( -- u ) \ gforth
 keycode k10  keycode k10 ( -- u ) \ gforth
 keycode k11 \ not in pfe  keycode k11 ( -- u ) \ gforth
 keycode k12 \ not in pfe  keycode k12 ( -- u ) \ gforth
 \ shifted function/keypad keys have the same key sequences (in xterm)  \ shifted fuinction keys (don't work in xterm (same as unshifted, but
 \ and pfe gives the same keycodes; so what are these keycodes good for?  \ s-k1..s-k8 work in the Linux console)
 \ keycode s-k1  keycode s-k1  ( -- u ) \ gforth 
 \ keycode s-k2  keycode s-k2  ( -- u ) \ gforth 
 \ keycode s-k3  keycode s-k3  ( -- u ) \ gforth 
 \ keycode s-k4  keycode s-k4  ( -- u ) \ gforth 
 \ keycode s-k5  keycode s-k5  ( -- u ) \ gforth 
 \ keycode s-k6  keycode s-k6  ( -- u ) \ gforth 
 \ keycode s-k7  keycode s-k7  ( -- u ) \ gforth 
 \ keycode s-k8  keycode s-k8  ( -- u ) \ gforth 
 \ keycode s-k9  keycode s-k9  ( -- u ) \ gforth 
 \ keycode s-k10  keycode s-k10 ( -- u ) \ gforth 
 \ keycode s-k11 \ not in pfe  keycode s-k11 ( -- u ) \ gforth
 \ keycode s-k12 \ not in pfe  keycode s-k12 ( -- u ) \ gforth
   
 \ helper word  \ helper word
 \ print a key sequence:  \ print a key sequence:
Line 116  table constant esc-sequences \ and prefi Line 125  table constant esc-sequences \ and prefi
 create ekey-buffer 8 chars allot  create ekey-buffer 8 chars allot
 2variable ekey-buffered  2variable ekey-buffered
   
 27 constant #esc  [IFUNDEF] #esc  27 Constant #esc  [THEN]
   
 : esc-prefix ( -- u )  : esc-prefix ( -- u )
     key ekey-buffered char-append-buffer      key? if
     ekey-buffered 2@ esc-sequences search-wordlist          key ekey-buffered char-append-buffer
     if          ekey-buffered 2@ esc-sequences search-wordlist
         execute exit          if
     else              execute exit
         ekey-buffered 2@ unkeys #esc          endif
     then ;      endif
       ekey-buffered 2@ unkeys #esc ;
   
 : esc-sequence ( xt addr u -- ; name execution: -- u ) recursive  : esc-sequence ( xt addr u -- ; name execution: -- u ) recursive
     \ define key "name" and all prefixes      \ define key "name" and all prefixes
Line 142  create ekey-buffer 8 chars allot Line 152  create ekey-buffer 8 chars allot
     then ( xt addr u )      then ( xt addr u )
     nextname alias ;      nextname alias ;
   
   \ nac02dec1999 exclude the escape sequences if we are using crossdoc.fs to generate
   \ a documentation file. Do this because key sequences [ and OR here clash with
   \ standard names and so prevent them appearing in the documentation. 
   [IFUNDEF] put-doc-entry
 get-current esc-sequences set-current  get-current esc-sequences set-current
   
 \ esc sequences (derived by using key-sequence in an xterm)  \ esc sequences (derived by using key-sequence in an xterm)
Line 152  get-current esc-sequences set-current Line 166  get-current esc-sequences set-current
 ' k-down        s" [B"  esc-sequence  ' k-down        s" [B"  esc-sequence
 ' k-home        s" [H"  esc-sequence  ' k-home        s" [H"  esc-sequence
 ' k-end         s" [F"  esc-sequence  ' k-end         s" [F"  esc-sequence
 \ ' k-prior     s" [5~" esc-sequence \ from linux console  ' k-prior       s" [5~" esc-sequence
 \ ' k-next      s" [6~" esc-sequence \ from linux console  ' k-next        s" [6~" esc-sequence
 ' k-insert      s" [2~" esc-sequence  ' k-insert      s" [2~" esc-sequence
   
 ' k1    s" OP"  esc-sequence  ' k1    s" OP"  esc-sequence
Line 169  get-current esc-sequences set-current Line 183  get-current esc-sequences set-current
 ' k11   s" [23~" esc-sequence  ' k11   s" [23~" esc-sequence
 ' k12   s" [24~" esc-sequence  ' k12   s" [24~" esc-sequence
   
   \ esc sequences from Linux console:
   
   ' k1       s" [[A" esc-sequence
   ' k2       s" [[B" esc-sequence
   ' k3       s" [[C" esc-sequence
   ' k4       s" [[D" esc-sequence
   ' k5       s" [[E" esc-sequence
   ' k-delete s" [3~" esc-sequence
   ' k-home   s" [1~" esc-sequence
   ' k-end    s" [4~" esc-sequence
   
   ' s-k1 s" [25~" esc-sequence
   ' s-k2 s" [26~" esc-sequence
   ' s-k3 s" [28~" esc-sequence
   ' s-k4 s" [29~" esc-sequence
   ' s-k5 s" [31~" esc-sequence
   ' s-k6 s" [32~" esc-sequence
   ' s-k7 s" [33~" esc-sequence
   ' s-k8 s" [34~" esc-sequence
   
 set-current  set-current
   [ENDIF]
   
 : clear-ekey-buffer ( -- )  : clear-ekey-buffer ( -- )
       ekey-buffer 0 ekey-buffered 2! ;      ekey-buffer 0 ekey-buffered 2! ;
   
 : ekey ( -- u )  : ekey ( -- u ) \ facility-ext e-key
       \G Receive a keyboard event @var{u} (encoding implementation-defined).
     key dup #esc =      key dup #esc =
     if      if
         drop clear-ekey-buffer          drop clear-ekey-buffer
         esc-prefix          esc-prefix
     then ;      then ;
   
 : ekey>char ( u -- u false | c true )  : ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char
     dup 256 u< ;      \G Convert keyboard event @var{u} into character @code{c} if possible.
       dup k-left u< ; \ k-left must be first!
 : esc? ( -- flag ) recursive  
     key? 0=  ' key? alias ekey? ( -- flag ) \ facility-ext e-key-question
     if  \G True if a keyboard event is available.
         false exit  
     then  \  : esc? ( -- flag ) recursive
     key ekey-buffered char-append-buffer  \      key? 0=
     ekey-buffered 2@ esc-sequences search-wordlist  \      if
     if  \       false exit
         ['] esc-prefix =  \      then
         if  \      key ekey-buffered char-append-buffer
             esc? exit  \      ekey-buffered 2@ esc-sequences search-wordlist
         then  \      if
     then  \       ['] esc-prefix =
     true ;  \       if
   \           esc? exit
 : ekey? ( -- flag )  \       then
     key?  \      then
     if  \      true ;
         key dup #esc =  
         if  \  : ekey? ( -- flag ) \ facility-ext e-key-question
             clear-ekey-buffer esc?  \      \G Return @code{true} if a keyboard event is available (use
             ekey-buffered 2@ unkeys  \      \G @code{ekey} to receive the event), @code{false} otherwise.
         else  \      key?
             true  \      if
         then  \       key dup #esc =
         swap unkey  \       if
     else  \           clear-ekey-buffer esc?
         false  \           ekey-buffered 2@ unkeys
     then ;  \       else
   \           true
   \       then
   \       swap unkey
   \      else
   \       false
   \      then ;
   
 \ : test-ekey?  \ : test-ekey?
 \     begin  \     begin

Removed from v.1.1  
changed lines
  Added in v.1.16


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