;;; proced.el --- operate on system processes like dired
-;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;; Author: Roland Winkler <winkler@gnu.org>
;; Keywords: Processes, Unix
;; listed. See `proced-mode' for getting started.
;;
;; To do:
-;; - interactive temporary customizability of flags in `proced-grammar-alist'
-;; - allow "sudo kill PID", "renice PID"
+;; - Interactive temporary customizability of flags in `proced-grammar-alist'
+;; - Allow "sudo kill PID", "sudo renice PID"
+;; `proced-send-signal' operates on multiple processes one by one.
+;; With "sudo" we want to execute one "kill" or "renice" command
+;; for all marked processes. Is there a `sudo-call-process'?
;;
;; Thoughts and Ideas
;; - Currently, `process-attributes' returns the list of
;;; Code:
-(require 'time-date) ; for `with-decoded-time-value'
-
(defgroup proced nil
"Proced mode."
:group 'processes
:type '(choice (function :tag "function")
(string :tag "command")))
+(defcustom proced-renice-command "renice"
+ "Name of renice command."
+ :group 'proced
+ :version "24.3"
+ :type '(string :tag "command"))
+
(defcustom proced-signal-list
'( ;; signals supported on all POSIX compliant systems
("HUP" . " (1. Hangup)")
If JUSTIFY is an integer, its modulus gives the width of the attribute
values formatted with FORMAT. If JUSTIFY is positive, NAME appears
-right-justified, otherwise it appears left-justified. If JUSTIFY is 'left
-or 'right, the field width is calculated from all field values in the listing.
-If JUSTIFY is 'left, the field values are formatted left-justified and
+right-justified, otherwise it appears left-justified. If JUSTIFY is `left'
+or `right', the field width is calculated from all field values in the listing.
+If JUSTIFY is `left', the field values are formatted left-justified and
right-justified otherwise.
PREDICATE is the predicate for sorting and filtering the process listing
based on attribute KEY. PREDICATE takes two arguments P1 and P2,
the corresponding attribute values of two processes. PREDICATE should
-return 'equal if P1 has same rank like P2. Any other non-nil value says
+return `equal' if P1 has same rank like P2. Any other non-nil value says
that P1 is \"less than\" P2, or nil if not.
If PREDICATE is nil the attribute cannot be sorted.
for sorting the process listing. KEY1, KEY2, ... are KEYs appearing as cars
of `proced-grammar-alist'. First the PREDICATE of KEY1 is evaluated.
If it yields non-equal, it defines the sort order for the corresponding
-processes. If it evaluates to 'equal the PREDICATE of KEY2 is evaluated, etc.
+processes. If it evaluates to `equal' the PREDICATE of KEY2 is evaluated, etc.
REFINER can be a list of flags (LESS-B EQUAL-B LARGER-B) used by the command
`proced-refine' (see there) to refine the listing based on attribute KEY.
the value of attribute KEY of the process at the position of point
using PREDICATE.
If PREDICATE yields non-nil, the process is accepted if LESS-B is non-nil.
-If PREDICATE yields 'equal, the process is accepted if EQUAL-B is non-nil.
+If PREDICATE yields `equal', the process is accepted if EQUAL-B is non-nil.
If PREDICATE yields nil, the process is accepted if LARGER-B is non-nil.
REFINER can also be a list (FUNCTION HELP-ECHO).
(define-key km "\C-n" 'next-line)
(define-key km "\C-p" 'previous-line)
(define-key km "\C-?" 'previous-line)
+ (define-key km [?\S-\ ] 'previous-line)
(define-key km [down] 'next-line)
(define-key km [up] 'previous-line)
;; marking
(define-key km "o" 'proced-omit-processes)
(define-key km "x" 'proced-send-signal) ; Dired compatibility
(define-key km "k" 'proced-send-signal) ; kill processes
+ (define-key km "r" 'proced-renice) ; renice processes
;; misc
(define-key km "h" 'describe-mode)
(define-key km "?" 'proced-help)
:style toggle
:selected (eval proced-auto-update-flag)
:help "Auto Update of Proced Buffer"]
+ "--"
["Send signal" proced-send-signal
- :help "Send Signal to Marked Processes"]))
+ :help "Send Signal to Marked Processes"]
+ ["Renice" proced-renice
+ :help "Renice Marked Processes"]))
;; helper functions
(defun proced-marker-regexp ()
;;;###autoload
(defun proced (&optional arg)
"Generate a listing of UNIX system processes.
-If invoked with optional ARG the window displaying the process
-information will be displayed but not selected.
-Runs the normal hook `proced-post-display-hook'.
+\\<proced-mode-map>
+If invoked with optional ARG, do not select the window displaying
+the process information.
-See `proced-mode' for a description of features available in Proced buffers."
+This function runs the normal hook `proced-post-display-hook'.
+
+See `proced-mode' for a description of features available in
+Proced buffers."
(interactive "P")
(unless proced-available
(error "Proced is not available on this system"))
(defun proced-time-lessp (t1 t2)
"Return t if time value T1 is less than time value T2.
Return `equal' if T1 equals T2. Return nil otherwise."
- (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1)
- (high2 low2 micro2 pico2 type2 t2))
- (cond ((< high1 high2))
- ((< high2 high1) nil)
- ((< low1 low2))
- ((< low2 low1) nil)
- ((< micro1 micro2))
- ((< micro2 micro1) nil)
- ((< pico1 pico2))
- ((< pico2 pico1) nil)
- (t 'equal))))
+ (or (time-less-p t1 t2)
+ (if (not (time-less-p t2 t1)) 'equal)))
;;; Sorting
Prefix ARG controls sort order:
- If prefix ARG is positive (negative), sort in ascending (descending) order.
-- If ARG is nil or 'no-arg and SCHEME is equal to the previous sorting scheme,
+- If ARG is nil or `no-arg' and SCHEME is equal to the previous sorting scheme,
reverse the sorting order.
-- If ARG is nil or 'no-arg and SCHEME differs from the previous sorting scheme,
+- If ARG is nil or `no-arg' and SCHEME differs from the previous sorting scheme,
adopt the sorting order defined for SCHEME in `proced-grammar-alist'.
Set variable `proced-sort' to SCHEME. The current sort scheme is displayed
Preserves point and marks."
(proced-update t))
-(defun proced-send-signal (&optional signal)
- "Send a SIGNAL to the marked processes.
-If no process is marked, operate on current process.
-SIGNAL may be a string (HUP, INT, TERM, etc.) or a number.
-If SIGNAL is nil display marked processes and query interactively for SIGNAL.
-After sending the signal, this command runs the normal hook
-`proced-after-send-signal-hook'."
- (interactive)
+(defun proced-marked-processes ()
+ "Return marked processes as alist of PIDs.
+If no process is marked return alist with the PID of the process point is on.
+The cdrs of the alist are the text strings displayed by Proced for these
+processes. They are used for error messages."
(let ((regexp (proced-marker-regexp))
process-alist)
;; collect marked processes
(+ 2 (line-beginning-position))
(line-end-position)))
process-alist)))
- (setq process-alist
- (if process-alist
- (nreverse process-alist)
- ;; take current process
- (list (cons (proced-pid-at-point)
+ (if process-alist
+ (nreverse process-alist)
+ ;; take current process
+ (let ((pid (proced-pid-at-point)))
+ (if pid
+ (list (cons pid
(buffer-substring-no-properties
(+ 2 (line-beginning-position))
- (line-end-position))))))
+ (line-end-position)))))))))
+
+(defmacro proced-with-processes-buffer (process-alist &rest body)
+ "Execute the forms in BODY in a temporary buffer displaying PROCESS-ALIST.
+PROCESS-ALIST is an alist of process PIDs as in `proced-process-alist'.
+The value returned is the value of the last form in BODY."
+ (declare (indent 1) (debug t))
+ ;; Use leading space in buffer name to make this buffer ephemeral
+ `(let ((bufname " *Marked Processes*")
+ (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)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (setq buffer-read-only t)
+ (dolist (process ,process-alist)
+ (insert " " (cdr process) "\n"))
+ (delete-char -1)
+ (goto-char (point-min)))
+ (save-window-excursion
+ ;; 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)
+ ,@body))))
+
+(defun proced-send-signal (&optional signal process-alist)
+ "Send a SIGNAL to processes in PROCESS-ALIST.
+PROCESS-ALIST is an alist as returned by `proced-marked-processes'.
+Interactively, PROCESS-ALIST contains the marked processes.
+If no process is marked, it contains the process point is on,
+SIGNAL may be a string (HUP, INT, TERM, etc.) or a number.
+After sending SIGNAL to all processes in PROCESS-ALIST, this command
+runs the normal hook `proced-after-send-signal-hook'.
+
+For backward compatibility SIGNAL and PROCESS-ALIST may be nil.
+Then PROCESS-ALIST contains the marked processes or the process point is on
+and SIGNAL is queried interactively. This noninteractive usage is still
+supported but discouraged. It will be removed in a future version of Emacs."
+ (interactive
+ (let* ((process-alist (proced-marked-processes))
+ (pnum (if (= 1 (length process-alist))
+ "1 process"
+ (format "%d processes" (length process-alist))))
+ (completion-ignore-case t)
+ (completion-extra-properties
+ '(:annotation-function
+ (lambda (s) (cdr (assoc s proced-signal-list))))))
+ (proced-with-processes-buffer process-alist
+ (list (completing-read (concat "Send signal [" pnum
+ "] (default TERM): ")
+ proced-signal-list
+ nil nil nil nil "TERM")
+ process-alist))))
+
+ (unless (and signal process-alist)
+ ;; Discouraged usage (supported for backward compatibility):
+ ;; The new calling sequence separates more cleanly between the parts
+ ;; of the code required for interactive and noninteractive calls so that
+ ;; the command can be used more flexibly in noninteractive ways, too.
+ (unless (get 'proced-send-signal 'proced-outdated)
+ (put 'proced-send-signal 'proced-outdated t)
+ (message "Outdated usage of `proced-send-signal'")
+ (sit-for 2))
+ (setq process-alist (proced-marked-processes))
(unless signal
- ;; Display marked processes (code taken from `dired-mark-pop-up').
- (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)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (buffer-disable-undo)
- (setq buffer-read-only t)
- (dolist (process process-alist)
- (insert " " (cdr process) "\n"))
- (delete-char -1)
- (goto-char (point-min)))
- (save-window-excursion
- ;; 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))))
- (completion-extra-properties
- '(:annotation-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)
- (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))))
+ (let ((pnum (if (= 1 (length process-alist))
+ "1 process"
+ (format "%d processes" (length process-alist))))
+ (completion-ignore-case t)
+ (completion-extra-properties
+ '(:annotation-function
+ (lambda (s) (cdr (assoc s proced-signal-list))))))
+ (proced-with-processes-buffer process-alist
+ (setq signal (completing-read (concat "Send signal [" pnum
+ "] (default TERM): ")
+ proced-signal-list
+ nil nil nil nil "TERM"))))))
+
+ (let (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 nil
- (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
+ (unless (zerop (funcall
+ proced-signal-function (car process) signal))
+ (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 (format "-%s" signal)))
+ (dolist (process process-alist)
+ (with-temp-buffer
+ (condition-case nil
+ (unless (zerop (call-process
+ proced-signal-function nil t nil
+ signal (number-to-string (car process))))
+ (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
+ (format "Signal %s" 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" (length process-alist))))
+ ;; final clean-up
+ (run-hooks 'proced-after-send-signal-hook))
+
+(defun proced-renice (priority process-alist)
+ "Renice the processes in PROCESS-ALIST to PRIORITY.
+PROCESS-ALIST is an alist as returned by `proced-marked-processes'.
+Interactively, PROCESS-ALIST contains the marked processes.
+If no process is marked, it contains the process point is on,
+After renicing all processes in PROCESS-ALIST, this command runs
+the normal hook `proced-after-send-signal-hook'."
+ (interactive
+ (let ((process-alist (proced-marked-processes)))
+ (proced-with-processes-buffer process-alist
+ (list (read-number "New priority: ")
+ process-alist))))
+ (if (numberp priority)
+ (setq priority (number-to-string priority)))
+ (let (failures)
+ (dolist (process process-alist)
+ (with-temp-buffer
+ (condition-case nil
+ (unless (zerop (call-process
+ proced-renice-command nil t nil
+ priority (number-to-string (car process))))
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures))
+ (error ; catch errors from failed renice
+ (proced-log (current-buffer))
+ (proced-log "%s\n" (cdr process))
+ (push (cdr process) failures)))))
+ (if failures
+ (proced-log-summary
+ (format "Renice %s" priority)
+ (format "%d of %d renice%s failed"
+ (length failures) (length process-alist)
+ (if (= 1 (length process-alist)) "" "s")))
+ (proced-success-message "Reniced" (length process-alist))))
+ ;; final clean-up
+ (run-hooks 'proced-after-send-signal-hook))
;; similar to `dired-why'
(defun proced-why ()
(let (buffer-read-only)
(cond ((stringp log)
(insert (if args
- (apply 'format log args)
+ (apply #'format-message log args)
log)))
((bufferp log)
(insert-buffer-substring log))
(unless (bolp)
(insert "\n"))
(insert (current-time-string)
- "\tBuffer `" (buffer-name obuf) "', "
- (format "signal `%s'\n" (car args)))
+ (format-message "\tBuffer `%s', signal `%s'\n"
+ (buffer-name obuf) (car args)))
(goto-char (point-max))
(insert "\f\n")))))))