From 8f823b52b1c1bad5d958fe9fbed0d1ba32493d43 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Mon, 10 Feb 2025 20:01:04 +0100 Subject: [PATCH] elisp-mode.el: Show symbol documentation via 'help-echo' --- lisp/help-at-pt.el | 40 +++++++++++------------- lisp/help.el | 1 - lisp/progmodes/elisp-mode.el | 59 ++++++++++++++++++++++++++++++++---- 3 files changed, 71 insertions(+), 29 deletions(-) diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index 3c0c60bfa4d..47732c7e8fd 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -85,33 +85,29 @@ If this produces no string either, return nil." (declare-function widget-at "wid-edit" (&optional pos)) ;;;###autoload -(defun display-local-help (&optional inhibit-warning describe-button) - "Display in the echo area `kbd-help' or `help-echo' text at point. +(defun display-local-help (&optional inhibit-warning _) + "Display `help-echo' text at point. This command displays the help message which is the string produced -by the `kbd-help' property at point. If `kbd-help' at point does not -produce a string, but the `help-echo' property does, then that string -is displayed instead. - -The string is passed through `substitute-command-keys' before it -is displayed. +by the `help-echo' property at point. If INHIBIT-WARNING is non-nil, do not display a warning message when there is no help property at point. -If DESCRIBE-BUTTON in non-nil (interactively, the prefix arg), and -there's a button/widget at point, pop up a buffer describing that -button/widget instead." - (interactive (list nil current-prefix-arg)) - (let ((help (help-at-pt-kbd-string))) - (cond - ((and describe-button (button-at (point))) - (button-describe)) - ((and describe-button (widget-at (point))) - (widget-describe)) - (help - (message "%s" (substitute-command-keys help))) - ((not inhibit-warning) - (message "No local help at point"))))) +(fn &optional INHIBIT-WARNING)" + (interactive) + (let* ((posn (posn-at-point)) + (tooltip-frame-parameters + (cons `(left . ,(+ (car (posn-x-y posn)) + (window-pixel-left (posn-window posn)) + (string-pixel-width (string (char-after))) 10)) + (cons `(top . ,(+ (cdr (posn-x-y (posn-at-point))) + (window-pixel-top (posn-window posn)) + (line-pixel-height) 10)) + tooltip-frame-parameters)))) + ;; TODO: Use a child frame like in `eldoc-box' instead of a tooltip. + (if-let ((help (help-at-pt-string))) + (tooltip-show (substitute-quotes help)) + (unless inhibit-warning (message "No local help at point"))))) (defvar help-at-pt-timer nil "Non-nil means that a timer is set that checks for local help. diff --git a/lisp/help.el b/lisp/help.el index 6af8458339b..e8481f49a6b 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -59,7 +59,6 @@ buffer.") (defvar-keymap help-map :doc "Keymap for characters following the Help key." "." #'display-local-help - "C-a" #'about-emacs "C-c" #'describe-copying "C-d" #'view-emacs-debugging diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 2adbc85e22e..cb40cd80ec4 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -327,6 +327,10 @@ happens in interactive invocations." (defvar-keymap elisp--dynlex-modeline-map " " #'elisp-enable-lexical-binding) +(defface elisp-symbol-at-mouse '((t :background "#f0fff0")) + "Face for highlighting the symbol at mouse in Emacs Lisp code." + :group 'lisp) + (defface elisp-free-variable '((t :inherit underline)) "Face for highlighting free variables in Emacs Lisp code." :group 'lisp) @@ -414,14 +418,48 @@ happens in interactive invocations." (cl-case type (variable (cond ((equal beg def) "Local variable definition") (def "Local variable") - (t "Special variable"))) + (t (if-let ((sym (intern (buffer-substring-no-properties beg end)))) + (lambda (&rest _) + (if-let ((doc (documentation-property sym 'variable-documentation t))) + (format "Special variable `%S'.\n\n%s" sym doc) + "Special variable")) + "Special variable")))) (block (if (equal beg def) "Block definition" "Block")) - (face "Face") + (face (if-let ((sym (intern (buffer-substring-no-properties beg end)))) + (lambda (&rest _) + (if-let ((doc (documentation-property sym 'face-documentation))) + (format "Face `%S'.\n\n%s" sym doc) + "Face")) + "Face")) (function (cond ((equal beg def) "Local function definition") (def "Local function call") - (t "Function call"))) - (macro "Macro call") - (special-form "Special form") + (t (if-let ((sym (intern (buffer-substring-no-properties beg end)))) + (lambda (&rest _) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (insert "`" (symbol-name sym) "' is ") + (describe-function-1 sym) + (help-make-xrefs)) + (buffer-string))) + "Function call")))) + (macro (if-let ((sym (intern (buffer-substring-no-properties beg end)))) + (lambda (&rest _) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (insert "`" (symbol-name sym) "' is ") + (describe-function-1 sym) + (help-make-xrefs)) + (buffer-string))) + "Macro call")) + (special-form (if-let ((sym (intern (buffer-substring-no-properties beg end)))) + (lambda (&rest _) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (insert "`" (symbol-name sym) "' is ") + (describe-function-1 sym) + (help-make-xrefs)) + (buffer-string))) + "Special form")) (throw-tag "`throw'/`catch' tag") (warning-type "Warning type") (feature "Feature") @@ -438,10 +476,16 @@ happens in interactive invocations." (defun "Function definition") (defvar "Special variable definition") (defface "Face definition") - (major-mode "Major mode")))) + (major-mode (if-let ((sym (intern (buffer-substring-no-properties beg end)))) + (lambda (&rest _) + (if-let ((doc (documentation sym))) + (format "Major mode `%S'.\n\n%s" sym doc) + "Major mode")) + "Major mode"))))) (defun elisp-fontify-symbol (type sym len id &optional def) (elisp--annotate-symbol-with-help-echo type sym (+ sym len) def) + (put-text-property sym (+ sym len) 'mouse-face 'elisp-symbol-at-mouse) (if (null id) (when-let ((face (cl-case type (variable 'elisp-free-variable) @@ -588,6 +632,9 @@ be used instead. (cl-pushnew 'help-echo (alist-get 'font-lock-extra-managed-props (nthcdr 5 font-lock-defaults))) + (cl-pushnew 'mouse-face + (alist-get 'font-lock-extra-managed-props + (nthcdr 5 font-lock-defaults))) (alist-set 'font-lock-fontify-region-function (nthcdr 5 font-lock-defaults) #'elisp-fontify-region) -- 2.39.5