Mercurial > emacs
changeset 46619:5d2941da3ed1
(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).
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Mon, 22 Jul 2002 15:31:13 +0000 |
| parents | 6edefbc65dc4 |
| children | f367f20901c0 |
| files | lisp/calendar/cal-hebrew.el |
| diffstat | 1 files changed, 94 insertions(+), 77 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/calendar/cal-hebrew.el Mon Jul 22 15:30:43 2002 +0000 +++ b/lisp/calendar/cal-hebrew.el Mon Jul 22 15:31:13 2002 +0000 @@ -896,9 +896,12 @@ "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 @@ (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"))))))))) + (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) +(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 @@ (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")))))) + (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 () +(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 @@ (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)))))))) + (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 () - "Parasha diary entry--entry applies if date is a Saturday." +(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 @@ (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"