* calendar/todos.el: Display numerical priority string of top

priority items in category in a distinctive face.
(todos-prefix-string): Make doc string more precise.
(todos-top-priority): New defface.
(todos-done, todos-done-sep): Use more compact face definition
\(taken from font-lock.el).
(todos-comment): Give a complete face definition, instead of
inheriting from todos-done.
(todos-font-lock-keywords): Use todos-comment-face for
todos-comment-string-matcher.
(todos-prefix-overlays): Use todos-top-priority as the face
property of top priority items; don't condition reapplying item
prefix overlay on whether the string changed, since that prevents
updating display after changing number of top priorities.
(todos-set-top-priorities): Call todos-prefix-overlays to update
display.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5ac573dc06be5286861ab845b26daa4d6e211c20..9ca318515e9cadb81973b567bce6da64bbf66c98 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,22 @@
+2013-01-06  Stephen Berman  <stephen.berman@gmx.net>
+
+       * calendar/todos.el: Display numerical priority string of top
+       priority items in category in a distinctive face.
+       (todos-prefix-string): Make doc string more precise.
+       (todos-top-priority): New defface.
+       (todos-done, todos-done-sep): Use more compact face definition
+       \(taken from font-lock.el).
+       (todos-comment): Give a complete face definition, instead of
+       inheriting from todos-done.
+       (todos-font-lock-keywords): Use todos-comment-face for
+       todos-comment-string-matcher.
+       (todos-prefix-overlays): Use todos-top-priority as the face
+       property of top priority items; don't condition reapplying item
+       prefix overlay on whether the string changed, since that prevents
+       updating display after changing number of top priorities.
+       (todos-set-top-priorities): Call todos-prefix-overlays to update
+       display.
+
 2013-01-04  Stephen Berman  <Stephen.Berman@rub.de>
 
        * calendar/todos.el (todos-reset-global-current-todos-file)

diff --git a/lisp/calendar/todos.el b/lisp/calendar/todos.el
index f1876db459c27f7055d7777fa75d61cf0f0478d3..b956e7807ae0a166c2901a378041ed59e73d3772 100644 (file)
--- a/lisp/calendar/todos.el
+++ b/lisp/calendar/todos.el
@@ -614,7 +614,31 @@ categories display according to priority."
     (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
     (((class color) (min-colors 8)) (:foreground "magenta"))
     (t (:weight bold :underline t)))
-  "Face for Todos prefix string."
+  "Face for Todos prefix or numerical priority string."
+  :group 'todos-faces)
+
+(defface todos-top-priority
+  ;; '((t :inherit font-lock-comment-face))
+  '((((class grayscale) (background light))
+     :foreground "DimGray" :weight bold :slant italic)
+    (((class grayscale) (background dark))
+     :foreground "LightGray" :weight bold :slant italic)
+    (((class color) (min-colors 88) (background light))
+     :foreground "Firebrick" :weight bold)
+    (((class color) (min-colors 88) (background dark))
+     :foreground "chocolate1" :weight bold)
+    (((class color) (min-colors 16) (background light))
+     :foreground "red" :weight bold)
+    (((class color) (min-colors 16) (background dark))
+     :foreground "red1" :weight bold)
+    (((class color) (min-colors 8) (background light))
+     :foreground "red" :weight bold)
+    (((class color) (min-colors 8) (background dark))
+     :foreground "yellow" :weight bold)
+    (t :weight bold :slant italic))
+  "Face for top priority Todos item numerical priority string.
+The item's priority number string has this face if the number is
+less than or equal the category's top priority setting."
   :group 'todos-faces)
 
 (defface todos-mark
@@ -738,77 +762,51 @@ categories display according to priority."
 
 (defface todos-done
   ;; '((t :inherit font-lock-comment-face))
-  '((((class grayscale)
-      (background light))
-     (:slant italic :weight bold :foreground "DimGray"))
-    (((class grayscale)
-      (background dark))
-     (:slant italic :weight bold :foreground "LightGray"))
-    (((class color)
-      (min-colors 88)
-      (background light))
-     (:foreground "Firebrick"))
-    (((class color)
-      (min-colors 88)
-      (background dark))
-     (:foreground "chocolate1"))
-    (((class color)
-      (min-colors 16)
-      (background light))
-     (:foreground "red"))
-    (((class color)
-      (min-colors 16)
-      (background dark))
-     (:foreground "red1"))
-    (((class color)
-      (min-colors 8)
-      (background light))
-     (:foreground "red"))
-    (((class color)
-      (min-colors 8)
-      (background dark))
-     (:foreground "yellow"))
-    (t
-     (:slant italic :weight bold)))
+  '((((class grayscale) (background light))
+     :foreground "DimGray" :weight bold :slant italic)
+    (((class grayscale) (background dark))
+     :foreground "LightGray" :weight bold :slant italic)
+    (((class color) (min-colors 88) (background light))
+     :foreground "Firebrick")
+    (((class color) (min-colors 88) (background dark))
+     :foreground "chocolate1")
+    (((class color) (min-colors 16) (background light))
+     :foreground "red")
+    (((class color) (min-colors 16) (background dark))
+     :foreground "red1")
+    (((class color) (min-colors 8) (background light))
+     :foreground "red")
+    (((class color) (min-colors 8) (background dark))
+     :foreground "yellow")
+    (t :weight bold :slant italic))
   "Face for done Todos item header string."
   :group 'todos-faces)
 (defvar todos-done-face 'todos-done)
 
 (defface todos-comment
-  '((t :inherit todos-done))
+  ;; '((t :inherit font-lock-keyword-face))
+  '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
+    (((class grayscale) (background dark))  :foreground "DimGray" :weight bold)
+    (((class color) (min-colors 88) (background light)) :foreground "Purple")
+    (((class color) (min-colors 88) (background dark))  :foreground "Cyan1")
+    (((class color) (min-colors 16) (background light)) :foreground "Purple")
+    (((class color) (min-colors 16) (background dark))  :foreground "Cyan")
+    (((class color) (min-colors 8)) :foreground "cyan" :weight bold)
+    (t :weight bold))
   "Face for comments appended to done Todos items."
   :group 'todos-faces)
 (defvar todos-comment-face 'todos-comment)
 
 (defface todos-done-sep
   ;; '((t :inherit font-lock-type-face))
-  '((((class grayscale)
-      (background light))
-     (:weight bold :foreground "Gray90"))
-    (((class grayscale)
-      (background dark))
-     (:weight bold :foreground "DimGray"))
-    (((class color)
-      (min-colors 88)
-      (background light))
-     (:foreground "ForestGreen"))
-    (((class color)
-      (min-colors 88)
-      (background dark))
-     (:foreground "PaleGreen"))
-    (((class color)
-      (min-colors 16)
-      (background light))
-     (:foreground "ForestGreen"))
-    (((class color)
-      (min-colors 16)
-      (background dark))
-     (:foreground "PaleGreen"))
-    (((class color)
-      (min-colors 8))
-     (:foreground "green"))
-    (t
-     (:underline t :weight bold)))
+  '((((class grayscale) (background light)) :foreground "Gray90" :weight bold)
+    (((class grayscale) (background dark))  :foreground "DimGray" :weight bold)
+    (((class color) (min-colors 88) (background light)) :foreground "ForestGreen")
+    (((class color) (min-colors 88) (background dark))  :foreground "PaleGreen")
+    (((class color) (min-colors 16) (background light)) :foreground "ForestGreen")
+    (((class color) (min-colors 16) (background dark))  :foreground "PaleGreen")
+    (((class color) (min-colors 8)) :foreground "green")
+    (t :weight bold :underline t))
   "Face for separator string bewteen done and not done Todos items."
   :group 'todos-faces)
 (defvar todos-done-sep-face 'todos-done-sep)
@@ -904,7 +902,7 @@ mode following todo (not done) items."
    '(todos-date-string-matcher 1 todos-date-face t)
    '(todos-time-string-matcher 1 todos-time-face t)
    '(todos-done-string-matcher 0 todos-done-face t)
-   '(todos-comment-string-matcher 1 todos-done-face t)
+   '(todos-comment-string-matcher 1 todos-comment-face t)
    ;; '(todos-category-string-matcher 1 todos-done-sep-face t)
    '(todos-category-string-matcher-1 1 todos-done-sep-face t t)
    '(todos-category-string-matcher-2 1 todos-done-sep-face t t)
@@ -1535,7 +1533,7 @@ The final element is \"*\", indicating an unspecified month.")
   (todos-backward-item)
   (todos-prefix-overlays))
 
-(defun todos-prefix-overlays ()
+(defun todos-prefix-overlays ()                ;FIXME: this is a category function
   "Put before-string overlay in front of this category's items.
 The overlay's value is the string `todos-prefix' or with non-nil
 `todos-number-priorities' an integer in the sequence from 1 to
@@ -1546,7 +1544,12 @@ of each other."
            (not (string-match "^[[:space:]]*$" todos-prefix)))
     (let ((prefix (propertize (concat todos-prefix " ")
                              'face 'todos-prefix-string))
-         (num 0))
+         (num 0)
+         (cat-tp (or (cdr (assoc-string (todos-current-category)
+                      (nth 2 (assoc-string todos-current-todos-file
+                                           todos-priorities-rules))))
+                     todos-show-priorities))
+         done)
       (save-excursion
        (goto-char (point-min))
        (while (not (eobp))
@@ -1560,9 +1563,13 @@ of each other."
                         (looking-back (concat "^"
                                               (regexp-quote todos-category-done)
                                               "\n")))
-               (setq num 1))
+               (setq num 1
+                     done t))
              (setq prefix (propertize (concat (number-to-string num) " ")
-                                      'face 'todos-prefix-string)))
+                                      'face
+                                      (if (and (not done) (<= num cat-tp))
+                                          'todos-top-priority ; make defface
+                                        'todos-prefix-string))))
            (let ((ovs (overlays-in (point) (point)))
                  marked ov-pref)
              (if ovs
@@ -1571,14 +1578,17 @@ of each other."
                      (if (equal val "*")
                          (setq marked t)
                        (setq ov-pref val)))))
-             (unless (equal ov-pref prefix)
+             ;; Omitting this condition doesn't appear to slow
+             ;; redisplay down, while having it prevents updating
+             ;; display after changing number of top priorities.
+             ;; (unless (equal ov-pref prefix)
                ;; Why doesn't this work?
                ;; (remove-overlays (point) (point) 'before-string)
-               (remove-overlays (point) (point))
-               (overlay-put (make-overlay (point) (point))
-                            'before-string prefix)
-               (and marked (overlay-put (make-overlay (point) (point))
-                                        'before-string todos-item-mark)))))
+             (remove-overlays (point) (point))
+             (overlay-put (make-overlay (point) (point))
+                          'before-string prefix)
+             (and marked (overlay-put (make-overlay (point) (point))
+                                      'before-string todos-item-mark))));)
          (forward-line))))))
 
 ;; ---------------------------------------------------------------------------
@@ -2104,7 +2114,8 @@ set the user customizable option `todos-priorities-rules'."
                          (list file cur nrule)
                        nrule)
                      (delete frule rules)))
-    (customize-save-variable 'todos-priorities-rules rules)))
+    (customize-save-variable 'todos-priorities-rules rules)
+    (todos-prefix-overlays)))
 
 (defun todos-filtered-buffer-name (buffer-type file-list)
   "Rename Todos filtered buffer using BUFFER-TYPE and FILE-LIST.