[Emacs-diffs] master e971ce6: Make autoloads populate a new definition-prefixes table

[Stefan Monnier]

branch: master
commit e971ce6de27f982720ef312637e1d40da80e8d1f
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    Make autoloads populate a new definition-prefixes table
    
    * lisp/subr.el (definition-prefixes): New hash table.
    (register-definition-prefixes): New function.
    
    * lisp/emacs-lisp/autoload.el (autoload-compute-prefixes): New var.
    (autoload--split-prefixes-1, autoload--split-prefixes)
    (autoload--make-defs-autoload): New functions.
    (autoload-defs-autoload-max-size, autoload-popular-prefixes): New vars.
    (autoload-generate-file-autoloads): Obey autoload-compute-prefixes.
    (update-directory-autoloads): Don't touch loaddefs.el if the set of
    autoloads hasn't changed (i.e. if only the timestamp would change).
    
    * lisp/loadup.el: Purify definition-prefixes.
    
    * lisp/w32-fns.el: Keep name space clean.
    (w32-set-default-process-coding-system): Rename from
    set-default-process-coding-system.
    (w32-set-system-coding-system): Rename from set-w32-system-coding-system.
---
 lisp/emacs-lisp/autoload.el |  196 +++++++++++++++++++++++++++++++++++++++----
 lisp/loadup.el              |    6 ++
 lisp/subr.el                |   11 +++
 lisp/w32-fns.el             |   11 ++-
 4 files changed, 205 insertions(+), 19 deletions(-)

diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index aedee8c..80f5c28 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -183,10 +183,12 @@ expression, in which case we want to handle forms 
differently."
             (args (pcase car
                      ((or `defun `defmacro
                           `defun* `defmacro* `cl-defun `cl-defmacro
-                          `define-overloadable-function) (nth 2 form))
+                          `define-overloadable-function)
+                      (nth 2 form))
                      (`define-skeleton '(&optional str arg))
                      ((or `define-generic-mode `define-derived-mode
-                          `define-compilation-mode) nil)
+                          `define-compilation-mode)
+                      nil)
                      (_ t)))
             (body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
             (doc (if (stringp (car body)) (pop body))))
@@ -202,7 +204,8 @@ expression, in which case we want to handle forms 
differently."
                                   define-global-minor-mode
                                   define-globalized-minor-mode
                                   easy-mmode-define-minor-mode
-                                  define-minor-mode)) t)
+                                  define-minor-mode))
+                     t)
                 (eq (car-safe (car body)) 'interactive))
            ,(if macrop ''macro nil))))
 
@@ -313,7 +316,7 @@ The variable `autoload-print-form-outbuf' specifies the 
buffer to
 put the output in."
   (cond
    ;; If the form is a sequence, recurse.
-   ((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form)))
+   ((eq (car form) 'progn) (mapcar #'autoload-print-form (cdr form)))
    ;; Symbols at the toplevel are meaningless.
    ((symbolp form) nil)
    (t
@@ -413,6 +416,16 @@ make it writable."
 (defun autoload-insert-section-header (outbuf autoloads load-name file time)
   "Insert the section-header line,
 which lists the file name and which functions are in it, etc."
+  ;; (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)
@@ -471,7 +484,7 @@ which lists the file name and which functions are in it, 
etc."
         ;; 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 "/")))))
+       (t (setq name (mapconcat #'identity names "/")))))
     (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
         (substring name 0 (match-beginning 0))
       name)))
@@ -487,8 +500,93 @@ Return non-nil in the case where no autoloads were added 
at point."
   (let ((generated-autoload-file buffer-file-name))
     (autoload-generate-file-autoloads file (current-buffer))))
 
-(defvar print-readably)
-
+(defun autoload--split-prefixes-1 (strs)
+  (let ((prefixes ()))
+    (dolist (str strs)
+      (string-match "\\`[^-:/_]*[-:/_]*" str)
+      (let* ((prefix (match-string 0 str))
+             (tail (substring str (match-end 0)))
+             (cell (assoc prefix prefixes)))
+        (cond
+         ((null cell) (push (list prefix tail) prefixes))
+         ((equal (cadr cell) tail) nil)
+         (t (setcdr cell (cons tail (cdr cell)))))))
+    prefixes))
+
+(defun autoload--split-prefixes (prefixes)
+  (apply #'nconc
+         (mapcar (lambda (cell)
+                   (let ((prefix (car cell)))
+                     (mapcar (lambda (cell)
+                               (cons (concat prefix (car cell)) (cdr cell)))
+                             (autoload--split-prefixes-1 (cdr cell)))))
+                 prefixes)))
+
+(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.")
+
+(defconst autoload-defs-autoload-max-size 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
+memory, we'll end up looking in too many files when we need a particular
+prefix), and if set too large, they will be too specific (i.e. they will
+cost more memory use).")
+
+(defvar autoload-popular-prefixes nil)
+
+(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 ((prefixes (autoload--split-prefixes-1 defs))
+        (again t))
+    ;; (message "Initial prefixes %s : %S" file (mapcar #'car prefixes))
+    (while again
+      (setq again nil)
+      (let ((newprefixes
+             (sort
+              (mapcar (lambda (cell)
+                        (cons cell
+                              (autoload--split-prefixes-1 (cdr cell))))
+                      prefixes)
+              (lambda (x y) (< (length (cdr x)) (length (cdr y)))))))
+        (setq prefixes nil)
+        (while newprefixes
+          (let ((x (pop newprefixes)))
+            (if (or (equal '("") (cdar x))
+                    (and (cddr x)
+                         (not (member (caar x)
+                                      autoload-popular-prefixes))
+                         (> (+ (length prefixes) (length newprefixes)
+                               (length (cdr x)))
+                            autoload-defs-autoload-max-size)))
+                ;; Nothing to split or would split too deep.
+                (push (car x) prefixes)
+              ;; (message "Expand %S to %S" (caar x) (cdr x))
+              (setq again t)
+              (setq prefixes
+                    (nconc (mapcar (lambda (cell)
+                                     (cons (concat (caar x)
+                                                   (car cell))
+                                           (cdr cell)))
+                                   (cdr x))
+                           prefixes)))))))
+    ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
+    (when prefixes
+      `(if (fboundp 'register-definition-prefixes)
+           (register-definition-prefixes ,file ',(mapcar #'car prefixes))))))
 
 (defun autoload--setup-output (otherbuf outbuf absfile load-name)
   (let ((outbuf
@@ -566,11 +664,11 @@ FILE's modification time."
       (let (load-name
             (print-length nil)
             (print-level nil)
-            (print-readably t)           ; This does something in Lucid Emacs.
             (float-output-format nil)
             (visited (get-file-buffer file))
             (otherbuf nil)
             (absfile (expand-file-name file))
+          (defs '())
             ;; nil until we found a cookie.
             output-start)
         (when
@@ -629,13 +727,73 @@ FILE's modification time."
                           ;; Don't read the comment.
                           (forward-line 1))
                          (t
+                  ;; Avoid (defvar <foo>) by requiring a trailing space.
+                  ;; Also, ignore this prefix business
+                  ;; for ;;;###tramp-autoload and friends.
+                  (when (and (equal generate-autoload-cookie ";;;###autoload")
+                             (looking-at "(\\(def[^ ]+\\) ['(]*\\([^' 
()\"\n]+\\)[\n \t]")
+                             (not (member
+                                   (match-string 1)
+                                   '("define-obsolete-function-alias"
+                                     "define-obsolete-variable-alias"
+                                     "define-category" "define-key"
+                                     "defgroup" "defface" "defadvice"
+                                     ;; Hmm... this is getting ugly:
+                                     "define-widget"
+                                     "defun-rcirc-command"))))
+                    (push (match-string 2) defs))
                           (forward-sexp 1)
                           (forward-line 1))))))
 
+          (when (and autoload-compute-prefixes defs)
+            ;; This output needs to always go in the main loaddefs.el,
+            ;; regardless of generated-autoload-file.
+            ;; FIXME: the files that don't have autoload cookies but
+            ;; do have definitions end up listed twice in loaddefs.el:
+            ;; once for their register-definition-prefixes and once in
+            ;; the list of "files without any autoloads".
+            (let ((form (autoload--make-defs-autoload defs load-name)))
+              (cond
+               ((null form))             ;All defs obey the default rule, yay!
+               ((not otherbuf)
+                (unless output-start
+                  (setq output-start (autoload--setup-output
+                                      nil outbuf absfile load-name)))
+                (let ((autoload-print-form-outbuf
+                       (marker-buffer output-start)))
+                  (autoload-print-form form)))
+               (t
+                (let* ((other-output-start
+                        ;; To force the output to go to the main loaddefs.el
+                        ;; rather than to generated-autoload-file,
+                        ;; there are two cases: if outbuf is non-nil,
+                        ;; then passing otherbuf=nil is enough, but if
+                        ;; outbuf is nil, that won't cut it, so we
+                        ;; locally bind generated-autoload-file.
+                        (let ((generated-autoload-file
+                               (default-value 'generated-autoload-file)))
+                          (autoload--setup-output nil outbuf absfile 
load-name)))
+                       (autoload-print-form-outbuf
+                        (marker-buffer other-output-start)))
+                  (autoload-print-form form)
+                  (with-current-buffer (marker-buffer other-output-start)
+                    (save-excursion
+                      ;; Insert the section-header line which lists
+                      ;; the file name and which functions are in it, etc.
+                      (goto-char other-output-start)
+                      (let ((relfile (file-relative-name absfile)))
+                        (autoload-insert-section-header
+                         (marker-buffer other-output-start)
+                         "actual autoloads are elsewhere" load-name relfile
+                         (nth 5 (file-attributes absfile)))
+                        (insert ";;; Generated autoloads from " relfile "\n")))
+                    (insert generate-autoload-section-trailer)))))))
+
                   (when output-start
                     (let ((secondary-autoloads-file-buf
                            (if otherbuf (current-buffer))))
                       (with-current-buffer (marker-buffer output-start)
+                        (cl-assert (> (point) output-start))
                         (save-excursion
                           ;; Insert the section-header line which lists the 
file name
                           ;; and which functions are in it, etc.
@@ -827,12 +985,13 @@ write its autoloads into the specified file instead."
                     (dolist (suf (get-load-suffixes))
                       (unless (string-match "\\.elc" suf) (push suf tmp)))
                      (concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
-        (files (apply 'nconc
+        (files (apply #'nconc
                       (mapcar (lambda (dir)
                                 (directory-files (expand-file-name dir)
                                                  t files-re))
                               dirs)))
-         (done ())
+         (done ())                      ;Files processed; to remove duplicates.
+         (changed nil)                  ;Non-nil if some change occured.
         (last-time)
          ;; Files with no autoload cookies or whose autoloads go to other
          ;; files because of file-local autoload-generated-file settings.
@@ -850,7 +1009,7 @@ write its autoloads into the specified file instead."
       (save-excursion
        ;; Canonicalize file names and remove the autoload file itself.
        (setq files (delete (file-relative-name buffer-file-name)
-                           (mapcar 'file-relative-name files)))
+                           (mapcar #'file-relative-name files)))
 
        (goto-char (point-min))
        (while (search-forward generate-autoload-section-header nil t)
@@ -878,6 +1037,7 @@ write its autoloads into the specified file instead."
                        ;; If the file is actually excluded.
                        (member (expand-file-name file) autoload-excludes))
                    ;; Remove the obsolete section.
+                   (setq changed t)
                   (autoload-remove-section (match-beginning 0)))
                  ((not (time-less-p (let ((oldtime (nth 4 form)))
                                       (if (member oldtime
@@ -889,6 +1049,7 @@ write its autoloads into the specified file instead."
                   ;; File hasn't changed.
                   nil)
                  (t
+                   (setq changed t)
                    (autoload-remove-section (match-beginning 0))
                    (if (autoload-generate-file-autoloads
                         ;; Passing `current-buffer' makes it insert at point.
@@ -908,7 +1069,8 @@ write its autoloads into the specified file instead."
                  (autoload-generate-file-autoloads file nil buffer-file-name))
            (push file no-autoloads)
            (if (time-less-p no-autoloads-time file-time)
-               (setq no-autoloads-time file-time)))))
+               (setq no-autoloads-time file-time)))
+           (t (setq changed t))))
 
        (when no-autoloads
          ;; Sort them for better readability.
@@ -922,8 +1084,12 @@ write its autoloads into the specified file instead."
                                                   autoload--non-timestamp))
          (insert generate-autoload-section-trailer)))
 
-      (let ((version-control 'never))
-       (save-buffer))
+      ;; Don't modify the file if its content has not been changed, so `make'
+      ;; dependencies don't trigger unnecessarily.
+      (when changed
+        (let ((version-control 'never))
+          (save-buffer)))
+
       ;; In case autoload entries were added to other files because of
       ;; file-local autoload-generated-file settings.
       (autoload-save-buffers))))
@@ -955,7 +1121,7 @@ should be non-nil)."
                (push (expand-file-name file) autoload-excludes)))))))
   (let ((args command-line-args-left))
     (setq command-line-args-left nil)
-    (apply 'update-directory-autoloads args)))
+    (apply #'update-directory-autoloads args)))
 
 (provide 'autoload)
 
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 53fc221..db3c36d 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -161,6 +161,12 @@
   ;; In case loaddefs hasn't been generated yet.
   (file-error (load "ldefs-boot.el")))
 
+(let ((new (make-hash-table :test 'equal)))
+  ;; Now that loaddefs has populated definition-prefixes, purify its contents.
+  (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new))
+           definition-prefixes)
+  (setq definition-prefixes new))
+
 (load "emacs-lisp/nadvice")
 (load "emacs-lisp/cl-preloaded")
 (load "minibuffer")            ;After loaddefs, for define-minor-mode.
diff --git a/lisp/subr.el b/lisp/subr.el
index 438f00a..b5d6f6f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -5150,6 +5150,17 @@ as a list.")
 
 
 ;;; Misc.
+
+(defvar definition-prefixes (make-hash-table :test 'equal)
+  "Hash table mapping prefixes to the files in which they're used.
+This can be used to automatically fetch not-yet-loaded definitions.")
+
+(defun register-definition-prefixes (file prefixes)
+  "Register that FILE uses PREFIXES."
+  (dolist (prefix prefixes)
+    (puthash prefix (cons file (gethash prefix definition-prefixes))
+             definition-prefixes)))
+
 (defconst menu-bar-separator '("--")
   "Separator for menus.")
 
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 690a990..4815f4b 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -121,7 +121,7 @@ You should set this to t when using a non-system 
shell.\n\n"))))
 (add-hook 'after-init-hook 'w32-check-shell-configuration)
 
 ;; Override setting chosen at startup.
-(defun set-default-process-coding-system ()
+(defun w32-set-default-process-coding-system ()
   ;; Most programs on Windows will accept Unix line endings on input
   ;; (and some programs ported from Unix require it) but most will
   ;; produce DOS line endings on output.
@@ -142,8 +142,9 @@ You should set this to t when using a non-system 
shell.\n\n"))))
                 . ,(if (default-value 'enable-multibyte-characters)
                        '(undecided-dos . undecided-dos)
                      '(raw-text-dos . raw-text-dos)))))
-
-(add-hook 'before-init-hook 'set-default-process-coding-system)
+(define-obsolete-function-alias 'set-default-process-coding-system
+  #'w32-set-default-process-coding-system "26.1")
+(add-hook 'before-init-hook #'w32-set-default-process-coding-system)
 
 
 ;;; Basic support functions for managing Emacs's locale setting
@@ -217,7 +218,7 @@ names."
        (setq start (match-end 0)))
       name)))
 
-(defun set-w32-system-coding-system (coding-system)
+(defun w32-set-system-coding-system (coding-system)
   "Set the coding system used by the Windows system to CODING-SYSTEM.
 This is used for things like passing font names with non-ASCII
 characters in them to the system.  For a list of possible values of
@@ -233,6 +234,8 @@ This function is provided for backward compatibility, since
             default))))
   (check-coding-system coding-system)
   (setq locale-coding-system coding-system))
+(define-obsolete-function-alias 'set-w32-system-coding-system
+  #'w32-set-system-coding-system "26.1")
 
 ;; locale-coding-system was introduced to do the same thing as
 ;; w32-system-coding-system. Use that instead.