scope.el,elisp-mode.el: Recognize 'declare' specs

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index 17665df29c9da8046832b4003655cfb1cc2cb4e7..2f33bf9002681e8502f2aef0e23c9ac8b37f07a2 100644 (file)
--- a/lisp/emacs-lisp/scope.el
+++ b/lisp/emacs-lisp/scope.el
@@ -104,55 +104,92 @@ Optional argument LOCAL is a local context to extend."
 
 (defun scope-lambda (local args body)
   "Analyze (lambda ARGS BODY) function definition in LOCAL context."
-  ;; Handle docstring.
-  (cond
-   ((and (consp (car body))
-         (or (symbol-with-pos-p (caar body))
-             (symbolp (caar body)))
-         (eq (bare-symbol (caar body)) :documentation))
-    (scope-1 local (cadar body))
-    (setq body (cdr body)))
-   ((stringp (car body)) (setq body (cdr body))))
-  ;; Handle `declare'.
-  ;; FIXME: `declare' is macro-expanded away, so we never actually see
-  ;; it in a `lambda'.
-  (when-let ((form (car body))
-             (decl (car-safe form))
-             ((or (symbol-with-pos-p decl)
-                  (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))
-    (setq body (cdr body)))
-  ;; Handle `interactive'.
-  (when-let ((form (car body))
-             (intr (car-safe form))
-             ((or (symbol-with-pos-p intr)
-                  (symbolp intr)))
-             ((eq (bare-symbol intr) 'interactive)))
-    (scope-interactive local intr (cadar body) (cddar body))
-    (setq body (cdr body)))
-  ;; Handle ARGS.
-  (dolist (arg args)
-    (and (symbol-with-pos-p arg)
-         (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))))))
-  ;; Handle BODY.
   (let ((l local))
     (dolist (arg args)
       (when-let ((bare (bare-symbol arg))
                  (beg (scope-sym-pos arg)))
         (unless (memq bare '(&optional &rest))
           (setq l (scope-local-new bare beg l)))))
-    (scope-n l body)))
+    ;; Handle docstring.
+    (cond
+     ((and (consp (car body))
+           (or (symbol-with-pos-p (caar body))
+               (symbolp (caar body)))
+           (eq (bare-symbol (caar body)) :documentation))
+      (scope-s local (caar body))
+      (scope-1 local (cadar body))
+      (setq body (cdr body)))
+     ((stringp (car body)) (setq body (cdr body))))
+    ;; Handle `declare'.
+    (when-let ((form (car body))
+               (decl (car-safe form))
+               ((or (symbol-with-pos-p decl)
+                    (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))
+      (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))
+          (cl-case bare
+            (completion (scope-sharpquote local (cadr spec)))
+            (interactive-only
+             (when-let ((bare (scope-sym-bare (cadr spec)))
+                        ((not (eq bare t))))
+               (scope-sharpquote local (cadr spec))))
+            (obsolete
+             (when-let ((bare (scope-sym-bare (cadr spec))))
+               (scope-sharpquote local (cadr spec))))
+            ((compiler-macro gv-expander gv-setter)
+             ;; Use the extended lexical environment `l'.
+             (scope-sharpquote l (cadr spec)))
+            (modes
+             (dolist (mode (cdr spec))
+               (when-let* ((beg (scope-sym-pos mode))
+                           (bare (bare-symbol mode))
+                           (len (length (symbol-name bare))))
+                 (funcall scope-callback 'major-mode beg len nil))))
+            (interactive-args
+             (dolist (arg-form (cdr spec))
+               (when-let ((arg (car-safe arg-form)))
+                 (scope-s l arg)
+                 (when (consp (cdr arg-form))
+                   (scope-1 local (cadr arg-form)))))))))
+      (setq body (cdr body)))
+    ;; Handle `interactive'.
+    (when-let ((form (car body))
+               (intr (car-safe form))
+               ((or (symbol-with-pos-p intr)
+                    (symbolp intr)))
+               ((eq (bare-symbol intr) 'interactive)))
+      (scope-interactive local intr (cadar body) (cddar body))
+      (setq body (cdr body)))
+    ;; Handle ARGS.
+    (dolist (arg args)
+      (and (symbol-with-pos-p arg)
+           (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))))))
+    ;; Handle BODY.
+    (let ((l local))
+      (dolist (arg args)
+        (when-let ((bare (bare-symbol arg))
+                   (beg (scope-sym-pos arg)))
+          (unless (memq bare '(&optional &rest))
+            (setq l (scope-local-new bare beg l)))))
+      (scope-n l body))))
 
 (defun scope-defun (local name args body)
   (when-let ((beg (scope-sym-pos name))
@@ -1236,11 +1273,11 @@ a (possibly empty) list of safe macros.")
             (scope-n local (cdr forms)))
            ((memq bare '(with-slots))
             (scope-with-slots local (car forms) (cadr forms) (cddr forms)))
-           ((memq bare '(ert-deftest))
+           ((memq bare '(defun defmacro ert-deftest))
             (scope-defun local (car forms) (cadr forms) (cddr forms)))
            ((eq bare 'cl-defmethod)
             (scope-defmethod local (car forms) (cdr forms)))
-           ((eq bare 'cl-defun)
+           ((memq bare '(cl-defun cl-defmacro))
             (scope-cl-defun local (car forms) (cadr forms) (cddr forms)))
            ((memq bare '(declare-function))
             (scope-declare-function local (car forms) (cadr forms)

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index f9cbc1023fce87946428ad192189717d772bee42..e69ef840b42d3cd359418d6c1e5a755c3f2bd2c8 100644 (file)
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -435,6 +435,7 @@ happens in interactive invocations."
      (throw-tag     "`throw'/`catch' tag")
      (warning-type  "Warning type")
      (feature       "Feature")
+     (declaration   "Declaration")
      (rx-construct  "`rx' construct")
      (theme         "Theme")
      (widget-type   "Widget type")
@@ -460,6 +461,7 @@ happens in interactive invocations."
                          (throw-tag     'elisp-throw-tag)
                          (warning-type  'font-lock-type-face)
                          (feature       'elisp-feature)
+                         (declaration   'font-lock-variable-use-face)
                          (rx-construct  'elisp-rx)
                          (theme         'elisp-theme)
                          (widget-type   'font-lock-type-face)
@@ -913,6 +915,9 @@ in `completion-at-point-functions' (which see)."
                             ((widget-type) (lambda (sym) (get sym 'widget-type)))
                             ((warning-type)
                              (lambda (sym) (memq sym byte-compile-warning-types)))
+                            ((declaration)
+                             (lambda (sym) (or (alist-get sym macro-declarations-alist)
+                                               (alist-get sym defun-declarations-alist))))
                             ((group) (lambda (sym) (get sym 'group-documentation)))
                             ((face) #'facep)
                             ((nil) (lambda (sym)