# HG changeset patch # User Roland Winkler # Date 1209955100 0 # Node ID 97585dd63d91b86064e7e36638715cf70db5e98a # Parent 070ce953fab4f7ebc19ce037b7fa04105d873423 (proced-command-alist): Fix system-type values. Fix defcustom. (proced-sorting-schemes-alist, proced-sorting-scheme): New variables. (proced-sort-pcpu, proced-sort-pmem, proced-sort-pid) (proced-sort-start, proced-sort, proced-sort-time): New commands. (proced-update): Use proced-sorting-scheme. Update modeline. (proced-send-signal): Use nreverse. (proced-sorting-scheme-p): New function. diff -r 070ce953fab4 -r 97585dd63d91 lisp/proced.el --- a/lisp/proced.el Sun May 04 23:24:49 2008 +0000 +++ b/lisp/proced.el Mon May 05 02:38:20 2008 +0000 @@ -30,7 +30,8 @@ ;; 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 @@ -49,12 +50,12 @@ (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) @@ -65,7 +66,7 @@ ((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. @@ -80,8 +81,42 @@ :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. @@ -186,6 +221,12 @@ (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) @@ -200,6 +241,13 @@ ["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] @@ -211,9 +259,11 @@ "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 () @@ -258,21 +308,20 @@ \\{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") @@ -285,6 +334,8 @@ (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)))) @@ -396,7 +447,7 @@ ;; 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) @@ -411,7 +462,9 @@ (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 " ") @@ -447,6 +500,12 @@ (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.")))) @@ -476,6 +535,7 @@ ;; 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 @@ -555,6 +615,52 @@ (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