Highlight binding and free var occurrences in Emacs Lisp

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 3c9f80d7c4b3eddde49d638de857ddb478244732..42e7f44b033ddd6e3b88f06de19f746b4b588cd5 100644 (file)
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -324,6 +324,29 @@ happens in interactive invocations."
 (defvar-keymap elisp--dynlex-modeline-map
   "<mode-line> <mouse-1>" #'elisp-enable-lexical-binding)
 
+(defface elisp-free-variable '((t :inherit underline))
+  "Face for highlighting free variables in Emacs Lisp code.")
+
+(defface elisp-binding-variable '((t :inherit italic))
+  "Face for highlighting binding occurrences of variables in Emacs Lisp code.")
+
+(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)
+        (pcase-dolist (`(,sym ,len ,bin)
+                       (scope (read-positioning-symbols (current-buffer))))
+          (when-let ((face (cond
+                            ((null bin) 'elisp-free-variable)
+                            ((= sym bin) 'elisp-binding-variable))))
+            (font-lock-append-text-property sym (+ sym len) 'face face)))))
+    `(jit-lock-bounds ,beg . ,end)))
+
 ;;;###autoload
 (define-derived-mode emacs-lisp-mode lisp-data-mode
   `("ELisp"
@@ -350,6 +373,9 @@ 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)))
   (setf (nth 2 font-lock-defaults) nil)
   (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
   (if (boundp 'electric-pair-text-pairs)