1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Donald Ziesig
22
23 Abstract
24
25 TTemplateExpander provides xml templates to replace the hard-coded
26 pascal snippets used by TCodeCompletionCodeTool.
27
28 The xml file fragment for the Setter method:
29
30 <templates>
31 *
32 *
33 *
34 <template name="SetterMethod">
35 procedure <ClassName>.<AccessParam/>(<PropVarName/>: <PropType/>);<br/>
36 begin
37 <indent/>if <VarName/>=<PropVarName/> then Exit;<br/>
38 <indent/><VarName/>:=<PropVarName/>;<br/>
39 end;<br/>
40 </template>
41 *
42 *
43 *
44 </templates>
45
46 produces pascal:
47
48 procedure TMyClass.SetMyVar(AValue: MyType);
49 begin
50 if AValue=MyVar then Exit;
51 MyVar:=AValue;
52 end;
53
54 ===============================================================================
55
56 The following xml tags are implemented:
57
58 <if var="SomeBool"> ... </if> generates pascal code if string value of
59 the argument named "SomeBool" is "true".
60
61 <ifnot var="SomeBool" ... </ifnot> generates pascal code if string value of
62 the argument named "SomeBool" is not "true"
63
64 <else> ... </else> must immediately follow </if> or </ifnot>.
65 generates pascal code if the negation of
66 the previous tag is true.
67
68 <count var="SomeVar"> ... </count> generates pascal code for zero or more
69 values of the string argument "SomeVar".
70 The values are encoded as a single string
71 of the form "Arg0?Arg1?...ArgN?" (Yeah, I
72 know. See the comments below about a hack.)
73
74 <indent/> is replaced by the appropriate Indent string.
75
76 <br/> is replaced by the appropriate LineEnd string.
77
78 <SomeVar/> is replaced by the string element of ArgVal
79 which corresponds to the string element of
80 ArgName.
81
82 }
83 unit CodeCompletionTemplater;
84
85 {$mode objfpc}{$H+}
86
87 interface
88
89 uses
90 Classes, SysUtils, laz2_DOM, laz2_XMLRead, LazFileUtils,
91 CodeCache, FileProcs;
92
93 type
94
95 { TTemplateExpander }
96
97 TTemplateExpander = class
98 private
99 FCode: TCodeBuffer;
100 fCodeChangeStep: Integer;
101 procedure LoadCode;
102 procedure SetCode(AValue: TCodeBuffer);
103 protected
104 XMLDoc : TXMLDocument;
105 Root : TDOMNode;
106
ArgCountnull107 function ArgCount(Args: String): Integer;
ArgNnull108 function ArgN(Args: String; Index : Integer) : String;
109
ExpandTemplatenull110 function ExpandTemplate(Template: TDOMNode;
111 LineEnd, Indent : String;
112 ArgName: array of String;
113 ArgVal: array of const;
114 CountIndex: Integer = -1): String;
115
FindTemplatenull116 function FindTemplate(TemplateName: String): TDOMNode;
117 public
118 constructor Create;
119 destructor Destroy; override;
120
Expandnull121 function Expand(TemplateName : String;
122 LineEnd, Indent : String;
123 ArgName : array of String;
124 ArgVal : array of const): String;
125
TemplateExistsnull126 function TemplateExists(TemplateName: String): Boolean;
127
128 property Doc: TXMLDocument read XMLDoc;
129 property Code: TCodeBuffer read FCode write SetCode;
130 procedure ReloadCode;
131 end;
132
133 var
134 CTTemplateExpander : TTemplateExpander; // will be set by CodeToolBoss
135
136 implementation
137
138 { TTemplateExpander }
139
140 //
141 // ArgCount and ArgN are part of a hack to overcome the fact that
142 // "array of const" can not contain another array.
143 //
144 // instead of a convenient ['a',...,['x1,'x2'],...,'z'] we must use something
145 // like ['a',...,'x1?x2?',...'z'] (which is what I chose just for simplicity)
146 //
147
ArgCountnull148 function TTemplateExpander.ArgCount(Args: String): Integer;
149 var
150 I : Integer;
151 begin
152 Result := 0;
153 for I := 1 to Length(Args) do
154 if Args[I] = '?' then
155 Inc(Result);
156 end;
157
ArgNnull158 function TTemplateExpander.ArgN(Args: String; Index: Integer): String;
159 var
160 I : Integer;
161 P : Integer;
162 S : String;
163 begin
164 S := Args;
165 for I := 0 to pred(Index) do
166 begin
167 P := Pos('?',S);
168 S := Copy(S,P+1,65535);
169 end;
170 P := Pos('?',S);
171 Result := Copy(S,1,P-1);
172 end;
173
174 constructor TTemplateExpander.Create;
175 begin
176 fCodeChangeStep:=CTInvalidChangeStamp;
177 end;
178
179 destructor TTemplateExpander.Destroy;
180 begin
181 FCode:=nil;
182 FreeAndNil(XMLDoc);
183 end;
184
Expandnull185 function TTemplateExpander.Expand(TemplateName: String; LineEnd,
186 Indent: String; ArgName: array of String; ArgVal: array of const): String;
187 var
188 Template : TDOMNode;
189 begin
190 Template := FindTemplate(TemplateName);
191 if Template = nil then
192 raise Exception.Create('Template "' + TemplateName + '" not found in TemplateExpander.');
193 Result := ExpandTemplate(Template, LineEnd, Indent, ArgName, ArgVal);
194 end;
195
ExpandTemplatenull196 function TTemplateExpander.ExpandTemplate(Template: TDOMNode; LineEnd,
197 Indent: String; ArgName: array of String; ArgVal: array of const;
198 CountIndex : Integer): String;
199
200 // Sequential search of ArgName array to return corresponding element
201 // of the ArgVal array (appropriately processed if it simulates being
202 // an array itself.
203 function GetArgValue(Name : String; Index : Integer = -1): String;
204 var
205 I : Integer;
206 S : String;
207 begin
208 for I := 0 to pred(Length(ArgName)) do
209 if ArgName[I] = Name then
210 begin
211 S := AnsiString(ArgVal[I].VAnsiString);
212 if (Index < 0) or (Pos('?',S) = 0) then
213 Result := S
214 else
215 Result := ArgN(S, Index);
216 exit;
217 end;
218 raise Exception.Create('ExpandTemplate could not find Argument named "' + Name + '"');
219 end;
220
221 function GetBoolArgValue(Name : String): Boolean;
222 var
223 I : Integer;
224 begin
225 for I := 0 to pred(Length(ArgName)) do
226 if ArgName[I] = Name then
227 begin
228 Result := ArgVal[I].VBoolean;
229 exit;
230 end;
231 raise Exception.Create('ExpandTemplate could not find Argument named "' + Name + '"');
232 end;
233
234 function GetNodeValue(Node : TDOMNode; Required : Boolean = True): String;
235 var
236 Len : Integer;
237 begin
238 Result := '';
239 Len := Node.Attributes.Length;
240 if Required then
241 if Len = 0 then
242 raise Exception.Create('Missing attribute tag for node "' + Node.NodeName + '"');
243 if Len > 0 then
244 Result := Node.Attributes.Item[0].NodeValue;
245 end;
246
247 var
248 Node : TDOMNode;
249 N : String;
250 S : String;
251 Name : String;
252 R : String; // for debugger
253 PrevNode : TDOMNode;
254 CommentFlag : Boolean;
255 CountArgs : String;
256 NArgs : Integer;
257 I : Integer;
258 begin
259 R := '';
260 PrevNode := nil;
261 Node := Template.FirstChild;
262 while Node <> nil do
263 begin
264 N := Node.NodeName;
265 S := Node.NodeValue;
266 CommentFlag := False;
267 // plain text in the xml file is copied directly to the output (almost).
268 if N = '#text' then
269 begin
270 if Pos(#10, S) = 1 then // Hack to work around XML parser that leaves
271 S := Copy(S,2,65535); // A new-line when text appears in first
272 R := R + S; // column of the XML file.
273 end
274 // indent the text using the string argument Indent
275 else if N = 'indent' then
276 begin
277 Name := GetNodeValue(Node, False);
278 if Name = '' then
279 R := R + Indent
280 else
281 R := R + GetArgValue(Name);
282 end
283 // add the line break using the string argument LineEnd
284 else if N = 'br' then
285 R := R + LineEnd
286 // process the xml 'if' tag
287 else if (N = 'if') then
288 begin
289 Name := GetNodeValue(Node); //Node.Attributes.Item[0].NodeValue;
290 if GetBoolArgValue(Name) then
291 R := R + ExpandTemplate(Node, LineEnd,Indent,ArgName,ArgVal);
292 end
293 // process the xml 'ifnot' tag
294 else if (N = 'ifnot') then
295 begin
296 Name := GetNodeValue(Node); //Node.Attributes.Item[0].NodeValue;
297 if not GetBoolArgValue(Name) then
298 R := R + ExpandTemplate(Node, LineEnd,Indent,ArgName,ArgVal);
299 end
300 // process the xml 'else' tag. This is sneaky. The else tag must (almost)
301 // immediately follow the closing of either the 'if' or 'ifnot' tags. (The
302 // exception allows comments to intervene)
303 //
304 // The original implementation used separate 'else' and 'elsenot' tags, but
305 // the xml file got so confusing at times that it was better to add some
306 // nasty looking code here to make the xml neater.
307 else if N = 'else' then
308 begin
309 if PrevNode = nil then
310 raise Exception.Create('Expander: "else" without "if" or "ifnot"');
311 if PrevNode.NodeName = 'if' then
312 begin
313 Name := GetNodeValue(PrevNode); //PrevNode.Attributes.Item[0].NodeValue;
314 if GetBoolArgValue(Name) then
315 R := R + ExpandTemplate(Node, LineEnd,Indent,ArgName,ArgVal);
316 end
317 else if PrevNode.NodeName = 'ifnot' then
318 begin
319 Name := GetNodeValue(PrevNode); //PrevNode.Attributes.Item[0].NodeValue;
320 if not GetBoolArgValue(Name) then
321 R := R + ExpandTemplate(Node, LineEnd,Indent,ArgName,ArgVal);
322 end
323 else
324 raise Exception.Create('Expander: mis-placed "else" following ' + PrevNode.NodeName);
325
326 end
327 // process the xml 'count' tag. This implements multiple lines to be generated
328 // from array or list data in the pascal code. This was originally needed to
329 // implement the 'AssignMethod' template.
330 else if N = 'count' then
331 begin
332 Name := GetNodeValue(Node); //Node.Attributes.Item[0].NodeValue;
333 CountArgs := GetArgValue(Name);
334 NArgs := ArgCount(CountArgs);
335 for I := 0 to pred(Nargs) do
336 R := R + ExpandTemplate(Node, LineEnd,Indent,ArgName,ArgVal, I);
337 end
338 // process all other xml tags (less comment) as requests for the pascal variable
339 // specified by the tag name: e.g., <ClassName/> will look for an argument name
340 // of ClassName in the ArgNames array and get the corresponding value from the
341 // ArgVals array;
342 else if N <> '#comment' then
343 R := R + GetArgValue(N, CountIndex)
344 {$IFDEF DebugTemplate }
345 else
346 begin
347 R := R + '{ ' + Node.NodeValue + ' }';
348 CommentFlag := True;
349 end;
350 {$ELSE DebugTemplate}
351 else
352 CommentFlag := True;
353 {$ENDIF DebugTemplate}
354 // ignore the comment nodes in subsequent processing.
355 if not CommentFlag then PrevNode := Node;
356 Node := Node.NextSibling;
357 end;
358 Result := R;
359 end;
360
FindTemplatenull361 function TTemplateExpander.FindTemplate(TemplateName : String): TDOMNode;
362 var
363 N : String;
364 begin
365 if not Assigned(Root) then
366 begin
367 Result := nil;
368 exit;
369 end;
370 if Root.NodeName <> 'templates' then
371 raise Exception.Create('Root node of codetools TemplateExpander = "' + Root.NodeName + '", "templates" expected.');
372
373 // Sequential search of list of templates.
374 Result := Root.FirstChild;
375 while Result <> nil do
376 begin
377 N := Result.NodeName;
378 if N <> '#comment' then // ignores first level comments
379 begin
380 if N <> 'template' then
381 raise Exception.Create('template node of codetools TemplateExpander = "' + N + '", "template" expected.');
382 if Result.Attributes.Item[0].NodeValue = TemplateName then
383 break;
384 end;
385 Result := Result.NextSibling;
386 end;
387 end;
388
389 procedure TTemplateExpander.LoadCode;
390 var
391 ms: TMemoryStream;
392 begin
393 if Code=nil then begin
394 fCodeChangeStep:=CTInvalidChangeStamp;
395 exit;
396 end;
397 fCodeChangeStep:=Code.ChangeStep;
398 Root:=nil;
399 FreeAndNil(XMLDoc);
400 ms:=TMemoryStream.Create;
401 try
402 Code.SaveToStream(ms);
403 ms.Position:=0;
404 ReadXMLFile(XMLDoc, ms);
405 Root := XMLDoc.DocumentElement;
406 finally
407 ms.Free;
408 end;
409 end;
410
411 procedure TTemplateExpander.SetCode(AValue: TCodeBuffer);
412 begin
413 if FCode=AValue then Exit;
414 FCode:=AValue;
415 LoadCode;
416 end;
417
TemplateExistsnull418 function TTemplateExpander.TemplateExists(TemplateName: String): Boolean;
419 begin
420 ReloadCode;
421 Result := FindTemplate(TemplateName) <> nil;
422 end;
423
424 procedure TTemplateExpander.ReloadCode;
425 begin
426 if Code=nil then exit;
427 if Code.ChangeStep=fCodeChangeStep then exit;
428 LoadCode;
429 end;
430
431 end.
432
433