--- gforth/history.fs	2007/05/05 17:26:02	1.51
+++ gforth/history.fs	2007/07/01 11:32:44	1.59
@@ -70,7 +70,9 @@ s" os-class" environment? [IF] s" unix"
 \ moving in history file                               16oct94py
 
 defer back-restore ( u -- )
-' backspaces is back-restore
+defer cur-correct ( addr u -- )
+' backspaces IS back-restore
+' 2drop IS cur-correct
 
 [IFDEF] x-width
 : clear-line ( max span addr pos1 -- max addr )
@@ -93,7 +95,7 @@ defer back-restore ( u -- )
   forward^ 2@ 2dup hist-setpos backward^ 2!
   2dup get-line drop
   hist-pos  forward^ 2!
-  tuck 2dup type 0 ;
+  tuck 2dup type 2dup cur-correct 0 ;
 
 : find-prev-line ( max addr -- max span addr pos2 )
   backward^ 2@ forward^ 2!
@@ -105,7 +107,7 @@ defer back-restore ( u -- )
   REPEAT  2drop  THEN  tuck ;
 
 : 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,
 
@@ -199,28 +201,44 @@ require utf-8.fs
 [IFUNDEF] #esc  27 Constant #esc  [THEN]
 
 Variable curpos
+Variable screenw
 
+: 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 ;
-: cur-correct  ( addr u -- )  x-width curpos @ + cursor@ -
-    form nip >r  r@ 2/ + r@ / r> * negate curpos +! ;
+: cursor@ ( -- n )  at-xy? screenw @ * + ;
+: cursor! ( n -- )  screenw @ /mod at-xy ;
+: xcur-correct  ( addr u -- )
+    cygwin? curpos @ -1 = or  IF  2drop EXIT  THEN
+    x-width curpos @ + cursor@ -
+    screenw @ >r  r@ 2/ + r@ / r> * negate curpos +! ;
+: save-cursor ( -- )
+    cygwin? IF  #esc emit '7 emit  ELSE
+	key? IF  -1  ELSE  form nip screenw ! 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 )
+    key? ?EXIT
     restore-cursor 2dup type 2dup cur-correct ;
 : .all ( span addr pos1 -- span addr pos1 )
+    key? ?EXIT
     restore-cursor >r 2dup swap type 2dup swap cur-correct r> ;
 : xback-restore ( u -- )
-    drop restore-cursor ;
+    drop key? ?EXIT
+    restore-cursor ;
+
+: xretype ( max span addr pos1 -- max span addr pos1 )
+    restore-cursor screenw @ >r save-cursor
+    .all 2 pick r@ / screenw @ r> - * 0 max spaces .rest false ;
 
 \ 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.
@@ -232,7 +250,7 @@ Variable curpos
     2dup chars + r@ swap r@ xc-size xc!+? 2drop drop
     r> xc-size >r  rot r@ chars + -rot r> chars + ;
 : (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 )
     dup  IF  over + xchar- over -  0 max .all .rest
     ELSE  bell  THEN 0 ;
@@ -265,7 +283,11 @@ Variable curpos
     >r end^ 2@ hist-setpos
     2dup swap history write-line drop ( throw ) \ don't worry about errors
     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 )
     prefix-found cell+ @ ?dup IF  >r
@@ -296,6 +318,7 @@ Variable curpos
     ['] xclear-tib   ctrl K bindkey
     ['] xfirst-pos   ctrl A bindkey
     ['] xend-pos     ctrl E bindkey
+    ['] xretype      bl     bindkey
     history IF  ['] (xenter)     #lf    bindkey  THEN
     history IF  ['] (xenter)     #cr    bindkey  THEN
     ['] xtab-expand  #tab   bindkey
@@ -303,6 +326,7 @@ Variable curpos
     ['] kill-prefix  IS everychar
     ['] save-cursor  IS everyline
     ['] xback-restore IS back-restore
+    ['] xcur-correct  IS cur-correct
 ;
 
 xchar-history