diff options
| author | Glenn Morris | 2008-03-20 04:38:27 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-20 04:38:27 +0000 |
| commit | 06e9110e45e25b1f6b83fdc4e6d8c678c1e3020e (patch) | |
| tree | 14f2a4824c030ed77f66e800d85497e3d93029ff | |
| parent | 01633b01c6ffaf5912f5b40922d5bd43b5bde7f4 (diff) | |
| download | emacs-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.el | 35 |
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. |
| 76 | Used 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") |