;;; proced.el --- operate on system processes like dired
-;; Copyright (C) 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
;; Keywords: Processes, Unix
;; - allow "sudo kill PID", "renice PID"
;;
;; Thoughts and Ideas
-;; - Currently, `system-process-attributes' returns the list of
+;; - Currently, `process-attributes' returns the list of
;; command-line arguments of a process as one concatenated string.
;; This format is compatible with `shell-command'. Also, under
;; MS-Windows, the command-line arguments are actually stored as a
;; single string, so that it is impossible to reverse-engineer it back
-;; into separate arguments. Alternatively, `system-process-attributes'
+;; into separate arguments. Alternatively, `process-attributes'
;; could (try to) return a list of strings that correspond to individual
;; command-line arguments. Then one could feed such a list of
;; command-line arguments into `call-process' or `start-process'.
(defcustom proced-signal-list
'( ;; signals supported on all POSIX compliant systems
- ("HUP (1. Hangup)")
- ("INT (2. Terminal interrupt)")
- ("QUIT (3. Terminal quit)")
- ("ABRT (6. Process abort)")
- ("KILL (9. Kill - cannot be caught or ignored)")
- ("ALRM (14. Alarm Clock)")
- ("TERM (15. Termination)")
+ ("HUP" . " (1. Hangup)")
+ ("INT" . " (2. Terminal interrupt)")
+ ("QUIT" . " (3. Terminal quit)")
+ ("ABRT" . " (6. Process abort)")
+ ("KILL" . " (9. Kill - cannot be caught or ignored)")
+ ("ALRM" . " (14. Alarm Clock)")
+ ("TERM" . " (15. Termination)")
;; POSIX 1003.1-2001
;; Which systems do not support these signals so that we can
;; exclude them from `proced-signal-list'?
- ("CONT (Continue executing)")
- ("STOP (Stop executing / pause - cannot be caught or ignored)")
- ("TSTP (Terminal stop / pause)"))
+ ("CONT" . " (Continue executing)")
+ ("STOP" . " (Stop executing / pause - cannot be caught or ignored)")
+ ("TSTP" . " (Terminal stop / pause)"))
"List of signals, used for minibuffer completion."
:group 'proced
- :type '(repeat (string :tag "signal")))
+ :type '(repeat (cons (string :tag "signal name")
+ (string :tag "description"))))
;; For which attributes can we use a fixed width of the output field?
;; A fixed width speeds up formatting, yet it can make
;; It would be neat if one could temporarily override the following
;; predefined rules.
(defcustom proced-grammar-alist
- '( ;; attributes defined in `system-process-attributes'
+ '( ;; attributes defined in `process-attributes'
(euid "EUID" "%d" right proced-< nil (euid pid) (nil t nil))
- (user "USER" nil left proced-string-lessp nil (user pid) (nil t nil))
+ (user "User" nil left proced-string-lessp nil (user pid) (nil t nil))
(egid "EGID" "%d" right proced-< nil (egid euid pid) (nil t nil))
- (group "GROUP" nil left proced-string-lessp nil (group user pid) (nil t nil))
- (comm "COMMAND" nil left proced-string-lessp nil (comm pid) (nil t nil))
- (state "STAT" nil left proced-string-lessp nil (state pid) (nil t nil))
+ (group "Group" nil left proced-string-lessp nil (group user pid) (nil t nil))
+ (comm "Command" nil left proced-string-lessp nil (comm pid) (nil t nil))
+ (state "Stat" nil left proced-string-lessp nil (state pid) (nil t nil))
(ppid "PPID" "%d" right proced-< nil (ppid pid)
((lambda (ppid) (proced-filter-parents proced-process-alist ppid))
"refine to process parents"))
- (pgrp "PGRP" "%d" right proced-< nil (pgrp euid pid) (nil t nil))
- (sess "SESS" "%d" right proced-< nil (sess pid) (nil t nil))
+ (pgrp "PGrp" "%d" right proced-< nil (pgrp euid pid) (nil t nil))
+ (sess "Sess" "%d" right proced-< nil (sess pid) (nil t nil))
(ttname "TTY" proced-format-ttname left proced-string-lessp nil (ttname pid) (nil t nil))
(tpgid "TPGID" "%d" right proced-< nil (tpgid pid) (nil t nil))
- (minflt "MINFLT" "%d" right proced-< nil (minflt pid) (nil t t))
- (majflt "MAJFLT" "%d" right proced-< nil (majflt pid) (nil t t))
- (cminflt "CMINFLT" "%d" right proced-< nil (cminflt pid) (nil t t))
- (cmajflt "CMAJFLT" "%d" right proced-< nil (cmajflt pid) (nil t t))
- (utime "UTIME" proced-format-time right proced-time-lessp t (utime pid) (nil t t))
- (stime "STIME" proced-format-time right proced-time-lessp t (stime pid) (nil t t))
- (time "TIME" proced-format-time right proced-time-lessp t (time pid) (nil t t))
- (cutime "CUTIME" proced-format-time right proced-time-lessp t (cutime pid) (nil t t))
- (cstime "CSTIME" proced-format-time right proced-time-lessp t (cstime pid) (nil t t))
- (ctime "CTIME" proced-format-time right proced-time-lessp t (ctime pid) (nil t t))
- (pri "PR" "%d" right proced-< t (pri pid) (nil t t))
- (nice "NI" "%3d" 3 proced-< t (nice pid) (t t nil))
- (thcount "THCOUNT" "%d" right proced-< t (thcount pid) (nil t t))
- (start "START" proced-format-start 6 proced-time-lessp nil (start pid) (t t nil))
- (vsize "VSIZE" "%d" right proced-< t (vsize pid) (nil t t))
+ (minflt "MinFlt" "%d" right proced-< nil (minflt pid) (nil t t))
+ (majflt "MajFlt" "%d" right proced-< nil (majflt pid) (nil t t))
+ (cminflt "CMinFlt" "%d" right proced-< nil (cminflt pid) (nil t t))
+ (cmajflt "CMajFlt" "%d" right proced-< nil (cmajflt pid) (nil t t))
+ (utime "UTime" proced-format-time right proced-time-lessp t (utime pid) (nil t t))
+ (stime "STime" proced-format-time right proced-time-lessp t (stime pid) (nil t t))
+ (time "Time" proced-format-time right proced-time-lessp t (time pid) (nil t t))
+ (cutime "CUTime" proced-format-time right proced-time-lessp t (cutime pid) (nil t t))
+ (cstime "CSTime" proced-format-time right proced-time-lessp t (cstime pid) (nil t t))
+ (ctime "CTime" proced-format-time right proced-time-lessp t (ctime pid) (nil t t))
+ (pri "Pr" "%d" right proced-< t (pri pid) (nil t t))
+ (nice "Ni" "%3d" 3 proced-< t (nice pid) (t t nil))
+ (thcount "THCount" "%d" right proced-< t (thcount pid) (nil t t))
+ (start "Start" proced-format-start 6 proced-time-lessp nil (start pid) (t t nil))
+ (vsize "VSize" "%d" right proced-< t (vsize pid) (nil t t))
(rss "RSS" "%d" right proced-< t (rss pid) (nil t t))
- (etime "ETIME" proced-format-time right proced-time-lessp t (etime pid) (nil t t))
+ (etime "ETime" proced-format-time right proced-time-lessp t (etime pid) (nil t t))
(pcpu "%CPU" "%.1f" right proced-< t (pcpu pid) (nil t t))
- (pmem "%MEM" "%.1f" right proced-< t (pmem pid) (nil t t))
- (args "ARGS" proced-format-args left proced-string-lessp nil (args pid) (nil t nil))
+ (pmem "%Mem" "%.1f" right proced-< t (pmem pid) (nil t t))
+ (args "Args" proced-format-args left proced-string-lessp nil (args pid) (nil t nil))
;;
;; attributes defined by proced (see `proced-process-attributes')
(pid "PID" "%d" right proced-< nil (pid)
((lambda (ppid) (proced-filter-children proced-process-alist ppid))
"refine to process children"))
;; process tree
- (tree "TREE" proced-format-tree left nil nil nil nil))
+ (tree "Tree" proced-format-tree left nil nil nil nil))
"Alist of rules for handling Proced attributes.
Each element has the form
This variable extends the functionality of `proced-process-attributes'.
Each function is called with one argument, the list of attributes
of a system process. It returns a cons cell of the form (KEY . VALUE)
-like `system-process-attributes'. This cons cell is appended to the list
+like `process-attributes'. This cons cell is appended to the list
returned by `proced-process-attributes'.
If the function returns nil, the value is ignored."
:group 'proced
;; FIXME: is there a better name for filter `user' that does not coincide
;; with an attribute key?
(defcustom proced-filter-alist
- `((user (user . ,(concat "\\`" (user-real-login-name) "\\'")))
- (user-running (user . ,(concat "\\`" (user-real-login-name) "\\'"))
+ `((user (user . ,(concat "\\`" (regexp-quote (user-real-login-name)) "\\'")))
+ (user-running (user . ,(concat "\\`" (regexp-quote (user-real-login-name)) "\\'"))
(state . "\\`[Rr]\\'"))
(all)
(all-running (state . "\\`[Rr]\\'"))
:group 'proced
:type '(choice (symbol :tag "Sort Scheme")
(repeat :tag "Key List" (symbol :tag "Key"))))
-(make-variable-buffer-local 'proced-format)
+(make-variable-buffer-local 'proced-sort)
(defcustom proced-descend t
"Non-nil if proced listing is sorted in descending order."
:options '(fit-window-to-buffer)
:group 'proced)
+(defcustom proced-after-send-signal-hook nil
+ "Normal hook run after sending a signal to processes by `proced-send-signal'.
+May be used to revert the process listing."
+ :type 'hook
+ :options '(proced-revert)
+ :group 'proced)
+
;; Internal variables
(defvar proced-available (not (null (list-system-processes)))
;; marking
(define-key km "d" 'proced-mark) ; Dired compatibility ("delete")
(define-key km "m" 'proced-mark)
+ (put 'proced-mark :advertised-binding "m")
(define-key km "u" 'proced-unmark)
(define-key km "\177" 'proced-unmark-backward)
(define-key km "M" 'proced-mark-all)
(defun proced-header-line ()
"Return header line for Proced buffer."
(list (propertize " " 'display '(space :align-to 0))
- (replace-regexp-in-string ;; preserve text properties
- "\\(%\\)" "\\1\\1" (substring proced-header-line (window-hscroll)))))
+ (if (<= (window-hscroll) (length proced-header-line))
+ (replace-regexp-in-string ;; preserve text properties
+ "\\(%\\)" "\\1\\1"
+ (substring proced-header-line (window-hscroll))))))
(defun proced-pid-at-point ()
"Return pid of system process at point.
;; proced mode
(define-derived-mode proced-mode special-mode "Proced"
- "Mode for displaying UNIX system processes and sending signals to them.
+ "Mode for displaying system processes and sending signals to them.
Type \\[proced] to start a Proced session. In a Proced buffer
type \\<proced-mode-map>\\[proced-mark] to mark a process for later commands.
Type \\[proced-send-signal] to send signals to marked processes.
(progn
(display-buffer buffer)
(with-current-buffer buffer
- (run-hooks 'proced-post-display-hook)))
+ (proced-update t)))
(pop-to-buffer buffer)
- (run-hooks 'proced-post-display-hook)
+ (proced-update t)
(message
(substitute-command-keys
"Type \\<proced-mode-map>\\[quit-window] to quit, \\[proced-help] for help")))))
;; lists are ignored? When would such processes be of interest?
(let (process-alist attributes attr)
(dolist (pid (or pid-list (list-system-processes)) process-alist)
- (when (setq attributes (system-process-attributes pid))
+ (when (setq attributes (process-attributes pid))
(setq attributes (cons (cons 'pid pid) attributes))
(dolist (fun proced-custom-attributes)
(if (setq attr (funcall fun attributes))
(line-end-position))))))
(unless signal
;; Display marked processes (code taken from `dired-mark-pop-up').
- (let ((bufname " *Marked Processes*")
+ (let ((bufname " *Marked Processes*") ; use leading space in buffer name
+ ; to make this buffer ephemeral
(header-line (substring-no-properties proced-header-line)))
(with-current-buffer (get-buffer-create bufname)
(setq truncate-lines t
proced-header-line header-line ; inherit header line
header-line-format '(:eval (proced-header-line)))
(add-hook 'post-command-hook 'force-mode-line-update nil t)
- (erase-buffer)
- (dolist (process process-alist)
- (insert " " (cdr process) "\n"))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (setq buffer-read-only t)
+ (dolist (process process-alist)
+ (insert " " (cdr process) "\n")))
(save-window-excursion
- (pop-to-buffer (current-buffer))
+ ;; Analogous to `dired-pop-to-buffer'
+ ;; Don't split window horizontally. (Bug#1806)
+ (let (split-width-threshold)
+ (pop-to-buffer (current-buffer)))
(fit-window-to-buffer (get-buffer-window) nil 1)
(let* ((completion-ignore-case t)
(pnum (if (= 1 (length process-alist))
"1 process"
(format "%d processes" (length process-alist))))
- ;; The following is an ugly hack. Is there a better way
- ;; to help people like me to remember the signals and
- ;; their meanings?
- (tmp (completing-read (concat "Send signal [" pnum
- "] (default TERM): ")
- proced-signal-list
- nil nil nil nil "TERM")))
- (setq signal (if (string-match "^\\(\\S-+\\)\\s-" tmp)
- (match-string 1 tmp) tmp))))))
- ;; send signal
- (let ((count 0)
- failures)
- ;; Why not always use `signal-process'? See
- ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html
- (if (functionp proced-signal-function)
- ;; use built-in `signal-process'
- (let ((signal (if (stringp signal)
- (if (string-match "\\`[0-9]+\\'" signal)
- (string-to-number signal)
- (make-symbol signal))
- signal))) ; number
- (dolist (process process-alist)
- (condition-case err
- (if (zerop (funcall
- proced-signal-function (car process) signal))
- (setq count (1+ count))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures))
- (error ; catch errors from failed signals
- (proced-log "%s\n" err)
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures)))))
- ;; use external system call
- (let ((signal (concat "-" (if (numberp signal)
- (number-to-string signal) signal))))
+ (completion-annotate-function
+ (lambda (s) (cdr (assoc s proced-signal-list)))))
+ (setq signal
+ (completing-read (concat "Send signal [" pnum
+ "] (default TERM): ")
+ proced-signal-list
+ nil nil nil nil "TERM")))))))
+ ;; send signal
+ (let ((count 0)
+ failures)
+ ;; Why not always use `signal-process'? See
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html
+ (if (functionp proced-signal-function)
+ ;; use built-in `signal-process'
+ (let ((signal (if (stringp signal)
+ (if (string-match "\\`[0-9]+\\'" signal)
+ (string-to-number signal)
+ (make-symbol signal))
+ signal))) ; number
(dolist (process process-alist)
- (with-temp-buffer
- (condition-case err
- (if (zerop (call-process
- proced-signal-function nil t nil
- signal (number-to-string (car process))))
- (setq count (1+ count))
- (proced-log (current-buffer))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures))
- (error ; catch errors from failed signals
- (proced-log (current-buffer))
- (proced-log "%s\n" (cdr process))
- (push (cdr process) failures)))))))
- (if failures
- ;; Proced error message are not always very precise.
- ;; Can we issue a useful one-line summary in the
- ;; message area (using FAILURES) if only one signal failed?
- (proced-log-summary
- signal
- (format "%d of %d signal%s failed"
- (length failures) (length process-alist)
- (if (= 1 (length process-alist)) "" "s")))
- (proced-success-message "Sent signal to" count)))
- ;; final clean-up
- (run-hooks 'proced-after-send-signal-hook))))
+ (condition-case err
+ (if (zerop (funcall
+ proced-signal-function (car process) signal))
+ (setq count (1+ count))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed signals
+ (proced-log "%s\n" err)
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))
+ ;; use external system call
+ (let ((signal (concat "-" (if (numberp signal)
+ (number-to-string signal) signal))))
+ (dolist (process process-alist)
+ (with-temp-buffer
+ (condition-case err
+ (if (zerop (call-process
+ proced-signal-function nil t nil
+ signal (number-to-string (car process))))
+ (setq count (1+ count))
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed signals
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))))
+ (if failures
+ ;; Proced error message are not always very precise.
+ ;; Can we issue a useful one-line summary in the
+ ;; message area (using FAILURES) if only one signal failed?
+ (proced-log-summary
+ signal
+ (format "%d of %d signal%s failed"
+ (length failures) (length process-alist)
+ (if (= 1 (length process-alist)) "" "s")))
+ (proced-success-message "Sent signal to" count)))
+ ;; final clean-up
+ (run-hooks 'proced-after-send-signal-hook)))
;; similar to `dired-why'
(defun proced-why ()
(message "Change in Proced buffer undone.
Killed processes cannot be recovered by Emacs."))
+(defun proced-unload-function ()
+ "Unload the Proced library."
+ (save-current-buffer
+ (dolist (buf (buffer-list))
+ (set-buffer buf)
+ (when (eq major-mode 'proced-mode)
+ (funcall (or (default-value 'major-mode) 'fundamental-mode)))))
+ ;; continue standard unloading
+ nil)
+
(provide 'proced)
;; arch-tag: a6e312ad-9032-45aa-972d-31a8cfc545af
HCoop / bpt / emacs.git / blobdiff