From 2f4e0a60acaaad45fa90abf4db5bb962a053b6a5 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 16 Aug 2024 17:56:47 +0200 Subject: [PATCH] * lisp/progmodes/elisp-mode.el: Minor cleanup. --- lisp/emacs-lisp/scope.el | 2 +- lisp/progmodes/elisp-mode.el | 111 +++++++++++++++++++---------------- 2 files changed, 63 insertions(+), 50 deletions(-) diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el index 82bb02e07b4..8b1aefe80b5 100644 --- 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 145ad694e86..a7cf5c256b7 100644 --- 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) -- 2.39.2