diff options
| author | Roland Winkler | 2008-12-14 17:41:29 +0000 |
|---|---|---|
| committer | Roland Winkler | 2008-12-14 17:41:29 +0000 |
| commit | b4f671ce5443c03c64e45a75a644712e438dbe22 (patch) | |
| tree | 8ae56d12330a2475e2cfcdc8dbf3dd77576764b8 | |
| parent | 413e65fe7ee7c466434680c8e1503d3ac77516cd (diff) | |
| download | emacs-b4f671ce5443c03c64e45a75a644712e438dbe22.tar.gz emacs-b4f671ce5443c03c64e45a75a644712e438dbe22.zip | |
(proced-grammar-alist): Allow refiner elements that
are cons pairs (function . help-echo) or nil.
(proced-refine): Use them.
(proced-format-alist): Allow alternatives.
(proced-descend): New variable.
(proced-sort): New arg descend.
(proced-sort-interactive): Repeated calls toggle sort order.
(proced-format): Accomodate changes of proced-format-alist.
Undefined attributes are displayed as "?".
(proced-process-attributes): New optional arg pid-list.
Ignore processes with empty attribute list.
| -rw-r--r-- | lisp/ChangeLog | 24 | ||||
| -rw-r--r-- | lisp/proced.el | 299 |
2 files changed, 222 insertions, 101 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9d30d7c3d73..bc03ab78c01 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,27 @@ | |||
| 1 | 2008-12-14 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> | ||
| 2 | |||
| 3 | * proced.el (proced-grammar-alist): Allow refiner elements that | ||
| 4 | are cons pairs (function . help-echo) or nil. | ||
| 5 | (proced-refine): Use them. | ||
| 6 | (proced-format-alist): Allow alternatives. | ||
| 7 | (proced-descend): New variable. | ||
| 8 | (proced-sort): New arg descend. | ||
| 9 | (proced-sort-interactive): Repeated calls toggle sort order. | ||
| 10 | (proced-format): Accomodate changes of proced-format-alist. | ||
| 11 | Undefined attributes are displayed as "?". | ||
| 12 | (proced-process-attributes): New optional arg pid-list. | ||
| 13 | Ignore processes with empty attribute list. | ||
| 14 | |||
| 15 | 2008-12-14 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> | ||
| 16 | |||
| 17 | * proced.el (proced-auto-update-interval): Renamed from | ||
| 18 | proced-timer-interval. | ||
| 19 | (proced-auto-update-flag): Renamed from proced-timer-flag. | ||
| 20 | (proced-auto-update-timer): Renamed from proced-timer. | ||
| 21 | (proced-toggle-auto-update): Renamed from | ||
| 22 | proced-toggle-timer-flag. | ||
| 23 | (proced-available): Initialize appropriately. | ||
| 24 | |||
| 1 | 2008-12-13 Glenn Morris <rgm@gnu.org> | 25 | 2008-12-13 Glenn Morris <rgm@gnu.org> |
| 2 | 26 | ||
| 3 | * subr.el (declare-function): Doc fix. | 27 | * subr.el (declare-function): Doc fix. |
diff --git a/lisp/proced.el b/lisp/proced.el index 5dd0b7a6625..2988925c1d0 100644 --- a/lisp/proced.el +++ b/lisp/proced.el | |||
| @@ -104,7 +104,9 @@ the external command (usually \"kill\")." | |||
| 104 | (group "GROUP" nil left proced-string-lessp nil (group user pid) (nil t nil)) | 104 | (group "GROUP" nil left proced-string-lessp nil (group user pid) (nil t nil)) |
| 105 | (comm "COMMAND" nil left proced-string-lessp nil (comm pid) (nil t nil)) | 105 | (comm "COMMAND" nil left proced-string-lessp nil (comm pid) (nil t nil)) |
| 106 | (state "STAT" nil left proced-string-lessp nil (state pid) (nil t nil)) | 106 | (state "STAT" nil left proced-string-lessp nil (state pid) (nil t nil)) |
| 107 | (ppid "PPID" "%d" right proced-< nil (ppid pid) (nil t nil)) | 107 | (ppid "PPID" "%d" right proced-< nil (ppid pid) |
| 108 | ((lambda (ppid) (proced-filter-parents proced-process-alist ppid)) . | ||
| 109 | "refine to process parents")) | ||
| 108 | (pgrp "PGRP" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) | 110 | (pgrp "PGRP" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) |
| 109 | (sess "SESS" "%d" right proced-< nil (sess pid) (nil t nil)) | 111 | (sess "SESS" "%d" right proced-< nil (sess pid) (nil t nil)) |
| 110 | (ttname "TTY" proced-format-ttname left proced-string-lessp nil (ttname pid) (nil t nil)) | 112 | (ttname "TTY" proced-format-ttname left proced-string-lessp nil (ttname pid) (nil t nil)) |
| @@ -129,7 +131,9 @@ the external command (usually \"kill\")." | |||
| 129 | (args "ARGS" proced-format-args left proced-string-lessp nil (args pid) (nil t nil)) | 131 | (args "ARGS" proced-format-args left proced-string-lessp nil (args pid) (nil t nil)) |
| 130 | ;; | 132 | ;; |
| 131 | ;; attributes defined by proced (see `proced-process-attributes') | 133 | ;; attributes defined by proced (see `proced-process-attributes') |
| 132 | (pid "PID" "%d" right proced-< nil (pid) (t t nil)) | 134 | (pid "PID" "%d" right proced-< nil (pid) |
| 135 | ((lambda (ppid) (proced-filter-children proced-process-alist ppid)) . | ||
| 136 | "refine to process children")) | ||
| 133 | ;; time: sum of utime and stime | 137 | ;; time: sum of utime and stime |
| 134 | (time "TIME" proced-format-time right proced-time-lessp t (time pid) (nil t t)) | 138 | (time "TIME" proced-format-time right proced-time-lessp t (time pid) (nil t t)) |
| 135 | ;; ctime: sum of cutime and cstime | 139 | ;; ctime: sum of cutime and cstime |
| @@ -138,7 +142,7 @@ the external command (usually \"kill\")." | |||
| 138 | 142 | ||
| 139 | Each element has the form | 143 | Each element has the form |
| 140 | 144 | ||
| 141 | (KEY NAME FORMAT JUSTIFY PREDICATE REVERSE SORT-SCHEME REFINE-FLAGS). | 145 | (KEY NAME FORMAT JUSTIFY PREDICATE REVERSE SORT-SCHEME REFINER). |
| 142 | 146 | ||
| 143 | Symbol KEY is the car of a process attribute. | 147 | Symbol KEY is the car of a process attribute. |
| 144 | 148 | ||
| @@ -161,8 +165,8 @@ the corresponding attribute values of two processes. PREDICATE should | |||
| 161 | return 'equal if P1 has same rank like P2. Any other non-nil value says | 165 | return 'equal if P1 has same rank like P2. Any other non-nil value says |
| 162 | that P1 is \"less than\" P2, or nil if not. | 166 | that P1 is \"less than\" P2, or nil if not. |
| 163 | 167 | ||
| 164 | REVERSE is non-nil if the sort order is opposite to the order defined | 168 | PREDICATE defines an ascending sort order. REVERSE is non-nil if the sort |
| 165 | by PREDICATE. | 169 | order is descending. |
| 166 | 170 | ||
| 167 | SORT-SCHEME is a list (KEY1 KEY2 ...) defining a hierarchy of rules | 171 | SORT-SCHEME is a list (KEY1 KEY2 ...) defining a hierarchy of rules |
| 168 | for sorting the process listing. KEY1, KEY2, ... are KEYs appearing as cars | 172 | for sorting the process listing. KEY1, KEY2, ... are KEYs appearing as cars |
| @@ -170,14 +174,21 @@ of `proced-grammar-alist'. First the PREDICATE of KEY1 is evaluated. | |||
| 170 | If it yields non-equal, it defines the sort order for the corresponding | 174 | If it yields non-equal, it defines the sort order for the corresponding |
| 171 | processes. If it evaluates to 'equal the PREDICATE of KEY2 is evaluated, etc. | 175 | processes. If it evaluates to 'equal the PREDICATE of KEY2 is evaluated, etc. |
| 172 | 176 | ||
| 173 | REFINE-FLAGS is a list (LESS-B EQUAL-B LARGER-B) used by the command | 177 | REFINER can be a list of flags (LESS-B EQUAL-B LARGER-B) used by the command |
| 174 | `proced-refine' (see there) to refine the listing based on attribute KEY. | 178 | `proced-refine' (see there) to refine the listing based on attribute KEY. |
| 175 | This command compares the value of attribute KEY of every process with | 179 | This command compares the value of attribute KEY of every process with |
| 176 | the value of attribute KEY of the process at the position of point | 180 | the value of attribute KEY of the process at the position of point |
| 177 | using PREDICATE. | 181 | using PREDICATE. |
| 178 | If PREDICATE yields non-nil, the process is accepted if LESS-B is non-nil. | 182 | If PREDICATE yields non-nil, the process is accepted if LESS-B is non-nil. |
| 179 | If PREDICATE yields 'equal, the process is accepted if EQUAL-B is non-nil. | 183 | If PREDICATE yields 'equal, the process is accepted if EQUAL-B is non-nil. |
| 180 | If PREDICATE yields nil, the process is accepted if LARGER-B is non-nil." | 184 | If PREDICATE yields nil, the process is accepted if LARGER-B is non-nil. |
| 185 | |||
| 186 | REFINER can also be a cons pair (FUNCTION . HELP-ECHO). | ||
| 187 | FUNCTION is called with one argument, the PID of the process at the position | ||
| 188 | of point. The function must return a list of PIDs that is used for the refined | ||
| 189 | listing. HELP-ECHO is a string that is shown when mouse is over this field. | ||
| 190 | |||
| 191 | If REFINER is nil no refinement is done." | ||
| 181 | :group 'proced | 192 | :group 'proced |
| 182 | :type '(repeat (list :tag "Attribute" | 193 | :type '(repeat (list :tag "Attribute" |
| 183 | (symbol :tag "Key") | 194 | (symbol :tag "Key") |
| @@ -191,12 +202,16 @@ If PREDICATE yields nil, the process is accepted if LARGER-B is non-nil." | |||
| 191 | (const :tag "right" right) | 202 | (const :tag "right" right) |
| 192 | (integer :tag "width")) | 203 | (integer :tag "width")) |
| 193 | (function :tag "Predicate") | 204 | (function :tag "Predicate") |
| 194 | (boolean :tag "Reverse Sort Order") | 205 | (boolean :tag "Descending Sort Order") |
| 195 | (repeat :tag "Sort Scheme" (symbol :tag "Key")) | 206 | (repeat :tag "Sort Scheme" (symbol :tag "Key")) |
| 196 | (list :tag "Refine Flags" | 207 | (choice :tag "Refiner" |
| 197 | (boolean :tag "Less") | 208 | (list :tag "Refine Flags" |
| 198 | (boolean :tag "Equal") | 209 | (boolean :tag "Less") |
| 199 | (boolean :tag "Larger"))))) | 210 | (boolean :tag "Equal") |
| 211 | (boolean :tag "Larger")) | ||
| 212 | (cons (function :tag "Refinement Function") | ||
| 213 | (string :tag "Help echo")) | ||
| 214 | (const :tag "None" nil))))) | ||
| 200 | 215 | ||
| 201 | (defcustom proced-custom-attributes nil | 216 | (defcustom proced-custom-attributes nil |
| 202 | "List of functions defining custom attributes. | 217 | "List of functions defining custom attributes. |
| @@ -217,19 +232,25 @@ If the function returns nil, the value is ignored." | |||
| 217 | ;; Sorting can also be based on attributes that are invisible in the listing. | 232 | ;; Sorting can also be based on attributes that are invisible in the listing. |
| 218 | 233 | ||
| 219 | (defcustom proced-format-alist | 234 | (defcustom proced-format-alist |
| 220 | '((short user pid pcpu pmem start time args) | 235 | '((short user pid pcpu pmem start time (args comm)) |
| 221 | (medium user pid pcpu pmem vsize rss ttname state start time args) | 236 | (medium user pid pcpu pmem vsize rss ttname state start time (args comm)) |
| 222 | (long user euid group pid pri nice pcpu pmem vsize rss ttname state | 237 | (long user euid group pid pri nice pcpu pmem vsize rss ttname state |
| 223 | start time args) | 238 | start time (args comm)) |
| 224 | (verbose user euid group egid pid ppid pgrp sess comm pri nice pcpu pmem | 239 | (verbose user euid group egid pid ppid pgrp sess pri nice pcpu pmem |
| 225 | state thcount vsize rss ttname tpgid minflt majflt cminflt cmajflt | 240 | state thcount vsize rss ttname tpgid minflt majflt cminflt cmajflt |
| 226 | start time utime stime ctime cutime cstime etime args)) | 241 | start time utime stime ctime cutime cstime etime (args comm))) |
| 227 | "Alist of formats of listing. | 242 | "Alist of formats of listing. |
| 228 | The car of each element is a symbol, the name of the format. | 243 | The car of each element is a symbol, the name of the format. |
| 229 | The cdr is a list of keys appearing in `proced-grammar-alist'." | 244 | The cdr is a list of attribute keys appearing in `proced-grammar-alist'. |
| 245 | An element of this list may also be a list of attribute keys that specifies | ||
| 246 | alternatives. If the first attribute is absent for a process, use the second | ||
| 247 | one, etc." | ||
| 230 | :group 'proced | 248 | :group 'proced |
| 231 | :type '(alist :key-type (symbol :tag "Format Name") | 249 | :type '(alist :key-type (symbol :tag "Format Name") |
| 232 | :value-type (repeat :tag "Keys" (symbol :tag "")))) | 250 | :value-type (repeat :tag "Keys" |
| 251 | (choice (symbol :tag "") | ||
| 252 | (repeat :tag "Alternative Keys" | ||
| 253 | (symbol :tag "")))))) | ||
| 233 | 254 | ||
| 234 | (defcustom proced-format 'short | 255 | (defcustom proced-format 'short |
| 235 | "Current format of Proced listing. | 256 | "Current format of Proced listing. |
| @@ -298,6 +319,12 @@ of `proced-grammar-alist'." | |||
| 298 | (repeat :tag "Key List" (symbol :tag "Key")))) | 319 | (repeat :tag "Key List" (symbol :tag "Key")))) |
| 299 | (make-variable-buffer-local 'proced-format) | 320 | (make-variable-buffer-local 'proced-format) |
| 300 | 321 | ||
| 322 | (defcustom proced-descend t | ||
| 323 | "Non-nil if proced listing is sorted in descending order." | ||
| 324 | :group 'proced | ||
| 325 | :type '(boolean :tag "Descending Sort Order")) | ||
| 326 | (make-variable-buffer-local 'proced-descend) | ||
| 327 | |||
| 301 | (defcustom proced-goal-attribute 'args | 328 | (defcustom proced-goal-attribute 'args |
| 302 | "If non-nil, key of the attribute that defines the `goal-column'." | 329 | "If non-nil, key of the attribute that defines the `goal-column'." |
| 303 | :group 'proced | 330 | :group 'proced |
| @@ -325,7 +352,8 @@ cons pairs, see `proced-process-attributes'.") | |||
| 325 | (make-variable-buffer-local 'proced-process-alist) | 352 | (make-variable-buffer-local 'proced-process-alist) |
| 326 | 353 | ||
| 327 | (defvar proced-sort-internal nil | 354 | (defvar proced-sort-internal nil |
| 328 | "Sort scheme for listing (internal format).") | 355 | "Sort scheme for listing (internal format). |
| 356 | It is a list of lists (KEY PREDICATE REVERSE).") | ||
| 329 | 357 | ||
| 330 | (defvar proced-marker-char ?* ; the answer is 42 | 358 | (defvar proced-marker-char ?* ; the answer is 42 |
| 331 | "In proced, the current mark character.") | 359 | "In proced, the current mark character.") |
| @@ -495,7 +523,7 @@ Important: the match ends just after the marker.") | |||
| 495 | ["Revert" revert-buffer | 523 | ["Revert" revert-buffer |
| 496 | :help "Revert Process Listing"] | 524 | :help "Revert Process Listing"] |
| 497 | ["Auto Update" proced-toggle-auto-update | 525 | ["Auto Update" proced-toggle-auto-update |
| 498 | :style radio | 526 | :style toggle |
| 499 | :selected (eval proced-auto-update-flag) | 527 | :selected (eval proced-auto-update-flag) |
| 500 | :help "Auto Update of Proced Buffer"] | 528 | :help "Auto Update of Proced Buffer"] |
| 501 | ["Send signal" proced-send-signal | 529 | ["Send signal" proced-send-signal |
| @@ -904,42 +932,53 @@ This list includes CPID unless OMIT-CPID is non-nil." | |||
| 904 | "Refine Proced listing by comparing with the attribute value at point. | 932 | "Refine Proced listing by comparing with the attribute value at point. |
| 905 | Optional EVENT is the location of the Proced field. | 933 | Optional EVENT is the location of the Proced field. |
| 906 | 934 | ||
| 907 | If point is on the attribute ATTR, this command compares the value of ATTR | 935 | Refinement is controlled by the REFINER defined for each attribute ATTR |
| 908 | of every process with the value of ATTR of the process at the position | 936 | in `proced-grammar-alist'. |
| 909 | of point. One can select processes for which the value of ATTR is | 937 | |
| 910 | \"less than\", \"equal\", and / or \"larger\" than ATTR of the process | 938 | If REFINER is a list of flags and point is on the attribute ATTR, this command |
| 911 | point is on. | 939 | compares the value of ATTR of every process with the value of ATTR |
| 940 | of the process at the position of point. | ||
| 912 | 941 | ||
| 913 | The predicate for the comparison of two ATTR values is defined | 942 | The predicate for the comparison of two ATTR values is defined |
| 914 | in `proced-grammar-alist'. For each return value of the predicate | 943 | in `proced-grammar-alist'. For each return value of the predicate |
| 915 | a refine flag is defined in `proced-grammar-alist'. A process is included | 944 | a refine flag is defined in `proced-grammar-alist'. One can select |
| 916 | in the new listing if the refine flag for the return value of the predicate | 945 | processes for which the value of ATTR is \"less than\", \"equal\", |
| 917 | is non-nil. | 946 | and / or \"larger\" than ATTR of the process point is on. A process |
| 947 | is included in the new listing if the refine flag for the corresponding | ||
| 948 | return value of the predicate is non-nil. | ||
| 918 | The help-echo string for `proced-refine' uses \"+\" or \"-\" to indicate | 949 | The help-echo string for `proced-refine' uses \"+\" or \"-\" to indicate |
| 919 | the current values of the refine flags. | 950 | the current values of these refine flags. |
| 951 | |||
| 952 | If REFINER is a cons pair (FUNCTION . HELP-ECHO), FUNCTION is called | ||
| 953 | with one argument, the PID of the process at the position of point. | ||
| 954 | The function must return a list of PIDs that is used for the refined | ||
| 955 | listing. HELP-ECHO is a string that is shown when mouse is over this field. | ||
| 920 | 956 | ||
| 921 | This command refines an already existing process listing based initially | 957 | This command refines an already existing process listing generated initially |
| 922 | on the variable `proced-filter'. It does not change this variable. | 958 | based on the value of the variable `proced-filter'. It does not change |
| 923 | It does not revert the listing. If you frequently need a certain refinement, | 959 | this variable. It does not revert the listing. If you frequently need |
| 924 | consider defining a new filter in `proced-filter-alist'." | 960 | a certain refinement, consider defining a new filter in `proced-filter-alist'." |
| 925 | (interactive (list last-input-event)) | 961 | (interactive (list last-input-event)) |
| 926 | (if event (posn-set-point (event-end event))) | 962 | (if event (posn-set-point (event-end event))) |
| 927 | (let ((key (get-text-property (point) 'proced-key)) | 963 | (let ((key (get-text-property (point) 'proced-key)) |
| 928 | (pid (get-text-property (point) 'proced-pid))) | 964 | (pid (get-text-property (point) 'proced-pid))) |
| 929 | (if (and key pid) | 965 | (if (and key pid) |
| 930 | (let* ((grammar (assq key proced-grammar-alist)) | 966 | (let* ((grammar (assq key proced-grammar-alist)) |
| 931 | (predicate (nth 4 grammar)) | 967 | (refiner (nth 7 grammar))) |
| 932 | (refiner (nth 7 grammar)) | 968 | (when refiner |
| 933 | (ref (cdr (assq key (cdr (assq pid proced-process-alist))))) | 969 | (cond ((functionp (car refiner)) |
| 934 | val new-alist) | 970 | (setq proced-process-alist (funcall (car refiner) pid))) |
| 935 | (when ref | 971 | ((consp refiner) |
| 936 | (dolist (process proced-process-alist) | 972 | (let ((predicate (nth 4 grammar)) |
| 937 | (setq val (funcall predicate (cdr (assq key (cdr process))) ref)) | 973 | (ref (cdr (assq key (cdr (assq pid proced-process-alist))))) |
| 938 | (if (cond ((not val) (nth 2 refiner)) | 974 | val new-alist) |
| 939 | ((eq val 'equal) (nth 1 refiner)) | 975 | (dolist (process proced-process-alist) |
| 940 | (val (car refiner))) | 976 | (setq val (funcall predicate (cdr (assq key (cdr process))) ref)) |
| 941 | (push process new-alist))) | 977 | (if (cond ((not val) (nth 2 refiner)) |
| 942 | (setq proced-process-alist new-alist) | 978 | ((eq val 'equal) (nth 1 refiner)) |
| 979 | (val (car refiner))) | ||
| 980 | (push process new-alist))) | ||
| 981 | (setq proced-process-alist new-alist)))) | ||
| 943 | ;; Do not revert listing. | 982 | ;; Do not revert listing. |
| 944 | (proced-update))) | 983 | (proced-update))) |
| 945 | (message "No refiner defined here.")))) | 984 | (message "No refiner defined here.")))) |
| @@ -1009,8 +1048,11 @@ Return `equal' if T1 equals T2. Return nil otherwise." | |||
| 1009 | (throw 'done (proced-xor predicate (nth 2 sorter))))) | 1048 | (throw 'done (proced-xor predicate (nth 2 sorter))))) |
| 1010 | (eq t predicate))))) | 1049 | (eq t predicate))))) |
| 1011 | 1050 | ||
| 1012 | (defun proced-sort (process-alist sorter) | 1051 | (defun proced-sort (process-alist sorter descend) |
| 1013 | "Sort PROCESS-ALIST using scheme SORTER. | 1052 | "Sort PROCESS-ALIST using scheme SORTER. |
| 1053 | SORTER is a scheme like `proced-sort'. | ||
| 1054 | DESCEND is non-nil if the first element of SORTER is sorted | ||
| 1055 | in descending order. | ||
| 1014 | Return the sorted process list." | 1056 | Return the sorted process list." |
| 1015 | ;; translate SORTER into a list of lists (KEY PREDICATE REVERSE) | 1057 | ;; translate SORTER into a list of lists (KEY PREDICATE REVERSE) |
| 1016 | (setq proced-sort-internal | 1058 | (setq proced-sort-internal |
| @@ -1023,7 +1065,12 @@ Return the sorted process list." | |||
| 1023 | ((symbolp sorter) (list sorter)) | 1065 | ((symbolp sorter) (list sorter)) |
| 1024 | (t (error "Sorter undefined %s" sorter))))) | 1066 | (t (error "Sorter undefined %s" sorter))))) |
| 1025 | (if proced-sort-internal | 1067 | (if proced-sort-internal |
| 1026 | (sort process-alist 'proced-sort-p) | 1068 | (progn |
| 1069 | ;; splice DESCEND into the list | ||
| 1070 | (setcar proced-sort-internal | ||
| 1071 | (list (caar proced-sort-internal) | ||
| 1072 | (nth 1 (car proced-sort-internal)) descend)) | ||
| 1073 | (sort process-alist 'proced-sort-p)) | ||
| 1027 | process-alist)) | 1074 | process-alist)) |
| 1028 | 1075 | ||
| 1029 | (defun proced-sort-interactive (scheme &optional revert) | 1076 | (defun proced-sort-interactive (scheme &optional revert) |
| @@ -1031,6 +1078,8 @@ Return the sorted process list." | |||
| 1031 | When called interactively, an empty string means nil, i.e., no sorting. | 1078 | When called interactively, an empty string means nil, i.e., no sorting. |
| 1032 | With prefix REVERT non-nil revert listing. | 1079 | With prefix REVERT non-nil revert listing. |
| 1033 | 1080 | ||
| 1081 | Repeated calls using the same value of SCHEME toggle the sort order. | ||
| 1082 | |||
| 1034 | Set variable `proced-sort' to SCHEME. The current sort scheme is displayed | 1083 | Set variable `proced-sort' to SCHEME. The current sort scheme is displayed |
| 1035 | in the mode line, using \"+\" or \"-\" for ascending or descending order." | 1084 | in the mode line, using \"+\" or \"-\" for ascending or descending order." |
| 1036 | (interactive | 1085 | (interactive |
| @@ -1038,38 +1087,49 @@ in the mode line, using \"+\" or \"-\" for ascending or descending order." | |||
| 1038 | proced-grammar-alist nil t))) | 1087 | proced-grammar-alist nil t))) |
| 1039 | (list (if (string= "" scheme) nil (intern scheme)) | 1088 | (list (if (string= "" scheme) nil (intern scheme)) |
| 1040 | current-prefix-arg))) | 1089 | current-prefix-arg))) |
| 1041 | ;; only update if necessary | 1090 | (setq proced-descend |
| 1042 | (when (or (not (eq proced-sort scheme)) revert) | 1091 | ;; If `proced-sort-interactive' is called repeatedly for the same sort key, |
| 1043 | (setq proced-sort scheme) | 1092 | ;; the sort order is reversed. |
| 1044 | (proced-update revert))) | 1093 | (if (equal proced-sort scheme) |
| 1094 | (not proced-descend) | ||
| 1095 | (nth 5 (assq (if (consp scheme) (car scheme) scheme) | ||
| 1096 | proced-grammar-alist))) | ||
| 1097 | proced-sort scheme) | ||
| 1098 | (proced-update revert)) | ||
| 1045 | 1099 | ||
| 1046 | (defun proced-sort-pcpu (&optional revert) | 1100 | (defun proced-sort-pcpu (&optional revert) |
| 1047 | "Sort Proced buffer by percentage CPU time (%CPU)." | 1101 | "Sort Proced buffer by percentage CPU time (%CPU). |
| 1102 | Repeated calls toggle the sort order." | ||
| 1048 | (interactive "P") | 1103 | (interactive "P") |
| 1049 | (proced-sort-interactive 'pcpu revert)) | 1104 | (proced-sort-interactive 'pcpu revert)) |
| 1050 | 1105 | ||
| 1051 | (defun proced-sort-pmem (&optional revert) | 1106 | (defun proced-sort-pmem (&optional revert) |
| 1052 | "Sort Proced buffer by percentage memory usage (%MEM)." | 1107 | "Sort Proced buffer by percentage memory usage (%MEM). |
| 1108 | Repeated calls toggle the sort order." | ||
| 1053 | (interactive "P") | 1109 | (interactive "P") |
| 1054 | (proced-sort-interactive 'pmem)) | 1110 | (proced-sort-interactive 'pmem revert)) |
| 1055 | 1111 | ||
| 1056 | (defun proced-sort-pid (&optional revert) | 1112 | (defun proced-sort-pid (&optional revert) |
| 1057 | "Sort Proced buffer by PID." | 1113 | "Sort Proced buffer by PID. |
| 1114 | Repeated calls toggle the sort order." | ||
| 1058 | (interactive "P") | 1115 | (interactive "P") |
| 1059 | (proced-sort-interactive 'pid revert)) | 1116 | (proced-sort-interactive 'pid revert)) |
| 1060 | 1117 | ||
| 1061 | (defun proced-sort-start (&optional revert) | 1118 | (defun proced-sort-start (&optional revert) |
| 1062 | "Sort Proced buffer by time the command started (START)." | 1119 | "Sort Proced buffer by time the command started (START). |
| 1120 | Repeated calls toggle the sort order." | ||
| 1063 | (interactive "P") | 1121 | (interactive "P") |
| 1064 | (proced-sort-interactive 'start revert)) | 1122 | (proced-sort-interactive 'start revert)) |
| 1065 | 1123 | ||
| 1066 | (defun proced-sort-time (&optional revert) | 1124 | (defun proced-sort-time (&optional revert) |
| 1067 | "Sort Proced buffer by CPU time (TIME)." | 1125 | "Sort Proced buffer by CPU time (TIME). |
| 1126 | Repeated calls toggle the sort order." | ||
| 1068 | (interactive "P") | 1127 | (interactive "P") |
| 1069 | (proced-sort-interactive 'time revert)) | 1128 | (proced-sort-interactive 'time revert)) |
| 1070 | 1129 | ||
| 1071 | (defun proced-sort-user (&optional revert) | 1130 | (defun proced-sort-user (&optional revert) |
| 1072 | "Sort Proced buffer by USER." | 1131 | "Sort Proced buffer by USER. |
| 1132 | Repeated calls toggle the sort order." | ||
| 1073 | (interactive "P") | 1133 | (interactive "P") |
| 1074 | (proced-sort-interactive 'user revert)) | 1134 | (proced-sort-interactive 'user revert)) |
| 1075 | 1135 | ||
| @@ -1077,7 +1137,8 @@ in the mode line, using \"+\" or \"-\" for ascending or descending order." | |||
| 1077 | "Sort Proced listing based on an attribute. | 1137 | "Sort Proced listing based on an attribute. |
| 1078 | EVENT is a mouse event with starting position in the header line. | 1138 | EVENT is a mouse event with starting position in the header line. |
| 1079 | It is converted in the corresponding attribute key. | 1139 | It is converted in the corresponding attribute key. |
| 1080 | This command updates the variable `proced-sort'." | 1140 | This command updates the variable `proced-sort'. |
| 1141 | Repeated calls for the same header toggle the sort order." | ||
| 1081 | (interactive "e\nP") | 1142 | (interactive "e\nP") |
| 1082 | (let ((start (event-start event)) | 1143 | (let ((start (event-start event)) |
| 1083 | col key) | 1144 | col key) |
| @@ -1130,6 +1191,7 @@ The return string is always 6 characters wide." | |||
| 1130 | (substring ttname (if (string-match "\\`/dev/" ttname) | 1191 | (substring ttname (if (string-match "\\`/dev/" ttname) |
| 1131 | (match-end 0) 0))) | 1192 | (match-end 0) 0))) |
| 1132 | 1193 | ||
| 1194 | ;; Proced assumes that every process occupies only one line in the listing. | ||
| 1133 | (defun proced-format-args (args) | 1195 | (defun proced-format-args (args) |
| 1134 | "Format attribute ARGS. | 1196 | "Format attribute ARGS. |
| 1135 | Replace newline characters by \"^J\" (two characters)." | 1197 | Replace newline characters by \"^J\" (two characters)." |
| @@ -1139,12 +1201,31 @@ Replace newline characters by \"^J\" (two characters)." | |||
| 1139 | "Display PROCESS-ALIST using FORMAT." | 1201 | "Display PROCESS-ALIST using FORMAT." |
| 1140 | (if (symbolp format) | 1202 | (if (symbolp format) |
| 1141 | (setq format (cdr (assq format proced-format-alist)))) | 1203 | (setq format (cdr (assq format proced-format-alist)))) |
| 1204 | |||
| 1205 | ;; Not all systems give us all attributes. We take `emacs-pid' as a | ||
| 1206 | ;; representative process PID. If FORMAT contains a list of alternative | ||
| 1207 | ;; attributes, we take the first attribute that is non-nil for `emacs-pid'. | ||
| 1208 | ;; If none of the alternatives is non-nil, the attribute is ignored | ||
| 1209 | ;; in the listing. | ||
| 1210 | (let ((standard-attributes | ||
| 1211 | (car (proced-process-attributes (list (emacs-pid))))) | ||
| 1212 | new-format fmi) | ||
| 1213 | (dolist (fmt format) | ||
| 1214 | (if (symbolp fmt) | ||
| 1215 | (if (assq fmt standard-attributes) | ||
| 1216 | (push fmt new-format)) | ||
| 1217 | (while (setq fmi (pop fmt)) | ||
| 1218 | (when (assq fmi standard-attributes) | ||
| 1219 | (push fmi new-format) | ||
| 1220 | (setq fmt nil))))) | ||
| 1221 | (setq format (nreverse new-format))) | ||
| 1222 | |||
| 1142 | (insert (make-string (length process-alist) ?\n)) | 1223 | (insert (make-string (length process-alist) ?\n)) |
| 1143 | (let ((whitespace " ") header-list grammar) | 1224 | (let ((whitespace " ") (unknown "?") |
| 1225 | (sort-key (if (consp proced-sort) (car proced-sort) proced-sort)) | ||
| 1226 | header-list grammar) | ||
| 1144 | ;; Loop over all attributes | 1227 | ;; Loop over all attributes |
| 1145 | (while (setq grammar (pop format)) | 1228 | (while (setq grammar (assq (pop format) proced-grammar-alist)) |
| 1146 | (if (symbolp grammar) | ||
| 1147 | (setq grammar (assq grammar proced-grammar-alist))) | ||
| 1148 | (let* ((key (car grammar)) | 1229 | (let* ((key (car grammar)) |
| 1149 | (fun (cond ((stringp (nth 2 grammar)) | 1230 | (fun (cond ((stringp (nth 2 grammar)) |
| 1150 | `(lambda (arg) (format ,(nth 2 grammar) arg))) | 1231 | `(lambda (arg) (format ,(nth 2 grammar) arg))) |
| @@ -1156,21 +1237,29 @@ Replace newline characters by \"^J\" (two characters)." | |||
| 1156 | ;; field the corresponding key. | 1237 | ;; field the corresponding key. |
| 1157 | ;; Of course, the sort predicate appearing in help-echo | 1238 | ;; Of course, the sort predicate appearing in help-echo |
| 1158 | ;; is only part of the story. But it gives the main idea. | 1239 | ;; is only part of the story. But it gives the main idea. |
| 1159 | (hprops `(proced-key ,key mouse-face highlight | 1240 | (hprops (let ((descend (if (eq key sort-key) proced-descend (nth 5 grammar)))) |
| 1160 | help-echo ,(format proced-header-help-echo | 1241 | `(proced-key ,key mouse-face highlight |
| 1161 | (if (nth 5 grammar) "-" "+") | 1242 | help-echo ,(format proced-header-help-echo |
| 1162 | (nth 1 grammar) | 1243 | (if descend "-" "+") |
| 1163 | (if (nth 5 grammar) "descending" "ascending")))) | 1244 | (nth 1 grammar) |
| 1164 | (fprops `(proced-key ,key mouse-face highlight | 1245 | (if descend "descending" "ascending"))))) |
| 1165 | help-echo ,(format proced-field-help-echo | 1246 | (refiner (nth 7 grammar)) |
| 1247 | (fprops | ||
| 1248 | (cond ((functionp (car refiner)) | ||
| 1249 | `(proced-key ,key mouse-face highlight | ||
| 1250 | help-echo ,(format "mouse-2, RET: %s" | ||
| 1251 | (cdr refiner)))) | ||
| 1252 | ((consp refiner) | ||
| 1253 | `(proced-key ,key mouse-face highlight | ||
| 1254 | help-echo ,(format "mouse-2, RET: refine by attribute %s %s" | ||
| 1166 | (nth 1 grammar) | 1255 | (nth 1 grammar) |
| 1167 | (mapconcat (lambda (s) | 1256 | (mapconcat (lambda (s) |
| 1168 | (if s "+" "-")) | 1257 | (if s "+" "-")) |
| 1169 | (nth 7 grammar) "")))) | 1258 | refiner "")))))) |
| 1170 | value) | 1259 | value) |
| 1171 | 1260 | ||
| 1172 | ;; highlight the header of the sort column | 1261 | ;; highlight the header of the sort column |
| 1173 | (if (eq key proced-sort) | 1262 | (if (eq key sort-key) |
| 1174 | (setq hprops (append '(face proced-sort-header) hprops))) | 1263 | (setq hprops (append '(face proced-sort-header) hprops))) |
| 1175 | (goto-char (point-min)) | 1264 | (goto-char (point-min)) |
| 1176 | (cond ( ;; fixed width of output field | 1265 | (cond ( ;; fixed width of output field |
| @@ -1180,7 +1269,8 @@ Replace newline characters by \"^J\" (two characters)." | |||
| 1180 | (setq value (cdr (assq key (cdr process)))) | 1269 | (setq value (cdr (assq key (cdr process)))) |
| 1181 | (insert (if value | 1270 | (insert (if value |
| 1182 | (apply 'propertize (funcall fun value) fprops) | 1271 | (apply 'propertize (funcall fun value) fprops) |
| 1183 | (make-string (abs (nth 3 grammar)) ?\s)) | 1272 | (format (concat "%" (number-to-string (nth 3 grammar)) "s") |
| 1273 | unknown)) | ||
| 1184 | whitespace) | 1274 | whitespace) |
| 1185 | (forward-line)) | 1275 | (forward-line)) |
| 1186 | (push (format (concat "%" (number-to-string (nth 3 grammar)) "s") | 1276 | (push (format (concat "%" (number-to-string (nth 3 grammar)) "s") |
| @@ -1192,7 +1282,8 @@ Replace newline characters by \"^J\" (two characters)." | |||
| 1192 | (dolist (process process-alist) | 1282 | (dolist (process process-alist) |
| 1193 | (end-of-line) | 1283 | (end-of-line) |
| 1194 | (setq value (cdr (assq key (cdr process)))) | 1284 | (setq value (cdr (assq key (cdr process)))) |
| 1195 | (if value (insert (apply 'propertize (funcall fun value) fprops))) | 1285 | (insert (if value (apply 'propertize (funcall fun value) fprops) |
| 1286 | unknown)) | ||
| 1196 | (forward-line)) | 1287 | (forward-line)) |
| 1197 | (push (apply 'propertize (nth 1 grammar) hprops) header-list)) | 1288 | (push (apply 'propertize (nth 1 grammar) hprops) header-list)) |
| 1198 | 1289 | ||
| @@ -1205,7 +1296,8 @@ Replace newline characters by \"^J\" (two characters)." | |||
| 1205 | (setq value (apply 'propertize (funcall fun value) fprops) | 1296 | (setq value (apply 'propertize (funcall fun value) fprops) |
| 1206 | width (max width (length value)) | 1297 | width (max width (length value)) |
| 1207 | field-list (cons value field-list)) | 1298 | field-list (cons value field-list)) |
| 1208 | (push "" field-list))) | 1299 | (push unknown field-list) |
| 1300 | (setq width (max width (length unknown))))) | ||
| 1209 | (let ((afmt (concat "%" (if (eq 'left (nth 3 grammar)) "-" "") | 1301 | (let ((afmt (concat "%" (if (eq 'left (nth 3 grammar)) "-" "") |
| 1210 | (number-to-string width) "s"))) | 1302 | (number-to-string width) "s"))) |
| 1211 | (push (format afmt (apply 'propertize (nth 1 grammar) hprops)) | 1303 | (push (format afmt (apply 'propertize (nth 1 grammar) hprops)) |
| @@ -1250,28 +1342,33 @@ With prefix REVERT non-nil revert listing." | |||
| 1250 | 1342 | ||
| 1251 | ;; generate listing | 1343 | ;; generate listing |
| 1252 | 1344 | ||
| 1253 | (defun proced-process-attributes () | 1345 | (defun proced-process-attributes (&optional pid-list) |
| 1254 | "Return alist of attributes for each system process. | 1346 | "Return alist of attributes for each system process. |
| 1255 | This alist can be customized via `proced-custom-attributes'." | 1347 | This alist can be customized via `proced-custom-attributes'. |
| 1256 | (mapcar (lambda (pid) | 1348 | Optional arg PID-LIST is a list of PIDs of system process that are analyzed. |
| 1257 | (let* ((attributes (system-process-attributes pid)) | 1349 | If no attributes are known for a process (possibly because it already died) |
| 1258 | (utime (cdr (assq 'utime attributes))) | 1350 | the process is ignored." |
| 1259 | (stime (cdr (assq 'stime attributes))) | 1351 | ;; Should we make it customizable whether processes with empty attribute |
| 1260 | (cutime (cdr (assq 'cutime attributes))) | 1352 | ;; lists are ignored? When would such processes be of interest? |
| 1261 | (cstime (cdr (assq 'cstime attributes))) | 1353 | (let (process-alist attributes) |
| 1262 | attr) | 1354 | (dolist (pid (or pid-list (list-system-processes)) process-alist) |
| 1263 | (setq attributes | 1355 | (when (setq attributes (system-process-attributes pid)) |
| 1264 | (append (list (cons 'pid pid)) | 1356 | (let ((utime (cdr (assq 'utime attributes))) |
| 1265 | (if (and utime stime) | 1357 | (stime (cdr (assq 'stime attributes))) |
| 1266 | (list (cons 'time (time-add utime stime)))) | 1358 | (cutime (cdr (assq 'cutime attributes))) |
| 1267 | (if (and cutime cstime) | 1359 | (cstime (cdr (assq 'cstime attributes))) |
| 1268 | (list (cons 'ctime (time-add cutime cstime)))) | 1360 | attr) |
| 1269 | attributes)) | 1361 | (setq attributes |
| 1270 | (dolist (fun proced-custom-attributes) | 1362 | (append (list (cons 'pid pid)) |
| 1271 | (if (setq attr (funcall fun attributes)) | 1363 | (if (and utime stime) |
| 1272 | (push attr attributes))) | 1364 | (list (cons 'time (time-add utime stime)))) |
| 1273 | (cons pid attributes))) | 1365 | (if (and cutime cstime) |
| 1274 | (list-system-processes))) | 1366 | (list (cons 'ctime (time-add cutime cstime)))) |
| 1367 | attributes)) | ||
| 1368 | (dolist (fun proced-custom-attributes) | ||
| 1369 | (if (setq attr (funcall fun attributes)) | ||
| 1370 | (push attr attributes))) | ||
| 1371 | (push (cons pid attributes) process-alist)))))) | ||
| 1275 | 1372 | ||
| 1276 | (defun proced-update (&optional revert quiet) | 1373 | (defun proced-update (&optional revert quiet) |
| 1277 | "Update the `proced' process information. Preserves point and marks. | 1374 | "Update the `proced' process information. Preserves point and marks. |
| @@ -1286,8 +1383,8 @@ Suppress status information if QUIET is nil." | |||
| 1286 | (setq proced-process-alist (proced-process-attributes))) | 1383 | (setq proced-process-alist (proced-process-attributes))) |
| 1287 | ;; filtering and sorting | 1384 | ;; filtering and sorting |
| 1288 | (setq proced-process-alist | 1385 | (setq proced-process-alist |
| 1289 | (proced-sort (proced-filter proced-process-alist | 1386 | (proced-sort (proced-filter proced-process-alist proced-filter) |
| 1290 | proced-filter) proced-sort)) | 1387 | proced-sort proced-descend)) |
| 1291 | 1388 | ||
| 1292 | ;; It is useless to keep undo information if we revert, filter, or | 1389 | ;; It is useless to keep undo information if we revert, filter, or |
| 1293 | ;; refine the listing so that `proced-process-alist' has changed. | 1390 | ;; refine the listing so that `proced-process-alist' has changed. |
| @@ -1381,10 +1478,10 @@ Suppress status information if QUIET is nil." | |||
| 1381 | (concat ": " (symbol-name proced-filter)) | 1478 | (concat ": " (symbol-name proced-filter)) |
| 1382 | "") | 1479 | "") |
| 1383 | (if proced-sort | 1480 | (if proced-sort |
| 1384 | (let* ((key (if (listp proced-sort) (car proced-sort) | 1481 | (let* ((key (if (consp proced-sort) (car proced-sort) |
| 1385 | proced-sort)) | 1482 | proced-sort)) |
| 1386 | (grammar (assq key proced-grammar-alist))) | 1483 | (grammar (assq key proced-grammar-alist))) |
| 1387 | (concat " by " (if (nth 5 grammar) "-" "+") | 1484 | (concat " by " (if proced-descend "-" "+") |
| 1388 | (nth 1 grammar))) | 1485 | (nth 1 grammar))) |
| 1389 | ""))) | 1486 | ""))) |
| 1390 | (force-mode-line-update) | 1487 | (force-mode-line-update) |