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

@@ -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))
+  (or (let ((buf (get-file-buffer filename)))
-        (truename (abbreviate-file-name (file-truename filename))))
+        (when (and buf (or (not predicate) (funcall predicate buf))) buf))
-    (or (let ((buf (get-file-buffer filename)))
+      (let ((truename (abbreviate-file-name (file-truename filename))))
-          (when (and buf (funcall predicate buf)) buf))
+        (or
-        (let ((list (buffer-list)) found)
+         (let ((buf (get-truename-buffer truename)))
-          (while (and (not found) list)
+           (when (and buf (buffer-local-value 'buffer-file-name buf)
-            (with-current-buffer (car list)
+                      (or (not predicate) (funcall predicate buf)))
-              (if (and buffer-file-name
+             buf))
-                       (string= buffer-file-truename truename)
+         (let* ((attributes (file-attributes truename))
-                       (funcall predicate (current-buffer)))
+                (number (file-attribute-file-identifier attributes)))
-                  (setq found (car list))))
+           (and buffer-file-numbers-unique
-            (setq list (cdr list)))
+                (car-safe number)       ;Make sure the inode is not just nil.
-          found)
+                (let ((buf (find-buffer 'buffer-file-number number)))
-        (let* ((attributes (file-attributes truename))
+                  (when (and buf (buffer-local-value 'buffer-file-name buf)
-               (number (file-attribute-file-identifier attributes))
+                             ;; Verify this buffer's file number
-               (list (buffer-list)) found)
+                             ;; still belongs to its file.
-          (and buffer-file-numbers-unique
+                             (file-exists-p buffer-file-name)
-               (car-safe number)       ;Make sure the inode is not just nil.
+                             (equal (file-attributes buffer-file-truename)
-               (while (and (not found) list)
+                                    attributes)
-                 (with-current-buffer (car list)
+                             (or (not predicate)
-                   (if (and buffer-file-name
+                                 (funcall predicate (current-buffer))))
-                            (equal buffer-file-number number)
+                    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)
-                            (funcall predicate (current-buffer)))
-                       (setq found (car list))))
-                 (setq list (cdr list))))
-          found))))
 
 (defcustom find-file-wildcards t
   "Non-nil means file-visiting commands should handle wildcards.

src/buffer.c

@@ -519,8 +519,11 @@ See also `find-buffer-visiting'.  */)
   return Qnil;
 }
 
-Lisp_Object
+DEFUN ("get-truename-buffer", Fget_truename_buffer, Sget_truename_buffer, 1, 1, 0,
-get_truename_buffer (register Lisp_Object filename)
+       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);

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))

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);

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);