From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#73792: 30; Confusion in loaddefs-generate--*-prefixes Date: Wed, 23 Oct 2024 10:06:29 -0400 Message-ID: References: <87ttdgavfs.fsf@bernoul.li> Reply-To: Stefan Monnier Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="13226"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: 73792@debbugs.gnu.org To: Jonas Bernoulli Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Oct 23 16:07:57 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1t3c1k-0003Hr-I6 for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 23 Oct 2024 16:07:56 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1t3c1S-0008L5-It; Wed, 23 Oct 2024 10:07:38 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1t3c1O-0008K0-Ge for bug-gnu-emacs@gnu.org; Wed, 23 Oct 2024 10:07:34 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1t3c1M-0001vh-Qu for bug-gnu-emacs@gnu.org; Wed, 23 Oct 2024 10:07:34 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:References:In-Reply-To:From:To:Subject; bh=BAA0jox5N8faSgBNtw49CXfNraKwHxONS4UlJKY/YMg=; b=a50oaxxMjC98/+Qhg2Ytsy6CUBe0iH7fMH2Hratk63S3WmUJV5+aaQhFMJSeXgyk7R5j2p5OLyv0+9UJ3xDAcoLWt6aFMswSZLZtk1xNbAUiGUruJzzWHpzysllRVU48cbgVgFikH5KxYGL2/EOUnCQmOmsL97XgE6KOL1gcN6zZYmfQTGWpdynO9FldwSXoUb/75654WnsnH9EQr0lz68eDojPCmyynaf8HLv8go8egIxZquUZjfupNcH5FvCvcicRdi0PrTw66KJwvjCCM539oxnE2ncbrWyikOKhO9j4UYe13csZbTpBoUaPnMYBPyFqCEz51KeB5uRnCMNlvBQ==; Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1t3c1q-00067y-2C for bug-gnu-emacs@gnu.org; Wed, 23 Oct 2024 10:08:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 23 Oct 2024 14:08:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73792 X-GNU-PR-Package: emacs Original-Received: via spool by 73792-submit@debbugs.gnu.org id=B73792.172969243223478 (code B ref 73792); Wed, 23 Oct 2024 14:08:02 +0000 Original-Received: (at 73792) by debbugs.gnu.org; 23 Oct 2024 14:07:12 +0000 Original-Received: from localhost ([127.0.0.1]:60326 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3c11-00066b-7L for submit@debbugs.gnu.org; Wed, 23 Oct 2024 10:07:12 -0400 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:6968) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3c0y-00066M-HO for 73792@debbugs.gnu.org; Wed, 23 Oct 2024 10:07:10 -0400 Original-Received: from pmg1.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id AA3021000C3; Wed, 23 Oct 2024 10:06:32 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1729692391; bh=bTGTCE5owsB27lGbP4X3EoUSA54LjoLVrtzyBD/L+qc=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=QPDPBIzsUWL7sRmiOGGBzHdO/xUsfEek4CclNMeBNlRdk3Cy+QJi3vi//dgJW0tub xNIxKux0YhSrkehq+bbW5JZU2WFK7MqDK46iy6aBd4/OEDc9nel2kC/xBaKUyL/Fft tIfk19dxIHj51TdGHki20Yp5yCZXwC+pu4/EGj8mzWTAezZINtatm2hAdARJbLTesO FDTnUe7zKmnkz6IfHXf9k+UgWQ6GkU5h9TGw5lZSd3IzT9UuqyPQXgjgX5N0Yhk0aU U63m1mekv8o59UxCgwBQx0rM1pKf+MfReQCwLKjw44KDe9sSZkIopuBOG8fVg/Fb7b W7pwwJIX8Thbg== Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg1.iro.umontreal.ca (Proxmox) with ESMTP id 4DE0C100042; Wed, 23 Oct 2024 10:06:31 -0400 (EDT) Original-Received: from pastel (69-196-161-60.dsl.teksavvy.com [69.196.161.60]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 22373120E7D; Wed, 23 Oct 2024 10:06:31 -0400 (EDT) In-Reply-To: <87ttdgavfs.fsf@bernoul.li> (Jonas Bernoulli's message of "Sun, 13 Oct 2024 17:12:23 +0200") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:294146 Archived-At: --=-=-= Content-Type: text/plain > 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 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=loaddefs.patch 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))) --=-=-=--