--- gforth/history.fs 2008/02/12 16:44:58 1.70 +++ gforth/history.fs 2012/04/06 16:50:03 1.78 @@ -1,6 +1,6 @@ \ command line edit and history support 16oct94py -\ Copyright (C) 1995,2000,2003,2004,2005,2006,2007 Free Software Foundation, Inc. +\ Copyright (C) 1995,2000,2003,2004,2005,2006,2007,2008,2010,2011 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -118,10 +118,11 @@ Variable screenw \ Create lfpad #lf c, : (enter) ( max span addr pos1 -- max span addr pos2 true ) - >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> (ret) ; + >r 2dup swap -trailing nip IF + end^ 2@ hist-setpos + 2dup swap history write-line drop + hist-pos 2dup backward^ 2! end^ 2! + THEN r> (ret) ; : extract-word ( addr len -- addr' len' ) dup >r BEGIN 1- dup 0>= WHILE 2dup + c@ bl = UNTIL THEN 1+ @@ -206,7 +207,9 @@ require utf-8.fs [IFUNDEF] #esc 27 Constant #esc [THEN] -: at-deltaxy ( dx dy -- ) base @ >r decimal +: at-deltaxy ( dx dy -- ) + over 0< over 0= and IF drop abs backspaces EXIT THEN + base @ >r decimal ?dup IF #esc emit '[ emit dup abs 0 .r 0< IF 'A ELSE 'B THEN emit THEN @@ -230,6 +233,8 @@ require utf-8.fs ' xcur-correct IS cur-correct : xback-restore ( u -- ) + dup screenw @ mod 0= IF 1- 0 max THEN + \ correction for line=screenw, no wraparound then! screenw @ /mod negate swap negate swap at-deltaxy ; : .rest ( addr pos1 -- addr pos1 ) linew @ xback-restore 2dup type 2dup cur-correct ; @@ -276,26 +281,26 @@ require utf-8.fs : xend-pos ( max span addr pos1 -- max span addr span 0 ) drop over .all 0 ; - -: xclear-line ( max span addr pos1 -- max addr ) - 2dup x-width dup xback-restore dup spaces xback-restore drop nip ; -: xclear-tib ( max span addr pos -- max 0 addr 0 false ) - xclear-line 0 tuck dup ; +: xclear-rest ( max span addr pos -- max pos addr pos false ) + rot >r tuck 2dup r> swap /string u8width dup spaces linew +! .all 0 ; : (xenter) ( max span addr pos1 -- max span addr pos2 true ) - >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 2dup swap -trailing nip IF + end^ 2@ hist-setpos + 2dup swap history write-line drop ( throw ) \ don't worry about errors + hist-pos 2dup backward^ 2! end^ 2! + THEN r> .all space true ; : xkill-expand ( max span addr pos1 -- max span addr pos2 ) prefix-found cell+ @ ?dup IF >r r@ - >string over r@ + -rot move rot r@ - -rot .all r@ spaces r> back-restore .rest THEN ; +[IFUNDEF] insert : insert ( string length buffer size -- ) rot over min >r r@ - ( left over ) over dup r@ + rot move r> move ; +[THEN] : xtab-expand ( max span addr pos1 -- max span addr pos2 0 ) key? IF #tab (xins) 0 EXIT THEN @@ -314,7 +319,7 @@ require utf-8.fs ['] ?xdel ctrl H bindkey ['] xeof ctrl D bindkey ['] ctrl X bindkey - ['] xclear-tib ctrl K bindkey + ['] xclear-rest ctrl K bindkey ['] xfirst-pos ctrl A bindkey ['] xend-pos ctrl E bindkey ['] xretype ctrl L bindkey