Diff for /gforth/history.fs between versions 1.46 and 1.52

version 1.46, 2006/02/19 17:27:12 version 1.52, 2007/05/05 17:27:40
Line 1 Line 1
 \ command line edit and history support                 16oct94py  \ command line edit and history support                 16oct94py
   
 \ Copyright (C) 1995,2000,2003,2004,2005 Free Software Foundation, Inc.  \ Copyright (C) 1995,2000,2003,2004,2005,2006 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 72  s" os-class" environment? [IF] s" unix" Line 72  s" os-class" environment? [IF] s" unix"
 defer back-restore ( u -- )  defer back-restore ( u -- )
 ' backspaces is back-restore  ' backspaces is back-restore
   
   [IFDEF] x-width
 : clear-line ( max span addr pos1 -- max addr )  : clear-line ( max span addr pos1 -- max addr )
   back-restore over over swap x-width spaces swap back-restore ;    back-restore over over swap x-width spaces swap back-restore ;
   [ELSE]
   : clear-line ( max span addr pos1 -- max addr )
     back-restore over spaces swap back-restore ;
   [THEN]
 \ : clear-tib ( max span addr pos -- max 0 addr 0 false )  \ : clear-tib ( max span addr pos -- max 0 addr 0 false )
 \   clear-line 0 tuck dup ;  \   clear-line 0 tuck dup ;
   
Line 194  require utf-8.fs Line 198  require utf-8.fs
   
 [IFUNDEF] #esc  27 Constant #esc  [THEN]  [IFUNDEF] #esc  27 Constant #esc  [THEN]
   
 : save-cursor ( -- )  #esc emit '7 emit ;  Variable curpos
 : restore-cursor ( -- )  #esc emit '8 emit ;  
   : at-xy? ( -- x y )
       key? drop
       #esc emit ." [6n"  0 0
       BEGIN  key dup 'R <>  WHILE
               dup '; = IF  drop  swap  ELSE
                   dup '0 '9 1+ within  IF  '0 - swap 10 * +  ELSE
                       drop  THEN  THEN
       REPEAT  drop 1- swap 1- ;
   : cursor@ ( -- n )  at-xy? form nip * + ;
   : cursor! ( n -- )  form nip /mod at-xy ;
   : cur-correct  ( addr u -- )  x-width curpos @ + cursor@ -
       form nip >r  r@ 2/ + r@ / r> * negate curpos +! ;
   
   : save-cursor ( -- )  cursor@ curpos ! ;
   : restore-cursor ( -- )  curpos @ cursor! ;
 : .rest ( addr pos1 -- addr pos1 )  : .rest ( addr pos1 -- addr pos1 )
     restore-cursor 2dup type ;      restore-cursor 2dup type 2dup cur-correct ;
 : .all ( span addr pos1 -- span addr pos1 )  : .all ( span addr pos1 -- span addr pos1 )
     restore-cursor >r 2dup swap type r> ;      key? IF  rdrop  EXIT  THEN
       restore-cursor >r 2dup swap type 2dup swap cur-correct r> ;
 : xback-restore ( u -- )  : xback-restore ( u -- )
     drop restore-cursor ;      drop restore-cursor ;
   
Line 277  require utf-8.fs Line 297  require utf-8.fs
     ['] xclear-tib   ctrl K bindkey      ['] xclear-tib   ctrl K bindkey
     ['] xfirst-pos   ctrl A bindkey      ['] xfirst-pos   ctrl A bindkey
     ['] xend-pos     ctrl E bindkey      ['] xend-pos     ctrl E bindkey
     ['] (xenter)     #lf    bindkey      history IF  ['] (xenter)     #lf    bindkey  THEN
     ['] (xenter)     #cr    bindkey      history IF  ['] (xenter)     #cr    bindkey  THEN
     ['] xtab-expand  #tab   bindkey      ['] xtab-expand  #tab   bindkey
     ['] (xins)       IS insert-char      ['] (xins)       IS insert-char
     ['] kill-prefix  IS everychar      ['] kill-prefix  IS everychar
Line 295  xchar-history Line 315  xchar-history
     ?dup-if      ?dup-if
         \ !! >stderr          \ !! >stderr
         \ history-file type ." : " .error cr          \ history-file type ." : " .error cr
         drop 2drop          drop 2drop 0 to history
         ['] false ['] false ['] (ret)          ['] false ['] false ['] (ret)
     else      else
         to history          to history
Line 312  xchar-history Line 332  xchar-history
 : history-cold ( -- )  : history-cold ( -- )
     history-file get-history xchar-history ;      history-file get-history xchar-history ;
   
 ' history-cold INIT8 chained  :noname ( -- )
       defers 'cold
       history-cold
   ; is 'cold
   
 history-cold  history-cold
   

Removed from v.1.46  
changed lines
  Added in v.1.52


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