implemented package check broken dependency on compile

git-svn-id: trunk@4064 -
This commit is contained in:
mattias 2003-04-16 17:20:24 +00:00
parent 7691dfe1a7
commit 7734542e04
14 changed files with 365 additions and 216 deletions

View File

@ -111,6 +111,7 @@ begin
SortSelectionDialog.TheText:=TheText;
SortSelectionDialog.PreviewSynEdit.Highlighter:=Highlighter;
EditorOpts.GetSynEditSelectedColor(SortSelectionDialog.PreviewSynEdit);
SortSelectionDialog.UpdatePreview;
Result:=SortSelectionDialog.ShowModal;
if Result=mrOk then
SortedText:=SortSelectionDialog.SortedText;
@ -377,6 +378,7 @@ procedure TSortSelectionDialog.SortSelectionDialogClose(Sender: TObject;
begin
MiscellaneousOptions.SortSelDirection:=Direction;
MiscellaneousOptions.SortSelDomain:=Domain;
MiscellaneousOptions.Save;
end;
procedure TSortSelectionDialog.SetDirection(const AValue: TSortDirection);
@ -434,7 +436,8 @@ begin
FIgnoreSpace:=true;
FDirection:=sdAscending;
FDomain:=sdLines;
FStates:=FStates+[ssdPreviewNeedsUpdate,ssdSortedTextNeedsUpdate];
Position:=poScreenCenter;
IDEDialogLayoutList.ApplyLayout(Self,600,400);
Caption:='Sort Selection';

View File

@ -1,166 +1,87 @@
/* XPM */
static char * pkg_package_circle_xpm[] = {
"16 17 146 2",
" c None",
". c #494214",
"+ c #844737",
"@ c #81422E",
"# c #870013",
"$ c #4B4417",
"% c #874C3A",
"& c #DDC2BE",
"* c #B72D1E",
"= c #CB352A",
"- c #7E000E",
"; c #6F000F",
"> c #777049",
", c #824431",
"' c #EEE1DF",
") c #AAA791",
"! c #B4B096",
"~ c #B6B294",
"{ c #282828",
"] c #5A000C",
"^ c #453F15",
"/ c #FEFDFB",
"( c #FEFDF5",
"_ c #7C4535",
": c #DCBFB5",
"< c #AAA896",
"[ c #4B4836",
"} c #625F45",
"| c #736E52",
"1 c #7D795A",
"2 c #777259",
"3 c #F8EEC3",
"4 c #F7EBC0",
"5 c #7B3F2C",
"6 c #C6847D",
"7 c #CF5148",
"8 c #B4B19D",
"9 c #787355",
"0 c #FBF5D0",
"a c #FEF8CD",
"b c #FCF5C6",
"c c #F2EAB9",
"d c #9D8D43",
"e c #807439",
"f c #413B18",
"g c #7F3E2A",
"h c #7D382A",
"i c #B56D66",
"j c #F2ECC4",
"k c #B5A24F",
"l c #E8E8E8",
"m c #9E8E40",
"n c #948639",
"o c #474015",
"p c #474014",
"q c #853728",
"r c #DCC2BF",
"s c #C52B20",
"t c #BE231B",
"u c #9C633D",
"v c #D55D54",
"w c #6B3626",
"x c #918249",
"y c #978849",
"z c #3A3A3A",
"A c #9C8D41",
"B c #887B39",
"C c #918236",
"D c #484114",
"E c #DCD0A3",
"F c #714538",
"G c #E4CFCD",
"H c #9E663D",
"I c #D36054",
"J c #887B47",
"K c #8F8246",
"L c #454545",
"M c #C3C3C3",
"N c #887B35",
"O c #8C7E31",
"P c #EADDA8",
"Q c #D8CC99",
"R c #78341F",
"S c #D25C53",
"T c #9A9068",
"U c #918348",
"V c #2C2C2C",
"W c #C4C4C4",
"X c #6D6D6D",
"Y c #7F732C",
"Z c #EBDCA4",
"` c #E6D79E",
" . c #D4C690",
".. c #998F67",
"+. c #A99D6E",
"@. c #B6B6B6",
"#. c #727272",
"$. c #4D4D4D",
"%. c #555555",
"&. c #E8D99E",
"*. c #E6D79A",
"=. c #E2D395",
"-. c #CFC187",
";. c #AC9F70",
">. c #AA9E6D",
",. c #363636",
"'. c #2B2B2B",
"). c #8F8F8F",
"!. c #515151",
"~. c #E5D598",
"{. c #E3D394",
"]. c #E1D190",
"^. c #DECD8B",
"/. c #D4C382",
"(. c #D2C27E",
"_. c #D0BF7B",
":. c #8D7F3F",
"<. c #535353",
"[. c #AEAEAE",
"}. c #565656",
"|. c #5C5526",
"1. c #5A5321",
"2. c #3E391A",
"3. c #D4C483",
"4. c #DACA83",
"5. c #DBC981",
"6. c #D9C77D",
"7. c #D6C378",
"8. c #949494",
"9. c #686868",
"0. c #3D3D3D",
"a. c #3D391A",
"b. c #443E16",
"c. c #CEBD76",
"d. c #D4C276",
"e. c #D6C477",
"f. c #BEBEBE",
"g. c #626262",
"h. c #373737",
"i. c #292929",
"j. c #A3A3A3",
"k. c #767676",
"l. c #5B5B5B",
"m. c #323232",
"n. c #484848",
"o. c #414141",
" . . ",
" + @ @ @ @ # ",
" $ % & * = # - ; # # ",
" . > , ' * = # ) ! ~ { ] # ^ ",
". / ( _ : = # < [ } | 1 2 { # ^ ",
". 3 4 5 6 7 # 8 9 0 a b c d e f ",
"g h g 5 i 7 # # # # j k l m n o ",
"p q r 6 s t u v w x y z A B C . ",
"D E F G t H I w J K L M { N O . ",
". P Q R r S w T U V W X X { Y D ",
". Z ` .w w ..+.{ @.#.$.%.X { ^ ",
". &.*.=.-.;.>.,.,.'.).!.).,.,.,.",
". ~.{.].^./.(._.:.<.[.}.{ |.1.2.",
" { { 3.4.5.6.7.m { 8.9.0.a.b. ",
" { { { c.d.e.{ f.#.g.{ ",
" h.0.{ i.X j.k.l.m. ",
" ,.n.{ { o.{ "};
"16 17 67 1",
" c None",
". c #494214",
"+ c #844737",
"@ c #81422E",
"# c #870013",
"$ c #4B4417",
"% c #874C3A",
"& c #DDC2BE",
"* c #B72D1E",
"= c #CB352A",
"- c #7E000E",
"; c #6F000F",
"> c #824431",
", c #EEE1DF",
"' c #282828",
") c #5A000C",
"! c #7C4535",
"~ c #DCBFB5",
"{ c #7B3F2C",
"] c #C6847D",
"^ c #CF5148",
"/ c #7F3E2A",
"( c #7D382A",
"_ c #B56D66",
": c #853728",
"< c #DCC2BF",
"[ c #C52B20",
"} c #BE231B",
"| c #9C633D",
"1 c #D55D54",
"2 c #6B3626",
"3 c #3A3A3A",
"4 c #714538",
"5 c #E4CFCD",
"6 c #9E663D",
"7 c #D36054",
"8 c #454545",
"9 c #C3C3C3",
"0 c #78341F",
"a c #D25C53",
"b c #2C2C2C",
"c c #C4C4C4",
"d c #6D6D6D",
"e c #B6B6B6",
"f c #727272",
"g c #4D4D4D",
"h c #555555",
"i c #363636",
"j c #2B2B2B",
"k c #8F8F8F",
"l c #515151",
"m c #535353",
"n c #AEAEAE",
"o c #565656",
"p c #949494",
"q c #686868",
"r c #3D3D3D",
"s c #BEBEBE",
"t c #626262",
"u c #373737",
"v c #292929",
"w c #A3A3A3",
"x c #767676",
"y c #5B5B5B",
"z c #323232",
"A c #484848",
"B c #414141",
" .. ",
" +@@@@# ",
" $%&*=#-;## ",
" >,*=# ')# ",
" !~=# '# ",
" {]^# ",
"/(/{_^#### ",
" :<][}|12 3 ",
" 45}672 89' ",
" 0<a2 bcdd' ",
" 22 'efghd' ",
" iijklkiii",
" mno' ",
" 'pqr ",
" '' 'sft' ",
" ur'vdwxyz ",
" iA''B' "};

View File

@ -1157,6 +1157,7 @@ type
function GetPrevVisible: TTreeNode;
function HasAsParent(AValue: TTreeNode): Boolean;
function IndexOf(AValue: TTreeNode): Integer;
function IndexOfText(const NodeText: string): Integer;
procedure MakeVisible;
procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); virtual;
procedure MultiSelectGroup;
@ -1757,6 +1758,9 @@ end.
{ =============================================================================
$Log$
Revision 1.73 2003/04/16 17:20:24 mattias
implemented package check broken dependency on compile
Revision 1.72 2003/04/14 18:03:48 mattias
implemented inherited compiler options

View File

@ -525,6 +525,7 @@ type
function CustomFormIndex(AForm: TCustomForm): integer;
function FormIndex(AForm: TForm): integer;
function CustomFormZIndex(AForm: TCustomForm): integer;
procedure MoveFormToFront(ACustomForm: TCustomForm);
public
property ActiveControl: TWinControl read FActiveControl;
property ActiveCustomForm: TCustomForm read FActiveCustomForm;

View File

@ -643,7 +643,9 @@ end;
procedure TCustomForm.SetZOrder(Topmost: Boolean);
begin
if Parent=nil then begin
if TopMost and HandleAllocated then BringWindowToTop(Handle);
if TopMost and HandleAllocated then begin
BringWindowToTop(Handle);
end;
exit;
end;
inherited SetZOrder(Topmost);
@ -1131,14 +1133,9 @@ begin
// update Screen object
Screen.FActiveControl := Control;
Screen.FActiveCustomForm := Self;
Screen.FCustomForms.Remove(Self);
Screen.FCustomForms.Insert(0, Self);
Screen.MoveFormToFront(Self);
if Self is TForm then
begin
Screen.FActiveForm := TForm(Self);
Screen.FFormList.Remove(Self);
Screen.FFormList.Insert(0, Self);
end
Screen.FActiveForm := TForm(Self)
else
Screen.FActiveForm := nil;
@ -1396,7 +1393,7 @@ begin
EnableTaskWindows(WindowList);}
if Screen.FSaveFocusedList.Count > 0 then
begin
Screen.FFocusedForm := TCustoMForm(Screen.FSaveFocusedList.First);
Screen.FFocusedForm := TCustomForm(Screen.FSaveFocusedList.First);
Screen.FSaveFocusedList.Remove(Screen.FFocusedForm);
end else
Screen.FFocusedForm := nil;
@ -1409,6 +1406,9 @@ end;
{ =============================================================================
$Log$
Revision 1.95 2003/04/16 17:20:24 mattias
implemented package check broken dependency on compile
Revision 1.94 2003/04/11 21:21:34 mattias
implemented closing unneeded package

View File

@ -339,5 +339,18 @@ begin
end;
end;
procedure TScreen.MoveFormToFront(ACustomForm: TCustomForm);
begin
FCustomForms.Remove(ACustomForm);
FCustomForms.Insert(0, ACustomForm);
FCustomFormsZOrdered.Remove(ACustomForm);
FCustomFormsZOrdered.Insert(0, ACustomForm);
if ACustomForm is TForm then
begin
Screen.FFormList.Remove(ACustomForm);
Screen.FFormList.Insert(0, ACustomForm);
end;
end;
// included by forms.pp

View File

@ -879,6 +879,15 @@ begin
end;
end;
function TTreeNode.IndexOfText(const NodeText: string): Integer;
begin
Result:=Count-1;
while Result>=0 do begin
if FItems[Result].Text=NodeText then exit;
dec(Result);
end;
end;
function TTreeNode.GetCount: Integer;
//var Node: TTreeNode;
begin

View File

@ -329,11 +329,10 @@ begin
end;
// check if required package exists
if PackageGraph.FindNodeOfDependency(NewDependency,fpfSearchPackageEverywhere)
=nil then
begin
if not PackageGraph.DependencyExists(NewDependency,fpfSearchPackageEverywhere)
then begin
MessageDlg('Package not found',
'The packagename "'+NewPckName+'" was not found.'#13
'The dependency "'+NewDependency.AsString+'" was not found.'#13
+'Please choose an existing package.',
mtError,[mbCancel],0);
exit;

View File

@ -58,6 +58,11 @@ type
);
TPkgOpenFlags = set of TPkgOpenFlag;
TPkgCompileFlag = (
pcfCompileAll
);
TPkgCompileFlags = set of TPkgCompileFlag;
TBasePkgManager = class(TComponent)
public
procedure ConnectMainBarEvents; virtual; abstract;
@ -78,6 +83,9 @@ type
function DoSaveAllPackages(Flags: TPkgSaveFlags): TModalResult; virtual; abstract;
function DoClosePackageEditor(APackage: TLazPackage): TModalResult; virtual; abstract;
function DoCloseAllPackageEditors: TModalResult; virtual; abstract;
procedure DoShowPackageGraphPathList(PathList: TList); virtual; abstract;
function DoCompilePackage(APackage: TLazPackage;
Flags: TPkgCompileFlags): TModalResult; virtual; abstract;
end;
var

View File

@ -245,6 +245,7 @@ type
property RequiredPackage: TLazPackage read FRequiredPackage write SetRequiredPackage;
property LoadPackageResult: TLoadPackageResult read FLoadPackageResult write SetLoadPackageResult;
end;
PPkgDependency = ^TPkgDependency;
{ TPkgCompilerOptions }

View File

@ -51,6 +51,9 @@ type
TOnSavePackage =
function(Sender: TObject; APackage: TLazPackage;
SaveAs: boolean): TModalResult of object;
TOnCompilePackage =
function(Sender: TObject; APackage: TLazPackage;
CompileAll: boolean): TModalResult of object;
TOnCreateNewPkgFile =
function(Sender: TObject;
const Params: TAddToPkgResult): TModalResult of object;
@ -90,6 +93,7 @@ type
procedure AddBitBtnClick(Sender: TObject);
procedure ApplyDependencyButtonClick(Sender: TObject);
procedure CallRegisterProcCheckBoxClick(Sender: TObject);
procedure CompileAllClick(Sender: TObject);
procedure CompileBitBtnClick(Sender: TObject);
procedure CompilerOptionsBitBtnClick(Sender: TObject);
procedure FilePropsGroupBoxResize(Sender: TObject);
@ -138,6 +142,7 @@ type
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure DoSave(SaveAs: boolean);
procedure DoCompile(CompileAll: boolean);
public
property LazPackage: TLazPackage read FLazPackage write SetLazPackage;
end;
@ -148,6 +153,7 @@ type
TPackageEditors = class
private
FItems: TList; // list of TPackageEditorForm
FOnCompilePackage: TOnCompilePackage;
FOnCreateNewFile: TOnCreateNewPkgFile;
FOnFreeEditor: TOnFreePkgEditor;
FOnGetIDEFileInfo: TGetIDEFileStateEvent;
@ -172,6 +178,8 @@ type
function CreateNewFile(Sender: TObject;
const Params: TAddToPkgResult): TModalResult;
function SavePackage(APackage: TLazPackage; SaveAs: boolean): TModalResult;
function CompilePackage(APackage: TLazPackage;
CompileAll: boolean): TModalResult;
procedure UpdateAllEditors;
public
property Editors[Index: integer]: TPackageEditorForm read GetEditors;
@ -185,6 +193,8 @@ type
read FOnGetUnitRegisterInfo write FOnGetUnitRegisterInfo;
property OnFreeEditor: TOnFreePkgEditor read FOnFreeEditor write FOnFreeEditor;
property OnSavePackage: TOnSavePackage read FOnSavePackage write FOnSavePackage;
property OnCompilePackage: TOnCompilePackage read FOnCompilePackage
write FOnCompilePackage;
end;
var
@ -336,6 +346,7 @@ begin
AddPopupMenuItem('Save',@SaveBitBtnClick,SaveBitBtn.Enabled);
AddPopupMenuItem('Save As',@SaveAsClick,not LazPackage.AutoCreated);
AddPopupMenuItem('Compile',@CompileBitBtnClick,CompileBitBtn.Enabled);
AddPopupMenuItem('Compile All',@CompileAllClick,CompileBitBtn.Enabled);
AddPopupMenuItem('Add',@AddBitBtnClick,AddBitBtn.Enabled);
AddPopupMenuItem('Remove',@RemoveBitBtnClick,RemoveBitBtn.Enabled);
AddPopupMenuItem('Install',@InstallBitBtnClick,InstallBitBtn.Enabled);
@ -723,9 +734,14 @@ begin
end;
end;
procedure TPackageEditorForm.CompileAllClick(Sender: TObject);
begin
DoCompile(true);
end;
procedure TPackageEditorForm.CompileBitBtnClick(Sender: TObject);
begin
DoCompile(false);
end;
procedure TPackageEditorForm.CompilerOptionsBitBtnClick(Sender: TObject);
@ -1340,6 +1356,14 @@ begin
UpdateStatusBar;
end;
procedure TPackageEditorForm.DoCompile(CompileAll: boolean);
begin
PackageEditors.CompilePackage(LazPackage,CompileAll);
UpdateButtons;
UpdateTitle;
UpdateStatusBar;
end;
constructor TPackageEditorForm.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -1456,7 +1480,15 @@ end;
function TPackageEditors.SavePackage(APackage: TLazPackage;
SaveAs: boolean): TModalResult;
begin
if Assigned(OnSavePackage) then Result:=OnSavePackage(Self,APackage,SaveAs);
if Assigned(OnSavePackage) then
Result:=OnSavePackage(Self,APackage,SaveAs);
end;
function TPackageEditors.CompilePackage(APackage: TLazPackage;
CompileAll: boolean): TModalResult;
begin
if Assigned(OnCompilePackage) then
Result:=OnCompilePackage(Self,APackage,CompileAll);
end;
procedure TPackageEditors.UpdateAllEditors;

View File

@ -108,51 +108,72 @@ type
procedure BeginUpdate(Change: boolean);
procedure EndUpdate;
function Updating: boolean;
public
// searching
function CheckIfPackageCanBeClosed(APackage: TLazPackage): boolean;
function CreateUniquePkgName(const Prefix: string;
IgnorePackage: TLazPackage): string;
function CreateUniqueUnitName(const Prefix: string): string;
function FindAPackageWithName(const PkgName: string;
IgnorePackage: TLazPackage): TLazPackage;
function FindFileInAllPackages(const TheFilename: string;
ResolveLinks, IgnoreDeleted: boolean): TPkgFile;
function FindLowestPkgNodeByName(const PkgName: string): TAVLTreeNode;
function FindNextSameName(ANode: TAVLTreeNode): TAVLTreeNode;
function FindNodeOfDependency(Dependency: TPkgDependency;
Flags: TFindPackageFlags): TAVLTreeNode;
function FindOpenPackage(Dependency: TPkgDependency;
Flags: TFindPackageFlags): TLazPackage;
function FindAPackageWithName(const PkgName: string;
IgnorePackage: TLazPackage): TLazPackage;
function FindPackageWithFilename(const TheFilename: string;
ResolveLinks: boolean): TLazPackage;
function FindPackageWithID(PkgID: TLazPackageID): TLazPackage;
function FindUnit(StartPackage: TLazPackage; const TheUnitName: string;
WithRequiredPackages, IgnoreDeleted: boolean): TPkgFile;
function FindUnitInAllPackages(const TheUnitName: string;
IgnoreDeleted: boolean): TPkgFile;
function FindFileInAllPackages(const TheFilename: string;
ResolveLinks, IgnoreDeleted: boolean): TPkgFile;
function FindPackageWithFilename(const TheFilename: string;
ResolveLinks: boolean): TLazPackage;
function CreateUniqueUnitName(const Prefix: string): string;
function GetBrokenDependenciesWhenChangingPkgID(APackage: TLazPackage;
const NewName: string; NewVersion: TPkgVersion): TList;
function PackageCanBeReplaced(OldPackage, NewPackage: TLazPackage): boolean;
function PackageIsNeeded(APackage: TLazPackage): boolean;
function PackageNameExists(const PkgName: string;
IgnorePackage: TLazPackage): boolean;
function CreateUniquePkgName(const Prefix: string;
IgnorePackage: TLazPackage): string;
function CreateNewPackage(const Prefix: string): TLazPackage;
function DependencyExists(Dependency: TPkgDependency;
Flags: TFindPackageFlags): boolean;
procedure ConsistencyCheck;
procedure GetAllRequiredPackages(FirstDependency: TPkgDependency;
var List: TList);
procedure IterateAllComponentClasses(Event: TIterateComponentClassesEvent);
procedure IterateComponentClasses(APackage: TLazPackage;
Event: TIterateComponentClassesEvent;
WithUsedPackages, WithRequiredPackages: boolean);
procedure IteratePackages(Flags: TFindPackageFlags;
Event: TIteratePackagesEvent);
procedure IteratePackagesSorted(Flags: TFindPackageFlags;
Event: TIteratePackagesEvent);
procedure MarkAllPackagesAsNotVisited;
procedure MarkNeededPackages;
function FindBrokenDependencyPath(APackage: TLazPackage): TList;
public
// packages handling
function CreateNewPackage(const Prefix: string): TLazPackage;
procedure AddPackage(APackage: TLazPackage);
procedure ReplacePackage(OldPackage, NewPackage: TLazPackage);
procedure AddStaticBasePackages;
procedure ClosePackage(APackage: TLazPackage);
procedure CloseUnneededPackages;
procedure ChangePackageID(APackage: TLazPackage;
const NewName: string; NewVersion: TPkgVersion;
RenameDependencies: boolean);
public
// registration
procedure RegisterUnitHandler(const TheUnitName: string;
RegisterProc: TRegisterProc);
procedure RegisterComponentsHandler(const Page: string;
ComponentClasses: array of TComponentClass);
procedure RegistrationError(const Msg: string);
procedure AddPackage(APackage: TLazPackage);
procedure ReplacePackage(OldPackage, NewPackage: TLazPackage);
procedure AddStaticBasePackages;
procedure ClosePackage(APackage: TLazPackage);
procedure MarkNeededPackages;
procedure MarkAllPackagesAsNotVisited;
procedure CloseUnneededPackages;
procedure ChangePackageID(APackage: TLazPackage;
const NewName: string; NewVersion: TPkgVersion;
RenameDependencies: boolean);
function GetBrokenDependenciesWhenChangingPkgID(APackage: TLazPackage;
const NewName: string; NewVersion: TPkgVersion): TList;
function CheckIfPackageCanBeClosed(APackage: TLazPackage): boolean;
function PackageIsNeeded(APackage: TLazPackage): boolean;
function PackageCanBeReplaced(OldPackage, NewPackage: TLazPackage): boolean;
procedure RegisterStaticPackages;
public
// dependency handling
procedure AddDependencyToPackage(APackage: TLazPackage;
Dependency: TPkgDependency);
procedure ChangeDependency(Dependency, NewDependency: TPkgDependency);
@ -160,17 +181,8 @@ type
var APackage: TLazPackage): TLoadPackageResult;
procedure MoveRequiredDependencyUp(ADependency: TPkgDependency);
procedure MoveRequiredDependencyDown(ADependency: TPkgDependency);
procedure IterateComponentClasses(APackage: TLazPackage;
Event: TIterateComponentClassesEvent;
WithUsedPackages, WithRequiredPackages: boolean);
procedure IterateAllComponentClasses(Event: TIterateComponentClassesEvent);
procedure IteratePackages(Flags: TFindPackageFlags;
Event: TIteratePackagesEvent);
procedure IteratePackagesSorted(Flags: TFindPackageFlags;
Event: TIteratePackagesEvent);
procedure GetAllRequiredPackages(FirstDependency: TPkgDependency;
var List: TList);
public
// properties
property AbortRegistration: boolean read FAbortRegistration
write SetAbortRegistration;
property ErrorMsg: string read FErrorMsg write FErrorMsg;
@ -571,6 +583,22 @@ begin
end;
end;
function TLazPackageGraph.DependencyExists(Dependency: TPkgDependency;
Flags: TFindPackageFlags): boolean;
begin
Result:=true;
if FindNodeOfDependency(Dependency,Flags)<>nil then exit;
if FindAPackageWithName(Dependency.PackageName,nil)=nil then begin
// no package with same name open
// -> try package links
if fpfSearchInPkgLinks in Flags then
if PkgLinks.FindLinkWithDependency(Dependency)<>nil then exit;
end else begin
// there is already a package with this name open, but the wrong version
end;
Result:=false;
end;
function TLazPackageGraph.CreateUniquePkgName(const Prefix: string;
IgnorePackage: TLazPackage): string;
var
@ -911,6 +939,48 @@ begin
FreeMem(PkgStack);
end;
function TLazPackageGraph.FindBrokenDependencyPath(APackage: TLazPackage
): TList;
procedure FindBroken(CurPackage: TLazPackage; var PathList: TList);
var
Dependency: TPkgDependency;
RequiredPackage: TLazPackage;
begin
CurPackage.Flags:=CurPackage.Flags+[lpfVisited];
Dependency:=CurPackage.FirstRequiredDependency;
while Dependency<>nil do begin
if Dependency.LoadPackageResult=lprSuccess then begin
// dependency ok
RequiredPackage:=Dependency.RequiredPackage;
if not (lpfVisited in RequiredPackage.Flags) then begin
FindBroken(RequiredPackage,PathList);
if PathList<>nil then begin
// broken dependency found
// -> add current package to list to
PathList.Insert(0,CurPackage);
exit;
end;
end;
end else begin
// broken dependency found
PathList:=TList.Create;
PathList.Add(CurPackage);
PathList.Add(Dependency);
exit;
end;
Dependency:=Dependency.NextRequiresDependency;
end;
end;
begin
Result:=nil;
if (Count=0) or (APackage=nil) then exit;
// mark all packages as not visited
MarkAllPackagesAsNotVisited;
FindBroken(APackage,Result);
end;
procedure TLazPackageGraph.MarkAllPackagesAsNotVisited;
var
i: Integer;

View File

@ -85,6 +85,7 @@ type
procedure UpdatePackageAdded(Pkg: TLazPackage);
procedure SelectPackage(Pkg: TLazPackage);
function FindMainNodeWithText(const s: string): TTreeNode;
procedure ShowPath(PathList: TList);
public
property OnOpenPackage: TOnOpenPackage read FOnOpenPackage write FOnOpenPackage;
end;
@ -663,6 +664,48 @@ begin
while (Result<>nil) and (Result.Text<>s) do Result:=Result.GetNextSibling;
end;
procedure TPkgGraphExplorer.ShowPath(PathList: TList);
var
AnObject: TObject;
CurNode, LastNode: TTreeNode;
i: Integer;
procedure SelectChild(var Node: TTreeNode; const NodeText: string);
var
i: Integer;
begin
if Node=nil then
Node:=FindMainNodeWithText(NodeText)
else begin
Node.Expanded:=true;
i:=Node.IndexOfText(NodeText);
if i>=0 then
Node:=Node.Items[i]
else
Node:=nil;
end;
end;
begin
PkgTreeView.BeginUpdate;
CurNode:=nil;
LastNode:=nil;
for i:=0 to PathList.Count-1 do begin
AnObject:=TObject(PathList[i]);
LastNode:=CurNode;
if AnObject is TLazPackage then begin
SelectChild(CurNode,TLazPackage(AnObject).IDAsString);
end else if AnObject is TPkgDependency then begin
SelectChild(CurNode,TPkgDependency(AnObject).AsString);
end else
break;
if CurNode=nil then break;
end;
if CurNode<>nil then Lastnode:=CurNode;
PkgTreeView.Selected:=LastNode;
PkgTreeView.EndUpdate;
end;
initialization
PackageGraphExplorer:=nil;

View File

@ -56,6 +56,8 @@ type
TPkgManager = class(TBasePkgManager)
procedure MainIDEitmPkgOpenPackageFileClick(Sender: TObject);
procedure MainIDEitmPkgPkgGraphClick(Sender: TObject);
function OnPackageEditorCompilePackage(Sender: TObject;
APackage: TLazPackage; CompileAll: boolean): TModalResult;
function OnPackageEditorCreateFile(Sender: TObject;
const Params: TAddToPkgResult): TModalResult;
procedure OnPackageEditorFreeEditor(APackage: TLazPackage);
@ -106,6 +108,9 @@ type
function DoShowPackageGraph: TModalResult;
function DoClosePackageEditor(APackage: TLazPackage): TModalResult; override;
function DoCloseAllPackageEditors: TModalResult; override;
procedure DoShowPackageGraphPathList(PathList: TList); override;
function DoCompilePackage(APackage: TLazPackage;
Flags: TPkgCompileFlags): TModalResult; override;
end;
implementation
@ -145,6 +150,16 @@ begin
DoShowPackageGraph;
end;
function TPkgManager.OnPackageEditorCompilePackage(Sender: TObject;
APackage: TLazPackage; CompileAll: boolean): TModalResult;
var
Flags: TPkgCompileFlags;
begin
Flags:=[];
if CompileAll then Include(Flags,pcfCompileAll);
Result:=DoCompilePackage(APackage,Flags);
end;
function TPkgManager.OnPackageEditorCreateFile(Sender: TObject;
const Params: TAddToPkgResult): TModalResult;
var
@ -531,6 +546,7 @@ begin
PackageEditors.OnGetUnitRegisterInfo:=@OnPackageEditorGetUnitRegisterInfo;
PackageEditors.OnFreeEditor:=@OnPackageEditorFreeEditor;
PackageEditors.OnSavePackage:=@OnPackageEditorSavePackage;
PackageEditors.OnCompilePackage:=@OnPackageEditorCompilePackage;
Application.AddOnIdleHandler(@OnApplicationIdle);
end;
@ -875,6 +891,36 @@ begin
Result:=mrOk;
end;
procedure TPkgManager.DoShowPackageGraphPathList(PathList: TList);
begin
if DoShowPackageGraph<>mrOk then exit;
PackageGraphExplorer.ShowPath(PathList);
end;
function TPkgManager.DoCompilePackage(APackage: TLazPackage;
Flags: TPkgCompileFlags): TModalResult;
var
PathList: TList;
begin
Result:=mrCancel;
if APackage.AutoCreated then exit;
// check for broken dependencies
PathList:=PackageGraph.FindBrokenDependencyPath(APackage);
if PathList<>nil then begin
DoShowPackageGraphPathList(PathList);
Result:=MessageDlg('Broken dependency',
'A required packages was not found. See package graph.',
mtError,[mbCancel,mbAbort],0);
exit;
end;
// check for circle dependencies
Result:=mrOk;
end;
function TPkgManager.DoClosePackageEditor(APackage: TLazPackage): TModalResult;
begin
if APackage.Editor<>nil then begin
@ -898,7 +944,6 @@ begin
if CurPackage.Modified and (not CurPackage.ReadOnly)
and (not (lpfSkipSaving in CurPackage.Flags)) then begin
Result:=DoSavePackage(CurPackage,Flags);
writeln('TPkgManager.DoSaveAllPackages A ',CurPackage.IDAsString,' ',Result=mrOk);
if Result=mrIgnore then
CurPackage.Flags:=CurPackage.Flags+[lpfSkipSaving];
if Result<>mrOk then exit;