1 {
2 /***************************************************************************
3 encloseifdef.pas - Conditional Defines
4 ----------------------------------------
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 * *
10 * This source is free software; you can redistribute it and/or modify *
11 * it under the terms of the GNU General Public License as published by *
12 * the Free Software Foundation; either version 2 of the License, or *
13 * (at your option) any later version. *
14 * *
15 * This code is distributed in the hope that it will be useful, but *
16 * WITHOUT ANY WARRANTY; without even the implied warranty of *
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
18 * General Public License for more details. *
19 * *
20 * A copy of the GNU General Public License is available on the World *
21 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
22 * obtain it by writing to the Free Software Foundation, *
23 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
24 * *
25 ***************************************************************************
26 }
27 unit EncloseIfDef;
28
29 {$mode objfpc}{$H+}
30
31 interface
32
33 (* Utility to assist in inserting conditional defines. For example, to convert
34 OnCreate := @CreateHandler
35 to:
36 OnCreate := {$IFDEF FPC} @ {$ENDIF} CreateHandler
37 select @ and then use Edit, Insert $IFDEF (default shortcut Ctrl+Shift+D),
38 select "FPC,NONE" and hit return. If you select one or more complete lines
39 then the conditional defines are put on sepearate lines as in:
40 {$IFDEF DEBUG}
41 Writeln('State= ', State)
42 {$ENDIF}
43 The choices are listed in abbreviated form so:
44 MSWINDOWS,UNIX => {$IFDEF MSWINDOWS} ... {$ENDIF} {$IFDEF UNIX} ... {$ENDIF}
45 FPC,ELSE => {$IFDEF FPC} ... {$ELSE} ... {$ENDIF}
46 DEBUG,NONE => {$IFDEF DEBUG} ... {$ENDIF}
47 This tool is most useful when you need to put several identical conditionals
48 in a file, You can add to the possible conditionals by selecting or typing
49 the required symbols in "First test" and /or "Second test" and using the
50 Add button. Your additons are saved in the encloseifdef.xml file in the lazarus
51 configuration directory.
52 *)
53
54 uses
55 Classes, SysUtils, Controls, Forms, StdCtrls, Buttons, ButtonPanel,
56 LCLProc, LCLType, LazConf, LazFileUtils, Laz2_XMLCfg, LazFileCache,
57 IDEHelpIntf, IDEImagesIntf, LazarusIDEStrConsts, EnvironmentOpts;
58
59 type
60
61 { TEncloseIfDefForm }
62
63 TEncloseIfDefForm = class(TForm)
64 AddBtn: TBitBtn;
65 AddInverse: TBitBtn;
66 ButtonPanel1: TButtonPanel;
67 FirstLabel: TLabel;
68 FirstTest: TComboBox;
69 ListBox: TListBox;
70 NewTestGroupBox: TGroupBox;
71 RemoveBtn: TBitBtn;
72 SecondLabel: TLabel;
73 SecondTest: TComboBox;
74 procedure AddBtnClick(Sender: TObject);
75 procedure AddInverseCLICK(Sender: TObject);
76 procedure btnSaveClick(Sender: TObject);
77 procedure OKButtonClick(Sender: TObject);
78 procedure TestEditChange(Sender: TObject);
79 procedure HelpButtonClick(Sender: TObject);
80 procedure CondFormCREATE(Sender: TObject);
81 procedure ListBoxClick(Sender: TObject);
82 procedure ListBoxDblClick(Sender: TObject);
83 procedure RemoveBtnClick(Sender: TObject);
84 procedure ListBoxKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
85 procedure FormShow(Sender: TObject);
86 private
87 StoredChoice, StoredFirst, StoredSecond: string;
88 FS: string;
SplitActiveRownull89 function SplitActiveRow(out aFirst, aSecond: string): Boolean;
90 procedure DeleteSelected;
91 procedure UpdateButtons;
IsChangednull92 function IsChanged: Boolean;
93 procedure SaveIfChanged;
CreateXMLConfignull94 function CreateXMLConfig: TXMLConfig;
95 end;
96
97
EncloseInsideIFDEFnull98 function EncloseInsideIFDEF(Text: string; IsPascal: Boolean):string;
99
100 implementation
101
102 {$R *.lfm}
103
104 const
105 XmlRoot = 'encloseifdef/';
106
ShowEncloseIfDefDlgnull107 function ShowEncloseIfDefDlg: string;
108 var
109 EncloseIfDefForm: TEncloseIfDefForm;
110 begin
111 Result := '';
112 EncloseIfDefForm := TEncloseIfDefForm.Create(nil);
113 try
114 EncloseIfDefForm.ActiveControl := EncloseIfDefForm.ListBox;
115 if EncloseIfDefForm.ShowModal = mrOK then
116 Result := EncloseIfDefForm.FS;
117 finally
118 EncloseIfDefForm.Free;
119 end
120 end;
121
EncloseInsideIFDEFnull122 function EncloseInsideIFDEF(Text: string; IsPascal: Boolean):string;
123 var
124 cond, s, f: string;
125 p, p1: Integer;
126 IsElse, IsTwo, HasNewline: Boolean;
127 Tail, Indent: string;
128
ifdefnull129 function ifdef(s:string):string;
130 begin
131 Result :='';
132 if (s <>'') and (s[1] = '!') then begin
133 if IsPascal then
134 Result := 'N'
135 else
136 Result := 'n';
137 s := Copy(s,2,Length(s)-1);
138 end;
139 if IsPascal then
140 Result := '{$IF' + Result + 'DEF ' + s + '}'
141 else
142 Result := '#if' + Result + 'def ' + s;
143 end;
144
145 begin
146 Result := Text;
147 cond := ShowEncloseIfDefDlg;
148 p := Pos(',',cond);
149 if p <= 0 then Exit;
150 f := Copy(Cond, 1, p-1);
151 s := Copy(Cond, p+1, Length(Cond));
152 IsElse := CompareText(s, 'ELSE') = 0;
153 IsTwo := CompareText(s, 'NONE') <> 0;
154 HasNewline := Pos(#10, Text) > 0;
155 if HasNewline then begin
156 p := 1;
157 { leave leading newlines unchanged (outside $IFDEF) }
158 while (p <= Length(Text)) and (Text[p] in [#10,#13]) do Inc(p);
159 Result := Copy(Text,1,p-1);
160 p1 := p;
161 { Work out current indentation, to line up $IFDEFS }
162 while (p <= Length(Text)) and (Text[p] in [#9,' ']) do Inc(p);
163 Indent := Copy(Text, p1, p-p1);
164 Text := Copy(Text,p,Length(Text));
165 p := Length(Text);
166 { Tailing whitespace is left outside $IFDEF }
167 while (p>0) and (Text[p] in [' ',#9,#10,#13]) do Dec(p);
168 Tail := Copy(Text, p+1, Length(Text));
169 SetLength(Text,p);
170 end else begin
171 Result := '';
172 Tail := '';
173 Indent := '';
174 end;
175 if IsPascal then begin
176 f := ifdef(f);
177 s := ifdef(s);
178 if HasNewline then begin
179 Result := Result + Indent + f + LineEnding + Indent + Text + LineEnding;
180 if IsElse then
181 Result := Result + Indent + '{$ELSE}' + LineEnding
182 else begin
183 Result := Result + Indent + '{$ENDIF}';
184 if IsTwo then
185 Result := Result + LineEnding + Indent + s + LineEnding;
186 end;
187 if IsTwo then
188 Result := Result + Indent + Text + LineEnding + Indent + '{$ENDIF}';
189 Result := Result + Tail;
190 end else begin
191 Result := Result + f + ' ' + Text;
192 if IsElse then
193 Result := Result + ' {$ELSE} '
194 else begin
195 Result := Result + ' {$ENDIF}';
196 if IsTwo then
197 Result := Result + ' ' + s + ' ';
198 end;
199 if IsTwo then
200 Result := Result + Text + ' {$ENDIF}';
201 end;
202 end else begin
203 Result := Result + ifdef(f) + LineEnding + indent + Text + LineEnding;
204 if IsElse then
205 Result := Result + '#else' + LineEnding
206 else begin
207 Result := Result + '#endif /* ' + f + ' */' + LineEnding;
208 if IsTwo then
209 Result := Result + ifdef(s) + LineEnding;
210 end;
211 if IsTwo then begin
212 Result := Result + indent + Text + LineEnding + '#endif /* ';
213 if IsElse then
214 Result := Result + f
215 else
216 Result := Result + s;
217 Result := Result + ' */' + LineEnding;
218 end;
219 Result := Result + Tail;
220 end;
221 end;
222
223 { TEncloseIfDefForm }
224
225 procedure TEncloseIfDefForm.CondFormCREATE(Sender: TObject);
226 var
227 i: Integer;
228 XMLConfig: TXMLConfig;
229 begin
230 NewTestGroupBox.Caption := rsCreateNewDefine;
231 Caption := rsConditionalDefines;
232 FirstLabel.Caption := lisFirstTest;
233 SecondLabel.Caption := lisSecondTest;
234 AddBtn.Caption := lisBtnAdd;
235 IDEImages.AssignImage(AddBtn, 'laz_add');
236 AddInverse.Caption := rsAddInverse;
237 IDEImages.AssignImage(AddInverse, 'pkg_issues');
238 RemoveBtn.Caption := lisBtnRemove;
239 IDEImages.AssignImage(RemoveBtn, 'laz_delete');
240 ButtonPanel1.CloseButton.Caption := lisSave;
241 ButtonPanel1.OKButton.Caption := lisOk;
242 //ButtonPanel1.CloseButton.LoadGlyphFromStock(idButtonSave);
243 //if btnSave.Glyph.Empty then
244 // btnSave.LoadGlyphFromResourceName(HInstance, 'laz_save');
245 try
246 XMLConfig:=CreateXMLConfig;
247 try
248 StoredChoice := XMLConfig.GetValue(XmlRoot + 'Choice',
249 '"MSWINDOWS,UNIX","MSWINDOWS,ELSE","FPC,NONE","FPC,ELSE","DEBUG,NONE"');
250 StoredFirst := XMLConfig.GetValue(XmlRoot + 'First', 'MSWINDOWS');
251 StoredSecond := XMLConfig.GetValue(XmlRoot + 'Second', 'UNIX');
252 finally
253 XMLConfig.Free;
254 end;
255 except
256 on E: Exception do begin
257 debugln('TCondForm.CondFormCREATE ',E.Message);
258 end;
259 end;
260 with ListBox do begin
261 Items.CommaText := StoredChoice;
262 i := Items.IndexOf(StoredFirst+','+StoredSecond);
263 if i < 0 then begin
264 Items.Add(StoredFirst+','+StoredSecond);
265 ItemIndex := 0;
266 end else
267 ItemIndex := i;
268 end;
269 FirstTest.DropDownCount := EnvironmentOptions.DropDownCount;
270 SecondTest.DropDownCount := EnvironmentOptions.DropDownCount;
271 end;
272
273 procedure TEncloseIfDefForm.FormShow(Sender: TObject);
274 begin
275 if SecondTest.Items.Count < 10 then
276 SecondTest.Items.AddStrings(FirstTest.Items);
277 ListBoxClick(Nil);
278 end;
279
TEncloseIfDefForm.SplitActiveRownull280 function TEncloseIfDefForm.SplitActiveRow(out aFirst, aSecond: string): Boolean;
281 var
282 i: integer;
283 Line: string;
284 begin
285 Result := False;
286 aFirst := '';
287 aSecond := '';
288 with ListBox do
289 if ItemIndex >= 0 then begin
290 Line := Items[ItemIndex];
291 i := Pos(',', Line);
292 if i > 0 then begin
293 Result := True;
294 aFirst := Copy(Line, 1, i-1);
295 aSecond := Copy(Line, i+1, Length(Line));
296 end
297 end;
298 end;
299
300 procedure TEncloseIfDefForm.AddBtnClick(Sender: TObject);
301 begin
302 ListBox.Items.Add(FirstTest.Text+','+SecondTest.Text);
303 ListBox.ItemIndex := ListBox.Items.Count-1;
304 UpdateButtons;
305 end;
306
307 procedure TEncloseIfDefForm.AddInverseCLICK(Sender: TObject);
308 begin
309 ListBox.Items.Add('!'+FirstTest.Text+','+SecondTest.Text);
310 ListBox.ItemIndex := ListBox.Items.Count-1;
311 UpdateButtons;
312 end;
313
314 procedure TEncloseIfDefForm.TestEditChange(Sender: TObject);
315 begin
316 UpdateButtons;
317 end;
318
319 procedure TEncloseIfDefForm.btnSaveClick(Sender: TObject);
320 begin
321 SaveIfChanged;
322 Close;
323 end;
324
325 procedure TEncloseIfDefForm.OKButtonClick(Sender: TObject);
326 begin
327 SaveIfChanged;
328 with ListBox do
329 FS := Items[ItemIndex]; // Return selected row to caller.
330 end;
331
332 procedure TEncloseIfDefForm.HelpButtonClick(Sender: TObject);
333 begin
334 LazarusHelp.ShowHelpForIDEControl(Self);
335 end;
336
337 procedure TEncloseIfDefForm.ListBoxClick(Sender: TObject);
338 var
339 ff, ss: string;
340 begin
341 if SplitActiveRow(ff, ss) then begin
342 FirstTest.Text := ff;
343 SecondTest.Text := ss;
344 UpdateButtons;
345 end;
346 end;
347
348 procedure TEncloseIfDefForm.ListBoxDblClick(Sender: TObject);
349 begin
350 ModalResult := mrOK;
351 end;
352
353 procedure TEncloseIfDefForm.RemoveBtnClick(Sender: TObject);
354 begin
355 DeleteSelected;
356 end;
357
358 procedure TEncloseIfDefForm.ListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
359 begin
360 if Key = VK_DELETE then begin
361 DeleteSelected;
362 Key := 0;
363 end;
364 end;
365
366 procedure TEncloseIfDefForm.DeleteSelected;
367 var
368 i: Integer;
369 begin
370 with ListBox.Items do
371 for i := Count-1 downto 0 do
372 if ListBox.Selected[i] then begin
373 Delete(i);
374 UpdateButtons;
375 end;
376 end;
377
378 procedure TEncloseIfDefForm.UpdateButtons;
379 var
380 s: string;
381 begin
382 s := FirstTest.Text+','+SecondTest.Text;
383 AddBtn.Enabled := (FirstTest.Text <> '') and (ListBox.Items.IndexOf(s) = -1);
384 s := '!' + s;
385 AddInverse.Enabled := (FirstTest.Text <> '')
386 and (FirstTest.Text[1] <> '!')
387 and (ListBox.Items.IndexOf(s) = -1);
388 RemoveBtn.Enabled := ListBox.SelCount > 0;
389 ButtonPanel1.CloseButton.Enabled := IsChanged;
390 ButtonPanel1.OKButton.Enabled := ListBox.SelCount > 0;
391 end;
392
IsChangednull393 function TEncloseIfDefForm.IsChanged: Boolean;
394 var
395 ff, ss: string;
396 begin
397 if StoredChoice <> ListBox.Items.CommaText then
398 Exit(True);
399 if SplitActiveRow(ff, ss) then begin
400 if StoredFirst <> ff then
401 Exit(True);
402 if StoredSecond <> ss then
403 Exit(True);
404 end;
405 Result := False;
406 end;
407
408 procedure TEncloseIfDefForm.SaveIfChanged;
409 var
410 ff, ss: string;
411 XMLConfig: TXMLConfig;
412 begin
413 if ButtonPanel1.CloseButton.Enabled then // enabled only if there are changes
414 try
415 SplitActiveRow(ff, ss);
416 InvalidateFileStateCache;
417 XMLConfig:=CreateXMLConfig;
418 try
419 XMLConfig.SetValue(XmlRoot + 'Choice', ListBox.Items.CommaText);
420 XMLConfig.SetValue(XmlRoot + 'First', ff);
421 XMLConfig.SetValue(XmlRoot + 'Second', ss);
422 XMLConfig.Flush;
423 finally
424 XMLConfig.Free;
425 end;
426 except
427 on E: Exception do begin
428 debugln('TCondForm.SaveIfChanged ',E.Message);
429 end;
430 end;
431 end;
432
CreateXMLConfignull433 function TEncloseIfDefForm.CreateXMLConfig: TXMLConfig;
434 var
435 ConfFileName: String;
436 begin
437 Result:=nil;
438 ConfFileName:=AppendPathDelim(GetPrimaryConfigPath)+'encloseifdef.xml';
439 try
440 if (not FileExistsUTF8(ConfFileName)) then
441 Result:=TXMLConfig.CreateClean(ConfFileName)
442 else
443 Result:=TXMLConfig.Create(ConfFileName);
444 except
445 on E: Exception do begin
446 debugln('TCondForm.CreateXMLConfig ',E.Message);
447 end;
448 end;
449 end;
450
451 end.
452