;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
-;; Copyright (C) 1995, 1997, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc.
;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
(interactive
(let* ((death-date
(if (equal (current-buffer) (get-buffer calendar-buffer))
- (calendar-cursor-to-date)
+ (calendar-cursor-to-date t)
(let* ((today (calendar-current-date))
(year (calendar-read
"Year of death (>0): "
(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
(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))
+(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-absolute-from-hebrew
- (list birth-month 1 year))
- birth-day -1))))
+ ;; or the corresponding day in years without that date.
+ (+ (calendar-hebrew-to-absolute (list b-month 1 year)) b-day -1))))
(defvar date)
"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."
+(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
- (if european-calendar-style
- (list birth-day birth-month birth-year)
- (list birth-month birth-day birth-year)))
+ (diary-make-date month day 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)")))))
+ (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)
;;;###diary-autoload
(define-obsolete-function-alias 'diary-omer 'diary-hebrew-omer "23.1")
-(defvar entry)
-
(autoload 'diary-make-date "diary-lib")
(declare-function diary-ordinal-suffix "diary-lib" (n))
;;;###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.
+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
- (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)))
(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))
- (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)
HCoop / bpt / emacs.git / blobdiff