--- gforth/history.fs 2007/09/30 19:46:10 1.63 +++ gforth/history.fs 2007/12/31 18:40:24 1.69 @@ -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 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,13 +206,13 @@ require utf-8.fs [IFUNDEF] #esc 27 Constant #esc [THEN] -: at-deltaxy ( dx dy -- ) +: at-deltaxy ( dx dy -- ) base @ >r decimal ?dup IF #esc emit '[ emit dup abs 0 .r 0< IF 'A ELSE 'B THEN emit THEN ?dup IF #esc emit '[ emit dup abs 0 .r 0< IF 'D ELSE 'C THEN emit - THEN ; + THEN r> base ! ; \ : cygwin? ( -- flag ) s" TERM" getenv s" cygwin" str= ; \ : at-xy? ( -- x y ) @@ -237,7 +237,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 ; @@ -252,7 +252,7 @@ require utf-8.fs 2dup chars + r@ swap r@ xc-size xc!+? 2drop drop r> xc-size >r rot r@ chars + -rot r> chars + ; : (xins) ( max span addr pos1 xc -- max span addr pos2 ) - .all .rest ; + key? 0= IF .all .rest THEN ; : xback ( max span addr pos1 -- max span addr pos2 f ) dup IF over + xchar- over - 0 max .all .rest ELSE bell THEN 0 ;