paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 10:37:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

Packager: Allow overwriting existing unit files in New Component dialog. Error was shown AFTER a file was overwritten. Issue #26928.

Browse Source 
git-svn-id: trunk@59240 -
This commit is contained in:
juha 2018-10-03 11:24:35 +00:00
parent baeca2e0d7
commit 8026ce28ae
5 changed files with 118 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
packager/addtopackagedlg.lfm
View File

@ -15,8 +15,8 @@ object AddToPackageDlg: TAddToPackageDlg
LCLVersion = '2.1.0.0'
object ButtonPanel1: TButtonPanel
Left = 6
Height = 34
Top = 373
Height = 26
Top = 381
Width = 684
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
@ -50,7 +50,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideRight.Control = AncestorComboBox
AnchorSideRight.Side = asrBottom
Left = 184
Height = 31
Height = 25
Top = 43
Width = 200
Anchors = [akTop, akLeft, akRight]
@ -67,7 +67,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideRight.Side = asrBottom
Left = 184
Height = 31
Top = 80
Top = 74
Width = 200
BorderSpacing.Top = 6
ItemHeight = 0
@ -78,11 +78,11 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideLeft.Control = AncestorComboBox
AnchorSideTop.Control = UnitNameEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ComponentUnitFileBrowseButton
AnchorSideRight.Control = UnitDirectoryBrowseButton
Left = 184
Height = 31
Top = 154
Width = 443
Height = 25
Top = 142
Width = 449
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
OnChange = UnitDirectoryEditChange
@ -96,8 +96,8 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideRight.Control = AncestorComboBox
AnchorSideRight.Side = asrBottom
Left = 184
Height = 31
Top = 117
Height = 25
Top = 111
Width = 200
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
@ -111,7 +111,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrBottom
Left = 184
Height = 32
Top = 213
Top = 195
Width = 32
BorderSpacing.Top = 6
Constraints.MinHeight = 32
@ -128,7 +128,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrCenter
Left = 222
Height = 19
Top = 220
Top = 202
Width = 124
BorderSpacing.Around = 6
Caption = 'IconNormInfoLabel'
@ -150,38 +150,38 @@ object AddToPackageDlg: TAddToPackageDlg
State = cbChecked
TabOrder = 1
end
object ComponentUnitFileBrowseButton: TButton
object UnitDirectoryBrowseButton: TButton
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = UnitDirectoryEdit
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = ComponentUnitFileShortenButton
Left = 627
AnchorSideRight.Control = UnitDirectoryShortenButton
Left = 633
Height = 25
Hint = 'Save file dialog'
Top = 157
Top = 142
Width = 25
Anchors = [akTop, akRight]
Caption = '...'
OnClick = ComponentUnitFileBrowseButtonClick
OnClick = UnitDirectoryBrowseButtonClick
ParentShowHint = False
ShowHint = True
TabOrder = 5
end
object ComponentUnitFileShortenButton: TButton
object UnitDirectoryShortenButton: TButton
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = UnitDirectoryEdit
AnchorSideTop.Side = asrCenter
AnchorSideRight.Side = asrBottom
Left = 652
Height = 33
Left = 658
Height = 25
Hint = 'Shorten or expand filename'
Top = 153
Width = 28
Top = 142
Width = 22
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 6
Caption = '<>'
OnClick = ComponentUnitFileShortenButtonClick
OnClick = UnitDirectoryShortenButtonClick
ParentShowHint = False
ShowHint = True
TabOrder = 6
@ -191,7 +191,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrCenter
Left = 5
Height = 19
Top = 220
Top = 202
Width = 98
Caption = 'IconNormLabel'
ParentColor = False
@ -201,7 +201,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrCenter
Left = 5
Height = 19
Top = 123
Top = 114
Width = 99
Caption = 'UnitNameLabel'
ParentColor = False
@ -211,7 +211,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrCenter
Left = 5
Height = 19
Top = 160
Top = 145
Width = 119
Caption = 'UnitDirectoryLabel'
ParentColor = False
@ -221,7 +221,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrCenter
Left = 5
Height = 19
Top = 86
Top = 80
Width = 111
Caption = 'PalettePageLabel'
ParentColor = False
@ -231,7 +231,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrCenter
Left = 5
Height = 19
Top = 49
Top = 46
Width = 104
Caption = 'ClassNameLabel'
ParentColor = False
@ -252,7 +252,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrBottom
Left = 184
Height = 32
Top = 251
Top = 233
Width = 32
BorderSpacing.Top = 6
Constraints.MinHeight = 32
@ -267,7 +267,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrBottom
Left = 184
Height = 32
Top = 289
Top = 271
Width = 32
BorderSpacing.Top = 6
Constraints.MinHeight = 32
@ -282,7 +282,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrCenter
Left = 5
Height = 19
Top = 258
Top = 240
Width = 85
Caption = 'Icon150Label'
ParentColor = False
@ -293,7 +293,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrCenter
Left = 5
Height = 19
Top = 296
Top = 278
Width = 85
Caption = 'Icon200Label'
ParentColor = False
@ -305,7 +305,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrCenter
Left = 222
Height = 19
Top = 258
Top = 240
Width = 111
BorderSpacing.Around = 6
Caption = 'Icon150InfoLabel'
@ -318,7 +318,7 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrCenter
Left = 222
Height = 19
Top = 296
Top = 278
Width = 111
BorderSpacing.Around = 6
Caption = 'Icon200InfoLabel'
@ -330,11 +330,26 @@ object AddToPackageDlg: TAddToPackageDlg
AnchorSideTop.Side = asrBottom
Left = 195
Height = 19
Top = 188
Top = 170
Width = 118
BorderSpacing.Left = 11
BorderSpacing.Top = 3
Caption = 'UnitFilenameLabel'
ParentColor = False
end
object UnitFilenameExistsLabel: TLabel
AnchorSideLeft.Control = UnitFilenameLabel
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = UnitFilenameLabel
AnchorSideTop.Side = asrCenter
Left = 331
Height = 19
Top = 170
Width = 152
BorderSpacing.Left = 18
Caption = 'UnitFilenameExistsLabel'
Font.Color = clMaroon
ParentColor = False
ParentFont = False
end
end

72
packager/addtopackagedlg.pas
View File

@ -101,10 +101,11 @@ type
Icon150InfoLabel: TLabel;
Icon200InfoLabel: TLabel;
IconNormLabel: TLabel;
ComponentUnitFileBrowseButton: TButton;
UnitFilenameExistsLabel: TLabel;
UnitDirectoryBrowseButton: TButton;
UnitDirectoryEdit: TEdit;
UnitDirectoryLabel: TLabel;
ComponentUnitFileShortenButton: TButton;
UnitDirectoryShortenButton: TButton;
UnitNameEdit: TEdit;
UnitNameLabel: TLabel;
Icon200BitBtn: TBitBtn;
@ -119,8 +120,8 @@ type
procedure AncestorShowAllCheckBoxClick(Sender: TObject);
procedure ClassNameEditChange(Sender: TObject);
procedure IconBitBtnClick(Sender: TObject);
procedure ComponentUnitFileBrowseButtonClick(Sender: TObject);
procedure ComponentUnitFileShortenButtonClick(Sender: TObject);
procedure UnitDirectoryBrowseButtonClick(Sender: TObject);
procedure UnitDirectoryShortenButtonClick(Sender: TObject);
procedure UnitDirectoryEditChange(Sender: TObject);
procedure UnitNameEditChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -130,8 +131,6 @@ type
fLastNewAncestorType: string;
fLastNewClassName: string;
FLazPackage: TLazPackage;
FOnGetIDEFileInfo: TGetIDEFileStateEvent;
FOnGetUnitRegisterInfo: TOnGetUnitRegisterInfo;
fPkgComponents: TAVLTree;// tree of TPkgComponent
fPackages: TAVLTree;// tree of TLazPackage or TPackageLink
fParams: TAddToPkgResult;
@ -146,37 +145,28 @@ type
function CheckNewCompOk: Boolean;
procedure AutoCompleteNewComponent;
procedure AutoCompleteUnitName;
procedure UpdateUnitFilename;
public
procedure UpdateAvailableAncestorTypes;
procedure UpdateAvailablePageNames;
public
property LazPackage: TLazPackage read FLazPackage write SetLazPackage;
property OnGetIDEFileInfo: TGetIDEFileStateEvent read FOnGetIDEFileInfo
write FOnGetIDEFileInfo;
property OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo
read FOnGetUnitRegisterInfo write FOnGetUnitRegisterInfo;
end;
function ShowAddToPackageDlg(Pkg: TLazPackage; out Params: TAddToPkgResult;
OnGetIDEFileInfo: TGetIDEFileStateEvent;
OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo): TModalResult;
function ShowAddToPackageDlg(Pkg: TLazPackage; out Params: TAddToPkgResult): TModalResult;
implementation
{$R *.lfm}
function ShowAddToPackageDlg(Pkg: TLazPackage; out Params: TAddToPkgResult;
OnGetIDEFileInfo: TGetIDEFileStateEvent;
OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo): TModalResult;
function ShowAddToPackageDlg(Pkg: TLazPackage; out Params: TAddToPkgResult): TModalResult;
var
AddDlg: TAddToPackageDlg;
begin
Params:=nil;
AddDlg:=TAddToPackageDlg.Create(nil);
try
AddDlg.OnGetIDEFileInfo:=OnGetIDEFileInfo;
AddDlg.OnGetUnitRegisterInfo:=OnGetUnitRegisterInfo;
AddDlg.LazPackage:=Pkg;
Result:=AddDlg.ShowModal;
if Result=mrOk then begin
@ -257,12 +247,13 @@ begin
UnitDirectoryLabel.Caption:=lisA2PDirectoryForUnitFile;
UnitDirectoryEdit.Text:='';
UnitFilenameLabel.Caption:='';
with ComponentUnitFileBrowseButton do begin
UnitFilenameExistsLabel.Caption:='';
with UnitDirectoryBrowseButton do begin
Caption:='...';
ShowHint:=true;
Hint:=lisA2PSaveFileDialog;
Hint:=lisChooseDirectory; // Remove lisA2PSaveFileDialog later.
end;
with ComponentUnitFileShortenButton do begin
with UnitDirectoryShortenButton do begin
Caption:='<>';
ShowHint:=true;
Hint:=lisA2PShortenOrExpandFilename;
@ -365,7 +356,7 @@ begin
end;
end;
procedure TAddToPackageDlg.ComponentUnitFileBrowseButtonClick(Sender: TObject);
procedure TAddToPackageDlg.UnitDirectoryBrowseButtonClick(Sender: TObject);
var
DirDialog: TSelectDirectoryDialog;
begin
@ -378,7 +369,7 @@ begin
//DirDialog.Filter:=Format('%s|*.pas;*.pp', [dlgFilterPascalFile]);
if DirDialog.Execute then begin
UnitDirectoryEdit.Text:=DirDialog.Filename;
UnitFilenameLabel.Caption:=AppendPathDelim(UnitDirectoryEdit.Text)+GenerateUnitFileName;
UpdateUnitFilename;
end;
InputHistories.StoreFileDialogSettings(DirDialog);
finally
@ -386,7 +377,7 @@ begin
end;
end;
procedure TAddToPackageDlg.ComponentUnitFileShortenButtonClick(Sender: TObject);
procedure TAddToPackageDlg.UnitDirectoryShortenButtonClick(Sender: TObject);
var
S: string;
begin
@ -400,12 +391,12 @@ begin
UnitDirectoryEdit.Text:=CreateRelativePath(S,LazPackage.Directory,True)
else
UnitDirectoryEdit.Text:=CreateAbsolutePath(S,LazPackage.Directory);
UnitFilenameLabel.Caption:=AppendPathDelim(UnitDirectoryEdit.Text)+GenerateUnitFileName;
UpdateUnitFilename;
end;
procedure TAddToPackageDlg.UnitDirectoryEditChange(Sender: TObject);
begin
UnitFilenameLabel.Caption:=AppendPathDelim(UnitDirectoryEdit.Text)+GenerateUnitFileName;
UpdateUnitFilename;
if UnitDirectoryEdit.Text<>'' then
fIconDlg.InitialDir:=UnitDirectoryEdit.Text;
end;
@ -413,7 +404,7 @@ end;
procedure TAddToPackageDlg.UnitNameEditChange(Sender: TObject);
begin
CheckNewCompOk;
UnitFilenameLabel.Caption:=AppendPathDelim(UnitDirectoryEdit.Text)+GenerateUnitFileName;
UpdateUnitFilename;
end;
procedure TAddToPackageDlg.NewComponentButtonClick(Sender: TObject);
@ -445,6 +436,13 @@ begin
raise Exception.Create('NewComponentButtonClick: Cannot create directory '+ThePath);
fParams.UnitFilename:=AppendPathDelim(ThePath)+GenerateUnitFileName;
// check if package is readonly
if LazPackage.ReadOnly then begin
IDEMessageDialog(lisAF2PPackageIsReadOnly,
Format(lisAF2PThePackageIsReadOnly, [LazPackage.IDAsString]),
mtError,[mbCancel]);
exit;
end;
// check Ancestor Type
if not IsValidIdent(fParams.AncestorType) then begin
IDEMessageDialog(lisA2PInvalidAncestorType,
@ -503,9 +501,14 @@ begin
then
exit;
end;
// check filename
if not CheckAddingPackageUnit(LazPackage, d2ptNewComponent,
OnGetIDEFileInfo, fParams.UnitFilename) then exit;
// check if unitname is a componentclass
if IDEComponentPalette.FindComponent(fParams.Unit_Name)<>nil then begin
if IDEMessageDialog(lisA2PAmbiguousUnitName,
Format(lisA2PTheUnitNameIsTheSameAsAnRegisteredComponent,[fParams.Unit_Name,LineEnding]),
mtWarning,[mbCancel,mbIgnore])<>mrIgnore
then
exit;
end;
// create dependency if needed
PkgComponent:=TPkgComponent(IDEComponentPalette.FindComponent(fParams.AncestorType));
@ -590,6 +593,15 @@ begin
UnitDirectoryEdit.Text:=LazPackage.Directory;
end;
procedure TAddToPackageDlg.UpdateUnitFilename;
begin
UnitFilenameLabel.Caption:=AppendPathDelim(UnitDirectoryEdit.Text)+GenerateUnitFileName;
if FileExists(UnitFilenameLabel.Caption) then
UnitFilenameExistsLabel.Caption:=lisA2PFileAlreadyExists
else
UnitFilenameExistsLabel.Caption:='';
end;
procedure TAddToPackageDlg.UpdateAvailableAncestorTypes;
var
ANode: TAVLTreeNode;

38
packager/packageeditor.pas
View File

@ -373,7 +373,7 @@ type
procedure DoSave(SaveAs: boolean);
procedure DoSortFiles;
function DoOpenPkgFile(PkgFile: TPkgFile): TModalResult;
function ShowAddDialog: TModalResult;
function ShowNewCompDialog: TModalResult;
function ShowAddDepDialog: TModalResult;
function ShowAddFPMakeDepDialog: TModalResult;
function PkgNameToFormName(const PkgName: string): string;
@ -1074,7 +1074,7 @@ end;
procedure TPackageEditorForm.mnuAddNewCompClick(Sender: TObject);
begin
ShowAddDialog;
ShowNewCompDialog;
end;
procedure TPackageEditorForm.mnuAddNewReqrClick(Sender: TObject);
@ -2128,7 +2128,7 @@ begin
end;
end;
function TPackageEditorForm.ShowAddDialog: TModalResult;
function TPackageEditorForm.ShowNewCompDialog: TModalResult;
var
IgnoreUnitPaths: TFilenameToStringTree;
@ -2140,19 +2140,25 @@ var
procedure AddNewComponent(AddParams: TAddToPkgResult);
begin
ExtendUnitIncPathForNewUnit(AddParams.UnitFilename,'',IgnoreUnitPaths);
ExtendUnitIncPathForNewUnit(AddParams.UnitFilename, '', IgnoreUnitPaths);
// add file
with AddParams do
LazPackage.AddFile(UnitFilename,Unit_Name,FileType,PkgFileFlags,cpNormal);
FreeAndNil(FNextSelectedPart);
FNextSelectedPart:=TPENodeData.Create(penFile,AddParams.UnitFilename,false);
// add dependency
if (AddParams.Dependency<>nil)
and (not PkgDependsOn(AddParams.Dependency.PackageName)) then
PackageGraph.AddDependencyToPackage(LazPackage,AddParams.Dependency);
if (AddParams.IconNormFile<>'') and (not PkgDependsOn('LCL')) then
PackageGraph.AddDependencyToPackage(LazPackage,PackageGraph.LCLPackage);
PackageEditors.DeleteAmbiguousFiles(LazPackage,AddParams.UnitFilename);
begin
Assert(FilenameIsAbsolute(UnitFilename), 'AddNewComponent: Filename is relative.');
// This file can also replace an existing file.
if LazPackage.FindPkgFile(UnitFilename,true,false)=nil then
LazPackage.AddFile(UnitFilename, Unit_Name, FileType, PkgFileFlags, cpNormal)
else
LazPackage.Modified:=True;
FreeAndNil(FNextSelectedPart);
FNextSelectedPart:=TPENodeData.Create(penFile, UnitFilename, false);
// add dependency
if (Dependency<>nil) and not PkgDependsOn(Dependency.PackageName) then
PackageGraph.AddDependencyToPackage(LazPackage, Dependency);
if (IconNormFile<>'') and not PkgDependsOn('LCL') then
PackageGraph.AddDependencyToPackage(LazPackage, PackageGraph.LCLPackage);
PackageEditors.DeleteAmbiguousFiles(LazPackage, UnitFilename);
end;
// open file in editor
PackageEditors.CreateNewFile(Self,AddParams);
end;
@ -2165,9 +2171,7 @@ begin
exit(mrCancel);
end;
Result:=ShowAddToPackageDlg(LazPackage, AddParams,
PackageEditors.OnGetIDEFileInfo,
PackageEditors.OnGetUnitRegisterInfo);
Result:=ShowAddToPackageDlg(LazPackage, AddParams);
if Result<>mrOk then exit;
PackageGraph.BeginUpdate(false);

9
packager/packagesystem.pas
View File

@ -1920,16 +1920,15 @@ begin
end;
{$ENDIF}
if (IDEComponentPalette<>nil)
and (IDEComponentPalette.FindComponent(CurClassname)<>nil) then begin
RegistrationError(
Format(lisPkgSysComponentClassAlreadyDefined, [CurComponent.ClassName]));
end;
and (IDEComponentPalette.FindComponent(CurClassname)<>nil) then
RegistrationError(Format(lisPkgSysComponentClassAlreadyDefined,[CurClassname]));
if AbortRegistration then exit;
// add the component to the package owning the file
// (e.g. a designtime package can register units of a runtime packages)
NewPkgComponent:=
FRegistrationFile.LazPackage.AddComponent(FRegistrationFile,Page,CurComponent);
//debugln('TLazPackageGraph.RegisterComponentsHandler Page="',Page,'" CurComponent=',CurComponent.ClassName,' FRegistrationFile=',FRegistrationFile.Filename);
//DebugLn('TLazPackageGraph.RegisterComponentsHandler Page="',Page,
// '" CurComponent=',CurClassname,' FRegistrationFile=',FRegistrationFile.Filename);
if IDEComponentPalette<>nil then
IDEComponentPalette.AddComponent(NewPkgComponent);
end;

2
packager/pkgmanager.pas
View File

@ -5244,7 +5244,7 @@ begin
// save
Result:=DoSavePackage(APackage,SaveFlags);
if Result<>mrOk then exit;
Result:=CurEditor.ShowAddDialog; // show new component dialog
Result:=CurEditor.ShowNewCompDialog; // show new component dialog
end;
function TPkgManager.SavePackageFiles(APackage: TLazPackage): TModalResult;