1 files changed, 154 insertions, 151 deletions

diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index 29abaebb9b4..46d593bae64 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -1,6 +1,6 @@
 ;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
 
-;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc.
 
 ;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
 ;;      Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -41,29 +41,10 @@
 
 ;;; Code:
 
-(require 'calendar)
+(defvar displayed-month)
+(defvar displayed-year)
 
-(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."
@@ -75,15 +56,6 @@ Gregorian date Sunday, December 31, 1 BC."
       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
@@ -133,6 +105,15 @@ Gregorian date Sunday, December 31, 1 BC."
   "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)
@@ -156,13 +137,37 @@ Gregorian date Sunday, December 31, 1 BC."
     (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"
-   "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"
-   "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.
@@ -525,9 +530,9 @@ not be marked in the calendar.  This function is provided for use with the
                                  (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
@@ -573,7 +578,8 @@ not be marked in the calendar.  This function is provided for use with the
                         gdate
                         (buffer-substring-no-properties entry-start (point))
                         (buffer-substring-no-properties
-                         (1+ date-start) (1- entry-start)))))))
+                         (1+ date-start) (1- entry-start))
+                        (copy-marker entry-start))))))
                (setq d (cdr d))))
            (setq gdate
                  (calendar-gregorian-from-absolute
@@ -581,6 +587,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))))
 
+(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
@@ -598,11 +678,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
-           (dayname (diary-name-pattern calendar-day-name-array))
+           (dayname (diary-name-pattern calendar-day-name-array
+                                        calendar-day-abbrev-array))
            (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]+\\|\\*")
@@ -672,99 +753,21 @@ is provided for use as part of the nongregorian-diary-marking-hook."
                          (string-to-int y-str)))))
             (if dd-name
                 (mark-calendar-days-named
-                 (cdr (assoc-ignore-case
-                       (substring dd-name 0 3)
-                       (calendar-make-alist
-                        calendar-day-name-array
-                        0
-                        '(lambda (x) (substring x 0 3))))))
+                 (cdr (assoc-ignore-case dd-name
+                                         (calendar-make-alist
+                                          calendar-day-name-array
+                                          0 nil calendar-day-abbrev-array))))
               (if mm-name
-                  (if (string-equal mm-name "*")
-                      (setq mm 0)
-                    (setq
-                      mm
-                      (cdr
-                        (assoc-ignore-case
-                         mm-name
-                         (calendar-make-alist
-                          calendar-hebrew-month-name-array-leap-year))))))
+                  (setq mm
+                        (if (string-equal mm-name "*") 0
+                          (cdr
+                           (assoc-ignore-case
+                            mm-name
+                            (calendar-make-alist
+                             calendar-hebrew-month-name-array-leap-year))))))
               (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.
@@ -1016,6 +1019,26 @@ use when highlighting the day in the calendar."
                                         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.
 
@@ -1061,18 +1084,6 @@ use when highlighting the day in the calendar."
                                    (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.")
-
 ;; The seven ordinary year types (keviot)
 
 (defconst hebrew-calendar-year-Saturday-incomplete-Sunday
@@ -1192,14 +1203,6 @@ 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.")
 
-(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)
 
 ;;; cal-hebrew.el ends here