paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-02 13:19:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

IDE: implemented showing help for identifier completion

Browse Source 
git-svn-id: trunk@15065 -
This commit is contained in:
mattias 2008-05-06 21:37:25 +00:00
parent 5122d3eaaf
commit 1c51099541
7 changed files with 125 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/codetools/customcodetool.pas
View File

@ -1984,7 +1984,7 @@ begin
else
inc(FTreeChangeStep);
if NodesDeleting then begin
DebugLn(['TCustomCodeTool.IncreaseTreeChangeStep NodesDeleting ',MainFilename,' ',Tree<>nil,' ',(Tree<>nil) and (Tree.Root<>nil)]);
//DebugLn(['TCustomCodeTool.IncreaseTreeChangeStep NodesDeleting ',MainFilename,' ',Tree<>nil,' ',(Tree<>nil) and (Tree.Root<>nil)]);
if FNodesDeletedChangeStep=High(integer) then
FNodesDeletedChangeStep:=Low(integer)
else

12
components/codetools/identcompletiontool.pas
View File

@ -743,14 +743,14 @@ begin
if (Tool.Tree=nil) then exit;
RootNode:=Tool.Tree.Root;
if RootNode=nil then exit;
DebugLn(['TIdentifierList.ToolTreeChange START ',Tool.MainFilename]);
//DebugLn(['TIdentifierList.ToolTreeChange START ',Tool.MainFilename]);
if FIdentView.Count=0 then exit;
DebugLn(['TIdentifierList.ToolTreeChange ',Tool.MainFilename]);
//DebugLn(['TIdentifierList.ToolTreeChange ',Tool.MainFilename]);
AVLNode:=FIdentView.FindLowest;
while AVLNode<>nil do begin
Item:=TIdentifierListItem(AVLNode.Data);
if (Item.FNode<>nil) and (Item.Tool=Tool) then begin
DebugLn(['TIdentifierList.ToolTreeChange ',Item.Identifier]);
//DebugLn(['TIdentifierList.ToolTreeChange ',Item.Identifier]);
Item.UnbindNode;
end;
AVLNode:=FIdentView.FindSuccessor(AVLNode);
@ -2023,7 +2023,7 @@ begin
FNodeStartPos:=FNode.StartPos;
FNodeDesc:=FNode.Desc;
FNodeHash:=GetNodeHash(FNode);
DebugLn(['TIdentifierListItem.StoreNodeHash ',Identifier,' Pos=',FNodeStartPos,' Hash=',FNodeHash]);
//DebugLn(['TIdentifierListItem.StoreNodeHash ',Identifier,' Pos=',FNodeStartPos,' Hash=',FNodeHash]);
end;
function TIdentifierListItem.RestoreNode: boolean;
@ -2032,7 +2032,7 @@ var
NewHash: String;
begin
if not (iliNodeHashValid in Flags) then exit(true);
DebugLn(['TIdentifierListItem.RestoreNode ',Identifier]);
//DebugLn(['TIdentifierListItem.RestoreNode ',Identifier]);
NewNode:=Tool.FindDeepestExpandedNodeAtPos(FNodeStartPos,false);
Result:=false;
if (NewNode=nil) or (NewNode.StartPos<>FNodeStartPos)
@ -2047,7 +2047,7 @@ begin
Exclude(Flags,iliNodeHashValid);
exit;
end;
DebugLn(['TIdentifierListItem.RestoreNode Success ',Identifier]);
//DebugLn(['TIdentifierListItem.RestoreNode Success ',Identifier]);
Node:=NewNode;
Result:=true;
end;

6
components/codetools/pascalparsertool.pas
View File

@ -4072,9 +4072,13 @@ var HasForwardModifier, IsFunction, IsOperator, IsMethod: boolean;
begin
if ProcNode.Desc=ctnProcedureHead then ProcNode:=ProcNode.Parent;
if (ProcNode=nil) or (not (ProcNode.Desc in [ctnProcedure,ctnProcedureType]))
or (ProcNode.FirstChild=nil) then
or (ProcNode.FirstChild=nil) then begin
{$IFDEF CheckNodeTool}
CTDumpStack;
{$ENDIF}
RaiseException('[TPascalParserTool.BuildSubTreeForProcHead] '
+'internal error: invalid ProcNode');
end;
if (ProcNode.FirstChild.SubDesc and ctnsNeedJITParsing)=0 then exit;
ProcNode.FirstChild.SubDesc:=
ProcNode.FirstChild.SubDesc and (not ctnsNeedJITParsing);

7
ide/codehelp.pas
View File

@ -29,6 +29,11 @@ unit CodeHelp;
{$mode objfpc}{$H+}
{off $DEFINE VerboseLazDoc}
{off $DEFINE VerboseLazDocFails}
{$IFDEF VerboseLazDoc}
{$DEFINE VerboseLazDocFails}
{$ENDIF}
interface
@ -1479,7 +1484,7 @@ begin
// get the declaration chain
Result:=GetDeclarationChain(Code,X,Y,ListOfPCodeXYPosition,CacheWasUsed);
if Result<>chprSuccess then begin
{$IFDEF VerboseLazDoc}
{$IFDEF VerboseLazDocFails}
DebugLn(['TCodeHelpManager.GetElementChain GetDeclarationChain failed ',Code.Filename,' x=',x,' y=',y]);
{$ENDIF}
exit;

128
ide/fpdochints.pas
View File

@ -30,10 +30,10 @@ unit FPDocHints;
interface
uses
Classes, SysUtils, LCLProc, Forms, Controls, Graphics,
CodeToolManager, CodeCache, BasicCodeTools, IdentCompletionTool,
SrcEditorIntf,
SrcEditHintFrm, CodeHelp;
Classes, SysUtils, LCLProc, Forms, Controls, Graphics, StdCtrls,
CodeToolManager, CodeCache, BasicCodeTools, IdentCompletionTool, CodeTree,
CodeAtom,
IDEHelpIntf, SrcEditorIntf, SrcEditHintFrm, CodeHelp;
type
@ -43,13 +43,18 @@ type
private
FHintValid: boolean;
FWaitingForIdle: boolean;
FBaseURL: string;
FHTMLHint: string;
FHTMLControl: TControl;
FHTMLProvider: TAbstractIDEHTMLProvider;
FTextControl: TLabel;
procedure SetHintValid(const AValue: boolean);
procedure SetWaitingForIdle(const AValue: boolean);
procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
procedure ReadLazDocData;
procedure UpdateHintControl;
public
destructor Destroy; override;
procedure Paint(Canvas: TCanvas; const ARect: TRect); override;
procedure UpdateHint; override;
property WaitingForIdle: boolean read FWaitingForIdle write SetWaitingForIdle;
property HintValid: boolean read FHintValid write SetHintValid;
@ -88,11 +93,16 @@ procedure TFPDocHintProvider.ReadLazDocData;
var
Position: LongInt;
Item: TIdentifierListItem;
Code: TCodeBuffer;
CacheWasUsed: boolean;
Chain: TCodeHelpElementChain;
Y,X: integer;
Node: TCodeTreeNode;
HelpResult: TCodeHelpParseResult;
Caret: TCodeXYPosition;
CleanPos: LongInt;
begin
FBaseURL:='';
FHTMLHint:='';
// find current completion item
if (SourceEditorWindow=nil) or (CodeToolBoss=nil)
or (CodeToolBoss.IdentifierList=nil) then
exit;
@ -101,45 +111,97 @@ begin
exit;
Item:=CodeToolBoss.IdentifierList.FilteredItems[Position];
DebugLn(['TFPDocHintProvider.ReadLazDocData Identifier=',Item.Identifier]);
Chain:=nil;
try
if (Item.Node<>nil) then begin
if (Item.Tool.Scanner=nil) then exit;
Code:=TCodeBuffer(Item.Tool.Scanner.MainCode);
if Code=nil then begin
DebugLn(['TFPDocHintProvider.ReadLazDocData FAILED Tool without MainCode']);
exit;
// find current codetool node
Node:=Item.Node;
if (Node=nil) then begin
DebugLn(['TFPDocHintProvider.ReadLazDocData FAILED no node']);
exit;
end;
if (Item.Tool.Scanner=nil) then exit;
//DebugLn(['TFPDocHintProvider.ReadLazDocData Src=',copy(Item.Tool.Src,Node.StartPos,30),' ',Node.DescAsString]);
// search the position of the identifier, not the keyword
CleanPos:=Node.StartPos;
case Node.Desc of
ctnProcedure:
begin
Item.Tool.MoveCursorToProcName(Node,true);
CleanPos:=Item.Tool.CurPos.StartPos;
end;
Code.AbsoluteToLineCol(Item.Node.StartPos,Y,X);
if (Y<1) or (X<1) then begin
DebugLn(['TFPDocHintProvider.ReadLazDocData FAILED X=',X,' Y=',Y]);
exit;
ctnProperty:
begin
if Item.Tool.MoveCursorToPropName(Node) then
CleanPos:=Item.Tool.CurPos.StartPos;
end;
CodeHelpBoss.GetElementChain(Code,X,Y,true,Chain,CacheWasUsed);
DebugLn(['TFPDocHintProvider.ReadLazDocData Chain=',Chain<>nil]);
if Chain=nil then begin
DebugLn(['TFPDocHintProvider.ReadLazDocData FAILED Chain=nil']);
exit;
end;
end else begin
end;
// get help text
if (not Item.Tool.CleanPosToCaret(CleanPos,Caret)) then begin
DebugLn(['TFPDocHintProvider.ReadLazDocData FAILED CleanPosToCaret']);
exit;
end;
//DebugLn(['TFPDocHintProvider.ReadLazDocData ',Item.Identifier,' ',Item.Tool.MainFilename,' ',Caret.Code.Filename,' ',Caret.X,',',Caret.Y]);
HelpResult:=CodeHelpBoss.GetHTMLHint(Caret.Code,Caret.X,Caret.Y,true,
FBaseURL,FHTMLHint,CacheWasUsed);
if HelpResult<>chprSuccess then begin
DebugLn(['TFPDocHintProvider.ReadLazDocData FAILED Identifier=',Item.Identifier]);
exit;
end;
finally
Chain.Free;
UpdateHintControl;
end;
end;
procedure TFPDocHintProvider.UpdateHintControl;
var
IsHTML: Boolean;
ms: TMemoryStream;
begin
IsHTML:=SysUtils.CompareText(copy(FHTMLHint,1,6),'<HTML>')=0;
if IsHTML then begin
if (FHTMLControl=nil) then begin
FHTMLProvider:=nil;
FHTMLControl:=CreateIDEHTMLControl(nil,FHTMLProvider);
FHTMLControl.Parent:=Control;
FHTMLControl.Align:=alClient;
end;
if FTextControl<>nil then
FTextControl.Visible:=false;
FHTMLControl.Visible:=true;
FHTMLProvider.BaseURL:=FBaseURL;
ms:=TMemoryStream.Create;
try
if FHTMLHint<>'' then
ms.Write(FHTMLHint[1],length(FHTMLHint));
ms.Position:=0;
FHTMLProvider.ControlIntf.SetHTMLContent(ms);
finally
ms.Free;
end;
end else begin
if (FTextControl=nil) then begin
FTextControl:=TLabel.Create(nil);
FTextControl.Parent:=Control;
FTextControl.Align:=alClient;
FTextControl.WordWrap:=true;
end;
if FHTMLControl<>nil then
FHTMLControl.Visible:=false;
FTextControl.Visible:=true;
FTextControl.Caption:=FHTMLHint;
end;
end;
destructor TFPDocHintProvider.Destroy;
begin
FHTMLProvider:=nil;
FreeAndNil(FHTMLControl);
FreeAndNil(FTextControl);
WaitingForIdle:=false;
inherited Destroy;
end;
procedure TFPDocHintProvider.Paint(Canvas: TCanvas; const ARect: TRect);
begin
end;
procedure TFPDocHintProvider.UpdateHint;
begin
WaitingForIdle:=true;

6
ide/sourceeditor.pp
View File

@ -3558,11 +3558,15 @@ var
OldCompletionControl: TSynCompletion;
begin
if CurCompletionControl=nil then exit;
// clear the IdentifierList (otherwise it would try to update everytime
// the codetools are used)
CodeToolBoss.IdentifierList.Clear;
OldCompletionControl:=CurCompletionControl;
CurCompletionControl:=nil;
OldCompletionControl.Deactivate;
CurrentCompletionType:=ctNone;
ActSE:=GetActiveSE;
if ActSE<>nil then begin

26
ide/srcedithintfrm.pas
View File

@ -41,24 +41,24 @@ type
TCodeHintProvider = class(TComponent)
private
FControl: TControl;
FControl: TWinControl;
protected
procedure SetControl(const AValue: TControl); virtual;
procedure SetControl(const AValue: TWinControl); virtual;
public
procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer); virtual;
procedure Paint(Canvas: TCanvas; const ARect: TRect); virtual; abstract;
procedure UpdateHint; virtual;
property Control: TControl read FControl write SetControl;
property Control: TWinControl read FControl write SetControl;
end;
{ TCodeHintFrm }
{ TSrcEditHintWindow }
TSrcEditHintWindow = class(THintWindow)
procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormPaint(Sender: TObject);
procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
private
FAnchorForm: TCustomForm;
@ -136,18 +136,6 @@ begin
end;
end;
procedure TSrcEditHintWindow.FormPaint(Sender: TObject);
begin
if Provider<>nil then begin
Provider.Paint(Canvas,Rect(0,0,ClientWidth,ClientHeight));
end else begin
with Canvas do begin
Font.SetDefault;
TextOut(6,20,'No help available (missing provider)');
end;
end;
end;
procedure TSrcEditHintWindow.FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char
);
var
@ -311,7 +299,7 @@ end;
procedure TSrcEditHintWindow.Paint;
begin
FormPaint(Self);
end;
constructor TSrcEditHintWindow.Create(TheOwner: TComponent);
@ -352,7 +340,7 @@ end;
{ TCodeHintProvider }
procedure TCodeHintProvider.SetControl(const AValue: TControl);
procedure TCodeHintProvider.SetControl(const AValue: TWinControl);
begin
if FControl=AValue then exit;
FControl:=AValue;