lisp/proced.el

   1 ;;; proced.el --- operate on processes like dired
   2
   3 ;; Copyright (C) 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
   6 ;; Keywords: Processes, Unix
   7
   8 ;; This file is part of GNU Emacs.
   9
  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)
  13 ;; any later version.
  14
  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.
  19
  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.
  24
  25 ;;; Commentary:
  26
  27 ;; Proced makes an Emacs buffer containing a listing of the current processes
  28 ;; (using ps(1)).  You can use the normal Emacs commands to move around in
  29 ;; this buffer, and special Proced commands to operate on the processes listed.
  30 ;;
  31 ;; To autoload, use
  32 ;;     (autoload 'proced "proced" nil t)
  33 ;; in your .emacs file.
  34 ;;
  35 ;; Is there a need for additional features like:
  36 ;; - automatic update of process list
  37 ;; - sort by CPU time or other criteria
  38 ;; - filter by user name or other criteria
  39
  40 ;;; Code:
  41
  42 (defgroup proced nil
  43   "Proced mode."
  44   :group 'processes
  45   :group 'unix
  46   :prefix "proced-")
  47
  48 (defcustom proced-procname-column-regexp "\\b\\(CMD\\|COMMAND\\)\\b"
  49   "If non-nil, regexp that defines the `proced-procname-column'."
  50   :group 'proced
  51   :type '(choice (const :tag "none" nil)
  52                  (regexp :tag "regexp")))
  53
  54 (defcustom proced-command-alist
  55   (cond ((memq system-type '(berkeley-unix netbsd))
  56          '(("user" ("ps" "-uxgww") 2)
  57            ("user-running" ("ps" "-uxrgww") 2)
  58            ("all" ("ps" "-auxgww") 2)
  59            ("all-running" ("ps" "-auxrgww") 2)))
  60         ((memq system-type '(linux lignux gnu/linux))
  61          `(("user" ("ps" "uxwww") 2)
  62            ("user-running" ("ps" "uxrwww") 2)
  63            ("all" ("ps" "auxwww") 2)
  64            ("all-running" ("ps" "auxrwww") 2)
  65            ("emacs" ("ps" "--pid" ,(number-to-string (emacs-pid))
  66                      "--ppid" ,(number-to-string (emacs-pid))
  67                       "uwww") 2)))
  68         (t ; standard syntax doesn't allow us 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 SORT-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.
  79 SORT-COLUMN is the column number used for sorting the process listing
  80 \(must be a numeric field).  If nil, the process listing is not sorted."
  81   :group 'proced
  82   :type '(repeat (group (string :tag "name")
  83                         (cons (string :tag "command")
  84                               (repeat (string :tag "option")))
  85                         (integer :tag "PID column")
  86                         (option (integer :tag "sort column")))))
  87
  88 (defcustom proced-command (if (zerop (user-real-uid)) "all" "user")
  89   "Name of process listing.
  90 Must be the car of an element of `proced-command-alist'."
  91   :group 'proced
  92   :type '(string :tag "name"))
  93
  94 (defcustom proced-kill-program "kill"
  95   "Name of kill command (usually `kill')."
  96   :group 'proced
  97   :type '(string :tag "command"))
  98
  99 (defcustom proced-signal-list
 100   '(("HUP   (1.  Hangup)")
 101     ("INT   (2.  Terminal interrupt)")
 102     ("QUIT  (3.  Terminal quit)")
 103     ("ABRT  (6.  Process abort)")
 104     ("KILL  (9.  Kill -- cannot be caught or ignored)")
 105     ("ALRM  (14. Alarm Clock)")
 106     ("TERM  (15. Termination)"))
 107   "List of signals, used for minibuffer completion."
 108   :group 'proced
 109   :type '(repeat (string :tag "signal")))
 110
 111 (defvar proced-marker-char ?*           ; the answer is 42
 112   "In proced, the current mark character.")
 113
 114 ;; face and font-lock code taken from dired
 115 (defgroup proced-faces nil
 116   "Faces used by Proced."
 117   :group 'proced
 118   :group 'faces)
 119
 120 (defface proced-header
 121   '((t (:inherit font-lock-type-face)))
 122   "Face used for proced headers."
 123   :group 'proced-faces)
 124 (defvar proced-header-face 'proced-header
 125   "Face name used for proced headers.")
 126
 127 (defface proced-mark
 128   '((t (:inherit font-lock-constant-face)))
 129   "Face used for proced marks."
 130   :group 'proced-faces)
 131 (defvar proced-mark-face 'proced-mark
 132   "Face name used for proced marks.")
 133
 134 (defface proced-marked
 135   '((t (:inherit font-lock-warning-face)))
 136   "Face used for marked processes."
 137   :group 'proced-faces)
 138 (defvar proced-marked-face 'proced-marked
 139   "Face name used for marked processes.")
 140
 141 (defvar proced-re-mark "^[^ \n]"
 142   "Regexp matching a marked line.
 143 Important: the match ends just after the marker.")
 144
 145 (defvar proced-header-regexp "\\`.*$"
 146   "Regexp matching a header line.")
 147
 148 (defvar proced-procname-column nil
 149   "Proced command column.
 150 Initialized based on `proced-procname-column-regexp'.")
 151
 152 (defvar proced-font-lock-keywords
 153   (list
 154    ;;
 155    ;; Process listing headers.
 156    (list proced-header-regexp '(0 proced-header-face))
 157    ;;
 158    ;; Proced marks.
 159    (list proced-re-mark '(0 proced-mark-face))
 160    ;;
 161    ;; Marked files.
 162    (list (concat "^[" (char-to-string proced-marker-char) "]")
 163          '(".+" (proced-move-to-procname) nil (0 proced-marked-face)))))
 164
 165 (defvar proced-mode-map
 166   (let ((km (make-sparse-keymap)))
 167     (define-key km " " 'next-line)
 168     (define-key km "n" 'next-line)
 169     (define-key km "p" 'previous-line)
 170     (define-key km "\C-?" 'previous-line)
 171     (define-key km "h" 'describe-mode)
 172     (define-key km "?" 'proced-help)
 173     (define-key km "d" 'proced-mark) ; Dired compatibility
 174     (define-key km "m" 'proced-mark)
 175     (define-key km "M" 'proced-mark-all)
 176     (define-key km "g" 'revert-buffer) ; Dired compatibility
 177     (define-key km "q" 'quit-window)
 178     (define-key km "u" 'proced-unmark)
 179     (define-key km "U" 'proced-unmark-all)
 180     (define-key km "x" 'proced-send-signal) ; Dired compatibility
 181     (define-key km "k" 'proced-send-signal) ; kill processes
 182     (define-key km "l" 'proced-listing-type)
 183     (define-key km [remap undo] 'proced-undo)
 184     (define-key km [remap advertised-undo] 'proced-undo)
 185     km)
 186   "Keymap for proced commands")
 187
 188 (easy-menu-define
 189   proced-menu proced-mode-map "Proced Menu"
 190   '("Proced"
 191     ["Mark" proced-mark t]
 192     ["Unmark" proced-unmark t]
 193     ["Mark All" proced-mark-all t]
 194     ["Unmark All" proced-unmark-all t]
 195     "--"
 196     ["Revert" revert-buffer t]
 197     ["Send signal" proced-send-signal t]
 198     ["Change listing" proced-listing-type t]))
 199
 200 (defconst proced-help-string
 201   "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit  (type ? for more help)"
 202   "Help string for proced.")
 203
 204 (defun proced-mode (&optional arg)
 205   "Mode for displaying UNIX processes and sending signals to them.
 206 Type \\[proced-mark-process] to mark a process for later commands.
 207 Type \\[proced-send-signal] to send signals to marked processes.
 208
 209 If invoked with optional ARG the window displaying the process
 210 information will be displayed but not selected.
 211
 212 \\{proced-mode-map}"
 213   (interactive "P")
 214   (let ((proced-buffer (get-buffer-create "*Process Info*")) new)
 215     (set-buffer proced-buffer)
 216     (setq new (zerop (buffer-size)))
 217     (when new
 218       (kill-all-local-variables)
 219       (use-local-map proced-mode-map)
 220       (abbrev-mode 0)
 221       (auto-fill-mode 0)
 222       (setq buffer-read-only t
 223             truncate-lines t
 224             major-mode 'proced-mode
 225             mode-name "Proced")
 226       (set (make-local-variable 'revert-buffer-function) 'proced-revert)
 227       (set (make-local-variable 'font-lock-defaults)
 228            '(proced-font-lock-keywords t nil nil beginning-of-line)))
 229
 230     (if (or new arg)
 231         (proced-update))
 232
 233     (if arg
 234         (display-buffer proced-buffer)
 235       (pop-to-buffer proced-buffer)
 236       (message (substitute-command-keys
 237                 "type \\[quit-window] to quit, \\[proced-help] for help")))
 238     (if new (run-mode-hooks 'proced-mode-hook))))
 239
 240 ;; Proced mode is suitable only for specially formatted data.
 241 (put 'proced-mode 'mode-class 'special)
 242
 243 (fset 'proced 'proced-mode)
 244
 245 (defun proced-move-to-procname ()
 246   "Move to the beginning of the process name on the current line.
 247 Return the position of the beginning of the process name, or nil if none found."
 248   (beginning-of-line)
 249   (if proced-procname-column
 250       (forward-char proced-procname-column)
 251     (forward-char 2)))
 252
 253 (defun proced-mark (&optional count)
 254   "Mark the current (or next COUNT) processes."
 255   (interactive "p")
 256   (proced-do-mark t count))
 257
 258 (defun proced-unmark (&optional count)
 259   "Unmark the current (or next COUNT) processes."
 260   (interactive "p")
 261   (proced-do-mark nil count))
 262
 263 (defun proced-do-mark (mark &optional count)
 264   "Mark the current (or next ARG) processes using MARK."
 265   (or count (setq count 1))
 266   (let ((n (if (<= 0 count) 1 -1))
 267         (line (line-number-at-pos))
 268         buffer-read-only)
 269     ;; do nothing in the first line
 270     (unless (= line 1)
 271       (setq count (1+ (cond ((<= 0 count) count)
 272                             ((< (abs count) line) (abs count))
 273                             (t (1- line)))))
 274       (beginning-of-line)
 275       (while (not (or (zerop (setq count (1- count))) (eobp)))
 276         (proced-insert-mark mark n))
 277       (proced-move-to-procname))))
 278
 279 (defun proced-mark-all ()
 280   "Mark all processes."
 281   (interactive)
 282   (proced-do-mark-all t))
 283
 284 (defun proced-unmark-all ()
 285   "Unmark all processes."
 286   (interactive)
 287   (proced-do-mark-all nil))
 288
 289 (defun proced-do-mark-all (mark)
 290   "Mark all processes using MARK."
 291   (save-excursion
 292     (let (buffer-read-only)
 293       (goto-line 2)
 294       (while (not (eobp))
 295         (proced-insert-mark mark 1)))))
 296
 297 (defun proced-insert-mark (mark n)
 298   "If MARK is non-nil, insert `proced-marker-char', move N lines."
 299   ;; Do we need other marks besides `proced-marker-char'?
 300   (insert (if mark proced-marker-char ?\s))
 301   (delete-char 1)
 302   (forward-line n))
 303
 304 (defun proced-listing-type (command)
 305   "Select `proced' listing type COMMAND from `proced-command-alist'."
 306   (interactive
 307    (list (completing-read "Listing type: " proced-command-alist nil t)))
 308   (setq proced-command command)
 309   (proced-update))
 310
 311 (defsubst proced-skip-regexp ()
 312   "Regexp to skip in process listing."
 313   (apply 'concat (make-list (1- (nth 2 (assoc proced-command
 314                                               proced-command-alist)))
 315                             "\\s-+\\S-+")))
 316
 317 (defun proced-update (&optional quiet)
 318   "Update the `proced' process information.  Preserves point and marks."
 319   (interactive)
 320   (or quiet (message "Updating process information..."))
 321   (let* ((command (cdr (assoc proced-command proced-command-alist)))
 322          (regexp (concat (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\)"))
 323          (old-pos (if (save-excursion
 324                         (beginning-of-line)
 325                         (looking-at (concat "^[* ]" regexp)))
 326                       (cons (match-string-no-properties 1)
 327                             (current-column))))
 328          buffer-read-only plist)
 329     (goto-char (point-min))
 330     ;; remember marked processes (whatever the mark was)
 331     (while (re-search-forward (concat "^\\(\\S-\\)" regexp) nil t)
 332       (push (cons (match-string-no-properties 2)
 333                   (match-string-no-properties 1)) plist))
 334     ;; generate new listing
 335     (erase-buffer)
 336     (apply 'call-process (caar command) nil t nil (cdar command))
 337     (goto-char (point-min))
 338     (while (not (eobp))
 339       (insert "  ")
 340       (forward-line))
 341     ;; (delete-trailing-whitespace)
 342     (goto-char (point-min))
 343     (while (re-search-forward "[ \t\r]+$" nil t)
 344       (delete-region (match-beginning 0) (match-end 0)))
 345     ;; set `proced-procname-column'
 346     (goto-char (point-min))
 347     (and proced-procname-column-regexp
 348          (re-search-forward proced-procname-column-regexp nil t)
 349          (setq proced-procname-column (1- (match-beginning 0))))
 350     ;; sort fields
 351     (goto-line 2)
 352     (if (nth 2 command)
 353         (sort-numeric-fields (nth 2 command) (point) (point-max)))
 354     (set-buffer-modified-p nil)
 355     ;; restore process marks
 356     (if plist
 357         (save-excursion
 358           (goto-line 2)
 359           (let (mark)
 360             (while (re-search-forward (concat "^" regexp) nil t)
 361               (if (setq mark (assoc (match-string-no-properties 1) plist))
 362                   (save-excursion
 363                     (beginning-of-line)
 364                     (insert (cdr mark))
 365                     (delete-char 1)))))))
 366     ;; restore buffer position (if possible)
 367     (goto-line 2)
 368     (if (and old-pos
 369              (re-search-forward
 370               (concat "^[* ]" (proced-skip-regexp) "\\s-+" (car old-pos) "\\>")
 371               nil t))
 372         (progn
 373           (beginning-of-line)
 374           (forward-char (cdr old-pos)))
 375       (proced-move-to-procname))
 376     (or quiet (input-pending-p)
 377         (message "Updating process information...done."))))
 378
 379 (defun proced-revert (&rest args)
 380   "Analog of `revert-buffer'."
 381   (proced-update))
 382
 383 ;; I do not want to reinvent the wheel
 384 (autoload 'dired-pop-to-buffer "dired")
 385
 386 (defun proced-send-signal (&optional signal)
 387   "Send a SIGNAL to the marked processes.
 388 SIGNAL may be a string (HUP, INT, TERM, etc.) or a number.
 389 If SIGNAL is nil display marked processes and query interactively for SIGNAL."
 390   (interactive)
 391   (let ((regexp (concat "^\\*" (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\).*$"))
 392         plist)
 393     ;; collect marked processes
 394     (save-excursion
 395       (goto-char (point-min))
 396       (while (re-search-forward regexp nil t)
 397         (push (cons (match-string-no-properties 1)
 398                     (substring (match-string-no-properties 0) 2))
 399               plist)))
 400     (if (not plist)
 401         (message "No processes marked")
 402       (unless signal
 403         ;; Display marked processes (code taken from `dired-mark-pop-up').
 404         ;; We include all process information to distinguish multiple
 405         ;; instances of the same program.
 406         (let ((bufname  " *Marked Processes*")
 407               (header (save-excursion
 408                         (goto-char (+ 2 (point-min)))
 409                         (buffer-substring-no-properties
 410                          (point) (line-end-position)))))
 411           (with-current-buffer (get-buffer-create bufname)
 412             (setq truncate-lines t)
 413             (erase-buffer)
 414             (insert header "\n")
 415             (dolist (proc plist)
 416               (insert (cdr proc) "\n"))
 417             (save-window-excursion
 418               (dired-pop-to-buffer bufname) ; all we need
 419               (let* ((completion-ignore-case t)
 420                      ;; The following is an ugly hack. Is there a better way
 421                      ;; to help people like me to remember the signals and
 422                      ;; their meanings?
 423                      (tmp (completing-read "Signal (default TERM): "
 424                                            proced-signal-list
 425                                            nil nil nil nil "TERM")))
 426                 (setq signal (if (string-match "^\\(\\S-+\\)\\s-" tmp)
 427                                  (match-string 1 tmp) tmp))))))
 428         ;; send signal
 429         (apply 'call-process proced-kill-program nil 0 nil
 430                (concat "-" (if (numberp signal)
 431                                (number-to-string signal) signal))
 432                (mapcar 'car plist))
 433         (run-hooks 'proced-after-send-signal-hook)))))
 434
 435 (defun proced-help ()
 436   "Provide help for the `proced' user."
 437   (interactive)
 438   (if (eq last-command 'proced-help)
 439       (describe-mode)
 440     (message proced-help-string)))
 441
 442 (defun proced-undo ()
 443   "Undo in a proced buffer.
 444 This doesn't recover killed processes, it just undoes changes in the proced
 445 buffer.  You can use it to recover marks."
 446   (interactive)
 447   (let (buffer-read-only)
 448     (undo))
 449   (message "Change in proced buffer undone.
 450 Killed processes cannot be recovered by Emacs."))
 451
 452 (provide 'proced)
 453
 454 ;; arch-tag: a6e312ad-9032-45aa-972d-31a8cfc545af
 455 ;;; proced.el ends here.