[gforth] / gforth / history.fs  

gforth: gforth/history.fs

Diff for /gforth/history.fs between version 1.41 and 1.55

version 1.41, Wed Jan 26 21:41:27 2005 UTC version 1.55, Sat Jun 9 21:41:29 2007 UTC
Line 1 
Line 1 
 \ command line edit and history support                 16oct94py  \ command line edit and history support                 16oct94py
   
 \ Copyright (C) 1995,2000,2003,2004 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 69 
Line 69 
   
 \ moving in history file                               16oct94py  \ moving in history file                               16oct94py
   
 : clear-line ( max span addr pos1 -- max addr )  defer back-restore ( u -- )
   backspaces over spaces swap backspaces ;  defer cur-correct ( addr u -- )
   ' backspaces IS back-restore
   ' 2drop IS cur-correct
   
   [IFDEF] x-width
   : clear-line ( max span addr pos1 -- max addr )
     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 86 
Line 95 
   forward^ 2@ 2dup hist-setpos backward^ 2!    forward^ 2@ 2dup hist-setpos backward^ 2!
   2dup get-line drop    2dup get-line drop
   hist-pos  forward^ 2!    hist-pos  forward^ 2!
   tuck 2dup type 0 ;    tuck 2dup type 2dup cur-correct 0 ;
   
 : find-prev-line ( max addr -- max span addr pos2 )  : find-prev-line ( max addr -- max span addr pos2 )
   backward^ 2@ forward^ 2!    backward^ 2@ forward^ 2!
Line 98 
Line 107 
   REPEAT  2drop  THEN  tuck ;    REPEAT  2drop  THEN  tuck ;
   
 : prev-line  ( max span addr pos1 -- max span addr pos2 false )  : prev-line  ( max span addr pos1 -- max span addr pos2 false )
     clear-line find-prev-line 2dup type 0 ;      clear-line find-prev-line 2dup type 2dup cur-correct 0 ;
   
 \ Create lfpad #lf c,  \ Create lfpad #lf c,
   
Line 191 
Line 200 
   
 [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 ;  
   s" os-type" environment? [IF] s" cygwin" str= [IF]
   : cygwin? ( -- flag ) s" TERM" getenv s" cygwin" str= ;
   : 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 ;
   : xcur-correct  ( addr u -- )
       cygwin? IF  2drop EXIT  THEN
       x-width curpos @ + cursor@ -
       form nip >r  r@ 2/ + r@ / r> * negate curpos +! ;
   : save-cursor ( -- )
       cygwin? IF  #esc emit '7 emit  ELSE  cursor@ curpos !  THEN ;
   : restore-cursor ( -- )
       cygwin? IF  #esc emit '8 emit  ELSE  curpos @ cursor!  THEN ;
   [ELSE]
   : 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 ;
   : xcur-correct  ( addr u -- )  x-width curpos @ + cursor@ -
       form nip >r  r@ 2/ + r@ / r> * negate curpos +! ;
   : save-cursor ( -- )  cursor@ curpos ! ;
   : restore-cursor ( -- )  curpos @ cursor! ;
   [THEN] [THEN]
   ' xcur-correct IS cur-correct
   
 : .rest ( addr pos1 -- addr pos1 )  : .rest ( addr pos1 -- addr pos1 )
     restore-cursor 2dup type ;      key? ?EXIT
       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? ?EXIT
       restore-cursor >r 2dup swap type 2dup swap cur-correct r> ;
   : xback-restore ( u -- )
       drop key? ?EXIT
       restore-cursor ;
   
   \ In the following, addr max is the buffer, addr span is the current
   \ string in the buffer, and pos1 is the cursor position in the buffer.
   
 : <xins>  ( max span addr pos1 xc -- max span addr pos2 )  : <xins>  ( max span addr pos1 xc -- max span addr pos2 )
     >r  2over r@ xc-size + u< IF  ( max span addr pos1 R:xc )      >r  2over r@ xc-size + u< IF  ( max span addr pos1 R:xc )
Line 269 
Line 324 
     ['] 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
     ['] save-cursor  IS everyline ;      ['] save-cursor  IS everyline
       ['] xback-restore IS back-restore
       ['] xcur-correct  IS cur-correct
   ;
   
 xchar-history  xchar-history
   
Line 285 
Line 343 
     ?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 300 
Line 358 
 ;  ;
   
 : history-cold ( -- )  : history-cold ( -- )
     history-file get-history ;      history-file get-history xchar-history ;
   
   :noname ( -- )
       defers 'cold
       history-cold
   ; is 'cold
   
 ' history-cold INIT8 chained  
 history-cold  history-cold
   

Generate output suitable for use with a patch program
Legend:
Removed from v.1.41  
changed lines
  Added in v.1.55
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help