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

IDE: added menu item: Package / New component, feature 1337

Browse Source 
git-svn-id: trunk@35055 -
This commit is contained in:
mattias 2012-01-31 13:11:31 +00:00
parent 13ceadc4af
commit 7fb7467b8e
14 changed files with 469 additions and 198 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -6143,6 +6143,8 @@ packager/installpkgsetdlg.lfm svneol=native#text/plain
packager/installpkgsetdlg.pas svneol=native#text/pascal
packager/missingpkgfilesdlg.lfm svneol=native#text/plain
packager/missingpkgfilesdlg.pas svneol=native#text/plain
packager/newpkgcomponentdlg.lfm svneol=native#text/plain
packager/newpkgcomponentdlg.pas svneol=native#text/pascal
packager/openinstalledpkgdlg.lfm svneol=native#text/plain
packager/openinstalledpkgdlg.pas svneol=native#text/pascal
packager/packagedefs.pas svneol=native#text/pascal

3
docs/IDEWindowHelpTree.xml
View File

@ -1,5 +1,5 @@
<?xml version="1.0"?>
<CONFIG Name="IDE windows and dialogs" Path="IDE_Window:_" ChildCount="59">
<CONFIG Name="IDE windows and dialogs" Path="IDE_Window:_" ChildCount="60">
<Node1 Name="TObjectInspector" Path="Object_Inspector" HasHelp="True"/>
<Node2 Name="TfrmCompilerOptions" Path="Compiler_Options" IsRoot="True" HasHelp="True" ChildCount="1">
<Node1 Name="MainNotebook" ChildCount="7">
@ -162,4 +162,5 @@
<Node8 Name="DirCheck" Path="#ClickDir" HasHelp="True"/>
</Node58>
<Node59 Name="TCleanBuildProjectDialog" Path="Clean_up_build_files_dialog" IsRoot="True" HasHelp="True"/>
<Node60 Name="TNewPkgComponentDialog" Path="Create_new_package_component" IsRoot="True" HasHelp="True"/>
</CONFIG>

5
ide/keymapping.pp
View File

@ -581,6 +581,7 @@ begin
ecOpenPackageFile : Result:= lisMenuOpenPackageFile;
ecOpenPackageOfCurUnit : Result:= lisMenuOpenPackageOfCurUnit;
ecAddCurFileToPkg : Result:= lisMenuAddCurFileToPkg;
ecNewPkgComponent : Result:= lisMenuPkgNewPackageComponent;
ecPackageGraph : Result:= lisMenuPackageGraph;
ecEditInstallPkgs : Result:= lisMenuEditInstallPkgs;
ecConfigCustomComps : Result:= lisMenuConfigCustomComps;
@ -1164,6 +1165,7 @@ begin
ecOpenPackageFile: SetSingle(VK_UNKNOWN,[]);
ecOpenPackageOfCurUnit:SetSingle(VK_UNKNOWN,[]);
ecAddCurFileToPkg: SetSingle(VK_UNKNOWN,[]);
ecNewPkgComponent: SetSingle(VK_UNKNOWN,[]);
ecPackageGraph: SetSingle(VK_UNKNOWN,[]);
ecEditInstallPkgs: SetSingle(VK_UNKNOWN,[]);
ecConfigCustomComps: SetSingle(VK_UNKNOWN,[]);
@ -1592,6 +1594,7 @@ begin
ecOpenPackageFile: SetSingle(VK_UNKNOWN,[]);
ecOpenPackageOfCurUnit:SetSingle(VK_UNKNOWN,[]);
ecAddCurFileToPkg: SetSingle(VK_UNKNOWN,[]);
ecNewPkgComponent: SetSingle(VK_UNKNOWN,[]);
ecPackageGraph: SetSingle(VK_UNKNOWN,[]);
ecEditInstallPkgs: SetSingle(VK_UNKNOWN,[]);
ecConfigCustomComps: SetSingle(VK_UNKNOWN,[]);
@ -2201,6 +2204,7 @@ begin
ecOpenPackageFile: SetSingle(VK_UNKNOWN,[]);
ecOpenPackageOfCurUnit:SetSingle(VK_UNKNOWN,[]);
ecAddCurFileToPkg: SetSingle(VK_UNKNOWN,[]);
ecNewPkgComponent: SetSingle(VK_UNKNOWN,[]);
ecPackageGraph: SetSingle(VK_UNKNOWN,[]);
ecEditInstallPkgs: SetSingle(VK_UNKNOWN,[]);
ecConfigCustomComps: SetSingle(VK_UNKNOWN,[]);
@ -2792,6 +2796,7 @@ begin
AddDefault(C, 'Open package file', lisKMOpenPackageFile, ecOpenPackageFile);
AddDefault(C, 'Open package of current unit', lisMenuOpenPackageOfCurUnit, ecOpenPackageOfCurUnit);
AddDefault(C, 'Add active unit to a package', lisMenuAddCurFileToPkg, ecAddCurFileToPkg);
AddDefault(C, 'Add new component to a package', lisMenuPkgNewPackageComponent, ecNewPkgComponent);
AddDefault(C, 'Package graph', lisMenuPackageGraph, ecPackageGraph);
AddDefault(C, 'Configure installed packages', lisInstallUninstallPackages, ecEditInstallPkgs);
AddDefault(C, 'Configure custom components', lisKMConfigureCustomComponents, ecConfigCustomComps);

9
ide/lazarus.lpi
View File

@ -63,7 +63,7 @@
<PackageName Value="SynEdit"/>
</Item6>
</RequiredPackages>
<Units Count="87">
<Units Count="88">
<Unit0>
<Filename Value="lazarus.pp"/>
<IsPartOfProject Value="True"/>
@ -655,6 +655,13 @@
<ResourceBaseClass Value="Form"/>
<UnitName Value="IDEFPDocFileSearch"/>
</Unit86>
<Unit87>
<Filename Value="../packager/newpkgcomponentdlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="NewPkgComponentDialog"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="NewPkgComponentDlg"/>
</Unit87>
</Units>
</ProjectOptions>
<CompilerOptions>

5
ide/lazarusidestrconsts.pas
View File

@ -3254,6 +3254,10 @@ resourcestring
lisPkgFileTypeIssues = 'Issues xml file';
lisPkgFileTypeText = 'Text';
lisPkgFileTypeBinary = 'Binary';
lisCreateNewPackage = '(Create new package)';
lisCreateNewPackageComponent = 'Create new package component';
lisMenuNewComponent = 'New component';
lisPkgSelectAPackage = 'Select a package';
// view project units dialog
lisViewProjectUnits = 'View Project Units';
@ -5495,6 +5499,7 @@ resourcestring
lisFileFiltersDeleteRow = 'Delete Row';
lisFileFiltersInsertRow = 'Insert Row';
lisFileFiltersSetDefaults = 'Set defaults';
lisMenuPkgNewPackageComponent = 'New package component';
implementation

14
ide/main.pp
View File

@ -3926,20 +3926,20 @@ var
ASrcEdit: TSourceEditor;
AUnitInfo: TUnitInfo;
PkgFile: TPkgFile;
OpenPkgCurF, AddCurF: Boolean;
CanOpenPkgOfFile, CanAddCurFile: Boolean;
begin
OpenPkgCurF:=False;
AddCurF:=False;
CanOpenPkgOfFile:=False;
CanAddCurFile:=False;
GetCurrentUnit(ASrcEdit,AUnitInfo);
if Assigned(ASrcEdit) then begin
PkgFile:=PackageGraph.FindFileInAllPackages(AUnitInfo.Filename,true,
not AUnitInfo.IsPartOfProject);
OpenPkgCurF:=Assigned(PkgFile);
AddCurF:=(not AUnitInfo.IsVirtual) and FileExistsUTF8(AUnitInfo.Filename)
CanOpenPkgOfFile:=Assigned(PkgFile);
CanAddCurFile:=(not AUnitInfo.IsVirtual) and FileExistsUTF8(AUnitInfo.Filename)
and not AUnitInfo.IsPartOfProject;
end;
MainIDEBar.itmPkgOpenPackageOfCurUnit.Enabled:=OpenPkgCurF;
MainIDEBar.itmPkgAddCurFileToPkg.Enabled:=AddCurF;
MainIDEBar.itmPkgOpenPackageOfCurUnit.Enabled:=CanOpenPkgOfFile;
MainIDEBar.itmPkgAddCurFileToPkg.Enabled:=CanAddCurFile;
end;
{------------------------------------------------------------------------------}

1
ide/mainbar.pas
View File

@ -314,6 +314,7 @@ type
//itmPkgOpenRecent: TIDEMenuSection;
//itmPkgUnits: TIDEMenuSection;
itmPkgAddCurFileToPkg: TIDEMenuCommand;
itmPkgAddNewComponentToPkg: TIDEMenuCommand;
//itmPkgGraphSection: TIDEMenuSection;
itmPkgPkgGraph: TIDEMenuCommand;
itmPkgEditInstallPkgs: TIDEMenuCommand;

2
ide/mainbase.pas
View File

@ -720,6 +720,7 @@ begin
CreateMenuSeparatorSection(mnuComponent,itmPkgUnits,'itmPkgUnits');
ParentMI:=itmPkgUnits;
CreateMenuItem(ParentMI,itmPkgAddCurFileToPkg,'itmPkgAddCurFileToPkg',lisMenuAddCurFileToPkg,'pkg_add');
CreateMenuItem(ParentMI, itmPkgAddNewComponentToPkg, 'itmPkgAddNewComponentToPkg', lisMenuNewComponent, 'pkg_add');
CreateMenuSeparatorSection(mnuComponent,itmPkgGraphSection,'itmPkgGraphSection');
ParentMI:=itmPkgGraphSection;
@ -991,6 +992,7 @@ begin
itmPkgOpenPackageFile.Command:=GetCommand(ecOpenPackageFile);
itmPkgOpenPackageOfCurUnit.Command:=GetCommand(ecOpenPackageOfCurUnit);
itmPkgAddCurFileToPkg.Command:=GetCommand(ecAddCurFileToPkg);
itmPkgAddNewComponentToPkg.Command:=GetCommand(ecNewPkgComponent);
itmPkgPkgGraph.Command:=GetCommand(ecPackageGraph);
itmPkgEditInstallPkgs.Command:=GetCommand(ecEditInstallPkgs);
{$IFDEF CustomIDEComps}

9
ideintf/idecommands.pas
View File

@ -283,11 +283,12 @@ const
ecOpenPackageFile = ecFirstLazarus + 601;
ecOpenPackageOfCurUnit = ecFirstLazarus + 602;
ecAddCurFileToPkg = ecFirstLazarus + 603;
ecNewPkgComponent = ecFirstLazarus + 604;
// ecAddCurUnitToPkg = ecAddCurFileToPkg deprecated;
ecPackageGraph = ecFirstLazarus + 604;
ecEditInstallPkgs = ecFirstLazarus + 605;
ecConfigCustomComps = ecFirstLazarus + 606;
ecNewPackage = ecFirstLazarus + 607;
ecPackageGraph = ecFirstLazarus + 605;
ecEditInstallPkgs = ecFirstLazarus + 606;
ecConfigCustomComps = ecFirstLazarus + 607;
ecNewPackage = ecFirstLazarus + 608;
// custom tools menu
ecExtToolFirst = ecFirstLazarus + 700;

33
packager/addtopackagedlg.pas
View File

@ -177,6 +177,8 @@ type
fPkgComponents: TAVLTree;// tree of TPkgComponent
fPackages: TAVLTree;// tree of TLazPackage or TPackageLink
FComponentIconFilename: string;
function GetActivatePage: TAddToPkgType;
procedure SetActivatePage(AValue: TAddToPkgType);
procedure SetLazPackage(const AValue: TLazPackage);
procedure SetupComponents;
procedure SetupNewFilePage;
@ -202,11 +204,13 @@ type
write FOnGetIDEFileInfo;
property OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo
read FOnGetUnitRegisterInfo write FOnGetUnitRegisterInfo;
property ActivatePage: TAddToPkgType read GetActivatePage write SetActivatePage;
end;
function ShowAddToPackageDlg(Pkg: TLazPackage; var Params: TAddToPkgResult;
OnGetIDEFileInfo: TGetIDEFileStateEvent;
OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo): TModalResult;
OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo;
var Page: TAddToPkgType): TModalResult;
function CheckAddingUnitFilename(LazPackage: TLazPackage;
AddFileType: TAddToPkgType; OnGetIDEFileInfo: TGetIDEFileStateEvent;
var AFilename: string): boolean;
@ -223,7 +227,8 @@ implementation
function ShowAddToPackageDlg(Pkg: TLazPackage; var Params: TAddToPkgResult;
OnGetIDEFileInfo: TGetIDEFileStateEvent;
OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo): TModalResult;
OnGetUnitRegisterInfo: TOnGetUnitRegisterInfo;
var Page: TAddToPkgType): TModalResult;
var
AddDlg: TAddToPackageDlg;
begin
@ -231,7 +236,9 @@ begin
AddDlg.OnGetIDEFileInfo:=OnGetIDEFileInfo;
AddDlg.OnGetUnitRegisterInfo:=OnGetUnitRegisterInfo;
AddDlg.LazPackage:=Pkg;
AddDlg.ActivatePage:=Page;
Result:=AddDlg.ShowModal;
Page:=AddDlg.ActivatePage;
if Result=mrOk then begin
Params:=AddDlg.Params;
AddDlg.Params:=nil;
@ -1052,6 +1059,28 @@ begin
UpdateAvailableDependencyNames;
end;
function TAddToPackageDlg.GetActivatePage: TAddToPkgType;
begin
if NoteBook.ActivePage=NewComponentPage then
Result:=d2ptNewComponent
else if NoteBook.ActivePage=NewRequirementPage then
Result:=d2ptRequiredPkg
else if NoteBook.ActivePage=AddFilesPage then
Result:=d2ptFiles
else
Result:=d2ptNewFile;
end;
procedure TAddToPackageDlg.SetActivatePage(AValue: TAddToPkgType);
begin
case AValue of
d2ptNewComponent: NoteBook.ActivePage:=NewComponentPage;
d2ptRequiredPkg: NoteBook.ActivePage:=NewRequirementPage;
d2ptFile,d2ptFiles: NoteBook.ActivePage:=AddFilesPage;
else NoteBook.ActivePage:=NewFilePage;
end;
end;
procedure TAddToPackageDlg.SetupComponents;
begin
NewFilePage.Caption:=lisA2PNewFile;

51
packager/newpkgcomponentdlg.lfm Normal file
View File

@ -0,0 +1,51 @@
object NewPkgComponentDialog: TNewPkgComponentDialog
Left = 250
Height = 255
Top = 250
Width = 343
Caption = 'NewPkgComponentDialog'
ClientHeight = 255
ClientWidth = 343
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '0.9.31'
object ButtonPanel1: TButtonPanel
Left = 6
Height = 40
Top = 209
Width = 331
OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
TabOrder = 0
ShowButtons = [pbOK, pbCancel, pbHelp]
end
object PkgsGroupBox: TGroupBox
Left = 6
Height = 197
Top = 6
Width = 331
Align = alClient
BorderSpacing.Around = 6
Caption = 'PkgsGroupBox'
ClientHeight = 178
ClientWidth = 327
TabOrder = 1
object PkgsListBox: TListBox
Left = 0
Height = 178
Top = 0
Width = 327
Align = alClient
ItemHeight = 0
ScrollWidth = 325
TabOrder = 0
TopIndex = -1
end
end
end

122
packager/newpkgcomponentdlg.pas Normal file
View File

@ -0,0 +1,122 @@
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code 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. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
Author: Mattias Gaertner
Abstract:
Dialog to select the package where to create the new component.
}
unit NewPkgComponentDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel,
StdCtrls, PackageSystem, PackageDefs, LazarusIDEStrConsts;
type
{ TNewPkgComponentDialog }
TNewPkgComponentDialog = class(TForm)
ButtonPanel1: TButtonPanel;
PkgsGroupBox: TGroupBox;
PkgsListBox: TListBox;
procedure FormCreate(Sender: TObject);
private
procedure FillPkgsListBox;
public
function GetPackageName: string;
end;
function ShowNewPkgComponentDialog(out aPackage: TLazPackage): TModalResult;
implementation
{$R *.lfm}
function ShowNewPkgComponentDialog(out aPackage: TLazPackage): TModalResult;
var
NewPkgComponentDialog: TNewPkgComponentDialog;
PkgName: String;
begin
aPackage:=nil;
NewPkgComponentDialog:=TNewPkgComponentDialog.Create(nil);
try
Result:=NewPkgComponentDialog.ShowModal;
if Result<>mrOk then exit;
PkgName:=NewPkgComponentDialog.GetPackageName;
if PkgName<>'' then
aPackage:=PackageGraph.FindPackageWithName(PkgName,nil);
finally
NewPkgComponentDialog.Free;
end;
end;
{ TNewPkgComponentDialog }
procedure TNewPkgComponentDialog.FormCreate(Sender: TObject);
begin
Caption:=lisCreateNewPackageComponent;
PkgsGroupBox.Caption:=lisPkgSelectAPackage;
FillPkgsListBox;
end;
procedure TNewPkgComponentDialog.FillPkgsListBox;
var
sl: TStringList;
Pkg: TLazPackage;
i: Integer;
begin
sl:=TStringList.Create;
try
for i:=0 to PackageGraph.Count-1 do begin
Pkg:=PackageGraph[i];
if (not (Pkg.PackageType in [lptRunAndDesignTime,lptDesignTime]))
or Pkg.ReadOnly or Pkg.AutoCreated
then continue;
sl.Add(Pkg.Name);
end;
sl.Sort;
// add as first item '(create new)'
sl.Insert(0,lisCreateNewPackage);
PkgsListBox.Items.Assign(sl);
PkgsListBox.ItemIndex:=0;
finally
sl.Free;
end;
end;
function TNewPkgComponentDialog.GetPackageName: string;
var
i: Integer;
begin
i:=PkgsListBox.ItemIndex;
if i<1 then
Result:=''
else
Result:=PkgsListBox.Items[i];
end;
end.

371
packager/packageeditor.pas
View File

@ -271,6 +271,7 @@ type
var IgnoreIncPaths: TFilenameToStringTree);
function CanBeAddedToProject: boolean;
protected
fLastDlgPage: TAddToPkgType;
procedure SetLazPackage(const AValue: TLazPackage); override;
public
constructor Create(TheOwner: TComponent); override;
@ -289,6 +290,7 @@ type
procedure DoSortFiles;
procedure DoOpenPkgFile(PkgFile: TPkgFile);
procedure UpdateAll(Immediately: boolean); override;
function ShowAddDialog(var DlgPage: TAddToPkgType): TModalResult;
public
property LazPackage: TLazPackage read FLazPackage write SetLazPackage;
property SortAlphabetically: boolean read FSortAlphabetically write SetSortAlphabetically;
@ -1125,189 +1127,8 @@ begin
end;
procedure TPackageEditorForm.AddBitBtnClick(Sender: TObject);
var
IgnoreUnitPaths, IgnoreIncPaths: TFilenameToStringTree;
procedure AddUnit(AddParams: TAddToPkgResult);
var
NewLFMFilename: String;
NewLRSFilename: String;
begin
NewLFMFilename:='';
NewLRSFilename:='';
// add lfm file
if AddParams.AutoAddLFMFile then begin
NewLFMFilename:=ChangeFileExt(AddParams.UnitFilename,'.lfm');
if FileExistsUTF8(NewLFMFilename)
and (LazPackage.FindPkgFile(NewLFMFilename,true,false)=nil) then
LazPackage.AddFile(NewLFMFilename,'',pftLFM,[],cpNormal)
else
NewLFMFilename:='';
end;
// add lrs file
if AddParams.AutoAddLRSFile then begin
NewLRSFilename:=ChangeFileExt(AddParams.UnitFilename,'.lrs');
if FileExistsUTF8(NewLRSFilename)
and (LazPackage.FindPkgFile(NewLRSFilename,true,false)=nil) then
LazPackage.AddFile(NewLRSFilename,'',pftLRS,[],cpNormal)
else
NewLRSFilename:='';
end;
ExtendUnitIncPathForNewUnit(AddParams.UnitFilename,NewLRSFilename,
IgnoreUnitPaths);
// add unit file
with AddParams do
FNextSelectedPart := LazPackage.AddFile(UnitFilename,Unit_Name,
FileType,PkgFileFlags,cpNormal);
PackageEditors.DeleteAmbiguousFiles(LazPackage,AddParams.UnitFilename);
UpdateAll(false);
end;
procedure AddVirtualUnit(AddParams: TAddToPkgResult);
begin
with AddParams do
FNextSelectedPart := LazPackage.AddFile(UnitFilename,Unit_Name,FileType,
PkgFileFlags,cpNormal);
PackageEditors.DeleteAmbiguousFiles(LazPackage,AddParams.UnitFilename);
UpdateAll(false);
end;
procedure AddNewComponent(AddParams: TAddToPkgResult);
begin
ExtendUnitIncPathForNewUnit(AddParams.UnitFilename,'',IgnoreUnitPaths);
// add file
with AddParams do
FNextSelectedPart := LazPackage.AddFile(UnitFilename,Unit_Name,FileType,
PkgFileFlags,cpNormal);
// add dependency
if (AddParams.Dependency<>nil)
and (LazPackage.FindDependencyByName(AddParams.Dependency.PackageName)=nil)
then
PackageGraph.AddDependencyToPackage(LazPackage,AddParams.Dependency);
if (AddParams.IconFile<>'')
and (LazPackage.FindDependencyByName('LCL')=nil) then
PackageGraph.AddDependencyToPackage(LazPackage,PackageGraph.LCLPackage);
PackageEditors.DeleteAmbiguousFiles(LazPackage,AddParams.UnitFilename);
// open file in editor
PackageEditors.CreateNewFile(Self,AddParams);
UpdateAll(false);
end;
procedure AddRequiredPkg(AddParams: TAddToPkgResult);
begin
// add dependency
PackageGraph.AddDependencyToPackage(LazPackage,AddParams.Dependency);
FNextSelectedPart := AddParams.Dependency;
UpdateAll(false);
end;
procedure AddFile(AddParams: TAddToPkgResult);
begin
// add file
with AddParams do begin
if (CompareFileExt(UnitFilename,'.inc',false)=0)
or (CompareFileExt(UnitFilename,'.lrs',false)=0) then
ExtendIncPathForNewIncludeFile(UnitFilename,IgnoreIncPaths);
FNextSelectedPart := LazPackage.AddFile(UnitFilename,Unit_Name,FileType,
PkgFileFlags,cpNormal);
end;
UpdateAll(false);
end;
procedure AddNewFile(AddParams: TAddToPkgResult);
var
NewFilename: String;
DummyResult: TModalResult;
NewFileType: TPkgFileType;
NewPkgFileFlags: TPkgFileFlags;
Desc: TProjectFileDescriptor;
NewUnitName: String;
HasRegisterProc: Boolean;
begin
// create new file
if AddParams.NewItem is TNewItemProjectFile then begin
// create new file
Desc:=TNewItemProjectFile(AddParams.NewItem).Descriptor;
NewFilename:='';
DummyResult:=LazarusIDE.DoNewFile(Desc,NewFilename,'',
[nfOpenInEditor,nfCreateDefaultSrc,nfIsNotPartOfProject],LazPackage);
if DummyResult=mrOk then begin
// success
// -> now add it to package
NewUnitName:='';
NewFileType:=FileNameToPkgFileType(NewFilename);
NewPkgFileFlags:=[];
if (NewFileType in PkgFileUnitTypes) then begin
Include(NewPkgFileFlags,pffAddToPkgUsesSection);
NewUnitName:=ExtractFilenameOnly(NewFilename);
if Assigned(PackageEditors.OnGetUnitRegisterInfo) then begin
HasRegisterProc:=false;
PackageEditors.OnGetUnitRegisterInfo(Self,NewFilename,
NewUnitName,HasRegisterProc);
if HasRegisterProc then
Include(NewPkgFileFlags,pffHasRegisterProc);
end;
end;
FNextSelectedPart := LazPackage.AddFile(NewFilename,NewUnitName,NewFileType,
NewPkgFileFlags, cpNormal);
UpdateAll(true);
end;
end;
end;
var
AddParams: TAddToPkgResult;
OldParams: TAddToPkgResult;
begin
if LazPackage.ReadOnly then begin
UpdateButtons;
exit;
end;
if ShowAddToPackageDlg(LazPackage,AddParams,PackageEditors.OnGetIDEFileInfo,
PackageEditors.OnGetUnitRegisterInfo)
<>mrOk
then
exit;
PackageGraph.BeginUpdate(false);
IgnoreUnitPaths:=nil;
IgnoreIncPaths:=nil;
try
while AddParams<>nil do begin
case AddParams.AddType of
d2ptUnit:
AddUnit(AddParams);
d2ptVirtualUnit:
AddVirtualUnit(AddParams);
d2ptNewComponent:
AddNewComponent(AddParams);
d2ptRequiredPkg:
AddRequiredPkg(AddParams);
d2ptFile:
AddFile(AddParams);
d2ptNewFile:
AddNewFile(AddParams);
end;
OldParams:=AddParams;
AddParams:=AddParams.Next;
OldParams.Next:=nil;
OldParams.Free;
end;
AddParams.Free;
LazPackage.Modified:=true;
finally
IgnoreUnitPaths.Free;
IgnoreIncPaths.Free;
PackageGraph.EndUpdate;
end;
ShowAddDialog(fLastDlgPage);
end;
procedure TPackageEditorForm.AddToUsesPkgSectionCheckBoxChange(Sender: TObject);
@ -1638,6 +1459,192 @@ begin
UpdateStatusBar;
end;
function TPackageEditorForm.ShowAddDialog(var DlgPage: TAddToPkgType
): TModalResult;
var
IgnoreUnitPaths, IgnoreIncPaths: TFilenameToStringTree;
procedure AddUnit(AddParams: TAddToPkgResult);
var
NewLFMFilename: String;
NewLRSFilename: String;
begin
NewLFMFilename:='';
NewLRSFilename:='';
// add lfm file
if AddParams.AutoAddLFMFile then begin
NewLFMFilename:=ChangeFileExt(AddParams.UnitFilename,'.lfm');
if FileExistsUTF8(NewLFMFilename)
and (LazPackage.FindPkgFile(NewLFMFilename,true,false)=nil) then
LazPackage.AddFile(NewLFMFilename,'',pftLFM,[],cpNormal)
else
NewLFMFilename:='';
end;
// add lrs file
if AddParams.AutoAddLRSFile then begin
NewLRSFilename:=ChangeFileExt(AddParams.UnitFilename,'.lrs');
if FileExistsUTF8(NewLRSFilename)
and (LazPackage.FindPkgFile(NewLRSFilename,true,false)=nil) then
LazPackage.AddFile(NewLRSFilename,'',pftLRS,[],cpNormal)
else
NewLRSFilename:='';
end;
ExtendUnitIncPathForNewUnit(AddParams.UnitFilename,NewLRSFilename,
IgnoreUnitPaths);
// add unit file
with AddParams do
FNextSelectedPart := LazPackage.AddFile(UnitFilename,Unit_Name,
FileType,PkgFileFlags,cpNormal);
PackageEditors.DeleteAmbiguousFiles(LazPackage,AddParams.UnitFilename);
UpdateAll(false);
end;
procedure AddVirtualUnit(AddParams: TAddToPkgResult);
begin
with AddParams do
FNextSelectedPart := LazPackage.AddFile(UnitFilename,Unit_Name,FileType,
PkgFileFlags,cpNormal);
PackageEditors.DeleteAmbiguousFiles(LazPackage,AddParams.UnitFilename);
UpdateAll(false);
end;
procedure AddNewComponent(AddParams: TAddToPkgResult);
begin
ExtendUnitIncPathForNewUnit(AddParams.UnitFilename,'',IgnoreUnitPaths);
// add file
with AddParams do
FNextSelectedPart := LazPackage.AddFile(UnitFilename,Unit_Name,FileType,
PkgFileFlags,cpNormal);
// add dependency
if (AddParams.Dependency<>nil)
and (LazPackage.FindDependencyByName(AddParams.Dependency.PackageName)=nil)
then
PackageGraph.AddDependencyToPackage(LazPackage,AddParams.Dependency);
if (AddParams.IconFile<>'')
and (LazPackage.FindDependencyByName('LCL')=nil) then
PackageGraph.AddDependencyToPackage(LazPackage,PackageGraph.LCLPackage);
PackageEditors.DeleteAmbiguousFiles(LazPackage,AddParams.UnitFilename);
// open file in editor
PackageEditors.CreateNewFile(Self,AddParams);
UpdateAll(false);
end;
procedure AddRequiredPkg(AddParams: TAddToPkgResult);
begin
// add dependency
PackageGraph.AddDependencyToPackage(LazPackage,AddParams.Dependency);
FNextSelectedPart := AddParams.Dependency;
UpdateAll(false);
end;
procedure AddFile(AddParams: TAddToPkgResult);
begin
// add file
with AddParams do begin
if (CompareFileExt(UnitFilename,'.inc',false)=0)
or (CompareFileExt(UnitFilename,'.lrs',false)=0) then
ExtendIncPathForNewIncludeFile(UnitFilename,IgnoreIncPaths);
FNextSelectedPart := LazPackage.AddFile(UnitFilename,Unit_Name,FileType,
PkgFileFlags,cpNormal);
end;
UpdateAll(false);
end;
procedure AddNewFile(AddParams: TAddToPkgResult);
var
NewFilename: String;
DummyResult: TModalResult;
NewFileType: TPkgFileType;
NewPkgFileFlags: TPkgFileFlags;
Desc: TProjectFileDescriptor;
NewUnitName: String;
HasRegisterProc: Boolean;
begin
// create new file
if AddParams.NewItem is TNewItemProjectFile then begin
// create new file
Desc:=TNewItemProjectFile(AddParams.NewItem).Descriptor;
NewFilename:='';
DummyResult:=LazarusIDE.DoNewFile(Desc,NewFilename,'',
[nfOpenInEditor,nfCreateDefaultSrc,nfIsNotPartOfProject],LazPackage);
if DummyResult=mrOk then begin
// success
// -> now add it to package
NewUnitName:='';
NewFileType:=FileNameToPkgFileType(NewFilename);
NewPkgFileFlags:=[];
if (NewFileType in PkgFileUnitTypes) then begin
Include(NewPkgFileFlags,pffAddToPkgUsesSection);
NewUnitName:=ExtractFilenameOnly(NewFilename);
if Assigned(PackageEditors.OnGetUnitRegisterInfo) then begin
HasRegisterProc:=false;
PackageEditors.OnGetUnitRegisterInfo(Self,NewFilename,
NewUnitName,HasRegisterProc);
if HasRegisterProc then
Include(NewPkgFileFlags,pffHasRegisterProc);
end;
end;
FNextSelectedPart := LazPackage.AddFile(NewFilename,NewUnitName,NewFileType,
NewPkgFileFlags, cpNormal);
UpdateAll(true);
end;
end;
end;
var
AddParams: TAddToPkgResult;
OldParams: TAddToPkgResult;
begin
if LazPackage.ReadOnly then begin
UpdateButtons;
exit(mrCancel);
end;
Result:=ShowAddToPackageDlg(LazPackage,AddParams,PackageEditors.OnGetIDEFileInfo,
PackageEditors.OnGetUnitRegisterInfo,DlgPage);
fLastDlgPage:=DlgPage;
if Result<>mrOk then exit;
PackageGraph.BeginUpdate(false);
IgnoreUnitPaths:=nil;
IgnoreIncPaths:=nil;
try
while AddParams<>nil do begin
case AddParams.AddType of
d2ptUnit:
AddUnit(AddParams);
d2ptVirtualUnit:
AddVirtualUnit(AddParams);
d2ptNewComponent:
AddNewComponent(AddParams);
d2ptRequiredPkg:
AddRequiredPkg(AddParams);
d2ptFile:
AddFile(AddParams);
d2ptNewFile:
AddNewFile(AddParams);
end;
OldParams:=AddParams;
AddParams:=AddParams.Next;
OldParams.Next:=nil;
OldParams.Free;
end;
AddParams.Free;
LazPackage.Modified:=true;
finally
IgnoreUnitPaths.Free;
IgnoreIncPaths.Free;
PackageGraph.EndUpdate;
end;
end;
procedure TPackageEditorForm.UpdateTitle;
var
NewCaption: String;

40
packager/pkgmanager.pas
View File

@ -61,7 +61,7 @@ uses
IDETranslations, TransferMacros, BuildLazDialog, NewDialog,
IDEDialogs, ProjectInspector, ComponentPalette, SourceEditor,
AddFileToAPackageDlg, LazarusPackageIntf, PublishProjectDlg, PkgLinksDlg,
InstallPkgSetDlg, ConfirmPkgListDlg,
InstallPkgSetDlg, ConfirmPkgListDlg, NewPkgComponentDlg,
// bosses
BaseBuildManager, BasePkgManager,
MainBar, MainIntf, MainBase;
@ -128,6 +128,7 @@ type
procedure MainIDEitmPkgPkgGraphClick(Sender: TObject);
procedure MainIDEitmPkgEditInstallPkgsClick(Sender: TObject);
procedure MainIDEitmPkgAddCurFileToPkgClick(Sender: TObject);
procedure MainIDEitmPkgNewComponentClick(Sender: TObject);
procedure MainIDEitmPkgOpenPackageOfCurUnitClicked(Sender: TObject);
procedure MainIDEitmConfigCustomCompsClicked(Sender: TObject);
procedure MainIDEitmOpenRecentPackageClicked(Sender: TObject);
@ -285,6 +286,7 @@ type
function DoClosePackageEditor(APackage: TLazPackage): TModalResult; override;
function DoCloseAllPackageEditors: TModalResult; override;
function DoAddActiveUnitToAPackage: TModalResult;
function DoNewPackageComponent: TModalResult;
function WarnAboutMissingPackageFiles(APackage: TLazPackage): TModalResult;
function AddPackageDependency(APackage: TLazPackage; const ReqPackage: string;
OnlyTestIfPossible: boolean = false): TModalResult; override;
@ -559,6 +561,11 @@ begin
DoAddActiveUnitToAPackage;
end;
procedure TPkgManager.MainIDEitmPkgNewComponentClick(Sender: TObject);
begin
DoNewPackageComponent;
end;
procedure TPkgManager.MainIDEitmPkgOpenPackageOfCurUnitClicked(Sender: TObject);
var
ActiveSourceEditor: TSourceEditorInterface;
@ -1579,6 +1586,7 @@ begin
itmPkgOpenPackageFile.OnClick:=@MainIDEitmPkgOpenPackageFileClick;
itmPkgOpenPackageOfCurUnit.OnClick :=@MainIDEitmPkgOpenPackageOfCurUnitClicked;
itmPkgAddCurFileToPkg.OnClick:=@MainIDEitmPkgAddCurFileToPkgClick;
itmPkgAddNewComponentToPkg.OnClick:=@MainIDEitmPkgNewComponentClick;
itmPkgPkgGraph.OnClick:=@MainIDEitmPkgPkgGraphClick;
itmPkgEditInstallPkgs.OnClick:=@MainIDEitmPkgEditInstallPkgsClick;
{$IFDEF CustomIDEComps}
@ -3448,6 +3456,36 @@ begin
@MainIDE.GetIDEFileState);
end;
function TPkgManager.DoNewPackageComponent: TModalResult;
var
APackage: TLazPackage;
CurEditor: TPackageEditorForm;
SaveFlags: TPkgSaveFlags;
Page: TAddToPkgType;
begin
Result:=ShowNewPkgComponentDialog(APackage);
if Result<>mrOk then exit;
SaveFlags:=[];
if APackage=nil then begin
// create new package
// create a new package with standard dependencies
APackage:=PackageGraph.CreateNewPackage(NameToValidIdentifier(lisPkgMangNewPackage));
PackageGraph.AddDependencyToPackage(APackage,
PackageGraph.IDEIntfPackage.CreateDependencyWithOwner(APackage));
APackage.Modified:=false;
Include(SaveFlags,psfSaveAs);
end;
// open a package editor
CurEditor:=PackageEditors.OpenEditor(APackage);
IDEWindowCreators.ShowForm(CurEditor,true);
// save
Result:=DoSavePackage(APackage,SaveFlags);
if Result<>mrOk then exit;
// show new component dialog
Page:=d2ptNewComponent;
Result:=CurEditor.ShowAddDialog(Page);
end;
function TPkgManager.WarnAboutMissingPackageFiles(APackage: TLazPackage): TModalResult;
var
i: Integer;