Add mouse face to semantic face instead of replacing

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index cb40cd80ec43846d3924df8996250f9b1ae65199..997c0cd9db637f8f96824168065e3c081d4cca7a 100644 (file)
--- 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
   "<mode-line> <mouse-1>" #'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."