--- gforth/history.fs 2007/06/09 21:41:29 1.55 +++ gforth/history.fs 2007/06/30 23:00:14 1.58 @@ -201,8 +201,8 @@ require utf-8.fs [IFUNDEF] #esc 27 Constant #esc [THEN] Variable curpos +Variable screenw -s" os-type" environment? [IF] s" cygwin" str= [IF] : cygwin? ( -- flag ) s" TERM" getenv s" cygwin" str= ; : at-xy? ( -- x y ) key? drop @@ -212,32 +212,19 @@ s" os-type" environment? [IF] s" cygwin" 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 ; +: cursor@ ( -- n ) at-xy? screenw @ * + ; +: cursor! ( n -- ) screenw @ /mod at-xy ; : xcur-correct ( addr u -- ) - cygwin? IF 2drop EXIT THEN + cygwin? curpos @ -1 = or IF 2drop EXIT THEN x-width curpos @ + cursor@ - - form nip >r r@ 2/ + r@ / r> * negate curpos +! ; + screenw @ >r r@ 2/ + r@ / r> * negate curpos +! ; : save-cursor ( -- ) - cygwin? IF #esc emit '7 emit ELSE cursor@ curpos ! THEN ; + 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 @ 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] + cygwin? IF #esc emit '8 emit ELSE + curpos @ dup -1 = IF drop ELSE cursor! THEN THEN ; + ' xcur-correct IS cur-correct : .rest ( addr pos1 -- addr pos1 ) @@ -250,6 +237,10 @@ s" os-type" environment? [IF] s" cygwin" drop key? ?EXIT restore-cursor ; +: xretype ( max span addr pos1 -- max span addr pos1 ) + restore-cursor screenw @ >r save-cursor + .all 2 pick r@ / 1+ 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. @@ -293,7 +284,11 @@ s" os-type" environment? [IF] s" cygwin" >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 @@ -324,6 +319,7 @@ s" os-type" environment? [IF] s" cygwin" ['] 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