Mercurial > rg

comparison parser.pas @ 0:62966dd383ed default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
initial
author Radomir Dopieralski <sheep-devel@sheep.art.pl>
date Sun, 08 Dec 2013 19:39:15 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:62966dd383ed
1 { File i/o and parsing routines. }
2
3 UNIT Parser;
4
5 INTERFACE
6
7 USES Gzio;
8
9 CONST REMCHAR='#';
10 REMEND=#13;
11 STRCHAR='"';
12 VRBCHAR='\';
13
14 { TYPE CfgFile=FILE OF CHAR; }
15 TYPE CfgFile=gzFile;
16
17 CONST PARSE_NOERROR=0;
18 PARSE_ERR_EOF=1;
19 PARSE_ERR_NUM=2;
20 PARSE_ERR_STR=3;
21 PARSE_ERR_NAM=4;
22 PARSE_ERR_OPN=5;
23
24 VAR errNum:BYTE;
25 actLine: WORD;
26 FUNCTION ReadName(VAR f:CfgFile):STRING;
27 FUNCTION ReadString(VAR f:CfgFile):STRING;
28 FUNCTION ReadNumber(VAR f:CfgFile):INTEGER;
29 PROCEDURE OpenCfg(VAR f:CfgFile; name: STRING);
30 PROCEDURE CloseCfg(VAR f:CfgFile);
31
32 IMPLEMENTATION
33
34 CONST CHR_EOF=#26;
35
36 PROCEDURE OpenCfg(VAR f:CfgFile; name: STRING);
37 BEGIN
38 actLine:=1;
39 errNum:=PARSE_NOERROR;
40
41 f:=gzOpen(name,'r');
42 IF f=NIL THEN BEGIN
43 errNum:=PARSE_ERR_OPN;
44 WriteLn('Can''t open ',name);
45 END;
46 END;
47
48 PROCEDURE CloseCfg(VAR f:CfgFile);
49 BEGIN
50 IF gzClose(f)>0 THEN errNum:=PARSE_ERR_OPN;
51 END;
52
53 FUNCTION ReadChr(VAR f:CfgFile): CHAR;
54 VAR c: CHAR;
55 b: INTEGER;
56 BEGIN
57 b:=gzGetC(f);
58
59 IF (b<0) OR (b>255) OR (c=CHR_EOF) THEN BEGIN
60 errNum:=PARSE_ERR_EOF;
61 c:=CHR_EOF;
62 END ELSE c:=Chr(b);
63
64 IF c=#13 THEN Inc(actLine);
65 ReadChr:=c;
66 END;
67
68 FUNCTION IsEmpty(c:CHAR):BOOLEAN;
69 BEGIN
70 IsEmpty:=(c=' ') OR (c=#9) OR (c=#13) OR (c=#10) OR (c=CHR_EOF);
71 END;
72
73 FUNCTION ReadName(VAR f:CfgFile):STRING;
74 VAR s: STRING;
75 c: CHAR;
76 BEGIN
77 ReadName:='';
78 REPEAT
79 c:=ReadChr(f);
80 IF c=REMCHAR THEN BEGIN
81 REPEAT
82 c:=ReadChr(f);
83 UNTIL (c=REMEND) OR (c=CHR_EOF);
84 IF (c<>CHR_EOF) THEN c:=' ';
85 END;
86 UNTIL (NOT IsEmpty(c)) OR (c=CHR_EOF);
87 s:='';
88 WHILE NOT IsEmpty(c) DO BEGIN
89 s:=Concat(s,UpCase(c));
90 c:=ReadChr(f);
91 END;
92 IF s='' THEN errNum:=PARSE_ERR_NAM;
93 ReadName:=s;
94 END;
95
96 FUNCTION ReadString(VAR f:CfgFile):STRING;
97 VAR s: STRING;
98 c: CHAR;
99 BEGIN
100 ReadString:='';
101 REPEAT
102 c:=ReadChr(f);
103 IF c=REMCHAR THEN BEGIN
104 REPEAT
105 c:=ReadChr(f);
106 UNTIL (c=REMEND) OR (c=CHR_EOF);
107 IF (c<>CHR_EOF) THEN c:=' ';
108 END;
109 UNTIL (NOT IsEmpty(c)) OR (c=CHR_EOF);
110 s:='';
111 IF c<>STRCHAR THEN BEGIN
112 errNum:=PARSE_ERR_STR;
113 END ELSE BEGIN
114 REPEAT
115 c:=ReadChr(f);
116 IF c=STRCHAR THEN Break;
117 IF c=#13 THEN BEGIN
118 ErrNum:=PARSE_ERR_STR;
119 Exit;
120 END;
121 IF c=CHR_EOF THEN Exit;
122 IF c=VRBCHAR THEN BEGIN
123 c:=ReadChr(f);
124 END;
125 s:=Concat(s,c);
126 UNTIL FALSE;
127 END;
128 ReadString:=s;
129 END;
130
131 FUNCTION ReadNumber(VAR f:CfgFile):INTEGER;
132 VAR s: STRING;
133 c: CHAR;
134 i,j: INTEGER;
135 BEGIN
136 ReadNumber:=0;
137 REPEAT
138 c:=ReadChr(f);
139 IF c=REMCHAR THEN BEGIN
140 REPEAT
141 c:=ReadChr(f);
142 UNTIL (c=REMEND) OR (c=CHR_EOF);
143 IF (c<>CHR_EOF) THEN c:=' ';
144 END;
145 UNTIL (NOT IsEmpty(c)) OR (c=CHR_EOF);
146 s:='';
147 WHILE NOT IsEmpty(c) DO BEGIN
148 s:=Concat(s,UpCase(c));
149 c:=ReadChr(f);
150 END;
151 Val(s,i,j);
152 IF j=0 THEN ReadNumber:=i
153 ELSE BEGIN
154 errNum:=PARSE_ERR_NUM;
155 END;
156 END;
157
158 END.