Mercurial > emacs

--- 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 ()