mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 09:39:31 +02:00
implemented add file to a package dialog
git-svn-id: trunk@4095 -
This commit is contained in:
mattias
parent
0818bea677
commit
ac2eaea0ba
@ -2425,7 +2425,6 @@ begin
|
||||
chkDebugDBX.Checked := CompilerOpts.GenerateDebugDBX;
|
||||
chkUseLineInfoUnit.Checked := CompilerOpts.UseLineInfoUnit;
|
||||
chkUseHeaptrc.Checked := CompilerOpts.UseHeaptrc;
|
||||
chkUseHeaptrc.Enabled:=EnabledLinkerOpts;
|
||||
chkGenGProfCode.Checked := CompilerOpts.GenGProfCode;
|
||||
chkSymbolsStrip.Checked := CompilerOpts.StripSymbols;
|
||||
chkSymbolsStrip.Enabled:=EnabledLinkerOpts;
|
||||
|
||||
@ -383,6 +383,7 @@ type
|
||||
procedure SaveEnvironment; virtual; abstract;
|
||||
procedure SetRecentSubMenu(ParentMenuItem: TMenuItem; FileList: TStringList;
|
||||
OnClickEvent: TNotifyEvent); virtual;
|
||||
procedure DoJumpToCodeToolBossError; virtual; abstract;
|
||||
procedure SaveSourceEditorChangesToCodeCache(PageIndex: integer); virtual; abstract;
|
||||
end;
|
||||
|
||||
|
||||
@ -38,29 +38,66 @@ unit AddFileToAPackageDlg;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Buttons, StdCtrls, LazarusIDEStrConsts,
|
||||
IDEProcs, IDEOptionDefs, PackageDefs, PackageSystem;
|
||||
Classes, SysUtils, Forms, Controls, Buttons, ExtCtrls, StdCtrls,
|
||||
LazarusIDEStrConsts, Dialogs, AVL_Tree, FileCtrl, IDEProcs, IDEOptionDefs,
|
||||
ComponentReg, PackageDefs, PackageSystem;
|
||||
|
||||
type
|
||||
TAddFileToAPackageDlg = class(TForm)
|
||||
FileGroupBox: TGroupBox;
|
||||
FileNameEdit: TEdit;
|
||||
UnitNameLabel: TLabel;
|
||||
UnitNameEdit: TEdit;
|
||||
HasRegisterProcCheckBox: TCheckBox;
|
||||
FileTypeRadioGroup: TRadioGroup;
|
||||
PackagesGroupBox: TGroupBox;
|
||||
PackagesComboBox: TComboBox;
|
||||
ShowAllCheckBox: TCheckBox;
|
||||
OkButton: TButton;
|
||||
CancelButton: TButton;
|
||||
procedure AddFileToAPackageDlgClose(Sender: TObject;
|
||||
var Action: TCloseAction);
|
||||
procedure AddFileToAPackageDlgResize(Sender: TObject);
|
||||
procedure FileGroupBoxResize(Sender: TObject);
|
||||
procedure OkButtonClick(Sender: TObject);
|
||||
procedure PackagesGroupBoxResize(Sender: TObject);
|
||||
procedure ShowAllCheckBoxClick(Sender: TObject);
|
||||
private
|
||||
fPackages: TAVLTree;// tree of TLazPackage
|
||||
function GetFileType: TPkgFileType;
|
||||
function GetFilename: string;
|
||||
function GetHasRegisterProc: boolean;
|
||||
function GetUnitName: string;
|
||||
procedure SetFileType(const AValue: TPkgFileType);
|
||||
procedure SetFilename(const AValue: string);
|
||||
procedure SetHasRegisterProc(const AValue: boolean);
|
||||
procedure SetUnitName(const AValue: string);
|
||||
procedure SetupComponents;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure UpdateAvailablePackages;
|
||||
property Filename: string read GetFilename write SetFilename;
|
||||
property UnitName: string read GetUnitName write SetUnitName;
|
||||
property FileType: TPkgFileType read GetFileType write SetFileType;
|
||||
property HasRegisterProc: boolean read GetHasRegisterProc write SetHasRegisterProc;
|
||||
end;
|
||||
|
||||
function ShowAddFileToAPackageDlg(const Filename: string): TModalResult;
|
||||
function ShowAddFileToAPackageDlg(const Filename, UnitName: string;
|
||||
HasRegisterProc: boolean): TModalResult;
|
||||
|
||||
implementation
|
||||
|
||||
function ShowAddFileToAPackageDlg(const Filename: string): TModalResult;
|
||||
function ShowAddFileToAPackageDlg(const Filename, UnitName: string;
|
||||
HasRegisterProc: boolean): TModalResult;
|
||||
var
|
||||
Dialog: TAddFileToAPackageDlg;
|
||||
begin
|
||||
Dialog:=TAddFileToAPackageDlg.Create(Application);
|
||||
Dialog.Filename:=Filename;
|
||||
Dialog.UnitName:=UnitName;
|
||||
Dialog.HasRegisterProc:=HasRegisterProc;
|
||||
Dialog.UpdateAvailablePackages;
|
||||
Result:=Dialog.ShowModal;
|
||||
Dialog.Free;
|
||||
end;
|
||||
@ -73,26 +110,353 @@ begin
|
||||
IDEDialogLayoutList.SaveLayout(Self);
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.SetupComponents;
|
||||
procedure TAddFileToAPackageDlg.AddFileToAPackageDlgResize(Sender: TObject);
|
||||
begin
|
||||
with FileGroupBox do
|
||||
SetBounds(10,10,Parent.ClientWidth-20,120);
|
||||
|
||||
with PackagesGroupBox do
|
||||
SetBounds(10,FileGroupBox.Top+FileGroupBox.Height+5,Parent.ClientWidth-20,75);
|
||||
|
||||
with OkButton do
|
||||
SetBounds(Parent.ClientWidth-200,Parent.ClientHeight-30,80,Height);
|
||||
|
||||
with CancelButton do
|
||||
SetBounds(Parent.ClientWidth-100,Parent.ClientHeight-30,80,Height);
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.FileGroupBoxResize(Sender: TObject);
|
||||
begin
|
||||
with UnitNameLabel do
|
||||
SetBounds(5,33,90,Height);
|
||||
with UnitNameEdit do
|
||||
SetBounds(UnitNameLabel.Left+UnitNameLabel.Width+3,30,250,Height);
|
||||
with HasRegisterProcCheckBox do
|
||||
SetBounds(5,60,200,Height);
|
||||
|
||||
with FileTypeRadioGroup do
|
||||
SetBounds(0,30,Parent.ClientWidth,Parent.ClientHeight-30);
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.OkButtonClick(Sender: TObject);
|
||||
var
|
||||
PkgID: TLazPackageID;
|
||||
APackage: TLazPackage;
|
||||
PkgFile: TPkgFile;
|
||||
begin
|
||||
PkgID:=TLazPackageID.Create;
|
||||
try
|
||||
// check package ID
|
||||
if not PkgID.StringToID(PackagesComboBox.Text) then begin
|
||||
MessageDlg('Invalid Package',
|
||||
'Invalid package ID: "'+PackagesComboBox.Text+'"',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
// search package
|
||||
APackage:=PackageGraph.FindPackageWithID(PkgID);
|
||||
if APackage=nil then begin
|
||||
MessageDlg('Package not found',
|
||||
'Package "'+PkgID.IDAsString+'" not found.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check if package is readonly
|
||||
if APackage.ReadOnly then begin
|
||||
MessageDlg('Package is read only',
|
||||
'The package '+APackage.IDAsString+' is read only.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check if file is already in the package
|
||||
PkgFile:=APackage.FindPkgFile(Filename,false,true);
|
||||
if PkgFile<>nil then begin
|
||||
MessageDlg('File is already in package',
|
||||
'The file "'+Filename+'"'#13
|
||||
+'is already in the package '+APackage.IDAsString+'.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// ok -> add file to package
|
||||
APackage.BeginUpdate;
|
||||
APackage.AddFile(Filename,UnitName,FileType,[],cpNormal);
|
||||
if APackage.Editor<>nil then APackage.Editor.UpdateAll;
|
||||
APackage.EndUpdate;
|
||||
|
||||
ModalResult:=mrOk;
|
||||
finally
|
||||
PkgID.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.PackagesGroupBoxResize(Sender: TObject);
|
||||
begin
|
||||
with ShowAllCheckBox do
|
||||
SetBounds(10,30,200,Height);
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.ShowAllCheckBoxClick(Sender: TObject);
|
||||
begin
|
||||
UpdateAvailablePackages;
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.SetupComponents;
|
||||
var
|
||||
pft: TPkgFileType;
|
||||
begin
|
||||
FileGroupBox:=TGroupBox.Create(Self);
|
||||
with FileGroupBox do begin
|
||||
Name:='FileGroupBox';
|
||||
Parent:=Self;
|
||||
Caption:='File';
|
||||
OnResize:=@FileGroupBoxResize;
|
||||
end;
|
||||
|
||||
FileNameEdit:=TEdit.Create(Self);
|
||||
with FileNameEdit do begin
|
||||
Name:='FileNameEdit';
|
||||
Parent:=FileGroupBox;
|
||||
Text:='';
|
||||
Align:=alTop;
|
||||
ReadOnly:=true;
|
||||
end;
|
||||
|
||||
UnitNameLabel:=TLabel.Create(Self);
|
||||
with UnitNameLabel do begin
|
||||
Name:='UnitNameLabel';
|
||||
Parent:=FileGroupBox;
|
||||
Caption:='Unit Name: ';
|
||||
end;
|
||||
|
||||
UnitNameEdit:=TEdit.Create(Self);
|
||||
with UnitNameEdit do begin
|
||||
Name:='UnitNameEdit';
|
||||
Parent:=FileGroupBox;
|
||||
Text:='';
|
||||
end;
|
||||
|
||||
HasRegisterProcCheckBox:=TCheckBox.Create(Self);
|
||||
with HasRegisterProcCheckBox do begin
|
||||
Name:='HasRegisterProcCheckBox';
|
||||
Parent:=FileGroupBox;
|
||||
Caption:='Has Register procedure';
|
||||
end;
|
||||
|
||||
FileTypeRadioGroup:=TRadioGroup.Create(Self);
|
||||
with FileTypeRadioGroup do begin
|
||||
Name:='FileTypeRadioGroup';
|
||||
Parent:=FileGroupBox;
|
||||
Caption:='File Type';
|
||||
with Items do begin
|
||||
BeginUpdate;
|
||||
for pft:=Low(TPkgFileType) to High(TPkgFileType) do begin
|
||||
if pft=pftUnit then continue;
|
||||
Add(GetPkgFileTypeLocalizedName(pft));
|
||||
end;
|
||||
EndUpdate;
|
||||
end;
|
||||
ItemIndex:=0;
|
||||
Columns:=2;
|
||||
end;
|
||||
|
||||
PackagesGroupBox:=TGroupBox.Create(Self);
|
||||
with PackagesGroupBox do begin
|
||||
Name:='PackagesGroupBox';
|
||||
Parent:=Self;
|
||||
Caption:='Destination Package';
|
||||
OnResize:=@PackagesGroupBoxResize;
|
||||
end;
|
||||
|
||||
PackagesComboBox:=TComboBox.Create(Self);
|
||||
with PackagesComboBox do begin
|
||||
Name:='PackagesComboBox';
|
||||
Parent:=PackagesGroupBox;
|
||||
Align:=alTop;
|
||||
end;
|
||||
|
||||
ShowAllCheckBox:=TCheckBox.Create(Self);
|
||||
with ShowAllCheckBox do begin
|
||||
Name:='ShowAllCheckBox';
|
||||
Parent:=PackagesGroupBox;
|
||||
Caption:='Show All';
|
||||
Checked:=false;
|
||||
OnClick:=@ShowAllCheckBoxClick;
|
||||
end;
|
||||
|
||||
OkButton:=TButton.Create(Self);
|
||||
with OkButton do begin
|
||||
Name:='OkButton';
|
||||
Parent:=Self;
|
||||
Caption:='Ok';
|
||||
OnClick:=@OkButtonClick;
|
||||
end;
|
||||
|
||||
CancelButton:=TButton.Create(Self);
|
||||
with CancelButton do begin
|
||||
Name:='CancelButton';
|
||||
Parent:=Self;
|
||||
Caption:='Cancel';
|
||||
ModalResult:=mrCancel;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.SetFilename(const AValue: string);
|
||||
var
|
||||
NewPFT: TPkgFileType;
|
||||
begin
|
||||
if FileNameEdit.Text=AValue then exit;
|
||||
FileNameEdit.Text:=AValue;
|
||||
if FilenameIsPascalUnit(AValue) then
|
||||
NewPFT:=pftUnit
|
||||
else if CompareFileExt(AValue,'.lfm',true)=0 then
|
||||
NewPFT:=pftLFM
|
||||
else if CompareFileExt(AValue,'.lrs',true)=0 then
|
||||
NewPFT:=pftLRS
|
||||
else if CompareFileExt(AValue,'.inc',true)=0 then
|
||||
NewPFT:=pftInclude
|
||||
else if FileIsText(AValue) then
|
||||
NewPFT:=pftText
|
||||
else
|
||||
NewPFT:=pftBinary;
|
||||
FileType:=NewPFT;
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.SetHasRegisterProc(const AValue: boolean);
|
||||
begin
|
||||
if HasRegisterProc=AValue then exit;
|
||||
HasRegisterProcCheckBox.Checked:=AValue;
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.SetUnitName(const AValue: string);
|
||||
begin
|
||||
if UnitName=AValue then exit;
|
||||
UnitNameEdit.Text:=AValue;
|
||||
end;
|
||||
|
||||
function TAddFileToAPackageDlg.GetFilename: string;
|
||||
begin
|
||||
Result:=FileNameEdit.Text;
|
||||
end;
|
||||
|
||||
function TAddFileToAPackageDlg.GetFileType: TPkgFileType;
|
||||
var
|
||||
i: Integer;
|
||||
CurPFT: TPkgFileType;
|
||||
begin
|
||||
if FileTypeRadioGroup.Visible then begin
|
||||
i:=0;
|
||||
for CurPFT:=Low(TPkgFileType) to High(TPkgFileType) do begin
|
||||
if CurPFT=pftUnit then continue;
|
||||
if FileTypeRadioGroup.ItemIndex=i then begin
|
||||
Result:=CurPFT;
|
||||
exit;
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
Result:=pftText;
|
||||
end else begin
|
||||
Result:=pftUnit;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAddFileToAPackageDlg.GetHasRegisterProc: boolean;
|
||||
begin
|
||||
Result:=HasRegisterProcCheckBox.Checked;
|
||||
end;
|
||||
|
||||
function TAddFileToAPackageDlg.GetUnitName: string;
|
||||
begin
|
||||
Result:=UnitNameEdit.Text;
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.SetFileType(const AValue: TPkgFileType);
|
||||
var
|
||||
ShowUnitProps: Boolean;
|
||||
i: Integer;
|
||||
CurPFT: TPkgFileType;
|
||||
begin
|
||||
if FileType=AValue then exit;
|
||||
i:=0;
|
||||
for CurPFT:=Low(TPkgFileType) to High(TPkgFileType) do begin
|
||||
if CurPFT=pftUnit then continue;
|
||||
if CurPFT=AValue then break;
|
||||
inc(i);
|
||||
end;
|
||||
if i<FileTypeRadioGroup.Items.Count then
|
||||
FileTypeRadioGroup.ItemIndex:=i
|
||||
else
|
||||
FileTypeRadioGroup.ItemIndex:=-1;
|
||||
|
||||
ShowUnitProps:=(AValue=pftUnit);
|
||||
UnitNameLabel.Visible:=ShowUnitProps;
|
||||
UnitNameEdit.Visible:=ShowUnitProps;
|
||||
HasRegisterProcCheckBox.Visible:=ShowUnitProps;
|
||||
FileTypeRadioGroup.Visible:=not ShowUnitProps;
|
||||
end;
|
||||
|
||||
constructor TAddFileToAPackageDlg.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
Name:='AddFileToAPackageDlg';
|
||||
//fPackages:=TAVLTree.Create(@CompareLazPackageID);
|
||||
Caption:='Add file to a package';
|
||||
fPackages:=TAVLTree.Create(@CompareLazPackageID);
|
||||
Position:=poScreenCenter;
|
||||
IDEDialogLayoutList.ApplyLayout(Self,500,300);
|
||||
IDEDialogLayoutList.ApplyLayout(Self,320,170);
|
||||
SetupComponents;
|
||||
OnClose:=@AddFileToAPackageDlgClose;
|
||||
OnResize:=@AddFileToAPackageDlgResize;
|
||||
OnResize(Self);
|
||||
end;
|
||||
|
||||
destructor TAddFileToAPackageDlg.Destroy;
|
||||
begin
|
||||
fPackages.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TAddFileToAPackageDlg.UpdateAvailablePackages;
|
||||
var
|
||||
i: Integer;
|
||||
APackage: TLazPackage;
|
||||
AFilename: String;
|
||||
ADirectory: String;
|
||||
sl: TStringList;
|
||||
ANode: TAVLTreeNode;
|
||||
begin
|
||||
fPackages.Clear;
|
||||
AFilename:=Filename;
|
||||
ADirectory:=ExtractFilePath(Filename);
|
||||
for i:=0 to PackageGraph.Count-1 do begin
|
||||
APackage:=PackageGraph[i];
|
||||
// skip readonly packages
|
||||
if APackage.ReadOnly then continue;
|
||||
// skip packages, that already contains the file
|
||||
if APackage.FindPkgFile(AFilename,false,true)<>nil then continue;
|
||||
if not ShowAllCheckBox.Checked then begin
|
||||
// skip packages, where the filename is not in the package directory
|
||||
// or one of its source directories
|
||||
if (not FileIsInPath(AFilename,APackage.Directory))
|
||||
and (APackage.SourceDirectories.GetFileReference(ADirectory)=nil) then
|
||||
continue;
|
||||
end;
|
||||
fPackages.Add(APackage);
|
||||
end;
|
||||
sl:=TStringList.Create;
|
||||
ANode:=fPackages.FindLowest;
|
||||
while ANode<>nil do begin
|
||||
sl.Add(TLazPackage(ANode.Data).IDAsString);
|
||||
ANode:=fPackages.FindSuccessor(ANode);
|
||||
end;
|
||||
PackagesComboBox.Items.Assign(sl);
|
||||
if PackagesComboBox.Items.Count>0 then
|
||||
PackagesComboBox.Text:=PackagesComboBox.Items[0]
|
||||
else
|
||||
PackagesComboBox.Text:='';
|
||||
sl.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -229,46 +229,52 @@ begin
|
||||
end;
|
||||
|
||||
// check file extension
|
||||
if not FilenameIsPascalUnit(AFilename) then begin
|
||||
MessageDlg('File not unit',
|
||||
'Pascal units must have the extension .pp or .pas',
|
||||
mtWarning,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check unitname
|
||||
AnUnitName:=ExtractFileNameOnly(AFilename);
|
||||
if not IsValidIdent(AnUnitName) then begin
|
||||
MessageDlg('File not unit',
|
||||
+'"'+AnUnitName+'" is not a valid unit name.',
|
||||
mtWarning,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check if unitname already exists in package
|
||||
PkgFile:=PackageGraph.FindUnit(LazPackage,AnUnitName,true,true);
|
||||
if PkgFile<>nil then begin
|
||||
if PkgFile.LazPackage=LazPackage then begin
|
||||
MessageDlg('Unitname already exists',
|
||||
'The unitname "'+AnUnitName+'" already exists in this package.',
|
||||
mtError,[mbCancel],0);
|
||||
if AddFileType in [d2ptUnit,d2ptNewComponent] then begin
|
||||
if not FilenameIsPascalUnit(AFilename) then begin
|
||||
MessageDlg('File not unit',
|
||||
'Pascal units must have the extension .pp or .pas',
|
||||
mtWarning,[mbCancel],0);
|
||||
exit;
|
||||
end else begin
|
||||
if MessageDlg('Unitname already exists',
|
||||
'The unitname "'+AnUnitName+'" already exists in the package:'#13
|
||||
+PkgFile.LazPackage.IDAsString,
|
||||
mtWarning,[mbCancel,mbIgnore],0)<>mrIgnore then exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// check if unitname is a componentclass
|
||||
if IDEComponentPalette.FindComponent(AnUnitName)<>nil then begin
|
||||
if MessageDlg('Ambigious Unit Name',
|
||||
'The unit name "'+AnUnitName+'" is the same as an registered component.'#13
|
||||
+'Using this can cause strange error messages.',
|
||||
mtWarning,[mbCancel,mbIgnore],0)<>mrIgnore
|
||||
then
|
||||
// check unitname
|
||||
if AddFileType in [d2ptUnit,d2ptNewComponent] then begin
|
||||
AnUnitName:=ExtractFileNameOnly(AFilename);
|
||||
if not IsValidIdent(AnUnitName) then begin
|
||||
MessageDlg('File not unit',
|
||||
+'"'+AnUnitName+'" is not a valid unit name.',
|
||||
mtWarning,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check if unitname already exists in package
|
||||
PkgFile:=PackageGraph.FindUnit(LazPackage,AnUnitName,true,true);
|
||||
if PkgFile<>nil then begin
|
||||
if PkgFile.LazPackage=LazPackage then begin
|
||||
MessageDlg('Unitname already exists',
|
||||
'The unitname "'+AnUnitName+'" already exists in this package.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end else begin
|
||||
if MessageDlg('Unitname already exists',
|
||||
'The unitname "'+AnUnitName+'" already exists in the package:'#13
|
||||
+PkgFile.LazPackage.IDAsString,
|
||||
mtWarning,[mbCancel,mbIgnore],0)<>mrIgnore then exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// check if unitname is a componentclass
|
||||
if IDEComponentPalette.FindComponent(AnUnitName)<>nil then begin
|
||||
if MessageDlg('Ambigious Unit Name',
|
||||
'The unit name "'+AnUnitName+'" is the same as an registered component.'#13
|
||||
+'Using this can cause strange error messages.',
|
||||
mtWarning,[mbCancel,mbIgnore],0)<>mrIgnore
|
||||
then
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
AnUnitName:='';
|
||||
end;
|
||||
|
||||
// check if file already exists in package
|
||||
@ -281,10 +287,10 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check if file is part of project or marked readonly
|
||||
// check if file is part of project
|
||||
if Assigned(OnGetIDEFileInfo) then begin
|
||||
IDEFileFlags:=[];
|
||||
OnGetIDEFileInfo(nil,AFilename,[ifsPartOfProject,ifsReadOnly],
|
||||
OnGetIDEFileInfo(nil,AFilename,[ifsPartOfProject{,ifsReadOnly}],
|
||||
IDEFileFlags);
|
||||
if (ifsPartOfProject in IDEFileFlags) then begin
|
||||
MessageDlg('File is used',
|
||||
@ -293,12 +299,12 @@ begin
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
if (ifsReadOnly in IDEFileFlags) then begin
|
||||
{if (ifsReadOnly in IDEFileFlags) then begin
|
||||
MessageDlg('File is readonly',
|
||||
'The file "'+AFilename+'" is marked as readonly.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
end;}
|
||||
end;
|
||||
|
||||
// ok
|
||||
|
||||
@ -590,8 +590,7 @@ type
|
||||
property RemovedFiles[Index: integer]: TPkgFile read GetRemovedFiles;
|
||||
property SourceDirectories: TFileReferenceList read FSourceDirectories;
|
||||
property StateFileDate: longint read FStateFileDate write FStateFileDate;
|
||||
property UsageOptions: TPkgAdditionalCompilerOptions
|
||||
read FUsageOptions;
|
||||
property UsageOptions: TPkgAdditionalCompilerOptions read FUsageOptions;
|
||||
end;
|
||||
|
||||
PLazPackage = ^TLazPackage;
|
||||
|
||||
@ -106,6 +106,7 @@ type
|
||||
procedure AddBitBtnClick(Sender: TObject);
|
||||
procedure ApplyDependencyButtonClick(Sender: TObject);
|
||||
procedure CallRegisterProcCheckBoxClick(Sender: TObject);
|
||||
procedure ChangeFileTypeMenuItemClick(Sender: TObject);
|
||||
procedure CompileAllClick(Sender: TObject);
|
||||
procedure CompileBitBtnClick(Sender: TObject);
|
||||
procedure CompilerOptionsBitBtnClick(Sender: TObject);
|
||||
@ -121,12 +122,11 @@ type
|
||||
procedure OpenFileMenuItemClick(Sender: TObject);
|
||||
procedure OptionsBitBtnClick(Sender: TObject);
|
||||
procedure PackageEditorFormClose(Sender: TObject; var Action: TCloseAction);
|
||||
procedure PackageEditorFormCloseQuery(Sender: TObject; var CanClose: boolean
|
||||
);
|
||||
procedure PackageEditorFormCloseQuery(Sender: TObject; var CanClose: boolean);
|
||||
procedure PackageEditorFormResize(Sender: TObject);
|
||||
procedure ReAddMenuItemClick(Sender: TObject);
|
||||
procedure RegisteredListBoxDrawItem(Control: TWinControl; Index: Integer;
|
||||
ARect: TRect; State: TOwnerDrawState);
|
||||
ARect: TRect; State: TOwnerDrawState);
|
||||
procedure RemoveBitBtnClick(Sender: TObject);
|
||||
procedure SaveBitBtnClick(Sender: TObject);
|
||||
procedure SaveAsClick(Sender: TObject);
|
||||
@ -316,8 +316,13 @@ begin
|
||||
if Removed then begin
|
||||
// re-add file
|
||||
AFilename:=PkgFile.Filename;
|
||||
if not CheckAddingUnitFilename(LazPackage,d2ptUnit,
|
||||
PackageEditors.OnGetIDEFileInfo,AFilename) then exit;
|
||||
if PkgFile.FIleType=pftUnit then begin
|
||||
if not CheckAddingUnitFilename(LazPackage,d2ptUnit,
|
||||
PackageEditors.OnGetIDEFileInfo,AFilename) then exit;
|
||||
end else begin
|
||||
if not CheckAddingUnitFilename(LazPackage,d2ptFile,
|
||||
PackageEditors.OnGetIDEFileInfo,AFilename) then exit;
|
||||
end;
|
||||
PkgFile.Filename:=AFilename;
|
||||
LazPackage.UnremovePkgFile(PkgFile);
|
||||
UpdateAll;
|
||||
@ -335,60 +340,83 @@ end;
|
||||
|
||||
procedure TPackageEditorForm.FilesPopupMenuPopup(Sender: TObject);
|
||||
var
|
||||
CurNode: TTreeNode;
|
||||
ItemCnt: Integer;
|
||||
CurDependency: TPkgDependency;
|
||||
Removed: boolean;
|
||||
|
||||
procedure AddPopupMenuItem(const ACaption: string; AnEvent: TNotifyEvent;
|
||||
EnabledFlag: boolean);
|
||||
var
|
||||
CurMenuItem: TMenuItem;
|
||||
CurFile: TPkgFile;
|
||||
|
||||
function AddPopupMenuItem(const ACaption: string; AnEvent: TNotifyEvent;
|
||||
EnabledFlag: boolean): TMenuItem;
|
||||
begin
|
||||
if FilesPopupMenu.Items.Count<=ItemCnt then begin
|
||||
CurMenuItem:=TMenuItem.Create(Self);
|
||||
FilesPopupMenu.Items.Add(CurMenuItem);
|
||||
end else
|
||||
CurMenuItem:=FilesPopupMenu.Items[ItemCnt];
|
||||
CurMenuItem.Caption:=ACaption;
|
||||
CurMenuItem.OnClick:=AnEvent;
|
||||
CurMenuItem.Enabled:=EnabledFlag;
|
||||
Result:=TMenuItem.Create(Self);
|
||||
FilesPopupMenu.Items.Add(Result);
|
||||
end else begin
|
||||
Result:=FilesPopupMenu.Items[ItemCnt];
|
||||
while Result.Count>0 do Result.Delete(Result.Count-1);
|
||||
end;
|
||||
Result.Caption:=ACaption;
|
||||
Result.OnClick:=AnEvent;
|
||||
Result.Enabled:=EnabledFlag;
|
||||
inc(ItemCnt);
|
||||
end;
|
||||
|
||||
procedure AddFileTypeMenuItem;
|
||||
var
|
||||
FileTypeMenuItem: TMenuItem;
|
||||
CurPFT: TPkgFileType;
|
||||
NewMenuItem: TMenuItem;
|
||||
begin
|
||||
FileTypeMenuItem:=AddPopupMenuItem('File Type',nil,true);
|
||||
for CurPFT:=Low(TPkgFileType) to High(TPkgFileType) do begin
|
||||
NewMenuItem:=TMenuItem.Create(Self);
|
||||
NewMenuItem.Caption:=GetPkgFileTypeLocalizedName(CurPFT);
|
||||
NewMenuItem.OnClick:=@ChangeFileTypeMenuItemClick;
|
||||
NewMenuItem.Enabled:=(CurPFT<>pftUnit)
|
||||
or FilenameIsPascalUnit(CurFile.Filename);
|
||||
FileTypeMenuItem.Add(NewMenuItem);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
CurNode:=FilesTreeView.Selected;
|
||||
ItemCnt:=0;
|
||||
CurDependency:=GetCurrentDependency(Removed);
|
||||
if CurNode<>nil then begin
|
||||
if CurNode.Parent<>nil then begin
|
||||
if CurNode.Parent=FilesNode then begin
|
||||
AddPopupMenuItem('Open file',@OpenFileMenuItemClick,true);
|
||||
AddPopupMenuItem('Remove file',@RemoveBitBtnClick,
|
||||
RemoveBitBtn.Enabled);
|
||||
end else if (CurDependency<>nil) and (not Removed) then begin
|
||||
AddPopupMenuItem('Open package',@OpenFileMenuItemClick,true);
|
||||
AddPopupMenuItem('Remove dependency',@RemoveBitBtnClick,
|
||||
RemoveBitBtn.Enabled);
|
||||
AddPopupMenuItem('Move dependency up',@MoveDependencyUpClick,
|
||||
(CurDependency.PrevRequiresDependency<>nil)
|
||||
and (not LazPackage.ReadOnly));
|
||||
AddPopupMenuItem('Move dependency down',@MoveDependencyDownClick,
|
||||
(CurDependency.NextRequiresDependency<>nil)
|
||||
and (not LazPackage.ReadOnly));
|
||||
end else if (CurNode.Parent=RemovedFilesNode) then begin
|
||||
AddPopupMenuItem('Open file',@OpenFileMenuItemClick,true);
|
||||
AddPopupMenuItem('Add file',@ReAddMenuItemClick,
|
||||
AddBitBtn.Enabled);
|
||||
end else if (CurNode.Parent=RemovedRequiredNode) then begin
|
||||
AddPopupMenuItem('Open package',@OpenFileMenuItemClick,true);
|
||||
AddPopupMenuItem('Re-Add dependency',@ReAddMenuItemClick,
|
||||
AddBitBtn.Enabled);
|
||||
end;
|
||||
end;
|
||||
end else begin
|
||||
if CurDependency=nil then
|
||||
CurFile:=GetCurrentFile(Removed)
|
||||
else
|
||||
CurFile:=nil;
|
||||
|
||||
if CurFile<>nil then begin
|
||||
if not Removed then begin
|
||||
AddPopupMenuItem('Open file',@OpenFileMenuItemClick,true);
|
||||
AddPopupMenuItem('Remove file',@RemoveBitBtnClick,
|
||||
RemoveBitBtn.Enabled);
|
||||
AddFileTypeMenuItem;
|
||||
end else begin
|
||||
AddPopupMenuItem('Open file',@OpenFileMenuItemClick,true);
|
||||
AddPopupMenuItem('Re-Add file',@ReAddMenuItemClick,
|
||||
AddBitBtn.Enabled);
|
||||
end;
|
||||
end;
|
||||
|
||||
if CurDependency<>nil then begin
|
||||
if (not Removed) then begin
|
||||
AddPopupMenuItem('Open package',@OpenFileMenuItemClick,true);
|
||||
AddPopupMenuItem('Remove dependency',@RemoveBitBtnClick,
|
||||
RemoveBitBtn.Enabled);
|
||||
AddPopupMenuItem('Move dependency up',@MoveDependencyUpClick,
|
||||
(CurDependency.PrevRequiresDependency<>nil)
|
||||
and (not LazPackage.ReadOnly));
|
||||
AddPopupMenuItem('Move dependency down',@MoveDependencyDownClick,
|
||||
(CurDependency.NextRequiresDependency<>nil)
|
||||
and (not LazPackage.ReadOnly));
|
||||
end else begin
|
||||
AddPopupMenuItem('Open package',@OpenFileMenuItemClick,true);
|
||||
AddPopupMenuItem('Re-Add dependency',@ReAddMenuItemClick,
|
||||
AddBitBtn.Enabled);
|
||||
end;
|
||||
end;
|
||||
|
||||
if ItemCnt>0 then
|
||||
AddPopupMenuItem('-',nil,true);
|
||||
|
||||
@ -803,6 +831,30 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.ChangeFileTypeMenuItemClick(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
CurItem: TMenuItem;
|
||||
CurPFT: TPkgFileType;
|
||||
Removed: boolean;
|
||||
CurFile: TPkgFile;
|
||||
begin
|
||||
CurItem:=TMenuItem(Sender);
|
||||
i:=CurItem.Parent.IndexOf(CurItem);
|
||||
if i<0 then exit;
|
||||
CurFile:=GetCurrentFile(Removed);
|
||||
if CurFile=nil then exit;
|
||||
for CurPFT:=Low(TPkgFileType) to High(TPkgFileType) do begin
|
||||
if CurItem.Caption=GetPkgFileTypeLocalizedName(CurPFT) then begin
|
||||
if (not FilenameIsPascalUnit(CurFIle.Filename))
|
||||
and (CurPFT=pftUnit) then exit;
|
||||
CurFile.FileType:=CurPFT;
|
||||
UpdateAll;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.CompileAllClick(Sender: TObject);
|
||||
begin
|
||||
DoCompile(true);
|
||||
@ -1155,7 +1207,6 @@ begin
|
||||
CurFile:=LazPackage.Files[i];
|
||||
CurNode.Text:=CurFile.GetShortFilename;
|
||||
SetImageIndex(CurNode,CurFile);
|
||||
writeln('AAA1 ',CurNode.Text,' ',CurNode.ImageIndex,' ',ImageIndexBinary,' ',CurFile.FileType=pftBinary);
|
||||
CurNode:=CurNode.GetNextSibling;
|
||||
end;
|
||||
while CurNode<>nil do begin
|
||||
@ -1170,7 +1221,7 @@ writeln('AAA1 ',CurNode.Text,' ',CurNode.ImageIndex,' ',ImageIndexBinary,' ',Cur
|
||||
if RemovedFilesNode=nil then begin
|
||||
RemovedFilesNode:=
|
||||
FilesTreeView.Items.Add(RequiredPackagesNode,
|
||||
'Removed Files (are not saved)');
|
||||
'Removed Files (these entries are not saved to the lpk file)');
|
||||
RemovedFilesNode.ImageIndex:=ImageIndexRemovedFiles;
|
||||
RemovedFilesNode.SelectedIndex:=RemovedFilesNode.ImageIndex;
|
||||
end;
|
||||
@ -1233,7 +1284,8 @@ begin
|
||||
if CurDependency<>nil then begin
|
||||
if RemovedRequiredNode=nil then begin
|
||||
RemovedRequiredNode:=
|
||||
FilesTreeView.Items.Add(nil,'Removed required packages (are not saved)');
|
||||
FilesTreeView.Items.Add(nil,
|
||||
'Removed required packages (these entries are not saved to the lpk file)');
|
||||
RemovedRequiredNode.ImageIndex:=ImageIndexRemovedRequired;
|
||||
RemovedRequiredNode.SelectedIndex:=RemovedRequiredNode.ImageIndex;
|
||||
end;
|
||||
@ -1293,7 +1345,8 @@ begin
|
||||
FilePropsGroupBox.Enabled:=true;
|
||||
FilePropsGroupBox.Caption:='File Properties';
|
||||
// set Register Unit checkbox
|
||||
CallRegisterProcCheckBox.Enabled:=not LazPackage.ReadOnly;
|
||||
CallRegisterProcCheckBox.Enabled:=(not LazPackage.ReadOnly)
|
||||
and (CurFile.FileType=pftUnit);
|
||||
CallRegisterProcCheckBox.Checked:=pffHasRegisterProc in CurFile.Flags;
|
||||
// fetch all registered plugins
|
||||
CurListIndex:=0;
|
||||
|
||||
@ -104,6 +104,9 @@ type
|
||||
function MacroFunctionPkgSrcPath(Data: Pointer): boolean;
|
||||
function MacroFunctionPkgUnitPath(Data: Pointer): boolean;
|
||||
function MacroFunctionPkgIncPath(Data: Pointer): boolean;
|
||||
function DoGetUnitRegisterInfo(const AFilename: string;
|
||||
var TheUnitName: string; var HasRegisterProc: boolean;
|
||||
IgnoreErrors: boolean): TModalResult;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -272,22 +275,8 @@ end;
|
||||
procedure TPkgManager.OnPackageEditorGetUnitRegisterInfo(Sender: TObject;
|
||||
const AFilename: string; var TheUnitName: string; var HasRegisterProc: boolean
|
||||
);
|
||||
var
|
||||
ExpFilename: String;
|
||||
CodeBuffer: TCodeBuffer;
|
||||
begin
|
||||
ExpFilename:=CleanAndExpandFilename(AFilename);
|
||||
// create default values
|
||||
TheUnitName:='';
|
||||
HasRegisterProc:=false;
|
||||
MainIDE.SaveSourceEditorChangesToCodeCache(-1);
|
||||
CodeBuffer:=CodeToolBoss.LoadFile(ExpFilename,true,false);
|
||||
if CodeBuffer<>nil then begin
|
||||
TheUnitName:=CodeToolBoss.GetSourceName(CodeBuffer,false);
|
||||
CodeToolBoss.HasInterfaceRegisterProc(CodeBuffer,HasRegisterProc);
|
||||
end;
|
||||
if TheUnitName='' then
|
||||
TheUnitName:=ExtractFileNameOnly(ExpFilename);
|
||||
DoGetUnitRegisterInfo(AFilename,TheUnitName,HasRegisterProc,true);
|
||||
end;
|
||||
|
||||
function TPkgManager.OnPackageEditorOpenPackage(Sender: TObject;
|
||||
@ -937,6 +926,39 @@ begin
|
||||
PkgID.Free;
|
||||
end;
|
||||
|
||||
function TPkgManager.DoGetUnitRegisterInfo(const AFilename: string;
|
||||
var TheUnitName: string; var HasRegisterProc: boolean; IgnoreErrors: boolean
|
||||
): TModalResult;
|
||||
|
||||
function ErrorsHandled: boolean;
|
||||
begin
|
||||
if (CodeToolBoss.ErrorMessage='') or IgnoreErrors then exit;
|
||||
MainIDE.DoJumpToCodeToolBossError;
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
var
|
||||
ExpFilename: String;
|
||||
CodeBuffer: TCodeBuffer;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
ExpFilename:=CleanAndExpandFilename(AFilename);
|
||||
// create default values
|
||||
TheUnitName:='';
|
||||
HasRegisterProc:=false;
|
||||
MainIDE.SaveSourceEditorChangesToCodeCache(-1);
|
||||
CodeBuffer:=CodeToolBoss.LoadFile(ExpFilename,true,false);
|
||||
if CodeBuffer<>nil then begin
|
||||
TheUnitName:=CodeToolBoss.GetSourceName(CodeBuffer,false);
|
||||
if not ErrorsHandled then exit;
|
||||
CodeToolBoss.HasInterfaceRegisterProc(CodeBuffer,HasRegisterProc);
|
||||
if not ErrorsHandled then exit;
|
||||
end;
|
||||
if TheUnitName='' then
|
||||
TheUnitName:=ExtractFileNameOnly(ExpFilename);
|
||||
Result:=mrOk;
|
||||
end;
|
||||
|
||||
constructor TPkgManager.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
@ -1467,7 +1489,7 @@ var
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
|
||||
writeln('TPkgManager.DoCompilePackage A ',APackage.IDAsString,' Flags=',PkgCompileFlagsToString(Flags));
|
||||
writeln('TPkgManager.DoCompilePackage A ',APackage.IDAsString,' Flags=',PkgCompileFlagsToString(Flags));
|
||||
|
||||
if APackage.AutoCreated then exit;
|
||||
|
||||
@ -1733,6 +1755,8 @@ var
|
||||
ActiveUnitInfo: TUnitInfo;
|
||||
PkgFile: TPkgFile;
|
||||
Filename: String;
|
||||
TheUnitName: String;
|
||||
HasRegisterProc: Boolean;
|
||||
begin
|
||||
MainIDE.GetCurrentUnit(ActiveSourceEditor,ActiveUnitInfo);
|
||||
if ActiveSourceEditor=nil then exit;
|
||||
@ -1761,12 +1785,19 @@ begin
|
||||
if PkgFile<>nil then begin
|
||||
Result:=MessageDlg('File is already in package',
|
||||
'The file "'+Filename+'"'#13
|
||||
+'is already in the package '+PkgFile.LazPackage.IDAsString+'.'#13,
|
||||
+'is already in the package '+PkgFile.LazPackage.IDAsString+'.',
|
||||
mtWarning,[mbIgnore,mbCancel,mbAbort],0);
|
||||
if Result<>mrIgnore then exit;
|
||||
end;
|
||||
|
||||
Result:=ShowAddFileToAPackageDlg(Filename);
|
||||
TheUnitName:='';
|
||||
HasRegisterProc:=false;
|
||||
if FilenameIsPascalUnit(Filename) then begin
|
||||
Result:=DoGetUnitRegisterInfo(Filename,TheUnitName,HasRegisterProc,false);
|
||||
if Result<>mrOk then exit;
|
||||
end;
|
||||
|
||||
Result:=ShowAddFileToAPackageDlg(Filename,TheUnitName,HasRegisterProc);
|
||||
end;
|
||||
|
||||
function TPkgManager.OnProjectInspectorOpen(Sender: TObject): boolean;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user