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