| 1 | ;;; cal-islam.el --- calendar functions for the Islamic calendar |
| 2 | |
| 3 | ;; Copyright (C) 1995, 1997, 2001-2013 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 | (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 | ;;; cal-islam.el ends here |