Commit | Line | Data |
---|---|---|
1a06eabd | 1 | ;;; holidays.el --- holiday functions for the calendar package |
fc68affa | 2 | |
a96a5fca | 3 | ;; Copyright (C) 1989, 90, 92, 93, 94, 1997 Free Software Foundation, Inc. |
3a801d0c | 4 | |
fc68affa | 5 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
7e1dae73 | 6 | ;; Keywords: holidays, calendar |
fc68affa | 7 | |
1802278a JB |
8 | ;; This file is part of GNU Emacs. |
9 | ||
59243403 RS |
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
8ec105a0 | 14 | |
1802278a | 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
1802278a | 24 | |
fc68affa ER |
25 | ;;; Commentary: |
26 | ||
1802278a JB |
27 | ;; This collection of functions implements the holiday features as described |
28 | ;; in calendar.el. | |
29 | ||
1802278a JB |
30 | ;; Technical details of all the calendrical calculations can be found in |
31 | ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, | |
a96a5fca PE |
32 | ;; Cambridge University Press (1997). |
33 | ||
34 | ;; An earlier version of the technical details appeared in | |
35 | ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, | |
1802278a | 36 | ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990), |
7e1dae73 JB |
37 | ;; pages 899-928. ``Calendrical Calculations, Part II: Three Historical |
38 | ;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen, | |
c8d190a5 JB |
39 | ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), |
40 | ;; pages 383-404. | |
7e1dae73 JB |
41 | |
42 | ;; Hard copies of these two papers can be obtained by sending email to | |
43 | ;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and | |
44 | ;; the message BODY containing your mailing address (snail). | |
1802278a | 45 | |
a96a5fca PE |
46 | ;; Comments, corrections, and improvements should be sent to |
47 | ;; Edward M. Reingold Department of Computer Science | |
48 | ;; (217) 333-6733 University of Illinois at Urbana-Champaign | |
49 | ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue | |
50 | ;; Urbana, Illinois 61801 | |
51 | ||
fc68affa ER |
52 | ;;; Code: |
53 | ||
0b0f8fa4 GM |
54 | (defvar displayed-month) |
55 | (defvar displayed-year) | |
56 | ||
1802278a | 57 | (require 'calendar) |
e5d77022 | 58 | |
32933edb ER |
59 | (autoload 'holiday-julian "cal-julian" |
60 | "Holiday on MONTH, DAY (Julian) called STRING." | |
61 | t) | |
62 | ||
63 | (autoload 'holiday-hebrew "cal-hebrew" | |
64 | "Holiday on MONTH, DAY (Hebrew) called STRING." | |
65 | t) | |
66 | ||
67 | (autoload 'holiday-rosh-hashanah-etc "cal-hebrew" | |
68 | "List of dates related to Rosh Hashanah, as visible in calendar window." | |
69 | t) | |
70 | ||
71 | (autoload 'holiday-hanukkah "cal-hebrew" | |
72 | "List of dates related to Hanukkah, as visible in calendar window." | |
73 | t) | |
74 | ||
75 | (autoload 'holiday-passover-etc "cal-hebrew" | |
76 | "List of dates related to Passover, as visible in calendar window." | |
77 | t) | |
78 | ||
79 | (autoload 'holiday-tisha-b-av-etc "cal-hebrew" | |
80 | "List of dates around Tisha B'Av, as visible in calendar window." | |
81 | t) | |
82 | ||
327b6868 | 83 | (autoload 'holiday-islamic "cal-islam" |
32933edb ER |
84 | "Holiday on MONTH, DAY (Islamic) called STRING." |
85 | t) | |
86 | ||
811a8484 JW |
87 | (autoload 'holiday-bahai "cal-bahai" |
88 | "Holiday on MONTH, DAY (Baha'i) called STRING." | |
89 | t) | |
90 | ||
327b6868 | 91 | (autoload 'holiday-chinese-new-year "cal-china" |
32933edb ER |
92 | "Date of Chinese New Year." |
93 | t) | |
94 | ||
8ec105a0 | 95 | (autoload 'solar-equinoxes-solstices "solar" |
7e1dae73 JB |
96 | "Date and time of equinoxes and solstices, if visible in the calendar window. |
97 | Requires floating point." | |
98 | t) | |
99 | ||
c8224de6 | 100 | ;;;###autoload |
7e1dae73 | 101 | (defun holidays (&optional arg) |
1802278a | 102 | "Display the holidays for last month, this month, and next month. |
7e1dae73 JB |
103 | If called with an optional prefix argument, prompts for month and year. |
104 | ||
1802278a | 105 | This function is suitable for execution in a .emacs file." |
7e1dae73 | 106 | (interactive "P") |
1802278a | 107 | (save-excursion |
7e1dae73 | 108 | (let* ((completion-ignore-case t) |
c99d4526 ER |
109 | (date (if arg |
110 | (calendar-read-date t) | |
111 | (calendar-current-date))) | |
112 | (displayed-month (extract-calendar-month date)) | |
113 | (displayed-year (extract-calendar-year date))) | |
1802278a JB |
114 | (list-calendar-holidays)))) |
115 | ||
40b14a0c | 116 | ;;;###autoload |
056a21c4 RS |
117 | (defun list-holidays (y1 y2 &optional l label) |
118 | "Display holidays for years Y1 to Y2 (inclusive). | |
119 | ||
120 | The optional list of holidays L defaults to `calendar-holidays'. See the | |
121 | documentation for that variable for a description of holiday lists. | |
122 | ||
123 | The optional LABEL is used to label the buffer created." | |
124 | (interactive | |
125 | (let* ((start-year (calendar-read | |
126 | "Starting year of holidays (>0): " | |
127 | '(lambda (x) (> x 0)) | |
128 | (int-to-string (extract-calendar-year | |
129 | (calendar-current-date))))) | |
130 | (end-year (calendar-read | |
131 | (format "Ending year (inclusive) of holidays (>=%s): " | |
132 | start-year) | |
133 | '(lambda (x) (>= x start-year)) | |
134 | (int-to-string start-year))) | |
135 | (completion-ignore-case t) | |
136 | (lists | |
137 | (list | |
138 | (cons "All" calendar-holidays) | |
139 | (if (fboundp 'atan) | |
140 | (cons "Equinoxes/Solstices" | |
141 | (list (list 'solar-equinoxes-solstices)))) | |
142 | (if general-holidays (cons "General" general-holidays)) | |
143 | (if local-holidays (cons "Local" local-holidays)) | |
144 | (if other-holidays (cons "Other" other-holidays)) | |
145 | (if christian-holidays (cons "Christian" christian-holidays)) | |
146 | (if hebrew-holidays (cons "Hebrew" hebrew-holidays)) | |
147 | (if islamic-holidays (cons "Islamic" islamic-holidays)) | |
811a8484 | 148 | (if bahai-holidays (cons "Baha'i" bahai-holidays)) |
056a21c4 RS |
149 | (if oriental-holidays (cons "Oriental" oriental-holidays)) |
150 | (if solar-holidays (cons "Solar" solar-holidays)) | |
151 | (cons "Ask" nil))) | |
152 | (choice (capitalize | |
153 | (completing-read "List (TAB for choices): " lists nil t))) | |
154 | (which (if (string-equal choice "Ask") | |
155 | (eval (read-variable "Enter list name: ")) | |
156 | (cdr (assoc choice lists)))) | |
157 | (name (if (string-equal choice "Equinoxes/Solstices") | |
158 | choice | |
ebad70de | 159 | (if (member choice '("Ask" "")) |
a1506d29 | 160 | "Holidays" |
056a21c4 RS |
161 | (format "%s Holidays" choice))))) |
162 | (list start-year end-year which name))) | |
163 | (message "Computing holidays...") | |
164 | (let* ((holiday-buffer "*Holidays*") | |
165 | (calendar-holidays (if l l calendar-holidays)) | |
ebad70de | 166 | (title (or label "Holidays")) |
056a21c4 RS |
167 | (holiday-list nil) |
168 | (s (calendar-absolute-from-gregorian (list 2 1 y1))) | |
169 | (e (calendar-absolute-from-gregorian (list 11 1 y2))) | |
170 | (d s) | |
171 | (never t) | |
172 | (displayed-month 2) | |
173 | (displayed-year y1)) | |
174 | (while (or never (<= d e)) | |
175 | (setq holiday-list (append holiday-list (calendar-holiday-list))) | |
176 | (setq never nil) | |
177 | (increment-calendar-month displayed-month displayed-year 3) | |
178 | (setq d (calendar-absolute-from-gregorian | |
179 | (list displayed-month 1 displayed-year)))) | |
ebad70de RS |
180 | (save-excursion |
181 | (set-buffer (get-buffer-create holiday-buffer)) | |
182 | (setq buffer-read-only nil) | |
183 | (calendar-set-mode-line | |
184 | (if (= y1 y2) | |
185 | (format "%s for %s" title y1) | |
186 | (format "%s for %s-%s" title y1 y2))) | |
187 | (erase-buffer) | |
188 | (goto-char (point-min)) | |
189 | (insert | |
190 | (mapconcat | |
191 | '(lambda (x) (concat (calendar-date-string (car x)) | |
192 | ": " (car (cdr x)))) | |
193 | holiday-list "\n")) | |
194 | (goto-char (point-min)) | |
195 | (set-buffer-modified-p nil) | |
196 | (setq buffer-read-only t) | |
197 | (display-buffer holiday-buffer) | |
198 | (message "Computing holidays...done")))) | |
199 | ||
056a21c4 | 200 | |
1802278a JB |
201 | (defun check-calendar-holidays (date) |
202 | "Check the list of holidays for any that occur on DATE. | |
203 | The value returned is a list of strings of relevant holiday descriptions. | |
204 | The holidays are those in the list calendar-holidays." | |
205 | (let* ((displayed-month (extract-calendar-month date)) | |
206 | (displayed-year (extract-calendar-year date)) | |
207 | (h (calendar-holiday-list)) | |
208 | (holiday-list)) | |
209 | (while h | |
210 | (if (calendar-date-equal date (car (car h))) | |
211 | (setq holiday-list (append holiday-list (cdr (car h))))) | |
212 | (setq h (cdr h))) | |
213 | holiday-list)) | |
214 | ||
215 | (defun calendar-cursor-holidays () | |
216 | "Find holidays for the date specified by the cursor in the calendar window." | |
217 | (interactive) | |
218 | (message "Checking holidays...") | |
56e7830d | 219 | (let* ((date (calendar-cursor-to-date t)) |
1802278a JB |
220 | (date-string (calendar-date-string date)) |
221 | (holiday-list (check-calendar-holidays date)) | |
222 | (holiday-string (mapconcat 'identity holiday-list "; ")) | |
223 | (msg (format "%s: %s" date-string holiday-string))) | |
224 | (if (not holiday-list) | |
225 | (message "No holidays known for %s" date-string) | |
8ec105a0 | 226 | (if (<= (length msg) (frame-width)) |
eec5a2e4 | 227 | (message "%s" msg) |
1802278a JB |
228 | (set-buffer (get-buffer-create holiday-buffer)) |
229 | (setq buffer-read-only nil) | |
7e1dae73 | 230 | (calendar-set-mode-line date-string) |
1802278a JB |
231 | (erase-buffer) |
232 | (insert (mapconcat 'identity holiday-list "\n")) | |
233 | (goto-char (point-min)) | |
234 | (set-buffer-modified-p nil) | |
235 | (setq buffer-read-only t) | |
236 | (display-buffer holiday-buffer) | |
237 | (message "Checking holidays...done"))))) | |
238 | ||
239 | (defun mark-calendar-holidays () | |
240 | "Mark notable days in the calendar window." | |
241 | (interactive) | |
242 | (setq mark-holidays-in-calendar t) | |
243 | (message "Marking holidays...") | |
244 | (let ((holiday-list (calendar-holiday-list))) | |
245 | (while holiday-list | |
246 | (mark-visible-calendar-date | |
247 | (car (car holiday-list)) calendar-holiday-marker) | |
248 | (setq holiday-list (cdr holiday-list)))) | |
249 | (message "Marking holidays...done")) | |
250 | ||
251 | (defun list-calendar-holidays () | |
252 | "Create a buffer containing the holidays for the current calendar window. | |
253 | The holidays are those in the list calendar-notable-days. Returns t if any | |
254 | holidays are found, nil if not." | |
255 | (interactive) | |
256 | (message "Looking up holidays...") | |
257 | (let ((holiday-list (calendar-holiday-list)) | |
258 | (m1 displayed-month) | |
259 | (y1 displayed-year) | |
260 | (m2 displayed-month) | |
261 | (y2 displayed-year)) | |
262 | (if (not holiday-list) | |
263 | (progn | |
264 | (message "Looking up holidays...none found") | |
265 | nil) | |
266 | (set-buffer (get-buffer-create holiday-buffer)) | |
267 | (setq buffer-read-only nil) | |
268 | (increment-calendar-month m1 y1 -1) | |
269 | (increment-calendar-month m2 y2 1) | |
7e1dae73 | 270 | (calendar-set-mode-line |
1d34f349 RS |
271 | (if (= y1 y2) |
272 | (format "Notable Dates from %s to %s, %d%%-" | |
273 | (calendar-month-name m1) (calendar-month-name m2) y2) | |
274 | (format "Notable Dates from %s, %d to %s, %d%%-" | |
275 | (calendar-month-name m1) y1 (calendar-month-name m2) y2))) | |
1802278a JB |
276 | (erase-buffer) |
277 | (insert | |
278 | (mapconcat | |
279 | '(lambda (x) (concat (calendar-date-string (car x)) | |
280 | ": " (car (cdr x)))) | |
281 | holiday-list "\n")) | |
282 | (goto-char (point-min)) | |
283 | (set-buffer-modified-p nil) | |
284 | (setq buffer-read-only t) | |
285 | (display-buffer holiday-buffer) | |
286 | (message "Looking up holidays...done") | |
287 | t))) | |
288 | ||
289 | (defun calendar-holiday-list () | |
290 | "Form the list of holidays that occur on dates in the calendar window. | |
291 | The holidays are those in the list calendar-holidays." | |
8ec105a0 | 292 | (let ((p calendar-holidays) |
1802278a JB |
293 | (holiday-list)) |
294 | (while p | |
8ec105a0 JB |
295 | (let* ((holidays |
296 | (if calendar-debug-sexp | |
297 | (let ((stack-trace-on-error t)) | |
298 | (eval (car p))) | |
299 | (condition-case nil | |
300 | (eval (car p)) | |
301 | (error (beep) | |
302 | (message "Bad holiday list item: %s" (car p)) | |
303 | (sleep-for 2)))))) | |
1802278a JB |
304 | (if holidays |
305 | (setq holiday-list (append holidays holiday-list)))) | |
306 | (setq p (cdr p))) | |
307 | (setq holiday-list (sort holiday-list 'calendar-date-compare)))) | |
308 | ||
309 | ;; Below are the functions that calculate the dates of holidays; these | |
8ec105a0 JB |
310 | ;; are eval'ed in the function calendar-holiday-list. If you |
311 | ;; write other such functions, be sure to imitate the style used below. | |
312 | ;; Remember that each function must return a list of items of the form | |
313 | ;; ((month day year) string) of VISIBLE dates in the calendar window. | |
314 | ||
315 | (defun holiday-fixed (month day string) | |
316 | "Holiday on MONTH, DAY (Gregorian) called STRING. | |
317 | If MONTH, DAY is visible, the value returned is the list (((MONTH DAY year) | |
318 | STRING)). Returns nil if it is not visible in the current calendar window." | |
319 | (let ((m displayed-month) | |
320 | (y displayed-year)) | |
1802278a JB |
321 | (increment-calendar-month m y (- 11 month)) |
322 | (if (> m 9) | |
323 | (list (list (list month day y) string))))) | |
324 | ||
8ec105a0 | 325 | (defun holiday-float (month dayname n string &optional day) |
151eeaa7 | 326 | "Holiday on MONTH, DAYNAME (Nth occurrence) called STRING. |
8ec105a0 | 327 | If the Nth DAYNAME in MONTH is visible, the value returned is the list |
a4e104bf | 328 | \(((MONTH DAY year) STRING)). |
8ec105a0 JB |
329 | |
330 | If N<0, count backward from the end of MONTH. | |
331 | ||
151eeaa7 | 332 | An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY. |
8ec105a0 | 333 | |
1802278a | 334 | Returns nil if it is not visible in the current calendar window." |
151eeaa7 RS |
335 | ;; This is messy because the holiday may be visible, while the date on which |
336 | ;; it is based is not. For example, the first Monday after December 30 may be | |
337 | ;; visible when January is not. For large values of |n| the problem is more | |
338 | ;; grotesque. If we didn't have to worry about such cases, we could just use | |
339 | ||
340 | ;; (let ((m displayed-month) | |
341 | ;; (y displayed-year)) | |
342 | ;; (increment-calendar-month m y (- 11 month)) | |
343 | ;; (if (> m 9); month in year y is visible | |
344 | ;; (list (list (calendar-nth-named-day n dayname month y day) string))))) | |
345 | ||
346 | ;; which is the way the function was originally written. | |
347 | ||
348 | (let* ((m1 displayed-month) | |
349 | (y1 displayed-year) | |
350 | (m2 m1) | |
351 | (y2 y1)) | |
352 | (increment-calendar-month m1 y1 -1) | |
353 | (increment-calendar-month m2 y2 1) | |
354 | (let* ((d1; first possible base date for holiday | |
355 | (+ (calendar-nth-named-absday 1 dayname m1 y1) | |
356 | (* -7 n) | |
357 | (if (> n 0) 1 -7))) | |
358 | (d2; last possible base date for holiday | |
359 | (+ (calendar-nth-named-absday -1 dayname m2 y2) | |
360 | (* -7 n) | |
361 | (if (> n 0) 7 -1))) | |
362 | (y1 (extract-calendar-year (calendar-gregorian-from-absolute d1))) | |
363 | (y2 (extract-calendar-year (calendar-gregorian-from-absolute d2))) | |
364 | (y; year of base date | |
365 | (if (or (= y1 y2) (> month 9)) | |
366 | y1 | |
367 | y2)) | |
368 | (d; day of base date | |
369 | (or day (if (> n 0) | |
370 | 1 | |
371 | (calendar-last-day-of-month month y)))) | |
372 | (date; base date for holiday | |
373 | (calendar-absolute-from-gregorian (list month d y)))) | |
374 | (if (and (<= d1 date) (<= date d2)) | |
375 | (list (list (calendar-nth-named-day n dayname month y d) | |
376 | string)))))) | |
8ec105a0 | 377 | |
8ec105a0 | 378 | (defun holiday-sexp (sexp string) |
7e1dae73 | 379 | "Sexp holiday for dates in the calendar window. |
8ec105a0 JB |
380 | SEXP is an expression in variable `year' evaluates to `date'. |
381 | ||
382 | STRING is an expression in `date' that evaluates to the holiday description | |
383 | of `date'. | |
384 | ||
385 | If `date' is visible in the calendar window, the holiday STRING is on that | |
386 | date. If date is nil, or if the date is not visible, there is no holiday." | |
7e1dae73 JB |
387 | (let ((m displayed-month) |
388 | (y displayed-year)) | |
389 | (increment-calendar-month m y -1) | |
390 | (filter-visible-calendar-holidays | |
391 | (append | |
8ec105a0 JB |
392 | (let* ((year y) |
393 | (date (eval sexp)) | |
394 | (string (if date (eval string)))) | |
395 | (list (list date string))) | |
396 | (let* ((year (1+ y)) | |
397 | (date (eval sexp)) | |
398 | (string (if date (eval string)))) | |
399 | (list (list date string))))))) | |
400 | ||
401 | (defun holiday-advent () | |
1802278a JB |
402 | "Date of Advent, if visible in calendar window." |
403 | (let ((year displayed-year) | |
404 | (month displayed-month)) | |
405 | (increment-calendar-month month year -1) | |
406 | (let ((advent (calendar-gregorian-from-absolute | |
407 | (calendar-dayname-on-or-before 0 | |
408 | (calendar-absolute-from-gregorian | |
409 | (list 12 3 year)))))) | |
410 | (if (calendar-date-is-visible-p advent) | |
411 | (list (list advent "Advent")))))) | |
412 | ||
8ec105a0 | 413 | (defun holiday-easter-etc () |
1802278a JB |
414 | "List of dates related to Easter, as visible in calendar window." |
415 | (if (and (> displayed-month 5) (not all-christian-calendar-holidays)) | |
416 | nil;; Ash Wednesday, Good Friday, and Easter are not visible. | |
417 | (let* ((century (1+ (/ displayed-year 100))) | |
418 | (shifted-epact ;; Age of moon for April 5... | |
419 | (% (+ 14 (* 11 (% displayed-year 19));; ...by Nicaean rule | |
420 | (- ;; ...corrected for the Gregorian century rule | |
421 | (/ (* 3 century) 4)) | |
422 | (/ ;; ...corrected for Metonic cycle inaccuracy. | |
423 | (+ 5 (* 8 century)) 25) | |
424 | (* 30 century));; Keeps value positive. | |
425 | 30)) | |
426 | (adjusted-epact ;; Adjust for 29.5 day month. | |
427 | (if (or (= shifted-epact 0) | |
428 | (and (= shifted-epact 1) (< 10 (% displayed-year 19)))) | |
429 | (1+ shifted-epact) | |
430 | shifted-epact)) | |
431 | (paschal-moon ;; Day after the full moon on or after March 21. | |
432 | (- (calendar-absolute-from-gregorian (list 4 19 displayed-year)) | |
433 | adjusted-epact)) | |
434 | (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7))) | |
435 | (mandatory | |
436 | (list | |
437 | (list (calendar-gregorian-from-absolute abs-easter) | |
438 | "Easter Sunday") | |
439 | (list (calendar-gregorian-from-absolute (- abs-easter 2)) | |
440 | "Good Friday") | |
441 | (list (calendar-gregorian-from-absolute (- abs-easter 46)) | |
442 | "Ash Wednesday"))) | |
443 | (optional | |
444 | (list | |
445 | (list (calendar-gregorian-from-absolute (- abs-easter 63)) | |
446 | "Septuagesima Sunday") | |
447 | (list (calendar-gregorian-from-absolute (- abs-easter 56)) | |
448 | "Sexagesima Sunday") | |
449 | (list (calendar-gregorian-from-absolute (- abs-easter 49)) | |
450 | "Shrove Sunday") | |
451 | (list (calendar-gregorian-from-absolute (- abs-easter 48)) | |
452 | "Shrove Monday") | |
453 | (list (calendar-gregorian-from-absolute (- abs-easter 47)) | |
454 | "Shrove Tuesday") | |
455 | (list (calendar-gregorian-from-absolute (- abs-easter 14)) | |
456 | "Passion Sunday") | |
457 | (list (calendar-gregorian-from-absolute (- abs-easter 7)) | |
458 | "Palm Sunday") | |
459 | (list (calendar-gregorian-from-absolute (- abs-easter 3)) | |
460 | "Maundy Thursday") | |
461 | (list (calendar-gregorian-from-absolute (+ abs-easter 35)) | |
462 | "Rogation Sunday") | |
463 | (list (calendar-gregorian-from-absolute (+ abs-easter 39)) | |
2ba08787 | 464 | "Ascension Day") |
1802278a JB |
465 | (list (calendar-gregorian-from-absolute (+ abs-easter 49)) |
466 | "Pentecost (Whitsunday)") | |
467 | (list (calendar-gregorian-from-absolute (+ abs-easter 50)) | |
69f5afe4 | 468 | "Whitmonday") |
1802278a JB |
469 | (list (calendar-gregorian-from-absolute (+ abs-easter 56)) |
470 | "Trinity Sunday") | |
471 | (list (calendar-gregorian-from-absolute (+ abs-easter 60)) | |
472 | "Corpus Christi"))) | |
473 | (output-list | |
474 | (filter-visible-calendar-holidays mandatory))) | |
475 | (if all-christian-calendar-holidays | |
476 | (setq output-list | |
a1506d29 | 477 | (append |
1802278a JB |
478 | (filter-visible-calendar-holidays optional) |
479 | output-list))) | |
480 | output-list))) | |
481 | ||
8ec105a0 JB |
482 | (defun holiday-greek-orthodox-easter () |
483 | "Date of Easter according to the rule of the Council of Nicaea." | |
7e1dae73 JB |
484 | (let ((m displayed-month) |
485 | (y displayed-year)) | |
486 | (increment-calendar-month m y 1) | |
487 | (let* ((julian-year | |
488 | (extract-calendar-year | |
489 | (calendar-julian-from-absolute | |
490 | (calendar-absolute-from-gregorian | |
491 | (list m (calendar-last-day-of-month m y) y))))) | |
492 | (shifted-epact ;; Age of moon for April 5. | |
493 | (% (+ 14 | |
494 | (* 11 (% julian-year 19))) | |
495 | 30)) | |
496 | (paschal-moon ;; Day after full moon on or after March 21. | |
497 | (- (calendar-absolute-from-julian (list 4 19 julian-year)) | |
498 | shifted-epact)) | |
499 | (nicaean-easter;; Sunday following the Paschal moon | |
500 | (calendar-gregorian-from-absolute | |
501 | (calendar-dayname-on-or-before 0 (+ paschal-moon 7))))) | |
502 | (if (calendar-date-is-visible-p nicaean-easter) | |
503 | (list (list nicaean-easter "Pascha (Greek Orthodox Easter)")))))) | |
504 | ||
1802278a JB |
505 | (defun filter-visible-calendar-holidays (l) |
506 | "Return a list of all visible holidays of those on L." | |
507 | (let ((visible) | |
508 | (p l)) | |
509 | (while p | |
c8d190a5 JB |
510 | (and (car (car p)) |
511 | (calendar-date-is-visible-p (car (car p))) | |
512 | (setq visible (append (list (car p)) visible))) | |
1802278a JB |
513 | (setq p (cdr p))) |
514 | visible)) | |
49116ac0 JB |
515 | |
516 | (provide 'holidays) | |
517 | ||
ab5796a9 | 518 | ;;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37 |
1a06eabd | 519 | ;;; holidays.el ends here |