diff options
| author | Laurence Warne | 2022-12-03 21:41:57 +0000 |
|---|---|---|
| committer | Eli Zaretskii | 2022-12-14 16:32:10 +0200 |
| commit | 7b8f3e00dd0ff1083f22d07b7ce3ecc3b5a6a032 (patch) | |
| tree | 7ed4c0d36bcf01d4b20b8d5849cda6a0c6f13939 | |
| parent | 42c757913a4c6acc07f8904df7def6b720bb23b4 (diff) | |
| download | emacs-7b8f3e00dd0ff1083f22d07b7ce3ecc3b5a6a032.tar.gz emacs-7b8f3e00dd0ff1083f22d07b7ce3ecc3b5a6a032.zip | |
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'.
| -rw-r--r-- | lisp/proced.el | 52 |
1 files changed, 34 insertions, 18 deletions
diff --git a/lisp/proced.el b/lisp/proced.el index c7419288edf..c09ee18a8be 100644 --- a/lisp/proced.el +++ b/lisp/proced.el | |||
| @@ -656,6 +656,14 @@ Important: the match ends just after the marker.") | |||
| 656 | ) | 656 | ) |
| 657 | (put 'proced-mark :advertised-binding "m") | 657 | (put 'proced-mark :advertised-binding "m") |
| 658 | 658 | ||
| 659 | (defvar-local proced-refinements nil | ||
| 660 | "Information about the current buffer refinements. | ||
| 661 | |||
| 662 | It should be a list of elements of the form (REFINER PID KEY GRAMMAR), where | ||
| 663 | REFINER and GRAMMAR are as described in `proced-grammar-alist', PID is the | ||
| 664 | process ID of the process used to create the refinement, and KEY the attribute | ||
| 665 | of the process. A value of nil indicates that there are no active refinements.") | ||
| 666 | |||
| 659 | (easy-menu-define proced-menu proced-mode-map | 667 | (easy-menu-define proced-menu proced-mode-map |
| 660 | "Proced Menu." | 668 | "Proced Menu." |
| 661 | `("Proced" | 669 | `("Proced" |
| @@ -1337,20 +1345,7 @@ a certain refinement, consider defining a new filter in `proced-filter-alist'." | |||
| 1337 | (let* ((grammar (assq key proced-grammar-alist)) | 1345 | (let* ((grammar (assq key proced-grammar-alist)) |
| 1338 | (refiner (nth 7 grammar))) | 1346 | (refiner (nth 7 grammar))) |
| 1339 | (when refiner | 1347 | (when refiner |
| 1340 | (cond ((functionp (car refiner)) | 1348 | (add-to-list 'proced-refinements (list refiner pid key grammar) t) |
| 1341 | (setq proced-process-alist (funcall (car refiner) pid))) | ||
| 1342 | ((consp refiner) | ||
| 1343 | (let ((predicate (nth 4 grammar)) | ||
| 1344 | (ref (cdr (assq key (cdr (assq pid proced-process-alist))))) | ||
| 1345 | val new-alist) | ||
| 1346 | (dolist (process proced-process-alist) | ||
| 1347 | (setq val (funcall predicate (cdr (assq key (cdr process))) ref)) | ||
| 1348 | (if (cond ((not val) (nth 2 refiner)) | ||
| 1349 | ((eq val 'equal) (nth 1 refiner)) | ||
| 1350 | (val (car refiner))) | ||
| 1351 | (push process new-alist))) | ||
| 1352 | (setq proced-process-alist new-alist)))) | ||
| 1353 | ;; Do not revert listing. | ||
| 1354 | (proced-update))) | 1349 | (proced-update))) |
| 1355 | (message "No refiner defined here.")))) | 1350 | (message "No refiner defined here.")))) |
| 1356 | 1351 | ||
| @@ -1859,10 +1854,29 @@ After updating a displayed Proced buffer run the normal hook | |||
| 1859 | "Updating process display..."))) | 1854 | "Updating process display..."))) |
| 1860 | (if revert ;; evaluate all processes | 1855 | (if revert ;; evaluate all processes |
| 1861 | (setq proced-process-alist (proced-process-attributes))) | 1856 | (setq proced-process-alist (proced-process-attributes))) |
| 1862 | ;; filtering and sorting | 1857 | ;; filtering |
| 1858 | (setq proced-process-alist (proced-filter proced-process-alist proced-filter)) | ||
| 1859 | ;; refinements | ||
| 1860 | (pcase-dolist (`(,refiner ,pid ,key ,grammar) proced-refinements) | ||
| 1861 | ;; It's possible the process has exited since the refinement was made | ||
| 1862 | (when (assq pid proced-process-alist) | ||
| 1863 | (cond ((functionp (car refiner)) | ||
| 1864 | (setq proced-process-alist (funcall (car refiner) pid))) | ||
| 1865 | ((consp refiner) | ||
| 1866 | (let ((predicate (nth 4 grammar)) | ||
| 1867 | (ref (cdr (assq key (cdr (assq pid proced-process-alist))))) | ||
| 1868 | val new-alist) | ||
| 1869 | (dolist (process proced-process-alist) | ||
| 1870 | (setq val (funcall predicate (cdr (assq key (cdr process))) ref)) | ||
| 1871 | (when (cond ((not val) (nth 2 refiner)) | ||
| 1872 | ((eq val 'equal) (nth 1 refiner)) | ||
| 1873 | (val (car refiner))) | ||
| 1874 | (push process new-alist))) | ||
| 1875 | (setq proced-process-alist new-alist)))))) | ||
| 1876 | |||
| 1877 | ;; sorting | ||
| 1863 | (setq proced-process-alist | 1878 | (setq proced-process-alist |
| 1864 | (proced-sort (proced-filter proced-process-alist proced-filter) | 1879 | (proced-sort proced-process-alist proced-sort proced-descend)) |
| 1865 | proced-sort proced-descend)) | ||
| 1866 | 1880 | ||
| 1867 | ;; display as process tree? | 1881 | ;; display as process tree? |
| 1868 | (setq proced-process-alist | 1882 | (setq proced-process-alist |
| @@ -1976,7 +1990,9 @@ After updating a displayed Proced buffer run the normal hook | |||
| 1976 | 1990 | ||
| 1977 | (defun proced-revert (&rest _args) | 1991 | (defun proced-revert (&rest _args) |
| 1978 | "Reevaluate the process listing based on the currently running processes. | 1992 | "Reevaluate the process listing based on the currently running processes. |
| 1979 | Preserves point and marks." | 1993 | Preserves point and marks, but not refinements (see `proced-refine' for |
| 1994 | information on refinements)." | ||
| 1995 | (setq proced-refinements nil) | ||
| 1980 | (proced-update t)) | 1996 | (proced-update t)) |
| 1981 | 1997 | ||
| 1982 | (defun proced-marked-processes () | 1998 | (defun proced-marked-processes () |