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