paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 05:38:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented define templates for projects with packages

Browse Source 
git-svn-id: trunk@4094 -
This commit is contained in:
mattias 2003-04-24 16:44:28 +00:00
parent 3ce6a58d2a
commit 0818bea677
23 changed files with 2170 additions and 1302 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
components/codetools/codecache.pas
View File

@ -111,6 +111,11 @@ type
FExpirationTimeInDays: integer;
FGlobalWriteLockIsSet: boolean;
FGlobalWriteLockStep: integer;
fLastIncludeLinkFile: string;
fLastIncludeLinkFileAge: integer;
fLastIncludeLinkFileValid: boolean;
fLastIncludeLinkFileChangeStep: integer;
fChangeStep: integer;
function FindIncludeLink(const IncludeFilename: string): string;
function FindIncludeLinkNode(const IncludeFilename: string): TIncludedByLink;
function OnScannerCheckFileOnDisk(Code: pointer): boolean;
@ -124,6 +129,7 @@ type
var ReadOnly: boolean);
procedure OnScannerIncludeCode(ParentCode, IncludeCode: pointer);
procedure UpdateIncludeLinks;
procedure IncreaseChangeStep;
public
constructor Create;
destructor Destroy; override;
@ -135,12 +141,13 @@ type
function LoadFile(const AFilename: string): TCodeBuffer;
function LoadIncludeLinksFromFile(const AFilename: string): boolean;
function LoadIncludeLinksFromXML(XMLConfig: TXMLConfig;
const XMLPath: string): boolean;
const XMLPath: string): boolean;
function SaveBufferAs(OldBuffer: TCodeBuffer; const AFilename: string;
var NewBuffer: TCodeBuffer): boolean;
function SaveIncludeLinksToFile(const AFilename: string): boolean;
var NewBuffer: TCodeBuffer): boolean;
function SaveIncludeLinksToFile(const AFilename: string;
OnlyIfChanged: boolean): boolean;
function SaveIncludeLinksToXML(XMLConfig: TXMLConfig;
const XMLPath: string): boolean;
const XMLPath: string): boolean;
procedure Clear;
procedure ClearAllSourceLogEntries;
procedure OnBufferSetFileName(Sender: TCodeBuffer;
@ -414,10 +421,16 @@ begin
end;
procedure TCodeCache.OnScannerIncludeCode(ParentCode, IncludeCode: pointer);
var
CodeBuffer: TCodeBuffer;
begin
if (ParentCode<>nil) and (IncludeCode<>nil) and (ParentCode<>IncludeCode) then
TCodeBuffer(IncludeCode).LastIncludedByFile:=
TCodeBuffer(ParentCode).Filename;
begin
CodeBuffer:=TCodeBuffer(IncludeCode);
if CodeBuffer.LastIncludedByFile=TCodeBuffer(ParentCode).Filename then exit;
CodeBuffer.LastIncludedByFile:=TCodeBuffer(ParentCode).Filename;
IncreaseChangeStep;
end;
end;
procedure TCodeCache.OnScannerGetSourceStatus(Sender: TObject; Code:Pointer;
@ -487,17 +500,37 @@ begin
end;
end;
function TCodeCache.SaveIncludeLinksToFile(const AFilename: string): boolean;
procedure TCodeCache.IncreaseChangeStep;
begin
inc(fChangeStep);
if fChangeStep=$7fffffff then fChangeStep:=-$7fffffff;
end;
function TCodeCache.SaveIncludeLinksToFile(const AFilename: string;
OnlyIfChanged: boolean): boolean;
var XMLConfig: TXMLConfig;
begin
try
if OnlyIfChanged and fLastIncludeLinkFileValid
and (fLastIncludeLinkFileChangeStep=fChangeStep)
and (fLastIncludeLinkFile=AFilename)
and FileExists(AFilename) and (FileAge(AFilename)=fLastIncludeLinkFileAge)
then begin
exit;
end;
ClearFile(AFilename,true);
XMLConfig:=TXMLConfig.Create(AFilename);
try
Result:=SaveIncludeLinksToXML(XMLConfig,'');
fLastIncludeLinkFile:=AFilename;
fLastIncludeLinkFileAge:=FileAge(AFilename);
fLastIncludeLinkFileChangeStep:=fChangeStep;
fLastIncludeLinkFileValid:=true;
finally
XMLConfig.Free;
end;
except
fLastIncludeLinkFileValid:=false;
Result:=false;
end;
end;
@ -509,10 +542,15 @@ begin
XMLConfig:=TXMLConfig.Create(AFilename);
try
Result:=LoadIncludeLinksFromXML(XMLConfig,'');
fLastIncludeLinkFile:=AFilename;
fLastIncludeLinkFileAge:=FileAge(AFilename);
fLastIncludeLinkFileChangeStep:=fChangeStep;
fLastIncludeLinkFileValid:=true;
finally
XMLConfig.Free;
end;
except
fLastIncludeLinkFileValid:=false;
Result:=false;
end;
end;

8
components/codetools/codetoolmanager.pas
View File

@ -91,7 +91,7 @@ type
function OnScannerGetInitValues(Code: Pointer;
var AChangeStep: integer): TExpressionEvaluator;
procedure OnDefineTreeReadValue(Sender: TObject; const VariableName: string;
var Value: string);
var Value: string; var Handled: boolean);
procedure OnGlobalValuesChanged;
function DoOnFindUsedUnit(SrcTool: TFindDeclarationTool; const TheUnitName,
TheUnitInFilename: string): TCodeBuffer;
@ -1983,9 +1983,11 @@ begin
end;
procedure TCodeToolManager.OnDefineTreeReadValue(Sender: TObject;
const VariableName: string; var Value: string);
const VariableName: string; var Value: string; var Handled: boolean);
begin
Value:=GlobalValues[VariableName];
Handled:=GlobalValues.IsDefined(VariableName);
if Handled then
Value:=GlobalValues[VariableName];
//writeln('[TCodeToolManager.OnDefineTreeReadValue] Name="',VariableName,'" = "',Value,'"');
end;

1140
components/codetools/definetemplates.pas
View File

File diff suppressed because it is too large Load Diff

24
components/codetools/fileprocs.pas
View File

@ -75,6 +75,7 @@ function SearchFileInPath(const Filename, BasePath, SearchPath,
Delimiter: string; SearchLoUpCase: boolean): string;
function FilenameIsMatching(const Mask, Filename: string;
MatchExactly: boolean): boolean;
function ClearFile(const Filename: string; RaiseOnError: boolean): boolean;
implementation
@ -87,6 +88,29 @@ uses
var
UpChars: array[char] of char;
{-------------------------------------------------------------------------------
function ClearFile(const Filename: string; RaiseOnError: boolean): boolean;
-------------------------------------------------------------------------------}
function ClearFile(const Filename: string; RaiseOnError: boolean): boolean;
var
fs: TFileStream;
begin
if FileExists(Filename) then begin
try
fs:=TFileStream.Create(Filename,fmOpenWrite);
fs.Size:=0;
fs.Free;
except
on E: Exception do begin
Result:=false;
if RaiseOnError then raise;
exit;
end;
end;
end;
Result:=true;
end;
function CompareFilenames(const Filename1, Filename2: string): integer;
begin
{$IFDEF WIN32}

211
ide/codetoolsdefines.pas
View File

@ -133,7 +133,6 @@ type
// selected item
SelectedItemGroupBox: TGroupBox;
TypeLabel: TLabel;
ProjectSpecificCheckBox: TCheckBox;
NameLabel: TLabel;
NameEdit: TEdit;
DescriptionLabel: TLabel;
@ -157,7 +156,6 @@ type
procedure ValueNoteBookResize(Sender: TObject);
procedure DefineTreeViewMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X,Y: integer);
procedure ProjectSpecificCheckBoxClick(Sender: TObject);
procedure RefreshPreview;
// exit menu
@ -226,12 +224,6 @@ type
function ShowCodeToolsDefinesEditor(ACodeToolBoss: TCodeToolManager;
Options: TCodeToolsOptions; Macros: TTransferMacroList): TModalResult;
function SaveGlobalCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
Options: TCodeToolsOptions): TModalResult;
function SaveProjectSpecificCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
const ProjectInfoFile: string): TModalResult;
function LoadCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
Options: TCodeToolsOptions; const ProjectInfoFile: string): TModalResult;
implementation
@ -243,119 +235,6 @@ uses
type
TWinControlClass = class of TWinControl;
function SaveGlobalCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
Options: TCodeToolsOptions): TModalResult;
var
XMLConfig: TXMLConfig;
begin
Result:=mrCancel;
try
XMLConfig:=TXMLConfig.Create(Options.Filename);
try
ACodeToolBoss.DefineTree.SaveToXMLConfig(XMLConfig,
'CodeToolsGlobalDefines/',dtspGlobals);
XMLConfig.Flush;
finally
XMLConfig.Free;
end;
Result:=mrOk;
except
on e: Exception do
Result:=MessageDlg(lisCodeToolsDefsWriteError, Format(
lisCodeToolsDefsErrorWhileWriting, ['"', Options.Filename, '"', #13,
e.Message]), mtError, [mbIgnore, mbAbort], 0);
end;
end;
function SaveProjectSpecificCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
const ProjectInfoFile: string): TModalResult;
var
XMLConfig: TXMLConfig;
begin
Result:=mrCancel;
try
XMLConfig:=TXMLConfig.Create(ProjectInfoFile);
try
ACodeToolBoss.DefineTree.SaveToXMLConfig(XMLConfig,
'ProjectSpecificCodeToolsDefines/',dtspProjectSpecific);
XMLConfig.Flush;
finally
XMLConfig.Free;
end;
Result:=mrOk;
except
on e: Exception do
Result:=MessageDlg(lisCodeToolsDefsWriteError,
Format(lisCodeToolsDefsErrorWhileWritingProjectInfoFile, ['"',
ProjectInfoFile, '"', #13, e.Message]), mtError, [mbIgnore, mbAbort
], 0);
end;
end;
function LoadCodeToolsDefines(ACodeToolBoss: TCodeToolManager;
Options: TCodeToolsOptions; const ProjectInfoFile: string): TModalResult;
// replaces globals and project defines if changed
var
NewDefineTree: TDefineTree;
XMLConfig: TXMLConfig;
begin
Result:=mrCancel;
NewDefineTree:=TDefineTree.Create;
try
// create a temporary copy of current defines
NewDefineTree.Assign(ACodeToolBoss.DefineTree);
// remove non auto generated = all globals and project specific defines
NewDefineTree.RemoveNonAutoCreated;
if (Options<>nil) and (Options.Filename<>'') then begin
// load global defines
try
XMLConfig:=TXMLConfig.Create(Options.Filename);
try
NewDefineTree.LoadFromXMLConfig(XMLConfig,
'CodeToolsGlobalDefines/',dtlpGlobals,'Global');
finally
XMLConfig.Free;
end;
Result:=mrOk;
except
on e: Exception do
Result:=MessageDlg(lisCodeToolsDefsReadError, Format(
lisCodeToolsDefsErrorReading, ['"', Options.Filename, '"', #13,
e.Message]), mtError, [mbIgnore, mbAbort], 0);
end;
if Result<>mrOk then exit;
end;
if ProjectInfoFile<>'' then begin
// load project specific defines
try
XMLConfig:=TXMLConfig.Create(ProjectInfoFile);
try
NewDefineTree.LoadFromXMLConfig(XMLConfig,
'ProjectSpecificCodeToolsDefines/',dtlpProjectSpecific,
'ProjectSpecific');
finally
XMLConfig.Free;
end;
Result:=mrOk;
except
on e: Exception do
Result:=MessageDlg(lisCodeToolsDefsReadError,
Format(lisCodeToolsDefsErrorReadingProjectInfoFile, ['"',
ProjectInfoFile, '"', #13, e.Message]), mtError, [mbIgnore,
mbAbort], 0);
end;
if Result<>mrOk then exit;
end;
// check if something changed (so the caches are only cleared if neccesary)
if not NewDefineTree.IsEqual(ACodeToolBoss.DefineTree) then begin
ACodeToolBoss.DefineTree.Assign(NewDefineTree);
end;
Result:=mrOk;
finally
NewDefineTree.Free;
end;
end;
function ShowCodeToolsDefinesEditor(ACodeToolBoss: TCodeToolManager;
Options: TCodeToolsOptions; Macros: TTransferMacroList): TModalResult;
var CodeToolsDefinesEditor: TCodeToolsDefinesEditor;
@ -367,8 +246,10 @@ begin
if Result=mrOk then begin
if not CodeToolsDefinesEditor.DefineTree.IsEqual(ACodeToolBoss.DefineTree)
then begin
ACodeToolBoss.DefineTree.Assign(CodeToolsDefinesEditor.DefineTree);
Result:=SaveGlobalCodeToolsDefines(ACodeToolBoss,Options);
ACodeToolBoss.DefineTree.AssignNonAutoCreated(
CodeToolsDefinesEditor.DefineTree);
Options.ReadGlobalDefinesTemplatesFromTree(ACodeToolBoss.DefineTree);
Options.Save;
end;
end;
CodeToolsDefinesEditor.Free;
@ -400,14 +281,9 @@ begin
Top:=3;
Width:=SelItemMaxX-2*Left;
end;
with ProjectSpecificCheckBox do begin
Left:=TypeLabel.Left;
Top:=TypeLabel.Top+TypeLabel.Height+5;
Width:=SelItemMaxX-2*Left;
end;
with NameLabel do begin
Left:=ProjectSpecificCheckBox.Left;
Top:=ProjectSpecificCheckBox.Top+ProjectSpecificCheckBox.Height+7;
Left:=TypeLabel.Left;
Top:=TypeLabel.Top+TypeLabel.Height+7;
Width:=70;
end;
with NameEdit do begin
@ -761,7 +637,8 @@ begin
writeln(' CompilerPath="',CompilerPath,'"');
if (CompilerPath<>'') and (CompilerPath<>DefaultCompiler) then
FPCTemplate:=Boss.DefinePool.CreateFPCTemplate(CompilerPath,
CreateCompilerTestPascalFilename,UnitSearchPath)
CreateCompilerTestPascalFilename,UnitSearchPath,
CodeToolsOpts)
else
FPCTemplate:=nil;
@ -772,7 +649,8 @@ begin
if (FPCSrcDir<>'') and (FPCSrcDir<>DefaultFPCSrcDir)
and (UnitSearchPath<>'') then
FPCSrcTemplate:=Boss.DefinePool.CreateFPCSrcTemplate(FPCSrcDir,
UnitSearchPath, false, UnitLinkList)
UnitSearchPath, false, UnitLinkList,
CodeToolsOpts)
else
FPCSrcTemplate:=nil;
@ -799,6 +677,7 @@ begin
FPCSrcTemplate.Free;
end;
DirTemplate.SetDefineOwner(CodeToolsOpts,true);
InsertTemplate(DirTemplate);
end;
end;
@ -833,7 +712,8 @@ begin
writeln(' CompilerPath="',CompilerPath,'"');
FPCTemplate:=Boss.DefinePool.CreateFPCTemplate(CompilerPath,
CreateCompilerTestPascalFilename,s);
CreateCompilerTestPascalFilename,s,
CodeToolsOpts);
if FPCTemplate=nil then exit;
FPCTemplate.Name:='Free Pascal Compiler ('+CompilerPath+')';
InsertTemplate(FPCTemplate);
@ -877,7 +757,8 @@ begin
writeln(' CompilerPath="',CompilerPath,'"');
FPCTemplate:=Boss.DefinePool.CreateFPCTemplate(CompilerPath,
CreateCompilerTestPascalFilename,UnitSearchPath);
CreateCompilerTestPascalFilename,UnitSearchPath,
CodeToolsOpts);
if FPCTemplate=nil then begin
writeln('ERROR: unable to get FPC Compiler Macros from "',CompilerPath,'"');
exit;
@ -889,7 +770,8 @@ begin
writeln(' FPCSrcDir="',FPCSrcDir,'"');
UnitSearchPath:='';
FPCSrcTemplate:=Boss.DefinePool.CreateFPCSrcTemplate(FPCSrcDir,
UnitSearchPath, false, UnitLinks);
UnitSearchPath, false, UnitLinks,
CodeToolsOpts);
if FPCSrcTemplate=nil then begin
writeln('ERROR: unable to create FPC CVS Src defines for "',FPCSrcDir,'"');
FPCTemplate.Free;
@ -906,6 +788,7 @@ begin
ResetAllTemplate.InsertInFront(FPCSrcDirTemplate.FirstChild);
FPCTemplate.InsertBehind(ResetAllTemplate);
FPCSrcDirTemplate.SetDefineOwner(CodeToolsOpts,true);
InsertTemplate(FPCSrcDirTemplate);
end;
end;
@ -931,7 +814,8 @@ begin
EndUpdate;
if ShowModal=mrCancel then exit;
LazTemplate:=Boss.DefinePool.CreateLazarusSrcTemplate(FileNames[0],
'$('+ExternalMacroStart+'LCLWidgetType)','');
'$('+ExternalMacroStart+'LCLWidgetType)','',
CodeToolsOpts);
if LazTemplate=nil then exit;
LazTemplate.Name:='Lazarus Directory ('+FileNames[0]+')';
InsertTemplate(LazTemplate);
@ -947,7 +831,7 @@ begin
else
DelphiVersion:=5;
InsertTemplate(Boss.DefinePool.CreateDelphiCompilerDefinesTemplate(
DelphiVersion));
DelphiVersion,CodeToolsOpts));
end;
procedure TCodeToolsDefinesEditor.InsertDelphiDirectoryTemplateMenuItemClick(
@ -980,7 +864,7 @@ begin
EndUpdate;
if ShowModal=mrCancel then exit;
DirTemplate:=Boss.DefinePool.CreateDelphiDirectoryTemplate(FileNames[0],
DelphiVersion);
DelphiVersion,CodeToolsOpts);
if DirTemplate=nil then exit;
DirTemplate.Name:=DelphiName+' ('+FileNames[0]+')';
InsertTemplate(DirTemplate);
@ -1027,7 +911,7 @@ begin
EndUpdate;
if ShowModal=mrCancel then exit;
ProjTemplate:=Boss.DefinePool.CreateDelphiProjectTemplate(FileNames[0],
FileNames[1],DelphiVersion);
FileNames[1],DelphiVersion,CodeToolsOpts);
if ProjTemplate=nil then exit;
ProjTemplate.Name:=DelphiName+' Project ('+FileNames[0]+')';
InsertTemplate(ProjTemplate);
@ -1075,30 +959,6 @@ begin
end;
end;
procedure TCodeToolsDefinesEditor.ProjectSpecificCheckBoxClick(Sender: TObject);
var
SelTreeNode: TTreeNode;
SelDefNode: TDefineTemplate;
begin
SelTreeNode:=DefineTreeView.Selected;
if SelTreeNode=nil then exit;
SelDefNode:=TDefineTemplate(SelTreeNode.Data);
if ProjectSpecificCheckBox.Checked=(dtfProjectSpecific in SelDefNode.Flags)
then exit;
if SelDefNode.IsAutoGenerated then begin
MessageDlg(lisCodeToolsDefsNodeIsReadonly,
lisCodeToolsDefsAutoGeneratedNodesCanNotBeEdited,
mtInformation,[mbCancel],0);
exit;
end;
if ProjectSpecificCheckBox.Checked then
Include(SelDefNode.Flags,dtfProjectSpecific)
else
Exclude(SelDefNode.Flags,dtfProjectSpecific);
SetNodeImages(SelTreeNode,true);
SetTypeLabel;
end;
procedure TCodeToolsDefinesEditor.RefreshPreview;
begin
if DefinePreview=nil then exit;
@ -1471,12 +1331,6 @@ begin
CreateWinControl(TypeLabel,TLabel,'TypeLabel',SelectedItemGroupBox);
CreateWinControl(ProjectSpecificCheckBox,TCheckBox,'ProjectSpecificCheckBox',
SelectedItemGroupBox);
ProjectSpecificCheckBox.Caption:=
lisCodeToolsDefsNodeAndItsChildrenAreOnly;
ProjectSpecificCheckBox.OnClick:=@ProjectSpecificCheckBoxClick;
CreateWinControl(NameLabel,TLabel,'NameLabel',SelectedItemGroupBox);
NameLabel.Caption:=lisCodeToolsDefsName;
@ -1598,15 +1452,9 @@ begin
end;
ANode.SelectedIndex:=ANode.ImageIndex;
if ADefineTemplate.IsAutoGenerated then begin
if ADefineTemplate.IsProjectSpecific then
ANode.StateIndex:=15
else
ANode.StateIndex:=13;
ANode.StateIndex:=13;
end else begin
if ADefineTemplate.IsProjectSpecific then
ANode.StateIndex:=14
else
ANode.StateIndex:=12;
ANode.StateIndex:=12;
end;
if WithSubNodes then begin
ANode:=ANode.GetFirstChild;
@ -1663,8 +1511,6 @@ begin
if (ATreeNode<>nil) then begin
ADefNode:=TDefineTemplate(ATreeNode.Data);
if (not ADefNode.IsAutoGenerated) then begin
if ProjectSpecificCheckBox.Checked then
Include(ADefNode.Flags,dtfProjectSpecific);
ADefNode.Name:=NameEdit.Text;
ATreeNode.Text:=ADefNode.Name;
ADefNode.Variable:=VariableEdit.Text;
@ -1698,7 +1544,6 @@ begin
if SelTreeNode<>nil then begin
SelDefNode:=TDefineTemplate(SelTreeNode.Data);
SetValuesEditable(not SelDefNode.IsAutoGenerated);
ProjectSpecificCheckBox.Checked:=dtfProjectSpecific in SelDefNode.Flags;
NameEdit.Text:=SelDefNode.Name;
DescriptionEdit.Text:=SelDefNode.Description;
VariableEdit.Text:=SelDefNode.Variable;
@ -1737,8 +1582,6 @@ begin
s:=Format(lisCodeToolsDefsAction, [DefineActionNames[SelDefNode.Action]]);
if SelDefNode.IsAutoGenerated then
s:=Format(lisCodeToolsDefsautoGenerated, [s]);
if SelDefNode.IsProjectSpecific then
s:=Format(lisCodeToolsDefsprojectSpecific, [s]);
end else begin
s:=lisCodeToolsDefsnoneSelected;
end;
@ -1805,6 +1648,7 @@ begin
NewValue:='';
NewDefNode:=TDefineTemplate.Create(NewName,NewDescription,NewVariable,
NewValue,Action);
NewDefNode.Owner:=CodeToolsOpts;
// add node to treeview
if (NodeInFront<>nil) then
// insert in front
@ -1955,7 +1799,6 @@ procedure TCodeToolsDefinesEditor.SetValuesEditable(AValue: boolean);
begin
SelectedItemGroupBox.Enabled:=true;
TypeLabel.Enabled:=true;
ProjectSpecificCheckBox.Enabled:=AValue;
NameLabel.Enabled:=AValue;
NameEdit.Enabled:=AValue;
DescriptionLabel.Enabled:=AValue;
@ -1984,7 +1827,7 @@ constructor TCodeToolsDefinesEditor.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
Position:=poScreenCenter;
IDEDialogLayoutList.ApplyLayout(Self,500, 460);
IDEDialogLayoutList.ApplyLayout(Self,500,460);
if LazarusResources.Find(ClassName)=nil then begin
Caption:=lisCodeToolsDefsCodeToolsDefinesEditor;

185
ide/codetoolsoptions.pas
View File

@ -50,6 +50,9 @@ type
FAdjustTopLineDueToComment: boolean;
FJumpCentered: boolean;
FCursorBeyondEOL: boolean;
// Define Templates
FGlobalDefineTemplates: TDefineTemplate;
// CodeCreation
FAddInheritedCodeToOverrideMethod: boolean;
@ -77,14 +80,17 @@ type
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure ClearGlobalDefineTemplates;
procedure Load;
procedure Save;
procedure AssignTo(Boss: TCodeToolManager);
procedure AssignGlobalDefineTemplatesToTree(Tree: TDefineTree);
property Filename: string read FFilename write SetFilename;
procedure SetLazarusDefaultFilename;
procedure Assign(CodeToolsOpts: TCodeToolsOptions);
function IsEqual(CodeToolsOpts: TCodeToolsOptions): boolean;
function CreateCopy: TCodeToolsOptions;
procedure ReadGlobalDefinesTemplatesFromTree(Tree: TDefineTree);
// General
property SrcPath: string read FSrcPath write FSrcPath;
@ -93,6 +99,9 @@ type
property JumpCentered: boolean read FJumpCentered write FJumpCentered;
property CursorBeyondEOL: boolean
read FCursorBeyondEOL write FCursorBeyondEOL;
// Define Templates
property GlobalDefineTemplates: TDefineTemplate read FGlobalDefineTemplates;
// CodeCreation
property CompleteProperties: boolean
@ -299,12 +308,13 @@ begin
end;
procedure WriteAtomTypesToXML(XMLConfig: TXMLConfig; const Path: string;
NewValues: TAtomTypes);
NewValues, DefaultValues: TAtomTypes);
var a: TAtomType;
begin
for a:=Low(TAtomType) to High(TAtomType) do begin
if (a<>atNone) then
XMLConfig.SetValue(Path+AtomTypeNames[a]+'/Value',a in NewValues);
XMLConfig.SetDeleteValue(Path+AtomTypeNames[a]+'/Value',
a in NewValues,a in DefaultValues);
end;
end;
@ -340,7 +350,7 @@ end;
destructor TCodeToolsOptions.Destroy;
begin
ClearGlobalDefineTemplates;
inherited Destroy;
end;
@ -363,7 +373,23 @@ begin
true);
FCursorBeyondEOL:=XMLConfig.GetValue(
'CodeToolsOptions/CursorBeyondEOL/Value',true);
// Define templates
// delete old one
ClearGlobalDefineTemplates;
// create empty one
FGlobalDefineTemplates:=TDefineTemplate.Create;
FGlobalDefineTemplates.Name:='';
// load
FGlobalDefineTemplates.LoadFromXMLConfig(XMLConfig,'CodeToolsGlobalDefines/',
true,true);
// delete if still empty
if FGlobalDefineTemplates.Name='' then begin
ClearGlobalDefineTemplates;
end else begin
FGlobalDefineTemplates.SetDefineOwner(Self,true);
end;
// CodeCreation
FAddInheritedCodeToOverrideMethod:=XMLConfig.GetValue(
'CodeToolsOptions/AddInheritedCodeToOverrideMethod/Value',true);
@ -375,7 +401,7 @@ begin
'CodeToolsOptions/ClassPartInsertPolicy/Value',
ClassPartInsertPolicyNames[cpipAlphabetically]));
FMixMethodsAndPorperties:=XMLConfig.GetValue(
'CodeToolsOptions/MixMethodsAndPorperties/Value',false);
'CodeToolsOptions/MixMethodsAndProperties/Value',false);
FForwardProcInsertPolicy:=ForwardProcInsertPolicyNameToPolicy(
XMLConfig.GetValue('CodeToolsOptions/ForwardProcInsertPolicy/Value',
ForwardProcInsertPolicyNames[fpipInFrontOfMethods]));
@ -411,10 +437,10 @@ begin
'CodeToolsOptions/SetPropertyVariablename/Value',''),'AValue');
XMLConfig.Free;
except
// ToDo
writeln('[TCodeToolsOptions.Load] error reading "',FFilename,'"');
on E: Exception do begin
writeln('[TCodeToolsOptions.Load] error reading "',FFilename,'": ',E.Message);
end;
end;
end;
@ -423,63 +449,77 @@ var
XMLConfig: TXMLConfig;
begin
try
ClearFile(FFileName,true);
XMLConfig:=TXMLConfig.Create(FFileName);
XMLConfig.SetValue('CodeToolsOptions/Version/Value',
CodeToolsOptionsVersion);
// General
XMLConfig.SetValue('CodeToolsOptions/SrcPath/Value',FSrcPath);
XMLConfig.SetValue('CodeToolsOptions/AdjustTopLineDueToComment/Value',
FAdjustTopLineDueToComment);
XMLConfig.SetValue('CodeToolsOptions/JumpCentered/Value',FJumpCentered);
XMLConfig.SetValue('CodeToolsOptions/CursorBeyondEOL/Value',
FCursorBeyondEOL);
XMLConfig.SetDeleteValue('CodeToolsOptions/SrcPath/Value',FSrcPath,'');
XMLConfig.SetDeleteValue('CodeToolsOptions/AdjustTopLineDueToComment/Value',
FAdjustTopLineDueToComment,true);
XMLConfig.SetDeleteValue('CodeToolsOptions/JumpCentered/Value',
FJumpCentered,true);
XMLConfig.SetDeleteValue('CodeToolsOptions/CursorBeyondEOL/Value',
FCursorBeyondEOL,true);
// Define templates
FGlobalDefineTemplates.SaveToXMLConfig(XMLConfig,'CodeToolsGlobalDefines/',
true,false,true,false);
// CodeCreation
XMLConfig.SetValue(
XMLConfig.SetDeleteValue(
'CodeToolsOptions/AddInheritedCodeToOverrideMethod/Value',
AddInheritedCodeToOverrideMethod);
XMLConfig.SetValue(
'CodeToolsOptions/CompleteProperties/Value',CompleteProperties);
XMLConfig.SetValue(
'CodeToolsOptions/LineLengthXMLConfig/Value',FLineLength);
XMLConfig.SetValue('CodeToolsOptions/ClassPartInsertPolicy/Value',
ClassPartInsertPolicyNames[FClassPartInsertPolicy]);
XMLConfig.SetValue(
'CodeToolsOptions/MixMethodsAndPorperties/Value',FMixMethodsAndPorperties);
XMLConfig.SetValue('CodeToolsOptions/ForwardProcInsertPolicy/Value',
ForwardProcInsertPolicyNames[FForwardProcInsertPolicy]);
XMLConfig.SetValue(
'CodeToolsOptions/KeepForwardProcOrder/Value',FKeepForwardProcOrder);
XMLConfig.SetValue('CodeToolsOptions/MethodInsertPolicy/Value',
MethodInsertPolicyNames[FMethodInsertPolicy]);
XMLConfig.SetValue('CodeToolsOptions/KeyWordPolicy/Value',
WordPolicyNames[FKeyWordPolicy]);
XMLConfig.SetValue('CodeToolsOptions/IdentifierPolicy/Value',
WordPolicyNames[FIdentifierPolicy]);
AddInheritedCodeToOverrideMethod,true);
XMLConfig.SetDeleteValue(
'CodeToolsOptions/CompleteProperties/Value',CompleteProperties,true);
XMLConfig.SetDeleteValue(
'CodeToolsOptions/LineLengthXMLConfig/Value',FLineLength,80);
XMLConfig.SetDeleteValue('CodeToolsOptions/ClassPartInsertPolicy/Value',
ClassPartInsertPolicyNames[FClassPartInsertPolicy],
ClassPartInsertPolicyNames[cpipAlphabetically]);
XMLConfig.SetDeleteValue(
'CodeToolsOptions/MixMethodsAndProperties/Value',FMixMethodsAndPorperties,
false);
XMLConfig.SetDeleteValue('CodeToolsOptions/ForwardProcInsertPolicy/Value',
ForwardProcInsertPolicyNames[FForwardProcInsertPolicy],
ForwardProcInsertPolicyNames[fpipInFrontOfMethods]);
XMLConfig.SetDeleteValue(
'CodeToolsOptions/KeepForwardProcOrder/Value',FKeepForwardProcOrder,true);
XMLConfig.SetDeleteValue('CodeToolsOptions/MethodInsertPolicy/Value',
MethodInsertPolicyNames[FMethodInsertPolicy],
MethodInsertPolicyNames[mipClassOrder]);
XMLConfig.SetDeleteValue('CodeToolsOptions/KeyWordPolicy/Value',
WordPolicyNames[FKeyWordPolicy],
WordPolicyNames[wpLowerCase]);
XMLConfig.SetDeleteValue('CodeToolsOptions/IdentifierPolicy/Value',
WordPolicyNames[FIdentifierPolicy],
WordPolicyNames[wpNone]);
WriteAtomTypesToXML(XMLConfig,'CodeToolsOptions/DoNotSplitLineInFront/',
FDoNotSplitLineInFront);
FDoNotSplitLineInFront,DefaultDoNotSplitLineInFront);
WriteAtomTypesToXML(XMLConfig,'CodeToolsOptions/DoNotSplitLineAfter/',
FDoNotSplitLineAfter);
FDoNotSplitLineAfter,DefaultDoNotSplitLineAfter);
WriteAtomTypesToXML(XMLConfig,'CodeToolsOptions/DoInsertSpaceInFront/',
FDoInsertSpaceInFront);
FDoInsertSpaceInFront,DefaultDoInsertSpaceInFront);
WriteAtomTypesToXML(XMLConfig,'CodeToolsOptions/DoInsertSpaceAfter/',
FDoInsertSpaceAfter);
XMLConfig.SetValue('CodeToolsOptions/PropertyReadIdentPrefix/Value',
FPropertyReadIdentPrefix);
XMLConfig.SetValue('CodeToolsOptions/PropertyWriteIdentPrefix/Value',
FPropertyWriteIdentPrefix);
XMLConfig.SetValue('CodeToolsOptions/PropertyStoredIdentPostfix/Value',
FPropertyStoredIdentPostfix);
XMLConfig.SetValue('CodeToolsOptions/PrivatVariablePrefix/Value',
FPrivatVariablePrefix);
XMLConfig.SetValue('CodeToolsOptions/SetPropertyVariablename/Value',
FSetPropertyVariablename);
FDoInsertSpaceAfter,DefaultDoInsertSpaceAfter);
XMLConfig.SetDeleteValue('CodeToolsOptions/PropertyReadIdentPrefix/Value',
FPropertyReadIdentPrefix,'Get');
XMLConfig.SetDeleteValue('CodeToolsOptions/PropertyWriteIdentPrefix/Value',
FPropertyWriteIdentPrefix,'Set');
XMLConfig.SetDeleteValue('CodeToolsOptions/PropertyStoredIdentPostfix/Value',
FPropertyStoredIdentPostfix,'IsStored');
XMLConfig.SetDeleteValue('CodeToolsOptions/PrivatVariablePrefix/Value',
FPrivatVariablePrefix,'F');
XMLConfig.SetDeleteValue('CodeToolsOptions/SetPropertyVariablename/Value',
FSetPropertyVariablename,'AValue');
XMLConfig.Flush;
XMLConfig.Free;
except
writeln('ERROR: error while writing codetools options "',FFilename,'"');
on E: Exception do begin
writeln('[TCodeToolsOptions.Load] error writing "',FFilename,'": ',E.Message);
end;
end;
end;
@ -512,6 +552,13 @@ begin
FAddInheritedCodeToOverrideMethod:=CodeToolsOpts.AddInheritedCodeToOverrideMethod;
FCompleteProperties:=CodeToolsOpts.CompleteProperties;
// define templates
ClearGlobalDefineTemplates;
FGlobalDefineTemplates:=
CodeToolsOpts.FGlobalDefineTemplates.CreateCopy(false,true,true);
if FGlobalDefineTemplates<>nil then
FGlobalDefineTemplates.SetDefineOwner(Self,true);
// CodeCreation
FLineLength:=CodeToolsOpts.FLineLength;
FClassPartInsertPolicy:=CodeToolsOpts.FClassPartInsertPolicy;
@ -543,6 +590,9 @@ begin
FAdjustTopLineDueToComment:=true;
FJumpCentered:=true;
FCursorBeyondEOL:=true;
// define templates
ClearGlobalDefineTemplates;
// CodeCreation
FAddInheritedCodeToOverrideMethod:=true;
@ -566,6 +616,15 @@ begin
FSetPropertyVariablename:='AValue';
end;
procedure TCodeToolsOptions.ClearGlobalDefineTemplates;
begin
if FGlobalDefineTemplates<>nil then begin
FGlobalDefineTemplates.Clear(true);
FGlobalDefineTemplates.Free;
FGlobalDefineTemplates:=nil;
end;
end;
function TCodeToolsOptions.IsEqual(CodeToolsOpts: TCodeToolsOptions): boolean;
begin
Result:=
@ -576,6 +635,10 @@ begin
and (FCursorBeyondEOL=CodeToolsOpts.FCursorBeyondEOL)
and (AddInheritedCodeToOverrideMethod=CodeToolsOpts.AddInheritedCodeToOverrideMethod)
and (CompleteProperties=CodeToolsOpts.CompleteProperties)
// define templates
and (FGlobalDefineTemplates.IsEqual(
CodeToolsOpts.FGlobalDefineTemplates,true,true))
// CodeCreation
and (FLineLength=CodeToolsOpts.FLineLength)
@ -605,6 +668,17 @@ begin
Result.Filename:=Filename;
end;
procedure TCodeToolsOptions.ReadGlobalDefinesTemplatesFromTree(Tree: TDefineTree
);
begin
ClearGlobalDefineTemplates;
FGlobalDefineTemplates:=
Tree.ExtractTemplatesOwnedBy(Self,[],[dtfAutoGenerated]);
if FGlobalDefineTemplates<>nil then begin
FGlobalDefineTemplates.SetDefineOwner(Self,true);
end;
end;
procedure TCodeToolsOptions.AssignTo(Boss: TCodeToolManager);
begin
// General - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -614,7 +688,7 @@ begin
Boss.CursorBeyondEOL:=CursorBeyondEOL;
Boss.AddInheritedCodeToOverrideMethod:=AddInheritedCodeToOverrideMethod;
Boss.CompleteProperties:=CompleteProperties;
// CreateCode - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
with Boss.SourceChangeCache do begin
BeautifyCodeOptions.LineLength:=LineLength;
@ -637,6 +711,17 @@ begin
Boss.SetPropertyVariablename:=SetPropertyVariablename;
end;
procedure TCodeToolsOptions.AssignGlobalDefineTemplatesToTree(Tree: TDefineTree
);
begin
// Define templates - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
// remove old custom define templates
Tree.RemoveTemplatesOwnedBy(Self,[],[dtfAutoGenerated]);
// merge current custom define templates
if FGlobalDefineTemplates<>nil then
Tree.MergeDefineTemplates(FGlobalDefineTemplates,'');
end;
{ TCodeToolsOptsDlg }
constructor TCodeToolsOptsDlg.Create(AnOwner: TComponent);

130
ide/compileroptions.pp
View File

@ -253,8 +253,7 @@ type
function MakeOptionsString(Flags: TCompilerCmdLineOptions): String;
function MakeOptionsString(const MainSourceFileName: string;
Flags: TCompilerCmdLineOptions): String; virtual;
function CustomOptionsAsString: string;
Flags: TCompilerCmdLineOptions): String; virtual;
function ConvertSearchPathToCmdLine(const switch, paths: String): String;
function ConvertOptionsToCmdLine(const Delim, Switch, OptionStr: string): string;
function GetXMLConfigPath: String; virtual;
@ -270,6 +269,11 @@ type
function GetUnitPath(RelativeToBaseDir: boolean): string;
function GetIncludePath(RelativeToBaseDir: boolean): string;
function GetSrcPath(RelativeToBaseDir: boolean): string;
function GetLibraryPath(RelativeToBaseDir: boolean): string;
function GetParsedPath(Option: TParsedCompilerOptString;
InheritedOption: TInheritedCompilerOption;
RelativeToBaseDir: boolean): string;
function GetCustomOptions: string;
public
{ Properties }
property Owner: TObject read fOwner write fOwner;
@ -1203,52 +1207,68 @@ begin
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);
Result:=GetParsedPath(pcosUnitPath,icoUnitPath,RelativeToBaseDir);
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);
Result:=GetParsedPath(pcosIncludePath,icoIncludePath,RelativeToBaseDir);
end;
function TBaseCompilerOptions.GetSrcPath(RelativeToBaseDir: boolean): string;
var
CurSrcPath: String;
InhSrcPath: String;
begin
// src path
CurSrcPath:=ParsedOpts.GetParsedValue(pcosSrcPath);
Result:=GetParsedPath(pcosSrcPath,icoSrcPath,RelativeToBaseDir);
end;
function TBaseCompilerOptions.GetLibraryPath(RelativeToBaseDir: boolean
): string;
begin
Result:=GetParsedPath(pcosLibraryPath,icoLibraryPath,RelativeToBaseDir);
end;
function TBaseCompilerOptions.GetParsedPath(Option: TParsedCompilerOptString;
InheritedOption: TInheritedCompilerOption;
RelativeToBaseDir: boolean): string;
var
CurrentPath: String;
InheritedPath: String;
begin
// current path
CurrentPath:=ParsedOpts.GetParsedValue(Option);
if (not RelativeToBaseDir) then
CreateAbsolutePath(CurSrcPath,BaseDirectory);
CreateAbsolutePath(CurrentPath,BaseDirectory);
// inherited src path
InhSrcPath:=GetInheritedOption(icoSrcPath,RelativeToBaseDir);
// inherited path
InheritedPath:=GetInheritedOption(InheritedOption,RelativeToBaseDir);
Result:=MergeSearchPaths(CurSrcPath,InhSrcPath);
Result:=MergeSearchPaths(CurrentPath,InheritedPath);
end;
function TBaseCompilerOptions.GetCustomOptions: string;
var
CurCustomOptions: String;
InhCustomOptions: String;
i: Integer;
begin
// custom options
CurCustomOptions:=ParsedOpts.GetParsedValue(pcosCustomOptions);
// inherited custom options
InhCustomOptions:=GetInheritedOption(icoCustomOptions,true);
// concatenate
if CurCustomOptions<>'' then
Result:=CurCustomOptions+' '+InhCustomOptions
else
Result:=InhCustomOptions;
if Result='' then exit;
// eliminate line breaks
for i:=1 to length(Result) do
if Result[i]<' ' then Result[i]:=' ';
if Result='' then exit;
if (Result[1]=' ') or (Result[length(Result)]=' ') then
Result:=Trim(Result);
end;
{------------------------------------------------------------------------------
@ -1269,18 +1289,16 @@ function TBaseCompilerOptions.MakeOptionsString(
var
switches, tempsw: String;
InhLinkerOpts: String;
InhLibraryPath: String;
InhCustomOptions: String;
NewTargetFilename: String;
CurIncludePath: String;
CurLibraryPath: String;
CurUnitPath: String;
CurOutputDir: String;
CurCustomOptions: String;
CurLinkerOptions: String;
InhObjectPath: String;
CurObjectPath: String;
CurMainSrcFile: String;
CurCustomOptions: String;
begin
if MainSourceFileName='' then
CurMainSrcFile:=GetDefaultMainSourceFileName
@ -1706,17 +1724,10 @@ Processor specific options:
// library path
if (not (ccloNoLinkerOpts in Flags)) then begin
CurLibraryPath:=ParsedOpts.GetParsedValue(pcosLibraryPath);
CurLibraryPath:=GetLibraryPath(true);
if (CurLibraryPath <> '') then
switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fl', CurLibraryPath);
end;
// inherited library path
if (not (ccloNoLinkerOpts in Flags)) then begin
InhLibraryPath:=GetInheritedOption(icoLibraryPath,true);
if (InhLibraryPath <> '') then
switches := switches + ' ' + ConvertSearchPathToCmdLine('-Fl', InhLibraryPath);
end;
// object path
CurObjectPath:=ParsedOpts.GetParsedValue(pcosObjectPath);
@ -1802,35 +1813,18 @@ Processor specific options:
end;
// custom options
CurCustomOptions:=ParsedOpts.GetParsedValue(pcosCustomOptions);
CurCustomOptions:=GetCustomOptions;
if CurCustomOptions<>'' then
Switches:=Switches+' '+CurCustomOptions;
// inherited custom options
InhCustomOptions:=GetInheritedOption(icoCustomOptions,true);
if InhCustomOptions<>'' then
Switches:=Switches+' '+InhCustomOptions;
switches := switches+' '+CurCustomOptions;
fOptionsString := switches;
Result := fOptionsString;
end;
function TBaseCompilerOptions.CustomOptionsAsString: string;
var
i: Integer;
begin
Result:=CustomOptions;
if Result='' then exit;
for i:=1 to length(Result) do
if Result[i]<' ' then Result[i]:=' ';
if Result='' then exit;
Result:=Trim(Result);
end;
{------------------------------------------------------------------------------}
{ TBaseCompilerOptions ConvertSearchPathToCmdLine }
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------
TBaseCompilerOptions ConvertSearchPathToCmdLine
------------------------------------------------------------------------------}
function TBaseCompilerOptions.ConvertSearchPathToCmdLine(
const switch, paths: String): String;
var

299
ide/editdefinetree.pas
View File

@ -38,29 +38,51 @@ uses
Classes, SysUtils, FileProcs, FileCtrl, IDEProcs, CodeToolManager,
DefineTemplates, CompilerOptions, TransferMacros, LinkScanner;
procedure CreateProjectDefineTemplate(CompOpts: TCompilerOptions);
function CustomCompilerOptsToDefTempl(const Options: string): TDefineTemplate;
// global
procedure SetAdditionalGlobalSrcPathToCodeToolBoss(const SrcPath: string);
function FindCurrentProjectDirTemplate: TDefineTemplate;
// current project
function FindCurrentProjectTemplate: TDefineTemplate;
function CreateProjectTemplate(var ProjectDirTemplate: TDefineTemplate
): TDefineTemplate;
// packages
function FindPackagesTemplate: TDefineTemplate;
function FindPackageTemplateWithID(const PkgID: string): TDefineTemplate;
function CreatePackagesTemplate: TDefineTemplate;
function CreatePackageTemplateWithID(const PkgID: string): TDefineTemplate;
// miscellaneous
function UpdateCompilerOptionsTemplates(ParentTemplate: TDefineTemplate;
CompOpts: TCompilerOptions; RecursiveDefines, ClearCache: boolean): boolean;
function ReplaceAutoGeneratedDefine(ParentTemplate: TDefineTemplate;
const Name, Description, Variable, Value: string;
RecursiveDefine: boolean): boolean;
function RemoveAutoGeneratedDefine(ParentTemplate: TDefineTemplate;
const Name: string): boolean;
const
ProjectDirDefTemplName = 'Current Project Directory';
PackagesDefTemplName = 'Packages';
ProjectDefTemplName = 'Current Project';
ProjectDirDefTemplName = 'Current Project Directory';
ProjectDirSrcPathDefTemplName = 'Project SrcPath';
ProjectDirUnitPathDefTemplName = 'Project UnitPath';
ProjectDirIncPathDefTemplName = 'Project IncPath';
PackagesDefTemplName = 'Packages';
PkgOutputDirDefTemplName = 'Output Directory';
FPCModeDefTemplName = 'MODE';
IOChecksOnDefTemplName = 'IOCHECKS on';
RangeChecksOnDefTemplName = 'RANGECHECKS on';
OverflowChecksOnDefTemplName = 'OVERFLOWCHECKS on';
UseLineInfoUnitDefTemplName = 'use LINEINFO unit';
UseHeapTrcUnitDefTemplName = 'use HEAPTRC unit';
FPCCmdLineDefTemplName = 'Custom Options';
implementation
function FindCurrentProjectDirTemplate: TDefineTemplate;
begin
Result:=CodeToolBoss.DefineTree.FindDefineTemplateByName(
ProjectDirDefTemplName,true);
end;
function FindPackagesTemplate: TDefineTemplate;
begin
Result:=CodeToolBoss.DefineTree.FindDefineTemplateByName(
@ -78,6 +100,60 @@ begin
Result:=PkgTempl.FindChildByName(PkgID);
end;
function FindCurrentProjectTemplate: TDefineTemplate;
begin
Result:=CodeToolBoss.DefineTree.FindDefineTemplateByName(
ProjectDefTemplName,true);
end;
function CreateProjectTemplate(var ProjectDirTemplate: TDefineTemplate
): TDefineTemplate;
var
ProjectDir, ProjectSrcPath, ProjectIncPath,
ProjectUnitPath: TDefineTemplate;
begin
Result:=FindCurrentProjectTemplate;
if Result<>nil then begin
ProjectDirTemplate:=Result.FindChildByName(ProjectDirDefTemplName);
exit;
end;
// create the main template for the project
Result:=TDefineTemplate.Create(ProjectDefTemplName,'Current Project','','',
da_Block);
// create the template for the project directory
ProjectDir:=TDefineTemplate.Create(ProjectDirDefTemplName,
'Current Project Directory','','$(#ProjectDir)',da_Directory);
Result.AddChild(ProjectDir);
ProjectDirTemplate:=ProjectDir;
// create the template for the SrcPath
ProjectSrcPath:=TDefineTemplate.Create(ProjectDirSrcPathDefTemplName,
'Project SrcPath',ExternalMacroStart+'SrcPath',
'$Project(SrcPath);$('+ExternalMacroStart+'SrcPath)',
da_DefineRecurse);
ProjectDir.AddChild(ProjectSrcPath);
// create the template for the IncPath
ProjectIncPath:=TDefineTemplate.Create(ProjectDirIncPathDefTemplName,
'Project IncPath',ExternalMacroStart+'IncPath',
'$Project(IncPath);$('+ExternalMacroStart+'IncPath)',
da_DefineRecurse);
ProjectDir.AddChild(ProjectIncPath);
// create the template for the UnitPath
ProjectUnitPath:=TDefineTemplate.Create(ProjectDirUnitPathDefTemplName,
'Project UnitPath',ExternalMacroStart+'UnitPath',
'$Project(UnitPath);$('+ExternalMacroStart+'UnitPath)',
da_DefineRecurse);
ProjectDir.AddChild(ProjectUnitPath);
Result.SetFlags([dtfAutoGenerated],[],false);
// insert behind all
CodeToolBoss.DefineTree.ReplaceRootSameName(Result);
end;
function CreatePackagesTemplate: TDefineTemplate;
begin
Result:=FindPackagesTemplate;
@ -138,125 +214,160 @@ begin
end;
end;
procedure CreateProjectDefineTemplate(CompOpts: TCompilerOptions);
var ProjectDir: string;
ProjTempl: TDefineTemplate;
UnitPath: String;
IncPath: String;
SrcPath: String;
function UpdateCompilerOptionsTemplates(ParentTemplate: TDefineTemplate;
CompOpts: TCompilerOptions; RecursiveDefines, ClearCache: boolean): boolean;
// returns true on change, false on no change
var
CustomOpts: TDefineTemplate;
begin
Result:=false;
{ ToDo:
StackChecks
DontUseConfigFile
AdditionalConfigFile
}
// define macros for project directory
ProjectDir:='$('+ExternalMacroStart+'ProjectDir)';
// create define node for current project directory -------------------------
ProjTempl:=TDefineTemplate.Create(ProjectDirDefTemplName,
'Current Project Directory','',ProjectDir,da_Directory);
ProjTempl.Flags:=[dtfAutoGenerated,dtfProjectSpecific];
// FPC modes ----------------------------------------------------------------
if CompOpts.DelphiCompat then begin
// set mode DELPHI
ProjTempl.AddChild(TDefineTemplate.Create('MODE',
'set FPC mode to DELPHI',CompilerModeVars[cmDELPHI],'1',da_DefineRecurse));
Result:=Result or
ReplaceAutoGeneratedDefine(ParentTemplate,FPCModeDefTemplName,
'set FPC mode to DELPHI',CompilerModeVars[cmDELPHI],'1',
RecursiveDefines);
end else if CompOpts.TPCompatible then begin
// set mode TP
ProjTempl.AddChild(TDefineTemplate.Create('MODE',
'set FPC mode to TP',CompilerModeVars[cmTP],'1',da_DefineRecurse));
Result:=Result or
ReplaceAutoGeneratedDefine(ParentTemplate,FPCModeDefTemplName,
'set FPC mode to TP',CompilerModeVars[cmTP],'1',RecursiveDefines);
end else if CompOpts.GPCCompat then begin
// set mode GPC
ProjTempl.AddChild(TDefineTemplate.Create('MODE',
'set FPC mode to GPC',CompilerModeVars[cmGPC],'1',da_DefineRecurse));
Result:=Result or
ReplaceAutoGeneratedDefine(ParentTemplate,FPCModeDefTemplName,
'set FPC mode to GPC',CompilerModeVars[cmGPC],'1',RecursiveDefines);
end else begin
// set no mode
Result:=Result or
RemoveAutoGeneratedDefine(ParentTemplate,FPCModeDefTemplName);
end;
// Checks -------------------------------------------------------------------
// IO Checks
if CompOpts.IOChecks then begin
// set IO checking on
ProjTempl.AddChild(TDefineTemplate.Create('IOCHECKS on',
'set IOCHECKS on','IOCHECKS','1',da_DefineRecurse));
Result:=Result or
ReplaceAutoGeneratedDefine(ParentTemplate,IOChecksOnDefTemplName,
'set IOCHECKS on','IOCHECKS','1',RecursiveDefines);
end else begin
Result:=Result or
RemoveAutoGeneratedDefine(ParentTemplate,IOChecksOnDefTemplName);
end;
// Range checking
if CompOpts.RangeChecks then begin
// set Range checking on
ProjTempl.AddChild(TDefineTemplate.Create('RANGECHECKS on',
'set RANGECHECKS on','RANGECHECKS','1',da_DefineRecurse));
Result:=Result or
ReplaceAutoGeneratedDefine(ParentTemplate,RangeChecksOnDefTemplName,
'set RANGECHECKS on','RANGECHECKS','1',RecursiveDefines);
end else begin
Result:=Result or
RemoveAutoGeneratedDefine(ParentTemplate,RangeChecksOnDefTemplName);
end;
// Overflow checking
if CompOpts.OverflowChecks then begin
// set Overflow checking on
ProjTempl.AddChild(TDefineTemplate.Create('OVERFLOWCHECKS on',
'set OVERFLOWCHECKS on','OVERFLOWCHECKS','1',da_DefineRecurse));
Result:=Result or
ReplaceAutoGeneratedDefine(ParentTemplate,OverflowChecksOnDefTemplName,
'set OVERFLOWCHECKS on','OVERFLOWCHECKS','1',RecursiveDefines);
end else begin
Result:=Result or
RemoveAutoGeneratedDefine(ParentTemplate,OverflowChecksOnDefTemplName);
end;
// Hidden used units --------------------------------------------------------
// use lineinfo unit
if CompOpts.UseLineInfoUnit then begin
// use lineinfo unit
ProjTempl.AddChild(TDefineTemplate.Create('Use LINEINFO unit',
'use LineInfo unit',ExternalMacroStart+'UseLineInfo','1',da_DefineRecurse));
Result:=Result or
ReplaceAutoGeneratedDefine(ParentTemplate,UseLineInfoUnitDefTemplName,
'use LineInfo unit',ExternalMacroStart+'UseLineInfo','1',
RecursiveDefines);
end else begin
Result:=Result or
RemoveAutoGeneratedDefine(ParentTemplate,UseLineInfoUnitDefTemplName);
end;
// use heaptrc unit
if CompOpts.UseHeaptrc then begin
// use heaptrc unit
ProjTempl.AddChild(TDefineTemplate.Create('Use HEAPTRC unit',
'use HeapTrc unit',ExternalMacroStart+'UseHeapTrcUnit','1',da_DefineRecurse));
Result:=Result or
ReplaceAutoGeneratedDefine(ParentTemplate,UseHeapTrcUnitDefTemplName,
'use HeapTrc unit',ExternalMacroStart+'UseHeapTrcUnit','1',
RecursiveDefines);
end else begin
Result:=Result or
RemoveAutoGeneratedDefine(ParentTemplate,UseHeapTrcUnitDefTemplName);
end;
// Paths --------------------------------------------------------------------
// Include Path
IncPath:=ConvertTransferMacrosToExternalMacros(CompOpts.GetIncludePath(false));
if IncPath<>'' then begin
// add include paths
ProjTempl.AddChild(TDefineTemplate.Create('IncludePath',
'include path addition',ExternalMacroStart+'IncPath',
IncPath+';'
+'$('+ExternalMacroStart+'IncPath)',
da_DefineRecurse));
end;
// compiled unit path (ppu/ppw/dcu files)
UnitPath:=ConvertTransferMacrosToExternalMacros(CompOpts.GetUnitPath(false));
if UnitPath<>'' then begin
// add compiled unit path
ProjTempl.AddChild(TDefineTemplate.Create('UnitPath',
'unit path addition',ExternalMacroStart+'UnitPath',
UnitPath+';'
+'$('+ExternalMacroStart+'UnitPath)',
da_DefineRecurse));
end;
// source path (unitpath + sources for the CodeTools, hidden to the compiler)
SrcPath:=ConvertTransferMacrosToExternalMacros(CompOpts.GetSrcPath(false));
if (SrcPath<>'') or (UnitPath<>'') then begin
// add compiled unit path
ProjTempl.AddChild(TDefineTemplate.Create('SrcPath',
'source path addition',ExternalMacroStart+'SrcPath',
MergeSearchPaths(UnitPath,SrcPath)+';'
+'$('+ExternalMacroStart+'SrcPath)',
da_DefineRecurse));
end;
// LCL Widget Type ----------------------------------------------------------
if CodeToolBoss.GlobalValues[ExternalMacroStart+'LCLWidgetType']<>
CompOpts.LCLWidgetType then
begin
CodeToolBoss.GlobalValues[ExternalMacroStart+'LCLWidgetType']:=
CompOpts.LCLWidgetType;
CodeToolBoss.DefineTree.ClearCache;
// custom options -----------------------------------------------------------
CustomOpts:=CodeToolBoss.DefinePool.CreateFPCCommandLineDefines(
FPCCmdLineDefTemplName,CompOpts.GetCustomOptions,RecursiveDefines,nil);
if CustomOpts<>nil then begin
ParentTemplate.ReplaceChild(CustomOpts);
end else begin
ParentTemplate.DeleteChild(FPCCmdLineDefTemplName);
end;
// --------------------------------------------------------------------------
// replace project defines in DefineTree
CodeToolBoss.DefineTree.ReplaceRootSameName(ProjTempl);
// clear cache
if ClearCache and Result then CodeToolBoss.DefineTree.ClearCache;
end;
function CustomCompilerOptsToDefTempl(const Options: string): TDefineTemplate;
function ReplaceAutoGeneratedDefine(ParentTemplate: TDefineTemplate;
const Name, Description, Variable, Value: string;
RecursiveDefine: boolean): boolean;
// returns true on change, false on no change
var
DefType: TDefineAction;
NewDefine: TDefineTemplate;
OldNode: TDefineTemplate;
begin
Result:=false; // no change
OldNode:=ParentTemplate.FindChildByName(Name);
if RecursiveDefine then
DefType:=da_DefineRecurse
else
DefType:=da_Define;
if OldNode=nil then begin
NewDefine:=TDefineTemplate.Create(Name,Description,Variable,Value,DefType);
ParentTemplate.AddChild(NewDefine);
NewDefine.Flags:=[dtfAutoGenerated];
Result:=true;
end else begin
if (OldNode.Name=Name)
and (OldNode.Description=Description)
and (OldNode.Variable=Variable)
and (OldNode.Value=Value)
and (OldNode.Action=DefType)
and (dtfAutoGenerated in OldNode.Flags)
then exit;
OldNode.Name:=Name;
OldNode.Description:=Description;
OldNode.Variable:=Variable;
OldNode.Value:=Value;
OldNode.Action:=DefType;
OldNode.Flags:=[dtfAutoGenerated];
Result:=true;
end;
end;
// ToDo
Result:=nil;
function RemoveAutoGeneratedDefine(ParentTemplate: TDefineTemplate;
const Name: string): boolean;
// returns true on change, false on no change
var
OldNode: TDefineTemplate;
begin
Result:=false; // no change
OldNode:=ParentTemplate.FindChildByName(Name);
if OldNode<>nil then begin
OldNode.Unbind;
OldNode.Free;
Result:=true;
end;
end;
procedure SetAdditionalGlobalSrcPathToCodeToolBoss(const SrcPath: string);

27
ide/keymapping.pp
View File

@ -166,10 +166,6 @@ const
ecBuildAll = ecUserFirst + 407;
ecBuildLazarus = ecUserFirst + 408;
// tools menu
ecExtToolFirst = ecUserFirst + 500;
ecExtToolLast = ecUserFirst + 599;
// project menu
ecNewProject = ecUserFirst + 700;
ecNewProjectFromFile = ecUserFirst + 701;
@ -184,6 +180,17 @@ const
ecViewProjectTodos = ecUserFirst + 710;
ecProjectOptions = ecUserFirst + 711;
// components menu
ecOpenPackage = ecUserFirst + 900;
ecOpenPackageFile = ecUserFirst + 901;
ecAddCurUnitToPkg = ecUserFirst + 902;
ecPackageGraph = ecUserFirst + 903;
ecConfigCustomComps = ecUserFirst + 904;
// tools menu
ecExtToolFirst = ecUserFirst + 500;
ecExtToolLast = ecUserFirst + 599;
// option commmands
ecRunParameters = ecUserFirst + 800;
ecCompilerOptions = ecUserFirst + 801;
@ -194,12 +201,6 @@ const
ecCodeToolsOptions = ecUserFirst + 806;
ecCodeToolsDefinesEd = ecUserFirst + 807;
// components menu
ecConfigCustomComps = ecUserFirst + 900;
ecOpenPackage = ecUserFirst + 901;
ecOpenPackageFile = ecUserFirst + 902;
ecPackageGraph = ecUserFirst + 903;
// help menu
ecAboutLazarus = ecUserFirst + 1000;
@ -630,10 +631,11 @@ begin
ecCompilerOptions : Result:= srkmecCompilerOptions;
// components menu
ecConfigCustomComps : Result:= lisMenuConfigCustomComps;
ecOpenPackage : Result:= lisMenuOpenPackage;
ecOpenPackageFile : Result:= lisMenuOpenPackageFile;
ecAddCurUnitToPkg : Result:= lisMenuAddCurUnitToPkg;
ecPackageGraph : Result:= lisMenuPackageGraph;
ecConfigCustomComps : Result:= lisMenuConfigCustomComps;
// tools menu
ecExtToolSettings : Result:= srkmecExtToolSettings;
@ -1469,10 +1471,11 @@ begin
// components menu
C:=Categories[AddCategory('Components',srkmCatComponentsMenu,caAll)];
Add(C,'Configure custom components',ecConfigCustomComps,VK_UNKNOWN,[],VK_UNKNOWN,[]);
Add(C,'Open package',ecOpenPackage,VK_UNKNOWN,[],VK_UNKNOWN,[]);
Add(C,'Open package file',ecOpenPackageFile,VK_UNKNOWN,[],VK_UNKNOWN,[]);
Add(C,'Add active unit to a package',ecAddCurUnitToPkg,VK_UNKNOWN,[],VK_UNKNOWN,[]);
Add(C,'Package graph',ecPackageGraph,VK_UNKNOWN,[],VK_UNKNOWN,[]);
Add(C,'Configure custom components',ecConfigCustomComps,VK_UNKNOWN,[],VK_UNKNOWN,[]);
// tools menu
C:=Categories[AddCategory(KeyCategoryToolMenuName,srkmCatToolMenu,caAll)];

11
ide/lazarusidestrconsts.pas
View File

@ -209,11 +209,12 @@ resourcestring
lisMenuCompilerOptions = 'Compiler Options...';
lisMenuRunParameters = 'Run Parameters ...';
lisMenuConfigCustomComps = 'Configure custom components';
lisMenuOpenPackage = 'Open package';
lisMenuOpenRecentPkg = 'Open recent package';
lisMenuOpenPackageFile = 'Open package file';
lisMenuAddCurUnitToPkg = 'Add active unit to a package';
lisMenuPackageGraph = 'Package Graph';
lisMenuConfigCustomComps = 'Configure custom components';
lisMenuSettings = 'Configure custom tools ...';
lisMenuQuickSyntaxCheck = 'Quick syntax check';
@ -1230,6 +1231,14 @@ resourcestring
dlgTodoListGotoLine='Goto selected source line';
dlgTodoListPrintList='Print todo items';
dlgToDoListOptions='ToDo options...';
// packages
lisPkgFileTypeUnit = 'Unit';
lisPkgFileTypeLFM = 'LFM - Lazarus form text';
lisPkgFileTypeLRS = 'LRS - Lazarus resource';
lisPkgFileTypeInclude = 'Include file';
lisPkgFileTypeText = 'Text';
lisPkgFileTypeBinary = 'Binary';
implementation
end.

18
ide/mainbar.pas
View File

@ -289,11 +289,12 @@ type
itmProjectRunParameters: TMenuItem;
// components menu
itmCompsConfigCustomComps: TMenuItem;
itmPkgOpenPackage: TMenuItem;
itmPkgOpenPackageFile: TMenuItem;
itmPkgOpenRecent: TMenuItem;
itmPkgAddCurUnitToPkg: TMenuItem;
itmPkgPkgGraph: TMenuItem;
itmCompsConfigCustomComps: TMenuItem;
// tools menu
itmToolConfigure: TMenuItem;
@ -1128,6 +1129,18 @@ begin
mnuComponents.Add(CreateMenuSeparator);
{$ENDIF}
itmPkgAddCurUnitToPkg := TMenuItem.Create(Self);
itmPkgAddCurUnitToPkg.Name:='itmPkgAddCurUnitToPkg';
itmPkgAddCurUnitToPkg.Caption := lisMenuAddCurUnitToPkg;
itmPkgAddCurUnitToPkg.Graphic:=LoadPixmap('pkg_addunittopackage');
{$IFDEF EnablePkgs}
mnuComponents.Add(itmPkgAddCurUnitToPkg);
{$ENDIF}
{$IFDEF EnablePkgs}
mnuComponents.Add(CreateMenuSeparator);
{$ENDIF}
itmPkgPkgGraph := TMenuItem.Create(Self);
itmPkgPkgGraph.Name:='itmPkgPkgGraph';
itmPkgPkgGraph.Caption := lisMenuPackageGraph;
@ -1347,10 +1360,11 @@ begin
itmProjectRunParameters.ShortCut:=CommandToShortCut(ecRunParameters);
// components menu
itmCompsConfigCustomComps.ShortCut:=CommandToShortCut(ecConfigCustomComps);
itmPkgOpenPackage.ShortCut:=CommandToShortCut(ecOpenPackage);
itmPkgOpenPackageFile.ShortCut:=CommandToShortCut(ecOpenPackageFile);
itmPkgAddCurUnitToPkg.ShortCut:=CommandToShortCut(ecAddCurUnitToPkg);
itmPkgPkgGraph.ShortCut:=CommandToShortCut(ecPackageGraph);
itmCompsConfigCustomComps.ShortCut:=CommandToShortCut(ecConfigCustomComps);
// tools menu
itmToolConfigure.ShortCut:=CommandToShortCut(ecExtToolSettings);

19
ide/miscoptions.pas
View File

@ -147,19 +147,26 @@ begin
XMLConfig.Free;
end;
except
writeln('ERROR: unable read miscellaneous options from "',GetFilename,'"');
on E: Exception do begin
writeln('ERROR: unable read miscellaneous options from "',GetFilename,'": ',E.Message);
end;
end;
end;
procedure TMiscellaneousOptions.Save;
var XMLConfig: TXMLConfig;
Path: String;
XMLFilename: String;
begin
XMLFilename:=GetFilename;
try
XMLConfig:=TXMLConfig.Create(GetFilename);
ClearFile(XMLFilename,true);
XMLConfig:=TXMLConfig.Create(XMLFilename);
except
writeln('ERROR: unable to open miscellaneous options "',GetFilename,'"');
exit;
on E: Exception do begin
writeln('ERROR: unable to open miscellaneous options "',XMLFilename,'":',E.Message);
exit;
end;
end;
try
try
@ -178,7 +185,9 @@ begin
XMLConfig.Free;
end;
except
writeln('ERROR: unable read miscellaneous options from "',GetFilename,'"');
on E: Exception do begin
writeln('ERROR: unable read miscellaneous options from "',XMLFilename,'": ',E.Message);
end;
end;
end;

137
ide/project.pp
View File

@ -216,11 +216,44 @@ type
end;
{ TProjectDefineTemplates }
TProjectDefineTemplatesFlag = (
ptfFlagsChanged
);
TProjectDefineTemplatesFlags = set of TProjectDefineTemplatesFlag;
TProjectDefineTemplates = class
private
FFlags: TProjectDefineTemplatesFlags;
FMain: TDefineTemplate;
FProjectDir: TDefineTemplate;
FProject: TProject;
FUpdateLock: integer;
procedure UpdateMain;
public
constructor Create(OwnerProject: TProject);
destructor Destroy; override;
procedure Clear;
procedure BeginUpdate;
procedure EndUpdate;
procedure CompilerFlagsChanged;
procedure AllChanged;
public
property Owner: TProject read FProject;
property Main: TDefineTemplate read FMain;
end;
{ TProject }
TProjectType = // for a description see ProjectTypeDescriptions below
(ptApplication, ptProgram, ptCustomProgram);
TProjectFlag = (pfSaveClosedUnits, pfSaveOnlyProjectUnits);
(ptApplication, ptProgram, ptCustomProgram);
TProjectFlag = (
pfSaveClosedUnits, // save info about closed files (not part of project)
pfSaveOnlyProjectUnits // save no info about foreign files
);
TProjectFlags = set of TProjectFlag;
TProjectFileSearchFlag = (
@ -239,6 +272,7 @@ type
fBookmarks: TProjectBookmarkList;
fChanged: boolean;
fCompilerOptions: TProjectCompilerOptions;
FDefineTemplates: TProjectDefineTemplates;
fFirstAutoRevertLockedUnit: TUnitInfo; // units with IsAutoRevertLocked=true
fFirstLoadedUnit: TUnitInfo; // units with Loaded=true
fFirstPartOfProject: TUnitInfo; // units with IsPartOfProject=true
@ -251,7 +285,7 @@ type
fJumpHistory: TProjectJumpHistory;
fLastReadLPIFileDate: TDateTime;
fLastReadLPIFilename: string;
fMainUnitID: Integer; // only for ptApplication
fMainUnitID: Integer; // only for ptApplication, ptProgram
fModified: boolean;
FOnBeginUpdate: TNotifyEvent;
FOnEndUpdate: TEndUpdateProjectEvent;
@ -263,7 +297,7 @@ type
fRunParameterOptions: TRunParamsOptions;
fTargetFileExt: String;
fTitle: String;
fUnitList: TList; // list of _all_ units (TUnitInfo)
fUnitList: TList; // list of _all_ units (TUnitInfo)
FUpdateLock: integer;
xmlconfig: TXMLConfig;
function GetMainFilename: String;
@ -394,6 +428,7 @@ type
property Bookmarks: TProjectBookmarkList read fBookmarks write fBookmarks;
property CompilerOptions: TProjectCompilerOptions
read fCompilerOptions write fCompilerOptions;
property DefineTemplates: TProjectDefineTemplates read FDefineTemplates;
property FirstAutoRevertLockedUnit: TUnitInfo read fFirstAutoRevertLockedUnit;
property FirstLoadedUnit: TUnitInfo read fFirstLoadedUnit;
property FirstPartOfProject: TUnitInfo read fFirstPartOfProject;
@ -1095,6 +1130,7 @@ begin
FAutoCreateForms := true;
fBookmarks := TProjectBookmarkList.Create;
fCompilerOptions := TProjectCompilerOptions.Create(Self);
FDefineTemplates:=TProjectDefineTemplates.Create(Self);
FFlags:=DefaultProjectFlags;
fIconPath := '';
fJumpHistory:=TProjectJumpHistory.Create;
@ -1164,13 +1200,14 @@ end;
destructor TProject.Destroy;
begin
Clear;
fBookmarks.Free;
if (xmlconfig <> nil) then xmlconfig.Free;
fUnitList.Free;
fJumpHistory.Free;
fPublishOptions.Free;
fRunParameterOptions.Free;
fCompilerOptions.Free;
FreeThenNil(fBookmarks);
FreeThenNil(xmlconfig);
FreeThenNil(fUnitList);
FreeThenNil(fJumpHistory);
FreeThenNil(fPublishOptions);
FreeThenNil(fRunParameterOptions);
FreeThenNil(fCompilerOptions);
FreeThenNil(FDefineTemplates);
inherited Destroy;
end;
@ -1516,8 +1553,7 @@ var i:integer;
begin
BeginUpdate(true);
if xmlconfig<>nil then xmlconfig.Free;
xmlconfig:=nil;
FreeThenNil(xmlconfig);
// break and free removed dependencies
while FFirstRemovedDependency<>nil do
@ -1535,6 +1571,7 @@ begin
fActiveEditorIndexAtStart := -1;
fBookmarks.Clear;
fCompilerOptions.Clear;
FDefineTemplates.Clear;
fIconPath := '';
fJumpHistory.Clear;
fMainUnitID := -1;
@ -1550,6 +1587,7 @@ end;
procedure TProject.BeginUpdate(Change: boolean);
begin
inc(FUpdateLock);
FDefineTemplates.BeginUpdate;
if FUpdateLock=1 then begin
fChanged:=Change;
if Assigned(OnBeginUpdate) then OnBeginUpdate(Self);
@ -1561,6 +1599,7 @@ procedure TProject.EndUpdate;
begin
if FUpdateLock<=0 then RaiseException('TProject.EndUpdate');
dec(FUpdateLock);
FDefineTemplates.EndUpdate;
if FUpdateLock=0 then begin
if Assigned(OnEndUpdate) then OnEndUpdate(Self,fChanged);
end;
@ -2540,12 +2579,84 @@ begin
PkgList.Free;
end;
{ TProjectDefineTemplates }
constructor TProjectDefineTemplates.Create(OwnerProject: TProject);
begin
inherited Create;
FProject:=OwnerProject;
end;
destructor TProjectDefineTemplates.Destroy;
begin
Clear;
inherited Destroy;
end;
procedure TProjectDefineTemplates.Clear;
begin
if FMain<>nil then begin
CodeToolBoss.DefineTree.RemoveDefineTemplate(FMain);
FMain:=nil;
FProjectDir:=nil;
FFlags:=FFlags+[ptfFlagsChanged];
end;
end;
procedure TProjectDefineTemplates.BeginUpdate;
begin
inc(FUpdateLock);
end;
procedure TProjectDefineTemplates.EndUpdate;
begin
if FUpdateLock=0 then RaiseException('TProjectDefineTemplates.EndUpdate');
dec(FUpdateLock);
if FUpdateLock=0 then begin
if ptfFlagsChanged in FFlags then CompilerFlagsChanged;
end;
end;
procedure TProjectDefineTemplates.UpdateMain;
begin
// update the package block define template (the container for all other
// define templates of the package)
if FMain=nil then begin
// create the main project template
FMain:=CreateProjectTemplate(FProjectDir);
FMain.SetDefineOwner(Owner,false);
FMain.SetFlags([dtfAutoGenerated],[],false);
end;
// ClearCache is here unnessary, because it is only a block
end;
procedure TProjectDefineTemplates.CompilerFlagsChanged;
begin
if FUpdateLock>0 then begin
Include(FFlags,ptfFlagsChanged);
exit;
end;
Exclude(FFlags,ptfFlagsChanged);
if FMain=nil then UpdateMain;
UpdateCompilerOptionsTemplates(FProjectDir,Owner.CompilerOptions,true,true);
end;
procedure TProjectDefineTemplates.AllChanged;
begin
CompilerFlagsChanged;
CodeToolBoss.DefineTree.ClearCache;
end;
end.
{
$Log$
Revision 1.114 2003/04/24 16:44:28 mattias
implemented define templates for projects with packages
Revision 1.113 2003/04/21 16:21:28 mattias
implemented default package for custom IDE components

4
ide/transfermacros.pp
View File

@ -56,7 +56,9 @@ type
TMacroFunction = function(const s:string; var Abort: boolean):string of object;
TTransferMacroFlag = (tmfInteractive);
TTransferMacroFlag = (
tmfInteractive
);
TTransferMacroFlags = set of TTransferMacroFlag;
TTransferMacro = class

124
images/pkg_binary.xpm
View File

@ -1,34 +1,96 @@
/* XPM */
static char * pkg_binary_xpm[] = {
"16 16 15 1",
"18 18 75 1",
" c None",
". c #000000",
"+ c #FFFFFF",
"@ c #E7ADA5",
"# c #E79C8C",
"$ c #080000",
"% c #DE8C84",
"& c #E7A594",
"* c #EFC1BD",
"= c #D6634A",
"- c #F7DED6",
"; c #CE5242",
"> c #D66B52",
", c #EFB5AD",
"' c #F7E7E7",
" ",
" ",
" ....... ",
" .+++++.. ",
" .+++++.+. ",
" .+++@#$... ",
" .++%&*=++. ",
" .++-++;++. ",
" .++++>,++. ",
" .+++'&+++. ",
" .+++'*+++. ",
" .+++''+++. ",
" .++++++++. ",
" .......... ",
" ",
" "};
". c #585858",
"+ c #DEDEDE",
"@ c #BCB7B1",
"# c #999999",
"$ c #FFFFFF",
"% c #EAEAEA",
"& c #6D6D6D",
"* c #6F6F6F",
"= c #FCFCFC",
"- c #707070",
"; c #CECECE",
"> c #303030",
", c #898989",
"' c #6B6B6B",
") c #424242",
"! c #F6F5F5",
"~ c #E2E0DE",
"{ c #8F8984",
"] c #FBF9F6",
"^ c #F4F0EC",
"/ c #E7E0D9",
"( c #BEB6AF",
"_ c #DFDFDF",
": c #FEFEFE",
"< c #FBF8F5",
"[ c #F8F4ED",
"} c #F3EDE3",
"| c #EEE7DC",
"1 c #BCAE97",
"2 c #FEFEFD",
"3 c #FAF8F4",
"4 c #F8F4EC",
"5 c #F5EFE5",
"6 c #F3EBDC",
"7 c #ECE2D4",
"8 c #FDFDFC",
"9 c #F8F3EB",
"0 c #F5EEE4",
"a c #F3EADC",
"b c #ECDFCA",
"c c #BCAB90",
"d c #FCFCFB",
"e c #F3EADB",
"f c #ECDBC2",
"g c #BCA88A",
"h c #FAF6F2",
"i c #F5EEE2",
"j c #F0E4D2",
"k c #EEE0C9",
"l c #E9D6BA",
"m c #BCA685",
"n c #F7F1E9",
"o c #F4EDE2",
"p c #F0E4D1",
"q c #EEDFC8",
"r c #BCA37F",
"s c #F4EDE1",
"t c #F2E8D8",
"u c #F0E4D0",
"v c #EEDEC8",
"w c #ECDABF",
"x c #E9D6B8",
"y c #E7D1B0",
"z c #E5CCA7",
"A c #BCA178",
"B c #C6C1B6",
"C c #C4BDAC",
"D c #C3B8A3",
"E c #C2B39A",
"F c #C0AF91",
"G c #BFAA88",
"H c #BEA57F",
"I c #BDA076",
"J c #BC9E73",
" ......... ",
" .+++++@.#. ",
" .+$$$$%&$#. ",
" .+$$*$=-;$#> ",
" .+$**$$,-')> ",
" .+$$*$$!~@{> ",
" .+$***$]^/(> ",
" ._$$$:<[}|1> ",
" .+$$2345671> ",
" .+$8*90a*bc> ",
" .+d*9*e**fg> ",
" .+h*i*jk*lm> ",
" .+no*pq***r> ",
" .+stuvwxyzA> ",
" .BBCDEFGHIJ> ",
" .>>>>>>>>>>> ",
" ",
" "};

379
images/pkg_text.xpm
View File

@ -1,276 +1,107 @@
/* XPM */
static char * pkg_text_xpm[] = {
"16 16 257 2",
" c None",
". c #000000",
"+ c #800000",
"@ c #008000",
"# c #808000",
"$ c #000080",
"% c #800080",
"& c #008080",
"* c #C0C0C0",
"= c #C0DCC0",
"- c #A6CAF0",
"; c #402000",
"> c #602000",
", c #802000",
"' c #A02000",
") c #C02000",
"! c #E02000",
"~ c #004000",
"{ c #204000",
"] c #404000",
"^ c #604000",
"/ c #804000",
"( c #A04000",
"_ c #C04000",
": c #E04000",
"< c #006000",
"[ c #206000",
"} c #406000",
"| c #606000",
"1 c #806000",
"2 c #A06000",
"3 c #C06000",
"4 c #E06000",
"5 c #008000",
"6 c #208000",
"7 c #408000",
"8 c #608000",
"9 c #808000",
"0 c #A08000",
"a c #C08000",
"b c #E08000",
"c c #00A000",
"d c #20A000",
"e c #40A000",
"f c #60A000",
"g c #80A000",
"h c #A0A000",
"i c #C0A000",
"j c #E0A000",
"k c #00C000",
"l c #20C000",
"m c #40C000",
"n c #60C000",
"o c #80C000",
"p c #A0C000",
"q c #C0C000",
"r c #E0C000",
"s c #00E000",
"t c #20E000",
"u c #40E000",
"v c #60E000",
"w c #80E000",
"x c #A0E000",
"y c #C0E000",
"z c #E0E000",
"A c #000040",
"B c #200040",
"C c #400040",
"D c #600040",
"E c #800040",
"F c #A00040",
"G c #C00040",
"H c #E00040",
"I c #002040",
"J c #202040",
"K c #402040",
"L c #602040",
"M c #802040",
"N c #A02040",
"O c #C02040",
"P c #E02040",
"Q c #004040",
"R c #204040",
"S c #404040",
"T c #604040",
"U c #804040",
"V c #A04040",
"W c #C04040",
"X c #E04040",
"Y c #006040",
"Z c #206040",
"` c #406040",
" . c #606040",
".. c #806040",
"+. c #A06040",
"@. c #C06040",
"#. c #E06040",
"$. c #008040",
"%. c #208040",
"&. c #408040",
"*. c #608040",
"=. c #808040",
"-. c #A08040",
";. c #C08040",
">. c #E08040",
",. c #00A040",
"'. c #20A040",
"). c #40A040",
"!. c #60A040",
"~. c #80A040",
"{. c #A0A040",
"]. c #C0A040",
"^. c #E0A040",
"/. c #00C040",
"(. c #20C040",
"_. c #40C040",
":. c #60C040",
"<. c #80C040",
"[. c #A0C040",
"}. c #C0C040",
"|. c #E0C040",
"1. c #00E040",
"2. c #20E040",
"3. c #40E040",
"4. c #60E040",
"5. c #80E040",
"6. c #A0E040",
"7. c #C0E040",
"8. c #E0E040",
"9. c #000080",
"0. c #200080",
"a. c #400080",
"b. c #600080",
"c. c #800080",
"d. c #A00080",
"e. c #C00080",
"f. c #E00080",
"g. c #002080",
"h. c #202080",
"i. c #402080",
"j. c #602080",
"k. c #802080",
"l. c #A02080",
"m. c #C02080",
"n. c #E02080",
"o. c #004080",
"p. c #204080",
"q. c #404080",
"r. c #604080",
"s. c #804080",
"t. c #A04080",
"u. c #C04080",
"v. c #E04080",
"w. c #006080",
"x. c #206080",
"y. c #406080",
"z. c #606080",
"A. c #806080",
"B. c #A06080",
"C. c #C06080",
"D. c #E06080",
"E. c #008080",
"F. c #208080",
"G. c #408080",
"H. c #608080",
"I. c #808080",
"J. c #A08080",
"K. c #C08080",
"L. c #E08080",
"M. c #00A080",
"N. c #20A080",
"O. c #40A080",
"P. c #60A080",
"Q. c #80A080",
"R. c #A0A080",
"S. c #C0A080",
"T. c #E0A080",
"U. c #00C080",
"V. c #20C080",
"W. c #40C080",
"X. c #60C080",
"Y. c #80C080",
"Z. c #A0C080",
"`. c #C0C080",
" + c #E0C080",
".+ c #00E080",
"++ c #20E080",
"@+ c #40E080",
"#+ c #60E080",
"$+ c #80E080",
"%+ c #A0E080",
"&+ c #C0E080",
"*+ c #E0E080",
"=+ c #0000C0",
"-+ c #2000C0",
";+ c #4000C0",
">+ c #6000C0",
",+ c #8000C0",
"'+ c #A000C0",
")+ c #C000C0",
"!+ c #E000C0",
"~+ c #0020C0",
"{+ c #2020C0",
"]+ c #4020C0",
"^+ c #6020C0",
"/+ c #8020C0",
"(+ c #A020C0",
"_+ c #C020C0",
":+ c #E020C0",
"<+ c #0040C0",
"[+ c #2040C0",
"}+ c #4040C0",
"|+ c #6040C0",
"1+ c #8040C0",
"2+ c #A040C0",
"3+ c #C040C0",
"4+ c #E040C0",
"5+ c #0060C0",
"6+ c #2060C0",
"7+ c #4060C0",
"8+ c #6060C0",
"9+ c #8060C0",
"0+ c #A060C0",
"a+ c #C060C0",
"b+ c #E060C0",
"c+ c #0080C0",
"d+ c #2080C0",
"e+ c #4080C0",
"f+ c #6080C0",
"g+ c #8080C0",
"h+ c #A080C0",
"i+ c #C080C0",
"j+ c #E080C0",
"k+ c #00A0C0",
"l+ c #20A0C0",
"m+ c #40A0C0",
"n+ c #60A0C0",
"o+ c #80A0C0",
"p+ c #A0A0C0",
"q+ c #C0A0C0",
"r+ c #E0A0C0",
"s+ c #00C0C0",
"t+ c #20C0C0",
"u+ c #40C0C0",
"v+ c #60C0C0",
"w+ c #80C0C0",
"x+ c #A0C0C0",
"y+ c #FFFBF0",
"z+ c #A0A0A4",
"A+ c #808080",
"B+ c #FF0000",
"C+ c #00FF00",
"D+ c #FFFF00",
"E+ c #0000FF",
"F+ c #FF00FF",
"G+ c #00FFFF",
"H+ c #FFFFFF",
" ",
" ",
" . . . . . . . ",
" . H+H+H+H+H+. . ",
" . H+H+H+H+H+. H+. ",
" . H+H+H+H+H+. . . . ",
" . H+H+H+H+H+H+H+H+. ",
" . H+H+H+H+H+H+H+H+. ",
" . H+H+H+H+H+H+H+H+. ",
" . H+H+H+H+H+H+H+H+. ",
" . H+H+H+H+H+H+H+H+. ",
" . H+H+H+H+H+H+H+H+. ",
" . H+H+H+H+H+H+H+H+. ",
" . . . . . . . . . . ",
" ",
" "};
"18 18 86 1",
" c None",
". c #585858",
"+ c #DEDEDE",
"@ c #BCB7B1",
"# c #999999",
"$ c #FFFFFF",
"% c #EAEAEA",
"& c #6D6D6D",
"* c #FCFCFC",
"= c #707070",
"- c #CECECE",
"; c #303030",
"> c #9B9B9B",
", c #898989",
"' c #6B6B6B",
") c #424242",
"! c #F6F5F5",
"~ c #E2E0DE",
"{ c #8F8984",
"] c #FBF9F6",
"^ c #F4F0EC",
"/ c #E7E0D9",
"( c #BEB6AF",
"_ c #DFDFDF",
": c #FEFEFE",
"< c #FBF8F5",
"[ c #F8F4ED",
"} c #F3EDE3",
"| c #EEE7DC",
"1 c #BCAE97",
"2 c #9A9A9A",
"3 c #989794",
"4 c #97948F",
"5 c #95918B",
"6 c #948F86",
"7 c #ECE2D4",
"8 c #FDFDFC",
"9 c #FAF8F4",
"0 c #F8F3EB",
"a c #F5EEE4",
"b c #F3EADC",
"c c #F1E6D4",
"d c #ECDFCA",
"e c #BCAB90",
"f c #FCFCFB",
"g c #95918A",
"h c #948E85",
"i c #928B80",
"j c #91887B",
"k c #ECDBC2",
"l c #BCA88A",
"m c #FAF6F2",
"n c #F8F2EA",
"o c #F5EEE2",
"p c #F2E9DA",
"q c #F0E4D2",
"r c #EEE0C9",
"s c #ECDCC1",
"t c #E9D6BA",
"u c #BCA685",
"v c #F7F1E9",
"w c #949089",
"x c #938D84",
"y c #928B7F",
"z c #91887A",
"A c #8F8575",
"B c #8E8270",
"C c #E7D1B0",
"D c #BCA37F",
"E c #F4EDE1",
"F c #F2E8D8",
"G c #F0E4D0",
"H c #EEDEC8",
"I c #ECDABF",
"J c #E9D6B8",
"K c #E5CCA7",
"L c #BCA178",
"M c #C6C1B6",
"N c #C4BDAC",
"O c #C3B8A3",
"P c #C2B39A",
"Q c #C0AF91",
"R c #BFAA88",
"S c #BEA57F",
"T c #BDA076",
"U c #BC9E73",
" ......... ",
" .+++++@.#. ",
" .+$$$$%&$#. ",
" .+$$$$*=-$#; ",
" .+$>>>$,='); ",
" .+$$$$$!~@{; ",
" .+$>>>>]^/(; ",
" ._$$$:<[}|1; ",
" .+$>2345671; ",
" .+$890abcde; ",
" .+f34ghijkl; ",
" .+mnopqrstu; ",
" .+vwxyzABCD; ",
" .+EFGHIJCKL; ",
" .MMNOPQRSTU; ",
" .;;;;;;;;;;; ",
" ",
" "};

202
packager/addtopackagedlg.pas
View File

@ -47,7 +47,8 @@ type
TAddToPkgType = (
d2ptUnit,
d2ptNewComponent,
d2ptRequiredPkg
d2ptRequiredPkg,
d2ptFile
);
TAddToPkgResult = record
@ -70,6 +71,7 @@ type
// notebook
NoteBook: TNoteBook;
AddUnitPage: TPage;
AddFilePage: TPage;
NewComponentPage: TPage;
NewDependPage: TPage;
// add unit page
@ -106,6 +108,16 @@ type
DependMaxVersionEdit: TEdit;
NewDependButton: TButton;
CancelDependButton: TButton;
// add file page
AddFilenameLabel: TLabel;
AddFilenameEdit: TEdit;
AddFileBrowseButton: TButton;
AddFileTypeRadioGroup: TRadioGroup;
AddFileButton: TButton;
CancelAddFileButton: TButton;
procedure AddFileBrowseButtonClick(Sender: TObject);
procedure AddFileButtonClick(Sender: TObject);
procedure AddFilePageResize(Sender: TObject);
procedure AddToPackageDlgClose(Sender: TObject; var Action: TCloseAction);
procedure AddUnitButtonClick(Sender: TObject);
procedure AddUnitFileBrowseButtonClick(Sender: TObject);
@ -113,6 +125,7 @@ type
procedure AddUnitUpdateButtonClick(Sender: TObject);
procedure AncestorComboBoxCloseUp(Sender: TObject);
procedure AncestorShowAllCheckBoxClick(Sender: TObject);
procedure CancelAddFileButtonClick(Sender: TObject);
procedure CancelAddUnitButtonClick(Sender: TObject);
procedure CancelNewComponentButtonClick(Sender: TObject);
procedure ClassNameEditChange(Sender: TObject);
@ -136,6 +149,7 @@ type
procedure AutoCompleteNewComponent;
procedure AutoCompleteNewComponentUnitName;
procedure UpdateAddUnitInfo;
procedure UpdateAddFileInfo;
public
Params: TAddToPkgResult;
constructor Create(TheOwner: TComponent); override;
@ -378,6 +392,99 @@ begin
IDEDialogLayoutList.SaveLayout(Self);
end;
procedure TAddToPackageDlg.AddFilePageResize(Sender: TObject);
var
x: Integer;
y: Integer;
begin
x:=5;
y:=5;
with AddFilenameLabel do
SetBounds(x,y+2,100,Height);
inc(x,AddFilenameLabel.Width+5);
with AddFilenameEdit do
SetBounds(x,y,Parent.ClientWidth-x-30,Height);
inc(x,AddFilenameEdit.Width+2);
with AddFileBrowseButton do
SetBounds(x,y,AddFilenameEdit.Height,AddFilenameEdit.Height);
x:=5;
y:=AddFilenameEdit.Top+AddFilenameEdit.Height+5;
with AddFileTypeRadioGroup do begin
SetBounds(x,y,Parent.ClientWidth-2*x,140);
inc(y,Height+20);
end;
with AddFileButton do
SetBounds(x,y,80,Height);
inc(x,AddFileButton.Width+10);
with CancelAddFileButton do
SetBounds(x,y,80,Height);
end;
procedure TAddToPackageDlg.AddFileBrowseButtonClick(Sender: TObject);
var
OpenDialog: TOpenDialog;
AFilename: string;
begin
OpenDialog:=TOpenDialog.Create(Application);
try
InputHistories.ApplyFileDialogSettings(OpenDialog);
OpenDialog.Title:=lisOpenFile;
OpenDialog.Options:=OpenDialog.Options+[ofFileMustExist,ofPathMustExist];
if OpenDialog.Execute then begin
AFilename:=CleanAndExpandFilename(OpenDialog.Filename);
if FileExists(AFilename) then begin
LazPackage.ShortenFilename(AFilename);
AddFilenameEdit.Text:=AFilename;
UpdateAddFileInfo;
end;
end;
InputHistories.StoreFileDialogSettings(OpenDialog);
finally
OpenDialog.Free;
end;
end;
procedure TAddToPackageDlg.AddFileButtonClick(Sender: TObject);
var
i: Integer;
CurPFT: TPkgFileType;
begin
Params.AddType:=d2ptUnit;
Params.UnitFilename:=AddFilenameEdit.Text;
Params.FileType:=pftText;
Params.UnitName:='';
Params.PkgFileFlags:=[];
if not FileExists(Params.UnitFilename) then begin
MessageDlg('File not found',
'File "'+Params.UnitFilename+'" not found.',
mtError,[mbCancel],0);
exit;
end;
if LazPackage.FindPkgFile(Params.UnitFilename,true,true)<>nil then begin
MessageDlg('File already in package',
'The file "'+Params.UnitFilename+'" is already in the package.',
mtError,[mbCancel],0);
exit;
end;
i:=0;
for CurPFT:=Low(TPkgFileType) to High(TPkgFileType) do begin
if CurPFT=pftUnit then continue;
if i=AddFileTypeRadioGroup.ItemIndex then begin
Params.FileType:=CurPFT;
end;
inc(i);
end;
ModalResult:=mrOk;
end;
procedure TAddToPackageDlg.AddUnitFileBrowseButtonClick(Sender: TObject);
var
OpenDialog: TOpenDialog;
@ -463,6 +570,11 @@ begin
UpdateAvailableAncestorTypes;
end;
procedure TAddToPackageDlg.CancelAddFileButtonClick(Sender: TObject);
begin
ModalResult:=mrCancel;
end;
procedure TAddToPackageDlg.CancelAddUnitButtonClick(Sender: TObject);
begin
ModalResult:=mrCancel;
@ -781,6 +893,8 @@ begin
end;
procedure TAddToPackageDlg.SetupComponents;
var
pft: TPkgFileType;
begin
NoteBook:=TNoteBook.Create(Self);
with NoteBook do begin
@ -792,6 +906,8 @@ begin
NewComponentPage:=Page[1];
Pages.Add('New Requirement');
NewDependPage:=Page[2];
Pages.Add('Add File');
AddFilePage:=Page[3];
PageIndex:=0;
Align:=alClient;
end;
@ -801,6 +917,7 @@ begin
AddUnitPage.OnResize:=@AddUnitPageResize;
NewComponentPage.OnResize:=@NewComponentPageResize;
NewDependPage.OnResize:=@NewDependPageResize;
AddFilePage.OnResize:=@AddFilePageResize;
AddUnitFilenameLabel:=TLabel.Create(Self);
with AddUnitFilenameLabel do begin
@ -1037,6 +1154,62 @@ begin
Caption:='Cancel';
ModalResult:=mrCancel;
end;
// add file
AddFilenameLabel:=TLabel.Create(Self);
with AddFilenameLabel do begin
Name:='AddFilenameLabel';
Parent:=AddFilePage;
Caption:='File name:';
end;
AddFilenameEdit:=TEdit.Create(Self);
with AddFilenameEdit do begin
Name:='AddFilenameEdit';
Parent:=AddFilePage;
Text:='<choose an existing file>';
end;
AddFileBrowseButton:=TButton.Create(Self);
with AddFileBrowseButton do begin
Name:='AddFileBrowseButton';
Parent:=AddFilePage;
Caption:='...';
OnClick:=@AddFileBrowseButtonClick;
end;
AddFileTypeRadioGroup:=TRadioGroup.Create(Self);
with AddFileTypeRadioGroup do begin
Name:='AddFileTypeRadioGroup';
Parent:=AddFilePage;
Caption:='File Type';
with Items do begin
BeginUpdate;
for pft:=Low(TPkgFileType) to High(TPkgFileType) do begin
if pft=pftUnit then continue;
Add(GetPkgFileTypeLocalizedName(pft));
end;
EndUpdate;
end;
OnClick:=@AddUnitUpdateButtonClick;
end;
AddFileButton:=TButton.Create(Self);
with AddFileButton do begin
Name:='AddFileButton';
Parent:=AddFilePage;
Caption:='Ok';
OnClick:=@AddFileButtonClick;
end;
CancelAddFileButton:=TButton.Create(Self);
with CancelAddFileButton do begin
Name:='CancelAddFileButton';
Parent:=AddFilePage;
Caption:='Cancel';
OnClick:=@CancelAddFileButtonClick;
end;
end;
procedure TAddToPackageDlg.OnIterateComponentClasses(PkgComponent: TPkgComponent
@ -1119,6 +1292,33 @@ begin
end;
end;
procedure TAddToPackageDlg.UpdateAddFileInfo;
var
CurFilename: String;
NewPFT: TPkgFileType;
CurPFT: TPkgFileType;
i: Integer;
begin
CurFilename:=AddFilenameEdit.Text;
if CompareFileExt(CurFilename,'.lfm',true)=0 then
NewPFT:=pftLFM
else if CompareFileExt(CurFilename,'.lrs',true)=0 then
NewPFT:=pftLRS
else if CompareFileExt(CurFilename,'.inc',true)=0 then
NewPFT:=pftInclude
else if FileIsText(CurFilename) then
NewPFT:=pftText
else
NewPFT:=pftBinary;
i:=0;
for CurPFT:=Low(TPkgFileType) to High(TPkgFileType) do begin
if CurPFT=pftUnit then continue;
if CurPFT=NewPFT then break;
inc(i);
end;
AddFileTypeRadioGroup.ItemIndex:=i;
end;
constructor TAddToPackageDlg.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);

1
packager/basepkgmanager.pas
View File

@ -72,6 +72,7 @@ type
procedure ConnectSourceNotebookEvents; virtual; abstract;
procedure SetupMainBarShortCuts; virtual; abstract;
procedure SetRecentPackagesMenu; virtual; abstract;
procedure SaveSettings; virtual; abstract;
function GetDefaultSaveDirectoryForFile(const Filename: string): string; virtual; abstract;

95
packager/packagedefs.pas
View File

@ -47,7 +47,8 @@ interface
uses
Classes, SysUtils, LCLProc, LResources, Graphics, Laz_XMLCfg, AVL_Tree,
DefineTemplates, CodeToolManager, EditDefineTree, CompilerOptions, Forms,
FileCtrl, IDEProcs, ComponentReg, TransferMacros, FileReferenceList;
FileCtrl, LazarusIDEStrConsts, IDEProcs, ComponentReg, TransferMacros,
FileReferenceList;
type
TLazPackage = class;
@ -111,9 +112,12 @@ type
{ TPkgFile }
TPkgFileType = (
pftUnit, // file is pascal unit
pftText, // file is text (e.g. copyright or install notes)
pftBinary // file is something else
pftUnit, // file is pascal unit
pftLFM, // lazarus form text file
pftLRS, // lazarus resource file
pftInclude, // include file
pftText, // file is text (e.g. copyright or install notes)
pftBinary // file is something else
);
TPkgFileTypes = set of TPkgFileType;
@ -420,7 +424,6 @@ type
FDefineTemplates: TLazPackageDefineTemplates;
FDescription: string;
FDirectory: string;
FEditorRect: TRect;
FFilename: string;
FFiles: TList; // TList of TPkgFile
FFirstRemovedDependency: TPkgDependency;
@ -430,8 +433,10 @@ type
FHoldPackageCount: integer;
FIconFile: string;
FInstalled: TPackageInstallType;
FLastCompilerFileDate: integer;
FLastCompilerFilename: string;
FLastCompilerParams: string;
FLicense: string;
FMacros: TTransferMacroList;
FModifiedLock: integer;
FPackageEditor: TBasePackageEditor;
@ -458,11 +463,11 @@ type
procedure SetAutoInstall(const AValue: TPackageInstallType);
procedure SetAutoUpdate(const AValue: boolean);
procedure SetDescription(const AValue: string);
procedure SetEditorRect(const AValue: TRect);
procedure SetFilename(const AValue: string);
procedure SetFlags(const AValue: TLazPackageFlags);
procedure SetIconFile(const AValue: string);
procedure SetInstalled(const AValue: TPackageInstallType);
procedure SetLicense(const AValue: string);
procedure SetRegistered(const AValue: boolean);
procedure SetModified(const AValue: boolean);
procedure SetName(const AValue: string); override;
@ -493,7 +498,6 @@ type
procedure LongenFilename(var AFilename: string);
function GetResolvedFilename: string;
procedure ConsistencyCheck;
procedure UpdateEditorRect;
procedure GetInheritedCompilerOptions(var OptionsList: TList);
function GetCompileSourceFilename: string;
function GetOutputDirectory: string;
@ -557,7 +561,6 @@ type
property Directory: string read FDirectory; // the path of the .lpk file
property Editor: TBasePackageEditor read FPackageEditor
write SetPackageEditor;
property EditorRect: TRect read FEditorRect write SetEditorRect;
property FileCount: integer read GetFileCount;
property Filename: string read FFilename write SetFilename;//the .lpk filename
property Files[Index: integer]: TPkgFile read GetFiles;
@ -572,8 +575,11 @@ type
property Installed: TPackageInstallType read FInstalled write SetInstalled;
property LastCompilerFilename: string read FLastCompilerFilename
write FLastCompilerFilename;
property LastCompilerFileDate: integer read FLastCompilerFileDate
write FLastCompilerFileDate;
property LastCompilerParams: string read FLastCompilerParams
write FLastCompilerParams;
property License: string read FLicense write SetLicense;
property Macros: TTransferMacroList read FMacros;
property Modified: boolean read GetModified write SetModified;
property PackageType: TLazPackageType read FPackageType
@ -603,9 +609,9 @@ const
LazPkgXMLFileVersion = 1;
PkgFileTypeNames: array[TPkgFileType] of string = (
'pftUnit', 'pftText', 'pftBinary');
'pftUnit', 'pftLFM', 'pftLRS', 'pftInclude', 'pftText', 'pftBinary');
PkgFileTypeIdents: array[TPkgFileType] of string = (
'Unit', 'Text', 'Binary');
'Unit', 'LFM', 'LRS', 'Include', 'Text', 'Binary');
PkgFileFlag: array[TPkgFileFlag] of string = (
'pffHasRegisterProc');
PkgDependencyFlagNames: array[TPkgDependencyFlag] of string = (
@ -636,6 +642,7 @@ function GetUsageOptionsList(PackageList: TList): TList;
function PkgFileTypeIdentToType(const s: string): TPkgFileType;
function LazPackageTypeIdentToType(const s: string): TLazPackageType;
function GetPkgFileTypeLocalizedName(FileType: TPkgFileType): string;
procedure SortDependencyList(Dependencies: TList);
procedure LoadPkgDependencyList(XMLConfig: TXMLConfig; const ThePath: string;
@ -675,6 +682,20 @@ begin
Result:=lptRunTime;
end;
function GetPkgFileTypeLocalizedName(FileType: TPkgFileType): string;
begin
case FileType of
pftUnit: Result:=lisPkgFileTypeUnit;
pftLFM: Result:=lisPkgFileTypeLFM;
pftLRS: Result:=lisPkgFileTypeLRS;
pftInclude: Result:=lisPkgFileTypeInclude;
pftText: Result:=lisPkgFileTypeText;
pftBinary: Result:=lisPkgFileTypeBinary;
else
Result:='Unknown';
end;
end;
procedure LoadPkgDependencyList(XMLConfig: TXMLConfig; const ThePath: string;
var First: TPkgDependency; ListType: TPkgDependencyList; Owner: TObject;
HoldPackages: boolean);
@ -1587,11 +1608,6 @@ begin
Modified:=true;
end;
procedure TLazPackage.SetEditorRect(const AValue: TRect);
begin
FEditorRect:=AValue;
end;
procedure TLazPackage.SetFilename(const AValue: string);
var
NewFilename: String;
@ -1633,6 +1649,13 @@ begin
FInstalled:=AValue;
end;
procedure TLazPackage.SetLicense(const AValue: string);
begin
if FLicense=AValue then exit;
FLicense:=AValue;
Modified:=true;
end;
procedure TLazPackage.SetRegistered(const AValue: boolean);
begin
if FRegistered=AValue then exit;
@ -1850,7 +1873,8 @@ begin
Name:=XMLConfig.GetValue(Path+'Name/Value','');
FAuthor:=XMLConfig.GetValue(Path+'Author/Value','');
FCompilerOptions.LoadFromXMLConfig(XMLConfig,Path+'CompilerOptions/');
FDescription:=XMLConfig.GetValue(Path+'Description','');
FDescription:=XMLConfig.GetValue(Path+'Description/Value','');
FLicense:=XMLConfig.GetValue(Path+'License/Value','');
FVersion.LoadFromXMLConfig(XMLConfig,Path+'Version/',FileVersion);
LoadFiles(Path+'Files/',FFiles);
LoadFlags(Path);
@ -1861,7 +1885,6 @@ begin
LoadPkgDependencyList(XMLConfig,Path+'RequiredPkgs/',
FFirstRequiredDependency,pdlRequires,Self,false);
FUsageOptions.LoadFromXMLConfig(XMLConfig,Path+'UsageOptions/');
LoadRect(XMLConfig,Path+'EditorRect/',fEditorRect);
EndUpdate;
Modified:=false;
UnlockModified;
@ -1891,11 +1914,11 @@ procedure TLazPackage.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string
end;
begin
UpdateEditorRect;
XMLConfig.SetDeleteValue(Path+'Name/Value',FName,'');
XMLConfig.SetDeleteValue(Path+'Author/Value',FAuthor,'');
FCompilerOptions.SaveToXMLConfig(XMLConfig,Path+'CompilerOptions/');
XMLConfig.SetDeleteValue(Path+'Description',FDescription,'');
XMLConfig.SetDeleteValue(Path+'Description/Value',FDescription,'');
XMLConfig.SetDeleteValue(Path+'License/Value',FLicense,'');
FVersion.SaveToXMLConfig(XMLConfig,Path+'Version/');
SaveFiles(Path+'Files/',FFiles);
SaveFlags(Path);
@ -1906,7 +1929,6 @@ begin
SavePkgDependencyList(XMLConfig,Path+'RequiredPkgs/',
FFirstRequiredDependency,pdlRequires);
FUsageOptions.SaveToXMLConfig(XMLConfig,Path+'UsageOptions/');
SaveRect(XMLConfig,Path+'EditorRect/',fEditorRect);
Modified:=false;
end;
@ -2227,13 +2249,6 @@ begin
Name:=NewName;
end;
procedure TLazPackage.UpdateEditorRect;
begin
if Editor=nil then exit;
EditorRect:=Rect(Editor.Left,Editor.Top,
Editor.Left+Editor.Width,Editor.Top+Editor.Height);
end;
procedure TLazPackage.GetAllRequiredPackages(var List: TList);
begin
if Assigned(OnGetAllRequiredPackages) then
@ -2630,12 +2645,12 @@ end;
procedure TLazPackageDefineTemplates.Clear;
begin
if FMain<>nil then begin
fLastSourceDirectories.Clear;
CodeToolBoss.DefineTree.RemoveDefineTemplate(FMain);
FMain:=nil;
FOutputDir:=nil;
FOutPutSrcPath:=nil;
fLastOutputDirSrcPathIDAsString:='';
fLastSourceDirectories.Clear;
FFlags:=FFlags+[pdtIDChanged,pdtOutputDirChanged,pdtSourceDirsChanged];
end;
end;
@ -2704,8 +2719,10 @@ begin
// define templates of the package)
if FMain=nil then begin
FMain:=CreatePackageTemplateWithID(LazPackage.IDAsString);
end;
FMain.Name:=LazPackage.IDAsString;
FMain.SetDefineOwner(LazPackage,false);
FMain.SetFlags([dtfAutoGenerated],[],false);
end else
FMain.Name:=LazPackage.IDAsString;
// ClearCache is here unnessary, because it is only a block
end;
@ -2717,19 +2734,23 @@ begin
if FOutputDir=nil then begin
FOutputDir:=TDefineTemplate.Create(PkgOutputDirDefTemplName,
'Output directory','',LazPackage.GetOutputDirectory,da_Directory);
FOutputDir.SetDefineOwner(LazPackage,false);
FOutputDir.SetFlags([dtfAutoGenerated],[],false);
FMain.AddChild(FOutputDir);
end;
if (FOutPutSrcPath=nil)
or (fLastOutputDirSrcPathIDAsString<>LazPackage.IDAsString) then begin
fLastOutputDirSrcPathIDAsString:=LazPackage.IDAsString;
FOutPutSrcPath:=TDefineTemplate.Create('CompiledSrcPath',
FOutputSrcPath:=TDefineTemplate.Create('CompiledSrcPath',
'CompiledSrcPath addition',CompiledSrcPathMacroName,
'$PkgSrcPath('+fLastOutputDirSrcPathIDAsString+');'
+'$('+CompiledSrcPathMacroName+')',
da_Define);
CodeToolBoss.DefineTree.ReplaceChild(FOutputDir,FOutPutSrcPath,
FOutPutSrcPath.Name);
FOutputSrcPath.SetDefineOwner(LazPackage,false);
FOutputSrcPath.SetFlags([dtfAutoGenerated],[],false);
CodeToolBoss.DefineTree.ReplaceChild(FOutputDir,FOutputSrcPath,
FOutputSrcPath.Name);
end;
end;
@ -2769,7 +2790,9 @@ begin
// clear old define templates
if fLastSourceDirectories<>nil then begin
for i:=0 to fLastSourceDirectories.Count-1 do begin
TDefineTemplate(fLastSourceDirectories.Objects[i]).Free;
SrcDirDefTempl:=TDefineTemplate(fLastSourceDirectories.Objects[i]);
SrcDirDefTempl.Unbind;
SrcDirDefTempl.Free;
end;
fLastSourceDirectories.Clear;
end else
@ -2793,11 +2816,13 @@ begin
'#IncPath','$(#IncPath);$PkgIncPath('+LazPackage.IDAsString+')',
da_Define);
SrcDirDefTempl.AddChild(IncPathDefTempl);
SrcDirDefTempl.SetDefineOwner(LazPackage,false);
SrcDirDefTempl.SetFlags([dtfAutoGenerated],[],false);
// add directory
FMain.AddChild(SrcDirDefTempl);
end;
CodeToolBoss.DefineTree.ClearCache;
finally
NewSourceDirs.Free;
end;

241
packager/packageeditor.pas
View File

@ -39,9 +39,9 @@ interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls, ComCtrls, Buttons,
LResources, Graphics, LCLType, Menus, Dialogs, IDEProcs, LazarusIDEStrConsts,
IDEOptionDefs, IDEDefs, CompilerOptions, ComponentReg, PackageDefs,
PkgOptionsDlg, AddToPackageDlg, PackageSystem;
LResources, Graphics, LCLType, Menus, Dialogs, Laz_XMLCfg, AVL_Tree, IDEProcs,
LazConf, LazarusIDEStrConsts, IDEOptionDefs, IDEDefs, CompilerOptions,
ComponentReg, PackageDefs, PkgOptionsDlg, AddToPackageDlg, PackageSystem;
type
TOnOpenFile =
@ -60,6 +60,19 @@ type
TOnFreePkgEditor = procedure(APackage: TLazPackage) of object;
{ TPackageEditorLayout }
TPackageEditorLayout = class
public
Filename: string;
Rectangle: TRect;
constructor Create;
destructor Destroy; override;
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
end;
{ TPackageEditorForm }
TPackageEditorForm = class(TBasePackageEditor)
@ -155,6 +168,7 @@ type
TPackageEditors = class
private
FItems: TList; // list of TPackageEditorForm
fLayouts: TAVLTree;// tree of TPackageEditorLayout sorted for filename
FOnCompilePackage: TOnCompilePackage;
FOnCreateNewFile: TOnCreateNewPkgFile;
FOnFreeEditor: TOnFreePkgEditor;
@ -164,11 +178,16 @@ type
FOnOpenPackage: TOnOpenPackage;
FOnSavePackage: TOnSavePackage;
function GetEditors(Index: integer): TPackageEditorForm;
procedure ApplyLayout(AnEditor: TPackageEditorForm);
procedure SaveLayout(AnEditor: TPackageEditorForm);
procedure LoadLayouts;
function GetLayoutConfigFilename: string;
public
constructor Create;
destructor Destroy; override;
function Count: integer;
procedure Clear;
procedure SaveLayouts;
procedure Remove(Editor: TPackageEditorForm);
function IndexOfPackage(Pkg: TLazPackage): integer;
function FindEditor(Pkg: TLazPackage): TPackageEditorForm;
@ -214,10 +233,32 @@ var
ImageIndexRemovedRequired: integer;
ImageIndexUnit: integer;
ImageIndexRegisterUnit: integer;
ImageIndexLFM: integer;
ImageIndexLRS: integer;
ImageIndexInclude: integer;
ImageIndexText: integer;
ImageIndexBinary: integer;
ImageIndexConflict: integer;
function CompareLayouts(Data1, Data2: Pointer): integer;
var
Layout1: TPackageEditorLayout;
Layout2: TPackageEditorLayout;
begin
Layout1:=TPackageEditorLayout(Data1);
Layout2:=TPackageEditorLayout(Data2);
Result:=CompareFilenames(Layout1.Filename,Layout2.Filename);
end;
function CompareFilenameWithLayout(Key, Data: Pointer): integer;
var
Filename: String;
Layout: TPackageEditorLayout;
begin
Filename:=String(Key);
Layout:=TPackageEditorLayout(Data);
Result:=CompareFilenames(Filename,Layout.Filename);
end;
{ TPackageEditorForm }
@ -460,7 +501,7 @@ procedure TPackageEditorForm.PackageEditorFormClose(Sender: TObject;
var Action: TCloseAction);
begin
if LazPackage=nil then exit;
PackageEditors.SaveLayout(Self);
end;
procedure TPackageEditorForm.PackageEditorFormCloseQuery(Sender: TObject;
@ -645,11 +686,13 @@ begin
PackageGraph.BeginUpdate(false);
case AddParams.AddType of
d2ptUnit:
begin
// add file
with AddParams do
LazPackage.AddFile(UnitFilename,UnitName,FileType,PkgFileFlags,cpNormal);
UpdateAll;
end;
d2ptNewComponent:
@ -663,6 +706,7 @@ begin
end;
// open file in editor
PackageEditors.CreateNewFile(Self,AddParams);
UpdateAll;
end;
d2ptRequiredPkg:
@ -670,7 +714,15 @@ begin
// add dependency
PackageGraph.AddDependencyToPackage(LazPackage,AddParams.Dependency);
end;
d2ptFile:
begin
// add file
with AddParams do
LazPackage.AddFile(UnitFilename,UnitName,FileType,PkgFileFlags,cpNormal);
UpdateAll;
end;
end;
LazPackage.Modified:=true;
PackageGraph.EndUpdate;
@ -779,20 +831,13 @@ begin
end;
procedure TPackageEditorForm.SetLazPackage(const AValue: TLazPackage);
var
ARect: TRect;
begin
if FLazPackage=AValue then exit;
if FLazPackage<>nil then FLazPackage.Editor:=nil;
FLazPackage:=AValue;
if FLazPackage=nil then exit;
FLazPackage.Editor:=Self;
// find a nice position for the editor
ARect:=FLazPackage.EditorRect;
if (ARect.Bottom<ARect.Top+50) or (ARect.Right<ARect.Left+50) then
ARect:=CreateNiceWindowPosition(500,400);
SetBounds(ARect.Left,ARect.Top,
ARect.Right-ARect.Left,ARect.Bottom-ARect.Top);
PackageEditors.ApplyLayout(Self);
// update components
UpdateAll;
// show files
@ -837,6 +882,12 @@ begin
AddResImg('pkg_unit');
ImageIndexRegisterUnit:=Count;
AddResImg('pkg_registerunit');
ImageIndexLFM:=Count;
AddResImg('pkg_lfm');
ImageIndexLRS:=Count;
AddResImg('pkg_lrs');
ImageIndexInclude:=Count;
AddResImg('pkg_include');
ImageIndexText:=Count;
AddResImg('pkg_text');
ImageIndexBinary:=Count;
@ -1074,6 +1125,9 @@ procedure TPackageEditorForm.UpdateFiles;
ANode.ImageIndex:=ImageIndexRegisterUnit
else
ANode.ImageIndex:=ImageIndexUnit;
pftLFM: ANode.ImageIndex:=ImageIndexLFM;
pftLRS: ANode.ImageIndex:=ImageIndexLRS;
pftInclude: ANode.ImageIndex:=ImageIndexInclude;
pftText: ANode.ImageIndex:=ImageIndexText;
pftBinary: ANode.ImageIndex:=ImageIndexBinary;
else
@ -1101,6 +1155,7 @@ begin
CurFile:=LazPackage.Files[i];
CurNode.Text:=CurFile.GetShortFilename;
SetImageIndex(CurNode,CurFile);
writeln('AAA1 ',CurNode.Text,' ',CurNode.ImageIndex,' ',ImageIndexBinary,' ',CurFile.FileType=pftBinary);
CurNode:=CurNode.GetNextSibling;
end;
while CurNode<>nil do begin
@ -1438,6 +1493,94 @@ begin
Result:=TPackageEditorForm(FItems[Index]);
end;
procedure TPackageEditors.ApplyLayout(AnEditor: TPackageEditorForm);
var
PkgFilename: String;
ANode: TAVLTreeNode;
ARect: TRect;
begin
if fLayouts=nil then LoadLayouts;
PkgFilename:=AnEditor.LazPackage.Filename;
ANode:=fLayouts.FindKey(Pointer(PkgFilename),@CompareFilenameWithLayout);
// find a nice position for the editor
if ANode<>nil then
ARect:=TPackageEditorLayout(ANode.Data).Rectangle
else
ARect:=Rect(0,0,0,0);
if (ARect.Bottom<ARect.Top+50) or (ARect.Right<ARect.Left+50)
or (ARect.Bottom>Screen.Height) or (ARect.Right>Screen.Width) then
ARect:=CreateNiceWindowPosition(500,400);
AnEditor.SetBounds(ARect.Left,ARect.Top,
ARect.Right-ARect.Left,ARect.Bottom-ARect.Top);
end;
procedure TPackageEditors.SaveLayout(AnEditor: TPackageEditorForm);
var
PkgFilename: String;
ANode: TAVLTreeNode;
CurLayout: TPackageEditorLayout;
begin
if fLayouts=nil then exit;
PkgFilename:=AnEditor.LazPackage.Filename;
ANode:=fLayouts.FindKey(Pointer(PkgFilename),@CompareFilenameWithLayout);
if ANode<>nil then begin
CurLayout:=TPackageEditorLayout(ANode.Data);
fLayouts.Remove(CurLayout);
end else begin
CurLayout:=TPackageEditorLayout.Create;
end;
CurLayout.Filename:=PkgFilename;
with AnEditor do
CurLayout.Rectangle:=Bounds(Left,Top,Width,Height);
fLayouts.Add(CurLayout);
end;
procedure TPackageEditors.LoadLayouts;
var
Filename: String;
Path: String;
XMLConfig: TXMLConfig;
LayoutCount: Integer;
NewLayout: TPackageEditorLayout;
i: Integer;
begin
if fLayouts=nil then fLayouts:=TAVLTree.Create(@CompareLayouts);
fLayouts.FreeAndClear;
Filename:=GetLayoutConfigFilename;
if not FileExists(Filename) then exit;
try
XMLConfig:=TXMLConfig.Create(Filename);
except
writeln('ERROR: unable to open package editor layouts "',Filename,'"');
exit;
end;
try
try
Path:='PackageEditorLayouts/';
LayoutCount:=XMLConfig.GetValue(Path+'Count/Value',0);
for i:=1 to LayoutCount do begin
NewLayout:=TPackageEditorLayout.Create;
NewLayout.LoadFromXMLConfig(XMLConfig,Path+'Layout'+IntToStr(i));
if (NewLayout.Filename='') or (fLayouts.Find(NewLayout)<>nil) then
NewLayout.Free
else
fLayouts.Add(NewLayout);
end;
finally
XMLConfig.Free;
end;
except
on E: Exception do begin
writeln('ERROR: unable read miscellaneous options from "',Filename,'": ',E.Message);
end;
end;
end;
function TPackageEditors.GetLayoutConfigFilename: string;
begin
Result:=SetDirSeparators(GetPrimaryConfigPath+'/packageeditorlayouts.xml');
end;
constructor TPackageEditors.Create;
begin
FItems:=TList.Create;
@ -1447,6 +1590,10 @@ destructor TPackageEditors.Destroy;
begin
Clear;
FItems.Free;
if fLayouts<>nil then begin
fLayouts.FreeAndClear;
fLayouts.Free;
end;
inherited Destroy;
end;
@ -1460,6 +1607,48 @@ begin
FItems.Clear;
end;
procedure TPackageEditors.SaveLayouts;
var
Filename: String;
XMLConfig: TXMLConfig;
Path: String;
LayoutCount: Integer;
ANode: TAVLTreeNode;
CurLayout: TPackageEditorLayout;
begin
if fLayouts=nil then exit;
Filename:=GetLayoutConfigFilename;
try
ClearFile(Filename,true);
XMLConfig:=TXMLConfig.Create(Filename);
except
on E: Exception do begin
writeln('ERROR: unable to open miscellaneous options "',Filename,'": ',E.Message);
exit;
end;
end;
try
try
Path:='PackageEditorLayouts/';
LayoutCount:=0;
ANode:=fLayouts.FindLowest;
while ANode<>nil do begin
inc(LayoutCount);
CurLayout:=TPackageEditorLayout(ANode.Data);
CurLayout.SaveToXMLConfig(XMLConfig,Path+'Layout'+IntToStr(LayoutCount));
ANode:=fLayouts.FindSuccessor(ANode);
end;
XMLConfig.SetDeleteValue(Path+'Count/Value',LayoutCount,0);
XMLConfig.Flush;
finally
XMLConfig.Free;
end;
except
writeln('ERROR: unable read miscellaneous options from "',Filename,'"');
end;
end;
procedure TPackageEditors.Remove(Editor: TPackageEditorForm);
begin
FItems.Remove(Editor);
@ -1548,6 +1737,32 @@ begin
for i:=0 to Count-1 do Editors[i].UpdateAll;
end;
{ TPackageEditorLayout }
constructor TPackageEditorLayout.Create;
begin
end;
destructor TPackageEditorLayout.Destroy;
begin
inherited Destroy;
end;
procedure TPackageEditorLayout.LoadFromXMLConfig(XMLConfig: TXMLConfig;
const Path: string);
begin
Filename:=XMLConfig.GetValue(Path+'Filename/Value','');
LoadRect(XMLConfig,Path+'Rect/',Rectangle);
end;
procedure TPackageEditorLayout.SaveToXMLConfig(XMLConfig: TXMLConfig;
const Path: string);
begin
XMLConfig.SetDeleteValue(Path+'Filename/Value',Filename,'');
SaveRect(XMLConfig,Path+'Rect/',Rectangle);
end;
initialization
PackageEditors:=nil;

3
packager/packagesystem.pas
View File

@ -808,6 +808,7 @@ begin
Filename:='$(FPCSrcDir)/fcl/';
Version.SetValues(1,0,1,1);
Author:='FPC team';
License:='LGPL-2';
AutoInstall:=pitStatic;
AutoUpdate:=false;
Description:='The FCL - FreePascal Component Library '
@ -838,6 +839,7 @@ begin
Filename:='$(LazarusDir)/lcl/';
Version.SetValues(1,0,1,1);
Author:='Lazarus';
License:='LGPL-2';
AutoInstall:=pitStatic;
AutoUpdate:=false;
Description:='The LCL - Lazarus Component Library '
@ -885,6 +887,7 @@ begin
Filename:='$(LazarusDir)/components/synedit/';
Version.SetValues(1,0,1,1);
Author:='SynEdit - http://sourceforge.net/projects/synedit/';
License:='LGPL-2';
AutoInstall:=pitStatic;
AutoUpdate:=false;
Description:='SynEdit - the editor component used by Lazarus. '

135
packager/pkgmanager.pas
View File

@ -51,13 +51,11 @@ uses
PackageEditor, AddToPackageDlg, PackageDefs, PackageLinks, PackageSystem,
OpenInstalledPkgDlg, PkgGraphExplorer, BrokenDependenciesDlg, CompilerOptions,
ExtToolDialog, ExtToolEditDlg, EditDefineTree, DefineTemplates,
ProjectInspector, ComponentPalette,
ProjectInspector, ComponentPalette, UnitEditor, AddFileToAPackageDlg,
BasePkgManager, MainBar;
type
TPkgManager = class(TBasePkgManager)
procedure IDEComponentPaletteEndUpdate(Sender: TObject;
PaletteChanged: boolean);
// events
function OnPackageEditorCompilePackage(Sender: TObject;
APackage: TLazPackage; CompileAll: boolean): TModalResult;
@ -71,6 +69,7 @@ type
APackage: TLazPackage): TModalResult;
procedure MainIDEitmPkgOpenPackageFileClick(Sender: TObject);
procedure MainIDEitmPkgPkgGraphClick(Sender: TObject);
procedure MainIDEitmPkgAddCurUnitToPkgClick(Sender: TObject);
procedure mnuConfigCustomCompsClicked(Sender: TObject);
procedure mnuOpenRecentPackageClicked(Sender: TObject);
procedure mnuPkgOpenPackageClicked(Sender: TObject);
@ -86,6 +85,8 @@ type
procedure PackageGraphDeletePackage(APackage: TLazPackage);
procedure PackageGraphDependencyModified(ADependency: TPkgDependency);
procedure PackageGraphEndUpdate(Sender: TObject; GraphChanged: boolean);
procedure IDEComponentPaletteEndUpdate(Sender: TObject;
PaletteChanged: boolean);
private
// helper functions
function DoShowSavePackageAsDialog(APackage: TLazPackage): TModalResult;
@ -112,6 +113,7 @@ type
procedure SetupMainBarShortCuts; override;
procedure SetRecentPackagesMenu; override;
procedure AddFileToRecentPackages(const Filename: string);
procedure SaveSettings; override;
function GetDefaultSaveDirectoryForFile(const Filename: string): string; override;
@ -147,6 +149,7 @@ type
Flags: TPkgCompileFlags): TModalResult; override;
function OnRenameFile(const OldFilename,
NewFilename: string): TModalResult; override;
function DoAddActiveUnitToAPackage: TModalResult;
function OnProjectInspectorOpen(Sender: TObject): boolean; override;
@ -195,6 +198,11 @@ begin
UpdateVisibleComponentPalette;
end;
procedure TPkgManager.MainIDEitmPkgAddCurUnitToPkgClick(Sender: TObject);
begin
DoAddActiveUnitToAPackage;
end;
function TPkgManager.OnPackageEditorCompilePackage(Sender: TObject;
APackage: TLazPackage; CompileAll: boolean): TModalResult;
var
@ -643,19 +651,23 @@ function TPkgManager.DoSavePackageCompiledState(APackage: TLazPackage;
var
XMLConfig: TXMLConfig;
StateFile: String;
CompilerFileDate: Integer;
begin
StateFile:=APackage.GetStateFilename;
try
CompilerFileDate:=FileAge(CompilerFilename);
ClearFile(StateFile,true);
XMLConfig:=TXMLConfig.Create(StateFile);
try
XMLConfig.SetValue('Compiler/Value',CompilerFilename);
XMLConfig.SetValue('Compiler/Date',CompilerFileDate);
XMLConfig.SetValue('Params/Value',CompilerParams);
XMLConfig.Flush;
finally
XMLConfig.Free;
end;
APackage.LastCompilerFilename:=CompilerFilename;
APackage.LastCompilerFileDate:=CompilerFileDate;
APackage.LastCompilerParams:=CompilerParams;
APackage.StateFileDate:=FileAge(StateFile);
APackage.Flags:=APackage.Flags+[lpfStateFileLoaded];
@ -699,6 +711,8 @@ begin
try
APackage.LastCompilerFilename:=
XMLConfig.GetValue('Compiler/Value','');
APackage.LastCompilerFileDate:=
XMLConfig.GetValue('Compiler/Date',0);
APackage.LastCompilerParams:=
XMLConfig.GetValue('Params/Value','');
finally
@ -769,8 +783,16 @@ var
RequiredPackage: TLazPackage;
begin
Result:=mrYes;
writeln('TPkgManager.CheckIfPackageNeedsCompilation A ',APackage.IDAsString);
// calculate compiler filename and parameters
OutputDir:=APackage.GetOutputDirectory;
SrcFilename:=OutputDir+APackage.GetCompileSourceFilename;
NewCompilerFilename:=APackage.GetCompilerFilename;
NewCompilerParams:=APackage.CompilerOptions.MakeOptionsString(
APackage.CompilerOptions.DefaultMakeOptionsFlags)
+' '+CreateRelativePath(SrcFilename,APackage.Directory);
// check state file
StateFilename:=APackage.GetStateFilename;
Result:=DoLoadPackageCompiledState(APackage,false);
@ -799,7 +821,7 @@ begin
if StateFileAge<RequiredPackage.StateFileDate then begin
writeln('TPkgManager.CheckIfPackageNeedsCompilation Required ',
RequiredPackage.IDAsString,' State file is newer than ',
' State file ',APackage.IDAsString);
'State file ',APackage.IDAsString);
exit;
end;
end;
@ -807,22 +829,32 @@ begin
Dependency:=Dependency.NextRequiresDependency;
end;
OutputDir:=APackage.GetOutputDirectory;
SrcFilename:=OutputDir+APackage.GetCompileSourceFilename;
NewCompilerFilename:=APackage.GetCompilerFilename;
NewCompilerParams:=APackage.CompilerOptions.MakeOptionsString(
APackage.CompilerOptions.DefaultMakeOptionsFlags)
+' '+CreateRelativePath(SrcFilename,APackage.Directory);
Result:=mrYes;
// check compiler command
// check main source file
if not FileExists(SrcFilename) or (StateFileAge<FileAge(SrcFilename)) then
begin
writeln('TPkgManager.CheckIfPackageNeedsCompilation SrcFile outdated ',APackage.IDAsString);
exit;
end;
// check compiler and params
if NewCompilerFilename<>APackage.LastCompilerFilename then begin
writeln('TPkgManager.CheckIfPackageNeedsCompilation Compiler filename changed for ',APackage.IDAsString);
writeln(' Old="',APackage.LastCompilerFilename,'"');
writeln(' Now="',NewCompilerFilename,'"');
exit;
end;
if not FileExists(NewCompilerFilename) then begin
writeln('TPkgManager.CheckIfPackageNeedsCompilation Compiler filename not found for ',APackage.IDAsString);
writeln(' File="',NewCompilerFilename,'"');
exit;
end;
if FileAge(NewCompilerFilename)<>APackage.LastCompilerFileDate then begin
writeln('TPkgManager.CheckIfPackageNeedsCompilation Compiler file changed for ',APackage.IDAsString);
writeln(' File="',NewCompilerFilename,'"');
exit;
end;
if NewCompilerParams<>APackage.LastCompilerParams then begin
writeln('TPkgManager.CheckIfPackageNeedsCompilation Compiler params changed for ',APackage.IDAsString);
writeln(' Old="',APackage.LastCompilerParams,'"');
@ -830,13 +862,6 @@ begin
exit;
end;
// check main source file
if not FileExists(SrcFilename) or (StateFileAge<FileAge(SrcFilename)) then
begin
writeln('TPkgManager.CheckIfPackageNeedsCompilation SrcFile outdated ',APackage.IDAsString);
exit;
end;
// check package files
if StateFileAge<FileAge(APackage.Filename) then begin
writeln('TPkgManager.CheckIfPackageNeedsCompilation StateFile older than lpk ',APackage.IDAsString);
@ -963,10 +988,11 @@ end;
procedure TPkgManager.ConnectMainBarEvents;
begin
with MainIDE do begin
itmCompsConfigCustomComps.OnClick :=@mnuConfigCustomCompsClicked;
itmPkgOpenPackage.OnClick :=@mnuPkgOpenPackageClicked;
itmPkgOpenPackageFile.OnClick:=@MainIDEitmPkgOpenPackageFileClick;
itmPkgAddCurUnitToPkg.OnClick:=@MainIDEitmPkgAddCurUnitToPkgClick;
itmPkgPkgGraph.OnClick:=@MainIDEitmPkgPkgGraphClick;
itmCompsConfigCustomComps.OnClick :=@mnuConfigCustomCompsClicked;
end;
SetRecentPackagesMenu;
@ -996,6 +1022,11 @@ begin
MainIDE.SaveEnvironment;
end;
procedure TPkgManager.SaveSettings;
begin
PackageEditors.SaveLayouts;
end;
function TPkgManager.GetDefaultSaveDirectoryForFile(const Filename: string
): string;
var
@ -1432,6 +1463,7 @@ var
PkgCompileTool: TExternalToolOptions;
CompilerFilename: String;
CompilerParams: String;
EffektiveCompilerParams: String;
begin
Result:=mrCancel;
@ -1498,14 +1530,23 @@ writeln('TPkgManager.DoCompilePackage A ',APackage.IDAsString,' Flags=',PkgCompi
end;
end;
// change compiler parameters for compiling clean
EffektiveCompilerParams:=CompilerParams;
if pcfCleanCompile in Flags then begin
if EffektiveCompilerParams<>'' then
EffektiveCompilerParams:='-B '+EffektiveCompilerParams
else
EffektiveCompilerParams:='-B';
end;
PkgCompileTool:=TExternalToolOptions.Create;
try
PkgCompileTool.Title:='Compiling package '+APackage.IDAsString;
PkgCompileTool.Filename:=CompilerFilename;
PkgCompileTool.ScanOutputForFPCMessages:=true;
PkgCompileTool.ScanOutputForMakeMessages:=true;
PkgCompileTool.WorkingDirectory:=APackage.Directory;
PkgCompileTool.CmdLineParams:=CompilerParams;
PkgCompileTool.Filename:=CompilerFilename;
PkgCompileTool.CmdLineParams:=EffektiveCompilerParams;
// clear old errors
SourceNotebook.ClearErrorLines;
@ -1686,6 +1727,48 @@ begin
Result:=mrOk;
end;
function TPkgManager.DoAddActiveUnitToAPackage: TModalResult;
var
ActiveSourceEditor: TSourceEditor;
ActiveUnitInfo: TUnitInfo;
PkgFile: TPkgFile;
Filename: String;
begin
MainIDE.GetCurrentUnit(ActiveSourceEditor,ActiveUnitInfo);
if ActiveSourceEditor=nil then exit;
Filename:=ActiveUnitInfo.Filename;
// check if filename is absolute
if ActiveUnitInfo.IsVirtual or (not FileExists(Filename)) then begin
Result:=MessageDlg('File not saved',
'Please save the file before adding it to a package.',
mtWarning,[mbCancel],0);
exit;
end;
// check if file is part of project
if ActiveUnitInfo.IsPartOfProject then begin
Result:=MessageDlg('File is in Project',
'Warning: The file "'+Filename+'"'#13
+'belongs to the current project.'
,mtWarning,[mbIgnore,mbCancel,mbAbort],0);
if Result<>mrIgnore then exit;
end;
// check if file is already in a package
PkgFile:=PackageGraph.FindFileInAllPackages(Filename,false,true);
if PkgFile<>nil then begin
Result:=MessageDlg('File is already in package',
'The file "'+Filename+'"'#13
+'is already in the package '+PkgFile.LazPackage.IDAsString+'.'#13,
mtWarning,[mbIgnore,mbCancel,mbAbort],0);
if Result<>mrIgnore then exit;
end;
Result:=ShowAddFileToAPackageDlg(Filename);
end;
function TPkgManager.OnProjectInspectorOpen(Sender: TObject): boolean;
var
Dependency: TPkgDependency;
@ -1725,8 +1808,10 @@ begin
if CurPackage.Modified and (not CurPackage.ReadOnly)
and (not (lpfSkipSaving in CurPackage.Flags)) then begin
Result:=DoSavePackage(CurPackage,Flags);
if Result=mrIgnore then
if Result=mrIgnore then begin
CurPackage.Flags:=CurPackage.Flags+[lpfSkipSaving];
Result:=mrOk;
end;
if Result<>mrOk then exit;
AllSaved:=false;
end;

27
packager/pkgoptionsdlg.pas
View File

@ -51,6 +51,8 @@ type
DescriptionMemo: TMemo;
AuthorGroupBox: TGroupBox;
AuthorEdit: TEdit;
LicenseGroupBox: TGroupBox;
LicenseMemo: TMemo;
VersionGroupBox: TGroupBox;
VersionMajorLabel: TLabel;
VersionMajorSpinEdit: TSpinEdit;
@ -282,6 +284,11 @@ begin
inc(y,Height+5);
end;
with LicenseGroupBox do begin
SetBounds(x,y+3,w,70);
inc(y,Height+5);
end;
with VersionGroupBox do
SetBounds(x,y,w,90);
end;
@ -369,6 +376,7 @@ begin
// Description page
LazPackage.Description:=DescriptionMemo.Text;
LazPackage.Author:=AuthorEdit.Text;
LazPackage.License:=LicenseMemo.Text;
LazPackage.AutoIncrementVersionOnBuild:=AutoIncrementOnBuildCheckBox.Checked;
// Usage page
@ -530,6 +538,22 @@ begin
Text:='';
end;
LicenseGroupBox:=TGroupBox.Create(Self);
with LicenseGroupBox do begin
Name:='LicenseGroupBox';
Parent:=DescriptionPage;
Caption:='License:';
end;
LicenseMemo:=TMemo.Create(Self);
with LicenseMemo do begin
Name:='LicenseMemo';
Parent:=LicenseGroupBox;
Align:=alClient;
ScrollBars:=ssAutoVertical;
Text:='';
end;
VersionGroupBox:=TGroupBox.Create(Self);
with VersionGroupBox do begin
Name:='VersionGroupBox';
@ -800,7 +824,8 @@ begin
// Description page
DescriptionMemo.Text:=LazPackage.Description;
AuthorEdit.Text:=LazPackage.Author;
LicenseMemo.Text:=LazPackage.License;
VersionMajorSpinEdit.Value:=LazPackage.Version.Major;
VersionMinorSpinEdit.Value:=LazPackage.Version.Minor;
VersionReleaseSpinEdit.Value:=LazPackage.Version.Release;