--- gforth/history.fs	2004/12/27 21:15:40	1.36
+++ gforth/history.fs	2005/01/12 21:21:53	1.40
@@ -1,6 +1,6 @@
 \ command line edit and history support                 16oct94py
 
-\ Copyright (C) 1995,2000,2003 Free Software Foundation, Inc.
+\ Copyright (C) 1995,2000,2003,2004 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -222,7 +222,8 @@ Create prefix-found  0 , 0 ,
 
 [IFUNDEF] everyline defer everyline [THEN]
 
-: 8-bit-io ( -- )
+: char-history ( -- )
+    \ might be useful on dumb terminals, otherwise unused
     ['] forw        ctrl F bindkey
     ['] back        ctrl B bindkey
     ['] ?del        ctrl H bindkey
@@ -238,21 +239,100 @@ Create prefix-found  0 , 0 ,
     ['] tab-expand  #tab   bindkey
     ['] (ins)       IS insert-char
     ['] kill-prefix IS everychar
-    ['] noop        IS everyline
-    [ action-of key ] Literal IS key
-    [ action-of emit ] Literal IS emit ;
+    ['] noop        IS everyline ;
 
 \ UTF-8 support
 
-include utf-8.fs
+require utf-8.fs
 
-: utf-8-cold ( -- )
-    s" LANG" getenv s" .UTF-8" search nip nip
-    IF  utf-8-io  ELSE  8-bit-io  THEN ;
+[IFUNDEF] #esc  27 Constant #esc  [THEN]
 
-' utf-8-cold INIT8 chained
+: save-cursor ( -- )  #esc emit '7 emit ;
+: restore-cursor ( -- )  #esc emit '8 emit ;
+: .rest ( addr pos1 -- addr pos1 )
+    restore-cursor 2dup type ;
+: .all ( span addr pos1 -- span addr pos1 )
+    restore-cursor >r 2dup swap type r> ;
+
+: <xins>  ( max span addr pos1 xc -- max span addr pos2 )
+    >r  2over r@ xc-size + u< IF  ( max span addr pos1 R:xc )
+	rdrop bell  EXIT  THEN
+    >string over r@ xc-size + swap move
+    2dup chars + r@ swap r@ xc-size xc!+? 2drop drop
+    r> xc-size >r  rot r@ chars + -rot r> chars + ;
+: (xins)  ( max span addr pos1 xc -- max span addr pos2 )
+    <xins> .all .rest ;
+: xback  ( max span addr pos1 -- max span addr pos2 f )
+    dup  IF  over + xchar- over -  0 max .all .rest
+    ELSE  bell  THEN 0 ;
+: xforw  ( max span addr pos1 -- max span addr pos2 f )
+    2 pick over <> IF  over + xc@+ xemit over -  ELSE  bell  THEN 0 ;
+: (xdel)  ( max span addr pos1 -- max span addr pos2 )
+    over + dup xchar- tuck - >r over -
+    >string over r@ + -rot move
+    rot r> - -rot ;
+: ?xdel ( max span addr pos1 -- max span addr pos2 0 )
+  dup  IF  (xdel) .all 2 spaces .rest  THEN  0 ;
+: <xdel> ( max span addr pos1 -- max span addr pos2 0 )
+  2 pick over <>
+    IF  xforw drop (xdel) .all 2 spaces .rest
+    ELSE  bell  THEN  0 ;
+: xeof  2 pick over or 0=  IF  bye  ELSE  <xdel>  THEN ;
+
+: xfirst-pos  ( max span addr pos1 -- max span addr 0 0 )
+  drop 0 .all .rest 0 ;
+: xend-pos  ( max span addr pos1 -- max span addr span 0 )
+  drop over .all 0 ;
+
+
+: xclear-line ( max span addr pos1 -- max addr )
+    drop restore-cursor swap spaces restore-cursor ;
+: xclear-tib ( max span addr pos -- max 0 addr 0 false )
+    xclear-line 0 tuck dup ;
+
+: (xenter)  ( max span addr pos1 -- max span addr pos2 true )
+    >r end^ 2@ hist-setpos
+    2dup swap history write-line drop ( throw ) \ don't worry about errors
+    hist-pos 2dup backward^ 2! end^ 2!
+    r> .all space true ;
+
+: xkill-expand ( max span addr pos1 -- max span addr pos2 )
+    prefix-found cell+ @ ?dup IF  >r
+	r@ - >string over r@ + -rot move
+	rot r@ - -rot .all r> spaces .rest THEN ;
+
+: insert   ( string length buffer size -- )
+    rot over min >r  r@ - ( left over )
+    over dup r@ +  rot move   r> move  ;
+
+: xtab-expand ( max span addr pos1 -- max span addr pos2 0 )
+    key? IF  #tab (xins) 0  EXIT  THEN
+    xkill-expand 2dup extract-word dup 0= IF  nip EXIT  THEN
+    search-prefix tib-full?
+    IF    bell  2drop  prefix-off
+    ELSE  dup >r
+	2>r >string r@ + 2r> 2swap insert
+	r@ + rot r> + -rot
+    THEN
+    prefix-found @ IF  bl (xins)  ELSE  .all .rest  THEN  0 ;
+
+: xchar-history ( -- )
+    ['] xforw        ctrl F bindkey
+    ['] xback        ctrl B bindkey
+    ['] ?xdel        ctrl H bindkey
+    ['] xeof         ctrl D bindkey
+    ['] <xdel>       ctrl X bindkey
+    ['] xclear-tib   ctrl K bindkey
+    ['] xfirst-pos   ctrl A bindkey
+    ['] xend-pos     ctrl E bindkey
+    ['] (xenter)     #lf    bindkey
+    ['] (xenter)     #cr    bindkey
+    ['] xtab-expand  #tab   bindkey
+    ['] (xins)       IS insert-char
+    ['] kill-prefix  IS everychar
+    ['] save-cursor  IS everyline ;
 
-utf-8-cold
+xchar-history
 
 \ initializing history