lisp/calendar/cal-islam.el

   1 ;;; cal-islam.el --- calendar functions for the Islamic calendar
   2
   3 ;; Copyright (C) 1995, 1997, 2001-2015 Free Software Foundation, Inc.
   4
   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
  10
  11 ;; This file is part of GNU Emacs.
  12
  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.
  17
  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.
  22
  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/>.
  25
  26 ;;; Commentary:
  27
  28 ;; See calendar.el.
  29
  30 ;;; Code:
  31
  32 (require 'calendar)
  33
  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.")
  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).")
  45
  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)))
  50
  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))))
  57
  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))))
  64
  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
  89
  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))))
 117
 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)
 129         ""
 130       (calendar-date-string islamic-date nil t))))
 131
 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))))
 140
 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))))
 165
 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)))
 173
 174 (defvar displayed-month)                ; from calendar-generate
 175 (defvar displayed-year)
 176
 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))))))
 218
 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                                   ))))))))))
 235
 236 (autoload 'diary-list-entries-1 "diary-lib")
 237
 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))
 253
 254 (autoload 'calendar-mark-1 "diary-lib")
 255
 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))
 263
 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 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))
 275
 276 (autoload 'diary-insert-entry-1 "diary-lib")
 277
 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))
 287
 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))
 297
 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))
 307
 308 (defvar date)
 309
 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))))
 318
 319 (provide 'cal-islam)
 320
 321 ;;; cal-islam.el ends here