diff options
Diffstat (limited to 'Build/source/utils/mtx/mtx-0.60d/multfile.pas')
-rw-r--r-- | Build/source/utils/mtx/mtx-0.60d/multfile.pas | 196 |
1 files changed, 196 insertions, 0 deletions
diff --git a/Build/source/utils/mtx/mtx-0.60d/multfile.pas b/Build/source/utils/mtx/mtx-0.60d/multfile.pas new file mode 100644 index 00000000000..6c272992a3f --- /dev/null +++ b/Build/source/utils/mtx/mtx-0.60d/multfile.pas @@ -0,0 +1,196 @@ +unit multfile; (* DPL 2004-03-06 +(* 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; + 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 inc(current^.lineno); + 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 if current = NIL then currentLineNo := 0 + else currentLineNo := current^.lineno; + 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. |