;;; elisp-scope.el --- Semantic analysis for ELisp symbols -*- lexical-binding: t; -*- ;; Copyright (C) 2025 Free Software Foundation, Inc. ;; Author: Eshel Yaron ;; Keywords: lisp, languages ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This library implements an analysis that determines the role of each ;; symbol in ELisp code. The entry point for the analysis is the ;; function `elisp-scope-analyze-form', see its docstring for usage ;; information. ;;; Code: (require 'cl-lib) (defun elisp-scope--define-symbol-role (name parents props) (put name 'elisp-scope-parent-roles parents) (put name 'elisp-scope-role-properties props)) (defmacro elisp-scope-define-symbol-role (name parents &rest props) "Define NAME as the name of a symbol role that inherits from PARENTS. A symbol role is a symbol that Emacs uses to describe the role of (other) symbols in ELisp source code. For example, the symbol role `face' characterizes symbols that are face names. PROPS is a plist specifying the properties of the new symbol role NAME. NAME inherits properties that do not appear in PROPS from its PARENTS." (declare (indent defun)) `(elisp-scope--define-symbol-role ',name ',parents ,(when props `(list ,@props)))) ;;;###autoload (defun elisp-scope-get-symbol-role-property (role prop) "Return value of property PROP for symbol role ROLE." (seq-some (lambda (c) (plist-get (get c 'elisp-scope-role-properties) prop)) (elisp-scope--all-reachable-symbol-roles role))) (defvar elisp-scope--all-reachable-symbol-roles-cache (make-hash-table)) (defun elisp-scope--all-reachable-symbol-roles (symbol-role) (with-memoization (gethash symbol-role elisp-scope--all-reachable-symbol-roles-cache) (cons symbol-role (let* ((parents (get symbol-role 'elisp-scope-parent-roles)) (aps (mapcar #'elisp-scope--all-reachable-symbol-roles parents))) (if (cdr aps) (merge-ordered-lists (nconc aps (list parents))) (car aps)))))) ;;;###autoload (defun elisp-scope-set-symbol-role-property (role prop value) "Set value of property PROP for symbol role ROLE to VALUE." (put role 'elisp-scope-role-properties (plist-put (get role 'elisp-scope-role-properties) prop value))) ;;;###autoload (defun elisp-scope-symbol-role-p (sym) (or (get sym 'elisp-scope-parent-roles) (get sym 'elisp-scope-role-properties))) (defvar elisp-scope-read-symbol-role-history nil) (defun elisp-scope-read-symbol-role (prompt &optional default) (completing-read (format-prompt prompt default) obarray #'elisp-scope-symbol-role-p 'confirm nil 'elisp-scope-read-symbol-role-history default)) (defvar describe-symbol-backends) ;;;###autoload (defun elisp-scope-add-symbol-roles-to-describe-symbol () (require 'help-mode) (setf (alist-get "symbol-role" describe-symbol-backends nil nil #'equal) `(,#'elisp-scope-symbol-role-p ,#'elisp-scope-describe-symbol-role))) ;;;###autoload (defun elisp-scope-describe-symbol-role (role &rest _) (interactive (list (elisp-scope-read-symbol-role "Describe symbol role" (when-let* ((def (symbol-at-point)) ((elisp-scope-symbol-role-p def))) def)))) (when (stringp role) (setq role (intern role))) (let ((help-buffer-under-preparation t)) (help-setup-xref (list #'elisp-scope-describe-symbol-role role) (called-interactively-p 'interactive)) (with-help-window (help-buffer) (with-current-buffer standard-output (insert "Symbol role " (substitute-quotes (concat "`" (symbol-name role) "'")) ":\n\n" (substitute-quotes (or (elisp-scope-get-symbol-role-property role :doc) "Undocumented."))) (when-let* ((parents (get role 'elisp-scope-parent-roles))) (insert "\n\nParent roles: " (mapconcat (lambda (parent) (let ((name (symbol-name parent))) (substitute-quotes (concat "`" (buttonize name #'elisp-scope-describe-symbol-role name "mouse-2, RET: describe this symbol role") "'")))) parents ", "))) ;; Return the text we displayed for `describe-symbol-backends'. (buffer-string))))) (elisp-scope-define-symbol-role symbol-role () :doc "Symbol role names." :definition 'symbol-role-definition :face 'elisp-symbol-role :help (cl-constantly "Symbol role") :namespace 'symbol-role) (elisp-scope-define-symbol-role symbol-role-definition (symbol-role) :doc "Symbol role name definitions." :face 'elisp-symbol-role-definition :help (cl-constantly "Symbol role definition") :imenu "Symbol Role" :namespace 'symbol-role) (elisp-scope-define-symbol-role variable () :doc "Abstract symbol role of variables." :namespace 'variable) (elisp-scope-define-symbol-role free-variable (variable) :doc "Variable names." :definition 'defvar :face 'elisp-free-variable :help (lambda (beg end _def) (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) (lambda (&rest _) (let ((val (if (boundp sym) (truncate-string-to-width (prin1-to-string (symbol-value sym)) 60 nil nil t) "#"))) (if-let* ((doc (documentation-property sym 'variable-documentation t))) (format "Special variable `%S'.\n\nValue: %s\n\n%s" sym val doc) (format "Special variable `%S'.\n\nValue: %s" sym val)))) "Special variable"))) (elisp-scope-define-symbol-role bound-variable (variable) :doc "Local variable names." :face 'elisp-bound-variable :help (cl-constantly "Local variable")) (elisp-scope-define-symbol-role binding-variable (bound-variable) :doc "Local variable definitions." :face 'elisp-binding-variable :help (cl-constantly "Local variable binding")) (elisp-scope-define-symbol-role shadowed-variable (variable) :doc "Locally shadowed variable names." :face 'elisp-shadowed-variable :help (cl-constantly "Locally shadowed variable")) (elisp-scope-define-symbol-role shadowing-variable (shadowed-variable) :doc "Local variable definitions." :face 'elisp-shadowing-variable :help (cl-constantly "Local variable shadowing")) (elisp-scope-define-symbol-role face () :doc "Face names." :definition 'defface :face 'elisp-face :help (lambda (beg end _def) (elisp--help-echo beg end 'face-documentation "Face")) :namespace 'face) (elisp-scope-define-symbol-role callable () :doc "Abstract symbol role of function-like symbols." :namespace 'function) (elisp-scope-define-symbol-role function (callable) :doc "Function names." :definition '(defun defcmd) :face 'elisp-function-reference :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"))))) (elisp-scope-define-symbol-role command (function) :doc "Command names.") (elisp-scope-define-symbol-role unknown (function) :doc "Unknown symbols at function position." :face 'elisp-unknown-call :help (cl-constantly "Unknown callable")) (elisp-scope-define-symbol-role 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"))) (elisp-scope-define-symbol-role macro (callable) :doc "Macro names." :definition 'defmacro :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"))) (elisp-scope-define-symbol-role 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"))) (elisp-scope-define-symbol-role throw-tag () :doc "Symbols used as `throw'/`catch' tags." :face 'elisp-throw-tag :help (cl-constantly "`throw'/`catch' tag")) (elisp-scope-define-symbol-role warning-type () :doc "Byte-compilation warning types." :face 'elisp-warning-type :help (cl-constantly "Warning type")) (elisp-scope-define-symbol-role feature () :doc "Feature names." :definition 'deffeature :face 'elisp-feature :help (cl-constantly "Feature") :namespace 'feature) (elisp-scope-define-symbol-role deffeature (feature) :doc "Feature definitions." :imenu "Feature" :help (cl-constantly "Feature definition")) (elisp-scope-define-symbol-role function-property-declaration () :doc "Function/macro property declaration types." :face 'elisp-function-property-declaration :help (cl-constantly "Function/macro property declaration")) (elisp-scope-define-symbol-role rx-construct () :doc "`rx' constructs." :face 'elisp-rx :help (cl-constantly "`rx' construct")) (elisp-scope-define-symbol-role theme () :doc "Custom theme names." :definition 'deftheme :face 'elisp-theme :help (cl-constantly "Theme")) (elisp-scope-define-symbol-role deftheme (theme) :doc "Custom theme definitions." :imenu "Theme" :help (cl-constantly "Theme definition")) (elisp-scope-define-symbol-role thing () :doc "`thing-at-point' \"thing\" identifiers." :face 'elisp-thing :help (cl-constantly "Thing (text object)")) (elisp-scope-define-symbol-role slot () :doc "EIEIO slots." :face 'elisp-slot :help (cl-constantly "Slot")) (elisp-scope-define-symbol-role widget-type () :doc "Widget types." :definition 'widget-type-definition :face 'elisp-widget-type :help (cl-constantly "Widget type") :namespace 'widget-type) (elisp-scope-define-symbol-role widget-type-definition (widget-type) :doc "Widget type definitions." :imenu "Widget" :help (cl-constantly "Widget type definition")) (elisp-scope-define-symbol-role type () :doc "ELisp object type names." :face 'elisp-type :help (cl-constantly "Type")) (elisp-scope-define-symbol-role deftype (type) :doc "ELisp object type definitions." :imenu "Type" :help (cl-constantly "Type definition")) (elisp-scope-define-symbol-role group () :doc "Customization groups." :definition 'defgroup :face 'elisp-group :help (cl-constantly "Customization group")) (elisp-scope-define-symbol-role defgroup (group) :doc "Customization group definitions." :imenu "Group" :help (cl-constantly "Customization group definition")) (elisp-scope-define-symbol-role nnoo-backend () :doc "`nnoo' backend names." :face 'elisp-nnoo-backend :help (cl-constantly "`nnoo' backend")) (elisp-scope-define-symbol-role condition () :doc "`condition-case' conditions." :definition 'defcondition :face 'elisp-condition :help (lambda (beg end _def) (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) (lambda (&rest _) (let ((msg (get sym 'error-message))) (apply #'concat "`condition-case' condition" (when (and msg (not (string-empty-p msg))) `(": " ,msg))))) "`condition-case' condition")) :namespace 'condition) (elisp-scope-define-symbol-role defcondition (condition) :doc "`condition-case' condition definitions." :definition 'defcondition :help (cl-constantly "`condition-case' condition definition")) (elisp-scope-define-symbol-role ampersand () :doc "Argument list markers, such as `&optional' and `&rest'." :face 'elisp-ampersand :help (cl-constantly "Arguments separator")) (elisp-scope-define-symbol-role constant () :doc "Self-evaluating symbols." :face 'elisp-constant :help (cl-constantly "Constant")) (elisp-scope-define-symbol-role defun () :doc "Function definitions." :definition 'defun :face 'elisp-defun :help (cl-constantly "Function definition") :imenu "Function" :namespace 'function) (elisp-scope-define-symbol-role defmacro () :doc "Macro definitions." :definition 'defmacro :face 'elisp-defmacro :help (cl-constantly "Macro definition") :imenu "Macro" :namespace 'function) (elisp-scope-define-symbol-role defcmd (defun) :doc "Command definitions." :definition 'defcmd :help (cl-constantly "Command definition") :imenu "Command") (elisp-scope-define-symbol-role defvar () :doc "Variable definitions." :definition 'defvar :face 'elisp-defvar :help (cl-constantly "Special variable definition") :imenu "Variable" :namespace 'variable) (elisp-scope-define-symbol-role special-variable-declaration () :doc "Special variable declarations." :definition 'defvar :face 'elisp-special-variable-declaration :help (cl-constantly "Special variable declaration") :namespace 'variable) (elisp-scope-define-symbol-role defface () :doc "Face definitions." :definition 'defface :face 'elisp-defface :help (cl-constantly "Face definition") :imenu "Face" :namespace 'face) (elisp-scope-define-symbol-role major-mode () :doc "Major mode names." :definition 'major-mode-definition :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")) :namespace 'function) (elisp-scope-define-symbol-role major-mode-definition (major-mode) :doc "Major mode definitions." :help (cl-constantly "Major mode definition") :imenu "Major Mode") (elisp-scope-define-symbol-role block () :doc "`cl-block' block names." :help (lambda (beg _end def) (if (equal beg def) "Block definition" "Block"))) (elisp-scope-define-symbol-role icon () :doc "Icon names." :definition 'deficon :face 'elisp-icon :help (cl-constantly "Icon") :namespace 'icon) (elisp-scope-define-symbol-role deficon () :doc "Icon definitions." :definition 'deficon :face 'elisp-deficon :help (cl-constantly "Icon definition") :imenu "Icon" :namespace 'icon) (elisp-scope-define-symbol-role oclosure () :doc "OClosure type names." :definition 'defoclosure :face 'elisp-oclosure :help (lambda (beg end _def) (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) (lambda (&rest _) (if-let* ((doc (oclosure--class-docstring (get sym 'cl--class)))) (format "OClosure type `%S'.\n\n%s" sym doc) "OClosure type")) "OClosure type")) :namespace 'oclosure) (elisp-scope-define-symbol-role defoclosure () :doc "OClosure type definitions." :definition 'defoclosure :face 'elisp-defoclosure :help (cl-constantly "OClosure type definition") :imenu "OClosure type" :namespace 'oclosure) (elisp-scope-define-symbol-role coding () :doc "Coding system names." :definition 'defcoding :face 'elisp-coding :help (lambda (beg end _def) (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) (lambda (&rest _) (if-let* ((doc (coding-system-doc-string sym))) (format "Coding system `%S'.\n\n%s" sym doc) "Coding system")) "Coding system")) :namespace 'coding) (elisp-scope-define-symbol-role defcoding () :doc "Coding system definitions." :definition 'defcoding :face 'elisp-defcoding :help (cl-constantly "Coding system definition") :imenu "Coding system" :namespace 'coding) (elisp-scope-define-symbol-role charset () :doc "Charset names." :definition 'defcharset :face 'elisp-charset :help (lambda (beg end _def) (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) (lambda (&rest _) (if-let* ((doc (charset-description sym))) (format "Charset `%S'.\n\n%s" sym doc) "Charset")) "Charset")) :namespace 'charset) (elisp-scope-define-symbol-role defcharset () :doc "Charset definitions." :definition 'defcharset :face 'elisp-defcharset :help (cl-constantly "Charset definition") :imenu "Charset" :namespace 'charset) (elisp-scope-define-symbol-role completion-category () :doc "Completion categories." :definition 'completion-category-definition :face 'elisp-completion-category :help (lambda (beg end _def) (if-let* ((sym (intern (buffer-substring-no-properties beg end)))) (lambda (&rest _) (if-let* ((doc (get sym 'completion-category-documentation))) (format "Completion category `%S'.\n\n%s" sym doc) "Completion category")) "Completion category")) :namespace 'completion-category) (elisp-scope-define-symbol-role completion-category-definition () :doc "Completion category definitions." :definition 'completion-category-definition :face 'elisp-completion-category-definition :help (cl-constantly "Completion category definition") :imenu "Completion category" :namespace 'completion-category) (defvar elisp-scope-counter nil) (defvar elisp-scope-local-bindings nil "Alist of locally bound variables. This is a list of cons cells (BOUND . BINDER), where BOUND is a symbol which has a local variable binding in the current context, and BINDER uniquely identifies the value that BOUND is bound to. Usually, BINDER is the buffer position in which BOUND is bound, such as a surrounding `let' or `lambda' form.") (defvar elisp-scope-output-spec nil "Output spec of the form currently analyzed, or nil if unknown. See `elisp-scope-1' for possible values.") (defvar elisp-scope-callback #'ignore) (defvar elisp-scope-current-let-alist-form nil) (defsubst elisp-scope-local-new (sym pos &optional local) "Return new local context with SYM bound at POS. Optional argument LOCAL is a local context to extend." (cons (cons sym (or pos (cons 'gen (incf elisp-scope-counter)))) local)) (defsubst elisp-scope-sym-pos (sym) (when (symbol-with-pos-p sym) (symbol-with-pos-pos sym))) (defsubst elisp-scope-sym-bare (sym) (cond ((symbolp sym) sym) ((symbol-with-pos-p sym) (bare-symbol sym)))) (defvar elisp-scope--quoted nil) (defsubst elisp-scope-report (role beg len &optional id def) (funcall elisp-scope-callback role beg len id (or def (and (numberp id) id)))) (defvar elisp-scope-special-variables nil) (defun elisp-scope-special-variable-p (sym) (or (memq sym elisp-scope-special-variables) (special-variable-p sym))) (defun elisp-scope-variable (sym beg len id) (elisp-scope-report (if id (if (elisp-scope-special-variable-p sym) 'shadowed-variable 'bound-variable) 'free-variable) beg len id)) (defun elisp-scope-binding (sym beg len) (elisp-scope-report (if (elisp-scope-special-variable-p sym) 'shadowing-variable 'binding-variable) beg len beg)) (defun elisp-scope-s (sym) (let* ((beg (elisp-scope-sym-pos sym)) (bare (elisp-scope-sym-bare sym)) (name (symbol-name bare)) (len (length name))) (when (and beg (not (booleanp bare))) (cond ((keywordp bare) (elisp-scope-report 'constant beg len)) ((and elisp-scope-current-let-alist-form (= (aref name 0) ?.)) (if (and (length> name 1) (= (aref name 1) ?.)) ;; Double dot escapes `let-alist'. (let* ((unescaped (intern (substring name 1)))) (elisp-scope-variable unescaped beg len (alist-get unescaped elisp-scope-local-bindings))) (elisp-scope-report 'bound-variable beg len (list 'let-alist (car elisp-scope-current-let-alist-form) bare) (cdr elisp-scope-current-let-alist-form)))) (t (elisp-scope-variable bare beg len (alist-get bare elisp-scope-local-bindings))))))) (defun elisp-scope-let-1 (local bindings body) (if bindings (let* ((binding (ensure-list (car bindings))) (sym (car binding)) (bare (elisp-scope-sym-bare sym)) (len (length (symbol-name bare))) (beg (elisp-scope-sym-pos sym))) (when beg (elisp-scope-binding bare beg len)) (elisp-scope-1 (cadr binding)) (elisp-scope-let-1 (if bare (elisp-scope-local-new bare beg local) local) (cdr bindings) body)) (let ((elisp-scope-local-bindings local)) (elisp-scope-n body elisp-scope-output-spec)))) (defun elisp-scope-let (bindings body) (elisp-scope-let-1 elisp-scope-local-bindings bindings body)) (defun elisp-scope-let* (bindings body) (if bindings (let* ((binding (ensure-list (car bindings))) (sym (car binding)) (bare (bare-symbol sym)) (len (length (symbol-name bare))) (beg (elisp-scope-sym-pos sym))) (when beg (elisp-scope-binding bare beg len)) (elisp-scope-1 (cadr binding)) (let ((elisp-scope-local-bindings (elisp-scope-local-new bare beg elisp-scope-local-bindings))) (elisp-scope-let* (cdr bindings) body))) (elisp-scope-n body elisp-scope-output-spec))) (defun elisp-scope-interactive (intr spec modes) (when (symbol-with-pos-p intr) (elisp-scope-report 'special-form (symbol-with-pos-pos intr) (length (symbol-name (elisp-scope-sym-bare intr))))) (elisp-scope-1 spec) (mapc #'elisp-scope-major-mode-name modes)) (defun elisp-scope-lambda (args body &optional outspec) (let ((l elisp-scope-local-bindings)) (when (listp args) (dolist (arg args) (when-let* ((bare (bare-symbol arg)) (beg (elisp-scope-sym-pos arg))) (unless (memq bare '(&optional &rest)) (setq l (elisp-scope-local-new bare beg l)))))) ;; Handle docstring. (cond ((and (consp (car body)) (or (symbol-with-pos-p (caar body)) (symbolp (caar body))) (eq (bare-symbol (caar body)) :documentation)) (elisp-scope-s (caar body)) (elisp-scope-1 (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) (elisp-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 (elisp-scope-sym-bare head))) (when (symbol-with-pos-p head) (elisp-scope-report 'function-property-declaration (symbol-with-pos-pos head) (length (symbol-name bare)))) (cl-case bare (completion (elisp-scope-sharpquote (cadr spec))) (interactive-only (when-let* ((bare (elisp-scope-sym-bare (cadr spec))) ((not (eq bare t)))) (elisp-scope-sharpquote (cadr spec)))) (obsolete (when-let* ((bare (elisp-scope-sym-bare (cadr spec)))) (elisp-scope-sharpquote (cadr spec)))) ((compiler-macro gv-expander gv-setter) ;; Use the extended lexical environment `l'. (let ((elisp-scope-local-bindings l)) (elisp-scope-sharpquote (cadr spec)))) (modes (mapc #'elisp-scope-major-mode-name (cdr spec))) (interactive-args (dolist (arg-form (cdr spec)) (when-let* ((arg (car-safe arg-form))) (let ((elisp-scope-local-bindings l)) (elisp-scope-s arg)) (when (consp (cdr arg-form)) (elisp-scope-1 (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))) (elisp-scope-interactive intr (cadar body) (cddar body)) (setq body (cdr body))) ;; Handle ARGS. (when (listp 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 (and beg (not (eq bare '_))) (if (memq bare '(&optional &rest)) (elisp-scope-report 'ampersand beg len) (elisp-scope-report 'binding-variable beg len beg))))))) ;; Handle BODY. (let ((elisp-scope-local-bindings l)) (elisp-scope-n body outspec)))) (defun elisp-scope-defun (name args body) (when-let* ((beg (elisp-scope-sym-pos name)) (bare (elisp-scope-sym-bare name))) (elisp-scope-report (let ((tmp body)) (when (stringp (car-safe tmp)) (pop tmp)) (when (eq 'declare (elisp-scope-sym-bare (car-safe (car-safe tmp)))) (pop tmp)) (if (eq 'interactive (elisp-scope-sym-bare (car-safe (car-safe tmp)))) 'defcmd 'defun)) beg (length (symbol-name bare)))) (elisp-scope-lambda args body)) (defun elisp-scope-setq (args) (elisp-scope-n args elisp-scope-output-spec)) (defvar elisp-scope-local-definitions nil) (defmacro elisp-scope-with-local-definition (sym def &rest body) (declare (indent 2) (debug t)) `(let ((elisp-scope-local-definitions (cons (cons ,sym ,def) elisp-scope-local-definitions))) ,@body)) (defun elisp-scope-flet (defs body outspec) (if defs (let* ((def (car defs)) (func (car def)) (exps (cdr def)) (beg (elisp-scope-sym-pos func)) (bare (bare-symbol func)) (len (length (symbol-name bare)))) (when beg ;; TODO: Use a bespoke 'local-function-definition' role. (elisp-scope-report 'function beg len beg)) (if (cdr exps) ;; def is (FUNC ARGLIST BODY...) (elisp-scope-cl-lambda (car exps) (cdr exps)) ;; def is (FUNC EXP) (elisp-scope-1 (car exps))) (let ((pos (or beg (cons 'gen (incf elisp-scope-counter))))) (elisp-scope-with-local-definition bare (elisp-scope--local-function-analyzer pos) (elisp-scope-flet (cdr defs) body outspec)))) (elisp-scope-n body outspec))) (defun elisp-scope--local-function-analyzer (pos) (lambda (f &rest args) (when (symbol-with-pos-p f) (elisp-scope-report 'function (symbol-with-pos-pos f) (length (symbol-name (bare-symbol f))) pos)) (elisp-scope-n args))) (defun elisp-scope-labels (defs forms outspec) (if defs (let* ((def (car defs)) (func (car def)) (args (cadr def)) (body (cddr def)) (beg (elisp-scope-sym-pos func)) (bare (bare-symbol func)) (len (length (symbol-name bare)))) (when beg (elisp-scope-report 'function beg len beg)) (let ((pos (or beg (cons 'gen (incf elisp-scope-counter))))) (elisp-scope-with-local-definition bare (elisp-scope--local-function-analyzer pos) (elisp-scope-lambda args body) (elisp-scope-flet (cdr defs) forms outspec)))) (elisp-scope-n forms outspec))) (defvar elisp-scope-block-alist nil) (defun elisp-scope-block (name body) (if name (let* ((beg (elisp-scope-sym-pos name)) (bare (bare-symbol name))) (when beg (elisp-scope-report 'block beg (length (symbol-name bare)) beg)) (let ((elisp-scope-block-alist (elisp-scope-local-new bare beg elisp-scope-block-alist))) (elisp-scope-n body))) (elisp-scope-n body))) (defun elisp-scope-return-from (name result) (when-let* ((bare (and (symbol-with-pos-p name) (bare-symbol name))) (pos (alist-get bare elisp-scope-block-alist))) (elisp-scope-report 'block (symbol-with-pos-pos name) (length (symbol-name bare)) pos)) (elisp-scope-1 result)) (defvar elisp-scope-assume-func nil) (defun elisp-scope-sharpquote (arg) (cond ((or (symbol-with-pos-p arg) (symbolp arg)) (let ((bare (bare-symbol arg))) (cond ((or (functionp bare) (assq bare elisp-scope-local-definitions) elisp-scope-assume-func) (elisp-scope-report-s arg 'function)) (t (elisp-scope-report-s arg 'unknown))))) ((consp arg) (elisp-scope-1 arg)))) (defun elisp-scope-loop-for-and (rest) (if (eq (elisp-scope-sym-bare (car rest)) 'and) (elisp-scope-loop-for elisp-scope-local-bindings (cadr rest) (cddr rest)) (elisp-scope-loop rest))) (defun elisp-scope-loop-for-by (local expr rest) (elisp-scope-1 expr) (let ((elisp-scope-local-bindings local)) (elisp-scope-loop-for-and rest))) (defun elisp-scope-loop-for-to (local expr rest) (elisp-scope-1 expr) (when-let* ((bare (elisp-scope-sym-bare (car rest))) (more (cdr rest))) (cond ((eq bare 'by) (elisp-scope-loop-for-by local (car more) (cdr more))) (t (let ((elisp-scope-local-bindings local)) (elisp-scope-loop-for-and rest)))))) (defun elisp-scope-loop-for-from (local expr rest) (elisp-scope-1 expr) (when-let* ((bare (elisp-scope-sym-bare (car rest))) (more (cdr rest))) (cond ((memq bare '(to upto downto below above)) (elisp-scope-loop-for-to local (car more) (cdr more))) ((eq bare 'by) (elisp-scope-loop-for-by local (car more) (cdr more))) (t (let ((elisp-scope-local-bindings local)) (elisp-scope-loop-for-and rest)))))) (defun elisp-scope-loop-for-= (local expr rest) (elisp-scope-1 expr) (when-let* ((bare (elisp-scope-sym-bare (car rest))) (more (cdr rest))) (cond ((eq bare 'then) (elisp-scope-loop-for-by local (car more) (cdr more))) (t (let ((elisp-scope-local-bindings local)) (elisp-scope-loop-for-and rest)))))) (defun elisp-scope-loop-for-being-the-hash-keys-of-using (form rest) (let* ((var (cadr form)) (bare (elisp-scope-sym-bare var)) (beg (elisp-scope-sym-pos var))) (when beg (elisp-scope-binding bare beg (length (symbol-name bare)))) (let ((elisp-scope-local-bindings (elisp-scope-local-new bare beg elisp-scope-local-bindings))) (elisp-scope-loop-for-and rest)))) (defun elisp-scope-loop-for-being-the-hash-keys-of (local expr rest) (elisp-scope-1 expr) (when-let* ((bare (elisp-scope-sym-bare (car rest))) (more (cdr rest))) (let ((elisp-scope-local-bindings local)) (cond ((eq bare 'using) (elisp-scope-loop-for-being-the-hash-keys-of-using (car more) (cdr more))) (t (elisp-scope-loop-for-and rest)))))) (defun elisp-scope-loop-for-being-the-hash-keys (local word rest) (when-let* ((bare (elisp-scope-sym-bare word))) (cond ((eq bare 'of) (elisp-scope-loop-for-being-the-hash-keys-of local (car rest) (cdr rest)))))) (defun elisp-scope-loop-for-being-the (local word rest) (when-let* ((bare (elisp-scope-sym-bare word))) (cond ((memq bare '(buffer buffers)) (let ((elisp-scope-local-bindings local)) (elisp-scope-loop-for-and rest))) ((memq bare '( hash-key hash-keys hash-value hash-values key-code key-codes key-binding key-bindings)) (elisp-scope-loop-for-being-the-hash-keys local (car rest) (cdr rest)))))) (defun elisp-scope-loop-for-being (local next rest) (elisp-scope-loop-for-being-the local (car rest) (if (memq (elisp-scope-sym-bare next) '(the each)) (cdr rest) rest))) (defun elisp-scope-loop-for (local vars rest) (if vars ;; FIXME: var need not be a symbol, see ;; `cl-macs-loop-destructure-cons' test in cl-macs-tests.el. (let* ((var (car (ensure-list vars))) (bare (bare-symbol var)) (beg (elisp-scope-sym-pos var))) (when beg (elisp-scope-binding bare beg (length (symbol-name bare)))) (elisp-scope-loop-for (elisp-scope-local-new bare beg local) (cdr-safe vars) rest)) (when-let* ((bare (elisp-scope-sym-bare (car rest))) (more (cdr rest))) (cond ((memq bare '(from upfrom downfrom)) (elisp-scope-loop-for-from local (car more) (cdr more))) ((memq bare '( to upto downto below above in on in-ref)) (elisp-scope-loop-for-to local (car more) (cdr more))) ((memq bare '(by across across-ref)) (elisp-scope-loop-for-by local (car more) (cdr more))) ((eq bare '=) (elisp-scope-loop-for-= local (car more) (cdr more))) ((eq bare 'being) (elisp-scope-loop-for-being local (car more) (cdr more))))))) (defun elisp-scope-loop-repeat (form rest) (elisp-scope-1 form) (elisp-scope-loop rest)) (defvar elisp-scope-loop-into-vars nil) (defun elisp-scope-loop-collect (expr rest) (elisp-scope-1 expr) (let ((bw (elisp-scope-sym-bare (car rest))) (more (cdr rest))) (if (eq bw 'into) (let* ((var (car more)) (bare (elisp-scope-sym-bare var)) (beg (elisp-scope-sym-pos var))) (if (memq bare elisp-scope-loop-into-vars) (progn (elisp-scope-s var) (elisp-scope-loop (cdr more))) (when beg (elisp-scope-binding bare beg (length (symbol-name bare)))) (let ((elisp-scope-loop-into-vars (cons bare elisp-scope-loop-into-vars)) (elisp-scope-local-bindings (elisp-scope-local-new bare beg elisp-scope-local-bindings))) (elisp-scope-loop (cdr more))))) (elisp-scope-loop rest)))) (defun elisp-scope-loop-with-and (rest) (if (eq (elisp-scope-sym-bare (car rest)) 'and) (elisp-scope-loop-with (cadr rest) (cddr rest)) (elisp-scope-loop rest))) (defun elisp-scope-loop-with (var rest) (let* ((bare (elisp-scope-sym-bare var)) (beg (symbol-with-pos-pos var)) (l (elisp-scope-local-new bare beg elisp-scope-local-bindings)) (eql (car rest))) (when beg (elisp-scope-binding bare beg (length (symbol-name bare)))) (if (eq (elisp-scope-sym-bare eql) '=) (let* ((val (cadr rest)) (more (cddr rest))) (elisp-scope-1 val) (let ((elisp-scope-local-bindings l)) (elisp-scope-loop-with-and more))) (let ((elisp-scope-local-bindings l)) (elisp-scope-loop-with-and rest))))) (defun elisp-scope-loop-do (form rest) (elisp-scope-1 form) (if (consp (car rest)) (elisp-scope-loop-do (car rest) (cdr rest)) (elisp-scope-loop rest))) (defun elisp-scope-loop-named (name rest) (let* ((beg (elisp-scope-sym-pos name)) (bare (elisp-scope-sym-bare name))) (when beg (elisp-scope-report 'block beg (length (symbol-name bare)) beg)) (let ((elisp-scope-block-alist (elisp-scope-local-new bare beg elisp-scope-block-alist))) (elisp-scope-loop rest)))) (defun elisp-scope-loop-finally (next rest) (if-let* ((bare (elisp-scope-sym-bare next))) (cond ((eq bare 'do) (elisp-scope-loop-do (car rest) (cdr rest))) ((eq bare 'return) (elisp-scope-1 (car rest)) (elisp-scope-loop (cdr rest)))) (if (eq (elisp-scope-sym-bare (car-safe next)) 'return) (progn (elisp-scope-1 (cadr next)) (elisp-scope-loop (cdr rest))) (elisp-scope-loop-do next rest)))) (defun elisp-scope-loop-initially (next rest) (if (eq (elisp-scope-sym-bare next) 'do) (elisp-scope-loop-do (car rest) (cdr rest)) (elisp-scope-loop-do next rest))) (defvar elisp-scope-loop-if-depth 0) (defun elisp-scope-loop-if (keyword condition rest) (elisp-scope-1 condition) (let ((elisp-scope-loop-if-depth (1+ elisp-scope-loop-if-depth)) (elisp-scope-local-bindings ;; `if' binds `it'. (elisp-scope-local-new 'it (elisp-scope-sym-pos keyword) elisp-scope-local-bindings))) (elisp-scope-loop rest))) (defun elisp-scope-loop-end (rest) (let ((elisp-scope-loop-if-depth (1- elisp-scope-loop-if-depth))) (unless (minusp elisp-scope-loop-if-depth) (elisp-scope-loop rest)))) (defun elisp-scope-loop-and (rest) (when (plusp elisp-scope-loop-if-depth) (elisp-scope-loop rest))) (defun elisp-scope-loop (forms) (when forms (let* ((kw (car forms)) (bare (elisp-scope-sym-bare kw)) (rest (cdr forms))) (cond ((memq bare '(for as)) (elisp-scope-loop-for elisp-scope-local-bindings (car rest) (cdr rest))) ((memq bare '( repeat while until always never thereis iter-by return)) (elisp-scope-loop-repeat (car rest) (cdr rest))) ((memq bare '(collect append nconc concat vconcat count sum maximize minimize)) (elisp-scope-loop-collect (car rest) (cdr rest))) ((memq bare '(with)) (elisp-scope-loop-with (car rest) (cdr rest))) ((memq bare '(do)) (elisp-scope-loop-do (car rest) (cdr rest))) ((memq bare '(named)) (elisp-scope-loop-named (car rest) (cdr rest))) ((memq bare '(finally)) (elisp-scope-loop-finally (car rest) (cdr rest))) ((memq bare '(initially)) (elisp-scope-loop-initially (car rest) (cdr rest))) ((memq bare '(if when unless)) (elisp-scope-loop-if kw (car rest) (cdr rest))) ((memq bare '(end)) (elisp-scope-loop-end rest)) ((memq bare '(and else)) (elisp-scope-loop-and rest)))))) (defun elisp-scope-named-let (name bindings body &optional outspec) (let ((bare (elisp-scope-sym-bare name)) (beg (elisp-scope-sym-pos name))) (when beg (elisp-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 (elisp-scope-binding bare beg (length (symbol-name bare)))) (elisp-scope-1 (cadr binding)))) (let ((l elisp-scope-local-bindings)) (dolist (binding bindings) (when-let* ((sym (car (ensure-list binding))) (bare (elisp-scope-sym-bare sym))) (setq l (elisp-scope-local-new bare (elisp-scope-sym-pos sym) l)))) (let ((pos (or beg (cons 'gen (incf elisp-scope-counter))))) (elisp-scope-with-local-definition bare (elisp-scope--local-function-analyzer pos) (let ((elisp-scope-local-bindings l)) (elisp-scope-n body outspec))))))) (defun elisp-scope-rx (regexps) (dolist (regexp regexps) (elisp-scope-rx-1 regexp))) (defvar elisp-scope-rx-alist nil) (defun elisp-scope-rx-1 (regexp) (if (consp regexp) (let* ((head (car regexp)) (bare (elisp-scope-sym-bare head))) (when (and bare (symbol-with-pos-p head)) (elisp-scope-report 'rx-construct (symbol-with-pos-pos head) (length (symbol-name bare)) (alist-get bare elisp-scope-rx-alist))) (cond ((memq bare '(literal regex regexp eval)) (elisp-scope-1 (cadr regexp))) ((memq bare '( seq sequence and : or | zero-or-more 0+ * *? one-or-more 1+ + +? zero-or-one optional opt \? \?? = >= ** repeat minimal-match maximal-match group submatch group-n submatch-n)) (elisp-scope-rx (cdr regexp))))) (when-let* (((symbol-with-pos-p regexp)) (bare (elisp-scope-sym-bare regexp))) (elisp-scope-report 'rx-construct (symbol-with-pos-pos regexp) (length (symbol-name bare)) (alist-get bare elisp-scope-rx-alist))))) (defun elisp-scope-rx-define (name rest) (when-let* ((bare (elisp-scope-sym-bare name))) (elisp-scope-report 'rx-construct (symbol-with-pos-pos name) (length (symbol-name bare)) nil)) (if (not (cdr rest)) (elisp-scope-rx-1 (car rest)) (let ((l elisp-scope-rx-alist) (args (car rest)) (rx (cadr rest))) (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 _)) (elisp-scope-report 'ampersand beg len) (elisp-scope-report 'rx-construct beg len beg)))))) (dolist (arg args) (when-let* ((bare (bare-symbol arg)) (beg (elisp-scope-sym-pos arg))) (unless (memq bare '(&optional &rest)) (setq l (elisp-scope-local-new bare beg l))))) (let ((elisp-scope-rx-alist l)) (elisp-scope-rx-1 rx))))) (defun elisp-scope-rx-let (bindings body) (if-let* ((binding (car bindings))) (let ((name (car binding)) (rest (cdr binding))) (when-let* ((bare (elisp-scope-sym-bare name)) (beg (symbol-with-pos-pos name))) (elisp-scope-report 'rx-construct beg (length (symbol-name bare)) beg)) (if (cdr rest) (let ((l elisp-scope-rx-alist) (args (car rest)) (rx (cadr rest))) (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 _)) (elisp-scope-report 'ampersand beg len) (elisp-scope-report 'rx-construct beg len beg)))))) (dolist (arg args) (when-let* ((bare (bare-symbol arg)) (beg (elisp-scope-sym-pos arg))) (unless (memq bare '(&optional &rest)) (setq l (elisp-scope-local-new bare beg l))))) (let ((elisp-scope-rx-alist l)) (elisp-scope-rx-1 rx)) (let ((elisp-scope-rx-alist (elisp-scope-local-new (elisp-scope-sym-bare name) (elisp-scope-sym-pos name) elisp-scope-rx-alist))) (elisp-scope-rx-let (cdr bindings) body))) (elisp-scope-rx-1 (car rest)) (let ((elisp-scope-rx-alist (elisp-scope-local-new (elisp-scope-sym-bare name) (elisp-scope-sym-pos name) elisp-scope-rx-alist))) (elisp-scope-rx-let (cdr bindings) body)))) (elisp-scope-n body))) (defun elisp-scope-gv-define-expander (name handler) (when-let* ((beg (elisp-scope-sym-pos name)) (bare (elisp-scope-sym-bare name))) (elisp-scope-report 'defun beg (length (symbol-name bare)))) (elisp-scope-1 handler)) (defun elisp-scope-gv-define-simple-setter (name setter rest) (when-let* ((beg (elisp-scope-sym-pos name)) (bare (elisp-scope-sym-bare name))) (elisp-scope-report 'defun beg (length (symbol-name bare)))) (when-let* ((beg (elisp-scope-sym-pos setter)) (bare (elisp-scope-sym-bare setter))) (elisp-scope-report 'function beg (length (symbol-name bare)))) (elisp-scope-n rest)) (defun elisp-scope-face (face) (if (or (elisp-scope-sym-bare face) (keywordp (elisp-scope-sym-bare (car-safe face)))) (elisp-scope-face-1 face) (mapc #'elisp-scope-face-1 face))) (defun elisp-scope-face-1 (face) (cond ((symbol-with-pos-p face) (when-let* ((beg (elisp-scope-sym-pos face)) (bare (elisp-scope-sym-bare face))) (elisp-scope-report 'face beg (length (symbol-name bare))))) ((keywordp (elisp-scope-sym-bare (car-safe face))) (let ((l face)) (while l (let ((kw (car l)) (vl (cadr l))) (setq l (cddr l)) (when-let* ((bare (elisp-scope-sym-bare kw)) ((keywordp bare))) (when-let* ((beg (elisp-scope-sym-pos kw)) (len (length (symbol-name bare)))) (elisp-scope-report 'constant beg len)) (when (eq bare :inherit) (when-let* ((beg (elisp-scope-sym-pos vl)) (fbare (elisp-scope-sym-bare vl))) (elisp-scope-report 'face beg (length (symbol-name fbare)))))))))))) (defun elisp-scope-deftype (name args body) (when-let* ((beg (elisp-scope-sym-pos name)) (bare (elisp-scope-sym-bare name))) (elisp-scope-report 'deftype beg (length (symbol-name bare)))) (elisp-scope-lambda args body)) (defun elisp-scope-widget-type (form) (when-let* (((memq (elisp-scope-sym-bare (car-safe form)) '(quote \`))) (type (cadr form))) (elisp-scope-widget-type-1 type))) (defun elisp-scope-widget-type-1 (type) (cond ((symbol-with-pos-p type) (when-let* ((beg (elisp-scope-sym-pos type)) (bare (elisp-scope-sym-bare type))) (elisp-scope-report 'widget-type (symbol-with-pos-pos type) (length (symbol-name (bare-symbol type)))))) ((consp type) (let ((head (car type))) (when-let* ((beg (elisp-scope-sym-pos head)) (bare (elisp-scope-sym-bare head))) (elisp-scope-report 'widget-type beg (length (symbol-name bare)))) (when-let* ((bare (elisp-scope-sym-bare head))) (elisp-scope-widget-type-arguments bare (cdr type))))))) (defun elisp-scope-widget-type-keyword-arguments (head kw args) (when-let* ((beg (elisp-scope-sym-pos kw)) (len (length (symbol-name (bare-symbol kw))))) (elisp-scope-report 'constant beg len)) (cond ((and (memq head '(plist alist)) (memq kw '(:key-type :value-type))) (elisp-scope-widget-type-1 (car args))) ((memq kw '(:action :match :match-inline :validate)) (when-let* ((fun (car args)) (beg (elisp-scope-sym-pos fun)) (bare (elisp-scope-sym-bare fun))) (elisp-scope-report 'function beg (length (symbol-name bare))))) ((memq kw '(:args)) (mapc #'elisp-scope-widget-type-1 (car args)))) ;; TODO: (restricted-sexp :match-alternatives CRITERIA) (elisp-scope-widget-type-arguments head (cdr args))) (defun elisp-scope-widget-type-arguments (head args) (let* ((arg (car args)) (bare (elisp-scope-sym-bare arg))) (if (keywordp bare) (elisp-scope-widget-type-keyword-arguments head bare (cdr args)) (elisp-scope-widget-type-arguments-1 head args)))) (defun elisp-scope-widget-type-arguments-1 (head args) (cl-case head ((list cons group vector choice radio set repeat checklist) (mapc #'elisp-scope-widget-type-1 args)) ((function-item) (when-let* ((fun (car args)) (beg (elisp-scope-sym-pos fun)) (bare (elisp-scope-sym-bare fun))) (elisp-scope-report 'function beg (length (symbol-name bare))))) ((variable-item) (when-let* ((var (car args)) (beg (elisp-scope-sym-pos var)) (bare (elisp-scope-sym-bare var))) (elisp-scope-report 'free-variable beg (length (symbol-name bare))))))) (defun elisp-scope-quoted-group (sym-form) (when-let* (((eq (elisp-scope-sym-bare (car-safe sym-form)) 'quote)) (sym (cadr sym-form)) (beg (elisp-scope-sym-pos sym)) (bare (elisp-scope-sym-bare sym))) (elisp-scope-report 'group beg (length (symbol-name bare))))) (defun elisp-scope-defmethod-1 (local args body) (if args (let ((arg (car args)) (bare nil)) (cond ((consp arg) (let* ((var (car arg)) (spec (cadr arg))) (cond ((setq bare (elisp-scope-sym-bare var)) (when-let* ((beg (elisp-scope-sym-pos var)) (len (length (symbol-name bare)))) (elisp-scope-binding bare beg len)) (cond ((consp spec) (let ((head (car spec)) (form (cadr spec))) (and (eq 'eql (elisp-scope-sym-bare head)) (not (or (symbolp form) (symbol-with-pos-p form))) (elisp-scope-1 form)))) ((symbol-with-pos-p spec) (when-let* ((beg (symbol-with-pos-pos spec)) (bare (bare-symbol spec)) (len (length (symbol-name bare)))) (elisp-scope-report 'type beg len)))) (elisp-scope-defmethod-1 (elisp-scope-local-new bare (elisp-scope-sym-pos var) local) (cdr args) body))))) ((setq bare (elisp-scope-sym-bare arg)) (cond ((memq bare '(&optional &rest &body _)) (when-let* ((beg (elisp-scope-sym-pos arg))) (elisp-scope-report 'ampersand beg (length (symbol-name bare)))) (elisp-scope-defmethod-1 local (cdr args) body)) ((eq bare '&context) (let* ((expr-type (cadr args)) (expr (car expr-type)) (spec (cadr expr-type)) (more (cddr args))) (when-let* ((beg (elisp-scope-sym-pos arg))) (elisp-scope-report 'ampersand beg (length (symbol-name bare)))) (elisp-scope-1 expr) (cond ((consp spec) (let ((head (car spec)) (form (cadr spec))) (and (eq 'eql (elisp-scope-sym-bare head)) (not (or (symbolp form) (symbol-with-pos-p form))) (elisp-scope-1 form)))) ((symbol-with-pos-p spec) (when-let* ((beg (symbol-with-pos-pos spec)) (bare (bare-symbol spec)) (len (length (symbol-name bare)))) (elisp-scope-report 'type beg len beg)))) (elisp-scope-defmethod-1 local more body))) (t (when-let* ((beg (elisp-scope-sym-pos arg)) (len (length (symbol-name bare)))) (elisp-scope-binding bare beg len)) (elisp-scope-defmethod-1 (elisp-scope-local-new bare (elisp-scope-sym-pos arg) local) (cdr args) body)))))) (let ((elisp-scope-local-bindings local)) (elisp-scope-n body)))) ;; (defun elisp-scope-defmethod (local name rest) ;; (when (and (symbol-with-pos-p (car rest)) ;; (eq (bare-symbol (car rest)) :extra)) ;; (setq rest (cddr rest))) ;; (when (and (symbol-with-pos-p (car rest)) ;; (memq (bare-symbol (car rest)) '(:before :after :around))) ;; (setq rest (cdr rest))) ;; (elisp-scope-defmethod-1 local local name (car rest) ;; (if (stringp (cadr rest)) (cddr rest) (cdr rest)))) (defun elisp-scope-defmethod (name rest) (when-let* ((beg (elisp-scope-sym-pos name)) (bare (elisp-scope-sym-bare name))) (elisp-scope-report 'defun beg (length (symbol-name bare)))) ;; [EXTRA] (when (eq (elisp-scope-sym-bare (car rest)) :extra) (elisp-scope-s (car rest)) (setq rest (cddr rest))) ;; [QUALIFIER] (when (keywordp (elisp-scope-sym-bare (car rest))) (elisp-scope-s (car rest)) (setq rest (cdr rest))) ;; ARGUMENTS (elisp-scope-defmethod-1 elisp-scope-local-bindings (car rest) (cdr rest))) (defun elisp-scope-cl-defun (name arglist body) (let ((beg (elisp-scope-sym-pos name)) (bare (elisp-scope-sym-bare name))) (when beg (elisp-scope-report 'defun beg (length (symbol-name bare)))) (let ((elisp-scope-block-alist (elisp-scope-local-new bare beg elisp-scope-block-alist))) (elisp-scope-cl-lambda arglist body)))) (defun elisp-scope-cl-lambda (arglist body) (elisp-scope-cl-lambda-1 arglist nil body)) (defun elisp-scope-cl-lambda-1 (arglist more body) (cond (arglist (if (consp arglist) (let ((head (car arglist))) (if (consp head) (elisp-scope-cl-lambda-1 head (cons (cdr arglist) more) body) (let ((bare (elisp-scope-sym-bare head))) (if (memq bare '(&optional &rest &body &key &aux &whole &cl-defs &cl-quote)) (progn (when-let* ((beg (elisp-scope-sym-pos head))) (elisp-scope-report 'ampersand beg (length (symbol-name bare)))) (cl-case bare (&optional (elisp-scope-cl-lambda-optional (cadr arglist) (cddr arglist) more body)) (&cl-defs (elisp-scope-cl-lambda-defs (cadr arglist) (cddr arglist) more body)) ((&rest &body) (elisp-scope-cl-lambda-rest (cadr arglist) (cddr arglist) more body)) (&key (elisp-scope-cl-lambda-key (cadr arglist) (cddr arglist) more body)) (&aux (elisp-scope-cl-lambda-aux (cadr arglist) (cddr arglist) more body)) (&whole (elisp-scope-cl-lambda-1 (cdr arglist) more body)))) (when-let* ((beg (elisp-scope-sym-pos head))) (elisp-scope-binding bare beg (length (symbol-name bare)))) (let ((elisp-scope-local-bindings (elisp-scope-local-new bare (elisp-scope-sym-pos head) elisp-scope-local-bindings))) (elisp-scope-cl-lambda-1 (cdr arglist) more body)))))) (elisp-scope-cl-lambda-1 (list '&rest arglist) more body))) (more (elisp-scope-cl-lambda-1 (car more) (cdr more) body)) (t (elisp-scope-lambda nil body)))) (defun elisp-scope-cl-lambda-defs (arg arglist more body) (when (consp arg) (let ((def (car arg)) (defs (cdr arg))) (elisp-scope-1 def) (dolist (d defs) (elisp-scope-n (cdr-safe d))))) (elisp-scope-cl-lambda-1 arglist more body)) (defun elisp-scope-cl-lambda-optional (arg arglist more body) (let* ((a (ensure-list arg)) (var (car a)) (l elisp-scope-local-bindings) (init (cadr a)) (svar (caddr a))) (elisp-scope-1 init) (if (consp var) (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-1 var (cons (append (when svar (list svar)) (cons '&optional arglist)) more) body)) (when-let* ((bare (elisp-scope-sym-bare svar))) (when-let* ((beg (elisp-scope-sym-pos svar))) (elisp-scope-binding bare beg (length (symbol-name bare)))) (setq l (elisp-scope-local-new bare (elisp-scope-sym-pos svar) l))) (when-let* ((bare (elisp-scope-sym-bare var))) (when-let* ((beg (elisp-scope-sym-pos var))) (elisp-scope-binding bare beg (length (symbol-name bare)))) (setq l (elisp-scope-local-new bare (elisp-scope-sym-pos var) l))) (cond (arglist (let ((head (car arglist))) (if-let* ((bare (elisp-scope-sym-bare head)) ((memq bare '(&rest &body &key &aux)))) (progn (when-let* ((beg (elisp-scope-sym-pos head))) (elisp-scope-report 'ampersand beg (length (symbol-name bare)))) (cl-case bare ((&rest &body) (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-rest (cadr arglist) (cddr arglist) more body))) (&key (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-key (cadr arglist) (cddr arglist) more body))) (&aux (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-aux (cadr arglist) (cddr arglist) more body))))) (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-optional head (cdr arglist) more body))))) (more (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-1 (car more) (cdr more) body))) (t (let ((elisp-scope-local-bindings l)) (elisp-scope-lambda nil body))))))) (defun elisp-scope-cl-lambda-rest (var arglist more body) (let* ((l elisp-scope-local-bindings)) (if (consp var) (elisp-scope-cl-lambda-1 var (cons arglist more) body) (when-let* ((bare (elisp-scope-sym-bare var))) (when-let* ((beg (elisp-scope-sym-pos var))) (elisp-scope-binding bare beg (length (symbol-name bare)))) (setq l (elisp-scope-local-new bare (elisp-scope-sym-pos var) l))) (cond (arglist (let ((head (car arglist))) (if-let* ((bare (elisp-scope-sym-bare head)) ((memq bare '(&key &aux)))) (progn (when-let* ((beg (elisp-scope-sym-pos head))) (elisp-scope-report 'ampersand beg (length (symbol-name bare)))) (cl-case bare (&key (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-key (cadr arglist) (cddr arglist) more body))) (&aux (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-aux (cadr arglist) (cddr arglist) more body))))) (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-1 (car more) (cdr more) body))))) (more (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-1 (car more) (cdr more) body))) (t (let ((elisp-scope-local-bindings l)) (elisp-scope-lambda nil body))))))) (defun elisp-scope-cl-lambda-key (arg arglist more body) (let* ((a (ensure-list arg)) (var (car a)) (l elisp-scope-local-bindings) (init (cadr a)) (svar (caddr a)) (kw (car-safe var))) (elisp-scope-1 init) (and kw (or (symbolp kw) (symbol-with-pos-p kw)) (cadr var) (not (cddr var)) ;; VAR is (KEYWORD VAR) (setq var (cadr var))) (when-let* ((bare (elisp-scope-sym-bare kw)) ((keywordp bare))) (when-let* ((beg (elisp-scope-sym-pos kw))) (elisp-scope-report 'constant beg (length (symbol-name bare)))) (setq l (elisp-scope-local-new bare (elisp-scope-sym-pos svar) l))) (if (consp var) (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-1 var (cons (append (when svar (list svar)) (cons '&key arglist)) more) body)) (when-let* ((bare (elisp-scope-sym-bare svar))) (when-let* ((beg (elisp-scope-sym-pos svar))) (elisp-scope-binding bare beg (length (symbol-name bare)))) (setq l (elisp-scope-local-new bare (elisp-scope-sym-pos svar) l))) (when-let* ((bare (elisp-scope-sym-bare var))) (when-let* ((beg (elisp-scope-sym-pos var))) (elisp-scope-binding bare beg (length (symbol-name bare)))) (setq l (elisp-scope-local-new bare (elisp-scope-sym-pos var) l))) (cond (arglist (let ((head (car arglist))) (if-let* ((bare (elisp-scope-sym-bare head)) ((memq bare '(&aux &allow-other-keys)))) (progn (when-let* ((beg (elisp-scope-sym-pos head))) (elisp-scope-report 'ampersand beg (length (symbol-name bare)))) (cl-case bare (&aux (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-aux (cadr arglist) (cddr arglist) more body))) (&allow-other-keys (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-1 (car more) (cdr more) body))))) (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-key head (cdr arglist) more body))))) (more (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-1 (car more) (cdr more) body))) (t (let ((elisp-scope-local-bindings l)) (elisp-scope-lambda nil body))))))) (defun elisp-scope-cl-lambda-aux (arg arglist more body) (let* ((a (ensure-list arg)) (var (car a)) (l elisp-scope-local-bindings) (init (cadr a))) (elisp-scope-1 init) (if (consp var) (let ((elisp-scope-local-bindings l)) (elisp-scope-cl-lambda-1 var (cons arglist more) body)) (when-let* ((bare (elisp-scope-sym-bare var))) (when-let* ((beg (elisp-scope-sym-pos var))) (elisp-scope-binding bare beg (length (symbol-name bare)))) (setq l (elisp-scope-local-new bare (elisp-scope-sym-pos var) l))) (let ((elisp-scope-local-bindings l)) (cond (arglist (elisp-scope-cl-lambda-aux (car arglist) (cdr arglist) more body)) (more (elisp-scope-cl-lambda-1 (car more) (cdr more) body)) (t (elisp-scope-lambda nil body))))))) (defun elisp-scope-cl-macrolet (bindings body outspec) (if-let* ((b (car bindings))) (let ((name (car b)) (arglist (cadr b)) (mbody (cddr b))) (elisp-scope-cl-lambda arglist mbody) (when-let* ((bare (elisp-scope-sym-bare name)) (len (length (symbol-name bare)))) (let ((beg (elisp-scope-sym-pos name))) ;; TODO: Use a bespoke 'local-macro-definition' role. (when beg (elisp-scope-report 'macro beg len beg)) (let ((pos (or beg (cons 'gen (incf elisp-scope-counter))))) (elisp-scope-with-local-definition bare (lambda (f &rest _) (when (symbol-with-pos-p f) (elisp-scope-report 'macro (symbol-with-pos-pos f) len pos))) (elisp-scope-cl-macrolet (cdr bindings) body outspec)))))) (elisp-scope-n body outspec))) (defun elisp-scope-define-minor-mode (mode _doc body) (let ((explicit-var nil) (command t)) (while-let ((kw (car-safe body)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (when-let* ((beg (elisp-scope-sym-pos kw))) (elisp-scope-report 'constant beg (length (symbol-name bkw)))) (cl-case bkw ((:init-value :keymap :after-hook :initialize) (elisp-scope-1 (cadr body))) (:lighter (elisp-scope-mode-line-construct (cadr body))) ((:interactive) (let ((val (cadr body))) (when (consp val) (mapc #'elisp-scope-major-mode-name val)) (setq command 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 (elisp-scope-1 (car place)) (elisp-scope-sharpquote tail)) (elisp-scope-1 place))) (setq explicit-var t)) ((:group) (elisp-scope-quoted-group (cadr body))) ((:predicate) ;For globalized minor modes. (elisp-scope-global-minor-mode-predicate (cadr body))) ((:on :off) (let ((obod (cdr body))) (while (and obod (not (keywordp (elisp-scope-sym-bare (car obod))))) (elisp-scope-1 (pop obod))) (setq body (cons bkw (cons nil obod)))))) (setq body (cddr body))) (when-let* ((bare (elisp-scope-sym-bare mode)) (beg (elisp-scope-sym-pos mode)) (typ (if command 'defcmd 'defun))) (elisp-scope-report typ beg (length (symbol-name bare))) (unless explicit-var (elisp-scope-report 'defvar beg (length (symbol-name bare))))) (elisp-scope-n body))) (defun elisp-scope-global-minor-mode-predicate (pred) (if (consp pred) (if (eq 'not (elisp-scope-sym-bare (car pred))) (mapc #'elisp-scope-global-minor-mode-predicate (cdr pred)) (mapc #'elisp-scope-global-minor-mode-predicate pred)) (elisp-scope-major-mode-name pred))) (defun elisp-scope-major-mode-name (mode) (when-let* ((beg (elisp-scope-sym-pos mode)) (bare (bare-symbol mode)) ((not (booleanp bare))) (len (length (symbol-name bare)))) (elisp-scope-report 'major-mode beg len))) (defun elisp-scope-mode-line-construct (format) (elisp-scope-mode-line-construct-1 format)) (defun elisp-scope-mode-line-construct-1 (format) (cond ((symbol-with-pos-p format) (elisp-scope-report 'free-variable (symbol-with-pos-pos format) (length (symbol-name (bare-symbol format))))) ((consp format) (let ((head (car format))) (cond ((or (stringp head) (consp head) (integerp head)) (mapc #'elisp-scope-mode-line-construct-1 format)) ((or (symbolp head) (symbol-with-pos-p head)) (elisp-scope-s head) (cl-case (bare-symbol head) (:eval (elisp-scope-1 (cadr format))) (:propertize (elisp-scope-mode-line-construct-1 (cadr format)) (when-let* ((props (cdr format)) (symbols-with-pos-enabled t) (val-form (plist-get props 'face))) (elisp-scope-face-1 val-form))) (otherwise (elisp-scope-mode-line-construct-1 (cadr format)) (elisp-scope-mode-line-construct-1 (caddr format)))))))))) (defcustom elisp-scope-safe-macros nil "Specify which macros are safe to expand during code analysis. If this is t, macros are considered safe by default. Otherwise, this is a (possibly empty) list of safe macros. Note that this option only affects analysis of untrusted code, for trusted code macro expansion is always safe." :type '(choice (const :tag "Trust all macros" t) (repeat :tag "Trust these macros" symbol)) :group 'lisp) (defvar elisp-scope-unsafe-macros '( static-if static-when static-unless cl-eval-when eval-when-compile eval-and-compile let-when-compile rx cl-macrolet nnoo-define-basics)) (defun elisp-scope-safe-macro-p (macro) "Check whether it is safe to expand MACRO, return non-nil iff so. If MACRO is one of the macros in `elisp-scope-unsafe-macros', then it is never considered safe. Otherwise, MACRO is safe if it specified in `elisp-scope-safe-macros', or if it has a non-nil `safe-macro' symbol property, or if the current buffer is trusted (see `trusted-content-p')." (and (not (memq macro elisp-scope-unsafe-macros)) (or (eq elisp-scope-safe-macros t) (memq macro elisp-scope-safe-macros) (get macro 'safe-macro) (trusted-content-p)))) (defvar warning-minimum-log-level) (defmacro elisp-scope-define-analyzer (fsym args &rest body) (declare (indent defun)) (let ((analyzer (intern (concat "elisp-scope--analyze-" (symbol-name fsym))))) `(progn (defun ,analyzer ,args ,@body) (put ',fsym 'elisp-scope-analyzer #',analyzer)))) (defmacro elisp-scope--define-function-analyzer (fsym args role &rest body) (declare (indent defun)) (let ((helper (intern (concat "elisp-scope--analyze-" (symbol-name fsym) "-1")))) `(progn (defun ,helper ,args ,@body) (elisp-scope-define-analyzer ,fsym (f &rest args) (elisp-scope-report-s f ',role) (apply #',helper args))))) (defmacro elisp-scope-define-function-analyzer (fsym args &rest body) (declare (indent defun)) `(elisp-scope--define-function-analyzer ,fsym ,args function ,@body)) (defmacro elisp-scope-define-macro-analyzer (fsym args &rest body) (declare (indent defun)) (let ((helper (intern (concat "elisp-scope--analyze-" (symbol-name fsym) "-1")))) `(progn (defun ,helper ,args ,@body) (elisp-scope-define-analyzer ,fsym (f &rest args) (elisp-scope-report-s f 'macro) (apply #',helper args))))) (defmacro elisp-scope-define-special-form-analyzer (fsym args &rest body) (declare (indent defun)) (let ((helper (intern (concat "elisp-scope--analyze-" (symbol-name fsym) "-1")))) `(progn (defun ,helper ,args ,@body) (elisp-scope-define-analyzer ,fsym (f &rest args) (elisp-scope-report-s f 'special-form) (apply #',helper args))))) (defun elisp-scope--unquote (form) (when (memq (elisp-scope-sym-bare (car-safe form)) '(quote function \`)) (cadr form))) (elisp-scope-define-analyzer with-suppressed-warnings (f warnings &rest body) (elisp-scope-report-s f 'macro) (dolist (warning warnings) (when-let* ((wsym (car-safe warning))) (elisp-scope-report-s wsym 'warning-type))) (elisp-scope-n body)) (elisp-scope-define-analyzer eval (f form &optional lexical) (elisp-scope-report-s f 'function) ;; TODO: Use elisp-scope-1 with outspec `code' in the next line. ;; Difficulty: that would analyze the quoted code as if it is ;; evaluated in an unrelated local environment, so local variables ;; wouldn't be recognized correctly etc. We can solve that by adding ;; some `code-evaled-here' outspec. (elisp-scope-1 (or (elisp-scope--unquote form) form)) (elisp-scope-1 lexical)) (elisp-scope-define-function-analyzer funcall (&optional f &rest args) (elisp-scope-1 f '(symbol . function)) (elisp-scope-n args)) (put 'apply 'elisp-scope-analyzer #'elisp-scope--analyze-funcall) (elisp-scope-define-function-analyzer defalias (&optional sym def docstring) (elisp-scope-1 sym '(symbol . defun)) (elisp-scope-1 def '(symbol . defun)) (elisp-scope-1 docstring)) (elisp-scope-define-function-analyzer oclosure--define (&optional name docstring parent-names slots &rest props) (elisp-scope-1 name '(symbol . defoclosure)) (elisp-scope-1 docstring) (elisp-scope-1 parent-names '(repeat . (symbol . oclosure))) (elisp-scope-1 slots '(repeat . (or (symbol . slot) (cons (symbol . slot) . (plist (:type . cl-type)))))) (while-let ((kw (car-safe props)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (elisp-scope-1 (cadr props) (when (eq bkw :predicate) '(symbol . defun))) (setq props (cddr props))) (when props (elisp-scope-n props))) (elisp-scope-define-function-analyzer define-charset (&optional name docstring &rest props) (elisp-scope-1 name '(symbol . defcharset)) (elisp-scope-1 docstring) (elisp-scope-n props)) (elisp-scope-define-function-analyzer define-charset-alias (&optional alias charset) (elisp-scope-1 alias '(symbol . defcharset)) (elisp-scope-1 charset '(symbol . charset))) (elisp-scope-define-function-analyzer charset-chars (&optional charset &rest rest) (elisp-scope-1 charset '(symbol . charset)) (elisp-scope-n rest)) (dolist (sym '(charset-description charset-info charset-iso-final-char charset-long-name charset-plist charset-short-name get-charset-property put-charset-property list-charset-chars set-charset-plist set-charset-priority unify-charset locale-charset-to-coding-system)) (put sym 'elisp-scope-analyzer #'elisp-scope--analyze-charset-chars)) (elisp-scope-define-function-analyzer define-coding-system (&optional name &rest rest) (elisp-scope-1 name '(symbol . defcoding)) (mapc #'elisp-scope-1 rest)) (elisp-scope-define-function-analyzer define-coding-system-alias (&optional alias coding-system) (elisp-scope-1 alias '(symbol . defcoding)) (elisp-scope-1 coding-system '(symbol . coding))) (elisp-scope-define-function-analyzer decode-coding-region (&optional start end coding-system &rest rest) (elisp-scope-1 start) (elisp-scope-1 end) (elisp-scope-1 coding-system '(symbol . coding)) (elisp-scope-n rest)) (put 'encode-coding-region 'elisp-scope-analyzer #'elisp-scope--analyze-decode-coding-region) (elisp-scope-define-function-analyzer decode-coding-string (&optional string coding-system &rest rest) (elisp-scope-1 string) (elisp-scope-1 coding-system '(symbol . coding)) (elisp-scope-n rest)) (dolist (sym '(encode-coding-char encode-coding-string)) (put sym 'elisp-scope-analyzer #'elisp-scope--analyze-decode-coding-string)) (elisp-scope-define-function-analyzer coding-system-mnemonic (&optional coding-system &rest rest) (elisp-scope-1 coding-system '(symbol . coding)) (elisp-scope-n rest)) (dolist (sym '(add-to-coding-system-list check-coding-system coding-system-aliases coding-system-base coding-system-category coding-system-change-eol-conversion coding-system-change-text-conversion coding-system-charset-list coding-system-doc-string coding-system-eol-type coding-system-eol-type-mnemonic coding-system-get coding-system-plist coding-system-post-read-conversion coding-system-pre-write-conversion coding-system-put coding-system-translation-table-for-decode coding-system-translation-table-for-encode coding-system-type describe-coding-system prefer-coding-system print-coding-system print-coding-system-briefly revert-buffer-with-coding-system set-buffer-file-coding-system set-clipboard-coding-system set-coding-system-priority set-default-coding-systems set-file-name-coding-system set-keyboard-coding-system set-next-selection-coding-system set-selection-coding-system set-terminal-coding-system universal-coding-system-argument)) (put sym 'elisp-scope-analyzer #'elisp-scope--analyze-coding-system-mnemonic)) (elisp-scope-define-function-analyzer thing-at-point (&optional thing no-props) (elisp-scope-1 thing '(symbol . thing)) (elisp-scope-1 no-props)) (dolist (sym '( forward-thing beginning-of-thing end-of-thing bounds-of-thing-at-point)) (put sym 'elisp-scope-analyzer #'elisp-scope--analyze-thing-at-point)) (elisp-scope-define-function-analyzer bounds-of-thing-at-mouse (&optional event thing) (elisp-scope-1 event) (elisp-scope-1 thing '(symbol . thing))) (elisp-scope-define-function-analyzer thing-at-mouse (&optional event thing no-props) (elisp-scope-1 event) (elisp-scope-1 thing '(symbol . thing)) (elisp-scope-1 no-props)) (elisp-scope-define-function-analyzer custom-declare-variable (sym default doc &rest args) (elisp-scope-1 sym '(symbol . defvar)) (elisp-scope-1 default) (elisp-scope-1 doc) (while-let ((kw (car-safe args)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (cl-case bkw (:type ;; TODO: Use `elisp-scope-1' with an appropriate outspec. (if-let* ((quoted (elisp-scope--unquote (cadr args)))) (elisp-scope-widget-type-1 quoted) (elisp-scope-1 (cadr args)))) (:group (elisp-scope-1 (cadr args) '(symbol . group))) (otherwise (elisp-scope-1 (cadr args)))) (setq args (cddr args))) (when args (elisp-scope-n args))) (elisp-scope-define-function-analyzer custom-declare-group (sym members doc &rest args) (elisp-scope-1 sym '(symbol . defgroup)) (elisp-scope-1 members) (elisp-scope-1 doc '(symbol . defgroup)) (while-let ((kw (car-safe args)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (elisp-scope-1 (cadr args) (when (eq bkw :group) '(symbol . group))) (setq args (cddr args))) (when args (elisp-scope-n args))) (elisp-scope-define-function-analyzer custom-declare-face (face spec doc &rest args) (elisp-scope-1 face '(symbol . defface)) ;; TODO: Use `elisp-scope-1' with an appropriate outspec. (if-let* ((q (elisp-scope--unquote spec))) (when (consp q) (dolist (s q) (elisp-scope-face (cdr s)))) (elisp-scope-1 spec)) (elisp-scope-1 doc) (while-let ((kw (car-safe args)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (elisp-scope-1 (cadr args) (when (eq bkw :group) '(symbol . group))) (setq args (cddr args))) (when args (elisp-scope-n args))) (elisp-scope-define-function-analyzer cl-typep (val type) (elisp-scope-1 val) (elisp-scope-1 type 'cl-type)) (elisp-scope-define-function-analyzer pulse-momentary-highlight-region (start end &optional face) (elisp-scope-1 start) (elisp-scope-1 end) (elisp-scope-1 face '(symbol . face))) (elisp-scope--define-function-analyzer throw (&optional tag val) non-local-exit (elisp-scope-1 tag '(symbol . throw-tag)) (elisp-scope-1 val)) (elisp-scope--define-function-analyzer signal (&optional error-symbol data) non-local-exit (elisp-scope-1 error-symbol '(symbol . condition)) (elisp-scope-1 data)) (elisp-scope--define-function-analyzer kill-emacs (&rest rest) non-local-exit (elisp-scope-n rest)) (dolist (sym '( abort-recursive-edit top-level exit-recursive-edit tty-frame-restack error user-error minibuffer-quit-recursive-edit exit-minibuffer)) (put sym 'elisp-scope-analyzer #'elisp-scope--analyze-kill-emacs)) (elisp-scope-define-function-analyzer run-hooks (&rest hooks) (dolist (hook hooks) (elisp-scope-1 hook '(symbol . free-variable)))) (elisp-scope-define-function-analyzer fboundp (&optional symbol) (elisp-scope-1 symbol '(symbol . function))) (elisp-scope-define-function-analyzer overlay-put (&optional ov prop val) (elisp-scope-1 ov) (elisp-scope-1 prop) ;TODO: Recognize overlay props. (if-let* ((q (elisp-scope--unquote prop)) ((eq (elisp-scope-sym-bare q) 'face)) (face (elisp-scope--unquote val))) ;; TODO: Use `elisp-scope-1' with an appropriate outspec. (elisp-scope-face face) (elisp-scope-1 val))) (elisp-scope-define-function-analyzer add-face-text-property (&optional start end face &rest rest) (elisp-scope-1 start) (elisp-scope-1 end) (elisp-scope-1 face '(symbol . face)) (elisp-scope-n rest)) (elisp-scope-define-function-analyzer facep (&optional face &rest rest) (elisp-scope-1 face '(symbol . face)) (elisp-scope-n rest)) (dolist (sym '( check-face face-id face-differs-from-default-p face-name face-all-attributes face-attribute face-foreground face-background face-stipple face-underline-p face-inverse-video-p face-bold-p face-italic-p face-extend-p face-documentation set-face-documentation set-face-attribute set-face-font set-face-background set-face-foreground set-face-stipple set-face-underline set-face-inverse-video set-face-bold set-face-italic set-face-extend)) (put sym 'elisp-scope-analyzer #'elisp-scope--analyze-facep)) (elisp-scope-define-function-analyzer boundp (&optional var &rest rest) (elisp-scope-1 var '(symbol . free-variable)) (elisp-scope-n rest)) (dolist (sym '( set symbol-value define-abbrev-table special-variable-p local-variable-p local-variable-if-set-p add-variable-watcher get-variable-watchers remove-variable-watcher default-value set-default make-local-variable buffer-local-value add-to-list add-to-history find-buffer customize-set-variable set-variable add-hook remove-hook run-hook-with-args run-hook-wrapped)) (put sym 'elisp-scope-analyzer #'elisp-scope--analyze-boundp)) (elisp-scope-define-function-analyzer defvaralias (new base &optional docstring) (elisp-scope-1 new '(symbol . defvar)) (elisp-scope-1 base '(symbol . free-variable)) (elisp-scope-1 docstring)) (elisp-scope-define-function-analyzer define-error (&optional name message parent) (elisp-scope-1 name '(symbol . defcondition)) (elisp-scope-1 message) (elisp-scope-1 parent '(or (symbol . condition) (repeat . (symbol . condition))))) (elisp-scope-define-function-analyzer featurep (feature &rest rest) (elisp-scope-1 feature '(symbol . feature)) (elisp-scope-n rest)) (put 'require 'elisp-scope-analyzer #'elisp-scope--analyze-featurep) (elisp-scope-define-function-analyzer provide (feature &rest rest) (elisp-scope-1 feature '(symbol . deffeature)) (elisp-scope-n rest)) (elisp-scope-define-function-analyzer put-text-property (&optional beg end prop val obj) (elisp-scope-1 beg) (elisp-scope-1 end) (elisp-scope-1 prop) (if-let* (((memq (elisp-scope-sym-bare (elisp-scope--unquote prop)) '(mouse-face face))) (q (elisp-scope--unquote val))) ;; TODO: Use `elisp-scope-1' with an appropriate outspec. (elisp-scope-face q) (elisp-scope-1 val)) (elisp-scope-1 obj)) (put 'remove-overlays 'elisp-scope-analyzer #'elisp-scope--analyze-put-text-property) (elisp-scope-define-function-analyzer propertize (string &rest props) (elisp-scope-1 string) (while props (elisp-scope-1 (car props)) (cl-case (elisp-scope-sym-bare (elisp-scope--unquote (car props))) ((face mouse-face) (if-let* ((q (elisp-scope--unquote (cadr props)))) ;; TODO: Use `elisp-scope-1' with an appropriate outspec. (elisp-scope-face q) (elisp-scope-1 (cadr props)))) (otherwise (elisp-scope-1 (cadr props)))) (setq props (cddr props))) (when props (elisp-scope-n props))) (elisp-scope-define-function-analyzer eieio-defclass-internal (&optional name superclasses slots options) (elisp-scope-1 name '(symbol . deftype)) (elisp-scope-1 superclasses '(repeat . (symbol . type))) (elisp-scope-1 slots '(repeat cons (symbol . slot) plist (:initform . code) (:initarg . (symbol . constant)) (:accessor . (symbol . defun)) (:allocation . code) (:writer . (symbol . function)) (:reader . (symbol . function)) (:type . cl-type) ;; TODO: add (:custom . custom-type) )) (elisp-scope-1 options)) (elisp-scope-define-function-analyzer cl-struct-define (&optional name doc parent type named slots children tag print) (elisp-scope-1 name '(symbol . deftype)) (elisp-scope-1 doc) (elisp-scope-1 parent '(symbol . type)) (elisp-scope-1 type) (elisp-scope-1 named) (elisp-scope-1 slots) ;TODO: Specify type of `slots'. (elisp-scope-1 children) (elisp-scope-1 tag) (elisp-scope-1 print)) (elisp-scope-define-function-analyzer define-widget (name class doc &rest args) (elisp-scope-1 name '(symbol . widget-type-definition)) (elisp-scope-1 class '(symbol . widget-type)) (elisp-scope-1 doc) (while-let ((kw (car-safe args)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (cl-case bkw (:type ;; TODO: Use `elisp-scope-1' with an appropriate outtype. (if-let* ((quoted (elisp-scope--unquote (cadr args)))) (elisp-scope-widget-type-1 quoted) (elisp-scope-1 (cadr args)))) (:args (if-let* ((quoted (elisp-scope--unquote (cadr args)))) (mapc #'elisp-scope-widget-type-1 quoted) (elisp-scope-1 (cadr args)))) (otherwise (elisp-scope-1 (cadr args)))) (setq args (cddr args))) (when args (elisp-scope-n args))) (elisp-scope-define-function-analyzer provide-theme (name &rest rest) (elisp-scope-1 name '(symbol . theme)) (elisp-scope-n rest)) (dolist (sym '(enable-theme disable-theme load-theme custom-theme-p)) (put sym 'elisp-scope-analyzer #'elisp-scope--analyze-provide-theme)) (elisp-scope-define-function-analyzer custom-theme-set-variables (theme &rest args) (elisp-scope-1 theme '(symbol . theme)) (dolist (arg args) (elisp-scope-1 arg '(cons (symbol . free-variable) . (cons code . (or (cons t . (cons (repeat . (symbol . feature)) . t)) t)))))) (elisp-scope-define-function-analyzer custom-declare-theme (name &rest rest) (elisp-scope-1 name '(symbol . deftheme)) (elisp-scope-n rest)) (elisp-scope-define-function-analyzer eieio-oref (obj slot) (elisp-scope-1 obj) (elisp-scope-1 slot '(symbol . slot))) (dolist (fun '(slot-boundp slot-makeunbound slot-exists-p eieio-oref-default)) (put fun 'elisp-scope-analyzer #'elisp-scope--analyze-eieio-oref)) (elisp-scope-define-function-analyzer eieio-oset (obj slot value) (elisp-scope-1 obj) (elisp-scope-1 slot '(symbol . slot)) (elisp-scope-1 value)) (put 'eieio-oset-default 'elisp-scope-analyzer #'elisp-scope--analyze-eieio-oset) (elisp-scope-define-function-analyzer derived-mode-p (modes &rest rest) (elisp-scope-1 modes '(or (repeat . (symbol . major-mode)) (symbol . major-mode))) (dolist (mode rest) (elisp-scope-1 mode '(symbol . major-mode)))) (elisp-scope-define-function-analyzer derived-mode-set-parent (&optional mode parent) (elisp-scope-1 mode '(symbol . major-mode)) (elisp-scope-1 parent '(symbol . major-mode))) (elisp-scope-define-function-analyzer elisp-scope-report (role &rest args) (elisp-scope-1 role '(symbol . symbol-role)) (mapc #'elisp-scope-1 args)) (elisp-scope-define-function-analyzer elisp-scope-report-s (&optional sym role) (elisp-scope-1 sym) (elisp-scope-1 role '(symbol . symbol-role))) (elisp-scope-define-function-analyzer elisp-scope-1 (&optional form outspec) (elisp-scope-1 form) (elisp-scope-1 outspec 'spec)) (elisp-scope-define-function-analyzer icons--register (&optional name parent spec doc kws) (elisp-scope-1 name '(symbol . deficon)) (elisp-scope-1 parent '(symbol . icon)) (elisp-scope-1 spec) ;TODO: Specify spec of `spec'. (elisp-scope-1 doc) (if-let* ((q (elisp-scope--unquote kws))) (progn (while-let ((kw (car-safe q)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (elisp-scope-1 (cadr q) (when (eq bkw :group) '(symbol . group))) (setq q (cddr q))) (when q (elisp-scope-n q))) (elisp-scope-1 kws))) (elisp-scope-define-function-analyzer setopt--set (&optional var val) (elisp-scope-1 var '(symbol . free-variable)) (elisp-scope-1 val elisp-scope-output-spec)) (elisp-scope-define-function-analyzer autoload (&optional func file doc int type) (elisp-scope-1 func '(symbol . function)) (elisp-scope-1 file) (elisp-scope-1 doc) (elisp-scope-1 int '(repeat . (symbol . major-mode))) (elisp-scope-1 type)) (elisp-scope-define-function-analyzer define-completion-category (&optional name parents &rest rest) (elisp-scope-1 name '(symbol . completion-category-definition)) (elisp-scope-1 parents '(repeat . (symbol . completion-category))) (elisp-scope-n rest)) (elisp-scope-define-function-analyzer completion-table-with-category (&optional category table) (elisp-scope-1 category '(symbol . completion-category)) (elisp-scope-1 table)) (defun elisp-scope--easy-menu-do-define-menu (menu) (let ((items (cdr menu))) (while-let ((kw (car-safe items)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (cl-case bkw ((:active :label :visible) (elisp-scope-1 (cadr items))) ((:filter) (elisp-scope-sharpquote (cadr items)))) (setq items (cddr items))) (dolist (item items) (cond ((vectorp item) (when (length> item 2) (elisp-scope-sharpquote (aref item 1)) (let ((it (cddr (append item nil)))) (elisp-scope-1 (car it)) (while-let ((kw (car-safe it)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (cl-case bkw ((:active :enable :label :visible :suffix :selected) (elisp-scope-1 (cadr it)))) (setq it (cddr it)))))) ((consp item) (elisp-scope--easy-menu-do-define-menu item)))))) (elisp-scope-define-function-analyzer easy-menu-do-define (&optional symbol maps doc menu) (elisp-scope-1 symbol) (elisp-scope-1 maps) (elisp-scope-1 doc) (if-let* ((q (elisp-scope--unquote menu))) ;; TODO: Use `elisp-scope-1' with an appropriate outspec. (elisp-scope--easy-menu-do-define-menu q) (elisp-scope-1 menu))) (elisp-scope-define-function-analyzer define-key (&optional keymap key def remove) (elisp-scope-1 keymap) (elisp-scope-1 key) (if-let* ((q (elisp-scope--unquote def))) ;; TODO: Use `elisp-scope-1' with an appropriate outspec. (cond ((eq (elisp-scope-sym-bare (car-safe q)) 'menu-item) (let ((fn (caddr q)) (it (cdddr q))) (elisp-scope-sharpquote fn) (while-let ((kw (car-safe it)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (cl-case bkw ((:active :enable :label :visible :suffix :selected) (elisp-scope-1 (cadr it))) ((:filter) (elisp-scope-sharpquote (cadr it)))) (setq it (cddr it))))) ((or (symbolp q) (symbol-with-pos-p q)) (elisp-scope-report-s q 'function))) (elisp-scope-1 def)) (elisp-scope-1 remove)) (elisp-scope-define-function-analyzer eval-after-load (&optional file form) (elisp-scope-1 file '(symbol . feature)) (elisp-scope-1 form 'code)) (elisp-scope-define-macro-analyzer if-let* (&optional varlist then &rest else) (elisp-scope-if-let varlist then else elisp-scope-output-spec)) (defun elisp-scope-if-let (bindings then else outspec) (if (consp bindings) (let* ((binding (car bindings)) (sym (when (cdr binding) (car binding))) (form (if (cdr binding) (cadr binding) (car binding))) (bare (bare-symbol sym)) (len (length (symbol-name bare))) (beg (elisp-scope-sym-pos sym))) (when beg (elisp-scope-binding bare beg len)) (elisp-scope-1 form) (let ((elisp-scope-local-bindings (elisp-scope-local-new bare beg elisp-scope-local-bindings))) (elisp-scope-if-let (cdr bindings) then else outspec))) (elisp-scope-1 then outspec) (elisp-scope-n else outspec))) (elisp-scope-define-macro-analyzer define-globalized-minor-mode (global mode turn-on &rest body) (elisp-scope-report-s mode 'function) (elisp-scope-report-s turn-on 'function) (elisp-scope-define-minor-mode global nil body)) (elisp-scope-define-macro-analyzer define-derived-mode (&optional child parent name &rest body) (elisp-scope-report-s child 'major-mode-definition) (elisp-scope-report-s parent 'major-mode) (elisp-scope-mode-line-construct name) (when (stringp (car body)) (pop body)) (while-let ((kw (car-safe body)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (cl-case bkw (:group (elisp-scope-quoted-group (cadr body))) ((:syntax-table :abbrev-table :after-hook) (elisp-scope-1 (cadr body)))) (setq body (cddr body))) (elisp-scope-n body)) (elisp-scope-define-macro-analyzer lambda (args &rest body) (elisp-scope-lambda args body)) (defun elisp-scope-oclosure-lambda-1 (local bindings args body) (if bindings (let* ((binding (ensure-list (car bindings))) (sym (car binding)) (bare (elisp-scope-sym-bare sym)) (len (length (symbol-name bare))) (beg (elisp-scope-sym-pos sym))) (when beg (elisp-scope-binding bare beg len)) (elisp-scope-1 (cadr binding)) (elisp-scope-oclosure-lambda-1 (if bare (elisp-scope-local-new bare beg local) local) (cdr bindings) args body)) (let ((elisp-scope-local-bindings local)) (elisp-scope-lambda args body)))) (defun elisp-scope-oclosure-lambda (spec args body) (let ((type (car-safe spec))) (elisp-scope-report-s type 'oclosure)) (elisp-scope-oclosure-lambda-1 elisp-scope-local-bindings (cdr-safe spec) args body)) (elisp-scope-define-macro-analyzer oclosure-lambda (&optional spec args &rest body) (elisp-scope-oclosure-lambda spec args body)) (elisp-scope-define-macro-analyzer cl-loop (&rest clauses) (elisp-scope-loop clauses)) (elisp-scope-define-macro-analyzer named-let (name bindings &rest body) (elisp-scope-named-let name bindings body elisp-scope-output-spec)) (elisp-scope-define-macro-analyzer cl-flet (bindings &rest body) (elisp-scope-flet bindings body elisp-scope-output-spec)) (elisp-scope-define-macro-analyzer cl-labels (bindings &rest body) (elisp-scope-labels bindings body elisp-scope-output-spec)) (elisp-scope-define-macro-analyzer with-slots (spec-list object &rest body) (elisp-scope-1 object) (elisp-scope-let spec-list body)) (elisp-scope-define-macro-analyzer cl-defmethod (name &rest rest) (elisp-scope-defmethod name rest)) (elisp-scope-define-macro-analyzer cl-destructuring-bind (args expr &rest body) (elisp-scope-1 expr) (elisp-scope-cl-lambda args body)) (elisp-scope-define-macro-analyzer declare-function (&optional fn _file arglist _fileonly) (elisp-scope-report-s fn 'function) (elisp-scope-lambda (and (listp arglist) arglist) nil)) (elisp-scope-define-macro-analyzer cl-block (name &rest body) (elisp-scope-block name body)) (elisp-scope-define-macro-analyzer cl-return-from (name &optional result) (elisp-scope-return-from name result)) (elisp-scope-define-macro-analyzer rx (&rest regexps) ;; Unsafe macro! (elisp-scope-rx regexps)) (elisp-scope-define-macro-analyzer cl-tagbody (&rest body) (let (labels statements) (while body (let ((head (pop body))) (if (consp head) (push head statements) (push head labels)))) (elisp-scope-cl-tagbody (nreverse labels) (nreverse statements)))) (defvar elisp-scope-label-alist nil) (defun elisp-scope-cl-tagbody (labels statements) (if labels (let* ((label (car labels)) (bare (elisp-scope-sym-bare label))) (when-let* ((beg (elisp-scope-sym-pos label))) (elisp-scope-report 'label beg (length (symbol-name bare)) beg)) (let ((elisp-scope-label-alist (if bare (elisp-scope-local-new bare (elisp-scope-sym-pos label) elisp-scope-label-alist) elisp-scope-label-alist))) (elisp-scope-cl-tagbody (cdr labels) statements))) (elisp-scope-n statements))) (elisp-scope-define-macro-analyzer go (label) ;; TODO: Change to a local macro defintion induced by `cl-tagbody'. (when-let* ((bare (elisp-scope-sym-bare label)) (pos (alist-get bare elisp-scope-label-alist)) (beg (elisp-scope-sym-pos label))) (elisp-scope-report 'label beg (length (symbol-name bare)) pos))) (elisp-scope-define-macro-analyzer rx-define (name &rest rest) (elisp-scope-rx-define name rest)) (elisp-scope-define-macro-analyzer rx-let (bindings &rest body) (elisp-scope-rx-let bindings body)) (elisp-scope-define-macro-analyzer let-when-compile (bindings &rest body) ;; Unsafe macro! (elisp-scope-let* bindings body)) (elisp-scope-define-macro-analyzer cl-eval-when (_when &rest body) ;; Unsafe macro! (elisp-scope-n body)) (elisp-scope-define-macro-analyzer cl-macrolet (bindings &rest body) ;; Unsafe macro! (elisp-scope-cl-macrolet bindings body elisp-scope-output-spec)) (elisp-scope-define-macro-analyzer cl-symbol-macrolet (bindings &rest body) ;; Unsafe macro! (elisp-scope-let* bindings body)) (elisp-scope-define-macro-analyzer nnoo-define-basics (&optional backend) ;; Unsafe macro! (let* ((bare (bare-symbol backend)) (len (length (symbol-name bare))) (beg (elisp-scope-sym-pos backend))) (when beg (elisp-scope-report 'nnoo-backend beg len)))) (elisp-scope-define-macro-analyzer gv-define-expander (name handler) (elisp-scope-gv-define-expander name handler)) (elisp-scope-define-macro-analyzer gv-define-simple-setter (name setter &rest rest) (elisp-scope-gv-define-simple-setter name setter rest)) (elisp-scope-define-macro-analyzer cl-deftype (name arglist &rest body) (elisp-scope-deftype name arglist body)) (elisp-scope-define-macro-analyzer define-minor-mode (&optional mode doc &rest body) (when mode (elisp-scope-define-minor-mode mode doc body))) (elisp-scope-define-macro-analyzer setq-local (&rest args) (elisp-scope-setq args)) (put 'setq-default 'elisp-scope-analyzer #'elisp-scope--analyze-setq-local) (elisp-scope-define-macro-analyzer cl-defun (name arglist &rest body) (elisp-scope-cl-defun name arglist body)) (put 'cl-defmacro 'elisp-scope-analyzer #'elisp-scope--analyze-cl-defun) (elisp-scope-define-macro-analyzer defun (&optional name arglist &rest body) (when name (elisp-scope-defun name arglist body))) (elisp-scope-define-macro-analyzer defmacro (&optional name arglist &rest body) (elisp-scope-report-s name 'defmacro) (elisp-scope-lambda arglist body)) (put 'ert-deftest 'elisp-scope-analyzer #'elisp-scope--analyze-defun) (elisp-scope-define-macro-analyzer elisp-scope-define-symbol-role (&optional name parents &rest props) (elisp-scope-report-s name 'symbol-role-definition) (dolist (parent parents) (elisp-scope-report-s parent 'symbol-role)) (while-let ((kw (car-safe props)) (bkw (elisp-scope-sym-bare kw)) ((keywordp bkw))) (elisp-scope-report-s kw 'constant) (cl-case bkw (:face (if-let* ((q (elisp-scope--unquote (cadr props)))) (elisp-scope-face-1 q) (elisp-scope-1 (cadr props)))) (:definition (if-let* ((q (elisp-scope--unquote (cadr props)))) (dolist (st (ensure-list q)) (elisp-scope-report-s st 'symbol-role)) (elisp-scope-1 (cadr props)))) (otherwise (elisp-scope-1 (cadr props)))) (setq props (cddr props)))) (elisp-scope-define-macro-analyzer cl-letf (bindings &rest body) (let ((l elisp-scope-local-bindings)) (dolist (binding bindings) (let ((place (car binding))) (if (or (symbol-with-pos-p place) (symbolp place)) (let* ((bare (bare-symbol place)) (len (length (symbol-name bare))) (beg (elisp-scope-sym-pos place))) (when beg (elisp-scope-binding bare beg len)) (setq l (elisp-scope-local-new bare beg l))) (elisp-scope-1 place)) (elisp-scope-1 (cadr binding)))) (let ((elisp-scope-local-bindings l)) (elisp-scope-n body elisp-scope-output-spec)))) (elisp-scope-define-macro-analyzer setf (&rest args) (elisp-scope-setq args)) (elisp-scope-define-macro-analyzer pop (&optional place) (elisp-scope-1 place)) (elisp-scope-define-macro-analyzer push (&optional newelt place) (elisp-scope-1 newelt) (elisp-scope-1 place)) (elisp-scope-define-macro-analyzer with-memoization (&optional place &rest body) (elisp-scope-1 place) (elisp-scope-n body elisp-scope-output-spec)) (elisp-scope-define-macro-analyzer cl-pushnew (&rest args) (mapc #'elisp-scope-1 args)) (dolist (sym '(incf decf)) (put sym 'elisp-scope-analyzer #'elisp-scope--analyze-cl-pushnew)) (elisp-scope-define-macro-analyzer static-if (&optional test then &rest else) (elisp-scope-1 test) (elisp-scope-1 then elisp-scope-output-spec) (elisp-scope-n else elisp-scope-output-spec)) (elisp-scope-define-macro-analyzer static-when (&optional test &rest body) (elisp-scope-1 test) (elisp-scope-n body elisp-scope-output-spec)) (put 'static-unless 'elisp-scope-analyzer #'elisp-scope--analyze-static-when) (elisp-scope-define-macro-analyzer eval-when-compile (&rest body) (elisp-scope-n body elisp-scope-output-spec)) (put 'eval-and-compile 'elisp-scope-analyzer #'elisp-scope--analyze-eval-when-compile) (elisp-scope-define-macro-analyzer cl-callf (&rest args) (elisp-scope-sharpquote (car args)) (elisp-scope-n (cdr args))) (put 'cl-callf2 'elisp-scope-analyzer #'elisp-scope--analyze-cl-callf) (elisp-scope-define-macro-analyzer seq-let (args sequence &rest body) (elisp-scope-1 sequence) (let ((l elisp-scope-local-bindings)) (dolist (arg args) (let* ((bare (elisp-scope-sym-bare arg)) (len (length (symbol-name bare))) (beg (elisp-scope-sym-pos arg))) (if (eq bare '&rest) (elisp-scope-report 'ampersand beg len) (when beg (elisp-scope-binding bare beg len)) (setq l (elisp-scope-local-new bare beg l))))) (let ((elisp-scope-local-bindings l)) (elisp-scope-n body)))) (elisp-scope-define-analyzer let-alist (f alist &rest body) (elisp-scope-report-s f 'macro) (elisp-scope-1 alist) (let ((elisp-scope-current-let-alist-form (cons (or (elisp-scope-sym-pos f) (cons 'gen (incf elisp-scope-counter))) (elisp-scope-sym-pos f)))) (elisp-scope-n body))) (elisp-scope-define-macro-analyzer define-obsolete-face-alias (&optional obs cur when) (when-let* ((q (elisp-scope--unquote obs))) (elisp-scope-report-s q 'defface)) (when-let* ((q (elisp-scope--unquote cur))) (elisp-scope-report-s q 'face)) (elisp-scope-1 when)) (elisp-scope-define-macro-analyzer backquote (&optional structure) (elisp-scope-backquote structure elisp-scope-output-spec)) (defvar elisp-scope-backquote-depth 0) (defun elisp-scope-backquote (structure &optional outspec) (let ((elisp-scope-backquote-depth (1+ elisp-scope-backquote-depth))) (elisp-scope-backquote-1 structure outspec))) (defun elisp-scope-backquote-1 (structure &optional outspec) (cond ((vectorp structure) (dotimes (i (length structure)) (elisp-scope-backquote-1 (aref structure i)))) ((atom structure) (elisp-scope-quote structure outspec)) ((or (eq (car structure) backquote-unquote-symbol) (eq (car structure) backquote-splice-symbol)) (if (= elisp-scope-backquote-depth 1) (elisp-scope-1 (cadr structure) outspec) (let ((elisp-scope-backquote-depth (1- elisp-scope-backquote-depth))) (elisp-scope-backquote-1 (cadr structure))))) (t (while (consp structure) (elisp-scope-backquote-1 (pop structure))) (when structure (elisp-scope-backquote-1 structure))))) (elisp-scope-define-special-form-analyzer let (bindings &rest body) (elisp-scope-let bindings body)) (elisp-scope-define-special-form-analyzer let* (bindings &rest body) (elisp-scope-let* bindings body)) (elisp-scope-define-special-form-analyzer cond (&rest clauses) (dolist (clause clauses) (elisp-scope-n clause elisp-scope-output-spec))) (elisp-scope-define-special-form-analyzer setq (&rest args) (elisp-scope-setq args)) (elisp-scope-define-special-form-analyzer defvar (&rest args) (elisp-scope-report-s (car args) (if (cdr args) 'defvar 'special-variable-declaration)) (elisp-scope-1 (cadr args))) (elisp-scope-define-special-form-analyzer defconst (&optional sym init _doc) (elisp-scope-report-s sym 'defvar) (elisp-scope-1 init)) (elisp-scope-define-special-form-analyzer condition-case (var bodyform &rest handlers) (let* ((bare (bare-symbol var)) (beg (when (symbol-with-pos-p var) (symbol-with-pos-pos var))) (l (elisp-scope-local-new bare beg elisp-scope-local-bindings))) (when beg (elisp-scope-binding bare beg (length (symbol-name bare)))) (elisp-scope-1 bodyform elisp-scope-output-spec) (dolist (handler handlers) (dolist (cond-name (ensure-list (car-safe handler))) (when-let* ((cbeg (elisp-scope-sym-pos cond-name)) (cbare (elisp-scope-sym-bare cond-name)) (clen (length (symbol-name cbare)))) (cond ((booleanp cbare)) ((keywordp cbare) (elisp-scope-report 'constant cbeg clen)) (t (elisp-scope-report 'condition cbeg clen))))) (let ((elisp-scope-local-bindings l)) (elisp-scope-n (cdr handler) elisp-scope-output-spec))))) (elisp-scope-define-special-form-analyzer function (&optional arg) (when arg (elisp-scope-sharpquote arg))) (elisp-scope-define-special-form-analyzer quote (arg) (elisp-scope-quote arg elisp-scope-output-spec)) (elisp-scope-define-special-form-analyzer interactive (&rest _) ;; Out-of-place `interactive' call, do nothing. ) (elisp-scope-define-special-form-analyzer if (&optional test then &rest else) (elisp-scope-1 test) (elisp-scope-1 then elisp-scope-output-spec) (elisp-scope-n else elisp-scope-output-spec)) (elisp-scope-define-special-form-analyzer and (&rest forms) (elisp-scope-n forms elisp-scope-output-spec)) (elisp-scope-define-special-form-analyzer or (&rest forms) (dolist (form forms) (elisp-scope-1 form elisp-scope-output-spec))) (defun elisp-scope-quote (arg &optional outspec) (when outspec (when-let* ((spec (elisp-scope--match-spec-to-arg outspec arg))) (elisp-scope--handle-quoted spec arg)))) (cl-defgeneric elisp-scope--handle-quoted (spec arg)) (cl-defmethod elisp-scope--handle-quoted ((_spec (eql t)) _arg) ;; Do nothing. ) (cl-defmethod elisp-scope--handle-quoted ((_spec (eql 'code)) arg) (let ((elisp-scope-local-bindings nil) (elisp-scope-current-let-alist-form nil) (elisp-scope-local-definitions nil) (elisp-scope-block-alist nil) (elisp-scope-label-alist nil) (elisp-scope-rx-alist nil) (elisp-scope--quoted t)) (elisp-scope-1 arg))) (cl-defmethod elisp-scope--handle-quoted ((spec (head symbol)) arg) (when-let* ((role (cdr spec))) (elisp-scope-report-s arg role))) (cl-defmethod elisp-scope--handle-quoted ((spec (head list)) arg) (let ((specs (cdr spec))) (while specs (elisp-scope--handle-quoted (pop specs) (pop arg))))) (cl-defmethod elisp-scope--handle-quoted ((spec (head cons)) arg) (elisp-scope--handle-quoted (cadr spec) (car arg)) (elisp-scope--handle-quoted (cddr spec) (cdr arg))) (cl-defgeneric elisp-scope--match-spec-to-arg (spec arg)) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (eql t)) _arg) spec) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (eql 'code)) _arg) spec) (cl-defmethod elisp-scope--match-spec-to-arg ((_spec (eql 'spec)) arg) (elisp-scope--match-spec-to-arg ;; Unfold `spec'. '(or (symbol) (cons (member symbol) . (symbol . symbol-role)) (cons (member repeat) . spec) (cons (member or) . (repeat . spec)) (cons (member cons) . (cons spec . spec)) (cons (member member) . t) (cons (member plist) . (repeat . (cons (symbol . constant) . spec)))) arg)) (cl-defmethod elisp-scope--match-spec-to-arg ((_spec (eql 'cl-type)) arg) (elisp-scope--match-spec-to-arg ;; Unfold `cl-type'. '(or (member t) (symbol . type) (cons (member integer float real number) . t) (cons (member or and not) . (repeat . cl-type)) (cons (member member cl-member) . (repeat . t)) (cons (member satisfies) . (cons (or (symbol . function) code) . t))) arg)) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (head symbol)) arg) (when (or (symbolp arg) (symbol-with-pos-p arg)) spec)) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (head repeat)) arg) (when (listp arg) (named-let loop ((args arg) (acc nil)) (if args (when-let* ((res (elisp-scope--match-spec-to-arg (cdr spec) (car args)))) (loop (cdr args) (cons res acc))) (cons 'list (nreverse acc)))))) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (head or)) arg) (named-let loop ((specs (cdr spec))) (when specs (if-let* ((res (elisp-scope--match-spec-to-arg (car specs) arg))) res (loop (cdr specs)))))) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (head cons)) arg) (when (consp arg) (let ((car-spec (cadr spec)) (cdr-spec (cddr spec))) (when-let* ((car-res (elisp-scope--match-spec-to-arg car-spec (car arg))) (cdr-res (elisp-scope--match-spec-to-arg cdr-spec (cdr arg)))) (cons 'cons (cons car-res cdr-res)))))) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (head member)) arg) (let ((symbols-with-pos-enabled t)) (and (member arg (cdr spec)) t))) (cl-defmethod elisp-scope--match-spec-to-arg ((spec (head plist)) arg) (cond ((consp arg) (let ((res nil) (go t)) (while (and arg go) (let* ((key (car arg)) (bkw (elisp-scope-sym-bare key)) (val (cadr arg))) (push (if (keywordp bkw) '(symbol . constant) t) res) (push (setq go (elisp-scope--match-spec-to-arg (alist-get bkw (cdr spec) t) val)) res)) (setq arg (cddr arg))) (when go (cons 'list (nreverse res))))) ((null arg) t))) (elisp-scope-define-special-form-analyzer catch (&optional tag &rest body) (elisp-scope-1 tag '(symbol . throw-tag)) (elisp-scope-n body elisp-scope-output-spec)) (elisp-scope-define-special-form-analyzer progn (&rest body) (elisp-scope-n body elisp-scope-output-spec)) (put 'inline 'elisp-scope-analyzer #'elisp-scope--analyze-progn) (put 'save-current-buffer 'elisp-scope-analyzer #'elisp-scope--analyze-progn) (put 'save-excursion 'elisp-scope-analyzer #'elisp-scope--analyze-progn) (put 'save-restriction 'elisp-scope-analyzer #'elisp-scope--analyze-progn) (elisp-scope-define-special-form-analyzer while (&rest rest) (mapc #'elisp-scope-1 rest)) (elisp-scope-define-special-form-analyzer prog1 (&rest body) (when (consp body) (elisp-scope-1 (pop body) elisp-scope-output-spec)) (elisp-scope-n body)) (put 'unwind-protect 'elisp-scope-analyzer #'elisp-scope--analyze-prog1) (defun elisp-scope-report-s (sym role) "Report that symbol SYM has role ROLE. If SYM is not a symbol with position information, do nothing." (when-let* ((beg (elisp-scope-sym-pos sym)) (bare (bare-symbol sym))) (elisp-scope-report role beg (length (symbol-name bare))))) (defvar-local elisp-scope-buffer-file-name nil) (defun elisp-scope-1 (form &optional outspec) "Analyze FORM as an evaluated form with expected output spec OUTSPEC. If OUTSPEC is non-nil, it specifies FORM's expected \"output spec\". This guides the analysis of quoted (sub)forms. OUTSPEC can be one the following: - t: FORM evaluates to an arbitrary object. In other words, OUTSPEC of t conveys no information about FORM. - `code': FORM evaluates to a form to be evaluated elsewhere. The quoted output of FORM will again be analyzed as an evaluated form, in a \"clean\" local environment. - (symbol . ROLE): FORM evaluates to a symbol with role ROLE. See `elisp-scope-define-symbol-role' for more information about defining new symbol roles. - (repeat . SPEC): FORM evaluates to a list with elements of spec SPEC. - (cons CARSPEC . CDRSPEC): FORM evaluates to a cons cell whose `car' has spec CARSPEC and whose `cdr' has spec CDRSPEC. - (member . VALS): FORM evaluates to a `member' of VALS. - (plist . VALSPECS): FORM evaluates to a plist. VALSPECS is an alist associating value specs to properties in the plist. For example, an entry (:face . (symbol . face)) in VALSPECS says that the value of the property `:face' in the plist is a face name. - (or . SPECS): FORM evaluates to a value that matches one of SPECS. For example, to analyze a FORM that evaluates to either a list of major mode names or just to a single major mode name, use OUTSPEC as follows: (elisp-scope-1 FORM \\='(or (repeat . (symbol . major-mode)) (symbol . major-mode))) If FORM in this example is (if (something-p) \\='foo \\='(bar baz)), then all of `foo', `bar' and `baz' will be analyzed as major mode names. See also `elisp-scope-analyze-form' for an details about how subforms are analyzed." (cond ((consp form) (let* ((f (car form)) (bare (elisp-scope-sym-bare f)) (forms (cdr form)) (this nil)) (when bare (cond ((setq this (or (alist-get bare elisp-scope-local-definitions) (function-get bare 'elisp-scope-analyzer))) (let ((elisp-scope-output-spec outspec)) (apply this form))) ((macrop bare) (elisp-scope-report-s f 'macro) (cond ((elisp-scope-safe-macro-p bare) (let* ((warning-minimum-log-level :emergency) (macroexp-inhibit-compiler-macros t) (symbols-with-pos-enabled t) (message-log-max nil) (inhibit-message t) (macroexpand-all-environment (append (mapcar #'list elisp-scope-unsafe-macros) macroexpand-all-environment)) (expanded (ignore-errors (macroexpand-1 form macroexpand-all-environment)))) (elisp-scope-1 expanded outspec))) ((eq (get bare 'edebug-form-spec) t) (elisp-scope-n forms)))) ((functionp bare) (elisp-scope-report-s f 'function) (elisp-scope-n forms)) (t (elisp-scope-report-s f 'unknown) (when elisp-scope-assume-func (elisp-scope-n forms))))))) ((symbol-with-pos-p form) (elisp-scope-s form)))) (defun elisp-scope-n (forms &optional outspec) "Analyze FORMS as evaluated forms. OUTSPEC is the expected output spec of the last form in FORMS, if any. It is passed to `elisp-scope-1', which see." (while (cdr-safe forms) (elisp-scope-1 (pop forms))) (when-let* ((form (car-safe forms))) (elisp-scope-1 form outspec))) ;;;###autoload (defun elisp-scope-analyze-form (callback &optional stream) "Read and analyze code from STREAM, reporting findings via CALLBACK. Call CALLBACK for each analyzed symbol SYM with arguments ROLE, POS, LEN, ID and DEF, where ROLE 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. This function recursively analyzes Lisp forms (HEAD . TAIL), usually starting with a top-level form, by inspecting HEAD at each level: - If HEAD is a symbol with a non-nil `elisp-scope-analyzer' symbol property, then the value of that property specifies a bespoke analzyer function, AF, that is called as (AF HEAD . TAIL) to analyze the form. See more details about writing analyzer functions below. - If HEAD satisfies `functionp', which means it is a function in the running Emacs session, analzye the form as a function call. - If HEAD is a safe macro (see `elisp-scope-safe-macro-p'), expand it and analyze the resulting form. - If HEAD is unknown, then the arguments in TAIL are ignored, unless `elisp-scope-assume-func' is non-nil, in which case they are analyzed as evaluated forms (i.e. HEAD is assumed to be a function). An analyzer (function specified via the `elisp-scope-analyzer' property) can use the functions `elisp-scope-report-s', `elisp-scope-1' and `elisp-scope-n' to analyze its arguments, and it can consult the variable `elisp-scope-output-spec' to obtain the expected output spec of the analyzed form. For example, the following is a suitable analyzer for the `identity' function: (lambda (fsym arg) (elisp-scope-report-s fsym \\='function) (elisp-scope-1 arg elisp-scope-output-spec))" (let ((elisp-scope-counter 0) (elisp-scope-callback callback) (read-symbol-shorthands nil) (max-lisp-eval-depth 32768)) (elisp-scope-1 (read-positioning-symbols (or stream (current-buffer)))))) (provide 'elisp-scope) ;;; elisp-scope.el ends here