diff options
Diffstat (limited to 'lisp/emacs-lisp/autoload.el')
| -rw-r--r-- | lisp/emacs-lisp/autoload.el | 349 |
1 files changed, 11 insertions, 338 deletions
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 1e4b2c14a01..d324a7fc70c 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -28,11 +28,15 @@ ;; Lisp source files in various useful ways. To learn more, read the ;; source; if you're going to use this, you'd better be able to. +;; The functions in this file have been largely superseded by +;; loaddefs-gen.el. + ;;; Code: (require 'lisp-mode) ;for `doc-string-elt' properties. (require 'lisp-mnt) (require 'cl-lib) +(require 'loaddefs-gen) (defvar generated-autoload-file nil "File into which to write autoload definitions. @@ -112,165 +116,7 @@ then we use the timestamp of the output file instead. As a result: (defvar autoload-modified-buffers) ;Dynamically scoped var. -(defun make-autoload (form file &optional expansion) - "Turn FORM into an autoload or defvar for source file FILE. -Returns nil if FORM is not a special autoload form (i.e. a function definition -or macro definition or a defcustom). -If EXPANSION is non-nil, we're processing the macro expansion of an -expression, in which case we want to handle forms differently." - (let ((car (car-safe form)) expand) - (cond - ((and expansion (eq car 'defalias)) - (pcase-let* - ((`(,_ ,_ ,arg . ,rest) form) - ;; `type' is non-nil if it defines a macro. - ;; `fun' is the function part of `arg' (defaults to `arg'). - ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t)) - (and (let fun arg) (let type nil))) - arg) - ;; `lam' is the lambda expression in `fun' (or nil if not - ;; recognized). - (lam (if (memq (car-safe fun) '(quote function)) (cadr fun))) - ;; `args' is the list of arguments (or t if not recognized). - ;; `body' is the body of `lam' (or t if not recognized). - ((or `(lambda ,args . ,body) - (and (let args t) (let body t))) - lam) - ;; Get the `doc' from `body' or `rest'. - (doc (cond ((stringp (car-safe body)) (car body)) - ((stringp (car-safe rest)) (car rest)))) - ;; Look for an interactive spec. - (interactive (pcase body - ((or `((interactive . ,iargs) . ,_) - `(,_ (interactive . ,iargs) . ,_)) - ;; List of modes or just t. - (if (nthcdr 1 iargs) - (list 'quote (nthcdr 1 iargs)) - t))))) - ;; Add the usage form at the end where describe-function-1 - ;; can recover it. - (when (consp args) (setq doc (help-add-fundoc-usage doc args))) - ;; (message "autoload of %S" (nth 1 form)) - `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type))) - - ((and expansion (memq car '(progn prog1))) - (let ((end (memq :autoload-end form))) - (when end ;Cut-off anything after the :autoload-end marker. - (setq form (copy-sequence form)) - (setcdr (memq :autoload-end form) nil)) - (let ((exps (delq nil (mapcar (lambda (form) - (make-autoload form file expansion)) - (cdr form))))) - (when exps (cons 'progn exps))))) - - ;; For complex cases, try again on the macro-expansion. - ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode - define-globalized-minor-mode defun defmacro - easy-mmode-define-minor-mode define-minor-mode - define-inline cl-defun cl-defmacro cl-defgeneric - cl-defstruct pcase-defmacro)) - (macrop car) - (setq expand (let ((load-true-file-name file) - (load-file-name file)) - (macroexpand form))) - (memq (car expand) '(progn prog1 defalias))) - (make-autoload expand file 'expansion)) ;Recurse on the expansion. - - ;; For special function-like operators, use the `autoload' function. - ((memq car '(define-skeleton define-derived-mode - define-compilation-mode define-generic-mode - easy-mmode-define-global-mode define-global-minor-mode - define-globalized-minor-mode - easy-mmode-define-minor-mode define-minor-mode - cl-defun defun* cl-defmacro defmacro* - define-overloadable-function)) - (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*))) - (name (nth 1 form)) - (args (pcase car - ((or 'defun 'defmacro - 'defun* 'defmacro* 'cl-defun 'cl-defmacro - 'define-overloadable-function) - (nth 2 form)) - ('define-skeleton '(&optional str arg)) - ((or 'define-generic-mode 'define-derived-mode - 'define-compilation-mode) - nil) - (_ t))) - (body (nthcdr (or (function-get car 'doc-string-elt) 3) form)) - (doc (if (stringp (car body)) (pop body)))) - ;; Add the usage form at the end where describe-function-1 - ;; can recover it. - (when (listp args) (setq doc (help-add-fundoc-usage doc args))) - ;; `define-generic-mode' quotes the name, so take care of that - `(autoload ,(if (listp name) name (list 'quote name)) - ,file ,doc - ,(or (and (memq car '(define-skeleton define-derived-mode - define-generic-mode - easy-mmode-define-global-mode - define-global-minor-mode - define-globalized-minor-mode - easy-mmode-define-minor-mode - define-minor-mode)) - t) - (and (eq (car-safe (car body)) 'interactive) - ;; List of modes or just t. - (or (if (nthcdr 1 (car body)) - (list 'quote (nthcdr 1 (car body))) - t)))) - ,(if macrop ''macro nil)))) - - ;; For defclass forms, use `eieio-defclass-autoload'. - ((eq car 'defclass) - (let ((name (nth 1 form)) - (superclasses (nth 2 form)) - (doc (nth 4 form))) - (list 'eieio-defclass-autoload (list 'quote name) - (list 'quote superclasses) file doc))) - - ;; Convert defcustom to less space-consuming data. - ((eq car 'defcustom) - (let* ((varname (car-safe (cdr-safe form))) - (props (nthcdr 4 form)) - (initializer (plist-get props :initialize)) - (init (car-safe (cdr-safe (cdr-safe form)))) - (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form))))) - ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))) - ) - `(progn - ,(if (not (member initializer '(nil 'custom-initialize-default - #'custom-initialize-default - 'custom-initialize-reset - #'custom-initialize-reset))) - form - `(defvar ,varname ,init ,doc)) - ;; When we include the complete `form', this `custom-autoload' - ;; is not indispensable, but it still helps in case the `defcustom' - ;; doesn't specify its group explicitly, and probably in a few other - ;; corner cases. - (custom-autoload ',varname ,file - ,(condition-case nil - (null (plist-get props :set)) - (error nil))) - ;; Propagate the :safe property to the loaddefs file. - ,@(when-let ((safe (plist-get props :safe))) - `((put ',varname 'safe-local-variable ,safe)))))) - - ((eq car 'defgroup) - ;; In Emacs this is normally handled separately by cus-dep.el, but for - ;; third party packages, it can be convenient to explicitly autoload - ;; a group. - (let ((groupname (nth 1 form))) - `(let ((loads (get ',groupname 'custom-loads))) - (if (member ',file loads) nil - (put ',groupname 'custom-loads (cons ',file loads)))))) - - ;; When processing a macro expansion, any expression - ;; before a :autoload-end should be included. These are typically (put - ;; 'fun 'prop val) and things like that. - ((and expansion (consp form)) form) - - ;; nil here indicates that this is not a special autoload form. - (t nil)))) +(defalias 'make-autoload #'loaddefs-generate--make-autoload) ;; Forms which have doc-strings which should be printed specially. ;; A doc-string-elt property of ELT says that (nth ELT FORM) is @@ -379,41 +225,7 @@ put the output in." (print-escape-nonascii t)) (print form outbuf))))))) -(defun autoload-rubric (file &optional type feature) - "Return a string giving the appropriate autoload rubric for FILE. -TYPE (default \"autoloads\") is a string stating the type of -information contained in FILE. TYPE \"package\" acts like the default, -but adds an extra line to the output to modify `load-path'. - -If FEATURE is non-nil, FILE will provide a feature. FEATURE may -be a string naming the feature, otherwise it will be based on -FILE's name." - (let ((basename (file-name-nondirectory file)) - (lp (if (equal type "package") (setq type "autoloads")))) - (concat ";;; " basename - " --- automatically extracted " (or type "autoloads") - " -*- lexical-binding: t -*-\n" - (when (string-match "/lisp/loaddefs\\.el\\'" file) - ";; This file will be copied to ldefs-boot.el and checked in periodically.\n") - ";;\n" - ";;; Code:\n\n" - (if lp - "(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path))))\n\n") - " \n" - ;; This is used outside of autoload.el, eg cus-dep, finder. - (if feature - (format "(provide '%s)\n" - (if (stringp feature) feature - (file-name-sans-extension basename)))) - ";; Local Variables:\n" - ";; version-control: never\n" - ";; no-byte-compile: t\n" ;; #$ is byte-compiled into nil. - ";; no-update-autoloads: t\n" - ";; coding: utf-8-emacs-unix\n" - ";; End:\n" - ";;; " basename - " ends here\n"))) +(defalias 'autoload-rubric #'loaddefs-generate--rubric) (defvar autoload-ensure-writable nil "Non-nil means `autoload-find-generated-file' makes existing file writable.") @@ -480,35 +292,13 @@ if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)." (hack-local-variables)) (current-buffer))) +(defalias 'autoload-insert-section-header + #'loaddefs-generate--insert-section-header) + (defvar no-update-autoloads nil "File local variable to prevent scanning this file for autoload cookies.") -(defun autoload-file-load-name (file outfile) - "Compute the name that will be used to load FILE. -OUTFILE should be the name of the global loaddefs.el file, which -is expected to be at the root directory of the files we are -scanning for autoloads and will be in the `load-path'." - (let* ((name (file-relative-name file (file-name-directory outfile))) - (names '()) - (dir (file-name-directory outfile))) - ;; If `name' has directory components, only keep the - ;; last few that are really needed. - (while name - (setq name (directory-file-name name)) - (push (file-name-nondirectory name) names) - (setq name (file-name-directory name))) - (while (not name) - (cond - ((null (cdr names)) (setq name (car names))) - ((file-exists-p (expand-file-name "subdirs.el" dir)) - ;; FIXME: here we only check the existence of subdirs.el, - ;; without checking its content. This makes it generate wrong load - ;; names for cases like lisp/term which is not added to load-path. - (setq dir (expand-file-name (pop names) dir))) - (t (setq name (mapconcat #'identity names "/"))))) - (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name) - (substring name 0 (match-beginning 0)) - name))) +(defalias 'autoload-file-load-name #'loaddefs-generate--file-load-name) (defun generate-file-autoloads (file) "Insert at point a loaddefs autoload section for FILE. @@ -522,13 +312,6 @@ Return non-nil in the case where no autoloads were added at point." (autoload-generate-file-autoloads file (current-buffer) buffer-file-name) autoload-modified-buffers)) -(defvar autoload-compute-prefixes t - "If non-nil, autoload will add code to register the prefixes used in a file. -Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines -variables or functions that use \"foo-\" as prefix, that will not be registered. -But all other prefixes will be included.") -(put 'autoload-compute-prefixes 'safe #'booleanp) - (defconst autoload-def-prefixes-max-entries 5 "Target length of the list of definition prefixes per file. If set too small, the prefixes will be too generic (i.e. they'll use little @@ -540,102 +323,7 @@ cost more memory use).") "Target size of definition prefixes. Don't try to split prefixes that are already longer than that.") -(require 'radix-tree) - -(defun autoload--make-defs-autoload (defs file) - - ;; Remove the defs that obey the rule that file foo.el (or - ;; foo-mode.el) uses "foo-" as prefix. - ;; FIXME: help--symbol-completion-table still doesn't know how to use - ;; the rule that file foo.el (or foo-mode.el) uses "foo-" as prefix. - ;;(let ((prefix - ;; (concat (substring file 0 (string-match "-mode\\'" file)) "-"))) - ;; (dolist (def (prog1 defs (setq defs nil))) - ;; (unless (string-prefix-p prefix def) - ;; (push def defs)))) - - ;; Then compute a small set of prefixes that cover all the - ;; remaining definitions. - (let* ((tree (let ((tree radix-tree-empty)) - (dolist (def defs) - (setq tree (radix-tree-insert tree def t))) - tree)) - (prefixes nil)) - ;; Get the root prefixes, that we should include in any case. - (radix-tree-iter-subtrees - tree (lambda (prefix subtree) - (push (cons prefix subtree) prefixes))) - ;; In some cases, the root prefixes are too short, e.g. if you define - ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes. - (dolist (pair (prog1 prefixes (setq prefixes nil))) - (let ((s (car pair))) - (if (or (and (> (length s) 2) ; Long enough! - ;; But don't use "def" from deffoo-pkg-thing. - (not (string= "def" s))) - (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix? - (radix-tree-lookup (cdr pair) "")) ;Nothing to expand! - (push pair prefixes) ;Keep it as is. - (radix-tree-iter-subtrees - (cdr pair) (lambda (prefix subtree) - (push (cons (concat s prefix) subtree) prefixes)))))) - ;; FIXME: The expansions done below are mostly pointless, such as - ;; for `yenc', where we replace "yenc-" with an exhaustive list (5 - ;; elements). - ;; (while - ;; (let ((newprefixes nil) - ;; (changes nil)) - ;; (dolist (pair prefixes) - ;; (let ((prefix (car pair))) - ;; (if (or (> (length prefix) autoload-def-prefixes-max-length) - ;; (radix-tree-lookup (cdr pair) "")) - ;; ;; No point splitting it any further. - ;; (push pair newprefixes) - ;; (setq changes t) - ;; (radix-tree-iter-subtrees - ;; (cdr pair) (lambda (sprefix subtree) - ;; (push (cons (concat prefix sprefix) subtree) - ;; newprefixes)))))) - ;; (and changes - ;; (<= (length newprefixes) - ;; autoload-def-prefixes-max-entries) - ;; (let ((new nil) - ;; (old nil)) - ;; (dolist (pair prefixes) - ;; (unless (memq pair newprefixes) ;Not old - ;; (push pair old))) - ;; (dolist (pair newprefixes) - ;; (unless (memq pair prefixes) ;Not new - ;; (push pair new))) - ;; (cl-assert new) - ;; (message "Expanding %S to %S" - ;; (mapcar #'car old) (mapcar #'car new)) - ;; t) - ;; (setq prefixes newprefixes) - ;; (< (length prefixes) autoload-def-prefixes-max-entries)))) - - ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes)) - (when prefixes - (let ((strings - (mapcar - (lambda (x) - (let ((prefix (car x))) - (if (or (> (length prefix) 2) ;Long enough! - (and (eq (length prefix) 2) - (string-match "[[:punct:]]" prefix))) - prefix - ;; Some packages really don't follow the rules. - ;; Drop the most egregious cases such as the - ;; one-letter prefixes. - (let ((dropped ())) - (radix-tree-iter-mappings - (cdr x) (lambda (s _) - (push (concat prefix s) dropped))) - (message "%s:0: Warning: Not registering prefix \"%s\". Affects: %S" - file prefix dropped) - nil)))) - prefixes))) - `(register-definition-prefixes ,file ',(sort (delq nil strings) - 'string<)))))) +(defalias 'autoload--make-defs-autoload #'loaddefs-generate--make-prefixes) (defun autoload--setup-output (otherbuf outbuf absfile load-name output-file) (let ((outbuf @@ -687,21 +375,6 @@ Don't try to split prefixes that are already longer than that.") (defvar autoload-builtin-package-versions nil) -(defvar autoload-ignored-definitions - '("define-obsolete-function-alias" - "define-obsolete-variable-alias" - "define-category" "define-key" - "defgroup" "defface" "defadvice" - "def-edebug-spec" - ;; Hmm... this is getting ugly: - "define-widget" - "define-erc-module" - "define-erc-response-handler" - "defun-rcirc-command") - "List of strings naming definitions to ignore for prefixes. -More specifically those definitions will not be considered for the -`register-definition-prefixes' call.") - (defun autoload-generate-file-autoloads (file &optional outbuf outfile) "Insert an autoload section for FILE in the appropriate buffer. Autoloads are generated for defuns and defmacros in FILE |