From f46a9a90463f1a114fcf7b736bc0ee1d49e2d918 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Mon, 12 Aug 2024 09:09:48 +0200 Subject: [PATCH] elisp-mode.el, scope.el: Also highlight function symbols --- lisp/emacs-lisp/scope.el | 54 +++++++++++++++++++++---- lisp/progmodes/elisp-mode.el | 36 ++++++++++------- lisp/progmodes/refactor-elisp.el | 2 +- test/lisp/emacs-lisp/scope-tests.el | 15 +++++-- test/lisp/progmodes/elisp-mode-tests.el | 3 +- 5 files changed, 82 insertions(+), 28 deletions(-) diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el index 52dc261bffb..fe575611e7e 100644 --- a/lisp/emacs-lisp/scope.el +++ b/lisp/emacs-lisp/scope.el @@ -64,9 +64,8 @@ Optional argument LOCAL is a local context to extend." bindings) (let ((l local)) (dolist (binding bindings) - (let ((sym (if (consp binding) (car binding) binding))) - (when binding - (setq l (scope-local-new (bare-symbol sym) (symbol-with-pos-pos sym) l))))) + (when-let ((sym (if (consp binding) (car binding) binding))) + (setq l (scope-local-new (bare-symbol sym) (symbol-with-pos-pos sym) l)))) (scope-n l body)))) (defun scope-let* (local bindings body) @@ -301,8 +300,11 @@ Optional argument LOCAL is a local context to extend." (mapcan (apply-partially #'scope-n local) clauses)) (defun scope-setq (local args) - (cl-loop for (var val) on args by #'cddr - nconc (nconc (scope-s local var) (scope-1 local val)))) + (when args + (let ((var (car args)) (val (cadr args))) + (nconc (scope-s local var) + (scope-1 local val) + (scope-setq local (cddr args)))))) (defun scope-defvar (local _sym init) (scope-1 local init)) @@ -873,6 +875,35 @@ Optional argument LOCAL is a local context to extend." (scope-loop-with local (car rest) (cadr rest) (caddr rest) (cdddr rest))) ((memq bare '(do)) (scope-loop-do local (car rest) (cdr rest)))))))))) +(defun scope-named-let (local name bindings body) + (let ((bare (bare-symbol name)) + (beg (symbol-with-pos-pos name))) + (cons + (list beg (length (symbol-name bare)) beg) + (nconc + (mapcan (lambda (binding) + (cond + ((consp binding) + (cons + (let* ((sym (car binding)) + (beg (symbol-with-pos-pos sym)) + (bare (bare-symbol sym)) + (len (length (symbol-name bare)))) + (list beg len beg)) + (scope-1 local (cadr binding)))) + (binding + (let* ((sym binding) + (beg (symbol-with-pos-pos sym)) + (bare (bare-symbol sym)) + (len (length (symbol-name bare)))) + (list (list beg len beg)))))) + bindings) + (let ((l (scope-local-new bare beg local))) + (dolist (binding bindings) + (when-let ((sym (if (consp binding) (car binding) binding))) + (setq l (scope-local-new (bare-symbol sym) (symbol-with-pos-pos sym) l)))) + (let ((scope-flet-list (cons bare scope-flet-list))) (scope-n l body))))))) + (defvar scope-assume-func-p nil) (defun scope-1 (local form &optional top-level) @@ -884,8 +915,11 @@ Optional argument LOCAL is a local context to extend." ((symbol-with-pos-p f) (let ((bare (bare-symbol f))) (cond - ((or (functionp bare) - (memq bare '( if and or while + ((functionp bare) ;; (scope-n local forms) + (cons + (list (symbol-with-pos-pos f) (length (symbol-name bare)) 'function) + (scope-n local forms))) + ((or (memq bare '( if and or while save-excursion save-restriction save-current-buffer catch unwind-protect progn prog1 eval-when-compile eval-and-compile with-eval-after-load @@ -914,6 +948,8 @@ Optional argument LOCAL is a local context to extend." ((memq bare '(declare-function)) (scope-declare-function local (car forms) (cadr forms) (caddr forms) (cadddr forms))) + ((memq bare '(let-when-compile)) + (scope-let* local (car forms) (cdr forms))) ((memq bare '(if-let when-let and-let)) (scope-if-let local (car forms) (cdr forms))) ((memq bare '(if-let* when-let* and-let* while-let)) @@ -942,6 +978,8 @@ Optional argument LOCAL is a local context to extend." (scope-1 local (car forms))) ((memq bare '(letrec)) (scope-letrec local (car forms) (cdr forms))) + ((memq bare '(named-let)) + (scope-named-let local (car forms) (cadr forms) (cdr forms))) ((memq bare '(cl-flet)) (scope-flet local (car forms) (cdr forms))) ((memq bare '(cl-labels)) @@ -1025,7 +1063,7 @@ starting with a top-level form, by inspecting HEAD at each level: `scope-n' to obtain bindings graphs for sub-forms. See also `scope-local-new' for extending LOCAL with local bindings in TAIL. -- If within the code under analysis HEAD is a `cl-letf'-bound local +- If within the code under analysis HEAD is a `cl-flet'-bound local function name, analyze the form as a function call. - Otherwise, HEAD is unknown. If the HEAD of the top-level form that diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 1a5861d80dd..5490ef8dc52 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -377,13 +377,16 @@ happens in interactive invocations." (condition-case nil (scope (current-buffer)) (end-of-file nil))) - (if (null bin) - (font-lock-append-text-property sym (+ sym len) 'face 'elisp-free-variable) + (cond + ((numberp bin) (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)))))) + (elisp-cursor-sensor bin))) + ((eq bin 'function) + (font-lock-append-text-property sym (+ sym len) 'face 'font-lock-function-call-face)) + (t (font-lock-append-text-property sym (+ sym len) 'face 'elisp-free-variable)))))) `(jit-lock-bounds ,beg . ,end))) (font-lock-default-fontify-region beg end loudly))) @@ -409,6 +412,7 @@ be used instead. \\{emacs-lisp-mode-map}" :group 'lisp (defvar project-vc-external-roots-function) + (setq font-lock-defaults (copy-tree font-lock-defaults)) (setcar font-lock-defaults '(lisp-el-font-lock-keywords lisp-el-font-lock-keywords-1 @@ -416,8 +420,10 @@ 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))) + (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)))) (setf (nth 2 font-lock-defaults) nil) (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers) (if (boundp 'electric-pair-text-pairs) @@ -1111,15 +1117,17 @@ namespace but with lower confidence." (cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier) (let* ((pos (get-text-property 0 'pos identifier)) - (dec (seq-some - (pcase-lambda (`(,beg ,len ,dec)) - (when (<= beg pos (+ beg len)) dec)) - (save-excursion - (goto-char pos) - (beginning-of-defun) - (scope (current-buffer)))))) - (if dec (list (xref-make "lexical binding" - (xref-make-buffer-location (current-buffer) dec))) + (dec (when pos + (seq-some + (pcase-lambda (`(,beg ,len ,dec)) + (when (<= beg pos (+ beg len)) dec)) + (save-excursion + (goto-char pos) + (beginning-of-defun) + (scope (current-buffer))))))) + (if (numberp dec) + (list (xref-make "lexical binding" + (xref-make-buffer-location (current-buffer) dec))) (require 'find-func) (let ((sym (intern-soft identifier))) (when sym diff --git a/lisp/progmodes/refactor-elisp.el b/lisp/progmodes/refactor-elisp.el index be33e7ece44..996dbecdc3f 100644 --- a/lisp/progmodes/refactor-elisp.el +++ b/lisp/progmodes/refactor-elisp.el @@ -35,7 +35,7 @@ (scope (current-buffer))))) (seq-some (pcase-lambda (`(,beg ,len ,bin)) - (and bin (<= beg (point) (+ beg len)) + (and (numberp bin) (<= beg (point) (+ beg len)) (list (propertize (buffer-substring-no-properties beg (+ beg len)) 'pos beg)))) all))) diff --git a/test/lisp/emacs-lisp/scope-tests.el b/test/lisp/emacs-lisp/scope-tests.el index 030e05d0335..d57c9821756 100644 --- a/test/lisp/emacs-lisp/scope-tests.el +++ b/test/lisp/emacs-lisp/scope-tests.el @@ -32,8 +32,10 @@ (76 3 13) (80 4 nil) (85 3 51) + (97 6 function) (104 3 13) (108 3 51) + (118 6 function) (125 3 17)) (scope " (defun foo (bar baz) @@ -45,13 +47,16 @@ (ert-deftest scope-test-2 () (should (equal '((110 11 110) + (133 16 function) (197 6 197) + (228 7 function) (236 6 197) (257 2 257) (263 3 263) (287 2 287) (290 3 263) (313 2 257) + (317 9 function) (327 2 287) (330 11 110) (353 11 110)) @@ -69,10 +74,12 @@ op-be-alist))")))) (ert-deftest scope-test-3 () - (should (equal '((45 3 45) ;env - (55 4 55) ;body - (136 4 136) ;syms - (172 4 172) ;vals + (should (equal '((45 3 45) + (55 4 55) + (136 4 136) + (142 11 function) + (172 4 172) + (178 11 function) (212 4 136) (218 4 172) (258 3 45) diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 591c32a8271..e8224db3613 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -785,7 +785,8 @@ to (xref-elisp-test-descr-to-target xref)." (xref-elisp-deftest find-defs-minor-defvar-c (with-temp-buffer (emacs-lisp-mode) - (insert "(foo overwrite-mode") + (insert "(foo overwrite-mode)") + (backward-char) (xref-backend-definitions 'elisp (xref-backend-identifier-at-point 'elisp))) (list -- 2.39.2