1 { /***************************************************************************
2 imexportcompilerOpts.pas
3 ------------------------
4
5 ***************************************************************************/
6
7 ***************************************************************************
8 * *
9 * This source is free software; you can redistribute it and/or modify *
10 * it under the terms of the GNU General Public License as published by *
11 * the Free Software Foundation; either version 2 of the License, or *
12 * (at your option) any later version. *
13 * *
14 * This code is distributed in the hope that it will be useful, but *
15 * WITHOUT ANY WARRANTY; without even the implied warranty of *
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
17 * General Public License for more details. *
18 * *
19 * A copy of the GNU General Public License is available on the World *
20 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
21 * obtain it by writing to the Free Software Foundation, *
22 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
23 * *
24 ***************************************************************************
25
26 Author: Mattias Gaertner, Juha Manninen
27 }
28 unit ImExportCompilerOpts;
29
30 {$mode objfpc}{$H+}
31
32 interface
33
34 uses
35 SysUtils,
36 // LCL
37 LCLType, Forms, Controls, Dialogs, StdCtrls, Buttons, ExtCtrls, ButtonPanel,
38 // LazUtils
39 FileUtil, LazFileUtils, Laz2_XMLCfg,
40 // IdeIntf
41 IDEOptEditorIntf, IDEImagesIntf,
42 // IDE
43 IDEProcs, LazarusIDEStrConsts, InputHistory, Project, CompilerOptions;
44
45 type
46 { TImExportCompOptsDlg }
47
48 TImExportCompOptsDlg = class(TForm)
49 ButtonBrowse: TButton;
50 ButtonPanel1: TButtonPanel;
51 ExportRadioGroup: TRadioGroup;
52 FileLabel: TLabel;
53 FileNameEdit: TComboBox;
54 OpenDlg: TOpenDialog;
55 SaveDlg: TSaveDialog;
56 procedure ButtonBrowseClick(Sender: TObject);
57 procedure FileNameEditChange(Sender: TObject);
58 procedure ImExportCompOptsDlgCLOSE(Sender: TObject; var {%H-}CloseAction: TCloseAction);
59 procedure ImExportCompOptsDlgCREATE(Sender: TObject);
60 procedure OpenButtonCLICK(Sender: TObject);
61 procedure SaveButtonCLICK(Sender: TObject);
62 private
63 FFilename: string;
64 FParentDialog: TAbstractOptionsEditorDialog;
65 FExport: boolean;
66 procedure InitExport(AOptions: TBaseCompilerOptions);
67 procedure InitImport;
68 procedure LoadRecentList;
69 //procedure SaveRecentList;
70 procedure SetFilename(const AValue: string);
71 procedure DoOpenFile(const AFilename: string);
72 procedure DoSaveFile(const AFilename: string);
73 public
74 property Filename: string read FFilename write SetFilename;
75 end;
76
77 { TOptsImExport }
78
79 TOptsImExport = class
80 private
81 fOptions: TBaseCompilerOptions; // TProjectCompilerOptions or TPkgCompilerOptions
82 fImExportDlg: TImExportCompOptsDlg;
83 fXMLConfig: TXMLConfig;
GetXMLPathForCompilerOptionsnull84 function GetXMLPathForCompilerOptions: string;
OpenXMLnull85 function OpenXML(const Filename: string): TModalResult;
86 public
DoImportnull87 function DoImport(const Filename: string): TModalResult;
DoExportOptionsnull88 function DoExportOptions(const Filename: string): TModalResult;
DoExportBuildModesnull89 function DoExportBuildModes(const Filename: string): TModalResult;
90 constructor Create(AOptions: TBaseCompilerOptions; aImExportDlg: TImExportCompOptsDlg);
91 destructor Destroy; override;
92 end;
93
ShowImportCompilerOptionsDialognull94 function ShowImportCompilerOptionsDialog(AOptions: TBaseCompilerOptions;
95 aDialog: TAbstractOptionsEditorDialog): TModalResult;
ShowExportCompilerOptionsDialognull96 function ShowExportCompilerOptionsDialog(AOptions: TBaseCompilerOptions;
97 aDialog: TAbstractOptionsEditorDialog): TModalResult;
98
99
100 implementation
101
102 {$R *.lfm}
103
104 const
105 DefaultCompilerOptPath = 'CompilerOptions/';
106
ShowImportCompilerOptionsDialognull107 function ShowImportCompilerOptionsDialog(AOptions: TBaseCompilerOptions;
108 aDialog: TAbstractOptionsEditorDialog): TModalResult;
109 var
110 ImExportCompOptsDlg: TImExportCompOptsDlg;
111 Importer: TOptsImExport;
112 begin
113 ImExportCompOptsDlg := TImExportCompOptsDlg.Create(nil);
114 try
115 ImExportCompOptsDlg.FParentDialog := aDialog;
116 ImExportCompOptsDlg.InitImport;
117 Result := ImExportCompOptsDlg.ShowModal;
118 if Result <> mrOk then Exit;
119 Importer := TOptsImExport.Create(AOptions, ImExportCompOptsDlg);
120 try
121 Result := Importer.DoImport(ImExportCompOptsDlg.Filename);
122 finally
123 Importer.Free;
124 end;
125 finally
126 ImExportCompOptsDlg.Free;
127 end;
128 end;
129
ShowExportCompilerOptionsDialognull130 function ShowExportCompilerOptionsDialog(AOptions: TBaseCompilerOptions;
131 aDialog: TAbstractOptionsEditorDialog): TModalResult;
132 var
133 ImExportCompOptsDlg: TImExportCompOptsDlg;
134 Exporter: TOptsImExport;
135 begin
136 ImExportCompOptsDlg := TImExportCompOptsDlg.Create(nil);
137 try
138 ImExportCompOptsDlg.FParentDialog := aDialog;
139 ImExportCompOptsDlg.InitExport(AOptions);
140 Result := ImExportCompOptsDlg.ShowModal;
141 if Result <> mrOk then Exit;
142 Exporter := TOptsImExport.Create(AOptions, ImExportCompOptsDlg);
143 try
144 case ImExportCompOptsDlg.ExportRadioGroup.ItemIndex of
145 0: Result := Exporter.DoExportOptions(ImExportCompOptsDlg.Filename);
146 1: Result := Exporter.DoExportBuildModes(ImExportCompOptsDlg.Filename);
147 end;
148 finally
149 Exporter.Free;
150 end;
151 finally
152 ImExportCompOptsDlg.Free;
153 end;
154 end;
155
156 { TOptsImExport }
157
158 constructor TOptsImExport.Create(AOptions: TBaseCompilerOptions;
159 aImExportDlg: TImExportCompOptsDlg);
160 begin
161 inherited Create;
162 fOptions := AOptions;
163 fImExportDlg := aImExportDlg;
164 end;
165
166 destructor TOptsImExport.Destroy;
167 begin
168 fXMLConfig.Free;
169 inherited Destroy;
170 end;
171
OpenXMLnull172 function TOptsImExport.OpenXML(const Filename: string): TModalResult;
173 begin
174 Result := mrOk;
175 try
176 fXMLConfig:=TXMLConfig.Create(Filename);
177 except
178 on E: Exception do
179 begin
180 Result:=MessageDlg(lisIECOErrorOpeningXml,
181 Format(lisIECOErrorOpeningXmlFile, [Filename, LineEnding, E.Message]),
182 mtError, [mbCancel], 0);
183 end;
184 end;
185 end;
186
GetXMLPathForCompilerOptionsnull187 function TOptsImExport.GetXMLPathForCompilerOptions: string;
188 const
189 OptPathSuffix = 'SearchPaths/CompilerPath/Value';
190 PkgCompilerOptPath = 'Package/CompilerOptions/';
191 PkgVersionPath = 'Package/Version';
192 var
193 FileVersion: Integer;
194 begin
195 if fXMLConfig.GetValue(OptPathSuffix,'')<>'' then
196 // old lpi file
197 Result:=''
198 else if fXMLConfig.GetValue(DefaultCompilerOptPath+OptPathSuffix,'')<>'' then
199 // current lpi file
200 Result:=DefaultCompilerOptPath
201 else if fXMLConfig.GetValue(PkgCompilerOptPath+OptPathSuffix,'')<>'' then
202 // current lpk file
203 Result:=PkgCompilerOptPath
204 else begin
205 // default: depending on file type
206 Result:=DefaultCompilerOptPath;
207 if FilenameExtIs(fXMLConfig.Filename,'lpk',true) then
208 begin
209 try
210 FileVersion:=fXMLConfig.GetValue(PkgVersionPath,2);
211 except
212 FileVersion:=2; // On error assume version 2.
213 end;
214 if FileVersion>=2 then
215 Result:=PkgCompilerOptPath; // current lpk file
216 end;
217 end;
218 end;
219
TOptsImExport.DoImportnull220 function TOptsImExport.DoImport(const Filename: string): TModalResult;
221 // Import options to project or package. Only projects support BuildModes.
222 var
223 CompOptPath: String;
224 begin
225 Result := OpenXML(Filename);
226 if Result <> mrOK then Exit;
227 CompOptPath := GetXMLPathForCompilerOptions;
228 if Assigned(fXMLConfig.FindNode('BuildModes',False)) then
229 begin // The import file has BuildModes.
230 if fOptions is TProjectCompilerOptions then
231 begin // Project options
232 Project1.BuildModes.LoadProjOptsFromXMLConfig(fXMLConfig, '');
233 fImExportDlg.FParentDialog.UpdateBuildModeGUI;
234 ShowMessageFmt(lisSuccessfullyImportedBuildModes, [Project1.BuildModes.Count, Filename]);
235 end
236 else begin // Package options
237 ShowMessage(lisImportingBuildModesNotSupported);
238 Result := mrAbort;
239 end;
240 end
241 else if Assigned(fXMLConfig.FindNode(CompOptPath,False)) then
242 begin
243 fOptions.LoadFromXMLConfig(fXMLConfig, CompOptPath);
244 ShowMessageFmt(lisSuccessfullyImportedCompilerOptions, [Filename]);
245 end
246 else
247 ShowMessageFmt(lisIECONoCompilerOptionsInFile, [Filename]);
248 end;
249
TOptsImExport.DoExportOptionsnull250 function TOptsImExport.DoExportOptions(const Filename: string): TModalResult;
251 // Export options of project or package.
252 begin
253 Result := OpenXML(Filename);
254 if Result <> mrOK then Exit;
255 fOptions.SaveToXMLConfig(fXMLConfig, DefaultCompilerOptPath);
256 fXMLConfig.Flush;
257 ShowMessageFmt(lisSuccessfullyExportedCompilerOptions, [Filename]);
258 end;
259
TOptsImExport.DoExportBuildModesnull260 function TOptsImExport.DoExportBuildModes(const Filename: string): TModalResult;
261 // Export options of project's BuildModes. Packages don't have BuildModes.
262 begin
263 Result := OpenXML(Filename);
264 if Result <> mrOK then Exit;
265 Project1.BuildModes.SaveProjOptsToXMLConfig(fXMLConfig, '', False, True);
266 fXMLConfig.Flush;
267 ShowMessageFmt(lisSuccessfullyExportedBuildModes, [Project1.BuildModes.Count, Filename]);
268 end;
269
270 { TImExportCompOptsDlg }
271
272 procedure TImExportCompOptsDlg.InitImport;
273 begin
274 FExport:=false;
275 Caption:=lisIECOImportCompilerOptions;
276 // ToDo: Later when the XML file is selected, ExportRadioGroup can be made
277 // Visible but disabled. Then ItemIndex must be set according to file contents.
278 // If file contains one mode -> ItemIndex:=0. If more modes -> ItemIndex:=1.
279 ExportRadioGroup.Visible:=False;
280
281 OpenDlg.Filter:=Format('%s|*.xml|'
282 +'%s|*.lpi|'
283 +'%s|*.lpk|'
284 +'%s|*.lps|'
285 +'%s|%s',
286 [dlgFilterXML,
287 dlgFilterLazarusProject,
288 dlgFilterLazarusPackage,
289 dlgFilterLazarusSession,
290 dlgFilterAll, GetAllFilesMask]);
291
292 with ButtonPanel1 do begin
293 OKButton.Caption:=lisIECOLoadFromFile;
294 OKButton.LoadGlyphFromStock(idButtonOpen);
295 if OKButton.Glyph.Empty then
296 IDEImages.AssignImage(OKButton, 'laz_open');
297 OKButton.Enabled:=False;
298 OKButton.OnClick:=@OpenButtonCLICK;
299 end;
300 end;
301
302 procedure TImExportCompOptsDlg.InitExport(AOptions: TBaseCompilerOptions);
303 begin
304 FExport:=true;
305 Caption:=lisIECOExportCompilerOptions;
306 SaveDlg.Filter:=Format('%s|*.xml|%s|%s',
307 [dlgFilterXML, dlgFilterAll, GetAllFilesMask]);
308
309 if not (AOptions is TProjectCompilerOptions) then
310 ExportRadioGroup.Visible:=False
311 else if Project1.BuildModes.Count <= 1 then
312 ExportRadioGroup.Enabled:=False;
313 with ButtonPanel1 do begin
314 OKButton.Caption:=lisIECOSaveToFile;
315 OKButton.LoadGlyphFromStock(idButtonSave);
316 if OKButton.Glyph.Empty then
317 IDEImages.AssignImage(OKButton, 'laz_save');
318 OKButton.Enabled:=False;
319 OKButton.OnClick:=@SaveButtonCLICK;
320 end;
321 end;
322
323 procedure TImExportCompOptsDlg.ImExportCompOptsDlgCREATE(Sender: TObject);
324 begin
325 FileLabel.Caption:=lisFile;
326 ExportRadioGroup.Caption:=lisIECOCompilerOptionsOf;
327 ExportRadioGroup.Items.Strings[0]:=lisIECOCurrentBuildMode;
328 ExportRadioGroup.Items.Strings[1]:=lisIECOAllBuildModes;
329 LoadRecentList;
330 end;
331
332 procedure TImExportCompOptsDlg.ButtonBrowseClick(Sender: TObject);
333 var
334 Dlg: TFileDialog;
335 begin
336 if FExport then Dlg:= SaveDlg
337 else Dlg:= OpenDlg;
338
339 with Dlg do
340 begin
341 FileName := '';
342 if Execute then
343 begin
344 FileNameEdit.Text := FileName;
345 FileNameEditChange(nil);
346 end;
347 end;
348 end;
349
350 procedure TImExportCompOptsDlg.FileNameEditChange(Sender: TObject);
351 begin
352 if FExport then
353 ButtonPanel1.OKButton.Enabled := FileNameEdit.Text <> ''
354 else
355 ButtonPanel1.OKButton.Enabled := FileExistsUTF8(FileNameEdit.Text);
356 end;
357
358 procedure TImExportCompOptsDlg.OpenButtonCLICK(Sender: TObject);
359 begin
360 DoOpenFile(CleanAndExpandFilename(FileNameEdit.Text));
361 end;
362
363 procedure TImExportCompOptsDlg.SaveButtonCLICK(Sender: TObject);
364 begin
365 DoSaveFile(CleanAndExpandFilename(FileNameEdit.Text));
366 end;
367
368 procedure TImExportCompOptsDlg.ImExportCompOptsDlgCLOSE(Sender: TObject; var CloseAction: TCloseAction);
369 begin
370 //SaveRecentList;
371 end;
372
373 procedure TImExportCompOptsDlg.LoadRecentList;
374 begin
375 FileNameEdit.Items.Assign(
376 InputHistories.HistoryLists.GetList(hlCompilerOptsImExport,true,rltFile));
377 end;
378 {
379 procedure TImExportCompOptsDlg.SaveRecentList;
380 begin
381 InputHistories.HistoryLists.GetList(hlCompilerOptsImExport,true,rltFile).Assign(
382 FileNameEdit.Items);
383 InputHistories.Save;
384 end;
385 }
386 procedure TImExportCompOptsDlg.SetFilename(const AValue: string);
387 begin
388 if FFilename=AValue then exit;
389 FFilename:=AValue;
390 InputHistories.HistoryLists.GetList(hlCompilerOptsImExport,true,rltFile).AppendEntry(FFilename);
391 LoadRecentList;
392 end;
393
394 procedure TImExportCompOptsDlg.DoOpenFile(const AFilename: string);
395 begin
396 if DirPathExists(AFilename) then exit;
397 Filename := AFilename;
398 ModalResult := mrOk;
399 end;
400
401 procedure TImExportCompOptsDlg.DoSaveFile(const AFilename: string);
402 var
403 MsgResult: TModalResult;
404 begin
405 if DirPathExists(AFilename) then exit;
406 if ExtractFileExt(AFilename) = '' then
407 Filename:=AFilename + '.xml'
408 else
409 Filename:=AFilename;
410 if FileExistsUTF8(Filename) then begin
411 MsgResult:=MessageDlg(lisIECOExportFileExists,
412 Format(lisIECOExportFileExistsOpenFileAndReplaceOnlyCompilerOpti,
413 [Filename, LineEnding, LineEnding]),
414 mtConfirmation,[mbYes,mbCancel],0);
415 if MsgResult<>mrYes then exit;
416 end;
417 ModalResult := mrOk;
418 end;
419
420 end.
421
422