From: Laurence Warne <laurencewarne@gmail.com>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 60381@debbugs.gnu.org
Subject: bug#60381: [PATCH] Preserve Window Position with Proced
Date: Sat, 7 Jan 2023 17:23:36 +0000 [thread overview]
Message-ID: <CAE2oLqgRyvLAW43g7B2gzZzBhR2QgQVWTHFQjidA1eou_r4pRw@mail.gmail.com> (raw)
In-Reply-To: <83mt6uscd2.fsf@gnu.org>
[-- Attachment #1.1: Type: text/plain, Size: 331 bytes --]
Cool, I think I've now fixed the second issue (preserving the position in
proced buffers which are not displayed in any window) using your suggestion
of setting switch-to-buffer-preserve-window-point locally to nil in proced
buffers. I've attached a new patch, the same as the previous one but with
one line change for the above.
[-- Attachment #1.2: Type: text/html, Size: 373 bytes --]
[-- Attachment #2: 0001-Preserve-the-window-position-with-proced.patch --]
[-- Type: text/x-patch, Size: 8996 bytes --]
From b030dbce20668386b60212b90ace9f1100620de3 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.
Similarly, preserve the position in proced buffers which are not
displayed in any window by setting
switch-to-buffer-preserve-window-point to nil in proced buffers.
* 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.
(proced--position-info, proced--determine-pos): New Functions.
(proced-mode): Set switch-to-buffer-preserve-window-point to nil in
proced buffers.
* test/lisp/proced-tests.el
(proced-update-preserves-pid-at-point-test): New test.
---
lisp/proced.el | 104 ++++++++++++++++++++++++++------------
test/lisp/proced-tests.el | 17 +++++++
2 files changed, 88 insertions(+), 33 deletions(-)
diff --git a/lisp/proced.el b/lisp/proced.el
index c09ee18a8b..d8a11bd778 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"
@@ -847,6 +893,7 @@ proced-mode
(setq-local revert-buffer-function #'proced-revert)
(setq-local font-lock-defaults
'(proced-font-lock-keywords t nil nil beginning-of-line))
+ (setq-local switch-to-buffer-preserve-window-point nil)
(if (and (not proced-auto-update-timer) proced-auto-update-interval)
(setq proced-auto-update-timer
(run-at-time t proced-auto-update-interval
@@ -1889,17 +1936,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 +1972,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 +1982,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
next prev parent reply other threads:[~2023-01-07 17:23 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-12-28 15:55 bug#60381: [PATCH] Preserve Window Position with Proced Laurence Warne
2022-12-28 17:14 ` Eli Zaretskii
2022-12-28 20:30 ` Laurence Warne
2022-12-29 6:09 ` Eli Zaretskii
2022-12-29 12:52 ` Laurence Warne
2022-12-29 14:09 ` Eli Zaretskii
[not found] ` <CAE2oLqh5i-fFVeYwyRufWhFZzrxDCfO+VrWFpe3tRLW9OJKUbg@mail.gmail.com>
2022-12-29 17:37 ` Eli Zaretskii
2023-01-05 15:59 ` Laurence Warne
2023-01-07 9:28 ` Eli Zaretskii
2023-01-07 11:58 ` Laurence Warne
2023-01-07 13:28 ` Eli Zaretskii
2023-01-07 17:23 ` Laurence Warne [this message]
2023-01-14 8:40 ` Eli Zaretskii
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=CAE2oLqgRyvLAW43g7B2gzZzBhR2QgQVWTHFQjidA1eou_r4pRw@mail.gmail.com \
--to=laurencewarne@gmail.com \
--cc=60381@debbugs.gnu.org \
--cc=eliz@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.