# HG changeset patch # User Roland Winkler # Date 1208136844 0 # Node ID ab8c45d22418b3a1cb6e0074a99dc17ba430bc6e # Parent 9fefa536be587356f0c94c5b7182c2fbf853732a (proced-command-alist): Remove sort column. (proced-command, proced-procname-column): Use make-variable-buffer-local. (proced-signal-function): Renamed from proced-kill-program. Allow for elisp symbols and string values representing system calls. (proced-marker-regexp, proced-success-message): New functions. (proced): Use defalias. Add autoload cookie. (proced-unmark-backward, proced-toggle-marks) (proced-hide-processes): New commands. (proced-do-mark): Simplify code. (proced-insert-mark): Use optional arg BACKWARD instead of line number. (proced-update): Remove sorting. (proced-send-signal): Display number of processes to operate on. Allow for system calls or elisp functions to send signals. Check if signal was send successfully. diff -r 9fefa536be58 -r ab8c45d22418 lisp/proced.el --- a/lisp/proced.el Sun Apr 13 22:12:02 2008 +0000 +++ b/lisp/proced.el Mon Apr 14 01:34:04 2008 +0000 @@ -1,4 +1,4 @@ -;;; proced.el --- operate on processes like dired +;;; proced.el --- operate on system processes like dired ;; Copyright (C) 2008 Free Software Foundation, Inc. @@ -24,18 +24,15 @@ ;;; 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. +;; 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. ;; -;; To autoload, use -;; (autoload 'proced "proced" nil t) -;; in your .emacs file. -;; -;; Is there a need for additional features like: -;; - automatic update of process list +;; To do: ;; - sort by CPU time or other criteria ;; - filter by user name or other criteria +;; - automatic update of process list ;;; Code: @@ -69,15 +66,13 @@ `(("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") @@ -90,11 +85,15 @@ 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)") @@ -148,6 +147,7 @@ (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 @@ -173,13 +173,16 @@ (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 [remap undo] 'proced-undo) (define-key km [remap advertised-undo] 'proced-undo) km) @@ -192,6 +195,9 @@ ["Unmark" proced-unmark t] ["Mark All" proced-mark-all t] ["Unmark All" proced-unmark-all t] + ["Toggle Marks" proced-unmark-all t] + "--" + ["Hide Marked Processes" proced-hide-processes t] "--" ["Revert" revert-buffer t] ["Send signal" proced-send-signal t] @@ -201,8 +207,28 @@ "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)" "Help string for proced.") +(defun proced-marker-regexp () + (concat "^" (regexp-quote (char-to-string proced-marker-char)))) + +(defun proced-success-message (action count) + (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-+"))) + (defun proced-mode (&optional arg) - "Mode for displaying UNIX processes and sending signals to them. + "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. @@ -240,15 +266,8 @@ ;; 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))) +;;;###autoload +(defalias 'proced 'proced-mode) (defun proced-mark (&optional count) "Mark the current (or next COUNT) processes." @@ -260,20 +279,24 @@ (interactive "p") (proced-do-mark nil count)) +(defun proced-unmark-backward (&optional count) + "Unmark the previous (or COUNT previous) processes." + (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 () @@ -288,18 +311,74 @@ (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))))) + +(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)) - (proced-insert-mark mark 1))))) + (cond ((looking-at mark-re) + (proced-insert-mark nil)) + ((looking-at " ") + (proced-insert-mark t)) + (t + (forward-line 1))))))) -(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-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'." @@ -308,14 +387,9 @@ (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))) @@ -342,16 +416,12 @@ (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 @@ -380,7 +450,8 @@ "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) @@ -388,21 +459,23 @@ 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))) (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))) @@ -417,19 +490,48 @@ (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)) + (push (cdr process) err-list) + (setq count (1+ count))))) + ;; 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))) + (push (cdr process) err-list) + (setq count (1+ count)))))) + (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 ()