scratch/faster-loaddefs 046ccbe701 1/7: Initial version

[Lars Ingebrigtsen]

branch: scratch/faster-loaddefs
commit 046ccbe701f135cbbf2c607eaee81d6553f7f547
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Initial version
---
 lisp/Makefile.in                |  68 +---------
 lisp/emacs-lisp/loaddefs-gen.el | 294 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 298 insertions(+), 64 deletions(-)

diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index fabf6ed55e..966369c8d3 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -59,15 +59,6 @@ BYTE_COMPILE_EXTRA_FLAGS =
 # BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not 
unresolved)))'
 # The example above is just for developers, it should not be used by default.
 
-# Those automatically generated autoload files that need special rules
-# to build; i.e. not including things created via generated-autoload-file
-# (eg calc/calc-loaddefs.el).
-LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \
-       $(lisp)/calendar/diary-loaddefs.el \
-       $(lisp)/calendar/hol-loaddefs.el \
-       $(lisp)/mh-e/mh-loaddefs.el \
-       $(lisp)/net/tramp-loaddefs.el
-
 # All generated autoload files.
 loaddefs = $(shell find ${srcdir} -name '*loaddefs.el' ! -name '.*')
 # Elisp files auto-generated.
@@ -98,7 +89,9 @@ ifeq ($(HAVE_NATIVE_COMP),yes)
 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.
 MAIN_FIRST = ./emacs-lisp/eieio.el ./emacs-lisp/eieio-base.el \
@@ -195,10 +188,8 @@ $(lisp)/finder-inf.el:
 autoloads .PHONY: $(lisp)/loaddefs.el
 $(lisp)/loaddefs.el: gen-lisp $(LOADDEFS)
        $(AM_V_GEN)$(emacs) -l autoload \
-           --eval '(setq autoload-ensure-writable t)' \
-           --eval '(setq autoload-builtin-package-versions t)' \
-           --eval '(setq generated-autoload-file (expand-file-name 
(unmsys--file-name "$@")))' \
-           -f batch-update-autoloads ${SUBDIRS_ALMOST}
+            -l $(lisp)/emacs-lisp/loaddefs-gen.elc \
+           -f batch-loaddefs-gen ${SUBDIRS_ALMOST}
 
 # autoloads only runs when loaddefs.el is nonexistent, although it
 # generates a number of different files. Provide a force option to enable
@@ -456,57 +447,6 @@ compile-one-process: $(LOADDEFS) compile-first
        $(emacs) $(BYTE_COMPILE_FLAGS) \
            --eval "(batch-byte-recompile-directory 0)" $(lisp)
 
-# Update MH-E internal autoloads. These are not to be confused with
-# the autoloads for the MH-E entry points, which are already in loaddefs.el.
-MH_E_DIR = $(lisp)/mh-e
-MH_E_SRC = $(sort $(wildcard ${MH_E_DIR}/mh*.el))
-MH_E_SRC := $(filter-out ${MH_E_DIR}/mh-loaddefs.el,${MH_E_SRC})
-
-.PHONY: mh-autoloads
-mh-autoloads: $(MH_E_DIR)/mh-loaddefs.el
-$(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC)
-       $(AM_V_GEN)$(emacs) -l autoload \
-          --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \
-          --eval "(setq generated-autoload-file (expand-file-name 
(unmsys--file-name \"$@\")))" \
-          -f batch-update-autoloads $(MH_E_DIR)
-
-# Update TRAMP internal autoloads. Maybe we could move tramp*.el into
-# an own subdirectory. OTOH, it does not hurt to keep them in
-# lisp/net.
-TRAMP_DIR = $(lisp)/net
-TRAMP_SRC = $(sort $(wildcard ${TRAMP_DIR}/tramp*.el))
-TRAMP_SRC := $(filter-out ${TRAMP_DIR}/tramp-loaddefs.el,${TRAMP_SRC})
-
-$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC)
-       $(AM_V_GEN)$(emacs) -l autoload \
-          --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \
-          --eval "(setq generated-autoload-file (expand-file-name 
(unmsys--file-name \"$@\")))" \
-          -f batch-update-autoloads $(TRAMP_DIR)
-
-CAL_DIR = $(lisp)/calendar
-## Those files that may contain internal calendar autoload cookies.
-CAL_SRC = $(addprefix ${CAL_DIR}/,diary-lib.el holidays.el lunar.el solar.el)
-CAL_SRC := $(sort ${CAL_SRC} $(wildcard ${CAL_DIR}/cal-*.el))
-CAL_SRC := $(filter-out ${CAL_DIR}/cal-loaddefs.el,${CAL_SRC})
-
-$(CAL_DIR)/cal-loaddefs.el: $(CAL_SRC)
-       $(AM_V_GEN)$(emacs) -l autoload \
-          --eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \
-          --eval "(setq generated-autoload-file (expand-file-name 
(unmsys--file-name \"$@\")))" \
-          -f batch-update-autoloads $(CAL_DIR)
-
-$(CAL_DIR)/diary-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/cal-loaddefs.el
-       $(AM_V_GEN)$(emacs) -l autoload \
-          --eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \
-          --eval "(setq generated-autoload-file (expand-file-name 
(unmsys--file-name \"$@\")))" \
-          -f batch-update-autoloads $(CAL_DIR)
-
-$(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/diary-loaddefs.el
-       $(AM_V_GEN)$(emacs) -l autoload \
-          --eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \
-          --eval "(setq generated-autoload-file (expand-file-name 
(unmsys--file-name \"$@\")))" \
-          -f batch-update-autoloads $(CAL_DIR)
-
 .PHONY: bootstrap-clean distclean maintainer-clean
 
 bootstrap-clean:
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
new file mode 100644
index 0000000000..401f66aed4
--- /dev/null
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -0,0 +1,294 @@
+;;; loaddefs-gen.el --- generate loaddefs.el files  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Keywords: maint
+;; Package: emacs
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package generates the main lisp/loaddefs.el file, as well as
+;; all the other loaddefs files, like calendar/diary-loaddefs.el, etc.
+
+;; The main entry point is `loaddefs-gen--generate' (normally called
+;; from batch-loaddefs-gen via lisp/Makefile).
+;;
+;; The "other" loaddefs files are specified either via a file-local
+;; setting of `generated-autoload-file', or by specifying
+;;
+;;   ;;;###foo-autoload
+;;
+;; This makes the autoload go to foo-loaddefs.el in the current directory.
+;; Normal ;;;###autoload specs go to the main loaddefs file.
+
+;;; Code:
+
+(require 'autoload)
+
+(defun loaddefs-gen--parse-file (file main-outfile)
+  "Examing FILE for ;;;###autoload statements.
+MAIN-OUTFILE is the main loaddefs file these statements are
+destined for, but this can be overriden by the buffer-local
+setting of `generated-autoload-file' in FILE, and
+by ;;;###foo-autoload statements."
+  (let ((defs nil)
+        (regexp "^;;;###\\([-a-z0-9A-Z]+\\)?autoload")
+        (load-name (autoload-file-load-name file main-outfile))
+        local-outfile inhibit-prefs package-defs
+        inhibit-autoloads)
+    (with-temp-buffer
+      (insert-file-contents file)
+      (goto-char (point-max))
+      ;; We "open-code" this version of `hack-local-variables',
+      ;; because it's really slow in bootstrap-emacs.
+      (when (search-backward ";; Local Variables:" (- (point-max) 1000) t)
+        (save-excursion
+          (when (re-search-forward "generated-autoload-file: *" nil t)
+            ;; Buffer-local file that should be interpreted relative to
+            ;; the .el file.
+            (setq local-outfile (expand-file-name (read (current-buffer))
+                                                  (file-name-directory 
file)))))
+        (save-excursion
+          (when (re-search-forward "generated-autoload-load-name: *" nil t)
+            (setq load-name (read (current-buffer)))))
+        (when (re-search-forward "no-update-autoloads: *" nil t)
+          (setq inhibit-autoloads (read (current-buffer)))))
+
+      ;; Obey the no-update-autoloads file local variable.
+      (unless inhibit-autoloads
+        (when autoload-builtin-package-versions
+          (let ((version (lm-header "version"))
+                package)
+            (when (and version
+                       (setq version (ignore-errors (version-to-list version)))
+                       (setq package (or (lm-header "package")
+                                         (file-name-sans-extension
+                                          (file-name-nondirectory file)))))
+              ;; FIXME: Push directly to defs.
+              (setq package-defs
+                    `(push (purecopy ',(cons (intern package) version))
+                           package--builtin-versions)))))
+
+        (goto-char (point-min))
+        ;; The cookie might be like ;;;###tramp-autoload...
+        (while (re-search-forward regexp nil t)
+          ;; ... and if we have one of these names, then alter outfile.
+          (let* ((aname (match-string 1))
+                 (to-file (if aname
+                              (expand-file-name
+                               (concat aname "loaddefs.el")
+                               (file-name-directory file))
+                            (or local-outfile main-outfile))))
+            (when aname
+              (setq inhibit-prefs t))
+            (if (eolp)
+                ;; We have a form following.
+                (let* ((form (prog1
+                                 (read (current-buffer))
+                               (unless (bolp)
+                                 (forward-line 1))))
+                       (autoload (make-autoload form load-name)))
+                  (if (not autoload)
+                      ;; It's was not transformed to an autoload spec;
+                      ;; add as is.
+                      (push (list to-file file
+                                  (loaddefs-gen--prettify-autoload form))
+                            defs)
+                    ;; We get back either an autoload form, or a tree
+                    ;; structure of `(progn ...)' things, so unravel that.
+                    (let ((forms (if (eq (car autoload) 'progn)
+                                     (cdr autoload)
+                                   (list autoload))))
+                      (while forms
+                        (let ((elem (pop forms)))
+                          (if (eq (car elem) 'progn)
+                              ;; More recursion; push it to the end.
+                              (setq forms (nconc forms (cdr elem)))
+                            ;; We have something to add to the defs; do it.
+                            (push (list to-file file
+                                        (loaddefs-gen--prettify-autoload elem))
+                                  defs)))))))
+              ;; Just put the rest of the line into the loaddefs.
+              (push (list to-file file
+                          (buffer-substring (point) (line-end-position)))
+                    defs)))))
+
+      (when (and autoload-compute-prefixes (not inhibit-prefs))
+        (goto-char (point-min))
+        (let ((prefs nil))
+          ;; Avoid (defvar <foo>) by requiring a trailing space.
+          (while (re-search-forward
+                  "^(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
+            (unless (member (match-string 1) autoload-ignored-definitions)
+              (let ((name (match-string-no-properties 2)))
+                (when (save-excursion
+                        (goto-char (match-beginning 0))
+                        (or (bobp)
+                            (progn
+                              (forward-line -1)
+                              (not (looking-at regexp)))))
+                  (push name prefs)))))
+          ;; This output needs to always go in the main loaddefs.el,
+          ;; regardless of `generated-autoload-file'.
+          (let ((form (autoload--make-defs-autoload prefs load-name)))
+            (cond
+             ((null form))       ;All defs obey the default rule, yay!
+             (t
+              (push (list main-outfile file form) defs)))))))
+
+    (if package-defs
+        (nconc defs (list (list (or local-outfile main-outfile) file
+                                package-defs)))
+      defs)))
+
+(defun loaddefs-gen--prettify-autoload (autoload)
+  (with-temp-buffer
+    (prin1 autoload (current-buffer) t)
+    (goto-char (point-min))
+    (when (looking-at-p "(autoload\\|(defvar\\|(defconst")
+      (forward-char 1)
+      (ignore-errors
+        (forward-sexp 3)
+        (skip-chars-forward " "))
+      (when (looking-at-p "\"")
+        (save-excursion
+          (forward-char 1)
+          (insert "\\\n"))
+        (narrow-to-region (point)
+                          (progn
+                            (forward-sexp 1)
+                            (point)))
+        (goto-char (point-min))
+        (while (search-forward "\n(" nil t)
+          (replace-match "\n\\(" t t))
+        (widen)))
+    (buffer-string)))
+
+(defun loaddefs-gen--generate (dir output-file &optional exclude-files)
+  "Generate loaddefs files for Lisp files in the directories DIRS.
+DIR can be either a single directory or a list of
+directories.
+
+The autoloads will be written to OUTPUT-FILE.  If any Lisp file
+binds `generated-autoload-file' as a file-local variable, write
+its autoloads into the specified file instead.
+
+The function does NOT recursively descend into subdirectories of the
+directory or directories specified."
+  (let* ((files-re (let ((tmp nil))
+                    (dolist (suf (get-load-suffixes))
+                       ;; We don't use module-file-suffix below because
+                       ;; we don't want to depend on whether Emacs was
+                       ;; built with or without modules support, nor
+                       ;; what is the suffix for the underlying OS.
+                      (unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf)
+                         (push suf tmp)))
+                     (concat "\\`[^=.].*" (regexp-opt tmp t) "\\'")))
+        (files (apply #'nconc
+                      (mapcar (lambda (d)
+                                (directory-files (expand-file-name d)
+                                                  t files-re))
+                              (if (consp dir) dir (list dir)))))
+         (defs nil))
+
+    ;; Collect all the autoload data.
+    (let ((progress (make-progress-reporter
+                     (byte-compile-info
+                      (concat "Scraping files for autoloads"))
+                     0 (length files) nil 10))
+          (file-count 0))
+      (dolist (file files)
+        ;; Do not insert autoload entries for excluded files.
+        (progress-reporter-update progress (setq file-count (1+ file-count)))
+        (unless (member (expand-file-name file) exclude-files)
+          (setq defs (nconc
+                     (loaddefs-gen--parse-file file output-file)
+                      defs))))
+      (progress-reporter-done progress))
+
+    ;; 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))
+        (search-backward "\f")
+        ;; The group by source file (and sort alphabetically).
+        (dolist (section (sort (seq-group-by #'cadr (cdr fdefs))
+                               (lambda (e1 e2)
+                                 (string<
+                                  (file-name-sans-extension
+                                   (file-name-nondirectory (car e1)))
+                                  (file-name-sans-extension
+                                   (file-name-nondirectory (car e2)))))))
+          (pop section)
+          (let ((relfile (file-relative-name
+                          (cadar section)
+                          (file-name-directory (car fdefs)))))
+            (autoload-insert-section-header
+             (current-buffer) nil
+             (file-name-sans-extension
+              (file-name-nondirectory relfile))
+             relfile '(0 0 0 0))
+            (insert ";;; Generated autoloads from " relfile "\n\n")
+            (dolist (def (reverse section))
+              (setq def (caddr def))
+              (if (stringp def)
+                  (princ def (current-buffer))
+                (prin1 def (current-buffer) t))
+              (ensure-empty-lines 1))
+            (insert ";;;***\n")))
+        ;; FIXME: Remove.
+        (goto-char (point-min))
+        (while (re-search-forward
+                "^;;; Generated autoloads.*\n\\(\n\\)(push" nil t)
+          (goto-char (match-end 1))
+          (delete-char -1))
+        (write-region (point-min) (point-max) (car fdefs) nil 'silent)
+        (byte-compile-info (file-relative-name (car fdefs) lisp-directory)
+                           t "GEN")))))
+
+(defun loaddefs-gen--excluded-files ()
+  ;; Exclude those files that are preloaded on ALL platforms.
+  ;; These are the ones in loadup.el where "(load" is at the start
+  ;; of the line (crude, but it works).
+  (let ((default-directory (file-name-directory lisp-directory))
+        (excludes nil)
+       file)
+    (with-temp-buffer
+      (insert-file-contents "loadup.el")
+      (while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t)
+       (setq file (match-string 1))
+       (or (string-match "\\.el\\'" file)
+           (setq file (format "%s.el" file)))
+       (or (string-match "\\`site-" file)
+           (push (expand-file-name file) excludes))))
+    ;; Don't scan ldefs-boot.el, either.
+    (cons (expand-file-name "ldefs-boot.el") excludes)))
+
+;;;###autoload
+(defun batch-loaddefs-gen ()
+  "Generate lisp/loaddefs.el autoloads in batch mode."
+  ;; For use during the Emacs build process only.
+  (let ((args command-line-args-left))
+    (setq command-line-args-left nil)
+    (let ((autoload-builtin-package-versions t))
+      (loaddefs-gen--generate
+       args "loaddefs.el" (loaddefs-gen--excluded-files)))))
+
+(provide 'loaddefs-gen)
+
+;;; loaddefs-gen.el ends here