1 ;;; cal-islam.el --- calendar functions for the Islamic calendar.
3 ;; Copyright (C) 1995, 1997 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., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, 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'' by Nachum Dershowitz and Edward M. Reingold,
33 ;; Cambridge University Press (1997).
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
45 (defvar calendar-islamic-month-name-array
46 ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
47 "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"])
49 (defvar calendar-islamic-epoch
(calendar-absolute-from-julian '(7 16 622))
50 "Absolute date of start of Islamic calendar = August 29, 284 A.D. (Julian).")
52 (defun islamic-calendar-leap-year-p (year)
53 "Returns t if YEAR is a leap year on the Islamic calendar."
55 (list 2 5 7 10 13 16 18 21 24 26 29)))
57 (defun islamic-calendar-last-day-of-month (month year
)
58 "The last day in MONTH during YEAR on the Islamic calendar."
60 ((memq month
(list 1 3 5 7 9 11)) 30)
61 ((memq month
(list 2 4 6 8 10)) 29)
62 (t (if (islamic-calendar-leap-year-p year
) 30 29))))
64 (defun islamic-calendar-day-number (date)
65 "Return the day number within the year of the Islamic date DATE."
66 (let* ((month (extract-calendar-month date
))
67 (day (extract-calendar-day date
)))
69 (* 29 (/ (1- month
) 2))
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
))
82 ((< y
3) 0) ((< y
6) 1) ((< y
8) 2) ((< y
11) 3) ((< y
14) 4)
83 ((< y
17) 5) ((< y
19) 6) ((< y
22) 7) ((< y
25) 8) ((< y
27) 9)
85 (+ (islamic-calendar-day-number date
);; days so far this year
86 (* (1- year
) 354) ;; days in all non-leap years
87 (* 11 (/ year
30)) ;; leap days in complete cycles
88 leap-years-in-cycle
;; leap days this cycle
89 (1- calendar-islamic-epoch
)))) ;; days before start of calendar
91 (defun calendar-islamic-from-absolute (date)
92 "Compute the Islamic date (month day year) corresponding to absolute DATE.
93 The absolute date is the number of days elapsed since the (imaginary)
94 Gregorian date Sunday, December 31, 1 BC."
95 (if (< date calendar-islamic-epoch
)
96 (list 0 0 0);; pre-Islamic date
97 (let* ((approx (/ (- date calendar-islamic-epoch
)
98 355));; Approximation from below.
99 (year ;; Search forward from the approximation.
101 (calendar-sum y approx
102 (>= date
(calendar-absolute-from-islamic
105 (month ;; Search forward from Muharram.
106 (1+ (calendar-sum m
1
108 (calendar-absolute-from-islamic
110 (islamic-calendar-last-day-of-month
114 (day ;; Calculate the day by subtraction.
116 (1- (calendar-absolute-from-islamic (list month
1 year
))))))
117 (list month day year
))))
119 (defun calendar-islamic-date-string (&optional date
)
120 "String of Islamic date before sunset of Gregorian DATE.
121 Returns the empty string if DATE is pre-Islamic.
122 Defaults to today's date if DATE is not given.
123 Driven by the variable `calendar-date-display-form'."
124 (let ((calendar-month-name-array calendar-islamic-month-name-array
)
125 (islamic-date (calendar-islamic-from-absolute
126 (calendar-absolute-from-gregorian
127 (or date
(calendar-current-date))))))
128 (if (< (extract-calendar-year islamic-date
) 1)
130 (calendar-date-string islamic-date nil t
))))
132 (defun calendar-print-islamic-date ()
133 "Show the Islamic calendar equivalent of the date under the cursor."
135 (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t
))))
136 (if (string-equal i
"")
137 (message "Date is pre-Islamic")
138 (message "Islamic date (until sunset): %s" i
))))
140 (defun calendar-goto-islamic-date (date &optional noecho
)
141 "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is t."
143 (let* ((today (calendar-current-date))
145 "Islamic calendar year (>0): "
146 '(lambda (x) (> x
0))
148 (extract-calendar-year
149 (calendar-islamic-from-absolute
150 (calendar-absolute-from-gregorian today
))))))
151 (month-array calendar-islamic-month-name-array
)
152 (completion-ignore-case t
)
156 "Islamic calendar month name: "
157 (mapcar 'list
(append month-array nil
))
159 (calendar-make-alist month-array
1 'capitalize
))))
160 (last (islamic-calendar-last-day-of-month month year
))
162 (format "Islamic calendar day (1-%d): " last
)
163 '(lambda (x) (and (< 0 x
) (<= x last
))))))
164 (list (list month day year
))))
165 (calendar-goto-date (calendar-gregorian-from-absolute
166 (calendar-absolute-from-islamic date
)))
167 (or noecho
(calendar-print-islamic-date)))
169 (defun diary-islamic-date ()
170 "Islamic calendar equivalent of date diary entry."
171 (let ((i (calendar-islamic-date-string date
)))
172 (if (string-equal i
"")
173 "Date is pre-Islamic"
174 (format "Islamic date (until sunset): %s" i
))))
176 (defun holiday-islamic (month day string
)
177 "Holiday on MONTH, DAY (Islamic) called STRING.
178 If MONTH, DAY (Islamic) is visible, the value returned is corresponding
179 Gregorian date in the form of the list (((month day year) STRING)). Returns
180 nil if it is not visible in the current calendar window."
181 (let* ((islamic-date (calendar-islamic-from-absolute
182 (calendar-absolute-from-gregorian
183 (list displayed-month
15 displayed-year
))))
184 (m (extract-calendar-month islamic-date
))
185 (y (extract-calendar-year islamic-date
))
188 nil
;; Islamic calendar doesn't apply.
189 (increment-calendar-month m y
(- 10 month
))
190 (if (> m
7);; Islamic date might be visible
191 (let ((date (calendar-gregorian-from-absolute
192 (calendar-absolute-from-islamic (list month day y
)))))
193 (if (calendar-date-is-visible-p date
)
194 (list (list date string
))))))))
196 (defun list-islamic-diary-entries ()
197 "Add any Islamic date entries from the diary file to `diary-entries-list'.
198 Islamic date diary entries must be prefaced by an `islamic-diary-entry-symbol'
199 \(normally an `I'). The same diary date forms govern the style of the Islamic
200 calendar entries, except that the Islamic month names must be spelled in full.
201 The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
202 Dhu al-Hijjah. If an Islamic date diary entry begins with a
203 `diary-nonmarking-symbol', the entry will appear in the diary listing, but will
204 not be marked in the calendar. This function is provided for use with the
205 `nongregorian-diary-listing-hook'."
207 (let ((buffer-read-only nil
)
208 (diary-modified (buffer-modified-p))
209 (gdate original-date
)
210 (mark (regexp-quote diary-nonmarking-symbol
)))
211 (calendar-for-loop i from
1 to number do
212 (let* ((d diary-date-forms
)
213 (idate (calendar-islamic-from-absolute
214 (calendar-absolute-from-gregorian gdate
)))
215 (month (extract-calendar-month idate
))
216 (day (extract-calendar-day idate
))
217 (year (extract-calendar-year idate
)))
220 ((date-form (if (equal (car (car d
)) 'backup
)
223 (backup (equal (car (car d
)) 'backup
))
226 (calendar-day-name gdate
) "\\|"
227 (substring (calendar-day-name gdate
) 0 3) ".?"))
228 (calendar-month-name-array
229 calendar-islamic-month-name-array
)
233 (calendar-month-name month
)))
234 (month (concat "\\*\\|0*" (int-to-string month
)))
235 (day (concat "\\*\\|0*" (int-to-string day
)))
238 "\\*\\|0*" (int-to-string year
)
239 (if abbreviated-calendar-year
240 (concat "\\|" (int-to-string (% year
100)))
244 "\\(\\`\\|\^M\\|\n\\)" mark
"?"
245 (regexp-quote islamic-diary-entry-symbol
)
247 (mapconcat 'eval date-form
"\\)\\(")
249 (case-fold-search t
))
250 (goto-char (point-min))
251 (while (re-search-forward regexp nil t
)
252 (if backup
(re-search-backward "\\<" nil t
))
253 (if (and (or (char-equal (preceding-char) ?\^M
)
254 (char-equal (preceding-char) ?
\n))
255 (not (looking-at " \\|\^I")))
256 ;; Diary entry that consists only of date.
258 ;; Found a nonempty diary entry--make it visible and
259 ;; add it to the list.
260 (let ((entry-start (point))
262 (re-search-backward "\^M\\|\n\\|\\`")
263 (setq date-start
(point))
264 (re-search-forward "\^M\\|\n" nil t
2)
265 (while (looking-at " \\|\^I")
266 (re-search-forward "\^M\\|\n" nil t
))
268 (subst-char-in-region date-start
(point) ?\^M ?
\n t
)
271 (buffer-substring-no-properties entry-start
(point))
272 (buffer-substring-no-properties
273 (1+ date-start
) (1- entry-start
)))))))
276 (calendar-gregorian-from-absolute
277 (1+ (calendar-absolute-from-gregorian gdate
)))))
278 (set-buffer-modified-p diary-modified
))
279 (goto-char (point-min))))
281 (defun mark-islamic-diary-entries ()
282 "Mark days in the calendar window that have Islamic date diary entries.
283 Each entry in diary-file (or included files) visible in the calendar window
284 is marked. Islamic date entries are prefaced by a islamic-diary-entry-symbol
285 \(normally an `I'). The same diary-date-forms govern the style of the Islamic
286 calendar entries, except that the Islamic month names must be spelled in full.
287 The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
288 Dhu al-Hijjah. Islamic date diary entries that begin with a
289 diary-nonmarking-symbol will not be marked in the calendar. This function is
290 provided for use as part of the nongregorian-diary-marking-hook."
291 (let ((d diary-date-forms
))
294 ((date-form (if (equal (car (car d
)) 'backup
)
296 (car d
)));; ignore 'backup directive
297 (dayname (diary-name-pattern calendar-day-name-array
))
300 (diary-name-pattern calendar-islamic-month-name-array t
)
302 (month "[0-9]+\\|\\*")
304 (year "[0-9]+\\|\\*")
305 (l (length date-form
))
306 (d-name-pos (- l
(length (memq 'dayname date-form
))))
307 (d-name-pos (if (/= l d-name-pos
) (+ 2 d-name-pos
)))
308 (m-name-pos (- l
(length (memq 'monthname date-form
))))
309 (m-name-pos (if (/= l m-name-pos
) (+ 2 m-name-pos
)))
310 (d-pos (- l
(length (memq 'day date-form
))))
311 (d-pos (if (/= l d-pos
) (+ 2 d-pos
)))
312 (m-pos (- l
(length (memq 'month date-form
))))
313 (m-pos (if (/= l m-pos
) (+ 2 m-pos
)))
314 (y-pos (- l
(length (memq 'year date-form
))))
315 (y-pos (if (/= l y-pos
) (+ 2 y-pos
)))
318 "\\(\\`\\|\^M\\|\n\\)"
319 (regexp-quote islamic-diary-entry-symbol
)
321 (mapconcat 'eval date-form
"\\)\\(")
323 (case-fold-search t
))
324 (goto-char (point-min))
325 (while (re-search-forward regexp nil t
)
329 (match-beginning d-name-pos
)
330 (match-end d-name-pos
))))
334 (match-beginning m-name-pos
)
335 (match-end m-name-pos
))))
339 (match-beginning m-pos
)
345 (match-beginning d-pos
)
350 (match-beginning y-pos
)
354 (if (and (= (length y-str
) 2)
355 abbreviated-calendar-year
)
357 (extract-calendar-year
358 (calendar-islamic-from-absolute
359 (calendar-absolute-from-gregorian
360 (calendar-current-date)))))
361 (y (+ (string-to-int y-str
)
362 (* 100 (/ current-y
100)))))
363 (if (> (- y current-y
) 50)
365 (if (> (- current-y y
) 50)
368 (string-to-int y-str
)))))
370 (mark-calendar-days-named
371 (cdr (assoc (capitalize (substring dd-name
0 3))
373 calendar-day-name-array
375 '(lambda (x) (substring x
0 3))))))
377 (if (string-equal mm-name
"*")
383 calendar-islamic-month-name-array
))))))
384 (mark-islamic-calendar-date-pattern mm dd yy
)))))
387 (defun mark-islamic-calendar-date-pattern (month day year
)
388 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
389 A value of 0 in any position is a wildcard."
391 (set-buffer calendar-buffer
)
392 (if (and (/= 0 month
) (/= 0 day
))
394 ;; Fully specified Islamic date.
395 (let ((date (calendar-gregorian-from-absolute
396 (calendar-absolute-from-islamic
397 (list month day year
)))))
398 (if (calendar-date-is-visible-p date
)
399 (mark-visible-calendar-date date
)))
400 ;; Month and day in any year--this taken from the holiday stuff.
401 (let* ((islamic-date (calendar-islamic-from-absolute
402 (calendar-absolute-from-gregorian
403 (list displayed-month
15 displayed-year
))))
404 (m (extract-calendar-month islamic-date
))
405 (y (extract-calendar-year islamic-date
))
408 nil
;; Islamic calendar doesn't apply.
409 (increment-calendar-month m y
(- 10 month
))
410 (if (> m
7);; Islamic date might be visible
411 (let ((date (calendar-gregorian-from-absolute
412 (calendar-absolute-from-islamic
413 (list month day y
)))))
414 (if (calendar-date-is-visible-p date
)
415 (mark-visible-calendar-date date
)))))))
416 ;; Not one of the simple cases--check all visible dates for match.
417 ;; Actually, the following code takes care of ALL of the cases, but
418 ;; it's much too slow to be used for the simple (common) cases.
419 (let ((m displayed-month
)
423 (increment-calendar-month m y -
1)
425 (calendar-absolute-from-gregorian
427 (increment-calendar-month m y
2)
429 (calendar-absolute-from-gregorian
430 (list m
(calendar-last-day-of-month m y
) y
)))
431 (calendar-for-loop date from first-date to last-date do
432 (let* ((i-date (calendar-islamic-from-absolute date
))
433 (i-month (extract-calendar-month i-date
))
434 (i-day (extract-calendar-day i-date
))
435 (i-year (extract-calendar-year i-date
)))
436 (and (or (zerop month
)
442 (mark-visible-calendar-date
443 (calendar-gregorian-from-absolute date
)))))))))
445 (defun insert-islamic-diary-entry (arg)
446 "Insert a diary entry.
447 For the Islamic date corresponding to the date indicated by point.
448 Prefix arg will make the entry nonmarking."
450 (let* ((calendar-month-name-array calendar-islamic-month-name-array
))
453 islamic-diary-entry-symbol
454 (calendar-date-string
455 (calendar-islamic-from-absolute
456 (calendar-absolute-from-gregorian
457 (calendar-cursor-to-date t
)))
461 (defun insert-monthly-islamic-diary-entry (arg)
462 "Insert a monthly diary entry.
463 For the day of the Islamic month corresponding to the date indicated by point.
464 Prefix arg will make the entry nonmarking."
466 (let* ((calendar-date-display-form
467 (if european-calendar-style
'(day " * ") '("* " day
)))
468 (calendar-month-name-array calendar-islamic-month-name-array
))
471 islamic-diary-entry-symbol
472 (calendar-date-string
473 (calendar-islamic-from-absolute
474 (calendar-absolute-from-gregorian
475 (calendar-cursor-to-date t
)))))
478 (defun insert-yearly-islamic-diary-entry (arg)
479 "Insert an annual diary entry.
480 For the day of the Islamic year corresponding to the date indicated by point.
481 Prefix arg will make the entry nonmarking."
483 (let* ((calendar-date-display-form
484 (if european-calendar-style
486 '(monthname " " day
)))
487 (calendar-month-name-array calendar-islamic-month-name-array
))
490 islamic-diary-entry-symbol
491 (calendar-date-string
492 (calendar-islamic-from-absolute
493 (calendar-absolute-from-gregorian
494 (calendar-cursor-to-date t
)))))
499 ;;; cal-islam.el ends here