1 {
2 /***************************************************************************
3 patheditordlg.pp
4 ----------------
5
6 ***************************************************************************/
7
8 *****************************************************************************
9 See the file COPYING.modifiedLGPL.txt, included in this distribution,
10 for details about the license.
11 *****************************************************************************
12
13 Abstract:
14 Defines the TPathEditorDialog, which is a form to edit search paths
15
16 }
17 unit PathEditorDlg;
18
19 {$mode objfpc}{$H+}
20
21 interface
22
23 uses
24 Classes, SysUtils, types,
25 // LCL
26 LCLType, LCLProc, Forms, Controls, Buttons, StdCtrls, Dialogs, Menus, Graphics,
27 ButtonPanel, Clipbrd,
28 // LazUtils
29 FileUtil, LazFileUtils, LazStringUtils, LazFileCache, LazUTF8,
30 // LazControls
31 ShortPathEdit,
32 // IdeIntf
33 MacroIntf, IDEImagesIntf, IDEUtils,
34 // IDE
35 TransferMacros, GenericListSelect, LazarusIDEStrConsts;
36
37 type
38
39 { TPathEditorDialog }
40
41 TPathEditorDialog = class(TForm)
42 AddTemplateButton: TBitBtn;
43 ButtonPanel1: TButtonPanel;
44 CopyMenuItem: TMenuItem;
45 MoveDownButton: TSpeedButton;
46 MoveUpButton: TSpeedButton;
47 OpenDialog1: TOpenDialog;
48 SaveDialog1: TSaveDialog;
49 ExportMenuItem: TMenuItem;
50 ImportMenuItem: TMenuItem;
51 SeparMenuItem: TMenuItem;
52 PasteMenuItem: TMenuItem;
53 PopupMenu1: TPopupMenu;
54 ReplaceButton: TBitBtn;
55 AddButton: TBitBtn;
56 DeleteInvalidPathsButton: TBitBtn;
57 DirectoryEdit: TShortPathEdit;
58 DeleteButton: TBitBtn;
59 PathListBox: TListBox;
60 PathGroupBox: TGroupBox;
61 BrowseDialog: TSelectDirectoryDialog;
62 procedure AddButtonClick(Sender: TObject);
63 procedure AddTemplateButtonClick(Sender: TObject);
64 procedure CopyMenuItemClick(Sender: TObject);
65 procedure ExportMenuItemClick(Sender: TObject);
66 procedure FormDestroy(Sender: TObject);
67 procedure PasteMenuItemClick(Sender: TObject);
68 procedure DeleteInvalidPathsButtonClick(Sender: TObject);
69 procedure DeleteButtonClick(Sender: TObject);
70 procedure DirectoryEditAcceptDirectory(Sender: TObject; var Value: String);
71 procedure DirectoryEditChange(Sender: TObject);
72 procedure FormCreate(Sender: TObject);
73 procedure FormShow(Sender: TObject);
74 procedure MoveDownButtonClick(Sender: TObject);
75 procedure MoveUpButtonClick(Sender: TObject);
76 procedure PathListBoxDrawItem({%H-}Control: TWinControl; Index: Integer;
77 ARect: TRect; {%H-}State: TOwnerDrawState);
78 procedure PathListBoxKeyDown(Sender: TObject; var Key: Word;
79 Shift: TShiftState);
80 procedure PathListBoxSelectionChange(Sender: TObject; {%H-}User: boolean);
81 procedure ReplaceButtonClick(Sender: TObject);
82 procedure ImportMenuItemClick(Sender: TObject);
83 private
84 FBaseDirectory: string;
85 FEffectiveBaseDirectory: string;
86 FTemplateList: TStringListUTF8Fast;
87 procedure AddPath(aPath: String; aObject: TObject);
GetPathnull88 function GetPath: string;
BaseRelativenull89 function BaseRelative(const APath: string): String;
PathAsAbsolutenull90 function PathAsAbsolute(const APath: string): String;
PathMayExistnull91 function PathMayExist(APath: string): TObject;
92 procedure ReadHelper(Paths: TStringList);
93 procedure SetBaseDirectory(const AValue: string);
94 procedure SetPath(const AValue: string);
95 procedure SetTemplates(const AValue: string);
96 procedure UpdateButtons;
97 procedure WriteHelper(Paths: TStringList);
98 public
99 property BaseDirectory: string read FBaseDirectory write SetBaseDirectory;
100 property EffectiveBaseDirectory: string read FEffectiveBaseDirectory;
101 property Path: string read GetPath write SetPath;
102 property Templates: string {read GetTemplates} write SetTemplates;
103 end;
104
105 TOnPathEditorExecuted = function (Context: String; var NewPath: String): Boolean of object;
106
107 { TPathEditorButton }
108
109 TPathEditorButton = class(TButton)
110 private
111 FCurrentPathEditor: TPathEditorDialog;
112 FAssociatedEdit: TCustomEdit;
113 FContextCaption: String;
114 FTemplates: String;
115 FOnExecuted: TOnPathEditorExecuted;
116 protected
117 procedure DoOnPathEditorExecuted;
118 public
119 procedure Click; override;
120 property CurrentPathEditor: TPathEditorDialog read FCurrentPathEditor;
121 property AssociatedEdit: TCustomEdit read FAssociatedEdit write FAssociatedEdit;
122 property ContextCaption: String read FContextCaption write FContextCaption;
123 property Templates: String read FTemplates write FTemplates;
124 property OnExecuted: TOnPathEditorExecuted read FOnExecuted write FOnExecuted;
125 end;
126
PathEditorDialognull127 function PathEditorDialog: TPathEditorDialog;
128 procedure SetPathTextAndHint(aPath: String; aEdit: TCustomEdit);
129
130
131 implementation
132
133 {$R *.lfm}
134
135 var PathEditor: TPathEditorDialog;
136
PathEditorDialognull137 function PathEditorDialog: TPathEditorDialog;
138 begin
139 if PathEditor=nil then
140 PathEditor:=TPathEditorDialog.Create(Application);
141 Result:=PathEditor;
142 end;
143
TextToPathnull144 function TextToPath(const AText: string): string;
145 var
146 i, j: integer;
147 begin
148 Result:=AText;
149 // convert all line ends to semicolons, remove empty paths and trailing spaces
150 i:=1;
151 j:=1;
152 while i<=length(AText) do begin
153 if AText[i] in [#10,#13] then begin
154 // new line -> new path
155 inc(i);
156 if (i<=length(AText)) and (AText[i] in [#10,#13])
157 and (AText[i]<>AText[i-1]) then
158 inc(i);
159 // skip spaces at end of path
160 while (j>1) and (Result[j-1]=' ') do
161 dec(j);
162 // skip empty paths
163 if (j=1) or (Result[j-1]<>';') then begin
164 Result[j]:=';';
165 inc(j);
166 end;
167 end else if ord(AText[i])<32 then begin
168 // skip trailing spaces
169 inc(i)
170 end else if AText[i]=' ' then begin
171 // space -> skip spaces at beginning of path
172 if (j>1) and (Result[j-1]<>';') then begin
173 Result[j]:=AText[i];
174 inc(j);
175 end;
176 inc(i);
177 end else begin
178 // path char -> just copy
179 Result[j]:=AText[i];
180 inc(j);
181 inc(i);
182 end;
183 end;
184 if (j>1) and (Result[j-1]=';') then dec(j);
185 SetLength(Result,j-1);
186 end;
187
188 procedure SetPathTextAndHint(aPath: String; aEdit: TCustomEdit);
189 var
190 sl: TStrings;
191 begin
192 aEdit.Text := aPath;
193 if Pos(';', aPath) > 0 then
194 begin
195 sl := SplitString(aPath, ';');
196 aEdit.Hint := sl.Text;
197 sl.Free;
198 end
199 else
200 aEdit.Hint := lisDelimiterIsSemicolon;
201 end;
202
203 { TPathEditorDialog }
204
TPathEditorDialog.BaseRelativenull205 function TPathEditorDialog.BaseRelative(const APath: string): String;
206 begin
207 Result:=Trim(APath);
208 if (FEffectiveBaseDirectory<>'') and FilenameIsAbsolute(FEffectiveBaseDirectory) then
209 Result:=CreateRelativePath(Result, FEffectiveBaseDirectory);
210 end;
211
TPathEditorDialog.PathAsAbsolutenull212 function TPathEditorDialog.PathAsAbsolute(const APath: string): String;
213 begin
214 Result:=APath;
215 if not TTransferMacroList.StrHasMacros(Result) // not a template
216 and (FEffectiveBaseDirectory<>'') and FilenameIsAbsolute(FEffectiveBaseDirectory) then
217 Result:=CreateAbsolutePath(Result, FEffectiveBaseDirectory);
218 end;
219
PathMayExistnull220 function TPathEditorDialog.PathMayExist(APath: string): TObject;
221 // Returns 1 if path exists or contains a macro, 0 otherwise.
222 // Result is casted to TObject to be used for Strings.Objects.
223 begin
224 if TTransferMacroList.StrHasMacros(APath) then
225 Exit(TObject(1));
226 Result:=TObject(0);
227 if (FEffectiveBaseDirectory<>'') and FilenameIsAbsolute(FEffectiveBaseDirectory) then
228 APath:=CreateAbsolutePath(APath, FEffectiveBaseDirectory);
229 if DirPathExistsCached(APath) then
230 Result:=TObject(1);
231 end;
232
233 procedure TPathEditorDialog.AddPath(aPath: String; aObject: TObject);
234 var
235 y: integer;
236 begin
237 y:=PathListBox.ItemIndex+1;
238 if y=0 then
239 y:=PathListBox.Count;
240 PathListBox.Items.InsertObject(y, aPath, aObject);
241 PathListBox.ItemIndex:=y;
242 UpdateButtons;
243 end;
244
245 procedure TPathEditorDialog.AddButtonClick(Sender: TObject);
246 begin
247 AddPath(BaseRelative(DirectoryEdit.Text), PathMayExist(DirectoryEdit.Text));
248 end;
249
250 procedure TPathEditorDialog.ReplaceButtonClick(Sender: TObject);
251 begin
252 with PathListBox do begin
253 Items[ItemIndex]:=BaseRelative(DirectoryEdit.Text);
254 Items.Objects[ItemIndex]:=PathMayExist(DirectoryEdit.Text);
255 UpdateButtons;
256 end;
257 end;
258
259 procedure TPathEditorDialog.DeleteButtonClick(Sender: TObject);
260 begin
261 PathListBox.Items.Delete(PathListBox.ItemIndex);
262 UpdateButtons;
263 end;
264
265 procedure TPathEditorDialog.DirectoryEditAcceptDirectory(Sender: TObject; var Value: String);
266 begin
267 DirectoryEdit.Text := BaseRelative(Value);
268 {$IFDEF LCLCarbon}
269 // Not auto-called on Mac. ToDo: fix it in the component instead of here.
270 DirectoryEdit.OnChange(nil);
271 {$ENDIF}
272 end;
273
274 procedure TPathEditorDialog.DeleteInvalidPathsButtonClick(Sender: TObject);
275 var
276 i: Integer;
277 begin
278 with PathListBox do
279 for i:=Items.Count-1 downto 0 do
280 if PtrInt(Items.Objects[i])=0 then
281 Items.Delete(i);
282 end;
283
284 procedure TPathEditorDialog.AddTemplateButtonClick(Sender: TObject);
285 var
286 TemplateForm: TGenericListSelectForm;
287 i: Integer;
288 begin
289 TemplateForm := TGenericListSelectForm.Create(Nil);
290 try
291 TemplateForm.Caption := lisPathEditPathTemplates;
292 // Let a user select only templates which are not in the list already.
293 for i := 0 to FTemplateList.Count-1 do
294 if PathListBox.Items.IndexOf(FTemplateList[i]) = -1 then
295 TemplateForm.ListBox.Items.Add(FTemplateList[i]);
296 if TemplateForm.ShowModal = mrOK then
297 with TemplateForm.ListBox do
298 AddPath(Items[ItemIndex], TObject(1));
299 finally
300 TemplateForm.Free;
301 end;
302 end;
303
304 procedure TPathEditorDialog.WriteHelper(Paths: TStringList);
305 // Helper method for writing paths. Collect paths to a StringList.
306 var
307 i: integer;
308 begin
309 for i := 0 to PathListBox.Count-1 do
310 Paths.Add(PathAsAbsolute(PathListBox.Items[i]));
311 end;
312
313 procedure TPathEditorDialog.CopyMenuItemClick(Sender: TObject);
314 var
315 Paths: TStringList;
316 begin
317 Paths := TStringList.Create;
318 try
319 WriteHelper(Paths);
320 Clipboard.AsText := Paths.Text;
321 finally
322 Paths.Free;
323 end;
324 end;
325
326 procedure TPathEditorDialog.ExportMenuItemClick(Sender: TObject);
327 var
328 Paths: TStringList;
329 begin
330 if not SaveDialog1.Execute then Exit;
331 Paths := TStringList.Create;
332 try
333 WriteHelper(Paths);
334 Paths.SaveToFile(SaveDialog1.FileName);
335 finally
336 Paths.Free;
337 end;
338 end;
339
340 procedure TPathEditorDialog.ReadHelper(Paths: TStringList);
341 // Helper method for reading paths. Insert paths from a StringList to the ListBox.
342 var
343 s: string;
344 y, i: integer;
345 begin
346 y := PathListBox.ItemIndex;
347 if y = -1 then
348 y := PathListBox.Count-1;
349 for i := 0 to Paths.Count-1 do
350 begin
351 s := Trim(Paths[i]);
352 if s <> '' then
353 begin
354 Inc(y);
355 PathListBox.Items.InsertObject(y, BaseRelative(s), PathMayExist(s));
356 end;
357 end;
358 UpdateButtons;
359 end;
360
361 procedure TPathEditorDialog.PasteMenuItemClick(Sender: TObject);
362 var
363 Paths: TStringList;
364 begin
365 Paths := TStringList.Create;
366 try
367 Paths.Text := Clipboard.AsText;
368 ReadHelper(Paths);
369 finally
370 Paths.Free;
371 end;
372 end;
373
374 procedure TPathEditorDialog.ImportMenuItemClick(Sender: TObject);
375 var
376 Paths: TStringList;
377 begin
378 if not OpenDialog1.Execute then Exit;
379 Paths := TStringList.Create;
380 try
381 Paths.LoadFromFile(OpenDialog1.FileName);
382 ReadHelper(Paths);
383 finally
384 Paths.Free;
385 end;
386 end;
387
388 procedure TPathEditorDialog.DirectoryEditChange(Sender: TObject);
389 begin
390 UpdateButtons;
391 end;
392
393 procedure TPathEditorDialog.PathListBoxSelectionChange(Sender: TObject; User: boolean);
394 Var
395 FullPath : String;
396 begin
397 with PathListBox do
398 if ItemIndex>-1 then begin
399 DirectoryEdit.Text:=BaseRelative(Items[ItemIndex]);
400 FullPath := Items[ItemIndex];
401 IDEMacros.SubstituteMacros(FullPath);
402 DirectoryEdit.Directory:=PathAsAbsolute(FullPath);
403 end;
404 UpdateButtons;
405 end;
406
407 procedure TPathEditorDialog.FormCreate(Sender: TObject);
408 const
409 Filt = 'Text file (*.txt)|*.txt|All files (*)|*';
410 begin
411 FTemplateList := TStringListUTF8Fast.Create;
412 Caption:=dlgDebugOptionsPathEditorDlgCaption;
413 PathGroupBox.Caption:=lisPathEditSearchPaths;
414 MoveUpButton.Hint:=lisPathEditMovePathUp;
415 MoveDownButton.Hint:=lisPathEditMovePathDown;
416 ReplaceButton.Caption:=lisReplace;
417 ReplaceButton.Hint:=lisPathEditorReplaceHint;
418 AddButton.Caption:=lisAdd;
419 AddButton.Hint:=lisPathEditorAddHint;
420 DeleteButton.Caption:=lisDelete;
421 DeleteButton.Hint:=lisPathEditorDeleteHint;
422 DeleteInvalidPathsButton.Caption:=lisPathEditDeleteInvalidPaths;
423 DeleteInvalidPathsButton.Hint:=lisPathEditorDeleteInvalidHint;
424 AddTemplateButton.Caption:=lisCodeTemplAdd;
425 AddTemplateButton.Hint:=lisPathEditorTemplAddHint;
426
427 PopupMenu1.Images:=IDEImages.Images_16;
428 CopyMenuItem.Caption:=lisCopyAllItemsToClipboard;
429 CopyMenuItem.ImageIndex:=IDEImages.LoadImage('laz_copy');
430 PasteMenuItem.Caption:=lisMenuPasteFromClipboard;
431 PasteMenuItem.ImageIndex:=IDEImages.LoadImage('laz_paste');
432 ExportMenuItem.Caption:=lisExportAllItemsToFile;
433 ExportMenuItem.ImageIndex:=IDEImages.LoadImage('laz_save');
434 ImportMenuItem.Caption:=lisImportFromFile;
435 ImportMenuItem.ImageIndex:=IDEImages.LoadImage('laz_open');
436
437 OpenDialog1.Filter:=Filt;
438 SaveDialog1.Filter:=Filt;
439
440 IDEImages.AssignImage(MoveUpButton, 'arrow_up');
441 IDEImages.AssignImage(MoveDownButton, 'arrow_down');
442 IDEImages.AssignImage(ReplaceButton, 'menu_reportingbug');
443 IDEImages.AssignImage(AddButton, 'laz_add');
444 IDEImages.AssignImage(DeleteButton, 'laz_delete');
445 IDEImages.AssignImage(DeleteInvalidPathsButton, 'menu_clean');
446 IDEImages.AssignImage(AddTemplateButton, 'laz_add');
447 end;
448
449 procedure TPathEditorDialog.FormDestroy(Sender: TObject);
450 begin
451 FTemplateList.Free;
452 end;
453
454 procedure TPathEditorDialog.FormShow(Sender: TObject);
455 begin
456 PathListBox.ItemIndex:=-1;
457 UpdateButtons;
458 end;
459
460 procedure TPathEditorDialog.MoveDownButtonClick(Sender: TObject);
461 var
462 y: integer;
463 begin
464 y:=PathListBox.ItemIndex;
465 if (y>-1) and (y<PathListBox.Count-1) then begin
466 PathListBox.Items.Move(y,y+1);
467 PathListBox.ItemIndex:=y+1;
468 UpdateButtons;
469 end;
470 end;
471
472 procedure TPathEditorDialog.MoveUpButtonClick(Sender: TObject);
473 var
474 y: integer;
475 begin
476 y:=PathListBox.ItemIndex;
477 if (y>0) and (y<PathListBox.Count) then begin
478 PathListBox.Items.Move(y,y-1);
479 PathListBox.ItemIndex:=y-1;
480 UpdateButtons;
481 end;
482 end;
483
484 procedure TPathEditorDialog.PathListBoxDrawItem(Control: TWinControl;
485 Index: Integer; ARect: TRect; State: TOwnerDrawState);
486 begin
487 if Index < 0 then Exit;
488 with PathListBox do begin
489 Canvas.FillRect(ARect);
490 if PtrInt(Items.Objects[Index]) = 0 then
491 Canvas.Font.Color := clGray;
492 Canvas.TextRect(ARect, ARect.Left, ARect.Top, Items[Index]);
493 end;
494 end;
495
496 procedure TPathEditorDialog.PathListBoxKeyDown(Sender: TObject; var Key: Word;
497 Shift: TShiftState);
498 begin
499 if (ssCtrl in shift) and ((Key = VK_UP) or (Key = VK_DOWN)) then begin
500 if Key = VK_UP then
501 MoveUpButtonClick(Nil)
502 else
503 MoveDownButtonClick(Nil);
504 Key:=VK_UNKNOWN;
505 end;
506 end;
507
GetPathnull508 function TPathEditorDialog.GetPath: string;
509 begin
510 // ToDo: Join PathListBox.Items directly without Text property.
511 Result:=TextToPath(PathListBox.Items.Text);
512 end;
513
514 procedure TPathEditorDialog.SetPath(const AValue: string);
515 var
516 sl: TStrings;
517 i: Integer;
518 begin
519 DirectoryEdit.Text:='';
520 PathListBox.Items.Clear;
521 sl := SplitString(AValue, ';');
522 try
523 for i:=0 to sl.Count-1 do
524 PathListBox.Items.AddObject(sl[i], PathMayExist(sl[i]));
525 PathListBox.ItemIndex:=-1;
526 finally
527 sl.Free;
528 end;
529 end;
530
531 procedure TPathEditorDialog.SetTemplates(const AValue: string);
532 begin
533 SplitString(GetForcedPathDelims(AValue), ';', FTemplateList, True);
534 AddTemplateButton.Enabled := FTemplateList.Count > 0;
535 end;
536
537 procedure TPathEditorDialog.UpdateButtons;
538 var
539 i: integer;
540 InValidPathsExist: Boolean;
541 begin
542 // Replace / add / delete / Delete Invalid Paths
543 AddButton.Enabled:=(DirectoryEdit.Text<>'')
544 and (DirectoryEdit.Text<>FEffectiveBaseDirectory)
545 and (IndexInStringList(PathListBox.Items,cstCaseSensitive,
546 BaseRelative(DirectoryEdit.Text)) = -1);
547 ReplaceButton.Enabled:=AddButton.Enabled and (PathListBox.ItemIndex>-1) ;
548 DeleteButton.Enabled:=PathListBox.SelCount=1; // or ItemIndex>-1; ?
549 // Delete non-existent paths button. Check if there are any.
550 InValidPathsExist:=False;
551 for i:=0 to PathListBox.Items.Count-1 do
552 if PtrInt(PathListBox.Items.Objects[i])=0 then begin
553 InValidPathsExist:=True;
554 Break;
555 end;
556 DeleteInvalidPathsButton.Enabled:=InValidPathsExist;
557 // Move up / down buttons
558 i := PathListBox.ItemIndex;
559 MoveUpButton.Enabled := i > 0;
560 MoveDownButton.Enabled := (i > -1) and (i < PathListBox.Count-1);
561 end;
562
563 procedure TPathEditorDialog.SetBaseDirectory(const AValue: string);
564 begin
565 if FBaseDirectory=AValue then exit;
566 FBaseDirectory:=AValue;
567 FEffectiveBaseDirectory:=FBaseDirectory;
568 IDEMacros.SubstituteMacros(FEffectiveBaseDirectory);
569 DirectoryEdit.Directory:=FEffectiveBaseDirectory;
570 end;
571
572 { TPathEditorButton }
573
574 procedure TPathEditorButton.Click;
575 begin
576 FCurrentPathEditor:=PathEditorDialog;
577 try
578 inherited Click;
579 FCurrentPathEditor.Templates := FTemplates;
580 FCurrentPathEditor.Path := AssociatedEdit.Text;
581 FCurrentPathEditor.ShowModal;
582 DoOnPathEditorExecuted;
583 finally
584 FCurrentPathEditor:=nil;
585 end;
586 end;
587
588 procedure TPathEditorButton.DoOnPathEditorExecuted;
589 var
590 Ok: Boolean;
591 NewPath: String;
592 begin
593 NewPath := FCurrentPathEditor.Path;
594 Ok := (FCurrentPathEditor.ModalResult = mrOk) and (AssociatedEdit.Text <> NewPath);
595 if Ok and Assigned(OnExecuted) then
596 Ok := OnExecuted(ContextCaption, NewPath);
597 // Assign value only if old <> new and OnExecuted allows it.
598 if Ok then
599 SetPathTextAndHint(NewPath, AssociatedEdit);
600 end;
601
602 end.
603
604