Add some new cal-hebrew functions.

* lisp/calendar/cal-hebrew.el (hebrew-calendar-birthday, diary-hebrew-birthday):
New functions.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2b42e0f24a12a384986b94b816d4509a6f78f4b8..01509ef2a4085b7c5ff0826749c240efbaef593a 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2011-03-01  Ed Reingold  <reingold@emr.cs.iit.edu>
+
+       * calendar/cal-hebrew.el (hebrew-calendar-birthday)
+       (diary-hebrew-birthday): New functions.
+
 2011-03-01  Glenn Morris  <rgm@gnu.org>
 
        * dired.el (dired-safe-switches-p): Beef it up.

diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index f2dfc3c51fe78b5900f9cc6f33589b899e6b8fa1..8844dbadc9d47cad7b39bc919fe81836eb11b3c7 100644 (file)
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -792,6 +792,23 @@ from the cursor position."
 (define-obsolete-function-alias 'list-yahrzeit-dates
   'calendar-hebrew-list-yahrzeits "23.1")
 
+(defun hebrew-calendar-birthday (birth-date year)
+  "Absolute date of the anniversary of Hebrew BIRTH-DATE in Hebrew YEAR."
+  (let* ((birth-day (extract-calendar-day birth-date))
+         (birth-month (extract-calendar-month birth-date))
+         (birth-year (extract-calendar-year birth-date)))
+    (if ; It's Adar in a normal Hebrew year or Adar II
+        ; in a Hebrew leap year,
+        (= birth-month (hebrew-calendar-last-month-of-year birth-year))
+        ;; Then use the same day in last month of Hebrew year.
+      (calendar-absolute-from-hebrew
+       (list (hebrew-calendar-last-month-of-year year) birth-day year))
+      ;; Else use the normal anniversary of the birth date,
+      ;; or the corresponding day in years without that date
+      (+ (calendar-absolute-from-hebrew
+          (list birth-month 1 year))
+         birth-day -1))))
+
 (defvar date)
 
 ;; To be called from diary-list-sexp-entries, where DATE is bound.
@@ -800,6 +817,40 @@ from the cursor position."
   "Hebrew calendar equivalent of date diary entry."
   (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
 
+(defun diary-hebrew-birthday
+  (birth-month birth-day birth-year &optional after-sunset)
+  "Hebrew birthday diary entry--entry applies if date is birthdate or the day
+before.  Parameters are BIRTH-MONTH, BIRTH-DAY, BIRTH-YEAR; the diary entry is
+assumed to be the name of the person.  Date of birth is on the *civil*
+calendar; although the date of birth is specified by the civil calendar, the
+proper Hebrew calendar birthday is determined.  NOTE: If the birth occurred
+after local sunset on the given civil date, the following civil date
+corresponds to the Hebrew birthday--the optional parameter AFTER-SUNSET does
+this correction when t.  If `european-calendar-style' is t, the order of the
+parameters is changed to BIRTH-DAY, BIRTH-MONTH, BIRTH-YEAR."
+  (let* ((h-date (calendar-hebrew-from-absolute
+                  (+ (calendar-absolute-from-gregorian
+                      (if european-calendar-style
+                          (list birth-day birth-month birth-year)
+                        (list birth-month birth-day birth-year)))
+                     (if after-sunset 1 0))))
+         (h-month (extract-calendar-month h-date))
+         (h-day (extract-calendar-day h-date))
+         (h-year (extract-calendar-year h-date))
+         (d (calendar-absolute-from-gregorian date))
+         (h-yr (extract-calendar-year (calendar-hebrew-from-absolute d)))
+         (age (- h-yr h-year))
+         (b-date (hebrew-calendar-birthday h-date h-yr)))
+    (if (and (> age 0) (or (= b-date d) (= b-date (1+ d))))
+        (format "%s's %d%s Hebrew birthday%s"
+                entry
+                age
+                (cond ((= (% age 10) 1) "st")
+                      ((= (% age 10) 2) "nd")
+                      ((= (% age 10) 3) "rd")
+                      (t "th"))
+                (if (= b-date d) "" " (evening)")))))
+
 ;;;###diary-autoload
 (defun diary-hebrew-omer (&optional mark)
   "Omer count diary entry.