(add-to-diary-list): Fix typo in previous doc fix.

[gnu-emacs] / lisp / calendar / cal-hebrew.el

diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index 79bbd95647423730816ac7fb124315fafe82ce20..1272e9966d4f89c4cec5988b7df2e47c165ebb70 100644 (file)
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -1,9 +1,11 @@
-;;; cal-hebrew.el --- calendar functions for the Hebrew calendar.
+;;; cal-hebrew.el --- calendar functions for the Hebrew calendar

 
 

-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006
+;;   Free Software Foundation, Inc.

 
 ;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
 ;;      Edward M. Reingold <reingold@cs.uiuc.edu>
 
 ;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
 ;;      Edward M. Reingold <reingold@cs.uiuc.edu>

+;; Maintainer: Glenn Morris <rgm@gnu.org>

 ;; Keywords: calendar
 ;; Human-Keywords: Hebrew calendar, calendar, diary
 
 ;; Keywords: calendar
 ;; Human-Keywords: Hebrew calendar, calendar, diary
 


@@ -21,14 +23,18 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the

-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.

 
 ;;; Commentary:
 
 ;; This collection of functions implements the features of calendar.el and
 ;; diary.el that deal with the Hebrew calendar.
 
 
 ;;; Commentary:
 
 ;; This collection of functions implements the features of calendar.el and
 ;; diary.el that deal with the Hebrew calendar.
 

+;; Technical details of all the calendrical calculations can be found in
+;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
+;; and Nachum Dershowitz, Cambridge University Press (2001).
+

 ;; Comments, corrections, and improvements should be sent to
 ;;  Edward M. Reingold               Department of Computer Science
 ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
 ;; Comments, corrections, and improvements should be sent to
 ;;  Edward M. Reingold               Department of Computer Science
 ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign


@@ -37,29 +43,14 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(require 'calendar)
+(defvar date)
+(defvar displayed-month)
+(defvar displayed-year)
+(defvar entry)
+(defvar number)
+(defvar original-date)

 
 

-(defun calendar-hebrew-from-absolute (date)
-  "Compute the Hebrew date (month day year) corresponding to absolute DATE.
-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))
-         (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))))
-    (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
-        (setq year (1+ year)))
-    (let ((length (hebrew-calendar-last-month-of-year year)))
-      (while (> date
-                (calendar-absolute-from-hebrew
-                 (list month
-                       (hebrew-calendar-last-day-of-month month year)
-                       year)))
-        (setq month (1+ (% month length)))))
-    (setq day (1+
-               (- date (calendar-absolute-from-hebrew (list month 1 year)))))
-    (list month day year)))
+(require 'calendar)

 
 (defun hebrew-calendar-leap-year-p (year)
   "t if YEAR is a Hebrew calendar leap year."
 
 (defun hebrew-calendar-leap-year-p (year)
   "t if YEAR is a Hebrew calendar leap year."


@@ -71,15 +62,6 @@ Gregorian date Sunday, December 31, 1 BC."
       13
     12))
 
       13
     12))
 

-(defun hebrew-calendar-last-day-of-month (month year)
-  "The last day of MONTH in YEAR."
-  (if (or (memq month (list 2 4 6 10 13))
-          (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
-          (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
-          (and (= month 9) (hebrew-calendar-short-kislev-p year)))
-      29
-    30))
-

 (defun hebrew-calendar-elapsed-days (year)
   "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
   (let* ((months-elapsed
 (defun hebrew-calendar-elapsed-days (year)
   "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
   (let* ((months-elapsed


@@ -111,9 +93,9 @@ Gregorian date Sunday, December 31, 1 BC."
             day)))
     (if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
         (memq (% alternative-day 7) (list 0 3 5))
             day)))
     (if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
         (memq (% alternative-day 7) (list 0 3 5))

-  ;; Then postpone it one (more) day and return        
+  ;; Then postpone it one (more) day and return

         (1+ alternative-day)
         (1+ alternative-day)

-  ;; Else return        
+  ;; Else return

       alternative-day)))
 
 (defun hebrew-calendar-days-in-year (year)
       alternative-day)))
 
 (defun hebrew-calendar-days-in-year (year)


@@ -129,6 +111,15 @@ Gregorian date Sunday, December 31, 1 BC."
   "t if Kislev is short in Hebrew YEAR."
   (= (% (hebrew-calendar-days-in-year year) 10) 3))
 
   "t if Kislev is short in Hebrew YEAR."
   (= (% (hebrew-calendar-days-in-year year) 10) 3))
 

+(defun hebrew-calendar-last-day-of-month (month year)
+  "The last day of MONTH in YEAR."
+  (if (or (memq month (list 2 4 6 10 13))
+          (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
+          (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
+          (and (= month 9) (hebrew-calendar-short-kislev-p year)))
+      29
+    30))
+

 (defun calendar-absolute-from-hebrew (date)
   "Absolute date of Hebrew DATE.
 The absolute date is the number of days elapsed since the (imaginary)
 (defun calendar-absolute-from-hebrew (date)
   "Absolute date of Hebrew DATE.
 The absolute date is the number of days elapsed since the (imaginary)


@@ -152,13 +143,37 @@ Gregorian date Sunday, December 31, 1 BC."
     (hebrew-calendar-elapsed-days year);; Days in prior years.
     -1373429)))                        ;; Days elapsed before absolute date 1.
 
     (hebrew-calendar-elapsed-days year);; Days in prior years.
     -1373429)))                        ;; Days elapsed before absolute date 1.
 

+(defun calendar-hebrew-from-absolute (date)
+  "Compute the Hebrew date (month day year) corresponding to absolute DATE.
+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))
+         (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))))
+    (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
+        (setq year (1+ year)))
+    (let ((length (hebrew-calendar-last-month-of-year year)))
+      (while (> date
+                (calendar-absolute-from-hebrew
+                 (list month
+                       (hebrew-calendar-last-day-of-month month year)
+                       year)))
+        (setq month (1+ (% month length)))))
+    (setq day (1+
+               (- date (calendar-absolute-from-hebrew (list month 1 year)))))
+    (list month day year)))
+

 (defvar calendar-hebrew-month-name-array-common-year
   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
 (defvar calendar-hebrew-month-name-array-common-year
   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"

-   "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"])
+   "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"]
+"Array of strings giving the names of the Hebrew months in a common year.")

 
 (defvar calendar-hebrew-month-name-array-leap-year
   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
 
 (defvar calendar-hebrew-month-name-array-leap-year
   ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"

-   "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"])
+   "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"]
+"Array of strings giving the names of the Hebrew months in a leap year.")

 
 (defun calendar-hebrew-date-string (&optional date)
   "String of Hebrew date before sunset of Gregorian DATE.
 
 (defun calendar-hebrew-date-string (&optional date)
   "String of Hebrew date before sunset of Gregorian DATE.


@@ -227,27 +242,25 @@ Driven by the variable `calendar-date-display-form'."
                            calendar-hebrew-month-name-array-leap-year
                          calendar-hebrew-month-name-array-common-year))
           (completion-ignore-case t)
                            calendar-hebrew-month-name-array-leap-year
                          calendar-hebrew-month-name-array-common-year))
           (completion-ignore-case t)

-          (month (cdr (assoc
-                       (capitalize
-                        (completing-read
-                         "Hebrew calendar month name: "
-                         (mapcar 'list (append month-array nil))
-                         (if (= year 3761)
-                             '(lambda (x)
-                                (let ((m (cdr
-                                          (assoc
-                                           (car x)
-                                           (calendar-make-alist
-                                            month-array)))))
-                                  (< 0
-                                     (calendar-absolute-from-hebrew
-                                      (list m
-                                            (hebrew-calendar-last-day-of-month
-                                             m year)
-                                            year))))))
-                                 
-                         t))
-                       (calendar-make-alist month-array 1 'capitalize))))
+          (month (cdr (assoc-string
+                       (completing-read
+                        "Hebrew calendar month name: "
+                        (mapcar 'list (append month-array nil))
+                        (if (= year 3761)
+                            '(lambda (x)
+                               (let ((m (cdr
+                                         (assoc-string
+                                          (car x)
+                                          (calendar-make-alist month-array)
+                                          t))))
+                                 (< 0
+                                    (calendar-absolute-from-hebrew
+                                     (list m
+                                           (hebrew-calendar-last-day-of-month
+                                            m year)
+                                           year))))))
+                        t)
+                       (calendar-make-alist month-array 1) t)))

           (last (hebrew-calendar-last-day-of-month month year))
           (first (if (and (= year 3761) (= month 10))
                      18 1))
           (last (hebrew-calendar-last-day-of-month month year))
           (first (if (and (= year 3761) (= month 10))
                      18 1))


@@ -314,7 +327,7 @@ nil if it is not visible in the current calendar window."
               (list (calendar-gregorian-from-absolute (+ abs-r-h 22))
                     "Simchat Torah")))
            (optional
               (list (calendar-gregorian-from-absolute (+ abs-r-h 22))
                     "Simchat Torah")))
            (optional

-            (list 
+            (list

              (list (calendar-gregorian-from-absolute
                     (calendar-dayname-on-or-before 6 (- abs-r-h 4)))
                    "Selichot (night)")
              (list (calendar-gregorian-from-absolute
                     (calendar-dayname-on-or-before 6 (- abs-r-h 4)))
                    "Selichot (night)")


@@ -343,12 +356,12 @@ nil if it is not visible in the current calendar window."
              (list (calendar-gregorian-from-absolute (+ abs-r-h 19))
                    "Hol Hamoed Sukkot (fourth day)")
              (list (calendar-gregorian-from-absolute (+ abs-r-h 20))
              (list (calendar-gregorian-from-absolute (+ abs-r-h 19))
                    "Hol Hamoed Sukkot (fourth day)")
              (list (calendar-gregorian-from-absolute (+ abs-r-h 20))

-                   "Hoshannah Rabbah")))
+                   "Hoshanah Rabbah")))

             (output-list
              (filter-visible-calendar-holidays mandatory)))
       (if all-hebrew-calendar-holidays
           (setq output-list
             (output-list
              (filter-visible-calendar-holidays mandatory)))
       (if all-hebrew-calendar-holidays
           (setq output-list

-                (append 
+                (append

                  (filter-visible-calendar-holidays optional)
                  output-list)))
       output-list)))
                  (filter-visible-calendar-holidays optional)
                  output-list)))
       output-list)))


@@ -399,7 +412,7 @@ nil if it is not visible in the current calendar window."
              (list (calendar-gregorian-from-absolute (+ abs-p 50))
                    "Shavuot")))
            (optional
              (list (calendar-gregorian-from-absolute (+ abs-p 50))
                    "Shavuot")))
            (optional

-            (list 
+            (list

              (list (calendar-gregorian-from-absolute
                     (calendar-dayname-on-or-before 6 (- abs-p 43)))
                    "Shabbat Shekalim")
              (list (calendar-gregorian-from-absolute
                     (calendar-dayname-on-or-before 6 (- abs-p 43)))
                    "Shabbat Shekalim")


@@ -456,7 +469,7 @@ nil if it is not visible in the current calendar window."
              (list (calendar-gregorian-from-absolute (+ abs-p 33))
                    "Lag BaOmer")
              (list (calendar-gregorian-from-absolute (+ abs-p 43))
              (list (calendar-gregorian-from-absolute (+ abs-p 33))
                    "Lag BaOmer")
              (list (calendar-gregorian-from-absolute (+ abs-p 43))

-                   "Yom Yerushalim")
+                   "Yom Yerushalaim")

              (list (calendar-gregorian-from-absolute (+ abs-p 49))
                    "Erev Shavuot")
              (list (calendar-gregorian-from-absolute (+ abs-p 51))
              (list (calendar-gregorian-from-absolute (+ abs-p 49))
                    "Erev Shavuot")
              (list (calendar-gregorian-from-absolute (+ abs-p 51))


@@ -465,7 +478,7 @@ nil if it is not visible in the current calendar window."
              (filter-visible-calendar-holidays mandatory)))
       (if all-hebrew-calendar-holidays
           (setq output-list
              (filter-visible-calendar-holidays mandatory)))
       (if all-hebrew-calendar-holidays
           (setq output-list

-                (append 
+                (append

                  (filter-visible-calendar-holidays optional)
                  output-list)))
       output-list)))
                  (filter-visible-calendar-holidays optional)
                  output-list)))
       output-list)))


@@ -479,7 +492,7 @@ nil if it is not visible in the current calendar window."
                       (list 5 9 (+ displayed-year 3760)))))
 
       (filter-visible-calendar-holidays
                       (list 5 9 (+ displayed-year 3760)))))
 
       (filter-visible-calendar-holidays

-       (list 
+       (list

         (list (calendar-gregorian-from-absolute
                (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))
               "Tzom Tammuz")
         (list (calendar-gregorian-from-absolute
                (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))
               "Tzom Tammuz")


@@ -511,7 +524,7 @@ not be marked in the calendar.  This function is provided for use with the
             (mark (regexp-quote diary-nonmarking-symbol)))
         (calendar-for-loop i from 1 to number do
            (let* ((d diary-date-forms)
             (mark (regexp-quote diary-nonmarking-symbol)))
         (calendar-for-loop i from 1 to number do
            (let* ((d diary-date-forms)

-                  (hdate (calendar-hebrew-from-absolute 
+                  (hdate (calendar-hebrew-from-absolute

                           (calendar-absolute-from-gregorian gdate)))
                   (month (extract-calendar-month hdate))
                   (day (extract-calendar-day hdate))
                           (calendar-absolute-from-gregorian gdate)))
                   (month (extract-calendar-month hdate))
                   (day (extract-calendar-day hdate))


@@ -523,9 +536,9 @@ not be marked in the calendar.  This function is provided for use with the
                                  (car d)))
                     (backup (equal (car (car d)) 'backup))
                     (dayname
                                  (car d)))
                     (backup (equal (car (car d)) 'backup))
                     (dayname

-                     (concat
-                      (calendar-day-name gdate) "\\|"
-                      (substring (calendar-day-name gdate) 0 3) ".?"))
+                     (format "%s\\|%s\\.?"
+                             (calendar-day-name gdate)
+                             (calendar-day-name gdate 'abbrev)))

                     (calendar-month-name-array
                      calendar-hebrew-month-name-array-leap-year)
                     (monthname
                     (calendar-month-name-array
                      calendar-hebrew-month-name-array-leap-year)
                     (monthname


@@ -568,7 +581,11 @@ not be marked in the calendar.  This function is provided for use with the
                        (backward-char 1)
                        (subst-char-in-region date-start (point) ?\^M ?\n t)
                        (add-to-diary-list
                        (backward-char 1)
                        (subst-char-in-region date-start (point) ?\^M ?\n t)
                        (add-to-diary-list

-                         gdate (buffer-substring entry-start (point)))))))
+                        gdate
+                        (buffer-substring-no-properties entry-start (point))
+                        (buffer-substring-no-properties
+                         (1+ date-start) (1- entry-start))
+                        (copy-marker entry-start))))))

                (setq d (cdr d))))
            (setq gdate
                  (calendar-gregorian-from-absolute
                (setq d (cdr d))))
            (setq gdate
                  (calendar-gregorian-from-absolute


@@ -576,6 +593,80 @@ not be marked in the calendar.  This function is provided for use with the
            (set-buffer-modified-p diary-modified))
         (goto-char (point-min))))
 
            (set-buffer-modified-p diary-modified))
         (goto-char (point-min))))
 

+(defun mark-hebrew-calendar-date-pattern (month day year)
+  "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
+A value of 0 in any position is a wildcard."
+  (save-excursion
+    (set-buffer calendar-buffer)
+    (if (and (/= 0 month) (/= 0 day))
+        (if (/= 0 year)
+            ;; Fully specified Hebrew date.
+            (let ((date (calendar-gregorian-from-absolute
+                         (calendar-absolute-from-hebrew
+                          (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.
+          (if (memq displayed-month;;  This test is only to speed things up a
+                    (list          ;;  bit; it works fine without the test too.
+                     (if (< 11 month) (- month 11) (+ month 1))
+                     (if (< 10 month) (- month 10) (+ month 2))
+                     (if (<  9 month) (- month  9) (+ month 3))
+                     (if (<  8 month) (- month  8) (+ month 4))
+                     (if (<  7 month) (- month  7) (+ month 5))))
+              (let ((m1 displayed-month)
+                    (y1 displayed-year)
+                    (m2 displayed-month)
+                    (y2 displayed-year)
+                    (year))
+                (increment-calendar-month m1 y1 -1)
+                (increment-calendar-month m2 y2 1)
+                (let* ((start-date (calendar-absolute-from-gregorian
+                                    (list m1 1 y1)))
+                       (end-date (calendar-absolute-from-gregorian
+                                  (list m2
+                                        (calendar-last-day-of-month m2 y2)
+                                        y2)))
+                       (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)))
+                  (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
+                  (let ((date (calendar-gregorian-from-absolute
+                               (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)))))))))
+

 (defun mark-hebrew-diary-entries ()
   "Mark days in the calendar window that have Hebrew date diary entries.
 Each entry in diary-file (or included files) visible in the calendar window
 (defun mark-hebrew-diary-entries ()
   "Mark days in the calendar window that have Hebrew date diary entries.
 Each entry in diary-file (or included files) visible in the calendar window


@@ -593,11 +684,12 @@ is provided for use as part of the nongregorian-diary-marking-hook."
           ((date-form (if (equal (car (car d)) 'backup)
                           (cdr (car d))
                         (car d)));; ignore 'backup directive
           ((date-form (if (equal (car (car d)) 'backup)
                           (cdr (car d))
                         (car d)));; ignore 'backup directive

-           (dayname (diary-name-pattern calendar-day-name-array))
+           (dayname (diary-name-pattern calendar-day-name-array
+                                        calendar-day-abbrev-array))

            (monthname
            (monthname

-            (concat
-             (diary-name-pattern calendar-hebrew-month-name-array-leap-year t)
-             "\\|\\*"))
+            (format "%s\\|\\*"
+                    (diary-name-pattern
+                     calendar-hebrew-month-name-array-leap-year)))

            (month "[0-9]+\\|\\*")
            (day "[0-9]+\\|\\*")
            (year "[0-9]+\\|\\*")
            (month "[0-9]+\\|\\*")
            (day "[0-9]+\\|\\*")
            (year "[0-9]+\\|\\*")


@@ -632,13 +724,13 @@ is provided for use as part of the nongregorian-diary-marking-hook."
                       (buffer-substring
                        (match-beginning m-name-pos)
                        (match-end m-name-pos))))
                       (buffer-substring
                        (match-beginning m-name-pos)
                        (match-end m-name-pos))))

-                 (mm (string-to-int
+                 (mm (string-to-number

                       (if m-pos
                           (buffer-substring
                            (match-beginning m-pos)
                            (match-end m-pos))
                         "")))
                       (if m-pos
                           (buffer-substring
                            (match-beginning m-pos)
                            (match-end m-pos))
                         "")))

-                 (dd (string-to-int
+                 (dd (string-to-number

                       (if d-pos
                           (buffer-substring
                            (match-beginning d-pos)
                       (if d-pos
                           (buffer-substring
                            (match-beginning d-pos)


@@ -657,108 +749,31 @@ is provided for use as part of the nongregorian-diary-marking-hook."
                                     (calendar-hebrew-from-absolute
                                      (calendar-absolute-from-gregorian
                                       (calendar-current-date)))))
                                     (calendar-hebrew-from-absolute
                                      (calendar-absolute-from-gregorian
                                       (calendar-current-date)))))

-                                  (y (+ (string-to-int y-str)
+                                  (y (+ (string-to-number y-str)

                                         (* 100 (/ current-y 100)))))
                              (if (> (- y current-y) 50)
                                  (- y 100)
                                (if (> (- current-y y) 50)
                                    (+ y 100)
                                  y)))
                                         (* 100 (/ current-y 100)))))
                              (if (> (- y current-y) 50)
                                  (- y 100)
                                (if (> (- current-y y) 50)
                                    (+ y 100)
                                  y)))

-                         (string-to-int y-str)))))
+                         (string-to-number y-str)))))

             (if dd-name
                 (mark-calendar-days-named
             (if dd-name
                 (mark-calendar-days-named

-                 (cdr (assoc (capitalize (substring dd-name 0 3))
-                             (calendar-make-alist
-                               calendar-day-name-array
-                               0
-                              '(lambda (x) (substring x 0 3))))))
+                 (cdr (assoc-string dd-name
+                                         (calendar-make-alist
+                                          calendar-day-name-array
+                                          0 nil calendar-day-abbrev-array) t)))

               (if mm-name
               (if mm-name

-                  (if (string-equal mm-name "*")
-                      (setq mm 0)
-                    (setq
-                      mm
-                      (cdr 
-                        (assoc
-                          (capitalize mm-name)
+                  (setq mm
+                        (if (string-equal mm-name "*") 0
+                          (cdr
+                           (assoc-string
+                            mm-name

                             (calendar-make-alist
                             (calendar-make-alist

-                               calendar-hebrew-month-name-array-leap-year))))))
+                             calendar-hebrew-month-name-array-leap-year) t)))))

               (mark-hebrew-calendar-date-pattern mm dd yy)))))
       (setq d (cdr d)))))
 
               (mark-hebrew-calendar-date-pattern mm dd yy)))))
       (setq d (cdr d)))))
 

-(defun mark-hebrew-calendar-date-pattern (month day year)
-  "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
-A value of 0 in any position is a wildcard."
-  (save-excursion
-    (set-buffer calendar-buffer)
-    (if (and (/= 0 month) (/= 0 day))
-        (if (/= 0 year)
-            ;; Fully specified Hebrew date.
-            (let ((date (calendar-gregorian-from-absolute
-                         (calendar-absolute-from-hebrew
-                          (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.
-          (if (memq displayed-month;;  This test is only to speed things up a
-                    (list          ;;  bit; it works fine without the test too.
-                     (if (< 11 month) (- month 11) (+ month 1))
-                     (if (< 10 month) (- month 10) (+ month 2))
-                     (if (<  9 month) (- month  9) (+ month 3))
-                     (if (<  8 month) (- month  8) (+ month 4))
-                     (if (<  7 month) (- month  7) (+ month 5))))
-              (let ((m1 displayed-month)
-                    (y1 displayed-year)
-                    (m2 displayed-month)
-                    (y2 displayed-year)
-                    (year))
-                (increment-calendar-month m1 y1 -1)
-                (increment-calendar-month m2 y2 1)
-                (let* ((start-date (calendar-absolute-from-gregorian
-                                    (list m1 1 y1)))
-                       (end-date (calendar-absolute-from-gregorian
-                                  (list m2
-                                        (calendar-last-day-of-month m2 y2)
-                                        y2)))
-                       (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)))
-                  (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
-                  (let ((date (calendar-gregorian-from-absolute
-                               (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)))))))))
-

 (defun insert-hebrew-diary-entry (arg)
   "Insert a diary entry.
 For the Hebrew date corresponding to the date indicated by point.
 (defun insert-hebrew-diary-entry (arg)
   "Insert a diary entry.
 For the Hebrew date corresponding to the date indicated by point.


@@ -769,7 +784,7 @@ Prefix arg will make the entry nonmarking."
     (make-diary-entry
      (concat
       hebrew-diary-entry-symbol
     (make-diary-entry
      (concat
       hebrew-diary-entry-symbol

-      (calendar-date-string 
+      (calendar-date-string

        (calendar-hebrew-from-absolute
         (calendar-absolute-from-gregorian
          (calendar-cursor-to-date t)))
        (calendar-hebrew-from-absolute
         (calendar-absolute-from-gregorian
          (calendar-cursor-to-date t)))


@@ -788,7 +803,7 @@ Prefix arg will make the entry nonmarking."
     (make-diary-entry
      (concat
       hebrew-diary-entry-symbol
     (make-diary-entry
      (concat
       hebrew-diary-entry-symbol

-      (calendar-date-string 
+      (calendar-date-string

        (calendar-hebrew-from-absolute
         (calendar-absolute-from-gregorian
          (calendar-cursor-to-date t)))))
        (calendar-hebrew-from-absolute
         (calendar-absolute-from-gregorian
          (calendar-cursor-to-date t)))))


@@ -808,7 +823,7 @@ Prefix arg will make the entry nonmarking."
     (make-diary-entry
      (concat
       hebrew-diary-entry-symbol
     (make-diary-entry
      (concat
       hebrew-diary-entry-symbol

-      (calendar-date-string 
+      (calendar-date-string

        (calendar-hebrew-from-absolute
         (calendar-absolute-from-gregorian
          (calendar-cursor-to-date t)))))
        (calendar-hebrew-from-absolute
         (calendar-absolute-from-gregorian
          (calendar-cursor-to-date t)))))


@@ -830,14 +845,12 @@ from the cursor position."
                            (int-to-string (extract-calendar-year today))))
                     (month-array calendar-month-name-array)
                     (completion-ignore-case t)
                            (int-to-string (extract-calendar-year today))))
                     (month-array calendar-month-name-array)
                     (completion-ignore-case t)

-                    (month (cdr (assoc
-                                 (capitalize
-                                  (completing-read
-                                   "Month of death (name): "
-                                   (mapcar 'list (append month-array nil))
-                                   nil t))
-                                 (calendar-make-alist
-                                  month-array 1 'capitalize))))
+                    (month (cdr (assoc-string
+                                 (completing-read
+                                  "Month of death (name): "
+                                  (mapcar 'list (append month-array nil))
+                                  nil t)
+                                 (calendar-make-alist month-array 1) t)))

                     (last (calendar-last-day-of-month month year))
                     (day (calendar-read
                           (format "Day of death (1-%d): " last)
                     (last (calendar-last-day-of-month month year))
                     (day (calendar-read
                           (format "Day of death (1-%d): " last)


@@ -892,9 +905,12 @@ from the cursor position."
   "Hebrew calendar equivalent of date diary entry."
   (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
 
   "Hebrew calendar equivalent of date diary entry."
   (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
 

-(defun diary-omer ()
+(defun diary-omer (&optional mark)

   "Omer count diary entry.
   "Omer count diary entry.

-Entry applies if date is within 50 days after Passover."
+Entry applies if date is within 50 days after Passover.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."

   (let* ((passover
           (calendar-absolute-from-hebrew
            (list 1 15 (+ (extract-calendar-year date) 3760))))
   (let* ((passover
           (calendar-absolute-from-hebrew
            (list 1 15 (+ (extract-calendar-year date) 3760))))


@@ -902,30 +918,34 @@ Entry applies if date is within 50 days after Passover."
          (week (/ omer 7))
          (day (% omer 7)))
     (if (and (> omer 0) (< omer 50))
          (week (/ omer 7))
          (day (% omer 7)))
     (if (and (> omer 0) (< omer 50))

-        (format "Day %d%s of the omer (until sunset)"
-                omer
-                (if (zerop week)
-                    ""
-                  (format ", that is, %d week%s%s"
-                          week
-                          (if (= week 1) "" "s")
-                          (if (zerop day)
-                              ""
-                            (format " and %d day%s"
-                                    day (if (= day 1) "" "s")))))))))
-
-(defun diary-yahrzeit (death-month death-day death-year)
+        (cons mark
+             (format "Day %d%s of the omer (until sunset)"
+                     omer
+                     (if (zerop week)
+                         ""
+                       (format ", that is, %d week%s%s"
+                               week
+                               (if (= week 1) "" "s")
+                               (if (zerop day)
+                                   ""
+                                 (format " and %d day%s"
+                                         day (if (= day 1) "" "s"))))))))))
+
+(defun diary-yahrzeit (death-month death-day death-year &optional mark)

   "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
 Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
 to be the name of the person.  Date of death is on the *civil* calendar;
 although the date of death is specified by the civil calendar, the proper
 Hebrew calendar yahrzeit is determined.  If `european-calendar-style' is t, the
   "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
 Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
 to be the name of the person.  Date of death is on the *civil* calendar;
 although the date of death is specified by the civil calendar, the proper
 Hebrew calendar yahrzeit is determined.  If `european-calendar-style' is t, the

-order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR."
+order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."

   (let* ((h-date (calendar-hebrew-from-absolute
                   (calendar-absolute-from-gregorian
                    (if european-calendar-style
                        (list death-day death-month death-year)
   (let* ((h-date (calendar-hebrew-from-absolute
                   (calendar-absolute-from-gregorian
                    (if european-calendar-style
                        (list death-day death-month death-year)

-                   (list death-month death-day death-year)))))
+                    (list death-month death-day death-year)))))

          (h-month (extract-calendar-month h-date))
          (h-day (extract-calendar-day h-date))
          (h-year (extract-calendar-year h-date))
          (h-month (extract-calendar-month h-date))
          (h-day (extract-calendar-day h-date))
          (h-year (extract-calendar-year h-date))


@@ -934,18 +954,22 @@ order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR."
          (diff (- yr h-year))
          (y (hebrew-calendar-yahrzeit h-date yr)))
     (if (and (> diff 0) (or (= y d) (= y (1+ d))))
          (diff (- yr h-year))
          (y (hebrew-calendar-yahrzeit h-date yr)))
     (if (and (> diff 0) (or (= y d) (= y (1+ d))))

-        (format "Yahrzeit of %s%s: %d%s anniversary"
-                entry
-                (if (= y d) "" " (evening)")
-                diff
-                (cond ((= (% diff 10) 1) "st")
-                      ((= (% diff 10) 2) "nd")
-                      ((= (% diff 10) 3) "rd")
-                      (t "th"))))))
-
-(defun diary-rosh-hodesh ()
+        (cons mark
+             (format "Yahrzeit of %s%s: %d%s anniversary"
+                     entry
+                     (if (= y d) "" " (evening)")
+                     diff
+                     (cond ((= (% diff 10) 1) "st")
+                           ((= (% diff 10) 2) "nd")
+                           ((= (% diff 10) 3) "rd")
+                           (t "th")))))))
+
+(defun diary-rosh-hodesh (&optional mark)

   "Rosh Hodesh diary entry.
   "Rosh Hodesh diary entry.

-Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
+Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."

   (let* ((d (calendar-absolute-from-gregorian date))
          (h-date (calendar-hebrew-from-absolute d))
          (h-month (extract-calendar-month h-date))
   (let* ((d (calendar-absolute-from-gregorian date))
          (h-date (calendar-hebrew-from-absolute d))
          (h-month (extract-calendar-month h-date))


@@ -961,47 +985,73 @@ Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
          (h-yesterday (extract-calendar-day
                        (calendar-hebrew-from-absolute (1- d)))))
     (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
          (h-yesterday (extract-calendar-day
                        (calendar-hebrew-from-absolute (1- d)))))
     (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))

-        (format
-         "Rosh Hodesh %s"
-         (if (= h-day 30)
-             (format
-              "%s (first day)"
-              ;; next month must be in the same year since this
-              ;; month can't be the last month of the year since
-              ;; it has 30 days
-              (aref h-month-names h-month))
-           (if (= h-yesterday 30)
-               (format "%s (second day)" this-month)
-             this-month)))
-      (if (= (% d 7) 6);; Saturday--check for Shabbat Mevarhim
-          (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
-                 (format "Mevarhim Rosh Hodesh %s (%s)"
-                         (aref h-month-names
-                               (if (= h-month
-                                      (hebrew-calendar-last-month-of-year
-                                       h-year))
-                                   0 h-month))
-                         (aref calendar-day-name-array (- 29 h-day))))
-                ((and (< h-day 30) (> h-day 22) (= 30 last-day))
-                 (format "Mevarhim Rosh Hodesh %s (%s-%s)"
-                         (aref h-month-names h-month)
-                         (if (= h-day 29)
-                             "tomorrow"
-                           (aref calendar-day-name-array (- 29 h-day)))
-                         (aref calendar-day-name-array
-                               (% (- 30 h-day) 7)))))
+        (cons mark
+             (format
+              "Rosh Hodesh %s"
+              (if (= h-day 30)
+                  (format
+                   "%s (first day)"
+                   ;; next month must be in the same year since this
+                   ;; month can't be the last month of the year since
+                   ;; it has 30 days
+                   (aref h-month-names h-month))
+                (if (= h-yesterday 30)
+                    (format "%s (second day)" this-month)
+                  this-month))))
+      (if (= (% d 7) 6)        ;; Saturday--check for Shabbat Mevarchim
+          (cons mark
+               (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
+                      (format "Mevarchim Rosh Hodesh %s (%s)"
+                              (aref h-month-names
+                                    (if (= h-month
+                                           (hebrew-calendar-last-month-of-year
+                                            h-year))
+                                        0 h-month))
+                              (aref calendar-day-name-array (- 29 h-day))))
+                     ((and (< h-day 30) (> h-day 22) (= 30 last-day))
+                      (format "Mevarchim Rosh Hodesh %s (%s-%s)"
+                              (aref h-month-names h-month)
+                              (if (= h-day 29)
+                                  "tomorrow"
+                                (aref calendar-day-name-array (- 29 h-day)))
+                              (aref calendar-day-name-array
+                                    (% (- 30 h-day) 7))))))

         (if (and (= h-day 29) (/= h-month 6))
         (if (and (= h-day 29) (/= h-month 6))

-            (format "Erev Rosh Hodesh %s"
-                    (aref h-month-names
-                          (if (= h-month
-                                 (hebrew-calendar-last-month-of-year
-                                  h-year))
-                              0 h-month))))))))
-
-(defun diary-parasha ()
-  "Parasha diary entry--entry applies if date is a Saturday."
+            (cons mark
+                 (format "Erev Rosh Hodesh %s"
+                         (aref h-month-names
+                               (if (= h-month
+                                      (hebrew-calendar-last-month-of-year
+                                       h-year))
+                                   0 h-month)))))))))
+
+(defvar hebrew-calendar-parashiot-names
+["Bereshith"   "Noah"      "Lech L'cha" "Vayera"    "Hayei Sarah" "Toledoth"
+ "Vayetze"     "Vayishlah" "Vayeshev"   "Mikketz"   "Vayiggash"   "Vayhi"
+ "Shemoth"     "Vaera"     "Bo"         "Beshallah" "Yithro"      "Mishpatim"
+ "Terumah"     "Tetzavveh" "Ki Tissa"   "Vayakhel"  "Pekudei"     "Vayikra"
+ "Tzav"        "Shemini"   "Tazria"     "Metzora"   "Aharei Moth" "Kedoshim"
+ "Emor"        "Behar"     "Behukkotai" "Bemidbar"  "Naso"       "Behaalot'cha"
+ "Shelah L'cha" "Korah"    "Hukkath"    "Balak"     "Pinhas"      "Mattoth"
+ "Masei"       "Devarim"   "Vaethanan"  "Ekev"      "Reeh"        "Shofetim"
+ "Ki Tetze"    "Ki Tavo"   "Nitzavim"   "Vayelech"  "Haazinu"]
+  "The names of the parashiot in the Torah.")
+
+(defun hebrew-calendar-parasha-name (p)
+  "Name(s) corresponding to parasha P."
+  (if (arrayp p);; combined parasha
+      (format "%s/%s"
+              (aref hebrew-calendar-parashiot-names (aref p 0))
+              (aref hebrew-calendar-parashiot-names (aref p 1)))
+    (aref hebrew-calendar-parashiot-names p)))
+
+(defun diary-parasha (&optional mark)
+  "Parasha diary entry--entry applies if date is a Saturday.
+
+An optional parameter MARK specifies a face or single-character string to
+use when highlighting the day in the calendar."

   (let ((d (calendar-absolute-from-gregorian date)))
   (let ((d (calendar-absolute-from-gregorian date)))

-    (if (= (% d 7) 6);;  Saturday
+    (if (= (% d 7) 6) ;;  Saturday

         (let*
             ((h-year (extract-calendar-year
                       (calendar-hebrew-from-absolute d)))
         (let*
             ((h-year (extract-calendar-year
                       (calendar-hebrew-from-absolute d)))


@@ -1020,36 +1070,25 @@ Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
                          (t "regular")))
              (year-format
               (symbol-value
                          (t "regular")))
              (year-format
               (symbol-value

-               (intern (format "hebrew-calendar-year-%s-%s-%s";; keviah
+               (intern (format "hebrew-calendar-year-%s-%s-%s" ;; keviah

                                rosh-hashanah-day type passover-day))))
                                rosh-hashanah-day type passover-day))))

-             (first-saturday;; of Hebrew year
+             (first-saturday ;; of Hebrew year

               (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah)))
               (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah)))

-             (saturday;; which Saturday of the Hebrew year
+             (saturday ;; which Saturday of the Hebrew year

               (/ (- d first-saturday) 7))
              (parasha (aref year-format saturday)))
           (if parasha
               (/ (- d first-saturday) 7))
              (parasha (aref year-format saturday)))
           (if parasha

-              (format
-               "Parashat %s"
-               (if (listp parasha);; Israel differs from diaspora
-                   (if (car parasha)
-                       (format "%s (diaspora), %s (Israel)"
-                               (hebrew-calendar-parasha-name (car parasha))
-                               (hebrew-calendar-parasha-name (cdr parasha)))
-                     (format "%s (Israel)"
-                             (hebrew-calendar-parasha-name (cdr parasha))))
-                 (hebrew-calendar-parasha-name parasha))))))))
-
-(defvar hebrew-calendar-parashiot-names
-["Bereshith"   "Noah"      "Lech L'cha" "Vayera"    "Hayei Sarah" "Toledoth"
- "Vayetze"     "Vayishlah" "Vayeshev"   "Mikketz"   "Vayiggash"   "Vayhi"
- "Shemoth"     "Vaera"     "Bo"         "Beshallah" "Yithro"      "Mishpatim"
- "Terumah"     "Tetzavveh" "Ki Tissa"   "Vayakhel"  "Pekudei"     "Vayikra"
- "Tzav"        "Shemini"   "Tazria"     "Metzora"   "Aharei Moth" "Kedoshim"
- "Emor"        "Behar"     "Behukkotai" "Bemidbar"  "Naso"       "Behaalot'cha"
- "Shelah L'cha" "Korah"    "Hukkath"    "Balak"     "Pinhas"      "Mattoth"
- "Masei"       "Devarim"   "Vaethanan"  "Ekev"      "Reeh"        "Shofetim"
- "Ki Tetze"    "Ki Tavo"   "Nitzavim"   "Vayelech"  "Haazinu"]
-  "The names of the parashiot in the Torah.")
+              (cons mark
+                   (format
+                    "Parashat %s"
+                    (if (listp parasha) ;; Israel differs from diaspora
+                        (if (car parasha)
+                            (format "%s (diaspora), %s (Israel)"
+                                    (hebrew-calendar-parasha-name (car parasha))
+                                    (hebrew-calendar-parasha-name (cdr parasha)))
+                          (format "%s (Israel)"
+                                  (hebrew-calendar-parasha-name (cdr parasha))))
+                      (hebrew-calendar-parasha-name parasha)))))))))

 
 ;; The seven ordinary year types (keviot)
 
 
 ;; The seven ordinary year types (keviot)
 


@@ -1170,14 +1209,7 @@ have 29 days), and has Passover start on Sunday.")
 Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
 have 30 days), and has Passover start on Tuesday.")
 
 Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
 have 30 days), and has Passover start on Tuesday.")
 

-(defun hebrew-calendar-parasha-name (p)
-  "Name(s) corresponding to parasha P."
-  (if (arrayp p);; combined parasha
-      (format "%s/%s"
-              (aref hebrew-calendar-parashiot-names (aref p 0))
-              (aref hebrew-calendar-parashiot-names (aref p 1)))
-    (aref hebrew-calendar-parashiot-names p)))
-

 (provide 'cal-hebrew)
 
 (provide 'cal-hebrew)
 

+;;; arch-tag: aaab6718-7712-42ac-a32d-28fe1f944f3c

 ;;; cal-hebrew.el ends here
 ;;; cal-hebrew.el ends here