1 { Dialog to configure Build/Run file
2 }
3 unit BuildFileDlg;
4
5 {$mode objfpc}{$H+}
6
7 interface
8
9 uses
10 Classes, SysUtils,
11 // LCL
12 LCLProc, LCLType, Forms, Controls, Graphics, ComCtrls, Dialogs, StdCtrls, ButtonPanel,
13 // LazUtils
14 LazFileUtils, LazStringUtils,
15 // CodeTools
16 BasicCodeTools,
17 // IdeIntf
18 IDEHelpIntf, MacroDefIntf, LazIDEIntf, IDEUtils,
19 // IDE
20 InputHistory, LazarusIDEStrConsts, EnvironmentOpts, TransferMacros;
21
22 type
23
24 { TMacroSelectionBox }
25
26 TMacroSelectionBox = class(TGroupBox)
27 procedure ListBoxClick(Sender: TObject);
28 private
29 FMacroList: TTransferMacroList;
30 FOnAddMacro: TNotifyEvent;
31 ListBox: TListBox;
32 AddButton: TButton;
33 procedure AddButtonClick(Sender: TObject);
34 procedure SetMacroList(const AValue: TTransferMacroList);
35 procedure FillListBox;
36 public
37 constructor Create(TheOwner: TComponent); override;
GetSelectedMacronull38 function GetSelectedMacro(var MacroAsCode: string): TTransferMacro;
39 property MacroList: TTransferMacroList read FMacroList write SetMacroList;
40 property OnAddMacro: TNotifyEvent read FOnAddMacro write FOnAddMacro;
41 end;
42
43
44 { TBuildFileDialog }
45
46 TBuildFileDialog = class(TForm)
47 RunBeforeBuildCheckbox: TCheckBox;
48 BuildBrowseWorkDirButton: TButton;
49 BuildCommandGroupbox: TGroupBox;
50 BuildCommandMemo: TMemo;
51 BuildScanForFPCMsgCheckbox: TCheckBox;
52 BuildScanForMakeMsgCheckbox: TCheckBox;
53 BuildWorkDirCombobox: TComboBox;
54 BuildWorkingDirGroupbox: TGroupBox;
55 BuildPage: TTabSheet;
56 ButtonPanel: TButtonPanel;
57 GeneralPage: TTabSheet;
58 Notebook1: TPageControl;
59 OverrideBuildProjectCheckbox: TCheckBox;
60 OverrideRunProjectCheckbox: TCheckBox;
61 RunBrowseWorkDirButton: TButton;
62 RunCommandGroupbox: TGroupBox;
63 RunCommandMemo: TMemo;
64 RunPage: TTabSheet;
65 RunWorkDirCombobox: TComboBox;
66 RunWorkDirGroupbox: TGroupBox;
67 RunShowOutputCheckBox: TCheckBox;
68 WhenFileIsActiveGroupbox: TGroupBox;
69 BuildMacroSelectionBox: TMacroSelectionBox;
70 RunMacroSelectionBox: TMacroSelectionBox;
71 procedure BuildBrowseWorkDirButtonCLICK(Sender: TObject);
72 procedure BuildFileDialogCreate(Sender: TObject);
73 procedure BuildFileDialogKeyDown(Sender: TObject; var Key: Word;
74 {%H-}Shift: TShiftState);
75 procedure BuildMacroSelectionBoxAddMacro(Sender: TObject);
76 procedure HelpButtonClick(Sender: TObject);
77 procedure OkButtonClick(Sender: TObject);
78 procedure RunMacroSelectionBoxAddMacro(Sender: TObject);
79 private
80 FDirectiveList: TStrings;
81 FFilename: string;
82 FMacroList: TTransferMacroList;
GetBuildFileIfActivenull83 function GetBuildFileIfActive: boolean;
GetRunFileIfActivenull84 function GetRunFileIfActive: boolean;
85 procedure SetBuildFileIfActive(const AValue: boolean);
86 procedure SetDirectiveList(const AValue: TStrings);
87 procedure SetFilename(const AValue: string);
88 procedure SetMacroList(const AValue: TTransferMacroList);
89 procedure SetRunFileIfActive(const AValue: boolean);
90 procedure UpdateCaption;
91 procedure ReadDirectiveList;
92 procedure WriteDirectiveList;
93 public
94 property DirectiveList: TStrings read FDirectiveList write SetDirectiveList;
95 property BuildFileIfActive: boolean read GetBuildFileIfActive write SetBuildFileIfActive;
96 property RunFileIfActive: boolean read GetRunFileIfActive write SetRunFileIfActive;
97 property Filename: string read FFilename write SetFilename;
98 property MacroList: TTransferMacroList read FMacroList write SetMacroList;
99 end;
100
101 const
102 IDEDirDefaultBuildCommand = '$(CompPath) $(EdFile)';
103 IDEDirBuildScanFlagDefValues = [idedbsfFPC,idedbsfMake];
104 IDEDirDefaultRunCommand = '$MakeExe($(EdFile))';
105 IDEDirRunFlagDefValues = [idedrfBuildBeforeRun];
106
107 var
108 IDEDirectiveSpecialChars: string;
109
IndexOfIDEDirectivenull110 function IndexOfIDEDirective(DirectiveList: TStrings;
111 const DirectiveName: string): integer;
GetIDEStringDirectivenull112 function GetIDEStringDirective(DirectiveList: TStrings;
113 const DirectiveName, DefaultValue: string): string;
GetIDEDirectiveFlagnull114 function GetIDEDirectiveFlag(const DirectiveValue, FlagName: string;
115 DefaultValue: boolean): boolean;
116 procedure SetIDEDirective(DirectiveList: TStrings; const DirectiveName: string;
117 const NewValue, DefaultValue: string);
StringToIDEDirectiveValuenull118 function StringToIDEDirectiveValue(const s: string): string;
IDEDirectiveValueToStringnull119 function IDEDirectiveValueToString(const s: string): string;
IDEDirectiveNameToDirectivenull120 function IDEDirectiveNameToDirective(const DirectiveName: string): TIDEDirective;
121
122 // build scan flags
IDEDirBuildScanFlagNameToFlagnull123 function IDEDirBuildScanFlagNameToFlag(const FlagName: string): TIDEDirBuildScanFlag;
GetIDEDirBuildScanFromStringnull124 function GetIDEDirBuildScanFromString(const s: string): TIDEDirBuildScanFlags;
GetIDEDirBuildScanStrFromFlagsnull125 function GetIDEDirBuildScanStrFromFlags(Flags: TIDEDirBuildScanFlags): string;
126
127 // run flags
IDEDirRunFlagNameToFlagnull128 function IDEDirRunFlagNameToFlag(const FlagName: string
129 ): TIDEDirRunFlag;
GetIDEDirRunFlagFromStringnull130 function GetIDEDirRunFlagFromString(const s: string): TIDEDirRunFlags; overload;
GetIDEDirRunFlagFromStringnull131 function GetIDEDirRunFlagFromString(const s: string;
132 DefaultFlags: TIDEDirRunFlags): TIDEDirRunFlags; overload;
GetIDEDirRunFlagStrFromFlagsnull133 function GetIDEDirRunFlagStrFromFlags(Flags: TIDEDirRunFlags): string;
134
135
136
137 implementation
138
139 {$R *.lfm}
140
141 procedure AddFlagStr(var FlagStr: string; const FlagName: string;
142 Value: boolean);
143 var
144 s: String;
145 begin
146 s:=FlagName;
147 if FlagStr<>'' then s:=' '+s;
148 if Value then
149 s:=s+'+'
150 else
151 s:=s+'-';
152 FlagStr:=FlagStr+s;
153 end;
154
IndexOfIDEDirectivenull155 function IndexOfIDEDirective(DirectiveList: TStrings;
156 const DirectiveName: string): integer;
157 var
158 i: Integer;
159 CurDirective: string;
160 DirectiveNameLen: Integer;
161 begin
162 Result:=-1;
163 if (DirectiveList=nil) or (DirectiveName='') then exit;
164 DirectiveNameLen:=length(DirectiveName);
165 for i:=0 to DirectiveList.Count-1 do begin
166 CurDirective:=DirectiveList[i];
167 if length(CurDirective)>4+DirectiveNameLen then begin
168 if CompareText(@CurDirective[3],DirectiveNameLen,
169 @DirectiveName[1],DirectiveNameLen,
170 false)=0
171 then begin
172 Result:=i;
173 exit;
174 end;
175 end;
176 end;
177 end;
178
GetIDEStringDirectivenull179 function GetIDEStringDirective(DirectiveList: TStrings;
180 const DirectiveName, DefaultValue: string): string;
181 var
182 CurDirective: string;
183 DirectiveNameLen: Integer;
184 Index: Integer;
185 begin
186 Result:=DefaultValue;
187 Index:=IndexOfIDEDirective(DirectiveList,DirectiveName);
188 if Index<0 then exit;
189 DirectiveNameLen:=length(DirectiveName);
190 CurDirective:=DirectiveList[Index];
191 Result:=IDEDirectiveValueToString(copy(CurDirective,4+DirectiveNameLen,
192 length(CurDirective)-4-DirectiveNameLen));
193 end;
194
GetIDEDirectiveFlagnull195 function GetIDEDirectiveFlag(const DirectiveValue,
196 FlagName: string; DefaultValue: boolean): boolean;
197 // Example: 'FPC+ Make off BUILD on FPC-'
198
ReadNextWordnull199 function ReadNextWord(var ReadPos: integer;
200 out WordStart, WordEnd: integer): boolean;
201 begin
202 Result:=false;
203 // skip space
204 while (ReadPos<=length(DirectiveValue))
205 and (DirectiveValue[ReadPos]=' ') do
206 inc(ReadPos);
207 // read word
208 WordStart:=ReadPos;
209 while (ReadPos<=length(DirectiveValue))
210 and (DirectiveValue[ReadPos]in ['a'..'z','A'..'Z']) do
211 inc(ReadPos);
212 WordEnd:=ReadPos;
213 Result:=WordStart<WordEnd;
214 end;
215
216 var
217 ReadPos: Integer;
218 WordStart, WordEnd,ValueStart, ValueEnd: integer;
219 CurValue: Boolean;
220 begin
221 Result:=DefaultValue;
222 if (FlagName='') or (DirectiveValue='') then exit;
223 ReadPos:=1;
224 repeat
225 if not ReadNextWord(ReadPos,WordStart,WordEnd) then exit;
226 // read value
227 if ReadPos>length(DirectiveValue) then begin
228 // missing value
229 exit;
230 end;
231 case DirectiveValue[ReadPos] of
232 '+','-':
233 begin
234 CurValue:=DirectiveValue[ReadPos]='+';
235 inc(ReadPos);
236 end;
237 ' ':
238 begin
239 if not ReadNextWord(ReadPos,ValueStart,ValueEnd) then exit;
240 if CompareText(@DirectiveValue[ValueStart],ValueEnd-ValueStart,
241 'ON',2,false)=0
242 then
243 CurValue:=true
244 else if CompareText(@DirectiveValue[ValueStart],ValueEnd-ValueStart,
245 'OFF',3,false)=0
246 then
247 CurValue:=false
248 else
249 // syntax error
250 exit;
251 end;
252 else
253 // syntax error
254 exit;
255 end;
256 if CompareText(@DirectiveValue[WordStart],WordEnd-WordStart,
257 @FlagName[1],length(FlagName),false)=0
258 then begin
259 Result:=CurValue;
260 exit;
261 end;
262 until false;
263 end;
264
265 procedure SetIDEDirective(DirectiveList: TStrings; const DirectiveName: string;
266 const NewValue, DefaultValue: string);
267 var
268 Index: Integer;
269 NewEntry: String;
270 begin
271 if (DirectiveName='') or (DirectiveList=nil) then exit;
272 //DebugLn(['SetIDEDirective ',DirectiveName,' NewValue="',NewValue,'" DefaultValue="',DefaultValue,'"']);
273 Index:=IndexOfIDEDirective(DirectiveList,DirectiveName);
274 if NewValue=DefaultValue then begin
275 // value is default -> remove entry
276 while Index>=0 do begin
277 DirectiveList.Delete(Index);
278 Index:=IndexOfIDEDirective(DirectiveList,DirectiveName);
279 end;
280 exit;
281 end else begin
282 // value is not default
283 NewEntry:='{%'+DirectiveName+' '+StringToIDEDirectiveValue(NewValue)+'}';
284 if Index<0 then
285 Index:=DirectiveList.Add(NewEntry)
286 else
287 DirectiveList[Index]:=NewEntry;
288 end;
289 end;
290
StringToIDEDirectiveValuenull291 function StringToIDEDirectiveValue(const s: string): string;
292 var
293 NewLength: Integer;
294 i: Integer;
295 ResultPos: Integer;
296 SpecialIndex: Integer;
297 begin
298 NewLength:=length(s);
299 for i:=1 to length(s) do
300 if Pos(s[i],IDEDirectiveSpecialChars)>0 then
301 inc(NewLength);
302 if NewLength=length(s) then begin
303 Result:=s;
304 exit;
305 end;
306 SetLength(Result,NewLength);
307 ResultPos:=1;
308 for i:=1 to length(s) do begin
309 SpecialIndex:=Pos(s[i],IDEDirectiveSpecialChars);
310 if SpecialIndex>0 then begin
311 Result[ResultPos]:='%';
312 inc(ResultPos);
313 Result[ResultPos]:=chr(ord('0')+SpecialIndex);
314 inc(ResultPos);
315 end else begin
316 Result[ResultPos]:=s[i];
317 inc(ResultPos);
318 end;
319 end;
320 if ResultPos<>NewLength+1 then
321 RaiseGDBException('Internal error');
322 end;
323
IDEDirectiveValueToStringnull324 function IDEDirectiveValueToString(const s: string): string;
325 var
326 NewLength: Integer;
327 i: Integer;
328 ResultPos: Integer;
329 SpecialIndex: Integer;
330 begin
331 NewLength:=length(s);
332 for i:=1 to length(s) do
333 if (s[i]='%') and (i<length(s)) then
334 dec(NewLength);
335 if NewLength=length(s) then begin
336 Result:=s;
337 exit;
338 end;
339 SetLength(Result,NewLength);
340 ResultPos:=1;
341 i:=1;
342 while i<=length(s) do begin
343 if (s[i]='%') and (i<length(s)) then begin
344 inc(i);
345 SpecialIndex:=ord(s[i])-ord('0');
346 inc(i);
347 if (SpecialIndex<1) or (SpecialIndex>length(IDEDirectiveSpecialChars))
348 then
349 Result[ResultPos]:='?'
350 else
351 Result[ResultPos]:=IDEDirectiveSpecialChars[SpecialIndex];
352 inc(ResultPos);
353 end else begin
354 Result[ResultPos]:=s[i];
355 inc(ResultPos);
356 inc(i);
357 end;
358 end;
359 if ResultPos<>NewLength+1 then
360 RaiseGDBException('Internal error');
361 end;
362
IDEDirectiveNameToDirectivenull363 function IDEDirectiveNameToDirective(const DirectiveName: string): TIDEDirective;
364 begin
365 for Result:=Low(TIDEDirective) to High(TIDEDirective) do
366 if CompareText(IDEDirectiveNames[Result],DirectiveName)=0 then exit;
367 Result:=idedNone;
368 end;
369
IDEDirBuildScanFlagNameToFlagnull370 function IDEDirBuildScanFlagNameToFlag(const FlagName: string): TIDEDirBuildScanFlag;
371 begin
372 for Result:=Low(TIDEDirBuildScanFlag) to High(TIDEDirBuildScanFlag) do
373 if CompareText(IDEDirBuildScanFlagNames[Result],FlagName)=0 then
374 exit;
375 Result:=idedbsfNone;
376 end;
377
GetIDEDirBuildScanFromStringnull378 function GetIDEDirBuildScanFromString(const s: string): TIDEDirBuildScanFlags;
379 var
380 f: TIDEDirBuildScanFlag;
381 begin
382 Result:=[];
383 for f:=Low(TIDEDirBuildScanFlag) to High(TIDEDirBuildScanFlag) do begin
384 if f=idedbsfNone then continue;
385 if GetIDEDirectiveFlag(s,IDEDirBuildScanFlagNames[f],
386 f in IDEDirBuildScanFlagDefValues)
387 then
388 Include(Result,f);
389 end;
390 end;
391
GetIDEDirBuildScanStrFromFlagsnull392 function GetIDEDirBuildScanStrFromFlags(Flags: TIDEDirBuildScanFlags): string;
393 var
394 f: TIDEDirBuildScanFlag;
395 begin
396 Result:='';
397 for f:=Low(TIDEDirBuildScanFlag) to High(TIDEDirBuildScanFlag) do begin
398 if f=idedbsfNone then continue;
399 if (f in Flags)<>(f in IDEDirBuildScanFlagDefValues) then
400 AddFlagStr(Result,IDEDirBuildScanFlagNames[f],f in Flags);
401 end;
402 end;
403
IDEDirRunFlagNameToFlagnull404 function IDEDirRunFlagNameToFlag(const FlagName: string): TIDEDirRunFlag;
405 begin
406 for Result:=Low(TIDEDirRunFlag) to High(TIDEDirRunFlag) do
407 if CompareText(IDEDirRunFlagNames[Result],FlagName)=0 then
408 exit;
409 Result:=idedrfNone;
410 end;
411
GetIDEDirRunFlagFromStringnull412 function GetIDEDirRunFlagFromString(const s: string): TIDEDirRunFlags;
413 begin
414 Result:=GetIDEDirRunFlagFromString(s,IDEDirRunFlagDefValues);
415 end;
416
GetIDEDirRunFlagFromStringnull417 function GetIDEDirRunFlagFromString(const s: string;
418 DefaultFlags: TIDEDirRunFlags): TIDEDirRunFlags;
419 var
420 f: TIDEDirRunFlag;
421 begin
422 Result:=[];
423 for f:=Low(TIDEDirRunFlag) to High(TIDEDirRunFlag) do begin
424 if f=idedrfNone then continue;
425 if GetIDEDirectiveFlag(s,IDEDirRunFlagNames[f],f in DefaultFlags)
426 then
427 Include(Result,f);
428 end;
429 end;
430
GetIDEDirRunFlagStrFromFlagsnull431 function GetIDEDirRunFlagStrFromFlags(Flags: TIDEDirRunFlags): string;
432 var
433 f: TIDEDirRunFlag;
434 begin
435 Result:='';
436 for f:=Low(TIDEDirRunFlag) to High(TIDEDirRunFlag) do begin
437 if f=idedrfNone then continue;
438 if (f in Flags)<>(f in IDEDirRunFlagDefValues) then
439 AddFlagStr(Result,IDEDirRunFlagNames[f],f in Flags);
440 end;
441 end;
442
443 { TBuildFileDialog }
444
445 procedure TBuildFileDialog.BuildFileDialogKeyDown(Sender: TObject;
446 var Key: Word; Shift: TShiftState);
447 begin
448 if Key=VK_ESCAPE then ModalResult:=mrCancel;
449 end;
450
451 procedure TBuildFileDialog.BuildMacroSelectionBoxAddMacro(Sender: TObject);
452 var
453 MacroCode: string;
454 Macro: TTransferMacro;
455 begin
456 MacroCode:='';
457 Macro:=BuildMacroSelectionBox.GetSelectedMacro(MacroCode);
458 if Macro=nil then exit;
459 BuildCommandMemo.SelText:=MacroCode;
460 end;
461
462 procedure TBuildFileDialog.HelpButtonClick(Sender: TObject);
463 begin
464 LazarusHelp.ShowHelpForIDEControl(Self);
465 end;
466
467 procedure TBuildFileDialog.OkButtonClick(Sender: TObject);
468 begin
469 WriteDirectiveList;
470 ModalResult:=mrOk;
471 end;
472
473 procedure TBuildFileDialog.RunMacroSelectionBoxAddMacro(Sender: TObject);
474 var
475 MacroCode: string;
476 Macro: TTransferMacro;
477 begin
478 MacroCode:='';
479 Macro:=RunMacroSelectionBox.GetSelectedMacro(MacroCode);
480 if Macro=nil then exit;
481 RunCommandMemo.SelText:=MacroCode;
482 end;
483
484 procedure TBuildFileDialog.BuildFileDialogCreate(Sender: TObject);
485 begin
486 Notebook1.PageIndex:=0;
487
488 BuildMacroSelectionBox:=TMacroSelectionBox.Create(Self);
489 with BuildMacroSelectionBox do begin
490 Name:='BuildMacroSelectionBox';
491 Caption:=lisEdtExtToolMacros;
492 OnAddMacro:=@BuildMacroSelectionBoxAddMacro;
493 AnchorToNeighbour(akTop,0,BuildScanForMakeMsgCheckbox);
494 BorderSpacing.Around:=6;
495 Align:=alClient;
496 Parent:=BuildPage;
497 end;
498
499 RunMacroSelectionBox:=TMacroSelectionBox.Create(Self);
500 with RunMacroSelectionBox do begin
501 Name:='RunMacroSelectionBox';
502 Caption:=lisEdtExtToolMacros;
503 OnAddMacro:=@RunMacroSelectionBoxAddMacro;
504 AnchorToNeighbour(akTop,0,RunCommandGroupbox);
505 BorderSpacing.Around:=6;
506 Align:=alClient;
507 Parent:=RunPage;
508 end;
509
510 GeneralPage.Caption:=lisOptions;
511 WhenFileIsActiveGroupbox.Caption:=lisBFWhenThisFileIsActiveInSourceEditor;
512 OverrideBuildProjectCheckbox.Caption:=
513 lisBFOnBuildProjectExecuteTheBuildFileCommandInstead;
514 OverrideRunProjectCheckbox.Caption:=
515 lisBFOnRunProjectExecuteTheRunFileCommandInstead;
516
517 BuildPage.Caption:=lisBuildCaption;
518 BuildWorkingDirGroupbox.Caption:=lisBFWorkingDirectoryLeaveEmptyForFilePath;
519 BuildCommandGroupbox.Caption:=lisBFBuildCommand;
520 BuildScanForFPCMsgCheckbox.Caption:=lisCOScanForFPCMessages;
521 BuildScanForMakeMsgCheckbox.Caption:=lisCOScanForMakeMessages;
522
523 RunPage.Caption:=lisRun;
524 RunBeforeBuildCheckbox.Caption:=lisBFAlwaysBuildBeforeRun;
525 RunShowOutputCheckBox.Caption:=lisShowOutput;
526 RunWorkDirGroupbox.Caption:=lisBFWorkingDirectoryLeaveEmptyForFilePath;
527 RunCommandGroupbox.Caption:=lisBFRunCommand;
528
529 ButtonPanel.HelpButton.OnClick := @HelpButtonClick;
530 ButtonPanel.OKButton.OnClick := @OKButtonClick;
531
532 BuildWorkDirCombobox.DropDownCount:=EnvironmentOptions.DropDownCount;
533 RunWorkDirCombobox.DropDownCount:=EnvironmentOptions.DropDownCount;
534 end;
535
536 procedure TBuildFileDialog.BuildBrowseWorkDirButtonCLICK(Sender: TObject);
537 var
538 OpenDialog: TSelectDirectoryDialog;
539 NewFilename: String;
540 ComboBox: TComboBox;
541 begin
542 OpenDialog:=TSelectDirectoryDialog.Create(Self);
543 try
544 InputHistories.ApplyFileDialogSettings(OpenDialog);
545 if Sender=BuildBrowseWorkDirButton then
546 OpenDialog.Title:=lisWorkingDirectoryForBuilding
547 else if Sender=RunBrowseWorkDirButton then
548 OpenDialog.Title:=lisWorkingDirectoryForRun
549 else
550 exit;
551 OpenDialog.Filename:='';
552 OpenDialog.InitialDir:=ExtractFilePath(Filename);
553 if OpenDialog.Execute then begin
554 NewFilename:=TrimFilename(OpenDialog.Filename);
555 if Sender=BuildBrowseWorkDirButton then
556 ComboBox:=BuildWorkDirCombobox
557 else if Sender=RunBrowseWorkDirButton then
558 ComboBox:=RunWorkDirCombobox;
559 SetComboBoxText(ComboBox,NewFilename,cstFilename);
560 end;
561 InputHistories.StoreFileDialogSettings(OpenDialog);
562 finally
563 OpenDialog.Free;
564 end;
565 end;
566
567 procedure TBuildFileDialog.SetDirectiveList(const AValue: TStrings);
568 begin
569 if FDirectiveList=AValue then exit;
570 FDirectiveList:=AValue;
571 ReadDirectiveList;
572 end;
573
574 procedure TBuildFileDialog.SetFilename(const AValue: string);
575 begin
576 if FFilename=AValue then exit;
577 FFilename:=AValue;
578 UpdateCaption;
579 end;
580
581 procedure TBuildFileDialog.SetMacroList(const AValue: TTransferMacroList);
582 begin
583 if FMacroList=AValue then exit;
584 FMacroList:=AValue;
585 BuildMacroSelectionBox.MacroList:=MacroList;
586 RunMacroSelectionBox.MacroList:=MacroList;
587 end;
588
589 procedure TBuildFileDialog.SetBuildFileIfActive(const AValue: boolean);
590 begin
591 OverrideBuildProjectCheckbox.Checked:=AValue;
592 end;
593
TBuildFileDialog.GetBuildFileIfActivenull594 function TBuildFileDialog.GetBuildFileIfActive: boolean;
595 begin
596 Result:=OverrideBuildProjectCheckbox.Checked;
597 end;
598
GetRunFileIfActivenull599 function TBuildFileDialog.GetRunFileIfActive: boolean;
600 begin
601 Result:=OverrideRunProjectCheckbox.Checked;
602 end;
603
604 procedure TBuildFileDialog.SetRunFileIfActive(const AValue: boolean);
605 begin
606 OverrideRunProjectCheckbox.Checked:=AValue;
607 end;
608
609 procedure TBuildFileDialog.UpdateCaption;
610 begin
611 Caption:=Format(lisConfigureBuild, [Filename]);
612 end;
613
614 procedure TBuildFileDialog.ReadDirectiveList;
615 var
616 BuildWorkingDir: String;
617 BuildCommand: String;
618 BuildScanForFPCMsg: Boolean;
619 BuildScanForMakeMsg: Boolean;
620 RunWorkingDir: String;
621 RunCommand: String;
622 BuildScanStr: String;
623 BuildScan: TIDEDirBuildScanFlags;
624 RunFlags: TIDEDirRunFlags;
625 begin
626 // get values from directive list
627 // build
628 BuildWorkingDir:=GetIDEStringDirective(DirectiveList,
629 IDEDirectiveNames[idedBuildWorkingDir],
630 '');
631 BuildCommand:=GetIDEStringDirective(DirectiveList,
632 IDEDirectiveNames[idedBuildCommand],
633 IDEDirDefaultBuildCommand);
634 BuildScanStr:=GetIDEStringDirective(DirectiveList,
635 IDEDirectiveNames[idedBuildScan],'');
636 BuildScan:=GetIDEDirBuildScanFromString(BuildScanStr);
637 BuildScanForFPCMsg:=idedbsfFPC in BuildScan;
638 BuildScanForMakeMsg:=idedbsfMake in BuildScan;
639
640 // run
641 RunFlags:=GetIDEDirRunFlagFromString(
642 GetIDEStringDirective(DirectiveList,
643 IDEDirectiveNames[idedRunFlags],''));
644 RunWorkingDir:=GetIDEStringDirective(DirectiveList,
645 IDEDirectiveNames[idedRunWorkingDir],'');
646 RunCommand:=GetIDEStringDirective(DirectiveList,
647 IDEDirectiveNames[idedRunCommand],
648 IDEDirDefaultRunCommand);
649
650 // set values to dialog
651 BuildWorkDirCombobox.Text:=BuildWorkingDir;
652 BuildCommandMemo.Lines.Text:=BuildCommand;
653 BuildScanForFPCMsgCheckbox.Checked:=BuildScanForFPCMsg;
654 BuildScanForMakeMsgCheckbox.Checked:=BuildScanForMakeMsg;
655 RunBeforeBuildCheckbox.Checked:=idedrfBuildBeforeRun in RunFlags;
656 RunShowOutputCheckBox.Checked:=idedrfMessages in RunFlags;
657 RunWorkDirCombobox.Text:=RunWorkingDir;
658 RunCommandMemo.Lines.Text:=RunCommand;
659 end;
660
661 procedure TBuildFileDialog.WriteDirectiveList;
662 var
663 BuildWorkingDir: String;
664 BuildCommand: String;
665 BuildScanForFPCMsg: Boolean;
666 BuildScanForMakeMsg: Boolean;
667 BuildScan: TIDEDirBuildScanFlags;
668 RunWorkingDir: String;
669 RunCommand: String;
670 RunFlags: TIDEDirRunFlags;
671 begin
672 // get values from dialog
673 // build
674 BuildWorkingDir:=SpecialCharsToSpaces(BuildWorkDirCombobox.Text,true);
675 BuildCommand:=SpecialCharsToSpaces(BuildCommandMemo.Lines.Text,true);
676 BuildScanForFPCMsg:=BuildScanForFPCMsgCheckbox.Checked;
677 BuildScanForMakeMsg:=BuildScanForMakeMsgCheckbox.Checked;
678 BuildScan:=[];
679 if BuildScanForFPCMsg then Include(BuildScan,idedbsfFPC);
680 if BuildScanForMakeMsg then Include(BuildScan,idedbsfMake);
681
682 // run
683 RunFlags:=[];
684 if RunBeforeBuildCheckbox.Checked then Include(RunFlags,idedrfBuildBeforeRun);
685 if RunShowOutputCheckBox.Checked then Include(RunFlags,idedrfMessages);
686 RunWorkingDir:=SpecialCharsToSpaces(RunWorkDirCombobox.Text,true);
687 RunCommand:=SpecialCharsToSpaces(RunCommandMemo.Lines.Text,true);
688
689 // set values to directivelist
690 //DebugLn(['TBuildFileDialog.WriteDirectiveList ']);
691 SetIDEDirective(DirectiveList,IDEDirectiveNames[idedBuildWorkingDir],
692 BuildWorkingDir,'');
693 SetIDEDirective(DirectiveList,IDEDirectiveNames[idedBuildCommand],
694 BuildCommand,IDEDirDefaultBuildCommand);
695 SetIDEDirective(DirectiveList,IDEDirectiveNames[idedBuildScan],
696 GetIDEDirBuildScanStrFromFlags(BuildScan),'');
697 SetIDEDirective(DirectiveList,IDEDirectiveNames[idedRunWorkingDir],
698 RunWorkingDir,'');
699 SetIDEDirective(DirectiveList,IDEDirectiveNames[idedRunCommand],
700 RunCommand,IDEDirDefaultRunCommand);
701 SetIDEDirective(DirectiveList,IDEDirectiveNames[idedRunFlags],
702 GetIDEDirRunFlagStrFromFlags(RunFlags),'');
703 end;
704
705 { TMacroSelectionBox }
706
707 procedure TMacroSelectionBox.ListBoxClick(Sender: TObject);
708 begin
709 AddButton.Enabled:=(Listbox.ItemIndex>=0);
710 end;
711
712 procedure TMacroSelectionBox.AddButtonClick(Sender: TObject);
713 begin
714 if Assigned(OnAddMacro) then OnAddMacro(Self);
715 end;
716
717 procedure TMacroSelectionBox.SetMacroList(const AValue: TTransferMacroList);
718 begin
719 if FMacroList=AValue then exit;
720 FMacroList:=AValue;
721 FillListBox;
722 end;
723
724 procedure TMacroSelectionBox.FillListBox;
725 var
726 i: Integer;
727 Macro: TTransferMacro;
728 begin
729 ListBox.Items.BeginUpdate;
730 ListBox.Items.Clear;
731 if MacroList=nil then exit;
732 for i:=0 to MacroList.Count-1 do begin
733 Macro:=MacroList[i];
nilnull734 if Macro.MacroFunction=nil then begin
735 Listbox.Items.Add('$('+Macro.Name+') - '+Macro.Description);
736 end else begin
737 Listbox.Items.Add('$'+Macro.Name+'() - '+Macro.Description);
738 end;
739 end;
740 ListBox.Items.EndUpdate;
741 end;
742
743 constructor TMacroSelectionBox.Create(TheOwner: TComponent);
744 begin
745 inherited Create(TheOwner);
746
747 AddButton:=TButton.Create(Self);
748 with AddButton do begin
749 Name:='AddButton';
750 Caption:=lisAdd;
751 OnClick:=@AddButtonClick;
752 Enabled:=false;
753 AutoSize:=true;
754 Anchors:=[akTop,akRight];
755 Top:=0;
756 BorderSpacing.Around := 6;
757 AnchorParallel(akTop,0,Self);
758 AnchorParallel(akRight,0,Self);
759 Parent:=Self;
760 end;
761
762 ListBox:=TListBox.Create(Self);
763 with ListBox do begin
764 Name:='ListBox';
765 OnClick:=@ListBoxClick;
766 Align:=alLeft;
767 BorderSpacing.Around := 6;
768 AnchorToNeighbour(akRight, 0, AddButton);
769 Parent:=Self;
770 end;
771 end;
772
GetSelectedMacronull773 function TMacroSelectionBox.GetSelectedMacro(
774 var MacroAsCode: string): TTransferMacro;
775 var
776 i: integer;
777 begin
778 Result:=nil;
779 MacroAsCode:='';
780 if MacroList=nil then exit;
781 i:=Listbox.ItemIndex;
782 if i<0 then exit;
783 Result:=MacroList[i];
nilnull784 if Result.MacroFunction=nil then
785 MacroAsCode:='$('+Result.Name+')'
786 else
787 MacroAsCode:='$'+Result.Name+'()';
788 end;
789
790 initialization
791 IDEDirectiveSpecialChars:='{}*%';
792
793 end.
794
795