aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog24
-rw-r--r--lisp/proced.el299
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 @@
12008-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
152008-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
12008-12-13 Glenn Morris <rgm@gnu.org> 252008-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
139Each element has the form 143Each 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
143Symbol KEY is the car of a process attribute. 147Symbol KEY is the car of a process attribute.
144 148
@@ -161,8 +165,8 @@ the corresponding attribute values of two processes. PREDICATE should
161return 'equal if P1 has same rank like P2. Any other non-nil value says 165return 'equal if P1 has same rank like P2. Any other non-nil value says
162that P1 is \"less than\" P2, or nil if not. 166that P1 is \"less than\" P2, or nil if not.
163 167
164REVERSE is non-nil if the sort order is opposite to the order defined 168PREDICATE defines an ascending sort order. REVERSE is non-nil if the sort
165by PREDICATE. 169order is descending.
166 170
167SORT-SCHEME is a list (KEY1 KEY2 ...) defining a hierarchy of rules 171SORT-SCHEME is a list (KEY1 KEY2 ...) defining a hierarchy of rules
168for sorting the process listing. KEY1, KEY2, ... are KEYs appearing as cars 172for 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.
170If it yields non-equal, it defines the sort order for the corresponding 174If it yields non-equal, it defines the sort order for the corresponding
171processes. If it evaluates to 'equal the PREDICATE of KEY2 is evaluated, etc. 175processes. If it evaluates to 'equal the PREDICATE of KEY2 is evaluated, etc.
172 176
173REFINE-FLAGS is a list (LESS-B EQUAL-B LARGER-B) used by the command 177REFINER 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.
175This command compares the value of attribute KEY of every process with 179This command compares the value of attribute KEY of every process with
176the value of attribute KEY of the process at the position of point 180the value of attribute KEY of the process at the position of point
177using PREDICATE. 181using PREDICATE.
178If PREDICATE yields non-nil, the process is accepted if LESS-B is non-nil. 182If PREDICATE yields non-nil, the process is accepted if LESS-B is non-nil.
179If PREDICATE yields 'equal, the process is accepted if EQUAL-B is non-nil. 183If PREDICATE yields 'equal, the process is accepted if EQUAL-B is non-nil.
180If PREDICATE yields nil, the process is accepted if LARGER-B is non-nil." 184If PREDICATE yields nil, the process is accepted if LARGER-B is non-nil.
185
186REFINER can also be a cons pair (FUNCTION . HELP-ECHO).
187FUNCTION is called with one argument, the PID of the process at the position
188of point. The function must return a list of PIDs that is used for the refined
189listing. HELP-ECHO is a string that is shown when mouse is over this field.
190
191If 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.
228The car of each element is a symbol, the name of the format. 243The car of each element is a symbol, the name of the format.
229The cdr is a list of keys appearing in `proced-grammar-alist'." 244The cdr is a list of attribute keys appearing in `proced-grammar-alist'.
245An element of this list may also be a list of attribute keys that specifies
246alternatives. If the first attribute is absent for a process, use the second
247one, 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).
356It 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.
905Optional EVENT is the location of the Proced field. 933Optional EVENT is the location of the Proced field.
906 934
907If point is on the attribute ATTR, this command compares the value of ATTR 935Refinement is controlled by the REFINER defined for each attribute ATTR
908of every process with the value of ATTR of the process at the position 936in `proced-grammar-alist'.
909of 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 938If REFINER is a list of flags and point is on the attribute ATTR, this command
911point is on. 939compares the value of ATTR of every process with the value of ATTR
940of the process at the position of point.
912 941
913The predicate for the comparison of two ATTR values is defined 942The predicate for the comparison of two ATTR values is defined
914in `proced-grammar-alist'. For each return value of the predicate 943in `proced-grammar-alist'. For each return value of the predicate
915a refine flag is defined in `proced-grammar-alist'. A process is included 944a refine flag is defined in `proced-grammar-alist'. One can select
916in the new listing if the refine flag for the return value of the predicate 945processes for which the value of ATTR is \"less than\", \"equal\",
917is non-nil. 946and / or \"larger\" than ATTR of the process point is on. A process
947is included in the new listing if the refine flag for the corresponding
948return value of the predicate is non-nil.
918The help-echo string for `proced-refine' uses \"+\" or \"-\" to indicate 949The help-echo string for `proced-refine' uses \"+\" or \"-\" to indicate
919the current values of the refine flags. 950the current values of these refine flags.
951
952If REFINER is a cons pair (FUNCTION . HELP-ECHO), FUNCTION is called
953with one argument, the PID of the process at the position of point.
954The function must return a list of PIDs that is used for the refined
955listing. HELP-ECHO is a string that is shown when mouse is over this field.
920 956
921This command refines an already existing process listing based initially 957This command refines an already existing process listing generated initially
922on the variable `proced-filter'. It does not change this variable. 958based on the value of the variable `proced-filter'. It does not change
923It does not revert the listing. If you frequently need a certain refinement, 959this variable. It does not revert the listing. If you frequently need
924consider defining a new filter in `proced-filter-alist'." 960a 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.
1053SORTER is a scheme like `proced-sort'.
1054DESCEND is non-nil if the first element of SORTER is sorted
1055in descending order.
1014Return the sorted process list." 1056Return 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."
1031When called interactively, an empty string means nil, i.e., no sorting. 1078When called interactively, an empty string means nil, i.e., no sorting.
1032With prefix REVERT non-nil revert listing. 1079With prefix REVERT non-nil revert listing.
1033 1080
1081Repeated calls using the same value of SCHEME toggle the sort order.
1082
1034Set variable `proced-sort' to SCHEME. The current sort scheme is displayed 1083Set variable `proced-sort' to SCHEME. The current sort scheme is displayed
1035in the mode line, using \"+\" or \"-\" for ascending or descending order." 1084in 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).
1102Repeated 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).
1108Repeated 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.
1114Repeated 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).
1120Repeated 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).
1126Repeated 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.
1132Repeated 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.
1078EVENT is a mouse event with starting position in the header line. 1138EVENT is a mouse event with starting position in the header line.
1079It is converted in the corresponding attribute key. 1139It is converted in the corresponding attribute key.
1080This command updates the variable `proced-sort'." 1140This command updates the variable `proced-sort'.
1141Repeated 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.
1135Replace newline characters by \"^J\" (two characters)." 1197Replace 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.
1255This alist can be customized via `proced-custom-attributes'." 1347This alist can be customized via `proced-custom-attributes'.
1256 (mapcar (lambda (pid) 1348Optional arg PID-LIST is a list of PIDs of system process that are analyzed.
1257 (let* ((attributes (system-process-attributes pid)) 1349If no attributes are known for a process (possibly because it already died)
1258 (utime (cdr (assq 'utime attributes))) 1350the 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)