comparison lisp/proced.el @ 98249:538f59dc1be8

(proced-grammar-alist, proced-custom-attributes) (proced-format-alist, proced-format, proced-filter-alist) (proced-filter, proced-sort): Use defcustom. (proced-mode): Fix docstring. (proced-process-attributes): Handle return value nil of functions in proced-custom-attributes.

98248:215a88f14455

;; system processes.  You can use the normal Emacs commands to move around
;; in this buffer, and special Proced commands to operate on the processes
;; listed.  See `proced-mode' for getting started.
;;
;; To do:
;; - use defcustom where appropriate
;; - interactive temporary customizability of flags in `proced-grammar-alist'
;; - allow "sudo kill PID", "renice PID"
;;
;; Wishlist
;; - tree view like pstree(1)

;; predicate like `<'.  Otherwise, a list of proced predicates can be used
;; to refine the sort.
;;
;; It would be neat if one could temporarily override the following
;; predefined rules.
(defvar proced-grammar-alist
  '( ;; attributes defined in `system-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))
    (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))

Each element has the form

  (KEY NAME FORMAT JUSTIFY PREDICATE REVERSE SORT-SCHEME REFINE-FLAGS).

KEY is the car of a process attribute.

NAME appears in the header line.

FORMAT specifies the format for displaying the attribute values.
It can be a string passed to `format'.  It can be a function called
with one argument, the value of the attribute.  Nil means take as is.

This command compares the value of attribute KEY of every process with
the value of attribute KEY of the process at the position of point
using PREDICATE.
If PREDICATE yields non-nil, the process is accepted if LESS-B is non-nil.
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.")

(defvar proced-custom-attributes nil
  "List of functions defining custom attributes.
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'.")

;; Formatting and sorting rules are defined "per attribute".  If formatting
;; and / or sorting should use more than one attribute, it appears more
;; transparent to define a new derived attribute, so that formatting and
;; sorting can use them consistently.  (Are there exceptions to this rule?
;; Would it be advantageous to have yet more general methods available?)
;; Sorting can also be based on attributes that are invisible in the listing.

(defvar proced-format-alist
  '((short user pid pcpu pmem start time args)
    (medium user pid pcpu pmem vsize rss ttname state start time args)
    (long user euid group pid pri nice pcpu pmem vsize rss ttname state
          start time args)
    (verbose user euid group egid pid ppid pgrp sess comm pri nice pcpu pmem
             state thcount vsize rss ttname tpgid minflt majflt cminflt cmajflt
             start time utime stime ctime cutime cstime etime args))
  "Alist of formats of listing.
The car of each element is a symbol, the name of the format.
The cdr is a list of keys appearing in `proced-grammar-alist'.")

(defvar proced-format 'short
  "Current format of Proced listing.
It can be the car of an element of `proced-format-alist'.
It can also be a list of keys appearing in `proced-grammar-alist'.")
(make-variable-buffer-local 'proced-format)

;; FIXME: is there a better name for filter `user' that does not coincide
;; with an attribute key?
(defvar proced-filter-alist
  `((user (user . ,(concat "\\`" (user-real-login-name) "\\'")))
    (user-running (user . ,(concat "\\`" (user-real-login-name) "\\'"))
                  (state . "\\`[Rr]\\'"))
    (all)
    (all-running (state . "\\`[Rr]\\'"))

\(KEY . FUN)      Apply function FUN to attribute KEY.  Accept this process,
                 if FUN returns non-nil.
\(function . FUN) For each process, apply function FUN to list of attributes
                 of each.  Accept the process if FUN returns non-nil.
\(fun-all . FUN)  Apply function FUN to entire process list.
                 FUN must return the filtered list.")

(defvar proced-filter 'user
  "Current filter of proced listing.
It can be the car of an element of `proced-filter-alist'.
It can also be a list of elementary filters as in the cdrs of the elements
of `proced-filter-alist'.")
(make-variable-buffer-local 'proced-filter)

(defvar proced-sort 'pcpu
  "Current sort scheme for proced listing.
It must be the KEY of an element of `proced-grammar-alist'.
It can also be a list of KEYs as in the SORT-SCHEMEs of the elements
of `proced-grammar-alist'.")
(make-variable-buffer-local 'proced-format)

(defcustom proced-goal-attribute 'args
  "If non-nil, key of the attribute that defines the `goal-column'."
  :group 'proced
  :type '(choice (const :tag "none" nil)
                 (symbol :tag "key")))

(defcustom proced-timer-interval 5
  "Time interval in seconds for updating Proced buffers."
  :group 'proced
  :type 'integer)

(defcustom proced-timer-flag nil
  "Non-nil for auto update of a Proced buffer.

(defvar proced-header-line nil
  "Headers in Proced buffer as a string.")
(make-variable-buffer-local 'proced-header-line)

(defvar proced-log-buffer "*Proced log*"
  "Name of Proced Log buffer.")

(defvar proced-process-tree nil
  "Process tree of listing (internal variable).")

(defvar proced-timer nil
  "Stores if Proced timer is already installed.")

(defconst proced-help-string
  "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)"
  "Help string for proced.")

;; proced mode

(define-derived-mode proced-mode nil "Proced"
  "Mode for displaying UNIX system processes and sending signals to them.
Type \\<proced-mode-map>\\[proced-mark] to mark a process for later commands.
Type \\[proced-send-signal] to send signals to marked processes.

The initial content of a listing is defined by the variable `proced-filter'
and the variable `proced-format'.
The variable `proced-filter' specifies which system processes are displayed.

  (mapcar (lambda (pid)
            (let* ((attributes (system-process-attributes pid))
                   (utime (cdr (assq 'utime attributes)))
                   (stime (cdr (assq 'stime attributes)))
                   (cutime (cdr (assq 'cutime attributes)))
                   (cstime (cdr (assq 'cstime attributes))))
              (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)
                (push (funcall fun attributes) attributes))
              (cons pid attributes)))
          (list-system-processes)))

(defun proced-update (&optional revert quiet)
  "Update the `proced' process information.  Preserves point and marks.

                                   proced-header-line))
                (if (nth 3 grammar)
                    (match-beginning 0)
                  (match-end 0)))))

    ;; restore process marks and buffer position (if possible)
    ;; FIXME: sometimes this puts point in the middle of the proced buffer
    ;; where it is not interesting.  Is there a better / more flexible solution?
    (goto-char (point-min))
    (let (pid mark new-pos)
      (if (or mp-list (car old-pos))
          (while (not (eobp))

98249:538f59dc1be8

;; system processes.  You can use the normal Emacs commands to move around
;; in this buffer, and special Proced commands to operate on the processes
;; listed.  See `proced-mode' for getting started.
;;
;; To do:
;; - interactive temporary customizability of flags in `proced-grammar-alist'
;; - allow "sudo kill PID", "renice PID"
;;
;; Wishlist
;; - tree view like pstree(1)

;; predicate like `<'.  Otherwise, a list of proced predicates can be used
;; to refine the sort.
;;
;; It would be neat if one could temporarily override the following
;; predefined rules.
(defcustom proced-grammar-alist
  '( ;; attributes defined in `system-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))
    (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))

Each element has the form

  (KEY NAME FORMAT JUSTIFY PREDICATE REVERSE SORT-SCHEME REFINE-FLAGS).

Symbol KEY is the car of a process attribute.

String NAME appears in the header line.

FORMAT specifies the format for displaying the attribute values.
It can be a string passed to `format'.  It can be a function called
with one argument, the value of the attribute.  Nil means take as is.

This command compares the value of attribute KEY of every process with
the value of attribute KEY of the process at the position of point
using PREDICATE.
If PREDICATE yields non-nil, the process is accepted if LESS-B is non-nil.
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."
  :group 'proced
  :type '(repeat (list :tag "Attribute"
                       (symbol :tag "Key")
                       (string :tag "Header")
                       (choice :tag "Format"
                               (const :tag "None" nil)
                               (string :tag "Format String")
                               (function :tag "Formatting Function"))
                       (choice :tag "Justification"
                               (const :tag "left" left)
                               (const :tag "right" right)
                               (integer :tag "width"))
                       (function :tag "Predicate")
                       (boolean :tag "Reverse Sort Order")
                       (repeat :tag "Sort Scheme" (symbol :tag "Key"))
                       (list :tag "Refine Flags"
                             (boolean :tag "Less")
                             (boolean :tag "Equal")
                             (boolean :tag "Larger")))))

(defcustom proced-custom-attributes nil
  "List of functions defining custom attributes.
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
returned by `proced-process-attributes'.
If the function returns nil, the value is ignored."
  :group 'proced
  :type '(repeat (function :tag "Attribute")))

;; Formatting and sorting rules are defined "per attribute".  If formatting
;; and / or sorting should use more than one attribute, it appears more
;; transparent to define a new derived attribute, so that formatting and
;; sorting can use them consistently.  (Are there exceptions to this rule?
;; Would it be advantageous to have yet more general methods available?)
;; Sorting can also be based on attributes that are invisible in the listing.

(defcustom proced-format-alist
  '((short user pid pcpu pmem start time args)
    (medium user pid pcpu pmem vsize rss ttname state start time args)
    (long user euid group pid pri nice pcpu pmem vsize rss ttname state
          start time args)
    (verbose user euid group egid pid ppid pgrp sess comm pri nice pcpu pmem
             state thcount vsize rss ttname tpgid minflt majflt cminflt cmajflt
             start time utime stime ctime cutime cstime etime args))
  "Alist of formats of listing.
The car of each element is a symbol, the name of the format.
The cdr is a list of keys appearing in `proced-grammar-alist'."
  :group 'proced
  :type '(alist :key-type (symbol :tag "Format Name")
                :value-type (repeat :tag "Keys" (symbol :tag ""))))

(defcustom proced-format 'short
  "Current format of Proced listing.
It can be the car of an element of `proced-format-alist'.
It can also be a list of keys appearing in `proced-grammar-alist'."
  :group 'proced
  :type '(choice (symbol :tag "Format Name")
                 (repeat :tag "Keys" (symbol :tag ""))))
(make-variable-buffer-local 'proced-format)

;; 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) "\\'"))
                  (state . "\\`[Rr]\\'"))
    (all)
    (all-running (state . "\\`[Rr]\\'"))

\(KEY . FUN)      Apply function FUN to attribute KEY.  Accept this process,
                 if FUN returns non-nil.
\(function . FUN) For each process, apply function FUN to list of attributes
                 of each.  Accept the process if FUN returns non-nil.
\(fun-all . FUN)  Apply function FUN to entire process list.
                 FUN must return the filtered list."
  :group 'proced
  :type '(repeat (cons :tag "Filter"
                       (symbol :tag "Filter Name")
                       (repeat :tag "Filters"
                               (choice (cons :tag "Key . Regexp" (symbol :tag "Key") regexp)
                                       (cons :tag "Key . Function" (symbol :tag "Key") function)
                                       (cons :tag "Function" (const :tag "Key: function" function) function)
                                       (cons :tag "Fun-all" (const :tag "Key: fun-all" fun-all) function))))))

(defcustom proced-filter 'user
  "Current filter of proced listing.
It can be the car of an element of `proced-filter-alist'.
It can also be a list of elementary filters as in the cdrs of the elements
of `proced-filter-alist'."
  :group 'proced
  :type '(choice (symbol :tag "Filter Name")
                 (repeat :tag "Filters"
                         (choice (cons :tag "Key . Regexp" (symbol :tag "Key") regexp)
                                 (cons :tag "Key . Function" (symbol :tag "Key") function)
                                 (cons :tag "Function" (const :tag "Key: function" function) function)
                                 (cons :tag "Fun-all" (const :tag "Key: fun-all" fun-all) function)))))
(make-variable-buffer-local 'proced-filter)

(defcustom proced-sort 'pcpu
  "Current sort scheme for proced listing.
It must be the KEY of an element of `proced-grammar-alist'.
It can also be a list of KEYs as in the SORT-SCHEMEs of the elements
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)

(defcustom proced-goal-attribute 'args
  "If non-nil, key of the attribute that defines the `goal-column'."
  :group 'proced
  :type '(choice (const :tag "none" nil)
                 (symbol :tag "key")))

(defcustom proced-timer-interval 5
  "Time interval in seconds for auto updating Proced buffers."
  :group 'proced
  :type 'integer)

(defcustom proced-timer-flag nil
  "Non-nil for auto update of a Proced buffer.

(defvar proced-header-line nil
  "Headers in Proced buffer as a string.")
(make-variable-buffer-local 'proced-header-line)

(defvar proced-process-tree nil
  "Process tree of listing (internal variable).")

(defvar proced-timer nil
  "Stores if Proced timer is already installed.")

(defvar proced-log-buffer "*Proced log*"
  "Name of Proced Log buffer.")

(defconst proced-help-string
  "(n)ext, (p)revious, (m)ark, (u)nmark, (k)ill, (q)uit (type ? for more help)"
  "Help string for proced.")

;; proced mode

(define-derived-mode proced-mode nil "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-mode-map>\\[proced-mark] to mark a process for later commands.
Type \\[proced-send-signal] to send signals to marked processes.

The initial content of a listing is defined by the variable `proced-filter'
and the variable `proced-format'.
The variable `proced-filter' specifies which system processes are displayed.

  (mapcar (lambda (pid)
            (let* ((attributes (system-process-attributes pid))
                   (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)))
              (cons pid attributes)))
          (list-system-processes)))

(defun proced-update (&optional revert quiet)
  "Update the `proced' process information.  Preserves point and marks.

                                   proced-header-line))
                (if (nth 3 grammar)
                    (match-beginning 0)
                  (match-end 0)))))

    ;; Restore process marks and buffer position (if possible).
    ;; Sometimes this puts point in the middle of the proced buffer
    ;; where it is not interesting.  Is there a better / more flexible solution?
    (goto-char (point-min))
    (let (pid mark new-pos)
      (if (or mp-list (car old-pos))
          (while (not (eobp))