From unknown Fri Sep 19 13:03:50 2025 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.509 (Entity 5.509) Content-Type: text/plain; charset=utf-8 From: bug#79458 <79458@debbugs.gnu.org> To: bug#79458 <79458@debbugs.gnu.org> Subject: Status: [PATCH] Call load-path-filter-function in Flocate_file_internal Reply-To: bug#79458 <79458@debbugs.gnu.org> Date: Fri, 19 Sep 2025 20:03:50 +0000 retitle 79458 [PATCH] Call load-path-filter-function in Flocate_file_intern= al reassign 79458 emacs submitter 79458 Spencer Baugh severity 79458 normal tag 79458 patch thanks From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 16 12:51:55 2025 Received: (at submit) by debbugs.gnu.org; 16 Sep 2025 16:51:55 +0000 Received: from localhost ([127.0.0.1]:49845 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uyYuI-000512-Ju for submit@debbugs.gnu.org; Tue, 16 Sep 2025 12:51:55 -0400 Received: from lists.gnu.org ([2001:470:142::17]:41880) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uyYuD-00050F-Rb for submit@debbugs.gnu.org; Tue, 16 Sep 2025 12:51:52 -0400 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 1uyYu6-0005TA-Ms for bug-gnu-emacs@gnu.org; Tue, 16 Sep 2025 12:51:42 -0400 Received: from mxout5.mail.janestreet.com ([64.215.233.18]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1uyYu1-0006wh-NG for bug-gnu-emacs@gnu.org; Tue, 16 Sep 2025 12:51:42 -0400 From: Spencer Baugh To: bug-gnu-emacs@gnu.org Subject: [PATCH] Call load-path-filter-function in Flocate_file_internal X-Debbugs-Cc: monnier@iro.umontreal.ca Date: Tue, 16 Sep 2025 12:51:34 -0400 Message-ID: MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=janestreet.com; s=waixah; t=1758041495; bh=Dzall/c4KVmLqJmyVk5PqnlHiX3Ao6YGR+TTxsLYvMg=; h=From:To:Subject:Date; b=BwMUPhLzWqjLFWrmj9ImV6a5cYX8ADAmowaFrK06Z3rEltYbvkhymnbMjVSmN3tRy Kqy65YmUsInBXLOjLbhHHUefRoElcS2wo4V1Kp7yQq3T+8y4rcUmftzYRFpPiigzbz Sqfki8blR6gcrYY4VuIgfQaiyqf6oRVB+eqgNUCHgTDjDcyhZBokg/xN1iNG72cRfD 1rE3j54eRFpF+HZGGLWQrew3lG5pSViRuiRJ9SAAPtALodPEF9jzsVt1ouTaFlYvpZ D5qrdi8kXr2WKyBj/wL7j48lLelPcp865yxBu0XqcvIzINk0UWYF6AD2brco57eWuc FN87Ex/kEckhA== Received-SPF: pass client-ip=64.215.233.18; envelope-from=sbaugh@janestreet.com; helo=mxout5.mail.janestreet.com X-Spam_score_int: -43 X-Spam_score: -4.4 X-Spam_bar: ---- X-Spam_report: (-4.4 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_MED=-2.3, RCVD_IN_MSPIKE_H5=0.001, RCVD_IN_MSPIKE_WL=0.001, RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, RCVD_IN_VALIDITY_SAFE_BLOCKED=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: 0.9 (/) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.1 (/) --=-=-= Content-Type: text/plain Tags: patch See emacs-devel thread https://lists.gnu.org/archive/html/emacs-devel/2025-09/msg00389.html This allows calls like (locate-library "term/xterm") made by tty-run-terminal-initialization to be optimized for long load-paths. * lisp/startup.el (load-path-filter-cache-directory-files): Filter on the directory of multi-component file names, and handle nil PREFIXES. * src/lread.c (Flocate_file_internal): Call load-path-filter-function. * test/lisp/startup-tests.el (startup-tests/load-path-filter-cache-directory-files): Add. In GNU Emacs 30.1.90 (build 53, x86_64-pc-linux-gnu, X toolkit, cairo version 1.15.12, Xaw scroll bars) of 2025-09-12 built on igm-qws-u22796a Repository revision: 40acab314a5c157ac30d65e6c7939f925c8205b7 Repository branch: emacs-30 Windowing system distributor 'The X.Org Foundation', version 11.0.12011000 System Description: Rocky Linux 8.10 (Green Obsidian) Configured using: 'configure --with-x-toolkit=lucid --without-gpm --without-gconf --without-selinux --without-imagemagick --with-modules --with-gif=no --with-cairo --with-rsvg --without-compress-install --with-tree-sitter --with-native-compilation=aot PKG_CONFIG_PATH=/usr/local/home/garnish/libtree-sitter/0.22.6-1/lib/pkgconfig/' --=-=-= Content-Type: text/patch Content-Disposition: attachment; filename=0001-Call-load-path-filter-function-in-Flocate_file_inter.patch >From 30d3bdf9d6da9c77d529a292c0abe9f48be8d57b Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 16 Sep 2025 12:09:54 -0400 Subject: [PATCH] Call load-path-filter-function in Flocate_file_internal This allows calls like (locate-library "term/xterm") made by tty-run-terminal-initialization to be optimized for long load-paths. * lisp/startup.el (load-path-filter-cache-directory-files): Filter on the directory of multi-component file names, and handle nil PREFIXES. * src/lread.c (Flocate_file_internal): Call load-path-filter-function. * test/lisp/startup-tests.el (startup-tests/load-path-filter-cache-directory-files): Add. --- lisp/startup.el | 52 +++++++++++++++++++++----------------- src/lread.c | 2 ++ test/lisp/startup-tests.el | 12 +++++++++ 3 files changed, 43 insertions(+), 23 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index 836ead6deb0..5d824a0966e 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1157,38 +1157,44 @@ load-path-filter-cache-directory-files PATH should be a list of directories such as `load-path'. Returns a copy of PATH with any directories that cannot contain FILE with SUFFIXES removed from it. -Doesn't filter PATH if FILE is an absolute file name or if FILE is -a relative file name with leading directories. +Doesn't filter PATH if FILE is an absolute file name. Caches contents of directories in `load-path-filter--cache'. This function is called from `load' via `load-path-filter-function'." - (if (file-name-directory file) - ;; FILE has more than one component, don't bother filtering. + (if (or (file-name-absolute-p file) + (string-empty-p file) + (null suffixes) + ;; Don't bother filtering if "" is among the suffixes. + ;; It's a much less common use-case and it would use + ;; more memory to keep the corresponding info. + (member "" suffixes)) path (pcase-let ((`(,rx . ,ht) (with-memoization (alist-get suffixes load-path-filter--cache nil nil #'equal) - (if (member "" suffixes) - '(nil ;; Optimize the filtering. - ;; Don't bother filtering if "" is among the suffixes. - ;; It's a much less common use-case and it would use - ;; more memory to keep the corresponding info. - . nil) - (cons (concat (regexp-opt suffixes) "\\'") - (make-hash-table :test #'equal)))))) - (if (null ht) - path - (let ((completion-regexp-list nil)) - (seq-filter - (lambda (dir) - (when (file-directory-p dir) - (try-completion - file - (with-memoization (gethash dir ht) - (directory-files dir nil rx t))))) - path)))))) + (cons (concat (regexp-opt (cons "/" suffixes)) "\\'") + (make-hash-table :test #'equal))))) + (let ((filter-on + ;; Filter on the first component of FILE. + (let ((split (file-name-split file))) + (if (cdr split) + ;; The first component must be a directory. + (file-name-as-directory (car split)) + (car split)))) + (completion-regexp-list nil) + (completion-ignore-case nil)) + (seq-filter + (lambda (dir) + (when (file-directory-p dir) + (try-completion + filter-on + (with-memoization (gethash dir ht) + (seq-filter + (lambda (file) (string-match rx file)) + (file-name-all-completions "" dir)))))) + path))))) (defun command-line () "A subroutine of `normal-top-level'. diff --git a/src/lread.c b/src/lread.c index 1a667ce163a..3dae4477f2e 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1601,6 +1601,8 @@ DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) { Lisp_Object file; + if (FUNCTIONP (Vload_path_filter_function)) + path = calln (Vload_path_filter_function, path, filename, suffixes); int fd = openp (path, filename, suffixes, &file, predicate, false, true, NULL); if (NILP (predicate) && fd >= 0) diff --git a/test/lisp/startup-tests.el b/test/lisp/startup-tests.el index 59290ad4806..7b52a57b5bd 100644 --- a/test/lisp/startup-tests.el +++ b/test/lisp/startup-tests.el @@ -44,4 +44,16 @@ startup-tests/command-switch-alist (should (equal foo-args '("--foo"))) (should (equal bar-args '("--bar=value"))))) +(ert-deftest startup-tests/load-path-filter-cache-directory-files () + (should (locate-file "term/xterm" load-path '(".el"))) + (should (locate-file "startup" load-path '(".el"))) + (let ((load-path-filter-function #'load-path-filter-cache-directory-files) + load-path-filter--cache) + (should (load-path-filter-cache-directory-files load-path "startup" '(".el"))) + (should (load-path-filter-cache-directory-files load-path "term/xterm" '(".el"))) + (should (locate-file "term/xterm" load-path '(".el"))) + (should (locate-file "startup" load-path '(".el"))) + (should (locate-file "term/xterm.el" load-path)) + (should (locate-file "startup.el" load-path)))) + ;;; startup-tests.el ends here -- 2.43.7 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 16 17:03:01 2025 Received: (at 79458) by debbugs.gnu.org; 16 Sep 2025 21:03:01 +0000 Received: from localhost ([127.0.0.1]:51202 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uycpI-0007TL-CK for submit@debbugs.gnu.org; Tue, 16 Sep 2025 17:03:01 -0400 Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:43796) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uycpF-0007T4-Li for 79458@debbugs.gnu.org; Tue, 16 Sep 2025 17:02:58 -0400 Received: from pmg2.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 6651D80030; Tue, 16 Sep 2025 17:02:51 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1758056566; bh=AGIBmY9mtNJeAf+VjgaDXe3gMteI6+ySKYkwU7LYxe8=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=lhQMhn4NkmZjHHVlxPUUGyxpwBgV9n0xrGC2XziZx38VLWcNOmobjCvAzu88akjR9 0zkSRXy5A8qZ35D7TCXEPikN07CJBw3Z2Y9PN8AZI4leaM8TB5t5kXBp9Ysna8KX3b TtTGEshmzfioh9T5nNCzYWxHJOYreQVg6G/Z7v9t0E17lYmjnhtmt896y/SxZENrEf NA38dBWKs7kDq86Gp6aWq+38jdJdwkSxjDl31lNljuMRDtVToGa/1TimjlHvhhdEaz x6uasuxWxVXTDaGl++ZnNoZ7dRkIvhz1E5nc7nNCwpC6YgEJSWqyV6nVUDSlVn5qDZ 7aiqRO8viK9DA== Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 21839805B1; Tue, 16 Sep 2025 17:02:46 -0400 (EDT) Received: from asado (unknown [192.197.121.81]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 0E1571205D2; Tue, 16 Sep 2025 17:02:46 -0400 (EDT) From: Stefan Monnier To: Spencer Baugh Subject: Re: bug#79458: [PATCH] Call load-path-filter-function in Flocate_file_internal In-Reply-To: Message-ID: References: Date: Tue, 16 Sep 2025 17:02:45 -0400 User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-SPAM-INFO: Spam detection results: 0 ALL_TRUSTED -1 Passed through trusted hosts only via SMTP AWL -0.000 Adjusted score from AWL reputation of From: address BAYES_00 -1.9 Bayes spam probability is 0 to 1% DKIM_SIGNED 0.1 Message has a DKIM or DK signature, not necessarily valid DKIM_VALID -0.1 Message has at least one valid DKIM or DK signature DKIM_VALID_AU -0.1 Message has a valid DKIM or DK signature from author's domain DKIM_VALID_EF -0.1 Message has a valid DKIM or DK signature from envelope-from domain X-SPAM-LEVEL: X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 79458 Cc: 79458@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > From 30d3bdf9d6da9c77d529a292c0abe9f48be8d57b Mon Sep 17 00:00:00 2001 > From: Spencer Baugh > Date: Tue, 16 Sep 2025 12:09:54 -0400 > Subject: [PATCH] Call load-path-filter-function in Flocate_file_internal > > This allows calls like (locate-library "term/xterm") made by > tty-run-terminal-initialization to be optimized for long > load-paths. > > * lisp/startup.el (load-path-filter-cache-directory-files): > Filter on the directory of multi-component file names, and > handle nil PREFIXES. > * src/lread.c (Flocate_file_internal): Call > load-path-filter-function. > * test/lisp/startup-tests.el > (startup-tests/load-path-filter-cache-directory-files): Add. s/PREFIXES/SUFFIXES/? > --- > lisp/startup.el | 52 +++++++++++++++++++++----------------- > src/lread.c | 2 ++ > test/lisp/startup-tests.el | 12 +++++++++ > 3 files changed, 43 insertions(+), 23 deletions(-) > > diff --git a/lisp/startup.el b/lisp/startup.el > index 836ead6deb0..5d824a0966e 100644 > --- a/lisp/startup.el > +++ b/lisp/startup.el > @@ -1157,38 +1157,44 @@ load-path-filter-cache-directory-files > PATH should be a list of directories such as `load-path'. > Returns a copy of PATH with any directories that cannot contain FILE > with SUFFIXES removed from it. > -Doesn't filter PATH if FILE is an absolute file name or if FILE is > -a relative file name with leading directories. > +Doesn't filter PATH if FILE is an absolute file name. > > Caches contents of directories in `load-path-filter--cache'. > > This function is called from `load' via `load-path-filter-function'." > - (if (file-name-directory file) > - ;; FILE has more than one component, don't bother filtering. > + (if (or (file-name-absolute-p file) > + (string-empty-p file) > + (null suffixes) > + ;; Don't bother filtering if "" is among the suffixes. > + ;; It's a much less common use-case and it would use > + ;; more memory to keep the corresponding info. > + (member "" suffixes)) > path > (pcase-let > ((`(,rx . ,ht) > (with-memoization (alist-get suffixes load-path-filter--cache > nil nil #'equal) > - (if (member "" suffixes) > - '(nil ;; Optimize the filtering. > - ;; Don't bother filtering if "" is among the suffixes. > - ;; It's a much less common use-case and it would use > - ;; more memory to keep the corresponding info. > - . nil) > - (cons (concat (regexp-opt suffixes) "\\'") > - (make-hash-table :test #'equal)))))) > - (if (null ht) > - path > - (let ((completion-regexp-list nil)) > - (seq-filter > - (lambda (dir) > - (when (file-directory-p dir) > - (try-completion > - file > - (with-memoization (gethash dir ht) > - (directory-files dir nil rx t))))) > - path)))))) > + (cons (concat (regexp-opt (cons "/" suffixes)) "\\'") > + (make-hash-table :test #'equal))))) > + (let ((filter-on > + ;; Filter on the first component of FILE. > + (let ((split (file-name-split file))) > + (if (cdr split) > + ;; The first component must be a directory. > + (file-name-as-directory (car split)) > + (car split)))) > + (completion-regexp-list nil) > + (completion-ignore-case nil)) > + (seq-filter > + (lambda (dir) > + (when (file-directory-p dir) > + (try-completion > + filter-on > + (with-memoization (gethash dir ht) > + (seq-filter > + (lambda (file) (string-match rx file)) > + (file-name-all-completions "" dir)))))) > + path))))) Have you compared the above `string-match` approach to letting `file-name-all-completions` do the regexp matching via `completion-regexp-list`? > --- a/src/lread.c > +++ b/src/lread.c > @@ -1601,6 +1601,8 @@ DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, > (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) > { > Lisp_Object file; > + if (FUNCTIONP (Vload_path_filter_function)) > + path = calln (Vload_path_filter_function, path, filename, suffixes); > int fd = openp (path, filename, suffixes, &file, predicate, false, true, > NULL); > if (NILP (predicate) && fd >= 0) Of course, this makes the name `load-path-filter-function` a lie since it applies to more than just `load-path`. Have you tried to move the call directly into `openp`? Also, I wonder what's the impact on the size of the cache. I get the impression that we might be more likely to get duplicates because of slight variations of `suffixes`. Stefan From debbugs-submit-bounces@debbugs.gnu.org Tue Sep 16 17:38:17 2025 Received: (at 79458) by debbugs.gnu.org; 16 Sep 2025 21:38:17 +0000 Received: from localhost ([127.0.0.1]:51441 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uydNP-0001e2-W6 for submit@debbugs.gnu.org; Tue, 16 Sep 2025 17:38:17 -0400 Received: from mxout5.mail.janestreet.com ([64.215.233.18]:35217) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uydNM-0001d6-CX for 79458@debbugs.gnu.org; Tue, 16 Sep 2025 17:38:13 -0400 From: Spencer Baugh To: Stefan Monnier Subject: Re: bug#79458: [PATCH] Call load-path-filter-function in Flocate_file_internal In-Reply-To: (Stefan Monnier's message of "Tue, 16 Sep 2025 17:02:45 -0400") References: Date: Tue, 16 Sep 2025 17:38:06 -0400 Message-ID: User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=janestreet.com; s=waixah; t=1758058686; bh=H9D1ME/Jvgtxhpx9vI1GdyxQoX9BEe0UKLdBR52Q4iM=; h=From:To:Cc:Subject:In-Reply-To:References:Date; b=IzWc+EpzOopH0srhfB/NhY+fauQ0Qc98qX8+1p66Sa6Opsa6QHwIJ8GYDL5kaiQKD 7lBJ1ywutRb0TS0eSiCQP9vUhvSzvllkSPLoES0LfGFsPeUmaSSphMgFoaKlO/HwU3 +J2kN1GZUNs1sHQBUopRpc7prpw7julrd/CdvADw9F7XjFrZmWjYIrndQ777SMbK75 doFbiw3Hg/rVFAOwEcVZ1Pzjfbe2ns/Hjttd6tsTVi3Ckrhw6E1tVUE+Hwww5g1B3E V00B/qar2chNGNPpvlKez9GGe5m8wXSI8OUU8hoZJWiIQ+bW9qUuAmzaU+uQc+Zkmq ohcbDqTu322XA== X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 79458 Cc: 79458@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) --=-=-= Content-Type: text/plain Stefan Monnier writes: >> From 30d3bdf9d6da9c77d529a292c0abe9f48be8d57b Mon Sep 17 00:00:00 2001 >> From: Spencer Baugh >> Date: Tue, 16 Sep 2025 12:09:54 -0400 >> Subject: [PATCH] Call load-path-filter-function in Flocate_file_internal >> >> This allows calls like (locate-library "term/xterm") made by >> tty-run-terminal-initialization to be optimized for long >> load-paths. >> >> * lisp/startup.el (load-path-filter-cache-directory-files): >> Filter on the directory of multi-component file names, and >> handle nil PREFIXES. >> * src/lread.c (Flocate_file_internal): Call >> load-path-filter-function. >> * test/lisp/startup-tests.el >> (startup-tests/load-path-filter-cache-directory-files): Add. > > s/PREFIXES/SUFFIXES/? Oops, yes, will fix in next version. >> --- >> lisp/startup.el | 52 +++++++++++++++++++++----------------- >> src/lread.c | 2 ++ >> test/lisp/startup-tests.el | 12 +++++++++ >> 3 files changed, 43 insertions(+), 23 deletions(-) >> >> diff --git a/lisp/startup.el b/lisp/startup.el >> index 836ead6deb0..5d824a0966e 100644 >> --- a/lisp/startup.el >> +++ b/lisp/startup.el >> @@ -1157,38 +1157,44 @@ load-path-filter-cache-directory-files >> PATH should be a list of directories such as `load-path'. >> Returns a copy of PATH with any directories that cannot contain FILE >> with SUFFIXES removed from it. >> -Doesn't filter PATH if FILE is an absolute file name or if FILE is >> -a relative file name with leading directories. >> +Doesn't filter PATH if FILE is an absolute file name. >> >> Caches contents of directories in `load-path-filter--cache'. >> >> This function is called from `load' via `load-path-filter-function'." >> - (if (file-name-directory file) >> - ;; FILE has more than one component, don't bother filtering. >> + (if (or (file-name-absolute-p file) >> + (string-empty-p file) >> + (null suffixes) >> + ;; Don't bother filtering if "" is among the suffixes. >> + ;; It's a much less common use-case and it would use >> + ;; more memory to keep the corresponding info. >> + (member "" suffixes)) >> path >> (pcase-let >> ((`(,rx . ,ht) >> (with-memoization (alist-get suffixes load-path-filter--cache >> nil nil #'equal) >> - (if (member "" suffixes) >> - '(nil ;; Optimize the filtering. >> - ;; Don't bother filtering if "" is among the suffixes. >> - ;; It's a much less common use-case and it would use >> - ;; more memory to keep the corresponding info. >> - . nil) >> - (cons (concat (regexp-opt suffixes) "\\'") >> - (make-hash-table :test #'equal)))))) >> - (if (null ht) >> - path >> - (let ((completion-regexp-list nil)) >> - (seq-filter >> - (lambda (dir) >> - (when (file-directory-p dir) >> - (try-completion >> - file >> - (with-memoization (gethash dir ht) >> - (directory-files dir nil rx t))))) >> - path)))))) >> + (cons (concat (regexp-opt (cons "/" suffixes)) "\\'") >> + (make-hash-table :test #'equal))))) >> + (let ((filter-on >> + ;; Filter on the first component of FILE. >> + (let ((split (file-name-split file))) >> + (if (cdr split) >> + ;; The first component must be a directory. >> + (file-name-as-directory (car split)) >> + (car split)))) >> + (completion-regexp-list nil) >> + (completion-ignore-case nil)) >> + (seq-filter >> + (lambda (dir) >> + (when (file-directory-p dir) >> + (try-completion >> + filter-on >> + (with-memoization (gethash dir ht) >> + (seq-filter >> + (lambda (file) (string-match rx file)) >> + (file-name-all-completions "" dir)))))) >> + path))))) > > Have you compared the above `string-match` approach to letting > `file-name-all-completions` do the regexp matching via > `completion-regexp-list`? Yes. Alas, completion-regexp-list is applied by file-name-all-completions *before* the "/" is added to the file names of directories. So using completion-regexp-list just didn't work :( >> --- a/src/lread.c >> +++ b/src/lread.c >> @@ -1601,6 +1601,8 @@ DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, >> (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) >> { >> Lisp_Object file; >> + if (FUNCTIONP (Vload_path_filter_function)) >> + path = calln (Vload_path_filter_function, path, filename, suffixes); >> int fd = openp (path, filename, suffixes, &file, predicate, false, true, >> NULL); >> if (NILP (predicate) && fd >= 0) > > Of course, this makes the name `load-path-filter-function` a lie since > it applies to more than just `load-path`. Yes. We probably should change the name. > Have you tried to move the call directly into `openp`? Just tried, it seems to work fine. The attached patch does that. > Also, I wonder what's the impact on the size of the cache. I get the > impression that we might be more likely to get duplicates because of > slight variations of `suffixes`. True. What about just having a single cached list per directory, instead of having separate lists pre-filtered with suffixes? That would avoid the problem of duplication due to different suffixes. The attached patch does that (in addition to moving the call to openp). I especially like that it now works when "" is present as a suffix. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Call-load-path-filter-function-in-openp.patch >From 41ad123b8201325aa2e15dee84d8470c2eeb2933 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 16 Sep 2025 12:09:54 -0400 Subject: [PATCH] Call load-path-filter-function in openp This allows calls like (locate-library "term/xterm") made by tty-run-terminal-initialization to be optimized for long load-paths. * lisp/startup.el (load-path-filter--cache): Update docstring; this is now just a single hash-table. (load-path-filter-cache-directory-files): Filter on the directory of multi-component file names, and handle nil SUFFIXES. (bug#79458) * src/lread.c (openp): Call load-path-filter-function. * test/lisp/startup-tests.el (startup-tests/load-path-filter-cache-directory-files): Add. --- lisp/startup.el | 63 +++++++++++++++++--------------------- src/lread.c | 5 +-- test/lisp/startup-tests.el | 12 ++++++++ 3 files changed, 43 insertions(+), 37 deletions(-) diff --git a/lisp/startup.el b/lisp/startup.el index 836ead6deb0..820b525a073 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1141,14 +1141,8 @@ lisp-directory (defvar load-path-filter--cache nil "A cache used by `load-path-filter-cache-directory-files'. -The value is an alist. The car of each entry is a list of load suffixes, -such as returned by `get-load-suffixes'. The cdr of each entry is a -cons whose car is a regex matching those suffixes -at the end of a string, and whose cdr is a hash-table mapping directories -to files in those directories which end with one of the suffixes. -These can also be nil, in which case no filtering will happen. -The files named in the hash-table can be of any kind, -including subdirectories. +The value is a hash-table mapping directories to files in those +directories. Subdirectories will end with a \"/\". The hash-table uses `equal' as its key comparison function.") (defun load-path-filter-cache-directory-files (path file suffixes) @@ -1157,38 +1151,37 @@ load-path-filter-cache-directory-files PATH should be a list of directories such as `load-path'. Returns a copy of PATH with any directories that cannot contain FILE with SUFFIXES removed from it. -Doesn't filter PATH if FILE is an absolute file name or if FILE is -a relative file name with leading directories. +Doesn't filter PATH if FILE is an absolute file name. Caches contents of directories in `load-path-filter--cache'. This function is called from `load' via `load-path-filter-function'." - (if (file-name-directory file) - ;; FILE has more than one component, don't bother filtering. + (if (or (file-name-absolute-p file) + (string-empty-p file)) path - (pcase-let - ((`(,rx . ,ht) - (with-memoization (alist-get suffixes load-path-filter--cache - nil nil #'equal) - (if (member "" suffixes) - '(nil ;; Optimize the filtering. - ;; Don't bother filtering if "" is among the suffixes. - ;; It's a much less common use-case and it would use - ;; more memory to keep the corresponding info. - . nil) - (cons (concat (regexp-opt suffixes) "\\'") - (make-hash-table :test #'equal)))))) - (if (null ht) - path - (let ((completion-regexp-list nil)) - (seq-filter - (lambda (dir) - (when (file-directory-p dir) - (try-completion - file - (with-memoization (gethash dir ht) - (directory-files dir nil rx t))))) - path)))))) + (unless suffixes + (setq suffixes '(""))) + (let ((filter-on + ;; Filter on the first component of FILE. + (let ((split (file-name-split file))) + (if (cdr split) + ;; The first component must be a directory. + (file-name-as-directory (car split)) + (car split)))) + (completion-regexp-list + (list (concat (regexp-opt (cons "/" suffixes)) "\\'"))) + (completion-ignore-case nil)) + (unless load-path-filter--cache + (setq load-path-filter--cache (make-hash-table :test #'equal))) + (seq-filter + (lambda (dir) + (when (file-directory-p dir) + (try-completion + filter-on + (with-memoization (gethash dir load-path-filter--cache) + (let ((completion-regexp-list nil)) + (file-name-all-completions "" dir)))))) + path)))) (defun command-line () "A subroutine of `normal-top-level'. diff --git a/src/lread.c b/src/lread.c index 1a667ce163a..fc470709931 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1205,8 +1205,6 @@ DEFUN ("load", Fload, Sload, 1, 5, 0, } Lisp_Object load_path = Vload_path; - if (FUNCTIONP (Vload_path_filter_function)) - load_path = calln (Vload_path_filter_function, load_path, file, suffixes); #if !defined USE_ANDROID_ASSETS fd = openp (load_path, file, suffixes, &found, Qnil, @@ -1794,6 +1792,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, absolute = complete_filename_p (str); + if (FUNCTIONP (Vload_path_filter_function)) + path = calln (Vload_path_filter_function, path, str, suffixes); + AUTO_LIST1 (just_use_str, Qnil); if (NILP (path)) path = just_use_str; diff --git a/test/lisp/startup-tests.el b/test/lisp/startup-tests.el index 59290ad4806..7b52a57b5bd 100644 --- a/test/lisp/startup-tests.el +++ b/test/lisp/startup-tests.el @@ -44,4 +44,16 @@ startup-tests/command-switch-alist (should (equal foo-args '("--foo"))) (should (equal bar-args '("--bar=value"))))) +(ert-deftest startup-tests/load-path-filter-cache-directory-files () + (should (locate-file "term/xterm" load-path '(".el"))) + (should (locate-file "startup" load-path '(".el"))) + (let ((load-path-filter-function #'load-path-filter-cache-directory-files) + load-path-filter--cache) + (should (load-path-filter-cache-directory-files load-path "startup" '(".el"))) + (should (load-path-filter-cache-directory-files load-path "term/xterm" '(".el"))) + (should (locate-file "term/xterm" load-path '(".el"))) + (should (locate-file "startup" load-path '(".el"))) + (should (locate-file "term/xterm.el" load-path)) + (should (locate-file "startup.el" load-path)))) + ;;; startup-tests.el ends here -- 2.43.7 --=-=-=--