scope.el: Analyze minor mode definitions

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index ee7747fcbcf4ebc9a872db2ef67ddd76fbaf3cf0..d80d907eb0ba616eac578c50a1dd6ff3c13ff45b 100644 (file)
--- a/lisp/emacs-lisp/scope.el
+++ b/lisp/emacs-lisp/scope.el
@@ -95,12 +95,7 @@ Optional argument LOCAL is a local context to extend."
              (length (symbol-name (scope-sym-bare intr)))
              nil))
   (scope-1 local spec)
-  (dolist (mode modes)
-    (and (symbol-with-pos-p mode)
-         (when-let* ((beg (symbol-with-pos-pos mode))
-                     (bare (bare-symbol mode))
-                     (len (length (symbol-name bare))))
-           (funcall scope-callback 'major-mode beg len nil)))))
+  (mapc #'scope-major-mode-name modes))
 
 (defun scope-lambda (local args body)
   "Analyze (lambda ARGS BODY) function definition in LOCAL context."
@@ -151,12 +146,7 @@ Optional argument LOCAL is a local context to extend."
             ((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))))
+            (modes (mapc #'scope-major-mode-name (cdr spec)))
             (interactive-args
              (dolist (arg-form (cdr spec))
                (when-let ((arg (car-safe arg-form)))
@@ -1008,6 +998,90 @@ Optional argument LOCAL is a local context to extend."
             (scope-cl-macrolet local (cdr bindings) body))))
     (scope-n local body)))
 
+(defun scope-define-global-minor-mode (local global mode turn-on body)
+  (scope-sharpquote local mode)
+  (scope-sharpquote local turn-on)
+  (scope-define-minor-mode local global nil body))
+
+(defun scope-define-minor-mode (local mode _doc body)
+  (let ((explicit-var nil))
+    (while-let ((kw (car-safe body))
+                (bkw (scope-sym-bare kw))
+                ((keywordp bkw)))
+      (when-let ((beg (scope-sym-pos kw)))
+        (funcall scope-callback 'constant beg (length (symbol-name bkw)) nil))
+      (cl-case bkw
+        ((:init-value :keymap :after-hook :initialize)
+         (scope-1 local (cadr body)))
+        (:lighter (scope-mode-line-construct local (cadr body)))
+        ((:interactive)
+         (let ((val (cadr body)))
+           (when (consp val) (mapc #'scope-major-mode-name val))))
+        ((:variable)
+         (let* ((place (cadr body))
+                (tail (cdr-safe place)))
+           (if (and tail (let ((symbols-with-pos-enabled t))
+                           (or (symbolp tail) (functionp tail))))
+               (progn
+                 (scope-1 local (car place))
+                 (scope-sharpquote local tail))
+             (scope-1 local place)))
+         (setq explicit-var t))
+        ((:group)
+         (scope-quoted-group local (cadr body)))
+        ((:predicate)                   ;For globalized minor modes.
+         (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)
+      (unless explicit-var
+        (funcall scope-callback 'defvar beg (length (symbol-name bare)) nil)))
+    (scope-n local body)))
+
+(defun scope-global-minor-mode-predicate (pred)
+  (if (consp pred)
+      (if (eq 'not (scope-sym-bare (car pred)))
+          (mapc #'scope-global-minor-mode-predicate (cdr pred))
+        (mapc #'scope-global-minor-mode-predicate pred))
+    (scope-major-mode-name pred)))
+
+(defun scope-major-mode-name (mode)
+  (when-let* ((beg (scope-sym-pos mode))
+              (bare (bare-symbol mode))
+              ((not (booleanp bare)))
+              (len (length (symbol-name bare))))
+    (funcall scope-callback 'major-mode beg len nil)))
+
+(defun scope-mode-line-construct (_local format)
+  (scope-mode-line-construct-1 format))
+
+(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))
+   ((consp format)
+    (let ((head (car format)))
+      (cond
+       ((or (stringp head) (consp head) (integerp head))
+        (mapc #'scope-mode-line-construct-1 format))
+       ((or (symbolp head) (symbol-with-pos-p head))
+        (scope-s nil head)
+        (cl-case (bare-symbol head)
+          (:eval
+           (scope-1 nil (cadr format)))
+          (:propertize
+           (scope-mode-line-construct-1 (cadr format))
+           (when-let* ((props (cdr format))
+                       (symbols-with-pos-enabled t)
+                       (val-form (plist-get props 'face)))
+             (scope-face-1 val-form)))
+          (otherwise
+           (scope-mode-line-construct-1 (cadr format))
+           (scope-mode-line-construct-1 (caddr format))))))))))
+
 (defvar scope-safe-macros t
   "Specify which macros are safe to expand.
 
@@ -1349,6 +1423,11 @@ a (possibly empty) list of safe macros.")
              local (car forms) (cadr forms) (cddr forms)))
            ((memq bare '(cl-deftype))
             (scope-deftype local (car forms) (cadr forms) (cddr forms)))
+           ((memq bare '(define-minor-mode))
+            (scope-define-minor-mode local (car forms) (cadr forms) (cddr forms)))
+           ((memq bare '(define-global-minor-mode define-globalized-minor-mode))
+            (scope-define-global-minor-mode
+             local (car forms) (cadr forms) (caddr forms) (cdddr forms)))
            ((scope-safe-macro-p bare)
             (scope-1 local (let ((symbols-with-pos-enabled t))
                              ;; Ignore errors from trying to expand