diff --git a/components/codetools/codetoolmanager.pas b/components/codetools/codetoolmanager.pas index 0b93c4d971..b8956ff4d5 100644 --- a/components/codetools/codetoolmanager.pas +++ b/components/codetools/codetoolmanager.pas @@ -420,8 +420,6 @@ type function FindIncludeDirective(Code: TCodeBuffer; StartX, StartY: integer; out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer; const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean; - function AddIncludeDirective(Code: TCodeBuffer; const Filename: string; - const NewSrc: string = ''): boolean; deprecated; function AddIncludeDirectiveForInit(Code: TCodeBuffer; const Filename: string; const NewSrc: string = ''): boolean; function AddUnitWarnDirective(Code: TCodeBuffer; WarnID, Comment: string; @@ -3440,12 +3438,6 @@ begin end; end; -function TCodeToolManager.AddIncludeDirective(Code: TCodeBuffer; - const Filename: string; const NewSrc: string): boolean; -begin - Result:=AddIncludeDirectiveForInit(Code,Filename,NewSrc); -end; - function TCodeToolManager.AddIncludeDirectiveForInit(Code: TCodeBuffer; const Filename: string; const NewSrc: string): boolean; begin diff --git a/components/codetools/customcodetool.pas b/components/codetools/customcodetool.pas index fb3dd77358..56d48507dd 100644 --- a/components/codetools/customcodetool.pas +++ b/components/codetools/customcodetool.pas @@ -206,7 +206,6 @@ type function SkipResourceDirective(StartPos: integer): integer; function UpdateNeeded(Range: TLinkScannerRange): boolean; - function UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean; deprecated; // use UpdateNeeded(lsrImplementationStart) or UpdateNeeded(lsrEnd) procedure BeginParsing(Range: TLinkScannerRange); virtual; procedure BeginParsingAndGetCleanPos( Range: TLinkScannerRange; CursorPos: TCodeXYPosition; @@ -3009,14 +3008,6 @@ begin {$ENDIF} end; -function TCustomCodeTool.UpdateNeeded(OnlyInterfaceNeeded: boolean): boolean; -begin - if OnlyInterfaceNeeded then - Result:=UpdateNeeded(lsrImplementationStart) - else - Result:=UpdateNeeded(lsrEnd); -end; - function TCustomCodeTool.CompareSrcIdentifiers(Identifier1, Identifier2: PChar ): boolean; begin diff --git a/components/codetools/definetemplates.pas b/components/codetools/definetemplates.pas index 008574830a..f406e068f0 100644 --- a/components/codetools/definetemplates.pas +++ b/components/codetools/definetemplates.pas @@ -621,10 +621,6 @@ type Owner: TObject): TDefineTemplate; function GetFPCVerFromFPCTemplate(Template: TDefineTemplate; out FPCVersion, FPCRelease, FPCPatch: integer): boolean; - function CreateFPCSrcTemplate(const FPCSrcDir, UnitSearchPath, PPUExt, - DefaultTargetOS, DefaultProcessorName: string; - UnitLinkListValid: boolean; var UnitLinkList: string; - Owner: TObject): TDefineTemplate; deprecated; function CreateFPCCommandLineDefines(const Name, CmdLine: string; RecursiveDefines: boolean; Owner: TObject; @@ -6327,571 +6323,6 @@ begin end; end; -function TDefinePool.CreateFPCSrcTemplate( - const FPCSrcDir, UnitSearchPath, PPUExt, DefaultTargetOS, - DefaultProcessorName: string; - UnitLinkListValid: boolean; var UnitLinkList: string; - Owner: TObject): TDefineTemplate; -var - Dir, SrcOS, SrcOS2, TargetCPU, UnitLinks: string; - UnitTree: TAVLTree; // tree of TDefTemplUnitNameLink - IncPathMacro, DefaultSrcOS, DefaultSrcOS2: string; - ProgressID: integer; - - function d(const Filenames: string): string; - begin - Result:=GetForcedPathDelims(Filenames); - end; - - function GatherUnits: boolean; forward; - - function FindUnitLink(const AnUnitName: string): TUnitNameLink; - var ANode: TAVLTreeNode; - cmp: integer; - begin - if UnitTree=nil then GatherUnits; - ANode:=UnitTree.Root; - while ANode<>nil do begin - Result:=TUnitNameLink(ANode.Data); - cmp:=CompareText(AnUnitName,Result.Unit_Name); - if cmp<0 then - ANode:=ANode.Left - else if cmp>0 then - ANode:=ANode.Right - else - exit; - end; - Result:=nil; - end; - - function GatherUnits: boolean; - - function FileNameMacroCount(const AFilename: string): integer; - // count number of macros in filename - // a macro looks like this '$(name)' without a SpecialChar in front - // macronames can contain macros themselves - var i: integer; - begin - Result:=0; - i:=1; - while (i<=length(AFilename)) do begin - if (AFilename[i]=SpecialChar) then - inc(i,2) - else if (AFilename[i]='$') then begin - inc(i); - if (i<=length(AFilename)) and (AFilename[i]='(') then - inc(Result); - end else - inc(i); - end; - end; - - function BuildMacroFilename(const AFilename: string; - var MacroCount, UsedMacroCount: integer): string; - // replace Operating System and Processor Type with macros - // MacroCount = number of macros are in the filename - // UsedMacroCount = number of macros fitting to the current settings - var DirStart, DirEnd, i: integer; - DirName: string; - - function ReplaceDir(const MacroValue, DefaultMacroValue, - MacroName: string): boolean; - begin - Result:=false; - if CompareText(MacroValue,DirName)=0 then begin - // this is a macro - if CompareText(DirName,DefaultMacroValue)=0 then begin - // the current settings would replace the macro to fit this filename - inc(UsedMacroCount); - end; - BuildMacroFilename:=copy(BuildMacroFilename,1,DirStart-1)+MacroName+ - copy(BuildMacroFilename,DirEnd,length(BuildMacroFilename)-DirEnd+1); - inc(DirEnd,length(MacroName)-length(DirName)); - DirName:=MacroName; - Result:=true; - end; - end; - - begin - MacroCount:=0; - Result:=copy(AFilename,length(Dir)+1,length(AFilename)-length(Dir)); - DirStart:=1; - while (DirStart<=length(Result)) do begin - while (DirStart<=length(Result)) and (Result[DirStart]=PathDelim) - do - inc(DirStart); - DirEnd:=DirStart; - while (DirEnd<=length(Result)) and (Result[DirEnd]<>PathDelim) do - inc(DirEnd); - if DirEnd>length(Result) then break; - if DirEnd>DirStart then begin - DirName:=copy(Result,DirStart,DirEnd-DirStart); - // replace operating system - for i:=Low(FPCOperatingSystemNames) to High(FPCOperatingSystemNames) - do - if ReplaceDir(FPCOperatingSystemNames[i],DefaultTargetOS,TargetOSMacro) - then - break; - // replace operating system class - for i:=Low(FPCOperatingSystemAlternativeNames) - to High(FPCOperatingSystemAlternativeNames) - do - if ReplaceDir(FPCOperatingSystemAlternativeNames[i],DefaultSrcOS, - SrcOS) - then - break; - // replace operating system secondary class - for i:=Low(FPCOperatingSystemAlternative2Names) - to High(FPCOperatingSystemAlternative2Names) - do - if ReplaceDir(FPCOperatingSystemAlternative2Names[i],DefaultSrcOS2, - SrcOS2) - then - break; - // replace processor type - for i:=Low(FPCProcessorNames) to High(FPCProcessorNames) do - if ReplaceDir(FPCProcessorNames[i],DefaultProcessorName, - TargetCPU) - then - break; - end; - DirStart:=DirEnd; - end; - Result:=Dir+Result; - end; - - function IsSpecialDirectory(Dir, SpecialDir: string): boolean; - var - p1: Integer; - p2: Integer; - begin - p1:=length(Dir); - p2:=length(SpecialDir); - if (p1>=1) and (Dir[p1]=PathDelim) then dec(p1); - if (p2>=1) and (SpecialDir[p2]=PathDelim) then dec(p2); - while (p1>=1) and (p2>=1) - and (UpChars[Dir[p1]]=UpChars[SpecialDir[p2]]) do begin - dec(p1); - dec(p2); - end; - Result:=(p2=0) and ((p1=0) or (Dir[p1]=PathDelim)); - end; - - function BrowseDirectory(ADirPath: string; Priority: integer): boolean; - const - IgnoreDirs: array[1..16] of shortstring =( - '.', '..', 'CVS', '.svn', 'examples', 'example', 'tests', 'fake', - 'ide', 'demo', 'docs', 'template', 'fakertl', 'install', 'installer', - 'compiler' - ); - var - AFilename, Ext, AUnitName, MacroFileName: string; - FileInfo: TSearchRec; - NewUnitLink, OldUnitLink: TUnitNameLink; - i: integer; - MacroCount, UsedMacroCount: integer; - MakeFileFPC: String; - SubDirs, GlobalSubDirs, TargetSubDirs: String; - SubPriority: Integer; - begin - Result:=true; - {$IFDEF VerboseFPCSrcScan} - DebugLn('Browse ',ADirPath); - {$ENDIF} - if ADirPath='' then exit; - ADirPath:=AppendPathDelim(ADirPath); - - // check for special directories - if IsSpecialDirectory(ADirPath,'packages'+PathDelim+'amunits') then begin - {$IFDEF VerboseFPCSrcScan} - DebugLn(['BrowseDirectory skip ',ADirPath]); - {$ENDIF} - exit; - end; - - inc(ProgressID); - if CheckAbort(ProgressID,-1,'') then exit(false); - // read Makefile.fpc to get some hints - MakeFileFPC:=ADirPath+'Makefile.fpc'; - SubDirs:=''; - if FileExistsUTF8(MakeFileFPC) then begin - ParseMakefileFPC(MakeFileFPC,DefaultTargetOS,GlobalSubDirs,TargetSubDirs); - SubDirs:=GlobalSubDirs; - if TargetSubDirs<>'' then begin - if SubDirs<>'' then - SubDirs:=SubDirs+';'; - SubDirs:=SubDirs+TargetSubDirs; - end; - //debugln('BrowseDirectory ADirPath="',ADirPath,'" SubDirs="',SubDirs,'" SrcOS="',DefaultTargetOS,'"'); - end; - - // set directory priority - if System.Pos(Dir+'rtl'+PathDelim,ADirPath)>0 then - inc(Priority); - if System.Pos(Dir+'packages'+PathDelim+'fcl',ADirPath)>0 then // packages/fcl* - inc(Priority); - // search sources .pp,.pas - if FindFirstUTF8(ADirPath+FileMask,faAnyFile,FileInfo)=0 then begin - repeat - AFilename:=FileInfo.Name; - if (AFilename='') or (AFilename='.') or (AFilename='..') then - continue; - //debugln('Browse Filename=',AFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0); - i:=High(IgnoreDirs); - while (i>=Low(IgnoreDirs)) and (AFilename<>IgnoreDirs[i]) do dec(i); - //if CompareText(AFilename,'fcl')=0 then - // debugln('Browse ',AFilename,' IsDir=',(FileInfo.Attr and faDirectory)>0,' Ignore=',i>=Low(IgnoreDirs)); - if i>=Low(IgnoreDirs) then continue; - AFilename:=ADirPath+AFilename; - if (FileInfo.Attr and faDirectory)>0 then begin - // directory -> recursively - // ToDo: prevent cycling in links - SubPriority:=0; - if CompareFilenames(AFilename,Dir+'rtl')=0 - then begin - // units in 'rtl' have higher priority than other directories - inc(SubPriority); - end; - if (SubDirs<>'') - and (FindPathInSearchPath(@FileInfo.Name[1],length(FileInfo.Name), - PChar(SubDirs),length(SubDirs))<>nil) - then begin - // units in directories compiled by the Makefile have higher prio - inc(SubPriority); - end; - if not BrowseDirectory(AFilename,SubPriority) then exit(false); - end else begin - Ext:=UpperCaseStr(ExtractFileExt(AFilename)); - if (Ext='.PP') or (Ext='.PAS') or (Ext='.P') then begin - // pascal unit found - AUnitName:=FileInfo.Name; - AUnitName:=copy(AUnitName,1,length(AUnitName)-length(Ext)); - if AUnitName<>'' then begin - OldUnitLink:=FindUnitLink(AUnitName); - MacroCount:=0; - UsedMacroCount:=0; - MacroFileName:= - BuildMacroFileName(AFilename,MacroCount,UsedMacroCount); - if OldUnitLink=nil then begin - // first unit with this name - NewUnitLink:=TUnitNameLink.Create; - NewUnitLink.Unit_Name:=AUnitName; - NewUnitLink.FileName:=MacroFileName; - NewUnitLink.MacroCount:=MacroCount; - NewUnitLink.UsedMacroCount:=UsedMacroCount; - NewUnitLink.Score:=Priority; - UnitTree.Add(NewUnitLink); - end else begin - { there is another unit with this name - - the decision which filename is the right one is based on a - simple heuristic: - - a filename with macros is preferred above one without - This skips the templates. - - A macro fitting better with the current settings - is preferred. For example: - If the current OS is linux then on fpc 1.0.x: - $(#FPCSrcDir)/fcl/classes/$(#TargetOS)/classes.pp - - A unit in the rtl is preferred above one in the fcl - - FPC stores a unit many times, if there is different version - for each Operating System or Processor Type. And sometimes - units are stored in a combined OS (e.g. 'unix'). - Therefore every occurence of such values is replaced by a - macro. And filenames without macros are always deleted if - there is a filename with a macro. (The filename without - macro is only used by the FPC team as a template source - for the OS specific). - If there are several macro filenames for the same unit, the - filename with the highest number of default values is used. - - For example: - classes.pp can be found in several places - In fpc 1.0.x: - - /rtl/amiga/classes.pp - /fcl/amiga/classes.pp - /fcl/beos/classes.pp - /fcl/qnx/classes.pp - /fcl/sunos/classes.pp - /fcl/template/classes.pp - /fcl/classes/freebsd/classes.pp - /fcl/classes/go32v2/classes.pp - /fcl/classes/linux/classes.pp - /fcl/classes/netbsd/classes.pp - /fcl/classes/openbsd/classes.pp - /fcl/classes/os2/classes.pp - /fcl/classes/win32/classes.pp - - In fpc 1.9.x/2.0.x: - /rtl/win32/classes.pp - /rtl/watcom/classes.pp - /rtl/go32v2/classes.pp - /rtl/netwlibc/classes.pp - /rtl/netbsd/classes.pp - /rtl/linux/classes.pp - /rtl/os2/classes.pp - /rtl/freebsd/classes.pp - /rtl/openbsd/classes.pp - /rtl/netware/classes.pp - /rtl/darwin/classes.pp - /rtl/morphos/classes.pp - /fcl/sunos/classes.pp - /fcl/beos/classes.pp - /fcl/qnx/classes.pp - /fcl/classes/win32/classes.pp - /fcl/classes/go32v2/classes.pp - /fcl/classes/netbsd/classes.pp - /fcl/classes/linux/classes.pp - /fcl/classes/os2/classes.pp - /fcl/classes/freebsd/classes.pp - /fcl/classes/openbsd/classes.pp - /fcl/template/classes.pp - /fcl/amiga/classes.pp - - This means, there are several possible macro filenames: - $(#FPCSrcDir)/rtl/$(#TargetOS)/classes.pp - $(#FPCSrcDir)/fcl/$(#TargetOS)/classes.pp - $(#FPCSrcDir)/fcl/classes/$(#TargetOS)/classes.pp - - Example: libc.pp - /rtl/netwlibc/libc.pp - /packages/base/libc/libc.pp - There are no macros and no templates. This is a special case. - - } - if (AUnitName='libc') - and (System.Pos(AppendPathDelim(FPCSrcDir)+'packages'+PathDelim,ADirPath)>0) - then begin - // /rtl/netwlibc/libc.pp - // /packages/base/libc/libc.pp - inc(Priority,2); - end; - //DebugLn(['BrowseDirectory duplicate found: ',AUnitName,' OldUnitLink.Filename=',OldUnitLink.Filename,' MacroFileName=',MacroFileName,' Priority=',Priority,' OldUnitLink.Priority=',OldUnitLink.Score]); - if (Priority>OldUnitLink.Score) - or ((Priority=OldUnitLink.Score) - and (UsedMacroCount>OldUnitLink.UsedMacroCount)) - then begin - // take the new macro filename - OldUnitLink.Filename:=MacroFileName; - OldUnitLink.MacroCount:=MacroCount; - OldUnitLink.Score:=Priority; - end; - end; - end; - end; - end; - until FindNextUTF8(FileInfo)<>0; - end; - FindCloseUTF8(FileInfo); - end; - - begin - if UnitTree<>nil then exit(true); - UnitTree:=TAVLTree.Create(@CompareUnitLinkNodes); - Result:=BrowseDirectory(Dir,0); - end; - - - procedure AddFPCSourceLinkForUnit(const AnUnitName: string); - var UnitLink: TUnitNameLink; - s: string; - begin - // search - if AnUnitName='' then exit; - UnitLink:=FindUnitLink(AnUnitName); - {$IFDEF VerboseFPCSrcScan} - DbgOut('AddFPCSourceLinkForUnit ',AnUnitName,' '); - if UnitLink<>nil then - DebugLn(' -> ',UnitLink.Filename) - else - DebugLn('MISSING'); - {$ELSE} - if (UnitLink=nil) and (CTConsoleVerbosity>=0) then - DebugLn(['Warning: unable to find source of fpc unit ',AnUnitName]); - {$ENDIF} - if UnitLink=nil then exit; - s:=AnUnitName+' '+UnitLink.Filename+LineEnding; - UnitLinkList:=UnitLinkList+s; - end; - - function FindStandardPPUSources: boolean; - var PathStart, PathEnd: integer; - ADirPath, AUnitName: string; - FileInfo: TSearchRec; - CurMask: String; - begin - Result:=false; - {$IFDEF VerboseFPCSrcScan} - DebugLn('FindStandardPPUSources ..'); - {$ENDIF} - // try every ppu file in every reachable directory (CompUnitPath) - if UnitLinkListValid then exit(true); - UnitLinkList:=''; - PathStart:=1; - CurMask:=PPUExt; - if CurMask='' then CurMask:='.ppu'; - if CurMask[1]<>'.' then - CurMask:='.'+CurMask; - CurMask:='*'+CurMask; - //DebugLn('FindStandardPPUSources UnitSearchPath="',UnitSearchPath,'"'); - while PathStart<=length(UnitSearchPath) do begin - while (PathStart<=length(UnitSearchPath)) - and (UnitSearchPath[PathStart]=';') do - inc(PathStart); - PathEnd:=PathStart; - // extract single path from unit search path - while (PathEnd<=length(UnitSearchPath)) - and (UnitSearchPath[PathEnd]<>';') do - inc(PathEnd); - if PathEnd>PathStart then begin - ADirPath:=copy(UnitSearchPath,PathStart,PathEnd-PathStart); - {$IFDEF VerboseFPCSrcScan} - DebugLn('FindStandardPPUSources Searching ',CurMask,' in ',ADirPath); - {$ENDIF} - inc(ProgressID); - if CheckAbort(ProgressID,-1,'') then exit(false); - // search all ppu files in this directory - if FindFirstUTF8(ADirPath+CurMask,faAnyFile,FileInfo)=0 then begin - repeat - AUnitName:=lowercase(ExtractFileNameOnly(FileInfo.Name)); - {$IFDEF VerboseFPCSrcScan} - DebugLn('FindStandardPPUSources Found: ',AUnitName); - {$ENDIF} - if (UnitTree=nil) and (not GatherUnits) then exit; - AddFPCSourceLinkForUnit(AUnitName); - if (UnitTree=nil) or (UnitTree.Count=0) then exit; - until FindNextUTF8(FileInfo)<>0; - end; - FindCloseUTF8(FileInfo); - end; - PathStart:=PathEnd; - end; - UnitLinkListValid:=true; - Result:=true; - end; - - procedure AddProcessorTypeDefine(ParentDefTempl: TDefineTemplate); - // some FPC source files expects defines 'i386' instead of 'CPUi386' - // define them automatically with IF..THEN constructs - var - i: Integer; - CPUName: String; - IfTemplate: TDefineTemplate; - begin - // FPC defines CPUxxx defines (e.g. CPUI386, CPUPOWERPC). - // These defines are created by the compiler depending - // on xxx defines (i386, powerpc). - // Create: - // IF CPUi386 then define i386 - // IF CPUpowerpc then define powerpc - // ... - for i:=Low(FPCProcessorNames) to high(FPCProcessorNames) do begin - CPUName:=FPCProcessorNames[i]; - IfTemplate:=TDefineTemplate.Create('IFDEF CPU'+CPUName, - 'IFDEF CPU'+CPUName,'CPU'+CPUName,'',da_IfDef); - IfTemplate.AddChild(TDefineTemplate.Create('DEFINE '+CPUName, - 'DEFINE '+CPUName,CPUName,'',da_DefineRecurse)); - ParentDefTempl.AddChild(IfTemplate); - end; - end; - - procedure AddSrcOSDefines(ParentDefTempl: TDefineTemplate); - var - IfTargetOSIsNotSrcOS: TDefineTemplate; - RTLSrcOSDir: TDefineTemplate; - IfTargetOSIsNotSrcOS2: TDefineTemplate; - RTLSrcOS2Dir: TDefineTemplate; - begin - // if TargetOS<>SrcOS - IfTargetOSIsNotSrcOS:=TDefineTemplate.Create( - 'IF TargetOS<>SrcOS', - ctsIfTargetOSIsNotSrcOS,'',''''+TargetOSMacro+'''<>'''+SrcOS+'''',da_If); - // rtl/$(#SrcOS) - RTLSrcOSDir:=TDefineTemplate.Create('SrcOS',SrcOS,'', - SrcOS,da_Directory); - IfTargetOSIsNotSrcOS.AddChild(RTLSrcOSDir); - RTLSrcOSDir.AddChild(TDefineTemplate.Create('Include Path', - 'include path', - IncludePathMacroName,IncPathMacro+';inc', - da_Define)); - RTLSrcOSDir.AddChild(TDefineTemplate.Create('Include Path', - 'include path to TargetCPU directories', - IncludePathMacroName,IncPathMacro+';'+TargetCPU, - da_Define)); - ParentDefTempl.AddChild(IfTargetOSIsNotSrcOS); - - // if TargetOS<>SrcOS2 - IfTargetOSIsNotSrcOS2:=TDefineTemplate.Create( - 'IF TargetOS is not SrcOS2', - ctsIfTargetOSIsNotSrcOS,'',''''+TargetOSMacro+'''<>'''+SrcOS2+'''',da_If); - // rtl/$(#SrcOS2) - RTLSrcOS2Dir:=TDefineTemplate.Create('SrcOS2',SrcOS2,'', - SrcOS2,da_Directory); - IfTargetOSIsNotSrcOS2.AddChild(RTLSrcOS2Dir); - RTLSrcOS2Dir.AddChild(TDefineTemplate.Create('Include Path', - 'include path to TargetCPU directories', - IncludePathMacroName,IncPathMacro+';'+TargetCPU, - da_DefineRecurse)); - ParentDefTempl.AddChild(IfTargetOSIsNotSrcOS2); - end; - -var - DefTempl: TDefineTemplate; - Ok: Boolean; -begin - {$IFDEF VerboseFPCSrcScan} - DebugLn('CreateFPCSrcTemplate ',FPCSrcDir,': length(UnitSearchPath)=',DbgS(length(UnitSearchPath)),' Valid=',DbgS(UnitLinkListValid),' PPUExt=',PPUExt); - {$ENDIF} - if UnitSearchPath='' then begin - DebugLn(['Note: [TDefinePool.CreateFPCSrcTemplate] UnitSearchPath empty']); - end; - Result:=nil; - ProgressID:=0; - Ok:=false; - try - Dir:=AppendPathDelim(FPCSrcDir); - SrcOS:='$('+ExternalMacroStart+'SrcOS)'; - SrcOS2:='$('+ExternalMacroStart+'SrcOS2)'; - TargetCPU:=TargetCPUMacro; - IncPathMacro:=IncludePathMacro; - DefaultSrcOS:=GetDefaultSrcOSForTargetOS(DefaultTargetOS); - DefaultSrcOS2:=GetDefaultSrcOS2ForTargetOS(DefaultTargetOS); - - if (FPCSrcDir='') or (not DirPathExists(FPCSrcDir)) then begin - DebugLn(['Warning: [TDefinePool.CreateFPCSrcTemplate] FPCSrcDir does not exist: FPCSrcDir="',FPCSrcDir,'" (env FPCDIR)']); - exit; - end; - // try to find for every reachable ppu file the unit file in the FPC sources - UnitLinks:=UnitLinksMacroName; - UnitTree:=nil; - if not FindStandardPPUSources then exit; - - Result:=CreateFPCSourceTemplate(FPCSrcDir,Owner); - - DefTempl:=TDefineTemplate.Create('FPC Unit Links', - ctsSourceFilenamesForStandardFPCUnits, - UnitLinks,UnitLinkList,da_DefineRecurse); - Result.AddChild(DefTempl); - - // clean up - if UnitTree<>nil then begin - UnitTree.FreeAndClear; - UnitTree.Free; - end; - - Result.SetDefineOwner(Owner,true); - Result.SetFlags([dtfAutoGenerated],[],false); - - Ok:=true; - finally - if not ok then - FreeAndNil(Result); - if (ProgressID>0) and Assigned(OnProgress) then - OnProgress(Self,ProgressID,ProgressID,'',Ok); - end; -end; - function TDefinePool.CreateDelphiSrcPath(DelphiVersion: integer; const PathPrefix: string): string; begin diff --git a/components/codetools/fileprocs.pas b/components/codetools/fileprocs.pas index 3e35d5d6c8..1ecba280af 100644 --- a/components/codetools/fileprocs.pas +++ b/components/codetools/fileprocs.pas @@ -100,8 +100,6 @@ const CTInvalidChangeStamp = LUInvalidChangeStamp; CTInvalidChangeStamp64 = LUInvalidChangeStamp64; // using a value outside integer to spot wrong types early -function GetFilenameOnDisk(const AFilename: string): string; inline; deprecated; // use FindDiskFilename - function CompareAnsiStringFilenames(Data1, Data2: Pointer): integer; function CompareFilenameOnly(Filename: PChar; FilenameLen: integer; NameOnly: PChar; NameOnlyLen: integer; CaseSensitive: boolean): integer; @@ -510,11 +508,6 @@ begin until StartPos>length(Result); end; -function GetFilenameOnDisk(const AFilename: string): string; -begin - Result:=FindDiskFilename(AFilename); -end; - function CompareAnsiStringFilenames(Data1, Data2: Pointer): integer; begin Result:=CompareFilenames(AnsiString(Data1),AnsiString(Data2)); diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 34be65ca3c..e16fe6e3b3 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -936,17 +936,12 @@ type BuildTheTree: Boolean): TCodeTreeNode;// search for type, const, var, proc, prop function FindSubDeclaration(Identifier: string; ParentNode: TCodeTreeNode ): TCodeTreeNode; // search for type, const, var, proc, prop - - function FindInitializationSection: TCodeTreeNode; deprecated 'Use FindInitializationNode instead.'; - function FindMainUsesSection(UseContainsSection: boolean = false): TCodeTreeNode; deprecated 'Use FindMainUsesNode instead.'; - function FindImplementationUsesSection: TCodeTreeNode; deprecated 'Use FindImplementationUsesNode instead.'; function FindNameInUsesSection(UsesNode: TCodeTreeNode; const AUnitName: string): TCodeTreeNode; function FindUnitInUsesSection(UsesNode: TCodeTreeNode; const AnUnitName: string; out NamePos, InPos: TAtomPosition): boolean; function FindUnitInAllUsesSections(const AnUnitName: string; out NamePos, InPos: TAtomPosition): boolean; function GetUnitNameForUsesSection(TargetTool: TFindDeclarationTool): string; - function GetUnitForUsesSection(TargetTool: TFindDeclarationTool): string; deprecated 'use GetUnitNameForUsesSection instead'; function IsHiddenUsedUnit(TheUnitName: PChar): boolean; function FindCodeToolForUsedUnit(const AnUnitName, AnUnitInFilename: string; @@ -957,7 +952,6 @@ type function FindUnitCaseInsensitive(var AnUnitName, AnUnitInFilename: string): string; procedure GatherUnitAndSrcPath(var UnitPath, CompleteSrcPath: string); - function SearchUnitInUnitLinks(const TheUnitName: string): string; deprecated; function SearchUnitInUnitSet(const TheUnitName: string): string; function GetNameSpaces: string; @@ -2793,17 +2787,6 @@ begin Result:=nil; end; -function TFindDeclarationTool.FindMainUsesSection(UseContainsSection: boolean - ): TCodeTreeNode; -begin - Result := FindMainUsesNode(UseContainsSection); -end; - -function TFindDeclarationTool.FindImplementationUsesSection: TCodeTreeNode; -begin - Result := FindImplementationUsesNode; -end; - function TFindDeclarationTool.FindNameInUsesSection(UsesNode: TCodeTreeNode; const AUnitName: string): TCodeTreeNode; var @@ -2919,12 +2902,6 @@ begin end; end; -function TFindDeclarationTool.GetUnitForUsesSection( - TargetTool: TFindDeclarationTool): string; -begin - Result:=GetUnitNameForUsesSection(TargetTool); -end; - function TFindDeclarationTool.IsHiddenUsedUnit(TheUnitName: PChar): boolean; var HiddenUnits: String; @@ -2944,11 +2921,6 @@ begin Result:=false; end; -function TFindDeclarationTool.FindInitializationSection: TCodeTreeNode; -begin - Result:=FindInitializationNode; -end; - function TFindDeclarationTool.FindDeclarationInUsesSection( UsesNode: TCodeTreeNode; CleanPos: integer; out NewPos: TCodeXYPosition; out NewTopLine: integer): boolean; @@ -3144,14 +3116,7 @@ begin //DebugLn('TFindDeclarationTool.GatherUnitAndSrcPath UnitPath="',UnitPath,'" CompleteSrcPath="',CompleteSrcPath,'"'); end; -function TFindDeclarationTool.SearchUnitInUnitLinks(const TheUnitName: string - ): string; -begin - Result:=DirectoryCache.FindUnitLink(TheUnitName); -end; - -function TFindDeclarationTool.SearchUnitInUnitSet(const TheUnitName: string - ): string; +function TFindDeclarationTool.SearchUnitInUnitSet(const TheUnitName: string): string; begin Result:=DirectoryCache.FindUnitInUnitSet(TheUnitName); end; diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 99599d4d65..2b3e5e7685 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -259,7 +259,6 @@ type procedure ValidateToolDependencies; virtual; procedure BuildTree(Range: TLinkScannerRange); - procedure BuildTree(OnlyInterface: boolean); deprecated; procedure BuildTreeAndGetCleanPos(TreeRange: TTreeRange; ScanRange: TLinkScannerRange; const CursorPos: TCodeXYPosition; out CleanCursorPos: integer; @@ -996,14 +995,6 @@ begin {$ENDIF} end; -procedure TPascalParserTool.BuildTree(OnlyInterface: boolean); -begin - if OnlyInterface then - BuildTree(lsrImplementationStart) - else - BuildTree(lsrEnd); -end; - procedure TPascalParserTool.BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode); // reparse a quick parsed begin..end block and build the child nodes // create nodes for 'with' and 'case' statements diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index 5b7c18cc36..760dfbafa2 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -294,9 +294,6 @@ type function FindIncludeDirective(const CursorPos: TCodeXYPosition; out NewPos: TCodeXYPosition; out NewTopLine: integer; const Filename: string = ''): boolean; - function AddIncludeDirective(const Filename: string; - SourceChangeCache: TSourceChangeCache; const NewSrc: string = '' - ): boolean; deprecated; function AddIncludeDirectiveForInit(const Filename: string; SourceChangeCache: TSourceChangeCache; const NewSrc: string = '' ): boolean; @@ -6510,12 +6507,6 @@ begin Result:=CleanPosToCaretAndTopLine(CleanCursorPos,NewPos,NewTopLine); end; -function TStandardCodeTool.AddIncludeDirective(const Filename: string; - SourceChangeCache: TSourceChangeCache; const NewSrc: string): boolean; -begin - Result:=AddIncludeDirectiveForInit(Filename,SourceChangeCache,NewSrc); -end; - function TStandardCodeTool.AddIncludeDirectiveForInit(const Filename: string; SourceChangeCache: TSourceChangeCache; const NewSrc: string): boolean; var diff --git a/components/ideintf/compoptsintf.pas b/components/ideintf/compoptsintf.pas index 23728cd414..326163a20c 100644 --- a/components/ideintf/compoptsintf.pas +++ b/components/ideintf/compoptsintf.pas @@ -149,7 +149,6 @@ type fOwner: TObject; SetEmulatedFloatOpcodes: boolean; function GetDebugInfoTypeStr: String; - function GetGenerateDwarf: Boolean; procedure SetAllowLabel(const AValue: Boolean); procedure SetAssemblerStyle(const AValue: Integer); procedure SetCMacros(const AValue: Boolean); @@ -161,7 +160,6 @@ type procedure SetDontUseConfigFile(const AValue: Boolean); procedure SetExecutableType(const AValue: TCompilationExecutableType); procedure SetGenDebugInfo(const AValue: Boolean); - procedure SetGenerateDwarf(const AValue: Boolean); procedure SetGenGProfCode(const AValue: Boolean); procedure SetHeapSize(const AValue: Integer); procedure SetIncludeAssertionCode(const AValue: Boolean); @@ -432,7 +430,6 @@ type property GenerateDebugInfo: Boolean read fGenDebugInfo write SetGenDebugInfo; property DebugInfoType: TCompilerDbgSymbolType read FDebugInfoType write SetDebugInfoType; property DebugInfoTypeStr: String read GetDebugInfoTypeStr; - property GenerateDwarf: Boolean read GetGenerateDwarf write SetGenerateDwarf; deprecated 'use DebugInfoType'; property UseLineInfoUnit: Boolean read fUseLineInfoUnit write SetUseLineInfoUnit; property UseHeaptrc: Boolean read fUseHeaptrc write SetUseHeaptrc; property TrashVariables: Boolean read fTrashVariables write SetTrashVariables; @@ -719,11 +716,6 @@ begin IncreaseChangeStamp; end; -function TLazCompilerOptions.GetGenerateDwarf: Boolean; -begin - Result := FDebugInfoType in [dsDwarf2, dsDwarf2Set]; -end; - function TLazCompilerOptions.GetDebugInfoTypeStr: String; begin WriteStr(Result, FDebugInfoType); @@ -800,14 +792,6 @@ begin IncreaseChangeStamp; end; -procedure TLazCompilerOptions.SetGenerateDwarf(const AValue: Boolean); -begin - if (FDebugInfoType = dsDwarf2) = AValue then exit; - if AValue then - FDebugInfoType := dsDwarf2; - IncreaseChangeStamp; -end; - procedure TLazCompilerOptions.SetGenGProfCode(const AValue: Boolean); begin if fGenGProfCode=AValue then exit; diff --git a/components/ideintf/idemsgintf.pas b/components/ideintf/idemsgintf.pas index 66246bf36e..48af8786c7 100644 --- a/components/ideintf/idemsgintf.pas +++ b/components/ideintf/idemsgintf.pas @@ -96,11 +96,6 @@ type aSrcFilename: string = ''; LineNumber: integer = 0; Column: integer = 0; const ViewCaption: string = ''): TMessageLine; virtual; abstract; function GetSelectedLine: TMessageLine; virtual; abstract; - - procedure BeginBlock(ClearOldBlocks: Boolean = true); deprecated; // not needed anymore - procedure AddMsg(const Msg, {%H-}CurDir: string; {%H-}OriginalIndex: integer; - Parts: TStrings = nil); deprecated; // use AddCustomMessages instead or create a new view via GetView or CreateView - procedure EndBlock; deprecated; // not needed anymore end; var @@ -137,102 +132,6 @@ begin Result:=nil; end; -{ TIDEMessagesWindowInterface } - -procedure TIDEMessagesWindowInterface.BeginBlock(ClearOldBlocks: Boolean); -begin - if ClearOldBlocks then - Clear; -end; - -procedure TIDEMessagesWindowInterface.AddMsg(const Msg, CurDir: string; - OriginalIndex: integer; Parts: TStrings); - - function StrToUrgency(s: string; Def: TMessageLineUrgency): TMessageLineUrgency; - begin - if CompareText(s,'Error')=0 then - Result:=mluError - else if CompareText(s,'Warning')=0 then - Result:=mluWarning - else if CompareText(s,'Note')=0 then - Result:=mluNote - else if CompareText(s,'Hint')=0 then - Result:=mluHint - else - Result:=Def; - end; - -var - s: String; - Urgency: TMessageLineUrgency; - Line: Integer; - Column: Integer; - p: SizeInt; - ColonPos: SizeInt; - Filename: String; - Message: String; -begin - Urgency:=mluImportant; - Line:=0; - Column:=0; - Filename:=''; - Message:=Msg; - ColonPos:=Pos(':',Message); - if ColonPos>0 then begin - // check for - // urgency: Msg - // filename(line) urgency: Msg - // filename(line,col) urgency: Msg - s:=LeftStr(Message,ColonPos-1); - p:=Pos('(',s); - if p>0 then begin - // has filename(...: - Filename:=TrimFilename(LeftStr(s,p-1)); - Delete(s,1,p); - // get line number - p:=1; - while (p<=length(s)) and (s[p] in ['0'..'9']) do inc(p); - Line:=StrToIntDef(LeftStr(s,p-1),0); - Delete(s,1,p-1); - if (p<=length(s)) and (s[p]=',') then begin - // get column - Delete(s,1,1); - while (p<=length(s)) and (s[p] in ['0'..'9']) do inc(p); - Column:=StrToIntDef(LeftStr(s,p-1),0); - Delete(s,1,p-1); - end; - if (p<=length(s)) and (s[p]=')') then begin - inc(p); - while (p<=length(s)) and (s[p]=' ') do inc(p); - Delete(s,1,p-1); - end; - end; - // check for urgency (a single word) - p:=1; - while (p<=length(s)) and (s[p] in ['a'..'z','A'..'Z',#128..#255]) do inc(p); - if (p>1) and (pnil then begin - Urgency:=StrToUrgency(Parts.Values['Type'],Urgency); - Line:=StrToIntDef(Parts.Values['Line'],Line); - Column:=StrToIntDef(Parts.Values['Column'],Column); - if Parts.Values['Filename']<>'' then - Filename:=Parts.Values['Filename']; - if Parts.Values['Message']<>'' then - Message:=Parts.Values['Message']; - end; - AddCustomMessage(Urgency,Message,Filename,Line,Column); -end; - -procedure TIDEMessagesWindowInterface.EndBlock; -begin - -end; - { TMsgQuickFix } procedure TMsgQuickFix.QuickFix(Fixes: TMsgQuickFixes; Msg: TMessageLine); diff --git a/components/ideintf/menuintf.pas b/components/ideintf/menuintf.pas index 203390a793..fc6c1631c3 100644 --- a/components/ideintf/menuintf.pas +++ b/components/ideintf/menuintf.pas @@ -163,9 +163,6 @@ type function NeedBottomSeparator: boolean; function GetFirstChildSameContainer: TIDEMenuItem; function GetLastChildSameContainer: TIDEMenuItem; - procedure BeginUpdate; deprecated; - procedure EndUpdate; deprecated; - procedure NotifySubSectionOnShow(Sender: TObject; WithChildren: Boolean = true); virtual; procedure RemoveAllHandlersOfObject(AnObject: TObject); @@ -178,8 +175,6 @@ type public property ChildrenAsSubMenu: boolean read FChildrenAsSubMenu write SetChildrenAsSubMenu default true; - property ChildsAsSubMenu: boolean read FChildrenAsSubMenu - write SetChildrenAsSubMenu default true; deprecated;// use ChildrenAsSubMenu instead property SubMenuImages: TCustomImageList read FSubMenuImages write SetSubMenuImages; property Items[Index: Integer]: TIDEMenuItem read GetItems; default; @@ -1466,16 +1461,6 @@ begin end; end; -procedure TIDEMenuSection.BeginUpdate; -begin - -end; - -procedure TIDEMenuSection.EndUpdate; -begin - -end; - procedure TIDEMenuSection.RemoveAllHandlersOfObject(AnObject: TObject); var HandlerType: TIDEMenuSectionHandlerType; diff --git a/components/lazutils/avglvltree.pas b/components/lazutils/avglvltree.pas index 2efa0500c1..50d4ad5908 100644 --- a/components/lazutils/avglvltree.pas +++ b/components/lazutils/avglvltree.pas @@ -240,9 +240,7 @@ type procedure Add(const Name, Value: string); inline; procedure Add(const Name, Value, Delimiter: string); procedure AddNameValues(List: TStrings); - procedure AddValues(List: TStrings); inline; deprecated; // use AddNames procedure AddNames(List: TStrings); - procedure Delete(const Name: string); inline; deprecated; // use Remove property Values[const s: string]: string read GetValues write SetValues; default; function GetNodeData(Node: TAVLTreeNode): PStringToStringItem; inline; function AsText: string; @@ -673,11 +671,6 @@ begin Values[List.Names[i]]:=List.ValueFromIndex[i]; end; -procedure TStringToStringTree.AddValues(List: TStrings); -begin - AddNames(List); -end; - procedure TStringToStringTree.AddNames(List: TStrings); var i: Integer; @@ -686,11 +679,6 @@ begin Values[List[i]]:=''; end; -procedure TStringToStringTree.Delete(const Name: string); -begin - Remove(Name); -end; - function TStringToStringTree.GetNodeData(Node: TAVLTreeNode): PStringToStringItem; begin Result:=PStringToStringItem(Node.Data); diff --git a/components/lazutils/laz2_dom.pas b/components/lazutils/laz2_dom.pas index 9f141dfced..bb9991390d 100644 --- a/components/lazutils/laz2_dom.pas +++ b/components/lazutils/laz2_dom.pas @@ -349,8 +349,7 @@ type function GetCount: LongWord; function GetItem(index: LongWord): TDOMNode; function NodeFilter({%H-}aNode: TDOMNode): TFilterResult; virtual; - // now deprecated in favor of NodeFilter - procedure BuildList; virtual; + procedure BuildList; virtual; deprecated 'Use NodeFilter instead.'; public constructor Create(ANode: TDOMNode); destructor Destroy; override; diff --git a/components/lazutils/lazutf8.pas b/components/lazutils/lazutf8.pas index 7208c9c293..b36b6d8e96 100644 --- a/components/lazutils/lazutf8.pas +++ b/components/lazutils/lazutf8.pas @@ -77,7 +77,6 @@ function UTF8CodepointSize(p: PChar): integer; inline; function UTF8CharacterLength(p: PChar): integer; deprecated 'Use UTF8CodepointSize instead.'; // Fast version of UTF8CodepointSize. Assumes the UTF-8 codepoint is valid. function UTF8CodepointSizeFast(p: PChar): integer; inline; -function UTF8CharacterLengthFast(p: PChar): integer; deprecated 'Use UTF8CodepointSizeFast instead.'; function UTF8Length(const s: string): PtrInt; inline; function UTF8Length(p: PChar; ByteCount: PtrInt): PtrInt; @@ -155,7 +154,7 @@ function UTF8WrapText(S: string; MaxCol: integer): string; overload; type TEscapeMode = (emPascal, emHexPascal, emHexC, emC, emAsciiControlNames); -function ValidUTF8String(const s: String): String; inline; deprecated 'Use Utf8EscapeControlChars() instead.'; // deprecated in 1.7 + function Utf8EscapeControlChars(S: String; EscapeMode: TEscapeMode = emPascal): String; type @@ -469,11 +468,6 @@ begin end; end; -function UTF8CharacterLengthFast(p: PChar): integer; -begin - Result := UTF8CodepointSizeFast(p); -end; - function UTF8Length(const s: string): PtrInt; begin Result:=UTF8Length(PChar(s),length(s)); @@ -2871,11 +2865,6 @@ begin Result := FindInvalidUTF8Codepoint(p, Count, StopOnNonUTF8); end; -function ValidUTF8String(const s: String): String; inline; -begin - Result := Utf8EscapeControlChars(s, emPascal); -end; - { Translates escape characters inside an UTF8 encoded string into human readable format. diff --git a/components/lazutils/lookupstringlist.pas b/components/lazutils/lookupstringlist.pas index e13ac26e9e..b75fa7269e 100644 --- a/components/lazutils/lookupstringlist.pas +++ b/components/lazutils/lookupstringlist.pas @@ -53,9 +53,6 @@ type function IndexOf(const S: string): Integer; override; end; - TDictionaryStringList = class(TLookupStringList) - end deprecated 'The class was renamed to TLookupStringList.'; - function Deduplicate(AStrings: TStrings): Boolean; implementation diff --git a/components/lazutils/translations.pas b/components/lazutils/translations.pas index 0a9ee0953a..2303a2dd0c 100644 --- a/components/lazutils/translations.pas +++ b/components/lazutils/translations.pas @@ -99,7 +99,6 @@ type Duplicate: boolean; constructor Create(const TheIdentifierLow, TheOriginal, TheTranslated: string); procedure ModifyFlag(const AFlag: string; Check: boolean); - property Identifier: string read IdentifierLow; deprecated; end; { TPOFile } diff --git a/debugger/debugger.pp b/debugger/debugger.pp index 684bca1a34..63f19c9280 100644 --- a/debugger/debugger.pp +++ b/debugger/debugger.pp @@ -1770,7 +1770,6 @@ const ); function DBGCommandNameToCommand(const s: string): TDBGCommand; -function DBGStateNameToState(const s: string): TDBGState; deprecated; function DBGBreakPointActionNameToAction(const s: string): TIDEBreakPointAction; function dbgs(AFlag: TDebuggerLocationFlag): String; overload; @@ -1821,13 +1820,6 @@ begin Result:=dcStop; end; -function DBGStateNameToState(const s: string): TDBGState; -begin - for Result:=Low(TDBGState) to High(TDBGState) do - if AnsiCompareText(s,DBGStateNames[Result])=0 then exit; - Result:=dsNone; -end; - function DBGBreakPointActionNameToAction(const s: string): TIDEBreakPointAction; begin for Result:=Low(TIDEBreakPointAction) to High(TIDEBreakPointAction) do diff --git a/ide/idehelpmanager.pas b/ide/idehelpmanager.pas index 479994ec0c..e6ae8c40fa 100644 --- a/ide/idehelpmanager.pas +++ b/ide/idehelpmanager.pas @@ -189,10 +189,7 @@ type FRTLHelpDBPath: THelpBaseURLObject; FLazUtilsHelpDB: THelpDatabase; FLazUtilsHelpDBPath: THelpBaseURLObject; - // Used by CreateHint - FHtmlHelpProvider: TAbstractIDEHTMLProvider; - FHintWindow: THintWindow; - function HtmlHelpProvider: TAbstractIDEHTMLProvider; + procedure RegisterIDEHelpDatabases; procedure RegisterDefaultIDEHelpViewers; procedure FindDefaultBrowser(var DefaultBrowser, Params: string); @@ -214,9 +211,6 @@ type procedure ShowHelpForMessage; override; procedure ShowHelpForObjectInspector(Sender: TObject); override; procedure ShowHelpForIDEControl(Sender: TControl); override; - function CreateHint(aHintWindow: THintWindow; ScreenPos: TPoint; - const {%H-}BaseURL: string; var TheHint: string; out HintWinRect: TRect): boolean; - override; deprecated 'Use THintWindowManager class instead'; function GetHintForSourcePosition(const ExpandedFilename: string; const CodePos: TPoint; out BaseURL, HTMLHint: string; Flags: TIDEHelpManagerCreateHintFlags = []): TShowHelpResult; override; @@ -1603,60 +1597,6 @@ begin IDEWindowHelpNodes.InvokeHelp(Sender); end; -function TIDEHelpManager.HtmlHelpProvider: TAbstractIDEHTMLProvider; -var - HelpControl: TControl; -begin - Assert(Assigned(FHintWindow), 'TIDEHelpManager.HtmlHelpProvider: FHintWindow is not assigned.'); - if FHtmlHelpProvider = nil then - begin - HelpControl := CreateIDEHTMLControl(FHintWindow, FHtmlHelpProvider, [ihcWithClipboardMenu]); - HelpControl.Parent := FHintWindow; - HelpControl.Align := alClient; - end; - Result := FHtmlHelpProvider; -end; - -function TIDEHelpManager.CreateHint(aHintWindow: THintWindow; ScreenPos: TPoint; - const BaseURL: string; var TheHint: string; out HintWinRect: TRect): boolean; -var - ms: TMemoryStream; - NewWidth, NewHeight: integer; -begin - if CompareText(copy(TheHint,1,6),'')=0 then begin // Text is HTML - ms:=TMemoryStream.Create; - try - if TheHint<>'' then - ms.Write(TheHint[1],length(TheHint)); - ms.Position:=0; - HtmlHelpProvider.ControlIntf.SetHTMLContent(ms,''); - //FHtmlHelpProvider.BaseURL:=BaseURL; //Not needed - finally - ms.Free; - end; - FHtmlHelpProvider.ControlIntf.GetPreferredControlSize(NewWidth,NewHeight); - - if NewWidth <= 0 then - NewWidth := 500 - else - inc(NewWidth, 8); // border - - if NewHeight <= 0 then - NewHeight := 200 - else - inc(NewHeight, 8); // border - - HintWinRect := Rect(0, 0, NewWidth, NewHeight); - TheHint:=''; - end else begin - HintWinRect := aHintWindow.CalcHintRect(Screen.Width, TheHint, Nil); - aHintWindow.HintRect := HintWinRect; // Adds borders. - end; - OffsetRect(HintWinRect, ScreenPos.X, ScreenPos.Y+30); - - Result:=true; -end; - function TIDEHelpManager.GetHintForSourcePosition(const ExpandedFilename: string; const CodePos: TPoint; out BaseURL, HTMLHint: string; Flags: TIDEHelpManagerCreateHintFlags): TShowHelpResult; diff --git a/ide/project.pp b/ide/project.pp index 3d840cf522..a2adff97a9 100644 --- a/ide/project.pp +++ b/ide/project.pp @@ -471,7 +471,6 @@ type property Source: TCodeBuffer read fSource write SetSource; property DefaultSyntaxHighlighter: TLazSyntaxHighlighter read FDefaultSyntaxHighlighter write SetDefaultSyntaxHighlighter; - property SrcUnitName: String read FUnitName write SetUnitName; deprecated 'Use Unit_Name instead.'; property UserReadOnly: Boolean read fUserReadOnly write SetUserReadOnly; property SourceDirectoryReferenced: boolean read FSourceDirectoryReferenced; property AutoReferenceSourceDir: boolean read FAutoReferenceSourceDir @@ -1095,7 +1094,6 @@ type property OnSaveUnitSessionInfo: TOnSaveUnitSessionInfoInfo read FOnSaveUnitSessionInfo write FOnSaveUnitSessionInfo; property POOutputDirectory: string read FPOOutputDirectory write SetPOOutputDirectory; - property ProjectDirectory: string read GetDirectory; deprecated 'Use Directory instead.'; property ProjectInfoFile: string read GetProjectInfoFile write SetProjectInfoFile; property PublishOptions: TPublishProjectOptions read FPublishOptions write FPublishOptions; property ProjResources: TProjectResources read GetProjResources; diff --git a/lcl/interfaces/gtk2/gtk2def.pp b/lcl/interfaces/gtk2/gtk2def.pp index b29075d64a..d0308988a4 100644 --- a/lcl/interfaces/gtk2/gtk2def.pp +++ b/lcl/interfaces/gtk2/gtk2def.pp @@ -426,8 +426,6 @@ type property ROP2: Integer read GetRop2 write SetRop2; end; - TGtk2DeviceContext = TGtkDeviceContext deprecated; - // memory system for TDeviceContext(s) --------------------------------------------- { TDeviceContextMemManager } diff --git a/lcl/lclclasses.pp b/lcl/lclclasses.pp index adf0736c1b..22f4373076 100644 --- a/lcl/lclclasses.pp +++ b/lcl/lclclasses.pp @@ -80,7 +80,6 @@ type protected public destructor Destroy; override; - property Handle: TLCLIntfHandle read GetHandle; deprecated; property HandleAllocated: Boolean read GetReferenceAllocated; property ReferenceAllocated: Boolean read GetReferenceAllocated; end;