/ide/patheditordlg.pas

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