Lines Matching +defs:calendar +defs:islamic +defs:date +defs:string
1 ;;; cal-islam.el --- calendar functions for the Islamic calendar
8 ;; Keywords: calendar
9 ;; Human-Keywords: Islamic calendar, calendar, diary
30 ;; This collection of functions implements the features of calendar.el and
31 ;; diary.el that deal with the Islamic calendar.
39 (defvar date)
43 (defvar original-date)
47 (defvar calendar-islamic-month-name-array
52 (defvar calendar-islamic-epoch (calendar-absolute-from-julian '(7 16 622))
53 "Absolute date of start of Islamic calendar = August 29, 284 A.D. (Julian).")
55 (defun islamic-calendar-leap-year-p (year)
56 "Returns t if YEAR is a leap year on the Islamic calendar."
60 (defun islamic-calendar-last-day-of-month (month year)
61 "The last day in MONTH during YEAR on the Islamic calendar."
65 (t (if (islamic-calendar-leap-year-p year) 30 29))))
67 (defun islamic-calendar-day-number (date)
68 "Return the day number within the year of the Islamic date DATE."
69 (let* ((month (extract-calendar-month date))
70 (day (extract-calendar-day date)))
75 (defun calendar-absolute-from-islamic (date)
76 "Absolute date of Islamic DATE.
77 The absolute date is the number of days elapsed since the (imaginary)
78 Gregorian date Sunday, December 31, 1 BC."
79 (let* ((month (extract-calendar-month date))
80 (day (extract-calendar-day date))
81 (year (extract-calendar-year date))
88 (+ (islamic-calendar-day-number date);; days so far this year
92 (1- calendar-islamic-epoch)))) ;; days before start of calendar
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)
104 (calendar-sum y approx
105 (>= date (calendar-absolute-from-islamic
109 (1+ (calendar-sum m 1
110 (> date
111 (calendar-absolute-from-islamic
113 (islamic-calendar-last-day-of-month
118 (- date
119 (1- (calendar-absolute-from-islamic (list month 1 year))))))
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 (< (extract-calendar-year islamic-date) 1)
133 (calendar-date-string islamic-date nil t))))
135 (defun calendar-print-islamic-date ()
136 "Show the Islamic calendar equivalent of the date under the cursor."
138 (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t))))
139 (if (string-equal i "")
141 (message "Islamic date (until sunset): %s" i))))
143 (defun calendar-goto-islamic-date (date &optional noecho)
144 "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is t."
146 (let* ((today (calendar-current-date))
147 (year (calendar-read
148 "Islamic calendar year (>0): "
150 (int-to-string
151 (extract-calendar-year
152 (calendar-islamic-from-absolute
153 (calendar-absolute-from-gregorian today))))))
154 (month-array calendar-islamic-month-name-array)
156 (month (cdr (assoc-string
158 "Islamic calendar month name: "
161 (calendar-make-alist month-array 1) t)))
162 (last (islamic-calendar-last-day-of-month month year))
163 (day (calendar-read
164 (format "Islamic calendar day (1-%d): " last)
167 (calendar-goto-date (calendar-gregorian-from-absolute
168 (calendar-absolute-from-islamic date)))
169 (or noecho (calendar-print-islamic-date)))
171 (defun diary-islamic-date ()
172 "Islamic calendar equivalent of date diary entry."
173 (let ((i (calendar-islamic-date-string date)))
174 (if (string-equal i "")
176 (format "Islamic date (until sunset): %s" i))))
178 (defun holiday-islamic (month day string)
181 Gregorian date in the form of the list (((month day year) STRING)). Returns
182 nil if it is not visible in the current calendar window."
183 (let* ((islamic-date (calendar-islamic-from-absolute
184 (calendar-absolute-from-gregorian
186 (m (extract-calendar-month islamic-date))
187 (y (extract-calendar-year islamic-date))
188 (date))
190 nil;; Islamic calendar doesn't apply.
191 (increment-calendar-month m y (- 10 month))
192 (if (> m 7);; Islamic date might be visible
193 (let ((date (calendar-gregorian-from-absolute
194 (calendar-absolute-from-islamic (list month day y)))))
195 (if (calendar-date-is-visible-p date)
196 (list (list date string))))))))
198 (defun list-islamic-diary-entries ()
199 "Add any Islamic date entries from the diary file to `diary-entries-list'.
200 Islamic date diary entries must be prefaced by an `islamic-diary-entry-symbol'
201 \(normally an `I'). The same diary date forms govern the style of the Islamic
202 calendar entries, except that the Islamic month names must be spelled in full.
204 Dhu al-Hijjah. If an Islamic date diary entry begins with a
206 not be marked in the calendar. This function is provided for use with the
211 (gdate original-date)
213 (calendar-for-loop i from 1 to number do
214 (let* ((d diary-date-forms)
215 (idate (calendar-islamic-from-absolute
216 (calendar-absolute-from-gregorian gdate)))
217 (month (extract-calendar-month idate))
218 (day (extract-calendar-day idate))
219 (year (extract-calendar-year idate)))
222 ((date-form (if (equal (car (car d)) 'backup)
228 (calendar-day-name gdate)
229 (calendar-day-name gdate 'abbrev)))
230 (calendar-month-name-array
231 calendar-islamic-month-name-array)
235 (calendar-month-name month)))
236 (month (concat "\\*\\|0*" (int-to-string month)))
237 (day (concat "\\*\\|0*" (int-to-string day)))
240 "\\*\\|0*" (int-to-string year)
241 (if abbreviated-calendar-year
242 (concat "\\|" (int-to-string (% year 100)))
247 (regexp-quote islamic-diary-entry-symbol)
249 (mapconcat 'eval date-form "\\)\\(")
258 ;; Diary entry that consists only of date.
263 (date-start))
265 (setq date-start (point))
270 (subst-char-in-region date-start (point) ?\^M ?\n t)
275 (1+ date-start) (1- entry-start))
279 (calendar-gregorian-from-absolute
280 (1+ (calendar-absolute-from-gregorian gdate)))))
284 (defun mark-islamic-diary-entries ()
285 "Mark days in the calendar window that have Islamic date diary entries.
286 Each entry in diary-file (or included files) visible in the calendar window
287 is marked. Islamic date entries are prefaced by a islamic-diary-entry-symbol
288 \(normally an `I'). The same diary-date-forms govern the style of the Islamic
289 calendar entries, except that the Islamic month names must be spelled in full.
291 Dhu al-Hijjah. Islamic date diary entries that begin with a
292 diary-nonmarking-symbol will not be marked in the calendar. This function is
294 (let ((d diary-date-forms))
297 ((date-form (if (equal (car (car d)) 'backup)
300 (dayname (diary-name-pattern calendar-day-name-array
301 calendar-day-abbrev-array))
304 (diary-name-pattern calendar-islamic-month-name-array)))
308 (l (length date-form))
309 (d-name-pos (- l (length (memq 'dayname date-form))))
311 (m-name-pos (- l (length (memq 'monthname date-form))))
313 (d-pos (- l (length (memq 'day date-form))))
315 (m-pos (- l (length (memq 'month date-form))))
317 (y-pos (- l (length (memq 'year date-form))))
322 (regexp-quote islamic-diary-entry-symbol)
324 (mapconcat 'eval date-form "\\)\\(")
339 (mm (string-to-number
345 (dd (string-to-number
358 abbreviated-calendar-year)
360 (extract-calendar-year
361 (calendar-islamic-from-absolute
362 (calendar-absolute-from-gregorian
363 (calendar-current-date)))))
364 (y (+ (string-to-number y-str)
371 (string-to-number y-str)))))
373 (mark-calendar-days-named
374 (cdr (assoc-string dd-name
375 (calendar-make-alist
376 calendar-day-name-array
377 0 nil calendar-day-abbrev-array) t)))
379 (setq mm (if (string-equal mm-name "*") 0
380 (cdr (assoc-string
382 (calendar-make-alist
383 calendar-islamic-month-name-array) t)))))
384 (mark-islamic-calendar-date-pattern mm dd yy)))))
387 (defun mark-islamic-calendar-date-pattern (month day year)
388 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
391 (set-buffer calendar-buffer)
394 ;; Fully specified Islamic date.
395 (let ((date (calendar-gregorian-from-absolute
396 (calendar-absolute-from-islamic
398 (if (calendar-date-is-visible-p date)
399 (mark-visible-calendar-date date)))
401 (let* ((islamic-date (calendar-islamic-from-absolute
402 (calendar-absolute-from-gregorian
404 (m (extract-calendar-month islamic-date))
405 (y (extract-calendar-year islamic-date))
406 (date))
408 nil;; Islamic calendar doesn't apply.
409 (increment-calendar-month m y (- 10 month))
410 (if (> m 7);; Islamic date might be visible
411 (let ((date (calendar-gregorian-from-absolute
412 (calendar-absolute-from-islamic
414 (if (calendar-date-is-visible-p date)
415 (mark-visible-calendar-date date)))))))
421 (first-date)
422 (last-date))
423 (increment-calendar-month m y -1)
424 (setq first-date
425 (calendar-absolute-from-gregorian
427 (increment-calendar-month m y 2)
428 (setq last-date
429 (calendar-absolute-from-gregorian
430 (list m (calendar-last-day-of-month m y) y)))
431 (calendar-for-loop date from first-date to last-date do
432 (let* ((i-date (calendar-islamic-from-absolute date))
433 (i-month (extract-calendar-month i-date))
434 (i-day (extract-calendar-day i-date))
435 (i-year (extract-calendar-year i-date)))
442 (mark-visible-calendar-date
443 (calendar-gregorian-from-absolute date)))))))))
445 (defun insert-islamic-diary-entry (arg)
447 For the Islamic date corresponding to the date indicated by point.
450 (let* ((calendar-month-name-array calendar-islamic-month-name-array))
453 islamic-diary-entry-symbol
454 (calendar-date-string
455 (calendar-islamic-from-absolute
456 (calendar-absolute-from-gregorian
457 (calendar-cursor-to-date t)))
461 (defun insert-monthly-islamic-diary-entry (arg)
463 For the day of the Islamic month corresponding to the date indicated by point.
466 (let* ((calendar-date-display-form
467 (if european-calendar-style '(day " * ") '("* " day )))
468 (calendar-month-name-array calendar-islamic-month-name-array))
471 islamic-diary-entry-symbol
472 (calendar-date-string
473 (calendar-islamic-from-absolute
474 (calendar-absolute-from-gregorian
475 (calendar-cursor-to-date t)))))
478 (defun insert-yearly-islamic-diary-entry (arg)
480 For the day of the Islamic year corresponding to the date indicated by point.
483 (let* ((calendar-date-display-form
484 (if european-calendar-style
487 (calendar-month-name-array calendar-islamic-month-name-array))
490 islamic-diary-entry-symbol
491 (calendar-date-string
492 (calendar-islamic-from-absolute
493 (calendar-absolute-from-gregorian
494 (calendar-cursor-to-date t)))))