lisp/proced.el

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