diff options
| author | Glenn Morris | 2011-02-28 19:38:41 -0800 |
|---|---|---|
| committer | Glenn Morris | 2011-02-28 19:38:41 -0800 |
| commit | 7454f2002dda2c585f19078c9ac54d7c24a4ac15 (patch) | |
| tree | d445f634df5a948529393250374a79c18f70975a | |
| parent | cdcbd5a79568a2255059c8804fc2073aa383767f (diff) | |
| download | emacs-7454f2002dda2c585f19078c9ac54d7c24a4ac15.tar.gz emacs-7454f2002dda2c585f19078c9ac54d7c24a4ac15.zip | |
Rework previous cal-hebrew change.
* lisp/calendar/cal-hebrew.el (calendar-hebrew-birthday, diary-hebrew-date):
Rename and rework functions added in previous change.
* etc/NEWS: Mention diary-hebrew-birthday.
| -rw-r--r-- | etc/NEWS | 2 | ||||
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/calendar/cal-hebrew.el | 85 |
3 files changed, 45 insertions, 47 deletions
| @@ -391,6 +391,8 @@ You can get a comparable behavior with: | |||
| 391 | 391 | ||
| 392 | ** Calendar, Diary, and Appt | 392 | ** Calendar, Diary, and Appt |
| 393 | 393 | ||
| 394 | *** New function `diary-hebrew-birthday'. | ||
| 395 | |||
| 394 | --- | 396 | --- |
| 395 | *** The obsolete (since Emacs 22.1) method of enabling the appt package | 397 | *** The obsolete (since Emacs 22.1) method of enabling the appt package |
| 396 | by adding appt-make-list to diary-hook has been removed. Use appt-activate. | 398 | by adding appt-make-list to diary-hook has been removed. Use appt-activate. |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 01509ef2a40..e841238524c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2011-03-01 Glenn Morris <rgm@gnu.org> | ||
| 2 | |||
| 3 | * calendar/cal-hebrew.el (calendar-hebrew-birthday, diary-hebrew-date): | ||
| 4 | Rename and rework functions added in previous change. | ||
| 5 | |||
| 1 | 2011-03-01 Ed Reingold <reingold@emr.cs.iit.edu> | 6 | 2011-03-01 Ed Reingold <reingold@emr.cs.iit.edu> |
| 2 | 7 | ||
| 3 | * calendar/cal-hebrew.el (hebrew-calendar-birthday) | 8 | * calendar/cal-hebrew.el (hebrew-calendar-birthday) |
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 8844dbadc9d..20b7d7cbc44 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el | |||
| @@ -792,22 +792,19 @@ from the cursor position." | |||
| 792 | (define-obsolete-function-alias 'list-yahrzeit-dates | 792 | (define-obsolete-function-alias 'list-yahrzeit-dates |
| 793 | 'calendar-hebrew-list-yahrzeits "23.1") | 793 | 'calendar-hebrew-list-yahrzeits "23.1") |
| 794 | 794 | ||
| 795 | (defun hebrew-calendar-birthday (birth-date year) | 795 | (defun calendar-hebrew-birthday (date year) |
| 796 | "Absolute date of the anniversary of Hebrew BIRTH-DATE in Hebrew YEAR." | 796 | "Absolute date of the anniversary of Hebrew birth DATE, in Hebrew YEAR." |
| 797 | (let* ((birth-day (extract-calendar-day birth-date)) | 797 | (let ((b-day (calendar-extract-day date)) |
| 798 | (birth-month (extract-calendar-month birth-date)) | 798 | (b-month (calendar-extract-month date)) |
| 799 | (birth-year (extract-calendar-year birth-date))) | 799 | (b-year (calendar-extract-year date))) |
| 800 | (if ; It's Adar in a normal Hebrew year or Adar II | 800 | ;; If it's Adar in a normal Hebrew year or Adar II in a Hebrew leap year... |
| 801 | ; in a Hebrew leap year, | 801 | (if (= b-month (calendar-hebrew-last-month-of-year b-year)) |
| 802 | (= birth-month (hebrew-calendar-last-month-of-year birth-year)) | 802 | ;; ...then use the same day in last month of Hebrew year. |
| 803 | ;; Then use the same day in last month of Hebrew year. | 803 | (calendar-hebrew-to-absolute |
| 804 | (calendar-absolute-from-hebrew | 804 | (list (calendar-hebrew-last-month-of-year year) b-day year)) |
| 805 | (list (hebrew-calendar-last-month-of-year year) birth-day year)) | ||
| 806 | ;; Else use the normal anniversary of the birth date, | 805 | ;; Else use the normal anniversary of the birth date, |
| 807 | ;; or the corresponding day in years without that date | 806 | ;; or the corresponding day in years without that date. |
| 808 | (+ (calendar-absolute-from-hebrew | 807 | (+ (calendar-hebrew-to-absolute (list b-month 1 year)) b-day -1)))) |
| 809 | (list birth-month 1 year)) | ||
| 810 | birth-day -1)))) | ||
| 811 | 808 | ||
| 812 | (defvar date) | 809 | (defvar date) |
| 813 | 810 | ||
| @@ -817,39 +814,35 @@ from the cursor position." | |||
| 817 | "Hebrew calendar equivalent of date diary entry." | 814 | "Hebrew calendar equivalent of date diary entry." |
| 818 | (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date))) | 815 | (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date))) |
| 819 | 816 | ||
| 820 | (defun diary-hebrew-birthday | 817 | (defvar entry) |
| 821 | (birth-month birth-day birth-year &optional after-sunset) | 818 | |
| 822 | "Hebrew birthday diary entry--entry applies if date is birthdate or the day | 819 | ;;;###diary-autoload |
| 823 | before. Parameters are BIRTH-MONTH, BIRTH-DAY, BIRTH-YEAR; the diary entry is | 820 | (defun diary-hebrew-birthday (month day year &optional after-sunset) |
| 824 | assumed to be the name of the person. Date of birth is on the *civil* | 821 | "Hebrew birthday diary entry. |
| 825 | calendar; although the date of birth is specified by the civil calendar, the | 822 | Entry applies if date is birthdate (MONTH DAY YEAR), or the day before. |
| 826 | proper Hebrew calendar birthday is determined. NOTE: If the birth occurred | 823 | The order of the input parameters changes according to |
| 827 | after local sunset on the given civil date, the following civil date | 824 | `calendar-date-style' (e.g. to DAY MONTH YEAR in the European style). |
| 828 | corresponds to the Hebrew birthday--the optional parameter AFTER-SUNSET does | 825 | |
| 829 | this correction when t. If `european-calendar-style' is t, the order of the | 826 | Assumes the associated diary entry is the name of the person. |
| 830 | parameters is changed to BIRTH-DAY, BIRTH-MONTH, BIRTH-YEAR." | 827 | |
| 828 | Although the date of birth is specified by the *civil* calendar, | ||
| 829 | this function determines the proper Hebrew calendar birthday. | ||
| 830 | If the optional argument AFTER-SUNSET is non-nil, this means the | ||
| 831 | birth occurred after local sunset on the given civil date. | ||
| 832 | In this case, the following civil date corresponds to the Hebrew birthday." | ||
| 831 | (let* ((h-date (calendar-hebrew-from-absolute | 833 | (let* ((h-date (calendar-hebrew-from-absolute |
| 832 | (+ (calendar-absolute-from-gregorian | 834 | (+ (calendar-absolute-from-gregorian |
| 833 | (if european-calendar-style | 835 | (diary-make-date month day year)) |
| 834 | (list birth-day birth-month birth-year) | ||
| 835 | (list birth-month birth-day birth-year))) | ||
| 836 | (if after-sunset 1 0)))) | 836 | (if after-sunset 1 0)))) |
| 837 | (h-month (extract-calendar-month h-date)) | 837 | (h-year (calendar-extract-year h-date)) ; birth-day |
| 838 | (h-day (extract-calendar-day h-date)) | 838 | (d (calendar-absolute-from-gregorian date)) ; today |
| 839 | (h-year (extract-calendar-year h-date)) | 839 | (h-yr (calendar-extract-year (calendar-hebrew-from-absolute d))) |
| 840 | (d (calendar-absolute-from-gregorian date)) | 840 | (age (- h-yr h-year)) ; current H year - birth H-year |
| 841 | (h-yr (extract-calendar-year (calendar-hebrew-from-absolute d))) | 841 | (b-date (calendar-hebrew-birthday h-date h-yr))) |
| 842 | (age (- h-yr h-year)) | 842 | (and (> age 0) (memq b-date (list d (1+ d))) |
| 843 | (b-date (hebrew-calendar-birthday h-date h-yr))) | 843 | (format "%s's %d%s Hebrew birthday%s" entry age |
| 844 | (if (and (> age 0) (or (= b-date d) (= b-date (1+ d)))) | 844 | (diary-ordinal-suffix age) |
| 845 | (format "%s's %d%s Hebrew birthday%s" | 845 | (if (= b-date d) "" " (evening)"))))) |
| 846 | entry | ||
| 847 | age | ||
| 848 | (cond ((= (% age 10) 1) "st") | ||
| 849 | ((= (% age 10) 2) "nd") | ||
| 850 | ((= (% age 10) 3) "rd") | ||
| 851 | (t "th")) | ||
| 852 | (if (= b-date d) "" " (evening)"))))) | ||
| 853 | 846 | ||
| 854 | ;;;###diary-autoload | 847 | ;;;###diary-autoload |
| 855 | (defun diary-hebrew-omer (&optional mark) | 848 | (defun diary-hebrew-omer (&optional mark) |
| @@ -880,8 +873,6 @@ use when highlighting the day in the calendar." | |||
| 880 | ;;;###diary-autoload | 873 | ;;;###diary-autoload |
| 881 | (define-obsolete-function-alias 'diary-omer 'diary-hebrew-omer "23.1") | 874 | (define-obsolete-function-alias 'diary-omer 'diary-hebrew-omer "23.1") |
| 882 | 875 | ||
| 883 | (defvar entry) | ||
| 884 | |||
| 885 | (autoload 'diary-make-date "diary-lib") | 876 | (autoload 'diary-make-date "diary-lib") |
| 886 | 877 | ||
| 887 | (declare-function diary-ordinal-suffix "diary-lib" (n)) | 878 | (declare-function diary-ordinal-suffix "diary-lib" (n)) |