--- gforth/ekey.fs 2007/12/31 17:34:58 1.18 +++ gforth/ekey.fs 2008/11/08 19:43:50 1.21 @@ -1,12 +1,12 @@ \ ekey etc. -\ Copyright (C) 1999,2002,2003,2004,2005,2006,2007 Free Software Foundation, Inc. +\ Copyright (C) 1999,2002,2003,2004,2005,2006,2007,2008 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth is free software; you can redistribute it and/or \ 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. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ this implementation of EKEY just translates VT100/ANSI escape @@ -32,8 +31,16 @@ \ 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 ) - 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: \ k-insert, k-delete, k11, k12, s-k11, s-k12 @@ -42,7 +49,25 @@ $40000000 constant k-shift-mask ( -- u ) $20000000 constant k-ctrl-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-right ( -- u ) \ X:ekeys keycode k-up ( -- u ) \ X:ekeys