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

implemented searching packages

Browse Source 
git-svn-id: trunk@4018 -
This commit is contained in:
mattias 2003-04-06 22:39:47 +00:00
parent d236710880
commit 3fe22d290e
8 changed files with 291 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
ide/mainbar.pas
View File

@ -92,7 +92,8 @@ type
ofQuiet, // less messages
ofAddToRecent, // add file to recent files
ofRegularFile, // open as regular file (e.g. not a whole project)
ofVirtualFile // open the virtual file
ofVirtualFile, // open the virtual file
ofConvertMacros // replace macros in filename
);
TOpenFlags = set of TOpenFlag;
@ -334,6 +335,8 @@ type
function DoOpenEditorFile(AFileName:string; PageIndex: integer;
Flags: TOpenFlags): TModalResult; virtual; abstract;
function DoInitProjectRun: TModalResult; virtual; abstract;
function DoOpenMacroFile(Sender: TObject;
const AFilename: string): TModalResult; virtual;
function DoCheckFilesOnDisk: TModalResult; virtual; abstract;
function DoCheckAmbigiousSources(const AFilename: string;
@ -358,7 +361,8 @@ const
'ofQuiet',
'ofAddToRecent',
'ofRegularFile',
'ofVirtualFile'
'ofVirtualFile',
'ofConvertMacros'
);
SaveFlagNames: array[TSaveFlag] of string = (
@ -1289,6 +1293,13 @@ begin
end;
end;
function TMainIDEBar.DoOpenMacroFile(Sender: TObject; const AFilename: string
): TModalResult;
begin
Result:=DoOpenEditorFile(AFilename,-1,
[ofOnlyIfExists,ofAddToRecent,ofRegularFile,ofConvertMacros]);
end;
{-------------------------------------------------------------------------------
function TMainIDEBar.DoCheckAmbigiousSources(const AFilename: string
): TModalResult;

4
lcl/include/popupmenu.inc
View File

@ -44,6 +44,7 @@ Procedure TPopupMenu.PopUp(X,Y : Integer);
begin
FPopupPoint := Point(X, Y);
DoPopup(Self);
if Items.Count=0 then exit;
HandleNeeded;
SendMsgToInterface(LM_POPUPSHOW, Self, @FPopupPoint);
end;
@ -51,6 +52,9 @@ end;
{
$Log$
Revision 1.7 2003/04/06 22:39:47 mattias
implemented searching packages
Revision 1.6 2002/10/26 15:15:48 lazarus
MG: broke LCL<->interface circles

6
lcl/include/treeview.inc
View File

@ -4208,8 +4208,14 @@ begin
// ToDo: insert clipboard text into node text
// :=PrimarySelection.AsText;
end;
end else if Button=mbRight then begin
if RightClickSelect then begin
Selected:=GetNodeAt(X,Y);
end;
end;
inherited MouseDown(Button, Shift, X, Y);
CursorNode:=GetNodeAt(X,Y);
bStartDrag := false;
if ([ssDouble,ssTriple,ssQuad]*Shift)=[] then begin

15
packager/packagedefs.pas
View File

@ -305,7 +305,7 @@ type
procedure CheckInnerDependencies;
function Compare(Package2: TLazPackage): integer;
procedure ShortenFilename(var ExpandedFilename: string);
procedure LongenFilename(var ExpandedFilename: string);
procedure LongenFilename(var AFilename: string);
procedure IterateComponentClasses(Event: TIterateComponentClassesEvent;
WithRequiredPackages: boolean);
procedure ConsistencyCheck;
@ -477,6 +477,7 @@ var
begin
NewFilename:=AValue;
DoDirSeparators(NewFilename);
LazPackage.LongenFilename(NewFilename);
if FFilename=NewFilename then exit;
FFilename:=NewFilename;
UpdateUnitName;
@ -1215,8 +1216,8 @@ var
PkgDir: String;
CurPath: String;
begin
if IsVirtual then exit;
PkgDir:=Directory;
PkgDir:=FDirectory;
if (PkgDir='') and (PkgDir[length(PkgDir)]<>PathDelim) then exit;
CurPath:=copy(ExtractFilePath(ExpandedFilename),1,length(PkgDir));
if CompareFilenames(PkgDir,CurPath)=0 then begin
ExpandedFilename:=copy(ExpandedFilename,length(CurPath)+1,
@ -1224,11 +1225,11 @@ begin
end;
end;
procedure TLazPackage.LongenFilename(var ExpandedFilename: string);
procedure TLazPackage.LongenFilename(var AFilename: string);
begin
if IsVirtual then exit;
if not FilenameIsAbsolute(ExpandedFilename) then
ExpandedFilename:=TrimFilename(Directory+ExpandedFilename);
if (FDirectory='') and (FDirectory[length(FDirectory)]<>PathDelim) then exit;
if not FilenameIsAbsolute(AFilename) then
AFilename:=TrimFilename(Directory+AFilename);
end;
procedure TLazPackage.IterateComponentClasses(

105
packager/packageeditor.pas
View File

@ -39,10 +39,15 @@ interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls, ComCtrls, Buttons,
LResources, Graphics, LCLType,
LazarusIDEStrConsts, IDEOptionDefs, PackageDefs, AddToPackageDlg;
LResources, Graphics, LCLType, Menus, LazarusIDEStrConsts, IDEOptionDefs,
PackageDefs, AddToPackageDlg, PackageSystem;
type
TOnOpenFile =
function(Sender: TObject; const Filename: string): TModalResult of Object;
TOnOpenPackage =
function(Sender: TObject; APackage: TLazPackage): TModalResult of Object;
{ TPackageEditorForm }
TPackageEditorForm = class(TBasePackageEditor)
@ -58,10 +63,13 @@ type
RegisteredListBox: TListBox;
StatusBar: TStatusBar;
ImageList: TImageList;
FilesPopupMenu: TPopupMenu;
procedure AddBitBtnClick(Sender: TObject);
procedure FilePropsGroupBoxResize(Sender: TObject);
procedure FilesTreeViewMouseUp(Sender: TOBject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FilesPopupMenuPopup(Sender: TObject);
procedure OpenFileMenuItemClick(Sender: TObject);
procedure PackageEditorFormResize(Sender: TObject);
procedure RegisteredListBoxDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
@ -94,6 +102,8 @@ type
TPackageEditors = class
private
FItems: TList; // list of TPackageEditorForm
FOnOpenFile: TOnOpenFile;
FOnOpenPackage: TOnOpenPackage;
function GetEditors(Index: integer): TPackageEditorForm;
public
constructor Create;
@ -104,8 +114,13 @@ type
function IndexOfPackage(Pkg: TLazPackage): integer;
function FindEditor(Pkg: TLazPackage): TPackageEditorForm;
function OpenEditor(Pkg: TLazPackage): TPackageEditorForm;
function OpenFile(Sender: TObject; const Filename: string): TModalResult;
function OpenDependency(Sender: TObject;
Dependency: TPkgDependency): TModalResult;
public
property Editors[Index: integer]: TPackageEditorForm read GetEditors;
property OnOpenFile: TOnOpenFile read FOnOpenFile write FOnOpenFile;
property OnOpenPackage: TOnOpenPackage read FOnOpenPackage write FOnOpenPackage;
end;
var
@ -155,6 +170,61 @@ begin
FilePropsGroupBox.SetBounds(x,y,w,h);
end;
procedure TPackageEditorForm.FilesPopupMenuPopup(Sender: TObject);
var
CurNode: TTreeNode;
ItemCnt: Integer;
procedure AddPopupMenuItem(const ACaption: string; AnEvent: TNotifyEvent);
var
CurMenuItem: TMenuItem;
begin
if FilesPopupMenu.Items.Count<=ItemCnt then begin
CurMenuItem:=TMenuItem.Create(Self);
FilesPopupMenu.Items.Add(CurMenuItem);
end else
CurMenuItem:=FilesPopupMenu.Items[FilesPopupMenu.Items.Count-1];
CurMenuItem.Caption:=ACaption;
CurMenuItem.OnClick:=AnEvent;
inc(ItemCnt);
end;
begin
CurNode:=FilesTreeView.Selected;
ItemCnt:=0;
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
AddPopupMenuItem('Open package',@OpenFileMenuItemClick);
end;
end else begin
end;
while FilesPopupMenu.Items.Count>ItemCnt do
FilesPopupMenu.Items.Delete(FilesPopupMenu.Items.Count-1);
end;
procedure TPackageEditorForm.OpenFileMenuItemClick(Sender: TObject);
var
CurNode: TTreeNode;
NodeIndex: Integer;
CurFile: TPkgFile;
CurDependency: TPkgDependency;
begin
CurNode:=FilesTreeView.Selected;
if CurNode=nil then exit;
NodeIndex:=CurNode.Index;
if CurNode.Parent=FilesNode then begin
CurFile:=LazPackage.Files[NodeIndex];
PackageEditors.OpenFile(Self,CurFile.Filename);
end else if CurNode.Parent=RequiredPackagesNode then begin
CurDependency:=LazPackage.RequiredPkgs[NodeIndex];
PackageEditors.OpenDependency(Self,CurDependency);
end;
end;
procedure TPackageEditorForm.RegisteredListBoxDrawItem(Control: TWinControl;
Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
@ -273,7 +343,7 @@ begin
AddResImg('pkg_text');
AddResImg('pkg_binary');
end;
CompileBitBtn:=TBitBtn.Create(Self);
with CompileBitBtn do begin
Name:='CompileBitBtn';
@ -312,6 +382,11 @@ begin
Caption:='Options';
end;
FilesPopupMenu:=TPopupMenu.Create(Self);
with FilesPopupMenu do begin
OnPopup:=@FilesPopupMenuPopup;
end;
FilesTreeView:=TTreeView.Create(Self);
with FilesTreeView do begin
Name:='FilesTreeView';
@ -328,7 +403,9 @@ begin
ConflictPackagesNode.ImageIndex:=2;
ConflictPackagesNode.SelectedIndex:=ConflictPackagesNode.ImageIndex;
EndUpdate;
PopupMenu:=FilesPopupMenu;
OnMouseUp:=@FilesTreeViewMouseUp;
Options:=Options+[tvoRightClickSelect];
end;
FilePropsGroupBox:=TGroupBox.Create(Self);
@ -619,6 +696,28 @@ begin
end;
end;
function TPackageEditors.OpenFile(Sender: TObject; const Filename: string
): TModalResult;
begin
if Assigned(OnOpenFile) then
Result:=OnOpenFile(Sender,Filename)
else
Result:=mrCancel;
end;
function TPackageEditors.OpenDependency(Sender: TObject;
Dependency: TPkgDependency): TModalResult;
var
APackage: TLazPackage;
begin
Result:=mrCancel;
if PackageGraph.OpenDependency(Dependency,
fpfSearchPackageEverywhere,APackage)=lprSuccess then
begin
if Assigned(OnOpenPackage) then Result:=OnOpenPackage(Sender,APackage);
end;
end;
initialization
PackageEditors:=nil;

72
packager/packagelinks.pas
View File

@ -73,13 +73,25 @@ type
{ TPackageLinks }
TPkgLinksState = (
plsUserLinksNeedUpdate,
plsGlobalLinksNeedUpdate
);
TPkgLinksStates = set of TPkgLinksState;
TPackageLinks = class
private
FGlobalLinks: TAVLTree; // tree of TPackageLink
FUserLinks: TAVLTree; // tree of TPackageLink
fUpdateLock: integer;
FStates: TPkgLinksStates;
function FindLeftMostNode(LinkTree: TAVLTree;
const PkgName: string): TAVLTreeNode;
function FindLinkWithPkgNameInTree(LinkTree: TAVLTree;
const PkgName: string): TPackageLink;
function FindLinkWithDependencyInTree(LinkTree: TAVLTree;
Dependency: TPkgDependency): TPackageLink;
public
constructor Create;
destructor Destroy; override;
@ -87,14 +99,14 @@ type
procedure UpdateGlobalLinks;
procedure UpdateUserLinks;
procedure UpdateAll;
function FindPkgFileName(LinkTree: TAVLTree;
const PkgName: string): TPackageLink;
function FindPkgFilename(LinkTree: TAVLTree;
Dependency: TPkgDependency): TPackageLink;
function FindPkgFileName(const PkgName: string): TPackageLink;
function FindPkgFilename(Dependency: TPkgDependency): TPackageLink;
procedure BeginUpdate;
procedure EndUpdate;
function FindLinkWithPkgName(const PkgName: string): TPackageLink;
function FindLinkWithDependency(Dependency: TPkgDependency): TPackageLink;
end;
var
PkgLinks: TPackageLinks;
implementation
@ -211,6 +223,7 @@ procedure TPackageLinks.Clear;
begin
FGlobalLinks.FreeAndClear;
FUserLinks.FreeAndClear;
FStates:=[plsUserLinksNeedUpdate,plsGlobalLinksNeedUpdate];
end;
procedure TPackageLinks.UpdateGlobalLinks;
@ -271,6 +284,12 @@ var
CurFilename: String;
NewFilename: string;
begin
if fUpdateLock>0 then begin
Include(FStates,plsGlobalLinksNeedUpdate);
exit;
end;
Exclude(FStates,plsGlobalLinksNeedUpdate);
FGlobalLinks.FreeAndClear;
GlobalLinksDir:=AppendPathDelim(EnvironmentOptions.LazarusDirectory)
+'packager'+PathDelim+'globallinks'+PathDelim;
@ -300,6 +319,7 @@ begin
sl.Free;
NewPkgLink:=TPackageLink.Create;
NewPkgLink.Origin:=ploGlobal;
NewPkgLink.PkgName:=NewPkgName;
NewPkgLink.Version.Assign(PkgVersion);
NewPkgLink.Filename:=NewFilename;
@ -325,6 +345,12 @@ var
NewPkgLink: TPackageLink;
ItemPath: String;
begin
if fUpdateLock>0 then begin
Include(FStates,plsUserLinksNeedUpdate);
exit;
end;
Exclude(FStates,plsUserLinksNeedUpdate);
FUserLinks.FreeAndClear;
ConfigFilename:=AppendPathDelim(GetPrimaryConfigPath)+'packagefiles.xml';
XMLConfig:=nil;
@ -336,6 +362,7 @@ begin
for i:=0 to LinkCount-1 do begin
ItemPath:=Path+'Item'+IntToStr(i)+'/';
NewPkgLink:=TPackageLink.Create;
NewPkgLink.Origin:=ploUser;
NewPkgLink.PkgName:=XMLConfig.GetValue(ItemPath+'PkgName/Value','');
NewPkgLink.Version.LoadFromXMLConfig(XMLConfig,ItemPath+'Version/',
LazPkgXMLFileVersion);
@ -361,7 +388,20 @@ begin
UpdateUserLinks;
end;
function TPackageLinks.FindPkgFileName(LinkTree: TAVLTree;
procedure TPackageLinks.BeginUpdate;
begin
inc(fUpdateLock);
end;
procedure TPackageLinks.EndUpdate;
begin
if fUpdateLock<=0 then RaiseException('TPackageLinks.EndUpdate');
dec(fUpdateLock);
if (plsGlobalLinksNeedUpdate in FStates) then UpdateGlobalLinks;
if (plsUserLinksNeedUpdate in FStates) then UpdateUserLinks;
end;
function TPackageLinks.FindLinkWithPkgNameInTree(LinkTree: TAVLTree;
const PkgName: string): TPackageLink;
// find left most link with PkgName
var
@ -374,7 +414,7 @@ begin
Result:=TPackageLink(CurNode.Data);
end;
function TPackageLinks.FindPkgFilename(LinkTree: TAVLTree;
function TPackageLinks.FindLinkWithDependencyInTree(LinkTree: TAVLTree;
Dependency: TPkgDependency): TPackageLink;
var
Link: TPackageLink;
@ -399,20 +439,24 @@ begin
end;
end;
function TPackageLinks.FindPkgFileName(const PkgName: string): TPackageLink;
function TPackageLinks.FindLinkWithPkgName(const PkgName: string): TPackageLink;
begin
Result:=FindPkgFileName(FUserLinks,PkgName);
Result:=FindLinkWithPkgNameInTree(FUserLinks,PkgName);
if Result=nil then
Result:=FindPkgFileName(FGlobalLinks,PkgName);
Result:=FindLinkWithPkgNameInTree(FGlobalLinks,PkgName);
end;
function TPackageLinks.FindPkgFilename(Dependency: TPkgDependency
function TPackageLinks.FindLinkWithDependency(Dependency: TPkgDependency
): TPackageLink;
begin
Result:=FindPkgFileName(FUserLinks,Dependency);
Result:=FindLinkWithDependencyInTree(FUserLinks,Dependency);
if Result=nil then
Result:=FindPkgFileName(FGlobalLinks,Dependency);
Result:=FindLinkWithDependencyInTree(FGlobalLinks,Dependency);
end;
initialization
PkgLinks:=nil;
end.

87
packager/packagesystem.pas
View File

@ -42,6 +42,28 @@ uses
LazarusIDEStrConsts, IDEProcs, PackageLinks, PackageDefs, LazarusPackageIntf,
ComponentReg, RegisterLCL, RegisterFCL;
type
TLoadPackageResult = (
lprUndefined,
lprSuccess,
lprNotFound,
lprLoadError
);
TFindPackageFlag = (
fpfSearchInInstalledPckgs,
fpfSearchInAutoInstallPckgs,
fpfSearchInPckgsWithEditor,
fpfSearchInPkgLinks,
fpfIgnoreVersion
);
TFindPackageFlags = set of TFindPackageFlag;
const
fpfSearchPackageEverywhere =
[fpfSearchInInstalledPckgs,fpfSearchInAutoInstallPckgs,
fpfSearchInPckgsWithEditor,fpfSearchInPkgLinks];
type
TLazPackageGraph = class
private
@ -67,6 +89,8 @@ type
function Count: integer;
function FindLeftMostByName(const PkgName: string): TAVLTreeNode;
function FindNextSameName(ANode: TAVLTreeNode): TAVLTreeNode;
function FindWithDependency(Dependency: TPkgDependency;
Flags: TFindPackageFlags): TAVLTreeNode;
function PackageNameExists(const PkgName: string;
IgnorePackage: TLazPackage): boolean;
function CreateUniquePkgName(const Prefix: string;
@ -81,6 +105,8 @@ type
procedure AddPackage(APackage: TLazPackage);
procedure AddStaticBasePackages;
procedure RegisterStaticPackages;
function OpenDependency(Dependency: TPkgDependency;
Flags: TFindPackageFlags; var APackage: TLazPackage): TLoadPackageResult;
public
property Packages[Index: integer]: TLazPackage read GetPackages; default;
property RegistrationPackage: TLazPackage read FRegistrationPackage
@ -202,6 +228,34 @@ begin
Result:=NextNode;
end;
function TLazPackageGraph.FindWithDependency(Dependency: TPkgDependency;
Flags: TFindPackageFlags): TAVLTreeNode;
var
CurPkg: TLazPackage;
begin
// search in all packages with the same name
Result:=FindLeftMostByName(Dependency.PackageName);
while Result<>nil do begin
CurPkg:=TLazPackage(Result.Data);
// check version
if (not (fpfIgnoreVersion in Flags))
and (not Dependency.IsCompatible(CurPkg)) then begin
Result:=FindNextSameName(Result);
continue;
end;
// check installed packages
if (fpfSearchInInstalledPckgs in Flags)
and (CurPkg.Installed<>pitNope) then exit;
// check autoinstall packages
if (fpfSearchInAutoInstallPckgs in Flags)
and (CurPkg.AutoInstall<>pitNope) then exit;
// check packages with opened editor
if (fpfSearchInPckgsWithEditor in Flags) and (CurPkg.Editor<>nil) then exit;
// search next package node with same name
Result:=FindNextSameName(Result);
end;
end;
function TLazPackageGraph.PackageNameExists(const PkgName: string;
IgnorePackage: TLazPackage): boolean;
var
@ -385,7 +439,7 @@ begin
AutoCreated:=true;
Name:='FCL';
Title:='FreePascal Component Library';
Filename:='$(#FPCSrcDir)/fcl/';
Filename:='$(FPCSrcDir)/fcl/';
Version.SetValues(1,0,1,1);
Author:='FPC team';
AutoInstall:=pitStatic;
@ -409,7 +463,7 @@ begin
AutoCreated:=true;
Name:='LCL';
Title:='Lazarus Component Library';
Filename:='$(#LazarusDir)/lcl/';
Filename:='$(LazarusDir)/lcl/';
Version.SetValues(1,0,1,1);
Author:='Lazarus';
AutoInstall:=pitStatic;
@ -471,6 +525,35 @@ begin
RegistrationPackage:=nil;
end;
function TLazPackageGraph.OpenDependency(Dependency: TPkgDependency;
Flags: TFindPackageFlags; var APackage: TLazPackage): TLoadPackageResult;
var
ANode: TAVLTreeNode;
PkgLink: TPackageLink;
begin
Result:=lprUndefined;
// search in opened packages
ANode:=FindWithDependency(Dependency,Flags);
if (ANode=nil) then begin
// package not yet open
if (fpfSearchInPkgLinks in Flags) then begin
PkgLinks.UpdateAll;
PkgLink:=PkgLinks.FindLinkWithDependency(Dependency);
if PkgLink<>nil then begin
// ToDo
end;
end;
end;
if ANode<>nil then begin
APackage:=TLazPackage(ANode.Data);
Result:=lprSuccess;
end else begin
Result:=lprSuccess;
end;
end;
initialization
PackageGraph:=nil;

15
packager/pkgmanager.pas
View File

@ -51,6 +51,8 @@ uses
type
TPkgManager = class(TBasePkgManager)
function OnPackageEditorOpenPackage(Sender: TObject; APackage: TLazPackage
): TModalResult;
procedure mnuConfigCustomCompsClicked(Sender: TObject);
procedure mnuOpenInstalledPckClicked(Sender: TObject);
public
@ -73,6 +75,12 @@ implementation
{ TPkgManager }
function TPkgManager.OnPackageEditorOpenPackage(Sender: TObject;
APackage: TLazPackage): TModalResult;
begin
Result:=DoOpenPackage(APackage);
end;
procedure TPkgManager.mnuConfigCustomCompsClicked(Sender: TObject);
begin
ShowConfigureCustomComponents;
@ -87,14 +95,21 @@ constructor TPkgManager.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
IDEComponentPalette:=TIDEComponentPalette.Create;
PkgLinks:=TPackageLinks.Create;
PackageGraph:=TLazPackageGraph.Create;
PackageEditors:=TPackageEditors.Create;
PackageEditors.OnOpenFile:=@MainIDE.DoOpenMacroFile;
PackageEditors.OnOpenPackage:=@OnPackageEditorOpenPackage;
end;
destructor TPkgManager.Destroy;
begin
FreeThenNil(PackageEditors);
FreeThenNil(PackageGraph);
FreeThenNil(PkgLinks);
FreeThenNil(IDEComponentPalette);
inherited Destroy;
end;