{ /*************************************************************************** patheditordlg.pp ---------------- ***************************************************************************/ ***************************************************************************** See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** Abstract: Defines the TPathEditorDialog, which is a form to edit search paths } unit PathEditorDlg; {$mode objfpc}{$H+} interface uses Classes, SysUtils, types, // LCL LCLType, LCLProc, Forms, Controls, Buttons, StdCtrls, Dialogs, Menus, Graphics, ButtonPanel, Clipbrd, // LazUtils FileUtil, LazFileUtils, LazStringUtils, LazFileCache, LazUTF8, // LazControls ShortPathEdit, // IdeIntf MacroIntf, IDEImagesIntf, IDEUtils, // IDE TransferMacros, GenericListSelect, LazarusIDEStrConsts; type { TPathEditorDialog } TPathEditorDialog = class(TForm) AddTemplateButton: TBitBtn; ButtonPanel1: TButtonPanel; CopyMenuItem: TMenuItem; MoveDownButton: TSpeedButton; MoveUpButton: TSpeedButton; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; ExportMenuItem: TMenuItem; ImportMenuItem: TMenuItem; SeparMenuItem: TMenuItem; PasteMenuItem: TMenuItem; PopupMenu1: TPopupMenu; ReplaceButton: TBitBtn; AddButton: TBitBtn; DeleteInvalidPathsButton: TBitBtn; DirectoryEdit: TShortPathEdit; DeleteButton: TBitBtn; PathListBox: TListBox; PathGroupBox: TGroupBox; BrowseDialog: TSelectDirectoryDialog; procedure AddButtonClick(Sender: TObject); procedure AddTemplateButtonClick(Sender: TObject); procedure CopyMenuItemClick(Sender: TObject); procedure ExportMenuItemClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure PasteMenuItemClick(Sender: TObject); procedure DeleteInvalidPathsButtonClick(Sender: TObject); procedure DeleteButtonClick(Sender: TObject); procedure DirectoryEditAcceptDirectory(Sender: TObject; var Value: String); procedure DirectoryEditChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure MoveDownButtonClick(Sender: TObject); procedure MoveUpButtonClick(Sender: TObject); procedure PathListBoxDrawItem({%H-}Control: TWinControl; Index: Integer; ARect: TRect; {%H-}State: TOwnerDrawState); procedure PathListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure PathListBoxSelectionChange(Sender: TObject; {%H-}User: boolean); procedure ReplaceButtonClick(Sender: TObject); procedure ImportMenuItemClick(Sender: TObject); private FBaseDirectory: string; FEffectiveBaseDirectory: string; FTemplateList: TStringListUTF8Fast; procedure AddPath(aPath: String; aObject: TObject); function GetPath: string; function BaseRelative(const APath: string): String; function PathAsAbsolute(const APath: string): String; function PathMayExist(APath: string): TObject; procedure ReadHelper(Paths: TStringList); procedure SetBaseDirectory(const AValue: string); procedure SetPath(const AValue: string); procedure SetTemplates(const AValue: string); procedure UpdateButtons; procedure WriteHelper(Paths: TStringList); public property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; property EffectiveBaseDirectory: string read FEffectiveBaseDirectory; property Path: string read GetPath write SetPath; property Templates: string {read GetTemplates} write SetTemplates; end; TOnPathEditorExecuted = function (Context: String; var NewPath: String): Boolean of object; { TPathEditorButton } TPathEditorButton = class(TButton) private FCurrentPathEditor: TPathEditorDialog; FAssociatedEdit: TCustomEdit; FContextCaption: String; FTemplates: String; FOnExecuted: TOnPathEditorExecuted; protected procedure DoOnPathEditorExecuted; public procedure Click; override; property CurrentPathEditor: TPathEditorDialog read FCurrentPathEditor; property AssociatedEdit: TCustomEdit read FAssociatedEdit write FAssociatedEdit; property ContextCaption: String read FContextCaption write FContextCaption; property Templates: String read FTemplates write FTemplates; property OnExecuted: TOnPathEditorExecuted read FOnExecuted write FOnExecuted; end; function PathEditorDialog: TPathEditorDialog; procedure SetPathTextAndHint(aPath: String; aEdit: TCustomEdit); implementation {$R *.lfm} var PathEditor: TPathEditorDialog; function PathEditorDialog: TPathEditorDialog; begin if PathEditor=nil then PathEditor:=TPathEditorDialog.Create(Application); Result:=PathEditor; end; function TextToPath(const AText: string): string; var i, j: integer; begin Result:=AText; // convert all line ends to semicolons, remove empty paths and trailing spaces i:=1; j:=1; while i<=length(AText) do begin if AText[i] in [#10,#13] then begin // new line -> new path inc(i); if (i<=length(AText)) and (AText[i] in [#10,#13]) and (AText[i]<>AText[i-1]) then inc(i); // skip spaces at end of path while (j>1) and (Result[j-1]=' ') do dec(j); // skip empty paths if (j=1) or (Result[j-1]<>';') then begin Result[j]:=';'; inc(j); end; end else if ord(AText[i])<32 then begin // skip trailing spaces inc(i) end else if AText[i]=' ' then begin // space -> skip spaces at beginning of path if (j>1) and (Result[j-1]<>';') then begin Result[j]:=AText[i]; inc(j); end; inc(i); end else begin // path char -> just copy Result[j]:=AText[i]; inc(j); inc(i); end; end; if (j>1) and (Result[j-1]=';') then dec(j); SetLength(Result,j-1); end; procedure SetPathTextAndHint(aPath: String; aEdit: TCustomEdit); var sl: TStrings; begin aEdit.Text := aPath; if Pos(';', aPath) > 0 then begin sl := SplitString(aPath, ';'); aEdit.Hint := sl.Text; sl.Free; end else aEdit.Hint := lisDelimiterIsSemicolon; end; { TPathEditorDialog } function TPathEditorDialog.BaseRelative(const APath: string): String; begin Result:=Trim(APath); if (FEffectiveBaseDirectory<>'') and FilenameIsAbsolute(FEffectiveBaseDirectory) then Result:=CreateRelativePath(Result, FEffectiveBaseDirectory); end; function TPathEditorDialog.PathAsAbsolute(const APath: string): String; begin Result:=APath; if not TTransferMacroList.StrHasMacros(Result) // not a template and (FEffectiveBaseDirectory<>'') and FilenameIsAbsolute(FEffectiveBaseDirectory) then Result:=CreateAbsolutePath(Result, FEffectiveBaseDirectory); end; function TPathEditorDialog.PathMayExist(APath: string): TObject; // Returns 1 if path exists or contains a macro, 0 otherwise. // Result is casted to TObject to be used for Strings.Objects. begin if TTransferMacroList.StrHasMacros(APath) then Exit(TObject(1)); Result:=TObject(0); if (FEffectiveBaseDirectory<>'') and FilenameIsAbsolute(FEffectiveBaseDirectory) then APath:=CreateAbsolutePath(APath, FEffectiveBaseDirectory); if DirPathExistsCached(APath) then Result:=TObject(1); end; procedure TPathEditorDialog.AddPath(aPath: String; aObject: TObject); var y: integer; begin y:=PathListBox.ItemIndex+1; if y=0 then y:=PathListBox.Count; PathListBox.Items.InsertObject(y, aPath, aObject); PathListBox.ItemIndex:=y; UpdateButtons; end; procedure TPathEditorDialog.AddButtonClick(Sender: TObject); begin AddPath(BaseRelative(DirectoryEdit.Text), PathMayExist(DirectoryEdit.Text)); end; procedure TPathEditorDialog.ReplaceButtonClick(Sender: TObject); begin with PathListBox do begin Items[ItemIndex]:=BaseRelative(DirectoryEdit.Text); Items.Objects[ItemIndex]:=PathMayExist(DirectoryEdit.Text); UpdateButtons; end; end; procedure TPathEditorDialog.DeleteButtonClick(Sender: TObject); begin PathListBox.Items.Delete(PathListBox.ItemIndex); UpdateButtons; end; procedure TPathEditorDialog.DirectoryEditAcceptDirectory(Sender: TObject; var Value: String); begin DirectoryEdit.Text := BaseRelative(Value); {$IFDEF LCLCarbon} // Not auto-called on Mac. ToDo: fix it in the component instead of here. DirectoryEdit.OnChange(nil); {$ENDIF} end; procedure TPathEditorDialog.DeleteInvalidPathsButtonClick(Sender: TObject); var i: Integer; begin with PathListBox do for i:=Items.Count-1 downto 0 do if PtrInt(Items.Objects[i])=0 then Items.Delete(i); end; procedure TPathEditorDialog.AddTemplateButtonClick(Sender: TObject); var TemplateForm: TGenericListSelectForm; i: Integer; begin TemplateForm := TGenericListSelectForm.Create(Nil); try TemplateForm.Caption := lisPathEditPathTemplates; // Let a user select only templates which are not in the list already. for i := 0 to FTemplateList.Count-1 do if PathListBox.Items.IndexOf(FTemplateList[i]) = -1 then TemplateForm.ListBox.Items.Add(FTemplateList[i]); if TemplateForm.ShowModal = mrOK then with TemplateForm.ListBox do AddPath(Items[ItemIndex], TObject(1)); finally TemplateForm.Free; end; end; procedure TPathEditorDialog.WriteHelper(Paths: TStringList); // Helper method for writing paths. Collect paths to a StringList. var i: integer; begin for i := 0 to PathListBox.Count-1 do Paths.Add(PathAsAbsolute(PathListBox.Items[i])); end; procedure TPathEditorDialog.CopyMenuItemClick(Sender: TObject); var Paths: TStringList; begin Paths := TStringList.Create; try WriteHelper(Paths); Clipboard.AsText := Paths.Text; finally Paths.Free; end; end; procedure TPathEditorDialog.ExportMenuItemClick(Sender: TObject); var Paths: TStringList; begin if not SaveDialog1.Execute then Exit; Paths := TStringList.Create; try WriteHelper(Paths); Paths.SaveToFile(SaveDialog1.FileName); finally Paths.Free; end; end; procedure TPathEditorDialog.ReadHelper(Paths: TStringList); // Helper method for reading paths. Insert paths from a StringList to the ListBox. var s: string; y, i: integer; begin y := PathListBox.ItemIndex; if y = -1 then y := PathListBox.Count-1; for i := 0 to Paths.Count-1 do begin s := Trim(Paths[i]); if s <> '' then begin Inc(y); PathListBox.Items.InsertObject(y, BaseRelative(s), PathMayExist(s)); end; end; UpdateButtons; end; procedure TPathEditorDialog.PasteMenuItemClick(Sender: TObject); var Paths: TStringList; begin Paths := TStringList.Create; try Paths.Text := Clipboard.AsText; ReadHelper(Paths); finally Paths.Free; end; end; procedure TPathEditorDialog.ImportMenuItemClick(Sender: TObject); var Paths: TStringList; begin if not OpenDialog1.Execute then Exit; Paths := TStringList.Create; try Paths.LoadFromFile(OpenDialog1.FileName); ReadHelper(Paths); finally Paths.Free; end; end; procedure TPathEditorDialog.DirectoryEditChange(Sender: TObject); begin UpdateButtons; end; procedure TPathEditorDialog.PathListBoxSelectionChange(Sender: TObject; User: boolean); Var FullPath : String; begin with PathListBox do if ItemIndex>-1 then begin DirectoryEdit.Text:=BaseRelative(Items[ItemIndex]); FullPath := Items[ItemIndex]; IDEMacros.SubstituteMacros(FullPath); DirectoryEdit.Directory:=PathAsAbsolute(FullPath); end; UpdateButtons; end; procedure TPathEditorDialog.FormCreate(Sender: TObject); const Filt = 'Text file (*.txt)|*.txt|All files (*)|*'; begin FTemplateList := TStringListUTF8Fast.Create; Caption:=dlgDebugOptionsPathEditorDlgCaption; PathGroupBox.Caption:=lisPathEditSearchPaths; MoveUpButton.Hint:=lisPathEditMovePathUp; MoveDownButton.Hint:=lisPathEditMovePathDown; ReplaceButton.Caption:=lisReplace; ReplaceButton.Hint:=lisPathEditorReplaceHint; AddButton.Caption:=lisAdd; AddButton.Hint:=lisPathEditorAddHint; DeleteButton.Caption:=lisDelete; DeleteButton.Hint:=lisPathEditorDeleteHint; DeleteInvalidPathsButton.Caption:=lisPathEditDeleteInvalidPaths; DeleteInvalidPathsButton.Hint:=lisPathEditorDeleteInvalidHint; AddTemplateButton.Caption:=lisCodeTemplAdd; AddTemplateButton.Hint:=lisPathEditorTemplAddHint; PopupMenu1.Images:=IDEImages.Images_16; CopyMenuItem.Caption:=lisCopyAllItemsToClipboard; CopyMenuItem.ImageIndex:=IDEImages.LoadImage('laz_copy'); PasteMenuItem.Caption:=lisMenuPasteFromClipboard; PasteMenuItem.ImageIndex:=IDEImages.LoadImage('laz_paste'); ExportMenuItem.Caption:=lisExportAllItemsToFile; ExportMenuItem.ImageIndex:=IDEImages.LoadImage('laz_save'); ImportMenuItem.Caption:=lisImportFromFile; ImportMenuItem.ImageIndex:=IDEImages.LoadImage('laz_open'); OpenDialog1.Filter:=Filt; SaveDialog1.Filter:=Filt; IDEImages.AssignImage(MoveUpButton, 'arrow_up'); IDEImages.AssignImage(MoveDownButton, 'arrow_down'); IDEImages.AssignImage(ReplaceButton, 'menu_reportingbug'); IDEImages.AssignImage(AddButton, 'laz_add'); IDEImages.AssignImage(DeleteButton, 'laz_delete'); IDEImages.AssignImage(DeleteInvalidPathsButton, 'menu_clean'); IDEImages.AssignImage(AddTemplateButton, 'laz_add'); end; procedure TPathEditorDialog.FormDestroy(Sender: TObject); begin FTemplateList.Free; end; procedure TPathEditorDialog.FormShow(Sender: TObject); begin PathListBox.ItemIndex:=-1; UpdateButtons; end; procedure TPathEditorDialog.MoveDownButtonClick(Sender: TObject); var y: integer; begin y:=PathListBox.ItemIndex; if (y>-1) and (y0) and (y 0; end; procedure TPathEditorDialog.UpdateButtons; var i: integer; InValidPathsExist: Boolean; begin // Replace / add / delete / Delete Invalid Paths AddButton.Enabled:=(DirectoryEdit.Text<>'') and (DirectoryEdit.Text<>FEffectiveBaseDirectory) and (IndexInStringList(PathListBox.Items,cstCaseSensitive, BaseRelative(DirectoryEdit.Text)) = -1); ReplaceButton.Enabled:=AddButton.Enabled and (PathListBox.ItemIndex>-1) ; DeleteButton.Enabled:=PathListBox.SelCount=1; // or ItemIndex>-1; ? // Delete non-existent paths button. Check if there are any. InValidPathsExist:=False; for i:=0 to PathListBox.Items.Count-1 do if PtrInt(PathListBox.Items.Objects[i])=0 then begin InValidPathsExist:=True; Break; end; DeleteInvalidPathsButton.Enabled:=InValidPathsExist; // Move up / down buttons i := PathListBox.ItemIndex; MoveUpButton.Enabled := i > 0; MoveDownButton.Enabled := (i > -1) and (i < PathListBox.Count-1); end; procedure TPathEditorDialog.SetBaseDirectory(const AValue: string); begin if FBaseDirectory=AValue then exit; FBaseDirectory:=AValue; FEffectiveBaseDirectory:=FBaseDirectory; IDEMacros.SubstituteMacros(FEffectiveBaseDirectory); DirectoryEdit.Directory:=FEffectiveBaseDirectory; end; { TPathEditorButton } procedure TPathEditorButton.Click; begin FCurrentPathEditor:=PathEditorDialog; try inherited Click; FCurrentPathEditor.Templates := FTemplates; FCurrentPathEditor.Path := AssociatedEdit.Text; FCurrentPathEditor.ShowModal; DoOnPathEditorExecuted; finally FCurrentPathEditor:=nil; end; end; procedure TPathEditorButton.DoOnPathEditorExecuted; var Ok: Boolean; NewPath: String; begin NewPath := FCurrentPathEditor.Path; Ok := (FCurrentPathEditor.ModalResult = mrOk) and (AssociatedEdit.Text <> NewPath); if Ok and Assigned(OnExecuted) then Ok := OnExecuted(ContextCaption, NewPath); // Assign value only if old <> new and OnExecuted allows it. if Ok then SetPathTextAndHint(NewPath, AssociatedEdit); end; end.