cal-islam.el 13.8 KB
Newer Older
1
;;; cal-islam.el --- calendar functions for the Islamic calendar
Edward M. Reingold's avatar
Edward M. Reingold committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1995, 1997, 2001-2019 Free Software Foundation, Inc.
Edward M. Reingold's avatar
Edward M. Reingold committed
4 5

;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
Glenn Morris's avatar
Glenn Morris committed
6
;; Maintainer: emacs-devel@gnu.org
Edward M. Reingold's avatar
Edward M. Reingold committed
7 8
;; Keywords: calendar
;; Human-Keywords: Islamic calendar, calendar, diary
9
;; Package: calendar
Edward M. Reingold's avatar
Edward M. Reingold committed
10 11 12

;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Edward M. Reingold's avatar
Edward M. Reingold committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Edward M. Reingold's avatar
Edward M. Reingold committed
17 18 19 20 21 22 23

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Edward M. Reingold's avatar
Edward M. Reingold committed
25 26 27

;;; Commentary:

28
;; See calendar.el.
29

Edward M. Reingold's avatar
Edward M. Reingold committed
30 31
;;; Code:

32
(require 'calendar)
Edward M. Reingold's avatar
Edward M. Reingold committed
33

34
(defconst calendar-islamic-month-name-array
Edward M. Reingold's avatar
Edward M. Reingold committed
35
  ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
36 37
   "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"]
"Array of strings giving the names of the Islamic months.")
Edward M. Reingold's avatar
Edward M. Reingold committed
38

39
(eval-and-compile
40
  (autoload 'calendar-julian-to-absolute "cal-julian"))
41 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).")
Edward M. Reingold's avatar
Edward M. Reingold committed
45

46
(defun calendar-islamic-leap-year-p (year)
Glenn Morris's avatar
Glenn Morris committed
47
  "Return t if YEAR is a leap year on the Islamic calendar."
Edward M. Reingold's avatar
Edward M. Reingold committed
48 49 50
  (memq (% year 30)
        (list 2 5 7 10 13 16 18 21 24 26 29)))

51
(defun calendar-islamic-last-day-of-month (month year)
Edward M. Reingold's avatar
Edward M. Reingold committed
52 53 54 55
  "The last day in MONTH during YEAR on the Islamic calendar."
  (cond
   ((memq month (list 1 3 5 7 9 11)) 30)
   ((memq month (list 2 4 6 8 10)) 29)
56
   (t (if (calendar-islamic-leap-year-p year) 30 29))))
Edward M. Reingold's avatar
Edward M. Reingold committed
57

58
(defun calendar-islamic-day-number (date)
Edward M. Reingold's avatar
Edward M. Reingold committed
59
  "Return the day number within the year of the Islamic date DATE."
60
  (let ((month (calendar-extract-month date)))
61 62
    (+ (* 30 (/ month 2))
       (* 29 (/ (1- month) 2))
63
       (calendar-extract-day date))))
Edward M. Reingold's avatar
Edward M. Reingold committed
64

65
(defun calendar-islamic-to-absolute (date)
Edward M. Reingold's avatar
Edward M. Reingold committed
66 67 68
  "Absolute date of Islamic DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
69 70 71
  (let* ((month (calendar-extract-month date))
         (day (calendar-extract-day date))
         (year (calendar-extract-year date))
Edward M. Reingold's avatar
Edward M. Reingold committed
72
         (y (% year 30))
Glenn Morris's avatar
Glenn Morris committed
73 74 75 76 77 78 79 80 81 82 83
         (leap-years-in-cycle (cond ((< y 3) 0)
                                    ((< y 6) 1)
                                    ((< y 8) 2)
                                    ((< y 11) 3)
                                    ((< y 14) 4)
                                    ((< y 17) 5)
                                    ((< y 19) 6)
                                    ((< y 22) 7)
                                    ((< y 25) 8)
                                    ((< y 27) 9)
                                    (t 10))))
84
    (+ (calendar-islamic-day-number date) ; days so far this year
Glenn Morris's avatar
Glenn Morris committed
85 86 87 88
       (* (1- year) 354)                  ; days in all non-leap years
       (* 11 (/ year 30))             ; leap days in complete cycles
       leap-years-in-cycle            ; leap days this cycle
       (1- calendar-islamic-epoch)))) ; days before start of calendar
Edward M. Reingold's avatar
Edward M. Reingold committed
89 90 91 92 93 94

(defun calendar-islamic-from-absolute (date)
  "Compute the Islamic date (month day year) corresponding to absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
  (if (< date calendar-islamic-epoch)
Glenn Morris's avatar
Glenn Morris committed
95
      (list 0 0 0)                      ; pre-Islamic date
Edward M. Reingold's avatar
Edward M. Reingold committed
96
    (let* ((approx (/ (- date calendar-islamic-epoch)
Glenn Morris's avatar
Glenn Morris committed
97 98
                      355))  ; approximation from below
           (year             ; search forward from the approximation
Edward M. Reingold's avatar
Edward M. Reingold committed
99 100
            (+ approx
               (calendar-sum y approx
101
                             (>= date (calendar-islamic-to-absolute
Edward M. Reingold's avatar
Edward M. Reingold committed
102 103
                                       (list 1 1 (1+ y))))
                             1)))
Glenn Morris's avatar
Glenn Morris committed
104
           (month                       ; search forward from Muharram
Edward M. Reingold's avatar
Edward M. Reingold committed
105 106
            (1+ (calendar-sum m 1
                              (> date
107
                                 (calendar-islamic-to-absolute
Edward M. Reingold's avatar
Edward M. Reingold committed
108
                                  (list m
109
                                        (calendar-islamic-last-day-of-month
Edward M. Reingold's avatar
Edward M. Reingold committed
110 111 112
                                         m year)
                                        year)))
                              1)))
Glenn Morris's avatar
Glenn Morris committed
113
           (day                    ; calculate the day by subtraction
Edward M. Reingold's avatar
Edward M. Reingold committed
114
            (- date
115
               (1- (calendar-islamic-to-absolute (list month 1 year))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
116 117
      (list month day year))))

118
;;;###cal-autoload
Edward M. Reingold's avatar
Edward M. Reingold committed
119 120 121 122 123 124 125 126 127
(defun calendar-islamic-date-string (&optional date)
  "String of Islamic date before sunset of Gregorian DATE.
Returns the empty string if DATE is pre-Islamic.
Defaults to today's date if DATE is not given.
Driven by the variable `calendar-date-display-form'."
  (let ((calendar-month-name-array calendar-islamic-month-name-array)
        (islamic-date (calendar-islamic-from-absolute
                       (calendar-absolute-from-gregorian
                        (or date (calendar-current-date))))))
128
    (if (< (calendar-extract-year islamic-date) 1)
Edward M. Reingold's avatar
Edward M. Reingold committed
129 130 131
        ""
      (calendar-date-string islamic-date nil t))))

132
;;;###cal-autoload
133
(defun calendar-islamic-print-date ()
Edward M. Reingold's avatar
Edward M. Reingold committed
134 135 136 137 138 139 140
  "Show the Islamic calendar equivalent of the date under the cursor."
  (interactive)
  (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t))))
    (if (string-equal i "")
        (message "Date is pre-Islamic")
      (message "Islamic date (until sunset): %s" i))))

141 142 143
(defun calendar-islamic-read-date ()
  "Interactively read the arguments for an Islamic date command.
Reads a year, month, and day."
Glenn Morris's avatar
Glenn Morris committed
144 145 146 147
  (let* ((today (calendar-current-date))
         (year (calendar-read
                "Islamic calendar year (>0): "
                (lambda (x) (> x 0))
148
                (number-to-string
149
                 (calendar-extract-year
Glenn Morris's avatar
Glenn Morris committed
150 151 152 153 154 155 156 157 158 159
                  (calendar-islamic-from-absolute
                   (calendar-absolute-from-gregorian today))))))
         (month-array calendar-islamic-month-name-array)
         (completion-ignore-case t)
         (month (cdr (assoc-string
                      (completing-read
                       "Islamic calendar month name: "
                       (mapcar 'list (append month-array nil))
                       nil t)
                      (calendar-make-alist month-array 1) t)))
160
         (last (calendar-islamic-last-day-of-month month year))
Glenn Morris's avatar
Glenn Morris committed
161 162 163 164 165
         (day (calendar-read
               (format "Islamic calendar day (1-%d): " last)
               (lambda (x) (and (< 0 x) (<= x last))))))
    (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))
Edward M. Reingold's avatar
Edward M. Reingold committed
170
  (calendar-goto-date (calendar-gregorian-from-absolute
171 172 173
                       (calendar-islamic-to-absolute date)))
  (or noecho (calendar-islamic-print-date)))

174
(defvar displayed-month)                ; from calendar-generate
175 176
(defvar displayed-year)

177
;;;###holiday-autoload
Edward M. Reingold's avatar
Edward M. Reingold committed
178 179
(defun holiday-islamic (month day string)
  "Holiday on MONTH, DAY (Islamic) called STRING.
Glenn Morris's avatar
Glenn Morris committed
180 181 182
If MONTH, DAY (Islamic) is visible, returns the corresponding
Gregorian date as the list (((month day year) STRING)).
Returns nil if it is not visible in the current calendar window."
183 184 185 186 187
  ;; Islamic date corresponding to the center of the calendar window.
  ;; Since the calendar displays 3 months at a time, there are approx
  ;; 45 visible days either side of this date.  Given the length of
  ;; the Islamic months, this means up to two different months are
  ;; visible either side of the central date.
Edward M. Reingold's avatar
Edward M. Reingold committed
188 189 190
  (let* ((islamic-date (calendar-islamic-from-absolute
                        (calendar-absolute-from-gregorian
                         (list displayed-month 15 displayed-year))))
191 192
         (m (calendar-extract-month islamic-date))
         (y (calendar-extract-year islamic-date))
Glenn Morris's avatar
Glenn Morris committed
193
         date)
194
    (unless (< m 1)                   ; Islamic calendar doesn't apply
195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211
      ;; Since converting to absolute dates can be a complex
      ;; operation, we try to speed things up by excluding those date
      ;; ranges that can't possibly be visible.
      ;; We can view the situation (see above) as if we had a calendar
      ;; window displaying 5 months at a time.  When month m is
      ;; central, months m-2:m+2 (modulo 12) might be visible.
      ;; Recall from holiday-fixed that with a 3 month calendar
      ;; window, November is special, because we can do a one-sided
      ;; inclusion test.  When November is central is when the end of
      ;; year first appears on the calendar.  Similarly, with a 5
      ;; month window, October is special.  When October is central is
      ;; when the end of year first appears, and when January is
      ;; central, October is no longer visible.  October is visible
      ;; when the central month is >= 8.
      ;; Hence to test if any given month might be visible, we can
      ;; shift things and ask about October.
      ;; At the same time, we work out the appropriate year y to use.
212
      (calendar-increment-month m y (- 10 month))
213 214 215
      (and (> m 7)                      ; Islamic date might be visible
           (calendar-date-is-visible-p
            (setq date (calendar-gregorian-from-absolute
216
                        (calendar-islamic-to-absolute (list month day y)))))
217
           (list (list date string))))))
Edward M. Reingold's avatar
Edward M. Reingold committed
218

219 220 221 222 223 224 225 226 227 228
;;;###holiday-autoload
(defun holiday-islamic-new-year ()
  "Holiday entry for the Islamic New Year, if visible in the calendar window."
  (let ((date (caar (holiday-islamic 1 1 "")))
        (m displayed-month)
        (y displayed-year))
    (and date
         (list (list date
                     (format "Islamic New Year %d"
                             (progn
229 230
                               (calendar-increment-month m y 1)
                               (calendar-extract-year
231 232 233 234 235
                                (calendar-islamic-from-absolute
                                 (calendar-absolute-from-gregorian
                                  (list m (calendar-last-day-of-month m y) y)
                                  ))))))))))

236
(autoload 'diary-list-entries-1 "diary-lib")
237

238
;;;###diary-autoload
239
(defun diary-islamic-list-entries ()
Edward M. Reingold's avatar
Edward M. Reingold committed
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
Glenn Morris's avatar
Glenn Morris committed
243
of the Islamic calendar entries, except that the Islamic month
244
names cannot be abbreviated.  The Islamic months are numbered
Glenn Morris's avatar
Glenn Morris committed
245 246 247 248
from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah.
If an Islamic date diary entry begins with `diary-nonmarking-symbol',
the entry will appear in the diary listing, but will not be
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))
Edward M. Reingold's avatar
Edward M. Reingold committed
253

Glenn Morris's avatar
Glenn Morris committed
254 255
(autoload 'calendar-mark-1 "diary-lib")

256
;;;###diary-autoload
257
(defun calendar-islamic-mark-date-pattern (month day year &optional color)
Edward M. Reingold's avatar
Edward M. Reingold committed
258
  "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
Glenn Morris's avatar
Glenn Morris committed
259
A value of 0 in any position is a wildcard.  Optional argument COLOR is
260
passed to `calendar-mark-visible-date' as MARK."
Glenn Morris's avatar
Glenn Morris committed
261
  (calendar-mark-1 month day year 'calendar-islamic-from-absolute
262 263
                   'calendar-islamic-to-absolute color))

264
(autoload 'diary-mark-entries-1 "diary-lib")
265 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 271
window.  See `diary-islamic-list-entries' for more information."
  (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))
275

Glenn Morris's avatar
Glenn Morris committed
276 277
(autoload 'diary-insert-entry-1 "diary-lib")

278
;;;###cal-autoload
279
(defun diary-islamic-insert-entry (arg)
Edward M. Reingold's avatar
Edward M. Reingold committed
280 281
  "Insert a diary entry.
For the Islamic date corresponding to the date indicated by point.
Glenn Morris's avatar
Glenn Morris committed
282
Prefix argument ARG makes the entry nonmarking."
Edward M. Reingold's avatar
Edward M. Reingold committed
283
  (interactive "P")
Glenn Morris's avatar
Glenn Morris committed
284
  (diary-insert-entry-1 nil arg calendar-islamic-month-name-array
285
                        diary-islamic-entry-symbol
Glenn Morris's avatar
Glenn Morris committed
286
                        'calendar-islamic-from-absolute))
Edward M. Reingold's avatar
Edward M. Reingold committed
287

288
;;;###cal-autoload
289
(defun diary-islamic-insert-monthly-entry (arg)
Edward M. Reingold's avatar
Edward M. Reingold committed
290 291
  "Insert a monthly diary entry.
For the day of the Islamic month corresponding to the date indicated by point.
Glenn Morris's avatar
Glenn Morris committed
292
Prefix argument ARG makes the entry nonmarking."
Edward M. Reingold's avatar
Edward M. Reingold committed
293
  (interactive "P")
Glenn Morris's avatar
Glenn Morris committed
294
  (diary-insert-entry-1 'monthly arg calendar-islamic-month-name-array
295
                        diary-islamic-entry-symbol
Glenn Morris's avatar
Glenn Morris committed
296
                        'calendar-islamic-from-absolute))
Edward M. Reingold's avatar
Edward M. Reingold committed
297

298
;;;###cal-autoload
299
(defun diary-islamic-insert-yearly-entry (arg)
Edward M. Reingold's avatar
Edward M. Reingold committed
300 301
  "Insert an annual diary entry.
For the day of the Islamic year corresponding to the date indicated by point.
Glenn Morris's avatar
Glenn Morris committed
302
Prefix argument ARG makes the entry nonmarking."
Edward M. Reingold's avatar
Edward M. Reingold committed
303
  (interactive "P")
Glenn Morris's avatar
Glenn Morris committed
304
  (diary-insert-entry-1 'yearly arg calendar-islamic-month-name-array
305
                        diary-islamic-entry-symbol
Glenn Morris's avatar
Glenn Morris committed
306
                        'calendar-islamic-from-absolute))
Edward M. Reingold's avatar
Edward M. Reingold committed
307

308 309 310
(defvar date)

;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
311
;;;###diary-autoload
312 313 314 315 316 317 318
(defun diary-islamic-date ()
  "Islamic calendar equivalent of date diary entry."
  (let ((i (calendar-islamic-date-string date)))
    (if (string-equal i "")
        "Date is pre-Islamic"
      (format "Islamic date (until sunset): %s" i))))

319
(provide 'cal-islam)
Edward M. Reingold's avatar
Edward M. Reingold committed
320

321
;;; cal-islam.el ends here