From b030dbce20668386b60212b90ace9f1100620de3 Mon Sep 17 00:00:00 2001 From: Laurence Warne 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