{ /*************************************************************************** project.pp - project utility class file ----------------------------------------- TProject is responsible for managing a complete project. Initial Revision : Sun Mar 28 23:15:32 CST 1999 ***************************************************************************/ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** } unit Project; {$mode objfpc}{$H+} {$ifdef Trace} {$ASSERTIONS ON} {$endif} interface {$I ide.inc} uses {$IFDEF IDE_MEM_CHECK} MemCheck, {$ENDIF} // RTL + FCL + LCL Classes, SysUtils, TypInfo, LCLProc, Forms, Controls, Dialogs, maps, // CodeTools CodeToolsConfig, ExprEval, DefineTemplates, BasicCodeTools, CodeToolsCfgScript, CodeToolManager, CodeCache, FileProcs, // LazUtils FPCAdds, FileUtil, LazFileUtils, LazFileCache, LazUTF8, Laz2_XMLCfg, // IDEIntf PropEdits, CompOptsIntf, ProjectIntf, MacroIntf, MacroDefIntf, UnitResources, PackageIntf, SrcEditorIntf, IDEOptionsIntf, IDEDialogs, LazIDEIntf, // SynEdit SynEdit, // IDE CompOptsModes, ProjectResources, LazConf, W32Manifest, ProjectIcon, LazarusIDEStrConsts, CompilerOptions, TransferMacros, EditorOptions, IDEProcs, RunParamsOpts, ProjectDefs, ProjPackBase, FileReferenceList, EditDefineTree, ModeMatrixOpts, PackageDefs, PackageSystem; type TUnitInfo = class; TProject = class; TOnFileBackup = function(const FileToBackup: string):TModalResult of object; TOnUnitNameChange = procedure(AnUnitInfo: TUnitInfo; const OldUnitName, NewUnitName: string; CheckIfAllowed: boolean; var Allowed: boolean) of object; TOnLoadProjectInfo = procedure(TheProject: TProject; XMLConfig: TXMLConfig; Merge: boolean) of object; TOnSaveProjectInfo = procedure(TheProject: TProject; XMLConfig: TXMLConfig; WriteFlags: TProjectWriteFlags) of object; TOnChangeProjectInfoFile = procedure(TheProject: TProject) of object; TOnSaveUnitSessionInfoInfo = procedure(AUnitInfo: TUnitInfo) of object; TUnitInfoList = ( uilPartOfProject, uilWithEditorIndex, uilWithComponent, uilLoaded, uilAutoRevertLocked ); TUnitCompDependencyList = ( ucdlRequires, ucdlUsedBy ); TUnitCompDependencyType = ( ucdtAncestor, // RequiresUnit is ancestor ucdtProperty, // a property references RequiresUnit's component or sub component ucdtOldProperty, // like ucdtProperty, but for the old state before the revert ucdtInlineClass // RequiresUnit is class of an inline component ); TUnitCompDependencyTypes = set of TUnitCompDependencyType; const AllUnitCompDependencyTypes = [low(TUnitCompDependencyType)..high(TUnitCompDependencyType)]; // Names for extra buildmodes which may be created automatically. DebugModeName = 'Debug'; ReleaseModeName = 'Release'; type { TUCDComponentProperty } TUCDComponentProperty = class public UsedByPropPath: string; RequiresPropPath: string; constructor Create(const SrcPath, DestPath: string); end; { TUnitComponentDependency } TUnitComponentDependency = class private FCompProps: TFPList;// list of TUCDComponentProperty FRequiresUnit: TUnitInfo; FTypes: TUnitCompDependencyTypes; FUsedByUnit: TUnitInfo; function GetCompPropCount: integer; function GetCompProps(Index: integer): TUCDComponentProperty; procedure SetRequiresUnit(const AValue: TUnitInfo); procedure SetTypes(const AValue: TUnitCompDependencyTypes); procedure SetUsedByUnit(const AValue: TUnitInfo); public NextDependency,PrevDependency: array[TUnitCompDependencyList] of TUnitComponentDependency; constructor Create; destructor Destroy; override; procedure ClearComponentProperties; function NextUsedByDependency: TUnitComponentDependency; function PrevUsedByDependency: TUnitComponentDependency; function NextRequiresDependency: TUnitComponentDependency; function PrevRequiresDependency: TUnitComponentDependency; procedure AddToList(var FirstDependency: TUnitComponentDependency; ListType: TUnitCompDependencyList); procedure RemoveFromList(var FirstDependency: TUnitComponentDependency; ListType: TUnitCompDependencyList); property RequiresUnit: TUnitInfo read FRequiresUnit write SetRequiresUnit; property UsedByUnit: TUnitInfo read FUsedByUnit write SetUsedByUnit; property Types: TUnitCompDependencyTypes read FTypes write SetTypes; property CompPropCount: integer read GetCompPropCount; property CompProps[Index: integer]: TUCDComponentProperty read GetCompProps; function FindUsedByPropPath(const UsedByPropPath: string): TUCDComponentProperty; function SetUsedByPropPath(const UsedByPropPath, RequiresPropPath: string ): TUCDComponentProperty; function CreatePropPath(AComponent: TComponent; const PropName: string = ''): string; end; //--------------------------------------------------------------------------- TUnitInfoFlag = ( uifComponentUsedByDesigner, uifComponentIndirectlyUsedByDesigner, uifMarked, uifInternalFile // data from an internal source (e.g. an editor macro (pascal script) from memory) ); TUnitInfoFlags = set of TUnitInfoFlag; { TUnitEditorInfo } TUnitEditorInfo = class private FEditorComponent: TSourceEditorInterface; FUnitInfo: TUnitInfo; procedure SetEditorComponent(const AValue: TSourceEditorInterface); private FIsLocked: Boolean; FIsVisibleTab: Boolean; FPageIndex: integer; FWindowID: integer; FTopLine: integer; FCursorPos: TPoint; // physical (screen) position FFoldState: String; // Todo: FCustomHighlighter is only ever set to false, and not stored in XML FCustomHighlighter: boolean; // do not change highlighter on file extension change FSyntaxHighlighter: TLazSyntaxHighlighter; procedure SetFoldState(AValue: String); procedure SetPageIndex(const AValue: Integer); procedure SetIsVisibleTab(const AValue: Boolean); procedure SetWindowIndex(const AValue: Integer); protected procedure Clear; public constructor Create(aUnitInfo: TUnitInfo); destructor Destroy; override; property UnitInfo: TUnitInfo read FUnitInfo; property EditorComponent: TSourceEditorInterface read FEditorComponent write SetEditorComponent; procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; SaveFold: Boolean); public property IsVisibleTab: Boolean read FIsVisibleTab write SetIsVisibleTab; property PageIndex: Integer read FPageIndex write SetPageIndex; property WindowID: Integer read FWindowID write SetWindowIndex; property TopLine: Integer read FTopLine write FTopLine; property CursorPos: TPoint read FCursorPos write FCursorPos; property FoldState: String read FFoldState write SetFoldState; property IsLocked: Boolean read FIsLocked write FIsLocked; property CustomHighlighter: Boolean read FCustomHighlighter write FCustomHighlighter; // SetCustomHighlighter property SyntaxHighlighter: TLazSyntaxHighlighter read FSyntaxHighlighter write FSyntaxHighlighter; // SetSyntaxHighlighter end; { TUnitEditorInfoList } TUnitEditorInfoList = class private FList: TFPList; FUnitInfo: TUnitInfo; function GetClosedEditorInfos(Index: Integer): TUnitEditorInfo; function GetEditorInfos(Index: Integer): TUnitEditorInfo; function GetOpenEditorInfos(Index: Integer): TUnitEditorInfo; protected procedure ClearEachInfo; procedure SortByPageIndex; procedure SetLastUsedEditor(AEditor:TSourceEditorInterface); procedure MakeUsedEditorInfo(AEditorInfo: TUnitEditorInfo); procedure MakeUnUsedEditorInfo(AEditorInfo: TUnitEditorInfo); procedure Clear; public constructor Create(aUnitInfo: TUnitInfo); destructor Destroy; override; property EditorInfos[Index: Integer]: TUnitEditorInfo read GetEditorInfos; default; property OpenEditorInfos[Index: Integer]: TUnitEditorInfo read GetOpenEditorInfos; property ClosedEditorInfos[Index: Integer]: TUnitEditorInfo read GetClosedEditorInfos; function Count: Integer; function OpenCount: Integer; function ClosedCount: Integer; function IndexOfEditorComponent(anEditor: TSourceEditorInterface): Integer; function NewEditorInfo: TUnitEditorInfo; procedure Add(AEditorInfo: TUnitEditorInfo); procedure Delete(Index: Integer); procedure Remove(AEditorInfo: TUnitEditorInfo); end; { TUnitInfo } TUnitInfo = class(TLazProjectFile) private FComponentFallbackClasses: TStrings; FCustomDefaultHighlighter: boolean; FDefaultSyntaxHighlighter: TLazSyntaxHighlighter; FDisableI18NForLFM: boolean; FEditorInfoList: TUnitEditorInfoList; FAutoReferenceSourceDir: boolean; fAutoRevertLockCount: integer;// =0 means, codetools can auto update from disk fBookmarks: TFileBookmarks; FBuildFileIfActive: boolean; fComponent: TComponent; FComponentState: TWindowState; // state of component when we save it FResourceBaseClass: TPFComponentBaseClass; fComponentName: string; { classname is always T this attribute contains the component name, even if the unit is not loaded, or the designer form is not created. A component can be for example a TForm or a TDataModule } fComponentResourceName: string; FComponentLastBinStreamSize: TStreamSeekType; FComponentLastLFMStreamSize: TStreamSeekType; FComponentLastLRSStreamSize: TStreamSeekType; FDirectives: TStrings; fFileName: string; // with path = saved, without path = not yet saved fFileReadOnly: Boolean; FFirstRequiredComponent: TUnitComponentDependency; FFirstUsedByComponent: TUnitComponentDependency; FFlags: TUnitInfoFlags; fHasResources: boolean; // source has resource file FIgnoreFileDateOnDiskValid: boolean; FIgnoreFileDateOnDisk: longint; fLoaded: Boolean; // loaded in the source editor, needed to restore open files fLoadedDesigner: Boolean; // has a visible designer, needed to restore open designers FLoadingComponent: boolean; fModified: boolean; fNext, fPrev: array[TUnitInfoList] of TUnitInfo; fOnFileBackup: TOnFileBackup; fOnLoadSaveFilename: TOnLoadSaveFilename; FOnUnitNameChange: TOnUnitNameChange; FProject: TProject; FRevertLockCount: integer;// >0 means IDE is currently reverting this unit FRunFileIfActive: boolean; FSessionModified: boolean; fSource: TCodeBuffer; fSrcUnitName: String; fUsageCount: extended; fUserReadOnly: Boolean; fSourceChangeStep: LongInt; FSourceDirectoryReferenced: boolean; FSourceDirNeedReference: boolean; fLastDirectoryReferenced: string; FSetBookmarLock: Integer; FUnitResourceFileformat: TUnitResourcefileFormatClass; function GetEditorInfo(Index: Integer): TUnitEditorInfo; function GetHasResources:boolean; function GetModified: boolean; function GetNextAutoRevertLockedUnit: TUnitInfo; function GetNextLoadedUnit: TUnitInfo; function GetNextPartOfProject: TUnitInfo; function GetNextUnitWithComponent: TUnitInfo; function GetNextUnitWithEditorIndex: TUnitInfo; function GetOpenEditorInfo(Index: Integer): TUnitEditorInfo; function GetPrevAutoRevertLockedUnit: TUnitInfo; function GetPrevLoadedUnit: TUnitInfo; function GetPrevPartOfProject: TUnitInfo; function GetPrevUnitWithComponent: TUnitInfo; function GetPrevUnitWithEditorIndex: TUnitInfo; function GetUnitResourceFileformat: TUnitResourcefileFormatClass; procedure SetAutoReferenceSourceDir(const AValue: boolean); procedure SetBuildFileIfActive(const AValue: boolean); procedure SetDefaultSyntaxHighlighter(const AValue: TLazSyntaxHighlighter); procedure SetDirectives(const AValue: TStrings); procedure SetDisableI18NForLFM(const AValue: boolean); procedure SetFileReadOnly(const AValue: Boolean); procedure SetComponent(const AValue: TComponent); procedure SetLoaded(const AValue: Boolean); procedure SetLoadedDesigner(const AValue: Boolean); procedure SetModified(const AValue: boolean); procedure SetProject(const AValue: TProject); procedure SetRunFileIfActive(const AValue: boolean); procedure SetSessionModified(const AValue: boolean); procedure SetSource(ABuffer: TCodeBuffer); procedure SetSrcUnitName(const NewUnitName:string); procedure SetUserReadOnly(const NewValue: boolean); protected function GetFileName: string; override; procedure SetFilename(const AValue: string); override; procedure SetIsPartOfProject(const AValue: boolean); override; procedure UpdateList(ListType: TUnitInfoList; Add: boolean); procedure SetInternalFilename(const NewFilename: string); procedure UpdateHasCustomHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter); procedure UpdatePageIndex; public constructor Create(ACodeBuffer: TCodeBuffer); destructor Destroy; override; function GetFileOwner: TObject; override; function GetFileOwnerName: string; override; function ChangedOnDisk(CompareOnlyLoadSaveTime: boolean): boolean; function IsAutoRevertLocked: boolean; function IsReverting: boolean; function IsMainUnit: boolean; function IsVirtual: boolean; function GetDirectory: string; function GetFullFilename: string; override; function GetShortFilename(UseUp: boolean): string; override; function NeedsSaveToDisk: boolean; function ReadOnly: boolean; function ReadUnitSource(ReadUnitName,Revert:boolean): TModalResult; function ShortFilename: string; function WriteUnitSource: TModalResult; function WriteUnitSourceToFile(const AFileName: string): TModalResult; procedure Clear; procedure ClearModifieds; override; procedure ClearComponentDependencies; procedure WriteDebugReportUnitComponentDependencies(Prefix: string); procedure IgnoreCurrentFileDateOnDisk; procedure IncreaseAutoRevertLock; // do not auto revert from disk procedure DecreaseAutoRevertLock; function ReadUnitNameFromSource(TryCache: boolean): string;// fetch unit name from source and update property UnitName function GetUsesUnitName: string; function CreateUnitName: string; procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; Merge, IgnoreIsPartOfProject: boolean; FileVersion: integer); procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; SaveData, SaveSession: boolean; UsePathDelim: TPathDelimSwitch); procedure UpdateUsageCount(Min, IfBelowThis, IncIfBelow: extended); procedure UpdateUsageCount(TheUsage: TUnitUsage; const Factor: TDateTime); procedure UpdateSourceDirectoryReference; procedure SetSourceText(const SourceText: string; Beautify: boolean = false); override; function GetSourceText: string; override; // component dependencies function AddRequiresComponentDependency(RequiredUnit: TUnitInfo; Types: TUnitCompDependencyTypes ): TUnitComponentDependency; procedure RemoveRequiresComponentDependency(RequiredUnit: TUnitInfo; Types: TUnitCompDependencyTypes); function FindComponentDependency(RequiredUnit: TUnitInfo ): TUnitComponentDependency; function FindRequiredComponentDependency(MinTypes: TUnitCompDependencyTypes ): TUnitComponentDependency; function FindUsedByComponentDependency(MinTypes: TUnitCompDependencyTypes ): TUnitComponentDependency; function FindAncestorUnit: TUnitInfo; procedure ClearUnitComponentDependencies( ClearTypes: TUnitCompDependencyTypes); // Bookmarks function AddBookmark(X, Y, ID: integer):integer; procedure DeleteBookmark(ID: integer); // EditorInfo // At any time, any UnitInfo has at least one EditorInfo function EditorInfoCount: Integer; property EditorInfo[Index: Integer]: TUnitEditorInfo read GetEditorInfo; function OpenEditorInfoCount: Integer; // with EditorComponent assigned property OpenEditorInfo[Index: Integer]: TUnitEditorInfo read GetOpenEditorInfo; function GetClosedOrNewEditorInfo: TUnitEditorInfo; procedure SetLastUsedEditor(AEditor:TSourceEditorInterface); // Highlighter procedure UpdateDefaultHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter); public { Properties } property UnitResourceFileformat: TUnitResourcefileFormatClass read GetUnitResourceFileformat; // Unit lists property NextUnitWithEditorIndex: TUnitInfo read GetNextUnitWithEditorIndex; property PrevUnitWithEditorIndex: TUnitInfo read GetPrevUnitWithEditorIndex; property NextUnitWithComponent: TUnitInfo read GetNextUnitWithComponent; property PrevUnitWithComponent: TUnitInfo read GetPrevUnitWithComponent; property NextLoadedUnit: TUnitInfo read GetNextLoadedUnit; property PrevLoadedUnit: TUnitInfo read GetPrevLoadedUnit; property NextAutoRevertLockedUnit: TUnitInfo read GetNextAutoRevertLockedUnit; property PrevAutoRevertLockedUnit: TUnitInfo read GetPrevAutoRevertLockedUnit; property NextPartOfProject: TUnitInfo read GetNextPartOfProject; property PrevPartOfProject: TUnitInfo read GetPrevPartOfProject; public property Bookmarks: TFileBookmarks read FBookmarks write FBookmarks; property BuildFileIfActive: boolean read FBuildFileIfActive write SetBuildFileIfActive; property Component: TComponent read fComponent write SetComponent; property ComponentName: string read fComponentName write fComponentName; property ComponentResourceName: string read fComponentResourceName write fComponentResourceName; property ComponentFallbackClasses: TStrings read FComponentFallbackClasses write FComponentFallbackClasses; // classname to componentclass, for not registered classes in lfm property ComponentState: TWindowState read FComponentState write FComponentState; property ResourceBaseClass: TPFComponentBaseClass read FResourceBaseClass write FResourceBaseClass; property ComponentLastBinStreamSize: TStreamSeekType read FComponentLastBinStreamSize write FComponentLastBinStreamSize; property ComponentLastLRSStreamSize: TStreamSeekType read FComponentLastLRSStreamSize write FComponentLastLRSStreamSize; property ComponentLastLFMStreamSize: TStreamSeekType read FComponentLastLFMStreamSize write FComponentLastLFMStreamSize; property CustomDefaultHighlighter: boolean read FCustomDefaultHighlighter write FCustomDefaultHighlighter; property Directives: TStrings read FDirectives write SetDirectives; property DisableI18NForLFM: boolean read FDisableI18NForLFM write SetDisableI18NForLFM; property FileReadOnly: Boolean read fFileReadOnly write SetFileReadOnly; property FirstRequiredComponent: TUnitComponentDependency read FFirstRequiredComponent; property FirstUsedByComponent: TUnitComponentDependency read FFirstUsedByComponent; property Flags: TUnitInfoFlags read FFlags write FFlags; property HasResources: boolean read GetHasResources write fHasResources; property Loaded: Boolean read fLoaded write SetLoaded; property LoadedDesigner: Boolean read fLoadedDesigner write SetLoadedDesigner; property LoadingComponent: boolean read FLoadingComponent write FLoadingComponent; property Modified: boolean read GetModified write SetModified;// not Session data property SessionModified: boolean read FSessionModified write SetSessionModified; property OnFileBackup: TOnFileBackup read fOnFileBackup write fOnFileBackup; property OnLoadSaveFilename: TOnLoadSaveFilename read fOnLoadSaveFilename write fOnLoadSaveFilename; property OnUnitNameChange: TOnUnitNameChange read FOnUnitNameChange write FOnUnitNameChange; property Project: TProject read FProject write SetProject; property RunFileIfActive: boolean read FRunFileIfActive write SetRunFileIfActive; property Source: TCodeBuffer read fSource write SetSource; property DefaultSyntaxHighlighter: TLazSyntaxHighlighter read FDefaultSyntaxHighlighter write SetDefaultSyntaxHighlighter; property SrcUnitName: String read fSrcUnitName write SetSrcUnitName; // unit name in source property UserReadOnly: Boolean read fUserReadOnly write SetUserReadOnly; property SourceDirectoryReferenced: boolean read FSourceDirectoryReferenced; property AutoReferenceSourceDir: boolean read FAutoReferenceSourceDir write SetAutoReferenceSourceDir; end; //--------------------------------------------------------------------------- { TProjectCompilationToolOptions } TProjectCompilationToolOptions = class(TCompilationToolOptions) private FCompileReasons: TCompileReasons; FDefaultCompileReasons: TCompileReasons; procedure SetCompileReasons(const AValue: TCompileReasons); procedure SetDefaultCompileReasons(const AValue: TCompileReasons); protected procedure SubstituteMacros(var s: string); override; public procedure Clear; override; function CreateDiff(CompOpts: TCompilationToolOptions; Tool: TCompilerDiffTool): boolean; override; procedure Assign(Src: TCompilationToolOptions); override; procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; DoSwitchPathDelims: boolean); override; procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; UsePathDelim: TPathDelimSwitch); override; function GetProject: TProject; public property CompileReasons: TCompileReasons read FCompileReasons write SetCompileReasons; property DefaultCompileReasons: TCompileReasons read FDefaultCompileReasons write SetDefaultCompileReasons; end; TProjectBuildMode = class; { TProjectCompilerOptions } TProjectCompilerOptions = class(TBaseCompilerOptions) private FBuildMode: TProjectBuildMode; FProject: TProject; FCompileReasons: TCompileReasons; protected procedure SetTargetCPU(const AValue: string); override; procedure SetTargetOS(const AValue: string); override; procedure SetCustomOptions(const AValue: string); override; procedure SetIncludePaths(const AValue: string); override; procedure SetLibraryPaths(const AValue: string); override; procedure SetLinkerOptions(const AValue: string); override; procedure SetObjectPath(const AValue: string); override; procedure SetSrcPath(const AValue: string); override; procedure SetUnitPaths(const AValue: string); override; procedure SetUnitOutputDir(const AValue: string); override; procedure SetConditionals(AValue: string); override; function SubstituteProjectMacros(const s: string; PlatformIndependent: boolean): string; public constructor Create(const AOwner: TObject); override; destructor Destroy; override; function IsActive: boolean; override; class function GetInstance: TAbstractIDEOptions; override; class function GetGroupCaption: string; override; procedure Clear; override; procedure LoadFromXMLConfig(AXMLConfig: TXMLConfig; const Path: string); override; procedure SaveToXMLConfig(AXMLConfig: TXMLConfig; const Path: string); override; function CanBeDefaulForProject: boolean; override; function GetOwnerName: string; override; function GetDefaultMainSourceFileName: string; override; procedure GetInheritedCompilerOptions(var OptionsList: TFPList); override; procedure Assign(Source: TPersistent); override; function IsEqual(CompOpts: TBaseCompilerOptions): boolean; override; function CreateDiff(CompOpts: TBaseCompilerOptions; Tool: TCompilerDiffTool = nil): boolean; override; // true if differ procedure InvalidateOptions; procedure SetAlternativeCompile(const Command: string; ScanFPCMsgs: boolean); override; public property LazProject: TProject read FProject; property BuildMode: TProjectBuildMode read FBuildMode; published property CompileReasons: TCompileReasons read FCompileReasons write FCompileReasons; end; { TProjectDefineTemplates } TProjectDefineTemplates = class(TProjPackDefineTemplates) private procedure FixTemplateOrder; protected procedure UpdateMain; override; procedure UpdateSrcDirIfDef; override; procedure UpdateSourceDirectories; override; procedure UpdateOutputDirectory; override; procedure UpdateDefinesForCustomDefines; override; procedure ClearFlags; override; public constructor Create(AOwner: IProjPack); destructor Destroy; override; procedure AllChanged; override; procedure UpdateGlobalValues; end; { TProjectBuildMode } TProjectBuildMode = class(TLazProjectBuildMode) private FCompilerOptions: TProjectCompilerOptions; protected function GetLazCompilerOptions: TLazCompilerOptions; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function LazProject: TProject; procedure Clear; function Equals(Src: TProjectBuildMode): boolean; reintroduce; function CreateDiff(Other: TProjectBuildMode; Tool: TCompilerDiffTool = nil): boolean; procedure Assign(Src: TProjectBuildMode); reintroduce; procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); procedure SaveMacroValuesAtOldPlace(XMLConfig: TXMLConfig; const Path: string); procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; IsDefault: Boolean; var Cnt: integer); function GetCaption: string; override; function GetIndex: integer; override; public // copied by Assign, compared by Equals, cleared by Clear property CompilerOptions: TProjectCompilerOptions read FCompilerOptions; end; { TProjectBuildModes } TProjectBuildModes = class(TLazProjectBuildModes) private FAssigning: Boolean; FSessionMatrixOptions: TBuildMatrixOptions; FSharedMatrixOptions: TBuildMatrixOptions; fSavedChangeStamp: int64; fItems: TFPList; FLazProject: TProject; fOnChanged: TMethodList; // Variables used by LoadFromXMLConfig and SaveToXMLConfig FXMLConfig: TXMLConfig; FGlobalMatrixOptions: TBuildMatrixOptions; function GetItems(Index: integer): TProjectBuildMode; function GetModified: boolean; procedure OnItemChanged(Sender: TObject); procedure SetModified(const AValue: boolean); // Used by LoadFromXMLConfig procedure AddMatrixMacro(const MacroName, MacroValue, ModeIdentifier: string; InSession: boolean); procedure LoadSessionEnabledNonSessionMatrixOptions(const Path: string); procedure LoadOtherCompilerOpts(const Path: string; FromIndex, ToIndex: Integer; InSession: boolean); procedure LoadMacroValues(const Path: string; CurMode: TProjectBuildMode); procedure LoadAllMacroValues(const Path: string; Cnt: Integer); procedure LoadOldFormat(const Path: string); procedure LoadActiveBuildMode(const Path: string); // Used by SaveToXMLConfig procedure SaveSessionData(const Path: string); procedure SaveSharedMatrixOptions(const Path: string); protected function GetLazBuildModes(Index: integer): TLazProjectBuildMode; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Clear; function IsEqual(OtherModes: TProjectBuildModes): boolean; procedure Assign(Source: TPersistent; WithModified: boolean); overload; procedure Delete(Index: integer); function IndexOf(Identifier: string): integer; function IndexOf(aMode: TProjectBuildMode): integer; function Find(Identifier: string): TProjectBuildMode; function Add(Identifier: string): TProjectBuildMode; procedure Move(FromIndex, ToIndex: integer); function Count: integer; override; procedure IncreaseChangeStamp; procedure AddOnChangedHandler(const Handler: TNotifyEvent); procedure RemoveOnChangedHandler(const Handler: TNotifyEvent); function IsModified(InSession: boolean): boolean; function GetSessionModes: TStringList; function IsSessionMode(const ModeIdentifier: string): boolean; function IsSharedMode(const ModeIdentifier: string): boolean; procedure RenameMatrixMode(const OldName, NewName: string); function CreateExtraModes(aCurMode: TProjectBuildMode): TProjectBuildMode; // load, save procedure LoadProjOptsFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); procedure LoadSessionFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; LoadAllOptions: boolean); procedure SaveProjOptsToXMLConfig(XMLConfig: TXMLConfig; const Path: string; SaveSession: boolean); procedure SaveSessionOptsToXMLConfig(XMLConfig: TXMLConfig; const Path: string; SaveSession: boolean); public property Items[Index: integer]: TProjectBuildMode read GetItems; default; property ChangeStamp: integer read FChangeStamp; property LazProject: TProject read FLazProject write FLazProject; property Assigning: Boolean read FAssigning; property Modified: boolean read GetModified write SetModified; property SharedMatrixOptions: TBuildMatrixOptions read FSharedMatrixOptions; property SessionMatrixOptions: TBuildMatrixOptions read FSessionMatrixOptions; end; { TProjectIDEOptions } TProjectIDEOptions = class(TAbstractIDEOptions) private FProject: TProject; public constructor Create(AProject: TProject); destructor Destroy; override; class function GetInstance: TAbstractIDEOptions; override; class function GetGroupCaption: string; override; property Project: TProject read FProject; end; { TProject } TEndUpdateProjectEvent = procedure(Sender: TObject; ProjectChanged: boolean) of object; TLazProjectStateFlag = ( lpsfStateFileLoaded, lpsfPropertyDependenciesChanged, lpsfDesignerChanged ); TLazProjectStateFlags = set of TLazProjectStateFlag; TOldProjectType = (ptApplication, ptProgram, ptCustomProgram); TProject = class(TLazProject, IProjPack) private FActiveBuildMode: TProjectBuildMode; FActiveBuildModeBackup: integer; FActiveWindowIndexAtStart: integer; FBuildModes: TProjectBuildModes; FBuildModesBackup: TProjectBuildModes; FAllEditorsInfoList: TUnitEditorInfoList; FAllEditorsInfoMap: TMap; FAutoCreateForms: boolean; FChangeStampSaved: integer; FEnableI18NForLFM: boolean; FLastCompileComplete: boolean; FMacroEngine: TTransferMacroList; FTmpAutoCreatedForms: TStrings; // temporary, used to apply auto create forms changes FAutoOpenDesignerFormsDisabled: boolean; FBookmarks: TProjectBookmarkList; fChanged: boolean; fCurStorePathDelim: TPathDelimSwitch; // used by OnLoadSaveFilename FDefineTemplates: TProjectDefineTemplates; fDestroying: boolean; FEnableI18N: boolean; fFirst, fLast: array[TUnitInfoList] of TUnitInfo; FFirstRemovedDependency: TPkgDependency; FFirstRequiredDependency: TPkgDependency; FJumpHistory: TProjectJumpHistory; FLastCompilerFileDate: integer; FLastCompilerFilename: string; FLastCompilerParams: string; fLastReadLPIFileDate: TDateTime; fLastReadLPIFilename: string; FLockUnitComponentDependencies: integer; FMainProject: boolean; fMainUnitID: Integer; FOnBeginUpdate: TNotifyEvent; FOnChangeProjectInfoFile: TOnChangeProjectInfoFile; FOnEndUpdate: TEndUpdateProjectEvent; fOnFileBackup: TOnFileBackup; FOnLoadProjectInfo: TOnLoadProjectInfo; FOnSaveProjectInfo: TOnSaveProjectInfo; FOnSaveUnitSessionInfo: TOnSaveUnitSessionInfoInfo; fPathDelimChanged: boolean; // PathDelim in system and current config differ (see StorePathDelim and SessionStorePathDelim) FPOOutputDirectory: string; fProjectDirectory: string; fProjectDirectoryReferenced: string; fProjectInfoFile: String; // the lpi filename fProjectInfoFileBuffer: TCodeBuffer; fProjectInfoFileBufChangeStamp: integer; fProjectInfoFileDate: LongInt; FPublishOptions: TPublishProjectOptions; FRevertLockCount: integer; FSessionModifiedBackup: boolean; FSessionStorePathDelim: TPathDelimSwitch; FSkipCheckLCLInterfaces: boolean; FSourceDirectories: TFileReferenceList; FStateFileDate: longint; FStateFlags: TLazProjectStateFlags; FStorePathDelim: TPathDelimSwitch; FUnitList: TFPList; // list of _all_ units (TUnitInfo) FOtherDefines: TStrings; // list of user selectable defines for custom options FUpdateLock: integer; FUseAsDefault: Boolean; // Variables used by ReadProject / WriteProject FXMLConfig: TXMLConfig; FLoadAllOptions: Boolean; // All options / just options used as default for new projects FFileVersion: Integer; FNewMainUnitID: LongInt; FProjectWriteFlags: TProjectWriteFlags; FSaveSessionInLPI: Boolean; procedure ClearBuildModes; function GetAllEditorsInfo(Index: Integer): TUnitEditorInfo; function GetCompilerOptions: TProjectCompilerOptions; function GetBaseCompilerOptions: TBaseCompilerOptions; function GetFirstAutoRevertLockedUnit: TUnitInfo; function GetFirstLoadedUnit: TUnitInfo; function GetFirstPartOfProject: TUnitInfo; function GetFirstUnitWithComponent: TUnitInfo; function GetFirstUnitWithEditorIndex: TUnitInfo; function GetIDEOptions: TProjectIDEOptions; function GetMainFilename: String; function GetMainUnitInfo: TUnitInfo; function GetProjResources: TProjectResources; function GetRunParameterOptions: TRunParamsOptions; function GetSourceDirectories: TFileReferenceList; function GetTargetFilename: string; function GetUnits(Index: integer): TUnitInfo; function JumpHistoryCheckPosition( APosition:TProjectJumpHistoryPosition): boolean; function OnUnitFileBackup(const Filename: string): TModalResult; procedure ClearSourceDirectories; procedure EmbeddedObjectModified(Sender: TObject); procedure OnLoadSaveFilename(var AFilename: string; Load: boolean); procedure OnUnitNameChange(AnUnitInfo: TUnitInfo; const OldUnitName, NewUnitName: string; CheckIfAllowed: boolean; var Allowed: boolean); procedure SetActiveBuildMode(const AValue: TProjectBuildMode); procedure SetAutoOpenDesignerFormsDisabled(const AValue: boolean); procedure SetEnableI18N(const AValue: boolean); procedure SetEnableI18NForLFM(const AValue: boolean); procedure SetLastCompilerParams(AValue: string); procedure SetMainProject(const AValue: boolean); procedure SetMainUnitID(const AValue: Integer); procedure SetPOOutputDirectory(const AValue: string); procedure SetSkipCheckLCLInterfaces(const AValue: boolean); procedure SetStorePathDelim(const AValue: TPathDelimSwitch); procedure SetTargetFilename(const NewTargetFilename: string); procedure SourceDirectoriesChanged(Sender: TObject); procedure UpdateFileBuffer; procedure UpdateProjectDirectory; procedure UpdateSessionFilename; procedure UpdateSourceDirectories; procedure UpdateUsageCounts(const ConfigFilename: string); function UnitMustBeSaved(UnitInfo: TUnitInfo; WriteFlags: TProjectWriteFlags; SaveSession: boolean): boolean; procedure UpdateVisibleEditor(PgIndex: integer); procedure LoadDefaultSession; procedure EditorInfoAdd(EdInfo: TUnitEditorInfo); procedure EditorInfoRemove(EdInfo: TUnitEditorInfo); procedure OnMacroEngineSubstitution({%H-}TheMacro: TTransferMacro; const MacroName: string; var s: string; const Data: PtrInt; var Handled, Abort: boolean; Depth: integer); // Methods for ReadProject function LoadOldProjectType(const Path: string): TOldProjectType; procedure LoadFlags(const Path: string); procedure LoadOtherDefines(const Path: string); procedure LoadSessionInfo(const Path: string; Merge: boolean); procedure LoadFromLPI; procedure LoadFromSession; function DoLoadLPI(Filename: String): TModalResult; function DoLoadSession(Filename: String): TModalResult; // Methods for WriteProject procedure SaveFlags(const Path: string); procedure SaveUnits(const Path: string; SaveSession: boolean); procedure SaveOtherDefines(const Path: string); procedure SaveSessionInfo(const Path: string); procedure SaveToLPI; procedure SaveToSession; function DoWrite(Filename: String; IsLpi: Boolean): TModalResult; protected function GetActiveBuildModeID: string; override; function GetDefineTemplates: TProjPackDefineTemplates; function GetFiles(Index: integer): TLazProjectFile; override; function GetLazBuildModes: TLazProjectBuildModes; override; function GetMainFile: TLazProjectFile; override; function GetMainFileID: Integer; override; function GetModified: boolean; override; function GetProjectInfoFile: string; override; function GetUseManifest: boolean; override; procedure SetActiveBuildModeID(aIdent: string); override; procedure SetExecutableType(const AValue: TProjectExecutableType); override; procedure SetFlags(const AValue: TProjectFlags); override; procedure SetMainFileID(const AValue: Integer); override; procedure SetModified(const AValue: boolean); override; procedure SetProjectInfoFile(const NewFilename: string); override; procedure SetSessionModified(const AValue: boolean); override; procedure SetSessionStorage(const AValue: TProjectSessionStorage); override; procedure SetUseManifest(AValue: boolean); override; protected // special unit lists procedure AddToList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList); procedure RemoveFromList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList); procedure AddToOrRemoveFromAutoRevertLockedList(AnUnitInfo: TUnitInfo); procedure AddToOrRemoveFromComponentList(AnUnitInfo: TUnitInfo); procedure AddToOrRemoveFromLoadedList(AnUnitInfo: TUnitInfo); procedure AddToOrRemoveFromPartOfProjectList(AnUnitInfo: TUnitInfo); public constructor Create(ProjectDescription: TProjectDescriptor); override; destructor Destroy; override; procedure Clear; override; procedure BeginUpdate(Change: boolean); procedure EndUpdate; procedure UnitModified(AnUnitInfo: TUnitInfo); function NeedsDefineTemplates: boolean; procedure BeginRevertUnit(AnUnitInfo: TUnitInfo); procedure EndRevertUnit(AnUnitInfo: TUnitInfo); function IsReverting(AnUnitInfo: TUnitInfo): boolean; // load/save function IsVirtual: boolean; override; function SomethingModified(CheckData, CheckSession: boolean; Verbose: boolean = false): boolean; function SomeDataModified(Verbose: boolean = false): boolean; function SomeSessionModified(Verbose: boolean = false): boolean; procedure MainSourceFilenameChanged; procedure GetUnitsChangedOnDisk(var AnUnitList: TFPList); function HasProjectInfoFileChangedOnDisk: boolean; procedure IgnoreProjectInfoFileOnDisk; function ReadProject(const NewProjectInfoFile: string; GlobalMatrixOptions: TBuildMatrixOptions; LoadAllOptions: Boolean = True): TModalResult; function WriteProject(ProjectWriteFlags: TProjectWriteFlags; const OverrideProjectInfoFile: string; GlobalMatrixOptions: TBuildMatrixOptions): TModalResult; procedure UpdateExecutableType; override; procedure BackupSession; procedure RestoreSession; procedure BackupBuildModes; procedure RestoreBuildModes; // title function GetTitle: string; override; function TitleIsDefault(Fuzzy: boolean = false): boolean; function GetIDAsString: string; function GetIDAsWord: string; // units function UnitCount:integer; function GetFileCount: integer; override; function NewUniqueUnitName(const AnUnitName: string): string; function NewUniqueFilename(const Filename: string): string; procedure AddFile(ProjectFile: TLazProjectFile; AddToProjectUsesClause: boolean); override; procedure RemoveUnit(Index: integer; RemoveFromUsesSection: boolean = true); override; // true if something changed function RemoveNonExistingFiles(RemoveFromUsesSection: boolean = true): boolean; function CreateProjectFile(const Filename: string): TLazProjectFile; override; procedure UpdateVisibleUnit(AnEditor: TSourceEditorInterface; AWindowID: Integer); procedure UpdateAllVisibleUnits; // search function IndexOf(AUnitInfo: TUnitInfo): integer; function IndexOfUnitWithName(const AnUnitName: string; OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo): integer; function IndexOfUnitWithComponent(AComponent: TComponent; OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo): integer; function IndexOfUnitWithComponentName(const AComponentName: string; OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo): integer; function IndexOfFilename(const AFilename: string): integer; function IndexOfFilename(const AFilename: string; SearchFlags: TProjectFileSearchFlags): integer; function ProjectUnitWithFilename(const AFilename: string): TUnitInfo; function ProjectUnitWithShortFilename(const ShortFilename: string): TUnitInfo; function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo; function UnitWithEditorComponent(AEditor:TSourceEditorInterface): TUnitInfo; function UnitWithComponent(AComponent: TComponent): TUnitInfo; function UnitWithComponentClass(AClass: TComponentClass): TUnitInfo; function UnitWithComponentClassName(const AClassName: string): TUnitInfo; function UnitWithComponentName(AComponentName: String; OnlyPartOfProject: boolean): TUnitInfo; function UnitComponentInheritingFrom(AClass: TComponentClass; Ignore: TUnitInfo): TUnitInfo; function UnitUsingComponentUnit(ComponentUnit: TUnitInfo; Types: TUnitCompDependencyTypes): TUnitInfo; function UnitComponentIsUsed(ComponentUnit: TUnitInfo; CheckHasDesigner: boolean): boolean; function UnitInfoWithFilename(const AFilename: string): TUnitInfo; function UnitInfoWithFilename(const AFilename: string; SearchFlags: TProjectFileSearchFlags): TUnitInfo; function UnitWithUnitname(const AnUnitname: string): TUnitInfo; function AllEditorsInfoCount: Integer; property AllEditorsInfo[Index: Integer]: TUnitEditorInfo read GetAllEditorsInfo; function EditorInfoWithEditorComponent(AEditor:TSourceEditorInterface): TUnitEditorInfo; function SearchFile(const ShortFilename: string; SearchFlags: TSearchIDEFileFlags): TUnitInfo; function FindFile(const AFilename: string; SearchFlags: TProjectFileSearchFlags): TLazProjectFile; override; // Application.CreateForm statements function AddCreateFormToProjectFile(const AClassName, AName:string):boolean; function RemoveCreateFormFromProjectFile(const {%H-}AClassName, AName: string):boolean; function FormIsCreatedInProjectFile(const AClassname, AName:string):boolean; // resources function GetMainResourceFilename(AnUnitInfo: TUnitInfo): string; function GetResourceFile(AnUnitInfo: TUnitInfo; Index:integer):TCodeBuffer; procedure LoadDefaultIcon; override; // filenames and fileinfo function RemoveProjectPathFromFilename(const AFilename: string): string; function FileIsInProjectDir(const AFilename: string): boolean; procedure GetVirtualDefines(DefTree: TDefineTree; DirDef: TDirectoryDefines); function GetShortFilename(const Filename: string; UseUp: boolean): string; override; procedure ConvertToLPIFilename(var AFilename: string); override; procedure ConvertFromLPIFilename(var AFilename: string); override; // package dependencies function FindDependencyByName(const PackageName: string): TPkgDependency; function FindRemovedDependencyByName(const PkgName: string): TPkgDependency; function RequiredDepByIndex(Index: integer): TPkgDependency; function RemovedDepByIndex(Index: integer): TPkgDependency; procedure AddRequiredDependency(Dependency: TPkgDependency); procedure RemoveRequiredDependency(Dependency: TPkgDependency); procedure DeleteRequiredDependency(Dependency: TPkgDependency); procedure DeleteRemovedDependency(Dependency: TPkgDependency); procedure RemoveRemovedDependency(Dependency: TPkgDependency); procedure ReaddRemovedDependency(Dependency: TPkgDependency); procedure MoveRequiredDependencyUp(Dependency: TPkgDependency); procedure MoveRequiredDependencyDown(Dependency: TPkgDependency); function Requires(APackage: TLazPackage; SearchRecursively: boolean): boolean; procedure GetAllRequiredPackages(var List: TFPList; ReqFlags: TPkgIntfRequiredFlags = []; MinPolicy: TPackageUpdatePolicy = low(TPackageUpdatePolicy)); procedure AddPackageDependency(const PackageName: string); override; // unit dependencies procedure LockUnitComponentDependencies; procedure UnlockUnitComponentDependencies; procedure UpdateUnitComponentDependencies; procedure InvalidateUnitComponentDesignerDependencies; procedure ClearUnitComponentDependencies(ClearTypes: TUnitCompDependencyTypes); procedure FindUnitsUsingSubComponent(SubComponent: TComponent; List: TFPList; IgnoreOwner: boolean); procedure WriteDebugReportUnitComponentDependencies(Prefix: string); // paths procedure AddSrcPath(const SrcPathAddition: string); override; function GetSourceDirs(WithProjectDir, WithoutOutputDir: boolean): string; function GetOutputDirectory: string; function GetCompilerFilename: string; function GetStateFilename: string; function GetCompileSourceFilename: string; procedure AutoAddOutputDirToIncPath; // compile state file function LoadStateFile(IgnoreErrors: boolean): TModalResult; function SaveStateFile(const CompilerFilename, CompilerParams: string; Complete: boolean): TModalResult; // source editor procedure UpdateAllCustomHighlighter; procedure UpdateAllSyntaxHighlighter; // i18n function GetPOOutDirectory: string; //auto created forms function GetAutoCreatedFormsList: TStrings; property TmpAutoCreatedForms: TStrings read FTmpAutoCreatedForms write FTmpAutoCreatedForms; // Bookmarks function AddBookmark(X, Y, ID: Integer; AUnitInfo:TUnitInfo):integer; procedure DeleteBookmark(ID: Integer); public property ActiveBuildMode: TProjectBuildMode read FActiveBuildMode write SetActiveBuildMode; property ActiveWindowIndexAtStart: integer read FActiveWindowIndexAtStart write FActiveWindowIndexAtStart; property AutoCreateForms: boolean read FAutoCreateForms write FAutoCreateForms; property AutoOpenDesignerFormsDisabled: boolean read FAutoOpenDesignerFormsDisabled write SetAutoOpenDesignerFormsDisabled; property Bookmarks: TProjectBookmarkList read FBookmarks write FBookmarks; property BuildModes: TProjectBuildModes read FBuildModes; property SkipCheckLCLInterfaces: boolean read FSkipCheckLCLInterfaces write SetSkipCheckLCLInterfaces; property CompilerOptions: TProjectCompilerOptions read GetCompilerOptions; property DefineTemplates: TProjectDefineTemplates read FDefineTemplates; property Destroying: boolean read fDestroying; property EnableI18N: boolean read FEnableI18N write SetEnableI18N; property EnableI18NForLFM: boolean read FEnableI18NForLFM write SetEnableI18NForLFM; property FirstAutoRevertLockedUnit: TUnitInfo read GetFirstAutoRevertLockedUnit; property FirstLoadedUnit: TUnitInfo read GetFirstLoadedUnit; property FirstPartOfProject: TUnitInfo read GetFirstPartOfProject; property FirstRemovedDependency: TPkgDependency read FFirstRemovedDependency; property FirstRequiredDependency: TPkgDependency read FFirstRequiredDependency; property FirstUnitWithComponent: TUnitInfo read GetFirstUnitWithComponent; property FirstUnitWithEditorIndex: TUnitInfo read GetFirstUnitWithEditorIndex; property IDAsString: string read GetIDAsString; property IDAsWord: string read GetIDAsWord; property IDEOptions: TProjectIDEOptions read GetIDEOptions; property JumpHistory: TProjectJumpHistory read FJumpHistory write FJumpHistory; property LastCompilerFileDate: integer read FLastCompilerFileDate write FLastCompilerFileDate; property LastCompilerFilename: string read FLastCompilerFilename write FLastCompilerFilename; property LastCompilerParams: string read FLastCompilerParams write SetLastCompilerParams; property LastCompileComplete: boolean read FLastCompileComplete write FLastCompileComplete; property MacroEngine: TTransferMacroList read FMacroEngine; property MainFilename: String read GetMainFilename; property MainProject: boolean read FMainProject write SetMainProject; property MainUnitID: Integer read FMainUnitID write SetMainUnitID; property MainUnitInfo: TUnitInfo read GetMainUnitInfo; property OnBeginUpdate: TNotifyEvent read FOnBeginUpdate write FOnBeginUpdate; property OnChangeProjectInfoFile: TOnChangeProjectInfoFile read FOnChangeProjectInfoFile write FOnChangeProjectInfoFile; property OnEndUpdate: TEndUpdateProjectEvent read FOnEndUpdate write FOnEndUpdate; property OnFileBackup: TOnFileBackup read fOnFileBackup write fOnFileBackup; property OnLoadProjectInfo: TOnLoadProjectInfo read FOnLoadProjectInfo write FOnLoadProjectInfo; property OnSaveProjectInfo: TOnSaveProjectInfo read FOnSaveProjectInfo write FOnSaveProjectInfo; property OnSaveUnitSessionInfo: TOnSaveUnitSessionInfoInfo read FOnSaveUnitSessionInfo write FOnSaveUnitSessionInfo; property POOutputDirectory: string read FPOOutputDirectory write SetPOOutputDirectory; property ProjectDirectory: string read fProjectDirectory; property ProjectInfoFile: string read GetProjectInfoFile write SetProjectInfoFile; property PublishOptions: TPublishProjectOptions read FPublishOptions write FPublishOptions; property ProjResources: TProjectResources read GetProjResources; property RunParameterOptions: TRunParamsOptions read GetRunParameterOptions; property SourceDirectories: TFileReferenceList read GetSourceDirectories; property StateFileDate: longint read FStateFileDate write FStateFileDate; property StateFlags: TLazProjectStateFlags read FStateFlags write FStateFlags; property SessionStorePathDelim: TPathDelimSwitch read FSessionStorePathDelim write FSessionStorePathDelim; property StorePathDelim: TPathDelimSwitch read FStorePathDelim write SetStorePathDelim; property TargetFilename: string read GetTargetFilename write SetTargetFilename; property Units[Index: integer]: TUnitInfo read GetUnits; property OtherDefines: TStrings read FOtherDefines; property UpdateLock: integer read FUpdateLock; property UseAsDefault: Boolean read FUseAsDefault write FUseAsDefault; // for dialog only (used to store options once) end; const ResourceFileExt = '.lrs'; DefaultProjectOptionsFilename = 'projectoptions.xml'; DefaultProjectCompilerOptionsFilename = 'compileroptions.xml'; // old way < 0.9.31 OldProjectTypeNames : array[TOldProjectType] of string = ( 'Application', 'Program', 'Custom program' ); var Project1: TProject = nil;// the main project function AddCompileReasonsDiff(const PropertyName: string; const Old, New: TCompileReasons; Tool: TCompilerDiffTool = nil): boolean; function dbgs(aType: TUnitCompDependencyType): string; overload; function dbgs(Types: TUnitCompDependencyTypes): string; overload; function dbgs(Flag: TUnitInfoFlag): string; overload; function dbgs(Flags: TUnitInfoFlags): string; overload; implementation const ProjectInfoFileVersion = 10; ProjOptionsPath = 'ProjectOptions/'; function AddCompileReasonsDiff(const PropertyName: string; const Old, New: TCompileReasons; Tool: TCompilerDiffTool): boolean; begin if Old=New then exit(false); Result:=true; Tool.AddSetDiff(PropertyName,integer(Old),integer(New), PString(@CompileReasonNames[Low(TCompileReasons)])); end; function dbgs(aType: TUnitCompDependencyType): string; begin case aType of ucdtAncestor: Result:='Ancestor'; ucdtProperty: Result:='Property'; ucdtOldProperty: Result:='OldProperty'; ucdtInlineClass: Result:='InlineClass'; else Result:='?' end; end; function dbgs(Types: TUnitCompDependencyTypes): string; var t: TUnitCompDependencyType; begin Result:=''; for t:=low(Types) to High(Types) do if t in Types then begin if Result<>'' then Result:=Result+';'; Result:=Result+dbgs(t); end; Result:='['+Result+']'; end; function dbgs(Flag: TUnitInfoFlag): string; begin Result:=''; WriteStr(Result, Flag); end; function dbgs(Flags: TUnitInfoFlags): string; var f: TUnitInfoFlag; begin Result:=''; for f:=low(Flags) to High(Flags) do if f in Flags then begin if Result<>'' then Result:=Result+';'; Result:=Result+dbgs(f); end; Result:='['+Result+']'; end; { TUnitEditorInfo } procedure TUnitEditorInfo.SetEditorComponent(const AValue: TSourceEditorInterface); begin if FEditorComponent = AValue then exit; if AValue = nil then begin fUnitInfo.Project.FAllEditorsInfoMap.Delete(FEditorComponent); FEditorComponent := AValue; UnitInfo.FEditorInfoList.MakeUnUsedEditorInfo(Self); PageIndex := -1; // calls UnitInfo.UpdatePageIndex IsLocked := False; end else begin PageIndex := -1; with fUnitInfo.Project do // Map for lookup: Editor -> EditorInfo if not FAllEditorsInfoMap.HasId(AValue) then FAllEditorsInfoMap.Add(AValue, Self); FEditorComponent := AValue; UnitInfo.FEditorInfoList.MakeUsedEditorInfo(Self); AValue.UpdateProjectFile; // Set EditorIndex / calls UnitInfo.UpdatePageIndex end; FUnitInfo.SessionModified:=true; end; procedure TUnitEditorInfo.SetPageIndex(const AValue: Integer); begin if FPageIndex = AValue then exit; FPageIndex := AValue; FUnitInfo.UpdatePageIndex; FUnitInfo.SessionModified := True; end; procedure TUnitEditorInfo.SetFoldState(AValue: String); begin if FFoldState = AValue then Exit; FFoldState := AValue; FUnitInfo.SessionModified := True; end; procedure TUnitEditorInfo.SetIsVisibleTab(const AValue: Boolean); begin if FIsVisibleTab = AValue then exit; FIsVisibleTab := AValue; FUnitInfo.SessionModified := True; end; procedure TUnitEditorInfo.SetWindowIndex(const AValue: Integer); begin if FWindowID = AValue then exit; FWindowID := AValue; FUnitInfo.SessionModified := True; end; procedure TUnitEditorInfo.Clear; begin FIsVisibleTab := False; FPageIndex := -1; FWindowID := -1; FTopLine := -1; FCursorPos.X := -1; FCursorPos.Y := -1; FFoldState := ''; FSyntaxHighlighter := FUnitInfo.DefaultSyntaxHighlighter; FCustomHighlighter := FUnitInfo.CustomDefaultHighlighter; end; constructor TUnitEditorInfo.Create(aUnitInfo: TUnitInfo); begin FUnitInfo := aUnitInfo; Clear; if FUnitInfo.Project <> nil then FUnitInfo.Project.EditorInfoAdd(Self); end; destructor TUnitEditorInfo.Destroy; begin if FUnitInfo.Project <> nil then FUnitInfo.Project.EditorInfoRemove(Self); inherited Destroy; end; procedure TUnitEditorInfo.LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); begin IsVisibleTab := XMLConfig.GetValue(Path+'IsVisibleTab/Value', False); PageIndex := XMLConfig.GetValue(Path+'EditorIndex/Value',0); WindowID := XMLConfig.GetValue(Path+'WindowIndex/Value',0); // update old data if (FPageIndex >= 0) and (FWindowID < 0) then WindowID := 1; FTopLine := XMLConfig.GetValue(Path+'TopLine/Value',1); CursorPos := Point(XMLConfig.GetValue(Path+'CursorPos/X',1), XMLConfig.GetValue(Path+'CursorPos/Y',1)); FFoldState := XMLConfig.GetValue(Path+'FoldState/Value', ''); FIsLocked := XMLConfig.GetValue(Path+'IsLocked/Value', False); FSyntaxHighlighter := StrToLazSyntaxHighlighter( XMLConfig.GetValue(Path+'SyntaxHighlighter/Value', LazSyntaxHighlighterNames[UnitInfo.DefaultSyntaxHighlighter])); end; procedure TUnitEditorInfo.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; SaveFold: Boolean); begin XMLConfig.SetDeleteValue(Path+'IsVisibleTab/Value', FIsVisibleTab, False); XMLConfig.SetDeleteValue(Path+'EditorIndex/Value', FPageIndex, 0); XMLConfig.SetDeleteValue(Path+'WindowIndex/Value', FWindowID, 0); XMLConfig.SetDeleteValue(Path+'TopLine/Value', FTopLine, 1); XMLConfig.SetDeleteValue(Path+'CursorPos/X', FCursorPos.X, 1); XMLConfig.SetDeleteValue(Path+'CursorPos/Y', FCursorPos.Y, 1); XMLConfig.SetDeleteValue(Path+'IsLocked/Value', FIsLocked, False); if SaveFold then XMLConfig.SetDeleteValue(Path+'FoldState/Value', FoldState, '') else XMLConfig.DeletePath(Path+'FoldState'); XMLConfig.SetDeleteValue(Path+'SyntaxHighlighter/Value', LazSyntaxHighlighterNames[fSyntaxHighlighter], LazSyntaxHighlighterNames[UnitInfo.DefaultSyntaxHighlighter]); end; { TUnitEditorInfoList } function TUnitEditorInfoList.GetEditorInfos(Index: Integer): TUnitEditorInfo; begin Result := TUnitEditorInfo(FList[Index]); end; function TUnitEditorInfoList.GetClosedEditorInfos(Index: Integer): TUnitEditorInfo; var i: Integer; begin i := 0; while (i < Count) and (Index >= 0) do begin Result := EditorInfos[i]; if Result.EditorComponent = nil then dec(Index); inc(i); end; if Index >= 0 then Result := nil; end; function TUnitEditorInfoList.GetOpenEditorInfos(Index: Integer): TUnitEditorInfo; var i: Integer; begin i := 0; while (i < Count) and (Index >= 0) do begin Result := EditorInfos[i]; if Result.EditorComponent <> nil then dec(Index); inc(i); end; if Index >= 0 then Result := nil; end; procedure TUnitEditorInfoList.ClearEachInfo; var i: Integer; begin for i := 0 to Count - 1 do EditorInfos[i].Clear; end; function CompareEditorInfoByPageIndex(EditorInfo1, EditorInfo2: TUnitEditorInfo): integer; begin Result := EditorInfo1.WindowID - EditorInfo2.WindowID; if Result = 0 then Result := EditorInfo1.PageIndex - EditorInfo2.PageIndex; end; procedure TUnitEditorInfoList.SortByPageIndex; begin FList.Sort(TListSortCompare(@CompareEditorInfoByPageIndex)); end; procedure TUnitEditorInfoList.SetLastUsedEditor(AEditor: TSourceEditorInterface); var i: Integer; begin i := IndexOfEditorComponent(AEditor); if i <> 0 then FList.Move(i, 0); end; procedure TUnitEditorInfoList.MakeUsedEditorInfo(AEditorInfo: TUnitEditorInfo); var i, j: Integer; begin i := FList.IndexOf(AEditorInfo); j := OpenCount; if (i > j) and (j < Count) then FList.Move(i, j); end; procedure TUnitEditorInfoList.MakeUnUsedEditorInfo(AEditorInfo: TUnitEditorInfo); var i: Integer; begin i := FList.IndexOf(AEditorInfo); if i <> FList.Count - 1 then FList.Move(i, FList.Count - 1); end; procedure TUnitEditorInfoList.Clear; begin while Count > 0 do begin EditorInfos[0].Free; Delete(0); end; end; constructor TUnitEditorInfoList.Create(aUnitInfo: TUnitInfo); begin FUnitInfo := aUnitInfo; FList := TFPList.Create; end; destructor TUnitEditorInfoList.Destroy; begin Clear; FreeAndNil(FList); inherited Destroy; end; function TUnitEditorInfoList.Count: Integer; begin Result := FList.Count; end; function TUnitEditorInfoList.OpenCount: Integer; var i: Integer; begin i := Count - 1; Result := 0; while i >= 0 do begin if EditorInfos[i].EditorComponent <> nil then inc(Result); dec(i); end; end; function TUnitEditorInfoList.ClosedCount: Integer; var i: Integer; begin i := Count - 1; Result := 0; while i >= 0 do begin if EditorInfos[i].EditorComponent = nil then inc(Result); dec(i); end; end; function TUnitEditorInfoList.IndexOfEditorComponent(anEditor: TSourceEditorInterface): Integer; begin Result := Count - 1; while (Result >= 0) and (EditorInfos[Result].EditorComponent <> anEditor) do dec(Result); end; function TUnitEditorInfoList.NewEditorInfo: TUnitEditorInfo; begin Result := TUnitEditorInfo.Create(FUnitInfo); FList.Add(Result); end; procedure TUnitEditorInfoList.Add(AEditorInfo: TUnitEditorInfo); begin FList.Add(AEditorInfo); end; procedure TUnitEditorInfoList.Delete(Index: Integer); begin Flist.Delete(Index); end; procedure TUnitEditorInfoList.Remove(AEditorInfo: TUnitEditorInfo); var i: LongInt; begin i := FList.IndexOf(AEditorInfo); if i >= 0 then Delete(i); end; {------------------------------------------------------------------------------ TUnitInfo Constructor ------------------------------------------------------------------------------} constructor TUnitInfo.Create(ACodeBuffer: TCodeBuffer); begin inherited Create; //DebugLn('Trace:Project Unit Info Class Created'); FEditorInfoList := TUnitEditorInfoList.Create(Self); FEditorInfoList.NewEditorInfo; FBookmarks:=TFileBookmarks.Create; Clear; Source := ACodeBuffer; if Source=nil then FFileName:=''; end; {------------------------------------------------------------------------------ TUnitInfo Destructor ------------------------------------------------------------------------------} destructor TUnitInfo.Destroy; begin Component:=nil; Source:=nil; FreeAndNil(FBookmarks); Project:=nil; FreeAndNil(FEditorInfoList); FreeAndNil(FComponentFallbackClasses); inherited Destroy; end; function TUnitInfo.GetFileOwner: TObject; begin Result:=Project; end; function TUnitInfo.GetFileOwnerName: string; begin if Project<>nil then Result:=ExtractFilename(Project.ProjectInfoFile) else Result:=''; end; {------------------------------------------------------------------------------ TUnitInfo WriteUnitSource ------------------------------------------------------------------------------} function TUnitInfo.WriteUnitSource: TModalResult; var ACaption:string; AText:string; begin if fSource=nil then begin Result:=mrOk; exit; end; if Assigned(fOnFileBackup) then begin Result:=fOnFileBackup(Filename); if Result=mrAbort then exit; end; repeat if not fSource.Save then begin ACaption:=lisCodeToolsDefsWriteError; AText:=Format(lisUnableToWriteFile2, [Filename]); Result:=IDEMessageDialog(ACaption,AText,mtError,mbAbortRetryIgnore); if Result=mrAbort then exit; if Result=mrIgnore then Result:=mrOk; end else begin Result:=mrOk; FIgnoreFileDateOnDiskValid:=true; end; until Result<>mrRetry; Result:=mrOk; end; function TUnitInfo.WriteUnitSourceToFile(const AFileName: string): TModalResult; var ACaption:string; AText:string; begin if fSource=nil then begin Result:=mrOk; exit; end; if Assigned(fOnFileBackup) then begin Result:=fOnFileBackup(AFilename); if Result=mrAbort then exit; end; repeat if not fSource.SaveToFile(AFileName) then begin ACaption:=lisCodeToolsDefsWriteError; AText:=Format(lisUnableToWriteFile2, [AFilename]); Result:=IDEMessageDialog(ACaption,AText,mtError,mbAbortRetryIgnore); if Result=mrAbort then exit; if Result=mrIgnore then Result:=mrOk; end else Result:=mrOk; until Result<>mrRetry; Result:=mrOk; end; {------------------------------------------------------------------------------ TUnitInfo ReadUnitSource ------------------------------------------------------------------------------} function TUnitInfo.ReadUnitSource(ReadUnitName,Revert:boolean): TModalResult; var ACaption:string; AText:string; NewSource: TCodeBuffer; begin repeat NewSource:=CodeToolBoss.LoadFile(Filename,true,Revert); if NewSource=nil then begin ACaption:=lisCodeToolsDefsReadError; AText:=Format(lisUnableToReadFile2, [Filename]); Result:=IDEMessageDialog(ACaption,AText,mtError,mbAbortRetryIgnore); if Result in [mrAbort,mrIgnore] then exit; end else begin Source:=NewSource; FIgnoreFileDateOnDiskValid:=true; Result:=mrOk; end; until Result<>mrRetry; if ReadUnitName then begin ReadUnitNameFromSource(false); end; Result:=mrOk; end; function TUnitInfo.ReadUnitNameFromSource(TryCache: boolean): string; begin Result:=''; if TryCache then Result:=CodeToolBoss.GetCachedSourceName(Source); if Result='' then Result:=CodeToolBoss.GetSourceName(fSource,false); if Result<>'' then begin // source can be parsed => update SrcUnitName {$IFDEF VerboseIDESrcUnitName} if CompareFilenames(ExtractFileNameOnly(Filename),'interpkgconflictfiles')=0 then debugln(['TUnitInfo.ReadUnitNameFromSource ',Result]); {$ENDIF} fSrcUnitName:=Result; end else begin // unable to parse the source if FilenameIsPascalSource(Filename) then begin // use default: the filename Result:=ExtractFileNameOnly(Filename); if CompareText(Result,fSrcUnitName)=0 then begin // the last stored unitname has the better case Result:=SrcUnitName; end; end; end; end; function TUnitInfo.GetUsesUnitName: string; begin if not FilenameIsPascalUnit(Filename) then Result:='' else begin Result:=SrcUnitName; if (Result='') or (CompareText(Result,ExtractFileNameOnly(Filename))<>0) then Result:=ExtractFileNameOnly(Filename); end; end; function TUnitInfo.CreateUnitName: string; begin Result:=SrcUnitName; if (Result='') and FilenameIsPascalSource(Filename) then Result:=ExtractFilenameOnly(Filename); end; {------------------------------------------------------------------------------ TUnitInfo Clear ------------------------------------------------------------------------------} procedure TUnitInfo.Clear; begin FBookmarks.Clear; FSetBookmarLock := 0; FBuildFileIfActive:=false; fComponent := nil; fComponentName := ''; fComponentResourceName := ''; FComponentState := wsNormal; FDefaultSyntaxHighlighter := lshText; FDisableI18NForLFM:=false; FCustomDefaultHighlighter := False; FEditorInfoList.ClearEachInfo; fFilename := ''; fFileReadOnly := false; fHasResources := false; FIgnoreFileDateOnDiskValid := false; fAutoReferenceSourceDir := true; inherited SetIsPartOfProject(false); Modified := false; SessionModified := false; FRunFileIfActive:=false; fSrcUnitName := ''; fUsageCount:=-1; fUserReadOnly := false; if fSource<>nil then fSource.Clear; Loaded := false; LoadedDesigner := false; ClearComponentDependencies; end; procedure TUnitInfo.ClearModifieds; begin Modified:=false; SessionModified:=false; end; procedure TUnitInfo.ClearComponentDependencies; begin while FFirstRequiredComponent<>nil do FFirstRequiredComponent.Free; while FFirstUsedByComponent<>nil do FFirstUsedByComponent.Free; end; procedure TUnitInfo.WriteDebugReportUnitComponentDependencies(Prefix: string); var Dependency: TUnitComponentDependency; begin DebugLn([Prefix+'TUnitInfo.WriteDebugReportUnitComponentDependencies ',Filename,' ',dbgs(Flags)]); Dependency:=FirstRequiredComponent; if Dependency<>nil then begin DebugLn([Prefix+' Requires: >>> ']); while Dependency<>nil do begin DebugLn([Prefix+' '+Dependency.RequiresUnit.Filename+' '+dbgs(Dependency.Types)]); Dependency:=Dependency.NextRequiresDependency; end; end; Dependency:=FirstUsedByComponent; if Dependency<>nil then begin DebugLn([Prefix+' UsedBy: <<<']); while Dependency<>nil do begin DebugLn([Prefix+' '+Dependency.UsedByUnit.Filename+' '+dbgs(Dependency.Types)]); Dependency:=Dependency.NextUsedByDependency; end; end; end; {------------------------------------------------------------------------------ TUnitInfo SaveToXMLConfig ------------------------------------------------------------------------------} procedure TUnitInfo.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; SaveData, SaveSession: boolean; UsePathDelim: TPathDelimSwitch); var AFilename: String; i, X, Y: Integer; s: String; begin // global data AFilename:=Filename; if Assigned(fOnLoadSaveFilename) then fOnLoadSaveFilename(AFilename, False); XMLConfig.SetValue(Path+'Filename/Value',SwitchPathDelims(AFilename,UsePathDelim)); if SaveData then XMLConfig.SetDeleteValue(Path+'IsPartOfProject/Value',IsPartOfProject,false); if SaveSession and Assigned(Project.OnSaveUnitSessionInfo) then Project.OnSaveUnitSessionInfo(Self); if IsPartOfProject and SaveData then XMLConfig.SetDeleteValue(Path+'DisableI18NForLFM/Value',FDisableI18NForLFM,false); // context data (project/session) if (IsPartOfProject and SaveData) or ((not IsPartOfProject) and SaveSession) then begin XMLConfig.SetDeleteValue(Path+'ComponentName/Value',fComponentName,''); XMLConfig.SetDeleteValue(Path+'HasResources/Value',fHasResources,false); XMLConfig.SetDeleteValue(Path+'ResourceBaseClass/Value', PFComponentBaseClassNames[FResourceBaseClass], PFComponentBaseClassNames[pfcbcNone]); s:=fSrcUnitName; if (s<>'') and (ExtractFileNameOnly(Filename)=s) then s:=''; // only save if SrcUnitName differ from filename XMLConfig.SetDeleteValue(Path+'UnitName/Value',s,''); // save custom data SaveStringToStringTree(XMLConfig,CustomData,Path+'CustomData/'); end; // session data if SaveSession then begin FEditorInfoList[0].SaveToXMLConfig(XMLConfig, Path, pfSaveFoldState in Project.Flags); XMLConfig.SetDeleteValue(Path+'ExtraEditorCount/Value', FEditorInfoList.Count-1, 0); for i := 1 to FEditorInfoList.Count - 1 do FEditorInfoList[i].SaveToXMLConfig(XMLConfig, Path + 'ExtraEditor'+IntToStr(i)+'/', pfSaveFoldState in Project.Flags); XMLConfig.SetDeleteValue(Path+'ComponentState/Value',Ord(FComponentState),0); XMLConfig.SetDeleteValue(Path+'UsageCount/Value',RoundToInt(fUsageCount),-1); if OpenEditorInfoCount > 0 then for i := Bookmarks.Count - 1 downto 0 do begin if (Project.Bookmarks.BookmarkWithID(Bookmarks[i].ID) = nil) or (Project.Bookmarks.BookmarkWithID(Bookmarks[i].ID).UnitInfo <> self) then Bookmarks.Delete(i) else if TSynEdit(OpenEditorInfo[0].EditorComponent.EditorControl).GetBookMark(Bookmarks[i].ID, X{%H-}, Y{%H-}) then Bookmarks[i].CursorPos := Point(X, Y); end; FBookmarks.SaveToXMLConfig(XMLConfig,Path+'Bookmarks/'); XMLConfig.SetDeleteValue(Path+'Loaded/Value',fLoaded,false); XMLConfig.SetDeleteValue(Path+'LoadedDesigner/Value',fLoadedDesigner,false); XMLConfig.SetDeleteValue(Path+'ReadOnly/Value',fUserReadOnly,false); XMLConfig.SetDeleteValue(Path+'BuildFileIfActive/Value', FBuildFileIfActive,false); XMLConfig.SetDeleteValue(Path+'RunFileIfActive/Value', FRunFileIfActive,false); // save custom session data SaveStringToStringTree(XMLConfig,CustomSessionData,Path+'CustomSessionData/'); XMLConfig.SetDeleteValue(Path+'DefaultSyntaxHighlighter/Value', LazSyntaxHighlighterNames[FDefaultSyntaxHighlighter], LazSyntaxHighlighterNames[lshFreePascal]); end; end; {------------------------------------------------------------------------------ TUnitInfo LoadFromXMLConfig ------------------------------------------------------------------------------} procedure TUnitInfo.LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; Merge, IgnoreIsPartOfProject: boolean; FileVersion: integer); var AFilename: string; c, i: Integer; begin // project data if not Merge then begin AFilename:=XMLConfig.GetValue(Path+'Filename/Value',''); if Assigned(fOnLoadSaveFilename) then fOnLoadSaveFilename(AFilename,true); fFilename:=AFilename; fComponentName:=XMLConfig.GetValue(Path+'ComponentName/Value',''); if fComponentName='' then fComponentName:=XMLConfig.GetValue(Path+'FormName/Value',''); FComponentState := TWindowState(XMLConfig.GetValue(Path+'ComponentState/Value',0)); FDisableI18NForLFM:=XMLConfig.GetValue(Path+'DisableI18NForLFM/Value',false); HasResources:=XMLConfig.GetValue(Path+'HasResources/Value',false); FResourceBaseClass:=StrToComponentBaseClass( XMLConfig.GetValue(Path+'ResourceBaseClass/Value','')); if not IgnoreIsPartOfProject then IsPartOfProject:=XMLConfig.GetValue(Path+'IsPartOfProject/Value',false); AFilename:=XMLConfig.GetValue(Path+'ResourceFilename/Value',''); if (AFilename<>'') and Assigned(fOnLoadSaveFilename) then fOnLoadSaveFilename(AFilename,true); if FilenameIsPascalSource(Filename) then begin fSrcUnitName:=XMLConfig.GetValue(Path+'UnitName/Value',''); if fSrcUnitName='' then fSrcUnitName:=ExtractFileNameOnly(Filename); {$IFDEF VerboseIDESrcUnitName} if CompareFilenames(ExtractFileNameOnly(Filename),'interpkgconflictfiles')=0 then debugln(['TUnitInfo.LoadFromXMLConfig ',fSrcUnitName]); {$ENDIF} end else fSrcUnitName:=''; // save custom data LoadStringToStringTree(XMLConfig,CustomData,Path+'CustomData/'); end; // session data FDefaultSyntaxHighlighter := StrToLazSyntaxHighlighter( XMLConfig.GetValue(Path+'DefaultSyntaxHighlighter/Value', LazSyntaxHighlighterNames[lshFreePascal])); FEditorInfoList.Clear; FEditorInfoList.NewEditorInfo; FEditorInfoList[0].LoadFromXMLConfig(XMLConfig, Path); c := XMLConfig.GetValue(Path+'ExtraEditorCount/Value', 0); for i := 1 to c do FEditorInfoList.NewEditorInfo.LoadFromXMLConfig(XMLConfig, Path + 'ExtraEditor'+IntToStr(i)+'/'); Loaded:=XMLConfig.GetValue(Path+'Loaded/Value',false); if Loaded then LoadedDesigner:=XMLConfig.GetValue(Path+'LoadedDesigner/Value',FileVersion<8) else LoadedDesigner:=false; fUserReadOnly:=XMLConfig.GetValue(Path+'ReadOnly/Value',false); FBuildFileIfActive:=XMLConfig.GetValue(Path+'BuildFileIfActive/Value', false); FRunFileIfActive:=XMLConfig.GetValue(Path+'RunFileIfActive/Value',false); fUsageCount:=XMLConfig.GetValue(Path+'UsageCount/Value',-1); if fUsageCount<1 then begin UpdateUsageCount(uuIsLoaded,1); if IsPartOfProject then UpdateUsageCount(uuIsPartOfProject,1); end; FBookmarks.LoadFromXMLConfig(XMLConfig,Path+'Bookmarks/'); // load custom session data LoadStringToStringTree(XMLConfig,CustomSessionData,Path+'CustomSessionData/'); end; procedure TUnitInfo.SetSrcUnitName(const NewUnitName:string); var Allowed: boolean; OldUnitName: String; begin if (fSrcUnitName <> NewUnitName) and (NewUnitName <> '') then begin Allowed := true; OldUnitName := fSrcUnitName; if OldUnitName = '' then OldUnitName := ExtractFileNameOnly(Filename); if Assigned(FOnUnitNameChange) then FOnUnitNameChange(Self, OldUnitName, NewUnitName, false, Allowed); // (ignore Allowed) if (fSource <> nil) then begin CodeToolBoss.RenameSource(fSource,NewUnitName); end; {$IFDEF VerboseIDESrcUnitName} if CompareFilenames(ExtractFileNameOnly(Filename),'interpkgconflictfiles')=0 then debugln(['TUnitInfo.SetSrcUnitName ',NewUnitName]); {$ENDIF} fSrcUnitName := NewUnitName; Modified := true; if (Project <> nil) then Project.UnitModified(Self); end; end; procedure TUnitInfo.UpdateList(ListType: TUnitInfoList; Add: boolean); begin if Project<>nil then begin if Add then Project.AddToList(Self,ListType) else Project.RemoveFromList(Self,ListType); end else begin fNext[ListType]:=nil; fPrev[ListType]:=nil; end; end; procedure TUnitInfo.SetInternalFilename(const NewFilename: string); begin if fFileName=NewFilename then exit; //DebugLn('TUnitInfo.SetInternalFilename Old=',fFileName,' New=',NewFilename); // if directory changed then remove the old directory reference if SourceDirectoryReferenced and (Project<>nil) and (fLastDirectoryReferenced<>GetDirectory) then begin Project.SourceDirectories.RemoveFilename(fLastDirectoryReferenced); FSourceDirectoryReferenced:=false; end; fFileName:=NewFilename; if EditorOpts<>nil then UpdateDefaultHighlighter(FilenameToLazSyntaxHighlighter(FFilename)); UpdateSourceDirectoryReference; end; procedure TUnitInfo.UpdateHasCustomHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter); var i: Integer; begin FCustomDefaultHighlighter := FDefaultSyntaxHighlighter <> aDefaultHighlighter; for i := 0 to FEditorInfoList.Count - 1 do FEditorInfoList[i].CustomHighlighter := FEditorInfoList[i].SyntaxHighlighter <> aDefaultHighlighter; end; procedure TUnitInfo.UpdatePageIndex; var HasPageIndex: Boolean; BookmarkID, i, j: integer; begin HasPageIndex := False; i := FEditorInfoList.Count - 1; while (i >= 0) and not HasPageIndex do begin if EditorInfo[i].PageIndex >= 0 then HasPageIndex := True; dec(i); end; UpdateList(uilWithEditorIndex, HasPageIndex); if assigned(Project1) and assigned(Project1.Bookmarks) then begin if OpenEditorInfoCount > 0 then begin inc(FSetBookmarLock); try // Adjust bookmarks for i := Bookmarks.Count - 1 downto 0 do begin BookmarkID := Bookmarks[i].ID; j := Project1.Bookmarks.IndexOfID(BookmarkID); if (j < 0) then TSynEdit(OpenEditorInfo[0].EditorComponent.EditorControl).SetBookMark(BookmarkID, Bookmarks[i].CursorPos.X, Bookmarks[i].CursorPos.Y); end; finally dec(FSetBookmarLock); end; end else // OpenEditorInfoCount = 0 Project1.Bookmarks.DeleteAllWithUnitInfo(Self); end; end; procedure TUnitInfo.UpdateDefaultHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter); var i: Integer; begin //debugln(['TUnitInfo.UpdateDefaultHighlighter ',Filename,' ',ord(aDefaultHighlighter)]); if not FCustomDefaultHighlighter then DefaultSyntaxHighlighter := aDefaultHighlighter else for i := 0 to FEditorInfoList.Count - 1 do if not FEditorInfoList[i].CustomHighlighter then FEditorInfoList[i].SyntaxHighlighter := aDefaultHighlighter; end; function TUnitInfo.GetFileName: string; begin if fSource<>nil then Result:=fSource.Filename else Result:=fFileName; end; procedure TUnitInfo.SetFilename(const AValue: string); begin if fSource<>nil then RaiseException('TUnitInfo.SetFilename Source<>nil') else SetInternalFilename(AValue); end; function TUnitInfo.IsVirtual: boolean; begin if fSource<>nil then Result:=fSource.IsVirtual else Result:=not FilenameIsAbsolute(fFileName); end; function TUnitInfo.GetDirectory: string; begin if IsVirtual then begin if Project<>nil then Result:=Project.ProjectDirectory else Result:=''; end else begin Result:=ExtractFilePath(Filename); end; end; function TUnitInfo.GetFullFilename: string; begin Result:=fFilename; // not saved files have file names without path // they exist in the Codetools filename space end; function TUnitInfo.GetShortFilename(UseUp: boolean): string; begin if Project<>nil then Result:=Project.GetShortFilename(Filename,UseUp) else Result:=Filename; end; function TUnitInfo.IsMainUnit: boolean; begin Result:=(Project<>nil) and (Project.MainUnitInfo=Self); end; procedure TUnitInfo.IncreaseAutoRevertLock; begin inc(fAutoRevertLockCount); if (fAutoRevertLockCount=1) then begin // activate lock if (Source<>nil) then Source.LockAutoDiskRevert; if Project<>nil then Project.AddToOrRemoveFromAutoRevertLockedList(Self); end; end; procedure TUnitInfo.DecreaseAutoRevertLock; begin dec(fAutoRevertLockCount); if (fAutoRevertLockCount=0) then begin // deactivate lock if (Source<>nil) then Source.LockAutoDiskRevert; if Project<>nil then Project.AddToOrRemoveFromAutoRevertLockedList(Self); end; end; function TUnitInfo.IsAutoRevertLocked: boolean; begin Result:=fAutoRevertLockCount>0; end; function TUnitInfo.IsReverting: boolean; begin Result:=FRevertLockCount>0; end; function TUnitInfo.ChangedOnDisk(CompareOnlyLoadSaveTime: boolean): boolean; begin Result:=(Source<>nil) and Source.FileOnDiskHasChanged; //if Result then debugln(['TUnitInfo.ChangedOnDisk ',Filename,' FileAgeCached=',FileAgeCached(Source.Filename)]); if Result and (not CompareOnlyLoadSaveTime) and FIgnoreFileDateOnDiskValid and (FIgnoreFileDateOnDisk=Source.FileDateOnDisk) then Result:=false; if (not IsVirtual) and FileExistsCached(Filename) then FileReadOnly:=not FileIsWritableCached(Filename) else FileReadOnly:=false; end; procedure TUnitInfo.IgnoreCurrentFileDateOnDisk; begin if Source<>nil then begin FIgnoreFileDateOnDiskValid:=true; FIgnoreFileDateOnDisk:=Source.FileDateOnDisk; end end; function TUnitInfo.ShortFilename: string; begin if Project<>nil then begin Result:=Project.RemoveProjectPathFromFilename(Filename); end else begin Result:=Filename; end; end; function TUnitInfo.NeedsSaveToDisk: boolean; begin Result:=IsVirtual or Modified or ChangedOnDisk(true); //DebugLn(['TUnitInfo.NeedsSaveToDisk ',filename,' Result=',Result,' Modified=',Modified]); if not Result then begin if Source<>nil then Result:=Source.FileOnDiskNeedsUpdate else Result:=not FileExistsUTF8(Filename); end; end; procedure TUnitInfo.UpdateUsageCount(Min, IfBelowThis, IncIfBelow: extended); begin if fUsageCountnil do begin if Result.RequiresUnit=RequiredUnit then break; Result:=Result.NextRequiresDependency; end; // if none exists, then create one if Result=nil then begin Result:=TUnitComponentDependency.Create; Result.UsedByUnit:=Self; Result.RequiresUnit:=RequiredUnit; end; Result.Types:=Result.Types+Types; end; procedure TUnitInfo.RemoveRequiresComponentDependency(RequiredUnit: TUnitInfo; Types: TUnitCompDependencyTypes); var Dependency: TUnitComponentDependency; NextDependency: TUnitComponentDependency; begin Dependency:=FirstRequiredComponent; while Dependency<>nil do begin NextDependency:=Dependency.NextRequiresDependency; if (Dependency.RequiresUnit=RequiredUnit) then begin Dependency.Types:=Dependency.Types-Types; if Dependency.Types=[] then Dependency.Free; end; Dependency:=NextDependency; end; end; function TUnitInfo.FindComponentDependency(RequiredUnit: TUnitInfo ): TUnitComponentDependency; begin Result:=FirstRequiredComponent; while Result<>nil do begin if Result.RequiresUnit=RequiredUnit then exit; Result:=Result.NextRequiresDependency; end; end; function TUnitInfo.FindRequiredComponentDependency( MinTypes: TUnitCompDependencyTypes): TUnitComponentDependency; begin Result:=FirstRequiredComponent; while Result<>nil do begin if Result.Types*MinTypes=MinTypes then exit; Result:=Result.NextRequiresDependency; end; end; function TUnitInfo.FindUsedByComponentDependency( MinTypes: TUnitCompDependencyTypes): TUnitComponentDependency; begin Result:=FirstUsedByComponent; while Result<>nil do begin if Result.Types*MinTypes=MinTypes then exit; Result:=Result.NextUsedByDependency; end; end; function TUnitInfo.FindAncestorUnit: TUnitInfo; var Dependency: TUnitComponentDependency; begin if Component<>nil then begin Dependency:=FirstRequiredComponent; while Dependency<>nil do begin Result:=Dependency.RequiresUnit; if (Result.Component<>nil) and (Component.ClassParent=Result.Component.ClassType) then exit; Dependency:=Dependency.NextRequiresDependency; end; end; Result:=nil; end; procedure TUnitInfo.ClearUnitComponentDependencies( ClearTypes: TUnitCompDependencyTypes); var Dep: TUnitComponentDependency; NextDep: TUnitComponentDependency; begin Dep:=FirstRequiredComponent; while Dep<>nil do begin NextDep:=Dep.NextRequiresDependency; Dep.Types:=Dep.Types-ClearTypes; if Dep.Types=[] then Dep.Free; Dep:=NextDep; end; end; function TUnitInfo.AddBookmark(X, Y, ID: integer): integer; begin if FSetBookmarLock = 0 then Result := Bookmarks.Add(X, Y, ID) else Result := -1; SessionModified := True; Project1.AddBookmark(X, Y, ID, Self); end; procedure TUnitInfo.DeleteBookmark(ID: integer); var i: Integer; begin i := Bookmarks.IndexOfID(ID); if i >= 0 then begin Bookmarks.Delete(i); SessionModified := True; end; Project1.DeleteBookmark(ID); end; function TUnitInfo.EditorInfoCount: Integer; begin Result := FEditorInfoList.Count; end; function TUnitInfo.OpenEditorInfoCount: Integer; begin Result := FEditorInfoList.OpenCount; end; function TUnitInfo.GetClosedOrNewEditorInfo: TUnitEditorInfo; begin if FEditorInfoList.ClosedCount > 0 then Result := FEditorInfoList.ClosedEditorInfos[0] else Result := FEditorInfoList.NewEditorInfo; end; procedure TUnitInfo.SetLastUsedEditor(AEditor: TSourceEditorInterface); begin FEditorInfoList.SetLastUsedEditor(AEditor); end; function TUnitInfo.ReadOnly: boolean; begin Result:=UserReadOnly or FileReadOnly; end; procedure TUnitInfo.SetSource(ABuffer: TCodeBuffer); begin if fSource=ABuffer then begin if fSource<>nil then fSourceChangeStep:=FSource.ChangeStep; exit; end; if (fSource<>nil) and IsAutoRevertLocked then fSource.UnlockAutoDiskRevert; fSource:=ABuffer; FIgnoreFileDateOnDiskValid:=false; if (fSource<>nil) then begin fSourceChangeStep:=FSource.ChangeStep; if IsAutoRevertLocked then fSource.LockAutoDiskRevert; SetInternalFilename(fSource.FileName); if (fProject<>nil) and (fProject.MainUnitInfo=Self) then fProject.MainSourceFilenameChanged; end; end; procedure TUnitInfo.SetUserReadOnly(const NewValue: boolean); begin fUserReadOnly:=NewValue; if fSource<>nil then fSource.ReadOnly:=ReadOnly; end; function TUnitInfo.GetHasResources:boolean; begin Result:=fHasResources or (ComponentName<>''); end; function TUnitInfo.GetEditorInfo(Index: Integer): TUnitEditorInfo; begin Result := FEditorInfoList[Index]; end; function TUnitInfo.GetModified: boolean; begin Result:=fModified or ((Source<>nil) and (Source.ChangeStep<>fSourceChangeStep)); end; function TUnitInfo.GetNextAutoRevertLockedUnit: TUnitInfo; begin Result:=fNext[uilAutoRevertLocked]; end; function TUnitInfo.GetNextLoadedUnit: TUnitInfo; begin Result:=fNext[uilLoaded]; end; function TUnitInfo.GetNextPartOfProject: TUnitInfo; begin Result:=fNext[uilPartOfProject]; end; function TUnitInfo.GetNextUnitWithComponent: TUnitInfo; begin Result:=fNext[uilWithComponent]; end; function TUnitInfo.GetNextUnitWithEditorIndex: TUnitInfo; begin Result:=fNext[uilWithEditorIndex]; end; function TUnitInfo.GetOpenEditorInfo(Index: Integer): TUnitEditorInfo; begin Result := FEditorInfoList.OpenEditorInfos[Index]; end; function TUnitInfo.GetPrevAutoRevertLockedUnit: TUnitInfo; begin Result:=fPrev[uilAutoRevertLocked]; end; function TUnitInfo.GetPrevLoadedUnit: TUnitInfo; begin Result:=fPrev[uilLoaded]; end; function TUnitInfo.GetPrevPartOfProject: TUnitInfo; begin Result:=fPrev[uilPartOfProject]; end; function TUnitInfo.GetPrevUnitWithComponent: TUnitInfo; begin Result:=fPrev[uilWithComponent]; end; function TUnitInfo.GetPrevUnitWithEditorIndex: TUnitInfo; begin Result:=fPrev[uilWithEditorIndex]; end; function TUnitInfo.GetUnitResourceFileformat: TUnitResourcefileFormatClass; var ResourceFormats : TUnitResourcefileFormatArr; i: integer; begin if not assigned(FUnitResourceFileformat) then begin if Source=nil then Source:=CodeToolBoss.LoadFile(Filename,true,false); if Source<>nil then begin ResourceFormats := GetUnitResourcefileFormats; for i := 0 to high(ResourceFormats) do begin if ResourceFormats[i].FindResourceDirective(Source) then begin FUnitResourceFileformat:=ResourceFormats[i]; Result := FUnitResourceFileformat; Exit; end; end; end; FUnitResourceFileformat := LFMUnitResourcefileFormat; end; Result := FUnitResourceFileformat; end; procedure TUnitInfo.SetAutoReferenceSourceDir(const AValue: boolean); begin if FAutoReferenceSourceDir=AValue then exit; FAutoReferenceSourceDir:=AValue; UpdateSourceDirectoryReference; end; procedure TUnitInfo.SetBuildFileIfActive(const AValue: boolean); begin if FBuildFileIfActive=AValue then exit; FBuildFileIfActive:=AValue; SessionModified:=true; end; procedure TUnitInfo.SetDefaultSyntaxHighlighter(const AValue: TLazSyntaxHighlighter); var i: Integer; begin if FDefaultSyntaxHighlighter = AValue then exit; FDefaultSyntaxHighlighter := AValue; for i := 0 to FEditorInfoList.Count - 1 do if not FEditorInfoList[i].CustomHighlighter then FEditorInfoList[i].SyntaxHighlighter := AValue; end; procedure TUnitInfo.SetDirectives(const AValue: TStrings); begin if FDirectives=AValue then exit; FDirectives:=AValue; end; procedure TUnitInfo.SetDisableI18NForLFM(const AValue: boolean); begin if FDisableI18NForLFM=AValue then exit; FDisableI18NForLFM:=AValue; Modified:=true; end; procedure TUnitInfo.SetFileReadOnly(const AValue: Boolean); begin if fFileReadOnly=AValue then exit; fFileReadOnly:=AValue; if fSource<>nil then fSource.ReadOnly:=ReadOnly; SessionModified:=true; end; procedure TUnitInfo.SetComponent(const AValue: TComponent); begin if fComponent=AValue then exit; fComponent:=AValue; UpdateList(uilWithComponent,fComponent<>nil); if fComponent=nil then ClearComponentDependencies else FResourceBaseClass:=GetComponentBaseClass(fComponent.ClassType); end; procedure TUnitInfo.SetIsPartOfProject(const AValue: boolean); begin if IsPartOfProject=AValue then exit; if Project<>nil then Project.BeginUpdate(true); inherited SetIsPartOfProject(AValue); Modified:=true; UpdateList(uilPartOfProject,IsPartOfProject); if IsPartOfProject then UpdateUsageCount(uuIsPartOfProject,0); UpdateSourceDirectoryReference; if Project<>nil then Project.EndUpdate; end; {------------------------------------------------------------------------------- procedure TUnitInfo.SetLoaded(const AValue: Boolean); Loaded is a flag, that is set, when a unit has finished loading into the editor. It is saved to the project session file and a loaded unit will be reloaded, when the project is opened. -------------------------------------------------------------------------------} procedure TUnitInfo.SetLoaded(const AValue: Boolean); begin if fLoaded=AValue then exit; fLoaded:=AValue; if fLoaded then begin IncreaseAutoRevertLock; UpdateUsageCount(uuIsLoaded,0); end else begin DecreaseAutoRevertLock; end; end; {------------------------------------------------------------------------------- procedure TUnitInfo.SetLoadedDesigner(const AValue: Boolean); LoadedDesigner is a flag, that is set, when a visible designer form has finished opening. It is saved to the project session file and a designer is restored, when the project is opened and the IDE form editor option auto open designer forms is enabled. -------------------------------------------------------------------------------} procedure TUnitInfo.SetLoadedDesigner(const AValue: Boolean); begin if fLoadedDesigner=AValue then exit; fLoadedDesigner:=AValue; end; procedure TUnitInfo.SetModified(const AValue: boolean); begin if Modified=AValue then exit; {$IFDEF VerboseIDEModified} debugln(['TUnitInfo.SetModified ',Filename,' new Modified=',AValue]); {$ENDIF} fModified:=AValue; if (not fModified) and Assigned(Source) then fSourceChangeStep:=Source.ChangeStep; end; procedure TUnitInfo.SetProject(const AValue: TProject); var ListType: TUnitInfoList; i: Integer; begin if FProject=AValue then exit; if FProject<>nil then begin for ListType:=Low(TUnitInfoList) to High(TUnitInfoList) do Project.RemoveFromList(Self,ListType); for i := 0 to FEditorInfoList.Count - 1 do FProject.EditorInfoRemove(FEditorInfoList[i]); end; FProject:=AValue; if FProject<>nil then begin UpdatePageIndex; if Component<>nil then Project.AddToList(Self,uilWithComponent); if Loaded then Project.AddToList(Self,uilLoaded); if IsAutoRevertLocked then Project.AddToList(Self,uilAutoRevertLocked); if IsPartOfProject then Project.AddToList(Self,uilPartOfProject); for i := 0 to FEditorInfoList.Count - 1 do FProject.EditorInfoAdd(FEditorInfoList[i]); end; UpdateSourceDirectoryReference; end; procedure TUnitInfo.SetRunFileIfActive(const AValue: boolean); begin if FRunFileIfActive=AValue then exit; FRunFileIfActive:=AValue; SessionModified:=true; end; procedure TUnitInfo.SetSessionModified(const AValue: boolean); begin if FSessionModified=AValue then exit; {$IFDEF VerboseIDEModified} debugln(['TUnitInfo.SetSessionModified ',Filename,' new Modified=',AValue]); {$ENDIF} FSessionModified:=AValue; end; { TProjectIDEOptions } constructor TProjectIDEOptions.Create(AProject: TProject); begin inherited Create; FProject := AProject; end; destructor TProjectIDEOptions.Destroy; begin inherited Destroy; end; class function TProjectIDEOptions.GetInstance: TAbstractIDEOptions; begin if Project1<>nil then Result := Project1.IDEOptions else Result := nil; end; class function TProjectIDEOptions.GetGroupCaption: string; begin Result := dlgProjectOptions; end; {------------------------------------------------------------------------------ TProject Class ------------------------------------------------------------------------------} {------------------------------------------------------------------------------ TProject Constructor ------------------------------------------------------------------------------} constructor TProject.Create(ProjectDescription: TProjectDescriptor); begin inherited Create(ProjectDescription); FActiveWindowIndexAtStart := 0; FSkipCheckLCLInterfaces:=false; FAutoCreateForms := true; FAllEditorsInfoList := TUnitEditorInfoList.Create(nil); FAllEditorsInfoMap := TMap.Create(ituPtrSize, SizeOf(TObject)); FBookmarks := TProjectBookmarkList.Create; FMacroEngine:=TTransferMacroList.Create; FMacroEngine.OnSubstitution:=@OnMacroEngineSubstitution; FBuildModes:=TProjectBuildModes.Create(nil); FBuildModes.LazProject:=Self; FBuildModesBackup:=TProjectBuildModes.Create(nil); FBuildModesBackup.LazProject:=Self; ActiveBuildMode:=FBuildModes.Add('Default'); FDefineTemplates:=TProjectDefineTemplates.Create(Self); FFlags:=DefaultProjectFlags; FJumpHistory:=TProjectJumpHistory.Create; FJumpHistory.OnCheckPosition:=@JumpHistoryCheckPosition; FJumpHistory.OnLoadSaveFilename:=@OnLoadSaveFilename; fMainUnitID := -1; fProjectInfoFile := ''; ProjectSessionFile:=''; FSourceDirectories:=TFileReferenceList.Create; FSourceDirectories.OnChanged:=@SourceDirectoriesChanged; UpdateProjectDirectory; FIDEOptions:=TProjectIDEOptions.Create(Self); FPublishOptions:=TPublishProjectOptions.Create(Self); FRunParameters:=TRunParamsOptions.Create; Title := ''; FUnitList := TFPList.Create; // list of TUnitInfo FOtherDefines := TStringList.Create; FResources := TProjectResources.Create(Self); ProjResources.OnModified := @EmbeddedObjectModified; end; {------------------------------------------------------------------------------ TProject Destructor ------------------------------------------------------------------------------} destructor TProject.Destroy; begin FDestroying := True; FDefineTemplates.Active := False; ActiveBuildMode:=nil; Clear; FreeThenNil(FIDEOptions); FreeAndNil(FBuildModesBackup); FreeAndNil(FBuildModes); FreeAndNil(FMacroEngine); FreeAndNil(FAllEditorsInfoMap); FreeAndNil(FAllEditorsInfoList); FreeThenNil(FResources); FreeThenNil(FBookmarks); FreeThenNil(FOtherDefines); FreeThenNil(FUnitList); FreeThenNil(FJumpHistory); FreeThenNil(FSourceDirectories); FreeThenNil(FPublishOptions); FreeThenNil(FRunParameters); FreeThenNil(FDefineTemplates); inherited Destroy; end; {------------------------------------------------------------------------------ Methods for ReadProject ------------------------------------------------------------------------------} function TProject.LoadOldProjectType(const Path: string): TOldProjectType; function OldProjectTypeNameToType(const s: string): TOldProjectType; begin for Result:=Low(TOldProjectType) to High(TOldProjectType) do if (CompareText(OldProjectTypeNames[Result],s)=0) then exit; Result:=ptApplication; end; begin if FFileVersion<=4 then Result:=OldProjectTypeNameToType(FXMLConfig.GetValue(Path+'General/ProjectType/Value', '')) else Result:=ptCustomProgram; end; procedure TProject.LoadFlags(const Path: string); procedure SetFlag(f: TProjectFlag; Value: boolean); begin if Value then Include(FFlags,f) else Exclude(FFlags,f); end; var f: TProjectFlag; OldProjectType: TOldProjectType; DefFlags: TProjectFlags; begin OldProjectType:=LoadOldProjectType(Path); DefFlags:=DefaultProjectFlags; if FFileVersion<7 then Exclude(DefFlags,pfLRSFilesInOutputDirectory); Flags:=[]; for f:=Low(TProjectFlag) to High(TProjectFlag) do SetFlag(f,FXMLConfig.GetValue(Path+'General/Flags/'+ProjectFlagNames[f]+'/Value',f in DefFlags)); if FFileVersion<=3 then begin // set new flags SetFlag(pfMainUnitIsPascalSource, OldProjectType in [ptProgram,ptApplication]); SetFlag(pfMainUnitHasUsesSectionForAllUnits, OldProjectType in [ptProgram,ptApplication]); SetFlag(pfMainUnitHasCreateFormStatements, OldProjectType in [ptApplication]); SetFlag(pfMainUnitHasTitleStatement,OldProjectType in [ptApplication]); SetFlag(pfRunnable, OldProjectType in [ptProgram,ptApplication,ptCustomProgram]); end; Flags:=Flags-[pfUseDefaultCompilerOptions]; end; procedure TProject.LoadOtherDefines(const Path: string); var Cnt, i: Integer; SubPath, s: String; begin SubPath := 'OtherDefines/'; if not FXMLConfig.HasPath(Path+SubPath, False) then SubPath := 'CustomDefines/'; // Load from the old path name. Cnt := FXMLConfig.GetValue(Path+SubPath+'Count', 0); for i := 0 to Cnt-1 do begin s := FXMLConfig.GetValue(Path+SubPath+'Define'+IntToStr(i)+'/Value', ''); if s <> '' then FOtherDefines.Add(s); end; end; procedure TProject.LoadSessionInfo(const Path: string; Merge: boolean); var NewUnitInfo: TUnitInfo; NewUnitCount, i: integer; SubPath: String; NewUnitFilename: String; OldUnitInfo: TUnitInfo; MergeUnitInfo: Boolean; begin {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject D reading units');{$ENDIF} NewUnitCount:=FXMLConfig.GetValue(Path+'Units/Count',0); for i := 0 to NewUnitCount - 1 do begin SubPath:=Path+'Units/Unit'+IntToStr(i)+'/'; NewUnitFilename:=FXMLConfig.GetValue(SubPath+'Filename/Value',''); OnLoadSaveFilename(NewUnitFilename,true); // load unit and add it OldUnitInfo:=UnitInfoWithFilename(NewUnitFilename); if OldUnitInfo<>nil then begin // unit already exists if Merge then begin NewUnitInfo:=OldUnitInfo; MergeUnitInfo:=true; end else begin // Doppelganger -> inconsistency found, ignore this file debugln('TProject.ReadProject file exists twice in lpi file: ignoring "'+NewUnitFilename+'"'); continue; end; end else begin NewUnitInfo:=TUnitInfo.Create(nil); AddFile(NewUnitInfo,false); MergeUnitInfo:=false; end; NewUnitInfo.LoadFromXMLConfig(FXMLConfig,SubPath,MergeUnitInfo,Merge,FFileVersion); if i=FNewMainUnitID then begin MainUnitID:=IndexOf(NewUnitInfo); FNewMainUnitID:=-1; end; end; // load editor info i := FXMLConfig.GetValue(Path+'General/ActiveEditorIndexAtStart/Value', -1); if (i >= 0) then UpdateVisibleEditor(i); // Load old Config => No WindowIndex ActiveWindowIndexAtStart := FXMLConfig.GetValue(Path+'General/ActiveWindowIndexAtStart/Value', 0); FSkipCheckLCLInterfaces:=FXMLConfig.GetValue(Path+'SkipCheckLCLInterfaces/Value',false); FJumpHistory.LoadFromXMLConfig(FXMLConfig,Path+''); CleanOutputFileMask:=FXMLConfig.GetValue(Path+'Build/CleanOutputFileMask/Value', DefaultProjectCleanOutputFileMask); CleanSourcesFileMask:=FXMLConfig.GetValue(Path+'Build/CleanSourcesFileMask/Value', DefaultProjectCleanSourcesFileMask); // load custom session data LoadStringToStringTree(FXMLConfig,CustomSessionData,Path+'CustomSessionData/'); end; procedure TProject.LoadFromLPI; const Path = ProjOptionsPath; begin if (FFileVersion=0) and (FXMLConfig.GetValue(Path+'Units/Count',0)=0) then if IDEMessageDialog(lisStrangeLpiFile, Format(lisTheFileDoesNotLookLikeALpiFile, [ProjectInfoFile]), mtConfirmation,[mbIgnore,mbAbort])<>mrIgnore then exit; LoadFlags(Path); SessionStorage:=StrToProjectSessionStorage( FXMLConfig.GetValue(Path+'General/SessionStorage/Value', ProjectSessionStorageNames[DefaultProjectSessionStorage])); //DebugLn('TProject.ReadProject SessionStorage=',dbgs(ord(SessionStorage)),' ProjectSessionFile=',ProjectSessionFile); // load properties // Note: in FFileVersion<9 the default value was -1 // Since almost all projects have a MainUnit the value 0 was always // added to the lpi. // Changing the default value to 0 avoids the redundancy and // automatically fixes broken lpi files. FNewMainUnitID := FXMLConfig.GetValue(Path+'General/MainUnit/Value', 0); Title := FXMLConfig.GetValue(Path+'General/Title/Value', ''); AutoCreateForms := FXMLConfig.GetValue(Path+'General/AutoCreateForms/Value', true); // fpdoc FPDocPaths:=SwitchPathDelims(FXMLConfig.GetValue(Path+'LazDoc/Paths',''),fPathDelimChanged); FPDocPackageName:=FXMLConfig.GetValue(Path+'LazDoc/PackageName',''); // i18n if FFileVersion<6 then begin POOutputDirectory := SwitchPathDelims( FXMLConfig.GetValue(Path+'RST/OutDir', ''),fPathDelimChanged); EnableI18N := POOutputDirectory <> ''; end else begin EnableI18N := FXMLConfig.GetValue(Path+'i18n/EnableI18N/Value', False); EnableI18NForLFM := FXMLConfig.GetValue(Path+'i18n/EnableI18N/LFM', True); POOutputDirectory := SwitchPathDelims( FXMLConfig.GetValue(Path+'i18n/OutDir/Value', ''),fPathDelimChanged); end; {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject E reading comp sets');{$ENDIF} // load custom data LoadStringToStringTree(FXMLConfig,CustomData,Path+'CustomData/'); {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject update ct boss');{$ENDIF} CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'ProjPath']:=ProjectDirectory; CodeToolBoss.DefineTree.ClearCache; // load the dependencies LoadPkgDependencyList(FXMLConfig,Path+'RequiredPackages/', FFirstRequiredDependency,pdlRequires,Self,true,false); // load the Run and Build parameter Options RunParameterOptions.Load(FXMLConfig,Path,fPathDelimChanged); // load the Publish Options PublishOptions.LoadFromXMLConfig(FXMLConfig,Path+'PublishOptions/',fPathDelimChanged); // load defines used for custom options LoadOtherDefines(Path); // load session info LoadSessionInfo(Path,false); // call hooks to read their info (e.g. DebugBoss) if Assigned(OnLoadProjectInfo) then OnLoadProjectInfo(Self, FXMLConfig, false); end; procedure TProject.LoadFromSession; const Path = 'ProjectSession/'; var pds: TPathDelimSwitch; begin pds:=CheckPathDelim(FXMLConfig.GetValue(Path+'PathDelim/Value', '/'), fPathDelimChanged); SessionStorePathDelim:=pds; fCurStorePathDelim:=pds; FFileVersion:=FXMLConfig.GetValue(Path+'Version/Value',0); // load MacroValues and compiler options BuildModes.LoadSessionFromXMLConfig(FXMLConfig, Path, FLoadAllOptions); // load defines used for custom options LoadOtherDefines(Path); // load session info LoadSessionInfo(Path,true); // call hooks to read their info (e.g. DebugBoss) if Assigned(OnLoadProjectInfo) then OnLoadProjectInfo(Self,FXMLConfig,true); end; function TProject.DoLoadLPI(Filename: String): TModalResult; var PIFile: String; begin Result:=mrOk; if FLoadAllOptions then begin // read the whole lpi, clear any old values Clear; ProjectInfoFile:=Filename; PIFile:=ProjectInfoFile; // May be different from Filename, setter changed. fProjectInfoFileBuffer:=CodeToolBoss.LoadFile(PIFile,true,true); fProjectInfoFileBufChangeStamp:=CTInvalidChangeStamp; try fProjectInfoFileDate:=FileAgeCached(PIFile); {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject A reading lpi');{$ENDIF} if fProjectInfoFileBuffer=nil then FXMLConfig := TCodeBufXMLConfig.CreateWithCache(PIFile,false) else begin FXMLConfig := TCodeBufXMLConfig.CreateWithCache(PIFile,false,true, fProjectInfoFileBuffer.Source); fProjectInfoFileBufChangeStamp:=fProjectInfoFileBuffer.ChangeStep; end; {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject B done lpi');{$ENDIF} except on E: Exception do begin IDEMessageDialog(lisUnableToReadLpi, Format(lisUnableToReadTheProjectInfoFile,[LineEnding,PIFile])+LineEnding+E.Message, mtError, [mbOk]); Result:=mrCancel; exit; end; end; fLastReadLPIFilename:=PIFile; fLastReadLPIFileDate:=Now; FNewMainUnitID:=-1; end else begin // read only parts of the lpi, keep other values try FXMLConfig := TCodeBufXMLConfig.CreateWithCache(Filename,true) except on E: Exception do begin IDEMessageDialog(lisUnableToReadLpi, Format(lisUnableToReadTheProjectInfoFile,[LineEnding,Filename])+LineEnding+E.Message, mtError, [mbOk]); Result:=mrCancel; exit; end; end; end; try // get format fStorePathDelim:=CheckPathDelim(FXMLConfig.GetValue(ProjOptionsPath+'PathDelim/Value','/'), fPathDelimChanged); fCurStorePathDelim:=StorePathDelim; {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject C reading values');{$ENDIF} FFileVersion:= FXMLConfig.GetValue(ProjOptionsPath+'Version/Value',0); UseAppBundle := FXMLConfig.GetValue(ProjOptionsPath+'General/UseAppBundle/Value', True); if FLoadAllOptions then LoadFromLPI; // Resources ProjResources.ReadFromProjectFile(FXMLConfig, ProjOptionsPath, FLoadAllOptions); // load MacroValues and compiler options ClearBuildModes; BuildModes.LoadProjOptsFromXMLConfig(FXMLConfig, ProjOptionsPath); // load matrix options BuildModes.SharedMatrixOptions.LoadFromXMLConfig(FXMLConfig, ProjOptionsPath+'BuildModes/SharedMatrixOptions/'); finally {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject freeing xml');{$ENDIF} fPathDelimChanged:=false; try FXMLConfig.Modified:=false; FXMLConfig.Free; except end; FXMLConfig:=nil; end; end; function TProject.DoLoadSession(Filename: String): TModalResult; begin Result:=mrOK; if FileExistsUTF8(Filename) then begin //DebugLn('TProject.ReadProject loading Session Filename=',Filename); try FXMLConfig := TCodeBufXMLConfig.CreateWithCache(Filename); LoadFromSession; except IDEMessageDialog(lisCCOErrorCaption, Format(lisUnableToReadTheProjectInfoFile, [LineEnding,Filename]), mtError,[mbOk]); Result:=mrCancel; exit; end; fPathDelimChanged:=false; try FXMLConfig.Modified:=false; FXMLConfig.Free; except end; fCurStorePathDelim:=StorePathDelim; FXMLConfig:=nil; end else // there is no .lps file -> create some defaults LoadDefaultSession; end; // Method ReadProject itself function TProject.ReadProject(const NewProjectInfoFile: string; GlobalMatrixOptions: TBuildMatrixOptions; LoadAllOptions: Boolean): TModalResult; begin Result := mrCancel; BeginUpdate(true); try BuildModes.FGlobalMatrixOptions := GlobalMatrixOptions; FLoadAllOptions := LoadAllOptions; // load project lpi file Result:=DoLoadLPI(NewProjectInfoFile); if Result<>mrOK then Exit; // load session file (if available) if (SessionStorage in pssHasSeparateSession) and (CompareFilenames(ProjectInfoFile,ProjectSessionFile)<>0) and FLoadAllOptions then begin Result:=DoLoadSession(ProjectSessionFile); if Result<>mrOK then Exit; end; finally EndUpdate; FAllEditorsInfoList.SortByPageIndex; end; {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject END');{$ENDIF} Result := mrOk; end; {------------------------------------------------------------------------------ Methods for TProject WriteProject ------------------------------------------------------------------------------} procedure TProject.SaveFlags(const Path: string); var f: TProjectFlag; begin for f:=Low(TProjectFlag) to High(TProjectFlag) do begin FXMLConfig.SetDeleteValue(Path+'General/Flags/' +ProjectFlagNames[f]+'/Value', f in Flags, f in DefaultProjectFlags); end; end; procedure TProject.SaveUnits(const Path: string; SaveSession: boolean); var i, SaveUnitCount: integer; begin SaveUnitCount:=0; for i:=0 to UnitCount-1 do if UnitMustBeSaved(Units[i],FProjectWriteFlags,SaveSession) then begin Units[i].SaveToXMLConfig(FXMLConfig, Path+'Units/Unit'+IntToStr(SaveUnitCount)+'/',True,SaveSession,fCurStorePathDelim); inc(SaveUnitCount); end; FXMLConfig.SetDeleteValue(Path+'Units/Count',SaveUnitCount,0); end; procedure TProject.SaveOtherDefines(const Path: string); var i: integer; begin for i:=0 to FOtherDefines.Count-1 do FXMLConfig.SetDeleteValue(Path+'OtherDefines/Define'+IntToStr(i)+'/Value', FOtherDefines[i],''); FXMLConfig.SetDeleteValue(Path+'OtherDefines/Count',FOtherDefines.Count,0); end; procedure TProject.SaveSessionInfo(const Path: string); begin FXMLConfig.DeleteValue(Path+'General/ActiveEditorIndexAtStart/Value'); FXMLConfig.SetDeleteValue(Path+'General/ActiveWindowIndexAtStart/Value', ActiveWindowIndexAtStart,0); FXMLConfig.SetDeleteValue('SkipCheckLCLInterfaces/Value', FSkipCheckLCLInterfaces,false); FXMLConfig.SetDeleteValue(Path+'Build/CleanOutputFileMask/Value', CleanOutputFileMask,DefaultProjectCleanOutputFileMask); FXMLConfig.SetDeleteValue(Path+'Build/CleanSourcesFileMask/Value', CleanSourcesFileMask,DefaultProjectCleanSourcesFileMask); if (not (pfSaveOnlyProjectUnits in Flags)) and (not (pwfSkipJumpPoints in FProjectWriteFlags)) then begin if (pfSaveJumpHistory in Flags) then begin FJumpHistory.DeleteInvalidPositions; FJumpHistory.SaveToXMLConfig(FXMLConfig,Path); end else FXMLConfig.DeletePath(Path+'JumpHistory'); end; // save custom session data SaveStringToStringTree(FXMLConfig,CustomSessionData,Path+'CustomSessionData/'); end; procedure TProject.SaveToLPI; const Path = ProjOptionsPath; var CurFlags: TProjectWriteFlags; begin // format FXMLConfig.SetValue(Path+'Version/Value',ProjectInfoFileVersion); FXMLConfig.SetDeleteValue(Path+'PathDelim/Value',PathDelimSwitchToDelim[fCurStorePathDelim],'/'); SaveFlags(Path); FXMLConfig.SetDeleteValue(Path+'General/SessionStorage/Value', ProjectSessionStorageNames[SessionStorage], ProjectSessionStorageNames[DefaultProjectSessionStorage]); // general properties FXMLConfig.SetValue(Path+'General/MainUnit/Value', MainUnitID); // always write a value to support opening by older IDEs (<=0.9.28). This can be changed in a few releases. FXMLConfig.SetDeleteValue(Path+'General/AutoCreateForms/Value', AutoCreateForms,true); FXMLConfig.SetDeleteValue(Path+'General/Title/Value', Title,''); FXMLConfig.SetDeleteValue(Path+'General/UseAppBundle/Value', UseAppBundle, True); // fpdoc FXMLConfig.SetDeleteValue(Path+'LazDoc/Paths', SwitchPathDelims(CreateRelativeSearchPath(FPDocPaths,ProjectDirectory), fCurStorePathDelim), ''); FXMLConfig.SetDeleteValue(Path+'LazDoc/PackageName',FPDocPackageName,''); // i18n FXMLConfig.SetDeleteValue(Path+'i18n/EnableI18N/Value', EnableI18N, false); FXMLConfig.SetDeleteValue(Path+'i18n/EnableI18N/LFM', EnableI18NForLFM, true); FXMLConfig.SetDeleteValue(Path+'i18n/OutDir/Value', SwitchPathDelims(CreateRelativePath(POOutputDirectory,ProjectDirectory), fCurStorePathDelim), ''); // Resources ProjResources.WriteToProjectFile(FXMLConfig, Path); // save custom data SaveStringToStringTree(FXMLConfig,CustomData,Path+'CustomData/'); // Save the macro values and compiler options BuildModes.SaveProjOptsToXMLConfig(FXMLConfig, Path, FSaveSessionInLPI); BuildModes.SaveSharedMatrixOptions(Path); if FSaveSessionInLPI then BuildModes.SaveSessionData(Path); // save the Publish Options PublishOptions.SaveToXMLConfig(FXMLConfig,Path+'PublishOptions/',fCurStorePathDelim); // save the Run and Build parameter options RunParameterOptions.Save(FXMLConfig,Path,fCurStorePathDelim); // save dependencies SavePkgDependencyList(FXMLConfig,Path+'RequiredPackages/', FFirstRequiredDependency,pdlRequires,fCurStorePathDelim); // save units SaveUnits(Path,FSaveSessionInLPI); if FSaveSessionInLPI then begin // save defines used for custom options SaveOtherDefines(Path); // save session info SaveSessionInfo(Path); end; // Notifiy hooks if Assigned(OnSaveProjectInfo) then begin CurFlags:=FProjectWriteFlags; if not FSaveSessionInLPI then CurFlags:=CurFlags+[pwfSkipSeparateSessionInfo]; OnSaveProjectInfo(Self,FXMLConfig,CurFlags); end; // save lpi to disk //debugln(['TProject.WriteProject ',DbgSName(FXMLConfig),' FCfgFilename=',FCfgFilename]); FXMLConfig.Flush; if not (pwfIgnoreModified in FProjectWriteFlags) then Modified:=false; if FSaveSessionInLPI then SessionModified:=false; end; procedure TProject.SaveToSession; const Path = 'ProjectSession/'; begin fCurStorePathDelim:=SessionStorePathDelim; FXMLConfig.SetDeleteValue(Path+'PathDelim/Value', PathDelimSwitchToDelim[fCurStorePathDelim],'/'); FXMLConfig.SetValue(Path+'Version/Value',ProjectInfoFileVersion); // Save the session build modes BuildModes.SaveSessionOptsToXMLConfig(FXMLConfig, Path, True); BuildModes.SaveSessionData(Path); // save all units SaveUnits(Path,true); // save defines used for custom options SaveOtherDefines(Path); // save session info SaveSessionInfo(Path); // Notifiy hooks if Assigned(OnSaveProjectInfo) then OnSaveProjectInfo(Self,FXMLConfig,FProjectWriteFlags+[pwfSkipProjectInfo]); end; function TProject.DoWrite(Filename: String; IsLpi: Boolean): TModalResult; var Msg: String; begin repeat Result := mrOK; try FXMLConfig := TCodeBufXMLConfig.CreateWithCache(Filename,false); except on E: Exception do begin DebugLn('ERROR: ',E.Message); if IsLpi then Msg:=lisUnableToWriteTheProjectInfoFileError else Msg:=lisUnableToWriteTheProjectSessionFileError; IDEMessageDialog(lisCodeToolsDefsWriteError, Format(Msg, [LineEnding, Filename, LineEnding, E.Message]) ,mtError,[mbOk]); Result:=mrCancel; exit; end; end; try // Now actually write the data either to LPI file or to session file. if IsLpi then SaveToLPI else SaveToSession; except on E: Exception do begin Result:=IDEMessageDialog(lisCodeToolsDefsWriteError, Format(lisUnableToWriteToFile2, [Filename]), mtError,[mbRetry,mbAbort]); end; end; if IsLpi and (CompareFilenames(ProjectInfoFile,FXMLConfig.Filename)=0) then UpdateFileBuffer; try FXMLConfig.Free; except end; FXMLConfig:=nil; until Result<>mrRetry; end; // Method WriteProject itself function TProject.WriteProject(ProjectWriteFlags: TProjectWriteFlags; const OverrideProjectInfoFile: string; GlobalMatrixOptions: TBuildMatrixOptions): TModalResult; var CfgFilename: String; SessFilename: String; // only set if session should be saved to a separate file SessionResult: TModalResult; WriteLPI, WriteLPS: Boolean; begin Result := mrCancel; fCurStorePathDelim:=StorePathDelim; if OverrideProjectInfoFile<>'' then CfgFilename := OverrideProjectInfoFile else CfgFilename := ProjectInfoFile; CfgFilename:=SetDirSeparators(CfgFilename); SessFilename := ''; if (not (pwfSkipSeparateSessionInfo in ProjectWriteFlags)) and (SessionStorage in pssHasSeparateSession) then begin // save session in separate file .lps if OverrideProjectInfoFile<>'' then SessFilename := ChangeFileExt(OverrideProjectInfoFile,'.lps') else SessFilename := ProjectSessionFile; if (CompareFilenames(SessFilename,CfgFilename)=0) then SessFilename:=''; end; //DebugLn('TProject.WriteProject Write Session File="',SessFilename,'"'); DoDirSeparators(SessFilename); FProjectWriteFlags := ProjectWriteFlags; BuildModes.FGlobalMatrixOptions := GlobalMatrixOptions; // first save the .lpi file if (pwfSkipSeparateSessionInfo in ProjectWriteFlags) or (SessionStorage=pssNone) then FSaveSessionInLPI:=false else FSaveSessionInLPI:=(SessFilename='') or (CompareFilenames(SessFilename,CfgFilename)=0); // check if modified if pwfIgnoreModified in ProjectWriteFlags then begin WriteLPI:=true; WriteLPS:=true; end else begin WriteLPI:=SomeDataModified or (not FileExistsUTF8(CfgFilename)); if (CompareFilenames(ProjectInfoFile,CfgFilename)=0) then // save to default lpi WriteLPI:=WriteLPI or (fProjectInfoFileDate<>FileAgeCached(CfgFilename)) else // save to another file WriteLPI:=true; if SessFilename='' then begin WriteLPS:=false; WriteLPI:=WriteLPI or SomeSessionModified; end else begin WriteLPS:=WriteLPI or SomeSessionModified or (not FileExistsUTF8(SessFilename)); end; if not (WriteLPI or WriteLPS) then exit(mrOk); end; //debugln(['TProject.WriteProject WriteLPI=',WriteLPI,' WriteLPS=',WriteLPS,' Modifed=',Modified,' SessionModified=',SessionModified]); // backup if WriteLPI and Assigned(fOnFileBackup) then begin Result:=fOnFileBackup(CfgFilename); if Result=mrAbort then exit; end; // increase usage counters UpdateUsageCounts(CfgFilename); if WriteLPI then // Write to LPI Result:=DoWrite(CfgFilename, True); if (SessFilename<>'') and WriteLPS then begin // save session in separate file .lps if Assigned(fOnFileBackup) then begin Result:=fOnFileBackup(SessFilename); if Result=mrAbort then exit; end; SessionResult:=DoWrite(SessFilename, False); if (Result=mrOk) and (SessionResult<>mrOk) then Result:=SessionResult; end; end; procedure TProject.UpdateExecutableType; function GetMainSourceType: string; var AnUnitInfo: TUnitInfo; begin Result:=''; if MainUnitID<0 then exit; AnUnitInfo:=Units[MainUnitID]; if AnUnitInfo.Source=nil then exit; Result:=CodeToolBoss.GetSourceType(AnUnitInfo.Source,false); end; var SourceType: String; begin SourceType:=GetMainSourceType; if SysUtils.CompareText(SourceType,'Program')=0 then ExecutableType:=petProgram else if SysUtils.CompareText(SourceType,'Library')=0 then ExecutableType:=petLibrary else if SysUtils.CompareText(SourceType,'Unit')=0 then ExecutableType:=petUnit else if SysUtils.CompareText(SourceType,'Package')=0 then ExecutableType:=petPackage else ExecutableType:=petNone; end; procedure TProject.BackupSession; begin FSessionModifiedBackup:=SessionModified; end; procedure TProject.RestoreSession; begin SessionModified:=FSessionModifiedBackup; end; procedure TProject.BackupBuildModes; begin FActiveBuildModeBackup:=BuildModes.IndexOf(ActiveBuildMode); {$IFDEF VerboseIDEModified} debugln(['TProject.BackupBuildModes START=====================']); {$ENDIF} FBuildModesBackup.Assign(BuildModes,true); {$IFDEF VerboseIDEModified} debugln(['TProject.BackupBuildModes END===================== Modified=',Modified]); {$ENDIF} end; procedure TProject.RestoreBuildModes; begin Assert(FBuildModesBackup.Count>0, 'TProject.RestoreBuildModes: FBuildModesBackup.Count=0'); ActiveBuildMode:=nil; BuildModes.Assign(FBuildModesBackup,true); if (FActiveBuildModeBackup>=0) and (FActiveBuildModeBackup0) and (t[p] in ['0'..'9']) do dec(p); if SysUtils.CompareText(copy(t,1,p),'project')=0 then exit; Result:=false; end; function TProject.GetIDAsString: string; begin Result:='Project'; // TODO: see TLazPackage, when this is changed change also TProjectDefineTemplates.UpdateSrcDirIfDef end; function TProject.GetIDAsWord: string; begin Result:='Project'; // TODO: see TLazPackage when this is changed change also TProjectDefineTemplates.UpdateSrcDirIfDef end; {------------------------------------------------------------------------------ TProject AddFile ------------------------------------------------------------------------------} procedure TProject.AddFile(ProjectFile: TLazProjectFile; AddToProjectUsesClause: boolean); var NewIndex: integer; AnUnit: TUnitInfo; s: String; begin AnUnit:=ProjectFile as TUnitInfo; //debugln('TProject.AddFile A ',AnUnit.Filename,' AddToProjectFile=',dbgs(AddToProjectFile)); if (UnitInfoWithFilename(AnUnit.Filename)<>nil) and (AnUnit.FileName <> '') then debugln(['TProject.AddFile WARNING: file already in unit list: ',AnUnit.Filename]); BeginUpdate(true); NewIndex:=UnitCount; FUnitList.Add(AnUnit); AnUnit.Project:=Self; AnUnit.OnFileBackup:=@OnUnitFileBackup; AnUnit.OnLoadSaveFilename:=@OnLoadSaveFilename; AnUnit.OnUnitNameChange:=@OnUnitNameChange; // lock the main unit (when it is changed on disk it should *not* auto revert) if MainUnitID=NewIndex then MainUnitInfo.IncreaseAutoRevertLock; if AddToProjectUsesClause and (MainUnitID>=0) and (MainUnitID<>NewIndex) then begin s:=AnUnit.GetUsesUnitName; if s<>'' then // add unit to uses section CodeToolBoss.AddUnitToMainUsesSectionIfNeeded(MainUnitInfo.Source,s,'',true); end; EndUpdate; UnitModified(AnUnit); end; {------------------------------------------------------------------------------ TProject RemoveUnit ------------------------------------------------------------------------------} procedure TProject.RemoveUnit(Index: integer; RemoveFromUsesSection: boolean); var OldUnitInfo: TUnitInfo; begin if (Index<0) or (Index>=UnitCount) then begin raise Exception.Create('ERROR: TProject.RemoveUnit index out of bounds'); end; if (Index=MainUnitID) then begin raise Exception.Create('ERROR: TProject.RemoveUnit index = MainUnit'); end; BeginUpdate(true); OldUnitInfo:=Units[Index]; UnitModified(OldUnitInfo); if (MainUnitID>=0) then begin // remove unit from uses section and from createforms in program file if (OldUnitInfo.IsPartOfProject) then begin if RemoveFromUsesSection then begin if (OldUnitInfo.SrcUnitName<>'') then begin CodeToolBoss.RemoveUnitFromAllUsesSections(MainUnitInfo.Source, OldUnitInfo.SrcUnitName); end; if (OldUnitInfo.ComponentName<>'') then begin CodeToolBoss.RemoveCreateFormStatement(MainUnitInfo.Source, OldUnitInfo.ComponentName); end; end; end; end; // delete bookmarks of this unit Bookmarks.DeleteAllWithUnitInfo(OldUnitInfo); // adjust MainUnit if MainUnitID>=Index then dec(fMainUnitID); // delete unitinfo instance OldUnitInfo.Free; FUnitList.Delete(Index); EndUpdate; end; function TProject.CreateProjectFile(const Filename: string): TLazProjectFile; var NewBuf: TCodeBuffer; AnUnitInfo: TUnitInfo; begin NewBuf:=CodeToolBoss.CreateFile(Filename); AnUnitInfo:=TUnitInfo.Create(NewBuf); if EditorOpts<>nil then AnUnitInfo.DefaultSyntaxHighlighter := FilenameToLazSyntaxHighlighter(NewBuf.Filename); Result:=AnUnitInfo; end; procedure TProject.UpdateVisibleUnit(AnEditor: TSourceEditorInterface; AWindowID: Integer); var i: Integer; begin for i := 0 to AllEditorsInfoCount - 1 do if AllEditorsInfo[i].WindowID = AWindowID then AllEditorsInfo[i].IsVisibleTab := AllEditorsInfo[i].EditorComponent = AnEditor; end; procedure TProject.UpdateAllVisibleUnits; var i, j: Integer; aWndId: LongInt; Info: TUnitEditorInfo; begin for i := 0 to AllEditorsInfoCount - 1 do begin Info:=AllEditorsInfo[i]; aWndId:=Info.WindowID; j := SourceEditorManagerIntf.IndexOfSourceWindowWithID(aWndId); Info.IsVisibleTab := (aWndId>=0) and (j >= 0) and (Info.EditorComponent = SourceEditorManagerIntf.SourceWindows[j].ActiveEditor); end; end; function TProject.RemoveNonExistingFiles(RemoveFromUsesSection: boolean): boolean; var i: Integer; AnUnitInfo: TUnitInfo; begin Result:=false; i:=UnitCount-1; while (i>=0) do begin if iMainUnitID) then begin if not FileExistsUTF8(AnUnitInfo.Filename) then begin RemoveUnit(i,RemoveFromUsesSection); Result:=true; end; end; end; dec(i); end; end; {------------------------------------------------------------------------------ TProject Clear ------------------------------------------------------------------------------} procedure TProject.Clear; var i:integer; begin BeginUpdate(true); inherited Clear; // break and free removed dependencies while FFirstRemovedDependency<>nil do DeleteRemovedDependency(FFirstRemovedDependency); // break and free required dependencies while FFirstRequiredDependency<>nil do DeleteRequiredDependency(FFirstRequiredDependency); // delete files for i:=0 to UnitCount-1 do Units[i].Free; FUnitList.Clear; RunParameters.Clear; FActiveWindowIndexAtStart := -1; FSkipCheckLCLInterfaces:=false; FAutoOpenDesignerFormsDisabled := false; FEnableI18N:=false; FEnableI18NForLFM:=true; FBookmarks.Clear; ClearBuildModes; FDefineTemplates.Clear; FJumpHistory.Clear; fMainUnitID := -1; fProjectInfoFile := ''; ProjectSessionFile:=''; FStateFileDate:=0; FStateFlags:=[]; ClearSourceDirectories; UpdateProjectDirectory; FPublishOptions.Clear; Title := ''; Modified := false; SessionModified := false; EndUpdate; end; procedure TProject.BeginUpdate(Change: boolean); begin inc(FUpdateLock); FDefineTemplates.BeginUpdate; FSourceDirectories.BeginUpdate; if FUpdateLock=1 then begin fChanged:=Change; if Assigned(OnBeginUpdate) then OnBeginUpdate(Self); end else fChanged:=fChanged or Change; end; procedure TProject.EndUpdate; begin if FUpdateLock<=0 then RaiseException('TProject.EndUpdate'); dec(FUpdateLock); FSourceDirectories.EndUpdate; FDefineTemplates.EndUpdate; if FUpdateLock=0 then begin if Assigned(OnEndUpdate) then OnEndUpdate(Self,fChanged); end; end; procedure TProject.UnitModified(AnUnitInfo: TUnitInfo); begin if AnUnitInfo.IsPartOfProject then begin {$IFDEF VerboseIDEModified} debugln(['TProject.UnitModified ',AnUnitInfo.Filename]); {$ENDIF} Modified:=true; end else SessionModified:=true; end; function TProject.NeedsDefineTemplates: boolean; begin Result:=not Destroying; end; procedure TProject.BeginRevertUnit(AnUnitInfo: TUnitInfo); begin if AnUnitInfo<>nil then inc(AnUnitInfo.FRevertLockCount); inc(FRevertLockCount); if FRevertLockCount=1 then begin Include(FStateFlags,lpsfPropertyDependenciesChanged); ClearUnitComponentDependencies([ucdtOldProperty,ucdtProperty]); LockUnitComponentDependencies; UpdateUnitComponentDependencies; end; end; procedure TProject.EndRevertUnit(AnUnitInfo: TUnitInfo); begin if FRevertLockCount<=0 then raise Exception.Create('TProject.EndRevertUnit Project'); if (AnUnitInfo<>nil) and (AnUnitInfo.FRevertLockCount<=0) then raise Exception.Create('TProject.EndRevertUnit Filename='+AnUnitInfo.Filename); if AnUnitInfo<>nil then dec(AnUnitInfo.FRevertLockCount); dec(FRevertLockCount); if FRevertLockCount=0 then UnlockUnitComponentDependencies; end; function TProject.IsReverting(AnUnitInfo: TUnitInfo): boolean; begin if AnUnitInfo=nil then Result:=FRevertLockCount>0 else Result:=AnUnitInfo.FRevertLockCount>0; end; function TProject.GetUnits(Index:integer):TUnitInfo; begin Result:=TUnitInfo(FUnitList[Index]); end; procedure TProject.SetFlags(const AValue: TProjectFlags); begin inherited SetFlags(AValue); end; procedure TProject.SetMainUnitID(const AValue: Integer); begin if AValue>=UnitCount then RaiseGDBException(''); if MainUnitID=AValue then exit; if (MainUnitID>=0) and (MainUnitID=0) and (MainUnitIDFChangeStampSaved) or ((BuildModes<>nil) and BuildModes.Modified); end; procedure TProject.SetModified(const AValue: boolean); begin {$IFDEF VerboseIDEModified} if Modified<>AValue then begin debugln(['TProject.SetModified ================= ',AValue,' ',FChangeStamp]); CTDumpStack; end; {$ENDIF} if fDestroying then exit; if AValue then IncreaseChangeStamp else begin FChangeStampSaved:=FChangeStamp; PublishOptions.Modified := False; ProjResources.Modified := False; BuildModes.Modified:=false; SessionModified := False; end; end; procedure TProject.SetSessionModified(const AValue: boolean); begin if AValue=SessionModified then exit; {$IFDEF VerboseIDEModified} debugln(['TProject.SetSessionModified new Modified=',AValue]); {$ENDIF} inherited SetSessionModified(AValue); end; procedure TProject.SetExecutableType(const AValue: TProjectExecutableType); begin inherited SetExecutableType(AValue); case ExecutableType of petLibrary: CompilerOptions.ExecutableType:=cetLibrary; else CompilerOptions.ExecutableType:=cetProgram; end; end; function TProject.GetUseManifest: boolean; begin Result:=ProjResources.XPManifest.UseManifest; end; procedure TProject.SetUseManifest(AValue: boolean); begin ProjResources.XPManifest.UseManifest:=AValue; end; function TProject.UnitCount:integer; begin Result:=FUnitList.Count; end; function TProject.GetFileCount: integer; begin Result:=UnitCount; end; function TProject.NewUniqueUnitName(const AnUnitName: string):string; function ExpandedUnitname(const AnUnitName:string):string; begin Result:=uppercase(ExtractFileNameOnly(AnUnitName)); end; function UnitNameExists(const AnUnitName:string):boolean; var i:integer; ExpName:string; begin Result:=true; ExpName:=ExpandedUnitName(AnUnitName); if ExtractFileNameOnly(fProjectInfoFile)=ExpName then exit; for i:=0 to UnitCount-1 do if (Units[i].IsPartOfProject) and (ExpandedUnitName(Units[i].FileName)=ExpName) then exit; Result:=false; end; var u:integer; Prefix: string; begin Prefix:=AnUnitName; while (Prefix<>'') and (Prefix[length(Prefix)] in ['0'..'9']) do Prefix:=copy(Prefix,1,length(Prefix)-1); if (Prefix='') or (not IsValidIdent(Prefix)) then Prefix:='Unit'; u:=0; repeat inc(u); Result:=Prefix+IntToStr(u); until (not UnitNameExists(Result)); end; function TProject.NewUniqueFilename(const Filename: string): string; var FileNameOnly: String; FileExt: String; i: Integer; begin FileNameOnly:=ExtractFilenameOnly(Filename); while (FileNameOnly<>'') and (FileNameOnly[length(FileNameOnly)] in ['0'..'9']) do FileNameOnly:=copy(FileNameOnly,1,length(FileNameOnly)-1); FileExt:=ExtractFileExt(Filename); i:=0; repeat inc(i); Result:=FileNameOnly+IntToStr(i)+FileExt; until ProjectUnitWithShortFilename(Result)=nil; end; function TProject.AddCreateFormToProjectFile(const AClassName, AName: string):boolean; begin if (pfMainUnitHasCreateFormStatements in Project1.Flags) then begin Result:=CodeToolBoss.AddCreateFormStatement(MainUnitInfo.Source, AClassName,AName); if Result then begin MainUnitInfo.Modified:=true; end; end else begin Result:=false; end; end; function TProject.RemoveCreateFormFromProjectFile(const AClassName,AName:string):boolean; begin Result:=CodeToolBoss.RemoveCreateFormStatement(MainUnitInfo.Source,AName); if Result then begin MainUnitInfo.Modified:=true; end; end; function TProject.FormIsCreatedInProjectFile(const AClassname,AName:string):boolean; var p: integer; begin Result:=(CodeToolBoss.FindCreateFormStatement(MainUnitInfo.Source, 1,AClassName,AName,p)=0); if p=0 then ; end; function TProject.IndexOfUnitWithName(const AnUnitName:string; OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo):integer; begin if AnUnitName='' then exit(-1); Result:=UnitCount-1; while (Result>=0) do begin if ((OnlyProjectUnits and Units[Result].IsPartOfProject) or (not OnlyProjectUnits)) and (IgnoreUnit<>Units[Result]) and (Units[Result].SrcUnitName<>'') then begin if (CompareDottedIdentifiers(PChar(Units[Result].SrcUnitName),PChar(AnUnitName))=0) then exit; end; dec(Result); end; end; function TProject.IndexOfUnitWithComponent(AComponent: TComponent; OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo):integer; begin Result:=UnitCount-1; while (Result>=0) do begin if (OnlyProjectUnits and Units[Result].IsPartOfProject) or (not OnlyProjectUnits) and (IgnoreUnit<>Units[Result]) then begin if Units[Result].Component=AComponent then exit; end; dec(Result); end; end; function TProject.IndexOfUnitWithComponentName(const AComponentName: string; OnlyProjectUnits: boolean; IgnoreUnit: TUnitInfo): integer; begin Result:=UnitCount-1; while (Result>=0) do begin if ((OnlyProjectUnits and Units[Result].IsPartOfProject) or (not OnlyProjectUnits)) and (IgnoreUnit<>Units[Result]) then begin if (CompareText(Units[Result].ComponentName,AComponentName)=0) or ((Units[Result].Component<>nil) and (CompareText(Units[Result].Component.Name,AComponentName)=0)) then exit; end; dec(Result); end; end; function TProject.UnitWithEditorComponent(AEditor: TSourceEditorInterface): TUnitInfo; var AnEditorInfo: TUnitEditorInfo; begin if AEditor = nil then exit(nil); AnEditorInfo := EditorInfoWithEditorComponent(AEditor); if AnEditorInfo = nil then exit(nil); Result := AnEditorInfo.UnitInfo; end; function TProject.GetResourceFile(AnUnitInfo: TUnitInfo; Index:integer): TCodeBuffer; var i, LinkIndex: integer; begin LinkIndex:=-1; i:=0; Result:=nil; while (i'') and FilenameIsAbsolute(BaseDir) and UseUp then Result:=CreateRelativePath(Result,BaseDir) else begin CurPath:=copy(ExtractFilePath(Result),1,length(BaseDir)); if CompareFilenames(BaseDir,CurPath)=0 then Result:=copy(Result,length(CurPath)+1,length(Result)); end; end; procedure TProject.ConvertToLPIFilename(var AFilename: string); begin OnLoadSaveFilename(AFilename,false); end; procedure TProject.ConvertFromLPIFilename(var AFilename: string); begin OnLoadSaveFilename(AFilename,true); end; function TProject.GetMainResourceFilename(AnUnitInfo: TUnitInfo):string; var CodeBuf: TCodeBuffer; begin CodeBuf:=GetResourceFile(AnUnitInfo,1); if CodeBuf=nil then begin if AnUnitInfo.Filename='' then exit(''); Result:=ChangeFileExt(AnUnitInfo.Filename,ResourceFileExt); exit; end else Result:=CodeBuf.Filename; end; function TProject.IsVirtual: boolean; begin Result:=((MainUnitID>=0) and MainUnitInfo.IsVirtual) or (ProjectInfoFile='') or (not FilenameIsAbsolute(ProjectInfoFile)); end; function TProject.IndexOf(AUnitInfo: TUnitInfo):integer; begin Result:=UnitCount-1; while (Result>=0) and (Units[Result]<>AUnitInfo) do dec(Result); end; procedure TProject.AddToOrRemoveFromComponentList(AnUnitInfo: TUnitInfo); begin if AnUnitInfo.Component=nil then begin RemoveFromList(AnUnitInfo,uilWithComponent); end else begin AddToList(AnUnitInfo,uilWithComponent); end; end; procedure TProject.AddToOrRemoveFromLoadedList(AnUnitInfo: TUnitInfo); begin if not AnUnitInfo.Loaded then begin RemoveFromList(AnUnitInfo,uilLoaded); end else begin AddToList(AnUnitInfo,uilLoaded); end; end; procedure TProject.AddToOrRemoveFromAutoRevertLockedList(AnUnitInfo: TUnitInfo); begin if not AnUnitInfo.IsAutoRevertLocked then begin RemoveFromList(AnUnitInfo,uilAutoRevertLocked); end else begin AddToList(AnUnitInfo,uilAutoRevertLocked); end; end; procedure TProject.AddToOrRemoveFromPartOfProjectList(AnUnitInfo: TUnitInfo); begin if not AnUnitInfo.IsPartOfProject then begin RemoveFromList(AnUnitInfo,uilPartOfProject); end else begin AddToList(AnUnitInfo,uilPartOfProject); end; end; function TProject.GetTargetFilename: string; begin Result:=FLazCompilerOptions.TargetFilename; end; procedure TProject.SetTargetFilename(const NewTargetFilename: string); begin FLazCompilerOptions.TargetFilename:=NewTargetFilename; end; procedure TProject.SetEnableI18N(const AValue: boolean); begin if FEnableI18N=AValue then exit; FEnableI18N:=AValue; {$IFDEF VerboseIDEModified} debugln(['TProject.SetEnableI18N ',AValue]); {$ENDIF} Modified:=true; end; procedure TProject.SetPOOutputDirectory(const AValue: string); var NewValue: String; begin NewValue:=ChompPathDelim(TrimFilename(AValue)); if FPOOutputDirectory=NewValue then exit; FPOOutputDirectory:=NewValue; {$IFDEF VerboseIDEModified} debugln(['TProject.SetPOOutputDirectory ',AValue]); {$ENDIF} Modified:=true; end; function TProject.GetMainFilename: String; begin if MainUnitID>=0 then Result:=MainUnitInfo.Filename else Result:=''; end; function TProject.GetFirstPartOfProject: TUnitInfo; begin Result:=FFirst[uilPartOfProject]; end; function TProject.GetFirstLoadedUnit: TUnitInfo; begin Result:=fFirst[uilLoaded]; end; procedure TProject.EmbeddedObjectModified(Sender: TObject); begin if ProjResources.Modified then Modified := True; end; function TProject.GetFirstAutoRevertLockedUnit: TUnitInfo; begin Result:=fFirst[uilAutoRevertLocked]; end; function TProject.GetAllEditorsInfo(Index: Integer): TUnitEditorInfo; begin Result := FAllEditorsInfoList[Index]; end; function TProject.GetCompilerOptions: TProjectCompilerOptions; begin Result := TProjectCompilerOptions(FLazCompilerOptions); end; function TProject.GetBaseCompilerOptions: TBaseCompilerOptions; // This satisfies the IProjPack interface requirement. begin Result := TBaseCompilerOptions(FLazCompilerOptions); end; procedure TProject.ClearBuildModes; begin ActiveBuildMode:=nil; FBuildModes.Clear; if not fDestroying then ActiveBuildMode:=FBuildModes.Add('default'); end; function TProject.GetActiveBuildModeID: string; begin Result := ActiveBuildMode.Identifier; end; function TProject.GetFirstUnitWithComponent: TUnitInfo; begin Result:=fFirst[uilWithComponent]; end; function TProject.GetFirstUnitWithEditorIndex: TUnitInfo; begin Result:=fFirst[uilWithEditorIndex]; end; function TProject.GetIDEOptions: TProjectIDEOptions; begin Result := TProjectIDEOptions(FIDEOptions); end; function TProject.GetMainUnitInfo: TUnitInfo; begin if (MainUnitID>=0) and (MainUnitID'') and TitleIsDefault(true); fProjectInfoFile:=NewProjectInfoFile; if TitleWasDefault then Title:=GetDefaultTitle; UpdateProjectDirectory; UpdateSessionFilename; if Assigned(OnChangeProjectInfoFile) then OnChangeProjectInfoFile(Self); FDefineTemplates.SourceDirectoriesChanged; {$IFDEF VerboseIDEModified} debugln(['TProject.SetProjectInfoFile ',NewFilename]); {$ENDIF} Modified:=true; EndUpdate; //DebugLn('TProject.SetProjectInfoFile FDefineTemplates.FUpdateLock=',dbgs(FDefineTemplates.FUpdateLock)); end; procedure TProject.SetSessionStorage(const AValue: TProjectSessionStorage); begin if SessionStorage=AValue then exit; inherited SetSessionStorage(AValue); {$IFDEF VerboseIDEModified} debugln(['TProject.SetSessionStorage ']); {$ENDIF} Modified:=true; UpdateSessionFilename; end; function TProject.OnUnitFileBackup(const Filename: string): TModalResult; begin if Assigned(fOnFileBackup) then Result:=fOnFileBackup(Filename) else Result:=mrOk; end; procedure TProject.OnLoadSaveFilename(var AFilename: string; Load:boolean); { This function is used after reading a filename from the config and before writing a filename to a config. The config can be the lpi or the session. } var ProjectPath: string; FileWasAbsolute: Boolean; function FileCanBeMadeRelative: boolean; begin Result:=false; if not FileWasAbsolute then exit; {$IFdef MSWindows} // check that the file is on the same drive / filesystem if CompareText(ExtractFileDrive(AFilename),ExtractFileDrive(ProjectPath))<>0 then exit; {$ENDIF} Result:=true; end; begin if AFileName='' then exit; //debugln(['TProject.OnLoadSaveFilename A "',AFilename,'" fPathDelimChanged=',fPathDelimChanged,' Load=',Load]); if Load and fPathDelimChanged then begin {$IFDEF MSWindows} // PathDelim changed from '/' to '\' FileWasAbsolute:=FilenameIsUnixAbsolute(AFileName); {$ELSE} // PathDelim changed from '\' to '/' FileWasAbsolute:=FilenameIsWinAbsolute(AFileName); {$ENDIF} ForcePathDelims(AFilename); end else begin FileWasAbsolute:=FilenameIsAbsolute(AFileName); end; AFilename:=TrimFilename(AFilename); ProjectPath:=AppendPathDelim(ProjectDirectory); if ProjectPath<>'' then begin if Load then begin // make filename absolute if not FileWasAbsolute then AFilename:=TrimFilename(ProjectPath+AFilename); end else begin // try making filename relative to project file if FileCanBeMadeRelative then begin AFilename:=CreateRelativePath(AFilename,ProjectPath); end; end; end; if (not Load) then begin if (not IsCurrentPathDelim(fCurStorePathDelim)) and (FilenameIsAbsolute(AFileName)) and (ProjectPath<>'') then begin // the lpi file is saved with different pathdelims // this will destroy absolute paths // => force it relative AFileName:=ExtractRelativepath(ProjectPath,AFilename); end; AFilename:=SwitchPathDelims(AFileName,fCurStorePathDelim); end; //debugln('TProject.OnLoadSaveFilename END "',AFilename,'" FileWasAbsolute=',dbgs(FileWasAbsolute)); end; function TProject.RemoveProjectPathFromFilename(const AFilename: string): string; var ProjectPath:string; begin ProjectPath:=ProjectDirectory; if ProjectPath='' then ProjectPath:=GetCurrentDirUTF8; Result:=AFilename; ForcePathDelims(Result); // try making filename relative to project file if FilenameIsAbsolute(Result) and (CompareFileNames(copy(Result,1,length(ProjectPath)),ProjectPath)=0) then Result:=copy(Result,length(ProjectPath)+1, length(Result)-length(ProjectPath)); end; function TProject.FileIsInProjectDir(const AFilename: string): boolean; var ProjectDir, FilePath: string; begin if FilenameIsAbsolute(AFilename) then begin if (not IsVirtual) then begin ProjectDir:=ProjectDirectory; FilePath:=LeftStr(AFilename,length(ProjectDir)); Result:=(CompareFileNames(ProjectDir,FilePath)=0); end else Result:=false; end else Result:=true; end; procedure TProject.GetVirtualDefines(DefTree: TDefineTree; DirDef: TDirectoryDefines); procedure ExtendPath(const AVariable, APath: string); var TempValue: string; begin if APath<>'' then begin DefTree.ReadValue(DirDef,APath+';','',TempValue); DirDef.Values.Prepend(AVariable,TempValue); end; end; begin if (not IsVirtual) then exit; ExtendPath(UnitPathMacroName,CompilerOptions.OtherUnitFiles); ExtendPath(IncludePathMacroName,CompilerOptions.IncludePath); ExtendPath(SrcPathMacroName,CompilerOptions.SrcPath); end; procedure TProject.GetUnitsChangedOnDisk(var AnUnitList: TFPList); var AnUnitInfo: TUnitInfo; begin AnUnitList:=nil; AnUnitInfo:=fFirst[uilAutoRevertLocked]; while (AnUnitInfo<>nil) do begin if (AnUnitInfo.Source<>nil) and AnUnitInfo.ChangedOnDisk(false) then begin if AnUnitList=nil then AnUnitList:=TFPList.Create; AnUnitList.Add(AnUnitInfo); end; AnUnitInfo:=AnUnitInfo.fNext[uilAutoRevertLocked]; end; end; function TProject.HasProjectInfoFileChangedOnDisk: boolean; var AnUnitInfo: TUnitInfo; Code: TCodeBuffer; begin Result:=false; if IsVirtual or Modified then exit; AnUnitInfo:=UnitInfoWithFilename(ProjectInfoFile,[pfsfOnlyEditorFiles]); if (AnUnitInfo<>nil) then begin // user is editing the lpi file in source editor exit; end; AnUnitInfo:=fFirst[uilAutoRevertLocked]; while (AnUnitInfo<>nil) do begin if CompareFilenames(AnUnitInfo.Filename,ProjectInfoFile)=0 then begin // revert is locked for this file exit; end; AnUnitInfo:=AnUnitInfo.fNext[uilAutoRevertLocked]; end; if not FileExistsCached(ProjectInfoFile) then exit; if fProjectInfoFileDate=FileAgeCached(ProjectInfoFile) then exit; // file on disk has changed, check content Code:=CodeToolBoss.LoadFile(ProjectInfoFile,true,true); if (Code<>nil) and (Code=fProjectInfoFileBuffer) and (Code.ChangeStep=fProjectInfoFileBufChangeStamp) then exit; //DebugLn(['TProject.HasProjectInfoFileChangedOnDisk ',ProjectInfoFile,' fProjectInfoFileDate=',fProjectInfoFileDate,' ',FileAgeUTF8(ProjectInfoFile)]); Result:=true; end; procedure TProject.IgnoreProjectInfoFileOnDisk; begin fProjectInfoFileDate:=FileAgeCached(ProjectInfoFile); end; function TProject.FindDependencyByName(const PackageName: string): TPkgDependency; begin Result:=FindDependencyByNameInList(FFirstRequiredDependency,pdlRequires, PackageName); end; function TProject.FindRemovedDependencyByName(const PkgName: string): TPkgDependency; begin Result:=FindDependencyByNameInList(FFirstRemovedDependency,pdlRequires,PkgName); end; function TProject.RequiredDepByIndex(Index: integer): TPkgDependency; begin Result:=GetDependencyWithIndex(FFirstRequiredDependency,pdlRequires,Index); end; function TProject.RemovedDepByIndex(Index: integer): TPkgDependency; begin Result:=GetDependencyWithIndex(FFirstRemovedDependency,pdlRequires,Index); end; procedure TProject.AddRequiredDependency(Dependency: TPkgDependency); begin BeginUpdate(true); Dependency.AddToList(FFirstRequiredDependency,pdlRequires); Dependency.Owner:=Self; Dependency.HoldPackage:=true; FDefineTemplates.CustomDefinesChanged; {$IFDEF VerboseAddProjPkg} DebugLn(['TProject.AddRequiredDependency ']); {$ENDIF} IncreaseCompilerParseStamp; {$IFDEF VerboseIDEModified} debugln(['TProject.AddRequiredDependency ',Dependency.PackageName]); {$ENDIF} Modified:=true; EndUpdate; end; procedure TProject.RemoveRequiredDependency(Dependency: TPkgDependency); begin BeginUpdate(true); Dependency.RemoveFromList(FFirstRequiredDependency,pdlRequires); Dependency.RequiredPackage:=nil; Dependency.AddToList(FFirstRemovedDependency,pdlRequires); Dependency.Removed:=true; FDefineTemplates.CustomDefinesChanged; IncreaseCompilerParseStamp; {$IFDEF VerboseIDEModified} debugln(['TProject.RemoveRequiredDependency ',Dependency.PackageName]); {$ENDIF} Modified:=true; EndUpdate; end; procedure TProject.DeleteRequiredDependency(Dependency: TPkgDependency); begin BeginUpdate(true); Dependency.RequiredPackage:=nil; Dependency.RemoveFromList(FFirstRequiredDependency,pdlRequires); Dependency.Free; FDefineTemplates.CustomDefinesChanged; IncreaseCompilerParseStamp; EndUpdate; end; procedure TProject.DeleteRemovedDependency(Dependency: TPkgDependency); begin BeginUpdate(true); Dependency.RequiredPackage:=nil; Dependency.RemoveFromList(FFirstRemovedDependency,pdlRequires); Dependency.Free; EndUpdate; end; procedure TProject.RemoveRemovedDependency(Dependency: TPkgDependency); begin BeginUpdate(true); Dependency.RemoveFromList(FFirstRemovedDependency,pdlRequires); Dependency.Removed:=false; EndUpdate; end; procedure TProject.ReaddRemovedDependency(Dependency: TPkgDependency); begin BeginUpdate(true); RemoveRemovedDependency(Dependency); AddRequiredDependency(Dependency); EndUpdate; end; procedure TProject.MoveRequiredDependencyUp(Dependency: TPkgDependency); begin if Dependency.PrevRequiresDependency=nil then exit; BeginUpdate(true); Dependency.MoveUpInList(FFirstRequiredDependency,pdlRequires); FDefineTemplates.CustomDefinesChanged; IncreaseCompilerParseStamp; EndUpdate; end; procedure TProject.MoveRequiredDependencyDown(Dependency: TPkgDependency); begin if Dependency.NextRequiresDependency=nil then exit; BeginUpdate(true); Dependency.MoveDownInList(FFirstRequiredDependency,pdlRequires); FDefineTemplates.CustomDefinesChanged; IncreaseCompilerParseStamp; EndUpdate; end; function TProject.Requires(APackage: TLazPackage; SearchRecursively: boolean): boolean; begin if SearchRecursively then Result:=PackageGraph.FindDependencyRecursively(FFirstRequiredDependency, APackage)<>nil else Result:=FindCompatibleDependencyInList(FFirstRequiredDependency,pdlRequires, APackage)<>nil; end; procedure TProject.GetAllRequiredPackages(var List: TFPList; ReqFlags: TPkgIntfRequiredFlags; MinPolicy: TPackageUpdatePolicy); begin if Assigned(OnGetAllRequiredPackages) then OnGetAllRequiredPackages(nil,FirstRequiredDependency,List,ReqFlags,MinPolicy); end; procedure TProject.AddPackageDependency(const PackageName: string); var PkgDependency: TPkgDependency; begin if FindDependencyByNameInList(FirstRequiredDependency,pdlRequires,PackageName) <>nil then exit; PkgDependency:=TPkgDependency.Create; PkgDependency.PackageName:=PackageName; AddRequiredDependency(PkgDependency); end; procedure TProject.LockUnitComponentDependencies; begin inc(FLockUnitComponentDependencies); if FLockUnitComponentDependencies=1 then begin // update once Include(FStateFlags,lpsfPropertyDependenciesChanged); Include(FStateFlags,lpsfDesignerChanged); end; end; procedure TProject.UnlockUnitComponentDependencies; begin if FLockUnitComponentDependencies=0 then raise Exception.Create(''); dec(FLockUnitComponentDependencies); end; procedure TProject.UpdateUnitComponentDependencies; procedure Search(AnUnitInfo: TUnitInfo; AComponent: TComponent); // search the published properties of AComponent for references to other units var TypeInfo: PTypeInfo; TypeData: PTypeData; PropInfo: PPropInfo; PropList: PPropList; CurCount,i: integer; ReferenceComponent: TComponent; OwnerComponent: TComponent; ReferenceUnit: TUnitInfo; Dependency: TUnitComponentDependency; begin if AComponent<>AnUnitInfo.Component then begin ReferenceUnit:=UnitWithComponentClass(TComponentClass(AComponent.ClassType)); {$ifdef VerboseFormEditor} DebugLn(['Search UnitComponent=',DbgSName(AnUnitInfo.Component),' AComponent=',DbgSName(AComponent),' ReferenceUnit=',ReferenceUnit<>nil]); {$endif} if (ReferenceUnit<>nil) then begin // component class references another unit {$IFDEF VerboseIDEMultiForm} DebugLn(['TProject.UpdateUnitComponentDependencies inline component found: ',DbgSName(AComponent),' ',AnUnitInfo.Filename,' -> ',ReferenceUnit.Filename]); {$ENDIF} AnUnitInfo.AddRequiresComponentDependency( ReferenceUnit,[ucdtInlineClass]); end; end; // read all properties and remove doubles TypeInfo:=PTypeInfo(AComponent.ClassInfo); repeat // read all property infos of current class TypeData:=GetTypeData(TypeInfo); // read property count CurCount:=GetPropList(TypeInfo,PropList); try // read properties for i:=0 to CurCount-1 do begin PropInfo:=PropList^[i]; if (PropInfo^.PropType^.Kind=tkClass) then begin // property of kind TObject ReferenceComponent:=TComponent(GetObjectProp(AComponent,PropInfo)); //debugln('TProject.UpdateUnitComponentDependencies Property ',dbgsName(AComponent),' Name=',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' Value=',dbgsName(ReferenceComponent),' TypeInfo=',TypeInfo^.Name); if ReferenceComponent is TComponent then begin // reference is a TComponent OwnerComponent:=ReferenceComponent; while OwnerComponent.Owner<>nil do OwnerComponent:=OwnerComponent.Owner; if OwnerComponent<>AnUnitInfo.Component then begin // property references a component that is not owned // by the current unit ReferenceUnit:=UnitWithComponent(OwnerComponent); if ReferenceUnit<>nil then begin // property references another unit {$IFDEF VerboseIDEMultiForm} DebugLn(['TProject.UpdateUnitComponentDependencies multi form reference found: ',AnUnitInfo.Filename,' -> ',ReferenceUnit.Filename]); {$ENDIF} AnUnitInfo.AddRequiresComponentDependency( ReferenceUnit,[ucdtProperty]); if FRevertLockCount>0 then begin Dependency:=AnUnitInfo.AddRequiresComponentDependency( ReferenceUnit,[ucdtOldProperty]); Dependency.SetUsedByPropPath( Dependency.CreatePropPath(AComponent,PropInfo^.Name), Dependency.CreatePropPath(ReferenceComponent)); end; end; end; end; end; end; finally FreeMem(PropList); end; TypeInfo:=TypeData^.ParentInfo; until TypeInfo=nil; end; procedure DFSRequiredDesigner(AnUnitInfo, IgnoreUnitInfo: TUnitInfo); var Dependency: TUnitComponentDependency; UsingUnitInfo: TUnitInfo; begin if (AnUnitInfo=nil) or (AnUnitInfo.Component=nil) or (uifMarked in AnUnitInfo.FFlags) then exit; Include(AnUnitInfo.FFlags,uifMarked); Dependency:=AnUnitInfo.FirstRequiredComponent; while Dependency<>nil do begin UsingUnitInfo:=Dependency.RequiresUnit; if (UsingUnitInfo<>IgnoreUnitInfo) and (not (uifComponentIndirectlyUsedByDesigner in UsingUnitInfo.FFlags)) then begin {$IFDEF VerboseIDEMultiForm} DebugLn(['TProject.UpdateUnitComponentDependencies.DFSRequiredDesigner designer of ',AnUnitInfo.Filename,' uses ',UsingUnitInfo.Filename]); {$ENDIF} Include(UsingUnitInfo.FFlags,uifComponentIndirectlyUsedByDesigner); DFSRequiredDesigner(UsingUnitInfo,IgnoreUnitInfo); end; Dependency:=Dependency.NextRequiresDependency; end; end; var AnUnitInfo: TUnitInfo; i: Integer; begin if (FLockUnitComponentDependencies=0) or (lpsfPropertyDependenciesChanged in FStateFlags) then begin Exclude(FStateFlags,lpsfPropertyDependenciesChanged); // clear dependencies ClearUnitComponentDependencies([ucdtProperty,ucdtInlineClass]); {$IFDEF VerboseIDEMultiForm} DebugLn(['TProject.UpdateUnitComponentDependencies checking properties ...']); {$ENDIF} // find property dependencies AnUnitInfo:=FirstUnitWithComponent; while AnUnitInfo<>nil do begin Search(AnUnitInfo,AnUnitInfo.Component); for i:=AnUnitInfo.Component.ComponentCount-1 downto 0 do Search(AnUnitInfo,AnUnitInfo.Component.Components[i]); AnUnitInfo:=AnUnitInfo.NextUnitWithComponent; end; //WriteDebugReportUnitComponentDependencies('P '); end; if (FLockUnitComponentDependencies=0) or (lpsfDesignerChanged in FStateFlags) then begin Exclude(FStateFlags,lpsfDesignerChanged); {$IFDEF VerboseIDEMultiForm} DebugLn(['TProject.UpdateUnitComponentDependencies checking designers ...']); {$ENDIF} // find designer dependencies AnUnitInfo:=FirstUnitWithComponent; while AnUnitInfo<>nil do begin AnUnitInfo.FFlags:=AnUnitInfo.FFlags- [uifMarked,uifComponentIndirectlyUsedByDesigner,uifComponentUsedByDesigner]; if FindRootDesigner(AnUnitInfo.Component)<>nil then begin {$IFDEF VerboseIDEMultiForm} DebugLn(['TProject.UpdateUnitComponentDependencies used by designer: ',AnUnitInfo.Filename]); {$ENDIF} Include(AnUnitInfo.FFlags,uifComponentUsedByDesigner); end; AnUnitInfo:=AnUnitInfo.NextUnitWithComponent; end; // mark all units that are used indirectly by a designer AnUnitInfo:=FirstUnitWithComponent; while AnUnitInfo<>nil do begin if (uifComponentUsedByDesigner in AnUnitInfo.FFlags) then begin // mark all that use indirectly this designer Exclude(AnUnitInfo.FFlags,uifMarked); DFSRequiredDesigner(AnUnitInfo,AnUnitInfo); end; AnUnitInfo:=AnUnitInfo.NextUnitWithComponent; end; {$IFDEF VerboseTFrame} WriteDebugReportUnitComponentDependencies('UUCD '); {$ENDIF} end; end; procedure TProject.InvalidateUnitComponentDesignerDependencies; begin Include(FStateFlags,lpsfDesignerChanged); end; procedure TProject.ClearUnitComponentDependencies(ClearTypes: TUnitCompDependencyTypes); var i: Integer; begin for i:=UnitCount-1 downto 0 do Units[i].ClearUnitComponentDependencies(ClearTypes); end; procedure TProject.FindUnitsUsingSubComponent(SubComponent: TComponent; List: TFPList; IgnoreOwner: boolean); procedure Search(AnUnitInfo: TUnitInfo; AComponent: TComponent); // search the published properties of AComponent for references to other units var TypeInfo: PTypeInfo; TypeData: PTypeData; PropInfo: PPropInfo; PropList: PPropList; CurCount,i: integer; ReferenceComponent: TComponent; begin if csDestroying in AComponent.ComponentState then exit; // read all properties and remove doubles TypeInfo:=PTypeInfo(AComponent.ClassInfo); repeat // read all property infos of current class TypeData:=GetTypeData(TypeInfo); // read property count CurCount:=GetPropList(TypeInfo,PropList); try // read properties for i:=0 to CurCount-1 do begin PropInfo:=PropList^[i]; if PropInfo^.PropType^.Kind=tkClass then begin // property of kind TObject ReferenceComponent:=TComponent(GetObjectProp(AComponent,PropInfo)); //debugln('TProject.FindUnitsUsingSubComponent Property ',dbgsName(AComponent),' Name=',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' Value=',dbgsName(ReferenceComponent),' TypeInfo=',TypeInfo^.Name); if ReferenceComponent=SubComponent then begin if List.IndexOf(AnUnitInfo)<0 then List.Add(AnUnitInfo); end; end; end; finally FreeMem(PropList); end; TypeInfo:=TypeData^.ParentInfo; until TypeInfo=nil; end; var AnUnitInfo: TUnitInfo; i: Integer; OwnerComponent: TComponent; begin if SubComponent=nil then exit; if IgnoreOwner then begin OwnerComponent:=SubComponent; while OwnerComponent<>nil do OwnerComponent:=OwnerComponent.Owner; end else OwnerComponent:=nil; AnUnitInfo:=FirstUnitWithComponent; while AnUnitInfo<>nil do begin if csDestroying in AnUnitInfo.Component.ComponentState then continue; if AnUnitInfo.Component<>OwnerComponent then begin Search(AnUnitInfo,AnUnitInfo.Component); for i:=AnUnitInfo.Component.ComponentCount-1 downto 0 do Search(AnUnitInfo,AnUnitInfo.Component.Components[i]); end; AnUnitInfo:=AnUnitInfo.NextUnitWithComponent; end; end; procedure TProject.WriteDebugReportUnitComponentDependencies(Prefix: string); var i: Integer; AnUnitInfo: TUnitInfo; begin for i:=0 to UnitCount-1 do begin AnUnitInfo:=Units[i]; if (AnUnitInfo.FirstUsedByComponent<>nil) or (AnUnitInfo.FirstRequiredComponent<>nil) then AnUnitInfo.WriteDebugReportUnitComponentDependencies(Prefix); end; end; procedure TProject.AddSrcPath(const SrcPathAddition: string); begin CompilerOptions.SrcPath:=MergeSearchPaths(CompilerOptions.SrcPath, GetForcedPathDelims(SrcPathAddition)); end; function TProject.GetSourceDirs(WithProjectDir, WithoutOutputDir: boolean): string; begin Result:=SourceDirectories.CreateSearchPathFromAllFiles; if WithProjectDir then Result:=MergeSearchPaths(Result,ProjectDirectory); if WithoutOutputDir then Result:=RemoveSearchPaths(Result,GetOutputDirectory); end; function TProject.GetOutputDirectory: string; begin Result:=CompilerOptions.ParsedOpts.GetParsedValue(pcosOutputDir); end; function TProject.GetCompilerFilename: string; begin Result:=CompilerOptions.ParsedOpts.GetParsedValue(pcosCompilerPath); end; function TProject.GetStateFilename: string; begin Result:=GetOutputDirectory; if (not FilenameIsAbsolute(Result)) and (not IsVirtual) then Result:=ProjectDirectory; Result:=AppendPathDelim(Result)+ChangeFileExt(GetCompileSourceFilename,'.compiled'); end; function TProject.GetCompileSourceFilename: string; begin if MainUnitID<0 then Result:='' else Result:=ExtractFilename(MainUnitInfo.Filename); end; procedure TProject.AutoAddOutputDirToIncPath; var IncPath: String; begin if pfLRSFilesInOutputDirectory in Flags then begin // the .lrs files are auto created in the output directory // => make sure the project output directory is in the include path IncPath:=CompilerOptions.IncludePath; if SearchDirectoryInSearchPath(IncPath,'$(ProjOutDir)')<1 then CompilerOptions.IncludePath:=MergeSearchPaths(IncPath,';$(ProjOutDir)'); end; end; function TProject.LoadStateFile(IgnoreErrors: boolean): TModalResult; var XMLConfig: TXMLConfig; StateFile: String; CurStateFileAge: Integer; begin StateFile:=GetStateFilename; if (not FilenameIsAbsolute(StateFile)) or (not FileExistsUTF8(StateFile)) then begin DebugLn('TProject.DoLoadStateFile Statefile not found: ',StateFile); StateFlags:=StateFlags-[lpsfStateFileLoaded]; Result:=mrOk; exit; end; // read the state file CurStateFileAge:=FileAgeCached(StateFile); if (not (lpsfStateFileLoaded in StateFlags)) or (StateFileDate<>CurStateFileAge) then begin StateFlags:=StateFlags-[lpsfStateFileLoaded]; try XMLConfig:=TCodeBufXMLConfig.CreateWithCache(StateFile); try LastCompilerFilename:=XMLConfig.GetValue('Compiler/Value',''); LastCompilerFileDate:=XMLConfig.GetValue('Compiler/Date',0); LastCompilerParams:=XMLConfig.GetValue('Params/Value',''); LastCompileComplete:=XMLConfig.GetValue('Complete/Value',true); finally XMLConfig.Free; end; StateFileDate:=CurStateFileAge; except on E: Exception do begin if IgnoreErrors then begin Result:=mrOk; end else begin Result:=IDEMessageDialog(lisPkgMangErrorReadingFile, Format(lisProjMangUnableToReadStateFileOfProjectError, [StateFile, IDAsString, LineEnding, E.Message]), mtError,[mbAbort]); end; exit; end; end; StateFlags:=StateFlags+[lpsfStateFileLoaded]; end; Result:=mrOk; end; function TProject.SaveStateFile(const CompilerFilename, CompilerParams: string; Complete: boolean): TModalResult; var XMLConfig: TXMLConfig; StateFile: String; CompilerFileDate: Integer; begin StateFile:=GetStateFilename; if not FilenameIsAbsolute(StateFile) then exit(mrOk); try CompilerFileDate:=FileAgeCached(CompilerFilename); XMLConfig:=TCodeBufXMLConfig.CreateWithCache(StateFile,false); try // always write all values for easy use by other tools and other versions of IDE XMLConfig.SetValue('Compiler/Value',CompilerFilename); XMLConfig.SetValue('Compiler/Date',CompilerFileDate); XMLConfig.SetValue('Params/Value',CompilerParams); XMLConfig.SetDeleteValue('Complete/Value',Complete,true); InvalidateFileStateCache(StateFile); XMLConfig.Flush; finally XMLConfig.Free; end; LastCompilerFilename:=CompilerFilename; LastCompilerFileDate:=CompilerFileDate; LastCompilerParams:=CompilerParams; LastCompileComplete:=Complete; StateFileDate:=FileAgeCached(StateFile); StateFlags:=StateFlags+[lpsfStateFileLoaded]; except on E: Exception do begin Result:=IDEMessageDialog(lisPkgMangErrorWritingFile, Format(lisProjMangUnableToWriteStateFileForProjectError, [IDAsString, LineEnding, E.Message]), mtError,[mbAbort,mbCancel]); exit; end; end; Result:=mrOk; end; procedure TProject.UpdateAllCustomHighlighter; var i: Integer; begin if EditorOpts=nil then exit; for i:=0 to UnitCount-1 do Units[i].UpdateHasCustomHighlighter(FilenameToLazSyntaxHighlighter(Units[i].Filename)); end; procedure TProject.UpdateAllSyntaxHighlighter; var i: Integer; begin if EditorOpts=nil then exit; for i:=0 to UnitCount-1 do Units[i].UpdateDefaultHighlighter(FilenameToLazSyntaxHighlighter(Units[i].Filename)); end; function TProject.GetPOOutDirectory: string; begin Result:=POOutputDirectory; if not IDEMacros.SubstituteMacros(Result) then debugln(['TProject.GetPOOutDirectory failed POOutputDirectory="',POOutputDirectory,'"']); Result:=TrimFilename(Result); if not FilenameIsAbsolute(Result) then Result:=TrimFilename(AppendPathDelim(ProjectDirectory)+Result); end; function TProject.GetAutoCreatedFormsList: TStrings; var i, j: integer; begin if (MainUnitID >= 0) then begin Result := CodeToolBoss.ListAllCreateFormStatements(MainUnitInfo.Source); if Result <> nil then for i := 0 to Result.Count - 1 do begin j := Pos(':', Result[i]); if j > 0 then if 't' + LowerCase(Copy(Result[i], 1, j - 1)) = LowerCase( Copy(Result[i], j + 1, Length(Result[i]) - j)) then Result[i] := Copy(Result[i], 1, j - 1); end;// shorten lines of type 'FormName:TFormName' to simply 'FormName' end else Result := nil; end; function TProject.AddBookmark(X, Y, ID: Integer; AUnitInfo:TUnitInfo): integer; begin Result := Bookmarks.Add(X, Y, ID, AUnitInfo); SessionModified := true; end; procedure TProject.DeleteBookmark(ID: Integer); var i: Integer; begin i := Bookmarks.IndexOfID(ID); if i < 0 then exit; Bookmarks.Delete(i); SessionModified := true; end; procedure TProject.OnUnitNameChange(AnUnitInfo: TUnitInfo; const OldUnitName, NewUnitName: string; CheckIfAllowed: boolean; var Allowed: boolean); var i:integer; begin if AnUnitInfo.IsPartOfProject then begin if CheckIfAllowed then begin // check if no other project unit has this name for i:=0 to UnitCount-1 do begin if (Units[i].IsPartOfProject) and (Units[i]<>AnUnitInfo) and (Units[i].SrcUnitName<>'') and (CompareText(Units[i].SrcUnitName,NewUnitName)=0) then begin Allowed:=false; exit; end; end; end; if (OldUnitName<>'') then begin if (pfMainUnitIsPascalSource in Flags) then begin // rename unit in program uses section CodeToolBoss.RenameUsedUnit(MainUnitInfo.Source, OldUnitName, NewUnitName, ''); end; if MainUnitInfo = AnUnitInfo then begin // we are renaming a project => update resource directives ProjResources.RenameDirectives(OldUnitName, NewUnitName); end; end; end; end; procedure TProject.SetActiveBuildMode(const AValue: TProjectBuildMode); begin // Must be set even if FActiveBuildMode=AValue. Modes may be added and deleted, // the same old address can be used by a new mode. FActiveBuildMode:=AValue; if FActiveBuildMode<>nil then FLazCompilerOptions:=FActiveBuildMode.CompilerOptions else FLazCompilerOptions:=nil; {$IFDEF VerboseIDEModified} debugln(['TProject.SetActiveBuildMode ']); {$ENDIF} SessionModified:=true; if Self=Project1 then IncreaseBuildMacroChangeStamp; end; procedure TProject.SetActiveBuildModeID(aIdent: string); var i: Integer; begin for i:=0 to BuildModes.Count-1 do begin if BuildModes[i].Identifier=aIdent then begin ActiveBuildMode:=BuildModes[i]; Break; end; end; end; procedure TProject.SetAutoOpenDesignerFormsDisabled(const AValue: boolean); begin if FAutoOpenDesignerFormsDisabled=AValue then exit; FAutoOpenDesignerFormsDisabled:=AValue; end; procedure TProject.SetEnableI18NForLFM(const AValue: boolean); begin if FEnableI18NForLFM=AValue then exit; FEnableI18NForLFM:=AValue; {$IFDEF VerboseIDEModified} debugln(['TProject.SetEnableI18NForLFM ',AValue]); {$ENDIF} Modified:=true; end; procedure TProject.SetLastCompilerParams(AValue: string); begin if FLastCompilerParams=AValue then Exit; //debugln(['TProject.SetLastCompilerParams Old="',FLastCompilerParams,'"']); //debugln(['TProject.SetLastCompilerParams New="',AValue,'"']); FLastCompilerParams:=AValue; end; procedure TProject.SetMainProject(const AValue: boolean); begin if MainProject=AValue then exit; FMainProject:=AValue; if MainProject then SourceDirectories.AddFilename(VirtualDirectory) else SourceDirectories.RemoveFilename(VirtualDirectory); end; procedure TProject.SetSkipCheckLCLInterfaces(const AValue: boolean); begin if FSkipCheckLCLInterfaces=AValue then exit; FSkipCheckLCLInterfaces:=AValue; SessionModified:=true; end; procedure TProject.SetStorePathDelim(const AValue: TPathDelimSwitch); begin if FStorePathDelim=AValue then exit; FStorePathDelim:=AValue; {$IFDEF VerboseIDEModified} debugln(['TProject.SetStorePathDelim ']); {$ENDIF} Modified:=true; end; function TProject.JumpHistoryCheckPosition( APosition: TProjectJumpHistoryPosition): boolean; var i: integer; begin i:=IndexOfFilename(APosition.Filename); Result:=(i>=0) and (Units[i].OpenEditorInfoCount > 0); end; function TProject.SomethingModified(CheckData, CheckSession: boolean; Verbose: boolean): boolean; begin Result := True; if CheckData and SomeDataModified(Verbose) then exit; if CheckSession and SomeSessionModified(Verbose) then exit; Result := False; end; function TProject.SomeDataModified(Verbose: boolean): boolean; var AnUnitInfo: TUnitInfo; begin Result:=true; if Modified then begin if Verbose then DebugLn('TProject.SomeDataModified Modified'); Exit; end; if BuildModes.IsModified(false) then begin if Verbose then DebugLn(['TProject.SomeDataModified CompilerOptions/BuildModes']); Exit; end; AnUnitInfo:=FirstPartOfProject; while AnUnitInfo<>nil do begin if AnUnitInfo.Modified then begin if Verbose then DebugLn('TProject.SomeDataModified PartOfProject ',AnUnitInfo.Filename); Exit; end; AnUnitInfo:=AnUnitInfo.NextPartOfProject; end; Result:=false; end; function TProject.SomeSessionModified(Verbose: boolean): boolean; var i: Integer; begin Result:=true; if SessionModified then begin if Verbose then DebugLn('TProject.SomeSessionModified SessionModified'); Exit; end; if BuildModes.IsModified(true) then begin if Verbose then DebugLn(['TProject.SomeSessionModified CompilerOptions/BuildModes']); Exit; end; for i := 0 to UnitCount - 1 do begin if Units[i].SessionModified then begin if Verbose then DebugLn('TProject.SomeSessionModified Session of ',Units[i].Filename); exit; end; if (not Units[i].IsPartOfProject) and Units[i].Modified then begin if Verbose then DebugLn('TProject.SomeSessionModified Not PartOfProject ',Units[i].Filename); exit; end; end; Result:=false; end; procedure TProject.MainSourceFilenameChanged; begin end; function TProject.UnitWithComponent(AComponent: TComponent): TUnitInfo; begin Result:=fFirst[uilWithComponent]; while (Result<>nil) and (Result.Component<>AComponent) do Result:=Result.fNext[uilWithComponent]; end; function TProject.UnitWithComponentClass(AClass: TComponentClass): TUnitInfo; begin Result:=fFirst[uilWithComponent]; while (Result<>nil) and (Result.Component.ClassType<>AClass) do Result:=Result.fNext[uilWithComponent]; end; function TProject.UnitWithComponentClassName(const AClassName: string ): TUnitInfo; begin Result := fFirst[uilWithComponent]; while (Result<>nil) and (SysUtils.CompareText(Result.Component.ClassName, AClassName) <> 0) do Result := Result.fNext[uilWithComponent]; end; function TProject.UnitWithComponentName(AComponentName: String; OnlyPartOfProject: boolean): TUnitInfo; var i: Integer; begin if OnlyPartOfProject then begin Result := fFirst[uilPartOfProject]; while (Result<>nil) and (SysUtils.CompareText(Result.ComponentName, AComponentName) <> 0) do Result := Result.fNext[uilPartOfProject]; end else begin Result:=nil; for i:=0 to UnitCount-1 do if SysUtils.CompareText(Units[i].ComponentName,AComponentName)=0 then begin Result:=Units[i]; exit; end; end; end; function TProject.UnitComponentInheritingFrom(AClass: TComponentClass; Ignore: TUnitInfo): TUnitInfo; begin Result:=fFirst[uilWithComponent]; while (Result<>nil) do begin if (Result<>Ignore) and Result.Component.InheritsFrom(AClass) then exit; Result:=Result.fNext[uilWithComponent]; end; end; function TProject.UnitUsingComponentUnit(ComponentUnit: TUnitInfo; Types: TUnitCompDependencyTypes): TUnitInfo; var Dependency: TUnitComponentDependency; begin Result:=nil; Dependency:=ComponentUnit.FindUsedByComponentDependency(Types); if Dependency=nil then exit; Result:=Dependency.UsedByUnit; end; function TProject.UnitComponentIsUsed(ComponentUnit: TUnitInfo; CheckHasDesigner: boolean): boolean; begin if ComponentUnit.Component=nil then exit(false); if CheckHasDesigner and (uifComponentUsedByDesigner in ComponentUnit.Flags) then exit(true); if (uifComponentIndirectlyUsedByDesigner in ComponentUnit.Flags) then exit(true); if ComponentUnit.FindUsedByComponentDependency([ucdtAncestor])<>nil then exit(true); if ComponentUnit.FindUsedByComponentDependency([ucdtInlineClass])<>nil then exit(true); Result:=false; end; function TProject.UnitInfoWithFilename(const AFilename: string): TUnitInfo; var i: Integer; begin i:=IndexOfFilename(AFilename); if i>=0 then Result:=Units[i] else Result:=nil; end; function TProject.UnitInfoWithFilename(const AFilename: string; SearchFlags: TProjectFileSearchFlags): TUnitInfo; function MakeFilenameComparable(const TheFilename: string): string; begin Result:=TheFilename; if (pfsfResolveFileLinks in SearchFlags) and FilenameIsAbsolute(Result) then Result:=GetPhysicalFilenameCached(Result,false); end; function FindFileInList(ListType: TUnitInfoList): TUnitInfo; var BaseFilename: String; CurBaseFilename: String; begin BaseFilename:=MakeFilenameComparable(AFilename); Result:=fFirst[ListType]; while Result<>nil do begin CurBaseFilename:=MakeFilenameComparable(Result.Filename); if CompareFilenames(BaseFilename,CurBaseFilename)=0 then exit; Result:=Result.fNext[ListType]; end; end; var i: Integer; begin if (SearchFlags-[pfsfResolveFileLinks]=[pfsfOnlyEditorFiles]) then // search only in list of Files with EditorIndex // There is a list, so we can search much faster Result:=FindFileInList(uilWithEditorIndex) else if (SearchFlags-[pfsfResolveFileLinks]=[pfsfOnlyProjectFiles]) then // search only in list of project files // There is a list, so we can search much faster Result:=FindFileInList(uilPartOfProject) else begin // slow search i:=IndexOfFilename(AFilename,SearchFlags); if i>=0 then Result:=Units[i] else Result:=nil; end; end; function TProject.UnitWithUnitname(const AnUnitname: string): TUnitInfo; var i: Integer; begin i:=IndexOfUnitWithName(AnUnitName,true,nil); if i>=0 then Result:=Units[i] else Result:=nil; end; function TProject.AllEditorsInfoCount: Integer; begin Result := FAllEditorsInfoList.Count; end; function TProject.EditorInfoWithEditorComponent(AEditor: TSourceEditorInterface): TUnitEditorInfo; begin Result := Nil; FAllEditorsInfoMap.GetData(AEditor, Result); end; procedure TProject.EditorInfoAdd(EdInfo: TUnitEditorInfo); begin FAllEditorsInfoList.Add(EdInfo); Assert(not Assigned(EdInfo.EditorComponent), 'TUnitEditorInfo.EditorComponent should not be assigned. It is set later.'); end; procedure TProject.EditorInfoRemove(EdInfo: TUnitEditorInfo); begin FAllEditorsInfoList.Remove(EdInfo); if Assigned(EdInfo.EditorComponent) then FAllEditorsInfoMap.Delete(EdInfo.EditorComponent); end; procedure TProject.OnMacroEngineSubstitution(TheMacro: TTransferMacro; const MacroName: string; var s: string; const Data: PtrInt; var Handled, Abort: boolean; Depth: integer); var Values: TCTCfgScriptVariables; Macro: PCTCfgScriptVariable; var NewValue: String; begin if Data=CompilerOptionMacroPlatformIndependent then begin NewValue:=GetMakefileMacroValue(MacroName); if NewValue<>'' then begin s:=NewValue; Handled:=true; exit; end; end; // check build macros if (MacroName<>'') and IsValidIdent(MacroName) then begin Values:=GetBuildMacroValues(CompilerOptions,true); if Values<>nil then begin Macro:=Values.GetVariable(PChar(MacroName)); if Macro<>nil then begin s:=GetCTCSVariableAsString(Macro); //debugln(['TProject.OnMacroEngineSubstitution Macro=',MacroName,' Value="',s,'"']); Handled:=true; exit; end; end; end; // check local macros // check global macros GlobalMacroList.ExecuteMacro(MacroName,s,Data,Handled,Abort,Depth); end; function TProject.SearchFile(const ShortFilename: string; SearchFlags: TSearchIDEFileFlags): TUnitInfo; var SearchedFilename: String; function FilenameFits(AFilename: string): boolean; begin if siffIgnoreExtension in SearchFlags then AFileName:=ExtractFilenameOnly(AFileName); if FilenameIsAbsolute(AFileName) then AFileName:=ExtractFilename(AFileName); if siffCaseSensitive in SearchFlags then Result:=SearchedFilename=AFilename else // check Pascal case insensitivity (CompareText, do not use CompareFilenamesIgnoreCase, because of Turkish I) Result:=CompareText(SearchedFilename,AFilename)=0; end; begin SearchedFilename:=ShortFilename; if siffIgnoreExtension in SearchFlags then SearchedFilename:=ExtractFilenameOnly(SearchedFilename); // search in files which are part of the project Result:=FirstPartOfProject; while Result<>nil do begin if FilenameFits(Result.Filename) then exit; Result:=Result.NextPartOfProject; end; // search in files opened in editor if not (siffDoNotCheckOpenFiles in SearchFlags) then begin Result:=FirstUnitWithEditorIndex; while Result<>nil do begin if FilenameFits(Result.Filename) then exit; Result:=Result.NextUnitWithEditorIndex; end; end; end; function TProject.FindFile(const AFilename: string; SearchFlags: TProjectFileSearchFlags): TLazProjectFile; begin Result:=UnitInfoWithFilename(AFilename, SearchFlags); end; function TProject.IndexOfFilename(const AFilename: string): integer; begin Result:=UnitCount-1; while (Result>=0) do begin if CompareFilenames(AFilename,Units[Result].Filename)=0 then exit; dec(Result); end; end; function TProject.IndexOfFilename(const AFilename: string; SearchFlags: TProjectFileSearchFlags): integer; function MakeFilenameComparable(const TheFilename: string): string; begin Result:=TheFilename; if (pfsfResolveFileLinks in SearchFlags) and (FilenameIsAbsolute(Result)) then Result:=GetPhysicalFilenameCached(Result,false); end; var BaseFilename: String; CurBaseFilename: String; begin BaseFilename:=MakeFilenameComparable(AFilename); Result:=UnitCount-1; while (Result>=0) do begin if (pfsfOnlyEditorFiles in SearchFlags) and (Units[Result].OpenEditorInfoCount = 0) then begin dec(Result); continue; end; if (pfsfOnlyVirtualFiles in SearchFlags) and (not Units[Result].IsVirtual) then begin dec(Result); continue; end; if (pfsfOnlyProjectFiles in SearchFlags) and (not Units[Result].IsPartOfProject) then begin dec(Result); continue; end; CurBaseFilename:=MakeFilenameComparable(Units[Result].Filename); if CompareFilenames(BaseFilename,CurBaseFilename)=0 then exit; dec(Result); end; end; function TProject.ProjectUnitWithFilename(const AFilename: string): TUnitInfo; begin Result:=fFirst[uilPartOfProject]; while Result<>nil do begin if CompareFileNames(AFilename,Result.Filename)=0 then exit; Result:=Result.fNext[uilPartOfProject]; end; end; function TProject.ProjectUnitWithShortFilename(const ShortFilename: string): TUnitInfo; begin Result:=fFirst[uilPartOfProject]; while Result<>nil do begin if CompareFileNames(ShortFilename,ExtractFilename(Result.Filename))=0 then exit; Result:=Result.fNext[uilPartOfProject]; end; end; function TProject.ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo; begin Result:=fFirst[uilPartOfProject]; while Result<>nil do begin if CompareText(AnUnitName,Result.SrcUnitName)=0 then exit; Result:=Result.fNext[uilPartOfProject]; end; end; procedure TProject.UpdateFileBuffer; begin fProjectInfoFileBuffer:=CodeToolBoss.LoadFile(ProjectInfoFile,true,true); fProjectInfoFileDate:=FileAgeCached(ProjectInfoFile); if fProjectInfoFileBuffer<>nil then fProjectInfoFileBufChangeStamp:=fProjectInfoFileBuffer.ChangeStep else fProjectInfoFileBufChangeStamp:=CTInvalidChangeStamp; end; procedure TProject.UpdateProjectDirectory; var i: Integer; begin if fDestroying then exit; fProjectDirectory:=ExtractFilePath(fProjectInfoFile); if BuildModes<>nil then for i:=0 to BuildModes.Count-1 do BuildModes[i].CompilerOptions.BaseDirectory:=fProjectDirectory; if fProjectDirectory<>fProjectDirectoryReferenced then begin if fProjectDirectoryReferenced<>'' then FSourceDirectories.RemoveFilename(fProjectDirectoryReferenced); if fProjectDirectory<>'' then FSourceDirectories.AddFilename(fProjectDirectory); fProjectDirectoryReferenced:=fProjectDirectory; end; end; procedure TProject.UpdateSessionFilename; begin case SessionStorage of pssInProjectInfo: ProjectSessionFile:=ProjectInfoFile; pssInProjectDir: ProjectSessionFile:=ChangeFileExt(ProjectInfoFile,'.lps'); pssInIDEConfig: ProjectSessionFile:=AppendPathDelim(GetProjectSessionsConfigPath) +ExtractFileNameOnly(ProjectInfoFile)+'.lps'; pssNone: ProjectSessionFile:=''; end; end; procedure TProject.UpdateSourceDirectories; var Cnt: Integer; i: Integer; AnUnitInfo: TUnitInfo; begin Cnt:=FUnitList.Count; for i:=0 to Cnt-1 do begin AnUnitInfo:=Units[i]; AnUnitInfo.FSourceDirectoryReferenced:=false; end; ClearSourceDirectories; for i:=0 to Cnt-1 do begin AnUnitInfo:=Units[i]; AnUnitInfo.AutoReferenceSourceDir:=true; AnUnitInfo.UpdateSourceDirectoryReference; end; //DebugLn('TProject.UpdateSourceDirectories B ',UnitCount,' "',fSourceDirectories.CreateSearchPathFromAllFiles,'"'); end; procedure TProject.UpdateUsageCounts(const ConfigFilename: string); var UnitUsageCount: TDateTime; DiffTime: TDateTime; i: Integer; begin UnitUsageCount:=0; if CompareFileNames(ConfigFilename,fLastReadLPIFilename)=0 then begin DiffTime:=Now-fLastReadLPIFileDate; if DiffTime>0 then UnitUsageCount:= DiffTime*24; // one step every hour fLastReadLPIFileDate:=Now; end; for i:=0 to UnitCount-1 do begin if Units[i].IsPartOfProject then Units[i].UpdateUsageCount(uuIsPartOfProject,UnitUsageCount) else if Units[i].Loaded then Units[i].UpdateUsageCount(uuIsLoaded,UnitUsageCount) else Units[i].UpdateUsageCount(uuNotUsed,UnitUsageCount); end; end; function TProject.UnitMustBeSaved(UnitInfo: TUnitInfo; WriteFlags: TProjectWriteFlags; SaveSession: boolean): boolean; begin Result:=false; if not UnitInfo.IsPartOfProject then begin if not SaveSession then exit; if (pfSaveOnlyProjectUnits in Flags) then exit; if (pwfSaveOnlyProjectUnits in WriteFlags) then exit; if (not UnitInfo.Loaded) then begin if (not (pfSaveClosedUnits in Flags)) then exit; if (pwfSkipClosedUnits in WriteFlags) then exit; if UnitInfo.fUsageCount<=0 then exit; end; end; Result:=true; end; procedure TProject.UpdateVisibleEditor(PgIndex: integer); var i: Integer; begin i := AllEditorsInfoCount - 1; while i >= 0 do begin if (AllEditorsInfo[i].PageIndex = PgIndex) then AllEditorsInfo[i].IsVisibleTab := True; dec(i); end; end; procedure TProject.LoadDefaultSession; var AnUnitInfo: TUnitInfo; BestUnitInfo: TUnitInfo; begin BestUnitInfo:=FirstUnitWithEditorIndex; if (BestUnitInfo<>nil) and (BestUnitInfo.Loaded) and FileExistsCached(BestUnitInfo.Filename) then exit; BestUnitInfo:=nil; if (MainUnitID>=0) then begin if Requires(PackageGraph.LCLPackage,true) and (Flags*[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement]<>[]) then begin // this is a probably a LCL project where the main source only contains // automatic code end else BestUnitInfo:=MainUnitInfo; end; if BestUnitInfo=nil then begin AnUnitInfo:=FirstPartOfProject; while AnUnitInfo<>nil do begin if FileExistsCached(AnUnitInfo.Filename) then begin if (BestUnitInfo=nil) or (FilenameIsPascalUnit(AnUnitInfo.Filename) and (not FilenameIsPascalUnit(BestUnitInfo.Filename))) then begin BestUnitInfo:=AnUnitInfo; end; end; AnUnitInfo:=AnUnitInfo.NextPartOfProject; end; end; if BestUnitInfo<>nil then begin BestUnitInfo.EditorInfo[0].PageIndex := 0; BestUnitInfo.EditorInfo[0].WindowID := 0; BestUnitInfo.EditorInfo[0].IsVisibleTab := True; ActiveWindowIndexAtStart:=0; BestUnitInfo.Loaded:=true; end; end; procedure TProject.ClearSourceDirectories; begin FSourceDirectories.Clear; fProjectDirectoryReferenced:=''; if MainProject then FSourceDirectories.AddFilename(VirtualDirectory); if (fProjectDirectory<>'') then begin FSourceDirectories.AddFilename(fProjectDirectory); fProjectDirectoryReferenced:=fProjectDirectory; end; end; procedure TProject.SourceDirectoriesChanged(Sender: TObject); begin FDefineTemplates.SourceDirectoriesChanged; end; function TProject.GetDefineTemplates: TProjPackDefineTemplates; begin Result:=FDefineTemplates; end; function TProject.GetMainFile: TLazProjectFile; begin Result:=MainUnitInfo; end; function TProject.GetMainFileID: Integer; begin Result:=MainUnitID; end; procedure TProject.SetMainFileID(const AValue: Integer); begin MainUnitID:=AValue; end; function TProject.GetLazBuildModes: TLazProjectBuildModes; begin Result:=FBuildModes; end; procedure TProject.AddToList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList); begin // add to list if AnUnitInfo is not in list if (fFirst[ListType]<>AnUnitInfo) and (AnUnitInfo.fNext[ListType]=nil) and (AnUnitInfo.fPrev[ListType]=nil) then begin AnUnitInfo.fPrev[ListType]:=fLast[ListType]; AnUnitInfo.fNext[ListType]:=nil; if fFirst[ListType]=nil then fFirst[ListType]:=AnUnitInfo else fLast[ListType].fNext[ListType]:=AnUnitInfo; fLast[ListType]:=AnUnitInfo; end; end; procedure TProject.RemoveFromList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList); begin // remove from list if AnUnitInfo is in list if fFirst[ListType]=AnUnitInfo then fFirst[ListType]:=AnUnitInfo.fNext[ListType]; if fLast[ListType]=AnUnitInfo then fLast[ListType]:=AnUnitInfo.fPrev[ListType]; if AnUnitInfo.fNext[ListType]<>nil then AnUnitInfo.fNext[ListType].fPrev[ListType]:=AnUnitInfo.fPrev[ListType]; if AnUnitInfo.fPrev[ListType]<>nil then AnUnitInfo.fPrev[ListType].fNext[ListType]:=AnUnitInfo.fNext[ListType]; AnUnitInfo.fNext[ListType]:=nil; AnUnitInfo.fPrev[ListType]:=nil; end; { TProjectCompilationToolOptions } procedure TProjectCompilationToolOptions.SetCompileReasons( const AValue: TCompileReasons); begin if FCompileReasons=AValue then exit; FCompileReasons:=AValue; {$IFDEF VerboseIDEModified} debugln(['TProjectCompilationToolOptions.SetCompileReasons']); {$ENDIF} IncreaseChangeStamp; end; procedure TProjectCompilationToolOptions.SetDefaultCompileReasons( const AValue: TCompileReasons); begin if FDefaultCompileReasons=AValue then exit; FDefaultCompileReasons:=AValue; {$IFDEF VerboseIDEModified} debugln(['TProjectCompilationToolOptions.SetDefaultCompileReasons']); {$ENDIF} IncreaseChangeStamp; end; procedure TProjectCompilationToolOptions.SubstituteMacros(var s: string); var CompOpts: TProjectCompilerOptions; begin if Owner is TProjectCompilerOptions then begin CompOpts:=TProjectCompilerOptions(Owner); //debugln(['TProjectCompilationToolOptions.SubstituteMacros ',DbgSName(Owner),' ',CompOpts.LazProject<>nil]); s:=CompOpts.SubstituteProjectMacros(s,false); end else inherited SubstituteMacros(s); end; procedure TProjectCompilationToolOptions.Clear; begin inherited Clear; CompileReasons := crAll; end; function TProjectCompilationToolOptions.CreateDiff( CompOpts: TCompilationToolOptions; Tool: TCompilerDiffTool): boolean; begin if (CompOpts is TProjectCompilationToolOptions) then begin Result:=AddCompileReasonsDiff('CompileReasons',CompileReasons, TProjectCompilationToolOptions(CompOpts).CompileReasons,Tool); end else begin Result:=true; if Tool<>nil then Tool.Differ:=true; end; if (Tool=nil) and Result then exit; if (inherited CreateDiff(CompOpts, Tool)) then Result:=true; end; procedure TProjectCompilationToolOptions.Assign(Src: TCompilationToolOptions); begin inherited Assign(Src); if Src is TProjectCompilationToolOptions then begin CompileReasons := TProjectCompilationToolOptions(Src).CompileReasons; end else begin CompileReasons := crAll; end; end; procedure TProjectCompilationToolOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; DoSwitchPathDelims: boolean); begin inherited LoadFromXMLConfig(XMLConfig, Path, DoSwitchPathDelims); CompileReasons := LoadXMLCompileReasons(XMLConfig, Path+'CompileReasons/', DefaultCompileReasons); //debugln(['TProjectCompilationToolOptions.LoadFromXMLConfig ',Path,' ',crCompile in CompileReasons]); end; procedure TProjectCompilationToolOptions.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; UsePathDelim: TPathDelimSwitch); begin inherited SaveToXMLConfig(XMLConfig, Path, UsePathDelim); SaveXMLCompileReasons(XMLConfig, Path+'CompileReasons/', CompileReasons, DefaultCompileReasons); //debugln(['TProjectCompilationToolOptions.SaveToXMLConfig ',Path,' ',crCompile in CompileReasons]); end; function TProjectCompilationToolOptions.GetProject: TProject; begin if (Owner is TProjectCompilerOptions) then Result:=TProjectCompilerOptions(Owner).LazProject else Result:=nil; end; { TProjectCompilerOptions } procedure TProjectCompilerOptions.LoadFromXMLConfig(AXMLConfig: TXMLConfig; const Path: string); begin inherited LoadFromXMLConfig(AXMLConfig,Path); //FileVersion:=aXMLConfig.GetValue(Path+'Version/Value', 0); // old compatibility if AXMLConfig.GetValue(Path+'SkipCompiler/Value',false) then FCompileReasons := [] else FCompileReasons := LoadXMLCompileReasons(AXMLConfig,Path+'CompileReasons/',crAll); //debugln(['TProjectCompilerOptions.LoadFromXMLConfig ',Path+'CompileReasons/ ',crCompile in FCompileReasons]); end; procedure TProjectCompilerOptions.SaveToXMLConfig(AXMLConfig: TXMLConfig; const Path: string); begin inherited SaveToXMLConfig(AXMLConfig,Path); SaveXMLCompileReasons(AXMLConfig, Path+'CompileReasons/', FCompileReasons, crAll); //debugln(['TProjectCompilerOptions.SaveToXMLConfig ',Path+'CompileReasons/ ',crCompile in FCompileReasons]); end; procedure TProjectCompilerOptions.SetTargetCPU(const AValue: string); begin inherited SetTargetCPU(AValue); end; procedure TProjectCompilerOptions.SetTargetOS(const AValue: string); begin inherited SetTargetOS(AValue); end; procedure TProjectCompilerOptions.SetCustomOptions(const AValue: string); begin if CustomOptions=AValue then exit; InvalidateOptions; inherited SetCustomOptions(AValue); if IsActive then LazProject.DefineTemplates.CustomDefinesChanged; end; procedure TProjectCompilerOptions.SetIncludePaths(const AValue: string); begin if IncludePath=AValue then exit; InvalidateOptions; inherited SetIncludePaths(AValue); end; procedure TProjectCompilerOptions.SetLibraryPaths(const AValue: string); begin if Libraries=AValue then exit; InvalidateOptions; inherited SetLibraryPaths(AValue); end; procedure TProjectCompilerOptions.SetLinkerOptions(const AValue: string); begin if LinkerOptions=AValue then exit; InvalidateOptions; inherited SetLinkerOptions(AValue); end; procedure TProjectCompilerOptions.SetObjectPath(const AValue: string); begin if ObjectPath=AValue then exit; InvalidateOptions; inherited SetObjectPath(AValue); end; procedure TProjectCompilerOptions.SetSrcPath(const AValue: string); begin if SrcPath=AValue then exit; InvalidateOptions; inherited SetSrcPath(AValue); end; procedure TProjectCompilerOptions.SetUnitPaths(const AValue: string); begin if OtherUnitFiles=AValue then exit; InvalidateOptions; inherited SetUnitPaths(AValue); end; procedure TProjectCompilerOptions.SetUnitOutputDir(const AValue: string); begin if UnitOutputDirectory=AValue then exit; InvalidateOptions; inherited SetUnitOutputDir(AValue); if IsActive then LazProject.DefineTemplates.OutputDirectoryChanged; end; procedure TProjectCompilerOptions.SetConditionals(AValue: string); begin AValue:=UTF8Trim(AValue,[]); if Conditionals=AValue then exit; InvalidateOptions; inherited SetConditionals(AValue); end; function TProjectCompilerOptions.SubstituteProjectMacros(const s: string; PlatformIndependent: boolean): string; begin Result:=s; if LazProject=nil then exit; //debugln(['TProjectCompilerOptions.SubstituteProjectMacros s="',s,'"']); if PlatformIndependent then begin if not LazProject.MacroEngine.SubstituteStr(Result,CompilerOptionMacroPlatformIndependent) then debugln(['TProjectCompilerOptions.SubstituteProjectMacros failed: "',CompilerOptionMacroPlatformIndependent,'"']); end else begin if not LazProject.MacroEngine.SubstituteStr(Result,CompilerOptionMacroNormal) then debugln(['TProjectCompilerOptions.SubstituteProjectMacros failed: "',CompilerOptionMacroNormal,'"']); end; end; procedure TProjectCompilerOptions.Assign(Source: TPersistent); var ProjCompOptions: TProjectCompilerOptions; begin inherited Assign(Source); if Source is TProjectCompilerOptions then begin ProjCompOptions:=TProjectCompilerOptions(Source); FCompileReasons:=ProjCompOptions.FCompileReasons; end else begin FCompileReasons:=[crCompile, crBuild, crRun]; // keep BuildModes end; end; function TProjectCompilerOptions.IsEqual(CompOpts: TBaseCompilerOptions): boolean; begin Result:=inherited IsEqual(CompOpts); end; function TProjectCompilerOptions.CreateDiff(CompOpts: TBaseCompilerOptions; Tool: TCompilerDiffTool): boolean; begin //if Tool<>nil then debugln(['TProjectCompilerOptions.CreateDiff ',DbgSName(Self)]); if (CompOpts is TProjectCompilerOptions) then begin Result:=AddCompileReasonsDiff('CompileReasons',FCompileReasons, TProjectCompilerOptions(CompOpts).FCompileReasons,Tool); end else begin Result:=true; if Tool<>nil then Tool.Differ:=true; end; //if Tool<>nil then debugln(['TProjectCompilerOptions.CreateDiff Before inherited ',Result]); if (Tool=nil) and Result then exit; if (inherited CreateDiff(CompOpts, Tool)) then Result:=true; end; procedure TProjectCompilerOptions.InvalidateOptions; begin if (LazProject=nil) then exit; end; procedure TProjectCompilerOptions.SetAlternativeCompile(const Command: string; ScanFPCMsgs: boolean); begin inherited SetAlternativeCompile(Command, ScanFPCMsgs); CompileReasons:=[]; end; class function TProjectCompilerOptions.GetInstance: TAbstractIDEOptions; begin Result := Project1.CompilerOptions; end; class function TProjectCompilerOptions.GetGroupCaption: string; begin Result := dlgCompilerOptions; end; constructor TProjectCompilerOptions.Create(const AOwner: TObject); begin FCompileReasons := [crCompile, crBuild, crRun]; inherited Create(AOwner, TProjectCompilationToolOptions); with TProjectCompilationToolOptions(ExecuteBefore) do begin DefaultCompileReasons:=crAll; CompileReasons:=DefaultCompileReasons; end; with TProjectCompilationToolOptions(ExecuteAfter) do begin DefaultCompileReasons:=crAll; CompileReasons:=DefaultCompileReasons; end; if AOwner <> nil then FProject := AOwner as TProject; ParsedOpts.OnLocalSubstitute:=@SubstituteProjectMacros; end; destructor TProjectCompilerOptions.Destroy; begin inherited Destroy; end; function TProjectCompilerOptions.IsActive: boolean; begin Result:=(LazProject<>nil) and (LazProject.CompilerOptions=Self) and not LazProject.BuildModes.Assigning; end; procedure TProjectCompilerOptions.Clear; begin inherited Clear; end; function TProjectCompilerOptions.CanBeDefaulForProject: boolean; begin Result:=true; end; function TProjectCompilerOptions.GetOwnerName: string; begin Result:=LazProject.GetTitleOrName; if Result='' then Result:=ExtractFilename(LazProject.ProjectInfoFile); end; function TProjectCompilerOptions.GetDefaultMainSourceFileName: string; var MainUnitInfo: TUnitInfo; begin MainUnitInfo:=FProject.MainUnitInfo; if (MainUnitInfo<>nil) then Result:=ExtractFileName(MainUnitInfo.Filename) else Result:=''; if Result='' then Result:=inherited GetDefaultMainSourceFileName; end; procedure TProjectCompilerOptions.GetInheritedCompilerOptions( var OptionsList: TFPList); var PkgList: TFPList; ReqFlags: TPkgIntfRequiredFlags; begin PkgList:=nil; try ReqFlags:=[]; if not (pfUseDesignTimePackages in LazProject.Flags) then Include(ReqFlags,pirSkipDesignTimeOnly); LazProject.GetAllRequiredPackages(PkgList,ReqFlags); OptionsList:=GetUsageOptionsList(PkgList); finally PkgList.Free; end; end; { TProjectDefineTemplates } constructor TProjectDefineTemplates.Create(AOwner: IProjPack); begin inherited Create(AOwner); end; destructor TProjectDefineTemplates.Destroy; begin inherited Destroy; end; procedure TProjectDefineTemplates.UpdateMain; begin if (Owner as TProject).Destroying then exit; // update the package block define template (the container for all other // define templates of the project) if FMain=nil then begin // create the main project template FMain:=CreateProjectTemplateWithID(Owner.IDAsWord); FMain.SetDefineOwner(Owner as TProject,false); FMain.SetFlags([dtfAutoGenerated],[],false); end else FMain.Name:=Owner.IDAsWord; // ClearCache is here unnessary, because it is only a block end; procedure TProjectDefineTemplates.UpdateSrcDirIfDef; var Changed: Boolean; UnitPathDefTempl: TDefineTemplate; IncPathDefTempl: TDefineTemplate; SrcPathDefTempl: TDefineTemplate; IfValue: String; begin // The options are enclosed by an // IFDEF #ProjectSrcMark template. // Each source directory defines this variable, so that the settings can be // activated for each source directory by a simple DEFINE. if (FMain=nil) then UpdateMain; if FSrcDirectories=nil then begin FSrcDirectories:=TDefineTemplate.Create('Source Directories', 'Source Directories','','', da_Block); FMain.AddChild(FSrcDirectories); end; Changed:=false; IfValue:='defined(#ProjectSrcMark'+Owner.IDAsWord+')'; if (Owner as TProject) = Project1 then IfValue:=IfValue+' or defined('+UseDefaultsFlagName+')'; if FSrcDirIf=nil then begin FSrcDirIf:=TDefineTemplate.Create('Source Directory Additions', 'Additional defines for project source directories and all directories using defaults', '',IfValue, da_If); FMain.AddChild(FSrcDirIf); // create unit path template for this directory UnitPathDefTempl:=TDefineTemplate.Create('UnitPath', lisPkgDefsUnitPath, '#UnitPath','$(#UnitPath);$ProjectUnitPath('+Owner.IDAsString+')', da_Define); FSrcDirIf.AddChild(UnitPathDefTempl); // create include path template for this directory IncPathDefTempl:=TDefineTemplate.Create('IncPath','Include Path', '#IncPath','$(#IncPath);$ProjectIncPath('+Owner.IDAsString+')', da_Define); FSrcDirIf.AddChild(IncPathDefTempl); // create src path template for this directory SrcPathDefTempl:=TDefineTemplate.Create('SrcPath','Src Path', '#SrcPath','$(#SrcPath);$ProjectSrcPath('+Owner.IDAsString+')', da_Define); FSrcDirIf.AddChild(SrcPathDefTempl); Changed:=true; end else begin if FSrcDirIf.Value<>IfValue then begin FSrcDirIf.Value:=IfValue; Changed:=true; end; end; if Changed then CodeToolBoss.DefineTree.ClearCache; end; procedure TProjectDefineTemplates.UpdateOutputDirectory; var Proj: TProject; begin Proj := Owner as TProject; //DebugLn('TProjectDefineTemplates.UpdateDefinesForOutputDirectory ',Owner.IDAsString); if (not Owner.NeedsDefineTemplates) or (not Active) then exit; if FMain=nil then UpdateMain; if FOutputDir=nil then begin //DebugLn('TProjectDefineTemplates.UpdateDefinesForOutputDirectory ',Owner.IDAsString,' creating FOutputDir'); FOutputDir:=TDefineTemplate.Create(ProjectOutputDirDefTemplName, 'Output directoy of proj', '', Proj.GetOutputDirectory, da_Directory); FOutputDir.SetDefineOwner(Proj,false); FOutputDir.SetFlags([dtfAutoGenerated],[],false); DisableDefaultsInDirectories(FOutputDir,false); FMain.AddChild(FOutputDir); FixTemplateOrder; end else begin FOutputDir.Value:=Proj.GetOutputDirectory; end; if (FOutPutSrcPath=nil) or (fLastOutputDirSrcPathIDAsString<>Owner.IDAsString) then begin fLastOutputDirSrcPathIDAsString:=Owner.IDAsString; FOutputSrcPath:=TDefineTemplate.Create('CompiledSrcPath', lisPkgDefsCompiledSrcPathAddition, CompiledSrcPathMacroName, '$ProjectSrcPath('+fLastOutputDirSrcPathIDAsString+');' +'$('+CompiledSrcPathMacroName+')', da_Define); FOutputSrcPath.SetDefineOwner(Proj,false); FOutputSrcPath.SetFlags([dtfAutoGenerated],[],false); CodeToolBoss.DefineTree.ReplaceChild(FOutputDir,FOutputSrcPath, FOutputSrcPath.Name); end; end; procedure TProjectDefineTemplates.UpdateSourceDirectories; var NewSourceDirs: TStringList; i: Integer; SrcDirDefTempl: TDefineTemplate; IDHasChanged: Boolean; SrcDirMarkDefTempl: TDefineTemplate; CurUnitPath: String; begin //DebugLn('TProjectDefineTemplates.UpdateDefinesForSourceDirectories ',Owner.IDAsString,' Active=',dbgs(Active),' TimeStamp=',dbgs(fLastSourceDirStamp),' Project.TimeStamp=',dbgs(Project.SourceDirectories.TimeStamp)); if (not Owner.NeedsDefineTemplates) or (not Active) then exit; // quick check if something has changed IDHasChanged:=fLastSourceDirsIDAsString<>Owner.IDAsString; CurUnitPath:=Owner.BaseCompilerOptions.ParsedOpts.GetParsedValue(pcosUnitPath); CurUnitPath:=CreateAbsoluteSearchPath(CurUnitPath, Owner.BaseCompilerOptions.BaseDirectory); //DebugLn('TProjectDefineTemplates.UpdateDefinesForSourceDirectories A'); if (fLastSourceDirectories<>nil) and (fLastSourceDirStamp=Owner.SourceDirectories.TimeStamp) and (not IDHasChanged) and (CurUnitPath=fLastUnitPath) then exit; fLastSourceDirStamp:=Owner.SourceDirectories.TimeStamp; fLastSourceDirsIDAsString:=Owner.IDAsString; fLastUnitPath:=CurUnitPath; NewSourceDirs:=Owner.SourceDirectories.CreateFileList; //DebugLn('TProjectDefineTemplates.UpdateDefinesForSourceDirectories B "',NewSourceDirs.Text,'"'); try MergeSearchPaths(NewSourceDirs,CurUnitPath); // real check if something has changed if (fLastSourceDirectories<>nil) and (NewSourceDirs.Count=fLastSourceDirectories.Count) and (not IDHasChanged) then begin i:=NewSourceDirs.Count-1; while (i>=0) and (CompareFilenames(NewSourceDirs[i],fLastSourceDirectories[i])=0) do dec(i); if i<0 then exit; end; // clear old define templates if fLastSourceDirectories<>nil then begin for i:=0 to fLastSourceDirectories.Count-1 do begin SrcDirDefTempl:=TDefineTemplate(fLastSourceDirectories.Objects[i]); SrcDirDefTempl.Unbind; SrcDirDefTempl.Free; end; fLastSourceDirectories.Clear; end else fLastSourceDirectories:=TStringList.Create; // build source directory define templates fLastSourceDirectories.Assign(NewSourceDirs); if (FSrcDirIf=nil) and (fLastSourceDirectories.Count>0) then UpdateSrcDirIfDef; for i:=0 to fLastSourceDirectories.Count-1 do begin // create directory template SrcDirDefTempl:=TDefineTemplate.Create('Source Directory '+IntToStr(i+1), fLastSourceDirectories[i],'',fLastSourceDirectories[i],da_Directory); DisableDefaultsInDirectories(SrcDirDefTempl,false); fLastSourceDirectories.Objects[i]:=SrcDirDefTempl; // add proj source directory marker SrcDirMarkDefTempl:=TDefineTemplate.Create('ProjectSrcDirMark', lisProjProjectSourceDirectoryMark, '#ProjectSrcMark'+Owner.IDAsWord, '1', da_Define); SrcDirDefTempl.AddChild(SrcDirMarkDefTempl); SrcDirDefTempl.SetDefineOwner(Owner as TProject, false); SrcDirDefTempl.SetFlags([dtfAutoGenerated],[],false); // add directory FSrcDirectories.AddChild(SrcDirDefTempl); end; CodeToolBoss.DefineTree.ClearCache; finally NewSourceDirs.Free; end; end; procedure TProjectDefineTemplates.UpdateDefinesForCustomDefines; var OptionsDefTempl: TDefineTemplate; NewCustomOptions: String; Changed: Boolean; begin if (not Owner.NeedsDefineTemplates) or (not Active) then exit; // check if something has changed NewCustomOptions:=Owner.BaseCompilerOptions.GetOptionsForCTDefines; if (FLastCustomOptions=NewCustomOptions) then exit; Changed:=false; FLastCustomOptions:=NewCustomOptions; OptionsDefTempl:=CodeToolBoss.DefinePool.CreateFPCCommandLineDefines( 'Custom Options', FLastCustomOptions, false, Owner as TProject); if OptionsDefTempl=nil then begin // no custom options -> delete old template if FSrcDirIf<>nil then begin if FSrcDirIf.DeleteChild('Custom Options') then Changed:=true; end; end else begin UpdateSrcDirIfDef; FSrcDirIf.ReplaceChild(OptionsDefTempl); Changed:=true; end; if Changed then CodeToolBoss.DefineTree.ClearCache; end; procedure TProjectDefineTemplates.FixTemplateOrder; begin if (FSrcDirIf<>nil) then FSrcDirIf.Parent.MoveToLast(FSrcDirIf); end; procedure TProjectDefineTemplates.ClearFlags; begin FFlags:=FFlags+[ptfFlagsChanged]; end; procedure TProjectDefineTemplates.AllChanged; begin SourceDirectoriesChanged; CustomDefinesChanged; UpdateGlobalValues; UpdateSrcDirIfDef; CodeToolBoss.DefineTree.ClearCache; end; procedure TProjectDefineTemplates.UpdateGlobalValues; var NewProjectDir: String; Changed: Boolean; begin Changed:=false; // the LCLWidgetType, TargetCPU and TargetOS is set by the TBuildManager if (Owner as TProject).IsVirtual then NewProjectDir:=VirtualDirectory else NewProjectDir:=(Owner as TProject).ProjectDirectory; if CodeToolBoss.SetGlobalValue(ExternalMacroStart+'ProjPath',NewProjectDir) then Changed:=true; if Changed then IncreaseCompilerParseStamp; end; { TUnitComponentDependency } procedure TUnitComponentDependency.SetRequiresUnit(const AValue: TUnitInfo); begin if FRequiresUnit=AValue then exit; if (AValue<>nil) and (FUsedByUnit=AValue) then raise Exception.Create('TUnitComponentDependency.SetRequiresUnit inconsistency'); if FRequiresUnit<>nil then RemoveFromList(FRequiresUnit.FFirstUsedByComponent,ucdlUsedBy); FRequiresUnit:=AValue; if FRequiresUnit<>nil then AddToList(FRequiresUnit.FFirstUsedByComponent,ucdlUsedBy); end; procedure TUnitComponentDependency.SetTypes(const AValue: TUnitCompDependencyTypes); begin if AValue=FTypes then exit; FTypes:=AValue; if (not (ucdtOldProperty in FTypes)) and (FCompProps<>nil) then ClearComponentProperties; end; function TUnitComponentDependency.GetCompPropCount: integer; begin if FCompProps=nil then Result:=0 else Result:=FCompProps.Count; end; function TUnitComponentDependency.GetCompProps(Index: integer): TUCDComponentProperty; begin Result:=TUCDComponentProperty(FCompProps[Index]); end; procedure TUnitComponentDependency.SetUsedByUnit(const AValue: TUnitInfo); begin if FUsedByUnit=AValue then exit; if (AValue<>nil) and (FRequiresUnit=AValue) then raise Exception.Create('TUnitComponentDependency.SetUsedByUnit inconsistency'); if FUsedByUnit<>nil then RemoveFromList(FUsedByUnit.FFirstRequiredComponent,ucdlRequires); FUsedByUnit:=AValue; if FUsedByUnit<>nil then AddToList(FUsedByUnit.FFirstRequiredComponent,ucdlRequires); end; constructor TUnitComponentDependency.Create; begin end; destructor TUnitComponentDependency.Destroy; begin RequiresUnit:=nil; UsedByUnit:=nil; ClearComponentProperties; inherited Destroy; end; procedure TUnitComponentDependency.ClearComponentProperties; var i: Integer; begin if FCompProps=nil then exit; for i:=0 to FCompProps.Count-1 do TObject(FCompProps[i]).Free; FreeAndNil(FCompProps); end; function TUnitComponentDependency.NextUsedByDependency: TUnitComponentDependency; begin Result:=NextDependency[ucdlUsedBy]; end; function TUnitComponentDependency.PrevUsedByDependency: TUnitComponentDependency; begin Result:=PrevDependency[ucdlUsedBy]; end; function TUnitComponentDependency.NextRequiresDependency: TUnitComponentDependency; begin Result:=NextDependency[ucdlRequires]; end; function TUnitComponentDependency.PrevRequiresDependency: TUnitComponentDependency; begin Result:=PrevDependency[ucdlRequires]; end; procedure TUnitComponentDependency.AddToList( var FirstDependency: TUnitComponentDependency; ListType: TUnitCompDependencyList); begin NextDependency[ListType]:=FirstDependency; FirstDependency:=Self; PrevDependency[ListType]:=nil; if NextDependency[ListType]<>nil then NextDependency[ListType].PrevDependency[ListType]:=Self; end; procedure TUnitComponentDependency.RemoveFromList( var FirstDependency: TUnitComponentDependency; ListType: TUnitCompDependencyList); begin if FirstDependency=Self then FirstDependency:=NextDependency[ListType]; if NextDependency[ListType]<>nil then NextDependency[ListType].PrevDependency[ListType]:=PrevDependency[ListType]; if PrevDependency[ListType]<>nil then PrevDependency[ListType].NextDependency[ListType]:=NextDependency[ListType]; NextDependency[ListType]:=nil; PrevDependency[ListType]:=nil; end; function TUnitComponentDependency.FindUsedByPropPath( const UsedByPropPath: string): TUCDComponentProperty; var i: Integer; begin if FCompProps=nil then exit(nil); for i:=FCompProps.Count-1 downto 0 do begin Result:=CompProps[i]; if SysUtils.CompareText(Result.UsedByPropPath,UsedByPropPath)=0 then exit; end; Result:=nil; end; function TUnitComponentDependency.SetUsedByPropPath(const UsedByPropPath, RequiresPropPath: string): TUCDComponentProperty; begin //DebugLn(['TUnitComponentDependency.SetUsedByPropPath ',UsedByPropPath,'=',RequiresPropPath]); if (not (ucdtOldProperty in FTypes)) then raise Exception.Create('TUnitComponentDependency.SetUsedByPropPath inconsistency'); Result:=FindUsedByPropPath(UsedByPropPath); if Result=nil then begin if FCompProps=nil then FCompProps:=TFPList.Create; Result:=TUCDComponentProperty.Create(UsedByPropPath,RequiresPropPath); FCompProps.Add(Result); end else begin Result.UsedByPropPath:=UsedByPropPath;// update case Result.RequiresPropPath:=RequiresPropPath; end; end; function TUnitComponentDependency.CreatePropPath(AComponent: TComponent; const PropName: string): string; begin Result:=PropName; while AComponent<>nil do begin if Result<>'' then Result:='.'+Result; Result:=AComponent.Name+Result; AComponent:=AComponent.Owner; end; end; { TUCDComponentProperty } constructor TUCDComponentProperty.Create(const SrcPath, DestPath: string); begin UsedByPropPath:=SrcPath; RequiresPropPath:=DestPath; end; { TProjectBuildMode } function TProjectBuildMode.GetLazCompilerOptions: TLazCompilerOptions; begin Result:=FCompilerOptions; end; constructor TProjectBuildMode.Create(AOwner: TComponent); begin inherited Create(AOwner); FCompilerOptions:=TProjectCompilerOptions.Create(LazProject); FCompilerOptions.AddOnChangedHandler(@OnItemChanged); FCompilerOptions.FBuildMode:=Self; end; destructor TProjectBuildMode.Destroy; begin FreeAndNil(FCompilerOptions); inherited Destroy; end; function TProjectBuildMode.LazProject: TProject; begin if Owner is TProjectBuildModes then Result:=TProjectBuildModes(Owner).LazProject else Result:=Nil; end; procedure TProjectBuildMode.Clear; begin CompilerOptions.Clear; end; function TProjectBuildMode.Equals(Src: TProjectBuildMode): boolean; begin Result:=CompilerOptions.IsEqual(Src.CompilerOptions); end; function TProjectBuildMode.CreateDiff(Other: TProjectBuildMode; Tool: TCompilerDiffTool): boolean; begin // Note: if there is a Tool all steps must be evaluated, if not exit on first diff //if Tool<>nil then debugln(['TProjectBuildMode.CreateDiff ']); Result:=CompilerOptions.CreateDiff(Other.CompilerOptions,Tool); if (Tool=nil) and Result then exit; end; procedure TProjectBuildMode.Assign(Src: TProjectBuildMode); begin if Equals(Src) then exit; InSession:=Src.InSession; CompilerOptions.Assign(Src.CompilerOptions); end; procedure TProjectBuildMode.LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); begin FIdentifier:=XMLConfig.GetValue('Identifier',''); FCompilerOptions.LoadFromXMLConfig(XMLConfig,Path+'CompilerOptions/'); end; procedure TProjectBuildMode.SaveMacroValuesAtOldPlace(XMLConfig: TXMLConfig; const Path: string); var Cnt: Integer; Modes: TProjectBuildModes; begin // for older IDE (<1.1) save the macros at the old place Assert(Assigned(Owner), 'SaveMacroValuesAtOldPlace: Owner not assigned.'); Modes := Owner as TProjectBuildModes; Cnt:=Modes.SessionMatrixOptions.SaveAtOldXMLConfig(XMLConfig, Path, Identifier); Cnt+=Modes.SharedMatrixOptions.SaveAtOldXMLConfig(XMLConfig, Path, Identifier); XMLConfig.SetDeleteValue(Path+'Count',Cnt,0); end; procedure TProjectBuildMode.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; IsDefault: Boolean; var Cnt: integer); var SubPath: String; begin inc(Cnt); SubPath:=Path+'BuildModes/Item'+IntToStr(Cnt)+'/'; XMLConfig.SetDeleteValue(SubPath+'Name',Identifier,''); if IsDefault then XMLConfig.SetDeleteValue(SubPath+'Default',True,false) else begin SaveMacroValuesAtOldPlace(XMLConfig, SubPath+'MacroValues/'); CompilerOptions.SaveToXMLConfig(XMLConfig,SubPath+'CompilerOptions/'); end; end; function TProjectBuildMode.GetCaption: string; var i: Integer; begin Result:=Identifier; for i:=length(Result) downto 1 do if Result[i] in ['&',#0..#31,#127] then System.Delete(Result,i,1); if Result<>'' then exit; i:=GetIndex; if i>=0 then Result:='['+IntToStr(i)+']'; end; function TProjectBuildMode.GetIndex: integer; begin if LazProject<>nil then Result:=LazProject.BuildModes.IndexOf(Self) else Result:=-1; end; { TProjectBuildModes } function TProjectBuildModes.GetItems(Index: integer): TProjectBuildMode; begin Result:=TProjectBuildMode(fItems[Index]); end; function TProjectBuildModes.GetModified: boolean; begin Result:=fSavedChangeStamp<>FChangeStamp; end; procedure TProjectBuildModes.OnItemChanged(Sender: TObject); begin {$IFDEF VerboseIDEModified} debugln(['TProjectBuildModes.OnItemChanged ',DbgSName(Sender)]); {$ENDIF} IncreaseChangeStamp; end; procedure TProjectBuildModes.SetModified(const AValue: boolean); var i: Integer; begin if AValue then IncreaseChangeStamp else begin for i:=0 to Count-1 do Items[i].Modified:=false; SharedMatrixOptions.Modified:=false; SessionMatrixOptions.Modified:=false; fSavedChangeStamp:=FChangeStamp; end; end; constructor TProjectBuildModes.Create(AOwner: TComponent); begin inherited Create(AOwner); fOnChanged:=TMethodList.Create; fItems:=TFPList.Create; FChangeStamp:=CTInvalidChangeStamp; fSavedChangeStamp:=FChangeStamp; FSharedMatrixOptions:=TBuildMatrixOptions.Create; FSharedMatrixOptions.OnChanged:=@OnItemChanged; FSessionMatrixOptions:=TBuildMatrixOptions.Create; FSessionMatrixOptions.OnChanged:=@OnItemChanged; end; destructor TProjectBuildModes.Destroy; begin FreeAndNil(fOnChanged); Clear; FreeAndNil(FSharedMatrixOptions); FreeAndNil(FSessionMatrixOptions); FreeAndNil(fItems); inherited Destroy; end; procedure TProjectBuildModes.Clear; begin while Count>0 do Delete(Count-1); SharedMatrixOptions.Clear; SessionMatrixOptions.Clear; end; function TProjectBuildModes.IsEqual(OtherModes: TProjectBuildModes): boolean; var i: Integer; begin Result:=true; if OtherModes.Count<>Count then exit; for i:=0 to Count-1 do if not Items[i].Equals(OtherModes[i]) then exit; if not SharedMatrixOptions.Equals(OtherModes.SharedMatrixOptions) then exit; if not SessionMatrixOptions.Equals(OtherModes.SessionMatrixOptions) then exit; Result:=false; end; procedure TProjectBuildModes.Assign(Source: TPersistent; WithModified: boolean); var OtherModes: TProjectBuildModes; i: Integer; CurMode: TProjectBuildMode; begin if Source is TProjectBuildModes then begin FAssigning:=True; OtherModes:=TProjectBuildModes(Source); Clear; for i:=0 to OtherModes.Count-1 do begin CurMode:=Add(OtherModes[i].Identifier); CurMode.Assign(OtherModes[i]); if WithModified then CurMode.Modified:=OtherModes[i].Modified; end; SharedMatrixOptions.Assign(OtherModes.SharedMatrixOptions); SessionMatrixOptions.Assign(OtherModes.SessionMatrixOptions); if WithModified then Modified:=OtherModes.Modified; FAssigning:=False; end else inherited Assign(Source); end; procedure TProjectBuildModes.Delete(Index: integer); var Item: TProjectBuildMode; begin Item:=Items[Index]; fItems.Delete(Index); Item.Free; {$IFDEF VerboseIDEModified} debugln(['TProjectBuildModes.Delete ']); {$ENDIF} IncreaseChangeStamp; end; function TProjectBuildModes.IndexOf(Identifier: string): integer; begin Result:=Count-1; while (Result>=0) and (SysUtils.CompareText(Identifier,Items[Result].Identifier)<>0) do dec(Result); end; function TProjectBuildModes.IndexOf(aMode: TProjectBuildMode): integer; begin Result:=fItems.IndexOf(aMode); end; function TProjectBuildModes.Find(Identifier: string): TProjectBuildMode; var i: LongInt; begin i:=IndexOf(Identifier); if i>=0 then Result:=Items[i] else Result:=nil; end; function TProjectBuildModes.Add(Identifier: string): TProjectBuildMode; begin Result:=TProjectBuildMode.Create(Self); Result.FIdentifier:=Identifier; if LazProject<>nil then Result.CompilerOptions.BaseDirectory:=LazProject.ProjectDirectory; Result.AddOnChangedHandler(@OnItemChanged); fItems.Add(Result); end; procedure TProjectBuildModes.Move(FromIndex, ToIndex: integer); begin fItems.Move(FromIndex,ToIndex); end; function TProjectBuildModes.Count: integer; begin Result:=fItems.Count; end; procedure TProjectBuildModes.IncreaseChangeStamp; begin CTIncreaseChangeStamp(FChangeStamp); if fOnChanged<>nil then fOnChanged.CallNotifyEvents(Self); end; procedure TProjectBuildModes.AddOnChangedHandler(const Handler: TNotifyEvent); begin fOnChanged.Add(TMethod(Handler)); end; procedure TProjectBuildModes.RemoveOnChangedHandler(const Handler: TNotifyEvent); begin fOnChanged.Remove(TMethod(Handler)); end; function TProjectBuildModes.IsModified(InSession: boolean): boolean; var i: Integer; begin Result:=true; if InSession then begin if SessionMatrixOptions.Modified then exit; end else begin if SharedMatrixOptions.Modified then exit; end; for i:=0 to Count-1 do if (Items[i].InSession=InSession) and Items[i].Modified then exit; Result:=false; end; function TProjectBuildModes.GetSessionModes: TStringList; var i: Integer; BuildMode: TProjectBuildMode; begin Result:=TStringList.Create; for i:=0 to Count-1 do begin BuildMode:=Items[i]; if BuildMode.InSession then Result.Add(BuildMode.Identifier); end; end; function TProjectBuildModes.IsSessionMode(const ModeIdentifier: string): boolean; var i: Integer; BuildMode: TProjectBuildMode; begin for i:=0 to Count-1 do begin BuildMode:=Items[i]; if SysUtils.CompareText(BuildMode.Identifier,ModeIdentifier)=0 then exit(BuildMode.InSession); end; Result:=false; end; function TProjectBuildModes.IsSharedMode(const ModeIdentifier: string): boolean; var i: Integer; BuildMode: TProjectBuildMode; begin for i:=0 to Count-1 do begin BuildMode:=Items[i]; if SysUtils.CompareText(BuildMode.Identifier,ModeIdentifier)=0 then exit(not BuildMode.InSession); end; Result:=false; end; procedure TProjectBuildModes.RenameMatrixMode(const OldName, NewName: string); begin SharedMatrixOptions.RenameMode(OldName,NewName); SessionMatrixOptions.RenameMode(OldName,NewName); end; function TProjectBuildModes.CreateExtraModes(aCurMode: TProjectBuildMode): TProjectBuildMode; // Create Debug and Release buildmodes. Return the created debug mode. // Params: aCurMode - existing mode to copy settings from. procedure AssignAndSetBooleans(aMode: TProjectBuildMode; IsDebug: Boolean); begin if Assigned(aCurMode) then aMode.Assign(aCurMode); // clone from currently selected mode with aMode.CompilerOptions do begin // Smart linking SmartLinkUnit:=not IsDebug; LinkSmart:=not IsDebug; // Checks IOChecks:=IsDebug; RangeChecks:=IsDebug; OverflowChecks:=IsDebug; StackChecks:=IsDebug; IncludeAssertionCode:=IsDebug; VerifyObjMethodCall:=IsDebug; // Debug flags GenerateDebugInfo:=IsDebug; UseExternalDbgSyms:=IsDebug; UseHeaptrc:=IsDebug; TrashVariables:=IsDebug; end; end; var RelMode: TProjectBuildMode; begin // Create Debug mode Result:=Add(DebugModeName); AssignAndSetBooleans(Result, True); Result.CompilerOptions.OptimizationLevel:=1; // Optimization Result.CompilerOptions.DebugInfoType:=dsDwarf2Set; // Debug // Create Release mode RelMode:=Add(ReleaseModeName); AssignAndSetBooleans(RelMode, False); RelMode.CompilerOptions.OptimizationLevel:=3; // Optimization, slow, but safe, -O4 is dangerous RelMode.CompilerOptions.DebugInfoType:=dsAuto; // No Debug end; // Methods for LoadFromXMLConfig procedure TProjectBuildModes.AddMatrixMacro(const MacroName, MacroValue, ModeIdentifier: string; InSession: boolean); var MatrixOptions: TBuildMatrixOptions; MatrixOption: TBuildMatrixOption; begin MatrixOption:=SharedMatrixOptions.FindMacro(MacroName,MacroValue); if MatrixOption=nil then MatrixOption:=SessionMatrixOptions.FindMacro(MacroName,MacroValue); if MatrixOption<>nil then begin // Macro already exists => enable mode for this macro MatrixOption.EnableMode(ModeIdentifier); end else begin // Macro does not yet exist => create if InSession then MatrixOptions:=SessionMatrixOptions else MatrixOptions:=SharedMatrixOptions; MatrixOption:=MatrixOptions.Add(bmotIDEMacro,'*'); MatrixOption.MacroName:=MacroName; MatrixOption.Value:=MacroValue; MatrixOption.Modes:=ModeIdentifier; end; end; procedure TProjectBuildModes.LoadSessionEnabledNonSessionMatrixOptions(const Path: string); var i, Cnt: integer; SubPath: String; ModeID, OptionID: String; begin // disable all matrix options in session modes if FGlobalMatrixOptions<>nil then FGlobalMatrixOptions.DisableModes(@IsSessionMode); SharedMatrixOptions.DisableModes(@IsSessionMode); // load Cnt:=FXMLConfig.GetValue(Path+'Count',0); for i:=1 to Cnt do begin SubPath:=Path+'Item'+IntToStr(i)+'/'; ModeID:=FXMLConfig.GetValue(SubPath+'Mode',''); if (ModeID='') or (not IsSessionMode(ModeID)) then begin debugln(['LoadSessionEnabledNonSessionMatrixOptions not a session Mode="',dbgstr(ModeID),'" at ',SubPath]); continue; end; OptionID:=FXMLConfig.GetValue(SubPath+'Option',''); if OptionID='' then begin debugln(['LoadSessionEnabledNonSessionMatrixOptions invalid option at ',SubPath]); continue; end; if Assigned(FGlobalMatrixOptions) then FGlobalMatrixOptions.EnableModeIfOptionFound(ModeID, OptionID); if Assigned(SharedMatrixOptions) then SharedMatrixOptions.EnableModeIfOptionFound(ModeID, OptionID); end; end; procedure TProjectBuildModes.LoadOtherCompilerOpts(const Path: string; FromIndex, ToIndex: Integer; InSession: boolean); // Iterate rest of the modes. var i: Integer; Ident, SubPath: String; CurMode: TProjectBuildMode; begin for i:=FromIndex to ToIndex do begin SubPath:=Path+'Item'+IntToStr(i)+'/'; Ident:=FXMLConfig.GetValue(SubPath+'Name',''); CurMode:=Add(Ident); // add another mode CurMode.InSession:=InSession; CurMode.CompilerOptions.LoadFromXMLConfig(FXMLConfig, SubPath+'CompilerOptions/'); end; end; procedure TProjectBuildModes.LoadMacroValues(const Path: string; CurMode: TProjectBuildMode); var i, Cnt: Integer; SubPath, MacroName, MacroValue: String; begin // load macro values of old IDE (<1.1) Cnt:=FXMLConfig.GetValue(Path+'Count',0); //debugln(['LoadMacroValues Cnt=',Cnt]); for i:=1 to Cnt do begin SubPath:=Path+'Macro'+IntToStr(i)+'/'; MacroName:=FXMLConfig.GetValue(SubPath+'Name',''); if (MacroName='') or not IsValidIdent(MacroName) then continue; MacroValue:=FXMLConfig.GetValue(SubPath+'Value',''); //debugln(['LoadMacroValues Mode="',CurMode.Identifier,'" ',MacroName,'="',MacroValue,'" session=',CurMode.InSession]); AddMatrixMacro(MacroName,MacroValue,CurMode.Identifier,CurMode.InSession); end; end; procedure TProjectBuildModes.LoadAllMacroValues(const Path: string; Cnt: Integer); var i: Integer; SubPath: String; begin // First default mode. LoadMacroValues(Path+'MacroValues/', Items[0]); // Iterate rest of the modes. for i:=2 to Cnt do begin SubPath:=Path+'BuildModes/Item'+IntToStr(i)+'/'; LoadMacroValues(SubPath+'MacroValues/', Items[i-1]); end; end; procedure TProjectBuildModes.LoadOldFormat(const Path: string); var Ident, CompOptsPath, MacroValsPath: String; CurMode: TProjectBuildMode; begin // no build modes => an old file format CompOptsPath:='CompilerOptions/'; // due to a bug in an old version, the XML path can be 'CompilerOptions/' or '' if (LazProject.FFileVersion<3) and (FXMLConfig.GetValue('SearchPaths/CompilerPath/Value','')<>'') then CompOptsPath:=''; MacroValsPath:=Path+'MacroValues/'; CurMode:=Items[0]; LoadMacroValues(MacroValsPath,CurMode); if FXMLConfig.GetValue(CompOptsPath+'Version/Value', 0)<10 then begin // LCLWidgetType was not a macro but a property of its own Ident := FXMLConfig.GetValue(CompOptsPath+'LCLWidgetType/Value', ''); if (Ident<>'') and (SysUtils.CompareText(Ident,'default')<>0) then AddMatrixMacro('LCLWidgetType',Ident,'default',false); end; CurMode.CompilerOptions.LoadFromXMLConfig(FXMLConfig,CompOptsPath); end; procedure TProjectBuildModes.LoadActiveBuildMode(const Path: string); var CurMode: TProjectBuildMode; begin CurMode:=Find(FXMLConfig.GetValue(Path+'BuildModes/Active','default')); if CurMode=nil then CurMode:=Items[0]; LazProject.ActiveBuildMode:=CurMode; end; procedure TProjectBuildModes.LoadProjOptsFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); // Load for project var Cnt: Integer; begin FXMLConfig := XMLConfig; Cnt:=FXMLConfig.GetValue(Path+'BuildModes/Count',0); if Cnt>0 then begin // Project default mode is stored at the old XML path for backward compatibility. // Testing the 'Default' XML attribute is not needed because the first mode // is always default. Items[0].Identifier:=FXMLConfig.GetValue(Path+'BuildModes/Item1/Name', ''); Items[0].CompilerOptions.LoadFromXMLConfig(FXMLConfig, 'CompilerOptions/'); LoadOtherCompilerOpts(Path+'BuildModes/', 2, Cnt, False); LoadAllMacroValues(Path+'MacroValues/', Cnt); end else LoadOldFormat(Path); LoadActiveBuildMode(Path); end; procedure TProjectBuildModes.LoadSessionFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; LoadAllOptions: boolean); // Load for session var Cnt: Integer; begin FXMLConfig := XMLConfig; if LoadAllOptions then // load matrix options SessionMatrixOptions.LoadFromXMLConfig(FXMLConfig, Path+'BuildModes/SessionMatrixOptions/'); Cnt:=FXMLConfig.GetValue(Path+'BuildModes/Count',0); if Cnt>0 then begin // Add a new mode for session compiler options. LoadOtherCompilerOpts(Path+'BuildModes/', 1, Cnt, True); LoadAllMacroValues(Path+'MacroValues/', Cnt); end; if LoadAllOptions then // load what matrix options are enabled in session build modes LoadSessionEnabledNonSessionMatrixOptions(Path+'BuildModes/SessionEnabledMatrixOptions/'); LoadActiveBuildMode(Path); end; // Methods for SaveToXMLConfig procedure TProjectBuildModes.SaveSessionData(const Path: string); var SubPath: String; i, Cnt: Integer; begin // save what mode is currently active in the session FXMLConfig.SetDeleteValue(Path+'BuildModes/Active', LazProject.ActiveBuildMode.Identifier,'default'); // save matrix options of session SessionMatrixOptions.SaveToXMLConfig(FXMLConfig, Path+'BuildModes/SessionMatrixOptions/',nil); // save what matrix options are enabled in session build modes Cnt:=0; SubPath:=Path+'BuildModes/SessionEnabledMatrixOptions/'; for i:=0 to Count-1 do if Items[i].InSession then SharedMatrixOptions.SaveSessionEnabled(FXMLConfig, SubPath, Items[i].Identifier, Cnt); if Assigned(FGlobalMatrixOptions) then for i:=0 to Count-1 do if Items[i].InSession then FGlobalMatrixOptions.SaveSessionEnabled(FXMLConfig, SubPath, Items[i].Identifier, Cnt); FXMLConfig.SetDeleteValue(SubPath+'Count',Cnt,0); end; procedure TProjectBuildModes.SaveSharedMatrixOptions(const Path: string); begin SharedMatrixOptions.SaveToXMLConfig(FXMLConfig, Path+'BuildModes/SharedMatrixOptions/',@IsSharedMode); end; function TProjectBuildModes.GetLazBuildModes(Index: integer): TLazProjectBuildMode; begin Result:=TLazProjectBuildMode(fItems[Index]); end; // SaveToXMLConfig itself procedure TProjectBuildModes.SaveProjOptsToXMLConfig(XMLConfig: TXMLConfig; const Path: string; SaveSession: boolean); var i, Cnt: Integer; begin FXMLConfig := XMLConfig; // Save the default mode under an old xml path to let old IDEs open new projects // Note: the 0.9.29 reader already supports fetching the default build // mode from the BuildModes, so in one or two releases we can switch //Items[0].SaveDefaultCompilerOpts(FXMLConfig, Path); Items[0].SaveMacroValuesAtOldPlace(XMLConfig,Path+'MacroValues/'); Items[0].CompilerOptions.SaveToXMLConfig(XMLConfig,'CompilerOptions/'); // no Path! Cnt:=0; for i:=0 to Count-1 do if SaveSession or not Items[i].InSession then Items[i].SaveToXMLConfig(FXMLConfig, Path, i=0, Cnt); FXMLConfig.SetDeleteValue(Path+'BuildModes/Count',Cnt,0); end; procedure TProjectBuildModes.SaveSessionOptsToXMLConfig(XMLConfig: TXMLConfig; const Path: string; SaveSession: boolean); var i, Cnt: Integer; begin FXMLConfig := XMLConfig; Cnt:=0; for i:=0 to Count-1 do if Items[i].InSession and SaveSession then Items[i].SaveToXMLConfig(FXMLConfig, Path, false, Cnt); FXMLConfig.SetDeleteValue(Path+'BuildModes/Count',Cnt,0); end; initialization RegisterIDEOptionsGroup(GroupProject, TProjectIDEOptions); RegisterIDEOptionsGroup(GroupCompiler, TProjectCompilerOptions); end.