1 ;;; proced.el --- operate on system processes like dired
3 ;; Copyright (C) 2008 Free Software Foundation, Inc.
5 ;; Author: Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
6 ;; Keywords: Processes, Unix
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; Proced makes an Emacs buffer containing a listing of the current system
26 ;; processes (using ps(1)). You can use the normal Emacs commands
27 ;; to move around in this buffer, and special Proced commands to operate
28 ;; on the processes listed.
31 ;; - use list-system-processes and system-process-attributes
32 ;; - sort and filter by user name or other criteria
33 ;; - make fields clickable for marking / filtering / sorting:
34 ;; clicking on a USER field marks all processes of this user etc
35 ;; clicking on a %MEM field marks all processes with at least this %MEM.
36 ;; clicking on a header field sorts according to this header
37 ;; - mark parent and children PIDs (or both)
38 ;; - automatic update of process list
39 ;; - allow "sudo kill PID", "renice PID"
49 ;; FIXME: a better approach instead of PID-COLUMN would be based
50 ;; on `proced-header-alist' once we have a reliable scheme to set this variable
51 (defcustom proced-command-alist
52 (cond ((memq system-type
'(berkeley-unix))
53 '(("user" ("ps" "-uxgww") 2)
54 ("user-running" ("ps" "-uxrgww") 2)
55 ("all" ("ps" "-auxgww") 2)
56 ("all-running" ("ps" "-auxrgww") 2)))
57 ((memq system-type
'(gnu gnu
/linux
)) ; BSD syntax
58 `(("user" ("ps" "uxwww") 2)
59 ("user-running" ("ps" "uxrwww") 2)
60 ("all" ("ps" "auxwww") 2)
61 ("all-running" ("ps" "auxrwww") 2)
62 ("emacs" ("ps" "--pid" ,(number-to-string (emacs-pid))
63 "--ppid" ,(number-to-string (emacs-pid))
65 ((memq system-type
'(darwin))
66 `(("user" ("ps" "-u" ,(number-to-string (user-uid))) 2)
67 ("all" ("ps" "-Au") 2)))
68 (t ; standard UNIX syntax; doesn't allow to list running processes only
69 `(("user" ("ps" "-fu" ,(number-to-string (user-uid))) 2)
70 ("all" ("ps" "-ef") 2))))
71 "Alist of commands to get list of processes.
72 Each element has the form (NAME COMMAND PID-COLUMN).
73 NAME is a shorthand name to select the type of listing.
74 COMMAND is a list (COMMAND-NAME ARG1 ARG2 ...),
75 where COMMAND-NAME is the command to generate the listing (usually \"ps\").
76 ARG1, ARG2, ... are arguments passed to COMMAND-NAME to generate
77 a particular listing. These arguments differ under various operating systems.
78 PID-COLUMN is the column number (starting from 1) of the process ID."
80 :type
'(repeat (group (string :tag
"name")
81 (cons (string :tag
"command")
82 (repeat (string :tag
"option")))
83 (integer :tag
"PID column"))))
85 (defcustom proced-command
(if (zerop (user-real-uid)) "all" "user")
86 "Name of process listing.
87 Must be the car of an element of `proced-command-alist'."
89 :type
'(string :tag
"name"))
90 (make-variable-buffer-local 'proced-command
)
92 ;; Should we incorporate in NAME that sorting can be done in ascending
93 ;; or descending order? Then we couldn't associate NAME anymore with one
94 ;; of the headers in the output of ps(1).
95 ;; FIXME: A sorting scheme without options or with an option being a symbol
96 ;; should be implemented in elisp
97 (defcustom proced-sorting-schemes-alist
98 (cond ((memq system-type
'(gnu gnu
/linux
)) ; GNU long options
99 '(("%CPU" "--sort" "-pcpu") ; descending order
100 ("%MEM" "--sort" "-pmem") ; descending order
101 ("COMMAND" "--sort" "args")
102 ("PID" "--sort" "pid")
103 ("PGID,PID" "--sort" "pgid,pid")
104 ("PPID,PID" "--sort" "ppid,pid")
105 ("RSS" "--sort" "rss,pid") ; equal RSS's are rare
106 ("STAT,PID" "--sort" "stat,pid")
107 ("START" "--sort" "start_time")
108 ("TIME" "--sort" "cputime")
109 ("TTY,PID" "--sort" "tty,pid")
110 ("UID,PID" "--sort" "uid,pid")
111 ("USER,PID" "--sort" "user,pid")
112 ("VSZ,PID" "--sort" "vsz,pid"))))
113 "Alist of sorting schemes.
114 Each element is a list (NAME OPTION1 OPTION2 ...).
115 NAME denotes the sorting scheme. It is the name of a header or a
116 comma-separated sequence of headers in the output of ps(1).
117 OPTION1, OPTION2, ... are options defining the sorting scheme."
119 :type
'(repeat (cons (string :tag
"name")
120 (repeat (string :tag
"option")))))
122 (defcustom proced-sorting-scheme nil
123 "Proced sorting type.
124 Must be the car of an element of `proced-sorting-schemes-alist' or nil."
126 :type
`(choice ,@(append '((const nil
)) ; sorting type may be nil
127 (mapcar (lambda (item)
128 (list 'const
(car item
)))
129 proced-sorting-schemes-alist
))))
130 (make-variable-buffer-local 'proced-sorting-scheme
)
132 (defcustom proced-goal-header-re
"\\b\\(CMD\\|COMMAND\\)\\b"
133 "If non-nil, regexp that defines the `proced-goal-column'."
135 :type
'(choice (const :tag
"none" nil
)
136 (regexp :tag
"regexp")))
138 (defcustom proced-signal-function
'signal-process
139 "Name of signal function.
140 It can be an elisp function (usually `signal-process') or a string specifying
141 the external command (usually \"kill\")."
143 :type
'(choice (function :tag
"function")
144 (string :tag
"command")))
146 (defcustom proced-signal-list
147 '(;; signals supported on all POSIX compliant systems
149 ("INT (2. Terminal interrupt)")
150 ("QUIT (3. Terminal quit)")
151 ("ABRT (6. Process abort)")
152 ("KILL (9. Kill - cannot be caught or ignored)")
153 ("ALRM (14. Alarm Clock)")
154 ("TERM (15. Termination)")
156 ;; Which systems do not support these signals so that we can
157 ;; exclude them from `proced-signal-list'?
158 ("CONT (Continue executing)")
159 ("STOP (Stop executing / pause - cannot be caught or ignored)")
160 ("TSTP (Terminal stop / pause)"))
161 "List of signals, used for minibuffer completion."
163 :type
'(repeat (string :tag
"signal")))
165 ;; Internal variables
166 (defvar proced-marker-char ?
* ; the answer is 42
167 "In proced, the current mark character.")
169 ;; face and font-lock code taken from dired
170 (defgroup proced-faces nil
171 "Faces used by Proced."
176 '((t (:inherit font-lock-constant-face
)))
177 "Face used for proced marks."
178 :group
'proced-faces
)
179 (defvar proced-mark-face
'proced-mark
180 "Face name used for proced marks.")
182 (defface proced-marked
183 '((t (:inherit font-lock-warning-face
)))
184 "Face used for marked processes."
185 :group
'proced-faces
)
186 (defvar proced-marked-face
'proced-marked
187 "Face name used for marked processes.")
189 (defvar proced-re-mark
"^[^ \n]"
190 "Regexp matching a marked line.
191 Important: the match ends just after the marker.")
193 (defvar proced-goal-column nil
194 "Proced goal column. Initialized based on `proced-goal-header-re'.")
195 (make-variable-buffer-local 'proced-goal-column
)
197 (defvar proced-font-lock-keywords
201 (list proced-re-mark
'(0 proced-mark-face
))
204 (list (concat "^[" (char-to-string proced-marker-char
) "]")
205 '(".+" (proced-move-to-goal-column) nil
(0 proced-marked-face
)))))
207 (defvar proced-mode-map
208 (let ((km (make-sparse-keymap)))
210 (define-key km
" " 'proced-next-line
)
211 (define-key km
"n" 'proced-next-line
)
212 (define-key km
"p" 'proced-previous-line
)
213 (define-key km
"\C-n" 'proced-next-line
)
214 (define-key km
"\C-p" 'proced-previous-line
)
215 (define-key km
"\C-?" 'proced-previous-line
)
216 (define-key km
[down] 'proced-next-line)
217 (define-key km [up] 'proced-previous-line)
219 (define-key km "d" 'proced-mark) ; Dired compatibility
220 (define-key km "m" 'proced-mark)
221 (define-key km "u" 'proced-unmark)
222 (define-key km "\177" 'proced-unmark-backward)
223 (define-key km "M" 'proced-mark-all)
224 (define-key km "U" 'proced-unmark-all)
225 (define-key km "t" 'proced-toggle-marks)
227 (define-key km "sc" 'proced-sort-pcpu)
228 (define-key km "sm" 'proced-sort-pmem)
229 (define-key km "sp" 'proced-sort-pid)
230 (define-key km "ss" 'proced-sort-start)
231 (define-key km "sS" 'proced-sort)
232 (define-key km "st" 'proced-sort-time)
234 (define-key km "o" 'proced-omit-processes)
235 (define-key km "x" 'proced-send-signal) ; Dired compatibility
236 (define-key km "k" 'proced-send-signal) ; kill processes
238 (define-key km "l" 'proced-listing-type)
239 (define-key km "g" 'revert-buffer) ; Dired compatibility
240 (define-key km "h" 'describe-mode)
241 (define-key km "?" 'proced-help)
242 (define-key km "q" 'quit-window)
243 (define-key km [remap undo] 'proced-undo)
244 (define-key km [remap advertised-undo] 'proced-undo)
246 "Keymap for proced commands.")
249 proced-menu proced-mode-map "Proced Menu"
252 :help "Mark Current Process"]
253 ["Unmark" proced-unmark
254 :help "Unmark Current Process"]
255 ["Mark All" proced-mark-all
256 :help "Mark All Processes"]
257 ["Unmark All" proced-unmark-all
258 :help "Unmark All Process"]
259 ["Toggle Marks" proced-toggle-marks
260 :help "Marked Processes Become Unmarked, and Vice Versa"]
262 ["Sort..." proced-sort
263 :help "Sort Process List"]
264 ["Sort by %CPU" proced-sort-pcpu (proced-sorting-scheme-p "%CPU")]
265 ["Sort by %MEM" proced-sort-pmem (proced-sorting-scheme-p "%MEM")]
266 ["Sort by PID" proced-sort-pid (proced-sorting-scheme-p "PID")]
267 ["Sort by START" proced-sort-start (proced-sorting-scheme-p "START")]
268 ["Sort by TIME" proced-sort-time (proced-sorting-scheme-p "TIME")]
270 ["Omit Marked Processes" proced-omit-processes
271 :help "Omit Marked Processes in Process Listing."]
273 ["Revert" revert-buffer
274 :help "Revert Process Listing"]
275 ["Send signal" proced-send-signal
276 :help "Send Signal to Marked Processes"]
278 :help "Select Type of Process Listing"
279 ,@(mapcar (lambda (el)
280 (let ((command (car el)))
281 `[,command (proced-listing-type ,command)
283 :selected (string= proced-command ,command)]))
284 proced-command-alist))))
286 (defconst proced-help-string
287 "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)"
288 "Help string for proced.")
290 (defvar proced-header-line nil
291 "Headers in Proced buffer as a string.")
292 (make-variable-buffer-local 'proced-header-line)
294 (defvar proced-header-alist nil
295 "Alist of headers in Proced buffer.
296 Each element is of the form (NAME START END JUSTIFY).
297 NAME is name of header in the output of ps(1).
298 START and END are column numbers starting from 0.
299 END is t if there is no end column for that field.
300 JUSTIFY is 'left or 'right for left or right-justified output of ps(1).")
301 (make-variable-buffer-local 'proced-header-alist)
303 (defvar proced-sorting-schemes-re nil
304 "Regexp to match valid sorting schemes.")
305 (make-variable-buffer-local 'proced-sorting-schemes-re)
307 (defvar proced-log-buffer "*Proced log*"
308 "Name of Proced Log buffer.")
311 (defun proced-marker-regexp ()
312 "Return regexp matching `proced-marker-char'."
313 ;; `proced-marker-char' must appear in column zero
314 (concat "^" (regexp-quote (char-to-string proced-marker-char))))
316 (defun proced-success-message (action count)
317 "Display success message for ACTION performed for COUNT processes."
318 (message "%s %s process%s" action count (if (= 1 count) "" "es")))
320 (defun proced-move-to-goal-column ()
321 "Move to `proced-goal-column' if non-nil."
323 (if proced-goal-column
324 (forward-char proced-goal-column)
327 ;; FIXME: a better approach would be based on `proced-header-alist'
328 ;; once we have a reliable scheme to set this variable
329 (defsubst proced-skip-regexp ()
330 "Regexp to skip in process listing to find PID column."
331 (apply 'concat (make-list (1- (nth 2 (assoc proced-command
332 proced-command-alist)))
335 (define-derived-mode proced-mode nil "Proced"
336 "Mode for displaying UNIX system processes and sending signals to them.
337 Type \\<proced-mode-map>\\[proced-mark] to mark a process for later commands.
338 Type \\[proced-send-signal] to send signals to marked processes.
343 (setq buffer-read-only t
345 header-line-format '(:eval (proced-header-line)))
346 (add-hook 'post-command-hook 'force-mode-line-update nil t)
347 (set (make-local-variable 'revert-buffer-function) 'proced-revert)
348 (set (make-local-variable 'font-lock-defaults)
349 '(proced-font-lock-keywords t nil nil beginning-of-line)))
351 ;; Proced mode is suitable only for specially formatted data.
352 (put 'proced-mode 'mode-class 'special)
355 (defun proced (&optional arg)
356 "Mode for displaying UNIX system processes and sending signals to them.
357 Type \\<proced-mode-map>\\[proced-mark] to mark a process for later commands.
358 Type \\[proced-send-signal] to send signals to marked processes.
360 If invoked with optional ARG the window displaying the process
361 information will be displayed but not selected.
365 (let ((buffer (get-buffer-create "*Proced*")) new)
367 (setq new (zerop (buffer-size)))
368 (if new (proced-mode))
372 (display-buffer buffer)
373 (pop-to-buffer buffer)
375 (substitute-command-keys
376 "Type \\<proced-mode-map>\\[quit-window] to quit, \\[proced-help] for help")))))
378 (defun proced-next-line (arg)
379 "Move down lines then position at `proced-goal-column'.
380 Optional prefix ARG says how many lines to move; default is one line."
383 (proced-move-to-goal-column))
385 (defun proced-previous-line (arg)
386 "Move up lines then position at `proced-goal-column'.
387 Optional prefix ARG says how many lines to move; default is one line."
389 (forward-line (- arg))
390 (proced-move-to-goal-column))
392 (defun proced-mark (&optional count)
393 "Mark the current (or next COUNT) processes."
395 (proced-do-mark t count))
397 (defun proced-unmark (&optional count)
398 "Unmark the current (or next COUNT) processes."
400 (proced-do-mark nil count))
402 (defun proced-unmark-backward (&optional count)
403 "Unmark the previous (or COUNT previous) processes."
404 ;; Analogous to `dired-unmark-backward',
405 ;; but `ibuffer-unmark-backward' behaves different.
407 (proced-do-mark nil (- (or count 1))))
409 (defun proced-do-mark (mark &optional count)
410 "Mark the current (or next COUNT) processes using MARK."
411 (or count (setq count 1))
412 (let ((backward (< count 0))
414 (setq count (1+ (if (<= 0 count) count
415 (min (1- (line-number-at-pos)) (abs count)))))
417 (while (not (or (zerop (setq count (1- count))) (eobp)))
418 (proced-insert-mark mark backward))
419 (proced-move-to-goal-column)))
421 (defun proced-mark-all ()
423 If `transient-mark-mode' is turned on and the region is active,
426 (proced-do-mark-all t))
428 (defun proced-unmark-all ()
429 "Unmark all processes.
430 If `transient-mark-mode' is turned on and the region is active,
433 (proced-do-mark-all nil))
435 (defun proced-do-mark-all (mark)
436 "Mark all processes using MARK.
437 If `transient-mark-mode' is turned on and the region is active,
439 (let (buffer-read-only)
441 (if (and transient-mark-mode mark-active)
442 ;; Operate even on those lines that are only partially a part
443 ;; of region. This appears most consistent with
444 ;; `proced-move-to-goal-column'.
445 (let ((end (save-excursion
446 (goto-char (region-end))
447 (unless (looking-at "^") (forward-line))
449 (goto-char (region-beginning))
450 (unless (looking-at "^") (beginning-of-line))
451 (while (< (point) end)
452 (proced-insert-mark mark)))
453 (goto-char (point-min))
455 (proced-insert-mark mark))))))
457 (defun proced-toggle-marks ()
458 "Toggle marks: marked processes become unmarked, and vice versa."
460 (let ((mark-re (proced-marker-regexp))
463 (goto-char (point-min))
465 (cond ((looking-at mark-re)
466 (proced-insert-mark nil))
468 (proced-insert-mark t))
470 (forward-line 1)))))))
472 (defun proced-insert-mark (mark &optional backward)
473 "If MARK is non-nil, insert `proced-marker-char'.
474 If BACKWARD is non-nil, move one line backwards before inserting the mark.
475 Otherwise move one line forward after inserting the mark."
476 (if backward (forward-line -1))
477 (insert (if mark proced-marker-char ?\s))
479 (unless backward (forward-line)))
481 ;; Mostly analog of `dired-do-kill-lines'.
482 ;; However, for negative args the target lines of `dired-do-kill-lines'
483 ;; include the current line, whereas `dired-mark' for negative args operates
484 ;; on the preceding lines. Here we are consistent with `dired-mark'.
485 (defun proced-omit-processes (&optional arg quiet)
486 "Omit marked processes.
487 With prefix ARG, omit that many lines starting with the current line.
488 \(A negative argument omits backward.)
489 If QUIET is non-nil suppress status message.
490 Returns count of omitted lines."
492 (let ((mark-re (proced-marker-regexp))
496 ;; Omit ARG lines starting with the current line.
497 (delete-region (line-beginning-position)
500 (setq count (- arg (forward-line arg)))
501 (setq count (min (1- (line-number-at-pos))
503 (forward-line (- count)))
507 (goto-char (point-min))
508 (while (and (not (eobp))
509 (re-search-forward mark-re nil t))
510 (delete-region (match-beginning 0)
511 (save-excursion (forward-line) (point)))
512 (setq count (1+ count)))))
513 (unless (zerop count) (proced-move-to-goal-column))
514 (unless quiet (proced-success-message "Omitted" count))
517 (defun proced-listing-type (command)
518 "Select `proced' listing type COMMAND from `proced-command-alist'."
520 (list (completing-read "Listing type: " proced-command-alist nil t)))
521 (setq proced-command command)
524 (defun proced-header-line ()
525 "Return header line for Proced buffer."
526 (list (propertize " " 'display '(space :align-to 0))
527 (replace-regexp-in-string
528 "%" "%%" (substring proced-header-line (window-hscroll)))))
530 (defun proced-update (&optional quiet)
531 "Update the `proced' process information. Preserves point and marks.
532 Suppress status information if QUIET is nil."
533 ;; This is the main function that generates and updates the process listing.
535 (or quiet (message "Updating process information..."))
536 (let* ((command (cadr (assoc proced-command proced-command-alist)))
537 (regexp (concat (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\)"))
538 (old-pos (if (save-excursion
540 (looking-at (concat "^[* ]" regexp)))
541 (cons (match-string-no-properties 1)
543 buffer-read-only mp-list)
544 (goto-char (point-min))
545 ;; remember marked processes (whatever the mark was)
546 (while (re-search-forward (concat "^\\(\\S-\\)" regexp) nil t)
547 (push (cons (match-string-no-properties 2)
548 (match-string-no-properties 1)) mp-list))
549 ;; generate new listing
551 (apply 'call-process (car command) nil t nil
552 (append (cdr command) (cdr (assoc proced-sorting-scheme
553 proced-sorting-schemes-alist))))
554 (goto-char (point-min))
558 ;; (delete-trailing-whitespace)
559 (goto-char (point-min))
560 (while (re-search-forward "[ \t\r]+$" nil t)
561 (delete-region (match-beginning 0) (match-end 0)))
562 (goto-char (point-min))
563 (let ((lep (line-end-position)))
564 (setq proced-header-line (buffer-substring-no-properties (point) lep))
565 (setq proced-header-alist nil)
566 ;; FIXME: handle left/right justification properly
567 (while (re-search-forward "\\([^ \t\n]+\\)[ \t]*\\($\\)?" lep t)
568 (push (list (match-string-no-properties 1)
569 ;; take the column number starting from zero
570 (- (match-beginning 0) (point-min))
571 (or (not (not (match-beginning 2)))
572 (- (match-end 0) (point-min)))
574 proced-header-alist)))
575 (let ((temp (regexp-opt (mapcar 'car proced-header-alist) t)))
576 (setq proced-sorting-schemes-re
577 (concat "\\`" temp "\\(," temp "\\)*\\'")))
578 ;; remove header line from ps(1) output
579 (goto-char (point-min))
580 (delete-region (point)
581 (save-excursion (forward-line) (point)))
582 (set-buffer-modified-p nil)
583 ;; set `proced-goal-column'
584 (if proced-goal-header-re
585 (let ((hlist proced-header-alist) header)
586 (while (setq header (pop hlist))
587 (if (string-match proced-goal-header-re (car header))
588 (setq proced-goal-column
589 (if (eq 'left (nth 3 header))
590 (nth 1 header) (nth 2 header))
592 ;; restore process marks
595 (goto-char (point-min))
597 (while (re-search-forward (concat "^" regexp) nil t)
598 (if (setq mark (assoc (match-string-no-properties 1) mp-list))
602 (delete-char 1)))))))
603 ;; restore buffer position (if possible)
604 (goto-char (point-min))
607 (concat "^[* ]" (proced-skip-regexp) "\\s-+" (car old-pos) "\\>")
611 (forward-char (cdr old-pos)))
612 (proced-move-to-goal-column))
614 ;; Does the long mode-name clutter the modeline?
615 (setq mode-name (concat "Proced: " proced-command
616 (if proced-sorting-scheme
617 (concat " by " proced-sorting-scheme)
619 (force-mode-line-update)
621 (or quiet (input-pending-p)
622 (message "Updating process information...done."))))
624 (defun proced-revert (&rest args)
625 "Analog of `revert-buffer'."
628 ;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer'
629 ;; and move it to window.el so that proced and ibuffer can easily use it, too?
630 ;; What about functions like `appt-disp-window' that use
631 ;; `shrink-window-if-larger-than-buffer'?
632 (autoload 'dired-pop-to-buffer "dired")
634 (defun proced-send-signal (&optional signal)
635 "Send a SIGNAL to the marked processes.
636 If no process is marked, operate on current process.
637 SIGNAL may be a string (HUP, INT, TERM, etc.) or a number.
638 If SIGNAL is nil display marked processes and query interactively for SIGNAL."
640 (let ((regexp (concat (proced-marker-regexp)
641 (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$"))
643 ;; collect marked processes
645 (goto-char (point-min))
646 (while (re-search-forward regexp nil t)
647 (push (cons (match-string-no-properties 1)
648 ;; How much info should we collect here? Would it be
649 ;; better to collect only the PID (to avoid ambiguities)
650 ;; and the command name?
651 (substring (match-string-no-properties 0) 2))
655 (nreverse process-list)
656 ;; take current process
659 (looking-at (concat "^" (proced-skip-regexp)
660 "\\s-+\\([0-9]+\\>\\).*$"))
661 (list (cons (match-string-no-properties 1)
662 (substring (match-string-no-properties 0) 2))))))
664 ;; Display marked processes (code taken from `dired-mark-pop-up').
665 (let ((bufname " *Marked Processes*")
666 (header proced-header-line)) ; inherit header line
667 (with-current-buffer (get-buffer-create bufname)
668 (setq truncate-lines t
669 proced-header-line header
670 header-line-format '(:eval (proced-header-line)))
671 (add-hook 'post-command-hook 'force-mode-line-update nil t)
673 (dolist (process process-list)
674 (insert " " (cdr process) "\n"))
675 (save-window-excursion
676 (dired-pop-to-buffer bufname) ; all we need
677 (let* ((completion-ignore-case t)
678 (pnum (if (= 1 (length process-list))
680 (format "%d processes" (length process-list))))
681 ;; The following is an ugly hack. Is there a better way
682 ;; to help people like me to remember the signals and
684 (tmp (completing-read (concat "Send signal [" pnum
685 "] (default TERM): ")
687 nil nil nil nil "TERM")))
688 (setq signal (if (string-match "^\\(\\S-+\\)\\s-" tmp)
689 (match-string 1 tmp) tmp))))))
693 ;; Why not always use `signal-process'? See
694 ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html
695 (if (functionp proced-signal-function)
696 ;; use built-in `signal-process'
697 (let ((signal (if (stringp signal)
698 (if (string-match "\\`[0-9]+\\'" signal)
699 (string-to-number signal)
700 (make-symbol signal))
702 (dolist (process process-list)
705 proced-signal-function
706 (string-to-number (car process)) signal))
707 (setq count (1+ count))
708 (proced-log "%s\n" (cdr process))
709 (push (cdr process) failures))
710 (error ;; catch errors from failed signals
711 (proced-log "%s\n" err)
712 (proced-log "%s\n" (cdr process))
713 (push (cdr process) failures)))))
714 ;; use external system call
715 (let ((signal (concat "-" (if (numberp signal)
716 (number-to-string signal) signal))))
717 (dolist (process process-list)
720 (if (zerop (call-process
721 proced-signal-function nil t nil
722 signal (car process)))
723 (setq count (1+ count))
724 (proced-log (current-buffer))
725 (proced-log "%s\n" (cdr process))
726 (push (cdr process) failures))
727 (error ;; catch errors from failed signals
728 (proced-log (current-buffer))
729 (proced-log "%s\n" (cdr process))
730 (push (cdr process) failures)))))))
734 (format "%d of %d signal%s failed"
735 (length failures) (length process-list)
736 (if (= 1 (length process-list)) "" "s")))
737 (proced-success-message "Sent signal to" count)))
739 (run-hooks 'proced-after-send-signal-hook))))
741 ;; just like `dired-why'
743 "Pop up a buffer with error log output from Proced.
744 A group of errors from a single command ends with a formfeed.
745 Thus, use \\[backward-page] to find the beginning of a group of errors."
747 (if (get-buffer proced-log-buffer)
748 (let ((owindow (selected-window))
749 (window (display-buffer (get-buffer proced-log-buffer))))
752 (select-window window)
753 (goto-char (point-max))
757 (select-window owindow)))))
759 ;; similar to `dired-log'
760 (defun proced-log (log &rest args)
761 "Log a message or the contents of a buffer.
762 If LOG is a string and there are more args, it is formatted with
763 those ARGS. Usually the LOG string ends with a \\n.
764 End each bunch of errors with (proced-log t signal):
765 this inserts the current time, buffer and signal at the start of the page,
766 and \f (formfeed) at the end."
767 (let ((obuf (current-buffer)))
768 (with-current-buffer (get-buffer-create proced-log-buffer)
769 (goto-char (point-max))
770 (let ((inhibit-read-only t))
773 (apply 'format log args)
776 (insert-buffer-substring log))
781 (insert (current-time-string)
782 "\tBuffer `" (buffer-name obuf) "', "
783 (format "signal `%s'\n" (car args)))
784 (goto-char (point-max))
785 (insert "\f\n")))))))
787 ;; similar to `dired-log-summary'
788 (defun proced-log-summary (signal string)
789 "State a summary of SIGNAL's failures, in echo area and log buffer.
790 STRING is an overall summary of the failures."
791 (message "Signal %s: %s--type ? for details" signal string)
792 ;; Log a summary describing a bunch of errors.
793 (proced-log (concat "\n" string "\n"))
794 (proced-log t signal))
796 (defun proced-help ()
797 "Provide help for the `proced' user."
800 (if (eq last-command 'proced-help)
802 (message proced-help-string)))
804 (defun proced-undo ()
805 "Undo in a proced buffer.
806 This doesn't recover killed processes, it just undoes changes in the proced
807 buffer. You can use it to recover marks."
809 (let (buffer-read-only)
811 (message "Change in Proced buffer undone.
812 Killed processes cannot be recovered by Emacs."))
815 (defun proced-sort (scheme)
816 "Sort Proced buffer using SCHEME.
817 When called interactively, an empty string means nil, i.e., no sorting."
819 (list (let* ((completion-ignore-case t)
820 ;; restrict completion list to applicable sorting schemes
824 (if (string-match proced-sorting-schemes-re
827 proced-sorting-schemes-alist)))
828 (scheme (completing-read "Sorting type: "
829 completion-list nil t)))
830 (if (string= "" scheme) nil scheme))))
831 (if (proced-sorting-scheme-p scheme)
833 (setq proced-sorting-scheme scheme)
835 (error "Proced sorting scheme %s not applicable" scheme)))
837 (defun proced-sorting-scheme-p (scheme)
838 "Return non-nil if SCHEME is an applicable sorting scheme.
839 SCHEME must be a string or nil."
841 (and (string-match proced-sorting-schemes-re scheme)
842 (assoc scheme proced-sorting-schemes-alist))))
844 (defun proced-sort-pcpu ()
845 "Sort Proced buffer by percentage CPU time (%CPU)."
847 (proced-sort "%CPU"))
849 (defun proced-sort-pmem ()
850 "Sort Proced buffer by percentage memory usage (%MEM)."
852 (proced-sort "%MEM"))
854 (defun proced-sort-pid ()
855 "Sort Proced buffer by PID."
859 (defun proced-sort-start ()
860 "Sort Proced buffer by time the command started (START)."
862 (proced-sort "START"))
864 (defun proced-sort-time ()
865 "Sort Proced buffer by cumulative CPU time (TIME)."
867 (proced-sort "TIME"))
871 ;; arch-tag: a6e312ad-9032-45aa-972d-31a8cfc545af
872 ;;; proced.el ends here