summaryrefslogtreecommitdiff
path: root/support/rnototex/dsrops.pas
blob: c83fe24033a6d71855825429ae1f318bef629b31 (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
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
[INHERIT('SCREENHANDLERS','UTILITYOPS','ARGOPS',
'TREEANDLISTOPS','FLAGOPS','CONVERSION'), environment('dsrops')]

MODULE DSROPS;


CONST
    
   indexofpagecommand = 38;

VAR
    
    totallines             : [EXTERNAL] integer;
    totalgooddsrcommands : [EXTERNAL] integer;
    totalbaddsrcommands  : [EXTERNAL] integer;





[GLOBAL] FUNCTION listispagecommand( list : arglist ) : boolean;
var
   s : pckstr;
begin 
   listispagecommand := false;
   if arglistlength(list) = 1 then
   begin
      s := argliteral(firstarg(list), TRUE );
      if s = 'PAGE' then
        listispagecommand := true
   end 
end;


                              
[GLOBAL] PROCEDURE checkfordsrcommand( var infile, outfile : text; 
	                         var dsrcommand : boolean );
var
  gotten : boolean;
begin
  if flagclass(currentchar) = control then
  begin           
    getnextchar(infile, gotten);
    if gotten then
    begin
      if (flagclass(currentchar) <> comment) and (currentchar <> blank) then
          dsrcommand := true
    end
    else
    begin
      dsrcommand := false;   
      texwrite(outfile, currentchar)
    end                     
  end
  else
    dsrcommand := false
end;




[GLOBAL] PROCEDURE parsedsrcommand( var infile, outfile : text; var list :
	                              arglist; var anothercommand : boolean;
	                              var carrychar : boolean; var charcarried : char);
const                                                          
   dontwritethem = false;
type
   charidentity = (letter, separator, number, semicolon, quote, commentchar,newdsrcommand);
var                                    
   quotedchar : char;
   argread : argument;   
   currentargclass : charidentity;
   done, gotten, atseparator, endofdsrcommand : boolean;
   i : integer;

   function charclass( ch : char ) : charidentity;
   label
      localexit;
   begin
      charclass := separator;                                       
      if flagclass( ch ) = control then
      begin
         charclass := newdsrcommand;      
         goto localexit
      end;
      if ch in ['a'..'z','A'..'Z'] then
      begin
         charclass := letter;
         goto localexit
      end;
      if ch in ['+','-','0'..'9'] then
      begin                                                                    
         charclass := number;
	 goto localexit
      end;
      if ch in [chr(34), chr(39)] then
      begin
         charclass := quote;
         goto localexit
      end;
      if flagclass(currentchar) = comment then
      begin
         charclass := commentchar;
         goto localexit
      end;
      if ch = ';' then
        charclass := semicolon;                        
      localexit : nullstatement
   end;
                                                                               
   procedure startarg( ch : char; var arg : argument; startset : setofargtype);
   begin
      initarg(arg, startset, ch, indexofunknowntexcommand, false);
   end;

begin   
    list := nulllist;
    atseparator := false;
    endofdsrcommand := false;
    anothercommand := false;                        
    carrychar := false;
    repeat
         currentargclass := charclass(currentchar);
         case currentargclass of 
       	    letter  : begin
	                atseparator := false;
	                startarg(currentchar, argread, [dsrverb,stylespecifier, textpckstr,character]);
                        done := false;
                        repeat
	                    getnextchar(infile, gotten);
                            if gotten then                                    
	                    begin
	                        if charclass(currentchar) = letter then
                                    appendchartoarg(currentchar, argread)
                                else
                                    done := true
                            end
	                    else
                            begin
                                done := true;
	                        endofdsrcommand :=  true
	                    end
	                until done;
	                appendargonlist(list, argread )
                     end;
       	    number  : begin
	                atseparator := false;
	                startarg(currentchar, argread, [int,signedint,textpckstr,nulltype]);
                        done := false;
                        repeat
	                    getnextchar(infile, gotten);
                            if gotten then                                    
	                    begin
	                        if charclass(currentchar) = number then
                                    appendchartoarg(currentchar, argread)
                                else
                                    done := true
                            end
	                    else
                            begin
                                done := true;
	                        endofdsrcommand :=  true
	                    end
	                until done;
	                appendargonlist(list, argread )
                     end;                                           
	 separator : begin                                        
	                passblanks(infile, outfile, dontwritethem);
	                if (atseparator) and (currentchar <> lastinputchar) then
	                begin
	                    startarg(blank, argread, [nulltype]);
	                    appendargonlist(list, argread);
                            atseparator := false
	                end
	                else
	                begin
                            if flagclass(currentchar) = control then
	                      endofdsrcommand := true
                            else
                              if charclass(currentchar) = separator then
                              begin
                                getnextchar(infile, gotten);
	                        if gotten then
                                   atseparator := true
	                        else
                                begin
                                   atseparator := false;
	                           startarg(blank, argread, [nulltype]);
	                           appendargonlist(list, argread);
	                           endofdsrcommand := true         
                                end
                              end
	                end
	             end;                                                             
	semicolon : begin
                       endofdsrcommand := true;
	               getnextchar(infile, gotten);
	               if charclass(currentchar) = newdsrcommand then
	                  currentargclass := newdsrcommand
	               else
	               begin
	                 carrychar := true;
	                 charcarried := currentchar
	               end
	             end;
	    quote  : begin       
	                quotedchar := currentchar;
	                getnextchar(infile, gotten);
                        if gotten then
	                begin
	                   startarg(currentchar, argread, [quotedpckstr]);
	                   done := false;
	                   repeat
	                      getnextchar(infile, gotten);
	                      if gotten then
	                      begin
	                        if charclass(currentchar) = quote then
	                        begin
	                            getnextchar(infile, gotten);
	                            done := true;
	                            if not gotten then
	                                endofdsrcommand := true
	                        end
	                        else
	                            appendchartoarg(currentchar, argread)
	                      end                                              
                              else
	                      begin
	                        endofdsrcommand := true;
	                        done := true
	                      end
	                   until done
	                end
	                else                                           
	                  startarg(quotedchar, argread,[textpckstr,character]);
                        appendargonlist(list, argread)
                     end;
      commentchar : begin
	               endofdsrcommand := true
                     end;
   newdsrcommand : begin
                       endofdsrcommand := true;  
                     end
      end; {case}
    until endofdsrcommand;                    
    if currentargclass <> newdsrcommand then
      newline( infile, outfile, false)           
    else
      anothercommand := true
end;
	                               
      
                                     
PROCEDURE parsefile( var infile, outfile : text; textree : argtree );
const                 
   nocrlf = false;
   putcrlf = true;                              
var
   dsrcommandfound      : boolean;
   chargotten            : boolean;
   dsrarguments          : arglist;
   texcommandindex      : integer;
   nextcommandtowrite  : integer;                             
   successfulparse       : boolean;
   depthofsearch        : integer;                                         
   anothercommand        : boolean;
   carrychar             : boolean;
   charcarried, copychar : char;
begin     
  ttywritestring('Translating input ...');                         
  totalgooddsrcommands := 0;
  totalbaddsrcommands := 0;
  nextcommandtowrite := indexofunknowntexcommand;
  anothercommand := false;
  repeat                                    
    putsecondarytexcommand( outfile, nextcommandtowrite);
    repeat
      checkfordsrcommand( infile, outfile, dsrcommandfound );
      if dsrcommandfound then
      begin
        parsedsrcommand( infile, outfile, dsrarguments, anothercommand,carrychar,charcarried);
        if listispagecommand( dsrarguments) then
        begin
          successfulparse := true;
          texcommandindex := indexofpagecommand
        end
        else
          searchtreeforlist( textree, dsrarguments,successfulparse, texcommandindex,
          depthofsearch);            
        if successfulparse then
        begin
          totalgooddsrcommands := totalgooddsrcommands + 1;
          puttexcommand(outfile, texcommandindex, dsrarguments, nextcommandtowrite);
          if carrychar then
          begin
	     copychar := currentchar;
	     currentchar := charcarried;
	     writecurrentchar( infile, outfile );
	     currentchar := copychar
          end
        end
        else
        begin
          totalbaddsrcommands := totalbaddsrcommands + 1;
          write(outfile,'%Unidentified RUNOFF command "');
          dumpthelist(outfile, dsrarguments);
          writeln(outfile,'"')
        end
      end
      else
        anothercommand := false
    until (not dsrcommandfound) and (not anothercommand);
    repeat
      writecurrentchar( infile, outfile );
      getnextchar(infile, chargotten)
    until not chargotten;
    newline(infile, outfile, putcrlf)
  until eof(infile)
end;



END.