1{ 2 *************************************************************************** 3 * * 4 * This source is free software; you can redistribute it and/or modify * 5 * it under the terms of the GNU General Public License as published by * 6 * the Free Software Foundation; either version 2 of the License, or * 7 * (at your option) any later version. * 8 * * 9 * This code is distributed in the hope that it will be useful, but * 10 * WITHOUT ANY WARRANTY; without even the implied warranty of * 11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 12 * General Public License for more details. * 13 * * 14 * A copy of the GNU General Public License is available on the World * 15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 16 * obtain it by writing to the Free Software Foundation, * 17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * 18 * * 19 *************************************************************************** 20 21 Author: Mattias Gaertner 22 23 Abstract: 24 This unit defines a class to store the options in a xml file. 25 26} 27unit EnvironmentOpts; 28 29{$mode objfpc}{$H+} 30 31interface 32 33uses 34{$IFDEF IDE_MEM_CHECK} 35 MemCheck, 36{$ENDIF} 37{$ifdef Windows} 38 ShlObj, 39{$endif} 40 Classes, SysUtils, TypInfo, contnrs, math, 41 // LCL 42 Graphics, Controls, Forms, Dialogs, LCLProc, 43 // LazUtils 44 LazFileUtils, FileUtil, LazFileCache, LazConfigStorage, LazUTF8, LazStringUtils, 45 Laz2_XMLCfg, Laz2_DOM, 46 // CodeTools 47 FileProcs, SourceChanger, CodeCompletionTool, 48 // IDEIntf 49 ProjectIntf, ObjectInspector, IDEWindowIntf, IDEOptionsIntf, IDEOptEditorIntf, 50 ComponentReg, IDEExternToolIntf, MacroDefIntf, SrcEditorIntf, 51 // DebuggerIntf 52 DbgIntfDebuggerBase, 53 // IDE 54 IDEProcs, DialogProcs, LazarusIDEStrConsts, IDETranslations, LazConf, 55 IDEOptionDefs, TransferMacros, ModeMatrixOpts, Debugger, 56 IdeCoolbarData, EditorToolbarStatic; 57 58const 59 EnvOptsVersion: integer = 110; 60 // 107 added Lazarus version 61 // 108 added LastCalledByLazarusFullPath 62 // 109 changed paths for desktop settings, supporting multiple desktops. 63 // 110 changed BackupType to string instead of integer 64 65 {$IFDEF Windows} 66 DefaultMakefilename = '$Path($(CompPath))make.exe'; 67 {$ELSE} 68 {$IFDEF FreeBSD} 69 DefaultMakefilename = 'gmake'; 70 {$ELSE} 71 DefaultMakefilename = 'make'; 72 {$ENDIF} 73 {$ENDIF} 74 75 RestoreProjectClosed = '-'; 76 DefaultMaxRecentOpenFiles = 10; 77 DefaultMaxRecentProjectFiles = 5; 78 DefaultMaxRecentPackageFiles = 10; 79 80 DefaultAutoSaveIntervalInSecs = 300; 81 82 DefaultRubberbandSelectsGrandChilds = false; 83 DefaultGridColor = clBlack; 84 DefaultGridSize = 8; 85 DefaultGuideLineColorLeftTop = clBlue; 86 DefaultGuideLineColorRightBottom = clGreen; 87 88 DefaultDropDownCount = 8; 89 90 //---------------------------------------------------------------------------- 91 92 { Backup } 93type 94 TBackupType = ( 95 bakNone, // no backup files 96 bakSymbolInFront, // .~pp 97 bakSymbolBehind, // .pp~ 98 bakCounter, // .pp;1 99 bakUserDefinedAddExt,// .pp.xxx 100 bakSameName // .pp only available if backuping into subdirectory 101 ); 102 103 TBackupInfo = record 104 BackupType: TBackupType; 105 AdditionalExtension:string; // for bakUserDefinedAddExt 106 MaxCounter: integer; // for bakCounter 107 SubDirectory: string; 108 end; 109const 110 // Important: When changing any of these values increase EnvOptsVersion 111 // and add code to read old options 112 DefaultBackupTypeProject = bakSameName; 113 DefaultBackupTypeOther = bakUserDefinedAddExt; 114 DefaultBackupAddExt = 'bak'; 115 DefaultBackupMaxCounter = 9; 116 DefaultBackupSubDirectory = 'backup'; 117 118 { Debugging } 119 120type 121 TDebuggerEventLogColor = record 122 Foreground: TColor; 123 Background: TColor; 124 end; 125 126const 127 DebuggerDefaultColors: array[TDBGEventType] of TDebuggerEventLogColor = ( 128{ etDefault } (Foreground: clWindowText; Background: clWindow), 129{ etBreakpointEvaluation } (Foreground: $8080FF; Background: clWindow), 130{ etBreakpointHit } (Foreground: clRed; Background: clWindow), 131{ etBreakpointMessage } (Foreground: $0000D9; Background: clWindow), 132{ etBreakpointStackDump } (Foreground: $2080FF; Background: clWindow), 133{ etExceptionRaised } (Foreground: clTeal; Background: clWindow), 134{ etModuleLoad } (Foreground: clBlue; Background: clWindow), 135{ etModuleUnload } (Foreground: clBlue; Background: clWindow), 136{ etOutputDebugString } (Foreground: clNavy; Background: clWindow), 137{ etProcessExit } (Foreground: clGray; Background: clWindow), 138{ etProcessStart } (Foreground: clGray; Background: clWindow), 139{ etThreadExit } (Foreground: clMaroon; Background: clWindow), 140{ etThreadStart } (Foreground: clMaroon; Background: clWindow), 141{ etWindowsMessagePosted } (Foreground: clWhite; Background: clGray), 142{ etWindowsMessageSent } (Foreground: clSkyBlue; Background: clWindow) 143 ); 144 145{ Naming } 146 147type 148 TPascalExtType = (petNone, petPAS, petPP, petP); 149 150const 151 PascalExtension: array[TPascalExtType] of string = ('', '.pas', '.pp', '.p'); 152 153 154 { Ambiguous files } 155type 156 TAmbiguousFileAction = ( 157 afaAsk, 158 afaAutoDelete, 159 afaAutoRename, 160 afaWarnOnCompile, 161 afaIgnore 162 ); 163 TAmbiguousFileActions = set of TAmbiguousFileAction; 164 165const 166 AmbiguousFileActionNames: array[TAmbiguousFileAction] of string = ( 167 'Ask', 168 'AutoDelete', 169 'AutoRename', 170 'WarnOnCompile', 171 'Ignore' 172 ); 173 174type 175 TCharCaseFileAction = ( 176 ccfaAsk, 177 ccfaAutoRename, 178 ccfaIgnore 179 ); 180 TCharCaseFileActions = set of TCharCaseFileAction; 181 182const 183 CharCaseFileActionNames: array[TCharCaseFileAction] of string = ( 184 'Ask', 185 'AutoRename', 186 'Ignore' 187 ); 188 189type 190 TUnitRenameReferencesAction = ( 191 urraAlways, // update references in other files 192 urraAsk, // scan, then ask, then update 193 urraNever // don't scan, don't ask, don't update 194 ); 195 TUnitRenameReferencesActions = set of TUnitRenameReferencesAction; 196 197const 198 UnitRenameReferencesActionNames: array[TUnitRenameReferencesAction] of string = ( 199 'Always', 200 'Ask', 201 'Never' 202 ); 203 204type 205 TIDEMultipleInstancesOption = ( 206 mioAlwaysStartNew, 207 mioOpenFilesInRunning, 208 mioForceSingleInstance 209 ); 210const 211 IDEMultipleInstancesOptionNames: array[TIDEMultipleInstancesOption] of string = ( 212 'AlwaysStartNew', // mioAlwaysStartNew 213 'OpenFilesInRunning', // mioOpenFilesInRunning 214 'ForceSingleInstance' // mioForceSingleInstance 215 ); 216 DefaultIDEMultipleInstancesOption = mioOpenFilesInRunning; 217 218 { Messages window } 219type 220 TMsgWndFileNameStyle = ( 221 mwfsShort, // = ExtractFilename 222 mwfsRelative, // = CreateRelativePath 223 mwfsFull 224 ); 225 TMsgWndFileNameStyles = set of TMsgWndFileNameStyle; 226const 227 MsgWndFileNameStyleNames: array[TMsgWndFileNameStyle] of string = ( 228 'Short', // mwfsShort 229 'Relative', // mwfsRelative 230 'Full' // mwfsFull 231 ); 232type 233 TMsgWndColor = ( 234 mwBackground, 235 mwRunning, 236 mwSuccess, 237 mwFailed, 238 mwAutoHeader, 239 mwTextColor 240 ); 241const 242 MsgWndDefBackgroundColor = clWindow; 243 MsgWndDefHeaderBackgroundRunning = clYellow; 244 MsgWndDefHeaderBackgroundSuccess = TColor($60FF60); // light green 245 MsgWndDefHeaderBackgroundFailed = TColor($6060FF); // light red 246 MsgWndDefAutoHeaderBackground = clSkyBlue; 247 MsgWndDefTextColor = clDefault; 248 249 MsgWndDefaultColors: array[TMsgWndColor] of TColor = ( 250 MsgWndDefBackgroundColor, // mwBackground 251 MsgWndDefHeaderBackgroundRunning, // mwRunning 252 MsgWndDefHeaderBackgroundSuccess, // mwSuccess 253 MsgWndDefHeaderBackgroundFailed, // mwFailed 254 MsgWndDefAutoHeaderBackground, // mwAutoHeader 255 MsgWndDefTextColor 256 ); 257 MsgWndColorNames: array[TMsgWndColor] of string = ( 258 'Background', 259 'Running', 260 'Success', 261 'Failed', 262 'AutoHeader', 263 'TextColor' 264 ); 265 266 { External Tools - the user menu items in the Tools menu } 267type 268 TBaseExternalUserTools = class 269 public 270 constructor Create; virtual; abstract; 271 function Load(Config: TConfigStorage; const Path: string): TModalResult; virtual; abstract; 272 function Save(Config: TConfigStorage; const Path: string): TModalResult; virtual; abstract; 273 end; 274 TExternalUserToolsClass = class of TBaseExternalUserTools; 275var 276 ExternalUserToolsClass: TExternalUserToolsClass; // set by ExtToolEditDlg to TExternalUserTools 277 278type 279 TEnvOptParseType = ( 280 eopLazarusDirectory, 281 eopCompilerFilename, 282 eopFPCSourceDirectory, 283 eopTestBuildDirectory, 284 eopMakeFilename, 285 eopFPDocPaths, 286 eopCompilerMessagesFilename, 287 eopDebuggerFilename, 288 eopDebuggerSearchPath, 289 eopFppkgConfigFile 290 ); 291 TEnvOptParseTypes = set of TEnvOptParseType; 292 293type 294 TEnvironmentOptions = class; 295 296 { TDebuggerPropertiesConfig } 297 298 TDebuggerPropertiesConfig = class(TPersistent) 299 private 300 FFLags: set of (dpcLoaded, dpcDeleted); 301 FActive: Boolean; 302 FConfigClass: String; 303 FConfigClassInOldXml: String; // The ConfigClass in the xml file. In case the class in memory is changed 304 FConfigName: String; 305 FDebuggerClass: TDebuggerClass; 306 FDebuggerFilename: string; 307 FIsFromOldXml: Boolean; 308 FUID: String; 309 FXmlIndex: Integer; 310 FDebuggerProperties: TDebuggerProperties; 311 312 procedure InitUID; 313 public 314 destructor Destroy; override; 315 constructor CreateFromXmlConf(AXMLCfg: TRttiXMLConfig; APath: String; AIndex: Integer); 316 constructor CreateFromOldXmlConf(AXMLCfg: TRttiXMLConfig; APath: String; 317 ADebuggerClass: TDebuggerClass; AForceLoad: Boolean = False); 318 constructor CreateFromOldXmlConf(AXMLCfg: TRttiXMLConfig; APath: String; 319 ADebuggerClassName: String; AForceLoad: Boolean = False); 320 constructor CreateForDebuggerClass(ADebuggerClass: TDebuggerClass); 321 constructor CreateCopy(ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean = True; ACopyXmlOrigin: Boolean = False); 322 323 procedure CopyFrom(ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean = True); 324 procedure AssignTo(Dest: TPersistent); override; 325 function DisplayName: String; 326 function NeedsExePath: Boolean; 327 procedure ChangeDebuggerClass(ADebuggerClass: TDebuggerClass; ACopyPropValues: Boolean = True); 328 procedure MarkAsDeleted; 329 function IsLoaded: Boolean; 330 function IsDeleted: Boolean; 331 function DebugText: String; 332 333 procedure DeleteFromXml(AXMLCfg: TRttiXMLConfig; APath: String); // uses FXmlIndex from last load/save. No prior sibling must have benn removed or inserted 334 procedure DeleteFromOldXml(AXMLCfg: TRttiXMLConfig; APath: String); 335 procedure SaveToXml(AXMLCfg: TRttiXMLConfig; APath: String; AIndex: Integer); 336 procedure SaveToOldXml(AXMLCfg: TRttiXMLConfig; APath: String); 337 338 property DebuggerClass: TDebuggerClass read FDebuggerClass; 339 property DebuggerProperties: TDebuggerProperties read FDebuggerProperties; 340 property IsFromOldXml: Boolean read FIsFromOldXml; 341 published 342 property ConfigName: String read FConfigName write FConfigName; 343 property ConfigClass: String read FConfigClass write FConfigClass; 344 property DebuggerFilename: string read FDebuggerFilename write FDebuggerFilename; 345 property Active: Boolean read FActive write FActive; 346 property UID: String read FUID write FUID; 347 end; 348 349 TLastOpenPackagesList = class(TStringList) 350 public 351 function Remove(const aString: string): Boolean; 352 constructor Create; 353 end; 354 355 TUseUnitDlgOptions = record 356 AllUnits: Boolean; 357 AddToImplementation: Boolean; 358 end; 359 360 { TCustomDesktopOpt } 361 362 TCustomDesktopOpt = class 363 protected 364 FName:string; 365 FAssociatedDebugDesktopName: String; 366 FConfigStore: TXMLOptionsStorage; 367 FIsDocked: Boolean; 368 FXMLCfg: TRttiXMLConfig; 369 370 function GetCompatible: Boolean; virtual; 371 372 public 373 constructor Create(const aName: String); virtual; overload; 374 constructor Create(const aName: String; const aIsDocked: Boolean); virtual; overload; 375 destructor Destroy; override; 376 procedure SetConfig(aXMLCfg: TRttiXMLConfig; aConfigStore: TXMLOptionsStorage); 377 procedure Load(Path: String); virtual; 378 procedure Save(Path: String); virtual; abstract; 379 property Name: String read FName write FName; 380 property AssociatedDebugDesktopName: String read FAssociatedDebugDesktopName write FAssociatedDebugDesktopName; 381 property IsDocked: Boolean read FIsDocked; 382 property Compatible: Boolean read GetCompatible; 383 end; 384 TDesktopOptClass = class of TCustomDesktopOpt; 385 386 TDesktopOIOptions = class(TPersistent) 387 private 388 FComponentTreeHeight: integer; 389 FInfoBoxHeight: integer; 390 FShowComponentTree: Boolean; 391 FShowInfoBox: boolean; 392 FSplitterX: array[TObjectInspectorPage] of Integer; 393 394 function GetSplitterX(const APage: TObjectInspectorPage): Integer; 395 procedure SetSplitterX(const APage: TObjectInspectorPage; 396 const ASplitterX: Integer); 397 protected 398 procedure AssignTo(Dest: TPersistent); override; 399 public 400 constructor Create; 401 402 procedure ImportSettingsFromIDE(const AOptions: TEnvironmentOptions); 403 procedure ExportSettingsToIDE(const AOptions: TEnvironmentOptions); 404 procedure Load(XMLConfig: TXMLConfig; Path: String); 405 procedure Save(XMLConfig: TXMLConfig; Path: String); 406 407 property ShowComponentTree: Boolean read FShowComponentTree write FShowComponentTree; 408 property ComponentTreeHeight: integer read FComponentTreeHeight write FComponentTreeHeight; 409 property SplitterX[const APage: TObjectInspectorPage]: Integer read GetSplitterX write SetSplitterX; 410 property ShowInfoBox: boolean read FShowInfoBox write FShowInfoBox; 411 property InfoBoxHeight: integer read FInfoBoxHeight write FInfoBoxHeight; 412 end; 413 414 { TDesktopOpt } 415 416 TDesktopOpt = class(TCustomDesktopOpt) 417 private 418 // window layout 419 FIDEWindowCreatorsLayoutList: TSimpleWindowLayoutList; 420 FIDEDialogLayoutList: TIDEDialogLayoutList; 421 FObjectInspectorOptions: TDesktopOIOptions; 422 FSingleTaskBarButton: boolean; 423 FHideIDEOnRun: boolean; 424 FAutoAdjustIDEHeight: boolean; 425 FAutoAdjustIDEHeightFullCompPal: boolean; 426 // window menu 427 FIDENameForDesignedFormList: boolean; 428 // CompletionWindow 429 FCompletionWindowWidth: Integer; 430 FCompletionWindowHeight: Integer; 431 // title 432 FIDETitleStartsWithProject: boolean; 433 FIDETitleIncludesBuildMode: boolean; 434 FIDEProjectDirectoryInIdeTitle: boolean; 435 // IDE Coolbar 436 FIDECoolBarOptions: TIDECoolBarOptions; 437 // Editor Toolbar 438 FEditorToolBarOptions: TEditorToolBarOptions; 439 // component palette 440 FComponentPaletteOptions: TCompPaletteOptions; 441 442 //Docking options 443 FDockedOpt: TAbstractDesktopDockingOpt; 444 445 procedure InitLayoutList; 446 protected 447 function GetCompatible: Boolean; override; 448 public 449 constructor Create(const aName: String; const aIsDocked: Boolean); override; overload; 450 destructor Destroy; override; 451 procedure Assign(Source: TDesktopOpt; const AssignName: Boolean = False; 452 const IsCompatible: Boolean = True); 453 public 454 procedure Load(Path: String); override; 455 procedure Save(Path: String); override; 456 procedure ImportSettingsFromIDE(const AOptions: TEnvironmentOptions); 457 procedure ExportSettingsToIDE(const AOptions: TEnvironmentOptions); 458 procedure RestoreDesktop; 459 460 property IDEWindowCreatorsLayoutList: TSimpleWindowLayoutList read FIDEWindowCreatorsLayoutList write FIDEWindowCreatorsLayoutList; 461 property IDEDialogLayoutList: TIDEDialogLayoutList read FIDEDialogLayoutList; 462 property SingleTaskBarButton: boolean read FSingleTaskBarButton write FSingleTaskBarButton; 463 property HideIDEOnRun: boolean read FHideIDEOnRun write FHideIDEOnRun; 464 property AutoAdjustIDEHeight: Boolean read FAutoAdjustIDEHeight write FAutoAdjustIDEHeight; 465 property AutoAdjustIDEHeightFullCompPal: Boolean read FAutoAdjustIDEHeightFullCompPal 466 write FAutoAdjustIDEHeightFullCompPal; 467 property IDENameForDesignedFormList: boolean read FIDENameForDesignedFormList 468 write FIDENameForDesignedFormList; 469 property CompletionWindowWidth: Integer read FCompletionWindowWidth write FCompletionWindowWidth; 470 property CompletionWindowHeight: Integer read FCompletionWindowHeight write FCompletionWindowHeight; 471 property IDETitleStartsWithProject: boolean read FIDETitleStartsWithProject 472 write FIDETitleStartsWithProject; 473 property IDETitleIncludesBuildMode: boolean read FIDETitleIncludesBuildMode 474 write FIDETitleIncludesBuildMode; 475 property IDEProjectDirectoryInIdeTitle: boolean read FIDEProjectDirectoryInIdeTitle 476 write FIDEProjectDirectoryInIdeTitle; 477 property IDECoolBarOptions: TIDECoolBarOptions read FIDECoolBarOptions; 478 property EditorToolBarOptions: TEditorToolBarOptions read FEditorToolBarOptions; 479 property ComponentPaletteOptions: TCompPaletteOptions read FComponentPaletteOptions; 480 property ObjectInspectorOptions: TDesktopOIOptions read FObjectInspectorOptions; 481 end; 482 483 { TUnsupportedDesktopOpt } 484 485 TUnsupportedDesktopOpt = Class(TCustomDesktopOpt) 486 private 487 FRetainXMLData:TDOMDocument; 488 public 489 destructor Destroy; override; 490 procedure Load(Path: String); override; 491 procedure Save(Path: String); override; 492 end; 493 494 { TDesktopOptList } 495 496 TDesktopOptList = class(TObjectList) 497 private 498 FXMLCfg: TRttiXMLConfig; 499 FConfigStore: TXMLOptionsStorage; 500 FEnvOpts: TEnvironmentOptions; 501 function GetItem(Index: Integer): TCustomDesktopOpt; 502 procedure SetConfig(aXMLCfg: TRttiXMLConfig; aConfigStore: TXMLOptionsStorage); 503 public 504 constructor Create(aEnvOpts: TEnvironmentOptions); 505 destructor Destroy; override; 506 procedure AddFromCfg(Path: String); 507 function IndexOf(aName: string): integer; 508 function Find(aName: string): TCustomDesktopOpt; 509 property Items[Index: Integer]: TCustomDesktopOpt read GetItem; default; 510 end; 511 512 { TIDESubOptions } 513 514 TIDESubOptions = class(TPersistent) 515 private 516 FPath: string; 517 public 518 procedure ReadFromXml(AnXmlConf: TRttiXMLConfig); 519 procedure WriteToXml(AnXmlConf: TRttiXMLConfig); 520 procedure ReadFromXml(AnXmlConf: TRttiXMLConfig; APath: String); virtual; abstract; 521 procedure WriteToXml(AnXmlConf: TRttiXMLConfig; APath: String); virtual; abstract; 522 procedure Assign(Source: TPersistent); override; 523 property Path: String read FPath; 524 end; 525 526 { TDebuggerPropertiesConfigList } 527 528 TDebuggerPropertiesConfigList = class(TStringListUTF8Fast) 529 private 530 function GetOpt(Index: Integer): TDebuggerPropertiesConfig; 531 public 532 procedure ClearAll; 533 function EntryByName(AConfName, AConfClass: String): TDebuggerPropertiesConfig; 534 function EntryByUid(AnUid: String): TDebuggerPropertiesConfig; 535 property Opt[Index: Integer]: TDebuggerPropertiesConfig read GetOpt; 536 end; 537 538 { TEnvironmentOptions - class for storing environment options } 539 540 TEnvironmentOptions = class(TIDEEnvironmentOptions) 541 private const 542 XML_PATH_DEBUGGER_CONF = 'EnvironmentOptions/Debugger/Configs/Config[%d]/'; 543 XML_PATH_DEBUGGER_CONF_OLD = 'EnvironmentOptions/Debugger/Class%s/%s/'; 544 private 545 FCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig; 546 FDebuggerAllowFunctionCalls: boolean; 547 FDebuggerAutoSetInstanceFromClass: boolean; 548 FDebuggerShowExitCodeMessage: boolean; 549 FHasActiveDebuggerEntry: Boolean; 550 fRegisteredSubConfig: TObjectList; 551 FDebuggerAutoCloseAsm: boolean; 552 // config file 553 FFilename: string; 554 FFileAge: longint; 555 FFileVersion: integer; 556 FFileHasChangedOnDisk: boolean; 557 FMaxExtToolsInParallel: integer; 558 FOldLazarusVersion: string; 559 FXMLCfg: TRttiXMLConfig; 560 FConfigStore: TXMLOptionsStorage; 561 FDbgConfigStore: TXMLOptionsStorage; // for debugger 562 563 // main buttons 564 FShowButtonGlyphs: TApplicationShowGlyphs; 565 FShowMenuGlyphs: TApplicationShowGlyphs; 566 567 // auto save 568 FAutoSaveEditorFiles: boolean; 569 FAutoSaveProject: boolean; 570 FAutoSaveIntervalInSecs: integer; 571 FLastSavedProjectFile: string; 572 FLastOpenPackages: TLastOpenPackagesList;//list of filenames with open packages 573 574 // comboboxes 575 FDropDownCount: Integer; 576 577 // designer 578 FCreateComponentFocusNameProperty: boolean; 579 FSwitchToFavoritesOITab: boolean; 580 FShowBorderSpacing: boolean; 581 FShowGrid: boolean; 582 FSnapToGrid: boolean; 583 FGridSizeX: integer; 584 FGridSizeY: integer; 585 FGridColor: TColor; 586 FShowGuideLines: boolean; 587 FSnapToGuideLines: boolean; 588 FGuideLineColorLeftTop: TColor; 589 FGuideLineColorRightBottom: TColor; 590 FShowComponentCaptions: boolean; 591 FShowEditorHints: boolean; 592 FAutoCreateFormsOnOpen: boolean; 593 FRightClickSelects: boolean; 594 FGrabberColor: TColor; 595 FMarkerColor: TColor; 596 FNonFormBackgroundColor: TColor; 597 FRubberbandSelectionColor: TColor; 598 FRubberbandCreationColor: TColor; 599 FRubberbandSelectsGrandChilds: boolean; 600 FCheckPackagesOnFormCreate: boolean; 601 FFormTitleBarChangesObjectInspector: boolean; 602 FForceDPIScalingInDesignTime: boolean; 603 604 // object inspector 605 FObjectInspectorOptions: TOIOptions; 606 // project inspector 607 FProjInspSortAlphabetically: boolean; 608 FProjInspShowDirHierarchy: boolean; 609 // package editor 610 FPackageEditorSortAlphabetically: boolean; 611 FPackageEditorShowDirHierarchy: boolean; 612 // procedure list 613 FProcedureListFilterStart: boolean; 614 615 // hints 616 FAskSaveSessionOnly: boolean; 617 FCheckDiskChangesWithLoading: boolean; 618 FShowHintsForComponentPalette: boolean; 619 FShowHintsForMainSpeedButtons: boolean; 620 621 // messages 622 fMsgViewDblClickJumps: boolean; 623 fMsgViewFocus: boolean; 624 FShowMessagesIcons: boolean; 625 FMsgViewStayOnTop: boolean; 626 FMsgViewShowTranslations: boolean; 627 FMsgViewAlwaysDrawFocused: boolean; 628 FMsgViewFilenameStyle: TMsgWndFileNameStyle; 629 fMsgViewColors: array[TMsgWndColor] of TColor; 630 fMsgColors: array[TMessageLineUrgency] of TColor; 631 FShowCompileDialog: Boolean; // show dialog during compile 632 FAutoCloseCompileDialog: Boolean; // auto close dialog after succesed compile 633 FMsgViewFilters: TLMsgViewFilters; 634 FMsgViewShowFPCMsgLinesCompiled: Boolean; 635 636 // compiler + debugger + lazarus files 637 FParseValues: array[TEnvOptParseType] of TParseString; 638 FLazarusDirHistory: TStringList; 639 FCompilerFileHistory: TStringList; 640 FFPCSourceDirHistory: TStringList; 641 FMakeFileHistory: TStringList; 642 FTestBuildDirHistory: TStringList; 643 FCompilerMessagesFileHistory: TStringList; 644 FManyBuildModesSelection: TStringList; 645 FBuildMatrixOptions: TBuildMatrixOptions; 646 FIsGlobalMode: TStrToBoolEvent; 647 648 // Clean build project dialog 649 FCleanBuildProjOut: Boolean; 650 FCleanBuildProjSrc: Boolean; 651 FCleanBuildPkgOut: Boolean; 652 FCleanBuildPkgSrc: Boolean; 653 654 // Primary-config verification 655 FLastCalledByLazarusFullPath: String; 656 657 // TODO: store per debuggerclass options 658 // Maybe these should go to a new TDebuggerOptions class 659 FDebuggerResetAfterRun: boolean; 660 FDebuggerConfig: TDebuggerConfigStore; 661 FDebuggerFileHistory: TStringList; // per debugger class 662 FDebuggerProperties: TDebuggerPropertiesConfigList; // named entries 663 FKnownDebuggerClassCount: Integer; 664 FDebuggerShowStopMessage: Boolean; 665 FDebuggerEventLogClearOnRun: Boolean; 666 FDebuggerEventLogCheckLineLimit: Boolean; 667 FDebuggerEventLogLineLimit: Integer; 668 FDebuggerEventLogShowBreakpoint: Boolean; 669 FDebuggerEventLogShowDebugger: Boolean; 670 FDebuggerEventLogShowModule: Boolean; 671 FDebuggerEventLogShowOutput: Boolean; 672 FDebuggerEventLogShowProcess: Boolean; 673 FDebuggerEventLogShowThread: Boolean; 674 FDebuggerEventLogShowWindows: Boolean; 675 FDebuggerEventLogUseColors: Boolean; 676 FDebuggerEventLogColors: array[TDBGEventType] of TDebuggerEventLogColor; 677 678 // recent files and directories 679 FRecentOpenFiles: TStringList; 680 FMaxRecentOpenFiles: integer; 681 FRecentProjectFiles: TStringList; 682 FMaxRecentProjectFiles: integer; 683 FRecentPackageFiles: TStringList; 684 FMaxRecentPackageFiles: integer; 685 FOpenLastProjectAtStart: boolean; 686 FNewProjectTemplateAtStart: string; 687 FMultipleInstances: TIDEMultipleInstancesOption; 688 // Prevent repopulating Recent project files menu with example projects if it was already cleared up. 689 FAlreadyPopulatedRecentFiles : Boolean; 690 691 //other recent settings 692 FLastEventMethodCCResult: TCodeCreationDlgResult; 693 FLastVariableCCResult: TCodeCreationDlgResult; 694 FUseUnitDlgOptions: TUseUnitDlgOptions; 695 696 // backup 697 FBackupInfoProjectFiles: TBackupInfo; 698 FBackupInfoOtherFiles: TBackupInfo; 699 700 // external tools 701 fExternalUserTools: TBaseExternalUserTools; // see ExtToolEditDlg.TExternalUserTools 702 703 // naming conventions 704 fPascalFileExtension: TPascalExtType; 705 fCharcaseFileAction: TCharCaseFileAction; 706 fAmbiguousFileAction: TAmbiguousFileAction; 707 FUnitRenameReferencesAction: TUnitRenameReferencesAction; 708 FAskForFilenameOnNewFile: boolean; 709 FLowercaseDefaultFilename: boolean; 710 711 // language ID (see LazarusTranslations in translations.pas) 712 fLanguageID: string; 713 714 // 'new items' 715 FNewFormTemplate: string; 716 FNewUnitTemplate: string; 717 FFileDialogFilter: string; 718 719 //component list 720 FComponentListKeepOpen: Boolean; 721 FComponentListPageIndex: Integer; 722 723 // Desktop 724 FDesktops: TDesktopOptList; 725 FDesktop: TDesktopOpt; 726 FLastDesktopBeforeDebug: TDesktopOpt; 727 FActiveDesktopName: string; 728 FAutoSaveActiveDesktop: Boolean; 729 FDebugDesktopName: string; 730 FFppkgConfigFileHistory: TStringList; 731 732 function GetActiveDesktop: TDesktopOpt; 733 function GetCompilerFilename: string; 734 function GetCompilerMessagesFilename: string; 735 function GetCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig; 736 function GetDebugDesktop: TDesktopOpt; 737 function GetDebuggerEventLogColors(AIndex: TDBGEventType): TDebuggerEventLogColor; 738 function GetDebuggerSearchPath: string; 739 function GetFPCSourceDirectory: string; 740 function GetFPDocPaths: string; 741 function GetLazarusDirectory: string; 742 function GetMakeFilename: string; 743 function GetMsgColors(u: TMessageLineUrgency): TColor; 744 function GetMsgViewColors(c: TMsgWndColor): TColor; 745 function GetNamedDebuggerFileHistory(AnIndex: String): TStringList; 746 function GetSubConfig(Index: Integer): TIDESubOptions; 747 function GetTestBuildDirectory: string; 748 function GetFppkgConfigFile: string; 749 procedure LoadNonDesktop(Path: String); 750 procedure SaveNonDesktop(Path: String); 751 procedure SetCompilerFilename(const AValue: string); 752 procedure SetCompilerMessagesFilename(AValue: string); 753 procedure SetCurrentDebuggerPropertiesOpt(AValue: TDebuggerPropertiesConfig); 754 procedure SetDebuggerEventLogColors(AIndex: TDBGEventType; 755 const AValue: TDebuggerEventLogColor); 756 procedure SetDebuggerSearchPath(const AValue: string); 757 procedure SetFPDocPaths(const AValue: string); 758 procedure SetMakeFilename(const AValue: string); 759 procedure SetFPCSourceDirectory(const AValue: string); 760 procedure SetLazarusDirectory(const AValue: string); 761 procedure SetFppkgConfigFile(AValue: string); 762 procedure SetMsgColors(u: TMessageLineUrgency; AValue: TColor); 763 procedure SetMsgViewColors(c: TMsgWndColor; AValue: TColor); 764 procedure SetParseValue(o: TEnvOptParseType; const NewValue: string); 765 766 procedure SetFileName(const NewFilename: string); 767 function FileHasChangedOnDisk: boolean; 768 procedure InitXMLCfg(CleanConfig: boolean); 769 procedure FileUpdated; 770 procedure SetTestBuildDirectory(const AValue: string); 771 procedure LoadDebuggerProperties; 772 public 773 class function GetGroupCaption:string; override; 774 class function GetInstance: TAbstractIDEOptions; override; 775 procedure DoAfterWrite(Restore: boolean); override; 776 procedure RegisterSubConfig(ASubConfig: TIDESubOptions; APath: String); 777 procedure UnRegisterSubConfig(ASubConfig: TIDESubOptions); 778 function SubConfigCount: integer; 779 property SubConfig[Index: Integer]: TIDESubOptions read GetSubConfig; 780 public 781 constructor Create; 782 destructor Destroy; override; 783 procedure Load(OnlyDesktop: boolean); 784 procedure Save(OnlyDesktop: boolean); 785 property IsGlobalMode: TStrToBoolEvent read FIsGlobalMode write FIsGlobalMode; 786 property Filename: string read FFilename write SetFilename; 787 function GetDefaultConfigFilename: string; 788 procedure CreateConfig; 789 property OldLazarusVersion: string read FOldLazarusVersion; 790 791 function GetParsedLazarusDirectory: string; 792 function GetParsedTestBuildDirectory: string; 793 function GetParsedCompilerFilename: string; override; 794 function GetParsedFPCSourceDirectory(FPCVer: string = ''): string; 795 function GetParsedMakeFilename: string; 796 function GetParsedCompilerMessagesFilename: string; 797 function GetParsedFPDocPaths: string; 798 function GetParsedDebuggerFilename(TheProject: TLazProject = nil): string; 799 function GetParsedDebuggerSearchPath: string; 800 function GetParsedFppkgConfig: string; override; 801 function GetParsedValue(o: TEnvOptParseType; AUnparsedValue: String = ''): string; 802 803 // macros 804 procedure InitMacros(AMacroList: TTransferMacroList); 805 function MacroFuncFPCSrcDir(const {%H-}s:string; const {%H-}Data: PtrInt; 806 var {%H-}Abort: boolean): string; 807 function MacroFuncLazarusDir(const {%H-}s:string; const {%H-}Data: PtrInt; 808 var {%H-}Abort: boolean): string; 809 function MacroFuncExeExt(const {%H-}s:string; const {%H-}Data: PtrInt; 810 var {%H-}Abort: boolean): string; 811 function MacroFuncLanguageID(const {%H-}s:string; const {%H-}Data: PtrInt; 812 var {%H-}Abort: boolean): string; 813 function MacroFuncLanguageName(const {%H-}s:string; const {%H-}Data: PtrInt; 814 var {%H-}Abort: boolean): string; 815 function MacroFuncTestDir(const {%H-}s:string; const {%H-}Data: PtrInt; 816 var {%H-}Abort: boolean): string; 817 function MacroFuncConfDir(const {%H-}s:string; const {%H-}Data: PtrInt; 818 var {%H-}Abort: boolean): string; 819 820 procedure UseDesktop(ADesktop: TDesktopOpt); 821 procedure EnableDebugDesktop; 822 procedure DisableDebugDesktop; 823 class function DesktopCanBeLoaded(const aDockMaster: string): Boolean; 824 825 // auto save 826 // ask even if only project session needs saving 827 property AskSaveSessionOnly: boolean read FAskSaveSessionOnly write FAskSaveSessionOnly; 828 property AutoSaveEditorFiles: boolean read FAutoSaveEditorFiles write FAutoSaveEditorFiles; 829 property AutoSaveProject: boolean read FAutoSaveProject write FAutoSaveProject; 830 property AutoSaveIntervalInSecs: integer read FAutoSaveIntervalInSecs write FAutoSaveIntervalInSecs; 831 832 // form editor 833 property ShowBorderSpacing: boolean read FShowBorderSpacing write FShowBorderSpacing; 834 property ShowGrid: boolean read FShowGrid write FShowGrid; 835 property SnapToGrid: boolean read FSnapToGrid write FSnapToGrid; 836 property GridColor: TColor read FGridColor write FGridColor; 837 property GridSizeX: integer read FGridSizeX write FGridSizeX; 838 property GridSizeY: integer read FGridSizeY write FGridSizeY; 839 property ShowGuideLines: boolean read FShowGuideLines write FShowGuideLines; 840 property SnapToGuideLines: boolean read FSnapToGuideLines write FSnapToGuideLines; 841 property GuideLineColorLeftTop: TColor read FGuideLineColorLeftTop 842 write FGuideLineColorLeftTop; 843 property GuideLineColorRightBottom: TColor read FGuideLineColorRightBottom 844 write FGuideLineColorRightBottom; 845 property ShowComponentCaptions: boolean read FShowComponentCaptions 846 write FShowComponentCaptions; 847 property ShowEditorHints: boolean read FShowEditorHints 848 write FShowEditorHints; 849 property AutoCreateFormsOnOpen: boolean read FAutoCreateFormsOnOpen 850 write FAutoCreateFormsOnOpen; 851 property CheckPackagesOnFormCreate: boolean read FCheckPackagesOnFormCreate 852 write FCheckPackagesOnFormCreate; 853 property RightClickSelects: boolean read FRightClickSelects 854 write FRightClickSelects; 855 property GrabberColor: TColor read FGrabberColor write FGrabberColor; 856 property MarkerColor: TColor read FMarkerColor write FMarkerColor; 857 property NonFormBackgroundColor: TColor read FNonFormBackgroundColor 858 write FNonFormBackgroundColor; 859 property RubberbandSelectionColor: TColor read FRubberbandSelectionColor 860 write FRubberbandSelectionColor; 861 property RubberbandCreationColor: TColor read FRubberbandCreationColor 862 write FRubberbandCreationColor; 863 property RubberbandSelectsGrandChilds: boolean read FRubberbandSelectsGrandChilds 864 write FRubberbandSelectsGrandChilds; 865 property CreateComponentFocusNameProperty: boolean read FCreateComponentFocusNameProperty 866 write FCreateComponentFocusNameProperty; 867 property SwitchToFavoritesOITab: boolean read FSwitchToFavoritesOITab 868 write FSwitchToFavoritesOITab; 869 property FormTitleBarChangesObjectInspector: boolean read FFormTitleBarChangesObjectInspector 870 write FFormTitleBarChangesObjectInspector; 871 property ForceDPIScalingInDesignTime: boolean read FForceDPIScalingInDesignTime 872 write FForceDPIScalingInDesignTime; 873 874 // object inspector 875 property ObjectInspectorOptions: TOIOptions read FObjectInspectorOptions; 876 877 // project inspector 878 property ProjInspSortAlphabetically: boolean read FProjInspSortAlphabetically 879 write FProjInspSortAlphabetically; 880 property ProjInspShowDirHierarchy: boolean read FProjInspShowDirHierarchy 881 write FProjInspShowDirHierarchy; 882 // package editor 883 property PackageEditorSortAlphabetically: boolean read FPackageEditorSortAlphabetically 884 write FPackageEditorSortAlphabetically; 885 property PackageEditorShowDirHierarchy: boolean read FPackageEditorShowDirHierarchy 886 write FPackageEditorShowDirHierarchy; 887 // procedure list 888 property ProcedureListFilterStart: boolean read FProcedureListFilterStart 889 write FProcedureListFilterStart; 890 // hints 891 property CheckDiskChangesWithLoading: boolean read FCheckDiskChangesWithLoading 892 write FCheckDiskChangesWithLoading; 893 property ShowHintsForComponentPalette: boolean read FShowHintsForComponentPalette 894 write FShowHintsForComponentPalette; 895 property ShowHintsForMainSpeedButtons: boolean read FShowHintsForMainSpeedButtons 896 write FShowHintsForMainSpeedButtons; 897 // files 898 property LazarusDirectory: string read GetLazarusDirectory write SetLazarusDirectory; 899 property LazarusDirHistory: TStringList read FLazarusDirHistory write FLazarusDirHistory; 900 property CompilerFilename: string read GetCompilerFilename write SetCompilerFilename; 901 property CompilerFileHistory: TStringList read FCompilerFileHistory write FCompilerFileHistory; 902 property FPCSourceDirectory: string read GetFPCSourceDirectory write SetFPCSourceDirectory; 903 property FPCSourceDirHistory: TStringList read FFPCSourceDirHistory; 904 property MakeFilename: string read GetMakeFilename write SetMakeFilename; 905 property MakeFileHistory: TStringList read FMakeFileHistory; 906 function DebuggerFilename(TheProject: TLazProject = nil): string; 907 property DebuggerFileHistory[AnIndex: String]: TStringList read GetNamedDebuggerFileHistory; 908 property DebuggerSearchPath: string read GetDebuggerSearchPath write SetDebuggerSearchPath; 909 property DebuggerShowStopMessage: boolean read FDebuggerShowStopMessage write FDebuggerShowStopMessage; 910 property DebuggerShowExitCodeMessage: boolean read FDebuggerShowExitCodeMessage write FDebuggerShowExitCodeMessage; 911 property DebuggerResetAfterRun: boolean read FDebuggerResetAfterRun write FDebuggerResetAfterRun; 912 property DebuggerAutoCloseAsm: boolean read FDebuggerAutoCloseAsm write FDebuggerAutoCloseAsm; 913 property DebuggerAutoSetInstanceFromClass: boolean read FDebuggerAutoSetInstanceFromClass write FDebuggerAutoSetInstanceFromClass; 914 property DebuggerAllowFunctionCalls: boolean read FDebuggerAllowFunctionCalls write FDebuggerAllowFunctionCalls; 915 property FppkgConfigFile: string read GetFppkgConfigFile write SetFppkgConfigFile; 916 property FppkgConfigFileHistory: TStringList read FFppkgConfigFileHistory write FFppkgConfigFileHistory; 917 // ShowCompileDialog and AutoCloseCompileDialog are currently not used. 918 // But maybe someone will implement them again. Keep them till 1.4.2 919 property ShowCompileDialog: boolean read FShowCompileDialog write FShowCompileDialog; 920 property AutoCloseCompileDialog: boolean read FAutoCloseCompileDialog write FAutoCloseCompileDialog; 921 property TestBuildDirectory: string read GetTestBuildDirectory write SetTestBuildDirectory; 922 property TestBuildDirHistory: TStringList read FTestBuildDirHistory; 923 property CompilerMessagesFilename: string read GetCompilerMessagesFilename 924 write SetCompilerMessagesFilename; // non English translation file 925 property CompilerMessagesFileHistory: TStringList read FCompilerMessagesFileHistory; 926 // ToDo: Remove this from trunk after Lazarus 2.2.0 is out. Now for backwards compatibility. 927 property ManyBuildModesSelection: TStringList read FManyBuildModesSelection; 928 929 // Primary-config verification 930 property LastCalledByLazarusFullPath: String read FLastCalledByLazarusFullPath write FLastCalledByLazarusFullPath; 931 932 // global build options 933 property BuildMatrixOptions: TBuildMatrixOptions read FBuildMatrixOptions; 934 935 // Clean build project dialog 936 property CleanBuildProjOut: Boolean read FCleanBuildProjOut write FCleanBuildProjOut; 937 property CleanBuildProjSrc: Boolean read FCleanBuildProjSrc write FCleanBuildProjSrc; 938 property CleanBuildPkgOut: Boolean read FCleanBuildPkgOut write FCleanBuildPkgOut; 939 property CleanBuildPkgSrc: Boolean read FCleanBuildPkgSrc write FCleanBuildPkgSrc; 940 941 // Debugger 942 procedure SaveDebuggerPropertiesList; 943 function CurrentDebuggerClass(TheProject: TLazProject = nil): TDebuggerClass; 944 function DebuggerPropertiesConfigList: TDebuggerPropertiesConfigList; 945 function CurrentDebuggerPropertiesConfigEx(TheProject: TLazProject): TDebuggerPropertiesConfig; 946 property CurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig read GetCurrentDebuggerPropertiesConfig write SetCurrentDebuggerPropertiesOpt; 947 property HasActiveDebuggerEntry: Boolean read FHasActiveDebuggerEntry write FHasActiveDebuggerEntry; // for the initial setup dialog / entry may be of unknown class 948 property DebuggerConfig: TDebuggerConfigStore read FDebuggerConfig; 949 950 // Debugger event log 951 property DebuggerEventLogClearOnRun: Boolean read FDebuggerEventLogClearOnRun write FDebuggerEventLogClearOnRun; 952 property DebuggerEventLogCheckLineLimit: Boolean read FDebuggerEventLogCheckLineLimit write FDebuggerEventLogCheckLineLimit; 953 property DebuggerEventLogLineLimit: Integer read FDebuggerEventLogLineLimit write FDebuggerEventLogLineLimit; 954 property DebuggerEventLogShowBreakpoint: Boolean read FDebuggerEventLogShowBreakpoint write FDebuggerEventLogShowBreakpoint; 955 property DebuggerEventLogShowProcess: Boolean read FDebuggerEventLogShowProcess write FDebuggerEventLogShowProcess; 956 property DebuggerEventLogShowThread: Boolean read FDebuggerEventLogShowThread write FDebuggerEventLogShowThread; 957 property DebuggerEventLogShowModule: Boolean read FDebuggerEventLogShowModule write FDebuggerEventLogShowModule; 958 property DebuggerEventLogShowOutput: Boolean read FDebuggerEventLogShowOutput write FDebuggerEventLogShowOutput; 959 property DebuggerEventLogShowWindows: Boolean read FDebuggerEventLogShowWindows write FDebuggerEventLogShowWindows; 960 property DebuggerEventLogShowDebugger: Boolean read FDebuggerEventLogShowDebugger write FDebuggerEventLogShowDebugger; 961 property DebuggerEventLogUseColors: Boolean read FDebuggerEventLogUseColors write FDebuggerEventLogUseColors; 962 property DebuggerEventLogColors[AIndex: TDBGEventType]: TDebuggerEventLogColor read GetDebuggerEventLogColors write SetDebuggerEventLogColors; 963 964 // recent files and directories 965 property RecentOpenFiles: TStringList read FRecentOpenFiles; 966 property MaxRecentOpenFiles: integer read FMaxRecentOpenFiles 967 write FMaxRecentOpenFiles; 968 procedure AddToRecentOpenFiles(const AFilename: string); override; 969 procedure RemoveFromRecentOpenFiles(const AFilename: string); override; 970 Procedure GetRecentFiles(aType: TIDERecentHandler; aList : TStrings); override; 971 property RecentProjectFiles: TStringList read FRecentProjectFiles; 972 property MaxRecentProjectFiles: integer read FMaxRecentProjectFiles 973 write FMaxRecentProjectFiles; 974 procedure AddToRecentProjectFiles(const AFilename: string); override; 975 procedure RemoveFromRecentProjectFiles(const AFilename: string); override; 976 property RecentPackageFiles: TStringList read FRecentPackageFiles; 977 property MaxRecentPackageFiles: integer read FMaxRecentPackageFiles 978 write FMaxRecentPackageFiles; 979 procedure AddToRecentPackageFiles(const AFilename: string); override; 980 procedure RemoveFromRecentPackageFiles(const AFilename: string); override; 981 property LastSavedProjectFile: string read FLastSavedProjectFile 982 write FLastSavedProjectFile; { if empty then create new project, 983 if '-' then do not load/create any project } 984 property LastOpenPackages: TLastOpenPackagesList read FLastOpenPackages; 985 property OpenLastProjectAtStart: boolean read FOpenLastProjectAtStart 986 write FOpenLastProjectAtStart; 987 property NewProjectTemplateAtStart: string read FNewProjectTemplateAtStart 988 write FNewProjectTemplateAtStart; 989 property MultipleInstances: TIDEMultipleInstancesOption read FMultipleInstances 990 write FMultipleInstances; 991 property FileDialogFilter: string read FFileDialogFilter write FFileDialogFilter; 992 993 // other recent settings 994 property LastEventMethodCCResult: TCodeCreationDlgResult 995 read FLastEventMethodCCResult write FLastEventMethodCCResult; 996 property LastVariableCCResult: TCodeCreationDlgResult 997 read FLastVariableCCResult write FLastVariableCCResult; 998 property UseUnitDlgOptions: TUseUnitDlgOptions 999 read FUseUnitDlgOptions write FUseUnitDlgOptions; 1000 1001 // backup 1002 property BackupInfoProjectFiles: TBackupInfo read FBackupInfoProjectFiles 1003 write FBackupInfoProjectFiles; 1004 property BackupInfoOtherFiles: TBackupInfo read FBackupInfoOtherFiles 1005 write FBackupInfoOtherFiles; 1006 // external tools 1007 property ExternalToolMenuItems: TBaseExternalUserTools read fExternalUserTools; 1008 property MaxExtToolsInParallel: integer read FMaxExtToolsInParallel 1009 write FMaxExtToolsInParallel; // 0=automatic 1010 // naming conventions 1011 property PascalFileExtension: TPascalExtType read fPascalFileExtension 1012 write fPascalFileExtension; 1013 property AmbiguousFileAction: TAmbiguousFileAction read fAmbiguousFileAction 1014 write fAmbiguousFileAction; 1015 property CharcaseFileAction: TCharCaseFileAction read fCharcaseFileAction 1016 write fCharcaseFileAction; 1017 property UnitRenameReferencesAction: TUnitRenameReferencesAction 1018 read FUnitRenameReferencesAction 1019 write FUnitRenameReferencesAction; 1020 property AskForFilenameOnNewFile: boolean read FAskForFilenameOnNewFile 1021 write FAskForFilenameOnNewFile; 1022 property LowercaseDefaultFilename: boolean read FLowercaseDefaultFilename 1023 write FLowercaseDefaultFilename; 1024 // fpdoc 1025 property FPDocPaths: string read GetFPDocPaths write SetFPDocPaths; 1026 1027 // language 1028 property LanguageID: string read fLanguageID write fLanguageID; 1029 1030 // messages view 1031 property MsgViewDblClickJumps: boolean read fMsgViewDblClickJumps 1032 write fMsgViewDblClickJumps; // true=dbl click jump to error, false=single click jumps 1033 property MsgViewFocus: boolean read fMsgViewFocus 1034 write fMsgViewFocus; // when showing the message window, focus it 1035 property ShowMessagesIcons: boolean read FShowMessagesIcons write FShowMessagesIcons; 1036 property MsgViewStayOnTop: boolean read FMsgViewStayOnTop write FMsgViewStayOnTop; 1037 property MsgViewShowTranslations: boolean read FMsgViewShowTranslations 1038 write FMsgViewShowTranslations; 1039 property MsgViewAlwaysDrawFocused: boolean read FMsgViewAlwaysDrawFocused 1040 write FMsgViewAlwaysDrawFocused; 1041 property MsgViewFilenameStyle: TMsgWndFileNameStyle read FMsgViewFilenameStyle 1042 write FMsgViewFilenameStyle; 1043 property MsgViewColors[c: TMsgWndColor]: TColor read GetMsgViewColors write SetMsgViewColors; 1044 property MsgViewFilters: TLMsgViewFilters read FMsgViewFilters; 1045 property MsgColors[u: TMessageLineUrgency]: TColor read GetMsgColors write SetMsgColors; 1046 property MsgViewShowFPCMsgLinesCompiled: Boolean read FMsgViewShowFPCMsgLinesCompiled write FMsgViewShowFPCMsgLinesCompiled; 1047 1048 //component list 1049 property ComponentListKeepOpen: Boolean read FComponentListKeepOpen write FComponentListKeepOpen; 1050 property ComponentListPageIndex: Integer read FComponentListPageIndex write FComponentListPageIndex; 1051 1052 // glyphs 1053 property ShowButtonGlyphs: TApplicationShowGlyphs read FShowButtonGlyphs write FShowButtonGlyphs; 1054 property ShowMenuGlyphs: TApplicationShowGlyphs read FShowMenuGlyphs write FShowMenuGlyphs; 1055 // comboboxes 1056 property DropDownCount: Integer read FDropDownCount write FDropDownCount; 1057 // default template for each 'new item' category: Name=Path, Value=TemplateName 1058 property NewUnitTemplate: string read FNewUnitTemplate write FNewUnitTemplate; 1059 property NewFormTemplate: string read FNewFormTemplate write FNewFormTemplate; 1060 // Desktop 1061 property Desktops: TDesktopOptList read FDesktops; 1062 property Desktop: TDesktopOpt read FDesktop; // the working desktop, standalone 1063 property DebugDesktopName: string read FDebugDesktopName write FDebugDesktopName; 1064 property DebugDesktop: TDesktopOpt read GetDebugDesktop; // debug desktop from Desktops list 1065 property ActiveDesktopName: string read FActiveDesktopName write FActiveDesktopName; 1066 property ActiveDesktop: TDesktopOpt read GetActiveDesktop; // active desktop from Desktops list 1067 property AutoSaveActiveDesktop: Boolean read FAutoSaveActiveDesktop write FAutoSaveActiveDesktop; 1068 end; 1069 1070var 1071 OverrideFPCVer: string = ''; 1072 EnvironmentOptions: TEnvironmentOptions = nil; 1073 1074function PascalExtToType(const Ext: string): TPascalExtType; 1075function AmbiguousFileActionNameToType(const Action: string): TAmbiguousFileAction; 1076function CharCaseFileActionNameToType(const Action: string): TCharCaseFileAction; 1077function UnitRenameReferencesActionNameToType(const Action: string): TUnitRenameReferencesAction; 1078function StrToMsgWndFilenameStyle(const s: string): TMsgWndFileNameStyle; 1079function StrToIDEMultipleInstancesOption(const s: string): TIDEMultipleInstancesOption; 1080function BackupTypeToName(b: TBackupType): string; 1081function NameToBackupType(const s: string): TBackupType; 1082 1083function SimpleDirectoryCheck(const OldDir, NewDir, 1084 NotFoundErrMsg: string; out StopChecking: boolean): boolean; 1085 1086const 1087 DefaultMsgViewFocus = {$IFDEF Windows}true{$ELSE}false{$ENDIF}; 1088 MaxComboBoxCount: integer = 20; 1089 EnvOptsConfFileName = 'environmentoptions.xml'; 1090 BakMaxCounterInfiniteTxt = 'infinite'; 1091 1092 EnvOptParseTypeNames: array[TEnvOptParseType] of string = ( 1093 'LazarusDir', // eopLazarusDirectory 1094 'CompPath', // eopCompilerFilename 1095 'FPCSrcDir', // eopFPCSourceDirectory 1096 'TestDir', // eopTestBuildDirectory 1097 'Make', // eopMakeFilename 1098 'FPDocPath', // eopFPDocPaths 1099 'CompMsgFile', // eopCompilerMessagesFilename 1100 'Debugger', // eopDebuggerFilename 1101 'DebugPath', // eopDebuggerSearchPath 1102 'FppkgConfig' // eopFppkgConfigFile 1103 ); 1104 1105function dbgs(o: TEnvOptParseType): string; overload; 1106function dbgs(u: TMessageLineUrgency): string; overload; 1107 1108implementation 1109 1110function PascalExtToType(const Ext: string): TPascalExtType; 1111begin 1112 if Ext<>'' then 1113 for Result:=Low(TPascalExtType) to High(TPascalExtType) do 1114 if CompareFilenames(Ext,PascalExtension[Result])=0 then exit; 1115 Result:=petNone; 1116end; 1117 1118function AmbiguousFileActionNameToType( 1119 const Action: string): TAmbiguousFileAction; 1120begin 1121 for Result:=Low(TAmbiguousFileAction) to High(TAmbiguousFileAction) do 1122 if CompareText(AmbiguousFileActionNames[Result],Action)=0 then 1123 exit; 1124 Result:=afaAsk; 1125end; 1126 1127function CharCaseFileActionNameToType( 1128 const Action: string): TCharCaseFileAction; 1129begin 1130 for Result:=Low(TCharCaseFileAction) to High(TCharCaseFileAction) do 1131 if CompareText(CharCaseFileActionNames[Result],Action)=0 then 1132 exit; 1133 Result:=ccfaAutoRename; 1134end; 1135 1136function UnitRenameReferencesActionNameToType(const Action: string 1137 ): TUnitRenameReferencesAction; 1138begin 1139 for Result:=Low(TUnitRenameReferencesAction) to High(TUnitRenameReferencesAction) do 1140 if CompareText(UnitRenameReferencesActionNames[Result],Action)=0 then 1141 exit; 1142 Result:=urraAsk; 1143end; 1144 1145function StrToMsgWndFilenameStyle(const s: string): TMsgWndFileNameStyle; 1146begin 1147 for Result in TMsgWndFileNameStyle do 1148 if CompareText(s,MsgWndFileNameStyleNames[Result])=0 then exit; 1149 Result:=mwfsShort; 1150end; 1151 1152function StrToIDEMultipleInstancesOption(const s: string): TIDEMultipleInstancesOption; 1153begin 1154 for Result in TIDEMultipleInstancesOption do 1155 if CompareText(s,IDEMultipleInstancesOptionNames[Result])=0 then exit; 1156 Result:=DefaultIDEMultipleInstancesOption; 1157end; 1158 1159function BackupTypeToName(b: TBackupType): string; 1160begin 1161 Str(b,Result); 1162 Delete(Result,1,length('bak')); 1163end; 1164 1165function NameToBackupType(const s: string): TBackupType; 1166var 1167 b: TBackupType; 1168begin 1169 for b in TBackupType do 1170 if CompareText(s,BackupTypeToName(b))=0 then exit(b); 1171 Result:=bakNone; 1172end; 1173 1174function SimpleDirectoryCheck(const OldDir, NewDir, 1175 NotFoundErrMsg: string; out StopChecking: boolean): boolean; 1176var 1177 SubResult: TModalResult; 1178begin 1179 StopChecking:=true; 1180 if OldDir=NewDir then begin 1181 Result:=true; 1182 exit; 1183 end; 1184 SubResult:=CheckDirPathExists(NewDir,lisEnvOptDlgDirectoryNotFound, 1185 NotFoundErrMsg); 1186 if SubResult=mrIgnore then begin 1187 Result:=true; 1188 exit; 1189 end; 1190 if SubResult=mrCancel then begin 1191 Result:=false; 1192 exit; 1193 end; 1194 StopChecking:=false; 1195 Result:=true; 1196end; 1197 1198function dbgs(o: TEnvOptParseType): string; 1199begin 1200 Result:=EnvOptParseTypeNames[o]; 1201end; 1202 1203function dbgs(u: TMessageLineUrgency): string; 1204begin 1205 WriteStr(Result, u); 1206end; 1207 1208{ TDebuggerPropertiesConfigList } 1209 1210function TDebuggerPropertiesConfigList.GetOpt(Index: Integer): TDebuggerPropertiesConfig; 1211begin 1212 Result := TDebuggerPropertiesConfig(Objects[Index]); 1213end; 1214 1215procedure TDebuggerPropertiesConfigList.ClearAll; 1216var 1217 i: Integer; 1218begin 1219 for i := 0 to Count - 1 do 1220 Objects[i].Free; 1221 Clear; 1222end; 1223 1224function TDebuggerPropertiesConfigList.EntryByName(AConfName, AConfClass: String 1225 ): TDebuggerPropertiesConfig; 1226var 1227 i: Integer; 1228 dpCfg: TDebuggerPropertiesConfig; 1229begin 1230 Result := nil; 1231 i := Count - 1; 1232 while i >= 0 do begin 1233 dpCfg := Opt[i]; 1234 if (not dpCfg.IsDeleted) and dpCfg.IsLoaded 1235 and (dpCfg.ConfigName = AConfName) 1236 and (dpCfg.ConfigClass = AConfClass) then 1237 Break; 1238 dec(i); 1239 end; 1240 if i >= 0 then 1241 Result := dpCfg; 1242end; 1243 1244function TDebuggerPropertiesConfigList.EntryByUid(AnUid: String 1245 ): TDebuggerPropertiesConfig; 1246var 1247 i: Integer; 1248begin 1249 Result := nil; 1250 i := Count - 1; 1251 while (i >= 0) and (Opt[i].UID <> AnUid) do 1252 dec(i); 1253 if i >= 0 then 1254 Result := Opt[i]; 1255end; 1256 1257{ TDebuggerPropertiesConfig } 1258 1259procedure TDebuggerPropertiesConfig.InitUID; 1260var 1261 g: TGUID; 1262begin 1263 if FUID <> '' then 1264 exit; 1265 1266 if CreateGUID(g) = 0 then 1267 FUID := GUIDToString(g) 1268 else 1269 FUID := IntToHex(Random($100000000), 8)+'-'+IntToHex(Random($100000000), 8)+'-'+IntToHex(Random($100000000), 8); 1270end; 1271 1272destructor TDebuggerPropertiesConfig.Destroy; 1273begin 1274 inherited Destroy; 1275 FreeAndNil(FDebuggerProperties); 1276end; 1277 1278constructor TDebuggerPropertiesConfig.CreateFromXmlConf( 1279 AXMLCfg: TRttiXMLConfig; APath: String; AIndex: Integer); 1280begin 1281 Create; 1282 FIsFromOldXml := False; 1283 FFLags := []; 1284 1285 APath := Format(APath, [AIndex]); 1286 AXMLCfg.ReadObject(APath, Self); 1287 FXmlIndex := AIndex; 1288 1289 FDebuggerClass := TBaseDebugManagerIntf.DebuggersByClassName[ConfigClass]; 1290 if FDebuggerClass <> nil then begin 1291 FDebuggerProperties := FDebuggerClass.CreateProperties; 1292 AXMLCfg.ReadObject(APath + 'Properties/', FDebuggerProperties); 1293 FFLags := [dpcLoaded]; 1294 end; 1295 1296 InitUID; 1297end; 1298 1299constructor TDebuggerPropertiesConfig.CreateFromOldXmlConf( 1300 AXMLCfg: TRttiXMLConfig; APath: String; ADebuggerClass: TDebuggerClass; 1301 AForceLoad: Boolean); 1302var 1303 p: String; 1304begin 1305 Create; 1306 FIsFromOldXml := True; 1307 FFLags := []; 1308 1309 p := Format(APath, [ADebuggerClass.ClassName, 'Config']); 1310 if AXMLCfg.HasPath(p, False) then 1311 AForceLoad := True; 1312 // Read first, so any (invalid) Class/Name will be cleared after reading 1313 AXMLCfg.ReadObject(p, Self); // read FDebuggerFilename; 1314 1315 FConfigClass := ADebuggerClass.ClassName; 1316 FConfigClassInOldXml := FConfigClass; 1317 FConfigName := ''; 1318 FXmlIndex := -1; 1319 1320 APath := Format(APath, [FConfigClass, 'Properties']); 1321 if AForceLoad or AXMLCfg.HasPath(APath, False) then begin 1322 FDebuggerClass := ADebuggerClass; 1323 FDebuggerProperties := ADebuggerClass.CreateProperties; 1324 AXMLCfg.ReadObject(APath, FDebuggerProperties); 1325 FFLags := [dpcLoaded]; 1326 end; 1327 1328 InitUID; 1329end; 1330 1331constructor TDebuggerPropertiesConfig.CreateFromOldXmlConf( 1332 AXMLCfg: TRttiXMLConfig; APath: String; ADebuggerClassName: String; 1333 AForceLoad: Boolean); 1334var 1335 p: String; 1336begin 1337 Create; 1338 FIsFromOldXml := True; 1339 FFLags := []; 1340 1341 p := Format(APath, [ADebuggerClassName, 'Config']); 1342 if AXMLCfg.HasPath(p, False) then 1343 AForceLoad := True; 1344 // Read first, so any (invalid) Class/Name will be cleared after reading 1345 AXMLCfg.ReadObject(p, Self); // read FDebuggerFilename; 1346 1347 FConfigClass := ADebuggerClassName; 1348 FConfigClassInOldXml := FConfigClass; 1349 FConfigName := ''; 1350 FXmlIndex := -1; 1351 1352 FDebuggerClass := TBaseDebugManagerIntf.DebuggersByClassName[ConfigClass]; 1353 APath := Format(APath, [FConfigClass, 'Properties']); 1354 if (FDebuggerClass <> nil) and (AForceLoad or AXMLCfg.HasPath(APath, False)) then begin 1355 FDebuggerProperties := FDebuggerClass.CreateProperties; 1356 AXMLCfg.ReadObject(APath, FDebuggerProperties); 1357 FFLags := [dpcLoaded]; 1358 end; 1359 1360 InitUID; 1361end; 1362 1363constructor TDebuggerPropertiesConfig.CreateForDebuggerClass( 1364 ADebuggerClass: TDebuggerClass); 1365begin 1366 Create; 1367 FIsFromOldXml := False; 1368 FXmlIndex := -1; 1369 1370 FDebuggerClass := ADebuggerClass; 1371 FConfigClass := ADebuggerClass.ClassName; 1372 FConfigName := ''; 1373 FDebuggerProperties := ADebuggerClass.CreateProperties; 1374 FFLags := [dpcLoaded]; // i.e. treat as loaded, save when saving all 1375 1376 InitUID; 1377end; 1378 1379constructor TDebuggerPropertiesConfig.CreateCopy( 1380 ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean; 1381 ACopyXmlOrigin: Boolean); 1382begin 1383 Create; 1384 CopyFrom(ASource, ACopyPropValues); 1385 if ACopyXmlOrigin then begin 1386 FIsFromOldXml := ASource.FIsFromOldXml; 1387 FXmlIndex := ASource.FXmlIndex; 1388 FUID := ASource.FUID; 1389 end 1390 else begin 1391 FIsFromOldXml := False; 1392 FXmlIndex := -1; 1393 end; 1394end; 1395 1396procedure TDebuggerPropertiesConfig.CopyFrom( 1397 ASource: TDebuggerPropertiesConfig; ACopyPropValues: Boolean); 1398begin 1399 FConfigClass := ASource.FConfigClass; 1400 FConfigClassInOldXml := ASource.FConfigClassInOldXml; 1401 FConfigName := ASource.FConfigName; 1402 FDebuggerClass := ASource.FDebuggerClass; 1403 FDebuggerFilename := ASource.FDebuggerFilename; 1404 FFLags := ASource.FFLags; 1405 1406 if not IsDeleted then begin 1407 FreeAndNil(FDebuggerProperties); 1408 if ASource.DebuggerClass <> nil then 1409 FDebuggerProperties := ASource.DebuggerClass.CreateProperties; 1410 if ACopyPropValues and (ASource.FDebuggerProperties <> nil) then 1411 FDebuggerProperties.Assign(ASource.FDebuggerProperties); 1412 end; 1413 1414 FUID := ''; 1415 InitUID; 1416end; 1417 1418procedure TDebuggerPropertiesConfig.AssignTo(Dest: TPersistent); 1419begin 1420 TDebuggerPropertiesConfig(Dest).CopyFrom(Self); 1421end; 1422 1423function TDebuggerPropertiesConfig.DisplayName: String; 1424begin 1425 if FDebuggerClass <> nil then 1426 Result := FDebuggerClass.Caption 1427 else 1428 Result := FConfigClass; 1429 if FConfigName <> '' then 1430 Result := FConfigName + ' [' + Result + ']' 1431 else 1432 Result := '[' + Result + ']'; 1433end; 1434 1435function TDebuggerPropertiesConfig.NeedsExePath: Boolean; 1436begin 1437 Result := (FDebuggerClass <> nil) and FDebuggerClass.NeedsExePath; 1438end; 1439 1440procedure TDebuggerPropertiesConfig.ChangeDebuggerClass( 1441 ADebuggerClass: TDebuggerClass; ACopyPropValues: Boolean); 1442var 1443 p: TDebuggerProperties; 1444begin 1445 assert(IsLoaded and not IsDeleted, 'TDebuggerPropertiesConfig.ChangeDebuggerClass: IsLoaded'); 1446 FDebuggerClass := ADebuggerClass; 1447 FConfigClass := ADebuggerClass.ClassName; 1448 p := FDebuggerProperties; 1449 FDebuggerProperties := ADebuggerClass.CreateProperties; 1450 if ACopyPropValues and (p <> nil) then 1451 FDebuggerProperties.Assign(p); 1452 p.Free; 1453end; 1454 1455procedure TDebuggerPropertiesConfig.MarkAsDeleted; 1456begin 1457 FreeAndNil(FDebuggerProperties); 1458 FFLags := FFLags + [dpcDeleted]; 1459end; 1460 1461function TDebuggerPropertiesConfig.IsLoaded: Boolean; 1462begin 1463 Result := dpcLoaded in FFLags; // (FDebuggerClass <> nil) and (FDebuggerProperties <> nil); 1464end; 1465 1466function TDebuggerPropertiesConfig.IsDeleted: Boolean; 1467begin 1468 Result := dpcDeleted in FFLags; // (FDebuggerClass <> nil) and (FDebuggerProperties = nil); 1469end; 1470 1471function TDebuggerPropertiesConfig.DebugText: String; 1472begin 1473 if Self = nil then 1474 exit('NIL'); 1475 Result := Format('C-Name: %s, C-Class: %s, Class %s, Prop %s, Xml: %d %s, Path: %s', 1476 [FConfigName, FConfigClass, DbgSName(FDebuggerClass), dbgs(FDebuggerProperties), 1477 FXmlIndex, dbgs(FIsFromOldXml), FDebuggerFilename]); 1478end; 1479 1480procedure TDebuggerPropertiesConfig.DeleteFromXml(AXMLCfg: TRttiXMLConfig; 1481 APath: String); 1482begin 1483 if FXmlIndex < 0 then 1484 exit; 1485 APath := Format(APath, [FXmlIndex]); 1486 FXmlIndex := -1; 1487 1488 AXMLCfg.DeletePath(APath); 1489end; 1490 1491procedure TDebuggerPropertiesConfig.DeleteFromOldXml(AXMLCfg: TRttiXMLConfig; 1492 APath: String); 1493begin 1494 if FConfigClassInOldXml = '' then begin 1495 debugln(['Debugger was loaded, but has no ConfigClass in XML', DebugText]); 1496 FConfigClassInOldXml := FConfigClass; 1497 end; 1498 1499 AXMLCfg.DeletePath(Format(APath, [FConfigClassInOldXml, 'Config'])); 1500 AXMLCfg.DeletePath(Format(APath, [FConfigClassInOldXml, 'Properties'])); 1501 1502 if FConfigClassInOldXml <> FConfigClass then begin 1503 AXMLCfg.DeletePath(Format(APath, [FConfigClass, 'Config'])); 1504 AXMLCfg.DeletePath(Format(APath, [FConfigClass, 'Properties'])); 1505 end; 1506 FConfigClassInOldXml := FConfigClass; 1507 FXmlIndex := -1; 1508 FIsFromOldXml := False; 1509end; 1510 1511procedure TDebuggerPropertiesConfig.SaveToXml(AXMLCfg: TRttiXMLConfig; 1512 APath: String; AIndex: Integer); 1513var 1514 PropDef: TDebuggerProperties; 1515 OptDef: TDebuggerPropertiesConfig; 1516begin 1517 APath := Format(APath, [AIndex]); 1518 FIsFromOldXml := False; 1519 FXmlIndex := AIndex; 1520 1521 OptDef := TDebuggerPropertiesConfig.Create; 1522 AXMLCfg.WriteObject(APath, Self, OptDef); 1523 OptDef.Free; 1524 1525 if FDebuggerProperties <> nil then begin 1526 PropDef := FDebuggerClass.CreateProperties; 1527 AXMLCfg.WriteObject(APath + 'Properties/', FDebuggerProperties, PropDef); 1528 PropDef.Free; 1529 end; 1530end; 1531 1532procedure TDebuggerPropertiesConfig.SaveToOldXml(AXMLCfg: TRttiXMLConfig; 1533 APath: String); 1534var 1535 PropDef: TDebuggerProperties; 1536 OptDef: TDebuggerPropertiesConfig; 1537begin 1538 FIsFromOldXml := True; 1539 FConfigClassInOldXml := FConfigClass; 1540 FXmlIndex := -1; 1541 1542 OptDef := TDebuggerPropertiesConfig.Create; 1543 OptDef.ConfigName := ConfigName; // Do not write Name 1544 // ConfigClass will differ and be written. This ensures that even an unmodified config is written (to preserve its existence) 1545 AXMLCfg.WriteObject(Format(APath, [FConfigClass, 'Config']), Self, OptDef); 1546 OptDef.Free; 1547 1548 if FDebuggerProperties <> nil then begin 1549 APath := Format(APath, [FConfigClass, 'Properties']); 1550 PropDef := FDebuggerClass.CreateProperties; 1551 AXMLCfg.WriteObject(APath, FDebuggerProperties, PropDef); 1552 PropDef.Free; 1553 end; 1554end; 1555 1556{ TIDESubOptions } 1557 1558procedure TIDESubOptions.ReadFromXml(AnXmlConf: TRttiXMLConfig); 1559begin 1560 ReadFromXml(AnXmlConf, FPath); 1561end; 1562 1563procedure TIDESubOptions.WriteToXml(AnXmlConf: TRttiXMLConfig); 1564begin 1565 WriteToXml(AnXmlConf, FPath); 1566end; 1567 1568procedure TIDESubOptions.Assign(Source: TPersistent); 1569begin 1570 inherited Assign(Source); 1571 FPath := TIDESubOptions(Source).FPath; 1572end; 1573 1574{ TDesktopOIOptions } 1575 1576constructor TDesktopOIOptions.Create; 1577var 1578 I: TObjectInspectorPage; 1579begin 1580 FComponentTreeHeight := -1; 1581 FInfoBoxHeight := -1; 1582 FShowInfoBox := True; 1583 for I in TObjectInspectorPage do 1584 SplitterX[I] := -1; 1585end; 1586 1587procedure TDesktopOIOptions.AssignTo(Dest: TPersistent); 1588var 1589 DDest: TDesktopOIOptions; 1590 I: TObjectInspectorPage; 1591begin 1592 if Dest is TDesktopOIOptions then 1593 begin 1594 DDest := TDesktopOIOptions(Dest); 1595 1596 for I in TObjectInspectorPage do 1597 DDest.SplitterX[I] := SplitterX[I]; 1598 DDest.ShowInfoBox := ShowInfoBox; 1599 DDest.ComponentTreeHeight := ComponentTreeHeight; 1600 DDest.ShowComponentTree := ShowComponentTree; 1601 DDest.InfoBoxHeight := InfoBoxHeight; 1602 end else 1603 inherited AssignTo(Dest); 1604end; 1605 1606function TDesktopOIOptions.GetSplitterX(const APage: TObjectInspectorPage 1607 ): Integer; 1608begin 1609 Result := FSplitterX[APage]; 1610end; 1611 1612procedure TDesktopOIOptions.ImportSettingsFromIDE( 1613 const AOptions: TEnvironmentOptions); 1614var 1615 I: TObjectInspectorPage; 1616 o: TOIOptions; 1617begin 1618 o := AOptions.ObjectInspectorOptions; 1619 for I in TObjectInspectorPage do 1620 FSplitterX[I] := o.GridSplitterX[I]; 1621 1622 ShowInfoBox := o.ShowInfoBox; 1623 ComponentTreeHeight := o.ComponentTreeHeight; 1624 ShowComponentTree := o.ShowComponentTree; 1625 InfoBoxHeight := o.InfoBoxHeight; 1626end; 1627 1628procedure TDesktopOIOptions.Load(XMLConfig: TXMLConfig; Path: String); 1629var 1630 I: TObjectInspectorPage; 1631begin 1632 Path := Path + 'ObjectInspectorOptions/'; 1633 for I in TObjectInspectorPage do 1634 FSplitterX[I] := XMLConfig.GetValue(Path+'SplitterX/'+DefaultOIPageNames[I]+'/Value',-1); 1635 ShowComponentTree := XMLConfig.GetValue(Path+'ComponentTree/Show/Value',True); 1636 ComponentTreeHeight := XMLConfig.GetValue(Path+'ComponentTree/Height/Value',-1); 1637 ShowInfoBox := XMLConfig.GetValue(Path+'InfoBox/Show/Value',True); 1638 InfoBoxHeight := XMLConfig.GetValue(Path+'InfoBox/Height/Value',-1); 1639end; 1640 1641procedure TDesktopOIOptions.Save(XMLConfig: TXMLConfig; Path: String); 1642var 1643 I: TObjectInspectorPage; 1644begin 1645 Path := Path + 'ObjectInspectorOptions/'; 1646 for I in TObjectInspectorPage do 1647 XMLConfig.SetDeleteValue(Path+'SplitterX/'+DefaultOIPageNames[I]+'/Value',FSplitterX[I],-1); 1648 XMLConfig.SetDeleteValue(Path+'ComponentTree/Show/Value',ShowComponentTree,True); 1649 XMLConfig.SetDeleteValue(Path+'ComponentTree/Height/Value',ComponentTreeHeight,-1); 1650 XMLConfig.SetDeleteValue(Path+'InfoBox/Show/Value',ShowInfoBox,True); 1651 XMLConfig.SetDeleteValue(Path+'InfoBox/Height/Value',InfoBoxHeight,-1); 1652end; 1653 1654procedure TDesktopOIOptions.SetSplitterX(const APage: TObjectInspectorPage; 1655 const ASplitterX: Integer); 1656begin 1657 FSplitterX[APage] := ASplitterX; 1658end; 1659 1660procedure TDesktopOIOptions.ExportSettingsToIDE( 1661 const AOptions: TEnvironmentOptions); 1662var 1663 I: TObjectInspectorPage; 1664 o: TOIOptions; 1665begin 1666 o := AOptions.ObjectInspectorOptions; 1667 for I in TObjectInspectorPage do 1668 if FSplitterX[I]>=0 then 1669 o.GridSplitterX[I] := Max(10, FSplitterX[I]); 1670 1671 o.ShowInfoBox := ShowInfoBox; 1672 o.ShowComponentTree := ShowComponentTree; 1673 if ComponentTreeHeight>=0 then 1674 o.ComponentTreeHeight := Max(10, ComponentTreeHeight); 1675 if InfoBoxHeight>=0 then 1676 o.InfoBoxHeight := Max(10, InfoBoxHeight); 1677end; 1678 1679{ TUnsupportedDesktopOpt } 1680 1681destructor TUnsupportedDesktopOpt.Destroy; 1682begin 1683 freeandnil(FRetainXMLData); 1684 inherited Destroy; 1685end; 1686 1687procedure TUnsupportedDesktopOpt.Load(Path: string); 1688var 1689 lPnode, lChldNode: TDOMNode; 1690begin 1691 inherited; 1692 1693 FreeAndNil(FRetainXMLData); 1694 FRetainXMLData := TDOMDocument.Create; 1695 lPnode := FXMLCfg.FindNode(Path, False); 1696 lChldNode := lPnode.CloneNode(True, FRetainXMLData); 1697 FRetainXMLData.AppendChild(lChldNode); 1698end; 1699 1700procedure TUnsupportedDesktopOpt.Save(Path: string); 1701var 1702 lChldNode, lChCh: TDOMNode; 1703 lsNodeName: DOMString; 1704 lParentNode: TDOMNode; 1705 PathM1, PreD, LastD: String; 1706begin 1707 if Assigned(FRetainXMLData) then 1708 begin 1709 PathM1 := copy(Path, 1, length(Path) - 1); 1710 PreD := ExtractFilePath(PathM1); 1711 LastD := ExtractFileNameOnly(PathM1); 1712 lParentNode:= FXMLCfg.FindNode(path, False); 1713 lChldNode := FRetainXMLData.FirstChild.CloneNode(True, FXMLCfg.Document); 1714 lsNodeName := lChldNode.NodeName; 1715 if LastD = lsNodeName then 1716 FXMLCfg.FindNode(PreD,False).ReplaceChild(lChldNode,FXMLCfg.FindNode(Path,False)) 1717 else 1718 begin 1719 try 1720 if not assigned(lParentNode) then 1721 begin 1722 lParentNode:=FXMLCfg.Document.CreateElement(LastD); 1723 FXMLCfg.FindNode(PreD, False).AppendChild(lParentNode); 1724 end; 1725 while lChldNode.HasChildNodes do 1726 begin 1727 lChCh := lChldNode.FirstChild; 1728 lChldNode.DetachChild(lChCh); 1729 lParentNode.AppendChild(lChCh); 1730 end; 1731 finally 1732 FreeAndNil(lChldNode); 1733 end; 1734 end; 1735 end; 1736end; 1737 1738{ TCustomDesktopOpt } 1739 1740function TCustomDesktopOpt.GetCompatible: Boolean; 1741begin 1742 Result := false; 1743end; 1744 1745procedure TCustomDesktopOpt.Load(Path: String); 1746begin 1747 FAssociatedDebugDesktopName:=FXMLCfg.GetValue(Path+'AssociatedDebugDesktopName/Value', ''); 1748end; 1749 1750constructor TCustomDesktopOpt.Create(const aName: String); 1751begin 1752 Create(aName, Assigned(IDEDockMaster)); 1753end; 1754 1755constructor TCustomDesktopOpt.Create(const aName: String; 1756 const aIsDocked: Boolean); 1757begin 1758 inherited Create; 1759 FName:=aName; 1760 FIsDocked := aIsDocked; 1761end; 1762 1763destructor TCustomDesktopOpt.Destroy; 1764begin 1765 inherited Destroy; 1766end; 1767 1768procedure TCustomDesktopOpt.SetConfig(aXMLCfg: TRttiXMLConfig; 1769 aConfigStore: TXMLOptionsStorage); 1770begin 1771 FXMLCfg := aXMLCfg; 1772 FConfigStore := aConfigStore; 1773end; 1774 1775{ TLastOpenPackagesList } 1776 1777constructor TLastOpenPackagesList.Create; 1778begin 1779 inherited Create; 1780 Sorted:=true; 1781 Duplicates:=dupIgnore; 1782end; 1783 1784function TLastOpenPackagesList.Remove(const aString: string): Boolean; 1785var 1786 xIndex: Integer; 1787begin 1788 xIndex := IndexOf(aString); 1789 Result := xIndex >= 0; 1790 if Result then 1791 Delete(xIndex); 1792end; 1793 1794{ TDesktopOptList } 1795 1796constructor TDesktopOptList.Create(aEnvOpts: TEnvironmentOptions); 1797begin 1798 inherited Create; 1799 FEnvOpts := aEnvOpts; 1800end; 1801 1802destructor TDesktopOptList.Destroy; 1803begin 1804 inherited Destroy; 1805end; 1806 1807procedure TDesktopOptList.SetConfig(aXMLCfg: TRttiXMLConfig; aConfigStore: TXMLOptionsStorage); 1808begin 1809 FXMLCfg := aXMLCfg; 1810 FConfigStore := aConfigStore; 1811end; 1812 1813procedure TDesktopOptList.AddFromCfg(Path: String); 1814var 1815 dsk: TCustomDesktopOpt; 1816 dskClass: TDesktopOptClass; 1817 dskName, dskDockMaster: String; 1818begin 1819 dskName := FXMLCfg.GetValue(Path+'Name', 'default'); 1820 dskDockMaster := FXMLCfg.GetValue(Path+'DockMaster', ''); 1821 1822 if IndexOf(dskname) >=0 then 1823 exit; 1824 1825 if TEnvironmentOptions.DesktopCanBeLoaded(dskDockMaster) then 1826 dskClass := TDesktopOpt 1827 else 1828 dskClass := TUnsupportedDesktopOpt; 1829 1830 dsk := dskClass.Create(dskName, dskDockMaster<>''); 1831 dsk.SetConfig(FXMLCfg, FConfigStore); 1832 dsk.Load(Path); 1833 Add(dsk); 1834end; 1835 1836function TDesktopOptList.IndexOf(aName: string): integer; 1837begin 1838 Result:=Count-1; 1839 while (Result>=0) 1840 and (CompareText(aName, Items[Result].Name)<>0) do 1841 dec(Result); 1842end; 1843 1844function TDesktopOptList.Find(aName: string): TCustomDesktopOpt; 1845var 1846 i: LongInt; 1847begin 1848 i:=IndexOf(aName); 1849 if i>=0 then 1850 Result:=Items[i] 1851 else 1852 Result:=nil; 1853end; 1854 1855function TDesktopOptList.GetItem(Index: Integer): TCustomDesktopOpt; 1856begin 1857 Result := TCustomDesktopOpt(inherited Items[Index]); 1858end; 1859 1860{ TDesktopOpt } 1861 1862constructor TDesktopOpt.Create(const aName: String; const aIsDocked: Boolean); 1863begin 1864 if aIsDocked and not Assigned(IDEDockMaster) then 1865 raise Exception.Create('Internal error: TEnvironmentOptions.CreateDesktop cannot create docked desktop in undocked environment.'); 1866 1867 inherited; 1868 1869 if aIsDocked then 1870 FDockedOpt := IDEDockMaster.DockedDesktopOptClass.Create; 1871 1872 FSingleTaskBarButton:=false; 1873 FHideIDEOnRun:=false; 1874 FAutoAdjustIDEHeight:=true; 1875 FAutoAdjustIDEHeightFullCompPal := true; 1876 // window menu 1877 FIDENameForDesignedFormList:=false; 1878 // CompletionWindow 1879 FCompletionWindowWidth := 320 * Screen.PixelsPerInch div 96; 1880 FCompletionWindowHeight := 6; 1881 // title 1882 FIDETitleStartsWithProject:=false; 1883 FIDETitleIncludesBuildMode:=false; 1884 FIDEProjectDirectoryInIdeTitle:=false; 1885 // IDE Coolbar 1886 FIDECoolBarOptions:=TIDECoolBarOptions.Create; 1887 // Editor Toolbar 1888 FEditorToolBarOptions:=TEditorToolBarOptions.Create; 1889 // component palette 1890 FComponentPaletteOptions:=TCompPaletteOptions.Create; 1891 // object inspector 1892 FObjectInspectorOptions:=TDesktopOIOptions.Create; 1893 // Windows layout 1894 InitLayoutList; 1895 1896 FIDEDialogLayoutList:=TIDEDialogLayoutList.Create; 1897 FIDEWindowCreatorsLayoutList:=TSimpleWindowLayoutList.Create(False); 1898 FIDEDialogLayoutList.Assign(IDEWindowIntf.IDEDialogLayoutList); 1899 FIDEWindowCreatorsLayoutList.CopyItemsFrom(IDEWindowIntf.IDEWindowCreators.SimpleLayoutStorage); 1900end; 1901 1902destructor TDesktopOpt.Destroy; 1903begin 1904 FreeAndNil(FComponentPaletteOptions); 1905 FreeAndNil(FEditorToolBarOptions); 1906 FreeAndNil(FIDECoolBarOptions); 1907 FreeAndNil(FDockedOpt); 1908 FreeAndNil(FObjectInspectorOptions); 1909 1910 FreeAndNil(FIDEDialogLayoutList); 1911 FreeAndNil(FIDEWindowCreatorsLayoutList); 1912 1913 inherited Destroy; 1914end; 1915 1916function TDesktopOpt.GetCompatible: Boolean; 1917begin 1918 Result := (IsDocked = Assigned(IDEDockMaster)); 1919end; 1920 1921procedure TDesktopOpt.Assign(Source: TDesktopOpt; const AssignName: Boolean; 1922 const IsCompatible: Boolean); 1923begin 1924 if AssignName then 1925 FName := Source.FName; 1926 1927 if IsCompatible and (Assigned(FDockedOpt) <> Assigned(Source.FDockedOpt)) then 1928 raise Exception.Create('Internal error: TDesktopOpt.Assign mixed docked/undocked desktops.'); 1929 1930 // window layout 1931 if IsCompatible then 1932 begin 1933 FIDEWindowCreatorsLayoutList.CopyItemsFrom(Source.FIDEWindowCreatorsLayoutList); 1934 FIDEDialogLayoutList.Assign(Source.FIDEDialogLayoutList); 1935 FAssociatedDebugDesktopName := Source.FAssociatedDebugDesktopName; 1936 end; 1937 FSingleTaskBarButton := Source.FSingleTaskBarButton; 1938 FHideIDEOnRun := Source.FHideIDEOnRun; 1939 FAutoAdjustIDEHeight := Source.FAutoAdjustIDEHeight; 1940 FAutoAdjustIDEHeightFullCompPal := Source.FAutoAdjustIDEHeightFullCompPal; 1941 // window menu 1942 FIDENameForDesignedFormList := Source.FIDENameForDesignedFormList; 1943 // CompletionWindow 1944 FCompletionWindowWidth := Source.FCompletionWindowWidth; 1945 FCompletionWindowHeight := Source.FCompletionWindowHeight; 1946 // title 1947 FIDETitleStartsWithProject := Source.FIDETitleStartsWithProject; 1948 FIDETitleIncludesBuildMode := Source.FIDETitleIncludesBuildMode; 1949 FIDEProjectDirectoryInIdeTitle := Source.FIDEProjectDirectoryInIdeTitle; 1950 // IDE Coolbar 1951 FIDECoolBarOptions.Assign(Source.FIDECoolBarOptions); 1952 // Editor Toolbar 1953 FEditorToolBarOptions.Assign(Source.FEditorToolBarOptions); 1954 // component palette 1955 FComponentPaletteOptions.Assign(Source.FComponentPaletteOptions); 1956 // object inspector 1957 FObjectInspectorOptions.Assign(Source.FObjectInspectorOptions); 1958 1959 if IsCompatible and Assigned(FDockedOpt) then 1960 FDockedOpt.Assign(Source.FDockedOpt); 1961end; 1962 1963procedure TDesktopOpt.Load(Path: String); 1964begin 1965 inherited; 1966 1967 // Windows layout 1968 FIDEWindowCreatorsLayoutList.LoadFromConfig(FConfigStore, Path); 1969 FIDEDialogLayoutList.LoadFromConfig(FConfigStore, Path+'Dialogs/'); 1970 1971 FSingleTaskBarButton:=FXMLCfg.GetValue(Path+'SingleTaskBarButton/Value', False); 1972 FHideIDEOnRun:=FXMLCfg.GetValue(Path+'HideIDEOnRun/Value',false); 1973 FAutoAdjustIDEHeight:=FXMLCfg.GetValue(Path+'AutoAdjustIDEHeight/Value',true); 1974 FAutoAdjustIDEHeightFullCompPal:=FXMLCfg.GetValue(Path+'AutoAdjustIDEHeightFullComponentPalette/Value',true); 1975 // Window menu 1976 FIDENameForDesignedFormList:=FXMLCfg.GetValue(Path+'IDENameForDesignedFormList/Value',false); 1977 // title 1978 FIDETitleStartsWithProject:=FXMLCfg.GetValue(Path+'IDETitleStartsWithProject/Value',false); 1979 FIDETitleIncludesBuildMode:=FXMLCfg.GetValue(Path+'IDETitleIncludesBuildMode/Value',false); 1980 FIDEProjectDirectoryInIdeTitle:=FXMLCfg.GetValue(Path+'IDEProjectDirectoryInIdeTitle/Value',false); 1981 // CompletionWindow 1982 FCompletionWindowWidth:=FXMLCfg.GetValue(Path+'CompletionWindowOptions/Width/Value', FCompletionWindowWidth); 1983 FCompletionWindowHeight:=FXMLCfg.GetValue(Path+'CompletionWindowOptions/Height/Value', 6); 1984 1985 if not FXMLCfg.HasPath(Path+'IDECoolBarOptions/', True) then 1986 Path := ''; // Toolbars and palette were at the top level in XML. 1987 // IDE Coolbar 1988 FIDECoolBarOptions.Load(FXMLCfg, Path); 1989 // Editor Toolbar 1990 FEditorToolBarOptions.Load(FXMLCfg, Path); 1991 // component palette 1992 FComponentPaletteOptions.Load(FXMLCfg, Path); 1993 // Object Inspector 1994 FObjectInspectorOptions.Load(FXMLCfg, Path); 1995 1996 if Assigned(FDockedOpt) then 1997 FDockedOpt.Load(Path, FXMLCfg); 1998end; 1999 2000procedure TDesktopOpt.RestoreDesktop; 2001begin 2002 IDEWindowCreators.RestoreSimpleLayout; 2003 if Assigned(FDockedOpt) then 2004 FDockedOpt.RestoreDesktop; 2005end; 2006 2007procedure TDesktopOpt.ImportSettingsFromIDE(const AOptions: TEnvironmentOptions 2008 ); 2009begin 2010 IDEWindowIntf.IDEWindowCreators.SimpleLayoutStorage.StoreWindowPositions; 2011 FIDEDialogLayoutList.Assign(IDEWindowIntf.IDEDialogLayoutList); 2012 FIDEWindowCreatorsLayoutList.CopyItemsFrom(IDEWindowIntf.IDEWindowCreators.SimpleLayoutStorage); 2013 FObjectInspectorOptions.ImportSettingsFromIDE(AOptions); 2014 2015 if Assigned(FDockedOpt) then 2016 FDockedOpt.ImportSettingsFromIDE; 2017end; 2018 2019procedure TDesktopOpt.Save(Path: String); 2020begin 2021 // windows 2022 FXMLCfg.SetDeleteValue(Path+'Name', FName, ''); 2023 if Assigned(FDockedOpt) then 2024 FXMLCfg.SetDeleteValue(Path+'DockMaster', IDEDockMaster.ClassName, '') 2025 else 2026 FXMLCfg.DeleteValue(Path+'DockMaster'); 2027 2028 FIDEWindowCreatorsLayoutList.SaveToConfig(FConfigStore, Path); 2029 FIDEDialogLayoutList.SaveToConfig(FConfigStore,Path+'Dialogs/'); 2030 2031 FXMLCfg.SetDeleteValue(Path+'AssociatedDebugDesktopName/Value', FAssociatedDebugDesktopName, ''); 2032 FXMLCfg.SetDeleteValue(Path+'SingleTaskBarButton/Value',FSingleTaskBarButton, False); 2033 FXMLCfg.SetDeleteValue(Path+'HideIDEOnRun/Value',FHideIDEOnRun,false); 2034 FXMLCfg.SetDeleteValue(Path+'AutoAdjustIDEHeight/Value',FAutoAdjustIDEHeight,true); 2035 FXMLCfg.SetDeleteValue(Path+'AutoAdjustIDEHeightFullComponentPalette/Value', 2036 FAutoAdjustIDEHeightFullCompPal,true); 2037 // Window menu 2038 FXMLCfg.SetDeleteValue(Path+'IDENameForDesignedFormList/Value',FIDENameForDesignedFormList,false); 2039 // title 2040 FXMLCfg.SetDeleteValue(Path+'IDETitleStartsWithProject/Value',FIDETitleStartsWithProject,false); 2041 FXMLCfg.SetDeleteValue(Path+'IDETitleIncludesBuildMode/Value',FIDETitleIncludesBuildMode,false); 2042 FXMLCfg.SetDeleteValue(Path+'IDEProjectDirectoryInIdeTitle/Value',FIDEProjectDirectoryInIdeTitle,false); 2043 // CompletionWindow 2044 FXMLCfg.SetValue(Path+'CompletionWindowOptions/Width/Value',FCompletionWindowWidth); 2045 FXMLCfg.SetDeleteValue(Path+'CompletionWindowOptions/Height/Value',FCompletionWindowHeight, 6); 2046 // IDE Coolbar 2047 FIDECoolBarOptions.Save(FXMLCfg, Path); 2048 // Editor Toolbar 2049 FEditorToolBarOptions.Save(FXMLCfg, Path); 2050 // component palette 2051 FComponentPaletteOptions.Save(FXMLCfg, Path); 2052 // Object Inspector 2053 FObjectInspectorOptions.Save(FXMLCfg, Path); 2054 2055 if Assigned(FDockedOpt) then 2056 FDockedOpt.Save(Path, FXMLCfg); 2057end; 2058 2059procedure TDesktopOpt.ExportSettingsToIDE(const AOptions: TEnvironmentOptions); 2060var 2061 ComplForm: TCustomForm; 2062begin 2063 if Assigned(FDockedOpt) then 2064 FDockedOpt.ExportSettingsToIDE; 2065 2066 IDEWindowIntf.IDEDialogLayoutList.Assign(FIDEDialogLayoutList); 2067 IDEWindowIntf.IDEWindowCreators.SimpleLayoutStorage.CopyItemsFrom(FIDEWindowCreatorsLayoutList); 2068 FObjectInspectorOptions.ExportSettingsToIDE(AOptions); 2069 if Assigned(SourceEditorManagerIntf) then 2070 begin 2071 ComplForm := SourceEditorManagerIntf.DefaultSynCompletionForm; 2072 if Assigned(ComplForm) then 2073 ComplForm.Width := Max(50, CompletionWindowWidth); 2074 SourceEditorManagerIntf.SynCompletionLinesInWindow := Max(3, CompletionWindowHeight); 2075 end; 2076end; 2077 2078procedure InitLayoutHelper(const FormID: string); 2079begin 2080 with IDEWindowCreators.SimpleLayoutStorage do 2081 if not Assigned(ItemByFormID(FormID)) then 2082 CreateWindowLayout(FormID); 2083end; 2084 2085procedure TDesktopOpt.InitLayoutList; 2086var 2087 l: TNonModalIDEWindow; 2088begin 2089 for l:=Low(TNonModalIDEWindow) to High(TNonModalIDEWindow) do 2090 if l<>nmiwNone then 2091 InitLayoutHelper(NonModalIDEWindowNames[l]); 2092 InitLayoutHelper(DefaultObjectInspectorName); 2093end; 2094 2095{ TEnvironmentOptions } 2096 2097constructor TEnvironmentOptions.Create; 2098var 2099 o: TEnvOptParseType; 2100 c: TMsgWndColor; 2101 u: TMessageLineUrgency; 2102begin 2103 inherited Create; 2104 fRegisteredSubConfig := TObjectList.Create(False); 2105 for o:=low(FParseValues) to high(FParseValues) do 2106 FParseValues[o].ParseStamp:=CTInvalidChangeStamp; 2107 2108 FFilename:=''; 2109 2110 // language 2111 LanguageID:=''; 2112 2113 // auto save 2114 FAskSaveSessionOnly:=false; 2115 FAutoSaveEditorFiles:=true; 2116 FAutoSaveProject:=true; 2117 FAutoSaveIntervalInSecs:=DefaultAutoSaveIntervalInSecs; 2118 FLastSavedProjectFile:=''; 2119 FLastOpenPackages:=TLastOpenPackagesList.Create; 2120 2121 // EnvironmentOptionsDialog editor 2122 FShowGrid:=true; 2123 FShowBorderSpacing:=false; 2124 FGridColor:=DefaultGridColor; 2125 FSnapToGrid:=true; 2126 FGridSizeX:=DefaultGridSize; 2127 FGridSizeY:=DefaultGridSize; 2128 FShowGuideLines:=true; 2129 FSnapToGuideLines:=true; 2130 FGuideLineColorLeftTop:=DefaultGuideLineColorLeftTop; 2131 FGuideLineColorRightBottom:=DefaultGuideLineColorRightBottom; 2132 FShowComponentCaptions:=false; 2133 FShowEditorHints:=true; 2134 FAutoCreateFormsOnOpen:=true; 2135 FCheckPackagesOnFormCreate:=true; 2136 FRightClickSelects:=true; 2137 FGrabberColor:=clBlack; 2138 FMarkerColor:=clDkGray; 2139 FNonFormBackgroundColor:=clWindow; 2140 FRubberbandSelectionColor:=clNavy; 2141 FRubberbandCreationColor:=clMaroon; 2142 FRubberbandSelectsGrandChilds:=DefaultRubberbandSelectsGrandChilds; 2143 FCreateComponentFocusNameProperty:=false; 2144 FSwitchToFavoritesOITab:=false; 2145 FFormTitleBarChangesObjectInspector:=false; 2146 FForceDPIScalingInDesignTime:=true; 2147 2148 // object inspector 2149 FObjectInspectorOptions:=TOIOptions.Create; 2150 // project inspector 2151 FProjInspSortAlphabetically:=false; 2152 FProjInspShowDirHierarchy:=false; 2153 // package editor 2154 FPackageEditorSortAlphabetically:=false; 2155 FPackageEditorShowDirHierarchy:=false; 2156 // procedure list 2157 FProcedureListFilterStart:=false; 2158 2159 // hints 2160 FCheckDiskChangesWithLoading:=false; 2161 FShowHintsForComponentPalette:=true; 2162 FShowHintsForMainSpeedButtons:=true; 2163 2164 // messages view 2165 fMsgViewDblClickJumps:=true; 2166 fMsgViewFocus:=DefaultMsgViewFocus; 2167 FShowMessagesIcons:=true; 2168 FMsgViewStayOnTop:=false; 2169 FMsgViewShowTranslations:=false; 2170 FMsgViewAlwaysDrawFocused:=false; 2171 FMsgViewFilenameStyle:=mwfsShort; 2172 for c:=low(TMsgWndColor) to high(TMsgWndColor) do 2173 fMsgViewColors[c]:=MsgWndDefaultColors[c]; 2174 for u:=low(TMessageLineUrgency) to high(TMessageLineUrgency) do 2175 fMsgColors[u] := clDefault; 2176 FMsgViewFilters:=TLMsgViewFilters.Create(nil); 2177 FMsgViewShowFPCMsgLinesCompiled:=false; 2178 2179 // glyphs 2180 FShowButtonGlyphs := sbgSystem; 2181 FShowMenuGlyphs := sbgSystem; 2182 2183 // comboboxes 2184 FDropDownCount:=DefaultDropDownCount; 2185 2186 // files 2187 LazarusDirectory:=''; 2188 FLazarusDirHistory:=TStringList.Create; 2189 CompilerFilename:=''; 2190 FCompilerFileHistory:=TStringList.Create; 2191 FPCSourceDirectory:=''; 2192 FFPCSourceDirHistory:=TStringList.Create; 2193 MakeFilename:=DefaultMakefilename; 2194 FMakeFileHistory:=TStringList.Create; 2195 FDebuggerFileHistory:=TStringList.Create; 2196 FDebuggerFileHistory.OwnsObjects := True; 2197 FDebuggerProperties := TDebuggerPropertiesConfigList.Create; 2198 FDebuggerEventLogColors:=DebuggerDefaultColors; 2199 FppkgConfigFile:=''; 2200 FFppkgConfigFileHistory:=TStringList.Create; 2201 TestBuildDirectory:=GetDefaultTestBuildDirectory; 2202 FTestBuildDirHistory:=TStringList.Create; 2203 CompilerMessagesFilename:=''; 2204 FCompilerMessagesFileHistory:=TStringList.Create; 2205 FManyBuildModesSelection:=TStringList.Create; 2206 2207 // recent files and directories 2208 FRecentOpenFiles:=TStringList.Create; 2209 FMaxRecentOpenFiles:=DefaultMaxRecentOpenFiles; 2210 FRecentProjectFiles:=TStringList.Create; 2211 FMaxRecentProjectFiles:=DefaultMaxRecentProjectFiles; 2212 FRecentPackageFiles:=TStringList.Create; 2213 FMaxRecentPackageFiles:=DefaultMaxRecentPackageFiles; 2214 FOpenLastProjectAtStart:=true; 2215 FMultipleInstances:=DefaultIDEMultipleInstancesOption; 2216 2217 // other recent settings 2218 FLastEventMethodCCResult.ClassSection:=icsPublic; 2219 FLastVariableCCResult.ClassSection:=icsPrivate; 2220 FLastVariableCCResult.Location:=cclLocal; 2221 2222 // backup 2223 with FBackupInfoProjectFiles do begin 2224 BackupType:=DefaultBackupTypeProject; 2225 AdditionalExtension:=DefaultBackupAddExt; // for bakUserDefinedAddExt 2226 MaxCounter:=DefaultBackupMaxCounter; // for bakCounter 2227 SubDirectory:=DefaultBackupSubDirectory; 2228 end; 2229 with FBackupInfoOtherFiles do begin 2230 BackupType:=DefaultBackupTypeOther; 2231 AdditionalExtension:=DefaultBackupAddExt; // for bakUserDefinedAddExt 2232 MaxCounter:=DefaultBackupMaxCounter; // for bakCounter 2233 SubDirectory:=DefaultBackupSubDirectory; 2234 end; 2235 2236 // external tools 2237 if Assigned(ExternalUserToolsClass) then 2238 fExternalUserTools:=ExternalUserToolsClass.Create; 2239 FMaxExtToolsInParallel:=0; 2240 2241 // naming 2242 fPascalFileExtension:=petPAS; 2243 fCharcaseFileAction:=ccfaAutoRename; 2244 FUnitRenameReferencesAction:=urraAsk; 2245 FAskForFilenameOnNewFile:=false; 2246 FLowercaseDefaultFilename:=true; 2247 2248 //debug 2249 (* TODO: maybe revert relations. Create this in Debugger, and call environmentoptions for the configstore only? *) 2250 FDebuggerConfig := TDebuggerConfigStore.Create; 2251 2252 // global build options 2253 FBuildMatrixOptions:=TBuildMatrixOptions.Create; 2254 2255 // Desktop collection 2256 FDesktops := TDesktopOptList.Create(Self); 2257 // FDesktop points to the IDE properties 2258 FDesktop := TDesktopOpt.Create(''); 2259 FAutoSaveActiveDesktop := True; 2260end; 2261 2262destructor TEnvironmentOptions.Destroy; 2263begin 2264 FreeAndNil(fRegisteredSubConfig); 2265 FreeAndNil(FDesktops); 2266 FreeAndNil(FDesktop); 2267 FreeAndNil(FLastDesktopBeforeDebug); 2268 FreeAndNil(FBuildMatrixOptions); 2269 FreeAndNil(FMsgViewFilters); 2270 FreeAndNil(fExternalUserTools); 2271 FreeAndNil(FRecentOpenFiles); 2272 FreeAndNil(FRecentProjectFiles); 2273 FreeAndNil(FRecentPackageFiles); 2274 FreeAndNil(FObjectInspectorOptions); 2275 FreeAndNil(FLazarusDirHistory); 2276 FreeAndNil(FCompilerFileHistory); 2277 FreeAndNil(FFPCSourceDirHistory); 2278 FreeAndNil(FMakeFileHistory); 2279 FDebuggerProperties.ClearAll; 2280 FreeAndNil(FDebuggerProperties); 2281 FreeAndNil(FDebuggerFileHistory); 2282 FreeAndNil(FManyBuildModesSelection); 2283 FreeAndNil(FTestBuildDirHistory); 2284 FreeAndNil(FCompilerMessagesFileHistory); 2285 FreeAndNil(FDebuggerConfig); 2286 FreeAndNil(FConfigStore); 2287 FreeAndNil(FDbgConfigStore); 2288 FreeAndNil(FXMLCfg); 2289 FreeAndNil(FLastOpenPackages); 2290 FreeAndNil(FFppkgConfigFileHistory); 2291 inherited Destroy; 2292end; 2293 2294procedure TEnvironmentOptions.DisableDebugDesktop; 2295begin 2296 if (FLastDesktopBeforeDebug=nil) or (FDesktop=nil) then 2297 Exit; 2298 try 2299 if AutoSaveActiveDesktop and Assigned(DebugDesktop) then 2300 begin 2301 FDesktop.ImportSettingsFromIDE(Self); 2302 DebugDesktop.Assign(FDesktop); 2303 end; 2304 2305 UseDesktop(FLastDesktopBeforeDebug); 2306 finally 2307 FreeAndNil(FLastDesktopBeforeDebug); 2308 end; 2309end; 2310 2311class function TEnvironmentOptions.GetGroupCaption: string; 2312begin 2313 Result := dlgGroupEnvironment; 2314end; 2315 2316class function TEnvironmentOptions.GetInstance: TAbstractIDEOptions; 2317begin 2318 Result := EnvironmentOptions; 2319end; 2320 2321procedure TEnvironmentOptions.DoAfterWrite(Restore: boolean); 2322begin 2323 // Note! Data is saved when the IDE is closed. 2324 //if not Restore then 2325 // Save(False); 2326 inherited DoAfterWrite(Restore); 2327end; 2328 2329procedure TEnvironmentOptions.RegisterSubConfig(ASubConfig: TIDESubOptions; 2330 APath: String); 2331var 2332 i: Integer; 2333begin 2334 if (APath = '') or (APath = '/') then 2335 raise Exception.Create('Empty SubConfig path'); 2336 if APath[Length(APath)-1] <> '/' then 2337 APath := APath + '/'; 2338 if APath[1] = '/' then 2339 delete(APath,1 ,1); 2340 for i := 0 to SubConfigCount - 1 do 2341 if SubConfig[i].FPath = APath then 2342 raise Exception.Create('Duplicate SubConfig path'); 2343 fRegisteredSubConfig.Add(ASubConfig); 2344 ASubConfig.FPath := APath; 2345 if FXMLCfg <> nil then 2346 ASubConfig.ReadFromXml(FXMLCfg, APath); 2347end; 2348 2349procedure TEnvironmentOptions.UnRegisterSubConfig(ASubConfig: TIDESubOptions); 2350begin 2351 fRegisteredSubConfig.Remove(ASubConfig); 2352end; 2353 2354function TEnvironmentOptions.SubConfigCount: integer; 2355begin 2356 Result := fRegisteredSubConfig.Count; 2357end; 2358 2359procedure TEnvironmentOptions.EnableDebugDesktop; 2360begin 2361 if not Assigned(FLastDesktopBeforeDebug) and Assigned(DebugDesktop) and (DebugDesktop <> ActiveDesktop) then 2362 begin 2363 FLastDesktopBeforeDebug := TDesktopOpt.Create(ActiveDesktopName); 2364 if AutoSaveActiveDesktop then 2365 FDesktop.ImportSettingsFromIDE(Self); 2366 FLastDesktopBeforeDebug.Assign(FDesktop, False); 2367 EnvironmentOptions.UseDesktop(DebugDesktop); 2368 end; 2369end; 2370 2371procedure TEnvironmentOptions.CreateConfig; 2372var 2373 ConfFileName: string; 2374begin 2375 ConfFileName:=GetDefaultConfigFilename; 2376 CopySecondaryConfigFile(EnvOptsConfFileName); 2377 if (not FileExistsUTF8(ConfFileName)) then begin 2378 //DebugLn('Note: environment config file not found - using defaults'); 2379 end; 2380 Filename:=ConfFilename; 2381end; 2382 2383class function TEnvironmentOptions.DesktopCanBeLoaded(const aDockMaster: string 2384 ): Boolean; 2385begin 2386 Result := (aDockMaster = '') or ( 2387 Assigned(IDEDockMaster) and (IDEDockMaster.ClassName = aDockMaster)); 2388end; 2389 2390function TEnvironmentOptions.GetParsedLazarusDirectory: string; 2391begin 2392 Result:=GetParsedValue(eopLazarusDirectory); 2393end; 2394 2395procedure TEnvironmentOptions.SetFileName(const NewFilename: string); 2396begin 2397 if FFilename=NewFilename then exit; 2398 FFilename:=NewFilename; 2399 FFileHasChangedOnDisk:=true; 2400end; 2401 2402procedure TEnvironmentOptions.LoadNonDesktop(Path: String); 2403 2404 procedure LoadBackupInfo(var BackupInfo: TBackupInfo; const Path:string; 2405 DefaultBackupType: TBackupType); 2406 var i:integer; 2407 begin 2408 with BackupInfo do begin 2409 if FFileVersion>=110 then begin 2410 BackupType:=NameToBackupType(FXMLCfg.GetValue(Path+'Type',BackupTypeToName(DefaultBackupType))); 2411 end else begin 2412 // 109 and less: 2413 i:=FXMLCfg.GetValue(Path+'Type',5); 2414 case i of 2415 0:BackupType:=bakNone; 2416 1:BackupType:=bakSymbolInFront; 2417 2:BackupType:=bakSymbolBehind; 2418 3:BackupType:=bakCounter; 2419 4:BackupType:=bakSameName; 2420 else 2421 BackupType:=bakUserDefinedAddExt; 2422 end; 2423 end; 2424 AdditionalExtension:=FXMLCfg.GetValue(Path+'AdditionalExtension',DefaultBackupAddExt); 2425 MaxCounter:=FXMLCfg.GetValue(Path+'MaxCounter',9); // DefaultBackupMaxCounter 2426 if FFileVersion<101 then 2427 SubDirectory:='' 2428 else 2429 SubDirectory:=FXMLCfg.GetValue(Path+'SubDirectory','backup'); // DefaultBackupSubDirectory; 2430 end; 2431 end; 2432 2433var 2434 EventType: TDBGEventType; 2435 i: Integer; 2436begin 2437 // files 2438 LazarusDirectory:=FXMLCfg.GetValue(Path+'LazarusDirectory/Value',LazarusDirectory); 2439 LoadRecentList(FXMLCfg,FLazarusDirHistory,Path+'LazarusDirectory/History/',rltFile); 2440 if FLazarusDirHistory.Count=0 then 2441 FLazarusDirHistory.Add(ProgramDirectoryWithBundle); 2442 CompilerFilename:=TrimFilename(FXMLCfg.GetValue( 2443 Path+'CompilerFilename/Value',CompilerFilename)); 2444 LoadRecentList(FXMLCfg,FCompilerFileHistory,Path+'CompilerFilename/History/',rltFile); 2445 if FCompilerFileHistory.Count=0 then 2446 GetDefaultCompilerFilenames(FCompilerFileHistory); 2447 FPCSourceDirectory:=FXMLCfg.GetValue(Path+'FPCSourceDirectory/Value',FPCSourceDirectory); 2448 LoadRecentList(FXMLCfg,FFPCSourceDirHistory,Path+'FPCSourceDirectory/History/',rltFile); 2449 MakeFilename:=TrimFilename(FXMLCfg.GetValue(Path+'MakeFilename/Value',MakeFilename)); 2450 LoadRecentList(FXMLCfg,FMakeFileHistory,Path+'MakeFilename/History/',rltFile); 2451 if FMakeFileHistory.Count=0 then 2452 GetDefaultMakeFilenames(FMakeFileHistory); 2453 FppkgConfigFile:=FXMLCfg.GetValue(Path+'FppkgConfigFile/Value',FppkgConfigFile); 2454 LoadRecentList(FXMLCfg,FFppkgConfigFileHistory,Path+'FppkgConfigFile/History/',rltFile); 2455 2456 TestBuildDirectory:=FXMLCfg.GetValue(Path+'TestBuildDirectory/Value',TestBuildDirectory); 2457 LoadRecentList(FXMLCfg,FTestBuildDirHistory,Path+'TestBuildDirectory/History/',rltFile); 2458 if FTestBuildDirHistory.Count=0 then 2459 GetDefaultTestBuildDirs(FTestBuildDirHistory); 2460 CompilerMessagesFilename:=FXMLCfg.GetValue(Path+'CompilerMessagesFilename/Value',CompilerMessagesFilename); 2461 LoadRecentList(FXMLCfg,FCompilerMessagesFileHistory,Path+'CompilerMessagesFilename/History/',rltFile); 2462 LoadRecentList(FXMLCfg,FManyBuildModesSelection,Path+'ManyBuildModesSelection/',rltCaseInsensitive); 2463 2464 // Primary-config verification 2465 FLastCalledByLazarusFullPath:=FXMLCfg.GetValue(Path+'LastCalledByLazarusFullPath/Value',''); 2466 2467 // global build options, additions and overrides 2468 FConfigStore.AppendBasePath('BuildMatrix'); 2469 FBuildMatrixOptions.LoadFromConfig(FConfigStore); 2470 FConfigStore.UndoAppendBasePath; 2471 2472 // Clean build project dialog 2473 FCleanBuildProjOut:=FXMLCfg.GetValue(Path+'CleanBuild/ProjOut',true); 2474 FCleanBuildProjSrc:=FXMLCfg.GetValue(Path+'CleanBuild/ProjSrc',true); 2475 FCleanBuildPkgOut:=FXMLCfg.GetValue(Path+'CleanBuild/PkgOut',true); 2476 FCleanBuildPkgSrc:=FXMLCfg.GetValue(Path+'CleanBuild/PkgSrc',true); 2477 2478 // backup 2479 LoadBackupInfo(FBackupInfoProjectFiles,Path+'BackupProjectFiles/',DefaultBackupTypeProject); 2480 LoadBackupInfo(FBackupInfoOtherFiles,Path+'BackupOtherFiles/',DefaultBackupTypeOther); 2481 2482 // Debugger 2483 // DO not call LoadDebuggerProperties; => not all debuggers are registered when this is first called 2484 FDebuggerConfig.Load; 2485 if FXMLCfg.HasPath(Path+'DebuggerFilename/History', False) then begin 2486 i := FDebuggerFileHistory.AddObject('', TStringList.Create); 2487 LoadRecentList(FXMLCfg,TStrings(FDebuggerFileHistory.Objects[i]),Path+'DebuggerFilename/History/',rltFile); 2488 end; 2489 DebuggerSearchPath:=FXMLCfg.GetValue(Path+'DebuggerSearchPath/Value',''); 2490 // Debugger General Options 2491 DebuggerShowStopMessage:=FXMLCfg.GetValue(Path+'DebuggerOptions/ShowStopMessage/Value', True); 2492 DebuggerShowExitCodeMessage:=FXMLCfg.GetValue(Path+'DebuggerOptions/DebuggerShowExitCodeMessage/Value', True); 2493 DebuggerResetAfterRun :=FXMLCfg.GetValue(Path+'DebuggerOptions/DebuggerResetAfterRun/Value', False); 2494 FDebuggerAutoCloseAsm :=FXMLCfg.GetValue(Path+'DebuggerOptions/DebuggerAutoCloseAsm/Value', False); 2495 FDebuggerAutoSetInstanceFromClass :=FXMLCfg.GetValue(Path+'DebuggerOptions/DebuggerAutoSetInstanceFromClass/Value', False); 2496 FDebuggerAllowFunctionCalls :=FXMLCfg.GetValue(Path+'DebuggerOptions/DebuggerAllowFunctionCalls/Value', False); 2497 FDebuggerEventLogClearOnRun := FXMLCfg.GetValue(Path+'Debugger/EventLogClearOnRun', True); 2498 FDebuggerEventLogCheckLineLimit := FXMLCfg.GetValue(Path+'Debugger/EventLogCheckLineLimit', False); 2499 FDebuggerEventLogLineLimit := FXMLCfg.GetValue(Path+'Debugger/EventLogLineLimit', 1000); 2500 FDebuggerEventLogShowBreakpoint := FXMLCfg.GetValue(Path+'Debugger/EventLogShowBreakpoint', False); 2501 FDebuggerEventLogShowProcess := FXMLCfg.GetValue(Path+'Debugger/EventLogShowProcess', True); 2502 FDebuggerEventLogShowThread := FXMLCfg.GetValue(Path+'Debugger/EventLogShowThread', True); 2503 FDebuggerEventLogShowModule := FXMLCfg.GetValue(Path+'Debugger/EventLogShowModule', False); 2504 FDebuggerEventLogShowOutput := FXMLCfg.GetValue(Path+'Debugger/EventLogShowOutput', True); 2505 FDebuggerEventLogShowWindows := FXMLCfg.GetValue(Path+'Debugger/EventLogShowWindows', False); 2506 FDebuggerEventLogShowDebugger := FXMLCfg.GetValue(Path+'Debugger/EventLogShowDebugger', True); 2507 FDebuggerEventLogUseColors := FXMLCfg.GetValue(Path+'Debugger/EventLogUseColors', True); 2508 for EventType := Low(TDBGEventType) to High(TDBGEventType) do 2509 begin 2510 FDebuggerEventLogColors[EventType].Background := 2511 FXMLCfg.GetValue(Path+'Debugger/EventLogColors/' + 2512 GetEnumName(TypeInfo(EventType), Ord(EventType)) + '/Background', 2513 DebuggerDefaultColors[EventType].Background); 2514 FDebuggerEventLogColors[EventType].Foreground := 2515 FXMLCfg.GetValue(Path+'Debugger/EventLogColors/' + 2516 GetEnumName(TypeInfo(EventType), Ord(EventType)) + '/Foreground', 2517 DebuggerDefaultColors[EventType].Foreground); 2518 end; 2519end; 2520 2521procedure TEnvironmentOptions.Load(OnlyDesktop: boolean); 2522 2523 procedure AddRecentProjectInitial(aProjPath, aProjFile: string); 2524 // Add a project to the list of recent projects if the project has write access. 2525 // The check can be removed when the IDE allows compiling read-only projects. 2526 var 2527 WholeFilePath: String; 2528 begin 2529 aProjPath:=SwitchPathDelims(aProjPath, True); 2530 WholeFilePath:=ExtractFilePath(Application.ExeName) + aProjPath + aProjFile; 2531 if FileIsWritable(aProjPath) and FileIsWritable(WholeFilePath) then 2532 AddToRecentList(WholeFilePath,FRecentProjectFiles,FMaxRecentProjectFiles,rltFile); 2533 end; 2534 2535 procedure LoadPascalFileExt(const Path: string); 2536 begin 2537 fPascalFileExtension:=PascalExtToType(FXMLCfg.GetValue( 2538 Path+'Naming/PascalFileExtension',PascalExtension[petPAS])); 2539 if fPascalFileExtension=petNone then 2540 fPascalFileExtension:=petPAS; 2541 end; 2542 2543 procedure LoadCCResult(var CCResult: TCodeCreationDlgResult; const Path: string; 2544 const DefaultClassSection: TInsertClassSection); 2545 begin 2546 CCResult.ClassSection:=InsertClassSectionNameToSection(FXMLCfg.GetValue( 2547 Path+'/ClassSection',InsertClassSectionNames[DefaultClassSection])); 2548 CCResult.Location:=CreateCodeLocationNameToLocation(FXMLCfg.GetValue( 2549 Path+'/Location',CreateCodeLocationNames[cclLocal])); 2550 end; 2551 2552var 2553 Path, CurPath: String; 2554 i, j: Integer; 2555 Rec: PIDEOptionsGroupRec; 2556 NodeName, xFileName: String; 2557 mwc: TMsgWndColor; 2558 u: TMessageLineUrgency; 2559begin 2560 try 2561 InitXMLCfg(false); 2562 // ToDo: Get rid of EnvironmentOptions/ path. The whole file is about 2563 // environment options. Many section are not under it any more. 2564 Path:='EnvironmentOptions/'; 2565 FFileVersion:=FXMLCfg.GetValue(Path+'Version/Value',EnvOptsVersion); 2566 FOldLazarusVersion:=FXMLCfg.GetValue(Path+'Version/Lazarus',''); 2567 if FOldLazarusVersion='' then begin 2568 // 108 added LastCalledByLazarusFullPath 2569 // 107 added Lazarus version 2570 // 1.1 r36507 106 2571 // 0.9.31 r28811 106 2572 // 0.9.29 r21344 106 2573 // 0.9.27 r16725 106 2574 // 0.9.25 r12751 106 2575 // 0.9.23 r10809 106 2576 end; 2577 2578 // language 2579 fLanguageID:=FXMLCfg.GetValue(Path+'Language/ID',''); 2580 2581 // auto save 2582 FAskSaveSessionOnly:=FXMLCfg.GetValue(Path+'AutoSave/AskSaveSessionOnly',false); 2583 FAutoSaveEditorFiles:=FXMLCfg.GetValue(Path+'AutoSave/EditorFiles',true); 2584 FAutoSaveProject:=FXMLCfg.GetValue(Path+'AutoSave/Project',true); 2585 FAutoSaveIntervalInSecs:=FXMLCfg.GetValue(Path+'AutoSave/IntervalInSecs',DefaultAutoSaveIntervalInSecs); 2586 FLastSavedProjectFile:=FXMLCfg.GetValue(Path+'AutoSave/LastSavedProjectFile',''); 2587 FOpenLastProjectAtStart:=FXMLCfg.GetValue(Path+'AutoSave/OpenLastProjectAtStart',true); 2588 FNewProjectTemplateAtStart:=FXMLCfg.GetValue(Path+'NewProjectTemplateAtStart/Value','Application'); 2589 FShowCompileDialog:=FXMLCfg.GetValue(Path+'ShowCompileDialog/Value',false); 2590 FAutoCloseCompileDialog:=FXMLCfg.GetValue(Path+'AutoCloseCompileDialog/Value',false); 2591 FAutoSaveActiveDesktop:=FXMLCfg.GetValue(Path+'AutoSave/ActiveDesktop',True); 2592 FLastOpenPackages.Clear; 2593 if FOpenLastProjectAtStart then 2594 begin 2595 i := 1; 2596 repeat 2597 xFileName := FXMLCfg.GetValue(Path+'AutoSave/LastOpenPackages/Package'+IntToStr(i), ''); 2598 if FileExistsCached(xFileName) then 2599 FLastOpenPackages.Add(xFileName); 2600 Inc(i); 2601 until xFileName=''; 2602 end; 2603 2604 // form editor 2605 FShowGrid:=FXMLCfg.GetValue(Path+'FormEditor/ShowGrid',true); 2606 FShowBorderSpacing:=FXMLCfg.GetValue(Path+'FormEditor/ShowBorderSpacing',false); 2607 FGridColor:=FXMLCfg.GetValue(Path+'FormEditor/GridColor',DefaultGridColor); 2608 FSnapToGrid:=FXMLCfg.GetValue(Path+'FormEditor/SnapToGrid',true); 2609 FGridSizeX:=FXMLCfg.GetValue(Path+'FormEditor/GridSizeX',DefaultGridSize); 2610 FGridSizeY:=FXMLCfg.GetValue(Path+'FormEditor/GridSizeY',DefaultGridSize); 2611 FShowGuideLines:=FXMLCfg.GetValue(Path+'FormEditor/ShowGuideLines',true); 2612 FSnapToGuideLines:=FXMLCfg.GetValue(Path+'FormEditor/SnapToGuideLines',true); 2613 FGuideLineColorLeftTop:=FXMLCfg.GetValue(Path+'FormEditor/GuideLineColorLeftTop', 2614 DefaultGuideLineColorLeftTop); 2615 FGuideLineColorRightBottom:=FXMLCfg.GetValue(Path+'FormEditor/GuideLineColorRightBottom', 2616 DefaultGuideLineColorRightBottom); 2617 FShowComponentCaptions:=FXMLCfg.GetValue(Path+'FormEditor/ShowComponentCaptions',true); 2618 FShowEditorHints:=FXMLCfg.GetValue(Path+'FormEditor/ShowEditorHints',true); 2619 FAutoCreateFormsOnOpen:=FXMLCfg.GetValue(Path+'FormEditor/AutoCreateFormsOnOpen',true); 2620 FCheckPackagesOnFormCreate:=FXMLCfg.GetValue(Path+'FormEditor/CheckPackagesOnFormCreate',true); 2621 FRightClickSelects:=FXMLCfg.GetValue(Path+'FormEditor/RightClickSelects',true); 2622 FGrabberColor:=FXMLCfg.GetValue(Path+'FormEditor/GrabberColor/Value',FGrabberColor); 2623 FMarkerColor:=FXMLCfg.GetValue(Path+'FormEditor/MarkerColor/Value',FMarkerColor); 2624 FNonFormBackgroundColor:=FXMLCfg.GetValue(Path+'FormEditor/NonFormBackgroundColor/Value',FNonFormBackgroundColor); 2625 FRubberbandSelectionColor:=FXMLCfg.GetValue(Path+'FormEditor/Rubberband/SelectionColor/Value', 2626 FRubberbandSelectionColor); 2627 FRubberbandCreationColor:=FXMLCfg.GetValue(Path+'FormEditor/Rubberband/CreationColor/Value', 2628 FRubberbandCreationColor); 2629 FRubberbandSelectsGrandChilds:=FXMLCfg.GetValue(Path+'FormEditor/Rubberband/SelectsGrandChilds/Value',DefaultRubberbandSelectsGrandChilds); 2630 FCreateComponentFocusNameProperty:=FXMLCfg.GetValue( 2631 Path+'FormEditor/CreateComponentFocusNameProperty/Value',false); 2632 FSwitchToFavoritesOITab:=FXMLCfg.GetValue(Path+'FormEditor/SwitchToFavoritesOITab/Value',false); 2633 FFormTitleBarChangesObjectInspector:=FXMLCfg.GetValue(Path+'FormEditor/FormTitleBarChangesObjectInspector/Value',false); 2634 FForceDPIScalingInDesignTime:=FXMLCfg.GetValue(Path+'FormEditor/ForceDPIScalingInDesignTime/Value',true); 2635 2636 if not OnlyDesktop then 2637 LoadNonDesktop(Path); 2638 2639 // project inspector 2640 FProjInspSortAlphabetically:=FXMLCfg.GetValue(Path+'ProjInspSortAlphabetically/Value',false); 2641 FProjInspShowDirHierarchy:=FXMLCfg.GetValue(Path+'ProjInspShowDirHierarchy/Value',false); 2642 2643 // package editor 2644 FPackageEditorSortAlphabetically:=FXMLCfg.GetValue(Path+'PackageEditorSortAlphabetically/Value',false); 2645 FPackageEditorShowDirHierarchy:=FXMLCfg.GetValue(Path+'PackageEditorShowDirHierarchy/Value',false); 2646 2647 // procedure list 2648 FProcedureListFilterStart:=FXMLCfg.GetValue(Path+'ProcedureListFilterStart/Value',false); 2649 2650 // hints 2651 FCheckDiskChangesWithLoading:=FXMLCfg.GetValue(Path+'CheckDiskChangesWithLoading/Value',false); 2652 FShowHintsForComponentPalette:=FXMLCfg.GetValue(Path+'ShowHintsForComponentPalette/Value',true); 2653 FShowHintsForMainSpeedButtons:=FXMLCfg.GetValue(Path+'ShowHintsForMainSpeedButtons/Value',true); 2654 2655 // messages view 2656 fMsgViewDblClickJumps:=FXMLCfg.GetValue(Path+'MsgViewDblClickJumps/Value',false); 2657 fMsgViewFocus:=FXMLCfg.GetValue(Path+'MsgViewFocus/Value',DefaultMsgViewFocus); 2658 FShowMessagesIcons:=FXMLCfg.GetValue(Path+'MsgView/ShowMessagesIcons/Value',true); 2659 FMsgViewStayOnTop:=FXMLCfg.GetValue(Path+'MsgView/StayOnTop/Value',false); 2660 FMsgViewShowTranslations:=FXMLCfg.GetValue(Path+'MsgView/ShowTranslations/Value',false); 2661 FMsgViewAlwaysDrawFocused:=FXMLCfg.GetValue(Path+'MsgView/AlwaysDrawFocused/Value',false); 2662 FMsgViewFilenameStyle:=StrToMsgWndFilenameStyle(FXMLCfg.GetValue( 2663 Path+'MsgView/Filename/Style',MsgWndFileNameStyleNames[mwfsShort])); 2664 for mwc:=low(TMsgWndColor) to high(TMsgWndColor) do 2665 fMsgViewColors[mwc]:=FXMLCfg.GetValue( 2666 Path+'MsgView/Colors/'+MsgWndColorNames[mwc],MsgWndDefaultColors[mwc]); 2667 for u:=low(TMessageLineUrgency) to high(TMessageLineUrgency) do 2668 fMsgColors[u] := FXMLCfg.GetValue( 2669 Path+'MsgView/MsgColors/'+dbgs(u),clDefault); 2670 MsgViewFilters.LoadFromXMLConfig(FXMLCfg,'MsgView/Filters/'); 2671 FMsgViewShowFPCMsgLinesCompiled:=FXMLCfg.GetValue(Path+'MsgView/FPCMsg/ShowLinesCompiled',false); 2672 2673 //component list 2674 FComponentListKeepOpen:=FXMLCfg.GetValue(Path+'ComponentList/KeepOpen',false); 2675 FComponentListPageIndex:=FXMLCfg.GetValue(Path+'ComponentList/PageIndex',0); 2676 2677 // glyphs 2678 FShowButtonGlyphs := TApplicationShowGlyphs(FXMLCfg.GetValue(Path+'ShowButtonGlyphs/Value', 2679 Ord(sbgSystem))); 2680 FShowMenuGlyphs := TApplicationShowGlyphs(FXMLCfg.GetValue(Path+'ShowMenuGlyphs/Value', 2681 Ord(sbgSystem))); 2682 2683 // comboboxes 2684 FDropDownCount:=FXMLCfg.GetValue(Path+'ComboBoxes/DropDownCount',DefaultDropDownCount); 2685 2686 // recent files and directories 2687 FMaxRecentOpenFiles:=FXMLCfg.GetValue(Path+'Recent/OpenFiles/Max',DefaultMaxRecentOpenFiles); 2688 LoadRecentList(FXMLCfg,FRecentOpenFiles,Path+'Recent/OpenFiles/',rltFile); 2689 FMaxRecentProjectFiles:=FXMLCfg.GetValue(Path+'Recent/ProjectFiles/Max',DefaultMaxRecentProjectFiles); 2690 LoadRecentList(FXMLCfg,FRecentProjectFiles,Path+'Recent/ProjectFiles/',rltFile); 2691 FMaxRecentPackageFiles:=FXMLCfg.GetValue(Path+'Recent/PackageFiles/Max',DefaultMaxRecentPackageFiles); 2692 LoadRecentList(FXMLCfg,FRecentPackageFiles,Path+'Recent/PackageFiles/',rltFile); 2693 2694 FAlreadyPopulatedRecentFiles := FXMLCfg.GetValue(Path+'Recent/AlreadyPopulated', false); 2695 2696 // other recent settings 2697 LoadCCResult(FLastEventMethodCCResult, Path+'Recent/EventMethodCCResult', icsPublic); 2698 LoadCCResult(FLastVariableCCResult, Path+'Recent/VariableCCResult', icsPrivate); 2699 2700 FUseUnitDlgOptions.AllUnits:=FXMLCfg.GetValue(Path+'Recent/UseUnitDlg/AllUnits',False); 2701 FUseUnitDlgOptions.AddToImplementation:=FXMLCfg.GetValue(Path+'Recent/UseUnitDlg/AddToImplementation',False); 2702 2703 // Add example projects to an empty project list if examples have write access 2704 if (FRecentProjectFiles.count=0) and (not FAlreadyPopulatedRecentFiles) then begin 2705 AddRecentProjectInitial('examples/jpeg/', 'jpegexample.lpi'); 2706 AddRecentProjectInitial('examples/sprites/', 'spriteexample.lpi'); 2707 AddRecentProjectInitial('examples/openglcontrol/', 'openglcontrol_demo.lpi'); 2708 AddRecentProjectInitial('examples/imagelist/', 'project1.lpi'); 2709 AddRecentProjectInitial('examples/', 'hello.lpi'); 2710 FAlreadyPopulatedRecentFiles := True; 2711 end; 2712 2713 // external tools 2714 if Assigned(fExternalUserTools) then 2715 fExternalUserTools.Load(FConfigStore,Path+'ExternalTools/'); 2716 FMaxExtToolsInParallel:=FXMLCfg.GetValue(Path+'ExternalTools/MaxInParallel',0); 2717 2718 // naming 2719 LoadPascalFileExt(Path+''); 2720 if FFileVersion>=103 then begin 2721 fCharcaseFileAction:=CharCaseFileActionNameToType(FXMLCfg.GetValue( 2722 Path+'CharcaseFileAction/Value','')); 2723 end else begin 2724 if FXMLCfg.GetValue(Path+'PascalFileAskLowerCase/Value',true) then 2725 fCharcaseFileAction:=ccfaAsk 2726 else if FXMLCfg.GetValue(Path+'PascalFileAutoLowerCase/Value',false) 2727 then 2728 fCharcaseFileAction:=ccfaAutoRename 2729 else 2730 fCharcaseFileAction:=ccfaIgnore; 2731 end; 2732 if FFileVersion>=104 then 2733 CurPath:=Path+'AmbiguousFileAction/Value' 2734 else 2735 CurPath:=Path+'AmbigiousFileAction/Value'; 2736 fAmbiguousFileAction:=AmbiguousFileActionNameToType(FXMLCfg.GetValue( 2737 CurPath,AmbiguousFileActionNames[fAmbiguousFileAction])); 2738 FUnitRenameReferencesAction:=UnitRenameReferencesActionNameToType(FXMLCfg.GetValue( 2739 Path+'UnitRenameReferencesAction/Value',UnitRenameReferencesActionNames[urraAsk])); 2740 FAskForFilenameOnNewFile:=FXMLCfg.GetValue(Path+'AskForFilenameOnNewFile/Value',false); 2741 FLowercaseDefaultFilename:=FXMLCfg.GetValue(Path+'LowercaseDefaultFilename/Value',true); 2742 FMultipleInstances:=StrToIDEMultipleInstancesOption(FXMLCfg.GetValue(Path+'MultipleInstances/Value','')); 2743 2744 // fpdoc 2745 FPDocPaths := FXMLCfg.GetValue(Path+'LazDoc/Paths',''); 2746 if FFileVersion<=105 then 2747 FPDocPaths:=LineBreaksToDelimiter(FPDocPaths,';'); 2748 2749 // 'new items' 2750 FNewUnitTemplate:=FXMLCfg.GetValue(Path+'New/UnitTemplate/Value',FileDescNamePascalUnit); 2751 FNewFormTemplate:=FXMLCfg.GetValue(Path+'New/FormTemplate/Value',FileDescNameLCLForm); 2752 2753 // object inspector 2754 FObjectInspectorOptions.Load; 2755 FObjectInspectorOptions.SaveBounds:=false; 2756 2757 // IDEEditorGroups 2758 for i := 0 to IDEEditorGroups.Count-1 do 2759 begin 2760 Rec := IDEEditorGroups[i]; 2761 NodeName := Rec^.GroupClass.ClassName; 2762 Rec^.Collapsed := FXMLCfg.GetValue(Path+'OptionDialog/Tree/' + NodeName + '/Value', 2763 Rec^.DefaultCollapsed); 2764 if Rec^.Items <> nil then begin 2765 for j := 0 to Rec^.Items.Count-1 do begin 2766 Rec^.Items[j]^.Collapsed := FXMLCfg.GetValue(Path+'OptionDialog/Tree/' + NodeName 2767 + '/' + Rec^.Items[j]^.EditorClass.ClassName + '/Value', 2768 Rec^.Items[j]^.DefaultCollapsed); 2769 end; 2770 end; 2771 end; 2772 2773 // The user can define many desktops. They are saved under path Desktops/. 2774 FDesktops.Clear; 2775 FDesktops.SetConfig(FXMLCfg, FConfigStore); 2776 FActiveDesktopName := ''; 2777 2778 if FFileVersion<109 then begin 2779 //load old default desktop - backwards compatibility - or create a new default desktop 2780 CurPath := 'Desktop/'; // New place: Desktop/ 2781 if not FXMLCfg.HasPath(CurPath, True) then 2782 CurPath := Path+'Desktop/'; // Old place: EnvironmentOptions/Desktop/ 2783 if FXMLCfg.HasPath(CurPath, True) or//default desktop exists in the settings 2784 ((ActiveDesktop.IDECoolBarOptions.ToolBars.Count = 0) and 2785 (ActiveDesktop.FIDEDialogLayoutList.Count = 0))//desktop is empty, load it to recreate! 2786 then 2787 begin 2788 ActiveDesktop.SetConfig(FXMLCfg, FConfigStore); 2789 ActiveDesktop.Load(CurPath); 2790 end; 2791 end else begin 2792 CurPath := 'Desktops/'; 2793 FDebugDesktopName := FXMLCfg.GetValue(CurPath+'DebugDesktop', ''); 2794 FActiveDesktopName := FXMLCfg.GetValue(CurPath+'ActiveDesktop', ''); 2795 j := FXMLCfg.GetValue(CurPath+'Count', 1); 2796 for i := 1 to j do 2797 FDesktops.AddFromCfg(CurPath+'Desktop'+IntToStr(i)+'/'); 2798 end; 2799 if FFileVersion<=109 then begin 2800 FXMLCfg.DeletePath('Desktop'); 2801 FXMLCfg.DeletePath(CurPath+'Desktop'); 2802 end; 2803 2804 FDesktop.Assign(ActiveDesktop, False); 2805 FDesktop.ExportSettingsToIDE(Self); 2806 2807 for i := 0 to SubConfigCount - 1 do 2808 SubConfig[i].ReadFromXml(FXMLCfg); 2809 2810 FileUpdated; 2811 except 2812 on E: Exception do 2813 DebugLn('[TEnvironmentOptions.Load] error reading "',FFilename,'": '+E.Message); 2814 end; 2815end; 2816 2817procedure TEnvironmentOptions.SaveNonDesktop(Path: String); 2818 2819 procedure SaveBackupInfo(var BackupInfo: TBackupInfo; Path:string; 2820 DefaultBackupType: TBackupType); 2821 begin 2822 with BackupInfo do begin 2823 FXMLCfg.SetDeleteValue(Path+'Type',BackupTypeToName(BackupType),BackupTypeToName(DefaultBackupType)); 2824 FXMLCfg.SetDeleteValue(Path+'AdditionalExtension',AdditionalExtension,DefaultBackupAddExt); 2825 FXMLCfg.SetDeleteValue(Path+'MaxCounter',MaxCounter,DefaultBackupMaxCounter); 2826 FXMLCfg.SetDeleteValue(Path+'SubDirectory',SubDirectory,DefaultBackupSubDirectory); 2827 end; 2828 end; 2829 2830var 2831 BaseDir, CurLazDir: String; 2832 EventType: TDBGEventType; 2833 i: Integer; 2834begin 2835 // files 2836 CurLazDir:=ChompPathDelim(LazarusDirectory); 2837 if not TTransferMacroList.StrHasMacros(CurLazDir) then begin 2838 BaseDir:=ExtractFilePath(ChompPathDelim(GetPrimaryConfigPath)); 2839 if PathIsInPath(CurLazDir,BaseDir) then begin 2840 // the pcp directory is in the lazarus directory 2841 // or the lazarus directory is a sibling or a sub dir of a sibling of the pcp 2842 // examples: 2843 // pcp=C:\Lazarus\config, lazdir=C:\Lazarus => store '..' 2844 // pcp=/home/user/.lazarus, lazdir=/home/user/freepascal/lazarus => store ../freepascal/lazarus 2845 CurLazDir:=CreateRelativePath(CurLazDir,GetPrimaryConfigPath); 2846 end; 2847 FXMLCfg.SetValue(Path+'LazarusDirectory/Value',CurLazDir); // always store, no SetDeleteValue 2848 end; 2849 SaveRecentList(FXMLCfg,FLazarusDirHistory,Path+'LazarusDirectory/History/'); 2850 FXMLCfg.SetDeleteValue(Path+'CompilerFilename/Value',CompilerFilename,''); 2851 SaveRecentList(FXMLCfg,FCompilerFileHistory,Path+'CompilerFilename/History/'); 2852 FXMLCfg.SetDeleteValue(Path+'FPCSourceDirectory/Value',FPCSourceDirectory,''); 2853 SaveRecentList(FXMLCfg,FFPCSourceDirHistory,Path+'FPCSourceDirectory/History/'); 2854 FXMLCfg.SetDeleteValue(Path+'MakeFilename/Value',MakeFilename,DefaultMakefilename); 2855 SaveRecentList(FXMLCfg,FMakeFileHistory,Path+'MakeFilename/History/'); 2856 FXMLCfg.SetDeleteValue(Path+'TestBuildDirectory/Value',TestBuildDirectory,''); 2857 SaveRecentList(FXMLCfg,FTestBuildDirHistory,Path+'TestBuildDirectory/History/'); 2858 FXMLCfg.SetDeleteValue(Path+'CompilerMessagesFilename/Value',CompilerMessagesFilename,''); 2859 SaveRecentList(FXMLCfg,FCompilerMessagesFileHistory,Path+'CompilerMessagesFilename/History/'); 2860 FXMLCfg.SetDeleteValue(Path+'FppkgConfigFile/Value',FppkgConfigFile,''); 2861 SaveRecentList(FXMLCfg,FFppkgConfigFileHistory,Path+'FppkgConfigFile/History/'); 2862 // Note: ManyBuildModesSelection is not stored here any more. Moved to project settings. 2863 2864 // Primary-config verification 2865 FXMLCfg.SetDeleteValue(Path+'LastCalledByLazarusFullPath/Value',FLastCalledByLazarusFullPath,''); 2866 2867 // global buid options 2868 FConfigStore.AppendBasePath('BuildMatrix'); 2869 FBuildMatrixOptions.SaveToConfig(FConfigStore,IsGlobalMode); 2870 FConfigStore.UndoAppendBasePath; 2871 2872 // Clean build project dialog 2873 FXMLCfg.SetDeleteValue(Path+'CleanBuild/ProjOut',FCleanBuildProjOut,true); 2874 FXMLCfg.SetDeleteValue(Path+'CleanBuild/ProjSrc',FCleanBuildProjSrc,true); 2875 FXMLCfg.SetDeleteValue(Path+'CleanBuild/PkgOut',FCleanBuildPkgOut,true); 2876 FXMLCfg.SetDeleteValue(Path+'CleanBuild/PkgSrc',FCleanBuildPkgSrc,true); 2877 2878 // backup 2879 SaveBackupInfo(FBackupInfoProjectFiles,Path+'BackupProjectFiles/',DefaultBackupTypeProject); 2880 SaveBackupInfo(FBackupInfoOtherFiles,Path+'BackupOtherFiles/',DefaultBackupTypeOther); 2881 2882 // debugger 2883 FDebuggerConfig.Save; 2884 SaveDebuggerPropertiesList; 2885 FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/ShowStopMessage/Value', 2886 FDebuggerShowStopMessage, True); 2887 FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/DebuggerShowExitCodeMessage/Value', 2888 FDebuggerShowExitCodeMessage, True); 2889 FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/DebuggerResetAfterRun/Value', 2890 FDebuggerResetAfterRun, False); 2891 FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/DebuggerAutoCloseAsm/Value', 2892 FDebuggerAutoCloseAsm, False); 2893 FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/DebuggerAutoSetInstanceFromClass/Value', 2894 FDebuggerAutoSetInstanceFromClass, False); 2895 FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/DebuggerAllowFunctionCalls/Value', 2896 FDebuggerAllowFunctionCalls, False); 2897 for i := 0 to FDebuggerFileHistory.Count -1 do 2898 if FDebuggerFileHistory[i] = '' then 2899 SaveRecentList(FXMLCfg,TStrings(FDebuggerFileHistory.Objects[i]),Path+'DebuggerFilename/History/') 2900 else 2901 SaveRecentList(FXMLCfg,TStrings(FDebuggerFileHistory.Objects[i]), 2902 Path+'DebuggerFilename/'+FDebuggerFileHistory[i]+'/History/'); 2903 FXMLCfg.SetDeleteValue(Path+'DebuggerSearchPath/Value',DebuggerSearchPath,''); 2904 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogClearOnRun',FDebuggerEventLogClearOnRun, True); 2905 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogCheckLineLimit',FDebuggerEventLogCheckLineLimit, False); 2906 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogLineLimit',FDebuggerEventLogLineLimit, 1000); 2907 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowBreakpoint',FDebuggerEventLogShowBreakpoint, False); 2908 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowProcess',FDebuggerEventLogShowProcess, True); 2909 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowThread',FDebuggerEventLogShowThread, True); 2910 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowModule',FDebuggerEventLogShowModule, False); 2911 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowOutput',FDebuggerEventLogShowOutput, True); 2912 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowWindows',FDebuggerEventLogShowWindows, False); 2913 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowDebugger',FDebuggerEventLogShowDebugger, True); 2914 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogUseColors',FDebuggerEventLogUseColors, True); 2915 for EventType := Low(TDBGEventType) to High(TDBGEventType) do 2916 begin 2917 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogColors/' + 2918 GetEnumName(TypeInfo(EventType), Ord(EventType)) + '/Background', 2919 FDebuggerEventLogColors[EventType].Background, 2920 DebuggerDefaultColors[EventType].Background); 2921 FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogColors/' + 2922 GetEnumName(TypeInfo(EventType), Ord(EventType)) + '/Foreground', 2923 FDebuggerEventLogColors[EventType].Foreground, 2924 DebuggerDefaultColors[EventType].Foreground); 2925 end; 2926end; 2927 2928procedure TEnvironmentOptions.Save(OnlyDesktop: boolean); 2929 procedure SaveCCResult(const CCResult: TCodeCreationDlgResult; const Path: string; 2930 const DefaultClassSection: TInsertClassSection); 2931 begin 2932 FXMLCfg.SetDeleteValue(Path+'/ClassSection', 2933 InsertClassSectionNames[CCResult.ClassSection], 2934 InsertClassSectionNames[DefaultClassSection]); 2935 FXMLCfg.SetDeleteValue(Path+'/Location', 2936 CreateCodeLocationNames[CCResult.Location], 2937 CreateCodeLocationNames[cclLocal]); 2938 end; 2939 2940var 2941 Path, CurPath, NodeName: String; 2942 i, j: Integer; 2943 Rec: PIDEOptionsGroupRec; 2944 mwc: TMsgWndColor; 2945 u: TMessageLineUrgency; 2946 xSaveDesktop: TCustomDesktopOpt; 2947 xActiveDesktopName: string; 2948begin 2949 try 2950 InitXMLCfg(true); 2951 // ToDo: Get rid of EnvironmentOptions/ path. The whole file is about 2952 // environment options. Many section are not under it any more. 2953 Path:='EnvironmentOptions/'; 2954 2955 FXMLCfg.SetValue(Path+'Version/Value',EnvOptsVersion); 2956 FXMLCfg.SetValue(Path+'Version/Lazarus',LazarusVersionStr); 2957 2958 // language 2959 FXMLCfg.SetDeleteValue(Path+'Language/ID',LanguageID,''); 2960 2961 // auto save 2962 FXMLCfg.SetDeleteValue(Path+'AutoSave/AskSaveSessionOnly',FAskSaveSessionOnly,false); 2963 FXMLCfg.SetDeleteValue(Path+'AutoSave/EditorFiles',FAutoSaveEditorFiles,true); 2964 FXMLCfg.SetDeleteValue(Path+'AutoSave/Project',FAutoSaveProject,true); 2965 FXMLCfg.SetDeleteValue(Path+'AutoSave/IntervalInSecs',FAutoSaveIntervalInSecs,DefaultAutoSaveIntervalInSecs); 2966 FXMLCfg.SetDeleteValue(Path+'AutoSave/LastSavedProjectFile',FLastSavedProjectFile,''); 2967 FXMLCfg.SetDeleteValue(Path+'AutoSave/OpenLastProjectAtStart',FOpenLastProjectAtStart,true); 2968 2969 FXMLCfg.SetDeleteValue(Path+'NewProjectTemplateAtStart/Value',FNewProjectTemplateAtStart,'Application'); 2970 FXMLCfg.SetDeleteValue(Path+'AutoSave/ActiveDesktop', FAutoSaveActiveDesktop, True); 2971 FXMLCfg.DeletePath(Path+'AutoSave/LastOpenPackages/'); 2972 if FOpenLastProjectAtStart then 2973 for i := 0 to FLastOpenPackages.Count-1 do 2974 FXMLCfg.SetValue(Path+'AutoSave/LastOpenPackages/Package'+IntToStr(i+1), FLastOpenPackages[i]); 2975 2976 // form editor 2977 FXMLCfg.SetDeleteValue(Path+'FormEditor/ShowBorderSpacing',FShowBorderSpacing,false); 2978 FXMLCfg.SetDeleteValue(Path+'FormEditor/ShowGrid',FShowGrid,true); 2979 FXMLCfg.SetDeleteValue(Path+'FormEditor/GridColor',FGridColor,DefaultGridColor); 2980 FXMLCfg.SetDeleteValue(Path+'FormEditor/SnapToGrid',FSnapToGrid,true); 2981 FXMLCfg.SetDeleteValue(Path+'FormEditor/GridSizeX',FGridSizeX,DefaultGridSize); 2982 FXMLCfg.SetDeleteValue(Path+'FormEditor/GridSizeY',FGridSizeY,DefaultGridSize); 2983 FXMLCfg.SetDeleteValue(Path+'FormEditor/ShowGuideLines',FShowGuideLines,true); 2984 FXMLCfg.SetDeleteValue(Path+'FormEditor/SnapToGuideLines',FSnapToGuideLines,true); 2985 FXMLCfg.SetDeleteValue(Path+'FormEditor/GuideLineColorLeftTop',FGuideLineColorLeftTop,DefaultGuideLineColorLeftTop); 2986 FXMLCfg.SetDeleteValue(Path+'FormEditor/GuideLineColorRightBottom',FGuideLineColorRightBottom,DefaultGuideLineColorRightBottom); 2987 FXMLCfg.SetDeleteValue(Path+'FormEditor/ShowComponentCaptions',FShowComponentCaptions,true); 2988 FXMLCfg.SetDeleteValue(Path+'FormEditor/ShowEditorHints',FShowEditorHints,true); 2989 FXMLCfg.SetDeleteValue(Path+'FormEditor/AutoCreateFormsOnOpen',FAutoCreateFormsOnOpen,true); 2990 FXMLCfg.SetDeleteValue(Path+'FormEditor/CheckPackagesOnFormCreate',FCheckPackagesOnFormCreate,true); 2991 FXMLCfg.SetDeleteValue(Path+'FormEditor/RightClickSelects',FRightClickSelects,true); 2992 FXMLCfg.SetDeleteValue(Path+'FormEditor/GrabberColor/Value',FGrabberColor,clBlack); 2993 FXMLCfg.SetDeleteValue(Path+'FormEditor/MarkerColor/Value',FMarkerColor,clDkGray); 2994 FXMLCfg.SetDeleteValue(Path+'FormEditor/NonFormBackgroundColor/Value',FNonFormBackgroundColor,clWindow); 2995 FXMLCfg.SetDeleteValue(Path+'FormEditor/Rubberband/SelectionColor/Value', 2996 FRubberbandSelectionColor,clBlack); 2997 FXMLCfg.SetDeleteValue(Path+'FormEditor/Rubberband/CreationColor/Value', 2998 FRubberbandCreationColor,clRed); 2999 FXMLCfg.SetDeleteValue(Path+'FormEditor/Rubberband/SelectsGrandChilds/Value', 3000 FRubberbandSelectsGrandChilds,DefaultRubberbandSelectsGrandChilds); 3001 FXMLCfg.SetDeleteValue(Path+'FormEditor/CreateComponentFocusNameProperty/Value', 3002 FCreateComponentFocusNameProperty,false); 3003 FXMLCfg.SetDeleteValue(Path+'FormEditor/SwitchToFavoritesOITab/Value',FSwitchToFavoritesOITab,false); 3004 FXMLCfg.SetDeleteValue(Path+'FormEditor/FormTitleBarChangesObjectInspector/Value',FFormTitleBarChangesObjectInspector,false); 3005 FXMLCfg.SetDeleteValue(Path+'FormEditor/ForceDPIScalingInDesignTime/Value',FForceDPIScalingInDesignTime,true); 3006 3007 FXMLCfg.SetDeleteValue(Path+'ShowCompileDialog/Value',FShowCompileDialog,False); 3008 FXMLCfg.SetDeleteValue(Path+'AutoCloseCompileDialog/Value',FAutoCloseCompileDialog,False); 3009 3010 if not OnlyDesktop then 3011 SaveNonDesktop(Path); 3012 3013 // project inspector 3014 FXMLCfg.SetDeleteValue(Path+'ProjInspSortAlphabetically/Value',FProjInspSortAlphabetically,false); 3015 FXMLCfg.SetDeleteValue(Path+'ProjInspShowDirHierarchy/Value',FProjInspShowDirHierarchy,false); 3016 3017 // package editor 3018 FXMLCfg.SetDeleteValue(Path+'PackageEditorSortAlphabetically/Value',FPackageEditorSortAlphabetically,false); 3019 FXMLCfg.SetDeleteValue(Path+'PackageEditorShowDirHierarchy/Value',FPackageEditorShowDirHierarchy,false); 3020 3021 // procedure list 3022 FXMLCfg.SetDeleteValue(Path+'ProcedureListFilterStart/Value',FProcedureListFilterStart,false); 3023 3024 // hints 3025 FXMLCfg.SetDeleteValue(Path+'CheckDiskChangesWithLoading/Value',FCheckDiskChangesWithLoading,false); 3026 FXMLCfg.SetDeleteValue(Path+'ShowHintsForComponentPalette/Value',FShowHintsForComponentPalette,true); 3027 FXMLCfg.SetDeleteValue(Path+'ShowHintsForMainSpeedButtons/Value',FShowHintsForMainSpeedButtons,true); 3028 3029 // messages view 3030 FXMLCfg.SetDeleteValue(Path+'MsgViewDblClickJumps/Value',fMsgViewDblClickJumps,false); 3031 FXMLCfg.SetDeleteValue(Path+'MsgViewFocus/Value',fMsgViewFocus,DefaultMsgViewFocus); 3032 FXMLCfg.SetDeleteValue(Path+'MsgView/ShowMessagesIcons/Value',FShowMessagesIcons,true); 3033 FXMLCfg.SetDeleteValue(Path+'MsgView/StayOnTop/Value',FMsgViewStayOnTop,false); 3034 FXMLCfg.SetDeleteValue(Path+'MsgView/ShowTranslations/Value',FMsgViewShowTranslations,false); 3035 FXMLCfg.SetDeleteValue(Path+'MsgView/AlwaysDrawFocused/Value',FMsgViewAlwaysDrawFocused,false); 3036 FXMLCfg.SetDeleteValue(Path+'MsgView/Filename/Style', 3037 MsgWndFileNameStyleNames[FMsgViewFilenameStyle], 3038 MsgWndFileNameStyleNames[mwfsShort]); 3039 for mwc:=low(TMsgWndColor) to high(TMsgWndColor) do 3040 FXMLCfg.SetDeleteValue(Path+'MsgView/Colors/'+MsgWndColorNames[mwc], 3041 fMsgViewColors[mwc],MsgWndDefaultColors[mwc]); 3042 for u:=low(TMessageLineUrgency) to high(TMessageLineUrgency) do 3043 FXMLCfg.SetDeleteValue(Path+'MsgView/MsgColors/'+dbgs(u), 3044 fMsgColors[u],clDefault); 3045 MsgViewFilters.SaveToXMLConfig(FXMLCfg,'MsgView/Filters/'); 3046 FXMLCfg.SetDeleteValue(Path+'MsgView/FPCMsg/ShowLinesCompiled',FMsgViewShowFPCMsgLinesCompiled,false); 3047 3048 //component list 3049 FXMLCfg.SetDeleteValue(Path+'ComponentList/KeepOpen',FComponentListKeepOpen,false); 3050 FXMLCfg.SetDeleteValue(Path+'ComponentList/PageIndex',FComponentListPageIndex,0); 3051 3052 // glyphs 3053 FXMLCfg.SetDeleteValue(Path+'ShowButtonGlyphs/Value',Ord(FShowButtonGlyphs), Ord(sbgSystem)); 3054 FXMLCfg.SetDeleteValue(Path+'ShowMenuGlyphs/Value',Ord(FShowMenuGlyphs), Ord(sbgSystem)); 3055 3056 // comboboxes 3057 FXMLCfg.SetDeleteValue(Path+'ComboBoxes/DropDownCount',FDropDownCount,DefaultDropDownCount); 3058 3059 // recent files and directories 3060 FXMLCfg.SetDeleteValue(Path+'Recent/OpenFiles/Max',FMaxRecentOpenFiles,DefaultMaxRecentOpenFiles); 3061 SaveRecentList(FXMLCfg,FRecentOpenFiles,Path+'Recent/OpenFiles/',FMaxRecentOpenFiles); 3062 FXMLCfg.SetDeleteValue(Path+'Recent/ProjectFiles/Max',FMaxRecentProjectFiles,DefaultMaxRecentProjectFiles); 3063 SaveRecentList(FXMLCfg,FRecentProjectFiles,Path+'Recent/ProjectFiles/',FMaxRecentProjectFiles); 3064 FXMLCfg.SetDeleteValue(Path+'Recent/PackageFiles/Max',FMaxRecentPackageFiles,DefaultMaxRecentPackageFiles); 3065 SaveRecentList(FXMLCfg,FRecentPackageFiles,Path+'Recent/PackageFiles/',FMaxRecentPackageFiles); 3066 3067 FXMLCfg.SetDeleteValue(Path+'Recent/AlreadyPopulated', FAlreadyPopulatedRecentFiles, false); 3068 3069 // other recent settings 3070 SaveCCResult(FLastEventMethodCCResult, Path+'Recent/EventMethodCCResult', icsPublic); 3071 SaveCCResult(FLastVariableCCResult, Path+'Recent/VariableCCResult', icsPrivate); 3072 3073 FXMLCfg.SetDeleteValue(Path+'Recent/UseUnitDlg/AllUnits',FUseUnitDlgOptions.AllUnits,False); 3074 FXMLCfg.SetDeleteValue(Path+'Recent/UseUnitDlg/AddToImplementation',FUseUnitDlgOptions.AddToImplementation,False); 3075 3076 // external tools 3077 if Assigned(fExternalUserTools) then 3078 fExternalUserTools.Save(FConfigStore,Path+'ExternalTools/'); 3079 FXMLCfg.SetDeleteValue(Path+'ExternalTools/MaxInParallel',FMaxExtToolsInParallel,0); 3080 3081 // naming 3082 FXMLCfg.SetDeleteValue(Path+'Naming/PascalFileExtension', 3083 PascalExtension[fPascalFileExtension],'.pas'); 3084 FXMLCfg.SetDeleteValue(Path+'CharcaseFileAction/Value', 3085 CharCaseFileActionNames[fCharcaseFileAction], 3086 CharCaseFileActionNames[ccfaAutoRename]); 3087 FXMLCfg.SetDeleteValue(Path+'AmbiguousFileAction/Value', 3088 AmbiguousFileActionNames[fAmbiguousFileAction], 3089 AmbiguousFileActionNames[afaAsk]); 3090 FXMLCfg.SetDeleteValue(Path+'AskForFilenameOnNewFile/Value', 3091 FAskForFilenameOnNewFile,false); 3092 FXMLCfg.SetDeleteValue(Path+'LowercaseDefaultFilename/Value', 3093 FLowercaseDefaultFilename,true); 3094 FXMLCfg.SetDeleteValue(Path+'MultipleInstances/Value', 3095 IDEMultipleInstancesOptionNames[FMultipleInstances], 3096 IDEMultipleInstancesOptionNames[DefaultIDEMultipleInstancesOption]); 3097 3098 // fpdoc 3099 FXMLCfg.SetDeleteValue(Path+'LazDoc/Paths',FPDocPaths,''); 3100 3101 // 'new items' 3102 FXMLCfg.SetDeleteValue(Path+'New/UnitTemplate/Value',FNewUnitTemplate,FileDescNamePascalUnit); 3103 FXMLCfg.SetDeleteValue(Path+'New/FormTemplate/Value',FNewFormTemplate,FileDescNameLCLForm); 3104 3105 // object inspector 3106 FObjectInspectorOptions.SaveBounds:=false; 3107 FObjectInspectorOptions.Save; 3108 3109 // IDEEditorGroups 3110 for i := 0 to IDEEditorGroups.Count-1 do 3111 begin 3112 Rec := IDEEditorGroups[i]; 3113 NodeName := Rec^.GroupClass.ClassName; 3114 FXMLCfg.SetDeleteValue(Path+'OptionDialog/Tree/' + NodeName + '/Value', 3115 Rec^.Collapsed, 3116 Rec^.DefaultCollapsed); 3117 if Rec^.Items <> nil then begin 3118 for j := 0 to Rec^.Items.Count-1 do begin 3119 FXMLCfg.SetDeleteValue(Path+'OptionDialog/Tree/' + NodeName 3120 + '/' + Rec^.Items[j]^.EditorClass.ClassName + '/Value', 3121 Rec^.Items[j]^.Collapsed, 3122 Rec^.Items[j]^.DefaultCollapsed); 3123 end; 3124 end; 3125 end; 3126 3127 //automatically save active desktops 3128 if AutoSaveActiveDesktop 3129 and (Application.MainForm<>nil) and Application.MainForm.Visible then 3130 begin 3131 //save active desktop 3132 FDesktop.ImportSettingsFromIDE(Self); 3133 ActiveDesktop.Assign(FDesktop); 3134 3135 if Assigned(FLastDesktopBeforeDebug) then//are we in debug session? 3136 begin 3137 //save last desktop before the debug desktop 3138 xSaveDesktop := FDesktops.Find(FLastDesktopBeforeDebug.Name); 3139 if Assigned(xSaveDesktop) and xSaveDesktop.InheritsFrom(TDesktopOpt) then 3140 TDesktopOpt(xSaveDesktop).Assign(FLastDesktopBeforeDebug, False); 3141 end; 3142 end; 3143 if Assigned(FLastDesktopBeforeDebug) then 3144 xActiveDesktopName := FLastDesktopBeforeDebug.Name 3145 else 3146 xActiveDesktopName := FActiveDesktopName; 3147 3148 // The user can define many desktops. They are saved under path Desktops/. 3149 FXMLCfg.DeletePath('Desktops/'); 3150 CurPath:='Desktops/'; 3151 FXMLCfg.SetDeleteValue(CurPath+'Count', FDesktops.Count, 0); 3152 FXMLCfg.SetDeleteValue(CurPath+'DebugDesktop', FDebugDesktopName, ''); 3153 FXMLCfg.SetDeleteValue(CurPath+'ActiveDesktop', xActiveDesktopName, ''); 3154 for i := 0 to FDesktops.Count-1 do 3155 begin 3156 FDesktops[i].SetConfig(FXMLCfg, FConfigStore); 3157 FDesktops[i].Save(CurPath+'Desktop'+IntToStr(i+1)+'/'); 3158 end; 3159 3160 for i := 0 to SubConfigCount - 1 do 3161 SubConfig[i].WriteToXml(FXMLCfg); 3162 3163 FXMLCfg.Flush; 3164 FileUpdated; 3165 except 3166 on E: Exception do begin 3167 DebugLn('[TEnvironmentOptions.Save] error writing "',Filename,'": ',E.Message); 3168 end; 3169 end; 3170end; 3171 3172function TEnvironmentOptions.GetDefaultConfigFilename: string; 3173begin 3174 Result:=TrimFilename(AppendPathDelim(GetPrimaryConfigPath)+EnvOptsConfFileName); 3175end; 3176 3177procedure TEnvironmentOptions.AddToRecentOpenFiles(const AFilename: string); 3178var 3179 Allow: Boolean; 3180begin 3181 Allow := True; 3182 DoAddToRecentOpenFiles(AFilename, Allow); 3183 if Allow then 3184 AddToRecentList(AFilename,FRecentOpenFiles,FMaxRecentOpenFiles,rltFile); 3185end; 3186 3187procedure TEnvironmentOptions.AddToRecentPackageFiles(const AFilename: string); 3188var 3189 Allow: Boolean; 3190begin 3191 Allow := True; 3192 DoAddToRecentPackageFiles(AFilename, Allow); 3193 if Allow then 3194 AddToRecentList(AFilename,FRecentPackageFiles,FMaxRecentPackageFiles,rltFile); 3195end; 3196 3197procedure TEnvironmentOptions.RemoveFromRecentOpenFiles(const AFilename: string); 3198begin 3199 RemoveFromRecentList(AFilename,FRecentOpenFiles,rltFile); 3200end; 3201 3202procedure TEnvironmentOptions.GetRecentFiles(aType: TIDERecentHandler; 3203 aList: TStrings); 3204begin 3205 case aType of 3206 irhProjectFiles : aList.Assign(FRecentProjectFiles); 3207 irhPackageFiles : aList.Assign(FRecentPackageFiles); 3208 irhOpenFiles : aList.Assign(FRecentOpenFiles); 3209 end; 3210end; 3211 3212procedure TEnvironmentOptions.RemoveFromRecentPackageFiles(const AFilename: string); 3213begin 3214 RemoveFromRecentList(AFilename,FRecentPackageFiles,rltFile); 3215end; 3216 3217procedure TEnvironmentOptions.AddToRecentProjectFiles(const AFilename: string); 3218var 3219 Allow: Boolean; 3220begin 3221 Allow := True; 3222 DoAddToRecentProjectFiles(AFilename, Allow); 3223 if Allow then 3224 AddToRecentList(AFilename,FRecentProjectFiles,FMaxRecentProjectFiles,rltFile); 3225 {$ifdef Windows} 3226 SHAddToRecentDocs(SHARD_PATHW, PWideChar(UTF8ToUTF16(AFileName))); 3227 {$endif} 3228end; 3229 3230procedure TEnvironmentOptions.RemoveFromRecentProjectFiles(const AFilename: string); 3231begin 3232 RemoveFromRecentList(AFilename,FRecentProjectFiles,rltFile); 3233end; 3234 3235function TEnvironmentOptions.GetParsedTestBuildDirectory: string; 3236begin 3237 Result:=GetParsedValue(eopTestBuildDirectory); 3238end; 3239 3240function TEnvironmentOptions.GetParsedFPCSourceDirectory(FPCVer: string): string; 3241var 3242 s: String; 3243begin 3244 if (FPCVer<>'') and (Pos('$(',FPCSourceDirectory)>0) then begin 3245 s:='$(FPCVer)'; 3246 GlobalMacroList.SubstituteStr(s); 3247 if s<>FPCVer then begin 3248 // override macro FPCVer 3249 OverrideFPCVer:=FPCVer; 3250 IncreaseCompilerParseStamp; 3251 try 3252 Result:=GetParsedValue(eopFPCSourceDirectory); 3253 //debugln(['TEnvironmentOptions.GetParsedFPCSourceDirectory FPCVer=',FPCVer,' FPCSrcDir=',Result]); 3254 finally 3255 OverrideFPCVer:=''; 3256 IncreaseCompilerParseStamp; 3257 end; 3258 exit; 3259 end; 3260 end; 3261 Result:=GetParsedValue(eopFPCSourceDirectory); 3262end; 3263 3264function TEnvironmentOptions.GetParsedMakeFilename: string; 3265begin 3266 Result:=GetParsedValue(eopMakeFilename); 3267end; 3268 3269function TEnvironmentOptions.GetParsedCompilerMessagesFilename: string; 3270begin 3271 Result:=GetParsedValue(eopCompilerMessagesFilename); 3272end; 3273 3274function TEnvironmentOptions.GetParsedFPDocPaths: string; 3275begin 3276 Result:=GetParsedValue(eopFPDocPaths); 3277end; 3278 3279function TEnvironmentOptions.GetParsedDebuggerFilename(TheProject: TLazProject 3280 ): string; 3281begin 3282 if FParseValues[eopDebuggerFilename].UnparsedValue <> DebuggerFilename(TheProject) then 3283 SetParseValue(eopDebuggerFilename,UTF8Trim(DebuggerFilename(TheProject))); 3284 3285 Result:=GetParsedValue(eopDebuggerFilename); 3286end; 3287 3288function TEnvironmentOptions.GetParsedDebuggerSearchPath: string; 3289begin 3290 Result:=GetParsedValue(eopDebuggerSearchPath); 3291end; 3292 3293function TEnvironmentOptions.GetParsedFppkgConfig: string; 3294begin 3295 Result:=GetParsedValue(eopFppkgConfigFile); 3296end; 3297 3298function TEnvironmentOptions.GetParsedValue(o: TEnvOptParseType; 3299 AUnparsedValue: String): string; 3300type 3301 PParseString = ^TParseString; 3302var 3303 SpacePos: SizeInt; 3304 CurParams: String; 3305 TempValue: TParseString; 3306 VP: PParseString; 3307begin 3308 if AUnparsedValue <> '' then begin 3309 TempValue.UnparsedValue := AUnparsedValue; 3310 TempValue.ParseStamp := CTInvalidChangeStamp; 3311 TempValue.Parsing := False; 3312 VP := @TempValue; 3313 end 3314 else 3315 VP := @FParseValues[o]; 3316 3317 with VP^ do begin 3318 if (ParseStamp<>CompilerParseStamp) 3319 or (CompilerParseStamp=CTInvalidChangeStamp) then begin 3320 if Parsing then begin 3321 debugln(['TEnvironmentOptions.GetParsedValue circular macro dependency: ',dbgs(o)]); 3322 exit('circularmacroerror'); 3323 end; 3324 Parsing:=true; 3325 try 3326 ParsedValue:=UnparsedValue; 3327 if (ParsedValue='') and (o=eopCompilerMessagesFilename) then 3328 ParsedValue:=GetForcedPathDelims('$(FPCSrcDir)/compiler/msg/errore.msg'); 3329 3330 if not GlobalMacroList.SubstituteStr(ParsedValue) then begin 3331 debugln(['TEnvironmentOptions.GetParsedValue failed for ',dbgs(o),' Value="',UnparsedValue,'"']); 3332 end; 3333 ParseStamp:=CompilerParseStamp; 3334 3335 case o of 3336 eopLazarusDirectory: 3337 // lazarus directory 3338 begin 3339 ParsedValue:=TrimAndExpandDirectory(ParsedValue,GetPrimaryConfigPath); 3340 if ParsedValue='' then 3341 ParsedValue:=TrimFilename(AppendPathDelim(GetCurrentDirUTF8)); 3342 end; 3343 eopFPCSourceDirectory,eopTestBuildDirectory: 3344 // directory 3345 begin 3346 ParsedValue:=TrimAndExpandDirectory(ParsedValue,GetParsedLazarusDirectory); 3347 if ParsedValue='' then 3348 ParsedValue:=GetParsedLazarusDirectory; 3349 end; 3350 eopCompilerMessagesFilename: 3351 // data file 3352 begin 3353 ParsedValue:=TrimAndExpandFilename(ParsedValue,GetParsedLazarusDirectory); 3354 if (UnparsedValue='') and (not FileExistsCached(ParsedValue)) then 3355 begin 3356 // the default errore.msg file does not exist in the fpc sources 3357 // => use the fallback of the codetools 3358 ParsedValue:=AppendPathDelim(GetParsedLazarusDirectory) 3359 +GetForcedPathDelims('components/codetools/fpc.errore.msg'); 3360 end; 3361 end; 3362 eopFPDocPaths,eopDebuggerSearchPath: 3363 // search path 3364 ParsedValue:=TrimSearchPath(ParsedValue,GetParsedLazarusDirectory,true); 3365 eopCompilerFilename,eopMakeFilename,eopDebuggerFilename,eopFppkgConfigFile: 3366 // program 3367 begin 3368 ParsedValue:=Trim(ParsedValue); 3369 CurParams:=''; 3370 if (o in [eopDebuggerFilename]) then begin 3371 // program + params 3372 // examples: 3373 // gdb -v 3374 // "C:\public folder\gdb" 3375 SpacePos:=1; 3376 while (SpacePos<=length(ParsedValue)) do begin 3377 if ParsedValue[SpacePos]='"' then begin 3378 System.Delete(ParsedValue,1,1); // delete startng " 3379 while (SpacePos<=length(ParsedValue)) 3380 and (ParsedValue[SpacePos]<>'"') do 3381 inc(SpacePos); 3382 if SpacePos<=length(ParsedValue) then 3383 System.Delete(ParsedValue,1,1); // delete ending " 3384 end else if ParsedValue[SpacePos]=' ' then 3385 break 3386 else 3387 inc(SpacePos); 3388 end; 3389 CurParams:=copy(ParsedValue,SpacePos,length(ParsedValue)); 3390 system.Delete(ParsedValue,SpacePos,length(ParsedValue)); 3391 end; 3392 // program 3393 ParsedValue:=TrimFilename(ParsedValue); 3394 if (ParsedValue<>'') and (not FilenameIsAbsolute(ParsedValue)) then 3395 begin 3396 if (ExtractFilePath(ParsedValue)='') 3397 and (not FileExistsCached(GetParsedLazarusDirectory+ParsedValue)) then 3398 ParsedValue:=FindDefaultExecutablePath(ParsedValue) 3399 else 3400 ParsedValue:=TrimFilename(GetParsedLazarusDirectory+ParsedValue); 3401 end; 3402 // append parameters 3403 if CurParams<>'' then begin 3404 if System.Pos(' ',ParsedValue)>0 then 3405 ParsedValue:='"'+ParsedValue+'"'; 3406 ParsedValue+=CurParams; 3407 end; 3408 end; 3409 end; 3410 finally 3411 Parsing:=false; 3412 end; 3413 end; 3414 Result:=ParsedValue; 3415 end; 3416end; 3417 3418function TEnvironmentOptions.GetParsedCompilerFilename: string; 3419begin 3420 Result:=GetParsedValue(eopCompilerFilename); 3421end; 3422 3423procedure TEnvironmentOptions.InitMacros(AMacroList: TTransferMacroList); 3424begin 3425 AMacroList.Add(TTransferMacro.Create('FPCSrcDir','', 3426 lisFreePascalSourceDirectory,@MacroFuncFPCSrcDir,[])); 3427 AMacroList.Add(TTransferMacro.Create('LazarusDir','', 3428 lisLazarusDirectory,@MacroFuncLazarusDir,[])); 3429 AMacroList.Add(TTransferMacro.Create('ExeExt','', 3430 lisFileExtensionOfPrograms, @MacroFuncExeExt, [])); 3431 AMacroList.Add(TTransferMacro.Create('LanguageID','', 3432 lisLazarusLanguageID,@MacroFuncLanguageID,[])); 3433 AMacroList.Add(TTransferMacro.Create('LanguageName','', 3434 lisLazarusLanguageName,@MacroFuncLanguageName,[])); 3435 AMacroList.Add(TTransferMacro.Create('TestDir','', 3436 lisTestDirectory,@MacroFuncTestDir,[])); 3437 AMacroList.Add(TTransferMacro.Create('ConfDir','', 3438 lisConfigDirectory,@MacroFuncConfDir,[])); 3439 AMacroList.Add(TTransferMacro.Create('Home',GetUserDir, 3440 lisUserSHomeDirectory, nil, [])); 3441end; 3442 3443function TEnvironmentOptions.MacroFuncFPCSrcDir(const s: string; 3444 const Data: PtrInt; var Abort: boolean): string; 3445begin 3446 Result:=GetParsedFPCSourceDirectory; 3447end; 3448 3449function TEnvironmentOptions.MacroFuncLazarusDir(const s: string; 3450 const Data: PtrInt; var Abort: boolean): string; 3451begin 3452 Result:=GetParsedLazarusDirectory; 3453end; 3454 3455function TEnvironmentOptions.MacroFuncExeExt(const s: string; 3456 const Data: PtrInt; var Abort: boolean): string; 3457begin 3458 Result:=GetExecutableExt; 3459end; 3460 3461function TEnvironmentOptions.MacroFuncLanguageID(const s: string; 3462 const Data: PtrInt; var Abort: boolean): string; 3463begin 3464 Result:=LanguageID; 3465end; 3466 3467function TEnvironmentOptions.MacroFuncLanguageName(const s: string; 3468 const Data: PtrInt; var Abort: boolean): string; 3469begin 3470 Result:=GetLazarusLanguageLocalizedName(LanguageID); 3471end; 3472 3473function TEnvironmentOptions.MacroFuncTestDir(const s: string; 3474 const Data: PtrInt; var Abort: boolean): string; 3475begin 3476 Result:=GetParsedTestBuildDirectory; 3477end; 3478 3479function TEnvironmentOptions.MacroFuncConfDir(const s: string; 3480 const Data: PtrInt; var Abort: boolean): string; 3481begin 3482 Result:=GetPrimaryConfigPath; 3483end; 3484 3485procedure TEnvironmentOptions.SaveDebuggerPropertiesList; 3486var 3487 i, ConfCount: Integer; 3488 Entry: TDebuggerPropertiesConfig; 3489begin 3490 (* Delete old entries 3491 If an entry was loaded for a DebuggerClass that is currently unknown (package not compiled into IDE) 3492 then the entry did not load its properties. Therefore such entries "not Entry.IsLoaded" 3493 must not be deleted. 3494 Loop from the highest Index, so deleting an entry will not change the Xml-Index of 3495 the Indexes still to loop over. 3496 *) 3497 for i := FDebuggerProperties.Count - 1 downto 0 do begin 3498 // Delete last entry first 3499 Entry := FDebuggerProperties.Opt[i]; 3500 if not Entry.IsLoaded then 3501 Continue; 3502 3503 if (not Entry.IsFromOldXml) then 3504 Entry.DeleteFromXml(FXMLCfg, XML_PATH_DEBUGGER_CONF) // will be rewritten 3505 else 3506 if Entry.IsDeleted or 3507 (Entry.ConfigName <> '') or // Moved to named list 3508 (Entry.ConfigClass <> Entry.FConfigClassInOldXml) 3509 then 3510 Entry.DeleteFromOldXml(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD); 3511 3512 if Entry.IsDeleted then begin 3513 Entry.Free; 3514 FDebuggerProperties.Delete(i); 3515 end; 3516 end; 3517 3518 ConfCount := FXMLCfg.GetListItemCount('EnvironmentOptions/Debugger/Configs/', 'Config', False) + 1; 3519 for i := 0 to FDebuggerProperties.Count - 1 do begin 3520 Entry := FDebuggerProperties.Opt[i]; 3521 if not Entry.IsLoaded then 3522 Continue; 3523 3524 Entry.Active := Entry = FCurrentDebuggerPropertiesConfig; 3525 if(Entry.ConfigName <> '') then begin 3526 Entry.SaveToXml(FXMLCfg, XML_PATH_DEBUGGER_CONF, ConfCount); 3527 inc(ConfCount); 3528 end 3529 else begin 3530 Entry.SaveToOldXml(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD); 3531 // For compatibility 3532 if Entry.Active then 3533 FXMLCfg.SetDeleteValue('EnvironmentOptions/DebuggerFilename/Value', Entry.DebuggerFilename,''); 3534 end; 3535 end; 3536 3537 // compatibility 3538 if (FCurrentDebuggerPropertiesConfig <> nil) and (FCurrentDebuggerPropertiesConfig.ConfigName = '') then 3539 FXMLCfg.SetValue('EnvironmentOptions/Debugger/Class', FCurrentDebuggerPropertiesConfig.ConfigClass) 3540 else 3541 FXMLCfg.DeleteValue('EnvironmentOptions/Debugger/Class') 3542end; 3543 3544procedure TEnvironmentOptions.LoadDebuggerProperties; 3545var 3546 ConfCount, i: Integer; 3547 DbgClassType: TDebuggerClass; 3548 Entry, UnloadedCurrent: TDebuggerPropertiesConfig; 3549 ActiveClassName, CurFilename: String; 3550 ActiveClassSeen: Boolean; 3551begin 3552 if (FDebuggerProperties.Count > 0) and 3553 (TBaseDebugManagerIntf.DebuggerCount = FKnownDebuggerClassCount) 3554 then 3555 exit; 3556 FKnownDebuggerClassCount := TBaseDebugManagerIntf.DebuggerCount; 3557 HasActiveDebuggerEntry := False; 3558 3559 3560 FDebuggerProperties.ClearAll; 3561 FCurrentDebuggerPropertiesConfig := nil; 3562 UnloadedCurrent := nil; 3563 3564 // Load new style entries 3565 ConfCount := FXMLCfg.GetListItemCount('EnvironmentOptions/Debugger/Configs/', 'Config', False); 3566 for i := 1 to ConfCount do begin 3567 Entry := TDebuggerPropertiesConfig.CreateFromXmlConf(FXMLCfg, XML_PATH_DEBUGGER_CONF, i); 3568 FDebuggerProperties.AddObject(Entry.ConfigName, Entry); 3569 if Entry.Active then 3570 HasActiveDebuggerEntry := True; 3571 if Entry.Active and Entry.IsLoaded and (FCurrentDebuggerPropertiesConfig = nil) then 3572 FCurrentDebuggerPropertiesConfig := Entry; 3573 if Entry.Active and (UnloadedCurrent = nil) then 3574 UnloadedCurrent := Entry; 3575 end; 3576 3577 if FCurrentDebuggerPropertiesConfig = nil then 3578 FCurrentDebuggerPropertiesConfig := UnloadedCurrent; 3579 3580 // Read old style, per class 3581 ActiveClassName := ''; 3582 ActiveClassSeen := False; 3583 if FCurrentDebuggerPropertiesConfig = nil then 3584 ActiveClassName := FXMLCfg.GetValue('EnvironmentOptions/Debugger/Class', ''); 3585 HasActiveDebuggerEntry := HasActiveDebuggerEntry or (ActiveClassName <> ''); 3586 // There is only one filename for all classes 3587 CurFilename:=FXMLCfg.GetValue('EnvironmentOptions/DebuggerFilename/Value',''); 3588 3589 for i := 0 to TBaseDebugManagerIntf.DebuggerCount -1 do begin 3590 DbgClassType := TBaseDebugManagerIntf.Debuggers[i]; 3591 ActiveClassSeen := ActiveClassSeen or (CompareText(DbgClassType.ClassName, ActiveClassName)=0); 3592 Entry := TDebuggerPropertiesConfig.CreateFromOldXmlConf(FXMLCfg, XML_PATH_DEBUGGER_CONF_OLD, 3593 DbgClassType, CompareText(DbgClassType.ClassName, ActiveClassName)=0); 3594 if not Entry.IsLoaded then begin 3595 Entry.Free; 3596 Continue; 3597 end; 3598 if (Entry.DebuggerFilename = '') and (Entry.NeedsExePath or (not Entry.IsLoaded)) then 3599 Entry.DebuggerFilename := CurFilename; 3600 FDebuggerProperties.AddObject(Entry.ConfigName, Entry); 3601 if (Entry.ConfigClass = ActiveClassName) and (FCurrentDebuggerPropertiesConfig = nil) then 3602 FCurrentDebuggerPropertiesConfig := Entry; 3603 end; 3604end; 3605 3606function TEnvironmentOptions.CurrentDebuggerClass(TheProject: TLazProject): TDebuggerClass; 3607var 3608 Cfg: TDebuggerPropertiesConfig; 3609begin 3610 LoadDebuggerProperties; 3611 3612 Result := nil; 3613 Cfg := CurrentDebuggerPropertiesConfigEx(TheProject); 3614 if Cfg<> nil then 3615 Result := Cfg.DebuggerClass; 3616end; 3617 3618function TEnvironmentOptions.GetCurrentDebuggerPropertiesConfig: TDebuggerPropertiesConfig; 3619begin 3620 LoadDebuggerProperties; 3621 Result := FCurrentDebuggerPropertiesConfig; 3622end; 3623 3624procedure TEnvironmentOptions.SetCurrentDebuggerPropertiesOpt( 3625 AValue: TDebuggerPropertiesConfig); 3626begin 3627 LoadDebuggerProperties; 3628 3629 if FCurrentDebuggerPropertiesConfig = AValue then Exit; 3630 if (AValue <> nil) and (FDebuggerProperties.IndexOfObject(AValue) < 0) then 3631 FDebuggerProperties.AddObject(AValue.ConfigName, AValue); 3632 FCurrentDebuggerPropertiesConfig := AValue; 3633end; 3634 3635function TEnvironmentOptions.DebuggerPropertiesConfigList: TDebuggerPropertiesConfigList; 3636begin 3637 LoadDebuggerProperties; 3638 3639 Result := FDebuggerProperties; 3640end; 3641 3642function TEnvironmentOptions.CurrentDebuggerPropertiesConfigEx( 3643 TheProject: TLazProject): TDebuggerPropertiesConfig; 3644begin 3645 Result := nil; 3646 if (TheProject <> nil) and (TheProject.CurrentDebuggerBackend <> '') then 3647 Result := FDebuggerProperties.EntryByUid(TheProject.CurrentDebuggerBackend); 3648 3649 if Result = nil then 3650 Result := CurrentDebuggerPropertiesConfig; 3651end; 3652 3653function TEnvironmentOptions.FileHasChangedOnDisk: boolean; 3654begin 3655 Result:=FFileHasChangedOnDisk 3656 or ((FFilename<>'') and (FFileAge<>0) and (FileAgeCached(FFilename)<>FFileAge)); 3657 FFileHasChangedOnDisk:=Result; 3658end; 3659 3660procedure TEnvironmentOptions.InitXMLCfg(CleanConfig: boolean); 3661begin 3662 if FileHasChangedOnDisk or (FXMLCfg=nil) then begin 3663 FreeAndNil(FConfigStore); 3664 FreeAndNil(FDbgConfigStore); 3665 FreeAndNil(FXMLCfg); 3666 if CleanConfig then 3667 FXMLCfg:=TRttiXMLConfig.CreateClean(Filename) 3668 else 3669 FXMLCfg:=TRttiXMLConfig.Create(Filename); 3670 FConfigStore:=TXMLOptionsStorage.Create(FXMLCfg); 3671 //ComponentPaletteOptions.ConfigStore:=FConfigStore; 3672 ObjectInspectorOptions.ConfigStore:=FConfigStore; 3673 FDbgConfigStore:=TXMLOptionsStorage.Create(FXMLCfg, 'EnvironmentOptions/Debugger/'); 3674 FDebuggerConfig.ConfigStore := FDbgConfigStore; 3675 end; 3676end; 3677 3678procedure TEnvironmentOptions.FileUpdated; 3679begin 3680 FFileHasChangedOnDisk:=false; 3681 if FFilename<>'' then 3682 FFileAge:=FileAgeCached(FFilename) 3683 else 3684 FFileAge:=0; 3685end; 3686 3687function TEnvironmentOptions.GetActiveDesktop: TDesktopOpt; 3688 3689 procedure ChooseDefault; 3690 begin 3691 //use default desktop name 3692 if Assigned(IDEDockMaster) then 3693 FActiveDesktopName := 'default docked'//name for desktop with AnchorDocking 3694 else 3695 FActiveDesktopName := 'default'; 3696 end; 3697 3698var 3699 OldActiveDesktopName: string; 3700 OldActiveDesktop, lDskTpOpt: TCustomDesktopOpt; 3701begin 3702 Result := nil; 3703 if FActiveDesktopName <> '' then 3704 begin 3705 lDskTpOpt := FDesktops.Find(FActiveDesktopName); 3706 if Assigned(lDskTpOpt) and lDskTpOpt.InheritsFrom(TDesktopOpt) and lDskTpOpt.Compatible then 3707 Exit(TDesktopOpt(lDskTpOpt)); 3708 end; 3709 3710 //the selected desktop is unsupported (docked/undocked) 3711 // -> use default 3712 OldActiveDesktopName := FActiveDesktopName; 3713 ChooseDefault; 3714 lDskTpOpt := FDesktops.Find(FActiveDesktopName); 3715 if Assigned(lDskTpOpt) and lDskTpOpt.InheritsFrom(TDesktopOpt) then 3716 if lDskTpOpt.Compatible then 3717 Exit(TDesktopOpt(lDskTpOpt)) 3718 else 3719 Result := TDesktopOpt(lDskTpOpt); 3720 3721 //recreate desktop with ActiveDesktopName 3722 if Assigned(Result) then 3723 FDesktops.Remove(Result); 3724 3725 Result := TDesktopOpt.Create(FActiveDesktopName); 3726 FDesktops.Add(Result); 3727 Result.Assign(FDesktop); 3728 if Assigned(IDEDockMaster) then 3729 Result.FDockedOpt.LoadDefaults; 3730 OldActiveDesktop := FDesktops.Find(OldActiveDesktopName); 3731 if not (OldActiveDesktop is TDesktopOpt) then 3732 begin 3733 lDskTpOpt := FDesktops.Find('default'); 3734 if Assigned(lDskTpOpt) and lDskTpOpt.InheritsFrom(TDesktopOpt) and lDskTpOpt.Compatible then 3735 OldActiveDesktop := TDesktopOpt(lDskTpOpt) 3736 else 3737 OldActiveDesktop := nil; 3738 end; 3739 if Assigned(OldActiveDesktop) then 3740 Result.Assign(TDesktopOpt(OldActiveDesktop), False, False); 3741end; 3742 3743procedure TEnvironmentOptions.SetTestBuildDirectory(const AValue: string); 3744var 3745 NewValue: String; 3746begin 3747 NewValue:=AppendPathDelim(TrimFilename(AValue)); 3748 SetParseValue(eopTestBuildDirectory,NewValue); 3749end; 3750 3751procedure TEnvironmentOptions.UseDesktop(ADesktop: TDesktopOpt); 3752 function _ContainsControl(const _Parent, _Control: TWinControl): Boolean; 3753 var 3754 I: Integer; 3755 begin 3756 for I := 0 to _Parent.ControlCount-1 do 3757 if _Parent.Controls[I] is TWinControl then 3758 begin 3759 if (_Parent.Controls[I] = _Control) or 3760 _ContainsControl(TWinControl(_Parent.Controls[I]), _Control) 3761 then 3762 Exit(True); 3763 end; 3764 Result := False; 3765 end; 3766var 3767 xLastFocusControl: TWinControl; 3768 xLastFocusForm: TCustomForm; 3769begin 3770 xLastFocusControl := Screen.ActiveControl; 3771 xLastFocusForm := Screen.ActiveCustomForm; 3772 DoBeforeWrite(False); //this is needed to get the EditorToolBar refreshed!!! - needed only here in UseDesktop() 3773 FDesktop.Assign(ADesktop); 3774 ActiveDesktopName := ADesktop.Name; 3775 if ADesktop.AssociatedDebugDesktopName<>'' then 3776 DebugDesktopName := ADesktop.AssociatedDebugDesktopName; 3777 FDesktop.ExportSettingsToIDE(Self); 3778 DoAfterWrite(False); //this is needed to get the EditorToolBar refreshed!!! - needed only here in UseDesktop() 3779 FDesktop.RestoreDesktop; 3780 3781 //set focus back to the previously focused control 3782 if Screen.CustomFormIndex(xLastFocusForm) >= 0 then//check if form hasn't been destroyed 3783 begin 3784 if ((xLastFocusForm = xLastFocusControl) or _ContainsControl(xLastFocusForm, xLastFocusControl)) and//check if control hasn't been destroyed 3785 xLastFocusForm.CanFocus and 3786 xLastFocusControl.CanFocus 3787 then 3788 xLastFocusControl.SetFocus; 3789 end; 3790end; 3791 3792procedure TEnvironmentOptions.SetLazarusDirectory(const AValue: string); 3793var 3794 NewValue: String; 3795begin 3796 NewValue:=AppendPathDelim(TrimFilename(AValue)); 3797 SetParseValue(eopLazarusDirectory,NewValue); 3798end; 3799 3800procedure TEnvironmentOptions.SetMsgColors(u: TMessageLineUrgency; AValue: TColor); 3801begin 3802 fMsgColors[u] := AValue; 3803end; 3804 3805procedure TEnvironmentOptions.SetMsgViewColors(c: TMsgWndColor; AValue: TColor); 3806begin 3807 fMsgViewColors[c]:=AValue; 3808end; 3809 3810procedure TEnvironmentOptions.SetParseValue(o: TEnvOptParseType; 3811 const NewValue: string); 3812begin 3813 with FParseValues[o] do begin 3814 if UnparsedValue=NewValue then exit; 3815 UnparsedValue:=NewValue; 3816 ParseStamp:=CTInvalidChangeStamp; 3817 IncreaseCompilerParseStamp; 3818 end; 3819end; 3820 3821procedure TEnvironmentOptions.SetFPCSourceDirectory(const AValue: string); 3822begin 3823 SetParseValue(eopFPCSourceDirectory,AValue); 3824end; 3825 3826procedure TEnvironmentOptions.SetCompilerFilename(const AValue: string); 3827begin 3828 SetParseValue(eopCompilerFilename,TrimFilename(AValue)); 3829end; 3830 3831procedure TEnvironmentOptions.SetCompilerMessagesFilename(AValue: string); 3832begin 3833 SetParseValue(eopCompilerMessagesFilename,TrimFilename(AValue)); 3834end; 3835 3836function TEnvironmentOptions.GetDebuggerEventLogColors(AIndex: TDBGEventType): TDebuggerEventLogColor; 3837begin 3838 Result := FDebuggerEventLogColors[AIndex]; 3839end; 3840 3841function TEnvironmentOptions.DebuggerFilename(TheProject: TLazProject): string; 3842begin 3843 Result := ''; 3844 LoadDebuggerProperties; 3845 if CurrentDebuggerPropertiesConfigEx(TheProject) <> nil then 3846 Result:=CurrentDebuggerPropertiesConfigEx(TheProject).DebuggerFilename; 3847end; 3848 3849function TEnvironmentOptions.GetDebuggerSearchPath: string; 3850begin 3851 Result:=FParseValues[eopDebuggerSearchPath].UnparsedValue; 3852end; 3853 3854function TEnvironmentOptions.GetCompilerFilename: string; 3855begin 3856 Result:=FParseValues[eopCompilerFilename].UnparsedValue; 3857end; 3858 3859function TEnvironmentOptions.GetCompilerMessagesFilename: string; 3860begin 3861 Result:=FParseValues[eopCompilerMessagesFilename].UnparsedValue; 3862end; 3863 3864function TEnvironmentOptions.GetDebugDesktop: TDesktopOpt; 3865var 3866 lDskTpOpt: TCustomDesktopOpt; 3867begin 3868 Result := nil; 3869 if FDebugDesktopName <> '' then 3870 begin 3871 lDskTpOpt := FDesktops.Find(FDebugDesktopName); 3872 if Assigned(lDskTpOpt) and lDskTpOpt.InheritsFrom(TDesktopOpt) and lDskTpOpt.Compatible then //do not mix docked/undocked desktops 3873 Result := TDesktopOpt(lDskTpOpt); 3874 end; 3875 3876end; 3877 3878function TEnvironmentOptions.GetFPCSourceDirectory: string; 3879begin 3880 Result:=FParseValues[eopFPCSourceDirectory].UnparsedValue; 3881end; 3882 3883function TEnvironmentOptions.GetFPDocPaths: string; 3884begin 3885 Result:=FParseValues[eopFPDocPaths].UnparsedValue; 3886end; 3887 3888function TEnvironmentOptions.GetLazarusDirectory: string; 3889begin 3890 Result:=FParseValues[eopLazarusDirectory].UnparsedValue; 3891end; 3892 3893function TEnvironmentOptions.GetFppkgConfigFile: string; 3894begin 3895 Result:=FParseValues[eopFppkgConfigFile].UnparsedValue; 3896end; 3897 3898function TEnvironmentOptions.GetMakeFilename: string; 3899begin 3900 Result:=FParseValues[eopMakeFilename].UnparsedValue; 3901end; 3902 3903function TEnvironmentOptions.GetMsgColors(u: TMessageLineUrgency): TColor; 3904begin 3905 Result:=fMsgColors[u]; 3906end; 3907 3908function TEnvironmentOptions.GetMsgViewColors(c: TMsgWndColor): TColor; 3909begin 3910 Result:=fMsgViewColors[c]; 3911end; 3912 3913function TEnvironmentOptions.GetNamedDebuggerFileHistory(AnIndex: String 3914 ): TStringList; 3915var 3916 i: Integer; 3917begin 3918 i := FDebuggerFileHistory.IndexOf(AnIndex); 3919 if i < 0 then begin 3920 i := FDebuggerFileHistory.AddObject(AnIndex, TStringList.Create); 3921 if FXMLCfg.HasPath('EnvironmentOptions/DebuggerFilename/'+AnIndex+'/History', False) then 3922 LoadRecentList(FXMLCfg,TStrings(FDebuggerFileHistory.Objects[i]),'EnvironmentOptions/DebuggerFilename/'+AnIndex+'/History/',rltFile) 3923 else 3924 TStrings(FDebuggerFileHistory.Objects[i]).Assign(DebuggerFileHistory['']); // init from old list 3925 end; 3926 Result := TStringList(FDebuggerFileHistory.Objects[i]); 3927end; 3928 3929function TEnvironmentOptions.GetSubConfig(Index: Integer): TIDESubOptions; 3930begin 3931 Result := TIDESubOptions(fRegisteredSubConfig[Index]); 3932end; 3933 3934function TEnvironmentOptions.GetTestBuildDirectory: string; 3935begin 3936 Result:=FParseValues[eopTestBuildDirectory].UnparsedValue; 3937end; 3938 3939procedure TEnvironmentOptions.SetDebuggerEventLogColors(AIndex: TDBGEventType; const AValue: TDebuggerEventLogColor); 3940begin 3941 FDebuggerEventLogColors[AIndex] := AValue; 3942end; 3943 3944procedure TEnvironmentOptions.SetDebuggerSearchPath(const AValue: string); 3945begin 3946 SetParseValue(eopDebuggerSearchPath,TrimSearchPath(AValue,'')); 3947end; 3948 3949procedure TEnvironmentOptions.SetFPDocPaths(const AValue: string); 3950begin 3951 SetParseValue(eopFPDocPaths,TrimSearchPath(AValue,'')); 3952end; 3953 3954procedure TEnvironmentOptions.SetMakeFilename(const AValue: string); 3955begin 3956 SetParseValue(eopMakeFilename,TrimFilename(AValue)); 3957end; 3958 3959procedure TEnvironmentOptions.SetFppkgConfigFile(AValue: string); 3960begin 3961 SetParseValue(eopFppkgConfigFile,UTF8Trim(AValue)); 3962end; 3963 3964initialization 3965 RegisterIDEOptionsGroup(GroupEnvironment, TEnvironmentOptions); 3966end. 3967 3968