*** empty log message ***
[bpt/emacs.git] / lisp / calendar / cal-hebrew.el
CommitLineData
5c19bda9 1;;; cal-hebrew.el --- calendar functions for the Hebrew calendar.
4b112ac4 2
a96a5fca 3;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
4b112ac4 4
85d0ba86 5;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
4b112ac4
ER
6;; Edward M. Reingold <reingold@cs.uiuc.edu>
7;; Keywords: calendar
8;; Human-Keywords: Hebrew calendar, calendar, diary
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
b578f267
EN
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
4b112ac4
ER
26
27;;; Commentary:
28
29;; This collection of functions implements the features of calendar.el and
30;; diary.el that deal with the Hebrew calendar.
31
a96a5fca
PE
32;; Technical details of all the calendrical calculations can be found in
33;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
34;; Cambridge University Press (1997).
35
4b112ac4
ER
36;; Comments, corrections, and improvements should be sent to
37;; Edward M. Reingold Department of Computer Science
38;; (217) 333-6733 University of Illinois at Urbana-Champaign
39;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
40;; Urbana, Illinois 61801
41
42;;; Code:
43
44(require 'calendar)
45
46(defun calendar-hebrew-from-absolute (date)
47 "Compute the Hebrew date (month day year) corresponding to absolute DATE.
48The absolute date is the number of days elapsed since the (imaginary)
49Gregorian date Sunday, December 31, 1 BC."
50 (let* ((greg-date (calendar-gregorian-from-absolute date))
51 (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
52 (1- (extract-calendar-month greg-date))))
53 (day)
54 (year (+ 3760 (extract-calendar-year greg-date))))
55 (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
56 (setq year (1+ year)))
57 (let ((length (hebrew-calendar-last-month-of-year year)))
58 (while (> date
59 (calendar-absolute-from-hebrew
60 (list month
61 (hebrew-calendar-last-day-of-month month year)
62 year)))
63 (setq month (1+ (% month length)))))
64 (setq day (1+
65 (- date (calendar-absolute-from-hebrew (list month 1 year)))))
66 (list month day year)))
67
68(defun hebrew-calendar-leap-year-p (year)
69 "t if YEAR is a Hebrew calendar leap year."
70 (< (% (1+ (* 7 year)) 19) 7))
71
72(defun hebrew-calendar-last-month-of-year (year)
73 "The last month of the Hebrew calendar YEAR."
74 (if (hebrew-calendar-leap-year-p year)
75 13
76 12))
77
78(defun hebrew-calendar-last-day-of-month (month year)
79 "The last day of MONTH in YEAR."
80 (if (or (memq month (list 2 4 6 10 13))
81 (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
82 (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
83 (and (= month 9) (hebrew-calendar-short-kislev-p year)))
84 29
85 30))
86
87(defun hebrew-calendar-elapsed-days (year)
88 "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
89 (let* ((months-elapsed
90 (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far.
91 (* 12 (% (1- year) 19)) ;; Regular months in this cycle
92 (/ (1+ (* 7 (% (1- year) 19))) 19)));; Leap months this cycle
93 (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))
94 (hours-elapsed (+ 5
95 (* 12 months-elapsed)
96 (* 793 (/ months-elapsed 1080))
97 (/ parts-elapsed 1080)))
98 (parts ;; Conjunction parts
99 (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
100 (day ;; Conjunction day
101 (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
102 (alternative-day
103 (if (or (>= parts 19440) ;; If the new moon is at or after midday,
104 (and (= (% day 7) 2);; ...or is on a Tuesday...
105 (>= parts 9924) ;; at 9 hours, 204 parts or later...
106 (not (hebrew-calendar-leap-year-p year)));; of a
107 ;; common year,
108 (and (= (% day 7) 1);; ...or is on a Monday...
109 (>= parts 16789) ;; at 15 hours, 589 parts or later...
110 (hebrew-calendar-leap-year-p (1- year))));; at the end
111 ;; of a leap year
112 ;; Then postpone Rosh HaShanah one day
113 (1+ day)
114 ;; Else
115 day)))
116 (if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
117 (memq (% alternative-day 7) (list 0 3 5))
118 ;; Then postpone it one (more) day and return
119 (1+ alternative-day)
120 ;; Else return
121 alternative-day)))
122
123(defun hebrew-calendar-days-in-year (year)
124 "Number of days in Hebrew YEAR."
125 (- (hebrew-calendar-elapsed-days (1+ year))
126 (hebrew-calendar-elapsed-days year)))
127
128(defun hebrew-calendar-long-heshvan-p (year)
129 "t if Heshvan is long in Hebrew YEAR."
130 (= (% (hebrew-calendar-days-in-year year) 10) 5))
131
132(defun hebrew-calendar-short-kislev-p (year)
133 "t if Kislev is short in Hebrew YEAR."
134 (= (% (hebrew-calendar-days-in-year year) 10) 3))
135
136(defun calendar-absolute-from-hebrew (date)
137 "Absolute date of Hebrew DATE.
138The absolute date is the number of days elapsed since the (imaginary)
139Gregorian date Sunday, December 31, 1 BC."
140 (let* ((month (extract-calendar-month date))
141 (day (extract-calendar-day date))
142 (year (extract-calendar-year date)))
143 (+ day ;; Days so far this month.
144 (if (< month 7);; before Tishri
145 ;; Then add days in prior months this year before and after Nisan
146 (+ (calendar-sum
147 m 7 (<= m (hebrew-calendar-last-month-of-year year))
148 (hebrew-calendar-last-day-of-month m year))
149 (calendar-sum
150 m 1 (< m month)
151 (hebrew-calendar-last-day-of-month m year)))
152 ;; Else add days in prior months this year
153 (calendar-sum
154 m 7 (< m month)
155 (hebrew-calendar-last-day-of-month m year)))
156 (hebrew-calendar-elapsed-days year);; Days in prior years.
157 -1373429))) ;; Days elapsed before absolute date 1.
158
159(defvar calendar-hebrew-month-name-array-common-year
160 ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
161 "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"])
162
163(defvar calendar-hebrew-month-name-array-leap-year
164 ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
165 "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"])
166
167(defun calendar-hebrew-date-string (&optional date)
168 "String of Hebrew date before sunset of Gregorian DATE.
169Defaults to today's date if DATE is not given.
170Driven by the variable `calendar-date-display-form'."
171 (let* ((hebrew-date (calendar-hebrew-from-absolute
172 (calendar-absolute-from-gregorian
173 (or date (calendar-current-date)))))
174 (calendar-month-name-array
175 (if (hebrew-calendar-leap-year-p (extract-calendar-year hebrew-date))
176 calendar-hebrew-month-name-array-leap-year
177 calendar-hebrew-month-name-array-common-year)))
178 (calendar-date-string hebrew-date nil t)))
179
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."
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)))
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))))
198 ;; If it's Kislev 30 it depends on the first anniversary; if
199 ;; that was not Kislev 30, use the day before Teveth 1.
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))))
204 ;; If it's Adar II, use the same day in last month of
205 ;; year (Adar or Adar II).
206 ((= death-month 13)
207 (calendar-absolute-from-hebrew
208 (list (hebrew-calendar-last-month-of-year year) death-day year)))
209 ;; If it's the 30th in Adar I and year is not a leap year
210 ;; (so Adar has only 29 days), use the last day in Shevat.
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
219(defun calendar-goto-hebrew-date (date &optional noecho)
220 "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is t."
221 (interactive
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)
bf7b2caf
RS
234 (month (cdr (assoc-ignore-case
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-ignore-case
242 (car x)
243 (calendar-make-alist
244 month-array)))))
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))))
4b112ac4
ER
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 (calendar-goto-date (calendar-gregorian-from-absolute
262 (calendar-absolute-from-hebrew date)))
263 (or noecho (calendar-print-hebrew-date)))
264
265(defun holiday-hebrew (month day string)
266 "Holiday on MONTH, DAY (Hebrew) called STRING.
267If MONTH, DAY (Hebrew) is visible, the value returned is corresponding
268Gregorian date in the form of the list (((month day year) STRING)). Returns
269nil if it is not visible in the current calendar window."
270 (if (memq displayed-month;; This test is only to speed things up a bit;
271 (list ;; it works fine without the test too.
272 (if (< 11 month) (- month 11) (+ month 1))
273 (if (< 10 month) (- month 10) (+ month 2))
274 (if (< 9 month) (- month 9) (+ month 3))
275 (if (< 8 month) (- month 8) (+ month 4))
276 (if (< 7 month) (- month 7) (+ month 5))))
277 (let ((m1 displayed-month)
278 (y1 displayed-year)
279 (m2 displayed-month)
280 (y2 displayed-year)
281 (year))
282 (increment-calendar-month m1 y1 -1)
283 (increment-calendar-month m2 y2 1)
284 (let* ((start-date (calendar-absolute-from-gregorian
285 (list m1 1 y1)))
286 (end-date (calendar-absolute-from-gregorian
287 (list m2 (calendar-last-day-of-month m2 y2) y2)))
288 (hebrew-start (calendar-hebrew-from-absolute start-date))
289 (hebrew-end (calendar-hebrew-from-absolute end-date))
290 (hebrew-y1 (extract-calendar-year hebrew-start))
291 (hebrew-y2 (extract-calendar-year hebrew-end)))
292 (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
293 (let ((date (calendar-gregorian-from-absolute
294 (calendar-absolute-from-hebrew
295 (list month day year)))))
296 (if (calendar-date-is-visible-p date)
297 (list (list date string))))))))
298
299(defun holiday-rosh-hashanah-etc ()
300 "List of dates related to Rosh Hashanah, as visible in calendar window."
301 (if (or (< displayed-month 8)
302 (> displayed-month 11))
303 nil;; None of the dates is visible
304 (let* ((abs-r-h (calendar-absolute-from-hebrew
305 (list 7 1 (+ displayed-year 3761))))
306 (mandatory
307 (list
308 (list (calendar-gregorian-from-absolute abs-r-h)
309 (format "Rosh HaShanah %d" (+ 3761 displayed-year)))
310 (list (calendar-gregorian-from-absolute (+ abs-r-h 9))
311 "Yom Kippur")
312 (list (calendar-gregorian-from-absolute (+ abs-r-h 14))
313 "Sukkot")
314 (list (calendar-gregorian-from-absolute (+ abs-r-h 21))
315 "Shemini Atzeret")
316 (list (calendar-gregorian-from-absolute (+ abs-r-h 22))
317 "Simchat Torah")))
318 (optional
319 (list
320 (list (calendar-gregorian-from-absolute
321 (calendar-dayname-on-or-before 6 (- abs-r-h 4)))
322 "Selichot (night)")
323 (list (calendar-gregorian-from-absolute (1- abs-r-h))
2e3befba 324 "Erev Rosh HaShanah")
4b112ac4
ER
325 (list (calendar-gregorian-from-absolute (1+ abs-r-h))
326 "Rosh HaShanah (second day)")
327 (list (calendar-gregorian-from-absolute
328 (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2)))
329 "Tzom Gedaliah")
330 (list (calendar-gregorian-from-absolute
331 (calendar-dayname-on-or-before 6 (+ 7 abs-r-h)))
332 "Shabbat Shuvah")
333 (list (calendar-gregorian-from-absolute (+ abs-r-h 8))
334 "Erev Yom Kippur")
335 (list (calendar-gregorian-from-absolute (+ abs-r-h 13))
336 "Erev Sukkot")
337 (list (calendar-gregorian-from-absolute (+ abs-r-h 15))
338 "Sukkot (second day)")
339 (list (calendar-gregorian-from-absolute (+ abs-r-h 16))
340 "Hol Hamoed Sukkot (first day)")
341 (list (calendar-gregorian-from-absolute (+ abs-r-h 17))
342 "Hol Hamoed Sukkot (second day)")
343 (list (calendar-gregorian-from-absolute (+ abs-r-h 18))
344 "Hol Hamoed Sukkot (third day)")
345 (list (calendar-gregorian-from-absolute (+ abs-r-h 19))
346 "Hol Hamoed Sukkot (fourth day)")
347 (list (calendar-gregorian-from-absolute (+ abs-r-h 20))
348 "Hoshannah Rabbah")))
349 (output-list
350 (filter-visible-calendar-holidays mandatory)))
351 (if all-hebrew-calendar-holidays
352 (setq output-list
353 (append
354 (filter-visible-calendar-holidays optional)
355 output-list)))
356 output-list)))
357
358(defun holiday-hanukkah ()
359 "List of dates related to Hanukkah, as visible in calendar window."
360 (if (memq displayed-month;; This test is only to speed things up a bit;
361 '(10 11 12 1 2));; it works fine without the test too.
362 (let ((m displayed-month)
363 (y displayed-year))
364 (increment-calendar-month m y 1)
365 (let* ((h-y (extract-calendar-year
366 (calendar-hebrew-from-absolute
367 (calendar-absolute-from-gregorian
368 (list m (calendar-last-day-of-month m y) y)))))
369 (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y))))
370 (filter-visible-calendar-holidays
371 (list
372 (list (calendar-gregorian-from-absolute (1- abs-h))
373 "Erev Hanukkah")
374 (list (calendar-gregorian-from-absolute abs-h)
375 "Hanukkah (first day)")
376 (list (calendar-gregorian-from-absolute (1+ abs-h))
377 "Hanukkah (second day)")
378 (list (calendar-gregorian-from-absolute (+ abs-h 2))
379 "Hanukkah (third day)")
380 (list (calendar-gregorian-from-absolute (+ abs-h 3))
381 "Hanukkah (fourth day)")
382 (list (calendar-gregorian-from-absolute (+ abs-h 4))
383 "Hanukkah (fifth day)")
384 (list (calendar-gregorian-from-absolute (+ abs-h 5))
385 "Hanukkah (sixth day)")
386 (list (calendar-gregorian-from-absolute (+ abs-h 6))
387 "Hanukkah (seventh day)")
388 (list (calendar-gregorian-from-absolute (+ abs-h 7))
389 "Hanukkah (eighth day)")))))))
390
391(defun holiday-passover-etc ()
392 "List of dates related to Passover, as visible in calendar window."
393 (if (< 7 displayed-month)
394 nil;; None of the dates is visible
395 (let* ((abs-p (calendar-absolute-from-hebrew
396 (list 1 15 (+ displayed-year 3760))))
397 (mandatory
398 (list
399 (list (calendar-gregorian-from-absolute abs-p)
400 "Passover")
401 (list (calendar-gregorian-from-absolute (+ abs-p 50))
402 "Shavuot")))
403 (optional
404 (list
405 (list (calendar-gregorian-from-absolute
406 (calendar-dayname-on-or-before 6 (- abs-p 43)))
407 "Shabbat Shekalim")
408 (list (calendar-gregorian-from-absolute
409 (calendar-dayname-on-or-before 6 (- abs-p 30)))
410 "Shabbat Zachor")
411 (list (calendar-gregorian-from-absolute
412 (if (= (% abs-p 7) 2) (- abs-p 33) (- abs-p 31)))
413 "Fast of Esther")
414 (list (calendar-gregorian-from-absolute (- abs-p 31))
415 "Erev Purim")
416 (list (calendar-gregorian-from-absolute (- abs-p 30))
417 "Purim")
418 (list (calendar-gregorian-from-absolute
419 (if (zerop (% abs-p 7)) (- abs-p 28) (- abs-p 29)))
420 "Shushan Purim")
421 (list (calendar-gregorian-from-absolute
422 (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7))
423 "Shabbat Parah")
424 (list (calendar-gregorian-from-absolute
425 (calendar-dayname-on-or-before 6 (- abs-p 14)))
426 "Shabbat HaHodesh")
427 (list (calendar-gregorian-from-absolute
428 (calendar-dayname-on-or-before 6 (1- abs-p)))
429 "Shabbat HaGadol")
430 (list (calendar-gregorian-from-absolute (1- abs-p))
431 "Erev Passover")
432 (list (calendar-gregorian-from-absolute (1+ abs-p))
433 "Passover (second day)")
434 (list (calendar-gregorian-from-absolute (+ abs-p 2))
435 "Hol Hamoed Passover (first day)")
436 (list (calendar-gregorian-from-absolute (+ abs-p 3))
437 "Hol Hamoed Passover (second day)")
438 (list (calendar-gregorian-from-absolute (+ abs-p 4))
439 "Hol Hamoed Passover (third day)")
440 (list (calendar-gregorian-from-absolute (+ abs-p 5))
441 "Hol Hamoed Passover (fourth day)")
442 (list (calendar-gregorian-from-absolute (+ abs-p 6))
443 "Passover (seventh day)")
444 (list (calendar-gregorian-from-absolute (+ abs-p 7))
445 "Passover (eighth day)")
bbc054a9
RS
446 (list (calendar-gregorian-from-absolute
447 (if (zerop (% (+ abs-p 12) 7))
448 (+ abs-p 13)
449 (+ abs-p 12)))
4b112ac4
ER
450 "Yom HaShoah")
451 (list (calendar-gregorian-from-absolute
452 (if (zerop (% abs-p 7))
453 (+ abs-p 18)
454 (if (= (% abs-p 7) 6)
455 (+ abs-p 19)
456 (+ abs-p 20))))
457 "Yom HaAtzma'ut")
458 (list (calendar-gregorian-from-absolute (+ abs-p 33))
459 "Lag BaOmer")
460 (list (calendar-gregorian-from-absolute (+ abs-p 43))
8f596798 461 "Yom Yerushalaim")
4b112ac4
ER
462 (list (calendar-gregorian-from-absolute (+ abs-p 49))
463 "Erev Shavuot")
464 (list (calendar-gregorian-from-absolute (+ abs-p 51))
465 "Shavuot (second day)")))
466 (output-list
467 (filter-visible-calendar-holidays mandatory)))
468 (if all-hebrew-calendar-holidays
469 (setq output-list
470 (append
471 (filter-visible-calendar-holidays optional)
472 output-list)))
473 output-list)))
474
475(defun holiday-tisha-b-av-etc ()
476 "List of dates around Tisha B'Av, as visible in calendar window."
477 (if (or (< displayed-month 5)
478 (> displayed-month 9))
479 nil;; None of the dates is visible
480 (let* ((abs-t-a (calendar-absolute-from-hebrew
481 (list 5 9 (+ displayed-year 3760)))))
482
483 (filter-visible-calendar-holidays
484 (list
485 (list (calendar-gregorian-from-absolute
486 (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))
487 "Tzom Tammuz")
488 (list (calendar-gregorian-from-absolute
489 (calendar-dayname-on-or-before 6 abs-t-a))
490 "Shabbat Hazon")
491 (list (calendar-gregorian-from-absolute
492 (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a))
493 "Tisha B'Av")
494 (list (calendar-gregorian-from-absolute
495 (calendar-dayname-on-or-before 6 (+ abs-t-a 7)))
496 "Shabbat Nahamu"))))))
497
498(defun list-hebrew-diary-entries ()
499 "Add any Hebrew date entries from the diary file to `diary-entries-list'.
500Hebrew date diary entries must be prefaced by `hebrew-diary-entry-symbol'
501\(normally an `H'). The same diary date forms govern the style of the Hebrew
502calendar entries, except that the Hebrew month names must be spelled in full.
503The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
504Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
505common Hebrew year. If a Hebrew date diary entry begins with a
506`diary-nonmarking-symbol', the entry will appear in the diary listing, but will
507not be marked in the calendar. This function is provided for use with the
508`nongregorian-diary-listing-hook'."
509 (if (< 0 number)
510 (let ((buffer-read-only nil)
511 (diary-modified (buffer-modified-p))
512 (gdate original-date)
513 (mark (regexp-quote diary-nonmarking-symbol)))
514 (calendar-for-loop i from 1 to number do
515 (let* ((d diary-date-forms)
516 (hdate (calendar-hebrew-from-absolute
517 (calendar-absolute-from-gregorian gdate)))
518 (month (extract-calendar-month hdate))
519 (day (extract-calendar-day hdate))
520 (year (extract-calendar-year hdate)))
521 (while d
522 (let*
523 ((date-form (if (equal (car (car d)) 'backup)
524 (cdr (car d))
525 (car d)))
526 (backup (equal (car (car d)) 'backup))
527 (dayname
528 (concat
529 (calendar-day-name gdate) "\\|"
530 (substring (calendar-day-name gdate) 0 3) ".?"))
531 (calendar-month-name-array
532 calendar-hebrew-month-name-array-leap-year)
533 (monthname
534 (concat
535 "\\*\\|"
536 (calendar-month-name month)))
537 (month (concat "\\*\\|0*" (int-to-string month)))
538 (day (concat "\\*\\|0*" (int-to-string day)))
539 (year
540 (concat
541 "\\*\\|0*" (int-to-string year)
542 (if abbreviated-calendar-year
543 (concat "\\|" (int-to-string (% year 100)))
544 "")))
545 (regexp
546 (concat
547 "\\(\\`\\|\^M\\|\n\\)" mark "?"
548 (regexp-quote hebrew-diary-entry-symbol)
549 "\\("
550 (mapconcat 'eval date-form "\\)\\(")
551 "\\)"))
552 (case-fold-search t))
553 (goto-char (point-min))
554 (while (re-search-forward regexp nil t)
555 (if backup (re-search-backward "\\<" nil t))
556 (if (and (or (char-equal (preceding-char) ?\^M)
557 (char-equal (preceding-char) ?\n))
558 (not (looking-at " \\|\^I")))
559 ;; Diary entry that consists only of date.
560 (backward-char 1)
561 ;; Found a nonempty diary entry--make it visible and
562 ;; add it to the list.
563 (let ((entry-start (point))
564 (date-start))
565 (re-search-backward "\^M\\|\n\\|\\`")
566 (setq date-start (point))
567 (re-search-forward "\^M\\|\n" nil t 2)
568 (while (looking-at " \\|\^I")
569 (re-search-forward "\^M\\|\n" nil t))
570 (backward-char 1)
571 (subst-char-in-region date-start (point) ?\^M ?\n t)
572 (add-to-diary-list
f674d9ac
KH
573 gdate
574 (buffer-substring-no-properties entry-start (point))
575 (buffer-substring-no-properties
576 (1+ date-start) (1- entry-start)))))))
4b112ac4
ER
577 (setq d (cdr d))))
578 (setq gdate
579 (calendar-gregorian-from-absolute
580 (1+ (calendar-absolute-from-gregorian gdate)))))
581 (set-buffer-modified-p diary-modified))
582 (goto-char (point-min))))
583
584(defun mark-hebrew-diary-entries ()
585 "Mark days in the calendar window that have Hebrew date diary entries.
586Each entry in diary-file (or included files) visible in the calendar window
587is marked. Hebrew date entries are prefaced by a hebrew-diary-entry-symbol
588\(normally an `H'). The same diary-date-forms govern the style of the Hebrew
589calendar entries, except that the Hebrew month names must be spelled in full.
590The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
591Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
592common Hebrew year. Hebrew date diary entries that begin with a
593diary-nonmarking symbol will not be marked in the calendar. This function
594is provided for use as part of the nongregorian-diary-marking-hook."
595 (let ((d diary-date-forms))
596 (while d
597 (let*
598 ((date-form (if (equal (car (car d)) 'backup)
599 (cdr (car d))
600 (car d)));; ignore 'backup directive
601 (dayname (diary-name-pattern calendar-day-name-array))
602 (monthname
603 (concat
604 (diary-name-pattern calendar-hebrew-month-name-array-leap-year t)
605 "\\|\\*"))
606 (month "[0-9]+\\|\\*")
607 (day "[0-9]+\\|\\*")
608 (year "[0-9]+\\|\\*")
609 (l (length date-form))
610 (d-name-pos (- l (length (memq 'dayname date-form))))
611 (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
612 (m-name-pos (- l (length (memq 'monthname date-form))))
613 (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
614 (d-pos (- l (length (memq 'day date-form))))
615 (d-pos (if (/= l d-pos) (+ 2 d-pos)))
616 (m-pos (- l (length (memq 'month date-form))))
617 (m-pos (if (/= l m-pos) (+ 2 m-pos)))
618 (y-pos (- l (length (memq 'year date-form))))
619 (y-pos (if (/= l y-pos) (+ 2 y-pos)))
620 (regexp
621 (concat
622 "\\(\\`\\|\^M\\|\n\\)"
623 (regexp-quote hebrew-diary-entry-symbol)
624 "\\("
625 (mapconcat 'eval date-form "\\)\\(")
626 "\\)"))
627 (case-fold-search t))
628 (goto-char (point-min))
629 (while (re-search-forward regexp nil t)
630 (let* ((dd-name
631 (if d-name-pos
632 (buffer-substring
633 (match-beginning d-name-pos)
634 (match-end d-name-pos))))
635 (mm-name
636 (if m-name-pos
637 (buffer-substring
638 (match-beginning m-name-pos)
639 (match-end m-name-pos))))
640 (mm (string-to-int
641 (if m-pos
642 (buffer-substring
643 (match-beginning m-pos)
644 (match-end m-pos))
645 "")))
646 (dd (string-to-int
647 (if d-pos
648 (buffer-substring
649 (match-beginning d-pos)
650 (match-end d-pos))
651 "")))
652 (y-str (if y-pos
653 (buffer-substring
654 (match-beginning y-pos)
655 (match-end y-pos))))
656 (yy (if (not y-str)
657 0
658 (if (and (= (length y-str) 2)
659 abbreviated-calendar-year)
660 (let* ((current-y
661 (extract-calendar-year
662 (calendar-hebrew-from-absolute
663 (calendar-absolute-from-gregorian
664 (calendar-current-date)))))
665 (y (+ (string-to-int y-str)
666 (* 100 (/ current-y 100)))))
667 (if (> (- y current-y) 50)
668 (- y 100)
669 (if (> (- current-y y) 50)
670 (+ y 100)
671 y)))
672 (string-to-int y-str)))))
673 (if dd-name
674 (mark-calendar-days-named
bf7b2caf
RS
675 (cdr (assoc-ignore-case
676 (substring dd-name 0 3)
677 (calendar-make-alist
678 calendar-day-name-array
679 0
680 '(lambda (x) (substring x 0 3))))))
4b112ac4
ER
681 (if mm-name
682 (if (string-equal mm-name "*")
683 (setq mm 0)
684 (setq
685 mm
686 (cdr
bf7b2caf
RS
687 (assoc-ignore-case
688 mm-name
689 (calendar-make-alist
690 calendar-hebrew-month-name-array-leap-year))))))
4b112ac4
ER
691 (mark-hebrew-calendar-date-pattern mm dd yy)))))
692 (setq d (cdr d)))))
693
694(defun mark-hebrew-calendar-date-pattern (month day year)
695 "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
696A value of 0 in any position is a wildcard."
697 (save-excursion
698 (set-buffer calendar-buffer)
699 (if (and (/= 0 month) (/= 0 day))
700 (if (/= 0 year)
701 ;; Fully specified Hebrew date.
702 (let ((date (calendar-gregorian-from-absolute
703 (calendar-absolute-from-hebrew
704 (list month day year)))))
705 (if (calendar-date-is-visible-p date)
706 (mark-visible-calendar-date date)))
707 ;; Month and day in any year--this taken from the holiday stuff.
708 (if (memq displayed-month;; This test is only to speed things up a
709 (list ;; bit; it works fine without the test too.
710 (if (< 11 month) (- month 11) (+ month 1))
711 (if (< 10 month) (- month 10) (+ month 2))
712 (if (< 9 month) (- month 9) (+ month 3))
713 (if (< 8 month) (- month 8) (+ month 4))
714 (if (< 7 month) (- month 7) (+ month 5))))
715 (let ((m1 displayed-month)
716 (y1 displayed-year)
717 (m2 displayed-month)
718 (y2 displayed-year)
719 (year))
720 (increment-calendar-month m1 y1 -1)
721 (increment-calendar-month m2 y2 1)
722 (let* ((start-date (calendar-absolute-from-gregorian
723 (list m1 1 y1)))
724 (end-date (calendar-absolute-from-gregorian
725 (list m2
726 (calendar-last-day-of-month m2 y2)
727 y2)))
728 (hebrew-start
729 (calendar-hebrew-from-absolute start-date))
730 (hebrew-end (calendar-hebrew-from-absolute end-date))
731 (hebrew-y1 (extract-calendar-year hebrew-start))
732 (hebrew-y2 (extract-calendar-year hebrew-end)))
733 (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
734 (let ((date (calendar-gregorian-from-absolute
735 (calendar-absolute-from-hebrew
736 (list month day year)))))
737 (if (calendar-date-is-visible-p date)
738 (mark-visible-calendar-date date)))))))
739 ;; Not one of the simple cases--check all visible dates for match.
740 ;; Actually, the following code takes care of ALL of the cases, but
741 ;; it's much too slow to be used for the simple (common) cases.
742 (let ((m displayed-month)
743 (y displayed-year)
744 (first-date)
745 (last-date))
746 (increment-calendar-month m y -1)
747 (setq first-date
748 (calendar-absolute-from-gregorian
749 (list m 1 y)))
750 (increment-calendar-month m y 2)
751 (setq last-date
752 (calendar-absolute-from-gregorian
753 (list m (calendar-last-day-of-month m y) y)))
754 (calendar-for-loop date from first-date to last-date do
755 (let* ((h-date (calendar-hebrew-from-absolute date))
756 (h-month (extract-calendar-month h-date))
757 (h-day (extract-calendar-day h-date))
758 (h-year (extract-calendar-year h-date)))
759 (and (or (zerop month)
760 (= month h-month))
761 (or (zerop day)
762 (= day h-day))
763 (or (zerop year)
764 (= year h-year))
765 (mark-visible-calendar-date
766 (calendar-gregorian-from-absolute date)))))))))
767
768(defun insert-hebrew-diary-entry (arg)
769 "Insert a diary entry.
770For the Hebrew date corresponding to the date indicated by point.
771Prefix arg will make the entry nonmarking."
772 (interactive "P")
773 (let* ((calendar-month-name-array
774 calendar-hebrew-month-name-array-leap-year))
775 (make-diary-entry
776 (concat
777 hebrew-diary-entry-symbol
778 (calendar-date-string
779 (calendar-hebrew-from-absolute
780 (calendar-absolute-from-gregorian
781 (calendar-cursor-to-date t)))
782 nil t))
783 arg)))
784
785(defun insert-monthly-hebrew-diary-entry (arg)
786 "Insert a monthly diary entry.
787For the day of the Hebrew month corresponding to the date indicated by point.
788Prefix arg will make the entry nonmarking."
789 (interactive "P")
790 (let* ((calendar-date-display-form
791 (if european-calendar-style '(day " * ") '("* " day )))
792 (calendar-month-name-array
793 calendar-hebrew-month-name-array-leap-year))
794 (make-diary-entry
795 (concat
796 hebrew-diary-entry-symbol
797 (calendar-date-string
798 (calendar-hebrew-from-absolute
799 (calendar-absolute-from-gregorian
800 (calendar-cursor-to-date t)))))
801 arg)))
802
803(defun insert-yearly-hebrew-diary-entry (arg)
804 "Insert an annual diary entry.
805For the day of the Hebrew year corresponding to the date indicated by point.
806Prefix arg will make the entry nonmarking."
807 (interactive "P")
808 (let* ((calendar-date-display-form
809 (if european-calendar-style
810 '(day " " monthname)
811 '(monthname " " day)))
812 (calendar-month-name-array
813 calendar-hebrew-month-name-array-leap-year))
814 (make-diary-entry
815 (concat
816 hebrew-diary-entry-symbol
817 (calendar-date-string
818 (calendar-hebrew-from-absolute
819 (calendar-absolute-from-gregorian
820 (calendar-cursor-to-date t)))))
821 arg)))
822
823;;;###autoload
824(defun list-yahrzeit-dates (death-date start-year end-year)
825 "List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR.
826When called interactively from the calendar window, the date of death is taken
827from the cursor position."
828 (interactive
829 (let* ((death-date
830 (if (equal (current-buffer) (get-buffer calendar-buffer))
831 (calendar-cursor-to-date)
832 (let* ((today (calendar-current-date))
833 (year (calendar-read
834 "Year of death (>0): "
835 '(lambda (x) (> x 0))
836 (int-to-string (extract-calendar-year today))))
837 (month-array calendar-month-name-array)
838 (completion-ignore-case t)
bf7b2caf
RS
839 (month (cdr (assoc-ignore-case
840 (completing-read
841 "Month of death (name): "
842 (mapcar 'list (append month-array nil))
843 nil t)
844 (calendar-make-alist month-array 1))))
4b112ac4
ER
845 (last (calendar-last-day-of-month month year))
846 (day (calendar-read
847 (format "Day of death (1-%d): " last)
848 '(lambda (x) (and (< 0 x) (<= x last))))))
849 (list month day year))))
850 (death-year (extract-calendar-year death-date))
851 (start-year (calendar-read
852 (format "Starting year of Yahrzeit table (>%d): "
853 death-year)
854 '(lambda (x) (> x death-year))
855 (int-to-string (1+ death-year))))
856 (end-year (calendar-read
857 (format "Ending year of Yahrzeit table (>=%d): "
858 start-year)
859 '(lambda (x) (>= x start-year)))))
860 (list death-date start-year end-year)))
861 (message "Computing yahrzeits...")
862 (let* ((yahrzeit-buffer "*Yahrzeits*")
863 (h-date (calendar-hebrew-from-absolute
864 (calendar-absolute-from-gregorian death-date)))
865 (h-month (extract-calendar-month h-date))
866 (h-day (extract-calendar-day h-date))
867 (h-year (extract-calendar-year h-date)))
868 (set-buffer (get-buffer-create yahrzeit-buffer))
869 (setq buffer-read-only nil)
870 (calendar-set-mode-line
871 (format "Yahrzeit dates for %s = %s"
872 (calendar-date-string death-date)
873 (let ((calendar-month-name-array
874 (if (hebrew-calendar-leap-year-p h-year)
875 calendar-hebrew-month-name-array-leap-year
876 calendar-hebrew-month-name-array-common-year)))
877 (calendar-date-string h-date nil t))))
878 (erase-buffer)
879 (goto-char (point-min))
880 (calendar-for-loop i from start-year to end-year do
881 (insert
882 (calendar-date-string
883 (calendar-gregorian-from-absolute
884 (hebrew-calendar-yahrzeit
885 h-date
886 (extract-calendar-year
887 (calendar-hebrew-from-absolute
888 (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n"))
889 (goto-char (point-min))
890 (set-buffer-modified-p nil)
891 (setq buffer-read-only t)
892 (display-buffer yahrzeit-buffer)
893 (message "Computing yahrzeits...done")))
894
895(defun diary-hebrew-date ()
896 "Hebrew calendar equivalent of date diary entry."
897 (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
898
899(defun diary-omer ()
900 "Omer count diary entry.
901Entry applies if date is within 50 days after Passover."
902 (let* ((passover
903 (calendar-absolute-from-hebrew
904 (list 1 15 (+ (extract-calendar-year date) 3760))))
905 (omer (- (calendar-absolute-from-gregorian date) passover))
906 (week (/ omer 7))
907 (day (% omer 7)))
908 (if (and (> omer 0) (< omer 50))
909 (format "Day %d%s of the omer (until sunset)"
910 omer
911 (if (zerop week)
912 ""
913 (format ", that is, %d week%s%s"
914 week
915 (if (= week 1) "" "s")
916 (if (zerop day)
917 ""
918 (format " and %d day%s"
919 day (if (= day 1) "" "s")))))))))
920
921(defun diary-yahrzeit (death-month death-day death-year)
922 "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
923Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
924to be the name of the person. Date of death is on the *civil* calendar;
925although the date of death is specified by the civil calendar, the proper
926Hebrew calendar yahrzeit is determined. If `european-calendar-style' is t, the
927order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR."
928 (let* ((h-date (calendar-hebrew-from-absolute
929 (calendar-absolute-from-gregorian
930 (if european-calendar-style
931 (list death-day death-month death-year)
932 (list death-month death-day death-year)))))
933 (h-month (extract-calendar-month h-date))
934 (h-day (extract-calendar-day h-date))
935 (h-year (extract-calendar-year h-date))
936 (d (calendar-absolute-from-gregorian date))
937 (yr (extract-calendar-year (calendar-hebrew-from-absolute d)))
938 (diff (- yr h-year))
939 (y (hebrew-calendar-yahrzeit h-date yr)))
940 (if (and (> diff 0) (or (= y d) (= y (1+ d))))
941 (format "Yahrzeit of %s%s: %d%s anniversary"
942 entry
943 (if (= y d) "" " (evening)")
944 diff
945 (cond ((= (% diff 10) 1) "st")
946 ((= (% diff 10) 2) "nd")
947 ((= (% diff 10) 3) "rd")
948 (t "th"))))))
949
950(defun diary-rosh-hodesh ()
951 "Rosh Hodesh diary entry.
952Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
953 (let* ((d (calendar-absolute-from-gregorian date))
954 (h-date (calendar-hebrew-from-absolute d))
955 (h-month (extract-calendar-month h-date))
956 (h-day (extract-calendar-day h-date))
957 (h-year (extract-calendar-year h-date))
958 (leap-year (hebrew-calendar-leap-year-p h-year))
959 (last-day (hebrew-calendar-last-day-of-month h-month h-year))
960 (h-month-names
961 (if leap-year
962 calendar-hebrew-month-name-array-leap-year
963 calendar-hebrew-month-name-array-common-year))
964 (this-month (aref h-month-names (1- h-month)))
965 (h-yesterday (extract-calendar-day
966 (calendar-hebrew-from-absolute (1- d)))))
967 (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
968 (format
969 "Rosh Hodesh %s"
970 (if (= h-day 30)
971 (format
972 "%s (first day)"
973 ;; next month must be in the same year since this
974 ;; month can't be the last month of the year since
975 ;; it has 30 days
976 (aref h-month-names h-month))
977 (if (= h-yesterday 30)
978 (format "%s (second day)" this-month)
979 this-month)))
980 (if (= (% d 7) 6);; Saturday--check for Shabbat Mevarhim
981 (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
982 (format "Mevarhim Rosh Hodesh %s (%s)"
983 (aref h-month-names
984 (if (= h-month
985 (hebrew-calendar-last-month-of-year
986 h-year))
987 0 h-month))
988 (aref calendar-day-name-array (- 29 h-day))))
989 ((and (< h-day 30) (> h-day 22) (= 30 last-day))
990 (format "Mevarhim Rosh Hodesh %s (%s-%s)"
991 (aref h-month-names h-month)
992 (if (= h-day 29)
993 "tomorrow"
994 (aref calendar-day-name-array (- 29 h-day)))
995 (aref calendar-day-name-array
996 (% (- 30 h-day) 7)))))
997 (if (and (= h-day 29) (/= h-month 6))
998 (format "Erev Rosh Hodesh %s"
999 (aref h-month-names
1000 (if (= h-month
1001 (hebrew-calendar-last-month-of-year
1002 h-year))
1003 0 h-month))))))))
1004
1005(defun diary-parasha ()
1006 "Parasha diary entry--entry applies if date is a Saturday."
1007 (let ((d (calendar-absolute-from-gregorian date)))
1008 (if (= (% d 7) 6);; Saturday
1009 (let*
1010 ((h-year (extract-calendar-year
1011 (calendar-hebrew-from-absolute d)))
2e3befba 1012 (rosh-hashanah
4b112ac4
ER
1013 (calendar-absolute-from-hebrew (list 7 1 h-year)))
1014 (passover
1015 (calendar-absolute-from-hebrew (list 1 15 h-year)))
2e3befba
PE
1016 (rosh-hashanah-day
1017 (aref calendar-day-name-array (% rosh-hashanah 7)))
4b112ac4
ER
1018 (passover-day
1019 (aref calendar-day-name-array (% passover 7)))
1020 (long-h (hebrew-calendar-long-heshvan-p h-year))
1021 (short-k (hebrew-calendar-short-kislev-p h-year))
1022 (type (cond ((and long-h (not short-k)) "complete")
1023 ((and (not long-h) short-k) "incomplete")
1024 (t "regular")))
1025 (year-format
1026 (symbol-value
1027 (intern (format "hebrew-calendar-year-%s-%s-%s";; keviah
2e3befba 1028 rosh-hashanah-day type passover-day))))
4b112ac4 1029 (first-saturday;; of Hebrew year
2e3befba 1030 (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah)))
4b112ac4
ER
1031 (saturday;; which Saturday of the Hebrew year
1032 (/ (- d first-saturday) 7))
1033 (parasha (aref year-format saturday)))
1034 (if parasha
1035 (format
1036 "Parashat %s"
1037 (if (listp parasha);; Israel differs from diaspora
1038 (if (car parasha)
1039 (format "%s (diaspora), %s (Israel)"
1040 (hebrew-calendar-parasha-name (car parasha))
1041 (hebrew-calendar-parasha-name (cdr parasha)))
1042 (format "%s (Israel)"
1043 (hebrew-calendar-parasha-name (cdr parasha))))
1044 (hebrew-calendar-parasha-name parasha))))))))
1045
1046(defvar hebrew-calendar-parashiot-names
1047["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth"
1048 "Vayetze" "Vayishlah" "Vayeshev" "Mikketz" "Vayiggash" "Vayhi"
1049 "Shemoth" "Vaera" "Bo" "Beshallah" "Yithro" "Mishpatim"
1050 "Terumah" "Tetzavveh" "Ki Tissa" "Vayakhel" "Pekudei" "Vayikra"
1051 "Tzav" "Shemini" "Tazria" "Metzora" "Aharei Moth" "Kedoshim"
1052 "Emor" "Behar" "Behukkotai" "Bemidbar" "Naso" "Behaalot'cha"
1053 "Shelah L'cha" "Korah" "Hukkath" "Balak" "Pinhas" "Mattoth"
1054 "Masei" "Devarim" "Vaethanan" "Ekev" "Reeh" "Shofetim"
1055 "Ki Tetze" "Ki Tavo" "Nitzavim" "Vayelech" "Haazinu"]
1056 "The names of the parashiot in the Torah.")
1057
1058;; The seven ordinary year types (keviot)
1059
1060(defconst hebrew-calendar-year-Saturday-incomplete-Sunday
1061 [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]
1062 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1063 43 44 45 46 47 48 49 50]
1064 "The structure of the parashiot.
1065Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have
106629 days), and has Passover start on Sunday.")
1067
1068(defconst hebrew-calendar-year-Saturday-complete-Tuesday
1069 [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]
1070 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1071 43 44 45 46 47 48 49 [50 51]]
1072 "The structure of the parashiot.
1073Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
1074have 30 days), and has Passover start on Tuesday.")
1075
1076(defconst hebrew-calendar-year-Monday-incomplete-Tuesday
1077 [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]
1078 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1079 43 44 45 46 47 48 49 [50 51]]
1080 "The structure of the parashiot.
1081Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
1082have 29 days), and has Passover start on Tuesday.")
1083
1084(defconst hebrew-calendar-year-Monday-complete-Thursday
1085 [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]
1086 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
1087 (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1088 "The structure of the parashiot.
1089Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
109030 days), and has Passover start on Thursday.")
1091
1092(defconst hebrew-calendar-year-Tuesday-regular-Thursday
1093 [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]
1094 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
1095 (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1096 "The structure of the parashiot.
1097Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
1098Kislev has 30 days), and has Passover start on Thursday.")
1099
1100(defconst hebrew-calendar-year-Thursday-regular-Saturday
1101 [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
1102 24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30)
1103 (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48
1104 49 50]
1105 "The structure of the parashiot.
1106Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and
1107Kislev has 30 days), and has Passover start on Saturday.")
1108
1109(defconst hebrew-calendar-year-Thursday-complete-Sunday
1110 [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
1111 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
1112 43 44 45 46 47 48 49 50]
1113 "The structure of the parashiot.
1114Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each
1115have 30 days), and has Passover start on Sunday.")
1116
1117;; The seven leap year types (keviot)
1118
1119(defconst hebrew-calendar-year-Saturday-incomplete-Tuesday
1120 [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
1121 23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42]
1122 43 44 45 46 47 48 49 [50 51]]
1123 "The structure of the parashiot.
1124Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each
1125have 29 days), and has Passover start on Tuesday.")
1126
1127(defconst hebrew-calendar-year-Saturday-complete-Thursday
1128 [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
1129 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
1130 (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1131 "The structure of the parashiot.
1132Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
1133have 30 days), and has Passover start on Thursday.")
1134
1135(defconst hebrew-calendar-year-Monday-incomplete-Thursday
1136 [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
1137 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
1138 (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
1139 "The structure of the parashiot.
1140Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
1141have 29 days), and has Passover start on Thursday.")
1142
1143(defconst hebrew-calendar-year-Monday-complete-Saturday
1144 [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
1145 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
1146 (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
1147 (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
1148 "The structure of the parashiot.
1149Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
115030 days), and has Passover start on Saturday.")
1151
1152(defconst hebrew-calendar-year-Tuesday-regular-Saturday
1153 [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
1154 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
1155 (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
1156 (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
1157 "The structure of the parashiot.
1158Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
1159Kislev has 30 days), and has Passover start on Saturday.")
1160
1161(defconst hebrew-calendar-year-Thursday-incomplete-Sunday
1162 [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
1163 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
1164 43 44 45 46 47 48 49 50]
1165 "The structure of the parashiot.
1166Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both
1167have 29 days), and has Passover start on Sunday.")
1168
1169(defconst hebrew-calendar-year-Thursday-complete-Tuesday
1170 [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
1171 23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
1172 43 44 45 46 47 48 49 [50 51]]
1173 "The structure of the parashiot.
1174Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
1175have 30 days), and has Passover start on Tuesday.")
1176
1177(defun hebrew-calendar-parasha-name (p)
1178 "Name(s) corresponding to parasha P."
1179 (if (arrayp p);; combined parasha
1180 (format "%s/%s"
1181 (aref hebrew-calendar-parashiot-names (aref p 0))
1182 (aref hebrew-calendar-parashiot-names (aref p 1)))
1183 (aref hebrew-calendar-parashiot-names p)))
1184
1185(provide 'cal-hebrew)
1186
1187;;; cal-hebrew.el ends here