1 { 2 *************************************************************************** 3 * * 4 * This source is free software; you can redistribute it and/or modify * 5 * it under the terms of the GNU General Public License as published by * 6 * the Free Software Foundation; either version 2 of the License, or * 7 * (at your option) any later version. * 8 * * 9 * This code is distributed in the hope that it will be useful, but * 10 * WITHOUT ANY WARRANTY; without even the implied warranty of * 11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 12 * General Public License for more details. * 13 * * 14 * A copy of the GNU General Public License is available on the World * 15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 16 * obtain it by writing to the Free Software Foundation, * 17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * 18 * * 19 *************************************************************************** 20 21 Author: Mattias Gaertner 22 23 Abstract: 24 A hint using the fpdoc data. 25 } 26 unit FPDocHints; 27 28 {$mode objfpc}{$H+} 29 30 interface 31 32 uses 33 Classes, SysUtils, LCLProc, Forms, Controls, Graphics, StdCtrls, 34 CodeToolManager, CodeCache, IdentCompletionTool, CodeTree, 35 IDEHelpIntf, SrcEditorIntf, SrcEditHintFrm, CodeHelp; 36 37 type 38 { TFPDocHintProvider } 39 40 TFPDocHintProvider = class(TCodeHintProvider) 41 private 42 FHintValid: boolean; 43 FWaitingForIdle: boolean; 44 FBaseURL: string; 45 FHTMLHint: string; 46 FHTMLControl: TControl; 47 FHTMLProvider: TAbstractIDEHTMLProvider; 48 FTextControl: TLabel; 49 procedure SetHintValid(const AValue: boolean); 50 procedure SetWaitingForIdle(const AValue: boolean); 51 procedure ApplicationIdle(Sender: TObject; var {%H-}Done: Boolean); 52 procedure DoUpdateHint; 53 procedure UpdateHintControl; 54 public 55 destructor Destroy; override; 56 procedure UpdateHint; override; 57 property WaitingForIdle: boolean read FWaitingForIdle write SetWaitingForIdle; 58 property HintValid: boolean read FHintValid write SetHintValid; 59 end; 60 61 implementation 62 63 { TFPDocHintProvider } 64 65 procedure TFPDocHintProvider.SetWaitingForIdle(const AValue: boolean); 66 begin 67 if FWaitingForIdle=AValue then exit; 68 FWaitingForIdle:=AValue; 69 if Application<>nil then begin 70 if FWaitingForIdle then 71 Application.AddOnIdleHandler(@ApplicationIdle) 72 else 73 Application.RemoveOnIdleHandler(@ApplicationIdle); 74 end; 75 end; 76 77 procedure TFPDocHintProvider.SetHintValid(const AValue: boolean); 78 begin 79 if FHintValid=AValue then exit; 80 FHintValid:=AValue; 81 end; 82 83 procedure TFPDocHintProvider.ApplicationIdle(Sender: TObject; var Done: Boolean); 84 begin 85 WaitingForIdle:=false; 86 DoUpdateHint; 87 end; 88 89 procedure TFPDocHintProvider.DoUpdateHint; 90 var 91 Position: LongInt; 92 Item: TIdentifierListItem; 93 CacheWasUsed: boolean; 94 Node: TCodeTreeNode; 95 HelpResult: TCodeHelpParseResult; 96 Caret: TCodeXYPosition; 97 CleanPos: LongInt; 98 BaseDir, PropDetails: String; 99 begin 100 FBaseURL:=''; 101 FHTMLHint:=''; 102 103 if (Control=nil) or (not Control.IsVisible) then exit; 104 //debugln(['TFPDocHintProvider.DoUpdateHint ',DbgSName(Control)]); 105 106 // find current completion item 107 if (SourceEditorManagerIntf=nil) or (CodeToolBoss=nil) 108 or (CodeToolBoss.IdentifierList=nil) then 109 exit; 110 Position:=SourceEditorManagerIntf.CompletionBoxPosition; 111 if (Position<0) or (Position>=CodeToolBoss.IdentifierList.GetFilteredCount) then 112 exit; 113 Item:=CodeToolBoss.IdentifierList.FilteredItems[Position]; 114 DebugLn(['TFPDocHintProvider.DoUpdateHint Identifier=',Item.Identifier]); 115 try 116 FBaseURL:=''; 117 FHTMLHint:='<HTML><BODY>No help available.</BODY></HTML>'; 118 // find current codetool node 119 Node:=Item.Node; 120 if (Node=nil) then begin 121 if (Item.DefaultDesc=ctnUnit) 122 and (CodeToolBoss.IdentifierList.StartContextPos.Code<>nil) then begin 123 BaseDir:=CodeToolBoss.IdentifierList.StartContextPos.Code.Filename; 124 HelpResult:=CodeHelpBoss.GetHTMLHintForUnit(Item.Identifier,'',BaseDir, 125 [chhoDeclarationHeader,chhoComments], 126 FBaseURL,FHTMLHint,CacheWasUsed); 127 if HelpResult<>chprSuccess then begin 128 DebugLn(['TFPDocHintProvider.DoUpdateHint FAILED Unit=',Item.Identifier]); 129 end; 130 exit; 131 end; 132 DebugLn(['TFPDocHintProvider.DoUpdateHint FAILED no node ',NodeDescriptionAsString(Item.DefaultDesc),' Identifier=',Item.Identifier]); 133 exit; 134 end; 135 if (Item.Tool.Scanner=nil) then exit; 136 //DebugLn(['TFPDocHintProvider.DoUpdateHint Src=',copy(Item.Tool.Src,Node.StartPos,30),' ',Node.DescAsString]); 137 138 // search the position of the identifier, not the keyword 139 CleanPos:=Node.StartPos; 140 case Node.Desc of 141 ctnProcedure: 142 begin 143 Item.Tool.MoveCursorToProcName(Node,true); 144 CleanPos:=Item.Tool.CurPos.StartPos; 145 end; 146 ctnProperty: 147 begin 148 if Item.Tool.MoveCursorToPropName(Node) then 149 CleanPos:=Item.Tool.CurPos.StartPos; 150 end; 151 end; 152 153 // get help text 154 if (not Item.Tool.CleanPosToCaret(CleanPos,Caret)) then begin 155 DebugLn(['TFPDocHintProvider.DoUpdateHint FAILED CleanPosToCaret Tool=',Item.Tool.MainFilename,' CleanPos=',CleanPos,' SrcLen=',Item.Tool.SrcLen]); 156 exit; 157 end; 158 //DebugLn(['TFPDocHintProvider.DoUpdateHint ',Item.Identifier,' ',Item.Tool.MainFilename,' ',Caret.Code.Filename,' ',Caret.X,',',Caret.Y]); 159 HelpResult:=CodeHelpBoss.GetHTMLHint(Caret.Code,Caret.X,Caret.Y, 160 [chhoDeclarationHeader,chhoComments], 161 FBaseURL,FHTMLHint,PropDetails,CacheWasUsed); 162 if HelpResult<>chprSuccess then begin 163 DebugLn(['TFPDocHintProvider.DoUpdateHint FAILED Identifier=',Item.Identifier]); 164 exit; 165 end; 166 finally 167 UpdateHintControl; 168 end; 169 end; 170 171 procedure TFPDocHintProvider.UpdateHintControl; 172 var 173 IsHTML: Boolean; 174 ms: TMemoryStream; 175 begin 176 IsHTML:=SysUtils.CompareText(copy(FHTMLHint,1,6),'<HTML>')=0; 177 if IsHTML then begin 178 if (FHTMLControl=nil) then begin 179 FHTMLProvider:=nil; 180 FHTMLControl:=CreateIDEHTMLControl(nil,FHTMLProvider); 181 FHTMLControl.Parent:=Control; 182 FHTMLControl.Align:=alClient; 183 end; 184 if FTextControl<>nil then 185 FTextControl.Visible:=false; 186 FHTMLControl.Visible:=true; 187 FHTMLProvider.BaseURL:=FBaseURL; 188 //debugln(['TFPDocHintProvider.UpdateHintControl FHTMLControl=',DbgSName(FHTMLControl),' FHTMLProvider=',DbgSName(FHTMLProvider)]); 189 ms:=TMemoryStream.Create; 190 try 191 if FHTMLHint<>'' then 192 ms.Write(FHTMLHint[1],length(FHTMLHint)); 193 ms.Position:=0; 194 FHTMLProvider.ControlIntf.SetHTMLContent(ms,''); 195 finally 196 ms.Free; 197 end; 198 end else begin 199 if (FTextControl=nil) then begin 200 FTextControl:=TLabel.Create(nil); 201 FTextControl.Parent:=Control; 202 FTextControl.Align:=alClient; 203 FTextControl.WordWrap:=true; 204 end; 205 if FHTMLControl<>nil then 206 FHTMLControl.Visible:=false; 207 FTextControl.Visible:=true; 208 FTextControl.Caption:=FHTMLHint; 209 end; 210 end; 211 212 destructor TFPDocHintProvider.Destroy; 213 begin 214 // important: free provider before control 215 FreeAndNil(FHTMLProvider); 216 FreeAndNil(FTextControl); 217 FreeAndNil(FHTMLControl); 218 WaitingForIdle:=false; 219 inherited Destroy; 220 end; 221 222 procedure TFPDocHintProvider.UpdateHint; 223 begin 224 WaitingForIdle:=true; 225 inherited UpdateHint; 226 end; 227 228 end. 229 230