bug#73792: 30; Confusion in loaddefs-generate--*-prefixes

[Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 2738 bytes --]

> This comment confused me
>
> ,----
> | (defun loaddefs-generate--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))
> `----
>
> as I could not see anything being removed here.
>
> Digging through history I learned this comment was lifted from older
> code shown below and removed in 1d4e90341782030cc7d8c29c639450b079587908,
> where it was followed by commented code that would actually have done
> that.

Yup, the comment applied to some earlier version of the code, sorry.

> And now for something completely different... (As in "here you might
> want to *add* a comment" ;P )
>
> loaddefs-generate--compute-prefixes ignores definitions with an
> autoload cookie:
>
> ,----
> |             (when (save-excursion
> |                     (goto-char (match-beginning 0))
> |                     (or (bobp)
> |                         (progn
> |                           (forward-line -1)
> |                           (not (looking-at ";;;###autoload")))))
> |               (push name prefs))))))
> `----
>
> Why?!

The "symbol prefix" machinery is designed so as to try and give easier
access to those things that Emacs wouldn't know about with it
(i.e. symbols that exist "out there" in some installed packaged but
aren't yet represented in `obarray`).

Autoloaded functions are presumably already represented in `obarray`
even if the file hasn't yet been loaded.  Admittedly, this is not 100%
sure, but that's the reason why the code thinks it can ignore them.

As for "why bother", well it turns out that it's not completely uncommon
for a package's autoloaded functions to fall outside of the prefix
shared by all other definitions, so skipping them can help improve the
prefix.  Examples would be `run-foo` commands where all other functions
use the `foo-` prefix, or even just the common `foo` entry point where
all other definitions use the `foo-` prefix.

> I might overlook something, but it seems that the old implementation
> in pre-1d4e90341782030cc7d8c29c639450b079587908 autoloads.el didn't
> do that.

I'm pretty sure it did (based on my recollection of the timing: most of
the experiments and design of the functionality happened before the
move to `loaddefs-gen.el`), tho I haven't bothered to look at the code.

BTW, I've played with a slightly different code, tho I haven't yet
finalized it.  See patch below.


        Stefan

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: loaddefs.patch --]
[-- Type: text/x-diff, Size: 13006 bytes --]

diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 50e90cdf94c..5ed8f60f241 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -90,7 +90,7 @@ generated-autoload-file
 The autoload file is assumed to contain a trailer starting with a
 FormFeed character.")
 ;;;###autoload
-(put 'generated-autoload-file 'safe-local-variable 'stringp)
+(put 'generated-autoload-file 'safe-local-variable #'stringp)
 
 (defvar generated-autoload-load-name nil
   "Load name for `autoload' statements generated from autoload cookies.
@@ -99,7 +99,7 @@ generated-autoload-load-name
 is not in `load-path'.
 This also affects the generated cus-load.el file.")
 ;;;###autoload
-(put 'generated-autoload-load-name 'safe-local-variable 'stringp)
+(put 'generated-autoload-load-name 'safe-local-variable #'stringp)
 
 (defun loaddefs-generate--file-load-name (file outfile)
   "Compute the name that will be used to load FILE.
@@ -325,54 +325,103 @@ loaddefs-generate--make-autoload
      ;; nil here indicates that this is not a special autoload form.
      (t nil))))
 
+(defvar loaddefs-generate-prefixes-limit 8
+  "Max number of prefixes registered per file.")
+
+(defvar loaddefs-generate-prefixes-generic
+  '("find-" "make-" "copy-" "define-" "global-" "batch-")
+  "Prefixes which are not specific enough.")
+
+(defvar loaddefs-generate-prefixes-ignore ()
+  "List of prefixes that are not worth registering.
+Meant to be used as a file-local variable.")
+
 (defun loaddefs-generate--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<))))))
+  ;; FIXME: We should take advantage of (and encourage) the convention
+  ;; of using the same namespace prefix as the file name.
+  ;; (message "loaddefs-generate-prefixes-ignore in %S = %S"
+  ;;          file loaddefs-generate-prefixes-ignore)
+  (letrec
+      ;; First, convert the list of DEFS into a radix tree.
+      ((tree (let ((tree radix-tree-empty))
+               (dolist (def defs)
+                 (setq tree (radix-tree-insert tree def t)))
+               tree))
+       (valid-prefix-p ;; Avoid prefixes that are excessively generic.
+        (lambda (s)
+          (and (or (> (length s) 2)     ;Long enough!
+                   ;; A real (tho short) prefix?
+                   (string-match ".[[:punct:]]\\'" s))
+               ;; But avoid generic prefixes.
+               (let ((x (try-completion s loaddefs-generate-prefixes-generic)))
+                 (not (or (equal x s) (equal x t)))))))
+       (ignore-p
+        (lambda (s)
+          (or (not (listp loaddefs-generate-prefixes-ignore))
+              (let ((ignore nil))
+                (dolist (ignored-prefix loaddefs-generate-prefixes-ignore)
+                  (when (string-prefix-p ignored-prefix s)
+                    (setq ignore t)))
+                ignore))))
+       (ids ;; Convert a radix (sub)tree back into a list of identifiers.
+        (lambda (prefix tree)
+          (let ((ids '()))
+            (radix-tree-iter-mappings
+             tree (lambda (s _) (push (concat prefix s) ids)))
+            ids)))
+       (dropped '())   ;; List of prefixes that are rejected.
+       (valid-prefixes ;; Return possible valid prefixes of a (sub)tree.
+        (lambda (prefix tree)
+          (let ((prefixes '()))
+            (radix-tree-iter-subtrees
+             tree
+             (lambda (s subtree)
+               (setq s (concat prefix s))
+               (cond
+                ((funcall ignore-p s)) ;; Drop silently.
+                ((funcall valid-prefix-p s) (push (cons s subtree) prefixes))
+                ((radix-tree-lookup tree "") ;Nothing to expand!
+                 (push (cons s (funcall ids prefix subtree)) dropped))
+                (t
+                 (setq prefixes (nconc (funcall valid-prefixes s subtree)
+                                       prefixes))))))
+            prefixes)))
+       ;; Initial list of possible valid prefixes.
+       (prefixes (funcall valid-prefixes "" tree)))
+    (when (> (length prefixes) loaddefs-generate-prefixes-limit)
+      ;; The list is too long.  Throw out the prefixes that cover fewer
+      ;; identifiers: they're less useful (and they tend to be longer).
+      (let* ((sorted
+              (sort
+               (mapcar (lambda (x)
+                         (let ((prefix (car x)) (tree (cdr x)))
+                           (cons prefix (funcall ids prefix tree))))
+                       prefixes)
+               (lambda (x y) (> (length (cdr x)) (length (cdr y)))))))
+        (setq dropped (nconc (nthcdr loaddefs-generate-prefixes-limit sorted) dropped))
+        (setq prefixes (nreverse (take loaddefs-generate-prefixes-limit sorted)))
+        ;; Don't keep prefixes that contain no-more elements than dropped ones,
+        ;; so we're not affected by arbitrary ordering between subtrees.
+        (while (= (length (cdar prefixes)) (length (cdar dropped)))
+          (push (pop prefixes) dropped))))
+    (when dropped
+      (let ((ids (mapcan #'cdr dropped)))
+        (message "%s:0: Warning: Not registering %d prefixes (%d (%d%%) identifiers).
+Affected prefixes: %S"
+                 file (length dropped) (length ids)
+                 (/ (* (length ids) 100)
+                    (+ (length ids) (length (mapcan #'cdr prefixes))))
+                 (mapcar #'car dropped)))) ;;ids
+    (let ((expd (when dropped
+                  `(ignore "dropped-prefixes" ',(mapcar #'car dropped))))
+          (expr
+           (when prefixes
+             (let ((strings (mapcar #'car prefixes)))
+               `(register-definition-prefixes
+                 ,file ',(sort strings #'string<))))))
+      (if (and expd expr)
+          `(progn ,expr ,expd)
+        (or expd expr)))))
 
 (defun loaddefs-generate--parse-file (file main-outfile &optional package-data)
   "Examining FILE for ;;;###autoload statements.
@@ -386,45 +435,45 @@ loaddefs-generate--parse-file
 don't include."
   (let ((defs nil)
         (load-name (loaddefs-generate--file-load-name file main-outfile))
-        (compute-prefixes t)
         read-symbol-shorthands
-        local-outfile inhibit-autoloads)
+        local-outfile)
     (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.
+      ;; FIXME: That fails to obey `dir-locals.el'!
       (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)))))
-        (save-excursion
-          (when (re-search-forward "no-update-autoloads: *" nil t)
-            (setq inhibit-autoloads (read (current-buffer)))))
-        (save-excursion
-          (when (re-search-forward "autoload-compute-prefixes: *" nil t)
-            (setq compute-prefixes (read (current-buffer)))))
-        (save-excursion
-          ;; Since we're "open-coding", we have to repeat more
-          ;; complicated logic in `hack-local-variables'.
-          (when-let ((beg
-                      (re-search-forward "read-symbol-shorthands: *" nil t)))
-            ;; `read-symbol-shorthands' alist ends with two parens.
-            (let* ((end (re-search-forward ")[;\n\s]*)"))
-                   (commentless (replace-regexp-in-string
-                                 "\n\\s-*;+" ""
-                                 (buffer-substring beg end)))
-                   (unsorted-shorthands (car (read-from-string commentless))))
-              (setq read-symbol-shorthands
-                    (sort unsorted-shorthands
-                          (lambda (sh1 sh2)
-                            (> (length (car sh1)) (length (car sh2))))))))))
+        (while (re-search-forward
+                (concat (regexp-opt
+                         '("generated-autoload-file"
+                           "generated-autoload-load-name"
+                           "no-update-autoloads"
+                           "autoload-compute-prefixes"
+                           "read-symbol-shorthands"
+                           "loaddefs-generate-prefixes-ignore")
+                         t)
+                 ": *")
+                nil t)
+          (condition-case err
+              (set (make-local-variable (intern (match-string 1)))
+                   (read (current-buffer)))
+            (error
+             (message "Error while reading local var %S: %S"
+                      (match-string 1) err))))
+        (when (local-variable-p 'generated-autoload-file)
+          ;; Buffer-local file that should be interpreted relative to
+          ;; the .el file.
+          (setq local-outfile (expand-file-name generated-autoload-file
+                                                (file-name-directory file))))
+        (when (local-variable-p 'generated-autoload-load-name)
+          (setq load-name generated-autoload-load-name))
+        (when (local-variable-p 'read-symbol-shorthands)
+          ;; Duplicate the logic in `hack-local-variables--find-variables'.
+          (setq read-symbol-shorthands
+                (sort read-symbol-shorthands
+                      (lambda (sh1 sh2)
+                        (> (length (car sh1)) (length (car sh2))))))))
 
       ;; We always return the package version (even for pre-dumped
       ;; files).
@@ -446,7 +495,7 @@ loaddefs-generate--parse-file
                   defs))))
 
       ;; Obey the `no-update-autoloads' file local variable.
-      (when (and (not inhibit-autoloads)
+      (when (and (not no-update-autoloads)
                  (not (eq package-data 'only)))
         (goto-char (point-min))
         ;; The cookie might be like ;;;###tramp-autoload...
@@ -496,8 +545,7 @@ loaddefs-generate--parse-file
                             (buffer-substring (point) (line-end-position)))
                       defs)))))
 
-        (when (and autoload-compute-prefixes
-                   compute-prefixes)
+        (when autoload-compute-prefixes
           (with-demoted-errors "%S"
             (when-let
                 ((form (loaddefs-generate--compute-prefixes load-name)))