{ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** Author: Mattias Gaertner Abstract: This unit defines a class to store the options in a xml file. } unit EnvironmentOpts; {$mode objfpc}{$H+} interface uses {$IFDEF IDE_MEM_CHECK} MemCheck, {$ENDIF} {$ifdef Windows} ShlObj, {$endif} Classes, SysUtils, TypInfo, contnrs, math, // LCL Graphics, Controls, Forms, Dialogs, LCLProc, // LazUtils LazFileUtils, FileUtil, LazFileCache, LazConfigStorage, LazUTF8, LazStringUtils, Laz2_XMLCfg, Laz2_DOM, // CodeTools FileProcs, SourceChanger, CodeCompletionTool, // IDEIntf ProjectIntf, ObjectInspector, IDEWindowIntf, IDEOptionsIntf, IDEOptEditorIntf, ComponentReg, IDEExternToolIntf, MacroDefIntf, SrcEditorIntf, // DebuggerIntf DbgIntfDebuggerBase, // IDE IDEProcs, DialogProcs, LazarusIDEStrConsts, IDETranslations, LazConf, IDEOptionDefs, TransferMacros, ModeMatrixOpts, Debugger, IdeCoolbarData, EditorToolbarStatic; const EnvOptsVersion: integer = 110; // 107 added Lazarus version // 108 added LastCalledByLazarusFullPath // 109 changed paths for desktop settings, supporting multiple desktops. // 110 changed BackupType to string instead of integer {$IFDEF Windows} DefaultMakefilename = '$Path($(CompPath))make.exe'; {$ELSE} {$IFDEF FreeBSD} DefaultMakefilename = 'gmake'; {$ELSE} DefaultMakefilename = 'make'; {$ENDIF} {$ENDIF} RestoreProjectClosed = '-'; DefaultMaxRecentOpenFiles = 10; DefaultMaxRecentProjectFiles = 5; DefaultMaxRecentPackageFiles = 10; DefaultAutoSaveIntervalInSecs = 300; DefaultRubberbandSelectsGrandChilds = false; DefaultGridColor = clBlack; DefaultGridSize = 8; DefaultGuideLineColorLeftTop = clBlue; DefaultGuideLineColorRightBottom = clGreen; //---------------------------------------------------------------------------- { Backup } type TBackupType = ( bakNone, // no backup files bakSymbolInFront, // .~pp bakSymbolBehind, // .pp~ bakCounter, // .pp;1 bakUserDefinedAddExt,// .pp.xxx bakSameName // .pp only available if backuping into subdirectory ); TBackupInfo = record BackupType: TBackupType; AdditionalExtension:string; // for bakUserDefinedAddExt MaxCounter: integer; // for bakCounter SubDirectory: string; end; const // Important: When changing any of these values increase EnvOptsVersion // and add code to read old options DefaultBackupTypeProject = bakSameName; DefaultBackupTypeOther = bakUserDefinedAddExt; DefaultBackupAddExt = 'bak'; DefaultBackupMaxCounter = 9; DefaultBackupSubDirectory = 'backup'; { Debugging } type TDebuggerEventLogColor = record Foreground: TColor; Background: TColor; end; const DebuggerDefaultColors: array[TDBGEventType] of TDebuggerEventLogColor = ( { etDefault } (Foreground: clWindowText; Background: clWindow), { etBreakpointEvaluation } (Foreground: $8080FF; Background: clWindow), { etBreakpointHit } (Foreground: clRed; Background: clWindow), { etBreakpointMessage } (Foreground: $0000D9; Background: clWindow), { etBreakpointStackDump } (Foreground: $2080FF; Background: clWindow), { etExceptionRaised } (Foreground: clTeal; Background: clWindow), { etModuleLoad } (Foreground: clBlue; Background: clWindow), { etModuleUnload } (Foreground: clBlue; Background: clWindow), { etOutputDebugString } (Foreground: clNavy; Background: clWindow), { etProcessExit } (Foreground: clGray; Background: clWindow), { etProcessStart } (Foreground: clGray; Background: clWindow), { etThreadExit } (Foreground: clMaroon; Background: clWindow), { etThreadStart } (Foreground: clMaroon; Background: clWindow), { etWindowsMessagePosted } (Foreground: clWhite; Background: clGray), { etWindowsMessageSent } (Foreground: clSkyBlue; Background: clWindow) ); { Naming } type TPascalExtType = (petNone, petPAS, petPP, petP); const PascalExtension: array[TPascalExtType] of string = ('', '.pas', '.pp', '.p'); { Ambiguous files } type TAmbiguousFileAction = ( afaAsk, afaAutoDelete, afaAutoRename, afaWarnOnCompile, afaIgnore ); TAmbiguousFileActions = set of TAmbiguousFileAction; const AmbiguousFileActionNames: array[TAmbiguousFileAction] of string = ( 'Ask', 'AutoDelete', 'AutoRename', 'WarnOnCompile', 'Ignore' ); type TCharCaseFileAction = ( ccfaAsk, ccfaAutoRename, ccfaIgnore ); TCharCaseFileActions = set of TCharCaseFileAction; const CharCaseFileActionNames: array[TCharCaseFileAction] of string = ( 'Ask', 'AutoRename', 'Ignore' ); type TUnitRenameReferencesAction = ( urraAlways, // update references in other files urraAsk, // scan, then ask, then update urraNever // don't scan, don't ask, don't update ); TUnitRenameReferencesActions = set of TUnitRenameReferencesAction; const UnitRenameReferencesActionNames: array[TUnitRenameReferencesAction] of string = ( 'Always', 'Ask', 'Never' ); type TIDEMultipleInstancesOption = ( mioAlwaysStartNew, mioOpenFilesInRunning, mioForceSingleInstance ); const IDEMultipleInstancesOptionNames: array[TIDEMultipleInstancesOption] of string = ( 'AlwaysStartNew', // mioAlwaysStartNew 'OpenFilesInRunning', // mioOpenFilesInRunning 'ForceSingleInstance' // mioForceSingleInstance ); DefaultIDEMultipleInstancesOption = mioOpenFilesInRunning; { Messages window } type TMsgWndFileNameStyle = ( mwfsShort, // = ExtractFilename mwfsRelative, // = CreateRelativePath mwfsFull ); TMsgWndFileNameStyles = set of TMsgWndFileNameStyle; const MsgWndFileNameStyleNames: array[TMsgWndFileNameStyle] of string = ( 'Short', // mwfsShort 'Relative', // mwfsRelative 'Full' // mwfsFull ); type TMsgWndColor = ( mwBackground, mwRunning, mwSuccess, mwFailed, mwAutoHeader, mwTextColor ); const MsgWndDefBackgroundColor = clWindow; MsgWndDefHeaderBackgroundRunning = clYellow; MsgWndDefHeaderBackgroundSuccess = TColor($60FF60); // light green MsgWndDefHeaderBackgroundFailed = TColor($6060FF); // light red MsgWndDefAutoHeaderBackground = clSkyBlue; MsgWndDefTextColor = clDefault; MsgWndDefaultColors: array[TMsgWndColor] of TColor = ( MsgWndDefBackgroundColor, // mwBackground MsgWndDefHeaderBackgroundRunning, // mwRunning MsgWndDefHeaderBackgroundSuccess, // mwSuccess MsgWndDefHeaderBackgroundFailed, // mwFailed MsgWndDefAutoHeaderBackground, // mwAutoHeader MsgWndDefTextColor ); MsgWndColorNames: array[TMsgWndColor] of string = ( 'Background', 'Running', 'Success', 'Failed', 'AutoHeader', 'TextColor' ); { External Tools - the user menu items in the Tools menu } type TBaseExternalUserTools = class public constructor Create; virtual; abstract; function Load(Config: TConfigStorage; const Path: string): TModalResult; virtual; abstract; function Save(Config: TConfigStorage; const Path: string): TModalResult; virtual; abstract; end; TExternalUserToolsClass = class of TBaseExternalUserTools; var ExternalUserToolsClass: TExternalUserToolsClass; // set by ExtToolEditDlg to TExternalUserTools type TEnvOptParseType = ( eopLazarusDirectory, eopCompilerFilename, eopFPCSourceDirectory, eopTestBuildDirectory, eopMakeFilename, eopFPDocPaths, eopCompilerMessagesFilename, eopDebuggerFilename, eopDebuggerSearchPath ); TEnvOptParseTypes = set of TEnvOptParseType; type TEnvironmentOptions = class; TLastOpenPackagesList = class(TStringList) public function Remove(const aString: string): Boolean; constructor Create; end; TUseUnitDlgOptions = record AllUnits: Boolean; AddToImplementation: Boolean; end; { TCustomDesktopOpt } TCustomDesktopOpt = class protected FName:string; FAssociatedDebugDesktopName: String; FConfigStore: TXMLOptionsStorage; FIsDocked: Boolean; FXMLCfg: TRttiXMLConfig; function GetCompatible: Boolean; virtual; public constructor Create(const aName: String); virtual; overload; constructor Create(const aName: String; const aIsDocked: Boolean); virtual; overload; destructor Destroy; override; procedure SetConfig(aXMLCfg: TRttiXMLConfig; aConfigStore: TXMLOptionsStorage); procedure Load(Path: String); virtual; procedure Save(Path: String); virtual; abstract; property Name: String read FName write FName; property AssociatedDebugDesktopName: String read FAssociatedDebugDesktopName write FAssociatedDebugDesktopName; property IsDocked: Boolean read FIsDocked; property Compatible: Boolean read GetCompatible; end; TDesktopOptClass = class of TCustomDesktopOpt; TDesktopOIOptions = class(TPersistent) private FComponentTreeHeight: integer; FInfoBoxHeight: integer; FShowComponentTree: Boolean; FShowInfoBox: boolean; FSplitterX: array[TObjectInspectorPage] of Integer; function GetSplitterX(const APage: TObjectInspectorPage): Integer; procedure SetSplitterX(const APage: TObjectInspectorPage; const ASplitterX: Integer); protected procedure AssignTo(Dest: TPersistent); override; public constructor Create; procedure ImportSettingsFromIDE(const AOptions: TEnvironmentOptions); procedure ExportSettingsToIDE(const AOptions: TEnvironmentOptions); procedure Load(XMLConfig: TXMLConfig; Path: String); procedure Save(XMLConfig: TXMLConfig; Path: String); property ShowComponentTree: Boolean read FShowComponentTree write FShowComponentTree; property ComponentTreeHeight: integer read FComponentTreeHeight write FComponentTreeHeight; property SplitterX[const APage: TObjectInspectorPage]: Integer read GetSplitterX write SetSplitterX; property ShowInfoBox: boolean read FShowInfoBox write FShowInfoBox; property InfoBoxHeight: integer read FInfoBoxHeight write FInfoBoxHeight; end; { TDesktopOpt } TDesktopOpt = class(TCustomDesktopOpt) private // window layout FIDEWindowCreatorsLayoutList: TSimpleWindowLayoutList; FIDEDialogLayoutList: TIDEDialogLayoutList; FObjectInspectorOptions: TDesktopOIOptions; FSingleTaskBarButton: boolean; FHideIDEOnRun: boolean; FAutoAdjustIDEHeight: boolean; FAutoAdjustIDEHeightFullCompPal: boolean; // window menu FIDENameForDesignedFormList: boolean; // CompletionWindow FCompletionWindowWidth: Integer; FCompletionWindowHeight: Integer; // title FIDETitleStartsWithProject: boolean; FIDETitleIncludesBuildMode: boolean; FIDEProjectDirectoryInIdeTitle: boolean; // IDE Coolbar FIDECoolBarOptions: TIDECoolBarOptions; // Editor Toolbar FEditorToolBarOptions: TEditorToolBarOptions; // component palette FComponentPaletteOptions: TCompPaletteOptions; //Docking options FDockedOpt: TAbstractDesktopDockingOpt; procedure InitLayoutList; protected function GetCompatible: Boolean; override; public constructor Create(const aName: String; const aIsDocked: Boolean); override; overload; destructor Destroy; override; procedure Assign(Source: TDesktopOpt; const AssignName: Boolean = False; const IsCompatible: Boolean = True); public procedure Load(Path: String); override; procedure Save(Path: String); override; procedure ImportSettingsFromIDE(const AOptions: TEnvironmentOptions); procedure ExportSettingsToIDE(const AOptions: TEnvironmentOptions); procedure RestoreDesktop; property IDEWindowCreatorsLayoutList: TSimpleWindowLayoutList read FIDEWindowCreatorsLayoutList write FIDEWindowCreatorsLayoutList; property IDEDialogLayoutList: TIDEDialogLayoutList read FIDEDialogLayoutList; property SingleTaskBarButton: boolean read FSingleTaskBarButton write FSingleTaskBarButton; property HideIDEOnRun: boolean read FHideIDEOnRun write FHideIDEOnRun; property AutoAdjustIDEHeight: Boolean read FAutoAdjustIDEHeight write FAutoAdjustIDEHeight; property AutoAdjustIDEHeightFullCompPal: Boolean read FAutoAdjustIDEHeightFullCompPal write FAutoAdjustIDEHeightFullCompPal; property IDENameForDesignedFormList: boolean read FIDENameForDesignedFormList write FIDENameForDesignedFormList; property CompletionWindowWidth: Integer read FCompletionWindowWidth write FCompletionWindowWidth; property CompletionWindowHeight: Integer read FCompletionWindowHeight write FCompletionWindowHeight; property IDETitleStartsWithProject: boolean read FIDETitleStartsWithProject write FIDETitleStartsWithProject; property IDETitleIncludesBuildMode: boolean read FIDETitleIncludesBuildMode write FIDETitleIncludesBuildMode; property IDEProjectDirectoryInIdeTitle: boolean read FIDEProjectDirectoryInIdeTitle write FIDEProjectDirectoryInIdeTitle; property IDECoolBarOptions: TIDECoolBarOptions read FIDECoolBarOptions; property EditorToolBarOptions: TEditorToolBarOptions read FEditorToolBarOptions; property ComponentPaletteOptions: TCompPaletteOptions read FComponentPaletteOptions; property ObjectInspectorOptions: TDesktopOIOptions read FObjectInspectorOptions; end; { TUnsupportedDesktopOpt } TUnsupportedDesktopOpt = Class(TCustomDesktopOpt) private FRetainXMLData:TDOMDocument; public destructor Destroy; override; procedure Load(Path: String); override; procedure Save(Path: String); override; end; { TDesktopOptList } TDesktopOptList = class(TObjectList) private FXMLCfg: TRttiXMLConfig; FConfigStore: TXMLOptionsStorage; FEnvOpts: TEnvironmentOptions; function GetItem(Index: Integer): TCustomDesktopOpt; procedure SetConfig(aXMLCfg: TRttiXMLConfig; aConfigStore: TXMLOptionsStorage); public constructor Create(aEnvOpts: TEnvironmentOptions); destructor Destroy; override; procedure AddFromCfg(Path: String); function IndexOf(aName: string): integer; function Find(aName: string): TCustomDesktopOpt; property Items[Index: Integer]: TCustomDesktopOpt read GetItem; default; end; { TEnvironmentOptions - class for storing environment options } TEnvironmentOptions = class(TIDEEnvironmentOptions) private FDebuggerAutoCloseAsm: boolean; // config file FFilename: string; FFileAge: longint; FFileVersion: integer; FFileHasChangedOnDisk: boolean; FMaxExtToolsInParallel: integer; FOldLazarusVersion: string; FXMLCfg: TRttiXMLConfig; FConfigStore: TXMLOptionsStorage; FDbgConfigStore: TXMLOptionsStorage; // for debugger // main buttons FShowButtonGlyphs: TApplicationShowGlyphs; FShowMenuGlyphs: TApplicationShowGlyphs; // auto save FAutoSaveEditorFiles: boolean; FAutoSaveProject: boolean; FAutoSaveIntervalInSecs: integer; FLastSavedProjectFile: string; FLastOpenPackages: TLastOpenPackagesList;//list of filenames with open packages // designer FCreateComponentFocusNameProperty: boolean; FSwitchToFavoritesOITab: boolean; FDesignerPaintLazy: boolean; FShowBorderSpacing: boolean; FShowGrid: boolean; FSnapToGrid: boolean; FGridSizeX: integer; FGridSizeY: integer; FGridColor: TColor; FShowGuideLines: boolean; FSnapToGuideLines: boolean; FGuideLineColorLeftTop: TColor; FGuideLineColorRightBottom: TColor; FShowComponentCaptions: boolean; FShowEditorHints: boolean; FAutoCreateFormsOnOpen: boolean; FRightClickSelects: boolean; FGrabberColor: TColor; FMarkerColor: TColor; FRubberbandSelectionColor: TColor; FRubberbandCreationColor: TColor; FRubberbandSelectsGrandChilds: boolean; FCheckPackagesOnFormCreate: boolean; FFormTitleBarChangesObjectInspector: boolean; FForceDPIScalingInDesignTime: boolean; // object inspector FObjectInspectorOptions: TOIOptions; // project inspector FProjInspSortAlphabetically: boolean; FProjInspShowDirHierarchy: boolean; // package editor FPackageEditorSortAlphabetically: boolean; FPackageEditorShowDirHierarchy: boolean; // procedure list FProcedureListFilterStart: boolean; // hints FAskSaveSessionOnly: boolean; FCheckDiskChangesWithLoading: boolean; FDiskChangesAutoCheckModified: boolean; FShowHintsForComponentPalette: boolean; FShowHintsForMainSpeedButtons: boolean; // messages fMsgViewDblClickJumps: boolean; fMsgViewFocus: boolean; FShowMessagesIcons: boolean; FMsgViewStayOnTop: boolean; FMsgViewShowTranslations: boolean; FMsgViewAlwaysDrawFocused: boolean; FMsgViewFilenameStyle: TMsgWndFileNameStyle; fMsgViewColors: array[TMsgWndColor] of TColor; fMsgColors: array[TMessageLineUrgency] of TColor; FShowCompileDialog: Boolean; // show dialog during compile FAutoCloseCompileDialog: Boolean; // auto close dialog after succesed compile FMsgViewFilters: TLMsgViewFilters; FMsgViewShowFPCMsgLinesCompiled: Boolean; // compiler + debugger + lazarus files FParseValues: array[TEnvOptParseType] of TParseString; FLazarusDirHistory: TStringList; FCompilerFileHistory: TStringList; FFPCSourceDirHistory: TStringList; FMakeFileHistory: TStringList; FTestBuildDirHistory: TStringList; FCompilerMessagesFileHistory: TStringList; FManyBuildModesSelection: TStringList; FBuildMatrixOptions: TBuildMatrixOptions; FIsGlobalMode: TStrToBoolEvent; // Clean build project dialog FCleanBuildProjOut: Boolean; FCleanBuildProjSrc: Boolean; FCleanBuildPkgOut: Boolean; FCleanBuildPkgSrc: Boolean; // Primary-config verification FLastCalledByLazarusFullPath: String; // TODO: store per debuggerclass options // Maybe these should go to a new TDebuggerOptions class FDebuggerResetAfterRun: boolean; FDebuggerConfig: TDebuggerConfigStore; FDebuggerFileHistory: TStringList; // per debugger class FDebuggerProperties: TStringList; // per debugger class FDebuggerShowStopMessage: Boolean; FDebuggerEventLogClearOnRun: Boolean; FDebuggerEventLogCheckLineLimit: Boolean; FDebuggerEventLogLineLimit: Integer; FDebuggerEventLogShowBreakpoint: Boolean; FDebuggerEventLogShowDebugger: Boolean; FDebuggerEventLogShowModule: Boolean; FDebuggerEventLogShowOutput: Boolean; FDebuggerEventLogShowProcess: Boolean; FDebuggerEventLogShowThread: Boolean; FDebuggerEventLogShowWindows: Boolean; FDebuggerEventLogUseColors: Boolean; FDebuggerEventLogColors: array[TDBGEventType] of TDebuggerEventLogColor; // recent files and directories FRecentOpenFiles: TStringList; FMaxRecentOpenFiles: integer; FRecentProjectFiles: TStringList; FMaxRecentProjectFiles: integer; FRecentPackageFiles: TStringList; FMaxRecentPackageFiles: integer; FOpenLastProjectAtStart: boolean; FMultipleInstances: TIDEMultipleInstancesOption; // Prevent repopulating Recent project files menu with example projects if it was already cleared up. FAlreadyPopulatedRecentFiles : Boolean; //other recent settings FLastEventMethodCCResult: TCodeCreationDlgResult; FLastVariableCCResult: TCodeCreationDlgResult; FUseUnitDlgOptions: TUseUnitDlgOptions; // backup FBackupInfoProjectFiles: TBackupInfo; FBackupInfoOtherFiles: TBackupInfo; // external tools fExternalUserTools: TBaseExternalUserTools; // see ExtToolEditDlg.TExternalUserTools // naming conventions fPascalFileExtension: TPascalExtType; fCharcaseFileAction: TCharCaseFileAction; fAmbiguousFileAction: TAmbiguousFileAction; FUnitRenameReferencesAction: TUnitRenameReferencesAction; FAskForFilenameOnNewFile: boolean; FLowercaseDefaultFilename: boolean; // language ID (see LazarusTranslations in translations.pas) fLanguageID: string; // 'new items' FNewFormTemplate: string; FNewUnitTemplate: string; FFileDialogFilter: string; //component list FComponentListKeepOpen: Boolean; // Desktop FDesktops: TDesktopOptList; FDesktop: TDesktopOpt; FLastDesktopBeforeDebug: TDesktopOpt; FActiveDesktopName: string; FAutoSaveActiveDesktop: Boolean; FDebugDesktopName: string; function GetActiveDesktop: TDesktopOpt; function GetCompilerFilename: string; function GetCompilerMessagesFilename: string; function GetDebugDesktop: TDesktopOpt; function GetDebuggerEventLogColors(AIndex: TDBGEventType): TDebuggerEventLogColor; function GetDebuggerFilename: string; function GetDebuggerSearchPath: string; function GetFPCSourceDirectory: string; function GetFPDocPaths: string; function GetLazarusDirectory: string; function GetMakeFilename: string; function GetMsgColors(u: TMessageLineUrgency): TColor; function GetMsgViewColors(c: TMsgWndColor): TColor; function GetTestBuildDirectory: string; procedure LoadNonDesktop(Path: String); procedure SaveNonDesktop(Path: String); procedure SetCompilerFilename(const AValue: string); procedure SetCompilerMessagesFilename(AValue: string); procedure SetDebuggerEventLogColors(AIndex: TDBGEventType; const AValue: TDebuggerEventLogColor); procedure SetDebuggerSearchPath(const AValue: string); procedure SetFPDocPaths(const AValue: string); procedure SetMakeFilename(const AValue: string); procedure SetDebuggerFilename(AValue: string); procedure SetFPCSourceDirectory(const AValue: string); procedure SetLazarusDirectory(const AValue: string); procedure SetMsgColors(u: TMessageLineUrgency; AValue: TColor); procedure SetMsgViewColors(c: TMsgWndColor; AValue: TColor); procedure SetParseValue(o: TEnvOptParseType; const NewValue: string); procedure SetFileName(const NewFilename: string); function FileHasChangedOnDisk: boolean; procedure InitXMLCfg(CleanConfig: boolean); procedure FileUpdated; procedure SetTestBuildDirectory(const AValue: string); public class function GetGroupCaption:string; override; class function GetInstance: TAbstractIDEOptions; override; procedure DoAfterWrite(Restore: boolean); override; public constructor Create; destructor Destroy; override; procedure Load(OnlyDesktop: boolean); procedure Save(OnlyDesktop: boolean); property IsGlobalMode: TStrToBoolEvent read FIsGlobalMode write FIsGlobalMode; property Filename: string read FFilename write SetFilename; function GetDefaultConfigFilename: string; procedure CreateConfig; property OldLazarusVersion: string read FOldLazarusVersion; function GetParsedLazarusDirectory: string; function GetParsedTestBuildDirectory: string; function GetParsedCompilerFilename: string; function GetParsedFPCSourceDirectory(FPCVer: string = ''): string; function GetParsedMakeFilename: string; function GetParsedCompilerMessagesFilename: string; function GetParsedFPDocPaths: string; function GetParsedDebuggerFilename: string; function GetParsedDebuggerSearchPath: string; function GetParsedValue(o: TEnvOptParseType): string; // macros procedure InitMacros(AMacroList: TTransferMacroList); function MacroFuncFPCSrcDir(const {%H-}s:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFuncLazarusDir(const {%H-}s:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFuncExeExt(const {%H-}s:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFuncLanguageID(const {%H-}s:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFuncLanguageName(const {%H-}s:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFuncTestDir(const {%H-}s:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; function MacroFuncConfDir(const {%H-}s:string; const {%H-}Data: PtrInt; var {%H-}Abort: boolean): string; procedure UseDesktop(ADesktop: TDesktopOpt); procedure EnableDebugDesktop; procedure DisableDebugDesktop; class function DesktopCanBeLoaded(const aDockMaster: string): Boolean; // auto save // ask even if only project session needs saving property AskSaveSessionOnly: boolean read FAskSaveSessionOnly write FAskSaveSessionOnly; property AutoSaveEditorFiles: boolean read FAutoSaveEditorFiles write FAutoSaveEditorFiles; property AutoSaveProject: boolean read FAutoSaveProject write FAutoSaveProject; property AutoSaveIntervalInSecs: integer read FAutoSaveIntervalInSecs write FAutoSaveIntervalInSecs; // form editor property ShowBorderSpacing: boolean read FShowBorderSpacing write FShowBorderSpacing; property ShowGrid: boolean read FShowGrid write FShowGrid; property SnapToGrid: boolean read FSnapToGrid write FSnapToGrid; property GridColor: TColor read FGridColor write FGridColor; property GridSizeX: integer read FGridSizeX write FGridSizeX; property GridSizeY: integer read FGridSizeY write FGridSizeY; property ShowGuideLines: boolean read FShowGuideLines write FShowGuideLines; property SnapToGuideLines: boolean read FSnapToGuideLines write FSnapToGuideLines; property GuideLineColorLeftTop: TColor read FGuideLineColorLeftTop write FGuideLineColorLeftTop; property GuideLineColorRightBottom: TColor read FGuideLineColorRightBottom write FGuideLineColorRightBottom; property ShowComponentCaptions: boolean read FShowComponentCaptions write FShowComponentCaptions; property ShowEditorHints: boolean read FShowEditorHints write FShowEditorHints; property AutoCreateFormsOnOpen: boolean read FAutoCreateFormsOnOpen write FAutoCreateFormsOnOpen; property CheckPackagesOnFormCreate: boolean read FCheckPackagesOnFormCreate write FCheckPackagesOnFormCreate; property RightClickSelects: boolean read FRightClickSelects write FRightClickSelects; property GrabberColor: TColor read FGrabberColor write FGrabberColor; property MarkerColor: TColor read FMarkerColor write FMarkerColor; property RubberbandSelectionColor: TColor read FRubberbandSelectionColor write FRubberbandSelectionColor; property RubberbandCreationColor: TColor read FRubberbandCreationColor write FRubberbandCreationColor; property RubberbandSelectsGrandChilds: boolean read FRubberbandSelectsGrandChilds write FRubberbandSelectsGrandChilds; property DesignerPaintLazy: boolean read FDesignerPaintLazy write FDesignerPaintLazy; property CreateComponentFocusNameProperty: boolean read FCreateComponentFocusNameProperty write FCreateComponentFocusNameProperty; property SwitchToFavoritesOITab: boolean read FSwitchToFavoritesOITab write FSwitchToFavoritesOITab; property FormTitleBarChangesObjectInspector: boolean read FFormTitleBarChangesObjectInspector write FFormTitleBarChangesObjectInspector; property ForceDPIScalingInDesignTime: boolean read FForceDPIScalingInDesignTime write FForceDPIScalingInDesignTime; // object inspector property ObjectInspectorOptions: TOIOptions read FObjectInspectorOptions; // project inspector property ProjInspSortAlphabetically: boolean read FProjInspSortAlphabetically write FProjInspSortAlphabetically; property ProjInspShowDirHierarchy: boolean read FProjInspShowDirHierarchy write FProjInspShowDirHierarchy; // package editor property PackageEditorSortAlphabetically: boolean read FPackageEditorSortAlphabetically write FPackageEditorSortAlphabetically; property PackageEditorShowDirHierarchy: boolean read FPackageEditorShowDirHierarchy write FPackageEditorShowDirHierarchy; // procedure list property ProcedureListFilterStart: boolean read FProcedureListFilterStart write FProcedureListFilterStart; // hints property CheckDiskChangesWithLoading: boolean read FCheckDiskChangesWithLoading write FCheckDiskChangesWithLoading; property DiskChangesAutoCheckModified: boolean read FDiskChangesAutoCheckModified write FDiskChangesAutoCheckModified; property ShowHintsForComponentPalette: boolean read FShowHintsForComponentPalette write FShowHintsForComponentPalette; property ShowHintsForMainSpeedButtons: boolean read FShowHintsForMainSpeedButtons write FShowHintsForMainSpeedButtons; // files property LazarusDirectory: string read GetLazarusDirectory write SetLazarusDirectory; property LazarusDirHistory: TStringList read FLazarusDirHistory write FLazarusDirHistory; property CompilerFilename: string read GetCompilerFilename write SetCompilerFilename; property CompilerFileHistory: TStringList read FCompilerFileHistory write FCompilerFileHistory; property FPCSourceDirectory: string read GetFPCSourceDirectory write SetFPCSourceDirectory; property FPCSourceDirHistory: TStringList read FFPCSourceDirHistory; property MakeFilename: string read GetMakeFilename write SetMakeFilename; property MakeFileHistory: TStringList read FMakeFileHistory; property DebuggerFilename: string read GetDebuggerFilename write SetDebuggerFilename; property DebuggerFileHistory: TStringList read FDebuggerFileHistory; property DebuggerSearchPath: string read GetDebuggerSearchPath write SetDebuggerSearchPath; property DebuggerShowStopMessage: boolean read FDebuggerShowStopMessage write FDebuggerShowStopMessage; property DebuggerResetAfterRun: boolean read FDebuggerResetAfterRun write FDebuggerResetAfterRun; property DebuggerAutoCloseAsm: boolean read FDebuggerAutoCloseAsm write FDebuggerAutoCloseAsm; // ShowCompileDialog and AutoCloseCompileDialog are currently not used. // But maybe someone will implement them again. Keep them till 1.4.2 property ShowCompileDialog: boolean read FShowCompileDialog write FShowCompileDialog; property AutoCloseCompileDialog: boolean read FAutoCloseCompileDialog write FAutoCloseCompileDialog; property TestBuildDirectory: string read GetTestBuildDirectory write SetTestBuildDirectory; property TestBuildDirHistory: TStringList read FTestBuildDirHistory; property CompilerMessagesFilename: string read GetCompilerMessagesFilename write SetCompilerMessagesFilename; // non English translation file property CompilerMessagesFileHistory: TStringList read FCompilerMessagesFileHistory; property ManyBuildModesSelection: TStringList read FManyBuildModesSelection; // Primary-config verification property LastCalledByLazarusFullPath: String read FLastCalledByLazarusFullPath write FLastCalledByLazarusFullPath; // global build options property BuildMatrixOptions: TBuildMatrixOptions read FBuildMatrixOptions; // Clean build project dialog property CleanBuildProjOut: Boolean read FCleanBuildProjOut write FCleanBuildProjOut; property CleanBuildProjSrc: Boolean read FCleanBuildProjSrc write FCleanBuildProjSrc; property CleanBuildPkgOut: Boolean read FCleanBuildPkgOut write FCleanBuildPkgOut; property CleanBuildPkgSrc: Boolean read FCleanBuildPkgSrc write FCleanBuildPkgSrc; // Debugger procedure SaveDebuggerPropertiesList; procedure SaveDebuggerProperties(DebuggerClass: String; Properties: TDebuggerProperties); procedure LoadDebuggerProperties(DebuggerClass: String; Properties: TDebuggerProperties); property DebuggerConfig: TDebuggerConfigStore read FDebuggerConfig; // Debugger event log property DebuggerEventLogClearOnRun: Boolean read FDebuggerEventLogClearOnRun write FDebuggerEventLogClearOnRun; property DebuggerEventLogCheckLineLimit: Boolean read FDebuggerEventLogCheckLineLimit write FDebuggerEventLogCheckLineLimit; property DebuggerEventLogLineLimit: Integer read FDebuggerEventLogLineLimit write FDebuggerEventLogLineLimit; property DebuggerEventLogShowBreakpoint: Boolean read FDebuggerEventLogShowBreakpoint write FDebuggerEventLogShowBreakpoint; property DebuggerEventLogShowProcess: Boolean read FDebuggerEventLogShowProcess write FDebuggerEventLogShowProcess; property DebuggerEventLogShowThread: Boolean read FDebuggerEventLogShowThread write FDebuggerEventLogShowThread; property DebuggerEventLogShowModule: Boolean read FDebuggerEventLogShowModule write FDebuggerEventLogShowModule; property DebuggerEventLogShowOutput: Boolean read FDebuggerEventLogShowOutput write FDebuggerEventLogShowOutput; property DebuggerEventLogShowWindows: Boolean read FDebuggerEventLogShowWindows write FDebuggerEventLogShowWindows; property DebuggerEventLogShowDebugger: Boolean read FDebuggerEventLogShowDebugger write FDebuggerEventLogShowDebugger; property DebuggerEventLogUseColors: Boolean read FDebuggerEventLogUseColors write FDebuggerEventLogUseColors; property DebuggerEventLogColors[AIndex: TDBGEventType]: TDebuggerEventLogColor read GetDebuggerEventLogColors write SetDebuggerEventLogColors; // recent files and directories property RecentOpenFiles: TStringList read FRecentOpenFiles; property MaxRecentOpenFiles: integer read FMaxRecentOpenFiles write FMaxRecentOpenFiles; procedure AddToRecentOpenFiles(const AFilename: string); override; procedure RemoveFromRecentOpenFiles(const AFilename: string); override; property RecentProjectFiles: TStringList read FRecentProjectFiles; property MaxRecentProjectFiles: integer read FMaxRecentProjectFiles write FMaxRecentProjectFiles; procedure AddToRecentProjectFiles(const AFilename: string); override; procedure RemoveFromRecentProjectFiles(const AFilename: string); override; property RecentPackageFiles: TStringList read FRecentPackageFiles; property MaxRecentPackageFiles: integer read FMaxRecentPackageFiles write FMaxRecentPackageFiles; procedure AddToRecentPackageFiles(const AFilename: string); override; procedure RemoveFromRecentPackageFiles(const AFilename: string); override; property LastSavedProjectFile: string read FLastSavedProjectFile write FLastSavedProjectFile; { if empty then create new project, if '-' then do not load/create any project } property LastOpenPackages: TLastOpenPackagesList read FLastOpenPackages; property OpenLastProjectAtStart: boolean read FOpenLastProjectAtStart write FOpenLastProjectAtStart; property MultipleInstances: TIDEMultipleInstancesOption read FMultipleInstances write FMultipleInstances; property FileDialogFilter: string read FFileDialogFilter write FFileDialogFilter; // other recent settings property LastEventMethodCCResult: TCodeCreationDlgResult read FLastEventMethodCCResult write FLastEventMethodCCResult; property LastVariableCCResult: TCodeCreationDlgResult read FLastVariableCCResult write FLastVariableCCResult; property UseUnitDlgOptions: TUseUnitDlgOptions read FUseUnitDlgOptions write FUseUnitDlgOptions; // backup property BackupInfoProjectFiles: TBackupInfo read FBackupInfoProjectFiles write FBackupInfoProjectFiles; property BackupInfoOtherFiles: TBackupInfo read FBackupInfoOtherFiles write FBackupInfoOtherFiles; // external tools property ExternalToolMenuItems: TBaseExternalUserTools read fExternalUserTools; property MaxExtToolsInParallel: integer read FMaxExtToolsInParallel write FMaxExtToolsInParallel; // 0=automatic // naming conventions property PascalFileExtension: TPascalExtType read fPascalFileExtension write fPascalFileExtension; property AmbiguousFileAction: TAmbiguousFileAction read fAmbiguousFileAction write fAmbiguousFileAction; property CharcaseFileAction: TCharCaseFileAction read fCharcaseFileAction write fCharcaseFileAction; property UnitRenameReferencesAction: TUnitRenameReferencesAction read FUnitRenameReferencesAction write FUnitRenameReferencesAction; property AskForFilenameOnNewFile: boolean read FAskForFilenameOnNewFile write FAskForFilenameOnNewFile; property LowercaseDefaultFilename: boolean read FLowercaseDefaultFilename write FLowercaseDefaultFilename; // fpdoc property FPDocPaths: string read GetFPDocPaths write SetFPDocPaths; // language property LanguageID: string read fLanguageID write fLanguageID; // messages view property MsgViewDblClickJumps: boolean read fMsgViewDblClickJumps write fMsgViewDblClickJumps; // true=dbl click jump to error, false=single click jumps property MsgViewFocus: boolean read fMsgViewFocus write fMsgViewFocus; // when showing the message window, focus it property ShowMessagesIcons: boolean read FShowMessagesIcons write FShowMessagesIcons; property MsgViewStayOnTop: boolean read FMsgViewStayOnTop write FMsgViewStayOnTop; property MsgViewShowTranslations: boolean read FMsgViewShowTranslations write FMsgViewShowTranslations; property MsgViewAlwaysDrawFocused: boolean read FMsgViewAlwaysDrawFocused write FMsgViewAlwaysDrawFocused; property MsgViewFilenameStyle: TMsgWndFileNameStyle read FMsgViewFilenameStyle write FMsgViewFilenameStyle; property MsgViewColors[c: TMsgWndColor]: TColor read GetMsgViewColors write SetMsgViewColors; property MsgViewFilters: TLMsgViewFilters read FMsgViewFilters; property MsgColors[u: TMessageLineUrgency]: TColor read GetMsgColors write SetMsgColors; property MsgViewShowFPCMsgLinesCompiled: Boolean read FMsgViewShowFPCMsgLinesCompiled write FMsgViewShowFPCMsgLinesCompiled; //component list property ComponentListKeepOpen: Boolean read FComponentListKeepOpen write FComponentListKeepOpen; // glyphs property ShowButtonGlyphs: TApplicationShowGlyphs read FShowButtonGlyphs write FShowButtonGlyphs; property ShowMenuGlyphs: TApplicationShowGlyphs read FShowMenuGlyphs write FShowMenuGlyphs; // default template for each 'new item' category: Name=Path, Value=TemplateName property NewUnitTemplate: string read FNewUnitTemplate write FNewUnitTemplate; property NewFormTemplate: string read FNewFormTemplate write FNewFormTemplate; // Desktop property Desktops: TDesktopOptList read FDesktops; property Desktop: TDesktopOpt read FDesktop; // the working desktop, standalone property DebugDesktopName: string read FDebugDesktopName write FDebugDesktopName; property DebugDesktop: TDesktopOpt read GetDebugDesktop; // debug desktop from Desktops list property ActiveDesktopName: string read FActiveDesktopName write FActiveDesktopName; property ActiveDesktop: TDesktopOpt read GetActiveDesktop; // active desktop from Desktops list property AutoSaveActiveDesktop: Boolean read FAutoSaveActiveDesktop write FAutoSaveActiveDesktop; end; var OverrideFPCVer: string = ''; EnvironmentOptions: TEnvironmentOptions = nil; function PascalExtToType(const Ext: string): TPascalExtType; function AmbiguousFileActionNameToType(const Action: string): TAmbiguousFileAction; function CharCaseFileActionNameToType(const Action: string): TCharCaseFileAction; function UnitRenameReferencesActionNameToType(const Action: string): TUnitRenameReferencesAction; function StrToMsgWndFilenameStyle(const s: string): TMsgWndFileNameStyle; function StrToIDEMultipleInstancesOption(const s: string): TIDEMultipleInstancesOption; function BackupTypeToName(b: TBackupType): string; function NameToBackupType(const s: string): TBackupType; function SimpleDirectoryCheck(const OldDir, NewDir, NotFoundErrMsg: string; out StopChecking: boolean): boolean; const DefaultMsgViewFocus = {$IFDEF Windows}true{$ELSE}false{$ENDIF}; MaxComboBoxCount: integer = 20; EnvOptsConfFileName = 'environmentoptions.xml'; BakMaxCounterInfiniteTxt = 'infinite'; EnvOptParseTypeNames: array[TEnvOptParseType] of string = ( 'LazarusDir', // eopLazarusDirectory 'CompPath', // eopCompilerFilename 'FPCSrcDir', // eopFPCSourceDirectory 'TestDir', // eopTestBuildDirectory 'Make', // eopMakeFilename 'FPDocPath', // eopFPDocPaths 'CompMsgFile', // eopCompilerMessagesFilename 'Debugger', // eopDebuggerFilename 'DebugPath' // eopDebuggerSearchPath ); function dbgs(o: TEnvOptParseType): string; overload; function dbgs(u: TMessageLineUrgency): string; overload; implementation function PascalExtToType(const Ext: string): TPascalExtType; begin if Ext<>'' then for Result:=Low(TPascalExtType) to High(TPascalExtType) do if CompareFilenames(Ext,PascalExtension[Result])=0 then exit; Result:=petNone; end; function AmbiguousFileActionNameToType( const Action: string): TAmbiguousFileAction; begin for Result:=Low(TAmbiguousFileAction) to High(TAmbiguousFileAction) do if CompareText(AmbiguousFileActionNames[Result],Action)=0 then exit; Result:=afaAsk; end; function CharCaseFileActionNameToType( const Action: string): TCharCaseFileAction; begin for Result:=Low(TCharCaseFileAction) to High(TCharCaseFileAction) do if CompareText(CharCaseFileActionNames[Result],Action)=0 then exit; Result:=ccfaAutoRename; end; function UnitRenameReferencesActionNameToType(const Action: string ): TUnitRenameReferencesAction; begin for Result:=Low(TUnitRenameReferencesAction) to High(TUnitRenameReferencesAction) do if CompareText(UnitRenameReferencesActionNames[Result],Action)=0 then exit; Result:=urraAsk; end; function StrToMsgWndFilenameStyle(const s: string): TMsgWndFileNameStyle; begin for Result in TMsgWndFileNameStyle do if CompareText(s,MsgWndFileNameStyleNames[Result])=0 then exit; Result:=mwfsShort; end; function StrToIDEMultipleInstancesOption(const s: string): TIDEMultipleInstancesOption; begin for Result in TIDEMultipleInstancesOption do if CompareText(s,IDEMultipleInstancesOptionNames[Result])=0 then exit; Result:=DefaultIDEMultipleInstancesOption; end; function BackupTypeToName(b: TBackupType): string; begin Str(b,Result); Delete(Result,1,length('bak')); end; function NameToBackupType(const s: string): TBackupType; var b: TBackupType; begin for b in TBackupType do if CompareText(s,BackupTypeToName(b))=0 then exit(b); Result:=bakNone; end; function SimpleDirectoryCheck(const OldDir, NewDir, NotFoundErrMsg: string; out StopChecking: boolean): boolean; var SubResult: TModalResult; begin StopChecking:=true; if OldDir=NewDir then begin Result:=true; exit; end; SubResult:=CheckDirPathExists(NewDir,lisEnvOptDlgDirectoryNotFound, NotFoundErrMsg); if SubResult=mrIgnore then begin Result:=true; exit; end; if SubResult=mrCancel then begin Result:=false; exit; end; StopChecking:=false; Result:=true; end; function dbgs(o: TEnvOptParseType): string; begin Result:=EnvOptParseTypeNames[o]; end; function dbgs(u: TMessageLineUrgency): string; begin WriteStr(Result, u); end; { TDesktopOIOptions } constructor TDesktopOIOptions.Create; var I: TObjectInspectorPage; begin FComponentTreeHeight := -1; FInfoBoxHeight := -1; FShowInfoBox := True; for I in TObjectInspectorPage do SplitterX[I] := -1; end; procedure TDesktopOIOptions.AssignTo(Dest: TPersistent); var DDest: TDesktopOIOptions; I: TObjectInspectorPage; begin if Dest is TDesktopOIOptions then begin DDest := TDesktopOIOptions(Dest); for I in TObjectInspectorPage do DDest.SplitterX[I] := SplitterX[I]; DDest.ShowInfoBox := ShowInfoBox; DDest.ComponentTreeHeight := ComponentTreeHeight; DDest.ShowComponentTree := ShowComponentTree; DDest.InfoBoxHeight := InfoBoxHeight; end else inherited AssignTo(Dest); end; function TDesktopOIOptions.GetSplitterX(const APage: TObjectInspectorPage ): Integer; begin Result := FSplitterX[APage]; end; procedure TDesktopOIOptions.ImportSettingsFromIDE( const AOptions: TEnvironmentOptions); var I: TObjectInspectorPage; o: TOIOptions; begin o := AOptions.ObjectInspectorOptions; for I in TObjectInspectorPage do FSplitterX[I] := o.GridSplitterX[I]; ShowInfoBox := o.ShowInfoBox; ComponentTreeHeight := o.ComponentTreeHeight; ShowComponentTree := o.ShowComponentTree; InfoBoxHeight := o.InfoBoxHeight; end; procedure TDesktopOIOptions.Load(XMLConfig: TXMLConfig; Path: String); var I: TObjectInspectorPage; begin Path := Path + 'ObjectInspectorOptions/'; for I in TObjectInspectorPage do FSplitterX[I] := XMLConfig.GetValue(Path+'SplitterX/'+DefaultOIPageNames[I]+'/Value',-1); ShowComponentTree := XMLConfig.GetValue(Path+'ComponentTree/Show/Value',True); ComponentTreeHeight := XMLConfig.GetValue(Path+'ComponentTree/Height/Value',-1); ShowInfoBox := XMLConfig.GetValue(Path+'InfoBox/Show/Value',True); InfoBoxHeight := XMLConfig.GetValue(Path+'InfoBox/Height/Value',-1); end; procedure TDesktopOIOptions.Save(XMLConfig: TXMLConfig; Path: String); var I: TObjectInspectorPage; begin Path := Path + 'ObjectInspectorOptions/'; for I in TObjectInspectorPage do XMLConfig.SetDeleteValue(Path+'SplitterX/'+DefaultOIPageNames[I]+'/Value',FSplitterX[I],-1); XMLConfig.SetDeleteValue(Path+'ComponentTree/Show/Value',ShowComponentTree,True); XMLConfig.SetDeleteValue(Path+'ComponentTree/Height/Value',ComponentTreeHeight,-1); XMLConfig.SetDeleteValue(Path+'InfoBox/Show/Value',ShowInfoBox,True); XMLConfig.SetDeleteValue(Path+'InfoBox/Height/Value',InfoBoxHeight,-1); end; procedure TDesktopOIOptions.SetSplitterX(const APage: TObjectInspectorPage; const ASplitterX: Integer); begin FSplitterX[APage] := ASplitterX; end; procedure TDesktopOIOptions.ExportSettingsToIDE( const AOptions: TEnvironmentOptions); var I: TObjectInspectorPage; o: TOIOptions; begin o := AOptions.ObjectInspectorOptions; for I in TObjectInspectorPage do if FSplitterX[I]>=0 then o.GridSplitterX[I] := Max(10, FSplitterX[I]); o.ShowInfoBox := ShowInfoBox; o.ShowComponentTree := ShowComponentTree; if ComponentTreeHeight>=0 then o.ComponentTreeHeight := Max(10, ComponentTreeHeight); if InfoBoxHeight>=0 then o.InfoBoxHeight := Max(10, InfoBoxHeight); end; { TUnsupportedDesktopOpt } destructor TUnsupportedDesktopOpt.Destroy; begin freeandnil(FRetainXMLData); inherited Destroy; end; procedure TUnsupportedDesktopOpt.Load(Path: string); var lPnode, lChldNode: TDOMNode; begin inherited; FreeAndNil(FRetainXMLData); FRetainXMLData := TDOMDocument.Create; lPnode := FXMLCfg.FindNode(Path, False); lChldNode := lPnode.CloneNode(True, FRetainXMLData); FRetainXMLData.AppendChild(lChldNode); end; procedure TUnsupportedDesktopOpt.Save(Path: string); var lChldNode, lChCh: TDOMNode; lsNodeName: DOMString; lParentNode: TDOMNode; begin if Assigned(FRetainXMLData) then begin lParentNode:= FXMLCfg.FindNode(path, False); lChldNode := FRetainXMLData.FirstChild.CloneNode(True, FXMLCfg.Document); lsNodeName := lChldNode.NodeName; if ExtractFileNameOnly(copy(path, 1, length(path) - 1)) = lsNodeName then FXMLCfg.FindNode(ExtractFilePath(copy(path, 1, length(path) - 1)), False) .ReplaceChild(lChldNode, FXMLCfg.FindNode(path, False)) else begin try if not assigned(lParentNode) then begin lParentNode:=FXMLCfg.Document.CreateElement( ExtractFileNameOnly(copy(path, 1, length(path) - 1))); FXMLCfg.FindNode(ExtractFilePath(copy(path, 1, length(path) - 1)), False). AppendChild(lParentNode); end; while lChldNode.HasChildNodes do begin lChCh := lChldNode.FirstChild; lChldNode.DetachChild(lChCh); lParentNode.AppendChild(lChCh); end; finally FreeAndNil(lChldNode); end; end; end; end; { TCustomDesktopOpt } function TCustomDesktopOpt.GetCompatible: Boolean; begin Result := false; end; procedure TCustomDesktopOpt.Load(Path: String); begin FAssociatedDebugDesktopName:=FXMLCfg.GetValue(Path+'AssociatedDebugDesktopName/Value', ''); end; constructor TCustomDesktopOpt.Create(const aName: String); begin Create(aName, Assigned(IDEDockMaster)); end; constructor TCustomDesktopOpt.Create(const aName: String; const aIsDocked: Boolean); begin inherited Create; FName:=aName; FIsDocked := aIsDocked; end; destructor TCustomDesktopOpt.Destroy; begin inherited Destroy; end; procedure TCustomDesktopOpt.SetConfig(aXMLCfg: TRttiXMLConfig; aConfigStore: TXMLOptionsStorage); begin FXMLCfg := aXMLCfg; FConfigStore := aConfigStore; end; { TLastOpenPackagesList } constructor TLastOpenPackagesList.Create; begin inherited Create; Sorted:=true; Duplicates:=dupIgnore; end; function TLastOpenPackagesList.Remove(const aString: string): Boolean; var xIndex: Integer; begin xIndex := IndexOf(aString); Result := xIndex >= 0; if Result then Delete(xIndex); end; { TDesktopOptList } constructor TDesktopOptList.Create(aEnvOpts: TEnvironmentOptions); begin inherited Create; FEnvOpts := aEnvOpts; end; destructor TDesktopOptList.Destroy; begin inherited Destroy; end; procedure TDesktopOptList.SetConfig(aXMLCfg: TRttiXMLConfig; aConfigStore: TXMLOptionsStorage); begin FXMLCfg := aXMLCfg; FConfigStore := aConfigStore; end; procedure TDesktopOptList.AddFromCfg(Path: String); var dsk: TCustomDesktopOpt; dskClass: TDesktopOptClass; dskName, dskDockMaster: String; begin dskName := FXMLCfg.GetValue(Path+'Name', 'default'); dskDockMaster := FXMLCfg.GetValue(Path+'DockMaster', ''); if IndexOf(dskname) >=0 then exit; if TEnvironmentOptions.DesktopCanBeLoaded(dskDockMaster) then dskClass := TDesktopOpt else dskClass := TUnsupportedDesktopOpt; dsk := dskClass.Create(dskName, dskDockMaster<>''); dsk.SetConfig(FXMLCfg, FConfigStore); dsk.Load(Path); Add(dsk); end; function TDesktopOptList.IndexOf(aName: string): integer; begin Result:=Count-1; while (Result>=0) and (CompareText(aName, Items[Result].Name)<>0) do dec(Result); end; function TDesktopOptList.Find(aName: string): TCustomDesktopOpt; var i: LongInt; begin i:=IndexOf(aName); if i>=0 then Result:=Items[i] else Result:=nil; end; function TDesktopOptList.GetItem(Index: Integer): TCustomDesktopOpt; begin Result := TCustomDesktopOpt(inherited Items[Index]); end; { TDesktopOpt } constructor TDesktopOpt.Create(const aName: String; const aIsDocked: Boolean); begin if aIsDocked and not Assigned(IDEDockMaster) then raise Exception.Create('Internal error: TEnvironmentOptions.CreateDesktop cannot create docked desktop in undocked environment.'); inherited; if aIsDocked then FDockedOpt := IDEDockMaster.DockedDesktopOptClass.Create; FSingleTaskBarButton:=false; FHideIDEOnRun:=false; FAutoAdjustIDEHeight:=true; FAutoAdjustIDEHeightFullCompPal := true; // window menu FIDENameForDesignedFormList:=false; // CompletionWindow FCompletionWindowWidth := 320 * Screen.PixelsPerInch div 96; FCompletionWindowHeight := 6; // title FIDETitleStartsWithProject:=false; FIDETitleIncludesBuildMode:=false; FIDEProjectDirectoryInIdeTitle:=false; // IDE Coolbar FIDECoolBarOptions:=TIDECoolBarOptions.Create; // Editor Toolbar FEditorToolBarOptions:=TEditorToolBarOptions.Create; // component palette FComponentPaletteOptions:=TCompPaletteOptions.Create; // object inspector FObjectInspectorOptions:=TDesktopOIOptions.Create; // Windows layout InitLayoutList; FIDEDialogLayoutList:=TIDEDialogLayoutList.Create; FIDEWindowCreatorsLayoutList:=TSimpleWindowLayoutList.Create(False); FIDEDialogLayoutList.Assign(IDEWindowIntf.IDEDialogLayoutList); FIDEWindowCreatorsLayoutList.CopyItemsFrom(IDEWindowIntf.IDEWindowCreators.SimpleLayoutStorage); end; destructor TDesktopOpt.Destroy; begin FreeAndNil(FComponentPaletteOptions); FreeAndNil(FEditorToolBarOptions); FreeAndNil(FIDECoolBarOptions); FreeAndNil(FDockedOpt); FreeAndNil(FObjectInspectorOptions); FreeAndNil(FIDEDialogLayoutList); FreeAndNil(FIDEWindowCreatorsLayoutList); inherited Destroy; end; function TDesktopOpt.GetCompatible: Boolean; begin Result := (IsDocked = Assigned(IDEDockMaster)); end; procedure TDesktopOpt.Assign(Source: TDesktopOpt; const AssignName: Boolean; const IsCompatible: Boolean); begin if AssignName then FName := Source.FName; if IsCompatible and (Assigned(FDockedOpt) <> Assigned(Source.FDockedOpt)) then raise Exception.Create('Internal error: TDesktopOpt.Assign mixed docked/undocked desktops.'); // window layout if IsCompatible then begin FIDEWindowCreatorsLayoutList.CopyItemsFrom(Source.FIDEWindowCreatorsLayoutList); FIDEDialogLayoutList.Assign(Source.FIDEDialogLayoutList); FAssociatedDebugDesktopName := Source.FAssociatedDebugDesktopName; end; FSingleTaskBarButton := Source.FSingleTaskBarButton; FHideIDEOnRun := Source.FHideIDEOnRun; FAutoAdjustIDEHeight := Source.FAutoAdjustIDEHeight; FAutoAdjustIDEHeightFullCompPal := Source.FAutoAdjustIDEHeightFullCompPal; // window menu FIDENameForDesignedFormList := Source.FIDENameForDesignedFormList; // CompletionWindow FCompletionWindowWidth := Source.FCompletionWindowWidth; FCompletionWindowHeight := Source.FCompletionWindowHeight; // title FIDETitleStartsWithProject := Source.FIDETitleStartsWithProject; FIDETitleIncludesBuildMode := Source.FIDETitleIncludesBuildMode; FIDEProjectDirectoryInIdeTitle := Source.FIDEProjectDirectoryInIdeTitle; // IDE Coolbar FIDECoolBarOptions.Assign(Source.FIDECoolBarOptions); // Editor Toolbar FEditorToolBarOptions.Assign(Source.FEditorToolBarOptions); // component palette FComponentPaletteOptions.Assign(Source.FComponentPaletteOptions); // object inspector FObjectInspectorOptions.Assign(Source.FObjectInspectorOptions); if IsCompatible and Assigned(FDockedOpt) then FDockedOpt.Assign(Source.FDockedOpt); end; procedure TDesktopOpt.Load(Path: String); begin inherited; // Windows layout FIDEWindowCreatorsLayoutList.LoadFromConfig(FConfigStore, Path); FIDEDialogLayoutList.LoadFromConfig(FConfigStore, Path+'Dialogs/'); FSingleTaskBarButton:=FXMLCfg.GetValue(Path+'SingleTaskBarButton/Value', False); FHideIDEOnRun:=FXMLCfg.GetValue(Path+'HideIDEOnRun/Value',false); FAutoAdjustIDEHeight:=FXMLCfg.GetValue(Path+'AutoAdjustIDEHeight/Value',true); FAutoAdjustIDEHeightFullCompPal:=FXMLCfg.GetValue(Path+'AutoAdjustIDEHeightFullComponentPalette/Value',true); // Window menu FIDENameForDesignedFormList:=FXMLCfg.GetValue(Path+'IDENameForDesignedFormList/Value',false); // title FIDETitleStartsWithProject:=FXMLCfg.GetValue(Path+'IDETitleStartsWithProject/Value',false); FIDETitleIncludesBuildMode:=FXMLCfg.GetValue(Path+'IDETitleIncludesBuildMode/Value',false); FIDEProjectDirectoryInIdeTitle:=FXMLCfg.GetValue(Path+'IDEProjectDirectoryInIdeTitle/Value',false); // CompletionWindow FCompletionWindowWidth:=FXMLCfg.GetValue(Path+'CompletionWindowOptions/Width/Value', FCompletionWindowWidth); FCompletionWindowHeight:=FXMLCfg.GetValue(Path+'CompletionWindowOptions/Height/Value', 6); if not FXMLCfg.HasPath(Path+'IDECoolBarOptions/', True) then Path := ''; // Toolbars and palette were at the top level in XML. // IDE Coolbar FIDECoolBarOptions.Load(FXMLCfg, Path); // Editor Toolbar FEditorToolBarOptions.Load(FXMLCfg, Path); // component palette FComponentPaletteOptions.Load(FXMLCfg, Path); // Object Inspector FObjectInspectorOptions.Load(FXMLCfg, Path); if Assigned(FDockedOpt) then FDockedOpt.Load(Path, FXMLCfg); end; procedure TDesktopOpt.RestoreDesktop; begin IDEWindowCreators.RestoreSimpleLayout; if Assigned(FDockedOpt) then FDockedOpt.RestoreDesktop; end; procedure TDesktopOpt.ImportSettingsFromIDE(const AOptions: TEnvironmentOptions ); begin IDEWindowIntf.IDEWindowCreators.SimpleLayoutStorage.StoreWindowPositions; FIDEDialogLayoutList.Assign(IDEWindowIntf.IDEDialogLayoutList); FIDEWindowCreatorsLayoutList.CopyItemsFrom(IDEWindowIntf.IDEWindowCreators.SimpleLayoutStorage); FObjectInspectorOptions.ImportSettingsFromIDE(AOptions); if Assigned(FDockedOpt) then FDockedOpt.ImportSettingsFromIDE; end; procedure TDesktopOpt.Save(Path: String); begin // windows FXMLCfg.SetDeleteValue(Path+'Name', FName, ''); if Assigned(FDockedOpt) then FXMLCfg.SetDeleteValue(Path+'DockMaster', IDEDockMaster.ClassName, '') else FXMLCfg.DeleteValue(Path+'DockMaster'); FIDEWindowCreatorsLayoutList.SaveToConfig(FConfigStore, Path); FIDEDialogLayoutList.SaveToConfig(FConfigStore,Path+'Dialogs/'); FXMLCfg.SetDeleteValue(Path+'AssociatedDebugDesktopName/Value', FAssociatedDebugDesktopName, ''); FXMLCfg.SetDeleteValue(Path+'SingleTaskBarButton/Value',FSingleTaskBarButton, False); FXMLCfg.SetDeleteValue(Path+'HideIDEOnRun/Value',FHideIDEOnRun,false); FXMLCfg.SetDeleteValue(Path+'AutoAdjustIDEHeight/Value',FAutoAdjustIDEHeight,true); FXMLCfg.SetDeleteValue(Path+'AutoAdjustIDEHeightFullComponentPalette/Value', FAutoAdjustIDEHeightFullCompPal,true); // Window menu FXMLCfg.SetDeleteValue(Path+'IDENameForDesignedFormList/Value',FIDENameForDesignedFormList,false); // title FXMLCfg.SetDeleteValue(Path+'IDETitleStartsWithProject/Value',FIDETitleStartsWithProject,false); FXMLCfg.SetDeleteValue(Path+'IDETitleIncludesBuildMode/Value',FIDETitleIncludesBuildMode,false); FXMLCfg.SetDeleteValue(Path+'IDEProjectDirectoryInIdeTitle/Value',FIDEProjectDirectoryInIdeTitle,false); // CompletionWindow FXMLCfg.SetValue(Path+'CompletionWindowOptions/Width/Value',FCompletionWindowWidth); FXMLCfg.SetDeleteValue(Path+'CompletionWindowOptions/Height/Value',FCompletionWindowHeight, 6); // IDE Coolbar FIDECoolBarOptions.Save(FXMLCfg, Path); // Editor Toolbar FEditorToolBarOptions.Save(FXMLCfg, Path); // component palette FComponentPaletteOptions.Save(FXMLCfg, Path); // Object Inspector FObjectInspectorOptions.Save(FXMLCfg, Path); if Assigned(FDockedOpt) then FDockedOpt.Save(Path, FXMLCfg); end; procedure TDesktopOpt.ExportSettingsToIDE(const AOptions: TEnvironmentOptions); var ComplForm: TCustomForm; begin if Assigned(FDockedOpt) then FDockedOpt.ExportSettingsToIDE; IDEWindowIntf.IDEDialogLayoutList.Assign(FIDEDialogLayoutList); IDEWindowIntf.IDEWindowCreators.SimpleLayoutStorage.CopyItemsFrom(FIDEWindowCreatorsLayoutList); FObjectInspectorOptions.ExportSettingsToIDE(AOptions); if Assigned(SourceEditorManagerIntf) then begin ComplForm := SourceEditorManagerIntf.DefaultSynCompletionForm; if Assigned(ComplForm) then ComplForm.Width := Max(50, CompletionWindowWidth); SourceEditorManagerIntf.SynCompletionLinesInWindow := Max(3, CompletionWindowHeight); end; end; procedure InitLayoutHelper(const FormID: string); begin with IDEWindowCreators.SimpleLayoutStorage do if not Assigned(ItemByFormID(FormID)) then CreateWindowLayout(FormID); end; procedure TDesktopOpt.InitLayoutList; var l: TNonModalIDEWindow; begin for l:=Low(TNonModalIDEWindow) to High(TNonModalIDEWindow) do if l<>nmiwNone then InitLayoutHelper(NonModalIDEWindowNames[l]); InitLayoutHelper(DefaultObjectInspectorName); end; { TEnvironmentOptions } constructor TEnvironmentOptions.Create; var o: TEnvOptParseType; c: TMsgWndColor; u: TMessageLineUrgency; begin inherited Create; for o:=low(FParseValues) to high(FParseValues) do FParseValues[o].ParseStamp:=CTInvalidChangeStamp; FFilename:=''; // language LanguageID:=''; // auto save FAskSaveSessionOnly:=false; FAutoSaveEditorFiles:=true; FAutoSaveProject:=true; FAutoSaveIntervalInSecs:=DefaultAutoSaveIntervalInSecs; FLastSavedProjectFile:=''; FLastOpenPackages:=TLastOpenPackagesList.Create; // EnvironmentOptionsDialog editor FShowGrid:=true; FShowBorderSpacing:=false; FGridColor:=DefaultGridColor; FSnapToGrid:=true; FGridSizeX:=DefaultGridSize; FGridSizeY:=DefaultGridSize; FShowGuideLines:=true; FSnapToGuideLines:=true; FGuideLineColorLeftTop:=DefaultGuideLineColorLeftTop; FGuideLineColorRightBottom:=DefaultGuideLineColorRightBottom; FShowComponentCaptions:=false; FShowEditorHints:=true; FAutoCreateFormsOnOpen:=true; FCheckPackagesOnFormCreate:=true; FRightClickSelects:=true; FGrabberColor:=clBlack; FMarkerColor:=clDkGray; FRubberbandSelectionColor:=clNavy; FRubberbandCreationColor:=clMaroon; FRubberbandSelectsGrandChilds:=DefaultRubberbandSelectsGrandChilds; FDesignerPaintLazy:=true; FCreateComponentFocusNameProperty:=false; FSwitchToFavoritesOITab:=false; FFormTitleBarChangesObjectInspector:=false; FForceDPIScalingInDesignTime:=true; // object inspector FObjectInspectorOptions:=TOIOptions.Create; // project inspector FProjInspSortAlphabetically:=false; FProjInspShowDirHierarchy:=false; // package editor FPackageEditorSortAlphabetically:=false; FPackageEditorShowDirHierarchy:=false; // procedure list FProcedureListFilterStart:=false; // hints FCheckDiskChangesWithLoading:=false; FDiskChangesAutoCheckModified:=false; FShowHintsForComponentPalette:=true; FShowHintsForMainSpeedButtons:=true; // messages view fMsgViewDblClickJumps:=true; fMsgViewFocus:=DefaultMsgViewFocus; FShowMessagesIcons:=true; FMsgViewStayOnTop:=false; FMsgViewShowTranslations:=false; FMsgViewAlwaysDrawFocused:=false; FMsgViewFilenameStyle:=mwfsShort; for c:=low(TMsgWndColor) to high(TMsgWndColor) do fMsgViewColors[c]:=MsgWndDefaultColors[c]; for u:=low(TMessageLineUrgency) to high(TMessageLineUrgency) do fMsgColors[u] := clDefault; FMsgViewFilters:=TLMsgViewFilters.Create(nil); FMsgViewShowFPCMsgLinesCompiled:=false; // glyphs FShowButtonGlyphs := sbgSystem; FShowMenuGlyphs := sbgSystem; // files LazarusDirectory:=''; FLazarusDirHistory:=TStringList.Create; CompilerFilename:=''; FCompilerFileHistory:=TStringList.Create; FPCSourceDirectory:=''; FFPCSourceDirHistory:=TStringList.Create; MakeFilename:=DefaultMakefilename; FMakeFileHistory:=TStringList.Create; DebuggerFilename:=''; FDebuggerFileHistory:=TStringList.Create; FDebuggerProperties := TStringList.Create; FDebuggerEventLogColors:=DebuggerDefaultColors; TestBuildDirectory:=GetDefaultTestBuildDirectory; FTestBuildDirHistory:=TStringList.Create; CompilerMessagesFilename:=''; FCompilerMessagesFileHistory:=TStringList.Create; FManyBuildModesSelection:=TStringList.Create; // recent files and directories FRecentOpenFiles:=TStringList.Create; FMaxRecentOpenFiles:=DefaultMaxRecentOpenFiles; FRecentProjectFiles:=TStringList.Create; FMaxRecentProjectFiles:=DefaultMaxRecentProjectFiles; FRecentPackageFiles:=TStringList.Create; FMaxRecentPackageFiles:=DefaultMaxRecentPackageFiles; FOpenLastProjectAtStart:=true; FMultipleInstances:=DefaultIDEMultipleInstancesOption; // other recent settings FLastEventMethodCCResult.ClassSection:=icsPublic; FLastVariableCCResult.ClassSection:=icsPrivate; FLastVariableCCResult.Location:=cclLocal; // backup with FBackupInfoProjectFiles do begin BackupType:=DefaultBackupTypeProject; AdditionalExtension:=DefaultBackupAddExt; // for bakUserDefinedAddExt MaxCounter:=DefaultBackupMaxCounter; // for bakCounter SubDirectory:=DefaultBackupSubDirectory; end; with FBackupInfoOtherFiles do begin BackupType:=DefaultBackupTypeOther; AdditionalExtension:=DefaultBackupAddExt; // for bakUserDefinedAddExt MaxCounter:=DefaultBackupMaxCounter; // for bakCounter SubDirectory:=DefaultBackupSubDirectory; end; // external tools if Assigned(ExternalUserToolsClass) then fExternalUserTools:=ExternalUserToolsClass.Create; FMaxExtToolsInParallel:=0; // naming fPascalFileExtension:=petPAS; fCharcaseFileAction:=ccfaAutoRename; FUnitRenameReferencesAction:=urraAsk; FAskForFilenameOnNewFile:=false; FLowercaseDefaultFilename:=true; //debug (* TODO: maybe revert relations. Create this in Debugger, and call environmentoptions for the configstore only? *) FDebuggerConfig := TDebuggerConfigStore.Create; // global build options FBuildMatrixOptions:=TBuildMatrixOptions.Create; // Desktop collection FDesktops := TDesktopOptList.Create(Self); // FDesktop points to the IDE properties FDesktop := TDesktopOpt.Create(''); FAutoSaveActiveDesktop := True; end; destructor TEnvironmentOptions.Destroy; var i: Integer; begin FreeAndNil(FDesktops); FreeAndNil(FDesktop); FreeAndNil(FLastDesktopBeforeDebug); FreeAndNil(FBuildMatrixOptions); FreeAndNil(FMsgViewFilters); FreeAndNil(fExternalUserTools); FreeAndNil(FRecentOpenFiles); FreeAndNil(FRecentProjectFiles); FreeAndNil(FRecentPackageFiles); FreeAndNil(FObjectInspectorOptions); FreeAndNil(FLazarusDirHistory); FreeAndNil(FCompilerFileHistory); FreeAndNil(FFPCSourceDirHistory); FreeAndNil(FMakeFileHistory); FreeAndNil(FDebuggerFileHistory); for i := 0 to FDebuggerProperties.Count - 1 do FDebuggerProperties.Objects[i].Free; FreeAndNil(FManyBuildModesSelection); FreeAndNil(FDebuggerProperties); FreeAndNil(FTestBuildDirHistory); FreeAndNil(FCompilerMessagesFileHistory); FreeAndNil(FDebuggerConfig); FreeAndNil(FConfigStore); FreeAndNil(FDbgConfigStore); FreeAndNil(FXMLCfg); FreeAndNil(FLastOpenPackages); inherited Destroy; end; procedure TEnvironmentOptions.DisableDebugDesktop; begin if (FLastDesktopBeforeDebug=nil) or (FDesktop=nil) then Exit; try if AutoSaveActiveDesktop and Assigned(DebugDesktop) then begin Desktop.ImportSettingsFromIDE(Self); DebugDesktop.Assign(Desktop); end; UseDesktop(FLastDesktopBeforeDebug); finally FreeAndNil(FLastDesktopBeforeDebug); end; end; class function TEnvironmentOptions.GetGroupCaption: string; begin Result := dlgGroupEnvironment; end; class function TEnvironmentOptions.GetInstance: TAbstractIDEOptions; begin Result := EnvironmentOptions; end; procedure TEnvironmentOptions.DoAfterWrite(Restore: boolean); begin // Note! Data is saved when the IDE is closed. //if not Restore then // Save(False); inherited DoAfterWrite(Restore); end; procedure TEnvironmentOptions.EnableDebugDesktop; begin if not Assigned(FLastDesktopBeforeDebug) and Assigned(DebugDesktop) and (DebugDesktop <> ActiveDesktop) then begin FLastDesktopBeforeDebug := TDesktopOpt.Create(ActiveDesktopName); if AutoSaveActiveDesktop then Desktop.ImportSettingsFromIDE(Self); FLastDesktopBeforeDebug.Assign(Desktop, False); EnvironmentOptions.UseDesktop(DebugDesktop); end; end; procedure TEnvironmentOptions.CreateConfig; var ConfFileName: string; begin ConfFileName:=GetDefaultConfigFilename; CopySecondaryConfigFile(EnvOptsConfFileName); if (not FileExistsUTF8(ConfFileName)) then begin //DebugLn('Note: environment config file not found - using defaults'); end; Filename:=ConfFilename; end; class function TEnvironmentOptions.DesktopCanBeLoaded(const aDockMaster: string ): Boolean; begin Result := (aDockMaster = '') or ( Assigned(IDEDockMaster) and (IDEDockMaster.ClassName = aDockMaster)); end; function TEnvironmentOptions.GetParsedLazarusDirectory: string; begin Result:=GetParsedValue(eopLazarusDirectory); end; procedure TEnvironmentOptions.SetFileName(const NewFilename: string); begin if FFilename=NewFilename then exit; FFilename:=NewFilename; FFileHasChangedOnDisk:=true; end; procedure TEnvironmentOptions.LoadNonDesktop(Path: String); procedure LoadBackupInfo(var BackupInfo: TBackupInfo; const Path:string; DefaultBackupType: TBackupType); var i:integer; begin with BackupInfo do begin if FFileVersion>=110 then begin BackupType:=NameToBackupType(FXMLCfg.GetValue(Path+'Type',BackupTypeToName(DefaultBackupType))); end else begin // 109 and less: i:=FXMLCfg.GetValue(Path+'Type',5); case i of 0:BackupType:=bakNone; 1:BackupType:=bakSymbolInFront; 2:BackupType:=bakSymbolBehind; 3:BackupType:=bakCounter; 4:BackupType:=bakSameName; else BackupType:=bakUserDefinedAddExt; end; end; AdditionalExtension:=FXMLCfg.GetValue(Path+'AdditionalExtension',DefaultBackupAddExt); MaxCounter:=FXMLCfg.GetValue(Path+'MaxCounter',9); // DefaultBackupMaxCounter if FFileVersion<101 then SubDirectory:='' else SubDirectory:=FXMLCfg.GetValue(Path+'SubDirectory','backup'); // DefaultBackupSubDirectory; end; end; var EventType: TDBGEventType; begin // files LazarusDirectory:=FXMLCfg.GetValue(Path+'LazarusDirectory/Value',LazarusDirectory); LoadRecentList(FXMLCfg,FLazarusDirHistory,Path+'LazarusDirectory/History/',rltFile); if FLazarusDirHistory.Count=0 then FLazarusDirHistory.Add(ProgramDirectoryWithBundle); CompilerFilename:=TrimFilename(FXMLCfg.GetValue( Path+'CompilerFilename/Value',CompilerFilename)); LoadRecentList(FXMLCfg,FCompilerFileHistory,Path+'CompilerFilename/History/',rltFile); if FCompilerFileHistory.Count=0 then GetDefaultCompilerFilenames(FCompilerFileHistory); FPCSourceDirectory:=FXMLCfg.GetValue(Path+'FPCSourceDirectory/Value',FPCSourceDirectory); LoadRecentList(FXMLCfg,FFPCSourceDirHistory,Path+'FPCSourceDirectory/History/',rltFile); MakeFilename:=TrimFilename(FXMLCfg.GetValue(Path+'MakeFilename/Value',MakeFilename)); LoadRecentList(FXMLCfg,FMakeFileHistory,Path+'MakeFilename/History/',rltFile); if FMakeFileHistory.Count=0 then GetDefaultMakeFilenames(FMakeFileHistory); TestBuildDirectory:=FXMLCfg.GetValue(Path+'TestBuildDirectory/Value',TestBuildDirectory); LoadRecentList(FXMLCfg,FTestBuildDirHistory,Path+'TestBuildDirectory/History/',rltFile); if FTestBuildDirHistory.Count=0 then GetDefaultTestBuildDirs(FTestBuildDirHistory); CompilerMessagesFilename:=FXMLCfg.GetValue(Path+'CompilerMessagesFilename/Value',CompilerMessagesFilename); LoadRecentList(FXMLCfg,FCompilerMessagesFileHistory,Path+'CompilerMessagesFilename/History/',rltFile); LoadRecentList(FXMLCfg,FManyBuildModesSelection,Path+'ManyBuildModesSelection/',rltCaseInsensitive); // Primary-config verification FLastCalledByLazarusFullPath:=FXMLCfg.GetValue(Path+'LastCalledByLazarusFullPath/Value',''); // global build options, additions and overrides FConfigStore.AppendBasePath('BuildMatrix'); FBuildMatrixOptions.LoadFromConfig(FConfigStore); FConfigStore.UndoAppendBasePath; // Clean build project dialog FCleanBuildProjOut:=FXMLCfg.GetValue(Path+'CleanBuild/ProjOut',true); FCleanBuildProjSrc:=FXMLCfg.GetValue(Path+'CleanBuild/ProjSrc',true); FCleanBuildPkgOut:=FXMLCfg.GetValue(Path+'CleanBuild/PkgOut',true); FCleanBuildPkgSrc:=FXMLCfg.GetValue(Path+'CleanBuild/PkgSrc',true); // backup LoadBackupInfo(FBackupInfoProjectFiles,Path+'BackupProjectFiles/',DefaultBackupTypeProject); LoadBackupInfo(FBackupInfoOtherFiles,Path+'BackupOtherFiles/',DefaultBackupTypeOther); // Debugger FDebuggerConfig.Load; DebuggerFilename:=FXMLCfg.GetValue(Path+'DebuggerFilename/Value',''); LoadRecentList(FXMLCfg,FDebuggerFileHistory,Path+'DebuggerFilename/History/',rltFile); DebuggerSearchPath:=FXMLCfg.GetValue(Path+'DebuggerSearchPath/Value',''); // Debugger General Options DebuggerShowStopMessage:=FXMLCfg.GetValue(Path+'DebuggerOptions/ShowStopMessage/Value', True); DebuggerResetAfterRun :=FXMLCfg.GetValue(Path+'DebuggerOptions/DebuggerResetAfterRun/Value', False); FDebuggerAutoCloseAsm :=FXMLCfg.GetValue(Path+'DebuggerOptions/DebuggerAutoCloseAsm/Value', False); FDebuggerEventLogClearOnRun := FXMLCfg.GetValue(Path+'Debugger/EventLogClearOnRun', True); FDebuggerEventLogCheckLineLimit := FXMLCfg.GetValue(Path+'Debugger/EventLogCheckLineLimit', False); FDebuggerEventLogLineLimit := FXMLCfg.GetValue(Path+'Debugger/EventLogLineLimit', 1000); FDebuggerEventLogShowBreakpoint := FXMLCfg.GetValue(Path+'Debugger/EventLogShowBreakpoint', False); FDebuggerEventLogShowProcess := FXMLCfg.GetValue(Path+'Debugger/EventLogShowProcess', True); FDebuggerEventLogShowThread := FXMLCfg.GetValue(Path+'Debugger/EventLogShowThread', True); FDebuggerEventLogShowModule := FXMLCfg.GetValue(Path+'Debugger/EventLogShowModule', False); FDebuggerEventLogShowOutput := FXMLCfg.GetValue(Path+'Debugger/EventLogShowOutput', True); FDebuggerEventLogShowWindows := FXMLCfg.GetValue(Path+'Debugger/EventLogShowWindows', False); FDebuggerEventLogShowDebugger := FXMLCfg.GetValue(Path+'Debugger/EventLogShowDebugger', True); FDebuggerEventLogUseColors := FXMLCfg.GetValue(Path+'Debugger/EventLogUseColors', True); for EventType := Low(TDBGEventType) to High(TDBGEventType) do begin FDebuggerEventLogColors[EventType].Background := FXMLCfg.GetValue(Path+'Debugger/EventLogColors/' + GetEnumName(TypeInfo(EventType), Ord(EventType)) + '/Background', DebuggerDefaultColors[EventType].Background); FDebuggerEventLogColors[EventType].Foreground := FXMLCfg.GetValue(Path+'Debugger/EventLogColors/' + GetEnumName(TypeInfo(EventType), Ord(EventType)) + '/Foreground', DebuggerDefaultColors[EventType].Foreground); end; end; procedure TEnvironmentOptions.Load(OnlyDesktop: boolean); procedure AddRecentProjectInitial(aProjPath, aProjFile: string); // Add a project to the list of recent projects if the project has write access. // The check can be removed when the IDE allows compiling read-only projects. var WholeFilePath: String; begin aProjPath:=SwitchPathDelims(aProjPath, True); WholeFilePath:=ExtractFilePath(Application.ExeName) + aProjPath + aProjFile; if FileIsWritable(aProjPath) and FileIsWritable(WholeFilePath) then AddToRecentList(WholeFilePath,FRecentProjectFiles,FMaxRecentProjectFiles,rltFile); end; procedure LoadPascalFileExt(const Path: string); begin fPascalFileExtension:=PascalExtToType(FXMLCfg.GetValue( Path+'Naming/PascalFileExtension',PascalExtension[petPAS])); if fPascalFileExtension=petNone then fPascalFileExtension:=petPAS; end; procedure LoadCCResult(var CCResult: TCodeCreationDlgResult; const Path: string; const DefaultClassSection: TInsertClassSection); begin CCResult.ClassSection:=InsertClassSectionNameToSection(FXMLCfg.GetValue( Path+'/ClassSection',InsertClassSectionNames[DefaultClassSection])); CCResult.Location:=CreateCodeLocationNameToLocation(FXMLCfg.GetValue( Path+'/Location',CreateCodeLocationNames[cclLocal])); end; var Path, CurPath: String; i, j: Integer; Rec: PIDEOptionsGroupRec; NodeName, xFileName: String; mwc: TMsgWndColor; u: TMessageLineUrgency; begin try InitXMLCfg(false); // ToDo: Get rid of EnvironmentOptions/ path. The whole file is about // environment options. Many section are not under it any more. Path:='EnvironmentOptions/'; FFileVersion:=FXMLCfg.GetValue(Path+'Version/Value',EnvOptsVersion); FOldLazarusVersion:=FXMLCfg.GetValue(Path+'Version/Lazarus',''); if FOldLazarusVersion='' then begin // 108 added LastCalledByLazarusFullPath // 107 added Lazarus version // 1.1 r36507 106 // 0.9.31 r28811 106 // 0.9.29 r21344 106 // 0.9.27 r16725 106 // 0.9.25 r12751 106 // 0.9.23 r10809 106 end; // language fLanguageID:=FXMLCfg.GetValue(Path+'Language/ID',''); // auto save FAskSaveSessionOnly:=FXMLCfg.GetValue(Path+'AutoSave/AskSaveSessionOnly',false); FAutoSaveEditorFiles:=FXMLCfg.GetValue(Path+'AutoSave/EditorFiles',true); FAutoSaveProject:=FXMLCfg.GetValue(Path+'AutoSave/Project',true); FAutoSaveIntervalInSecs:=FXMLCfg.GetValue(Path+'AutoSave/IntervalInSecs',DefaultAutoSaveIntervalInSecs); FLastSavedProjectFile:=FXMLCfg.GetValue(Path+'AutoSave/LastSavedProjectFile',''); FOpenLastProjectAtStart:=FXMLCfg.GetValue(Path+'AutoSave/OpenLastProjectAtStart',true); FShowCompileDialog:=FXMLCfg.GetValue(Path+'ShowCompileDialog/Value',false); FAutoCloseCompileDialog:=FXMLCfg.GetValue(Path+'AutoCloseCompileDialog/Value',false); FAutoSaveActiveDesktop:=FXMLCfg.GetValue(Path+'AutoSave/ActiveDesktop',True); FLastOpenPackages.Clear; if FOpenLastProjectAtStart then begin i := 1; repeat xFileName := FXMLCfg.GetValue(Path+'AutoSave/LastOpenPackages/Package'+IntToStr(i), ''); if FileExistsCached(xFileName) then FLastOpenPackages.Add(xFileName); Inc(i); until xFileName=''; end; // form editor FShowGrid:=FXMLCfg.GetValue(Path+'FormEditor/ShowGrid',true); FShowBorderSpacing:=FXMLCfg.GetValue(Path+'FormEditor/ShowBorderSpacing',false); FGridColor:=FXMLCfg.GetValue(Path+'FormEditor/GridColor',DefaultGridColor); FSnapToGrid:=FXMLCfg.GetValue(Path+'FormEditor/SnapToGrid',true); FGridSizeX:=FXMLCfg.GetValue(Path+'FormEditor/GridSizeX',DefaultGridSize); FGridSizeY:=FXMLCfg.GetValue(Path+'FormEditor/GridSizeY',DefaultGridSize); FShowGuideLines:=FXMLCfg.GetValue(Path+'FormEditor/ShowGuideLines',true); FSnapToGuideLines:=FXMLCfg.GetValue(Path+'FormEditor/SnapToGuideLines',true); FGuideLineColorLeftTop:=FXMLCfg.GetValue(Path+'FormEditor/GuideLineColorLeftTop', DefaultGuideLineColorLeftTop); FGuideLineColorRightBottom:=FXMLCfg.GetValue(Path+'FormEditor/GuideLineColorRightBottom', DefaultGuideLineColorRightBottom); FShowComponentCaptions:=FXMLCfg.GetValue(Path+'FormEditor/ShowComponentCaptions',true); FShowEditorHints:=FXMLCfg.GetValue(Path+'FormEditor/ShowEditorHints',true); FAutoCreateFormsOnOpen:=FXMLCfg.GetValue(Path+'FormEditor/AutoCreateFormsOnOpen',true); FCheckPackagesOnFormCreate:=FXMLCfg.GetValue(Path+'FormEditor/CheckPackagesOnFormCreate',true); FRightClickSelects:=FXMLCfg.GetValue(Path+'FormEditor/RightClickSelects',true); FGrabberColor:=FXMLCfg.GetValue(Path+'FormEditor/GrabberColor/Value',FGrabberColor); FMarkerColor:=FXMLCfg.GetValue(Path+'FormEditor/MarkerColor/Value',FMarkerColor); FRubberbandSelectionColor:=FXMLCfg.GetValue(Path+'FormEditor/Rubberband/SelectionColor/Value', FRubberbandSelectionColor); FRubberbandCreationColor:=FXMLCfg.GetValue(Path+'FormEditor/Rubberband/CreationColor/Value', FRubberbandCreationColor); FRubberbandSelectsGrandChilds:=FXMLCfg.GetValue(Path+'FormEditor/Rubberband/SelectsGrandChilds/Value',DefaultRubberbandSelectsGrandChilds); FDesignerPaintLazy:=FXMLCfg.GetValue(Path+'FormEditor/DesignerPaint/Lazy/Value',true); FCreateComponentFocusNameProperty:=FXMLCfg.GetValue( Path+'FormEditor/CreateComponentFocusNameProperty/Value',false); FSwitchToFavoritesOITab:=FXMLCfg.GetValue(Path+'FormEditor/SwitchToFavoritesOITab/Value',false); FFormTitleBarChangesObjectInspector:=FXMLCfg.GetValue(Path+'FormEditor/FormTitleBarChangesObjectInspector/Value',false); FForceDPIScalingInDesignTime:=FXMLCfg.GetValue(Path+'FormEditor/ForceDPIScalingInDesignTime/Value',true); if not OnlyDesktop then LoadNonDesktop(Path); // project inspector FProjInspSortAlphabetically:=FXMLCfg.GetValue(Path+'ProjInspSortAlphabetically/Value',false); FProjInspShowDirHierarchy:=FXMLCfg.GetValue(Path+'ProjInspShowDirHierarchy/Value',false); // package editor FPackageEditorSortAlphabetically:=FXMLCfg.GetValue(Path+'PackageEditorSortAlphabetically/Value',false); FPackageEditorShowDirHierarchy:=FXMLCfg.GetValue(Path+'PackageEditorShowDirHierarchy/Value',false); // procedure list FProcedureListFilterStart:=FXMLCfg.GetValue(Path+'ProcedureListFilterStart/Value',false); // hints FCheckDiskChangesWithLoading:=FXMLCfg.GetValue(Path+'CheckDiskChangesWithLoading/Value',false); FDiskChangesAutoCheckModified:=FXMLCfg.GetValue(Path+'DiskChangesAutoCheckModified/Value',false); FShowHintsForComponentPalette:=FXMLCfg.GetValue(Path+'ShowHintsForComponentPalette/Value',true); FShowHintsForMainSpeedButtons:=FXMLCfg.GetValue(Path+'ShowHintsForMainSpeedButtons/Value',true); // messages view fMsgViewDblClickJumps:=FXMLCfg.GetValue(Path+'MsgViewDblClickJumps/Value',false); fMsgViewFocus:=FXMLCfg.GetValue(Path+'MsgViewFocus/Value',DefaultMsgViewFocus); FShowMessagesIcons:=FXMLCfg.GetValue(Path+'MsgView/ShowMessagesIcons/Value',true); FMsgViewStayOnTop:=FXMLCfg.GetValue(Path+'MsgView/StayOnTop/Value',false); FMsgViewShowTranslations:=FXMLCfg.GetValue(Path+'MsgView/ShowTranslations/Value',false); FMsgViewAlwaysDrawFocused:=FXMLCfg.GetValue(Path+'MsgView/AlwaysDrawFocused/Value',false); FMsgViewFilenameStyle:=StrToMsgWndFilenameStyle(FXMLCfg.GetValue( Path+'MsgView/Filename/Style',MsgWndFileNameStyleNames[mwfsShort])); for mwc:=low(TMsgWndColor) to high(TMsgWndColor) do fMsgViewColors[mwc]:=FXMLCfg.GetValue( Path+'MsgView/Colors/'+MsgWndColorNames[mwc],MsgWndDefaultColors[mwc]); for u:=low(TMessageLineUrgency) to high(TMessageLineUrgency) do fMsgColors[u] := FXMLCfg.GetValue( Path+'MsgView/MsgColors/'+dbgs(u),clDefault); MsgViewFilters.LoadFromXMLConfig(FXMLCfg,'MsgView/Filters/'); FMsgViewShowFPCMsgLinesCompiled:=FXMLCfg.GetValue(Path+'MsgView/FPCMsg/ShowLinesCompiled',false); //component list FComponentListKeepOpen:=FXMLCfg.GetValue(Path+'ComponentList/KeepOpen',false); // glyphs FShowButtonGlyphs := TApplicationShowGlyphs(FXMLCfg.GetValue(Path+'ShowButtonGlyphs/Value', Ord(sbgSystem))); FShowMenuGlyphs := TApplicationShowGlyphs(FXMLCfg.GetValue(Path+'ShowMenuGlyphs/Value', Ord(sbgSystem))); // recent files and directories FMaxRecentOpenFiles:=FXMLCfg.GetValue(Path+'Recent/OpenFiles/Max',DefaultMaxRecentOpenFiles); LoadRecentList(FXMLCfg,FRecentOpenFiles,Path+'Recent/OpenFiles/',rltFile); FMaxRecentProjectFiles:=FXMLCfg.GetValue(Path+'Recent/ProjectFiles/Max',DefaultMaxRecentProjectFiles); LoadRecentList(FXMLCfg,FRecentProjectFiles,Path+'Recent/ProjectFiles/',rltFile); FMaxRecentPackageFiles:=FXMLCfg.GetValue(Path+'Recent/PackageFiles/Max',DefaultMaxRecentPackageFiles); LoadRecentList(FXMLCfg,FRecentPackageFiles,Path+'Recent/PackageFiles/',rltFile); FAlreadyPopulatedRecentFiles := FXMLCfg.GetValue(Path+'Recent/AlreadyPopulated', false); // other recent settings LoadCCResult(FLastEventMethodCCResult, Path+'Recent/EventMethodCCResult', icsPublic); LoadCCResult(FLastVariableCCResult, Path+'Recent/VariableCCResult', icsPrivate); FUseUnitDlgOptions.AllUnits:=FXMLCfg.GetValue(Path+'Recent/UseUnitDlg/AllUnits',False); FUseUnitDlgOptions.AddToImplementation:=FXMLCfg.GetValue(Path+'Recent/UseUnitDlg/AddToImplementation',False); // Add example projects to an empty project list if examples have write access if (FRecentProjectFiles.count=0) and (not FAlreadyPopulatedRecentFiles) then begin AddRecentProjectInitial('examples/jpeg/', 'jpegexample.lpi'); AddRecentProjectInitial('examples/sprites/', 'spriteexample.lpi'); AddRecentProjectInitial('examples/openglcontrol/', 'openglcontrol_demo.lpi'); AddRecentProjectInitial('examples/imagelist/', 'project1.lpi'); AddRecentProjectInitial('examples/', 'hello.lpi'); FAlreadyPopulatedRecentFiles := True; end; // external tools if Assigned(fExternalUserTools) then fExternalUserTools.Load(FConfigStore,Path+'ExternalTools/'); FMaxExtToolsInParallel:=FXMLCfg.GetValue(Path+'ExternalTools/MaxInParallel',0); // naming LoadPascalFileExt(Path+''); if FFileVersion>=103 then begin fCharcaseFileAction:=CharCaseFileActionNameToType(FXMLCfg.GetValue( Path+'CharcaseFileAction/Value','')); end else begin if FXMLCfg.GetValue(Path+'PascalFileAskLowerCase/Value',true) then fCharcaseFileAction:=ccfaAsk else if FXMLCfg.GetValue(Path+'PascalFileAutoLowerCase/Value',false) then fCharcaseFileAction:=ccfaAutoRename else fCharcaseFileAction:=ccfaIgnore; end; if FFileVersion>=104 then CurPath:=Path+'AmbiguousFileAction/Value' else CurPath:=Path+'AmbigiousFileAction/Value'; fAmbiguousFileAction:=AmbiguousFileActionNameToType(FXMLCfg.GetValue( CurPath,AmbiguousFileActionNames[fAmbiguousFileAction])); FUnitRenameReferencesAction:=UnitRenameReferencesActionNameToType(FXMLCfg.GetValue( Path+'UnitRenameReferencesAction/Value',UnitRenameReferencesActionNames[urraAsk])); FAskForFilenameOnNewFile:=FXMLCfg.GetValue(Path+'AskForFilenameOnNewFile/Value',false); FLowercaseDefaultFilename:=FXMLCfg.GetValue(Path+'LowercaseDefaultFilename/Value',true); FMultipleInstances:=StrToIDEMultipleInstancesOption(FXMLCfg.GetValue(Path+'MultipleInstances/Value','')); // fpdoc FPDocPaths := FXMLCfg.GetValue(Path+'LazDoc/Paths',''); if FFileVersion<=105 then FPDocPaths:=LineBreaksToDelimiter(FPDocPaths,';'); // 'new items' FNewUnitTemplate:=FXMLCfg.GetValue(Path+'New/UnitTemplate/Value',FileDescNamePascalUnit); FNewFormTemplate:=FXMLCfg.GetValue(Path+'New/FormTemplate/Value',FileDescNameLCLForm); // object inspector FObjectInspectorOptions.Load; FObjectInspectorOptions.SaveBounds:=false; // IDEEditorGroups for i := 0 to IDEEditorGroups.Count-1 do begin Rec := IDEEditorGroups[i]; NodeName := Rec^.GroupClass.ClassName; Rec^.Collapsed := FXMLCfg.GetValue(Path+'OptionDialog/Tree/' + NodeName + '/Value', Rec^.DefaultCollapsed); if Rec^.Items <> nil then begin for j := 0 to Rec^.Items.Count-1 do begin Rec^.Items[j]^.Collapsed := FXMLCfg.GetValue(Path+'OptionDialog/Tree/' + NodeName + '/' + Rec^.Items[j]^.EditorClass.ClassName + '/Value', Rec^.Items[j]^.DefaultCollapsed); end; end; end; // The user can define many desktops. They are saved under path Desktops/. FDesktops.Clear; FDesktops.SetConfig(FXMLCfg, FConfigStore); FActiveDesktopName := ''; if FFileVersion<109 then begin //load old default desktop - backwards compatibility - or create a new default desktop CurPath := 'Desktop/'; // New place: Desktop/ if not FXMLCfg.HasPath(CurPath, True) then CurPath := Path+'Desktop/'; // Old place: EnvironmentOptions/Desktop/ if FXMLCfg.HasPath(CurPath, True) or//default desktop exists in the settings ((ActiveDesktop.IDECoolBarOptions.ToolBars.Count = 0) and (ActiveDesktop.FIDEDialogLayoutList.Count = 0))//desktop is empty, load it to recreate! then begin ActiveDesktop.SetConfig(FXMLCfg, FConfigStore); ActiveDesktop.Load(CurPath); end; end else begin CurPath := 'Desktops/'; FDebugDesktopName := FXMLCfg.GetValue(CurPath+'DebugDesktop', ''); FActiveDesktopName := FXMLCfg.GetValue(CurPath+'ActiveDesktop', ''); j := FXMLCfg.GetValue(CurPath+'Count', 1); for i := 1 to j do FDesktops.AddFromCfg(CurPath+'Desktop'+IntToStr(i)+'/'); end; if FFileVersion<=109 then begin FXMLCfg.DeletePath('Desktop'); FXMLCfg.DeletePath(CurPath+'Desktop'); end; Desktop.Assign(ActiveDesktop, False); Desktop.ExportSettingsToIDE(Self); FileUpdated; except on E: Exception do DebugLn('[TEnvironmentOptions.Load] error reading "',FFilename,'": '+E.Message); end; end; procedure TEnvironmentOptions.SaveNonDesktop(Path: String); procedure SaveBackupInfo(var BackupInfo: TBackupInfo; Path:string; DefaultBackupType: TBackupType); begin with BackupInfo do begin FXMLCfg.SetDeleteValue(Path+'Type',BackupTypeToName(BackupType),BackupTypeToName(DefaultBackupType)); FXMLCfg.SetDeleteValue(Path+'AdditionalExtension',AdditionalExtension,DefaultBackupAddExt); FXMLCfg.SetDeleteValue(Path+'MaxCounter',MaxCounter,DefaultBackupMaxCounter); FXMLCfg.SetDeleteValue(Path+'SubDirectory',SubDirectory,DefaultBackupSubDirectory); end; end; var BaseDir, CurLazDir: String; EventType: TDBGEventType; begin // files CurLazDir:=ChompPathDelim(LazarusDirectory); if not TTransferMacroList.StrHasMacros(CurLazDir) then begin BaseDir:=ExtractFilePath(ChompPathDelim(GetPrimaryConfigPath)); if PathIsInPath(CurLazDir,BaseDir) then begin // the pcp directory is in the lazarus directory // or the lazarus directory is a sibling or a sub dir of a sibling of the pcp // examples: // pcp=C:\Lazarus\config, lazdir=C:\Lazarus => store '..' // pcp=/home/user/.lazarus, lazdir=/home/user/freepascal/lazarus => store ../freepascal/lazarus CurLazDir:=CreateRelativePath(CurLazDir,GetPrimaryConfigPath); end; FXMLCfg.SetValue(Path+'LazarusDirectory/Value',CurLazDir); // always store, no SetDeleteValue end; SaveRecentList(FXMLCfg,FLazarusDirHistory,Path+'LazarusDirectory/History/'); FXMLCfg.SetDeleteValue(Path+'CompilerFilename/Value',CompilerFilename,''); SaveRecentList(FXMLCfg,FCompilerFileHistory,Path+'CompilerFilename/History/'); FXMLCfg.SetDeleteValue(Path+'FPCSourceDirectory/Value',FPCSourceDirectory,''); SaveRecentList(FXMLCfg,FFPCSourceDirHistory,Path+'FPCSourceDirectory/History/'); FXMLCfg.SetDeleteValue(Path+'MakeFilename/Value',MakeFilename,DefaultMakefilename); SaveRecentList(FXMLCfg,FMakeFileHistory,Path+'MakeFilename/History/'); FXMLCfg.SetDeleteValue(Path+'TestBuildDirectory/Value',TestBuildDirectory,''); SaveRecentList(FXMLCfg,FTestBuildDirHistory,Path+'TestBuildDirectory/History/'); FXMLCfg.SetDeleteValue(Path+'CompilerMessagesFilename/Value',CompilerMessagesFilename,''); SaveRecentList(FXMLCfg,FCompilerMessagesFileHistory,Path+'CompilerMessagesFilename/History/'); SaveRecentList(FXMLCfg,FManyBuildModesSelection,Path+'ManyBuildModesSelection/'); // Primary-config verification FXMLCfg.SetDeleteValue(Path+'LastCalledByLazarusFullPath/Value',FLastCalledByLazarusFullPath,''); // global buid options FConfigStore.AppendBasePath('BuildMatrix'); FBuildMatrixOptions.SaveToConfig(FConfigStore,IsGlobalMode); FConfigStore.UndoAppendBasePath; // Clean build project dialog FXMLCfg.SetDeleteValue(Path+'CleanBuild/ProjOut',FCleanBuildProjOut,true); FXMLCfg.SetDeleteValue(Path+'CleanBuild/ProjSrc',FCleanBuildProjSrc,true); FXMLCfg.SetDeleteValue(Path+'CleanBuild/PkgOut',FCleanBuildPkgOut,true); FXMLCfg.SetDeleteValue(Path+'CleanBuild/PkgSrc',FCleanBuildPkgSrc,true); // backup SaveBackupInfo(FBackupInfoProjectFiles,Path+'BackupProjectFiles/',DefaultBackupTypeProject); SaveBackupInfo(FBackupInfoOtherFiles,Path+'BackupOtherFiles/',DefaultBackupTypeOther); // debugger FDebuggerConfig.Save; SaveDebuggerPropertiesList; FXMLCfg.SetDeleteValue(Path+'DebuggerFilename/Value',DebuggerFilename,''); FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/ShowStopMessage/Value', FDebuggerShowStopMessage, True); FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/DebuggerResetAfterRun/Value', FDebuggerResetAfterRun, False); FXMLCfg.SetDeleteValue(Path+'DebuggerOptions/DebuggerAutoCloseAsm/Value', FDebuggerAutoCloseAsm, False); SaveRecentList(FXMLCfg,FDebuggerFileHistory,Path+'DebuggerFilename/History/'); FXMLCfg.SetDeleteValue(Path+'DebuggerSearchPath/Value',DebuggerSearchPath,''); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogClearOnRun',FDebuggerEventLogClearOnRun, True); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogCheckLineLimit',FDebuggerEventLogCheckLineLimit, False); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogLineLimit',FDebuggerEventLogLineLimit, 1000); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowBreakpoint',FDebuggerEventLogShowBreakpoint, False); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowProcess',FDebuggerEventLogShowProcess, True); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowThread',FDebuggerEventLogShowThread, True); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowModule',FDebuggerEventLogShowModule, False); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowOutput',FDebuggerEventLogShowOutput, True); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowWindows',FDebuggerEventLogShowWindows, False); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogShowDebugger',FDebuggerEventLogShowDebugger, True); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogUseColors',FDebuggerEventLogUseColors, True); for EventType := Low(TDBGEventType) to High(TDBGEventType) do begin FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogColors/' + GetEnumName(TypeInfo(EventType), Ord(EventType)) + '/Background', FDebuggerEventLogColors[EventType].Background, DebuggerDefaultColors[EventType].Background); FXMLCfg.SetDeleteValue(Path+'Debugger/EventLogColors/' + GetEnumName(TypeInfo(EventType), Ord(EventType)) + '/Foreground', FDebuggerEventLogColors[EventType].Foreground, DebuggerDefaultColors[EventType].Foreground); end; end; procedure TEnvironmentOptions.Save(OnlyDesktop: boolean); procedure SaveCCResult(const CCResult: TCodeCreationDlgResult; const Path: string; const DefaultClassSection: TInsertClassSection); begin FXMLCfg.SetDeleteValue(Path+'/ClassSection', InsertClassSectionNames[CCResult.ClassSection], InsertClassSectionNames[DefaultClassSection]); FXMLCfg.SetDeleteValue(Path+'/Location', CreateCodeLocationNames[CCResult.Location], CreateCodeLocationNames[cclLocal]); end; var Path, CurPath, NodeName: String; i, j: Integer; Rec: PIDEOptionsGroupRec; mwc: TMsgWndColor; u: TMessageLineUrgency; xSaveDesktop: TCustomDesktopOpt; xActiveDesktopName: string; begin try InitXMLCfg(true); // ToDo: Get rid of EnvironmentOptions/ path. The whole file is about // environment options. Many section are not under it any more. Path:='EnvironmentOptions/'; FXMLCfg.SetValue(Path+'Version/Value',EnvOptsVersion); FXMLCfg.SetValue(Path+'Version/Lazarus',LazarusVersionStr); // language FXMLCfg.SetDeleteValue(Path+'Language/ID',LanguageID,''); // auto save FXMLCfg.SetDeleteValue(Path+'AutoSave/AskSaveSessionOnly',FAskSaveSessionOnly,false); FXMLCfg.SetDeleteValue(Path+'AutoSave/EditorFiles',FAutoSaveEditorFiles,true); FXMLCfg.SetDeleteValue(Path+'AutoSave/Project',FAutoSaveProject,true); FXMLCfg.SetDeleteValue(Path+'AutoSave/IntervalInSecs',FAutoSaveIntervalInSecs,DefaultAutoSaveIntervalInSecs); FXMLCfg.SetDeleteValue(Path+'AutoSave/LastSavedProjectFile',FLastSavedProjectFile,''); FXMLCfg.SetDeleteValue(Path+'AutoSave/OpenLastProjectAtStart',FOpenLastProjectAtStart,true); FXMLCfg.SetDeleteValue(Path+'AutoSave/ActiveDesktop', FAutoSaveActiveDesktop, True); FXMLCfg.DeletePath(Path+'AutoSave/LastOpenPackages/'); if FOpenLastProjectAtStart then for i := 0 to FLastOpenPackages.Count-1 do FXMLCfg.SetValue(Path+'AutoSave/LastOpenPackages/Package'+IntToStr(i+1), FLastOpenPackages[i]); // form editor FXMLCfg.SetDeleteValue(Path+'FormEditor/ShowBorderSpacing',FShowBorderSpacing,false); FXMLCfg.SetDeleteValue(Path+'FormEditor/ShowGrid',FShowGrid,true); FXMLCfg.SetDeleteValue(Path+'FormEditor/GridColor',FGridColor,DefaultGridColor); FXMLCfg.SetDeleteValue(Path+'FormEditor/SnapToGrid',FSnapToGrid,true); FXMLCfg.SetDeleteValue(Path+'FormEditor/GridSizeX',FGridSizeX,DefaultGridSize); FXMLCfg.SetDeleteValue(Path+'FormEditor/GridSizeY',FGridSizeY,DefaultGridSize); FXMLCfg.SetDeleteValue(Path+'FormEditor/ShowGuideLines',FShowGuideLines,true); FXMLCfg.SetDeleteValue(Path+'FormEditor/SnapToGuideLines',FSnapToGuideLines,true); FXMLCfg.SetDeleteValue(Path+'FormEditor/GuideLineColorLeftTop',FGuideLineColorLeftTop,DefaultGuideLineColorLeftTop); FXMLCfg.SetDeleteValue(Path+'FormEditor/GuideLineColorRightBottom',FGuideLineColorRightBottom,DefaultGuideLineColorRightBottom); FXMLCfg.SetDeleteValue(Path+'FormEditor/ShowComponentCaptions',FShowComponentCaptions,true); FXMLCfg.SetDeleteValue(Path+'FormEditor/ShowEditorHints',FShowEditorHints,true); FXMLCfg.SetDeleteValue(Path+'FormEditor/AutoCreateFormsOnOpen',FAutoCreateFormsOnOpen,true); FXMLCfg.SetDeleteValue(Path+'FormEditor/CheckPackagesOnFormCreate',FCheckPackagesOnFormCreate,true); FXMLCfg.SetDeleteValue(Path+'FormEditor/RightClickSelects',FRightClickSelects,true); FXMLCfg.SetDeleteValue(Path+'FormEditor/GrabberColor/Value',FGrabberColor,clBlack); FXMLCfg.SetDeleteValue(Path+'FormEditor/MarkerColor/Value',FMarkerColor,clDkGray); FXMLCfg.SetDeleteValue(Path+'FormEditor/Rubberband/SelectionColor/Value', FRubberbandSelectionColor,clBlack); FXMLCfg.SetDeleteValue(Path+'FormEditor/Rubberband/CreationColor/Value', FRubberbandCreationColor,clRed); FXMLCfg.SetDeleteValue(Path+'FormEditor/Rubberband/SelectsGrandChilds/Value', FRubberbandSelectsGrandChilds,DefaultRubberbandSelectsGrandChilds); FXMLCfg.SetDeleteValue(Path+'FormEditor/DesignerPaint/Lazy/Value',FDesignerPaintLazy,true); FXMLCfg.SetDeleteValue(Path+'FormEditor/CreateComponentFocusNameProperty/Value', FCreateComponentFocusNameProperty,false); FXMLCfg.SetDeleteValue(Path+'FormEditor/SwitchToFavoritesOITab/Value',FSwitchToFavoritesOITab,false); FXMLCfg.SetDeleteValue(Path+'FormEditor/FormTitleBarChangesObjectInspector/Value',FFormTitleBarChangesObjectInspector,false); FXMLCfg.SetDeleteValue(Path+'FormEditor/ForceDPIScalingInDesignTime/Value',FForceDPIScalingInDesignTime,true); FXMLCfg.SetDeleteValue(Path+'ShowCompileDialog/Value',FShowCompileDialog,False); FXMLCfg.SetDeleteValue(Path+'AutoCloseCompileDialog/Value',FAutoCloseCompileDialog,False); if not OnlyDesktop then SaveNonDesktop(Path); // project inspector FXMLCfg.SetDeleteValue(Path+'ProjInspSortAlphabetically/Value',FProjInspSortAlphabetically,false); FXMLCfg.SetDeleteValue(Path+'ProjInspShowDirHierarchy/Value',FProjInspShowDirHierarchy,false); // package editor FXMLCfg.SetDeleteValue(Path+'PackageEditorSortAlphabetically/Value',FPackageEditorSortAlphabetically,false); FXMLCfg.SetDeleteValue(Path+'PackageEditorShowDirHierarchy/Value',FPackageEditorShowDirHierarchy,false); // procedure list FXMLCfg.SetDeleteValue(Path+'ProcedureListFilterStart/Value',FProcedureListFilterStart,false); // hints FXMLCfg.SetDeleteValue(Path+'CheckDiskChangesWithLoading/Value',FCheckDiskChangesWithLoading,false); FXMLCfg.SetDeleteValue(Path+'DiskChangesAutoCheckModified/Value',FDiskChangesAutoCheckModified,false); FXMLCfg.SetDeleteValue(Path+'ShowHintsForComponentPalette/Value',FShowHintsForComponentPalette,true); FXMLCfg.SetDeleteValue(Path+'ShowHintsForMainSpeedButtons/Value',FShowHintsForMainSpeedButtons,true); // messages view FXMLCfg.SetDeleteValue(Path+'MsgViewDblClickJumps/Value',fMsgViewDblClickJumps,false); FXMLCfg.SetDeleteValue(Path+'MsgViewFocus/Value',fMsgViewFocus,DefaultMsgViewFocus); FXMLCfg.SetDeleteValue(Path+'MsgView/ShowMessagesIcons/Value',FShowMessagesIcons,true); FXMLCfg.SetDeleteValue(Path+'MsgView/StayOnTop/Value',FMsgViewStayOnTop,false); FXMLCfg.SetDeleteValue(Path+'MsgView/ShowTranslations/Value',FMsgViewShowTranslations,false); FXMLCfg.SetDeleteValue(Path+'MsgView/AlwaysDrawFocused/Value',FMsgViewAlwaysDrawFocused,false); FXMLCfg.SetDeleteValue(Path+'MsgView/Filename/Style', MsgWndFileNameStyleNames[FMsgViewFilenameStyle], MsgWndFileNameStyleNames[mwfsShort]); for mwc:=low(TMsgWndColor) to high(TMsgWndColor) do FXMLCfg.SetDeleteValue(Path+'MsgView/Colors/'+MsgWndColorNames[mwc], fMsgViewColors[mwc],MsgWndDefaultColors[mwc]); for u:=low(TMessageLineUrgency) to high(TMessageLineUrgency) do FXMLCfg.SetDeleteValue(Path+'MsgView/MsgColors/'+dbgs(u), fMsgColors[u],clDefault); MsgViewFilters.SaveToXMLConfig(FXMLCfg,'MsgView/Filters/'); FXMLCfg.SetDeleteValue(Path+'MsgView/FPCMsg/ShowLinesCompiled',FMsgViewShowFPCMsgLinesCompiled,false); //component list FXMLCfg.SetDeleteValue(Path+'ComponentList/KeepOpen',FComponentListKeepOpen,false); // glyphs FXMLCfg.SetDeleteValue(Path+'ShowButtonGlyphs/Value',Ord(FShowButtonGlyphs), Ord(sbgSystem)); FXMLCfg.SetDeleteValue(Path+'ShowMenuGlyphs/Value',Ord(FShowMenuGlyphs), Ord(sbgSystem)); // recent files and directories FXMLCfg.SetDeleteValue(Path+'Recent/OpenFiles/Max',FMaxRecentOpenFiles,DefaultMaxRecentOpenFiles); SaveRecentList(FXMLCfg,FRecentOpenFiles,Path+'Recent/OpenFiles/',FMaxRecentOpenFiles); FXMLCfg.SetDeleteValue(Path+'Recent/ProjectFiles/Max',FMaxRecentProjectFiles,DefaultMaxRecentProjectFiles); SaveRecentList(FXMLCfg,FRecentProjectFiles,Path+'Recent/ProjectFiles/',FMaxRecentProjectFiles); FXMLCfg.SetDeleteValue(Path+'Recent/PackageFiles/Max',FMaxRecentPackageFiles,DefaultMaxRecentPackageFiles); SaveRecentList(FXMLCfg,FRecentPackageFiles,Path+'Recent/PackageFiles/',FMaxRecentPackageFiles); FXMLCfg.SetDeleteValue(Path+'Recent/AlreadyPopulated', FAlreadyPopulatedRecentFiles, false); // other recent settings SaveCCResult(FLastEventMethodCCResult, Path+'Recent/EventMethodCCResult', icsPublic); SaveCCResult(FLastVariableCCResult, Path+'Recent/VariableCCResult', icsPrivate); FXMLCfg.SetDeleteValue(Path+'Recent/UseUnitDlg/AllUnits',FUseUnitDlgOptions.AllUnits,False); FXMLCfg.SetDeleteValue(Path+'Recent/UseUnitDlg/AddToImplementation',FUseUnitDlgOptions.AddToImplementation,False); // external tools if Assigned(fExternalUserTools) then fExternalUserTools.Save(FConfigStore,Path+'ExternalTools/'); FXMLCfg.SetDeleteValue(Path+'ExternalTools/MaxInParallel',FMaxExtToolsInParallel,0); // naming FXMLCfg.SetDeleteValue(Path+'Naming/PascalFileExtension', PascalExtension[fPascalFileExtension],'.pas'); FXMLCfg.SetDeleteValue(Path+'CharcaseFileAction/Value', CharCaseFileActionNames[fCharcaseFileAction], CharCaseFileActionNames[ccfaAutoRename]); FXMLCfg.SetDeleteValue(Path+'AmbiguousFileAction/Value', AmbiguousFileActionNames[fAmbiguousFileAction], AmbiguousFileActionNames[afaAsk]); FXMLCfg.SetDeleteValue(Path+'AskForFilenameOnNewFile/Value', FAskForFilenameOnNewFile,false); FXMLCfg.SetDeleteValue(Path+'LowercaseDefaultFilename/Value', FLowercaseDefaultFilename,true); FXMLCfg.SetDeleteValue(Path+'MultipleInstances/Value', IDEMultipleInstancesOptionNames[FMultipleInstances], IDEMultipleInstancesOptionNames[DefaultIDEMultipleInstancesOption]); // fpdoc FXMLCfg.SetDeleteValue(Path+'LazDoc/Paths',FPDocPaths,''); // 'new items' FXMLCfg.SetDeleteValue(Path+'New/UnitTemplate/Value',FNewUnitTemplate,FileDescNamePascalUnit); FXMLCfg.SetDeleteValue(Path+'New/FormTemplate/Value',FNewFormTemplate,FileDescNameLCLForm); // object inspector FObjectInspectorOptions.SaveBounds:=false; FObjectInspectorOptions.Save; // IDEEditorGroups for i := 0 to IDEEditorGroups.Count-1 do begin Rec := IDEEditorGroups[i]; NodeName := Rec^.GroupClass.ClassName; FXMLCfg.SetDeleteValue(Path+'OptionDialog/Tree/' + NodeName + '/Value', Rec^.Collapsed, Rec^.DefaultCollapsed); if Rec^.Items <> nil then begin for j := 0 to Rec^.Items.Count-1 do begin FXMLCfg.SetDeleteValue(Path+'OptionDialog/Tree/' + NodeName + '/' + Rec^.Items[j]^.EditorClass.ClassName + '/Value', Rec^.Items[j]^.Collapsed, Rec^.Items[j]^.DefaultCollapsed); end; end; end; //automatically save active desktops if AutoSaveActiveDesktop and (Application.MainForm<>nil) and Application.MainForm.Visible then begin //save active desktop Desktop.ImportSettingsFromIDE(Self); ActiveDesktop.Assign(Desktop); if Assigned(FLastDesktopBeforeDebug) then//are we in debug session? begin //save last desktop before the debug desktop xSaveDesktop := FDesktops.Find(FLastDesktopBeforeDebug.Name); if Assigned(xSaveDesktop) and xSaveDesktop.InheritsFrom(TDesktopOpt) then TDesktopOpt(xSaveDesktop).Assign(FLastDesktopBeforeDebug, False); end; end; if Assigned(FLastDesktopBeforeDebug) then xActiveDesktopName := FLastDesktopBeforeDebug.Name else xActiveDesktopName := FActiveDesktopName; // The user can define many desktops. They are saved under path Desktops/. FXMLCfg.DeletePath('Desktops/'); CurPath:='Desktops/'; FXMLCfg.SetDeleteValue(CurPath+'Count', FDesktops.Count, 0); FXMLCfg.SetDeleteValue(CurPath+'DebugDesktop', FDebugDesktopName, ''); FXMLCfg.SetDeleteValue(CurPath+'ActiveDesktop', xActiveDesktopName, ''); for i := 0 to FDesktops.Count-1 do begin FDesktops[i].SetConfig(FXMLCfg, FConfigStore); FDesktops[i].Save(CurPath+'Desktop'+IntToStr(i+1)+'/'); end; FXMLCfg.Flush; FileUpdated; except on E: Exception do begin DebugLn('[TEnvironmentOptions.Save] error writing "',Filename,'": ',E.Message); end; end; end; function TEnvironmentOptions.GetDefaultConfigFilename: string; begin Result:=TrimFilename(AppendPathDelim(GetPrimaryConfigPath)+EnvOptsConfFileName); end; procedure TEnvironmentOptions.AddToRecentOpenFiles(const AFilename: string); var Allow: Boolean; begin Allow := True; DoAddToRecentOpenFiles(AFilename, Allow); if Allow then AddToRecentList(AFilename,FRecentOpenFiles,FMaxRecentOpenFiles,rltFile); end; procedure TEnvironmentOptions.AddToRecentPackageFiles(const AFilename: string); var Allow: Boolean; begin Allow := True; DoAddToRecentPackageFiles(AFilename, Allow); if Allow then AddToRecentList(AFilename,FRecentPackageFiles,FMaxRecentPackageFiles,rltFile); end; procedure TEnvironmentOptions.RemoveFromRecentOpenFiles(const AFilename: string); begin RemoveFromRecentList(AFilename,FRecentOpenFiles,rltFile); end; procedure TEnvironmentOptions.RemoveFromRecentPackageFiles(const AFilename: string); begin RemoveFromRecentList(AFilename,FRecentPackageFiles,rltFile); end; procedure TEnvironmentOptions.AddToRecentProjectFiles(const AFilename: string); var Allow: Boolean; begin Allow := True; DoAddToRecentProjectFiles(AFilename, Allow); if Allow then AddToRecentList(AFilename,FRecentProjectFiles,FMaxRecentProjectFiles,rltFile); {$ifdef Windows} SHAddToRecentDocs(SHARD_PATHW, PWideChar(UTF8ToUTF16(AFileName))); {$endif} end; procedure TEnvironmentOptions.RemoveFromRecentProjectFiles(const AFilename: string); begin RemoveFromRecentList(AFilename,FRecentProjectFiles,rltFile); end; function TEnvironmentOptions.GetParsedTestBuildDirectory: string; begin Result:=GetParsedValue(eopTestBuildDirectory); end; function TEnvironmentOptions.GetParsedFPCSourceDirectory(FPCVer: string): string; var s: String; begin if (FPCVer<>'') and (Pos('$(',FPCSourceDirectory)>0) then begin s:='$(FPCVer)'; GlobalMacroList.SubstituteStr(s); if s<>FPCVer then begin // override macro FPCVer OverrideFPCVer:=FPCVer; IncreaseCompilerParseStamp; try Result:=GetParsedValue(eopFPCSourceDirectory); //debugln(['TEnvironmentOptions.GetParsedFPCSourceDirectory FPCVer=',FPCVer,' FPCSrcDir=',Result]); finally OverrideFPCVer:=''; IncreaseCompilerParseStamp; end; exit; end; end; Result:=GetParsedValue(eopFPCSourceDirectory); end; function TEnvironmentOptions.GetParsedMakeFilename: string; begin Result:=GetParsedValue(eopMakeFilename); end; function TEnvironmentOptions.GetParsedCompilerMessagesFilename: string; begin Result:=GetParsedValue(eopCompilerMessagesFilename); end; function TEnvironmentOptions.GetParsedFPDocPaths: string; begin Result:=GetParsedValue(eopFPDocPaths); end; function TEnvironmentOptions.GetParsedDebuggerFilename: string; begin Result:=GetParsedValue(eopDebuggerFilename); end; function TEnvironmentOptions.GetParsedDebuggerSearchPath: string; begin Result:=GetParsedValue(eopDebuggerSearchPath); end; function TEnvironmentOptions.GetParsedValue(o: TEnvOptParseType): string; var SpacePos: SizeInt; CurParams: String; begin with FParseValues[o] do begin if (ParseStamp<>CompilerParseStamp) or (CompilerParseStamp=CTInvalidChangeStamp) then begin if Parsing then begin debugln(['TEnvironmentOptions.GetParsedValue circular macro dependency: ',dbgs(o)]); exit('circularmacroerror'); end; Parsing:=true; try ParsedValue:=UnparsedValue; if (ParsedValue='') and (o=eopCompilerMessagesFilename) then ParsedValue:=GetForcedPathDelims('$(FPCSrcDir)/compiler/msg/errore.msg'); if not GlobalMacroList.SubstituteStr(ParsedValue) then begin debugln(['TEnvironmentOptions.GetParsedValue failed for ',dbgs(o),' Value="',UnparsedValue,'"']); end; ParseStamp:=CompilerParseStamp; case o of eopLazarusDirectory: // lazarus directory begin ParsedValue:=TrimAndExpandDirectory(ParsedValue,GetPrimaryConfigPath); if ParsedValue='' then ParsedValue:=TrimFilename(AppendPathDelim(GetCurrentDirUTF8)); end; eopFPCSourceDirectory,eopTestBuildDirectory: // directory begin ParsedValue:=TrimAndExpandDirectory(ParsedValue,GetParsedLazarusDirectory); if ParsedValue='' then ParsedValue:=GetParsedLazarusDirectory; end; eopCompilerMessagesFilename: // data file begin ParsedValue:=TrimAndExpandFilename(ParsedValue,GetParsedLazarusDirectory); if (UnparsedValue='') and (not FileExistsCached(ParsedValue)) then begin // the default errore.msg file does not exist in the fpc sources // => use the fallback of the codetools ParsedValue:=AppendPathDelim(GetParsedLazarusDirectory) +GetForcedPathDelims('components/codetools/fpc.errore.msg'); end; end; eopFPDocPaths,eopDebuggerSearchPath: // search path ParsedValue:=TrimSearchPath(ParsedValue,GetParsedLazarusDirectory,true); eopCompilerFilename,eopMakeFilename,eopDebuggerFilename: // program begin ParsedValue:=Trim(ParsedValue); CurParams:=''; if (o in [eopDebuggerFilename]) then begin // program + params // examples: // gdb -v // "C:\public folder\gdb" SpacePos:=1; while (SpacePos<=length(ParsedValue)) do begin if ParsedValue[SpacePos]='"' then begin System.Delete(ParsedValue,1,1); // delete startng " while (SpacePos<=length(ParsedValue)) and (ParsedValue[SpacePos]<>'"') do inc(SpacePos); if SpacePos<=length(ParsedValue) then System.Delete(ParsedValue,1,1); // delete ending " end else if ParsedValue[SpacePos]=' ' then break else inc(SpacePos); end; CurParams:=copy(ParsedValue,SpacePos,length(ParsedValue)); system.Delete(ParsedValue,SpacePos,length(ParsedValue)); end; // program ParsedValue:=TrimFilename(ParsedValue); if (ParsedValue<>'') and (not FilenameIsAbsolute(ParsedValue)) then begin if (ExtractFilePath(ParsedValue)='') and (not FileExistsCached(GetParsedLazarusDirectory+ParsedValue)) then ParsedValue:=FindDefaultExecutablePath(ParsedValue) else ParsedValue:=TrimFilename(GetParsedLazarusDirectory+ParsedValue); end; // append parameters if CurParams<>'' then begin if System.Pos(' ',ParsedValue)>0 then ParsedValue:='"'+ParsedValue+'"'; ParsedValue+=CurParams; end; end; end; finally Parsing:=false; end; end; Result:=ParsedValue; end; end; function TEnvironmentOptions.GetParsedCompilerFilename: string; begin Result:=GetParsedValue(eopCompilerFilename); end; procedure TEnvironmentOptions.InitMacros(AMacroList: TTransferMacroList); begin AMacroList.Add(TTransferMacro.Create('FPCSrcDir','', lisFreePascalSourceDirectory,@MacroFuncFPCSrcDir,[])); AMacroList.Add(TTransferMacro.Create('LazarusDir','', lisLazarusDirectory,@MacroFuncLazarusDir,[])); AMacroList.Add(TTransferMacro.Create('ExeExt','', lisFileExtensionOfPrograms, @MacroFuncExeExt, [])); AMacroList.Add(TTransferMacro.Create('LanguageID','', lisLazarusLanguageID,@MacroFuncLanguageID,[])); AMacroList.Add(TTransferMacro.Create('LanguageName','', lisLazarusLanguageName,@MacroFuncLanguageName,[])); AMacroList.Add(TTransferMacro.Create('TestDir','', lisTestDirectory,@MacroFuncTestDir,[])); AMacroList.Add(TTransferMacro.Create('ConfDir','', lisConfigDirectory,@MacroFuncConfDir,[])); AMacroList.Add(TTransferMacro.Create('Home',GetUserDir, lisUserSHomeDirectory, nil, [])); end; function TEnvironmentOptions.MacroFuncFPCSrcDir(const s: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=GetParsedFPCSourceDirectory; end; function TEnvironmentOptions.MacroFuncLazarusDir(const s: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=GetParsedLazarusDirectory; end; function TEnvironmentOptions.MacroFuncExeExt(const s: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=GetExecutableExt; end; function TEnvironmentOptions.MacroFuncLanguageID(const s: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=LanguageID; end; function TEnvironmentOptions.MacroFuncLanguageName(const s: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=GetLazarusLanguageLocalizedName(LanguageID); end; function TEnvironmentOptions.MacroFuncTestDir(const s: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=GetParsedTestBuildDirectory; end; function TEnvironmentOptions.MacroFuncConfDir(const s: string; const Data: PtrInt; var Abort: boolean): string; begin Result:=GetPrimaryConfigPath; end; procedure TEnvironmentOptions.SaveDebuggerPropertiesList; var DProp, DDef: TDebuggerProperties; i: Integer; begin for i := 0 to FDebuggerProperties.Count - 1 do begin DProp := TDebuggerProperties(FDebuggerProperties.Objects[i]); DDef := TDebuggerPropertiesClass(DProp.ClassType).Create; FXMLCfg.WriteObject( 'EnvironmentOptions/Debugger/Class' + FDebuggerProperties[i] + '/Properties/', DProp, DDef); DDef.Free; end; end; procedure TEnvironmentOptions.SaveDebuggerProperties(DebuggerClass: String; Properties: TDebuggerProperties); var i: Integer; Prop: TDebuggerProperties; begin i := FDebuggerProperties.IndexOf(DebuggerClass); if i < 0 then begin Prop := TDebuggerPropertiesClass(Properties.ClassType).Create; Prop.Assign(Properties); FDebuggerProperties.AddObject(DebuggerClass, Prop); end else TDebuggerProperties(FDebuggerProperties.Objects[i]).Assign(Properties); end; procedure TEnvironmentOptions.LoadDebuggerProperties(DebuggerClass: String; Properties: TDebuggerProperties); var i: Integer; DDef: TDebuggerProperties; begin i := FDebuggerProperties.IndexOf(DebuggerClass); if i < 0 then begin DDef := TDebuggerPropertiesClass(Properties.ClassType).Create; FXMLCfg.ReadObject('EnvironmentOptions/Debugger/Class' + DebuggerClass + '/Properties/', Properties, DDef); DDef.Free; end else Properties.Assign(TDebuggerProperties(FDebuggerProperties.Objects[i])); end; function TEnvironmentOptions.FileHasChangedOnDisk: boolean; begin Result:=FFileHasChangedOnDisk or ((FFilename<>'') and (FFileAge<>0) and (FileAgeCached(FFilename)<>FFileAge)); FFileHasChangedOnDisk:=Result; end; procedure TEnvironmentOptions.InitXMLCfg(CleanConfig: boolean); begin if FileHasChangedOnDisk or (FXMLCfg=nil) then begin FreeAndNil(FConfigStore); FreeAndNil(FDbgConfigStore); FreeAndNil(FXMLCfg); if CleanConfig then FXMLCfg:=TRttiXMLConfig.CreateClean(Filename) else FXMLCfg:=TRttiXMLConfig.Create(Filename); FConfigStore:=TXMLOptionsStorage.Create(FXMLCfg); //ComponentPaletteOptions.ConfigStore:=FConfigStore; ObjectInspectorOptions.ConfigStore:=FConfigStore; FDbgConfigStore:=TXMLOptionsStorage.Create(FXMLCfg, 'EnvironmentOptions/Debugger/'); FDebuggerConfig.ConfigStore := FDbgConfigStore; end; end; procedure TEnvironmentOptions.FileUpdated; begin FFileHasChangedOnDisk:=false; if FFilename<>'' then FFileAge:=FileAgeCached(FFilename) else FFileAge:=0; end; function TEnvironmentOptions.GetActiveDesktop: TDesktopOpt; procedure ChooseDefault; begin //use default desktop name if Assigned(IDEDockMaster) then FActiveDesktopName := 'default docked'//name for desktop with AnchorDocking else FActiveDesktopName := 'default'; end; var OldActiveDesktopName: string; OldActiveDesktop, lDskTpOpt: TCustomDesktopOpt; begin Result := nil; if FActiveDesktopName <> '' then begin lDskTpOpt := FDesktops.Find(FActiveDesktopName); if Assigned(lDskTpOpt) and lDskTpOpt.InheritsFrom(TDesktopOpt) and lDskTpOpt.Compatible then Exit(TDesktopOpt(lDskTpOpt)); end; //the selected desktop is unsupported (docked/undocked) // -> use default OldActiveDesktopName := FActiveDesktopName; ChooseDefault; lDskTpOpt := FDesktops.Find(FActiveDesktopName); if Assigned(lDskTpOpt) and lDskTpOpt.InheritsFrom(TDesktopOpt) then if lDskTpOpt.Compatible then Exit(TDesktopOpt(lDskTpOpt)) else Result := TDesktopOpt(lDskTpOpt); //recreate desktop with ActiveDesktopName if Assigned(Result) then FDesktops.Remove(Result); Result := TDesktopOpt.Create(FActiveDesktopName); FDesktops.Add(Result); Result.Assign(Desktop); if Assigned(IDEDockMaster) then Result.FDockedOpt.LoadDefaults; OldActiveDesktop := FDesktops.Find(OldActiveDesktopName); if not (OldActiveDesktop is TDesktopOpt) then begin lDskTpOpt := FDesktops.Find('default'); if Assigned(lDskTpOpt) and lDskTpOpt.InheritsFrom(TDesktopOpt) and lDskTpOpt.Compatible then OldActiveDesktop := TDesktopOpt(lDskTpOpt) else OldActiveDesktop := nil; end; if Assigned(OldActiveDesktop) then Result.Assign(TDesktopOpt(OldActiveDesktop), False, False); end; procedure TEnvironmentOptions.SetTestBuildDirectory(const AValue: string); var NewValue: String; begin NewValue:=AppendPathDelim(TrimFilename(AValue)); SetParseValue(eopTestBuildDirectory,NewValue); end; procedure TEnvironmentOptions.UseDesktop(ADesktop: TDesktopOpt); function _ContainsControl(const _Parent, _Control: TWinControl): Boolean; var I: Integer; begin for I := 0 to _Parent.ControlCount-1 do if _Parent.Controls[I] is TWinControl then begin if (_Parent.Controls[I] = _Control) or _ContainsControl(TWinControl(_Parent.Controls[I]), _Control) then Exit(True); end; Result := False; end; var xLastFocusControl: TWinControl; xLastFocusForm: TCustomForm; begin xLastFocusControl := Screen.ActiveControl; xLastFocusForm := Screen.ActiveCustomForm; DoBeforeWrite(False); //this is needed to get the EditorToolBar refreshed!!! - needed only here in UseDesktop() Desktop.Assign(ADesktop); ActiveDesktopName := ADesktop.Name; if ADesktop.AssociatedDebugDesktopName<>'' then DebugDesktopName := ADesktop.AssociatedDebugDesktopName; Desktop.ExportSettingsToIDE(Self); DoAfterWrite(False); //this is needed to get the EditorToolBar refreshed!!! - needed only here in UseDesktop() Desktop.RestoreDesktop; //set focus back to the previously focused control if Screen.CustomFormIndex(xLastFocusForm) >= 0 then//check if form hasn't been destroyed begin if ((xLastFocusForm = xLastFocusControl) or _ContainsControl(xLastFocusForm, xLastFocusControl)) and//check if control hasn't been destroyed xLastFocusForm.CanFocus and xLastFocusControl.CanFocus then xLastFocusControl.SetFocus; end; end; procedure TEnvironmentOptions.SetLazarusDirectory(const AValue: string); var NewValue: String; begin NewValue:=AppendPathDelim(TrimFilename(AValue)); SetParseValue(eopLazarusDirectory,NewValue); end; procedure TEnvironmentOptions.SetMsgColors(u: TMessageLineUrgency; AValue: TColor); begin fMsgColors[u] := AValue; end; procedure TEnvironmentOptions.SetMsgViewColors(c: TMsgWndColor; AValue: TColor); begin fMsgViewColors[c]:=AValue; end; procedure TEnvironmentOptions.SetParseValue(o: TEnvOptParseType; const NewValue: string); begin with FParseValues[o] do begin if UnparsedValue=NewValue then exit; UnparsedValue:=NewValue; ParseStamp:=CTInvalidChangeStamp; IncreaseCompilerParseStamp; end; end; procedure TEnvironmentOptions.SetFPCSourceDirectory(const AValue: string); begin SetParseValue(eopFPCSourceDirectory,AValue); end; procedure TEnvironmentOptions.SetCompilerFilename(const AValue: string); begin SetParseValue(eopCompilerFilename,TrimFilename(AValue)); end; procedure TEnvironmentOptions.SetCompilerMessagesFilename(AValue: string); begin SetParseValue(eopCompilerMessagesFilename,TrimFilename(AValue)); end; function TEnvironmentOptions.GetDebuggerEventLogColors(AIndex: TDBGEventType): TDebuggerEventLogColor; begin Result := FDebuggerEventLogColors[AIndex]; end; function TEnvironmentOptions.GetDebuggerFilename: string; begin Result:=FParseValues[eopDebuggerFilename].UnparsedValue; end; function TEnvironmentOptions.GetDebuggerSearchPath: string; begin Result:=FParseValues[eopDebuggerSearchPath].UnparsedValue; end; function TEnvironmentOptions.GetCompilerFilename: string; begin Result:=FParseValues[eopCompilerFilename].UnparsedValue; end; function TEnvironmentOptions.GetCompilerMessagesFilename: string; begin Result:=FParseValues[eopCompilerMessagesFilename].UnparsedValue; end; function TEnvironmentOptions.GetDebugDesktop: TDesktopOpt; var lDskTpOpt: TCustomDesktopOpt; begin Result := nil; if FDebugDesktopName <> '' then begin lDskTpOpt := FDesktops.Find(FDebugDesktopName); if Assigned(lDskTpOpt) and lDskTpOpt.InheritsFrom(TDesktopOpt) and lDskTpOpt.Compatible then //do not mix docked/undocked desktops Result := TDesktopOpt(lDskTpOpt); end; end; function TEnvironmentOptions.GetFPCSourceDirectory: string; begin Result:=FParseValues[eopFPCSourceDirectory].UnparsedValue; end; function TEnvironmentOptions.GetFPDocPaths: string; begin Result:=FParseValues[eopFPDocPaths].UnparsedValue; end; function TEnvironmentOptions.GetLazarusDirectory: string; begin Result:=FParseValues[eopLazarusDirectory].UnparsedValue; end; function TEnvironmentOptions.GetMakeFilename: string; begin Result:=FParseValues[eopMakeFilename].UnparsedValue; end; function TEnvironmentOptions.GetMsgColors(u: TMessageLineUrgency): TColor; begin Result:=fMsgColors[u]; end; function TEnvironmentOptions.GetMsgViewColors(c: TMsgWndColor): TColor; begin Result:=fMsgViewColors[c]; end; function TEnvironmentOptions.GetTestBuildDirectory: string; begin Result:=FParseValues[eopTestBuildDirectory].UnparsedValue; end; procedure TEnvironmentOptions.SetDebuggerEventLogColors(AIndex: TDBGEventType; const AValue: TDebuggerEventLogColor); begin FDebuggerEventLogColors[AIndex] := AValue; end; procedure TEnvironmentOptions.SetDebuggerSearchPath(const AValue: string); begin SetParseValue(eopDebuggerSearchPath,TrimSearchPath(AValue,'')); end; procedure TEnvironmentOptions.SetFPDocPaths(const AValue: string); begin SetParseValue(eopFPDocPaths,TrimSearchPath(AValue,'')); end; procedure TEnvironmentOptions.SetMakeFilename(const AValue: string); begin SetParseValue(eopMakeFilename,TrimFilename(AValue)); end; procedure TEnvironmentOptions.SetDebuggerFilename(AValue: string); begin SetParseValue(eopDebuggerFilename,UTF8Trim(AValue)); end; initialization RegisterIDEOptionsGroup(GroupEnvironment, TEnvironmentOptions); end.