mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-14 07:59:35 +02:00
implemented adding units to packages
git-svn-id: trunk@4023 -
This commit is contained in:
mattias
parent
47c644e8e8
commit
82e0e66828
@ -41,9 +41,9 @@ uses
|
||||
MemCheck,
|
||||
{$ENDIF}
|
||||
Classes, LazarusIDEStrConsts, LCLType, LclLinux, Compiler, StdCtrls, Forms,
|
||||
Buttons, Menus, ComCtrls, Spin, Project, SysUtils, FileCtrl, Controls,
|
||||
Graphics, ExtCtrls, Dialogs, LazConf, CompReg, CodeToolManager,
|
||||
Splash, ObjectInspector, PropEdits, SynEditKeyCmds, OutputFilter,
|
||||
Buttons, Menus, ComCtrls, Spin, ProjectDefs, Project, SysUtils, FileCtrl,
|
||||
Controls, Graphics, ExtCtrls, Dialogs, LazConf, CompReg, CodeToolManager,
|
||||
Splash, ObjectInspector, PropEdits, SynEditKeyCmds, OutputFilter, IDEDefs,
|
||||
MsgView, EnvironmentOpts, EditorOptions, IDEComp, FormEditor,
|
||||
KeyMapping, IDEProcs, UnitEditor, Debugger, IDEOptionDefs, CodeToolsDefines;
|
||||
|
||||
@ -70,9 +70,18 @@ type
|
||||
);
|
||||
|
||||
// new file flags
|
||||
TNewFlag = (nfIsPartOfProject // force IsPartOfProject,
|
||||
// default is to use a heuristic
|
||||
);
|
||||
TNewFlag = (
|
||||
nfIsPartOfProject, // force IsPartOfProject,
|
||||
// default is to use a heuristic
|
||||
nfIsNotPartOfProject,// forbid IsPartOfProject
|
||||
nfOpenInEditor, // open in editor
|
||||
nfSave, // save file instantly
|
||||
nfAddToRecent, // add file to recent files
|
||||
nfQuiet, // less messages
|
||||
nfConvertMacros, // replace macros in filename
|
||||
nfBeautifySrc, // beautify custom source
|
||||
nfCreateDefaultSrc // create initial source based on the type
|
||||
);
|
||||
TNewFlags = set of TNewFlag;
|
||||
|
||||
// save file flags
|
||||
@ -331,7 +340,12 @@ type
|
||||
function GetTestUnitFilename(AnUnitInfo: TUnitInfo): string; virtual; abstract;
|
||||
function IsTestUnitFilename(const AFilename: string): boolean; virtual; abstract;
|
||||
function GetRunCommandLine: string; virtual; abstract;
|
||||
procedure GetIDEFileState(Sender: TObject; const AFilename: string;
|
||||
NeededFlags: TIDEFileStateFlags; var ResultFlags: TIDEFileStateFlags); virtual; abstract;
|
||||
|
||||
function DoNewEditorFile(NewUnitType: TNewUnitType;
|
||||
NewFilename: string; const NewSource: string;
|
||||
NewFlags: TNewFlags): TModalResult; virtual; abstract;
|
||||
function DoOpenEditorFile(AFileName:string; PageIndex: integer;
|
||||
Flags: TOpenFlags): TModalResult; virtual; abstract;
|
||||
function DoInitProjectRun: TModalResult; virtual; abstract;
|
||||
@ -343,6 +357,7 @@ type
|
||||
Compiling: boolean): TModalResult;
|
||||
|
||||
procedure UpdateWindowsMenu; virtual;
|
||||
procedure SaveSourceEditorChangesToCodeCache(PageIndex: integer); virtual; abstract;
|
||||
end;
|
||||
|
||||
var
|
||||
|
||||
@ -64,17 +64,6 @@ type
|
||||
var Allowed: boolean) of object;
|
||||
|
||||
//---------------------------------------------------------------------------
|
||||
TNewUnitType = (
|
||||
nuEmpty, // no code
|
||||
nuUnit, // unit
|
||||
nuForm, // unit with form
|
||||
nuText,
|
||||
nuCustomProgram // program
|
||||
);
|
||||
|
||||
TUnitUsage = (uuIsPartOfProject, uuIsLoaded, uuIsModified, uuNotUsed);
|
||||
|
||||
|
||||
TUnitInfo = class(TObject)
|
||||
private
|
||||
fAutoRevertLockCount: integer;
|
||||
@ -314,6 +303,7 @@ type
|
||||
function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
|
||||
function UnitWithEditorIndex(Index:integer): TUnitInfo;
|
||||
Function UnitWithForm(AForm: TComponent): TUnitInfo;
|
||||
function UnitInfoWithFilename(const AFilename: string): TUnitInfo;
|
||||
|
||||
procedure CloseEditorIndex(EditorIndex:integer);
|
||||
procedure InsertEditorIndex(EditorIndex:integer);
|
||||
@ -894,9 +884,9 @@ begin
|
||||
'unit '+fUnitName+';'+LE
|
||||
+LE
|
||||
+'{$mode objfpc}{$H+}'+LE
|
||||
++LE
|
||||
+LE
|
||||
+'interface'+LE
|
||||
++LE
|
||||
+LE
|
||||
+'uses'+LE);
|
||||
case NewUnitType of
|
||||
nuUnit:
|
||||
@ -909,7 +899,7 @@ begin
|
||||
nuForm:
|
||||
begin
|
||||
NewSource:=NewSource+Beautified(
|
||||
' Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources;'+LE
|
||||
' Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs;'+LE
|
||||
+LE
|
||||
+'type'+LE
|
||||
+' T'+fFormName+' = class(TForm)'+LE
|
||||
@ -2072,6 +2062,17 @@ begin
|
||||
Result:=Result.fNextUnitWithForm;
|
||||
end;
|
||||
|
||||
function TProject.UnitInfoWithFilename(const AFilename: string): TUnitInfo;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
i:=IndexOfFilename(AFilename);
|
||||
if i>=0 then
|
||||
Result:=Units[i]
|
||||
else
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TProject.IndexOfFilename(const AFilename: string): integer;
|
||||
begin
|
||||
Result:=UnitCount-1;
|
||||
@ -2281,6 +2282,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.102 2003/04/07 23:49:03 mattias
|
||||
implemented adding units to packages
|
||||
|
||||
Revision 1.101 2003/03/29 21:41:19 mattias
|
||||
fixed path delimiters for environment directories
|
||||
|
||||
|
||||
@ -45,6 +45,17 @@ type
|
||||
TProjectWriteFlag = (pwfDontSaveClosedUnits, pwfSaveOnlyProjectUnits);
|
||||
TProjectWriteFlags = set of TProjectWriteFlag;
|
||||
|
||||
TNewUnitType = (
|
||||
nuEmpty, // no code
|
||||
nuUnit, // unit
|
||||
nuForm, // unit with form
|
||||
nuText,
|
||||
nuCustomProgram // program
|
||||
);
|
||||
|
||||
TUnitUsage = (uuIsPartOfProject, uuIsLoaded, uuIsModified, uuNotUsed);
|
||||
|
||||
|
||||
//---------------------------------------------------------------------------
|
||||
// bookmarks of a single file
|
||||
TFileBookmark = class
|
||||
|
||||
@ -40,9 +40,29 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Buttons, StdCtrls, ExtCtrls,
|
||||
Dialogs, LazarusIDEStrConsts, IDEOptionDefs, InputHistory, FileCtrl, AVL_Tree,
|
||||
IDEProcs, EnvironmentOpts, PackageSystem, PackageDefs, ComponentReg;
|
||||
CodeToolManager, IDEDefs, IDEProcs, EnvironmentOpts, PackageSystem,
|
||||
PackageDefs, ComponentReg;
|
||||
|
||||
type
|
||||
TAddToPkgType = (
|
||||
d2ptUnit,
|
||||
d2ptNewComponent,
|
||||
d2ptRequiredPkg
|
||||
);
|
||||
|
||||
TAddToPkgResult = record
|
||||
AddType: TAddToPkgType;
|
||||
Dependency: TPkgDependency;
|
||||
UnitFilename: string;
|
||||
UnitName: string;
|
||||
AncestorType: string;
|
||||
ClassName: string;
|
||||
PageName: string;
|
||||
FileType: TPkgFileType;
|
||||
PkgFileFlags: TPkgFileFlags;
|
||||
UsedUnitname: string;
|
||||
end;
|
||||
|
||||
TAddToPackageDlg = class(TForm)
|
||||
// notebook
|
||||
NoteBook: TNoteBook;
|
||||
@ -63,15 +83,16 @@ type
|
||||
ClassNameEdit: TEdit;
|
||||
PalettePageLabel: TLabel;
|
||||
PalettePageCombobox: TCombobox;
|
||||
ComponentUnitLabel: TLabel;
|
||||
ComponentUnitEdit: TEdit;
|
||||
ComponentUnitButton: TButton;
|
||||
ComponentUnitFileLabel: TLabel;
|
||||
ComponentUnitFileEdit: TEdit;
|
||||
ComponentUnitFileButton: TButton;
|
||||
ComponentUnitNameLabel: TLabel;
|
||||
ComponentUnitNameEdit: TEdit;
|
||||
NewComponentButton: TButton;
|
||||
CancelNewComponentButton: TButton;
|
||||
// new require/conflict
|
||||
// new required package
|
||||
DependPkgNameLabel: TLabel;
|
||||
DependPkgNameComboBox: TComboBox;
|
||||
DependTypeRadioGroup: TRadioGroup;
|
||||
DependMinVersionLabel: TLabel;
|
||||
DependMinVersionEdit: TEdit;
|
||||
DependMaxVersionLabel: TLabel;
|
||||
@ -87,14 +108,16 @@ type
|
||||
procedure CancelAddUnitButtonClick(Sender: TObject);
|
||||
procedure CancelNewComponentButtonClick(Sender: TObject);
|
||||
procedure ClassNameEditChange(Sender: TObject);
|
||||
procedure ComponentUnitButtonClick(Sender: TObject);
|
||||
procedure ComponentUnitFileButtonClick(Sender: TObject);
|
||||
procedure NewComponentButtonClick(Sender: TObject);
|
||||
procedure NewComponentPageResize(Sender: TObject);
|
||||
procedure NewDependButtonClick(Sender: TObject);
|
||||
procedure NewDependPageResize(Sender: TObject);
|
||||
private
|
||||
fLastNewComponentAncestorType: string;
|
||||
fLastNewComponentClassName: string;
|
||||
FLazPackage: TLazPackage;
|
||||
FOnGetIDEFileInfo: TGetIDEFileStateEvent;
|
||||
fPkgComponents: TAVLTree;// tree of TPkgComponent
|
||||
fPackages: TAVLTree;// tree of TLazPackage or TPackageLink
|
||||
procedure SetLazPackage(const AValue: TLazPackage);
|
||||
@ -103,7 +126,10 @@ type
|
||||
procedure OnIteratePackages(APackageID: TLazPackageID);
|
||||
procedure AutoCompleteNewComponent;
|
||||
procedure AutoCompleteNewComponentUnitName;
|
||||
function CheckUnitFilename(AddFileType: TAddToPkgType;
|
||||
var AFilename: string): boolean;
|
||||
public
|
||||
Params: TAddToPkgResult;
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure UpdateAvailableAncestorTypes;
|
||||
@ -111,21 +137,28 @@ type
|
||||
procedure UpdateAvailableDependencyNames;
|
||||
public
|
||||
property LazPackage: TLazPackage read FLazPackage write SetLazPackage;
|
||||
property OnGetIDEFileInfo: TGetIDEFileStateEvent read FOnGetIDEFileInfo
|
||||
write FOnGetIDEFileInfo;
|
||||
end;
|
||||
|
||||
function ShowAddToPackageDlg(Pkg: TLazPackage): TModalResult;
|
||||
function ShowAddToPackageDlg(Pkg: TLazPackage; var Params: TAddToPkgResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent): TModalResult;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
function ShowAddToPackageDlg(Pkg: TLazPackage): TModalResult;
|
||||
function ShowAddToPackageDlg(Pkg: TLazPackage; var Params: TAddToPkgResult;
|
||||
OnGetIDEFileInfo: TGetIDEFileStateEvent): TModalResult;
|
||||
var
|
||||
AddDlg: TAddToPackageDlg;
|
||||
begin
|
||||
AddDlg:=TAddToPackageDlg.Create(Application);
|
||||
AddDlg.LazPackage:=Pkg;
|
||||
AddDlg.OnGetIDEFileInfo:=OnGetIDEFileInfo;
|
||||
Result:=AddDlg.ShowModal;
|
||||
if Result=mrOk then
|
||||
Params:=AddDlg.Params;
|
||||
IDEDialogLayoutList.SaveLayout(AddDlg);
|
||||
AddDlg.Free;
|
||||
end;
|
||||
@ -138,60 +171,15 @@ begin
|
||||
end;
|
||||
|
||||
procedure TAddToPackageDlg.AddUnitButtonClick(Sender: TObject);
|
||||
var
|
||||
AFilename: String;
|
||||
AnUnitName: String;
|
||||
PkgFile: TPkgFile;
|
||||
Msg: String;
|
||||
begin
|
||||
// normalize filename
|
||||
AFilename:=CleanAndExpandFilename(AddUnitFilenameEdit.Text);
|
||||
// check if file exists
|
||||
if not FileExists(AFilename) then begin
|
||||
MessageDlg('File not found',
|
||||
'File "'+AFilename+'" not found.',mtError,[mbCancel],0);
|
||||
exit;
|
||||
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);
|
||||
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 file already exists in package
|
||||
PkgFile:=LazPackage.FindPkgFile(AFilename,true);
|
||||
if PkgFile<>nil then begin
|
||||
Msg:='File "'+AFilename+'" already exists in the project.';
|
||||
if PkgFile.Filename<>AFilename then
|
||||
Msg:=#13+'Existing file: "'+PkgFile.Filename+'"';
|
||||
MessageDlg('File already exists',Msg,mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Params.AddType:=d2ptUnit;
|
||||
|
||||
Params.UnitFilename:=AddUnitFilenameEdit.Text;
|
||||
if not CheckUnitFilename(Params.AddType,Params.UnitFilename) then exit;
|
||||
Params.UnitName:=ExtractFileNameOnly(Params.UnitFilename);
|
||||
Params.FileType:=pftUnit;
|
||||
Params.PkgFileFlags:=[];
|
||||
|
||||
// add it ...
|
||||
ModalResult:=mrOk;
|
||||
end;
|
||||
@ -273,7 +261,7 @@ begin
|
||||
AutoCompleteNewComponentUnitName;
|
||||
end;
|
||||
|
||||
procedure TAddToPackageDlg.ComponentUnitButtonClick(Sender: TObject);
|
||||
procedure TAddToPackageDlg.ComponentUnitFileButtonClick(Sender: TObject);
|
||||
var
|
||||
OpenDialog: TOpenDialog;
|
||||
AFilename: string;
|
||||
@ -287,7 +275,7 @@ begin
|
||||
AFilename:=CleanAndExpandFilename(OpenDialog.Filename);
|
||||
if FilenameIsPascalUnit(AFilename) then begin
|
||||
LazPackage.ShortenFilename(AFilename);
|
||||
ComponentUnitEdit.Text:=AFilename;
|
||||
ComponentUnitFileEdit.Text:=AFilename;
|
||||
end else begin
|
||||
MessageDlg('Invalid file',
|
||||
'A pascal unit must have the extension .pp or .pas',
|
||||
@ -301,9 +289,115 @@ begin
|
||||
end;
|
||||
|
||||
procedure TAddToPackageDlg.NewComponentButtonClick(Sender: TObject);
|
||||
var
|
||||
PkgFile: TPkgFile;
|
||||
PkgComponent: TPkgComponent;
|
||||
ARequiredPackage: TLazPackage;
|
||||
begin
|
||||
// ToDo
|
||||
ShowMessage('Not implemented yet');
|
||||
Params.AddType:=d2ptNewComponent;
|
||||
Params.FileType:=pftUnit;
|
||||
Params.PkgFileFlags:=[pffHasRegisterProc];
|
||||
Params.AncestorType:=AncestorComboBox.Text;
|
||||
Params.ClassName:=ClassNameEdit.Text;
|
||||
Params.PageName:=PalettePageCombobox.Text;
|
||||
Params.UnitName:=ComponentUnitNameEdit.Text;
|
||||
Params.UnitFilename:=ComponentUnitFileEdit.Text;
|
||||
Params.UsedUnitname:='';
|
||||
|
||||
// check Ancestor Type
|
||||
if not IsValidIdent(Params.AncestorType) then begin
|
||||
MessageDlg('Invalid Ancestor Type',
|
||||
'The ancestor type "'+Params.AncestorType+'"'
|
||||
+' is not a valid pascal identifier.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check pagename
|
||||
if length(Params.PageName)>100 then begin
|
||||
MessageDlg('Page Name too long',
|
||||
'The page name "'+Params.PageName+'" is too long (max 100 chars).',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check unitname - filename redundancy
|
||||
if AnsiCompareText(Params.Unitname,ExtractFileNameOnly(Params.UnitFilename))<>0
|
||||
then begin
|
||||
MessageDlg('Unit Name Invalid',
|
||||
'The unit name "'+Params.UnitName+'" does not correspond to the filename.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check classname
|
||||
if not IsValidIdent(Params.ClassName) then begin
|
||||
MessageDlg('Invalid Class Name',
|
||||
'The class name "'+Params.ClassName+'" is not a valid pascal identifier.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check classname<>ancestortype
|
||||
if AnsiCompareText(Params.ClassName,Params.AncestorType)=0 then begin
|
||||
MessageDlg('Invalid Circle',
|
||||
'The class name "'+Params.ClassName+'" and ancestor type "'
|
||||
+Params.AncestorType+'" are the same.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check ancestor type is not unitname
|
||||
PkgFile:=PackageGraph.FindUnit(LazPackage,Params.AncestorType,true);
|
||||
if PkgFile<>nil then begin
|
||||
if MessageDlg('Ambigious Ancestor Type',
|
||||
'The ancestor type "'+Params.AncestorType+'" has the same name as'#13
|
||||
+'the unit "'+PkgFile.Filename+'".',
|
||||
mtError,[mbCancel,mbIgnore],0)<>mrIgnore
|
||||
then
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check classname does not interfere with an existing unitname
|
||||
PkgFile:=PackageGraph.FindUnit(LazPackage,Params.ClassName,true);
|
||||
if PkgFile<>nil then begin
|
||||
if MessageDlg('Ambigious Class Name',
|
||||
'The class name "'+Params.AncestorType+'" has the same name as'#13
|
||||
+'the unit "'+PkgFile.Filename+'".',
|
||||
mtError,[mbCancel,mbIgnore],0)<>mrIgnore
|
||||
then
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check if classname already exists
|
||||
PkgComponent:=
|
||||
TPkgComponent(IDEComponentPalette.FindComponent(Params.Classname));
|
||||
if PkgComponent<>nil then begin
|
||||
if MessageDlg('Class Name already exists',
|
||||
'The class name "'+Params.ClassName+'" exists already in'#13
|
||||
+'Package '+PkgComponent.PkgFile.LazPackage.IDAsString+#13
|
||||
+'File: "'+PkgComponent.PkgFile.Filename+'"',
|
||||
mtError,[mbCancel,mbIgnore],0)<>mrIgnore
|
||||
then
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check filename
|
||||
if not CheckUnitFilename(Params.AddType,Params.UnitFilename) then exit;
|
||||
|
||||
// create dependency if needed
|
||||
PkgComponent:=
|
||||
TPkgComponent(IDEComponentPalette.FindComponent(Params.AncestorType));
|
||||
if PkgComponent<>nil then begin
|
||||
Params.UsedUnitname:=PkgComponent.GetUnitName;
|
||||
ARequiredPackage:=PkgComponent.PkgFile.LazPackage;
|
||||
if (LazPackage<>ARequiredPackage)
|
||||
and (not LazPackage.Requires(PkgComponent.PkgFile.LazPackage))
|
||||
then
|
||||
Params.Dependency:=ARequiredPackage.CreateDependencyForThisPkg;
|
||||
end;
|
||||
|
||||
ModalResult:=mrOk;
|
||||
end;
|
||||
|
||||
procedure TAddToPackageDlg.NewComponentPageResize(Sender: TObject);
|
||||
@ -345,18 +439,27 @@ begin
|
||||
x:=5;
|
||||
inc(y,PalettePageCombobox.Height+5);
|
||||
|
||||
with ComponentUnitLabel do
|
||||
with ComponentUnitFileLabel do
|
||||
SetBounds(x,y+2,100,Height);
|
||||
inc(x,ComponentUnitLabel.Width+5);
|
||||
inc(x,ComponentUnitFileLabel.Width+5);
|
||||
|
||||
with ComponentUnitEdit do
|
||||
with ComponentUnitFileEdit do
|
||||
SetBounds(x,y,Parent.ClientWidth-x-Height-5,Height);
|
||||
inc(x,ComponentUnitEdit.Width+2);
|
||||
inc(x,ComponentUnitFileEdit.Width+2);
|
||||
|
||||
with ComponentUnitButton do
|
||||
SetBounds(x,y,ComponentUnitEdit.Height,ComponentUnitEdit.Height);
|
||||
with ComponentUnitFileButton do
|
||||
SetBounds(x,y,ComponentUnitFileEdit.Height,ComponentUnitFileEdit.Height);
|
||||
x:=5;
|
||||
inc(y,ComponentUnitFileEdit.Height+5);
|
||||
|
||||
with ComponentUnitNameLabel do
|
||||
SetBounds(x,y+2,100,Height);
|
||||
inc(x,ComponentUnitNameLabel.Width+5);
|
||||
|
||||
with ComponentUnitNameEdit do
|
||||
SetBounds(x,y,100,Height);
|
||||
inc(y,ComponentUnitNameEdit.Height+15);
|
||||
x:=5;
|
||||
inc(y,ComponentUnitEdit.Height+15);
|
||||
|
||||
with NewComponentButton do
|
||||
SetBounds(x,y,80,Height);
|
||||
@ -366,6 +469,70 @@ begin
|
||||
SetBounds(x,y,80,Height);
|
||||
end;
|
||||
|
||||
procedure TAddToPackageDlg.NewDependButtonClick(Sender: TObject);
|
||||
var
|
||||
NewDependency: TPkgDependency;
|
||||
NewPckName: String;
|
||||
begin
|
||||
NewDependency:=TPkgDependency.Create;
|
||||
try
|
||||
// check minimum version
|
||||
if DependMinVersionEdit.Text<>'' then begin
|
||||
if not NewDependency.MinVersion.ReadString(DependMinVersionEdit.Text) then
|
||||
begin
|
||||
MessageDlg('Invalid version',
|
||||
'The Minimum Version "'+DependMinVersionEdit.Text+'" is invalid.'#13
|
||||
+'Please use the format major.minor.build.release'#13
|
||||
+'For exmaple: 1.0.20.10',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
NewDependency.Flags:=NewDependency.Flags+[pdfMinVersion];
|
||||
end;
|
||||
// check maximum version
|
||||
if DependMaxVersionEdit.Text<>'' then begin
|
||||
if not NewDependency.MaxVersion.ReadString(DependMaxVersionEdit.Text) then
|
||||
begin
|
||||
MessageDlg('Invalid version',
|
||||
'The Maximum Version "'+DependMaxVersionEdit.Text+'" is invalid.'#13
|
||||
+'Please use the format major.minor.build.release'#13
|
||||
+'For exmaple: 1.0.20.10',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
NewDependency.Flags:=NewDependency.Flags+[pdfMaxVersion];
|
||||
end;
|
||||
// check packagename
|
||||
NewPckName:=DependPkgNameComboBox.Text;
|
||||
if not IsValidIdent(NewPckName) then begin
|
||||
MessageDlg('Invalid packagename',
|
||||
'The packagename "'+NewPckName+'" is invalid.'#13
|
||||
+'Plase choose an existing package.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
NewDependency.PackageName:=NewPckName;
|
||||
if PackageGraph.FindWithDependency(NewDependency,fpfSearchPackageEverywhere)
|
||||
=nil then
|
||||
begin
|
||||
MessageDlg('Package not found',
|
||||
'The packagename "'+DependPkgNameComboBox.Text+'" was not found.'#13
|
||||
+'Please choose an existing package.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// ok
|
||||
Params.Dependency:=NewDependency;
|
||||
NewDependency:=nil;
|
||||
Params.AddType:=d2ptRequiredPkg;
|
||||
|
||||
ModalResult:=mrOk;
|
||||
finally
|
||||
NewDependency.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAddToPackageDlg.NewDependPageResize(Sender: TObject);
|
||||
var
|
||||
x: Integer;
|
||||
@ -381,10 +548,6 @@ begin
|
||||
SetBounds(x+DependPkgNameLabel.Width+5,y,150,Height);
|
||||
inc(y,DependPkgNameComboBox.Height+5);
|
||||
|
||||
with DependTypeRadioGroup do
|
||||
SetBounds(x,y,200,50);
|
||||
inc(y,DependTypeRadioGroup.Height+10);
|
||||
|
||||
with DependMinVersionLabel do
|
||||
SetBounds(x,y+3,170,Height);
|
||||
|
||||
@ -426,7 +589,7 @@ begin
|
||||
AddUnitPage:=Page[0];
|
||||
Pages.Add('New Component');
|
||||
NewComponentPage:=Page[1];
|
||||
Pages.Add('New Require, Conflict');
|
||||
Pages.Add('New Requirement');
|
||||
NewDependPage:=Page[2];
|
||||
PageIndex:=0;
|
||||
Align:=alClient;
|
||||
@ -532,26 +695,40 @@ begin
|
||||
Text:='';
|
||||
end;
|
||||
|
||||
ComponentUnitLabel:=TLabel.Create(Self);
|
||||
with ComponentUnitLabel do begin
|
||||
Name:='ComponentUnitLabel';
|
||||
ComponentUnitFileLabel:=TLabel.Create(Self);
|
||||
with ComponentUnitFileLabel do begin
|
||||
Name:='ComponentUnitFileLabel';
|
||||
Parent:=NewComponentPage;
|
||||
Caption:='Unit File Name:';
|
||||
end;
|
||||
|
||||
ComponentUnitEdit:=TEdit.Create(Self);
|
||||
with ComponentUnitEdit do begin
|
||||
Name:='ComponentUnitEdit';
|
||||
ComponentUnitFileEdit:=TEdit.Create(Self);
|
||||
with ComponentUnitFileEdit do begin
|
||||
Name:='ComponentUnitFileEdit';
|
||||
Parent:=NewComponentPage;
|
||||
Text:='';
|
||||
end;
|
||||
|
||||
ComponentUnitButton:=TButton.Create(Self);
|
||||
with ComponentUnitButton do begin
|
||||
Name:='ComponentUnitButton';
|
||||
ComponentUnitFileButton:=TButton.Create(Self);
|
||||
with ComponentUnitFileButton do begin
|
||||
Name:='ComponentUnitFileButton';
|
||||
Parent:=NewComponentPage;
|
||||
Caption:='...';
|
||||
OnClick:=@ComponentUnitButtonClick;
|
||||
OnClick:=@ComponentUnitFileButtonClick;
|
||||
end;
|
||||
|
||||
ComponentUnitNameLabel:=TLabel.Create(Self);
|
||||
with ComponentUnitNameLabel do begin
|
||||
Name:='ComponentUnitNameLabel';
|
||||
Parent:=NewComponentPage;
|
||||
Caption:='Unit Name:';
|
||||
end;
|
||||
|
||||
ComponentUnitNameEdit:=TEdit.Create(Self);
|
||||
with ComponentUnitNameEdit do begin
|
||||
Name:='ComponentUnitNameEdit';
|
||||
Parent:=NewComponentPage;
|
||||
Text:='';
|
||||
end;
|
||||
|
||||
NewComponentButton:=TButton.Create(Self);
|
||||
@ -571,7 +748,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
// add require, conflict
|
||||
// add require
|
||||
|
||||
DependPkgNameLabel:=TLabel.Create(Self);
|
||||
with DependPkgNameLabel do begin
|
||||
@ -587,17 +764,6 @@ begin
|
||||
Text:='';
|
||||
end;
|
||||
|
||||
DependTypeRadioGroup:=TRadioGroup.Create(Self);
|
||||
with DependTypeRadioGroup do begin
|
||||
Name:='DependTypeRadioGroup';
|
||||
Parent:=NewDependPage;
|
||||
Items.Add('Require');
|
||||
Items.Add('Conflict');
|
||||
ItemIndex:=0;
|
||||
Columns:=2;
|
||||
Caption:='Type';
|
||||
end;
|
||||
|
||||
DependMinVersionLabel:=TLabel.Create(Self);
|
||||
with DependMinVersionLabel do begin
|
||||
Name:='DependMinVersionLabel';
|
||||
@ -631,6 +797,7 @@ begin
|
||||
Name:='NewDependButton';
|
||||
Parent:=NewDependPage;
|
||||
Caption:='Ok';
|
||||
OnClick:=@NewDependButtonClick;
|
||||
end;
|
||||
|
||||
CancelDependButton:=TButton.Create(Self);
|
||||
@ -680,15 +847,21 @@ var
|
||||
NewUnitName: String;
|
||||
NewFileName: String;
|
||||
begin
|
||||
// check if update needed
|
||||
CurClassName:=ClassNameEdit.Text;
|
||||
if fLastNewComponentClassName=CurClassName then exit;
|
||||
fLastNewComponentClassName:=CurClassName;
|
||||
|
||||
// check classname
|
||||
if not IsValidIdent(CurClassName) then exit;
|
||||
|
||||
// create unitname
|
||||
NewUnitName:=CurClassName;
|
||||
if NewUnitName[1]='T' then
|
||||
NewUnitName:=copy(NewUnitName,2,length(NewUnitName)-1);
|
||||
NewUnitName:=PackageGraph.CreateUniqueUnitName(NewUnitName);
|
||||
ComponentUnitNameEdit.Text:=NewUnitName;
|
||||
|
||||
// create filename
|
||||
NewFileName:=NewUnitName;
|
||||
if EnvironmentOptions.PascalFileAutoLowerCase
|
||||
@ -700,7 +873,117 @@ begin
|
||||
// prepend path
|
||||
if LazPackage.HasDirectory then
|
||||
NewFileName:=LazPackage.Directory+NewFileName;
|
||||
ComponentUnitEdit.Text:=NewFileName;
|
||||
ComponentUnitFileEdit.Text:=NewFileName;
|
||||
end;
|
||||
|
||||
function TAddToPackageDlg.CheckUnitFilename(AddFileType: TAddToPkgType;
|
||||
var AFilename: string): boolean;
|
||||
var
|
||||
AnUnitName: String;
|
||||
PkgFile: TPkgFile;
|
||||
Msg: String;
|
||||
IDEFileFlags: TIDEFileStateFlags;
|
||||
begin
|
||||
Result:=false;
|
||||
|
||||
// normalize filename
|
||||
AFilename:=TrimFilename(AFilename);
|
||||
if (not FilenameIsAbsolute(AFilename)) then begin
|
||||
if LazPackage.HasDirectory then
|
||||
AFilename:=LazPackage.Directory+AFilename
|
||||
else begin
|
||||
MessageDlg('Invalid filename',
|
||||
'The filename "'+AFilename+'" is ambigious.'#13
|
||||
+'Please specifiy a filename with full path.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// check if file exists
|
||||
if not FileExists(AFilename) then begin
|
||||
if AddFileType=d2ptUnit then begin
|
||||
MessageDlg('File not found',
|
||||
'File "'+AFilename+'" not found.',mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
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);
|
||||
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;
|
||||
|
||||
// check if file already exists in package
|
||||
PkgFile:=LazPackage.FindPkgFile(AFilename,true);
|
||||
if PkgFile<>nil then begin
|
||||
Msg:='File "'+AFilename+'" already exists in the project.';
|
||||
if PkgFile.Filename<>AFilename then
|
||||
Msg:=#13+'Existing file: "'+PkgFile.Filename+'"';
|
||||
MessageDlg('File already exists',Msg,mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check if file is part of project or marked readonly
|
||||
if Assigned(OnGetIDEFileInfo) then begin
|
||||
IDEFileFlags:=[];
|
||||
OnGetIDEFileInfo(Self,AFilename,[ifsPartOfProject,ifsReadOnly],
|
||||
IDEFileFlags);
|
||||
if (ifsPartOfProject in IDEFileFlags) then begin
|
||||
MessageDlg('File is used',
|
||||
'The file "'+AFilename+'" is part of the current project.'#13
|
||||
+'It is a bad idea to share files between projects and packages.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
if (ifsReadOnly in IDEFileFlags) then begin
|
||||
MessageDlg('File is readonly',
|
||||
'The file "'+AFilename+'" is marked as readonly.',
|
||||
mtError,[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// ok
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
constructor TAddToPackageDlg.Create(TheOwner: TComponent);
|
||||
@ -776,7 +1059,7 @@ begin
|
||||
sl:=TStringList.Create;
|
||||
ANode:=fPackages.FindLowest;
|
||||
while ANode<>nil do begin
|
||||
sl.Add(TLazPackageID(ANode.Data).IDAsString);
|
||||
sl.Add(TLazPackageID(ANode.Data).Name);
|
||||
ANode:=fPackages.FindSuccessor(ANode);
|
||||
end;
|
||||
DependPkgNameComboBox.Items.Assign(sl);
|
||||
|
||||
@ -92,6 +92,7 @@ type
|
||||
function Compare(Version2: TPkgVersion): integer;
|
||||
procedure Assign(Source: TPkgVersion);
|
||||
function AsString: string;
|
||||
function ReadString(const s: string): boolean;
|
||||
procedure SetValues(NewMajor, NewMinor, NewBuild, NewRelease: integer);
|
||||
end;
|
||||
|
||||
@ -240,11 +241,6 @@ type
|
||||
TIterateComponentClassesEvent =
|
||||
procedure(PkgComponent: TPkgComponent) of object;
|
||||
|
||||
TPkgDependencyType = (
|
||||
pdtRequired,
|
||||
pdtConflict
|
||||
);
|
||||
|
||||
TPackageInstallType = (
|
||||
pitNope,
|
||||
pitStatic,
|
||||
@ -258,7 +254,6 @@ type
|
||||
FAutoInstall: TPackageInstallType;
|
||||
FCompilerOptions: TPkgCompilerOptions;
|
||||
FComponents: TList; // TList of TPkgComponent
|
||||
FConflictPkgs: TList; // TList of TPkgDependency
|
||||
FDependingPkgs: TList; // TList of TLazPackage
|
||||
FDescription: string;
|
||||
FDirectory: string;
|
||||
@ -281,8 +276,6 @@ type
|
||||
function GetAutoUpdate: boolean;
|
||||
function GetComponentCount: integer;
|
||||
function GetComponents(Index: integer): TPkgComponent;
|
||||
function GetConflictPkgCount: integer;
|
||||
function GetConflictPkgs(Index: integer): TPkgDependency;
|
||||
function GetDependingPkgCount: integer;
|
||||
function GetDependingPkgs(Index: integer): TLazPackage;
|
||||
function GetFileCount: integer;
|
||||
@ -335,12 +328,12 @@ type
|
||||
NewFileType: TPkgFileType; NewFlags: TPkgFileFlags;
|
||||
CompPriorityCat: TComponentPriorityCategory): TPkgFile;
|
||||
procedure AddRequiredDependency(Dependency: TPkgDependency);
|
||||
procedure AddConflictDependency(Dependency: TPkgDependency);
|
||||
function CreateDependencyForThisPkg: TPkgDependency;
|
||||
function AddComponent(PkgFile: TPkgFile; const Page: string;
|
||||
TheComponentClass: TComponentClass): TPkgComponent;
|
||||
procedure AddPkgComponent(APkgComponent: TPkgComponent);
|
||||
procedure RemovePkgComponent(APkgComponent: TPkgComponent);
|
||||
function Requires(APackage: TLazPackage): boolean;
|
||||
public
|
||||
property Author: string read FAuthor write SetAuthor;
|
||||
property AutoCreated: boolean read FAutoCreated write SetAutoCreated;
|
||||
@ -352,8 +345,6 @@ type
|
||||
read FCompilerOptions;
|
||||
property ComponentCount: integer read GetComponentCount;
|
||||
property Components[Index: integer]: TPkgComponent read GetComponents;
|
||||
property ConflictPkgCount: integer read GetConflictPkgCount;
|
||||
property ConflictPkgs[Index: integer]: TPkgDependency read GetConflictPkgs;
|
||||
property DependingPkgCount: integer read GetDependingPkgCount;
|
||||
property DependingPkgs[Index: integer]: TLazPackage read GetDependingPkgs;
|
||||
property Description: string read FDescription write SetDescription;
|
||||
@ -412,6 +403,7 @@ function LazPackageTypeIdentToType(const s: string): TLazPackageType;
|
||||
procedure SortDependencyList(Dependencies: TList);
|
||||
function CompareLazPackageID(Data1, Data2: Pointer): integer;
|
||||
function CompareNameWithPackage(Key, Data: Pointer): integer;
|
||||
function CompareLazPackageName(Data1, Data2: Pointer): integer;
|
||||
|
||||
|
||||
implementation
|
||||
@ -488,6 +480,16 @@ begin
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
function CompareLazPackageName(Data1, Data2: Pointer): integer;
|
||||
var
|
||||
Pkg1: TLazPackageID;
|
||||
Pkg2: TLazPackageID;
|
||||
begin
|
||||
Pkg1:=TLazPackageID(Data1);
|
||||
Pkg2:=TLazPackageID(Data2);
|
||||
Result:=AnsiCompareText(Pkg1.Name,Pkg2.Name);
|
||||
end;
|
||||
|
||||
{ TPkgFile }
|
||||
|
||||
procedure TPkgFile.SetFilename(const AValue: string);
|
||||
@ -824,6 +826,40 @@ begin
|
||||
+IntToStr(Release);
|
||||
end;
|
||||
|
||||
function TPkgVersion.ReadString(const s: string): boolean;
|
||||
var
|
||||
ints: array[1..4] of integer;
|
||||
i: integer;
|
||||
CurPos: Integer;
|
||||
StartPos: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
for i:=Low(ints) to High(ints) do begin
|
||||
// read int
|
||||
StartPos:=1;
|
||||
CurPos:=StartPos;
|
||||
ints[i]:=0;
|
||||
while (CurPos<=length(s)) and (s[CurPos] in ['0'..'9']) do begin
|
||||
ints[i]:=ints[i]*10+ord(s[CurPos])-ord('0');
|
||||
inc(CurPos);
|
||||
end;
|
||||
if (StartPos=CurPos) then exit;
|
||||
// read point
|
||||
if (CurPos>length(s)) then begin
|
||||
if i<High(ints) then exit;
|
||||
end else begin
|
||||
if s[CurPos]<>'.' then exit;
|
||||
inc(CurPos);
|
||||
end;
|
||||
end;
|
||||
Major:=ints[1];
|
||||
Minor:=ints[2];
|
||||
Build:=ints[3];
|
||||
Release:=ints[4];
|
||||
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TPkgVersion.SetValues(NewMajor, NewMinor, NewBuild,
|
||||
NewRelease: integer);
|
||||
begin
|
||||
@ -855,16 +891,6 @@ begin
|
||||
Result:=TPkgComponent(FComponents[Index]);
|
||||
end;
|
||||
|
||||
function TLazPackage.GetConflictPkgCount: integer;
|
||||
begin
|
||||
Result:=FConflictPkgs.Count;
|
||||
end;
|
||||
|
||||
function TLazPackage.GetConflictPkgs(Index: integer): TPkgDependency;
|
||||
begin
|
||||
Result:=TPkgDependency(FConflictPkgs[Index]);
|
||||
end;
|
||||
|
||||
function TLazPackage.GetDependingPkgCount: integer;
|
||||
begin
|
||||
Result:=FDependingPkgs.Count;
|
||||
@ -1048,7 +1074,6 @@ end;
|
||||
constructor TLazPackage.Create;
|
||||
begin
|
||||
FVersion:=TPkgVersion.Create;
|
||||
FConflictPkgs:=TList.Create;
|
||||
FComponents:=TList.Create;
|
||||
FDependingPkgs:=Tlist.Create;
|
||||
FRequiredPkgs:=TList.Create;
|
||||
@ -1066,7 +1091,6 @@ begin
|
||||
FreeAndNil(FFiles);
|
||||
FreeAndNil(FComponents);
|
||||
FreeAndNil(FCompilerOptions);
|
||||
FreeAndNil(FConflictPkgs);
|
||||
FreeAndNil(FDependingPkgs);
|
||||
FreeAndNil(FUsedPkgs);
|
||||
FreeAndNil(FRequiredPkgs);
|
||||
@ -1081,8 +1105,6 @@ var
|
||||
begin
|
||||
FAuthor:='';
|
||||
FAutoInstall:=pitNope;
|
||||
for i:=FConflictPkgs.Count-1 downto 0 do ConflictPkgs[i].Free;
|
||||
FConflictPkgs.Clear;
|
||||
for i:=FComponents.Count-1 downto 0 do Components[i].Free;
|
||||
FComponents.Clear;
|
||||
FCompilerOptions.Clear;
|
||||
@ -1171,7 +1193,6 @@ begin
|
||||
Clear;
|
||||
LockModified;
|
||||
FAuthor:=XMLConfig.GetValue(Path+'Author/Value','');
|
||||
LoadPkgDependencyList(Path+'ConflictPkgs/',FConflictPkgs);
|
||||
FCompilerOptions.LoadFromXMLConfig(XMLConfig,Path+'CompilerOptions/');
|
||||
FDescription:=XMLConfig.GetValue(Path+'Description','');
|
||||
FVersion.LoadFromXMLConfig(XMLConfig,Path+'Version/',FileVersion);
|
||||
@ -1223,7 +1244,6 @@ procedure TLazPackage.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string
|
||||
|
||||
begin
|
||||
XMLConfig.SetDeleteValue(Path+'Author/Value',FAuthor,'');
|
||||
SavePkgDependencyList(Path+'ConflictPkgs/',FConflictPkgs);
|
||||
FCompilerOptions.SaveToXMLConfig(XMLConfig,Path+'CompilerOptions/');
|
||||
XMLConfig.SetDeleteValue(Path+'Description',FDescription,'');
|
||||
FVersion.SaveToXMLConfig(XMLConfig,Path+'Version/');
|
||||
@ -1298,7 +1318,6 @@ begin
|
||||
CheckList(FUsedPkgs,true,true,true);
|
||||
CheckList(FDependingPkgs,true,true,true);
|
||||
CheckList(FRequiredPkgs,true,true,true);
|
||||
CheckList(FConflictPkgs,true,true,true);
|
||||
CheckList(FFiles,true,true,true);
|
||||
CheckList(FComponents,true,true,true);
|
||||
CheckEmptyListCut(FDependingPkgs,FUsedPkgs);
|
||||
@ -1369,11 +1388,6 @@ begin
|
||||
FRequiredPkgs.Add(Dependency);
|
||||
end;
|
||||
|
||||
procedure TLazPackage.AddConflictDependency(Dependency: TPkgDependency);
|
||||
begin
|
||||
FConflictPkgs.Add(Dependency);
|
||||
end;
|
||||
|
||||
function TLazPackage.CreateDependencyForThisPkg: TPkgDependency;
|
||||
begin
|
||||
Result:=TPkgDependency.Create;
|
||||
@ -1400,6 +1414,21 @@ begin
|
||||
FComponents.Remove(APkgComponent);
|
||||
end;
|
||||
|
||||
function TLazPackage.Requires(APackage: TLazPackage): boolean;
|
||||
var
|
||||
Cnt: Integer;
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
Cnt:=RequiredPkgCount;
|
||||
for i:=0 to Cnt-1 do begin
|
||||
if RequiredPkgs[i].IsCompatible(APackage) then begin
|
||||
Result:=true;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TPkgComponent }
|
||||
|
||||
procedure TPkgComponent.SetPkgFile(const AValue: TPkgFile);
|
||||
|
||||
@ -40,13 +40,16 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls, ComCtrls, Buttons,
|
||||
LResources, Graphics, LCLType, Menus, LazarusIDEStrConsts, IDEOptionDefs,
|
||||
PackageDefs, AddToPackageDlg, PackageSystem;
|
||||
IDEDefs, ComponentReg, PackageDefs, AddToPackageDlg, PackageSystem;
|
||||
|
||||
type
|
||||
TOnOpenFile =
|
||||
function(Sender: TObject; const Filename: string): TModalResult of Object;
|
||||
TOnOpenPackage =
|
||||
function(Sender: TObject; APackage: TLazPackage): TModalResult of Object;
|
||||
TOnCreateNewPkgFile =
|
||||
function(Sender: TObject;
|
||||
const Params: TAddToPkgResult): TModalResult of object;
|
||||
|
||||
{ TPackageEditorForm }
|
||||
|
||||
@ -78,7 +81,6 @@ type
|
||||
FLazPackage: TLazPackage;
|
||||
FilesNode: TTreeNode;
|
||||
RequiredPackagesNode: TTreeNode;
|
||||
ConflictPackagesNode: TTreeNode;
|
||||
FPlugins: TStringList;
|
||||
procedure SetLazPackage(const AValue: TLazPackage);
|
||||
procedure SetupComponents;
|
||||
@ -87,7 +89,6 @@ type
|
||||
procedure UpdateButtons;
|
||||
procedure UpdateFiles;
|
||||
procedure UpdateRequiredPkgs;
|
||||
procedure UpdateConflictPkgs;
|
||||
procedure UpdateSelectedFile;
|
||||
procedure UpdateStatusBar;
|
||||
public
|
||||
@ -103,6 +104,8 @@ type
|
||||
TPackageEditors = class
|
||||
private
|
||||
FItems: TList; // list of TPackageEditorForm
|
||||
FOnCreateNewFile: TOnCreateNewPkgFile;
|
||||
FOnGetIDEFileInfo: TGetIDEFileStateEvent;
|
||||
FOnOpenFile: TOnOpenFile;
|
||||
FOnOpenPackage: TOnOpenPackage;
|
||||
function GetEditors(Index: integer): TPackageEditorForm;
|
||||
@ -118,10 +121,16 @@ type
|
||||
function OpenFile(Sender: TObject; const Filename: string): TModalResult;
|
||||
function OpenDependency(Sender: TObject;
|
||||
Dependency: TPkgDependency): TModalResult;
|
||||
function CreateNewFile(Sender: TObject;
|
||||
const Params: TAddToPkgResult): TModalResult;
|
||||
public
|
||||
property Editors[Index: integer]: TPackageEditorForm read GetEditors;
|
||||
property OnCreateNewFile: TOnCreateNewPkgFile read FOnCreateNewFile
|
||||
write FOnCreateNewFile;
|
||||
property OnOpenFile: TOnOpenFile read FOnOpenFile write FOnOpenFile;
|
||||
property OnOpenPackage: TOnOpenPackage read FOnOpenPackage write FOnOpenPackage;
|
||||
property OnGetIDEFileInfo: TGetIDEFileStateEvent read FOnGetIDEFileInfo
|
||||
write FOnGetIDEFileInfo;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -199,8 +208,7 @@ begin
|
||||
if CurNode<>nil then begin
|
||||
if CurNode.Parent=FilesNode then begin
|
||||
AddPopupMenuItem('Open file',@OpenFileMenuItemClick);
|
||||
end else if (CurNode.Parent=RequiredPackagesNode)
|
||||
or (CurNode.Parent=ConflictPackagesNode) then begin
|
||||
end else if (CurNode.Parent=RequiredPackagesNode) then begin
|
||||
AddPopupMenuItem('Open package',@OpenFileMenuItemClick);
|
||||
end;
|
||||
end else begin
|
||||
@ -292,8 +300,44 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.AddBitBtnClick(Sender: TObject);
|
||||
var
|
||||
AddParams: TAddToPkgResult;
|
||||
begin
|
||||
if ShowAddToPackageDlg(LazPackage)<>mrOk then exit;
|
||||
if ShowAddToPackageDlg(LazPackage,AddParams,PackageEditors.OnGetIDEFileInfo)
|
||||
<>mrOk
|
||||
then
|
||||
exit;
|
||||
|
||||
case AddParams.AddType of
|
||||
d2ptUnit:
|
||||
begin
|
||||
with AddParams do
|
||||
LazPackage.AddFile(UnitFilename,UnitName,FileType,PkgFileFlags,cpNormal);
|
||||
UpdateFiles;
|
||||
end;
|
||||
|
||||
d2ptNewComponent:
|
||||
begin
|
||||
// add file
|
||||
with AddParams do
|
||||
LazPackage.AddFile(UnitFilename,UnitName,FileType,PkgFileFlags,cpNormal);
|
||||
UpdateFiles;
|
||||
// add dependency
|
||||
if AddParams.Dependency<>nil then begin
|
||||
LazPackage.AddRequiredDependency(AddParams.Dependency);
|
||||
UpdateRequiredPkgs;
|
||||
end;
|
||||
// open file in editor
|
||||
PackageEditors.CreateNewFile(Self,AddParams);
|
||||
end;
|
||||
|
||||
d2ptRequiredPkg:
|
||||
begin
|
||||
LazPackage.AddRequiredDependency(AddParams.Dependency);
|
||||
UpdateRequiredPkgs;
|
||||
end;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.SetLazPackage(const AValue: TLazPackage);
|
||||
@ -409,9 +453,6 @@ begin
|
||||
RequiredPackagesNode:=Items.Add(nil,'Required Packages');
|
||||
RequiredPackagesNode.ImageIndex:=1;
|
||||
RequiredPackagesNode.SelectedIndex:=RequiredPackagesNode.ImageIndex;
|
||||
ConflictPackagesNode:=Items.Add(nil,'Conflict Packages');
|
||||
ConflictPackagesNode.ImageIndex:=2;
|
||||
ConflictPackagesNode.SelectedIndex:=ConflictPackagesNode.ImageIndex;
|
||||
EndUpdate;
|
||||
PopupMenu:=FilesPopupMenu;
|
||||
OnMouseUp:=@FilesTreeViewMouseUp;
|
||||
@ -464,7 +505,6 @@ begin
|
||||
UpdateButtons;
|
||||
UpdateFiles;
|
||||
UpdateRequiredPkgs;
|
||||
UpdateConflictPkgs;
|
||||
UpdateSelectedFile;
|
||||
UpdateStatusBar;
|
||||
FilesTreeView.EndUpdate;
|
||||
@ -518,6 +558,7 @@ begin
|
||||
CurNode.Free;
|
||||
CurNode:=NextNode;
|
||||
end;
|
||||
FilesNode.Expanded:=true;
|
||||
FilesTreeView.EndUpdate;
|
||||
end;
|
||||
|
||||
@ -550,35 +591,6 @@ begin
|
||||
FilesTreeView.EndUpdate;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.UpdateConflictPkgs;
|
||||
var
|
||||
Cnt: Integer;
|
||||
CurNode: TTreeNode;
|
||||
i: Integer;
|
||||
CurDependency: TPkgDependency;
|
||||
NextNode: TTreeNode;
|
||||
begin
|
||||
Cnt:=LazPackage.ConflictPkgCount;
|
||||
FilesTreeView.BeginUpdate;
|
||||
CurNode:=ConflictPackagesNode.GetFirstChild;
|
||||
for i:=0 to Cnt-1 do begin
|
||||
if CurNode=nil then
|
||||
CurNode:=FilesTreeView.Items.AddChild(ConflictPackagesNode,'');
|
||||
CurDependency:=LazPackage.ConflictPkgs[i];
|
||||
CurNode.Text:=CurDependency.AsString;
|
||||
CurNode.ImageIndex:=ConflictPackagesNode.ImageIndex;
|
||||
CurNode.SelectedIndex:=CurNode.ImageIndex;
|
||||
CurNode:=CurNode.GetNextSibling;
|
||||
end;
|
||||
while CurNode<>nil do begin
|
||||
NextNode:=CurNode.GetNextSibling;
|
||||
CurNode.Free;
|
||||
CurNode:=NextNode;
|
||||
end;
|
||||
ConflictPackagesNode.Expanded:=true;
|
||||
FilesTreeView.EndUpdate;
|
||||
end;
|
||||
|
||||
procedure TPackageEditorForm.UpdateSelectedFile;
|
||||
var
|
||||
CurNode: TTreeNode;
|
||||
@ -730,6 +742,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPackageEditors.CreateNewFile(Sender: TObject;
|
||||
const Params: TAddToPkgResult): TModalResult;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
if Assigned(OnCreateNewFile) then
|
||||
Result:=OnCreateNewFile(Sender,Params);
|
||||
end;
|
||||
|
||||
initialization
|
||||
PackageEditors:=nil;
|
||||
|
||||
|
||||
@ -44,13 +44,16 @@ uses
|
||||
{$IFDEF IDE_MEM_CHECK}
|
||||
MemCheck,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, LCLProc, Forms, COntrols, KeyMapping, EnvironmentOpts,
|
||||
UComponentManMain, PackageEditor, PackageDefs, PackageLinks, PackageSystem,
|
||||
ComponentReg, OpenInstalledPkgDlg,
|
||||
Classes, SysUtils, LCLProc, Forms, Controls, CodeToolManager,
|
||||
KeyMapping, EnvironmentOpts, IDEProcs, ProjectDefs, IDEDefs,
|
||||
UComponentManMain, PackageEditor, AddToPackageDlg, PackageDefs, PackageLinks,
|
||||
PackageSystem, ComponentReg, OpenInstalledPkgDlg,
|
||||
BasePkgManager, MainBar;
|
||||
|
||||
type
|
||||
TPkgManager = class(TBasePkgManager)
|
||||
function OnPackageEditorCreateFile(Sender: TObject;
|
||||
const Params: TAddToPkgResult): TModalResult;
|
||||
function OnPackageEditorOpenPackage(Sender: TObject; APackage: TLazPackage
|
||||
): TModalResult;
|
||||
procedure mnuConfigCustomCompsClicked(Sender: TObject);
|
||||
@ -75,6 +78,56 @@ implementation
|
||||
|
||||
{ TPkgManager }
|
||||
|
||||
function TPkgManager.OnPackageEditorCreateFile(Sender: TObject;
|
||||
const Params: TAddToPkgResult): TModalResult;
|
||||
var
|
||||
LE: String;
|
||||
UsesLine: String;
|
||||
NewSource: String;
|
||||
begin
|
||||
Result:=mrCancel;
|
||||
// create sourcecode
|
||||
LE:=EndOfLine;
|
||||
UsesLine:='Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs';
|
||||
if System.Pos(Params.UsedUnitname,UsesLine)<1 then
|
||||
UsesLine:=UsesLine+', '+Params.UsedUnitname;
|
||||
NewSource:=
|
||||
'unit '+Params.UnitName+';'+LE
|
||||
+LE
|
||||
+'{$mode objfpc}{$H+}'+LE
|
||||
+LE
|
||||
+'interface'+LE
|
||||
+LE
|
||||
+'uses'+LE
|
||||
+' '+UsesLine+';'+LE
|
||||
+LE
|
||||
+'type'+LE
|
||||
+' '+Params.ClassName+' = class('+Params.AncestorType+')'+LE
|
||||
+' private'+LE
|
||||
+' { Private declarations }'+LE
|
||||
+' protected'+LE
|
||||
+' { Protected declarations }'+LE
|
||||
+' public'+LE
|
||||
+' { Public declarations }'+LE
|
||||
+' published'+LE
|
||||
+' { Published declarations }'+LE
|
||||
+' end;'+LE
|
||||
+LE
|
||||
+'procedure Register;'+LE
|
||||
+LE
|
||||
+'implementation'+LE
|
||||
+LE
|
||||
+'procedure Register;'+LE
|
||||
+'begin'+LE
|
||||
+' RegisterComponents('''+Params.PageName+''',['+Params.ClassName+']);'+LE
|
||||
+'end;'+LE
|
||||
+LE
|
||||
+'end.'+LE;
|
||||
|
||||
Result:=MainIDE.DoNewEditorFile(nuUnit,Params.UnitFilename,NewSource,
|
||||
[nfOpenInEditor,nfIsNotPartOfProject,nfSave,nfAddToRecent]);
|
||||
end;
|
||||
|
||||
function TPkgManager.OnPackageEditorOpenPackage(Sender: TObject;
|
||||
APackage: TLazPackage): TModalResult;
|
||||
begin
|
||||
@ -103,6 +156,8 @@ begin
|
||||
PackageEditors:=TPackageEditors.Create;
|
||||
PackageEditors.OnOpenFile:=@MainIDE.DoOpenMacroFile;
|
||||
PackageEditors.OnOpenPackage:=@OnPackageEditorOpenPackage;
|
||||
PackageEditors.OnCreateNewFile:=@OnPackageEditorCreateFile;
|
||||
PackageEditors.OnGetIDEFileInfo:=@MainIDE.GetIDEFileState;
|
||||
end;
|
||||
|
||||
destructor TPkgManager.Destroy;
|
||||
@ -136,6 +191,7 @@ procedure TPkgManager.LoadInstalledPackages;
|
||||
begin
|
||||
// base packages
|
||||
PackageGraph.AddStaticBasePackages;
|
||||
|
||||
PackageGraph.RegisterStaticPackages;
|
||||
// custom packages
|
||||
// ToDo
|
||||
|
||||
Loading…
Reference in New Issue
Block a user