[Emacs-diffs] Changes to emacs/lisp/calendar/cal-bahai.el,v

[Glenn Morris]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Glenn Morris <gm>       08/03/16 01:23:55

Index: cal-bahai.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calendar/cal-bahai.el,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -b -r1.33 -r1.34
--- cal-bahai.el        15 Mar 2008 03:00:48 -0000      1.33
+++ cal-bahai.el        16 Mar 2008 01:23:55 -0000      1.34
@@ -123,9 +123,8 @@
                        (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 (extract-calendar-day bahai-date))
+         (monthname (if (and (= m 19)
                     (<= d 0))
                "Ayyám-i-Há"
              (aref calendar-bahai-month-name-array (1- m))))
@@ -135,10 +134,10 @@
                         (+ d 5)
                       (+ d 4))
                   d)))
-          (dayname nil)
+         (year (int-to-string y))
           (month (int-to-string m))
-          (year (int-to-string y)))
-      (mapconcat 'eval calendar-date-display-form ""))))
+         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)
 
@@ -219,65 +223,23 @@
     (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,13 +271,16 @@
               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
+  (let ((calendar-date-display-form (if european-calendar-style
                                          '(day " * ")
                                        '("* " day )))
          (calendar-month-name-array calendar-bahai-month-name-array))
@@ -323,13 +291,16 @@
                (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
+  (let ((calendar-date-display-form (if european-calendar-style
                                          '(day " " monthname)
                                        '(monthname " " day)))
          (calendar-month-name-array calendar-bahai-month-name-array))
@@ -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: