Merge from trunk.

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

diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index 260a6bd757aa48465acd8b54bc9bff69a14a3e06..52bf442915f3311d805fe433080b622f836e7641 100644 (file)
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -1,13 +1,13 @@
 ;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
 
 ;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
 

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

 
 ;; 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
 
 ;; 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

+;; Package: calendar

 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 


@@ -375,7 +375,7 @@ or ALL is non-nil."
            (list (calendar-gregorian-from-absolute (1+ abs-r-h))
                  "Rosh HaShanah (second day)")
            (list (calendar-gregorian-from-absolute
            (list (calendar-gregorian-from-absolute (1+ abs-r-h))
                  "Rosh HaShanah (second day)")
            (list (calendar-gregorian-from-absolute

-                  (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2)))
+                  (+ abs-r-h (if (= (% abs-r-h 7) 4) 3 2)))

                  "Tzom Gedaliah")
            (list (calendar-gregorian-from-absolute
                   (calendar-dayname-on-or-before 6 (+ 7 abs-r-h)))
                  "Tzom Gedaliah")
            (list (calendar-gregorian-from-absolute
                   (calendar-dayname-on-or-before 6 (+ 7 abs-r-h)))


@@ -453,68 +453,71 @@ or ALL is non-nil."
          (list (calendar-gregorian-from-absolute (+ abs-p 50))
                     "Shavuot"))
         (when (or all calendar-hebrew-all-holidays-flag)
          (list (calendar-gregorian-from-absolute (+ abs-p 50))
                     "Shavuot"))
         (when (or all calendar-hebrew-all-holidays-flag)

-          (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 30)))
-                 "Shabbat Zachor")
-           (list (calendar-gregorian-from-absolute
-                  (if (= (% abs-p 7) 2) (- abs-p 33) (- abs-p 31)))
-                 "Fast of Esther")
-           (list (calendar-gregorian-from-absolute (- abs-p 31))
-                 "Erev Purim")
-           (list (calendar-gregorian-from-absolute (- abs-p 30))
-                 "Purim")
-           (list (calendar-gregorian-from-absolute
-                  (if (zerop (% abs-p 7)) (- abs-p 28) (- abs-p 29)))
-                 "Shushan Purim")
-           (list (calendar-gregorian-from-absolute
-                  (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7))
-                 "Shabbat Parah")
-           (list (calendar-gregorian-from-absolute
-                  (calendar-dayname-on-or-before 6 (- abs-p 14)))
-                 "Shabbat HaHodesh")
-           (list (calendar-gregorian-from-absolute
-                  (calendar-dayname-on-or-before 6 (1- abs-p)))
-                 "Shabbat HaGadol")
-           (list (calendar-gregorian-from-absolute (1- abs-p))
-                 "Erev Passover")
-           (list (calendar-gregorian-from-absolute (1+ abs-p))
-                 "Passover (second day)")
-           (list (calendar-gregorian-from-absolute (+ abs-p 2))
-                 "Hol Hamoed Passover (first day)")
-           (list (calendar-gregorian-from-absolute (+ abs-p 3))
-                 "Hol Hamoed Passover (second day)")
-           (list (calendar-gregorian-from-absolute (+ abs-p 4))
-                 "Hol Hamoed Passover (third day)")
-           (list (calendar-gregorian-from-absolute (+ abs-p 5))
-                 "Hol Hamoed Passover (fourth day)")
-           (list (calendar-gregorian-from-absolute (+ abs-p 6))
-                 "Passover (seventh day)")
-           (list (calendar-gregorian-from-absolute (+ abs-p 7))
-                 "Passover (eighth day)")
-           (list (calendar-gregorian-from-absolute
-                  (if (zerop (% (+ abs-p 12) 7))
-                      (+ abs-p 13)
-                    (+ abs-p 12)))
-                 "Yom HaShoah")
-           (list (calendar-gregorian-from-absolute
-                  (if (zerop (% abs-p 7))
-                      (+ abs-p 18)
-                    (if (= (% abs-p 7) 6)
-                        (+ abs-p 19)
-                      (+ abs-p 20))))
-                 "Yom HaAtzma'ut")
-           (list (calendar-gregorian-from-absolute (+ abs-p 33))
-                 "Lag BaOmer")
-           (list (calendar-gregorian-from-absolute (+ abs-p 43))
-                 "Yom Yerushalaim")
-           (list (calendar-gregorian-from-absolute (+ abs-p 49))
-                 "Erev Shavuot")
-           (list (calendar-gregorian-from-absolute (+ abs-p 51))
-                 "Shavuot (second day)"))))))))
+          (let ((wday (% abs-p 7)))
+            (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 30)))
+                   "Shabbat Zachor")
+             (list (calendar-gregorian-from-absolute
+                    (- abs-p (if (= wday 2) 33 31)))
+                   "Fast of Esther")
+             (list (calendar-gregorian-from-absolute (- abs-p 31))
+                   "Erev Purim")
+             (list (calendar-gregorian-from-absolute (- abs-p 30))
+                   "Purim")
+             (list (calendar-gregorian-from-absolute
+                    (- abs-p (if (zerop wday) 28 29)))
+                   "Shushan Purim")
+             (list (calendar-gregorian-from-absolute
+                    (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7))
+                   "Shabbat Parah")
+             (list (calendar-gregorian-from-absolute
+                    (calendar-dayname-on-or-before 6 (- abs-p 14)))
+                   "Shabbat HaHodesh")
+             (list (calendar-gregorian-from-absolute
+                    (calendar-dayname-on-or-before 6 (1- abs-p)))
+                   "Shabbat HaGadol")
+             (list (calendar-gregorian-from-absolute (1- abs-p))
+                   "Erev Passover")
+             (list (calendar-gregorian-from-absolute (1+ abs-p))
+                   "Passover (second day)")
+             (list (calendar-gregorian-from-absolute (+ abs-p 2))
+                   "Hol Hamoed Passover (first day)")
+             (list (calendar-gregorian-from-absolute (+ abs-p 3))
+                   "Hol Hamoed Passover (second day)")
+             (list (calendar-gregorian-from-absolute (+ abs-p 4))
+                   "Hol Hamoed Passover (third day)")
+             (list (calendar-gregorian-from-absolute (+ abs-p 5))
+                   "Hol Hamoed Passover (fourth day)")
+             (list (calendar-gregorian-from-absolute (+ abs-p 6))
+                   "Passover (seventh day)")
+             (list (calendar-gregorian-from-absolute (+ abs-p 7))
+                   "Passover (eighth day)")
+             (list (calendar-gregorian-from-absolute
+                    (+ abs-p (if (zerop (% (+ abs-p 12) 7))
+                                 13
+                               12)))
+                   "Yom HaShoah")
+             (list (calendar-gregorian-from-absolute
+                    (+ abs-p
+                       ;; If falls on Sat or Fri, moves to preceding Thurs.
+                       ;; If falls on Mon, moves to Tues (since 2004).
+                       (cond ((zerop wday) 18) ; Sat
+                             ((= wday 6) 19)   ; Fri
+                             ((= wday 2) 21)   ; Mon
+                             (t 20))))
+                   "Yom HaAtzma'ut")
+             (list (calendar-gregorian-from-absolute (+ abs-p 33))
+                   "Lag BaOmer")
+             (list (calendar-gregorian-from-absolute (+ abs-p 43))
+                   "Yom Yerushalaim")
+             (list (calendar-gregorian-from-absolute (+ abs-p 49))
+                   "Erev Shavuot")
+             (list (calendar-gregorian-from-absolute (+ abs-p 51))
+                   "Shavuot (second day)")))))))))

 
 ;;;###holiday-autoload
 (define-obsolete-function-alias 'holiday-passover-etc
 
 ;;;###holiday-autoload
 (define-obsolete-function-alias 'holiday-passover-etc


@@ -524,18 +527,19 @@ or ALL is non-nil."
 (defun holiday-hebrew-tisha-b-av ()
   "List of dates around Tisha B'Av, as visible in calendar window."
   (when (memq displayed-month '(5 6 7 8 9))
 (defun holiday-hebrew-tisha-b-av ()
   "List of dates around Tisha B'Av, as visible in calendar window."
   (when (memq displayed-month '(5 6 7 8 9))

-    (let ((abs-t-a (calendar-hebrew-to-absolute
-                    (list 5 9 (+ displayed-year 3760)))))
+    (let* ((abs-t-a (calendar-hebrew-to-absolute
+                     (list 5 9 (+ displayed-year 3760))))
+           (wday (% abs-t-a 7)))

       (holiday-filter-visible-calendar
        (list
         (list (calendar-gregorian-from-absolute
       (holiday-filter-visible-calendar
        (list
         (list (calendar-gregorian-from-absolute

-               (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))
+               (- abs-t-a (if (= wday 6) 20 21)))

               "Tzom Tammuz")
         (list (calendar-gregorian-from-absolute
                (calendar-dayname-on-or-before 6 abs-t-a))
               "Shabbat Hazon")
         (list (calendar-gregorian-from-absolute
               "Tzom Tammuz")
         (list (calendar-gregorian-from-absolute
                (calendar-dayname-on-or-before 6 abs-t-a))
               "Shabbat Hazon")
         (list (calendar-gregorian-from-absolute

-               (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a))
+               (if (= wday 6) (1+ abs-t-a) abs-t-a))

               "Tisha B'Av")
         (list (calendar-gregorian-from-absolute
                (calendar-dayname-on-or-before 6 (+ abs-t-a 7)))
               "Tisha B'Av")
         (list (calendar-gregorian-from-absolute
                (calendar-dayname-on-or-before 6 (+ abs-t-a 7)))


@@ -554,7 +558,7 @@ Includes: Tal Umatar, Tzom Teveth, Tu B'Shevat, Shabbat Shirah, and
 Kiddush HaHamah."
   (let ((m displayed-month)
         (y displayed-year)
 Kiddush HaHamah."
   (let ((m displayed-month)
         (y displayed-year)

-        year h-year s-s)
+        year h-year)

     (append
      (holiday-julian
       11
     (append
      (holiday-julian
       11


@@ -588,20 +592,17 @@ Kiddush HaHamah."
                        (calendar-extract-year
                         (calendar-hebrew-from-absolute
                          (calendar-absolute-from-gregorian
                        (calendar-extract-year
                         (calendar-hebrew-from-absolute
                          (calendar-absolute-from-gregorian

-                          (list m (calendar-last-day-of-month m y) y)))))
-              s-s
-              (calendar-hebrew-from-absolute
-               (if (= 6
-                      (% (calendar-hebrew-to-absolute
-                          (list 7 1 h-year))
-                         7))
-                   (calendar-dayname-on-or-before
-                    6 (calendar-hebrew-to-absolute
-                       (list 11 17 h-year)))
-                 (calendar-dayname-on-or-before
-                  6 (calendar-hebrew-to-absolute
-                     (list 11 16 h-year))))))
-        (calendar-extract-day s-s))
+                          (list m (calendar-last-day-of-month m y) y))))))
+        (calendar-extract-day
+         (calendar-hebrew-from-absolute
+          (calendar-dayname-on-or-before
+           6 (calendar-hebrew-to-absolute
+              (list 11
+                    (if (= 6
+                           (% (calendar-hebrew-to-absolute
+                               (list 7 1 h-year))
+                              7))
+                        17 16) h-year))))))

       "Shabbat Shirah")
      (and (progn
             (setq m displayed-month
       "Shabbat Shirah")
      (and (progn
             (setq m displayed-month


@@ -646,8 +647,7 @@ A value of 0 in any position is a wildcard.  Optional argument COLOR is
 passed to `calendar-mark-visible-date' as MARK."
   ;; FIXME not the same as the Bahai and Islamic cases, so can't use
   ;; calendar-mark-1.
 passed to `calendar-mark-visible-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)
+  (with-current-buffer calendar-buffer

     (if (and (not (zerop month)) (not (zerop day)))
         (if (not (zerop year))
             ;; Fully specified Hebrew date.
     (if (and (not (zerop month)) (not (zerop day)))
         (if (not (zerop year))
             ;; Fully specified Hebrew date.


@@ -764,8 +764,6 @@ from the cursor position."
   (message "Computing Yahrzeits...")
   (let* ((h-date (calendar-hebrew-from-absolute
                   (calendar-absolute-from-gregorian death-date)))
   (message "Computing Yahrzeits...")
   (let* ((h-date (calendar-hebrew-from-absolute
                   (calendar-absolute-from-gregorian death-date)))

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

          (h-year (calendar-extract-year h-date))
          (i (1- start-year)))
     (calendar-in-read-only-buffer calendar-hebrew-yahrzeit-buffer
          (h-year (calendar-extract-year h-date))
          (i (1- start-year)))
     (calendar-in-read-only-buffer calendar-hebrew-yahrzeit-buffer


@@ -792,6 +790,20 @@ from the cursor position."
 (define-obsolete-function-alias 'list-yahrzeit-dates
   'calendar-hebrew-list-yahrzeits "23.1")
 
 (define-obsolete-function-alias 'list-yahrzeit-dates
   'calendar-hebrew-list-yahrzeits "23.1")
 

+(defun calendar-hebrew-birthday (date year)
+  "Absolute date of the anniversary of Hebrew birth DATE, in Hebrew YEAR."
+  (let ((b-day (calendar-extract-day date))
+        (b-month (calendar-extract-month date))
+        (b-year (calendar-extract-year date)))
+    ;; If it's Adar in a normal Hebrew year or Adar II in a Hebrew leap year...
+    (if (= b-month (calendar-hebrew-last-month-of-year b-year))
+        ;; ...then use the same day in last month of Hebrew year.
+        (calendar-hebrew-to-absolute
+         (list (calendar-hebrew-last-month-of-year year) b-day year))
+      ;; Else use the normal anniversary of the birth date,
+      ;; or the corresponding day in years without that date.
+      (+ (calendar-hebrew-to-absolute (list b-month 1 year)) b-day -1))))
+

 (defvar date)
 
 ;; To be called from diary-list-sexp-entries, where DATE is bound.
 (defvar date)
 
 ;; To be called from diary-list-sexp-entries, where DATE is bound.


@@ -800,6 +812,37 @@ 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)))
 

+(defvar entry)
+(declare-function diary-ordinal-suffix "diary-lib" (n))
+
+;;;###diary-autoload
+(defun diary-hebrew-birthday (month day year &optional after-sunset)
+  "Hebrew birthday diary entry.
+Entry applies if date is birthdate (MONTH DAY YEAR), or the day before.
+The order of the input parameters changes according to
+`calendar-date-style' (e.g. to DAY MONTH YEAR in the European style).
+
+Assumes the associated diary entry is the name of the person.
+
+Although the date of birth is specified by the *civil* calendar,
+this function determines the proper Hebrew calendar birthday.
+If the optional argument AFTER-SUNSET is non-nil, this means the
+birth occurred after local sunset on the given civil date.
+In this case, the following civil date corresponds to the Hebrew birthday."
+  (let* ((h-date (calendar-hebrew-from-absolute
+                  (+ (calendar-absolute-from-gregorian
+                      (diary-make-date month day year))
+                     (if after-sunset 1 0))))
+         (h-year (calendar-extract-year h-date))     ; birth-day
+         (d (calendar-absolute-from-gregorian date)) ; today
+         (h-yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
+         (age (- h-yr h-year))          ; current H year - birth H-year
+         (b-date (calendar-hebrew-birthday h-date h-yr)))
+    (and (> age 0) (memq b-date (list d (1+ d)))
+         (format "%s's %d%s Hebrew birthday%s" entry age
+                 (diary-ordinal-suffix age)
+                 (if (= b-date d) "" " (evening)")))))
+

 ;;;###diary-autoload
 (defun diary-hebrew-omer (&optional mark)
   "Omer count diary entry.
 ;;;###diary-autoload
 (defun diary-hebrew-omer (&optional mark)
   "Omer count diary entry.


@@ -829,28 +872,32 @@ use when highlighting the day in the calendar."
 ;;;###diary-autoload
 (define-obsolete-function-alias 'diary-omer 'diary-hebrew-omer "23.1")
 
 ;;;###diary-autoload
 (define-obsolete-function-alias 'diary-omer 'diary-hebrew-omer "23.1")
 

-(defvar entry)
-

 (autoload 'diary-make-date "diary-lib")
 
 (autoload 'diary-make-date "diary-lib")
 

+(declare-function diary-ordinal-suffix "diary-lib" (n))
+

 ;;;###diary-autoload
 ;;;###diary-autoload

-(defun diary-hebrew-yahrzeit (death-month death-day death-year &optional mark)
+(defun diary-hebrew-yahrzeit (death-month death-day death-year
+                                          &optional mark after-sunset)

   "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.  Although the date
 of death is specified by the civil calendar, the proper Hebrew
 calendar Yahrzeit is determined.
 
   "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.  Although the date
 of death is specified by the civil calendar, the proper Hebrew
 calendar Yahrzeit is determined.
 

+If the death occurred after local sunset on the given civil date,
+the following civil date corresponds to the Hebrew date of
+death--set the optional parameter AFTER-SUNSET non-nil in this case.
+

 The order of the input parameters changes according to `calendar-date-style'
 \(e.g. to DEATH-DAY, DEATH-MONTH, DEATH-YEAR in the European style).
 
 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
 The order of the input parameters changes according to `calendar-date-style'
 \(e.g. to DEATH-DAY, DEATH-MONTH, DEATH-YEAR in the European style).
 
 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
-                   (diary-make-date death-month death-day death-year))))
-         (h-month (calendar-extract-month h-date))
-         (h-day (calendar-extract-day h-date))
+                  (+ (calendar-absolute-from-gregorian
+                      (diary-make-date death-month death-day death-year))
+                     (if after-sunset 1 0))))

          (h-year (calendar-extract-year h-date))
          (d (calendar-absolute-from-gregorian date))
          (yr (calendar-extract-year (calendar-hebrew-from-absolute d)))
          (h-year (calendar-extract-year h-date))
          (d (calendar-absolute-from-gregorian date))
          (yr (calendar-extract-year (calendar-hebrew-from-absolute d)))


@@ -903,16 +950,17 @@ use when highlighting the day in the calendar."
                      (format "%s (second day)" this-month)
                    this-month))))
       (if (= (% d 7) 6)        ; Saturday--check for Shabbat Mevarchim
                      (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))
+          (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
+                 (cons mark

                        (format "Mevarchim Rosh Hodesh %s (%s)"
                                (aref h-month-names
                                      (if (= h-month
                                             (calendar-hebrew-last-month-of-year
                                              h-year))
                                          0 h-month))
                        (format "Mevarchim Rosh Hodesh %s (%s)"
                                (aref h-month-names
                                      (if (= h-month
                                             (calendar-hebrew-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))
+                               (aref calendar-day-name-array (- 29 h-day)))))
+                ((and (< h-day 30) (> h-day 22) (= 30 last-day))
+                 (cons mark

                        (format "Mevarchim Rosh Hodesh %s (%s-%s)"
                                (aref h-month-names h-month)
                                (if (= h-day 29)
                        (format "Mevarchim Rosh Hodesh %s (%s-%s)"
                                (aref h-month-names h-month)
                                (if (= h-day 29)


@@ -1158,5 +1206,4 @@ use when highlighting the day in the calendar."
 
 (provide 'cal-hebrew)
 
 
 (provide 'cal-hebrew)
 

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

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