Mercurial > emacs
changeset 93491:15b2492faf63
(hebrew-calendar-elapsed-days): Dox fix.
(calendar-hebrew-date-is-visible-p): Extract some common code into
separate function.
(holiday-hebrew, mark-hebrew-calendar-date-pattern): Use it.
(calendar-hebrew-from-absolute, holiday-hanukkah)
(mark-hebrew-calendar-date-pattern): Reduce nesting of some lets.
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Tue, 01 Apr 2008 02:45:47 +0000 |
| parents | 2fd8322cee67 |
| children | 2fe1b51b8771 |
| files | lisp/calendar/cal-hebrew.el |
| diffstat | 1 files changed, 57 insertions(+), 77 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/calendar/cal-hebrew.el Tue Apr 01 02:44:52 2008 +0000 +++ b/lisp/calendar/cal-hebrew.el Tue Apr 01 02:45:47 2008 +0000 @@ -4,7 +4,7 @@ ;; 2008 Free Software Foundation, Inc. ;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu> -;; Edward M. Reingold <reingold@cs.uiuc.edu> +;; Edward M. Reingold <reingold@cs.uiuc.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Hebrew calendar, calendar, diary @@ -45,7 +45,8 @@ 12)) (defun hebrew-calendar-elapsed-days (year) - "Days from Sunday before start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR." + "Days to mean conjunction of Tishri of Hebrew YEAR. +Measured from Sunday before start of Hebrew calendar." (let* ((months-elapsed (+ (* 235 (/ (1- year) 19)) ; months in complete cycles so far (* 12 (% (1- year) 19)) ; regular months in this cycle @@ -133,16 +134,18 @@ (year (+ 3760 (extract-calendar-year greg-date))) (month (aref [9 10 11 12 1 2 3 4 7 7 7 8] (1- (extract-calendar-month greg-date)))) + (length (progn + (while (>= date (calendar-absolute-from-hebrew + (list 7 1 (1+ year)))) + (setq year (1+ year))) + (hebrew-calendar-last-month-of-year year))) day) - (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year)))) - (setq year (1+ year))) - (let ((length (hebrew-calendar-last-month-of-year year))) - (while (> date - (calendar-absolute-from-hebrew - (list month - (hebrew-calendar-last-day-of-month month year) - year))) - (setq month (1+ (% month length))))) + (while (> date + (calendar-absolute-from-hebrew + (list month + (hebrew-calendar-last-day-of-month month year) + year))) + (setq month (1+ (% month length)))) (setq day (1+ (- date (calendar-absolute-from-hebrew (list month 1 year))))) (list month day year))) @@ -265,12 +268,9 @@ (defvar displayed-month) ; from generate-calendar (defvar displayed-year) -;;;###holiday-autoload -(defun holiday-hebrew (month day string) - "Holiday on MONTH, DAY (Hebrew) called STRING. -If MONTH, DAY (Hebrew) is visible, the value returned is corresponding -Gregorian date in the form of the list (((month day year) STRING)). Returns -nil if it is not visible in the current calendar window." +(defun calendar-hebrew-date-is-visible-p (month day) + "Return non-nil if Hebrew MONTH DAY is visible in the calendar window. +Returns the corresponding Gregorian date." ;; This test is only to speed things up a bit; it works fine without it. (if (memq displayed-month ;; What this is doing is equivalent to +1,2,3,4,5 modulo 12, ie: @@ -325,7 +325,16 @@ (date (calendar-gregorian-from-absolute (calendar-absolute-from-hebrew (list month day year))))) (if (calendar-date-is-visible-p date) - (list (list date string)))))) + date)))) + +;;;###holiday-autoload +(defun holiday-hebrew (month day string) + "Holiday on MONTH, DAY (Hebrew) called STRING. +If MONTH, DAY (Hebrew) is visible, the value returned is corresponding +Gregorian date in the form of the list (((month day year) STRING)). Returns +nil if it is not visible in the current calendar window." + (let ((gdate (calendar-hebrew-date-is-visible-p month day))) + (if gdate (list (list gdate string))))) ;; h-r-h-e should be called from holidays code. (declare-function holiday-filter-visible-calendar "holidays" (l)) @@ -395,34 +404,35 @@ ;; This test is only to speed things up a bit, it works fine without it. (if (memq displayed-month '(10 11 12 1 2)) - (let ((m displayed-month) - (y displayed-year)) - (increment-calendar-month m y 1) - (let* ((h-y (extract-calendar-year + (let* ((m displayed-month) + (y displayed-year) + (h-y (progn + (increment-calendar-month m y 1) + (extract-calendar-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian - (list m (calendar-last-day-of-month m y) y))))) - (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y)))) - (holiday-filter-visible-calendar - (list - (list (calendar-gregorian-from-absolute (1- abs-h)) - "Erev Hanukkah") - (list (calendar-gregorian-from-absolute abs-h) - "Hanukkah (first day)") - (list (calendar-gregorian-from-absolute (1+ abs-h)) - "Hanukkah (second day)") - (list (calendar-gregorian-from-absolute (+ abs-h 2)) - "Hanukkah (third day)") - (list (calendar-gregorian-from-absolute (+ abs-h 3)) - "Hanukkah (fourth day)") - (list (calendar-gregorian-from-absolute (+ abs-h 4)) - "Hanukkah (fifth day)") - (list (calendar-gregorian-from-absolute (+ abs-h 5)) - "Hanukkah (sixth day)") - (list (calendar-gregorian-from-absolute (+ abs-h 6)) - "Hanukkah (seventh day)") - (list (calendar-gregorian-from-absolute (+ abs-h 7)) - "Hanukkah (eighth day)"))))))) + (list m (calendar-last-day-of-month m y) y)))))) + (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y)))) + (holiday-filter-visible-calendar + (list + (list (calendar-gregorian-from-absolute (1- abs-h)) + "Erev Hanukkah") + (list (calendar-gregorian-from-absolute abs-h) + "Hanukkah (first day)") + (list (calendar-gregorian-from-absolute (1+ abs-h)) + "Hanukkah (second day)") + (list (calendar-gregorian-from-absolute (+ abs-h 2)) + "Hanukkah (third day)") + (list (calendar-gregorian-from-absolute (+ abs-h 3)) + "Hanukkah (fourth day)") + (list (calendar-gregorian-from-absolute (+ abs-h 4)) + "Hanukkah (fifth day)") + (list (calendar-gregorian-from-absolute (+ abs-h 5)) + "Hanukkah (sixth day)") + (list (calendar-gregorian-from-absolute (+ abs-h 6)) + "Hanukkah (seventh day)") + (list (calendar-gregorian-from-absolute (+ abs-h 7)) + "Hanukkah (eighth day)")))))) ;;;###holiday-autoload (defun holiday-passover-etc () @@ -568,39 +578,9 @@ (list month day year))))) (if (calendar-date-is-visible-p date) (mark-visible-calendar-date date color))) - ;; Month and day in any year--this taken from the holiday stuff. - ;; This test is only to speed things up a bit, it works - ;; fine without it. - (if (memq displayed-month - (list - (if (< 11 month) (- month 11) (+ month 1)) - (if (< 10 month) (- month 10) (+ month 2)) - (if (< 9 month) (- month 9) (+ month 3)) - (if (< 8 month) (- month 8) (+ month 4)) - (if (< 7 month) (- month 7) (+ month 5)))) - (let ((m1 displayed-month) - (y1 displayed-year) - (m2 displayed-month) - (y2 displayed-year) - year) - (increment-calendar-month m1 y1 -1) - (increment-calendar-month m2 y2 1) - (let* ((start-date (calendar-absolute-from-gregorian - (list m1 1 y1))) - (end-date (calendar-absolute-from-gregorian - (list m2 - (calendar-last-day-of-month m2 y2) - y2))) - (hebrew-start (calendar-hebrew-from-absolute start-date)) - (hebrew-end (calendar-hebrew-from-absolute end-date)) - (hebrew-y1 (extract-calendar-year hebrew-start)) - (hebrew-y2 (extract-calendar-year hebrew-end))) - (setq year (if (< 6 month) hebrew-y2 hebrew-y1)) - (let ((date (calendar-gregorian-from-absolute - (calendar-absolute-from-hebrew - (list month day year))))) - (if (calendar-date-is-visible-p date) - (mark-visible-calendar-date date color))))))) + ;; Month and day in any year. + (let ((gdate (calendar-hebrew-date-is-visible-p month day))) + (if gdate (mark-visible-calendar-date gdate color)))) (calendar-mark-complex month day year 'calendar-hebrew-from-absolute color))))