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 unit DefinesGui;
22 
23 {$mode objfpc}{$H+}
24 
25 interface
26 
27 uses
28   Classes, Forms, StdCtrls, Buttons, ButtonPanel, CheckLst, LCLType, Controls,
29   IDEHelpIntf, IDEImagesIntf, LazarusIDEStrConsts, Compiler;
30 
31 type
32 
33   { TDefinesGuiForm }
34 
35   TDefinesGuiForm = class(TForm)
36     AddBtn: TBitBtn;
37     ButtonPanel: TButtonPanel;
38     DefinesCheckList: TCheckListBox;
39     gbNewDefine: TGroupBox;
40     RemoveBtn: TBitBtn;
41     edDefine: TEdit;
42     procedure FormCreate(Sender: TObject);
43     procedure FormShow(Sender: TObject);
44     procedure FormDestroy(Sender: TObject);
45     procedure AddBtnClick(Sender: TObject);
46     procedure EditChange(Sender: TObject);
47     procedure HelpButtonClick(Sender: TObject);
48     procedure DefinesCheckListClick(Sender: TObject);
49     procedure DefinesCheckListDblClick(Sender: TObject);
50     procedure RemoveBtnClick(Sender: TObject);
51     procedure DefinesCheckListKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
52   private
53     FIdleConnected: Boolean;
54     FOptionsReader: TCompilerOptReader;
55     FOptionsThread: TCompilerOptThread;
56     FCustomOptions: TStrings;
57     FUseComments: Boolean;
58     procedure SetIdleConnected(AValue: Boolean);
59     procedure OnIdle(Sender: TObject; var {%H-}Done: Boolean);
60     procedure DeleteSelected;
61     procedure UpdateButtons;
62   private
63     property IdleConnected: Boolean read FIdleConnected write SetIdleConnected;
64   public
ToCustomOptionsnull65     function ToCustomOptions(aStrings: TStrings): TModalResult;
66   public
67     property OptionsReader: TCompilerOptReader read FOptionsReader write FOptionsReader;
68     property OptionsThread: TCompilerOptThread read FOptionsThread write FOptionsThread;
69     property CustomOptions: TStrings read FCustomOptions write FCustomOptions;
70     property UseComments: Boolean read FUseComments write FUseComments;
71   end;
72 
73 
74 implementation
75 
76 {$R *.lfm}
77 
78 { TDefinesGuiForm }
79 
80 procedure TDefinesGuiForm.FormCreate(Sender: TObject);
81 begin
82   Caption := lisLazBuildDefines;
83   gbNewDefine.Caption := lisCodeToolsDefsDefine;
84   AddBtn.Caption := lisBtnAdd;
85   IDEImages.AssignImage(AddBtn, 'laz_add');
86   RemoveBtn.Caption := lisBtnRemove;
87   IDEImages.AssignImage(RemoveBtn, 'laz_delete');
88 end;
89 
90 procedure TDefinesGuiForm.FormShow(Sender: TObject);
91 begin
92   DefinesCheckListClick(Nil);
93   ActiveControl := DefinesCheckList;
94   IdleConnected := True;
95 end;
96 
97 procedure TDefinesGuiForm.FormDestroy(Sender: TObject);
98 begin
99 
100 end;
101 
102 procedure TDefinesGuiForm.AddBtnClick(Sender: TObject);
103 begin
104   DefinesCheckList.Items.Add(edDefine.Text);
105   DefinesCheckList.ItemIndex := DefinesCheckList.Items.Count-1;
106   UpdateButtons;
107 end;
108 
109 procedure TDefinesGuiForm.EditChange(Sender: TObject);
110 begin
111   UpdateButtons;
112 end;
113 
114 procedure TDefinesGuiForm.HelpButtonClick(Sender: TObject);
115 begin
116   LazarusHelp.ShowHelpForIDEControl(Self);
117 end;
118 
119 procedure TDefinesGuiForm.DefinesCheckListClick(Sender: TObject);
120 begin
121   with DefinesCheckList do
122     if ItemIndex > -1 then
123       edDefine.Text := Items[ItemIndex];
124   UpdateButtons;
125 end;
126 
127 procedure TDefinesGuiForm.DefinesCheckListDblClick(Sender: TObject);
128 begin
129   //ModalResult := mrOK;
130 end;
131 
132 procedure TDefinesGuiForm.RemoveBtnClick(Sender: TObject);
133 begin
134   DeleteSelected;
135 end;
136 
137 procedure TDefinesGuiForm.DefinesCheckListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
138 begin
139   if Key = VK_DELETE then
140   begin
141     DeleteSelected;
142     Key := 0;
143   end;
144 end;
145 
146 procedure TDefinesGuiForm.SetIdleConnected(AValue: Boolean);
147 begin
148   if FIdleConnected = AValue then exit;
149   FIdleConnected := AValue;
150   if FIdleConnected then
151     Application.AddOnIdleHandler(@OnIdle)
152   else
153     Application.RemoveOnIdleHandler(@OnIdle);
154 end;
155 
156 procedure TDefinesGuiForm.OnIdle(Sender: TObject; var Done: Boolean);
157 var
158   s: String;
159   i, ListInd: Integer;
160 begin
161   IdleConnected := False;
162   Screen.Cursor := crHourGlass;
163   try
164     FOptionsThread.EndParsing;            // Make sure the options are read.
165     // Parse and separate defines from other options.
166     FOptionsReader.FromCustomOptions(FCustomOptions);
167     // Check the found defines in the GUI.
168     for i := 0 to FOptionsReader.Defines.Count-1 do
169     begin
170       s := Copy(FOptionsReader.Defines[i], 3, MaxInt); // Skip '-d'.
171       ListInd := DefinesCheckList.Items.IndexOf(s);
172       if ListInd = -1 then
173       begin
174         DefinesCheckList.Items.Add(s);
175         ListInd := DefinesCheckList.Items.Count-1;
176       end;
177       DefinesCheckList.Checked[ListInd] := True;
178     end;
179   finally
180     Screen.Cursor := crDefault;
181   end;
182 end;
183 
184 procedure TDefinesGuiForm.DeleteSelected;
185 var
186   i: Integer;
187 begin
188   with DefinesCheckList.Items do
189     for i := Count-1 downto 0 do
190       if DefinesCheckList.Selected[i] then
191       begin
192         Delete(i);
193         UpdateButtons;
194       end;
195 end;
196 
197 procedure TDefinesGuiForm.UpdateButtons;
198 begin
199   AddBtn.Enabled := (edDefine.Text <> '')
200                 and (DefinesCheckList.Items.IndexOf(edDefine.Text) = -1);
201   RemoveBtn.Enabled := DefinesCheckList.SelCount > 0;
202 end;
203 
ToCustomOptionsnull204 function TDefinesGuiForm.ToCustomOptions(aStrings: TStrings): TModalResult;
205 var
206   i: Integer;
207 begin
208   // First update defines to OptionsReader.
209   FOptionsReader.Defines.Clear;
210   for i := 0 to DefinesCheckList.Count-1 do
211     if DefinesCheckList.Checked[i] then
212       FOptionsReader.Defines.Add('-d' + DefinesCheckList.Items[i]);
213   // Then add all options and defines.
214   FOptionsReader.ToCustomOptions(aStrings, FUseComments);
215   Result:=mrOk;
216 end;
217 
218 end.
219 
220