Mercurial > emacs
changeset 92990:2d634b2258fb
(calendar-mark-1): Autoload it.
(calendar-bahai-mark-date-pattern): Add optional argument `color'.
Use calendar-mark-1.
(calendar-bahai-date-string): Use a single let.
(diary-bahai-insert-entry, diary-bahai-insert-monthly-entry)
(diary-bahai-insert-yearly-entry): Use let rather than let*.
Move obsolete aliases after the functions that replaced them.
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Sun, 16 Mar 2008 01:23:55 +0000 |
| parents | 130c0da046a4 |
| children | 24a6717aed7f |
| files | lisp/calendar/cal-bahai.el |
| diffstat | 1 files changed, 64 insertions(+), 108 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/calendar/cal-bahai.el Sun Mar 16 01:23:25 2008 +0000 +++ b/lisp/calendar/cal-bahai.el Sun Mar 16 01:23:55 2008 +0000 @@ -105,10 +105,10 @@ 1 0))) (month ; search forward from Baha (1+ (calendar-sum m 1 - (> date - (calendar-absolute-from-bahai - (list m 19 year))) - 1))) + (> date + (calendar-absolute-from-bahai + (list m 19 year))) + 1))) (day ; calculate the day by subtraction (- date (1- (calendar-absolute-from-bahai (list month 1 year)))))) @@ -123,22 +123,21 @@ (or date (calendar-current-date))))) (y (extract-calendar-year bahai-date)) (m (extract-calendar-month bahai-date)) - (d (extract-calendar-day bahai-date))) - (let ((monthname - (if (and (= m 19) - (<= d 0)) - "Ayyám-i-Há" - (aref calendar-bahai-month-name-array (1- m)))) - (day (int-to-string - (if (<= d 0) - (if (calendar-bahai-leap-year-p y) - (+ d 5) - (+ d 4)) - d))) - (dayname nil) - (month (int-to-string m)) - (year (int-to-string y))) - (mapconcat 'eval calendar-date-display-form "")))) + (d (extract-calendar-day bahai-date)) + (monthname (if (and (= m 19) + (<= d 0)) + "Ayyám-i-Há" + (aref calendar-bahai-month-name-array (1- m)))) + (day (int-to-string + (if (<= d 0) + (if (calendar-bahai-leap-year-p y) + (+ d 5) + (+ d 4)) + d))) + (year (int-to-string y)) + (month (int-to-string m)) + dayname) + (mapconcat 'eval calendar-date-display-form ""))) ;;;###cal-autoload (defun calendar-bahai-print-date () @@ -147,6 +146,9 @@ (message "Bahá'í date: %s" (calendar-bahai-date-string (calendar-cursor-to-date t)))) +(define-obsolete-function-alias + 'calendar-print-bahai-date 'calendar-bahai-print-date "23.1") + (defun calendar-bahai-prompt-for-date () "Ask for a Bahá'í date." (let* ((today (calendar-current-date)) @@ -172,13 +174,15 @@ ;;;###cal-autoload (defun calendar-bahai-goto-date (date &optional noecho) - "Move cursor to Bahá'í date DATE. -Echo Bahá'í date unless NOECHO is non-nil." + "Move cursor to Bahá'í date DATE; echo Bahá'í date unless NOECHO is non-nil." (interactive (calendar-bahai-prompt-for-date)) (calendar-goto-date (calendar-gregorian-from-absolute (calendar-absolute-from-bahai date))) (or noecho (calendar-bahai-print-date))) +(define-obsolete-function-alias + 'calendar-goto-bahai-date 'calendar-bahai-goto-date "23.1") + (defvar displayed-month) (defvar displayed-year) @@ -216,68 +220,26 @@ `diary-nonmarking-symbol', the entry will appear in the diary listing, but will not be marked in the calendar. This function is provided for use with `nongregorian-diary-listing-hook'." - (diary-list-entries-1 calendar-bahai-month-name-array - bahai-diary-entry-symbol - 'calendar-bahai-from-absolute)) + (diary-list-entries-1 calendar-bahai-month-name-array + bahai-diary-entry-symbol + 'calendar-bahai-from-absolute)) +(define-obsolete-function-alias + 'list-bahai-diary-entries 'diary-bahai-list-entries "23.1") + + +(autoload 'calendar-mark-1 "diary-lib") ;;;###diary-autoload -(defun calendar-bahai-mark-date-pattern (month day year) +(defun calendar-bahai-mark-date-pattern (month day year &optional color) "Mark dates in calendar window that conform to Bahá'í date MONTH/DAY/YEAR. -A value of 0 in any position is a wildcard." - (save-excursion - (set-buffer calendar-buffer) - (if (and (not (zerop month)) (not (zerop day))) - (if (not (zerop year)) - ;; Fully specified Bahá'í date. - (let ((date (calendar-gregorian-from-absolute - (calendar-absolute-from-bahai - (list month day year))))) - (if (calendar-date-is-visible-p date) - (mark-visible-calendar-date date))) - ;; Month and day in any year--this taken from the holiday stuff. - (let* ((bahai-date (calendar-bahai-from-absolute - (calendar-absolute-from-gregorian - (list displayed-month 15 displayed-year)))) - (m (extract-calendar-month bahai-date)) - (y (extract-calendar-year bahai-date)) - (date)) - (unless (< m 1) ; Bahá'í calendar doesn't apply - (increment-calendar-month m y (- 10 month)) - (if (> m 7) ; Bahá'í date might be visible - (let ((date (calendar-gregorian-from-absolute - (calendar-absolute-from-bahai - (list month day y))))) - (if (calendar-date-is-visible-p date) - (mark-visible-calendar-date date))))))) - ;; Not one of the simple cases--check all visible dates for match. - ;; Actually, the following code takes care of ALL of the cases, but - ;; it's much too slow to be used for the simple (common) cases. - (let ((m displayed-month) - (y displayed-year) - (first-date) - (last-date)) - (increment-calendar-month m y -1) - (setq first-date - (calendar-absolute-from-gregorian - (list m 1 y))) - (increment-calendar-month m y 2) - (setq last-date - (calendar-absolute-from-gregorian - (list m (calendar-last-day-of-month m y) y))) - (calendar-for-loop date from first-date to last-date do - (let* ((b-date (calendar-bahai-from-absolute date)) - (i-month (extract-calendar-month b-date)) - (i-day (extract-calendar-day b-date)) - (i-year (extract-calendar-year b-date))) - (and (or (zerop month) - (= month i-month)) - (or (zerop day) - (= day i-day)) - (or (zerop year) - (= year i-year)) - (mark-visible-calendar-date - (calendar-gregorian-from-absolute - date))))))))) +A value of 0 in any position is a wildcard. Optional argument COLOR is +passed to `mark-visible-calendar-date' as MARK." + (calendar-mark-1 month day year 'calendar-bahai-from-absolute + 'calendar-absolute-from-bahai color)) + +(define-obsolete-function-alias + 'mark-bahai-calendar-date-pattern 'calendar-bahai-mark-date-pattern "23.1") + (autoload 'diary-mark-entries-1 "diary-lib") @@ -291,13 +253,16 @@ 'calendar-bahai-from-absolute 'calendar-bahai-mark-date-pattern)) +(define-obsolete-function-alias + 'mark-bahai-diary-entries 'diary-bahai-mark-entries "23.1") + ;;;###cal-autoload (defun diary-bahai-insert-entry (arg) "Insert a diary entry. For the Bahá'í date corresponding to the date indicated by point. Prefix argument ARG makes the entry nonmarking." (interactive "P") - (let* ((calendar-month-name-array calendar-bahai-month-name-array)) + (let ((calendar-month-name-array calendar-bahai-month-name-array)) (make-diary-entry (concat bahai-diary-entry-symbol (calendar-date-string @@ -306,16 +271,19 @@ nil t)) arg))) +(define-obsolete-function-alias + 'insert-bahai-diary-entry 'diary-bahai-insert-entry "23.1") + ;;;###cal-autoload (defun diary-bahai-insert-monthly-entry (arg) "Insert a monthly diary entry. For the day of the Bahá'í month corresponding to the date indicated by point. Prefix argument ARG makes the entry nonmarking." (interactive "P") - (let* ((calendar-date-display-form (if european-calendar-style - '(day " * ") - '("* " day ))) - (calendar-month-name-array calendar-bahai-month-name-array)) + (let ((calendar-date-display-form (if european-calendar-style + '(day " * ") + '("* " day ))) + (calendar-month-name-array calendar-bahai-month-name-array)) (make-diary-entry (concat bahai-diary-entry-symbol (calendar-date-string @@ -323,16 +291,19 @@ (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) arg))) +(define-obsolete-function-alias + 'insert-monthly-bahai-diary-entry 'diary-bahai-insert-monthly-entry "23.1") + ;;;###cal-autoload (defun diary-bahai-insert-yearly-entry (arg) "Insert an annual diary entry. For the day of the Bahá'í year corresponding to the date indicated by point. Prefix argument ARG will make the entry nonmarking." (interactive "P") - (let* ((calendar-date-display-form (if european-calendar-style - '(day " " monthname) - '(monthname " " day))) - (calendar-month-name-array calendar-bahai-month-name-array)) + (let ((calendar-date-display-form (if european-calendar-style + '(day " " monthname) + '(monthname " " day))) + (calendar-month-name-array calendar-bahai-month-name-array)) (make-diary-entry (concat bahai-diary-entry-symbol (calendar-date-string @@ -340,6 +311,9 @@ (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) arg))) +(define-obsolete-function-alias + 'insert-yearly-bahai-diary-entry 'diary-bahai-insert-yearly-entry "23.1") + (defvar date) ;; To be called from list-sexp-diary-entries, where DATE is bound. @@ -349,24 +323,6 @@ (format "Bahá'í date: %s" (calendar-bahai-date-string date))) -;; Backward compatibility. -(define-obsolete-function-alias - 'list-bahai-diary-entries 'diary-bahai-list-entries "23.1") -(define-obsolete-function-alias - 'mark-bahai-diary-entries 'diary-bahai-mark-entries "23.1") -(define-obsolete-function-alias - 'insert-bahai-diary-entry 'diary-bahai-insert-entry "23.1") -(define-obsolete-function-alias - 'insert-monthly-bahai-diary-entry 'diary-bahai-insert-monthly-entry "23.1") -(define-obsolete-function-alias - 'insert-yearly-bahai-diary-entry 'diary-bahai-insert-yearly-entry "23.1") -(define-obsolete-function-alias - 'mark-bahai-calendar-date-pattern 'calendar-bahai-mark-date-pattern "23.1") -(define-obsolete-function-alias - 'calendar-goto-bahai-date 'calendar-bahai-goto-date "23.1") -(define-obsolete-function-alias - 'calendar-print-bahai-date 'calendar-bahai-print-date "23.1") - (provide 'cal-bahai) ;; Local Variables: