Commit | Line | Data |
---|---|---|
3afbc435 | 1 | ;;; cal-islam.el --- calendar functions for the Islamic calendar |
0808d911 | 2 | |
d18d0261 GM |
3 | ;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
4 | ;; 2008 Free Software Foundation, Inc. | |
0808d911 ER |
5 | |
6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | |
dbfca9c4 | 7 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
0808d911 ER |
8 | ;; Keywords: calendar |
9 | ;; Human-Keywords: Islamic calendar, calendar, diary | |
10 | ||
11 | ;; This file is part of GNU Emacs. | |
12 | ||
13 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 | ;; it under the terms of the GNU General Public License as published by | |
075969b4 | 15 | ;; the Free Software Foundation; either version 3, or (at your option) |
0808d911 ER |
16 | ;; any later version. |
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 | |
b578f267 | 24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
26 | ;; Boston, MA 02110-1301, USA. | |
0808d911 ER |
27 | |
28 | ;;; Commentary: | |
29 | ||
7bead204 | 30 | ;; See calendar.el. |
a96a5fca | 31 | |
0808d911 ER |
32 | ;;; Code: |
33 | ||
282179b2 | 34 | (require 'calendar) |
0808d911 | 35 | |
cb339243 | 36 | (defconst calendar-islamic-month-name-array |
0808d911 | 37 | ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II" |
48ad4975 GM |
38 | "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"] |
39 | "Array of strings giving the names of the Islamic months.") | |
0808d911 | 40 | |
282179b2 | 41 | (eval-and-compile |
88c4ca18 | 42 | (autoload 'calendar-julian-to-absolute "cal-julian")) |
282179b2 GM |
43 | |
44 | (defconst calendar-islamic-epoch | |
88c4ca18 | 45 | (eval-when-compile (calendar-julian-to-absolute '(7 16 622))) |
282179b2 | 46 | "Absolute date of start of Islamic calendar = July 16, 622 AD (Julian).") |
0808d911 | 47 | |
88c4ca18 | 48 | (defun calendar-islamic-leap-year-p (year) |
c723ec5e | 49 | "Return t if YEAR is a leap year on the Islamic calendar." |
0808d911 ER |
50 | (memq (% year 30) |
51 | (list 2 5 7 10 13 16 18 21 24 26 29))) | |
52 | ||
88c4ca18 | 53 | (defun calendar-islamic-last-day-of-month (month year) |
0808d911 ER |
54 | "The last day in MONTH during YEAR on the Islamic calendar." |
55 | (cond | |
56 | ((memq month (list 1 3 5 7 9 11)) 30) | |
57 | ((memq month (list 2 4 6 8 10)) 29) | |
88c4ca18 | 58 | (t (if (calendar-islamic-leap-year-p year) 30 29)))) |
0808d911 | 59 | |
88c4ca18 | 60 | (defun calendar-islamic-day-number (date) |
0808d911 | 61 | "Return the day number within the year of the Islamic date DATE." |
e803eab7 | 62 | (let ((month (calendar-extract-month date))) |
f852191f GM |
63 | (+ (* 30 (/ month 2)) |
64 | (* 29 (/ (1- month) 2)) | |
e803eab7 | 65 | (calendar-extract-day date)))) |
0808d911 | 66 | |
88c4ca18 | 67 | (defun calendar-islamic-to-absolute (date) |
0808d911 ER |
68 | "Absolute date of Islamic DATE. |
69 | The absolute date is the number of days elapsed since the (imaginary) | |
70 | Gregorian date Sunday, December 31, 1 BC." | |
e803eab7 GM |
71 | (let* ((month (calendar-extract-month date)) |
72 | (day (calendar-extract-day date)) | |
73 | (year (calendar-extract-year date)) | |
0808d911 | 74 | (y (% year 30)) |
b2fba013 GM |
75 | (leap-years-in-cycle (cond ((< y 3) 0) |
76 | ((< y 6) 1) | |
77 | ((< y 8) 2) | |
78 | ((< y 11) 3) | |
79 | ((< y 14) 4) | |
80 | ((< y 17) 5) | |
81 | ((< y 19) 6) | |
82 | ((< y 22) 7) | |
83 | ((< y 25) 8) | |
84 | ((< y 27) 9) | |
85 | (t 10)))) | |
88c4ca18 | 86 | (+ (calendar-islamic-day-number date) ; days so far this year |
c9f8e628 GM |
87 | (* (1- year) 354) ; days in all non-leap years |
88 | (* 11 (/ year 30)) ; leap days in complete cycles | |
89 | leap-years-in-cycle ; leap days this cycle | |
90 | (1- calendar-islamic-epoch)))) ; days before start of calendar | |
0808d911 | 91 | |
88c4ca18 GM |
92 | (define-obsolete-function-alias 'calendar-absolute-from-islamic |
93 | 'calendar-islamic-to-absolute "23.1") | |
94 | ||
0808d911 ER |
95 | (defun calendar-islamic-from-absolute (date) |
96 | "Compute the Islamic date (month day year) corresponding to absolute DATE. | |
97 | The absolute date is the number of days elapsed since the (imaginary) | |
98 | Gregorian date Sunday, December 31, 1 BC." | |
99 | (if (< date calendar-islamic-epoch) | |
c9f8e628 | 100 | (list 0 0 0) ; pre-Islamic date |
0808d911 | 101 | (let* ((approx (/ (- date calendar-islamic-epoch) |
c9f8e628 GM |
102 | 355)) ; approximation from below |
103 | (year ; search forward from the approximation | |
0808d911 ER |
104 | (+ approx |
105 | (calendar-sum y approx | |
88c4ca18 | 106 | (>= date (calendar-islamic-to-absolute |
0808d911 ER |
107 | (list 1 1 (1+ y)))) |
108 | 1))) | |
c9f8e628 | 109 | (month ; search forward from Muharram |
0808d911 ER |
110 | (1+ (calendar-sum m 1 |
111 | (> date | |
88c4ca18 | 112 | (calendar-islamic-to-absolute |
0808d911 | 113 | (list m |
88c4ca18 | 114 | (calendar-islamic-last-day-of-month |
0808d911 ER |
115 | m year) |
116 | year))) | |
117 | 1))) | |
c9f8e628 | 118 | (day ; calculate the day by subtraction |
0808d911 | 119 | (- date |
88c4ca18 | 120 | (1- (calendar-islamic-to-absolute (list month 1 year)))))) |
0808d911 ER |
121 | (list month day year)))) |
122 | ||
9e85002d | 123 | ;;;###cal-autoload |
0808d911 ER |
124 | (defun calendar-islamic-date-string (&optional date) |
125 | "String of Islamic date before sunset of Gregorian DATE. | |
126 | Returns the empty string if DATE is pre-Islamic. | |
127 | Defaults to today's date if DATE is not given. | |
128 | Driven by the variable `calendar-date-display-form'." | |
129 | (let ((calendar-month-name-array calendar-islamic-month-name-array) | |
130 | (islamic-date (calendar-islamic-from-absolute | |
131 | (calendar-absolute-from-gregorian | |
132 | (or date (calendar-current-date)))))) | |
e803eab7 | 133 | (if (< (calendar-extract-year islamic-date) 1) |
0808d911 ER |
134 | "" |
135 | (calendar-date-string islamic-date nil t)))) | |
136 | ||
9e85002d | 137 | ;;;###cal-autoload |
88c4ca18 | 138 | (defun calendar-islamic-print-date () |
0808d911 ER |
139 | "Show the Islamic calendar equivalent of the date under the cursor." |
140 | (interactive) | |
141 | (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t)))) | |
142 | (if (string-equal i "") | |
143 | (message "Date is pre-Islamic") | |
144 | (message "Islamic date (until sunset): %s" i)))) | |
145 | ||
88c4ca18 GM |
146 | (define-obsolete-function-alias 'calendar-print-islamic-date |
147 | 'calendar-islamic-print-date "23.1") | |
148 | ||
1cdb4ad7 GM |
149 | (defun calendar-islamic-read-date () |
150 | "Interactively read the arguments for an Islamic date command. | |
151 | Reads a year, month, and day." | |
b2fba013 GM |
152 | (let* ((today (calendar-current-date)) |
153 | (year (calendar-read | |
154 | "Islamic calendar year (>0): " | |
155 | (lambda (x) (> x 0)) | |
156 | (int-to-string | |
e803eab7 | 157 | (calendar-extract-year |
b2fba013 GM |
158 | (calendar-islamic-from-absolute |
159 | (calendar-absolute-from-gregorian today)))))) | |
160 | (month-array calendar-islamic-month-name-array) | |
161 | (completion-ignore-case t) | |
162 | (month (cdr (assoc-string | |
163 | (completing-read | |
164 | "Islamic calendar month name: " | |
165 | (mapcar 'list (append month-array nil)) | |
166 | nil t) | |
167 | (calendar-make-alist month-array 1) t))) | |
88c4ca18 | 168 | (last (calendar-islamic-last-day-of-month month year)) |
b2fba013 GM |
169 | (day (calendar-read |
170 | (format "Islamic calendar day (1-%d): " last) | |
171 | (lambda (x) (and (< 0 x) (<= x last)))))) | |
172 | (list (list month day year)))) | |
173 | ||
9e85002d | 174 | ;;;###cal-autoload |
88c4ca18 | 175 | (defun calendar-islamic-goto-date (date &optional noecho) |
f852191f | 176 | "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is non-nil." |
1cdb4ad7 | 177 | (interactive (calendar-islamic-read-date)) |
0808d911 | 178 | (calendar-goto-date (calendar-gregorian-from-absolute |
88c4ca18 GM |
179 | (calendar-islamic-to-absolute date))) |
180 | (or noecho (calendar-islamic-print-date))) | |
181 | ||
182 | (define-obsolete-function-alias 'calendar-goto-islamic-date | |
183 | 'calendar-islamic-goto-date "23.1") | |
0808d911 | 184 | |
e803eab7 | 185 | (defvar displayed-month) ; from calendar-generate |
f852191f GM |
186 | (defvar displayed-year) |
187 | ||
9e85002d | 188 | ;;;###holiday-autoload |
0808d911 ER |
189 | (defun holiday-islamic (month day string) |
190 | "Holiday on MONTH, DAY (Islamic) called STRING. | |
191 | If MONTH, DAY (Islamic) is visible, the value returned is corresponding | |
192 | Gregorian date in the form of the list (((month day year) STRING)). Returns | |
193 | nil if it is not visible in the current calendar window." | |
7bead204 GM |
194 | ;; Islamic date corresponding to the center of the calendar window. |
195 | ;; Since the calendar displays 3 months at a time, there are approx | |
196 | ;; 45 visible days either side of this date. Given the length of | |
197 | ;; the Islamic months, this means up to two different months are | |
198 | ;; visible either side of the central date. | |
0808d911 ER |
199 | (let* ((islamic-date (calendar-islamic-from-absolute |
200 | (calendar-absolute-from-gregorian | |
201 | (list displayed-month 15 displayed-year)))) | |
e803eab7 GM |
202 | (m (calendar-extract-month islamic-date)) |
203 | (y (calendar-extract-year islamic-date)) | |
41099a1b | 204 | date) |
f852191f | 205 | (unless (< m 1) ; Islamic calendar doesn't apply |
7bead204 GM |
206 | ;; Since converting to absolute dates can be a complex |
207 | ;; operation, we try to speed things up by excluding those date | |
208 | ;; ranges that can't possibly be visible. | |
209 | ;; We can view the situation (see above) as if we had a calendar | |
210 | ;; window displaying 5 months at a time. When month m is | |
211 | ;; central, months m-2:m+2 (modulo 12) might be visible. | |
212 | ;; Recall from holiday-fixed that with a 3 month calendar | |
213 | ;; window, November is special, because we can do a one-sided | |
214 | ;; inclusion test. When November is central is when the end of | |
215 | ;; year first appears on the calendar. Similarly, with a 5 | |
216 | ;; month window, October is special. When October is central is | |
217 | ;; when the end of year first appears, and when January is | |
218 | ;; central, October is no longer visible. October is visible | |
219 | ;; when the central month is >= 8. | |
220 | ;; Hence to test if any given month might be visible, we can | |
221 | ;; shift things and ask about October. | |
222 | ;; At the same time, we work out the appropriate year y to use. | |
e803eab7 | 223 | (calendar-increment-month m y (- 10 month)) |
7bead204 GM |
224 | (and (> m 7) ; Islamic date might be visible |
225 | (calendar-date-is-visible-p | |
226 | (setq date (calendar-gregorian-from-absolute | |
88c4ca18 | 227 | (calendar-islamic-to-absolute (list month day y))))) |
7bead204 | 228 | (list (list date string)))))) |
0808d911 | 229 | |
df1c298d GM |
230 | ;;;###holiday-autoload |
231 | (defun holiday-islamic-new-year () | |
232 | "Holiday entry for the Islamic New Year, if visible in the calendar window." | |
233 | (let ((date (caar (holiday-islamic 1 1 ""))) | |
234 | (m displayed-month) | |
235 | (y displayed-year)) | |
236 | (and date | |
237 | (list (list date | |
238 | (format "Islamic New Year %d" | |
239 | (progn | |
e803eab7 GM |
240 | (calendar-increment-month m y 1) |
241 | (calendar-extract-year | |
df1c298d GM |
242 | (calendar-islamic-from-absolute |
243 | (calendar-absolute-from-gregorian | |
244 | (list m (calendar-last-day-of-month m y) y) | |
245 | )))))))))) | |
246 | ||
cb339243 | 247 | (autoload 'diary-list-entries-1 "diary-lib") |
6546bf55 | 248 | |
9e85002d | 249 | ;;;###diary-autoload |
88c4ca18 | 250 | (defun diary-islamic-list-entries () |
0808d911 | 251 | "Add any Islamic date entries from the diary file to `diary-entries-list'. |
7f2bc15e | 252 | Islamic date diary entries must be prefaced by `diary-islamic-entry-symbol' |
cb339243 | 253 | \(normally an `I'). The same `diary-date-forms' govern the style |
c723ec5e | 254 | of the Islamic calendar entries, except that the Islamic month |
2b79de59 | 255 | names cannot be abbreviated. The Islamic months are numbered |
c723ec5e GM |
256 | from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah. |
257 | If an Islamic date diary entry begins with `diary-nonmarking-symbol', | |
258 | the entry will appear in the diary listing, but will not be | |
259 | marked in the calendar. This function is provided for use with | |
9ee4e581 | 260 | `diary-nongregorian-listing-hook'." |
cb339243 | 261 | (diary-list-entries-1 calendar-islamic-month-name-array |
7f2bc15e | 262 | diary-islamic-entry-symbol |
cb339243 | 263 | 'calendar-islamic-from-absolute)) |
0808d911 | 264 | |
88c4ca18 GM |
265 | (define-obsolete-function-alias 'list-islamic-diary-entries |
266 | 'diary-islamic-list-entries "23.1") | |
267 | ||
b2fba013 GM |
268 | (autoload 'calendar-mark-1 "diary-lib") |
269 | ||
9e85002d | 270 | ;;;###diary-autoload |
88c4ca18 | 271 | (defun calendar-islamic-mark-date-pattern (month day year &optional color) |
0808d911 | 272 | "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR. |
b2fba013 | 273 | A value of 0 in any position is a wildcard. Optional argument COLOR is |
e803eab7 | 274 | passed to `calendar-mark-visible-date' as MARK." |
b2fba013 | 275 | (calendar-mark-1 month day year 'calendar-islamic-from-absolute |
88c4ca18 GM |
276 | 'calendar-islamic-to-absolute color)) |
277 | ||
278 | (define-obsolete-function-alias 'mark-islamic-calendar-date-pattern | |
279 | 'calendar-islamic-mark-date-pattern "23.1") | |
0808d911 | 280 | |
cb339243 | 281 | (autoload 'diary-mark-entries-1 "diary-lib") |
f852191f GM |
282 | |
283 | ;;;###diary-autoload | |
88c4ca18 | 284 | (defun diary-islamic-mark-entries () |
f852191f | 285 | "Mark days in the calendar window that have Islamic date diary entries. |
cb339243 | 286 | Marks each entry in `diary-file' (or included files) visible in the calendar |
88c4ca18 GM |
287 | window. See `diary-islamic-list-entries' for more information." |
288 | (diary-mark-entries-1 'calendar-islamic-mark-date-pattern | |
bf694ab9 | 289 | calendar-islamic-month-name-array |
7f2bc15e | 290 | diary-islamic-entry-symbol |
bf694ab9 | 291 | 'calendar-islamic-from-absolute)) |
f852191f | 292 | |
88c4ca18 GM |
293 | (define-obsolete-function-alias |
294 | 'mark-islamic-diary-entries 'diary-islamic-mark-entries "23.1") | |
41099a1b GM |
295 | |
296 | (autoload 'diary-insert-entry-1 "diary-lib") | |
297 | ||
9e85002d | 298 | ;;;###cal-autoload |
88c4ca18 | 299 | (defun diary-islamic-insert-entry (arg) |
0808d911 ER |
300 | "Insert a diary entry. |
301 | For the Islamic date corresponding to the date indicated by point. | |
c723ec5e | 302 | Prefix argument ARG makes the entry nonmarking." |
0808d911 | 303 | (interactive "P") |
41099a1b | 304 | (diary-insert-entry-1 nil arg calendar-islamic-month-name-array |
7f2bc15e | 305 | diary-islamic-entry-symbol |
41099a1b | 306 | 'calendar-islamic-from-absolute)) |
0808d911 | 307 | |
88c4ca18 GM |
308 | (define-obsolete-function-alias 'insert-islamic-diary-entry |
309 | 'diary-islamic-insert-entry "23.1") | |
310 | ||
9e85002d | 311 | ;;;###cal-autoload |
88c4ca18 | 312 | (defun diary-islamic-insert-monthly-entry (arg) |
0808d911 ER |
313 | "Insert a monthly diary entry. |
314 | For the day of the Islamic month corresponding to the date indicated by point. | |
c723ec5e | 315 | Prefix argument ARG makes the entry nonmarking." |
0808d911 | 316 | (interactive "P") |
41099a1b | 317 | (diary-insert-entry-1 'monthly arg calendar-islamic-month-name-array |
7f2bc15e | 318 | diary-islamic-entry-symbol |
41099a1b | 319 | 'calendar-islamic-from-absolute)) |
0808d911 | 320 | |
88c4ca18 GM |
321 | (define-obsolete-function-alias 'insert-monthly-islamic-diary-entry |
322 | 'diary-islamic-insert-monthly-entry "23.1") | |
323 | ||
9e85002d | 324 | ;;;###cal-autoload |
88c4ca18 | 325 | (defun diary-islamic-insert-yearly-entry (arg) |
0808d911 ER |
326 | "Insert an annual diary entry. |
327 | For the day of the Islamic year corresponding to the date indicated by point. | |
c723ec5e | 328 | Prefix argument ARG makes the entry nonmarking." |
0808d911 | 329 | (interactive "P") |
41099a1b | 330 | (diary-insert-entry-1 'yearly arg calendar-islamic-month-name-array |
7f2bc15e | 331 | diary-islamic-entry-symbol |
41099a1b | 332 | 'calendar-islamic-from-absolute)) |
88c4ca18 GM |
333 | (define-obsolete-function-alias |
334 | 'insert-yearly-islamic-diary-entry 'diary-islamic-insert-yearly-entry "23.1") | |
0808d911 | 335 | |
6546bf55 GM |
336 | (defvar date) |
337 | ||
338 | ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. | |
9e85002d | 339 | ;;;###diary-autoload |
6546bf55 GM |
340 | (defun diary-islamic-date () |
341 | "Islamic calendar equivalent of date diary entry." | |
342 | (let ((i (calendar-islamic-date-string date))) | |
343 | (if (string-equal i "") | |
344 | "Date is pre-Islamic" | |
345 | (format "Islamic date (until sunset): %s" i)))) | |
346 | ||
afdbe61d | 347 | (provide 'cal-islam) |
0808d911 | 348 | |
d383fd97 | 349 | ;; arch-tag: a951b6c1-6f47-48d5-bac3-1b505cd719f7 |
afdbe61d | 350 | ;;; cal-islam.el ends here |