From c72a2f6841f8a9c704f94ea28af3dfa07d7c8372 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Mon, 10 Feb 2025 21:01:40 +0100 Subject: [PATCH] Add mouse face to semantic face instead of replacing --- lisp/progmodes/elisp-mode.el | 134 ++++++++++++++++------------------- 1 file changed, 61 insertions(+), 73 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index cb40cd80ec4..997c0cd9db6 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -327,7 +327,7 @@ happens in interactive invocations." (defvar-keymap elisp--dynlex-modeline-map " " #'elisp-enable-lexical-binding) -(defface elisp-symbol-at-mouse '((t :background "#f0fff0")) +(defface elisp-symbol-at-mouse '((t :background "#fff6d8")) "Face for highlighting the symbol at mouse in Emacs Lisp code." :group 'lisp) @@ -412,53 +412,42 @@ happens in interactive invocations." :type 'boolean :group 'lisp) +(defun elisp--function-help-echo (sym &rest _) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (insert "`" (symbol-name sym) "' is ") + (describe-function-1 sym)) + (buffer-string))) + +(defun elisp--help-echo-1 (str sym prop &rest _) + (if-let ((doc (documentation-property sym prop t))) + (format "%s `%S'.\n\n%s" str sym doc) + str)) + +(defun elisp--help-echo (beg end prop str) + (if-let ((sym (intern-soft (buffer-substring-no-properties beg end)))) + (apply-partially #'elisp--help-echo-1 str sym prop) + str)) + (defun elisp--annotate-symbol-with-help-echo (type beg end def) (put-text-property beg end 'help-echo (cl-case type (variable (cond ((equal beg def) "Local variable definition") (def "Local 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")))) + (t (elisp--help-echo beg end 'variable-documentation "Special variable")))) (block (if (equal beg def) "Block definition" "Block")) - (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")) + (face (elisp--help-echo beg end 'face-documentation "Face")) (function (cond ((equal beg def) "Local function definition") (def "Local function call") - (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))) + (t (if-let ((sym (intern-soft (buffer-substring-no-properties beg end)))) + (apply-partially #'elisp--function-help-echo sym) "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 (if-let ((sym (intern-soft (buffer-substring-no-properties beg end)))) + (apply-partially #'elisp--function-help-echo sym) "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 (if-let ((sym (intern-soft (buffer-substring-no-properties beg end)))) + (apply-partially #'elisp--function-help-echo sym) "Special form")) (throw-tag "`throw'/`catch' tag") (warning-type "Warning type") @@ -485,42 +474,41 @@ happens in interactive invocations." (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) - (face 'elisp-face) - (function 'font-lock-function-call-face) - (macro 'elisp-macro-call) - (special-form 'elisp-special-form) - (throw-tag 'elisp-throw-tag) - (warning-type 'font-lock-type-face) - (feature 'elisp-feature) - (declaration 'font-lock-variable-use-face) - (rx-construct 'elisp-rx) - (theme 'elisp-theme) - (slot 'font-lock-builtin-face) - (widget-type 'font-lock-type-face) - (type 'font-lock-type-face) - (group 'font-lock-type-face) - (condition 'elisp-condition) - (ampersand 'font-lock-type-face) - (constant 'font-lock-builtin-face) - (defun 'font-lock-function-name-face) - (defvar 'font-lock-variable-name-face) - (defface 'font-lock-variable-name-face) - (major-mode 'elisp-major-mode-name)))) - (add-face-text-property sym (+ sym len) face t)) - (add-face-text-property sym (+ sym len) - (if (equal sym def) - 'elisp-binding-variable - 'elisp-bound-variable) - t) - (put-text-property sym (+ sym len 1) 'cursor-sensor-functions - ;; Get a fresh list with SYM hardcoded, - ;; so that the value is distinguishable - ;; from the value in adjacent regions. - (elisp-cursor-sensor sym)))) + (let ((face (cond + ((null id) + (cl-case type + (variable 'elisp-free-variable) + (face 'elisp-face) + (function 'font-lock-function-call-face) + (macro 'elisp-macro-call) + (special-form 'elisp-special-form) + (throw-tag 'elisp-throw-tag) + (warning-type 'font-lock-type-face) + (feature 'elisp-feature) + (declaration 'font-lock-variable-use-face) + (rx-construct 'elisp-rx) + (theme 'elisp-theme) + (slot 'font-lock-builtin-face) + (widget-type 'font-lock-type-face) + (type 'font-lock-type-face) + (group 'font-lock-type-face) + (condition 'elisp-condition) + (ampersand 'font-lock-type-face) + (constant 'font-lock-builtin-face) + (defun 'font-lock-function-name-face) + (defvar 'font-lock-variable-name-face) + (defface 'font-lock-variable-name-face) + (major-mode 'elisp-major-mode-name))) + ((equal sym def) 'elisp-binding-variable) + (t 'elisp-bound-variable)))) + (add-face-text-property sym (+ sym len) face t) + (put-text-property sym (+ sym len) 'mouse-face `(,face elisp-symbol-at-mouse)) + (when id + (put-text-property sym (+ sym len 1) 'cursor-sensor-functions + ;; Get a fresh list with SYM hardcoded, + ;; so that the value is distinguishable + ;; from the value in adjacent regions. + (elisp-cursor-sensor sym))))) (defun elisp-fontify-region-semantically (beg end) "Fontify symbols between BEG and END according to their semantics." -- 2.39.5