Implemented better mouse hover using posframe

Author: yyoncho

dap-mouse.el

@@ -37,24 +37,44 @@ applied with lower priority than the syntax highlighting."
   :group 'dap
   :package-version '(dap "0.9.1"))
 
+(defvar dap-mouse--hide-timer nil)
+
+(defvar dap-mouse-posframe-properties
+  (list :min-width 50
+        :internal-border-width 2
+        :internal-border-color (face-attribute 'mode-line :background)
+        :width 50
+        :min-height 10)
+  "The properties which will be used for creating the `posframe'.")
+
+(defconst dap-mouse-buffer "*dap-mouse*")
+
+(defun dap-mouse--hide-popup? ()
+  (let ((buffer-under-mouse (window-buffer (cl-first (window-list (cl-first (mouse-position))))))
+        (popup-buffer (get-buffer dap-mouse-buffer)))
+    (not (or (and (eq (current-buffer) popup-buffer)
+                  (eq buffer-under-mouse popup-buffer))
+             (eq buffer-under-mouse popup-buffer)))))
+
+(defcustom dap-mouse-popup-timeout 0.3
+  "The time to wait after command before hiding the popup.")
+
 ;;;###autoload
 (define-minor-mode dap-tooltip-mode
   "Toggle the display of GUD tooltips."
   :global t
   :group 'dap-mouse
   :group 'tooltip (require 'tooltip)
-  (if dap-tooltip-mode
-      (progn
-        (add-hook 'pre-command-hook 'tooltip-hide)
-        (add-hook 'tooltip-functions 'dap-tooltip-tips)
-        (add-hook 'lsp-mode-hook 'dap-tooltip-activate-mouse-motions-if-enabled)
-        (define-key lsp-mode-map [mouse-movement] 'dap-tooltip-mouse-motion))
-    (unless tooltip-mode
-      (remove-hook 'pre-command-hook 'tooltip-hide)
-      (remove-hook 'tooltip-functions 'dap-tooltip-tips)
-      (define-key lsp-mode-map  [mouse-movement] 'ignore)
-      (remove-hook 'lsp-mode-hook 'dap-tooltip-activate-mouse-motions-if-enabled)))
-  (dap-tooltip-activate-mouse-motions-if-enabled))
+  (cond
+   (dap-tooltip-mode
+    (add-hook 'tooltip-functions 'dap-tooltip-tips)
+    (add-hook 'lsp-mode-hook 'dap-tooltip-update-mouse-motions-if-enabled)
+    (define-key lsp-mode-map [mouse-movement] 'dap-tooltip-mouse-motion))
+   ((not tooltip-mode)
+    (remove-hook 'tooltip-functions 'dap-tooltip-tips)
+    (define-key lsp-mode-map  [mouse-movement] 'ignore)
+    (remove-hook 'lsp-mode-hook 'dap-tooltip-update-mouse-motions-if-enabled)))
+  (dap-tooltip-update-mouse-motions-if-enabled))
 
 (defcustom dap-tooltip-echo-area nil
   "Use the echo area instead of frames for DAP tooltips."
@@ -64,10 +84,10 @@ applied with lower priority than the syntax highlighting."
 
 ;;; Reacting on mouse movements
 
-(defun dap-tooltip-activate-mouse-motions-if-enabled ()
+(defun dap-tooltip-update-mouse-motions-if-enabled ()
   "Reconsider for all buffers whether mouse motion events are desired."
   (remove-hook 'post-command-hook
-               'dap-tooltip-activate-mouse-motions-if-enabled)
+               'dap-tooltip-update-mouse-motions-if-enabled)
   (dolist (buffer (buffer-list))
     (with-current-buffer buffer
       (if (and dap-tooltip-mode lsp-mode)
@@ -111,25 +131,37 @@ If there is an active selection - return it."
 
 (defun dap-tooltip-post-tooltip ()
   "Clean tooltip properties."
-  (remove-hook 'post-command-hook #'dap-tooltip-post-tooltip)
-
-  (when dap-tooltip-bounds
-    (remove-text-properties (car dap-tooltip-bounds)
-                            (cdr dap-tooltip-bounds)
-                            '(mouse-face))
-    ;; restore the selection
-    (when (region-active-p)
-      (let ((bounds dap-tooltip-bounds))
-        (run-with-idle-timer
-         0.0
-         nil
-         (lambda ()
-           (let ((point (point)))
-             (push-mark (car bounds) t t)
-             (goto-char (cdr bounds))
-             (unless (= point (point))
-               (exchange-point-and-mark)))))))
-    (setq dap-tooltip-bounds nil)))
+
+  (when dap-mouse--hide-timer
+    (cancel-timer dap-mouse--hide-timer))
+  (when (dap-mouse--hide-popup?)
+    (setq
+     dap-mouse--hide-timer
+     (run-at-time
+      dap-mouse-popup-timeout nil
+      (lambda ()
+        (when (dap-mouse--hide-popup?)
+          (posframe-hide dap-mouse-buffer)
+          (when dap-tooltip-bounds
+            (remove-text-properties (car dap-tooltip-bounds)
+                                    (cdr dap-tooltip-bounds)
+                                    '(mouse-face))
+            ;; restore the selection
+            (when (region-active-p)
+              (let ((bounds dap-tooltip-bounds))
+                (run-with-idle-timer
+                 0.0
+                 nil
+                 (lambda ()
+                   (let ((point (point)))
+                     (push-mark (car bounds) t t)
+                     (goto-char (cdr bounds))
+                     (unless (= point (point))
+                       (exchange-point-and-mark)))))))
+            (setq dap-tooltip-bounds nil))
+
+          (setq dap-mouse--hide-timer nil)
+          (remove-hook 'post-command-hook #'dap-tooltip-post-tooltip)))))))
 
 (defun dap-tooltip-tips (event)
   "Show tip for identifier or selection under the mouse.
@@ -149,25 +181,38 @@ This function must return nil if it doesn't handle EVENT."
                dap-tooltip-mode
                mouse-point)
       (-when-let* ((active-frame-id (-some->> debug-session
-                                              dap--debug-session-active-frame
-                                              (gethash "id")))
+                                      dap--debug-session-active-frame
+                                      (gethash "id")))
                    (bounds (dap-tooltip-thing-bounds mouse-point))
                    ((start . end) bounds)
-                   (expression (buffer-substring start end)))
+                   (expression (s-trim (buffer-substring start end))))
         (setq dap-tooltip-bounds bounds)
         (dap--send-message
          (dap--make-request "evaluate"
                             (list :expression expression
                                   :frameId active-frame-id))
-         (-lambda ((&hash "message" "body" (&hash? "result")))
+         (-lambda ((&hash "message" "body" (var &as &hash? "result")))
            (when (= request-id dap-tooltip--request)
              (if result
                  (progn
                    (add-text-properties start end
                                         '(mouse-face dap-mouse-eval-thing-face))
-                   (tooltip-show result
-                                 (or dap-tooltip-echo-area tooltip-use-echo-area
-                                     (not tooltip-mode)))
+                   (apply #'posframe-show
+                          (with-current-buffer (get-buffer-create dap-mouse-buffer)
+                            (lsp-treemacs-render
+                             (-let [(&hash "result" "variablesReference" variables-reference) var]
+                               `((:key ,expression
+                                       :label ,result
+                                       :icon dap-field
+                                       :children ,(dap-ui-render-variables
+                                                   debug-session
+                                                   variables-reference nil))))
+                             ""
+                             nil
+                             (buffer-name)))
+                          :position start
+                          :accept-focus t
+                          dap-mouse-posframe-properties)
                    (add-hook 'post-command-hook 'dap-tooltip-post-tooltip))
                (message message))))
          debug-session))))

dap-ui.el

@@ -171,14 +171,13 @@ number - expand N levels."
    ((not (dap--session-running debug-session)) 'dap-ui-sessions-terminated-face)
    (t 'dap-ui-sessions-running-face)))
 
-(defun dap-ui--make-overlay (beg end tooltip-text visuals &optional mouse-face buf)
+(defun dap-ui--make-overlay (beg end visuals &optional mouse-face buf)
   "Allocate a DAP UI overlay in range BEG and END.
 TOOLTIP-TEXT, VISUALS, MOUSE-FACE will be used for the overlay.
 BUF is the active buffer."
   (let ((ov (make-overlay beg end buf t t)))
     (overlay-put ov 'face           (plist-get visuals :face))
     (overlay-put ov 'mouse-face     mouse-face)
-    (overlay-put ov 'help-echo      tooltip-text)
     (overlay-put ov 'dap-ui-overlay  t)
     (overlay-put ov 'priority (plist-get visuals :priority))
     (let ((char (plist-get visuals :char)))
@@ -192,7 +191,7 @@ BUF is the active buffer."
                                            (plist-get visuals :fringe)))))))
     ov))
 
-(defun dap-ui--make-overlay-at (file point msg visuals)
+(defun dap-ui--make-overlay-at (file point visuals)
   "Create an overlay highlighting the given POINT in FILE.
 VISUALS and MSG will be used for the overlay."
   (-when-let (buf (find-buffer-visiting file))
@@ -201,7 +200,7 @@ VISUALS and MSG will be used for the overlay."
       (when (integer-or-marker-p point)
         (save-excursion
           (goto-char point)
-          (dap-ui--make-overlay (point-at-bol) (point-at-eol) msg visuals nil buf))))))
+          (dap-ui--make-overlay (point-at-bol) (point-at-eol) visuals nil buf))))))
 
 (defvar-local dap-ui--breakpoint-overlays nil)
 
@@ -236,7 +235,6 @@ DEBUG-SESSION the new breakpoints for FILE-NAME."
   (-map (-lambda ((bp . remote-bp))
           (push (dap-ui--make-overlay-at buffer-file-name
                                          (dap-breakpoint-get-point bp)
-                                         "Breakpoint"
                                          (dap-ui--breakpoint-visuals bp remote-bp))
                 dap-ui--breakpoint-overlays))
         (-zip-fill
@@ -261,7 +259,6 @@ DEBUG-SESSION the new breakpoints for FILE-NAME."
   (setq-local dap-ui--cursor-overlay
               (dap-ui--make-overlay-at
                file point
-               "Debug Marker"
                (list :face 'dap-ui-marker-face
                      :char ">"
                      :bitmap 'right-triangle
@@ -785,7 +782,7 @@ DEBUG-SESSION is the debug session triggering the event."
                                            'face 'font-lock-variable-name-face)
                                ": "
                                value)
-                      :icon variable
+                      :icon dap-variable
                       :value ,value
                       :session ,debug-session
                       :variables-reference ,variables-reference
@@ -811,7 +808,7 @@ DEBUG-SESSION is the debug session triggering the event."
             (-map (-lambda ((&hash "name" "variablesReference" variables-reference))
                     (list :key name
                           :label name
-                          :icon 'scope
+                          :icon 'dap-scope
                           :children (-partial #'dap-ui-render-variables
                                               (dap--cur-session)
                                               variables-reference)))
@@ -1065,7 +1062,7 @@ DEBUG-SESSION is the debug session triggering the event."
                                                    (s-join "\n"))
                                             "Breakpoint"))))
                    (list :key label
-                         :icon 'breakpoint
+                         :icon 'dap-breakpoint
                          :icon-literal (propertize
                                         "⬤ "
                                         'face (if (and remote-bp (gethash "verified" remote-bp))