comparison lisp/proced.el @ 100735:8ec0632b600c

(proced-grammar-alist): Allow predicate nil. New attribute tree. (proced-format-alist): Use attribute tree. (proced-tree-flag, proced-tree-indent): New variables. (proced-children-alist): Renamed from proced-process-tree. PPID must refer to a process in process-alist. Ignore PPIDs that equal PID. Children alist inherits sorting order from process-alist. (proced-process-tree): New variable. New function. (proced-process-tree-internal, proced-toggle-tree) (proced-tree, proced-tree-insert, proced-format-tree): New functions. (proced-mark-process-alist): Add docstring. (proced-filter-parents): PPID must refer to a process in process-alist. Ignore PPIDs that equal PID. (proced-sort): Throw error if attribute is not sortable. (proced-sort-interactive): Restrict completion to sortable attributes. (proced-format): Include tree in standard attributes if proced-tree-flag is non-nil. Make header clickable only if corresponding predicate is non-nil. (proced-update): Use proced-tree.

100734:72f33d657eb7

             ((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)))
  "Alist of rules for handling Proced attributes.

Each element has the form

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

PREDICATE is the predicate for sorting and filtering the process listing
based on attribute KEY.  PREDICATE takes two arguments P1 and P2,
the corresponding attribute values of two processes.  PREDICATE should
return 'equal if P1 has same rank like P2.  Any other non-nil value says
that P1 is \"less than\" P2, or nil if not.

PREDICATE defines an ascending sort order.  REVERSE is non-nil if the sort
order is descending.

SORT-SCHEME is a list (KEY1 KEY2 ...) defining a hierarchy of rules

                               (function :tag "Formatting Function"))
                       (choice :tag "Justification"
                               (const :tag "left" left)
                               (const :tag "right" right)
                               (integer :tag "width"))
                       (function :tag "Predicate")
                       (boolean :tag "Descending Sort Order")
                       (repeat :tag "Sort Scheme" (symbol :tag "Key"))
                       (choice :tag "Refiner"
                               (list :tag "Refine Flags"
                                     (boolean :tag "Less")
                                     (boolean :tag "Equal")
                                     (boolean :tag "Larger"))
                               (cons (function :tag "Refinement Function")
                                     (string :tag "Help echo"))
                               (const :tag "None" nil)))))

(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

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

Can be changed interactively via `proced-toggle-auto-update'."
  :group 'proced
  :type 'boolean)
(make-variable-buffer-local 'proced-auto-update-flag)

;; Internal variables

(defvar proced-available (not (null (list-system-processes)))
  "Non-nil means Proced is known to work on this system.")

(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-auto-update-timer nil
  "Stores if Proced auto update timer is already installed.")

(defvar proced-log-buffer "*Proced log*"

    (define-key km "st" 'proced-sort-time)
    (define-key km "su" 'proced-sort-user)
    ;; similar to `Buffer-menu-sort-by-column'
    (define-key km [header-line mouse-1] 'proced-sort-header)
    (define-key km [header-line mouse-2] 'proced-sort-header)
    ;; formatting
    (define-key km "F"  'proced-format-interactive)
    ;; operate
    (define-key km "o" 'proced-omit-processes)
    (define-key km "x" 'proced-send-signal) ; Dired compatibility

                   `[,(symbol-name format)
                     (proced-format-interactive ',format)
                     :style radio
                     :selected (eq proced-format ',format)]))
               proced-format-alist))
    "--"
    ["Omit Marked Processes" proced-omit-processes
     :help "Omit Marked Processes in Process Listing."]
    "--"
    ["Revert" revert-buffer

The sort order of Proced listings is defined by the variable `proced-sort'.
Type \\[proced-sort-interactive] or click on a header in the header line
to change the sort scheme.  The current sort scheme is indicated in the
mode line, using \"+\" or \"-\" for ascending or descending sort order.

An existing Proced listing can be refined by typing \\[proced-refine].
Refining an existing listing does not update the variable `proced-filter'.

The attribute-specific rules for formatting, filtering, sorting, and refining

  (interactive (list (proced-pid-at-point) current-prefix-arg))
  (proced-mark-process-alist
   (proced-filter-parents proced-process-alist cpid omit-cpid)))

(defun proced-mark-process-alist (process-alist &optional quiet)
  (let ((count 0))
    (if process-alist
        (let (buffer-read-only)
          (save-excursion
            (goto-char (point-min))

  ;; only update if necessary
  (unless (eq proced-filter scheme)
    (setq proced-filter scheme)
    (proced-update t)))

(defun proced-process-tree (process-alist)
  "Return process tree for PROCESS-ALIST.
The process tree is an alist with elements (PPID PID1 PID2 ...).
PPID is a parent PID.  PID1, PID2, ... are the child processes of PPID.
The list of children does not include grandchildren."
  (let (children-list ppid cpids)
    (dolist (process process-alist children-list)
      (setq ppid (cdr (assq 'ppid (cdr process))))
      (if ppid
          (setq children-list
                (if (setq cpids (assq ppid children-list))
                    (cons (cons ppid (cons (car process) (cdr cpids)))
                          (assq-delete-all ppid children-list))
                  (cons (list ppid (car process))
                        children-list)))))))

(defun proced-filter-children (process-alist ppid &optional omit-ppid)
  "For PROCESS-ALIST return list of child processes of PPID.
This list includes PPID unless OMIT-PPID is non-nil."
  (let ((proced-process-tree (proced-process-tree process-alist))
        new-alist)
    (dolist (pid (proced-children-pids ppid))
      (push (assq pid process-alist) new-alist))
    (if omit-ppid
        (assq-delete-all ppid new-alist)
      new-alist)))

;; helper function
(defun proced-children-pids (ppid)
  "Return list of children PIDs of PPID (including PPID)."
  (let ((cpids (cdr (assq ppid proced-process-tree))))
    (if cpids
        (cons ppid (apply 'append (mapcar 'proced-children-pids cpids)))
      (list ppid))))

(defun proced-filter-parents (process-alist pid &optional omit-pid)
  "For PROCESS-ALIST return list of parent processes of PID.
This list includes PID unless OMIT-PID is non-nil."
  (let ((parent-list (unless omit-pid (list (assq pid process-alist)))))
    (while (setq pid (cdr (assq 'ppid (cdr (assq pid process-alist)))))
      (push (assq pid process-alist) parent-list))
    parent-list))

;; Refining

;; Filters are used to select the processes in a new listing.

Return the sorted process list."
  ;; translate SORTER into a list of lists (KEY PREDICATE REVERSE)
  (setq proced-sort-internal
        (mapcar (lambda (arg)
                  (let ((grammar (assq arg proced-grammar-alist)))
                    (list arg (nth 4 grammar) (nth 5 grammar))))
                (cond ((listp sorter) sorter)
                      ((and (symbolp sorter)
                            (nth 6 (assq sorter proced-grammar-alist))))
                      ((symbolp sorter) (list sorter))

  adopt the sorting order defined for SCHEME in `proced-grammar-alist'.

Set variable `proced-sort' to SCHEME.  The current sort scheme is displayed
in the mode line, using \"+\" or \"-\" for ascending or descending order."
  (interactive
   (let ((scheme (completing-read "Sort attribute: "
                                  proced-grammar-alist nil t)))
     (list (if (string= "" scheme) nil (intern scheme))
           ;; like 'toggle in `define-derived-mode'
           (or current-prefix-arg 'no-arg))))

  (setq proced-descend

  "Format attribute TTNAME, omitting path \"/dev/\"."
  ;; Does this work for all systems?
  (substring ttname (if (string-match "\\`/dev/" ttname)
                        (match-end 0) 0)))

;; Proced assumes that every process occupies only one line in the listing.
(defun proced-format-args (args)
  "Format attribute ARGS.
Replace newline characters by \"^J\" (two characters)."
  (replace-regexp-in-string "\n" "^J" args))

  ;; If none of the alternatives is non-nil, the attribute is ignored
  ;; in the listing.
  (let ((standard-attributes
         (car (proced-process-attributes (list (emacs-pid)))))
        new-format fmi)
    (dolist (fmt format)
      (if (symbolp fmt)
          (if (assq fmt standard-attributes)
              (push fmt new-format))
        (while (setq fmi (pop fmt))

             ;; Text properties:
             ;; We use the text property `proced-key' to store in each
             ;; field the corresponding key.
             ;; Of course, the sort predicate appearing in help-echo
             ;; is only part of the story.  But it gives the main idea.
             (hprops (let ((descend (if (eq key sort-key) proced-descend (nth 5 grammar))))
                       `(proced-key ,key mouse-face highlight
                                    help-echo ,(format proced-header-help-echo
                                                       (if descend "-" "+")
                                                       (nth 1 grammar)
                                                       (if descend "descending" "ascending")))))
             (refiner (nth 7 grammar))
             (fprops
              (cond ((functionp (car refiner))
                     `(proced-key ,key mouse-face highlight
                                  help-echo ,(format "mouse-2, RET: %s"

      (setq proced-process-alist (proced-process-attributes)))
  ;; filtering and sorting
  (setq proced-process-alist
        (proced-sort (proced-filter proced-process-alist proced-filter)
                     proced-sort proced-descend))

  ;; It is useless to keep undo information if we revert, filter, or
  ;; refine the listing so that `proced-process-alist' has changed.
  ;; We could keep the undo information if we only re-sort the buffer.
  ;; Would that be useful?  Re-re-sorting is easy, too.

100735:8ec0632b600c

             ((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.

Each element has the form

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

PREDICATE is the predicate for sorting and filtering the process listing
based on attribute KEY.  PREDICATE takes two arguments P1 and P2,
the corresponding attribute values of two processes.  PREDICATE should
return 'equal if P1 has same rank like P2.  Any other non-nil value says
that P1 is \"less than\" P2, or nil if not.
If PREDICATE is nil the attribute cannot be sorted.

PREDICATE defines an ascending sort order.  REVERSE is non-nil if the sort
order is descending.

SORT-SCHEME is a list (KEY1 KEY2 ...) defining a hierarchy of rules

                               (function :tag "Formatting Function"))
                       (choice :tag "Justification"
                               (const :tag "left" left)
                               (const :tag "right" right)
                               (integer :tag "width"))
                       (choice :tag "Predicate"
                               (const :tag "None" nil)
                               (function :tag "Function"))
                       (boolean :tag "Descending Sort Order")
                       (repeat :tag "Sort Scheme" (symbol :tag "Key"))
                       (choice :tag "Refiner"
                               (const :tag "None" nil)
                               (list :tag "Refine Flags"
                                     (boolean :tag "Less")
                                     (boolean :tag "Equal")
                                     (boolean :tag "Larger"))
                               (cons (function :tag "Refinement Function")
                                     (string :tag "Help echo"))))))

(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

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

Can be changed interactively via `proced-toggle-auto-update'."
  :group 'proced
  :type 'boolean)
(make-variable-buffer-local 'proced-auto-update-flag)

(defcustom proced-tree-flag nil
  "Non-nil for display of Proced-buffer as process tree."
  :group 'proced
  :type 'boolean)
(make-variable-buffer-local 'proced-tree-flag)

;; Internal variables

(defvar proced-available (not (null (list-system-processes)))
  "Non-nil means Proced is known to work on this system.")

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

(defvar proced-children-alist nil
  "Children alist of process listing (internal variable).")

(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-auto-update-timer nil
  "Stores if Proced auto update timer is already installed.")

(defvar proced-log-buffer "*Proced log*"

    (define-key km "st" 'proced-sort-time)
    (define-key km "su" 'proced-sort-user)
    ;; similar to `Buffer-menu-sort-by-column'
    (define-key km [header-line mouse-1] 'proced-sort-header)
    (define-key km [header-line mouse-2] 'proced-sort-header)
    (define-key km "T" 'proced-toggle-tree)
    ;; formatting
    (define-key km "F"  'proced-format-interactive)
    ;; operate
    (define-key km "o" 'proced-omit-processes)
    (define-key km "x" 'proced-send-signal) ; Dired compatibility

                   `[,(symbol-name format)
                     (proced-format-interactive ',format)
                     :style radio
                     :selected (eq proced-format ',format)]))
               proced-format-alist))
    ["Tree Display" proced-toggle-tree
     :style toggle
     :selected (eval proced-tree-flag)
     :help "Display Proced Buffer as Process Tree"]
    "--"
    ["Omit Marked Processes" proced-omit-processes
     :help "Omit Marked Processes in Process Listing."]
    "--"
    ["Revert" revert-buffer

The sort order of Proced listings is defined by the variable `proced-sort'.
Type \\[proced-sort-interactive] or click on a header in the header line
to change the sort scheme.  The current sort scheme is indicated in the
mode line, using \"+\" or \"-\" for ascending or descending sort order.

Type \\[proced-toggle-tree] to toggle whether the listing is
displayed as process tree.

An existing Proced listing can be refined by typing \\[proced-refine].
Refining an existing listing does not update the variable `proced-filter'.

The attribute-specific rules for formatting, filtering, sorting, and refining

  (interactive (list (proced-pid-at-point) current-prefix-arg))
  (proced-mark-process-alist
   (proced-filter-parents proced-process-alist cpid omit-cpid)))

(defun proced-mark-process-alist (process-alist &optional quiet)
  "Mark processes in PROCESS-ALIST.
If QUIET is non-nil suppress status message."
  (let ((count 0))
    (if process-alist
        (let (buffer-read-only)
          (save-excursion
            (goto-char (point-min))

  ;; only update if necessary
  (unless (eq proced-filter scheme)
    (setq proced-filter scheme)
    (proced-update t)))

(defun proced-children-alist (process-alist)
  "Return children alist for PROCESS-ALIST.
The children alist has elements (PPID PID1 PID2 ...).
PPID is a parent PID.  PID1, PID2, ... are the child processes of PPID.
The children alist inherits the sorting order from PROCESS-ALIST.
The list of children does not include grandchildren."
  ;; The PPIDs inherit the sorting order of PROCESS-ALIST.
  (let ((process-tree (mapcar (lambda (a) (list (car a))) process-alist))
        ppid)
    (dolist (process process-alist)
      (setq ppid (cdr (assq 'ppid (cdr process))))
      (if (and ppid
               ;; Ignore a PPID that equals PID.
               (/= ppid (car process))
               ;; Accept only PPIDs that correspond to members in PROCESS-ALIST.
               (assq ppid process-alist))
          (let ((temp-alist process-tree) elt)
            (while (setq elt (pop temp-alist))
              (when (eq ppid (car elt))
                (setq temp-alist nil)
                (setcdr elt (cons (car process) (cdr elt))))))))
    ;; The child processes inherit the sorting order of PROCESS-ALIST.
    (setq process-tree
          (mapcar (lambda (a) (cons (car a) (nreverse (cdr a))))
                  process-tree))))

(defun proced-process-tree (process-alist)
  "Return process tree for PROCESS-ALIST."
  (let ((proced-children-alist (proced-children-alist process-alist))
        pid-alist proced-process-tree)
    (while (setq pid-alist (pop proced-children-alist))
      (push (proced-process-tree-internal pid-alist) proced-process-tree))
    (nreverse proced-process-tree)))

(defun proced-process-tree-internal (pid-alist)
  "Helper function for `proced-process-tree'."
  (let ((cpid-list (cdr pid-alist)) cpid-alist cpid)
    (while (setq cpid (car cpid-list))
      (if (setq cpid-alist (assq cpid proced-children-alist))
          ;; Unprocessed part of process tree that needs to be
          ;; analyzed recursively.
          (progn
            (setq proced-children-alist
                  (assq-delete-all cpid proced-children-alist))
            (setcar cpid-list (proced-process-tree-internal cpid-alist)))
        ;; We already processed this subtree and take it "as is".
        (setcar cpid-list (assq cpid proced-process-tree))
        (setq proced-process-tree
              (assq-delete-all cpid proced-process-tree)))
      (pop cpid-list)))
  pid-alist)

(defun proced-toggle-tree (arg)
  "Change whether this Proced buffer is displayed as process tree.
With prefix ARG, display as process tree if ARG is positive, otherwise
do not display as process tree.  Sets the variable `proced-tree-flag'."
  (interactive (list (or current-prefix-arg 'toggle)))
  (setq proced-tree-flag
        (cond ((eq arg 'toggle) (not proced-tree-flag))
              (arg (> (prefix-numeric-value arg) 0))
              (t (not proced-tree-flag))))
  (proced-update)
  (message "Proced process tree display %s"
           (if proced-tree-flag "enabled" "disabled")))

(defun proced-tree (process-alist)
  "Display Proced buffer as process tree if `proced-tree-flag' is non-nil.
If `proced-tree-flag' is non-nil, convert PROCESS-ALIST into a linear
process tree with a time attribute.  Otherwise, remove the tree attribute."
  (if proced-tree-flag
      ;; add tree attribute
      (let ((process-tree (proced-process-tree process-alist))
            (proced-tree-indent 0)
            proced-process-tree pt)
        (while (setq pt (pop process-tree))
          (proced-tree-insert pt))
        (nreverse proced-process-tree))
    (let (new-alist)
      ;; remove tree attribute
      (dolist (process process-alist)
        (push (assq-delete-all 'tree process) new-alist))
      (nreverse new-alist))))

(defun proced-tree-insert (process-tree)
  "Helper function for `proced-tree'."
  (let ((pprocess (assq (car process-tree) proced-process-alist)))
    (push (append (list (car pprocess))
                  (list (cons 'tree proced-tree-indent))
                  (cdr pprocess))
          proced-process-tree)
    (if (cdr process-tree)
        (let ((proced-tree-indent (1+ proced-tree-indent)))
          (mapc 'proced-tree-insert (cdr process-tree))))))

(defun proced-filter-children (process-alist ppid &optional omit-ppid)
  "For PROCESS-ALIST return list of child processes of PPID.
This list includes PPID unless OMIT-PPID is non-nil."
  (let ((proced-children-alist (proced-children-alist process-alist))
        new-alist)
    (dolist (pid (proced-children-pids ppid))
      (push (assq pid process-alist) new-alist))
    (if omit-ppid
        (assq-delete-all ppid new-alist)
      new-alist)))

(defun proced-children-pids (ppid)
  "Return list of children PIDs of PPID (including PPID)."
  (let ((cpids (cdr (assq ppid proced-children-alist))))
    (if cpids
        (cons ppid (apply 'append (mapcar 'proced-children-pids cpids)))
      (list ppid))))

(defun proced-filter-parents (process-alist pid &optional omit-pid)
  "For PROCESS-ALIST return list of parent processes of PID.
This list includes PID unless OMIT-PID is non-nil."
  (let ((parent-list (unless omit-pid (list (assq pid process-alist))))
        (process (assq pid process-alist))
        ppid)
    (while (and (setq ppid (cdr (assq 'ppid (cdr process))))
                ;; Ignore a PPID that equals PID.
                (/= ppid pid)
                ;; Accept only PPIDs that correspond to members in PROCESS-ALIST.
                (setq process (assq ppid process-alist)))
      (setq pid ppid)
      (push process parent-list))
    parent-list))

;; Refining

;; Filters are used to select the processes in a new listing.

Return the sorted process list."
  ;; translate SORTER into a list of lists (KEY PREDICATE REVERSE)
  (setq proced-sort-internal
        (mapcar (lambda (arg)
                  (let ((grammar (assq arg proced-grammar-alist)))
                    (unless (nth 4 grammar)
                      (error "Attribute %s not sortable" (car grammar)))
                    (list arg (nth 4 grammar) (nth 5 grammar))))
                (cond ((listp sorter) sorter)
                      ((and (symbolp sorter)
                            (nth 6 (assq sorter proced-grammar-alist))))
                      ((symbolp sorter) (list sorter))

  adopt the sorting order defined for SCHEME in `proced-grammar-alist'.

Set variable `proced-sort' to SCHEME.  The current sort scheme is displayed
in the mode line, using \"+\" or \"-\" for ascending or descending order."
  (interactive
   (let* (choices
          (scheme (completing-read "Sort attribute: "
                                   (dolist (grammar proced-grammar-alist choices)
                                     (if (nth 4 grammar)
                                         (push (list (car grammar)) choices)))
                                   nil t)))
     (list (if (string= "" scheme) nil (intern scheme))
           ;; like 'toggle in `define-derived-mode'
           (or current-prefix-arg 'no-arg))))

  (setq proced-descend

  "Format attribute TTNAME, omitting path \"/dev/\"."
  ;; Does this work for all systems?
  (substring ttname (if (string-match "\\`/dev/" ttname)
                        (match-end 0) 0)))

(defun proced-format-tree (tree)
  "Format attribute TREE."
  (concat (make-string tree ?\s) (number-to-string tree)))

;; Proced assumes that every process occupies only one line in the listing.
(defun proced-format-args (args)
  "Format attribute ARGS.
Replace newline characters by \"^J\" (two characters)."
  (replace-regexp-in-string "\n" "^J" args))

  ;; If none of the alternatives is non-nil, the attribute is ignored
  ;; in the listing.
  (let ((standard-attributes
         (car (proced-process-attributes (list (emacs-pid)))))
        new-format fmi)
    (if proced-tree-flag (push (cons 'tree 0) standard-attributes))
    (dolist (fmt format)
      (if (symbolp fmt)
          (if (assq fmt standard-attributes)
              (push fmt new-format))
        (while (setq fmi (pop fmt))

             ;; Text properties:
             ;; We use the text property `proced-key' to store in each
             ;; field the corresponding key.
             ;; Of course, the sort predicate appearing in help-echo
             ;; is only part of the story.  But it gives the main idea.
             (hprops
              (if (nth 4 grammar)
                  (let ((descend (if (eq key sort-key) proced-descend (nth 5 grammar))))
                    `(proced-key ,key mouse-face highlight
                                 help-echo ,(format proced-header-help-echo
                                                    (if descend "-" "+")
                                                    (nth 1 grammar)
                                                    (if descend "descending" "ascending"))))))
             (refiner (nth 7 grammar))
             (fprops
              (cond ((functionp (car refiner))
                     `(proced-key ,key mouse-face highlight
                                  help-echo ,(format "mouse-2, RET: %s"

      (setq proced-process-alist (proced-process-attributes)))
  ;; filtering and sorting
  (setq proced-process-alist
        (proced-sort (proced-filter proced-process-alist proced-filter)
                     proced-sort proced-descend))

  ;; display as process tree?
  (setq proced-process-alist
        (proced-tree proced-process-alist))

  ;; It is useless to keep undo information if we revert, filter, or
  ;; refine the listing so that `proced-process-alist' has changed.
  ;; We could keep the undo information if we only re-sort the buffer.
  ;; Would that be useful?  Re-re-sorting is easy, too.