[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/faster-loaddefs da7038e8ee: Flip dependency -- move needed autol
|
From: |
Lars Ingebrigtsen |
|
Subject: |
scratch/faster-loaddefs da7038e8ee: Flip dependency -- move needed autoload.el files til loaddefs-gen.el |
|
Date: |
Sun, 29 May 2022 13:40:56 -0400 (EDT) |
branch: scratch/faster-loaddefs
commit da7038e8eeb29b0d01bac7b3050430a6ffda6be0
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Flip dependency -- move needed autoload.el files til loaddefs-gen.el
After this, autoload.el functions/variables shouldn't be necessary during
an Emacs build.
---
lisp/Makefile.in | 10 +-
lisp/emacs-lisp/autoload.el | 375 +---------------------------------------
lisp/emacs-lisp/loaddefs-gen.el | 342 +++++++++++++++++++++++++++++++++++-
3 files changed, 348 insertions(+), 379 deletions(-)
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 966369c8d3..356201b5ef 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -75,10 +75,11 @@ compile-first: BYTE_COMPILE_FLAGS = \
# Files to compile before others during a bootstrap. This is done to
# speed up the bootstrap process. They're ordered by size, so we use
-# the slowest-compiler on the smallest file and move to larger files as the
-# compiler gets faster. 'autoload.elc' comes last because it is not used by
-# the compiler (so its compilation does not speed up subsequent compilations),
-# it's only placed here so as to speed up generation of the loaddefs.el file.
+# the slowest-compiler on the smallest file and move to larger files
+# as the compiler gets faster. 'loaddefs-gen.elc'/'radix-tree.el'
+# comes last because they're not used by the compiler (so its
+# compilation does not speed up subsequent compilations), it's only
+# placed here so as to speed up generation of the loaddefs.el files.
COMPILE_FIRST = \
$(lisp)/emacs-lisp/macroexp.elc \
@@ -90,7 +91,6 @@ COMPILE_FIRST += $(lisp)/emacs-lisp/comp.elc
COMPILE_FIRST += $(lisp)/emacs-lisp/comp-cstr.elc
endif
COMPILE_FIRST += $(lisp)/emacs-lisp/loaddefs-gen.elc
-COMPILE_FIRST += $(lisp)/emacs-lisp/autoload.elc
COMPILE_FIRST += $(lisp)/emacs-lisp/radix-tree.elc
# Files to compile early in compile-main. Works around bug#25556.
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index abd55338b6..76dd574ee4 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -33,6 +33,7 @@
(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 +113,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-gen--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 +222,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-gen--rubric)
(defvar autoload-ensure-writable nil
"Non-nil means `autoload-find-generated-file' makes existing file writable.")
@@ -433,36 +242,6 @@ FILE's name."
(ignore-errors (set-file-modes file (logior modes #o0200))))))
file)
-(defun autoload-insert-section-header (outbuf autoloads load-name file time)
- "Insert into buffer OUTBUF the section-header line for FILE.
-The header line lists the file name, its \"load name\", its autoloads,
-and the time the FILE was last updated (the time is inserted only
-if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)."
- ;; (cl-assert ;Make sure we don't insert it in the middle of another section.
- ;; (save-excursion
- ;; (or (not (re-search-backward
- ;; (concat "\\("
- ;; (regexp-quote generate-autoload-section-header)
- ;; "\\)\\|\\("
- ;; (regexp-quote generate-autoload-section-trailer)
- ;; "\\)")
- ;; nil t))
- ;; (match-end 2))))
- (insert generate-autoload-section-header)
- (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
- outbuf)
- (terpri outbuf)
- ;; Break that line at spaces, to avoid very long lines.
- ;; Make each sub-line into a comment.
- (with-current-buffer outbuf
- (save-excursion
- (forward-line -1)
- (while (not (eolp))
- (move-to-column 64)
- (skip-chars-forward "^ \n")
- (or (eolp)
- (insert "\n" generate-autoload-section-continuation))))))
-
(defun autoload-find-file (file)
"Fetch FILE and put it in a temp buffer. Return the buffer."
;; It is faster to avoid visiting the file.
@@ -480,35 +259,12 @@ if `autoload-timestamps' is non-nil, otherwise a fixed
fake time is inserted)."
(hack-local-variables))
(current-buffer)))
+(defalias 'autoload-insert-section-header
#'loaddefs-gen--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-gen--file-load-name)
(defun generate-file-autoloads (file)
"Insert at point a loaddefs autoload section for FILE.
@@ -522,13 +278,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-local-variable #'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 +289,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-gen--make-prefixes)
(defun autoload--setup-output (otherbuf outbuf absfile load-name output-file)
(let ((outbuf
@@ -687,21 +341,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
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index e3aed11f62..8ca2734a1c 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -42,7 +42,270 @@
;;; Code:
-(require 'autoload)
+(require 'radix-tree)
+(require 'lisp-mnt)
+
+(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-local-variable #'booleanp)
+
+
+(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 loaddefs-gen--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)))
+
+(defun loaddefs-gen--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)
+ (loaddefs-gen--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)))
+ ;; Recurse on the expansion.
+ (loaddefs-gen--make-autoload expand file '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))))
+
+(defun loaddefs-gen--make-prefixes (defs file)
+ ;; Remove the defs that obey the rule that file foo.el (or
+ ;; foo-mode.el) uses "foo-" as prefix. 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))))))
+ (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<))))))
+
(defun loaddefs-gen--parse-file (file main-outfile &optional package-only)
"Examing FILE for ;;;###autoload statements.
@@ -53,7 +316,7 @@ by ;;;###foo-autoload statements.
If PACKAGE-ONLY, only return the package info."
(let ((defs nil)
- (load-name (autoload-file-load-name file main-outfile))
+ (load-name (loaddefs-gen--file-load-name file main-outfile))
(compute-prefixes t)
local-outfile package-defs
inhibit-autoloads)
@@ -110,7 +373,8 @@ If PACKAGE-ONLY, only return the package info."
(read (current-buffer))
(unless (bolp)
(forward-line 1))))
- (autoload (or (make-autoload form load-name) form)))
+ (autoload (or (loaddefs-gen--make-autoload form
load-name)
+ form)))
;; We get back either an autoload form, or a tree
;; structure of `(progn ...)' things, so unravel that.
(let ((forms (if (eq (car autoload) 'progn)
@@ -177,7 +441,7 @@ If PACKAGE-ONLY, only return the package info."
(forward-line -1)
(not (looking-at ";;;###autoload")))))
(push name prefs)))))
- (autoload--make-defs-autoload prefs load-name)))
+ (loaddefs-gen--make-prefixes prefs load-name)))
(defun loaddefs-gen--prettify-autoload (autoload)
;; FIXME: All this is just to emulate the current look -- it should
@@ -215,6 +479,72 @@ If PACKAGE-ONLY, only return the package info."
(insert "\n")
(buffer-string)))
+(defun loaddefs-gen--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")))
+
+(defun loaddefs-gen--insert-section-header (outbuf autoloads load-name file
time)
+ "Insert into buffer OUTBUF the section-header line for FILE.
+The header line lists the file name, its \"load name\", its autoloads,
+and the time the FILE was last updated (the time is inserted only
+if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)."
+ ;; (cl-assert ;Make sure we don't insert it in the middle of another section.
+ ;; (save-excursion
+ ;; (or (not (re-search-backward
+ ;; (concat "\\("
+ ;; (regexp-quote generate-autoload-section-header)
+ ;; "\\)\\|\\("
+ ;; (regexp-quote generate-autoload-section-trailer)
+ ;; "\\)")
+ ;; nil t))
+ ;; (match-end 2))))
+ (insert "\f\n;;;### ")
+ (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
+ outbuf)
+ (terpri outbuf)
+ ;; Break that line at spaces, to avoid very long lines.
+ ;; Make each sub-line into a comment.
+ (with-current-buffer outbuf
+ (save-excursion
+ (forward-line -1)
+ (while (not (eolp))
+ (move-to-column 64)
+ (skip-chars-forward "^ \n")
+ (or (eolp)
+ (insert "\n" ";;;;;; "))))))
+
(defun loaddefs-gen--generate (dir output-file &optional excluded-files)
"Generate loaddefs files for Lisp files in the directories DIRS.
DIR can be either a single directory or a list of
@@ -261,7 +591,7 @@ directory or directories specified."
;; Generate the loaddef files. First group per output file.
(dolist (fdefs (seq-group-by #'car defs))
(with-temp-buffer
- (insert (autoload-rubric (car fdefs) nil t))
+ (insert (loaddefs-gen--rubric (car fdefs) nil t))
(search-backward "\f")
;; The group by source file (and sort alphabetically).
(dolist (section (sort (seq-group-by #'cadr (cdr fdefs))
@@ -275,7 +605,7 @@ directory or directories specified."
(let ((relfile (file-relative-name
(cadar section)
(file-name-directory (car fdefs)))))
- (autoload-insert-section-header
+ (loaddefs-gen--insert-section-header
(current-buffer) nil
(file-name-sans-extension
(file-name-nondirectory relfile))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- scratch/faster-loaddefs da7038e8ee: Flip dependency -- move needed autoload.el files til loaddefs-gen.el,
Lars Ingebrigtsen <=