aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRoland Winkler2008-05-20 10:17:15 +0000
committerRoland Winkler2008-05-20 10:17:15 +0000
commit92d9ce488f041ee46359b6bf48ddba88e92e2571 (patch)
treeba0b0f7ffa0081fa3a164abdc718e6786fdff371
parentdde8403ffedfd27895053cb15410f7a2a6315c1a (diff)
downloademacs-92d9ce488f041ee46359b6bf48ddba88e92e2571.tar.gz
emacs-92d9ce488f041ee46359b6bf48ddba88e92e2571.zip
(proced-goal-header-re): Renamed from proced-procname-column-regexp.
(proced-goal-column): Renamed from proced-procname-column. (proced-move-to-goal-column): Renamed from proced-move-to-procname. (proced-header-face, proced-header-regexp): Removed. (proced-font-lock-keywords): Remove proced-header-face. (proced-header-alist, proced-sorting-schemes-re): New variables. (proced): Rename Proced buffer to *Proced*. (proced-next-line, proced-previous-line): New commands. (proced-do-mark, proced-do-mark-all, proced-toggle-marks) (proced-hide-processes): Do not treat first line as special. (proced-header-space): New function. (proced-update): Use header-line-format. Initialize proced-header-alist and proced-sorting-schemes-re. Set proced-goal-column. Include proced-command in mode-name. (proced-send-signal): Use header-line-format for *Marked Processes* buffer. (proced-sort): Restrict minibuffer completion to applicable sorting schemes. (proced-sorting-scheme-p): Use proced-sorting-schemes-re.
-rw-r--r--lisp/proced.el301
1 files changed, 188 insertions, 113 deletions
diff --git a/lisp/proced.el b/lisp/proced.el
index daeadae5af8..7ab719114e1 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -28,6 +28,10 @@
28;; on the processes listed. 28;; on the processes listed.
29;; 29;;
30;; To do: 30;; To do:
31;; - decompose ps(1) output into columns (for `proced-header-alist')
32;; How can we identify columns that may contain whitespace
33;; and that can be either right or left justified?
34;; Use a "grammar table"?
31;; - sort the "cooked" values used in the output format fields 35;; - sort the "cooked" values used in the output format fields
32;; if ps(1) doesn't support the requested sorting scheme 36;; if ps(1) doesn't support the requested sorting scheme
33;; - filter by user name or other criteria 37;; - filter by user name or other criteria
@@ -41,12 +45,8 @@
41 :group 'unix 45 :group 'unix
42 :prefix "proced-") 46 :prefix "proced-")
43 47
44(defcustom proced-procname-column-regexp "\\b\\(CMD\\|COMMAND\\)\\b" 48;; FIXME: a better approach instead of PID-COLUMN would be based
45 "If non-nil, regexp that defines the `proced-procname-column'." 49;; on `proced-header-alist' once we have a reliable scheme to set this variable
46 :group 'proced
47 :type '(choice (const :tag "none" nil)
48 (regexp :tag "regexp")))
49
50(defcustom proced-command-alist 50(defcustom proced-command-alist
51 (cond ((memq system-type '(berkeley-unix)) 51 (cond ((memq system-type '(berkeley-unix))
52 '(("user" ("ps" "-uxgww") 2) 52 '(("user" ("ps" "-uxgww") 2)
@@ -81,7 +81,18 @@ PID-COLUMN is the column number (starting from 1) of the process ID."
81 (repeat (string :tag "option"))) 81 (repeat (string :tag "option")))
82 (integer :tag "PID column")))) 82 (integer :tag "PID column"))))
83 83
84;; Should we incorporate in NAME if sorting is done in descending order? 84(defcustom proced-command (if (zerop (user-real-uid)) "all" "user")
85 "Name of process listing.
86Must be the car of an element of `proced-command-alist'."
87 :group 'proced
88 :type '(string :tag "name"))
89(make-variable-buffer-local 'proced-command)
90
91;; Should we incorporate in NAME that sorting can be done in ascending
92;; or descending order? Then we couldn't associate NAME anymore with one
93;; of the headers in the output of ps(1).
94;; FIXME: A sorting scheme without options or with an option being a symbol
95;; should be implemented in elisp
85(defcustom proced-sorting-schemes-alist 96(defcustom proced-sorting-schemes-alist
86 (cond ((memq system-type '(gnu gnu/linux)) ; GNU long options 97 (cond ((memq system-type '(gnu gnu/linux)) ; GNU long options
87 '(("%CPU" "--sort" "-pcpu") ; descending order 98 '(("%CPU" "--sort" "-pcpu") ; descending order
@@ -100,8 +111,9 @@ PID-COLUMN is the column number (starting from 1) of the process ID."
100 ("VSZ,PID" "--sort" "vsz,pid")))) 111 ("VSZ,PID" "--sort" "vsz,pid"))))
101 "Alist of sorting schemes. 112 "Alist of sorting schemes.
102Each element is a list (NAME OPTION1 OPTION2 ...). 113Each element is a list (NAME OPTION1 OPTION2 ...).
103NAME denotes the sorting scheme and OPTION1, OPTION2, ... are options 114NAME denotes the sorting scheme. It is the name of a header or a
104defining the sorting scheme." 115comma-separated sequence of headers in the output of ps(1).
116OPTION1, OPTION2, ... are options defining the sorting scheme."
105 :group 'proced 117 :group 'proced
106 :type '(repeat (cons (string :tag "name") 118 :type '(repeat (cons (string :tag "name")
107 (repeat (string :tag "option"))))) 119 (repeat (string :tag "option")))))
@@ -116,12 +128,11 @@ Must be the car of an element of `proced-sorting-schemes-alist' or nil."
116 proced-sorting-schemes-alist)))) 128 proced-sorting-schemes-alist))))
117(make-variable-buffer-local 'proced-sorting-scheme) 129(make-variable-buffer-local 'proced-sorting-scheme)
118 130
119(defcustom proced-command (if (zerop (user-real-uid)) "all" "user") 131(defcustom proced-goal-header-re "\\b\\(CMD\\|COMMAND\\)\\b"
120 "Name of process listing. 132 "If non-nil, regexp that defines the `proced-goal-column'."
121Must be the car of an element of `proced-command-alist'."
122 :group 'proced 133 :group 'proced
123 :type '(string :tag "name")) 134 :type '(choice (const :tag "none" nil)
124(make-variable-buffer-local 'proced-command) 135 (regexp :tag "regexp")))
125 136
126(defcustom proced-signal-function 'signal-process 137(defcustom proced-signal-function 'signal-process
127 "Name of signal function. 138 "Name of signal function.
@@ -143,6 +154,7 @@ the external command (usually \"kill\")."
143 :group 'proced 154 :group 'proced
144 :type '(repeat (string :tag "signal"))) 155 :type '(repeat (string :tag "signal")))
145 156
157;; Internal variables
146(defvar proced-marker-char ?* ; the answer is 42 158(defvar proced-marker-char ?* ; the answer is 42
147 "In proced, the current mark character.") 159 "In proced, the current mark character.")
148 160
@@ -152,13 +164,6 @@ the external command (usually \"kill\")."
152 :group 'proced 164 :group 'proced
153 :group 'faces) 165 :group 'faces)
154 166
155(defface proced-header
156 '((t (:inherit font-lock-type-face)))
157 "Face used for proced headers."
158 :group 'proced-faces)
159(defvar proced-header-face 'proced-header
160 "Face name used for proced headers.")
161
162(defface proced-mark 167(defface proced-mark
163 '((t (:inherit font-lock-constant-face))) 168 '((t (:inherit font-lock-constant-face)))
164 "Face used for proced marks." 169 "Face used for proced marks."
@@ -177,54 +182,56 @@ the external command (usually \"kill\")."
177 "Regexp matching a marked line. 182 "Regexp matching a marked line.
178Important: the match ends just after the marker.") 183Important: the match ends just after the marker.")
179 184
180(defvar proced-header-regexp "\\`.*$" 185(defvar proced-goal-column nil
181 "Regexp matching a header line.") 186 "Proced goal column. Initialized based on `proced-goal-header-re'.")
182 187(make-variable-buffer-local 'proced-goal-column)
183(defvar proced-procname-column nil
184 "Proced command column.
185Initialized based on `proced-procname-column-regexp'.")
186(make-variable-buffer-local 'proced-procname-column)
187 188
188(defvar proced-font-lock-keywords 189(defvar proced-font-lock-keywords
189 (list 190 (list
190 ;; 191 ;;
191 ;; Process listing headers.
192 (list proced-header-regexp '(0 proced-header-face))
193 ;;
194 ;; Proced marks. 192 ;; Proced marks.
195 (list proced-re-mark '(0 proced-mark-face)) 193 (list proced-re-mark '(0 proced-mark-face))
196 ;; 194 ;;
197 ;; Marked files. 195 ;; Marked files.
198 (list (concat "^[" (char-to-string proced-marker-char) "]") 196 (list (concat "^[" (char-to-string proced-marker-char) "]")
199 '(".+" (proced-move-to-procname) nil (0 proced-marked-face))))) 197 '(".+" (proced-move-to-goal-column) nil (0 proced-marked-face)))))
200 198
201(defvar proced-mode-map 199(defvar proced-mode-map
202 (let ((km (make-sparse-keymap))) 200 (let ((km (make-sparse-keymap)))
203 (define-key km " " 'next-line) 201 ;; moving
204 (define-key km "n" 'next-line) 202 (define-key km " " 'proced-next-line)
205 (define-key km "p" 'previous-line) 203 (define-key km "n" 'proced-next-line)
206 (define-key km "\C-?" 'previous-line) 204 (define-key km "p" 'proced-previous-line)
207 (define-key km "h" 'describe-mode) 205 (define-key km "\C-n" 'proced-next-line)
208 (define-key km "?" 'proced-help) 206 (define-key km "\C-p" 'proced-previous-line)
207 (define-key km "\C-?" 'proced-previous-line)
208 (define-key km [down] 'proced-next-line)
209 (define-key km [up] 'proced-previous-line)
210 ;; marking
209 (define-key km "d" 'proced-mark) ; Dired compatibility 211 (define-key km "d" 'proced-mark) ; Dired compatibility
210 (define-key km "m" 'proced-mark) 212 (define-key km "m" 'proced-mark)
211 (define-key km "M" 'proced-mark-all)
212 (define-key km "u" 'proced-unmark) 213 (define-key km "u" 'proced-unmark)
213 (define-key km "\177" 'proced-unmark-backward) 214 (define-key km "\177" 'proced-unmark-backward)
215 (define-key km "M" 'proced-mark-all)
214 (define-key km "U" 'proced-unmark-all) 216 (define-key km "U" 'proced-unmark-all)
215 (define-key km "t" 'proced-toggle-marks) 217 (define-key km "t" 'proced-toggle-marks)
216 (define-key km "h" 'proced-hide-processes) 218 ;; sorting
217 (define-key km "x" 'proced-send-signal) ; Dired compatibility
218 (define-key km "k" 'proced-send-signal) ; kill processes
219 (define-key km "l" 'proced-listing-type)
220 (define-key km "g" 'revert-buffer) ; Dired compatibility
221 (define-key km "q" 'quit-window)
222 (define-key km "sc" 'proced-sort-pcpu) 219 (define-key km "sc" 'proced-sort-pcpu)
223 (define-key km "sm" 'proced-sort-pmem) 220 (define-key km "sm" 'proced-sort-pmem)
224 (define-key km "sp" 'proced-sort-pid) 221 (define-key km "sp" 'proced-sort-pid)
225 (define-key km "ss" 'proced-sort-start) 222 (define-key km "ss" 'proced-sort-start)
226 (define-key km "sS" 'proced-sort) 223 (define-key km "sS" 'proced-sort)
227 (define-key km "st" 'proced-sort-time) 224 (define-key km "st" 'proced-sort-time)
225 ;; operate
226 (define-key km "h" 'proced-hide-processes)
227 (define-key km "x" 'proced-send-signal) ; Dired compatibility
228 (define-key km "k" 'proced-send-signal) ; kill processes
229 ;; misc
230 (define-key km "l" 'proced-listing-type)
231 (define-key km "g" 'revert-buffer) ; Dired compatibility
232 (define-key km "h" 'describe-mode)
233 (define-key km "?" 'proced-help)
234 (define-key km "q" 'quit-window)
228 (define-key km [remap undo] 'proced-undo) 235 (define-key km [remap undo] 'proced-undo)
229 (define-key km [remap advertised-undo] 'proced-undo) 236 (define-key km [remap advertised-undo] 'proced-undo)
230 km) 237 km)
@@ -256,24 +263,40 @@ Initialized based on `proced-procname-column-regexp'.")
256 "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)" 263 "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)"
257 "Help string for proced.") 264 "Help string for proced.")
258 265
266(defvar proced-header-alist nil
267 "Alist of headers in Proced buffer.
268Each element is of the form (NAME START END JUSTIFY).
269NAME is name of header in the output of ps(1).
270START and END are column numbers starting from 0.
271END is t if there is no end column for that field.
272JUSTIFY is 'left or 'right for left or right-justified output of ps(1).")
273(make-variable-buffer-local 'proced-header-alist)
274
275(defvar proced-sorting-schemes-re nil
276 "Regexp to match valid sorting schemes.")
277(make-variable-buffer-local 'proced-sorting-schemes-re)
278
279;; helper functions
259(defun proced-marker-regexp () 280(defun proced-marker-regexp ()
260 "Return regexp matching `proced-marker-char'." 281 "Return regexp matching `proced-marker-char'."
282 ;; `proced-marker-char' must appear in column zero
261 (concat "^" (regexp-quote (char-to-string proced-marker-char)))) 283 (concat "^" (regexp-quote (char-to-string proced-marker-char))))
262 284
263(defun proced-success-message (action count) 285(defun proced-success-message (action count)
264 "Display success message for ACTION performed for COUNT processes." 286 "Display success message for ACTION performed for COUNT processes."
265 (message "%s %s process%s" action count (if (= 1 count) "" "es"))) 287 (message "%s %s process%s" action count (if (= 1 count) "" "es")))
266 288
267(defun proced-move-to-procname () 289(defun proced-move-to-goal-column ()
268 "Move to the beginning of the process name on the current line. 290 "Move to `proced-goal-column' if non-nil."
269Return the position of the beginning of the process name, or nil if none found."
270 (beginning-of-line) 291 (beginning-of-line)
271 (if proced-procname-column 292 (if proced-goal-column
272 (forward-char proced-procname-column) 293 (forward-char proced-goal-column)
273 (forward-char 2))) 294 (forward-char 2)))
274 295
296;; FIXME: a better approach would be based on `proced-header-alist'
297;; once we have a reliable scheme to set this variable
275(defsubst proced-skip-regexp () 298(defsubst proced-skip-regexp ()
276 "Regexp to skip in process listing." 299 "Regexp to skip in process listing to find PID column."
277 (apply 'concat (make-list (1- (nth 2 (assoc proced-command 300 (apply 'concat (make-list (1- (nth 2 (assoc proced-command
278 proced-command-alist))) 301 proced-command-alist)))
279 "\\s-+\\S-+"))) 302 "\\s-+\\S-+")))
@@ -306,7 +329,7 @@ information will be displayed but not selected.
306 329
307\\{proced-mode-map}" 330\\{proced-mode-map}"
308 (interactive "P") 331 (interactive "P")
309 (let ((buffer (get-buffer-create "*Process Info*")) new) 332 (let ((buffer (get-buffer-create "*Proced*")) new)
310 (set-buffer buffer) 333 (set-buffer buffer)
311 (setq new (zerop (buffer-size))) 334 (setq new (zerop (buffer-size)))
312 (if new (proced-mode)) 335 (if new (proced-mode))
@@ -320,6 +343,20 @@ information will be displayed but not selected.
320 (message (substitute-command-keys 343 (message (substitute-command-keys
321 "type \\[quit-window] to quit, \\[proced-help] for help"))))) 344 "type \\[quit-window] to quit, \\[proced-help] for help")))))
322 345
346(defun proced-next-line (arg)
347 "Move down lines then position at `proced-goal-column'.
348Optional prefix ARG says how many lines to move; default is one line."
349 (interactive "p")
350 (next-line arg)
351 (proced-move-to-goal-column))
352
353(defun proced-previous-line (arg)
354 "Move up lines then position at `proced-goal-column'.
355Optional prefix ARG says how many lines to move; default is one line."
356 (interactive "p")
357 (previous-line arg)
358 (proced-move-to-goal-column))
359
323(defun proced-mark (&optional count) 360(defun proced-mark (&optional count)
324 "Mark the current (or next COUNT) processes." 361 "Mark the current (or next COUNT) processes."
325 (interactive "p") 362 (interactive "p")
@@ -341,16 +378,13 @@ information will be displayed but not selected.
341 "Mark the current (or next ARG) processes using MARK." 378 "Mark the current (or next ARG) processes using MARK."
342 (or count (setq count 1)) 379 (or count (setq count 1))
343 (let ((backward (< count 0)) 380 (let ((backward (< count 0))
344 (line (line-number-at-pos))
345 buffer-read-only) 381 buffer-read-only)
346 ;; do nothing in the first line 382 (setq count (1+ (if (<= 0 count) count
347 (unless (= line 1) 383 (min (1- (line-number-at-pos)) (abs count)))))
348 (setq count (1+ (if (<= 0 count) count 384 (beginning-of-line)
349 (min (- line 2) (abs count))))) 385 (while (not (or (zerop (setq count (1- count))) (eobp)))
350 (beginning-of-line) 386 (proced-insert-mark mark backward))
351 (while (not (or (zerop (setq count (1- count))) (eobp))) 387 (proced-move-to-goal-column)))
352 (proced-insert-mark mark backward))
353 (proced-move-to-procname))))
354 388
355(defun proced-mark-all () 389(defun proced-mark-all ()
356 "Mark all processes." 390 "Mark all processes."
@@ -366,7 +400,7 @@ information will be displayed but not selected.
366 "Mark all processes using MARK." 400 "Mark all processes using MARK."
367 (let (buffer-read-only) 401 (let (buffer-read-only)
368 (save-excursion 402 (save-excursion
369 (goto-line 2) 403 (goto-char (point-min))
370 (while (not (eobp)) 404 (while (not (eobp))
371 (proced-insert-mark mark))))) 405 (proced-insert-mark mark)))))
372 406
@@ -376,7 +410,7 @@ information will be displayed but not selected.
376 (let ((mark-re (proced-marker-regexp)) 410 (let ((mark-re (proced-marker-regexp))
377 buffer-read-only) 411 buffer-read-only)
378 (save-excursion 412 (save-excursion
379 (goto-line 2) 413 (goto-char (point-min))
380 (while (not (eobp)) 414 (while (not (eobp))
381 (cond ((looking-at mark-re) 415 (cond ((looking-at mark-re)
382 (proced-insert-mark nil)) 416 (proced-insert-mark nil))
@@ -411,26 +445,22 @@ Returns count of hidden lines."
411 (save-excursion 445 (save-excursion
412 (if arg 446 (if arg
413 ;; Hide ARG lines starting with the current line. 447 ;; Hide ARG lines starting with the current line.
414 (let ((line (line-number-at-pos))) 448 (delete-region (line-beginning-position)
415 ;; do nothing in the first line 449 (save-excursion
416 (unless (= line 1) 450 (if (<= 0 arg)
417 (delete-region (line-beginning-position) 451 (setq count (- arg (forward-line arg)))
418 (save-excursion 452 (setq count (min (1- (line-number-at-pos))
419 (if (<= 0 arg) 453 (abs arg)))
420 (setq count (- arg (forward-line arg))) 454 (forward-line (- count)))
421 (setq count (min (- line 2) (abs arg))) 455 (point)))
422 (forward-line (- count)))
423 (point)))))
424 ;; Hide marked lines 456 ;; Hide marked lines
425 (goto-line 2)
426 (while (and (not (eobp)) 457 (while (and (not (eobp))
427 (re-search-forward mark-re nil t)) 458 (re-search-forward mark-re nil t))
428 (delete-region (match-beginning 0) 459 (delete-region (match-beginning 0)
429 (save-excursion (forward-line) (point))) 460 (save-excursion (forward-line) (point)))
430 (setq count (1+ count))))) 461 (setq count (1+ count)))))
431 (unless (zerop count) (proced-move-to-procname)) 462 (unless (zerop count) (proced-move-to-goal-column))
432 (unless quiet 463 (unless quiet (proced-success-message "Hid" count))
433 (proced-success-message "Hid" count))
434 count)) 464 count))
435 465
436(defun proced-listing-type (command) 466(defun proced-listing-type (command)
@@ -440,6 +470,11 @@ Returns count of hidden lines."
440 (setq proced-command command) 470 (setq proced-command command)
441 (proced-update)) 471 (proced-update))
442 472
473;; adopted from `ruler-mode-space'
474(defsubst proced-header-space (width)
475 "Return a single space string of WIDTH times the normal character width."
476 (propertize " " 'display (list 'space :width width)))
477
443(defun proced-update (&optional quiet) 478(defun proced-update (&optional quiet)
444 "Update the `proced' process information. Preserves point and marks." 479 "Update the `proced' process information. Preserves point and marks."
445 ;; This is the main function that generates and updates the process listing. 480 ;; This is the main function that generates and updates the process listing.
@@ -452,12 +487,12 @@ Returns count of hidden lines."
452 (looking-at (concat "^[* ]" regexp))) 487 (looking-at (concat "^[* ]" regexp)))
453 (cons (match-string-no-properties 1) 488 (cons (match-string-no-properties 1)
454 (current-column)))) 489 (current-column))))
455 buffer-read-only plist) 490 buffer-read-only mp-list)
456 (goto-char (point-min)) 491 (goto-char (point-min))
457 ;; remember marked processes (whatever the mark was) 492 ;; remember marked processes (whatever the mark was)
458 (while (re-search-forward (concat "^\\(\\S-\\)" regexp) nil t) 493 (while (re-search-forward (concat "^\\(\\S-\\)" regexp) nil t)
459 (push (cons (match-string-no-properties 2) 494 (push (cons (match-string-no-properties 2)
460 (match-string-no-properties 1)) plist)) 495 (match-string-no-properties 1)) mp-list))
461 ;; generate new listing 496 ;; generate new listing
462 (erase-buffer) 497 (erase-buffer)
463 (apply 'call-process (car command) nil t nil 498 (apply 'call-process (car command) nil t nil
@@ -471,25 +506,55 @@ Returns count of hidden lines."
471 (goto-char (point-min)) 506 (goto-char (point-min))
472 (while (re-search-forward "[ \t\r]+$" nil t) 507 (while (re-search-forward "[ \t\r]+$" nil t)
473 (delete-region (match-beginning 0) (match-end 0))) 508 (delete-region (match-beginning 0) (match-end 0)))
474 (set-buffer-modified-p nil)
475 ;; set `proced-procname-column'
476 (goto-char (point-min)) 509 (goto-char (point-min))
477 (and proced-procname-column-regexp 510 (let ((lep (line-end-position)))
478 (re-search-forward proced-procname-column-regexp nil t) 511 ;; header line: code inspired by `ruler-mode-ruler'
479 (setq proced-procname-column (1- (match-beginning 0)))) 512 (setq header-line-format
513 (list "" (if (eq 'left (car (window-current-scroll-bars)))
514 (proced-header-space 'scroll-bar))
515 (proced-header-space 'left-fringe)
516 (proced-header-space 'left-margin)
517 (replace-regexp-in-string
518 "%" "%%" (buffer-substring-no-properties (point) lep))))
519 (setq proced-header-alist nil)
520 ;; FIXME: handle left/right justification properly
521 (while (re-search-forward "\\([^ \t\n]+\\)[ \t]*\\($\\)?" lep t)
522 (push (list (match-string-no-properties 1)
523 ;; take the column number starting from zero
524 (1- (match-beginning 0)) (or (not (not (match-beginning 2)))
525 (1- (match-end 0)))
526 'left)
527 proced-header-alist)))
528 (let ((temp (regexp-opt (mapcar 'car proced-header-alist) t)))
529 (setq proced-sorting-schemes-re
530 (concat "\\`" temp "\\(," temp "\\)*\\'")))
531 ;; remove header line from ps(1) output
532 (goto-char (point-min))
533 (delete-region (point)
534 (save-excursion (forward-line) (point)))
535 (set-buffer-modified-p nil)
536 ;; set `proced-goal-column'
537 (if proced-goal-header-re
538 (let ((hlist proced-header-alist) header)
539 (while (setq header (pop hlist))
540 (if (string-match proced-goal-header-re (car header))
541 (setq proced-goal-column
542 (if (eq 'left (nth 3 header))
543 (nth 1 header) (nth 2 header))
544 hlist nil)))))
480 ;; restore process marks 545 ;; restore process marks
481 (if plist 546 (if mp-list
482 (save-excursion 547 (save-excursion
483 (goto-line 2) 548 (goto-char (point-min))
484 (let (mark) 549 (let (mark)
485 (while (re-search-forward (concat "^" regexp) nil t) 550 (while (re-search-forward (concat "^" regexp) nil t)
486 (if (setq mark (assoc (match-string-no-properties 1) plist)) 551 (if (setq mark (assoc (match-string-no-properties 1) mp-list))
487 (save-excursion 552 (save-excursion
488 (beginning-of-line) 553 (beginning-of-line)
489 (insert (cdr mark)) 554 (insert (cdr mark))
490 (delete-char 1))))))) 555 (delete-char 1)))))))
491 ;; restore buffer position (if possible) 556 ;; restore buffer position (if possible)
492 (goto-line 2) 557 (goto-char (point-min))
493 (if (and old-pos 558 (if (and old-pos
494 (re-search-forward 559 (re-search-forward
495 (concat "^[* ]" (proced-skip-regexp) "\\s-+" (car old-pos) "\\>") 560 (concat "^[* ]" (proced-skip-regexp) "\\s-+" (car old-pos) "\\>")
@@ -497,11 +562,13 @@ Returns count of hidden lines."
497 (progn 562 (progn
498 (beginning-of-line) 563 (beginning-of-line)
499 (forward-char (cdr old-pos))) 564 (forward-char (cdr old-pos)))
500 (proced-move-to-procname)) 565 (proced-move-to-goal-column))
501 ;; update modeline 566 ;; update modeline
502 (setq mode-name (if proced-sorting-scheme 567 ;; Does the long mode-name clutter the modeline?
503 (concat "Proced by " proced-sorting-scheme) 568 (setq mode-name (concat "Proced: " proced-command
504 "Proced")) 569 (if proced-sorting-scheme
570 (concat " by " proced-sorting-scheme)
571 "")))
505 (force-mode-line-update) 572 (force-mode-line-update)
506 ;; done 573 ;; done
507 (or quiet (input-pending-p) 574 (or quiet (input-pending-p)
@@ -512,7 +579,9 @@ Returns count of hidden lines."
512 (proced-update)) 579 (proced-update))
513 580
514;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer' 581;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer'
515;; and move it to simple.el so that proced and ibuffer can easily use it, too? 582;; and move it to window.el so that proced and ibuffer can easily use it, too?
583;; What about functions like `appt-disp-window' that use
584;; `shrink-window-if-larger-than-buffer'?
516(autoload 'dired-pop-to-buffer "dired") 585(autoload 'dired-pop-to-buffer "dired")
517 586
518(defun proced-send-signal (&optional signal) 587(defun proced-send-signal (&optional signal)
@@ -522,7 +591,7 @@ If SIGNAL is nil display marked processes and query interactively for SIGNAL."
522 (interactive) 591 (interactive)
523 (let ((regexp (concat (proced-marker-regexp) 592 (let ((regexp (concat (proced-marker-regexp)
524 (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$")) 593 (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$"))
525 plist) 594 process-list)
526 ;; collect marked processes 595 ;; collect marked processes
527 (save-excursion 596 (save-excursion
528 (goto-char (point-min)) 597 (goto-char (point-min))
@@ -532,29 +601,26 @@ If SIGNAL is nil display marked processes and query interactively for SIGNAL."
532 ;; better to collect only the PID (to avoid ambiguities) 601 ;; better to collect only the PID (to avoid ambiguities)
533 ;; and the command name? 602 ;; and the command name?
534 (substring (match-string-no-properties 0) 2)) 603 (substring (match-string-no-properties 0) 2))
535 plist))) 604 process-list)))
536 (setq plist (nreverse plist)) 605 (setq process-list (nreverse process-list))
537 (if (not plist) 606 (if (not process-list)
538 (message "No processes marked") 607 (message "No processes marked")
539 (unless signal 608 (unless signal
540 ;; Display marked processes (code taken from `dired-mark-pop-up'). 609 ;; Display marked processes (code taken from `dired-mark-pop-up').
541 (let ((bufname " *Marked Processes*") 610 (let ((bufname " *Marked Processes*")
542 (header (save-excursion 611 (header header-line-format)) ; reuse
543 (goto-char (+ 2 (point-min)))
544 (buffer-substring-no-properties
545 (point) (line-end-position)))))
546 (with-current-buffer (get-buffer-create bufname) 612 (with-current-buffer (get-buffer-create bufname)
547 (setq truncate-lines t) 613 (setq truncate-lines t
614 header-line-format header)
548 (erase-buffer) 615 (erase-buffer)
549 (insert header "\n") 616 (dolist (process process-list)
550 (dolist (proc plist) 617 (insert " " (cdr process) "\n"))
551 (insert (cdr proc) "\n"))
552 (save-window-excursion 618 (save-window-excursion
553 (dired-pop-to-buffer bufname) ; all we need 619 (dired-pop-to-buffer bufname) ; all we need
554 (let* ((completion-ignore-case t) 620 (let* ((completion-ignore-case t)
555 (pnum (if (= 1 (length plist)) 621 (pnum (if (= 1 (length process-list))
556 "1 process" 622 "1 process"
557 (format "%d processes" (length plist)))) 623 (format "%d processes" (length process-list))))
558 ;; The following is an ugly hack. Is there a better way 624 ;; The following is an ugly hack. Is there a better way
559 ;; to help people like me to remember the signals and 625 ;; to help people like me to remember the signals and
560 ;; their meanings? 626 ;; their meanings?
@@ -574,7 +640,7 @@ If SIGNAL is nil display marked processes and query interactively for SIGNAL."
574 (string-to-number signal) 640 (string-to-number signal)
575 (make-symbol signal)) 641 (make-symbol signal))
576 signal))) ; number 642 signal))) ; number
577 (dolist (process plist) 643 (dolist (process process-list)
578 (if (zerop (funcall 644 (if (zerop (funcall
579 proced-signal-function 645 proced-signal-function
580 (string-to-number (car process)) signal)) 646 (string-to-number (car process)) signal))
@@ -583,7 +649,7 @@ If SIGNAL is nil display marked processes and query interactively for SIGNAL."
583 ;; use external system call 649 ;; use external system call
584 (let ((signal (concat "-" (if (numberp signal) 650 (let ((signal (concat "-" (if (numberp signal)
585 (number-to-string signal) signal)))) 651 (number-to-string signal) signal))))
586 (dolist (process plist) 652 (dolist (process process-list)
587 (if (zerop (call-process 653 (if (zerop (call-process
588 proced-signal-function nil 0 nil 654 proced-signal-function nil 0 nil
589 signal (car process))) 655 signal (car process)))
@@ -610,7 +676,7 @@ buffer. You can use it to recover marks."
610 (interactive) 676 (interactive)
611 (let (buffer-read-only) 677 (let (buffer-read-only)
612 (undo)) 678 (undo))
613 (message "Change in proced buffer undone. 679 (message "Change in Proced buffer undone.
614Killed processes cannot be recovered by Emacs.")) 680Killed processes cannot be recovered by Emacs."))
615 681
616;;; Sorting 682;;; Sorting
@@ -619,20 +685,29 @@ Killed processes cannot be recovered by Emacs."))
619When called interactively, an empty string means nil, i.e., no sorting." 685When called interactively, an empty string means nil, i.e., no sorting."
620 (interactive 686 (interactive
621 (list (let* ((completion-ignore-case t) 687 (list (let* ((completion-ignore-case t)
688 ;; restrict completion list to applicable sorting schemes
689 (completion-list
690 (apply 'append
691 (mapcar (lambda (x)
692 (if (string-match proced-sorting-schemes-re
693 (car x))
694 (list (car x))))
695 proced-sorting-schemes-alist)))
622 (scheme (completing-read "Sorting type: " 696 (scheme (completing-read "Sorting type: "
623 proced-sorting-schemes-alist nil t))) 697 completion-list nil t)))
624 (if (string= "" scheme) nil scheme)))) 698 (if (string= "" scheme) nil scheme))))
625 (if (proced-sorting-scheme-p scheme) 699 (if (proced-sorting-scheme-p scheme)
626 (progn 700 (progn
627 (setq proced-sorting-scheme scheme) 701 (setq proced-sorting-scheme scheme)
628 (proced-update)) 702 (proced-update))
629 (error "Proced sorting scheme %s undefined" scheme))) 703 (error "Proced sorting scheme %s not applicable" scheme)))
630 704
631(defun proced-sorting-scheme-p (scheme) 705(defun proced-sorting-scheme-p (scheme)
632 "Return non-nil if SCHEME is an applicable sorting scheme. 706 "Return non-nil if SCHEME is an applicable sorting scheme.
633SCHEME must be a string or nil." 707SCHEME must be a string or nil."
634 (or (not scheme) 708 (or (not scheme)
635 (assoc scheme proced-sorting-schemes-alist))) 709 (and (string-match proced-sorting-schemes-re scheme)
710 (assoc scheme proced-sorting-schemes-alist))))
636 711
637(defun proced-sort-pcpu () 712(defun proced-sort-pcpu ()
638 "Sort Proced buffer by percentage CPU time (%CPU)." 713 "Sort Proced buffer by percentage CPU time (%CPU)."