From: Eshel Yaron <me@eshelyaron.com>
Date: Thu, 8 Aug 2024 20:26:16 +0000 (+0200)
Subject: Highlight occurrences of var at point in Emacs Lisp
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1260b3c683baa6d1abbcd931701403a9ac73d0c5;p=emacs.git

Highlight occurrences of var at point in Emacs Lisp
---

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 42e7f44b033..dae613426f6 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -327,25 +327,63 @@ 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 :inherit italic))
+(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.")
+
+(defun elisp-highlight-variable (pos)
+  (save-excursion
+    (goto-char pos)
+    (let* ((all (scope (save-excursion
+                         (goto-char pos)
+                         (beginning-of-defun)
+                         (read-positioning-symbols (current-buffer)))))
+           (dec (seq-some
+                 (pcase-lambda (`(,beg ,len ,bin))
+                   (when (<= beg pos (+ beg len)) bin))
+                 all)))
+      (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 'elisp-highlight-variable t)))))))
+
+(defun elisp-unhighlight-variable (pos)
+  (save-excursion
+    (goto-char pos)
+    (beginning-of-defun)
+    (remove-overlays (point) (progn (end-of-defun) (point)) 'elisp-highlight-variable t)))
+
+(defun elisp-cursor-sensor (pos)
+  (list
+   (lambda (_win old dir)
+     (if (eq dir 'entered)
+         (elisp-highlight-variable pos)
+       (elisp-unhighlight-variable old)))))
+
 (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)))
+  (or (ignore-errors
+        (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))))
+                (if (null bin)
+                    (font-lock-append-text-property sym (+ sym len) 'face 'elisp-free-variable)
+                  (font-lock-append-text-property sym (+ sym len) 'face (if (= sym bin)
+                                                                            'elisp-binding-variable
+                                                                          'elisp-bound-variable))
+                  (put-text-property sym (+ sym len 1) 'cursor-sensor-functions
+                                     (elisp-cursor-sensor bin))))))
+          `(jit-lock-bounds ,beg . ,end)))
+      (font-lock-default-fontify-region beg end loudly)))
 
 ;;;###autoload
 (define-derived-mode emacs-lisp-mode lisp-data-mode
@@ -376,6 +414,8 @@ be used instead.
   (setcdr (nthcdr 4 font-lock-defaults)
           (cons '(font-lock-fontify-region-function . elisp-fontify-region)
                 (nthcdr 5 font-lock-defaults)))
+  (push 'cursor-sensor-functions
+        (alist-get 'font-lock-extra-managed-props (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)