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 | ||
30 | ;; This collection of functions implements the features of calendar.el and | |
31 | ;; diary.el that deal with the Islamic calendar. | |
32 | ||
a96a5fca | 33 | ;; Technical details of all the calendrical calculations can be found in |
fffaba77 PE |
34 | ;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold |
35 | ;; and Nachum Dershowitz, Cambridge University Press (2001). | |
a96a5fca | 36 | |
0808d911 ER |
37 | ;;; Code: |
38 | ||
282179b2 | 39 | (require 'calendar) |
0808d911 | 40 | |
cb339243 | 41 | (defconst calendar-islamic-month-name-array |
0808d911 | 42 | ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II" |
48ad4975 GM |
43 | "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"] |
44 | "Array of strings giving the names of the Islamic months.") | |
0808d911 | 45 | |
282179b2 GM |
46 | (eval-and-compile |
47 | (autoload 'calendar-absolute-from-julian "cal-julian")) | |
48 | ||
49 | (defconst calendar-islamic-epoch | |
50 | (eval-when-compile (calendar-absolute-from-julian '(7 16 622))) | |
51 | "Absolute date of start of Islamic calendar = July 16, 622 AD (Julian).") | |
0808d911 ER |
52 | |
53 | (defun islamic-calendar-leap-year-p (year) | |
c723ec5e | 54 | "Return t if YEAR is a leap year on the Islamic calendar." |
0808d911 ER |
55 | (memq (% year 30) |
56 | (list 2 5 7 10 13 16 18 21 24 26 29))) | |
57 | ||
58 | (defun islamic-calendar-last-day-of-month (month year) | |
59 | "The last day in MONTH during YEAR on the Islamic calendar." | |
60 | (cond | |
61 | ((memq month (list 1 3 5 7 9 11)) 30) | |
62 | ((memq month (list 2 4 6 8 10)) 29) | |
63 | (t (if (islamic-calendar-leap-year-p year) 30 29)))) | |
64 | ||
65 | (defun islamic-calendar-day-number (date) | |
66 | "Return the day number within the year of the Islamic date DATE." | |
f852191f GM |
67 | (let ((month (extract-calendar-month date))) |
68 | (+ (* 30 (/ month 2)) | |
69 | (* 29 (/ (1- month) 2)) | |
70 | (extract-calendar-day date)))) | |
0808d911 ER |
71 | |
72 | (defun calendar-absolute-from-islamic (date) | |
73 | "Absolute date of Islamic DATE. | |
74 | The absolute date is the number of days elapsed since the (imaginary) | |
75 | Gregorian date Sunday, December 31, 1 BC." | |
76 | (let* ((month (extract-calendar-month date)) | |
77 | (day (extract-calendar-day date)) | |
78 | (year (extract-calendar-year date)) | |
79 | (y (% year 30)) | |
b2fba013 GM |
80 | (leap-years-in-cycle (cond ((< y 3) 0) |
81 | ((< y 6) 1) | |
82 | ((< y 8) 2) | |
83 | ((< y 11) 3) | |
84 | ((< y 14) 4) | |
85 | ((< y 17) 5) | |
86 | ((< y 19) 6) | |
87 | ((< y 22) 7) | |
88 | ((< y 25) 8) | |
89 | ((< y 27) 9) | |
90 | (t 10)))) | |
c9f8e628 GM |
91 | (+ (islamic-calendar-day-number date) ; days so far this year |
92 | (* (1- year) 354) ; days in all non-leap years | |
93 | (* 11 (/ year 30)) ; leap days in complete cycles | |
94 | leap-years-in-cycle ; leap days this cycle | |
95 | (1- calendar-islamic-epoch)))) ; days before start of calendar | |
0808d911 ER |
96 | |
97 | (defun calendar-islamic-from-absolute (date) | |
98 | "Compute the Islamic date (month day year) corresponding to absolute DATE. | |
99 | The absolute date is the number of days elapsed since the (imaginary) | |
100 | Gregorian date Sunday, December 31, 1 BC." | |
101 | (if (< date calendar-islamic-epoch) | |
c9f8e628 | 102 | (list 0 0 0) ; pre-Islamic date |
0808d911 | 103 | (let* ((approx (/ (- date calendar-islamic-epoch) |
c9f8e628 GM |
104 | 355)) ; approximation from below |
105 | (year ; search forward from the approximation | |
0808d911 ER |
106 | (+ approx |
107 | (calendar-sum y approx | |
108 | (>= date (calendar-absolute-from-islamic | |
109 | (list 1 1 (1+ y)))) | |
110 | 1))) | |
c9f8e628 | 111 | (month ; search forward from Muharram |
0808d911 ER |
112 | (1+ (calendar-sum m 1 |
113 | (> date | |
114 | (calendar-absolute-from-islamic | |
115 | (list m | |
116 | (islamic-calendar-last-day-of-month | |
117 | m year) | |
118 | year))) | |
119 | 1))) | |
c9f8e628 | 120 | (day ; calculate the day by subtraction |
0808d911 ER |
121 | (- date |
122 | (1- (calendar-absolute-from-islamic (list month 1 year)))))) | |
123 | (list month day year)))) | |
124 | ||
9e85002d | 125 | ;;;###cal-autoload |
0808d911 ER |
126 | (defun calendar-islamic-date-string (&optional date) |
127 | "String of Islamic date before sunset of Gregorian DATE. | |
128 | Returns the empty string if DATE is pre-Islamic. | |
129 | Defaults to today's date if DATE is not given. | |
130 | Driven by the variable `calendar-date-display-form'." | |
131 | (let ((calendar-month-name-array calendar-islamic-month-name-array) | |
132 | (islamic-date (calendar-islamic-from-absolute | |
133 | (calendar-absolute-from-gregorian | |
134 | (or date (calendar-current-date)))))) | |
135 | (if (< (extract-calendar-year islamic-date) 1) | |
136 | "" | |
137 | (calendar-date-string islamic-date nil t)))) | |
138 | ||
9e85002d | 139 | ;;;###cal-autoload |
0808d911 ER |
140 | (defun calendar-print-islamic-date () |
141 | "Show the Islamic calendar equivalent of the date under the cursor." | |
142 | (interactive) | |
143 | (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t)))) | |
144 | (if (string-equal i "") | |
145 | (message "Date is pre-Islamic") | |
146 | (message "Islamic date (until sunset): %s" i)))) | |
147 | ||
1cdb4ad7 GM |
148 | (defun calendar-islamic-read-date () |
149 | "Interactively read the arguments for an Islamic date command. | |
150 | Reads a year, month, and day." | |
b2fba013 GM |
151 | (let* ((today (calendar-current-date)) |
152 | (year (calendar-read | |
153 | "Islamic calendar year (>0): " | |
154 | (lambda (x) (> x 0)) | |
155 | (int-to-string | |
156 | (extract-calendar-year | |
157 | (calendar-islamic-from-absolute | |
158 | (calendar-absolute-from-gregorian today)))))) | |
159 | (month-array calendar-islamic-month-name-array) | |
160 | (completion-ignore-case t) | |
161 | (month (cdr (assoc-string | |
162 | (completing-read | |
163 | "Islamic calendar month name: " | |
164 | (mapcar 'list (append month-array nil)) | |
165 | nil t) | |
166 | (calendar-make-alist month-array 1) t))) | |
167 | (last (islamic-calendar-last-day-of-month month year)) | |
168 | (day (calendar-read | |
169 | (format "Islamic calendar day (1-%d): " last) | |
170 | (lambda (x) (and (< 0 x) (<= x last)))))) | |
171 | (list (list month day year)))) | |
172 | ||
9e85002d | 173 | ;;;###cal-autoload |
0808d911 | 174 | (defun calendar-goto-islamic-date (date &optional noecho) |
f852191f | 175 | "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is non-nil." |
1cdb4ad7 | 176 | (interactive (calendar-islamic-read-date)) |
0808d911 ER |
177 | (calendar-goto-date (calendar-gregorian-from-absolute |
178 | (calendar-absolute-from-islamic date))) | |
179 | (or noecho (calendar-print-islamic-date))) | |
180 | ||
f852191f GM |
181 | (defvar displayed-month) ; from generate-calendar |
182 | (defvar displayed-year) | |
183 | ||
9e85002d | 184 | ;;;###holiday-autoload |
0808d911 ER |
185 | (defun holiday-islamic (month day string) |
186 | "Holiday on MONTH, DAY (Islamic) called STRING. | |
187 | If MONTH, DAY (Islamic) is visible, the value returned is corresponding | |
188 | Gregorian date in the form of the list (((month day year) STRING)). Returns | |
189 | nil if it is not visible in the current calendar window." | |
190 | (let* ((islamic-date (calendar-islamic-from-absolute | |
191 | (calendar-absolute-from-gregorian | |
192 | (list displayed-month 15 displayed-year)))) | |
193 | (m (extract-calendar-month islamic-date)) | |
194 | (y (extract-calendar-year islamic-date)) | |
195 | (date)) | |
f852191f | 196 | (unless (< m 1) ; Islamic calendar doesn't apply |
0808d911 | 197 | (increment-calendar-month m y (- 10 month)) |
f852191f | 198 | (if (> m 7) ; Islamic date might be visible |
0808d911 ER |
199 | (let ((date (calendar-gregorian-from-absolute |
200 | (calendar-absolute-from-islamic (list month day y))))) | |
201 | (if (calendar-date-is-visible-p date) | |
202 | (list (list date string)))))))) | |
203 | ||
cb339243 | 204 | (autoload 'diary-list-entries-1 "diary-lib") |
6546bf55 | 205 | |
9e85002d | 206 | ;;;###diary-autoload |
0808d911 ER |
207 | (defun list-islamic-diary-entries () |
208 | "Add any Islamic date entries from the diary file to `diary-entries-list'. | |
c723ec5e | 209 | Islamic date diary entries must be prefaced by `islamic-diary-entry-symbol' |
cb339243 | 210 | \(normally an `I'). The same `diary-date-forms' govern the style |
c723ec5e | 211 | of the Islamic calendar entries, except that the Islamic month |
2b79de59 | 212 | names cannot be abbreviated. The Islamic months are numbered |
c723ec5e GM |
213 | from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah. |
214 | If an Islamic date diary entry begins with `diary-nonmarking-symbol', | |
215 | the entry will appear in the diary listing, but will not be | |
216 | marked in the calendar. This function is provided for use with | |
0808d911 | 217 | `nongregorian-diary-listing-hook'." |
cb339243 GM |
218 | (diary-list-entries-1 calendar-islamic-month-name-array |
219 | islamic-diary-entry-symbol | |
220 | 'calendar-islamic-from-absolute)) | |
0808d911 | 221 | |
b2fba013 GM |
222 | (autoload 'calendar-mark-1 "diary-lib") |
223 | ||
9e85002d | 224 | ;;;###diary-autoload |
b2fba013 | 225 | (defun mark-islamic-calendar-date-pattern (month day year &optional color) |
0808d911 | 226 | "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR. |
b2fba013 GM |
227 | A value of 0 in any position is a wildcard. Optional argument COLOR is |
228 | passed to `mark-visible-calendar-date' as MARK." | |
229 | (calendar-mark-1 month day year 'calendar-islamic-from-absolute | |
230 | 'calendar-absolute-from-islamic color)) | |
0808d911 | 231 | |
cb339243 | 232 | (autoload 'diary-mark-entries-1 "diary-lib") |
f852191f GM |
233 | |
234 | ;;;###diary-autoload | |
235 | (defun mark-islamic-diary-entries () | |
236 | "Mark days in the calendar window that have Islamic date diary entries. | |
cb339243 GM |
237 | Marks each entry in `diary-file' (or included files) visible in the calendar |
238 | window. See `list-islamic-diary-entries' for more information." | |
239 | (diary-mark-entries-1 calendar-islamic-month-name-array | |
240 | islamic-diary-entry-symbol | |
241 | 'calendar-islamic-from-absolute | |
242 | 'mark-islamic-calendar-date-pattern)) | |
f852191f | 243 | |
9e85002d | 244 | ;;;###cal-autoload |
0808d911 ER |
245 | (defun insert-islamic-diary-entry (arg) |
246 | "Insert a diary entry. | |
247 | For the Islamic date corresponding to the date indicated by point. | |
c723ec5e | 248 | Prefix argument ARG makes the entry nonmarking." |
0808d911 | 249 | (interactive "P") |
f852191f | 250 | (let ((calendar-month-name-array calendar-islamic-month-name-array)) |
0808d911 | 251 | (make-diary-entry |
f852191f GM |
252 | (concat islamic-diary-entry-symbol |
253 | (calendar-date-string | |
254 | (calendar-islamic-from-absolute | |
255 | (calendar-absolute-from-gregorian (calendar-cursor-to-date t))) | |
256 | nil t)) | |
0808d911 ER |
257 | arg))) |
258 | ||
9e85002d | 259 | ;;;###cal-autoload |
0808d911 ER |
260 | (defun insert-monthly-islamic-diary-entry (arg) |
261 | "Insert a monthly diary entry. | |
262 | For the day of the Islamic month corresponding to the date indicated by point. | |
c723ec5e | 263 | Prefix argument ARG makes the entry nonmarking." |
0808d911 | 264 | (interactive "P") |
f852191f GM |
265 | (let ((calendar-date-display-form (if european-calendar-style |
266 | '(day " * ") | |
267 | '("* " day ))) | |
268 | (calendar-month-name-array calendar-islamic-month-name-array)) | |
0808d911 | 269 | (make-diary-entry |
f852191f GM |
270 | (concat islamic-diary-entry-symbol |
271 | (calendar-date-string | |
272 | (calendar-islamic-from-absolute | |
273 | (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) | |
0808d911 ER |
274 | arg))) |
275 | ||
9e85002d | 276 | ;;;###cal-autoload |
0808d911 ER |
277 | (defun insert-yearly-islamic-diary-entry (arg) |
278 | "Insert an annual diary entry. | |
279 | For the day of the Islamic year corresponding to the date indicated by point. | |
c723ec5e | 280 | Prefix argument ARG makes the entry nonmarking." |
0808d911 | 281 | (interactive "P") |
f852191f GM |
282 | (let ((calendar-date-display-form (if european-calendar-style |
283 | '(day " " monthname) | |
284 | '(monthname " " day))) | |
285 | (calendar-month-name-array calendar-islamic-month-name-array)) | |
0808d911 | 286 | (make-diary-entry |
f852191f GM |
287 | (concat islamic-diary-entry-symbol |
288 | (calendar-date-string | |
289 | (calendar-islamic-from-absolute | |
290 | (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) | |
0808d911 ER |
291 | arg))) |
292 | ||
6546bf55 GM |
293 | (defvar date) |
294 | ||
295 | ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. | |
9e85002d | 296 | ;;;###diary-autoload |
6546bf55 GM |
297 | (defun diary-islamic-date () |
298 | "Islamic calendar equivalent of date diary entry." | |
299 | (let ((i (calendar-islamic-date-string date))) | |
300 | (if (string-equal i "") | |
301 | "Date is pre-Islamic" | |
302 | (format "Islamic date (until sunset): %s" i)))) | |
303 | ||
afdbe61d | 304 | (provide 'cal-islam) |
0808d911 | 305 | |
d383fd97 | 306 | ;; arch-tag: a951b6c1-6f47-48d5-bac3-1b505cd719f7 |
afdbe61d | 307 | ;;; cal-islam.el ends here |