Diff for /gforth/history.fs between versions 1.55 and 1.57

version 1.55, 2007/06/09 21:41:29 version 1.57, 2007/06/17 19:26:42
Line 202  require utf-8.fs Line 202  require utf-8.fs
   
 Variable curpos  Variable curpos
   
 s" os-type" environment? [IF] s" cygwin" str= [IF]  
 : cygwin? ( -- flag ) s" TERM" getenv s" cygwin" str= ;  : cygwin? ( -- flag ) s" TERM" getenv s" cygwin" str= ;
 : at-xy? ( -- x y )  : at-xy? ( -- x y )
     key? drop      key? drop
Line 215  s" os-type" environment? [IF] s" cygwin" Line 214  s" os-type" environment? [IF] s" cygwin"
 : 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 ;
 : xcur-correct  ( addr u -- )  : xcur-correct  ( addr u -- )
     cygwin? IF  2drop EXIT  THEN      cygwin? curpos @ -1 = or  IF  2drop EXIT  THEN
     x-width curpos @ + cursor@ -      x-width curpos @ + cursor@ -
     form nip >r  r@ 2/ + r@ / r> * negate curpos +! ;      form nip >r  r@ 2/ + r@ / r> * negate curpos +! ;
 : save-cursor ( -- )  : save-cursor ( -- )
     cygwin? IF  #esc emit '7 emit  ELSE  cursor@ curpos !  THEN ;      cygwin? IF  #esc emit '7 emit  ELSE
           key? IF  -1  ELSE  cursor@  THEN  curpos !  THEN ;
 : restore-cursor ( -- )  : restore-cursor ( -- )
     cygwin? IF  #esc emit '8 emit  ELSE  curpos @ cursor!  THEN ;      cygwin? IF  #esc emit '8 emit  ELSE
 [ELSE]          curpos @ dup -1 = IF  drop  ELSE   cursor!  THEN  THEN ;
 : 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  ' xcur-correct IS cur-correct
   
 : .rest ( addr pos1 -- addr pos1 )  : .rest ( addr pos1 -- addr pos1 )
Line 293  s" os-type" environment? [IF] s" cygwin" Line 279  s" os-type" environment? [IF] s" cygwin"
     >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

Removed from v.1.55  
changed lines
  Added in v.1.57


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