From 6a6c4b3be38d8031d823f4a8e97c6b9276faf495 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 25 Jan 2025 19:54:19 +0100 Subject: [PATCH] scope.el: Finalize refactor and let-alist support --- lisp/emacs-lisp/scope.el | 306 ++++++++++++++-------------- lisp/progmodes/elisp-mode.el | 47 ++--- lisp/progmodes/refactor-elisp.el | 12 +- test/lisp/emacs-lisp/scope-tests.el | 34 +++- 4 files changed, 208 insertions(+), 191 deletions(-) diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el index 7473c62bb36..142f9da6f6f 100644 --- a/lisp/emacs-lisp/scope.el +++ b/lisp/emacs-lisp/scope.el @@ -36,10 +36,6 @@ (defvar scope-gen-id-alist nil) -(defsubst scope-local-get (sym local) - "Get binding position of symbol SYM in local context LOCAL." - (alist-get sym local)) - (defsubst scope-local-new (sym pos &optional local) "Return new local context with SYM bound at POS. @@ -54,8 +50,8 @@ Optional argument LOCAL is a local context to extend." ((symbolp sym) sym) ((symbol-with-pos-p sym) (bare-symbol sym)))) -(defsubst scope-report (type beg len &optional def _id) - (funcall scope-callback type beg len def)) +(defsubst scope-report (type beg len &optional id def) + (funcall scope-callback type beg len id (or def (and (numberp id) id)))) (defun scope-s (local sym) (let* ((beg (scope-sym-pos sym)) @@ -66,13 +62,12 @@ Optional argument LOCAL is a local context to extend." (cond ((keywordp bare) (scope-report 'constant beg len)) ((and scope-current-let-alist-form (= (aref name 0) ?.)) - ;; FIXME: Support jumping to `let-alist' call as the - ;; "definition" of the `.foo' variables. - (scope-report 'variable beg len (cdr scope-current-let-alist-form) - (list 'let-alist (car scope-current-let-alist-form) bare))) - (t (scope-report 'variable beg len (scope-local-get bare local) - (or (alist-get bare scope-gen-id-alist) - (scope-local-get bare local)))))))) + (scope-report 'variable beg len + (list 'let-alist (car scope-current-let-alist-form) bare) + (cdr scope-current-let-alist-form))) + (t + (let ((id (alist-get bare local))) + (scope-report 'variable beg len id))))))) (defun scope-let-1 (local0 local bindings body) (if bindings @@ -81,7 +76,7 @@ Optional argument LOCAL is a local context to extend." (bare (bare-symbol sym)) (len (length (symbol-name bare))) (beg (scope-sym-pos sym))) - (when beg (funcall scope-callback 'variable beg len beg)) + (when beg (scope-report 'variable beg len beg)) (scope-1 local0 (cadr binding)) (scope-let-1 local0 (scope-local-new bare beg local) (cdr bindings) body)) @@ -97,7 +92,7 @@ Optional argument LOCAL is a local context to extend." (bare (bare-symbol sym)) (len (length (symbol-name bare))) (beg (scope-sym-pos sym))) - (when beg (funcall scope-callback 'variable beg len beg)) + (when beg (scope-report 'variable beg len beg)) (scope-1 local (cadr binding)) (scope-let* (scope-local-new bare beg local) (cdr bindings) body)) @@ -105,10 +100,9 @@ Optional argument LOCAL is a local context to extend." (defun scope-interactive (local intr spec modes) (when (symbol-with-pos-p intr) - (funcall scope-callback 'special-form - (symbol-with-pos-pos intr) - (length (symbol-name (scope-sym-bare intr))) - nil)) + (scope-report 'special-form + (symbol-with-pos-pos intr) + (length (symbol-name (scope-sym-bare intr))))) (scope-1 local spec) (mapc #'scope-major-mode-name modes)) @@ -137,18 +131,16 @@ Optional argument LOCAL is a local context to extend." (symbolp decl))) ((eq (bare-symbol decl) 'declare))) (when (symbol-with-pos-p decl) - (funcall scope-callback 'macro - (symbol-with-pos-pos decl) - (length (symbol-name (bare-symbol decl))) - nil)) + (scope-report 'macro + (symbol-with-pos-pos decl) + (length (symbol-name (bare-symbol decl))))) (dolist (spec (cdr form)) (when-let ((head (car-safe spec)) (bare (scope-sym-bare head))) (when (symbol-with-pos-p head) - (funcall scope-callback 'declaration - (symbol-with-pos-pos head) - (length (symbol-name bare)) - nil)) + (scope-report 'declaration + (symbol-with-pos-pos head) + (length (symbol-name bare)))) (cl-case bare (completion (scope-sharpquote local (cadr spec))) (interactive-only @@ -183,10 +175,10 @@ Optional argument LOCAL is a local context to extend." (let* ((beg (symbol-with-pos-pos arg)) (bare (bare-symbol arg)) (len (length (symbol-name bare)))) - (when beg - (if (memq (bare-symbol arg) '(&optional &rest _)) - (funcall scope-callback 'ampersand beg len nil) - (funcall scope-callback 'variable beg len beg)))))) + (when (and beg (not (eq bare '_))) + (if (memq bare '(&optional &rest)) + (scope-report 'ampersand beg len) + (scope-report 'variable beg len beg)))))) ;; Handle BODY. (let ((l local)) (dolist (arg args) @@ -199,7 +191,7 @@ Optional argument LOCAL is a local context to extend." (defun scope-defun (local name args body) (when-let ((beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'defun beg (length (symbol-name bare)) nil)) + (scope-report 'defun beg (length (symbol-name bare)))) (scope-lambda local args body)) (defun scope-cond (local clauses) @@ -217,7 +209,7 @@ Optional argument LOCAL is a local context to extend." (defun scope-defvar (local name init) (when-let ((beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'defvar beg (length (symbol-name bare)) nil)) + (scope-report 'defvar beg (length (symbol-name bare)))) (scope-1 local init)) (defun scope-condition-case (local var bodyform handlers) @@ -225,7 +217,7 @@ Optional argument LOCAL is a local context to extend." (beg (when (symbol-with-pos-p var) (symbol-with-pos-pos var))) (l (scope-local-new bare beg local))) (when beg - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (scope-1 local bodyform) (dolist (handler handlers) (dolist (cond-name (ensure-list (car-safe handler))) @@ -234,8 +226,8 @@ Optional argument LOCAL is a local context to extend." (clen (length (symbol-name cbare)))) (cond ((booleanp cbare)) - ((keywordp cbare) (funcall scope-callback 'constant cbeg clen nil)) - (t (funcall scope-callback 'condition cbeg clen nil))))) + ((keywordp cbare) (scope-report 'constant cbeg clen)) + (t (scope-report 'condition cbeg clen))))) (scope-n l (cdr handler))))) (defvar scope-flet-alist nil) @@ -248,7 +240,7 @@ Optional argument LOCAL is a local context to extend." (beg (scope-sym-pos func)) (bare (bare-symbol func))) (when beg - (funcall scope-callback 'function beg (length (symbol-name bare)) beg)) + (scope-report 'function beg (length (symbol-name bare)) beg)) (if (cdr exps) ;; def is (FUNC ARGLIST BODY...) (scope-lambda local (car exps) (cdr exps)) @@ -267,7 +259,7 @@ Optional argument LOCAL is a local context to extend." (beg (scope-sym-pos func)) (bare (bare-symbol func))) (when beg - (funcall scope-callback 'function beg (length (symbol-name bare)) beg)) + (scope-report 'function beg (length (symbol-name bare)) beg)) (let ((scope-flet-alist (scope-local-new bare beg scope-flet-alist))) (scope-lambda local args body) (scope-flet local (cdr defs) forms))) @@ -280,7 +272,7 @@ Optional argument LOCAL is a local context to extend." (let* ((beg (scope-sym-pos name)) (bare (bare-symbol name))) (when beg - (funcall scope-callback 'block beg (length (symbol-name bare)) beg)) + (scope-report 'block beg (length (symbol-name bare)) beg)) (let ((scope-block-alist (scope-local-new bare beg scope-block-alist))) (scope-n local body))) (scope-n local body))) @@ -288,8 +280,8 @@ Optional argument LOCAL is a local context to extend." (defun scope-return-from (local name result) (when-let ((bare (and (symbol-with-pos-p name) (bare-symbol name))) (pos (alist-get bare scope-block-alist))) - (funcall scope-callback 'block - (symbol-with-pos-pos name) (length (symbol-name bare)) pos)) + (scope-report 'block + (symbol-with-pos-pos name) (length (symbol-name bare)) pos)) (scope-1 local result)) (defvar scope-assume-func-p nil) @@ -302,7 +294,7 @@ Optional argument LOCAL is a local context to extend." (cond ((or (functionp bare) scope-assume-func-p) (when beg - (funcall scope-callback 'function beg (length (symbol-name bare)) nil))) + (scope-report 'function beg (length (symbol-name bare))))) ((or (assq bare scope-flet-alist) (consp arg)) (scope-1 local arg))))) ((consp arg) (scope-1 local arg)))) @@ -353,7 +345,7 @@ Optional argument LOCAL is a local context to extend." (bare (scope-sym-bare var)) (beg (scope-sym-pos var))) (when beg - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (scope-loop-for-and (scope-local-new bare beg local) rest))) (defun scope-loop-for-being-the-hash-keys-of (local0 local expr rest) @@ -393,7 +385,7 @@ Optional argument LOCAL is a local context to extend." (bare (bare-symbol var)) (beg (scope-sym-pos var))) (when beg - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (scope-loop-for local0 (scope-local-new bare beg local) (cdr-safe vars) rest)) (when-let ((bare (scope-sym-bare (car rest))) (more (cdr rest))) @@ -424,7 +416,7 @@ Optional argument LOCAL is a local context to extend." (bare (scope-sym-bare var)) (beg (scope-sym-pos var))) (when beg - (funcall scope-callback 'variable + (scope-report 'variable beg (length (symbol-name bare)) beg)) (scope-loop (scope-local-new bare beg local) (cdr more))) (scope-loop local rest)))) @@ -440,7 +432,7 @@ Optional argument LOCAL is a local context to extend." (l (scope-local-new bare beg local)) (eql (car rest))) (when beg - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (if (eq (scope-sym-bare eql) '=) (let* ((val (cadr rest)) (more (cddr rest))) (scope-1 local val) @@ -457,7 +449,7 @@ Optional argument LOCAL is a local context to extend." (let* ((beg (scope-sym-pos name)) (bare (scope-sym-bare name))) (when beg - (funcall scope-callback 'block beg (length (symbol-name bare)) beg)) + (scope-report 'block beg (length (symbol-name bare)) beg)) (let ((scope-block-alist (scope-local-new bare beg scope-block-alist))) (scope-loop local rest)))) @@ -521,13 +513,13 @@ Optional argument LOCAL is a local context to extend." (let ((bare (scope-sym-bare name)) (beg (scope-sym-pos name))) (when beg - (funcall scope-callback 'function beg (length (symbol-name bare)) beg)) + (scope-report 'function beg (length (symbol-name bare)) beg)) (dolist (binding bindings) (let* ((sym (car (ensure-list binding))) (beg (symbol-with-pos-pos sym)) (bare (bare-symbol sym))) (when beg - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (scope-1 local (cadr binding)))) (let ((l local)) (dolist (binding bindings) @@ -551,9 +543,9 @@ Optional argument LOCAL is a local context to extend." (let* ((head (car regexp)) (bare (scope-sym-bare head))) (when bare - (funcall scope-callback 'rx-construct - (symbol-with-pos-pos head) (length (symbol-name bare)) - (alist-get bare scope-rx-alist))) + (scope-report 'rx-construct + (symbol-with-pos-pos head) (length (symbol-name bare)) + (alist-get bare scope-rx-alist))) (cond ((memq bare '(literal regex regexp eval)) (scope-1 local (cadr regexp))) @@ -568,14 +560,14 @@ Optional argument LOCAL is a local context to extend." group-n submatch-n)) (scope-rx local (cdr regexp))))) (when-let ((bare (scope-sym-bare regexp))) - (funcall scope-callback 'rx-construct - (symbol-with-pos-pos regexp) (length (symbol-name bare)) - (alist-get bare scope-rx-alist))))) + (scope-report 'rx-construct + (symbol-with-pos-pos regexp) (length (symbol-name bare)) + (alist-get bare scope-rx-alist))))) (defun scope-rx-define (local name rest) (when-let ((bare (scope-sym-bare name))) - (funcall scope-callback 'rx-construct - (symbol-with-pos-pos name) (length (symbol-name bare)) nil)) + (scope-report 'rx-construct + (symbol-with-pos-pos name) (length (symbol-name bare)) nil)) (if (not (cdr rest)) (scope-rx-1 local (car rest)) (let ((l scope-rx-alist) @@ -588,8 +580,8 @@ Optional argument LOCAL is a local context to extend." (len (length (symbol-name bare)))) (when beg (if (memq (bare-symbol arg) '(&optional &rest _)) - (funcall scope-callback 'ampersand beg len nil) - (funcall scope-callback 'rx-construct beg len beg)))))) + (scope-report 'ampersand beg len) + (scope-report 'rx-construct beg len beg)))))) (dolist (arg args) (when-let ((bare (bare-symbol arg)) (beg (scope-sym-pos arg))) @@ -603,7 +595,7 @@ Optional argument LOCAL is a local context to extend." (let ((name (car binding)) (rest (cdr binding))) (when-let ((bare (scope-sym-bare name)) (beg (symbol-with-pos-pos name))) - (funcall scope-callback 'rx-construct + (scope-report 'rx-construct beg (length (symbol-name bare)) beg)) (if (cdr rest) (let ((l scope-rx-alist) @@ -616,8 +608,8 @@ Optional argument LOCAL is a local context to extend." (len (length (symbol-name bare)))) (when beg (if (memq (bare-symbol arg) '(&optional &rest _)) - (funcall scope-callback 'ampersand beg len nil) - (funcall scope-callback 'rx-construct beg len beg)))))) + (scope-report 'ampersand beg len) + (scope-report 'rx-construct beg len beg)))))) (dolist (arg args) (when-let ((bare (bare-symbol arg)) (beg (scope-sym-pos arg))) @@ -638,14 +630,14 @@ Optional argument LOCAL is a local context to extend." (defun scope-gv-define-expander (local name handler) (when-let* ((beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'defun beg (length (symbol-name bare)) nil)) + (scope-report 'defun beg (length (symbol-name bare)))) (scope-1 local handler)) (defun scope-gv-define-simple-setter (local name setter rest) (when-let* ((beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'defun beg (length (symbol-name bare)) nil)) + (scope-report 'defun beg (length (symbol-name bare)))) (when-let* ((beg (scope-sym-pos setter)) (bare (scope-sym-bare setter))) - (funcall scope-callback 'function beg (length (symbol-name bare)) nil)) + (scope-report 'function beg (length (symbol-name bare)))) (scope-n local rest)) (defun scope-catch (local tag body) @@ -653,7 +645,7 @@ Optional argument LOCAL is a local context to extend." (sym (cadr tag)) (beg (scope-sym-pos sym)) (bare (scope-sym-bare sym))) - (funcall scope-callback 'throw-tag beg (length (symbol-name bare)) nil)) + (scope-report 'throw-tag beg (length (symbol-name bare)))) (scope-n local body)) (defun scope-face (_local face-form) @@ -668,7 +660,7 @@ Optional argument LOCAL is a local context to extend." (cond ((symbol-with-pos-p face) (when-let ((beg (scope-sym-pos face)) (bare (scope-sym-bare face))) - (funcall scope-callback 'face beg (length (symbol-name bare)) nil))) + (scope-report 'face beg (length (symbol-name bare))))) ((keywordp (scope-sym-bare (car-safe face))) (let ((l face)) (while l @@ -679,14 +671,14 @@ Optional argument LOCAL is a local context to extend." ((keywordp bare))) (when-let ((beg (scope-sym-pos kw)) (len (length (symbol-name bare)))) - (funcall scope-callback 'constant beg len nil)) + (scope-report 'constant beg len)) (when (eq bare :inherit) (when-let ((beg (scope-sym-pos vl)) (fbare (scope-sym-bare vl))) - (funcall scope-callback 'face beg (length (symbol-name fbare)) nil)))))))))) + (scope-report 'face beg (length (symbol-name fbare)))))))))))) (defun scope-deftype (local name args body) (when-let* ((beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'type beg (length (symbol-name bare)) nil)) + (scope-report 'type beg (length (symbol-name bare)))) (scope-lambda local args body)) (defun scope-widget-type (_local form) @@ -698,20 +690,20 @@ Optional argument LOCAL is a local context to extend." (cond ((symbol-with-pos-p type) (when-let* ((beg (scope-sym-pos type)) (bare (scope-sym-bare type))) - (funcall scope-callback 'widget-type - (symbol-with-pos-pos type) - (length (symbol-name (bare-symbol type))) nil))) + (scope-report 'widget-type + (symbol-with-pos-pos type) + (length (symbol-name (bare-symbol type)))))) ((consp type) (let ((head (car type))) (when-let ((beg (scope-sym-pos head)) (bare (scope-sym-bare head))) - (funcall scope-callback 'widget-type beg (length (symbol-name bare)) nil)) + (scope-report 'widget-type beg (length (symbol-name bare)))) (when-let ((bare (scope-sym-bare head))) (scope-widget-type-arguments bare (cdr type))))))) (defun scope-widget-type-keyword-arguments (head kw args) (when-let ((beg (scope-sym-pos kw)) (len (length (symbol-name (bare-symbol kw))))) - (funcall scope-callback 'constant beg len nil)) + (scope-report 'constant beg len)) (cond ((and (memq head '(plist alist)) (memq kw '(:key-type :value-type))) @@ -720,7 +712,7 @@ Optional argument LOCAL is a local context to extend." (when-let* ((fun (car args)) (beg (scope-sym-pos fun)) (bare (scope-sym-bare fun))) - (funcall scope-callback 'function beg (length (symbol-name bare)) nil))) + (scope-report 'function beg (length (symbol-name bare))))) ((memq kw '(:args)) (mapc #'scope-widget-type-1 (car args)))) ;; TODO: (restricted-sexp :match-alternatives CRITERIA) @@ -741,19 +733,19 @@ Optional argument LOCAL is a local context to extend." (when-let* ((fun (car args)) (beg (scope-sym-pos fun)) (bare (scope-sym-bare fun))) - (funcall scope-callback 'function beg (length (symbol-name bare)) nil))) + (scope-report 'function beg (length (symbol-name bare))))) ((variable-item) (when-let* ((var (car args)) (beg (scope-sym-pos var)) (bare (scope-sym-bare var))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) nil))))) + (scope-report 'variable beg (length (symbol-name bare))))))) (defun scope-quoted-group (_local sym-form) (when-let* (((eq (scope-sym-bare (car-safe sym-form)) 'quote)) (sym (cadr sym-form)) (beg (scope-sym-pos sym)) (bare (scope-sym-bare sym))) - (funcall scope-callback 'group beg (length (symbol-name bare)) nil))) + (scope-report 'group beg (length (symbol-name bare))))) (defun scope-defmethod-1 (local0 local args body) (if args @@ -766,7 +758,7 @@ Optional argument LOCAL is a local context to extend." ((setq bare (scope-sym-bare var)) (when-let* ((beg (scope-sym-pos var)) (len (length (symbol-name bare)))) - (funcall scope-callback 'variable beg len beg)) + (scope-report 'variable beg len beg)) (cond ((consp spec) (let ((head (car spec)) (form (cadr spec))) @@ -777,7 +769,7 @@ Optional argument LOCAL is a local context to extend." (when-let* ((beg (symbol-with-pos-pos spec)) (bare (bare-symbol spec)) (len (length (symbol-name bare)))) - (funcall scope-callback 'type beg len nil)))) + (scope-report 'type beg len)))) (scope-defmethod-1 local0 (scope-local-new bare (scope-sym-pos var) local) (cdr args) body))))) @@ -785,7 +777,7 @@ Optional argument LOCAL is a local context to extend." (cond ((memq bare '(&optional &rest &body _)) (when-let ((beg (scope-sym-pos arg))) - (funcall scope-callback 'ampersand beg (length (symbol-name bare)) nil)) + (scope-report 'ampersand beg (length (symbol-name bare)))) (scope-defmethod-1 local0 local (cdr args) body)) ((eq bare '&context) (let* ((expr-type (cadr args)) @@ -793,7 +785,7 @@ Optional argument LOCAL is a local context to extend." (spec (cadr expr-type)) (more (cddr args))) (when-let ((beg (scope-sym-pos arg))) - (funcall scope-callback 'ampersand beg (length (symbol-name bare)) nil)) + (scope-report 'ampersand beg (length (symbol-name bare)))) (scope-1 local0 expr) (cond ((consp spec) @@ -805,12 +797,12 @@ Optional argument LOCAL is a local context to extend." (when-let* ((beg (symbol-with-pos-pos spec)) (bare (bare-symbol spec)) (len (length (symbol-name bare)))) - (funcall scope-callback 'type beg len beg)))) + (scope-report 'type beg len beg)))) (scope-defmethod-1 local0 local more body))) (t (when-let* ((beg (scope-sym-pos arg)) (len (length (symbol-name bare)))) - (funcall scope-callback 'variable beg len beg)) + (scope-report 'variable beg len beg)) (scope-defmethod-1 local0 (scope-local-new bare (scope-sym-pos arg) local) (cdr args) body)))))) @@ -829,7 +821,7 @@ Optional argument LOCAL is a local context to extend." (defun scope-defmethod (local name rest) "Analyze method definition for NAME with args REST in LOCAL context." (when-let* ((beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'defun beg (length (symbol-name bare)) nil)) + (scope-report 'defun beg (length (symbol-name bare)))) ;; [EXTRA] (when (eq (scope-sym-bare (car rest)) :extra) (scope-s local (car rest)) @@ -844,7 +836,7 @@ Optional argument LOCAL is a local context to extend." (defun scope-cl-defun (local name arglist body) (when-let ((beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'defun beg (length (symbol-name bare)) nil)) + (scope-report 'defun beg (length (symbol-name bare)))) (scope-cl-lambda local arglist body)) (defun scope-cl-lambda (local arglist body) @@ -861,7 +853,7 @@ Optional argument LOCAL is a local context to extend." (if (memq bare '(&optional &rest &body &key &aux &whole)) (progn (when-let ((beg (scope-sym-pos head))) - (funcall scope-callback 'ampersand beg (length (symbol-name bare)) nil)) + (scope-report 'ampersand beg (length (symbol-name bare)))) (cl-case bare (&optional (scope-cl-lambda-optional local (cadr arglist) (cddr arglist) more body)) ((&rest &body) (scope-cl-lambda-rest local (cadr arglist) (cddr arglist) more body)) @@ -869,7 +861,7 @@ Optional argument LOCAL is a local context to extend." (&aux (scope-cl-lambda-aux local (cadr arglist) (cddr arglist) more body)) (&whole (scope-cl-lambda-1 local (cdr arglist) more body)))) (when-let ((beg (scope-sym-pos head))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (scope-cl-lambda-1 (scope-local-new bare (scope-sym-pos head) local) (cdr arglist) more body))))) (scope-cl-lambda-1 local (list '&rest arglist) more body))) @@ -890,11 +882,11 @@ Optional argument LOCAL is a local context to extend." body) (when-let ((bare (scope-sym-bare svar))) (when-let ((beg (scope-sym-pos svar))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (setq l (scope-local-new bare (scope-sym-pos svar) l))) (when-let ((bare (scope-sym-bare var))) (when-let ((beg (scope-sym-pos var))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (setq l (scope-local-new bare (scope-sym-pos var) l))) (cond (arglist @@ -903,7 +895,7 @@ Optional argument LOCAL is a local context to extend." ((memq bare '(&rest &body &key &aux)))) (progn (when-let ((beg (scope-sym-pos head))) - (funcall scope-callback 'ampersand beg (length (symbol-name bare)) nil)) + (scope-report 'ampersand beg (length (symbol-name bare)))) (cl-case bare ((&rest &body) (scope-cl-lambda-rest l (cadr arglist) (cddr arglist) more body)) (&key (scope-cl-lambda-key l (cadr arglist) (cddr arglist) more body)) @@ -918,7 +910,7 @@ Optional argument LOCAL is a local context to extend." (scope-cl-lambda-1 l var (cons arglist more) body) (when-let ((bare (scope-sym-bare var))) (when-let ((beg (scope-sym-pos var))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (setq l (scope-local-new bare (scope-sym-pos var) l))) (cond (arglist @@ -927,7 +919,7 @@ Optional argument LOCAL is a local context to extend." ((memq bare '(&key &aux)))) (progn (when-let ((beg (scope-sym-pos head))) - (funcall scope-callback 'ampersand beg (length (symbol-name bare)) nil)) + (scope-report 'ampersand beg (length (symbol-name bare)))) (cl-case bare (&key (scope-cl-lambda-key l (cadr arglist) (cddr arglist) more body)) (&aux (scope-cl-lambda-aux l (cadr arglist) (cddr arglist) more body)))) @@ -951,7 +943,7 @@ Optional argument LOCAL is a local context to extend." (when-let ((bare (scope-sym-bare kw)) ((keywordp bare))) (when-let ((beg (scope-sym-pos kw))) - (funcall scope-callback 'constant beg (length (symbol-name bare)) nil)) + (scope-report 'constant beg (length (symbol-name bare)))) (setq l (scope-local-new bare (scope-sym-pos svar) l))) (if (consp var) (scope-cl-lambda-1 l var (cons (append (when svar (list svar)) @@ -960,11 +952,11 @@ Optional argument LOCAL is a local context to extend." body) (when-let ((bare (scope-sym-bare svar))) (when-let ((beg (scope-sym-pos svar))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (setq l (scope-local-new bare (scope-sym-pos svar) l))) (when-let ((bare (scope-sym-bare var))) (when-let ((beg (scope-sym-pos var))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (setq l (scope-local-new bare (scope-sym-pos var) l))) (cond (arglist @@ -973,7 +965,7 @@ Optional argument LOCAL is a local context to extend." ((memq bare '(&aux &allow-other-keys)))) (progn (when-let ((beg (scope-sym-pos head))) - (funcall scope-callback 'ampersand beg (length (symbol-name bare)) nil)) + (scope-report 'ampersand beg (length (symbol-name bare)))) (cl-case bare (&aux (scope-cl-lambda-aux l (cadr arglist) (cddr arglist) more body)) (&allow-other-keys (scope-cl-lambda-1 l (car more) (cdr more) body)))) @@ -991,7 +983,7 @@ Optional argument LOCAL is a local context to extend." (scope-cl-lambda-1 l var (cons arglist more) body) (when-let ((bare (scope-sym-bare var))) (when-let ((beg (scope-sym-pos var))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) beg)) + (scope-report 'variable beg (length (symbol-name bare)) beg)) (setq l (scope-local-new bare (scope-sym-pos var) l))) (cond (arglist (scope-cl-lambda-aux l (car arglist) (cdr arglist) more body)) @@ -1008,7 +1000,7 @@ Optional argument LOCAL is a local context to extend." (scope-cl-lambda local arglist mbody) (when-let ((bare (scope-sym-bare name))) (when-let ((beg (scope-sym-pos name))) - (funcall scope-callback 'macro beg (length (symbol-name bare)) beg)) + (scope-report 'macro beg (length (symbol-name bare)) beg)) (let ((scope-macrolet-alist (scope-local-new bare (scope-sym-pos name) scope-macrolet-alist))) (scope-cl-macrolet local (cdr bindings) body)))) (scope-n local body))) @@ -1024,7 +1016,7 @@ Optional argument LOCAL is a local context to extend." (bkw (scope-sym-bare kw)) ((keywordp bkw))) (when-let ((beg (scope-sym-pos kw))) - (funcall scope-callback 'constant beg (length (symbol-name bkw)) nil)) + (scope-report 'constant beg (length (symbol-name bkw)))) (cl-case bkw ((:init-value :keymap :after-hook :initialize) (scope-1 local (cadr body))) @@ -1048,9 +1040,9 @@ Optional argument LOCAL is a local context to extend." (scope-global-minor-mode-predicate (cadr body)))) (setq body (cddr body))) (when-let ((bare (scope-sym-bare mode)) (beg (scope-sym-pos mode))) - (funcall scope-callback 'defun beg (length (symbol-name bare)) nil) + (scope-report 'defun beg (length (symbol-name bare))) (unless explicit-var - (funcall scope-callback 'defvar beg (length (symbol-name bare)) nil))) + (scope-report 'defvar beg (length (symbol-name bare))))) (scope-n local body))) (defun scope-global-minor-mode-predicate (pred) @@ -1065,7 +1057,7 @@ Optional argument LOCAL is a local context to extend." (bare (bare-symbol mode)) ((not (booleanp bare))) (len (length (symbol-name bare)))) - (funcall scope-callback 'major-mode beg len nil))) + (scope-report 'major-mode beg len))) (defun scope-mode-line-construct (_local format) (scope-mode-line-construct-1 format)) @@ -1073,10 +1065,9 @@ Optional argument LOCAL is a local context to extend." (defun scope-mode-line-construct-1 (format) (cond ((symbol-with-pos-p format) - (funcall scope-callback 'variable - (symbol-with-pos-pos format) - (length (symbol-name (bare-symbol format))) - nil)) + (scope-report 'variable + (symbol-with-pos-pos format) + (length (symbol-name (bare-symbol format))))) ((consp format) (let ((head (car format))) (cond @@ -1124,14 +1115,14 @@ a (possibly empty) list of safe macros.") (when bare (cond ((assq bare scope-flet-alist) - (funcall scope-callback 'function - (symbol-with-pos-pos f) (length (symbol-name bare)) - (alist-get bare scope-flet-alist)) + (scope-report 'function + (symbol-with-pos-pos f) (length (symbol-name bare)) + (alist-get bare scope-flet-alist)) (scope-n local forms)) ((assq bare scope-macrolet-alist) - (funcall scope-callback 'macro - (symbol-with-pos-pos f) (length (symbol-name bare)) - (alist-get bare scope-macrolet-alist)) + (scope-report 'macro + (symbol-with-pos-pos f) (length (symbol-name bare)) + (alist-get bare scope-macrolet-alist)) ;; Local macros can be unsafe, so we do not expand them. ;; Hence we cannot interpret their arguments. ) @@ -1152,14 +1143,14 @@ a (possibly empty) list of safe macros.") (alias (cadr alias-form)) (beg (scope-sym-pos alias)) (bare (scope-sym-bare alias))) - (funcall scope-callback 'defun beg (length (symbol-name bare)) nil))) + (scope-report 'defun beg (length (symbol-name bare))))) (custom-declare-variable (when-let* ((sym-form (car forms)) ((eq (scope-sym-bare (car-safe sym-form)) 'quote)) (sym (cadr sym-form)) (beg (scope-sym-pos sym)) (bare (scope-sym-bare sym))) - (funcall scope-callback 'defvar beg (length (symbol-name bare)) nil)) + (scope-report 'defvar beg (length (symbol-name bare)))) (when-let* ((props (cdddr forms)) (symbols-with-pos-enabled t)) (when-let ((val-form (plist-get props :type))) @@ -1178,7 +1169,7 @@ a (possibly empty) list of safe macros.") (alias (cadr alias-form)) (beg (scope-sym-pos alias)) (bare (scope-sym-bare alias))) - (funcall scope-callback 'defface beg (length (symbol-name bare)) nil)) + (scope-report 'defface beg (length (symbol-name bare)))) (when-let* ((spec-form (cadr forms)) ((eq (scope-sym-bare (car-safe spec-form)) 'quote)) (specs (cadr spec-form)) @@ -1196,14 +1187,14 @@ a (possibly empty) list of safe macros.") (beg (scope-sym-pos alias)) (bare (scope-sym-bare alias))) (unless (booleanp bare) - (funcall scope-callback 'type beg (length (symbol-name bare)) nil)))) + (scope-report 'type beg (length (symbol-name bare)))))) (throw (when-let* ((tag-form (car forms)) ((memq (scope-sym-bare (car-safe tag-form)) '(quote \`))) (tag (cadr tag-form)) (beg (scope-sym-pos tag)) (bare (scope-sym-bare tag))) - (funcall scope-callback 'throw-tag beg (length (symbol-name bare)) nil))) + (scope-report 'throw-tag beg (length (symbol-name bare))))) (( boundp set symbol-value define-abbrev-table special-variable-p local-variable-p local-variable-if-set-p @@ -1215,28 +1206,28 @@ a (possibly empty) list of safe macros.") (var (cadr var-form)) (beg (scope-sym-pos var)) (bare (scope-sym-bare var))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) nil))) + (scope-report 'variable beg (length (symbol-name bare))))) ((run-hooks) (dolist (var-form forms) (when-let* (((memq (scope-sym-bare (car-safe var-form)) '(quote \`))) (var (cadr var-form)) (beg (scope-sym-pos var)) (bare (scope-sym-bare var))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) nil)))) + (scope-report 'variable beg (length (symbol-name bare)))))) ((featurep provide require) (when-let* ((feat-form (car forms)) ((memq (scope-sym-bare (car-safe feat-form)) '(quote \`))) (feat (cadr feat-form)) (beg (scope-sym-pos feat)) (bare (scope-sym-bare feat))) - (funcall scope-callback 'feature beg (length (symbol-name bare)) nil))) + (scope-report 'feature beg (length (symbol-name bare))))) ((fboundp) (when-let* ((fun-form (car forms)) ((memq (scope-sym-bare (car-safe fun-form)) '(quote \`))) (fun (cadr fun-form)) (beg (scope-sym-pos fun)) (bare (scope-sym-bare fun))) - (funcall scope-callback 'function beg (length (symbol-name bare)) nil))) + (scope-report 'function beg (length (symbol-name bare))))) (overlay-put (when-let* ((prop (cadr forms)) ((memq (scope-sym-bare (car-safe prop)) '(quote \`))) @@ -1258,39 +1249,39 @@ a (possibly empty) list of safe macros.") (name (cadr name-form)) (beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'type beg (length (symbol-name bare)) nil)) + (scope-report 'type beg (length (symbol-name bare)))) (when-let* ((sups-form (cadr forms)) ((memq (scope-sym-bare (car-safe sups-form)) '(quote \`))) (sups (cadr sups-form))) (dolist (sup (cadr sups-form)) (when-let* ((beg (scope-sym-pos sup)) (bare (scope-sym-bare sup))) - (funcall scope-callback 'type beg (length (symbol-name bare)) nil))))) + (scope-report 'type beg (length (symbol-name bare))))))) ((cl-struct-define) (when-let* ((name-form (car forms)) ((memq (scope-sym-bare (car-safe name-form)) '(quote \`))) (name (cadr name-form)) (beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'type beg (length (symbol-name bare)) nil)) + (scope-report 'type beg (length (symbol-name bare)))) (when-let* ((prnt-form (caddr forms)) ((memq (scope-sym-bare (car-safe prnt-form)) '(quote \`))) (prnt (cadr prnt-form)) (beg (scope-sym-pos prnt)) (bare (scope-sym-bare prnt))) - (funcall scope-callback 'type beg (length (symbol-name bare)) nil))) + (scope-report 'type beg (length (symbol-name bare))))) ((define-widget) (when-let* ((name-form (car forms)) ((memq (scope-sym-bare (car-safe name-form)) '(quote \`))) (name (cadr name-form)) (beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'widget-type beg (length (symbol-name bare)) nil)) + (scope-report 'widget-type beg (length (symbol-name bare)))) (when-let* ((prnt-form (cadr forms)) ((memq (scope-sym-bare (car-safe prnt-form)) '(quote \`))) (prnt (cadr prnt-form)) (beg (scope-sym-pos prnt)) (bare (scope-sym-bare prnt))) - (funcall scope-callback 'widget-type beg (length (symbol-name bare)) nil)) + (scope-report 'widget-type beg (length (symbol-name bare)))) (when-let* ((props (cdddr forms)) (symbols-with-pos-enabled t)) (when-let ((val-form (plist-get props :type))) @@ -1306,49 +1297,47 @@ a (possibly empty) list of safe macros.") (name (cadr name-form)) (beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'condition beg (length (symbol-name bare)) nil)) + (scope-report 'condition beg (length (symbol-name bare)))) (when-let* ((prnt-form (caddr forms)) ((memq (scope-sym-bare (car-safe prnt-form)) '(quote \`)))) (dolist (prnt (ensure-list (cadr prnt-form))) (when-let* ((beg (scope-sym-pos prnt)) (bare (scope-sym-bare prnt))) - (funcall scope-callback 'condition beg (length (symbol-name bare)) nil))))) + (scope-report 'condition beg (length (symbol-name bare))))))) ((signal) (when-let* ((name-form (car forms)) ((memq (scope-sym-bare (car-safe name-form)) '(quote \`))) (name (cadr name-form)) (beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'condition beg (length (symbol-name bare)) nil))) + (scope-report 'condition beg (length (symbol-name bare))))) ((provide-theme custom-declare-theme) (when-let* ((name-form (car forms)) ((memq (scope-sym-bare (car-safe name-form)) '(quote \`))) (name (cadr name-form)) (beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'theme beg (length (symbol-name bare)) nil))) + (scope-report 'theme beg (length (symbol-name bare))))) ((defvaralias) (when-let* ((new-form (car forms)) ((memq (scope-sym-bare (car-safe new-form)) '(quote \`))) (name (cadr new-form)) (beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'defvar beg (length (symbol-name bare)) nil)) + (scope-report 'defvar beg (length (symbol-name bare)))) (when-let* ((base-form (cadr forms)) ((memq (scope-sym-bare (car-safe base-form)) '(quote \`))) (name (cadr base-form)) (beg (scope-sym-pos name)) (bare (scope-sym-bare name))) - (funcall scope-callback 'variable beg (length (symbol-name bare)) nil)))) + (scope-report 'variable beg (length (symbol-name bare)))))) (when (symbol-with-pos-p f) - (funcall scope-callback 'function - (symbol-with-pos-pos f) (length (symbol-name bare)) - nil)) + (scope-report 'function + (symbol-with-pos-pos f) (length (symbol-name bare)))) (scope-n local forms)) ((special-form-p bare) (when (symbol-with-pos-p f) - (funcall scope-callback 'special-form - (symbol-with-pos-pos f) (length (symbol-name bare)) - nil)) + (scope-report 'special-form + (symbol-with-pos-pos f) (length (symbol-name bare)))) (cond ((eq bare 'let) (scope-let local (car forms) (cdr forms))) @@ -1371,15 +1360,15 @@ a (possibly empty) list of safe macros.") (scope-n local forms)))) ((macrop bare) (when (symbol-with-pos-p f) - (funcall scope-callback 'macro - (symbol-with-pos-pos f) (length (symbol-name bare)) - nil)) + (scope-report 'macro + (symbol-with-pos-pos f) (length (symbol-name bare)))) (cond ((memq bare '(let-alist)) (scope-1 local (car forms)) (let ((scope-current-let-alist-form - (or (scope-sym-pos f) - (cons 'gen (cl-incf scope-counter))))) + (cons (or (scope-sym-pos f) + (cons 'gen (cl-incf scope-counter))) + (scope-sym-pos f)))) (scope-n local (cdr forms)))) ((eq (get bare 'edebug-form-spec) t) (scope-n local forms)) ((eq bare 'lambda) (scope-lambda local (car forms) (cdr forms))) @@ -1400,8 +1389,8 @@ a (possibly empty) list of safe macros.") (when-let* ((wsym (car-safe warning)) (beg (scope-sym-pos wsym)) (bare (scope-sym-bare wsym))) - (funcall scope-callback 'warning-type beg - (length (symbol-name bare)) nil))) + (scope-report 'warning-type beg + (length (symbol-name bare))))) (scope-n local (cdr forms))) ((memq bare '(with-slots)) (scope-with-slots local (car forms) (cadr forms) (cddr forms))) @@ -1467,9 +1456,8 @@ a (possibly empty) list of safe macros.") (macroexpand-1 form macroexpand-all-environment)))))))) (scope-assume-func-p (when (symbol-with-pos-p f) - (funcall scope-callback 'function - (symbol-with-pos-pos f) (length (symbol-name bare)) - nil)) + (scope-report 'function + (symbol-with-pos-pos f) (length (symbol-name bare)))) (scope-n local forms)))))) ((symbol-with-pos-p form) (scope-s local form)))) @@ -1479,13 +1467,15 @@ a (possibly empty) list of safe macros.") (defun scope (callback &optional stream) "Read and analyze code from STREAM, reporting findings via CALLBACK. -Call CALLBACK for each analyzed symbol SYM with arguments TYPE, POS, LEN -and BINDER, where TYPE a symbol that specifies the semantics of SYM; POS -is the position of SYM in STREAM; LEN is SYM's length; and BINDER is the -position in which SYM is bound. If SYM is itself a binding occurrence, -then POS and BINDER are equal. If SYM is not lexically bound, then -BINDER is nil. This function ignores `read-symbol-shorthands', so SYM -and LEN always correspond to the symbol as it appears in STREAM. +Call CALLBACK for each analyzed symbol SYM with arguments TYPE, POS, +LEN, ID and DEF, where TYPE is a symbol that specifies the semantics of +SYM; POS is the position of SYM in STREAM; LEN is SYM's length; ID is an +object that uniquely identifies (co-)occurrences of SYM in the current +defun; and DEF is the position in which SYM is locally defined, or nil. +If SYM is itself a binding occurrence, then POS and BINDER are equal. +If SYM is not lexically bound, then BINDER is nil. This function +ignores `read-symbol-shorthands', so SYM and LEN always correspond to +the symbol as it appears in STREAM. If STREAM is nil, it defaults to the current buffer. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index b77ad25c548..a40d68deb81 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -408,17 +408,17 @@ happens in interactive invocations." :type 'boolean :group 'lisp) -(defun elisp--annotate-symbol-with-help-echo (type beg end bind) +(defun elisp--annotate-symbol-with-help-echo (type beg end def) (put-text-property beg end 'help-echo (cl-case type - (variable (cond ((equal beg bind) "Local variable definition") - (bind "Local variable") + (variable (cond ((equal beg def) "Local variable definition") + (def "Local variable") (t "Special variable"))) - (block (if (equal beg bind) "Block definition" "Block")) + (block (if (equal beg def) "Block definition" "Block")) (face "Face") - (function (cond ((equal beg bind) "Local function definition") - (bind "Local function call") + (function (cond ((equal beg def) "Local function definition") + (def "Local function call") (t "Function call"))) (macro "Macro call") (special-form "Special form") @@ -439,9 +439,9 @@ happens in interactive invocations." (defface "Face definition") (major-mode "Major mode")))) -(defun elisp-fontify-symbol (type sym len bind) - (elisp--annotate-symbol-with-help-echo type sym (+ sym len) bind) - (if (null bind) +(defun elisp-fontify-symbol (type sym len id &optional def) + (elisp--annotate-symbol-with-help-echo type sym (+ sym len) def) + (if (null id) (when-let ((face (cl-case type (variable 'elisp-free-variable) (face 'elisp-face) @@ -466,7 +466,7 @@ happens in interactive invocations." (major-mode 'elisp-major-mode-name)))) (add-face-text-property sym (+ sym len) face t)) (add-face-text-property sym (+ sym len) - (if (equal sym bind) + (if (equal sym def) 'elisp-binding-variable 'elisp-bound-variable) t) @@ -891,10 +891,9 @@ in `completion-at-point-functions' (which see)." (goto-char pos) (beginning-of-defun) (catch 'sym-type - (scope (lambda (type beg len _bin) + (scope (lambda (type beg len &rest _) (when (<= beg pos (+ beg len)) - (throw 'sym-type type))) - (current-buffer)) + (throw 'sym-type type)))) nil)) ((variable constant) (let ((local-vars (elisp--local-variables))) (lambda (sym) (or (elisp--shorthand-aware-boundp sym) @@ -1143,7 +1142,7 @@ confidence." (save-excursion (beginning-of-defun-raw) (cl-case (catch 'sym-type - (scope (lambda (type beg len _bin) + (scope (lambda (type beg len &rest _) (when (<= beg pos (+ beg len)) (throw 'sym-type type)))) nil) @@ -1168,10 +1167,9 @@ confidence." (goto-char pos) (beginning-of-defun) (catch 'var-def - (scope (lambda (_type beg len bin) + (scope (lambda (_type beg len _id &optional def) (when (<= beg pos (+ beg len)) - (throw 'var-def bin))) - (current-buffer)) + (throw 'var-def def)))) nil))))) (if (numberp dec) (list (xref-make "lexical binding" @@ -1196,13 +1194,12 @@ confidence." (save-excursion (goto-char pos) (beginning-of-defun) - (scope (lambda (_type beg len bin) + (scope (lambda (_type beg len id &optional _def) (when (<= beg pos (+ beg len)) - (setq cur bin)) - (when bin (alist-set beg all (list len bin)))) - (current-buffer))) + (setq cur id)) + (when id (alist-set beg all (list len id)))))) (seq-keep - (pcase-lambda (`(,sym ,len ,bin)) (when (equal bin cur) (cons sym len))) + (pcase-lambda (`(,beg ,len ,id)) (when (equal id cur) (cons beg len))) all))) (cl-defmethod xref-backend-references :around ((backend (eql 'elisp)) identifier) @@ -2587,13 +2584,13 @@ of TARGET." (save-excursion (goto-char beg) (beginning-of-defun-raw) - (scope (lambda (type sbeg len bin) + (scope (lambda (type sbeg len _id &optional def) (and (<= sbeg beg) (memq type '(function macro special-form top-level)) (push (nth 1 (syntax-ppss sbeg)) targets)) (let ((send (+ sbeg len))) - (and (<= beg sbeg send end) (numberp bin) (< bin beg) - (setq max (max max bin))))))) + (and (<= beg sbeg send end) def (< def beg) + (setq max (max max def))))))) (let* ((target (if-let ((avy-action #'ignore) ;Just return selection. (cands (seq-drop-while diff --git a/lisp/progmodes/refactor-elisp.el b/lisp/progmodes/refactor-elisp.el index e4de59e02e1..1d0688178b8 100644 --- a/lisp/progmodes/refactor-elisp.el +++ b/lisp/progmodes/refactor-elisp.el @@ -34,8 +34,8 @@ (save-excursion (beginning-of-defun-raw) (catch 'var-def - (scope (lambda (_type beg len bin) - (when (and bin (<= beg pos (+ beg len))) + (scope (lambda (_type beg len _id &optional def) + (when (and def (<= beg pos (+ beg len))) (throw 'var-def (list (propertize (buffer-substring-no-properties beg (+ beg len)) @@ -76,11 +76,11 @@ (goto-char beg) (beginning-of-defun-raw) (let (bound) - (scope (lambda (_type sbeg len bin) + (scope (lambda (_type sbeg len _id &optional def) (let ((send (+ sbeg len))) - (and (<= beg sbeg send end) (numberp bin) (< bin beg) - (unless (assoc bin bound #'=) - (push (cons bin (buffer-substring-no-properties + (and (<= beg sbeg send end) def (< def beg) + (unless (assoc def bound #'=) + (push (cons def (buffer-substring-no-properties sbeg send)) bound)))))) (let* ((buf (current-buffer)) (pos (point)) diff --git a/test/lisp/emacs-lisp/scope-tests.el b/test/lisp/emacs-lisp/scope-tests.el index a85aee30033..075af6d49eb 100644 --- a/test/lisp/emacs-lisp/scope-tests.el +++ b/test/lisp/emacs-lisp/scope-tests.el @@ -24,8 +24,8 @@ (defmacro scope-test (given expected) `(should (equal ,expected (let (all) - (scope (lambda (_type beg len bin) - (push (list beg len bin) all)) + (scope (lambda (_type beg len bin &optional def) + (push (list beg len def) all)) ,given) (reverse all))))) @@ -72,9 +72,11 @@ (8 17 nil) (104 3 nil) (110 11 110) + (156 26 nil) (133 16 nil) (189 6 nil) (197 6 197) + (204 5 nil) (221 5 nil) (228 7 nil) (236 6 197) @@ -102,7 +104,10 @@ (cl-progv ,syms ,vals ,@body))))" '((2 8 nil) (11 32 nil) + (107 7 nil) + (116 6 nil) (45 3 45) + (49 5 nil) (55 4 55) (130 3 nil) (136 4 136) @@ -149,4 +154,29 @@ (24 2 9) (27 2 9)))) +(ert-deftest scope-test-6 () + (scope-test " +(let-alist '((rose . red) (lily . white) (buttercup . yellow)) + (if (eq .rose 'red) + (let-alist '((rose . red) (lily . white) (buttercup . yellow)) + (if (eq .rose 'red) + .lily + (+ .lily .rose))) + (+ .lily .rose)))" + '((2 9 nil) + (67 2 nil) + (71 2 nil) + (74 5 2) + (93 9 nil) + (164 2 nil) + (168 2 nil) + (171 5 93) + (195 5 93) + (212 1 nil) + (214 5 93) + (220 5 93) + (234 1 nil) + (236 5 2) + (242 5 2)))) + ;;; scope-tests.el ends here -- 2.39.5