{ /*************************************************************************** patheditordlg.pp ---------------- ***************************************************************************/ ***************************************************************************** * * * See the file COPYING.modifiedLGPL.txt, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** Abstract: Defines the TPathEditorDialog, which is a form to edit search paths } unit PathEditorDlg; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Buttons, StdCtrls, Dialogs, FileUtil, ButtonPanel, ExtCtrls, EditBtn, MacroIntf, LCLType, Graphics, types, TransferMacros, LazarusIDEStrConsts, shortpathedit; type { TPathEditorDialog } TPathEditorDialog = class(TForm) AddTemplateButton: TBitBtn; ButtonPanel1: TButtonPanel; ReplaceButton: TBitBtn; AddButton: TBitBtn; DeleteInvalidPathsButton: TBitBtn; DirectoryEdit: TShortPathEdit; Splitter1: TSplitter; DeleteButton: TBitBtn; PathListBox: TListBox; MoveDownButton: TBitBtn; MoveUpButton: TBitBtn; TemplatesListBox: TListBox; TemplateGroupBox: TGroupBox; PathGroupBox: TGroupBox; BrowseDialog: TSelectDirectoryDialog; procedure AddButtonClick(Sender: TObject); procedure AddTemplateButtonClick(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 FormResize(Sender: TObject); procedure FormShow(Sender: TObject); procedure MoveDownButtonClick(Sender: TObject); procedure MoveUpButtonClick(Sender: TObject); procedure PathListBoxDrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState); procedure PathListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure PathListBoxSelectionChange(Sender: TObject; User: boolean); procedure ReplaceButtonClick(Sender: TObject); procedure TemplatesListBoxDblClick(Sender: TObject); procedure TemplatesListBoxSelectionChange(Sender: TObject; User: boolean); private FBaseDirectory: string; FEffectiveBaseDirectory: string; function GetPath: string; function GetTemplates: string; function PathToText(const APath: string): string; function BaseRelative(const APath: string): String; function PathAsAbsolute(const APath: string): String; function PathMayExist(APath: string): TObject; procedure SetBaseDirectory(const AValue: string); procedure SetPath(const AValue: string); procedure SetTemplates(const AValue: string); function TextToPath(const AText: string): string; procedure UpdateButtons; 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 = TNotifyEvent; TPathEditorButton = class(TButton) private FCurrentPathEditor: TPathEditorDialog; FOnExecuted: TOnPathEditorExecuted; protected procedure DoOnPathEditorExecuted; public procedure Click; override; property CurrentPathEditor: TPathEditorDialog read FCurrentPathEditor; property OnExecuted: TOnPathEditorExecuted read FOnExecuted write FOnExecuted; end; function PathEditorDialog: TPathEditorDialog; implementation {$R *.lfm} var PathEditor: TPathEditorDialog; function PathEditorDialog: TPathEditorDialog; begin if PathEditor=nil then PathEditor:=TPathEditorDialog.Create(Application); Result:=PathEditor; 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 DirectoryExists(APath) then Result:=TObject(1); end; procedure TPathEditorDialog.AddButtonClick(Sender: TObject); var y: integer; RelPath: String; begin with PathListBox do begin y:=ItemIndex+1; if y=0 then y:=Count; RelPath:=BaseRelative(DirectoryEdit.Text); Items.InsertObject(y, RelPath, PathMayExist(DirectoryEdit.Text)); ItemIndex:=y; UpdateButtons; end; end; procedure TPathEditorDialog.ReplaceButtonClick(Sender: TObject); var RelPath: String; begin with PathListBox do begin RelPath:=BaseRelative(DirectoryEdit.Text); Items[ItemIndex]:=RelPath; 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); 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 i, y: integer; begin y:=-1; for i:=0 to TemplatesListBox.Items.Count-1 do begin if TemplatesListBox.Selected[i] and (PathListBox.Items.IndexOf(TemplatesListBox.Items[i])=-1) then begin PathListBox.Items.AddObject(TemplatesListBox.Items[i], TObject(1)); y:=PathListBox.Count-1; end; end; if y>=1 then begin PathListBox.ItemIndex:=y; UpdateButtons; 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.TemplatesListBoxSelectionChange(Sender: TObject; User: boolean); begin UpdateButtons; end; procedure TPathEditorDialog.TemplatesListBoxDblClick(Sender: TObject); begin AddTemplateButtonClick(Nil); end; procedure TPathEditorDialog.FormCreate(Sender: TObject); begin 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; TemplateGroupBox.Caption:=lisPathEditPathTemplates; AddTemplateButton.Caption:=lisCodeTemplAdd; AddTemplateButton.Hint:=lisPathEditorTemplAddHint; MoveUpButton.LoadGlyphFromLazarusResource('arrow_up'); MoveDownButton.LoadGlyphFromLazarusResource('arrow_down'); ReplaceButton.LoadGlyphFromLazarusResource('menu_reportingbug'); AddButton.LoadGlyphFromLazarusResource('laz_add'); DeleteButton.LoadGlyphFromLazarusResource('laz_delete'); DeleteInvalidPathsButton.LoadGlyphFromLazarusResource('menu_clean'); AddTemplateButton.LoadGlyphFromLazarusResource('laz_add'); end; procedure TPathEditorDialog.FormResize(Sender: TObject); var PathGroupBoxHeight: integer; begin PathGroupBoxHeight:=((ClientHeight-70)*2) div 3; if PathGroupBoxHeight<10 then PathGroupBoxHeight:=10; PathGroupBox.Height:=PathGroupBoxHeight; end; procedure TPathEditorDialog.FormShow(Sender: TObject); begin PathListBox.ItemIndex:=-1; TemplatesListBox.ItemIndex:=-1; UpdateButtons; end; procedure TPathEditorDialog.MoveDownButtonClick(Sender: TObject); var y: integer; begin y:=PathListBox.ItemIndex; if (y>-1) and (y0) and (y0; end; function TPathEditorDialog.TextToPath(const AText: string): string; var i, j: integer; PathAsText: string; begin PathAsText:=AText; Result:=PathAsText; // convert all line ends to semicolons, remove empty paths and trailing spaces i:=1; j:=1; while i<=length(PathAsText) do begin if PathAsText[i] in [#10,#13] then begin // new line -> new path inc(i); if (i<=length(PathAsText)) and (PathAsText[i] in [#10,#13]) and (PathAsText[i]<>PathAsText[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(PathAsText[i])<32 then begin // skip trailing spaces inc(i) end else if PathAsText[i]=' ' then begin // space -> skip spaces at beginning of path if (j>1) and (Result[j-1]<>';') then begin Result[j]:=PathAsText[i]; inc(j); end; inc(i); end else begin // path char -> just copy Result[j]:=PathAsText[i]; inc(j); inc(i); end; end; if (j>1) and (Result[j-1]=';') then dec(j); SetLength(Result,j-1); end; function TPathEditorDialog.PathToText(const APath: string): string; var i: integer; NewPath: string; begin NewPath:=APath; for i:=1 to length(NewPath) do if NewPath[i]=';' then NewPath[i]:=#13; Result:=NewPath; end; procedure TPathEditorDialog.UpdateButtons; var i: integer; InValidPathsExist: Boolean; begin // Replace / add / delete / Delete Invalid Paths ReplaceButton.Enabled:=(DirectoryEdit.Text<>'') and (DirectoryEdit.Text<>FEffectiveBaseDirectory) and (PathListBox.Items.IndexOf(BaseRelative(DirectoryEdit.Text))=-1); AddButton.Enabled:=ReplaceButton.Enabled; DeleteButton.Enabled:=PathListBox.SelCount=1; // or ItemIndex>-1; ? AddTemplateButton.Enabled:=(TemplatesListBox.SelCount>1) or ((TemplatesListBox.ItemIndex>-1) and (PathListBox.Items.IndexOf(TemplatesListBox.Items[TemplatesListBox.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.ShowModal; DoOnPathEditorExecuted; finally FCurrentPathEditor:=nil; end; end; procedure TPathEditorButton.DoOnPathEditorExecuted; begin if Assigned(OnExecuted) then OnExecuted(Self); end; end.