1{ 2 /*************************************************************************** 3 project.pp - project utility class file 4 ----------------------------------------- 5 TProject is responsible for managing a complete project. 6 7 8 Initial Revision : Sun Mar 28 23:15:32 CST 1999 9 10 11 ***************************************************************************/ 12 13 *************************************************************************** 14 * * 15 * This source is free software; you can redistribute it and/or modify * 16 * it under the terms of the GNU General Public License as published by * 17 * the Free Software Foundation; either version 2 of the License, or * 18 * (at your option) any later version. * 19 * * 20 * This code is distributed in the hope that it will be useful, but * 21 * WITHOUT ANY WARRANTY; without even the implied warranty of * 22 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 23 * General Public License for more details. * 24 * * 25 * A copy of the GNU General Public License is available on the World * 26 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 27 * obtain it by writing to the Free Software Foundation, * 28 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * 29 * * 30 *************************************************************************** 31 32} 33unit Project; 34 35{$mode objfpc}{$H+} 36 37{$ifdef Trace} 38 {$ASSERTIONS ON} 39{$endif} 40 41interface 42 43{$I ide.inc} 44 45uses 46 {$IFDEF IDE_MEM_CHECK} 47 MemCheck, 48 {$ENDIF} 49 // RTL + FCL 50 Classes, SysUtils, TypInfo, 51 // LCL 52 LCLProc, Forms, Controls, Dialogs, 53 // CodeTools 54 CodeToolsConfig, ExprEval, DefineTemplates, BasicCodeTools, CodeToolsCfgScript, 55 LinkScanner, CodeToolManager, CodeCache, CodeTree, FileProcs, StdCodeTools, 56 // LazUtils 57 FPCAdds, LazUtilities, FileUtil, LazFileUtils, LazFileCache, LazMethodList, 58 LazLoggerBase, FileReferenceList, LazUTF8, Laz2_XMLCfg, Maps, 59 // IDEIntf 60 PropEdits, UnitResources, EditorSyntaxHighlighterDef, 61 CompOptsIntf, ProjectIntf, MacroIntf, MacroDefIntf, SrcEditorIntf, 62 IDEOptionsIntf, IDEOptEditorIntf, IDEDialogs, LazIDEIntf, PackageIntf, 63 // IDE 64 CompOptsModes, ProjectResources, LazConf, ProjectIcon, 65 IDECmdLine, IDEProcs, CompilerOptions, RunParamsOpts, ModeMatrixOpts, 66 TransferMacros, ProjectDefs, EditDefineTree, 67 LazarusIDEStrConsts, InputHistory, ProjPackCommon, PackageDefs, PackageSystem; 68 69type 70 TUnitInfo = class; 71 TProject = class; 72 73 TOnFileBackup = function(const FileToBackup: string):TModalResult of object; 74 TOnUnitNameChange = procedure(AnUnitInfo: TUnitInfo; 75 const OldUnitName, NewUnitName: string; 76 CheckIfAllowed: boolean; 77 var Allowed: boolean) of object; 78 TOnLoadProjectInfo = procedure(TheProject: TProject; XMLConfig: TXMLConfig; 79 Merge: boolean) of object; 80 TOnSaveProjectInfo = procedure(TheProject: TProject; 81 XMLConfig: TXMLConfig; WriteFlags: TProjectWriteFlags) of object; 82 TOnChangeProjectInfoFile = procedure(TheProject: TProject) of object; 83 84 TOnSaveUnitSessionInfoInfo = procedure(AUnitInfo: TUnitInfo) of object; 85 86 TUnitInfoList = ( 87 uilPartOfProject, 88 uilWithEditorIndex, 89 uilWithComponent, 90 uilLoaded, 91 uilAutoRevertLocked 92 ); 93 94 TUnitCompDependencyList = ( 95 ucdlRequires, 96 ucdlUsedBy 97 ); 98 TUnitCompDependencyType = ( 99 ucdtAncestor, // RequiresUnit is ancestor 100 ucdtProperty, // a property references RequiresUnit's component or sub component 101 ucdtOldProperty, // like ucdtProperty, but for the old state before the revert 102 ucdtInlineClass // RequiresUnit is class of an inline component 103 ); 104 TUnitCompDependencyTypes = set of TUnitCompDependencyType; 105 106const 107 AllUnitCompDependencyTypes = [low(TUnitCompDependencyType)..high(TUnitCompDependencyType)]; 108 // Names for extra buildmodes which may be created automatically. 109 DebugModeName = 'Debug'; 110 ReleaseModeName = 'Release'; 111 112type 113 114 { TUCDComponentProperty } 115 116 TUCDComponentProperty = class 117 public 118 UsedByPropPath: string; 119 RequiresPropPath: string; 120 constructor Create(const SrcPath, DestPath: string); 121 end; 122 123 { TUnitComponentDependency } 124 125 TUnitComponentDependency = class 126 private 127 FCompProps: TFPList;// list of TUCDComponentProperty 128 FRequiresUnit: TUnitInfo; 129 FTypes: TUnitCompDependencyTypes; 130 FUsedByUnit: TUnitInfo; 131 function GetCompPropCount: integer; 132 function GetCompProps(Index: integer): TUCDComponentProperty; 133 procedure SetRequiresUnit(const AValue: TUnitInfo); 134 procedure SetTypes(const AValue: TUnitCompDependencyTypes); 135 procedure SetUsedByUnit(const AValue: TUnitInfo); 136 public 137 NextDependency,PrevDependency: array[TUnitCompDependencyList] of TUnitComponentDependency; 138 constructor Create; 139 destructor Destroy; override; 140 procedure ClearComponentProperties; 141 function NextUsedByDependency: TUnitComponentDependency; 142 function PrevUsedByDependency: TUnitComponentDependency; 143 function NextRequiresDependency: TUnitComponentDependency; 144 function PrevRequiresDependency: TUnitComponentDependency; 145 procedure AddToList(var FirstDependency: TUnitComponentDependency; 146 ListType: TUnitCompDependencyList); 147 procedure RemoveFromList(var FirstDependency: TUnitComponentDependency; 148 ListType: TUnitCompDependencyList); 149 property RequiresUnit: TUnitInfo read FRequiresUnit write SetRequiresUnit; 150 property UsedByUnit: TUnitInfo read FUsedByUnit write SetUsedByUnit; 151 property Types: TUnitCompDependencyTypes read FTypes write SetTypes; 152 property CompPropCount: integer read GetCompPropCount; 153 property CompProps[Index: integer]: TUCDComponentProperty read GetCompProps; 154 function FindUsedByPropPath(const UsedByPropPath: string): TUCDComponentProperty; 155 function SetUsedByPropPath(const UsedByPropPath, RequiresPropPath: string 156 ): TUCDComponentProperty; 157 function CreatePropPath(AComponent: TComponent; 158 const PropName: string = ''): string; 159 end; 160 161 //--------------------------------------------------------------------------- 162 163 TUnitInfoFlag = ( 164 uifComponentUsedByDesigner, 165 uifComponentIndirectlyUsedByDesigner, 166 uifMarked, 167 uifInternalFile // data from an internal source (e.g. an editor macro (pascal script) from memory) 168 ); 169 TUnitInfoFlags = set of TUnitInfoFlag; 170 171 { TUnitEditorInfo } 172 173 TUnitEditorInfo = class 174 private 175 FEditorComponent: TSourceEditorInterface; 176 FUnitInfo: TUnitInfo; 177 procedure SetEditorComponent(const AValue: TSourceEditorInterface); 178 private 179 FIsLocked: Boolean; 180 FIsVisibleTab: Boolean; 181 FPageIndex: integer; 182 FWindowID: integer; 183 FTopLine: integer; 184 FCursorPos: TPoint; // physical (screen) position 185 FFoldState: String; 186 // Todo: FCustomHighlighter is only ever set to false, and not stored in XML 187 FCustomHighlighter: boolean; // do not change highlighter on file extension change 188 FSyntaxHighlighter: TLazSyntaxHighlighter; 189 procedure SetCursorPos(const AValue: TPoint); 190 procedure SetFoldState(AValue: String); 191 procedure SetIsLocked(const AValue: Boolean); 192 procedure SetPageIndex(const AValue: Integer); 193 procedure SetIsVisibleTab(const AValue: Boolean); 194 procedure SetSyntaxHighlighter(AValue: TLazSyntaxHighlighter); 195 procedure SetTopLine(const AValue: Integer); 196 procedure SetWindowIndex(const AValue: Integer); 197 protected 198 procedure Clear; 199 public 200 constructor Create(aUnitInfo: TUnitInfo); 201 destructor Destroy; override; 202 property UnitInfo: TUnitInfo read FUnitInfo; 203 property EditorComponent: TSourceEditorInterface 204 read FEditorComponent write SetEditorComponent; 205 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); 206 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; SaveFold: Boolean); 207 public 208 property IsVisibleTab: Boolean read FIsVisibleTab write SetIsVisibleTab; 209 property PageIndex: Integer read FPageIndex write SetPageIndex; 210 property WindowID: Integer read FWindowID write SetWindowIndex; 211 property TopLine: Integer read FTopLine write SetTopLine; 212 property CursorPos: TPoint read FCursorPos write SetCursorPos; 213 property FoldState: String read FFoldState write SetFoldState; 214 property IsLocked: Boolean read FIsLocked write SetIsLocked; 215 property CustomHighlighter: Boolean read FCustomHighlighter write FCustomHighlighter; // SetCustomHighlighter 216 property SyntaxHighlighter: TLazSyntaxHighlighter read FSyntaxHighlighter write SetSyntaxHighlighter; // SetSyntaxHighlighter 217 end; 218 219 { TUnitEditorInfoList } 220 221 TUnitEditorInfoList = class 222 private 223 FList: TFPList; 224 FUnitInfo: TUnitInfo; 225 function GetClosedEditorInfos(Index: Integer): TUnitEditorInfo; 226 function GetEditorInfos(Index: Integer): TUnitEditorInfo; 227 function GetOpenEditorInfos(Index: Integer): TUnitEditorInfo; 228 protected 229 procedure ClearEachInfo; 230 procedure SortByPageIndex; 231 procedure SetLastUsedEditor(AEditor:TSourceEditorInterface); 232 procedure MakeUsedEditorInfo(AEditorInfo: TUnitEditorInfo); 233 procedure MakeUnUsedEditorInfo(AEditorInfo: TUnitEditorInfo); 234 procedure Clear; 235 public 236 constructor Create(aUnitInfo: TUnitInfo); 237 destructor Destroy; override; 238 property EditorInfos[Index: Integer]: TUnitEditorInfo read GetEditorInfos; default; 239 property OpenEditorInfos[Index: Integer]: TUnitEditorInfo read GetOpenEditorInfos; 240 property ClosedEditorInfos[Index: Integer]: TUnitEditorInfo read GetClosedEditorInfos; 241 function Count: Integer; 242 function OpenCount: Integer; 243 function ClosedCount: Integer; 244 function IndexOfEditorComponent(anEditor: TSourceEditorInterface): Integer; 245 function NewEditorInfo: TUnitEditorInfo; 246 procedure Add(AEditorInfo: TUnitEditorInfo); 247 procedure Delete(Index: Integer); 248 procedure Remove(AEditorInfo: TUnitEditorInfo); 249 end; 250 251 { TUnitInfo } 252 253 TUnitInfo = class(TLazProjectFile) 254 private 255 FComponentFallbackClasses: TStrings; 256 FCustomDefaultHighlighter: boolean; 257 FDefaultSyntaxHighlighter: TLazSyntaxHighlighter; 258 FDisableI18NForLFM: boolean; 259 FEditorInfoList: TUnitEditorInfoList; 260 FAutoReferenceSourceDir: boolean; 261 fAutoRevertLockCount: integer;// =0 means, codetools can auto update from disk 262 fBookmarks: TFileBookmarks; 263 FBuildFileIfActive: boolean; 264 fComponent: TComponent; 265 FComponentState: TWindowState; // state of component when we save it 266 FResourceBaseClass: TPFComponentBaseClass; 267 fComponentName: string; { classname is always T<ComponentName> 268 this attribute contains the component name, 269 even if the unit is not loaded, or the designer form is not created. 270 A component can be for example a TForm or a TDataModule } 271 fComponentLFMLoadDate: longint; // Load time of associated LFM form file. 272 fComponentResourceName: string; 273 FComponentLastBinStreamSize: TStreamSeekType; 274 FComponentLastLFMStreamSize: TStreamSeekType; 275 FComponentLastLRSStreamSize: TStreamSeekType; 276 FDirectives: TStrings; 277 fFileName: string; // with path = saved, without path = not yet saved 278 fFileReadOnly: Boolean; 279 FFirstRequiredComponent: TUnitComponentDependency; 280 FFirstUsedByComponent: TUnitComponentDependency; 281 FFlags: TUnitInfoFlags; 282 fHasResources: boolean; // source has resource file 283 FIgnoreFileDateOnDiskValid: boolean; 284 FIgnoreFileDateOnDisk: longint; 285 fLoaded: Boolean; // loaded in the source editor, needed to restore open files 286 fLoadedDesigner: Boolean; // has a visible designer, needed to restore open designers 287 FLoadingComponent: boolean; 288 fModified: boolean; 289 fNext, fPrev: array[TUnitInfoList] of TUnitInfo; 290 fOnFileBackup: TOnFileBackup; 291 fOnLoadSaveFilename: TOnLoadSaveFilename; 292 FOnUnitNameChange: TOnUnitNameChange; 293 FProject: TProject; 294 FRevertLockCount: integer;// >0 means IDE is currently reverting this unit 295 FRunFileIfActive: boolean; 296 FSessionModified: boolean; 297 fSource: TCodeBuffer; 298 fUsageCount: extended; 299 fUserReadOnly: Boolean; 300 fSourceChangeStep: LongInt; 301 FSourceDirectoryReferenced: boolean; 302 FSourceDirNeedReference: boolean; 303 fLastDirectoryReferenced: string; 304 FSetBookmarLock: Integer; 305 FUnitResourceFileformat: TUnitResourcefileFormatClass; 306 307 function ComponentLFMOnDiskHasChanged: boolean; 308 function GetEditorInfo(Index: Integer): TUnitEditorInfo; 309 function GetHasResources: boolean; 310 function GetModified: boolean; 311 function GetNextAutoRevertLockedUnit: TUnitInfo; 312 function GetNextLoadedUnit: TUnitInfo; 313 function GetNextPartOfProject: TUnitInfo; 314 function GetNextUnitWithComponent: TUnitInfo; 315 function GetNextUnitWithEditorIndex: TUnitInfo; 316 function GetOpenEditorInfo(Index: Integer): TUnitEditorInfo; 317 function GetPrevAutoRevertLockedUnit: TUnitInfo; 318 function GetPrevLoadedUnit: TUnitInfo; 319 function GetPrevPartOfProject: TUnitInfo; 320 function GetPrevUnitWithComponent: TUnitInfo; 321 function GetPrevUnitWithEditorIndex: TUnitInfo; 322 function GetUnitResourceFileformat: TUnitResourcefileFormatClass; 323 procedure SetAutoReferenceSourceDir(const AValue: boolean); 324 procedure SetBuildFileIfActive(const AValue: boolean); 325 procedure SetDefaultSyntaxHighlighter(const AValue: TLazSyntaxHighlighter); 326 procedure SetDirectives(const AValue: TStrings); 327 procedure SetDisableI18NForLFM(const AValue: boolean); 328 procedure SetFileReadOnly(const AValue: Boolean); 329 procedure SetComponent(const AValue: TComponent); 330 procedure SetLoaded(const AValue: Boolean); 331 procedure SetLoadedDesigner(const AValue: Boolean); 332 procedure SetModified(const AValue: boolean); 333 procedure SetProject(const AValue: TProject); 334 procedure SetRunFileIfActive(const AValue: boolean); 335 procedure SetSessionModified(const AValue: boolean); 336 procedure SetSource(ABuffer: TCodeBuffer); 337 procedure SetTimeStamps; 338 procedure SetUserReadOnly(const NewValue: boolean); 339 protected 340 function GetFileName: string; override; 341 procedure SetFilename(const AValue: string); override; 342 procedure SetIsPartOfProject(const AValue: boolean); override; 343 procedure UpdateList(ListType: TUnitInfoList; Add: boolean); 344 procedure SetInternalFilename(const NewFilename: string); 345 procedure SetUnitName(const AValue: string); override; 346 347 procedure UpdateHasCustomHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter); 348 procedure UpdatePageIndex; 349 public 350 constructor Create(ACodeBuffer: TCodeBuffer); 351 destructor Destroy; override; 352 function GetFileOwner: TObject; override; 353 function GetFileOwnerName: string; override; 354 355 function ChangedOnDisk(CompareOnlyLoadSaveTime: boolean; IgnoreModifiedFlag: boolean = False): boolean; 356 function IsAutoRevertLocked: boolean; 357 function IsReverting: boolean; 358 function IsMainUnit: boolean; 359 function IsVirtual: boolean; 360 function GetDirectory: string; 361 function GetFullFilename: string; override; 362 function GetShortFilename(UseUp: boolean): string; override; 363 function NeedsSaveToDisk: boolean; 364 function ReadOnly: boolean; 365 function ReadUnitSource(ReadUnitName,Revert:boolean): TModalResult; 366 function ShortFilename: string; 367 function WriteUnitSource: TModalResult; 368 function WriteUnitSourceToFile(const AFileName: string): TModalResult; 369 procedure Clear; 370 procedure ClearModifieds; override; 371 procedure ClearComponentDependencies; 372 procedure WriteDebugReportUnitComponentDependencies(Prefix: string); 373 procedure IgnoreCurrentFileDateOnDisk; 374 procedure IncreaseAutoRevertLock; // do not auto revert from disk 375 procedure DecreaseAutoRevertLock; 376 function ReadUnitNameFromSource(TryCache: boolean): string;// fetch unit name from source and update property UnitName 377 function GetUsesUnitName: string; 378 function CreateUnitName: string; 379 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; 380 Merge, IgnoreIsPartOfProject: boolean; 381 FileVersion: integer); 382 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; 383 SaveData, SaveSession: boolean; 384 UsePathDelim: TPathDelimSwitch); 385 procedure UpdateUsageCount(Min, IfBelowThis, IncIfBelow: extended); 386 procedure UpdateUsageCount(TheUsage: TUnitUsage; const Factor: TDateTime); 387 procedure UpdateSourceDirectoryReference; 388 389 procedure SetSourceText(const SourceText: string; Beautify: boolean = false); override; 390 function GetSourceText: string; override; 391 392 // component dependencies 393 function AddRequiresComponentDependency(RequiredUnit: TUnitInfo; 394 Types: TUnitCompDependencyTypes 395 ): TUnitComponentDependency; 396 procedure RemoveRequiresComponentDependency(RequiredUnit: TUnitInfo; 397 Types: TUnitCompDependencyTypes); 398 function FindComponentDependency(RequiredUnit: TUnitInfo 399 ): TUnitComponentDependency; 400 function FindRequiredComponentDependency(MinTypes: TUnitCompDependencyTypes 401 ): TUnitComponentDependency; 402 function FindUsedByComponentDependency(MinTypes: TUnitCompDependencyTypes 403 ): TUnitComponentDependency; 404 function FindAncestorUnit: TUnitInfo; 405 procedure ClearUnitComponentDependencies(ClearTypes: TUnitCompDependencyTypes); 406 // Bookmarks 407 function AddBookmark(X, Y, ID: integer):integer; 408 procedure DeleteBookmark(ID: integer); 409 // EditorInfo 410 // At any time, any UnitInfo has at least one EditorInfo 411 function EditorInfoCount: Integer; 412 property EditorInfo[Index: Integer]: TUnitEditorInfo read GetEditorInfo; 413 function OpenEditorInfoCount: Integer; // with EditorComponent assigned 414 property OpenEditorInfo[Index: Integer]: TUnitEditorInfo read GetOpenEditorInfo; 415 function GetClosedOrNewEditorInfo: TUnitEditorInfo; 416 procedure SetLastUsedEditor(AEditor:TSourceEditorInterface); 417 // Highlighter 418 procedure UpdateDefaultHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter); 419 public 420 { Properties } 421 property UnitResourceFileformat: TUnitResourcefileFormatClass read GetUnitResourceFileformat; 422 423 // Unit lists 424 property NextUnitWithEditorIndex: TUnitInfo read GetNextUnitWithEditorIndex; 425 property PrevUnitWithEditorIndex: TUnitInfo read GetPrevUnitWithEditorIndex; 426 property NextUnitWithComponent: TUnitInfo read GetNextUnitWithComponent; 427 property PrevUnitWithComponent: TUnitInfo read GetPrevUnitWithComponent; 428 property NextLoadedUnit: TUnitInfo read GetNextLoadedUnit; 429 property PrevLoadedUnit: TUnitInfo read GetPrevLoadedUnit; 430 property NextAutoRevertLockedUnit: TUnitInfo read GetNextAutoRevertLockedUnit; 431 property PrevAutoRevertLockedUnit: TUnitInfo read GetPrevAutoRevertLockedUnit; 432 property NextPartOfProject: TUnitInfo read GetNextPartOfProject; 433 property PrevPartOfProject: TUnitInfo read GetPrevPartOfProject; 434 public 435 property Bookmarks: TFileBookmarks read FBookmarks write FBookmarks; 436 property BuildFileIfActive: boolean read FBuildFileIfActive 437 write SetBuildFileIfActive; 438 property Component: TComponent read fComponent write SetComponent; 439 property ComponentName: string read fComponentName write fComponentName; 440 property ComponentResourceName: string read fComponentResourceName 441 write fComponentResourceName; 442 property ComponentFallbackClasses: TStrings read FComponentFallbackClasses 443 write FComponentFallbackClasses; // classname to componentclass, for not registered classes in lfm 444 property ComponentState: TWindowState read FComponentState write FComponentState; 445 property ResourceBaseClass: TPFComponentBaseClass read FResourceBaseClass 446 write FResourceBaseClass; 447 property ComponentLastBinStreamSize: TStreamSeekType 448 read FComponentLastBinStreamSize write FComponentLastBinStreamSize; 449 property ComponentLastLRSStreamSize: TStreamSeekType 450 read FComponentLastLRSStreamSize write FComponentLastLRSStreamSize; 451 property ComponentLastLFMStreamSize: TStreamSeekType 452 read FComponentLastLFMStreamSize write FComponentLastLFMStreamSize; 453 property CustomDefaultHighlighter: boolean 454 read FCustomDefaultHighlighter write FCustomDefaultHighlighter; 455 property Directives: TStrings read FDirectives write SetDirectives; 456 property DisableI18NForLFM: boolean read FDisableI18NForLFM write SetDisableI18NForLFM; 457 property FileReadOnly: Boolean read fFileReadOnly write SetFileReadOnly; 458 property FirstRequiredComponent: TUnitComponentDependency 459 read FFirstRequiredComponent; 460 property FirstUsedByComponent: TUnitComponentDependency 461 read FFirstUsedByComponent; 462 property Flags: TUnitInfoFlags read FFlags write FFlags; 463 property HasResources: boolean read GetHasResources write fHasResources; 464 property Loaded: Boolean read fLoaded write SetLoaded; 465 property LoadedDesigner: Boolean read fLoadedDesigner write SetLoadedDesigner; 466 property LoadingComponent: boolean read FLoadingComponent write FLoadingComponent; 467 property Modified: boolean read GetModified write SetModified;// not Session data 468 property SessionModified: boolean read FSessionModified write SetSessionModified; 469 property OnFileBackup: TOnFileBackup read fOnFileBackup write fOnFileBackup; 470 property OnLoadSaveFilename: TOnLoadSaveFilename 471 read fOnLoadSaveFilename write fOnLoadSaveFilename; 472 property OnUnitNameChange: TOnUnitNameChange 473 read FOnUnitNameChange write FOnUnitNameChange; 474 property Project: TProject read FProject write SetProject; 475 property RunFileIfActive: boolean read FRunFileIfActive write SetRunFileIfActive; 476 property Source: TCodeBuffer read fSource write SetSource; 477 property DefaultSyntaxHighlighter: TLazSyntaxHighlighter 478 read FDefaultSyntaxHighlighter write SetDefaultSyntaxHighlighter; 479 property UserReadOnly: Boolean read fUserReadOnly write SetUserReadOnly; 480 property SourceDirectoryReferenced: boolean read FSourceDirectoryReferenced; 481 property AutoReferenceSourceDir: boolean read FAutoReferenceSourceDir 482 write SetAutoReferenceSourceDir; 483 end; 484 485 486 //--------------------------------------------------------------------------- 487 488 { TProjectCompilationToolOptions } 489 490 TProjectCompilationToolOptions = class(TCompilationToolOptions) 491 private 492 FDefaultCompileReasons: TCompileReasons; 493 procedure SetDefaultCompileReasons(const AValue: TCompileReasons); 494 protected 495 procedure SetCompileReasons(const AValue: TCompileReasons); override; 496 procedure SubstituteMacros(var s: string); override; 497 public 498 constructor Create(TheOwner: TLazCompilerOptions); override; 499 function CreateDiff(CompOpts: TCompilationToolOptions; 500 Tool: TCompilerDiffTool): boolean; override; 501 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; 502 DoSwitchPathDelims: boolean); override; 503 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; 504 UsePathDelim: TPathDelimSwitch); override; 505 function GetProject: TProject; 506 public 507 property DefaultCompileReasons: TCompileReasons read FDefaultCompileReasons write SetDefaultCompileReasons; 508 end; 509 510 TProjectBuildMode = class; 511 512 { TProjectCompilerOptions } 513 514 TProjectCompilerOptions = class(TBaseCompilerOptions) 515 private 516 FBuildMode: TProjectBuildMode; 517 FProject: TProject; 518 FCompileReasons: TCompileReasons; 519 procedure BeforeReadExec(Sender: TObject); 520 procedure AfterWriteExec(Sender: TObject; Restore: boolean); 521 protected 522 procedure SetTargetCPU(const AValue: string); override; 523 procedure SetTargetOS(const AValue: string); override; 524 procedure SetCustomOptions(const AValue: string); override; 525 procedure SetIncludePaths(const AValue: string); override; 526 procedure SetLibraryPaths(const AValue: string); override; 527 procedure SetLinkerOptions(const AValue: string); override; 528 procedure SetNamespaces(const AValue: string); override; 529 procedure SetObjectPath(const AValue: string); override; 530 procedure SetSrcPath(const AValue: string); override; 531 procedure SetUnitPaths(const AValue: string); override; 532 procedure SetUnitOutputDir(const AValue: string); override; 533 procedure SetConditionals(AValue: string); override; 534 function SubstituteProjectMacros(const s: string; 535 PlatformIndependent: boolean): string; 536 public 537 constructor Create(const AOwner: TObject); override; 538 destructor Destroy; override; 539 function IsActive: boolean; override; 540 class function GetInstance: TAbstractIDEOptions; override; 541 class function GetGroupCaption: string; override; 542 procedure Clear; override; 543 procedure LoadFromXMLConfig(AXMLConfig: TXMLConfig; const Path: string); override; 544 procedure SaveToXMLConfig(AXMLConfig: TXMLConfig; const Path: string); override; 545 function CanBeDefaulForProject: boolean; override; 546 function GetOwnerName: string; override; 547 function GetDefaultMainSourceFileName: string; override; 548 procedure GetInheritedCompilerOptions(var OptionsList: TFPList); override; 549 procedure Assign(Source: TPersistent); override; 550 function CreateDiff(CompOpts: TBaseCompilerOptions; 551 Tool: TCompilerDiffTool = nil): boolean; override; // true if differ 552 procedure SetAlternativeCompile(const Command: string; ScanFPCMsgs: boolean); override; 553 public 554 property LazProject: TProject read FProject; 555 property BuildMode: TProjectBuildMode read FBuildMode; 556 published 557 property CompileReasons: TCompileReasons read FCompileReasons write FCompileReasons; 558 end; 559 560 { TProjectDefineTemplates } 561 562 TProjectDefineTemplates = class(TProjPackDefineTemplates) 563 private 564 procedure FixTemplateOrder; 565 protected 566 procedure UpdateMain; override; 567 function UpdateSrcDirIfDef: Boolean; override; 568 procedure UpdateSourceDirectories; override; 569 procedure UpdateOutputDirectory; override; 570 procedure UpdateDefinesForCustomDefines; override; 571 procedure ClearFlags; override; 572 public 573 constructor Create(AOwner: IProjPack); 574 destructor Destroy; override; 575 procedure AllChanged(AActivating: boolean); override; 576 procedure UpdateGlobalValues; 577 end; 578 579 { TProjectBuildMode } 580 581 TProjectBuildMode = class(TLazProjectBuildMode) 582 private 583 FCompilerOptions: TProjectCompilerOptions; 584 protected 585 function GetLazCompilerOptions: TLazCompilerOptions; override; 586 public 587 constructor Create(AOwner: TComponent); override; 588 destructor Destroy; override; 589 function LazProject: TProject; 590 procedure Clear; 591 function Equals(Src: TProjectBuildMode): boolean; reintroduce; 592 function CreateDiff(Other: TProjectBuildMode; 593 Tool: TCompilerDiffTool = nil): boolean; 594 procedure Assign(Src: TProjectBuildMode); reintroduce; 595 procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); 596 procedure SaveMacroValuesAtOldPlace(XMLConfig: TXMLConfig; const Path: string); 597 procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; 598 IsDefault, ALegacyList: Boolean; var Cnt: integer); 599 function GetCaption: string; override; 600 function GetIndex: integer; override; 601 public 602 // copied by Assign, compared by Equals, cleared by Clear 603 property CompilerOptions: TProjectCompilerOptions read FCompilerOptions; 604 end; 605 606 { TProjectBuildModes } 607 608 TProjectBuildModes = class(TLazProjectBuildModes) 609 private 610 FAssigning: Boolean; 611 FSessionMatrixOptions: TBuildMatrixOptions; 612 FSharedMatrixOptions: TBuildMatrixOptions; 613 FManyBuildModes: TStringList; // User selection of many modes. 614 fSavedChangeStamp: int64; 615 fItems: TFPList; 616 FLazProject: TProject; 617 fChangedHandlers: TMethodList; 618 // Variables used by LoadFromXMLConfig and SaveToXMLConfig 619 FXMLConfig: TXMLConfig; 620 FGlobalMatrixOptions: TBuildMatrixOptions; 621 function GetItems(Index: integer): TProjectBuildMode; 622 function GetModified: boolean; 623 procedure OnItemChanged(Sender: TObject); 624 procedure SetModified(const AValue: boolean); 625 // Used by LoadFromXMLConfig 626 procedure AddMatrixMacro(const MacroName, MacroValue, ModeIdentifier: string; InSession: boolean); 627 procedure LoadSessionEnabledNonSessionMatrixOptions(const Path: string); 628 procedure LoadOtherCompilerOpts(const Path: string; FromIndex, ToIndex: Integer; InSession: boolean); 629 procedure LoadMacroValues(const Path: string; CurMode: TProjectBuildMode); 630 procedure LoadAllMacroValues(const Path: string; Cnt: Integer); 631 procedure LoadOldFormat(const Path: string); 632 procedure LoadActiveBuildMode(const Path: string); 633 // Used by SaveToXMLConfig 634 procedure SaveSessionData(const Path: string); 635 procedure SaveSharedMatrixOptions(const Path: string); 636 protected 637 function GetLazBuildModes(Index: integer): TLazProjectBuildMode; override; 638 public 639 constructor Create(AOwner: TComponent); override; 640 destructor Destroy; override; 641 procedure Clear; 642 function IsEqual(OtherModes: TProjectBuildModes): boolean; 643 procedure Assign(Source: TPersistent; WithModified: boolean); overload; 644 procedure Delete(Index: integer); 645 function IndexOf(Identifier: string): integer; 646 function IndexOf(aMode: TProjectBuildMode): integer; 647 function Find(Identifier: string): TProjectBuildMode; 648 function Add(Identifier: string): TProjectBuildMode; 649 procedure Move(FromIndex, ToIndex: integer); 650 function Count: integer; override; 651 procedure IncreaseChangeStamp; 652 procedure AddOnChangedHandler(const Handler: TNotifyEvent); 653 procedure RemoveOnChangedHandler(const Handler: TNotifyEvent); 654 function IsModified(InSession: boolean): boolean; 655 function GetSessionModes: TStringList; 656 function IsSessionMode(const ModeIdentifier: string): boolean; 657 function IsSharedMode(const ModeIdentifier: string): boolean; 658 procedure RenameMatrixMode(const OldName, NewName: string); 659 function CreateExtraModes(aCurMode: TProjectBuildMode): TProjectBuildMode; 660 // load, save 661 procedure LoadProjOptsFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); 662 procedure LoadSessionFromXMLConfig(XMLConfig: TXMLConfig; const Path: string; 663 LoadAllOptions: boolean); 664 procedure SaveProjOptsToXMLConfig(XMLConfig: TXMLConfig; const Path: string; 665 SaveSession, ALegacyList: boolean); 666 procedure SaveSessionOptsToXMLConfig(XMLConfig: TXMLConfig; const Path: string; 667 SaveSession, ALegacyList: boolean); 668 public 669 property Items[Index: integer]: TProjectBuildMode read GetItems; default; 670 property ChangeStamp: integer read FChangeStamp; 671 property LazProject: TProject read FLazProject write FLazProject; 672 property Assigning: Boolean read FAssigning; 673 property Modified: boolean read GetModified write SetModified; 674 property SharedMatrixOptions: TBuildMatrixOptions read FSharedMatrixOptions; 675 property SessionMatrixOptions: TBuildMatrixOptions read FSessionMatrixOptions; 676 property ManyBuildModes: TStringList read FManyBuildModes; 677 property ChangedHandlers: TMethodList read fChangedHandlers; 678 679 end; 680 681 { TProjectIDEOptions } 682 683 TProjectIDEOptions = class(TAbstractIDEProjectOptions) 684 private 685 FProject: TProject; 686 FLclApp: Boolean; 687 public 688 constructor Create(AProject: TProject); 689 destructor Destroy; override; 690 function GetProject: TLazProject; override; 691 function CheckLclApp: Boolean; 692 class function GetInstance: TAbstractIDEOptions; override; 693 class function GetGroupCaption: string; override; 694 property Project: TProject read FProject; 695 property LclApp: Boolean read FLclApp; 696 end; 697 698 { TProject } 699 700 TEndUpdateProjectEvent = 701 procedure(Sender: TObject; ProjectChanged: boolean) of object; 702 703 TLazProjectStateFlag = ( 704 lpsfStateFileLoaded, 705 lpsfPropertyDependenciesChanged, 706 lpsfDesignerChanged 707 ); 708 TLazProjectStateFlags = set of TLazProjectStateFlag; 709 710 TOldProjectType = (ptApplication, ptProgram, ptCustomProgram); 711 712 TProject = class(TLazProject, IProjPack) 713 private 714 FActiveBuildMode: TProjectBuildMode; 715 FActiveBuildModeBackup: integer; 716 FActiveWindowIndexAtStart: integer; 717 FBuildModes: TProjectBuildModes; 718 FBuildModesBackup: TProjectBuildModes; 719 FAllEditorsInfoList: TUnitEditorInfoList; 720 FAllEditorsInfoMap: TMap; 721 FAutoCreateForms: boolean; 722 FChangeStampSaved: integer; 723 FDebuggerBackend: String; 724 FEnableI18NForLFM: boolean; 725 FHistoryLists: THistoryLists; 726 FLastCompileComplete: boolean; 727 FMacroEngine: TTransferMacroList; 728 FTmpAutoCreatedForms: TStrings; // temporary, used to apply auto create forms changes 729 FAutoOpenDesignerFormsDisabled: boolean; 730 FBookmarks: TProjectBookmarkList; 731 fChanged: boolean; 732 fCurStorePathDelim: TPathDelimSwitch; // used by OnLoadSaveFilename 733 FDefineTemplates: TProjectDefineTemplates; 734 fDestroying: boolean; 735 FEnableI18N: boolean; 736 FI18NExcludedIdentifiers: TStrings; 737 FI18NExcludedOriginals: TStrings; 738 FForceUpdatePoFiles: Boolean; 739 fFirst, fLast: array[TUnitInfoList] of TUnitInfo; 740 FFirstRemovedDependency: TPkgDependency; 741 FFirstRequiredDependency: TPkgDependency; 742 FJumpHistory: TProjectJumpHistory; 743 FLastCompilerFileDate: integer; 744 FLastCompilerFilename: string; 745 FLastCompilerParams: string; 746 fLastReadLPIFileDate: TDateTime; 747 fLastReadLPIFilename: string; 748 FLockUnitComponentDependencies: integer; 749 FMainProject: boolean; 750 fMainUnitID: Integer; 751 FOnBeginUpdate: TNotifyEvent; 752 FOnChangeProjectInfoFile: TOnChangeProjectInfoFile; 753 FOnEndUpdate: TEndUpdateProjectEvent; 754 fOnFileBackup: TOnFileBackup; 755 FOnLoadProjectInfo: TOnLoadProjectInfo; 756 FOnSaveProjectInfo: TOnSaveProjectInfo; 757 FOnSaveUnitSessionInfo: TOnSaveUnitSessionInfoInfo; 758 fPathDelimChanged: boolean; // PathDelim in system and current config differ (see StorePathDelim and SessionStorePathDelim) 759 FPOOutputDirectory: string; 760 fProjectDirectory: string; 761 fProjectDirectoryReferenced: string; 762 fProjectInfoFile: String; // the lpi filename 763 fProjectInfoFileBuffer: TCodeBuffer; 764 fProjectInfoFileBufChangeStamp: integer; 765 fProjectInfoFileDate: LongInt; 766 FPublishOptions: TPublishProjectOptions; 767 FRevertLockCount: integer; 768 FSessionModifiedBackup: boolean; 769 FSessionStorePathDelim: TPathDelimSwitch; 770 FSkipCheckLCLInterfaces: boolean; 771 FSourceDirectories: TFileReferenceList; 772 FStateFileDate: longint; 773 FStateFlags: TLazProjectStateFlags; 774 FStorePathDelim: TPathDelimSwitch; 775 FUnitList: TFPList; // list of _all_ units (TUnitInfo) 776 FOtherDefines: TStrings; // list of user selectable defines for custom options 777 FUpdateLock: integer; 778 FUseAsDefault: Boolean; 779 // Variables used by ReadProject / WriteProject 780 FXMLConfig: TXMLConfig; 781 FLoadAllOptions: Boolean; // All options / just options used as default for new projects 782 FFileVersion: Integer; 783 FNewMainUnitID: LongInt; 784 FProjectWriteFlags: TProjectWriteFlags; 785 FSaveSessionInLPI: Boolean; 786 procedure ClearBuildModes; 787 function GetAllEditorsInfo(Index: Integer): TUnitEditorInfo; 788 function GetCompilerOptions: TProjectCompilerOptions; 789 function GetBaseCompilerOptions: TBaseCompilerOptions; 790 function GetFirstAutoRevertLockedUnit: TUnitInfo; 791 function GetFirstLoadedUnit: TUnitInfo; 792 function GetFirstPartOfProject: TUnitInfo; 793 function GetFirstUnitWithComponent: TUnitInfo; 794 function GetFirstUnitWithEditorIndex: TUnitInfo; 795 function GetIDEOptions: TProjectIDEOptions; 796 function GetMainFilename: String; 797 function GetMainUnitInfo: TUnitInfo; 798 function GetProjResources: TProjectResources; 799 function GetRunParameterOptions: TRunParamsOptions; 800 function GetSourceDirectories: TFileReferenceList; 801 function GetTargetFilename: string; 802 function GetUnits(Index: integer): TUnitInfo; 803 function GetUseLegacyLists: Boolean; 804 function JumpHistoryCheckPosition( 805 APosition:TProjectJumpHistoryPosition): boolean; 806 procedure ClearSourceDirectories; 807 procedure EmbeddedObjectModified(Sender: TObject); 808 function FileBackupHandler(const Filename: string): TModalResult; 809 procedure LoadSaveFilenameHandler(var AFilename: string; Load: boolean); 810 procedure UnitNameChangeHandler(AnUnitInfo: TUnitInfo; 811 const OldUnitName, NewUnitName: string; 812 CheckIfAllowed: boolean; var Allowed: boolean); 813 procedure SetActiveBuildMode(const AValue: TProjectBuildMode); 814 procedure SetAutoOpenDesignerFormsDisabled(const AValue: boolean); 815 procedure SetDebuggerBackend(AValue: String); 816 procedure SetEnableI18N(const AValue: boolean); 817 procedure SetEnableI18NForLFM(const AValue: boolean); 818 procedure SetLastCompilerParams(AValue: string); 819 procedure SetMainProject(const AValue: boolean); 820 procedure SetMainUnitID(const AValue: Integer); 821 procedure SetPOOutputDirectory(const AValue: string); 822 procedure SetSkipCheckLCLInterfaces(const AValue: boolean); 823 procedure SetStorePathDelim(const AValue: TPathDelimSwitch); 824 procedure SetTargetFilename(const NewTargetFilename: string); 825 procedure SourceDirectoriesChanged(Sender: TObject); 826 procedure UpdateFileBuffer; 827 procedure UpdateProjectDirectory; 828 procedure UpdateSessionFilename; 829 procedure UpdateSourceDirectories; 830 procedure UpdateUsageCounts(const ConfigFilename: string); 831 function UnitMustBeSaved(UnitInfo: TUnitInfo; WriteFlags: TProjectWriteFlags; 832 SaveSession: boolean): boolean; 833 procedure UpdateVisibleEditor(PgIndex: integer); 834 procedure LoadDefaultSession; 835 procedure EditorInfoAdd(EdInfo: TUnitEditorInfo); 836 procedure EditorInfoRemove(EdInfo: TUnitEditorInfo); 837 procedure OnMacroEngineSubstitution({%H-}TheMacro: TTransferMacro; 838 const MacroName: string; var s: string; 839 const Data: PtrInt; var Handled, Abort: boolean; Depth: integer); 840 // Methods for ReadProject 841 function LoadOldProjectType(const Path: string): TOldProjectType; 842 procedure LoadFlags(const Path: string); 843 procedure LoadOtherDefines(const Path: string); 844 procedure LoadSessionInfo(const Path: string; Merge: boolean); 845 procedure LoadFromLPI; 846 procedure LoadFromSession; 847 function DoLoadLPI(Filename: String): TModalResult; 848 function DoLoadSession(Filename: String): TModalResult; 849 function DoLoadLPR(Revert: boolean): TModalResult; 850 // Methods for WriteProject 851 procedure SaveFlags(const Path: string); 852 procedure SaveUnits(const Path: string; SaveSession: boolean); 853 procedure SaveOtherDefines(const Path: string); 854 procedure SaveSessionInfo(const Path: string); 855 procedure SaveToLPI; 856 procedure SaveToSession; 857 function DoWrite(Filename: String; IsLpi: Boolean): TModalResult; 858 protected 859 function GetDirectory: string; override; 860 function GetActiveBuildModeID: string; override; 861 function GetDefineTemplates: TProjPackDefineTemplates; 862 function GetFiles(Index: integer): TLazProjectFile; override; 863 function GetLazBuildModes: TLazProjectBuildModes; override; 864 function GetMainFile: TLazProjectFile; override; 865 function GetMainFileID: Integer; override; 866 function GetModified: boolean; override; 867 function GetProjectInfoFile: string; override; 868 function GetUseManifest: boolean; override; 869 procedure SetActiveBuildModeID(aIdent: string); override; 870 procedure SetExecutableType(const AValue: TProjectExecutableType); override; 871 procedure SetFlags(const AValue: TProjectFlags); override; 872 procedure SetMainFileID(const AValue: Integer); override; 873 procedure SetModified(const AValue: boolean); override; 874 procedure SetProjectInfoFile(const NewFilename: string); override; 875 procedure SetSessionModified(const AValue: boolean); override; 876 procedure SetSessionStorage(const AValue: TProjectSessionStorage); override; 877 procedure SetUseManifest(AValue: boolean); override; 878 function GetCurrentDebuggerBackend: String; override; 879 protected 880 // special unit lists 881 procedure AddToList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList); 882 procedure RemoveFromList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList); 883 884 procedure AddToOrRemoveFromAutoRevertLockedList(AnUnitInfo: TUnitInfo); 885 procedure AddToOrRemoveFromComponentList(AnUnitInfo: TUnitInfo); 886 procedure AddToOrRemoveFromLoadedList(AnUnitInfo: TUnitInfo); 887 procedure AddToOrRemoveFromPartOfProjectList(AnUnitInfo: TUnitInfo); 888 public 889 constructor Create(ProjectDescription: TProjectDescriptor); override; 890 destructor Destroy; override; 891 procedure Clear; override; 892 procedure BeginUpdate(Change: boolean); 893 procedure EndUpdate; 894 procedure UnitModified(AnUnitInfo: TUnitInfo); 895 function NeedsDefineTemplates: boolean; 896 procedure BeginRevertUnit(AnUnitInfo: TUnitInfo); 897 procedure EndRevertUnit(AnUnitInfo: TUnitInfo); 898 function IsLclApplication: Boolean; 899 function IsReverting(AnUnitInfo: TUnitInfo): boolean; 900 function IsVirtual: boolean; override; 901 // load/save 902 function SomethingModified(CheckData, CheckSession: boolean; Verbose: boolean = false): boolean; 903 function SomeDataModified(Verbose: boolean = false): boolean; 904 function SomeSessionModified(Verbose: boolean = false): boolean; 905 procedure MainSourceFilenameChanged; 906 procedure GetUnitsChangedOnDisk(var AnUnitList: TFPList; IgnoreModifiedFlag: boolean = False); 907 function HasProjectInfoFileChangedOnDisk: boolean; 908 procedure IgnoreProjectInfoFileOnDisk; 909 function ReadProject(const NewProjectInfoFile: string; 910 GlobalMatrixOptions: TBuildMatrixOptions; 911 LoadAllOptions: Boolean = True): TModalResult; 912 function WriteProject(ProjectWriteFlags: TProjectWriteFlags; 913 const OverrideProjectInfoFile: string; 914 GlobalMatrixOptions: TBuildMatrixOptions): TModalResult; 915 procedure UpdateExecutableType; override; 916 procedure BackupSession; 917 procedure RestoreSession; 918 procedure BackupBuildModes; 919 procedure RestoreBuildModes; 920 921 // title 922 function GetTitle: string; override; 923 function TitleIsDefault(Fuzzy: boolean = false): boolean; 924 function GetIDAsString: string; 925 function GetIDAsWord: string; 926 927 // units 928 function UnitCount:integer; 929 function GetFileCount: integer; override; 930 function NewUniqueUnitName(const AnUnitName: string): string; 931 function NewUniqueFilename(const Filename: string): string; 932 procedure AddFile(ProjectFile: TLazProjectFile; 933 AddToProjectUsesClause: boolean); override; 934 procedure RemoveUnit(Index: integer; 935 RemoveFromUsesSection: boolean = true); override; 936 // true if something changed 937 function RemoveNonExistingFiles(RemoveFromUsesSection: boolean = true): boolean; 938 function CreateProjectFile(const Filename: string): TLazProjectFile; override; 939 function GetAndUpdateVisibleUnit(AnEditor: TSourceEditorInterface; 940 AWindowID: Integer): TUnitInfo; 941 procedure UpdateAllVisibleUnits; 942 // search 943 function IndexOf(AUnitInfo: TUnitInfo): integer; 944 function IndexOfUnitWithName(const AnUnitName: string; 945 OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo): integer; 946 function IndexOfUnitWithComponent(AComponent: TComponent; 947 OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo): integer; 948 function IndexOfUnitWithComponentName(const AComponentName: string; 949 OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo): integer; 950 function IndexOfFilename(const AFilename: string): integer; 951 function IndexOfFilename(const AFilename: string; 952 SearchFlags: TProjectFileSearchFlags): integer; 953 function ProjectUnitWithFilename(const AFilename: string): TUnitInfo; 954 function ProjectUnitWithShortFilename(const ShortFilename: string): TUnitInfo; 955 function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo; 956 function UnitWithEditorComponent(AEditor:TSourceEditorInterface): TUnitInfo; 957 function UnitWithComponent(AComponent: TComponent): TUnitInfo; 958 function UnitWithComponentClass(AClass: TComponentClass): TUnitInfo; 959 function UnitWithComponentClassName(const AClassName: string): TUnitInfo; 960 function UnitWithComponentName(AComponentName: String; 961 OnlyPartOfProject: boolean): TUnitInfo; 962 function UnitComponentInheritingFrom(AClass: TComponentClass; 963 Ignore: TUnitInfo): TUnitInfo; 964 function UnitUsingComponentUnit(ComponentUnit: TUnitInfo; 965 Types: TUnitCompDependencyTypes): TUnitInfo; 966 function UnitComponentIsUsed(ComponentUnit: TUnitInfo; 967 CheckHasDesigner: boolean): boolean; 968 function UnitInfoWithFilename(const AFilename: string): TUnitInfo; 969 function UnitInfoWithFilename(const AFilename: string; 970 SearchFlags: TProjectFileSearchFlags): TUnitInfo; 971 function UnitWithUnitname(const AnUnitname: string): TUnitInfo; 972 function AllEditorsInfoCount: Integer; 973 property AllEditorsInfo[Index: Integer]: TUnitEditorInfo read GetAllEditorsInfo; 974 function EditorInfoWithEditorComponent(AEditor:TSourceEditorInterface): TUnitEditorInfo; 975 function SearchFile(const ShortFilename: string; 976 SearchFlags: TSearchIDEFileFlags): TUnitInfo; 977 function FindFile(const AFilename: string; 978 SearchFlags: TProjectFileSearchFlags): TLazProjectFile; override; 979 980 // used units with 'in' modifier 981 function UpdateIsPartOfProjectFromMainUnit: TModalResult; 982 983 // Application.CreateForm statements 984 function AddCreateFormToProjectFile(const AClassName, AName:string): boolean; 985 function RemoveCreateFormFromProjectFile(const AName: string): boolean; 986 function FormIsCreatedInProjectFile(const AClassname, AName:string): boolean; 987 function GetAutoCreatedFormsList: TStrings; 988 property TmpAutoCreatedForms: TStrings read FTmpAutoCreatedForms write FTmpAutoCreatedForms; 989 990 // resources 991 function GetMainResourceFilename(AnUnitInfo: TUnitInfo): string; 992 function GetResourceFile(AnUnitInfo: TUnitInfo; Index:integer):TCodeBuffer; 993 procedure LoadDefaultIcon; override; 994 995 // filenames and fileinfo 996 function RemoveProjectPathFromFilename(const AFilename: string): string; 997 function FileIsInProjectDir(const AFilename: string): boolean; 998 procedure GetVirtualDefines(DefTree: TDefineTree; DirDef: TDirectoryDefines); 999 function GetShortFilename(const Filename: string; UseUp: boolean): string; override; 1000 procedure ConvertToLPIFilename(var AFilename: string); override; 1001 procedure ConvertFromLPIFilename(var AFilename: string); override; 1002 1003 // package dependencies 1004 function FindDependencyByName(const PackageName: string): TPkgDependency; 1005 function FindRemovedDependencyByName(const PkgName: string): TPkgDependency; 1006 function RequiredDepByIndex(Index: integer): TPkgDependency; 1007 function RemovedDepByIndex(Index: integer): TPkgDependency; 1008 procedure AddRequiredDependency(Dependency: TPkgDependency); 1009 procedure RemoveRequiredDependency(Dependency: TPkgDependency); 1010 procedure DeleteRequiredDependency(Dependency: TPkgDependency); 1011 procedure DeleteRemovedDependency(Dependency: TPkgDependency); 1012 procedure RemoveRemovedDependency(Dependency: TPkgDependency); 1013 procedure ReaddRemovedDependency(Dependency: TPkgDependency); 1014 procedure MoveRequiredDependencyUp(Dependency: TPkgDependency); 1015 procedure MoveRequiredDependencyDown(Dependency: TPkgDependency); 1016 function Requires(APackage: TLazPackage; SearchRecursively: boolean): boolean; 1017 procedure GetAllRequiredPackages(var List: TFPList; 1018 ReqFlags: TPkgIntfRequiredFlags = []; 1019 MinPolicy: TPackageUpdatePolicy = low(TPackageUpdatePolicy)); 1020 procedure AddPackageDependency(const PackageName: string); override; 1021 function RemovePackageDependency(const PackageName: string): boolean; 1022 override; 1023 1024 // unit dependencies 1025 procedure LockUnitComponentDependencies; 1026 procedure UnlockUnitComponentDependencies; 1027 procedure UpdateUnitComponentDependencies; 1028 procedure InvalidateUnitComponentDesignerDependencies; 1029 procedure ClearUnitComponentDependencies(ClearTypes: TUnitCompDependencyTypes); 1030 procedure FindUnitsUsingSubComponent(SubComponent: TComponent; 1031 List: TFPList; IgnoreOwner: boolean); 1032 procedure WriteDebugReportUnitComponentDependencies(Prefix: string); 1033 1034 // paths 1035 procedure AddSrcPath(const SrcPathAddition: string); override; 1036 function GetSourceDirs(WithProjectDir, WithoutOutputDir: boolean): string; 1037 function GetOutputDirectory: string; 1038 function GetCompilerFilename: string; 1039 function GetStateFilename: string; 1040 function GetCompileSourceFilename: string; 1041 procedure AutoAddOutputDirToIncPath; 1042 function ExtendUnitSearchPath(NewUnitPaths: string): boolean; 1043 function ExtendIncSearchPath(NewIncPaths: string): boolean; 1044 1045 // compile state file 1046 function LoadStateFile(IgnoreErrors: boolean): TModalResult; 1047 function SaveStateFile(const CompilerFilename, CompilerParams: string; 1048 Complete: boolean): TModalResult; 1049 1050 // source editor 1051 procedure UpdateAllCustomHighlighter; 1052 procedure UpdateAllSyntaxHighlighter; 1053 1054 // i18n 1055 function GetPOOutDirectory: string; 1056 1057 // bookmarks 1058 function AddBookmark(X, Y, ID: Integer; AUnitInfo:TUnitInfo):integer; 1059 procedure DeleteBookmark(ID: Integer); 1060 public 1061 property ActiveBuildMode: TProjectBuildMode read FActiveBuildMode 1062 write SetActiveBuildMode; 1063 property ActiveWindowIndexAtStart: integer read FActiveWindowIndexAtStart 1064 write FActiveWindowIndexAtStart; 1065 property AutoCreateForms: boolean read FAutoCreateForms write FAutoCreateForms; 1066 property AutoOpenDesignerFormsDisabled: boolean read FAutoOpenDesignerFormsDisabled 1067 write SetAutoOpenDesignerFormsDisabled; 1068 property Bookmarks: TProjectBookmarkList read FBookmarks write FBookmarks; 1069 property BuildModes: TProjectBuildModes read FBuildModes; 1070 property SkipCheckLCLInterfaces: boolean read FSkipCheckLCLInterfaces 1071 write SetSkipCheckLCLInterfaces; 1072 property CompilerOptions: TProjectCompilerOptions read GetCompilerOptions; 1073 property DefineTemplates: TProjectDefineTemplates read FDefineTemplates; 1074 property Destroying: boolean read fDestroying; 1075 property EnableI18N: boolean read FEnableI18N write SetEnableI18N; 1076 property EnableI18NForLFM: boolean read FEnableI18NForLFM write SetEnableI18NForLFM; 1077 property I18NExcludedIdentifiers: TStrings read FI18NExcludedIdentifiers; 1078 property I18NExcludedOriginals: TStrings read FI18NExcludedOriginals; 1079 property UseLegacyLists: Boolean read GetUseLegacyLists; 1080 property ForceUpdatePoFiles: Boolean read FForceUpdatePoFiles write FForceUpdatePoFiles; 1081 property FirstAutoRevertLockedUnit: TUnitInfo read GetFirstAutoRevertLockedUnit; 1082 property FirstLoadedUnit: TUnitInfo read GetFirstLoadedUnit; 1083 property FirstPartOfProject: TUnitInfo read GetFirstPartOfProject; 1084 property FirstRemovedDependency: TPkgDependency read FFirstRemovedDependency; 1085 property FirstRequiredDependency: TPkgDependency read FFirstRequiredDependency; 1086 property FirstUnitWithComponent: TUnitInfo read GetFirstUnitWithComponent; 1087 property FirstUnitWithEditorIndex: TUnitInfo read GetFirstUnitWithEditorIndex; 1088 property IDAsString: string read GetIDAsString; 1089 property IDAsWord: string read GetIDAsWord; 1090 property IDEOptions: TProjectIDEOptions read GetIDEOptions; 1091 property JumpHistory: TProjectJumpHistory read FJumpHistory write FJumpHistory; 1092 property LastCompilerFileDate: integer read FLastCompilerFileDate 1093 write FLastCompilerFileDate; 1094 property LastCompilerFilename: string read FLastCompilerFilename 1095 write FLastCompilerFilename; 1096 property LastCompilerParams: string read FLastCompilerParams 1097 write SetLastCompilerParams; 1098 property LastCompileComplete: boolean read FLastCompileComplete write FLastCompileComplete; 1099 property MacroEngine: TTransferMacroList read FMacroEngine; 1100 property MainFilename: String read GetMainFilename; 1101 property MainProject: boolean read FMainProject write SetMainProject; 1102 property MainUnitID: Integer read FMainUnitID write SetMainUnitID; 1103 property MainUnitInfo: TUnitInfo read GetMainUnitInfo; 1104 property OnBeginUpdate: TNotifyEvent read FOnBeginUpdate write FOnBeginUpdate; 1105 property OnChangeProjectInfoFile: TOnChangeProjectInfoFile read FOnChangeProjectInfoFile 1106 write FOnChangeProjectInfoFile; 1107 property OnEndUpdate: TEndUpdateProjectEvent read FOnEndUpdate write FOnEndUpdate; 1108 property OnFileBackup: TOnFileBackup read fOnFileBackup write fOnFileBackup; 1109 property OnLoadProjectInfo: TOnLoadProjectInfo read FOnLoadProjectInfo 1110 write FOnLoadProjectInfo; 1111 property OnSaveProjectInfo: TOnSaveProjectInfo read FOnSaveProjectInfo 1112 write FOnSaveProjectInfo; 1113 property OnSaveUnitSessionInfo: TOnSaveUnitSessionInfoInfo 1114 read FOnSaveUnitSessionInfo write FOnSaveUnitSessionInfo; 1115 property POOutputDirectory: string read FPOOutputDirectory write SetPOOutputDirectory; 1116 property ProjectInfoFile: string read GetProjectInfoFile write SetProjectInfoFile; 1117 property PublishOptions: TPublishProjectOptions read FPublishOptions write FPublishOptions; 1118 property ProjResources: TProjectResources read GetProjResources; 1119 1120 property RunParameterOptions: TRunParamsOptions read GetRunParameterOptions; 1121 property HistoryLists: THistoryLists read FHistoryLists; 1122 property SourceDirectories: TFileReferenceList read GetSourceDirectories; 1123 property StateFileDate: longint read FStateFileDate write FStateFileDate; 1124 property StateFlags: TLazProjectStateFlags read FStateFlags write FStateFlags; 1125 property SessionStorePathDelim: TPathDelimSwitch read FSessionStorePathDelim write FSessionStorePathDelim; 1126 property StorePathDelim: TPathDelimSwitch read FStorePathDelim write SetStorePathDelim; 1127 property TargetFilename: string read GetTargetFilename write SetTargetFilename; 1128 property Units[Index: integer]: TUnitInfo read GetUnits; 1129 property OtherDefines: TStrings read FOtherDefines; 1130 property UpdateLock: integer read FUpdateLock; 1131 property UseAsDefault: Boolean read FUseAsDefault write FUseAsDefault; // for dialog only (used to store options once) 1132 1133 property DebuggerBackend: String read FDebuggerBackend write SetDebuggerBackend; 1134 end; 1135 1136 1137const 1138 ResourceFileExt = '.lrs'; 1139 DefaultProjectOptionsFilename = 'projectoptions.xml'; 1140 DefaultProjectCompilerOptionsFilename = 'compileroptions.xml'; // old way < 0.9.31 1141 OldProjectTypeNames : array[TOldProjectType] of string = ( 1142 'Application', 'Program', 'Custom program' 1143 ); 1144 1145var 1146 Project1: TProject = nil;// the main project 1147 1148function FilenameToLazSyntaxHighlighter(Filename: String): TLazSyntaxHighlighter; 1149function AddCompileReasonsDiff(const PropertyName: string; 1150 const Old, New: TCompileReasons; Tool: TCompilerDiffTool = nil): boolean; 1151function dbgs(aType: TUnitCompDependencyType): string; overload; 1152function dbgs(Types: TUnitCompDependencyTypes): string; overload; 1153function dbgs(Flag: TUnitInfoFlag): string; overload; 1154function dbgs(Flags: TUnitInfoFlags): string; overload; 1155 1156implementation 1157 1158const 1159 ProjectInfoFileVersion = 12; 1160 ProjOptionsPath = 'ProjectOptions/'; 1161 1162 1163function FilenameToLazSyntaxHighlighter(Filename: String): TLazSyntaxHighlighter; 1164var 1165 CompilerMode: TCompilerMode; 1166begin 1167 Result:=IDEEditorOptions.ExtensionToLazSyntaxHighlighter(ExtractFileExt(Filename)); 1168 if Result in [lshFreePascal,lshDelphi] then begin 1169 CompilerMode:=CodeToolBoss.GetCompilerModeForDirectory(ExtractFilePath(Filename)); 1170 if CompilerMode in [cmDELPHI,cmTP] then 1171 Result:=lshDelphi 1172 else 1173 Result:=lshFreePascal; 1174 end; 1175end; 1176 1177function AddCompileReasonsDiff(const PropertyName: string; 1178 const Old, New: TCompileReasons; Tool: TCompilerDiffTool): boolean; 1179begin 1180 if Old=New then exit(false); 1181 Result:=true; 1182 Tool.AddSetDiff(PropertyName,integer(Old),integer(New), 1183 PString(@CompileReasonNames[Low(TCompileReasons)])); 1184end; 1185 1186function dbgs(aType: TUnitCompDependencyType): string; 1187begin 1188 case aType of 1189 ucdtAncestor: Result:='Ancestor'; 1190 ucdtProperty: Result:='Property'; 1191 ucdtOldProperty: Result:='OldProperty'; 1192 ucdtInlineClass: Result:='InlineClass'; 1193 else Result:='?' 1194 end; 1195end; 1196 1197function dbgs(Types: TUnitCompDependencyTypes): string; 1198var 1199 t: TUnitCompDependencyType; 1200begin 1201 Result:=''; 1202 for t:=low(Types) to High(Types) do 1203 if t in Types then begin 1204 if Result<>'' then Result:=Result+';'; 1205 Result:=Result+dbgs(t); 1206 end; 1207 Result:='['+Result+']'; 1208end; 1209 1210function dbgs(Flag: TUnitInfoFlag): string; 1211begin 1212 Result:=''; 1213 WriteStr(Result, Flag); 1214end; 1215 1216function dbgs(Flags: TUnitInfoFlags): string; 1217var 1218 f: TUnitInfoFlag; 1219begin 1220 Result:=''; 1221 for f:=low(Flags) to High(Flags) do 1222 if f in Flags then begin 1223 if Result<>'' then Result:=Result+';'; 1224 Result:=Result+dbgs(f); 1225 end; 1226 Result:='['+Result+']'; 1227end; 1228 1229{ TUnitEditorInfo } 1230 1231procedure TUnitEditorInfo.SetEditorComponent(const AValue: TSourceEditorInterface); 1232begin 1233 if FEditorComponent = AValue then exit; 1234 if AValue = nil then begin 1235 fUnitInfo.Project.FAllEditorsInfoMap.Delete(FEditorComponent); 1236 FEditorComponent := AValue; 1237 UnitInfo.FEditorInfoList.MakeUnUsedEditorInfo(Self); 1238 PageIndex := -1; // calls UnitInfo.UpdatePageIndex 1239 IsLocked := False; 1240 end 1241 else begin 1242 PageIndex := -1; 1243 with fUnitInfo.Project do // Map for lookup: Editor -> EditorInfo 1244 if not FAllEditorsInfoMap.HasId(AValue) then 1245 FAllEditorsInfoMap.Add(AValue, Self); 1246 FEditorComponent := AValue; 1247 UnitInfo.FEditorInfoList.MakeUsedEditorInfo(Self); 1248 AValue.UpdateProjectFile; // Set EditorIndex / calls UnitInfo.UpdatePageIndex 1249 end; 1250 FUnitInfo.SessionModified:=true; 1251end; 1252 1253procedure TUnitEditorInfo.SetPageIndex(const AValue: Integer); 1254begin 1255 if FPageIndex = AValue then exit; 1256 FPageIndex := AValue; 1257 FUnitInfo.UpdatePageIndex; 1258 FUnitInfo.SessionModified := True; 1259end; 1260 1261procedure TUnitEditorInfo.SetFoldState(AValue: String); 1262begin 1263 if FFoldState = AValue then Exit; 1264 FFoldState := AValue; 1265 FUnitInfo.SessionModified := True; 1266end; 1267 1268procedure TUnitEditorInfo.SetIsLocked(const AValue: Boolean); 1269begin 1270 if FIsLocked=AValue then Exit; 1271 FIsLocked:=AValue; 1272 FUnitInfo.SessionModified := True; 1273end; 1274 1275procedure TUnitEditorInfo.SetCursorPos(const AValue: TPoint); 1276begin 1277 if ComparePoints(FCursorPos,AValue)=0 then Exit; 1278 FCursorPos:=AValue; 1279 FUnitInfo.SessionModified := True; 1280end; 1281 1282procedure TUnitEditorInfo.SetIsVisibleTab(const AValue: Boolean); 1283begin 1284 if FIsVisibleTab = AValue then exit; 1285 FIsVisibleTab := AValue; 1286 FUnitInfo.SessionModified := True; 1287end; 1288 1289procedure TUnitEditorInfo.SetSyntaxHighlighter(AValue: TLazSyntaxHighlighter); 1290begin 1291 if FSyntaxHighlighter = AValue then Exit; 1292 FSyntaxHighlighter := AValue; 1293 FCustomHighlighter := FSyntaxHighlighter <> FUnitInfo.DefaultSyntaxHighlighter; 1294 FUnitInfo.SessionModified := True; 1295end; 1296 1297procedure TUnitEditorInfo.SetTopLine(const AValue: Integer); 1298begin 1299 if FTopLine=AValue then Exit; 1300 FTopLine:=AValue; 1301 FUnitInfo.SessionModified := True; 1302end; 1303 1304procedure TUnitEditorInfo.SetWindowIndex(const AValue: Integer); 1305begin 1306 if FWindowID = AValue then exit; 1307 FWindowID := AValue; 1308 FUnitInfo.SessionModified := True; 1309end; 1310 1311procedure TUnitEditorInfo.Clear; 1312begin 1313 FIsVisibleTab := False; 1314 FPageIndex := -1; 1315 FWindowID := -1; 1316 FTopLine := -1; 1317 FCursorPos.X := -1; 1318 FCursorPos.Y := -1; 1319 FFoldState := ''; 1320 FSyntaxHighlighter := FUnitInfo.DefaultSyntaxHighlighter; 1321 FCustomHighlighter := FUnitInfo.CustomDefaultHighlighter; 1322end; 1323 1324constructor TUnitEditorInfo.Create(aUnitInfo: TUnitInfo); 1325begin 1326 FUnitInfo := aUnitInfo; 1327 Clear; 1328 if FUnitInfo.Project <> nil then 1329 FUnitInfo.Project.EditorInfoAdd(Self); 1330end; 1331 1332destructor TUnitEditorInfo.Destroy; 1333begin 1334 if FUnitInfo.Project <> nil then 1335 FUnitInfo.Project.EditorInfoRemove(Self); 1336 inherited Destroy; 1337end; 1338 1339procedure TUnitEditorInfo.LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); 1340begin 1341 IsVisibleTab := XMLConfig.GetValue(Path+'IsVisibleTab/Value', False); 1342 FPageIndex := XMLConfig.GetValue(Path+'EditorIndex/Value',0); 1343 WindowID := XMLConfig.GetValue(Path+'WindowIndex/Value',0); 1344 // update old data 1345 if (FPageIndex >= 0) and (FWindowID < 0) then 1346 WindowID := 1; 1347 FTopLine := XMLConfig.GetValue(Path+'TopLine/Value',1); 1348 FCursorPos := Point(XMLConfig.GetValue(Path+'CursorPos/X',1), 1349 XMLConfig.GetValue(Path+'CursorPos/Y',1)); 1350 FFoldState := XMLConfig.GetValue(Path+'FoldState/Value', ''); 1351 FIsLocked := XMLConfig.GetValue(Path+'IsLocked/Value', False); 1352 FSyntaxHighlighter := StrToLazSyntaxHighlighter( 1353 XMLConfig.GetValue(Path+'SyntaxHighlighter/Value', 1354 LazSyntaxHighlighterNames[UnitInfo.DefaultSyntaxHighlighter])); 1355end; 1356 1357procedure TUnitEditorInfo.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; 1358 SaveFold: Boolean); 1359begin 1360 XMLConfig.SetDeleteValue(Path+'IsVisibleTab/Value', FIsVisibleTab, False); 1361 XMLConfig.SetDeleteValue(Path+'EditorIndex/Value', FPageIndex, 0); 1362 XMLConfig.SetDeleteValue(Path+'WindowIndex/Value', FWindowID, 0); 1363 XMLConfig.SetDeleteValue(Path+'TopLine/Value', FTopLine, 1); 1364 XMLConfig.SetDeleteValue(Path+'CursorPos/X', FCursorPos.X, 1); 1365 XMLConfig.SetDeleteValue(Path+'CursorPos/Y', FCursorPos.Y, 1); 1366 XMLConfig.SetDeleteValue(Path+'IsLocked/Value', FIsLocked, False); 1367 if SaveFold then 1368 XMLConfig.SetDeleteValue(Path+'FoldState/Value', FoldState, '') 1369 else 1370 XMLConfig.DeletePath(Path+'FoldState'); 1371 XMLConfig.SetDeleteValue(Path+'SyntaxHighlighter/Value', 1372 LazSyntaxHighlighterNames[fSyntaxHighlighter], 1373 LazSyntaxHighlighterNames[UnitInfo.DefaultSyntaxHighlighter]); 1374end; 1375 1376{ TUnitEditorInfoList } 1377 1378function TUnitEditorInfoList.GetEditorInfos(Index: Integer): TUnitEditorInfo; 1379begin 1380 Result := TUnitEditorInfo(FList[Index]); 1381end; 1382 1383function TUnitEditorInfoList.GetClosedEditorInfos(Index: Integer): TUnitEditorInfo; 1384var 1385 i: Integer; 1386begin 1387 i := 0; 1388 while (i < Count) and (Index >= 0) do begin 1389 Result := EditorInfos[i]; 1390 if Result.EditorComponent = nil then dec(Index); 1391 inc(i); 1392 end; 1393 if Index >= 0 then 1394 Result := nil; 1395end; 1396 1397function TUnitEditorInfoList.GetOpenEditorInfos(Index: Integer): TUnitEditorInfo; 1398var 1399 i: Integer; 1400begin 1401 i := 0; 1402 while (i < Count) and (Index >= 0) do begin 1403 Result := EditorInfos[i]; 1404 if Result.EditorComponent <> nil then dec(Index); 1405 inc(i); 1406 end; 1407 if Index >= 0 then 1408 Result := nil; 1409end; 1410 1411procedure TUnitEditorInfoList.ClearEachInfo; 1412var 1413 i: Integer; 1414begin 1415 for i := 0 to Count - 1 do 1416 EditorInfos[i].Clear; 1417end; 1418 1419function CompareEditorInfoByPageIndex(EditorInfo1, EditorInfo2: TUnitEditorInfo): integer; 1420begin 1421 Result := EditorInfo1.WindowID - EditorInfo2.WindowID; 1422 if Result = 0 then 1423 Result := EditorInfo1.PageIndex - EditorInfo2.PageIndex; 1424end; 1425 1426procedure TUnitEditorInfoList.SortByPageIndex; 1427begin 1428 FList.Sort(TListSortCompare(@CompareEditorInfoByPageIndex)); 1429end; 1430 1431procedure TUnitEditorInfoList.SetLastUsedEditor(AEditor: TSourceEditorInterface); 1432var 1433 i: Integer; 1434begin 1435 i := IndexOfEditorComponent(AEditor); 1436 if i <> 0 then 1437 FList.Move(i, 0); 1438end; 1439 1440procedure TUnitEditorInfoList.MakeUsedEditorInfo(AEditorInfo: TUnitEditorInfo); 1441var 1442 i, j: Integer; 1443begin 1444 i := FList.IndexOf(AEditorInfo); 1445 j := OpenCount; 1446 if (i > j) and (j < Count) then 1447 FList.Move(i, j); 1448end; 1449 1450procedure TUnitEditorInfoList.MakeUnUsedEditorInfo(AEditorInfo: TUnitEditorInfo); 1451var 1452 i: Integer; 1453begin 1454 i := FList.IndexOf(AEditorInfo); 1455 if i <> FList.Count - 1 then 1456 FList.Move(i, FList.Count - 1); 1457end; 1458 1459procedure TUnitEditorInfoList.Clear; 1460begin 1461 while Count > 0 do begin 1462 EditorInfos[0].Free; 1463 Delete(0); 1464 end; 1465end; 1466 1467constructor TUnitEditorInfoList.Create(aUnitInfo: TUnitInfo); 1468begin 1469 FUnitInfo := aUnitInfo; 1470 FList := TFPList.Create; 1471end; 1472 1473destructor TUnitEditorInfoList.Destroy; 1474begin 1475 Clear; 1476 FreeAndNil(FList); 1477 inherited Destroy; 1478end; 1479 1480function TUnitEditorInfoList.Count: Integer; 1481begin 1482 Result := FList.Count; 1483end; 1484 1485function TUnitEditorInfoList.OpenCount: Integer; 1486var 1487 i: Integer; 1488begin 1489 i := Count - 1; 1490 Result := 0; 1491 while i >= 0 do begin 1492 if EditorInfos[i].EditorComponent <> nil then inc(Result); 1493 dec(i); 1494 end; 1495end; 1496 1497function TUnitEditorInfoList.ClosedCount: Integer; 1498var 1499 i: Integer; 1500begin 1501 i := Count - 1; 1502 Result := 0; 1503 while i >= 0 do begin 1504 if EditorInfos[i].EditorComponent = nil then inc(Result); 1505 dec(i); 1506 end; 1507end; 1508 1509function TUnitEditorInfoList.IndexOfEditorComponent(anEditor: TSourceEditorInterface): Integer; 1510begin 1511 Result := Count - 1; 1512 while (Result >= 0) and (EditorInfos[Result].EditorComponent <> anEditor) do 1513 dec(Result); 1514end; 1515 1516function TUnitEditorInfoList.NewEditorInfo: TUnitEditorInfo; 1517begin 1518 Result := TUnitEditorInfo.Create(FUnitInfo); 1519 FList.Add(Result); 1520end; 1521 1522procedure TUnitEditorInfoList.Add(AEditorInfo: TUnitEditorInfo); 1523begin 1524 FList.Add(AEditorInfo); 1525end; 1526 1527procedure TUnitEditorInfoList.Delete(Index: Integer); 1528begin 1529 Flist.Delete(Index); 1530end; 1531 1532procedure TUnitEditorInfoList.Remove(AEditorInfo: TUnitEditorInfo); 1533var 1534 i: LongInt; 1535begin 1536 i := FList.IndexOf(AEditorInfo); 1537 if i >= 0 then 1538 Delete(i); 1539end; 1540 1541{------------------------------------------------------------------------------ 1542 TUnitInfo Constructor 1543 ------------------------------------------------------------------------------} 1544constructor TUnitInfo.Create(ACodeBuffer: TCodeBuffer); 1545begin 1546 inherited Create; 1547 //DebugLn('Trace:Project Unit Info Class Created'); 1548 FEditorInfoList := TUnitEditorInfoList.Create(Self); 1549 FEditorInfoList.NewEditorInfo; 1550 FBookmarks:=TFileBookmarks.Create; 1551 Clear; 1552 Source := ACodeBuffer; 1553 if Source=nil then 1554 FFileName:=''; 1555end; 1556 1557{------------------------------------------------------------------------------ 1558 TUnitInfo Destructor 1559 ------------------------------------------------------------------------------} 1560destructor TUnitInfo.Destroy; 1561begin 1562 Component:=nil; 1563 Source:=nil; 1564 FreeAndNil(FBookmarks); 1565 Project:=nil; 1566 FreeAndNil(FEditorInfoList); 1567 FreeAndNil(FComponentFallbackClasses); 1568 inherited Destroy; 1569end; 1570 1571function TUnitInfo.GetFileOwner: TObject; 1572begin 1573 Result:=Project; 1574end; 1575 1576function TUnitInfo.GetFileOwnerName: string; 1577begin 1578 if Project<>nil then 1579 Result:=ExtractFilename(Project.ProjectInfoFile) 1580 else 1581 Result:=''; 1582end; 1583 1584{------------------------------------------------------------------------------ 1585 TUnitInfo WriteUnitSource 1586 ------------------------------------------------------------------------------} 1587function TUnitInfo.WriteUnitSource: TModalResult; 1588var 1589 ACaption:string; 1590 AText:string; 1591begin 1592 if fSource=nil then 1593 exit(mrOK); 1594 if Assigned(fOnFileBackup) then begin 1595 Result:=fOnFileBackup(Filename); 1596 if Result=mrAbort then exit; 1597 end; 1598 repeat 1599 if not fSource.Save then begin 1600 ACaption:=lisCodeToolsDefsWriteError; 1601 AText:=Format(lisUnableToWriteFile2, [Filename]); 1602 Result:=IDEMessageDialog(ACaption,AText,mtError,mbAbortRetryIgnore); 1603 if Result=mrAbort then exit; 1604 if Result=mrIgnore then Result:=mrOk; 1605 end else begin 1606 Result:=mrOk; 1607 FIgnoreFileDateOnDiskValid:=true; 1608 end; 1609 until Result<>mrRetry; 1610 Result:=mrOk; 1611end; 1612 1613function TUnitInfo.WriteUnitSourceToFile(const AFileName: string): TModalResult; 1614var 1615 ACaption:string; 1616 AText:string; 1617begin 1618 if fSource=nil then 1619 exit(mrOK); 1620 if Assigned(fOnFileBackup) then begin 1621 Result:=fOnFileBackup(AFilename); 1622 if Result=mrAbort then exit; 1623 end; 1624 repeat 1625 if not fSource.SaveToFile(AFileName) then begin 1626 ACaption:=lisCodeToolsDefsWriteError; 1627 AText:=Format(lisUnableToWriteFile2, [AFilename]); 1628 Result:=IDEMessageDialog(ACaption,AText,mtError,mbAbortRetryIgnore); 1629 if Result=mrAbort then exit; 1630 if Result=mrIgnore then Result:=mrOk; 1631 end else 1632 Result:=mrOk; 1633 until Result<>mrRetry; 1634 Result:=mrOk; 1635end; 1636 1637{------------------------------------------------------------------------------ 1638 TUnitInfo ReadUnitSource 1639 ------------------------------------------------------------------------------} 1640function TUnitInfo.ReadUnitSource(ReadUnitName,Revert:boolean): TModalResult; 1641var 1642 ACaption:string; 1643 AText:string; 1644 NewSource: TCodeBuffer; 1645begin 1646 repeat 1647 NewSource:=CodeToolBoss.LoadFile(Filename,true,Revert); 1648 if NewSource=nil then begin 1649 ACaption:=lisCodeToolsDefsReadError; 1650 AText:=Format(lisUnableToReadFile2, [Filename]); 1651 Result:=IDEMessageDialog(ACaption,AText,mtError,mbAbortRetryIgnore); 1652 if Result in [mrAbort,mrIgnore] then 1653 exit; 1654 end else begin 1655 Source:=NewSource; 1656 FIgnoreFileDateOnDiskValid:=true; 1657 Result:=mrOk; 1658 end; 1659 until Result<>mrRetry; 1660 if ReadUnitName then begin 1661 ReadUnitNameFromSource(false); 1662 end; 1663 Result:=mrOk; 1664end; 1665 1666function TUnitInfo.ReadUnitNameFromSource(TryCache: boolean): string; 1667begin 1668 Result:=''; 1669 if TryCache then 1670 Result:=CodeToolBoss.GetCachedSourceName(Source); 1671 if Result='' then 1672 Result:=CodeToolBoss.GetSourceName(fSource,false); 1673 if Result<>'' then begin 1674 // source can be parsed => update UnitName 1675 {$IFDEF VerboseIDESrcUnitName} 1676 if CompareFilenames(ExtractFileNameOnly(Filename),'interpkgconflictfiles')=0 then 1677 debugln(['TUnitInfo.ReadUnitNameFromSource ',Result]); 1678 {$ENDIF} 1679 FUnitName:=Result; 1680 end else begin 1681 // unable to parse the source 1682 if FilenameIsPascalSource(Filename) then begin 1683 // use default: the filename 1684 Result:=ExtractFileNameOnly(Filename); 1685 if CompareText(Result,FUnitName)=0 then begin 1686 // the last stored unitname has the better case 1687 Result:=FUnitName; 1688 end; 1689 end; 1690 end; 1691end; 1692 1693function TUnitInfo.GetUsesUnitName: string; 1694begin 1695 if FilenameHasPascalExt(Filename) then 1696 begin 1697 if FUnitName<>'' then 1698 Result:=FUnitName 1699 else 1700 Result:=ExtractFileNameOnly(Filename); 1701 end 1702 else 1703 Result:=''; 1704end; 1705 1706function TUnitInfo.CreateUnitName: string; 1707begin 1708 Result:=FUnitName; 1709 if (Result='') and FilenameIsPascalSource(Filename) then 1710 Result:=ExtractFilenameOnly(Filename); 1711end; 1712 1713{------------------------------------------------------------------------------ 1714 TUnitInfo Clear 1715 ------------------------------------------------------------------------------} 1716procedure TUnitInfo.Clear; 1717begin 1718 FBookmarks.Clear; 1719 FSetBookmarLock := 0; 1720 FBuildFileIfActive:=false; 1721 fComponent := nil; 1722 fComponentName := ''; 1723 fComponentResourceName := ''; 1724 FComponentState := wsNormal; 1725 FDefaultSyntaxHighlighter := lshText; 1726 FDisableI18NForLFM:=false; 1727 FCustomDefaultHighlighter := False; 1728 FEditorInfoList.ClearEachInfo; 1729 fFilename := ''; 1730 fFileReadOnly := false; 1731 fHasResources := false; 1732 FIgnoreFileDateOnDiskValid := false; 1733 fAutoReferenceSourceDir := true; 1734 inherited SetIsPartOfProject(false); 1735 Modified := false; 1736 SessionModified := false; 1737 FRunFileIfActive:=false; 1738 FUnitName := ''; 1739 fUsageCount:=-1; 1740 fUserReadOnly := false; 1741 if fSource<>nil then fSource.Clear; 1742 Loaded := false; 1743 LoadedDesigner := false; 1744 ClearComponentDependencies; 1745end; 1746 1747procedure TUnitInfo.ClearModifieds; 1748begin 1749 Modified:=false; 1750 SessionModified:=false; 1751end; 1752 1753procedure TUnitInfo.ClearComponentDependencies; 1754begin 1755 while FFirstRequiredComponent<>nil do FFirstRequiredComponent.Free; 1756 while FFirstUsedByComponent<>nil do FFirstUsedByComponent.Free; 1757end; 1758 1759procedure TUnitInfo.WriteDebugReportUnitComponentDependencies(Prefix: string); 1760var 1761 Dependency: TUnitComponentDependency; 1762begin 1763 DebugLn([Prefix+'TUnitInfo.WriteDebugReportUnitComponentDependencies ',Filename,' ',dbgs(Flags)]); 1764 Dependency:=FirstRequiredComponent; 1765 if Dependency<>nil then begin 1766 DebugLn([Prefix+' Requires: >>> ']); 1767 while Dependency<>nil do begin 1768 DebugLn([Prefix+' '+Dependency.RequiresUnit.Filename+' '+dbgs(Dependency.Types)]); 1769 Dependency:=Dependency.NextRequiresDependency; 1770 end; 1771 end; 1772 Dependency:=FirstUsedByComponent; 1773 if Dependency<>nil then begin 1774 DebugLn([Prefix+' UsedBy: <<<']); 1775 while Dependency<>nil do begin 1776 DebugLn([Prefix+' '+Dependency.UsedByUnit.Filename+' '+dbgs(Dependency.Types)]); 1777 Dependency:=Dependency.NextUsedByDependency; 1778 end; 1779 end; 1780end; 1781 1782 1783{------------------------------------------------------------------------------ 1784 TUnitInfo SaveToXMLConfig 1785 ------------------------------------------------------------------------------} 1786procedure TUnitInfo.SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string; 1787 SaveData, SaveSession: boolean; UsePathDelim: TPathDelimSwitch); 1788var 1789 AFilename: String; 1790 i, X, Y: Integer; 1791 s: String; 1792 BM: TFileBookmark; 1793begin 1794 // global data 1795 AFilename:=Filename; 1796 if Assigned(fOnLoadSaveFilename) then 1797 fOnLoadSaveFilename(AFilename, False); 1798 XMLConfig.SetValue(Path+'Filename/Value',SwitchPathDelims(AFilename,UsePathDelim)); 1799 1800 if SaveData then 1801 XMLConfig.SetDeleteValue(Path+'IsPartOfProject/Value',IsPartOfProject,false); 1802 1803 if SaveSession and Assigned(Project.OnSaveUnitSessionInfo) then 1804 Project.OnSaveUnitSessionInfo(Self); 1805 if IsPartOfProject and SaveData then 1806 XMLConfig.SetDeleteValue(Path+'DisableI18NForLFM/Value',FDisableI18NForLFM,false); 1807 1808 // context data (project/session) 1809 if (IsPartOfProject and SaveData) or ((not IsPartOfProject) and SaveSession) 1810 then begin 1811 XMLConfig.SetDeleteValue(Path+'ComponentName/Value',fComponentName,''); 1812 XMLConfig.SetDeleteValue(Path+'HasResources/Value',fHasResources,false); 1813 XMLConfig.SetDeleteValue(Path+'ResourceBaseClass/Value', 1814 PFComponentBaseClassNames[FResourceBaseClass], 1815 PFComponentBaseClassNames[pfcbcNone]); 1816 s:=FUnitName; 1817 if (s<>'') and (ExtractFileNameOnly(Filename)=s) then s:=''; // only save if UnitName differs from filename 1818 XMLConfig.SetDeleteValue(Path+'UnitName/Value',s,''); 1819 // save custom data 1820 SaveStringToStringTree(XMLConfig,CustomData,Path+'CustomData/'); 1821 end; 1822 1823 // session data 1824 if SaveSession then 1825 begin 1826 FEditorInfoList[0].SaveToXMLConfig(XMLConfig, Path, pfSaveFoldState in Project.Flags); 1827 XMLConfig.SetDeleteValue(Path+'ExtraEditorCount/Value', FEditorInfoList.Count-1, 0); 1828 for i := 1 to FEditorInfoList.Count - 1 do 1829 FEditorInfoList[i].SaveToXMLConfig(XMLConfig, Path + 'ExtraEditor'+IntToStr(i)+'/', 1830 pfSaveFoldState in Project.Flags); 1831 1832 XMLConfig.SetDeleteValue(Path+'ComponentState/Value',Ord(FComponentState),0); 1833 1834 XMLConfig.SetDeleteValue(Path+'UsageCount/Value',RoundToInt(fUsageCount),-1); 1835 if OpenEditorInfoCount > 0 then 1836 for i := Bookmarks.Count - 1 downto 0 do 1837 begin 1838 BM := Bookmarks[i]; 1839 if (Project.Bookmarks.BookmarkWithID(BM.ID) = nil) or 1840 (Project.Bookmarks.BookmarkWithID(BM.ID).UnitInfo <> self) 1841 then 1842 Bookmarks.Delete(i) 1843 else 1844 if OpenEditorInfo[0].EditorComponent.GetBookMark(BM.ID, X, Y) then 1845 BM.CursorPos := Point(X, Y); 1846 end; 1847 FBookmarks.SaveToXMLConfig(XMLConfig,Path+'Bookmarks/'); 1848 XMLConfig.SetDeleteValue(Path+'Loaded/Value',fLoaded,false); 1849 XMLConfig.SetDeleteValue(Path+'LoadedDesigner/Value',fLoadedDesigner,false); 1850 XMLConfig.SetDeleteValue(Path+'ReadOnly/Value',fUserReadOnly,false); 1851 XMLConfig.SetDeleteValue(Path+'BuildFileIfActive/Value', 1852 FBuildFileIfActive,false); 1853 XMLConfig.SetDeleteValue(Path+'RunFileIfActive/Value', 1854 FRunFileIfActive,false); 1855 // save custom session data 1856 SaveStringToStringTree(XMLConfig,CustomSessionData,Path+'CustomSessionData/'); 1857 XMLConfig.SetDeleteValue(Path+'DefaultSyntaxHighlighter/Value', 1858 LazSyntaxHighlighterNames[FDefaultSyntaxHighlighter], 1859 LazSyntaxHighlighterNames[lshFreePascal]); 1860 end; 1861end; 1862 1863{------------------------------------------------------------------------------ 1864 TUnitInfo LoadFromXMLConfig 1865 ------------------------------------------------------------------------------} 1866procedure TUnitInfo.LoadFromXMLConfig(XMLConfig: TXMLConfig; 1867 const Path: string; Merge, IgnoreIsPartOfProject: boolean; 1868 FileVersion: integer); 1869var 1870 AFilename: string; 1871 c, i: Integer; 1872begin 1873 // project data 1874 if not Merge then begin 1875 1876 AFilename:=XMLConfig.GetValue(Path+'Filename/Value',''); 1877 if Assigned(fOnLoadSaveFilename) then 1878 fOnLoadSaveFilename(AFilename,true); 1879 fFilename:=AFilename; 1880 1881 fComponentName:=XMLConfig.GetValue(Path+'ComponentName/Value',''); 1882 if fComponentName='' then 1883 fComponentName:=XMLConfig.GetValue(Path+'FormName/Value',''); 1884 FComponentState := TWindowState(XMLConfig.GetValue(Path+'ComponentState/Value',0)); 1885 FDisableI18NForLFM:=XMLConfig.GetValue(Path+'DisableI18NForLFM/Value',false); 1886 HasResources:=XMLConfig.GetValue(Path+'HasResources/Value',false); 1887 FResourceBaseClass:=StrToComponentBaseClass( 1888 XMLConfig.GetValue(Path+'ResourceBaseClass/Value','')); 1889 if not IgnoreIsPartOfProject then 1890 IsPartOfProject:=XMLConfig.GetValue(Path+'IsPartOfProject/Value',false); 1891 AFilename:=XMLConfig.GetValue(Path+'ResourceFilename/Value',''); 1892 if (AFilename<>'') and Assigned(fOnLoadSaveFilename) then 1893 fOnLoadSaveFilename(AFilename,true); 1894 if FilenameIsPascalSource(Filename) then begin 1895 FUnitName:=XMLConfig.GetValue(Path+'UnitName/Value',''); 1896 if FUnitName='' then 1897 FUnitName:=ExtractFileNameOnly(Filename); 1898 {$IFDEF VerboseIDESrcUnitName} 1899 if CompareFilenames(ExtractFileNameOnly(Filename),'interpkgconflictfiles')=0 then 1900 debugln(['TUnitInfo.LoadFromXMLConfig ',FUnitName]); 1901 {$ENDIF} 1902 end else 1903 FUnitName:=''; 1904 1905 // save custom data 1906 LoadStringToStringTree(XMLConfig,CustomData,Path+'CustomData/'); 1907 end; 1908 1909 // session data 1910 FDefaultSyntaxHighlighter := StrToLazSyntaxHighlighter( 1911 XMLConfig.GetValue(Path+'DefaultSyntaxHighlighter/Value', 1912 LazSyntaxHighlighterNames[lshFreePascal])); 1913 FEditorInfoList.Clear; 1914 FEditorInfoList.NewEditorInfo; 1915 FEditorInfoList[0].LoadFromXMLConfig(XMLConfig, Path); 1916 c := XMLConfig.GetValue(Path+'ExtraEditorCount/Value', 0); 1917 for i := 1 to c do 1918 FEditorInfoList.NewEditorInfo.LoadFromXMLConfig(XMLConfig, Path + 'ExtraEditor'+IntToStr(i)+'/'); 1919 UpdatePageIndex; 1920 1921 Loaded:=XMLConfig.GetValue(Path+'Loaded/Value',false); 1922 if Loaded then 1923 LoadedDesigner:=XMLConfig.GetValue(Path+'LoadedDesigner/Value',FileVersion<8) 1924 else 1925 LoadedDesigner:=false; 1926 fUserReadOnly:=XMLConfig.GetValue(Path+'ReadOnly/Value',false); 1927 FBuildFileIfActive:=XMLConfig.GetValue(Path+'BuildFileIfActive/Value',false); 1928 FRunFileIfActive:=XMLConfig.GetValue(Path+'RunFileIfActive/Value',false); 1929 fUsageCount:=XMLConfig.GetValue(Path+'UsageCount/Value',-1); 1930 if fUsageCount<1 then begin 1931 UpdateUsageCount(uuIsLoaded,1); 1932 if IsPartOfProject then 1933 UpdateUsageCount(uuIsPartOfProject,1); 1934 end; 1935 FBookmarks.LoadFromXMLConfig(XMLConfig,Path+'Bookmarks/'); 1936 // load custom session data 1937 LoadStringToStringTree(XMLConfig,CustomSessionData,Path+'CustomSessionData/'); 1938end; 1939 1940procedure TUnitInfo.SetUnitName(const AValue: string); 1941var 1942 Allowed: boolean; 1943 OldUnitName: String; 1944begin 1945 if (FUnitName <> AValue) and (AValue <> '') then 1946 begin 1947 Allowed := true; 1948 OldUnitName := FUnitName; 1949 if OldUnitName = '' then 1950 OldUnitName := ExtractFileNameOnly(Filename); 1951 if Assigned(FOnUnitNameChange) then 1952 FOnUnitNameChange(Self, OldUnitName, AValue, false, Allowed); 1953 // (ignore Allowed) 1954 if (fSource <> nil) then 1955 begin 1956 CodeToolBoss.RenameSource(fSource,AValue); 1957 end; 1958 {$IFDEF VerboseIDESrcUnitName} 1959 if CompareFilenames(ExtractFileNameOnly(Filename),'interpkgconflictfiles')=0 then 1960 debugln(['TUnitInfo.SetSrcUnitName ',AValue]); 1961 {$ENDIF} 1962 FUnitName := AValue; 1963 Modified := true; 1964 if (Project <> nil) then Project.UnitModified(Self); 1965 end; 1966end; 1967 1968procedure TUnitInfo.UpdateList(ListType: TUnitInfoList; Add: boolean); 1969begin 1970 if Project<>nil then begin 1971 if Add then 1972 Project.AddToList(Self,ListType) 1973 else 1974 Project.RemoveFromList(Self,ListType); 1975 end else begin 1976 fNext[ListType]:=nil; 1977 fPrev[ListType]:=nil; 1978 end; 1979end; 1980 1981procedure TUnitInfo.SetInternalFilename(const NewFilename: string); 1982begin 1983 if fFileName=NewFilename then exit; 1984 //DebugLn('TUnitInfo.SetInternalFilename Old=',fFileName,' New=',NewFilename); 1985 1986 // if directory changed then remove the old directory reference 1987 if SourceDirectoryReferenced 1988 and (Project<>nil) 1989 and (fLastDirectoryReferenced<>GetDirectory) then begin 1990 Project.SourceDirectories.RemoveFilename(fLastDirectoryReferenced); 1991 FSourceDirectoryReferenced:=false; 1992 end; 1993 1994 fFileName:=NewFilename; 1995 if IDEEditorOptions<>nil then 1996 UpdateDefaultHighlighter(FilenameToLazSyntaxHighlighter(FFilename)); 1997 UpdateSourceDirectoryReference; 1998end; 1999 2000procedure TUnitInfo.UpdateHasCustomHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter); 2001var 2002 i: Integer; 2003begin 2004 FCustomDefaultHighlighter := FDefaultSyntaxHighlighter <> aDefaultHighlighter; 2005 for i := 0 to FEditorInfoList.Count - 1 do 2006 FEditorInfoList[i].CustomHighlighter := 2007 FEditorInfoList[i].SyntaxHighlighter <> aDefaultHighlighter; 2008end; 2009 2010procedure TUnitInfo.UpdatePageIndex; 2011var 2012 HasPageIndex: Boolean; 2013 i, j: integer; 2014 BM: TFileBookmark; 2015begin 2016 HasPageIndex := False; 2017 i := FEditorInfoList.Count - 1; 2018 while (i >= 0) and not HasPageIndex do begin 2019 if EditorInfo[i].PageIndex >= 0 then 2020 HasPageIndex := True; 2021 dec(i); 2022 end; 2023 UpdateList(uilWithEditorIndex, HasPageIndex); 2024 2025 if Assigned(Project1) and Assigned(Project1.Bookmarks) then 2026 begin 2027 if OpenEditorInfoCount > 0 then begin 2028 inc(FSetBookmarLock); 2029 try 2030 // Adjust bookmarks 2031 for i := Bookmarks.Count-1 downto 0 do 2032 begin 2033 BM := Bookmarks[i]; 2034 j := Project1.Bookmarks.IndexOfID(BM.ID); 2035 if (j < 0) then 2036 OpenEditorInfo[0].EditorComponent.SetBookMark(BM.ID, BM.CursorPos.X, BM.CursorPos.Y); 2037 end; 2038 finally 2039 dec(FSetBookmarLock); 2040 end; 2041 end 2042 else // OpenEditorInfoCount = 0 2043 Project1.Bookmarks.DeleteAllWithUnitInfo(Self); 2044 end; 2045end; 2046 2047procedure TUnitInfo.UpdateDefaultHighlighter(aDefaultHighlighter: TLazSyntaxHighlighter); 2048var 2049 i: Integer; 2050begin 2051 //debugln(['TUnitInfo.UpdateDefaultHighlighter ',Filename,' ',ord(aDefaultHighlighter)]); 2052 if not FCustomDefaultHighlighter then 2053 DefaultSyntaxHighlighter := aDefaultHighlighter 2054 else 2055 for i := 0 to FEditorInfoList.Count - 1 do 2056 if not FEditorInfoList[i].CustomHighlighter then 2057 FEditorInfoList[i].SyntaxHighlighter := aDefaultHighlighter; 2058end; 2059 2060function TUnitInfo.GetFileName: string; 2061begin 2062 if fSource<>nil then 2063 Result:=fSource.Filename 2064 else 2065 Result:=fFileName; 2066end; 2067 2068procedure TUnitInfo.SetFilename(const AValue: string); 2069begin 2070 if fSource<>nil then 2071 RaiseGDBException('TUnitInfo.SetFilename Source<>nil') 2072 else 2073 SetInternalFilename(AValue); 2074end; 2075 2076function TUnitInfo.IsVirtual: boolean; 2077begin 2078 if fSource<>nil then 2079 Result:=fSource.IsVirtual 2080 else 2081 Result:=not FilenameIsAbsolute(fFileName); 2082end; 2083 2084function TUnitInfo.GetDirectory: string; 2085begin 2086 if IsVirtual then begin 2087 if Project<>nil then 2088 Result:=Project.Directory 2089 else 2090 Result:=''; 2091 end else begin 2092 Result:=ExtractFilePath(Filename); 2093 end; 2094end; 2095 2096function TUnitInfo.GetFullFilename: string; 2097begin 2098 Result:=fFilename; 2099 // not saved files have file names without path 2100 // they exist in the Codetools filename space 2101end; 2102 2103function TUnitInfo.GetShortFilename(UseUp: boolean): string; 2104begin 2105 if Project<>nil then 2106 Result:=Project.GetShortFilename(Filename,UseUp) 2107 else 2108 Result:=Filename; 2109end; 2110 2111function TUnitInfo.IsMainUnit: boolean; 2112begin 2113 Result:=(Project<>nil) and (Project.MainUnitInfo=Self); 2114end; 2115 2116procedure TUnitInfo.IncreaseAutoRevertLock; 2117begin 2118 inc(fAutoRevertLockCount); 2119 if fAutoRevertLockCount=1 then begin 2120 // activate lock 2121 if Source<>nil then 2122 Source.LockAutoDiskRevert; 2123 if Project<>nil then 2124 Project.AddToOrRemoveFromAutoRevertLockedList(Self); 2125 end; 2126end; 2127 2128procedure TUnitInfo.DecreaseAutoRevertLock; 2129begin 2130 dec(fAutoRevertLockCount); 2131 if fAutoRevertLockCount=0 then begin 2132 // deactivate lock 2133 if Source<>nil then 2134 Source.LockAutoDiskRevert; 2135 if Project<>nil then 2136 Project.AddToOrRemoveFromAutoRevertLockedList(Self); 2137 end; 2138end; 2139 2140function TUnitInfo.IsAutoRevertLocked: boolean; 2141begin 2142 Result:=fAutoRevertLockCount>0; 2143end; 2144 2145function TUnitInfo.IsReverting: boolean; 2146begin 2147 Result:=FRevertLockCount>0; 2148end; 2149 2150function TUnitInfo.ComponentLFMOnDiskHasChanged: boolean; 2151// Associated LFM resource file on disk has changed since last load/save 2152var 2153 ResFilename: String; 2154begin 2155 if fComponentLFMLoadDate=0 then Exit(false); // 0 means there is no LFM file. 2156 ResFilename:=UnitResourceFileformat.GetUnitResourceFilename(Filename,true); 2157 Result:=fComponentLFMLoadDate<>FileAgeCached(ResFilename); 2158 if Result then 2159 DebugLn(['TUnitInfo.ComponentLFMOnDiskHasChanged ', ResFilename, ' changed on disk.']); 2160end; 2161 2162procedure TUnitInfo.SetTimeStamps; 2163var 2164 ResFilename: String; 2165begin 2166 if FSource<>nil then 2167 fSourceChangeStep:=FSource.ChangeStep // Indicates any change is source 2168 else 2169 fSourceChangeStep:=CTInvalidChangeStamp; 2170 // Associated LFM resource file timestamp 2171 //if Component=nil then exit; <- Component is here always nil for some reason. 2172 if UnitResourceFileformat=nil then exit; // Happens with LazBuild 2173 ResFilename:=UnitResourceFileformat.GetUnitResourceFilename(Filename,true); 2174 if FileExistsCached(ResFilename) then 2175 fComponentLFMLoadDate:=FileAgeCached(ResFilename); 2176end; 2177 2178function TUnitInfo.ChangedOnDisk(CompareOnlyLoadSaveTime: boolean; 2179 IgnoreModifiedFlag: boolean): boolean; 2180begin 2181 Result:=(Source<>nil) and Source.FileOnDiskHasChanged(IgnoreModifiedFlag); 2182 if not Result then 2183 Result:=ComponentLFMOnDiskHasChanged; 2184 if Result 2185 and (not CompareOnlyLoadSaveTime) 2186 and FIgnoreFileDateOnDiskValid 2187 and (FIgnoreFileDateOnDisk=Source.FileDateOnDisk) then 2188 Result:=false; 2189 FileReadOnly:=(not IsVirtual) and FileExistsCached(Filename) 2190 and not FileIsWritableCached(Filename); 2191end; 2192 2193procedure TUnitInfo.IgnoreCurrentFileDateOnDisk; 2194begin 2195 if Source<>nil then begin 2196 FIgnoreFileDateOnDiskValid:=true; 2197 FIgnoreFileDateOnDisk:=Source.FileDateOnDisk; 2198 end 2199end; 2200 2201function TUnitInfo.ShortFilename: string; 2202begin 2203 if Project<>nil then 2204 Result:=Project.RemoveProjectPathFromFilename(Filename) 2205 else 2206 Result:=Filename; 2207end; 2208 2209function TUnitInfo.NeedsSaveToDisk: boolean; 2210begin 2211 Result:=IsVirtual or Modified or ChangedOnDisk(true); 2212 //DebugLn(['TUnitInfo.NeedsSaveToDisk ',filename,' Result=',Result,' Modified=',Modified]); 2213 if Result then Exit; 2214 if Source<>nil then 2215 Result:=Source.FileOnDiskNeedsUpdate 2216 else 2217 Result:=not FileExistsUTF8(Filename); 2218end; 2219 2220procedure TUnitInfo.UpdateUsageCount(Min, IfBelowThis, IncIfBelow: extended); 2221begin 2222 if fUsageCount<IfBelowThis then fUsageCount:=fUsageCount+IncIfBelow; 2223 if fUsageCount<Min then fUsageCount:=Min; 2224end; 2225 2226procedure TUnitInfo.UpdateUsageCount(TheUsage: TUnitUsage; const Factor: TDateTime); 2227begin 2228 case TheUsage of 2229 uuIsPartOfProject: UpdateUsageCount(20,200,2*Factor); 2230 uuIsLoaded: UpdateUsageCount(10,100,1*Factor); 2231 uuIsModified: UpdateUsageCount(10,0,0); 2232 uuNotUsed: fUsageCount:=fUsageCount-(Factor/5); 2233 end; 2234end; 2235 2236procedure TUnitInfo.UpdateSourceDirectoryReference; 2237begin 2238 FSourceDirNeedReference:=IsPartOfProject and (FilenameIsPascalSource(Filename)); 2239 if (not AutoReferenceSourceDir) or (FProject=nil) then exit; 2240 if FSourceDirNeedReference then begin 2241 if not SourceDirectoryReferenced then begin 2242 fLastDirectoryReferenced:=GetDirectory; 2243 //DebugLn('TUnitInfo.UpdateSourceDirectoryReference ADD File="',Filename,'" Project.SourceDirectories.TimeStamp=',dbgs(Project.SourceDirectories.TimeStamp)); 2244 FSourceDirectoryReferenced:=true; 2245 Project.SourceDirectories.AddFilename(fLastDirectoryReferenced); 2246 end; 2247 end else begin 2248 if SourceDirectoryReferenced then begin 2249 //DebugLn('TUnitInfo.UpdateSourceDirectoryReference REMOVE File="',Filename,'" Project.SourceDirectories.TimeStamp=',dbgs(Project.SourceDirectories.TimeStamp)); 2250 FSourceDirectoryReferenced:=false; 2251 Project.SourceDirectories.RemoveFilename(fLastDirectoryReferenced); 2252 end; 2253 end; 2254end; 2255 2256procedure TUnitInfo.SetSourceText(const SourceText: string; Beautify: boolean); 2257var 2258 Src: String; 2259begin 2260 Src:=SourceText; 2261 if Beautify then 2262 Src:=SourceEditorManagerIntf.Beautify(Src); 2263 Source.Source:=Src; 2264end; 2265 2266function TUnitInfo.GetSourceText: string; 2267begin 2268 Result:=Source.Source; 2269end; 2270 2271function TUnitInfo.AddRequiresComponentDependency(RequiredUnit: TUnitInfo; 2272 Types: TUnitCompDependencyTypes): TUnitComponentDependency; 2273begin 2274 if RequiredUnit=nil then RaiseGDBException('inconsistency'); 2275 if RequiredUnit=Self then RaiseGDBException('inconsistency'); 2276 // search a dependency to this RequiredUnit 2277 Result:=FirstRequiredComponent; 2278 while Result<>nil do begin 2279 if Result.RequiresUnit=RequiredUnit then break; 2280 Result:=Result.NextRequiresDependency; 2281 end; 2282 // if none exists, then create one 2283 if Result=nil then begin 2284 Result:=TUnitComponentDependency.Create; 2285 Result.UsedByUnit:=Self; 2286 Result.RequiresUnit:=RequiredUnit; 2287 end; 2288 Result.Types:=Result.Types+Types; 2289end; 2290 2291procedure TUnitInfo.RemoveRequiresComponentDependency(RequiredUnit: TUnitInfo; 2292 Types: TUnitCompDependencyTypes); 2293var 2294 Dependency: TUnitComponentDependency; 2295 NextDependency: TUnitComponentDependency; 2296begin 2297 Dependency:=FirstRequiredComponent; 2298 while Dependency<>nil do begin 2299 NextDependency:=Dependency.NextRequiresDependency; 2300 if (Dependency.RequiresUnit=RequiredUnit) then begin 2301 Dependency.Types:=Dependency.Types-Types; 2302 if Dependency.Types=[] then 2303 Dependency.Free; 2304 end; 2305 Dependency:=NextDependency; 2306 end; 2307end; 2308 2309function TUnitInfo.FindComponentDependency(RequiredUnit: TUnitInfo 2310 ): TUnitComponentDependency; 2311begin 2312 Result:=FirstRequiredComponent; 2313 while Result<>nil do begin 2314 if Result.RequiresUnit=RequiredUnit then exit; 2315 Result:=Result.NextRequiresDependency; 2316 end; 2317end; 2318 2319function TUnitInfo.FindRequiredComponentDependency( 2320 MinTypes: TUnitCompDependencyTypes): TUnitComponentDependency; 2321begin 2322 Result:=FirstRequiredComponent; 2323 while Result<>nil do begin 2324 if Result.Types*MinTypes=MinTypes then exit; 2325 Result:=Result.NextRequiresDependency; 2326 end; 2327end; 2328 2329function TUnitInfo.FindUsedByComponentDependency( 2330 MinTypes: TUnitCompDependencyTypes): TUnitComponentDependency; 2331begin 2332 Result:=FirstUsedByComponent; 2333 while Result<>nil do begin 2334 if Result.Types*MinTypes=MinTypes then exit; 2335 Result:=Result.NextUsedByDependency; 2336 end; 2337end; 2338 2339function TUnitInfo.FindAncestorUnit: TUnitInfo; 2340var 2341 Dependency: TUnitComponentDependency; 2342begin 2343 if Component<>nil then begin 2344 Dependency:=FirstRequiredComponent; 2345 while Dependency<>nil do begin 2346 Result:=Dependency.RequiresUnit; 2347 if (Result.Component<>nil) 2348 and (Component.ClassParent=Result.Component.ClassType) then 2349 exit; 2350 Dependency:=Dependency.NextRequiresDependency; 2351 end; 2352 end; 2353 Result:=nil; 2354end; 2355 2356procedure TUnitInfo.ClearUnitComponentDependencies( 2357 ClearTypes: TUnitCompDependencyTypes); 2358var 2359 Dep: TUnitComponentDependency; 2360 NextDep: TUnitComponentDependency; 2361begin 2362 Dep:=FirstRequiredComponent; 2363 while Dep<>nil do begin 2364 NextDep:=Dep.NextRequiresDependency; 2365 Dep.Types:=Dep.Types-ClearTypes; 2366 if Dep.Types=[] then 2367 Dep.Free; 2368 Dep:=NextDep; 2369 end; 2370end; 2371 2372function TUnitInfo.AddBookmark(X, Y, ID: integer): integer; 2373begin 2374 if FSetBookmarLock = 0 then 2375 Result := Bookmarks.Add(X, Y, ID) 2376 else 2377 Result := -1; 2378 SessionModified := True; 2379 Project1.AddBookmark(X, Y, ID, Self); 2380end; 2381 2382procedure TUnitInfo.DeleteBookmark(ID: integer); 2383var 2384 i: Integer; 2385begin 2386 i := Bookmarks.IndexOfID(ID); 2387 if i >= 0 then begin 2388 Bookmarks.Delete(i); 2389 SessionModified := True; 2390 end; 2391 Project1.DeleteBookmark(ID); 2392end; 2393 2394function TUnitInfo.EditorInfoCount: Integer; 2395begin 2396 Result := FEditorInfoList.Count; 2397end; 2398 2399function TUnitInfo.OpenEditorInfoCount: Integer; 2400begin 2401 Result := FEditorInfoList.OpenCount; 2402end; 2403 2404function TUnitInfo.GetClosedOrNewEditorInfo: TUnitEditorInfo; 2405begin 2406 if FEditorInfoList.ClosedCount > 0 then 2407 Result := FEditorInfoList.ClosedEditorInfos[0] 2408 else 2409 Result := FEditorInfoList.NewEditorInfo; 2410end; 2411 2412procedure TUnitInfo.SetLastUsedEditor(AEditor: TSourceEditorInterface); 2413begin 2414 FEditorInfoList.SetLastUsedEditor(AEditor); 2415end; 2416 2417function TUnitInfo.ReadOnly: boolean; 2418begin 2419 Result:=UserReadOnly or FileReadOnly; 2420end; 2421 2422procedure TUnitInfo.SetSource(ABuffer: TCodeBuffer); 2423begin 2424 if fSource=ABuffer then begin 2425 if fSource<>nil then 2426 SetTimeStamps; 2427 exit; 2428 end; 2429 if (fSource<>nil) and IsAutoRevertLocked then 2430 fSource.UnlockAutoDiskRevert; 2431 fSource:=ABuffer; 2432 FIgnoreFileDateOnDiskValid:=false; 2433 if (fSource<>nil) then begin 2434 SetTimeStamps; 2435 if IsAutoRevertLocked then 2436 fSource.LockAutoDiskRevert; 2437 SetInternalFilename(fSource.FileName); 2438 if (fProject<>nil) and (fProject.MainUnitInfo=Self) then 2439 fProject.MainSourceFilenameChanged; 2440 end; 2441end; 2442 2443procedure TUnitInfo.SetUserReadOnly(const NewValue: boolean); 2444begin 2445 fUserReadOnly:=NewValue; 2446 if fSource<>nil then 2447 fSource.ReadOnly:=ReadOnly; 2448end; 2449 2450function TUnitInfo.GetHasResources:boolean; 2451begin 2452 Result:=fHasResources or (ComponentName<>''); 2453end; 2454 2455function TUnitInfo.GetEditorInfo(Index: Integer): TUnitEditorInfo; 2456begin 2457 Result := FEditorInfoList[Index]; 2458end; 2459 2460function TUnitInfo.GetModified: boolean; 2461begin 2462 Result:=fModified 2463 or ((Source<>nil) and (Source.ChangeStep<>fSourceChangeStep)); 2464end; 2465 2466function TUnitInfo.GetNextAutoRevertLockedUnit: TUnitInfo; 2467begin 2468 Result:=fNext[uilAutoRevertLocked]; 2469end; 2470 2471function TUnitInfo.GetNextLoadedUnit: TUnitInfo; 2472begin 2473 Result:=fNext[uilLoaded]; 2474end; 2475 2476function TUnitInfo.GetNextPartOfProject: TUnitInfo; 2477begin 2478 Result:=fNext[uilPartOfProject]; 2479end; 2480 2481function TUnitInfo.GetNextUnitWithComponent: TUnitInfo; 2482begin 2483 Result:=fNext[uilWithComponent]; 2484end; 2485 2486function TUnitInfo.GetNextUnitWithEditorIndex: TUnitInfo; 2487begin 2488 Result:=fNext[uilWithEditorIndex]; 2489end; 2490 2491function TUnitInfo.GetOpenEditorInfo(Index: Integer): TUnitEditorInfo; 2492begin 2493 Result := FEditorInfoList.OpenEditorInfos[Index]; 2494end; 2495 2496function TUnitInfo.GetPrevAutoRevertLockedUnit: TUnitInfo; 2497begin 2498 Result:=fPrev[uilAutoRevertLocked]; 2499end; 2500 2501function TUnitInfo.GetPrevLoadedUnit: TUnitInfo; 2502begin 2503 Result:=fPrev[uilLoaded]; 2504end; 2505 2506function TUnitInfo.GetPrevPartOfProject: TUnitInfo; 2507begin 2508 Result:=fPrev[uilPartOfProject]; 2509end; 2510 2511function TUnitInfo.GetPrevUnitWithComponent: TUnitInfo; 2512begin 2513 Result:=fPrev[uilWithComponent]; 2514end; 2515 2516function TUnitInfo.GetPrevUnitWithEditorIndex: TUnitInfo; 2517begin 2518 Result:=fPrev[uilWithEditorIndex]; 2519end; 2520 2521function TUnitInfo.GetUnitResourceFileformat: TUnitResourcefileFormatClass; 2522var 2523 ResourceFormats : TUnitResourcefileFormatArr; 2524 i: integer; 2525begin 2526 if not assigned(FUnitResourceFileformat) then 2527 begin 2528 if Source=nil then 2529 Source:=CodeToolBoss.LoadFile(Filename,true,false); 2530 if Source<>nil then 2531 begin 2532 ResourceFormats := GetUnitResourcefileFormats; 2533 for i := 0 to high(ResourceFormats) do 2534 begin 2535 if ResourceFormats[i].FindResourceDirective(Source) then 2536 begin 2537 FUnitResourceFileformat:=ResourceFormats[i]; 2538 Result := FUnitResourceFileformat; 2539 Exit; 2540 end; 2541 end; 2542 end; 2543 FUnitResourceFileformat := LFMUnitResourcefileFormat; 2544 end; 2545 Result := FUnitResourceFileformat; 2546end; 2547 2548procedure TUnitInfo.SetAutoReferenceSourceDir(const AValue: boolean); 2549begin 2550 if FAutoReferenceSourceDir=AValue then exit; 2551 FAutoReferenceSourceDir:=AValue; 2552 UpdateSourceDirectoryReference; 2553end; 2554 2555procedure TUnitInfo.SetBuildFileIfActive(const AValue: boolean); 2556begin 2557 if FBuildFileIfActive=AValue then exit; 2558 FBuildFileIfActive:=AValue; 2559 SessionModified:=true; 2560end; 2561 2562procedure TUnitInfo.SetDefaultSyntaxHighlighter(const AValue: TLazSyntaxHighlighter); 2563var 2564 i: Integer; 2565begin 2566 if FDefaultSyntaxHighlighter = AValue then exit; 2567 FDefaultSyntaxHighlighter := AValue; 2568 for i := 0 to FEditorInfoList.Count - 1 do 2569 if not FEditorInfoList[i].CustomHighlighter then 2570 FEditorInfoList[i].SyntaxHighlighter := AValue; 2571end; 2572 2573procedure TUnitInfo.SetDirectives(const AValue: TStrings); 2574begin 2575 if FDirectives=AValue then exit; 2576 FDirectives:=AValue; 2577end; 2578 2579procedure TUnitInfo.SetDisableI18NForLFM(const AValue: boolean); 2580begin 2581 if FDisableI18NForLFM=AValue then exit; 2582 FDisableI18NForLFM:=AValue; 2583 Modified:=true; 2584end; 2585 2586procedure TUnitInfo.SetFileReadOnly(const AValue: Boolean); 2587begin 2588 if fFileReadOnly=AValue then exit; 2589 fFileReadOnly:=AValue; 2590 if fSource<>nil then 2591 fSource.ReadOnly:=ReadOnly; 2592 SessionModified:=true; 2593end; 2594 2595procedure TUnitInfo.SetComponent(const AValue: TComponent); 2596begin 2597 if fComponent=AValue then exit; 2598 fComponent:=AValue; 2599 UpdateList(uilWithComponent,fComponent<>nil); 2600 if fComponent=nil then 2601 ClearComponentDependencies 2602 else 2603 FResourceBaseClass:=GetComponentBaseClass(fComponent.ClassType); 2604end; 2605 2606procedure TUnitInfo.SetIsPartOfProject(const AValue: boolean); 2607begin 2608 if IsPartOfProject=AValue then exit; 2609 if Project<>nil then Project.BeginUpdate(true); 2610 inherited SetIsPartOfProject(AValue); 2611 Modified:=true; 2612 UpdateList(uilPartOfProject,IsPartOfProject); 2613 if IsPartOfProject then UpdateUsageCount(uuIsPartOfProject,0); 2614 UpdateSourceDirectoryReference; 2615 if Project<>nil then Project.EndUpdate; 2616end; 2617 2618{------------------------------------------------------------------------------- 2619 procedure TUnitInfo.SetLoaded(const AValue: Boolean); 2620 2621 Loaded is a flag, that is set, when a unit has finished loading into the 2622 editor. It is saved to the project session file and a loaded unit will be 2623 reloaded, when the project is opened. 2624-------------------------------------------------------------------------------} 2625procedure TUnitInfo.SetLoaded(const AValue: Boolean); 2626begin 2627 if fLoaded=AValue then exit; 2628 fLoaded:=AValue; 2629 if fLoaded then begin 2630 IncreaseAutoRevertLock; 2631 UpdateUsageCount(uuIsLoaded,0); 2632 end else begin 2633 DecreaseAutoRevertLock; 2634 end; 2635end; 2636 2637{------------------------------------------------------------------------------- 2638 procedure TUnitInfo.SetLoadedDesigner(const AValue: Boolean); 2639 2640 LoadedDesigner is a flag, that is set, when a visible designer form has 2641 finished opening. It is saved to the project session file and a designer 2642 is restored, when the project is opened and the IDE form editor option 2643 auto open designer forms is enabled. 2644-------------------------------------------------------------------------------} 2645procedure TUnitInfo.SetLoadedDesigner(const AValue: Boolean); 2646begin 2647 if fLoadedDesigner=AValue then exit; 2648 fLoadedDesigner:=AValue; 2649end; 2650 2651procedure TUnitInfo.SetModified(const AValue: boolean); 2652begin 2653 if Modified=AValue then exit; 2654 {$IFDEF VerboseIDEModified} 2655 debugln(['TUnitInfo.SetModified ',Filename,' new Modified=',AValue]); 2656 {$ENDIF} 2657 fModified:=AValue; 2658 if (not fModified) and Assigned(Source) then 2659 SetTimeStamps; 2660end; 2661 2662procedure TUnitInfo.SetProject(const AValue: TProject); 2663var 2664 ListType: TUnitInfoList; 2665 i: Integer; 2666begin 2667 if FProject=AValue then exit; 2668 if FProject<>nil then begin 2669 for ListType:=Low(TUnitInfoList) to High(TUnitInfoList) do 2670 Project.RemoveFromList(Self,ListType); 2671 for i := 0 to FEditorInfoList.Count - 1 do 2672 FProject.EditorInfoRemove(FEditorInfoList[i]); 2673 end; 2674 FProject:=AValue; 2675 if FProject<>nil then begin 2676 UpdatePageIndex; 2677 if Component<>nil then 2678 Project.AddToList(Self,uilWithComponent); 2679 if Loaded then 2680 Project.AddToList(Self,uilLoaded); 2681 if IsAutoRevertLocked then 2682 Project.AddToList(Self,uilAutoRevertLocked); 2683 if IsPartOfProject then 2684 Project.AddToList(Self,uilPartOfProject); 2685 for i := 0 to FEditorInfoList.Count - 1 do 2686 FProject.EditorInfoAdd(FEditorInfoList[i]); 2687 end; 2688 UpdateSourceDirectoryReference; 2689end; 2690 2691procedure TUnitInfo.SetRunFileIfActive(const AValue: boolean); 2692begin 2693 if FRunFileIfActive=AValue then exit; 2694 FRunFileIfActive:=AValue; 2695 SessionModified:=true; 2696end; 2697 2698procedure TUnitInfo.SetSessionModified(const AValue: boolean); 2699begin 2700 if FSessionModified=AValue then exit; 2701 {$IFDEF VerboseIDEModified} 2702 debugln(['TUnitInfo.SetSessionModified ',Filename,' new Modified=',AValue]); 2703 {$ENDIF} 2704 FSessionModified:=AValue; 2705end; 2706 2707 2708{ TProjectIDEOptions } 2709 2710constructor TProjectIDEOptions.Create(AProject: TProject); 2711begin 2712 inherited Create; 2713 FProject := AProject; 2714end; 2715 2716destructor TProjectIDEOptions.Destroy; 2717begin 2718 inherited Destroy; 2719end; 2720 2721function TProjectIDEOptions.GetProject: TLazProject; 2722begin 2723 Result := FProject; 2724end; 2725 2726function TProjectIDEOptions.CheckLclApp: Boolean; 2727begin 2728 FLclApp := FProject.IsLclApplication; 2729 Result := FLclApp; 2730end; 2731 2732class function TProjectIDEOptions.GetInstance: TAbstractIDEOptions; 2733begin 2734 if Project1<>nil then 2735 Result := Project1.IDEOptions 2736 else 2737 Result := nil; 2738end; 2739 2740class function TProjectIDEOptions.GetGroupCaption: string; 2741begin 2742 Result := dlgProjectOptions; 2743end; 2744 2745 2746{------------------------------------------------------------------------------ 2747 TProject Class 2748 ------------------------------------------------------------------------------} 2749 2750{------------------------------------------------------------------------------ 2751 TProject Constructor 2752 ------------------------------------------------------------------------------} 2753constructor TProject.Create(ProjectDescription: TProjectDescriptor); 2754begin 2755 inherited Create(ProjectDescription); 2756 2757 FActiveWindowIndexAtStart := 0; 2758 FSkipCheckLCLInterfaces:=false; 2759 FAutoCreateForms := true; 2760 FAllEditorsInfoList := TUnitEditorInfoList.Create(nil); 2761 FAllEditorsInfoMap := TMap.Create(ituPtrSize, SizeOf(TObject)); 2762 FBookmarks := TProjectBookmarkList.Create; 2763 2764 FMacroEngine:=TTransferMacroList.Create; 2765 FMacroEngine.OnSubstitution:=@OnMacroEngineSubstitution; 2766 FBuildModes:=TProjectBuildModes.Create(nil); 2767 FBuildModes.LazProject:=Self; 2768 FBuildModesBackup:=TProjectBuildModes.Create(nil); 2769 FBuildModesBackup.LazProject:=Self; 2770 ActiveBuildMode:=FBuildModes.Add('Default'); 2771 2772 FDefineTemplates:=TProjectDefineTemplates.Create(Self); 2773 FFlags:=DefaultProjectFlags; 2774 FJumpHistory:=TProjectJumpHistory.Create; 2775 FJumpHistory.OnCheckPosition:=@JumpHistoryCheckPosition; 2776 FJumpHistory.OnLoadSaveFilename:=@LoadSaveFilenameHandler; 2777 fMainUnitID := -1; 2778 fProjectInfoFile := ''; 2779 ProjectSessionFile:=''; 2780 FSourceDirectories:=TFileReferenceList.Create; 2781 FSourceDirectories.OnChanged:=@SourceDirectoriesChanged; 2782 UpdateProjectDirectory; 2783 FIDEOptions:=TProjectIDEOptions.Create(Self); 2784 FPublishOptions:=TPublishProjectOptions.Create(Self); 2785 FRunParameters:=TRunParamsOptions.Create; 2786 Title := ''; 2787 FUnitList := TFPList.Create; // list of TUnitInfo 2788 FOtherDefines := TStringList.Create; 2789 FEnableI18N := False; 2790 FEnableI18NForLFM := True; 2791 FI18NExcludedIdentifiers := TStringList.Create; 2792 FI18NExcludedOriginals := TStringList.Create; 2793 2794 FResources := TProjectResources.Create(Self); 2795 ProjResources.OnModified := @EmbeddedObjectModified; 2796 2797 FHistoryLists := THistoryLists.Create; 2798end; 2799 2800{------------------------------------------------------------------------------ 2801 TProject Destructor 2802 ------------------------------------------------------------------------------} 2803destructor TProject.Destroy; 2804begin 2805 FDestroying := True; 2806 FDefineTemplates.Active := False; 2807 ActiveBuildMode:=nil; 2808 Clear; 2809 FreeThenNil(FIDEOptions); 2810 FreeAndNil(FBuildModesBackup); 2811 FreeAndNil(FBuildModes); 2812 FreeAndNil(FMacroEngine); 2813 FreeAndNil(FAllEditorsInfoMap); 2814 FreeAndNil(FAllEditorsInfoList); 2815 FreeThenNil(FResources); 2816 FreeThenNil(FBookmarks); 2817 FreeThenNil(FI18NExcludedOriginals); 2818 FreeThenNil(FI18NExcludedIdentifiers); 2819 FreeThenNil(FOtherDefines); 2820 FreeThenNil(FUnitList); 2821 FreeThenNil(FJumpHistory); 2822 FreeThenNil(FSourceDirectories); 2823 FreeThenNil(FPublishOptions); 2824 FreeThenNil(FRunParameters); 2825 FreeThenNil(FDefineTemplates); 2826 FreeThenNil(FHistoryLists); 2827 2828 inherited Destroy; 2829end; 2830 2831{------------------------------------------------------------------------------ 2832 Methods for ReadProject 2833 ------------------------------------------------------------------------------} 2834 2835function TProject.LoadOldProjectType(const Path: string): TOldProjectType; 2836 2837 function OldProjectTypeNameToType(const s: string): TOldProjectType; 2838 begin 2839 for Result:=Low(TOldProjectType) to High(TOldProjectType) do 2840 if (CompareText(OldProjectTypeNames[Result],s)=0) then exit; 2841 Result:=ptApplication; 2842 end; 2843 2844begin 2845 if FFileVersion<=4 then 2846 Result:=OldProjectTypeNameToType(FXMLConfig.GetValue(Path+'General/ProjectType/Value', '')) 2847 else 2848 Result:=ptCustomProgram; 2849end; 2850 2851procedure TProject.LoadFlags(const Path: string); 2852 2853 procedure SetFlag(f: TProjectFlag; Value: boolean); 2854 begin 2855 if Value then Include(FFlags,f) else Exclude(FFlags,f); 2856 end; 2857 2858var 2859 f: TProjectFlag; 2860 OldProjectType: TOldProjectType; 2861 DefFlags: TProjectFlags; 2862begin 2863 OldProjectType:=LoadOldProjectType(Path); 2864 DefFlags:=DefaultProjectFlags; 2865 if FFileVersion<7 then 2866 Exclude(DefFlags,pfLRSFilesInOutputDirectory); 2867 Flags:=[]; 2868 for f:=Low(TProjectFlag) to High(TProjectFlag) do 2869 SetFlag(f,FXMLConfig.GetValue(Path+'General/Flags/'+ProjectFlagNames[f]+'/Value',f in DefFlags)); 2870 if FFileVersion<=3 then begin 2871 // set new flags 2872 SetFlag(pfMainUnitIsPascalSource, OldProjectType in [ptProgram,ptApplication]); 2873 SetFlag(pfMainUnitHasUsesSectionForAllUnits, OldProjectType in [ptProgram,ptApplication]); 2874 SetFlag(pfMainUnitHasCreateFormStatements, OldProjectType in [ptApplication]); 2875 SetFlag(pfMainUnitHasTitleStatement,OldProjectType in [ptApplication]); 2876 SetFlag(pfMainUnitHasScaledStatement,OldProjectType in [ptApplication]); 2877 SetFlag(pfRunnable, OldProjectType in [ptProgram,ptApplication,ptCustomProgram]); 2878 end; 2879 if FFileVersion<=11 then begin 2880 // set CompatibilityMode flag for legacy projects (this flag was added in FFileVersion=12 that changed 2881 // item format so that LPI cannot be opened in legacy Lazarus unless pfCompatibilityMode is set) 2882 SetFlag(pfCompatibilityMode, True); 2883 end; 2884 Flags:=Flags-[pfUseDefaultCompilerOptions]; 2885end; 2886 2887procedure TProject.LoadOtherDefines(const Path: string); 2888var 2889 Cnt, i: Integer; 2890 SubPath, s: String; 2891begin 2892 SubPath := 'OtherDefines/'; 2893 if not FXMLConfig.HasPath(Path+SubPath, False) then 2894 SubPath := 'CustomDefines/'; // Load from the old path name. 2895 Cnt := FXMLConfig.GetValue(Path+SubPath+'Count', 0); 2896 for i := 0 to Cnt-1 do 2897 begin 2898 s := FXMLConfig.GetValue(Path+SubPath+'Define'+IntToStr(i)+'/Value', ''); 2899 if s <> '' then 2900 FOtherDefines.Add(s); 2901 end; 2902end; 2903 2904procedure TProject.LoadSessionInfo(const Path: string; Merge: boolean); 2905// Note: the session can be stored in the lpi as well 2906// So this method is used for loading the lpi units as well 2907var 2908 NewUnitInfo: TUnitInfo; 2909 NewUnitCount, i: integer; 2910 SubPath: String; 2911 NewUnitFilename: String; 2912 OldUnitInfo: TUnitInfo; 2913 MergeUnitInfo, LegacyList: Boolean; 2914begin 2915 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject D reading units');{$ENDIF} 2916 LegacyList:=(FFileVersion<=11) or FXMLConfig.IsLegacyList(Path+'Units/'); 2917 NewUnitCount:=FXMLConfig.GetListItemCount(Path+'Units/', 'Unit', LegacyList); 2918 for i := 0 to NewUnitCount - 1 do begin 2919 SubPath:=Path+'Units/'+FXMLConfig.GetListItemXPath('Unit', i, LegacyList)+'/'; 2920 NewUnitFilename:=FXMLConfig.GetValue(SubPath+'Filename/Value',''); 2921 LoadSaveFilenameHandler(NewUnitFilename,true); 2922 // load unit and add it 2923 OldUnitInfo:=UnitInfoWithFilename(NewUnitFilename); 2924 if OldUnitInfo<>nil then begin 2925 // unit already exists 2926 if Merge then begin 2927 NewUnitInfo:=OldUnitInfo; 2928 MergeUnitInfo:=true; 2929 end else begin 2930 // Doppelganger -> inconsistency found, ignore this file 2931 debugln('TProject.ReadProject file exists twice in lpi file: ignoring "'+NewUnitFilename+'"'); 2932 continue; 2933 end; 2934 end else begin 2935 NewUnitInfo:=TUnitInfo.Create(nil); 2936 AddFile(NewUnitInfo,false); 2937 MergeUnitInfo:=false; 2938 end; 2939 2940 NewUnitInfo.LoadFromXMLConfig(FXMLConfig,SubPath,MergeUnitInfo,Merge,FFileVersion); 2941 if i=FNewMainUnitID then begin 2942 MainUnitID:=IndexOf(NewUnitInfo); 2943 FNewMainUnitID:=-1; 2944 end; 2945 end; 2946 2947 // load editor info 2948 i := FXMLConfig.GetValue(Path+'General/ActiveEditorIndexAtStart/Value', -1); 2949 if (i >= 0) then 2950 UpdateVisibleEditor(i); // Load old Config => No WindowIndex 2951 2952 ActiveWindowIndexAtStart := FXMLConfig.GetValue(Path+'General/ActiveWindowIndexAtStart/Value', 0); 2953 FSkipCheckLCLInterfaces:=FXMLConfig.GetValue(Path+'SkipCheckLCLInterfaces/Value',false); 2954 FJumpHistory.LoadFromXMLConfig(FXMLConfig,Path+''); 2955 CleanOutputFileMask:=FXMLConfig.GetValue(Path+'Build/CleanOutputFileMask/Value', 2956 DefaultProjectCleanOutputFileMask); 2957 CleanSourcesFileMask:=FXMLConfig.GetValue(Path+'Build/CleanSourcesFileMask/Value', 2958 DefaultProjectCleanSourcesFileMask); 2959 2960 // load custom session data 2961 LoadStringToStringTree(FXMLConfig,CustomSessionData,Path+'CustomSessionData/'); 2962end; 2963 2964procedure TProject.LoadFromLPI; 2965const 2966 Path = ProjOptionsPath; 2967begin 2968 if (FFileVersion=0) and (FXMLConfig.GetListItemCount(Path+'Units/', 'Unit', true)=0) then 2969 if IDEMessageDialog(lisStrangeLpiFile, 2970 Format(lisTheFileDoesNotLookLikeALpiFile, [ProjectInfoFile]), 2971 mtConfirmation,[mbIgnore,mbAbort])<>mrIgnore 2972 then exit; 2973 2974 LoadFlags(Path); 2975 SessionStorage:=StrToProjectSessionStorage( 2976 FXMLConfig.GetValue(Path+'General/SessionStorage/Value', 2977 ProjectSessionStorageNames[DefaultProjectSessionStorage])); 2978 //DebugLn('TProject.ReadProject SessionStorage=',dbgs(ord(SessionStorage)),' ProjectSessionFile=',ProjectSessionFile); 2979 2980 // load properties 2981 // Note: in FFileVersion<9 the default value was -1 2982 // Since almost all projects have a MainUnit the value 0 was always 2983 // added to the lpi. 2984 // Changing the default value to 0 avoids the redundancy and 2985 // automatically fixes broken lpi files. 2986 FNewMainUnitID := FXMLConfig.GetValue(Path+'General/MainUnit/Value', 0); 2987 Title := FXMLConfig.GetValue(Path+'General/Title/Value', ''); 2988 Scaled := FXMLConfig.GetValue(Path+'General/Scaled/Value', False); 2989 AutoCreateForms := FXMLConfig.GetValue(Path+'General/AutoCreateForms/Value', true); 2990 2991 // fpdoc 2992 FPDocPaths:=SwitchPathDelims(FXMLConfig.GetValue(Path+'LazDoc/Paths',''),fPathDelimChanged); 2993 FPDocPackageName:=FXMLConfig.GetValue(Path+'LazDoc/PackageName',''); 2994 2995 // i18n 2996 if FFileVersion<6 then begin 2997 POOutputDirectory := SwitchPathDelims( 2998 FXMLConfig.GetValue(Path+'RST/OutDir', ''),fPathDelimChanged); 2999 EnableI18N := POOutputDirectory <> ''; 3000 end else begin 3001 EnableI18N := FXMLConfig.GetValue(Path+'i18n/EnableI18N/Value', False); 3002 EnableI18NForLFM := FXMLConfig.GetValue(Path+'i18n/EnableI18N/LFM', True); 3003 POOutputDirectory := SwitchPathDelims( 3004 FXMLConfig.GetValue(Path+'i18n/OutDir/Value', ''),fPathDelimChanged); 3005 LoadStringList(FXMLConfig, FI18NExcludedIdentifiers, Path+'i18n/ExcludedIdentifiers/'); 3006 LoadStringList(FXMLConfig, FI18NExcludedOriginals, Path+'i18n/ExcludedOriginals/'); 3007 end; 3008 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject E reading comp sets');{$ENDIF} 3009 3010 // load custom data 3011 LoadStringToStringTree(FXMLConfig,CustomData,Path+'CustomData/'); 3012 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject update ct boss');{$ENDIF} 3013 CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'ProjPath']:=Directory; 3014 CodeToolBoss.DefineTree.ClearCache; 3015 // load the dependencies 3016 LoadPkgDependencyList(FXMLConfig,Path+'RequiredPackages/', 3017 FFirstRequiredDependency,pddRequires,Self,true,false); 3018 // load the Run and Build parameter Options 3019 RunParameterOptions.Clear; 3020 if FFileVersion<11 then 3021 RunParameterOptions.LegacyLoad(FXMLConfig,Path,fPathDelimChanged) 3022 else 3023 RunParameterOptions.Load(FXMLConfig,Path+'RunParams/',fPathDelimChanged,rpsLPI); 3024 // load the Publish Options 3025 PublishOptions.LoadFromXMLConfig(FXMLConfig,Path+'PublishOptions/',fPathDelimChanged); 3026 // load defines used for custom options 3027 LoadOtherDefines(Path); 3028 // load session info 3029 LoadSessionInfo(Path,false); 3030 3031 FDebuggerBackend := FXMLConfig.GetValue(Path+'Debugger/Backend/Value', ''); 3032 3033 // call hooks to read their info (e.g. DebugBoss) 3034 if Assigned(OnLoadProjectInfo) then 3035 OnLoadProjectInfo(Self, FXMLConfig, false); 3036end; 3037 3038procedure TProject.LoadFromSession; 3039const 3040 Path = 'ProjectSession/'; 3041var 3042 pds: TPathDelimSwitch; 3043begin 3044 pds:=CheckPathDelim(FXMLConfig.GetValue(Path+'PathDelim/Value', '/'), 3045 fPathDelimChanged); 3046 SessionStorePathDelim:=pds; 3047 fCurStorePathDelim:=pds; 3048 3049 FFileVersion:=FXMLConfig.GetValue(Path+'Version/Value',0); 3050 3051 // load MacroValues and compiler options 3052 BuildModes.LoadSessionFromXMLConfig(FXMLConfig, Path, FLoadAllOptions); 3053 3054 // load defines used for custom options 3055 LoadOtherDefines(Path); 3056 // load session info 3057 LoadSessionInfo(Path,true); 3058 3059 if FFileVersion>=11 then 3060 RunParameterOptions.Load(FXMLConfig,Path+'RunParams/',fPathDelimChanged,rpsLPS); 3061 HistoryLists.Clear; 3062 if FFileVersion>=12 then 3063 HistoryLists.LoadFromXMLConfig(FXMLConfig,Path+'HistoryLists/'); 3064 3065 // call hooks to read their info (e.g. DebugBoss) 3066 if Assigned(OnLoadProjectInfo) then 3067 OnLoadProjectInfo(Self,FXMLConfig,true); 3068end; 3069 3070function TProject.DoLoadLPI(Filename: String): TModalResult; 3071var 3072 PIFile: String; 3073begin 3074 Result:=mrOk; 3075 if FLoadAllOptions then 3076 begin 3077 // read the whole lpi, clear any old values 3078 Clear; 3079 ProjectInfoFile:=Filename; 3080 PIFile:=ProjectInfoFile; // May be different from Filename, setter changed. 3081 fProjectInfoFileBuffer:=CodeToolBoss.LoadFile(PIFile,true,true); 3082 fProjectInfoFileBufChangeStamp:=CTInvalidChangeStamp; 3083 try 3084 fProjectInfoFileDate:=FileAgeCached(PIFile); 3085 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject A reading lpi');{$ENDIF} 3086 if fProjectInfoFileBuffer=nil then 3087 FXMLConfig := TCodeBufXMLConfig.CreateWithCache(PIFile,false) 3088 else begin 3089 FXMLConfig := TCodeBufXMLConfig.CreateWithCache(PIFile,false,true, 3090 fProjectInfoFileBuffer.Source); 3091 fProjectInfoFileBufChangeStamp:=fProjectInfoFileBuffer.ChangeStep; 3092 end; 3093 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject B done lpi');{$ENDIF} 3094 except 3095 on E: Exception do begin 3096 IDEMessageDialog(lisUnableToReadLpi, 3097 Format(lisUnableToReadTheProjectInfoFile,[LineEnding,PIFile])+LineEnding+E.Message, 3098 mtError, [mbOk]); 3099 Result:=mrCancel; 3100 exit; 3101 end; 3102 end; 3103 fLastReadLPIFilename:=PIFile; 3104 fLastReadLPIFileDate:=Now; 3105 FNewMainUnitID:=-1; 3106 end 3107 else begin 3108 // read only parts of the lpi, keep other values 3109 try 3110 FXMLConfig := TCodeBufXMLConfig.CreateWithCache(Filename,true) 3111 except 3112 on E: Exception do begin 3113 IDEMessageDialog(lisUnableToReadLpi, 3114 Format(lisUnableToReadTheProjectInfoFile,[LineEnding,Filename])+LineEnding+E.Message, 3115 mtError, [mbOk]); 3116 Result:=mrCancel; 3117 exit; 3118 end; 3119 end; 3120 end; 3121 3122 try 3123 // get format 3124 fStorePathDelim:=CheckPathDelim(FXMLConfig.GetValue(ProjOptionsPath+'PathDelim/Value','/'), 3125 fPathDelimChanged); 3126 fCurStorePathDelim:=StorePathDelim; 3127 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject C reading values');{$ENDIF} 3128 FFileVersion:= FXMLConfig.GetValue(ProjOptionsPath+'Version/Value',0); 3129 UseAppBundle := FXMLConfig.GetValue(ProjOptionsPath+'General/UseAppBundle/Value', True); 3130 NSPrincipalClass := FXMLConfig.GetValue(ProjOptionsPath+'General/NSPrincipalClass/Value', ''); 3131 if FLoadAllOptions then 3132 LoadFromLPI; 3133 // Resources 3134 ProjResources.ReadFromProjectFile(FXMLConfig, ProjOptionsPath, FLoadAllOptions); 3135 // load MacroValues and compiler options 3136 ClearBuildModes; 3137 BuildModes.LoadProjOptsFromXMLConfig(FXMLConfig, ProjOptionsPath); 3138 // load matrix options 3139 BuildModes.SharedMatrixOptions.LoadFromXMLConfig(FXMLConfig, 3140 ProjOptionsPath+'BuildModes/SharedMatrixOptions/'); 3141 finally 3142 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject freeing xml');{$ENDIF} 3143 fPathDelimChanged:=false; 3144 try 3145 FXMLConfig.Modified:=false; 3146 FXMLConfig.Free; 3147 except 3148 end; 3149 FXMLConfig:=nil; 3150 end; 3151end; 3152 3153function TProject.DoLoadSession(Filename: String): TModalResult; 3154begin 3155 Result:=mrOK; 3156 if FileExistsUTF8(Filename) then 3157 begin 3158 //DebugLn('TProject.ReadProject loading Session Filename=',Filename); 3159 try 3160 FXMLConfig := TCodeBufXMLConfig.CreateWithCache(Filename); 3161 LoadFromSession; 3162 except 3163 IDEMessageDialog(lisCCOErrorCaption, 3164 Format(lisUnableToReadTheProjectInfoFile, [LineEnding,Filename]), 3165 mtError,[mbOk]); 3166 Result:=mrCancel; 3167 exit; 3168 end; 3169 3170 fPathDelimChanged:=false; 3171 try 3172 FXMLConfig.Modified:=false; 3173 FXMLConfig.Free; 3174 except 3175 end; 3176 fCurStorePathDelim:=StorePathDelim; 3177 FXMLConfig:=nil; 3178 end else 3179 // there is no .lps file -> create some defaults 3180 LoadDefaultSession; 3181end; 3182 3183function TProject.DoLoadLPR(Revert: boolean): TModalResult; 3184// lpr is here the main module, it does not need to have the extension .lpr 3185var 3186 LPRUnitInfo: TUnitInfo; 3187begin 3188 Result:=mrOk; 3189 if (MainUnitID<0) or (not (pfMainUnitIsPascalSource in Flags)) then 3190 exit; // has no lpr 3191 LPRUnitInfo:=MainUnitInfo; 3192 if (LPRUnitInfo.Source=nil) then begin 3193 LPRUnitInfo.Source:=CodeToolBoss.LoadFile(LPRUnitInfo.Filename,true,Revert); 3194 if LPRUnitInfo.Source=nil then exit(mrCancel); 3195 end; 3196 3197 UpdateIsPartOfProjectFromMainUnit; 3198end; 3199 3200// Method ReadProject itself 3201function TProject.ReadProject(const NewProjectInfoFile: string; 3202 GlobalMatrixOptions: TBuildMatrixOptions; LoadAllOptions: Boolean): TModalResult; 3203begin 3204 Result := mrCancel; 3205 BeginUpdate(true); 3206 try 3207 BuildModes.FGlobalMatrixOptions := GlobalMatrixOptions; 3208 FLoadAllOptions := LoadAllOptions; 3209 3210 // load project lpi file 3211 Result:=DoLoadLPI(NewProjectInfoFile); 3212 if Result<>mrOK then Exit; 3213 3214 // load session file (if available) 3215 if (SessionStorage in pssHasSeparateSession) 3216 and (CompareFilenames(ProjectInfoFile,ProjectSessionFile)<>0) 3217 and FLoadAllOptions then 3218 begin 3219 Result:=DoLoadSession(ProjectSessionFile); 3220 if Result<>mrOK then Exit; 3221 end; 3222 3223 // load lpr 3224 if (pfMainUnitIsPascalSource in Flags) and (MainUnitInfo<>nil) then 3225 DoLoadLPR(false); // ignore errors 3226 3227 finally 3228 EndUpdate; 3229 FAllEditorsInfoList.SortByPageIndex; 3230 end; 3231 {$IFDEF IDE_MEM_CHECK}CheckHeapWrtMemCnt('TProject.ReadProject END');{$ENDIF} 3232 Result := mrOk; 3233end; 3234 3235{------------------------------------------------------------------------------ 3236 Methods for TProject WriteProject 3237 ------------------------------------------------------------------------------} 3238 3239procedure TProject.SaveFlags(const Path: string); 3240var 3241 f: TProjectFlag; 3242begin 3243 for f:=Low(TProjectFlag) to High(TProjectFlag) do begin 3244 FXMLConfig.SetDeleteValue(Path+'General/Flags/' 3245 +ProjectFlagNames[f]+'/Value', f in Flags, f in DefaultProjectFlags); 3246 end; 3247end; 3248 3249procedure TProject.SaveUnits(const Path: string; SaveSession: boolean); 3250var 3251 i, SaveUnitCount: integer; 3252begin 3253 SaveUnitCount:=0; 3254 for i:=0 to UnitCount-1 do 3255 if UnitMustBeSaved(Units[i],FProjectWriteFlags,SaveSession) then begin 3256 Units[i].SaveToXMLConfig(FXMLConfig, 3257 Path+'Units/'+FXMLConfig.GetListItemXPath('Unit', SaveUnitCount, UseLegacyLists)+'/',True,SaveSession,fCurStorePathDelim); 3258 inc(SaveUnitCount); 3259 end; 3260 FXMLConfig.SetListItemCount(Path+'Units/',SaveUnitCount,UseLegacyLists); 3261end; 3262 3263procedure TProject.SaveOtherDefines(const Path: string); 3264var 3265 i: integer; 3266begin 3267 for i:=0 to FOtherDefines.Count-1 do 3268 FXMLConfig.SetDeleteValue(Path+'OtherDefines/Define'+IntToStr(i)+'/Value', 3269 FOtherDefines[i],''); 3270 FXMLConfig.SetDeleteValue(Path+'OtherDefines/Count',FOtherDefines.Count,0); 3271end; 3272 3273procedure TProject.SaveSessionInfo(const Path: string); 3274begin 3275 FXMLConfig.DeleteValue(Path+'General/ActiveEditorIndexAtStart/Value'); 3276 FXMLConfig.SetDeleteValue(Path+'General/ActiveWindowIndexAtStart/Value', 3277 ActiveWindowIndexAtStart,0); 3278 FXMLConfig.SetDeleteValue('SkipCheckLCLInterfaces/Value', 3279 FSkipCheckLCLInterfaces,false); 3280 FXMLConfig.SetDeleteValue(Path+'Build/CleanOutputFileMask/Value', 3281 CleanOutputFileMask,DefaultProjectCleanOutputFileMask); 3282 FXMLConfig.SetDeleteValue(Path+'Build/CleanSourcesFileMask/Value', 3283 CleanSourcesFileMask,DefaultProjectCleanSourcesFileMask); 3284 3285 if (not (pfSaveOnlyProjectUnits in Flags)) 3286 and (not (pwfSkipJumpPoints in FProjectWriteFlags)) then begin 3287 if (pfSaveJumpHistory in Flags) then begin 3288 FJumpHistory.DeleteInvalidPositions; 3289 FJumpHistory.SaveToXMLConfig(FXMLConfig,Path,UseLegacyLists); 3290 end 3291 else 3292 FXMLConfig.DeletePath(Path+'JumpHistory'); 3293 end; 3294 3295 // save custom session data 3296 SaveStringToStringTree(FXMLConfig,CustomSessionData,Path+'CustomSessionData/'); 3297end; 3298 3299procedure TProject.SaveToLPI; 3300const 3301 Path = ProjOptionsPath; 3302var 3303 CurFlags: TProjectWriteFlags; 3304begin 3305 FFileVersion:=ProjectInfoFileVersion; 3306 // format 3307 FXMLConfig.SetValue(Path+'Version/Value',ProjectInfoFileVersion); 3308 FXMLConfig.SetDeleteValue(Path+'PathDelim/Value',PathDelimSwitchToDelim[fCurStorePathDelim],'/'); 3309 SaveFlags(Path); 3310 FXMLConfig.SetDeleteValue(Path+'General/SessionStorage/Value', 3311 ProjectSessionStorageNames[SessionStorage], 3312 ProjectSessionStorageNames[DefaultProjectSessionStorage]); 3313 // general properties 3314 FXMLConfig.SetDeleteValue(Path+'General/MainUnit/Value', MainUnitID ,0); 3315 FXMLConfig.SetDeleteValue(Path+'General/AutoCreateForms/Value', 3316 AutoCreateForms,true); 3317 FXMLConfig.SetDeleteValue(Path+'General/Title/Value', Title,''); 3318 FXMLConfig.SetDeleteValue(Path+'General/Scaled/Value', Scaled,False); 3319 FXMLConfig.SetDeleteValue(Path+'General/UseAppBundle/Value', UseAppBundle, True); 3320 FXMLConfig.SetDeleteValue(Path+'General/NSPrincipalClass/Value', NSPrincipalClass, ''); 3321 3322 // fpdoc 3323 FXMLConfig.SetDeleteValue(Path+'LazDoc/Paths', 3324 SwitchPathDelims(CreateRelativeSearchPath(FPDocPaths,Directory), 3325 fCurStorePathDelim), ''); 3326 FXMLConfig.SetDeleteValue(Path+'LazDoc/PackageName',FPDocPackageName,''); 3327 3328 // i18n 3329 FXMLConfig.SetDeleteValue(Path+'i18n/EnableI18N/Value', EnableI18N, false); 3330 FXMLConfig.SetDeleteValue(Path+'i18n/EnableI18N/LFM', EnableI18NForLFM, true); 3331 FXMLConfig.SetDeleteValue(Path+'i18n/OutDir/Value', 3332 SwitchPathDelims(CreateRelativePath(POOutputDirectory,Directory), 3333 fCurStorePathDelim), ''); 3334 SaveStringList(FXMLConfig, FI18NExcludedIdentifiers, Path+'i18n/ExcludedIdentifiers/'); 3335 SaveStringList(FXMLConfig, FI18NExcludedOriginals, Path+'i18n/ExcludedOriginals/'); 3336 3337 // Resources 3338 ProjResources.WriteToProjectFile(FXMLConfig, Path); 3339 // save custom data 3340 SaveStringToStringTree(FXMLConfig,CustomData,Path+'CustomData/'); 3341 // Save the macro values and compiler options 3342 BuildModes.SaveProjOptsToXMLConfig(FXMLConfig, Path, FSaveSessionInLPI, UseLegacyLists); 3343 BuildModes.SaveSharedMatrixOptions(Path); 3344 if FSaveSessionInLPI then 3345 BuildModes.SaveSessionData(Path); 3346 // save the Publish Options 3347 PublishOptions.SaveToXMLConfig(FXMLConfig,Path+'PublishOptions/',fCurStorePathDelim); 3348 // save the Run and Build parameter options 3349 if pfCompatibilityMode in Flags then 3350 RunParameterOptions.LegacySave(FXMLConfig,Path,fCurStorePathDelim); 3351 RunParameterOptions.Save(FXMLConfig,Path+'RunParams/',fCurStorePathDelim,rpsLPI, UseLegacyLists); 3352 // save dependencies 3353 SavePkgDependencyList(FXMLConfig,Path+'RequiredPackages/', 3354 FFirstRequiredDependency,pddRequires,fCurStorePathDelim,pfCompatibilityMode in FFlags); 3355 // save units 3356 SaveUnits(Path,FSaveSessionInLPI); 3357 3358 FXMLConfig.SetDeleteValue(Path+'Debugger/Backend/Value', DebuggerBackend, ''); 3359 3360 if FSaveSessionInLPI then begin 3361 // save defines used for custom options 3362 SaveOtherDefines(Path); 3363 // save session info 3364 SaveSessionInfo(Path); 3365 end; 3366 3367 // Notifiy hooks 3368 if Assigned(OnSaveProjectInfo) then begin 3369 CurFlags:=FProjectWriteFlags; 3370 if not FSaveSessionInLPI then 3371 CurFlags:=CurFlags+[pwfSkipSeparateSessionInfo]; 3372 if UseLegacyLists then 3373 CurFlags:=CurFlags+[pwfCompatibilityMode]; 3374 OnSaveProjectInfo(Self,FXMLConfig,CurFlags); 3375 end; 3376 3377 if FXMLConfig.Modified or (not FileExistsCached(FXMLConfig.Filename)) then 3378 begin 3379 // backup 3380 if Assigned(fOnFileBackup) then begin 3381 if fOnFileBackup(FXMLConfig.Filename)=mrAbort then begin 3382 debugln(['Error: (lazarus) [TProject.SaveToLPI] backup of "'+FXMLConfig.Filename+'" failed.']); 3383 exit; 3384 end; 3385 end; 3386 3387 // save lpi to disk 3388 //debugln(['TProject.WriteProject ',DbgSName(FXMLConfig),' FCfgFilename=',FCfgFilename]); 3389 FXMLConfig.Flush; 3390 end; 3391 3392 if not (pwfIgnoreModified in FProjectWriteFlags) then 3393 Modified:=false; 3394 if FSaveSessionInLPI then 3395 SessionModified:=false; 3396end; 3397 3398procedure TProject.SaveToSession; 3399const 3400 Path = 'ProjectSession/'; 3401begin 3402 FFileVersion:=ProjectInfoFileVersion; 3403 fCurStorePathDelim:=SessionStorePathDelim; 3404 FXMLConfig.SetDeleteValue(Path+'PathDelim/Value', 3405 PathDelimSwitchToDelim[fCurStorePathDelim],'/'); 3406 FXMLConfig.SetValue(Path+'Version/Value',ProjectInfoFileVersion); 3407 3408 // Save the session build modes 3409 BuildModes.SaveSessionOptsToXMLConfig(FXMLConfig, Path, True, UseLegacyLists); 3410 BuildModes.SaveSessionData(Path); 3411 // save all units 3412 SaveUnits(Path,true); 3413 // save defines used for custom options 3414 SaveOtherDefines(Path); 3415 // save session info 3416 SaveSessionInfo(Path); 3417 // save the Run and Build parameter options 3418 RunParameterOptions.Save(FXMLConfig,Path+'RunParams/',fCurStorePathDelim,rpsLPS, UseLegacyLists); 3419 // save history lists 3420 HistoryLists.SaveToXMLConfig(FXMLConfig,Path+'HistoryLists/', UseLegacyLists); 3421 3422 // Notifiy hooks 3423 if Assigned(OnSaveProjectInfo) then 3424 OnSaveProjectInfo(Self,FXMLConfig,FProjectWriteFlags+[pwfSkipProjectInfo]); 3425end; 3426 3427function TProject.DoWrite(Filename: String; IsLpi: Boolean): TModalResult; 3428var 3429 Msg: String; 3430begin 3431 repeat 3432 Result := mrOK; 3433 try 3434 FXMLConfig := TCodeBufXMLConfig.CreateWithCache(Filename,false); 3435 except 3436 on E: Exception do begin 3437 DebugLn('ERROR: ',E.Message); 3438 if IsLpi then 3439 Msg:=lisUnableToWriteTheProjectInfoFileError 3440 else 3441 Msg:=lisUnableToWriteTheProjectSessionFileError; 3442 IDEMessageDialog(lisCodeToolsDefsWriteError, 3443 Format(Msg, [LineEnding, Filename, LineEnding, E.Message]) 3444 ,mtError,[mbOk]); 3445 Result:=mrCancel; 3446 exit; 3447 end; 3448 end; 3449 try 3450 // Now actually write the data either to LPI file or to session file. 3451 if IsLpi then 3452 SaveToLPI 3453 else 3454 SaveToSession; 3455 except 3456 on E: Exception do begin 3457 Result:=IDEMessageDialog(lisCodeToolsDefsWriteError, 3458 Format(lisUnableToWriteToFile2, [Filename]), mtError,[mbRetry,mbAbort]); 3459 end; 3460 end; 3461 if IsLpi and (CompareFilenames(ProjectInfoFile,FXMLConfig.Filename)=0) then 3462 UpdateFileBuffer; 3463 try 3464 FXMLConfig.Free; 3465 except 3466 end; 3467 FXMLConfig:=nil; 3468 until Result<>mrRetry; 3469end; 3470 3471function TProject.GetDirectory: string; 3472begin 3473 Result:=fProjectDirectory; 3474end; 3475 3476// Method WriteProject itself 3477function TProject.WriteProject(ProjectWriteFlags: TProjectWriteFlags; 3478 const OverrideProjectInfoFile: string; 3479 GlobalMatrixOptions: TBuildMatrixOptions): TModalResult; 3480var 3481 CfgFilename: String; 3482 SessFilename: String; // only set if session should be saved to a separate file 3483 SessionResult: TModalResult; 3484 WriteLPI, WriteLPS: Boolean; 3485begin 3486 Result := mrCancel; 3487 fCurStorePathDelim:=StorePathDelim; 3488 3489 if OverrideProjectInfoFile<>'' then 3490 CfgFilename := OverrideProjectInfoFile 3491 else 3492 CfgFilename := ProjectInfoFile; 3493 CfgFilename:=SetDirSeparators(CfgFilename); 3494 3495 SessFilename := ''; 3496 if (not (pwfSkipSeparateSessionInfo in ProjectWriteFlags)) 3497 and (SessionStorage in pssHasSeparateSession) then begin 3498 // save session in separate file .lps 3499 if OverrideProjectInfoFile<>'' then 3500 SessFilename := ChangeFileExt(OverrideProjectInfoFile,'.lps') 3501 else 3502 SessFilename := ProjectSessionFile; 3503 if (CompareFilenames(SessFilename,CfgFilename)=0) then 3504 SessFilename:=''; 3505 end; 3506 //DebugLn('TProject.WriteProject Write Session File="',SessFilename,'"'); 3507 DoDirSeparators(SessFilename); 3508 3509 FProjectWriteFlags := ProjectWriteFlags; 3510 BuildModes.FGlobalMatrixOptions := GlobalMatrixOptions; 3511 // first save the .lpi file 3512 if (pwfSkipSeparateSessionInfo in ProjectWriteFlags) or (SessionStorage=pssNone) then 3513 FSaveSessionInLPI:=false 3514 else 3515 FSaveSessionInLPI:=(SessFilename='') or (CompareFilenames(SessFilename,CfgFilename)=0); 3516 3517 // check if modified 3518 if pwfIgnoreModified in ProjectWriteFlags then 3519 begin 3520 WriteLPI:=true; 3521 WriteLPS:=true; 3522 end 3523 else begin 3524 WriteLPI:=SomeDataModified or (not FileExistsUTF8(CfgFilename)); 3525 if (CompareFilenames(ProjectInfoFile,CfgFilename)=0) then 3526 // save to default lpi 3527 WriteLPI:=WriteLPI or (fProjectInfoFileDate<>FileAgeCached(CfgFilename)) 3528 else 3529 // save to another file 3530 WriteLPI:=true; 3531 if SessFilename='' then begin 3532 WriteLPS:=false; 3533 WriteLPI:=WriteLPI or SomeSessionModified; 3534 end else begin 3535 WriteLPS:=WriteLPI or SomeSessionModified or (not FileExistsUTF8(SessFilename)); 3536 end; 3537 //debugln(['TProject.WriteProject WriteLPI=',WriteLPI,' WriteLPS=',WriteLPS]); 3538 if not (WriteLPI or WriteLPS) then exit(mrOk); 3539 end; 3540 //debugln(['TProject.WriteProject WriteLPI=',WriteLPI,' WriteLPS=',WriteLPS,' Modified=',Modified,' SessionModified=',SessionModified]); 3541 3542 // increase usage counters 3543 UpdateUsageCounts(CfgFilename); 3544 if WriteLPI then 3545 // Write to LPI 3546 Result:=DoWrite(CfgFilename, True); 3547 3548 if (SessFilename<>'') and WriteLPS then begin 3549 // save session in separate file .lps 3550 if Assigned(fOnFileBackup) then begin 3551 Result:=fOnFileBackup(SessFilename); 3552 if Result=mrAbort then exit; 3553 end; 3554 SessionResult:=DoWrite(SessFilename, False); 3555 if (Result=mrOk) and (SessionResult<>mrOk) then 3556 Result:=SessionResult; 3557 end; 3558end; 3559 3560procedure TProject.UpdateExecutableType; 3561 3562 function GetMainSourceType: string; 3563 var 3564 AnUnitInfo: TUnitInfo; 3565 begin 3566 Result:=''; 3567 if MainUnitID<0 then exit; 3568 AnUnitInfo:=Units[MainUnitID]; 3569 if AnUnitInfo.Source=nil then exit; 3570 Result:=CodeToolBoss.GetSourceType(AnUnitInfo.Source,false); 3571 end; 3572 3573var 3574 SourceType: String; 3575begin 3576 SourceType:=GetMainSourceType; 3577 if SysUtils.CompareText(SourceType,'Program')=0 then 3578 ExecutableType:=petProgram 3579 else if SysUtils.CompareText(SourceType,'Library')=0 then 3580 ExecutableType:=petLibrary 3581 else if SysUtils.CompareText(SourceType,'Unit')=0 then 3582 ExecutableType:=petUnit 3583 else if SysUtils.CompareText(SourceType,'Package')=0 then 3584 ExecutableType:=petPackage 3585 else 3586 ExecutableType:=petNone; 3587end; 3588 3589procedure TProject.BackupSession; 3590begin 3591 FSessionModifiedBackup:=SessionModified; 3592end; 3593 3594procedure TProject.RestoreSession; 3595begin 3596 SessionModified:=FSessionModifiedBackup; 3597end; 3598 3599procedure TProject.BackupBuildModes; 3600begin 3601 FActiveBuildModeBackup:=BuildModes.IndexOf(ActiveBuildMode); 3602 {$IFDEF VerboseIDEModified} 3603 debugln(['TProject.BackupBuildModes START=====================']); 3604 {$ENDIF} 3605 FBuildModesBackup.Assign(BuildModes,true); 3606 {$IFDEF VerboseIDEModified} 3607 debugln(['TProject.BackupBuildModes END===================== Modified=',Modified]); 3608 {$ENDIF} 3609end; 3610 3611procedure TProject.RestoreBuildModes; 3612begin 3613 Assert(FBuildModesBackup.Count>0, 'TProject.RestoreBuildModes: FBuildModesBackup.Count=0'); 3614 ActiveBuildMode:=nil; 3615 BuildModes.Assign(FBuildModesBackup,true); 3616 if (FActiveBuildModeBackup>=0) and (FActiveBuildModeBackup<BuildModes.Count) 3617 then 3618 ActiveBuildMode:=BuildModes[FActiveBuildModeBackup] 3619 else 3620 ActiveBuildMode:=BuildModes[0]; 3621end; 3622 3623function TProject.GetTitle: string; 3624begin 3625 Result:=Title; 3626 if not MacroEngine.SubstituteStr(Result) then 3627 debugln(['TProject.GetTitle failed Title="',Title,'"']); 3628end; 3629 3630function TProject.TitleIsDefault(Fuzzy: boolean): boolean; 3631var 3632 t: String; 3633 p: Integer; 3634begin 3635 Result:=true; 3636 t:=Title; 3637 if (t='') or (t=GetDefaultTitle) then exit; 3638 if Fuzzy and (SysUtils.CompareText(t,GetDefaultTitle)=0) then exit; 3639 // check for project+number 3640 p:=length(t); 3641 while (p>0) and (t[p] in ['0'..'9']) do dec(p); 3642 if SysUtils.CompareText(copy(t,1,p),'project')=0 then exit; 3643 Result:=false; 3644end; 3645 3646function TProject.GetIDAsString: string; 3647begin 3648 Result:='Project'; // TODO: see TLazPackage, when this is changed change also TProjectDefineTemplates.UpdateSrcDirIfDef 3649end; 3650 3651function TProject.GetIDAsWord: string; 3652begin 3653 Result:='Project'; // TODO: see TLazPackage when this is changed change also TProjectDefineTemplates.UpdateSrcDirIfDef 3654end; 3655 3656{------------------------------------------------------------------------------ 3657 TProject AddFile 3658 ------------------------------------------------------------------------------} 3659procedure TProject.AddFile(ProjectFile: TLazProjectFile; AddToProjectUsesClause: boolean); 3660var 3661 NewIndex: integer; 3662 AnUnit: TUnitInfo; 3663 s: String; 3664begin 3665 AnUnit:=ProjectFile as TUnitInfo; 3666 //debugln('TProject.AddFile A ',AnUnit.Filename,' AddToProjectFile=',dbgs(AddToProjectFile)); 3667 if (UnitInfoWithFilename(AnUnit.Filename)<>nil) and (AnUnit.FileName <> '') then 3668 debugln(['TProject.AddFile WARNING: file already in unit list: ',AnUnit.Filename]); 3669 BeginUpdate(true); 3670 NewIndex:=UnitCount; 3671 FUnitList.Add(AnUnit); 3672 AnUnit.Project:=Self; 3673 AnUnit.OnFileBackup:=@FileBackupHandler; 3674 AnUnit.OnLoadSaveFilename:=@LoadSaveFilenameHandler; 3675 AnUnit.OnUnitNameChange:=@UnitNameChangeHandler; 3676 3677 // lock the main unit (when it is changed on disk it must *not* auto revert) 3678 if MainUnitID=NewIndex then 3679 MainUnitInfo.IncreaseAutoRevertLock; 3680 3681 if AddToProjectUsesClause and (MainUnitID>=0) and (MainUnitID<>NewIndex) then 3682 begin 3683 s:=AnUnit.GetUsesUnitName; 3684 if s<>'' then // add unit to uses section 3685 CodeToolBoss.AddUnitToMainUsesSectionIfNeeded(MainUnitInfo.Source,s,'',[aufLast]); 3686 end; 3687 EndUpdate; 3688 UnitModified(AnUnit); 3689end; 3690 3691{------------------------------------------------------------------------------ 3692 TProject RemoveUnit 3693 ------------------------------------------------------------------------------} 3694procedure TProject.RemoveUnit(Index: integer; RemoveFromUsesSection: boolean); 3695var 3696 OldUnitInfo: TUnitInfo; 3697begin 3698 if (Index<0) or (Index>=UnitCount) then begin 3699 raise Exception.Create('ERROR: TProject.RemoveUnit index out of bounds'); 3700 end; 3701 if (Index=MainUnitID) then begin 3702 raise Exception.Create('ERROR: TProject.RemoveUnit index = MainUnit'); 3703 end; 3704 3705 BeginUpdate(true); 3706 OldUnitInfo:=Units[Index]; 3707 UnitModified(OldUnitInfo); 3708 3709 if (MainUnitID>=0) then begin 3710 // remove unit from uses section and from createforms in program file 3711 if (OldUnitInfo.IsPartOfProject) then begin 3712 if RemoveFromUsesSection then begin 3713 if (OldUnitInfo.Unit_Name<>'') then begin 3714 CodeToolBoss.RemoveUnitFromAllUsesSections(MainUnitInfo.Source, 3715 OldUnitInfo.Unit_Name); 3716 end; 3717 if (OldUnitInfo.ComponentName<>'') then begin 3718 CodeToolBoss.RemoveCreateFormStatement(MainUnitInfo.Source, 3719 OldUnitInfo.ComponentName); 3720 end; 3721 end; 3722 end; 3723 end; 3724 3725 // delete bookmarks of this unit 3726 Bookmarks.DeleteAllWithUnitInfo(OldUnitInfo); 3727 3728 // adjust MainUnit 3729 if MainUnitID>=Index then dec(fMainUnitID); 3730 3731 // delete unitinfo instance 3732 OldUnitInfo.Free; 3733 FUnitList.Delete(Index); 3734 EndUpdate; 3735end; 3736 3737function TProject.CreateProjectFile(const Filename: string): TLazProjectFile; 3738var 3739 NewBuf: TCodeBuffer; 3740 AnUnitInfo: TUnitInfo; 3741begin 3742 NewBuf:=CodeToolBoss.CreateFile(Filename); 3743 AnUnitInfo:=TUnitInfo.Create(NewBuf); 3744 if IDEEditorOptions<>nil then 3745 AnUnitInfo.DefaultSyntaxHighlighter := FilenameToLazSyntaxHighlighter(NewBuf.Filename); 3746 Result:=AnUnitInfo; 3747end; 3748 3749function TProject.GetAndUpdateVisibleUnit(AnEditor: TSourceEditorInterface; 3750 AWindowID: Integer): TUnitInfo; 3751var 3752 i: Integer; 3753 AnEditorInfo: TUnitEditorInfo; 3754begin 3755 for i := 0 to AllEditorsInfoCount - 1 do 3756 with AllEditorsInfo[i] do 3757 IsVisibleTab := (WindowID = AWindowID) and (EditorComponent = AnEditor); 3758 AnEditorInfo := EditorInfoWithEditorComponent(AnEditor); 3759 if AnEditorInfo = nil then Exit(nil); 3760 Result := AnEditorInfo.UnitInfo; 3761 if Assigned(Result) then 3762 Result.SetLastUsedEditor(AnEditor); 3763end; 3764 3765procedure TProject.UpdateAllVisibleUnits; 3766var 3767 i, j: Integer; 3768 aWndId: LongInt; 3769 Info: TUnitEditorInfo; 3770begin 3771 for i := 0 to AllEditorsInfoCount - 1 do begin 3772 Info:=AllEditorsInfo[i]; 3773 aWndId:=Info.WindowID; 3774 j := SourceEditorManagerIntf.IndexOfSourceWindowWithID(aWndId); 3775 Info.IsVisibleTab := (aWndId>=0) and (j >= 0) 3776 and (Info.EditorComponent = SourceEditorManagerIntf.SourceWindows[j].ActiveEditor); 3777 end; 3778end; 3779 3780function TProject.RemoveNonExistingFiles(RemoveFromUsesSection: boolean): boolean; 3781var 3782 i: Integer; 3783 AnUnitInfo: TUnitInfo; 3784begin 3785 Result:=false; 3786 i:=UnitCount-1; 3787 while (i>=0) do begin 3788 if i<UnitCount then begin 3789 AnUnitInfo:=Units[i]; 3790 if (not AnUnitInfo.IsVirtual) and (i<>MainUnitID) then begin 3791 if not FileExistsUTF8(AnUnitInfo.Filename) then begin 3792 RemoveUnit(i,RemoveFromUsesSection); 3793 Result:=true; 3794 end; 3795 end; 3796 end; 3797 dec(i); 3798 end; 3799end; 3800 3801{------------------------------------------------------------------------------ 3802 TProject Clear 3803 ------------------------------------------------------------------------------} 3804procedure TProject.Clear; 3805var i:integer; 3806begin 3807 BeginUpdate(true); 3808 inherited Clear; 3809 3810 // break and free removed dependencies 3811 while FFirstRemovedDependency<>nil do 3812 DeleteRemovedDependency(FFirstRemovedDependency); 3813 // break and free required dependencies 3814 while FFirstRequiredDependency<>nil do 3815 DeleteRequiredDependency(FFirstRequiredDependency); 3816 3817 // delete files 3818 for i:=0 to UnitCount-1 do Units[i].Free; 3819 FUnitList.Clear; 3820 3821 RunParameters.Clear; 3822 3823 FActiveWindowIndexAtStart := -1; 3824 FSkipCheckLCLInterfaces:=false; 3825 FAutoOpenDesignerFormsDisabled := false; 3826 FEnableI18N:=false; 3827 FEnableI18NForLFM:=true; 3828 FI18NExcludedOriginals.Clear; 3829 FI18NExcludedIdentifiers.Clear; 3830 FBookmarks.Clear; 3831 ClearBuildModes; 3832 FDefineTemplates.Clear; 3833 FJumpHistory.Clear; 3834 fMainUnitID := -1; 3835 fProjectInfoFile := ''; 3836 ProjectSessionFile:=''; 3837 FStateFileDate:=0; 3838 FStateFlags:=[]; 3839 ClearSourceDirectories; 3840 UpdateProjectDirectory; 3841 FPublishOptions.Clear; 3842 Title := ''; 3843 3844 Modified := false; 3845 SessionModified := false; 3846 EndUpdate; 3847end; 3848 3849procedure TProject.BeginUpdate(Change: boolean); 3850begin 3851 inc(FUpdateLock); 3852 FDefineTemplates.BeginUpdate; 3853 FSourceDirectories.BeginUpdate; 3854 if FUpdateLock=1 then begin 3855 fChanged:=Change; 3856 if Assigned(OnBeginUpdate) then OnBeginUpdate(Self); 3857 end else 3858 fChanged:=fChanged or Change; 3859end; 3860 3861procedure TProject.EndUpdate; 3862begin 3863 if FUpdateLock<=0 then RaiseGDBException('TProject.EndUpdate'); 3864 dec(FUpdateLock); 3865 FSourceDirectories.EndUpdate; 3866 FDefineTemplates.EndUpdate; 3867 if FUpdateLock=0 then begin 3868 if Assigned(OnEndUpdate) then OnEndUpdate(Self,fChanged); 3869 end; 3870end; 3871 3872procedure TProject.UnitModified(AnUnitInfo: TUnitInfo); 3873begin 3874 if AnUnitInfo.IsPartOfProject then begin 3875 {$IFDEF VerboseIDEModified} 3876 debugln(['TProject.UnitModified ',AnUnitInfo.Filename]); 3877 {$ENDIF} 3878 Modified:=true; 3879 end else 3880 SessionModified:=true; 3881end; 3882 3883function TProject.NeedsDefineTemplates: boolean; 3884begin 3885 Result:=not Destroying; 3886end; 3887 3888procedure TProject.BeginRevertUnit(AnUnitInfo: TUnitInfo); 3889begin 3890 if AnUnitInfo<>nil then 3891 inc(AnUnitInfo.FRevertLockCount); 3892 inc(FRevertLockCount); 3893 if FRevertLockCount=1 then begin 3894 Include(FStateFlags,lpsfPropertyDependenciesChanged); 3895 ClearUnitComponentDependencies([ucdtOldProperty,ucdtProperty]); 3896 LockUnitComponentDependencies; 3897 UpdateUnitComponentDependencies; 3898 end; 3899end; 3900 3901procedure TProject.EndRevertUnit(AnUnitInfo: TUnitInfo); 3902begin 3903 if FRevertLockCount<=0 then 3904 raise Exception.Create('TProject.EndRevertUnit Project'); 3905 if (AnUnitInfo<>nil) and (AnUnitInfo.FRevertLockCount<=0) then 3906 raise Exception.Create('TProject.EndRevertUnit Filename='+AnUnitInfo.Filename); 3907 if AnUnitInfo<>nil then 3908 dec(AnUnitInfo.FRevertLockCount); 3909 dec(FRevertLockCount); 3910 if FRevertLockCount=0 then 3911 UnlockUnitComponentDependencies; 3912end; 3913 3914function TProject.IsReverting(AnUnitInfo: TUnitInfo): boolean; 3915begin 3916 if AnUnitInfo=nil then 3917 Result:=FRevertLockCount>0 3918 else 3919 Result:=AnUnitInfo.FRevertLockCount>0; 3920end; 3921 3922function TProject.GetUnits(Index:integer):TUnitInfo; 3923begin 3924 Result:=TUnitInfo(FUnitList[Index]); 3925end; 3926 3927procedure TProject.SetFlags(const AValue: TProjectFlags); 3928begin 3929 inherited SetFlags(AValue); 3930end; 3931 3932procedure TProject.SetMainUnitID(const AValue: Integer); 3933begin 3934 if AValue>=UnitCount then 3935 RaiseGDBException(''); 3936 3937 if MainUnitID=AValue then exit; 3938 if (MainUnitID>=0) and (MainUnitID<UnitCount) then 3939 MainUnitInfo.DecreaseAutoRevertLock; 3940 fMainUnitID:=AValue; 3941 if (MainUnitID>=0) and (MainUnitID<UnitCount) then 3942 MainUnitInfo.IncreaseAutoRevertLock; 3943end; 3944 3945function TProject.GetFiles(Index: integer): TLazProjectFile; 3946begin 3947 Result:=Units[Index]; 3948end; 3949 3950function TProject.GetModified: boolean; 3951begin 3952 Result:=(FChangeStamp<>FChangeStampSaved) 3953 or ((BuildModes<>nil) and BuildModes.Modified); 3954end; 3955 3956procedure TProject.SetModified(const AValue: boolean); 3957begin 3958 {$IFDEF VerboseIDEModified} 3959 if Modified<>AValue then begin 3960 debugln(['TProject.SetModified ================= ',AValue,' ',FChangeStamp]); 3961 CTDumpStack; 3962 end; 3963 {$ENDIF} 3964 if fDestroying then exit; 3965 if AValue then 3966 IncreaseChangeStamp 3967 else begin 3968 FChangeStampSaved:=FChangeStamp; 3969 PublishOptions.Modified := False; 3970 ProjResources.Modified := False; 3971 BuildModes.Modified:=false; 3972 SessionModified := False; 3973 end; 3974end; 3975 3976procedure TProject.SetSessionModified(const AValue: boolean); 3977begin 3978 {$IFDEF VerboseIDEModified} 3979 debugln(['TProject.SetSessionModified new Modified=',AValue]); 3980 {$ENDIF} 3981 inherited SetSessionModified(AValue); 3982 if AValue then 3983 IncreaseSessionChangeStamp; 3984end; 3985 3986procedure TProject.SetExecutableType(const AValue: TProjectExecutableType); 3987begin 3988 inherited SetExecutableType(AValue); 3989 case ExecutableType of 3990 petLibrary: CompilerOptions.ExecutableType:=cetLibrary; 3991 else CompilerOptions.ExecutableType:=cetProgram; 3992 end; 3993end; 3994 3995function TProject.GetUseManifest: boolean; 3996begin 3997 Result:=ProjResources.XPManifest.UseManifest; 3998end; 3999 4000procedure TProject.SetUseManifest(AValue: boolean); 4001begin 4002 ProjResources.XPManifest.UseManifest:=AValue; 4003end; 4004 4005function TProject.GetCurrentDebuggerBackend: String; 4006begin 4007 Result := FDebuggerBackend; 4008end; 4009 4010function TProject.UnitCount:integer; 4011begin 4012 Result:=FUnitList.Count; 4013end; 4014 4015function TProject.GetFileCount: integer; 4016begin 4017 Result:=UnitCount; 4018end; 4019 4020function TProject.NewUniqueUnitName(const AnUnitName: string):string; 4021 4022 function ExpandedUnitname(const AnUnitName:string):string; 4023 begin 4024 Result:=uppercase(ExtractFileNameOnly(AnUnitName)); 4025 end; 4026 4027 function UnitNameExists(const AnUnitName:string):boolean; 4028 var i:integer; 4029 ExpName:string; 4030 begin 4031 Result:=true; 4032 ExpName:=ExpandedUnitName(AnUnitName); 4033 if ExtractFileNameOnly(fProjectInfoFile)=ExpName then exit; 4034 for i:=0 to UnitCount-1 do 4035 if (Units[i].IsPartOfProject) 4036 and (ExpandedUnitName(Units[i].FileName)=ExpName) then 4037 exit; 4038 Result:=false; 4039 end; 4040 4041var 4042 u:integer; 4043 Prefix: string; 4044begin 4045 Prefix:=AnUnitName; 4046 while (Prefix<>'') and (Prefix[length(Prefix)] in ['0'..'9']) do 4047 Prefix:=copy(Prefix,1,length(Prefix)-1); 4048 if not IsValidIdent(Prefix) then 4049 Prefix:='Unit'; 4050 u:=0; 4051 repeat 4052 inc(u); 4053 Result:=Prefix+IntToStr(u); 4054 until (not UnitNameExists(Result)); 4055end; 4056 4057function TProject.NewUniqueFilename(const Filename: string): string; 4058var 4059 FileNameOnly: String; 4060 FileExt: String; 4061 i: Integer; 4062begin 4063 FileNameOnly:=ExtractFilenameOnly(Filename); 4064 while (FileNameOnly<>'') 4065 and (FileNameOnly[length(FileNameOnly)] in ['0'..'9']) do 4066 FileNameOnly:=copy(FileNameOnly,1,length(FileNameOnly)-1); 4067 FileExt:=ExtractFileExt(Filename); 4068 i:=0; 4069 repeat 4070 inc(i); 4071 Result:=FileNameOnly+IntToStr(i)+FileExt; 4072 until ProjectUnitWithShortFilename(Result)=nil; 4073end; 4074 4075function TProject.AddCreateFormToProjectFile(const AClassName, AName: string): boolean; 4076begin 4077 Result:=CodeToolBoss.AddCreateFormStatement(MainUnitInfo.Source,AClassName,AName); 4078 if Result then 4079 MainUnitInfo.Modified:=true; 4080end; 4081 4082function TProject.RemoveCreateFormFromProjectFile(const AName:string):boolean; 4083begin 4084 Result:=CodeToolBoss.RemoveCreateFormStatement(MainUnitInfo.Source,AName); 4085 if Result then 4086 MainUnitInfo.Modified:=true; 4087end; 4088 4089function TProject.FormIsCreatedInProjectFile(const AClassname,AName:string): boolean; 4090var p: integer; 4091begin 4092 Result:=(CodeToolBoss.FindCreateFormStatement(MainUnitInfo.Source, 4093 1,AClassName,AName,p)=0); 4094 if p=0 then ; 4095end; 4096 4097function TProject.IndexOfUnitWithName(const AnUnitName:string; 4098 OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo):integer; 4099begin 4100 if AnUnitName='' then exit(-1); 4101 Result:=UnitCount-1; 4102 while (Result>=0) do begin 4103 if ((OnlyProjectUnits and Units[Result].IsPartOfProject) 4104 or (not OnlyProjectUnits)) 4105 and (IgnoreUnit<>Units[Result]) 4106 and (Units[Result].Unit_Name<>'') 4107 then begin 4108 if (CompareDottedIdentifiers(PChar(Units[Result].Unit_Name),PChar(AnUnitName))=0) 4109 then 4110 exit; 4111 end; 4112 dec(Result); 4113 end; 4114end; 4115 4116function TProject.IndexOfUnitWithComponent(AComponent: TComponent; 4117 OnlyProjectUnits:boolean; IgnoreUnit: TUnitInfo):integer; 4118begin 4119 Result:=UnitCount-1; 4120 while (Result>=0) do begin 4121 if (OnlyProjectUnits and Units[Result].IsPartOfProject) 4122 or (not OnlyProjectUnits) 4123 and (IgnoreUnit<>Units[Result]) then begin 4124 if Units[Result].Component=AComponent then 4125 exit; 4126 end; 4127 dec(Result); 4128 end; 4129end; 4130 4131function TProject.IndexOfUnitWithComponentName(const AComponentName: string; 4132 OnlyProjectUnits: boolean; IgnoreUnit: TUnitInfo): integer; 4133begin 4134 Result:=UnitCount-1; 4135 while (Result>=0) do begin 4136 if ((OnlyProjectUnits and Units[Result].IsPartOfProject) 4137 or (not OnlyProjectUnits)) 4138 and (IgnoreUnit<>Units[Result]) then begin 4139 if (CompareText(Units[Result].ComponentName,AComponentName)=0) 4140 or ((Units[Result].Component<>nil) 4141 and (CompareText(Units[Result].Component.Name,AComponentName)=0)) 4142 then 4143 exit; 4144 end; 4145 dec(Result); 4146 end; 4147end; 4148 4149function TProject.UnitWithEditorComponent(AEditor: TSourceEditorInterface): TUnitInfo; 4150var 4151 AnEditorInfo: TUnitEditorInfo; 4152begin 4153 if AEditor = nil then exit(nil); 4154 AnEditorInfo := EditorInfoWithEditorComponent(AEditor); 4155 if AnEditorInfo = nil then exit(nil); 4156 Result := AnEditorInfo.UnitInfo; 4157end; 4158 4159function TProject.GetResourceFile(AnUnitInfo: TUnitInfo; Index:integer): TCodeBuffer; 4160var i, LinkIndex: integer; 4161begin 4162 LinkIndex:=-1; 4163 i:=0; 4164 Result:=nil; 4165 while (i<Index) do begin 4166 inc(i); 4167 Result:=CodeToolBoss.FindNextResourceFile(AnUnitInfo.Source,LinkIndex); 4168 end; 4169end; 4170 4171procedure TProject.LoadDefaultIcon; 4172begin 4173 TProjectIcon(ProjResources[TProjectIcon]).LoadDefaultIcon; 4174end; 4175 4176function TProject.GetShortFilename(const Filename: string; UseUp: boolean): string; 4177var 4178 BaseDir: String; 4179 CurPath: String; 4180begin 4181 Result:=Filename; 4182 BaseDir:=AppendPathDelim(Directory); 4183 if (BaseDir<>'') and FilenameIsAbsolute(BaseDir) and UseUp then 4184 Result:=CreateRelativePath(Result,BaseDir) 4185 else begin 4186 CurPath:=copy(ExtractFilePath(Result),1,length(BaseDir)); 4187 if CompareFilenames(BaseDir,CurPath)=0 then 4188 delete(Result,1,length(CurPath)); 4189 end; 4190end; 4191 4192procedure TProject.ConvertToLPIFilename(var AFilename: string); 4193begin 4194 LoadSaveFilenameHandler(AFilename,false); 4195end; 4196 4197procedure TProject.ConvertFromLPIFilename(var AFilename: string); 4198begin 4199 LoadSaveFilenameHandler(AFilename,true); 4200end; 4201 4202function TProject.GetMainResourceFilename(AnUnitInfo: TUnitInfo):string; 4203var CodeBuf: TCodeBuffer; 4204begin 4205 CodeBuf:=GetResourceFile(AnUnitInfo,1); 4206 if CodeBuf=nil then begin 4207 if AnUnitInfo.Filename='' then exit(''); 4208 Result:=ChangeFileExt(AnUnitInfo.Filename,ResourceFileExt); 4209 exit; 4210 end else 4211 Result:=CodeBuf.Filename; 4212end; 4213 4214function TProject.IsLclApplication: Boolean; 4215var 4216 CodeTool: TCodeTool; 4217 UsesNode: TCodeTreeNode; 4218begin 4219 Result := False; 4220 // LCL dependency must be there. 4221 if FindDependencyByName('LCL') = Nil then Exit; 4222 //DebugLn(['IsLclApplication: Found LCL dependency.']); 4223 try 4224 // Check is uses section has "Forms" unit. 4225 if not CodeToolBoss.InitCurCodeTool(MainUnitInfo.Source) then Exit; 4226 CodeTool := CodeToolBoss.CurCodeTool; 4227 CodeTool.BuildTree(lsrMainUsesSectionEnd); 4228 UsesNode := CodeTool.FindMainUsesNode; 4229 if UsesNode = Nil then Exit; 4230 //DebugLn(['IsLclApplication: Found "uses" node.']); 4231 if CodeTool.FindNameInUsesSection(UsesNode, 'forms') = Nil then Exit; 4232 //DebugLn(['IsLclApplication: Found "Forms" unit.']); 4233 Result := True; 4234 except 4235 DebugLn(['IsLclApplication: Codetools could not parse the source.']); 4236 end; 4237end; 4238 4239function TProject.IsVirtual: boolean; 4240begin 4241 Result:=((MainUnitID>=0) and MainUnitInfo.IsVirtual) 4242 or (ProjectInfoFile='') or (not FilenameIsAbsolute(ProjectInfoFile)); 4243end; 4244 4245function TProject.IndexOf(AUnitInfo: TUnitInfo):integer; 4246begin 4247 Result:=UnitCount-1; 4248 while (Result>=0) and (Units[Result]<>AUnitInfo) do dec(Result); 4249end; 4250 4251procedure TProject.AddToOrRemoveFromComponentList(AnUnitInfo: TUnitInfo); 4252begin 4253 if AnUnitInfo.Component=nil then begin 4254 RemoveFromList(AnUnitInfo,uilWithComponent); 4255 end else begin 4256 AddToList(AnUnitInfo,uilWithComponent); 4257 end; 4258end; 4259 4260procedure TProject.AddToOrRemoveFromLoadedList(AnUnitInfo: TUnitInfo); 4261begin 4262 if not AnUnitInfo.Loaded then begin 4263 RemoveFromList(AnUnitInfo,uilLoaded); 4264 end else begin 4265 AddToList(AnUnitInfo,uilLoaded); 4266 end; 4267end; 4268 4269procedure TProject.AddToOrRemoveFromAutoRevertLockedList(AnUnitInfo: TUnitInfo); 4270begin 4271 if not AnUnitInfo.IsAutoRevertLocked then begin 4272 RemoveFromList(AnUnitInfo,uilAutoRevertLocked); 4273 end else begin 4274 AddToList(AnUnitInfo,uilAutoRevertLocked); 4275 end; 4276end; 4277 4278procedure TProject.AddToOrRemoveFromPartOfProjectList(AnUnitInfo: TUnitInfo); 4279begin 4280 if not AnUnitInfo.IsPartOfProject then begin 4281 RemoveFromList(AnUnitInfo,uilPartOfProject); 4282 end else begin 4283 AddToList(AnUnitInfo,uilPartOfProject); 4284 end; 4285end; 4286 4287function TProject.GetTargetFilename: string; 4288begin 4289 Result:=FLazCompilerOptions.TargetFilename; 4290end; 4291 4292procedure TProject.SetTargetFilename(const NewTargetFilename: string); 4293begin 4294 FLazCompilerOptions.TargetFilename:=NewTargetFilename; 4295end; 4296 4297procedure TProject.SetEnableI18N(const AValue: boolean); 4298begin 4299 if FEnableI18N=AValue then exit; 4300 FEnableI18N:=AValue; 4301 {$IFDEF VerboseIDEModified} 4302 debugln(['TProject.SetEnableI18N ',AValue]); 4303 {$ENDIF} 4304 Modified:=true; 4305end; 4306 4307procedure TProject.SetPOOutputDirectory(const AValue: string); 4308var 4309 NewValue: String; 4310begin 4311 NewValue:=ChompPathDelim(TrimFilename(AValue)); 4312 if FPOOutputDirectory=NewValue then exit; 4313 FPOOutputDirectory:=NewValue; 4314 {$IFDEF VerboseIDEModified} 4315 debugln(['TProject.SetPOOutputDirectory ',AValue]); 4316 {$ENDIF} 4317 Modified:=true; 4318end; 4319 4320function TProject.GetMainFilename: String; 4321begin 4322 if MainUnitID>=0 then Result:=MainUnitInfo.Filename 4323 else Result:=''; 4324end; 4325 4326function TProject.GetFirstPartOfProject: TUnitInfo; 4327begin 4328 Result:=FFirst[uilPartOfProject]; 4329end; 4330 4331function TProject.GetFirstLoadedUnit: TUnitInfo; 4332begin 4333 Result:=fFirst[uilLoaded]; 4334end; 4335 4336procedure TProject.EmbeddedObjectModified(Sender: TObject); 4337begin 4338 if ProjResources.Modified then 4339 Modified := True; 4340end; 4341 4342function TProject.GetFirstAutoRevertLockedUnit: TUnitInfo; 4343begin 4344 Result:=fFirst[uilAutoRevertLocked]; 4345end; 4346 4347function TProject.GetAllEditorsInfo(Index: Integer): TUnitEditorInfo; 4348begin 4349 Result := FAllEditorsInfoList[Index]; 4350end; 4351 4352function TProject.GetCompilerOptions: TProjectCompilerOptions; 4353begin 4354 Result := TProjectCompilerOptions(FLazCompilerOptions); 4355end; 4356 4357function TProject.GetBaseCompilerOptions: TBaseCompilerOptions; 4358// This satisfies the IProjPack interface requirement. 4359begin 4360 Result := TBaseCompilerOptions(FLazCompilerOptions); 4361end; 4362 4363procedure TProject.ClearBuildModes; 4364begin 4365 ActiveBuildMode:=nil; 4366 FBuildModes.Clear; 4367 if not fDestroying then 4368 ActiveBuildMode:=FBuildModes.Add('default'); 4369end; 4370 4371function TProject.GetActiveBuildModeID: string; 4372begin 4373 Result := ActiveBuildMode.Identifier; 4374end; 4375 4376function TProject.GetFirstUnitWithComponent: TUnitInfo; 4377begin 4378 Result:=fFirst[uilWithComponent]; 4379end; 4380 4381function TProject.GetFirstUnitWithEditorIndex: TUnitInfo; 4382begin 4383 Result:=fFirst[uilWithEditorIndex]; 4384end; 4385 4386function TProject.GetIDEOptions: TProjectIDEOptions; 4387begin 4388 Result := TProjectIDEOptions(FIDEOptions); 4389end; 4390 4391function TProject.GetMainUnitInfo: TUnitInfo; 4392begin 4393 if (MainUnitID>=0) and (MainUnitID<UnitCount) then 4394 Result:=Units[MainUnitID] 4395 else 4396 Result:=nil; 4397end; 4398 4399function TProject.GetProjResources: TProjectResources; 4400begin 4401 Result:=TProjectResources(Resources); 4402end; 4403 4404function TProject.GetRunParameterOptions: TRunParamsOptions; 4405begin 4406 Result:=TRunParamsOptions(FRunParameters); 4407end; 4408 4409function TProject.GetSourceDirectories: TFileReferenceList; 4410begin 4411 Result:=FSourceDirectories; 4412end; 4413 4414function TProject.GetProjectInfoFile:string; 4415begin 4416 Result:=fProjectInfoFile; 4417end; 4418 4419procedure TProject.SetProjectInfoFile(const NewFilename:string); 4420var 4421 NewProjectInfoFile: String; 4422 TitleWasDefault: Boolean; 4423begin 4424 NewProjectInfoFile:=TrimFilename(NewFilename); 4425 if NewProjectInfoFile='' then exit; 4426 ForcePathDelims(NewProjectInfoFile); 4427 if fProjectInfoFile=NewProjectInfoFile then exit; 4428 BeginUpdate(true); 4429 TitleWasDefault:=(Title<>'') and TitleIsDefault(true); 4430 fProjectInfoFile:=NewProjectInfoFile; 4431 if TitleWasDefault then 4432 Title:=GetDefaultTitle; 4433 UpdateProjectDirectory; 4434 UpdateSessionFilename; 4435 if Assigned(OnChangeProjectInfoFile) then 4436 OnChangeProjectInfoFile(Self); 4437 FDefineTemplates.SourceDirectoriesChanged; 4438 {$IFDEF VerboseIDEModified} 4439 debugln(['TProject.SetProjectInfoFile ',NewFilename]); 4440 {$ENDIF} 4441 Modified:=true; 4442 EndUpdate; 4443 //DebugLn('TProject.SetProjectInfoFile FDefineTemplates.FUpdateLock=',dbgs(FDefineTemplates.FUpdateLock)); 4444end; 4445 4446procedure TProject.SetSessionStorage(const AValue: TProjectSessionStorage); 4447begin 4448 if SessionStorage=AValue then exit; 4449 inherited SetSessionStorage(AValue); 4450 {$IFDEF VerboseIDEModified} 4451 debugln(['TProject.SetSessionStorage ']); 4452 {$ENDIF} 4453 Modified:=true; 4454 UpdateSessionFilename; 4455end; 4456 4457function TProject.FileBackupHandler(const Filename: string): TModalResult; 4458begin 4459 if Assigned(fOnFileBackup) then 4460 Result:=fOnFileBackup(Filename) 4461 else 4462 Result:=mrOk; 4463end; 4464 4465procedure TProject.LoadSaveFilenameHandler(var AFilename: string; Load:boolean); 4466{ This function is used after reading a filename from the config 4467 and before writing a filename to a config. 4468 The config can be the lpi or the session. 4469} 4470var 4471 ProjectPath: string; 4472 FileWasAbsolute: Boolean; 4473 4474 function FileCanBeMadeRelative: boolean; 4475 begin 4476 Result:=false; 4477 if not FileWasAbsolute then exit; 4478 {$IFdef MSWindows} 4479 // check that the file is on the same drive / filesystem 4480 if CompareText(ExtractFileDrive(AFilename),ExtractFileDrive(ProjectPath))<>0 4481 then exit; 4482 {$ENDIF} 4483 Result:=true; 4484 end; 4485 4486begin 4487 if AFileName='' then exit; 4488 //debugln(['TProject.OnLoadSaveFilename A "',AFilename,'" fPathDelimChanged=',fPathDelimChanged,' Load=',Load]); 4489 if Load and fPathDelimChanged then begin 4490 {$IFDEF MSWindows} 4491 // PathDelim changed from '/' to '\' 4492 FileWasAbsolute:=FilenameIsUnixAbsolute(AFileName); 4493 {$ELSE} 4494 // PathDelim changed from '\' to '/' 4495 FileWasAbsolute:=FilenameIsWinAbsolute(AFileName); 4496 {$ENDIF} 4497 ForcePathDelims(AFilename); 4498 end else begin 4499 FileWasAbsolute:=FilenameIsAbsolute(AFileName); 4500 end; 4501 AFilename:=TrimFilename(AFilename); 4502 4503 ProjectPath:=AppendPathDelim(Directory); 4504 if ProjectPath<>'' then begin 4505 if Load then begin 4506 // make filename absolute 4507 if not FileWasAbsolute then 4508 AFilename:=TrimFilename(ProjectPath+AFilename); 4509 end else begin 4510 // try making filename relative to project file 4511 if FileCanBeMadeRelative then begin 4512 AFilename:=CreateRelativePath(AFilename,ProjectPath); 4513 end; 4514 end; 4515 end; 4516 4517 if (not Load) then begin 4518 if (not IsCurrentPathDelim(fCurStorePathDelim)) 4519 and (FilenameIsAbsolute(AFileName)) 4520 and (ProjectPath<>'') then begin 4521 // the lpi file is saved with different pathdelims 4522 // this will destroy absolute paths 4523 // => force it relative 4524 AFileName:=ExtractRelativepath(ProjectPath,AFilename); 4525 end; 4526 AFilename:=SwitchPathDelims(AFileName,fCurStorePathDelim); 4527 end; 4528 //debugln('TProject.OnLoadSaveFilename END "',AFilename,'" FileWasAbsolute=',dbgs(FileWasAbsolute)); 4529end; 4530 4531function TProject.RemoveProjectPathFromFilename(const AFilename: string): string; 4532var 4533 ProjectPath:string; 4534begin 4535 ProjectPath:=Directory; 4536 if ProjectPath='' then ProjectPath:=GetCurrentDirUTF8; 4537 Result:=AFilename; 4538 ForcePathDelims(Result); 4539 // try making filename relative to project file 4540 if FilenameIsAbsolute(Result) 4541 and (CompareFileNames(copy(Result,1,length(ProjectPath)),ProjectPath)=0) then 4542 Result:=copy(Result,length(ProjectPath)+1, 4543 length(Result)-length(ProjectPath)); 4544end; 4545 4546function TProject.FileIsInProjectDir(const AFilename: string): boolean; 4547var 4548 ProjectDir, FilePath: string; 4549begin 4550 if FilenameIsAbsolute(AFilename) then 4551 begin 4552 if IsVirtual then 4553 Result:=false 4554 else begin 4555 ProjectDir:=Directory; 4556 FilePath:=LeftStr(AFilename,length(ProjectDir)); 4557 Result:=CompareFileNames(ProjectDir,FilePath)=0; 4558 end; 4559 end else 4560 Result:=true; 4561end; 4562 4563procedure TProject.GetVirtualDefines(DefTree: TDefineTree; DirDef: TDirectoryDefines); 4564 4565 procedure ExtendPath(const AVariable, APath: string); 4566 var 4567 TempValue: string; 4568 begin 4569 if APath<>'' then begin 4570 DefTree.ReadValue(DirDef,APath+';','',TempValue); 4571 DirDef.Values.Prepend(AVariable,TempValue); 4572 end; 4573 end; 4574 4575begin 4576 if (not IsVirtual) then exit; 4577 ExtendPath(NamespacesMacroName,CompilerOptions.Namespaces); 4578 ExtendPath(UnitPathMacroName,CompilerOptions.OtherUnitFiles); 4579 ExtendPath(IncludePathMacroName,CompilerOptions.IncludePath); 4580 ExtendPath(SrcPathMacroName,CompilerOptions.SrcPath); 4581end; 4582 4583procedure TProject.GetUnitsChangedOnDisk(var AnUnitList: TFPList; 4584 IgnoreModifiedFlag: boolean); 4585var 4586 AnUnitInfo: TUnitInfo; 4587begin 4588 AnUnitList:=nil; 4589 AnUnitInfo:=fFirst[uilAutoRevertLocked]; 4590 while (AnUnitInfo<>nil) do begin 4591 if (AnUnitInfo.Source<>nil) 4592 and AnUnitInfo.ChangedOnDisk(false, IgnoreModifiedFlag) then begin 4593 if AnUnitList=nil then 4594 AnUnitList:=TFPList.Create; 4595 AnUnitList.Add(AnUnitInfo); 4596 end; 4597 AnUnitInfo:=AnUnitInfo.fNext[uilAutoRevertLocked]; 4598 end; 4599end; 4600 4601function TProject.GetUseLegacyLists: Boolean; 4602begin 4603 Result:=pfCompatibilityMode in Flags; 4604end; 4605 4606function TProject.HasProjectInfoFileChangedOnDisk: boolean; 4607var 4608 AnUnitInfo: TUnitInfo; 4609 Code: TCodeBuffer; 4610begin 4611 Result:=false; 4612 if IsVirtual or Modified then exit; 4613 AnUnitInfo:=UnitInfoWithFilename(ProjectInfoFile,[pfsfOnlyEditorFiles]); 4614 if (AnUnitInfo<>nil) then begin 4615 // user is editing the lpi file in source editor 4616 exit; 4617 end; 4618 AnUnitInfo:=fFirst[uilAutoRevertLocked]; 4619 while (AnUnitInfo<>nil) do begin 4620 if CompareFilenames(AnUnitInfo.Filename,ProjectInfoFile)=0 then begin 4621 // revert is locked for this file 4622 exit; 4623 end; 4624 AnUnitInfo:=AnUnitInfo.fNext[uilAutoRevertLocked]; 4625 end; 4626 4627 if not FileExistsCached(ProjectInfoFile) then exit; 4628 if fProjectInfoFileDate=FileAgeCached(ProjectInfoFile) then exit; 4629 4630 // file on disk has changed, check content 4631 Code:=CodeToolBoss.LoadFile(ProjectInfoFile,true,true); 4632 if (Code<>nil) and (Code=fProjectInfoFileBuffer) 4633 and (Code.ChangeStep=fProjectInfoFileBufChangeStamp) 4634 then exit; 4635 4636 //DebugLn(['TProject.HasProjectInfoFileChangedOnDisk ',ProjectInfoFile,' fProjectInfoFileDate=',fProjectInfoFileDate,' ',FileAgeUTF8(ProjectInfoFile)]); 4637 Result:=true; 4638end; 4639 4640procedure TProject.IgnoreProjectInfoFileOnDisk; 4641begin 4642 fProjectInfoFileDate:=FileAgeCached(ProjectInfoFile); 4643end; 4644 4645function TProject.FindDependencyByName(const PackageName: string): TPkgDependency; 4646begin 4647 Result:=FindDependencyByNameInList(FFirstRequiredDependency,pddRequires, 4648 PackageName); 4649end; 4650 4651function TProject.FindRemovedDependencyByName(const PkgName: string): TPkgDependency; 4652begin 4653 Result:=FindDependencyByNameInList(FFirstRemovedDependency,pddRequires,PkgName); 4654end; 4655 4656function TProject.RequiredDepByIndex(Index: integer): TPkgDependency; 4657begin 4658 Result:=GetDependencyWithIndex(FFirstRequiredDependency,pddRequires,Index); 4659end; 4660 4661function TProject.RemovedDepByIndex(Index: integer): TPkgDependency; 4662begin 4663 Result:=GetDependencyWithIndex(FFirstRemovedDependency,pddRequires,Index); 4664end; 4665 4666procedure TProject.AddRequiredDependency(Dependency: TPkgDependency); 4667begin 4668 BeginUpdate(true); 4669 Dependency.AddToList(FFirstRequiredDependency,pddRequires); 4670 Dependency.Owner:=Self; 4671 Dependency.HoldPackage:=true; 4672 FDefineTemplates.CustomDefinesChanged; 4673 {$IFDEF VerboseAddProjPkg} 4674 DebugLn(['TProject.AddRequiredDependency ']); 4675 {$ENDIF} 4676 IncreaseCompilerParseStamp; 4677 {$IFDEF VerboseIDEModified} 4678 debugln(['TProject.AddRequiredDependency ',Dependency.PackageName]); 4679 {$ENDIF} 4680 Modified:=true; 4681 EndUpdate; 4682end; 4683 4684procedure TProject.RemoveRequiredDependency(Dependency: TPkgDependency); 4685begin 4686 BeginUpdate(true); 4687 Dependency.RemoveFromList(FFirstRequiredDependency,pddRequires); 4688 Dependency.RequiredPackage:=nil; 4689 Dependency.AddToList(FFirstRemovedDependency,pddRequires); 4690 Dependency.Removed:=true; 4691 FDefineTemplates.CustomDefinesChanged; 4692 IncreaseCompilerParseStamp; 4693 {$IFDEF VerboseIDEModified} 4694 debugln(['TProject.RemoveRequiredDependency ',Dependency.PackageName]); 4695 {$ENDIF} 4696 Modified:=true; 4697 EndUpdate; 4698end; 4699 4700procedure TProject.DeleteRequiredDependency(Dependency: TPkgDependency); 4701begin 4702 BeginUpdate(true); 4703 Dependency.RequiredPackage:=nil; 4704 Dependency.RemoveFromList(FFirstRequiredDependency,pddRequires); 4705 Dependency.Free; 4706 FDefineTemplates.CustomDefinesChanged; 4707 IncreaseCompilerParseStamp; 4708 EndUpdate; 4709end; 4710 4711procedure TProject.DeleteRemovedDependency(Dependency: TPkgDependency); 4712begin 4713 BeginUpdate(true); 4714 Dependency.RequiredPackage:=nil; 4715 Dependency.RemoveFromList(FFirstRemovedDependency,pddRequires); 4716 Dependency.Free; 4717 EndUpdate; 4718end; 4719 4720procedure TProject.RemoveRemovedDependency(Dependency: TPkgDependency); 4721begin 4722 BeginUpdate(true); 4723 Dependency.RemoveFromList(FFirstRemovedDependency,pddRequires); 4724 Dependency.Removed:=false; 4725 EndUpdate; 4726end; 4727 4728procedure TProject.ReaddRemovedDependency(Dependency: TPkgDependency); 4729begin 4730 BeginUpdate(true); 4731 RemoveRemovedDependency(Dependency); 4732 AddRequiredDependency(Dependency); 4733 EndUpdate; 4734end; 4735 4736procedure TProject.MoveRequiredDependencyUp(Dependency: TPkgDependency); 4737begin 4738 if Dependency.PrevRequiresDependency=nil then exit; 4739 BeginUpdate(true); 4740 Dependency.MoveUpInList(FFirstRequiredDependency,pddRequires); 4741 FDefineTemplates.CustomDefinesChanged; 4742 IncreaseCompilerParseStamp; 4743 EndUpdate; 4744end; 4745 4746procedure TProject.MoveRequiredDependencyDown(Dependency: TPkgDependency); 4747begin 4748 if Dependency.NextRequiresDependency=nil then exit; 4749 BeginUpdate(true); 4750 Dependency.MoveDownInList(FFirstRequiredDependency,pddRequires); 4751 FDefineTemplates.CustomDefinesChanged; 4752 IncreaseCompilerParseStamp; 4753 EndUpdate; 4754end; 4755 4756function TProject.Requires(APackage: TLazPackage; SearchRecursively: boolean): boolean; 4757begin 4758 if SearchRecursively then 4759 Result:=PackageGraph.FindDependencyRecursively(FFirstRequiredDependency, 4760 APackage)<>nil 4761 else 4762 Result:=FindCompatibleDependencyInList(FFirstRequiredDependency,pddRequires, 4763 APackage)<>nil; 4764end; 4765 4766procedure TProject.GetAllRequiredPackages(var List: TFPList; 4767 ReqFlags: TPkgIntfRequiredFlags; MinPolicy: TPackageUpdatePolicy); 4768var 4769 FPMakeList: TFPList; 4770begin 4771 if Assigned(OnGetAllRequiredPackages) then begin 4772 OnGetAllRequiredPackages(nil,FirstRequiredDependency,List,FPMakeList,ReqFlags,MinPolicy); 4773 FPMakeList.Free; 4774 end; 4775end; 4776 4777procedure TProject.AddPackageDependency(const PackageName: string); 4778var 4779 PkgDependency: TPkgDependency; 4780begin 4781 if FindDependencyByNameInList(FirstRequiredDependency,pddRequires,PackageName) 4782 <>nil then exit; 4783 PkgDependency:=TPkgDependency.Create; 4784 PkgDependency.DependencyType:=pdtLazarus; 4785 PkgDependency.PackageName:=PackageName; 4786 AddRequiredDependency(PkgDependency); 4787end; 4788 4789function TProject.RemovePackageDependency(const PackageName: string): boolean; 4790var 4791 PkgDependency: TPkgDependency; 4792begin 4793 PkgDependency:=FindDependencyByNameInList(FirstRequiredDependency,pddRequires,PackageName); 4794 Result := Assigned(PkgDependency); 4795 if Result then 4796 RemoveRequiredDependency(PkgDependency); 4797end; 4798 4799procedure TProject.LockUnitComponentDependencies; 4800begin 4801 inc(FLockUnitComponentDependencies); 4802 if FLockUnitComponentDependencies=1 then begin 4803 // update once 4804 Include(FStateFlags,lpsfPropertyDependenciesChanged); 4805 Include(FStateFlags,lpsfDesignerChanged); 4806 end; 4807end; 4808 4809procedure TProject.UnlockUnitComponentDependencies; 4810begin 4811 if FLockUnitComponentDependencies=0 then 4812 raise Exception.Create(''); 4813 dec(FLockUnitComponentDependencies); 4814end; 4815 4816procedure TProject.UpdateUnitComponentDependencies; 4817 4818 procedure Search(AnUnitInfo: TUnitInfo; AComponent: TComponent); 4819 // search the published properties of AComponent for references to other units 4820 var 4821 TypeInfo: PTypeInfo; 4822 TypeData: PTypeData; 4823 PropInfo: PPropInfo; 4824 PropList: PPropList; 4825 CurCount,i: integer; 4826 ReferenceComp: TObject; 4827 OwnerComponent: TComponent; 4828 ReferenceUnit: TUnitInfo; 4829 Dependency: TUnitComponentDependency; 4830 begin 4831 if AComponent<>AnUnitInfo.Component then begin 4832 ReferenceUnit:=UnitWithComponentClass(TComponentClass(AComponent.ClassType)); 4833 {$ifdef VerboseFormEditor} 4834 DebugLn(['Search UnitComponent=',DbgSName(AnUnitInfo.Component),' AComponent=',DbgSName(AComponent),' ReferenceUnit=',ReferenceUnit<>nil]); 4835 {$endif} 4836 if (ReferenceUnit<>nil) then begin 4837 // component class references another unit 4838 {$IFDEF VerboseIDEMultiForm} 4839 DebugLn(['TProject.UpdateUnitComponentDependencies inline component found: ',DbgSName(AComponent),' ',AnUnitInfo.Filename,' -> ',ReferenceUnit.Filename]); 4840 {$ENDIF} 4841 AnUnitInfo.AddRequiresComponentDependency( 4842 ReferenceUnit,[ucdtInlineClass]); 4843 end; 4844 end; 4845 4846 // read all properties and remove doubles 4847 TypeInfo:=PTypeInfo(AComponent.ClassInfo); 4848 repeat 4849 // read all property infos of current class 4850 TypeData:=GetTypeData(TypeInfo); 4851 // read property count 4852 CurCount:=GetPropList(TypeInfo,PropList); 4853 try 4854 // read properties 4855 for i:=0 to CurCount-1 do begin 4856 PropInfo:=PropList^[i]; 4857 if (PropInfo^.PropType^.Kind=tkClass) then begin 4858 // property of kind TObject 4859 ReferenceComp:=GetObjectProp(AComponent,PropInfo); 4860 //debugln('TProject.UpdateUnitComponentDependencies Property ',dbgsName(AComponent),' Name=',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' Value=',dbgsName(ReferenceComp),' TypeInfo=',TypeInfo^.Name); 4861 if ReferenceComp is TComponent then begin 4862 // reference is a TComponent 4863 OwnerComponent:=TComponent(ReferenceComp); 4864 while OwnerComponent.Owner<>nil do 4865 OwnerComponent:=OwnerComponent.Owner; 4866 if OwnerComponent<>AnUnitInfo.Component then begin 4867 // property references a component that is not owned 4868 // by the current unit 4869 ReferenceUnit:=UnitWithComponent(OwnerComponent); 4870 if ReferenceUnit<>nil then begin 4871 // property references another unit 4872 {$IFDEF VerboseIDEMultiForm} 4873 DebugLn(['TProject.UpdateUnitComponentDependencies multi form reference found: ',AnUnitInfo.Filename,' -> ',ReferenceUnit.Filename]); 4874 {$ENDIF} 4875 AnUnitInfo.AddRequiresComponentDependency( 4876 ReferenceUnit,[ucdtProperty]); 4877 if FRevertLockCount>0 then begin 4878 Dependency:=AnUnitInfo.AddRequiresComponentDependency( 4879 ReferenceUnit,[ucdtOldProperty]); 4880 Dependency.SetUsedByPropPath( 4881 Dependency.CreatePropPath(AComponent,PropInfo^.Name), 4882 Dependency.CreatePropPath(TComponent(ReferenceComp))); 4883 end; 4884 end; 4885 end; 4886 end; 4887 end; 4888 end; 4889 finally 4890 FreeMem(PropList); 4891 end; 4892 TypeInfo:=TypeData^.ParentInfo; 4893 until TypeInfo=nil; 4894 end; 4895 4896 procedure DFSRequiredDesigner(AnUnitInfo, IgnoreUnitInfo: TUnitInfo); 4897 var 4898 Dependency: TUnitComponentDependency; 4899 UsingUnitInfo: TUnitInfo; 4900 begin 4901 if (AnUnitInfo=nil) or (AnUnitInfo.Component=nil) 4902 or (uifMarked in AnUnitInfo.FFlags) then 4903 exit; 4904 Include(AnUnitInfo.FFlags,uifMarked); 4905 Dependency:=AnUnitInfo.FirstRequiredComponent; 4906 while Dependency<>nil do begin 4907 UsingUnitInfo:=Dependency.RequiresUnit; 4908 if (UsingUnitInfo<>IgnoreUnitInfo) 4909 and (not (uifComponentIndirectlyUsedByDesigner in UsingUnitInfo.FFlags)) 4910 then begin 4911 {$IFDEF VerboseIDEMultiForm} 4912 DebugLn(['TProject.UpdateUnitComponentDependencies.DFSRequiredDesigner designer of ',AnUnitInfo.Filename,' uses ',UsingUnitInfo.Filename]); 4913 {$ENDIF} 4914 Include(UsingUnitInfo.FFlags,uifComponentIndirectlyUsedByDesigner); 4915 DFSRequiredDesigner(UsingUnitInfo,IgnoreUnitInfo); 4916 end; 4917 Dependency:=Dependency.NextRequiresDependency; 4918 end; 4919 end; 4920 4921var 4922 AnUnitInfo: TUnitInfo; 4923 i: Integer; 4924begin 4925 if (FLockUnitComponentDependencies=0) 4926 or (lpsfPropertyDependenciesChanged in FStateFlags) then begin 4927 Exclude(FStateFlags,lpsfPropertyDependenciesChanged); 4928 // clear dependencies 4929 ClearUnitComponentDependencies([ucdtProperty,ucdtInlineClass]); 4930 {$IFDEF VerboseIDEMultiForm} 4931 DebugLn(['TProject.UpdateUnitComponentDependencies checking properties ...']); 4932 {$ENDIF} 4933 // find property dependencies 4934 AnUnitInfo:=FirstUnitWithComponent; 4935 while AnUnitInfo<>nil do begin 4936 Search(AnUnitInfo,AnUnitInfo.Component); 4937 for i:=AnUnitInfo.Component.ComponentCount-1 downto 0 do 4938 Search(AnUnitInfo,AnUnitInfo.Component.Components[i]); 4939 AnUnitInfo:=AnUnitInfo.NextUnitWithComponent; 4940 end; 4941 //WriteDebugReportUnitComponentDependencies('P '); 4942 end; 4943 4944 if (FLockUnitComponentDependencies=0) 4945 or (lpsfDesignerChanged in FStateFlags) then begin 4946 Exclude(FStateFlags,lpsfDesignerChanged); 4947 {$IFDEF VerboseIDEMultiForm} 4948 DebugLn(['TProject.UpdateUnitComponentDependencies checking designers ...']); 4949 {$ENDIF} 4950 // find designer dependencies 4951 AnUnitInfo:=FirstUnitWithComponent; 4952 while AnUnitInfo<>nil do begin 4953 AnUnitInfo.FFlags:=AnUnitInfo.FFlags- 4954 [uifMarked,uifComponentIndirectlyUsedByDesigner,uifComponentUsedByDesigner]; 4955 if FindRootDesigner(AnUnitInfo.Component)<>nil then begin 4956 {$IFDEF VerboseIDEMultiForm} 4957 DebugLn(['TProject.UpdateUnitComponentDependencies used by designer: ',AnUnitInfo.Filename]); 4958 {$ENDIF} 4959 Include(AnUnitInfo.FFlags,uifComponentUsedByDesigner); 4960 end; 4961 AnUnitInfo:=AnUnitInfo.NextUnitWithComponent; 4962 end; 4963 // mark all units that are used indirectly by a designer 4964 AnUnitInfo:=FirstUnitWithComponent; 4965 while AnUnitInfo<>nil do begin 4966 if (uifComponentUsedByDesigner in AnUnitInfo.FFlags) then 4967 begin 4968 // mark all that use indirectly this designer 4969 Exclude(AnUnitInfo.FFlags,uifMarked); 4970 DFSRequiredDesigner(AnUnitInfo,AnUnitInfo); 4971 end; 4972 AnUnitInfo:=AnUnitInfo.NextUnitWithComponent; 4973 end; 4974 {$IFDEF VerboseTFrame} 4975 WriteDebugReportUnitComponentDependencies('UUCD '); 4976 {$ENDIF} 4977 end; 4978end; 4979 4980procedure TProject.InvalidateUnitComponentDesignerDependencies; 4981begin 4982 Include(FStateFlags,lpsfDesignerChanged); 4983end; 4984 4985procedure TProject.ClearUnitComponentDependencies(ClearTypes: TUnitCompDependencyTypes); 4986var 4987 i: Integer; 4988begin 4989 for i:=UnitCount-1 downto 0 do 4990 Units[i].ClearUnitComponentDependencies(ClearTypes); 4991end; 4992 4993procedure TProject.FindUnitsUsingSubComponent(SubComponent: TComponent; 4994 List: TFPList; IgnoreOwner: boolean); 4995 4996 procedure Search(AnUnitInfo: TUnitInfo; AComponent: TComponent); 4997 // search the published properties of AComponent for references to other units 4998 var 4999 TypeInfo: PTypeInfo; 5000 TypeData: PTypeData; 5001 PropInfo: PPropInfo; 5002 PropList: PPropList; 5003 CurCount,i: integer; 5004 ReferenceComponent: TComponent; 5005 begin 5006 if csDestroying in AComponent.ComponentState then exit; 5007 5008 // read all properties and remove doubles 5009 TypeInfo:=PTypeInfo(AComponent.ClassInfo); 5010 repeat 5011 // read all property infos of current class 5012 TypeData:=GetTypeData(TypeInfo); 5013 // read property count 5014 CurCount:=GetPropList(TypeInfo,PropList); 5015 try 5016 // read properties 5017 for i:=0 to CurCount-1 do begin 5018 PropInfo:=PropList^[i]; 5019 if PropInfo^.PropType^.Kind=tkClass then begin 5020 // property of kind TObject 5021 ReferenceComponent:=TComponent(GetObjectProp(AComponent,PropInfo)); 5022 //debugln('TProject.FindUnitsUsingSubComponent Property ',dbgsName(AComponent),' Name=',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' Value=',dbgsName(ReferenceComponent),' TypeInfo=',TypeInfo^.Name); 5023 if ReferenceComponent=SubComponent then begin 5024 if List.IndexOf(AnUnitInfo)<0 then 5025 List.Add(AnUnitInfo); 5026 end; 5027 end; 5028 end; 5029 finally 5030 FreeMem(PropList); 5031 end; 5032 TypeInfo:=TypeData^.ParentInfo; 5033 until TypeInfo=nil; 5034 end; 5035 5036var 5037 AnUnitInfo: TUnitInfo; 5038 i: Integer; 5039 OwnerComponent: TComponent; 5040begin 5041 if SubComponent=nil then exit; 5042 if IgnoreOwner then begin 5043 OwnerComponent:=SubComponent; 5044 while OwnerComponent<>nil do 5045 OwnerComponent:=OwnerComponent.Owner; 5046 end else 5047 OwnerComponent:=nil; 5048 AnUnitInfo:=FirstUnitWithComponent; 5049 while AnUnitInfo<>nil do begin 5050 if csDestroying in AnUnitInfo.Component.ComponentState then continue; 5051 if AnUnitInfo.Component<>OwnerComponent then begin 5052 Search(AnUnitInfo,AnUnitInfo.Component); 5053 for i:=AnUnitInfo.Component.ComponentCount-1 downto 0 do 5054 Search(AnUnitInfo,AnUnitInfo.Component.Components[i]); 5055 end; 5056 AnUnitInfo:=AnUnitInfo.NextUnitWithComponent; 5057 end; 5058end; 5059 5060procedure TProject.WriteDebugReportUnitComponentDependencies(Prefix: string); 5061var 5062 i: Integer; 5063 AnUnitInfo: TUnitInfo; 5064begin 5065 for i:=0 to UnitCount-1 do begin 5066 AnUnitInfo:=Units[i]; 5067 if (AnUnitInfo.FirstUsedByComponent<>nil) 5068 or (AnUnitInfo.FirstRequiredComponent<>nil) then 5069 AnUnitInfo.WriteDebugReportUnitComponentDependencies(Prefix); 5070 end; 5071end; 5072 5073procedure TProject.AddSrcPath(const SrcPathAddition: string); 5074begin 5075 CompilerOptions.MergeToSrcPath( GetForcedPathDelims(SrcPathAddition) ); 5076end; 5077 5078function TProject.GetSourceDirs(WithProjectDir, WithoutOutputDir: boolean): string; 5079begin 5080 Result:=SourceDirectories.CreateSearchPathFromAllFiles; 5081 if WithProjectDir then 5082 Result:=MergeSearchPaths(Result,Directory); 5083 if WithoutOutputDir then 5084 Result:=RemoveSearchPaths(Result,GetOutputDirectory); 5085end; 5086 5087function TProject.GetOutputDirectory: string; 5088begin 5089 Result:=CompilerOptions.ParsedOpts.GetParsedValue(pcosOutputDir); 5090end; 5091 5092function TProject.GetCompilerFilename: string; 5093begin 5094 Result:=CompilerOptions.ParsedOpts.GetParsedValue(pcosCompilerPath); 5095end; 5096 5097function TProject.GetStateFilename: string; 5098begin 5099 Result:=GetOutputDirectory; 5100 if (not FilenameIsAbsolute(Result)) and (not IsVirtual) then 5101 Result:=Directory; 5102 Result:=AppendPathDelim(Result)+ChangeFileExt(GetCompileSourceFilename,'.compiled'); 5103end; 5104 5105function TProject.GetCompileSourceFilename: string; 5106begin 5107 if MainUnitID<0 then 5108 Result:='' 5109 else 5110 Result:=ExtractFilename(MainUnitInfo.Filename); 5111end; 5112 5113procedure TProject.AutoAddOutputDirToIncPath; 5114begin 5115 if pfLRSFilesInOutputDirectory in Flags then begin 5116 // the .lrs files are auto created in the output directory 5117 // => make sure the project output directory is in the include path 5118 if SearchDirectoryInSearchPath(CompilerOptions.IncludePath,'$(ProjOutDir)')<1 then 5119 CompilerOptions.MergeToIncludePaths(';$(ProjOutDir)'); 5120 end; 5121end; 5122 5123function TProject.ExtendUnitSearchPath(NewUnitPaths: string): boolean; 5124var 5125 CurUnitPaths: String; 5126 r: TModalResult; 5127begin 5128 CurUnitPaths:=CompilerOptions.ParsedOpts.GetParsedValue(pcosUnitPath); 5129 NewUnitPaths:=RemoveSearchPaths(NewUnitPaths,CurUnitPaths); 5130 if NewUnitPaths<>'' then begin 5131 NewUnitPaths:=CreateRelativeSearchPath(NewUnitPaths,Directory); 5132 r:=IDEMessageDialog(lisExtendUnitPath, 5133 Format(lisExtendUnitSearchPathOfProjectWith, [#13, NewUnitPaths]), 5134 mtConfirmation, [mbYes, mbNo, mbCancel]); 5135 case r of 5136 mrYes: CompilerOptions.MergeToUnitPaths(NewUnitPaths); 5137 mrNo: ; 5138 else exit(false); 5139 end; 5140 end; 5141 Result:=true; 5142end; 5143 5144function TProject.ExtendIncSearchPath(NewIncPaths: string): boolean; 5145var 5146 CurIncPaths: String; 5147 r: TModalResult; 5148begin 5149 CurIncPaths:=CompilerOptions.ParsedOpts.GetParsedValue(pcosIncludePath); 5150 NewIncPaths:=RemoveSearchPaths(NewIncPaths,CurIncPaths); 5151 if NewIncPaths<>'' then begin 5152 NewIncPaths:=CreateRelativeSearchPath(NewIncPaths,Directory); 5153 r:=IDEMessageDialog(lisExtendIncludePath, 5154 Format(lisExtendIncludeFilesSearchPathOfProjectWith, [#13, NewIncPaths]), 5155 mtConfirmation, [mbYes, mbNo, mbCancel]); 5156 case r of 5157 mrYes: CompilerOptions.MergeToIncludePaths(NewIncPaths); 5158 mrNo: ; 5159 else exit(false); 5160 end; 5161 end; 5162 Result:=true; 5163end; 5164 5165function TProject.LoadStateFile(IgnoreErrors: boolean): TModalResult; 5166var 5167 XMLConfig: TXMLConfig; 5168 StateFile: String; 5169 CurStateFileAge: Integer; 5170begin 5171 StateFile:=GetStateFilename; 5172 if (not FilenameIsAbsolute(StateFile)) or (not FileExistsUTF8(StateFile)) then 5173 begin 5174 DebugLn('TProject.DoLoadStateFile Statefile not found: ',StateFile); 5175 StateFlags:=StateFlags-[lpsfStateFileLoaded]; 5176 Result:=mrOk; 5177 exit; 5178 end; 5179 5180 // read the state file 5181 CurStateFileAge:=FileAgeCached(StateFile); 5182 if (not (lpsfStateFileLoaded in StateFlags)) 5183 or (StateFileDate<>CurStateFileAge) then 5184 begin 5185 StateFlags:=StateFlags-[lpsfStateFileLoaded]; 5186 try 5187 XMLConfig:=TCodeBufXMLConfig.CreateWithCache(StateFile); 5188 try 5189 LastCompilerFilename:=XMLConfig.GetValue('Compiler/Value',''); 5190 LastCompilerFileDate:=XMLConfig.GetValue('Compiler/Date',0); 5191 LastCompilerParams:=XMLConfig.GetValue('Params/Value',''); 5192 LastCompileComplete:=XMLConfig.GetValue('Complete/Value',true); 5193 finally 5194 XMLConfig.Free; 5195 end; 5196 StateFileDate:=CurStateFileAge; 5197 except 5198 on E: Exception do begin 5199 if IgnoreErrors then begin 5200 Result:=mrOk; 5201 end else begin 5202 Result:=IDEMessageDialog(lisPkgMangErrorReadingFile, 5203 Format(lisProjMangUnableToReadStateFileOfProjectError, 5204 [StateFile, IDAsString, LineEnding, E.Message]), 5205 mtError,[mbAbort]); 5206 end; 5207 exit; 5208 end; 5209 end; 5210 StateFlags:=StateFlags+[lpsfStateFileLoaded]; 5211 end; 5212 5213 Result:=mrOk; 5214end; 5215 5216function TProject.SaveStateFile(const CompilerFilename, CompilerParams: string; 5217 Complete: boolean): TModalResult; 5218var 5219 XMLConfig: TXMLConfig; 5220 StateFile: String; 5221 CompilerFileDate: Integer; 5222begin 5223 StateFile:=GetStateFilename; 5224 if not FilenameIsAbsolute(StateFile) then exit(mrOk); 5225 try 5226 CompilerFileDate:=FileAgeCached(CompilerFilename); 5227 XMLConfig:=TCodeBufXMLConfig.CreateWithCache(StateFile,false); 5228 try 5229 // always write all values for easy use by other tools and other versions of IDE 5230 XMLConfig.SetValue('Compiler/Value',CompilerFilename); 5231 XMLConfig.SetValue('Compiler/Date',CompilerFileDate); 5232 XMLConfig.SetValue('Params/Value',CompilerParams); 5233 XMLConfig.SetDeleteValue('Complete/Value',Complete,true); 5234 InvalidateFileStateCache(StateFile); 5235 XMLConfig.Flush; 5236 finally 5237 XMLConfig.Free; 5238 end; 5239 LastCompilerFilename:=CompilerFilename; 5240 LastCompilerFileDate:=CompilerFileDate; 5241 LastCompilerParams:=CompilerParams; 5242 LastCompileComplete:=Complete; 5243 StateFileDate:=FileAgeCached(StateFile); 5244 StateFlags:=StateFlags+[lpsfStateFileLoaded]; 5245 except 5246 on E: Exception do begin 5247 Result:=IDEMessageDialog(lisPkgMangErrorWritingFile, 5248 Format(lisProjMangUnableToWriteStateFileForProjectError, 5249 [IDAsString, LineEnding, E.Message]), 5250 mtError,[mbAbort,mbCancel]); 5251 exit; 5252 end; 5253 end; 5254 Result:=mrOk; 5255end; 5256 5257procedure TProject.UpdateAllCustomHighlighter; 5258var 5259 i: Integer; 5260begin 5261 if IDEEditorOptions=nil then exit; 5262 for i:=0 to UnitCount-1 do 5263 Units[i].UpdateHasCustomHighlighter(FilenameToLazSyntaxHighlighter(Units[i].Filename)); 5264end; 5265 5266procedure TProject.UpdateAllSyntaxHighlighter; 5267var 5268 i: Integer; 5269begin 5270 if IDEEditorOptions=nil then exit; 5271 for i:=0 to UnitCount-1 do 5272 Units[i].UpdateDefaultHighlighter(FilenameToLazSyntaxHighlighter(Units[i].Filename)); 5273end; 5274 5275function TProject.GetPOOutDirectory: string; 5276begin 5277 Result:=POOutputDirectory; 5278 if not IDEMacros.SubstituteMacros(Result) then 5279 debugln(['TProject.GetPOOutDirectory failed POOutputDirectory="',POOutputDirectory,'"']); 5280 Result:=TrimFilename(Result); 5281 if not FilenameIsAbsolute(Result) then 5282 Result:=TrimFilename(AppendPathDelim(Directory)+Result); 5283end; 5284 5285function TProject.GetAutoCreatedFormsList: TStrings; 5286var 5287 i, j: integer; 5288 S, StartS, EndS: String; 5289begin 5290 if (MainUnitID >= 0) then 5291 begin 5292 Result := CodeToolBoss.ListAllCreateFormStatements(MainUnitInfo.Source); 5293 if Result <> nil then 5294 for i := 0 to Result.Count - 1 do 5295 begin 5296 S := Result[i]; 5297 j := Pos(':', S); 5298 if j > 0 then begin 5299 StartS := Copy(S, 1, j-1); 5300 EndS := Copy(S, j+1, Length(S)-j); 5301 if CompareText('t'+StartS, EndS) = 0 then 5302 Result[i] := StartS; 5303 end; 5304 end;// shorten lines of type 'FormName:TFormName' to simply 'FormName' 5305 end 5306 else 5307 Result := nil; 5308end; 5309 5310function TProject.AddBookmark(X, Y, ID: Integer; AUnitInfo:TUnitInfo): integer; 5311begin 5312 Result := Bookmarks.Add(X, Y, ID, AUnitInfo); 5313 SessionModified := true; 5314end; 5315 5316procedure TProject.DeleteBookmark(ID: Integer); 5317var 5318 i: Integer; 5319begin 5320 i := Bookmarks.IndexOfID(ID); 5321 if i < 0 then exit; 5322 Bookmarks.Delete(i); 5323 SessionModified := true; 5324end; 5325 5326procedure TProject.UnitNameChangeHandler(AnUnitInfo: TUnitInfo; 5327 const OldUnitName, NewUnitName: string; CheckIfAllowed: boolean; 5328 var Allowed: boolean); 5329var 5330 i:integer; 5331begin 5332 if AnUnitInfo.IsPartOfProject then 5333 begin 5334 if CheckIfAllowed then begin 5335 // check if no other project unit has this name 5336 for i:=0 to UnitCount-1 do begin 5337 if (Units[i].IsPartOfProject) 5338 and (Units[i]<>AnUnitInfo) and (Units[i].Unit_Name<>'') 5339 and (CompareText(Units[i].Unit_Name,NewUnitName)=0) then begin 5340 Allowed:=false; 5341 exit; 5342 end; 5343 end; 5344 end; 5345 if (OldUnitName<>'') then 5346 begin 5347 if (pfMainUnitIsPascalSource in Flags) then 5348 begin 5349 // rename unit in program uses section 5350 CodeToolBoss.RenameUsedUnit(MainUnitInfo.Source, OldUnitName, NewUnitName, ''); 5351 end; 5352 if MainUnitInfo = AnUnitInfo then 5353 begin 5354 // we are renaming a project => update resource directives 5355 ProjResources.RenameDirectives(OldUnitName, NewUnitName); 5356 end; 5357 end; 5358 end; 5359end; 5360 5361procedure TProject.SetActiveBuildMode(const AValue: TProjectBuildMode); 5362begin 5363 // Must be set even if FActiveBuildMode=AValue. Modes may be added and deleted, 5364 // the same old address can be used by a new mode. 5365 FActiveBuildMode:=AValue; 5366 if FActiveBuildMode<>nil then 5367 FLazCompilerOptions:=FActiveBuildMode.CompilerOptions 5368 else 5369 FLazCompilerOptions:=nil; 5370 {$IFDEF VerboseIDEModified} 5371 debugln(['TProject.SetActiveBuildMode ']); 5372 {$ENDIF} 5373 SessionModified:=true; 5374 if Self=Project1 then 5375 IncreaseBuildMacroChangeStamp; 5376end; 5377 5378procedure TProject.SetActiveBuildModeID(aIdent: string); 5379var 5380 i: Integer; 5381begin 5382 for i:=0 to BuildModes.Count-1 do 5383 begin 5384 if BuildModes[i].Identifier=aIdent then 5385 begin 5386 ActiveBuildMode:=BuildModes[i]; 5387 Break; 5388 end; 5389 end; 5390end; 5391 5392procedure TProject.SetAutoOpenDesignerFormsDisabled(const AValue: boolean); 5393begin 5394 if FAutoOpenDesignerFormsDisabled=AValue then exit; 5395 FAutoOpenDesignerFormsDisabled:=AValue; 5396end; 5397 5398procedure TProject.SetDebuggerBackend(AValue: String); 5399begin 5400 if FDebuggerBackend = AValue then Exit; 5401 FDebuggerBackend := AValue; 5402 Modified := True; 5403end; 5404 5405procedure TProject.SetEnableI18NForLFM(const AValue: boolean); 5406begin 5407 if FEnableI18NForLFM=AValue then exit; 5408 FEnableI18NForLFM:=AValue; 5409 {$IFDEF VerboseIDEModified} 5410 debugln(['TProject.SetEnableI18NForLFM ',AValue]); 5411 {$ENDIF} 5412 Modified:=true; 5413end; 5414 5415procedure TProject.SetLastCompilerParams(AValue: string); 5416begin 5417 if FLastCompilerParams=AValue then Exit; 5418 //debugln(['TProject.SetLastCompilerParams Old="',FLastCompilerParams,'"']); 5419 //debugln(['TProject.SetLastCompilerParams New="',AValue,'"']); 5420 FLastCompilerParams:=AValue; 5421end; 5422 5423procedure TProject.SetMainProject(const AValue: boolean); 5424begin 5425 if MainProject=AValue then exit; 5426 FMainProject:=AValue; 5427 if MainProject then 5428 SourceDirectories.AddFilename(VirtualDirectory) 5429 else 5430 SourceDirectories.RemoveFilename(VirtualDirectory); 5431end; 5432 5433procedure TProject.SetSkipCheckLCLInterfaces(const AValue: boolean); 5434begin 5435 if FSkipCheckLCLInterfaces=AValue then exit; 5436 FSkipCheckLCLInterfaces:=AValue; 5437 SessionModified:=true; 5438end; 5439 5440procedure TProject.SetStorePathDelim(const AValue: TPathDelimSwitch); 5441begin 5442 if FStorePathDelim=AValue then exit; 5443 FStorePathDelim:=AValue; 5444 {$IFDEF VerboseIDEModified} 5445 debugln(['TProject.SetStorePathDelim ']); 5446 {$ENDIF} 5447 Modified:=true; 5448end; 5449 5450function TProject.JumpHistoryCheckPosition( 5451 APosition: TProjectJumpHistoryPosition): boolean; 5452var i: integer; 5453begin 5454 i:=IndexOfFilename(APosition.Filename); 5455 Result:=(i>=0) and (Units[i].OpenEditorInfoCount > 0); 5456end; 5457 5458function TProject.SomethingModified(CheckData, CheckSession: boolean; 5459 Verbose: boolean): boolean; 5460begin 5461 Result := True; 5462 if CheckData and SomeDataModified(Verbose) then exit; 5463 if CheckSession and SomeSessionModified(Verbose) then exit; 5464 Result := False; 5465end; 5466 5467function TProject.SomeDataModified(Verbose: boolean): boolean; 5468var 5469 AnUnitInfo: TUnitInfo; 5470begin 5471 Result:=true; 5472 if Modified then 5473 begin 5474 if Verbose then 5475 DebugLn('TProject.SomeDataModified Modified'); 5476 Exit; 5477 end; 5478 if BuildModes.IsModified(false) then 5479 begin 5480 if Verbose then 5481 DebugLn(['TProject.SomeDataModified CompilerOptions/BuildModes']); 5482 Exit; 5483 end; 5484 AnUnitInfo:=FirstPartOfProject; 5485 while AnUnitInfo<>nil do begin 5486 if AnUnitInfo.Modified then 5487 begin 5488 if Verbose then 5489 DebugLn('TProject.SomeDataModified PartOfProject ',AnUnitInfo.Filename); 5490 Exit; 5491 end; 5492 AnUnitInfo:=AnUnitInfo.NextPartOfProject; 5493 end; 5494 Result:=false; 5495end; 5496 5497function TProject.SomeSessionModified(Verbose: boolean): boolean; 5498var 5499 i: Integer; 5500begin 5501 Result:=true; 5502 if SessionModified then 5503 begin 5504 if Verbose then 5505 DebugLn('TProject.SomeSessionModified SessionModified'); 5506 Exit; 5507 end; 5508 if BuildModes.IsModified(true) then 5509 begin 5510 if Verbose then 5511 DebugLn(['TProject.SomeSessionModified CompilerOptions/BuildModes']); 5512 Exit; 5513 end; 5514 for i := 0 to UnitCount - 1 do 5515 begin 5516 if Units[i].SessionModified then 5517 begin 5518 if Verbose then 5519 DebugLn('TProject.SomeSessionModified Session of ',Units[i].Filename); 5520 exit; 5521 end; 5522 if (not Units[i].IsPartOfProject) and Units[i].Modified then 5523 begin 5524 if Verbose then 5525 DebugLn('TProject.SomeSessionModified Not PartOfProject ',Units[i].Filename); 5526 exit; 5527 end; 5528 end; 5529 Result:=false; 5530end; 5531 5532procedure TProject.MainSourceFilenameChanged; 5533begin 5534 5535end; 5536 5537function TProject.UnitWithComponent(AComponent: TComponent): TUnitInfo; 5538begin 5539 Result:=fFirst[uilWithComponent]; 5540 while (Result<>nil) and (Result.Component<>AComponent) do 5541 Result:=Result.fNext[uilWithComponent]; 5542end; 5543 5544function TProject.UnitWithComponentClass(AClass: TComponentClass): TUnitInfo; 5545begin 5546 Result:=fFirst[uilWithComponent]; 5547 while (Result<>nil) and (Result.Component.ClassType<>AClass) do 5548 Result:=Result.fNext[uilWithComponent]; 5549end; 5550 5551function TProject.UnitWithComponentClassName(const AClassName: string): TUnitInfo; 5552begin 5553 Result := fFirst[uilWithComponent]; 5554 while (Result<>nil) 5555 and (SysUtils.CompareText(Result.Component.ClassName, AClassName) <> 0) do 5556 Result := Result.fNext[uilWithComponent]; 5557end; 5558 5559function TProject.UnitWithComponentName(AComponentName: String; 5560 OnlyPartOfProject: boolean): TUnitInfo; 5561var 5562 i: Integer; 5563begin 5564 if OnlyPartOfProject then begin 5565 Result := fFirst[uilPartOfProject]; 5566 while (Result<>nil) 5567 and (SysUtils.CompareText(Result.ComponentName, AComponentName) <> 0) do 5568 Result := Result.fNext[uilPartOfProject]; 5569 end else begin 5570 Result:=nil; 5571 for i:=0 to UnitCount-1 do 5572 if SysUtils.CompareText(Units[i].ComponentName,AComponentName)=0 then 5573 begin 5574 Result:=Units[i]; 5575 exit; 5576 end; 5577 end; 5578end; 5579 5580function TProject.UnitComponentInheritingFrom(AClass: TComponentClass; 5581 Ignore: TUnitInfo): TUnitInfo; 5582begin 5583 Result:=fFirst[uilWithComponent]; 5584 while (Result<>nil) do begin 5585 if (Result<>Ignore) and Result.Component.InheritsFrom(AClass) then exit; 5586 Result:=Result.fNext[uilWithComponent]; 5587 end; 5588end; 5589 5590function TProject.UnitUsingComponentUnit(ComponentUnit: TUnitInfo; 5591 Types: TUnitCompDependencyTypes): TUnitInfo; 5592var 5593 Dependency: TUnitComponentDependency; 5594begin 5595 Result:=nil; 5596 Dependency:=ComponentUnit.FindUsedByComponentDependency(Types); 5597 if Dependency=nil then exit; 5598 Result:=Dependency.UsedByUnit; 5599end; 5600 5601function TProject.UnitComponentIsUsed(ComponentUnit: TUnitInfo; 5602 CheckHasDesigner: boolean): boolean; 5603begin 5604 if ComponentUnit.Component=nil then exit(false); 5605 if CheckHasDesigner 5606 and (uifComponentUsedByDesigner in ComponentUnit.Flags) then 5607 exit(true); 5608 if (uifComponentIndirectlyUsedByDesigner in ComponentUnit.Flags) then 5609 exit(true); 5610 if ComponentUnit.FindUsedByComponentDependency([ucdtAncestor])<>nil then 5611 exit(true); 5612 if ComponentUnit.FindUsedByComponentDependency([ucdtInlineClass])<>nil then 5613 exit(true); 5614 Result:=false; 5615end; 5616 5617function TProject.UnitInfoWithFilename(const AFilename: string): TUnitInfo; 5618var 5619 i: Integer; 5620begin 5621 i:=IndexOfFilename(AFilename); 5622 if i>=0 then 5623 Result:=Units[i] 5624 else 5625 Result:=nil; 5626end; 5627 5628function TProject.UnitInfoWithFilename(const AFilename: string; 5629 SearchFlags: TProjectFileSearchFlags): TUnitInfo; 5630 5631 function MakeFilenameComparable(const TheFilename: string): string; 5632 begin 5633 Result:=TheFilename; 5634 if (pfsfResolveFileLinks in SearchFlags) 5635 and FilenameIsAbsolute(Result) then 5636 Result:=GetPhysicalFilenameCached(Result,false); 5637 end; 5638 5639 function FindFileInList(ListType: TUnitInfoList): TUnitInfo; 5640 var 5641 BaseFilename: String; 5642 CurBaseFilename: String; 5643 begin 5644 BaseFilename:=MakeFilenameComparable(AFilename); 5645 Result:=fFirst[ListType]; 5646 while Result<>nil do begin 5647 CurBaseFilename:=MakeFilenameComparable(Result.Filename); 5648 if CompareFilenames(BaseFilename,CurBaseFilename)=0 then exit; 5649 Result:=Result.fNext[ListType]; 5650 end; 5651 end; 5652 5653var 5654 i: Integer; 5655begin 5656 if (SearchFlags-[pfsfResolveFileLinks]=[pfsfOnlyEditorFiles]) then 5657 // search only in list of Files with EditorIndex 5658 // There is a list, so we can search much faster 5659 Result:=FindFileInList(uilWithEditorIndex) 5660 else if (SearchFlags-[pfsfResolveFileLinks]=[pfsfOnlyProjectFiles]) then 5661 // search only in list of project files 5662 // There is a list, so we can search much faster 5663 Result:=FindFileInList(uilPartOfProject) 5664 else begin 5665 // slow search 5666 i:=IndexOfFilename(AFilename,SearchFlags); 5667 if i>=0 then 5668 Result:=Units[i] 5669 else 5670 Result:=nil; 5671 end; 5672end; 5673 5674function TProject.UnitWithUnitname(const AnUnitname: string): TUnitInfo; 5675var 5676 i: Integer; 5677begin 5678 i:=IndexOfUnitWithName(AnUnitName,true,nil); 5679 if i>=0 then 5680 Result:=Units[i] 5681 else 5682 Result:=nil; 5683end; 5684 5685function TProject.AllEditorsInfoCount: Integer; 5686begin 5687 Result := FAllEditorsInfoList.Count; 5688end; 5689 5690function TProject.EditorInfoWithEditorComponent(AEditor: TSourceEditorInterface): TUnitEditorInfo; 5691begin 5692 Result := Nil; 5693 FAllEditorsInfoMap.GetData(AEditor, Result); 5694end; 5695 5696procedure TProject.EditorInfoAdd(EdInfo: TUnitEditorInfo); 5697begin 5698 FAllEditorsInfoList.Add(EdInfo); 5699 Assert(not Assigned(EdInfo.EditorComponent), 5700 'TUnitEditorInfo.EditorComponent should not be assigned. It is set later.'); 5701end; 5702 5703procedure TProject.EditorInfoRemove(EdInfo: TUnitEditorInfo); 5704begin 5705 FAllEditorsInfoList.Remove(EdInfo); 5706 if Assigned(EdInfo.EditorComponent) then 5707 FAllEditorsInfoMap.Delete(EdInfo.EditorComponent); 5708end; 5709 5710procedure TProject.OnMacroEngineSubstitution(TheMacro: TTransferMacro; 5711 const MacroName: string; var s: string; const Data: PtrInt; var Handled, 5712 Abort: boolean; Depth: integer); 5713var 5714 Values: TCTCfgScriptVariables; 5715 Macro: PCTCfgScriptVariable; 5716var 5717 NewValue: String; 5718begin 5719 if Data=CompilerOptionMacroPlatformIndependent then 5720 begin 5721 NewValue:=GetMakefileMacroValue(MacroName); 5722 if NewValue<>'' then begin 5723 s:=NewValue; 5724 Handled:=true; 5725 exit; 5726 end; 5727 end; 5728 5729 // check build macros 5730 if IsValidIdent(MacroName) then 5731 begin 5732 Values:=GetBuildMacroValues(CompilerOptions,true); 5733 if Values<>nil then begin 5734 Macro:=Values.GetVariable(PChar(MacroName)); 5735 if Macro<>nil then 5736 begin 5737 s:=GetCTCSVariableAsString(Macro); 5738 //debugln(['TProject.OnMacroEngineSubstitution Macro=',MacroName,' Value="',s,'"']); 5739 Handled:=true; 5740 exit; 5741 end; 5742 end; 5743 end; 5744 5745 // check local macros 5746 5747 // check global macros 5748 GlobalMacroList.ExecuteMacro(MacroName,s,Data,Handled,Abort,Depth); 5749end; 5750 5751function TProject.SearchFile(const ShortFilename: string; 5752 SearchFlags: TSearchIDEFileFlags): TUnitInfo; 5753var 5754 SearchedFilename: String; 5755 5756 function FilenameFits(AFilename: string): boolean; 5757 begin 5758 if siffIgnoreExtension in SearchFlags then 5759 AFileName:=ExtractFilenameOnly(AFileName); 5760 if FilenameIsAbsolute(AFileName) then 5761 AFileName:=ExtractFilename(AFileName); 5762 if siffCaseSensitive in SearchFlags then 5763 Result:=SearchedFilename=AFilename 5764 else // check Pascal case insensitivity (CompareText, do not use CompareFilenamesIgnoreCase, because of Turkish I) 5765 Result:=CompareText(SearchedFilename,AFilename)=0; 5766 end; 5767 5768begin 5769 SearchedFilename:=ShortFilename; 5770 if siffIgnoreExtension in SearchFlags then 5771 SearchedFilename:=ExtractFilenameOnly(SearchedFilename); 5772 5773 // search in files which are part of the project 5774 Result:=FirstPartOfProject; 5775 while Result<>nil do begin 5776 if FilenameFits(Result.Filename) then exit; 5777 Result:=Result.NextPartOfProject; 5778 end; 5779 // search in files opened in editor 5780 if not (siffDoNotCheckOpenFiles in SearchFlags) then begin 5781 Result:=FirstUnitWithEditorIndex; 5782 while Result<>nil do begin 5783 if FilenameFits(Result.Filename) then exit; 5784 Result:=Result.NextUnitWithEditorIndex; 5785 end; 5786 end; 5787end; 5788 5789function TProject.FindFile(const AFilename: string; 5790 SearchFlags: TProjectFileSearchFlags): TLazProjectFile; 5791begin 5792 Result:=UnitInfoWithFilename(AFilename, SearchFlags); 5793end; 5794 5795function TProject.UpdateIsPartOfProjectFromMainUnit: TModalResult; 5796var 5797 FoundInUnits, MissingInUnits, NormalUnits: TStrings; 5798 i: Integer; 5799 Code: TCodeBuffer; 5800 CurFilename: String; 5801 AnUnitInfo, NewUnitInfo: TUnitInfo; 5802begin 5803 if (MainUnitID<0) or (MainUnitInfo.Source=nil) 5804 or ([pfMainUnitIsPascalSource,pfMainUnitHasUsesSectionForAllUnits]*Flags 5805 <>[pfMainUnitIsPascalSource,pfMainUnitHasUsesSectionForAllUnits]) 5806 then 5807 exit(mrOk); 5808 try 5809 if CodeToolBoss.FindDelphiProjectUnits(MainUnitInfo.Source,FoundInUnits, 5810 MissingInUnits, NormalUnits, true) 5811 then 5812 Result:=mrOk 5813 else 5814 Result:=mrCancel; 5815 if FoundInUnits<>nil then begin 5816 for i:=0 to FoundInUnits.Count-1 do begin 5817 Code:=FoundInUnits.Objects[i] as TCodeBuffer; 5818 CurFilename:=Code.Filename; 5819 AnUnitInfo:=UnitInfoWithFilename(CurFilename); 5820 if (AnUnitInfo<>nil) and AnUnitInfo.IsPartOfProject then continue; 5821 if ConsoleVerbosity>=0 then 5822 debugln(['Note: (lazarus) [TProject.UpdateIsPartOfProjectFromMainUnit] used unit ',FoundInUnits[i],' not marked in lpi. Setting IsPartOfProject flag.']); 5823 if AnUnitInfo=nil then begin 5824 NewUnitInfo:=TUnitInfo.Create(nil); 5825 NewUnitInfo.Filename:=CurFilename; 5826 NewUnitInfo.IsPartOfProject:=true; 5827 NewUnitInfo.Source:=Code; 5828 AddFile(NewUnitInfo,false); 5829 end else 5830 AnUnitInfo.IsPartOfProject:=true; 5831 end; 5832 end; 5833 finally 5834 FoundInUnits.Free; 5835 MissingInUnits.Free; 5836 NormalUnits.Free; 5837 end; 5838end; 5839 5840function TProject.IndexOfFilename(const AFilename: string): integer; 5841begin 5842 Result:=UnitCount-1; 5843 while (Result>=0) do begin 5844 if CompareFilenames(AFilename,Units[Result].Filename)=0 then exit; 5845 dec(Result); 5846 end; 5847end; 5848 5849function TProject.IndexOfFilename(const AFilename: string; 5850 SearchFlags: TProjectFileSearchFlags): integer; 5851 5852 function MakeFilenameComparable(const TheFilename: string): string; 5853 begin 5854 Result:=TheFilename; 5855 if (pfsfResolveFileLinks in SearchFlags) 5856 and (FilenameIsAbsolute(Result)) then 5857 Result:=GetPhysicalFilenameCached(Result,false); 5858 end; 5859 5860var 5861 BaseFilename: String; 5862 CurBaseFilename: String; 5863begin 5864 BaseFilename:=MakeFilenameComparable(AFilename); 5865 Result:=UnitCount-1; 5866 while (Result>=0) do begin 5867 if (pfsfOnlyEditorFiles in SearchFlags) 5868 and (Units[Result].OpenEditorInfoCount = 0) then begin 5869 dec(Result); 5870 continue; 5871 end; 5872 if (pfsfOnlyVirtualFiles in SearchFlags) 5873 and (not Units[Result].IsVirtual) then begin 5874 dec(Result); 5875 continue; 5876 end; 5877 if (pfsfOnlyProjectFiles in SearchFlags) 5878 and (not Units[Result].IsPartOfProject) then begin 5879 dec(Result); 5880 continue; 5881 end; 5882 CurBaseFilename:=MakeFilenameComparable(Units[Result].Filename); 5883 if CompareFilenames(BaseFilename,CurBaseFilename)=0 then exit; 5884 dec(Result); 5885 end; 5886end; 5887 5888function TProject.ProjectUnitWithFilename(const AFilename: string): TUnitInfo; 5889begin 5890 Result:=fFirst[uilPartOfProject]; 5891 while Result<>nil do begin 5892 if CompareFileNames(AFilename,Result.Filename)=0 then exit; 5893 Result:=Result.fNext[uilPartOfProject]; 5894 end; 5895end; 5896 5897function TProject.ProjectUnitWithShortFilename(const ShortFilename: string): TUnitInfo; 5898begin 5899 Result:=fFirst[uilPartOfProject]; 5900 while Result<>nil do begin 5901 if CompareFileNames(ShortFilename,ExtractFilename(Result.Filename))=0 then 5902 exit; 5903 Result:=Result.fNext[uilPartOfProject]; 5904 end; 5905end; 5906 5907function TProject.ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo; 5908begin 5909 Result:=fFirst[uilPartOfProject]; 5910 while Result<>nil do begin 5911 if CompareText(AnUnitName,Result.Unit_Name)=0 then exit; 5912 Result:=Result.fNext[uilPartOfProject]; 5913 end; 5914end; 5915 5916procedure TProject.UpdateFileBuffer; 5917begin 5918 fProjectInfoFileBuffer:=CodeToolBoss.LoadFile(ProjectInfoFile,true,true); 5919 fProjectInfoFileDate:=FileAgeCached(ProjectInfoFile); 5920 if fProjectInfoFileBuffer<>nil then 5921 fProjectInfoFileBufChangeStamp:=fProjectInfoFileBuffer.ChangeStep 5922 else 5923 fProjectInfoFileBufChangeStamp:=CTInvalidChangeStamp; 5924end; 5925 5926procedure TProject.UpdateProjectDirectory; 5927var 5928 i: Integer; 5929begin 5930 if fDestroying then exit; 5931 fProjectDirectory:=ExtractFilePath(fProjectInfoFile); 5932 if BuildModes<>nil then 5933 for i:=0 to BuildModes.Count-1 do 5934 BuildModes[i].CompilerOptions.BaseDirectory:=fProjectDirectory; 5935 if fProjectDirectory<>fProjectDirectoryReferenced then begin 5936 if fProjectDirectoryReferenced<>'' then 5937 FSourceDirectories.RemoveFilename(fProjectDirectoryReferenced); 5938 if fProjectDirectory<>'' then 5939 FSourceDirectories.AddFilename(fProjectDirectory); 5940 fProjectDirectoryReferenced:=fProjectDirectory; 5941 end; 5942end; 5943 5944procedure TProject.UpdateSessionFilename; 5945begin 5946 case SessionStorage of 5947 pssInProjectInfo: ProjectSessionFile:=ProjectInfoFile; 5948 pssInProjectDir: ProjectSessionFile:=ChangeFileExt(ProjectInfoFile,'.lps'); 5949 pssInIDEConfig: ProjectSessionFile:=AppendPathDelim(GetProjectSessionsConfigPath) 5950 +ExtractFileNameOnly(ProjectInfoFile)+'.lps'; 5951 pssNone: ProjectSessionFile:=''; 5952 end; 5953end; 5954 5955procedure TProject.UpdateSourceDirectories; 5956var 5957 Cnt: Integer; 5958 i: Integer; 5959 AnUnitInfo: TUnitInfo; 5960begin 5961 Cnt:=FUnitList.Count; 5962 for i:=0 to Cnt-1 do begin 5963 AnUnitInfo:=Units[i]; 5964 AnUnitInfo.FSourceDirectoryReferenced:=false; 5965 end; 5966 ClearSourceDirectories; 5967 for i:=0 to Cnt-1 do begin 5968 AnUnitInfo:=Units[i]; 5969 AnUnitInfo.AutoReferenceSourceDir:=true; 5970 AnUnitInfo.UpdateSourceDirectoryReference; 5971 end; 5972 //DebugLn('TProject.UpdateSourceDirectories B ',UnitCount,' "',fSourceDirectories.CreateSearchPathFromAllFiles,'"'); 5973end; 5974 5975procedure TProject.UpdateUsageCounts(const ConfigFilename: string); 5976var 5977 UnitUsageCount: TDateTime; 5978 DiffTime: TDateTime; 5979 i: Integer; 5980begin 5981 UnitUsageCount:=0; 5982 if CompareFileNames(ConfigFilename,fLastReadLPIFilename)=0 then begin 5983 DiffTime:=Now-fLastReadLPIFileDate; 5984 if DiffTime>0 then 5985 UnitUsageCount:= DiffTime*24; // one step every hour 5986 fLastReadLPIFileDate:=Now; 5987 end; 5988 for i:=0 to UnitCount-1 do begin 5989 if Units[i].IsPartOfProject then 5990 Units[i].UpdateUsageCount(uuIsPartOfProject,UnitUsageCount) 5991 else if Units[i].Loaded then 5992 Units[i].UpdateUsageCount(uuIsLoaded,UnitUsageCount) 5993 else 5994 Units[i].UpdateUsageCount(uuNotUsed,UnitUsageCount); 5995 end; 5996end; 5997 5998function TProject.UnitMustBeSaved(UnitInfo: TUnitInfo; WriteFlags: TProjectWriteFlags; 5999 SaveSession: boolean): boolean; 6000begin 6001 Result:=false; 6002 if not UnitInfo.IsPartOfProject then begin 6003 if not SaveSession then exit; 6004 if (pfSaveOnlyProjectUnits in Flags) then exit; 6005 if (pwfSaveOnlyProjectUnits in WriteFlags) then exit; 6006 if (not UnitInfo.Loaded) then begin 6007 if (not (pfSaveClosedUnits in Flags)) then exit; 6008 if (pwfSkipClosedUnits in WriteFlags) then exit; 6009 if UnitInfo.fUsageCount<=0 then exit; 6010 end; 6011 end; 6012 Result:=true; 6013end; 6014 6015procedure TProject.UpdateVisibleEditor(PgIndex: integer); 6016var 6017 i: Integer; 6018begin 6019 i := AllEditorsInfoCount - 1; 6020 while i >= 0 do begin 6021 if (AllEditorsInfo[i].PageIndex = PgIndex) then 6022 AllEditorsInfo[i].IsVisibleTab := True; 6023 dec(i); 6024 end; 6025end; 6026 6027procedure TProject.LoadDefaultSession; 6028var 6029 AnUnitInfo: TUnitInfo; 6030 BestUnitInfo: TUnitInfo; 6031begin 6032 BestUnitInfo:=FirstUnitWithEditorIndex; 6033 if (BestUnitInfo<>nil) and (BestUnitInfo.Loaded) 6034 and FileExistsCached(BestUnitInfo.Filename) then 6035 exit; 6036 BestUnitInfo:=nil; 6037 6038 if (MainUnitID>=0) then begin 6039 if Requires(PackageGraph.LCLPackage,true) 6040 and (Flags*[pfMainUnitHasCreateFormStatements,pfMainUnitHasTitleStatement,pfMainUnitHasScaledStatement]<>[]) 6041 then begin 6042 // this is a probably a LCL project where the main source only contains 6043 // automatic code 6044 end else 6045 BestUnitInfo:=MainUnitInfo; 6046 end; 6047 6048 if BestUnitInfo=nil then begin 6049 AnUnitInfo:=FirstPartOfProject; 6050 while AnUnitInfo<>nil do begin 6051 if FileExistsCached(AnUnitInfo.Filename) then begin 6052 if (BestUnitInfo=nil) 6053 or (FilenameHasPascalExt(AnUnitInfo.Filename) 6054 and (not FilenameHasPascalExt(BestUnitInfo.Filename))) 6055 then begin 6056 BestUnitInfo:=AnUnitInfo; 6057 end; 6058 end; 6059 AnUnitInfo:=AnUnitInfo.NextPartOfProject; 6060 end; 6061 end; 6062 if BestUnitInfo<>nil then begin 6063 BestUnitInfo.EditorInfo[0].PageIndex := 0; 6064 BestUnitInfo.EditorInfo[0].WindowID := 0; 6065 BestUnitInfo.EditorInfo[0].IsVisibleTab := True; 6066 ActiveWindowIndexAtStart:=0; 6067 BestUnitInfo.Loaded:=true; 6068 end; 6069end; 6070 6071procedure TProject.ClearSourceDirectories; 6072begin 6073 FSourceDirectories.Clear; 6074 fProjectDirectoryReferenced:=''; 6075 if MainProject then 6076 FSourceDirectories.AddFilename(VirtualDirectory); 6077 if (fProjectDirectory<>'') then begin 6078 FSourceDirectories.AddFilename(fProjectDirectory); 6079 fProjectDirectoryReferenced:=fProjectDirectory; 6080 end; 6081end; 6082 6083procedure TProject.SourceDirectoriesChanged(Sender: TObject); 6084begin 6085 FDefineTemplates.SourceDirectoriesChanged; 6086end; 6087 6088function TProject.GetDefineTemplates: TProjPackDefineTemplates; 6089begin 6090 Result:=FDefineTemplates; 6091end; 6092 6093function TProject.GetMainFile: TLazProjectFile; 6094begin 6095 Result:=MainUnitInfo; 6096end; 6097 6098function TProject.GetMainFileID: Integer; 6099begin 6100 Result:=MainUnitID; 6101end; 6102 6103procedure TProject.SetMainFileID(const AValue: Integer); 6104begin 6105 MainUnitID:=AValue; 6106end; 6107 6108function TProject.GetLazBuildModes: TLazProjectBuildModes; 6109begin 6110 Result:=FBuildModes; 6111end; 6112 6113procedure TProject.AddToList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList); 6114begin 6115 // add to list if AnUnitInfo is not in list 6116 if (fFirst[ListType]<>AnUnitInfo) 6117 and (AnUnitInfo.fNext[ListType]=nil) 6118 and (AnUnitInfo.fPrev[ListType]=nil) then begin 6119 AnUnitInfo.fPrev[ListType]:=fLast[ListType]; 6120 AnUnitInfo.fNext[ListType]:=nil; 6121 if fFirst[ListType]=nil then 6122 fFirst[ListType]:=AnUnitInfo 6123 else 6124 fLast[ListType].fNext[ListType]:=AnUnitInfo; 6125 fLast[ListType]:=AnUnitInfo; 6126 end; 6127end; 6128 6129procedure TProject.RemoveFromList(AnUnitInfo: TUnitInfo; ListType: TUnitInfoList); 6130begin 6131 // remove from list if AnUnitInfo is in list 6132 if fFirst[ListType]=AnUnitInfo then 6133 fFirst[ListType]:=AnUnitInfo.fNext[ListType]; 6134 if fLast[ListType]=AnUnitInfo then 6135 fLast[ListType]:=AnUnitInfo.fPrev[ListType]; 6136 if AnUnitInfo.fNext[ListType]<>nil then 6137 AnUnitInfo.fNext[ListType].fPrev[ListType]:=AnUnitInfo.fPrev[ListType]; 6138 if AnUnitInfo.fPrev[ListType]<>nil then 6139 AnUnitInfo.fPrev[ListType].fNext[ListType]:=AnUnitInfo.fNext[ListType]; 6140 AnUnitInfo.fNext[ListType]:=nil; 6141 AnUnitInfo.fPrev[ListType]:=nil; 6142end; 6143 6144{ TProjectCompilationToolOptions } 6145 6146constructor TProjectCompilationToolOptions.Create(TheOwner: TLazCompilerOptions); 6147begin 6148 inherited Create(TheOwner); 6149 FDefaultCompileReasons:=crAll; 6150end; 6151 6152function TProjectCompilationToolOptions.CreateDiff( 6153 CompOpts: TCompilationToolOptions; Tool: TCompilerDiffTool): boolean; 6154begin 6155 Assert(Assigned(Tool),'TProjectCompilationToolOptions.CreateDiff: Tool=Nil.'); 6156 Result:=AddCompileReasonsDiff('CompileReasons', CompileReasons, 6157 CompOpts.CompileReasons, Tool); 6158 if Result then exit; 6159 if inherited CreateDiff(CompOpts, Tool) then Result:=true; 6160end; 6161 6162procedure TProjectCompilationToolOptions.LoadFromXMLConfig(XMLConfig: TXMLConfig; 6163 const Path: string; DoSwitchPathDelims: boolean); 6164begin 6165 inherited LoadFromXMLConfig(XMLConfig, Path, DoSwitchPathDelims); 6166 CompileReasons := LoadXMLCompileReasons(XMLConfig, Path+'CompileReasons/', 6167 DefaultCompileReasons); 6168 //debugln(['TProjectCompilationToolOptions.LoadFromXMLConfig ',Path,' ',crCompile in CompileReasons]); 6169end; 6170 6171procedure TProjectCompilationToolOptions.SaveToXMLConfig(XMLConfig: TXMLConfig; 6172 const Path: string; UsePathDelim: TPathDelimSwitch); 6173begin 6174 inherited SaveToXMLConfig(XMLConfig, Path, UsePathDelim); 6175 SaveXMLCompileReasons(XMLConfig, Path+'CompileReasons/', CompileReasons, 6176 DefaultCompileReasons); 6177 //debugln(['TProjectCompilationToolOptions.SaveToXMLConfig ',Path,' ',crCompile in CompileReasons]); 6178end; 6179 6180function TProjectCompilationToolOptions.GetProject: TProject; 6181begin 6182 if (Owner is TProjectCompilerOptions) then 6183 Result:=TProjectCompilerOptions(Owner).LazProject 6184 else 6185 Result:=nil; 6186end; 6187 6188procedure TProjectCompilationToolOptions.SetCompileReasons(const AValue: TCompileReasons); 6189begin 6190 if FCompileReasons=AValue then exit; 6191 FCompileReasons:=AValue; 6192 Owner.IncreaseChangeStamp; 6193end; 6194 6195procedure TProjectCompilationToolOptions.SetDefaultCompileReasons(const AValue: TCompileReasons); 6196begin 6197 if FDefaultCompileReasons=AValue then exit; 6198 FDefaultCompileReasons:=AValue; 6199 Owner.IncreaseChangeStamp; 6200end; 6201 6202procedure TProjectCompilationToolOptions.SubstituteMacros(var s: string); 6203var 6204 CompOpts: TProjectCompilerOptions; 6205begin 6206 if Owner is TProjectCompilerOptions then begin 6207 CompOpts:=TProjectCompilerOptions(Owner); 6208 //debugln(['TProjectCompilationToolOptions.SubstituteMacros ',DbgSName(Owner),' ',CompOpts.LazProject<>nil]); 6209 s:=CompOpts.SubstituteProjectMacros(s,false); 6210 end else 6211 inherited SubstituteMacros(s); 6212end; 6213 6214{ TProjectCompilerOptions } 6215 6216procedure TProjectCompilerOptions.LoadFromXMLConfig(AXMLConfig: TXMLConfig; 6217 const Path: string); 6218begin 6219 inherited LoadFromXMLConfig(AXMLConfig,Path); 6220 //FileVersion:=aXMLConfig.GetValue(Path+'Version/Value', 0); 6221 FCompileReasons := LoadXMLCompileReasons(AXMLConfig,Path+'CompileReasons/',crAll); 6222end; 6223 6224procedure TProjectCompilerOptions.SaveToXMLConfig(AXMLConfig: TXMLConfig; 6225 const Path: string); 6226begin 6227 inherited SaveToXMLConfig(AXMLConfig,Path); 6228 SaveXMLCompileReasons(AXMLConfig, Path+'CompileReasons/', FCompileReasons, crAll); 6229end; 6230 6231procedure TProjectCompilerOptions.SetTargetCPU(const AValue: string); 6232begin 6233 inherited SetTargetCPU(AValue); 6234end; 6235 6236procedure TProjectCompilerOptions.SetTargetOS(const AValue: string); 6237begin 6238 inherited SetTargetOS(AValue); 6239end; 6240 6241procedure TProjectCompilerOptions.SetCustomOptions(const AValue: string); 6242begin 6243 if CustomOptions=AValue then exit; 6244 inherited SetCustomOptions(AValue); 6245 if IsActive then 6246 LazProject.DefineTemplates.CustomDefinesChanged; 6247end; 6248 6249procedure TProjectCompilerOptions.SetIncludePaths(const AValue: string); 6250begin 6251 if IncludePath=AValue then exit; 6252 inherited SetIncludePaths(AValue); 6253end; 6254 6255procedure TProjectCompilerOptions.SetLibraryPaths(const AValue: string); 6256begin 6257 if Libraries=AValue then exit; 6258 inherited SetLibraryPaths(AValue); 6259end; 6260 6261procedure TProjectCompilerOptions.SetLinkerOptions(const AValue: string); 6262begin 6263 if LinkerOptions=AValue then exit; 6264 inherited SetLinkerOptions(AValue); 6265end; 6266 6267procedure TProjectCompilerOptions.SetNamespaces(const AValue: string); 6268begin 6269 if Namespaces=AValue then exit; 6270 inherited SetNamespaces(AValue); 6271end; 6272 6273procedure TProjectCompilerOptions.SetObjectPath(const AValue: string); 6274begin 6275 if ObjectPath=AValue then exit; 6276 inherited SetObjectPath(AValue); 6277end; 6278 6279procedure TProjectCompilerOptions.SetSrcPath(const AValue: string); 6280begin 6281 if SrcPath=AValue then exit; 6282 inherited SetSrcPath(AValue); 6283end; 6284 6285procedure TProjectCompilerOptions.SetUnitPaths(const AValue: string); 6286begin 6287 if OtherUnitFiles=AValue then exit; 6288 inherited SetUnitPaths(AValue); 6289end; 6290 6291procedure TProjectCompilerOptions.SetUnitOutputDir(const AValue: string); 6292begin 6293 if UnitOutputDirectory=AValue then exit; 6294 inherited SetUnitOutputDir(AValue); 6295 if IsActive then 6296 LazProject.DefineTemplates.OutputDirectoryChanged; 6297end; 6298 6299procedure TProjectCompilerOptions.SetConditionals(AValue: string); 6300begin 6301 AValue:=UTF8Trim(AValue,[]); 6302 if Conditionals=AValue then exit; 6303 inherited SetConditionals(AValue); 6304end; 6305 6306function TProjectCompilerOptions.SubstituteProjectMacros(const s: string; 6307 PlatformIndependent: boolean): string; 6308begin 6309 Result:=s; 6310 if LazProject=nil then exit; 6311 //debugln(['TProjectCompilerOptions.SubstituteProjectMacros s="',s,'"']); 6312 if PlatformIndependent then begin 6313 if not LazProject.MacroEngine.SubstituteStr(Result,CompilerOptionMacroPlatformIndependent) 6314 then 6315 debugln(['TProjectCompilerOptions.SubstituteProjectMacros failed: "',CompilerOptionMacroPlatformIndependent,'"']); 6316 end 6317 else begin 6318 if not LazProject.MacroEngine.SubstituteStr(Result,CompilerOptionMacroNormal) 6319 then 6320 debugln(['TProjectCompilerOptions.SubstituteProjectMacros failed: "',CompilerOptionMacroNormal,'"']); 6321 end; 6322end; 6323 6324procedure TProjectCompilerOptions.Assign(Source: TPersistent); 6325var 6326 ProjCompOptions: TProjectCompilerOptions; 6327begin 6328 inherited Assign(Source); 6329 if Source is TProjectCompilerOptions then begin 6330 ProjCompOptions:=TProjectCompilerOptions(Source); 6331 FCompileReasons:=ProjCompOptions.FCompileReasons; 6332 end else begin 6333 FCompileReasons:=[crCompile, crBuild, crRun]; 6334 // keep BuildModes 6335 end; 6336end; 6337 6338function TProjectCompilerOptions.CreateDiff(CompOpts: TBaseCompilerOptions; 6339 Tool: TCompilerDiffTool): boolean; 6340begin 6341 //if Tool<>nil then debugln(['TProjectCompilerOptions.CreateDiff ',DbgSName(Self)]); 6342 if (CompOpts is TProjectCompilerOptions) then begin 6343 Result:=AddCompileReasonsDiff('CompileReasons',FCompileReasons, 6344 TProjectCompilerOptions(CompOpts).FCompileReasons,Tool); 6345 end else begin 6346 Result:=true; 6347 if Tool<>nil then Tool.Differ:=true; 6348 end; 6349 //if Tool<>nil then debugln(['TProjectCompilerOptions.CreateDiff Before inherited ',Result]); 6350 if (Tool=nil) and Result then exit; 6351 if (inherited CreateDiff(CompOpts, Tool)) then 6352 Result:=true; 6353end; 6354 6355procedure TProjectCompilerOptions.BeforeReadExec(Sender: TObject); 6356begin 6357 if LazProject<>nil then 6358 LazProject.BackupBuildModes; 6359end; 6360 6361procedure TProjectCompilerOptions.AfterWriteExec(Sender: TObject; Restore: boolean); 6362begin 6363 if Restore and (LazProject<>nil) then 6364 LazProject.RestoreBuildModes; 6365end; 6366 6367procedure TProjectCompilerOptions.SetAlternativeCompile(const Command: string; 6368 ScanFPCMsgs: boolean); 6369begin 6370 inherited SetAlternativeCompile(Command, ScanFPCMsgs); 6371 CompileReasons:=[]; 6372end; 6373 6374class function TProjectCompilerOptions.GetInstance: TAbstractIDEOptions; 6375begin 6376 Result := Project1.CompilerOptions; 6377end; 6378 6379class function TProjectCompilerOptions.GetGroupCaption: string; 6380begin 6381 Result := dlgCompilerOptions; 6382end; 6383 6384constructor TProjectCompilerOptions.Create(const AOwner: TObject); 6385begin 6386 FCompileReasons := crAll; 6387 inherited Create(AOwner, TProjectCompilationToolOptions); 6388 if AOwner <> nil then 6389 FProject := AOwner as TProject; 6390 ParsedOpts.OnLocalSubstitute:=@SubstituteProjectMacros; 6391 OnAfterWrite:=@AfterWriteExec; 6392 OnBeforeRead:=@BeforeReadExec; 6393end; 6394 6395destructor TProjectCompilerOptions.Destroy; 6396begin 6397 inherited Destroy; 6398end; 6399 6400function TProjectCompilerOptions.IsActive: boolean; 6401begin 6402 Result:=(LazProject<>nil) 6403 and not LazProject.BuildModes.Assigning 6404 and (LazProject.CompilerOptions=Self); 6405end; 6406 6407procedure TProjectCompilerOptions.Clear; 6408begin 6409 inherited Clear; 6410end; 6411 6412function TProjectCompilerOptions.CanBeDefaulForProject: boolean; 6413begin 6414 Result:=true; 6415end; 6416 6417function TProjectCompilerOptions.GetOwnerName: string; 6418begin 6419 Result:=LazProject.GetTitleOrName; 6420 if Result='' then Result:=ExtractFilename(LazProject.ProjectInfoFile); 6421end; 6422 6423function TProjectCompilerOptions.GetDefaultMainSourceFileName: string; 6424var 6425 MainUnitInfo: TUnitInfo; 6426begin 6427 MainUnitInfo:=FProject.MainUnitInfo; 6428 if (MainUnitInfo<>nil) then 6429 Result:=ExtractFileName(MainUnitInfo.Filename) 6430 else 6431 Result:=''; 6432 if Result='' then 6433 Result:=inherited GetDefaultMainSourceFileName; 6434end; 6435 6436procedure TProjectCompilerOptions.GetInheritedCompilerOptions( 6437 var OptionsList: TFPList); 6438var 6439 PkgList: TFPList; 6440 ReqFlags: TPkgIntfRequiredFlags; 6441begin 6442 PkgList:=nil; 6443 try 6444 ReqFlags:=[]; 6445 if not (pfUseDesignTimePackages in LazProject.Flags) then 6446 Include(ReqFlags,pirSkipDesignTimeOnly); 6447 LazProject.GetAllRequiredPackages(PkgList,ReqFlags); 6448 OptionsList:=GetUsageOptionsList(PkgList); 6449 finally 6450 PkgList.Free; 6451 end; 6452end; 6453 6454{ TProjectDefineTemplates } 6455 6456constructor TProjectDefineTemplates.Create(AOwner: IProjPack); 6457begin 6458 inherited Create(AOwner); 6459end; 6460 6461destructor TProjectDefineTemplates.Destroy; 6462begin 6463 inherited Destroy; 6464end; 6465 6466procedure TProjectDefineTemplates.UpdateMain; 6467begin 6468 if (Owner as TProject).Destroying then exit; 6469 // update the package block define template (the container for all other 6470 // define templates of the project) 6471 if FMain=nil then begin 6472 // create the main project template 6473 FMain:=CreateProjectTemplateWithID(Owner.IDAsWord); 6474 FMain.SetDefineOwner(Owner as TProject,false); 6475 FMain.SetFlags([dtfAutoGenerated],[],false); 6476 end else 6477 FMain.Name:=Owner.IDAsWord; 6478 // ClearCache is here unnessary, because it is only a block 6479end; 6480 6481function TProjectDefineTemplates.UpdateSrcDirIfDef: Boolean; 6482// Returns the changed state 6483var 6484 NamespacesDefTempl: TDefineTemplate; 6485 UnitPathDefTempl: TDefineTemplate; 6486 IncPathDefTempl: TDefineTemplate; 6487 SrcPathDefTempl: TDefineTemplate; 6488 IfValue: String; 6489begin 6490 // The options are enclosed by an 6491 // IFDEF #ProjectSrcMark<PckId> template. 6492 // Each source directory defines this variable, so that the settings can be 6493 // activated for each source directory by a simple DEFINE. 6494 if (FMain=nil) then UpdateMain; 6495 if FSrcDirectories=nil then begin 6496 FSrcDirectories:=TDefineTemplate.Create('Source Directories', 6497 'Source Directories','','', 6498 da_Block); 6499 FMain.AddChild(FSrcDirectories); 6500 end; 6501 6502 Result:=false; 6503 IfValue:='defined(#ProjectSrcMark'+Owner.IDAsWord+')'; 6504 if (Owner as TProject) = Project1 then 6505 IfValue:=IfValue+' or defined('+UseDefaultsFlagName+')'; 6506 if FSrcDirIf=nil then begin 6507 FSrcDirIf:=TDefineTemplate.Create('Source Directory Additions', 6508 'Additional defines for project source directories and all directories using defaults', 6509 '',IfValue, 6510 da_If); 6511 FMain.AddChild(FSrcDirIf); 6512 6513 // create namespaces template for this directory 6514 NamespacesDefTempl:=TDefineTemplate.Create('Namespaces', lisPkgDefsNamespaces, 6515 NamespacesMacroName,NamespacesMacro+';$ProjectNamespaces('+Owner.IDAsString+')', 6516 da_Define); 6517 FSrcDirIf.AddChild(NamespacesDefTempl); 6518 6519 // create unit path template for this directory 6520 UnitPathDefTempl:=TDefineTemplate.Create('UnitPath', lisPkgDefsUnitPath, 6521 UnitPathMacroName,UnitPathMacro+';$ProjectUnitPath('+Owner.IDAsString+')', 6522 da_Define); 6523 FSrcDirIf.AddChild(UnitPathDefTempl); 6524 6525 // create include path template for this directory 6526 IncPathDefTempl:=TDefineTemplate.Create('IncPath','Include Path', 6527 IncludePathMacroName,IncludePathMacro+';$ProjectIncPath('+Owner.IDAsString+')', 6528 da_Define); 6529 FSrcDirIf.AddChild(IncPathDefTempl); 6530 6531 // create src path template for this directory 6532 SrcPathDefTempl:=TDefineTemplate.Create('SrcPath','Src Path', 6533 SrcPathMacroName,SrcPathMacro+';$ProjectSrcPath('+Owner.IDAsString+')', 6534 da_Define); 6535 FSrcDirIf.AddChild(SrcPathDefTempl); 6536 6537 Result:=true; 6538 end else begin 6539 if FSrcDirIf.Value<>IfValue then begin 6540 FSrcDirIf.Value:=IfValue; 6541 Result:=true; 6542 end; 6543 end; 6544end; 6545 6546procedure TProjectDefineTemplates.UpdateOutputDirectory; 6547var 6548 Proj: TProject; 6549begin 6550 Proj := Owner as TProject; 6551 //DebugLn('TProjectDefineTemplates.UpdateDefinesForOutputDirectory ',Owner.IDAsString); 6552 if (not Owner.NeedsDefineTemplates) or (not Active) then exit; 6553 if FMain=nil then UpdateMain; 6554 6555 if FOutputDir=nil then begin 6556 //DebugLn('TProjectDefineTemplates.UpdateDefinesForOutputDirectory ',Owner.IDAsString,' creating FOutputDir'); 6557 FOutputDir:=TDefineTemplate.Create(ProjectOutputDirDefTemplName, 6558 'Output directory of proj', '', Proj.GetOutputDirectory, da_Directory); 6559 FOutputDir.SetDefineOwner(Proj,false); 6560 FOutputDir.SetFlags([dtfAutoGenerated],[],false); 6561 DisableDefaultsInDirectories(FOutputDir,false); 6562 FMain.AddChild(FOutputDir); 6563 FixTemplateOrder; 6564 end else begin 6565 FOutputDir.Value:=Proj.GetOutputDirectory; 6566 end; 6567 6568 if (FOutPutSrcPath=nil) 6569 or (fLastOutputDirSrcPathIDAsString<>Owner.IDAsString) then begin 6570 fLastOutputDirSrcPathIDAsString:=Owner.IDAsString; 6571 FOutputSrcPath:=TDefineTemplate.Create('CompiledSrcPath', 6572 lisPkgDefsCompiledSrcPathAddition, CompiledSrcPathMacroName, 6573 '$ProjectSrcPath('+fLastOutputDirSrcPathIDAsString+');' 6574 +'$('+CompiledSrcPathMacroName+')', 6575 da_Define); 6576 FOutputSrcPath.SetDefineOwner(Proj,false); 6577 FOutputSrcPath.SetFlags([dtfAutoGenerated],[],false); 6578 CodeToolBoss.DefineTree.ReplaceChild(FOutputDir,FOutputSrcPath,FOutputSrcPath.Name); 6579 end; 6580end; 6581 6582procedure TProjectDefineTemplates.UpdateSourceDirectories; 6583var 6584 NewSourceDirs: TStringList; 6585 i: Integer; 6586 SrcDirDefTempl: TDefineTemplate; 6587 IDHasChanged: Boolean; 6588 SrcDirMarkDefTempl: TDefineTemplate; 6589 CurUnitPath: String; 6590begin 6591 //DebugLn('TProjectDefineTemplates.UpdateDefinesForSourceDirectories ',Owner.IDAsString,' Active=',dbgs(Active),' TimeStamp=',dbgs(fLastSourceDirStamp),' Project.TimeStamp=',dbgs(Project.SourceDirectories.TimeStamp)); 6592 if (not Owner.NeedsDefineTemplates) or (not Active) then exit; 6593 6594 // quick check if something has changed 6595 IDHasChanged:=fLastSourceDirsIDAsString<>Owner.IDAsString; 6596 CurUnitPath:=Owner.BaseCompilerOptions.ParsedOpts.GetParsedValue(pcosUnitPath); 6597 CurUnitPath:=CreateAbsoluteSearchPath(CurUnitPath, 6598 Owner.BaseCompilerOptions.BaseDirectory); 6599 6600 //DebugLn('TProjectDefineTemplates.UpdateDefinesForSourceDirectories A'); 6601 if (fLastSourceDirectories<>nil) 6602 and (fLastSourceDirStamp=Owner.SourceDirectories.TimeStamp) 6603 and (not IDHasChanged) 6604 and (CurUnitPath=fLastUnitPath) then 6605 exit; 6606 fLastSourceDirStamp:=Owner.SourceDirectories.TimeStamp; 6607 fLastSourceDirsIDAsString:=Owner.IDAsString; 6608 fLastUnitPath:=CurUnitPath; 6609 6610 NewSourceDirs:=Owner.SourceDirectories.CreateFileList; 6611 //DebugLn('TProjectDefineTemplates.UpdateDefinesForSourceDirectories B "',NewSourceDirs.Text,'"'); 6612 try 6613 MergeSearchPaths(NewSourceDirs,CurUnitPath); 6614 6615 // real check if something has changed 6616 if (fLastSourceDirectories<>nil) 6617 and (NewSourceDirs.Count=fLastSourceDirectories.Count) 6618 and (not IDHasChanged) then begin 6619 i:=NewSourceDirs.Count-1; 6620 while (i>=0) 6621 and (CompareFilenames(NewSourceDirs[i],fLastSourceDirectories[i])=0) do 6622 dec(i); 6623 if i<0 then exit; 6624 end; 6625 6626 // clear old define templates 6627 if fLastSourceDirectories<>nil then begin 6628 for i:=0 to fLastSourceDirectories.Count-1 do begin 6629 SrcDirDefTempl:=TDefineTemplate(fLastSourceDirectories.Objects[i]); 6630 SrcDirDefTempl.Unbind; 6631 SrcDirDefTempl.Free; 6632 end; 6633 fLastSourceDirectories.Clear; 6634 end else 6635 fLastSourceDirectories:=TStringList.Create; 6636 6637 // build source directory define templates 6638 fLastSourceDirectories.Assign(NewSourceDirs); 6639 if (FSrcDirIf=nil) and (fLastSourceDirectories.Count>0) then 6640 UpdateSrcDirIfDef; 6641 for i:=0 to fLastSourceDirectories.Count-1 do begin 6642 // create directory template 6643 SrcDirDefTempl:=TDefineTemplate.Create('Source Directory '+IntToStr(i+1), 6644 fLastSourceDirectories[i],'',fLastSourceDirectories[i],da_Directory); 6645 DisableDefaultsInDirectories(SrcDirDefTempl,false); 6646 fLastSourceDirectories.Objects[i]:=SrcDirDefTempl; 6647 // add proj source directory marker 6648 SrcDirMarkDefTempl:=TDefineTemplate.Create('ProjectSrcDirMark', 6649 lisProjProjectSourceDirectoryMark, '#ProjectSrcMark'+Owner.IDAsWord, 6650 '1', da_Define); 6651 SrcDirDefTempl.AddChild(SrcDirMarkDefTempl); 6652 6653 SrcDirDefTempl.SetDefineOwner(Owner as TProject, false); 6654 SrcDirDefTempl.SetFlags([dtfAutoGenerated],[],false); 6655 // add directory 6656 FSrcDirectories.AddChild(SrcDirDefTempl); 6657 end; 6658 //DebugLn('TProjectDefineTemplates.UpdateSourceDirectories: Calling CodeToolBoss.DefineTree.ClearCache'); 6659 CodeToolBoss.DefineTree.ClearCache; 6660 finally 6661 NewSourceDirs.Free; 6662 end; 6663end; 6664 6665procedure TProjectDefineTemplates.UpdateDefinesForCustomDefines; 6666var 6667 OptionsDefTempl: TDefineTemplate; 6668 NewCustomOptions: String; 6669begin 6670 if (not Owner.NeedsDefineTemplates) or (not Active) then exit; 6671 6672 // check if something has changed 6673 NewCustomOptions:=Owner.BaseCompilerOptions.GetOptionsForCTDefines; 6674 if (FLastCustomOptions=NewCustomOptions) then exit; 6675 6676 FLastCustomOptions:=NewCustomOptions; 6677 OptionsDefTempl:=CodeToolBoss.DefinePool.CreateFPCCommandLineDefines( 6678 'Custom Options', FLastCustomOptions, false, Owner as TProject); 6679 if OptionsDefTempl=nil then begin 6680 // no custom options -> delete old template 6681 if (FSrcDirIf<>nil) and FSrcDirIf.DeleteChild('Custom Options') then 6682 begin 6683 //DebugLn('TProjectDefineTemplates.UpdateDefinesForCustomDefines: Calling CodeToolBoss.DefineTree.ClearCache'); 6684 CodeToolBoss.DefineTree.ClearCache; 6685 end; 6686 end else begin 6687 UpdateSrcDirIfDef; 6688 FSrcDirIf.ReplaceChild(OptionsDefTempl); 6689 //DebugLn('TProjectDefineTemplates.UpdateDefinesForCustomDefines: Calling CodeToolBoss.DefineTree.ClearCache'); 6690 CodeToolBoss.DefineTree.ClearCache; 6691 end; 6692end; 6693 6694procedure TProjectDefineTemplates.FixTemplateOrder; 6695begin 6696 if (FSrcDirIf<>nil) then 6697 FSrcDirIf.Parent.MoveToLast(FSrcDirIf); 6698end; 6699 6700procedure TProjectDefineTemplates.ClearFlags; 6701begin 6702 FFlags:=FFlags+[ptfCustomDefinesChanged]; 6703end; 6704 6705procedure TProjectDefineTemplates.AllChanged(AActivating: boolean); 6706begin 6707 if AActivating then ; 6708 UpdateSrcDirIfDef; 6709 SourceDirectoriesChanged; 6710 CustomDefinesChanged; 6711 UpdateGlobalValues; 6712end; 6713 6714procedure TProjectDefineTemplates.UpdateGlobalValues; 6715var 6716 NewProjectDir: String; 6717 Changed: Boolean; 6718begin 6719 Changed:=false; 6720 // the LCLWidgetType, TargetCPU and TargetOS is set by the TBuildManager 6721 if (Owner as TProject).IsVirtual then 6722 NewProjectDir:=VirtualDirectory 6723 else 6724 NewProjectDir:=(Owner as TProject).Directory; 6725 if CodeToolBoss.SetGlobalValue(ExternalMacroStart+'ProjPath',NewProjectDir) 6726 then 6727 Changed:=true; 6728 if Changed then 6729 IncreaseCompilerParseStamp; 6730end; 6731 6732{ TUnitComponentDependency } 6733 6734procedure TUnitComponentDependency.SetRequiresUnit(const AValue: TUnitInfo); 6735begin 6736 if FRequiresUnit=AValue then exit; 6737 if (AValue<>nil) and (FUsedByUnit=AValue) then 6738 raise Exception.Create('TUnitComponentDependency.SetRequiresUnit inconsistency'); 6739 if FRequiresUnit<>nil then 6740 RemoveFromList(FRequiresUnit.FFirstUsedByComponent,ucdlUsedBy); 6741 FRequiresUnit:=AValue; 6742 if FRequiresUnit<>nil then 6743 AddToList(FRequiresUnit.FFirstUsedByComponent,ucdlUsedBy); 6744end; 6745 6746procedure TUnitComponentDependency.SetTypes(const AValue: TUnitCompDependencyTypes); 6747begin 6748 if AValue=FTypes then exit; 6749 FTypes:=AValue; 6750 if (not (ucdtOldProperty in FTypes)) and (FCompProps<>nil) then 6751 ClearComponentProperties; 6752end; 6753 6754function TUnitComponentDependency.GetCompPropCount: integer; 6755begin 6756 if FCompProps=nil then 6757 Result:=0 6758 else 6759 Result:=FCompProps.Count; 6760end; 6761 6762function TUnitComponentDependency.GetCompProps(Index: integer): TUCDComponentProperty; 6763begin 6764 Result:=TUCDComponentProperty(FCompProps[Index]); 6765end; 6766 6767procedure TUnitComponentDependency.SetUsedByUnit(const AValue: TUnitInfo); 6768begin 6769 if FUsedByUnit=AValue then exit; 6770 if (AValue<>nil) and (FRequiresUnit=AValue) then 6771 raise Exception.Create('TUnitComponentDependency.SetUsedByUnit inconsistency'); 6772 if FUsedByUnit<>nil then 6773 RemoveFromList(FUsedByUnit.FFirstRequiredComponent,ucdlRequires); 6774 FUsedByUnit:=AValue; 6775 if FUsedByUnit<>nil then 6776 AddToList(FUsedByUnit.FFirstRequiredComponent,ucdlRequires); 6777end; 6778 6779constructor TUnitComponentDependency.Create; 6780begin 6781 6782end; 6783 6784destructor TUnitComponentDependency.Destroy; 6785begin 6786 RequiresUnit:=nil; 6787 UsedByUnit:=nil; 6788 ClearComponentProperties; 6789 inherited Destroy; 6790end; 6791 6792procedure TUnitComponentDependency.ClearComponentProperties; 6793var 6794 i: Integer; 6795begin 6796 if FCompProps=nil then exit; 6797 for i:=0 to FCompProps.Count-1 do TObject(FCompProps[i]).Free; 6798 FreeAndNil(FCompProps); 6799end; 6800 6801function TUnitComponentDependency.NextUsedByDependency: TUnitComponentDependency; 6802begin 6803 Result:=NextDependency[ucdlUsedBy]; 6804end; 6805 6806function TUnitComponentDependency.PrevUsedByDependency: TUnitComponentDependency; 6807begin 6808 Result:=PrevDependency[ucdlUsedBy]; 6809end; 6810 6811function TUnitComponentDependency.NextRequiresDependency: TUnitComponentDependency; 6812begin 6813 Result:=NextDependency[ucdlRequires]; 6814end; 6815 6816function TUnitComponentDependency.PrevRequiresDependency: TUnitComponentDependency; 6817begin 6818 Result:=PrevDependency[ucdlRequires]; 6819end; 6820 6821procedure TUnitComponentDependency.AddToList( 6822 var FirstDependency: TUnitComponentDependency; 6823 ListType: TUnitCompDependencyList); 6824begin 6825 NextDependency[ListType]:=FirstDependency; 6826 FirstDependency:=Self; 6827 PrevDependency[ListType]:=nil; 6828 if NextDependency[ListType]<>nil then 6829 NextDependency[ListType].PrevDependency[ListType]:=Self; 6830end; 6831 6832procedure TUnitComponentDependency.RemoveFromList( 6833 var FirstDependency: TUnitComponentDependency; 6834 ListType: TUnitCompDependencyList); 6835begin 6836 if FirstDependency=Self then FirstDependency:=NextDependency[ListType]; 6837 if NextDependency[ListType]<>nil then 6838 NextDependency[ListType].PrevDependency[ListType]:=PrevDependency[ListType]; 6839 if PrevDependency[ListType]<>nil then 6840 PrevDependency[ListType].NextDependency[ListType]:=NextDependency[ListType]; 6841 NextDependency[ListType]:=nil; 6842 PrevDependency[ListType]:=nil; 6843end; 6844 6845function TUnitComponentDependency.FindUsedByPropPath( 6846 const UsedByPropPath: string): TUCDComponentProperty; 6847var 6848 i: Integer; 6849begin 6850 if FCompProps=nil then exit(nil); 6851 for i:=FCompProps.Count-1 downto 0 do begin 6852 Result:=CompProps[i]; 6853 if SysUtils.CompareText(Result.UsedByPropPath,UsedByPropPath)=0 then exit; 6854 end; 6855 Result:=nil; 6856end; 6857 6858function TUnitComponentDependency.SetUsedByPropPath(const UsedByPropPath, 6859 RequiresPropPath: string): TUCDComponentProperty; 6860begin 6861 //DebugLn(['TUnitComponentDependency.SetUsedByPropPath ',UsedByPropPath,'=',RequiresPropPath]); 6862 if (not (ucdtOldProperty in FTypes)) then 6863 raise Exception.Create('TUnitComponentDependency.SetUsedByPropPath inconsistency'); 6864 Result:=FindUsedByPropPath(UsedByPropPath); 6865 if Result=nil then begin 6866 if FCompProps=nil then 6867 FCompProps:=TFPList.Create; 6868 Result:=TUCDComponentProperty.Create(UsedByPropPath,RequiresPropPath); 6869 FCompProps.Add(Result); 6870 end else begin 6871 Result.UsedByPropPath:=UsedByPropPath;// update case 6872 Result.RequiresPropPath:=RequiresPropPath; 6873 end; 6874end; 6875 6876function TUnitComponentDependency.CreatePropPath(AComponent: TComponent; 6877 const PropName: string): string; 6878begin 6879 Result:=PropName; 6880 while AComponent<>nil do begin 6881 if Result<>'' then 6882 Result:='.'+Result; 6883 Result:=AComponent.Name+Result; 6884 AComponent:=AComponent.Owner; 6885 end; 6886end; 6887 6888{ TUCDComponentProperty } 6889 6890constructor TUCDComponentProperty.Create(const SrcPath, DestPath: string); 6891begin 6892 UsedByPropPath:=SrcPath; 6893 RequiresPropPath:=DestPath; 6894end; 6895 6896{ TProjectBuildMode } 6897 6898function TProjectBuildMode.GetLazCompilerOptions: TLazCompilerOptions; 6899begin 6900 Result:=FCompilerOptions; 6901end; 6902 6903constructor TProjectBuildMode.Create(AOwner: TComponent); 6904begin 6905 inherited Create(AOwner); 6906 FCompilerOptions:=TProjectCompilerOptions.Create(LazProject); 6907 FCompilerOptions.AddOnChangedHandler(@OnItemChanged); 6908 FCompilerOptions.FBuildMode:=Self; 6909end; 6910 6911destructor TProjectBuildMode.Destroy; 6912begin 6913 FreeAndNil(FCompilerOptions); 6914 inherited Destroy; 6915end; 6916 6917function TProjectBuildMode.LazProject: TProject; 6918begin 6919 if Owner is TProjectBuildModes then 6920 Result:=TProjectBuildModes(Owner).LazProject 6921 else 6922 Result:=Nil; 6923end; 6924 6925procedure TProjectBuildMode.Clear; 6926begin 6927 CompilerOptions.Clear; 6928end; 6929 6930function TProjectBuildMode.Equals(Src: TProjectBuildMode): boolean; 6931begin 6932 Result:=CompilerOptions.IsEqual(Src.CompilerOptions); 6933end; 6934 6935function TProjectBuildMode.CreateDiff(Other: TProjectBuildMode; 6936 Tool: TCompilerDiffTool): boolean; 6937begin 6938 // Note: if there is a Tool all steps must be evaluated, if not exit on first diff 6939 //if Tool<>nil then debugln(['TProjectBuildMode.CreateDiff ']); 6940 Result:=CompilerOptions.CreateDiff(Other.CompilerOptions,Tool); 6941 if (Tool=nil) and Result then exit; 6942end; 6943 6944procedure TProjectBuildMode.Assign(Src: TProjectBuildMode); 6945begin 6946 if Equals(Src) then exit; 6947 InSession:=Src.InSession; 6948 CompilerOptions.Assign(Src.CompilerOptions); 6949end; 6950 6951procedure TProjectBuildMode.LoadFromXMLConfig(XMLConfig: TXMLConfig; 6952 const Path: string); 6953begin 6954 FIdentifier:=XMLConfig.GetValue('Identifier',''); 6955 FCompilerOptions.LoadFromXMLConfig(XMLConfig,Path+'CompilerOptions/'); 6956end; 6957 6958procedure TProjectBuildMode.SaveMacroValuesAtOldPlace(XMLConfig: TXMLConfig; const Path: string); 6959var 6960 Cnt: Integer; 6961 Modes: TProjectBuildModes; 6962begin 6963 // for older IDE (<1.1) save the macros at the old place 6964 Assert(Assigned(Owner), 'SaveMacroValuesAtOldPlace: Owner not assigned.'); 6965 Modes := Owner as TProjectBuildModes; 6966 Cnt:=Modes.SessionMatrixOptions.SaveAtOldXMLConfig(XMLConfig, Path, Identifier); 6967 Cnt+=Modes.SharedMatrixOptions.SaveAtOldXMLConfig(XMLConfig, Path, Identifier); 6968 XMLConfig.SetDeleteValue(Path+'Count',Cnt,0); 6969end; 6970 6971procedure TProjectBuildMode.SaveToXMLConfig(XMLConfig: TXMLConfig; 6972 const Path: string; IsDefault, ALegacyList: Boolean; var Cnt: integer); 6973var 6974 SubPath: String; 6975begin 6976 SubPath:=Path+'BuildModes/'+XMLConfig.GetListItemXPath('Item', Cnt, ALegacyList, True)+'/'; 6977 inc(Cnt); 6978 XMLConfig.SetDeleteValue(SubPath+'Name',Identifier,''); 6979 if IsDefault then 6980 XMLConfig.SetDeleteValue(SubPath+'Default',True,false) 6981 else begin 6982 SaveMacroValuesAtOldPlace(XMLConfig, SubPath+'MacroValues/'); 6983 CompilerOptions.SaveToXMLConfig(XMLConfig,SubPath+'CompilerOptions/'); 6984 end; 6985end; 6986 6987function TProjectBuildMode.GetCaption: string; 6988var 6989 i: Integer; 6990begin 6991 Result:=Identifier; 6992 for i:=length(Result) downto 1 do 6993 if Result[i] in ['&',#0..#31,#127] then 6994 System.Delete(Result,i,1); 6995 if Result<>'' then exit; 6996 i:=GetIndex; 6997 if i>=0 then 6998 Result:='['+IntToStr(i)+']'; 6999end; 7000 7001function TProjectBuildMode.GetIndex: integer; 7002begin 7003 if LazProject<>nil then 7004 Result:=LazProject.BuildModes.IndexOf(Self) 7005 else 7006 Result:=-1; 7007end; 7008 7009{ TProjectBuildModes } 7010 7011function TProjectBuildModes.GetItems(Index: integer): TProjectBuildMode; 7012begin 7013 Result:=TProjectBuildMode(fItems[Index]); 7014end; 7015 7016function TProjectBuildModes.GetModified: boolean; 7017begin 7018 Result:=fSavedChangeStamp<>FChangeStamp; 7019end; 7020 7021procedure TProjectBuildModes.OnItemChanged(Sender: TObject); 7022begin 7023 {$IFDEF VerboseIDEModified} 7024 debugln(['TProjectBuildModes.OnItemChanged ',DbgSName(Sender)]); 7025 {$ENDIF} 7026 IncreaseChangeStamp; 7027end; 7028 7029procedure TProjectBuildModes.SetModified(const AValue: boolean); 7030var 7031 i: Integer; 7032begin 7033 if AValue then 7034 IncreaseChangeStamp 7035 else begin 7036 for i:=0 to Count-1 do 7037 Items[i].Modified:=false; 7038 SharedMatrixOptions.Modified:=false; 7039 SessionMatrixOptions.Modified:=false; 7040 fSavedChangeStamp:=FChangeStamp; 7041 end; 7042end; 7043 7044constructor TProjectBuildModes.Create(AOwner: TComponent); 7045begin 7046 inherited Create(AOwner); 7047 fChangedHandlers:=TMethodList.Create; 7048 fItems:=TFPList.Create; 7049 FChangeStamp:=CTInvalidChangeStamp; 7050 fSavedChangeStamp:=FChangeStamp; 7051 FSharedMatrixOptions:=TBuildMatrixOptions.Create; 7052 FSharedMatrixOptions.OnChanged:=@OnItemChanged; 7053 FSessionMatrixOptions:=TBuildMatrixOptions.Create; 7054 FSessionMatrixOptions.OnChanged:=@OnItemChanged; 7055 FManyBuildModes:=TStringList.Create; 7056end; 7057 7058destructor TProjectBuildModes.Destroy; 7059begin 7060 FreeAndNil(fChangedHandlers); 7061 Clear; 7062 FreeAndNil(FManyBuildModes); 7063 FreeAndNil(FSharedMatrixOptions); 7064 FreeAndNil(FSessionMatrixOptions); 7065 FreeAndNil(fItems); 7066 inherited Destroy; 7067end; 7068 7069procedure TProjectBuildModes.Clear; 7070begin 7071 while Count>0 do 7072 Delete(Count-1); 7073 SharedMatrixOptions.Clear; 7074 SessionMatrixOptions.Clear; 7075 //fChangedHandlers.Clear; 7076end; 7077 7078function TProjectBuildModes.IsEqual(OtherModes: TProjectBuildModes): boolean; 7079var 7080 i: Integer; 7081begin 7082 Result:=true; 7083 if OtherModes.Count<>Count then exit; 7084 for i:=0 to Count-1 do 7085 if not Items[i].Equals(OtherModes[i]) then exit; 7086 if not SharedMatrixOptions.Equals(OtherModes.SharedMatrixOptions) then exit; 7087 if not SessionMatrixOptions.Equals(OtherModes.SessionMatrixOptions) then exit; 7088 Result:=false; 7089end; 7090 7091procedure TProjectBuildModes.Assign(Source: TPersistent; WithModified: boolean); 7092var 7093 OtherModes: TProjectBuildModes; 7094 i: Integer; 7095 CurMode: TProjectBuildMode; 7096begin 7097 if Source is TProjectBuildModes then begin 7098 FAssigning:=True; 7099 OtherModes:=TProjectBuildModes(Source); 7100 Clear; 7101 for i:=0 to OtherModes.Count-1 do 7102 begin 7103 CurMode:=Add(OtherModes[i].Identifier); 7104 CurMode.Assign(OtherModes[i]); 7105 if WithModified then 7106 CurMode.Modified:=OtherModes[i].Modified; 7107 end; 7108 SharedMatrixOptions.Assign(OtherModes.SharedMatrixOptions); 7109 SessionMatrixOptions.Assign(OtherModes.SessionMatrixOptions); 7110 ManyBuildModes.Assign(OtherModes.ManyBuildModes); 7111 ChangedHandlers.Assign(OtherModes.ChangedHandlers); 7112 if WithModified then 7113 Modified:=OtherModes.Modified; 7114 FAssigning:=False; 7115 end else 7116 inherited Assign(Source); 7117end; 7118 7119procedure TProjectBuildModes.Delete(Index: integer); 7120var 7121 Item: TProjectBuildMode; 7122begin 7123 Item:=Items[Index]; 7124 fItems.Delete(Index); 7125 Item.Free; 7126 {$IFDEF VerboseIDEModified} 7127 debugln(['TProjectBuildModes.Delete ']); 7128 {$ENDIF} 7129 IncreaseChangeStamp; 7130end; 7131 7132function TProjectBuildModes.IndexOf(Identifier: string): integer; 7133begin 7134 Result:=Count-1; 7135 while (Result>=0) 7136 and (SysUtils.CompareText(Identifier,Items[Result].Identifier)<>0) do 7137 dec(Result); 7138end; 7139 7140function TProjectBuildModes.IndexOf(aMode: TProjectBuildMode): integer; 7141begin 7142 Result:=fItems.IndexOf(aMode); 7143end; 7144 7145function TProjectBuildModes.Find(Identifier: string): TProjectBuildMode; 7146var 7147 i: LongInt; 7148begin 7149 i:=IndexOf(Identifier); 7150 if i>=0 then 7151 Result:=Items[i] 7152 else 7153 Result:=nil; 7154end; 7155 7156function TProjectBuildModes.Add(Identifier: string): TProjectBuildMode; 7157begin 7158 Result:=TProjectBuildMode.Create(Self); 7159 Result.FIdentifier:=Identifier; 7160 if LazProject<>nil then 7161 Result.CompilerOptions.BaseDirectory:=LazProject.Directory; 7162 Result.AddOnChangedHandler(@OnItemChanged); 7163 fItems.Add(Result); 7164end; 7165 7166procedure TProjectBuildModes.Move(FromIndex, ToIndex: integer); 7167begin 7168 fItems.Move(FromIndex,ToIndex); 7169end; 7170 7171function TProjectBuildModes.Count: integer; 7172begin 7173 Result:=fItems.Count; 7174end; 7175 7176procedure TProjectBuildModes.IncreaseChangeStamp; 7177begin 7178 CTIncreaseChangeStamp(FChangeStamp); 7179 if fChangedHandlers<>nil then fChangedHandlers.CallNotifyEvents(Self); 7180end; 7181 7182procedure TProjectBuildModes.AddOnChangedHandler(const Handler: TNotifyEvent); 7183begin 7184 fChangedHandlers.Add(TMethod(Handler)); 7185end; 7186 7187procedure TProjectBuildModes.RemoveOnChangedHandler(const Handler: TNotifyEvent); 7188begin 7189 fChangedHandlers.Remove(TMethod(Handler)); 7190end; 7191 7192function TProjectBuildModes.IsModified(InSession: boolean): boolean; 7193var 7194 i: Integer; 7195begin 7196 Result:=true; 7197 if InSession then begin 7198 if SessionMatrixOptions.Modified then exit; 7199 end else begin 7200 if SharedMatrixOptions.Modified then exit; 7201 end; 7202 for i:=0 to Count-1 do 7203 if (Items[i].InSession=InSession) and Items[i].Modified then 7204 exit; 7205 Result:=false; 7206end; 7207 7208function TProjectBuildModes.GetSessionModes: TStringList; 7209var 7210 i: Integer; 7211 BuildMode: TProjectBuildMode; 7212begin 7213 Result:=TStringList.Create; 7214 for i:=0 to Count-1 do begin 7215 BuildMode:=Items[i]; 7216 if BuildMode.InSession then 7217 Result.Add(BuildMode.Identifier); 7218 end; 7219end; 7220 7221function TProjectBuildModes.IsSessionMode(const ModeIdentifier: string): boolean; 7222var 7223 i: Integer; 7224 BuildMode: TProjectBuildMode; 7225begin 7226 for i:=0 to Count-1 do begin 7227 BuildMode:=Items[i]; 7228 if SysUtils.CompareText(BuildMode.Identifier,ModeIdentifier)=0 then 7229 exit(BuildMode.InSession); 7230 end; 7231 Result:=false; 7232end; 7233 7234function TProjectBuildModes.IsSharedMode(const ModeIdentifier: string): boolean; 7235var 7236 i: Integer; 7237 BuildMode: TProjectBuildMode; 7238begin 7239 for i:=0 to Count-1 do begin 7240 BuildMode:=Items[i]; 7241 if SysUtils.CompareText(BuildMode.Identifier,ModeIdentifier)=0 then 7242 exit(not BuildMode.InSession); 7243 end; 7244 Result:=false; 7245end; 7246 7247procedure TProjectBuildModes.RenameMatrixMode(const OldName, NewName: string); 7248begin 7249 SharedMatrixOptions.RenameMode(OldName,NewName); 7250 SessionMatrixOptions.RenameMode(OldName,NewName); 7251end; 7252 7253function TProjectBuildModes.CreateExtraModes(aCurMode: TProjectBuildMode): TProjectBuildMode; 7254// Create Debug and Release buildmodes. Return the created debug mode. 7255// Params: aCurMode - existing mode to copy settings from. 7256 7257 procedure AssignAndSetBooleans(aMode: TProjectBuildMode; IsDebug: Boolean); 7258 begin 7259 if Assigned(aCurMode) then 7260 aMode.Assign(aCurMode); // clone from currently selected mode 7261 with aMode.CompilerOptions do 7262 begin 7263 // Smart linking 7264 SmartLinkUnit:=not IsDebug; 7265 LinkSmart:=not IsDebug; 7266 // Checks 7267 IOChecks:=IsDebug; 7268 RangeChecks:=IsDebug; 7269 OverflowChecks:=IsDebug; 7270 StackChecks:=IsDebug; 7271 IncludeAssertionCode:=IsDebug; 7272 VerifyObjMethodCall:=IsDebug; 7273 // Debug flags 7274 GenerateDebugInfo:=IsDebug; 7275 UseExternalDbgSyms:=IsDebug; 7276 UseHeaptrc:=IsDebug; 7277 TrashVariables:=IsDebug; 7278 end; 7279 end; 7280 7281var 7282 RelMode: TProjectBuildMode; 7283begin 7284 // Create Debug mode 7285 Result:=Add(DebugModeName); 7286 AssignAndSetBooleans(Result, True); 7287 Result.CompilerOptions.OptimizationLevel:=1; // Optimization 7288 Result.CompilerOptions.DebugInfoType:=dsDwarf3; // Debug 7289 // Create Release mode 7290 RelMode:=Add(ReleaseModeName); 7291 AssignAndSetBooleans(RelMode, False); 7292 RelMode.CompilerOptions.OptimizationLevel:=3; // Slow but safe optimization, -O4 is dangerous 7293 RelMode.CompilerOptions.DebugInfoType:=dsAuto; // No Debug 7294end; 7295 7296// Methods for LoadFromXMLConfig 7297 7298procedure TProjectBuildModes.AddMatrixMacro(const MacroName, MacroValue, ModeIdentifier: string; 7299 InSession: boolean); 7300var 7301 MatrixOptions: TBuildMatrixOptions; 7302 MatrixOption: TBuildMatrixOption; 7303begin 7304 MatrixOption:=SharedMatrixOptions.FindMacro(MacroName,MacroValue); 7305 if MatrixOption=nil then 7306 MatrixOption:=SessionMatrixOptions.FindMacro(MacroName,MacroValue); 7307 if MatrixOption<>nil then begin 7308 // Macro already exists => enable mode for this macro 7309 MatrixOption.EnableMode(ModeIdentifier); 7310 end else begin 7311 // Macro does not yet exist => create 7312 if InSession then 7313 MatrixOptions:=SessionMatrixOptions 7314 else 7315 MatrixOptions:=SharedMatrixOptions; 7316 MatrixOption:=MatrixOptions.Add(bmotIDEMacro,'*'); 7317 MatrixOption.MacroName:=MacroName; 7318 MatrixOption.Value:=MacroValue; 7319 MatrixOption.Modes:=ModeIdentifier; 7320 end; 7321end; 7322 7323procedure TProjectBuildModes.LoadSessionEnabledNonSessionMatrixOptions(const Path: string); 7324var 7325 i, Cnt: integer; 7326 SubPath: String; 7327 ModeID, OptionID: String; 7328begin 7329 // disable all matrix options in session modes 7330 if FGlobalMatrixOptions<>nil then 7331 FGlobalMatrixOptions.DisableModes(@IsSessionMode); 7332 SharedMatrixOptions.DisableModes(@IsSessionMode); 7333 // load 7334 Cnt:=FXMLConfig.GetValue(Path+'Count',0); 7335 for i:=1 to Cnt do begin 7336 SubPath:=Path+'Item'+IntToStr(i)+'/'; 7337 ModeID:=FXMLConfig.GetValue(SubPath+'Mode',''); 7338 if (ModeID='') or (not IsSessionMode(ModeID)) then begin 7339 debugln(['LoadSessionEnabledNonSessionMatrixOptions not a session Mode="',dbgstr(ModeID),'" at ',SubPath]); 7340 continue; 7341 end; 7342 OptionID:=FXMLConfig.GetValue(SubPath+'Option',''); 7343 if OptionID='' then begin 7344 debugln(['LoadSessionEnabledNonSessionMatrixOptions invalid option at ',SubPath]); 7345 continue; 7346 end; 7347 if Assigned(FGlobalMatrixOptions) then 7348 FGlobalMatrixOptions.EnableModeIfOptionFound(ModeID, OptionID); 7349 if Assigned(SharedMatrixOptions) then 7350 SharedMatrixOptions.EnableModeIfOptionFound(ModeID, OptionID); 7351 end; 7352end; 7353 7354procedure TProjectBuildModes.LoadOtherCompilerOpts(const Path: string; 7355 FromIndex, ToIndex: Integer; InSession: boolean); 7356// Iterate rest of the modes. 7357var 7358 i: Integer; 7359 Ident, SubPath: String; 7360 CurMode: TProjectBuildMode; 7361 LegacyList: Boolean; 7362begin 7363 LegacyList := FXMLConfig.IsLegacyList(Path); 7364 for i:=FromIndex to ToIndex do 7365 begin 7366 SubPath:=Path+FXMLConfig.GetListItemXPath('Item', i-1, LegacyList, True)+'/'; 7367 Ident:=FXMLConfig.GetValue(SubPath+'Name',''); 7368 CurMode:=Add(Ident); // add another mode 7369 CurMode.InSession:=InSession; 7370 CurMode.CompilerOptions.LoadFromXMLConfig(FXMLConfig, SubPath+'CompilerOptions/'); 7371 end; 7372end; 7373 7374procedure TProjectBuildModes.LoadMacroValues(const Path: string; CurMode: TProjectBuildMode); 7375var 7376 i, Cnt: Integer; 7377 SubPath, MacroName, MacroValue: String; 7378begin 7379 // load macro values of old IDE (<1.1) 7380 Cnt:=FXMLConfig.GetValue(Path+'Count',0); 7381 //debugln(['LoadMacroValues Cnt=',Cnt]); 7382 for i:=1 to Cnt do begin 7383 SubPath:=Path+'Macro'+IntToStr(i)+'/'; 7384 MacroName:=FXMLConfig.GetValue(SubPath+'Name',''); 7385 if not IsValidIdent(MacroName) then continue; 7386 MacroValue:=FXMLConfig.GetValue(SubPath+'Value',''); 7387 //debugln(['LoadMacroValues Mode="',CurMode.Identifier,'" ',MacroName,'="',MacroValue,'" session=',CurMode.InSession]); 7388 AddMatrixMacro(MacroName,MacroValue,CurMode.Identifier,CurMode.InSession); 7389 end; 7390end; 7391 7392procedure TProjectBuildModes.LoadAllMacroValues(const Path: string; Cnt: Integer); 7393var 7394 i: Integer; 7395 SubPath: String; 7396 IsLegacyList: Boolean; 7397begin 7398 // First default mode. 7399 LoadMacroValues(Path+'MacroValues/', Items[0]); 7400 IsLegacyList := FXMLConfig.IsLegacyList(Path+'BuildModes/'); 7401 // Iterate rest of the modes. 7402 for i:=2 to Cnt do 7403 begin 7404 SubPath:=Path+'BuildModes/'+FXMLConfig.GetListItemXPath('Item', i-1, IsLegacyList, True); 7405 LoadMacroValues(SubPath+'MacroValues/', Items[i-1]); 7406 end; 7407end; 7408 7409procedure TProjectBuildModes.LoadOldFormat(const Path: string); 7410var 7411 Ident, CompOptsPath, MacroValsPath: String; 7412 CurMode: TProjectBuildMode; 7413begin 7414 // no build modes => an old file format 7415 CompOptsPath:='CompilerOptions/'; 7416 // due to a bug in an old version, the XML path can be 'CompilerOptions/' or '' 7417 if (LazProject.FFileVersion<3) 7418 and (FXMLConfig.GetValue('SearchPaths/CompilerPath/Value','')<>'') then 7419 CompOptsPath:=''; 7420 MacroValsPath:=Path+'MacroValues/'; 7421 CurMode:=Items[0]; 7422 LoadMacroValues(MacroValsPath,CurMode); 7423 if FXMLConfig.GetValue(CompOptsPath+'Version/Value', 0)<10 then begin 7424 // LCLWidgetType was not a macro but a property of its own 7425 Ident := FXMLConfig.GetValue(CompOptsPath+'LCLWidgetType/Value', ''); 7426 if (Ident<>'') and (SysUtils.CompareText(Ident,'default')<>0) then 7427 AddMatrixMacro('LCLWidgetType',Ident,'default',false); 7428 end; 7429 CurMode.CompilerOptions.LoadFromXMLConfig(FXMLConfig,CompOptsPath); 7430end; 7431 7432procedure TProjectBuildModes.LoadActiveBuildMode(const Path: string); 7433var 7434 CurMode: TProjectBuildMode; 7435begin 7436 CurMode:=Find(FXMLConfig.GetValue(Path+'BuildModes/Active','default')); 7437 if CurMode=nil then 7438 CurMode:=Items[0]; 7439 LazProject.ActiveBuildMode:=CurMode; 7440 // Many BuildModes selection, a comma separated list. 7441 FManyBuildModes.CommaText:=FXMLConfig.GetValue(Path+'ManyBuildModesSelection/Value',''); 7442end; 7443 7444procedure TProjectBuildModes.LoadProjOptsFromXMLConfig(XMLConfig: TXMLConfig; const Path: string); 7445// Load for project 7446var 7447 Cnt: Integer; 7448 IsLegacyList: Boolean; 7449begin 7450 FXMLConfig := XMLConfig; 7451 7452 IsLegacyList := FXMLConfig.IsLegacyList(Path+'BuildModes/'); 7453 Cnt:=FXMLConfig.GetListItemCount(Path+'BuildModes/', 'Item', IsLegacyList); 7454 if Cnt>0 then begin 7455 // Project default mode is stored at the old XML path for backward compatibility. 7456 // Testing the 'Default' XML attribute is not needed because the first mode 7457 // is always default. 7458 Items[0].Identifier:=FXMLConfig.GetValue(Path+'BuildModes/'+XMLConfig.GetListItemXPath('Item', 0, IsLegacyList, True)+'/Name', ''); 7459 Items[0].CompilerOptions.LoadFromXMLConfig(FXMLConfig, 'CompilerOptions/'); 7460 LoadOtherCompilerOpts(Path+'BuildModes/', 2, Cnt, False); 7461 LoadAllMacroValues(Path+'MacroValues/', Cnt); 7462 end 7463 else 7464 LoadOldFormat(Path); 7465 7466 LoadActiveBuildMode(Path); 7467end; 7468 7469procedure TProjectBuildModes.LoadSessionFromXMLConfig(XMLConfig: TXMLConfig; 7470 const Path: string; LoadAllOptions: boolean); 7471// Load for session 7472var 7473 Cnt: Integer; 7474 IsLegacyList: Boolean; 7475begin 7476 FXMLConfig := XMLConfig; 7477 7478 if LoadAllOptions then 7479 // load matrix options 7480 SessionMatrixOptions.LoadFromXMLConfig(FXMLConfig, Path+'BuildModes/SessionMatrixOptions/'); 7481 7482 IsLegacyList := FXMLConfig.IsLegacyList(Path+'BuildModes/'); 7483 Cnt:=FXMLConfig.GetListItemCount(Path+'BuildModes/', 'Item', IsLegacyList); 7484 if Cnt>0 then begin 7485 // Add a new mode for session compiler options. 7486 LoadOtherCompilerOpts(Path+'BuildModes/', 1, Cnt, True); 7487 LoadAllMacroValues(Path+'MacroValues/', Cnt); 7488 end; 7489 7490 if LoadAllOptions then 7491 // load what matrix options are enabled in session build modes 7492 LoadSessionEnabledNonSessionMatrixOptions(Path+'BuildModes/SessionEnabledMatrixOptions/'); 7493 7494 LoadActiveBuildMode(Path); 7495end; 7496 7497// Methods for SaveToXMLConfig 7498 7499procedure TProjectBuildModes.SaveSessionData(const Path: string); 7500var 7501 SubPath: String; 7502 i, Cnt: Integer; 7503begin 7504 // Many BuildModes selection, a comma separated list. 7505 FXMLConfig.SetDeleteValue(Path+'ManyBuildModesSelection/Value', FManyBuildModes.CommaText, ''); 7506 // save what mode is currently active in the session 7507 FXMLConfig.SetDeleteValue(Path+'BuildModes/Active', 7508 LazProject.ActiveBuildMode.Identifier,'default'); 7509 // save matrix options of session 7510 SessionMatrixOptions.SaveToXMLConfig(FXMLConfig, Path+'BuildModes/SessionMatrixOptions/',nil); 7511 7512 // save what matrix options are enabled in session build modes 7513 Cnt:=0; 7514 SubPath:=Path+'BuildModes/SessionEnabledMatrixOptions/'; 7515 for i:=0 to Count-1 do 7516 if Items[i].InSession then 7517 SharedMatrixOptions.SaveSessionEnabled(FXMLConfig, SubPath, Items[i].Identifier, Cnt); 7518 if Assigned(FGlobalMatrixOptions) then 7519 for i:=0 to Count-1 do 7520 if Items[i].InSession then 7521 FGlobalMatrixOptions.SaveSessionEnabled(FXMLConfig, SubPath, Items[i].Identifier, Cnt); 7522 FXMLConfig.SetDeleteValue(SubPath+'Count',Cnt,0); 7523end; 7524 7525procedure TProjectBuildModes.SaveSharedMatrixOptions(const Path: string); 7526begin 7527 SharedMatrixOptions.SaveToXMLConfig(FXMLConfig, Path+'BuildModes/SharedMatrixOptions/',@IsSharedMode); 7528end; 7529 7530function TProjectBuildModes.GetLazBuildModes(Index: integer): TLazProjectBuildMode; 7531begin 7532 Result:=TLazProjectBuildMode(fItems[Index]); 7533end; 7534 7535// SaveToXMLConfig itself 7536procedure TProjectBuildModes.SaveProjOptsToXMLConfig(XMLConfig: TXMLConfig; 7537 const Path: string; SaveSession, ALegacyList: boolean); 7538var 7539 i, Cnt: Integer; 7540begin 7541 FXMLConfig := XMLConfig; 7542 // Save the default mode under an old xml path to let old IDEs open new projects 7543 // Note: the 0.9.29 reader already supports fetching the default build 7544 // mode from the BuildModes, so in one or two releases we can switch 7545 //Items[0].SaveDefaultCompilerOpts(FXMLConfig, Path); 7546 Items[0].SaveMacroValuesAtOldPlace(XMLConfig,Path+'MacroValues/'); 7547 Items[0].CompilerOptions.SaveToXMLConfig(XMLConfig,'CompilerOptions/'); // no Path! 7548 7549 Cnt:=0; 7550 for i:=0 to Count-1 do 7551 if SaveSession or not Items[i].InSession then 7552 Items[i].SaveToXMLConfig(FXMLConfig, Path, i=0, ALegacyList, Cnt); 7553 FXMLConfig.SetListItemCount(Path+'BuildModes/',Cnt,ALegacyList); 7554end; 7555 7556procedure TProjectBuildModes.SaveSessionOptsToXMLConfig(XMLConfig: TXMLConfig; 7557 const Path: string; SaveSession, ALegacyList: boolean); 7558var 7559 i, Cnt: Integer; 7560begin 7561 FXMLConfig := XMLConfig; 7562 Cnt:=0; 7563 for i:=0 to Count-1 do 7564 if Items[i].InSession and SaveSession then 7565 Items[i].SaveToXMLConfig(FXMLConfig, Path, false, ALegacyList, Cnt); 7566 FXMLConfig.SetListItemCount(Path+'BuildModes/',Cnt,ALegacyList); 7567end; 7568 7569 7570initialization 7571 RegisterIDEOptionsGroup(GroupProject, TProjectIDEOptions); 7572 RegisterIDEOptionsGroup(GroupCompiler, TProjectCompilerOptions); 7573 7574end. 7575 7576