summaryrefslogtreecommitdiff
path: root/Build/source/utils/m-tx/mtx-src/multfile.pas
blob: fb89cca89e0a9eeb52863c963e4bdd35f73e8c59 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
unit multfile;  (* DPL 2004-03-06, 2015-01-16 
(* Support for including files into an input stream.  
(* Intended for an application that does not require Pascal formatting,
(*   but reads complete lines one at a time.
(* You never actually work with any files, except by supplying the
(    filename when the file is opened.
(* At any stage, you can switch the input to a new file. 
(* When the new file is at EOF, and a "read" is issued, the file is
(*   closed and the previous one resumed transparently.    This inclusion 
(*   can be nested to any level, memory permitting.
(* --- Normal mode of operation, replacing the usual Pascal style ---
   Instead of:  assign(textfile,filename); reset(textfile)
          use:  pushFile(filename)
   When another file should be included before the current file is done,
          use:  pushFile(newfilename)
   Instead of:  readln(textfile,line)  
          use:  line:=readLine
   Instead of:  eof(textfilen)
           or:  eofAll;    {Are all files at EOF?}
(* --- Abnormal mode of operation ---
   To abort a file before EOF is reached:
          use:  popFile; 
   To abort all files:
          use:  closeAll;
   To test whether only the current file is at EOF:
          use:  eofCurrent;
(* Additional features:
   fileError: boolean function, was there an error during file open or read?
   currentFilename: string function, name of current file
   currentLineNo: integer function, number of line just read from current file
   isEmpty(var s: string): boolean function, is s empty?
   readData: string function, like readLine, but continue reading until 
     a non-blank line is found, return blank only at EOF
   skipBlanks: skip blank lines in input: next call to readLine will be
     non-blank unless EOF is encountered
   report(items): procedure to control which messages are printed, 
     "items" is the sum of the following options
     (constants with the appropriate values are defined in the interface)
     1: reportnewfile - file is opened
     2: reportoldfile - file is resumed
     4: reportclose - file is closed
     8: reporterror - a file error is encountered 
    16: reportrecursive - there is a recursive include
        The default value is items=27 (all the above except reportclose)
     At present you cannot turn reportrecursive off.
   *)
interface

  procedure pushFile(filename: string);
  procedure popFile;
  procedure closeAll;
  procedure report(items: integer);
  function currentFilename: string;
  function eofAll: boolean;
  function eofCurrent: boolean;
  function fileError: boolean;  
  function readLine: string;
  function readData: string;
  function isEmpty(var s: string): boolean;
  function currentLineNo: integer;
  procedure skipBlanks;
  const nextData: string = '';

const
  reportnewfile = 1;
  reportoldfile = 2;
  reportclose = 4;
  reporterror = 8;
  reportrecursive = 16;

implementation

  type 
  pfilenode = ^filenode;
  filenode = record
    name: string;
    actualfile: text;
    prev: pfilenode;
    lineno: integer;
  end;  

  const current: pfilenode = NIL;
    last_valid_line_no: integer = 0;
    inputerror: boolean = false; 
    reportitem: integer = reportnewfile + reportoldfile 
     + reporterror + reportrecursive;

  procedure report(items: integer); begin reportitem := items end;

  function recursive (filename: string): boolean;
    var previous: pfilenode;
  begin if current=NIL then begin recursive:=false; exit; end;
    previous := current; recursive:=true;
    while previous <> NIL do
    begin
      if filename=previous^.name then exit;
      previous := previous^.prev;
    end;
    recursive:=false
  end;

  procedure pushFile(filename: string); 
    var newnode: pfilenode;
  begin  
    if recursive(filename) then
    begin writeln('===! Ignoring recursive include of file ',filename); exit; 
    end;
    new(newnode); newnode^.name := filename; newnode^.prev := current; 
    newnode^.lineno := 0;
{$I-}
    assign(newnode^.actualfile,filename);  reset(newnode^.actualfile);  
{$I+}
    inputerror := ioresult<>0; 
    if inputerror then dispose(newnode) else current := newnode;
    if not inputerror and ((reportitem and reportnewfile)>0) then writeln 
      ('==>> Input from file ',currentFilename);
    if inputerror and ((reportitem and reporterror)>0) then writeln
      ('==!! Could not open file ',filename);
  end;

  procedure popFile;
    var previous: pfilenode;
  begin  if current=NIL then exit;
    if (reportitem and reportclose)>0 then writeln
    ('==>> Closing file ',currentFilename,' at line number ', currentLineNo:1);
    close(current^.actualfile); previous := current^.prev; dispose(current);
    current := previous; 
    if (current<>NIL) and ((reportitem and reportoldfile)>0) then writeln
    ('==>> Resuming input from file ',currentFilename,' at line number ',
     currentLineNo:1);
  end;

  procedure closeAll;  begin  repeat popFile until current=NIL; end;

  function eofCurrent: boolean; 
  begin eofCurrent := eof(current^.actualfile);
  end;

  function readLine: string;
    var s: string;
  begin if nextData<>'' then 
    begin readLine:=nextData; nextData:=''; exit end; 
    if eofAll then begin readLine:=''; exit end; 
{$I-}
    readln(current^.actualfile,s); readLine:=s;
{$I+}
    inputerror := ioresult<>0;
    if not inputerror then 
    begin inc(current^.lineno);
      last_valid_line_no := current^.lineno
    end;
    if inputerror and ((reportitem and reporterror)>0) then writeln
      ('==!! Could not read from file ',currentFilename);
  end;

  function isEmpty(var s: string): boolean;
    var i: integer;
  begin if length(s)=0 then begin isEmpty:=true; exit; end;
    for i:=1 to length(s) do if s[i]<>' ' then 
      begin isEmpty:=false; exit; end;
    isEmpty:=true
  end;
 
  function readData: string;
    var s: string;
  begin if not isEmpty(nextData) then 
    begin readData:=nextData; nextData:=''; exit end;
    while not eofAll do
    begin  s:=readLine;
      if not isEmpty(s) then begin readData:=s; exit end;
    end;
    readData:='';
  end;

  procedure skipBlanks;
  begin while nextData='' do
    begin nextData:=readData; if eofAll then exit
    end
  end;

  function eofAll: boolean;
  begin eofAll := true;
    if current=NIL then exit else 
    if eofCurrent then begin popFile; eofAll:=eofAll; exit end;
    eofAll:=false
  end;

  function currentLineNo: integer;
  begin currentLineNo := last_valid_line_no
  end;

  function currentFilename: string;
  begin if current = NIL then currentFilename := 'No file open yet'
    else currentFilename := current^.name;
  end;

  function fileError: boolean;  begin fileError := inputerror; end;

end.