mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-29 21:42:49 +02:00
489 lines
14 KiB
ObjectPascal
489 lines
14 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
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, 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.LoadGlyphFromResourceName(HInstance, 'arrow_up');
|
|
MoveDownButton.LoadGlyphFromResourceName(HInstance, 'arrow_down');
|
|
ReplaceButton.LoadGlyphFromResourceName(HInstance, 'menu_reportingbug');
|
|
AddButton.LoadGlyphFromResourceName(HInstance, 'laz_add');
|
|
DeleteButton.LoadGlyphFromResourceName(HInstance, 'laz_delete');
|
|
DeleteInvalidPathsButton.LoadGlyphFromResourceName(HInstance, 'menu_clean');
|
|
AddTemplateButton.LoadGlyphFromResourceName(HInstance, '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 (y<PathListBox.Count-1) then begin
|
|
PathListBox.Items.Move(y,y+1);
|
|
PathListBox.ItemIndex:=y+1;
|
|
UpdateButtons;
|
|
end;
|
|
end;
|
|
|
|
procedure TPathEditorDialog.MoveUpButtonClick(Sender: TObject);
|
|
var
|
|
y: integer;
|
|
begin
|
|
y:=PathListBox.ItemIndex;
|
|
if (y>0) and (y<PathListBox.Count) then begin
|
|
PathListBox.Items.Move(y,y-1);
|
|
PathListBox.ItemIndex:=y-1;
|
|
UpdateButtons;
|
|
end;
|
|
end;
|
|
|
|
procedure TPathEditorDialog.PathListBoxDrawItem(Control: TWinControl;
|
|
Index: Integer; ARect: TRect; State: TOwnerDrawState);
|
|
begin
|
|
if Index < 0 then Exit;
|
|
with PathListBox do begin
|
|
Canvas.FillRect(ARect);
|
|
if PtrInt(Items.Objects[Index]) = 0 then
|
|
Canvas.Font.Color := clGray;
|
|
Canvas.TextRect(ARect, ARect.Left, ARect.Top, Items[Index]);
|
|
end;
|
|
end;
|
|
|
|
procedure TPathEditorDialog.PathListBoxKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if (ssCtrl in shift ) and ((Key = VK_UP) or (Key = VK_DOWN)) then begin
|
|
if Key = VK_UP then
|
|
MoveUpButtonClick(Nil)
|
|
else
|
|
MoveDownButtonClick(Nil);
|
|
Key:=VK_UNKNOWN;
|
|
end;
|
|
end;
|
|
|
|
function TPathEditorDialog.GetPath: string;
|
|
begin
|
|
Result:=TextToPath(PathListBox.Items.Text);
|
|
end;
|
|
|
|
function TPathEditorDialog.GetTemplates: string;
|
|
begin
|
|
Result:=TextToPath(TemplatesListBox.Items.Text);
|
|
end;
|
|
|
|
procedure TPathEditorDialog.SetPath(const AValue: string);
|
|
var
|
|
sl: TStringList;
|
|
i: Integer;
|
|
begin
|
|
DirectoryEdit.Text:='';
|
|
PathListBox.Items.Clear;
|
|
sl:=TstringList.Create();
|
|
try
|
|
sl.Text:=PathToText(AValue);
|
|
for i:=0 to sl.Count-1 do
|
|
PathListBox.Items.AddObject(sl[i], PathMayExist(sl[i]));
|
|
PathListBox.ItemIndex:=-1;
|
|
finally
|
|
sl.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TPathEditorDialog.SetTemplates(const AValue: string);
|
|
begin
|
|
TemplatesListBox.Items.Text:=PathToText(AValue);
|
|
TemplateGroupBox.Visible:=TemplatesListBox.Count>0;
|
|
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.
|
|
|