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

implemented automatic define templates for packages

Browse Source 
git-svn-id: trunk@4078 -
This commit is contained in:
mattias 2003-04-19 12:57:09 +00:00
parent aa9d15de4c
commit 4cd04fc129
9 changed files with 652 additions and 174 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

156
components/codetools/definetemplates.pas
View File

@ -112,7 +112,9 @@ type
const
DefineActionBlocks = [da_Block, da_Directory, da_If, da_IfDef, da_IfNDef,
da_ElseIf, da_Else];
da_ElseIf, da_Else];
DefineActionDefines = [da_Define,da_DefineRecurse,da_Undefine,
da_UndefineRecurse];
DefineActionNames: array[TDefineAction] of string = (
'None', 'Block', 'Define', 'DefineRecurse', 'Undefine', 'UndefineRecurse',
'UndefineAll', 'If', 'IfDef', 'IfNDef', 'ElseIf', 'Else', 'Directory'
@ -126,14 +128,14 @@ type
TDefineTemplate = class
private
FChildCount: integer;
FParent: TDefineTemplate;
FNext: TDefineTemplate;
FPrior: TDefineTemplate;
FChildFlags: TDefineTemplateFlags;
FFirstChild: TDefineTemplate;
FLastChild: TDefineTemplate;
FMarked: boolean;
FChildFlags: TDefineTemplateFlags;
FNext: TDefineTemplate;
FParent: TDefineTemplate;
FParentFlags: TDefineTemplateFlags;
FPrior: TDefineTemplate;
procedure ComputeChildFlags;
procedure ComputeParentFlags;
public
@ -143,53 +145,54 @@ type
Value: string;
Action: TDefineAction;
Flags: TDefineTemplateFlags;
function Level: integer;
function GetFirstSibling: TDefineTemplate;
procedure AddChild(ADefineTemplate: TDefineTemplate);
procedure InsertBehind(APrior: TDefineTemplate);
procedure InsertInFront(ANext: TDefineTemplate);
procedure Assign(ADefineTemplate: TDefineTemplate;
WithSubNodes, WithNextSiblings: boolean); virtual;
function IsEqual(ADefineTemplate: TDefineTemplate;
CheckSubNodes, CheckNextSiblings: boolean): boolean;
function CreateCopy(OnlyMarked: boolean): TDefineTemplate;
function FindRoot: TDefineTemplate;
function FindChildByName(const AName: string): TDefineTemplate;
function FindByName(const AName: string;
WithSubChilds, WithNextSiblings: boolean): TDefineTemplate;
function FindUniqueName(const Prefix: string): string;
function LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string): boolean;
procedure LoadValuesFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
OnlyMarked, WithMergeInfo: boolean);
class procedure MergeXMLConfig(ParentDefTempl: TDefineTemplate;
var FirstSibling,LastSibling:TDefineTemplate;
XMLConfig: TXMLConfig; const Path, NewNamePrefix: string);
function SelfOrParentContainsFlag(AFlag: TDefineTemplateFlag): boolean;
function IsAutoGenerated: boolean;
function IsProjectSpecific: boolean;
procedure RemoveFlags(TheFlags: TDefineTemplateFlags);
procedure MarkGlobals;
procedure MarkProjectSpecificOnly;
procedure MarkProjectSpecificAndParents;
procedure MarkNonAutoCreated;
procedure RemoveMarked;
procedure Unbind;
procedure Clear;
constructor Create;
constructor Create(const AName, ADescription, AVariable, AValue: string;
AnAction: TDefineAction);
AnAction: TDefineAction);
constructor Create;
destructor Destroy; override;
function ConsistencyCheck: integer; // 0 = ok
function CreateCopy(OnlyMarked: boolean): TDefineTemplate;
function FindByName(const AName: string;
WithSubChilds, WithNextSiblings: boolean): TDefineTemplate;
function FindChildByName(const AName: string): TDefineTemplate;
function FindRoot: TDefineTemplate;
function FindUniqueName(const Prefix: string): string;
function GetFirstSibling: TDefineTemplate;
function IsAutoGenerated: boolean;
function IsEqual(ADefineTemplate: TDefineTemplate;
CheckSubNodes, CheckNextSiblings: boolean): boolean;
function IsProjectSpecific: boolean;
function HasDefines(OnlyMarked, WithSiblings: boolean): boolean;
function Level: integer;
function LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string): boolean;
function SelfOrParentContainsFlag(AFlag: TDefineTemplateFlag): boolean;
procedure AddChild(ADefineTemplate: TDefineTemplate);
procedure Assign(ADefineTemplate: TDefineTemplate;
WithSubNodes, WithNextSiblings: boolean); virtual;
procedure Clear;
procedure InsertBehind(APrior: TDefineTemplate);
procedure InsertInFront(ANext: TDefineTemplate);
procedure LoadValuesFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure MarkGlobals;
procedure MarkNonAutoCreated;
procedure MarkProjectSpecificAndParents;
procedure MarkProjectSpecificOnly;
procedure RemoveFlags(TheFlags: TDefineTemplateFlags);
procedure RemoveMarked;
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
OnlyMarked, WithMergeInfo: boolean);
procedure Unbind;
procedure WriteDebugReport;
public
property ChildCount: integer read FChildCount;
property Parent: TDefineTemplate read FParent;
property Next: TDefineTemplate read FNext;
property Prior: TDefineTemplate read FPrior;
property FirstChild: TDefineTemplate read FFirstChild;
property LastChild: TDefineTemplate read FLastChild;
property Marked: boolean read FMarked write FMarked;
property Next: TDefineTemplate read FNext;
property Parent: TDefineTemplate read FParent;
property Prior: TDefineTemplate read FPrior;
end;
//---------------------------------------------------------------------------
@ -298,6 +301,7 @@ type
procedure RemoveProjectSpecificAndParents;
procedure RemoveProjectSpecificOnly;
procedure RemoveRootDefineTemplateByName(const AName: string);
procedure RemoveDefineTemplate(ADefTempl: TDefineTemplate);
procedure ReplaceChild(ParentTemplate, NewDefineTemplate: TDefineTemplate;
const ChildName: string);
procedure ReplaceRootSameName(ADefineTemplate: TDefineTemplate);
@ -1020,6 +1024,37 @@ begin
WriteNode(Self,' ');
end;
function TDefineTemplate.HasDefines(OnlyMarked, WithSiblings: boolean): boolean;
var
CurTempl: TDefineTemplate;
begin
Result:=true;
CurTempl:=Self;
while CurTempl<>nil do begin
if ((not OnlyMarked) or (CurTempl.FMarked))
and (CurTempl.Action in DefineActionDefines) then exit;
// go to next
if CurTempl.FFirstChild<>nil then
CurTempl:=CurTempl.FFirstChild
else if (CurTempl.FNext<>nil)
and (WithSiblings or (CurTempl.Parent<>Parent)) then
CurTempl:=CurTempl.FNext
else begin
// search uncle
repeat
CurTempl:=CurTempl.Parent;
if (CurTempl=Parent)
or ((CurTempl.Parent=Parent) and not WithSiblings) then begin
Result:=false;
exit;
end;
until (CurTempl.FNext<>nil);
CurTempl:=CurTempl.FNext;
end;
end;
Result:=false;
end;
function TDefineTemplate.IsEqual(ADefineTemplate: TDefineTemplate;
CheckSubNodes, CheckNextSiblings: boolean): boolean;
var SrcNode, DestNode: TDefineTemplate;
@ -1286,14 +1321,16 @@ end;
procedure TDefineTree.RemoveMarked;
var NewFirstNode: TDefineTemplate;
HadDefines: Boolean;
begin
if FFirstDefineTemplate=nil then exit;
NewFirstNode:=FFirstDefineTemplate;
while (NewFirstNode<>nil) and NewFirstNode.Marked do
NewFirstNode:=NewFirstNode.Next;
HadDefines:=FFirstDefineTemplate.HasDefines(true,true);
FFirstDefineTemplate.RemoveMarked;
FFirstDefineTemplate:=NewFirstNode;
ClearCache;
if HadDefines then ClearCache;
end;
procedure TDefineTree.RemoveGlobals;
@ -1618,35 +1655,32 @@ var
inc(ValuePos,Len);
end;
function Substitute(var CurValue: string; ValueLen: integer;
function Substitute(const CurValue: string; ValueLen: integer;
MacroStart: integer; var MacroEnd: integer): boolean;
var
MacroNameEnd: Integer;
MacroFuncNameEnd: Integer;
MacroFuncNameLen: Integer;
MacroLen: Integer;
MacroStr: String;
MacroFuncName: String;
NewMacroLen: Integer;
MacroParam: string;
begin
Result:=false;
MacroNameEnd:=MacroEnd;
MacroFuncNameLen:=MacroNameEnd-MacroStart-1;
MacroEnd:=SearchBracketClose(CurValue,MacroNameEnd)+1;
MacroFuncNameEnd:=MacroEnd;
MacroFuncNameLen:=MacroFuncNameEnd-MacroStart-1;
MacroEnd:=SearchBracketClose(CurValue,MacroFuncNameEnd)+1;
if MacroEnd>ValueLen+1 then exit;
MacroLen:=MacroEnd-MacroStart;
MacroStr:=copy(CurValue,MacroStart,MacroLen);
// Macro found
if MacroFuncNameLen>0 then begin
MacroFuncName:=copy(CurValue,MacroStart+1,MacroFuncNameLen);
// Macro function -> substitute macro parameter first
ReadValue(DirDef,copy(MacroStr,MacroNameEnd+1
,MacroLen-MacroFuncNameLen-3),CurDefinePath,MacroParam);
ReadValue(DirDef,copy(CurValue,MacroFuncNameEnd+1
,MacroEnd-MacroFuncNameEnd-2),CurDefinePath,MacroParam);
// execute the macro function
MacroStr:=ExecuteMacroFunction(MacroFuncName,MacroParam);
end else begin
// Macro variable
MacroStr:=copy(NewValue,MacroStart+2,MacroEnd-MacroStart-3);
MacroStr:=copy(CurValue,MacroStart+2,MacroEnd-MacroStart-3);
//writeln('**** MacroStr=',MacroStr);
//writeln('DirDef.Values=',DirDef.Values.AsString);
if MacroStr=DefinePathMacroName then begin
@ -1991,12 +2025,18 @@ procedure TDefineTree.RemoveRootDefineTemplateByName(const AName: string);
var ADefTempl: TDefineTemplate;
begin
ADefTempl:=FindDefineTemplateByName(AName,true);
if ADefTempl<>nil then begin
if ADefTempl=FFirstDefineTemplate then
FFirstDefineTemplate:=FFirstDefineTemplate.Next;
ADefTempl.Unbind;
ADefTempl.Free;
end;
if ADefTempl<>nil then RemoveDefineTemplate(ADefTempl);
end;
procedure TDefineTree.RemoveDefineTemplate(ADefTempl: TDefineTemplate);
var
HadDefines: Boolean;
begin
if ADefTempl=FFirstDefineTemplate then
FFirstDefineTemplate:=FFirstDefineTemplate.Next;
HadDefines:=ADefTempl.HasDefines(false,false);
ADefTempl.Free;
if HadDefines then ClearCache;
end;
procedure TDefineTree.ReplaceChild(ParentTemplate,

13
components/codetools/finddeclarationtool.pas
View File

@ -1217,6 +1217,7 @@ var
var UnitSrcSearchPath: string;
MainCodeIsVirtual: boolean;
CompiledResult: TCodeBuffer;
UnitSearchPath: string;
begin
{$IFDEF ShowTriedFiles}
writeln('TFindDeclarationTool.FindUnitSource A AnUnitName=',AnUnitName,' AnUnitInFilename=',AnUnitInFilename);
@ -1281,12 +1282,20 @@ begin
CompiledSrcExt:='.ppw';
CompiledResult:=SearchUnitFileInDir(CurDir,AnUnitName,false);
if CompiledResult=nil then begin
// search compiled unit in search path
// search compiled unit in src path
{$IFDEF ShowTriedFiles}
writeln('TFindDeclarationTool.FindUnitSource Search Compiled unit in search path=',UnitSrcSearchPath);
writeln('TFindDeclarationTool.FindUnitSource Search Compiled unit in src path=',UnitSrcSearchPath);
{$ENDIF}
CompiledResult:=SearchUnitFileInPath(UnitSrcSearchPath,AnUnitName,false);
end;
if CompiledResult=nil then begin
// search compiled unit in unit path
UnitSearchPath:=Scanner.Values[ExternalMacroStart+'UnitPath'];
{$IFDEF ShowTriedFiles}
writeln('TFindDeclarationTool.FindUnitSource Search Compiled unit in unit path=',UnitSearchPath);
{$ENDIF}
CompiledResult:=SearchUnitFileInPath(UnitSearchPath,AnUnitName,false);
end;
if (CompiledResult<>nil) then begin
// there is a compiled unit
if Assigned(OnGetSrcPathForCompiledUnit)

17
components/codetools/keywordfunclists.pas
View File

@ -83,6 +83,8 @@ type
procedure WriteDebugListing;
function AllwaysTrue: boolean;
function AllwaysFalse: boolean;
function Count: integer;
function GetItem(Index: integer): TKeyWordFunctionListItem;
constructor Create;
destructor Destroy; override;
end;
@ -508,6 +510,17 @@ begin
Result:=false;
end;
function TKeyWordFunctionList.Count: integer;
begin
Result:=FCount;
end;
function TKeyWordFunctionList.GetItem(Index: integer
): TKeyWordFunctionListItem;
begin
Result:=FItems[Index];
end;
function TKeyWordFunctionList.DoItCaseInsensitive(const AKeyWord: shortstring
): boolean;
var i: integer;
@ -546,14 +559,14 @@ begin
if i>=0 then begin
i:=FBucketStart[i];
if i>=0 then begin
KeyWordEnd:=PChar(integer(Start)+Len);
KeyWordEnd:=PChar(integer(Start)+Len-1);
repeat
KeyWordFuncItem:=@FItems[i];
if length(KeyWordFuncItem^.KeyWord)=Len then begin
KeyPos:=Len;
WordPos:=KeyWordEnd;
while (KeyPos>=1)
and (KeyWordFuncItem^.KeyWord[KeyPos]=UpChars[WordPos[0]]) do
and (KeyWordFuncItem^.KeyWord[KeyPos]=UpChars[WordPos^]) do
begin
dec(KeyPos);
dec(WordPos);

52
ide/compileroptions.pp
View File

@ -262,6 +262,8 @@ type
function MergeCustomOptions(const OldOptions, AddOptions: string): string;
function GetDefaultMainSourceFileName: string; virtual;
function NeedsLinkerOpts: boolean;
function GetUnitPath(RelativeToBaseDir: boolean): string;
function GetIncludePath(RelativeToBaseDir: boolean): string;
public
{ Properties }
property Owner: TObject read fOwner write fOwner;
@ -1182,6 +1184,39 @@ begin
Result:=not (ccloNoLinkerOpts in fDefaultMakeOptionsFlags);
end;
function TBaseCompilerOptions.GetUnitPath(RelativeToBaseDir: boolean): string;
var
CurUnitPath: String;
InhUnitPath: String;
begin
// unit path
CurUnitPath:=ParsedOpts.GetParsedValue(pcosUnitPath);
if (not RelativeToBaseDir) then
CreateAbsolutePath(CurUnitPath,BaseDirectory);
// inherited unit path
InhUnitPath:=GetInheritedOption(icoUnitPath,RelativeToBaseDir);
Result:=MergeSearchPaths(CurUnitPath,InhUnitPath);
end;
function TBaseCompilerOptions.GetIncludePath(RelativeToBaseDir: boolean
): string;
var
CurIncludePath: String;
InhIncludePath: String;
begin
// include path
CurIncludePath:=ParsedOpts.GetParsedValue(pcosIncludePath);
if (not RelativeToBaseDir) then
CreateAbsolutePath(CurIncludePath,BaseDirectory);
// inherited include path
InhIncludePath:=GetInheritedOption(icoIncludePath,RelativeToBaseDir);
Result:=MergeSearchPaths(CurIncludePath,InhIncludePath);
end;
{------------------------------------------------------------------------------
TBaseCompilerOptions MakeOptionsString
------------------------------------------------------------------------------}
@ -1200,9 +1235,7 @@ function TBaseCompilerOptions.MakeOptionsString(
var
switches, tempsw: String;
InhLinkerOpts: String;
InhIncludePath: String;
InhLibraryPath: String;
InhUnitPath: String;
InhCustomOptions: String;
NewTargetFilename: String;
CurIncludePath: String;
@ -1633,14 +1666,9 @@ Processor specific options:
{ ------------- Search Paths ---------------- }
// include path
CurIncludePath:=ParsedOpts.GetParsedValue(pcosIncludePath);
CurIncludePath:=GetIncludePath(true);
if (CurIncludePath <> '') then
switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fi', CurIncludePath);
// inherited include path
InhIncludePath:=GetInheritedOption(icoIncludePath,true);
if (InhIncludePath <> '') then
switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fi', InhIncludePath);
// library path
if (not (ccloNoLinkerOpts in Flags)) then begin
@ -1667,18 +1695,12 @@ Processor specific options:
switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fo', InhObjectPath);
// unit path
CurUnitPath:=ParsedOpts.GetParsedValue(pcosUnitPath);
CurUnitPath:=GetUnitPath(true);
// always add the current directory to the unit path, so that the compiler
// checks for changed files in the directory
CurUnitPath:=CurUnitPath+';.';
switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fu', CurUnitPath);
// inherited unit path
InhUnitPath:=GetInheritedOption(icoUnitPath,true);
if (InhUnitPath <> '') then
switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fu', InhUnitPath);
{ CompilerPath - Nothing needs to be done with this one }
{ Unit output directory }

69
ide/filereferencelist.pas
View File

@ -39,7 +39,7 @@ unit FileReferenceList;
interface
uses
Classes, SysUtils, AVL_Tree, FileCtrl;
Classes, SysUtils, AVL_Tree, FileCtrl, IDEProcs;
type
{ TFileReference }
@ -57,24 +57,35 @@ type
{ TFileReferenceList }
TFileReferenceFlag = (
frfSearchPathValid
frfSearchPathValid,
frfChanged
);
TFileReferenceFlags = set of TFileReferenceFlag;
TFileReferenceList = class
private
FOnChanged: TNotifyEvent;
FTimeStamp: integer;
FTree: TAVLTree; // tree of TFileReference sorted for filename
FFlags: TFileReferenceFlags;
FSearchPath: string;
FUpdateLock: integer;
procedure UpdateSearchPath;
procedure IncreaseTimeStamp;
procedure Invalidate;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure BeginUpdate;
procedure EndUpdate;
procedure AddFilename(const Filename: string);
procedure RemoveFilename(const Filename: string);
function GetFileReference(const Filename: string): TFileReference;
function CreateSearchPathFromAllFiles: string;
function CreateFileList: TStringList;
property TimeStamp: integer read FTimeStamp;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
end;
implementation
@ -148,6 +159,25 @@ begin
Include(FFlags,frfSearchPathValid);
end;
procedure TFileReferenceList.IncreaseTimeStamp;
begin
if FTimeStamp<$7fffffff then
inc(FTimeStamp)
else
FTimeStamp:=-$7fffffff;
end;
procedure TFileReferenceList.Invalidate;
begin
if frfSearchPathValid in FFlags then exit;
Exclude(FFlags,frfSearchPathValid);
IncreaseTimeStamp;
if FUpdateLock>0 then
Include(FFlags,frfChanged)
else if Assigned(OnChanged) then
OnChanged(Self);
end;
constructor TFileReferenceList.Create;
begin
@ -165,7 +195,23 @@ procedure TFileReferenceList.Clear;
begin
if (FTree<>nil) and (FTree.Count>0) then begin
FTree.FreeAndClear;
Exclude(FFlags,frfSearchPathValid);
Invalidate;
end;
end;
procedure TFileReferenceList.BeginUpdate;
begin
inc(FUpdateLock);
end;
procedure TFileReferenceList.EndUpdate;
begin
if FUpdateLock=0 then RaiseException('TFileReferenceList.EndUpdate');
dec(FUpdateLock);
if (frfChanged in FFlags) then begin
Exclude(FFlags,frfChanged);
if Assigned(OnChanged) then
OnChanged(Self);
end;
end;
@ -187,7 +233,7 @@ begin
inc(NewFileRef.fReferenceCount);
if FTree=nil then FTree:=TAVLTree.Create(@CompareFileReferences);
FTree.Add(NewFileRef);
Exclude(FFlags,frfSearchPathValid);
Invalidate;
end;
procedure TFileReferenceList.RemoveFilename(const Filename: string);
@ -204,7 +250,7 @@ begin
if CurFileRef.fReferenceCount=0 then begin
FTree.Remove(CurFileRef);
CurFileRef.Free;
Exclude(FFlags,frfSearchPathValid);
Invalidate;
end;
end;
@ -226,5 +272,18 @@ begin
Result:=FSearchPath;
end;
function TFileReferenceList.CreateFileList: TStringList;
var
ANode: TAVLTreeNode;
begin
Result:=TStringList.Create;
if FTree=nil then exit;
ANode:=FTree.FindLowest;
while ANode<>nil do begin
Result.Add(TFileReference(ANode.Data).Filename);
ANode:=FTree.FindSuccessor(ANode);
end;
end;
end.

17
ide/sortselectiondlg.pas
View File

@ -108,10 +108,13 @@ var
SortSelectionDialog: TSortSelectionDialog;
begin
SortSelectionDialog:=TSortSelectionDialog.Create(Application);
SortSelectionDialog.BeginUpdate;
SortSelectionDialog.TheText:=TheText;
SortSelectionDialog.PreviewSynEdit.Highlighter:=Highlighter;
EditorOpts.GetSynEditSelectedColor(SortSelectionDialog.PreviewSynEdit);
writeln('');
SortSelectionDialog.UpdatePreview;
SortSelectionDialog.EndUpdate;
Result:=SortSelectionDialog.ShowModal;
if Result=mrOk then
SortedText:=SortSelectionDialog.SortedText;
@ -434,8 +437,8 @@ constructor TSortSelectionDialog.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FIgnoreSpace:=true;
FDirection:=sdAscending;
FDomain:=sdLines;
FDirection:=MiscellaneousOptions.SortSelDirection;
FDomain:=MiscellaneousOptions.SortSelDomain;
FStates:=FStates+[ssdPreviewNeedsUpdate,ssdSortedTextNeedsUpdate];
Position:=poScreenCenter;
@ -475,7 +478,7 @@ begin
Add('Ascending');
Add('Descending');
Columns:=2;
case MiscellaneousOptions.SortSelDirection of
case FDirection of
sdAscending: ItemIndex:=0;
else ItemIndex:=1;
end;
@ -498,7 +501,7 @@ begin
Add('Lines');
Add('Words');
Add('Paragraphs');
case MiscellaneousOptions.SortSelDomain of
case FDomain of
sdLines: ItemIndex:=0;
sdWords: ItemIndex:=1;
else ItemIndex:=2;
@ -576,7 +579,11 @@ end;
procedure TSortSelectionDialog.EndUpdate;
begin
dec(FUpdateCount);
if FUpdateCount=0 then UpdatePreview;
if (FUpdateCount=0) then begin
if ssdSortedTextNeedsUpdate in FStates then
Include(FStates,ssdPreviewNeedsUpdate);
if (ssdPreviewNeedsUpdate in FStates) then UpdatePreview;
end;
end;
procedure TSortSelectionDialog.UpdatePreview;

387
packager/packagedefs.pas
View File

@ -46,8 +46,8 @@ interface
uses
Classes, SysUtils, LCLProc, LResources, Graphics, Laz_XMLCfg, AVL_Tree,
DefineTemplates, CompilerOptions, Forms, FileCtrl, IDEProcs, ComponentReg,
TransferMacros, FileReferenceList;
DefineTemplates, CodeToolManager, EditDefineTree, CompilerOptions, Forms,
FileCtrl, IDEProcs, ComponentReg, TransferMacros, FileReferenceList;
type
TLazPackage = class;
@ -93,6 +93,7 @@ type
Minor: integer;
Release: integer;
Build: integer;
OnChange: TNotifyEvent;
procedure Clear;
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
FileVersion: integer);
@ -306,17 +307,62 @@ type
protected
FName: string;
FVersion: TPkgVersion;
FIDAsString: string;
procedure SetName(const AValue: string); virtual;
procedure UpdateIDAsString;
procedure VersionChanged(Sender: TObject); virtual;
public
constructor Create;
destructor Destroy; override;
function IDAsString: string;
function StringToID(const s: string): boolean;
function Compare(PackageID2: TLazPackageID): integer;
procedure AssignID(Source: TLazPackageID); virtual;
public
property Name: string read FName write SetName;
property Version: TPkgVersion read FVersion;
property IDAsString: string read FIDAsString;
end;
{ TLazPackageDefineTemplates }
TLazPkgDefineTemplatesFlag = (
pdtIDChanged,
pdtSourceDirsChanged,
pdtOutputDirChanged
);
TLazPkgDefineTemplatesFlags = set of TLazPkgDefineTemplatesFlag;
TLazPackageDefineTemplates = class
private
FFlags: TLazPkgDefineTemplatesFlags;
fLastOutputDirSrcPathIDAsString: string;
fLastSourceDirectories: TStringList;
fLastSourceDirStamp: integer;
fLastSourceDirsIDAsString: string;
FLazPackage: TLazPackage;
FMain: TDefineTemplate;
FOutputDir: TDefineTemplate;
FOutPutSrcPath: TDefineTemplate;
FUpdateLock: integer;
procedure UpdateMain;
procedure UpdateDefinesForOutputDirectory;
procedure UpdateDefinesForSourceDirectories;
public
constructor Create(OwnerPackage: TLazPackage);
destructor Destroy; override;
procedure Clear;
procedure BeginUpdate;
procedure EndUpdate;
procedure PackageIDChanged;
procedure SourceDirectoriesChanged;
procedure OutputDirectoryChanged;
procedure AllChanged;
public
property LazPackage: TLazPackage read FLazPackage;
property Main: TDefineTemplate read FMain;
property OutputDir: TDefineTemplate read FOutputDir;
property OutPutSrcPath: TDefineTemplate read FOutPutSrcPath;
end;
@ -340,6 +386,7 @@ type
// package requires this package)
lpfVisited, // Used by the PackageGraph to avoid double checking
lpfDestroying, // set during destruction
lpfLoading, // set during loading
lpfSkipSaving, // Used by PkgBoss to skip saving
lpfCircle, // Used by the PackageGraph to mark circles
lpfStateFileLoaded // state file data valid
@ -365,7 +412,7 @@ type
FAutoInstall: TPackageInstallType;
FCompilerOptions: TPkgCompilerOptions;
FComponents: TList; // TList of TPkgComponent
FDefineTemplate: TDefineTemplate;
FDefineTemplates: TLazPackageDefineTemplates;
FDescription: string;
FDirectory: string;
FEditorRect: TRect;
@ -388,6 +435,7 @@ type
FRegistered: boolean;
FSourceDirectories: TFileReferenceList;
FStateFileDate: longint;
FUpdateLock: integer;
FUsageOptions: TPkgAdditionalCompilerOptions;
function GetAutoIncrementVersionOnBuild: boolean;
function GetAutoUpdate: boolean;
@ -420,9 +468,13 @@ type
function SubstitutePkgMacro(const s: string): string;
procedure Clear;
procedure UpdateSourceDirectories;
procedure VersionChanged(Sender: TObject); override;
procedure SourceDirectoriesChanged(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
procedure BeginUpdate;
procedure EndUpdate;
procedure LockModified;
procedure UnlockModified;
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
@ -441,6 +493,9 @@ type
function GetOutputDirectory: string;
function GetStateFilename: string;
function GetCompilerFilename: string;
function GetUnitPath(RelativeToBaseDir: boolean): string;
function GetIncludePath(RelativeToBaseDir: boolean): string;
function NeedsDefineTemplates: boolean;
// files
function FindPkgFile(const AFilename: string;
ResolveLinks, IgnoreRemoved: boolean): TPkgFile;
@ -490,8 +545,8 @@ type
property CompilerOptions: TPkgCompilerOptions read FCompilerOptions;
property ComponentCount: integer read GetComponentCount;
property Components[Index: integer]: TPkgComponent read GetComponents;
property DefineTemplate: TDefineTemplate read FDefineTemplate
write FDefineTemplate;
property DefineTemplates: TLazPackageDefineTemplates read FDefineTemplates
write FDefineTemplates;
property Description: string read FDescription write SetDescription;
property Directory: string read FDirectory; // the path of the .lpk file
property Editor: TBasePackageEditor read FPackageEditor
@ -553,8 +608,8 @@ const
'RunTime', 'DesignTime', 'RunAndDesignTime');
LazPackageFlagNames: array[TLazPackageFlag] of string = (
'lpfAutoIncrementVersionOnBuild', 'lpfModified', 'lpfAutoUpdate',
'lpfNeeded', 'lpfVisited', 'lpfDestroying', 'lpfSkipSaving', 'lpfCircle',
'lpfStateFileLoaded');
'lpfNeeded', 'lpfVisited', 'lpfDestroying', 'lpfLoading', 'lpfSkipSaving',
'lpfCircle', 'lpfStateFileLoaded');
var
// All TPkgDependency are added to this AVL tree (sorted for names, not version!)
@ -1222,21 +1277,23 @@ end;
procedure TPkgVersion.Clear;
begin
Major:=0;
Minor:=0;
Release:=0;
Build:=0;
SetValues(0,0,0,0);
end;
procedure TPkgVersion.LoadFromXMLConfig(XMLConfig: TXMLConfig;
const Path: string; FileVersion: integer);
var
NewMajor: Integer;
NewMinor: Integer;
NewRelease: Integer;
NewBuild: Integer;
begin
if FileVersion=1 then ;
Clear;
Major:=VersionBound(XMLConfig.GetValue(Path+'Major',0));
Minor:=VersionBound(XMLConfig.GetValue(Path+'Minor',0));
Release:=VersionBound(XMLConfig.GetValue(Path+'Release',0));
Build:=VersionBound(XMLConfig.GetValue(Path+'Build',0));
NewMajor:=VersionBound(XMLConfig.GetValue(Path+'Major',0));
NewMinor:=VersionBound(XMLConfig.GetValue(Path+'Minor',0));
NewRelease:=VersionBound(XMLConfig.GetValue(Path+'Release',0));
NewBuild:=VersionBound(XMLConfig.GetValue(Path+'Build',0));
SetValues(NewMajor,NewMinor,NewRelease,NewBuild);
end;
procedure TPkgVersion.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string
@ -1251,17 +1308,17 @@ end;
function TPkgVersion.Compare(Version2: TPkgVersion): integer;
begin
Result:=Major-Version2.Major;
if Result=0 then Result:=Minor-Version2.Minor;
if Result=0 then Result:=Release-Version2.Release;
if Result=0 then Result:=Build-Version2.Build;
if Result<>0 then exit;
Result:=Minor-Version2.Minor;
if Result<>0 then exit;
Result:=Release-Version2.Release;
if Result<>0 then exit;
Result:=Build-Version2.Build;
end;
procedure TPkgVersion.Assign(Source: TPkgVersion);
begin
Major:=Source.Major;
Minor:=Source.Minor;
Release:=Source.Release;
Build:=Source.Build;
SetValues(Source.Major,Source.Minor,Source.Release,Source.Build);
end;
function TPkgVersion.AsString: string;
@ -1296,10 +1353,7 @@ begin
inc(CurPos);
end;
end;
Major:=ints[1];
Minor:=ints[2];
Release:=ints[3];
Build:=ints[4];
SetValues(ints[1],ints[2],ints[3],ints[4]);
Result:=true;
end;
@ -1307,10 +1361,17 @@ end;
procedure TPkgVersion.SetValues(NewMajor, NewMinor, NewRelease,
NewBuild: integer);
begin
Major:=VersionBound(NewMajor);
Minor:=VersionBound(NewMinor);
Release:=VersionBound(NewRelease);
Build:=VersionBound(NewBuild);
NewMajor:=VersionBound(NewMajor);
NewMinor:=VersionBound(NewMinor);
NewRelease:=VersionBound(NewRelease);
NewBuild:=VersionBound(NewBuild);
if (NewMajor=Major) and (NewMinor=Minor) and (NewRelease=Release)
and (NewBuild=Build) then exit;
Major:=NewMajor;
Minor:=NewMinor;
Release:=NewRelease;
Build:=NewBuild;
if Assigned(OnChange) then OnChange(Self);
end;
function TPkgVersion.VersionBound(v: integer): integer;
@ -1501,7 +1562,8 @@ end;
procedure TLazPackage.SetName(const AValue: string);
begin
if FName=AValue then exit;
FName:=AValue;
inherited SetName(AValue);
FDefineTemplates.PackageIDChanged;
Modified:=true;
end;
@ -1529,6 +1591,7 @@ begin
inherited Create;
FComponents:=TList.Create;
FSourceDirectories:=TFileReferenceList.Create;
FSourceDirectories.OnChanged:=@SourceDirectoriesChanged;
FFiles:=TList.Create;
FRemovedFiles:=TList.Create;
FMacros:=TTransferMacroList.Create;
@ -1540,6 +1603,7 @@ begin
FCompilerOptions.DefaultMakeOptionsFlags:=[ccloNoLinkerOpts];
FUsageOptions:=TPkgAdditionalCompilerOptions.Create(Self);
FUsageOptions.ParsedOpts.OnLocalSubstitute:=@SubstitutePkgMacro;
FDefineTemplates:=TLazPackageDefineTemplates.Create(Self);
Clear;
end;
@ -1547,6 +1611,7 @@ destructor TLazPackage.Destroy;
begin
Include(FFlags,lpfDestroying);
Clear;
FreeAndNil(FDefineTemplates);
FreeAndNil(FRemovedFiles);
FreeAndNil(FFiles);
FreeAndNil(FComponents);
@ -1557,6 +1622,21 @@ begin
inherited Destroy;
end;
procedure TLazPackage.BeginUpdate;
begin
inc(FUpdateLock);
FDefineTemplates.BeginUpdate;
FSourceDirectories.BeginUpdate;
end;
procedure TLazPackage.EndUpdate;
begin
if FUpdateLock=0 then RaiseException('TLazPackage.EndUpdate');
dec(FUpdateLock);
FDefineTemplates.EndUpdate;
FSourceDirectories.EndUpdate;
end;
procedure TLazPackage.Clear;
var
i: Integer;
@ -1611,6 +1691,18 @@ begin
fSourceDirectories.AddFilename(Files[i].Directory);
end;
procedure TLazPackage.VersionChanged(Sender: TObject);
begin
inherited VersionChanged(Sender);
FDefineTemplates.PackageIDChanged;
Modified:=true;
end;
procedure TLazPackage.SourceDirectoriesChanged(Sender: TObject);
begin
FDefineTemplates.SourceDirectoriesChanged;
end;
procedure TLazPackage.LockModified;
begin
inc(FModifiedLock);
@ -1684,13 +1776,15 @@ var
end;
begin
Flags:=Flags+[lpfLoading];
FileVersion:=XMLConfig.GetValue(Path+'Version',0);
if FileVersion=1 then ;
OldFilename:=Filename;
BeginUpdate;
Clear;
Filename:=OldFilename;
LockModified;
FName:=XMLConfig.GetValue(Path+'Name/Value','');
Name:=XMLConfig.GetValue(Path+'Name/Value','');
FAuthor:=XMLConfig.GetValue(Path+'Author/Value','');
FCompilerOptions.LoadFromXMLConfig(XMLConfig,Path+'CompilerOptions/');
FDescription:=XMLConfig.GetValue(Path+'Description','');
@ -1705,8 +1799,10 @@ begin
FFirstRequiredDependency,pdlRequires);
FUsageOptions.LoadFromXMLConfig(XMLConfig,Path+'UsageOptions/');
LoadRect(XMLConfig,Path+'EditorRect/',fEditorRect);
EndUpdate;
Modified:=false;
UnlockModified;
Flags:=Flags-[lpfLoading];
end;
procedure TLazPackage.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string
@ -2135,6 +2231,24 @@ begin
Result:=CompilerOptions.ParsedOpts.GetParsedValue(pcosCompilerPath);
end;
function TLazPackage.GetUnitPath(RelativeToBaseDir: boolean): string;
begin
Result:=CompilerOptions.GetUnitPath(RelativeToBaseDir);
end;
function TLazPackage.GetIncludePath(RelativeToBaseDir: boolean): string;
begin
Result:=CompilerOptions.GetIncludePath(RelativeToBaseDir);
end;
function TLazPackage.NeedsDefineTemplates: boolean;
begin
if IsVirtual or AutoCreated or (lpfDestroying in Flags) or (Name='') then
Result:=false
else
Result:=true;
end;
{ TPkgComponent }
procedure TPkgComponent.SetPkgFile(const AValue: TPkgFile);
@ -2222,11 +2336,13 @@ procedure TLazPackageID.SetName(const AValue: string);
begin
if FName=AValue then exit;
FName:=AValue;
UpdateIDAsString;
end;
constructor TLazPackageID.Create;
begin
FVersion:=TPkgVersion.Create;
FVersion.OnChange:=@VersionChanged;
end;
destructor TLazPackageID.Destroy;
@ -2235,9 +2351,14 @@ begin
inherited Destroy;
end;
function TLazPackageID.IDAsString: string;
procedure TLazPackageID.UpdateIDAsString;
begin
Result:=Name+' '+Version.AsString;
FIDAsString:=Name+' '+Version.AsString;
end;
procedure TLazPackageID.VersionChanged(Sender: TObject);
begin
UpdateIDAsString;
end;
function TLazPackageID.StringToID(const s: string): boolean;
@ -2438,6 +2559,200 @@ begin
Result:=LazPackage.IDAsString;
end;
{ TLazPackageDefineTemplates }
constructor TLazPackageDefineTemplates.Create(OwnerPackage: TLazPackage);
begin
FLazPackage:=OwnerPackage;
end;
destructor TLazPackageDefineTemplates.Destroy;
begin
Clear;
fLastSourceDirectories.Free;
inherited Destroy;
end;
procedure TLazPackageDefineTemplates.Clear;
begin
if FMain<>nil then begin
CodeToolBoss.DefineTree.RemoveDefineTemplate(FMain);
FMain:=nil;
FOutputDir:=nil;
FOutPutSrcPath:=nil;
fLastOutputDirSrcPathIDAsString:='';
fLastSourceDirectories.Clear;
FFlags:=FFlags+[pdtIDChanged,pdtOutputDirChanged,pdtSourceDirsChanged];
end;
end;
procedure TLazPackageDefineTemplates.BeginUpdate;
begin
inc(FUpdateLock);
end;
procedure TLazPackageDefineTemplates.EndUpdate;
begin
if FUpdateLock=0 then RaiseException('TLazPackageDefineTemplates.EndUpdate');
dec(FUpdateLock);
if FUpdateLock=0 then begin
if pdtIDChanged in FFlags then PackageIDChanged;
if pdtSourceDirsChanged in FFlags then SourceDirectoriesChanged;
if pdtOutputDirChanged in FFlags then OutputDirectoryChanged;
end;
end;
procedure TLazPackageDefineTemplates.PackageIDChanged;
begin
if FUpdateLock>0 then begin
Include(FFlags,pdtIDChanged);
exit;
end;
Exclude(FFlags,pdtIDChanged);
UpdateMain;
UpdateDefinesForOutputDirectory;
UpdateDefinesForSourceDirectories;
end;
procedure TLazPackageDefineTemplates.SourceDirectoriesChanged;
begin
if FUpdateLock>0 then begin
Include(FFlags,pdtSourceDirsChanged);
exit;
end;
Exclude(FFlags,pdtSourceDirsChanged);
UpdateDefinesForSourceDirectories;
CodeToolBoss.DefineTree.ClearCache;
end;
procedure TLazPackageDefineTemplates.OutputDirectoryChanged;
begin
if FUpdateLock>0 then begin
Include(FFlags,pdtOutputDirChanged);
exit;
end;
Exclude(FFlags,pdtOutputDirChanged);
UpdateDefinesForOutputDirectory;
CodeToolBoss.DefineTree.ClearCache;
end;
procedure TLazPackageDefineTemplates.AllChanged;
begin
PackageIDChanged;
SourceDirectoriesChanged;
OutputDirectoryChanged;
end;
procedure TLazPackageDefineTemplates.UpdateMain;
begin
if not LazPackage.NeedsDefineTemplates then exit;
// update the package block define template (the container for all other
// define templates of the package)
if FMain=nil then begin
writeln('TLazPackageDefineTemplates.UpdateMain A ',LazPackage.IDAsString);
FMain:=CreatePackageTemplateWithID(LazPackage.IDAsString);
end;
FMain.Name:=LazPackage.IDAsString;
// ClearCache is here unnessary, because it is only a block
end;
procedure TLazPackageDefineTemplates.UpdateDefinesForOutputDirectory;
begin
if not LazPackage.NeedsDefineTemplates then exit;
if FMain=nil then UpdateMain;
if FOutputDir=nil then begin
FOutputDir:=TDefineTemplate.Create(PkgOutputDirDefTemplName,
'Output directory','',LazPackage.GetOutputDirectory,da_Directory);
FMain.AddChild(FOutputDir);
end;
if (FOutPutSrcPath=nil)
or (fLastOutputDirSrcPathIDAsString<>LazPackage.IDAsString) then begin
fLastOutputDirSrcPathIDAsString:=LazPackage.IDAsString;
writeln('TLazPackageDefineTemplates.UpdateDefinesForOutputDirectory A ',LazPackage.IDAsString);
FOutPutSrcPath:=TDefineTemplate.Create('CompiledSrcPath',
'CompiledSrcPath addition',CompiledSrcPathMacroName,
'$PkgSrcPath('+fLastOutputDirSrcPathIDAsString+');'
+'$('+CompiledSrcPathMacroName+')',
da_Define);
CodeToolBoss.DefineTree.ReplaceChild(FOutputDir,FOutPutSrcPath,
FOutPutSrcPath.Name);
end;
end;
procedure TLazPackageDefineTemplates.UpdateDefinesForSourceDirectories;
var
NewSourceDirs: TStringList;
i: Integer;
SrcDirDefTempl: TDefineTemplate;
UnitPathDefTempl: TDefineTemplate;
IncPathDefTempl: TDefineTemplate;
IDHasChanged: Boolean;
begin
if not LazPackage.NeedsDefineTemplates then exit;
// quick check if something has changed
IDHasChanged:=fLastSourceDirsIDAsString<>LazPackage.IDAsString;
if (fLastSourceDirectories<>nil)
and (fLastSourceDirStamp=LazPackage.SourceDirectories.TimeStamp)
and (not IDHasChanged) then
exit;
fLastSourceDirStamp:=LazPackage.SourceDirectories.TimeStamp;
fLastSourceDirsIDAsString:=LazPackage.IDAsString;
NewSourceDirs:=LazPackage.SourceDirectories.CreateFileList;
try
// real check if something has changed
if (fLastSourceDirectories<>nil)
and (NewSourceDirs.Count=fLastSourceDirectories.Count)
and (not IDHasChanged) then begin
i:=NewSourceDirs.Count-1;
while (i>=0)
and (CompareFilenames(NewSourceDirs[i],fLastSourceDirectories[i])=0) do
dec(i);
if i<0 then exit;
end;
// clear old define templates
if fLastSourceDirectories<>nil then begin
for i:=0 to fLastSourceDirectories.Count-1 do begin
TDefineTemplate(fLastSourceDirectories.Objects[i]).Free;
end;
fLastSourceDirectories.Clear;
end else
fLastSourceDirectories:=TStringList.Create;
writeln('TLazPackageDefineTemplates.UpdateDefinesForSourceDirectories A ',LazPackage.IDAsString,' "',NewSourceDirs.Text,'"');
// build source directory define templates
fLastSourceDirectories.Assign(NewSourceDirs);
if (FMain=nil) and (fLastSourceDirectories.Count>0) then UpdateMain;
for i:=0 to fLastSourceDirectories.Count-1 do begin
// create directory template
SrcDirDefTempl:=TDefineTemplate.Create('Source Directory '+IntToStr(i+1),
fLastSourceDirectories[i],'',fLastSourceDirectories[i],da_Directory);
fLastSourceDirectories.Objects[i]:=SrcDirDefTempl;
// create unit path template for this directory
UnitPathDefTempl:=TDefineTemplate.Create('UnitPath','Unit Path',
'#UnitPath','$(#UnitPath);$PkgUnitPath('+LazPackage.IDAsString+')',
da_Define);
SrcDirDefTempl.AddChild(UnitPathDefTempl);
// create include path template for this directory
IncPathDefTempl:=TDefineTemplate.Create('IncPath','Include Path',
'#IncPath','$(#IncPath);$PkgIncPath('+LazPackage.IDAsString+')',
da_Define);
SrcDirDefTempl.AddChild(IncPathDefTempl);
// add directory
FMain.AddChild(SrcDirDefTempl);
end;
CodeToolBoss.DefineTree.ClearCache;
finally
NewSourceDirs.Free;
end;
end;
initialization
PackageDependencies:=TAVLTree.Create(@ComparePkgDependencyNames);

3
packager/packagesystem.pas
View File

@ -624,8 +624,7 @@ begin
BeginUpdate(true);
Result:=TLazPackage.Create;
Result.Name:=CreateUniquePkgName('NewPackage',nil);
FItems.Add(Result);
FTree.Add(Result);
AddPackage(Result);
EndUpdate;
end;

112
packager/pkgmanager.pas
View File

@ -55,33 +55,33 @@ uses
type
TPkgManager = class(TBasePkgManager)
procedure MainIDEitmPkgOpenPackageFileClick(Sender: TObject);
procedure MainIDEitmPkgPkgGraphClick(Sender: TObject);
function OnPackageEditorCompilePackage(Sender: TObject;
APackage: TLazPackage; CompileAll: boolean): TModalResult;
function OnPackageEditorCreateFile(Sender: TObject;
const Params: TAddToPkgResult): TModalResult;
procedure OnPackageEditorFreeEditor(APackage: TLazPackage);
procedure OnPackageEditorGetUnitRegisterInfo(Sender: TObject;
const AFilename: string; var TheUnitName: string;
var HasRegisterProc: boolean);
function OnPackageEditorOpenPackage(Sender: TObject; APackage: TLazPackage
): TModalResult;
function OnPackageEditorSavePackage(Sender: TObject; APackage: TLazPackage;
SaveAs: boolean): TModalResult;
function PackageGraphExplorerOpenPackage(Sender: TObject;
APackage: TLazPackage): TModalResult;
procedure MainIDEitmPkgOpenPackageFileClick(Sender: TObject);
procedure MainIDEitmPkgPkgGraphClick(Sender: TObject);
procedure mnuConfigCustomCompsClicked(Sender: TObject);
procedure mnuOpenRecentPackageClicked(Sender: TObject);
procedure mnuPkgOpenPackageClicked(Sender: TObject);
procedure OnApplicationIdle(Sender: TObject);
procedure OnPackageEditorFreeEditor(APackage: TLazPackage);
procedure OnPackageEditorGetUnitRegisterInfo(Sender: TObject;
const AFilename: string; var TheUnitName: string;
var HasRegisterProc: boolean);
procedure PackageGraphAddPackage(Pkg: TLazPackage);
procedure PackageGraphBeginUpdate(Sender: TObject);
procedure PackageGraphChangePackageName(APackage: TLazPackage;
const OldName: string);
procedure PackageGraphDeletePackage(APackage: TLazPackage);
procedure PackageGraphDependencyModified(ADependency: TPkgDependency);
function PackageGraphExplorerOpenPackage(Sender: TObject;
APackage: TLazPackage): TModalResult;
procedure PkgManagerAddPackage(Pkg: TLazPackage);
procedure PkgManagerEndUpdate(Sender: TObject; GraphChanged: boolean);
procedure mnuConfigCustomCompsClicked(Sender: TObject);
procedure mnuPkgOpenPackageClicked(Sender: TObject);
procedure mnuOpenRecentPackageClicked(Sender: TObject);
procedure OnApplicationIdle(Sender: TObject);
procedure PackageGraphEndUpdate(Sender: TObject; GraphChanged: boolean);
private
function DoShowSavePackageAsDialog(APackage: TLazPackage): TModalResult;
function CompileRequiredPackages(APackage: TLazPackage): TModalResult;
@ -92,8 +92,9 @@ type
function DoLoadPackageCompiledState(APackage: TLazPackage;
IgnoreErrors: boolean): TModalResult;
function CheckIfPackageNeedsCompilation(APackage: TLazPackage): TModalResult;
procedure UpdateCodeToolsDefinesForPackage(APackage: TLazPackage);
function MacroFunctionPkgSrcPath(Data: Pointer): boolean;
function MacroFunctionPkgUnitPath(Data: Pointer): boolean;
function MacroFunctionPkgIncPath(Data: Pointer): boolean;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -303,15 +304,15 @@ begin
Result:=DoOpenPackage(APackage);
end;
procedure TPkgManager.PkgManagerAddPackage(Pkg: TLazPackage);
procedure TPkgManager.PackageGraphAddPackage(Pkg: TLazPackage);
begin
if FileExists(Pkg.FileName) then PkgLinks.AddUserLink(Pkg);
if PackageGraphExplorer<>nil then
PackageGraphExplorer.UpdatePackageAdded(Pkg);
UpdateCodeToolsDefinesForPackage(Pkg);
end;
procedure TPkgManager.PkgManagerEndUpdate(Sender: TObject; GraphChanged: boolean);
procedure TPkgManager.PackageGraphEndUpdate(Sender: TObject;
GraphChanged: boolean);
begin
if GraphChanged then IncreaseCompilerGraphStamp;
if PackageGraphExplorer<>nil then begin
@ -777,35 +778,6 @@ writeln('TPkgManager.CheckIfPackageNeedsCompilation END ',APackage.IDAsString);
Result:=mrNo;
end;
procedure TPkgManager.UpdateCodeToolsDefinesForPackage(APackage: TLazPackage);
var
PkgDefTempl: TDefineTemplate;
OutPutDirDefTempl, CompiledSrcPathDefTempl: TDefineTemplate;
begin
if APackage.IsVirtual or APackage.AutoCreated then exit;
if APackage.DefineTemplate=nil then begin
APackage.DefineTemplate:=CreatePackageTemplateWithID(APackage.IDAsString);
end;
PkgDefTempl:=APackage.DefineTemplate;
PkgDefTempl.Name:=APackage.IDAsString;
OutPutDirDefTempl:=PkgDefTempl.FindChildByName(PkgOutputDirDefTemplName);
if OutPutDirDefTempl=nil then begin
OutPutDirDefTempl:=TDefineTemplate.Create(PkgOutputDirDefTemplName,
'Output directory','',APackage.GetOutputDirectory,da_Directory);
CompiledSrcPathDefTempl:=TDefineTemplate.Create('CompiledSrcPath',
'CompiledSrcPath addition',CompiledSrcPathMacroName,
'$PkgSrcPath('+APackage.IDAsString+');$('+CompiledSrcPathMacroName+')',
da_Define);
OutPutDirDefTempl.AddChild(CompiledSrcPathDefTempl);
PkgDefTempl.AddChild(OutPutDirDefTempl);
CodeToolBoss.DefineTree.ClearCache;
end else begin
// ToDo: update Package ID if needed
end;
end;
function TPkgManager.MacroFunctionPkgSrcPath(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
@ -825,6 +797,44 @@ begin
PkgID.Free;
end;
function TPkgManager.MacroFunctionPkgUnitPath(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
PkgID: TLazPackageID;
APackage: TLazPackage;
begin
FuncData:=PReadFunctionData(Data);
PkgID:=TLazPackageID.Create;
Result:=false;
if PkgID.StringToID(FuncData^.Param) then begin
APackage:=PackageGraph.FindPackageWithID(PkgID);
if APackage<>nil then begin
FuncData^.Result:=APackage.GetUnitPath(false);
Result:=true;
end;
end;
PkgID.Free;
end;
function TPkgManager.MacroFunctionPkgIncPath(Data: Pointer): boolean;
var
FuncData: PReadFunctionData;
PkgID: TLazPackageID;
APackage: TLazPackage;
begin
FuncData:=PReadFunctionData(Data);
PkgID:=TLazPackageID.Create;
Result:=false;
if PkgID.StringToID(FuncData^.Param) then begin
APackage:=PackageGraph.FindPackageWithID(PkgID);
if APackage<>nil then begin
FuncData^.Result:=APackage.GetIncludePath(false);
Result:=true;
end;
end;
PkgID.Free;
end;
constructor TPkgManager.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -835,11 +845,11 @@ begin
PackageGraph:=TLazPackageGraph.Create;
PackageGraph.OnChangePackageName:=@PackageGraphChangePackageName;
PackageGraph.OnAddPackage:=@PkgManagerAddPackage;
PackageGraph.OnAddPackage:=@PackageGraphAddPackage;
PackageGraph.OnDeletePackage:=@PackageGraphDeletePackage;
PackageGraph.OnDependencyModified:=@PackageGraphDependencyModified;
PackageGraph.OnBeginUpdate:=@PackageGraphBeginUpdate;
PackageGraph.OnEndUpdate:=@PkgManagerEndUpdate;
PackageGraph.OnEndUpdate:=@PackageGraphEndUpdate;
PackageEditors:=TPackageEditors.Create;
PackageEditors.OnOpenFile:=@MainIDE.DoOpenMacroFile;
@ -853,6 +863,10 @@ begin
CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
'PKGSRCPATH',nil,@MacroFunctionPkgSrcPath);
CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
'PKGUNITPATH',nil,@MacroFunctionPkgUnitPath);
CodeToolBoss.DefineTree.MacroFunctions.AddExtended(
'PKGINCPATH',nil,@MacroFunctionPkgIncPath);
Application.AddOnIdleHandler(@OnApplicationIdle);
end;