diff options
| author | Ed Reingold | 2011-02-28 19:32:05 -0800 |
|---|---|---|
| committer | Glenn Morris | 2011-02-28 19:32:05 -0800 |
| commit | cdcbd5a79568a2255059c8804fc2073aa383767f (patch) | |
| tree | f6930b410693dcaf39e4e9d3e29287c0d201ff99 | |
| parent | 9903d828df3cf1ddfd21c880a0887079b16ec17e (diff) | |
| download | emacs-cdcbd5a79568a2255059c8804fc2073aa383767f.tar.gz emacs-cdcbd5a79568a2255059c8804fc2073aa383767f.zip | |
Add some new cal-hebrew functions.
* lisp/calendar/cal-hebrew.el (hebrew-calendar-birthday, diary-hebrew-birthday):
New functions.
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/calendar/cal-hebrew.el | 51 |
2 files changed, 56 insertions, 0 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2b42e0f24a1..01509ef2a40 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2011-03-01 Ed Reingold <reingold@emr.cs.iit.edu> | ||
| 2 | |||
| 3 | * calendar/cal-hebrew.el (hebrew-calendar-birthday) | ||
| 4 | (diary-hebrew-birthday): New functions. | ||
| 5 | |||
| 1 | 2011-03-01 Glenn Morris <rgm@gnu.org> | 6 | 2011-03-01 Glenn Morris <rgm@gnu.org> |
| 2 | 7 | ||
| 3 | * dired.el (dired-safe-switches-p): Beef it up. | 8 | * 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." | |||
| 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) | ||
| 796 | "Absolute date of the anniversary of Hebrew BIRTH-DATE in Hebrew YEAR." | ||
| 797 | (let* ((birth-day (extract-calendar-day birth-date)) | ||
| 798 | (birth-month (extract-calendar-month birth-date)) | ||
| 799 | (birth-year (extract-calendar-year birth-date))) | ||
| 800 | (if ; It's Adar in a normal Hebrew year or Adar II | ||
| 801 | ; in a Hebrew leap year, | ||
| 802 | (= birth-month (hebrew-calendar-last-month-of-year birth-year)) | ||
| 803 | ;; Then use the same day in last month of Hebrew year. | ||
| 804 | (calendar-absolute-from-hebrew | ||
| 805 | (list (hebrew-calendar-last-month-of-year year) birth-day year)) | ||
| 806 | ;; Else use the normal anniversary of the birth date, | ||
| 807 | ;; or the corresponding day in years without that date | ||
| 808 | (+ (calendar-absolute-from-hebrew | ||
| 809 | (list birth-month 1 year)) | ||
| 810 | birth-day -1)))) | ||
| 811 | |||
| 795 | (defvar date) | 812 | (defvar date) |
| 796 | 813 | ||
| 797 | ;; To be called from diary-list-sexp-entries, where DATE is bound. | 814 | ;; To be called from diary-list-sexp-entries, where DATE is bound. |
| @@ -800,6 +817,40 @@ from the cursor position." | |||
| 800 | "Hebrew calendar equivalent of date diary entry." | 817 | "Hebrew calendar equivalent of date diary entry." |
| 801 | (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date))) | 818 | (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date))) |
| 802 | 819 | ||
| 820 | (defun diary-hebrew-birthday | ||
| 821 | (birth-month birth-day birth-year &optional after-sunset) | ||
| 822 | "Hebrew birthday diary entry--entry applies if date is birthdate or the day | ||
| 823 | before. Parameters are BIRTH-MONTH, BIRTH-DAY, BIRTH-YEAR; the diary entry is | ||
| 824 | assumed to be the name of the person. Date of birth is on the *civil* | ||
| 825 | calendar; although the date of birth is specified by the civil calendar, the | ||
| 826 | proper Hebrew calendar birthday is determined. NOTE: If the birth occurred | ||
| 827 | after local sunset on the given civil date, the following civil date | ||
| 828 | corresponds to the Hebrew birthday--the optional parameter AFTER-SUNSET does | ||
| 829 | this correction when t. If `european-calendar-style' is t, the order of the | ||
| 830 | parameters is changed to BIRTH-DAY, BIRTH-MONTH, BIRTH-YEAR." | ||
| 831 | (let* ((h-date (calendar-hebrew-from-absolute | ||
| 832 | (+ (calendar-absolute-from-gregorian | ||
| 833 | (if european-calendar-style | ||
| 834 | (list birth-day birth-month birth-year) | ||
| 835 | (list birth-month birth-day birth-year))) | ||
| 836 | (if after-sunset 1 0)))) | ||
| 837 | (h-month (extract-calendar-month h-date)) | ||
| 838 | (h-day (extract-calendar-day h-date)) | ||
| 839 | (h-year (extract-calendar-year h-date)) | ||
| 840 | (d (calendar-absolute-from-gregorian date)) | ||
| 841 | (h-yr (extract-calendar-year (calendar-hebrew-from-absolute d))) | ||
| 842 | (age (- h-yr h-year)) | ||
| 843 | (b-date (hebrew-calendar-birthday h-date h-yr))) | ||
| 844 | (if (and (> age 0) (or (= b-date d) (= b-date (1+ d)))) | ||
| 845 | (format "%s's %d%s Hebrew birthday%s" | ||
| 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 | |||
| 803 | ;;;###diary-autoload | 854 | ;;;###diary-autoload |
| 804 | (defun diary-hebrew-omer (&optional mark) | 855 | (defun diary-hebrew-omer (&optional mark) |
| 805 | "Omer count diary entry. | 856 | "Omer count diary entry. |