--- gforth/history.fs 2007/09/30 20:21:44 1.64 +++ gforth/history.fs 2011/01/29 21:56:47 1.76 @@ -1,12 +1,12 @@ \ command line edit and history support 16oct94py -\ Copyright (C) 1995,2000,2003,2004,2005,2006 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,13 +15,14 @@ \ 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 ; + +' ctrl-i :noname - char [char] @ - ; -:noname - char [char] @ - postpone Literal ; + ctrl-i postpone Literal ; interpret/compile: ctrl ( "" -- ctrl-code ) \ command line editing 16oct94py @@ -76,8 +77,7 @@ defer cur-correct ( addr u -- ) Variable linew Variable screenw - -: linew-off linew off form nip screenw ! ; +: linew-off linew off cols screenw ! ; [IFDEF] x-width : clear-line ( max span addr pos1 -- max addr ) @@ -206,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 @@ -230,6 +232,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 ; @@ -237,7 +241,7 @@ require utf-8.fs linew @ xback-restore >r 2dup swap type 2dup swap cur-correct r> ; : xretype ( max span addr pos1 -- max span addr pos1 f ) - .all form nip screenw @ >r screenw ! + .all cols screenw @ >r screenw ! linew @ screenw @ / linew @ r@ / max screenw @ r> - * 0 max dup spaces linew +! .rest false ; @@ -276,11 +280,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 @@ -293,9 +294,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 @@ -314,7 +317,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 @@ -323,7 +326,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 ;