New feature: custom faces for diary sexps in calendar

[Alan Shutko]

I wanted to be able to color days differently in the calendar based
on the type of event they were, so I could tell at a glance when my
anniversary was, when I was on vacation, when I was on call for work.
So I've added the option to specify the marking (see
`mark-visible-calendar-date') when entering a sexp into your diary.

Now I can do 

%%(diary-anniversary 7 17 1999 'font-lock-warning-face) Our %d%s Anniversary

and be sure not to conflate my anniversary with a conference call.

Here's the patch.  It seems long, but most of it is just updating doc
strings.  If this would be ok for inclusion in Emacs, I'll do the
changes to the manual to document it.

2002-07-12  Alan Shutko  <address@hidden>

        * calendar/diary-lib.el (mark-sexp-diary-entries): Retrieve mark
        from diary-sexp-entry and pass it to mark-visible-calendar-date.
        (list-sexp-diary-entries): Update doc string for new docs for
        diary-date, diary-block, diary-float, diary-anniversary, and
        diary-cyclic.  If diary-sexp-entry returns a cons, only add
        the text to the diary list.
        (diary-sexp-entry): Allow sexps to return a cons of the form (MARK
        . STRING) to specify what face or character mark should be used in
        the calendar display.
        (diary-date, diary-block, diary-float, diary-anniversary) 
        (diary-cyclic): Add optional MARK parameter, specifying what face
        or character to use in the calendar display.  If MARK is non-nil,
        these will return (MARK . ENTRY).

Index: diary-lib.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/calendar/diary-lib.el,v
retrieving revision 1.54
diff -u -c -r1.54 diary-lib.el
*** diary-lib.el        22 Apr 2002 07:51:28 -0000      1.54
--- diary-lib.el        12 Jul 2002 15:31:51 -0000
***************
*** 808,814 ****
           (m)
           (y)
           (first-date)
!          (last-date))
      (save-excursion
        (set-buffer calendar-buffer)
        (setq m displayed-month)
--- 808,815 ----
           (m)
           (y)
           (first-date)
!          (last-date)
!          (mark))
      (save-excursion
        (set-buffer calendar-buffer)
        (setq m displayed-month)
***************
*** 856,865 ****
            (while (string-match "[\^M]" entry)
              (aset entry (match-beginning 0) ?\n )))
          (calendar-for-loop date from first-date to last-date do
!           (if (diary-sexp-entry sexp entry
!                                 (calendar-gregorian-from-absolute date))
                (mark-visible-calendar-date
!                (calendar-gregorian-from-absolute date))))))))
  
  (defun mark-included-diary-files ()
    "Mark the diary entries from other diary files with those of the diary file.
--- 857,868 ----
            (while (string-match "[\^M]" entry)
              (aset entry (match-beginning 0) ?\n )))
          (calendar-for-loop date from first-date to last-date do
!           (if (setq mark (diary-sexp-entry sexp entry
!                                 (calendar-gregorian-from-absolute date)))
                (mark-visible-calendar-date
!                (calendar-gregorian-from-absolute date) 
!                (if (consp mark)
!                    (car mark)))))))))
  
  (defun mark-included-diary-files ()
    "Mark the diary entries from other diary files with those of the diary file.
***************
*** 1020,1048 ****
  
  A number of built-in functions are available for this type of diary entry:
  
!       %%(diary-date MONTH DAY YEAR) text
                    Entry applies if date is MONTH, DAY, YEAR if
                    `european-calendar-style' is nil, and DAY, MONTH, YEAR if
                    `european-calendar-style' is t.  DAY, MONTH, and YEAR
                    can be lists of integers, the constant t, or an integer.
!                   The constant t means all values.
  
!       %%(diary-float MONTH DAYNAME N &optional DAY) text
                    Entry will appear on the Nth DAYNAME of MONTH.
                    (DAYNAME=0 means Sunday, 1 means Monday, and so on;
                    if N is negative it counts backward from the end of
                    the month.  MONTH can be a list of months, a single
                    month, or t to specify all months. Optional DAY means
                    Nth DAYNAME of MONTH on or after/before DAY.  DAY defaults
!                   to 1 if N>0 and the last day of the month if N<0.
  
!       %%(diary-block M1 D1 Y1 M2 D2 Y2) text
                    Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
                    inclusive.  (If `european-calendar-style' is t, the
                    order of the parameters should be changed to D1, M1, Y1,
!                   D2, M2, Y2.)
  
!       %%(diary-anniversary MONTH DAY YEAR) text
                    Entry will appear on anniversary dates of MONTH DAY, YEAR.
                    (If `european-calendar-style' is t, the order of the
                    parameters should be changed to DAY, MONTH, YEAR.)  Text
--- 1023,1057 ----
  
  A number of built-in functions are available for this type of diary entry:
  
!       %%(diary-date MONTH DAY YEAR &optional MARK) text
                    Entry applies if date is MONTH, DAY, YEAR if
                    `european-calendar-style' is nil, and DAY, MONTH, YEAR if
                    `european-calendar-style' is t.  DAY, MONTH, and YEAR
                    can be lists of integers, the constant t, or an integer.
!                   The constant t means all values.  An optional parameter 
!                   MARK specifies a face or single-character string to use
!                   when highlighting the day in the calendar.
  
!       %%(diary-float MONTH DAYNAME N &optional DAY MARK) text
                    Entry will appear on the Nth DAYNAME of MONTH.
                    (DAYNAME=0 means Sunday, 1 means Monday, and so on;
                    if N is negative it counts backward from the end of
                    the month.  MONTH can be a list of months, a single
                    month, or t to specify all months. Optional DAY means
                    Nth DAYNAME of MONTH on or after/before DAY.  DAY defaults
!                   to 1 if N>0 and the last day of the month if N<0.  An 
!                   optional parameter MARK specifies a face or 
single-character 
!                   string to use when highlighting the day in the calendar.
  
!       %%(diary-block M1 D1 Y1 M2 D2 Y2 &optional MARK) text
                    Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
                    inclusive.  (If `european-calendar-style' is t, the
                    order of the parameters should be changed to D1, M1, Y1,
!                   D2, M2, Y2.)  An optional parameter MARK specifies a face 
!                   or single-character string to use when highlighting the 
!                   day in the calendar.
  
!       %%(diary-anniversary MONTH DAY YEAR &optional MARK) text
                    Entry will appear on anniversary dates of MONTH DAY, YEAR.
                    (If `european-calendar-style' is t, the order of the
                    parameters should be changed to DAY, MONTH, YEAR.)  Text
***************
*** 1050,1065 ****
                    of years since the MONTH DAY, YEAR and %s will be replaced
                    by the ordinal ending of that number (that is, `st', `nd',
                    `rd' or `th', as appropriate.  The anniversary of February
!                   29 is considered to be March 1 in a non-leap year.
  
!       %%(diary-cyclic N MONTH DAY YEAR) text
                    Entry will appear every N days, starting MONTH DAY, YEAR.
                    (If `european-calendar-style' is t, the order of the
                    parameters should be changed to N, DAY, MONTH, YEAR.)  Text
                    can contain %d or %d%s; %d will be replaced by the number
                    of repetitions since the MONTH DAY, YEAR and %s will
                    be replaced by the ordinal ending of that number (that is,
!                   `st', `nd', `rd' or `th', as appropriate.
  
        %%(diary-remind SEXP DAYS &optional MARKING) text
                    Entry is a reminder for diary sexp SEXP.  DAYS is either a
--- 1059,1078 ----
                    of years since the MONTH DAY, YEAR and %s will be replaced
                    by the ordinal ending of that number (that is, `st', `nd',
                    `rd' or `th', as appropriate.  The anniversary of February
!                   29 is considered to be March 1 in a non-leap year.  An 
!                   optional parameter MARK specifies a face or 
single-character 
!                   string to use when highlighting the day in the calendar.
  
!       %%(diary-cyclic N MONTH DAY YEAR &optional MARK) text
                    Entry will appear every N days, starting MONTH DAY, YEAR.
                    (If `european-calendar-style' is t, the order of the
                    parameters should be changed to N, DAY, MONTH, YEAR.)  Text
                    can contain %d or %d%s; %d will be replaced by the number
                    of repetitions since the MONTH DAY, YEAR and %s will
                    be replaced by the ordinal ending of that number (that is,
!                   `st', `nd', `rd' or `th', as appropriate.  An optional 
!                   parameter MARK specifies a face or single-character string 
!                   to use when highlighting the day in the calendar.
  
        %%(diary-remind SEXP DAYS &optional MARKING) text
                    Entry is a reminder for diary sexp SEXP.  DAYS is either a
***************
*** 1184,1191 ****
          (let ((diary-entry (diary-sexp-entry sexp entry date)))
            (if diary-entry
                (subst-char-in-region line-start (point) ?\^M ?\n t))
!           (add-to-diary-list date diary-entry specifier)
!           (setq entry-found (or entry-found diary-entry)))))
      entry-found))
  
  (defun diary-sexp-entry (sexp entry date)
--- 1197,1208 ----
          (let ((diary-entry (diary-sexp-entry sexp entry date)))
            (if diary-entry
                (subst-char-in-region line-start (point) ?\^M ?\n t))
!           (add-to-diary-list date 
!                            (if (consp diary-entry)
!                                (cdr diary-entry)
!                              diary-entry)
!                            specifier)
!         (setq entry-found (or entry-found diary-entry)))))
      entry-found))
  
  (defun diary-sexp-entry (sexp entry date)
***************
*** 1208,1225 ****
                                      lines)))
                                diary-file sexp)
                       (sleep-for 2))))))
!     (if (stringp result)
!         result
!       (if result
!           entry
!         nil))))
  
! (defun diary-date (month day year)
    "Specific date(s) diary entry.
  Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil,
  and DAY, MONTH, YEAR if `european-calendar-style' is t.  DAY, MONTH, and YEAR
  can be lists of integers, the constant t, or an integer.  The constant t means
! all values."
    (let* ((dd (if european-calendar-style
                  month
                day))
--- 1225,1245 ----
                                      lines)))
                                diary-file sexp)
                       (sleep-for 2))))))
!     (cond ((stringp result) result)
!         ((and (consp result)
!               (stringp (cdr result))) result)
!         (result entry)
!           (t nil))))
  
! (defun diary-date (month day year &optional mark)
    "Specific date(s) diary entry.
  Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil,
  and DAY, MONTH, YEAR if `european-calendar-style' is t.  DAY, MONTH, and YEAR
  can be lists of integers, the constant t, or an integer.  The constant t means
! all values.
! 
! An optional parameter MARK specifies a face or single-character string to 
! use when highlighting the day in the calendar."
    (let* ((dd (if european-calendar-style
                  month
                day))
***************
*** 1241,1252 ****
               (eq year t)))
          entry)))
  
! (defun diary-block (m1 d1 y1 m2 d2 y2)
    "Block diary entry.
  Entry applies if date is between, or on one of, two dates.
  The order of the parameters is
  M1, D1, Y1, M2, D2, Y2 if `european-calendar-style' is nil, and
! D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t."
    (let ((date1 (calendar-absolute-from-gregorian
                  (if european-calendar-style
                      (list d1 m1 y1)
--- 1261,1276 ----
               (eq year t)))
          entry)))
  
! (defun diary-block (m1 d1 y1 m2 d2 y2 &optional mark)
    "Block diary entry.
  Entry applies if date is between, or on one of, two dates.
  The order of the parameters is
  M1, D1, Y1, M2, D2, Y2 if `european-calendar-style' is nil, and
! D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t.
! 
! An optional parameter MARK specifies a face or single-character string to 
! use when highlighting the day in the calendar."
! 
    (let ((date1 (calendar-absolute-from-gregorian
                  (if european-calendar-style
                      (list d1 m1 y1)
***************
*** 1257,1271 ****
                    (list m2 d2 y2))))
          (d (calendar-absolute-from-gregorian date)))
      (if (and (<= date1 d) (<= d date2))
!         entry)))
  
! (defun diary-float (month dayname n &optional day)
    "Floating diary entry--entry applies if date is the nth dayname of month.
  Parameters are MONTH, DAYNAME, N.  MONTH can be a list of months, the constant
  t, or an integer.  The constant t means all months.  If N is negative, count
  backward from the end of the month.
  
! An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY."
  ;; This is messy because the diary entry may apply, but the date on which it
  ;; is based can be in a different month/year.  For example, asking for the
  ;; first Monday after December 30.  For large values of |n| the problem is
--- 1281,1297 ----
                    (list m2 d2 y2))))
          (d (calendar-absolute-from-gregorian date)))
      (if (and (<= date1 d) (<= d date2))
!         (cons mark entry))))
  
! (defun diary-float (month dayname n &optional day mark)
    "Floating diary entry--entry applies if date is the nth dayname of month.
  Parameters are MONTH, DAYNAME, N.  MONTH can be a list of months, the constant
  t, or an integer.  The constant t means all months.  If N is negative, count
  backward from the end of the month.
  
! An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY.
! Optional MARK specifies a face or single-character string to use when 
! highlighting the day in the calendar."
  ;; This is messy because the diary entry may apply, but the date on which it
  ;; is based can be in a different month/year.  For example, asking for the
  ;; first Monday after December 30.  For large values of |n| the problem is
***************
*** 1319,1328 ****
                                            1
                                          (calendar-last-day-of-month m2 y2)))
                                d2)))))
!            entry))))
  
  
! (defun diary-anniversary (month day year)
    "Anniversary diary entry.
  Entry applies if date is the anniversary of MONTH, DAY, YEAR if
  `european-calendar-style' is nil, and DAY, MONTH, YEAR if
--- 1345,1354 ----
                                            1
                                          (calendar-last-day-of-month m2 y2)))
                                d2)))))
!            (cons mark entry)))))
  
  
! (defun diary-anniversary (month day year &optional mark)
    "Anniversary diary entry.
  Entry applies if date is the anniversary of MONTH, DAY, YEAR if
  `european-calendar-style' is nil, and DAY, MONTH, YEAR if
***************
*** 1330,1336 ****
  %d will be replaced by the number of years since the MONTH DAY, YEAR and the
  %s will be replaced by the ordinal ending of that number (that is, `st', `nd',
  `rd' or `th', as appropriate.  The anniversary of February 29 is considered
! to be March 1 in non-leap years."
    (let* ((d (if european-calendar-style
                  month
                day))
--- 1356,1365 ----
  %d will be replaced by the number of years since the MONTH DAY, YEAR and the
  %s will be replaced by the ordinal ending of that number (that is, `st', `nd',
  `rd' or `th', as appropriate.  The anniversary of February 29 is considered
! to be March 1 in non-leap years.
! 
! An optional parameter MARK specifies a face or single-character string to 
! use when highlighting the day in the calendar."
    (let* ((d (if european-calendar-style
                  month
                day))
***************
*** 1343,1357 ****
          (setq m 3
                d 1))
      (if (and (> diff 0) (calendar-date-equal (list m d y) date))
!         (format entry diff (diary-ordinal-suffix diff)))))
  
! (defun diary-cyclic (n month day year)
    "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
  If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR.
  ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of
  repetitions since the MONTH DAY, YEAR and %s will be replaced by the
  ordinal ending of that number (that is, `st', `nd', `rd' or `th', as
! appropriate."
    (let* ((d (if european-calendar-style
                  month
                day))
--- 1372,1389 ----
          (setq m 3
                d 1))
      (if (and (> diff 0) (calendar-date-equal (list m d y) date))
!         (cons mark (format entry diff (diary-ordinal-suffix diff))))))
  
! (defun diary-cyclic (n month day year &optional mark)
    "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
  If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR.
  ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of
  repetitions since the MONTH DAY, YEAR and %s will be replaced by the
  ordinal ending of that number (that is, `st', `nd', `rd' or `th', as
! appropriate.
! 
! An optional parameter MARK specifies a face or single-character string to 
! use when highlighting the day in the calendar."
    (let* ((d (if european-calendar-style
                  month
                day))
***************
*** 1363,1369 ****
                     (list m d year))))
           (cycle (/ diff n)))
      (if (and (>= diff 0) (zerop (% diff n)))
!         (format entry cycle (diary-ordinal-suffix cycle)))))
  
  (defun diary-ordinal-suffix (n)
    "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as 
appropriate.)"
--- 1395,1401 ----
                     (list m d year))))
           (cycle (/ diff n)))
      (if (and (>= diff 0) (zerop (% diff n)))
!         (cons mark (format entry cycle (diary-ordinal-suffix cycle))))))
  
  (defun diary-ordinal-suffix (n)
    "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as 
appropriate.)"


-- 
Alan Shutko <address@hidden> - In a variety of flavors!
Frogs have it easy -- They can eat what bugs them.