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, or (at your option)
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; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
27 ;; Proced makes an Emacs buffer containing a listing of the current system
28 ;; processes (using ps(1)). You can use the normal Emacs commands
29 ;; to move around in this buffer, and special Proced commands to operate
30 ;; on the processes listed.
33 ;; - sort the "cooked" values used in the output format fields
34 ;; if ps(1) doesn't support the requested sorting scheme
35 ;; - filter by user name or other criteria
36 ;; - automatic update of process list
46 (defcustom proced-procname-column-regexp
"\\b\\(CMD\\|COMMAND\\)\\b"
47 "If non-nil, regexp that defines the `proced-procname-column'."
49 :type
'(choice (const :tag
"none" nil
)
50 (regexp :tag
"regexp")))
52 (defcustom proced-command-alist
53 (cond ((memq system-type
'(berkeley-unix))
54 '(("user" ("ps" "-uxgww") 2)
55 ("user-running" ("ps" "-uxrgww") 2)
56 ("all" ("ps" "-auxgww") 2)
57 ("all-running" ("ps" "-auxrgww") 2)))
58 ((memq system-type
'(gnu gnu
/linux
)) ; BSD syntax
59 `(("user" ("ps" "uxwww") 2)
60 ("user-running" ("ps" "uxrwww") 2)
61 ("all" ("ps" "auxwww") 2)
62 ("all-running" ("ps" "auxrwww") 2)
63 ("emacs" ("ps" "--pid" ,(number-to-string (emacs-pid))
64 "--ppid" ,(number-to-string (emacs-pid))
66 ((memq system-type
'(darwin))
67 `(("user" ("ps" "-u" ,(number-to-string (user-uid))) 2)
68 ("all" ("ps" "-Au") 2)))
69 (t ; standard UNIX syntax; doesn't allow to list running processes only
70 `(("user" ("ps" "-fu" ,(number-to-string (user-uid))) 2)
71 ("all" ("ps" "-ef") 2))))
72 "Alist of commands to get list of processes.
73 Each element has the form (NAME COMMAND PID-COLUMN).
74 NAME is a shorthand name to select the type of listing.
75 COMMAND is a list (COMMAND-NAME ARG1 ARG2 ...),
76 where COMMAND-NAME is the command to generate the listing (usually \"ps\").
77 ARG1, ARG2, ... are arguments passed to COMMAND-NAME to generate
78 a particular listing. These arguments differ under various operating systems.
79 PID-COLUMN is the column number (starting from 1) of the process ID."
81 :type
'(repeat (group (string :tag
"name")
82 (cons (string :tag
"command")
83 (repeat (string :tag
"option")))
84 (integer :tag
"PID column"))))
86 ;; Should we incorporate in NAME if sorting is done in descending order?
87 (defcustom proced-sorting-schemes-alist
88 (cond ((memq system-type
'(gnu gnu
/linux
)) ; GNU long options
89 '(("%CPU" "--sort" "-pcpu") ; descending order
90 ("%MEM" "--sort" "-pmem") ; descending order
91 ("COMMAND" "--sort" "args")
92 ("PID" "--sort" "pid")
93 ("PGID,PID" "--sort" "pgid,pid")
94 ("PPID,PID" "--sort" "ppid,pid")
95 ("RSS" "--sort" "rss,pid") ; equal RSS's are rare
96 ("STAT,PID" "--sort" "stat,pid")
97 ("START" "--sort" "start_time")
98 ("TIME" "--sort" "cputime")
99 ("TTY,PID" "--sort" "tty,pid")
100 ("UID,PID" "--sort" "uid,pid")
101 ("USER,PID" "--sort" "user,pid")
102 ("VSZ,PID" "--sort" "vsz,pid"))))
103 "Alist of sorting schemes.
104 Each element is a list (NAME OPTION1 OPTION2 ...).
105 NAME denotes the sorting scheme and OPTION1, OPTION2, ... are options
106 defining the sorting scheme."
108 :type
'(repeat (cons (string :tag
"name")
109 (repeat (string :tag
"option")))))
111 (defcustom proced-sorting-scheme nil
112 "Proced sorting type.
113 Must be the car of an element of `proced-sorting-schemes-alist' or nil."
115 :type
`(choice ,@(append '((const nil
)) ; sorting type may be nil
116 (mapcar (lambda (item)
117 (list 'const
(car item
)))
118 proced-sorting-schemes-alist
))))
119 (make-variable-buffer-local 'proced-sorting-scheme
)
121 (defcustom proced-command
(if (zerop (user-real-uid)) "all" "user")
122 "Name of process listing.
123 Must be the car of an element of `proced-command-alist'."
125 :type
'(string :tag
"name"))
126 (make-variable-buffer-local 'proced-command
)
128 (defcustom proced-signal-function
'signal-process
129 "Name of signal function.
130 It can be an elisp function (usually `signal-process') or a string specifying
131 the external command (usually \"kill\")."
133 :type
'(choice (function :tag
"function")
134 (string :tag
"command")))
136 (defcustom proced-signal-list
137 '(("HUP (1. Hangup)")
138 ("INT (2. Terminal interrupt)")
139 ("QUIT (3. Terminal quit)")
140 ("ABRT (6. Process abort)")
141 ("KILL (9. Kill -- cannot be caught or ignored)")
142 ("ALRM (14. Alarm Clock)")
143 ("TERM (15. Termination)"))
144 "List of signals, used for minibuffer completion."
146 :type
'(repeat (string :tag
"signal")))
148 (defvar proced-marker-char ?
* ; the answer is 42
149 "In proced, the current mark character.")
151 ;; face and font-lock code taken from dired
152 (defgroup proced-faces nil
153 "Faces used by Proced."
157 (defface proced-header
158 '((t (:inherit font-lock-type-face
)))
159 "Face used for proced headers."
160 :group
'proced-faces
)
161 (defvar proced-header-face
'proced-header
162 "Face name used for proced headers.")
165 '((t (:inherit font-lock-constant-face
)))
166 "Face used for proced marks."
167 :group
'proced-faces
)
168 (defvar proced-mark-face
'proced-mark
169 "Face name used for proced marks.")
171 (defface proced-marked
172 '((t (:inherit font-lock-warning-face
)))
173 "Face used for marked processes."
174 :group
'proced-faces
)
175 (defvar proced-marked-face
'proced-marked
176 "Face name used for marked processes.")
178 (defvar proced-re-mark
"^[^ \n]"
179 "Regexp matching a marked line.
180 Important: the match ends just after the marker.")
182 (defvar proced-header-regexp
"\\`.*$"
183 "Regexp matching a header line.")
185 (defvar proced-procname-column nil
186 "Proced command column.
187 Initialized based on `proced-procname-column-regexp'.")
188 (make-variable-buffer-local 'proced-procname-column
)
190 (defvar proced-font-lock-keywords
193 ;; Process listing headers.
194 (list proced-header-regexp
'(0 proced-header-face
))
197 (list proced-re-mark
'(0 proced-mark-face
))
200 (list (concat "^[" (char-to-string proced-marker-char
) "]")
201 '(".+" (proced-move-to-procname) nil
(0 proced-marked-face
)))))
203 (defvar proced-mode-map
204 (let ((km (make-sparse-keymap)))
205 (define-key km
" " 'next-line
)
206 (define-key km
"n" 'next-line
)
207 (define-key km
"p" 'previous-line
)
208 (define-key km
"\C-?" 'previous-line
)
209 (define-key km
"h" 'describe-mode
)
210 (define-key km
"?" 'proced-help
)
211 (define-key km
"d" 'proced-mark
) ; Dired compatibility
212 (define-key km
"m" 'proced-mark
)
213 (define-key km
"M" 'proced-mark-all
)
214 (define-key km
"u" 'proced-unmark
)
215 (define-key km
"\177" 'proced-unmark-backward
)
216 (define-key km
"U" 'proced-unmark-all
)
217 (define-key km
"t" 'proced-toggle-marks
)
218 (define-key km
"h" 'proced-hide-processes
)
219 (define-key km
"x" 'proced-send-signal
) ; Dired compatibility
220 (define-key km
"k" 'proced-send-signal
) ; kill processes
221 (define-key km
"l" 'proced-listing-type
)
222 (define-key km
"g" 'revert-buffer
) ; Dired compatibility
223 (define-key km
"q" 'quit-window
)
224 (define-key km
"sc" 'proced-sort-pcpu
)
225 (define-key km
"sm" 'proced-sort-pmem
)
226 (define-key km
"sp" 'proced-sort-pid
)
227 (define-key km
"ss" 'proced-sort-start
)
228 (define-key km
"sS" 'proced-sort
)
229 (define-key km
"st" 'proced-sort-time
)
230 (define-key km
[remap undo
] 'proced-undo
)
231 (define-key km
[remap advertised-undo
] 'proced-undo
)
233 "Keymap for proced commands")
236 proced-menu proced-mode-map
"Proced Menu"
238 ["Mark" proced-mark t
]
239 ["Unmark" proced-unmark t
]
240 ["Mark All" proced-mark-all t
]
241 ["Unmark All" proced-unmark-all t
]
242 ["Toggle Marks" proced-unmark-all t
]
244 ["Sort" proced-sort t
]
245 ["Sort by %CPU" proced-sort-pcpu
(proced-sorting-scheme-p "%CPU")]
246 ["Sort by %MEM" proced-sort-pmem
(proced-sorting-scheme-p "%MEM")]
247 ["Sort by PID" proced-sort-pid
(proced-sorting-scheme-p "PID")]
248 ["Sort by START" proced-sort-start
(proced-sorting-scheme-p "START")]
249 ["Sort by TIME" proced-sort-time
(proced-sorting-scheme-p "TIME")]
251 ["Hide Marked Processes" proced-hide-processes t
]
253 ["Revert" revert-buffer t
]
254 ["Send signal" proced-send-signal t
]
255 ["Change listing" proced-listing-type t
]))
257 (defconst proced-help-string
258 "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)"
259 "Help string for proced.")
261 (defun proced-marker-regexp ()
262 "Return regexp matching `proced-marker-char'."
263 (concat "^" (regexp-quote (char-to-string proced-marker-char
))))
265 (defun proced-success-message (action count
)
266 "Display success message for ACTION performed for COUNT processes."
267 (message "%s %s process%s" action count
(if (= 1 count
) "" "es")))
269 (defun proced-move-to-procname ()
270 "Move to the beginning of the process name on the current line.
271 Return the position of the beginning of the process name, or nil if none found."
273 (if proced-procname-column
274 (forward-char proced-procname-column
)
277 (defsubst proced-skip-regexp
()
278 "Regexp to skip in process listing."
279 (apply 'concat
(make-list (1- (nth 2 (assoc proced-command
280 proced-command-alist
)))
283 (define-derived-mode proced-mode nil
"Proced"
284 "Mode for displaying UNIX system processes and sending signals to them.
285 Type \\[proced-mark-process] to mark a process for later commands.
286 Type \\[proced-send-signal] to send signals to marked processes.
291 (setq buffer-read-only t
293 (set (make-local-variable 'revert-buffer-function
) 'proced-revert
)
294 (set (make-local-variable 'font-lock-defaults
)
295 '(proced-font-lock-keywords t nil nil beginning-of-line
)))
297 ;; Proced mode is suitable only for specially formatted data.
298 (put 'proced-mode
'mode-class
'special
)
301 (defun proced (&optional arg
)
302 "Mode for displaying UNIX system processes and sending signals to them.
303 Type \\[proced-mark-process] to mark a process for later commands.
304 Type \\[proced-send-signal] to send signals to marked processes.
306 If invoked with optional ARG the window displaying the process
307 information will be displayed but not selected.
311 (let ((buffer (get-buffer-create "*Process Info*")) new
)
313 (setq new
(zerop (buffer-size)))
314 (if new
(proced-mode))
320 (display-buffer buffer
)
321 (pop-to-buffer buffer
)
322 (message (substitute-command-keys
323 "type \\[quit-window] to quit, \\[proced-help] for help")))))
325 (defun proced-mark (&optional count
)
326 "Mark the current (or next COUNT) processes."
328 (proced-do-mark t count
))
330 (defun proced-unmark (&optional count
)
331 "Unmark the current (or next COUNT) processes."
333 (proced-do-mark nil count
))
335 (defun proced-unmark-backward (&optional count
)
336 "Unmark the previous (or COUNT previous) processes."
337 ;; Analogous to `dired-unmark-backward',
338 ;; but `ibuffer-unmark-backward' behaves different.
340 (proced-do-mark nil
(- (or count
1))))
342 (defun proced-do-mark (mark &optional count
)
343 "Mark the current (or next ARG) processes using MARK."
344 (or count
(setq count
1))
345 (let ((backward (< count
0))
346 (line (line-number-at-pos))
348 ;; do nothing in the first line
350 (setq count
(1+ (if (<= 0 count
) count
351 (min (- line
2) (abs count
)))))
353 (while (not (or (zerop (setq count
(1- count
))) (eobp)))
354 (proced-insert-mark mark backward
))
355 (proced-move-to-procname))))
357 (defun proced-mark-all ()
358 "Mark all processes."
360 (proced-do-mark-all t
))
362 (defun proced-unmark-all ()
363 "Unmark all processes."
365 (proced-do-mark-all nil
))
367 (defun proced-do-mark-all (mark)
368 "Mark all processes using MARK."
369 (let (buffer-read-only)
373 (proced-insert-mark mark
)))))
375 (defun proced-toggle-marks ()
376 "Toggle marks: marked processes become unmarked, and vice versa."
378 (let ((mark-re (proced-marker-regexp))
383 (cond ((looking-at mark-re
)
384 (proced-insert-mark nil
))
386 (proced-insert-mark t
))
388 (forward-line 1)))))))
390 (defun proced-insert-mark (mark &optional backward
)
391 "If MARK is non-nil, insert `proced-marker-char'.
392 If BACKWARD is non-nil, move one line backwards before inserting the mark.
393 Otherwise move one line forward after inserting the mark."
394 (if backward
(forward-line -
1))
395 (insert (if mark proced-marker-char ?\s
))
397 (unless backward
(forward-line)))
399 ;; Mostly analog of `dired-do-kill-lines'.
400 ;; However, for negative args the target lines of `dired-do-kill-lines'
401 ;; include the current line, whereas `dired-mark' for negative args operates
402 ;; on the preceding lines. Here we are consistent with `dired-mark'.
403 (defun proced-hide-processes (&optional arg quiet
)
404 "Hide marked processes.
405 With prefix ARG, hide that many lines starting with the current line.
406 \(A negative argument hides backward.)
407 If QUIET is non-nil suppress status message.
408 Returns count of hidden lines."
410 (let ((mark-re (proced-marker-regexp))
415 ;; Hide ARG lines starting with the current line.
416 (let ((line (line-number-at-pos)))
417 ;; do nothing in the first line
419 (delete-region (line-beginning-position)
422 (setq count
(- arg
(forward-line arg
)))
423 (setq count
(min (- line
2) (abs arg
)))
424 (forward-line (- count
)))
428 (while (and (not (eobp))
429 (re-search-forward mark-re nil t
))
430 (delete-region (match-beginning 0)
431 (save-excursion (forward-line) (point)))
432 (setq count
(1+ count
)))))
433 (unless (zerop count
) (proced-move-to-procname))
435 (proced-success-message "Hid" count
))
438 (defun proced-listing-type (command)
439 "Select `proced' listing type COMMAND from `proced-command-alist'."
441 (list (completing-read "Listing type: " proced-command-alist nil t
)))
442 (setq proced-command command
)
445 (defun proced-update (&optional quiet
)
446 "Update the `proced' process information. Preserves point and marks."
447 ;; This is the main function that generates and updates the process listing.
449 (or quiet
(message "Updating process information..."))
450 (let* ((command (cadr (assoc proced-command proced-command-alist
)))
451 (regexp (concat (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\)"))
452 (old-pos (if (save-excursion
454 (looking-at (concat "^[* ]" regexp
)))
455 (cons (match-string-no-properties 1)
457 buffer-read-only plist
)
458 (goto-char (point-min))
459 ;; remember marked processes (whatever the mark was)
460 (while (re-search-forward (concat "^\\(\\S-\\)" regexp
) nil t
)
461 (push (cons (match-string-no-properties 2)
462 (match-string-no-properties 1)) plist
))
463 ;; generate new listing
465 (apply 'call-process
(car command
) nil t nil
466 (append (cdr command
) (cdr (assoc proced-sorting-scheme
467 proced-sorting-schemes-alist
))))
468 (goto-char (point-min))
472 ;; (delete-trailing-whitespace)
473 (goto-char (point-min))
474 (while (re-search-forward "[ \t\r]+$" nil t
)
475 (delete-region (match-beginning 0) (match-end 0)))
476 (set-buffer-modified-p nil
)
477 ;; set `proced-procname-column'
478 (goto-char (point-min))
479 (and proced-procname-column-regexp
480 (re-search-forward proced-procname-column-regexp nil t
)
481 (setq proced-procname-column
(1- (match-beginning 0))))
482 ;; restore process marks
487 (while (re-search-forward (concat "^" regexp
) nil t
)
488 (if (setq mark
(assoc (match-string-no-properties 1) plist
))
492 (delete-char 1)))))))
493 ;; restore buffer position (if possible)
497 (concat "^[* ]" (proced-skip-regexp) "\\s-+" (car old-pos
) "\\>")
501 (forward-char (cdr old-pos
)))
502 (proced-move-to-procname))
504 (setq mode-name
(if proced-sorting-scheme
505 (concat "Proced by " proced-sorting-scheme
)
507 (force-mode-line-update)
509 (or quiet
(input-pending-p)
510 (message "Updating process information...done."))))
512 (defun proced-revert (&rest args
)
513 "Analog of `revert-buffer'."
516 ;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer'
517 ;; and move it to simple.el so that proced and ibuffer can easily use it, too?
518 (autoload 'dired-pop-to-buffer
"dired")
520 (defun proced-send-signal (&optional signal
)
521 "Send a SIGNAL to the marked processes.
522 SIGNAL may be a string (HUP, INT, TERM, etc.) or a number.
523 If SIGNAL is nil display marked processes and query interactively for SIGNAL."
525 (let ((regexp (concat (proced-marker-regexp)
526 (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$"))
528 ;; collect marked processes
530 (goto-char (point-min))
531 (while (re-search-forward regexp nil t
)
532 (push (cons (match-string-no-properties 1)
533 ;; How much info should we collect here? Would it be
534 ;; better to collect only the PID (to avoid ambiguities)
535 ;; and the command name?
536 (substring (match-string-no-properties 0) 2))
538 (setq plist
(nreverse plist
))
540 (message "No processes marked")
542 ;; Display marked processes (code taken from `dired-mark-pop-up').
543 (let ((bufname " *Marked Processes*")
544 (header (save-excursion
545 (goto-char (+ 2 (point-min)))
546 (buffer-substring-no-properties
547 (point) (line-end-position)))))
548 (with-current-buffer (get-buffer-create bufname
)
549 (setq truncate-lines t
)
553 (insert (cdr proc
) "\n"))
554 (save-window-excursion
555 (dired-pop-to-buffer bufname
) ; all we need
556 (let* ((completion-ignore-case t
)
557 (pnum (if (= 1 (length plist
))
559 (format "%d processes" (length plist
))))
560 ;; The following is an ugly hack. Is there a better way
561 ;; to help people like me to remember the signals and
563 (tmp (completing-read (concat "Send signal [" pnum
564 "] (default TERM): ")
566 nil nil nil nil
"TERM")))
567 (setq signal
(if (string-match "^\\(\\S-+\\)\\s-" tmp
)
568 (match-string 1 tmp
) tmp
))))))
572 (if (functionp proced-signal-function
)
573 ;; use built-in `signal-process'
574 (let ((signal (if (stringp signal
)
575 (if (string-match "\\`[0-9]+\\'" signal
)
576 (string-to-number signal
)
577 (make-symbol signal
))
579 (dolist (process plist
)
581 proced-signal-function
582 (string-to-number (car process
)) signal
))
583 (setq count
(1+ count
))
584 (push (cdr process
) err-list
))))
585 ;; use external system call
586 (let ((signal (concat "-" (if (numberp signal
)
587 (number-to-string signal
) signal
))))
588 (dolist (process plist
)
589 (if (zerop (call-process
590 proced-signal-function nil
0 nil
591 signal
(car process
)))
592 (setq count
(1+ count
))
593 (push (cdr process
) err-list
)))))
595 ;; FIXME: that's not enough to display the errors.
596 (message "%s: %s" signal err-list
)
597 (proced-success-message "Sent signal to" count
)))
599 (run-hooks 'proced-after-send-signal-hook
)))))
601 (defun proced-help ()
602 "Provide help for the `proced' user."
604 (if (eq last-command
'proced-help
)
606 (message proced-help-string
)))
608 (defun proced-undo ()
609 "Undo in a proced buffer.
610 This doesn't recover killed processes, it just undoes changes in the proced
611 buffer. You can use it to recover marks."
613 (let (buffer-read-only)
615 (message "Change in proced buffer undone.
616 Killed processes cannot be recovered by Emacs."))
619 (defun proced-sort (scheme)
620 "Sort Proced buffer using SCHEME.
621 When called interactively, an empty string means nil, i.e., no sorting."
623 (list (let* ((completion-ignore-case t
)
624 (scheme (completing-read "Sorting type: "
625 proced-sorting-schemes-alist nil t
)))
626 (if (string= "" scheme
) nil scheme
))))
627 (if (proced-sorting-scheme-p scheme
)
629 (setq proced-sorting-scheme scheme
)
631 (error "Proced sorting scheme %s undefined" scheme
)))
633 (defun proced-sorting-scheme-p (scheme)
634 "Return non-nil if SCHEME is an applicable sorting scheme.
635 SCHEME must be a string or nil."
637 (assoc scheme proced-sorting-schemes-alist
)))
639 (defun proced-sort-pcpu ()
640 "Sort Proced buffer by percentage CPU time (%CPU)."
642 (proced-sort "%CPU"))
644 (defun proced-sort-pmem ()
645 "Sort Proced buffer by percentage memory usage (%MEM)."
647 (proced-sort "%MEM"))
649 (defun proced-sort-pid ()
650 "Sort Proced buffer by PID."
654 (defun proced-sort-start ()
655 "Sort Proced buffer by time the command started (START)."
657 (proced-sort "START"))
659 (defun proced-sort-time ()
660 "Sort Proced buffer by cumulative CPU time (TIME)."
662 (proced-sort "TIME"))
666 ;; arch-tag: a6e312ad-9032-45aa-972d-31a8cfc545af
667 ;;; proced.el ends here.