1 ;;; cal-islam.el --- calendar functions for the Islamic calendar
3 ;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4 ;; 2008 Free Software Foundation, Inc.
6 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
7 ;; Maintainer: Glenn Morris <rgm@gnu.org>
9 ;; Human-Keywords: Islamic calendar, calendar, diary
11 ;; This file is part of GNU Emacs.
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
15 ;; the Free Software Foundation; either version 3, or (at your option)
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.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
36 (defconst calendar-islamic-month-name-array
37 ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
38 "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"]
39 "Array of strings giving the names of the Islamic months.")
42 (autoload 'calendar-absolute-from-julian
"cal-julian"))
44 (defconst calendar-islamic-epoch
45 (eval-when-compile (calendar-absolute-from-julian '(7 16 622)))
46 "Absolute date of start of Islamic calendar = July 16, 622 AD (Julian).")
48 (defun islamic-calendar-leap-year-p (year)
49 "Return t if YEAR is a leap year on the Islamic calendar."
51 (list 2 5 7 10 13 16 18 21 24 26 29)))
53 (defun islamic-calendar-last-day-of-month (month year
)
54 "The last day in MONTH during YEAR on the Islamic calendar."
56 ((memq month
(list 1 3 5 7 9 11)) 30)
57 ((memq month
(list 2 4 6 8 10)) 29)
58 (t (if (islamic-calendar-leap-year-p year
) 30 29))))
60 (defun islamic-calendar-day-number (date)
61 "Return the day number within the year of the Islamic date DATE."
62 (let ((month (extract-calendar-month date
)))
64 (* 29 (/ (1- month
) 2))
65 (extract-calendar-day date
))))
67 (defun calendar-absolute-from-islamic (date)
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."
71 (let* ((month (extract-calendar-month date
))
72 (day (extract-calendar-day date
))
73 (year (extract-calendar-year date
))
75 (leap-years-in-cycle (cond ((< y
3) 0)
86 (+ (islamic-calendar-day-number date
) ; days so far this year
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
92 (defun calendar-islamic-from-absolute (date)
93 "Compute the Islamic date (month day year) corresponding to absolute DATE.
94 The absolute date is the number of days elapsed since the (imaginary)
95 Gregorian date Sunday, December 31, 1 BC."
96 (if (< date calendar-islamic-epoch
)
97 (list 0 0 0) ; pre-Islamic date
98 (let* ((approx (/ (- date calendar-islamic-epoch
)
99 355)) ; approximation from below
100 (year ; search forward from the approximation
102 (calendar-sum y approx
103 (>= date
(calendar-absolute-from-islamic
106 (month ; search forward from Muharram
107 (1+ (calendar-sum m
1
109 (calendar-absolute-from-islamic
111 (islamic-calendar-last-day-of-month
115 (day ; calculate the day by subtraction
117 (1- (calendar-absolute-from-islamic (list month
1 year
))))))
118 (list month day year
))))
121 (defun calendar-islamic-date-string (&optional date
)
122 "String of Islamic date before sunset of Gregorian DATE.
123 Returns the empty string if DATE is pre-Islamic.
124 Defaults to today's date if DATE is not given.
125 Driven by the variable `calendar-date-display-form'."
126 (let ((calendar-month-name-array calendar-islamic-month-name-array
)
127 (islamic-date (calendar-islamic-from-absolute
128 (calendar-absolute-from-gregorian
129 (or date
(calendar-current-date))))))
130 (if (< (extract-calendar-year islamic-date
) 1)
132 (calendar-date-string islamic-date nil t
))))
135 (defun calendar-print-islamic-date ()
136 "Show the Islamic calendar equivalent of the date under the cursor."
138 (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t
))))
139 (if (string-equal i
"")
140 (message "Date is pre-Islamic")
141 (message "Islamic date (until sunset): %s" i
))))
143 (defun calendar-islamic-read-date ()
144 "Interactively read the arguments for an Islamic date command.
145 Reads a year, month, and day."
146 (let* ((today (calendar-current-date))
148 "Islamic calendar year (>0): "
151 (extract-calendar-year
152 (calendar-islamic-from-absolute
153 (calendar-absolute-from-gregorian today
))))))
154 (month-array calendar-islamic-month-name-array
)
155 (completion-ignore-case t
)
156 (month (cdr (assoc-string
158 "Islamic calendar month name: "
159 (mapcar 'list
(append month-array nil
))
161 (calendar-make-alist month-array
1) t
)))
162 (last (islamic-calendar-last-day-of-month month year
))
164 (format "Islamic calendar day (1-%d): " last
)
165 (lambda (x) (and (< 0 x
) (<= x last
))))))
166 (list (list month day year
))))
169 (defun calendar-goto-islamic-date (date &optional noecho
)
170 "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is non-nil."
171 (interactive (calendar-islamic-read-date))
172 (calendar-goto-date (calendar-gregorian-from-absolute
173 (calendar-absolute-from-islamic date
)))
174 (or noecho
(calendar-print-islamic-date)))
176 (defvar displayed-month
) ; from generate-calendar
177 (defvar displayed-year
)
179 ;;;###holiday-autoload
180 (defun holiday-islamic (month day string
)
181 "Holiday on MONTH, DAY (Islamic) called STRING.
182 If MONTH, DAY (Islamic) is visible, the value returned is corresponding
183 Gregorian date in the form of the list (((month day year) STRING)). Returns
184 nil if it is not visible in the current calendar window."
185 ;; Islamic date corresponding to the center of the calendar window.
186 ;; Since the calendar displays 3 months at a time, there are approx
187 ;; 45 visible days either side of this date. Given the length of
188 ;; the Islamic months, this means up to two different months are
189 ;; visible either side of the central date.
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
))
196 (unless (< m
1) ; Islamic calendar doesn't apply
197 ;; Since converting to absolute dates can be a complex
198 ;; operation, we try to speed things up by excluding those date
199 ;; ranges that can't possibly be visible.
200 ;; We can view the situation (see above) as if we had a calendar
201 ;; window displaying 5 months at a time. When month m is
202 ;; central, months m-2:m+2 (modulo 12) might be visible.
203 ;; Recall from holiday-fixed that with a 3 month calendar
204 ;; window, November is special, because we can do a one-sided
205 ;; inclusion test. When November is central is when the end of
206 ;; year first appears on the calendar. Similarly, with a 5
207 ;; month window, October is special. When October is central is
208 ;; when the end of year first appears, and when January is
209 ;; central, October is no longer visible. October is visible
210 ;; when the central month is >= 8.
211 ;; Hence to test if any given month might be visible, we can
212 ;; shift things and ask about October.
213 ;; At the same time, we work out the appropriate year y to use.
214 (increment-calendar-month m y
(- 10 month
))
215 (and (> m
7) ; Islamic date might be visible
216 (calendar-date-is-visible-p
217 (setq date
(calendar-gregorian-from-absolute
218 (calendar-absolute-from-islamic (list month day y
)))))
219 (list (list date string
))))))
221 ;;;###holiday-autoload
222 (defun holiday-islamic-new-year ()
223 "Holiday entry for the Islamic New Year, if visible in the calendar window."
224 (let ((date (caar (holiday-islamic 1 1 "")))
229 (format "Islamic New Year %d"
231 (increment-calendar-month m y
1)
232 (extract-calendar-year
233 (calendar-islamic-from-absolute
234 (calendar-absolute-from-gregorian
235 (list m
(calendar-last-day-of-month m y
) y
)
238 (autoload 'diary-list-entries-1
"diary-lib")
241 (defun list-islamic-diary-entries ()
242 "Add any Islamic date entries from the diary file to `diary-entries-list'.
243 Islamic date diary entries must be prefaced by `islamic-diary-entry-symbol'
244 \(normally an `I'). The same `diary-date-forms' govern the style
245 of the Islamic calendar entries, except that the Islamic month
246 names cannot be abbreviated. The Islamic months are numbered
247 from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah.
248 If an Islamic date diary entry begins with `diary-nonmarking-symbol',
249 the entry will appear in the diary listing, but will not be
250 marked in the calendar. This function is provided for use with
251 `nongregorian-diary-listing-hook'."
252 (diary-list-entries-1 calendar-islamic-month-name-array
253 islamic-diary-entry-symbol
254 'calendar-islamic-from-absolute
))
256 (autoload 'calendar-mark-1
"diary-lib")
259 (defun mark-islamic-calendar-date-pattern (month day year
&optional color
)
260 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
261 A value of 0 in any position is a wildcard. Optional argument COLOR is
262 passed to `mark-visible-calendar-date' as MARK."
263 (calendar-mark-1 month day year
'calendar-islamic-from-absolute
264 'calendar-absolute-from-islamic color
))
266 (autoload 'diary-mark-entries-1
"diary-lib")
269 (defun mark-islamic-diary-entries ()
270 "Mark days in the calendar window that have Islamic date diary entries.
271 Marks each entry in `diary-file' (or included files) visible in the calendar
272 window. See `list-islamic-diary-entries' for more information."
273 (diary-mark-entries-1 'mark-islamic-calendar-date-pattern
274 calendar-islamic-month-name-array
275 islamic-diary-entry-symbol
276 'calendar-islamic-from-absolute
))
279 (autoload 'diary-insert-entry-1
"diary-lib")
282 (defun insert-islamic-diary-entry (arg)
283 "Insert a diary entry.
284 For the Islamic date corresponding to the date indicated by point.
285 Prefix argument ARG makes the entry nonmarking."
287 (diary-insert-entry-1 nil arg calendar-islamic-month-name-array
288 islamic-diary-entry-symbol
289 'calendar-islamic-from-absolute
))
292 (defun insert-monthly-islamic-diary-entry (arg)
293 "Insert a monthly diary entry.
294 For the day of the Islamic month corresponding to the date indicated by point.
295 Prefix argument ARG makes the entry nonmarking."
297 (diary-insert-entry-1 'monthly arg calendar-islamic-month-name-array
298 islamic-diary-entry-symbol
299 'calendar-islamic-from-absolute
))
302 (defun insert-yearly-islamic-diary-entry (arg)
303 "Insert an annual diary entry.
304 For the day of the Islamic year corresponding to the date indicated by point.
305 Prefix argument ARG makes the entry nonmarking."
307 (diary-insert-entry-1 'yearly arg calendar-islamic-month-name-array
308 islamic-diary-entry-symbol
309 'calendar-islamic-from-absolute
))
313 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
315 (defun diary-islamic-date ()
316 "Islamic calendar equivalent of date diary entry."
317 (let ((i (calendar-islamic-date-string date
)))
318 (if (string-equal i
"")
319 "Date is pre-Islamic"
320 (format "Islamic date (until sunset): %s" i
))))
324 ;; arch-tag: a951b6c1-6f47-48d5-bac3-1b505cd719f7
325 ;;; cal-islam.el ends here