Merge from origin/emacs-24
[emacs.git] / lisp / calendar / cal-islam.el
blob8e287526b5fe85d9c142b9abb1b9ac7645b01004
1 ;;; cal-islam.el --- calendar functions for the Islamic calendar
3 ;; Copyright (C) 1995, 1997, 2001-2015 Free Software Foundation, Inc.
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
6 ;; Maintainer: Glenn Morris <rgm@gnu.org>
7 ;; Keywords: calendar
8 ;; Human-Keywords: Islamic calendar, calendar, diary
9 ;; Package: calendar
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 of the License, or
16 ;; (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>.
26 ;;; Commentary:
28 ;; See calendar.el.
30 ;;; Code:
32 (require 'calendar)
34 (defconst calendar-islamic-month-name-array
35 ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
36 "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"]
37 "Array of strings giving the names of the Islamic months.")
39 (eval-and-compile
40 (autoload 'calendar-julian-to-absolute "cal-julian"))
42 (defconst calendar-islamic-epoch
43 (eval-when-compile (calendar-julian-to-absolute '(7 16 622)))
44 "Absolute date of start of Islamic calendar = July 16, 622 AD (Julian).")
46 (defun calendar-islamic-leap-year-p (year)
47 "Return t if YEAR is a leap year on the Islamic calendar."
48 (memq (% year 30)
49 (list 2 5 7 10 13 16 18 21 24 26 29)))
51 (defun calendar-islamic-last-day-of-month (month year)
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)
56 (t (if (calendar-islamic-leap-year-p year) 30 29))))
58 (defun calendar-islamic-day-number (date)
59 "Return the day number within the year of the Islamic date DATE."
60 (let ((month (calendar-extract-month date)))
61 (+ (* 30 (/ month 2))
62 (* 29 (/ (1- month) 2))
63 (calendar-extract-day date))))
65 (defun calendar-islamic-to-absolute (date)
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."
69 (let* ((month (calendar-extract-month date))
70 (day (calendar-extract-day date))
71 (year (calendar-extract-year date))
72 (y (% year 30))
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))))
84 (+ (calendar-islamic-day-number date) ; days so far this year
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
90 (defun calendar-islamic-from-absolute (date)
91 "Compute the Islamic date (month day year) corresponding to absolute DATE.
92 The absolute date is the number of days elapsed since the (imaginary)
93 Gregorian date Sunday, December 31, 1 BC."
94 (if (< date calendar-islamic-epoch)
95 (list 0 0 0) ; pre-Islamic date
96 (let* ((approx (/ (- date calendar-islamic-epoch)
97 355)) ; approximation from below
98 (year ; search forward from the approximation
99 (+ approx
100 (calendar-sum y approx
101 (>= date (calendar-islamic-to-absolute
102 (list 1 1 (1+ y))))
103 1)))
104 (month ; search forward from Muharram
105 (1+ (calendar-sum m 1
106 (> date
107 (calendar-islamic-to-absolute
108 (list m
109 (calendar-islamic-last-day-of-month
110 m year)
111 year)))
112 1)))
113 (day ; calculate the day by subtraction
114 (- date
115 (1- (calendar-islamic-to-absolute (list month 1 year))))))
116 (list month day year))))
118 ;;;###cal-autoload
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 (< (calendar-extract-year islamic-date) 1)
130 (calendar-date-string islamic-date nil t))))
132 ;;;###cal-autoload
133 (defun calendar-islamic-print-date ()
134 "Show the Islamic calendar equivalent of the date under the cursor."
135 (interactive)
136 (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t))))
137 (if (string-equal i "")
138 (message "Date is pre-Islamic")
139 (message "Islamic date (until sunset): %s" i))))
141 (defun calendar-islamic-read-date ()
142 "Interactively read the arguments for an Islamic date command.
143 Reads a year, month, and day."
144 (let* ((today (calendar-current-date))
145 (year (calendar-read
146 "Islamic calendar year (>0): "
147 (lambda (x) (> x 0))
148 (number-to-string
149 (calendar-extract-year
150 (calendar-islamic-from-absolute
151 (calendar-absolute-from-gregorian today))))))
152 (month-array calendar-islamic-month-name-array)
153 (completion-ignore-case t)
154 (month (cdr (assoc-string
155 (completing-read
156 "Islamic calendar month name: "
157 (mapcar 'list (append month-array nil))
158 nil t)
159 (calendar-make-alist month-array 1) t)))
160 (last (calendar-islamic-last-day-of-month month year))
161 (day (calendar-read
162 (format "Islamic calendar day (1-%d): " last)
163 (lambda (x) (and (< 0 x) (<= x last))))))
164 (list (list month day year))))
166 ;;;###cal-autoload
167 (defun calendar-islamic-goto-date (date &optional noecho)
168 "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is non-nil."
169 (interactive (calendar-islamic-read-date))
170 (calendar-goto-date (calendar-gregorian-from-absolute
171 (calendar-islamic-to-absolute date)))
172 (or noecho (calendar-islamic-print-date)))
174 (defvar displayed-month) ; from calendar-generate
175 (defvar displayed-year)
177 ;;;###holiday-autoload
178 (defun holiday-islamic (month day string)
179 "Holiday on MONTH, DAY (Islamic) called STRING.
180 If MONTH, DAY (Islamic) is visible, returns the corresponding
181 Gregorian date as the list (((month day year) STRING)).
182 Returns nil if it is not visible in the current calendar window."
183 ;; Islamic date corresponding to the center of the calendar window.
184 ;; Since the calendar displays 3 months at a time, there are approx
185 ;; 45 visible days either side of this date. Given the length of
186 ;; the Islamic months, this means up to two different months are
187 ;; visible either side of the central date.
188 (let* ((islamic-date (calendar-islamic-from-absolute
189 (calendar-absolute-from-gregorian
190 (list displayed-month 15 displayed-year))))
191 (m (calendar-extract-month islamic-date))
192 (y (calendar-extract-year islamic-date))
193 date)
194 (unless (< m 1) ; Islamic calendar doesn't apply
195 ;; Since converting to absolute dates can be a complex
196 ;; operation, we try to speed things up by excluding those date
197 ;; ranges that can't possibly be visible.
198 ;; We can view the situation (see above) as if we had a calendar
199 ;; window displaying 5 months at a time. When month m is
200 ;; central, months m-2:m+2 (modulo 12) might be visible.
201 ;; Recall from holiday-fixed that with a 3 month calendar
202 ;; window, November is special, because we can do a one-sided
203 ;; inclusion test. When November is central is when the end of
204 ;; year first appears on the calendar. Similarly, with a 5
205 ;; month window, October is special. When October is central is
206 ;; when the end of year first appears, and when January is
207 ;; central, October is no longer visible. October is visible
208 ;; when the central month is >= 8.
209 ;; Hence to test if any given month might be visible, we can
210 ;; shift things and ask about October.
211 ;; At the same time, we work out the appropriate year y to use.
212 (calendar-increment-month m y (- 10 month))
213 (and (> m 7) ; Islamic date might be visible
214 (calendar-date-is-visible-p
215 (setq date (calendar-gregorian-from-absolute
216 (calendar-islamic-to-absolute (list month day y)))))
217 (list (list date string))))))
219 ;;;###holiday-autoload
220 (defun holiday-islamic-new-year ()
221 "Holiday entry for the Islamic New Year, if visible in the calendar window."
222 (let ((date (caar (holiday-islamic 1 1 "")))
223 (m displayed-month)
224 (y displayed-year))
225 (and date
226 (list (list date
227 (format "Islamic New Year %d"
228 (progn
229 (calendar-increment-month m y 1)
230 (calendar-extract-year
231 (calendar-islamic-from-absolute
232 (calendar-absolute-from-gregorian
233 (list m (calendar-last-day-of-month m y) y)
234 ))))))))))
236 (autoload 'diary-list-entries-1 "diary-lib")
238 ;;;###diary-autoload
239 (defun diary-islamic-list-entries ()
240 "Add any Islamic date entries from the diary file to `diary-entries-list'.
241 Islamic date diary entries must be prefaced by `diary-islamic-entry-symbol'
242 \(normally an `I'). The same `diary-date-forms' govern the style
243 of the Islamic calendar entries, except that the Islamic month
244 names cannot be abbreviated. The Islamic months are numbered
245 from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah.
246 If an Islamic date diary entry begins with `diary-nonmarking-symbol',
247 the entry will appear in the diary listing, but will not be
248 marked in the calendar. This function is provided for use with
249 `diary-nongregorian-listing-hook'."
250 (diary-list-entries-1 calendar-islamic-month-name-array
251 diary-islamic-entry-symbol
252 'calendar-islamic-from-absolute))
254 (autoload 'calendar-mark-1 "diary-lib")
256 ;;;###diary-autoload
257 (defun calendar-islamic-mark-date-pattern (month day year &optional color)
258 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
259 A value of 0 in any position is a wildcard. Optional argument COLOR is
260 passed to `calendar-mark-visible-date' as MARK."
261 (calendar-mark-1 month day year 'calendar-islamic-from-absolute
262 'calendar-islamic-to-absolute color))
264 (autoload 'diary-mark-entries-1 "diary-lib")
266 ;;;###diary-autoload
267 (defun diary-islamic-mark-entries ()
268 "Mark days in the calendar window that have Islamic date diary entries.
269 Marks each entry in `diary-file' (or included files) visible in the calendar
270 window. See `diary-islamic-list-entries' for more information."
271 (diary-mark-entries-1 'calendar-islamic-mark-date-pattern
272 calendar-islamic-month-name-array
273 diary-islamic-entry-symbol
274 'calendar-islamic-from-absolute))
276 (autoload 'diary-insert-entry-1 "diary-lib")
278 ;;;###cal-autoload
279 (defun diary-islamic-insert-entry (arg)
280 "Insert a diary entry.
281 For the Islamic date corresponding to the date indicated by point.
282 Prefix argument ARG makes the entry nonmarking."
283 (interactive "P")
284 (diary-insert-entry-1 nil arg calendar-islamic-month-name-array
285 diary-islamic-entry-symbol
286 'calendar-islamic-from-absolute))
288 ;;;###cal-autoload
289 (defun diary-islamic-insert-monthly-entry (arg)
290 "Insert a monthly diary entry.
291 For the day of the Islamic month corresponding to the date indicated by point.
292 Prefix argument ARG makes the entry nonmarking."
293 (interactive "P")
294 (diary-insert-entry-1 'monthly arg calendar-islamic-month-name-array
295 diary-islamic-entry-symbol
296 'calendar-islamic-from-absolute))
298 ;;;###cal-autoload
299 (defun diary-islamic-insert-yearly-entry (arg)
300 "Insert an annual diary entry.
301 For the day of the Islamic year corresponding to the date indicated by point.
302 Prefix argument ARG makes the entry nonmarking."
303 (interactive "P")
304 (diary-insert-entry-1 'yearly arg calendar-islamic-month-name-array
305 diary-islamic-entry-symbol
306 'calendar-islamic-from-absolute))
308 (defvar date)
310 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
311 ;;;###diary-autoload
312 (defun diary-islamic-date ()
313 "Islamic calendar equivalent of date diary entry."
314 (let ((i (calendar-islamic-date-string date)))
315 (if (string-equal i "")
316 "Date is pre-Islamic"
317 (format "Islamic date (until sunset): %s" i))))
319 (provide 'cal-islam)
321 ;;; cal-islam.el ends here