diff --git a/converter/chgencodingdlg.pas b/converter/chgencodingdlg.pas index 692882e49a..3f548c6bc3 100644 --- a/converter/chgencodingdlg.pas +++ b/converter/chgencodingdlg.pas @@ -41,7 +41,8 @@ uses // IDEIntf IDEWindowIntf, SrcEditorIntf, IDEHelpIntf, IDEImagesIntf, // IDE - IDEProcs, PackageDefs, PackageSystem, Project, LazarusIDEStrConsts, EnvironmentOpts; + IDEProcs, PackageDefs, PackageSystem, Project, LazarusIDEStrConsts, + EnvironmentOpts, SearchPathProcs; type diff --git a/converter/convertdelphi.pas b/converter/convertdelphi.pas index 56c95177bd..5211314e5c 100644 --- a/converter/convertdelphi.pas +++ b/converter/convertdelphi.pas @@ -44,8 +44,9 @@ uses ComponentReg, IDEDialogs, LazIDEIntf, PackageIntf, ProjectIntf, IDEExternToolIntf, IDEOptEditorIntf, // IDE - IDEProcs, DialogProcs, CompilerOptions, ProjPackCommon, Project, ProjectDescriptorTypes, - PackageDefs, PackageSystem, PackageEditor, BasePkgManager, LazarusIDEStrConsts, + IDEProcs, DialogProcs, CompilerOptions, ProjPackCommon, Project, + ProjectDescriptorTypes, PackageDefs, PackageSystem, PackageEditor, + BasePkgManager, LazarusIDEStrConsts, SearchPathProcs, // Converter ConverterTypes, ConvertSettings, ConvCodeTool, MissingUnits, MissingPropertiesDlg, UsedUnits; diff --git a/debugger/breakpropertydlg.pas b/debugger/breakpropertydlg.pas index 9e45228096..288421b7ca 100644 --- a/debugger/breakpropertydlg.pas +++ b/debugger/breakpropertydlg.pas @@ -15,8 +15,8 @@ uses // DebuggerIntf DbgIntfDebuggerBase, // IDE - BreakPropertyDlgGroups, DebuggerDlg, Debugger, - BaseDebugManager, LazarusIDEStrConsts, InputHistory, IDEProcs, EnvironmentOpts; + BreakPropertyDlgGroups, DebuggerDlg, Debugger, BaseDebugManager, + LazarusIDEStrConsts, InputHistory, IDEProcs, EnvironmentOpts, RecentListProcs; type diff --git a/debugger/evaluatedlg.pp b/debugger/evaluatedlg.pp index 64fbc4ea3e..f2f4f5c874 100644 --- a/debugger/evaluatedlg.pp +++ b/debugger/evaluatedlg.pp @@ -49,7 +49,7 @@ uses LazarusIDEStrConsts, BaseDebugManager, InputHistory, IDEProcs, Debugger, IdeDebuggerWatchResPrinter, IdeDebuggerWatchResult, IdeDebuggerOpts, IdeDebuggerBackendValueConv, WatchInspectToolbar, DebuggerDlg, DebuggerStrConst, - IdeDebuggerStringConstants, IdeDebuggerBase, EnvironmentOpts; + IdeDebuggerStringConstants, IdeDebuggerBase, EnvironmentOpts, RecentListProcs; type diff --git a/debugger/frames/debugger_general_options.pas b/debugger/frames/debugger_general_options.pas index 33a1c6ec7e..aefa0cd3c8 100644 --- a/debugger/frames/debugger_general_options.pas +++ b/debugger/frames/debugger_general_options.pas @@ -34,7 +34,7 @@ uses IDEOptionsIntf, IDEOptEditorIntf, // IDE LazarusIDEStrConsts, PathEditorDlg, IDEProcs, - EnvironmentOpts, BaseDebugManager, IdeDebuggerOpts; + EnvironmentOpts, BaseDebugManager, IdeDebuggerOpts, SearchPathProcs; type diff --git a/debugger/inspectdlg.pas b/debugger/inspectdlg.pas index 4ab4359e02..4dc2284b8b 100644 --- a/debugger/inspectdlg.pas +++ b/debugger/inspectdlg.pas @@ -42,7 +42,7 @@ uses IdeDebuggerWatchResPrinter, IdeDebuggerWatchResult, IdeDebuggerWatchResUtils, IdeDebuggerBase, ArrayNavigationFrame, IdeDebuggerOpts, IdeDebuggerBackendValueConv, WatchInspectToolbar, DebuggerDlg, - DebuggerStrConst, EnvironmentOpts; + DebuggerStrConst, EnvironmentOpts, RecentListProcs; type diff --git a/ide/buildmanager.pas b/ide/buildmanager.pas index 1e866c3894..92098f4ff4 100644 --- a/ide/buildmanager.pas +++ b/ide/buildmanager.pas @@ -50,12 +50,12 @@ uses // IDEIntf IDEDialogs, LazIDEIntf, IDEMsgIntf, SrcEditorIntf, // IDE - IDECmdLine, LazarusIDEStrConsts, DialogProcs, IDEProcs, - InputHistory, EditDefineTree, ProjectResources, MiscOptions, LazConf, - EnvironmentOpts, TransferMacros, CompilerOptions, - ExtTools, etMakeMsgParser, etFPCMsgParser, etPas2jsMsgParser, - Compiler, FPCSrcScan, PackageDefs, PackageSystem, Project, ProjectIcon, - ModeMatrixOpts, BaseBuildManager, ApplicationBundle, RunParamsOpts; + IDECmdLine, LazarusIDEStrConsts, DialogProcs, IDEProcs, InputHistory, + EditDefineTree, ProjectResources, MiscOptions, LazConf, EnvironmentOpts, + TransferMacros, CompilerOptions, ExtTools, etMakeMsgParser, etFPCMsgParser, + etPas2jsMsgParser, Compiler, FPCSrcScan, PackageDefs, PackageSystem, Project, + ProjectIcon, ModeMatrixOpts, BaseBuildManager, ApplicationBundle, + RunParamsOpts, SearchPathProcs; const cInvalidCompiler = 'InvalidCompiler'; diff --git a/ide/buildmodesmanager.pas b/ide/buildmodesmanager.pas index 682471531d..1fd11b318c 100644 --- a/ide/buildmodesmanager.pas +++ b/ide/buildmodesmanager.pas @@ -41,7 +41,8 @@ uses // IDE MainBase, MainBar, BasePkgManager, PackageDefs, Project, CompilerOptions, EnvironmentOpts, TransferMacros, BaseBuildManager, Compiler_ModeMatrix, - BuildModeDiffDlg, GenericCheckList, IDEProcs, LazarusIDEStrConsts; + BuildModeDiffDlg, GenericCheckList, IDEProcs, LazarusIDEStrConsts, + SearchPathProcs; type diff --git a/ide/buildprofilemanager.pas b/ide/buildprofilemanager.pas index 4ee29c87c5..f0abf078f9 100644 --- a/ide/buildprofilemanager.pas +++ b/ide/buildprofilemanager.pas @@ -42,7 +42,8 @@ uses // IdeIntf IDEImagesIntf, IDEHelpIntf, IDEDialogs, // IDE - LazarusIDEStrConsts, IDEProcs, TransferMacros, EnvironmentOpts; + LazarusIDEStrConsts, IDEProcs, TransferMacros, EnvironmentOpts, + IdeXmlConfigProcs; type diff --git a/ide/buildprojectdlg.pas b/ide/buildprojectdlg.pas index 23ac4ba3d0..9508de8bd6 100644 --- a/ide/buildprojectdlg.pas +++ b/ide/buildprojectdlg.pas @@ -39,7 +39,7 @@ uses IDEDialogs, IDEImagesIntf, PackageIntf, // IDE PackageDefs, PackageSystem, InputHistory, LazarusIDEStrConsts, Project, - EnvironmentOpts, IDEProcs; + EnvironmentOpts, IDEProcs, RecentListProcs; type TBuildProjectDialogItem = class diff --git a/ide/checkcompileropts.pas b/ide/checkcompileropts.pas index 34d695d8a5..cb81a31af2 100644 --- a/ide/checkcompileropts.pas +++ b/ide/checkcompileropts.pas @@ -43,8 +43,8 @@ uses ProjectIntf, MacroIntf, IDEExternToolIntf, LazIDEIntf, IDEDialogs, PackageIntf, IDEMsgIntf, // IDE - Project, PackageSystem, IDEProcs, - LazarusIDEStrConsts, PackageDefs, CompilerOptions, TransferMacros; + Project, PackageSystem, IDEProcs, LazarusIDEStrConsts, PackageDefs, + CompilerOptions, TransferMacros, SearchPathProcs; type TCompilerOptionsTest = ( diff --git a/ide/cleandirdlg.pas b/ide/cleandirdlg.pas index 306ce1d481..222e32babb 100644 --- a/ide/cleandirdlg.pas +++ b/ide/cleandirdlg.pas @@ -39,7 +39,7 @@ uses IDEWindowIntf, IDEHelpIntf, IDEDialogs, // IDE IDEProcs, LazarusIDEStrConsts, LazConf, TransferMacros, InputHistory, - ShowDeletingFilesDlg, EnvironmentOpts; + ShowDeletingFilesDlg, EnvironmentOpts, RecentListProcs; type diff --git a/ide/codeexplopts.pas b/ide/codeexplopts.pas index 08c0613e87..afcf1e8b35 100644 --- a/ide/codeexplopts.pas +++ b/ide/codeexplopts.pas @@ -45,7 +45,7 @@ uses // IDEIntf IDEOptionsIntf, IDEOptEditorIntf, // IDE - LazConf, IDEProcs, LazarusIDEStrConsts; + LazConf, IDEProcs, LazarusIDEStrConsts, IdeXmlConfigProcs; type { TCodeExplorerOptions } diff --git a/ide/codehelp.pas b/ide/codehelp.pas index c1c9c70b43..ed638cf85b 100644 --- a/ide/codehelp.pas +++ b/ide/codehelp.pas @@ -56,8 +56,8 @@ uses IDECommands, IDEMsgIntf, MacroIntf, PackageIntf, LazHelpIntf, ProjectIntf, IDEDialogs, IDEHelpIntf, LazIDEIntf, IDEExternToolIntf, // IDE - EditorOptions, LazarusIDEStrConsts, IDEProcs, PackageDefs, - EnvironmentOpts, TransferMacros, PackageSystem, DialogProcs, KeyMapping; + EditorOptions, LazarusIDEStrConsts, IDEProcs, PackageDefs, EnvironmentOpts, + TransferMacros, PackageSystem, DialogProcs, KeyMapping, SearchPathProcs; const IDEProjectName = 'Lazarus'; diff --git a/ide/codetoolsdefpreview.pas b/ide/codetoolsdefpreview.pas index 1cf3ec336a..e6d71566fe 100644 --- a/ide/codetoolsdefpreview.pas +++ b/ide/codetoolsdefpreview.pas @@ -42,7 +42,8 @@ uses // IdeIntf IDEWindowIntf, IDEHelpIntf, // IDE - EditorOptions, LazarusIDEStrConsts, InputHistory, CodeToolsOptions, IDEProcs, EnvironmentOpts; + EditorOptions, LazarusIDEStrConsts, InputHistory, CodeToolsOptions, IDEProcs, + EnvironmentOpts, RecentListProcs; type TCodeToolsDefinesNodeValues = class diff --git a/ide/compileroptions.pp b/ide/compileroptions.pp index 53c31b12bf..61565839e8 100644 --- a/ide/compileroptions.pp +++ b/ide/compileroptions.pp @@ -56,7 +56,8 @@ uses IDEOptionsIntf, // IDE LazarusIDEStrConsts, IDEProcs, LazConf, TransferMacros, etFPCMsgParser, - IDECmdLine, ModeMatrixOpts, CompOptsModes, EnvironmentOpts; + IDECmdLine, ModeMatrixOpts, CompOptsModes, EnvironmentOpts, SearchPathProcs, + IdeXmlConfigProcs; const DefaultCompilerPath = '$(CompPath)'; diff --git a/ide/environmentopts.pp b/ide/environmentopts.pp index fddbc94b5e..64195d45cf 100644 --- a/ide/environmentopts.pp +++ b/ide/environmentopts.pp @@ -51,7 +51,7 @@ uses // DebuggerIntf DbgIntfDebuggerBase, // IDE - IDEProcs, LazarusIDEStrConsts, IDETranslations, LazConf, + RecentListProcs, SearchPathProcs, LazarusIDEStrConsts, IDETranslations, LazConf, IDEOptionDefs, TransferMacros, ModeMatrixOpts, IdeCoolbarData, EditorToolbarStatic, IdeDebuggerOpts; @@ -89,6 +89,14 @@ const //---------------------------------------------------------------------------- +type + TParseString = record + UnparsedValue: string; + ParsedValue: string; + ParseStamp: integer; + Parsing: boolean; + end; + { Backup } type TBackupType = ( diff --git a/ide/findinfilesdlg.pas b/ide/findinfilesdlg.pas index 2cba70a664..dbf2895add 100644 --- a/ide/findinfilesdlg.pas +++ b/ide/findinfilesdlg.pas @@ -31,7 +31,7 @@ uses ProjectGroupIntf, // IDE LazarusIDEStrConsts, InputHistory, InputhistoryWithSearchOpt, EditorOptions, Project, - IDEProcs, SearchFrm, SearchResultView, EnvironmentOpts; + IDEProcs, SearchFrm, SearchResultView, EnvironmentOpts, SearchPathProcs; type { TLazFindInFilesDialog } diff --git a/ide/findunitdlg.pas b/ide/findunitdlg.pas index db076e56e3..77a1f7aeed 100644 --- a/ide/findunitdlg.pas +++ b/ide/findunitdlg.pas @@ -42,7 +42,7 @@ uses LazIDEIntf, IDEMsgIntf, PackageLinkIntf, PackageIntf, IDEExternToolIntf, // IDE DialogProcs, PackageDefs, Project, IDEProcs, LazarusIDEStrConsts, - etFPCMsgParser, PackageLinks, PackageSystem, BasePkgManager; + etFPCMsgParser, SearchPathProcs, PackageLinks, PackageSystem, BasePkgManager; type TFindUnitDialog = class; diff --git a/ide/frames/compiler_compilation_options.pas b/ide/frames/compiler_compilation_options.pas index 781181614b..a0fdcde346 100644 --- a/ide/frames/compiler_compilation_options.pas +++ b/ide/frames/compiler_compilation_options.pas @@ -18,7 +18,8 @@ uses IDEDialogs, IDEUtils, // IDE Project, CompilerOptions, PackageDefs, LazarusIDEStrConsts, EnvironmentOpts, - LazConf, IDEProcs, DialogProcs, InputHistory, InitialSetupProc; + LazConf, IDEProcs, DialogProcs, InputHistory, InitialSetupProc, + RecentListProcs; type diff --git a/ide/frames/compiler_path_options.pas b/ide/frames/compiler_path_options.pas index 88226b3eb7..3904270d15 100644 --- a/ide/frames/compiler_path_options.pas +++ b/ide/frames/compiler_path_options.pas @@ -14,7 +14,7 @@ uses IDEOptionsIntf, IDEOptEditorIntf, MacroIntf, CompOptsIntf, IDEImagesIntf, IDEDialogs, // IDE Project, CompilerOptions, LazarusIDEStrConsts, PathEditorDlg, IDEProcs, - CheckCompilerOpts, ShowCompilerOpts, ImExportCompilerOpts; + CheckCompilerOpts, ShowCompilerOpts, ImExportCompilerOpts, SearchPathProcs; type diff --git a/ide/ideprocs.pp b/ide/ideprocs.pp index 080d07d9ee..fd426ba218 100644 --- a/ide/ideprocs.pp +++ b/ide/ideprocs.pp @@ -71,79 +71,7 @@ procedure ResolveLinksInFileList(List: TStrings; RemoveDanglingLinks: Boolean); function FindProgram(ProgramName, BaseDirectory: string; WithBaseDirectory: boolean): string; -// search paths -function TrimSearchPath(const SearchPath, BaseDirectory: string; - DeleteDoubles: boolean = false; ExpandPaths: boolean = false): string; -function MergeSearchPaths(const OldSearchPath, AddSearchPath: string): string; -procedure MergeSearchPaths(SearchPath: TStrings; const AddSearchPath: string); -function RemoveSearchPaths(const SearchPath, RemoveSearchPath: string): string; -function RemoveNonExistingPaths(const SearchPath, BaseDirectory: string): string; -function RebaseSearchPath(const SearchPath, - OldBaseDirectory, NewBaseDirectory: string; - SkipPathsStartingWithMacro: boolean): string; -function ShortenSearchPath(const SearchPath, BaseDirectory, - ChompDirectory: string): string; -function GetNextDirectoryInSearchPath(const SearchPath: string; - var NextStartPos: integer): string; -function GetNextUsedDirectoryInSearchPath(const SearchPath, - FilterDir: string; var NextStartPos: integer): string; -function SearchPathToList(const SearchPath: string): TStringList; -function SearchDirectoryInSearchPath(const SearchPath, Directory: string; - DirStartPos: integer = 1): integer; -function SearchDirectoryInSearchPath(SearchPath: TStrings; - const Directory: string; DirStartPos: integer = 0): integer; - -// Recent item lists -type - TRecentListType = ( - rltCaseSensitive, - rltCaseInsensitive, - rltFile - ); -const - RecentListTypeNames: array[TRecentListType] of string = ( - 'CaseSensitive', - 'CaseInsensitive', - 'File' - ); -function IndexInRecentList(List: TStrings; ListType: TRecentListType; - const Path: string): integer; -function StrToRecentListType(s: string): TRecentListType; -function CompareRecentListItem(s1, s2: string; ListType: TRecentListType): boolean; -procedure LoadRecentList(XMLConfig: TXMLConfig; List: TStrings; const Path: string; - ListType: TRecentListType); -procedure SaveRecentList(XMLConfig: TXMLConfig; List: TStrings; - const Path: string); overload; -procedure SaveRecentList(XMLConfig: TXMLConfig; List: TStrings; - const Path: string; aMax: Integer); overload; -function AddToRecentList(const s: string; List: TStrings; aMax: integer; - ListType: TRecentListType): boolean; -function AddComboTextToRecentList(cb: TCombobox; aMax: integer; - ListType: TRecentListType): boolean; -procedure RemoveFromRecentList(const s: string; List: TStrings; - ListType: TRecentListType); -procedure CleanUpRecentList(List: TStrings; ListType: TRecentListType); - // XMLconfig -procedure LoadRect(XMLConfig: TXMLConfig; const Path:string; - var ARect:TRect); -procedure LoadRect(XMLConfig: TXMLConfig; const Path:string; - var ARect:TRect; const DefaultRect: TRect); -procedure SaveRect(XMLConfig: TXMLConfig; const Path:string; - const ARect: TRect); -procedure SaveRect(XMLConfig: TXMLConfig; const Path:string; - const ARect, DefaultRect: TRect); -procedure LoadPoint(XMLConfig: TXMLConfig; const Path:string; - var APoint:TPoint; const DefaultPoint: TPoint); -procedure SavePoint(XMLConfig: TXMLConfig; const Path:string; - const APoint, DefaultPoint:TPoint); -procedure LoadStringList(XMLConfig: TXMLConfig; List: TStrings; const Path: string); -procedure SaveStringList(XMLConfig: TXMLConfig; List: TStrings; const Path: string); -procedure LoadStringToStringTree(XMLConfig: TXMLConfig; - Tree: TStringToStringTree; const Path: string); -procedure SaveStringToStringTree(XMLConfig: TXMLConfig; - Tree: TStringToStringTree; const Path: string); -procedure MakeXMLName(var Name: string); function LoadXMLConfigViaCodeBuffer(Filename: string): TXMLConfig; // Point conversion @@ -151,14 +79,6 @@ function PointToCfgStr(const Point: TPoint): string; procedure CfgStrToPoint(const s: string; var Point: TPoint; const DefaultPoint: TPoint); // environment -type - TParseString = record - UnparsedValue: string; - ParsedValue: string; - ParseStamp: integer; - Parsing: boolean; - end; - function GetCurrentUserName: string; function GetCurrentChangeLog: string; function GetProgramSearchPath: string; @@ -289,406 +209,6 @@ begin end; end; -function MergeSearchPaths(const OldSearchPath, AddSearchPath: string): string; -var - l: Integer; - EndPos: Integer; - StartPos: Integer; - NewPath: String; -begin - Result:=OldSearchPath; - if Result='' then begin - Result:=AddSearchPath; - exit; - end; - l:=length(AddSearchPath); - EndPos:=1; - while EndPos<=l do begin - StartPos:=EndPos; - while (AddSearchPath[StartPos]=';') do begin - inc(StartPos); - if StartPos>l then exit; - end; - EndPos:=StartPos; - while (EndPos<=l) and (AddSearchPath[EndPos]<>';') do inc(EndPos); - if SearchDirectoryInSearchPath(Result,AddSearchPath,StartPos)<1 then - begin - // new path found -> add - NewPath:=copy(AddSearchPath,StartPos,EndPos-StartPos); - if Result<>'' then - NewPath:=';'+NewPath; - Result:=Result+NewPath; - end; - end; -end; - -procedure MergeSearchPaths(SearchPath: TStrings; const AddSearchPath: string); -var - l: Integer; - EndPos: Integer; - StartPos: Integer; -begin - l:=length(AddSearchPath); - EndPos:=1; - while EndPos<=l do begin - StartPos:=EndPos; - while (AddSearchPath[StartPos]=';') do begin - inc(StartPos); - if StartPos>l then exit; - end; - EndPos:=StartPos; - while (EndPos<=l) and (AddSearchPath[EndPos]<>';') do inc(EndPos); - if SearchDirectoryInSearchPath(SearchPath,AddSearchPath,StartPos)<1 then - begin - // new path found -> add - SearchPath.Add(copy(AddSearchPath,StartPos,EndPos-StartPos)); - end; - end; -end; - -function RemoveSearchPaths(const SearchPath, RemoveSearchPath: string): string; -var - OldPathLen: Integer; - EndPos: Integer; - StartPos: Integer; - ResultStartPos: Integer; -begin - Result:=SearchPath; - OldPathLen:=length(SearchPath); - EndPos:=1; - ResultStartPos:=1; - repeat - StartPos:=EndPos; - while (StartPos<=OldPathLen) and (SearchPath[StartPos]=';') do - inc(StartPos); - if StartPos>OldPathLen then break; - EndPos:=StartPos; - while (EndPos<=OldPathLen) and (SearchPath[EndPos]<>';') do - inc(EndPos); - //DebugLn('RemoveSearchPaths Dir="',copy(SearchPath,StartPos,EndPos-StartPos),'" RemoveSearchPath="',RemoveSearchPath,'"'); - if SearchDirectoryInSearchPath(RemoveSearchPath,SearchPath,StartPos)>0 then - begin - // remove path -> skip - end else begin - // keep path -> copy - if ResultStartPos>1 then begin - Result[ResultStartPos]:=';'; - inc(ResultStartPos); - end; - while StartPoslength(Result) then break; - EndPos:=StartPos; - while (EndPos<=length(Result)) and (Result[EndPos]<>';') do - inc(EndPos); - if EndPos>StartPos then begin - CurPath:=copy(Result,StartPos,EndPos-StartPos); - if (not FilenameIsAbsolute(CurPath)) - and ((not SkipPathsStartingWithMacro) or (CurPath[1]<>'$')) - then begin - CurPath:=TrimFilename(AppendPathDelim(OldBaseDirectory)+CurPath); - CurPath:=CreateRelativePath(CurPath,NewBaseDirectory); - Result:=copy(Result,1,StartPos-1)+CurPath - +copy(Result,EndPos,length(Result)); - EndPos:=StartPos+length(CurPath); - end; - end; - until false; -end; - -function ShortenSearchPath(const SearchPath, BaseDirectory, - ChompDirectory: string): string; -// Every search path that is a subdirectory of ChompDirectory will be shortened. -// Before the test relative paths are expanded by BaseDirectory. -var - BaseEqualsChompDir: boolean; - - function Normalize(var ADirectory: string): boolean; - begin - if FilenameIsAbsolute(ADirectory) then begin - Result:=true; - end else begin - if BaseEqualsChompDir then - Result:=false - else begin - Result:=true; - ADirectory:=AppendPathDelim(BaseDirectory)+ADirectory; - end; - end; - if Result then - ADirectory:=AppendPathDelim(TrimFilename(ADirectory)); - end; - -var - PathLen: Integer; - EndPos: Integer; - StartPos: Integer; - CurDir: String; - NewCurDir: String; - DiffLen: Integer; -begin - Result:=SearchPath; - if (SearchPath='') or (ChompDirectory='') then exit; - - PathLen:=length(Result); - EndPos:=1; - BaseEqualsChompDir:=CompareFilenames(BaseDirectory,ChompDirectory)=0; - while EndPos<=PathLen do begin - StartPos:=EndPos; - while (Result[StartPos] in [';',#0..#32]) do begin - inc(StartPos); - if StartPos>PathLen then exit; - end; - EndPos:=StartPos; - while (EndPos<=PathLen) and (Result[EndPos]<>';') do inc(EndPos); - CurDir:=copy(Result,StartPos,EndPos-StartPos); - NewCurDir:=CurDir; - if Normalize(NewCurDir) then begin - if CompareFilenames(NewCurDir,ChompDirectory)=0 then - NewCurDir:='.' - else if FileIsInPath(NewCurDir,ChompDirectory) then - NewCurDir:=AppendPathDelim(CreateRelativePath(NewCurDir,BaseDirectory)); - if NewCurDir<>CurDir then begin - DiffLen:=length(NewCurDir)-length(CurDir); - Result:=copy(Result,1,StartPos-1)+NewCurDir - +copy(Result,EndPos,PathLen-EndPos+1); - inc(EndPos,DiffLen); - inc(PathLen,DiffLen); - end; - end; - StartPos:=EndPos; - end; -end; - -function GetNextDirectoryInSearchPath(const SearchPath: string; - var NextStartPos: integer): string; -var - PathLen: Integer; - CurStartPos: Integer; -begin - PathLen:=length(SearchPath); - if PathLen>0 then begin - repeat - while (NextStartPos<=PathLen) - and (SearchPath[NextStartPos] in [';',#0..#32]) do - inc(NextStartPos); - CurStartPos:=NextStartPos; - while (NextStartPos<=PathLen) and (SearchPath[NextStartPos]<>';') do - inc(NextStartPos); - Result:=TrimFilename(copy(SearchPath,CurStartPos,NextStartPos-CurStartPos)); - if Result<>'' then exit; - until (NextStartPos>PathLen); - end else begin - NextStartPos:=1; - end; - Result:=''; -end; - -function GetNextUsedDirectoryInSearchPath(const SearchPath, - FilterDir: string; var NextStartPos: integer): string; -// searches next directory in search path, -// which is equal to FilterDir or is in FilterDir -begin - while (NextStartPos<=length(SearchPath)) do begin - Result:=GetNextDirectoryInSearchPath(SearchPath,NextStartPos); - if (Result<>'') and PathIsInPath(Result,FilterDir) then - exit; - end; - Result:='' -end; - -function SearchPathToList(const SearchPath: string): TStringList; -var - p: Integer; - CurDir: String; -begin - Result:=TStringList.Create; - p:=1; - repeat - CurDir:=GetNextDirectoryInSearchPath(SearchPath,p); - if CurDir='' then break; - Result.Add(CurDir); - until false; -end; - -function SearchDirectoryInSearchPath(const SearchPath, Directory: string; - DirStartPos: integer): integer; -// -1 on not found -var - PathLen: Integer; - DirLen: Integer; - EndPos: Integer; - StartPos: Integer; - DirEndPos: Integer; - CurDirLen: Integer; - CurDirEndPos: Integer; -begin - Result:=-1; - DirLen:=length(Directory); - if (SearchPath='') - or (Directory='') or (DirStartPos>DirLen) or (Directory[DirStartPos]=';') then - exit; - DirEndPos:=DirStartPos; - while (DirEndPos<=DirLen) and (Directory[DirEndPos]<>';') do inc(DirEndPos); - // ignore PathDelim at end - if (DirEndPos>DirStartPos) and (Directory[DirEndPos-1]=PathDelim) then begin - while (DirEndPos>DirStartPos) and (Directory[DirEndPos-1]=PathDelim) do - dec(DirEndPos); - // check if it is the root path '/' - if DirEndPos=DirStartPos then DirEndPos:=DirStartPos+1; - end; - CurDirLen:=DirEndPos-DirStartPos; - //DebugLn('SearchDirectoryInSearchPath Dir="',copy(Directory,DirStartPos,CurDirLen),'"'); - PathLen:=length(SearchPath); - EndPos:=1; - while EndPos<=PathLen do begin - StartPos:=EndPos; - while (SearchPath[StartPos] in [';',#0..#32]) do begin - inc(StartPos); - if StartPos>PathLen then exit; - end; - EndPos:=StartPos; - while (EndPos<=PathLen) and (SearchPath[EndPos]<>';') do inc(EndPos); - CurDirEndPos:=EndPos; - // ignore PathDelim at end - if (CurDirEndPos>StartPos) and (SearchPath[CurDirEndPos-1]=PathDelim) then - begin - while (CurDirEndPos>StartPos) and (SearchPath[CurDirEndPos-1]=PathDelim) - do - dec(CurDirEndPos); - // check if it is the root path '/' - if CurDirEndPos=StartPos then CurDirEndPos:=StartPos+1; - end; - //DebugLn('SearchDirectoryInSearchPath CurDir="',copy(SearchPath,StartPos,CurDirEndPos-StartPos),'"'); - if CurDirEndPos-StartPos=CurDirLen then begin - // directories have same length -> compare chars - if FileUtil.CompareFilenames(@SearchPath[StartPos],CurDirLen, - @Directory[DirStartPos],CurDirLen, - false)=0 - then begin - // directory found - Result:=StartPos; - exit; - end; - end; - StartPos:=EndPos; - end; -end; - -function SearchDirectoryInSearchPath(SearchPath: TStrings; - const Directory: string; DirStartPos: integer): integer; -var - DirLen: Integer; - DirEndPos: Integer; - CurDirLen: Integer; - CurPath: string; - CurPathLen: Integer; -begin - Result:=-1; - DirLen:=length(Directory); - if (SearchPath.Count=0) - or (Directory='') or (DirStartPos>DirLen) or (Directory[DirStartPos]=';') then - exit; - DirEndPos:=DirStartPos; - while (DirEndPos<=DirLen) and (Directory[DirEndPos]<>';') do inc(DirEndPos); - // ignore PathDelim at end - if (DirEndPos>DirStartPos) and (Directory[DirEndPos-1]=PathDelim) then begin - while (DirEndPos>DirStartPos) and (Directory[DirEndPos-1]=PathDelim) do - dec(DirEndPos); - // check if it is the root path '/' - if DirEndPos=DirStartPos then DirEndPos:=DirStartPos+1; - end; - CurDirLen:=DirEndPos-DirStartPos; - - // search in all search paths - Result:=SearchPath.Count-1; - while Result>=0 do begin - CurPath:=SearchPath[Result]; - CurPathLen:=length(CurPath); - if CurPathLen>0 then - begin - while (CurPathLen>1) and (CurPath[CurPathLen]=PathDelim) do dec(CurPathLen); - end; - if (CurPathLen>0) - and (FileUtil.CompareFilenames(@CurPath[1],CurPathLen, - @Directory[DirStartPos],CurDirLen, - false)=0) - then begin - // directory found - exit; - end; - dec(Result); - end; -end; - -function RemoveNonExistingPaths(const SearchPath, BaseDirectory: string): string; -var - StartPos: Integer; - EndPos: LongInt; - CurPath: String; - MacroStartPos: LongInt; -begin - Result:=SearchPath; - StartPos:=1; - while StartPos<=length(Result) do begin - EndPos:=StartPos; - while (EndPos<=length(Result)) and (Result[EndPos]=';') do inc(EndPos); - if EndPos>StartPos then begin - // empty paths, e.g. ;;;; - // remove - Result:=copy(Result,1,StartPos-1)+copy(Result,EndPos,length(Result)); - EndPos:=StartPos; - end; - while (EndPos<=length(Result)) and (Result[EndPos]<>';') do inc(EndPos); - - CurPath:=copy(Result,StartPos,EndPos-StartPos); - - // cut macros - MacroStartPos:=System.Pos('$(',CurPath); - if MacroStartPos>0 then begin - CurPath:=copy(CurPath,1,MacroStartPos-1); - if (CurPath<>'') and (CurPath[length(CurPath)]<>PathDelim) then - CurPath:=ExtractFilePath(CurPath); - end; - - // make path absolute - if (CurPath<>'') and (not FilenameIsAbsolute(CurPath)) then - CurPath:=AppendPathDelim(BaseDirectory)+CurPath; - - if ((CurPath='') and (MacroStartPos<1)) - or (not DirPathExistsCached(CurPath)) then begin - // path does not exist -> remove - Result:=copy(Result,1,StartPos-1)+copy(Result,EndPos+1,length(Result)); - EndPos:=StartPos; - end else begin - StartPos:=EndPos+1; - end; - end; -end; - function StringToBuildMethod(const BuildMethod: string): TBuildMethod; begin if BuildMethod=SBuildMethod[bmFPMake] then @@ -738,194 +258,8 @@ begin FindCloseUTF8(FileInfo); end; -// Recent item lists : - -function IndexInRecentList(List: TStrings; ListType: TRecentListType; - const Path: string): integer; -begin - Result:=List.Count-1; - while (Result>=0) and (not CompareRecentListItem(List[Result],Path,ListType)) do - dec(Result); -end; - -function StrToRecentListType(s: string): TRecentListType; -begin - for Result:=Low(TRecentListType) to high(TRecentListType) do - if SysUtils.CompareText(s,RecentListTypeNames[Result])=0 then exit; - Result:=rltCaseSensitive; -end; - -function CompareRecentListItem(s1, s2: string; ListType: TRecentListType): boolean; -begin - case ListType of - rltCaseInsensitive: Result:=UTF8CompareLatinTextFast(s1,s2)=0; - rltFile: Result:=CompareFilenames(ChompPathDelim(s1),ChompPathDelim(s2))=0; - else Result:=s1=s2; - end; -end; - -procedure LoadRecentList(XMLConfig: TXMLConfig; List: TStrings; - const Path: string; ListType: TRecentListType); -begin - LoadStringList(XMLConfig,List,Path); - CleanUpRecentList(List,ListType); -end; - -procedure SaveRecentList(XMLConfig: TXMLConfig; List: TStrings; const Path: string); -begin - SaveStringList(XMLConfig,List,Path); -end; - -procedure SaveRecentList(XMLConfig: TXMLConfig; List: TStrings; - const Path: string; aMax: Integer); -var - i: Integer; - s: String; -begin - if aMax>0 then - while List.Count>aMax do // Truncate list to aMax items. - List.Delete(List.Count-1); - SaveStringList(XMLConfig,List,Path); - i:=List.Count+1; - while True do - begin - s:=Path+'Item'+IntToStr(i); - if not XMLConfig.HasPath(s+'/Value',True) then Break; - XMLConfig.DeletePath(s); // Remove excess items from XML. - Inc(i); - end; -end; - -function AddToRecentList(const s: string; List: TStrings; aMax: integer; - ListType: TRecentListType): boolean; -begin - if (List.Count>0) and CompareRecentListItem(List[0],s,ListType) then - exit(false); - Result:=true; - RemoveFromRecentList(s,List,ListType); - List.Insert(0,s); - if aMax>0 then - while List.Count>aMax do - List.Delete(List.Count-1); -end; - -function AddComboTextToRecentList(cb: TCombobox; aMax: integer; - ListType: TRecentListType): boolean; -var - List: TStringList; -begin - List:=TStringList.Create; - try - List.Assign(cb.Items); - Result:=AddToRecentList(cb.Text,List,aMax,ListType); - if Result then - begin - cb.Items.Assign(List); - cb.ItemIndex:=0; - end; - finally - List.Free; - end; -end; - -procedure RemoveFromRecentList(const s: string; List: TStrings; - ListType: TRecentListType); -var - i: integer; -begin - for i:=List.Count-1 downto 0 do - if CompareRecentListItem(List[i],s,ListType) then - List.Delete(i); -end; - -procedure CleanUpRecentList(List: TStrings; ListType: TRecentListType); -var - i: Integer; -begin - for i:=List.Count-1 downto 1 do - if (List[i]='') or CompareRecentListItem(List[i],List[i-1],ListType) then - List.Delete(i); -end; - // XMLConfig -procedure LoadStringList(XMLConfig: TXMLConfig; List: TStrings; const Path: string); -var - i,Count: integer; - s: string; -begin - Count:=XMLConfig.GetValue(Path+'Count',0); - List.Clear; - for i:=1 to Count do begin - s:=XMLConfig.GetValue(Path+'Item'+IntToStr(i)+'/Value',''); - if s<>'' then List.Add(s); - end; -end; - -procedure SaveStringList(XMLConfig: TXMLConfig; List: TStrings; const Path: string); -var - i: integer; -begin - XMLConfig.SetDeleteValue(Path+'Count',List.Count,0); - for i:=0 to List.Count-1 do - XMLConfig.SetDeleteValue(Path+'Item'+IntToStr(i+1)+'/Value',List[i],''); -end; - -procedure LoadStringToStringTree(XMLConfig: TXMLConfig; - Tree: TStringToStringTree; const Path: string); -var - Cnt: LongInt; - SubPath: String; - CurName: String; - CurValue: String; - i: Integer; -begin - Tree.Clear; - Cnt:=XMLConfig.GetValue(Path+'Count',0); - for i:=0 to Cnt-1 do begin - SubPath:=Path+'Item'+IntToStr(i)+'/'; - CurName:=XMLConfig.GetValue(SubPath+'Name',''); - CurValue:=XMLConfig.GetValue(SubPath+'Value',''); - Tree.Values[CurName]:=CurValue; - end; -end; - -procedure SaveStringToStringTree(XMLConfig: TXMLConfig; - Tree: TStringToStringTree; const Path: string); -var - Node: TAvlTreeNode; - Item: PStringToStringItem; - i: Integer; - SubPath: String; -begin - XMLConfig.SetDeleteValue(Path+'Count',Tree.Tree.Count,0); - Node:=Tree.Tree.FindLowest; - i:=0; - while Node<>nil do begin - Item:=PStringToStringItem(Node.Data); - SubPath:=Path+'Item'+IntToStr(i)+'/'; - XMLConfig.SetDeleteValue(SubPath+'Name',Item^.Name,''); - XMLConfig.SetDeleteValue(SubPath+'Value',Item^.Value,''); - Node:=Tree.Tree.FindSuccessor(Node); - inc(i); - end; -end; - -procedure MakeXMLName(var Name: string); -var - i: Integer; -begin - i:=1; - while i<=length(Name) do begin - if (Name[i] in ['a'..'z','A'..'Z','_']) - or (i>1) and (Name[i] in ['0'..'9']) then begin - inc(i); - end else begin - System.Delete(Name,i,1); - end; - end; -end; - function LoadXMLConfigViaCodeBuffer(Filename: string): TXMLConfig; var Code: TCodeBuffer; @@ -942,49 +276,6 @@ begin end; end; -procedure LoadRect(XMLConfig: TXMLConfig; const Path: string; - var ARect: TRect); -begin - LoadRect(XMLConfig,Path,ARect,Rect(0,0,0,0)); -end; - -procedure LoadRect(XMLConfig: TXMLConfig; const Path:string; var ARect:TRect; - const DefaultRect: TRect); -begin - ARect.Left:=XMLConfig.GetValue(Path+'Left',DefaultRect.Left); - ARect.Top:=XMLConfig.GetValue(Path+'Top',DefaultRect.Top); - ARect.Right:=XMLConfig.GetValue(Path+'Right',DefaultRect.Right); - ARect.Bottom:=XMLConfig.GetValue(Path+'Bottom',DefaultRect.Bottom); -end; - -procedure SaveRect(XMLConfig: TXMLConfig; const Path: string; const ARect: TRect); -begin - SaveRect(XMLConfig,Path,ARect,Rect(0,0,0,0)); -end; - -procedure SaveRect(XMLConfig: TXMLConfig; const Path:string; - const ARect, DefaultRect: TRect); -begin - XMLConfig.SetDeleteValue(Path+'Left',ARect.Left,DefaultRect.Left); - XMLConfig.SetDeleteValue(Path+'Top',ARect.Top,DefaultRect.Top); - XMLConfig.SetDeleteValue(Path+'Right',ARect.Right,DefaultRect.Right); - XMLConfig.SetDeleteValue(Path+'Bottom',ARect.Bottom,DefaultRect.Bottom); -end; - -procedure LoadPoint(XMLConfig: TXMLConfig; const Path: string; - var APoint: TPoint; const DefaultPoint: TPoint); -begin - APoint.X:=XMLConfig.GetValue(Path+'X',DefaultPoint.X); - APoint.Y:=XMLConfig.GetValue(Path+'Y',DefaultPoint.Y); -end; - -procedure SavePoint(XMLConfig: TXMLConfig; const Path: string; - const APoint, DefaultPoint: TPoint); -begin - XMLConfig.SetDeleteValue(Path+'X',APoint.X,DefaultPoint.X); - XMLConfig.SetDeleteValue(Path+'Y',APoint.Y,DefaultPoint.Y); -end; - procedure CheckList(List: TList; TestListNil, TestDoubles, TestNils: boolean); var Cnt: Integer; @@ -1137,58 +428,6 @@ begin List.Free; end; -{------------------------------------------------------------------------------- - function TrimSearchPath(const SearchPath, BaseDirectory: string): boolean; - - - Removes empty paths. - - Uses TrimFilename on every path. - - If BaseDirectory<>'' then every relative Filename will be expanded. - - removes doubles --------------------------------------------------------------------------------} -function TrimSearchPath(const SearchPath, BaseDirectory: string; - DeleteDoubles: boolean; ExpandPaths: boolean): string; -var - CurPath: String; - EndPos: Integer; - StartPos: Integer; - len: Integer; - BaseDir: String; -begin - Result:=''; - EndPos:=1; - len:=length(SearchPath); - BaseDir:=AppendPathDelim(TrimFilename(BaseDirectory)); - while EndPos<=len do begin - StartPos:=EndPos; - // skip empty paths and space chars at start - while (StartPos<=len) and (SearchPath[StartPos] in [';',#0..#32]) do - inc(StartPos); - if StartPos>len then break; - EndPos:=StartPos; - while (EndPos<=len) and (SearchPath[EndPos]<>';') do inc(EndPos); - CurPath:=copy(SearchPath,StartPos,EndPos-StartPos); - if CurPath<>'' then begin - // non empty path => expand, trim and normalize - if ExpandPaths then - CurPath:=TrimAndExpandDirectory(CurPath,BaseDir) - else if (BaseDir<>'') and (not FilenameIsAbsolute(CurPath)) then - CurPath:=BaseDir+CurPath; - CurPath:=ChompPathDelim(TrimFilename(CurPath)); - if CurPath='' then CurPath:='.'; - // check if path already exists - if (not DeleteDoubles) or (SearchDirectoryInSearchPath(Result,CurPath)<1) - then begin - if Result<>'' then - CurPath:=';'+CurPath; - if CurPath<>'' then - Result:=Result+CurPath - else - Result:=Result+'.'; - end; - end; - end; -end; - {------------------------------------------------------------------------------- BackupFileForWrite diff --git a/ide/imexportcompileropts.pas b/ide/imexportcompileropts.pas index 0f2704f664..ff603354c7 100644 --- a/ide/imexportcompileropts.pas +++ b/ide/imexportcompileropts.pas @@ -40,7 +40,8 @@ uses // IdeIntf IDEOptEditorIntf, IDEImagesIntf, // IDE - IDEProcs, LazarusIDEStrConsts, InputHistory, Project, CompilerOptions; + IDEProcs, LazarusIDEStrConsts, InputHistory, Project, CompilerOptions, + RecentListProcs; type { TImExportCompOptsDlg } diff --git a/ide/inputhistory.pas b/ide/inputhistory.pas index 1b9eddaf6b..e5f3d9c4fe 100644 --- a/ide/inputhistory.pas +++ b/ide/inputhistory.pas @@ -47,7 +47,7 @@ uses // IdeIntf ProjectIntf, IDEDialogs, // IDE - DiffPatch, LazConf, IDEProcs; + DiffPatch, LazConf, IDEProcs, RecentListProcs, IdeXmlConfigProcs; {$ifdef Windows} {$define CaseInsensitiveFilenames} diff --git a/ide/lazbuild.lpi b/ide/lazbuild.lpi index ce0aaf980a..1e4d4542f2 100644 --- a/ide/lazbuild.lpi +++ b/ide/lazbuild.lpi @@ -49,19 +49,22 @@ - + - + - + - + - + + + + diff --git a/ide/main.pp b/ide/main.pp index 92a94a0588..75907c8aec 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -113,6 +113,8 @@ uses etQuickFixes, etMessageFrame, etMessagesWnd, // converter ChgEncodingDlg, ConvertDelphi, MissingPropertiesDlg, LazXMLForms, + // IdeConfig + IdeConfig, // environment option frames editor_general_options, componentpalette_options, formed_options, OI_options, MsgWnd_Options, Files_Options, Desktop_Options, window_options, IdeStartup_Options, @@ -162,7 +164,7 @@ uses SourceFileManager, EditorToolbarStatic, IDEInstances, NotifyProcessEnd, WordCompletion, // main ide - MainBar, MainIntf, MainBase; + MainBar, MainIntf, MainBase, SearchPathProcs; type { TMainIDE } diff --git a/ide/makeresstrdlg.pas b/ide/makeresstrdlg.pas index 0312f223b3..8840dae839 100644 --- a/ide/makeresstrdlg.pas +++ b/ide/makeresstrdlg.pas @@ -49,7 +49,8 @@ uses // IdeIntf IDEWindowIntf, IDEHelpIntf, IDEDialogs, // IDE - LazarusIDEStrConsts, EditorOptions, InputHistory, MiscOptions, IDEProcs; + LazarusIDEStrConsts, EditorOptions, InputHistory, MiscOptions, IDEProcs, + RecentListProcs; type diff --git a/ide/miscoptions.pas b/ide/miscoptions.pas index fdb30b8540..1eca4570cf 100644 --- a/ide/miscoptions.pas +++ b/ide/miscoptions.pas @@ -31,7 +31,7 @@ interface uses Classes, SysUtils, LCLProc, BuildProfileManager, CodeToolsStructs, TextTools, - LazFileUtils, Laz2_XMLCfg, LazFileCache, LazConf, IDEProcs; + LazFileUtils, Laz2_XMLCfg, LazFileCache, LazConf, IDEProcs, IdeXmlConfigProcs; type { TFindRenameIdentifierOptions } diff --git a/ide/multipastedlg.pas b/ide/multipastedlg.pas index 77b4e3e49a..b81ac03b15 100644 --- a/ide/multipastedlg.pas +++ b/ide/multipastedlg.pas @@ -47,7 +47,7 @@ uses // IdeIntf IDEHelpIntf, // IDE - InputHistory, IDEProcs, LazarusIDEStrConsts, EnvironmentOpts; + InputHistory, IDEProcs, LazarusIDEStrConsts, EnvironmentOpts, RecentListProcs; const hlFormatPasteTxtBefore = 'FormatPasteTxtBefore'; diff --git a/ide/packages/ideconfig/ideconfig.lpk b/ide/packages/ideconfig/ideconfig.lpk index 245d2c28fe..c178f51930 100644 --- a/ide/packages/ideconfig/ideconfig.lpk +++ b/ide/packages/ideconfig/ideconfig.lpk @@ -9,7 +9,7 @@ - + + + + + + + + + + + + + + + + + + + + + diff --git a/ide/packages/ideconfig/ideconfig.pas b/ide/packages/ideconfig/ideconfig.pas index dca64d9bf9..9a747ba1e7 100644 --- a/ide/packages/ideconfig/ideconfig.pas +++ b/ide/packages/ideconfig/ideconfig.pas @@ -8,7 +8,7 @@ unit IdeConfig; interface uses - LazarusPackageIntf; + SearchPathProcs, RecentListProcs, IdeXmlConfigProcs, LazarusPackageIntf; implementation diff --git a/ide/packages/ideconfig/idexmlconfigprocs.pas b/ide/packages/ideconfig/idexmlconfigprocs.pas new file mode 100644 index 0000000000..3f5b93ae8d --- /dev/null +++ b/ide/packages/ideconfig/idexmlconfigprocs.pas @@ -0,0 +1,153 @@ +unit IdeXmlConfigProcs; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Laz2_XMLCfg, Laz_AVL_Tree, AvgLvlTree; + +procedure LoadStringList(XMLConfig: TXMLConfig; List: TStrings; const Path: string); +procedure SaveStringList(XMLConfig: TXMLConfig; List: TStrings; const Path: string); +procedure LoadRect(XMLConfig: TXMLConfig; const Path:string; + var ARect:TRect); +procedure LoadRect(XMLConfig: TXMLConfig; const Path:string; + var ARect:TRect; const DefaultRect: TRect); +procedure SaveRect(XMLConfig: TXMLConfig; const Path:string; + const ARect: TRect); +procedure SaveRect(XMLConfig: TXMLConfig; const Path:string; + const ARect, DefaultRect: TRect); +procedure LoadPoint(XMLConfig: TXMLConfig; const Path:string; + var APoint:TPoint; const DefaultPoint: TPoint); +procedure SavePoint(XMLConfig: TXMLConfig; const Path:string; + const APoint, DefaultPoint:TPoint); +procedure LoadStringToStringTree(XMLConfig: TXMLConfig; + Tree: TStringToStringTree; const Path: string); +procedure SaveStringToStringTree(XMLConfig: TXMLConfig; + Tree: TStringToStringTree; const Path: string); +procedure MakeXMLName(var Name: string); + +implementation + +procedure LoadStringList(XMLConfig: TXMLConfig; List: TStrings; const Path: string); +var + i,Count: integer; + s: string; +begin + Count:=XMLConfig.GetValue(Path+'Count',0); + List.Clear; + for i:=1 to Count do begin + s:=XMLConfig.GetValue(Path+'Item'+IntToStr(i)+'/Value',''); + if s<>'' then List.Add(s); + end; +end; + +procedure SaveStringList(XMLConfig: TXMLConfig; List: TStrings; const Path: string); +var + i: integer; +begin + XMLConfig.SetDeleteValue(Path+'Count',List.Count,0); + for i:=0 to List.Count-1 do + XMLConfig.SetDeleteValue(Path+'Item'+IntToStr(i+1)+'/Value',List[i],''); +end; + +procedure LoadRect(XMLConfig: TXMLConfig; const Path: string; + var ARect: TRect); +begin + LoadRect(XMLConfig,Path,ARect,Rect(0,0,0,0)); +end; + +procedure LoadRect(XMLConfig: TXMLConfig; const Path:string; var ARect:TRect; + const DefaultRect: TRect); +begin + ARect.Left:=XMLConfig.GetValue(Path+'Left',DefaultRect.Left); + ARect.Top:=XMLConfig.GetValue(Path+'Top',DefaultRect.Top); + ARect.Right:=XMLConfig.GetValue(Path+'Right',DefaultRect.Right); + ARect.Bottom:=XMLConfig.GetValue(Path+'Bottom',DefaultRect.Bottom); +end; + +procedure SaveRect(XMLConfig: TXMLConfig; const Path: string; const ARect: TRect); +begin + SaveRect(XMLConfig,Path,ARect,Rect(0,0,0,0)); +end; + +procedure SaveRect(XMLConfig: TXMLConfig; const Path:string; + const ARect, DefaultRect: TRect); +begin + XMLConfig.SetDeleteValue(Path+'Left',ARect.Left,DefaultRect.Left); + XMLConfig.SetDeleteValue(Path+'Top',ARect.Top,DefaultRect.Top); + XMLConfig.SetDeleteValue(Path+'Right',ARect.Right,DefaultRect.Right); + XMLConfig.SetDeleteValue(Path+'Bottom',ARect.Bottom,DefaultRect.Bottom); +end; + +procedure LoadPoint(XMLConfig: TXMLConfig; const Path: string; + var APoint: TPoint; const DefaultPoint: TPoint); +begin + APoint.X:=XMLConfig.GetValue(Path+'X',DefaultPoint.X); + APoint.Y:=XMLConfig.GetValue(Path+'Y',DefaultPoint.Y); +end; + +procedure SavePoint(XMLConfig: TXMLConfig; const Path: string; + const APoint, DefaultPoint: TPoint); +begin + XMLConfig.SetDeleteValue(Path+'X',APoint.X,DefaultPoint.X); + XMLConfig.SetDeleteValue(Path+'Y',APoint.Y,DefaultPoint.Y); +end; + +procedure LoadStringToStringTree(XMLConfig: TXMLConfig; + Tree: TStringToStringTree; const Path: string); +var + Cnt: LongInt; + SubPath: String; + CurName: String; + CurValue: String; + i: Integer; +begin + Tree.Clear; + Cnt:=XMLConfig.GetValue(Path+'Count',0); + for i:=0 to Cnt-1 do begin + SubPath:=Path+'Item'+IntToStr(i)+'/'; + CurName:=XMLConfig.GetValue(SubPath+'Name',''); + CurValue:=XMLConfig.GetValue(SubPath+'Value',''); + Tree.Values[CurName]:=CurValue; + end; +end; + +procedure SaveStringToStringTree(XMLConfig: TXMLConfig; + Tree: TStringToStringTree; const Path: string); +var + Node: TAVLTreeNode; + Item: PStringToStringItem; + i: Integer; + SubPath: String; +begin + XMLConfig.SetDeleteValue(Path+'Count',Tree.Tree.Count,0); + Node:=Tree.Tree.FindLowest; + i:=0; + while Node<>nil do begin + Item:=PStringToStringItem(Node.Data); + SubPath:=Path+'Item'+IntToStr(i)+'/'; + XMLConfig.SetDeleteValue(SubPath+'Name',Item^.Name,''); + XMLConfig.SetDeleteValue(SubPath+'Value',Item^.Value,''); + Node:=Tree.Tree.FindSuccessor(Node); + inc(i); + end; +end; + +procedure MakeXMLName(var Name: string); +var + i: Integer; +begin + i:=1; + while i<=length(Name) do begin + if (Name[i] in ['a'..'z','A'..'Z','_']) + or (i>1) and (Name[i] in ['0'..'9']) then begin + inc(i); + end else begin + System.Delete(Name,i,1); + end; + end; +end; + +end. + diff --git a/ide/packages/ideconfig/recentlistprocs.pas b/ide/packages/ideconfig/recentlistprocs.pas new file mode 100644 index 0000000000..ffc8388c5a --- /dev/null +++ b/ide/packages/ideconfig/recentlistprocs.pas @@ -0,0 +1,154 @@ +unit RecentListProcs; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Laz2_XMLCfg, LazUTF8, LazFileUtils, StdCtrls, + IdeXmlConfigProcs; + +// Recent item lists +type + TRecentListType = ( + rltCaseSensitive, + rltCaseInsensitive, + rltFile + ); +const + RecentListTypeNames: array[TRecentListType] of string = ( + 'CaseSensitive', + 'CaseInsensitive', + 'File' + ); +function IndexInRecentList(List: TStrings; ListType: TRecentListType; + const Path: string): integer; +function StrToRecentListType(s: string): TRecentListType; +function CompareRecentListItem(s1, s2: string; ListType: TRecentListType): boolean; +procedure LoadRecentList(XMLConfig: TXMLConfig; List: TStrings; const Path: string; + ListType: TRecentListType); +procedure SaveRecentList(XMLConfig: TXMLConfig; List: TStrings; + const Path: string); overload; +procedure SaveRecentList(XMLConfig: TXMLConfig; List: TStrings; + const Path: string; aMax: Integer); overload; +function AddToRecentList(const s: string; List: TStrings; aMax: integer; + ListType: TRecentListType): boolean; +function AddComboTextToRecentList(cb: TComboBox; aMax: integer; + ListType: TRecentListType): boolean; +procedure RemoveFromRecentList(const s: string; List: TStrings; + ListType: TRecentListType); +procedure CleanUpRecentList(List: TStrings; ListType: TRecentListType); + +implementation + +// Recent item lists : + +function IndexInRecentList(List: TStrings; ListType: TRecentListType; + const Path: string): integer; +begin + Result:=List.Count-1; + while (Result>=0) and (not CompareRecentListItem(List[Result],Path,ListType)) do + dec(Result); +end; + +function StrToRecentListType(s: string): TRecentListType; +begin + for Result:=Low(TRecentListType) to high(TRecentListType) do + if SysUtils.CompareText(s,RecentListTypeNames[Result])=0 then exit; + Result:=rltCaseSensitive; +end; + +function CompareRecentListItem(s1, s2: string; ListType: TRecentListType): boolean; +begin + case ListType of + rltCaseInsensitive: Result:=UTF8CompareLatinTextFast(s1,s2)=0; + rltFile: Result:=CompareFilenames(ChompPathDelim(s1),ChompPathDelim(s2))=0; + else Result:=s1=s2; + end; +end; + +procedure LoadRecentList(XMLConfig: TXMLConfig; List: TStrings; + const Path: string; ListType: TRecentListType); +begin + LoadStringList(XMLConfig,List,Path); + CleanUpRecentList(List,ListType); +end; + +procedure SaveRecentList(XMLConfig: TXMLConfig; List: TStrings; const Path: string); +begin + SaveStringList(XMLConfig,List,Path); +end; + +procedure SaveRecentList(XMLConfig: TXMLConfig; List: TStrings; + const Path: string; aMax: Integer); +var + i: Integer; + s: String; +begin + if aMax>0 then + while List.Count>aMax do // Truncate list to aMax items. + List.Delete(List.Count-1); + SaveStringList(XMLConfig,List,Path); + i:=List.Count+1; + while True do + begin + s:=Path+'Item'+IntToStr(i); + if not XMLConfig.HasPath(s+'/Value',True) then Break; + XMLConfig.DeletePath(s); // Remove excess items from XML. + Inc(i); + end; +end; + +function AddToRecentList(const s: string; List: TStrings; aMax: integer; + ListType: TRecentListType): boolean; +begin + if (List.Count>0) and CompareRecentListItem(List[0],s,ListType) then + exit(false); + Result:=true; + RemoveFromRecentList(s,List,ListType); + List.Insert(0,s); + if aMax>0 then + while List.Count>aMax do + List.Delete(List.Count-1); +end; + +function AddComboTextToRecentList(cb: TCombobox; aMax: integer; + ListType: TRecentListType): boolean; +var + List: TStringList; +begin + List:=TStringList.Create; + try + List.Assign(cb.Items); + Result:=AddToRecentList(cb.Text,List,aMax,ListType); + if Result then + begin + cb.Items.Assign(List); + cb.ItemIndex:=0; + end; + finally + List.Free; + end; +end; + +procedure RemoveFromRecentList(const s: string; List: TStrings; + ListType: TRecentListType); +var + i: integer; +begin + for i:=List.Count-1 downto 0 do + if CompareRecentListItem(List[i],s,ListType) then + List.Delete(i); +end; + +procedure CleanUpRecentList(List: TStrings; ListType: TRecentListType); +var + i: Integer; +begin + for i:=List.Count-1 downto 1 do + if (List[i]='') or CompareRecentListItem(List[i],List[i-1],ListType) then + List.Delete(i); +end; + +end. + diff --git a/ide/packages/ideconfig/searchpathprocs.pas b/ide/packages/ideconfig/searchpathprocs.pas new file mode 100644 index 0000000000..2e0e4b43d1 --- /dev/null +++ b/ide/packages/ideconfig/searchpathprocs.pas @@ -0,0 +1,487 @@ +unit SearchPathProcs; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LazFileUtils, LazFileCache, FileUtil; + +// search paths +function TrimSearchPath(const SearchPath, BaseDirectory: string; + DeleteDoubles: boolean = false; ExpandPaths: boolean = false): string; +function MergeSearchPaths(const OldSearchPath, AddSearchPath: string): string; +procedure MergeSearchPaths(SearchPath: TStrings; const AddSearchPath: string); +function RemoveSearchPaths(const SearchPath, RemoveSearchPath: string): string; +function RemoveNonExistingPaths(const SearchPath, BaseDirectory: string): string; +function RebaseSearchPath(const SearchPath, + OldBaseDirectory, NewBaseDirectory: string; + SkipPathsStartingWithMacro: boolean): string; +function ShortenSearchPath(const SearchPath, BaseDirectory, + ChompDirectory: string): string; +function GetNextDirectoryInSearchPath(const SearchPath: string; + var NextStartPos: integer): string; +function GetNextUsedDirectoryInSearchPath(const SearchPath, + FilterDir: string; var NextStartPos: integer): string; +function SearchPathToList(const SearchPath: string): TStringList; +function SearchDirectoryInSearchPath(const SearchPath, Directory: string; + DirStartPos: integer = 1): integer; +function SearchDirectoryInSearchPath(SearchPath: TStrings; + const Directory: string; DirStartPos: integer = 0): integer; + +implementation + +{------------------------------------------------------------------------------- + function TrimSearchPath(const SearchPath, BaseDirectory: string): boolean; + + - Removes empty paths. + - Uses TrimFilename on every path. + - If BaseDirectory<>'' then every relative Filename will be expanded. + - removes doubles +-------------------------------------------------------------------------------} +function TrimSearchPath(const SearchPath, BaseDirectory: string; + DeleteDoubles: boolean; ExpandPaths: boolean): string; +var + CurPath: String; + EndPos: Integer; + StartPos: Integer; + len: Integer; + BaseDir: String; +begin + Result:=''; + EndPos:=1; + len:=length(SearchPath); + BaseDir:=AppendPathDelim(TrimFilename(BaseDirectory)); + while EndPos<=len do begin + StartPos:=EndPos; + // skip empty paths and space chars at start + while (StartPos<=len) and (SearchPath[StartPos] in [';',#0..#32]) do + inc(StartPos); + if StartPos>len then break; + EndPos:=StartPos; + while (EndPos<=len) and (SearchPath[EndPos]<>';') do inc(EndPos); + CurPath:=copy(SearchPath,StartPos,EndPos-StartPos); + if CurPath<>'' then begin + // non empty path => expand, trim and normalize + if ExpandPaths then + CurPath:=TrimAndExpandDirectory(CurPath,BaseDir) + else if (BaseDir<>'') and (not FilenameIsAbsolute(CurPath)) then + CurPath:=BaseDir+CurPath; + CurPath:=ChompPathDelim(TrimFilename(CurPath)); + if CurPath='' then CurPath:='.'; + // check if path already exists + if (not DeleteDoubles) or (SearchDirectoryInSearchPath(Result,CurPath)<1) + then begin + if Result<>'' then + CurPath:=';'+CurPath; + if CurPath<>'' then + Result:=Result+CurPath + else + Result:=Result+'.'; + end; + end; + end; +end; + +function MergeSearchPaths(const OldSearchPath, AddSearchPath: string): string; +var + l: Integer; + EndPos: Integer; + StartPos: Integer; + NewPath: String; +begin + Result:=OldSearchPath; + if Result='' then begin + Result:=AddSearchPath; + exit; + end; + l:=length(AddSearchPath); + EndPos:=1; + while EndPos<=l do begin + StartPos:=EndPos; + while (AddSearchPath[StartPos]=';') do begin + inc(StartPos); + if StartPos>l then exit; + end; + EndPos:=StartPos; + while (EndPos<=l) and (AddSearchPath[EndPos]<>';') do inc(EndPos); + if SearchDirectoryInSearchPath(Result,AddSearchPath,StartPos)<1 then + begin + // new path found -> add + NewPath:=copy(AddSearchPath,StartPos,EndPos-StartPos); + if Result<>'' then + NewPath:=';'+NewPath; + Result:=Result+NewPath; + end; + end; +end; + +procedure MergeSearchPaths(SearchPath: TStrings; const AddSearchPath: string); +var + l: Integer; + EndPos: Integer; + StartPos: Integer; +begin + l:=length(AddSearchPath); + EndPos:=1; + while EndPos<=l do begin + StartPos:=EndPos; + while (AddSearchPath[StartPos]=';') do begin + inc(StartPos); + if StartPos>l then exit; + end; + EndPos:=StartPos; + while (EndPos<=l) and (AddSearchPath[EndPos]<>';') do inc(EndPos); + if SearchDirectoryInSearchPath(SearchPath,AddSearchPath,StartPos)<1 then + begin + // new path found -> add + SearchPath.Add(copy(AddSearchPath,StartPos,EndPos-StartPos)); + end; + end; +end; + +function RemoveSearchPaths(const SearchPath, RemoveSearchPath: string): string; +var + OldPathLen: Integer; + EndPos: Integer; + StartPos: Integer; + ResultStartPos: Integer; +begin + Result:=SearchPath; + OldPathLen:=length(SearchPath); + EndPos:=1; + ResultStartPos:=1; + repeat + StartPos:=EndPos; + while (StartPos<=OldPathLen) and (SearchPath[StartPos]=';') do + inc(StartPos); + if StartPos>OldPathLen then break; + EndPos:=StartPos; + while (EndPos<=OldPathLen) and (SearchPath[EndPos]<>';') do + inc(EndPos); + //DebugLn('RemoveSearchPaths Dir="',copy(SearchPath,StartPos,EndPos-StartPos),'" RemoveSearchPath="',RemoveSearchPath,'"'); + if SearchDirectoryInSearchPath(RemoveSearchPath,SearchPath,StartPos)>0 then + begin + // remove path -> skip + end else begin + // keep path -> copy + if ResultStartPos>1 then begin + Result[ResultStartPos]:=';'; + inc(ResultStartPos); + end; + while StartPosStartPos then begin + // empty paths, e.g. ;;;; + // remove + Result:=copy(Result,1,StartPos-1)+copy(Result,EndPos,length(Result)); + EndPos:=StartPos; + end; + while (EndPos<=length(Result)) and (Result[EndPos]<>';') do inc(EndPos); + + CurPath:=copy(Result,StartPos,EndPos-StartPos); + + // cut macros + MacroStartPos:=System.Pos('$(',CurPath); + if MacroStartPos>0 then begin + CurPath:=copy(CurPath,1,MacroStartPos-1); + if (CurPath<>'') and (CurPath[length(CurPath)]<>PathDelim) then + CurPath:=ExtractFilePath(CurPath); + end; + + // make path absolute + if (CurPath<>'') and (not FilenameIsAbsolute(CurPath)) then + CurPath:=AppendPathDelim(BaseDirectory)+CurPath; + + if ((CurPath='') and (MacroStartPos<1)) + or (not DirPathExistsCached(CurPath)) then begin + // path does not exist -> remove + Result:=copy(Result,1,StartPos-1)+copy(Result,EndPos+1,length(Result)); + EndPos:=StartPos; + end else begin + StartPos:=EndPos+1; + end; + end; +end; + +function RebaseSearchPath(const SearchPath, OldBaseDirectory, + NewBaseDirectory: string; SkipPathsStartingWithMacro: boolean): string; +// change every relative search path +var + EndPos: Integer; + StartPos: Integer; + CurPath: String; +begin + Result:=SearchPath; + if CompareFilenames(OldBaseDirectory,NewBaseDirectory)=0 then exit; + EndPos:=1; + repeat + StartPos:=EndPos; + while (StartPos<=length(Result)) and (Result[StartPos]=';') do + inc(StartPos); + if StartPos>length(Result) then break; + EndPos:=StartPos; + while (EndPos<=length(Result)) and (Result[EndPos]<>';') do + inc(EndPos); + if EndPos>StartPos then begin + CurPath:=copy(Result,StartPos,EndPos-StartPos); + if (not FilenameIsAbsolute(CurPath)) + and ((not SkipPathsStartingWithMacro) or (CurPath[1]<>'$')) + then begin + CurPath:=TrimFilename(AppendPathDelim(OldBaseDirectory)+CurPath); + CurPath:=CreateRelativePath(CurPath,NewBaseDirectory); + Result:=copy(Result,1,StartPos-1)+CurPath + +copy(Result,EndPos,length(Result)); + EndPos:=StartPos+length(CurPath); + end; + end; + until false; +end; + +function ShortenSearchPath(const SearchPath, BaseDirectory, + ChompDirectory: string): string; +// Every search path that is a subdirectory of ChompDirectory will be shortened. +// Before the test relative paths are expanded by BaseDirectory. +var + BaseEqualsChompDir: boolean; + + function Normalize(var ADirectory: string): boolean; + begin + if FilenameIsAbsolute(ADirectory) then begin + Result:=true; + end else begin + if BaseEqualsChompDir then + Result:=false + else begin + Result:=true; + ADirectory:=AppendPathDelim(BaseDirectory)+ADirectory; + end; + end; + if Result then + ADirectory:=AppendPathDelim(TrimFilename(ADirectory)); + end; + +var + PathLen: Integer; + EndPos: Integer; + StartPos: Integer; + CurDir: String; + NewCurDir: String; + DiffLen: Integer; +begin + Result:=SearchPath; + if (SearchPath='') or (ChompDirectory='') then exit; + + PathLen:=length(Result); + EndPos:=1; + BaseEqualsChompDir:=CompareFilenames(BaseDirectory,ChompDirectory)=0; + while EndPos<=PathLen do begin + StartPos:=EndPos; + while (Result[StartPos] in [';',#0..#32]) do begin + inc(StartPos); + if StartPos>PathLen then exit; + end; + EndPos:=StartPos; + while (EndPos<=PathLen) and (Result[EndPos]<>';') do inc(EndPos); + CurDir:=copy(Result,StartPos,EndPos-StartPos); + NewCurDir:=CurDir; + if Normalize(NewCurDir) then begin + if CompareFilenames(NewCurDir,ChompDirectory)=0 then + NewCurDir:='.' + else if FileIsInPath(NewCurDir,ChompDirectory) then + NewCurDir:=AppendPathDelim(CreateRelativePath(NewCurDir,BaseDirectory)); + if NewCurDir<>CurDir then begin + DiffLen:=length(NewCurDir)-length(CurDir); + Result:=copy(Result,1,StartPos-1)+NewCurDir + +copy(Result,EndPos,PathLen-EndPos+1); + inc(EndPos,DiffLen); + inc(PathLen,DiffLen); + end; + end; + StartPos:=EndPos; + end; +end; + +function GetNextDirectoryInSearchPath(const SearchPath: string; + var NextStartPos: integer): string; +var + PathLen: Integer; + CurStartPos: Integer; +begin + PathLen:=length(SearchPath); + if PathLen>0 then begin + repeat + while (NextStartPos<=PathLen) + and (SearchPath[NextStartPos] in [';',#0..#32]) do + inc(NextStartPos); + CurStartPos:=NextStartPos; + while (NextStartPos<=PathLen) and (SearchPath[NextStartPos]<>';') do + inc(NextStartPos); + Result:=TrimFilename(copy(SearchPath,CurStartPos,NextStartPos-CurStartPos)); + if Result<>'' then exit; + until (NextStartPos>PathLen); + end else begin + NextStartPos:=1; + end; + Result:=''; +end; + +function GetNextUsedDirectoryInSearchPath(const SearchPath, + FilterDir: string; var NextStartPos: integer): string; +// searches next directory in search path, +// which is equal to FilterDir or is in FilterDir +begin + while (NextStartPos<=length(SearchPath)) do begin + Result:=GetNextDirectoryInSearchPath(SearchPath,NextStartPos); + if (Result<>'') and PathIsInPath(Result,FilterDir) then + exit; + end; + Result:='' +end; + +function SearchPathToList(const SearchPath: string): TStringList; +var + p: Integer; + CurDir: String; +begin + Result:=TStringList.Create; + p:=1; + repeat + CurDir:=GetNextDirectoryInSearchPath(SearchPath,p); + if CurDir='' then break; + Result.Add(CurDir); + until false; +end; + +function SearchDirectoryInSearchPath(const SearchPath, Directory: string; + DirStartPos: integer): integer; +// -1 on not found +var + PathLen: Integer; + DirLen: Integer; + EndPos: Integer; + StartPos: Integer; + DirEndPos: Integer; + CurDirLen: Integer; + CurDirEndPos: Integer; +begin + Result:=-1; + DirLen:=length(Directory); + if (SearchPath='') + or (Directory='') or (DirStartPos>DirLen) or (Directory[DirStartPos]=';') then + exit; + DirEndPos:=DirStartPos; + while (DirEndPos<=DirLen) and (Directory[DirEndPos]<>';') do inc(DirEndPos); + // ignore PathDelim at end + if (DirEndPos>DirStartPos) and (Directory[DirEndPos-1]=PathDelim) then begin + while (DirEndPos>DirStartPos) and (Directory[DirEndPos-1]=PathDelim) do + dec(DirEndPos); + // check if it is the root path '/' + if DirEndPos=DirStartPos then DirEndPos:=DirStartPos+1; + end; + CurDirLen:=DirEndPos-DirStartPos; + //DebugLn('SearchDirectoryInSearchPath Dir="',copy(Directory,DirStartPos,CurDirLen),'"'); + PathLen:=length(SearchPath); + EndPos:=1; + while EndPos<=PathLen do begin + StartPos:=EndPos; + while (SearchPath[StartPos] in [';',#0..#32]) do begin + inc(StartPos); + if StartPos>PathLen then exit; + end; + EndPos:=StartPos; + while (EndPos<=PathLen) and (SearchPath[EndPos]<>';') do inc(EndPos); + CurDirEndPos:=EndPos; + // ignore PathDelim at end + if (CurDirEndPos>StartPos) and (SearchPath[CurDirEndPos-1]=PathDelim) then + begin + while (CurDirEndPos>StartPos) and (SearchPath[CurDirEndPos-1]=PathDelim) + do + dec(CurDirEndPos); + // check if it is the root path '/' + if CurDirEndPos=StartPos then CurDirEndPos:=StartPos+1; + end; + //DebugLn('SearchDirectoryInSearchPath CurDir="',copy(SearchPath,StartPos,CurDirEndPos-StartPos),'"'); + if CurDirEndPos-StartPos=CurDirLen then begin + // directories have same length -> compare chars + if FileUtil.CompareFilenames(@SearchPath[StartPos],CurDirLen, + @Directory[DirStartPos],CurDirLen, + false)=0 + then begin + // directory found + Result:=StartPos; + exit; + end; + end; + StartPos:=EndPos; + end; +end; + +function SearchDirectoryInSearchPath(SearchPath: TStrings; + const Directory: string; DirStartPos: integer): integer; +var + DirLen: Integer; + DirEndPos: Integer; + CurDirLen: Integer; + CurPath: string; + CurPathLen: Integer; +begin + Result:=-1; + DirLen:=length(Directory); + if (SearchPath.Count=0) + or (Directory='') or (DirStartPos>DirLen) or (Directory[DirStartPos]=';') then + exit; + DirEndPos:=DirStartPos; + while (DirEndPos<=DirLen) and (Directory[DirEndPos]<>';') do inc(DirEndPos); + // ignore PathDelim at end + if (DirEndPos>DirStartPos) and (Directory[DirEndPos-1]=PathDelim) then begin + while (DirEndPos>DirStartPos) and (Directory[DirEndPos-1]=PathDelim) do + dec(DirEndPos); + // check if it is the root path '/' + if DirEndPos=DirStartPos then DirEndPos:=DirStartPos+1; + end; + CurDirLen:=DirEndPos-DirStartPos; + + // search in all search paths + Result:=SearchPath.Count-1; + while Result>=0 do begin + CurPath:=SearchPath[Result]; + CurPathLen:=length(CurPath); + if CurPathLen>0 then + begin + while (CurPathLen>1) and (CurPath[CurPathLen]=PathDelim) do dec(CurPathLen); + end; + if (CurPathLen>0) + and (FileUtil.CompareFilenames(@CurPath[1],CurPathLen, + @Directory[DirStartPos],CurDirLen, + false)=0) + then begin + // directory found + exit; + end; + dec(Result); + end; +end; + +end. + diff --git a/ide/project.pp b/ide/project.pp index 09fc307fee..0ce7d9d97e 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -63,11 +63,11 @@ uses // DebuggerIntf DbgIntfDebuggerBase, IdeDebuggerOpts, IdeDebuggerBackendValueConv, // IDE - EnvironmentOpts, - CompOptsModes, ProjectResources, LazConf, ProjectIcon, + EnvironmentOpts, CompOptsModes, ProjectResources, LazConf, ProjectIcon, IDECmdLine, IDEProcs, CompilerOptions, RunParamsOpts, ModeMatrixOpts, - TransferMacros, ProjectDefs, EditDefineTree, - LazarusIDEStrConsts, InputHistory, ProjPackCommon, PackageDefs, PackageSystem; + TransferMacros, ProjectDefs, EditDefineTree, LazarusIDEStrConsts, + InputHistory, SearchPathProcs, IdeXmlConfigProcs, ProjPackCommon, PackageDefs, + PackageSystem; type TUnitInfo = class; diff --git a/ide/publishmoduledlg.pas b/ide/publishmoduledlg.pas index 9704a91873..94baf9647d 100644 --- a/ide/publishmoduledlg.pas +++ b/ide/publishmoduledlg.pas @@ -43,7 +43,8 @@ uses IDEWindowIntf, IDEHelpIntf, IDEDialogs, IDEImagesIntf, LazIDEIntf, // IDE ProjectDefs, Project, PackageDefs, IDEOptionDefs, InputHistory, - LazarusIDEStrConsts, IDEProcs, EnvironmentOpts, CompilerOptions; + LazarusIDEStrConsts, IDEProcs, EnvironmentOpts, CompilerOptions, + RecentListProcs; type { TPublishModuleDialog } diff --git a/ide/runparamsopts.pas b/ide/runparamsopts.pas index c35fb822de..9e38207f22 100644 --- a/ide/runparamsopts.pas +++ b/ide/runparamsopts.pas @@ -56,7 +56,7 @@ uses LazFileUtils, LazFileCache, LazUTF8, Laz2_XMLCfg, // IDE IDEProcs, MiscOptions, SysVarUserOverrideDlg, InputHistory, LazarusIDEStrConsts, - EnvironmentOpts; + EnvironmentOpts, RecentListProcs; { The xml format version: When the format changes (new values, changed formats) we can distinguish old diff --git a/ide/searchfrm.pas b/ide/searchfrm.pas index 6c61e2506e..ffd1e0043b 100644 --- a/ide/searchfrm.pas +++ b/ide/searchfrm.pas @@ -42,7 +42,8 @@ uses // IDEIntf IDEWindowIntf, LazIDEIntf, SrcEditorIntf, IDEDialogs, ProjectGroupIntf, // ide - LazarusIDEStrConsts, InputHistory, IDEProcs, SearchResultView, Project; + LazarusIDEStrConsts, InputHistory, IDEProcs, SearchResultView, Project, + SearchPathProcs; type diff --git a/ide/sourcefilemanager.pas b/ide/sourcefilemanager.pas index 66bda51afd..352750860f 100644 --- a/ide/sourcefilemanager.pas +++ b/ide/sourcefilemanager.pas @@ -56,7 +56,7 @@ uses SourceSynEditor, SourceEditor, EditorOptions, EnvironmentOpts, CustomFormEditor, ControlSelection, FormEditor, EmptyMethodsDlg, BaseDebugManager, TransferMacros, BuildManager, EditorMacroListViewer, FindRenameIdentifier, BuildModesManager, - ViewUnit_Dlg, InputHistory, CheckLFMDlg, etMessagesWnd, + ViewUnit_Dlg, InputHistory, CheckLFMDlg, etMessagesWnd, SearchPathProcs, ConvCodeTool, BasePkgManager, PackageDefs, PackageSystem, Designer, DesignerProcs; type diff --git a/ide/viewunit_dlg.pp b/ide/viewunit_dlg.pp index 1b175ad2a7..aaf75e3b1e 100644 --- a/ide/viewunit_dlg.pp +++ b/ide/viewunit_dlg.pp @@ -53,7 +53,7 @@ uses // IdeIntf IDEWindowIntf, IDEHelpIntf, IDEImagesIntf, // IDE - LazarusIdeStrConsts, IDEProcs, CustomFormEditor, PackageDefs; + LazarusIdeStrConsts, IDEProcs, CustomFormEditor, SearchPathProcs, PackageDefs; type TIDEProjectItem = ( diff --git a/packager/frames/package_integration_options.pas b/packager/frames/package_integration_options.pas index d1b5f079e5..ca1b55f109 100644 --- a/packager/frames/package_integration_options.pas +++ b/packager/frames/package_integration_options.pas @@ -13,7 +13,8 @@ uses // IdeIntf IDEOptionsIntf, IDEOptEditorIntf, MacroIntf, PackageIntf, // IDE - PackageDefs, LazarusIDEStrConsts, PathEditorDlg, IDEProcs, CodeHelp; + PackageDefs, LazarusIDEStrConsts, PathEditorDlg, IDEProcs, CodeHelp, + SearchPathProcs; type diff --git a/packager/frames/package_usage_options.pas b/packager/frames/package_usage_options.pas index 37f77467b6..85647459b9 100644 --- a/packager/frames/package_usage_options.pas +++ b/packager/frames/package_usage_options.pas @@ -13,7 +13,7 @@ uses // IdeIntf IDEOptionsIntf, IDEOptEditorIntf, MacroIntf, // IDE - PathEditorDlg, LazarusIDEStrConsts, IDEProcs, PackageDefs; + PathEditorDlg, LazarusIDEStrConsts, IDEProcs, SearchPathProcs, PackageDefs; type diff --git a/packager/interpkgconflictfiles.pas b/packager/interpkgconflictfiles.pas index d9b31e6070..7b1ff020db 100644 --- a/packager/interpkgconflictfiles.pas +++ b/packager/interpkgconflictfiles.pas @@ -66,7 +66,7 @@ uses ProjectIntf, CompOptsIntf, IDEWindowIntf, LazIDEIntf, IDEMsgIntf, IDEExternToolIntf, // IDE CompilerOptions, EnvironmentOpts, IDEProcs, DialogProcs, LazarusIDEStrConsts, - TransferMacros, PackageDefs, PackageSystem; + TransferMacros, SearchPathProcs, PackageDefs, PackageSystem; type TPGInterPkgOwnerInfo = class diff --git a/packager/packagedefs.pas b/packager/packagedefs.pas index 31a81cf4be..cb102b4237 100644 --- a/packager/packagedefs.pas +++ b/packager/packagedefs.pas @@ -54,7 +54,8 @@ uses LazIDEIntf, IDEOptEditorIntf, IDEDialogs, ComponentReg, IDEImagesIntf, // IDE EditDefineTree, CompilerOptions, CompOptsModes, IDEOptionDefs, ProjPackCommon, - LazarusIDEStrConsts, IDEProcs, TransferMacros, FppkgHelper; + LazarusIDEStrConsts, IDEProcs, TransferMacros, SearchPathProcs, + IdeXmlConfigProcs, FppkgHelper; type TLazPackage = class; diff --git a/packager/packageeditor.pas b/packager/packageeditor.pas index 6f5b828f82..8b9720e3b2 100644 --- a/packager/packageeditor.pas +++ b/packager/packageeditor.pas @@ -50,9 +50,10 @@ uses IDEImagesIntf, MenuIntf, LazIDEIntf, FormEditingIntf, IDEHelpIntf, IDEWindowIntf, IDEDialogs, ComponentReg, IDEOptEditorIntf, // IDE - MainBase, IDEProcs, DialogProcs, LazarusIDEStrConsts, IDEDefs, CompilerOptions, - EnvironmentOpts, InputHistory, PackageSystem, PackageDefs, AddToPackageDlg, - AddPkgDependencyDlg, AddFPMakeDependencyDlg, ProjPackChecks, PkgVirtualUnitEditor, + MainBase, IDEProcs, DialogProcs, LazarusIDEStrConsts, IDEDefs, + CompilerOptions, EnvironmentOpts, InputHistory, SearchPathProcs, + PackageSystem, PackageDefs, AddToPackageDlg, AddPkgDependencyDlg, + AddFPMakeDependencyDlg, ProjPackChecks, PkgVirtualUnitEditor, MissingPkgFilesDlg, CleanPkgDeps, ProjPackFilePropGui, ProjPackEditing, BasePkgManager; diff --git a/packager/packagesystem.pas b/packager/packagesystem.pas index c41d18eb4a..32bc08f220 100644 --- a/packager/packagesystem.pas +++ b/packager/packagesystem.pas @@ -63,8 +63,8 @@ uses LazarusPackageIntf, // IDE LazarusIDEStrConsts, IDECmdLine, EnvironmentOpts, IDEProcs, LazConf, - TransferMacros, DialogProcs, IDETranslations, CompilerOptions, PackageLinks, - PackageDefs, ComponentReg, FppkgHelper; + TransferMacros, DialogProcs, IDETranslations, CompilerOptions, + SearchPathProcs, PackageLinks, PackageDefs, ComponentReg, FppkgHelper; const MakefileCompileVersion = 2; diff --git a/packager/pkgmanager.pas b/packager/pkgmanager.pas index 9185ca4f1f..8acf46daad 100644 --- a/packager/pkgmanager.pas +++ b/packager/pkgmanager.pas @@ -71,7 +71,7 @@ uses SourceEditor, ProjPackChecks, AddFileToAPackageDlg, LazarusPackageIntf, PublishModuleDlg, PkgLinksDlg, InterPkgConflictFiles, InstallPkgSetDlg, ConfirmPkgListDlg, NewPkgComponentDlg, BaseBuildManager, BasePkgManager, - MainBar, MainIntf, MainBase, ModeMatrixOpts; + MainBar, MainIntf, MainBase, ModeMatrixOpts, RecentListProcs, SearchPathProcs; type