Merge pull request #28 from philburk/fixdevid
[pforth] / fth / save-input.fth
CommitLineData
08689895
HE
1\ SAVE-INPUT and RESTORE-INPUT
2
3anew task-save-input.fth
4
5private{
6
7: save-buffer ( -- column source-id 2 ) >in @ source-id 2 ;
8
9: restore-column ( column -- flag )
09d08b41
HE
10 source nip over <
11 IF drop true
12 ELSE >in ! false
13 THEN
08689895
HE
14;
15
16\ Return the file-position of the beginning of the current line in
17\ file SOURCE-ID. Assume that the current line is stored in SOURCE
18\ and that the current file-position is at an end-of-line (or
19\ end-of-file).
20: line-start-position ( -- ud )
09d08b41
HE
21 source-id file-position throw
22 \ unless at end-of-file, subtract newline
23 source-id file-size throw 2over d= 0= IF 1 s>d d- THEN
24 \ subtract line length
25 source nip s>d d-
08689895
HE
26;
27
28: save-file ( column line filepos:ud source-id 5 -- )
09d08b41
HE
29 >in @
30 source-line-number@
31 line-start-position
32 source-id
33 5
08689895
HE
34;
35
36: restore-file ( column line filepos:ud -- flag )
09d08b41
HE
37 source-id reposition-file IF 2drop true exit THEN
38 refill 0= IF 2drop true exit THEN
39 source-line-number!
40 restore-column
08689895
HE
41;
42
43: ndrop ( n*x n -- ) 0 ?do drop loop ;
44
45}private
46
47\ Source Stack
48\ EVALUATE >IN SourceID=(-1) 2
49\ keyboard >IN SourceID=(0) 2
50\ file >IN lineNumber filePos SourceID=(fileID) 5
51: SAVE-INPUT ( -- column {line filepos}? source-id n )
09d08b41
HE
52 source-id case
53 -1 of save-buffer endof
54 0 of save-buffer endof
55 drop save-file exit
56 endcase
08689895
HE
57;
58
59: RESTORE-INPUT ( column {line filepos}? source-id n -- flag )
09d08b41
HE
60 over source-id <> IF ndrop true exit THEN
61 drop
62 case
63 -1 of restore-column endof
64 0 of restore-column endof
65 drop restore-file exit
66 endcase
08689895
HE
67;
68
69privatize