aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2007-07-27 20:24:09 +0000
committerStefan Monnier2007-07-27 20:24:09 +0000
commite4e1cf95569c912d2113bf7211fbed434a623441 (patch)
tree01a669b2c109269f9f480cb84d67b484d8b24461
parent11361a8b9898df2f9e2054118434f59dd0f22b46 (diff)
downloademacs-e4e1cf95569c912d2113bf7211fbed434a623441.tar.gz
emacs-e4e1cf95569c912d2113bf7211fbed434a623441.zip
(calendar-bahai-month-name-array, calendar-bahai-epoch)
(calendar-bahai-leap-year-p, calendar-bahai-leap-base, diary-list-bahai-entries) (calendar-bahai-prompt-for-date, diary-bahai-mark-entries) (calendar-bahai-mark-date-pattern, diary-insert-bahai-entry) (diary-bahai-insert-monthly-entry, diary-bahai-insert-yearly-entry): New names to clean up namespace. (list-bahai-diary-entries, mark-bahai-diary-entries) (insert-bahai-diary-entry, insert-monthly-bahai-diary-entry) (insert-yearly-bahai-diary-entry, mark-bahai-calendar-date-pattern): Add compatibility aliases.
-rw-r--r--lisp/ChangeLog12
-rw-r--r--lisp/calendar/cal-bahai.el64
2 files changed, 51 insertions, 25 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 422d1936eea..f233d629670 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,17 @@
12007-07-27 Stefan Monnier <monnier@iro.umontreal.ca> 12007-07-27 Stefan Monnier <monnier@iro.umontreal.ca>
2 2
3 * calendar/cal-bahai.el (calendar-bahai-month-name-array)
4 (calendar-bahai-epoch, calendar-bahai-leap-year-p)
5 (calendar-bahai-leap-base, calendar-bahai-prompt-for-date)
6 (diary-list-bahai-entries, diary-bahai-mark-entries)
7 (calendar-bahai-mark-date-pattern, diary-insert-bahai-entry)
8 (diary-bahai-insert-monthly-entry, diary-bahai-insert-yearly-entry):
9 New names to clean up namespace.
10 (list-bahai-diary-entries, mark-bahai-diary-entries)
11 (insert-bahai-diary-entry, insert-monthly-bahai-diary-entry)
12 (insert-yearly-bahai-diary-entry, mark-bahai-calendar-date-pattern):
13 Add compatibility aliases.
14
3 * calendar/appt.el: Don't wrap defvar within eval-when-compile. 15 * calendar/appt.el: Don't wrap defvar within eval-when-compile.
4 16
5 * calendar/cal-move.el (calendar-scroll-left, calendar-scroll-right) 17 * calendar/cal-move.el (calendar-scroll-left, calendar-scroll-right)
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index e3b84539614..1657611466c 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -63,19 +63,19 @@
63 63
64(require 'cal-julian) 64(require 'cal-julian)
65 65
66(defvar bahai-calendar-month-name-array 66(defconst calendar-bahai-month-name-array
67 ["Baha" "Jalal" "Jamal" "`Azamat" "Nur" "Rahmat" "Kalimat" "Kamal" 67 ["Baha" "Jalal" "Jamal" "`Azamat" "Nur" "Rahmat" "Kalimat" "Kamal"
68 "Asma" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masa'il" 68 "Asma" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masa'il"
69 "Sharaf" "Sultan" "Mulk" "`Ala"]) 69 "Sharaf" "Sultan" "Mulk" "`Ala"])
70 70
71(defvar calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844)) 71(defconst 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).") 72 "Absolute date of start of Baha'i calendar = March 19, 622 A.D. (Julian).")
73 73
74(defun bahai-calendar-leap-year-p (year) 74(defun calendar-bahai-leap-year-p (year)
75 "True if YEAR is a leap year on the Baha'i calendar." 75 "True if YEAR is a leap year on the Baha'i calendar."
76 (calendar-leap-year-p (+ year 1844))) 76 (calendar-leap-year-p (+ year 1844)))
77 77
78(defvar bahai-calendar-leap-base 78(defconst calendar-bahai-leap-base
79 (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400))) 79 (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400)))
80 80
81(defun calendar-absolute-from-bahai (date) 81(defun calendar-absolute-from-bahai (date)
@@ -89,7 +89,7 @@ Gregorian date Sunday, December 31, 1 BC."
89 (leap-days (- (+ (/ prior-years 4) ; Leap days in prior years. 89 (leap-days (- (+ (/ prior-years 4) ; Leap days in prior years.
90 (- (/ prior-years 100)) 90 (- (/ prior-years 100))
91 (/ prior-years 400)) 91 (/ prior-years 400))
92 bahai-calendar-leap-base))) 92 calendar-bahai-leap-base)))
93 (+ (1- calendar-bahai-epoch) ; Days before epoch 93 (+ (1- calendar-bahai-epoch) ; Days before epoch
94 (* 365 (1- year)) ; Days in prior years. 94 (* 365 (1- year)) ; Days in prior years.
95 leap-days 95 leap-days
@@ -131,10 +131,10 @@ Defaults to today's date if DATE is not given."
131 (if (and (= m 19) 131 (if (and (= m 19)
132 (<= d 0)) 132 (<= d 0))
133 "Ayyam-i-Ha" 133 "Ayyam-i-Ha"
134 (aref bahai-calendar-month-name-array (1- m)))) 134 (aref calendar-bahai-month-name-array (1- m))))
135 (day (int-to-string 135 (day (int-to-string
136 (if (<= d 0) 136 (if (<= d 0)
137 (if (bahai-calendar-leap-year-p y) 137 (if (calendar-bahai-leap-year-p y)
138 (+ d 5) 138 (+ d 5)
139 (+ d 4)) 139 (+ d 4))
140 d))) 140 d)))
@@ -152,12 +152,12 @@ Defaults to today's date if DATE is not given."
152(defun calendar-goto-bahai-date (date &optional noecho) 152(defun calendar-goto-bahai-date (date &optional noecho)
153 "Move cursor to Baha'i date DATE. 153 "Move cursor to Baha'i date DATE.
154Echo Baha'i date unless NOECHO is t." 154Echo Baha'i date unless NOECHO is t."
155 (interactive (bahai-prompt-for-date)) 155 (interactive (calendar-bahai-prompt-for-date))
156 (calendar-goto-date (calendar-gregorian-from-absolute 156 (calendar-goto-date (calendar-gregorian-from-absolute
157 (calendar-absolute-from-bahai date))) 157 (calendar-absolute-from-bahai date)))
158 (or noecho (calendar-print-bahai-date))) 158 (or noecho (calendar-print-bahai-date)))
159 159
160(defun bahai-prompt-for-date () 160(defun calendar-bahai-prompt-for-date ()
161 "Ask for a Baha'i date." 161 "Ask for a Baha'i date."
162 (let* ((today (calendar-current-date)) 162 (let* ((today (calendar-current-date))
163 (year (calendar-read 163 (year (calendar-read
@@ -172,9 +172,9 @@ Echo Baha'i date unless NOECHO is t."
172 (completing-read 172 (completing-read
173 "Baha'i calendar month name: " 173 "Baha'i calendar month name: "
174 (mapcar 'list 174 (mapcar 'list
175 (append bahai-calendar-month-name-array nil)) 175 (append calendar-bahai-month-name-array nil))
176 nil t) 176 nil t)
177 (calendar-make-alist bahai-calendar-month-name-array 177 (calendar-make-alist calendar-bahai-month-name-array
178 1)))) 178 1))))
179 (day (calendar-read "Baha'i calendar day (1-19): " 179 (day (calendar-read "Baha'i calendar day (1-19): "
180 '(lambda (x) (and (< 0 x) (<= x 19)))))) 180 '(lambda (x) (and (< 0 x) (<= x 19))))))
@@ -204,7 +204,7 @@ nil if it is not visible in the current calendar window."
204 (if (calendar-date-is-visible-p date) 204 (if (calendar-date-is-visible-p date)
205 (list (list date string)))))))) 205 (list (list date string))))))))
206 206
207(defun list-bahai-diary-entries () 207(defun diary-list-bahai-entries ()
208 "Add any Baha'i date entries from the diary file to `diary-entries-list'. 208 "Add any Baha'i date entries from the diary file to `diary-entries-list'.
209Baha'i date diary entries must be prefaced by an 209Baha'i date diary entries must be prefaced by an
210`bahai-diary-entry-symbol' (normally a `B'). The same diary date 210`bahai-diary-entry-symbol' (normally a `B'). The same diary date
@@ -238,7 +238,7 @@ calendar. This function is provided for use with the
238 (calendar-day-name gdate) "\\|" 238 (calendar-day-name gdate) "\\|"
239 (substring (calendar-day-name gdate) 0 3) ".?")) 239 (substring (calendar-day-name gdate) 0 3) ".?"))
240 (calendar-month-name-array 240 (calendar-month-name-array
241 bahai-calendar-month-name-array) 241 calendar-bahai-month-name-array)
242 (monthname 242 (monthname
243 (concat 243 (concat
244 "\\*\\|" 244 "\\*\\|"
@@ -290,7 +290,7 @@ calendar. This function is provided for use with the
290 (set-buffer-modified-p diary-modified)) 290 (set-buffer-modified-p diary-modified))
291 (goto-char (point-min)))) 291 (goto-char (point-min))))
292 292
293(defun mark-bahai-diary-entries () 293(defun diary-bahai-mark-entries ()
294 "Mark days in the calendar window that have Baha'i date diary entries. 294 "Mark days in the calendar window that have Baha'i date diary entries.
295Each entry in diary-file (or included files) visible in the calendar 295Each entry in diary-file (or included files) visible in the calendar
296window is marked. Baha'i date entries are prefaced by a 296window is marked. Baha'i date entries are prefaced by a
@@ -311,7 +311,7 @@ nongregorian-diary-marking-hook."
311 (dayname (diary-name-pattern calendar-day-name-array)) 311 (dayname (diary-name-pattern calendar-day-name-array))
312 (monthname 312 (monthname
313 (concat 313 (concat
314 (diary-name-pattern bahai-calendar-month-name-array t) 314 (diary-name-pattern calendar-bahai-month-name-array t)
315 "\\|\\*")) 315 "\\|\\*"))
316 (month "[0-9]+\\|\\*") 316 (month "[0-9]+\\|\\*")
317 (day "[0-9]+\\|\\*") 317 (day "[0-9]+\\|\\*")
@@ -395,12 +395,12 @@ nongregorian-diary-marking-hook."
395 (cdr (assoc-string 395 (cdr (assoc-string
396 mm-name 396 mm-name
397 (calendar-make-alist 397 (calendar-make-alist
398 bahai-calendar-month-name-array) 398 calendar-bahai-month-name-array)
399 t))))) 399 t)))))
400 (mark-bahai-calendar-date-pattern mm dd yy))))) 400 (calendar-bahai-mark-date-pattern mm dd yy)))))
401 (setq d (cdr d))))) 401 (setq d (cdr d)))))
402 402
403(defun mark-bahai-calendar-date-pattern (month day year) 403(defun calendar-bahai-mark-date-pattern (month day year)
404 "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR. 404 "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR.
405A value of 0 in any position is a wildcard." 405A value of 0 in any position is a wildcard."
406 (save-excursion 406 (save-excursion
@@ -458,12 +458,12 @@ A value of 0 in any position is a wildcard."
458 (mark-visible-calendar-date 458 (mark-visible-calendar-date
459 (calendar-gregorian-from-absolute date))))))))) 459 (calendar-gregorian-from-absolute date)))))))))
460 460
461(defun insert-bahai-diary-entry (arg) 461(defun diary-insert-bahai-entry (arg)
462 "Insert a diary entry. 462 "Insert a diary entry.
463For the Baha'i date corresponding to the date indicated by point. 463For the Baha'i date corresponding to the date indicated by point.
464Prefix arg will make the entry nonmarking." 464Prefix arg will make the entry nonmarking."
465 (interactive "P") 465 (interactive "P")
466 (let* ((calendar-month-name-array bahai-calendar-month-name-array)) 466 (let* ((calendar-month-name-array calendar-bahai-month-name-array))
467 (make-diary-entry 467 (make-diary-entry
468 (concat 468 (concat
469 bahai-diary-entry-symbol 469 bahai-diary-entry-symbol
@@ -474,14 +474,14 @@ Prefix arg will make the entry nonmarking."
474 nil t)) 474 nil t))
475 arg))) 475 arg)))
476 476
477(defun insert-monthly-bahai-diary-entry (arg) 477(defun diary-bahai-insert-monthly-entry (arg)
478 "Insert a monthly diary entry. 478 "Insert a monthly diary entry.
479For the day of the Baha'i month corresponding to the date indicated by point. 479For the day of the Baha'i month corresponding to the date indicated by point.
480Prefix arg will make the entry nonmarking." 480Prefix arg will make the entry nonmarking."
481 (interactive "P") 481 (interactive "P")
482 (let* ((calendar-date-display-form 482 (let* ((calendar-date-display-form
483 (if european-calendar-style '(day " * ") '("* " day ))) 483 (if european-calendar-style '(day " * ") '("* " day )))
484 (calendar-month-name-array bahai-calendar-month-name-array)) 484 (calendar-month-name-array calendar-bahai-month-name-array))
485 (make-diary-entry 485 (make-diary-entry
486 (concat 486 (concat
487 bahai-diary-entry-symbol 487 bahai-diary-entry-symbol
@@ -491,7 +491,7 @@ Prefix arg will make the entry nonmarking."
491 (calendar-cursor-to-date t))))) 491 (calendar-cursor-to-date t)))))
492 arg))) 492 arg)))
493 493
494(defun insert-yearly-bahai-diary-entry (arg) 494(defun diary-bahai-insert-yearly-entry (arg)
495 "Insert an annual diary entry. 495 "Insert an annual diary entry.
496For the day of the Baha'i year corresponding to the date indicated by point. 496For the day of the Baha'i year corresponding to the date indicated by point.
497Prefix arg will make the entry nonmarking." 497Prefix arg will make the entry nonmarking."
@@ -500,7 +500,7 @@ Prefix arg will make the entry nonmarking."
500 (if european-calendar-style 500 (if european-calendar-style
501 '(day " " monthname) 501 '(day " " monthname)
502 '(monthname " " day))) 502 '(monthname " " day)))
503 (calendar-month-name-array bahai-calendar-month-name-array)) 503 (calendar-month-name-array calendar-bahai-month-name-array))
504 (make-diary-entry 504 (make-diary-entry
505 (concat 505 (concat
506 bahai-diary-entry-symbol 506 bahai-diary-entry-symbol
@@ -510,7 +510,21 @@ Prefix arg will make the entry nonmarking."
510 (calendar-cursor-to-date t))))) 510 (calendar-cursor-to-date t)))))
511 arg))) 511 arg)))
512 512
513;; Backward compatibility.
514(define-obsolete-function-alias
515 'list-bahai-diary-entries 'diary-list-bahai-entries "23.1")
516(define-obsolete-function-alias
517 'mark-bahai-diary-entries 'diary-mark-bahai-entries "23.1")
518(define-obsolete-function-alias
519 'insert-bahai-diary-entry 'diary-insert-bahai-entry "23.1")
520(define-obsolete-function-alias
521 'insert-monthly-bahai-diary-entry 'diary-insert-bahai-monthly-entry "23.1")
522(define-obsolete-function-alias
523 'insert-yearly-bahai-diary-entry 'diary-insert-bahai-yearly-entry "23.1")
524(define-obsolete-function-alias
525 'mark-bahai-calendar-date-pattern 'calendar-bahai-mark-date-pattern "23.1")
526
513(provide 'cal-bahai) 527(provide 'cal-bahai)
514 528
515;;; arch-tag: c1cb1d67-862a-4264-a01c-41cb4df01f14 529;; arch-tag: c1cb1d67-862a-4264-a01c-41cb4df01f14
516;;; cal-bahai.el ends here 530;;; cal-bahai.el ends here