Subject: bug#79458: [PATCH] Call load-path-filter-function in Flocate_file_internal

From: Spencer Baugh <[email-masked]>
Date: Tue, 16 Sep 2025 12:51:34 -0400

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/'

>From 30d3bdf9d6da9c77d529a292c0abe9f48be8d57b Mon Sep 17 00:00:00 2001
From: Spencer Baugh <[email-masked]>
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