mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity
emacs/lisp/emacs-lisp/elisp-scope.el
Eshel Yaron bde38ef480
; Rename 'elisp-scope-output-type' to 'elisp-scope-output-spec'. 
* lisp/emacs-lisp/elisp-scope.el: Change all references to
this notion of "type" to say "spec" instead.
2025-10-03 18:24:35 +02:00

2846 lines
114 KiB
EmacsLisp
Raw Blame History

;;; elisp-scope.el --- Semantic analysis for ELisp symbols -*- lexical-binding: t; -*-
;; Copyright (C) 2025 Free Software Foundation, Inc.
;; Author: Eshel Yaron <me@eshelyaron.com>
;; 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 <https://www.gnu.org/licenses/>.
;;; 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 help-mode--current-data)
;;;###autoload
(defun elisp-scope-describe-symbol-role (role)
(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 ", ")))
(setq help-mode--current-data
(list :symbol role :type 'define-symbol-role
:file (find-lisp-object-file-name role 'define-symbol-role)))))))
(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) "#<unbound>")))
(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 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-functions nil)
(defvar elisp-scope--local nil)
(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)
(defvar elisp-scope-gen-id-alist 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)))
(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)))))))
(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 local))
(elisp-scope-n body elisp-scope-output-spec))))
(defun elisp-scope-let (bindings body)
(elisp-scope-let-1 elisp-scope--local 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 (elisp-scope-local-new bare beg elisp-scope--local)))
(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))
(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 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 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 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-flet-alist nil)
(defun elisp-scope-flet (defs body)
(if defs
(let* ((def (car defs))
(func (car def))
(exps (cdr def))
(beg (elisp-scope-sym-pos func))
(bare (bare-symbol func)))
(when beg
(elisp-scope-report 'function beg (length (symbol-name bare)) 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 ((elisp-scope-flet-alist (elisp-scope-local-new bare beg elisp-scope-flet-alist)))
(elisp-scope-flet (cdr defs) body)))
(elisp-scope-n body)))
(defun elisp-scope-labels (defs forms)
(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)))
(when beg
(elisp-scope-report 'function beg (length (symbol-name bare)) beg))
(let ((elisp-scope-flet-alist (elisp-scope-local-new bare beg elisp-scope-flet-alist)))
(elisp-scope-lambda args body)
(elisp-scope-flet (cdr defs) forms)))
(elisp-scope-n forms)))
(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) (memq bare elisp-scope-local-functions) (assq bare elisp-scope-flet-alist) 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 (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 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 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 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 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 (elisp-scope-local-new bare beg elisp-scope--local)))
(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 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 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 (elisp-scope-local-new bare beg elisp-scope--local)))
(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))
(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 l))
(elisp-scope-loop-with-and more)))
(let ((elisp-scope--local 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
;; `if' binds `it'.
(elisp-scope-local-new 'it (elisp-scope-sym-pos keyword) elisp-scope--local)))
(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 (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))
(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 ((elisp-scope-flet-alist (elisp-scope-local-new bare beg elisp-scope-flet-alist))
(elisp-scope--local l))
(elisp-scope-n body outspec)))))
(defun elisp-scope-with-slots (spec-list object body)
(elisp-scope-1 object)
(elisp-scope-let spec-list body))
(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 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 (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 (elisp-scope-local-new bare (elisp-scope-sym-pos head) elisp-scope--local)))
(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)
(init (cadr a))
(svar (caddr a)))
(elisp-scope-1 init)
(if (consp var)
(let ((elisp-scope--local 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 l))
(elisp-scope-cl-lambda-rest (cadr arglist) (cddr arglist) more body)))
(&key (let ((elisp-scope--local l))
(elisp-scope-cl-lambda-key (cadr arglist) (cddr arglist) more body)))
(&aux (let ((elisp-scope--local l))
(elisp-scope-cl-lambda-aux (cadr arglist) (cddr arglist) more body)))))
(let ((elisp-scope--local l))
(elisp-scope-cl-lambda-optional head (cdr arglist) more body)))))
(more
(let ((elisp-scope--local l))
(elisp-scope-cl-lambda-1 (car more) (cdr more) body)))
(t (let ((elisp-scope--local l)) (elisp-scope-lambda nil body)))))))
(defun elisp-scope-cl-lambda-rest (var arglist more body)
(let* ((l elisp-scope--local))
(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 l))
(elisp-scope-cl-lambda-key (cadr arglist) (cddr arglist) more body)))
(&aux
(let ((elisp-scope--local l))
(elisp-scope-cl-lambda-aux (cadr arglist) (cddr arglist) more body)))))
(let ((elisp-scope--local l))
(elisp-scope-cl-lambda-1 (car more) (cdr more) body)))))
(more (let ((elisp-scope--local l))
(elisp-scope-cl-lambda-1 (car more) (cdr more) body)))
(t (let ((elisp-scope--local 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)
(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 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 l))
(elisp-scope-cl-lambda-aux (cadr arglist) (cddr arglist) more body)))
(&allow-other-keys
(let ((elisp-scope--local l))
(elisp-scope-cl-lambda-1 (car more) (cdr more) body)))))
(let ((elisp-scope--local l))
(elisp-scope-cl-lambda-key head (cdr arglist) more body)))))
(more (let ((elisp-scope--local l))
(elisp-scope-cl-lambda-1 (car more) (cdr more) body)))
(t (let ((elisp-scope--local 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)
(init (cadr a)))
(elisp-scope-1 init)
(if (consp var)
(let ((elisp-scope--local 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 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)))))))
(defvar elisp-scope-macrolet-alist nil)
(defun elisp-scope-cl-macrolet (bindings body)
(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)))
(when-let* ((beg (elisp-scope-sym-pos name)))
(elisp-scope-report 'macro beg (length (symbol-name bare)) beg))
(let ((elisp-scope-macrolet-alist (elisp-scope-local-new bare (elisp-scope-sym-pos name) elisp-scope-macrolet-alist)))
(elisp-scope-cl-macrolet (cdr bindings) body))))
(elisp-scope-n body)))
(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 'macro)
(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) ;TODO: Specify spec of `slots'.
(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.
(when-let* ((q (elisp-scope--unquote spec)))
(when (consp q) (dolist (s q) (elisp-scope-face (cdr s)))))
(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 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 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 (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-define-macro-analyzer cl-labels (bindings &rest body)
(elisp-scope-labels bindings body))
(elisp-scope-define-macro-analyzer with-slots (spec-list object &rest body)
(elisp-scope-with-slots spec-list object 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-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))
(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 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))
(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 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 (&optional sym init _doc)
(elisp-scope-report-s sym 'defvar)
(elisp-scope-1 init))
(put 'defconst 'elisp-scope-analyzer #'elisp-scope--analyze-defvar)
(defun elisp-scope-condition-case (var bodyform 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)))
(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 l))
(elisp-scope-n (cdr handler) elisp-scope-output-spec)))))
(elisp-scope-define-special-form-analyzer condition-case (var bodyform &rest handlers)
(elisp-scope-condition-case var bodyform handlers))
(elisp-scope-define-macro-analyzer condition-case-unless-debug (var bodyform &rest handlers)
(elisp-scope-condition-case var bodyform handlers))
(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 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 nil)
(elisp-scope-current-let-alist-form nil)
(elisp-scope-flet-alist nil)
(elisp-scope-block-alist nil)
(elisp-scope-macrolet-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 (assq bare elisp-scope-flet-alist))
(elisp-scope-report
'function (symbol-with-pos-pos f) (length (symbol-name bare)) (cdr this))
(elisp-scope-n forms))
((setq this (assq bare elisp-scope-macrolet-alist))
(when (symbol-with-pos-p f)
(elisp-scope-report
'macro (symbol-with-pos-pos f) (length (symbol-name bare)) (cdr this)))
;; Local macros can be unsafe, so we do not expand them.
;; Hence we cannot interpret their arguments.
)
((setq this (function-get bare 'elisp-scope-analyzer))
(let ((elisp-scope-output-spec outspec)) (apply this form)))
((special-form-p bare) (elisp-scope-report-s f 'special-form) (elisp-scope-n forms))
((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))))
((or (functionp bare) (memq bare elisp-scope-local-functions))
(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 analyzes 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
Reference in a new issue View git blame Copy permalink