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