X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/016151bb4c1612bf993f2dcfc9b3adfda3f157d9..1ddd96f5cf0b06846edd03d6b225c31206cee0b7:/lisp/proced.el diff --git a/lisp/proced.el b/lisp/proced.el index fc4d6d01cf..94ea579ebd 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1,8 +1,8 @@ ;;; proced.el --- operate on system processes like dired -;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 2008-2011 Free Software Foundation, Inc. -;; Author: Roland Winkler +;; Author: Roland Winkler ;; Keywords: Processes, Unix ;; This file is part of GNU Emacs. @@ -32,12 +32,12 @@ ;; - allow "sudo kill PID", "renice PID" ;; ;; Thoughts and Ideas -;; - Currently, `system-process-attributes' returns the list of +;; - Currently, `process-attributes' returns the list of ;; command-line arguments of a process as one concatenated string. ;; This format is compatible with `shell-command'. Also, under ;; MS-Windows, the command-line arguments are actually stored as a ;; single string, so that it is impossible to reverse-engineer it back -;; into separate arguments. Alternatively, `system-process-attributes' +;; into separate arguments. Alternatively, `process-attributes' ;; could (try to) return a list of strings that correspond to individual ;; command-line arguments. Then one could feed such a list of ;; command-line arguments into `call-process' or `start-process'. @@ -64,22 +64,23 @@ the external command (usually \"kill\")." (defcustom proced-signal-list '( ;; signals supported on all POSIX compliant systems - ("HUP (1. Hangup)") - ("INT (2. Terminal interrupt)") - ("QUIT (3. Terminal quit)") - ("ABRT (6. Process abort)") - ("KILL (9. Kill - cannot be caught or ignored)") - ("ALRM (14. Alarm Clock)") - ("TERM (15. Termination)") + ("HUP" . " (1. Hangup)") + ("INT" . " (2. Terminal interrupt)") + ("QUIT" . " (3. Terminal quit)") + ("ABRT" . " (6. Process abort)") + ("KILL" . " (9. Kill - cannot be caught or ignored)") + ("ALRM" . " (14. Alarm Clock)") + ("TERM" . " (15. Termination)") ;; POSIX 1003.1-2001 ;; Which systems do not support these signals so that we can ;; exclude them from `proced-signal-list'? - ("CONT (Continue executing)") - ("STOP (Stop executing / pause - cannot be caught or ignored)") - ("TSTP (Terminal stop / pause)")) + ("CONT" . " (Continue executing)") + ("STOP" . " (Stop executing / pause - cannot be caught or ignored)") + ("TSTP" . " (Terminal stop / pause)")) "List of signals, used for minibuffer completion." :group 'proced - :type '(repeat (string :tag "signal"))) + :type '(repeat (cons (string :tag "signal name") + (string :tag "description")))) ;; For which attributes can we use a fixed width of the output field? ;; A fixed width speeds up formatting, yet it can make @@ -94,47 +95,47 @@ the external command (usually \"kill\")." ;; It would be neat if one could temporarily override the following ;; predefined rules. (defcustom proced-grammar-alist - '( ;; attributes defined in `system-process-attributes' + '( ;; attributes defined in `process-attributes' (euid "EUID" "%d" right proced-< nil (euid pid) (nil t nil)) - (user "USER" nil left proced-string-lessp nil (user pid) (nil t nil)) + (user "User" nil left proced-string-lessp nil (user pid) (nil t nil)) (egid "EGID" "%d" right proced-< nil (egid euid pid) (nil t nil)) - (group "GROUP" nil left proced-string-lessp nil (group user pid) (nil t nil)) - (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)) + (group "Group" nil left proced-string-lessp nil (group user pid) (nil t nil)) + (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)) "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)) + (pgrp "PGrp" "%d" right proced-< nil (pgrp euid pid) (nil t nil)) + (sess "Sess" "%d" right proced-< nil (sess pid) (nil t nil)) (ttname "TTY" proced-format-ttname left proced-string-lessp nil (ttname pid) (nil t nil)) (tpgid "TPGID" "%d" right proced-< nil (tpgid pid) (nil t nil)) - (minflt "MINFLT" "%d" right proced-< nil (minflt pid) (nil t t)) - (majflt "MAJFLT" "%d" right proced-< nil (majflt pid) (nil t t)) - (cminflt "CMINFLT" "%d" right proced-< nil (cminflt pid) (nil t t)) - (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)) - (start "START" proced-format-start 6 proced-time-lessp nil (start pid) (t t nil)) - (vsize "VSIZE" "%d" right proced-< t (vsize pid) (nil t t)) + (minflt "MinFlt" "%d" right proced-< nil (minflt pid) (nil t t)) + (majflt "MajFlt" "%d" right proced-< nil (majflt pid) (nil t t)) + (cminflt "CMinFlt" "%d" right proced-< nil (cminflt pid) (nil t t)) + (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)) + (start "Start" proced-format-start 6 proced-time-lessp nil (start pid) (t t nil)) + (vsize "VSize" "%d" right proced-< t (vsize pid) (nil t t)) (rss "RSS" "%d" right proced-< t (rss pid) (nil t t)) - (etime "ETIME" proced-format-time right proced-time-lessp t (etime pid) (nil t t)) + (etime "ETime" proced-format-time right proced-time-lessp t (etime pid) (nil t t)) (pcpu "%CPU" "%.1f" right proced-< t (pcpu pid) (nil t t)) - (pmem "%MEM" "%.1f" right proced-< t (pmem pid) (nil t t)) - (args "ARGS" proced-format-args left proced-string-lessp nil (args pid) (nil t nil)) + (pmem "%Mem" "%.1f" right proced-< t (pmem pid) (nil t t)) + (args "Args" proced-format-args left proced-string-lessp nil (args pid) (nil t nil)) ;; ;; attributes defined by proced (see `proced-process-attributes') (pid "PID" "%d" right proced-< nil (pid) ((lambda (ppid) (proced-filter-children proced-process-alist ppid)) "refine to process children")) ;; process tree - (tree "TREE" proced-format-tree left nil nil nil nil)) + (tree "Tree" proced-format-tree left nil nil nil nil)) "Alist of rules for handling Proced attributes. Each element has the form @@ -218,7 +219,7 @@ If REFINER is nil no refinement is done." This variable extends the functionality of `proced-process-attributes'. Each function is called with one argument, the list of attributes of a system process. It returns a cons cell of the form (KEY . VALUE) -like `system-process-attributes'. This cons cell is appended to the list +like `process-attributes'. This cons cell is appended to the list returned by `proced-process-attributes'. If the function returns nil, the value is ignored." :group 'proced @@ -264,8 +265,8 @@ It can also be a list of keys appearing in `proced-grammar-alist'." ;; FIXME: is there a better name for filter `user' that does not coincide ;; with an attribute key? (defcustom proced-filter-alist - `((user (user . ,(concat "\\`" (user-real-login-name) "\\'"))) - (user-running (user . ,(concat "\\`" (user-real-login-name) "\\'")) + `((user (user . ,(concat "\\`" (regexp-quote (user-real-login-name)) "\\'"))) + (user-running (user . ,(concat "\\`" (regexp-quote (user-real-login-name)) "\\'")) (state . "\\`[Rr]\\'")) (all) (all-running (state . "\\`[Rr]\\'")) @@ -317,7 +318,7 @@ of `proced-grammar-alist'." :group 'proced :type '(choice (symbol :tag "Sort Scheme") (repeat :tag "Key List" (symbol :tag "Key")))) -(make-variable-buffer-local 'proced-format) +(make-variable-buffer-local 'proced-sort) (defcustom proced-descend t "Non-nil if proced listing is sorted in descending order." @@ -460,6 +461,7 @@ Important: the match ends just after the marker.") ;; marking (define-key km "d" 'proced-mark) ; Dired compatibility ("delete") (define-key km "m" 'proced-mark) + (put 'proced-mark :advertised-binding "m") (define-key km "u" 'proced-unmark) (define-key km "\177" 'proced-unmark-backward) (define-key km "M" 'proced-mark-all) @@ -608,7 +610,7 @@ Return nil if point is not on a process line." ;; proced mode (define-derived-mode proced-mode special-mode "Proced" - "Mode for displaying UNIX system processes and sending signals to them. + "Mode for displaying 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. Type \\[proced-send-signal] to send signals to marked processes. @@ -680,9 +682,9 @@ See `proced-mode' for a description of features available in Proced buffers." (progn (display-buffer buffer) (with-current-buffer buffer - (run-hooks 'proced-post-display-hook))) + (proced-update t))) (pop-to-buffer buffer) - (run-hooks 'proced-post-display-hook) + (proced-update t) (message (substitute-command-keys "Type \\\\[quit-window] to quit, \\[proced-help] for help"))))) @@ -1539,7 +1541,7 @@ the process is ignored." ;; lists are ignored? When would such processes be of interest? (let (process-alist attributes attr) (dolist (pid (or pid-list (list-system-processes)) process-alist) - (when (setq attributes (system-process-attributes pid)) + (when (setq attributes (process-attributes pid)) (setq attributes (cons (cons 'pid pid) attributes)) (dolist (fun proced-custom-attributes) (if (setq attr (funcall fun attributes)) @@ -1674,7 +1676,7 @@ After updating a displayed Proced buffer run the normal hook (message (if revert "Updating process information...done." "Updating process display...done."))))) -(defun proced-revert (&rest args) +(defun proced-revert (&rest _args) "Reevaluate the process listing based on the currently running processes. Preserves point and marks." (proced-update t)) @@ -1709,16 +1711,22 @@ After sending the signal, this command runs the normal hook (line-end-position)))))) (unless signal ;; Display marked processes (code taken from `dired-mark-pop-up'). - (let ((bufname " *Marked Processes*") + (let ((bufname " *Marked Processes*") ; use leading space in buffer name + ; to make this buffer ephemeral (header-line (substring-no-properties proced-header-line))) (with-current-buffer (get-buffer-create bufname) (setq truncate-lines t proced-header-line header-line ; inherit header line header-line-format '(:eval (proced-header-line))) (add-hook 'post-command-hook 'force-mode-line-update nil t) - (erase-buffer) - (dolist (process process-alist) - (insert " " (cdr process) "\n")) + (let ((inhibit-read-only t)) + (erase-buffer) + (buffer-disable-undo) + (setq buffer-read-only t) + (dolist (process process-alist) + (insert " " (cdr process) "\n")) + (delete-char -1) + (goto-char (point-min))) (save-window-excursion ;; Analogous to `dired-pop-to-buffer' ;; Don't split window horizontally. (Bug#1806) @@ -1729,67 +1737,66 @@ After sending the signal, this command runs the normal hook (pnum (if (= 1 (length process-alist)) "1 process" (format "%d processes" (length process-alist)))) - ;; 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 (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 - (let ((count 0) - failures) - ;; Why not always use `signal-process'? See - ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html - (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 process-alist) - (condition-case err - (if (zerop (funcall - proced-signal-function (car process) signal)) - (setq count (1+ count)) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures)) - (error ; catch errors from failed signals - (proced-log "%s\n" err) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures))))) - ;; use external system call - (let ((signal (concat "-" (if (numberp signal) - (number-to-string signal) signal)))) + (completion-extra-properties + '(:annotation-function + (lambda (s) (cdr (assoc s proced-signal-list)))))) + (setq signal + (completing-read (concat "Send signal [" pnum + "] (default TERM): ") + proced-signal-list + nil nil nil nil "TERM"))))))) + ;; send signal + (let ((count 0) + failures) + ;; Why not always use `signal-process'? See + ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html + (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 process-alist) - (with-temp-buffer - (condition-case err - (if (zerop (call-process - proced-signal-function nil t nil - signal (number-to-string (car process)))) - (setq count (1+ count)) - (proced-log (current-buffer)) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures)) - (error ; catch errors from failed signals - (proced-log (current-buffer)) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures))))))) - (if failures - ;; Proced error message are not always very precise. - ;; Can we issue a useful one-line summary in the - ;; message area (using FAILURES) if only one signal failed? - (proced-log-summary - signal - (format "%d of %d signal%s failed" - (length failures) (length process-alist) - (if (= 1 (length process-alist)) "" "s"))) - (proced-success-message "Sent signal to" count))) - ;; final clean-up - (run-hooks 'proced-after-send-signal-hook)))) + (condition-case err + (if (zerop (funcall + proced-signal-function (car process) signal)) + (setq count (1+ count)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures)) + (error ; catch errors from failed signals + (proced-log "%s\n" err) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures))))) + ;; use external system call + (let ((signal (concat "-" (if (numberp signal) + (number-to-string signal) signal)))) + (dolist (process process-alist) + (with-temp-buffer + (condition-case nil + (if (zerop (call-process + proced-signal-function nil t nil + signal (number-to-string (car process)))) + (setq count (1+ count)) + (proced-log (current-buffer)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures)) + (error ; catch errors from failed signals + (proced-log (current-buffer)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures))))))) + (if failures + ;; Proced error message are not always very precise. + ;; Can we issue a useful one-line summary in the + ;; message area (using FAILURES) if only one signal failed? + (proced-log-summary + signal + (format "%d of %d signal%s failed" + (length failures) (length process-alist) + (if (= 1 (length process-alist)) "" "s"))) + (proced-success-message "Sent signal to" count))) + ;; final clean-up + (run-hooks 'proced-after-send-signal-hook))) ;; similar to `dired-why' (defun proced-why () @@ -1866,5 +1873,4 @@ Killed processes cannot be recovered by Emacs.")) (provide 'proced) -;; arch-tag: a6e312ad-9032-45aa-972d-31a8cfc545af ;;; proced.el ends here