lisp/calendar/cal-islam.el

   1 ;;; cal-islam.el --- calendar functions for the Islamic calendar
   2
   3 ;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
   4 ;;   2008, 2009, 2010  Free Software Foundation, Inc.
   5
   6 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
   7 ;; Maintainer: Glenn Morris <rgm@gnu.org>
   8 ;; Keywords: calendar
   9 ;; Human-Keywords: Islamic calendar, calendar, diary
  10 ;; Package: calendar
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26
  27 ;;; Commentary:
  28
  29 ;; See calendar.el.
  30
  31 ;;; Code:
  32
  33 (require 'calendar)
  34
  35 (defconst calendar-islamic-month-name-array
  36   ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
  37    "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"]
  38 "Array of strings giving the names of the Islamic months.")
  39
  40 (eval-and-compile
  41   (autoload 'calendar-julian-to-absolute "cal-julian"))
  42
  43 (defconst calendar-islamic-epoch
  44   (eval-when-compile (calendar-julian-to-absolute '(7 16 622)))
  45   "Absolute date of start of Islamic calendar = July 16, 622 AD (Julian).")
  46
  47 (defun calendar-islamic-leap-year-p (year)
  48   "Return t if YEAR is a leap year on the Islamic calendar."
  49   (memq (% year 30)
  50         (list 2 5 7 10 13 16 18 21 24 26 29)))
  51
  52 (defun calendar-islamic-last-day-of-month (month year)
  53   "The last day in MONTH during YEAR on the Islamic calendar."
  54   (cond
  55    ((memq month (list 1 3 5 7 9 11)) 30)
  56    ((memq month (list 2 4 6 8 10)) 29)
  57    (t (if (calendar-islamic-leap-year-p year) 30 29))))
  58
  59 (defun calendar-islamic-day-number (date)
  60   "Return the day number within the year of the Islamic date DATE."
  61   (let ((month (calendar-extract-month date)))
  62     (+ (* 30 (/ month 2))
  63        (* 29 (/ (1- month) 2))
  64        (calendar-extract-day date))))
  65
  66 (defun calendar-islamic-to-absolute (date)
  67   "Absolute date of Islamic DATE.
  68 The absolute date is the number of days elapsed since the (imaginary)
  69 Gregorian date Sunday, December 31, 1 BC."
  70   (let* ((month (calendar-extract-month date))
  71          (day (calendar-extract-day date))
  72          (year (calendar-extract-year date))
  73          (y (% year 30))
  74          (leap-years-in-cycle (cond ((< y 3) 0)
  75                                     ((< y 6) 1)
  76                                     ((< y 8) 2)
  77                                     ((< y 11) 3)
  78                                     ((< y 14) 4)
  79                                     ((< y 17) 5)
  80                                     ((< y 19) 6)
  81                                     ((< y 22) 7)
  82                                     ((< y 25) 8)
  83                                     ((< y 27) 9)
  84                                     (t 10))))
  85     (+ (calendar-islamic-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
  90
  91 (define-obsolete-function-alias 'calendar-absolute-from-islamic
  92   'calendar-islamic-to-absolute "23.1")
  93
  94 (defun calendar-islamic-from-absolute (date)
  95   "Compute the Islamic date (month day year) corresponding to absolute DATE.
  96 The absolute date is the number of days elapsed since the (imaginary)
  97 Gregorian date Sunday, December 31, 1 BC."
  98   (if (< date calendar-islamic-epoch)
  99       (list 0 0 0)                      ; pre-Islamic date
 100     (let* ((approx (/ (- date calendar-islamic-epoch)
 101                       355))  ; approximation from below
 102            (year             ; search forward from the approximation
 103             (+ approx
 104                (calendar-sum y approx
 105                              (>= date (calendar-islamic-to-absolute
 106                                        (list 1 1 (1+ y))))
 107                              1)))
 108            (month                       ; search forward from Muharram
 109             (1+ (calendar-sum m 1
 110                               (> date
 111                                  (calendar-islamic-to-absolute
 112                                   (list m
 113                                         (calendar-islamic-last-day-of-month
 114                                          m year)
 115                                         year)))
 116                               1)))
 117            (day                    ; calculate the day by subtraction
 118             (- date
 119                (1- (calendar-islamic-to-absolute (list month 1 year))))))
 120       (list month day year))))
 121
 122 ;;;###cal-autoload
 123 (defun calendar-islamic-date-string (&optional date)
 124   "String of Islamic date before sunset of Gregorian DATE.
 125 Returns the empty string if DATE is pre-Islamic.
 126 Defaults to today's date if DATE is not given.
 127 Driven by the variable `calendar-date-display-form'."
 128   (let ((calendar-month-name-array calendar-islamic-month-name-array)
 129         (islamic-date (calendar-islamic-from-absolute
 130                        (calendar-absolute-from-gregorian
 131                         (or date (calendar-current-date))))))
 132     (if (< (calendar-extract-year islamic-date) 1)
 133         ""
 134       (calendar-date-string islamic-date nil t))))
 135
 136 ;;;###cal-autoload
 137 (defun calendar-islamic-print-date ()
 138   "Show the Islamic calendar equivalent of the date under the cursor."
 139   (interactive)
 140   (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t))))
 141     (if (string-equal i "")
 142         (message "Date is pre-Islamic")
 143       (message "Islamic date (until sunset): %s" i))))
 144
 145 (define-obsolete-function-alias 'calendar-print-islamic-date
 146   'calendar-islamic-print-date "23.1")
 147
 148 (defun calendar-islamic-read-date ()
 149   "Interactively read the arguments for an Islamic date command.
 150 Reads a year, month, and day."
 151   (let* ((today (calendar-current-date))
 152          (year (calendar-read
 153                 "Islamic calendar year (>0): "
 154                 (lambda (x) (> x 0))
 155                 (number-to-string
 156                  (calendar-extract-year
 157                   (calendar-islamic-from-absolute
 158                    (calendar-absolute-from-gregorian today))))))
 159          (month-array calendar-islamic-month-name-array)
 160          (completion-ignore-case t)
 161          (month (cdr (assoc-string
 162                       (completing-read
 163                        "Islamic calendar month name: "
 164                        (mapcar 'list (append month-array nil))
 165                        nil t)
 166                       (calendar-make-alist month-array 1) t)))
 167          (last (calendar-islamic-last-day-of-month month year))
 168          (day (calendar-read
 169                (format "Islamic calendar day (1-%d): " last)
 170                (lambda (x) (and (< 0 x) (<= x last))))))
 171     (list (list month day year))))
 172
 173 ;;;###cal-autoload
 174 (defun calendar-islamic-goto-date (date &optional noecho)
 175   "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is non-nil."
 176   (interactive (calendar-islamic-read-date))
 177   (calendar-goto-date (calendar-gregorian-from-absolute
 178                        (calendar-islamic-to-absolute date)))
 179   (or noecho (calendar-islamic-print-date)))
 180
 181 (define-obsolete-function-alias 'calendar-goto-islamic-date
 182   'calendar-islamic-goto-date "23.1")
 183
 184 (defvar displayed-month)                ; from calendar-generate
 185 (defvar displayed-year)
 186
 187 ;;;###holiday-autoload
 188 (defun holiday-islamic (month day string)
 189   "Holiday on MONTH, DAY (Islamic) called STRING.
 190 If MONTH, DAY (Islamic) is visible, returns the corresponding
 191 Gregorian date as the list (((month day year) STRING)).
 192 Returns nil if it is not visible in the current calendar window."
 193   ;; Islamic date corresponding to the center of the calendar window.
 194   ;; Since the calendar displays 3 months at a time, there are approx
 195   ;; 45 visible days either side of this date.  Given the length of
 196   ;; the Islamic months, this means up to two different months are
 197   ;; visible either side of the central date.
 198   (let* ((islamic-date (calendar-islamic-from-absolute
 199                         (calendar-absolute-from-gregorian
 200                          (list displayed-month 15 displayed-year))))
 201          (m (calendar-extract-month islamic-date))
 202          (y (calendar-extract-year islamic-date))
 203          date)
 204     (unless (< m 1)                   ; Islamic calendar doesn't apply
 205       ;; Since converting to absolute dates can be a complex
 206       ;; operation, we try to speed things up by excluding those date
 207       ;; ranges that can't possibly be visible.
 208       ;; We can view the situation (see above) as if we had a calendar
 209       ;; window displaying 5 months at a time.  When month m is
 210       ;; central, months m-2:m+2 (modulo 12) might be visible.
 211       ;; Recall from holiday-fixed that with a 3 month calendar
 212       ;; window, November is special, because we can do a one-sided
 213       ;; inclusion test.  When November is central is when the end of
 214       ;; year first appears on the calendar.  Similarly, with a 5
 215       ;; month window, October is special.  When October is central is
 216       ;; when the end of year first appears, and when January is
 217       ;; central, October is no longer visible.  October is visible
 218       ;; when the central month is >= 8.
 219       ;; Hence to test if any given month might be visible, we can
 220       ;; shift things and ask about October.
 221       ;; At the same time, we work out the appropriate year y to use.
 222       (calendar-increment-month m y (- 10 month))
 223       (and (> m 7)                      ; Islamic date might be visible
 224            (calendar-date-is-visible-p
 225             (setq date (calendar-gregorian-from-absolute
 226                         (calendar-islamic-to-absolute (list month day y)))))
 227            (list (list date string))))))
 228
 229 ;;;###holiday-autoload
 230 (defun holiday-islamic-new-year ()
 231   "Holiday entry for the Islamic New Year, if visible in the calendar window."
 232   (let ((date (caar (holiday-islamic 1 1 "")))
 233         (m displayed-month)
 234         (y displayed-year))
 235     (and date
 236          (list (list date
 237                      (format "Islamic New Year %d"
 238                              (progn
 239                                (calendar-increment-month m y 1)
 240                                (calendar-extract-year
 241                                 (calendar-islamic-from-absolute
 242                                  (calendar-absolute-from-gregorian
 243                                   (list m (calendar-last-day-of-month m y) y)
 244                                   ))))))))))
 245
 246 (autoload 'diary-list-entries-1 "diary-lib")
 247
 248 ;;;###diary-autoload
 249 (defun diary-islamic-list-entries ()
 250   "Add any Islamic date entries from the diary file to `diary-entries-list'.
 251 Islamic date diary entries must be prefaced by `diary-islamic-entry-symbol'
 252 \(normally an `I').  The same `diary-date-forms' govern the style
 253 of the Islamic calendar entries, except that the Islamic month
 254 names cannot be abbreviated.  The Islamic months are numbered
 255 from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah.
 256 If an Islamic date diary entry begins with `diary-nonmarking-symbol',
 257 the entry will appear in the diary listing, but will not be
 258 marked in the calendar.  This function is provided for use with
 259 `diary-nongregorian-listing-hook'."
 260   (diary-list-entries-1 calendar-islamic-month-name-array
 261                         diary-islamic-entry-symbol
 262                         'calendar-islamic-from-absolute))
 263
 264 (define-obsolete-function-alias 'list-islamic-diary-entries
 265   'diary-islamic-list-entries "23.1")
 266
 267 (autoload 'calendar-mark-1 "diary-lib")
 268
 269 ;;;###diary-autoload
 270 (defun calendar-islamic-mark-date-pattern (month day year &optional color)
 271   "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
 272 A value of 0 in any position is a wildcard.  Optional argument COLOR is
 273 passed to `calendar-mark-visible-date' as MARK."
 274   (calendar-mark-1 month day year 'calendar-islamic-from-absolute
 275                    'calendar-islamic-to-absolute color))
 276
 277 (define-obsolete-function-alias 'mark-islamic-calendar-date-pattern
 278   'calendar-islamic-mark-date-pattern "23.1")
 279
 280 (autoload 'diary-mark-entries-1 "diary-lib")
 281
 282 ;;;###diary-autoload
 283 (defun diary-islamic-mark-entries ()
 284   "Mark days in the calendar window that have Islamic date diary entries.
 285 Marks each entry in `diary-file' (or included files) visible in the calendar
 286 window.  See `diary-islamic-list-entries' for more information."
 287   (diary-mark-entries-1 'calendar-islamic-mark-date-pattern
 288                         calendar-islamic-month-name-array
 289                         diary-islamic-entry-symbol
 290                         'calendar-islamic-from-absolute))
 291
 292 (define-obsolete-function-alias
 293   'mark-islamic-diary-entries 'diary-islamic-mark-entries "23.1")
 294
 295 (autoload 'diary-insert-entry-1 "diary-lib")
 296
 297 ;;;###cal-autoload
 298 (defun diary-islamic-insert-entry (arg)
 299   "Insert a diary entry.
 300 For the Islamic date corresponding to the date indicated by point.
 301 Prefix argument ARG makes the entry nonmarking."
 302   (interactive "P")
 303   (diary-insert-entry-1 nil arg calendar-islamic-month-name-array
 304                         diary-islamic-entry-symbol
 305                         'calendar-islamic-from-absolute))
 306
 307 (define-obsolete-function-alias 'insert-islamic-diary-entry
 308   'diary-islamic-insert-entry "23.1")
 309
 310 ;;;###cal-autoload
 311 (defun diary-islamic-insert-monthly-entry (arg)
 312   "Insert a monthly diary entry.
 313 For the day of the Islamic month corresponding to the date indicated by point.
 314 Prefix argument ARG makes the entry nonmarking."
 315   (interactive "P")
 316   (diary-insert-entry-1 'monthly arg calendar-islamic-month-name-array
 317                         diary-islamic-entry-symbol
 318                         'calendar-islamic-from-absolute))
 319
 320 (define-obsolete-function-alias 'insert-monthly-islamic-diary-entry
 321   'diary-islamic-insert-monthly-entry "23.1")
 322
 323 ;;;###cal-autoload
 324 (defun diary-islamic-insert-yearly-entry (arg)
 325   "Insert an annual diary entry.
 326 For the day of the Islamic year corresponding to the date indicated by point.
 327 Prefix argument ARG makes the entry nonmarking."
 328   (interactive "P")
 329   (diary-insert-entry-1 'yearly arg calendar-islamic-month-name-array
 330                         diary-islamic-entry-symbol
 331                         'calendar-islamic-from-absolute))
 332 (define-obsolete-function-alias
 333   'insert-yearly-islamic-diary-entry 'diary-islamic-insert-yearly-entry "23.1")
 334
 335 (defvar date)
 336
 337 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
 338 ;;;###diary-autoload
 339 (defun diary-islamic-date ()
 340   "Islamic calendar equivalent of date diary entry."
 341   (let ((i (calendar-islamic-date-string date)))
 342     (if (string-equal i "")
 343         "Date is pre-Islamic"
 344       (format "Islamic date (until sunset): %s" i))))
 345
 346 (provide 'cal-islam)
 347
 348 ;; arch-tag: a951b6c1-6f47-48d5-bac3-1b505cd719f7
 349 ;;; cal-islam.el ends here