comparison lisp/proced.el @ 98172:87d64c3d48ac

(proced-mark-face, proced-marked-face) (proced-sort-header-face): Removed. (proced-font-lock-keywords): Simplified. (proced-format): Use face proced-sort-header. (proced-format-interactive, proced-sort-interactive) (proced-filter-interactive): Only call proced-update if the scheme has changed. (proced-sort-header): Use posn-actual-col-row.

98171:b9386bd24a89

  "Sort scheme for listing (internal format).")

(defvar proced-marker-char ?*		; the answer is 42
  "In proced, the current mark character.")

;; face and font-lock code taken from dired
(defgroup proced-faces nil
  "Faces used by Proced."
  :group 'proced
  :group 'faces)

(defface proced-mark
  '((t (:inherit font-lock-constant-face)))
  "Face used for proced marks."
  :group 'proced-faces)
(defvar proced-mark-face 'proced-mark
  "Face name used for proced marks.")

(defface proced-marked
  '((t (:inherit font-lock-warning-face)))
  "Face used for marked processes."
  :group 'proced-faces)
(defvar proced-marked-face 'proced-marked
  "Face name used for marked processes.")

(defface proced-sort-header
  '((t (:inherit font-lock-keyword-face)))
  "Face used for header of attribute used for sorting."
  :group 'proced-faces)
(defvar proced-sort-header-face 'proced-sort-header
  "Face name used for header of attribute used for sorting.")

(defvar proced-re-mark "^[^ \n]"
  "Regexp matching a marked line.
Important: the match ends just after the marker.")

(defconst proced-field-help-echo
  "mouse-2, RET: refine by attribute %s %s"
  "Help string shown when mouse is over a refinable field.")

(defvar proced-font-lock-keywords
  (list
   ;;
   ;; Proced marks.
   (list proced-re-mark '(0 proced-mark-face))
   ;;
   ;; Marked files.
   (list (concat "^[" (char-to-string proced-marker-char) "]")
         '(".+" (proced-move-to-goal-column) nil (0 proced-marked-face)))))

(defvar proced-mode-map
  (let ((km (make-sparse-keymap)))
    ;; moving
    (define-key km " " 'proced-next-line)

Set variable `proced-filter' to SCHEME.  Revert listing."
  (interactive
   (let ((scheme (completing-read "Filter: "
                                  proced-filter-alist nil t)))
     (list (if (string= "" scheme) nil (intern 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.

  (interactive
   (let ((scheme (completing-read "Sort attribute: "
                                  proced-grammar-alist nil t)))
     (list (if (string= "" scheme) nil (intern scheme))
           current-prefix-arg)))
  (setq proced-sort scheme)
  (proced-update revert))

(defun proced-sort-pcpu (&optional revert)
  "Sort Proced buffer by percentage CPU time (%CPU)."
  (interactive "P")
  (proced-sort-interactive 'pcpu revert))

(defun proced-sort-header (event &optional revert)
  "Sort Proced listing based on an attribute.
EVENT is a mouse event with starting position in the header line.
It is converted in the corresponding attribute key.
This updates the variable `proced-sort'."
  (interactive "e\nP")
  (let ((start (event-start event))
        col key)
    (save-selected-window
      (select-window (posn-window start))
      (setq col (+ (1- (car (posn-col-row start)))
                   (window-hscroll)))
      (when (and (<= 0 col) (< col (length proced-header-line)))
        (setq key (get-text-property col 'proced-key proced-header-line))
        (if key
            (proced-sort-interactive key revert)

                                                                (nth 7 grammar) ""))))
             value)

        ;; highlight the header of the sort column
        (if (eq key proced-sort)
            (setq hprops (append `(face ,proced-sort-header-face) hprops)))
        (goto-char (point-min))
        (cond ( ;; fixed width of output field
               (numberp (nth 3 grammar))
               (dolist (process process-alist)
                 (end-of-line)

  (interactive
   (let ((scheme (completing-read "Format: "
                                  proced-format-alist nil t)))
     (list (if (string= "" scheme) nil (intern scheme))
           current-prefix-arg)))
  (setq proced-format scheme)
  (proced-update revert))

;; generate listing

(defun proced-process-attributes ()
  "Return alist of attributes for each system process.

98172:87d64c3d48ac

  "Sort scheme for listing (internal format).")

(defvar proced-marker-char ?*		; the answer is 42
  "In proced, the current mark character.")

;; Faces and font-lock code taken from dired,
;; but face variables are deprecated for new code.
(defgroup proced-faces nil
  "Faces used by Proced."
  :group 'proced
  :group 'faces)

(defface proced-mark
  '((t (:inherit font-lock-constant-face)))
  "Face used for proced marks."
  :group 'proced-faces)

(defface proced-marked
  '((t (:inherit font-lock-warning-face)))
  "Face used for marked processes."
  :group 'proced-faces)

(defface proced-sort-header
  '((t (:inherit font-lock-keyword-face)))
  "Face used for header of attribute used for sorting."
  :group 'proced-faces)

(defvar proced-re-mark "^[^ \n]"
  "Regexp matching a marked line.
Important: the match ends just after the marker.")

(defconst proced-field-help-echo
  "mouse-2, RET: refine by attribute %s %s"
  "Help string shown when mouse is over a refinable field.")

(defvar proced-font-lock-keywords
  `(;; (Any) proced marks.
    (,proced-re-mark . 'proced-mark)
    ;; Processes marked with `proced-marker-char'
    ;; Should we make sure that only certain attributes are font-locked?
    (,(concat "^[" (char-to-string proced-marker-char) "]")
     ".+" (proced-move-to-goal-column) nil (0 'proced-marked))))

(defvar proced-mode-map
  (let ((km (make-sparse-keymap)))
    ;; moving
    (define-key km " " 'proced-next-line)

Set variable `proced-filter' to SCHEME.  Revert listing."
  (interactive
   (let ((scheme (completing-read "Filter: "
                                  proced-filter-alist nil t)))
     (list (if (string= "" scheme) nil (intern scheme)))))
  ;; 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.

  (interactive
   (let ((scheme (completing-read "Sort attribute: "
                                  proced-grammar-alist nil t)))
     (list (if (string= "" scheme) nil (intern scheme))
           current-prefix-arg)))
  ;; only update if necessary
  (when (or (not (eq proced-sort scheme)) revert)
    (setq proced-sort scheme)
    (proced-update revert)))

(defun proced-sort-pcpu (&optional revert)
  "Sort Proced buffer by percentage CPU time (%CPU)."
  (interactive "P")
  (proced-sort-interactive 'pcpu revert))

(defun proced-sort-header (event &optional revert)
  "Sort Proced listing based on an attribute.
EVENT is a mouse event with starting position in the header line.
It is converted in the corresponding attribute key.
This command updates the variable `proced-sort'."
  (interactive "e\nP")
  (let ((start (event-start event))
        col key)
    (save-selected-window
      (select-window (posn-window start))
      (setq col (+ (1- (car (posn-actual-col-row start)))
                   (window-hscroll)))
      (when (and (<= 0 col) (< col (length proced-header-line)))
        (setq key (get-text-property col 'proced-key proced-header-line))
        (if key
            (proced-sort-interactive key revert)

                                                                (nth 7 grammar) ""))))
             value)

        ;; highlight the header of the sort column
        (if (eq key proced-sort)
            (setq hprops (append '(face proced-sort-header) hprops)))
        (goto-char (point-min))
        (cond ( ;; fixed width of output field
               (numberp (nth 3 grammar))
               (dolist (process process-alist)
                 (end-of-line)

  (interactive
   (let ((scheme (completing-read "Format: "
                                  proced-format-alist nil t)))
     (list (if (string= "" scheme) nil (intern scheme))
           current-prefix-arg)))
  ;; only update if necessary
  (when (or (not (eq proced-format scheme)) revert)
    (setq proced-format scheme)
    (proced-update revert)))

;; generate listing

(defun proced-process-attributes ()
  "Return alist of attributes for each system process.