--- gforth/kernel/saccept.fs 1998/12/08 22:03:13 1.3 +++ gforth/kernel/saccept.fs 2006/05/27 21:19:25 1.13 @@ -1,6 +1,6 @@ \ a very simple accept approach -\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,1999,2000,2003 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -16,17 +16,32 @@ \ 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., 675 Mass Ave, Cambridge, MA 02139, USA. +\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. + +require ./io.fs + +\ : xon $11 emit ; +\ : xoff $13 emit ; + +Variable eof +Variable echo -1 echo ! : accept ( adr len -- len ) - over + over ( start end pnt ) + ( xon ) over + over ( start end pnt ) eof off BEGIN key dup #del = IF drop #bs THEN dup bl u< - IF dup #cr = over #lf = or IF space drop nip swap - EXIT THEN - #bs = IF 3 pick over <> - IF 1 chars - #bs emit bl emit #bs emit ELSE bell THEN THEN - ELSE >r 2dup <> IF r> dup emit over c! char+ ELSE r> drop bell THEN + IF + dup #cr = over #lf = or IF + echo @ IF space THEN drop nip swap - ( xoff ) EXIT THEN + dup #eof = IF eof on THEN + #bs = IF 2 pick over <> + IF 1 chars - + echo @ IF #bs emit bl emit #bs emit THEN + ELSE echo @ IF bell THEN THEN THEN + ELSE >r 2dup <> IF r> + echo @ IF dup emit THEN + over c! char+ ELSE r> drop bell THEN THEN AGAIN ;