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

[Glenn Morris]

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

Index: cal-hebrew.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calendar/cal-hebrew.el,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -b -r1.44 -r1.45
--- cal-hebrew.el       15 Mar 2008 03:01:40 -0000      1.44
+++ cal-hebrew.el       16 Mar 2008 01:25:11 -0000      1.45
@@ -111,7 +111,7 @@
   "Absolute date of Hebrew DATE.
 The absolute date is the number of days elapsed since the (imaginary)
 Gregorian date Sunday, December 31, 1 BC."
-  (let* ((month (extract-calendar-month date))
+  (let ((month (extract-calendar-month date))
          (day (extract-calendar-day date))
          (year (extract-calendar-year date)))
     (+ day                              ; days so far this month
@@ -135,10 +135,10 @@
 The absolute date is the number of days elapsed since the (imaginary)
 Gregorian date Sunday, December 31, 1 BC."
   (let* ((greg-date (calendar-gregorian-from-absolute date))
+         (year (+ 3760 (extract-calendar-year greg-date)))
          (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
                       (1- (extract-calendar-month greg-date))))
-         (day)
-         (year (+ 3760 (extract-calendar-year greg-date))))
+         day)
     (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
       (setq year (1+ year)))
     (let ((length (hebrew-calendar-last-month-of-year year)))
@@ -185,7 +185,7 @@
 
 (defun hebrew-calendar-yahrzeit (death-date year)
   "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."
-  (let* ((death-day (extract-calendar-day death-date))
+  (let ((death-day (extract-calendar-day death-date))
          (death-month (extract-calendar-month death-date))
          (death-year (extract-calendar-year death-date)))
     (cond
@@ -216,10 +216,8 @@
      (t (calendar-absolute-from-hebrew
          (list death-month death-day year))))))
 
-;;;###cal-autoload
-(defun calendar-goto-hebrew-date (date &optional noecho)
-  "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is non-nil."
-  (interactive
+(defun calendar-hebrew-prompt-for-date ()
+  "Ask for a Hebrew date."
    (let* ((today (calendar-current-date))
           (year (calendar-read
                  "Hebrew calendar year (>3760): "
@@ -259,6 +257,11 @@
                         first last)
                 (lambda (x) (and (<= first x) (<= x last))))))
      (list (list month day year))))
+
+;;;###cal-autoload
+(defun calendar-goto-hebrew-date (date &optional noecho)
+  "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is non-nil."
+  (interactive (calendar-hebrew-prompt-for-date))
   (calendar-goto-date (calendar-gregorian-from-absolute
                        (calendar-absolute-from-hebrew date)))
   (or noecho (calendar-print-hebrew-date)))
@@ -308,9 +311,8 @@
 ;;;###holiday-autoload
 (defun holiday-rosh-hashanah-etc ()
   "List of dates related to Rosh Hashanah, as visible in calendar window."
-  (if (or (< displayed-month 8)
+  (unless (or (< displayed-month 8)     ; none of the dates is visible
           (> displayed-month 11))
-      nil                               ; none of the dates is visible
     (let* ((abs-r-h (calendar-absolute-from-hebrew
                      (list 7 1 (+ displayed-year 3761))))
            (mandatory
@@ -403,8 +405,7 @@
 ;;;###holiday-autoload
 (defun holiday-passover-etc ()
   "List of dates related to Passover, as visible in calendar window."
-  (if (< 7 displayed-month)
-      nil                               ; none of the dates is visible
+  (unless (< 7 displayed-month)         ; none of the dates is visible
     (let* ((abs-p (calendar-absolute-from-hebrew
                    (list 1 15 (+ displayed-year 3760))))
            (mandatory
@@ -488,12 +489,10 @@
 ;;;###holiday-autoload
 (defun holiday-tisha-b-av-etc ()
   "List of dates around Tisha B'Av, as visible in calendar window."
-  (if (or (< displayed-month 5)
+  (unless (or (< displayed-month 5)     ; none of the dates is visible
           (> displayed-month 9))
-      nil                               ; none of the dates is visible
-    (let* ((abs-t-a (calendar-absolute-from-hebrew
+    (let ((abs-t-a (calendar-absolute-from-hebrew
                      (list 5 9 (+ displayed-year 3760)))))
-
       (holiday-filter-visible-calendar
        (list
         (list (calendar-gregorian-from-absolute
@@ -528,10 +527,15 @@
                         hebrew-diary-entry-symbol
                         'calendar-hebrew-from-absolute))
 
+(autoload 'calendar-mark-complex "diary-lib")
+
 ;;;###diary-autoload
-(defun mark-hebrew-calendar-date-pattern (month day year)
+(defun mark-hebrew-calendar-date-pattern (month day year &optional color)
   "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
-A value of 0 in any position is a wildcard."
+A value of 0 in any position is a wildcard.  Optional argument COLOR is
+passed to `mark-visible-calendar-date' as MARK."
+  ;; FIXME not the same as the Bahai and Islamic cases, so can't use
+  ;; calendar-mark-1.
   (save-excursion
     (set-buffer calendar-buffer)
     (if (and (not (zerop month)) (not (zerop day)))
@@ -541,7 +545,7 @@
                          (calendar-absolute-from-hebrew
                           (list month day year)))))
               (if (calendar-date-is-visible-p date)
-                  (mark-visible-calendar-date date)))
+                  (mark-visible-calendar-date date color)))
           ;; Month and day in any year--this taken from the holiday stuff.
           ;; This test is only to speed things up a bit, it works
           ;; fine without it.
@@ -556,7 +560,7 @@
                     (y1 displayed-year)
                     (m2 displayed-month)
                     (y2 displayed-year)
-                    (year))
+                    year)
                 (increment-calendar-month m1 y1 -1)
                 (increment-calendar-month m2 y2 1)
                 (let* ((start-date (calendar-absolute-from-gregorian
@@ -565,8 +569,7 @@
                                   (list m2
                                         (calendar-last-day-of-month m2 y2)
                                         y2)))
-                       (hebrew-start
-                        (calendar-hebrew-from-absolute start-date))
+                       (hebrew-start (calendar-hebrew-from-absolute 
start-date))
                        (hebrew-end (calendar-hebrew-from-absolute end-date))
                        (hebrew-y1 (extract-calendar-year hebrew-start))
                        (hebrew-y2 (extract-calendar-year hebrew-end)))
@@ -575,36 +578,9 @@
                                (calendar-absolute-from-hebrew
                                 (list month day year)))))
                     (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* ((h-date (calendar-hebrew-from-absolute date))
-                                  (h-month (extract-calendar-month h-date))
-                                  (h-day (extract-calendar-day h-date))
-                                  (h-year (extract-calendar-year h-date)))
-                             (and (or (zerop month)
-                                      (= month h-month))
-                                  (or (zerop day)
-                                      (= day h-day))
-                                  (or (zerop year)
-                                      (= year h-year))
-                                  (mark-visible-calendar-date
-                                   (calendar-gregorian-from-absolute date)))))
-        ))))
+                        (mark-visible-calendar-date date color)))))))
+      (calendar-mark-complex month day year
+                             'calendar-hebrew-from-absolute color))))
 
 (autoload 'diary-mark-entries-1 "diary-lib")
 
@@ -624,15 +600,12 @@
 For the Hebrew date corresponding to the date indicated by point.
 Prefix argument ARG makes the entry nonmarking."
   (interactive "P")
-  (let* ((calendar-month-name-array
-          calendar-hebrew-month-name-array-leap-year))
+  (let ((calendar-month-name-array calendar-hebrew-month-name-array-leap-year))
     (make-diary-entry
-     (concat
-      hebrew-diary-entry-symbol
+     (concat hebrew-diary-entry-symbol
       (calendar-date-string
        (calendar-hebrew-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))
+               (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))
        nil t))
      arg)))
 
@@ -642,17 +615,15 @@
 For the day of the Hebrew 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-hebrew-month-name-array-leap-year))
+  (let ((calendar-date-display-form (if european-calendar-style
+                                        '(day " * ")
+                                      '("* " day )))
+        (calendar-month-name-array calendar-hebrew-month-name-array-leap-year))
     (make-diary-entry
-     (concat
-      hebrew-diary-entry-symbol
+     (concat hebrew-diary-entry-symbol
       (calendar-date-string
        (calendar-hebrew-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
+               (calendar-absolute-from-gregorian (calendar-cursor-to-date 
t)))))
      arg)))
 
 ;;;###cal-autoload
@@ -661,19 +632,15 @@
 For the day of the Hebrew year 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 " " monthname)
             '(monthname " " day)))
-         (calendar-month-name-array
-          calendar-hebrew-month-name-array-leap-year))
+         (calendar-month-name-array 
calendar-hebrew-month-name-array-leap-year))
     (make-diary-entry
-     (concat
-      hebrew-diary-entry-symbol
+     (concat hebrew-diary-entry-symbol
       (calendar-date-string
        (calendar-hebrew-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
+               (calendar-absolute-from-gregorian (calendar-cursor-to-date 
t)))))
      arg)))
 
 ;;;###autoload