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 |