Diff for /gforth/ekey.fs between versions 1.17 and 1.25

version 1.17, 2007/06/15 21:06:52 version 1.25, 2009/01/21 18:08:11
Line 1 Line 1
 \ ekey etc.  \ ekey etc.
   
 \ Copyright (C) 1999,2002,2003,2004,2005,2006 Free Software Foundation, Inc.  \ Copyright (C) 1999,2002,2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
 \ Gforth is free software; you can redistribute it and/or  \ Gforth is free software; you can redistribute it and/or
 \ modify it under the terms of the GNU General Public License  \ modify it under the terms of the GNU General Public License
 \ as published by the Free Software Foundation; either version 2  \ as published by the Free Software Foundation, either version 3
 \ of the License, or (at your option) any later version.  \ of the License, or (at your option) any later version.
   
 \ This program is distributed in the hope that it will be useful,  \ This program is distributed in the hope that it will be useful,
Line 15 Line 15
 \ GNU General Public License for more details.  \ GNU General Public License for more details.
   
 \ 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, see http://www.gnu.org/licenses/.
 \ 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 32 Line 31
   
 \ The keycode names are compatible with pfe-0.9.14  \ The keycode names are compatible with pfe-0.9.14
   
   $80000000 constant keycode-start
   $80000016 constant keycode-limit
   
   create keycode-table keycode-limit keycode-start - cells allot
   
 : keycode ( u1 "name" -- u2 ; name execution: -- u )  : keycode ( u1 "name" -- u2 ; name execution: -- u )
     dup constant 1+ ;      dup keycode-limit keycode-start within -11 and throw
       dup constant
       dup latest keycode-table rot keycode-start - th !
       1+ ;
   
 \ most of the keys are also in pfe, except:  \ most of the keys are also in pfe, except:
 \ k-insert, k-delete, k11, k12, s-k11, s-k12  \ k-insert, k-delete, k11, k12, s-k11, s-k12
Line 42  $40000000 constant k-shift-mask ( -- u ) Line 49  $40000000 constant k-shift-mask ( -- u )
 $20000000 constant k-ctrl-mask ( -- u )  \ X:ekeys  $20000000 constant k-ctrl-mask ( -- u )  \ X:ekeys
 $10000000 constant k-alt-mask ( -- u )   \ X:ekeys  $10000000 constant k-alt-mask ( -- u )   \ X:ekeys
   
 $80000000  : simple-fkey-string ( u1 -- c-addr u ) \ gforth
       \G @i{c-addr u} is the string name of the function key @i{u1}.
       \G Only works for simple function keys without modifier masks.
       \G Any @i{u1} that does not correspond to a simple function key
       \G currently produces an exception.
       dup keycode-limit keycode-start within -24 and throw
       keycode-table swap keycode-start - th @ name>string ;
   
   : fkey. ( u -- ) \ gforth fkey-dot
       \G Print a string representation for the function key @i{u}.
       \G @i{U} must be a function key (possibly with modifier masks),
       \G otherwise there may be an exception.
       dup [ k-shift-mask k-ctrl-mask k-alt-mask or or invert ] literal and
       simple-fkey-string type
       dup k-shift-mask and if ."  k-shift-mask or" then
       dup k-ctrl-mask  and if ."  k-ctrl-mask or"  then
           k-alt-mask   and if ."  k-alt-mask or"   then ;
   
   keycode-start
 keycode k-left   ( -- u ) \ X:ekeys    keycode k-left   ( -- u ) \ X:ekeys  
 keycode k-right  ( -- u ) \ X:ekeys  keycode k-right  ( -- u ) \ X:ekeys
 keycode k-up     ( -- u ) \ X:ekeys  keycode k-up     ( -- u ) \ X:ekeys
Line 150  table constant esc-sequences \ and prefi Line 175  table constant esc-sequences \ and prefi
   
 create ekey-buffer 8 chars allot  create ekey-buffer 8 chars allot
 2variable ekey-buffered  2variable ekey-buffered
   
 [IFUNDEF] #esc  27 Constant #esc  [THEN]  [IFUNDEF] #esc  27 Constant #esc  [THEN]
   
 : esc-prefix ( -- u )  : esc-prefix ( -- u )
Line 307  s-k6 s" [32~" esc-sequence Line 331  s-k6 s" [32~" esc-sequence
 s-k7 s" [33~" esc-sequence  s-k7 s" [33~" esc-sequence
 s-k8 s" [34~" esc-sequence  s-k8 s" [34~" esc-sequence
   
   \ esc sequences for MacOS X iterm <e7a7c785-3bea-408b-94e9-4b59b008546f@x16g2000prn.googlegroups.com>
   k-left   s" OD" esc-sequence
   k-right  s" OC" esc-sequence
   k-up     s" OA" esc-sequence
   k-down   s" OB" esc-sequence
   
 set-current  set-current
 [ENDIF]  [ENDIF]
   
 : clear-ekey-buffer ( -- )  : clear-ekey-buffer ( -- )
     ekey-buffer 0 ekey-buffered 2! ;      ekey-buffer 0 ekey-buffered 2! ;
   
   [IFDEF] max-single-byte
       : read-xkey ( key -- flag )
           clear-ekey-buffer
           ekey-buffered char-append-buffer
           ekey-buffer 1 u8addrlen 1 +do
               key? 0= ?leave
               key ekey-buffered char-append-buffer
           loop
           ekey-buffer 1 u8addrlen ekey-buffered @ = ;
       : get-xkey ( u -- xc )
           dup max-single-byte u>= if
               read-xkey if
                   ekey-buffer xc@+ nip         else
                   ekey-buffered 2@ unkeys key  then
           then ;
       : xkey? ( -- flag )
           key? dup if
               drop key read-xkey ekey-buffered 2@ unkeys
               clear-ekey-buffer  then ;
   [THEN]
   
 : ekey ( -- u ) \ facility-ext e-key  : ekey ( -- u ) \ facility-ext e-key
     \G Receive a keyboard event @var{u} (encoding implementation-defined).      \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  exit
     then ;      then
       [IFDEF] max-single-byte
           get-xkey
       [THEN]
   ;
   
   [IFDEF] max-single-byte
 : ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char  : ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char
     \G Convert keyboard event @var{u} into character @code{c} if possible.      \G Convert keyboard event @var{u} into character @code{c} if possible.
       dup max-single-byte u< ; \ k-left must be first!
   : ekey>xchar ( u -- u false | xc true ) \ xchar-ext e-key-to-xchar
       \G Convert keyboard event @var{u} into xchar @code{xc} if possible.
     dup k-left u< ; \ k-left must be first!      dup k-left u< ; \ k-left must be first!
   : ekey>fkey ( u1 -- u2 f ) \ X:ekeys
   \G If u1 is a keyboard event in the special key set, convert
   \G keyboard event @var{u1} into key id @var{u2} and return true;
   \G otherwise return @var{u1} and false.
       ekey>xchar 0= ;
   
   ' xkey? alias ekey? ( -- flag ) \ facility-ext e-key-question
   [ELSE]
   : ekey>char ( u -- u false | c true ) \ facility-ext e-key-to-char
       \G Convert keyboard event @var{u} into character @code{c} if possible.
       dup k-left u< ; \ k-left must be first!
 : ekey>fkey ( u1 -- u2 f ) \ X:ekeys  : ekey>fkey ( u1 -- u2 f ) \ X:ekeys
 \G If u1 is a keyboard event in the special key set, convert  \G If u1 is a keyboard event in the special key set, convert
 \G keyboard event @var{u1} into key id @var{u2} and return true;  \G keyboard event @var{u1} into key id @var{u2} and return true;
Line 332  set-current Line 401  set-current
     ekey>char 0= ;      ekey>char 0= ;
   
 ' key? alias ekey? ( -- flag ) \ facility-ext e-key-question  ' key? alias ekey? ( -- flag ) \ facility-ext e-key-question
   [THEN]
   
 \G True if a keyboard event is available.  \G True if a keyboard event is available.
   
 \  : esc? ( -- flag ) recursive  \  : esc? ( -- flag ) recursive

Removed from v.1.17  
changed lines
  Added in v.1.25


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