scope.el: Finalize refactor and let-alist support

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index 7473c62bb36446f937998c11e90a9c41142716d9..142f9da6f6f9a437da55cb4301299dc8faca1303 100644 (file)
--- 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 b77ad25c54848d2adf0fcdeb02274c391ef9afc2..a40d68deb8179f6d71a278ba3a9c1484c8d89b91 100644 (file)
--- 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 e4de59e02e1fc11eee98a577314b85e5740bd63e..1d0688178b8bafb2db46676a814d6da6ead82dec 100644 (file)
--- 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 a85aee30033716a5f36f6911980982d2639e5f9a..075af6d49ebf6a41405767a0dc06ff2b70875f39 100644 (file)
--- 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