Commit | Line | Data |
---|---|---|
e708e9d9 | 1 | ;;; cal-bahai.el --- calendar functions for the Bahá'í calendar. |
811a8484 | 2 | |
95df8112 | 3 | ;; Copyright (C) 2001-2011 Free Software Foundation, Inc. |
811a8484 JW |
4 | |
5 | ;; Author: John Wiegley <johnw@gnu.org> | |
6 | ;; Keywords: calendar | |
305c237c | 7 | ;; Human-Keywords: Bahá'í calendar, Bahá'í, Baha'i, Bahai, calendar, diary |
bd78fa1d | 8 | ;; Package: calendar |
811a8484 JW |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
2ed66575 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
811a8484 | 13 | ;; it under the terms of the GNU General Public License as published by |
2ed66575 GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
811a8484 JW |
16 | |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
2ed66575 | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
811a8484 JW |
24 | |
25 | ;;; Commentary: | |
26 | ||
27 | ;; This collection of functions implements the features of calendar.el | |
20246a85 | 28 | ;; and diary-lib.el that deal with the Bahá'í calendar. |
811a8484 | 29 | |
305c237c | 30 | ;; The Bahá'í (http://www.bahai.org) calendar system is based on a |
811a8484 | 31 | ;; solar cycle of 19 months with 19 days each. The four remaining |
305c237c | 32 | ;; "intercalary" days are called the Ayyám-i-Há (days of Há), and are |
811a8484 JW |
33 | ;; placed between the 18th and 19th months. They are meant as a time |
34 | ;; of festivals preceding the 19th month, which is the month of | |
305c237c | 35 | ;; fasting. In Gregorian leap years, there are 5 of these days (Há |
811a8484 JW |
36 | ;; has the numerical value of 5 in the arabic abjad, or |
37 | ;; letter-to-number, reckoning). | |
38 | ||
39 | ;; Each month is named after an attribute of God, as are the 19 days | |
40 | ;; -- which have the same names as the months. There is also a name | |
41 | ;; for each year in every 19 year cycle. These cycles are called | |
305c237c | 42 | ;; Váhids. A cycle of 19 Váhids (361 years) is called a Kullu-Shay, |
811a8484 JW |
43 | ;; which means "all things". |
44 | ||
305c237c | 45 | ;; The calendar was named the "Badí` calendar" by its author, the Báb. |
811a8484 JW |
46 | ;; It uses a week of seven days, corresponding to the Gregorian week, |
47 | ;; each of which has its own name, again patterned after the | |
48 | ;; attributes of God. | |
49 | ||
305c237c | 50 | ;; Note: The days of Ayyám-i-Há are encoded as zero and negative |
811a8484 | 51 | ;; offsets from the first day of the final month. So, (19 -3 157) is |
305c237c | 52 | ;; the first day of Ayyám-i-Há, in the year 157 BE. |
811a8484 JW |
53 | |
54 | ;;; Code: | |
55 | ||
0ac1cb01 | 56 | (require 'calendar) |
811a8484 | 57 | |
e4e1cf95 | 58 | (defconst calendar-bahai-month-name-array |
305c237c JW |
59 | ["Bahá" "Jalál" "Jamál" "`Azamat" "Núr" "Rahmat" "Kalimát" "Kamál" |
60 | "Asmá" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masá'il" | |
6bd7c8eb GM |
61 | "Sharaf" "Sultán" "Mulk" "`Alá"] |
62 | "Array of the month names in the Bahá'í calendar.") | |
811a8484 | 63 | |
e4e1cf95 | 64 | (defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844)) |
0ac1cb01 | 65 | "Absolute date of start of Bahá'í calendar = March 21, 1844 AD.") |
811a8484 | 66 | |
e4e1cf95 | 67 | (defun calendar-bahai-leap-year-p (year) |
06e9110e | 68 | "True if Bahá'í YEAR is a leap year in the Bahá'í calendar." |
811a8484 JW |
69 | (calendar-leap-year-p (+ year 1844))) |
70 | ||
e4e1cf95 | 71 | (defconst calendar-bahai-leap-base |
6bd7c8eb | 72 | (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400)) |
06e9110e | 73 | "Number of leap years between 1 and 1844 AD, inclusive. |
f22c8bf7 | 74 | Used by `calendar-bahai-to-absolute'.") |
811a8484 | 75 | |
f22c8bf7 | 76 | (defun calendar-bahai-to-absolute (date) |
305c237c | 77 | "Compute absolute date from Bahá'í date DATE. |
811a8484 JW |
78 | The absolute date is the number of days elapsed since the (imaginary) |
79 | Gregorian date Sunday, December 31, 1 BC." | |
e803eab7 GM |
80 | (let* ((month (calendar-extract-month date)) |
81 | (day (calendar-extract-day date)) | |
82 | (year (calendar-extract-year date)) | |
71ea27ee GM |
83 | (prior-years (+ (1- year) 1844)) |
84 | (leap-days (- (+ (/ prior-years 4) ; leap days in prior years | |
85 | (- (/ prior-years 100)) | |
86 | (/ prior-years 400)) | |
87 | calendar-bahai-leap-base))) | |
88 | (+ (1- calendar-bahai-epoch) ; days before epoch | |
89 | (* 365 (1- year)) ; days in prior years | |
811a8484 JW |
90 | leap-days |
91 | (calendar-sum m 1 (< m month) 19) | |
06e9110e GM |
92 | (if (= month 19) |
93 | (if (calendar-bahai-leap-year-p year) 5 4) | |
94 | 0) | |
71ea27ee | 95 | day))) ; days so far this month |
811a8484 | 96 | |
f22c8bf7 GM |
97 | (define-obsolete-function-alias 'calendar-absolute-from-bahai |
98 | 'calendar-bahai-to-absolute "23.1") | |
99 | ||
811a8484 | 100 | (defun calendar-bahai-from-absolute (date) |
06e9110e | 101 | "Bahá'í date (month day year) corresponding to the absolute DATE." |
811a8484 | 102 | (if (< date calendar-bahai-epoch) |
f1209c4f | 103 | (list 0 0 0) ; pre-Bahá'í date |
811a8484 | 104 | (let* ((greg (calendar-gregorian-from-absolute date)) |
e803eab7 GM |
105 | (gmonth (calendar-extract-month greg)) |
106 | (year (+ (- (calendar-extract-year greg) 1844) | |
06e9110e GM |
107 | (if (or (> gmonth 3) |
108 | (and (= gmonth 3) | |
e803eab7 | 109 | (>= (calendar-extract-day greg) 21))) |
71ea27ee | 110 | 1 0))) |
f1209c4f | 111 | (month ; search forward from Baha |
811a8484 | 112 | (1+ (calendar-sum m 1 |
f22c8bf7 | 113 | (> date (calendar-bahai-to-absolute (list m 19 year))) |
d07a05c2 | 114 | 1))) |
f1209c4f | 115 | (day ; calculate the day by subtraction |
811a8484 | 116 | (- date |
f22c8bf7 | 117 | (1- (calendar-bahai-to-absolute (list month 1 year)))))) |
811a8484 JW |
118 | (list month day year)))) |
119 | ||
dedac6ab | 120 | ;;;###cal-autoload |
811a8484 | 121 | (defun calendar-bahai-date-string (&optional date) |
305c237c | 122 | "String of Bahá'í date of Gregorian DATE. |
811a8484 JW |
123 | Defaults to today's date if DATE is not given." |
124 | (let* ((bahai-date (calendar-bahai-from-absolute | |
71ea27ee GM |
125 | (calendar-absolute-from-gregorian |
126 | (or date (calendar-current-date))))) | |
e803eab7 | 127 | (y (calendar-extract-year bahai-date))) |
06e9110e | 128 | (if (< y 1) |
fb9e0d34 | 129 | "" ; pre-Bahai |
e803eab7 GM |
130 | (let* ((m (calendar-extract-month bahai-date)) |
131 | (d (calendar-extract-day bahai-date)) | |
fb9e0d34 GM |
132 | (monthname (if (and (= m 19) |
133 | (<= d 0)) | |
134 | "Ayyám-i-Há" | |
135 | (aref calendar-bahai-month-name-array (1- m)))) | |
d92bcf94 | 136 | (day (number-to-string |
fb9e0d34 GM |
137 | (if (<= d 0) |
138 | (+ d (if (calendar-bahai-leap-year-p y) 5 4)) | |
139 | d))) | |
d92bcf94 GM |
140 | (year (number-to-string y)) |
141 | (month (number-to-string m)) | |
fb9e0d34 GM |
142 | dayname) |
143 | ;; Can't call calendar-date-string because of monthname oddity. | |
144 | (mapconcat 'eval calendar-date-display-form ""))))) | |
811a8484 | 145 | |
dedac6ab | 146 | ;;;###cal-autoload |
03368919 | 147 | (defun calendar-bahai-print-date () |
305c237c | 148 | "Show the Bahá'í calendar equivalent of the selected date." |
811a8484 | 149 | (interactive) |
06e9110e GM |
150 | (let ((s (calendar-bahai-date-string (calendar-cursor-to-date t)))) |
151 | (if (string-equal s "") | |
152 | (message "Date is pre-Bahá'í") | |
153 | (message "Bahá'í date: %s" s)))) | |
811a8484 | 154 | |
d07a05c2 GM |
155 | (define-obsolete-function-alias |
156 | 'calendar-print-bahai-date 'calendar-bahai-print-date "23.1") | |
157 | ||
ff5daae5 GM |
158 | (defun calendar-bahai-read-date () |
159 | "Interactively read the arguments for a Bahá'í date command. | |
160 | Reads a year, month and day." | |
811a8484 JW |
161 | (let* ((today (calendar-current-date)) |
162 | (year (calendar-read | |
305c237c | 163 | "Bahá'í calendar year (not 0): " |
9b6c7da9 | 164 | (lambda (x) (not (zerop x))) |
d92bcf94 | 165 | (number-to-string |
e803eab7 | 166 | (calendar-extract-year |
811a8484 JW |
167 | (calendar-bahai-from-absolute |
168 | (calendar-absolute-from-gregorian today)))))) | |
169 | (completion-ignore-case t) | |
170 | (month (cdr (assoc | |
71ea27ee GM |
171 | (completing-read |
172 | "Bahá'í calendar month name: " | |
173 | (mapcar 'list | |
174 | (append calendar-bahai-month-name-array nil)) | |
175 | nil t) | |
e4e1cf95 | 176 | (calendar-make-alist calendar-bahai-month-name-array |
811a8484 | 177 | 1)))) |
305c237c | 178 | (day (calendar-read "Bahá'í calendar day (1-19): " |
71ea27ee | 179 | (lambda (x) (and (< 0 x) (<= x 19)))))) |
811a8484 JW |
180 | (list (list month day year)))) |
181 | ||
ff5daae5 GM |
182 | (define-obsolete-function-alias |
183 | 'calendar-bahai-prompt-for-date 'calendar-bahai-read-date "23.1") | |
184 | ||
6bd7c8eb GM |
185 | ;;;###cal-autoload |
186 | (defun calendar-bahai-goto-date (date &optional noecho) | |
d07a05c2 | 187 | "Move cursor to Bahá'í date DATE; echo Bahá'í date unless NOECHO is non-nil." |
ff5daae5 | 188 | (interactive (calendar-bahai-read-date)) |
6bd7c8eb | 189 | (calendar-goto-date (calendar-gregorian-from-absolute |
f22c8bf7 | 190 | (calendar-bahai-to-absolute date))) |
6bd7c8eb GM |
191 | (or noecho (calendar-bahai-print-date))) |
192 | ||
d07a05c2 GM |
193 | (define-obsolete-function-alias |
194 | 'calendar-goto-bahai-date 'calendar-bahai-goto-date "23.1") | |
195 | ||
dedac6ab GM |
196 | (defvar displayed-month) |
197 | (defvar displayed-year) | |
811a8484 | 198 | |
dedac6ab | 199 | ;;;###holiday-autoload |
811a8484 | 200 | (defun holiday-bahai (month day string) |
305c237c | 201 | "Holiday on MONTH, DAY (Bahá'í) called STRING. |
a28fa64f GM |
202 | If MONTH, DAY (Bahá'í) is visible in the current calendar window, |
203 | returns the corresponding Gregorian date in the form of the | |
204 | list (((month day year) STRING)). Otherwise, returns nil." | |
cca1ce4c GM |
205 | ;; Since the calendar window shows 3 months at a time, there are |
206 | ;; approx +/- 45 days either side of the central month. | |
207 | ;; Since the Bahai months have 19 days, this means up to +/- 3 months. | |
811a8484 | 208 | (let* ((bahai-date (calendar-bahai-from-absolute |
71ea27ee GM |
209 | (calendar-absolute-from-gregorian |
210 | (list displayed-month 15 displayed-year)))) | |
e803eab7 GM |
211 | (m (calendar-extract-month bahai-date)) |
212 | (y (calendar-extract-year bahai-date)) | |
8743fe88 | 213 | date) |
49f64954 | 214 | (unless (< m 1) ; Bahá'í calendar doesn't apply |
cca1ce4c GM |
215 | ;; Cf holiday-fixed, holiday-islamic. |
216 | ;; With a +- 3 month calendar window, and 19 months per year, | |
217 | ;; month 16 is special. When m16 is central is when the | |
218 | ;; end-of-year first appears. When m1 is central, m16 is no | |
219 | ;; longer visible. Hence we can do a one-sided test to see if | |
220 | ;; m16 is visible. m16 is visible when the central month >= 13. | |
221 | ;; To see if other months are visible we can shift the range | |
222 | ;; accordingly. | |
e803eab7 | 223 | (calendar-increment-month m y (- 16 month) 19) |
cca1ce4c GM |
224 | (and (> m 12) ; Bahá'í date might be visible |
225 | (calendar-date-is-visible-p | |
226 | (setq date (calendar-gregorian-from-absolute | |
f22c8bf7 | 227 | (calendar-bahai-to-absolute (list month day y))))) |
cca1ce4c | 228 | (list (list date string)))))) |
811a8484 | 229 | |
df7c034e GM |
230 | (autoload 'holiday-fixed "holidays") |
231 | ||
232 | ;;;###holiday-autoload | |
233 | (defun holiday-bahai-new-year () | |
234 | "Holiday entry for the Bahá'í New Year, if visible in the calendar window." | |
235 | (holiday-fixed 3 21 | |
236 | (format "Bahá'í New Year (Naw-Ruz) %d" | |
237 | (- displayed-year (1- 1844))))) | |
238 | ||
239 | ;;;###holiday-autoload | |
240 | (defun holiday-bahai-ridvan (&optional all) | |
241 | "Holidays related to Ridvan, as visible in the calendar window. | |
242 | Only considers the first, ninth, and twelfth days, unless ALL or | |
1c76c939 | 243 | `calendar-bahai-all-holidays-flag' is non-nil." |
df7c034e GM |
244 | (let ((ord ["First" "Second" "Third" "Fourth" "Fifth" "Sixth" |
245 | "Seventh" "Eighth" "Ninth" "Tenth" "Eleventh" "Twelfth"]) | |
246 | (show '(0 8 11)) | |
247 | rid h) | |
1c76c939 | 248 | (if (or all calendar-bahai-all-holidays-flag) |
df7c034e GM |
249 | (setq show (number-sequence 0 11))) |
250 | ;; More trouble than it was worth...? | |
251 | (dolist (i show (nreverse rid)) | |
252 | (if (setq h (holiday-fixed (if (< i 10) 4 5) | |
253 | (+ i (if (< i 10) 21 -9)) | |
254 | (format "%s Day of Ridvan" (aref ord i)))) | |
255 | (push (car h) rid))))) | |
256 | ||
0a349c6d | 257 | (autoload 'diary-list-entries-1 "diary-lib") |
6df98952 | 258 | |
dedac6ab | 259 | ;;;###diary-autoload |
03368919 | 260 | (defun diary-bahai-list-entries () |
305c237c | 261 | "Add any Bahá'í date entries from the diary file to `diary-entries-list'. |
cdf4a0e8 | 262 | Bahá'í date diary entries must be prefaced by `diary-bahai-entry-symbol' |
6bd7c8eb | 263 | \(normally a `B'). The same diary date forms govern the style of the |
02a2da66 GM |
264 | Bahá'í calendar entries, except that the Bahá'í month names cannot be |
265 | abbreviated. The Bahá'í months are numbered from 1 to 19 with Bahá being | |
6bd7c8eb GM |
266 | 1 and 19 being `Alá. If a Bahá'í date diary entry begins with |
267 | `diary-nonmarking-symbol', the entry will appear in the diary listing, but | |
268 | will not be marked in the calendar. This function is provided for use with | |
9ee4e581 | 269 | `diary-nongregorian-listing-hook'." |
d07a05c2 | 270 | (diary-list-entries-1 calendar-bahai-month-name-array |
cdf4a0e8 | 271 | diary-bahai-entry-symbol |
d07a05c2 GM |
272 | 'calendar-bahai-from-absolute)) |
273 | (define-obsolete-function-alias | |
274 | 'list-bahai-diary-entries 'diary-bahai-list-entries "23.1") | |
275 | ||
276 | ||
277 | (autoload 'calendar-mark-1 "diary-lib") | |
811a8484 | 278 | |
6bd7c8eb | 279 | ;;;###diary-autoload |
d07a05c2 | 280 | (defun calendar-bahai-mark-date-pattern (month day year &optional color) |
6bd7c8eb | 281 | "Mark dates in calendar window that conform to Bahá'í date MONTH/DAY/YEAR. |
d07a05c2 | 282 | A value of 0 in any position is a wildcard. Optional argument COLOR is |
e803eab7 | 283 | passed to `calendar-mark-visible-date' as MARK." |
d07a05c2 | 284 | (calendar-mark-1 month day year 'calendar-bahai-from-absolute |
f22c8bf7 | 285 | 'calendar-bahai-to-absolute color)) |
d07a05c2 GM |
286 | |
287 | (define-obsolete-function-alias | |
288 | 'mark-bahai-calendar-date-pattern 'calendar-bahai-mark-date-pattern "23.1") | |
289 | ||
6bd7c8eb | 290 | |
0a349c6d | 291 | (autoload 'diary-mark-entries-1 "diary-lib") |
6df98952 | 292 | |
dedac6ab | 293 | ;;;###diary-autoload |
e4e1cf95 | 294 | (defun diary-bahai-mark-entries () |
305c237c | 295 | "Mark days in the calendar window that have Bahá'í date diary entries. |
0a349c6d GM |
296 | Marks each entry in `diary-file' (or included files) visible in the calendar |
297 | window. See `diary-bahai-list-entries' for more information." | |
5882b6bb GM |
298 | (diary-mark-entries-1 'calendar-bahai-mark-date-pattern |
299 | calendar-bahai-month-name-array | |
cdf4a0e8 | 300 | diary-bahai-entry-symbol |
5882b6bb | 301 | 'calendar-bahai-from-absolute)) |
811a8484 | 302 | |
d07a05c2 GM |
303 | (define-obsolete-function-alias |
304 | 'mark-bahai-diary-entries 'diary-bahai-mark-entries "23.1") | |
305 | ||
8743fe88 GM |
306 | |
307 | (autoload 'diary-insert-entry-1 "diary-lib") | |
308 | ||
dedac6ab | 309 | ;;;###cal-autoload |
03368919 | 310 | (defun diary-bahai-insert-entry (arg) |
811a8484 | 311 | "Insert a diary entry. |
305c237c | 312 | For the Bahá'í date corresponding to the date indicated by point. |
2c4abeb8 | 313 | Prefix argument ARG makes the entry nonmarking." |
811a8484 | 314 | (interactive "P") |
8743fe88 | 315 | (diary-insert-entry-1 nil arg calendar-bahai-month-name-array |
cdf4a0e8 | 316 | diary-bahai-entry-symbol |
8743fe88 | 317 | 'calendar-bahai-from-absolute)) |
811a8484 | 318 | |
d07a05c2 GM |
319 | (define-obsolete-function-alias |
320 | 'insert-bahai-diary-entry 'diary-bahai-insert-entry "23.1") | |
321 | ||
dedac6ab | 322 | ;;;###cal-autoload |
e4e1cf95 | 323 | (defun diary-bahai-insert-monthly-entry (arg) |
811a8484 | 324 | "Insert a monthly diary entry. |
305c237c | 325 | For the day of the Bahá'í month corresponding to the date indicated by point. |
2c4abeb8 | 326 | Prefix argument ARG makes the entry nonmarking." |
811a8484 | 327 | (interactive "P") |
8743fe88 | 328 | (diary-insert-entry-1 'monthly arg calendar-bahai-month-name-array |
cdf4a0e8 | 329 | diary-bahai-entry-symbol |
8743fe88 | 330 | 'calendar-bahai-from-absolute)) |
811a8484 | 331 | |
d07a05c2 GM |
332 | (define-obsolete-function-alias |
333 | 'insert-monthly-bahai-diary-entry 'diary-bahai-insert-monthly-entry "23.1") | |
334 | ||
dedac6ab | 335 | ;;;###cal-autoload |
e4e1cf95 | 336 | (defun diary-bahai-insert-yearly-entry (arg) |
811a8484 | 337 | "Insert an annual diary entry. |
305c237c | 338 | For the day of the Bahá'í year corresponding to the date indicated by point. |
2c4abeb8 | 339 | Prefix argument ARG will make the entry nonmarking." |
811a8484 | 340 | (interactive "P") |
8743fe88 | 341 | (diary-insert-entry-1 'yearly arg calendar-bahai-month-name-array |
cdf4a0e8 | 342 | diary-bahai-entry-symbol |
8743fe88 | 343 | 'calendar-bahai-from-absolute)) |
811a8484 | 344 | |
d07a05c2 GM |
345 | (define-obsolete-function-alias |
346 | 'insert-yearly-bahai-diary-entry 'diary-bahai-insert-yearly-entry "23.1") | |
347 | ||
dedac6ab GM |
348 | (defvar date) |
349 | ||
9ee4e581 | 350 | ;; To be called from diary-list-sexp-entries, where DATE is bound. |
dedac6ab GM |
351 | ;;;###diary-autoload |
352 | (defun diary-bahai-date () | |
353 | "Bahá'í calendar equivalent of date diary entry." | |
354 | (format "Bahá'í date: %s" (calendar-bahai-date-string date))) | |
355 | ||
356 | ||
811a8484 JW |
357 | (provide 'cal-bahai) |
358 | ||
e708e9d9 GM |
359 | ;; Local Variables: |
360 | ;; coding: utf-8 | |
e708e9d9 GM |
361 | ;; End: |
362 | ||
811a8484 | 363 | ;;; cal-bahai.el ends here |