Commit | Line | Data |
---|---|---|
3afbc435 | 1 | ;;; cal-hebrew.el --- calendar functions for the Hebrew calendar |
4b112ac4 | 2 | |
0d1bb2ff GM |
3 | ;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
4 | ;; 2008 Free Software Foundation, Inc. | |
4b112ac4 | 5 | |
85d0ba86 | 6 | ;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu> |
4b112ac4 | 7 | ;; Edward M. Reingold <reingold@cs.uiuc.edu> |
dbfca9c4 | 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
4b112ac4 ER |
9 | ;; Keywords: calendar |
10 | ;; Human-Keywords: Hebrew calendar, calendar, diary | |
11 | ||
12 | ;; This file is part of GNU Emacs. | |
13 | ||
14 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
15 | ;; it under the terms of the GNU General Public License as published by | |
075969b4 | 16 | ;; the Free Software Foundation; either version 3, or (at your option) |
4b112ac4 ER |
17 | ;; any later version. |
18 | ||
19 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 | ;; GNU General Public License for more details. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
b578f267 | 25 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
26 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
27 | ;; Boston, MA 02110-1301, USA. | |
4b112ac4 ER |
28 | |
29 | ;;; Commentary: | |
30 | ||
31 | ;; This collection of functions implements the features of calendar.el and | |
32 | ;; diary.el that deal with the Hebrew calendar. | |
33 | ||
a96a5fca | 34 | ;; Technical details of all the calendrical calculations can be found in |
fffaba77 PE |
35 | ;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold |
36 | ;; and Nachum Dershowitz, Cambridge University Press (2001). | |
a96a5fca | 37 | |
4b112ac4 ER |
38 | ;;; Code: |
39 | ||
da3fc020 | 40 | (require 'calendar) |
4b112ac4 ER |
41 | |
42 | (defun hebrew-calendar-leap-year-p (year) | |
6afe7cdd | 43 | "Non-nil if YEAR is a Hebrew calendar leap year." |
4b112ac4 ER |
44 | (< (% (1+ (* 7 year)) 19) 7)) |
45 | ||
46 | (defun hebrew-calendar-last-month-of-year (year) | |
47 | "The last month of the Hebrew calendar YEAR." | |
48 | (if (hebrew-calendar-leap-year-p year) | |
49 | 13 | |
50 | 12)) | |
51 | ||
4b112ac4 | 52 | (defun hebrew-calendar-elapsed-days (year) |
6afe7cdd | 53 | "Days from Sunday before start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR." |
4b112ac4 | 54 | (let* ((months-elapsed |
9c68082d GM |
55 | (+ (* 235 (/ (1- year) 19)) ; months in complete cycles so far |
56 | (* 12 (% (1- year) 19)) ; regular months in this cycle | |
57 | (/ (1+ (* 7 (% (1- year) 19))) 19))) ; leap months this cycle | |
4b112ac4 ER |
58 | (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080)))) |
59 | (hours-elapsed (+ 5 | |
60 | (* 12 months-elapsed) | |
61 | (* 793 (/ months-elapsed 1080)) | |
62 | (/ parts-elapsed 1080))) | |
71ea27ee | 63 | (parts ; conjunction parts |
4b112ac4 | 64 | (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080))) |
71ea27ee | 65 | (day ; conjunction day |
4b112ac4 ER |
66 | (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24))) |
67 | (alternative-day | |
9c68082d | 68 | (if (or (>= parts 19440) ; if the new moon is at or after midday |
71ea27ee | 69 | (and (= (% day 7) 2) ; ...or is on a Tuesday... |
9c68082d | 70 | (>= parts 9924) ; at 9 hours, 204 parts or later... |
71ea27ee | 71 | ;; of a common year... |
9c68082d | 72 | (not (hebrew-calendar-leap-year-p year))) |
71ea27ee | 73 | (and (= (% day 7) 1) ; ...or is on a Monday... |
9c68082d | 74 | (>= parts 16789) ; at 15 hours, 589 parts or later... |
71ea27ee | 75 | ;; at the end of a leap year. |
9c68082d | 76 | (hebrew-calendar-leap-year-p (1- year)))) |
71ea27ee | 77 | ;; Then postpone Rosh HaShanah one day. |
4b112ac4 | 78 | (1+ day) |
71ea27ee | 79 | ;; Else: |
4b112ac4 | 80 | day))) |
9c68082d GM |
81 | ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday |
82 | (if (memq (% alternative-day 7) (list 0 3 5)) | |
71ea27ee | 83 | ;; Then postpone it one (more) day and return. |
4b112ac4 | 84 | (1+ alternative-day) |
9c68082d | 85 | ;; Else return. |
4b112ac4 ER |
86 | alternative-day))) |
87 | ||
88 | (defun hebrew-calendar-days-in-year (year) | |
89 | "Number of days in Hebrew YEAR." | |
90 | (- (hebrew-calendar-elapsed-days (1+ year)) | |
91 | (hebrew-calendar-elapsed-days year))) | |
92 | ||
93 | (defun hebrew-calendar-long-heshvan-p (year) | |
6afe7cdd | 94 | "Non-nil if Heshvan is long in Hebrew YEAR." |
4b112ac4 ER |
95 | (= (% (hebrew-calendar-days-in-year year) 10) 5)) |
96 | ||
97 | (defun hebrew-calendar-short-kislev-p (year) | |
6afe7cdd | 98 | "Non-nil if Kislev is short in Hebrew YEAR." |
4b112ac4 ER |
99 | (= (% (hebrew-calendar-days-in-year year) 10) 3)) |
100 | ||
da3fc020 GM |
101 | (defun hebrew-calendar-last-day-of-month (month year) |
102 | "The last day of MONTH in YEAR." | |
103 | (if (or (memq month (list 2 4 6 10 13)) | |
104 | (and (= month 12) (not (hebrew-calendar-leap-year-p year))) | |
105 | (and (= month 8) (not (hebrew-calendar-long-heshvan-p year))) | |
106 | (and (= month 9) (hebrew-calendar-short-kislev-p year))) | |
107 | 29 | |
108 | 30)) | |
109 | ||
4b112ac4 ER |
110 | (defun calendar-absolute-from-hebrew (date) |
111 | "Absolute date of Hebrew DATE. | |
112 | The absolute date is the number of days elapsed since the (imaginary) | |
113 | Gregorian date Sunday, December 31, 1 BC." | |
28c02796 GM |
114 | (let ((month (extract-calendar-month date)) |
115 | (day (extract-calendar-day date)) | |
116 | (year (extract-calendar-year date))) | |
71ea27ee GM |
117 | (+ day ; days so far this month |
118 | (if (< month 7) ; before Tishri | |
119 | ;; Then add days in prior months this year before and after Nisan. | |
4b112ac4 ER |
120 | (+ (calendar-sum |
121 | m 7 (<= m (hebrew-calendar-last-month-of-year year)) | |
122 | (hebrew-calendar-last-day-of-month m year)) | |
123 | (calendar-sum | |
124 | m 1 (< m month) | |
125 | (hebrew-calendar-last-day-of-month m year))) | |
71ea27ee | 126 | ;; Else add days in prior months this year. |
4b112ac4 ER |
127 | (calendar-sum |
128 | m 7 (< m month) | |
129 | (hebrew-calendar-last-day-of-month m year))) | |
71ea27ee GM |
130 | (hebrew-calendar-elapsed-days year) ; days in prior years |
131 | -1373429))) ; days elapsed before absolute date 1 | |
4b112ac4 | 132 | |
da3fc020 GM |
133 | (defun calendar-hebrew-from-absolute (date) |
134 | "Compute the Hebrew date (month day year) corresponding to absolute DATE. | |
135 | The absolute date is the number of days elapsed since the (imaginary) | |
136 | Gregorian date Sunday, December 31, 1 BC." | |
137 | (let* ((greg-date (calendar-gregorian-from-absolute date)) | |
28c02796 | 138 | (year (+ 3760 (extract-calendar-year greg-date))) |
da3fc020 | 139 | (month (aref [9 10 11 12 1 2 3 4 7 7 7 8] |
71ea27ee | 140 | (1- (extract-calendar-month greg-date)))) |
28c02796 | 141 | day) |
da3fc020 | 142 | (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year)))) |
71ea27ee | 143 | (setq year (1+ year))) |
da3fc020 GM |
144 | (let ((length (hebrew-calendar-last-month-of-year year))) |
145 | (while (> date | |
146 | (calendar-absolute-from-hebrew | |
147 | (list month | |
148 | (hebrew-calendar-last-day-of-month month year) | |
149 | year))) | |
150 | (setq month (1+ (% month length))))) | |
151 | (setq day (1+ | |
152 | (- date (calendar-absolute-from-hebrew (list month 1 year))))) | |
153 | (list month day year))) | |
154 | ||
711d00e7 | 155 | (defconst calendar-hebrew-month-name-array-common-year |
4b112ac4 | 156 | ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" |
da3fc020 | 157 | "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"] |
71ea27ee | 158 | "Array of strings giving the names of the Hebrew months in a common year.") |
4b112ac4 | 159 | |
711d00e7 | 160 | (defconst calendar-hebrew-month-name-array-leap-year |
4b112ac4 | 161 | ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" |
da3fc020 | 162 | "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"] |
71ea27ee | 163 | "Array of strings giving the names of the Hebrew months in a leap year.") |
4b112ac4 | 164 | |
28b3c0f5 | 165 | ;;;###cal-autoload |
4b112ac4 ER |
166 | (defun calendar-hebrew-date-string (&optional date) |
167 | "String of Hebrew date before sunset of Gregorian DATE. | |
168 | Defaults to today's date if DATE is not given. | |
169 | Driven by the variable `calendar-date-display-form'." | |
170 | (let* ((hebrew-date (calendar-hebrew-from-absolute | |
171 | (calendar-absolute-from-gregorian | |
172 | (or date (calendar-current-date))))) | |
173 | (calendar-month-name-array | |
174 | (if (hebrew-calendar-leap-year-p (extract-calendar-year hebrew-date)) | |
175 | calendar-hebrew-month-name-array-leap-year | |
176 | calendar-hebrew-month-name-array-common-year))) | |
177 | (calendar-date-string hebrew-date nil t))) | |
178 | ||
28b3c0f5 | 179 | ;;;###cal-autoload |
4b112ac4 ER |
180 | (defun calendar-print-hebrew-date () |
181 | "Show the Hebrew calendar equivalent of the date under the cursor." | |
182 | (interactive) | |
183 | (message "Hebrew date (until sunset): %s" | |
184 | (calendar-hebrew-date-string (calendar-cursor-to-date t)))) | |
185 | ||
186 | (defun hebrew-calendar-yahrzeit (death-date year) | |
187 | "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR." | |
28c02796 GM |
188 | (let ((death-day (extract-calendar-day death-date)) |
189 | (death-month (extract-calendar-month death-date)) | |
190 | (death-year (extract-calendar-year death-date))) | |
4b112ac4 ER |
191 | (cond |
192 | ;; If it's Heshvan 30 it depends on the first anniversary; if | |
193 | ;; that was not Heshvan 30, use the day before Kislev 1. | |
194 | ((and (= death-month 8) | |
195 | (= death-day 30) | |
196 | (not (hebrew-calendar-long-heshvan-p (1+ death-year)))) | |
197 | (1- (calendar-absolute-from-hebrew (list 9 1 year)))) | |
9c68082d GM |
198 | ;; If it's Kislev 30 it depends on the first anniversary; if that |
199 | ;; was not Kislev 30, use the day before Teveth 1. | |
4b112ac4 ER |
200 | ((and (= death-month 9) |
201 | (= death-day 30) | |
202 | (hebrew-calendar-short-kislev-p (1+ death-year))) | |
203 | (1- (calendar-absolute-from-hebrew (list 10 1 year)))) | |
9c68082d GM |
204 | ;; If it's Adar II, use the same day in last month of year (Adar |
205 | ;; or Adar II). | |
4b112ac4 ER |
206 | ((= death-month 13) |
207 | (calendar-absolute-from-hebrew | |
208 | (list (hebrew-calendar-last-month-of-year year) death-day year))) | |
9c68082d GM |
209 | ;; If it's the 30th in Adar I and year is not a leap year (so |
210 | ;; Adar has only 29 days), use the last day in Shevat. | |
4b112ac4 ER |
211 | ((and (= death-day 30) |
212 | (= death-month 12) | |
213 | (not (hebrew-calendar-leap-year-p year))) | |
214 | (calendar-absolute-from-hebrew (list 11 30 year))) | |
215 | ;; In all other cases, use the normal anniversary of the date of death. | |
216 | (t (calendar-absolute-from-hebrew | |
217 | (list death-month death-day year)))))) | |
218 | ||
42281b7b GM |
219 | (defun calendar-hebrew-read-date () |
220 | "Interactively read the arguments for a Hebrew date command. | |
221 | Reads a year, month, and day." | |
28c02796 GM |
222 | (let* ((today (calendar-current-date)) |
223 | (year (calendar-read | |
224 | "Hebrew calendar year (>3760): " | |
225 | (lambda (x) (> x 3760)) | |
226 | (int-to-string | |
227 | (extract-calendar-year | |
228 | (calendar-hebrew-from-absolute | |
229 | (calendar-absolute-from-gregorian today)))))) | |
230 | (month-array (if (hebrew-calendar-leap-year-p year) | |
231 | calendar-hebrew-month-name-array-leap-year | |
232 | calendar-hebrew-month-name-array-common-year)) | |
233 | (completion-ignore-case t) | |
234 | (month (cdr (assoc-string | |
235 | (completing-read | |
236 | "Hebrew calendar month name: " | |
237 | (mapcar 'list (append month-array nil)) | |
238 | (if (= year 3761) | |
239 | (lambda (x) | |
240 | (let ((m (cdr | |
241 | (assoc-string | |
242 | (car x) | |
243 | (calendar-make-alist month-array) | |
244 | t)))) | |
245 | (< 0 | |
246 | (calendar-absolute-from-hebrew | |
247 | (list m | |
248 | (hebrew-calendar-last-day-of-month | |
249 | m year) | |
250 | year)))))) | |
251 | t) | |
252 | (calendar-make-alist month-array 1) t))) | |
253 | (last (hebrew-calendar-last-day-of-month month year)) | |
254 | (first (if (and (= year 3761) (= month 10)) | |
255 | 18 1)) | |
256 | (day (calendar-read | |
257 | (format "Hebrew calendar day (%d-%d): " | |
258 | first last) | |
259 | (lambda (x) (and (<= first x) (<= x last)))))) | |
260 | (list (list month day year)))) | |
261 | ||
28b3c0f5 | 262 | ;;;###cal-autoload |
4b112ac4 | 263 | (defun calendar-goto-hebrew-date (date &optional noecho) |
8f11970d | 264 | "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is non-nil." |
42281b7b | 265 | (interactive (calendar-hebrew-read-date)) |
4b112ac4 ER |
266 | (calendar-goto-date (calendar-gregorian-from-absolute |
267 | (calendar-absolute-from-hebrew date))) | |
268 | (or noecho (calendar-print-hebrew-date))) | |
269 | ||
8f11970d GM |
270 | (defvar displayed-month) ; from generate-calendar |
271 | (defvar displayed-year) | |
272 | ||
28b3c0f5 | 273 | ;;;###holiday-autoload |
4b112ac4 ER |
274 | (defun holiday-hebrew (month day string) |
275 | "Holiday on MONTH, DAY (Hebrew) called STRING. | |
276 | If MONTH, DAY (Hebrew) is visible, the value returned is corresponding | |
277 | Gregorian date in the form of the list (((month day year) STRING)). Returns | |
278 | nil if it is not visible in the current calendar window." | |
9c68082d GM |
279 | ;; This test is only to speed things up a bit; it works fine without it. |
280 | (if (memq displayed-month | |
281 | (list | |
4b112ac4 ER |
282 | (if (< 11 month) (- month 11) (+ month 1)) |
283 | (if (< 10 month) (- month 10) (+ month 2)) | |
284 | (if (< 9 month) (- month 9) (+ month 3)) | |
285 | (if (< 8 month) (- month 8) (+ month 4)) | |
286 | (if (< 7 month) (- month 7) (+ month 5)))) | |
2ed33c40 GM |
287 | (let* ((m1 displayed-month) |
288 | (y1 displayed-year) | |
289 | (m2 displayed-month) | |
290 | (y2 displayed-year) | |
291 | (start-date (progn | |
292 | (increment-calendar-month m1 y1 -1) | |
293 | (calendar-absolute-from-gregorian (list m1 1 y1)))) | |
294 | (end-date (progn | |
295 | (increment-calendar-month m2 y2 1) | |
296 | (calendar-absolute-from-gregorian | |
297 | (list m2 (calendar-last-day-of-month m2 y2) y2)))) | |
298 | (hebrew-start (calendar-hebrew-from-absolute start-date)) | |
299 | (hebrew-end (calendar-hebrew-from-absolute end-date)) | |
300 | (hebrew-y1 (extract-calendar-year hebrew-start)) | |
301 | (hebrew-y2 (extract-calendar-year hebrew-end)) | |
302 | (year (if (< 6 month) hebrew-y2 hebrew-y1)) | |
303 | (date (calendar-gregorian-from-absolute | |
304 | (calendar-absolute-from-hebrew (list month day year))))) | |
305 | (if (calendar-date-is-visible-p date) | |
306 | (list (list date string)))))) | |
4b112ac4 | 307 | |
e475d400 GM |
308 | ;; h-r-h-e should be called from holidays code. |
309 | (declare-function holiday-filter-visible-calendar "holidays" (l)) | |
310 | ||
28b3c0f5 | 311 | ;;;###holiday-autoload |
4b112ac4 ER |
312 | (defun holiday-rosh-hashanah-etc () |
313 | "List of dates related to Rosh Hashanah, as visible in calendar window." | |
28c02796 GM |
314 | (unless (or (< displayed-month 8) ; none of the dates is visible |
315 | (> displayed-month 11)) | |
4b112ac4 | 316 | (let* ((abs-r-h (calendar-absolute-from-hebrew |
71ea27ee GM |
317 | (list 7 1 (+ displayed-year 3761)))) |
318 | (mandatory | |
319 | (list | |
320 | (list (calendar-gregorian-from-absolute abs-r-h) | |
321 | (format "Rosh HaShanah %d" (+ 3761 displayed-year))) | |
322 | (list (calendar-gregorian-from-absolute (+ abs-r-h 9)) | |
323 | "Yom Kippur") | |
324 | (list (calendar-gregorian-from-absolute (+ abs-r-h 14)) | |
325 | "Sukkot") | |
326 | (list (calendar-gregorian-from-absolute (+ abs-r-h 21)) | |
327 | "Shemini Atzeret") | |
328 | (list (calendar-gregorian-from-absolute (+ abs-r-h 22)) | |
329 | "Simchat Torah"))) | |
4b112ac4 | 330 | (optional |
a1506d29 | 331 | (list |
4b112ac4 ER |
332 | (list (calendar-gregorian-from-absolute |
333 | (calendar-dayname-on-or-before 6 (- abs-r-h 4))) | |
334 | "Selichot (night)") | |
335 | (list (calendar-gregorian-from-absolute (1- abs-r-h)) | |
2e3befba | 336 | "Erev Rosh HaShanah") |
4b112ac4 ER |
337 | (list (calendar-gregorian-from-absolute (1+ abs-r-h)) |
338 | "Rosh HaShanah (second day)") | |
339 | (list (calendar-gregorian-from-absolute | |
340 | (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2))) | |
341 | "Tzom Gedaliah") | |
342 | (list (calendar-gregorian-from-absolute | |
343 | (calendar-dayname-on-or-before 6 (+ 7 abs-r-h))) | |
344 | "Shabbat Shuvah") | |
345 | (list (calendar-gregorian-from-absolute (+ abs-r-h 8)) | |
346 | "Erev Yom Kippur") | |
347 | (list (calendar-gregorian-from-absolute (+ abs-r-h 13)) | |
348 | "Erev Sukkot") | |
349 | (list (calendar-gregorian-from-absolute (+ abs-r-h 15)) | |
350 | "Sukkot (second day)") | |
351 | (list (calendar-gregorian-from-absolute (+ abs-r-h 16)) | |
352 | "Hol Hamoed Sukkot (first day)") | |
353 | (list (calendar-gregorian-from-absolute (+ abs-r-h 17)) | |
354 | "Hol Hamoed Sukkot (second day)") | |
355 | (list (calendar-gregorian-from-absolute (+ abs-r-h 18)) | |
356 | "Hol Hamoed Sukkot (third day)") | |
357 | (list (calendar-gregorian-from-absolute (+ abs-r-h 19)) | |
358 | "Hol Hamoed Sukkot (fourth day)") | |
359 | (list (calendar-gregorian-from-absolute (+ abs-r-h 20)) | |
321a8c3e | 360 | "Hoshanah Rabbah"))) |
71ea27ee GM |
361 | (output-list |
362 | (holiday-filter-visible-calendar mandatory))) | |
4b112ac4 ER |
363 | (if all-hebrew-calendar-holidays |
364 | (setq output-list | |
a1506d29 | 365 | (append |
8705f7f3 | 366 | (holiday-filter-visible-calendar optional) |
4b112ac4 ER |
367 | output-list))) |
368 | output-list))) | |
369 | ||
28b3c0f5 | 370 | ;;;###holiday-autoload |
4b112ac4 ER |
371 | (defun holiday-hanukkah () |
372 | "List of dates related to Hanukkah, as visible in calendar window." | |
9c68082d GM |
373 | ;; This test is only to speed things up a bit, it works fine without it. |
374 | (if (memq displayed-month | |
71ea27ee | 375 | '(10 11 12 1 2)) |
9c68082d | 376 | (let ((m displayed-month) |
71ea27ee GM |
377 | (y displayed-year)) |
378 | (increment-calendar-month m y 1) | |
379 | (let* ((h-y (extract-calendar-year | |
380 | (calendar-hebrew-from-absolute | |
381 | (calendar-absolute-from-gregorian | |
382 | (list m (calendar-last-day-of-month m y) y))))) | |
383 | (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y)))) | |
384 | (holiday-filter-visible-calendar | |
385 | (list | |
386 | (list (calendar-gregorian-from-absolute (1- abs-h)) | |
387 | "Erev Hanukkah") | |
388 | (list (calendar-gregorian-from-absolute abs-h) | |
389 | "Hanukkah (first day)") | |
390 | (list (calendar-gregorian-from-absolute (1+ abs-h)) | |
391 | "Hanukkah (second day)") | |
392 | (list (calendar-gregorian-from-absolute (+ abs-h 2)) | |
393 | "Hanukkah (third day)") | |
394 | (list (calendar-gregorian-from-absolute (+ abs-h 3)) | |
395 | "Hanukkah (fourth day)") | |
396 | (list (calendar-gregorian-from-absolute (+ abs-h 4)) | |
397 | "Hanukkah (fifth day)") | |
398 | (list (calendar-gregorian-from-absolute (+ abs-h 5)) | |
399 | "Hanukkah (sixth day)") | |
400 | (list (calendar-gregorian-from-absolute (+ abs-h 6)) | |
401 | "Hanukkah (seventh day)") | |
402 | (list (calendar-gregorian-from-absolute (+ abs-h 7)) | |
403 | "Hanukkah (eighth day)"))))))) | |
4b112ac4 | 404 | |
28b3c0f5 | 405 | ;;;###holiday-autoload |
4b112ac4 ER |
406 | (defun holiday-passover-etc () |
407 | "List of dates related to Passover, as visible in calendar window." | |
28c02796 | 408 | (unless (< 7 displayed-month) ; none of the dates is visible |
4b112ac4 | 409 | (let* ((abs-p (calendar-absolute-from-hebrew |
71ea27ee | 410 | (list 1 15 (+ displayed-year 3760)))) |
4b112ac4 ER |
411 | (mandatory |
412 | (list | |
413 | (list (calendar-gregorian-from-absolute abs-p) | |
414 | "Passover") | |
415 | (list (calendar-gregorian-from-absolute (+ abs-p 50)) | |
416 | "Shavuot"))) | |
417 | (optional | |
a1506d29 | 418 | (list |
4b112ac4 ER |
419 | (list (calendar-gregorian-from-absolute |
420 | (calendar-dayname-on-or-before 6 (- abs-p 43))) | |
421 | "Shabbat Shekalim") | |
422 | (list (calendar-gregorian-from-absolute | |
423 | (calendar-dayname-on-or-before 6 (- abs-p 30))) | |
424 | "Shabbat Zachor") | |
425 | (list (calendar-gregorian-from-absolute | |
426 | (if (= (% abs-p 7) 2) (- abs-p 33) (- abs-p 31))) | |
427 | "Fast of Esther") | |
428 | (list (calendar-gregorian-from-absolute (- abs-p 31)) | |
429 | "Erev Purim") | |
430 | (list (calendar-gregorian-from-absolute (- abs-p 30)) | |
431 | "Purim") | |
432 | (list (calendar-gregorian-from-absolute | |
433 | (if (zerop (% abs-p 7)) (- abs-p 28) (- abs-p 29))) | |
434 | "Shushan Purim") | |
435 | (list (calendar-gregorian-from-absolute | |
436 | (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7)) | |
437 | "Shabbat Parah") | |
438 | (list (calendar-gregorian-from-absolute | |
439 | (calendar-dayname-on-or-before 6 (- abs-p 14))) | |
440 | "Shabbat HaHodesh") | |
441 | (list (calendar-gregorian-from-absolute | |
442 | (calendar-dayname-on-or-before 6 (1- abs-p))) | |
443 | "Shabbat HaGadol") | |
444 | (list (calendar-gregorian-from-absolute (1- abs-p)) | |
445 | "Erev Passover") | |
446 | (list (calendar-gregorian-from-absolute (1+ abs-p)) | |
447 | "Passover (second day)") | |
448 | (list (calendar-gregorian-from-absolute (+ abs-p 2)) | |
449 | "Hol Hamoed Passover (first day)") | |
450 | (list (calendar-gregorian-from-absolute (+ abs-p 3)) | |
451 | "Hol Hamoed Passover (second day)") | |
452 | (list (calendar-gregorian-from-absolute (+ abs-p 4)) | |
453 | "Hol Hamoed Passover (third day)") | |
454 | (list (calendar-gregorian-from-absolute (+ abs-p 5)) | |
455 | "Hol Hamoed Passover (fourth day)") | |
456 | (list (calendar-gregorian-from-absolute (+ abs-p 6)) | |
457 | "Passover (seventh day)") | |
458 | (list (calendar-gregorian-from-absolute (+ abs-p 7)) | |
459 | "Passover (eighth day)") | |
bbc054a9 RS |
460 | (list (calendar-gregorian-from-absolute |
461 | (if (zerop (% (+ abs-p 12) 7)) | |
462 | (+ abs-p 13) | |
463 | (+ abs-p 12))) | |
4b112ac4 ER |
464 | "Yom HaShoah") |
465 | (list (calendar-gregorian-from-absolute | |
466 | (if (zerop (% abs-p 7)) | |
467 | (+ abs-p 18) | |
468 | (if (= (% abs-p 7) 6) | |
469 | (+ abs-p 19) | |
470 | (+ abs-p 20)))) | |
471 | "Yom HaAtzma'ut") | |
472 | (list (calendar-gregorian-from-absolute (+ abs-p 33)) | |
473 | "Lag BaOmer") | |
474 | (list (calendar-gregorian-from-absolute (+ abs-p 43)) | |
8f596798 | 475 | "Yom Yerushalaim") |
4b112ac4 ER |
476 | (list (calendar-gregorian-from-absolute (+ abs-p 49)) |
477 | "Erev Shavuot") | |
478 | (list (calendar-gregorian-from-absolute (+ abs-p 51)) | |
479 | "Shavuot (second day)"))) | |
480 | (output-list | |
71ea27ee | 481 | (holiday-filter-visible-calendar mandatory))) |
4b112ac4 ER |
482 | (if all-hebrew-calendar-holidays |
483 | (setq output-list | |
a1506d29 | 484 | (append |
8705f7f3 | 485 | (holiday-filter-visible-calendar optional) |
4b112ac4 ER |
486 | output-list))) |
487 | output-list))) | |
488 | ||
28b3c0f5 | 489 | ;;;###holiday-autoload |
4b112ac4 ER |
490 | (defun holiday-tisha-b-av-etc () |
491 | "List of dates around Tisha B'Av, as visible in calendar window." | |
28c02796 GM |
492 | (unless (or (< displayed-month 5) ; none of the dates is visible |
493 | (> displayed-month 9)) | |
494 | (let ((abs-t-a (calendar-absolute-from-hebrew | |
495 | (list 5 9 (+ displayed-year 3760))))) | |
8705f7f3 | 496 | (holiday-filter-visible-calendar |
a1506d29 | 497 | (list |
4b112ac4 ER |
498 | (list (calendar-gregorian-from-absolute |
499 | (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21))) | |
500 | "Tzom Tammuz") | |
501 | (list (calendar-gregorian-from-absolute | |
502 | (calendar-dayname-on-or-before 6 abs-t-a)) | |
503 | "Shabbat Hazon") | |
504 | (list (calendar-gregorian-from-absolute | |
505 | (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a)) | |
506 | "Tisha B'Av") | |
507 | (list (calendar-gregorian-from-absolute | |
508 | (calendar-dayname-on-or-before 6 (+ abs-t-a 7))) | |
509 | "Shabbat Nahamu")))))) | |
510 | ||
711d00e7 | 511 | (autoload 'diary-list-entries-1 "diary-lib") |
c3efd659 | 512 | |
28b3c0f5 | 513 | ;;;###diary-autoload |
4b112ac4 ER |
514 | (defun list-hebrew-diary-entries () |
515 | "Add any Hebrew date entries from the diary file to `diary-entries-list'. | |
516 | Hebrew date diary entries must be prefaced by `hebrew-diary-entry-symbol' | |
8f11970d GM |
517 | \(normally an `H'). The same diary date forms govern the style |
518 | of the Hebrew calendar entries, except that the Hebrew month | |
872edde5 | 519 | names cannot be abbreviated. The Hebrew months are numbered |
8f11970d GM |
520 | from 1 to 13 with Nisan being 1, 12 being Adar I and 13 being |
521 | Adar II; you must use `Adar I' if you want Adar of a common | |
522 | Hebrew year. If a Hebrew date diary entry begins with | |
523 | `diary-nonmarking-symbol', the entry will appear in the diary | |
524 | listing, but will not be marked in the calendar. This function | |
525 | is provided for use with `nongregorian-diary-listing-hook'." | |
711d00e7 GM |
526 | (diary-list-entries-1 calendar-hebrew-month-name-array-leap-year |
527 | hebrew-diary-entry-symbol | |
528 | 'calendar-hebrew-from-absolute)) | |
4b112ac4 | 529 | |
28c02796 GM |
530 | (autoload 'calendar-mark-complex "diary-lib") |
531 | ||
28b3c0f5 | 532 | ;;;###diary-autoload |
28c02796 | 533 | (defun mark-hebrew-calendar-date-pattern (month day year &optional color) |
da3fc020 | 534 | "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR. |
28c02796 GM |
535 | A value of 0 in any position is a wildcard. Optional argument COLOR is |
536 | passed to `mark-visible-calendar-date' as MARK." | |
537 | ;; FIXME not the same as the Bahai and Islamic cases, so can't use | |
538 | ;; calendar-mark-1. | |
da3fc020 GM |
539 | (save-excursion |
540 | (set-buffer calendar-buffer) | |
0d1bb2ff GM |
541 | (if (and (not (zerop month)) (not (zerop day))) |
542 | (if (not (zerop year)) | |
da3fc020 GM |
543 | ;; Fully specified Hebrew date. |
544 | (let ((date (calendar-gregorian-from-absolute | |
545 | (calendar-absolute-from-hebrew | |
546 | (list month day year))))) | |
547 | (if (calendar-date-is-visible-p date) | |
28c02796 | 548 | (mark-visible-calendar-date date color))) |
da3fc020 | 549 | ;; Month and day in any year--this taken from the holiday stuff. |
71ea27ee GM |
550 | ;; This test is only to speed things up a bit, it works |
551 | ;; fine without it. | |
9c68082d GM |
552 | (if (memq displayed-month |
553 | (list | |
da3fc020 GM |
554 | (if (< 11 month) (- month 11) (+ month 1)) |
555 | (if (< 10 month) (- month 10) (+ month 2)) | |
556 | (if (< 9 month) (- month 9) (+ month 3)) | |
557 | (if (< 8 month) (- month 8) (+ month 4)) | |
558 | (if (< 7 month) (- month 7) (+ month 5)))) | |
559 | (let ((m1 displayed-month) | |
560 | (y1 displayed-year) | |
561 | (m2 displayed-month) | |
562 | (y2 displayed-year) | |
28c02796 | 563 | year) |
da3fc020 GM |
564 | (increment-calendar-month m1 y1 -1) |
565 | (increment-calendar-month m2 y2 1) | |
566 | (let* ((start-date (calendar-absolute-from-gregorian | |
567 | (list m1 1 y1))) | |
568 | (end-date (calendar-absolute-from-gregorian | |
569 | (list m2 | |
570 | (calendar-last-day-of-month m2 y2) | |
571 | y2))) | |
28c02796 | 572 | (hebrew-start (calendar-hebrew-from-absolute start-date)) |
da3fc020 GM |
573 | (hebrew-end (calendar-hebrew-from-absolute end-date)) |
574 | (hebrew-y1 (extract-calendar-year hebrew-start)) | |
575 | (hebrew-y2 (extract-calendar-year hebrew-end))) | |
576 | (setq year (if (< 6 month) hebrew-y2 hebrew-y1)) | |
577 | (let ((date (calendar-gregorian-from-absolute | |
578 | (calendar-absolute-from-hebrew | |
579 | (list month day year))))) | |
580 | (if (calendar-date-is-visible-p date) | |
28c02796 GM |
581 | (mark-visible-calendar-date date color))))))) |
582 | (calendar-mark-complex month day year | |
583 | 'calendar-hebrew-from-absolute color)))) | |
da3fc020 | 584 | |
711d00e7 | 585 | (autoload 'diary-mark-entries-1 "diary-lib") |
e475d400 | 586 | |
28b3c0f5 | 587 | ;;;###diary-autoload |
4b112ac4 ER |
588 | (defun mark-hebrew-diary-entries () |
589 | "Mark days in the calendar window that have Hebrew date diary entries. | |
711d00e7 GM |
590 | Marks each entry in `diary-file' (or included files) visible in the calendar |
591 | window. See `list-hebrew-diary-entries' for more information." | |
592 | (diary-mark-entries-1 calendar-hebrew-month-name-array-leap-year | |
593 | hebrew-diary-entry-symbol | |
594 | 'calendar-hebrew-from-absolute | |
595 | 'mark-hebrew-calendar-date-pattern)) | |
4b112ac4 | 596 | |
f2b46435 GM |
597 | |
598 | (autoload 'diary-insert-entry-1 "diary-lib") | |
599 | ||
28b3c0f5 | 600 | ;;;###cal-autoload |
4b112ac4 ER |
601 | (defun insert-hebrew-diary-entry (arg) |
602 | "Insert a diary entry. | |
603 | For the Hebrew date corresponding to the date indicated by point. | |
6afe7cdd | 604 | Prefix argument ARG makes the entry nonmarking." |
4b112ac4 | 605 | (interactive "P") |
f2b46435 GM |
606 | (diary-insert-entry-1 nil arg calendar-hebrew-month-name-array-leap-year |
607 | hebrew-diary-entry-symbol | |
608 | 'calendar-hebrew-from-absolute)) | |
4b112ac4 | 609 | |
28b3c0f5 | 610 | ;;;###cal-autoload |
4b112ac4 ER |
611 | (defun insert-monthly-hebrew-diary-entry (arg) |
612 | "Insert a monthly diary entry. | |
613 | For the day of the Hebrew month corresponding to the date indicated by point. | |
6afe7cdd | 614 | Prefix argument ARG makes the entry nonmarking." |
4b112ac4 | 615 | (interactive "P") |
f2b46435 GM |
616 | (diary-insert-entry-1 'monthly arg calendar-hebrew-month-name-array-leap-year |
617 | hebrew-diary-entry-symbol | |
618 | 'calendar-hebrew-from-absolute)) | |
4b112ac4 | 619 | |
28b3c0f5 | 620 | ;;;###cal-autoload |
4b112ac4 ER |
621 | (defun insert-yearly-hebrew-diary-entry (arg) |
622 | "Insert an annual diary entry. | |
623 | For the day of the Hebrew year corresponding to the date indicated by point. | |
6afe7cdd | 624 | Prefix argument ARG makes the entry nonmarking." |
4b112ac4 | 625 | (interactive "P") |
f2b46435 GM |
626 | (diary-insert-entry-1 'yearly arg calendar-hebrew-month-name-array-leap-year |
627 | hebrew-diary-entry-symbol | |
628 | 'calendar-hebrew-from-absolute)) | |
4b112ac4 ER |
629 | |
630 | ;;;###autoload | |
631 | (defun list-yahrzeit-dates (death-date start-year end-year) | |
632 | "List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR. | |
633 | When called interactively from the calendar window, the date of death is taken | |
634 | from the cursor position." | |
635 | (interactive | |
636 | (let* ((death-date | |
637 | (if (equal (current-buffer) (get-buffer calendar-buffer)) | |
638 | (calendar-cursor-to-date) | |
639 | (let* ((today (calendar-current-date)) | |
640 | (year (calendar-read | |
641 | "Year of death (>0): " | |
c645b7bb | 642 | (lambda (x) (> x 0)) |
4b112ac4 ER |
643 | (int-to-string (extract-calendar-year today)))) |
644 | (month-array calendar-month-name-array) | |
645 | (completion-ignore-case t) | |
abe4091c | 646 | (month (cdr (assoc-string |
bf7b2caf RS |
647 | (completing-read |
648 | "Month of death (name): " | |
649 | (mapcar 'list (append month-array nil)) | |
650 | nil t) | |
abe4091c | 651 | (calendar-make-alist month-array 1) t))) |
4b112ac4 ER |
652 | (last (calendar-last-day-of-month month year)) |
653 | (day (calendar-read | |
654 | (format "Day of death (1-%d): " last) | |
c645b7bb | 655 | (lambda (x) (and (< 0 x) (<= x last)))))) |
4b112ac4 ER |
656 | (list month day year)))) |
657 | (death-year (extract-calendar-year death-date)) | |
658 | (start-year (calendar-read | |
659 | (format "Starting year of Yahrzeit table (>%d): " | |
660 | death-year) | |
c645b7bb | 661 | (lambda (x) (> x death-year)) |
4b112ac4 ER |
662 | (int-to-string (1+ death-year)))) |
663 | (end-year (calendar-read | |
664 | (format "Ending year of Yahrzeit table (>=%d): " | |
665 | start-year) | |
71ea27ee GM |
666 | (lambda (x) (>= x start-year))))) |
667 | (list death-date start-year end-year))) | |
6afe7cdd | 668 | (message "Computing Yahrzeits...") |
66471e03 | 669 | (let* ((h-date (calendar-hebrew-from-absolute |
4b112ac4 ER |
670 | (calendar-absolute-from-gregorian death-date))) |
671 | (h-month (extract-calendar-month h-date)) | |
672 | (h-day (extract-calendar-day h-date)) | |
673 | (h-year (extract-calendar-year h-date))) | |
318a5488 GM |
674 | (calendar-in-read-only-buffer cal-hebrew-yahrzeit-buffer |
675 | (calendar-set-mode-line | |
676 | (format "Yahrzeit dates for %s = %s" | |
677 | (calendar-date-string death-date) | |
678 | (let ((calendar-month-name-array | |
679 | (if (hebrew-calendar-leap-year-p h-year) | |
680 | calendar-hebrew-month-name-array-leap-year | |
681 | calendar-hebrew-month-name-array-common-year))) | |
682 | (calendar-date-string h-date nil t)))) | |
683 | (calendar-for-loop i from start-year to end-year do | |
684 | (insert | |
685 | (calendar-date-string | |
686 | (calendar-gregorian-from-absolute | |
687 | (hebrew-calendar-yahrzeit | |
688 | h-date | |
689 | (extract-calendar-year | |
690 | (calendar-hebrew-from-absolute | |
691 | (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n"))) | |
6afe7cdd | 692 | (message "Computing Yahrzeits...done"))) |
4b112ac4 | 693 | |
c3efd659 GM |
694 | (defvar date) |
695 | ||
28b3c0f5 GM |
696 | ;; To be called from list-sexp-diary-entries, where DATE is bound. |
697 | ;;;###diary-autoload | |
4b112ac4 ER |
698 | (defun diary-hebrew-date () |
699 | "Hebrew calendar equivalent of date diary entry." | |
700 | (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date))) | |
701 | ||
28b3c0f5 | 702 | ;;;###diary-autoload |
9a27723c | 703 | (defun diary-omer (&optional mark) |
4b112ac4 | 704 | "Omer count diary entry. |
9a27723c RS |
705 | Entry applies if date is within 50 days after Passover. |
706 | ||
a1506d29 | 707 | An optional parameter MARK specifies a face or single-character string to |
9a27723c | 708 | use when highlighting the day in the calendar." |
4b112ac4 ER |
709 | (let* ((passover |
710 | (calendar-absolute-from-hebrew | |
711 | (list 1 15 (+ (extract-calendar-year date) 3760)))) | |
712 | (omer (- (calendar-absolute-from-gregorian date) passover)) | |
713 | (week (/ omer 7)) | |
714 | (day (% omer 7))) | |
715 | (if (and (> omer 0) (< omer 50)) | |
a1506d29 | 716 | (cons mark |
71ea27ee GM |
717 | (format "Day %d%s of the omer (until sunset)" |
718 | omer | |
719 | (if (zerop week) | |
720 | "" | |
721 | (format ", that is, %d week%s%s" | |
722 | week | |
723 | (if (= week 1) "" "s") | |
724 | (if (zerop day) | |
725 | "" | |
726 | (format " and %d day%s" | |
727 | day (if (= day 1) "" "s")))))))))) | |
4b112ac4 | 728 | |
c3efd659 GM |
729 | (defvar entry) |
730 | ||
f2b46435 GM |
731 | (autoload 'diary-make-date "diary-lib") |
732 | ||
28b3c0f5 | 733 | ;;;###diary-autoload |
9a27723c | 734 | (defun diary-yahrzeit (death-month death-day death-year &optional mark) |
6afe7cdd | 735 | "Yahrzeit diary entry--entry applies if date is Yahrzeit or the day before. |
f2b46435 GM |
736 | Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary |
737 | entry is assumed to be the name of the person. Although the date | |
738 | of death is specified by the civil calendar, the proper Hebrew | |
739 | calendar Yahrzeit is determined. | |
740 | ||
741 | The order of the input parameters changes according to `calendar-date-style' | |
742 | \(e.g. to DEATH-DAY, DEATH-MONTH, DEATH-YEAR in the European style). | |
9a27723c | 743 | |
a1506d29 | 744 | An optional parameter MARK specifies a face or single-character string to |
9a27723c | 745 | use when highlighting the day in the calendar." |
4b112ac4 ER |
746 | (let* ((h-date (calendar-hebrew-from-absolute |
747 | (calendar-absolute-from-gregorian | |
f2b46435 | 748 | (diary-make-date death-month death-day death-year)))) |
4b112ac4 ER |
749 | (h-month (extract-calendar-month h-date)) |
750 | (h-day (extract-calendar-day h-date)) | |
751 | (h-year (extract-calendar-year h-date)) | |
752 | (d (calendar-absolute-from-gregorian date)) | |
753 | (yr (extract-calendar-year (calendar-hebrew-from-absolute d))) | |
754 | (diff (- yr h-year)) | |
755 | (y (hebrew-calendar-yahrzeit h-date yr))) | |
756 | (if (and (> diff 0) (or (= y d) (= y (1+ d)))) | |
9a27723c | 757 | (cons mark |
71ea27ee GM |
758 | (format "Yahrzeit of %s%s: %d%s anniversary" |
759 | entry | |
760 | (if (= y d) "" " (evening)") | |
761 | diff | |
762 | (cond ((= (% diff 10) 1) "st") | |
763 | ((= (% diff 10) 2) "nd") | |
764 | ((= (% diff 10) 3) "rd") | |
765 | (t "th"))))))) | |
4b112ac4 | 766 | |
28b3c0f5 | 767 | ;;;###diary-autoload |
9a27723c | 768 | (defun diary-rosh-hodesh (&optional mark) |
4b112ac4 | 769 | "Rosh Hodesh diary entry. |
9a27723c RS |
770 | Entry applies if date is Rosh Hodesh, the day before, or the Saturday before. |
771 | ||
a1506d29 | 772 | An optional parameter MARK specifies a face or single-character string to |
9a27723c | 773 | use when highlighting the day in the calendar." |
4b112ac4 ER |
774 | (let* ((d (calendar-absolute-from-gregorian date)) |
775 | (h-date (calendar-hebrew-from-absolute d)) | |
776 | (h-month (extract-calendar-month h-date)) | |
777 | (h-day (extract-calendar-day h-date)) | |
778 | (h-year (extract-calendar-year h-date)) | |
779 | (leap-year (hebrew-calendar-leap-year-p h-year)) | |
780 | (last-day (hebrew-calendar-last-day-of-month h-month h-year)) | |
781 | (h-month-names | |
782 | (if leap-year | |
783 | calendar-hebrew-month-name-array-leap-year | |
784 | calendar-hebrew-month-name-array-common-year)) | |
785 | (this-month (aref h-month-names (1- h-month))) | |
786 | (h-yesterday (extract-calendar-day | |
787 | (calendar-hebrew-from-absolute (1- d))))) | |
788 | (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7))) | |
a1506d29 | 789 | (cons mark |
71ea27ee GM |
790 | (format |
791 | "Rosh Hodesh %s" | |
792 | (if (= h-day 30) | |
793 | (format | |
794 | "%s (first day)" | |
795 | ;; Next month must be in the same year since this | |
796 | ;; month can't be the last month of the year since | |
797 | ;; it has 30 days | |
798 | (aref h-month-names h-month)) | |
799 | (if (= h-yesterday 30) | |
800 | (format "%s (second day)" this-month) | |
801 | this-month)))) | |
802 | (if (= (% d 7) 6) ; Saturday--check for Shabbat Mevarchim | |
a1506d29 | 803 | (cons mark |
71ea27ee GM |
804 | (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day)) |
805 | (format "Mevarchim Rosh Hodesh %s (%s)" | |
806 | (aref h-month-names | |
807 | (if (= h-month | |
808 | (hebrew-calendar-last-month-of-year | |
809 | h-year)) | |
810 | 0 h-month)) | |
811 | (aref calendar-day-name-array (- 29 h-day)))) | |
812 | ((and (< h-day 30) (> h-day 22) (= 30 last-day)) | |
813 | (format "Mevarchim Rosh Hodesh %s (%s-%s)" | |
814 | (aref h-month-names h-month) | |
815 | (if (= h-day 29) | |
816 | "tomorrow" | |
817 | (aref calendar-day-name-array (- 29 h-day))) | |
818 | (aref calendar-day-name-array | |
819 | (% (- 30 h-day) 7)))))) | |
4b112ac4 | 820 | (if (and (= h-day 29) (/= h-month 6)) |
347a0e23 | 821 | (cons mark |
71ea27ee GM |
822 | (format "Erev Rosh Hodesh %s" |
823 | (aref h-month-names | |
824 | (if (= h-month | |
825 | (hebrew-calendar-last-month-of-year | |
826 | h-year)) | |
827 | 0 h-month))))))))) | |
9a27723c | 828 | |
711d00e7 | 829 | (defconst hebrew-calendar-parashiot-names |
71ea27ee GM |
830 | ["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth" |
831 | "Vayetze" "Vayishlah" "Vayeshev" "Mikketz" "Vayiggash" "Vayhi" | |
832 | "Shemoth" "Vaera" "Bo" "Beshallah" "Yithro" "Mishpatim" | |
833 | "Terumah" "Tetzavveh" "Ki Tissa" "Vayakhel" "Pekudei" "Vayikra" | |
834 | "Tzav" "Shemini" "Tazria" "Metzora" "Aharei Moth" "Kedoshim" | |
835 | "Emor" "Behar" "Behukkotai" "Bemidbar" "Naso" "Behaalot'cha" | |
836 | "Shelah L'cha" "Korah" "Hukkath" "Balak" "Pinhas" "Mattoth" | |
837 | "Masei" "Devarim" "Vaethanan" "Ekev" "Reeh" "Shofetim" | |
838 | "Ki Tetze" "Ki Tavo" "Nitzavim" "Vayelech" "Haazinu"] | |
da3fc020 GM |
839 | "The names of the parashiot in the Torah.") |
840 | ||
841 | (defun hebrew-calendar-parasha-name (p) | |
842 | "Name(s) corresponding to parasha P." | |
71ea27ee | 843 | (if (arrayp p) ; combined parasha |
da3fc020 GM |
844 | (format "%s/%s" |
845 | (aref hebrew-calendar-parashiot-names (aref p 0)) | |
846 | (aref hebrew-calendar-parashiot-names (aref p 1))) | |
847 | (aref hebrew-calendar-parashiot-names p))) | |
848 | ||
711d00e7 | 849 | ;; Following 14 constants are used in diary-parasha (intern). |
8f11970d | 850 | |
9c68082d | 851 | ;; The seven ordinary year types (keviot). |
4b112ac4 ER |
852 | (defconst hebrew-calendar-year-Saturday-incomplete-Sunday |
853 | [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] | |
71ea27ee GM |
854 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] |
855 | 43 44 45 46 47 48 49 50] | |
4b112ac4 ER |
856 | "The structure of the parashiot. |
857 | Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have | |
858 | 29 days), and has Passover start on Sunday.") | |
859 | ||
860 | (defconst hebrew-calendar-year-Saturday-complete-Tuesday | |
861 | [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] | |
71ea27ee GM |
862 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] |
863 | 43 44 45 46 47 48 49 [50 51]] | |
4b112ac4 ER |
864 | "The structure of the parashiot. |
865 | Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each | |
866 | have 30 days), and has Passover start on Tuesday.") | |
867 | ||
868 | (defconst hebrew-calendar-year-Monday-incomplete-Tuesday | |
869 | [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] | |
71ea27ee GM |
870 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] |
871 | 43 44 45 46 47 48 49 [50 51]] | |
4b112ac4 ER |
872 | "The structure of the parashiot. |
873 | Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each | |
874 | have 29 days), and has Passover start on Tuesday.") | |
875 | ||
876 | (defconst hebrew-calendar-year-Monday-complete-Thursday | |
877 | [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] | |
71ea27ee GM |
878 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) |
879 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] | |
4b112ac4 ER |
880 | "The structure of the parashiot. |
881 | Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have | |
882 | 30 days), and has Passover start on Thursday.") | |
883 | ||
884 | (defconst hebrew-calendar-year-Tuesday-regular-Thursday | |
885 | [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] | |
71ea27ee GM |
886 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36) |
887 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] | |
4b112ac4 ER |
888 | "The structure of the parashiot. |
889 | Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and | |
890 | Kislev has 30 days), and has Passover start on Thursday.") | |
891 | ||
892 | (defconst hebrew-calendar-year-Thursday-regular-Saturday | |
893 | [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23 | |
71ea27ee GM |
894 | 24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30) |
895 | (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48 | |
896 | 49 50] | |
4b112ac4 ER |
897 | "The structure of the parashiot. |
898 | Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and | |
899 | Kislev has 30 days), and has Passover start on Saturday.") | |
900 | ||
901 | (defconst hebrew-calendar-year-Thursday-complete-Sunday | |
902 | [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | |
71ea27ee GM |
903 | 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42] |
904 | 43 44 45 46 47 48 49 50] | |
4b112ac4 ER |
905 | "The structure of the parashiot. |
906 | Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each | |
907 | have 30 days), and has Passover start on Sunday.") | |
908 | ||
9c68082d | 909 | ;; The seven leap year types (keviot). |
4b112ac4 ER |
910 | (defconst hebrew-calendar-year-Saturday-incomplete-Tuesday |
911 | [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | |
71ea27ee GM |
912 | 23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42] |
913 | 43 44 45 46 47 48 49 [50 51]] | |
4b112ac4 ER |
914 | "The structure of the parashiot. |
915 | Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each | |
916 | have 29 days), and has Passover start on Tuesday.") | |
917 | ||
918 | (defconst hebrew-calendar-year-Saturday-complete-Thursday | |
919 | [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | |
71ea27ee GM |
920 | 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) |
921 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] | |
4b112ac4 ER |
922 | "The structure of the parashiot. |
923 | Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each | |
924 | have 30 days), and has Passover start on Thursday.") | |
925 | ||
926 | (defconst hebrew-calendar-year-Monday-incomplete-Thursday | |
927 | [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | |
71ea27ee GM |
928 | 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36) |
929 | (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]] | |
4b112ac4 ER |
930 | "The structure of the parashiot. |
931 | Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each | |
932 | have 29 days), and has Passover start on Thursday.") | |
933 | ||
934 | (defconst hebrew-calendar-year-Monday-complete-Saturday | |
935 | [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | |
71ea27ee GM |
936 | 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) |
937 | (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) | |
938 | (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] | |
4b112ac4 ER |
939 | "The structure of the parashiot. |
940 | Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have | |
941 | 30 days), and has Passover start on Saturday.") | |
942 | ||
943 | (defconst hebrew-calendar-year-Tuesday-regular-Saturday | |
944 | [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | |
71ea27ee GM |
945 | 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32) |
946 | (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39) | |
947 | (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50] | |
4b112ac4 ER |
948 | "The structure of the parashiot. |
949 | Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and | |
950 | Kislev has 30 days), and has Passover start on Saturday.") | |
951 | ||
952 | (defconst hebrew-calendar-year-Thursday-incomplete-Sunday | |
953 | [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | |
71ea27ee GM |
954 | 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
955 | 43 44 45 46 47 48 49 50] | |
4b112ac4 ER |
956 | "The structure of the parashiot. |
957 | Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both | |
958 | have 29 days), and has Passover start on Sunday.") | |
959 | ||
960 | (defconst hebrew-calendar-year-Thursday-complete-Tuesday | |
961 | [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | |
71ea27ee GM |
962 | 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
963 | 43 44 45 46 47 48 49 [50 51]] | |
4b112ac4 ER |
964 | "The structure of the parashiot. |
965 | Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both | |
966 | have 30 days), and has Passover start on Tuesday.") | |
967 | ||
711d00e7 GM |
968 | ;;;###diary-autoload |
969 | (defun diary-parasha (&optional mark) | |
970 | "Parasha diary entry--entry applies if date is a Saturday. | |
971 | An optional parameter MARK specifies a face or single-character string to | |
972 | use when highlighting the day in the calendar." | |
973 | (let ((d (calendar-absolute-from-gregorian date))) | |
974 | (if (= (% d 7) 6) ; Saturday | |
975 | (let* ((h-year (extract-calendar-year | |
976 | (calendar-hebrew-from-absolute d))) | |
977 | (rosh-hashanah | |
978 | (calendar-absolute-from-hebrew (list 7 1 h-year))) | |
979 | (passover | |
980 | (calendar-absolute-from-hebrew (list 1 15 h-year))) | |
981 | (rosh-hashanah-day | |
982 | (aref calendar-day-name-array (% rosh-hashanah 7))) | |
983 | (passover-day | |
984 | (aref calendar-day-name-array (% passover 7))) | |
985 | (long-h (hebrew-calendar-long-heshvan-p h-year)) | |
986 | (short-k (hebrew-calendar-short-kislev-p h-year)) | |
987 | (type (cond ((and long-h (not short-k)) "complete") | |
988 | ((and (not long-h) short-k) "incomplete") | |
989 | (t "regular"))) | |
990 | (year-format | |
991 | (symbol-value | |
992 | (intern (format "hebrew-calendar-year-%s-%s-%s" ; keviah | |
993 | rosh-hashanah-day type passover-day)))) | |
994 | (first-saturday ; of Hebrew year | |
995 | (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah))) | |
996 | (saturday ; which Saturday of the Hebrew year | |
997 | (/ (- d first-saturday) 7)) | |
998 | (parasha (aref year-format saturday))) | |
999 | (if parasha | |
1000 | (cons mark | |
1001 | (format | |
1002 | "Parashat %s" | |
1003 | (if (listp parasha) ; Israel differs from diaspora | |
1004 | (if (car parasha) | |
1005 | (format "%s (diaspora), %s (Israel)" | |
1006 | (hebrew-calendar-parasha-name | |
1007 | (car parasha)) | |
1008 | (hebrew-calendar-parasha-name | |
1009 | (cdr parasha))) | |
1010 | (format "%s (Israel)" | |
1011 | (hebrew-calendar-parasha-name | |
1012 | (cdr parasha)))) | |
1013 | (hebrew-calendar-parasha-name parasha))))))))) | |
1014 | ||
4b112ac4 ER |
1015 | (provide 'cal-hebrew) |
1016 | ||
c645b7bb | 1017 | ;; arch-tag: aaab6718-7712-42ac-a32d-28fe1f944f3c |
4b112ac4 | 1018 | ;;; cal-hebrew.el ends here |