Lines Matching +defs:calendar +defs:goto +defs:bahai +defs:date
1 ;;; cal-bahai.el --- calendar functions for the Baha'i calendar.
7 ;; Keywords: calendar
8 ;; Human-Keywords: Baha'i calendar, Baha'i, Bahai, calendar, diary
29 ;; This collection of functions implements the features of calendar.el
30 ;; and diary.el that deal with the Baha'i calendar.
32 ;; The Baha'i (http://www.bahai.org) calendar system is based on a
47 ;; The calendar was named the "Badi calendar" by its author, the Bab.
58 (defvar date)
62 (defvar original-date)
66 (defvar bahai-calendar-month-name-array
71 (defvar calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844))
72 "Absolute date of start of Baha'i calendar = March 19, 622 A.D. (Julian).")
74 (defun bahai-calendar-leap-year-p (year)
75 "True if YEAR is a leap year on the Baha'i calendar."
76 (calendar-leap-year-p (+ year 1844)))
78 (defvar bahai-calendar-leap-base
81 (defun calendar-absolute-from-bahai (date)
82 "Compute absolute date from Baha'i date DATE.
83 The absolute date is the number of days elapsed since the (imaginary)
84 Gregorian date Sunday, December 31, 1 BC."
85 (let* ((month (extract-calendar-month date))
86 (day (extract-calendar-day date))
87 (year (extract-calendar-year date))
92 bahai-calendar-leap-base)))
93 (+ (1- calendar-bahai-epoch) ; Days before epoch
96 (calendar-sum m 1 (< m month) 19)
100 (defun calendar-bahai-from-absolute (date)
102 (if (< date calendar-bahai-epoch)
103 (list 0 0 0) ;; pre-Baha'i date
104 (let* ((greg (calendar-gregorian-from-absolute date))
105 (year (+ (- (extract-calendar-year greg) 1844)
106 (if (or (> (extract-calendar-month greg) 3)
107 (and (= (extract-calendar-month greg) 3)
108 (>= (extract-calendar-day greg) 21)))
111 (1+ (calendar-sum m 1
112 (> date
113 (calendar-absolute-from-bahai
117 (- date
118 (1- (calendar-absolute-from-bahai (list month 1 year))))))
121 (defun calendar-bahai-date-string (&optional date)
122 "String of Baha'i date of Gregorian DATE.
123 Defaults to today's date if DATE is not given."
124 (let* ((bahai-date (calendar-bahai-from-absolute
125 (calendar-absolute-from-gregorian
126 (or date (calendar-current-date)))))
127 (y (extract-calendar-year bahai-date))
128 (m (extract-calendar-month bahai-date))
129 (d (extract-calendar-day bahai-date)))
134 (aref bahai-calendar-month-name-array (1- m))))
137 (if (bahai-calendar-leap-year-p y)
144 (mapconcat 'eval calendar-date-display-form ""))))
146 (defun calendar-print-bahai-date ()
147 "Show the Baha'i calendar equivalent of the selected date."
149 (message "Baha'i date: %s"
150 (calendar-bahai-date-string (calendar-cursor-to-date t))))
152 (defun calendar-goto-bahai-date (date &optional noecho)
153 "Move cursor to Baha'i date DATE.
154 Echo Baha'i date unless NOECHO is t."
155 (interactive (bahai-prompt-for-date))
156 (calendar-goto-date (calendar-gregorian-from-absolute
157 (calendar-absolute-from-bahai date)))
158 (or noecho (calendar-print-bahai-date)))
160 (defun bahai-prompt-for-date ()
161 "Ask for a Baha'i date."
162 (let* ((today (calendar-current-date))
163 (year (calendar-read
164 "Baha'i calendar year (not 0): "
167 (extract-calendar-year
168 (calendar-bahai-from-absolute
169 (calendar-absolute-from-gregorian today))))))
173 "Baha'i calendar month name: "
175 (append bahai-calendar-month-name-array nil))
177 (calendar-make-alist bahai-calendar-month-name-array
179 (day (calendar-read "Baha'i calendar day (1-19): "
183 (defun diary-bahai-date ()
184 "Baha'i calendar equivalent of date diary entry."
185 (format "Baha'i date: %s" (calendar-bahai-date-string date)))
187 (defun holiday-bahai (month day string)
190 Gregorian date in the form of the list (((month day year) STRING)). Returns
191 nil if it is not visible in the current calendar window."
192 (let* ((bahai-date (calendar-bahai-from-absolute
193 (calendar-absolute-from-gregorian
195 (m (extract-calendar-month bahai-date))
196 (y (extract-calendar-year bahai-date))
197 (date))
199 nil ;; Baha'i calendar doesn't apply.
200 (increment-calendar-month m y (- 10 month))
201 (if (> m 7) ;; Baha'i date might be visible
202 (let ((date (calendar-gregorian-from-absolute
203 (calendar-absolute-from-bahai (list month day y)))))
204 (if (calendar-date-is-visible-p date)
205 (list (list date string))))))))
207 (defun list-bahai-diary-entries ()
208 "Add any Baha'i date entries from the diary file to `diary-entries-list'.
209 Baha'i date diary entries must be prefaced by an
210 `bahai-diary-entry-symbol' (normally a `B'). The same diary date
211 forms govern the style of the Baha'i calendar entries, except that the
214 Baha'i date diary entry begins with a `diary-nonmarking-symbol', the
216 calendar. This function is provided for use with the
221 (gdate original-date)
223 (calendar-for-loop i from 1 to number do
224 (let* ((d diary-date-forms)
225 (bdate (calendar-bahai-from-absolute
226 (calendar-absolute-from-gregorian gdate)))
227 (month (extract-calendar-month bdate))
228 (day (extract-calendar-day bdate))
229 (year (extract-calendar-year bdate)))
232 ((date-form (if (equal (car (car d)) 'backup)
238 (calendar-day-name gdate) "\\|"
239 (substring (calendar-day-name gdate) 0 3) ".?"))
240 (calendar-month-name-array
241 bahai-calendar-month-name-array)
245 (calendar-month-name month)))
251 (if abbreviated-calendar-year
257 (regexp-quote bahai-diary-entry-symbol)
259 (mapconcat 'eval date-form "\\)\\(")
262 (goto-char (point-min))
268 ;; Diary entry that consists only of date.
273 (date-start))
275 (setq date-start (point))
280 (subst-char-in-region date-start (point) ?\^M ?\n t)
285 (1+ date-start) (1- entry-start)))))))
288 (calendar-gregorian-from-absolute
289 (1+ (calendar-absolute-from-gregorian gdate)))))
291 (goto-char (point-min))))
293 (defun mark-bahai-diary-entries ()
294 "Mark days in the calendar window that have Baha'i date diary entries.
295 Each entry in diary-file (or included files) visible in the calendar
296 window is marked. Baha'i date entries are prefaced by a
297 bahai-diary-entry-symbol \(normally a B`I'). The same
298 diary-date-forms govern the style of the Baha'i calendar entries,
301 `Ala. Baha'i date diary entries that begin with a
302 diary-nonmarking-symbol will not be marked in the calendar. This
305 (let ((d diary-date-forms))
308 ((date-form (if (equal (car (car d)) 'backup)
311 (dayname (diary-name-pattern calendar-day-name-array))
314 (diary-name-pattern bahai-calendar-month-name-array t)
319 (l (length date-form))
320 (d-name-pos (- l (length (memq 'dayname date-form))))
322 (m-name-pos (- l (length (memq 'monthname date-form))))
324 (d-pos (- l (length (memq 'day date-form))))
326 (m-pos (- l (length (memq 'month date-form))))
328 (y-pos (- l (length (memq 'year date-form))))
333 (regexp-quote bahai-diary-entry-symbol)
335 (mapconcat 'eval date-form "\\)\\(")
338 (goto-char (point-min))
369 abbreviated-calendar-year)
371 (extract-calendar-year
372 (calendar-bahai-from-absolute
373 (calendar-absolute-from-gregorian
374 (calendar-current-date)))))
384 (mark-calendar-days-named
386 (calendar-make-alist
387 calendar-day-name-array
397 (calendar-make-alist
398 bahai-calendar-month-name-array)
400 (mark-bahai-calendar-date-pattern mm dd yy)))))
403 (defun mark-bahai-calendar-date-pattern (month day year)
404 "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR.
407 (set-buffer calendar-buffer)
410 ;; Fully specified Baha'i date.
411 (let ((date (calendar-gregorian-from-absolute
412 (calendar-absolute-from-bahai
414 (if (calendar-date-is-visible-p date)
415 (mark-visible-calendar-date date)))
417 (let* ((bahai-date (calendar-bahai-from-absolute
418 (calendar-absolute-from-gregorian
420 (m (extract-calendar-month bahai-date))
421 (y (extract-calendar-year bahai-date))
422 (date))
424 nil;; Baha'i calendar doesn't apply.
425 (increment-calendar-month m y (- 10 month))
426 (if (> m 7);; Baha'i date might be visible
427 (let ((date (calendar-gregorian-from-absolute
428 (calendar-absolute-from-bahai
430 (if (calendar-date-is-visible-p date)
431 (mark-visible-calendar-date date)))))))
437 (first-date)
438 (last-date))
439 (increment-calendar-month m y -1)
440 (setq first-date
441 (calendar-absolute-from-gregorian
443 (increment-calendar-month m y 2)
444 (setq last-date
445 (calendar-absolute-from-gregorian
446 (list m (calendar-last-day-of-month m y) y)))
447 (calendar-for-loop date from first-date to last-date do
448 (let* ((b-date (calendar-bahai-from-absolute date))
449 (i-month (extract-calendar-month b-date))
450 (i-day (extract-calendar-day b-date))
451 (i-year (extract-calendar-year b-date)))
458 (mark-visible-calendar-date
459 (calendar-gregorian-from-absolute date)))))))))
461 (defun insert-bahai-diary-entry (arg)
463 For the Baha'i date corresponding to the date indicated by point.
466 (let* ((calendar-month-name-array bahai-calendar-month-name-array))
469 bahai-diary-entry-symbol
470 (calendar-date-string
471 (calendar-bahai-from-absolute
472 (calendar-absolute-from-gregorian
473 (calendar-cursor-to-date t)))
477 (defun insert-monthly-bahai-diary-entry (arg)
479 For the day of the Baha'i month corresponding to the date indicated by point.
482 (let* ((calendar-date-display-form
483 (if european-calendar-style '(day " * ") '("* " day )))
484 (calendar-month-name-array bahai-calendar-month-name-array))
487 bahai-diary-entry-symbol
488 (calendar-date-string
489 (calendar-bahai-from-absolute
490 (calendar-absolute-from-gregorian
491 (calendar-cursor-to-date t)))))
494 (defun insert-yearly-bahai-diary-entry (arg)
496 For the day of the Baha'i year corresponding to the date indicated by point.
499 (let* ((calendar-date-display-form
500 (if european-calendar-style
503 (calendar-month-name-array bahai-calendar-month-name-array))
506 bahai-diary-entry-symbol
507 (calendar-date-string
508 (calendar-bahai-from-absolute
509 (calendar-absolute-from-gregorian
510 (calendar-cursor-to-date t)))))
513 (provide 'cal-bahai)
516 ;;; cal-bahai.el ends here