Bernd Kreuss wrote:
> OK I have the fancy fpdoc and comment hints working for the codebrowser too.
> 
> I will clean it all up now and prepare a patch. It is not much code,
> simpler than I have initially thought.

OK, here is the patch. It works against current svn trunk and will
enable the same sot of mouse-over hints that exist in the source editor
also in the code browser.

Please somebody review it and tell me if this is acceptable.


Index: ide/codebrowser.pas
===================================================================
--- ide/codebrowser.pas	(Revision 26827)
+++ ide/codebrowser.pas	(Arbeitskopie)
@@ -52,11 +52,11 @@
   CodeIndex, StdCodeTools, SourceLog,
   // IDEIntf
   IDEWindowIntf, SrcEditorIntf, IDEMsgIntf, IDEDialogs, LazConfigStorage,
-  PackageIntf, TextTools, IDECommands, LazIDEIntf,
+  PackageIntf, TextTools, IDECommands, LazIDEIntf, IDEHelpIntf,
   // IDE
   Project, DialogProcs, PackageSystem, PackageDefs, LazarusIDEStrConsts,
   IDEOptionDefs, MsgQuickFixes, BasePkgManager, AddToProjectDlg,
-  EnvironmentOpts;
+  EnvironmentOpts, HelpManager;
 
 
 type
@@ -215,6 +215,8 @@
     UnitFilterBeginsSpeedButton: TSpeedButton;
     UnitFilterContainsSpeedButton: TSpeedButton;
     UnitFilterEdit: TEdit;
+    procedure BrowseTreeViewMouseMove(Sender: TObject; Shift: TShiftState; X,
+      Y: Integer);
     procedure UseIdentifierInCurUnitMenuItemClick(Sender: TObject);
     procedure UsePkgInCurUnitMenuItemClick(Sender: TObject);
     procedure UsePkgInProjectMenuItemClick(Sender: TObject);
@@ -248,6 +250,7 @@
     procedure ShowPrivateCheckBoxChange(Sender: TObject);
     procedure ShowUnitsCheckBoxChange(Sender: TObject);
   private
+    FHintWindow: THintWindow;
     FIDEDescription: string;
     FOptions: TCodeBrowserViewOptions;
     FOptionsChangeStamp: integer;
@@ -2433,6 +2436,9 @@
   CurUnit: TCodeBrowserUnit;
   Node: TCodeBrowserNode;
   Line, Column: integer;
+  CodePos: TPoint;
+  BaseURL, HTMLHint: String;
+
 begin
   Result:='';
   if (TVNode=nil) or (TVNode.Data=nil) then exit;
@@ -2450,7 +2456,32 @@
       Result:=TVNode.Text+#13+Node.CodePos.Code.Filename;
       Node.CodePos.Code.AbsoluteToLineCol(Node.CodePos.P,Line,Column);
       if Line>0 then
+      begin
         Result:=Result+' ('+IntToStr(Line)+','+IntToStr(Column)+')';
+
+        // let's try if the helpmanager can create a
+        // better hint with fpdoc and comments
+        CodePos.X:= Column;
+        CodePos.Y:= Line;
+
+        // if we point it at words like "function" it won't
+        // give us any help. We must point it at the identifier.
+        case LowerCase(LeftStr(TVNode.Text, 7)) of
+          'functio' : CodePos.X += 9;
+          'procedu' : CodePos.X += 10;
+          'class f' : CodePos.X += 15;
+          'class p' : CodePos.X += 16;
+        end;
+        TIDEHelpManager(HelpBoss).GetHintForSourcePosition(Node.CodePos.Code.Filename, CodePos, BaseURL, HTMLHint);
+
+        // if there is HTMLHelp then it must not contain
+        // anything else or it would break the display of
+        // the html-aware text label. Throw away the
+        // plaintext in Result that we have already
+        // and only use the HTML version.
+        if HTMLHint <> '' then
+           Result := HTMLHint;
+      end;
     end;
   end;
 end;
@@ -2784,6 +2815,7 @@
   TVNode: TTreeNode;
   HintStr: String;
   MousePos: TPoint;
+  HintWinRect : TRect;
 begin
   //DebugLn(['TCodeBrowserView.BrowseTreeViewShowHint ',dbgs(HintInfo^.CursorPos)]);
   HintStr:='';
@@ -2793,7 +2825,19 @@
     HintStr:=GetTVNodeHint(TVNode);
     //DebugLn(['TCodeBrowserView.BrowseTreeViewShowHint HintStr="',HintStr,'"']);
   end;
-  HintInfo^.HintStr:=HintStr;
+
+  HintInfo^.HintStr:=''; // force it to not show the built in hint window
+
+  // open a THintWindow with LazarusHelp instead
+  if hintstr = '' then
+     exit;
+  if csDestroying in ComponentState then exit;
+  if FHintWindow <> nil then
+    FHintWindow.Visible := false;
+  if FHintWindow = nil then
+    FHintWindow := THintWindow.Create(Self);
+  if LazarusHelp.CreateHint(FHintWindow, HintInfo^.HintPos, '', HintStr, HintWinRect) then
+      FHintWindow.ActivateHint(HintWinRect, HintStr);
 end;
 
 procedure TCodeBrowserView.CollapseAllPackagesMenuItemClick(Sender: TObject);
@@ -2888,6 +2932,16 @@
   UseUnitInSrcEditor(true);
 end;
 
+procedure TCodeBrowserView.BrowseTreeViewMouseMove(Sender: TObject;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  if FHintWindow <> nil then
+  begin
+     FHintWindow.Close;
+     FHintWindow := nil;
+  end;
+end;
+
 { TCodeBrowserViewOptions }
 
 procedure TCodeBrowserViewOptions.SetModified(const AValue: boolean);
Index: ide/codebrowser.lfm
===================================================================
--- ide/codebrowser.lfm	(Revision 26827)
+++ ide/codebrowser.lfm	(Arbeitskopie)
@@ -147,6 +147,7 @@
     ShowHint = True
     TabOrder = 2
     OnMouseDown = BrowseTreeViewMouseDown
+    OnMouseMove = BrowseTreeViewMouseMove
     OnShowHint = BrowseTreeViewShowHint
     Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw]
   end
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus

Reply via email to