paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-04 04:37:35 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDE: codehelp: improved debugging

Browse Source 
git-svn-id: trunk@30266 -
This commit is contained in:
mattias 2011-04-11 21:25:55 +00:00
parent 7fdaa0a211
commit dd0fc4c825
15 changed files with 417 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
components/codetools/codeatom.pas
View File

@ -151,8 +151,8 @@ procedure FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition: TAVLTree);
procedure AddListToTreeOfPCodeXYPosition(SrcList: TFPList;
DestTree: TAVLTree; ClearList, CreateCopies: boolean);
function DbgsCXY(const p: TCodeXYPosition): string;
function DbgsCP(const p: TCodePosition): string;
function Dbgs(const p: TCodeXYPosition): string; overload;
function Dbgs(const p: TCodePosition): string; overload;
function dbgs(const a: TAtomPosition): string; overload;
function ListOfPCodeXYPositionToStr(const ListOfPCodeXYPosition: TFPList): string;
@ -302,7 +302,7 @@ begin
SrcList.Clear;
end;
function DbgsCXY(const p: TCodeXYPosition): string;
function Dbgs(const p: TCodeXYPosition): string;
begin
if p.Code=nil then
Result:='(none)'
@ -310,7 +310,7 @@ begin
Result:=p.Code.Filename+'(y='+dbgs(p.y)+',x='+dbgs(p.x)+')';
end;
function DbgsCP(const p: TCodePosition): string;
function Dbgs(const p: TCodePosition): string;
var
CodeXYPosition: TCodeXYPosition;
begin
@ -319,7 +319,7 @@ begin
if CodeXYPosition.Code<>nil then begin
CodeXYPosition.Code.AbsoluteToLineCol(p.P,CodeXYPosition.Y,CodeXYPosition.X);
end;
Result:=DbgsCXY(CodeXYPosition);
Result:=Dbgs(CodeXYPosition);
end;
function dbgs(const a: TAtomPosition): string;
@ -339,7 +339,7 @@ begin
Result:='';
for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
p:=PCodeXYPosition(ListOfPCodeXYPosition[i])^;
Result:=Result+' '+DbgsCXY(p)+LineEnding;
Result:=Result+' '+Dbgs(p)+LineEnding;
end;
end;
end;

6
components/codetools/codecompletiontool.pas
View File

@ -1981,7 +1981,7 @@ begin
// adjust cursor position
AdjustCursor(OldCodePos,OldTopLine,NewPos,NewTopLine);
//DebugLn(['TCodeCompletionCodeTool.CompleteMethod END OldCodePos.P=',OldCodePos.P,' OldTopLine=',OldTopLine,' NewPos=',DbgsCXY(NewPos),' NewTopLine=',NewTopLine]);
//DebugLn(['TCodeCompletionCodeTool.CompleteMethod END OldCodePos.P=',OldCodePos.P,' OldTopLine=',OldTopLine,' NewPos=',Dbgs(NewPos),' NewTopLine=',NewTopLine]);
end;
function TCodeCompletionCodeTool.CreateParamListFromStatement(
@ -4817,7 +4817,7 @@ begin
CodeCompleteClassNode:=FindClassNode(CursorNode);
end;
if CodeCompleteClassNode=nil then begin
DebugLn(['TCodeCompletionCodeTool.FindEmptyMethods no class at ',DbgsCXY(CursorPos)]);
DebugLn(['TCodeCompletionCodeTool.FindEmptyMethods no class at ',Dbgs(CursorPos)]);
exit;
end;
ProcBodyNodes:=nil;
@ -6977,7 +6977,7 @@ var
ProcNode, ImplementationNode, AClassNode: TCodeTreeNode;
IsEventAssignment: boolean;
begin
//DebugLn(['TCodeCompletionCodeTool.CompleteCode CursorPos=',DbgsCXY(CursorPos),' OldTopLine=',OldTopLine]);
//DebugLn(['TCodeCompletionCodeTool.CompleteCode CursorPos=',Dbgs(CursorPos),' OldTopLine=',OldTopLine]);
Result:=false;
if (SourceChangeCache=nil) then

4
components/codetools/codetoolmanager.pas
View File

@ -1816,7 +1816,7 @@ begin
NewCode:=NewPos.Code;
if (NewTool=nil) and (NewNode<>nil) then ;
{$IFDEF CTDEBUG}
debugln(['TCodeToolManager.FindDeclaration ',DbgsCXY(NewPos)]);
debugln(['TCodeToolManager.FindDeclaration ',Dbgs(NewPos)]);
{$ENDIF}
end;
{$IFDEF DoNotHandleFindDeclException}
@ -2345,7 +2345,7 @@ begin
// check if old identifier is there
if CompareIdentifiers(@Code.Source[IdentStartPos],PChar(Pointer(OldIdentifier)))<>0
then begin
debugln(['TCodeToolManager.RenameIdentifier CONSISTENCY ERROR ',DbgsCXY(CurCodePos^),' ']);
debugln(['TCodeToolManager.RenameIdentifier CONSISTENCY ERROR ',Dbgs(CurCodePos^),' ']);
SetError(CurCodePos^.Code,CurCodePos^.Y,CurCodePos^.X,
Format(ctsStrExpectedButAtomFound,[OldIdentifier,
GetIdentifier(@Code.Source[IdentStartPos])])

10
components/codetools/codetools.lpk
View File

@ -5,7 +5,7 @@
<AddToProjectUsesSection Value="False"/>
<Author Value="Mattias Gaertner"/>
<CompilerOptions>
<Version Value="9"/>
<Version Value="10"/>
<SearchPaths>
<UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
@ -19,6 +19,9 @@
<Verbosity>
<ShowHints Value="False"/>
</Verbosity>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CustomOptions Value="$(IDEBuildOptions)"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
@ -279,9 +282,10 @@
</Item62>
<Item63>
<Filename Value="ctxmlfixfragment.pas"/>
<UnitName Value="ctxmlfixfragment"/>
<UnitName Value="CTXMLFixFragment"/>
</Item63>
</Files>
<LazDoc Paths="docs"/>
<i18n>
<EnableI18N Value="True"/>
<OutDir Value="languages"/>
@ -294,7 +298,7 @@
</Item1>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)/"/>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>

2
components/codetools/customcodetool.pas
View File

@ -2170,7 +2170,7 @@ begin
FIgnoreErrorAfter:=AValue;
LastErrorCheckedForIgnored:=false;
{$IFDEF ShowIgnoreErrorAfter}
DebugLn('TCustomCodeTool.SetIgnoreErrorAfter FIgnoreErrorAfter=',dbgsCP(FIgnoreErrorAfter));
DebugLn('TCustomCodeTool.SetIgnoreErrorAfter FIgnoreErrorAfter=',dbgs(FIgnoreErrorAfter));
{$ENDIF}
if Scanner<>nil then
Scanner.SetIgnoreErrorAfter(IgnoreErrorAfter.P,IgnoreErrorAfter.Code);

144
components/codetools/finddeclarationtool.pas
View File

@ -796,8 +796,10 @@ type
function SearchUnitInUnitSet(const TheUnitName: string): string;
function FindSmartHint(const CursorPos: TCodeXYPosition;
Flags: TFindSmartFlags = DefaultFindSmartHintFlags): string;
Flags: TFindSmartFlags = DefaultFindSmartHintFlags): string;
function GetSmartHint(Node: TCodeTreeNode; XYPos: TCodeXYPosition;
WithPosition: boolean): string;
function BaseTypeOfNodeHasSubIdents(ANode: TCodeTreeNode): boolean;
function FindBaseTypeOfNode(Params: TFindDeclarationParams;
Node: TCodeTreeNode): TFindContext;
@ -2122,14 +2124,9 @@ function TFindDeclarationTool.FindSmartHint(const CursorPos: TCodeXYPosition;
Flags: TFindSmartFlags): string;
var
NewTool: TFindDeclarationTool;
NewNode, IdentNode, TypeNode, ANode: TCodeTreeNode;
NewNode: TCodeTreeNode;
NewPos: TCodeXYPosition;
NewTopLine: integer;
AbsCursorPos: integer;
IdentStartPos, IdentEndPos: integer;
IdentAdded: boolean;
ClassStr: String;
NodeStr: String;
begin
Result:='';
if not FindDeclaration(CursorPos,Flags,NewTool,NewNode,NewPos,NewTopLine) then
@ -2137,17 +2134,27 @@ begin
// identifier not found
exit;
end;
Result:=NewTool.GetSmartHint(NewNode,NewPos,true);
end;
function TFindDeclarationTool.GetSmartHint(Node: TCodeTreeNode;
XYPos: TCodeXYPosition; WithPosition: boolean): string;
var
IdentNode, TypeNode, ANode: TCodeTreeNode;
ClassStr: String;
NodeStr: String;
begin
Result:='';
{ Examples:
var i: integer
/home/.../codetools/finddeclarationtools.pas(1224,7)
}
IdentAdded:=false;
// identifier category and identifier
if NewNode<>nil then begin
if Node<>nil then begin
// class visibility
if NewNode.Parent<>nil then begin
ANode:=NewNode.Parent;
if Node.Parent<>nil then begin
ANode:=Node.Parent;
while ANode<>nil do begin
if ANode.Desc in AllClassSections then begin
case ANode.Desc of
@ -2160,24 +2167,20 @@ begin
ctnClassPublished:
Result:=Result+'published ';
else
begin
ANode:=ANode.Parent;
Continue;
end;
break;
end;
break;
end else if ANode.Desc in ([ctnParameterList]+AllClasses) then
break;
ANode:=ANode.Parent;
end;
end;
if NewNode.Desc = ctnGenericName then NewNode := NewNode.Parent;
case NewNode.Desc of
if Node.Desc = ctnGenericName then Node := Node.Parent;
case Node.Desc of
ctnVarDefinition, ctnTypeDefinition, ctnConstDefinition,
ctnEnumIdentifier, ctnGenericType:
begin
case NewNode.Desc of
case Node.Desc of
ctnVarDefinition: Result:=Result+'var ';
ctnTypeDefinition: Result:=Result+'type ';
ctnConstDefinition: Result:=Result+'const ';
@ -2186,44 +2189,43 @@ begin
end;
// add class name
ClassStr := NewTool.ExtractClassName(NewNode.Parent, False, true);
ClassStr := ExtractClassName(Node.Parent, False, true);
if ClassStr <> '' then Result := Result + ClassStr + '.';
Result:=Result+NewTool.ExtractDefinitionName(NewNode);
IdentAdded:=true;
TypeNode:=NewTool.FindTypeNodeOfDefinition(NewNode);
Result:=Result+ExtractDefinitionName(Node);
TypeNode:=FindTypeNodeOfDefinition(Node);
if TypeNode<>nil then begin
case TypeNode.Desc of
ctnIdentifier, ctnSpecialize, ctnSpecializeType:
begin
if NewNode.Desc = ctnTypeDefinition then
if Node.Desc = ctnTypeDefinition then
Result:=Result+' = '
else
Result:=Result+': ';
Result := Result + NewTool.ExtractNode(TypeNode, []);
Result := Result + ExtractNode(TypeNode, []);
end;
ctnClass, ctnClassInterface, ctnDispinterface,
ctnObject, ctnRecordType,
ctnObjCClass, ctnObjCCategory, ctnObjCProtocol, ctnCPPClass:
begin
NewTool.MoveCursorToNodeStart(TypeNode);
NewTool.ReadNextAtom;
Result:=Result+': '+NewTool.GetAtom;
MoveCursorToNodeStart(TypeNode);
ReadNextAtom;
Result:=Result+': '+GetAtom;
end;
ctnConstant:
begin
NodeStr:=' = '+NewTool.ExtractNode(TypeNode,[]);
NodeStr:=' = '+ExtractNode(TypeNode,[]);
Result:=Result+copy(NodeStr,1,50);
end;
end;
end else begin
case NewNode.Desc of
case Node.Desc of
ctnConstDefinition:
begin
DebugLn('TFindDeclarationTool.FindSmartHint const without subnode "',NewTool.ExtractNode(NewNode,[]),'"');
NodeStr:=NewTool.ExtractCode(NewNode.StartPos
+GetIdentLen(@NewTool.Src[NewNode.StartPos]),
NewNode.EndPos,[]);
DebugLn('TFindDeclarationTool.FindSmartHint const without subnode "',ExtractNode(Node,[]),'"');
NodeStr:=ExtractCode(Node.StartPos
+GetIdentLen(@Src[Node.StartPos]),
Node.EndPos,[]);
Result:=Result+copy(NodeStr,1,50);
end;
end;
@ -2235,81 +2237,67 @@ begin
// ToDo: ppu, dcu files
Result:=Result+NewTool.ExtractProcHead(NewNode,
Result:=Result+ExtractProcHead(Node,
[phpAddClassName,phpWithStart,phpWithVarModifiers,phpWithParameterNames,
phpWithDefaultValues,phpWithResultType,phpWithOfObject]);
IdentAdded:=true;
end;
ctnProperty,
ctnProgram,ctnUnit,ctnPackage,ctnLibrary:
begin
IdentNode:=NewNode;
IdentNode:=Node;
// ToDo: ppu, dcu files
NewTool.MoveCursorToNodeStart(IdentNode);
NewTool.ReadNextAtom;
MoveCursorToNodeStart(IdentNode);
ReadNextAtom;
if (IdentNode.Desc=ctnProgram) and not UpAtomIs('PROGRAM') then begin
// program without source name
Result:='program '+ExtractFileNameOnly(MainFilename)+' ';
end else begin
Result:=Result+NewTool.GetAtom+' ';
Result:=Result+GetAtom+' ';
if NewNode.Desc = ctnProperty then begin // add class name
ClassStr := NewTool.ExtractClassName(NewNode, False, True);
if Node.Desc = ctnProperty then begin // add class name
ClassStr := ExtractClassName(Node, False, True);
if ClassStr <> '' then Result := Result + ClassStr + '.';
end;
NewTool.ReadNextAtom;
Result:=Result+NewTool.GetAtom+' ';
ReadNextAtom;
Result:=Result+GetAtom+' ';
end;
IdentAdded:=true;
end;
ctnGlobalProperty:
begin
IdentNode:=NewNode;
IdentNode:=Node;
// ToDo: ppu, dcu files
NewTool.MoveCursorToNodeStart(IdentNode);
MoveCursorToNodeStart(IdentNode);
Result:=Result+'property ';
NewTool.ReadNextAtom;
Result:=Result+NewTool.GetAtom+' ';
IdentAdded:=true;
ReadNextAtom;
Result:=Result+GetAtom+' ';
end;
else
DebugLn('ToDo: TFindDeclarationTool.FindSmartHint ',NewNode.DescAsString);
DebugLn('ToDo: TFindDeclarationTool.FindSmartHint ',Node.DescAsString);
end;
end;
// read the identifier if not already done
if not IdentAdded then begin
CursorPos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,AbsCursorPos);
GetIdentStartEndAtPosition(CursorPos.Code.Source,
AbsCursorPos,IdentStartPos,IdentEndPos);
if IdentStartPos<IdentEndPos then begin
Result:=Result+copy(CursorPos.Code.Source,IdentStartPos,IdentEndPos-IdentStartPos);
// type
// ToDo
Result:=Result+' ';
if WithPosition then begin
// filename
if Result<>'' then Result:=Result+LineEnding;
if XYPos.Code=nil then
CleanPosToCaret(Node.StartPos,XYPos);
Result:=Result+XYPos.Code.Filename;
// file position
if XYPos.Y>=1 then begin
Result:=Result+'('+IntToStr(XYPos.Y);
if XYPos.X>=1 then begin
Result:=Result+','+IntToStr(XYPos.X);
end;
Result:=Result+')';
end;
end;
// filename
if Result<>'' then Result:=Result+LineEnding;
Result:=Result+NewPos.Code.Filename;
// file position
if NewPos.Y>=1 then begin
Result:=Result+'('+IntToStr(NewPos.Y);
if NewPos.X>=1 then begin
Result:=Result+','+IntToStr(NewPos.X);
end;
Result:=Result+')';
end;
end;
function TFindDeclarationTool.BaseTypeOfNodeHasSubIdents(ANode: TCodeTreeNode
@ -4575,7 +4563,7 @@ var
//DebugLn(['CheckUsesSection ',GetAtom,' ',AUnitName]);
if UpAtomIs(UpperUnitName) then begin // compare case insensitive
if CleanPosToCaret(CurPos.StartPos,ReferencePos) then begin
//DebugLn(['CheckUsesSection found in uses section: ',DbgsCXY(ReferencePos)]);
//DebugLn(['CheckUsesSection found in uses section: ',Dbgs(ReferencePos)]);
Found:=true;
AddCodePosition(ListOfPCodeXYPosition,ReferencePos);
end;
@ -4602,7 +4590,7 @@ var
if UpAtomIs(UpperUnitName)
and not LastAtomIs(0,'.') then begin
if CleanPosToCaret(CurPos.StartPos,ReferencePos) then begin
//DebugLn(['CheckSource found: ',DbgsCXY(ReferencePos)]);
//DebugLn(['CheckSource found: ',Dbgs(ReferencePos)]);
AddCodePosition(ListOfPCodeXYPosition,ReferencePos);
end;
end;

2
components/codetools/identcompletiontool.pas
View File

@ -1717,7 +1717,7 @@ begin
// build code tree
{$IFDEF CTDEBUG}
DebugLn('TIdentCompletionTool.ParseSourceTillCollectionStart A CursorPos=',dbgs(CursorPos.X),',',dbgs(CursorPos.Y),' ',DbgsCXY(IdentStartXYPos));
DebugLn('TIdentCompletionTool.ParseSourceTillCollectionStart A CursorPos=',dbgs(CursorPos.X),',',dbgs(CursorPos.Y),' ',Dbgs(IdentStartXYPos));
{$ENDIF}
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);

2
components/codetools/pascalparsertool.pas
View File

@ -4736,7 +4736,7 @@ begin
IgnorePos.Code:=CursorPos.Code;
IgnorePos.Code.LineColToPosition(CursorPos.Y,CursorPos.X,IgnorePos.P);
if IgnorePos.P<1 then IgnorePos.Code:=nil;
//debugln(['TPascalParserTool.BuildTreeAndGetCleanPos IgnorePos=',dbgsCP(IgnorePos),' After=',IgnorePos.P,'=',copy(CursorPos.Code.Source,IgnorePos.P,10)]);
//debugln(['TPascalParserTool.BuildTreeAndGetCleanPos IgnorePos=',dbgs(IgnorePos),' After=',IgnorePos.P,'=',copy(CursorPos.Code.Source,IgnorePos.P,10)]);
IgnoreErrorAfter:=IgnorePos;
end else
ClearIgnoreErrorAfter;

56
components/codetools/pascalreadertool.pas
View File

@ -212,6 +212,8 @@ type
function GetPasDocComments(const StartPos: TCodeXYPosition;
InvokeBuildTree: boolean;
out ListOfPCodeXYPosition: TFPList): boolean;
function GetPasDocComments(Node: TCodeTreeNode;
out ListOfPCodeXYPosition: TFPList): boolean;
procedure CalcMemSize(Stats: TCTMemStats); override;
end;
@ -533,7 +535,7 @@ begin
end;
function TPascalReaderTool.ExtractClassName(ClassNode: TCodeTreeNode;
InUpperCase, WithParents: boolean): string;
InUpperCase: boolean; WithParents: boolean): string;
begin
Result:='';
while ClassNode<>nil do begin
@ -2561,6 +2563,26 @@ end;
function TPascalReaderTool.GetPasDocComments(const StartPos: TCodeXYPosition;
InvokeBuildTree: boolean; out ListOfPCodeXYPosition: TFPList): boolean;
var
CleanCursorPos: integer;
ANode: TCodeTreeNode;
begin
ListOfPCodeXYPosition:=nil;
Result:=false;
// parse source and find clean positions
if InvokeBuildTree then
BuildTreeAndGetCleanPos(StartPos,CleanCursorPos)
else
if CaretToCleanPos(StartPos,CleanCursorPos)<>0 then
exit;
ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
Result:=GetPasDocComments(ANode,ListOfPCodeXYPosition);
end;
function TPascalReaderTool.GetPasDocComments(Node: TCodeTreeNode;
out ListOfPCodeXYPosition: TFPList): boolean;
// Comments are normally in front.
// { Description of TMyClass. }
// TMyClass = class
@ -2633,49 +2655,37 @@ function TPascalReaderTool.GetPasDocComments(const StartPos: TCodeXYPosition;
end;
var
CleanCursorPos: integer;
ANode: TCodeTreeNode;
NextNode: TCodeTreeNode;
EndPos: LongInt;
TypeNode: TCodeTreeNode;
begin
ListOfPCodeXYPosition:=nil;
Result:=false;
// parse source and find clean positions
if InvokeBuildTree then
BuildTreeAndGetCleanPos(StartPos,CleanCursorPos)
else
if CaretToCleanPos(StartPos,CleanCursorPos)<>0 then
exit;
// find node
ANode:=FindDeepestNodeAtPos(CleanCursorPos,true);
if (ANode=nil) then exit;
if (ANode.Desc=ctnProcedureHead)
and (ANode.Parent<>nil) and (ANode.Parent.Desc=ctnProcedure) then
ANode:=ANode.Parent;
if (Node=nil) then exit;
if (Node.Desc=ctnProcedureHead)
and (Node.Parent<>nil) and (Node.Parent.Desc=ctnProcedure) then
Node:=Node.Parent;
// add space behind node to scan range
NextNode:=ANode.Next;
NextNode:=Node.Next;
if NextNode<>nil then
EndPos:=NextNode.StartPos
else
EndPos:=ANode.EndPos;
EndPos:=Node.EndPos;
// scan range for comments
if not Scan(ANode.StartPos,EndPos) then exit;
if not Scan(Node.StartPos,EndPos) then exit;
if ANode.Desc in AllIdentifierDefinitions then begin
if Node.Desc in AllIdentifierDefinitions then begin
// scan behind type
// for example: i: integer; // comment
TypeNode:=FindTypeNodeOfDefinition(ANode);
TypeNode:=FindTypeNodeOfDefinition(Node);
if TypeNode<>nil then begin
NextNode:=TypeNode.Next;
if NextNode<>nil then
EndPos:=NextNode.StartPos
else
EndPos:=ANode.EndPos;
EndPos:=Node.EndPos;
if not Scan(TypeNode.EndPos,EndPos) then exit;
end;
end;

4
components/synedit/synhighlighterpas.pp
View File

@ -488,10 +488,10 @@ type
function TopPascalCodeFoldBlockType
(DownIndex: Integer = 0): TPascalCodeFoldBlockType;
public
public
function MinimumPasFoldLevel(Index: Integer; AType: Integer = 1): integer;
function EndPasFoldLevel(Index: Integer; AType: Integer = 1): integer;
protected
protected
function LastLinePasFoldLevelFix(Index: Integer; AType: Integer = 1): integer;
function LastLineFoldLevelFix(Index: Integer): integer;

323
ide/codehelp.pas
View File

@ -42,12 +42,14 @@ uses
Classes, SysUtils, LCLProc, Forms, Controls, FileUtil, Dialogs, AvgLvlTree,
// codetools
CodeAtom, CodeTree, CodeToolManager, FindDeclarationTool, BasicCodeTools,
PascalParserTool, CodeCache, CacheCodeTools, FileProcs,
KeywordFuncLists, PascalParserTool, CodeCache, CacheCodeTools, FileProcs,
{$IFDEF NewXMLCfg}
Laz2_DOM, Laz2_XMLRead, Laz2_XMLWrite,
{$ELSE}
Laz_DOM, Laz_XMLRead, Laz_XMLWrite,
{$ENDIF}
// synedit
SynHighlighterPas,
// IDEIntf
IDEMsgIntf, MacroIntf, PackageIntf, LazHelpIntf, ProjectIntf, IDEDialogs,
IDEHelpIntf, LazIDEIntf,
@ -80,7 +82,6 @@ const
);
type
TLazFPDocFileFlag = (
ldffDocChangingCalled,
ldffDocChangedNeedsCalling
@ -220,10 +221,11 @@ type
{ TCodeHelpManager }
TCodeHelpManager = class
TCodeHelpManager = class(TComponent)
private
FDocs: TAvgLvlTree;// tree of loaded TLazFPDocFile
FHandlers: array[TCodeHelpManagerHandler] of TMethodList;
FPasHighlighter: TSynPasSyn;
FSrcToDocMap: TAvgLvlTree; // tree of TCHSourceToFPDocFile sorted for SourceFilename
FDeclarationCache: TDeclarationInheritanceCache;
procedure AddHandler(HandlerType: TCodeHelpManagerHandler;
@ -238,11 +240,11 @@ type
function CreateFPDocFile(const ExpandedFilename, PackageName,
ModuleName: string): TCodeBuffer;
public
constructor Create;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure FreeDocs;
procedure ClearSrcToDocMap;
function FindFPDocFile(const Filename: string): TLazFPDocFile;
function LoadFPDocFile(const Filename: string;
Flags: TCodeHelpOpenFileFlags;
@ -300,8 +302,16 @@ type
function GetHTMLHint(Code: TCodeBuffer; X, Y: integer; Options: TCodeHelpHintOptions;
out BaseURL, HTMLHint: string;
out CacheWasUsed: boolean): TCodeHelpParseResult;
function GetHTMLHint2(Code: TCodeBuffer; X, Y: integer; Options: TCodeHelpHintOptions;
out BaseURL, HTMLHint: string;
out CacheWasUsed: boolean): TCodeHelpParseResult;
function GetPasDocCommentsAsHTML(Tool: TCodeTool; Node: TCodeTreeNode): string;
function GetFPDocNodeAsHTML(DOMNode: TDOMNode): string;
function TextToHTML(Txt: string): string;
function CreateElement(Code: TCodeBuffer; X, Y: integer;
out Element: TCodeHelpElement): Boolean;
function SourceToFPDocHint(Src: string; NestedComments: boolean = true): string;
function SourcePosToFPDocHint(XYPos: TCodeXYPosition; Caption: string=''): string;
public
// Event lists
procedure RemoveAllHandlersOfObject(AnObject: TObject);
@ -311,8 +321,19 @@ type
procedure AddHandlerOnChanged(const OnDocChangedEvent: TCodeHelpChangeEvent;
AsLast: boolean = false);
procedure RemoveHandlerOnChanged(const OnDocChangedEvent: TCodeHelpChangeEvent);
public
property PasHighlighter: TSynPasSyn read FPasHighlighter;
end;
TFPDocHintToken = (
fpdhtText,
fpdhtKeyword,
fpdhtString,
fpdhtNumber,
fpdhtSymbol
);
TFPDocHintTokens = set of TFPDocHintToken;
var
CodeHelpBoss: TCodeHelpManager = nil;// set by the IDE
@ -325,10 +346,8 @@ function ToUnixLineEnding(const s: String): String;
function ToOSLineEnding(const s: String): String;
function ReplaceLineEndings(const s, NewLineEnds: string): string;
implementation
function ToUnixLineEnding(const s: String): String;
var
p: Integer;
@ -1156,13 +1175,15 @@ begin
end;
end;
constructor TCodeHelpManager.Create;
constructor TCodeHelpManager.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FDocs:=TAvgLvlTree.Create(@CompareLazFPDocFilenames);
FSrcToDocMap:=TAvgLvlTree.Create(@CompareLDSrc2DocSrcFilenames);
FDeclarationCache:=TDeclarationInheritanceCache.Create(
@CodeToolBoss.FindDeclarationAndOverload,
@CodeToolBoss.GetCodeTreeNodesDeletedStep);
FPasHighlighter:=TSynPasSyn.Create(Self);
end;
destructor TCodeHelpManager.Destroy;
@ -1400,6 +1421,7 @@ var
if PkgList=nil then exit;
try
for i:=0 to PkgList.Count-1 do begin
//debugln(['CheckUnitOwners ',DbgSName(TObject(PkgList[i]))]);
if TObject(PkgList[i]) is TLazProject then begin
AProject:=TLazProject(PkgList[i]);
AnOwner:=AProject;
@ -1411,12 +1433,12 @@ var
exit(true);
end else if TObject(PkgList[i]) is TLazPackage then begin
APackage:=TLazPackage(PkgList[i]);
AnOwner:=APackage;
if APackage.LazDocPaths='' then continue;
BaseDir:=APackage.Directory;
if BaseDir='' then continue;
// add lazdoc paths of package
if SearchInPath(APackage.LazDocPaths,BaseDir,Filename) then begin
AnOwner:=APackage;
exit(true);
end else if AnOwner=nil then
AnOwner:=APackage;
@ -1500,7 +1522,9 @@ begin
then begin
// not found
if AnOwner=nil then
DebugLn(['TCodeHelpManager.GetFPDocFilenameForSource Hint: file without owner: ',SrcFilename]);
DebugLn(['TCodeHelpManager.GetFPDocFilenameForSource Hint: file without owner: ',SrcFilename])
else
debugln(['TCodeHelpManager.GetFPDocFilenameForSource Hint: Owner has no lazdoc paths: ',SrcFilename]);
end;
// save to cache
@ -2209,27 +2233,6 @@ var
Result:=false;
end;
function TextToHTML(const s: string): string;
var
p: Integer;
EndPos: Integer;
begin
Result:=s;
// replace line breaks with <BR>
p:=1;
while (p<=length(Result)) do begin
if Result[p] in [#10,#13] then begin
EndPos:=p+1;
if (EndPos<=length(Result)) and (Result[EndPos] in [#10,#13]) then
inc(EndPos);
Result:=copy(Result,1,p-1)+le+copy(Result,EndPos,length(Result));
inc(p,length(le));
end else begin
inc(p);
end;
end;
end;
procedure AddText(const s: string);
begin
if IsHTML then
@ -2270,6 +2273,9 @@ var
f: TFPDocItem;
{$endif}
begin
{$IFDEF EnableNewCodeHints}
Result:=GetHTMLHint2(Code,X,Y,Options,BaseURL,HTMLHint,CacheWasUsed);
{$ENDIF}
{$ifdef VerboseHints}
DebugLn(['TCodeHelpManager.GetHint ',Code.Filename,' ',X,',',Y]);
{$endif}
@ -2367,6 +2373,188 @@ begin
{$endif}
end;
function TCodeHelpManager.GetHTMLHint2(Code: TCodeBuffer; X, Y: integer;
Options: TCodeHelpHintOptions; out BaseURL, HTMLHint: string;
out CacheWasUsed: boolean): TCodeHelpParseResult;
var
CursorPos: TCodeXYPosition;
CTTool: TFindDeclarationTool;
CTNode: TCodeTreeNode;
XYPos: TCodeXYPosition;
aTopLine: integer;
CTHint: String;
ListOfPCodeXYPosition: TFPList;
ElementName: String;
AnOwner: TObject;
FPDocFilename: String;
FPDocFile: TLazFPDocFile;
Complete: boolean;
ElementNode: TDOMNode;
begin
Result:=chprFailed;
BaseURL:='lazdoc://';
HTMLHint:='';
CacheWasUsed:=true;
if not CodeToolBoss.InitCurCodeTool(Code) then exit;
CursorPos.X:=X;
CursorPos.Y:=Y;
CursorPos.Code:=Code;
ListOfPCodeXYPosition:=nil;
Complete:=not (chhoSmallStep in Options);
try
try
// find declaration
if not CodeToolBoss.CurCodeTool.FindDeclaration(CursorPos,DefaultFindSmartHintFlags,
CTTool,CTNode,XYPos,aTopLine)
then
exit;
// add declaration
CTHint:=CTTool.GetSmartHint(CTNode,XYPos,false);
HTMLHint:=SourceToFPDocHint(CTHint);
// add link
HTMLHint:=HTMLHint+'<br>'+LineEnding;
if XYPos.Code=nil then
CTTool.CleanPosToCaret(CTNode.StartPos,XYPos);
HTMLHint:=HTMLHint+SourcePosToFPDocHint(XYPos);
ElementName:=CodeNodeToElementName(CTTool,CTNode);
// ToDo: check if ElementName already added (can happen on forward definitions)
FPDocFilename:=GetFPDocFilenameForSource(CTTool.MainFilename,
false,CacheWasUsed,AnOwner);
DebugLn(['TCodeHelpManager.GetHTMLHint2 FPDocFilename=',FPDocFilename,' ElementName="',ElementName,'"']);
if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
if FPDocFilename<>'' then begin
// load FPDoc file
LoadFPDocFile(FPDocFilename,[chofUpdateFromDisk],FPDocFile,CacheWasUsed);
if (not CacheWasUsed) and (not Complete) then exit(chprParsing);
ElementNode:=FPDocFile.GetElementWithName(ElementName);
if ElementNode<>nil then begin
debugln(['TCodeHelpManager.GetHTMLHint2 fpdoc element found "',ElementName,'"']);
HTMLHint:=HTMLHint+GetFPDocNodeAsHTML(ElementNode.FindNode(FPDocItemNames[fpdiShort]));
HTMLHint:=HTMLHint+GetFPDocNodeAsHTML(ElementNode.FindNode(FPDocItemNames[fpdiDescription]));
end;
end;
except
on E: Exception do begin
debugln(['TCodeHelpManager.GetHTMLHint2 ',E.Message]);
end;
end;
finally
FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
end;
debugln(['TCodeHelpManager.GetHTMLHint2 ',HTMLHint]);
Result:=chprSuccess;
end;
function TCodeHelpManager.GetPasDocCommentsAsHTML(Tool: TCodeTool;
Node: TCodeTreeNode): string;
var
ListOfPCodeXYPosition: TFPList;
i: Integer;
CodeXYPos: PCodeXYPosition;
CommentCode: TCodeBuffer;
CommentStart: integer;
NestedComments: Boolean;
CommentStr: String;
begin
Result:='';
if (Tool=nil) or (Node=nil) then exit;
ListOfPCodeXYPosition:=nil;
try
if not Tool.GetPasDocComments(Node,ListOfPCodeXYPosition) then exit;
if ListOfPCodeXYPosition=nil then exit;
NestedComments := Tool.Scanner.NestedComments;
for i := 0 to ListOfPCodeXYPosition.Count - 1 do
begin
CodeXYPos := PCodeXYPosition(ListOfPCodeXYPosition[i]);
CommentCode := CodeXYPos^.Code;
CommentCode.LineColToPosition(CodeXYPos^.Y,CodeXYPos^.X,CommentStart);
if (CommentStart<1) or (CommentStart>CommentCode.SourceLength)
then
continue;
CommentStr:=ExtractCommentContent(CommentCode.Source,CommentStart,
NestedComments,true,true,true);
if CommentStr <> '' then
Result:=Result+'<span class="comment">'+TextToHTML(CommentStr)+'</span><br>'+LineEnding;
end;
finally
FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
end;
end;
function TCodeHelpManager.GetFPDocNodeAsHTML(DOMNode: TDOMNode): string;
function NodeToHTML(Node: TDOMNode): string; forward;
function AddChilds(Node: TDOMNode): string;
var
Child: TDOMNode;
Element: TDOMElement;
begin
Result:='';
if Node is TDOMElement then begin
Element:=TDOMElement(Node);
end else begin
Child:=Node.FirstChild;
while Child<>nil do begin
Result:=Result+NodeToHTML(Child);
Child:=Child.NextSibling;
end;
end;
end;
function NodeToHTML(Node: TDOMNode): string;
var
s: String;
begin
Result:='';
if Node=nil then exit;
if (Node.NodeName='short')
or (Node.NodeName='descr') then begin
s:=AddChilds(Node);
if s<>'' then
Result:=Result+'<div class="'+Node.NodeName+'">'+AddChilds(Node)+'</div>';
end else begin
debugln(['Traverse ',Node.NodeName]);
end;
end;
begin
Result:=NodeToHTML(DOMNode);
end;
function TCodeHelpManager.TextToHTML(Txt: string): string;
var
p: Integer;
begin
Result:=Txt;
p:=length(Result);
while p>0 do
begin
case Result[p] of
'<': Result:=copy(Result,1,p-1)+'&lt;'+copy(Result,p+1,length(Result));
'>': Result:=copy(Result,1,p-1)+'&gt;'+copy(Result,p+1,length(Result));
'&': Result:=copy(Result,1,p-1)+'&amp;'+copy(Result,p+1,length(Result));
#10,#13:
begin
if (p>1) and (Result[p-1] in [#10,#13]) and (Result[p-1]<>Result[p]) then
dec(p);
Result:=copy(Result,1,p-1)+'<br>'+copy(Result,p,length(Result));
end;
end;
dec(p);
end;
end;
function TCodeHelpManager.CreateElement(Code: TCodeBuffer; X, Y: integer;
out Element: TCodeHelpElement): Boolean;
var
@ -2427,6 +2615,79 @@ begin
end;
end;
function TCodeHelpManager.SourceToFPDocHint(Src: string; NestedComments: boolean
): string;
procedure EndSpan(SpanName: string; var r: string);
begin
if SpanName='' then exit;
r:=r+'</span>';
end;
procedure StartSpan(SpanName: string; var r: string);
begin
if SpanName='' then exit;
r:=r+'<span class="'+SpanName+'">';
end;
function TokenIDToSpan(TokenID: TtkTokenKind): string;
begin
case TokenID of
tkComment: Result:='comment';
tkIdentifier: Result:='identifer';
tkKey: Result:='keyword';
tkNumber: Result:='number';
tkString: Result:='string';
tkSymbol: Result:='symbol';
tkDirective: Result:='directive';
else Result:='';
end;
end;
var
TokenID: TtkTokenKind;
LastTokenID: TtkTokenKind;
Token: String;
begin
Result:='';
PasHighlighter.NestedComments:=NestedComments;
PasHighlighter.ResetRange;
PasHighlighter.SetLine(Src,0);
LastTokenID:=tkUnknown;
while not PasHighlighter.GetEol do begin
TokenID:=PasHighlighter.GetTokenID;
if (Result<>'') and (LastTokenID<>TokenID) then
EndSpan(TokenIDToSpan(LastTokenID),Result);
if (Result='') or (LastTokenID<>TokenID) then
StartSpan(TokenIDToSpan(TokenID),Result);
Token:=PasHighlighter.GetToken;
//debugln(['TCodeHelpManager.SourceToFPDocHint ',Token,' ',ord(TokenID)]);
Result:=Result+TextToHTML(Token);
LastTokenID:=TokenID;
PasHighlighter.Next;
end;
if (Result<>'') and (LastTokenID<>tkUnknown) then
EndSpan(TokenIDToSpan(LastTokenID),Result);
end;
function TCodeHelpManager.SourcePosToFPDocHint(XYPos: TCodeXYPosition;
Caption: string): string;
var
Link: String;
begin
Result:='';
if XYPos.Code=nil then exit;
Link:=XYPos.Code.Filename;
if XYPos.Y>=1 then begin
Link:=Link+'('+IntToStr(XYPos.Y);
if XYPos.X>=1 then
Link:=Link+','+IntToStr(XYPos.X);
Link:=Link+')';
end;
if Caption='' then Caption:=Link;
Result:='<a href="source://'+Link+'">'+Caption+'</a>';
end;
procedure TCodeHelpManager.FreeDocs;
var
AVLNode: TAvgLvlTreeNode;

1
ide/fpdochints.pas
View File

@ -36,7 +36,6 @@ uses
IDEHelpIntf, SrcEditorIntf, SrcEditHintFrm, CodeHelp;
type
{ TFPDocHintProvider }
TFPDocHintProvider = class(TCodeHintProvider)

2
ide/helpmanager.pas
View File

@ -779,7 +779,7 @@ begin
RegisterIDEHelpDatabases;
RegisterDefaultIDEHelpViewers;
CodeHelpBoss:=TCodeHelpManager.Create;
CodeHelpBoss:=TCodeHelpManager.Create(Self);
// register property editors for URL handling
RegisterPropertyEditor(TypeInfo(AnsiString),

2
ide/msgquickfixes.pas
View File

@ -641,7 +641,7 @@ begin
exit;
end;
Identifier:=REVar(1);
DebugLn(['TQuickFixIdentifierNotFoundAddLocal.Execute Identifier=',Identifier,' ',DbgsCXY(CodeXY)]);
DebugLn(['TQuickFixIdentifierNotFoundAddLocal.Execute Identifier=',Identifier,' ',Dbgs(CodeXY)]);
if not IsIdentifierInCode(CodeXY.Code,CodeXY.X,CodeXY.Y,Identifier,
Identifier+' not found in '+CodeBuf.Filename

1
packager/pkgmanager.pas
View File

@ -3099,6 +3099,7 @@ begin
PkgFile:=PackageGraph.FindFileInAllPackages(UnitFilename,true,true);
if (PkgFile<>nil) and (PkgFile.LazPackage<>nil) then
Result.Add(PkgFile.LazPackage);
//debugln(['TPkgManager.GetPossibleOwnersOfUnit ',UnitFilename,' ',PkgFile<>nil,' ',(PkgFile<>nil) and (PkgFile.LazPackage<>nil),' Result.Count=',Result.Count]);
// check package source files (they usually do not have a TPkgFile)
for i:=0 to PackageGraph.Count-1 do begin
CurPackage:=PackageGraph.Packages[i];