--- gforth/ekey.fs	2007/12/31 17:34:58	1.18
+++ gforth/ekey.fs	2008/11/23 20:49:37	1.22
@@ -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
@@ -150,7 +175,6 @@ table constant esc-sequences \ and prefi
 
 create ekey-buffer 8 chars allot
 2variable ekey-buffered
-
 [IFUNDEF] #esc  27 Constant #esc  [THEN]
 
 : esc-prefix ( -- u )
@@ -319,17 +343,44 @@ set-current
     if
         drop clear-ekey-buffer
         esc-prefix
-    then ;
+    then
+    [IFDEF] max-single-byte
+	dup max-single-byte u>= if
+	    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 @ = if
+		ekey-buffer xc@+ nip         else
+		ekey-buffered 2@ unkeys key  then
+	then
+    [THEN]
+;
 
+[IFDEF] max-single-byte
+: 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 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!
+: 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= ;
+[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
 \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>char 0= ;
+[THEN]
 
 ' key? alias ekey? ( -- flag ) \ facility-ext e-key-question
 \G True if a keyboard event is available.