master b7a737ef49e 1/3: Improve performance of `find-buffer-visiting' (bug#66117)

[Eli Zaretskii]

branch: master
commit b7a737ef49e787120ea7a7e9f4d4ef04dd1a0723
Author: Ihor Radchenko <yantar92@posteo.net>
Commit: Eli Zaretskii <eliz@gnu.org>

    Improve performance of `find-buffer-visiting' (bug#66117)
    
    * src/buffer.c (Fget_truename_buffer): Expose `get_truename_buffer' to
    Elisp.
    (Ffind_buffer): New subr searching for a live buffer with a given
    value of buffer-local variable.
    (syms_of_buffer): Register the new added subroutines.
    * src/filelock.c (lock_file): Use the new `Fget_truename_buffer' name.
    * src/lisp.h:
    * test/manual/etags/c-src/emacs/src/lisp.h: Remove no-longer-necessary
    extern declarations for `get_truename_buffer'.
    * lisp/files.el (find-buffer-visiting): Refactor, using subroutines to
    search for buffers instead of slow manual Elisp iterations.
---
 lisp/files.el                            | 54 ++++++++++++++------------------
 src/buffer.c                             | 25 +++++++++++++--
 src/filelock.c                           |  2 +-
 src/lisp.h                               |  1 -
 test/manual/etags/c-src/emacs/src/lisp.h |  1 -
 5 files changed, 47 insertions(+), 36 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index caa0622ab08..315ba831e8c 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2208,37 +2208,29 @@ and others are ignored.  PREDICATE is called with the 
buffer as
 the only argument, but not with the buffer as the current buffer.
 
 If there is no such live buffer, return nil."
-  (let ((predicate (or predicate #'identity))
-        (truename (abbreviate-file-name (file-truename filename))))
-    (or (let ((buf (get-file-buffer filename)))
-          (when (and buf (funcall predicate buf)) buf))
-        (let ((list (buffer-list)) found)
-          (while (and (not found) list)
-            (with-current-buffer (car list)
-              (if (and buffer-file-name
-                       (string= buffer-file-truename truename)
-                       (funcall predicate (current-buffer)))
-                  (setq found (car list))))
-            (setq list (cdr list)))
-          found)
-        (let* ((attributes (file-attributes truename))
-               (number (file-attribute-file-identifier attributes))
-               (list (buffer-list)) found)
-          (and buffer-file-numbers-unique
-               (car-safe number)       ;Make sure the inode is not just nil.
-               (while (and (not found) list)
-                 (with-current-buffer (car list)
-                   (if (and buffer-file-name
-                            (equal buffer-file-number number)
-                            ;; Verify this buffer's file number
-                            ;; still belongs to its file.
-                            (file-exists-p buffer-file-name)
-                            (equal (file-attributes buffer-file-truename)
-                                   attributes)
-                            (funcall predicate (current-buffer)))
-                       (setq found (car list))))
-                 (setq list (cdr list))))
-          found))))
+  (or (let ((buf (get-file-buffer filename)))
+        (when (and buf (or (not predicate) (funcall predicate buf))) buf))
+      (let ((truename (abbreviate-file-name (file-truename filename))))
+        (or
+         (let ((buf (get-truename-buffer truename)))
+           (when (and buf (buffer-local-value 'buffer-file-name buf)
+                      (or (not predicate) (funcall predicate buf)))
+             buf))
+         (let* ((attributes (file-attributes truename))
+                (number (file-attribute-file-identifier attributes)))
+           (and buffer-file-numbers-unique
+                (car-safe number)       ;Make sure the inode is not just nil.
+                (let ((buf (find-buffer 'buffer-file-number number)))
+                  (when (and buf (buffer-local-value 'buffer-file-name buf)
+                             ;; Verify this buffer's file number
+                             ;; still belongs to its file.
+                             (file-exists-p buffer-file-name)
+                             (equal (file-attributes buffer-file-truename)
+                                    attributes)
+                             (or (not predicate)
+                                 (funcall predicate (current-buffer))))
+                    buf))))))))
+
 
 (defcustom find-file-wildcards t
   "Non-nil means file-visiting commands should handle wildcards.
diff --git a/src/buffer.c b/src/buffer.c
index ea0c23192b7..73e9839f883 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -519,8 +519,11 @@ See also `find-buffer-visiting'.  */)
   return Qnil;
 }
 
-Lisp_Object
-get_truename_buffer (register Lisp_Object filename)
+DEFUN ("get-truename-buffer", Fget_truename_buffer, Sget_truename_buffer, 1, 
1, 0,
+       doc: /* Return the buffer with `file-truename' equal to FILENAME (a 
string).
+If there is no such live buffer, return nil.
+See also `find-buffer-visiting'.  */)
+  (register Lisp_Object filename)
 {
   register Lisp_Object tail, buf;
 
@@ -533,6 +536,22 @@ get_truename_buffer (register Lisp_Object filename)
   return Qnil;
 }
 
+DEFUN ("find-buffer", Ffind_buffer, Sfind_buffer, 2, 2, 0,
+       doc: /* Return the buffer with buffer-local VARIABLE equal to VALUE.
+              If there is no such live buffer, return nil.
+See also `find-buffer-visiting'.  */)
+  (Lisp_Object variable, Lisp_Object value)
+{
+  register Lisp_Object tail, buf;
+
+  FOR_EACH_LIVE_BUFFER (tail, buf)
+    {
+      if (!NILP (Fequal (value, Fbuffer_local_value(variable, buf))))
+       return buf;
+    }
+  return Qnil;
+}
+
 /* Run buffer-list-update-hook if Vrun_hooks is non-nil and BUF does
    not have buffer hooks inhibited.  */
 
@@ -6010,6 +6029,8 @@ There is no reason to change that value except for 
debugging purposes.  */);
   defsubr (&Sbuffer_list);
   defsubr (&Sget_buffer);
   defsubr (&Sget_file_buffer);
+  defsubr (&Sget_truename_buffer);
+  defsubr (&Sfind_buffer);
   defsubr (&Sget_buffer_create);
   defsubr (&Smake_indirect_buffer);
   defsubr (&Sgenerate_new_buffer_name);
diff --git a/src/filelock.c b/src/filelock.c
index c2b306ab47d..9ce51c724b1 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -563,7 +563,7 @@ lock_file (Lisp_Object fn)
 
   /* See if this file is visited and has changed on disk since it was
      visited.  */
-  Lisp_Object subject_buf = get_truename_buffer (fn);
+  Lisp_Object subject_buf = Fget_truename_buffer (fn);
   if (!NILP (subject_buf)
       && NILP (Fverify_visited_file_modtime (subject_buf))
       && !NILP (Ffile_exists_p (fn))
diff --git a/src/lisp.h b/src/lisp.h
index ed1b007d4c5..efd36465e62 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4664,7 +4664,6 @@ extern void report_overlay_modification (Lisp_Object, 
Lisp_Object, bool,
                                          Lisp_Object, Lisp_Object, 
Lisp_Object);
 extern bool overlay_touches_p (ptrdiff_t);
 extern Lisp_Object other_buffer_safely (Lisp_Object);
-extern Lisp_Object get_truename_buffer (Lisp_Object);
 extern void init_buffer_once (void);
 extern void init_buffer (void);
 extern void syms_of_buffer (void);
diff --git a/test/manual/etags/c-src/emacs/src/lisp.h 
b/test/manual/etags/c-src/emacs/src/lisp.h
index aa8dc8c9a66..19463828270 100644
--- a/test/manual/etags/c-src/emacs/src/lisp.h
+++ b/test/manual/etags/c-src/emacs/src/lisp.h
@@ -4075,7 +4075,6 @@ extern void report_overlay_modification (Lisp_Object, 
Lisp_Object, bool,
                                          Lisp_Object, Lisp_Object, 
Lisp_Object);
 extern bool overlay_touches_p (ptrdiff_t);
 extern Lisp_Object other_buffer_safely (Lisp_Object);
-extern Lisp_Object get_truename_buffer (Lisp_Object);
 extern void init_buffer_once (void);
 extern void init_buffer (int);
 extern void syms_of_buffer (void);