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