From cdcbd5a79568a2255059c8804fc2073aa383767f Mon Sep 17 00:00:00 2001 From: Ed Reingold Date: Mon, 28 Feb 2011 19:32:05 -0800 Subject: [PATCH] Add some new cal-hebrew functions. * lisp/calendar/cal-hebrew.el (hebrew-calendar-birthday, diary-hebrew-birthday): New functions. --- lisp/ChangeLog | 5 ++++ lisp/calendar/cal-hebrew.el | 51 +++++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2b42e0f24a1..01509ef2a40 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-03-01 Ed Reingold + + * calendar/cal-hebrew.el (hebrew-calendar-birthday) + (diary-hebrew-birthday): New functions. + 2011-03-01 Glenn Morris * dired.el (dired-safe-switches-p): Beef it up. diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index f2dfc3c51fe..8844dbadc9d 100644 --- 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. -- 2.39.5