Make scope.el symbol types a first class citizen.

diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 54e6cb30b87dbe2903c2fce05b7014826ed5107b..13c58482697c14496a478c4faf5f151bb640bf52 100644 (file)
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -79,6 +79,9 @@ Please send improvements and fixes to the maintainer."
 (defvar find-error-regexp
   (concat "^\\s-*(define-error" find-function-space-re "%s\\(\\s-\\|$\\)"))
 
+(defvar find-symbol-type-regexp
+  (concat "^\\s-*(scope-define-symbol-type" find-function-space-re "%s\\(\\s-\\|$\\)"))
+
 (defvar find-widget-regexp
   (concat "^\\s-*(define-widget" find-function-space-re "%s\\(\\s-\\|$\\)"))
 
@@ -140,7 +143,8 @@ should insert the feature name."
     (defalias . find-alias-regexp)
     (ert-deftest . find-ert-deftest-regexp)
     (define-widget . find-widget-regexp)
-    (define-error . find-error-regexp))
+    (define-error . find-error-regexp)
+    (define-symbol-type . find-symbol-type-regexp))
   "Alist mapping definition types into regexp variables.
 Each regexp variable's value should actually be a format string
 to be used to substitute the desired symbol name into the regexp.

diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el
index 1b083f3c83525c45162c1948947ae24a664932a9..a2e45a3e47ac20931da38c831d8b938d80bfab10 100644 (file)
--- a/lisp/emacs-lisp/scope.el
+++ b/lisp/emacs-lisp/scope.el
@@ -26,6 +26,301 @@
 
 ;;; Code:
 
+(defun scope--define-symbol-type (name parents props)
+  (put name 'scope-parent-types parents)
+  (put name 'scope-type-properties props)
+  (add-to-list 'current-load-list `(define-symbol-type . ,name)))
+
+;;;###autoload
+(defmacro scope-define-symbol-type (name parents &rest props)
+  (declare (indent defun))
+  `(scope--define-symbol-type ',name ',parents ,(when props `(list ,@props))))
+
+;;;###autoload
+(defun scope-get-symbol-type-property (type prop)
+  (named-let loop ((current type)
+                   (parents (get type 'scope-parent-types))
+                   (more nil)
+                   (done nil))
+    (or (plist-get (get current 'scope-type-properties) prop)
+        (when-let ((next (car parents)))
+          (loop (car parents) (get next 'scope-parent-types) (append (cdr parents) more) done))
+        (when-let ((next (car more)))
+          (loop next (let (res)
+                       (dolist (per (get next 'scope-parent-types))
+                         (unless (memq per done)
+                           (push per res)))
+                       (nreverse res))
+                (cdr more) done)))))
+
+;;;###autoload
+(defun scope-symbol-type-p (sym)
+  (or (get sym 'scope-parent-types) (get sym 'scope-type-properties)))
+
+(defvar scope-read-symbol-type-history nil)
+
+(defun scope-read-symbol-type (prompt &optional default)
+  (completing-read
+   (format-prompt prompt default)
+   obarray #'scope-symbol-type-p 'confirm
+   nil 'scope-read-symbol-type-history default))
+
+(defvar help-mode--current-data)
+
+;;;###autoload
+(defun scope-describe-symbol-type (type)
+  (interactive (list (scope-read-symbol-type
+                      "Describe symbol type"
+                      (when-let ((def (symbol-at-point))
+                                 ((scope-symbol-type-p def)))
+                        def))))
+  (when (stringp type) (setq type (intern type)))
+  (let ((help-buffer-under-preparation t))
+    (help-setup-xref (list #'scope-describe-symbol-type type)
+                     (called-interactively-p 'interactive))
+    (with-help-window (help-buffer)
+      (with-current-buffer standard-output
+        (insert "Symbol type "
+                (substitute-quotes (concat "`" (symbol-name type) "'"))
+                ":\n\n"
+                (substitute-quotes
+                 (or (scope-get-symbol-type-property type :doc)
+                     "Undocumented.")))
+        (when-let ((parents (get type 'scope-parent-types)))
+          (insert "\n\nParent types: "
+                  (mapconcat (lambda (parent)
+                               (let ((name (symbol-name parent)))
+                                 (substitute-quotes
+                                  (concat
+                                   "`"
+                                   (buttonize
+                                    name #'scope-describe-symbol-type name
+                                    "mouse-2, RET: describe this symbol type")
+                                   "'"))))
+                             parents ", ")))
+        (setq help-mode--current-data
+              (list :symbol type :type 'define-symbol-type
+                    :file (find-lisp-object-file-name type 'define-symbol-type)))))))
+
+(put 'scope-describe-symbol-type 'minibuffer-action "describe")
+
+(scope-define-symbol-type symbol-type ()
+  :doc "Symbol type names."
+  :face 'elisp-symbol-type
+  :help (constantly "Symbol type")
+  :completion (constantly #'scope-symbol-type-p)
+  :namespace 'symbol-type)
+
+(scope-define-symbol-type symbol-type-definition (symbol-type)
+  :doc "Symbol type name definitions."
+  :face 'elisp-symbol-type-definition
+  :help (constantly "Symbol type definition")
+  :imenu "Symbol Type"
+  :namespace 'symbol-type)
+
+(scope-define-symbol-type variable ()
+  :doc "Variable names."
+  :face 'elisp-free-variable
+  :help (lambda (beg end def)
+          (cond ((equal beg def) "Local variable definition")
+                (def             "Local variable")
+                (t (elisp--help-echo beg end 'variable-documentation "Special variable"))))
+  :completion (lambda ()
+                (let ((local-vars (elisp-local-variables)))
+                  (lambda (sym) (or (elisp--shorthand-aware-boundp sym)
+                                    (memq sym local-vars)))))
+  :namespace 'variable)
+
+(scope-define-symbol-type face ()
+  :doc "Face names."
+  :face 'elisp-face
+  :help (lambda (beg end _def)
+          (elisp--help-echo beg end 'face-documentation "Face"))
+  :completion (constantly #'facep)
+  :namespace 'face)
+
+(scope-define-symbol-type callable ()
+  :doc "Abstract symbol type of function-like symbols."
+  :completion (constantly #'elisp--shorthand-aware-fboundp)
+  :namespace 'function)
+
+(scope-define-symbol-type function (callable)
+  :doc "Function names."
+  :face 'elisp-function-call
+  :help (lambda (beg end def)
+          (cond ((equal beg def) "Local function definition")
+                (def             "Local function call")
+                (t (if-let ((sym (intern-soft (buffer-substring-no-properties beg end))))
+                       (apply-partially #'elisp--function-help-echo sym)
+                     "Function call")))))
+
+(scope-define-symbol-type non-local-exit (function)
+  :doc "Functions that do not return."
+  :face 'elisp-non-local-exit
+  :help (lambda (beg end _def)
+          (if-let ((sym (intern-soft (buffer-substring-no-properties beg end))))
+              (apply-partially #'elisp--function-help-echo sym)
+            "Non-local exit")))
+
+(scope-define-symbol-type macro (callable)
+  :doc "Macro names."
+  :face 'elisp-macro-call
+  :help (lambda (beg end _def)
+          (if-let ((sym (intern-soft (buffer-substring-no-properties beg end))))
+              (apply-partially #'elisp--function-help-echo sym)
+            "Macro call")))
+
+(scope-define-symbol-type special-form (callable)
+  :doc "Special form names."
+  :face 'elisp-special-form
+  :help (lambda (beg end _def)
+          (if-let ((sym (intern-soft (buffer-substring-no-properties beg end))))
+              (apply-partially #'elisp--function-help-echo sym)
+            "Special form")))
+
+(scope-define-symbol-type throw-tag ()
+  :doc "Symbols used as `throw'/`catch' tags."
+  :face 'elisp-throw-tag
+  :help (constantly "`throw'/`catch' tag"))
+
+(scope-define-symbol-type warning-type ()
+  :doc "Byte-compilation warning types."
+  :face 'font-lock-type-face
+  :help (constantly "Warning type")
+  :completion (constantly (lambda (sym) (memq sym byte-compile-warning-types))))
+
+(scope-define-symbol-type feature ()
+  :doc "Feature names."
+  :face 'elisp-feature
+  :help (constantly "Feature")
+  :completion (constantly #'featurep)
+  :namespace 'feature)
+
+(scope-define-symbol-type declaration ()
+  :doc "Function attribute declaration types."
+  :face 'font-lock-variable-use-face
+  :help (constantly "Declaration")
+  :completion (constantly
+               (lambda (sym) (or (alist-get sym macro-declarations-alist)
+                                 (alist-get sym defun-declarations-alist)))))
+
+(scope-define-symbol-type rx-construct ()
+  :doc "`rx' constructs."
+  :face 'elisp-rx
+  :help (constantly "`rx' construct"))
+
+(scope-define-symbol-type theme ()
+  :doc "Custom theme names."
+  :face 'elisp-theme
+  :help (constantly "Theme")
+  :completion (constantly #'custom-theme-p))
+
+(scope-define-symbol-type thing ()
+  :doc "`thing-at-point' \"thing\" identifiers."
+  :face 'font-lock-type-face
+  :help (constantly "Thing (text object)")
+  :completion
+  (constantly
+   (lambda (sym)
+     (or
+      (assq sym (bound-and-true-p thing-at-point-provider-alist))
+      (assq sym (bound-and-true-p bounds-of-thing-at-point-provider-alist))
+      (get sym 'thing-at-point)
+      (get sym 'bounds-of-thing-at-point)
+      (get sym 'beginning-op)
+      (get sym 'end-op)))))
+
+(scope-define-symbol-type slot ()
+  :doc "EIEIO slots."
+  :face 'font-lock-builtin-face
+  :help (constantly "Slot"))
+
+(scope-define-symbol-type widget-type ()
+  :doc "Widget types."
+  :face 'font-lock-type-face
+  :help (constantly "Widget type")
+  :completion (constantly (lambda (sym) (get sym 'widget-type)))
+  :namespace 'widget-type)
+
+(scope-define-symbol-type type ()
+  :doc "ELisp object type names."
+  :face 'font-lock-type-face
+  :help (constantly "Type")
+  :completion (constantly (lambda (sym) (get sym 'cl--class))))
+
+(scope-define-symbol-type group ()
+  :doc "Customization groups."
+  :face 'font-lock-type-face
+  :help (constantly "Customization group")
+  :completion (constantly (lambda (sym) (get sym 'group-documentation))))
+
+(scope-define-symbol-type nnoo-backend ()
+  :doc "`nnoo' backend names."
+  :face 'font-lock-type-face
+  :help (constantly "`nnoo' backend"))
+
+(scope-define-symbol-type condition ()
+  :doc "`condition-case' conditions."
+  :face 'elisp-condition
+  :help (lambda (beg end _def)
+          (lambda (&rest _)
+            (let ((msg (get (intern (buffer-substring beg end)) 'error-message)))
+              (apply #'concat
+                     "`condition-case' condition"
+                     (when (and msg (not (string-empty-p msg)))
+                       `(": " ,msg))))))
+  :completion (constantly (lambda (sym) (get sym 'error-conditions)))
+  :namespace 'condition)
+
+(scope-define-symbol-type ampersand ()
+  :doc "Argument list markers, such as `&optional' and `&rest'."
+  :face 'font-lock-type-face
+  :help (constantly "Arguments separator"))
+
+(scope-define-symbol-type constant ()
+  :doc "Self-evaluating symbols."
+  :face 'font-lock-builtin-face
+  :help (constantly "Constant"))
+
+(scope-define-symbol-type defun ()
+  :doc "Function definitions."
+  :face 'font-lock-function-name-face
+  :help (constantly "Function definition")
+  :imenu "Function"
+  :namespace 'function)
+
+(scope-define-symbol-type defvar ()
+  :doc "Variable definitions."
+  :face 'font-lock-variable-name-face
+  :help (constantly "Special variable definition")
+  :imenu "Variable"
+  :namespace 'variable)
+
+(scope-define-symbol-type defface ()
+  :doc "Face definitions."
+  :face 'font-lock-variable-name-face
+  :help (constantly "Face definition")
+  :imenu "Face"
+  :namespace 'face)
+
+(scope-define-symbol-type major-mode ()
+  :doc "Major mode names."
+  :face 'elisp-major-mode-name
+  :help (lambda (beg end _def)
+          (if-let ((sym (intern (buffer-substring-no-properties beg end))))
+              (lambda (&rest _)
+                (if-let ((doc (documentation sym)))
+                    (format "Major mode `%S'.\n\n%s" sym doc)
+                  "Major mode"))
+            "Major mode"))
+  :completion (constantly (lambda (sym) (get sym 'major-mode-name)))
+  :namespace 'function)
+
+(scope-define-symbol-type block ()
+  :doc "`cl-block' block names."
+  :help (lambda (beg _end def)
+          (if (equal beg def) "Block definition" "Block")))
+
 (defvar scope-counter nil)
 
 (defvar scope-local-functions nil)
@@ -301,7 +596,7 @@ Optional argument LOCAL is a local context to extend."
     (let ((bare (bare-symbol arg))
           (beg (scope-sym-pos arg)))
       (cond
-       ((or (functionp bare) scope-assume-func-p)
+       ((or (functionp bare) (memq bare scope-local-functions) scope-assume-func-p)
         (when beg
           (scope-report 'function beg (length (symbol-name bare)))))
        ((or (assq bare scope-flet-alist) (consp arg))
@@ -1130,16 +1425,28 @@ a (possibly empty) list of safe macros.")
        (defun ,analyzer ,args ,@body)
        (put ',fsym 'scope-analyzer #',analyzer))))
 
-(defmacro scope-define-function-analyzer (fsym args &rest body)
+(defmacro scope--define-function-analyzer (fsym args type &rest body)
   (declare (indent defun))
   (let* ((helper (intern (concat "scope--analyze-" (symbol-name fsym) "-1"))))
     `(progn
        (defun ,helper ,args ,@body)
        (scope-define-analyzer ,fsym (l f &rest args)
-         (scope-report-s f 'function)
+         (scope-report-s f ',type)
          (apply #',helper args)
          (scope-n l args)))))
 
+(defmacro scope-define-function-analyzer (fsym args &rest body)
+  (declare (indent defun))
+  `(scope--define-function-analyzer ,fsym ,args function ,@body)
+  ;; (let* ((helper (intern (concat "scope--analyze-" (symbol-name fsym) "-1"))))
+  ;;   `(progn
+  ;;      (defun ,helper ,args ,@body)
+  ;;      (scope-define-analyzer ,fsym (l f &rest args)
+  ;;        (scope-report-s f 'function)
+  ;;        (apply #',helper args)
+  ;;        (scope-n l args))))
+  )
+
 (defmacro scope-define-macro-analyzer (fsym args &rest body)
   (declare (indent defun))
   (let* ((helper (intern (concat "scope--analyze-" (symbol-name fsym) "-1"))))
@@ -1235,16 +1542,26 @@ a (possibly empty) list of safe macros.")
 (scope-define-function-analyzer pulse-momentary-highlight-region (_start _end &optional face)
   (when-let ((q (scope--unqoute face))) (scope-face q)))
 
-(scope-define-function-analyzer throw (tag _value)
+(scope--define-function-analyzer throw (tag _value) non-local-exit
   (when-let ((q (scope--unqoute tag))) (scope-report-s q 'throw-tag)))
 
+(scope--define-function-analyzer signal (error-symbol &optional _data) non-local-exit
+  (when-let ((q (scope--unqoute error-symbol))) (scope-report-s q 'condition)))
+
+(scope--define-function-analyzer kill-emacs                     (&rest _) non-local-exit)
+(scope--define-function-analyzer abort-recursive-edit           (&rest _) non-local-exit)
+(scope--define-function-analyzer top-level                      (&rest _) non-local-exit)
+(scope--define-function-analyzer exit-recursive-edit            (&rest _) non-local-exit)
+(scope--define-function-analyzer tty-frame-restack              (&rest _) non-local-exit)
+(scope--define-function-analyzer error                          (&rest _) non-local-exit)
+(scope--define-function-analyzer user-error                     (&rest _) non-local-exit)
+(scope--define-function-analyzer minibuffer-quit-recursive-edit (&rest _) non-local-exit)
+(scope--define-function-analyzer exit-minibuffer                (&rest _) non-local-exit)
+
 (scope-define-function-analyzer run-hooks (&rest hooks)
   (dolist (hook hooks)
     (when-let ((q (scope--unqoute hook))) (scope-report-s q 'variable))))
 
-(scope-define-function-analyzer signal (error-symbol &optional _data)
-  (when-let ((q (scope--unqoute error-symbol))) (scope-report-s q 'condition)))
-
 (scope-define-function-analyzer fboundp (symbol)
   (when-let ((q (scope--unqoute symbol))) (scope-report-s q 'function)))
 
@@ -1335,6 +1652,12 @@ a (possibly empty) list of safe macros.")
 (scope-define-function-analyzer derived-mode-p (modes &rest _obsolete)
   (when-let ((q (scope--unqoute modes))) (scope-report-s q 'major-mode)))
 
+(scope-define-function-analyzer scope-report (type &rest _)
+  (when-let ((q (scope--unqoute type))) (scope-report-s q 'symbol-type)))
+
+(scope-define-function-analyzer scope-report-s (_sym type)
+  (when-let ((q (scope--unqoute type))) (scope-report-s q 'symbol-type)))
+
 (scope-define-macro-analyzer define-globalized-minor-mode (l global mode turn-on &rest body)
   (scope-report-s mode 'function)
   (scope-report-s turn-on 'function)
@@ -1466,6 +1789,20 @@ a (possibly empty) list of safe macros.")
 (put 'defmacro 'scope-analyzer #'scope--analyze-defun)
 (put 'ert-deftest 'scope-analyzer #'scope--analyze-defun)
 
+(scope-define-macro-analyzer scope-define-symbol-type (l &optional name parents &rest props)
+  (scope-report-s name 'symbol-type-definition)
+  (dolist (parent parents) (scope-report-s parent 'symbol-type))
+  (while-let ((kw (car-safe props))
+              (bkw (scope-sym-bare kw))
+              ((keywordp bkw)))
+    (scope-report-s kw 'constant)
+    (case bkw
+      (:face
+       (if-let ((q (scope--unqoute (cadr props)))) (scope-face-1 q)
+         (scope-1 l (cadr props))))
+      (otherwise (scope-1 l (cadr props))))
+    (setq props (cddr props))))
+
 (scope-define-macro-analyzer cl-letf (l bindings &rest body)
   (let ((l0 l))
     (dolist (binding bindings)
@@ -1618,11 +1955,9 @@ starting with a top-level form, by inspecting HEAD at each level:
 - If within the code under analysis HEAD is a `cl-flet'-bound local
   function name, analyze the form as a function call.
 
-- Otherwise, HEAD is unknown.  If the HEAD of the top-level form that
-  this function reads from STREAM is unknown, then this function ignores
-  it and returns nil.  If an unknown HEAD occurs in a nested form, then
-  by default it is similarly ignored, but if `scope-assume-func-p' is
-  non-nil, then this function assumes that such HEADs are functions."
+- If HEAD is unknown, then it is ignored, unless `scope-assume-func-p'
+  is non-nil, in which case this function assumes that unknown HEADs are
+  functions."
   (let ((scope-counter 0)
         (scope-callback callback)
         (read-symbol-shorthands nil))

diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index d063fb6cc43f6bc837d531b7fe4e6ea8d9957cb5..ff531403c6cda006d905d758d8fbef7bc22c8a29 100644 (file)
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -239,6 +239,11 @@ unloading."
     (put name 'error-conditions nil)
     (put name 'error-message nil)))
 
+(cl-defmethod loadhist-unload-element ((x (head define-symbol-type)))
+  (let ((name (cdr x)))
+    (put name 'scope-parent-types nil)
+    (put name 'scope-type-properties nil)))
+
 ;;;###autoload
 (defun unload-feature (feature &optional force)
   "Unload the library that provided FEATURE.

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 1b0f0f10263911477181d9717946c7500c2906f1..a9451fbda193ddc95594fa3938588f106aad84b8 100644 (file)
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -348,10 +348,22 @@ happens in interactive invocations."
   "Face for highlighting face names in Emacs Lisp code."
   :group 'lisp)
 
+(defface elisp-symbol-type '((t :foreground "#00008b" :inherit font-lock-function-call-face))
+  "Face for highlighting symbol type names in Emacs Lisp code."
+  :group 'lisp)
+
+(defface elisp-symbol-type-definition '((t :foreground "#00008b" :inherit font-lock-function-name-face))
+  "Face for highlighting symbol type names in Emacs Lisp code."
+  :group 'lisp)
+
 (defface elisp-function-call '((t :inherit font-lock-function-call-face))
   "Face for highlighting function calls in Emacs Lisp code."
   :group 'lisp)
 
+(defface elisp-non-local-exit '((t :inherit elisp-function-call :underline "red"))
+  "Face for highlighting function calls in Emacs Lisp code."
+  :group 'lisp)
+
 (defface elisp-macro-call '((t :inherit font-lock-keyword-face))
   "Face for highlighting macro calls in Emacs Lisp code."
   :group 'lisp)
@@ -437,82 +449,13 @@ happens in interactive invocations."
 (defun elisp--annotate-symbol-with-help-echo (type beg end def)
   (put-text-property
    beg end 'help-echo
-   (case type
-     (variable      (cond ((equal beg def) "Local variable definition")
-                          (def             "Local variable")
-                          (t (elisp--help-echo beg end 'variable-documentation "Special variable"))))
-     (block         (if (equal beg def) "Block definition" "Block"))
-     (face          (elisp--help-echo beg end 'face-documentation "Face"))
-     (function      (cond ((equal beg def) "Local function definition")
-                          (def             "Local function call")
-                          (t (if-let ((sym (intern-soft (buffer-substring-no-properties beg end))))
-                                 (apply-partially #'elisp--function-help-echo sym)
-                               "Function call"))))
-     (macro          (if-let ((sym (intern-soft (buffer-substring-no-properties beg end))))
-                         (apply-partially #'elisp--function-help-echo sym)
-                       "Macro call"))
-     (special-form  (if-let ((sym (intern-soft (buffer-substring-no-properties beg end))))
-                        (apply-partially #'elisp--function-help-echo sym)
-                      "Special form"))
-     (throw-tag     "`throw'/`catch' tag")
-     (warning-type  "Warning type")
-     (feature       "Feature")
-     (declaration   "Declaration")
-     (rx-construct  "`rx' construct")
-     (theme         "Theme")
-     (thing         "Thing (text object)")
-     (slot          "Slot")
-     (widget-type   "Widget type")
-     (type          "Type")
-     (group         "Customization group")
-     (condition     (lambda (&rest _)
-                      (let ((msg (get (intern (buffer-substring beg end)) 'error-message)))
-                        (apply #'concat
-                               "`condition-case' condition"
-                               (when (and msg (not (string-empty-p msg)))
-                                 `(": " ,msg))))))
-     (ampersand     "Arguments separator")
-     (constant      "Constant")
-     (defun         "Function definition")
-     (defvar        "Special variable definition")
-     (defface       "Face definition")
-     (nnoo-backend  "`nnoo' backend")
-     (major-mode    (if-let ((sym (intern (buffer-substring-no-properties beg end))))
-                        (lambda (&rest _)
-                          (if-let ((doc (documentation sym)))
-                              (format "Major mode `%S'.\n\n%s" sym doc)
-                            "Major mode"))
-                      "Major mode")))))
+   (when-let ((fun (scope-get-symbol-type-property type :help)))
+     (funcall fun beg end def))))
 
 (defun elisp-fontify-symbol (type sym len id &optional def)
   (elisp--annotate-symbol-with-help-echo type sym (+ sym len) def)
   (let ((face (cond
-               ((null id)
-                (case type
-                  (variable      'elisp-free-variable)
-                  (face          'elisp-face)
-                  (function      'elisp-function-call)
-                  (macro         'elisp-macro-call)
-                  (special-form  'elisp-special-form)
-                  (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)
-                  (thing         'font-lock-type-face)
-                  (slot          'font-lock-builtin-face)
-                  (widget-type   'font-lock-type-face)
-                  (type          'font-lock-type-face)
-                  (group         'font-lock-type-face)
-                  (nnoo-backend  'font-lock-type-face)
-                  (condition     'elisp-condition)
-                  (ampersand     'font-lock-type-face)
-                  (constant      'font-lock-builtin-face)
-                  (defun         'font-lock-function-name-face)
-                  (defvar        'font-lock-variable-name-face)
-                  (defface       'font-lock-variable-name-face)
-                  (major-mode    'elisp-major-mode-name)))
+               ((null id) (scope-get-symbol-type-property type :face))
                ((equal sym def) 'elisp-binding-variable)
                (t 'elisp-bound-variable))))
     (add-face-text-property sym (+ sym len) face t)
@@ -855,46 +798,11 @@ in `completion-at-point-functions' (which see)."
   (with-syntax-table emacs-lisp-mode-syntax-table
     (when-let ((pos (point))
                (scope-assume-func-p t)
-               (predicate (case (save-excursion
-                                  (goto-char pos)
-                                  (beginning-of-defun)
-                                  (catch 'sym-type
-                                    (scope (lambda (type beg len &rest _)
-                                             (when (<= beg pos (+ beg len))
-                                               (throw 'sym-type type))))
-                                    nil))
-                            ((variable constant) (let ((local-vars (elisp-local-variables)))
-                                                   (lambda (sym) (or (elisp--shorthand-aware-boundp sym)
-                                                                     (memq sym local-vars)))))
-                            ((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)))
-                            ((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)))
-                            ((condition) (lambda (sym) (get sym 'error-conditions)))
-                            ((face) #'facep)
-                            ((feature) #'featurep)
-                            ((theme) #'custom-theme-p)
-                            ((thing) (lambda (sym)
-                                       (or
-                                        (assq sym (bound-and-true-p thing-at-point-provider-alist))
-                                        (assq sym (bound-and-true-p bounds-of-thing-at-point-provider-alist))
-                                        (get sym 'thing-at-point)
-                                        (get sym 'bounds-of-thing-at-point)
-                                        (get sym 'beginning-op)
-                                        (get sym 'end-op))))
-                            ((nil) (lambda (sym)
-                                     (let ((sym (intern-soft (symbol-name sym))))
-                                       (or (boundp sym)
-                                           (fboundp sym)
-                                           (featurep sym)
-                                           (facep sym)
-                                           (symbol-plist sym)))))))
+               (predicate
+                (if-let ((fun (scope-get-symbol-type-property
+                               (elisp-symbol-type-at-pos pos) :completion)))
+                    (funcall fun)
+                  #'elisp-completion-at-point-default-predicate))
                (beg-end (bounds-of-thing-at-point 'symbol))
                (beg (car beg-end))
               (end (cdr beg-end)))
@@ -902,6 +810,20 @@ in `completion-at-point-functions' (which see)."
             :predicate predicate :exclusive 'no
             :sort-function #'elisp--sort-completions))))
 
+(defun elisp-symbol-type-at-pos (&optional pos)
+  (let ((pos (or pos (point))))
+    (save-excursion
+      (goto-char pos)
+      (beginning-of-defun)
+      (catch 'sym-type
+        (scope (lambda (type beg len &rest _)
+                 (when (<= beg pos (+ beg len))
+                   (throw 'sym-type type))))
+        nil))))
+
+(defun elisp-completion-at-point-default-predicate (sym)
+  (or (boundp sym) (fboundp sym) (featurep sym) (facep sym) (symbol-plist sym)))
+
 (defalias 'elisp-capf
   (completion-at-point-function-with-frecency-sorting
    #'elisp-completion-at-point))
@@ -1124,19 +1046,8 @@ confidence."
            (t 'maybe-variable))))))))
 
 (defun elisp--xref-infer-namespace-1 (pos)
-  (save-excursion
-    (beginning-of-defun-raw)
-    (case (catch 'sym-type
-            (scope (lambda (type beg len &rest _)
-                     (when (<= beg pos (+ beg len))
-                       (throw 'sym-type type))))
-            nil)
-      ((defface face) 'face)
-      ((feature) 'feature)
-      ((widget-type) 'widget-type)
-      ((condition) 'condition)
-      ((defvar variable constant) 'variable)
-      ((defun function macro special-form top-level major-mode) 'function))))
+  (scope-get-symbol-type-property
+   (elisp-symbol-type-at-pos pos) :namespace))
 
 (cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'elisp)))
   (let ((bounds (bounds-of-thing-at-point 'symbol)))
@@ -1203,7 +1114,8 @@ confidence."
                  (widget-type '(widget-type))
                  (condition '(condition))
                  (variable '(defvar variable constant))
-                 (function '(defun function macro special-form top-level major-mode)))))
+                 (symbol-type '(symbol-type symbol-type-definition))
+                 (function '(defun function macro special-form major-mode)))))
           (require 'project)
           (dolist-with-progress-reporter
               (file
@@ -1262,6 +1174,7 @@ confidence."
              ('face '(defface))
              ('feature '(feature))
              ('condition '(define-error))
+             ('symbol-type '(define-symbol-type))
              ('widget-type '(define-widget)))))
       (cl-loop for d in definitions
                when (memq
@@ -1314,6 +1227,10 @@ confidence."
         (when-let ((file (find-lisp-object-file-name symbol 'define-error)))
           (push (elisp--xref-make-xref 'define-error symbol file) xrefs)))
 
+      (when (scope-symbol-type-p symbol)
+        (when-let ((file (find-lisp-object-file-name symbol 'define-symbol-type)))
+          (push (elisp--xref-make-xref 'define-symbol-type symbol file) xrefs)))
+
       (when (fboundp symbol)
         (let ((file (find-lisp-object-file-name symbol (symbol-function symbol)))
               generic doc)
@@ -2650,7 +2567,8 @@ of TARGET."
        (beginning-of-defun-raw)
        (scope (lambda (type sbeg len _id &optional def)
                 (and (<= sbeg beg)
-                     (memq type '(function macro special-form top-level))
+                     ;; FIXME: use namespace info.
+                     (memq type '(function macro special-form))
                      (push (nth 1 (syntax-ppss sbeg)) targets))
                 (let ((send (+ sbeg len)))
                   (and (<= beg sbeg send end) def (< def beg)
@@ -2725,16 +2643,9 @@ of TARGET."
     (condition-case nil
         (while t
           (scope (lambda (type beg len &rest _)
-                   (case type
-                     ((defun)
-                      (push (cons (buffer-substring-no-properties beg (+ beg len)) beg)
-                            (alist-get "Function" index nil nil #'string=)))
-                     ((defvar)
-                      (push (cons (buffer-substring-no-properties beg (+ beg len)) beg)
-                            (alist-get "Var" index nil nil #'string=)))
-                     ((defface)
-                      (push (cons (buffer-substring-no-properties beg (+ beg len)) beg)
-                            (alist-get "Face" index nil nil #'string=)))))))
+                   (when-let ((group (scope-get-symbol-type-property type :imenu)))
+                     (push (cons (buffer-substring-no-properties beg (+ beg len)) beg)
+                           (alist-get group index nil nil #'string=))))))
       (end-of-file
        (dolist (group index) (setcdr group (nreverse (cdr group))))
        index))))