--- gforth/history.fs 2007/12/31 17:34:58 1.68 +++ gforth/history.fs 2011/01/01 14:33:03 1.75 @@ -1,12 +1,12 @@ \ 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 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License -\ as published by the Free Software Foundation; either version 2 +\ as published by the Free Software Foundation, either version 3 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. : ctrl-i ( "" -- c ) char toupper $40 xor ; @@ -207,7 +206,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 @@ -277,11 +278,8 @@ 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 @@ -294,9 +292,11 @@ require utf-8.fs 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 @@ -315,7 +315,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 @@ -324,7 +324,9 @@ require utf-8.fs ['] xtab-expand #tab bindkey ['] (xins) IS insert-char ['] kill-prefix IS everychar +[ifdef] everyline ['] linew-off IS everyline +[endif] ['] xback-restore IS back-restore ['] xcur-correct IS cur-correct ;