# HG changeset patch # User Roland Winkler # Date 1221410636 0 # Node ID 87d64c3d48ac37b432e4d4034ff72c39cca10771 # Parent b9386bd24a89bb59b78ad0d64dc3e41fd1773352 (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. diff -r b9386bd24a89 -r 87d64c3d48ac lisp/proced.el --- a/lisp/proced.el Sun Sep 14 11:28:27 2008 +0000 +++ b/lisp/proced.el Sun Sep 14 16:43:56 2008 +0000 @@ -271,7 +271,8 @@ (defvar proced-marker-char ?* ; the answer is 42 "In proced, the current mark character.") -;; face and font-lock code taken from dired +;; 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 @@ -281,22 +282,16 @@ '((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. @@ -328,14 +323,12 @@ "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))))) + `(;; (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))) @@ -786,8 +779,10 @@ (let ((scheme (completing-read "Filter: " proced-filter-alist nil t))) (list (if (string= "" scheme) nil (intern scheme))))) - (setq proced-filter scheme) - (proced-update t)) + ;; 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. @@ -976,8 +971,10 @@ proced-grammar-alist nil t))) (list (if (string= "" scheme) nil (intern scheme)) current-prefix-arg))) - (setq proced-sort scheme) - (proced-update revert)) + ;; 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)." @@ -1013,13 +1010,13 @@ "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'." +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-col-row 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)) @@ -1107,7 +1104,7 @@ ;; highlight the header of the sort column (if (eq key proced-sort) - (setq hprops (append `(face ,proced-sort-header-face) hprops))) + (setq hprops (append '(face proced-sort-header) hprops))) (goto-char (point-min)) (cond ( ;; fixed width of output field (numberp (nth 3 grammar)) @@ -1179,8 +1176,10 @@ proced-format-alist nil t))) (list (if (string= "" scheme) nil (intern scheme)) current-prefix-arg))) - (setq proced-format scheme) - (proced-update revert)) + ;; only update if necessary + (when (or (not (eq proced-format scheme)) revert) + (setq proced-format scheme) + (proced-update revert))) ;; generate listing