aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-03-20 04:38:27 +0000
committerGlenn Morris2008-03-20 04:38:27 +0000
commit06e9110e45e25b1f6b83fdc4e6d8c678c1e3020e (patch)
tree14f2a4824c030ed77f66e800d85497e3d93029ff
parent01633b01c6ffaf5912f5b40922d5bd43b5bde7f4 (diff)
downloademacs-06e9110e45e25b1f6b83fdc4e6d8c678c1e3020e.tar.gz
emacs-06e9110e45e25b1f6b83fdc4e6d8c678c1e3020e.zip
(calendar-bahai-leap-year-p)
(calendar-bahai-leap-base, calendar-bahai-from-absolute): Doc fixes. (calendar-absolute-from-bahai): Fix the leap-year case. (calendar-bahai-from-absolute): Store the month. (calendar-bahai-date-string, calendar-bahai-print-date): Handle pre-Bahai dates.
-rw-r--r--lisp/calendar/cal-bahai.el35
1 files changed, 20 insertions, 15 deletions
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index d92cab52c1e..8a24ffae108 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -67,12 +67,13 @@
67 "Absolute date of start of Bahá'í calendar = March 19, 622 AD (Julian).") 67 "Absolute date of start of Bahá'í calendar = March 19, 622 AD (Julian).")
68 68
69(defun calendar-bahai-leap-year-p (year) 69(defun calendar-bahai-leap-year-p (year)
70 "True if YEAR is a leap year on the Bahá'í calendar." 70 "True if Bahá'í YEAR is a leap year in the Bahá'í calendar."
71 (calendar-leap-year-p (+ year 1844))) 71 (calendar-leap-year-p (+ year 1844)))
72 72
73(defconst calendar-bahai-leap-base 73(defconst calendar-bahai-leap-base
74 (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400)) 74 (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400))
75 "Used by `calendar-absolute-from-bahai'.") 75 "Number of leap years between 1 and 1844 AD, inclusive.
76Used by `calendar-absolute-from-bahai'.")
76 77
77(defun calendar-absolute-from-bahai (date) 78(defun calendar-absolute-from-bahai (date)
78 "Compute absolute date from Bahá'í date DATE. 79 "Compute absolute date from Bahá'í date DATE.
@@ -90,24 +91,25 @@ Gregorian date Sunday, December 31, 1 BC."
90 (* 365 (1- year)) ; days in prior years 91 (* 365 (1- year)) ; days in prior years
91 leap-days 92 leap-days
92 (calendar-sum m 1 (< m month) 19) 93 (calendar-sum m 1 (< m month) 19)
93 (if (= month 19) 4 0) 94 (if (= month 19)
95 (if (calendar-bahai-leap-year-p year) 5 4)
96 0)
94 day))) ; days so far this month 97 day))) ; days so far this month
95 98
96(defun calendar-bahai-from-absolute (date) 99(defun calendar-bahai-from-absolute (date)
97 "Bahá'í year corresponding to the absolute DATE." 100 "Bahá'í date (month day year) corresponding to the absolute DATE."
98 (if (< date calendar-bahai-epoch) 101 (if (< date calendar-bahai-epoch)
99 (list 0 0 0) ; pre-Bahá'í date 102 (list 0 0 0) ; pre-Bahá'í date
100 (let* ((greg (calendar-gregorian-from-absolute date)) 103 (let* ((greg (calendar-gregorian-from-absolute date))
104 (gmonth (extract-calendar-month greg))
101 (year (+ (- (extract-calendar-year greg) 1844) 105 (year (+ (- (extract-calendar-year greg) 1844)
102 (if (or (> (extract-calendar-month greg) 3) 106 (if (or (> gmonth 3)
103 (and (= (extract-calendar-month greg) 3) 107 (and (= gmonth 3)
104 (>= (extract-calendar-day greg) 21))) 108 (>= (extract-calendar-day greg) 21)))
105 1 0))) 109 1 0)))
106 (month ; search forward from Baha 110 (month ; search forward from Baha
107 (1+ (calendar-sum m 1 111 (1+ (calendar-sum m 1
108 (> date 112 (> date (calendar-absolute-from-bahai (list m 19 year)))
109 (calendar-absolute-from-bahai
110 (list m 19 year)))
111 1))) 113 1)))
112 (day ; calculate the day by subtraction 114 (day ; calculate the day by subtraction
113 (- date 115 (- date
@@ -130,21 +132,24 @@ Defaults to today's date if DATE is not given."
130 (aref calendar-bahai-month-name-array (1- m)))) 132 (aref calendar-bahai-month-name-array (1- m))))
131 (day (int-to-string 133 (day (int-to-string
132 (if (<= d 0) 134 (if (<= d 0)
133 (if (calendar-bahai-leap-year-p y) 135 (+ d (if (calendar-bahai-leap-year-p y) 5 4))
134 (+ d 5)
135 (+ d 4))
136 d))) 136 d)))
137 (year (int-to-string y)) 137 (year (int-to-string y))
138 (month (int-to-string m)) 138 (month (int-to-string m))
139 dayname) 139 dayname)
140 (mapconcat 'eval calendar-date-display-form ""))) 140 (if (< y 1)
141 ""
142 ;; Can't call calendar-date-string because of monthname oddity.
143 (mapconcat 'eval calendar-date-display-form ""))))
141 144
142;;;###cal-autoload 145;;;###cal-autoload
143(defun calendar-bahai-print-date () 146(defun calendar-bahai-print-date ()
144 "Show the Bahá'í calendar equivalent of the selected date." 147 "Show the Bahá'í calendar equivalent of the selected date."
145 (interactive) 148 (interactive)
146 (message "Bahá'í date: %s" 149 (let ((s (calendar-bahai-date-string (calendar-cursor-to-date t))))
147 (calendar-bahai-date-string (calendar-cursor-to-date t)))) 150 (if (string-equal s "")
151 (message "Date is pre-Bahá'í")
152 (message "Bahá'í date: %s" s))))
148 153
149(define-obsolete-function-alias 154(define-obsolete-function-alias
150 'calendar-print-bahai-date 'calendar-bahai-print-date "23.1") 155 'calendar-print-bahai-date 'calendar-bahai-print-date "23.1")