1 {
2  *****************************************************************************
3   See the file COPYING.modifiedLGPL.txt, included in this distribution,
4   for details about the license.
5  *****************************************************************************
6 
7   Author: Mattias Gaertner
8 
9   Abstract:
10     Methods and Types to access the IDE packages.
11 }
12 unit PackageIntf;
13 
14 {$mode objfpc}{$H+}
15 
16 interface
17 
18 uses
19   Classes, SysUtils, contnrs,
20   // LazUtils
21   LazConfigStorage, LazMethodList, LazLoggerBase, UITypes,
22   // IdeIntf
23   NewItemIntf, ProjPackIntf, PackageDependencyIntf;
24 
25 const
26   PkgDescGroupName = 'Package';
27   PkgDescNameStandard = 'Standard Package';
28 
29 type
30   TPkgFileType = (
31     pftUnit,    // file is pascal unit
32     pftVirtualUnit,// file is virtual pascal unit
33     pftMainUnit, // file is the auto created main pascal unit
34     pftLFM,     // lazarus form text file
35     pftLRS,     // lazarus resource file
36     pftInclude, // include file
37     pftIssues,  // file is issues xml file
38     pftText,    // file is text (e.g. copyright or install notes)
39     pftBinary   // file is something else
40     );
41   TPkgFileTypes = set of TPkgFileType;
42 
43 const
44   PkgFileUnitTypes = [pftUnit,pftVirtualUnit,pftMainUnit];
45   PkgFileRealUnitTypes = [pftUnit,pftMainUnit];
46   PkgFileTypeIdents: array[TPkgFileType] of string = (
47     'Unit', 'Virtual Unit', 'Main Unit',
48     'LFM', 'LRS', 'Include', 'Issues', 'Text', 'Binary');
49 
50 type
51   TIDEPackage = class;
52 
53   { TLazPackageFile }
54 
55   TLazPackageFile = class(TIDEOwnedFile)
56   private
57     FDisableI18NForLFM: boolean;
58     FFileType: TPkgFileType;
59     FRemoved: boolean;
60   protected
GetInUsesnull61     function GetInUses: boolean; virtual; abstract;
62     procedure SetInUses(AValue: boolean); virtual; abstract;
GetIDEPackagenull63     function GetIDEPackage: TIDEPackage; virtual; abstract;
64     procedure SetRemoved(const AValue: boolean); virtual;
65     procedure SetDisableI18NForLFM(AValue: boolean); virtual;
66     procedure SetFileType(const AValue: TPkgFileType); virtual;
67   public
68     property LazPackage: TIDEPackage read GetIDEPackage;
69     property Removed: boolean read FRemoved write SetRemoved;
70     property DisableI18NForLFM: boolean read FDisableI18NForLFM write SetDisableI18NForLFM;
71     property FileType: TPkgFileType read FFileType write SetFileType;
72     property InUses: boolean read GetInUses write SetInUses; // added to uses section of package
73   end;
74 
75   { PkgDependency flags }
76 
77   TLoadPackageResult = (
78     lprUndefined,
79     lprSuccess,
80     lprNotFound,
81     lprLoadError
82     );
83 
84   { TPkgDependencyID }
85 
86   TPkgDependencyID = class(TPkgDependencyBase)
87   private
88     procedure SetRequiredPackage(const AValue: TIDEPackage);
89   protected
90     FLoadPackageResult: TLoadPackageResult;
91     FRequiredPackage: TIDEPackage;
92   public
93     constructor Create;
94     destructor Destroy; override;
95     procedure Clear; override;
96   public
97     property LoadPackageResult: TLoadPackageResult read FLoadPackageResult write FLoadPackageResult;
98     property RequiredIDEPackage: TIDEPackage read FRequiredPackage write SetRequiredPackage;
99   end;
100 
101   { TLazPackageID }
102 
103   TLazPackageID = class(TIDEProjPackBase)
104   private
105     FIDAsString: string;
106     FIDAsWord: string;
107   protected
108     FVersion: TPkgVersion;
109     procedure SetName(const NewName: TComponentName); override;
110     procedure UpdateIDAsString;
111     procedure VersionChanged(Sender: TObject); virtual;
GetDirectorynull112     function GetDirectory: string; override;
GetIDAsStringnull113     function GetIDAsString: string;
GetIDAsWordnull114     function GetIDAsWord: string;
115   public
116     procedure AssignOptions(Source: TPersistent); virtual;
117     constructor Create; virtual; reintroduce;
118     destructor Destroy; override;
StringToIDnull119     function StringToID(const s: string): boolean;
Comparenull120     function Compare(PackageID2: TLazPackageID): integer;
CompareMasknull121     function CompareMask(ExactPackageID: TLazPackageID): integer;
122     procedure AssignID(Source: TLazPackageID); virtual;
123   public
124     property Version: TPkgVersion read FVersion;
125     property IDAsString: string read GetIDAsString;
126     property IDAsWord: string read GetIDAsWord;
127   end;
128 
129   TIteratePackagesEvent = procedure(APackage: TLazPackageID) of object;
130 
131   TLazPackageType = (
132     lptRunTime, // Cannot register anything in the IDE. Can be used by designtime packages.
133     lptDesignTime, // Can register anything in the IDE but is not compiled into projects.
134                    // The IDE calls the 'register' procedures of each unit.
135     lptRunAndDesignTime, // Can do anything.
136     lptRunTimeOnly // As lptRunTime but cannot be installed in the IDE, not even indirectly.
137     );
138   TLazPackageTypes = set of TLazPackageType;
139 
140 const
141   LazPackageTypeIdents: array[TLazPackageType] of string = (
142     'RunTime', 'DesignTime', 'RunAndDesignTime', 'RunTimeOnly');
143 
144 type
145   TPackageInstallType = (
146     pitNope,
147     pitStatic,
148     pitDynamic
149     );
150 
151   { TIDEPackage }
152 
153   TIDEPackage = class(TLazPackageID)
154   protected
155     FAutoInstall: TPackageInstallType;
156     FFilename: string;
157     FChangeStamp: integer;
158     FCustomOptions: TConfigStorage;
159     FPackageType: TLazPackageType;
GetDirectoryExpandednull160     function GetDirectoryExpanded: string; virtual; abstract;
GetFileCountnull161     function GetFileCount: integer; virtual; abstract;
GetPkgFilesnull162     function GetPkgFiles(Index: integer): TLazPackageFile; virtual; abstract;
GetModifiednull163     function GetModified: boolean; virtual; abstract;
164     procedure SetFilename(const AValue: string); virtual; abstract;
165     procedure SetModified(const AValue: boolean); virtual; abstract;
GetRemovedCountnull166     function GetRemovedCount: integer; virtual; abstract;
GetRemovedPkgFilesnull167     function GetRemovedPkgFiles(Index: integer): TLazPackageFile; virtual; abstract;
168     procedure SetAutoInstall(AValue: TPackageInstallType); virtual; abstract;
169   public
170     procedure AssignOptions(Source: TPersistent); override;
IsVirtualnull171     function IsVirtual: boolean; virtual; abstract;
ReadOnlynull172     function ReadOnly: boolean; virtual; abstract;
173     constructor Create; override;
174     destructor Destroy; override;
175     procedure ClearCustomOptions;
176     // used by dependencies
177     procedure AddUsedByDependency(Dependency: TPkgDependencyBase); virtual; abstract;
178     procedure RemoveUsedByDependency(Dependency: TPkgDependencyBase); virtual; abstract;
179   public
180     property AutoInstall: TPackageInstallType read FAutoInstall write SetAutoInstall;
181     property Filename: string read FFilename write SetFilename;//the .lpk filename
182     property ChangeStamp: integer read FChangeStamp;
183     property CustomOptions: TConfigStorage read FCustomOptions;
184     property PackageType: TLazPackageType read FPackageType;
185     property DirectoryExpanded: string read GetDirectoryExpanded;
186     property FileCount: integer read GetFileCount;
187     property Files[Index: integer]: TLazPackageFile read GetPkgFiles;
188     property Modified: boolean read GetModified write SetModified;
189     property RemovedFilesCount: integer read GetRemovedCount;
190     property RemovedFiles[Index: integer]: TLazPackageFile read GetRemovedPkgFiles;
191   end;
192 
193 type
194   TPkgSaveFlag = (
195     psfSaveAs
196     );
197   TPkgSaveFlags = set of TPkgSaveFlag;
198 
199   TPkgOpenFlag = (
200     pofAddToRecent,   // add file to recent files
201     pofRevert,        // reload file if already open
202     pofConvertMacros, // replace macros in filename
203     pofMultiOpen,     // set during loading multiple files, shows 'Cancel all' button using mrAbort
204     pofDoNotOpenEditor// do not open packageeditor
205     );
206   TPkgOpenFlags = set of TPkgOpenFlag;
207 
208   TPkgCompileFlag = (
209     pcfOnlyIfNeeded,
210     pcfCleanCompile,  // append -B to the compiler options
211     pcfGroupCompile,
212     pcfDoNotCompileDependencies,
213     pcfDoNotCompilePackage,
214     pcfCompileDependenciesClean,
215     pcfSkipDesignTimePackages,
216     pcfDoNotSaveEditorFiles,
217     pcfCreateMakefile,
218     pcfCreateFpmakeFile
219     );
220   TPkgCompileFlags = set of TPkgCompileFlag;
221 
222 type
223   TPkgInstallInIDEFlag = (
224     piiifQuiet,
225     piiifClear, // replace, clear the old list
226     piiifRebuildIDE,
227     piiifSkipChecks,
228     piiifRemoveConflicts
229     );
230   TPkgInstallInIDEFlags = set of TPkgInstallInIDEFlag;
231 
232   TPkgIntfOwnerSearchFlag = (
233     piosfExcludeOwned, // file must not be marked as part of project/package
234     piosfIncludeSourceDirectories
235     );
236   TPkgIntfOwnerSearchFlags = set of TPkgIntfOwnerSearchFlag;
237 
238   TPkgIntfHandlerType = (
239     pihtGraphChanged, // called after loading/saving packages, changing dependencies
240     pihtPackageFileLoaded  { called after loading a lpk,
241            before the package is initialized and the dependencies are resolved }
242     );
243 
244   TPkgIntfRequiredFlag = (
245     pirNotRecursive, // return the list of direct dependencies, not sorted topologically
246     pirSkipDesignTimeOnly,
247     pirCompileOrder // start with packages that do not depend on other packages
248     );
249   TPkgIntfRequiredFlags = set of TPkgIntfRequiredFlag;
250 
251   TPkgIntfGatherUnitType = (
252     piguListed, // unit is in list of given Owner, i.e. in lpi, lpk file, this may contain platform specific units
253     piguUsed, // unit is used directly or indirectly by the start module and no currently open package/project is associated with it
254     piguAllUsed // as pigyUsed, except even units associated with another package/project are returned
255     );
256   TPkgIntfGatherUnitTypes = set of TPkgIntfGatherUnitType;
257 
258   { TPackageEditingInterface }
259 
260   TPackageEditingInterface = class(TComponent)
261   protected
262     FHandlers: array[TPkgIntfHandlerType] of TMethodList;
263     procedure AddHandler(HandlerType: TPkgIntfHandlerType;
264                          const AMethod: TMethod; AsLast: boolean = false);
265     procedure RemoveHandler(HandlerType: TPkgIntfHandlerType;
266                             const AMethod: TMethod);
267     procedure DoCallNotifyHandler(HandlerType: TPkgIntfHandlerType; Sender: TObject);
268   public
269     destructor Destroy; override;
DoOpenPackageWithNamenull270     function DoOpenPackageWithName(const APackageName: string;
271                          Flags: TPkgOpenFlags;
272                          ShowAbort: boolean): TModalResult; virtual; abstract;
DoOpenPackageFilenull273     function DoOpenPackageFile(AFilename: string;
274                          Flags: TPkgOpenFlags; ShowAbort: boolean
275                          ): TModalResult; virtual; abstract;
DoSaveAllPackagesnull276     function DoSaveAllPackages(Flags: TPkgSaveFlags): TModalResult; virtual; abstract;
277 
GetOwnersOfUnitnull278     function GetOwnersOfUnit(const UnitFilename: string): TFPList; virtual; abstract;
279     procedure ExtendOwnerListWithUsedByOwners(OwnerList: TFPList); virtual; abstract;
GetSourceFilesOfOwnersnull280     function GetSourceFilesOfOwners(OwnerList: TFPList): TStrings; virtual; abstract;
GetUnitsOfOwnersnull281     function GetUnitsOfOwners(OwnerList: TFPList; Flags: TPkgIntfGatherUnitTypes): TStrings; virtual; abstract;
GetPossibleOwnersOfUnitnull282     function GetPossibleOwnersOfUnit(const UnitFilename: string;
283                                      Flags: TPkgIntfOwnerSearchFlags): TFPList; virtual; abstract;
GetPackageOfSourceEditornull284     function GetPackageOfSourceEditor(out APackage: TIDEPackage; ASrcEdit: TObject): TLazPackageFile; virtual; abstract;
285 
GetPackageCountnull286     function GetPackageCount: integer; virtual; abstract;
GetPackagesnull287     function GetPackages(Index: integer): TIDEPackage; virtual; abstract;
FindPackageWithNamenull288     function FindPackageWithName(const PkgName: string; IgnorePackage: TIDEPackage = nil): TIDEPackage; virtual; abstract;
FindInstalledPackageWithUnitnull289     function FindInstalledPackageWithUnit(const AnUnitName: string): TIDEPackage; virtual; abstract;
IsPackageInstallednull290     function IsPackageInstalled(const PkgName: string): TIDEPackage; virtual; abstract;
291 
292     // dependencies
IsOwnerDependingOnPkgnull293     function IsOwnerDependingOnPkg(AnOwner: TObject; const PkgName: string;
294                                    out DependencyOwner: TObject): boolean; virtual; abstract;
295     procedure GetRequiredPackages(AnOwner: TObject; // a TLazProject or TIDEPackage
296       out PkgList: TFPList; // list of TIDEPackage
297       Flags: TPkgIntfRequiredFlags = []) virtual; abstract;
AddDependencyToOwnersnull298     function AddDependencyToOwners(OwnerList: TFPList; APackage: TIDEPackage;
299                    OnlyTestIfPossible: boolean = false): TModalResult; virtual; abstract; // mrOk or mrIgnore for already connected
AddUnitDependenciesForComponentClassesnull300     function AddUnitDependenciesForComponentClasses(const UnitFilename: string;
301                          ComponentClassnames: TStrings;
302                          Quiet: boolean = false): TModalResult; virtual; abstract;
RedirectPackageDependencynull303     function RedirectPackageDependency(APackage: TIDEPackage): TIDEPackage; virtual; abstract;
304 
305     // package editors
GetPackageOfEditorItemnull306     function GetPackageOfEditorItem(Sender: TObject): TIDEPackage; virtual; abstract;
307 
308     // package compilation
DoCompilePackagenull309     function DoCompilePackage(APackage: TIDEPackage; Flags: TPkgCompileFlags;
310                               ShowAbort: boolean): TModalResult; virtual; abstract;
311 
312     // install
CheckInstallPackageListnull313     function CheckInstallPackageList(PkgIDList: TObjectList;
314                  Flags: TPkgInstallInIDEFlags = []): boolean; virtual; abstract;
InstallPackagesnull315     function InstallPackages(PkgIdList: TObjectList;
316                   Flags: TPkgInstallInIDEFlags = []): TModalResult; virtual; abstract;
317 
318     //uninstall
UninstallPackagenull319     function UninstallPackage(APackage: TIDEPackage; ShowAbort: boolean): TModalResult; virtual; abstract;
320 
321     // events
322     procedure RemoveAllHandlersOfObject(AnObject: TObject);
323     procedure AddHandlerOnGraphChanged(const OnGraphChanged: TNotifyEvent;
324                                        AsLast: boolean = false);
325     procedure RemoveHandlerOnGraphChanged(const OnGraphChanged: TNotifyEvent);
326     procedure AddHandlerOnPackageFileLoaded(const OnPkgLoaded: TNotifyEvent;
327                                         AsLast: boolean = false);
328     procedure RemoveHandlerOnPackageFileLoaded(const OnPkgLoaded: TNotifyEvent);
329   end;
330 
331 var
332   PackageEditingInterface: TPackageEditingInterface; // will be set by the IDE
333 
334 
335 type
336   { TPackageDescriptor }
337 
338   TPackageDescriptor = class(TPersistent)
339   private
340     FName: string;
341     FReferenceCount: integer;
342     FVisibleInNewDialog: boolean;
343   protected
344     procedure SetName(const AValue: string); virtual;
345   public
346     constructor Create; virtual;
GetLocalizedNamenull347     function GetLocalizedName: string; virtual;
GetLocalizedDescriptionnull348     function GetLocalizedDescription: string; virtual;
349     procedure Release;
350     procedure Reference;
351     // TODO: procedure InitPackage(APackage: TLazPackage); virtual;
352     // TODO: procedure CreateStartFiles(APackage: TLazPackage); virtual;
353   public
354     property Name: string read FName write SetName;
355     property VisibleInNewDialog: boolean read FVisibleInNewDialog write FVisibleInNewDialog;
356   end;
357   TPackageDescriptorClass = class of TPackageDescriptor;
358 
359 
360   { TNewItemPackage - a new item for package descriptors }
361 
362   TNewItemPackage = class(TNewIDEItemTemplate)
363   private
364     FDescriptor: TPackageDescriptor;
365   public
LocalizedNamenull366     function LocalizedName: string; override;
Descriptionnull367     function Description: string; override;
368     procedure Assign(Source: TPersistent); override;
369   public
370     property Descriptor: TPackageDescriptor read FDescriptor write FDescriptor;
371   end;
372 
373 
374   { TPackageDescriptors }
375 
376   TPackageDescriptors = class(TPersistent)
377   protected
GetItemsnull378     function GetItems(Index: integer): TPackageDescriptor; virtual; abstract;
379   public
Countnull380     function Count: integer; virtual; abstract;
GetUniqueNamenull381     function GetUniqueName(const Name: string): string; virtual; abstract;
IndexOfnull382     function IndexOf(const Name: string): integer; virtual; abstract;
FindByNamenull383     function FindByName(const Name: string): TPackageDescriptor; virtual; abstract;
384     procedure RegisterDescriptor(Descriptor: TPackageDescriptor); virtual; abstract;
385     procedure UnregisterDescriptor(Descriptor: TPackageDescriptor); virtual; abstract;
386   public
387     property Items[Index: integer]: TPackageDescriptor read GetItems; default;
388   end;
389 
390   TPackageGraphInterface = class
391   protected
392     FChangeStamp: Int64;
393   protected
394     procedure IncChangeStamp; virtual;
395   public
396     property ChangeStamp: Int64 read FChangeStamp;
397   end;
398 
399 var
400   PackageDescriptors: TPackageDescriptors; // will be set by the IDE
401   PackageGraphInterface: TPackageGraphInterface; // must be set along with PackageSystem.PackageGraph
402 
403 
PkgFileTypeIdentToTypenull404 function PkgFileTypeIdentToType(const s: string): TPkgFileType;
LazPackageTypeIdentToTypenull405 function LazPackageTypeIdentToType(const s: string): TLazPackageType;
PackageDescriptorStdnull406 function PackageDescriptorStd: TPackageDescriptor;
PkgCompileFlagsToStringnull407 function PkgCompileFlagsToString(Flags: TPkgCompileFlags): string;
408 procedure RegisterPackageDescriptor(PkgDesc: TPackageDescriptor);
409 
410 
411 implementation
412 
413 
PkgFileTypeIdentToTypenull414 function PkgFileTypeIdentToType(const s: string): TPkgFileType;
415 begin
416   for Result:=Low(TPkgFileType) to High(TPkgFileType) do
417     if SysUtils.CompareText(s,PkgFileTypeIdents[Result])=0 then exit;
418   Result:=pftUnit;
419 end;
420 
LazPackageTypeIdentToTypenull421 function LazPackageTypeIdentToType(const s: string): TLazPackageType;
422 begin
423   for Result:=Low(TLazPackageType) to High(TLazPackageType) do
424     if SysUtils.CompareText(s,LazPackageTypeIdents[Result])=0 then exit;
425   Result:=lptRunTime;
426 end;
427 
PackageDescriptorStdnull428 function PackageDescriptorStd: TPackageDescriptor;
429 begin
430   Result:=PackageDescriptors.FindByName(PkgDescNameStandard);
431 end;
432 
PkgCompileFlagsToStringnull433 function PkgCompileFlagsToString(Flags: TPkgCompileFlags): string;
434 var
435   f: TPkgCompileFlag;
436   s: string;
437 begin
438   Result:='';
439   for f:=Low(TPkgCompileFlag) to High(TPkgCompileFlag) do begin
440     if not (f in Flags) then continue;
441     WriteStr(s, f);
442     if Result<>'' then
443       Result:=Result+',';
444     Result:=Result+s;
445   end;
446   Result:='['+Result+']';
447 end;
448 
449 procedure RegisterPackageDescriptor(PkgDesc: TPackageDescriptor);
450 var
451   NewItemPkg: TNewItemPackage;
452 begin
453   PackageDescriptors.RegisterDescriptor(PkgDesc);
454   if PkgDesc.VisibleInNewDialog then begin
455     NewItemPkg:=TNewItemPackage.Create(PkgDesc.Name,niifCopy,[niifCopy]);
456     NewItemPkg.Descriptor:=PkgDesc;
457     RegisterNewDialogItem(PkgDescGroupName,NewItemPkg);
458   end;
459 end;
460 
461 
462 { TPackageGraphInterface }
463 
464 procedure TPackageGraphInterface.IncChangeStamp;
465 begin
466   {$push}{$R-}  // range check off
467   Inc(FChangeStamp);
468   {$pop}
469 end;
470 
471 { TPackageDescriptor }
472 
473 procedure TPackageDescriptor.SetName(const AValue: string);
474 begin
475   if FName=AValue then exit;
476   FName:=AValue;
477 end;
478 
479 constructor TPackageDescriptor.Create;
480 begin
481   FReferenceCount:=1;
482   fVisibleInNewDialog:=true;
483 end;
484 
GetLocalizedNamenull485 function TPackageDescriptor.GetLocalizedName: string;
486 begin
487   Result:=Name;
488 end;
489 
GetLocalizedDescriptionnull490 function TPackageDescriptor.GetLocalizedDescription: string;
491 begin
492   Result:=GetLocalizedName;
493 end;
494 
495 procedure TPackageDescriptor.Release;
496 begin
497   //debugln('TPackageDescriptor.Release A ',Name,' ',dbgs(FReferenceCount));
498   if FReferenceCount=0 then
499     raise Exception.Create('');
500   dec(FReferenceCount);
501   if FReferenceCount=0 then Free;
502 end;
503 
504 procedure TPackageDescriptor.Reference;
505 begin
506   inc(FReferenceCount);
507 end;
508 
509 { TNewItemPackage }
510 
TNewItemPackage.LocalizedNamenull511 function TNewItemPackage.LocalizedName: string;
512 begin
513   Result:=Descriptor.GetLocalizedName;
514 end;
515 
Descriptionnull516 function TNewItemPackage.Description: string;
517 begin
518   Result:=Descriptor.GetLocalizedDescription;
519 end;
520 
521 procedure TNewItemPackage.Assign(Source: TPersistent);
522 begin
523   inherited Assign(Source);
524   if Source is TNewItemPackage then
525     FDescriptor:=TNewItemPackage(Source).Descriptor;
526 end;
527 
528 { TLazPackageID }
529 
530 constructor TPkgDependencyID.Create;
531 begin
532   inherited Create;
533 end;
534 
535 destructor TPkgDependencyID.Destroy;
536 begin
537   RequiredIDEPackage:=nil;
538   inherited Destroy;
539 end;
540 
541 procedure TPkgDependencyID.Clear;
542 begin
543   inherited Clear;
544   RequiredIDEPackage:=nil;
545 end;
546 
547 // Setters
548 
549 procedure TPkgDependencyID.SetRequiredPackage(const AValue: TIDEPackage);
550 begin
551   if FRequiredPackage=AValue then exit;
552   if FRequiredPackage<>nil then
553     FRequiredPackage.RemoveUsedByDependency(Self);
554   FLoadPackageResult:=lprUndefined;
555   FRequiredPackage:=AValue;
556   if FRequiredPackage<>nil then
557     FRequiredPackage.AddUsedByDependency(Self);
558 end;
559 
560 { TLazPackageID }
561 
562 constructor TLazPackageID.Create;
563 begin
564   inherited Create(nil);
565   FVersion:=TPkgVersion.Create;
566   FVersion.OnChange:=@VersionChanged;
567 end;
568 
569 destructor TLazPackageID.Destroy;
570 begin
571   FreeAndNil(FVersion);
572   inherited Destroy;
573 end;
574 
575 procedure TLazPackageID.UpdateIDAsString;
576 begin
577   FIDAsString:=Version.AsString;
578   if FIDAsString<>'' then
579     FIDAsString:=Name+' '+FIDAsString;
580   FIDAsWord:=Version.AsWord;
581   if FIDAsWord<>'' then
582     FIDAsWord:=Name+FIDAsWord;
583 end;
584 
585 procedure TLazPackageID.VersionChanged(Sender: TObject);
586 begin
587   UpdateIDAsString;
588 end;
589 
TLazPackageID.GetDirectorynull590 function TLazPackageID.GetDirectory: string;
591 begin
592   raise Exception.Create(''); // just an ID, no file
593   Result:='';
594 end;
595 
596 procedure TLazPackageID.AssignOptions(Source: TPersistent);
597 var
598   aSource: TLazPackageID;
599 begin
600   if Source is TLazPackageID then
601   begin
602     aSource:=TLazPackageID(Source);
603     FVersion.Assign(aSource.Version);
604     Name:=aSource.Name;
605     UpdateIDAsString;
606   end else
607     raise Exception.Create('TLazPackageID.AssignOptions: can not copy from '+DbgSName(Source));
608 end;
609 
StringToIDnull610 function TLazPackageID.StringToID(const s: string): boolean;
611 var
612   IdentEndPos: PChar;
613   StartPos: PChar;
614 
ReadIdentifiernull615   function ReadIdentifier: boolean;
616   begin
617     Result:=false;
618     while IdentEndPos^ in ['a'..'z','A'..'Z','0'..'9','_'] do begin
619       inc(IdentEndPos);
620       Result:=true;
621     end;
622   end;
623 
624 begin
625   Result:=false;
626   if s='' then exit;
627   IdentEndPos:=PChar(s);
628   repeat
629     if not ReadIdentifier then exit;
630     if IdentEndPos^<>'.' then break;
631     inc(IdentEndPos);
632   until false;
633   Name:=copy(s,1,IdentEndPos-PChar(s));
634   StartPos:=IdentEndPos;
635   while StartPos^=' ' do inc(StartPos);
636   if StartPos=IdentEndPos then begin
637     Version.Clear;
638     Version.Valid:=pvtNone;
639   end else begin
640     if not Version.ReadString(StartPos) then exit;
641   end;
642   Result:=true;
643 end;
644 
TLazPackageID.Comparenull645 function TLazPackageID.Compare(PackageID2: TLazPackageID): integer;
646 begin
647   if PackageID2 <> nil then
648   begin
649     Result:=CompareText(Name,PackageID2.Name);
650     if Result<>0 then exit;
651     Result:=Version.Compare(PackageID2.Version);
652   end
653   else
654     Result := -1;
655 end;
656 
CompareMasknull657 function TLazPackageID.CompareMask(ExactPackageID: TLazPackageID): integer;
658 begin
659   Result:=CompareText(Name,ExactPackageID.Name);
660   if Result<>0 then exit;
661   Result:=Version.CompareMask(ExactPackageID.Version);
662 end;
663 
664 procedure TLazPackageID.AssignID(Source: TLazPackageID);
665 begin
666   Name:=Source.Name;
667   Version.Assign(Source.Version);
668 end;
669 
GetIDAsStringnull670 function TLazPackageID.GetIDAsString: string;
671 begin
672   Result := FIDAsString;
673 end;
674 
GetIDAsWordnull675 function TLazPackageID.GetIDAsWord: string;
676 begin
677   Result := FIDAsWord;
678 end;
679 
680 procedure TLazPackageID.SetName(const NewName: TComponentName);
681 begin
682   if Name=NewName then exit;
683   ChangeName(NewName);
684   UpdateIDAsString;
685 end;
686 
687 { TIDEPackage }
688 
689 procedure TIDEPackage.AssignOptions(Source: TPersistent);
690 var
691   aSource: TIDEPackage;
692 begin
693   inherited AssignOptions(Source);
694   if Source is TIDEPackage then
695   begin
696     aSource:=TIDEPackage(Source);
697     LazCompilerOptions.Assign(aSource.LazCompilerOptions);
698     // ToDo:
699     //FCustomOptions:=aSource.FCustomOptions;
700   end;
701 end;
702 
703 constructor TIDEPackage.Create;
704 begin
705   inherited Create;
706   FCustomOptions:=TConfigMemStorage.Create('',false);
707 end;
708 
709 destructor TIDEPackage.Destroy;
710 begin
711   FreeAndNil(FCustomOptions);
712   inherited Destroy;
713 end;
714 
715 procedure TIDEPackage.ClearCustomOptions;
716 begin
717   TConfigMemStorage(FCustomOptions).Clear;
718 end;
719 
720 { TPackageEditingInterface }
721 
722 procedure TPackageEditingInterface.AddHandler(HandlerType: TPkgIntfHandlerType;
723   const AMethod: TMethod; AsLast: boolean);
724 begin
725   if FHandlers[HandlerType]=nil then
726     FHandlers[HandlerType]:=TMethodList.Create;
727   FHandlers[HandlerType].Add(AMethod,AsLast);
728 end;
729 
730 procedure TPackageEditingInterface.RemoveHandler(
731   HandlerType: TPkgIntfHandlerType; const AMethod: TMethod);
732 begin
733   FHandlers[HandlerType].Remove(AMethod);
734 end;
735 
736 procedure TPackageEditingInterface.DoCallNotifyHandler(
737   HandlerType: TPkgIntfHandlerType; Sender: TObject);
738 begin
739   FHandlers[HandlerType].CallNotifyEvents(Sender);
740 end;
741 
742 destructor TPackageEditingInterface.Destroy;
743 var
744   h: TPkgIntfHandlerType;
745 begin
746   for h:=Low(FHandlers) to high(FHandlers) do
747     FreeAndNil(FHandlers[h]);
748   inherited Destroy;
749 end;
750 
751 procedure TPackageEditingInterface.RemoveAllHandlersOfObject(AnObject: TObject);
752 var
753   HandlerType: TPkgIntfHandlerType;
754 begin
755   for HandlerType:=Low(HandlerType) to High(HandlerType) do
756     FHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject);
757 end;
758 
759 procedure TPackageEditingInterface.AddHandlerOnGraphChanged(
760   const OnGraphChanged: TNotifyEvent; AsLast: boolean);
761 begin
762   AddHandler(pihtGraphChanged,TMethod(OnGraphChanged),AsLast);
763 end;
764 
765 procedure TPackageEditingInterface.RemoveHandlerOnGraphChanged(
766   const OnGraphChanged: TNotifyEvent);
767 begin
768   RemoveHandler(pihtGraphChanged,TMethod(OnGraphChanged));
769 end;
770 
771 procedure TPackageEditingInterface.AddHandlerOnPackageFileLoaded(
772   const OnPkgLoaded: TNotifyEvent; AsLast: boolean);
773 begin
774   AddHandler(pihtPackageFileLoaded,TMethod(OnPkgLoaded),AsLast);
775 end;
776 
777 procedure TPackageEditingInterface.RemoveHandlerOnPackageFileLoaded(
778   const OnPkgLoaded: TNotifyEvent);
779 begin
780   RemoveHandler(pihtPackageFileLoaded,TMethod(OnPkgLoaded));
781 end;
782 
783 { TLazPackageFile }
784 
785 procedure TLazPackageFile.SetDisableI18NForLFM(AValue: boolean);
786 begin
787   FDisableI18NForLFM:=AValue;
788 end;
789 
790 procedure TLazPackageFile.SetFileType(const AValue: TPkgFileType);
791 begin
792   FFileType:=AValue;
793 end;
794 
795 procedure TLazPackageFile.SetRemoved(const AValue: boolean);
796 begin
797   FRemoved:=AValue;
798 end;
799 
800 initialization
801   PackageEditingInterface:=nil;
802 
803 end.
804 
805