# HG changeset patch # User Roland Winkler # Date 1230985133 0 # Node ID 883cbe72dc040a9cf492b8a008564a5ae5eccc1f # Parent d74b83c02d955c46d4e11e167656cf99b86d3680 (proced-grammar-alist): Refiner can be a list (function help-echo) instead of a cons pair. (proced-post-display-hook): New variable. (proced-tree-depth): Renamed from proced-tree-indent. (proced-mode): Derive mode from special-mode. (proced-mode-map): Changed accordingly. (proced, proced-update): Run proced-post-display-hook. (proced-do-mark-all): Count processes for which mark has been updated. (proced-format): Check for ppid attribute. (proced-process-attributes): Take time and ctime attribute from system-process-attributes. (proced-send-signal): Doc fix. Collect properly the info on marked processes. Use fit-window-to-buffer instead of dired-pop-to-buffer. diff -r d74b83c02d95 -r 883cbe72dc04 lisp/proced.el --- a/lisp/proced.el Sat Jan 03 11:17:47 2009 +0000 +++ b/lisp/proced.el Sat Jan 03 12:18:53 2009 +0000 @@ -102,7 +102,7 @@ (comm "COMMAND" nil left proced-string-lessp nil (comm pid) (nil t nil)) (state "STAT" nil left proced-string-lessp nil (state pid) (nil t nil)) (ppid "PPID" "%d" right proced-< nil (ppid pid) - ((lambda (ppid) (proced-filter-parents proced-process-alist ppid)) . + ((lambda (ppid) (proced-filter-parents proced-process-alist ppid)) "refine to process parents")) (pgrp "PGRP" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) (sess "SESS" "%d" right proced-< nil (sess pid) (nil t nil)) @@ -114,8 +114,10 @@ (cmajflt "CMAJFLT" "%d" right proced-< nil (cmajflt pid) (nil t t)) (utime "UTIME" proced-format-time right proced-time-lessp t (utime pid) (nil t t)) (stime "STIME" proced-format-time right proced-time-lessp t (stime pid) (nil t t)) + (time "TIME" proced-format-time right proced-time-lessp t (time pid) (nil t t)) (cutime "CUTIME" proced-format-time right proced-time-lessp t (cutime pid) (nil t t)) (cstime "CSTIME" proced-format-time right proced-time-lessp t (cstime pid) (nil t t)) + (ctime "CTIME" proced-format-time right proced-time-lessp t (ctime pid) (nil t t)) (pri "PR" "%d" right proced-< t (pri pid) (nil t t)) (nice "NI" "%3d" 3 proced-< t (nice pid) (t t nil)) (thcount "THCOUNT" "%d" right proced-< t (thcount pid) (nil t t)) @@ -129,12 +131,8 @@ ;; ;; attributes defined by proced (see `proced-process-attributes') (pid "PID" "%d" right proced-< nil (pid) - ((lambda (ppid) (proced-filter-children proced-process-alist ppid)) . + ((lambda (ppid) (proced-filter-children proced-process-alist ppid)) "refine to process children")) - ;; time: sum of utime and stime - (time "TIME" proced-format-time right proced-time-lessp t (time pid) (nil t t)) - ;; ctime: sum of cutime and cstime - (ctime "CTIME" proced-format-time right proced-time-lessp t (ctime pid) (nil t t)) ;; process tree (tree "TREE" proced-format-tree left nil nil nil nil)) "Alist of rules for handling Proced attributes. @@ -183,7 +181,7 @@ If PREDICATE yields 'equal, the process is accepted if EQUAL-B is non-nil. If PREDICATE yields nil, the process is accepted if LARGER-B is non-nil. -REFINER can also be a cons pair (FUNCTION . HELP-ECHO). +REFINER can also be a list (FUNCTION HELP-ECHO). FUNCTION is called with one argument, the PID of the process at the position of point. The function must return a list of PIDs that is used for the refined listing. HELP-ECHO is a string that is shown when mouse is over this field. @@ -208,12 +206,12 @@ (repeat :tag "Sort Scheme" (symbol :tag "Key")) (choice :tag "Refiner" (const :tag "None" nil) + (list (function :tag "Refinement Function") + (string :tag "Help echo")) (list :tag "Refine Flags" (boolean :tag "Less") (boolean :tag "Equal") - (boolean :tag "Larger")) - (cons (function :tag "Refinement Function") - (string :tag "Help echo")))))) + (boolean :tag "Larger")))))) (defcustom proced-custom-attributes nil "List of functions defining custom attributes. @@ -351,6 +349,13 @@ :type 'boolean) (make-variable-buffer-local 'proced-tree-flag) +(defcustom proced-post-display-hook nil + "Normal hook run after displaying or updating a Proced buffer. +May be used to adapt the window size via `fit-window-to-buffer'." + :type 'hook + :options '(fit-window-to-buffer) + :group 'proced) + ;; Internal variables (defvar proced-available (not (null (list-system-processes))) @@ -405,8 +410,8 @@ (defvar proced-process-tree nil "Proced process tree (internal variable).") -(defvar proced-tree-indent nil - "Internal variable for indentation of Proced process tree.") +(defvar proced-tree-depth nil + "Internal variable for depth of Proced process tree.") (defvar proced-auto-update-timer nil "Stores if Proced auto update timer is already installed.") @@ -478,12 +483,11 @@ (define-key km "x" 'proced-send-signal) ; Dired compatibility (define-key km "k" 'proced-send-signal) ; kill processes ;; misc - (define-key km "g" 'revert-buffer) ; Dired compatibility (define-key km "h" 'describe-mode) (define-key km "?" 'proced-help) - (define-key km "q" 'quit-window) (define-key km [remap undo] 'proced-undo) (define-key km [remap advertised-undo] 'proced-undo) + ;; Additional keybindings are inherited from `special-mode-map' km) "Keymap for Proced commands.") @@ -594,7 +598,7 @@ ;; proced mode -(define-derived-mode proced-mode nil "Proced" +(define-derived-mode proced-mode special-mode "Proced" "Mode for displaying UNIX system processes and sending signals to them. Type \\[proced] to start a Proced session. In a Proced buffer type \\\\[proced-mark] to mark a process for later commands. @@ -623,6 +627,9 @@ The attribute-specific rules for formatting, filtering, sorting, and refining are defined in `proced-grammar-alist'. +After displaying or updating a Proced buffer, Proced runs the normal hook +`proced-post-display-hook'. + \\{proced-mode-map}" (abbrev-mode 0) (auto-fill-mode 0) @@ -638,14 +645,12 @@ (run-at-time t proced-auto-update-interval 'proced-auto-update-timer)))) -;; Proced mode is suitable only for specially formatted data. -(put 'proced-mode 'mode-class 'special) - ;;;###autoload (defun proced (&optional arg) "Generate a listing of UNIX system processes. If invoked with optional ARG the window displaying the process information will be displayed but not selected. +Runs the normal hook `proced-post-display-hook'. See `proced-mode' for a description of features available in Proced buffers." (interactive "P") @@ -654,12 +659,21 @@ (let ((buffer (get-buffer-create "*Proced*")) new) (set-buffer buffer) (setq new (zerop (buffer-size))) - (if new (proced-mode)) - (if (or new arg) - (proced-update t)) + (when new + (proced-mode) + ;; `proced-update' runs `proced-post-display-hook' only if the + ;; Proced buffer has been selected. Yet the following call of + ;; `proced-update' is for an empty Proced buffer that has not + ;; yet been selected. Therefore we need to call + ;; `proced-post-display-hook' below. + (proced-update t)) (if arg - (display-buffer buffer) + (progn + (display-buffer buffer) + (with-current-buffer buffer + (run-hooks 'proced-post-display-hook))) (pop-to-buffer buffer) + (run-hooks 'proced-post-display-hook) (message (substitute-command-keys "Type \\\\[quit-window] to quit, \\[proced-help] for help"))))) @@ -685,6 +699,8 @@ (message "Proced auto update %s" (if proced-auto-update-flag "enabled" "disabled"))) +;;; Mark + (defun proced-mark (&optional count) "Mark the current (or next COUNT) processes." (interactive "p") @@ -714,43 +730,6 @@ (proced-insert-mark mark backward)) (proced-move-to-goal-column))) -(defun proced-mark-all () - "Mark all processes. -If `transient-mark-mode' is turned on and the region is active, -mark the region." - (interactive) - (proced-do-mark-all t)) - -(defun proced-unmark-all () - "Unmark all processes. -If `transient-mark-mode' is turned on and the region is active, -unmark the region." - (interactive) - (proced-do-mark-all nil)) - -(defun proced-do-mark-all (mark) - "Mark all processes using MARK. -If `transient-mark-mode' is turned on and the region is active, -mark the region." - (let ((count 0) end buffer-read-only) - (save-excursion - (if (use-region-p) - ;; Operate even on those lines that are only partially a part - ;; of region. This appears most consistent with - ;; `proced-move-to-goal-column'. - (progn (setq end (save-excursion - (goto-char (region-end)) - (unless (looking-at "^") (forward-line)) - (point))) - (goto-char (region-beginning)) - (unless (looking-at "^") (beginning-of-line))) - (goto-char (point-min)) - (setq end (point-max))) - (while (< (point) end) - (setq count (1+ count)) - (proced-insert-mark mark)) - (proced-success-message "Marked" count)))) - (defun proced-toggle-marks () "Toggle marks: marked processes become unmarked, and vice versa." (interactive) @@ -775,6 +754,49 @@ (delete-char 1) (unless backward (forward-line))) +(defun proced-mark-all () + "Mark all processes. +If `transient-mark-mode' is turned on and the region is active, +mark the region." + (interactive) + (proced-do-mark-all t)) + +(defun proced-unmark-all () + "Unmark all processes. +If `transient-mark-mode' is turned on and the region is active, +unmark the region." + (interactive) + (proced-do-mark-all nil)) + +(defun proced-do-mark-all (mark) + "Mark all processes using MARK. +If `transient-mark-mode' is turned on and the region is active, +mark the region." + (let* ((count 0) + (proced-marker-char (if mark proced-marker-char ?\s)) + (marker-re (proced-marker-regexp)) + end buffer-read-only) + (save-excursion + (if (use-region-p) + ;; Operate even on those lines that are only partially a part + ;; of region. This appears most consistent with + ;; `proced-move-to-goal-column'. + (progn (setq end (save-excursion + (goto-char (region-end)) + (unless (looking-at "^") (forward-line)) + (point))) + (goto-char (region-beginning)) + (unless (looking-at "^") (beginning-of-line))) + (goto-char (point-min)) + (setq end (point-max))) + (while (< (point) end) + (unless (looking-at marker-re) + (setq count (1+ count)) + (insert proced-marker-char) + (delete-char 1)) + (forward-line)) + (proced-success-message (if mark "Marked" "Unmarked") count)))) + (defun proced-mark-children (ppid &optional omit-ppid) "Mark child processes of process PPID. Also mark process PPID unless prefix OMIT-PPID is non-nil." @@ -1026,7 +1048,7 @@ (if proced-tree-flag ;; add tree attribute (let ((process-tree (proced-process-tree process-alist)) - (proced-tree-indent 0) + (proced-tree-depth 0) (proced-temp-alist process-alist) proced-process-tree pt) (while (setq pt (pop process-tree)) @@ -1044,11 +1066,11 @@ "Helper function for `proced-tree'." (let ((pprocess (assq (car process-tree) proced-temp-alist))) (push (append (list (car pprocess)) - (list (cons 'tree proced-tree-indent)) + (list (cons 'tree proced-tree-depth)) (cdr pprocess)) proced-process-tree) (if (cdr process-tree) - (let ((proced-tree-indent (1+ proced-tree-indent))) + (let ((proced-tree-depth (1+ proced-tree-depth))) (mapc 'proced-tree-insert (cdr process-tree)))))) ;; Refining @@ -1361,7 +1383,9 @@ (let ((standard-attributes (car (proced-process-attributes (list (emacs-pid))))) new-format fmi) - (if proced-tree-flag (push (cons 'tree 0) standard-attributes)) + (if (and proced-tree-flag + (assq 'ppid standard-attributes)) + (push (cons 'tree 0) standard-attributes)) (dolist (fmt format) (if (symbolp fmt) (if (assq fmt standard-attributes) @@ -1402,7 +1426,7 @@ (cond ((functionp (car refiner)) `(proced-key ,key mouse-face highlight help-echo ,(format "mouse-2, RET: %s" - (cdr refiner)))) + (nth 1 refiner)))) ((consp refiner) `(proced-key ,key mouse-face highlight help-echo ,(format "mouse-2, RET: refine by attribute %s %s" @@ -1504,30 +1528,21 @@ the process is ignored." ;; Should we make it customizable whether processes with empty attribute ;; lists are ignored? When would such processes be of interest? - (let (process-alist attributes) + (let (process-alist attributes attr) (dolist (pid (or pid-list (list-system-processes)) process-alist) (when (setq attributes (system-process-attributes pid)) - (let ((utime (cdr (assq 'utime attributes))) - (stime (cdr (assq 'stime attributes))) - (cutime (cdr (assq 'cutime attributes))) - (cstime (cdr (assq 'cstime attributes))) - attr) - (setq attributes - (append (list (cons 'pid pid)) - (if (and utime stime) - (list (cons 'time (time-add utime stime)))) - (if (and cutime cstime) - (list (cons 'ctime (time-add cutime cstime)))) - attributes)) - (dolist (fun proced-custom-attributes) - (if (setq attr (funcall fun attributes)) - (push attr attributes))) - (push (cons pid attributes) process-alist)))))) + (setq attributes (cons (cons 'pid pid) attributes)) + (dolist (fun proced-custom-attributes) + (if (setq attr (funcall fun attributes)) + (push attr attributes))) + (push (cons pid attributes) process-alist))))) (defun proced-update (&optional revert quiet) "Update the Proced process information. Preserves point and marks. With prefix REVERT non-nil, revert listing. -Suppress status information if QUIET is nil." +Suppress status information if QUIET is nil. +After updating a displayed Proced buffer run the normal hook +`proced-post-display-hook'." ;; This is the main function that generates and updates the process listing. (interactive "P") (setq revert (or revert (not proced-process-alist))) @@ -1643,6 +1658,8 @@ (nth 1 grammar))) ""))) (force-mode-line-update) + ;; run `proced-post-display-hook' only for a displayed buffer. + (if (get-buffer-window) (run-hooks 'proced-post-display-hook)) ;; done (or quiet (input-pending-p) (message (if revert "Updating process information...done." @@ -1653,17 +1670,13 @@ Preserves point and marks." (proced-update t)) -;; I do not want to reinvent the wheel. Should we rename `dired-pop-to-buffer' -;; and move it to window.el so that proced and ibuffer can easily use it, too? -;; What about functions like `appt-disp-window' that use -;; `shrink-window-if-larger-than-buffer'? -(autoload 'dired-pop-to-buffer "dired") - (defun proced-send-signal (&optional signal) "Send a SIGNAL to the marked processes. If no process is marked, operate on current process. SIGNAL may be a string (HUP, INT, TERM, etc.) or a number. -If SIGNAL is nil display marked processes and query interactively for SIGNAL." +If SIGNAL is nil display marked processes and query interactively for SIGNAL. +After sending the signal, this command runs the normal hook +`proced-after-send-signal-hook'." (interactive) (let ((regexp (proced-marker-regexp)) process-alist) @@ -1673,7 +1686,9 @@ (while (re-search-forward regexp nil t) (push (cons (proced-pid-at-point) ;; How much info should we collect here? - (substring (match-string-no-properties 0) 2)) + (buffer-substring-no-properties + (+ 2 (line-beginning-position)) + (line-end-position))) process-alist))) (setq process-alist (if process-alist @@ -1696,7 +1711,8 @@ (dolist (process process-alist) (insert " " (cdr process) "\n")) (save-window-excursion - (dired-pop-to-buffer bufname) ; all we need + (pop-to-buffer (current-buffer)) + (fit-window-to-buffer (get-buffer-window) nil 1) (let* ((completion-ignore-case t) (pnum (if (= 1 (length process-alist)) "1 process" @@ -1729,7 +1745,7 @@ (setq count (1+ count)) (proced-log "%s\n" (cdr process)) (push (cdr process) failures)) - (error ;; catch errors from failed signals + (error ; catch errors from failed signals (proced-log "%s\n" err) (proced-log "%s\n" (cdr process)) (push (cdr process) failures))))) @@ -1746,7 +1762,7 @@ (proced-log (current-buffer)) (proced-log "%s\n" (cdr process)) (push (cdr process) failures)) - (error ;; catch errors from failed signals + (error ; catch errors from failed signals (proced-log (current-buffer)) (proced-log "%s\n" (cdr process)) (push (cdr process) failures)))))))