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