1 ;;; cal-islam.el --- calendar functions for the Islamic calendar
3 ;; Copyright (C) 1995, 1997, 2001, 2003 Free Software Foundation, Inc.
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
7 ;; Human-Keywords: Islamic calendar, calendar, diary
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
28 ;; This collection of functions implements the features of calendar.el and
29 ;; diary.el that deal with the Islamic calendar.
31 ;; Technical details of all the calendrical calculations can be found in
32 ;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
33 ;; and Nachum Dershowitz, Cambridge University Press (2001).
35 ;; Comments, corrections, and improvements should be sent to
36 ;; Edward M. Reingold Department of Computer Science
37 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
38 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
39 ;; Urbana, Illinois 61801
44 (defvar displayed-month)
45 (defvar displayed-year)
47 (defvar original-date)
51 (defvar calendar-islamic-month-name-array
52 ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
53 "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"]
54 "Array of strings giving the names of the Islamic months.")
56 (defvar calendar-islamic-epoch (calendar-absolute-from-julian '(7 16 622))
57 "Absolute date of start of Islamic calendar = August 29, 284 A.D. (Julian).")
59 (defun islamic-calendar-leap-year-p (year)
60 "Returns t if YEAR is a leap year on the Islamic calendar."
62 (list 2 5 7 10 13 16 18 21 24 26 29)))
64 (defun islamic-calendar-last-day-of-month (month year)
65 "The last day in MONTH during YEAR on the Islamic calendar."
67 ((memq month (list 1 3 5 7 9 11)) 30)
68 ((memq month (list 2 4 6 8 10)) 29)
69 (t (if (islamic-calendar-leap-year-p year) 30 29))))
71 (defun islamic-calendar-day-number (date)
72 "Return the day number within the year of the Islamic date DATE."
73 (let* ((month (extract-calendar-month date))
74 (day (extract-calendar-day date)))
76 (* 29 (/ (1- month) 2))
79 (defun calendar-absolute-from-islamic (date)
80 "Absolute date of Islamic DATE.
81 The absolute date is the number of days elapsed since the (imaginary)
82 Gregorian date Sunday, December 31, 1 BC."
83 (let* ((month (extract-calendar-month date))
84 (day (extract-calendar-day date))
85 (year (extract-calendar-year date))
89 ((< y 3) 0) ((< y 6) 1) ((< y 8) 2) ((< y 11) 3) ((< y 14) 4)
90 ((< y 17) 5) ((< y 19) 6) ((< y 22) 7) ((< y 25) 8) ((< y 27) 9)
92 (+ (islamic-calendar-day-number date);; days so far this year
93 (* (1- year) 354) ;; days in all non-leap years
94 (* 11 (/ year 30)) ;; leap days in complete cycles
95 leap-years-in-cycle ;; leap days this cycle
96 (1- calendar-islamic-epoch)))) ;; days before start of calendar
98 (defun calendar-islamic-from-absolute (date)
99 "Compute the Islamic date (month day year) corresponding to absolute DATE.
100 The absolute date is the number of days elapsed since the (imaginary)
101 Gregorian date Sunday, December 31, 1 BC."
102 (if (< date calendar-islamic-epoch)
103 (list 0 0 0);; pre-Islamic date
104 (let* ((approx (/ (- date calendar-islamic-epoch)
105 355));; Approximation from below.
106 (year ;; Search forward from the approximation.
108 (calendar-sum y approx
109 (>= date (calendar-absolute-from-islamic
112 (month ;; Search forward from Muharram.
113 (1+ (calendar-sum m 1
115 (calendar-absolute-from-islamic
117 (islamic-calendar-last-day-of-month
121 (day ;; Calculate the day by subtraction.
123 (1- (calendar-absolute-from-islamic (list month 1 year))))))
124 (list month day year))))
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)
137 (calendar-date-string islamic-date nil t))))
139 (defun calendar-print-islamic-date ()
140 "Show the Islamic calendar equivalent of the date under the cursor."
142 (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t))))
143 (if (string-equal i "")
144 (message "Date is pre-Islamic")
145 (message "Islamic date (until sunset): %s" i))))
147 (defun calendar-goto-islamic-date (date &optional noecho)
148 "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is t."
150 (let* ((today (calendar-current-date))
152 "Islamic calendar year (>0): "
153 '(lambda (x) (> x 0))
155 (extract-calendar-year
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
162 "Islamic calendar month name: "
163 (mapcar 'list (append month-array nil))
165 (calendar-make-alist month-array 1) t)))
166 (last (islamic-calendar-last-day-of-month month year))
168 (format "Islamic calendar day (1-%d): " last)
169 '(lambda (x) (and (< 0 x) (<= x last))))))
170 (list (list month day year))))
171 (calendar-goto-date (calendar-gregorian-from-absolute
172 (calendar-absolute-from-islamic date)))
173 (or noecho (calendar-print-islamic-date)))
175 (defun diary-islamic-date ()
176 "Islamic calendar equivalent of date diary entry."
177 (let ((i (calendar-islamic-date-string date)))
178 (if (string-equal i "")
179 "Date is pre-Islamic"
180 (format "Islamic date (until sunset): %s" i))))
182 (defun holiday-islamic (month day string)
183 "Holiday on MONTH, DAY (Islamic) called STRING.
184 If MONTH, DAY (Islamic) is visible, the value returned is corresponding
185 Gregorian date in the form of the list (((month day year) STRING)). Returns
186 nil if it is not visible in the current calendar window."
187 (let* ((islamic-date (calendar-islamic-from-absolute
188 (calendar-absolute-from-gregorian
189 (list displayed-month 15 displayed-year))))
190 (m (extract-calendar-month islamic-date))
191 (y (extract-calendar-year islamic-date))
194 nil;; Islamic calendar doesn't apply.
195 (increment-calendar-month m y (- 10 month))
196 (if (> m 7);; Islamic date might be visible
197 (let ((date (calendar-gregorian-from-absolute
198 (calendar-absolute-from-islamic (list month day y)))))
199 (if (calendar-date-is-visible-p date)
200 (list (list date string))))))))
202 (defun list-islamic-diary-entries ()
203 "Add any Islamic date entries from the diary file to `diary-entries-list'.
204 Islamic date diary entries must be prefaced by an `islamic-diary-entry-symbol'
205 \(normally an `I'). The same diary date forms govern the style of the Islamic
206 calendar entries, except that the Islamic month names must be spelled in full.
207 The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
208 Dhu al-Hijjah. If an Islamic date diary entry begins with a
209 `diary-nonmarking-symbol', the entry will appear in the diary listing, but will
210 not be marked in the calendar. This function is provided for use with the
211 `nongregorian-diary-listing-hook'."
213 (let ((buffer-read-only nil)
214 (diary-modified (buffer-modified-p))
215 (gdate original-date)
216 (mark (regexp-quote diary-nonmarking-symbol)))
217 (calendar-for-loop i from 1 to number do
218 (let* ((d diary-date-forms)
219 (idate (calendar-islamic-from-absolute
220 (calendar-absolute-from-gregorian gdate)))
221 (month (extract-calendar-month idate))
222 (day (extract-calendar-day idate))
223 (year (extract-calendar-year idate)))
226 ((date-form (if (equal (car (car d)) 'backup)
229 (backup (equal (car (car d)) 'backup))
231 (format "%s\\|%s\\.?"
232 (calendar-day-name gdate)
233 (calendar-day-name gdate 'abbrev)))
234 (calendar-month-name-array
235 calendar-islamic-month-name-array)
239 (calendar-month-name month)))
240 (month (concat "\\*\\|0*" (int-to-string month)))
241 (day (concat "\\*\\|0*" (int-to-string day)))
244 "\\*\\|0*" (int-to-string year)
245 (if abbreviated-calendar-year
246 (concat "\\|" (int-to-string (% year 100)))
250 "\\(\\`\\|\^M\\|\n\\)" mark "?"
251 (regexp-quote islamic-diary-entry-symbol)
253 (mapconcat 'eval date-form "\\)\\(")
255 (case-fold-search t))
256 (goto-char (point-min))
257 (while (re-search-forward regexp nil t)
258 (if backup (re-search-backward "\\<" nil t))
259 (if (and (or (char-equal (preceding-char) ?\^M)
260 (char-equal (preceding-char) ?\n))
261 (not (looking-at " \\|\^I")))
262 ;; Diary entry that consists only of date.
264 ;; Found a nonempty diary entry--make it visible and
265 ;; add it to the list.
266 (let ((entry-start (point))
268 (re-search-backward "\^M\\|\n\\|\\`")
269 (setq date-start (point))
270 (re-search-forward "\^M\\|\n" nil t 2)
271 (while (looking-at " \\|\^I")
272 (re-search-forward "\^M\\|\n" nil t))
274 (subst-char-in-region date-start (point) ?\^M ?\n t)
277 (buffer-substring-no-properties entry-start (point))
278 (buffer-substring-no-properties
279 (1+ date-start) (1- entry-start))
280 (copy-marker entry-start))))))
283 (calendar-gregorian-from-absolute
284 (1+ (calendar-absolute-from-gregorian gdate)))))
285 (set-buffer-modified-p diary-modified))
286 (goto-char (point-min))))
288 (defun mark-islamic-diary-entries ()
289 "Mark days in the calendar window that have Islamic date diary entries.
290 Each entry in diary-file (or included files) visible in the calendar window
291 is marked. Islamic date entries are prefaced by a islamic-diary-entry-symbol
292 \(normally an `I'). The same diary-date-forms govern the style of the Islamic
293 calendar entries, except that the Islamic month names must be spelled in full.
294 The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
295 Dhu al-Hijjah. Islamic date diary entries that begin with a
296 diary-nonmarking-symbol will not be marked in the calendar. This function is
297 provided for use as part of the nongregorian-diary-marking-hook."
298 (let ((d diary-date-forms))
301 ((date-form (if (equal (car (car d)) 'backup)
303 (car d)));; ignore 'backup directive
304 (dayname (diary-name-pattern calendar-day-name-array
305 calendar-day-abbrev-array))
308 (diary-name-pattern calendar-islamic-month-name-array)))
309 (month "[0-9]+\\|\\*")
311 (year "[0-9]+\\|\\*")
312 (l (length date-form))
313 (d-name-pos (- l (length (memq 'dayname date-form))))
314 (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
315 (m-name-pos (- l (length (memq 'monthname date-form))))
316 (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
317 (d-pos (- l (length (memq 'day date-form))))
318 (d-pos (if (/= l d-pos) (+ 2 d-pos)))
319 (m-pos (- l (length (memq 'month date-form))))
320 (m-pos (if (/= l m-pos) (+ 2 m-pos)))
321 (y-pos (- l (length (memq 'year date-form))))
322 (y-pos (if (/= l y-pos) (+ 2 y-pos)))
325 "\\(\\`\\|\^M\\|\n\\)"
326 (regexp-quote islamic-diary-entry-symbol)
328 (mapconcat 'eval date-form "\\)\\(")
330 (case-fold-search t))
331 (goto-char (point-min))
332 (while (re-search-forward regexp nil t)
336 (match-beginning d-name-pos)
337 (match-end d-name-pos))))
341 (match-beginning m-name-pos)
342 (match-end m-name-pos))))
343 (mm (string-to-number
346 (match-beginning m-pos)
349 (dd (string-to-number
352 (match-beginning d-pos)
357 (match-beginning y-pos)
361 (if (and (= (length y-str) 2)
362 abbreviated-calendar-year)
364 (extract-calendar-year
365 (calendar-islamic-from-absolute
366 (calendar-absolute-from-gregorian
367 (calendar-current-date)))))
368 (y (+ (string-to-number y-str)
369 (* 100 (/ current-y 100)))))
370 (if (> (- y current-y) 50)
372 (if (> (- current-y y) 50)
375 (string-to-number y-str)))))
377 (mark-calendar-days-named
378 (cdr (assoc-string dd-name
380 calendar-day-name-array
381 0 nil calendar-day-abbrev-array) t)))
383 (setq mm (if (string-equal mm-name "*") 0
387 calendar-islamic-month-name-array) t)))))
388 (mark-islamic-calendar-date-pattern mm dd yy)))))
391 (defun mark-islamic-calendar-date-pattern (month day year)
392 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
393 A value of 0 in any position is a wildcard."
395 (set-buffer calendar-buffer)
396 (if (and (/= 0 month) (/= 0 day))
398 ;; Fully specified Islamic date.
399 (let ((date (calendar-gregorian-from-absolute
400 (calendar-absolute-from-islamic
401 (list month day year)))))
402 (if (calendar-date-is-visible-p date)
403 (mark-visible-calendar-date date)))
404 ;; Month and day in any year--this taken from the holiday stuff.
405 (let* ((islamic-date (calendar-islamic-from-absolute
406 (calendar-absolute-from-gregorian
407 (list displayed-month 15 displayed-year))))
408 (m (extract-calendar-month islamic-date))
409 (y (extract-calendar-year islamic-date))
412 nil;; Islamic calendar doesn't apply.
413 (increment-calendar-month m y (- 10 month))
414 (if (> m 7);; Islamic date might be visible
415 (let ((date (calendar-gregorian-from-absolute
416 (calendar-absolute-from-islamic
417 (list month day y)))))
418 (if (calendar-date-is-visible-p date)
419 (mark-visible-calendar-date date)))))))
420 ;; Not one of the simple cases--check all visible dates for match.
421 ;; Actually, the following code takes care of ALL of the cases, but
422 ;; it's much too slow to be used for the simple (common) cases.
423 (let ((m displayed-month)
427 (increment-calendar-month m y -1)
429 (calendar-absolute-from-gregorian
431 (increment-calendar-month m y 2)
433 (calendar-absolute-from-gregorian
434 (list m (calendar-last-day-of-month m y) y)))
435 (calendar-for-loop date from first-date to last-date do
436 (let* ((i-date (calendar-islamic-from-absolute date))
437 (i-month (extract-calendar-month i-date))
438 (i-day (extract-calendar-day i-date))
439 (i-year (extract-calendar-year i-date)))
440 (and (or (zerop month)
446 (mark-visible-calendar-date
447 (calendar-gregorian-from-absolute date)))))))))
449 (defun insert-islamic-diary-entry (arg)
450 "Insert a diary entry.
451 For the Islamic date corresponding to the date indicated by point.
452 Prefix arg will make the entry nonmarking."
454 (let* ((calendar-month-name-array calendar-islamic-month-name-array))
457 islamic-diary-entry-symbol
458 (calendar-date-string
459 (calendar-islamic-from-absolute
460 (calendar-absolute-from-gregorian
461 (calendar-cursor-to-date t)))
465 (defun insert-monthly-islamic-diary-entry (arg)
466 "Insert a monthly diary entry.
467 For the day of the Islamic month corresponding to the date indicated by point.
468 Prefix arg will make the entry nonmarking."
470 (let* ((calendar-date-display-form
471 (if european-calendar-style '(day " * ") '("* " day )))
472 (calendar-month-name-array calendar-islamic-month-name-array))
475 islamic-diary-entry-symbol
476 (calendar-date-string
477 (calendar-islamic-from-absolute
478 (calendar-absolute-from-gregorian
479 (calendar-cursor-to-date t)))))
482 (defun insert-yearly-islamic-diary-entry (arg)
483 "Insert an annual diary entry.
484 For the day of the Islamic year corresponding to the date indicated by point.
485 Prefix arg will make the entry nonmarking."
487 (let* ((calendar-date-display-form
488 (if european-calendar-style
490 '(monthname " " day)))
491 (calendar-month-name-array calendar-islamic-month-name-array))
494 islamic-diary-entry-symbol
495 (calendar-date-string
496 (calendar-islamic-from-absolute
497 (calendar-absolute-from-gregorian
498 (calendar-cursor-to-date t)))))
503 ;;; arch-tag: a951b6c1-6f47-48d5-bac3-1b505cd719f7
504 ;;; cal-islam.el ends here