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

version 1.50, 2006/12/31 13:39:13 version 1.51, 2007/05/05 17:26:02
Line 198  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> ;      restore-cursor >r 2dup swap type 2dup swap cur-correct r> ;
 : xback-restore ( u -- )  : xback-restore ( u -- )
     drop restore-cursor ;      drop restore-cursor ;
   
Line 217  require utf-8.fs Line 232  require utf-8.fs
     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> .all .rest ;      <xins> key? ?EXIT .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 ;

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


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