From 1d71022e6359d017d08a424cb2c04077c804e8a4 Mon Sep 17 00:00:00 2001 From: Laurence Warne Date: Sat, 3 Dec 2022 21:41:57 +0000 Subject: [PATCH] Make proced-update preserve refinements Make proced-update preserve refinements by creating a new buffer local variable proced-refinements which stores information about the current refinements and is used by proced-update to further refine proced-process-alist in the case it is non-nil. The result is that refinements are not immediately cleared when a proced buffer is updated with proced-auto-update-flag non-nil. proced-revert maintains its current behaviour of clearing any active refinements. * lisp/proced.el (proced-refinements): New buffer local variable which tracks the current refinements. (proced-refine): Set proced-refinements variable and defer setting of proced-process-alist to proced-update. (proced-update): Take into account proced-refinements when setting proced-process-alist. (proced-revert): Set proced-refinements to nil prior to calling proced-update. --- lisp/proced.el | 51 ++++++++++++++++++++++++++++++++------------------ 1 file changed, 33 insertions(+), 18 deletions(-) diff --git a/lisp/proced.el b/lisp/proced.el index c7419288ed..e13a804468 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -656,6 +656,14 @@ proced-mode-map ) (put 'proced-mark :advertised-binding "m") +(defvar-local proced-refinements nil + "Information about the current buffer refinements. + +It should be a list of elements of the form (REFINER PID KEY GRAMMAR), where +REFINER and GRAMMAR are as described in `proced-grammar-alist', PID is the +process ID of the process used to create the refinement, and KEY the attribute +of the process. A value of nil indicates that there are no active refinements.") + (easy-menu-define proced-menu proced-mode-map "Proced Menu." `("Proced" @@ -1337,20 +1345,7 @@ proced-refine (let* ((grammar (assq key proced-grammar-alist)) (refiner (nth 7 grammar))) (when refiner - (cond ((functionp (car refiner)) - (setq proced-process-alist (funcall (car refiner) pid))) - ((consp refiner) - (let ((predicate (nth 4 grammar)) - (ref (cdr (assq key (cdr (assq pid proced-process-alist))))) - val new-alist) - (dolist (process proced-process-alist) - (setq val (funcall predicate (cdr (assq key (cdr process))) ref)) - (if (cond ((not val) (nth 2 refiner)) - ((eq val 'equal) (nth 1 refiner)) - (val (car refiner))) - (push process new-alist))) - (setq proced-process-alist new-alist)))) - ;; Do not revert listing. + (add-to-list 'proced-refinements (list refiner pid key grammar) t) (proced-update))) (message "No refiner defined here.")))) @@ -1859,10 +1854,29 @@ proced-update "Updating process display..."))) (if revert ;; evaluate all processes (setq proced-process-alist (proced-process-attributes))) - ;; filtering and sorting + ;; filtering + (setq proced-process-alist (proced-filter proced-process-alist proced-filter)) + ;; refinements + (pcase-dolist (`(,refiner ,pid ,key ,grammar) proced-refinements) + ;; It's possible the process has exited since the refinement was made + (when (assq pid proced-process-alist) + (cond ((functionp (car refiner)) + (setq proced-process-alist (funcall (car refiner) pid))) + ((consp refiner) + (let ((predicate (nth 4 grammar)) + (ref (cdr (assq key (cdr (assq pid proced-process-alist))))) + val new-alist) + (dolist (process proced-process-alist) + (setq val (funcall predicate (cdr (assq key (cdr process))) ref)) + (when (cond ((not val) (nth 2 refiner)) + ((eq val 'equal) (nth 1 refiner)) + (val (car refiner))) + (push process new-alist))) + (setq proced-process-alist new-alist)))))) + + ;; sorting (setq proced-process-alist - (proced-sort (proced-filter proced-process-alist proced-filter) - proced-sort proced-descend)) + (proced-sort proced-process-alist proced-sort proced-descend)) ;; display as process tree? (setq proced-process-alist @@ -1976,7 +1990,8 @@ proced-update (defun proced-revert (&rest _args) "Reevaluate the process listing based on the currently running processes. -Preserves point and marks." +Preserves point and marks, but not refinements." + (setq proced-refinements nil) (proced-update t)) (defun proced-marked-processes () -- 2.30.2