From 1260b3c683baa6d1abbcd931701403a9ac73d0c5 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Thu, 8 Aug 2024 22:26:16 +0200 Subject: [PATCH] Highlight occurrences of var at point in Emacs Lisp --- lisp/progmodes/elisp-mode.el | 72 ++++++++++++++++++++++++++++-------- 1 file changed, 56 insertions(+), 16 deletions(-) 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) -- 2.39.2