bug#49264: 28.0.50; project.el+tramp performance issue

[Dmitry Gutov <dgutov@yandex.ru>]

[-- Attachment #1: Type: text/plain, Size: 773 bytes --]

Hi again,

On 27.07.2021 02:04, Dmitry Gutov wrote:
> On 26.07.2021 19:56, Ergus via Bug reports for GNU Emacs, the Swiss army 
> knife of text editors wrote:
>> Any progress/suggestion on this?
> 
> Only internally.
> 
> Let me get back to you on this in a couple of days.

Sorry for the long wait, this feature ties into another old discussion, 
and I wasn't sure how to proceed best.

Anyway, here's a patch to try (attached). It should recover performance 
lost back in 4ca13d98c9e while retaining flexibility (and even adding more).

There are still less than optimal places there (e.g. file-in-directory-p 
is not very fast), and the modules list is read from the disk every 
time, so some further optimization should be possible.

But first please try this version.

[-- Attachment #2: project-buffers.diff --]
[-- Type: text/x-patch, Size: 3124 bytes --]

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 4620ea8f47..f164c19ace 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -51,6 +51,11 @@
 ;; files and its relations to external directories.  `project-files'
 ;; should be consistent with `project-ignores'.
 ;;
+;; `project-buffers' can be overridden if the project has some unusual
+;; shape (e.g. it contains files residing outside of its root, or some
+;; files inside the root must not be considered a part of it). It
+;; should be consistent with `project-files'.
+;;
 ;; This list can change in future versions.
 ;;
 ;; VC project:
@@ -334,6 +339,16 @@ project--remote-file-names
                 (concat remote-id file))
               local-files))))
 
+(cl-defgeneric project-buffers (project)
+  "Return the list of all live buffers that belong to PROJECT."
+  (let ((root (project-root project))
+        bufs)
+    (dolist (buf (buffer-list))
+      (when (file-in-directory-p (buffer-local-value 'default-directory buf)
+                                 root)
+        (push buf bufs)))
+    (nreverse bufs)))
+
 (defgroup project-vc nil
   "Project implementation based on the VC package."
   :version "25.1"
@@ -628,6 +643,23 @@ project--value-in-dir
       (hack-dir-local-variables-non-file-buffer))
     (symbol-value var)))
 
+(cl-defmethod project-buffers ((project (head vc)))
+  (let* ((root (project-root project))
+         (modules (unless (or (project--vc-merge-submodules-p root)
+                              (project--submodule-p root))
+                    (mapcar
+                     (lambda (m) (concat root m))
+                     (project--git-submodules))))
+         dd
+         bufs)
+    (dolist (buf (buffer-list))
+      (setq dd (buffer-local-value 'default-directory buf))
+      (when (and (file-in-directory-p dd root)
+                 (not (cl-find-if (lambda (module) (file-in-directory-p dd module))
+                                  modules)))
+        (push buf bufs)))
+    (nreverse bufs)))
+
 \f
 ;;; Project commands
 
@@ -1014,13 +1046,11 @@ project--read-project-buffer
          (current-buffer (current-buffer))
          (other-buffer (other-buffer current-buffer))
          (other-name (buffer-name other-buffer))
+         (buffers (project-buffers pr))
          (predicate
           (lambda (buffer)
             ;; BUFFER is an entry (BUF-NAME . BUF-OBJ) of Vbuffer_alist.
-            (and (cdr buffer)
-                 (equal pr
-                        (with-current-buffer (cdr buffer)
-                          (project-current)))))))
+            (memq (cdr buffer) buffers))))
     (read-buffer
      "Switch to buffer: "
      (when (funcall predicate (cons other-name other-buffer))
@@ -1160,7 +1190,7 @@ project--buffers-to-kill
 What buffers should or should not be killed is described
 in `project-kill-buffer-conditions'."
   (let (bufs)
-    (dolist (buf (project--buffer-list pr))
+    (dolist (buf (project-buffers pr))
       (when (project--kill-buffer-check buf project-kill-buffer-conditions)
         (push buf bufs)))
     bufs))