;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; on the processes listed.
;;
;; To do:
-;; - sort by CPU time or other criteria
+;; - sort the "cooked" values used in the output format fields
+;; if ps(1) doesn't support the requested sorting scheme
;; - filter by user name or other criteria
;; - automatic update of process list
(regexp :tag "regexp")))
(defcustom proced-command-alist
- (cond ((memq system-type '(berkeley-unix netbsd))
+ (cond ((memq system-type '(berkeley-unix))
'(("user" ("ps" "-uxgww") 2)
("user-running" ("ps" "-uxrgww") 2)
("all" ("ps" "-auxgww") 2)
("all-running" ("ps" "-auxrgww") 2)))
- ((memq system-type '(linux lignux gnu/linux))
+ ((memq system-type '(gnu gnu/linux)) ; BSD syntax
`(("user" ("ps" "uxwww") 2)
("user-running" ("ps" "uxrwww") 2)
("all" ("ps" "auxwww") 2)
((memq system-type '(darwin))
`(("user" ("ps" "-u" ,(number-to-string (user-uid))) 2)
("all" ("ps" "-Au") 2)))
- (t ; standard syntax doesn't allow us to list running processes only
+ (t ; standard UNIX syntax; doesn't allow to list running processes only
`(("user" ("ps" "-fu" ,(number-to-string (user-uid))) 2)
("all" ("ps" "-ef") 2))))
"Alist of commands to get list of processes.
:type '(repeat (group (string :tag "name")
(cons (string :tag "command")
(repeat (string :tag "option")))
- (integer :tag "PID column")
- (option (integer :tag "sort column")))))
+ (integer :tag "PID column"))))
+
+;; Should we incorporate in NAME if sorting is done in descending order?
+(defcustom proced-sorting-schemes-alist
+ (cond ((memq system-type '(gnu gnu/linux)) ; GNU long options
+ '(("%CPU" "--sort" "-pcpu") ; descending order
+ ("%MEM" "--sort" "-pmem") ; descending order
+ ("COMMAND" "--sort" "args")
+ ("PID" "--sort" "pid")
+ ("PGID,PID" "--sort" "pgid,pid")
+ ("PPID,PID" "--sort" "ppid,pid")
+ ("RSS" "--sort" "rss,pid") ; equal RSS's are rare
+ ("STAT,PID" "--sort" "stat,pid")
+ ("START" "--sort" "start_time")
+ ("TIME" "--sort" "cputime")
+ ("TTY,PID" "--sort" "tty,pid")
+ ("UID,PID" "--sort" "uid,pid")
+ ("USER,PID" "--sort" "user,pid")
+ ("VSZ,PID" "--sort" "vsz,pid"))))
+ "Alist of sorting schemes.
+Each element is a list (NAME OPTION1 OPTION2 ...).
+NAME denotes the sorting scheme and OPTION1, OPTION2, ... are options
+defining the sorting scheme."
+ :group 'proced
+ :type '(repeat (cons (string :tag "name")
+ (repeat (string :tag "option")))))
+
+(defcustom proced-sorting-scheme nil
+ "Proced sorting type.
+Must be the car of an element of `proced-sorting-schemes-alist' or nil."
+ :group 'proced
+ :type `(choice ,@(append '((const nil)) ; sorting type may be nil
+ (mapcar (lambda (item)
+ (list 'const (car item)))
+ proced-sorting-schemes-alist))))
+(make-variable-buffer-local 'proced-sorting-scheme)
(defcustom proced-command (if (zerop (user-real-uid)) "all" "user")
"Name of process listing.
(define-key km "l" 'proced-listing-type)
(define-key km "g" 'revert-buffer) ; Dired compatibility
(define-key km "q" 'quit-window)
+ (define-key km "sc" 'proced-sort-pcpu)
+ (define-key km "sm" 'proced-sort-pmem)
+ (define-key km "sp" 'proced-sort-pid)
+ (define-key km "ss" 'proced-sort-start)
+ (define-key km "sS" 'proced-sort)
+ (define-key km "st" 'proced-sort-time)
(define-key km [remap undo] 'proced-undo)
(define-key km [remap advertised-undo] 'proced-undo)
km)
["Unmark All" proced-unmark-all t]
["Toggle Marks" proced-unmark-all t]
"--"
+ ["Sort" proced-sort t]
+ ["Sort by %CPU" proced-sort-pcpu (proced-sorting-scheme-p "%CPU")]
+ ["Sort by %MEM" proced-sort-pmem (proced-sorting-scheme-p "%MEM")]
+ ["Sort by PID" proced-sort-pid (proced-sorting-scheme-p "PID")]
+ ["Sort by START" proced-sort-start (proced-sorting-scheme-p "START")]
+ ["Sort by TIME" proced-sort-time (proced-sorting-scheme-p "TIME")]
+ "--"
["Hide Marked Processes" proced-hide-processes t]
"--"
["Revert" revert-buffer t]
"Help string for proced.")
(defun proced-marker-regexp ()
+ "Return regexp matching `proced-marker-char'."
(concat "^" (regexp-quote (char-to-string proced-marker-char))))
(defun proced-success-message (action count)
+ "Display success message for ACTION performed for COUNT processes."
(message "%s %s process%s" action count (if (= 1 count) "" "es")))
(defun proced-move-to-procname ()
\\{proced-mode-map}"
(interactive "P")
- (let ((proced-buffer (get-buffer-create "*Process Info*")) new)
- (set-buffer proced-buffer)
+ (let ((buffer (get-buffer-create "*Process Info*")) new)
+ (set-buffer buffer)
(setq new (zerop (buffer-size)))
- (when new (proced-mode))
+ (if new (proced-mode))
(if (or new arg)
(proced-update))
(if arg
- (display-buffer proced-buffer)
- (pop-to-buffer proced-buffer)
+ (display-buffer buffer)
+ (pop-to-buffer buffer)
(message (substitute-command-keys
"type \\[quit-window] to quit, \\[proced-help] for help")))))
-
(defun proced-mark (&optional count)
"Mark the current (or next COUNT) processes."
(interactive "p")
(defun proced-unmark-backward (&optional count)
"Unmark the previous (or COUNT previous) processes."
+ ;; Analogous to `dired-unmark-backward',
+ ;; but `ibuffer-unmark-backward' behaves different.
(interactive "p")
(proced-do-mark nil (- (or count 1))))
;; 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)))
+ (let* ((command (cadr (assoc proced-command proced-command-alist)))
(regexp (concat (proced-skip-regexp) "\\s-+\\([0-9]+\\>\\)"))
(old-pos (if (save-excursion
(beginning-of-line)
(match-string-no-properties 1)) plist))
;; generate new listing
(erase-buffer)
- (apply 'call-process (caar command) nil t nil (cdar command))
+ (apply 'call-process (car command) nil t nil
+ (append (cdr command) (cdr (assoc proced-sorting-scheme
+ proced-sorting-schemes-alist))))
(goto-char (point-min))
(while (not (eobp))
(insert " ")
(beginning-of-line)
(forward-char (cdr old-pos)))
(proced-move-to-procname))
+ ;; update modeline
+ (setq mode-name (if proced-sorting-scheme
+ (concat "Proced by " proced-sorting-scheme)
+ "Proced"))
+ (force-mode-line-update)
+ ;; done
(or quiet (input-pending-p)
(message "Updating process information...done."))))
;; and the command name?
(substring (match-string-no-properties 0) 2))
plist)))
+ (setq plist (nreverse plist))
(if (not plist)
(message "No processes marked")
(unless signal
(message "Change in proced buffer undone.
Killed processes cannot be recovered by Emacs."))
+;;; Sorting
+(defun proced-sort (scheme)
+ "Sort Proced buffer using SCHEME.
+When called interactively, an empty string means nil, i.e., no sorting."
+ (interactive
+ (list (let* ((completion-ignore-case t)
+ (scheme (completing-read "Sorting type: "
+ proced-sorting-schemes-alist nil t)))
+ (if (string= "" scheme) nil scheme))))
+ (if (proced-sorting-scheme-p scheme)
+ (progn
+ (setq proced-sorting-scheme scheme)
+ (proced-update))
+ (error "Proced sorting scheme %s undefined" scheme)))
+
+(defun proced-sorting-scheme-p (scheme)
+ "Return non-nil if SCHEME is an applicable sorting scheme.
+SCHEME must be a string or nil."
+ (or (not scheme)
+ (assoc scheme proced-sorting-schemes-alist)))
+
+(defun proced-sort-pcpu ()
+ "Sort Proced buffer by percentage CPU time (%CPU)."
+ (interactive)
+ (proced-sort "%CPU"))
+
+(defun proced-sort-pmem ()
+ "Sort Proced buffer by percentage memory usage (%MEM)."
+ (interactive)
+ (proced-sort "%MEM"))
+
+(defun proced-sort-pid ()
+ "Sort Proced buffer by PID."
+ (interactive)
+ (proced-sort "PID"))
+
+(defun proced-sort-start ()
+ "Sort Proced buffer by time the command started (START)."
+ (interactive)
+ (proced-sort "START"))
+
+(defun proced-sort-time ()
+ "Sort Proced buffer by cumulative CPU time (TIME)."
+ (interactive)
+ (proced-sort "TIME"))
+
(provide 'proced)
;; arch-tag: a6e312ad-9032-45aa-972d-31a8cfc545af
HCoop / bpt / emacs.git / blobdiff