-;;; proced.el --- operate on processes like dired
+;;; proced.el --- operate on system processes like dired
+
+;; Copyright (C) 2008 Free Software Foundation, Inc.
-;; Copyright (C) 2008 Roland Winkler
;; Author: Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
-;; Version: 0.5
;; Keywords: Processes, Unix
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program ; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;; Proced makes an Emacs buffer containing a listing of the current processes
-;; (using ps(1)). You can use the normal Emacs commands to move around in
-;; this buffer, and special Proced commands to operate on the processes listed.
-;;
-;; To autoload, use
-;; (autoload 'proced "proced" nil t)
-;; in your .emacs file.
+;; Proced makes an Emacs buffer containing a listing of the current system
+;; processes (using ps(1)). You can use the normal Emacs commands
+;; to move around in this buffer, and special Proced commands to operate
+;; on the processes listed.
;;
-;; Is there a need for additional features like:
-;; - automatic update of process list
-;; - sort by CPU time or other criteria
+;; To do:
+;; - sort the "cooked" values used in the output format fields
+;; if ps(1) doesn't support the requested sorting scheme
;; - filter by user name or other criteria
+;; - automatic update of process list
;;; Code:
(regexp :tag "regexp")))
(defcustom proced-command-alist
- (cond ((memq system-type '(berkeley-unix netbsd))
+ (cond ((memq system-type '(berkeley-unix))
'(("user" ("ps" "-uxgww") 2)
("user-running" ("ps" "-uxrgww") 2)
("all" ("ps" "-auxgww") 2)
("all-running" ("ps" "-auxrgww") 2)))
- ((memq system-type '(linux lignux gnu/linux))
+ ((memq system-type '(gnu gnu/linux)) ; BSD syntax
`(("user" ("ps" "uxwww") 2)
("user-running" ("ps" "uxrwww") 2)
("all" ("ps" "auxwww") 2)
("emacs" ("ps" "--pid" ,(number-to-string (emacs-pid))
"--ppid" ,(number-to-string (emacs-pid))
"uwww") 2)))
- (t ; standard syntax doesn't allow us to list running processes only
+ ((memq system-type '(darwin))
+ `(("user" ("ps" "-u" ,(number-to-string (user-uid))) 2)
+ ("all" ("ps" "-Au") 2)))
+ (t ; standard UNIX syntax; doesn't allow to list running processes only
`(("user" ("ps" "-fu" ,(number-to-string (user-uid))) 2)
("all" ("ps" "-ef") 2))))
"Alist of commands to get list of processes.
-Each element has the form (NAME COMMAND PID-COLUMN SORT-COLUMN).
+Each element has the form (NAME COMMAND PID-COLUMN).
NAME is a shorthand name to select the type of listing.
COMMAND is a list (COMMAND-NAME ARG1 ARG2 ...),
where COMMAND-NAME is the command to generate the listing (usually \"ps\").
ARG1, ARG2, ... are arguments passed to COMMAND-NAME to generate
a particular listing. These arguments differ under various operating systems.
-PID-COLUMN is the column number (starting from 1) of the process ID.
-SORT-COLUMN is the column number used for sorting the process listing
-\(must be a numeric field). If nil, the process listing is not sorted."
+PID-COLUMN is the column number (starting from 1) of the process ID."
:group 'proced
:type '(repeat (group (string :tag "name")
(cons (string :tag "command")
(repeat (string :tag "option")))
- (integer :tag "PID column")
- (option (integer :tag "sort column")))))
+ (integer :tag "PID column"))))
+
+;; Should we incorporate in NAME if sorting is done in descending order?
+(defcustom proced-sorting-schemes-alist
+ (cond ((memq system-type '(gnu gnu/linux)) ; GNU long options
+ '(("%CPU" "--sort" "-pcpu") ; descending order
+ ("%MEM" "--sort" "-pmem") ; descending order
+ ("COMMAND" "--sort" "args")
+ ("PID" "--sort" "pid")
+ ("PGID,PID" "--sort" "pgid,pid")
+ ("PPID,PID" "--sort" "ppid,pid")
+ ("RSS" "--sort" "rss,pid") ; equal RSS's are rare
+ ("STAT,PID" "--sort" "stat,pid")
+ ("START" "--sort" "start_time")
+ ("TIME" "--sort" "cputime")
+ ("TTY,PID" "--sort" "tty,pid")
+ ("UID,PID" "--sort" "uid,pid")
+ ("USER,PID" "--sort" "user,pid")
+ ("VSZ,PID" "--sort" "vsz,pid"))))
+ "Alist of sorting schemes.
+Each element is a list (NAME OPTION1 OPTION2 ...).
+NAME denotes the sorting scheme and OPTION1, OPTION2, ... are options
+defining the sorting scheme."
+ :group 'proced
+ :type '(repeat (cons (string :tag "name")
+ (repeat (string :tag "option")))))
+
+(defcustom proced-sorting-scheme nil
+ "Proced sorting type.
+Must be the car of an element of `proced-sorting-schemes-alist' or nil."
+ :group 'proced
+ :type `(choice ,@(append '((const nil)) ; sorting type may be nil
+ (mapcar (lambda (item)
+ (list 'const (car item)))
+ proced-sorting-schemes-alist))))
+(make-variable-buffer-local 'proced-sorting-scheme)
(defcustom proced-command (if (zerop (user-real-uid)) "all" "user")
"Name of process listing.
Must be the car of an element of `proced-command-alist'."
:group 'proced
:type '(string :tag "name"))
+(make-variable-buffer-local 'proced-command)
-(defcustom proced-kill-program "kill"
- "Name of kill command (usually `kill')."
+(defcustom proced-signal-function 'signal-process
+ "Name of signal function.
+It can be an elisp function (usually `signal-process') or a string specifying
+the external command (usually \"kill\")."
:group 'proced
- :type '(string :tag "command"))
+ :type '(choice (function :tag "function")
+ (string :tag "command")))
(defcustom proced-signal-list
'(("HUP (1. Hangup)")
(defvar proced-procname-column nil
"Proced command column.
Initialized based on `proced-procname-column-regexp'.")
+(make-variable-buffer-local 'proced-procname-column)
(defvar proced-font-lock-keywords
(list
(define-key km "d" 'proced-mark) ; Dired compatibility
(define-key km "m" 'proced-mark)
(define-key km "M" 'proced-mark-all)
- (define-key km "g" 'revert-buffer) ; Dired compatibility
- (define-key km "q" 'quit-window)
(define-key km "u" 'proced-unmark)
+ (define-key km "\177" 'proced-unmark-backward)
(define-key km "U" 'proced-unmark-all)
+ (define-key km "t" 'proced-toggle-marks)
+ (define-key km "h" 'proced-hide-processes)
(define-key km "x" 'proced-send-signal) ; Dired compatibility
(define-key km "k" 'proced-send-signal) ; kill processes
(define-key km "l" 'proced-listing-type)
+ (define-key km "g" 'revert-buffer) ; Dired compatibility
+ (define-key km "q" 'quit-window)
+ (define-key km "sc" 'proced-sort-pcpu)
+ (define-key km "sm" 'proced-sort-pmem)
+ (define-key km "sp" 'proced-sort-pid)
+ (define-key km "ss" 'proced-sort-start)
+ (define-key km "sS" 'proced-sort)
+ (define-key km "st" 'proced-sort-time)
(define-key km [remap undo] 'proced-undo)
(define-key km [remap advertised-undo] 'proced-undo)
km)
["Unmark" proced-unmark t]
["Mark All" proced-mark-all t]
["Unmark All" proced-unmark-all t]
+ ["Toggle Marks" proced-unmark-all t]
+ "--"
+ ["Sort" proced-sort t]
+ ["Sort by %CPU" proced-sort-pcpu (proced-sorting-scheme-p "%CPU")]
+ ["Sort by %MEM" proced-sort-pmem (proced-sorting-scheme-p "%MEM")]
+ ["Sort by PID" proced-sort-pid (proced-sorting-scheme-p "PID")]
+ ["Sort by START" proced-sort-start (proced-sorting-scheme-p "START")]
+ ["Sort by TIME" proced-sort-time (proced-sorting-scheme-p "TIME")]
+ "--"
+ ["Hide Marked Processes" proced-hide-processes t]
"--"
["Revert" revert-buffer t]
["Send signal" proced-send-signal t]
"(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)"
"Help string for proced.")
-(defun proced-mode (&optional arg)
- "Mode for displaying UNIX processes and sending signals to them.
+(defun proced-marker-regexp ()
+ "Return regexp matching `proced-marker-char'."
+ (concat "^" (regexp-quote (char-to-string proced-marker-char))))
+
+(defun proced-success-message (action count)
+ "Display success message for ACTION performed for COUNT processes."
+ (message "%s %s process%s" action count (if (= 1 count) "" "es")))
+
+(defun proced-move-to-procname ()
+ "Move to the beginning of the process name on the current line.
+Return the position of the beginning of the process name, or nil if none found."
+ (beginning-of-line)
+ (if proced-procname-column
+ (forward-char proced-procname-column)
+ (forward-char 2)))
+
+(defsubst proced-skip-regexp ()
+ "Regexp to skip in process listing."
+ (apply 'concat (make-list (1- (nth 2 (assoc proced-command
+ proced-command-alist)))
+ "\\s-+\\S-+")))
+
+(define-derived-mode proced-mode nil "Proced"
+ "Mode for displaying UNIX system processes and sending signals to them.
+Type \\[proced-mark-process] to mark a process for later commands.
+Type \\[proced-send-signal] to send signals to marked processes.
+
+\\{proced-mode-map}"
+ (abbrev-mode 0)
+ (auto-fill-mode 0)
+ (setq buffer-read-only t
+ truncate-lines t)
+ (set (make-local-variable 'revert-buffer-function) 'proced-revert)
+ (set (make-local-variable 'font-lock-defaults)
+ '(proced-font-lock-keywords t nil nil beginning-of-line)))
+
+;; Proced mode is suitable only for specially formatted data.
+(put 'proced-mode 'mode-class 'special)
+
+;;;###autoload
+(defun proced (&optional arg)
+ "Mode for displaying UNIX system processes and sending signals to them.
Type \\[proced-mark-process] to mark a process for later commands.
Type \\[proced-send-signal] to send signals to marked processes.
\\{proced-mode-map}"
(interactive "P")
- (let ((proced-buffer (get-buffer-create "*Process Info*")) new)
- (set-buffer proced-buffer)
+ (let ((buffer (get-buffer-create "*Process Info*")) new)
+ (set-buffer buffer)
(setq new (zerop (buffer-size)))
- (when new
- (kill-all-local-variables)
- (use-local-map proced-mode-map)
- (abbrev-mode 0)
- (auto-fill-mode 0)
- (setq buffer-read-only t
- truncate-lines t
- major-mode 'proced-mode
- mode-name "Proced")
- (set (make-local-variable 'revert-buffer-function) 'proced-revert)
- (set (make-local-variable 'font-lock-defaults)
- '(proced-font-lock-keywords t nil nil beginning-of-line)))
+ (if new (proced-mode))
(if (or new arg)
(proced-update))
(if arg
- (display-buffer proced-buffer)
- (pop-to-buffer proced-buffer)
+ (display-buffer buffer)
+ (pop-to-buffer buffer)
(message (substitute-command-keys
- "type \\[quit-window] to quit, \\[proced-help] for help")))
- (if new (run-mode-hooks 'proced-mode-hook))))
-
-;; Proced mode is suitable only for specially formatted data.
-(put 'proced-mode 'mode-class 'special)
-
-(fset 'proced 'proced-mode)
-
-(defun proced-move-to-procname ()
- "Move to the beginning of the process name on the current line.
-Return the position of the beginning of the process name, or nil if none found."
- (beginning-of-line)
- (if proced-procname-column
- (forward-char proced-procname-column)
- (forward-char 2)))
+ "type \\[quit-window] to quit, \\[proced-help] for help")))))
(defun proced-mark (&optional count)
"Mark the current (or next COUNT) processes."
(interactive "p")
(proced-do-mark nil count))
+(defun proced-unmark-backward (&optional count)
+ "Unmark the previous (or COUNT previous) processes."
+ ;; Analogous to `dired-unmark-backward',
+ ;; but `ibuffer-unmark-backward' behaves different.
+ (interactive "p")
+ (proced-do-mark nil (- (or count 1))))
+
(defun proced-do-mark (mark &optional count)
"Mark the current (or next ARG) processes using MARK."
(or count (setq count 1))
- (let ((n (if (<= 0 count) 1 -1))
+ (let ((backward (< count 0))
(line (line-number-at-pos))
buffer-read-only)
;; do nothing in the first line
(unless (= line 1)
- (setq count (1+ (cond ((<= 0 count) count)
- ((< (abs count) line) (abs count))
- (t (1- line)))))
+ (setq count (1+ (if (<= 0 count) count
+ (min (- line 2) (abs count)))))
(beginning-of-line)
(while (not (or (zerop (setq count (1- count))) (eobp)))
- (proced-insert-mark mark n))
+ (proced-insert-mark mark backward))
(proced-move-to-procname))))
(defun proced-mark-all ()
(defun proced-do-mark-all (mark)
"Mark all processes using MARK."
- (save-excursion
- (let (buffer-read-only)
+ (let (buffer-read-only)
+ (save-excursion
(goto-line 2)
(while (not (eobp))
- (proced-insert-mark mark 1)))))
+ (proced-insert-mark mark)))))
-(defun proced-insert-mark (mark n)
- "If MARK is non-nil, insert `proced-marker-char', move N lines."
- ;; Do we need other marks besides `proced-marker-char'?
+(defun proced-toggle-marks ()
+ "Toggle marks: marked processes become unmarked, and vice versa."
+ (interactive)
+ (let ((mark-re (proced-marker-regexp))
+ buffer-read-only)
+ (save-excursion
+ (goto-line 2)
+ (while (not (eobp))
+ (cond ((looking-at mark-re)
+ (proced-insert-mark nil))
+ ((looking-at " ")
+ (proced-insert-mark t))
+ (t
+ (forward-line 1)))))))
+
+(defun proced-insert-mark (mark &optional backward)
+ "If MARK is non-nil, insert `proced-marker-char'.
+If BACKWARD is non-nil, move one line backwards before inserting the mark.
+Otherwise move one line forward after inserting the mark."
+ (if backward (forward-line -1))
(insert (if mark proced-marker-char ?\s))
(delete-char 1)
- (forward-line n))
+ (unless backward (forward-line)))
+
+;; Mostly analog of `dired-do-kill-lines'.
+;; However, for negative args the target lines of `dired-do-kill-lines'
+;; include the current line, whereas `dired-mark' for negative args operates
+;; on the preceding lines. Here we are consistent with `dired-mark'.
+(defun proced-hide-processes (&optional arg quiet)
+ "Hide marked processes.
+With prefix ARG, hide that many lines starting with the current line.
+\(A negative argument hides backward.)
+If QUIET is non-nil suppress status message.
+Returns count of hidden lines."
+ (interactive "P")
+ (let ((mark-re (proced-marker-regexp))
+ (count 0)
+ buffer-read-only)
+ (save-excursion
+ (if arg
+ ;; Hide ARG lines starting with the current line.
+ (let ((line (line-number-at-pos)))
+ ;; do nothing in the first line
+ (unless (= line 1)
+ (delete-region (line-beginning-position)
+ (save-excursion
+ (if (<= 0 arg)
+ (setq count (- arg (forward-line arg)))
+ (setq count (min (- line 2) (abs arg)))
+ (forward-line (- count)))
+ (point)))))
+ ;; Hide marked lines
+ (goto-line 2)
+ (while (and (not (eobp))
+ (re-search-forward mark-re nil t))
+ (delete-region (match-beginning 0)
+ (save-excursion (forward-line) (point)))
+ (setq count (1+ count)))))
+ (unless (zerop count) (proced-move-to-procname))
+ (unless quiet
+ (proced-success-message "Hid" count))
+ count))
(defun proced-listing-type (command)
"Select `proced' listing type COMMAND from `proced-command-alist'."
(setq proced-command command)
(proced-update))
-(defsubst proced-skip-regexp ()
- "Regexp to skip in process listing."
- (apply 'concat (make-list (1- (nth 2 (assoc proced-command
- proced-command-alist)))
- "\\s-+\\S-+")))
-
(defun proced-update (&optional quiet)
"Update the `proced' process information. Preserves point and marks."
+ ;; This is the main function that generates and updates the process listing.
(interactive)
(or quiet (message "Updating process information..."))
- (let* ((command (cdr (assoc proced-command proced-command-alist)))
+ (let* ((command (cadr (assoc proced-command proced-command-alist)))
(regexp (concat (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\)"))
(old-pos (if (save-excursion
(beginning-of-line)
(match-string-no-properties 1)) plist))
;; generate new listing
(erase-buffer)
- (apply 'call-process (caar command) nil t nil (cdar command))
+ (apply 'call-process (car command) nil t nil
+ (append (cdr command) (cdr (assoc proced-sorting-scheme
+ proced-sorting-schemes-alist))))
(goto-char (point-min))
(while (not (eobp))
(insert " ")
(goto-char (point-min))
(while (re-search-forward "[ \t\r]+$" nil t)
(delete-region (match-beginning 0) (match-end 0)))
+ (set-buffer-modified-p nil)
;; set `proced-procname-column'
(goto-char (point-min))
(and proced-procname-column-regexp
(re-search-forward proced-procname-column-regexp nil t)
(setq proced-procname-column (1- (match-beginning 0))))
- ;; sort fields
- (goto-line 2)
- (if (nth 2 command)
- (sort-numeric-fields (nth 2 command) (point) (point-max)))
- (set-buffer-modified-p nil)
;; restore process marks
(if plist
(save-excursion
(beginning-of-line)
(forward-char (cdr old-pos)))
(proced-move-to-procname))
+ ;; update modeline
+ (setq mode-name (if proced-sorting-scheme
+ (concat "Proced by " proced-sorting-scheme)
+ "Proced"))
+ (force-mode-line-update)
+ ;; done
(or quiet (input-pending-p)
(message "Updating process information...done."))))
"Analog of `revert-buffer'."
(proced-update))
-;; I do not want to reinvent the wheel
+;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer'
+;; and move it to simple.el so that proced and ibuffer can easily use it, too?
(autoload 'dired-pop-to-buffer "dired")
(defun proced-send-signal (&optional signal)
SIGNAL may be a string (HUP, INT, TERM, etc.) or a number.
If SIGNAL is nil display marked processes and query interactively for SIGNAL."
(interactive)
- (let ((regexp (concat "^\\*" (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$"))
+ (let ((regexp (concat (proced-marker-regexp)
+ (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$"))
plist)
;; collect marked processes
(save-excursion
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(push (cons (match-string-no-properties 1)
+ ;; How much info should we collect here? Would it be
+ ;; better to collect only the PID (to avoid ambiguities)
+ ;; and the command name?
(substring (match-string-no-properties 0) 2))
plist)))
+ (setq plist (nreverse plist))
(if (not plist)
(message "No processes marked")
(unless signal
;; Display marked processes (code taken from `dired-mark-pop-up').
- ;; We include all process information to distinguish multiple
- ;; instances of the same program.
(let ((bufname " *Marked Processes*")
(header (save-excursion
(goto-char (+ 2 (point-min)))
(save-window-excursion
(dired-pop-to-buffer bufname) ; all we need
(let* ((completion-ignore-case t)
+ (pnum (if (= 1 (length plist))
+ "1 process"
+ (format "%d processes" (length plist))))
;; 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 "Signal (default TERM): "
+ (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
- (apply 'call-process proced-kill-program nil 0 nil
- (concat "-" (if (numberp signal)
- (number-to-string signal) signal))
- (mapcar 'car plist))
+ (let ((count 0)
+ err-list)
+ (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 plist)
+ (if (zerop (funcall
+ proced-signal-function
+ (string-to-number (car process)) signal))
+ (setq count (1+ count))
+ (push (cdr process) err-list))))
+ ;; use external system call
+ (let ((signal (concat "-" (if (numberp signal)
+ (number-to-string signal) signal))))
+ (dolist (process plist)
+ (if (zerop (call-process
+ proced-signal-function nil 0 nil
+ signal (car process)))
+ (setq count (1+ count))
+ (push (cdr process) err-list)))))
+ (if err-list
+ ;; FIXME: that's not enough to display the errors.
+ (message "%s: %s" signal err-list)
+ (proced-success-message "Sent signal to" count)))
+ ;; final clean-up
(run-hooks 'proced-after-send-signal-hook)))))
(defun proced-help ()
(message "Change in proced buffer undone.
Killed processes cannot be recovered by Emacs."))
+;;; Sorting
+(defun proced-sort (scheme)
+ "Sort Proced buffer using SCHEME.
+When called interactively, an empty string means nil, i.e., no sorting."
+ (interactive
+ (list (let* ((completion-ignore-case t)
+ (scheme (completing-read "Sorting type: "
+ proced-sorting-schemes-alist nil t)))
+ (if (string= "" scheme) nil scheme))))
+ (if (proced-sorting-scheme-p scheme)
+ (progn
+ (setq proced-sorting-scheme scheme)
+ (proced-update))
+ (error "Proced sorting scheme %s undefined" scheme)))
+
+(defun proced-sorting-scheme-p (scheme)
+ "Return non-nil if SCHEME is an applicable sorting scheme.
+SCHEME must be a string or nil."
+ (or (not scheme)
+ (assoc scheme proced-sorting-schemes-alist)))
+
+(defun proced-sort-pcpu ()
+ "Sort Proced buffer by percentage CPU time (%CPU)."
+ (interactive)
+ (proced-sort "%CPU"))
+
+(defun proced-sort-pmem ()
+ "Sort Proced buffer by percentage memory usage (%MEM)."
+ (interactive)
+ (proced-sort "%MEM"))
+
+(defun proced-sort-pid ()
+ "Sort Proced buffer by PID."
+ (interactive)
+ (proced-sort "PID"))
+
+(defun proced-sort-start ()
+ "Sort Proced buffer by time the command started (START)."
+ (interactive)
+ (proced-sort "START"))
+
+(defun proced-sort-time ()
+ "Sort Proced buffer by cumulative CPU time (TIME)."
+ (interactive)
+ (proced-sort "TIME"))
+
(provide 'proced)
+;; arch-tag: a6e312ad-9032-45aa-972d-31a8cfc545af
;;; proced.el ends here.
HCoop / bpt / emacs.git / blobdiff