Commit | Line | Data |
---|---|---|
1802278a JB |
1 | ;; Holiday functions. |
2 | ;; Copyright (C) 1989, 1990, 1991 Free Software Foundation, Inc. | |
3 | ||
4 | ;; This file is part of GNU Emacs. | |
5 | ||
6 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
7 | ;; but WITHOUT ANY WARRANTY. No author or distributor | |
8 | ;; accepts responsibility to anyone for the consequences of using it | |
9 | ;; or for whether it serves any particular purpose or works at all, | |
10 | ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
11 | ;; License for full details. | |
12 | ||
13 | ;; Everyone is granted permission to copy, modify and redistribute | |
14 | ;; GNU Emacs, but only under the conditions described in the | |
15 | ;; GNU Emacs General Public License. A copy of this license is | |
16 | ;; supposed to have been given to you along with GNU Emacs so you | |
17 | ;; can know your rights and responsibilities. It should be in a | |
18 | ;; file named COPYING. Among other things, the copyright notice | |
19 | ;; and this notice must be preserved on all copies. | |
20 | ||
21 | ;; This collection of functions implements the holiday features as described | |
22 | ;; in calendar.el. | |
23 | ||
24 | ;; Comments, corrections, and improvements should be sent to | |
25 | ;; Edward M. Reingold Department of Computer Science | |
26 | ;; (217) 333-6733 University of Illinois at Urbana-Champaign | |
27 | ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue | |
28 | ;; Urbana, Illinois 61801 | |
29 | ||
30 | ;; Technical details of all the calendrical calculations can be found in | |
31 | ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, | |
32 | ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990), | |
33 | ;; pages 899-928. | |
34 | ||
35 | (require 'calendar) | |
1802278a JB |
36 | (defun holidays () |
37 | "Display the holidays for last month, this month, and next month. | |
38 | This function is suitable for execution in a .emacs file." | |
39 | (interactive) | |
40 | (save-excursion | |
41 | (let* ((date (calendar-current-date)) | |
42 | (displayed-month (extract-calendar-month date)) | |
43 | (displayed-year (extract-calendar-year date))) | |
44 | (list-calendar-holidays)))) | |
45 | ||
46 | (defun check-calendar-holidays (date) | |
47 | "Check the list of holidays for any that occur on DATE. | |
48 | The value returned is a list of strings of relevant holiday descriptions. | |
49 | The holidays are those in the list calendar-holidays." | |
50 | (let* ((displayed-month (extract-calendar-month date)) | |
51 | (displayed-year (extract-calendar-year date)) | |
52 | (h (calendar-holiday-list)) | |
53 | (holiday-list)) | |
54 | (while h | |
55 | (if (calendar-date-equal date (car (car h))) | |
56 | (setq holiday-list (append holiday-list (cdr (car h))))) | |
57 | (setq h (cdr h))) | |
58 | holiday-list)) | |
59 | ||
60 | (defun calendar-cursor-holidays () | |
61 | "Find holidays for the date specified by the cursor in the calendar window." | |
62 | (interactive) | |
63 | (message "Checking holidays...") | |
64 | (let* ((date (calendar-cursor-to-date)) | |
65 | (date-string (calendar-date-string date)) | |
66 | (holiday-list (check-calendar-holidays date)) | |
67 | (holiday-string (mapconcat 'identity holiday-list "; ")) | |
68 | (msg (format "%s: %s" date-string holiday-string))) | |
69 | (if (not holiday-list) | |
70 | (message "No holidays known for %s" date-string) | |
71 | (if (<= (length msg) (screen-width)) | |
72 | (message msg) | |
73 | (set-buffer (get-buffer-create holiday-buffer)) | |
74 | (setq buffer-read-only nil) | |
75 | (setq mode-line-format | |
76 | (format "--------------------------%s%%-" | |
77 | date-string)) | |
78 | (erase-buffer) | |
79 | (insert (mapconcat 'identity holiday-list "\n")) | |
80 | (goto-char (point-min)) | |
81 | (set-buffer-modified-p nil) | |
82 | (setq buffer-read-only t) | |
83 | (display-buffer holiday-buffer) | |
84 | (message "Checking holidays...done"))))) | |
85 | ||
86 | (defun mark-calendar-holidays () | |
87 | "Mark notable days in the calendar window." | |
88 | (interactive) | |
89 | (setq mark-holidays-in-calendar t) | |
90 | (message "Marking holidays...") | |
91 | (let ((holiday-list (calendar-holiday-list))) | |
92 | (while holiday-list | |
93 | (mark-visible-calendar-date | |
94 | (car (car holiday-list)) calendar-holiday-marker) | |
95 | (setq holiday-list (cdr holiday-list)))) | |
96 | (message "Marking holidays...done")) | |
97 | ||
98 | (defun list-calendar-holidays () | |
99 | "Create a buffer containing the holidays for the current calendar window. | |
100 | The holidays are those in the list calendar-notable-days. Returns t if any | |
101 | holidays are found, nil if not." | |
102 | (interactive) | |
103 | (message "Looking up holidays...") | |
104 | (let ((holiday-list (calendar-holiday-list)) | |
105 | (m1 displayed-month) | |
106 | (y1 displayed-year) | |
107 | (m2 displayed-month) | |
108 | (y2 displayed-year)) | |
109 | (if (not holiday-list) | |
110 | (progn | |
111 | (message "Looking up holidays...none found") | |
112 | nil) | |
113 | (set-buffer (get-buffer-create holiday-buffer)) | |
114 | (setq buffer-read-only nil) | |
115 | (increment-calendar-month m1 y1 -1) | |
116 | (increment-calendar-month m2 y2 1) | |
117 | (setq mode-line-format | |
118 | (format "-------------Notable Dates from %s, %d to %s, %d%%-" | |
119 | (calendar-month-name m1) y1 (calendar-month-name m2) y2)) | |
120 | (erase-buffer) | |
121 | (insert | |
122 | (mapconcat | |
123 | '(lambda (x) (concat (calendar-date-string (car x)) | |
124 | ": " (car (cdr x)))) | |
125 | holiday-list "\n")) | |
126 | (goto-char (point-min)) | |
127 | (set-buffer-modified-p nil) | |
128 | (setq buffer-read-only t) | |
129 | (display-buffer holiday-buffer) | |
130 | (message "Looking up holidays...done") | |
131 | t))) | |
132 | ||
133 | (defun calendar-holiday-list () | |
134 | "Form the list of holidays that occur on dates in the calendar window. | |
135 | The holidays are those in the list calendar-holidays." | |
136 | (let ((p calendar-holidays) | |
137 | (holiday-list)) | |
138 | (while p | |
139 | (let* ((function-name | |
140 | (intern (format "calendar-holiday-function-%s" (car (car p))))) | |
141 | (holidays | |
142 | (if (cdr (car p));; optional arguments | |
143 | (funcall function-name (cdr (car p))) | |
144 | (funcall function-name)))) | |
145 | (if holidays | |
146 | (setq holiday-list (append holidays holiday-list)))) | |
147 | (setq p (cdr p))) | |
148 | (setq holiday-list (sort holiday-list 'calendar-date-compare)))) | |
149 | ||
150 | ;; Below are the functions that calculate the dates of holidays; these | |
151 | ;; are called by the funcall in the function calendar-holiday-list. If you | |
152 | ;; write other such functions, be sure to imitate the style used below, | |
153 | ;; including the evaluation of each element in the list that constitutes | |
154 | ;; the argument to the function. If you don't do this evaluation, the | |
155 | ;; list calendar-holidays cannot contain expressions (as, for example, in | |
156 | ;; the entry for the Islamic new year. Also remember that each function | |
157 | ;; must return a list of items of the form ((month day year) string); | |
158 | ;; the date (month day year) should be visible in the calendar window. | |
159 | ||
160 | (defun calendar-holiday-function-fixed (x) | |
161 | "Returns the corresponding Gregorian date, if visible in the window, to | |
162 | month, year where month is (car X) and year is (car (cdr X)). If it is | |
163 | visible, the value returned is the list (((month day year) string)) where | |
164 | string is (car (nthcdr 2 X)). Returns nil if it is not visible in the | |
165 | current calendar window." | |
166 | (let* ((month (eval (car x))) | |
167 | (day (eval (car (cdr x)))) | |
168 | (string (eval (car (nthcdr 2 x)))) | |
169 | (m displayed-month) | |
170 | (y displayed-year)) | |
171 | (increment-calendar-month m y (- 11 month)) | |
172 | (if (> m 9) | |
173 | (list (list (list month day y) string))))) | |
174 | ||
175 | (defun calendar-holiday-function-float (x) | |
176 | "Returns the corresponding Gregorian date, if visible in the window, to the | |
177 | n-th occurrence (negative counts from the end of the month) of dayname in | |
178 | month, year where month is (car X), year is (car (cdr X)), n is | |
179 | \(car \(nthcdr 2 X\)\). If it is visible, the value returned is the list | |
180 | \(\(\(month day year)\ string\)\) where string is (car (nthcdr 3 X)). | |
181 | Returns nil if it is not visible in the current calendar window." | |
182 | (let* ((month (eval (car x))) | |
183 | (dayname (eval (car (cdr x)))) | |
184 | (n (eval (car (nthcdr 2 x)))) | |
185 | (string (eval (car (nthcdr 3 x)))) | |
186 | (m displayed-month) | |
187 | (y displayed-year)) | |
188 | (increment-calendar-month m y (- 11 month)) | |
189 | (if (> m 9) | |
190 | (list (list (calendar-nth-named-day n dayname month y) string))))) | |
191 | ||
192 | (defun calendar-holiday-function-julian (x) | |
193 | "Returns the corresponding Gregorian date, if visible in the window, to the | |
194 | Julian date month, year where month is (car X) and year is (car (cdr X)). | |
195 | If it is visible, the value returned is the list (((month day year) string)) | |
196 | where string is (car (nthcdr 2 X)). Returns nil if it is not visible in the | |
197 | current calendar window." | |
198 | (let* ((month (eval (car x))) | |
199 | (day (eval (car (cdr x)))) | |
200 | (string (eval (car (nthcdr 2 x)))) | |
201 | (m1 displayed-month) | |
202 | (y1 displayed-year) | |
203 | (m2 displayed-month) | |
204 | (y2 displayed-year) | |
205 | (year)) | |
206 | (increment-calendar-month m1 y1 -1) | |
207 | (increment-calendar-month m2 y2 1) | |
208 | (let* ((start-date (calendar-absolute-from-gregorian | |
209 | (list m1 1 y1))) | |
210 | (end-date (calendar-absolute-from-gregorian | |
211 | (list m2 (calendar-last-day-of-month m2 y2) y2))) | |
212 | (julian-start (calendar-julian-from-absolute start-date)) | |
213 | (julian-end (calendar-julian-from-absolute end-date)) | |
214 | (julian-y1 (extract-calendar-year julian-start)) | |
215 | (julian-y2 (extract-calendar-year julian-end))) | |
216 | (setq year (if (< 10 month) julian-y1 julian-y2)) | |
217 | (let ((date (calendar-gregorian-from-absolute | |
218 | (calendar-absolute-from-julian | |
219 | (list month day year))))) | |
220 | (if (calendar-date-is-visible-p date) | |
221 | (list (list date string))))))) | |
222 | ||
223 | (defun calendar-holiday-function-islamic (x) | |
224 | "Returns the corresponding Gregorian date, if visible in the window, to the | |
225 | Islamic date month, day where month is (car X) and day is (car (cdr X)). | |
226 | If it is visible, the value returned is the list (((month day year) string)) | |
227 | where string is (car (nthcdr 2 X)). Returns nil if it is not visible in | |
228 | the current calendar window." | |
229 | (let* ((month (eval (car x))) | |
230 | (day (eval (car (cdr x)))) | |
231 | (string (eval (car (nthcdr 2 x)))) | |
232 | (islamic-date (calendar-islamic-from-absolute | |
233 | (calendar-absolute-from-gregorian | |
234 | (list displayed-month 15 displayed-year)))) | |
235 | (m (extract-calendar-month islamic-date)) | |
236 | (y (extract-calendar-year islamic-date)) | |
237 | (date)) | |
238 | (if (< m 1) | |
239 | nil;; Islamic calendar doesn't apply. | |
240 | (increment-calendar-month m y (- 10 month)) | |
241 | (if (> m 7);; Islamic date might be visible | |
242 | (let ((date (calendar-gregorian-from-absolute | |
243 | (calendar-absolute-from-islamic (list month day y))))) | |
244 | (if (calendar-date-is-visible-p date) | |
245 | (list (list date string)))))))) | |
246 | ||
247 | (defun calendar-holiday-function-hebrew (x) | |
248 | "Returns the corresponding Gregorian date, if visible in the window, to the | |
249 | Hebrew date month, day where month is (car X) and day is (car (cdr X)). | |
250 | If it is visible, the value returned is the list (((month day year) string)) | |
251 | where string is (car (nthcdr 2 X)). Returns nil if it is not visible in | |
252 | the current calendar window." | |
253 | (let* ((month (eval (car x))) | |
254 | (day (eval (car (cdr x)))) | |
255 | (string (eval (car (nthcdr 2 x))))) | |
256 | (if (memq displayed-month;; This test is only to speed things up a bit; | |
257 | (list ;; it works fine without the test too. | |
258 | (if (< 11 month) (- month 11) (+ month 1)) | |
259 | (if (< 10 month) (- month 10) (+ month 2)) | |
260 | (if (< 9 month) (- month 9) (+ month 3)) | |
261 | (if (< 8 month) (- month 8) (+ month 4)) | |
262 | (if (< 7 month) (- month 7) (+ month 5)))) | |
263 | (let ((m1 displayed-month) | |
264 | (y1 displayed-year) | |
265 | (m2 displayed-month) | |
266 | (y2 displayed-year) | |
267 | (year)) | |
268 | (increment-calendar-month m1 y1 -1) | |
269 | (increment-calendar-month m2 y2 1) | |
270 | (let* ((start-date (calendar-absolute-from-gregorian | |
271 | (list m1 1 y1))) | |
272 | (end-date (calendar-absolute-from-gregorian | |
273 | (list m2 (calendar-last-day-of-month m2 y2) y2))) | |
274 | (hebrew-start (calendar-hebrew-from-absolute start-date)) | |
275 | (hebrew-end (calendar-hebrew-from-absolute end-date)) | |
276 | (hebrew-y1 (extract-calendar-year hebrew-start)) | |
277 | (hebrew-y2 (extract-calendar-year hebrew-end))) | |
278 | (setq year (if (< 6 month) hebrew-y2 hebrew-y1)) | |
279 | (let ((date (calendar-gregorian-from-absolute | |
280 | (calendar-absolute-from-hebrew | |
281 | (list month day year))))) | |
282 | (if (calendar-date-is-visible-p date) | |
283 | (list (list date string))))))))) | |
284 | ||
285 | (defun calendar-holiday-function-if (x) | |
286 | "Conditional holiday for dates in the calendar window. | |
287 | The boolean condition is (car X). If t, the holiday (car (cdr X)) is | |
288 | checked. If nil, the holiday (car (cdr (cdr X))), if there, is checked." | |
289 | (let* ((boolean (eval (car x))) | |
290 | (h (if boolean (car (cdr x)) (car (cdr (cdr x)))))) | |
291 | (if h | |
292 | (let* ((function-name | |
293 | (intern (format "calendar-holiday-function-%s" (car h)))) | |
294 | (holidays | |
295 | (if (cdr h);; optional arguments | |
296 | (funcall function-name (cdr h)) | |
297 | (funcall function-name)))) | |
298 | holidays)))) | |
299 | ||
300 | (defun calendar-holiday-function-advent () | |
301 | "Date of Advent, if visible in calendar window." | |
302 | (let ((year displayed-year) | |
303 | (month displayed-month)) | |
304 | (increment-calendar-month month year -1) | |
305 | (let ((advent (calendar-gregorian-from-absolute | |
306 | (calendar-dayname-on-or-before 0 | |
307 | (calendar-absolute-from-gregorian | |
308 | (list 12 3 year)))))) | |
309 | (if (calendar-date-is-visible-p advent) | |
310 | (list (list advent "Advent")))))) | |
311 | ||
312 | (defun calendar-holiday-function-easter-etc () | |
313 | "List of dates related to Easter, as visible in calendar window." | |
314 | (if (and (> displayed-month 5) (not all-christian-calendar-holidays)) | |
315 | nil;; Ash Wednesday, Good Friday, and Easter are not visible. | |
316 | (let* ((century (1+ (/ displayed-year 100))) | |
317 | (shifted-epact ;; Age of moon for April 5... | |
318 | (% (+ 14 (* 11 (% displayed-year 19));; ...by Nicaean rule | |
319 | (- ;; ...corrected for the Gregorian century rule | |
320 | (/ (* 3 century) 4)) | |
321 | (/ ;; ...corrected for Metonic cycle inaccuracy. | |
322 | (+ 5 (* 8 century)) 25) | |
323 | (* 30 century));; Keeps value positive. | |
324 | 30)) | |
325 | (adjusted-epact ;; Adjust for 29.5 day month. | |
326 | (if (or (= shifted-epact 0) | |
327 | (and (= shifted-epact 1) (< 10 (% displayed-year 19)))) | |
328 | (1+ shifted-epact) | |
329 | shifted-epact)) | |
330 | (paschal-moon ;; Day after the full moon on or after March 21. | |
331 | (- (calendar-absolute-from-gregorian (list 4 19 displayed-year)) | |
332 | adjusted-epact)) | |
333 | (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7))) | |
334 | (mandatory | |
335 | (list | |
336 | (list (calendar-gregorian-from-absolute abs-easter) | |
337 | "Easter Sunday") | |
338 | (list (calendar-gregorian-from-absolute (- abs-easter 2)) | |
339 | "Good Friday") | |
340 | (list (calendar-gregorian-from-absolute (- abs-easter 46)) | |
341 | "Ash Wednesday"))) | |
342 | (optional | |
343 | (list | |
344 | (list (calendar-gregorian-from-absolute (- abs-easter 63)) | |
345 | "Septuagesima Sunday") | |
346 | (list (calendar-gregorian-from-absolute (- abs-easter 56)) | |
347 | "Sexagesima Sunday") | |
348 | (list (calendar-gregorian-from-absolute (- abs-easter 49)) | |
349 | "Shrove Sunday") | |
350 | (list (calendar-gregorian-from-absolute (- abs-easter 48)) | |
351 | "Shrove Monday") | |
352 | (list (calendar-gregorian-from-absolute (- abs-easter 47)) | |
353 | "Shrove Tuesday") | |
354 | (list (calendar-gregorian-from-absolute (- abs-easter 14)) | |
355 | "Passion Sunday") | |
356 | (list (calendar-gregorian-from-absolute (- abs-easter 7)) | |
357 | "Palm Sunday") | |
358 | (list (calendar-gregorian-from-absolute (- abs-easter 3)) | |
359 | "Maundy Thursday") | |
360 | (list (calendar-gregorian-from-absolute (+ abs-easter 35)) | |
361 | "Rogation Sunday") | |
362 | (list (calendar-gregorian-from-absolute (+ abs-easter 39)) | |
363 | "Ascension Sunday") | |
364 | (list (calendar-gregorian-from-absolute (+ abs-easter 49)) | |
365 | "Pentecost (Whitsunday)") | |
366 | (list (calendar-gregorian-from-absolute (+ abs-easter 50)) | |
367 | "Whitmunday") | |
368 | (list (calendar-gregorian-from-absolute (+ abs-easter 56)) | |
369 | "Trinity Sunday") | |
370 | (list (calendar-gregorian-from-absolute (+ abs-easter 60)) | |
371 | "Corpus Christi"))) | |
372 | (output-list | |
373 | (filter-visible-calendar-holidays mandatory))) | |
374 | (if all-christian-calendar-holidays | |
375 | (setq output-list | |
376 | (append | |
377 | (filter-visible-calendar-holidays optional) | |
378 | output-list))) | |
379 | output-list))) | |
380 | ||
381 | (defun calendar-holiday-function-rosh-hashanah-etc () | |
382 | "List of dates related to Rosh Hashanah, as visible in calendar window." | |
383 | (if (or (< displayed-month 8) | |
384 | (> displayed-month 11)) | |
385 | nil;; None of the dates is visible | |
386 | (let* ((abs-r-h (calendar-absolute-from-hebrew | |
387 | (list 7 1 (+ displayed-year 3761)))) | |
388 | (mandatory | |
389 | (list | |
390 | (list (calendar-gregorian-from-absolute abs-r-h) | |
391 | (format "Rosh HaShanah %d" (+ 3761 displayed-year))) | |
392 | (list (calendar-gregorian-from-absolute (+ abs-r-h 9)) | |
393 | "Yom Kippur") | |
394 | (list (calendar-gregorian-from-absolute (+ abs-r-h 14)) | |
395 | "Sukkot") | |
396 | (list (calendar-gregorian-from-absolute (+ abs-r-h 21)) | |
397 | "Shemini Atzeret") | |
398 | (list (calendar-gregorian-from-absolute (+ abs-r-h 22)) | |
399 | "Simchat Torah"))) | |
400 | (optional | |
401 | (list | |
402 | (list (calendar-gregorian-from-absolute | |
403 | (calendar-dayname-on-or-before 6 (- abs-r-h 4))) | |
404 | "Selichot (night)") | |
405 | (list (calendar-gregorian-from-absolute (1- abs-r-h)) | |
406 | "Erev Rosh HaShannah") | |
407 | (list (calendar-gregorian-from-absolute (1+ abs-r-h)) | |
408 | "Rosh HaShanah (second day)") | |
409 | (list (calendar-gregorian-from-absolute | |
410 | (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2))) | |
411 | "Tzom Gedaliah") | |
412 | (list (calendar-gregorian-from-absolute | |
413 | (calendar-dayname-on-or-before 6 (+ 7 abs-r-h))) | |
414 | "Shabbat Shuvah") | |
415 | (list (calendar-gregorian-from-absolute (+ abs-r-h 8)) | |
416 | "Erev Yom Kippur") | |
417 | (list (calendar-gregorian-from-absolute (+ abs-r-h 13)) | |
418 | "Erev Sukkot") | |
419 | (list (calendar-gregorian-from-absolute (+ abs-r-h 15)) | |
420 | "Sukkot (second day)") | |
421 | (list (calendar-gregorian-from-absolute (+ abs-r-h 16)) | |
422 | "Hol Hamoed Sukkot (first day)") | |
423 | (list (calendar-gregorian-from-absolute (+ abs-r-h 17)) | |
424 | "Hol Hamoed Sukkot (second day)") | |
425 | (list (calendar-gregorian-from-absolute (+ abs-r-h 18)) | |
426 | "Hol Hamoed Sukkot (third day)") | |
427 | (list (calendar-gregorian-from-absolute (+ abs-r-h 19)) | |
428 | "Hol Hamoed Sukkot (fourth day)") | |
429 | (list (calendar-gregorian-from-absolute (+ abs-r-h 20)) | |
430 | "Hoshannah Rabbah"))) | |
431 | (output-list | |
432 | (filter-visible-calendar-holidays mandatory))) | |
433 | (if all-hebrew-calendar-holidays | |
434 | (setq output-list | |
435 | (append | |
436 | (filter-visible-calendar-holidays optional) | |
437 | output-list))) | |
438 | output-list))) | |
439 | ||
440 | (defun calendar-holiday-function-hanukkah () | |
441 | "List of dates related to Hanukkah, as visible in calendar window." | |
442 | (if (memq displayed-month;; This test is only to speed things up a bit; | |
443 | '(10 11 12 1 2));; it works fine without the test too. | |
444 | (let ((m displayed-month) | |
445 | (y displayed-year)) | |
446 | (increment-calendar-month m y 1) | |
447 | (let* ((h-y (extract-calendar-year | |
448 | (calendar-hebrew-from-absolute | |
449 | (calendar-absolute-from-gregorian | |
450 | (list m (calendar-last-day-of-month m y) y))))) | |
451 | (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y)))) | |
452 | (filter-visible-calendar-holidays | |
453 | (list | |
454 | (list (calendar-gregorian-from-absolute (1- abs-h)) | |
455 | "Erev Hanukkah") | |
456 | (list (calendar-gregorian-from-absolute abs-h) | |
457 | "Hanukkah (first day)") | |
458 | (list (calendar-gregorian-from-absolute (1+ abs-h)) | |
459 | "Hanukkah (second day)") | |
460 | (list (calendar-gregorian-from-absolute (+ abs-h 2)) | |
461 | "Hanukkah (third day)") | |
462 | (list (calendar-gregorian-from-absolute (+ abs-h 3)) | |
463 | "Hanukkah (fourth day)") | |
464 | (list (calendar-gregorian-from-absolute (+ abs-h 4)) | |
465 | "Hanukkah (fifth day)") | |
466 | (list (calendar-gregorian-from-absolute (+ abs-h 5)) | |
467 | "Hanukkah (sixth day)") | |
468 | (list (calendar-gregorian-from-absolute (+ abs-h 6)) | |
469 | "Hanukkah (seventh day)") | |
470 | (list (calendar-gregorian-from-absolute (+ abs-h 7)) | |
471 | "Hanukkah (eighth day)"))))))) | |
472 | ||
473 | (defun calendar-holiday-function-passover-etc () | |
474 | "List of dates related to Passover, as visible in calendar window." | |
475 | (if (< 7 displayed-month) | |
476 | nil;; None of the dates is visible | |
477 | (let* ((abs-p (calendar-absolute-from-hebrew | |
478 | (list 1 15 (+ displayed-year 3760)))) | |
479 | (mandatory | |
480 | (list | |
481 | (list (calendar-gregorian-from-absolute abs-p) | |
482 | "Passover") | |
483 | (list (calendar-gregorian-from-absolute (+ abs-p 50)) | |
484 | "Shavuot"))) | |
485 | (optional | |
486 | (list | |
487 | (list (calendar-gregorian-from-absolute | |
488 | (calendar-dayname-on-or-before 6 (- abs-p 43))) | |
489 | "Shabbat Shekalim") | |
490 | (list (calendar-gregorian-from-absolute | |
491 | (calendar-dayname-on-or-before 6 (- abs-p 30))) | |
492 | "Shabbat Zachor") | |
493 | (list (calendar-gregorian-from-absolute | |
494 | (if (= (% abs-p 7) 2) (- abs-p 33) (- abs-p 31))) | |
495 | "Fast of Esther") | |
496 | (list (calendar-gregorian-from-absolute (- abs-p 31)) | |
497 | "Erev Purim") | |
498 | (list (calendar-gregorian-from-absolute (- abs-p 30)) | |
499 | "Purim") | |
500 | (list (calendar-gregorian-from-absolute | |
501 | (if (zerop (% abs-p 7)) (- abs-p 28) (- abs-p 29))) | |
502 | "Shushan Purim") | |
503 | (list (calendar-gregorian-from-absolute | |
504 | (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7)) | |
505 | "Shabbat Parah") | |
506 | (list (calendar-gregorian-from-absolute | |
507 | (calendar-dayname-on-or-before 6 (- abs-p 14))) | |
508 | "Shabbat HaHodesh") | |
509 | (list (calendar-gregorian-from-absolute | |
510 | (calendar-dayname-on-or-before 6 (1- abs-p))) | |
511 | "Shabbat HaGadol") | |
512 | (list (calendar-gregorian-from-absolute (1- abs-p)) | |
513 | "Erev Passover") | |
514 | (list (calendar-gregorian-from-absolute (1+ abs-p)) | |
515 | "Passover (second day)") | |
516 | (list (calendar-gregorian-from-absolute (+ abs-p 2)) | |
517 | "Hol Hamoed Passover (first day)") | |
518 | (list (calendar-gregorian-from-absolute (+ abs-p 3)) | |
519 | "Hol Hamoed Passover (second day)") | |
520 | (list (calendar-gregorian-from-absolute (+ abs-p 4)) | |
521 | "Hol Hamoed Passover (third day)") | |
522 | (list (calendar-gregorian-from-absolute (+ abs-p 5)) | |
523 | "Hol Hamoed Passover (fourth day)") | |
524 | (list (calendar-gregorian-from-absolute (+ abs-p 6)) | |
525 | "Passover (seventh day)") | |
526 | (list (calendar-gregorian-from-absolute (+ abs-p 7)) | |
527 | "Passover (eighth day)") | |
528 | (list (calendar-gregorian-from-absolute (+ abs-p 12)) | |
529 | "Yom HaShoah") | |
530 | (list (calendar-gregorian-from-absolute | |
531 | (if (zerop (% abs-p 7)) | |
532 | (+ abs-p 18) | |
533 | (if (= (% abs-p 7) 6) | |
534 | (+ abs-p 19) | |
535 | (+ abs-p 20)))) | |
536 | "Yom HaAtzma'ut") | |
537 | (list (calendar-gregorian-from-absolute (+ abs-p 33)) | |
538 | "Lag BaOmer") | |
539 | (list (calendar-gregorian-from-absolute (+ abs-p 43)) | |
540 | "Yom Yerushalim") | |
541 | (list (calendar-gregorian-from-absolute (+ abs-p 49)) | |
542 | "Erev Shavuot") | |
543 | (list (calendar-gregorian-from-absolute (+ abs-p 51)) | |
544 | "Shavuot (second day)"))) | |
545 | (output-list | |
546 | (filter-visible-calendar-holidays mandatory))) | |
547 | (if all-hebrew-calendar-holidays | |
548 | (setq output-list | |
549 | (append | |
550 | (filter-visible-calendar-holidays optional) | |
551 | output-list))) | |
552 | output-list))) | |
553 | ||
554 | (defun calendar-holiday-function-tisha-b-av-etc () | |
555 | "List of dates around Tisha B'Av, as visible in calendar window." | |
556 | (if (or (< displayed-month 5) | |
557 | (> displayed-month 9)) | |
558 | nil;; None of the dates is visible | |
559 | (let* ((abs-t-a (calendar-absolute-from-hebrew | |
560 | (list 5 9 (+ displayed-year 3760))))) | |
561 | ||
562 | (filter-visible-calendar-holidays | |
563 | (list | |
564 | (list (calendar-gregorian-from-absolute | |
565 | (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21))) | |
566 | "Tzom Tammuz") | |
567 | (list (calendar-gregorian-from-absolute | |
568 | (calendar-dayname-on-or-before 6 abs-t-a)) | |
569 | "Shabbat Hazon") | |
570 | (list (calendar-gregorian-from-absolute | |
571 | (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a)) | |
572 | "Tisha B'Av") | |
573 | (list (calendar-gregorian-from-absolute | |
574 | (calendar-dayname-on-or-before 6 (+ abs-t-a 7))) | |
575 | "Shabbat Nahamu")))))) | |
576 | ||
577 | (defun filter-visible-calendar-holidays (l) | |
578 | "Return a list of all visible holidays of those on L." | |
579 | (let ((visible) | |
580 | (p l)) | |
581 | (while p | |
582 | (if (calendar-date-is-visible-p (car (car p))) | |
583 | (setq visible (append (list (car p)) visible))) | |
584 | (setq p (cdr p))) | |
585 | visible)) | |
49116ac0 JB |
586 | |
587 | (provide 'holidays) | |
588 |