bug#60381: [PATCH] Preserve Window Position with Proced

[Laurence Warne <laurencewarne@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 2111 bytes --]

Hi,

Minor update, whilst working on the first case, I've come across some
strange behaviour which causes the window position to be reset to
(point-min) in some circumstances.  To reproduce this with a more minimal
setup than proced-update (I've also asked here:
https://emacs.stackexchange.com/questions/75165/window-point-reset-after-update
):

(defun example ()
  (interactive)
  (let* ((buf (get-buffer-create "*Example*"))
         (w-points (mapcar (lambda (win)
                             `(,win . ,(window-point win)))
                           (get-buffer-window-list buf))))
    (with-current-buffer buf
      (let ((buf-point (point)))
        (erase-buffer)
        (insert "line1\nline2\nline3\nline4\nline5")
        (goto-char buf-point)
        (mapc (lambda (wp) (set-window-point (car wp) (cdr wp))) w-points)))
    (message "Ran update")))

(setq example-timer (run-at-time t 5 #'example))

Now with a configuration of two windows, switch to the example buffer in
one of them, and move down a few lines. Switch to the other window, you
should see the window point stay the same after every update.

If you then invoke M-x, wait for an update to occur, and then cancel the
invocation using C-g, then you should see the point in the window
displaying the example buffer go back to the start of the window. I've
created a video here:
https://user-images.githubusercontent.com/17688577/210167335-f7a4d50f-dbaf-4ffc-b1e0-38c5612ed2e3.mp4.
I'm a bit confused by this, any pointers would be greatly appreciated.
On the upside, I've managed to put together a test which won't pass without
the patch.

In terms of the difference between this patch and the original, the new
patch maintains the window point for all windows which display a proced
buffer.  The original just set the window point for one, as a consequence
all windows displaying the proced buffer in question would have their point
set to the most recently visited window displaying the buffer.   I've had
to extract out some logic from proced-update to separate functions, and so
this patch is a bit more invasive.

Thanks, Laurence

[-- Attachment #1.2: Type: text/html, Size: 3944 bytes --]

[-- Attachment #2: 0001-Preserve-the-window-position-with-proced.patch --]
[-- Type: text/x-patch, Size: 8264 bytes --]

From d2135211cf5adcc2a510f7d250d520e8fb58a3d9 Mon Sep 17 00:00:00 2001
From: Laurence Warne <laurencewarne@gmail.com>
Date: Thu, 22 Dec 2022 17:16:08 +0000
Subject: [PATCH] Preserve the window position with proced

Preserve the window position for windows which display a proced buffer,
but are not the selected window when a proced buffer is updated.  Previously,
the window position would be set to the start of the buffer when a
proced buffer was updated and it was not displayed in the selected window.

* lisp/proced.el (proced-auto-update-timer): Only update a given
proced buffer if it is displayed in a window.
(proced-update): Set the window position if the proced buffer is
displayed in a window.
* test/lisp/proced-tests.el
(proced-update-preserves-pid-at-point-test): New test.
---
 lisp/proced.el            | 103 ++++++++++++++++++++++++++------------
 test/lisp/proced-tests.el |  17 +++++++
 2 files changed, 87 insertions(+), 33 deletions(-)

diff --git a/lisp/proced.el b/lisp/proced.el
index c09ee18a8b..858540d540 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -792,6 +792,52 @@ proced-pid-at-point
     (if (looking-at "^. .")
         (get-text-property (match-end 0) 'proced-pid))))
 
+(defun proced--position-info (pos)
+  "Return information of the process at POS.
+
+The returned information will have the form `(PID KEY COLUMN)' where
+PID is the process ID of the process at point, KEY is the value of the
+proced-key text property at point, and COLUMN is the column for which the
+current value of the proced-key text property starts, or 0 if KEY is nil."
+  ;; If point is on a field, we try to return point to that field.
+  ;; Otherwise we try to return to the same column
+  (save-excursion
+    (goto-char pos)
+    (let ((pid (proced-pid-at-point))
+          (key (get-text-property (point) 'proced-key)))
+      (list pid key ; can both be nil
+            (if key
+                (if (get-text-property (1- (point)) 'proced-key)
+                    (- (point) (previous-single-property-change
+                                (point) 'proced-key))
+                  0)
+              (current-column))))))
+
+(defun proced--determine-pos (key column)
+  "Return the point in the current line using KEY and COLUMN.
+
+Attempt to find the first position on the current line where the
+text property proced-key is equal to KEY.  If this is not possible, return
+the point of column COLUMN on the current line."
+  (save-excursion
+    (let (new-pos)
+      (if key
+          (let ((limit (line-end-position)) pos)
+            (while (and (not new-pos)
+                        (setq pos (next-property-change (point) nil limit)))
+              (goto-char pos)
+              (when (eq key (get-text-property (point) 'proced-key))
+                (forward-char (min column (- (next-property-change (point))
+                                             (point))))
+                (setq new-pos (point))))
+            (unless new-pos
+              ;; we found the process, but the field of point
+              ;; is not listed anymore
+              (setq new-pos (proced-move-to-goal-column))))
+        (setq new-pos (min (+ (line-beginning-position) column)
+                           (line-end-position))))
+      new-pos)))
+
 ;; proced mode
 
 (define-derived-mode proced-mode special-mode "Proced"
@@ -1889,17 +1935,10 @@ proced-update
   (if (consp buffer-undo-list)
       (setq buffer-undo-list nil))
   (let ((buffer-undo-list t)
-        ;; If point is on a field, we try to return point to that field.
-        ;; Otherwise we try to return to the same column
-        (old-pos (let ((pid (proced-pid-at-point))
-                       (key (get-text-property (point) 'proced-key)))
-                   (list pid key ; can both be nil
-                         (if key
-                             (if (get-text-property (1- (point)) 'proced-key)
-                                 (- (point) (previous-single-property-change
-                                             (point) 'proced-key))
-                               0)
-                           (current-column)))))
+        (window-pos-infos
+         (mapcar (lambda (w) `(,w . ,(proced--position-info (window-point w))))
+                 (get-buffer-window-list (current-buffer) nil t)))
+        (old-pos (proced--position-info (point)))
         buffer-read-only mp-list)
     ;; remember marked processes (whatever the mark was)
     (goto-char (point-min))
@@ -1932,7 +1971,8 @@ proced-update
     ;; Sometimes this puts point in the middle of the proced buffer
     ;; where it is not interesting.  Is there a better / more flexible solution?
     (goto-char (point-min))
-    (let (pid mark new-pos)
+
+    (let (pid mark new-pos win-points)
       (if (or mp-list (car old-pos))
           (while (not (eobp))
             (setq pid (proced-pid-at-point))
@@ -1941,28 +1981,25 @@ proced-update
               (delete-char 1)
               (beginning-of-line))
             (when (eq (car old-pos) pid)
-              (if (nth 1 old-pos)
-                  (let ((limit (line-end-position)) pos)
-                    (while (and (not new-pos)
-                                (setq pos (next-property-change (point) nil limit)))
-                      (goto-char pos)
-                      (when (eq (nth 1 old-pos)
-                                (get-text-property (point) 'proced-key))
-                        (forward-char (min (nth 2 old-pos)
-                                           (- (next-property-change (point))
-                                              (point))))
-                        (setq new-pos (point))))
-                    (unless new-pos
-                      ;; we found the process, but the field of point
-                      ;; is not listed anymore
-                      (setq new-pos (proced-move-to-goal-column))))
-                (setq new-pos (min (+ (line-beginning-position) (nth 2 old-pos))
-                                   (line-end-position)))))
+              (setq new-pos (proced--determine-pos (nth 1 old-pos)
+                                                   (nth 2 old-pos))))
+            (mapc (lambda (w-pos)
+                    (when (eq (cadr w-pos) pid)
+                      (push `(,(car w-pos) . ,(proced--determine-pos
+                                               (nth 1 (cdr w-pos))
+                                               (nth 2 (cdr w-pos))))
+                            win-points)))
+                  window-pos-infos)
             (forward-line)))
-      (if new-pos
-          (goto-char new-pos)
-        (goto-char (point-min))
-        (proced-move-to-goal-column)))
+      (let ((fallback (save-excursion (goto-char (point-min))
+                                      (proced-move-to-goal-column)
+                                      (point))))
+        (goto-char (or new-pos fallback))
+        ;; Update window points
+        (mapc (lambda (w-pos)
+                (set-window-point (car w-pos)
+                                  (alist-get (car w-pos) win-points fallback)))
+              window-pos-infos)))
     ;; update mode line
     ;; Does the long `mode-name' clutter the mode line?  It would be nice
     ;; to have some other location for displaying the values of the various
diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el
index 3c1f5493e7..1f47566529 100644
--- a/test/lisp/proced-tests.el
+++ b/test/lisp/proced-tests.el
@@ -101,5 +101,22 @@ proced-refine-with-update-test
        (should (string= pid (word-at-point)))
        (forward-line)))))
 
+(ert-deftest proced-update-preserves-pid-at-point-test ()
+  (proced--within-buffer
+   'medium
+   'user
+   (goto-char (point-min))
+   (search-forward (number-to-string (emacs-pid)))
+   (proced--move-to-column "PID")
+   (save-window-excursion
+     (let ((pid (proced-pid-at-point))
+           (new-window (split-window))
+           (old-window (get-buffer-window)))
+       (select-window new-window)
+       (with-current-buffer "*Proced*"
+         (proced-update t t))
+       (select-window old-window)
+       (should (= pid (proced-pid-at-point)))))))
+
 (provide 'proced-tests)
 ;;; proced-tests.el ends here
-- 
2.30.2