[gforth] / gforth / history.fs  

gforth: gforth/history.fs

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

version 1.49, Tue Nov 28 09:37:33 2006 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,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 70 
Line 70 
 \ moving in history file                               16oct94py  \ moving in history file                               16oct94py
   
 defer back-restore ( u -- )  defer back-restore ( u -- )
 ' backspaces is back-restore  defer cur-correct ( addr u -- )
   ' backspaces IS back-restore
   ' 2drop IS cur-correct
   
 [IFDEF] x-width  [IFDEF] x-width
 : clear-line ( max span addr pos1 -- max addr )  : clear-line ( max span addr pos1 -- max addr )
Line 93 
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 105 
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 198 
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 -- )  : xback-restore ( u -- )
     drop restore-cursor ;      drop key? ?EXIT
       restore-cursor ;
   
 \ In the following, addr max is the buffer, addr span is the current  \ 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.  \ string in the buffer, and pos1 is the cursor position in the buffer.
Line 288 
Line 331 
     ['] kill-prefix  IS everychar      ['] kill-prefix  IS everychar
     ['] save-cursor  IS everyline      ['] save-cursor  IS everyline
     ['] xback-restore IS back-restore      ['] xback-restore IS back-restore
       ['] xcur-correct  IS cur-correct
 ;  ;
   
 xchar-history  xchar-history

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help