Annotation of gforth/kernel-ec/saccept.fs, revision 1.2
1.1 pazsan 1: \ a very simple accept approach
2:
1.2 ! anton 3: \ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2006,2007,2010,2012 Free Software Foundation, Inc.
1.1 pazsan 4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation, either version 3
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program. If not, see http://www.gnu.org/licenses/.
19:
20: require ./io.fs
21:
22: \ : xon $11 emit ;
23: \ : xoff $13 emit ;
24:
25: Variable eof
26: Variable echo -1 echo !
27:
28: : accept ( adr len -- len )
29: ( xon ) over + over ( start end pnt ) eof off
30: BEGIN
31: key dup #del = IF drop #bs THEN
32: dup bl u<
33: IF
34: dup #cr = over #lf = or IF
35: echo @ IF space THEN drop nip swap - ( xoff ) EXIT THEN
36: dup #eof = IF eof on THEN
37: #bs = IF 2 pick over <>
38: IF 1 chars -
39: echo @ IF #bs emit bl emit #bs emit THEN
40: ELSE echo @ IF bell THEN THEN THEN
41: ELSE >r 2dup <> IF r>
42: echo @ IF dup emit THEN
43: over c! char+ ELSE r> drop bell THEN
44: THEN
45: AGAIN ;
46:
47: \ simple include for terminal.fs
48:
49: : refill-loop ( -- )
50: BEGIN 3 emit refill WHILE interpret REPEAT ;
51: : included ( addr u -- )
52: 2 emit dup $20 + emit type
53: echo @ IF
54: echo off ['] refill-loop catch
55: dup IF 4 emit THEN echo on throw
56: THEN ;
57: : include ( "file" -- ) parse-name included ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>