changeset 80700:46a4abfd98ce

(holiday-bahai): Use an algorithm actually relevant to this calendar system (sync from trunk 2008-03-31). (calendar-bahai-date-string): Avoid an error for pre-Bahai dates (sync from trunk 2008-03-31). (calendar-print-bahai-date): Handle pre-Bahai dates (sync from trunk 2008-03-20). (calendar-absolute-from-bahai): Fix the leap-year case (sync from trunk 2008-03-20).
author Glenn Morris <rgm@gnu.org>
date Sun, 10 Aug 2008 20:06:08 +0000
parents 2ba6b3010dbe
children 79edb264c830
files lisp/calendar/cal-bahai.el
diffstat 1 files changed, 46 insertions(+), 30 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/calendar/cal-bahai.el	Sun Aug 10 20:05:45 2008 +0000
+++ b/lisp/calendar/cal-bahai.el	Sun Aug 10 20:06:08 2008 +0000
@@ -94,7 +94,9 @@
        (* 365 (1- year))		; Days in prior years.
        leap-days
        (calendar-sum m 1 (< m month) 19)
-       (if (= month 19) 4 0)
+       (if (= month 19)
+           (if (bahai-calendar-leap-year-p year) 5 4)
+         0)
        day)))				; Days so far this month.
 
 (defun calendar-bahai-from-absolute (date)
@@ -127,27 +129,31 @@
          (y (extract-calendar-year bahai-date))
          (m (extract-calendar-month bahai-date))
          (d (extract-calendar-day bahai-date)))
-    (let ((monthname
-	   (if (and (= m 19)
-		    (<= d 0))
-	       "Ayyam-i-Ha"
-	     (aref bahai-calendar-month-name-array (1- m))))
-	  (day (int-to-string
-		(if (<= d 0)
-		    (if (bahai-calendar-leap-year-p y)
-			(+ d 5)
-		      (+ d 4))
-		  d)))
-	  (dayname nil)
-	  (month (int-to-string m))
-	  (year (int-to-string y)))
-      (mapconcat 'eval calendar-date-display-form ""))))
+    (if (< y 1)
+        ""                              ; pre-Bahai
+      (let ((monthname
+             (if (and (= m 19)
+                      (<= d 0))
+                 "Ayyam-i-Ha"
+               (aref bahai-calendar-month-name-array (1- m))))
+            (day (int-to-string
+                  (if (<= d 0)
+                      (if (bahai-calendar-leap-year-p y)
+                          (+ d 5)
+                        (+ d 4))
+                    d)))
+            (dayname nil)
+            (month (int-to-string m))
+            (year (int-to-string y)))
+        (mapconcat 'eval calendar-date-display-form "")))))
 
 (defun calendar-print-bahai-date ()
   "Show the Baha'i calendar equivalent of the selected date."
   (interactive)
-  (message "Baha'i date: %s"
-           (calendar-bahai-date-string (calendar-cursor-to-date t))))
+  (let ((s (calendar-bahai-date-string (calendar-cursor-to-date t))))
+   (if (string-equal s "")
+       (message "Date is pre-Baha'i")
+     (message "Baha'i date: %s" s))))
 
 (defun calendar-goto-bahai-date (date &optional noecho)
   "Move cursor to Baha'i date DATE.
@@ -186,23 +192,33 @@
 
 (defun holiday-bahai (month day string)
   "Holiday on MONTH, DAY (Baha'i) called STRING.
-If MONTH, DAY (Baha'i) 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."
+If MONTH, DAY (Baha'i) is visible in the current calendar window,
+returns the corresponding Gregorian date in the form of the
+list (((month day year) STRING)).  Otherwise, returns nil."
+  ;; Since the calendar window shows 3 months at a time, there are
+  ;; approx +/- 45 days either side of the central month.
+  ;; Since the Bahai months have 19 days, this means up to +/- 3 months.
   (let* ((bahai-date (calendar-bahai-from-absolute
 		      (calendar-absolute-from-gregorian
 		       (list displayed-month 15 displayed-year))))
          (m (extract-calendar-month bahai-date))
          (y (extract-calendar-year bahai-date))
-	 (date))
-    (if (< m 1)
-        nil ;;   Baha'i calendar doesn't apply.
-      (increment-calendar-month m y (- 10 month))
-      (if (> m 7) ;;  Baha'i date might be visible
-          (let ((date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-bahai (list month day y)))))
-            (if (calendar-date-is-visible-p date)
-                (list (list date string))))))))
+	 date)
+    (unless (< m 1)                    ; Baha'i calendar doesn't apply
+      ;; Cf holiday-fixed, holiday-islamic.
+      ;; With a +- 3 month calendar window, and 19 months per year,
+      ;; month 16 is special.  When m16 is central is when the
+      ;; end-of-year first appears.  When m1 is central, m16 is no
+      ;; longer visible.  Hence we can do a one-sided test to see if
+      ;; m16 is visible.  m16 is visible when the central month >= 13.
+      ;; To see if other months are visible we can shift the range
+      ;; accordingly.
+      (calendar-increment-month m y (- 16 month) 19)
+      (and (> m 12)                     ; Baha'i date might be visible
+           (calendar-date-is-visible-p
+            (setq date (calendar-gregorian-from-absolute
+                        (calendar-absolute-from-bahai (list month day y)))))
+           (list (list date string))))))
 
 (defun list-bahai-diary-entries ()
   "Add any Baha'i date entries from the diary file to `diary-entries-list'.