* lisp/progmodes/elisp-mode.el: Minor cleanup.

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index 82bb02e07b4bb6b0ed968b24c65b9431bff99377..8b1aefe80b57c634486abae58a08b05d245233db 100644 (file)
--- a/lisp/emacs-lisp/scope.el
+++ b/lisp/emacs-lisp/scope.el
@@ -522,7 +522,7 @@ Optional argument LOCAL is a local context to extend."
            ((memq bare '(cl-labels))
             (scope-labels local (car forms) (cdr forms)))
            ((memq bare '( eval-when-compile eval-and-compile
-                          setf pop push with-memoization))
+                          setf pop push with-memoization cl-pushnew))
             (scope-n local forms))
            ((memq bare '(with-slots))
             (scope-with-slots local (car forms) (cadr forms) (cddr forms)))

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 145ad694e8670d4d43ef21ce69221e42f04e0102..a7cf5c256b7844a37a661a010a62c1fdaef8e360 100644 (file)
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -327,13 +327,18 @@ happens in interactive invocations."
 (defface elisp-free-variable '((t :inherit underline))
   "Face for highlighting free variables in Emacs Lisp code.")
 
-(defface elisp-binding-variable '((t :slant italic :inherit font-lock-variable-name-face))
+(defface elisp-binding-variable
+  '((t :slant italic :inherit font-lock-variable-name-face))
   "Face for highlighting binding occurrences of variables in Emacs Lisp code.")
 
 (defface elisp-bound-variable '((t :slant italic))
-  "Face for highlighting binding occurrences of variables in Emacs Lisp code.")
+  "Face for highlighting bound occurrences of variables in Emacs Lisp code.")
+
+(defface elisp-variable-at-point '((t :inherit bold))
+  "Face for highlighting (all occurrences of) the variable at point.")
 
 (defun elisp-highlight-variable (pos)
+  "Highlight variable at POS along with its co-occurrences."
   (let* (all dec)
     (save-excursion
       (goto-char pos)
@@ -346,61 +351,70 @@ happens in interactive invocations."
     (pcase-dolist (`(,sym ,len ,bin) all)
       (when (equal bin dec)
         (let ((ov (make-overlay sym (+ sym len))))
-          (overlay-put ov 'face 'bold)
+          (overlay-put ov 'face 'elisp-variable-at-point)
           (overlay-put ov 'elisp-highlight-variable t))))))
 
 (defun elisp-unhighlight-variable (pos)
+  "Remove variable highlighting across top-level form at POS."
   (save-excursion
     (goto-char pos)
     (beginning-of-defun)
-    (remove-overlays (point) (progn (end-of-defun) (point)) 'elisp-highlight-variable t)))
+    (remove-overlays (point) (progn (end-of-defun) (point))
+                     'elisp-highlight-variable t)))
 
 (defun elisp-cursor-sensor (pos)
+  "Return `cursor-sensor-functions' for ELisp symbol at POS."
   (list
    (lambda (_win old dir)
      (if (eq dir 'entered)
          (elisp-highlight-variable pos)
        (elisp-unhighlight-variable old)))))
 
+(defcustom elisp-fontify-semantically t
+  "Whether to enable semantic fontification of ELisp symbols."
+  :type 'boolean
+  :group 'lisp)
+
+(defun elisp-fontify-region-semantically (beg end)
+  "Fontify symbols between BEG and END according to their semantics."
+  (save-excursion
+    (goto-char beg)
+    (while (< (point) end)
+      (ignore-errors
+        (scope
+         (lambda (type sym len bind)
+           (if (null bind)
+               (put-text-property sym (+ sym len) 'face
+                                  (cl-case type
+                                    (variable 'elisp-free-variable)
+                                    (function 'font-lock-function-call-face)
+                                    (defun    'font-lock-function-name-face)))
+             (put-text-property sym (+ sym len) 'face
+                                (if (equal sym bind)
+                                    'elisp-binding-variable
+                                  'elisp-bound-variable))
+             (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))))
+         (current-buffer))))))
+
 (defun elisp-fontify-region (beg end &optional loudly)
-  (let ((beg (save-excursion (goto-char beg) (beginning-of-defun) (point)))
-        (end (save-excursion (goto-char end) (end-of-defun)
-                             (skip-chars-backward " \t\n")
-                             (point))))
-    (font-lock-default-fontify-region beg end loudly)
-    (save-excursion
-      (goto-char beg)
-      (while (< (point) end)
-        (ignore-errors
-          (scope
-           (lambda (type sym len bin)
-             (cond
-              ((eq type 'variable)
-               (if (null bin)
-                   (put-text-property sym (+ sym len) 'face 'elisp-free-variable)
-                 (put-text-property sym (+ sym len) 'face (if (equal sym bin)
-                                                              'elisp-binding-variable
-                                                            'elisp-bound-variable))
-                 (put-text-property sym (+ sym len 1) 'cursor-sensor-functions
-                                    (elisp-cursor-sensor sym))))
-              ((eq type 'function)
-               (if (null bin)
-                   (put-text-property sym (+ sym len) 'face 'font-lock-function-call-face)
-                 (put-text-property sym (+ sym len) 'face (if (equal sym bin)
-                                                              'elisp-binding-variable
-                                                            'elisp-bound-variable))
-                 (put-text-property sym (+ sym len 1) 'cursor-sensor-functions
-                                    (elisp-cursor-sensor sym))))
-              ((eq type 'block)
-               (put-text-property sym (+ sym len) 'face (if (equal sym bin)
-                                                            'elisp-binding-variable
-                                                          'elisp-bound-variable))
-               (put-text-property sym (+ sym len 1) 'cursor-sensor-functions
-                                  (elisp-cursor-sensor sym)))
-              ((eq type 'defun)
-               (put-text-property sym (+ sym len) 'face 'font-lock-function-name-face))))
-           (current-buffer)))))
-    `(jit-lock-bounds ,beg . ,end)))
+  "Fontify ELisp code between BEG and END.
+
+Non-nil optional argument LOUDLY permits printing status messages.
+
+This is the `font-lock-fontify-region-function' for `emacs-lisp-mode'."
+  (if elisp-fontify-semantically
+      (let ((beg (save-excursion (goto-char beg) (beginning-of-defun) (point)))
+            (end (save-excursion (goto-char end) (end-of-defun)
+                                 (skip-chars-backward " \t\n")
+                                 (point))))
+        (font-lock-default-fontify-region beg end loudly)
+        (elisp-fontify-region-semantically beg end)
+        `(jit-lock-bounds ,beg . ,end))
+    (font-lock-default-fontify-region beg end loudly)))
 
 ;;;###autoload
 (define-derived-mode emacs-lisp-mode lisp-data-mode
@@ -429,13 +443,12 @@ be used instead.
           '(lisp-el-font-lock-keywords
             lisp-el-font-lock-keywords-1
             lisp-el-font-lock-keywords-2))
-  (setcdr (nthcdr 4 font-lock-defaults)
-          (cons '(font-lock-fontify-region-function . elisp-fontify-region)
-                (nthcdr 5 font-lock-defaults)))
-  (unless (memq 'cursor-sensor-functions
-                (alist-get 'font-lock-extra-managed-props (nthcdr 5 font-lock-defaults)))
-    (push 'cursor-sensor-functions
-          (alist-get 'font-lock-extra-managed-props (nthcdr 5 font-lock-defaults))))
+  (cl-pushnew 'cursor-sensor-functions
+              (alist-get 'font-lock-extra-managed-props
+                         (nthcdr 5 font-lock-defaults)))
+  (setf (alist-get 'font-lock-fontify-region-function
+                   (nthcdr 5 font-lock-defaults))
+        #'elisp-fontify-region)
   (setf (nth 2 font-lock-defaults) nil)
   (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
   (if (boundp 'electric-pair-text-pairs)