1
unit multfile; (* DPL 2004-03-06
2
(* Support for including files into an input stream.
3
(* Intended for an application that does not require Pascal formatting,
4
(* but reads complete lines one at a time.
5
(* You never actually work with any files, except by supplying the
6
( filename when the file is opened.
7
(* At any stage, you can switch the input to a new file.
8
(* When the new file is at EOF, and a "read" is issued, the file is
9
(* closed and the previous one resumed transparently. This inclusion
10
(* can be nested to any level, memory permitting.
11
(* --- Normal mode of operation, replacing the usual Pascal style ---
12
Instead of: assign(textfile,filename); reset(textfile)
13
use: pushFile(filename)
14
When another file should be included before the current file is done,
15
use: pushFile(newfilename)
16
Instead of: readln(textfile,line)
18
Instead of: eof(textfilen)
19
or: eofAll; {Are all files at EOF?}
20
(* --- Abnormal mode of operation ---
21
To abort a file before EOF is reached:
25
To test whether only the current file is at EOF:
27
(* Additional features:
28
fileError: boolean function, was there an error during file open or read?
29
currentFilename: string function, name of current file
30
currentLineNo: integer function, number of line just read from current file
31
isEmpty(var s: string): boolean function, is s empty?
32
readData: string function, like readLine, but continue reading until
33
a non-blank line is found, return blank only at EOF
34
skipBlanks: skip blank lines in input: next call to readLine will be
35
non-blank unless EOF is encountered
36
report(items): procedure to control which messages are printed,
37
"items" is the sum of the following options
38
(constants with the appropriate values are defined in the interface)
39
1: reportnewfile - file is opened
40
2: reportoldfile - file is resumed
41
4: reportclose - file is closed
42
8: reporterror - a file error is encountered
43
16: reportrecursive - there is a recursive include
44
The default value is items=27 (all the above except reportclose)
45
At present you cannot turn reportrecursive off.
49
procedure pushFile(filename: string);
52
procedure report(items: integer);
53
function currentFilename: string;
54
function eofAll: boolean;
55
function eofCurrent: boolean;
56
function fileError: boolean;
57
function readLine: string;
58
function readData: string;
59
function isEmpty(var s: string): boolean;
60
function currentLineNo: integer;
62
const nextData: string = '';
74
pfilenode = ^filenode;
82
const current: pfilenode = NIL;
83
inputerror: boolean = false;
84
reportitem: integer = reportnewfile + reportoldfile
85
+ reporterror + reportrecursive;
87
procedure report(items: integer); begin reportitem := items end;
89
function recursive (filename: string): boolean;
90
var previous: pfilenode;
91
begin if current=NIL then begin recursive:=false; exit; end;
92
previous := current; recursive:=true;
93
while previous <> NIL do
95
if filename=previous^.name then exit;
96
previous := previous^.prev;
101
procedure pushFile(filename: string);
102
var newnode: pfilenode;
104
if recursive(filename) then
105
begin writeln('===! Ignoring recursive include of file ',filename); exit;
107
new(newnode); newnode^.name := filename; newnode^.prev := current;
108
newnode^.lineno := 0;
110
assign(newnode^.actualfile,filename); reset(newnode^.actualfile);
112
inputerror := ioresult<>0;
113
if inputerror then dispose(newnode) else current := newnode;
114
if not inputerror and ((reportitem and reportnewfile)>0) then writeln
115
('==>> Input from file ',currentFilename);
116
if inputerror and ((reportitem and reporterror)>0) then writeln
117
('==!! Could not open file ',filename);
121
var previous: pfilenode;
122
begin if current=NIL then exit;
123
if (reportitem and reportclose)>0 then writeln
124
('==>> Closing file ',currentFilename,' at line number ', currentLineNo:1);
125
close(current^.actualfile); previous := current^.prev; dispose(current);
127
if (current<>NIL) and ((reportitem and reportoldfile)>0) then writeln
128
('==>> Resuming input from file ',currentFilename,' at line number ',
132
procedure closeAll; begin repeat popFile until current=NIL; end;
134
function eofCurrent: boolean;
135
begin eofCurrent := eof(current^.actualfile);
138
function readLine: string;
140
begin if nextData<>'' then
141
begin readLine:=nextData; nextData:=''; exit end;
142
if eofAll then begin readLine:=''; exit end;
144
readln(current^.actualfile,s); readLine:=s;
146
inputerror := ioresult<>0;
147
if not inputerror then inc(current^.lineno);
148
if inputerror and ((reportitem and reporterror)>0) then writeln
149
('==!! Could not read from file ',currentFilename);
152
function isEmpty(var s: string): boolean;
154
begin if length(s)=0 then begin isEmpty:=true; exit; end;
155
for i:=1 to length(s) do if s[i]<>' ' then
156
begin isEmpty:=false; exit; end;
160
function readData: string;
162
begin if not isEmpty(nextData) then
163
begin readData:=nextData; nextData:=''; exit end;
166
if not isEmpty(s) then begin readData:=s; exit end;
171
procedure skipBlanks;
172
begin while nextData='' do
173
begin nextData:=readData; if eofAll then exit
177
function eofAll: boolean;
178
begin eofAll := true;
179
if current=NIL then exit else
180
if eofCurrent then begin popFile; eofAll:=eofAll; exit end;
184
function currentLineNo: integer;
185
begin if current = NIL then currentLineNo := 0
186
else currentLineNo := current^.lineno;
189
function currentFilename: string;
190
begin if current = NIL then currentFilename := 'No file open yet'
191
else currentFilename := current^.name;
194
function fileError: boolean; begin fileError := inputerror; end;
added
removed
utils/mtx/mtx-0.60d/multfile.pas
