Diff for /gforth/history.fs between versions 1.51 and 1.56

version 1.51, 2007/05/05 17:26:02 version 1.56, 2007/06/16 20:47:00
Line 70  s" os-class" environment? [IF] s" unix" Line 70  s" os-class" environment? [IF] s" unix"
 \ 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  defer back-restore ( u -- ) Line 95  defer back-restore ( u -- )
   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  defer back-restore ( u -- ) Line 107  defer back-restore ( u -- )
   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 200  require utf-8.fs Line 202  require utf-8.fs
   
 Variable curpos  Variable curpos
   
   : cygwin? ( -- flag ) s" TERM" getenv s" cygwin" str= ;
 : at-xy? ( -- x y )  : at-xy? ( -- x y )
     key? drop      key? drop
     #esc emit ." [6n"  0 0      #esc emit ." [6n"  0 0
Line 210  Variable curpos Line 213  Variable curpos
     REPEAT  drop 1- swap 1- ;      REPEAT  drop 1- swap 1- ;
 : cursor@ ( -- n )  at-xy? form nip * + ;  : cursor@ ( -- n )  at-xy? form nip * + ;
 : cursor! ( n -- )  form nip /mod at-xy ;  : cursor! ( n -- )  form nip /mod at-xy ;
 : cur-correct  ( addr u -- )  x-width curpos @ + cursor@ -  : xcur-correct  ( addr u -- )
       cygwin? IF  2drop EXIT  THEN
       x-width curpos @ + cursor@ -
     form nip >r  r@ 2/ + r@ / r> * negate curpos +! ;      form nip >r  r@ 2/ + r@ / r> * negate curpos +! ;
   : save-cursor ( -- )
       cygwin? IF  #esc emit '7 emit  ELSE
           key? IF  -1  ELSE  cursor@  THEN  curpos !  THEN ;
   : restore-cursor ( -- )
       cygwin? IF  #esc emit '8 emit  ELSE
           curpos @ dup -1 = IF  drop  ELSE   cursor!  THEN  THEN ;
   
   ' xcur-correct IS cur-correct
   
 : save-cursor ( -- )  cursor@ curpos ! ;  
 : restore-cursor ( -- )  curpos @ cursor! ;  
 : .rest ( addr pos1 -- addr pos1 )  : .rest ( addr pos1 -- addr pos1 )
       key? ?EXIT
     restore-cursor 2dup type 2dup cur-correct ;      restore-cursor 2dup type 2dup cur-correct ;
 : .all ( span addr pos1 -- span addr pos1 )  : .all ( span addr pos1 -- span addr pos1 )
       key? ?EXIT
     restore-cursor >r 2dup swap type 2dup swap cur-correct r> ;      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 232  Variable curpos Line 246  Variable curpos
     2dup chars + r@ swap r@ xc-size xc!+? 2drop drop      2dup chars + r@ swap r@ xc-size xc!+? 2drop drop
     r> xc-size >r  rot r@ chars + -rot r> chars + ;      r> xc-size >r  rot r@ chars + -rot r> chars + ;
 : (xins)  ( max span addr pos1 xc -- max span addr pos2 )  : (xins)  ( max span addr pos1 xc -- max span addr pos2 )
     <xins> key? ?EXIT .all .rest ;      <xins> .all .rest ;
 : xback  ( max span addr pos1 -- max span addr pos2 f )  : xback  ( max span addr pos1 -- max span addr pos2 f )
     dup  IF  over + xchar- over -  0 max .all .rest      dup  IF  over + xchar- over -  0 max .all .rest
     ELSE  bell  THEN 0 ;      ELSE  bell  THEN 0 ;
Line 265  Variable curpos Line 279  Variable curpos
     >r end^ 2@ hist-setpos      >r end^ 2@ hist-setpos
     2dup swap history write-line drop ( throw ) \ don't worry about errors      2dup swap history write-line drop ( throw ) \ don't worry about errors
     hist-pos 2dup backward^ 2! end^ 2!      hist-pos 2dup backward^ 2! end^ 2!
     r> .all space true ;      r> curpos @ -1 = key? or IF
           >r 2dup swap type r>
       ELSE
           .all
       THEN space true ;
   
 : xkill-expand ( max span addr pos1 -- max span addr pos2 )  : xkill-expand ( max span addr pos1 -- max span addr pos2 )
     prefix-found cell+ @ ?dup IF  >r      prefix-found cell+ @ ?dup IF  >r
Line 303  Variable curpos Line 321  Variable curpos
     ['] 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

Removed from v.1.51  
changed lines
  Added in v.1.56


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