scope.el,elisp-mode.el: Support and custom types groups

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index 26f1154860aac372d014a4958190aeb999f8390f..9efe63bf0dc8e49acf52c94bd89b8e8a30eccf63 100644 (file)
--- a/lisp/emacs-lisp/scope.el
+++ b/lisp/emacs-lisp/scope.el
@@ -88,7 +88,12 @@ Optional argument LOCAL is a local context to extend."
          (scope-local-new bare beg local) (cdr bindings) body))
     (scope-n local body)))
 
-(defun scope-interactive (local spec modes)
+(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-1 local spec)
   (dolist (mode modes)
     (and (symbol-with-pos-p mode)
@@ -109,17 +114,26 @@ Optional argument LOCAL is a local context to extend."
     (setq body (cdr body)))
    ((stringp (car body)) (setq body (cdr body))))
   ;; Handle `declare'.
-  (when (and (consp (car body))
-             (or (symbol-with-pos-p (caar body))
-                 (symbolp (caar body)))
-             (eq (bare-symbol (caar body)) '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 (and (consp (car body))
-             (or (symbol-with-pos-p (caar body))
-                 (symbolp (caar body)))
-             (eq (bare-symbol (caar body)) 'interactive))
-    (scope-interactive local (cadar body) (cddar body))
+  (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)
@@ -557,6 +571,69 @@ Optional argument LOCAL is a local context to extend."
     (funcall scope-callback 'type beg (length (symbol-name bare)) nil))
   (scope-lambda local args body))
 
+(defun scope-widget-type (_local form)
+  (when-let (((memq (scope-sym-bare (car-safe form)) '(quote \`)))
+             (type (cadr form)))
+    (scope-widget-type-1 type)))
+
+(defun scope-widget-type-1 (type)
+  (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)))
+   ((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))
+      (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))
+  (cond
+   ((and (memq head '(plist alist))
+         (memq kw   '(:key-type :value-type)))
+    (scope-widget-type-1 (car args)))
+   ((memq kw '(:action :match :match-inline :validate))
+    (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))))
+  ;; TODO: (restricted-sexp :match-alternatives CRITERIA)
+  (scope-widget-type-arguments head (cdr args)))
+
+(defun scope-widget-type-arguments (head args)
+  (let* ((arg (car args))
+         (bare (scope-sym-bare arg)))
+    (if (keywordp bare)
+        (scope-widget-type-keyword-arguments head bare (cdr args))
+      (scope-widget-type-arguments-1 head args))))
+
+(defun scope-widget-type-arguments-1 (head args)
+  (cl-case head
+    ((list cons group vector choice radio set repeat) (mapc #'scope-widget-type-1 args))
+    ((function-item)
+     (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)))
+    ((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)))))
+
+(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)))
+
 (defvar scope-safe-macros t
   "Specify which macros are safe to expand.
 
@@ -607,12 +684,24 @@ a (possibly empty) list of safe macros.")
                           (bare (scope-sym-bare alias)))
                 (funcall scope-callback 'defun beg (length (symbol-name bare)) nil)))
             (custom-declare-variable
-             (when-let* ((alias-form (car forms))
-                         ((eq (scope-sym-bare (car-safe alias-form)) 'quote))
-                         (alias (cadr alias-form))
-                         (beg (scope-sym-pos alias))
-                         (bare (scope-sym-bare alias)))
-               (funcall scope-callback 'defvar beg (length (symbol-name bare)) nil)))
+             (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))
+             (when-let* ((props (cdddr forms))
+                         (symbols-with-pos-enabled t))
+               (when-let ((val-form (plist-get props :type)))
+                 (scope-widget-type local val-form))
+               (when-let ((val-form (plist-get props :group)))
+                 (scope-quoted-group local val-form))))
+            (custom-declare-group
+             (scope-quoted-group local (car forms))
+             (when-let* ((props (cdddr forms))
+                         (symbols-with-pos-enabled t)
+                         (val-form (plist-get props :group)))
+               (scope-quoted-group local val-form)))
             (custom-declare-face
              (when-let* ((alias-form (car forms))
                          ((eq (scope-sym-bare (car-safe alias-form)) 'quote))
@@ -625,7 +714,11 @@ a (possibly empty) list of safe macros.")
                          (specs (cadr spec-form))
                          ((consp specs)))
                (dolist (spec specs)
-                 (scope-face local (list 'quote (cdr spec))))))
+                 (scope-face local (list 'quote (cdr spec)))))
+             (when-let* ((props (cdddr forms))
+                         (symbols-with-pos-enabled t))
+               (when-let ((val-form (plist-get props :group)))
+                 (scope-quoted-group local val-form))))
             (throw
              (when-let* ((tag-form (car forms))
                          ((memq (scope-sym-bare (car-safe tag-form)) '(quote \`)))
@@ -633,7 +726,7 @@ a (possibly empty) list of safe macros.")
                          (beg (scope-sym-pos tag))
                          (bare (scope-sym-bare tag)))
                (funcall scope-callback 'throw-tag beg (length (symbol-name bare)) nil)))
-            (( boundp set symbol-value
+            (( boundp set symbol-value define-abbrev-table
                special-variable-p local-variable-p
                local-variable-if-set-p
                make-variable-buffer-local
@@ -699,7 +792,20 @@ a (possibly empty) list of safe macros.")
                          (prnt (cadr prnt-form))
                          (beg (scope-sym-pos prnt))
                          (bare (scope-sym-bare prnt)))
-               (funcall scope-callback 'type beg (length (symbol-name bare)) nil))))
+               (funcall scope-callback 'type beg (length (symbol-name bare)) nil)))
+            ((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))
+             (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))))
           (when (symbol-with-pos-p f)
             (funcall scope-callback 'function
                      (symbol-with-pos-pos f) (length (symbol-name bare))

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index abbdb58ea78a5fafa83b406aa48b05cffb7d3e89..9b718691e391358afb89d3d17f6a4cac08c764b5 100644 (file)
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -425,7 +425,9 @@ happens in interactive invocations."
      (special-form  "Special form")
      (throw-tag     "`throw'/`catch' tag")
      (feature       "Feature")
+     (widget-type   "Widget type")
      (type          "Type")
+     (group         "Customization group")
      (condition     "`condition-case' condition")
      (ampersand     "Arguments separator")
      (constant      "Constant")
@@ -445,7 +447,9 @@ happens in interactive invocations."
                          (special-form  'elisp-special-form)
                          (throw-tag     'elisp-throw-tag)
                          (feature       'elisp-feature)
+                         (widget-type   'font-lock-type-face)
                          (type          'font-lock-type-face)
+                         (group         'font-lock-type-face)
                          (condition     'elisp-condition)
                          (ampersand     'font-lock-type-face)
                          (constant      'font-lock-builtin-face)
@@ -887,6 +891,8 @@ in `completion-at-point-functions' (which see)."
                             ((function macro special-form top-level) #'elisp--shorthand-aware-fboundp)
                             ((major-mode) (lambda (sym) (get sym 'major-mode-name)))
                             ((type) (lambda (sym) (get sym 'cl--class)))
+                            ((widget-type) (lambda (sym) (get sym 'widget-type)))
+                            ((group) (lambda (sym) (get sym 'group-documentation)))
                             ((face) #'facep)
                             ((nil) (lambda (sym)
                                      (let ((sym (intern-soft (symbol-name sym))))