(diary-omer, diary-yahrzeit, diary-rosh-hodesh, diary-parasha, diary-parasha):

Add optional MARK parameter, specifying what face or character to use
in the calendar display.  These will now return (MARK . ENTRY).

1 files changed, 97 insertions, 80 deletions

diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index 3ba6b438c63..9bd3886eb42 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -896,9 +896,12 @@ from the cursor position."
   "Hebrew calendar equivalent of date diary entry."
   (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
 
-(defun diary-omer ()
+(defun diary-omer (&optional mark)
   "Omer count diary entry.
-Entry applies if date is within 50 days after Passover."
+Entry applies if date is within 50 days after Passover.
+
+An optional parameter MARK specifies a face or single-character string to 
+use when highlighting the day in the calendar."
   (let* ((passover
           (calendar-absolute-from-hebrew
            (list 1 15 (+ (extract-calendar-year date) 3760))))
@@ -906,30 +909,34 @@ Entry applies if date is within 50 days after Passover."
          (week (/ omer 7))
          (day (% omer 7)))
     (if (and (> omer 0) (< omer 50))
-        (format "Day %d%s of the omer (until sunset)"
-                omer
-                (if (zerop week)
-                    ""
-                  (format ", that is, %d week%s%s"
-                          week
-                          (if (= week 1) "" "s")
-                          (if (zerop day)
-                              ""
-                            (format " and %d day%s"
-                                    day (if (= day 1) "" "s")))))))))
-
-(defun diary-yahrzeit (death-month death-day death-year)
+        (cons mark 
+              (format "Day %d%s of the omer (until sunset)"
+                      omer
+                      (if (zerop week)
+                          ""
+                        (format ", that is, %d week%s%s"
+                                week
+                                (if (= week 1) "" "s")
+                                (if (zerop day)
+                                    ""
+                                  (format " and %d day%s"
+                                          day (if (= day 1) "" "s"))))))))))
+
+(defun diary-yahrzeit (death-month death-day death-year &optional mark)
   "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
 Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
 to be the name of the person.  Date of death is on the *civil* calendar;
 although the date of death is specified by the civil calendar, the proper
 Hebrew calendar yahrzeit is determined.  If `european-calendar-style' is t, the
-order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR."
+order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR.
+
+An optional parameter MARK specifies a face or single-character string to 
+use when highlighting the day in the calendar."
   (let* ((h-date (calendar-hebrew-from-absolute
                   (calendar-absolute-from-gregorian
                    (if european-calendar-style
                        (list death-day death-month death-year)
-                   (list death-month death-day death-year)))))
+                     (list death-month death-day death-year)))))
          (h-month (extract-calendar-month h-date))
          (h-day (extract-calendar-day h-date))
          (h-year (extract-calendar-year h-date))
@@ -938,18 +945,22 @@ order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR."
          (diff (- yr h-year))
          (y (hebrew-calendar-yahrzeit h-date yr)))
     (if (and (> diff 0) (or (= y d) (= y (1+ d))))
-        (format "Yahrzeit of %s%s: %d%s anniversary"
-                entry
-                (if (= y d) "" " (evening)")
-                diff
-                (cond ((= (% diff 10) 1) "st")
-                      ((= (% diff 10) 2) "nd")
-                      ((= (% diff 10) 3) "rd")
-                      (t "th"))))))
-
-(defun diary-rosh-hodesh ()
+        (cons mark
+              (format "Yahrzeit of %s%s: %d%s anniversary"
+                      entry
+                      (if (= y d) "" " (evening)")
+                      diff
+                      (cond ((= (% diff 10) 1) "st")
+                            ((= (% diff 10) 2) "nd")
+                            ((= (% diff 10) 3) "rd")
+                            (t "th")))))))
+
+(defun diary-rosh-hodesh (&optional mark)
   "Rosh Hodesh diary entry.
-Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
+Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.
+
+An optional parameter MARK specifies a face or single-character string to 
+use when highlighting the day in the calendar."
   (let* ((d (calendar-absolute-from-gregorian date))
          (h-date (calendar-hebrew-from-absolute d))
          (h-month (extract-calendar-month h-date))
@@ -965,47 +976,52 @@ Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
          (h-yesterday (extract-calendar-day
                        (calendar-hebrew-from-absolute (1- d)))))
     (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
-        (format
-         "Rosh Hodesh %s"
-         (if (= h-day 30)
-             (format
-              "%s (first day)"
-              ;; next month must be in the same year since this
-              ;; month can't be the last month of the year since
-              ;; it has 30 days
-              (aref h-month-names h-month))
-           (if (= h-yesterday 30)
-               (format "%s (second day)" this-month)
-             this-month)))
-      (if (= (% d 7) 6);; Saturday--check for Shabbat Mevarchim
-          (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
-                 (format "Mevarchim Rosh Hodesh %s (%s)"
-                         (aref h-month-names
-                               (if (= h-month
-                                      (hebrew-calendar-last-month-of-year
-                                       h-year))
-                                   0 h-month))
-                         (aref calendar-day-name-array (- 29 h-day))))
-                ((and (< h-day 30) (> h-day 22) (= 30 last-day))
-                 (format "Mevarchim Rosh Hodesh %s (%s-%s)"
-                         (aref h-month-names h-month)
-                         (if (= h-day 29)
-                             "tomorrow"
-                           (aref calendar-day-name-array (- 29 h-day)))
-                         (aref calendar-day-name-array
-                               (% (- 30 h-day) 7)))))
+        (cons mark 
+              (format
+               "Rosh Hodesh %s"
+               (if (= h-day 30)
+                   (format
+                    "%s (first day)"
+                    ;; next month must be in the same year since this
+                    ;; month can't be the last month of the year since
+                    ;; it has 30 days
+                    (aref h-month-names h-month))
+                 (if (= h-yesterday 30)
+                     (format "%s (second day)" this-month)
+                   this-month))))
+      (if (= (% d 7) 6) ;; Saturday--check for Shabbat Mevarchim
+          (cons mark 
+                (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
+                       (format "Mevarchim Rosh Hodesh %s (%s)"
+                               (aref h-month-names
+                                     (if (= h-month
+                                            (hebrew-calendar-last-month-of-year
+                                             h-year))
+                                         0 h-month))
+                               (aref calendar-day-name-array (- 29 h-day))))
+                      ((and (< h-day 30) (> h-day 22) (= 30 last-day))
+                       (format "Mevarchim Rosh Hodesh %s (%s-%s)"
+                               (aref h-month-names h-month)
+                               (if (= h-day 29)
+                                   "tomorrow"
+                                 (aref calendar-day-name-array (- 29 h-day)))
+                               (aref calendar-day-name-array
+                                     (% (- 30 h-day) 7))))))
         (if (and (= h-day 29) (/= h-month 6))
-            (format "Erev Rosh Hodesh %s"
-                    (aref h-month-names
-                          (if (= h-month
-                                 (hebrew-calendar-last-month-of-year
-                                  h-year))
-                              0 h-month))))))))
-
-(defun diary-parasha ()
-  "Parasha diary entry--entry applies if date is a Saturday."
+            (cons (format "Erev Rosh Hodesh %s"
+                          (aref h-month-names
+                                (if (= h-month
+                                       (hebrew-calendar-last-month-of-year
+                                        h-year))
+                                    0 h-month)))))))))
+
+(defun diary-parasha (&optional mark)
+  "Parasha diary entry--entry applies if date is a Saturday.
+
+An optional parameter MARK specifies a face or single-character string to 
+use when highlighting the day in the calendar."
   (let ((d (calendar-absolute-from-gregorian date)))
-    (if (= (% d 7) 6);;  Saturday
+    (if (= (% d 7) 6) ;;  Saturday
         (let*
             ((h-year (extract-calendar-year
                       (calendar-hebrew-from-absolute d)))
@@ -1024,24 +1040,25 @@ Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
                          (t "regular")))
              (year-format
               (symbol-value
-               (intern (format "hebrew-calendar-year-%s-%s-%s";; keviah
+               (intern (format "hebrew-calendar-year-%s-%s-%s" ;; keviah
                                rosh-hashanah-day type passover-day))))
-             (first-saturday;; of Hebrew year
+             (first-saturday ;; of Hebrew year
               (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah)))
-             (saturday;; which Saturday of the Hebrew year
+             (saturday ;; which Saturday of the Hebrew year
               (/ (- d first-saturday) 7))
              (parasha (aref year-format saturday)))
           (if parasha
-              (format
-               "Parashat %s"
-               (if (listp parasha);; Israel differs from diaspora
-                   (if (car parasha)
-                       (format "%s (diaspora), %s (Israel)"
-                               (hebrew-calendar-parasha-name (car parasha))
-                               (hebrew-calendar-parasha-name (cdr parasha)))
-                     (format "%s (Israel)"
-                             (hebrew-calendar-parasha-name (cdr parasha))))
-                 (hebrew-calendar-parasha-name parasha))))))))
+              (cons mark
+                    (format
+                     "Parashat %s"
+                     (if (listp parasha) ;; Israel differs from diaspora
+                         (if (car parasha)
+                             (format "%s (diaspora), %s (Israel)"
+                                     (hebrew-calendar-parasha-name (car parasha))
+                                     (hebrew-calendar-parasha-name (cdr parasha)))
+                           (format "%s (Israel)"
+                                   (hebrew-calendar-parasha-name (cdr parasha))))
+                       (hebrew-calendar-parasha-name parasha)))))))))
 
 (defvar hebrew-calendar-parashiot-names
 ["Bereshith"   "Noah"      "Lech L'cha" "Vayera"    "Hayei Sarah" "Toledoth"