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: Mattias Gaertner
22
23 Abstract:
24 The TResourceCodeTool provides functions to find, add and delete resources
25 in resource files.
26 }
27 unit ResourceCodeTool;
28
29 {$mode objfpc}{$H+}
30
31 interface
32
33 uses
34 Classes, SysUtils, KeywordFuncLists, MultiKeyWordListTool, CodeCache,
35 CodeAtom, BasicCodeTools;
36
37 type
38 TResourceCodeTool = class(TMultiKeyWordListCodeTool)
39 protected
40 procedure SetSource(ACode: TCodeBuffer);
41 public
42 // lazarus resources
FindLazarusResourceHeaderCommentnull43 function FindLazarusResourceHeaderComment(ResourceCode: TCodeBuffer
44 ): TAtomPosition;
AddLazarusResourceHeaderCommentnull45 function AddLazarusResourceHeaderComment(ResourceCode: TCodeBuffer;
46 const Comment: string): boolean;
FindLazarusResourcenull47 function FindLazarusResource(ResourceCode: TCodeBuffer;
48 const ResourceName: string; StartPos: integer): TAtomPosition;
FindAllLazarusResourcenull49 function FindAllLazarusResource(ResourceCode: TCodeBuffer;
50 const ResourceName: string; StartPos: integer): TAtomList;
AddLazarusResourcenull51 function AddLazarusResource(ResourceCode: TCodeBuffer;
52 const ResourceName, ResourceData: string): boolean;
RemoveLazarusResourcenull53 function RemoveLazarusResource(ResourceCode: TCodeBuffer;
54 const ResourceName: string): boolean;
RemoveLazarusResourceExnull55 function RemoveLazarusResourceEx(ResourceCode: TCodeBuffer;
56 const ResourceName: string; AllExceptFirst: boolean;
57 out First: TAtomPosition): boolean;
58 end;
59
60 TResourceCodeToolError = class(Exception)
61 end;
62
63 implementation
64
65 { TResourceCodeTool }
66
67 procedure TResourceCodeTool.SetSource(ACode: TCodeBuffer);
68 begin
69 ClearLastError;
70 Src:=ACode.Source;
71 SrcLen:=length(Src);
72 CurPos:=StartAtomPosition;
73 LastAtoms.Clear;
74 CurNode:=nil;
75 DoDeleteNodes(Tree.Root);
76 end;
77
TResourceCodeTool.FindLazarusResourceHeaderCommentnull78 function TResourceCodeTool.FindLazarusResourceHeaderComment(
79 ResourceCode: TCodeBuffer): TAtomPosition;
80 begin
81 Result.StartPos:=-1;
82 Result.EndPos:=-1;
83 Result.Flag:=cafNone;
84 SetSource(ResourceCode);
85
86 Result.StartPos:=FindNextNonSpace(Src,1);
87 if (Result.StartPos<=SrcLen) and (Src[Result.StartPos]='{') then
88 Result.EndPos:=FindCommentEnd(Src,Result.StartPos,false)
89 else
90 Result.StartPos:=-1;
91 end;
92
AddLazarusResourceHeaderCommentnull93 function TResourceCodeTool.AddLazarusResourceHeaderComment(
94 ResourceCode: TCodeBuffer; const Comment: string): boolean;
95 var
96 InsertPos: TAtomPosition;
97 begin
98 Result:=true;
99
100 // find existing one
101 InsertPos:=FindLazarusResourceHeaderComment(ResourceCode);
102 if InsertPos.StartPos>0 then begin
103 // there is already a comment
104 // -> don't touch it
105 end else
106 ResourceCode.Insert(1,Comment);
107 end;
108
FindLazarusResourcenull109 function TResourceCodeTool.FindLazarusResource(
110 ResourceCode: TCodeBuffer; const ResourceName: string;
111 StartPos: integer): TAtomPosition;
112 var
113 ResourceNameInPascal: string;
114 ResStartPos: integer;
115 begin
116 Result.StartPos:=-1;
117 Result.EndPos:=-1;
118 SetSource(ResourceCode);
119 if StartPos>=1 then
120 MoveCursorToCleanPos(StartPos);
121
122 // search "LAZARUSRESOURCES.ADD('ResourceName',"
123 ResourceNameInPascal:=''''+UpperCaseStr(ResourceName)+'''';
124 repeat
125 ReadNextAtom;
126 if UpAtomIs('LAZARUSRESOURCES') then begin
127 ResStartPos:=CurPos.StartPos;
128 ReadNextAtom;
129 if CurPos.Flag<>cafPoint then continue;
130 ReadNextAtom;
131 if not UpAtomIs('ADD') then continue;
132 ReadNextAtom;
133 if CurPos.Flag<>cafRoundBracketOpen then continue;
134 ReadNextAtom;
135 if UpAtomIs(ResourceNameInPascal) then begin
136 // resource start found
137 Result.StartPos:=ResStartPos;
138 end;
139 UndoReadNextAtom;
140 ReadTilBracketClose(false);
141 if CurPos.Flag<>cafRoundBracketClose then begin
142 // syntax error
143 Result.StartPos:=-1;
144 exit;
145 end;
146 if (Result.StartPos>0) then begin
147 // resource end found
148 Result.EndPos:=CurPos.EndPos;
149 ReadNextAtom;
150 if CurPos.Flag=cafSemicolon then
151 Result.EndPos:=CurPos.EndPos;
152 exit;
153 end;
154 end;
155 until CurPos.StartPos>SrcLen;
156 end;
157
FindAllLazarusResourcenull158 function TResourceCodeTool.FindAllLazarusResource(ResourceCode: TCodeBuffer;
159 const ResourceName: string; StartPos: integer): TAtomList;
160 var
161 ResourcePos: TAtomPosition;
162 begin
163 Result:=TAtomList.Create;
164 repeat
165 ResourcePos:=FindLazarusResource(ResourceCode,ResourceName,StartPos);
166 if ResourcePos.StartPos<1 then break;
167 Result.Add(ResourcePos);
168 StartPos:=ResourcePos.EndPos;
169 until false;
170 end;
171
AddLazarusResourcenull172 function TResourceCodeTool.AddLazarusResource(ResourceCode: TCodeBuffer;
173 const ResourceName, ResourceData: string): boolean;
174 var
175 InsertAtom: TAtomPosition;
176 NeededLineEnds, i: integer;
177 NewResData: string;
178 begin
179 Result:=false;
180 // try to find an old resource and delete all doubles
181 Result:=RemoveLazarusResourceEx(ResourceCode,ResourceName,true,InsertAtom);
182 if InsertAtom.StartPos<1 then begin
183 // not found -> add at end of file
184 InsertAtom.StartPos:=ResourceCode.SourceLength+1;
185 InsertAtom.EndPos:=ResourceCode.SourceLength+1;
186 end else begin
187 InsertAtom.StartPos:=BasicCodeTools.FindLineEndOrCodeInFrontOfPosition(Src,
188 InsertAtom.StartPos,1,false,true);
189 InsertAtom.EndPos:=BasicCodeTools.FindLineEndOrCodeAfterPosition(Src,
190 InsertAtom.EndPos,SrcLen,false);
191 end;
192 if CodeIsOnlySpace(Src,1,InsertAtom.StartPos-1) then
193 InsertAtom.StartPos:=1;
194 if CodeIsOnlySpace(Src,InsertAtom.EndPos+1,SrcLen) then
195 InsertAtom.EndPos:=SrcLen+1;
196
197 NewResData:=ResourceData;
198 i:=length(NewResData);
199 while (i>1) and (NewResData[i] in [' ',#10,#13]) do
200 dec(i);
201 SetLength(NewResData,i);
202 // add front gap
203 NeededLineEnds:=CountNeededLineEndsToAddForward(ResourceData,1,2);
204 NeededLineEnds:=CountNeededLineEndsToAddBackward(Src,InsertAtom.StartPos-1,
205 NeededLineEnds);
206 for i:=1 to NeededLineEnds do
207 NewResData:=LineEnding+NewResData;
208 // add start gap
209 NeededLineEnds:=CountNeededLineEndsToAddBackward(ResourceData,
210 length(ResourceData),2);
211 NeededLineEnds:=CountNeededLineEndsToAddForward(Src,InsertAtom.EndPos,
212 NeededLineEnds);
213 for i:=1 to NeededLineEnds do
214 NewResData:=NewResData+LineEnding;
215 // replace
216 ResourceCode.Replace(InsertAtom.StartPos,
217 InsertAtom.EndPos-InsertAtom.StartPos,
218 NewResData);
219 Result:=true;
220 end;
221
RemoveLazarusResourcenull222 function TResourceCodeTool.RemoveLazarusResource(ResourceCode: TCodeBuffer;
223 const ResourceName: string): boolean;
224 var
225 FirstResPos: TAtomPosition;
226 begin
227 Result:=RemoveLazarusResourceEx(ResourceCode,ResourceName,false,FirstResPos);
228 end;
229
RemoveLazarusResourceExnull230 function TResourceCodeTool.RemoveLazarusResourceEx(ResourceCode: TCodeBuffer;
231 const ResourceName: string; AllExceptFirst: boolean; out First: TAtomPosition
232 ): boolean;
233 var
234 ResourcePositions: TAtomList;
235 CurResPos: TAtomPosition;
236 i, FirstIndex: integer;
237 begin
238 Result:=true;
239 ResourcePositions:=FindAllLazarusResource(ResourceCode,ResourceName,-1);
240 try
241 if AllExceptFirst then
242 FirstIndex:=1
243 else
244 FirstIndex:=0;
245 for i:=ResourcePositions.Count-1 downto FirstIndex do begin
246 CurResPos:=ResourcePositions[i];
247 CurResPos.EndPos:=BasicCodeTools.FindLineEndOrCodeAfterPosition(Src,
248 CurResPos.EndPos,SrcLen,false);
249 ResourceCode.Delete(CurResPos.StartPos,
250 CurResPos.EndPos-CurResPos.StartPos);
251 end;
252 if ResourcePositions.Count>0 then begin
253 First:=ResourcePositions[0];
254 end else begin
255 First.StartPos:=-1;
256 First.EndPos:=-1;
257 end;
258 finally
259 ResourcePositions.Free;
260 end;
261 end;
262
263 end.
264
265