1 {
2 /***************************************************************************
3 pkgmanager.pas
4 --------------
5
6
7 ***************************************************************************/
8
9 ***************************************************************************
10 * *
11 * This source is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 * This code is distributed in the hope that it will be useful, but *
17 * WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
19 * General Public License for more details. *
20 * *
21 * A copy of the GNU General Public License is available on the World *
22 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
23 * obtain it by writing to the Free Software Foundation, *
24 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
25 * *
26 ***************************************************************************
27
28 Author: Mattias Gaertner
29
30 Abstract:
31 TPkgManager is the class for the global PkgBoss variable, which controls
32 the whole package system in the IDE.
33 }
34 unit PkgManager;
35
36 {$mode objfpc}{$H+}
37
38 interface
39
40 {$I ide.inc}
41
42 {$DEFINE UseLRS}
43 {off $DEFINE VerbosePkgEditDrag}
44
45 uses
46 {$IFDEF IDE_MEM_CHECK}
47 MemCheck,
48 {$ENDIF}
49 // RTL, FCL
50 TypInfo, math, Classes, SysUtils, contnrs, Laz_AVL_Tree,
51 // LCL
52 Forms, Controls, Dialogs, Menus, ComCtrls, LResources,
53 // LazUtils
54 LazUTF8, Laz2_XMLCfg, LazTracer, LazUtilities, LazStringUtils,
55 LazFileUtils, LazFileCache, StringHashList, AvgLvlTree, ObjectLists, Translations,
56 // Codetools
57 CodeToolsConfig, CodeToolManager, CodeCache, BasicCodeTools,
58 FileProcs, CodeTree, CTUnitGraph,
59 // BuildIntf
60 ProjPackIntf, ProjectIntf, PackageIntf, PackageDependencyIntf, PackageLinkIntf,
61 NewItemIntf, CompOptsIntf, IDEExternToolIntf, MacroIntf,
62 // IdeIntf
63 IDECommands, MenuIntf, IDEWindowIntf, LazIDEIntf, IDEMsgIntf, SrcEditorIntf,
64 ComponentReg, ComponentEditors, PropEdits, IDEDialogs, UnitResources,
65 // IDE
66 IDECmdLine, LazarusIDEStrConsts, IDEProcs, DialogProcs, IDEOptionDefs,
67 EnvironmentOpts, MiscOptions, InputHistory, Project, ProjPackEditing, PackageEditor,
68 AddToPackageDlg, PackageDefs, PackageLinks, PackageSystem, OpenInstalledPkgDlg,
69 PkgGraphExplorer, BrokenDependenciesDlg, CompilerOptions, IDETranslations,
70 TransferMacros, BuildLazDialog, NewDialog, FindInFilesDlg, ProjectInspector,
71 SourceEditor, ProjPackChecks, AddFileToAPackageDlg, LazarusPackageIntf,
72 PublishModuleDlg, PkgLinksDlg, InterPkgConflictFiles, InstallPkgSetDlg,
73 ConfirmPkgListDlg, NewPkgComponentDlg, BaseBuildManager, BasePkgManager,
74 MainBar, MainIntf, MainBase, ModeMatrixOpts;
75
76 type
77
78 TPackagePackageArray = specialize TObjectArray<TLazPackageID, TLazPackageID>;
79 TOwnerPackageArray = specialize TObjectArray<TObject, TLazPackageID>;
80
81 { TPkgManager }
82
83 TPkgManager = class(TBasePkgManager)
84 private
85 // event handlers - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
86 // package editor
PackageEditorAddToProjectnull87 function PackageEditorAddToProject(Sender: TObject; APackage: TLazPackage;
88 OnlyTestIfPossible: boolean): TModalResult;
PackageEditorCompilePackagenull89 function PackageEditorCompilePackage(Sender: TObject; APackage: TLazPackage;
90 CompileClean, CompileRequired: boolean): TModalResult;
91 procedure PackageEditorCopyMoveFiles(Sender: TObject);
PackageEditorCreateFilenull92 function PackageEditorCreateFile(Sender: TObject;
93 Params: TAddToPkgResult): TModalResult;
PackageEditorCreateMakefilenull94 function PackageEditorCreateMakefile(Sender: TObject;
95 APackage: TLazPackage): TModalResult;
PackageEditorCreateFpmakeFilenull96 function PackageEditorCreateFpmakeFile(Sender: TObject;
97 APackage: TLazPackage): TModalResult;
PackageEditorDeleteAmbiguousFilesnull98 function PackageEditorDeleteAmbiguousFiles(Sender: TObject;
99 {%H-}APackage: TLazPackage; const Filename: string): TModalResult;
100 procedure PackageEditorDragDropTreeView(Sender, Source: TObject; X, Y: Integer);
PackageEditorDragOverTreeViewnull101 function PackageEditorDragOverTreeView(Sender, Source: TObject; X, Y: Integer;
102 out TargetTVNode: TTreeNode; out TargetTVType: TTreeViewInsertMarkType): boolean;
PackageEditorFindInFilesnull103 function PackageEditorFindInFiles(Sender: TObject; APackage: TLazPackage): TModalResult;
PackageEditorInstallPackagenull104 function PackageEditorInstallPackage(Sender: TObject;
105 APackage: TLazPackage): TModalResult;
PackageEditorOpenPackagenull106 function PackageEditorOpenPackage(Sender: TObject; APackage: TLazPackage): TModalResult;
PackageEditorOpenPkgFilenull107 function PackageEditorOpenPkgFile(Sender: TObject; PkgFile: TPkgFile): TModalResult;
PackageEditorPublishPackagenull108 function PackageEditorPublishPackage(Sender: TObject; APackage: TLazPackage): TModalResult;
PackageEditorRevertPackagenull109 function PackageEditorRevertPackage(Sender: TObject; APackage: TLazPackage): TModalResult;
PackageEditorSavePackagenull110 function PackageEditorSavePackage(Sender: TObject; APackage: TLazPackage;
111 SaveAs: boolean): TModalResult;
PackageEditorUninstallPackagenull112 function PackageEditorUninstallPackage(Sender: TObject;
113 APackage: TLazPackage): TModalResult;
PackageEditorViewPkgSourcenull114 function PackageEditorViewPkgSource(Sender: TObject;
115 APackage: TLazPackage): TModalResult;
116 procedure AfterWritePackage(Sender: TObject; Restore: boolean);
117 procedure BeforeReadPackage(Sender: TObject);
118 procedure PackageEditorFreeEditor(APackage: TLazPackage);
PackageGraphCheckInterPkgFilesnull119 function PackageGraphCheckInterPkgFiles(IDEObject: TObject;
120 PkgList: TFPList; out FilesChanged: boolean): boolean;
121 // package graph
PackageGraphExplorerOpenPackagenull122 function PackageGraphExplorerOpenPackage(Sender: TObject;
123 APackage: TLazPackage): TModalResult;
PackageGraphExplorerOpenProjectnull124 function PackageGraphExplorerOpenProject(Sender: TObject;
125 AProject: TProject): TModalResult;
PackageGraphExplorerUninstallPackagenull126 function PackageGraphExplorerUninstallPackage(Sender: TObject;
127 APackage: TLazPackage): TModalResult;
128 procedure PackageGraphAddPackage(Pkg: TLazPackage);
129 procedure PackageGraphBeginUpdate(Sender: TObject);
130 procedure PackageGraphChangePackageName(APackage: TLazPackage;
131 const OldName: string);
132 procedure PackageGraphDeletePackage(APackage: TLazPackage);
133 procedure PackageGraphDependencyModified(ADependency: TPkgDependency);
134 procedure PackageGraphEndUpdate(Sender: TObject; GraphChanged: boolean);
135 procedure PackageGraphFindFPCUnit(const AUnitName, Directory: string;
136 var Filename: string);
137 // menu
138 procedure MainIDEitmPkgOpenPackageFileClick(Sender: TObject);
139 procedure MainIDEitmPkgPkgGraphClick(Sender: TObject);
140 procedure MainIDEitmPkgEditInstallPkgsClick(Sender: TObject);
141 procedure MainIDEitmPkgAddCurFileToPkgClick(Sender: TObject);
142 procedure MainIDEitmPkgNewComponentClick(Sender: TObject);
143 procedure MainIDEitmPkgOpenPackageOfCurUnitClicked(Sender: TObject);
144 procedure MainIDEitmOpenRecentPackageClicked(Sender: TObject);
145 procedure MainIDEitmPkgOpenLoadedPackageClicked(Sender: TObject);
146 procedure MainIDEitmPkgNewPackageClick(Sender: TObject);
147 procedure MainIDEitmPackageLinksClicked(Sender: TObject);
148
149 // source editor
150 procedure OpenPackageForCurrentSrcEditFile(Sender: TObject);
151
152 // LCL
153 procedure ApplicationIdleHandler(Sender: TObject; var {%H-}Done: Boolean);
154
155 // misc
156 procedure GetDependencyOwnerDescription(Dependency: TPkgDependency;
157 out Description: string);
158 procedure GetDependencyOwnerDirectory(Dependency: TPkgDependency;
159 out Directory: string);
160 procedure PackageFileLoaded(Sender: TObject);
161 procedure CheckInstallPackageListHandler(PkgIDList: TObjectList;
162 RemoveConflicts: boolean; out Ok: boolean);
DoBeforeCompilePackagesnull163 function DoBeforeCompilePackages(aPkgList: TFPList): TModalResult;
LoadDependencyListnull164 function LoadDependencyList(FirstDependency: TPkgDependency;
165 Quiet: boolean): TModalResult;
166 procedure CreateIDEWindow(Sender: TObject; aFormName: string;
167 var AForm: TCustomForm; DoDisableAutoSizing: boolean);
168 public
169 // component palette
170 procedure IDEComponentPaletteOpenPackage(Sender: TObject);
171 procedure IDEComponentPaletteOpenUnit(Sender: TObject);
172 // end event handlers - - - - - - - - - - - - - - - - - - - - - - - - - - -
173
174 private
175 // helper functions
176 FLastLazarusSrcDir: string;
177 {$IFDEF UseLRS}
178 FIconLRSSource: string;
179 {$ENDIF}
DoShowSavePackageAsDialognull180 function DoShowSavePackageAsDialog(APackage: TLazPackage): TModalResult;
CheckPackageGraphForCompilationnull181 function CheckPackageGraphForCompilation(APackage: TLazPackage;
182 FirstDependency: TPkgDependency;
183 const Directory: string;
184 ShowAbort: boolean): TModalResult;
185 procedure SaveAutoInstallDependencies;
186 procedure LoadStaticCustomPackages;
LoadInstalledPackagenull187 function LoadInstalledPackage(const PackageName: string;
188 AddToAutoInstall: boolean; var Quiet: boolean): TLazPackage;
189 procedure LoadAutoInstallPackages;
190 procedure AddUnitToProjectMainUsesSection(AProject: TProject;
191 const AnUnitName, AnUnitInFilename: string);
192 procedure AddToIconResource(const aIconFile, aResName: string);
193 // move files
CheckDragnull194 function CheckDrag(Sender, Source: TObject; X, Y: Integer;
195 out SrcFilesEdit, TargetFilesEdit: IFilesEditorInterface;
196 out aFileCount, aDependencyCount, aDirectoryCount: integer;
197 out TargetTVNode: TTreeNode; out TargetTVType: TTreeViewInsertMarkType
198 ): boolean;
199 procedure FilesEditDragDrop(Sender, Source: TObject; X, Y: Integer);
MoveFilesnull200 function MoveFiles(TargetFilesEdit, SrcFilesEdit: IFilesEditorInterface;
201 TargetDirectory: string): boolean;
MoveFilesnull202 function MoveFiles(TargetFilesEdit, SrcFilesEdit: IFilesEditorInterface;
203 IDEFiles: TFPList; TargetDirectory: string): boolean;
CopyMoveFilesnull204 function CopyMoveFiles(Sender: TObject): boolean;
ResolveBrokenDependenciesOnlinenull205 function ResolveBrokenDependenciesOnline(ABrokenDependencies: TFPList): TModalResult;
ShowBrokenDependenciesReportnull206 function ShowBrokenDependenciesReport(Dependencies: TFPList): TModalResult;
207 // Components
FilterMissingDepsForUnitnull208 function FilterMissingDepsForUnit(const UnitFilename: string;
209 InputPackageList: TPackagePackageArray;
210 out OutputPackageList: TOwnerPackageArray): TModalResult;
GetUnitsAndDepsForCompsnull211 function GetUnitsAndDepsForComps(ComponentClasses: TClassList;
212 out PackageList: TPackagePackageArray; out UnitList: TStringList): TModalResult;
213 public
214 constructor Create(TheOwner: TComponent); override;
215 destructor Destroy; override;
216
217 // initialization and menu
218 procedure ConnectMainBarEvents; override;
219 procedure ConnectSourceNotebookEvents; override;
220 procedure SetupMainBarShortCuts; override;
221 procedure SetRecentPackagesMenu; override;
222 procedure AddToMenuRecentPackages(const Filename: string);
223 procedure SaveSettings; override;
224 procedure ProcessCommand(Command: word; var Handled: boolean); override;
225 procedure OnSourceEditorPopupMenu(const AddMenuItemProc: TAddMenuItemProc); override;
226 procedure TranslateResourceStrings; override;
227
228 // files
GetDefaultSaveDirectoryForFilenull229 function GetDefaultSaveDirectoryForFile(const Filename: string): string; override;
OnRenameFilenull230 function OnRenameFile(const OldFilename, NewFilename: string;
231 IsPartOfProject: boolean): TModalResult; override;
FindIncludeFileInProjectDependenciesnull232 function FindIncludeFileInProjectDependencies(aProject: TProject;
233 const Filename: string): string; override;
GetOwnersOfUnitnull234 function GetOwnersOfUnit(const UnitFilename: string): TFPList; override;
235 procedure ExtendOwnerListWithUsedByOwners(OwnerList: TFPList); override;
GetSourceFilesOfOwnersnull236 function GetSourceFilesOfOwners(OwnerList: TFPList): TStrings; override;
GetUnitsOfOwnersnull237 function GetUnitsOfOwners(OwnerList: TFPList; Flags: TPkgIntfGatherUnitTypes): TStrings; override;
GetPossibleOwnersOfUnitnull238 function GetPossibleOwnersOfUnit(const UnitFilename: string;
239 Flags: TPkgIntfOwnerSearchFlags): TFPList; override;
GetPackageOfCurrentSourceEditornull240 function GetPackageOfCurrentSourceEditor(out APackage: TIDEPackage): TPkgFile;
GetPackageOfSourceEditornull241 function GetPackageOfSourceEditor(out APackage: TIDEPackage; ASrcEdit: TObject): TLazPackageFile; override;
FindVirtualUnitSourcenull242 function FindVirtualUnitSource(PkgFile: TPkgFile): string;
SearchFilenull243 function SearchFile(const AFilename: string;
244 SearchFlags: TSearchIDEFileFlags;
245 InObject: TObject): TPkgFile; override;
SearchUnitInDesigntimePackagesnull246 function SearchUnitInDesigntimePackages(const AnUnitName: string;
247 InObject: TObject): TPkgFile; override;
ShowFindInPackageFilesDlgnull248 function ShowFindInPackageFilesDlg(APackage: TLazPackage): TModalResult;
249
250 // package graph
AddPackageToGraphnull251 function AddPackageToGraph(APackage: TLazPackage): TModalResult;
252 procedure DoShowPackageGraph(Show: boolean);
253 procedure DoShowPackageGraphPathList(PathList: TFPList); override;
CheckUserSearchPathsnull254 function CheckUserSearchPaths(aCompilerOptions: TBaseCompilerOptions): TModalResult; override;
255 procedure LazarusSrcDirChanged; override;
GetPackageCountnull256 function GetPackageCount: integer; override;
GetPackagesnull257 function GetPackages(Index: integer): TIDEPackage; override;
FindPackageWithNamenull258 function FindPackageWithName(const PkgName: string; IgnorePackage: TIDEPackage = nil): TIDEPackage; override;
FindInstalledPackageWithUnitnull259 function FindInstalledPackageWithUnit(const AnUnitName: string
260 ): TIDEPackage; override;
IsPackageInstallednull261 function IsPackageInstalled(const PkgName: string): TIDEPackage; override;
IsOwnerDependingOnPkgnull262 function IsOwnerDependingOnPkg(AnOwner: TObject; const PkgName: string;
263 out DependencyOwner: TObject): boolean; override;
264 procedure GetRequiredPackages(AnOwner: TObject; out PkgList: TFPList;
265 Flags: TPkgIntfRequiredFlags = []); override;
AddDependencyToOwnersnull266 function AddDependencyToOwners(OwnerList: TFPList; APackage: TIDEPackage;
267 OnlyTestIfPossible: boolean = false): TModalResult; override;
AddDependencyToUnitOwnersnull268 function AddDependencyToUnitOwners(const OwnedFilename,
269 RequiredUnitname: string): TModalResult; override;
RedirectPackageDependencynull270 function RedirectPackageDependency(APackage: TIDEPackage): TIDEPackage; override;
271 procedure GetPackagesChangedOnDisk(out ListOfPackages: TStringList; IgnoreModifiedFlag: boolean = False); override;
RevertPackagesnull272 function RevertPackages(APackageList: TStringList): TModalResult; override;
273
274 // project
OpenProjectDependenciesnull275 function OpenProjectDependencies(AProject: TProject;
276 ReportMissing: boolean): TModalResult; override;
CheckProjectHasInstalledPackagesnull277 function CheckProjectHasInstalledPackages(AProject: TProject;
278 Interactive: boolean): TModalResult; override;
CanOpenDesignerFormnull279 function CanOpenDesignerForm(AnUnitInfo: TUnitInfo;
280 Interactive: boolean): TModalResult; override;
AddProjectDependencynull281 function AddProjectDependency(AProject: TProject; APackage: TLazPackage;
282 OnlyTestIfPossible: boolean = false): TModalResult; override;
AddProjectDependencynull283 function AddProjectDependency(AProject: TProject;
284 ADependency: TPkgDependency): TModalResult; override;
AddProjectDependenciesnull285 function AddProjectDependencies(AProject: TProject; const Packages: string;
286 OnlyTestIfPossible: boolean = false): TModalResult; override;
ProjectInspectorAddDependencynull287 function ProjectInspectorAddDependency(Sender: TObject;
288 ADependency: TPkgDependency): TModalResult; override;
ProjectInspectorRemoveDependencynull289 function ProjectInspectorRemoveDependency(Sender: TObject;
290 ADependency: TPkgDependency): TModalResult; override;
ProjectInspectorReAddDependencynull291 function ProjectInspectorReAddDependency(Sender: TObject;
292 ADependency: TPkgDependency): TModalResult; override;
293 procedure ProjectInspectorDragDropTreeView(Sender, Source: TObject;
294 X, Y: Integer); override;
ProjectInspectorDragOverTreeViewnull295 function ProjectInspectorDragOverTreeView(Sender, Source: TObject;
296 X, Y: Integer; out TargetTVNode: TTreeNode;
297 out TargetTVType: TTreeViewInsertMarkType): boolean; override;
298 procedure ProjectInspectorCopyMoveFiles(Sender: TObject); override;
299
300 // package editors
CanClosePackageEditornull301 function CanClosePackageEditor(APackage: TLazPackage): TModalResult; override;
CanCloseAllPackageEditorsnull302 function CanCloseAllPackageEditors: TModalResult; override;
DoOpenPkgFilenull303 function DoOpenPkgFile(PkgFile: TPkgFile): TModalResult;
DoNewPackagenull304 function DoNewPackage: TModalResult; override;
DoShowLoadedPkgDlgnull305 function DoShowLoadedPkgDlg: TModalResult; override;
DoOpenPackagenull306 function DoOpenPackage(APackage: TLazPackage; Flags: TPkgOpenFlags;
307 ShowAbort: boolean): TModalResult; override;
DoOpenPackageWithNamenull308 function DoOpenPackageWithName(const APackageName: string;
309 Flags: TPkgOpenFlags; ShowAbort: boolean): TModalResult; override;
DoOpenPackageFilenull310 function DoOpenPackageFile(AFilename: string;
311 Flags: TPkgOpenFlags;
312 ShowAbort: boolean): TModalResult; override;
IsPackageEditorFormnull313 function IsPackageEditorForm(AForm: TCustomForm): boolean; override;
314 procedure OpenHiddenModifiedPackages; override;
DoSavePackagenull315 function DoSavePackage(APackage: TLazPackage;
316 Flags: TPkgSaveFlags): TModalResult; override;
DoSaveAllPackagesnull317 function DoSaveAllPackages(Flags: TPkgSaveFlags): TModalResult; override;
DoClosePackageEditornull318 function DoClosePackageEditor(APackage: TLazPackage): TModalResult; override;
DoCloseAllPackageEditorsnull319 function DoCloseAllPackageEditors: TModalResult; override;
DoAddActiveUnitToAPackagenull320 function DoAddActiveUnitToAPackage: TModalResult;
DoNewPackageComponentnull321 function DoNewPackageComponent: TModalResult;
SavePackageFilesnull322 function SavePackageFiles(APackage: TLazPackage): TModalResult;
WarnAboutMissingPackageFilesnull323 function WarnAboutMissingPackageFiles(APackage: TLazPackage): TModalResult;
AddPackageDependencynull324 function AddPackageDependency(APackage: TLazPackage; const ReqPackage: string;
325 OnlyTestIfPossible: boolean = false): TModalResult; override;
ApplyDependencynull326 function ApplyDependency(CurDependency: TPkgDependency): TModalResult; override;
GetPackageOfEditorItemnull327 function GetPackageOfEditorItem(Sender: TObject): TIDEPackage; override;
328
329 // package compilation
DoCompileProjectDependenciesnull330 function DoCompileProjectDependencies(AProject: TProject;
331 Flags: TPkgCompileFlags): TModalResult; override;
DoCompilePackagenull332 function DoCompilePackage(APackage: TIDEPackage; Flags: TPkgCompileFlags;
333 ShowAbort: boolean): TModalResult; override;
DoCreatePackageMakefilenull334 function DoCreatePackageMakefile(APackage: TLazPackage;
335 ShowAbort: boolean): TModalResult;
DoCreatePackageFpmakefilenull336 function DoCreatePackageFpmakefile(APackage: TLazPackage;
337 ShowAbort: boolean): TModalResult;
338
339 // package installation
340 procedure LoadInstalledPackages; override;
341 procedure UnloadInstalledPackages;
DoInstallPackagenull342 function DoInstallPackage(APackage: TLazPackage): TModalResult;
DoUninstallPackagenull343 function DoUninstallPackage(APackage: TLazPackage;
344 Flags: TPkgUninstallFlags; ShowAbort: boolean): TModalResult;
CheckInstallPackageListnull345 function CheckInstallPackageList(PkgIDList: TObjectList;
346 Flags: TPkgInstallInIDEFlags = []
347 ): boolean; override;
InstallPackagesnull348 function InstallPackages(PkgIdList: TObjectList;
349 Flags: TPkgInstallInIDEFlags = []): TModalResult; override;
UninstallPackagenull350 function UninstallPackage(APackage: TIDEPackage; ShowAbort: boolean): TModalResult; override;
351 procedure DoTranslatePackage(APackage: TLazPackage);
DoOpenPackageSourcenull352 function DoOpenPackageSource(APackage: TLazPackage): TModalResult;
DoCompileAutoInstallPackagesnull353 function DoCompileAutoInstallPackages(Flags: TPkgCompileFlags;
354 OnlyBase: boolean): TModalResult; override;
DoSaveAutoInstallConfignull355 function DoSaveAutoInstallConfig: TModalResult; override;
DoPublishPackagenull356 function DoPublishPackage(APackage: TLazPackage; Flags: TPkgSaveFlags;
357 ShowDialog: boolean): TModalResult;
358
359 // components
AddUnitDepsForCompClassesnull360 function AddUnitDepsForCompClasses(const UnitFilename: string;
361 ComponentClasses: TClassList; Quiet: boolean): TModalResult; override;
362 { function GetMissingDependenciesForUnit(const UnitFilename: string;
363 ComponentClassnames: TStrings;
364 var List: TOwnerPackageArray): TModalResult;
365 }
GetUsableComponentUnitsnull366 function GetUsableComponentUnits(CurRoot: TPersistent): TFPList; override; // list of TUnitInfo
367 procedure IterateComponentNames(CurRoot: TPersistent; TypeData: PTypeData;
368 Proc: TGetStrProc); override;
FindUsableComponentnull369 function FindUsableComponent(CurRoot: TPersistent;
370 const ComponentPath: string): TComponent; override;
FindReferencedRootComponentnull371 function FindReferencedRootComponent(CurRoot: TPersistent;
372 const ComponentName: string): TComponent; override;
373 end;
374
375
376 { TLazPackageDescriptors }
377
378 TLazPackageDescriptors = class(TPackageDescriptors)
379 private
380 fDestroying: boolean;
381 fItems: TFPList; // list of TProjectDescriptor
382 protected
GetItemsnull383 function GetItems(Index: integer): TPackageDescriptor; override;
384 public
385 constructor Create;
386 destructor Destroy; override;
Countnull387 function Count: integer; override;
GetUniqueNamenull388 function GetUniqueName(const Name: string): string; override;
IndexOfnull389 function IndexOf(const Name: string): integer; override;
FindByNamenull390 function FindByName(const Name: string): TPackageDescriptor; override;
391 procedure RegisterDescriptor(Descriptor: TPackageDescriptor); override;
392 procedure UnregisterDescriptor(Descriptor: TPackageDescriptor); override;
393 procedure AddDefaultPackageDescriptors;
394 public
395 property Items[Index: integer]: TPackageDescriptor read GetItems; default;
396 end;
397
398
399 { TPackageDescriptorStd }
400
401 TPackageDescriptorStd = class(TPackageDescriptor)
402 public
403 constructor Create; override;
GetLocalizedNamenull404 function GetLocalizedName: string; override;
GetLocalizedDescriptionnull405 function GetLocalizedDescription: string; override;
406 end;
407
408 var
409 LazPackageDescriptors: TLazPackageDescriptors;
410
411 implementation
412
413 const
414 constNewPackageName = 'NewPackage'; //must be valid Pascal identifier, thus should not be allowed to be translated
415
416 { TPkgManager }
417
418 procedure TPkgManager.MainIDEitmPkgOpenPackageFileClick(Sender: TObject);
419 var
420 OpenDialog: TOpenDialog;
421 AFilename: string;
422 I: Integer;
423 OpenFlags: TPkgOpenFlags;
424 begin
425 OpenDialog:=TOpenDialog.Create(nil);
426 try
427 InputHistories.ApplyFileDialogSettings(OpenDialog);
428 OpenDialog.Title:=lisOpenPackageFile;
429 OpenDialog.Options:=OpenDialog.Options+[ofAllowMultiSelect];
430 OpenDialog.Filter:=dlgFilterLazarusPackage+' (*.lpk)|*.lpk'
431 +'|'+dlgFilterAll+' ('+FileMask+')|'+FileMask;
432 if OpenDialog.Execute and (OpenDialog.Files.Count>0) then begin
433 OpenFlags:=[pofAddToRecent];
434 For I := 0 to OpenDialog.Files.Count-1 do
435 Begin
436 AFilename:=CleanAndExpandFilename(OpenDialog.Files.Strings[i]);
437 if i<OpenDialog.Files.Count-1 then
438 Include(OpenFlags,pofMultiOpen)
439 else
440 Exclude(OpenFlags,pofMultiOpen);
441 if DoOpenPackageFile(AFilename,OpenFlags,true)=mrAbort then begin
442 break;
443 end;
444 end;
445 end;
446 InputHistories.StoreFileDialogSettings(OpenDialog);
447 finally
448 OpenDialog.Free;
449 end;
450 end;
451
452 procedure TPkgManager.MainIDEitmPkgPkgGraphClick(Sender: TObject);
453 begin
454 DoShowPackageGraph(true);
455 end;
456
457 procedure TPkgManager.MainIDEitmPkgEditInstallPkgsClick(Sender: TObject);
458 var
459 RebuildIDE: Boolean;
460 PkgIDList: TObjectList;
461 Flags: TPkgInstallInIDEFlags;
462 begin
463 RebuildIDE:=false;
464 PkgIDList:=nil;
465 try
466 if ShowEditInstallPkgsDialog(PackageGraph.FirstAutoInstallDependency,
467 @CheckInstallPackageListHandler,PkgIDList,RebuildIDE)<>mrOk
468 then exit;
469
470 Flags:=[piiifSkipChecks,piiifClear];
471 if RebuildIDE then Include(Flags,piiifRebuildIDE);
472 InstallPackages(PkgIDList,Flags);
473 finally
474 PkgIDList.Free;
475 end;
476 end;
477
478 procedure TPkgManager.IDEComponentPaletteOpenPackage(Sender: TObject);
479 begin
480 if (Sender=nil) or (not (Sender is TLazPackage)) then exit;
481 DoOpenPackage(TLazPackage(Sender),[],false);
482 end;
483
484 procedure TPkgManager.IDEComponentPaletteOpenUnit(Sender: TObject);
485 var
486 PkgComponent: TPkgComponent;
487 PkgFile: TPkgFile;
488 Filename: String;
489 begin
490 if (Sender=nil) then exit;
491 if (Sender is TPkgFile) then
492 DoOpenPkgFile(TPkgFile(Sender))
493 else if (Sender is TPkgComponent) then begin
494 PkgComponent:=TPkgComponent(Sender);
495 PkgFile:=PkgComponent.PkgFile;
496 if PkgFile=nil then exit;
497 Filename:='';
498 if PkgFile.FileType=pftVirtualUnit then
499 Filename:=FindVirtualUnitSource(PkgFile);
500 if Filename='' then
501 Filename:=PkgFile.GetFullFilename;
502 MainIDE.DoOpenFileAndJumpToIdentifier(
503 Filename,PkgComponent.ComponentClass.ClassName,
504 -1, -1, // open page somewhere
505 [ofOnlyIfExists,ofAddToRecent,ofRegularFile,ofConvertMacros]);
506 end;
507 end;
508
509 procedure TPkgManager.GetDependencyOwnerDescription(
510 Dependency: TPkgDependency; out Description: string);
511 begin
512 GetDescriptionOfDependencyOwner(Dependency,Description);
513 end;
514
515 procedure TPkgManager.GetDependencyOwnerDirectory(Dependency: TPkgDependency;
516 out Directory: string);
517 begin
518 GetDirectoryOfDependencyOwner(Dependency,Directory);
519 end;
520
521 procedure TPkgManager.PackageFileLoaded(Sender: TObject);
522 begin
523 DoCallNotifyHandler(pihtPackageFileLoaded,Sender);
524 end;
525
526 procedure TPkgManager.CheckInstallPackageListHandler(PkgIDList: TObjectList;
527 RemoveConflicts: boolean; out Ok: boolean);
528 var
529 Flags: TPkgInstallInIDEFlags;
530 begin
531 Flags:=[];
532 if RemoveConflicts then
533 Include(Flags,piiifRemoveConflicts);
534 Ok:=CheckInstallPackageList(PkgIDList,Flags);
535 if Ok then
536 SaveAutoInstallDependencies;
537 end;
538
DoBeforeCompilePackagesnull539 function TPkgManager.DoBeforeCompilePackages(aPkgList: TFPList): TModalResult;
540 // called before a bunch of packages are compiled
541
GetIgnorePkgOutDirIDnull542 function GetIgnorePkgOutDirID(CurPkg: TLazPackage): string;
543 begin
544 Result:='PkgOutDir#'+CurPkg.Filename+':'+CurPkg.GetOutputDirectory;
545 end;
546
547 var
548 PkgWithProjOverriddenOutDirs: TFPList;
549 i: Integer;
550 CurPkg: TLazPackage;
551 OutDir: String;
552 IgnoreItem: TIgnoreIDEQuestionItem;
553 s: String;
554 begin
555 Result:=mrOk;
556 if MainIDEBar=nil then exit; // not interactive
557 if InputHistories=nil then exit;
558
559 if not Assigned(OnGetOutputDirectoryOverride) then exit;
560 PkgWithProjOverriddenOutDirs:=TFPList.Create;
561 try
562 for i:=0 to aPkgList.Count-1 do
563 begin
564 CurPkg:=TLazPackage(aPkgList[i]);
565 OutDir:='';
566 OnGetOutputDirectoryOverride(CurPkg,OutDir,[bmgtProject,bmgtSession]);
567 if OutDir<>'' then begin
568 IgnoreItem:=InputHistories.Ignores.Find(GetIgnorePkgOutDirID(CurPkg));
569 if (IgnoreItem=nil) then
570 PkgWithProjOverriddenOutDirs.Add(CurPkg);
571 end;
572 end;
573 if PkgWithProjOverriddenOutDirs.Count>0 then
574 begin
575 s:='';
576 for i:=0 to PkgWithProjOverriddenOutDirs.Count-1 do begin
577 CurPkg:=TLazPackage(PkgWithProjOverriddenOutDirs[i]);
578 OutDir:=CreateRelativePath(CurPkg.GetOutputDirectory,CurPkg.Directory);
579 s+=CurPkg.Name+': '+OutDir+LineEnding;
580 end;
581 if IDEMessageDialog(lisConfirmation,
582 Format(lisPkgTheProjectOverridesTheOutputDirectoryOfTheFollowin,
583 [LineEnding, LineEnding+LineEnding, s]),
584 mtWarning, [mbOk, mbCancel])<>mrOk
585 then
586 exit(mrCancel);
587 // remember the answer
588 for i:=0 to PkgWithProjOverriddenOutDirs.Count-1 do begin
589 CurPkg:=TLazPackage(PkgWithProjOverriddenOutDirs[i]);
590 InputHistories.Ignores.Add(GetIgnorePkgOutDirID(CurPkg),iiidForever);
591 end;
592 end;
593 finally
594 PkgWithProjOverriddenOutDirs.Free;
595 end;
596 end;
597
LoadDependencyListnull598 function TPkgManager.LoadDependencyList(FirstDependency: TPkgDependency;
599 Quiet: boolean): TModalResult;
600 var
601 CurDependency: TPkgDependency;
602 OpenResult: TLoadPackageResult;
603 begin
604 Result:=mrCancel;
605 // load all packages
606 CurDependency:=FirstDependency;
607 while CurDependency<>nil do begin
608 OpenResult:=PackageGraph.OpenDependency(CurDependency,false);
609 if OpenResult<>lprSuccess then begin
610 if not Quiet then
611 IDEMessageDialog(lisCCOErrorCaption,
612 Format(lisUnableToLoadPackage, [CurDependency.AsString]),
613 mtError,[mbCancel]);
614 exit;
615 end;
616 CurDependency:=CurDependency.NextRequiresDependency;
617 end;
618 Result:=mrOk;
619 end;
620
621 procedure TPkgManager.OpenPackageForCurrentSrcEditFile(Sender: TObject);
622 var
623 APackage: TIDEPackage;
624 begin
625 GetPackageOfCurrentSourceEditor(APackage);
626 if APackage is TLazPackage then
627 DoOpenPackage(TLazPackage(APackage),[],false);
628 end;
629
630 procedure TPkgManager.CreateIDEWindow(Sender: TObject; aFormName: string; var
631 AForm: TCustomForm; DoDisableAutoSizing: boolean);
632 var
633 APackageName: String;
634 NewDependency: TPkgDependency;
635 APackage: TLazPackage;
636 LoadResult: TLoadPackageResult;
637 begin
638 //debugln(['TPkgManager.CreateIDEWindow ',aFormName]);
639 if SysUtils.CompareText(aFormName,NonModalIDEWindowNames[nmiwPkgGraphExplorer])=0
640 then begin
641 DoShowPackageGraph(false);
642 AForm:=PackageGraphExplorer;
643 if DoDisableAutoSizing then
644 AForm.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TPkgManager.CreateIDEWindow'){$ENDIF};
645 end else if SysUtils.CompareText(PackageEditorWindowPrefix,
646 copy(aFormName,1,length(PackageEditorWindowPrefix)))=0
647 then begin
648 APackageName:=copy(aFormName,length(PackageEditorWindowPrefix)+1,length(aFormName));
649 if not IsValidPkgName(APackageName) then exit;
650 NewDependency:=TPkgDependency.Create;
651 try
652 NewDependency.PackageName:=APackageName;
653 NewDependency.DependencyType:=pdtLazarus;
654 LoadResult:=PackageGraph.OpenDependency(NewDependency,false);
655 if LoadResult<>lprSuccess then exit;
656 finally
657 NewDependency.Free;
658 end;
659 APackage:=PackageGraph.FindPackageWithName(APackageName,nil);
660 if APackage=nil then exit;
661 AForm:=PackageEditors.CreateEditor(APackage,DoDisableAutoSizing);
662 end;
663 end;
664
665 procedure TPkgManager.MainIDEitmPkgAddCurFileToPkgClick(Sender: TObject);
666 begin
667 DoAddActiveUnitToAPackage;
668 end;
669
670 procedure TPkgManager.MainIDEitmPkgNewComponentClick(Sender: TObject);
671 begin
672 DoNewPackageComponent;
673 end;
674
675 procedure TPkgManager.MainIDEitmPkgOpenPackageOfCurUnitClicked(Sender: TObject);
676 var
677 ActiveSourceEditor: TSourceEditorInterface;
678 ActiveUnitInfo: TUnitInfo;
679 PkgFile: TPkgFile;
680 begin
681 MainIDE.GetCurrentUnitInfo(ActiveSourceEditor,ActiveUnitInfo);
682 if ActiveSourceEditor=nil then exit;
683 PkgFile:=PackageGraph.FindFileInAllPackages(ActiveUnitInfo.Filename,true,
684 not ActiveUnitInfo.IsPartOfProject);
685 if PkgFile=nil then
686 IDEMessageDialog(lisProjAddPackageNotFound,
687 lisPkgThisFileIsNotInAnyLoadedPackage, mtInformation, [mbCancel])
688 else
689 DoOpenPackageFile(PkgFile.LazPackage.Filename,[pofAddToRecent],false);
690 end;
691
692 procedure TPkgManager.AfterWritePackage(Sender: TObject; Restore: boolean);
693 var
694 Pkg: TLazPackage;
695 begin
696 Pkg := (Sender as TPackageIDEOptions).Package;
697 //debugln(['TPkgManager.AfterWritePackage ',Pkg, ' Restore=',Restore]);
698 Pkg.DefineTemplates.AllChanged(false);
699 if Restore then
700 Pkg.RestoreOptions;
701 end;
702
703 procedure TPkgManager.BeforeReadPackage(Sender: TObject);
704 begin
705 (Sender as TPackageIDEOptions).Package.BackupOptions;
706 end;
707
TPkgManager.PackageEditorCompilePackagenull708 function TPkgManager.PackageEditorCompilePackage(Sender: TObject;
709 APackage: TLazPackage; CompileClean, CompileRequired: boolean): TModalResult;
710 var
711 Flags: TPkgCompileFlags;
712 begin
713 Flags:=[];
714 if CompileClean then Include(Flags,pcfCleanCompile);
715 if CompileRequired then Include(Flags,pcfCompileDependenciesClean);
716 //debugln('TPkgManager.OnPackageEditorCompilePackage OS=',Globals.TargetOS);
717 Result:=DoCompilePackage(APackage,Flags,false);
718 end;
719
720 procedure TPkgManager.PackageEditorCopyMoveFiles(Sender: TObject);
721 begin
722 CopyMoveFiles(Sender);
723 end;
724
TPkgManager.PackageEditorCreateMakefilenull725 function TPkgManager.PackageEditorCreateMakefile(Sender: TObject;
726 APackage: TLazPackage): TModalResult;
727 begin
728 Result:=DoCreatePackageMakefile(APackage,false);
729 end;
730
TPkgManager.PackageEditorCreateFpmakeFilenull731 function TPkgManager.PackageEditorCreateFpmakeFile(Sender: TObject;
732 APackage: TLazPackage): TModalResult;
733 begin
734 Result:=DoCreatePackageFpmakefile(APackage,false);
735 end;
736
737 {$IFDEF UseLRS}
738 procedure TPkgManager.AddToIconResource(const aIconFile, aResName: string);
739 var
740 BinFileStream: TFileStream;
741 ResMemStream: TMemoryStream;
742 ResType: String;
743 OldLen, NewLen: integer;
744 begin
745 try
746 BinFileStream:=TFileStream.Create(aIconFile,fmOpenRead);
747 try
748 ResMemStream:=TMemoryStream.Create;
749 try
750 Assert(BinFileStream.Position=0, 'TPkgManager.AddToIconResource: Stream.Position > 0');
751 ResType:=UpperCase(ExtractFileExt(aIconFile));
752 if ResType<>'' then
753 Delete(ResType, 1, 1);
754 BinaryToLazarusResourceCode(BinFileStream,ResMemStream,aResName,ResType);
755 ResMemStream.Position:=0;
756 OldLen:=Length(FIconLRSSource);
757 NewLen:=ResMemStream.Size;
758 if NewLen>0 then begin
759 SetLength(FIconLRSSource,OldLen+NewLen);
760 ResMemStream.Read(FIconLRSSource[OldLen+1],NewLen);
761 end;
762 finally
763 ResMemStream.Free;
764 end;
765 finally
766 BinFileStream.Free;
767 end;
768 except
769 on E: Exception do begin
770 MessageDlg(lisCCOErrorCaption,
771 Format(lisErrorLoadingFile2,[aIconFile]) + LineEnding + E.Message,
772 mtError, [mbCancel], 0);
773 end;
774 end;
775 end;
776 {$ELSE}
777 // ToDo: Use FPC's resource type (.res)
778 {$ENDIF}
779
PackageEditorCreateFilenull780 function TPkgManager.PackageEditorCreateFile(Sender: TObject;
781 Params: TAddToPkgResult): TModalResult;
782 var
783 LE: String;
784 UsesLine: String;
785 NewSource: String;
786 UnitDirectives: String;
787 IconLRSFilename: String;
788 ResName: String;
789 CodeBuf: TCodeBuffer;
790 begin
791 Result:=mrCancel;
792 // create icon resource
793 if Params.IconNormFile<>'' then
794 begin
795 IconLRSFilename:=ChangeFileExt(Params.UnitFilename,'')+'_icon.lrs';
796 CodeBuf:=CodeToolBoss.CreateFile(IconLRSFilename);
797 if CodeBuf=nil then begin
798 debugln(['Error: (lazarus) [TPkgManager.PackageEditorCreateFile] file create failed: ',IconLRSFilename]);
799 exit;
800 end;
801 FIconLRSSource:='';
802 ResName:=ExtractFileNameOnly(Params.NewClassName);
803 AddToIconResource(Params.IconNormFile, ResName);
804 if Params.Icon150File<>'' then
805 AddToIconResource(Params.Icon150File, ResName+'_150');
806 if Params.Icon200File<>'' then
807 AddToIconResource(Params.Icon200File, ResName+'_200');
808 CodeBuf.Source:=FIconLRSSource;
809 Result:=SaveCodeBuffer(CodeBuf);
810 if Result<>mrOk then exit;
811 end
812 else
813 IconLRSFilename:='';
814 // create sourcecode
815 UsesLine:='Classes, SysUtils';
816 if PackageGraph.FindDependencyRecursively(Params.Pkg.FirstRequiredDependency,'LCL')<>nil
817 then
818 UsesLine:=UsesLine+', LResources, Forms, Controls, Graphics, Dialogs';
819 if (System.Pos(Params.UsedUnitname,UsesLine)<1) and (Params.UsedUnitname<>'') then
820 UsesLine:=UsesLine+', '+Params.UsedUnitname;
821 UnitDirectives:='{$mode objfpc}{$H+}';
822 if Params.Pkg<>nil then
823 UnitDirectives:=TFileDescPascalUnit.CompilerOptionsToUnitDirectives(
824 Params.Pkg.CompilerOptions);
825 LE:=LineEnding;
826 NewSource:=
827 'unit '+Params.Unit_Name+';'+LE
828 +LE
829 +UnitDirectives+LE
830 +LE
831 +'interface'+LE
832 +LE
833 +'uses'+LE
834 +' '+UsesLine+';'+LE
835 +LE
836 +'type'+LE
837 +' '+Params.NewClassName+' = class('+Params.AncestorType+')'+LE
838 +' private'+LE
839 +LE
840 +' protected'+LE
841 +LE
842 +' public'+LE
843 +LE
844 +' published'+LE
845 +LE
846 +' end;'+LE
847 +LE
848 +'procedure Register;'+LE
849 +LE
850 +'implementation'+LE
851 +LE
852 +'procedure Register;'+LE
853 +'begin'+LE;
854 if IconLRSFilename<>'' then
855 NewSource:=NewSource
856 +' {$I '+ExtractFileName(IconLRSFilename)+'}'+LE;
857 NewSource:=NewSource
858 +' RegisterComponents('''+Params.PageName+''',['+Params.NewClassName+']);'+LE
859 +'end;'+LE
860 +LE
861 +'end.'+LE;
862
863 FileDescriptorUnit.Owner:=Params.Pkg;
864 try
865 Result:=MainIDE.DoNewEditorFile(FileDescriptorUnit,
866 Params.UnitFilename,NewSource,
867 [nfOpenInEditor,nfIsNotPartOfProject,nfSave,nfAddToRecent]);
868 finally
869 FileDescriptorUnit.Owner:=nil;
870 end;
871 end;
872
PackageEditorDeleteAmbiguousFilesnull873 function TPkgManager.PackageEditorDeleteAmbiguousFiles(Sender: TObject;
874 APackage: TLazPackage; const Filename: string): TModalResult;
875 begin
876 Result:=BuildBoss.DeleteAmbiguousFiles(Filename);
877 end;
878
879 procedure TPkgManager.PackageEditorDragDropTreeView(Sender, Source: TObject;
880 X, Y: Integer);
881 begin
882 FilesEditDragDrop(Sender, Source, X, Y);
883 end;
884
PackageEditorDragOverTreeViewnull885 function TPkgManager.PackageEditorDragOverTreeView(Sender, Source: TObject;
886 X, Y: Integer; out TargetTVNode: TTreeNode;
887 out TargetTVType: TTreeViewInsertMarkType): boolean;
888 var
889 aFileCount: integer;
890 aDependencyCount: integer;
891 aDirectoryCount: integer;
892 TargetFilesEdit: IFilesEditorInterface;
893 SrcFilesEdit: IFilesEditorInterface;
894 begin
895 Result:=CheckDrag(Sender, Source, X, Y, TargetFilesEdit, SrcFilesEdit, aFileCount,
896 aDependencyCount, aDirectoryCount, TargetTVNode, TargetTVType);
897 end;
898
PackageEditorFindInFilesnull899 function TPkgManager.PackageEditorFindInFiles(Sender: TObject;
900 APackage: TLazPackage): TModalResult;
901 begin
902 Result:=ShowFindInPackageFilesDlg(APackage);
903 end;
904
PackageEditorAddToProjectnull905 function TPkgManager.PackageEditorAddToProject(Sender: TObject;
906 APackage: TLazPackage; OnlyTestIfPossible: boolean): TModalResult;
907 begin
908 Result:=AddProjectDependency(Project1,APackage,OnlyTestIfPossible);
909 end;
910
PackageEditorInstallPackagenull911 function TPkgManager.PackageEditorInstallPackage(Sender: TObject;
912 APackage: TLazPackage): TModalResult;
913 begin
914 Result:=DoInstallPackage(APackage);
915 end;
916
PackageEditorPublishPackagenull917 function TPkgManager.PackageEditorPublishPackage(Sender: TObject;
918 APackage: TLazPackage): TModalResult;
919 begin
920 Result:=DoPublishPackage(APackage,[],true);
921 end;
922
PackageEditorRevertPackagenull923 function TPkgManager.PackageEditorRevertPackage(Sender: TObject;
924 APackage: TLazPackage): TModalResult;
925 begin
926 if (not FilenameIsAbsolute(APackage.Filename))
927 or (not FileExistsUTF8(APackage.Filename)) then
928 exit(mrCancel);
929 Result:=DoOpenPackageFile(APackage.Filename,[pofRevert],false);
930 end;
931
PackageEditorUninstallPackagenull932 function TPkgManager.PackageEditorUninstallPackage(Sender: TObject;
933 APackage: TLazPackage): TModalResult;
934 begin
935 Result:=DoUninstallPackage(APackage,[],false);
936 end;
937
PackageEditorOpenPkgFilenull938 function TPkgManager.PackageEditorOpenPkgFile(Sender: TObject;
939 PkgFile: TPkgFile): TModalResult;
940 begin
941 Result:=DoOpenPkgFile(PkgFile);
942 end;
943
944 procedure TPkgManager.PackageEditorFreeEditor(APackage: TLazPackage);
945 begin
946 APackage.Editor:=nil;
947 PackageGraph.ClosePackage(APackage);
948 end;
949
PackageGraphCheckInterPkgFilesnull950 function TPkgManager.PackageGraphCheckInterPkgFiles(IDEObject: TObject;
951 PkgList: TFPList; out FilesChanged: boolean): boolean;
952 begin
953 Result:=CheckInterPkgFiles(IDEObject,PkgList,FilesChanged);
954 end;
955
PackageEditorOpenPackagenull956 function TPkgManager.PackageEditorOpenPackage(Sender: TObject;
957 APackage: TLazPackage): TModalResult;
958 begin
959 Result:=DoOpenPackage(APackage,[],false);
960 end;
961
PackageEditorSavePackagenull962 function TPkgManager.PackageEditorSavePackage(Sender: TObject;
963 APackage: TLazPackage; SaveAs: boolean): TModalResult;
964 begin
965 if SaveAs then
966 Result:=DoSavePackage(APackage,[psfSaveAs])
967 else
968 Result:=DoSavePackage(APackage,[]);
969 end;
970
PackageEditorViewPkgSourcenull971 function TPkgManager.PackageEditorViewPkgSource(Sender: TObject;
972 APackage: TLazPackage): TModalResult;
973 begin
974 Result:=DoOpenPackageSource(APackage);
975 end;
976
977 procedure TPkgManager.PackageGraphBeginUpdate(Sender: TObject);
978 begin
979 if PackageGraphExplorer<>nil then PackageGraphExplorer.BeginUpdate;
980 end;
981
982 procedure TPkgManager.PackageGraphChangePackageName(APackage: TLazPackage;
983 const OldName: string);
984 begin
985 if PackageGraphExplorer<>nil then
986 PackageGraphExplorer.UpdatePackageName(APackage,OldName);
987 end;
988
989 procedure TPkgManager.PackageGraphDeletePackage(APackage: TLazPackage);
990 begin
991 if APackage.Editor<>nil then begin
992 APackage.Editor.Hide;
993 APackage.Editor.Free;
994 end;
995 end;
996
997 procedure TPkgManager.PackageGraphDependencyModified(ADependency: TPkgDependency);
998 var
999 DepOwner: TObject;
1000 begin
1001 DepOwner:=ADependency.Owner;
1002 if DepOwner is TLazPackage then
1003 TLazPackage(DepOwner).Modified:=true
1004 else if DepOwner is TProject then
1005 TProject(DepOwner).Modified:=true;
1006 end;
1007
PackageGraphExplorerOpenPackagenull1008 function TPkgManager.PackageGraphExplorerOpenPackage(Sender: TObject;
1009 APackage: TLazPackage): TModalResult;
1010 begin
1011 Result:=DoOpenPackage(APackage,[pofAddToRecent],false);
1012 end;
1013
PackageGraphExplorerOpenProjectnull1014 function TPkgManager.PackageGraphExplorerOpenProject(Sender: TObject;
1015 AProject: TProject): TModalResult;
1016 begin
1017 if AProject<>Project1 then exit(mrCancel);
1018 MainIDE.DoShowProjectInspector;
1019 Result:=mrOk;
1020 end;
1021
1022 procedure TPkgManager.PackageGraphAddPackage(Pkg: TLazPackage);
1023 begin
1024 if FileExistsUTF8(Pkg.FileName) then LazPackageLinks.AddUserLink(Pkg);
1025 if PackageGraphExplorer<>nil then
1026 PackageGraphExplorer.UpdatePackageAdded(Pkg);
1027 end;
1028
1029 procedure TPkgManager.PackageGraphEndUpdate(Sender: TObject; GraphChanged: boolean);
1030 begin
1031 if GraphChanged then IncreaseCompilerParseStamp;
1032 if PackageGraphExplorer<>nil then begin
1033 if GraphChanged then PackageGraphExplorer.UpdateAll;
1034 PackageGraphExplorer.EndUpdate;
1035 end;
1036 if GraphChanged then begin
1037 if PackageEditors<>nil then
1038 PackageEditors.UpdateAllEditors(false);
1039 if ProjInspector<>nil then
1040 ProjInspector.UpdateRequiredPackages;
1041 DoCallNotifyHandler(pihtGraphChanged,Self);
1042 end;
1043 end;
1044
1045 procedure TPkgManager.PackageGraphFindFPCUnit(const AUnitName,
1046 Directory: string; var Filename: string);
1047 begin
1048 if (Directory<>'') and not FilenameIsAbsolute(Directory) then
1049 RaiseGDBException(Directory);
1050 //DebugLn('TPkgManager.PackageGraphFindFPCUnit "',Directory,'"');
1051 Filename:=CodeToolBoss.DirectoryCachePool.FindUnitInUnitLinks(Directory, AUnitName);
1052 end;
1053
PackageGraphExplorerUninstallPackagenull1054 function TPkgManager.PackageGraphExplorerUninstallPackage(Sender: TObject;
1055 APackage: TLazPackage): TModalResult;
1056 begin
1057 Result:=DoUninstallPackage(APackage,[],false);
1058 end;
1059
1060 procedure TPkgManager.MainIDEitmPkgNewPackageClick(Sender: TObject);
1061 begin
1062 DoNewPackage;
1063 end;
1064
1065 procedure TPkgManager.MainIDEitmPkgOpenLoadedPackageClicked(Sender: TObject);
1066 begin
1067 DoShowLoadedPkgDlg;
1068 end;
1069
1070 procedure TPkgManager.MainIDEitmPackageLinksClicked(Sender: TObject);
1071 begin
1072 ShowPackageLinks;
1073 end;
1074
1075 procedure TPkgManager.MainIDEitmOpenRecentPackageClicked(Sender: TObject);
1076
1077 procedure UpdateEnvironment;
1078 begin
1079 SetRecentPackagesMenu;
1080 MainIDE.SaveEnvironment;
1081 end;
1082
1083 var
1084 AFilename: string;
1085 begin
1086 // Hint holds the full filename, Caption may have a shortened form.
1087 AFileName:=(Sender as TIDEMenuItem).Hint;
1088 if DoOpenPackageFile(AFilename,[pofAddToRecent],false)=mrOk then begin
1089 UpdateEnvironment;
1090 end else begin
1091 // open failed
1092 if not FileExistsUTF8(AFilename) then begin
1093 // file does not exist -> delete it from recent file list
1094 EnvironmentOptions.RemoveFromRecentPackageFiles(AFilename);
1095 UpdateEnvironment;
1096 end;
1097 end;
1098 end;
1099
1100 procedure TPkgManager.ApplicationIdleHandler(Sender: TObject; var Done: Boolean);
1101 begin
1102 if PackageGraph = nil then Exit;
1103 if MainIDE.ToolStatus<>itNone then exit;
1104 if (Screen.ActiveCustomForm<>nil)
1105 and (fsModal in Screen.ActiveCustomForm.FormState) then exit;
1106 PackageGraph.CloseUnneededPackages;
1107 end;
1108
DoShowSavePackageAsDialognull1109 function TPkgManager.DoShowSavePackageAsDialog(APackage: TLazPackage): TModalResult;
1110 var
1111 OldPkgFilename: String;
1112 SaveDialog: TSaveDialog;
1113 NewFileName: String;
1114 NewPkgName: String;
1115 ConflictPkg: TLazPackage;
1116 PkgFile: TPkgFile;
1117 LowerFilename: String;
1118 BrokenDependencies: TFPList;
1119 RenameDependencies: Boolean;
1120 OldPkgName: String;
1121 NewMainUnitFileName: String;
1122
1123 procedure RenamePackageInProject;
1124 var
1125 AProject: TProject;
1126 OldUnitName: String;
1127 NewUnitName: String;
1128 begin
1129 AProject:=Project1;
1130 if (pfMainUnitIsPascalSource in AProject.Flags)
1131 and (AProject.MainUnitInfo<>nil) then begin
1132 OldUnitName:=OldPkgName;
1133 NewUnitName:=APackage.Name;
1134 if (OldUnitName<>NewUnitName) then begin
1135 MainIDE.SaveSourceEditorChangesToCodeCache(nil);
1136 if CodeToolBoss.RenameUsedUnit(
1137 AProject.MainUnitInfo.Source,OldUnitName,NewUnitName,'')
1138 then
1139 AProject.MainUnitInfo.Modified:=true;
1140 end;
1141 end;
1142 end;
1143
1144 begin
1145 OldPkgFilename:=APackage.Filename;
1146 OldPkgName:=APackage.Name;
1147
1148 SaveDialog:=TSaveDialog.Create(nil);
1149 try
1150 InputHistories.ApplyFileDialogSettings(SaveDialog);
1151 SaveDialog.Title:=Format(lisPkgMangSavePackageLpk, [APackage.IDAsString]);
1152 SaveDialog.Filter:=dlgFilterLazarusPackage+' (*.lpk)|*.lpk'
1153 +'|'+dlgFilterAll+' ('+FileMask+')|'+FileMask;
1154 if APackage.HasDirectory then
1155 SaveDialog.InitialDir:=APackage.Directory;
1156
1157 // build a nice package filename suggestion
1158 NewFileName:=APackage.Name+'.lpk';
1159 SaveDialog.FileName:=NewFileName;
1160
1161 repeat
1162 Result:=mrCancel;
1163
1164 if not SaveDialog.Execute then begin
1165 // user cancels
1166 Result:=mrCancel;
1167 exit;
1168 end;
1169 NewFileName:=CleanAndExpandFilename(SaveDialog.Filename);
1170 NewPkgName:=ExtractFileNameOnly(NewFilename);
1171 if APackage.MainUnitHasPkgName then
1172 NewMainUnitFileName:=ChangeFileExt(NewFileName,'.pas')
1173 else
1174 NewMainUnitFileName:='';
1175
1176 if PackageEditors.FindEditor(NewPkgName) <> nil then
1177 begin
1178 Result:=IDEMessageDialog(lisPkgMangInvalidPackageName,
1179 Format(lisPkgMangSaveAsAlreadyOpenedPackage, [NewPkgName]),
1180 mtInformation,[mbRetry,mbAbort]);
1181 if Result=mrAbort then exit;
1182 continue; // try again
1183 end;
1184
1185 // check file extension
1186 if ExtractFileExt(NewFilename)='' then begin
1187 // append extension
1188 NewFileName:=NewFileName+'.lpk';
1189 end
1190 else if not FilenameExtIs(NewFilename,'.lpk',true) then begin
1191 Result:=IDEMessageDialog(lisPkgMangInvalidPackageFileExtension,
1192 lisPkgMangPackagesMustHaveTheExtensionLpk,
1193 mtInformation,[mbRetry,mbAbort]);
1194 if Result=mrAbort then exit;
1195 continue; // try again
1196 end;
1197
1198 // check filename
1199 if not IsValidPkgName(NewPkgName) then begin
1200 Result:=IDEMessageDialog(lisPkgMangInvalidPackageName,
1201 Format(lisPkgMangThePackageNameIsNotAValidPackageNamePleaseChooseAn,
1202 [NewPkgName, LineEnding]),
1203 mtInformation,[mbRetry,mbAbort]);
1204 if Result=mrAbort then exit;
1205 continue; // try again
1206 end;
1207
1208 // apply naming conventions
1209
1210 if lowercase(NewPkgName) <> NewPkgName then
1211 begin
1212 LowerFilename:=ExtractFilePath(NewFilename)+lowercase(ExtractFileName(NewFilename));
1213 case EnvironmentOptions.CharcaseFileAction of
1214 ccfaAsk:
1215 if IDEMessageDialog(lisPkgMangRenameFileLowercase,
1216 Format(lisPkgMangShouldTheFileRenamedLowercaseTo,[LineEnding, LowerFilename]),
1217 mtConfirmation,[mbYes,mbNo])=mrYes
1218 then
1219 NewFileName:=LowerFilename;
1220 ccfaAutoRename: NewFileName:=LowerFilename;
1221 ccfaIgnore: ;
1222 end;
1223 end;
1224
1225 // check unit name conflict
1226 if NewMainUnitFileName<>'' then
1227 begin
1228 PkgFile:=APackage.FindUnit(NewPkgName);
1229 if PkgFile<>nil then begin
1230 Result:=IDEMessageDialog(lisNameConflict,
1231 lisThePackageAlreadyContainsAUnitWithThisName,
1232 mtWarning,[mbRetry,mbAbort]);
1233 if Result=mrAbort then exit;
1234 continue; // try again
1235 end;
1236 end;
1237
1238 // check package name conflict
1239 ConflictPkg:=PackageGraph.FindPackageWithName(NewPkgName,APackage);
1240 if ConflictPkg<>nil then begin
1241 Result:=IDEMessageDialog(lisPkgMangPackageNameAlreadyExists,
1242 Format(lisPkgMangThereIsAlreadyAnotherPackageWithTheName,
1243 [NewPkgName, LineEnding, ConflictPkg.IDAsString, LineEnding, ConflictPkg.Filename]),
1244 mtInformation,[mbRetry,mbAbort,mbIgnore]);
1245 if Result=mrAbort then exit;
1246 if Result<>mrIgnore then continue; // try again
1247 end;
1248
1249 // check file name conflict with project
1250 if (NewMainUnitFileName<>'')
1251 and (Project1.ProjectUnitWithFilename(NewMainUnitFileName)<>nil) then begin
1252 Result:=IDEMessageDialog(lisPkgMangFilenameIsUsedByProject,
1253 Format(lisPkgMangTheFileNameIsPartOfTheCurrentProject,[NewFilename,LineEnding]),
1254 mtInformation,[mbRetry,mbAbort]);
1255 if Result=mrAbort then exit;
1256 continue; // try again
1257 end;
1258
1259 // check file name conflicts with files in other packages
1260 if (NewMainUnitFileName<>'') then
1261 begin
1262 PkgFile:=PackageGraph.FindFileInAllPackages(NewMainUnitFileName,true,false);
1263 if PkgFile<>nil then begin
1264 Result:=IDEMessageDialog(lisPkgMangFilenameIsUsedByOtherPackage,
1265 Format(lisPkgMangTheFileNameIsUsedByThePackageInFile, [NewFilename, LineEnding,
1266 PkgFile.LazPackage.IDAsString, LineEnding, PkgFile.LazPackage.Filename]),
1267 mtWarning,[mbRetry,mbAbort]);
1268 if Result=mrAbort then exit;
1269 continue; // try again
1270 end;
1271 end;
1272
1273 // check for broken dependencies
1274 BrokenDependencies:=PackageGraph.GetBrokenDependenciesWhenChangingPkgID(
1275 APackage,NewPkgName,APackage.Version);
1276 RenameDependencies:=false;
1277 try
1278 if BrokenDependencies.Count>0 then begin
1279 Result:=ShowBrokenDependencies(BrokenDependencies);
1280 if Result=mrOK then // = Yes
1281 RenameDependencies:=true
1282 else if Result<>mrClose then // <> Ignore
1283 exit;
1284 end;
1285 finally
1286 BrokenDependencies.Free;
1287 end;
1288
1289 // check existing file
1290 if (CompareFilenames(NewFileName,OldPkgFilename)<>0) then
1291 begin
1292 if FileExistsUTF8(NewFileName) then begin
1293 Result:=IDEMessageDialog(lisPkgMangReplaceFile,
1294 Format(lisPkgMangReplaceExistingFile, [NewFilename]),
1295 mtConfirmation,[mbOk,mbCancel]);
1296 if Result<>mrOk then exit;
1297 end;
1298 if FileExistsUTF8(NewMainUnitFileName) then
1299 begin
1300 Result:=IDEMessageDialog(lisPkgMangReplaceFile,
1301 Format(lisPkgMangReplaceExistingFile, [NewFilename]),
1302 mtConfirmation,[mbOk,mbCancel]);
1303 if Result<>mrOk then exit;
1304 end;
1305 end;
1306
1307 // check if new file is read/writable
1308 Result:=CheckCreatingFile(NewFileName,true);
1309 if Result=mrAbort then exit;
1310
1311 until Result<>mrRetry;
1312 finally
1313 InputHistories.StoreFileDialogSettings(SaveDialog);
1314 SaveDialog.Free;
1315 end;
1316
1317 // set filename
1318 APackage.Filename:=NewFilename;
1319 if Assigned(APackage.Editor) then
1320 APackage.Editor.LazPackage := APackage;//force package editor name change!
1321
1322 // rename package
1323 PackageGraph.ChangePackageID(APackage,NewPkgName,APackage.Version,
1324 RenameDependencies,true);
1325 SaveAutoInstallDependencies;
1326 RenamePackageInProject;
1327
1328 //update LastOpenPackages list
1329 EnvironmentOptions.LastOpenPackages.Remove(OldPkgFilename);
1330 EnvironmentOptions.LastOpenPackages.Add(NewFileName);
1331 MainIDE.SaveEnvironment;
1332
1333 // clean up old package file to reduce ambiguousities
1334 if FileExistsUTF8(OldPkgFilename)
1335 and (CompareFilenames(OldPkgFilename,NewFilename)<>0) then begin
1336 if IDEMessageDialog(lisPkgMangDeleteOldPackageFile,
1337 Format(lisPkgMangDeleteOldPackageFile2, [OldPkgFilename]),
1338 mtConfirmation,[mbYes,mbNo])=mrYes
1339 then begin
1340 if DeleteFileUTF8(OldPkgFilename) then begin
1341 RemoveFromRecentList(OldPkgFilename,
1342 EnvironmentOptions.RecentPackageFiles,rltFile);
1343 end else begin
1344 IDEMessageDialog(lisPkgMangDeleteFailed,
1345 Format(lisPkgMangUnableToDeleteFile, [OldPkgFilename]), mtError, [mbOk]);
1346 end;
1347 end;
1348 end;
1349
1350 // success
1351 Result:=mrOk;
1352 end;
1353
CheckPackageGraphForCompilationnull1354 function TPkgManager.CheckPackageGraphForCompilation(APackage: TLazPackage;
1355 FirstDependency: TPkgDependency; const Directory: string; ShowAbort: boolean
1356 ): TModalResult;
1357 var
1358 PathList: TFPList;
1359 Dependency: TPkgDependency;
1360 PkgFile1,PkgFile2: TPkgFile;
1361 ConflictPkg: TLazPackage;
1362 s: String;
1363 Btns: TMsgDlgButtons;
1364 PkgList: TFPList;
1365 i: Integer;
1366 begin
1367 {$IFDEF VerbosePkgCompile}
1368 debugln('TPkgManager.CheckPackageGraphForCompilation A');
1369 {$ENDIF}
1370 if ShowAbort
1371 then Btns := [mbCancel] // will be replaced to Ignore
1372 else Btns := [mbOK];
1373 PathList:=nil;
1374 PkgList:=nil;
1375 try
1376 // check for unsaved packages
1377 PathList:=PackageGraph.FindUnsavedDependencyPath(APackage,FirstDependency);
1378 if PathList<>nil then begin
1379 DoShowPackageGraphPathList(PathList);
1380 Result:=IDEMessageDialogAb(lisPkgMangUnsavedPackage,
1381 lisPkgMangThereIsAnUnsavedPackageInTheRequiredPackages,
1382 mtError,[mbCancel],ShowAbort);
1383 exit;
1384 end;
1385
1386 // check for broken dependencies
1387 PathList:=PackageGraph.FindBrokenDependencyPath(APackage,FirstDependency);
1388 if PathList<>nil then begin
1389 if (PathList.Count=1) then begin
1390 Dependency:=TPkgDependency(PathList[0]);
1391 if Dependency is TPkgDependency then begin
1392 // check if project
1393 if Dependency.Owner is TProject then begin
1394 MainIDE.DoShowProjectInspector;
1395 Result:=IDEMessageDialogAb(lisPkgMangBrokenDependency,
1396 Format(lisPkgMangTheProjectRequiresThePackageButItWasNotFound,
1397 [Dependency.AsString, LineEnding]),
1398 mtError,Btns,ShowAbort);
1399 if not ShowAbort then
1400 Result := mrCancel; // User confirmed error, implicitly cancel the action
1401 exit;
1402 end;
1403 end;
1404 end;
1405 DoShowPackageGraphPathList(PathList);
1406 Result:=IDEMessageDialogAb(lisPkgMangBrokenDependency,
1407 lisPkgMangRequiredPackagesWereNotFound,
1408 mtError,Btns,ShowAbort);
1409 if not ShowAbort then
1410 Result := mrCancel; // User confirmed error, implicitly cancel the action
1411 exit;
1412 end;
1413
1414 // check for cycle dependencies
1415 PathList:=PackageGraph.FindCycleDependencyPath(APackage,FirstDependency);
1416 if PathList<>nil then begin
1417 DoShowPackageGraphPathList(PathList);
1418 Result:=IDEMessageDialogAb(lisPkgMangCircularDependencies,
1419 lisPkgMangThereIsACircularDependency,
1420 mtError,Btns,ShowAbort);
1421 if not ShowAbort then
1422 Result := mrCancel; // User confirmed error, implicitly cancel the action
1423 exit;
1424 end;
1425
1426 // check for all used package with wrong
1427 PackageGraph.GetAllRequiredPackages(APackage,FirstDependency,PkgList);
1428 if (PkgList<>nil) then begin
1429 for i:=0 to PkgList.Count-1 do begin
1430 Result:=CheckUserSearchPaths(TLazPackage(PkgList[i]).CompilerOptions);
1431 if Result<>mrOk then
1432 exit(mrCancel);
1433 end;
1434 end;
1435
1436 // check for a package that compiles to the default FPC search path
1437 PathList:=PackageGraph.FindPkgOutputInFPCSearchPath(APackage,FirstDependency);
1438 if PathList<>nil then begin
1439 ConflictPkg:=TObject(PathList[PathList.Count-1]) as TLazPackage;
1440 DoShowPackageGraphPathList(PathList);
1441 Result:=IDEMessageDialogAb(lisPkgMangCircularDependencies,
1442 Format(lisPkgMangThePackageIsCompiledAutomaticallyAndItsOutputDirec,
1443 [ConflictPkg.Name, ConflictPkg.GetOutputDirectory, LineEnding+LineEnding, LineEnding]),
1444 mtError,Btns,ShowAbort);
1445 if not ShowAbort then
1446 Result := mrCancel; // User confirmed error, implicitly cancel the action
1447 exit;
1448 end;
1449
1450 // check for ambiguous units between packages
1451 if PackageGraph.FindAmbiguousUnits(APackage,FirstDependency,
1452 PkgFile1,PkgFile2,ConflictPkg)
1453 then begin
1454 if (PkgFile1<>nil) and (PkgFile2<>nil) then begin
1455 s:=Format(lisPkgMangThereAreTwoUnitsWithTheSameName1From2From,
1456 [LineEnding+LineEnding, PkgFile1.Filename, PkgFile1.LazPackage.IDAsString,
1457 LineEnding, PkgFile2.Filename, PkgFile2.LazPackage.IDAsString]) + LineEnding;
1458 end else if (PkgFile1<>nil) and (ConflictPkg<>nil) then begin
1459 s:=Format(lisPkgMangThereIsAUnitWithTheSameNameAsAPackage1From2,
1460 [LineEnding+LineEnding, PkgFile1.Filename, PkgFile1.LazPackage.IDAsString,
1461 LineEnding, ConflictPkg.IDAsString]) + LineEnding;
1462 end else
1463 s:='Internal inconsistency FindAmbiguousUnits: '
1464 +'Please report this bug and how you got here.'+LineEnding;
1465 Result:=IDEMessageDialogAb(lisPkgMangAmbiguousUnitsFound, Format(
1466 lisPkgMangBothPackagesAreConnectedThisMeansEitherOnePackageU, [s]),
1467 mtError,Btns,ShowAbort);
1468 if not ShowAbort then
1469 Result := mrCancel; // User confirmed error, implicitly cancel the action
1470 exit;
1471 end;
1472
1473 // check for ambiguous units between packages and FPC units
1474 if PackageGraph.FindFPCConflictUnit(APackage,FirstDependency,Directory,
1475 @PackageGraphFindFPCUnit,PkgFile1,ConflictPkg)
1476 then begin
1477 if (ConflictPkg<>nil) then begin
1478 s:=Format(lisPkgMangThereIsAFPCUnitWithTheSameNameAsAPackage,
1479 [LineEnding+LineEnding, ConflictPkg.IDAsString]) + LineEnding;
1480 end else if (PkgFile1<>nil) then begin
1481 s:=Format(lisPkgMangThereIsAFPCUnitWithTheSameNameFrom,
1482 [LineEnding+LineEnding, PkgFile1.Filename, PkgFile1.LazPackage.IDAsString]) + LineEnding;
1483 end else
1484 s:='Internal inconsistency FindFPCConflictUnits: '
1485 +'Please report this bug and how you got here.'+LineEnding;
1486 Result:=IDEMessageDialogAb(lisPkgMangAmbiguousUnitsFound, s,
1487 mtError,Btns,ShowAbort);
1488 if not ShowAbort then
1489 Result := mrCancel; // User confirmed error, implicitly cancel the action
1490 exit;
1491 end;
1492
1493 finally
1494 PkgList.Free;
1495 PathList.Free;
1496 end;
1497
1498 {$IFDEF VerbosePkgCompile}
1499 debugln('TPkgManager.CheckPackageGraphForCompilation END');
1500 {$ENDIF}
1501 Result:=mrOk;
1502 end;
1503
1504 procedure TPkgManager.SaveAutoInstallDependencies;
1505 var
1506 Dependency: TPkgDependency;
1507 sl: TStringListUTF8Fast;
1508 begin
1509 sl:=TStringListUTF8Fast.Create;
1510 Dependency:=PackageGraph.FirstAutoInstallDependency;
1511 while Dependency<>nil do begin
1512 if (Dependency.LoadPackageResult=lprSuccess)
1513 and (not Dependency.RequiredPackage.Missing)
1514 and (not PackageGraph.IsStaticBasePackage(Dependency.PackageName))
1515 and (not (Dependency.RequiredPackage.PackageType in [lptRunTime,lptRunTimeOnly]))
1516 then begin
1517 if sl.IndexOf(Dependency.PackageName)<0 then begin
1518 sl.Add(Dependency.PackageName);
1519 //DebugLn('TPkgManager.SaveAutoInstallDependencies A ',Dependency.PackageName);
1520 end;
1521 end;
1522 Dependency:=Dependency.NextRequiresDependency;
1523 end;
1524 MiscellaneousOptions.BuildLazProfiles.StaticAutoInstallPackages.Assign(sl);
1525 MiscellaneousOptions.Save;
1526 sl.Free;
1527 end;
1528
1529 procedure TPkgManager.LoadStaticCustomPackages;
1530 var
1531 StaticPackages: TFPList;
1532 StaticPackage: PRegisteredPackage;
1533 i: Integer;
1534 APackage: TLazPackage;
1535 Quiet: Boolean;
1536 begin
1537 StaticPackages:=LazarusPackageIntf.RegisteredPackages;
1538 if StaticPackages=nil then exit;
1539 Quiet:=false;
1540
1541 // register IDE's FCL components
1542
1543 // register components in Lazarus packages
1544 for i:=0 to StaticPackages.Count-1 do begin
1545 StaticPackage:=PRegisteredPackage(StaticPackages[i]);
1546 //debugln(['TPkgManager.LoadStaticCustomPackages ',StaticPackage^.Name]);
1547
1548 // check package name
1549 if not IsValidPkgName(StaticPackage^.Name)
1550 then begin
1551 DebugLn('Warning: (lazarus) [TPkgManager.LoadStaticCustomPackages] Invalid Package Name: "',
1552 BinaryStrToText(StaticPackage^.Name),'"');
1553 continue;
1554 end;
1555
1556 // check RegisterFCLBaseComponents procedure
1557 if (StaticPackage^.RegisterProc=nil) then begin
1558 DebugLn('Warning: (lazarus) [TPkgManager.LoadStaticCustomPackages]',
1559 ' Package "',StaticPackage^.Name,'" has no register procedure.');
1560 continue;
1561 end;
1562
1563 // load package
1564 APackage:=LoadInstalledPackage(StaticPackage^.Name,KeepInstalledPackages,Quiet);
1565
1566 PackageGraph.RegisterStaticPackage(APackage,StaticPackage^.RegisterProc);
1567 end;
1568 PackageGraph.SortAutoInstallDependencies;
1569 ClearRegisteredPackages;
1570 end;
1571
LoadInstalledPackagenull1572 function TPkgManager.LoadInstalledPackage(const PackageName: string;
1573 AddToAutoInstall: boolean; var Quiet: boolean): TLazPackage;
1574 var
1575 NewDependency: TPkgDependency;
1576 PackageList: TStringList;
1577 begin
1578 //DebugLn('TPkgManager.LoadInstalledPackage PackageName="',PackageName,'" Quiet=',Quiet);
1579 NewDependency:=TPkgDependency.Create;
1580 NewDependency.Owner:=Self;
1581 NewDependency.DependencyType:=pdtLazarus;
1582 NewDependency.PackageName:=PackageName;
1583 PackageGraph.OpenInstalledDependency(NewDependency,pitStatic,Quiet);
1584 Result:=NewDependency.RequiredPackage;
1585 if AddToAutoInstall and (Result<>nil) then begin
1586 if FindDependencyByNameInList(
1587 PackageGraph.FirstAutoInstallDependency,pddRequires,PackageName)=nil
1588 then begin
1589 NewDependency.RequiredPackage.AutoInstall:=pitStatic;
1590 NewDependency.AddToList(PackageGraph.FirstAutoInstallDependency,pddRequires)
1591 end else
1592 NewDependency.Free;
1593 PackageList:=MiscellaneousOptions.BuildLazProfiles.StaticAutoInstallPackages;
1594 if PackageList.IndexOf(PackageName)<0 then
1595 PackageList.Add(PackageName);
1596 end else begin
1597 NewDependency.Free;
1598 end;
1599 end;
1600
1601 procedure TPkgManager.LoadAutoInstallPackages;
1602 begin
1603 FLastLazarusSrcDir:=EnvironmentOptions.GetParsedLazarusDirectory;
1604 PackageGraph.LoadAutoInstallPackages(
1605 MiscellaneousOptions.BuildLazProfiles.StaticAutoInstallPackages);
1606 end;
1607
1608 procedure TPkgManager.AddUnitToProjectMainUsesSection(AProject: TProject;
1609 const AnUnitName, AnUnitInFilename: string);
1610 begin
1611 // add unit to project main source file
1612 if (pfMainUnitIsPascalSource in AProject.Flags)
1613 and (pfMainUnitHasUsesSectionForAllUnits in AProject.Flags)
1614 and (AProject.MainUnitInfo<>nil) then begin
1615 //debugln('TPkgManager.AddUnitToProjectMainUsesSection B ',AnUnitName);
1616 if (AnUnitName<>'') then begin
1617 MainIDE.SaveSourceEditorChangesToCodeCache(nil);
1618 if CodeToolBoss.AddUnitToMainUsesSectionIfNeeded(
1619 AProject.MainUnitInfo.Source,AnUnitName,AnUnitInFilename)
1620 then
1621 AProject.MainUnitInfo.Modified:=true;
1622 end;
1623 end;
1624 end;
1625
CheckDragnull1626 function TPkgManager.CheckDrag(Sender, Source: TObject; X, Y: Integer; out
1627 SrcFilesEdit, TargetFilesEdit: IFilesEditorInterface; out aFileCount,
1628 aDependencyCount, aDirectoryCount: integer; out TargetTVNode: TTreeNode; out
1629 TargetTVType: TTreeViewInsertMarkType): boolean;
1630
1631 function GetFilesEditIntf(o: TObject): IFilesEditorInterface;
1632 var
1633 PkgEdit: TPackageEditorForm;
1634 aProjInsp: TProjectInspectorForm;
1635 begin
1636 Result:=nil;
1637 if o is TTreeView then begin
1638 PkgEdit:=PackageEditors.TreeViewToPkgEditor(TTreeView(o));
1639 if PkgEdit<>nil then
1640 Result:=PkgEdit
1641 else begin
1642 aProjInsp:=ProjInspector.TreeViewToInspector(TTreeView(o));
1643 if aProjInsp<>nil then
1644 Result:=aProjInsp;
1645 end;
1646 end;
1647 end;
1648
1649 var
1650 i: Integer;
1651 TVNode: TTreeNode;
1652 NodeData: TPENodeData;
1653 Item: TObject;
1654 Directory: String;
1655 TV: TTreeView;
1656 begin
1657 Result:=false;
1658 SrcFilesEdit:=nil;
1659 TargetFilesEdit:=nil;
1660 aFileCount:=0;
1661 aDependencyCount:=0;
1662 aDirectoryCount:=0;
1663 TargetTVNode:=nil;
1664 TargetTVType:=tvimNone;
1665
1666 // get source
1667 SrcFilesEdit:=GetFilesEditIntf(Source);
1668 if (SrcFilesEdit=nil) then begin
1669 {$IFDEF VerbosePkgEditDrag}
1670 debugln(['TPkgManager.CheckDrag failed: unknown src=',DbgSName(Source)]);
1671 {$ENDIF}
1672 exit;
1673 end;
1674 if SrcFilesEdit.FilesOwnerReadOnly
1675 or (not FilenameIsAbsolute(SrcFilesEdit.FilesBaseDirectory)) then begin
1676 {$IFDEF VerbosePkgEditDrag}
1677 debugln(['TPkgManager.CheckDrag failed: src=',DbgSName(SrcFilesEdit.FilesOwner),' readonly=',SrcFilesEdit.FilesOwnerReadOnly,' basedir=',SrcFilesEdit.FilesBaseDirectory]);
1678 {$ENDIF}
1679 exit;
1680 end;
1681
1682 // get target
1683 TargetFilesEdit:=GetFilesEditIntf(Sender);
1684 if (TargetFilesEdit=nil) then begin
1685 {$IFDEF VerbosePkgEditDrag}
1686 debugln(['TPkgManager.CheckDrag failed: unknown target=',DbgSName(Sender)]);
1687 {$ENDIF}
1688 exit;
1689 end;
1690 if TargetFilesEdit.FilesOwnerReadOnly
1691 or (not FilenameIsAbsolute(TargetFilesEdit.FilesBaseDirectory)) then begin
1692 {$IFDEF VerbosePkgEditDrag}
1693 debugln(['TPkgManager.CheckDrag failed: target=',DbgSName(TargetFilesEdit.FilesOwner),' readonly=',SrcFilesEdit.FilesOwnerReadOnly,' basedir=',SrcFilesEdit.FilesBaseDirectory]);
1694 {$ENDIF}
1695 exit;
1696 end;
1697
1698 //debugln(['TPkgManager.CheckDrag Src=',SrcFilesEdit.FilesOwnerName,' Target=',TargetFilesEdit.FilesOwnerName]);
1699
1700 // check items
1701 aFileCount:=0;
1702 aDependencyCount:=0;
1703 aDirectoryCount:=0;
1704 for i:=0 to SrcFilesEdit.FilesEditTreeView.SelectionCount-1 do begin
1705 TVNode:=SrcFilesEdit.FilesEditTreeView.Selections[i];
1706 if SrcFilesEdit.GetNodeDataItem(TVNode,NodeData,Item) then begin
1707 if NodeData.Removed then exit; // removed things cannot be moved
1708 if Item is TIDEOwnedFile then begin
1709 if (Item is TUnitInfo) and (TUnitInfo(Item)=TUnitInfo(Item).Project.MainUnitInfo)
1710 then
1711 continue;
1712 inc(aFileCount);
1713 end else if Item is TPkgDependency then begin
1714 inc(aDependencyCount);
1715 end;
1716 end else if SrcFilesEdit.IsDirectoryNode(TVNode) then begin
1717 inc(aDirectoryCount);
1718 end;
1719 end;
1720 if aFileCount+aDependencyCount+aDirectoryCount=0 then begin
1721 {$IFDEF VerbosePkgEditDrag}
1722 debugln(['TPkgManager.CheckDrag failed: nothing useful dragged']);
1723 {$ENDIF}
1724 exit;
1725 end;
1726 if aDirectoryCount>0 then begin
1727 {$IFDEF VerbosePkgEditDrag}
1728 debugln(['TPkgManager.CheckDrag failed: move directory is not implemented']);
1729 {$ENDIF}
1730 exit;
1731 end;
1732 if aDependencyCount>0 then begin
1733 {$IFDEF VerbosePkgEditDrag}
1734 debugln(['TPkgManager.CheckDrag failed: move dependency is not implemented']);
1735 {$ENDIF}
1736 exit;
1737 end;
1738 if Sign(aFileCount)+Sign(aDependencyCount)+Sign(aDirectoryCount)>1 then begin
1739 // more than one type, but only one type can be dragged
1740 {$IFDEF VerbosePkgEditDrag}
1741 debugln(['TPkgManager.CheckDrag failed: more than one type Files=',aFileCount,' Deps=',aDependencyCount,' Dirs=',aDirectoryCount]);
1742 {$ENDIF}
1743 exit;
1744 end;
1745
1746 TV:=TargetFilesEdit.FilesEditTreeView;
1747 TargetTVNode:=TV.GetNodeAt(X,Y);
1748 if TargetTVNode=nil then begin
1749 if aDependencyCount>0 then begin
1750 TargetTVNode:=TargetFilesEdit.TVNodeRequiredPackages;
1751 end else begin
1752 TargetTVNode:=TargetFilesEdit.TVNodeFiles;
1753 end;
1754 TargetTVType:=tvimAsFirstChild;
1755 end;
1756 if TargetFilesEdit.GetNodeDataItem(TargetTVNode,NodeData,Item) then begin
1757 // move to specific position is not yet supported
1758 // => redirect to parent nodes
1759 repeat
1760 TargetTVNode:=TargetTVNode.Parent;
1761 if TargetTVNode=nil then
1762 exit;
1763 until (TargetTVNode=TargetFilesEdit.TVNodeFiles)
1764 or (TargetTVNode=TargetFilesEdit.TVNodeRequiredPackages)
1765 or TargetFilesEdit.IsDirectoryNode(TargetTVNode);
1766 TargetTVType:=tvimAsFirstChild;
1767 end;
1768 if TargetFilesEdit.IsDirectoryNode(TargetTVNode)
1769 or (TargetTVNode=TargetFilesEdit.TVNodeFiles)
1770 then begin
1771 Directory:=TargetFilesEdit.GetNodeFilename(TargetTVNode);
1772 if not FilenameIsAbsolute(Directory) then begin
1773 {$IFDEF VerbosePkgEditDrag}
1774 debugln(['TPkgManager.CheckDrag: invalid target directory="',Directory,'"']);
1775 {$ENDIF}
1776 exit;
1777 end;
1778 TargetTVType:=tvimAsFirstChild;
1779 if aFileCount>0 then begin
1780 // drag files
1781 end else if aDirectoryCount>0 then begin
1782 // drag directory
1783 {$IFDEF VerbosePkgEditDrag}
1784 debugln(['TPkgManager.CheckDrag drag directory not implemented yet']);
1785 {$ENDIF}
1786 exit;
1787 end else begin
1788 {$IFDEF VerbosePkgEditDrag}
1789 debugln(['TPkgManager.CheckDrag failed: expected files or directory']);
1790 {$ENDIF}
1791 exit;
1792 end;
1793 end else if TargetTVNode=TargetFilesEdit.TVNodeRequiredPackages then begin
1794 if aDependencyCount=0 then exit;
1795 // drag dependencies
1796 TargetTVType:=tvimAsFirstChild;
1797 {$IFDEF VerbosePkgEditDrag}
1798 debugln(['TPkgManager.CheckDrag drag dependencies not implemented yet']);
1799 {$ENDIF}
1800 exit;
1801 end else begin
1802 {$IFDEF VerbosePkgEditDrag}
1803 debugln(['TPkgManager.CheckDrag failed: invalid target node: ',TargetTVNode.Text]);
1804 {$ENDIF}
1805 exit;
1806 end;
1807
1808 if (SrcFilesEdit=TargetFilesEdit)
1809 and (TargetTVNode.Selected or TargetTVNode.MultiSelected)
1810 then begin
1811 {$IFDEF VerbosePkgEditDrag}
1812 debugln(['TPkgManager.CheckDrag failed: target is selected']);
1813 {$ENDIF}
1814 exit;
1815 end;
1816
1817 Result:=true;
1818 end;
1819
1820 procedure TPkgManager.FilesEditDragDrop(Sender, Source: TObject; X, Y: Integer);
1821 var
1822 aFileCount: integer;
1823 aDependencyCount: integer;
1824 aDirectoryCount: integer;
1825 TargetTVNode: TTreeNode;
1826 TargetTVType: TTreeViewInsertMarkType;
1827 NodeData: TPENodeData;
1828 Item: TObject;
1829 aFile: TIDEOwnedFile;
1830 Directory: String;
1831 SrcFilesEdit: IFilesEditorInterface;
1832 TargetFilesEdit: IFilesEditorInterface;
1833 begin
1834 if not CheckDrag(Sender, Source, X, Y, SrcFilesEdit, TargetFilesEdit,
1835 aFileCount, aDependencyCount, aDirectoryCount, TargetTVNode, TargetTVType)
1836 then begin
1837 ShowMessage('drop failed, dragover was wrong');
1838 exit;
1839 end;
1840
1841 {$IFDEF VerbosePkgEditDrag}
1842 debugln(['TPkgManager.FilesEditDragDrop START Src=',SrcFilesEdit.FilesOwnerName,' Target=',TargetFilesEdit.FilesOwnerName,' FileCount=',aFileCount,' DepCount=',aDependencyCount,' DirCount=',aDirectoryCount]);
1843 {$ENDIF}
1844 if TargetFilesEdit.GetNodeDataItem(TargetTVNode,NodeData,Item) then begin
1845 if Item is TIDEOwnedFile then begin
1846 aFile:=TIDEOwnedFile(Item);
1847 if aFileCount=0 then exit;
1848 // drag files
1849 Directory:=ExtractFilePath(aFile.GetFullFilename);
1850 {$IFDEF VerbosePkgEditDrag}
1851 debugln(['TPkgManager.FilesEditDragDrop drag files to directory of ',aFile.Filename]);
1852 {$ENDIF}
1853 MoveFiles(TargetFilesEdit,SrcFilesEdit,Directory);
1854 end else if Item is TPkgDependency then begin
1855 if aDependencyCount=0 then exit;
1856 // ToDo: drag dependencies
1857 {$IFDEF VerbosePkgEditDrag}
1858 debugln(['TPkgManager.FilesEditDragDrop: drag dependencies']);
1859 {$ENDIF}
1860 ShowMessage('Not implemented yet: drag dependencies');
1861 end;
1862 end else if TargetFilesEdit.IsDirectoryNode(TargetTVNode)
1863 or (TargetTVNode=TargetFilesEdit.TVNodeFiles)
1864 then begin
1865 Directory:=TargetFilesEdit.GetNodeFilename(TargetTVNode);
1866 if aFileCount>0 then begin
1867 // drag files
1868 {$IFDEF VerbosePkgEditDrag}
1869 debugln(['TPkgManager.FilesEditDragDrop drag files to ',TargetFilesEdit.FilesBaseDirectory]);
1870 {$ENDIF}
1871 MoveFiles(TargetFilesEdit,SrcFilesEdit,Directory);
1872 end else if aDirectoryCount>0 then begin
1873 // drag directory
1874 {$IFDEF VerbosePkgEditDrag}
1875 debugln(['TPkgManager.FilesEditDragDrop: drag directory']);
1876 {$ENDIF}
1877 ShowMessage('Not implemented yet: drag directory');
1878 end else begin
1879 ShowMessage('I cannot drag that to a directory');
1880 end;
1881 end else if TargetTVNode=TargetFilesEdit.TVNodeRequiredPackages then begin
1882 if aDependencyCount=0 then exit;
1883 // ToDo: drag dependencies
1884 {$IFDEF VerbosePkgEditDrag}
1885 debugln(['TPkgManager.FilesEditDragDrop: drag dependencies']);
1886 {$ENDIF}
1887 ShowMessage('Not implemented yet: drag dependencies');
1888 end else begin
1889 {$IFDEF VerbosePkgEditDrag}
1890 if TargetTVNode=nil then
1891 debugln(['TPkgManager.FilesEditDragDrop TargetTVNode=nil'])
1892 else
1893 debugln(['TPkgManager.FilesEditDragDrop TargetTVNode="',TargetTVNode.Text,'"']);
1894 {$ENDIF}
1895 end;
1896 {$IFDEF VerbosePkgEditDrag}
1897 debugln(['TPkgManager.FilesEditDragDrop END']);
1898 {$ENDIF}
1899 end;
1900
MoveFilesnull1901 function TPkgManager.MoveFiles(TargetFilesEdit, SrcFilesEdit: IFilesEditorInterface;
1902 TargetDirectory: string): boolean;
1903 var
1904 Files: TFPList; // list of TPkgFile
1905 i: Integer;
1906 TVNode: TTreeNode;
1907 NodeData: TPENodeData;
1908 Item: TObject;
1909 begin
1910 Result:=false;
1911 if not FilenameIsAbsolute(TargetDirectory) then begin
1912 {$IFDEF VerbosePkgEditDrag}
1913 debugln(['TPkgManager.MoveFiles invalid TargetDirectory=',TargetDirectory]);
1914 {$ENDIF}
1915 exit;
1916 end;
1917 {$IFDEF VerbosePkgEditDrag}
1918 debugln(['TPkgManager.MoveFiles Target=',TargetFilesEdit.FilesOwnerName,' Src=',SrcFilesEdit.FilesOwnerName,' Dir="',TargetDirectory,'"']);
1919 {$ENDIF}
1920 Files:=TFPList.Create;
1921 try
1922 for i:=0 to SrcFilesEdit.FilesEditTreeView.SelectionCount-1 do begin
1923 TVNode:=SrcFilesEdit.FilesEditTreeView.Selections[i];
1924 if not SrcFilesEdit.GetNodeDataItem(TVNode, NodeData, Item) then continue;
1925 if NodeData.Removed then continue;
1926 if not (Item is TIDEOwnedFile) then continue;
1927 if (Item is TUnitInfo) and (TUnitInfo(Item)=TUnitInfo(Item).Project.MainUnitInfo)
1928 then
1929 continue;
1930 Files.Add(Item);
1931 end;
1932 if Files.Count=0 then begin
1933 {$IFDEF VerbosePkgEditDrag}
1934 debugln(['TPkgManager.MoveFiles no file feasable for moving']);
1935 {$ENDIF}
1936 exit(true);
1937 end;
1938
1939 Result:=MoveFiles(TargetFilesEdit,SrcFilesEdit,Files,TargetDirectory);
1940 finally
1941 Files.Free;
1942 end;
1943 end;
1944
MoveFilesnull1945 function TPkgManager.MoveFiles(TargetFilesEdit, SrcFilesEdit: IFilesEditorInterface;
1946 IDEFiles: TFPList; TargetDirectory: string): boolean;
1947 var
1948 ChangedFilenames: TFilenameToStringTree; // old to new file name
1949 AllChangedFilenames: TFilenameToStringTree; // including resouce files
1950 NewFileToOldOwnedFile: TFilenameToPointerTree; // filename to TIDEOwnedFile
1951 DeleteOld: Boolean;
1952 UnitFilenameToResFileList: TFilenameToPointerTree; // filename to TStringList
1953 SrcDirToPkg: TFilenameToPointerTree;
1954 SrcPackage, TargetPackage: TLazPackage;
1955 SrcProject, TargetProject: TProject;
1956 SrcIsTarget: Boolean;
1957
1958 procedure DeleteNonExistingPkgFiles;
1959 var
1960 i: Integer;
1961 CurFile: TIDEOwnedFile;
1962 aFilename: String;
1963 begin
1964 // ignore non existing files
1965 for i:=IDEFiles.Count-1 downto 0 do begin
1966 CurFile:=TIDEOwnedFile(IDEFiles[i]);
1967 aFilename:=CurFile.GetFullFilename;
1968 if not FileExistsCached(aFilename) then begin
1969 {$IFDEF VerbosePkgEditDrag}
1970 debugln(['TPkgManager.MoveFiles WARNING: file not found: ',aFilename]);
1971 {$ENDIF}
1972 IDEFiles.Delete(i);
1973 end;
1974
1975 if (CurFile is TUnitInfo) and (TUnitInfo(CurFile)=TUnitInfo(CurFile).Project.MainUnitInfo)
1976 then begin
1977 {$IFDEF VerbosePkgEditDrag}
1978 debugln(['TPkgManager.MoveFiles WARNING: main unit of project cannot be moved: ',aFilename]);
1979 {$ENDIF}
1980 IDEFiles.Delete(i);
1981 end;
1982 end;
1983 end;
1984
1985 function GetPkgProj(FilesEdit: IFilesEditorInterface; out aPkg: TLazPackage;
1986 out aProject: TProject): boolean;
1987 var
1988 MainUnit: TUnitInfo;
1989 Code: TCodeBuffer;
1990 Tool: TCodeTool;
1991 begin
1992 Result:=false;
1993 aPkg:=nil;
1994 aProject:=nil;
1995 if not FilenameIsAbsolute(FilesEdit.FilesBaseDirectory) then begin
1996 {$IFDEF VerbosePkgEditDrag}
1997 debugln(['TPkgManager.MoveFiles base dir not absolute: ',FilesEdit.FilesBaseDirectory]);
1998 {$ENDIF}
1999 exit;
2000 end;
2001
2002 if FilesEdit.FilesOwner is TLazPackage then begin
2003 aPkg:=TLazPackage(FilesEdit.FilesOwner);
2004 Result:=true;
2005 end else if FilesEdit.FilesOwner is TProject then begin
2006 aProject:=TProject(FilesEdit.FilesOwner);
2007 MainUnit:=aProject.MainUnitInfo;
2008 if (MainUnit<>nil) and (pfMainUnitIsPascalSource in aProject.Flags) then
2009 begin
2010 // check project main source for syntax errors
2011 if LoadCodeBuffer(Code,MainUnit.Filename,[lbfUpdateFromDisk,lbfCheckIfText],false)<>mrOk
2012 then exit;
2013 if not CodeToolBoss.Explore(Code,Tool,true) then begin
2014 {$IFDEF VerbosePkgEditDrag}
2015 debugln(['TPkgManager.MoveFiles project main source has errors: ',Code.Filename]);
2016 {$ENDIF}
2017 LazarusIDE.DoJumpToCodeToolBossError;
2018 exit;
2019 end;
2020 end;
2021 Result:=true;
2022 end;
2023 end;
2024
2025 function FileIsUnit(aFile: TIDEOwnedFile): boolean;
2026 begin
2027 if aFile is TPkgFile then
2028 Result:=TPkgFile(aFile).FileType in PkgFileRealUnitTypes
2029 else
2030 Result:=FilenameIsPascalSource(aFile.Filename);
2031 end;
2032
2033 procedure AddResFile(ResFiles: TStringList; ResFile: string);
2034 var
2035 NewResFile: String;
2036 begin
2037 if not FilenameIsAbsolute(ResFile) then exit;
2038 if AllChangedFilenames.Contains(ResFile) then exit;
2039 if IndexInRecentList(ResFiles,rltFile,ResFile)>=0 then exit;
2040 if not FileExistsCached(ResFile) then exit;
2041 ResFiles.Add(ResFile);
2042 NewResFile:=TargetDirectory+ExtractFilename(ResFile);
2043 AllChangedFilenames[ResFile]:=NewResFile;
2044 end;
2045
2046 function CollectFiles(out MoveFileCount: integer): boolean;
2047 var
2048 i: Integer;
2049 aFile: TIDEOwnedFile;
2050 OldFilename: String;
2051 NewFilename: String;
2052 ResFileList: TStringList;
2053 UnitResArr: TUnitResourcefileFormatArr;
2054 j: Integer;
2055 aFilename: String;
2056 S2PItem: PStringToPointerTreeItem;
2057 begin
2058 Result:=false;
2059 MoveFileCount:=0;
2060 for i:=0 to IDEFiles.Count-1 do begin
2061 aFile:=TIDEOwnedFile(IDEFiles[i]);
2062 OldFilename:=aFile.GetFullFilename;
2063 NewFilename:=TargetDirectory+ExtractFilename(OldFilename);
2064
2065 // check if two copied/moved files will get the same new file name
2066 if NewFileToOldOwnedFile.Contains(NewFilename) then begin
2067 IDEMessageDialog(lisConflictDetected,
2068 Format(lisTwoMovedFilesWillHaveTheSameFileNameIn,
2069 [#13, aFile.Filename, #13, TIDEOwnedFile(NewFileToOldOwnedFile[NewFilename]).Filename,
2070 #13, TargetFilesEdit.FilesOwnerName]), mtError, [mbCancel]);
2071 exit;
2072 end;
2073 NewFileToOldOwnedFile[NewFilename]:=aFile;
2074
2075 if CompareFilenames(NewFilename,OldFilename)<>0 then begin
2076 // file be copied/moved to another directory
2077 debugln(['Hint: (lazarus) CollectFiles Old="',OldFilename,'"']);
2078 debugln(['Hint: (lazarus) New="',NewFilename,'"']);
2079 inc(MoveFileCount);
2080 ChangedFilenames[OldFilename]:=NewFilename;
2081 AllChangedFilenames[OldFilename]:=NewFilename;
2082
2083 // check resource file
2084 if FileIsUnit(aFile) then begin
2085 ResFileList:=TStringList.Create;
2086 UnitFilenameToResFileList[OldFilename]:=ResFileList;
2087 AddResFile(ResFileList,ChangeFileExt(OldFilename,'.lfm'));
2088 AddResFile(ResFileList,ChangeFileExt(OldFilename,'.dfm'));
2089 AddResFile(ResFileList,ChangeFileExt(OldFilename,'.lrs'));
2090 UnitResArr:=GetUnitResourcefileFormats;
2091 for j:=0 to length(UnitResArr)-1 do begin
2092 aFilename:=UnitResArr[j].GetUnitResourceFilename(OldFilename,true);
2093 AddResFile(ResFileList,aFilename);
2094 end;
2095 end;
2096 end;
2097 end;
2098
2099 // remove res files, that are in IDEFiles
2100 for S2PItem in UnitFilenameToResFileList do begin
2101 OldFilename:=S2PItem^.Name;
2102 ResFileList:=TStringList(S2PItem^.Value);
2103 for i:=ResFileList.Count-1 downto 0 do begin
2104 if ChangedFilenames.Contains(ResFileList[i]) then
2105 ResFileList.Delete(i);
2106 end;
2107 end;
2108
2109 Result:=true;
2110 end;
2111
2112 function CheckNewFilesDoNotExist: boolean;
2113 var
2114 S2SItem: PStringToStringItem;
2115 OldFilename: String;
2116 NewFilename: String;
2117 ConflictFile: TIDEOwnedFile;
2118 CurName: String;
2119 ShortFilename: String;
2120 r: TModalResult;
2121 i: Integer;
2122 WarnUnitClash: Boolean;
2123 WarnNameClash: Boolean;
2124 Cnt: Integer;
2125 SrcEdit: TSourceEditor;
2126 begin
2127 Result:=false;
2128 WarnUnitClash:=true;
2129 WarnNameClash:=true;
2130 for S2SItem in AllChangedFilenames do begin
2131 OldFilename:=S2SItem^.Name;
2132 NewFilename:=S2SItem^.Value;
2133 if CompareFilenames(OldFilename,NewFilename)=0 then continue;
2134
2135 // check file does not exist
2136 if FileExistsCached(NewFilename) then begin
2137 IDEMessageDialog(lisConflictDetected,
2138 Format(lisThereIsAlreadyAFileIn, [#13, NewFilename, #13,
2139 TargetFilesEdit.FilesOwnerName]), mtError, [mbCancel]);
2140 exit;
2141 end;
2142
2143 // close source editor
2144 repeat
2145 SrcEdit:=SourceEditorManager.SourceEditorIntfWithFilename(NewFilename);
2146 if SrcEdit=nil then break;
2147 if LazarusIDE.DoCloseEditorFile(SrcEdit,[cfSaveFirst,
2148 cfCloseDependencies,cfSaveDependencies])<>mrOk then exit;
2149 until false;
2150
2151 if (not SrcIsTarget) then begin
2152 // warn duplicate names
2153 if FilenameIsPascalUnit(NewFilename) then begin
2154 // warn duplicate unit name
2155 CurName:=ExtractFileNameOnly(NewFilename);
2156 if TargetPackage<>nil then
2157 ConflictFile:=TargetPackage.FindUnit(CurName,true)
2158 else if TargetProject<>nil then
2159 ConflictFile:=TargetProject.UnitWithUnitname(CurName)
2160 else
2161 ConflictFile:=nil;
2162 if (ConflictFile<>nil) and WarnUnitClash then begin
2163 ShortFilename:=NewFilename;
2164 ShortFilename:=CreateRelativePath(ShortFilename,TargetFilesEdit.FilesBaseDirectory);
2165 r:=IDEMessageDialog(lisDuplicateUnit,
2166 Format(lisThereIsAlreadyAUnitInOldNewYouHaveToMakeSur, [
2167 CurName, TargetFilesEdit.FilesOwnerName, #13,
2168 ConflictFile.GetShortFilename(true), #13,
2169 ShortFilename, #13, #13, #13])
2170 ,mtWarning,[mbYes,mbYesToAll,mbCancel]);
2171 case r of
2172 mrYes: ;
2173 mrYesToAll: WarnUnitClash:=false;
2174 else exit;
2175 end;
2176 end;
2177 end else begin
2178 // warn duplicate file
2179 if TargetPackage<>nil then
2180 Cnt:=TargetPackage.FileCount
2181 else if TargetProject<>nil then
2182 Cnt:=TargetProject.FileCount
2183 else
2184 Cnt:=0;
2185 for i:=0 to Cnt-1 do begin
2186 if not WarnNameClash then continue;
2187 if TargetPackage<>nil then
2188 ConflictFile:=TargetPackage.Files[i]
2189 else if TargetProject<>nil then
2190 ConflictFile:=TargetProject.Files[i]
2191 else
2192 continue;
2193 ShortFilename:=ExtractFilename(NewFilename);
2194 CurName:=ExtractFileName(ConflictFile.Filename);
2195 if (UTF8CompareLatinTextFast(CurName,ShortFilename)<>0)
2196 and (CompareFilenames(CurName,ShortFilename)<>0) then
2197 continue;
2198 // name clash on this or other platforms => warn
2199 ShortFilename:=NewFilename;
2200 ShortFilename:=CreateRelativePath(ShortFilename,TargetFilesEdit.FilesBaseDirectory);
2201 r:=IDEMessageDialog(lisDuplicateFileName,
2202 Format(lisThereIsAlreadyAFileInOldNewContinue, [CurName,
2203 TargetFilesEdit.FilesOwnerName, #13,
2204 ConflictFile.GetShortFilename(true), #13,
2205 ShortFilename, #13, #13])
2206 ,mtWarning,[mbYes,mbYesToAll,mbCancel]);
2207 case r of
2208 mrYes: ;
2209 mrYesToAll: WarnNameClash:=false;
2210 else exit;
2211 end;
2212 end;
2213 end;
2214 end;
2215 end;
2216 Result:=true;
2217 end;
2218
2219 function CloseSrcEditors: boolean;
2220 var
2221 i: Integer;
2222 SrcEdit: TSourceEditorInterface;
2223 begin
2224 for i:=SourceEditorManagerIntf.SourceEditorCount-1 downto 0 do begin
2225 SrcEdit:=SourceEditorManagerIntf.SourceEditors[i];
2226 if not AllChangedFilenames.Contains(SrcEdit.FileName) then continue;
2227 if LazarusIDE.DoCloseEditorFile(SrcEdit,
2228 [cfSaveFirst,cfCloseDependencies])<>mrOk
2229 then begin
2230 {$IFDEF VerbosePkgEditDrag}
2231 debugln(['CloseSrcEditors failed']);
2232 {$ENDIF}
2233 exit(false);
2234 end;
2235 end;
2236 Result:=true;
2237 end;
2238
2239 function ClearOldCompiledFiles: boolean;
2240 var
2241 OutDir: String;
2242 CurFiles: TStrings;
2243 OutFilename: String;
2244 CurUnitName: String;
2245 S2SItem: PStringToStringItem;
2246 OldFilename: String;
2247 SeparateOutDir: Boolean;
2248 r: TModalResult;
2249 begin
2250 Result:=false;
2251 // => clear output directory of Src
2252 if SrcPackage<>nil then begin
2253 if PackageGraph.PreparePackageOutputDirectory(SrcPackage,true)<>mrOk then
2254 begin
2255 {$IFDEF VerbosePkgEditDrag}
2256 debugln(['TPkgManager.MoveFiles PreparePackageOutputDirectory failed']);
2257 {$ENDIF}
2258 exit;
2259 end;
2260 end else if SrcProject<>nil then begin
2261 OutDir:=ChompPathDelim(SrcProject.GetOutputDirectory);
2262 if not FilenameIsAbsolute(OutDir) then exit(true);
2263 CurFiles:=nil;
2264 try
2265 CodeToolBoss.DirectoryCachePool.GetListing(OutDir,CurFiles,false);
2266 for OutFilename in CurFiles do begin
2267 CurUnitName:=ExtractFilenameOnly(OutFilename);
2268 for S2SItem in ChangedFilenames do begin
2269 OldFilename:=S2SItem^.Name;
2270 if not FilenameIsPascalSource(OldFilename) then continue;
2271 if CompareTextCT(CurUnitName,ExtractFileNameOnly(OldFilename))<>0 then
2272 continue;
2273 // output filename and source have same unitname
2274 SeparateOutDir:=CompareFilenames(ChompPathDelim(ExtractFilePath(OldFilename)),OutDir)<>0;
2275 if FilenameExtIn(OutFilename,['ppu','o','ppl','rst','lrt'])
2276 or (SeparateOutDir and FilenameExtIn(OutFilename,['lrs','lfm'])) then
2277 begin
2278 // automatically created file found => delete
2279 r:=DeleteFileInteractive(OutFilename,[mbCancel,mbIgnore]);
2280 if not (r in [mrOk,mrIgnore]) then exit;
2281 end;
2282 break;
2283 end;
2284 end;
2285 finally
2286 CurFiles.Free;
2287 end;
2288 end;
2289 Result:=true;
2290 end;
2291
2292 function CheckUsesSection(Tool: TCodeTool; UsesNode: TCodeTreeNode;
2293 NewUnitFilename: string): boolean;
2294 // true if no warnings
2295 var
2296 AnUnitName, AnUnitInFilename: string;
2297 OldUsedUnitCode: TCodeBuffer;
2298 OldUsedUnitFilename: string;
2299 Node: TCodeTreeNode;
2300 NamePos: Integer;
2301 OldCompiledUnitname: String;
2302 CodePos: TCodeXYPosition;
2303 Msg: String;
2304 PkgName: String;
2305 UsedPkg: TLazPackage;
2306 NewUsedUnitFilename: String;
2307 begin
2308 Result:=true;
2309 if UsesNode=nil then exit;
2310 // check that all used units are available in the target package
2311 Node:=UsesNode.FirstChild;
2312 while Node<>nil do begin
2313 // read unit name
2314 AnUnitInFilename:='';
2315 AnUnitName:=Tool.ExtractUsedUnitName(Node,@AnUnitInFilename);
2316 NamePos:=Node.StartPos;
2317 Node:=Node.NextBrother;
2318 if AnUnitName='' then continue;
2319 // find unit file
2320 OldUsedUnitCode:=Tool.FindUnitSource(AnUnitName,AnUnitInFilename,false,NamePos);
2321 if (OldUsedUnitCode=nil) then begin
2322 // no source found
2323 // => search for ppu
2324 OldCompiledUnitname:=AnUnitName+'.ppu';
2325 OldUsedUnitFilename:=Tool.DirectoryCache.FindCompiledUnitInCompletePath(
2326 OldCompiledUnitname,false);
2327 if OldUsedUnitFilename='' then begin
2328 // unit not found
2329 // (that is ok, e.g. if the unit is used on another platform)
2330 // => only warn
2331 Msg:=Format(lisUnitNotFound, [AnUnitName]);
2332 if not Tool.CleanPosToCaret(NamePos,CodePos) then continue;
2333 Result:=false;
2334 IDEMessagesWindow.AddCustomMessage(mluWarning,Msg,
2335 CodePos.Code.Filename, CodePos.Y, CodePos.X, lisMoveFiles);
2336 continue;
2337 end;
2338 end else begin
2339 // unit found
2340 OldUsedUnitFilename:=OldUsedUnitCode.Filename;
2341 if AllChangedFilenames.Contains(OldUsedUnitFilename) then begin
2342 // this unit will be moved too => ok
2343 continue;
2344 end;
2345 end;
2346 // OldUsedUnitFilename is now either a .pas/pp/p or .ppu file
2347
2348 // search unit in new position
2349 NewUsedUnitFilename:=CodeToolBoss.DirectoryCachePool.FindUnitSourceInCompletePath(
2350 ExtractFilePath(NewUnitFilename),AnUnitName,AnUnitInFilename);
2351 if (NewUsedUnitFilename='') and (AnUnitInFilename='') then
2352 NewUsedUnitFilename:=CodeToolBoss.DirectoryCachePool.FindCompiledUnitInCompletePath(
2353 ExtractFilePath(NewUnitFilename),AnUnitName);
2354 if CompareFilenames(OldUsedUnitFilename,NewUsedUnitFilename)=0 then
2355 continue;
2356 // not found or a different unit found
2357
2358 if not Tool.CleanPosToCaret(NamePos,CodePos) then continue;
2359
2360 // find package of used unit
2361 PkgName:='';
2362 UsedPkg:=TLazPackage(SrcDirToPkg[ExtractFilePath(OldUsedUnitFilename)]);
2363 if UsedPkg<>nil then
2364 PkgName:=UsedPkg.Name;
2365
2366 if NewUsedUnitFilename='' then begin
2367 // at the new position the unit cannot be found
2368 if PkgName='' then begin
2369 Msg:=Format(lisUnitNotFoundAtNewPosition, [AnUnitName, NewUnitFilename]);
2370 end else begin
2371 Msg:=Format(lisUnitRequiresPackage, [AnUnitName, PkgName]);
2372 end;
2373 end else begin
2374 // a different unit will be used
2375 Msg:=Format(lisDifferentUnitFoundAtNewPosition, [AnUnitName,
2376 NewUnitFilename]);
2377 end;
2378
2379 Result:=false;
2380 IDEMessagesWindow.AddCustomMessage(mluWarning,Msg,
2381 CodePos.Code.Filename, CodePos.Y, CodePos.X, lisMoveFiles);
2382 end;
2383 end;
2384
2385 function CheckUsesSections: boolean;
2386 // check that all used units are available in the target package
2387 var
2388 i: Integer;
2389 aFile: TIDEOwnedFile;
2390 OldFilename: String;
2391 Code: TCodeBuffer;
2392 Tool: TCodeTool;
2393 NewFilename: String;
2394 begin
2395 if SrcIsTarget then
2396 exit(true);
2397 // moving files to another package/project
2398 if (SrcPackage<>nil) and (PackageGraph.FindDependencyRecursively(
2399 TargetFilesEdit.FirstRequiredDependency,SrcPackage)<>nil)
2400 then begin
2401 // units are moved to higher level package/project
2402 // => no check needed
2403 exit(true);
2404 end;
2405
2406 // check that all used units are available in the target
2407 Result:=true;
2408 for i:=0 to IDEFiles.Count-1 do begin
2409 aFile:=TIDEOwnedFile(IDEFiles[i]);
2410 if not FileIsUnit(aFile) then continue;
2411 OldFilename:=aFile.GetFullFilename;
2412 NewFilename:=ChangedFilenames[OldFilename];
2413 if CompareFilenames(ExtractFilePath(OldFilename),ExtractFilePath(NewFilename))=0
2414 then continue;
2415 if LoadCodeBuffer(Code,OldFilename,[lbfUpdateFromDisk,lbfCheckIfText],false)<>mrOk
2416 then exit;
2417 CodeToolBoss.Explore(Code,Tool,false);
2418 if not CheckUsesSection(Tool,Tool.FindMainUsesNode,NewFilename) then
2419 Result:=false;
2420 if not CheckUsesSection(Tool,Tool.FindImplementationUsesNode,NewFilename) then
2421 Result:=false;
2422 end;
2423 if not Result then begin
2424 if IDEMessageDialog(lisCCOWarningCaption,
2425 lisMovingTheseUnitsWillBreakTheirUsesSectionsSeeMessa,
2426 mtWarning,[mbIgnore,mbCancel])<>mrIgnore
2427 then
2428 exit;
2429 Result:=true;
2430 end;
2431 end;
2432
2433 function ExtendSearchPaths: boolean;
2434 var
2435 i: Integer;
2436 aFile: TIDEOwnedFile;
2437 NewDir: String;
2438 NewUnitPaths: String;
2439 NewIncPaths: String;
2440 OldFilename: String;
2441 FileType: TPkgFileType;
2442 begin
2443 NewUnitPaths:='';
2444 NewIncPaths:='';
2445 for i:=0 to IDEFiles.Count-1 do begin
2446 aFile:=TIDEOwnedFile(IDEFiles[i]);
2447 OldFilename:=aFile.GetFullFilename;
2448 NewDir:=ChompPathDelim(ExtractFilePath(ChangedFilenames[OldFilename]));
2449 if aFile is TPkgFile then
2450 FileType:=TPkgFile(aFile).FileType
2451 else
2452 FileType:=FileNameToPkgFileType(OldFilename);
2453 case FileType of
2454 pftUnit,pftMainUnit:
2455 MergeSearchPaths(NewUnitPaths,NewDir);
2456 pftInclude:
2457 MergeSearchPaths(NewIncPaths,NewDir);
2458 end;
2459 end;
2460 // unit paths
2461 if (NewUnitPaths<>'') and not TargetFilesEdit.ExtendUnitSearchPath(NewUnitPaths)
2462 then begin
2463 {$IFDEF VerbosePkgEditDrag}
2464 debugln(['ExtendSearchPaths ExtendUnitSearchPath failed: NewUnitPaths="',NewUnitPaths,'"']);
2465 {$ENDIF}
2466 exit(false);
2467 end;
2468 // include paths
2469 if (NewIncPaths<>'') and not TargetFilesEdit.ExtendIncSearchPath(NewIncPaths)
2470 then begin
2471 {$IFDEF VerbosePkgEditDrag}
2472 debugln(['ExtendSearchPaths ExtendIncSearchPath failed: NewIncPaths="',NewIncPaths,'"']);
2473 {$ENDIF}
2474 exit(false);
2475 end;
2476 Result:=true;
2477 end;
2478
2479 function MoveOrCopyFile(OldFilename: string;
2480 MovedFiles: TFilenameToPointerTree): boolean;
2481 var
2482 NewFilename: String;
2483 r: TModalResult;
2484 OldPkgFile: TPkgFile;
2485 NewPkgFile: TPkgFile;
2486 NewFileType: TPkgFileType;
2487 NewUnitName: String;
2488 NewCompPrio: TComponentPriority;
2489 NewResourceBaseClass: TPFComponentBaseClass;
2490 NewHasRegisterProc: Boolean;
2491 NewAddToUses: Boolean;
2492 OldProjFile: TUnitInfo;
2493 Code: TCodeBuffer;
2494 NewProjFile: TUnitInfo;
2495 begin
2496 Result:=false;
2497 // check if needed
2498 NewFilename:=TargetDirectory+ExtractFilename(OldFilename);
2499 if CompareFilenames(NewFilename,OldFilename)=0 then
2500 exit(true);
2501 // check if already moved
2502 if MovedFiles.Contains(OldFilename) then
2503 exit(true);
2504 MovedFiles[OldFilename]:=Self;
2505 // copy or move file
2506 if FileExistsUTF8(OldFilename) then begin
2507 if DeleteOld then begin
2508 {$IFDEF VerbosePkgEditDrag}
2509 debugln(['MoveOrCopyFile rename "',OldFilename,'" to "',NewFilename,'"']);
2510 {$ENDIF}
2511 r:=RenameFileWithErrorDialogs(OldFilename,NewFilename,[mbAbort,mbIgnore]);
2512 end else begin
2513 {$IFDEF VerbosePkgEditDrag}
2514 debugln(['MoveOrCopyFile copy "',OldFilename,'" to "',NewFilename,'"']);
2515 {$ENDIF}
2516 r:=CopyFileWithErrorDialogs(OldFilename,NewFilename,[mbAbort,mbIgnore]);
2517 end;
2518 if not (r in [mrIgnore,mrOK]) then begin
2519 debugln(['Error: (lazarus) MoveOrCopyFile: rename/copy failed: "',OldFilename,'" to "',NewFilename,'"']);
2520 exit;
2521 end;
2522 end else begin
2523 if IDEMessageDialog(lisCCOWarningCaption,
2524 Format(lisFileNotFound5, [#13, OldFilename]), mtWarning, [mbIgnore,
2525 mbCancel])<>mrIgnore
2526 then
2527 exit;
2528 end;
2529
2530 OldPkgFile:=nil;
2531 OldProjFile:=nil;
2532 if SrcPackage<>nil then begin
2533 OldPkgFile:=SrcPackage.FindPkgFile(OldFilename,true,false);
2534 if OldPkgFile=nil then begin
2535 {$IFDEF VerbosePkgEditDrag}
2536 debugln(['MoveOrCopyFile old file not in lpk: "',OldFilename,'" pkg=',SrcPackage.Name]);
2537 {$ENDIF}
2538 // this is a resource file
2539 // => do not create an entry in the target
2540 exit(true);
2541 end;
2542 end else if SrcProject<>nil then begin
2543 OldProjFile:=SrcProject.UnitInfoWithFilename(OldFilename,[pfsfOnlyProjectFiles]);
2544 if OldProjFile=nil then begin
2545 {$IFDEF VerbosePkgEditDrag}
2546 debugln(['MoveOrCopyFile old file not in lpi: "',OldFilename,'"']);
2547 {$ENDIF}
2548 // this is a resource file
2549 // => do not create an entry in the target
2550 exit(true);
2551 end;
2552 end else begin
2553 raise Exception.Create('implement me');
2554 end;
2555
2556 if OldPkgFile<>nil then begin
2557 NewUnitName:=OldPkgFile.Unit_Name;
2558 NewFileType:=OldPkgFile.FileType;
2559 if NewFileType=pftMainUnit then NewFileType:=pftUnit;
2560 NewCompPrio:=OldPkgFile.ComponentPriority;
2561 NewResourceBaseClass:=OldPkgFile.ResourceBaseClass;
2562 NewHasRegisterProc:=OldPkgFile.HasRegisterProc;
2563 NewAddToUses:=OldPkgFile.AddToUsesPkgSection;
2564 end else begin
2565 NewUnitName:=OldProjFile.Unit_Name;
2566 NewFileType:=FileNameToPkgFileType(OldFilename);
2567 NewCompPrio:=ComponentPriorityNormal;
2568 NewResourceBaseClass:=OldProjFile.ResourceBaseClass;
2569 NewHasRegisterProc:=false;
2570 NewAddToUses:=true;
2571 if NewFileType=pftUnit then begin
2572 Code:=CodeToolBoss.LoadFile(OldFilename,true,false);
2573 if (Code<>nil) and (TargetPackage<>nil) then
2574 NewHasRegisterProc:=CodeToolBoss.HasInterfaceRegisterProc(Code);
2575 end;
2576 end;
2577
2578 NewPkgFile:=nil;
2579 NewProjFile:=nil;
2580 if TargetPackage<>nil then begin
2581 // create new TPkgFile
2582 NewPkgFile:=TargetPackage.FindPkgFile(NewFilename,true,false);
2583 if NewPkgFile=nil then begin
2584 {$IFDEF VerbosePkgEditDrag}
2585 debugln(['MoveOrCopyFile create new "',NewFilename,'" pkg=',TargetPackage.Name]);
2586 {$ENDIF}
2587 NewPkgFile:=TargetPackage.AddFile(NewFilename,NewUnitName,
2588 NewFileType,[],NewCompPrio.Category);
2589 end else begin
2590 NewPkgFile.Unit_Name:=NewUnitName;
2591 NewFileType:=NewFileType;
2592 NewPkgFile.FileType:=NewFileType;
2593 end;
2594 NewPkgFile.ComponentPriority:=NewCompPrio;
2595 NewPkgFile.ResourceBaseClass:=NewResourceBaseClass;
2596 NewPkgFile.HasRegisterProc:=NewHasRegisterProc;
2597 if NewAddToUses
2598 and (TargetPackage.FindUsedUnit(ExtractFileNameOnly(NewFilename),NewPkgFile)<>nil)
2599 then begin
2600 // another unit with this name is already used
2601 NewPkgFile.AddToUsesPkgSection:=false;
2602 end else begin
2603 NewPkgFile.AddToUsesPkgSection:=NewAddToUses;
2604 end;
2605 end else if TargetProject<>nil then begin
2606 // create new TUnitInfo
2607
2608 NewProjFile:=TargetProject.UnitInfoWithFilename(NewFilename);
2609 if NewProjFile=nil then begin
2610 NewProjFile:=TUnitInfo.Create(nil);
2611 NewProjFile.Filename:=NewFilename;
2612 TargetProject.AddFile(NewProjFile,false);
2613 end;
2614 NewProjFile.IsPartOfProject:=true;
2615 NewProjFile.ResourceBaseClass:=NewResourceBaseClass;
2616 if OldProjFile<>nil then begin
2617 NewProjFile.HasResources:=OldProjFile.HasResources;
2618 NewProjFile.ComponentName:=OldProjFile.ComponentName;
2619 NewProjFile.ComponentResourceName:=OldProjFile.ComponentResourceName;
2620 NewProjFile.BuildFileIfActive:=OldProjFile.BuildFileIfActive;
2621 NewProjFile.RunFileIfActive:=OldProjFile.RunFileIfActive;
2622 NewProjFile.DefaultSyntaxHighlighter:=OldProjFile.DefaultSyntaxHighlighter;
2623 NewProjFile.DisableI18NForLFM:=OldProjFile.DisableI18NForLFM;
2624 NewProjFile.CustomDefaultHighlighter:=OldProjFile.CustomDefaultHighlighter;
2625 end;
2626 if (not SrcIsTarget)
2627 and (pfMainUnitHasUsesSectionForAllUnits in TargetProject.Flags) then
2628 begin
2629 CodeToolBoss.AddUnitToMainUsesSection(
2630 TargetProject.MainUnitInfo.Source,NewUnitName,'');
2631 CodeToolBoss.SourceChangeCache.Apply;
2632 TargetProject.MainUnitInfo.Modified:=true;
2633 end;
2634 end else begin
2635 raise Exception.Create('implement me');
2636 end;
2637
2638 // delete old
2639 if DeleteOld then begin
2640 {$IFDEF VerbosePkgEditDrag}
2641 debugln(['MoveOrCopyFile delete "',OldFilename,'" from=',SrcFilesEdit.FilesOwnerName]);
2642 {$ENDIF}
2643 if OldPkgFile<>nil then begin
2644 SrcPackage.DeleteFile(OldPkgFile);
2645 end else if OldProjFile<>nil then begin
2646 OldProjFile.IsPartOfProject:=false;
2647 if (not SrcIsTarget)
2648 and (pfMainUnitHasUsesSectionForAllUnits in SrcProject.Flags) then
2649 begin
2650 CodeToolBoss.RemoveUnitFromAllUsesSections(
2651 SrcProject.MainUnitInfo.Source,NewUnitName);
2652 CodeToolBoss.SourceChangeCache.Apply;
2653 SrcProject.MainUnitInfo.Modified:=true;
2654 end;
2655 end else begin
2656 raise Exception.Create('implement me');
2657 end;
2658 end;
2659 TargetFilesEdit.UpdateAll;
2660 SrcFilesEdit.UpdateAll;
2661 Result:=true;
2662 end;
2663
2664 function MoveOrCopyFiles: boolean;
2665 var
2666 i: Integer;
2667 OldFilename: String;
2668 MovedFiles: TFilenameToPointerTree;
2669 ResFileList: TStringList;
2670 j: Integer;
2671 begin
2672 Result:=false;
2673 TargetFilesEdit.BeginUpdate;
2674 SrcFilesEdit.BeginUpdate;
2675 MovedFiles:=TFilenameToPointerTree.Create(false);
2676 try
2677 for i:=0 to IDEFiles.Count-1 do begin
2678 OldFilename:=TIDEOwnedFile(IDEFiles[i]).GetFullFilename;
2679 if not MoveOrCopyFile(OldFilename,MovedFiles) then exit;
2680 ResFileList:=TStringList(UnitFilenameToResFileList[OldFilename]);
2681 if ResFileList=nil then continue;
2682 for j:=0 to ResFileList.Count-1 do
2683 if not MoveOrCopyFile(ResFileList[j],MovedFiles) then exit;
2684 end;
2685 finally
2686 MovedFiles.Free;
2687 SrcFilesEdit.EndUpdate;
2688 TargetFilesEdit.EndUpdate;
2689 end;
2690 Result:=true;
2691 end;
2692
2693 var
2694 MoveFileCount: Integer;
2695 MsgResult: TModalResult;
2696 begin
2697 Result:=false;
2698
2699 {$IFDEF VerbosePkgEditDrag}
2700 debugln(['TPkgManager.MoveFiles Self=',TargetFilesEdit.FilesOwnerName,' Src=',SrcFilesEdit.FilesOwnerName,' Dir="',TargetDirectory,'" FileCount=',IDEFiles.Count]);
2701 {$ENDIF}
2702 if not GetPkgProj(SrcFilesEdit,SrcPackage,SrcProject) then begin
2703 {$IFDEF VerbosePkgEditDrag}
2704 debugln(['TPkgManager.MoveFiles invalid src=',DbgSName(SrcFilesEdit.FilesOwner)]);
2705 {$ENDIF}
2706 exit;
2707 end;
2708 if not GetPkgProj(TargetFilesEdit,TargetPackage,TargetProject) then begin
2709 {$IFDEF VerbosePkgEditDrag}
2710 debugln(['TPkgManager.MoveFiles invalid target=',DbgSName(TargetFilesEdit.FilesOwner)]);
2711 {$ENDIF}
2712 exit;
2713 end;
2714
2715 DeleteNonExistingPkgFiles;
2716 if IDEFiles.Count=0 then begin
2717 {$IFDEF VerbosePkgEditDrag}
2718 debugln(['TPkgManager.MoveFiles PkgFiles.Count=0']);
2719 {$ENDIF}
2720 exit(true);
2721 end;
2722
2723 if TargetFilesEdit.FilesOwnerReadOnly then begin
2724 IDEMessageDialog(lisTargetIsReadOnly,
2725 Format(lisTheTargetIsNotWritable, [TargetFilesEdit.FilesOwnerName]),
2726 mtError, [mbCancel]);
2727 exit;
2728 end;
2729
2730 if not FilenameIsAbsolute(TargetDirectory) then begin
2731 {$IFDEF VerbosePkgEditDrag}
2732 debugln(['TPkgManager.MoveFiles invalid target dir=',TargetDirectory]);
2733 {$ENDIF}
2734 exit;
2735 end;
2736 TargetDirectory:=AppendPathDelim(TargetDirectory);
2737
2738 // check TargetDirectory
2739 if CheckDirectoryIsWritable(TargetDirectory)<>mrOk then begin
2740 debugln(['Warning: (lazarus) TPkgManager.MoveFiles not writable TargetDirectory=',TargetDirectory]);
2741 exit;
2742 end;
2743
2744 SrcIsTarget:=SrcFilesEdit.FilesOwner=TargetFilesEdit.FilesOwner;
2745
2746 IDEMessagesWindow.Clear;
2747
2748 NewFileToOldOwnedFile:=TFilenameToPointerTree.Create(false);
2749 ChangedFilenames:=TFilenameToStringTree.Create(false);
2750 AllChangedFilenames:=TFilenameToStringTree.Create(false);
2751 UnitFilenameToResFileList:=TFilenameToPointerTree.Create(false);
2752 UnitFilenameToResFileList.FreeValues:=true;
2753 SrcDirToPkg:=nil;
2754 try
2755 // collect all affected files including resource files
2756 if not CollectFiles(MoveFileCount) then begin
2757 {$IFDEF VerbosePkgEditDrag}
2758 debugln(['TPkgManager.MoveFiles CollectFiles failed']);
2759 {$ENDIF}
2760 exit;
2761 end;
2762
2763 // check if new position is free
2764 if not CheckNewFilesDoNotExist then begin
2765 {$IFDEF VerbosePkgEditDrag}
2766 debugln(['TPkgManager.MoveFiles CheckNewFilesDoNotExist failed']);
2767 {$ENDIF}
2768 exit;
2769 end;
2770
2771 if (MoveFileCount=0) and (SrcIsTarget) then begin
2772 // no move, only change order in package
2773 // ToDo: check this case in ItemsTreeViewDragDrop
2774 ShowMessage('Changing order via drag and drop is not implemented.');
2775 exit;
2776 end;
2777
2778 // ask for confirmation
2779 if IDEFiles.Count=MoveFileCount then begin
2780 MsgResult:=IDEQuestionDialog(lisMoveOrCopyFiles,
2781 Format(lisMoveOrCopyFileSFromToTheDirectoryOfPackage, [
2782 IntToStr(MoveFileCount),
2783 SrcFilesEdit.FilesOwnerName, #13,
2784 TargetDirectory, #13,
2785 TargetFilesEdit.FilesOwnerName]),
2786 mtConfirmation, [100, lisMove, 101, lisCopy, mrCancel]);
2787 case MsgResult of
2788 100: DeleteOld:=true;
2789 101: DeleteOld:=false;
2790 else exit;
2791 end;
2792 end else begin
2793 if IDEMessageDialog(lisMoveFiles2,
2794 Format(lisMoveFileSFromToTheDirectoryOf, [
2795 IntToStr(MoveFileCount),
2796 SrcFilesEdit.FilesOwnerName, #13,
2797 TargetDirectory, #13,
2798 TargetFilesEdit.FilesOwnerName]),
2799 mtConfirmation,[mbOk,mbCancel])<>mrOK
2800 then exit;
2801 DeleteOld:=true;
2802 end;
2803
2804 // fetch used packages
2805 SrcDirToPkg:=PackageGraph.GetMapSourceDirectoryToPackage;
2806
2807 // check uses sections
2808 if not CheckUsesSections then begin
2809 {$IFDEF VerbosePkgEditDrag}
2810 debugln(['TPkgManager.MoveFiles CheckUsesSections failed']);
2811 {$ENDIF}
2812 exit;
2813 end;
2814
2815 if DeleteOld then begin
2816 // close files and res files in source editor
2817 if not CloseSrcEditors then begin
2818 {$IFDEF VerbosePkgEditDrag}
2819 debugln(['TPkgManager.MoveFiles CloseSrcEditors failed']);
2820 {$ENDIF}
2821 exit;
2822 end;
2823 end;
2824
2825 if (not SrcIsTarget) then begin
2826 // files will be moved to another package/project
2827 if not ClearOldCompiledFiles then begin
2828 {$IFDEF VerbosePkgEditDrag}
2829 debugln(['TPkgManager.MoveFiles ClearOldCompiledFiles failed']);
2830 {$ENDIF}
2831 exit;
2832 end;
2833 end;
2834
2835 // extend unit/include path of LazPackage
2836 if not ExtendSearchPaths then begin
2837 {$IFDEF VerbosePkgEditDrag}
2838 debugln(['TPkgManager.MoveFiles ExtendSearchPaths failed']);
2839 {$ENDIF}
2840 exit;
2841 end;
2842
2843 // move/copy files
2844 if not MoveOrCopyFiles then begin
2845 {$IFDEF VerbosePkgEditDrag}
2846 debugln(['TPkgManager.MoveFiles MoveOrCopyFiles failed']);
2847 {$ENDIF}
2848 exit;
2849 end;
2850
2851 Result:=true;
2852 finally
2853 SrcDirToPkg.Free;
2854 UnitFilenameToResFileList.Free;
2855 AllChangedFilenames.Free;
2856 ChangedFilenames.Free;
2857 NewFileToOldOwnedFile.Free;
2858 end;
2859 end;
2860
CopyMoveFilesnull2861 function TPkgManager.CopyMoveFiles(Sender: TObject): boolean;
2862 var
2863 SelDirDlg: TSelectDirectoryDialog;
2864 FilesEdit: IFilesEditorInterface;
2865 TargetDir: String;
2866 begin
2867 Result:=false;
2868 if Sender is TPackageEditorForm then
2869 FilesEdit:=TPackageEditorForm(Sender)
2870 else if Sender is TProjectInspectorForm then
2871 FilesEdit:=TProjectInspectorForm(Sender)
2872 else begin
2873 debugln(['Error: (lazarus) TPkgManager.CopyMoveFiles wrong Sender: ',DbgSName(Sender)]);
2874 exit;
2875 end;
2876 SelDirDlg:=TSelectDirectoryDialog.Create(nil);
2877 try
2878 SelDirDlg.InitialDir:=FilesEdit.FilesBaseDirectory;
2879 SelDirDlg.Title:=lisSelectTargetDirectory;
2880 SelDirDlg.Options:=SelDirDlg.Options+[ofPathMustExist,ofFileMustExist];
2881 if not SelDirDlg.Execute then exit;
2882 TargetDir:=CleanAndExpandDirectory(SelDirDlg.FileName);
2883 Result:=MoveFiles(FilesEdit,FilesEdit,TargetDir);
2884 finally
2885 SelDirDlg.Free;
2886 end;
2887 end;
2888
2889 constructor TPkgManager.Create(TheOwner: TComponent);
2890 begin
2891 inherited Create(TheOwner);
2892 OnGetDependencyOwnerDescription:=@GetDependencyOwnerDescription;
2893 OnGetDependencyOwnerDirectory:=@GetDependencyOwnerDirectory;
2894 OnPackageFileLoaded:=@PackageFileLoaded;
2895
2896 // package links
2897 LazPackageLinks:=TLazPackageLinks.Create;
2898 PkgLinks:=LazPackageLinks;
2899 LazPackageLinks.UpdateAll;
2900
2901 // package graph
2902 PackageGraph:=TLazPackageGraph.Create;
2903 PackageGraphInterface:=PackageGraph;
2904 PackageGraph.OnAddPackage:=@PackageGraphAddPackage;
2905 PackageGraph.OnBeforeCompilePackages:=@DoBeforeCompilePackages;
2906 PackageGraph.OnBeginUpdate:=@PackageGraphBeginUpdate;
2907 PackageGraph.OnChangePackageName:=@PackageGraphChangePackageName;
2908 PackageGraph.OnCheckInterPkgFiles:=@PackageGraphCheckInterPkgFiles;
2909 PackageGraph.OnDeleteAmbiguousFiles:=@BuildBoss.DeleteAmbiguousFiles;
2910 PackageGraph.OnDeletePackage:=@PackageGraphDeletePackage;
2911 PackageGraph.OnDependencyModified:=@PackageGraphDependencyModified;
2912 PackageGraph.OnEndUpdate:=@PackageGraphEndUpdate;
2913 PackageGraph.OnTranslatePackage:=@DoTranslatePackage;
2914 PackageGraph.OnUninstallPackage:=@DoUninstallPackage;
2915
2916 // package editors
2917 PackageEditors:=TPackageEditors.Create;
2918 PackageEditors.OnAddToProject:=@PackageEditorAddToProject;
2919 PackageEditors.OnAfterWritePackage:=@AfterWritePackage;
2920 PackageEditors.OnBeforeReadPackage:=@BeforeReadPackage;
2921 PackageEditors.OnCompilePackage:=@PackageEditorCompilePackage;
2922 PackageEditors.OnCopyMoveFiles:=@PackageEditorCopyMoveFiles;
2923 PackageEditors.OnCreateFpmakeFile:=@PackageEditorCreateFpmakeFile;
2924 PackageEditors.OnCreateMakefile:=@PackageEditorCreateMakefile;
2925 PackageEditors.OnCreateNewFile:=@PackageEditorCreateFile;
2926 PackageEditors.OnDeleteAmbiguousFiles:=@PackageEditorDeleteAmbiguousFiles;
2927 PackageEditors.OnDragDropTreeView:=@PackageEditorDragDropTreeView;
2928 PackageEditors.OnDragOverTreeView:=@PackageEditorDragOverTreeView;
2929 PackageEditors.OnShowFindInFiles:=@PackageEditorFindInFiles;
2930 PackageEditors.OnFreeEditor:=@PackageEditorFreeEditor;
2931 PackageEditors.OnGetIDEFileInfo:=@MainIDE.GetIDEFileState;
2932 PackageEditors.OnInstallPackage:=@PackageEditorInstallPackage;
2933 PackageEditors.OnOpenFile:=@MainIDE.DoOpenMacroFile;
2934 PackageEditors.OnOpenPackage:=@PackageEditorOpenPackage;
2935 PackageEditors.OnOpenPkgFile:=@PackageEditorOpenPkgFile;
2936 PackageEditors.OnPublishPackage:=@PackageEditorPublishPackage;
2937 PackageEditors.OnRevertPackage:=@PackageEditorRevertPackage;
2938 PackageEditors.OnSavePackage:=@PackageEditorSavePackage;
2939 PackageEditors.OnUninstallPackage:=@PackageEditorUninstallPackage;
2940 PackageEditors.OnViewPackageSource:=@PackageEditorViewPkgSource;
2941
2942 // package macros
2943 CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
2944 'PKGDIR',nil,@PackageGraph.MacroFunctionCTPkgDir);
2945 CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
2946 'PKGSRCPATH',nil,@PackageGraph.MacroFunctionCTPkgSrcPath);
2947 CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
2948 'PKGUNITPATH',nil,@PackageGraph.MacroFunctionCTPkgUnitPath);
2949 CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
2950 'PKGINCPATH',nil,@PackageGraph.MacroFunctionCTPkgIncPath);
2951 CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
2952 'PKGNAME',nil,@PackageGraph.MacroFunctionCTPkgName);
2953 CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
2954 'PKGOUTDIR',nil,@PackageGraph.MacroFunctionCTPkgOutDir);
2955
2956 LazPackageDescriptors:=TLazPackageDescriptors.Create;
2957 LazPackageDescriptors.AddDefaultPackageDescriptors;
2958
2959 // idle handler
2960 Application.AddOnIdleHandler(@ApplicationIdleHandler,true);
2961 end;
2962
2963 destructor TPkgManager.Destroy;
2964 begin
2965 FreeThenNil(LazPackageDescriptors);
2966 PackageGraph.FreeAutoInstallDependencies;
2967 FreeThenNil(PackageGraphExplorer);
2968 FreeThenNil(PackageEditors);
2969 FreeThenNil(PackageGraph);
2970 FreeThenNil(LazPackageLinks);
2971 FreeThenNil(PackageDependencies);
2972 inherited Destroy;
2973 end;
2974
2975 procedure TPkgManager.ConnectMainBarEvents;
2976 begin
2977 with MainIDEBar do begin
2978 itmPkgNewPackage.OnClick:=@MainIDEitmPkgNewPackageClick;
2979 itmPkgOpenLoadedPackage.OnClick:=@MainIDEitmPkgOpenLoadedPackageClicked;
2980 itmPkgOpenPackageFile.OnClick:=@MainIDEitmPkgOpenPackageFileClick;
2981 itmPkgOpenPackageOfCurUnit.OnClick:=@MainIDEitmPkgOpenPackageOfCurUnitClicked;
2982 itmPkgAddCurFileToPkg.OnClick:=@MainIDEitmPkgAddCurFileToPkgClick;
2983 itmPkgAddNewComponentToPkg.OnClick:=@MainIDEitmPkgNewComponentClick;
2984 itmPkgPkgGraph.OnClick:=@MainIDEitmPkgPkgGraphClick;
2985 itmPkgPackageLinks.OnClick:=@MainIDEitmPackageLinksClicked;
2986 itmPkgEditInstallPkgs.OnClick:=@MainIDEitmPkgEditInstallPkgsClick;
2987 end;
2988
2989 SetRecentPackagesMenu;
2990
2991 IDEWindowCreators.Add(NonModalIDEWindowNames[nmiwPkgGraphExplorer],
2992 nil,@CreateIDEWindow,'250','200','','');
2993 IDEWindowCreators.Add(PackageEditorWindowPrefix,
2994 nil,@CreateIDEWindow,'250','200','','');
2995 RegisterStandardPackageEditorMenuItems;
2996 end;
2997
2998 procedure TPkgManager.ConnectSourceNotebookEvents;
2999 begin
3000
3001 end;
3002
3003 procedure TPkgManager.SetupMainBarShortCuts;
3004 begin
3005
3006 end;
3007
3008 procedure TPkgManager.SetRecentPackagesMenu;
3009 begin
3010 MainIDE.SetRecentSubMenu(itmPkgOpenRecent,
3011 EnvironmentOptions.RecentPackageFiles,
3012 @MainIDEitmOpenRecentPackageClicked);
3013 end;
3014
3015 procedure TPkgManager.AddToMenuRecentPackages(const Filename: string);
3016 begin
3017 EnvironmentOptions.AddToRecentPackageFiles(Filename);
3018 SetRecentPackagesMenu;
3019 MainIDE.SaveEnvironment;
3020 end;
3021
3022 procedure TPkgManager.SaveSettings;
3023 begin
3024
3025 end;
3026
GetDefaultSaveDirectoryForFilenull3027 function TPkgManager.GetDefaultSaveDirectoryForFile(const Filename: string): string;
3028 var
3029 APackage: TLazPackage;
3030 PkgFile: TPkgFile;
3031 begin
3032 Result:='';
3033 if FilenameIsAbsolute(Filename) then
3034 exit(ExtractFilePath(Filename));
3035 PkgFile:=PackageGraph.FindFileInAllPackages(Filename,true,true);
3036 if PkgFile=nil then exit;
3037 APackage:=PkgFile.LazPackage;
3038 if APackage.IsVirtual or (not APackage.HasDirectory) then exit;
3039 Result:=APackage.Directory;
3040 end;
3041
3042 procedure TPkgManager.LoadInstalledPackages;
3043 begin
3044 IDEComponentPalette.BeginUpdate;
3045 try
3046 PackageGraph.LoadStaticBasePackages;
3047 LoadStaticCustomPackages;
3048 LoadAutoInstallPackages;
3049 finally
3050 IDEComponentPalette.EndUpdate;
3051 end;
3052 end;
3053
3054 procedure TPkgManager.UnloadInstalledPackages;
3055 var
3056 Dependency: TPkgDependency;
3057 begin
3058 // unbind and free auto installed packages
3059 while PackageGraph.FirstAutoInstallDependency<>nil do begin
3060 Dependency:=PackageGraph.FirstAutoInstallDependency;
3061 Dependency.RequiredPackage:=nil;
3062 Dependency.RemoveFromList(PackageGraph.FirstAutoInstallDependency,pddRequires);
3063 Dependency.Free;
3064 end;
3065 end;
3066
3067 procedure TPkgManager.ProcessCommand(Command: word; var Handled: boolean);
3068 begin
3069 Handled:=true;
3070 case Command of
3071 ecOpenPackage: MainIDEitmPkgOpenLoadedPackageClicked(Self);
3072 ecOpenPackageFile: MainIDEitmPkgOpenPackageFileClick(Self);
3073 ecOpenPackageOfCurUnit: MainIDEitmPkgOpenPackageOfCurUnitClicked(Self);
3074 ecAddCurFileToPkg: MainIDEitmPkgAddCurFileToPkgClick(Self);
3075 ecPackageGraph: MainIDEitmPkgPkgGraphClick(Self);
3076 ecEditInstallPkgs: MainIDEitmPkgEditInstallPkgsClick(Self);
3077 else
3078 Handled:=false;
3079 end;
3080 end;
3081
3082 procedure TPkgManager.OnSourceEditorPopupMenu(const AddMenuItemProc: TAddMenuItemProc);
3083 var
3084 APackage: TIDEPackage;
3085 begin
3086 GetPackageOfCurrentSourceEditor(APackage);
3087 if APackage<>nil then
3088 AddMenuItemProc(Format(lisOpenPackage2, [APackage.Name]), true,
3089 @OpenPackageForCurrentSrcEditFile);
3090 end;
3091
3092 procedure TPkgManager.TranslateResourceStrings;
3093 var
3094 PkgList: TFPList;
3095 i: Integer;
3096 begin
3097 PkgList:=nil;
3098 PackageGraph.GetAllRequiredPackages(nil,
3099 PackageGraph.FirstAutoInstallDependency,PkgList);
3100 if PkgList=nil then exit;
3101 for i:=0 to PkgList.Count-1 do
3102 if TObject(PkgList[i]) is TLazPackage then
3103 DoTranslatePackage(TLazPackage(PkgList[i]));
3104 PkgList.Free;
3105 end;
3106
3107 procedure TPkgManager.DoTranslatePackage(APackage: TLazPackage);
3108 var
3109 TranslatedUnits: TStringHashList;
3110
3111 function UnitTranslated(const AnUnitName: string): boolean;
3112 begin
3113 Result:=(TranslatedUnits<>nil) and (TranslatedUnits.Find(AnUnitName)>=0);
3114 end;
3115
3116 procedure TranslateUnit(const AFilename, AnUnitName: string);
3117 begin
3118 //DebugLn(['TranslateUnit AFilename="',AFilename,'" AnUnitName="',AnUnitName,'"']);
3119 if TranslatedUnits=nil then
3120 TranslatedUnits:=TStringHashList.Create(false);
3121 TranslatedUnits.Add(AnUnitName);
3122 TranslateUnitResourceStrings(AnUnitName,AFilename);
3123 end;
3124
3125 procedure TranslateWithFileMask(APackage: TLazPackage;
3126 const Directory, Language: string);
3127 var
3128 CurUnitName: string;
3129 CurLang: string;
3130 Files: TStrings;
3131 Filename: String;
3132 begin
3133 if Language='' then exit;
3134 Files:=nil;
3135 try
3136 CodeToolBoss.DirectoryCachePool.GetListing(Directory,Files,false);
3137 for Filename in Files do begin
3138 if GetPOFilenameParts(Filename,CurUnitName,CurLang)
3139 and IsValidUnitName(CurUnitName)
3140 and (CurLang=Language)
3141 and (not UnitTranslated(CurUnitName))
3142 and (APackage.FindUnit(CurUnitName)<>nil)
3143 then begin
3144 TranslateUnit(AppendPathDelim(Directory)+Filename,CurUnitName);
3145 end;
3146 end;
3147 finally
3148 Files.Free;
3149 end;
3150 end;
3151
3152 var
3153 Directory: String;
3154 Lang: String;
3155 FallbackLang: String;
3156 Language: String;
3157 begin
3158 //DebugLn(['TPkgManager.DoTranslatePackage ',APackage.Name,' from ', APackage.POOutputDirectory]);
3159 if (APackage.POOutputDirectory='') then exit;
3160 Directory:=AppendPathDelim(APackage.GetPOOutDirectory);
3161
3162 Language:=EnvironmentOptions.LanguageID;
3163 if Language='' then begin
3164 Lang:=SystemLanguageID1;
3165 FallbackLang:=SystemLanguageID2;
3166 end else begin
3167 Lang:=Language;
3168 FallbackLang:='';
3169 end;
3170
3171 //DebugLn(['TPkgManager.DoTranslatePackage ', APackage.Name,' from ', APackage.POOutputDirectory,', Translated=',APackage.Translated,' Lang=',Lang]);
3172 if APackage.Translated=Lang then exit;
3173 APackage.Translated:=Lang;
3174
3175 TranslatedUnits:=nil;
3176 try
3177 //DebugLn(['TPkgManager.DoTranslatePackage ',APackage.Name,' Directory=',Directory,' Lang=',Lang,' FallbackLang=',FallbackLang]);
3178 TranslateWithFileMask(APackage,Directory,Lang);
3179 if FallbackLang<>Lang then
3180 TranslateWithFileMask(APackage,Directory,FallbackLang);
3181 finally
3182 TranslatedUnits.Free;
3183 MainIDEInterface.PackageTranslated(APackage);
3184 end;
3185 end;
3186
AddPackageToGraphnull3187 function TPkgManager.AddPackageToGraph(APackage: TLazPackage): TModalResult;
3188 var
3189 ConflictPkg: TLazPackage;
3190 Link: TPackageLink;
3191 begin
3192 // check Package Name
3193 if not IsValidPkgName(APackage.Name) then begin
3194 Result:=IDEMessageDialog(lisPkgMangInvalidPackageName2,
3195 Format(lisPkgMangThePackageNameOfTheFileIsInvalid,
3196 [APackage.Name, LineEnding, APackage.Filename]),
3197 mtError,[mbCancel,mbAbort]);
3198 exit;
3199 end;
3200
3201 // check if Package with same name is already loaded
3202 ConflictPkg:=PackageGraph.FindPackageWithName(APackage.Name,nil);
3203 if ConflictPkg<>nil then begin
3204 if not PackageGraph.PackageCanBeReplaced(ConflictPkg,APackage) then begin
3205 Result:=IDEMessageDialog(lisPkgMangPackageConflicts,
3206 Format(lisPkgMangThereIsAlreadyAPackageLoadedFromFile,
3207 [ConflictPkg.IDAsString, LineEnding, ConflictPkg.Filename, LineEnding, LineEnding]),
3208 mtError,[mbCancel,mbAbort]);
3209 exit;
3210 end;
3211
3212 if ConflictPkg.Modified and (not ConflictPkg.ReadOnly) then begin
3213 Result:=IDEMessageDialog(lisPkgMangSavePackage,
3214 Format(lisPkgMangLoadingPackageWillReplacePackage, [
3215 APackage.IDAsString, ConflictPkg.IDAsString, LineEnding,
3216 ConflictPkg.Filename, LineEnding, LineEnding+LineEnding, ConflictPkg.Filename]),
3217 mtConfirmation,[mbYes,mbNo,mbCancel,mbAbort]);
3218 if Result=mrNo then Result:=mrOk;
3219 if Result=mrYes then begin
3220 Result:=DoSavePackage(ConflictPkg,[]);
3221 end;
3222 if Result<>mrOk then exit;
3223 end;
3224
3225 // replace package
3226 PackageGraph.ReplacePackage(ConflictPkg,APackage);
3227 end else begin
3228 // add to graph
3229 PackageGraph.AddPackage(APackage);
3230 end;
3231
3232 // save package file links
3233 //DebugLn(['TPkgManager.AddPackageToGraph ',APackage.Name]);
3234 Link:=LazPackageLinks.AddUserLink(APackage);
3235 if Link<>nil then
3236 begin
3237 //debugln(['Hint: (lazarus) TPkgManager.AddPackageToGraph LinkLastUsed=',DateToCfgStr(Link.LastUsed,DateTimeAsCfgStrFormat),' ',dbgs(Link.Origin)]);
3238 LazPackageLinks.SaveUserLinks;
3239 end;
3240
3241 Result:=mrOk;
3242 end;
3243
ResolveBrokenDependenciesOnlinenull3244 function TPkgManager.ResolveBrokenDependenciesOnline(ABrokenDependencies: TFPList): TModalResult;
3245 var
3246 Dependency: TPkgDependency;
3247 I: Integer;
3248 PkgLinks: TList;
3249 PkgsStr: String;
3250 PackageLink: TPackageLink;
3251 begin
3252 Result := mrCancel;
3253 PkgLinks := TList.Create;
3254 try
3255 PkgsStr := '';
3256 for I := 0 to ABrokenDependencies.Count - 1 do begin
3257 Dependency := TPkgDependency(ABrokenDependencies[i]);
3258 PackageLink := LazPackageLinks.FindLinkWithPkgName(Dependency.AsString);
3259 if (PackageLink <> nil) {and (PackageLink.Origin = ploOnline)} then begin
3260 PkgLinks.Add(PackageLink);
3261 Dependency.LoadPackageResult:=lprAvailableOnline;
3262 if PkgsStr = '' then
3263 PkgsStr := '"' + PackageLink.Name + '"'
3264 else
3265 PkgsStr := PkgsStr + ', ' + '"' + PackageLink.Name + '"';
3266 end;
3267 end;
3268 if PkgLinks.Count > 0 then begin
3269 if IDEMessageDialog(lisNotInstalledPackages, Format(lisInstallPackagesMsg,[PkgsStr]),
3270 mtConfirmation, [mbYes, mbNo]) = mrYes then
3271 Result := OPMInterface.InstallPackages(PkgLinks);
3272 end;
3273 finally
3274 PkgLinks.Free;
3275 end;
3276 end;
3277
OpenProjectDependenciesnull3278 function TPkgManager.OpenProjectDependencies(AProject: TProject;
3279 ReportMissing: boolean): TModalResult;
3280 var
3281 BrokenDependencies: TFPList;
3282 OpmRes: TModalResult;
3283 Dependency: TPkgDependency;
3284 IgnorePackage: TLazPackage;
3285 begin
3286 Result := mrOk;
3287 OpmRes := mrOk;
3288
3289 Dependency:=AProject.FirstRequiredDependency;
3290 while Dependency<>nil do begin
3291 IgnorePackage:=PackageGraph.FindPackageWithName(Dependency.PackageName,nil);
3292 if (IgnorePackage<>nil) and Dependency.IsCompatible(IgnorePackage) then
3293 IgnorePackage:=nil;
3294 PackageGraph.OpenDependency(Dependency,false,IgnorePackage);
3295 Dependency:=Dependency.NextRequiresDependency;
3296 end;
3297
3298 if ReportMissing then begin
3299 BrokenDependencies := PackageGraph.FindAllBrokenDependencies(nil,
3300 AProject.FirstRequiredDependency);
3301 if Assigned(BrokenDependencies) then
3302 begin
3303 if Assigned(OPMInterface) then
3304 begin
3305 OpmRes := ResolveBrokenDependenciesOnline(BrokenDependencies);
3306 FreeAndNil(BrokenDependencies);
3307 BrokenDependencies := PackageGraph.FindAllBrokenDependencies(nil,
3308 AProject.FirstRequiredDependency);
3309 end;
3310 Result := ShowBrokenDependenciesReport(BrokenDependencies);
3311 BrokenDependencies.Free;
3312 end;
3313 end;
3314 LazPackageLinks.SaveUserLinks;
3315 if OpmRes = mrRetry then // mrRetry means the IDE must be rebuilt.
3316 MainIDEInterface.DoBuildLazarus([])
3317 end;
3318
AddProjectDependencynull3319 function TPkgManager.AddProjectDependency(AProject: TProject;
3320 APackage: TLazPackage; OnlyTestIfPossible: boolean): TModalResult;
3321 var
3322 NewDependency: TPkgDependency;
3323 ProvidingAPackage: TLazPackage;
3324 ConflictDependency: TPkgDependency;
3325 begin
3326 Result:=mrCancel;
3327
3328 // check if there is a dependency, that requires another version
3329 ConflictDependency:=PackageGraph.FindConflictRecursively(
3330 AProject.FirstRequiredDependency,APackage);
3331 if ConflictDependency<>nil then begin
3332 DebugLn(['Error: (lazarus) [TPkgManager.AddProjectDependency] ',APackage.IDAsString,' conflicts with ',ConflictDependency.AsString]);
3333 Result:=mrCancel;
3334 exit;
3335 end;
3336
3337 // check if the dependency is already there
3338 if FindDependencyByNameInList(AProject.FirstRequiredDependency,pddRequires,
3339 APackage.Name)<>nil
3340 then begin
3341 // package already there
3342 Result:=mrOk;
3343 exit;
3344 end;
3345
3346 ProvidingAPackage:=PackageGraph.FindPackageProvidingName(
3347 AProject.FirstRequiredDependency,APackage.Name);
3348 if ProvidingAPackage<>nil then
3349 begin
3350 // package is already provided by another package
3351 DebugLn(['Error: (lazarus) [TPkgManager.AddProjectDependency] ',APackage.Name,' is already provided by ',ProvidingAPackage.IDAsString]);
3352 Result:=mrOk;
3353 exit;
3354 end;
3355
3356 if OnlyTestIfPossible then
3357 exit(mrOk);
3358 // add a dependency for the package to the project
3359 NewDependency:=APackage.CreateDependencyWithOwner(AProject);
3360 Result:=AddProjectDependency(AProject,NewDependency);
3361 end;
3362
AddProjectDependencynull3363 function TPkgManager.AddProjectDependency(AProject: TProject;
3364 ADependency: TPkgDependency): TModalResult;
3365 begin
3366 Result:=mrOk;
3367 AProject.AddRequiredDependency(ADependency);
3368 PackageGraph.OpenDependency(ADependency,false);
3369 Project1.DefineTemplates.AllChanged(false);
3370 if (ADependency.RequiredPackage<>nil)
3371 and (not ADependency.RequiredPackage.Missing)
3372 and ADependency.RequiredPackage.AddToProjectUsesSection
3373 and ((ADependency.RequiredPackage.PackageType<>lptDesignTime)
3374 or (pfUseDesignTimePackages in AProject.Flags))
3375 then begin
3376 AddUnitToProjectMainUsesSection(AProject,
3377 ExtractFileNameOnly(ADependency.RequiredPackage.GetCompileSourceFilename),'');
3378 end;
3379 end;
3380
AddProjectDependenciesnull3381 function TPkgManager.AddProjectDependencies(AProject: TProject;
3382 const Packages: string; OnlyTestIfPossible: boolean): TModalResult;
3383 var
3384 RequiredPackages: TStrings;
3385 i: Integer;
3386 PkgName: string;
3387 APackage: TLazPackage;
3388 begin
3389 Result:=mrOk;
3390 RequiredPackages:=SplitString(Packages,';');
3391 try
3392 for i:=0 to RequiredPackages.Count-1 do begin
3393 PkgName:=Trim(RequiredPackages[i]);
3394 if not IsValidPkgName(PkgName) then continue;
3395 APackage:=PackageGraph.FindPackageWithName(PkgName,nil);
3396 if APackage=nil then begin
3397 DebugLn(['Error: (lazarus) [TPkgManager.AddProjectDependencies] package not found: ',PkgName]);
3398 if OnlyTestIfPossible then
3399 exit(mrCancel);
3400 continue;
3401 end;
3402 Result:=AddProjectDependency(AProject,APackage,OnlyTestIfPossible);
3403 if Result<>mrOk then exit;
3404 end;
3405 finally
3406 RequiredPackages.Free;
3407 end;
3408 end;
3409
CheckProjectHasInstalledPackagesnull3410 function TPkgManager.CheckProjectHasInstalledPackages(AProject: TProject;
3411 Interactive: boolean): TModalResult;
3412 var
3413 MissingUnits: TFPList;
3414 i: Integer;
3415 PkgFile: TPkgFile;
3416 Msg: String;
3417 PkgList: TObjectList;
3418 begin
3419 Result:=mrOk;
3420 MissingUnits:=PackageGraph.FindNotInstalledRegisterUnits(nil,
3421 AProject.FirstRequiredDependency);
3422 if MissingUnits<>nil then begin
3423 if Interactive then begin
3424 Msg:=Format(lisProbablyYouNeedToInstallSomePackagesForBeforeConti,
3425 [LineEnding+LineEnding, LineEnding, LineEnding+LineEnding]) + LineEnding+LineEnding;
3426 PkgList:=TObjectList.Create(false);
3427 try
3428 for i:=0 to MissingUnits.Count-1 do begin
3429 PkgFile:=TPkgFile(MissingUnits[i]);
3430 if PkgList.IndexOf(PkgFile.LazPackage)<0 then
3431 PkgList.Add(PkgFile.LazPackage);
3432 Msg:=Format(lisUnitInPackage,
3433 [Msg, PkgFile.Unit_Name, PkgFile.LazPackage.IDAsString]) + LineEnding;
3434 end;
3435 Result:=IDEQuestionDialog(lisPackageNeedsInstallation, Msg,
3436 mtWarning, [mrIgnore,'Continue without install',
3437 mrYes,'Install these packages',
3438 mrCancel,'Cancel','IsDefault']);
3439 if Result=mrIgnore then begin
3440 // continue
3441 end else if Result=mrYes then
3442 begin
3443 // install
3444 AProject.AutoOpenDesignerFormsDisabled:=true;
3445 InstallPackages(PkgList,[piiifRebuildIDE]);
3446 Result:=mrAbort;
3447 end else begin
3448 // do not warn again
3449 AProject.AutoOpenDesignerFormsDisabled:=true;
3450 end;
3451 finally
3452 PkgList.Free;
3453 end;
3454 end else
3455 Result:=mrCancel;
3456 MissingUnits.Free;
3457 end;
3458 end;
3459
DoNewPackagenull3460 function TPkgManager.DoNewPackage: TModalResult;
3461 var
3462 NewPackage: TLazPackage;
3463 begin
3464 Result:=mrCancel;
3465 // create a new package with standard dependencies
3466 NewPackage:=PackageGraph.CreateNewPackage(constNewPackageName);
3467 PackageGraph.AddDependencyToPackage(NewPackage,
3468 PackageGraph.FCLPackage.CreateDependencyWithOwner(NewPackage));
3469 NewPackage.Modified:=false;
3470
3471 // open a package editor
3472 PackageEditors.OpenEditor(NewPackage,true);
3473
3474 Result:=DoSavePackage(NewPackage,[psfSaveAs]);
3475 end;
3476
DoShowLoadedPkgDlgnull3477 function TPkgManager.DoShowLoadedPkgDlg: TModalResult;
3478 var
3479 APackage: TLazPackage;
3480 begin
3481 Result:=ShowOpenLoadedPkgDlg(APackage);
3482 if (Result<>mrOk) then exit;
3483 Result:=DoOpenPackage(APackage,[pofAddToRecent],false);
3484 end;
3485
DoOpenPackagenull3486 function TPkgManager.DoOpenPackage(APackage: TLazPackage;
3487 Flags: TPkgOpenFlags; ShowAbort: boolean): TModalResult;
3488 var
3489 AFilename: String;
3490 begin
3491 AFilename:=APackage.Filename;
3492 // revert: if possible and wanted
3493 if (pofRevert in Flags) and (FileExistsCached(AFilename)) then
3494 exit(DoOpenPackageFile(AFilename,Flags,ShowAbort));
3495 // open a package editor
3496 PackageEditors.OpenEditor(APackage,true);
3497 PackageGraph.RebuildDefineTemplates;
3498 // add to recent packages
3499 if (pofAddToRecent in Flags) and FileExistsCached(AFilename) then
3500 AddToMenuRecentPackages(AFilename);
3501 Result:=mrOk;
3502 end;
3503
DoOpenPackageWithNamenull3504 function TPkgManager.DoOpenPackageWithName(const APackageName: string;
3505 Flags: TPkgOpenFlags; ShowAbort: boolean): TModalResult;
3506 var
3507 APackage: TLazPackage;
3508 NewDependency: TPkgDependency;
3509 LoadResult: TLoadPackageResult;
3510 begin
3511 Result:=mrCancel;
3512 if not IsValidPkgName(APackageName) then exit;
3513 NewDependency:=TPkgDependency.Create;
3514 try
3515 NewDependency.PackageName:=APackageName;
3516 LoadResult:=PackageGraph.OpenDependency(NewDependency,ShowAbort);
3517 if LoadResult<>lprSuccess then exit;
3518 finally
3519 NewDependency.Free;
3520 end;
3521 APackage:=PackageGraph.FindPackageWithName(APackageName,nil);
3522 if APackage=nil then exit;
3523 Result:=DoOpenPackage(APackage,Flags,ShowAbort);
3524 end;
3525
DoOpenPackageFilenull3526 function TPkgManager.DoOpenPackageFile(AFilename: string; Flags: TPkgOpenFlags;
3527 ShowAbort: boolean): TModalResult;
3528
3529 procedure DoQuestionDlg(const Caption, Message: string);
3530 begin
3531 if pofMultiOpen in Flags then
3532 Result:=IDEQuestionDialog(Caption, Message,
3533 mtError, [mrIgnore, lisPkgMangSkipThisPackage,
3534 mrAbort])
3535 else
3536 Result:=IDEQuestionDialog(Caption, Message, mtError, [mrAbort])
3537 end;
3538
3539 var
3540 APackage: TLazPackage;
3541 XMLConfig: TXMLConfig;
3542 AlternativePkgName: String;
3543 Code: TCodeBuffer;
3544 OpenEditor: Boolean;
3545 begin
3546 // replace macros
3547 if pofConvertMacros in Flags then
3548 if not GlobalMacroList.SubstituteStr(AFilename) then exit(mrCancel);
3549
3550 AFilename:=GetPhysicalFilenameCached(CleanAndExpandFilename(AFilename),false);
3551
3552 // check file extension
3553 if not ( FilenameExtIs(AFilename,'lpk',true) or (pofRevert in Flags) ) then begin
3554 DoQuestionDlg(lisPkgMangInvalidFileExtension,
3555 Format(lisPkgMangTheFileIsNotALazarusPackage, [AFilename]));
3556 RemoveFromRecentList(AFilename,EnvironmentOptions.RecentPackageFiles,rltFile);
3557 SetRecentPackagesMenu;
3558 exit;
3559 end;
3560
3561 // check filename
3562 AlternativePkgName:=ExtractFileNameOnly(AFilename);
3563 if (not (pofRevert in Flags))
3564 and (not IsValidPkgName(AlternativePkgName))
3565 then begin
3566 DoQuestionDlg(lisPkgMangInvalidPackageFilename,
3567 Format(lisPkgMangThePackageFileNameInIsNotAValidLazarusPackageName,
3568 [AlternativePkgName, LineEnding, AFilename]));
3569 RemoveFromRecentList(AFilename,EnvironmentOptions.RecentPackageFiles,rltFile);
3570 SetRecentPackagesMenu;
3571 exit;
3572 end;
3573
3574 // add to recent packages
3575 if pofAddToRecent in Flags then begin
3576 AddToMenuRecentPackages(AFilename);
3577 end;
3578
3579 OpenEditor:=not (pofDoNotOpenEditor in Flags);
3580
3581 // check if package is already loaded
3582 APackage:=PackageGraph.FindPackageWithFilename(AFilename);
3583 if (APackage=nil) or (pofRevert in Flags) then begin
3584 // package not yet loaded or it should be reloaded
3585
3586 if (pofRevert in Flags)
3587 and ((APackage=nil) or (APackage.Editor=nil)) then
3588 OpenEditor:=false;
3589
3590 if not FileExistsUTF8(AFilename) then begin
3591 IDEMessageDialog(lisFileNotFound,
3592 Format(lisPkgMangFileNotFound, [AFilename]),
3593 mtError,[mbCancel]);
3594 RemoveFromRecentList(AFilename,EnvironmentOptions.RecentPackageFiles,rltFile);
3595 SetRecentPackagesMenu;
3596 Result:=mrCancel;
3597 exit;
3598 end;
3599
3600 // create a new package
3601 Result:=mrCancel;
3602 APackage:=TLazPackage.Create;
3603 try
3604 // load the package file
3605 try
3606 XMLConfig:=TCodeBufXMLConfig.Create(nil);
3607 try
3608 APackage.Filename:=AFilename;
3609 Result:=LoadXMLConfigFromCodeBuffer(AFilename,XMLConfig,
3610 Code,[lbfUpdateFromDisk,lbfRevert],ShowAbort);
3611 if Result<>mrOk then exit;
3612 APackage.LPKSource:=Code;
3613 APackage.LoadFromXMLConfig(XMLConfig,'Package/');
3614 finally
3615 XMLConfig.Free;
3616 end;
3617 except
3618 on E: Exception do begin
3619 DoQuestionDlg(lisPkgMangErrorReadingPackage,
3620 Format(lisPkgUnableToReadPackageFileError, [AFilename, LineEnding, E.Message]));
3621 exit;
3622 end;
3623 end;
3624
3625 // newly loaded is not modified
3626 APackage.Modified:=false;
3627
3628 // check if package name and file name correspond
3629 if (SysUtils.CompareText(AlternativePkgName,APackage.Name)<>0) then begin
3630 Result:=IDEMessageDialog(lisPkgMangFilenameDiffersFromPackagename,
3631 Format(lisPkgMangTheFilenameDoesNotCorrespondToThePackage,
3632 [ExtractFileName(AFilename), APackage.Name, LineEnding, AlternativePkgName]),
3633 mtConfirmation,[mbYes,mbCancel,mbAbort]);
3634 if Result<>mrYes then exit;
3635 APackage.Name:=AlternativePkgName;
3636 end;
3637
3638 // integrate it into the graph
3639 Result:=AddPackageToGraph(APackage);
3640 finally
3641 if Result<>mrOk then APackage.Free;
3642 end;
3643 end;
3644
3645 if OpenEditor then
3646 Result:=DoOpenPackage(APackage,[],ShowAbort)
3647 else
3648 Result:=mrOk;
3649
3650 LazPackageLinks.SaveUserLinks;
3651
3652 // the source editor highlighting depends on the compiler mode
3653 MainIDEInterface.UpdateHighlighters;
3654 end;
3655
IsPackageEditorFormnull3656 function TPkgManager.IsPackageEditorForm(AForm: TCustomForm): boolean;
3657 begin
3658 Result:=AForm is TPackageEditorForm;
3659 end;
3660
3661 procedure TPkgManager.OpenHiddenModifiedPackages;
3662 var
3663 i: Integer;
3664 APackage: TLazPackage;
3665 begin
3666 for i:=0 to PackageGraph.Count-1 do begin
3667 APackage:=PackageGraph.Packages[i];
3668 if (APackage.Editor=nil) and APackage.Modified
3669 and (APackage.UserIgnoreChangeStamp<>APackage.ChangeStamp) then begin
3670 PackageEditors.OpenEditor(APackage,false);
3671 end;
3672 end;
3673 end;
3674
DoSavePackagenull3675 function TPkgManager.DoSavePackage(APackage: TLazPackage;
3676 Flags: TPkgSaveFlags): TModalResult;
3677 var
3678 XMLConfig: TCodeBufXMLConfig;
3679 PkgLink: TPackageLink;
3680 Code: TCodeBuffer;
3681 begin
3682 // do not save during compilation
3683 if not (MainIDE.ToolStatus in [itNone,itDebugger]) then begin
3684 Result:=mrAbort;
3685 exit;
3686 end;
3687
3688 if APackage.IsVirtual then Include(Flags,psfSaveAs);
3689
3690 if not ( (psfSaveAs in Flags) or APackage.ReadOnly or APackage.Modified
3691 or FileExistsCached(APackage.Filename)
3692 or (APackage.UserIgnoreChangeStamp<>APackage.ChangeStamp )) then
3693 begin
3694 Result:=mrOk;
3695 exit;
3696 end;
3697
3698 // save new or changed files
3699 Result:=SavePackageFiles(APackage);
3700 if Result<>mrOk then exit;
3701
3702 // warn about missing files
3703 Result:=WarnAboutMissingPackageFiles(APackage);
3704 if Result<>mrOk then exit;
3705
3706 // save editor files to codetools
3707 MainIDE.SaveSourceEditorChangesToCodeCache(nil);
3708
3709 // save package
3710 if (psfSaveAs in Flags) then begin
3711 Result:=DoShowSavePackageAsDialog(APackage);
3712 if Result<>mrOk then exit;
3713 end;
3714
3715 // backup old file
3716 Result:=BuildBoss.BackupFileForWrite(APackage.Filename);
3717 if Result=mrAbort then exit;
3718
3719 // delete ambiguous files
3720 Result:=BuildBoss.DeleteAmbiguousFiles(APackage.Filename);
3721 if Result=mrAbort then exit;
3722
3723 // save
3724 try
3725 XMLConfig:=TCodeBufXMLConfig.Create(nil);
3726 try
3727 XMLConfig.Clear;
3728 XMLConfig.KeepFileAttributes:=true;
3729 APackage.SaveToXMLConfig(XMLConfig,'Package/');
3730 Code:=nil;
3731 Result:=SaveXMLConfigToCodeBuffer(APackage.Filename,XMLConfig,Code,true);
3732 if Result<>mrOk then exit;
3733 APackage.LPKSource:=Code;
3734 PkgLink:=LazPackageLinks.AddUserLink(APackage);
3735 if PkgLink<>nil then begin
3736 PkgLink.LPKFileDate:=FileDateToDateTimeDef(FileAgeUTF8(APackage.Filename));
3737 PkgLink.LPKFileDateValid:=true;
3738 LazPackageLinks.SaveUserLinks;
3739 end;
3740 finally
3741 XMLConfig.Free;
3742 end;
3743 except
3744 on E: Exception do begin
3745 Result:=IDEMessageDialog(lisPkgMangErrorWritingPackage,
3746 Format(lisPkgMangUnableToWritePackageToFileError,
3747 [APackage.IDAsString, LineEnding, APackage.Filename, LineEnding, E.Message]),
3748 mtError,[mbAbort,mbCancel]);
3749 exit;
3750 end;
3751 end;
3752
3753 // success
3754 APackage.Modified:=false;
3755 // add to recent
3756 if (psfSaveAs in Flags) then begin
3757 AddToMenuRecentPackages(APackage.Filename);
3758 end;
3759
3760 if APackage.Editor<>nil then
3761 APackage.Editor.UpdateAll(true);
3762 Result:=mrOk;
3763 end;
3764
3765 procedure TPkgManager.DoShowPackageGraph(Show: boolean);
3766 begin
3767 if PackageGraphExplorer=nil then begin
3768 PackageGraphExplorer:=TPkgGraphExplorerDlg.Create(Application);
3769 PackageGraphExplorer.OnOpenPackage:=@PackageGraphExplorerOpenPackage;
3770 PackageGraphExplorer.OnOpenProject:=@PackageGraphExplorerOpenProject;
3771 PackageGraphExplorer.OnUninstallPackage:=@PackageGraphExplorerUninstallPackage;
3772 end;
3773 if Show then
3774 IDEWindowCreators.ShowForm(PackageGraphExplorer,true);
3775 end;
3776
DoCloseAllPackageEditorsnull3777 function TPkgManager.DoCloseAllPackageEditors: TModalResult;
3778 var
3779 APackage: TLazPackage;
3780 begin
3781 while PackageEditors.Count>0 do begin
3782 APackage:=PackageEditors.Editors[PackageEditors.Count-1].LazPackage;
3783 Result:=DoClosePackageEditor(APackage);
3784 if Result<>mrOk then exit;
3785 end;
3786 Result:=mrOk;
3787 end;
3788
3789 procedure TPkgManager.DoShowPackageGraphPathList(PathList: TFPList);
3790 begin
3791 DoShowPackageGraph(true);
3792 PackageGraphExplorer.ShowPath(PathList);
3793 end;
3794
ShowBrokenDependenciesReportnull3795 function TPkgManager.ShowBrokenDependenciesReport(Dependencies: TFPList): TModalResult;
3796 var
3797 Msg: String;
3798 i: Integer;
3799 ADependency: TPkgDependency;
3800 begin
3801 Result:=mrOk;
3802 if (Dependencies=nil) or (Dependencies.Count=0) then exit;
3803 if Dependencies.Count=1 then
3804 Msg:=lisPkgMangTheFollowingPackageFailedToLoad
3805 else
3806 Msg:=lisPkgMangTheFollowingPackagesFailedToLoad;
3807 Msg:=Msg+LineEnding+LineEnding;
3808 for i:=0 to Dependencies.Count-1 do begin
3809 ADependency:=TPkgDependency(Dependencies[i]);
3810 Msg:=Msg+ADependency.AsString+LineEnding;
3811 end;
3812
3813 // give some hints
3814 ADependency:=TPkgDependency(Dependencies[0]);
3815 if (ADependency.Owner is TProject) then begin
3816 // broken dependency used by project -> show project inspector
3817 if ADependency.Owner=Project1 then begin
3818 MainIDE.DoShowProjectInspector;
3819 Msg:=Format(lisSeeProjectProjectInspector, [Msg]);
3820 end;
3821 end;
3822
3823 Result:=IDEMessageDialog(lisMissingPackages, Msg, mtError, [mbOk]);
3824 end;
3825
CheckUserSearchPathsnull3826 function TPkgManager.CheckUserSearchPaths(aCompilerOptions: TBaseCompilerOptions
3827 ): TModalResult;
3828 var
3829 aPackage: TLazPackage;
3830 CurUnitPath: String;
3831 CurIncPath: String;
3832 CurSrcPath: String;
3833 CurOutPath: String;
3834 SrcDirToPkg: TFilenameToPointerTree;
3835
3836 function CheckPathContainsDirOfOtherPkg(Option: TParsedCompilerOptString
3837 ): TModalResult;
3838 var
3839 aSearchPath: String;
3840 p: Integer;
3841 Dir: String;
3842 OtherPackage: TLazPackage;
3843 aType: String;
3844 s: String;
3845 begin
3846 Result:=mrOk;
3847 case Option of
3848 pcosIncludePath:
3849 begin
3850 aType:='include files search path';
3851 aSearchPath:=CurIncPath;
3852 end;
3853 pcosUnitPath:
3854 begin
3855 aType:='other unit files search path (aka unit path)';
3856 aSearchPath:=CurUnitPath;
3857 end;
3858 pcosSrcPath:
3859 begin
3860 aType:='other sources path';
3861 aSearchPath:=CurSrcPath;
3862 end;
3863 else
3864 exit;
3865 end;
3866 p:=1;
3867 repeat
3868 Dir:=GetNextDirectoryInSearchPath(aSearchPath,p);
3869 if Dir='' then break;
3870 Dir:=ChompPathDelim(Dir);
3871 if not FilenameIsAbsolute(Dir) then continue;
3872 OtherPackage:=TLazPackage(SrcDirToPkg[Dir]);
3873 if (OtherPackage<>nil) and (OtherPackage<>aPackage) then begin
3874 // search path contains source directory of another package
3875 if Option=pcosIncludePath then;
3876 s:=aType+' of "'+aCompilerOptions.GetOwnerName+'" contains "'+Dir+'", which belongs to package "'+OtherPackage.Name+'"';
3877 debugln(['Warning: (lazarus) [TPkgManager.CheckUserSearchPaths]: ',s]);
3878 { ToDo: find out
3879 - which path it is in the unparsed path
3880 - if there is already the dependency
3881 - if the dependency can be added
3882 and ask the user to delete the path and to add the dependency
3883
3884 if the user has already answered this question in the past, just warn }
3885 // warn user
3886 IDEMessagesWindow.AddCustomMessage(mluWarning,s);
3887 exit;
3888 end;
3889 until false;
3890 end;
3891
3892 function CheckOutPathContainsSources: TModalResult;
3893 var
3894 Files: TStrings;
3895 i: Integer;
3896 aFilename: String;
3897 s: String;
3898 begin
3899 Result:=mrOk;
3900 if aPackage=nil then exit;
3901 if not FilenameIsAbsolute(CurOutPath) then exit;
3902 Files:=nil;
3903 CodeToolBoss.DirectoryCachePool.GetListing(CurOutPath,Files,false);
3904 try
3905 for i:=0 to Files.Count-1 do begin
3906 aFilename:=Files[i];
3907 if FilenameIsPascalUnit(aFilename) then begin
3908 // warning: packages output path contain unit source
3909 s:=Format(lisOutputDirectoryOfContainsPascalUnitSource, [
3910 aCompilerOptions.GetOwnerName, aFilename]);
3911 debugln(['Warning: (lazarus) [CheckOutPathContainsSources]: ',s]);
3912 { ToDo: if the OutPath is not the default: ask user and change it }
3913 IDEMessagesWindow.AddCustomMessage(mluWarning,s);
3914 exit;
3915 end;
3916 end;
3917 finally
3918 Files.Free;
3919 end;
3920 end;
3921
3922 function CheckSrcPathIsInUnitPath: TModalResult;
3923 // warn: SrcPath should not contain directories of UnitPath
3924 var
3925 p: Integer;
3926 UnparsedUnitPath: String;
3927 UnparsedSrcPath: String;
3928 Dir: String;
3929 s: String;
3930 begin
3931 Result:=mrOk;
3932 UnparsedUnitPath:=aCompilerOptions.OtherUnitFiles;
3933 UnparsedSrcPath:=aCompilerOptions.SrcPath;
3934 p:=1;
3935 repeat
3936 Dir:=GetNextDirectoryInSearchPath(UnparsedSrcPath,p);
3937 if Dir='' then exit;
3938 if SearchDirectoryInSearchPath(UnparsedUnitPath,Dir)>0 then begin
3939 // Note: when changing this, update TQuickFixSrcPathOfPkgContains_OpenPkg
3940 s:=Format(lisOtherSourcesPathOfPackageContainsDirectoryWhichIsA, [
3941 aCompilerOptions.GetOwnerName, Dir]);
3942 debugln(['Warning: (lazarus) [CheckSrcPathIsInUnitPath]: ',s]);
3943 { ToDo: ask user and remove dir from unit path }
3944 IDEMessagesWindow.AddCustomMessage(mluWarning,s);
3945 exit;
3946 end;
3947 until false;
3948 end;
3949
3950 begin
3951 Result:=mrOk;
3952 if aCompilerOptions.CompilerPath='' then exit; // not a normal Pascal project
3953
3954 aPackage:=nil;
3955 if aCompilerOptions.Owner is TLazPackage then
3956 aPackage:=TLazPackage(aCompilerOptions.Owner)
3957 else if not (aCompilerOptions.Owner is TProject) then
3958 exit;
3959
3960 if (aPackage<>nil) and (aPackage.AutoUpdate=pupManually) then exit;
3961
3962 CurUnitPath:=aCompilerOptions.ParsedOpts.GetParsedValue(pcosUnitPath);
3963 CurIncPath:=aCompilerOptions.ParsedOpts.GetParsedValue(pcosIncludePath);
3964 CurSrcPath:=aCompilerOptions.ParsedOpts.GetParsedValue(pcosSrcPath);
3965 CurOutPath:=aCompilerOptions.ParsedOpts.GetParsedValue(pcosOutputDir);
3966 //debugln(['TPkgManager.CheckUserSearchPaths CompOpts=',aCompilerOptions.GetOwnerName,' UnitPath="',CurUnitPath,'" IncPath="',CurIncPath,'" SrcPath="',CurSrcPath,'" OutPath="',CurOutPath,'"']);
3967
3968 // create mapping source-directory to package
3969 SrcDirToPkg:=PackageGraph.GetMapSourceDirectoryToPackage(aPackage);
3970 try
3971 Result:=CheckPathContainsDirOfOtherPkg(pcosUnitPath);
3972 if Result<>mrOk then exit;
3973
3974 Result:=CheckPathContainsDirOfOtherPkg(pcosSrcPath);
3975 if Result<>mrOk then exit;
3976
3977 Result:=CheckOutPathContainsSources;
3978 if Result<>mrOk then exit;
3979
3980 Result:=CheckSrcPathIsInUnitPath;
3981 if Result<>mrOk then exit;
3982
3983 // ToDo: check if SrcPath is in inherited SrcPath
3984 // ToDo: check if UnitPath is in inherited UnitPath
3985 finally
3986 SrcDirToPkg.Free;
3987 end;
3988 end;
3989
3990 procedure TPkgManager.LazarusSrcDirChanged;
3991 const
3992 LazDirMacro = '$(LazarusDir)';
3993 var
3994 NewLazarusSrcDir: String;
3995 OldLazarusSrcDir: String;
3996 VisitedPkgs: TStringToStringTree;
3997 ReloadPkgs: TStringList;
3998
3999 function PkgInOldLazarusDir(APackage: TLazPackage): boolean;
4000 begin
4001 Result:=FileIsInPath(APackage.Filename,OldLazarusSrcDir)
4002 or PackageGraph.IsStaticBasePackage(APackage.Name)
4003 or (SysUtils.CompareText(copy(APackage.Filename,1,length(LazDirMacro)),LazDirMacro)=0)
4004 end;
4005
4006 procedure GatherLazarusSrcPackages(APackage: TLazPackage);
4007 var
4008 ADependency: TPkgDependency;
4009 begin
4010 if APackage=nil then exit;
4011 if VisitedPkgs.Contains(APackage.Name) then exit;
4012 VisitedPkgs[APackage.Name]:='1';
4013 // search the dependencies first
4014 ADependency:=APackage.FirstRequiredDependency;
4015 while ADependency<>nil do begin
4016 GatherLazarusSrcPackages(ADependency.RequiredPackage);
4017 ADependency:=ADependency.NextRequiresDependency;
4018 end;
4019 if PkgInOldLazarusDir(APackage) then begin
4020 // this package was from the old lazarus source directory
4021 ReloadPkgs.Add(APackage.Name);
4022 end;
4023 end;
4024
4025 function ReloadPkg(APackage: TLazPackage): boolean;
4026 var
4027 Link: TPackageLink;
4028 MsgResult: TModalResult;
4029 Filename: String;
4030 begin
4031 Result:=true;
4032 if APackage=nil then exit;
4033 if not PkgInOldLazarusDir(APackage) then exit;
4034 // this package was from the old lazarus source directory
4035 // check if there is a package in the new version
4036 Link:=LazPackageLinks.FindLinkWithPkgName(APackage.Name);
4037 if Link<>nil then begin
4038 Filename:=TrimFilename(Link.LPKFilename);
4039 if not FilenameIsAbsolute(Filename) then
4040 Filename:=AppendPathDelim(NewLazarusSrcDir)+Filename;
4041 if FileIsInPath(Filename,NewLazarusSrcDir)
4042 and FileExistsUTF8(Filename) then
4043 begin
4044 DebugLn(['Hint: (lazarus) [TPkgManager.LazarusSrcDirChanged] load: ',Filename]);
4045 // open package in new lazarus source directory
4046 MsgResult:=DoOpenPackageFile(Filename,[pofDoNotOpenEditor,pofRevert],true);
4047 if MsgResult=mrAbort then exit(false);
4048 end;
4049 end;
4050 end;
4051
4052 var
4053 i: Integer;
4054 begin
4055 if PackageGraph=nil then exit;
4056 OldLazarusSrcDir:=FLastLazarusSrcDir;
4057 NewLazarusSrcDir:=EnvironmentOptions.GetParsedLazarusDirectory;
4058 FLastLazarusSrcDir:=NewLazarusSrcDir;
4059 if CompareFilenames(OldLazarusSrcDir,NewLazarusSrcDir)=0 then exit;
4060 debugln(['Hint: (lazarus) [TPkgManager.LazarusSrcDirChanged] loading new lpl files from ',
4061 LazPackageLinks.GetGlobalLinkDirectory]);
4062 if LazPackageLinks.IsUpdating then
4063 debugln(['Warning: (lazarus) [TPkgManager.LazarusSrcDirChanged] inconsistency: LazPackageLinks are locked']);
4064 LazPackageLinks.UpdateGlobalLinks;
4065
4066 VisitedPkgs:=TStringToStringTree.Create(false);
4067 ReloadPkgs:=TStringList.Create;
4068 try
4069 // collect candidates
4070 for i:=0 to PackageGraph.Count-1 do
4071 GatherLazarusSrcPackages(PackageGraph.Packages[i]);
4072 // reload
4073 for i:=0 to ReloadPkgs.Count-1 do
4074 ReloadPkg(PackageGraph.FindPackageWithName(ReloadPkgs[i],nil));
4075 finally
4076 ReloadPkgs.Free;
4077 VisitedPkgs.Free;
4078 end;
4079 end;
4080
GetPackageCountnull4081 function TPkgManager.GetPackageCount: integer;
4082 begin
4083 Result:=PackageGraph.Count;
4084 end;
4085
GetPackagesnull4086 function TPkgManager.GetPackages(Index: integer): TIDEPackage;
4087 begin
4088 Result:=PackageGraph.Packages[Index];
4089 end;
4090
FindPackageWithNamenull4091 function TPkgManager.FindPackageWithName(const PkgName: string;
4092 IgnorePackage: TIDEPackage): TIDEPackage;
4093 begin
4094 Result:=PackageGraph.FindPackageWithName(PkgName, IgnorePackage as TLazPackage);
4095 end;
4096
FindInstalledPackageWithUnitnull4097 function TPkgManager.FindInstalledPackageWithUnit(const AnUnitName: string
4098 ): TIDEPackage;
4099 var
4100 PkgFile: TPkgFile;
4101 begin
4102 PkgFile:=PackageGraph.FindUnitInInstalledPackages(AnUnitName, true);
4103 if PkgFile=nil then
4104 Result:=nil
4105 else
4106 Result:=PkgFile.LazPackage;
4107 end;
4108
IsPackageInstallednull4109 function TPkgManager.IsPackageInstalled(const PkgName: string): TIDEPackage;
4110 var
4111 LazPackage: TLazPackage;
4112 begin
4113 Result := nil;
4114 LazPackage:=PackageGraph.FindPackageWithName(PkgName, nil);
4115 if (LazPackage<>nil) and (LazPackage.Installed<>pitNope) then
4116 Result:=LazPackage
4117 end;
4118
RedirectPackageDependencynull4119 function TPkgManager.RedirectPackageDependency(APackage: TIDEPackage): TIDEPackage;
4120 begin
4121 Result:=APackage;
4122 if Result=PackageGraph.LCLBasePackage then begin
4123 // Older Lazarus does not have a LCLBase and a component does not work
4124 // without an LCLBase implementation, so we have to use LCL instead.
4125 Result:=PackageGraph.LCLPackage;
4126 end;
4127 end;
4128
DoCompileProjectDependenciesnull4129 function TPkgManager.DoCompileProjectDependencies(AProject: TProject;
4130 Flags: TPkgCompileFlags): TModalResult;
4131 var
4132 CompilePolicy: TPackageUpdatePolicy;
4133 begin
4134 // check graph for cycles and broken dependencies
4135 if not (pcfDoNotCompileDependencies in Flags) then begin
4136 Result:=CheckPackageGraphForCompilation(nil,
4137 AProject.FirstRequiredDependency,
4138 AProject.Directory,false);
4139 if Result<>mrOk then exit;
4140 end;
4141
4142 // save all open files
4143 if not (pcfDoNotSaveEditorFiles in Flags) then begin
4144 Result:=MainIDE.DoSaveForBuild(crCompile);
4145 if Result<>mrOk then exit;
4146 end;
4147
4148 PackageGraph.BeginUpdate(false);
4149 try
4150 // automatically compile required packages
4151 if not (pcfDoNotCompileDependencies in Flags) then begin
4152 CompilePolicy:=pupAsNeeded;
4153 if pcfCompileDependenciesClean in Flags then
4154 CompilePolicy:=pupOnRebuildingAll;
4155 Result:=PackageGraph.CompileRequiredPackages(nil,
4156 AProject.FirstRequiredDependency,
4157 not (pfUseDesignTimePackages in AProject.Flags),
4158 CompilePolicy);
4159 if Result<>mrOk then exit;
4160 end;
4161 finally
4162 PackageGraph.EndUpdate;
4163 end;
4164
4165 Result:=mrOk;
4166 end;
4167
DoCompilePackagenull4168 function TPkgManager.DoCompilePackage(APackage: TIDEPackage;
4169 Flags: TPkgCompileFlags; ShowAbort: boolean): TModalResult;
4170 var
4171 OldToolStatus: TLazToolStatus;
4172 begin
4173 Result:=mrCancel;
4174
4175 DebugLn('Hint: (lazarus) compile package ',APackage.IDAsString,' Flags=',PkgCompileFlagsToString(Flags));
4176
4177 if APackage.IsVirtual then exit;
4178
4179 Result:=MainIDE.PrepareForCompile;
4180 if Result<>mrOk then exit;
4181 Assert(APackage is TLazPackage, 'TPkgManager.DoCompilePackage: APackage is not TLazPackage');
4182
4183 // check graph for circles and broken dependencies
4184 if not (pcfDoNotCompileDependencies in Flags) then begin
4185 Result:=CheckPackageGraphForCompilation(TLazPackage(APackage),nil,APackage.Directory,ShowAbort);
4186 if Result<>mrOk then exit;
4187 end;
4188
4189 // save all open files
4190 {$IFDEF VerboseSaveForBuild}
4191 DebugLn('TPkgManager.DoCompilePackage ',APackage.IDAsString,' Flags=',PkgCompileFlagsToString(Flags));
4192 {$ENDIF}
4193 if not (pcfDoNotSaveEditorFiles in Flags) then begin
4194 Result:=MainIDE.DoSaveForBuild(crCompile);
4195 if Result<>mrOk then exit;
4196 end;
4197
4198 // check user search paths
4199 Result:=CheckUserSearchPaths(TBaseCompilerOptions(APackage.LazCompilerOptions));
4200 if Result<>mrOk then exit;
4201
4202 // compile
4203 if LazarusIDE<>nil then begin
4204 OldToolStatus:=LazarusIDE.ToolStatus;
4205 LazarusIDE.ToolStatus:=itBuilder;
4206 end;
4207 Result:=PackageGraph.CompilePackage(TLazPackage(APackage),Flags,false);
4208 if LazarusIDE<>nil then
4209 LazarusIDE.ToolStatus:=OldToolStatus;
4210 end;
4211
DoCreatePackageMakefilenull4212 function TPkgManager.DoCreatePackageMakefile(APackage: TLazPackage;
4213 ShowAbort: boolean): TModalResult;
4214 begin
4215 Result:=DoCompilePackage(APackage,[pcfDoNotCompileDependencies,
4216 pcfDoNotCompilePackage,pcfCreateMakefile],ShowAbort);
4217 end;
4218
DoCreatePackageFpmakefilenull4219 function TPkgManager.DoCreatePackageFpmakefile(APackage: TLazPackage;
4220 ShowAbort: boolean): TModalResult;
4221 begin
4222 Result:=DoCompilePackage(APackage,[pcfDoNotCompileDependencies,
4223 pcfDoNotCompilePackage,pcfCreateFpmakeFile],ShowAbort);
4224 end;
4225
OnRenameFilenull4226 function TPkgManager.OnRenameFile(const OldFilename, NewFilename: string;
4227 IsPartOfProject: boolean): TModalResult;
4228 var
4229 OldPackage: TLazPackage;
4230 OldPkgFile: TPkgFile;
4231 NewPkgFile: TPkgFile;
4232 begin
4233 Result:=mrOk;
4234 if (OldFilename=NewFilename) then
4235 exit;
4236 //debugln('TPkgManager.OnRenameFile A OldFilename="',OldFilename,'" New="',NewFilename,'"');
4237 OldPkgFile:=PackageGraph.FindFileInAllPackages(OldFilename,true,not IsPartOfProject);
4238 if (OldPkgFile=nil) or (OldPkgFile.LazPackage.ReadOnly) then
4239 exit;
4240 OldPackage:=OldPkgFile.LazPackage;
4241 debugln('Hint: (lazarus) [TPkgManager.OnRenameFile] OldPackage="',OldPackage.Name);
4242 NewPkgFile:=PackageGraph.FindFileInAllPackages(NewFilename,true,false);
4243 if (NewPkgFile<>nil) and (OldPackage<>NewPkgFile.LazPackage) then exit;
4244
4245 OldPkgFile.Filename:=NewFilename;
4246 if OldPackage.Editor<>nil then
4247 OldPackage.Editor.UpdateAll(true);
4248 OldPackage.Modified:=true;
4249 end;
4250
4251 {------------------------------------------------------------------------------
4252 function TPkgManager.FindIncludeFileInProjectDependencies(Project1: TProject;
4253 const Filename: string): string;
4254
4255 Search filename in the include paths of all required packages
4256 ------------------------------------------------------------------------------}
FindIncludeFileInProjectDependenciesnull4257 function TPkgManager.FindIncludeFileInProjectDependencies(aProject: TProject;
4258 const Filename: string): string;
4259 var
4260 APackage: TLazPackage;
4261 IncPath: String;
4262 PkgList: TFPList;
4263 i: Integer;
4264 begin
4265 Result:='';
4266 if FilenameIsAbsolute(Filename) then
4267 exit(Filename);
4268 PkgList:=nil;
4269 PackageGraph.GetAllRequiredPackages(nil,aProject.FirstRequiredDependency,
4270 PkgList,[pirCompileOrder]);
4271 if PkgList=nil then exit;
4272 try
4273 for i:=0 to PkgList.Count-1 do begin
4274 APackage:=TLazPackage(PkgList[i]);
4275 IncPath:=APackage.CompilerOptions.GetIncludePath(false);
4276 Result:=SearchFileInPath(Filename,APackage.Directory,IncPath,';',ctsfcDefault);
4277 if Result<>'' then exit;
4278 end;
4279 finally
4280 PkgList.Free;
4281 end;
4282 end;
4283
4284 type
4285 TPackageIterateHelper = class
4286 public
4287 PackageNames: TStrings;
4288 PackageList: TStrings;
4289 procedure AddDependency(APackageID: TLazPackageID);
4290 end;
4291
4292 procedure TPackageIterateHelper.AddDependency(APackageID: TLazPackageID);
4293 begin
4294 { are we looking for this package? }
4295 if PackageNames.IndexOf(APackageID.Name)<0 then
4296 Exit;
4297 { was the package already added? }
4298 if PackageList.IndexOf(APackageID.Name)>=0 then
4299 Exit;
4300 PackageList.AddObject(APackageID.Name,APackageID);
4301 end;
4302
AddUnitDepsForCompClassesnull4303 function TPkgManager.AddUnitDepsForCompClasses(const UnitFilename: string;
4304 ComponentClasses: TClassList; Quiet: boolean): TModalResult;
4305 var
4306 UnitBuf: TCodeBuffer;
4307 UnitNames: TStringList;
4308 MissingDependencies: TOwnerPackageArray;
4309
4310 function LoadAndParseUnitBuf: TModalResult;
4311 begin
4312 if not CodeToolBoss.GatherExternalChanges then begin
4313 Result:=mrCancel;
4314 MainIDE.DoJumpToCodeToolBossError;
4315 exit;
4316 end;
4317 UnitBuf:=CodeToolBoss.LoadFile(UnitFilename,false,false);
4318 if UnitBuf=nil then begin
4319 Result:=IDEMessageDialog(lisErrorLoadingFile,
4320 Format(lisLoadingFailed, [UnitFilename]),
4321 mtError,[mbCancel,mbAbort]);
4322 exit;
4323 end;
4324 Result:=mrOk;
4325 end;
4326
4327 function RemoveExistingUnitnames: TModalResult;
4328 var
4329 ImplementationUsesSection: TStrings;
4330 MainUsesSection: TStrings;
4331 j: LongInt;
4332 i: Integer;
4333 begin
4334 Result:=LoadAndParseUnitBuf;
4335 if Result<>mrOk then exit;
4336 MainUsesSection:=nil;
4337 ImplementationUsesSection:=nil;
4338 try
4339 if not CodeToolBoss.FindUsedUnitNames(UnitBuf,MainUsesSection,
4340 ImplementationUsesSection)
4341 then begin
4342 MainIDE.DoJumpToCodeToolBossError;
4343 exit;
4344 end;
4345 for i:=0 to MainUsesSection.Count-1 do begin
4346 j:=UnitNames.IndexOf(MainUsesSection[i]);
4347 if j>=0 then UnitNames.Delete(j);
4348 end;
4349 finally
4350 MainUsesSection.Free;
4351 ImplementationUsesSection.Free;
4352 end;
4353 Result:=mrOk;
4354 end;
4355
4356 function AskUser: TModalResult;
4357 var
4358 UsesAdditions: String;
4359 UnitOwner: TObject;
4360 RequiredPackage: TLazPackageID;
4361 i: Integer;
4362 PackageAdditions: String;
4363 Msg: String;
4364 begin
4365 UsesAdditions:='';
4366 for i:=0 to UnitNames.Count-1 do begin
4367 if UsesAdditions<>'' then UsesAdditions:=UsesAdditions+', ';
4368 UsesAdditions:=UsesAdditions+UnitNames[i];
4369 end;
4370 //DebugLn('TPkgManager.AddUnitDepsForCompClasses UsesAdditions=',UsesAdditions);
4371 PackageAdditions:='';
4372 if MissingDependencies<>nil then begin
4373 for i:=0 to MissingDependencies.Count-1 do begin
4374 UnitOwner:=MissingDependencies[i];
4375 RequiredPackage:=MissingDependencies.Objects[i];
4376 if RequiredPackage is TIDEPackage then
4377 RequiredPackage:=RedirectPackageDependency(TIDEPackage(RequiredPackage));
4378 if UnitOwner is TProject then begin
4379 PackageAdditions:=Format(lisPkgMangAddingNewDependencyForProjectPackage,
4380 [PackageAdditions, TProject(UnitOwner).GetTitle, RequiredPackage.Name]) + LineEnding+LineEnding;
4381 end else if UnitOwner is TLazPackage then begin
4382 PackageAdditions:=Format(lisPkgMangAddingNewDependencyForPackagePackage,
4383 [PackageAdditions, TLazPackage(UnitOwner).Name, RequiredPackage.Name]) + LineEnding+LineEnding;
4384 end;
4385 end;
4386 end;
4387 //DebugLn('TPkgManager.AddUnitDepsForCompClasses PackageAdditions=',PackageAdditions);
4388 Msg:='';
4389 if UsesAdditions<>'' then begin
4390 Msg:=Format(lisPkgMangTheFollowingUnitsWillBeAddedToTheUsesSectionOf,
4391 [Msg, LineEnding, UnitFilename, LineEnding, UsesAdditions]) + LineEnding+LineEnding;
4392 end;
4393 if PackageAdditions<>'' then begin
4394 Msg:=Msg+PackageAdditions;
4395 end;
4396 if Msg<>'' then begin
4397 Result:=IDEMessageDialog(lisConfirmChanges,Msg,mtConfirmation,[mbOk,mbAbort]);
4398 exit;
4399 end;
4400 Result:=mrOk;
4401 end;
4402
4403 function AddDependencies: TModalResult;
4404 var
4405 i: Integer;
4406 UnitOwner: TObject;
4407 RequiredPackage: TLazPackageID;
4408 PkgDependency: TPkgDependency;
4409 begin
4410 if MissingDependencies<>nil then begin
4411 for i:=0 to MissingDependencies.Count-1 do begin
4412 UnitOwner:=MissingDependencies[i];
4413 RequiredPackage:=MissingDependencies.Objects[i];
4414 if RequiredPackage is TIDEPackage then
4415 RequiredPackage:=RedirectPackageDependency(TIDEPackage(RequiredPackage));
4416 if UnitOwner is TProject then begin
4417 DebugLn('Hint: (lazarus) [TPkgManager.AddUnitDepsForCompClasses] Adding Project Dependency ',TProject(UnitOwner).GetTitle,' -> ',RequiredPackage.Name);
4418 if RequiredPackage is TLazPackage then
4419 AddProjectDependency(TProject(UnitOwner),TLazPackage(RequiredPackage))
4420 else begin
4421 PkgDependency:=TPkgDependency.Create;
4422 PkgDependency.PackageName:=RequiredPackage.Name;
4423 AddProjectDependency(TProject(UnitOwner),PkgDependency);
4424 end;
4425 end else if UnitOwner is TLazPackage then begin
4426 DebugLn('Hint: (lazarus) [TPkgManager.AddUnitDepsForCompClasses] Adding Package Dependency ',TLazPackage(UnitOwner).Name,' -> ',RequiredPackage.Name);
4427 AddPackageDependency(TLazPackage(UnitOwner),RequiredPackage.Name);
4428 end;
4429 end;
4430 end;
4431 Result:=mrOk;
4432 end;
4433
4434 function AddUsedUnits: TModalResult;
4435 var
4436 i: Integer;
4437 begin
4438 Result:=LoadAndParseUnitBuf;
4439 if Result<>mrOk then exit;
4440 for i:=0 to UnitNames.Count-1 do begin
4441 DebugLn('Hint: (lazarus) [TPkgManager.AddUnitDepsForCompClasses] Extending Uses ',
4442 UnitBuf.Filename,' ',UnitNames[i]);
4443 if not CodeToolBoss.AddUnitToMainUsesSection(UnitBuf,UnitNames[i],'') then
4444 MainIDE.DoJumpToCodeToolBossError;
4445 end;
4446 Result:=mrOk;
4447 end;
4448
4449 var
4450 Dependencies: TPackagePackageArray;
4451 begin
4452 Result:=mrCancel;
4453 UnitNames:=nil;
4454 Dependencies:=nil;
4455 MissingDependencies:=nil;
4456 try
4457 Result:=GetUnitsAndDepsForComps(ComponentClasses, Dependencies, UnitNames);
4458 if Result<>mrOk then exit;
4459 // TODO: Frame instances are not registered components, UnitNames is not assigned
4460 if (UnitNames=nil) then exit(mrCancel);
4461
4462 if (Dependencies<>nil) then
4463 begin
4464 Result:=FilterMissingDepsForUnit(UnitFilename,Dependencies,MissingDependencies);
4465 if Result<>mrOk then exit;
4466 end;
4467
4468 Result:=RemoveExistingUnitnames;
4469 if Result<>mrOk then exit;
4470
4471 if (UnitNames.Count=0) // no change needed
4472 and ((MissingDependencies=nil) or (MissingDependencies.Count=0)) then exit;
4473
4474 if not Quiet then begin
4475 Result:=AskUser;
4476 if Result<>mrOk then exit;
4477 end;
4478
4479 Result:=AddDependencies;
4480 if Result<>mrOk then exit;
4481
4482 Result:=AddUsedUnits;
4483 if Result<>mrOk then exit;
4484
4485 Result:=mrOk;
4486 finally
4487 UnitNames.Free;
4488 Dependencies.Free;
4489 MissingDependencies.Free;
4490 end;
4491 end;
4492
GetUnitsAndDepsForCompsnull4493 function TPkgManager.GetUnitsAndDepsForComps(ComponentClasses: TClassList;
4494 out PackageList: TPackagePackageArray; out UnitList: TStringList): TModalResult;
4495 // returns a list of packages and units needed to use the Component in the unit
4496 var
4497 CurClassID: Integer;
4498 CurUnitIdx, CurPackageIdx: Integer;
4499 CurCompClass: TClass;
4500 CurRegComp: TRegisteredComponent;
4501 PkgFile: TPkgFile;
4502 RequiredPackage: TLazPackageID;
4503 CurUnitName: String;
4504 CurUnitNames: TStrings;
4505 CurPackages, AllPackages: TStringList;
4506 CurCompReq: TComponentRequirements;
4507 Helper: TPackageIterateHelper;
4508 begin
4509 Result:=mrCancel;
4510 PackageList:=nil;
4511 UnitList:=nil;
4512 CurPackages:=nil;
4513 AllPackages:=nil;
4514 CurUnitNames:=TStringListUTF8Fast.Create;
4515 try
4516 for CurClassID:=0 to ComponentClasses.Count-1 do
4517 begin
4518 CurCompClass:=ComponentClasses[CurClassID];
4519 CurRegComp:=IDEComponentPalette.FindRegComponent(CurCompClass);
4520 if CurRegComp is TPkgComponent then
4521 begin
4522 CurUnitName:='';
4523 CurUnitNames.Clear;
4524 CurCompReq:=nil;
4525 if UnitList=nil then
4526 begin
4527 UnitList:=TStringListUTF8Fast.Create;
4528 UnitList.Sorted:=True;
4529 UnitList.Duplicates:=dupIgnore;
4530 end;
4531 try
4532 if CurRegComp.ComponentClass<>nil then
4533 begin
4534 CurUnitName:=CurRegComp.ComponentClass.UnitName;
4535 CurCompReq:=GetComponentRequirements(CurRegComp.ComponentClass);
4536 end;
4537 //DebugLn(['TPkgManager.GetUnitsAndDepsForComps: CurUnitName=',CurUnitName]);
4538 if CurUnitName='' then
4539 CurUnitName:=CurRegComp.GetUnitName;
4540 //Assert(CurUnitNames.IndexOf(CurUnitName)<0,
4541 // 'TPkgManager.GetUnitsAndDepsForComps: Name already in CurUnitNames.');
4542 CurUnitNames.Add(CurUnitName);
4543 if CurCompReq<>nil then
4544 CurCompReq.RequiredUnits(CurUnitNames);
4545 for CurUnitIdx:=0 to CurUnitNames.Count-1 do
4546 begin
4547 CurUnitName:=CurUnitNames[CurUnitIdx];
4548 UnitList.Add(CurUnitName);
4549 PkgFile:=PackageGraph.FindUnitInAllPackages(CurUnitName,true);
4550 //DebugLn([' GetUnitsAndDepsForComps: CurUnitName=',CurUnitName,
4551 // ', PkgFile=', PkgFile.Unit_Name]);
4552 if PkgFile=nil then
4553 PkgFile:=TPkgComponent(CurRegComp).PkgFile;
4554 if PkgFile<>nil then
4555 begin
4556 RequiredPackage:=PkgFile.LazPackage;
4557 RequiredPackage:=RedirectPackageDependency(TIDEPackage(RequiredPackage));
4558 if RequiredPackage<>nil then
4559 begin
4560 if CurPackages=nil then
4561 begin
4562 CurPackages:=TStringListUTF8Fast.Create;
4563 CurPackages.Sorted:=True;
4564 CurPackages.Duplicates:=dupIgnore;
4565 end else
4566 CurPackages.Clear;
4567 if AllPackages=nil then
4568 begin
4569 AllPackages:=TStringListUTF8Fast.Create;
4570 AllPackages.Sorted:=True;
4571 AllPackages.Duplicates:=dupIgnore;
4572 end;
4573 CurPackages.Add(RequiredPackage.Name);
4574 if Assigned(CurCompReq) then
4575 CurCompReq.RequiredPkgs(CurPackages);
4576 Helper:=TPackageIterateHelper.Create;
4577 try
4578 Helper.PackageNames:=CurPackages;
4579 Helper.PackageList:=AllPackages;
4580 PackageGraph.IteratePackages(fpfSearchAllExisting,@Helper.AddDependency);
4581 finally
4582 Helper.Free;
4583 end;
4584 end;
4585 end;
4586 end; // for CurUnitIdx:=
4587 finally
4588 CurCompReq.Free;
4589 end;
4590 end;
4591 end; // for CurClassID:=...
4592 if Assigned(AllPackages) and (AllPackages.Count>0) then
4593 begin
4594 PackageList:=TPackagePackageArray.Create;
4595 for CurPackageIdx:=0 to AllPackages.Count-1 do
4596 PackageList.Add(TLazPackageID(AllPackages.Objects[CurPackageIdx]));
4597 end;
4598 finally
4599 CurUnitNames.Free;
4600 CurPackages.Free;
4601 AllPackages.Free;
4602 end;
4603 Result:=mrOk;
4604 end;
4605
FilterMissingDepsForUnitnull4606 function TPkgManager.FilterMissingDepsForUnit(const UnitFilename: string;
4607 InputPackageList: TPackagePackageArray;
4608 out OutputPackageList: TOwnerPackageArray): TModalResult;
4609 // returns a list of packages that are not yet used by the project the unit belongs to
4610 var
4611 UnitOwners: TFPList;
4612 UnitOwner: TObject;
4613 FirstDependency: TPkgDependency;
4614 CurOwnerID, CurPackageIdx: Integer;
4615 RequiredPackage: TLazPackageID;
4616 begin
4617 Result:=mrCancel;
4618 OutputPackageList:=nil;
4619 if (InputPackageList=nil) or (InputPackageList.Count=0) then
4620 Exit(mrOK);
4621 UnitOwners:=GetOwnersOfUnit(UnitFilename);
4622 if (UnitOwners<>nil) then begin
4623 for CurOwnerID:=0 to UnitOwners.Count-1 do begin
4624 UnitOwner:=TObject(UnitOwners[CurOwnerID]);
4625 if UnitOwner is TProject then
4626 FirstDependency:=TProject(UnitOwner).FirstRequiredDependency
4627 else if UnitOwner is TLazPackage then
4628 FirstDependency:=TLazPackage(UnitOwner).FirstRequiredDependency
4629 else
4630 FirstDependency:=nil;
4631 for CurPackageIdx:=0 to InputPackageList.Count-1 do begin
4632 RequiredPackage:=InputPackageList.Items[CurPackageIdx];
4633 if (RequiredPackage<>nil)
4634 and (RequiredPackage<>UnitOwner)
4635 and (FindCompatibleDependencyInList(FirstDependency,pddRequires,RequiredPackage)=nil)
4636 and (PackageGraph.FindPackageProvidingName(FirstDependency,RequiredPackage.Name)=nil)
4637 then begin
4638 if OutputPackageList=nil then
4639 OutputPackageList:=TOwnerPackageArray.Create;
4640 OutputPackageList.AddObject(UnitOwner,RequiredPackage);
4641 //debugln(['TPkgManager.FilterMissingDependenciesForUnit A ',UnitOwner.ClassName,' ',RequiredPackage.Name]);
4642 //if TObject(OutputPackageList[OutputPackageList.Count-1])<>UnitOwner then RaiseGDBException('A');
4643 //if TObject(OutputPackageList.Objects[OutputPackageList.Count-1])<>RequiredPackage then RaiseGDBException('B');
4644 end;
4645 end;
4646 end;
4647 UnitOwners.Free;
4648 end else begin
4649 DebugLn(['Warning: (lazarus) [TPkgManager.FilterMissingDependenciesForUnit] unit has no owner: ',UnitFilename]);
4650 end;
4651 Result:=mrOk;
4652 end;
4653 {
GetMissingDependenciesForUnitnull4654 function TPkgManager.GetMissingDependenciesForUnit(
4655 const UnitFilename: string; ComponentClassnames: TStrings;
4656 var List: TOwnerPackageArray): TModalResult;
4657 // returns a list of packages needed to use the Component in the unit
4658 var
4659 AllPackages: TPackagePackageArray;
4660 AllUnits: TStringList;
4661 begin
4662 List:=nil;
4663 Result:=GetUnitsAndDependenciesForComponents(ComponentClassnames,AllPackages,AllUnits);
4664 try
4665 if Result<>mrOK then Exit;
4666 Result:=FilterMissingDependenciesForUnit(UnitFilename,AllPackages,List);
4667 finally
4668 AllPackages.Free;
4669 AllUnits.Free;
4670 end;
4671 end;
4672 }
4673 function TPkgManager.GetOwnersOfUnit(const UnitFilename: string): TFPList;
4674 begin
4675 Result:=GetPossibleOwnersOfUnit(UnitFilename,[]);
4676 end;
4677
4678 procedure TPkgManager.ExtendOwnerListWithUsedByOwners(OwnerList: TFPList);
4679 // use items (packages and projects) in OwnerList as leaves and create the
4680 // list of all packages and projects using them.
4681 // The result will be the topologically sorted list of projects and packages
4682 // using the projects/packages in OwnerList, beginning with the top levels.
4683 var
4684 AddedNonPackages: TFPList;
4685
4686 procedure AddUsedByOwners(ADependenyOwner: TObject);
4687 var
4688 LazPackage: TLazPackage;
4689 Dependency: TPkgDependency;
4690 begin
4691 if ADependenyOwner is TProject then begin
4692 if AddedNonPackages.IndexOf(ADependenyOwner)>=0 then exit;
4693 AddedNonPackages.Add(ADependenyOwner);
4694 OwnerList.Add(ADependenyOwner);
4695 end else if ADependenyOwner is TLazPackage then begin
4696 LazPackage:=TLazPackage(ADependenyOwner);
4697 if lpfVisited in LazPackage.Flags then exit;
4698 LazPackage.Flags:=LazPackage.Flags+[lpfVisited];
4699 Dependency:=LazPackage.FirstUsedByDependency;
4700 while Dependency<>nil do begin
4701 AddUsedByOwners(Dependency.Owner);
4702 Dependency:=Dependency.NextUsedByDependency;
4703 end;
4704 OwnerList.Add(LazPackage);
4705 end;
4706 end;
4707
4708 var
4709 i: Integer;
4710 OldOwnerList: TFPList;
4711 begin
4712 OldOwnerList:=TFPList.Create;
4713 for i:=0 to OwnerList.Count-1 do
4714 OldOwnerList.Add(OwnerList[i]);
4715 OwnerList.Clear;
4716 AddedNonPackages:=TFPList.Create;
4717 PackageGraph.MarkAllPackagesAsNotVisited;
4718 for i:=0 to OldOwnerList.Count-1 do
4719 AddUsedByOwners(TObject(OldOwnerList[i]));
4720 AddedNonPackages.Free;
4721 OldOwnerList.Free;
4722 end;
4723
GetSourceFilesOfOwnersnull4724 function TPkgManager.GetSourceFilesOfOwners(OwnerList: TFPList): TStrings;
4725
4726 procedure AddFile(TheOwner: TObject; const Filename: string);
4727 begin
4728 if Result=nil then
4729 Result:=TStringList.Create;
4730 Result.AddObject(Filename,TheOwner);
4731 end;
4732
4733 var
4734 CurOwner: TObject;
4735 CurPackage: TLazPackage;
4736 CurPkgFile: TPkgFile;
4737 CurProject: TProject;
4738 CurUnit: TUnitInfo;
4739 i: Integer;
4740 j: Integer;
4741 begin
4742 Result:=nil;
4743 if OwnerList=nil then exit;
4744 for i:=0 to OwnerList.Count-1 do begin
4745 CurOwner:=TObject(OwnerList[i]);
4746 if CurOwner is TLazPackage then begin
4747 CurPackage:=TLazPackage(CurOwner);
4748 for j:=0 to CurPackage.FileCount-1 do begin
4749 CurPkgFile:=CurPackage.Files[j];
4750 if CurPkgFile.FileType in PkgFileUnitTypes then
4751 AddFile(CurOwner,CurPkgFile.GetFullFilename);
4752 end;
4753 end else if CurOwner is TProject then begin
4754 CurProject:=TProject(CurOwner);
4755 CurUnit:=CurProject.FirstPartOfProject;
4756 while CurUnit<>nil do begin
4757 if FilenameIsPascalSource(CurUnit.Filename) then
4758 AddFile(CurOwner,CurUnit.Filename);
4759 CurUnit:=CurUnit.NextPartOfProject;
4760 end;
4761 end;
4762 end;
4763 end;
4764
GetUnitsOfOwnersnull4765 function TPkgManager.GetUnitsOfOwners(OwnerList: TFPList;
4766 Flags: TPkgIntfGatherUnitTypes): TStrings;
4767 var
4768 Units: TFilenameToPointerTree;
4769 Graph: TUsesGraph;
4770
4771 procedure AddUnit(ExpFilename: string);
4772 begin
4773 if not FileExistsCached(ExpFilename) then exit;
4774 if Units.Contains(ExpFilename) then exit;
4775 Units[ExpFilename]:=nil;
4776 end;
4777
4778 procedure AddStartModule(ExpFilename: string);
4779 begin
4780 AddUnit(ExpFilename);
4781 Graph.AddStartUnit(ExpFilename);
4782 end;
4783
4784 var
4785 i, j: Integer;
4786 CurOwner: TObject;
4787 CurProject: TProject;
4788 CurPackage: TLazPackage;
4789 ProjFile: TLazProjectFile;
4790 PkgFile: TPkgFile;
4791 Completed: boolean;
4792 Node: TAVLTreeNode;
4793 UGUnit: TUGUnit;
4794 begin
4795 debugln(['TPkgManager.GetUnitsOfOwners piguListed=',piguListed in Flags,' piguUsed=',piguUsed in Flags,' piguAllUsed=',piguAllUsed in Flags]);
4796 Result:=TStringList.Create;
4797 if (OwnerList=nil) or (OwnerList.Count=0) then exit;
4798
4799 Units:=TFilenameToPointerTree.Create(false);
4800 Graph:=TUsesGraph.Create;
4801 try
4802
4803 for i:=0 to OwnerList.Count-1 do
4804 begin
4805 CurOwner:=TObject(OwnerList[i]);
4806 if CurOwner is TProject then
4807 begin
4808 CurProject:=TProject(CurOwner);
4809 if (pfMainUnitIsPascalSource in CurProject.Flags)
4810 and (CurProject.MainUnitInfo<>nil) then
4811 AddStartModule(CurProject.MainUnitInfo.GetFullFilename);
4812 if piguListed in Flags then
4813 begin
4814 for j:=0 to CurProject.FileCount-1 do
4815 begin
4816 ProjFile:=CurProject.Files[j];
4817 if not FilenameIsPascalUnit(ProjFile.Filename) then continue;
4818 AddStartModule(ProjFile.GetFullFilename);
4819 end;
4820 end;
4821 end else if CurOwner is TLazPackage then
4822 begin
4823 CurPackage:=TLazPackage(CurOwner);
4824 if piguListed in Flags then
4825 begin
4826 for j:=0 to CurPackage.FileCount-1 do
4827 begin
4828 PkgFile:=CurPackage.Files[j];
4829 if not (PkgFile.FileType in PkgFileRealUnitTypes) then continue;
4830 AddStartModule(PkgFile.GetFullFilename);
4831 end;
4832 end;
4833 end;
4834 end;
4835 if Units.Count=0 then
4836 begin
4837 debugln(['TPkgManager.GetUnitsOfOwners no start modules END']);
4838 exit; // no start modules
4839 end;
4840
4841 if [piguUsed,piguAllUsed]*Flags<>[] then
4842 begin
4843 // parse units recursively
4844 Graph.AddSystemUnitAsTarget;
4845 if piguAllUsed in Flags then
4846 begin
4847 // gather all used units
4848 end else if piguUsed in Flags then
4849 begin
4850 // ignore units of other packages
4851 for i:=0 to PackageGraph.Count-1 do
4852 begin
4853 CurPackage:=PackageGraph[i];
4854 if OwnerList.IndexOf(CurPackage)>=0 then continue;
4855 for j:=0 to CurPackage.FileCount-1 do
4856 begin
4857 PkgFile:=CurPackage.Files[j];
4858 if not (PkgFile.FileType in PkgFileRealUnitTypes) then continue;
4859 Graph.AddIgnoreUnit(PkgFile.GetFullFilename);
4860 end;
4861 end;
4862 end;
4863
4864 // parse
4865 Graph.Parse(true,Completed);
4866 if Completed then ;
4867
4868 // add parsed units
4869 Node:=Graph.FilesTree.FindLowest;
4870 while Node<>nil do
4871 begin
4872 UGUnit:=TUGUnit(Node.Data);
4873 if Graph.IgnoreFilesTree.Find(UGUnit)=nil then
4874 Units[UGUnit.Filename]:=nil;
4875 Node:=Node.Successor;
4876 end;
4877 end;
4878
4879 Units.GetNames(Result);
4880
4881 finally
4882 Graph.Free;
4883 Units.Free;
4884 end;
4885 end;
4886
GetPossibleOwnersOfUnitnull4887 function TPkgManager.GetPossibleOwnersOfUnit(const UnitFilename: string;
4888 Flags: TPkgIntfOwnerSearchFlags): TFPList;
4889 var
4890 SrcDir: String;// ExtractFilePath(UnitFilename);
4891
4892 procedure SearchInProject(AProject: TProject);
4893 var
4894 BaseDir: String;
4895 ProjectDirs: String;
4896 Add: Boolean;
4897 begin
4898 if AProject=nil then exit;
4899 Add:=false;
4900
4901 // check if in units
4902 if not (piosfExcludeOwned in Flags) then begin
4903 //DebugLn(['SearchInProject ',AProject.ProjectInfoFile,' UnitFilename=',UnitFilename]);
4904 if (CompareFilenames(UnitFilename,AProject.ProjectInfoFile)=0)
4905 or (AProject.UnitInfoWithFilename(UnitFilename,[pfsfOnlyProjectFiles])<>nil)
4906 then
4907 Add:=true;
4908 end;
4909
4910 BaseDir:=ExtractFilePath(AProject.ProjectInfoFile);
4911
4912 // check if in virtual project
4913 if (not Add)
4914 and (piosfIncludeSourceDirectories in Flags)
4915 and (BaseDir='')
4916 and (ExtractFilePath(UnitFilename)='') then
4917 Add:=true;
4918
4919 if (not Add)
4920 and (piosfIncludeSourceDirectories in Flags)
4921 and FilenameIsAbsolute(UnitFilename)
4922 and (BaseDir<>'') then begin
4923 // search in project source directories
4924 ProjectDirs:=AProject.LazCompilerOptions.OtherUnitFiles+';.';
4925 if IDEMacros.CreateAbsoluteSearchPath(ProjectDirs,BaseDir) then begin
4926 if FindPathInSearchPath(PChar(SrcDir),length(SrcDir),
4927 PChar(ProjectDirs),length(ProjectDirs))<>nil
4928 then
4929 Add:=true;
4930 end;
4931 end;
4932
4933 if Add then
4934 Result.Add(AProject);
4935 end;
4936
4937 var
4938 PkgFile: TPkgFile;
4939 CurPackage: TLazPackage;
4940 i: Integer;
4941 begin
4942 //DebugLn(['TPkgManager.GetPossibleOwnersOfUnit ',UnitFilename]);
4943 Result:=TFPList.Create;
4944
4945 SrcDir:=ExtractFilePath(UnitFilename);
4946
4947 // ToDo: create a cache
4948
4949 SearchInProject(Project1);
4950
4951 // find all packages owning file
4952 if piosfIncludeSourceDirectories in Flags then begin
4953 PackageGraph.FindPossibleOwnersOfUnit(UnitFilename,Result);
4954 end else if not (piosfExcludeOwned in Flags) then begin
4955 PkgFile:=PackageGraph.FindFileInAllPackages(UnitFilename,true,true);
4956 if (PkgFile<>nil) and (PkgFile.LazPackage<>nil) then
4957 Result.Add(PkgFile.LazPackage);
4958 //debugln(['TPkgManager.GetPossibleOwnersOfUnit ',UnitFilename,' ',PkgFile<>nil,' ',(PkgFile<>nil) and (PkgFile.LazPackage<>nil),' Result.Count=',Result.Count]);
4959 // check package source files (they usually do not have a TPkgFile)
4960 for i:=0 to PackageGraph.Count-1 do begin
4961 CurPackage:=PackageGraph.Packages[i];
4962 if ((CompareFilenames(UnitFilename,CurPackage.GetSrcFilename)=0)
4963 or (CompareFilenames(UnitFilename,CurPackage.Filename)=0))
4964 and (Result.IndexOf(CurPackage)<0) then
4965 Result.Add(CurPackage);
4966 end;
4967 end;
4968
4969 // clean up
4970 if Result.Count=0 then
4971 FreeThenNil(Result);
4972 end;
4973
GetPackageOfCurrentSourceEditornull4974 function TPkgManager.GetPackageOfCurrentSourceEditor(out APackage: TIDEPackage): TPkgFile;
4975 var
4976 SrcEdit: TSourceEditor;
4977 begin
4978 Result:=nil;
4979 APackage:=nil;
4980 SrcEdit:=SourceEditorManager.GetActiveSE;
4981 if SrcEdit=nil then exit;
4982 Result := TPkgFile(GetPackageOfSourceEditor(APackage, SrcEdit));
4983 end;
4984
GetPackageOfSourceEditornull4985 function TPkgManager.GetPackageOfSourceEditor(out APackage: TIDEPackage;
4986 ASrcEdit: TObject): TLazPackageFile;
4987 var
4988 Filename: String;
4989 i: Integer;
4990 begin
4991 Result:=nil;
4992 APackage:=nil;
4993 if ASrcEdit=nil then exit;
4994 Filename:=TSourceEditor(ASrcEdit).FileName;
4995 Result:=SearchFile(Filename,[],nil);
4996 if Result<>nil then begin
4997 APackage:=Result.LazPackage;
4998 exit;
4999 end;
5000 for i:=0 to PackageGraph.Count-1 do begin
5001 APackage:=PackageGraph[i];
5002 if CompareFilenames(TLazPackage(APackage).GetSrcFilename,FileName)=0 then
5003 exit;
5004 end;
5005 APackage:=nil;
5006 end;
5007
IsOwnerDependingOnPkgnull5008 function TPkgManager.IsOwnerDependingOnPkg(AnOwner: TObject;
5009 const PkgName: string; out DependencyOwner: TObject): boolean;
5010 var
5011 FirstDep: TPkgDependency;
5012 Dep: TPkgDependency;
5013 begin
5014 Result:=false;
5015 DependencyOwner:=nil;
5016 if (AnOwner=nil) or (PkgName='') then exit;
5017 if AnOwner is TProject then
5018 FirstDep:=TProject(AnOwner).FirstRequiredDependency
5019 else if AnOwner is TLazPackage then begin
5020 if CompareDottedIdentifiers(PChar(TLazPackage(AnOwner).Name),
5021 PChar(PkgName))=0
5022 then begin
5023 DependencyOwner:=AnOwner;
5024 exit(true);
5025 end;
5026 FirstDep:=TLazPackage(AnOwner).FirstRequiredDependency;
5027 end else
5028 exit(false);
5029 if PackageGraph=nil then exit;
5030 Dep:=PackageGraph.FindDependencyRecursively(FirstDep,PkgName);
5031 if Dep=nil then exit;
5032 DependencyOwner:=Dep.Owner;
5033 Result:=true;
5034 end;
5035
5036 procedure TPkgManager.GetRequiredPackages(AnOwner: TObject; out PkgList: TFPList;
5037 Flags: TPkgIntfRequiredFlags);
5038 var
5039 Dependency: TPkgDependency;
5040 begin
5041 PkgList:=nil;
5042 Dependency:=nil;
5043 if AnOwner is TProject then
5044 Dependency:=TProject(AnOwner).FirstRequiredDependency
5045 else if AnOwner is TLazPackage then
5046 Dependency:=TLazPackage(AnOwner).FirstRequiredDependency
5047 else if AnOwner=PkgBoss then
5048 Dependency:=PackageGraph.FirstAutoInstallDependency;
5049 if Dependency=nil then exit;
5050 PackageGraph.GetAllRequiredPackages(nil,Dependency,PkgList,Flags);
5051 end;
5052
AddDependencyToOwnersnull5053 function TPkgManager.AddDependencyToOwners(OwnerList: TFPList;
5054 APackage: TIDEPackage; OnlyTestIfPossible: boolean): TModalResult;
5055 var
5056 i: Integer;
5057 Item: TObject;
5058 NewDependency: TPkgDependency;
5059 ADependency: TPkgDependency;
5060 r: TModalResult;
5061 Pkg: TLazPackage;
5062 begin
5063 Pkg:=APackage as TLazPackage;
5064 if not OnlyTestIfPossible then begin
5065 Result:=AddDependencyToOwners(OwnerList,APackage,true);
5066 if Result<>mrOk then exit;
5067 end;
5068
5069 Result:=mrCancel;
5070 for i:=0 to OwnerList.Count-1 do begin
5071 Item:=TObject(OwnerList[i]);
5072 if Item=APackage then continue;
5073 if Item is TProject then begin
5074 Result:=AddProjectDependency(TProject(Item),Pkg,OnlyTestIfPossible);
5075 if Result<>mrOk then exit;
5076 end
5077 else if Item is TLazPackage then begin
5078 NewDependency:=TPkgDependency.Create;
5079 try
5080 NewDependency.PackageName:=APackage.Name;
5081 r:=TPkgFileCheck.AddingDependency(TLazPackage(Item),NewDependency,false);
5082 if r=mrCancel then exit;
5083 if (not OnlyTestIfPossible) and (r<>mrIgnore) then begin
5084 ADependency:=NewDependency;
5085 NewDependency:=nil;
5086 PackageGraph.AddDependencyToPackage(TLazPackage(Item),ADependency);
5087 end;
5088 finally
5089 NewDependency.Free;
5090 end;
5091 end;
5092 end;
5093 Result:=mrOk;
5094 end;
5095
DoOpenPkgFilenull5096 function TPkgManager.DoOpenPkgFile(PkgFile: TPkgFile): TModalResult;
5097 var
5098 Filename: String;
5099 begin
5100 if (PkgFile.FileType=pftVirtualUnit) then
5101 Filename:=FindVirtualUnitSource(PkgFile)
5102 else
5103 Filename:=PkgFile.GetFullFilename;
5104 if Filename<>'' then
5105 Result:=MainIDE.DoOpenEditorFile(Filename,-1,-1,
5106 [ofOnlyIfExists,ofAddToRecent,ofRegularFile]);
5107 end;
5108
FindVirtualUnitSourcenull5109 function TPkgManager.FindVirtualUnitSource(PkgFile: TPkgFile): string;
5110 begin
5111 Result:='';
5112 if (PkgFile.FileType=pftVirtualUnit)
5113 and (PkgFile.LazPackage<>nil)
5114 and (not FileExistsUTF8(PkgFile.Filename)) then begin
5115 Result:=MainIDE.FindSourceFile(PkgFile.GetShortFilename(false),
5116 PkgFile.LazPackage.Directory,[]);
5117 end;
5118 end;
5119
SearchFilenull5120 function TPkgManager.SearchFile(const AFilename: string;
5121 SearchFlags: TSearchIDEFileFlags; InObject: TObject): TPkgFile;
5122 var
5123 APackage: TLazPackage;
5124 CurFilename: String;
5125 begin
5126 if InObject is TLazPackage then begin
5127 APackage:=TLazPackage(InObject);
5128 CurFilename:=AFilename;
5129 APackage.ShortenFilename(CurFilename,true);
5130 Result:=APackage.SearchShortFilename(CurFilename,SearchFlags);
5131 if Result<>nil then exit;
5132 end;
5133 if not (siffDoNotCheckAllPackages in SearchFlags) then begin
5134 Result := PackageGraph.FindFileInAllPackages(AFilename, True, True);
5135 if Result<>nil then exit;
5136 end;
5137 Result:=nil;
5138 end;
5139
SearchUnitInDesigntimePackagesnull5140 function TPkgManager.SearchUnitInDesigntimePackages(const AnUnitName: string;
5141 InObject: TObject): TPkgFile;
5142 var
5143 i: Integer;
5144 APackage: TLazPackage;
5145 begin
5146 if InObject is TLazPackage then begin
5147 APackage:=TLazPackage(InObject);
5148 Result:=APackage.FindUnit(AnUnitName);
5149 if Result<>nil then exit;
5150 end;
5151 for i:=0 to PackageGraph.Count-1 do begin
5152 APackage:=PackageGraph[i];
5153 if APackage.Installed=pitNope then continue;
5154 Result:=APackage.FindUnit(AnUnitName);
5155 if Result<>nil then exit;
5156 end;
5157 Result:=nil;
5158 end;
5159
ShowFindInPackageFilesDlgnull5160 function TPkgManager.ShowFindInPackageFilesDlg(APackage: TLazPackage): TModalResult;
5161 var
5162 Dlg: TLazFindInFilesDialog;
5163 begin
5164 Result:=mrOk;
5165 Dlg:=FindInFilesDialog;
5166 Dlg.FindInSearchPath(APackage.SourceDirectories.CreateSearchPathFromAllFiles);
5167 end;
5168
AddDependencyToUnitOwnersnull5169 function TPkgManager.AddDependencyToUnitOwners(const OwnedFilename,
5170 RequiredUnitname: string): TModalResult;
5171 var
5172 OwnersList: TFPList;
5173 RequiredPkgFile: TPkgFile;
5174 RequiredPkg: TLazPackage;
5175 begin
5176 Result:=mrCancel;
5177 //DebugLn(['TPkgManager.AddDependencyToUnitOwners RequiredUnitname=',RequiredUnitname,' OwnedFilename=',OwnedFilename]);
5178
5179 // find needed package
5180 RequiredPkgFile:=SearchUnitInDesigntimePackages(RequiredUnitName,nil);
5181 if RequiredPkgFile=nil then begin
5182 DebugLn(['Note: (lazarus) [TPkgManager.AddDependencyToUnitOwners] unit not in designtime package: ',RequiredUnitName]);
5183 exit;
5184 end;
5185 RequiredPkg:=RequiredPkgFile.LazPackage;
5186
5187 // find owners of unit (package or project)
5188 OwnersList:=GetOwnersOfUnit(OwnedFilename);
5189 try
5190 if (OwnersList=nil) or (OwnersList.Count=0) then begin
5191 DebugLn(['Note: (lazarus) TPkgManager.AddDependencyToUnitOwners Owner not found of unit ',OwnedFilename]);
5192 exit;
5193 end;
5194 // add package dependency
5195 //DebugLn(['TPkgManager.AddDependencyToUnitOwners ',dbgsName(TObject(OwnersList[0])),' ',RequiredPkg.IDAsString]);
5196 RequiredPkg:=TLazPackage(RedirectPackageDependency(RequiredPkg));
5197 Result:=AddDependencyToOwners(OwnersList,RequiredPkg,false);
5198 finally
5199 OwnersList.Free;
5200 end;
5201 end;
5202
5203 procedure TPkgManager.GetPackagesChangedOnDisk(out ListOfPackages: TStringList;
5204 IgnoreModifiedFlag: boolean);
5205 begin
5206 if PackageGraph=nil then exit;
5207 PackageGraph.GetPackagesChangedOnDisk(ListOfPackages, IgnoreModifiedFlag);
5208 end;
5209
RevertPackagesnull5210 function TPkgManager.RevertPackages(APackageList: TStringList): TModalResult;
5211 var
5212 i: Integer;
5213 APackage: TLazPackage;
5214 Filename: String;
5215 begin
5216 if APackageList=nil then exit(mrOk);
5217 for i:=0 to APackageList.Count-1 do begin
5218 APackage:=TLazPackage(APackageList.Objects[i]);
5219 Filename:=APackageList[i];
5220 if Filename='' then
5221 Filename:=APackage.Filename;
5222 debugln(['Hint: (lazarus) [TPkgManager.RevertPackages] BEFORE Old=',APackage.Filename,' New=',Filename,' ',FileExistsCached(Filename)]);
5223 if FileExistsCached(Filename) then
5224 Result:=DoOpenPackageFile(Filename,[pofRevert],true)
5225 else begin
5226 APackage.LPKSource:=nil;
5227 APackage.Missing:=true;
5228 Result:=mrCancel;
5229 end;
5230 debugln(['Hint: (lazarus) [TPkgManager.RevertPackages] AFTER ',PackageGraph.FindPackageWithFilename(Filename)<>nil]);
5231 if Result=mrAbort then exit;
5232 end;
5233 Result:=mrOk;
5234 end;
5235
DoAddActiveUnitToAPackagenull5236 function TPkgManager.DoAddActiveUnitToAPackage: TModalResult;
5237 var
5238 ActiveSourceEditor: TSourceEditorInterface;
5239 ActiveUnitInfo: TUnitInfo;
5240 PkgFile: TPkgFile;
5241 Filename: String;
5242 begin
5243 MainIDE.GetCurrentUnitInfo(ActiveSourceEditor,ActiveUnitInfo);
5244 if ActiveSourceEditor=nil then exit(mrAbort);
5245
5246 Filename:=ActiveUnitInfo.Filename;
5247
5248 // check if filename is absolute
5249 if ActiveUnitInfo.IsVirtual or (not FileExistsUTF8(Filename)) then begin
5250 Result:=IDEMessageDialog(lisPkgMangFileNotSaved,
5251 lisPkgMangPleaseSaveTheFileBeforeAddingItToAPackage, mtWarning,[mbCancel]);
5252 exit;
5253 end;
5254
5255 // check if file is part of project
5256 if ActiveUnitInfo.IsPartOfProject then begin
5257 Result:=IDEMessageDialog(lisPkgMangFileIsInProject,
5258 Format(lisPkgMangWarningTheFileBelongsToTheCurrentProject,[Filename,LineEnding]),
5259 mtWarning,[mbIgnore,mbCancel]);
5260 if Result<>mrIgnore then exit;
5261 end;
5262
5263 // check if file is already in a package
5264 PkgFile:=PackageGraph.FindFileInAllPackages(Filename,true,true);
5265 if PkgFile<>nil then begin
5266 Result:=IDEMessageDialog(lisPkgMangFileIsAlreadyInPackage,
5267 Format(lisPkgMangTheFileIsAlreadyInThePackage,
5268 [Filename, LineEnding, PkgFile.LazPackage.IDAsString]),
5269 mtWarning,[mbIgnore,mbCancel]);
5270 if Result<>mrIgnore then exit;
5271 end;
5272
5273 Result:=ShowAddFileToAPackageDlg(Filename);
5274 end;
5275
DoNewPackageComponentnull5276 function TPkgManager.DoNewPackageComponent: TModalResult;
5277 var
5278 APackage: TLazPackage;
5279 SaveFlags: TPkgSaveFlags;
5280 CurEditor: TPackageEditorForm;
5281 begin
5282 Result:=ShowNewPkgComponentDialog(APackage);
5283 if Result<>mrOk then exit;
5284 SaveFlags:=[];
5285 if APackage=nil then begin
5286 // create new package
5287 // create a new package with standard dependencies
5288 APackage:=PackageGraph.CreateNewPackage(constNewPackageName);
5289 PackageGraph.AddDependencyToPackage(APackage,
5290 PackageGraph.IDEIntfPackage.CreateDependencyWithOwner(APackage));
5291 APackage.Modified:=false;
5292 Include(SaveFlags,psfSaveAs);
5293 end;
5294 // open a package editor
5295 CurEditor:=PackageEditors.OpenEditor(APackage,true);
5296 // save
5297 Result:=DoSavePackage(APackage,SaveFlags);
5298 if Result<>mrOk then exit;
5299 Result:=CurEditor.ShowNewCompDialog; // show new component dialog
5300 end;
5301
SavePackageFilesnull5302 function TPkgManager.SavePackageFiles(APackage: TLazPackage): TModalResult;
5303 var
5304 i: Integer;
5305 AFile: TPkgFile;
5306 AFilename: String;
5307 SaveFlags: TSaveFlags;
5308 SrcEdit: TSourceEditor;
5309 begin
5310 Result:=mrOk;
5311 for i:=0 to APackage.FileCount-1 do begin
5312 AFile:=APackage.Files[i];
5313 if AFile.FileType=pftVirtualUnit then continue;
5314 AFilename:=AFile.Filename;
5315 if System.Pos('$(',AFilename)>0 then begin
5316 // filename contains macros -> skip
5317 //debugln(['TPkgManager.SavePackageFiles macros ',AFilename]);
5318 continue;
5319 end;
5320 // check if open in editor
5321 SrcEdit:=SourceEditorManager.SourceEditorIntfWithFilename(AFilename);
5322 if SrcEdit=nil then
5323 begin
5324 // not open in source editor => skip
5325 //debugln(['TPkgManager.SavePackageFiles no src edit ',AFilename]);
5326 continue;
5327 end;
5328 SaveFlags:=[sfCanAbort];
5329 if not FilenameIsAbsolute(AFilename) then
5330 SaveFlags:=[sfSaveAs];
5331 Result:=LazarusIDE.DoSaveEditorFile(SrcEdit,SaveFlags);
5332 if Result=mrIgnore then Result:=mrOk;
5333 if Result<>mrOk then begin
5334 debugln(['Error: (lazarus) [TPkgManager.SavePackageFiles] failed writing "',AFilename,'"']);
5335 exit;
5336 end;
5337 end;
5338 end;
5339
WarnAboutMissingPackageFilesnull5340 function TPkgManager.WarnAboutMissingPackageFiles(APackage: TLazPackage): TModalResult;
5341 var
5342 i: Integer;
5343 AFile: TPkgFile;
5344 AFilename: String;
5345 begin
5346 Result:=mrOk;
5347 for i:=0 to APackage.FileCount-1 do begin
5348 AFile:=APackage.Files[i];
5349 if AFile.FileType=pftVirtualUnit then continue;
5350 AFilename:=AFile.GetFullFilename;
5351 if System.Pos('$(',AFilename)>0 then begin
5352 // filename contains macros -> skip
5353 continue;
5354 end;
5355 if FilenameIsAbsolute(AFilename) and FileExistsCached(AFilename) then
5356 continue;
5357 Result:=IDEQuestionDialog(lisPkgSysPackageFileNotFound,
5358 Format(lisPkgMangTheFileOfPackageWasNotFound, [AFilename, APackage.IDAsString]),
5359 mtWarning, [mrIgnore,mrAbort]);
5360 if Result<>mrAbort then
5361 Result:=mrOk;
5362 // one warning is enough
5363 exit;
5364 end;
5365 end;
5366
AddPackageDependencynull5367 function TPkgManager.AddPackageDependency(APackage: TLazPackage;
5368 const ReqPackage: string; OnlyTestIfPossible: boolean): TModalResult;
5369 var
5370 NewDependency: TPkgDependency;
5371 ADependency: TPkgDependency;
5372 begin
5373 NewDependency:=TPkgDependency.Create;
5374 try
5375 NewDependency.PackageName:=ReqPackage;
5376 Result:=TPkgFileCheck.AddingDependency(APackage,NewDependency,false);
5377 if Result=mrIgnore then exit(mrOk);
5378 if Result<>mrOk then exit;
5379 if not OnlyTestIfPossible then begin
5380 ADependency:=NewDependency;
5381 NewDependency:=nil;
5382 PackageGraph.AddDependencyToPackage(APackage,ADependency);
5383 Result:=mrOk;
5384 end;
5385 finally
5386 NewDependency.Free;
5387 end;
5388 end;
5389
ApplyDependencynull5390 function TPkgManager.ApplyDependency(CurDependency: TPkgDependency
5391 ): TModalResult;
5392 // apply
5393 var
5394 OldPkg: TLazPackage;
5395 PkgEdit: TPackageEditorForm;
5396 begin
5397 Result:=mrOk;
5398 OldPkg:=CurDependency.RequiredPackage;
5399 if (OldPkg<>nil) and CurDependency.IsCompatible(OldPkg) then
5400 exit(mrOk);
5401
5402 PkgEdit:=PackageEditors.FindEditor(OldPkg);
5403 if PkgEdit<>nil then
5404 begin
5405 if PkgEdit.CanCloseEditor<>mrOk then
5406 exit(mrCancel);
5407 end;
5408
5409 // Try to load the package again. Min/max version may have changed.
5410 CurDependency.LoadPackageResult := lprUndefined;
5411 // This calls UpdateRequiredPackages from PackageGraph.OnEndUpdate,
5412 // and also updates all package editors which is useless here.
5413 if PackageGraph.OpenDependency(CurDependency, False, OldPkg)<>lprSuccess then
5414 Result:=mrCancel;
5415 //fForcedFlags:=[pefNeedUpdateRequiredPkgs];
5416 end;
5417
GetPackageOfEditorItemnull5418 function TPkgManager.GetPackageOfEditorItem(Sender: TObject): TIDEPackage;
5419 begin
5420 Result:=nil;
5421 while (Sender is TMenuItem) and (TMenuItem(Sender).Parent<>nil) do
5422 Sender:=TMenuItem(Sender).Parent;
5423 if (Sender is TMenuItem) and (TMenuItem(Sender).Menu<>nil)
5424 then
5425 Sender:=TMenuItem(Sender).Menu;
5426 if (Sender is TComponent) and (TComponent(Sender).Owner is TCustomForm) then
5427 Sender:=TCustomForm(TComponent(Sender).Owner);
5428 if Sender is TPackageEditorForm then
5429 Result:=TPackageEditorForm(Sender).LazPackage;
5430 end;
5431
DoInstallPackagenull5432 function TPkgManager.DoInstallPackage(APackage: TLazPackage): TModalResult;
5433 var
5434 PkgList: TFPList;
5435 FPMakeList: TFPList;
5436
5437 function GetPkgListIndex(APackage: TLazPackage): integer;
5438 begin
5439 Result:=PkgList.Count-1;
5440 while (Result>=0) and (TLazPackage(PkgList[Result])<>APackage) do
5441 dec(Result);
5442 end;
5443
5444 function WarnForSuspiciousPackage(APackage: TLazPackage): TModalResult;
5445 var
5446 IgnorePath: String;
5447 UnitPath: String;
5448 begin
5449 if APackage.UsageOptions.IncludePath<>'' then
5450 begin
5451 IgnorePath:='InstallPkgAddsIncPath/'+APackage.Filename;
5452 if InputHistories.Ignores.Find(IgnorePath)=nil then
5453 begin
5454 Result:=IDEQuestionDialog(lisSuspiciousIncludePath,
5455 Format(lisThePackageAddsThePathToTheIncludePathOfTheIDEThisI, [
5456 APackage.IDAsString, dbgstr(APackage.UsageOptions.IncludePath), LineEnding]
5457 ),
5458 mtWarning, [mrYes, lisContinue,
5459 mrYesToAll, lisContinueAndDoNotAskAgain,
5460 mrCancel]);
5461 case Result of
5462 mrYes: ;
5463 mrYesToAll:
5464 InputHistories.Ignores.Add(IgnorePath,iiidForever);
5465 else
5466 exit(mrCancel);
5467 end;
5468 end;
5469 end;
5470 UnitPath:=Trim(GetForcedPathDelims(APackage.UsageOptions.UnitPath));
5471 while (UnitPath<>'') and (UnitPath[1]=';') do
5472 UnitPath:=copy(UnitPath,2,Length(UnitPath));
5473 while (UnitPath<>'') and (RightStr(UnitPath,1)=';') do
5474 UnitPath:=copy(UnitPath,1,Length(UnitPath)-1);
5475 UnitPath:=ChompPathDelim(TrimFilename(UnitPath));
5476 if SysUtils.CompareText(UnitPath,'$(PkgOutDir)')<>0 then
5477 begin
5478 IgnorePath:='InstallPkgAddsUnitPath/'+APackage.Filename;
5479 if InputHistories.Ignores.Find(IgnorePath)=nil then
5480 begin
5481 Result:=IDEQuestionDialog(lisSuspiciousUnitPath,
5482 Format(lisThePackageAddsThePathToTheUnitPathOfTheIDEThisIsPr, [
5483 APackage.IDAsString, dbgstr(APackage.UsageOptions.UnitPath), LineEnding]),
5484 mtWarning, [mrYes, lisContinue,
5485 mrYesToAll, lisContinueAndDoNotAskAgain,
5486 mrCancel]);
5487 case Result of
5488 mrYes: ;
5489 mrYesToAll:
5490 InputHistories.Ignores.Add(IgnorePath,iiidForever);
5491 else
5492 exit(mrCancel);
5493 end;
5494 end;
5495 end;
5496 Result:=mrOk;
5497 end;
5498
5499 var
5500 Dependency: TPkgDependency;
5501 i: Integer;
5502 s: String;
5503 NeedSaving: Boolean;
5504 RequiredPackage: TLazPackage;
5505 BuildIDEFlags: TBuildLazarusFlags;
5506 Msg: string;
5507 Btns: TMsgDlgButtons;
5508 ConflictDep: TPkgDependency;
5509 begin
5510 if not MainIDE.DoResetToolStatus([rfInteractive]) then exit(mrCancel);
5511
5512 try
5513 BuildBoss.SetBuildTargetIDE;
5514
5515 PackageGraph.BeginUpdate(true);
5516 PkgList:=nil;
5517 FPMakeList:=nil;
5518 try
5519
5520 // check if package is designtime package
5521 if APackage.PackageType in [lptRunTime,lptRunTimeOnly] then begin
5522 Btns:=[mbAbort];
5523 if APackage.PackageType=lptRunTime then
5524 Include(Btns,mbIgnore);
5525 Result:=IDEMessageDialog(lisPkgMangPackageIsNoDesigntimePackage,
5526 Format(lisPkgMangThePackageIsARuntimeOnlyPackageRuntimeOnlyPackages,
5527 [APackage.IDAsString, LineEnding]),
5528 mtError,Btns);
5529 if Result<>mrIgnore then exit;
5530 end;
5531 // check if package requires a runtime only package
5532 ConflictDep:=PackageGraph.FindRuntimePkgOnlyRecursively(
5533 APackage.FirstRequiredDependency);
5534 if ConflictDep<>nil then begin
5535 IDEQuestionDialog(lisNotADesigntimePackage,
5536 Format(lisThePackageCanNotBeInstalledBecauseItRequiresWhichI, [
5537 APackage.Name, ConflictDep.AsString]),
5538 mtError,
5539 [mrCancel]
5540 );
5541 exit;
5542 end;
5543
5544 // save package
5545 if APackage.IsVirtual or APackage.Modified then begin
5546 Result:=DoSavePackage(APackage,[]);
5547 if Result<>mrOk then exit;
5548 end;
5549
5550 // check consistency
5551 Result:=CheckPackageGraphForCompilation(APackage,nil,
5552 EnvironmentOptions.GetParsedLazarusDirectory,false);
5553 if Result<>mrOk then exit;
5554
5555 // get all required packages, which will also be auto installed
5556 APackage.GetAllRequiredPackages(PkgList,FPMakeList,false);
5557 if PkgList=nil then PkgList:=TFPList.Create;
5558
5559 // remove packages already marked for installation
5560 for i:=PkgList.Count-1 downto 0 do begin
5561 RequiredPackage:=TLazPackage(PkgList[i]);
5562 if (RequiredPackage.AutoInstall<>pitNope) then
5563 PkgList.Delete(i);
5564 end;
5565
5566 // now PkgList contains only the required packages that were added to the
5567 // list of installation packages
5568 // => show the user the list
5569 if PkgList.Count>0 then begin
5570 s:='';
5571 for i:=0 to PkgList.Count-1 do begin
5572 RequiredPackage:=TLazPackage(PkgList[i]);
5573 s:=s+RequiredPackage.IDAsString+LineEnding;
5574 end;
5575 if PkgList.Count=0 then
5576 Msg:=Format(lisPkgMangInstallingThePackageWillAutomaticallyInstallThePac,
5577 [APackage.IDAsString])
5578 else
5579 Msg:=Format(lisPkgMangInstallingThePackageWillAutomaticallyInstallThePac2,
5580 [APackage.IDAsString]);
5581 Result:=IDEMessageDialog(lisPkgMangAutomaticallyInstalledPackages,
5582 Msg+LineEnding+s,mtConfirmation,[mbOk,mbCancel]);
5583 if Result<>mrOk then exit;
5584 end;
5585
5586 // warn for packages with suspicious settings
5587 Result:=WarnForSuspiciousPackage(APackage);
5588 if Result<>mrOk then exit;
5589 for i:=0 to PkgList.Count-1 do begin
5590 RequiredPackage:=TLazPackage(PkgList[i]);
5591 Result:=WarnForSuspiciousPackage(RequiredPackage);
5592 if Result<>mrOk then exit;
5593 end;
5594
5595 // add packages to auto installed packages
5596 if GetPkgListIndex(APackage)<0 then
5597 PkgList.Add(APackage);
5598 NeedSaving:=false;
5599 for i:=0 to PkgList.Count-1 do begin
5600 RequiredPackage:=TLazPackage(PkgList[i]);
5601 if RequiredPackage.AutoInstall=pitNope then begin
5602 RequiredPackage.AutoInstall:=pitStatic;
5603 Dependency:=RequiredPackage.CreateDependencyWithOwner(Self);
5604 Dependency.AddToList(PackageGraph.FirstAutoInstallDependency,pddRequires);
5605 PackageGraph.OpenDependency(Dependency,false);
5606 NeedSaving:=true;
5607 end;
5608 end;
5609 finally
5610 PackageGraph.EndUpdate;
5611 PkgList.Free;
5612 FPMakeList.Free;
5613 end;
5614
5615 if NeedSaving then begin
5616 PackageGraph.SortAutoInstallDependencies;
5617 SaveAutoInstallDependencies;
5618 end;
5619
5620 // save IDE build configs, so user can build IDE on command line
5621 BuildIDEFlags:=[blfDontClean,blfOnlyIDE];
5622 Result:=MainIDE.DoSaveBuildIDEConfigs(BuildIDEFlags);
5623 if Result<>mrOk then exit;
5624 finally
5625 BuildBoss.SetBuildTargetProject1;
5626 end;
5627
5628 // ask user to rebuild Lazarus now
5629 Result:=IDEMessageDialog(lisPkgMangRebuildLazarus,
5630 Format(lisPkgMangThePackageWasMarkedForInstallationCurrentlyLazarus,
5631 [APackage.IDAsString, LineEnding, LineEnding+LineEnding]),
5632 mtConfirmation,[mbYes,mbNo]);
5633 if Result<>mrYes then begin
5634 Result:=mrOk;
5635 exit;
5636 end;
5637
5638 // rebuild Lazarus
5639 Result:=MainIDE.DoBuildLazarus(BuildIDEFlags);
5640 if Result<>mrOk then exit;
5641
5642 Result:=mrOk;
5643 end;
5644
DoUninstallPackagenull5645 function TPkgManager.DoUninstallPackage(APackage: TLazPackage;
5646 Flags: TPkgUninstallFlags; ShowAbort: boolean): TModalResult;
5647 var
5648 DependencyPath: TFPList;
5649 ParentPackage: TLazPackage;
5650 Dependency: TPkgDependency;
5651 BuildIDEFlags: TBuildLazarusFlags;
5652 begin
5653 if (APackage.Installed=pitNope) and (APackage.AutoInstall=pitNope) then exit;
5654
5655 // check if package is required by auto install package
5656 DependencyPath:=PackageGraph.FindAutoInstallDependencyPath(APackage);
5657 if DependencyPath<>nil then begin
5658 DoShowPackageGraphPathList(DependencyPath);
5659 ParentPackage:=TLazPackage(DependencyPath[0]);
5660 Result:=IDEMessageDialogAb(lisPkgMangPackageIsRequired,
5661 Format(lisPkgMangThePackageIsRequiredByWhichIsMarkedForInstallation,
5662 [APackage.IDAsString, ParentPackage.IDAsString, LineEnding]),
5663 mtError,[mbCancel],ShowAbort);
5664 exit;
5665 end;
5666
5667 // check if package is a lazarus base package
5668 if PackageGraph.IsStaticBasePackage(APackage.Name) then begin
5669 Result:=IDEMessageDialogAb(lisUninstallImpossible,
5670 Format(lisThePackageCanNotBeUninstalledBecauseItIsNeededByTh,[APackage.Name]),
5671 mtError,[mbCancel],ShowAbort);
5672 exit;
5673 end;
5674
5675 // confirm uninstall package
5676 if not (puifDoNotConfirm in Flags) then begin
5677 Result:=IDEMessageDialogAb(lisPkgMangUninstallPackage,
5678 Format(lisPkgMangUninstallPackage2, [APackage.IDAsString]),
5679 mtConfirmation,[mbYes,mbCancel],ShowAbort);
5680 if Result<>mrYes then exit;
5681 end;
5682
5683 PackageGraph.BeginUpdate(true);
5684 try
5685 // save package
5686 if APackage.IsVirtual or APackage.Modified then begin
5687 Result:=DoSavePackage(APackage,[]);
5688 if Result<>mrOk then exit;
5689 end;
5690
5691 // remove package from auto installed packages
5692 if APackage.AutoInstall<>pitNope then begin
5693 APackage.AutoInstall:=pitNope;
5694 Dependency:=FindCompatibleDependencyInList(PackageGraph.FirstAutoInstallDependency,
5695 pddRequires,APackage);
5696 if Dependency<>nil then begin
5697 Dependency.RemoveFromList(PackageGraph.FirstAutoInstallDependency,pddRequires);
5698 Dependency.Free;
5699 PackageGraph.SortAutoInstallDependencies;
5700 end;
5701 SaveAutoInstallDependencies;
5702 end;
5703
5704 // save IDE build configs, so user can build IDE on command line
5705 BuildIDEFlags:=[blfDontClean,blfOnlyIDE];
5706 Result:=MainIDE.DoSaveBuildIDEConfigs(BuildIDEFlags);
5707 if Result<>mrOk then exit;
5708
5709 if not (puifDoNotBuildIDE in Flags) then begin
5710 // ask user to rebuilt Lazarus now
5711 Result:=IDEMessageDialog(lisPkgMangRebuildLazarus,
5712 Format(lisPkgMangThePackageWasMarkedCurrentlyLazarus,
5713 [APackage.IDAsString, LineEnding, LineEnding+LineEnding]),
5714 mtConfirmation,[mbYes,mbNo]);
5715 if Result=mrNo then begin
5716 Result:=mrOk;
5717 exit;
5718 end;
5719
5720 // rebuild Lazarus
5721 Result:=MainIDE.DoBuildLazarus(BuildIDEFlags);
5722 if Result<>mrOk then exit;
5723 end;
5724 finally
5725 PackageGraph.EndUpdate;
5726 end;
5727 Result:=mrOk;
5728 end;
5729
UninstallPackagenull5730 function TPkgManager.UninstallPackage(APackage: TIDEPackage; ShowAbort: boolean): TModalResult;
5731 begin
5732 Assert(APackage is TLazPackage, 'TPkgManager.DoUninstallPackage: APackage is not TLazPackage');
5733 Result := DoUninstallPackage(TLazPackage(APackage), [puifDoNotConfirm, puifDoNotBuildIDE], ShowAbort);
5734 end;
5735
CheckInstallPackageListnull5736 function TPkgManager.CheckInstallPackageList(PkgIDList: TObjectList;
5737 Flags: TPkgInstallInIDEFlags): boolean;
5738 var
5739 NewFirstAutoInstallDependency: TPkgDependency;
5740
5741 procedure DeleteDependency(ADependency: TPkgDependency);
5742 var
5743 i: Integer;
5744 PkgID: TLazPackageID;
5745 PkgName: string;
5746 begin
5747 PkgName := ADependency.PackageName; // DeleteDependencyInList destroys ADependency -> don't use it anymore!
5748 DeleteDependencyInList(ADependency,NewFirstAutoInstallDependency,pddRequires);
5749 if piiifRemoveConflicts in Flags then
5750 for i:=PkgIDList.Count-1 downto 0 do begin
5751 PkgID:=TLazPackageID(PkgIDList[i]);
5752 if SysUtils.CompareText(PkgID.Name,PkgName)=0 then
5753 PkgIDList.Delete(i); // PkgID is automatically destroyed
5754 end;
5755 end;
5756
5757 var
5758 PkgList: TFPList;
5759 i: Integer;
5760 APackage: TLazPackage;
5761 ADependency: TPkgDependency;
5762 NextDependency: TPkgDependency;
5763 SaveFlags: TPkgSaveFlags;
5764 ConflictDep: TPkgDependency;
5765 begin
5766 Result:=false;
5767 PkgList:=nil;
5768 try
5769 // create new auto install dependency PkgIDList
5770 ListPkgIDToDependencyList(PkgIDList,NewFirstAutoInstallDependency,
5771 pddRequires,Self,true);
5772
5773 // load all required packages
5774 if LoadDependencyList(NewFirstAutoInstallDependency,piiifQuiet in Flags)<>mrOk then exit;
5775
5776 // remove all top level runtime packages from the list
5777 // Note: it's ok if a designtime package uses a runtime package
5778 ADependency:=NewFirstAutoInstallDependency;
5779 while ADependency<>nil do begin
5780 NextDependency:=ADependency.NextRequiresDependency;
5781 if (ADependency.RequiredPackage<>nil) then begin
5782 if (ADependency.RequiredPackage.PackageType in [lptRunTime,lptRunTimeOnly])
5783 then begin
5784 // top level dependency on runtime package => delete
5785 DeleteDependency(ADependency);
5786 end else begin
5787 ConflictDep:=PackageGraph.FindRuntimePkgOnlyRecursively(
5788 ADependency.RequiredPackage.FirstRequiredDependency);
5789 //debugln(['TPkgManager.CheckInstallPackageList ',ADependency.RequiredPackage.Name,' ',ConflictDep<>nil]);
5790 if ConflictDep<>nil then begin
5791 if piiifRemoveConflicts in Flags then begin
5792 // can remove conflict
5793 if not (piiifQuiet in Flags)
5794 and (IDEQuestionDialog(lisNotADesigntimePackage,
5795 Format(lisThePackageCanNotBeInstalledBecauseItRequiresWhichI, [
5796 ADependency.RequiredPackage.Name, ConflictDep.AsString]),
5797 mtError,
5798 [mrYes, Format(lisUninstall, [ADependency.RequiredPackage.Name]), mrCancel]
5799 )<>mrYes)
5800 then
5801 exit;
5802 end else begin
5803 // can not remove conflict
5804 if not (piiifQuiet in Flags) then
5805 IDEQuestionDialog(lisNotADesigntimePackage,
5806 Format(lisThePackageCanNotBeInstalledBecauseItRequiresWhichI, [
5807 ADependency.RequiredPackage.Name, ConflictDep.AsString]),
5808 mtError,[mrCancel]);
5809 exit;
5810 end;
5811 // dependency needs a runtime only package => delete
5812 DeleteDependency(ADependency);
5813 end;
5814 end;
5815 end;
5816 ADependency:=NextDependency;
5817 end;
5818
5819 PackageGraph.GetAllRequiredPackages(nil,NewFirstAutoInstallDependency,PkgList);
5820
5821 // try save all modified packages
5822 for i:=0 to PkgList.Count-1 do begin
5823 APackage:=TLazPackage(PkgList[i]);
5824 if (not APackage.UserReadOnly)
5825 and (APackage.IsVirtual or APackage.Modified) then begin
5826 SaveFlags:=[];
5827 if DoSavePackage(APackage,SaveFlags)<>mrOk then exit;
5828 end;
5829 end;
5830
5831 Result:=true;
5832 finally
5833 FreeDependencyList(NewFirstAutoInstallDependency,pddRequires);
5834 PkgList.Free;
5835 end;
5836 end;
5837
InstallPackagesnull5838 function TPkgManager.InstallPackages(PkgIdList: TObjectList;
5839 Flags: TPkgInstallInIDEFlags): TModalResult;
5840
5841 procedure CreateChangeReport(
5842 OldDependencyList, NewDependencyList: TPkgDependency; Report: TStrings);
5843 var
5844 CurDependency: TPkgDependency;
5845 OldDependency: TPkgDependency;
5846 NewDependency: TPkgDependency;
5847 s: String;
5848 begin
5849 // list all packages, that will be installed
5850 CurDependency:=NewDependencyList;
5851 while CurDependency<>nil do begin
5852 s:=CurDependency.AsString;
5853 OldDependency:=FindDependencyByNameInList(OldDependencyList,pddRequires,
5854 CurDependency.PackageName);
5855 if OldDependency=nil then begin
5856 // newly installed
5857 s:=s+'|'+lisPkgMgrNew;
5858 Report.Add(s);
5859 end;
5860 CurDependency:=CurDependency.NextRequiresDependency;
5861 end;
5862
5863 // list all packages, that will be removed
5864 CurDependency:=OldDependencyList;
5865 while CurDependency<>nil do begin
5866 NewDependency:=FindDependencyByNameInList(NewDependencyList,pddRequires,
5867 CurDependency.PackageName);
5868 if NewDependency=nil then
5869 // this package will be removed
5870 Report.Add('|'+lisPkgMgrRemove+'|'+CurDependency.AsString);
5871 CurDependency:=CurDependency.NextRequiresDependency;
5872 end;
5873
5874 // list all packages, that are kept
5875 CurDependency:=NewDependencyList;
5876 while CurDependency<>nil do begin
5877 s:=CurDependency.AsString;
5878 OldDependency:=FindDependencyByNameInList(OldDependencyList,pddRequires,
5879 CurDependency.PackageName);
5880 if OldDependency<>nil then begin
5881 // stay installed
5882 if CurDependency.AsString<>OldDependency.AsString then
5883 s:=s+'|'+lisPkgMgrKeep+'|'+OldDependency.AsString;
5884 Report.Add(s);
5885 end;
5886 CurDependency:=CurDependency.NextRequiresDependency;
5887 end;
5888 end;
5889
5890 var
5891 NewFirstAutoInstallDependency: TPkgDependency;
5892 BuildIDEFlags: TBuildLazarusFlags;
5893 Report: TStringList;
5894 PkgList: TFPList;
5895 RequiredPackage: TLazPackage;
5896 i: Integer;
5897 CurDependency: TPkgDependency;
5898 OldID: TLazPackageID;
5899 begin
5900 Result:=mrCancel;
5901 NewFirstAutoInstallDependency:=nil;
5902 PkgList:=nil;
5903 try
5904 if not (piiifClear in Flags) then
5905 begin
5906 // add existing install packages to list
5907 NewFirstAutoInstallDependency:=PackageGraph.FirstAutoInstallDependency;
5908 while NewFirstAutoInstallDependency<>nil do begin
5909 if NewFirstAutoInstallDependency.RequiredPackage<>nil then begin
5910 i:=PkgIdList.Count-1;
5911 while (i>=0)
5912 and (TLazPackageID(PkgIdList[i]).Compare(NewFirstAutoInstallDependency.RequiredPackage)<>0)
5913 do dec(i);
5914 if i<0 then begin
5915 OldID:=TLazPackageID.Create;
5916 OldID.AssignID(NewFirstAutoInstallDependency.RequiredPackage);
5917 PkgIdList.Add(OldID);
5918 end;
5919 end;
5920 NewFirstAutoInstallDependency:=NewFirstAutoInstallDependency.NextRequiresDependency;
5921 end;
5922 end;
5923
5924 if not (piiifSkipChecks in Flags) then
5925 begin
5926 if not CheckInstallPackageList(PkgIDList,Flags*[piiifQuiet,piiifRemoveConflicts]) then
5927 exit(mrCancel);
5928 end;
5929
5930 // create new auto install dependency PkgIDList
5931 ListPkgIDToDependencyList(PkgIDList,NewFirstAutoInstallDependency,
5932 pddRequires,Self,true);
5933
5934 PackageGraph.SortDependencyListTopologicallyOld(NewFirstAutoInstallDependency,
5935 false);
5936
5937 if not (piiifQuiet in Flags) then
5938 begin
5939 // tell the user, which packages will stay, which will be removed and
5940 // which will be newly installed
5941 try
5942 Report:=TStringList.Create;
5943 CreateChangeReport(
5944 PackageGraph.FirstAutoInstallDependency,NewFirstAutoInstallDependency,
5945 Report);
5946 if not ConfirmPackageList(Report) then exit(mrCancel);
5947 finally
5948 Report.Free;
5949 end;
5950 end;
5951
5952 // try to commit changes -> replace install list
5953 PackageGraph.BeginUpdate(true);
5954 try
5955 // get all required packages
5956 //debugln('TPkgManager.MainIDEitmPkgEditInstallPkgsClick GetAllRequiredPackages for ',DependencyListAsString(NewFirstAutoInstallDependency,pddRequires));
5957 if LoadDependencyList(NewFirstAutoInstallDependency,false)<>mrOk then exit(mrCancel);
5958 PackageGraph.GetAllRequiredPackages(nil,NewFirstAutoInstallDependency,PkgList);
5959
5960 // mark packages for installation
5961 //debugln('TPkgManager.MainIDEitmPkgEditInstallPkgsClick mark packages for installation');
5962 for i:=0 to PkgList.Count-1 do begin
5963 RequiredPackage:=TLazPackage(PkgList[i]);
5964 if RequiredPackage.AutoInstall=pitNope then begin
5965 RequiredPackage.AutoInstall:=pitStatic;
5966 end;
5967 end;
5968
5969 // mark packages for uninstall
5970 //debugln('TPkgManager.MainIDEitmPkgEditInstallPkgsClick mark packages for uninstall');
5971 CurDependency:=PackageGraph.FirstAutoInstallDependency;
5972 while CurDependency<>nil do begin
5973 if (CurDependency.RequiredPackage<>nil)
5974 and (not PackageGraph.IsStaticBasePackage(CurDependency.PackageName)) then
5975 CurDependency.RequiredPackage.AutoInstall:=pitNope;
5976 CurDependency:=CurDependency.NextRequiresDependency;
5977 end;
5978
5979 // replace install list
5980 //debugln('TPkgManager.MainIDEitmPkgEditInstallPkgsClick replace install list');
5981 FreeDependencyList(PackageGraph.FirstAutoInstallDependency,pddRequires);
5982 PackageGraph.FirstAutoInstallDependency:=NewFirstAutoInstallDependency;
5983 NewFirstAutoInstallDependency:=nil;
5984 finally
5985 PackageGraph.EndUpdate;
5986 end;
5987
5988 // save package list
5989 //debugln('TPkgManager.MainIDEitmPkgEditInstallPkgsClick save package list');
5990 PackageGraph.SortAutoInstallDependencies;
5991 SaveAutoInstallDependencies;
5992
5993 // save IDE build configs, so user can build IDE on command line
5994 BuildIDEFlags:=[blfDontClean,blfOnlyIDE];
5995 if MainIDE.DoSaveBuildIDEConfigs(BuildIDEFlags)<>mrOk then exit(mrCancel);
5996
5997 if piiifRebuildIDE in Flags then
5998 begin
5999 // rebuild Lazarus
6000 if MainIDE.DoBuildLazarus(BuildIDEFlags)<>mrOk then exit(mrCancel);
6001 end;
6002
6003 finally
6004 FreeDependencyList(NewFirstAutoInstallDependency,pddRequires);
6005 PkgList.Free;
6006 end;
6007 Result:=mrOk;
6008 end;
6009
DoOpenPackageSourcenull6010 function TPkgManager.DoOpenPackageSource(APackage: TLazPackage): TModalResult;
6011 var
6012 Filename: String;
6013 begin
6014 Result:=mrCancel;
6015 if APackage.IsVirtual then begin
6016 IDEMessageDialog(lisCCOErrorCaption,
6017 lisPkgMangThisIsAVirtualPackageItHasNoSourceYetPleaseSaveThe,
6018 mtError, [mbCancel]);
6019 exit;
6020 end;
6021 Filename:=APackage.GetSrcFilename;
6022 if (not FilenameIsAbsolute(Filename)) or (not FileExistsCached(Filename)) then begin
6023 IDEMessageDialog(lisCCOErrorCaption, lisPkgMangPleaseCompileThePackageFirst,
6024 mtError,[mbCancel]);
6025 exit;
6026 end;
6027 Result:=MainIDE.DoOpenEditorFile(Filename,-1,-1,[ofRegularFile]);
6028 end;
6029
DoCompileAutoInstallPackagesnull6030 function TPkgManager.DoCompileAutoInstallPackages(Flags: TPkgCompileFlags;
6031 OnlyBase: boolean): TModalResult;
6032 var
6033 Dependency: TPkgDependency;
6034 OldDependency: TPkgDependency;
6035 Dependencies: TPkgDependency;
6036 AutoRemove: Boolean;
6037 CompilePolicy: TPackageUpdatePolicy;
6038 begin
6039 PackageGraph.BeginUpdate(false);
6040 Dependencies:=PackageGraph.FirstAutoInstallDependency;
6041 try
6042 if OnlyBase then
6043 begin
6044 // create the list of base packages
6045 OldDependency:=PackageGraph.FirstAutoInstallDependency;
6046 Dependencies:=nil;
6047 while OldDependency<>nil do begin
6048 if (OldDependency.RequiredPackage<>nil)
6049 and PackageGraph.IsStaticBasePackage(OldDependency.RequiredPackage.Name) then
6050 begin
6051 Dependency:=TPkgDependency.Create;
6052 Dependency.Assign(OldDependency);
6053 Dependency.AddToEndOfList(Dependencies,pddRequires);
6054 end;
6055 OldDependency:=OldDependency.NextRequiresDependency;
6056 end;
6057 Dependencies:=GetFirstDependency(Dependencies,pddRequires);
6058 PackageGraph.OpenRequiredDependencyList(Dependencies);
6059 end;
6060
6061 // check every installed package if it was loaded correctly
6062 Dependency:=Dependencies;
6063 AutoRemove:=false;
6064 while Dependency<>nil do begin
6065 OldDependency:=Dependency;
6066 Dependency:=Dependency.NextRequiresDependency;
6067 if OldDependency.LoadPackageResult<>lprSuccess then begin
6068 if not AutoRemove then begin
6069 Result:=IDEMessageDialog(lisProjAddPackageNotFound,
6070 Format(lisPkgMangThePackageIsMarkedForInstallationButCanNotBeFound,
6071 [OldDependency.AsString, LineEnding]),
6072 mtError,[mbYes,mbYesToAll,mbAbort]);
6073 case Result of
6074 mrYes: ;
6075 mrYesToAll: AutoRemove:=true;
6076 else
6077 SaveAutoInstallDependencies;
6078 exit;
6079 end;
6080 end;
6081 OldDependency.RemoveFromList(PackageGraph.FirstAutoInstallDependency,pddRequires);
6082 OldDependency.Free;
6083 end;
6084 end;
6085 SaveAutoInstallDependencies;
6086
6087 // check consistency
6088 Result:=CheckPackageGraphForCompilation(nil,Dependencies,
6089 EnvironmentOptions.GetParsedLazarusDirectory,false);
6090 if Result<>mrOk then begin
6091 if ConsoleVerbosity>0 then
6092 debugln(['Error: (lazarus) [TPkgManager.DoCompileAutoInstallPackages] CheckPackageGraphForCompilation failed']);
6093 exit;
6094 end;
6095 //DebugLn(['TPkgManager.DoCompileAutoInstallPackages LCLUnitPath=',PackageGraph.LCLPackage.CompilerOptions.GetUnitPath(true)]);
6096
6097 // save all open files
6098 if not (pcfDoNotSaveEditorFiles in Flags) then begin
6099 Result:=MainIDE.DoSaveForBuild(crCompile);
6100 if Result<>mrOk then begin
6101 if ConsoleVerbosity>0 then
6102 debugln(['Error: (lazarus) [TPkgManager.DoCompileAutoInstallPackages] MainIDE.DoSaveForBuild failed']);
6103 exit;
6104 end;
6105 end;
6106
6107 // compile all auto install dependencies
6108 CompilePolicy:=pupAsNeeded;
6109 if pcfCompileDependenciesClean in Flags then
6110 CompilePolicy:=pupOnRebuildingAll;
6111 Result:=PackageGraph.CompileRequiredPackages(nil,Dependencies,false,
6112 CompilePolicy);
6113 if Result<>mrOk then begin
6114 if ConsoleVerbosity>0 then
6115 debugln(['Error: (lazarus) [TPkgManager.DoCompileAutoInstallPackages] PackageGraph.CompileRequiredPackages failed']);
6116 exit;
6117 end;
6118
6119 finally
6120 if OnlyBase then
6121 FreeDependencyList(Dependencies,pddRequires);
6122 PackageGraph.EndUpdate;
6123 end;
6124 Result:=mrOk;
6125 end;
6126
DoSaveAutoInstallConfignull6127 function TPkgManager.DoSaveAutoInstallConfig: TModalResult;
6128 var
6129 TargetDir: String;
6130 begin
6131 TargetDir:=MiscellaneousOptions.BuildLazProfiles.Current.TargetDirectory;
6132 IDEMacros.SubstituteMacros(TargetDir);
6133 TargetDir:=TrimFilename(TargetDir);
6134 if not ForceDirectory(TargetDir) then begin
6135 Result:=IDEMessageDialog(lisPkgMangUnableToCreateDirectory,
6136 Format(lisPkgMangUnableToCreateTargetDirectoryForLazarus,
6137 [LineEnding, TargetDir, LineEnding]),
6138 mtError,[mbCancel,mbAbort]);
6139 exit;
6140 end;
6141
6142 Result:=PackageGraph.SaveAutoInstallConfig;
6143 end;
6144
DoPublishPackagenull6145 function TPkgManager.DoPublishPackage(APackage: TLazPackage;
6146 Flags: TPkgSaveFlags; ShowDialog: boolean): TModalResult;
6147 begin
6148 // show the publish dialog
6149 if ShowDialog then begin
6150 Result:=ShowPublishDialog(APackage.PublishOptions);
6151 if Result<>mrOk then exit;
6152 end;
6153
6154 // save package
6155 Result:=DoSavePackage(APackage,Flags);
6156 if Result<>mrOk then exit;
6157
6158 // publish package
6159 Result:=PublishAModule(APackage.PublishOptions);
6160 end;
6161
GetUsableComponentUnitsnull6162 function TPkgManager.GetUsableComponentUnits(CurRoot: TPersistent): TFPList;
6163 var
6164 FMainUnitInfo: TUnitInfo;
6165 FMainUnitInfoValid: boolean;
6166 FMainOwner: TObject;
6167 FMainOwnerValid: boolean;
6168
6169 function MainUnitInfo: TUnitInfo;
6170 begin
6171 if not FMainUnitInfoValid then
6172 begin
6173 if CurRoot is TComponent then
6174 FMainUnitInfo := Project1.UnitWithComponent(TComponent(CurRoot));
6175 FMainUnitInfoValid := True;
6176 end;
6177 Result := FMainUnitInfo;
6178 end;
6179
6180 function MainOwner: TObject;
6181 var
6182 Owners: TFPList;
6183 begin
6184 if not FMainOwnerValid then
6185 begin
6186 if MainUnitInfo <> nil then
6187 begin
6188 if MainUnitInfo.IsPartOfProject then
6189 FMainOwner := Project1
6190 else
6191 begin
6192 Owners := GetOwnersOfUnit(MainUnitInfo.Filename);
6193 if (Owners <> nil) and (Owners.Count > 0) then
6194 FMainOwner := TObject(Owners[0]);
6195 Owners.Free;
6196 end;
6197 end;
6198 FMainOwnerValid := True;
6199 end;
6200 Result := FMainOwner;
6201 end;
6202
6203 procedure CheckUnit(AnUnitInfo: TUnitInfo);
6204 var
6205 Owners: TFPList;
6206 OtherOwner: TObject;
6207 APackage: TLazPackage;
6208 ConflictDependency: TPkgDependency;
6209 FirstDependency: TPkgDependency;
6210 begin
6211 if (AnUnitInfo.Component=nil)
6212 or (AnUnitInfo.Component=CurRoot) then
6213 exit;
6214 // check if the component can be used
6215 // A component can only be used, if it has a CreateForm statement in the lpr
6216 // A unit can not be used, if it has no owner (project/package).
6217 // And a unit can not be used, if it belongs to a higher level package.
6218 // For example: Package A uses Package B.
6219 // A can use units of B, but B can not use units of A.
6220 if AnUnitInfo.IsPartOfProject and MainUnitInfo.IsPartOfProject then
6221 begin
6222 // both units belong to the project => ok
6223 end else if AnUnitInfo.IsPartOfProject then
6224 begin
6225 // AnUnitInfo belongs to Project, but MainUnitInfo does not
6226 // A project unit can only be used by the project => not allowed
6227 exit;
6228 end else
6229 begin
6230 Owners:=GetOwnersOfUnit(AnUnitInfo.Filename);
6231 if (Owners=nil) or (Owners.Count=0) then begin
6232 // AnUnitInfo does not belong to a project or package
6233 // => this unit can not be used
6234 Owners.Free;
6235 exit;
6236 end;
6237 OtherOwner:=TObject(Owners[0]);
6238 Owners.Free;
6239 if OtherOwner=MainOwner then begin
6240 // both units belong to the same owner => ok
6241 end else if (OtherOwner is TLazPackage) then begin
6242 // check if MainOwner can use the package
6243 APackage:=TLazPackage(OtherOwner);
6244 if MainOwner is TProject then
6245 FirstDependency:=TProject(MainOwner).FirstRequiredDependency
6246 else if MainOwner is TLazPackage then
6247 FirstDependency:=TLazPackage(MainOwner).FirstRequiredDependency
6248 else
6249 exit;
6250 ConflictDependency:=PackageGraph.FindConflictRecursively(
6251 FirstDependency,APackage);
6252 if ConflictDependency<>nil then exit;
6253 if MainOwner is TLazPackage then begin
6254 // check if package already uses MainOwner
6255 ConflictDependency:=PackageGraph.FindDependencyRecursively(
6256 APackage.FirstRequiredDependency,TLazPackage(MainOwner).Name);
6257 if ConflictDependency<>nil then exit;
6258 end;
6259 end else begin
6260 // AnUnitInfo does not belong to a Package => can not be used
6261 exit;
6262 end;
6263 end;
6264 // this unit can be used -> add components
6265 if Result=nil then
6266 Result:=TFPList.Create;
6267 Result.Add(AnUnitInfo);
6268 end;
6269
6270 var
6271 AnUnitInfo: TUnitInfo;
6272 begin
6273 Result:=nil;
6274 if not (CurRoot is TComponent) then exit;
6275 FMainOwner:=nil;
6276 FMainOwnerValid:=false;
6277 FMainUnitInfo:=nil;
6278 FMainUnitInfoValid:=false;
6279 if (MainOwner=nil) or (MainUnitInfo=nil) then exit;
6280 // search all open designer forms (can be hidden)
6281 AnUnitInfo:=Project1.FirstUnitWithComponent;
6282 while AnUnitInfo<>nil do begin
6283 CheckUnit(AnUnitInfo);
6284 AnUnitInfo:=AnUnitInfo.NextUnitWithComponent;
6285 end;
6286 end;
6287
6288 procedure TPkgManager.IterateComponentNames(CurRoot: TPersistent;
6289 TypeData: PTypeData; Proc: TGetStrProc);
6290
6291 procedure CheckComponent(aRoot: TComponent);
6292 var
6293 i: integer;
6294 CurName: String;
6295 begin
6296 if aRoot = nil then exit;
6297 if (aRoot <> CurRoot) and (aRoot is TypeData^.ClassType) then
6298 Proc(aRoot.Name);
6299 for i := 0 to aRoot.ComponentCount - 1 do
6300 if (aRoot.Components[i] is TypeData^.ClassType) then
6301 begin
6302 CurName := aRoot.Components[i].Name;
6303 if aRoot <> CurRoot then
6304 CurName := aRoot.Name + '.' + CurName;
6305 Proc(CurName);
6306 end;
6307 end;
6308
6309 var
6310 UnitList: TFPList;
6311 i: Integer;
6312 begin
6313 if not (CurRoot is TComponent) then exit;
6314 CheckComponent(TComponent(CurRoot));
6315 UnitList := GetUsableComponentUnits(CurRoot);
6316 if UnitList = nil then exit;
6317 try
6318 for i := 0 to UnitList.Count - 1 do
6319 CheckComponent(TUnitInfo(UnitList[i]).Component);
6320 finally
6321 UnitList.Free;
6322 end;
6323 end;
6324
FindReferencedRootComponentnull6325 function TPkgManager.FindReferencedRootComponent(CurRoot: TPersistent;
6326 const ComponentName: string): TComponent;
6327 var
6328 UnitList: TFPList;
6329 ARoot: TComponent;
6330 i: integer;
6331 begin
6332 //DebugLn(['search ', ComponentName, ' CurRoot = ', dbgsName(CurRoot)]);
6333 Result := nil;
6334 UnitList := GetUsableComponentUnits(CurRoot);
6335 if UnitList = nil then
6336 Exit;
6337 try
6338 for i := 0 to UnitList.Count - 1 do
6339 begin
6340 ARoot := TUnitInfo(UnitList[i]).Component;
6341 DebugLn(['Hint: (lazarus) [TPkgManager.FindReferencedRootComponent] Root=',dbgsName(CurRoot),' Searched="',ComponentName,'" other root=',dbgsName(ARoot)]);
6342 if (ARoot <> nil) and (SysUtils.CompareText(ComponentName, ARoot.Name) = 0) then
6343 begin
6344 Result := ARoot;
6345 break;
6346 end;
6347 end;
6348 finally
6349 UnitList.Free;
6350 end;
6351 //DebugLn('search end');
6352 end;
6353
FindUsableComponentnull6354 function TPkgManager.FindUsableComponent(CurRoot: TPersistent;
6355 const ComponentPath: string): TComponent;
6356
6357 procedure CheckComponent(const RootName, SubPath: string; aRoot: TComponent);
6358 var
6359 i: integer;
6360 begin
6361 if aRoot = nil then exit;
6362 if (SysUtils.CompareText(RootName, aRoot.Name) <> 0) then exit;
6363
6364 if SubPath = '' then
6365 begin
6366 Result := aRoot;
6367 Exit;
6368 end;
6369
6370 for i := 0 to aRoot.ComponentCount - 1 do
6371 if SysUtils.CompareText(aRoot.Components[i].Name, SubPath) = 0 then
6372 begin
6373 Result := aRoot.Components[i];
6374 exit;
6375 end;
6376 end;
6377
6378 var
6379 UnitList: TFPList;
6380 SubPath: String;
6381 p: LongInt;
6382 RootName: String;
6383 i: Integer;
6384 begin
6385 Result := nil;
6386 if not (CurRoot is TComponent) then exit;
6387 SubPath := ComponentPath;
6388 p := System.Pos('.',SubPath);
6389 if p < 1 then
6390 RootName := ''
6391 else begin
6392 RootName := copy(ComponentPath, 1, p - 1);
6393 SubPath := copy(SubPath, p + 1, length(SubPath));
6394 end;
6395 if (RootName = '') or (SysUtils.CompareText(RootName, TComponent(CurRoot).Name) = 0) then
6396 CheckComponent(TComponent(CurRoot).Name, SubPath, TComponent(CurRoot));
6397 if (p < 1) then
6398 if Result = nil then
6399 begin
6400 RootName := SubPath;
6401 SubPath := '';
6402 end
6403 else
6404 exit;
6405 UnitList := GetUsableComponentUnits(CurRoot);
6406 if UnitList = nil then exit;
6407 try
6408 for i := 0 to UnitList.Count-1 do
6409 begin
6410 CheckComponent(RootName, SubPath, TUnitInfo(UnitList[i]).Component);
6411 if Result <> nil then exit;
6412 end;
6413 finally
6414 UnitList.Free;
6415 end;
6416 end;
6417
ProjectInspectorAddDependencynull6418 function TPkgManager.ProjectInspectorAddDependency(Sender: TObject;
6419 ADependency: TPkgDependency): TModalResult;
6420 begin
6421 Result:=AddProjectDependency(Project1,ADependency);
6422 end;
6423
ProjectInspectorRemoveDependencynull6424 function TPkgManager.ProjectInspectorRemoveDependency(Sender: TObject;
6425 ADependency: TPkgDependency): TModalResult;
6426 var
6427 ShortUnitName: String;
6428 Dummy: Boolean;
6429 begin
6430 Result:=mrOk;
6431 Project1.RemoveRequiredDependency(ADependency);
6432 //debugln('TPkgManager.OnProjectInspectorRemoveDependency A');
6433 Project1.DefineTemplates.AllChanged(false);
6434 if (Project1.MainUnitID>=0)
6435 and (pfMainUnitIsPascalSource in Project1.Flags)
6436 then begin
6437 MainIDE.SaveSourceEditorChangesToCodeCache(nil);
6438 ShortUnitName:=ADependency.PackageName;
6439 //debugln('TPkgManager.OnProjectInspectorRemoveDependency B ShortUnitName="',ShortUnitName,'"');
6440 if (ShortUnitName<>'') then begin
6441 Dummy:=CodeToolBoss.RemoveUnitFromAllUsesSections(
6442 Project1.MainUnitInfo.Source,ShortUnitName);
6443 if Dummy then
6444 Project1.MainUnitInfo.Modified:=true
6445 else begin
6446 MainIDEInterface.DoJumpToCodeToolBossError;
6447 Result:=mrCancel;
6448 exit;
6449 end;
6450 end;
6451 end;
6452 end;
6453
ProjectInspectorReAddDependencynull6454 function TPkgManager.ProjectInspectorReAddDependency(Sender: TObject;
6455 ADependency: TPkgDependency): TModalResult;
6456 begin
6457 Result:=mrOk;
6458 Project1.ReaddRemovedDependency(ADependency);
6459 PackageGraph.OpenDependency(ADependency,false);
6460 if (ADependency.RequiredPackage<>nil)
6461 and (not ADependency.RequiredPackage.Missing) then begin
6462 AddUnitToProjectMainUsesSection(Project1,ADependency.PackageName,'');
6463 end;
6464 end;
6465
6466 procedure TPkgManager.ProjectInspectorDragDropTreeView(Sender, Source: TObject;
6467 X, Y: Integer);
6468 begin
6469 {$IFDEF VerbosePkgEditDrag}
6470 debugln(['TPkgManager.OnProjectInspectorDragDropTreeView START']);
6471 {$ENDIF}
6472 FilesEditDragDrop(Sender, Source, X, Y);
6473 {$IFDEF VerbosePkgEditDrag}
6474 debugln(['TPkgManager.OnProjectInspectorDragDropTreeView END']);
6475 {$ENDIF}
6476 end;
6477
ProjectInspectorDragOverTreeViewnull6478 function TPkgManager.ProjectInspectorDragOverTreeView(Sender,
6479 Source: TObject; X, Y: Integer; out TargetTVNode: TTreeNode; out
6480 TargetTVType: TTreeViewInsertMarkType): boolean;
6481 var
6482 SrcFilesEdit: IFilesEditorInterface;
6483 TargetFilesEdit: IFilesEditorInterface;
6484 aFileCount: integer;
6485 aDependencyCount: integer;
6486 aDirectoryCount: integer;
6487 begin
6488 {$IFDEF VerbosePkgEditDrag}
6489 debugln(['TPkgManager.OnProjectInspectorDragOverTreeView ']);
6490 {$ENDIF}
6491 Result:=CheckDrag(Sender, Source, X, Y, SrcFilesEdit, TargetFilesEdit,
6492 aFileCount, aDependencyCount, aDirectoryCount, TargetTVNode, TargetTVType);
6493 end;
6494
6495 procedure TPkgManager.ProjectInspectorCopyMoveFiles(Sender: TObject);
6496 begin
6497 CopyMoveFiles(Sender);
6498 end;
6499
CanClosePackageEditornull6500 function TPkgManager.CanClosePackageEditor(APackage: TLazPackage): TModalResult;
6501 begin
6502 Result:=APackage.Editor.CanCloseEditor;
6503 end;
6504
CanCloseAllPackageEditorsnull6505 function TPkgManager.CanCloseAllPackageEditors: TModalResult;
6506 var
6507 APackage: TLazPackage;
6508 i: Integer;
6509 begin
6510 for i:=0 to PackageEditors.Count-1 do begin
6511 APackage:=PackageEditors.Editors[i].LazPackage;
6512 Result:=CanClosePackageEditor(APackage);
6513 if Result<>mrOk then exit;
6514 end;
6515 Result:=mrOk;
6516 end;
6517
CanOpenDesignerFormnull6518 function TPkgManager.CanOpenDesignerForm(AnUnitInfo: TUnitInfo;
6519 Interactive: boolean): TModalResult;
6520 var
6521 AProject: TProject;
6522 begin
6523 Result:=mrCancel;
6524 if AnUnitInfo=nil then exit;
6525 AProject:=AnUnitInfo.Project;
6526 if AProject=nil then exit;
6527 Result:=CheckProjectHasInstalledPackages(AProject,Interactive);
6528 end;
6529
DoClosePackageEditornull6530 function TPkgManager.DoClosePackageEditor(APackage: TLazPackage): TModalResult;
6531 begin
6532 if APackage.Editor<>nil then
6533 APackage.Editor.Free;
6534 Result:=mrOk;
6535 end;
6536
DoSaveAllPackagesnull6537 function TPkgManager.DoSaveAllPackages(Flags: TPkgSaveFlags): TModalResult;
6538 var
6539 AllSaved: Boolean;
6540 i: Integer;
6541 CurPackage: TLazPackage;
6542 begin
6543 try
6544 repeat
6545 AllSaved:=true;
6546 i:=0;
6547 while i<PackageGraph.Count do begin
6548 CurPackage:=PackageGraph[i];
6549 if CurPackage.Modified and (not CurPackage.ReadOnly)
6550 and (not (lpfSkipSaving in CurPackage.Flags)) then begin
6551 Result:=DoSavePackage(CurPackage,Flags);
6552 if Result=mrIgnore then begin
6553 CurPackage.Flags:=CurPackage.Flags+[lpfSkipSaving];
6554 Result:=mrOk;
6555 end;
6556 if Result<>mrOk then exit;
6557 AllSaved:=false;
6558 end;
6559 inc(i);
6560 end;
6561 until AllSaved;
6562 finally
6563 // clear all lpfSkipSaving flags
6564 for i:=0 to PackageGraph.Count-1 do begin
6565 CurPackage:=PackageGraph[i];
6566 CurPackage.Flags:=CurPackage.Flags-[lpfSkipSaving];
6567 end;
6568 end;
6569 Result:=mrOk;
6570 end;
6571
6572 { TLazPackageDescriptors }
6573
GetItemsnull6574 function TLazPackageDescriptors.GetItems(Index: integer): TPackageDescriptor;
6575 begin
6576 Result:=TPackageDescriptor(FItems[Index]);
6577 end;
6578
6579 constructor TLazPackageDescriptors.Create;
6580 begin
6581 PackageDescriptors:=Self;
6582 FItems:=TFPList.Create;
6583 end;
6584
6585 destructor TLazPackageDescriptors.Destroy;
6586 var
6587 i: Integer;
6588 begin
6589 fDestroying:=true;
6590 for i:=Count-1 downto 0 do Items[i].Release;
6591 FItems.Free;
6592 FItems:=nil;
6593 PackageDescriptors:=nil;
6594 inherited Destroy;
6595 end;
6596
Countnull6597 function TLazPackageDescriptors.Count: integer;
6598 begin
6599 Result:=FItems.Count;
6600 end;
6601
GetUniqueNamenull6602 function TLazPackageDescriptors.GetUniqueName(const Name: string): string;
6603 var
6604 i: Integer;
6605 begin
6606 Result:=Name;
6607 if IndexOf(Result)<0 then exit;
6608 i:=0;
6609 repeat
6610 inc(i);
6611 Result:=Name+IntToStr(i);
6612 until IndexOf(Result)<0;
6613 end;
6614
IndexOfnull6615 function TLazPackageDescriptors.IndexOf(const Name: string): integer;
6616 begin
6617 Result:=Count-1;
6618 while (Result>=0) and (UTF8CompareLatinTextFast(Name,Items[Result].Name)<>0) do
6619 dec(Result);
6620 end;
6621
FindByNamenull6622 function TLazPackageDescriptors.FindByName(const Name: string): TPackageDescriptor;
6623 var
6624 i: LongInt;
6625 begin
6626 i:=IndexOf(Name);
6627 if i>=0 then
6628 Result:=Items[i]
6629 else
6630 Result:=nil;
6631 end;
6632
6633 procedure TLazPackageDescriptors.RegisterDescriptor(Descriptor: TPackageDescriptor);
6634 begin
6635 if Descriptor.Name='' then
6636 raise Exception.Create('TLazPackageDescriptors.RegisterDescriptor Descriptor.Name empty');
6637 Descriptor.Name:=GetUniqueName(Descriptor.Name);
6638 FItems.Add(Descriptor);
6639 end;
6640
6641 procedure TLazPackageDescriptors.UnregisterDescriptor(Descriptor: TPackageDescriptor);
6642 var
6643 i: LongInt;
6644 begin
6645 if fDestroying then exit;
6646 i:=FItems.IndexOf(Descriptor);
6647 if i<0 then
6648 raise Exception.Create('TLazPackageDescriptors.UnregisterDescriptor');
6649 FItems.Delete(i);
6650 Descriptor.Release;
6651 end;
6652
6653 procedure TLazPackageDescriptors.AddDefaultPackageDescriptors;
6654 begin
6655 NewIDEItems.Add(TNewLazIDEItemCategoryPackage.Create(PkgDescGroupName));
6656 RegisterPackageDescriptor(TPackageDescriptorStd.Create);
6657 end;
6658
6659 { TPackageDescriptorStd }
6660
6661 constructor TPackageDescriptorStd.Create;
6662 begin
6663 inherited Create;
6664 Name:=PkgDescNameStandard;
6665 end;
6666
GetLocalizedNamenull6667 function TPackageDescriptorStd.GetLocalizedName: string;
6668 begin
6669 Result:=lisPackage;
6670 end;
6671
GetLocalizedDescriptionnull6672 function TPackageDescriptorStd.GetLocalizedDescription: string;
6673 begin
6674 Result:=Format(lisNewDlgCreateANewStandardPackageAPackageIsACollectionOfUn,
6675 [LineEnding]);
6676 end;
6677
6678 end.
6679
6680