Commit | Line | Data |
---|---|---|
e708e9d9 | 1 | ;;; cal-bahai.el --- calendar functions for the Bahá'í calendar. |
811a8484 | 2 | |
8b72699e | 3 | ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 |
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 |
811a8484 JW |
9 | |
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
075969b4 | 14 | ;; the Free Software Foundation; either version 3, or (at your option) |
811a8484 JW |
15 | ;; any later version. |
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 | |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
3a35cf56 LK |
24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 | ;; Boston, MA 02110-1301, USA. | |
811a8484 JW |
26 | |
27 | ;;; Commentary: | |
28 | ||
29 | ;; This collection of functions implements the features of calendar.el | |
305c237c | 30 | ;; and diary.el that deal with the Bahá'í calendar. |
811a8484 | 31 | |
305c237c | 32 | ;; The Bahá'í (http://www.bahai.org) calendar system is based on a |
811a8484 | 33 | ;; solar cycle of 19 months with 19 days each. The four remaining |
305c237c | 34 | ;; "intercalary" days are called the Ayyám-i-Há (days of Há), and are |
811a8484 JW |
35 | ;; placed between the 18th and 19th months. They are meant as a time |
36 | ;; of festivals preceding the 19th month, which is the month of | |
305c237c | 37 | ;; fasting. In Gregorian leap years, there are 5 of these days (Há |
811a8484 JW |
38 | ;; has the numerical value of 5 in the arabic abjad, or |
39 | ;; letter-to-number, reckoning). | |
40 | ||
41 | ;; Each month is named after an attribute of God, as are the 19 days | |
42 | ;; -- which have the same names as the months. There is also a name | |
43 | ;; for each year in every 19 year cycle. These cycles are called | |
305c237c | 44 | ;; Váhids. A cycle of 19 Váhids (361 years) is called a Kullu-Shay, |
811a8484 JW |
45 | ;; which means "all things". |
46 | ||
305c237c | 47 | ;; The calendar was named the "Badí` calendar" by its author, the Báb. |
811a8484 JW |
48 | ;; It uses a week of seven days, corresponding to the Gregorian week, |
49 | ;; each of which has its own name, again patterned after the | |
50 | ;; attributes of God. | |
51 | ||
305c237c | 52 | ;; Note: The days of Ayyám-i-Há are encoded as zero and negative |
811a8484 | 53 | ;; offsets from the first day of the final month. So, (19 -3 157) is |
305c237c | 54 | ;; the first day of Ayyám-i-Há, in the year 157 BE. |
811a8484 JW |
55 | |
56 | ;;; Code: | |
57 | ||
0ac1cb01 | 58 | (require 'calendar) |
811a8484 | 59 | |
e4e1cf95 | 60 | (defconst calendar-bahai-month-name-array |
305c237c JW |
61 | ["Bahá" "Jalál" "Jamál" "`Azamat" "Núr" "Rahmat" "Kalimát" "Kamál" |
62 | "Asmá" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masá'il" | |
6bd7c8eb GM |
63 | "Sharaf" "Sultán" "Mulk" "`Alá"] |
64 | "Array of the month names in the Bahá'í calendar.") | |
811a8484 | 65 | |
e4e1cf95 | 66 | (defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844)) |
0ac1cb01 | 67 | "Absolute date of start of Bahá'í calendar = March 21, 1844 AD.") |
811a8484 | 68 | |
e4e1cf95 | 69 | (defun calendar-bahai-leap-year-p (year) |
06e9110e | 70 | "True if Bahá'í YEAR is a leap year in the Bahá'í calendar." |
811a8484 JW |
71 | (calendar-leap-year-p (+ year 1844))) |
72 | ||
e4e1cf95 | 73 | (defconst calendar-bahai-leap-base |
6bd7c8eb | 74 | (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400)) |
06e9110e GM |
75 | "Number of leap years between 1 and 1844 AD, inclusive. |
76 | Used by `calendar-absolute-from-bahai'.") | |
811a8484 JW |
77 | |
78 | (defun calendar-absolute-from-bahai (date) | |
305c237c | 79 | "Compute absolute date from Bahá'í date DATE. |
811a8484 JW |
80 | The absolute date is the number of days elapsed since the (imaginary) |
81 | Gregorian date Sunday, December 31, 1 BC." | |
82 | (let* ((month (extract-calendar-month date)) | |
71ea27ee GM |
83 | (day (extract-calendar-day date)) |
84 | (year (extract-calendar-year date)) | |
85 | (prior-years (+ (1- year) 1844)) | |
86 | (leap-days (- (+ (/ prior-years 4) ; leap days in prior years | |
87 | (- (/ prior-years 100)) | |
88 | (/ prior-years 400)) | |
89 | calendar-bahai-leap-base))) | |
90 | (+ (1- calendar-bahai-epoch) ; days before epoch | |
91 | (* 365 (1- year)) ; days in prior years | |
811a8484 JW |
92 | leap-days |
93 | (calendar-sum m 1 (< m month) 19) | |
06e9110e GM |
94 | (if (= month 19) |
95 | (if (calendar-bahai-leap-year-p year) 5 4) | |
96 | 0) | |
71ea27ee | 97 | day))) ; days so far this month |
811a8484 JW |
98 | |
99 | (defun calendar-bahai-from-absolute (date) | |
06e9110e | 100 | "Bahá'í date (month day year) corresponding to the absolute DATE." |
811a8484 | 101 | (if (< date calendar-bahai-epoch) |
f1209c4f | 102 | (list 0 0 0) ; pre-Bahá'í date |
811a8484 | 103 | (let* ((greg (calendar-gregorian-from-absolute date)) |
06e9110e | 104 | (gmonth (extract-calendar-month greg)) |
71ea27ee | 105 | (year (+ (- (extract-calendar-year greg) 1844) |
06e9110e GM |
106 | (if (or (> gmonth 3) |
107 | (and (= gmonth 3) | |
71ea27ee GM |
108 | (>= (extract-calendar-day greg) 21))) |
109 | 1 0))) | |
f1209c4f | 110 | (month ; search forward from Baha |
811a8484 | 111 | (1+ (calendar-sum m 1 |
06e9110e | 112 | (> date (calendar-absolute-from-bahai (list m 19 year))) |
d07a05c2 | 113 | 1))) |
f1209c4f | 114 | (day ; calculate the day by subtraction |
811a8484 JW |
115 | (- date |
116 | (1- (calendar-absolute-from-bahai (list month 1 year)))))) | |
117 | (list month day year)))) | |
118 | ||
dedac6ab | 119 | ;;;###cal-autoload |
811a8484 | 120 | (defun calendar-bahai-date-string (&optional date) |
305c237c | 121 | "String of Bahá'í date of Gregorian DATE. |
811a8484 JW |
122 | Defaults to today's date if DATE is not given." |
123 | (let* ((bahai-date (calendar-bahai-from-absolute | |
71ea27ee GM |
124 | (calendar-absolute-from-gregorian |
125 | (or date (calendar-current-date))))) | |
811a8484 JW |
126 | (y (extract-calendar-year bahai-date)) |
127 | (m (extract-calendar-month bahai-date)) | |
d07a05c2 | 128 | (d (extract-calendar-day bahai-date)) |
34ee3257 GM |
129 | (monthname (if (or (< m 1) ; pre-Bahai, avoid aref error |
130 | (and (= m 19) | |
131 | (<= d 0))) | |
d07a05c2 GM |
132 | "Ayyám-i-Há" |
133 | (aref calendar-bahai-month-name-array (1- m)))) | |
134 | (day (int-to-string | |
135 | (if (<= d 0) | |
06e9110e | 136 | (+ d (if (calendar-bahai-leap-year-p y) 5 4)) |
d07a05c2 GM |
137 | d))) |
138 | (year (int-to-string y)) | |
139 | (month (int-to-string m)) | |
140 | dayname) | |
06e9110e GM |
141 | (if (< y 1) |
142 | "" | |
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))) |
811a8484 JW |
165 | (int-to-string |
166 | (extract-calendar-year | |
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 GM |
189 | (calendar-goto-date (calendar-gregorian-from-absolute |
190 | (calendar-absolute-from-bahai date))) | |
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 | |
34ee3257 | 199 | ;; FIXME same as islamic. |
dedac6ab | 200 | ;;;###holiday-autoload |
811a8484 | 201 | (defun holiday-bahai (month day string) |
305c237c JW |
202 | "Holiday on MONTH, DAY (Bahá'í) called STRING. |
203 | If MONTH, DAY (Bahá'í) is visible, the value returned is corresponding | |
811a8484 JW |
204 | Gregorian date in the form of the list (((month day year) STRING)). Returns |
205 | nil if it is not visible in the current calendar window." | |
206 | (let* ((bahai-date (calendar-bahai-from-absolute | |
71ea27ee GM |
207 | (calendar-absolute-from-gregorian |
208 | (list displayed-month 15 displayed-year)))) | |
811a8484 JW |
209 | (m (extract-calendar-month bahai-date)) |
210 | (y (extract-calendar-year bahai-date)) | |
8743fe88 | 211 | date) |
49f64954 | 212 | (unless (< m 1) ; Bahá'í calendar doesn't apply |
34ee3257 GM |
213 | ;; FIXME makes no sense (?), since there are not 12 months in a year. |
214 | ;; Suspect this was copied from cal-islam. | |
811a8484 | 215 | (increment-calendar-month m y (- 10 month)) |
71ea27ee | 216 | (if (> m 7) ; Bahá'í date might be visible |
811a8484 JW |
217 | (let ((date (calendar-gregorian-from-absolute |
218 | (calendar-absolute-from-bahai (list month day y))))) | |
219 | (if (calendar-date-is-visible-p date) | |
220 | (list (list date string)))))))) | |
221 | ||
0a349c6d | 222 | (autoload 'diary-list-entries-1 "diary-lib") |
6df98952 | 223 | |
dedac6ab | 224 | ;;;###diary-autoload |
03368919 | 225 | (defun diary-bahai-list-entries () |
305c237c | 226 | "Add any Bahá'í date entries from the diary file to `diary-entries-list'. |
6bd7c8eb GM |
227 | Bahá'í date diary entries must be prefaced by `bahai-diary-entry-symbol' |
228 | \(normally a `B'). The same diary date forms govern the style of the | |
02a2da66 GM |
229 | Bahá'í calendar entries, except that the Bahá'í month names cannot be |
230 | abbreviated. The Bahá'í months are numbered from 1 to 19 with Bahá being | |
6bd7c8eb GM |
231 | 1 and 19 being `Alá. If a Bahá'í date diary entry begins with |
232 | `diary-nonmarking-symbol', the entry will appear in the diary listing, but | |
233 | will not be marked in the calendar. This function is provided for use with | |
811a8484 | 234 | `nongregorian-diary-listing-hook'." |
d07a05c2 GM |
235 | (diary-list-entries-1 calendar-bahai-month-name-array |
236 | bahai-diary-entry-symbol | |
237 | 'calendar-bahai-from-absolute)) | |
238 | (define-obsolete-function-alias | |
239 | 'list-bahai-diary-entries 'diary-bahai-list-entries "23.1") | |
240 | ||
241 | ||
242 | (autoload 'calendar-mark-1 "diary-lib") | |
811a8484 | 243 | |
6bd7c8eb | 244 | ;;;###diary-autoload |
d07a05c2 | 245 | (defun calendar-bahai-mark-date-pattern (month day year &optional color) |
6bd7c8eb | 246 | "Mark dates in calendar window that conform to Bahá'í date MONTH/DAY/YEAR. |
d07a05c2 GM |
247 | A value of 0 in any position is a wildcard. Optional argument COLOR is |
248 | passed to `mark-visible-calendar-date' as MARK." | |
249 | (calendar-mark-1 month day year 'calendar-bahai-from-absolute | |
250 | 'calendar-absolute-from-bahai color)) | |
251 | ||
252 | (define-obsolete-function-alias | |
253 | 'mark-bahai-calendar-date-pattern 'calendar-bahai-mark-date-pattern "23.1") | |
254 | ||
6bd7c8eb | 255 | |
0a349c6d | 256 | (autoload 'diary-mark-entries-1 "diary-lib") |
6df98952 | 257 | |
dedac6ab | 258 | ;;;###diary-autoload |
e4e1cf95 | 259 | (defun diary-bahai-mark-entries () |
305c237c | 260 | "Mark days in the calendar window that have Bahá'í date diary entries. |
0a349c6d GM |
261 | Marks each entry in `diary-file' (or included files) visible in the calendar |
262 | window. See `diary-bahai-list-entries' for more information." | |
263 | (diary-mark-entries-1 calendar-bahai-month-name-array | |
264 | bahai-diary-entry-symbol | |
265 | 'calendar-bahai-from-absolute | |
266 | 'calendar-bahai-mark-date-pattern)) | |
811a8484 | 267 | |
d07a05c2 GM |
268 | (define-obsolete-function-alias |
269 | 'mark-bahai-diary-entries 'diary-bahai-mark-entries "23.1") | |
270 | ||
8743fe88 GM |
271 | |
272 | (autoload 'diary-insert-entry-1 "diary-lib") | |
273 | ||
dedac6ab | 274 | ;;;###cal-autoload |
03368919 | 275 | (defun diary-bahai-insert-entry (arg) |
811a8484 | 276 | "Insert a diary entry. |
305c237c | 277 | For the Bahá'í date corresponding to the date indicated by point. |
2c4abeb8 | 278 | Prefix argument ARG makes the entry nonmarking." |
811a8484 | 279 | (interactive "P") |
8743fe88 GM |
280 | (diary-insert-entry-1 nil arg calendar-bahai-month-name-array |
281 | bahai-diary-entry-symbol | |
282 | 'calendar-bahai-from-absolute)) | |
811a8484 | 283 | |
d07a05c2 GM |
284 | (define-obsolete-function-alias |
285 | 'insert-bahai-diary-entry 'diary-bahai-insert-entry "23.1") | |
286 | ||
dedac6ab | 287 | ;;;###cal-autoload |
e4e1cf95 | 288 | (defun diary-bahai-insert-monthly-entry (arg) |
811a8484 | 289 | "Insert a monthly diary entry. |
305c237c | 290 | For the day of the Bahá'í month corresponding to the date indicated by point. |
2c4abeb8 | 291 | Prefix argument ARG makes the entry nonmarking." |
811a8484 | 292 | (interactive "P") |
8743fe88 GM |
293 | (diary-insert-entry-1 'monthly arg calendar-bahai-month-name-array |
294 | bahai-diary-entry-symbol | |
295 | 'calendar-bahai-from-absolute)) | |
811a8484 | 296 | |
d07a05c2 GM |
297 | (define-obsolete-function-alias |
298 | 'insert-monthly-bahai-diary-entry 'diary-bahai-insert-monthly-entry "23.1") | |
299 | ||
dedac6ab | 300 | ;;;###cal-autoload |
e4e1cf95 | 301 | (defun diary-bahai-insert-yearly-entry (arg) |
811a8484 | 302 | "Insert an annual diary entry. |
305c237c | 303 | For the day of the Bahá'í year corresponding to the date indicated by point. |
2c4abeb8 | 304 | Prefix argument ARG will make the entry nonmarking." |
811a8484 | 305 | (interactive "P") |
8743fe88 GM |
306 | (diary-insert-entry-1 'yearly arg calendar-bahai-month-name-array |
307 | bahai-diary-entry-symbol | |
308 | 'calendar-bahai-from-absolute)) | |
811a8484 | 309 | |
d07a05c2 GM |
310 | (define-obsolete-function-alias |
311 | 'insert-yearly-bahai-diary-entry 'diary-bahai-insert-yearly-entry "23.1") | |
312 | ||
dedac6ab GM |
313 | (defvar date) |
314 | ||
315 | ;; To be called from list-sexp-diary-entries, where DATE is bound. | |
316 | ;;;###diary-autoload | |
317 | (defun diary-bahai-date () | |
318 | "Bahá'í calendar equivalent of date diary entry." | |
319 | (format "Bahá'í date: %s" (calendar-bahai-date-string date))) | |
320 | ||
321 | ||
811a8484 JW |
322 | (provide 'cal-bahai) |
323 | ||
e708e9d9 GM |
324 | ;; Local Variables: |
325 | ;; coding: utf-8 | |
e708e9d9 GM |
326 | ;; End: |
327 | ||
e4e1cf95 | 328 | ;; arch-tag: c1cb1d67-862a-4264-a01c-41cb4df01f14 |
811a8484 | 329 | ;;; cal-bahai.el ends here |