Commit | Line | Data |
---|---|---|
1a06eabd | 1 | ;;; holidays.el --- holiday functions for the calendar package |
fc68affa | 2 | |
dbfca9c4 | 3 | ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1997, 2001, 2002, 2003, |
8b72699e | 4 | ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
3a801d0c | 5 | |
fc68affa | 6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
aff88519 | 7 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
7e1dae73 | 8 | ;; Keywords: holidays, calendar |
fc68affa | 9 | |
1802278a JB |
10 | ;; This file is part of GNU Emacs. |
11 | ||
2ed66575 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
59243403 | 13 | ;; it under the terms of the GNU General Public License as published by |
2ed66575 GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
8ec105a0 | 16 | |
1802278a | 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
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 | |
2ed66575 | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
1802278a | 24 | |
fc68affa ER |
25 | ;;; Commentary: |
26 | ||
d600b865 | 27 | ;; See calendar.el. |
1802278a | 28 | |
fc68affa ER |
29 | ;;; Code: |
30 | ||
1802278a | 31 | (require 'calendar) |
94b73aef | 32 | (require 'hol-loaddefs) |
7e1dae73 | 33 | |
d463476b GM |
34 | (defgroup holidays nil |
35 | "Holidays support in calendar." | |
36 | :group 'calendar | |
37 | :prefix "holidays-" | |
38 | :group 'local) | |
39 | ||
40 | ;; The various holiday variables are autoloaded because people | |
41 | ;; are used to using them to set calendar-holidays without having to | |
42 | ;; explicitly load this file. | |
43 | ||
44 | ;;;###autoload | |
45 | (defcustom holiday-general-holidays | |
46 | '((holiday-fixed 1 1 "New Year's Day") | |
47 | (holiday-float 1 1 3 "Martin Luther King Day") | |
48 | (holiday-fixed 2 2 "Groundhog Day") | |
49 | (holiday-fixed 2 14 "Valentine's Day") | |
50 | (holiday-float 2 1 3 "President's Day") | |
51 | (holiday-fixed 3 17 "St. Patrick's Day") | |
52 | (holiday-fixed 4 1 "April Fools' Day") | |
53 | (holiday-float 5 0 2 "Mother's Day") | |
54 | (holiday-float 5 1 -1 "Memorial Day") | |
55 | (holiday-fixed 6 14 "Flag Day") | |
56 | (holiday-float 6 0 3 "Father's Day") | |
57 | (holiday-fixed 7 4 "Independence Day") | |
58 | (holiday-float 9 1 1 "Labor Day") | |
59 | (holiday-float 10 1 2 "Columbus Day") | |
60 | (holiday-fixed 10 31 "Halloween") | |
61 | (holiday-fixed 11 11 "Veteran's Day") | |
62 | (holiday-float 11 4 4 "Thanksgiving")) | |
63 | "General holidays. Default value is for the United States. | |
64 | See the documentation for `calendar-holidays' for details." | |
65 | :type 'sexp | |
66 | :group 'holidays) | |
67 | ;;;###autoload | |
68 | (put 'holiday-general-holidays 'risky-local-variable t) | |
69 | ;;;###autoload | |
70 | (define-obsolete-variable-alias 'general-holidays | |
71 | 'holiday-general-holidays "23.1") | |
72 | ||
73 | ;;;###autoload | |
74 | (defcustom holiday-oriental-holidays | |
43c783b8 GM |
75 | '((holiday-chinese-new-year) |
76 | (if calendar-chinese-all-holidays-flag | |
77 | (append | |
78 | (holiday-chinese 1 15 "Lantern Festival") | |
79 | (holiday-chinese-qingming) | |
80 | (holiday-chinese 5 5 "Dragon Boat Festival") | |
81 | (holiday-chinese 7 7 "Double Seventh Festival") | |
82 | (holiday-chinese 8 15 "Mid-Autumn Festival") | |
83 | (holiday-chinese 9 9 "Double Ninth Festival") | |
84 | (holiday-chinese-winter-solstice) | |
85 | ))) | |
d463476b GM |
86 | "Oriental holidays. |
87 | See the documentation for `calendar-holidays' for details." | |
43c783b8 | 88 | :version "23.1" ; added more holidays |
d463476b GM |
89 | :type 'sexp |
90 | :group 'holidays) | |
91 | ;;;###autoload | |
92 | (put 'holiday-oriental-holidays 'risky-local-variable t) | |
93 | ;;;###autoload | |
94 | (define-obsolete-variable-alias 'oriental-holidays | |
95 | 'holiday-oriental-holidays "23.1") | |
96 | ||
97 | ;;;###autoload | |
98 | (defcustom holiday-local-holidays nil | |
99 | "Local holidays. | |
100 | See the documentation for `calendar-holidays' for details." | |
101 | :type 'sexp | |
102 | :group 'holidays) | |
103 | ;;;###autoload | |
104 | (put 'holiday-local-holidays 'risky-local-variable t) | |
105 | ;;;###autoload | |
106 | (define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1") | |
107 | ||
108 | ;;;###autoload | |
109 | (defcustom holiday-other-holidays nil | |
110 | "User defined holidays. | |
111 | See the documentation for `calendar-holidays' for details." | |
112 | :type 'sexp | |
113 | :group 'holidays) | |
114 | ;;;###autoload | |
115 | (put 'holiday-other-holidays 'risky-local-variable t) | |
116 | ;;;###autoload | |
117 | (define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1") | |
118 | ||
119 | ;;;###autoload | |
120 | (defvar hebrew-holidays-1 | |
121 | '((holiday-hebrew-rosh-hashanah) | |
122 | (if calendar-hebrew-all-holidays-flag | |
123 | (holiday-julian | |
124 | 11 | |
125 | (let ((m displayed-month) | |
126 | (y displayed-year) | |
127 | year) | |
128 | (calendar-increment-month m y -1) | |
129 | (setq year (calendar-extract-year | |
130 | (calendar-julian-from-absolute | |
131 | (calendar-absolute-from-gregorian (list m 1 y))))) | |
132 | (if (zerop (% (1+ year) 4)) | |
133 | 22 | |
134 | 21)) "\"Tal Umatar\" (evening)"))) | |
135 | "Component of the old default value of `holiday-hebrew-holidays'.") | |
136 | ;;;###autoload | |
137 | (put 'hebrew-holidays-1 'risky-local-variable t) | |
138 | (make-obsolete-variable 'hebrew-holidays-1 'hebrew-holidays "23.1") | |
139 | ||
140 | ;;;###autoload | |
141 | (defvar hebrew-holidays-2 | |
142 | '((holiday-hebrew-hanukkah) ; respects calendar-hebrew-all-holidays-flag | |
143 | (if calendar-hebrew-all-holidays-flag | |
144 | (holiday-hebrew | |
145 | 10 | |
146 | (let ((h-year (calendar-extract-year | |
147 | (calendar-hebrew-from-absolute | |
148 | (calendar-absolute-from-gregorian | |
149 | (list displayed-month 28 displayed-year)))))) | |
150 | (if (= 6 (% (calendar-hebrew-to-absolute (list 10 10 h-year)) | |
151 | 7)) | |
152 | 11 10)) | |
153 | "Tzom Teveth")) | |
154 | (if calendar-hebrew-all-holidays-flag | |
155 | (holiday-hebrew 11 15 "Tu B'Shevat"))) | |
156 | "Component of the old default value of `holiday-hebrew-holidays'.") | |
157 | ;;;###autoload | |
158 | (put 'hebrew-holidays-2 'risky-local-variable t) | |
159 | (make-obsolete-variable 'hebrew-holidays-2 'hebrew-holidays "23.1") | |
160 | ||
161 | ;;;###autoload | |
162 | (defvar hebrew-holidays-3 | |
163 | '((if calendar-hebrew-all-holidays-flag | |
164 | (holiday-hebrew | |
165 | 11 | |
166 | (let* ((m displayed-month) | |
167 | (y displayed-year) | |
168 | (h-year (progn | |
169 | (calendar-increment-month m y 1) | |
170 | (calendar-extract-year | |
171 | (calendar-hebrew-from-absolute | |
172 | (calendar-absolute-from-gregorian | |
173 | (list m (calendar-last-day-of-month m y) y)))))) | |
174 | (s-s | |
175 | (calendar-hebrew-from-absolute | |
176 | (if (= 6 | |
177 | (% (calendar-hebrew-to-absolute | |
178 | (list 7 1 h-year)) | |
179 | 7)) | |
180 | (calendar-dayname-on-or-before | |
181 | 6 (calendar-hebrew-to-absolute | |
182 | (list 11 17 h-year))) | |
183 | (calendar-dayname-on-or-before | |
184 | 6 (calendar-hebrew-to-absolute | |
185 | (list 11 16 h-year)))))) | |
186 | (day (calendar-extract-day s-s))) | |
187 | day) | |
188 | "Shabbat Shirah"))) | |
189 | "Component of the old default value of `holiday-hebrew-holidays'.") | |
190 | ;;;###autoload | |
191 | (put 'hebrew-holidays-3 'risky-local-variable t) | |
192 | (make-obsolete-variable 'hebrew-holidays-3 'hebrew-holidays "23.1") | |
193 | ||
194 | ;;;###autoload | |
195 | (defvar hebrew-holidays-4 | |
196 | '((holiday-hebrew-passover) | |
197 | (and calendar-hebrew-all-holidays-flag | |
198 | (let* ((m displayed-month) | |
199 | (y displayed-year) | |
200 | (year (progn | |
201 | (calendar-increment-month m y -1) | |
202 | (calendar-extract-year | |
203 | (calendar-julian-from-absolute | |
204 | (calendar-absolute-from-gregorian (list m 1 y))))))) | |
205 | (= 21 (% year 28))) | |
206 | (holiday-julian 3 26 "Kiddush HaHamah")) | |
207 | (if calendar-hebrew-all-holidays-flag | |
208 | (holiday-hebrew-tisha-b-av))) | |
209 | "Component of the old default value of `holiday-hebrew-holidays'.") | |
210 | ;;;###autoload | |
211 | (put 'hebrew-holidays-4 'risky-local-variable t) | |
212 | (make-obsolete-variable 'hebrew-holidays-4 'hebrew-holidays "23.1") | |
213 | ||
214 | ;;;###autoload | |
215 | (defcustom holiday-hebrew-holidays | |
216 | '((holiday-hebrew-passover) | |
217 | (holiday-hebrew-rosh-hashanah) | |
218 | (holiday-hebrew-hanukkah) | |
219 | (if calendar-hebrew-all-holidays-flag | |
220 | (append | |
221 | (holiday-hebrew-tisha-b-av) | |
222 | (holiday-hebrew-misc)))) | |
223 | "Jewish holidays. | |
224 | See the documentation for `calendar-holidays' for details." | |
225 | :type 'sexp | |
226 | :version "23.1" ; removed dependency on hebrew-holidays-N | |
227 | :group 'holidays) | |
228 | ;;;###autoload | |
229 | (put 'holiday-hebrew-holidays 'risky-local-variable t) | |
230 | ;;;###autoload | |
231 | (define-obsolete-variable-alias 'hebrew-holidays | |
232 | 'holiday-hebrew-holidays "23.1") | |
233 | ||
234 | ;;;###autoload | |
235 | (defcustom holiday-christian-holidays | |
236 | '((holiday-easter-etc) ; respects calendar-christian-all-holidays-flag | |
237 | (holiday-fixed 12 25 "Christmas") | |
238 | (if calendar-christian-all-holidays-flag | |
239 | (append | |
240 | (holiday-fixed 1 6 "Epiphany") | |
241 | (holiday-julian 12 25 "Eastern Orthodox Christmas") | |
242 | (holiday-greek-orthodox-easter) | |
243 | (holiday-fixed 8 15 "Assumption") | |
244 | (holiday-advent 0 "Advent")))) | |
245 | "Christian holidays. | |
246 | See the documentation for `calendar-holidays' for details." | |
247 | :type 'sexp | |
248 | :group 'holidays) | |
249 | ;;;###autoload | |
250 | (put 'holiday-christian-holidays 'risky-local-variable t) | |
251 | ;;;###autoload | |
252 | (define-obsolete-variable-alias 'christian-holidays | |
253 | 'holiday-christian-holidays "23.1") | |
254 | ||
255 | ;;;###autoload | |
256 | (defcustom holiday-islamic-holidays | |
257 | '((holiday-islamic-new-year) | |
258 | (holiday-islamic 9 1 "Ramadan Begins") | |
259 | (if calendar-islamic-all-holidays-flag | |
260 | (append | |
261 | (holiday-islamic 1 10 "Ashura") | |
262 | (holiday-islamic 3 12 "Mulad-al-Nabi") | |
263 | (holiday-islamic 7 26 "Shab-e-Mi'raj") | |
264 | (holiday-islamic 8 15 "Shab-e-Bara't") | |
265 | (holiday-islamic 9 27 "Shab-e Qadr") | |
266 | (holiday-islamic 10 1 "Id-al-Fitr") | |
267 | (holiday-islamic 12 10 "Id-al-Adha")))) | |
268 | "Islamic holidays. | |
269 | See the documentation for `calendar-holidays' for details." | |
270 | :type 'sexp | |
271 | :group 'holidays) | |
272 | ;;;###autoload | |
273 | (put 'holiday-islamic-holidays 'risky-local-variable t) | |
274 | ;;;###autoload | |
275 | (define-obsolete-variable-alias 'islamic-holidays | |
276 | 'holiday-islamic-holidays "23.1") | |
277 | ||
278 | ;;;###autoload | |
279 | (defcustom holiday-bahai-holidays | |
280 | '((holiday-bahai-new-year) | |
281 | (holiday-bahai-ridvan) ; respects calendar-bahai-all-holidays-flag | |
282 | (holiday-fixed 5 23 "Declaration of the Bab") | |
283 | (holiday-fixed 5 29 "Ascension of Baha'u'llah") | |
284 | (holiday-fixed 7 9 "Martyrdom of the Bab") | |
285 | (holiday-fixed 10 20 "Birth of the Bab") | |
286 | (holiday-fixed 11 12 "Birth of Baha'u'llah") | |
287 | (if calendar-bahai-all-holidays-flag | |
288 | (append | |
289 | (holiday-fixed 11 26 "Day of the Covenant") | |
290 | (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha")))) | |
291 | "Baha'i holidays. | |
292 | See the documentation for `calendar-holidays' for details." | |
293 | :type 'sexp | |
294 | :group 'holidays) | |
295 | ;;;###autoload | |
296 | (put 'holiday-bahai-holidays 'risky-local-variable t) | |
297 | ;;;###autoload | |
298 | (define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1") | |
299 | ||
300 | ;;;###autoload | |
301 | (defcustom holiday-solar-holidays | |
302 | '((solar-equinoxes-solstices) | |
303 | (holiday-sexp calendar-daylight-savings-starts | |
304 | (format "Daylight Saving Time Begins %s" | |
305 | (solar-time-string | |
306 | (/ calendar-daylight-savings-starts-time (float 60)) | |
307 | calendar-standard-time-zone-name))) | |
308 | (holiday-sexp calendar-daylight-savings-ends | |
309 | (format "Daylight Saving Time Ends %s" | |
310 | (solar-time-string | |
311 | (/ calendar-daylight-savings-ends-time (float 60)) | |
312 | calendar-daylight-time-zone-name)))) | |
313 | "Sun-related holidays. | |
314 | See the documentation for `calendar-holidays' for details." | |
315 | :type 'sexp | |
316 | :group 'holidays) | |
317 | ;;;###autoload | |
318 | (put 'holiday-solar-holidays 'risky-local-variable t) | |
319 | ;;;###autoload | |
320 | (define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1") | |
321 | ||
322 | ;;;###autoload | |
323 | (defcustom calendar-holidays | |
324 | (append holiday-general-holidays holiday-local-holidays | |
325 | holiday-other-holidays holiday-christian-holidays | |
326 | holiday-hebrew-holidays holiday-islamic-holidays | |
327 | holiday-bahai-holidays holiday-oriental-holidays | |
328 | holiday-solar-holidays) | |
329 | "List of notable days for the command \\[holidays]. | |
330 | ||
331 | Additional holidays are easy to add to the list, just put them in the | |
332 | list `holiday-other-holidays' in your .emacs file. Similarly, by setting | |
333 | any of `holiday-general-holidays', `holiday-local-holidays', | |
334 | `holiday-christian-holidays', `holiday-hebrew-holidays', | |
335 | `holiday-islamic-holidays', `holiday-bahai-holidays', | |
336 | `holiday-oriental-holidays', or `holiday-solar-holidays' to nil in your | |
337 | .emacs file, you can eliminate unwanted categories of holidays. | |
338 | ||
339 | The aforementioned variables control the holiday choices offered | |
340 | by the function `holiday-list' when it is called interactively. | |
341 | ||
342 | They also initialize the default value of `calendar-holidays', | |
343 | which is the default list of holidays used by the function | |
344 | `holiday-list' in the non-interactive case. Note that these | |
345 | variables have no effect on `calendar-holidays' after it has been | |
346 | set (e.g. after the calendar is loaded). In that case, customize | |
347 | `calendar-holidays' directly. | |
348 | ||
349 | The intention is that (in the US) `holiday-local-holidays' be set in | |
350 | site-init.el and `holiday-other-holidays' be set by the user. | |
351 | ||
352 | Entries on the list are expressions that return (possibly empty) lists of | |
353 | items of the form ((month day year) string) of a holiday in the | |
354 | three-month period centered around `displayed-month' of `displayed-year'. | |
355 | Several basic functions are provided for this purpose: | |
356 | ||
357 | (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar | |
358 | (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in | |
359 | MONTH on the Gregorian calendar (0 for Sunday, | |
360 | etc.); K<0 means count back from the end of the | |
361 | month. An optional parameter DAY means the Kth | |
362 | DAYNAME after/before MONTH DAY. | |
363 | (holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar | |
364 | (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar | |
365 | (holiday-bahai MONTH DAY STRING) a fixed date on the Baha'i calendar | |
366 | (holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar | |
367 | (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression | |
368 | in the variable `year'; if it evaluates to | |
369 | a visible date, that's the holiday; if it | |
370 | evaluates to nil, there's no holiday. STRING | |
371 | is an expression in the variable `date'. | |
372 | ||
373 | For example, to add Bastille Day, celebrated in France on July 14, add | |
374 | ||
375 | (holiday-fixed 7 14 \"Bastille Day\") | |
376 | ||
377 | to the list. To add Hurricane Supplication Day, celebrated in the Virgin | |
378 | Islands on the fourth Monday in August, add | |
379 | ||
380 | (holiday-float 8 1 4 \"Hurricane Supplication Day\") | |
381 | ||
382 | to the list (the last Monday would be specified with `-1' instead of `4'). | |
383 | To add the last day of Hanukkah to the list, use | |
384 | ||
385 | (holiday-hebrew 10 2 \"Last day of Hanukkah\") | |
386 | ||
387 | since the Hebrew months are numbered with 1 starting from Nisan. | |
388 | To add the Islamic feast celebrating Mohammed's birthday, use | |
389 | ||
390 | (holiday-islamic 3 12 \"Mohammed's Birthday\") | |
391 | ||
392 | since the Islamic months are numbered from 1 starting with Muharram. | |
393 | To add an entry for the Baha'i festival of Ridvan, use | |
394 | ||
395 | (holiday-bahai 2 13 \"Festival of Ridvan\") | |
396 | ||
397 | since the Baha'i months are numbered from 1 starting with Baha. | |
398 | To add Thomas Jefferson's birthday, April 2, 1743 (Julian), use | |
399 | ||
400 | (holiday-julian 4 2 \"Jefferson's Birthday\") | |
401 | ||
402 | To include a holiday conditionally, use the sexp form or a conditional. For | |
403 | example, to include American presidential elections, which occur on the first | |
404 | Tuesday after the first Monday in November of years divisible by 4, add | |
405 | ||
406 | (holiday-sexp | |
407 | '(if (zerop (% year 4)) | |
408 | (calendar-gregorian-from-absolute | |
409 | (1+ (calendar-dayname-on-or-before | |
410 | 1 (+ 6 (calendar-absolute-from-gregorian | |
411 | (list 11 1 year))))))) | |
412 | \"US Presidential Election\") | |
413 | ||
414 | or | |
415 | ||
416 | (if (zerop (% displayed-year 4)) | |
417 | (holiday-fixed 11 | |
418 | (calendar-extract-day | |
419 | (calendar-gregorian-from-absolute | |
420 | (1+ (calendar-dayname-on-or-before | |
421 | 1 (+ 6 (calendar-absolute-from-gregorian | |
422 | (list 11 1 displayed-year))))))) | |
423 | \"US Presidential Election\")) | |
424 | ||
425 | to the list. To include the phases of the moon, add | |
426 | ||
427 | (lunar-phases) | |
428 | ||
429 | to the holiday list, where `lunar-phases' is an Emacs-Lisp function that | |
430 | you've written to return a (possibly empty) list of the relevant VISIBLE dates | |
431 | with descriptive strings such as | |
432 | ||
433 | (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... )." | |
434 | :type 'sexp | |
435 | :group 'holidays) | |
436 | ;;;###autoload | |
437 | (put 'calendar-holidays 'risky-local-variable t) | |
438 | ||
439 | ;;; End of user options. | |
440 | ||
441 | ||
d92bcf94 | 442 | ;; FIXME name that makes sense |
71855cc5 GM |
443 | ;;;###diary-autoload |
444 | (defun calendar-holiday-list () | |
445 | "Form the list of holidays that occur on dates in the calendar window. | |
446 | The holidays are those in the list `calendar-holidays'." | |
1dbf6332 GM |
447 | (let (res h) |
448 | (sort | |
449 | (dolist (p calendar-holidays res) | |
450 | (if (setq h (if calendar-debug-sexp | |
451 | (let ((stack-trace-on-error t)) | |
452 | (eval p)) | |
453 | (condition-case nil | |
454 | (eval p) | |
455 | (error (beep) | |
456 | (message "Bad holiday list item: %s" p) | |
457 | (sleep-for 2))))) | |
458 | (setq res (append h res)))) | |
459 | 'calendar-date-compare))) | |
71855cc5 | 460 | |
e803eab7 | 461 | (defvar displayed-month) ; from calendar-generate |
125001e9 GM |
462 | (defvar displayed-year) |
463 | ||
d92bcf94 | 464 | ;; FIXME name that makes sense |
71855cc5 GM |
465 | ;;;###cal-autoload |
466 | (defun calendar-list-holidays () | |
467 | "Create a buffer containing the holidays for the current calendar window. | |
d600b865 GM |
468 | The holidays are those in the list `calendar-notable-days'. |
469 | Returns non-nil if any holidays are found." | |
71855cc5 GM |
470 | (interactive) |
471 | (message "Looking up holidays...") | |
472 | (let ((holiday-list (calendar-holiday-list)) | |
473 | (m1 displayed-month) | |
474 | (y1 displayed-year) | |
475 | (m2 displayed-month) | |
476 | (y2 displayed-year)) | |
477 | (if (not holiday-list) | |
d600b865 | 478 | (message "Looking up holidays...none found") |
9449f9eb | 479 | (calendar-in-read-only-buffer holiday-buffer |
e803eab7 GM |
480 | (calendar-increment-month m1 y1 -1) |
481 | (calendar-increment-month m2 y2 1) | |
9449f9eb GM |
482 | (calendar-set-mode-line |
483 | (if (= y1 y2) | |
484 | (format "Notable Dates from %s to %s, %d%%-" | |
485 | (calendar-month-name m1) (calendar-month-name m2) y2) | |
486 | (format "Notable Dates from %s, %d to %s, %d%%-" | |
487 | (calendar-month-name m1) y1 (calendar-month-name m2) y2))) | |
488 | (insert | |
489 | (mapconcat | |
490 | (lambda (x) (concat (calendar-date-string (car x)) | |
491 | ": " (cadr x))) | |
492 | holiday-list "\n"))) | |
d600b865 GM |
493 | (message "Looking up holidays...done")) |
494 | holiday-list)) | |
71855cc5 GM |
495 | |
496 | (define-obsolete-function-alias | |
497 | 'list-calendar-holidays 'calendar-list-holidays "23.1") | |
498 | ||
c8224de6 | 499 | ;;;###autoload |
7e1dae73 | 500 | (defun holidays (&optional arg) |
1802278a | 501 | "Display the holidays for last month, this month, and next month. |
68707926 | 502 | If called with an optional prefix argument ARG, prompts for month and year. |
1802278a | 503 | This function is suitable for execution in a .emacs file." |
7e1dae73 | 504 | (interactive "P") |
1802278a | 505 | (save-excursion |
7e1dae73 | 506 | (let* ((completion-ignore-case t) |
71855cc5 | 507 | (date (if arg (calendar-read-date t) |
c99d4526 | 508 | (calendar-current-date))) |
e803eab7 GM |
509 | (displayed-month (calendar-extract-month date)) |
510 | (displayed-year (calendar-extract-year date))) | |
2317a7cf | 511 | (calendar-list-holidays)))) |
1802278a | 512 | |
5fceaf9c GM |
513 | ;; rms: "Emacs commands to display a list of something generally start |
514 | ;; with `list-'. Please make `list-holidays' the principal name." | |
40b14a0c | 515 | ;;;###autoload |
96ffea61 | 516 | (defun list-holidays (y1 &optional y2 l label) |
056a21c4 | 517 | "Display holidays for years Y1 to Y2 (inclusive). |
f97492e5 GM |
518 | Y2 defaults to Y1. The optional list of holidays L defaults to |
519 | `calendar-holidays'. If you want to control what holidays are | |
520 | displayed, use a different list. For example, | |
29c83850 | 521 | |
5fceaf9c | 522 | (list-holidays 2006 2006 |
e803eab7 | 523 | (append holiday-general-holidays holiday-local-holidays)) |
29c83850 | 524 | |
e803eab7 | 525 | will display holidays for the year 2006 defined in the two |
29c83850 EZ |
526 | mentioned lists, and nothing else. |
527 | ||
cae09dea | 528 | When called interactively, this command offers a choice of |
e803eab7 | 529 | holidays, based on the variables `holiday-solar-holidays' etc. See the |
cae09dea GM |
530 | documentation of `calendar-holidays' for a list of the variables |
531 | that control the choices, as well as a description of the format | |
532 | of a holiday list. | |
056a21c4 RS |
533 | |
534 | The optional LABEL is used to label the buffer created." | |
535 | (interactive | |
536 | (let* ((start-year (calendar-read | |
537 | "Starting year of holidays (>0): " | |
b3a6c0ca | 538 | (lambda (x) (> x 0)) |
d92bcf94 | 539 | (number-to-string (calendar-extract-year |
056a21c4 RS |
540 | (calendar-current-date))))) |
541 | (end-year (calendar-read | |
71855cc5 GM |
542 | (format "Ending year (inclusive) of holidays (>=%s): " |
543 | start-year) | |
544 | (lambda (x) (>= x start-year)) | |
d92bcf94 | 545 | (number-to-string start-year))) |
056a21c4 RS |
546 | (completion-ignore-case t) |
547 | (lists | |
548 | (list | |
549 | (cons "All" calendar-holidays) | |
7d58cf63 GM |
550 | (cons "Equinoxes/Solstices" |
551 | (list (list 'solar-equinoxes-solstices))) | |
e803eab7 GM |
552 | (if holiday-general-holidays |
553 | (cons "General" holiday-general-holidays)) | |
554 | (if holiday-local-holidays | |
555 | (cons "Local" holiday-local-holidays)) | |
556 | (if holiday-other-holidays | |
557 | (cons "Other" holiday-other-holidays)) | |
558 | (if holiday-christian-holidays | |
559 | (cons "Christian" holiday-christian-holidays)) | |
560 | (if holiday-hebrew-holidays | |
561 | (cons "Hebrew" holiday-hebrew-holidays)) | |
562 | (if holiday-islamic-holidays | |
563 | (cons "Islamic" holiday-islamic-holidays)) | |
564 | (if holiday-bahai-holidays | |
565 | (cons "Baha'i" holiday-bahai-holidays)) | |
566 | (if holiday-oriental-holidays | |
567 | (cons "Oriental" holiday-oriental-holidays)) | |
568 | (if holiday-solar-holidays | |
569 | (cons "Solar" holiday-solar-holidays)) | |
056a21c4 RS |
570 | (cons "Ask" nil))) |
571 | (choice (capitalize | |
572 | (completing-read "List (TAB for choices): " lists nil t))) | |
573 | (which (if (string-equal choice "Ask") | |
574 | (eval (read-variable "Enter list name: ")) | |
575 | (cdr (assoc choice lists)))) | |
576 | (name (if (string-equal choice "Equinoxes/Solstices") | |
577 | choice | |
ebad70de | 578 | (if (member choice '("Ask" "")) |
a1506d29 | 579 | "Holidays" |
056a21c4 RS |
580 | (format "%s Holidays" choice))))) |
581 | (list start-year end-year which name))) | |
96ffea61 | 582 | (unless y2 (setq y2 y1)) |
056a21c4 | 583 | (message "Computing holidays...") |
d600b865 GM |
584 | (let ((calendar-holidays (or l calendar-holidays)) |
585 | (title (or label "Holidays")) | |
586 | (s (calendar-absolute-from-gregorian (list 2 1 y1))) | |
587 | (e (calendar-absolute-from-gregorian (list 11 1 y2))) | |
588 | (displayed-month 2) | |
589 | (displayed-year y1) | |
590 | holiday-list) | |
591 | (while (<= s e) | |
592 | (setq holiday-list (append holiday-list (calendar-holiday-list))) | |
e803eab7 | 593 | (calendar-increment-month displayed-month displayed-year 3) |
d600b865 | 594 | (setq s (calendar-absolute-from-gregorian |
056a21c4 | 595 | (list displayed-month 1 displayed-year)))) |
ebad70de | 596 | (save-excursion |
9449f9eb GM |
597 | (calendar-in-read-only-buffer holiday-buffer |
598 | (calendar-set-mode-line | |
599 | (if (= y1 y2) | |
600 | (format "%s for %s" title y1) | |
601 | (format "%s for %s-%s" title y1 y2))) | |
602 | (insert | |
603 | (mapconcat | |
604 | (lambda (x) (concat (calendar-date-string (car x)) | |
605 | ": " (cadr x))) | |
606 | holiday-list "\n"))) | |
ebad70de RS |
607 | (message "Computing holidays...done")))) |
608 | ||
c0dac68f | 609 | ;;;###autoload |
5fceaf9c | 610 | (defalias 'holiday-list 'list-holidays) |
056a21c4 | 611 | |
4ca17d75 | 612 | ;;;###diary-autoload |
2317a7cf | 613 | (defun calendar-check-holidays (date) |
1802278a JB |
614 | "Check the list of holidays for any that occur on DATE. |
615 | The value returned is a list of strings of relevant holiday descriptions. | |
2317a7cf | 616 | The holidays are those in the list `calendar-holidays'." |
e803eab7 GM |
617 | (let ((displayed-month (calendar-extract-month date)) |
618 | (displayed-year (calendar-extract-year date)) | |
d600b865 GM |
619 | holiday-list) |
620 | (dolist (h (calendar-holiday-list) holiday-list) | |
2317a7cf | 621 | (if (calendar-date-equal date (car h)) |
d600b865 | 622 | (setq holiday-list (append holiday-list (cdr h))))))) |
1802278a | 623 | |
71855cc5 GM |
624 | (define-obsolete-function-alias |
625 | 'check-calendar-holidays 'calendar-check-holidays "23.1") | |
626 | ||
4ca17d75 | 627 | ;;;###cal-autoload |
f1eb28f2 GM |
628 | (defun calendar-cursor-holidays (&optional date) |
629 | "Find holidays for the date specified by the cursor in the calendar window. | |
630 | Optional DATE is a list (month day year) to use instead of the | |
631 | cursor position." | |
1802278a JB |
632 | (interactive) |
633 | (message "Checking holidays...") | |
f1eb28f2 GM |
634 | (or date (setq date (calendar-cursor-to-date t))) |
635 | (let* ((date-string (calendar-date-string date)) | |
2317a7cf | 636 | (holiday-list (calendar-check-holidays date)) |
1802278a JB |
637 | (holiday-string (mapconcat 'identity holiday-list "; ")) |
638 | (msg (format "%s: %s" date-string holiday-string))) | |
639 | (if (not holiday-list) | |
640 | (message "No holidays known for %s" date-string) | |
8ec105a0 | 641 | (if (<= (length msg) (frame-width)) |
eec5a2e4 | 642 | (message "%s" msg) |
9449f9eb GM |
643 | (calendar-in-read-only-buffer holiday-buffer |
644 | (calendar-set-mode-line date-string) | |
645 | (insert (mapconcat 'identity holiday-list "\n"))) | |
1802278a JB |
646 | (message "Checking holidays...done"))))) |
647 | ||
d92bcf94 | 648 | ;; FIXME move to calendar? |
4ca17d75 | 649 | ;;;###cal-autoload |
2317a7cf | 650 | (defun calendar-mark-holidays () |
1802278a JB |
651 | "Mark notable days in the calendar window." |
652 | (interactive) | |
e803eab7 | 653 | (setq calendar-mark-holidays-flag t) |
1802278a | 654 | (message "Marking holidays...") |
2317a7cf | 655 | (dolist (holiday (calendar-holiday-list)) |
e803eab7 | 656 | (calendar-mark-visible-date (car holiday) calendar-holiday-marker)) |
1802278a JB |
657 | (message "Marking holidays...done")) |
658 | ||
71855cc5 GM |
659 | (define-obsolete-function-alias |
660 | 'mark-calendar-holidays 'calendar-mark-holidays "23.1") | |
1802278a JB |
661 | |
662 | ;; Below are the functions that calculate the dates of holidays; these | |
8ec105a0 JB |
663 | ;; are eval'ed in the function calendar-holiday-list. If you |
664 | ;; write other such functions, be sure to imitate the style used below. | |
665 | ;; Remember that each function must return a list of items of the form | |
666 | ;; ((month day year) string) of VISIBLE dates in the calendar window. | |
667 | ||
668 | (defun holiday-fixed (month day string) | |
669 | "Holiday on MONTH, DAY (Gregorian) called STRING. | |
670 | If MONTH, DAY is visible, the value returned is the list (((MONTH DAY year) | |
671 | STRING)). Returns nil if it is not visible in the current calendar window." | |
c8a54cf1 GM |
672 | ;; This determines whether a given month is visible in the calendar. |
673 | ;; cf calendar-date-is-visible-p (which also checks the year part). | |
674 | ;; The day is irrelevant since only full months are displayed. | |
675 | ;; Since the calendar displays three months at a time, month N | |
676 | ;; is visible if displayed-month = N-1, N, N+1. | |
677 | ;; In particular, November is visible if d-m = 10, 11, 12. | |
678 | ;; This is useful, because we can do a one-sided test: | |
679 | ;; November is visible if d-m > 9. (Similarly, February is visible if | |
680 | ;; d-m < 4.) | |
681 | ;; To determine if December is visible, we can shift the calendar | |
682 | ;; back a month and ask if November is visible; to determine if | |
683 | ;; October is visible, we can shift it forward a month and ask if | |
684 | ;; November is visible; etc. | |
8ec105a0 JB |
685 | (let ((m displayed-month) |
686 | (y displayed-year)) | |
e803eab7 | 687 | (calendar-increment-month m y (- 11 month)) |
c8a54cf1 | 688 | (if (> m 9) ; is november visible? |
71855cc5 | 689 | (list (list (list month day y) string))))) |
1802278a | 690 | |
8ec105a0 | 691 | (defun holiday-float (month dayname n string &optional day) |
5d595461 GM |
692 | "Holiday called STRING on the Nth DAYNAME after/before MONTH DAY. |
693 | DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on. | |
694 | If N>0, use the Nth DAYNAME after MONTH DAY. | |
695 | If N<0, use the Nth DAYNAME before MONTH DAY. | |
696 | DAY defaults to 1 if N>0, and MONTH's last day otherwise. | |
697 | If the holiday is visible in the calendar window, returns a | |
698 | list (((month day year) STRING)). Otherwise returns nil." | |
d600b865 GM |
699 | ;; This is messy because the holiday may be visible, while the date |
700 | ;; on which it is based is not. For example, the first Monday after | |
701 | ;; December 30 may be visible when January is not. For large values | |
702 | ;; of |n| the problem is more grotesque. If we didn't have to worry | |
703 | ;; about such cases, we could just use the original version of this | |
704 | ;; function: | |
71855cc5 GM |
705 | ;; (let ((m displayed-month) |
706 | ;; (y displayed-year)) | |
e803eab7 | 707 | ;; (calendar-increment-month m y (- 11 month)) |
71855cc5 GM |
708 | ;; (if (> m 9); month in year y is visible |
709 | ;; (list (list (calendar-nth-named-day n dayname month y day) string))))) | |
151eeaa7 RS |
710 | (let* ((m1 displayed-month) |
711 | (y1 displayed-year) | |
d600b865 GM |
712 | (m2 displayed-month) |
713 | (y2 displayed-year) | |
714 | (d1 (progn ; first possible base date for holiday | |
e803eab7 | 715 | (calendar-increment-month m1 y1 -1) |
d600b865 GM |
716 | (+ (calendar-nth-named-absday 1 dayname m1 y1) |
717 | (* -7 n) | |
718 | (if (> n 0) 1 -7)))) | |
719 | (d2 ; last possible base date for holiday | |
720 | (progn | |
e803eab7 | 721 | (calendar-increment-month m2 y2 1) |
151eeaa7 RS |
722 | (+ (calendar-nth-named-absday -1 dayname m2 y2) |
723 | (* -7 n) | |
d600b865 | 724 | (if (> n 0) 7 -1)))) |
e803eab7 GM |
725 | (y1 (calendar-extract-year (calendar-gregorian-from-absolute d1))) |
726 | (y2 (calendar-extract-year (calendar-gregorian-from-absolute d2))) | |
d600b865 GM |
727 | (y ; year of base date |
728 | (if (or (= y1 y2) (> month 9)) | |
729 | y1 | |
730 | y2)) | |
731 | (d ; day of base date | |
732 | (or day (if (> n 0) | |
733 | 1 | |
734 | (calendar-last-day-of-month month y)))) | |
735 | (date ; base date for holiday | |
736 | (calendar-absolute-from-gregorian (list month d y)))) | |
737 | (and (<= d1 date) (<= date d2) | |
738 | (list (list (calendar-nth-named-day n dayname month y d) | |
739 | string))))) | |
8ec105a0 | 740 | |
1dbf6332 GM |
741 | (defun holiday-filter-visible-calendar (hlist) |
742 | "Filter list of holidays HLIST, and return only the visible ones. | |
743 | HLIST is a list of elements of the form (DATE) TEXT." | |
744 | (delq nil (mapcar (lambda (p) | |
745 | (and (car p) (calendar-date-is-visible-p (car p)) p)) | |
746 | hlist))) | |
71855cc5 GM |
747 | |
748 | (define-obsolete-function-alias | |
749 | 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1") | |
750 | ||
8ec105a0 | 751 | (defun holiday-sexp (sexp string) |
7e1dae73 | 752 | "Sexp holiday for dates in the calendar window. |
d600b865 GM |
753 | SEXP is an expression in variable `year' that is evaluated to |
754 | give `date'. STRING is an expression in `date' that evaluates to | |
755 | the holiday description of `date'. If `date' is visible in the | |
756 | calendar window, the holiday STRING is on that date. If date is | |
757 | nil, or if the date is not visible, there is no holiday." | |
7e1dae73 | 758 | (let ((m displayed-month) |
d600b865 GM |
759 | (y displayed-year) |
760 | year date) | |
e803eab7 | 761 | (calendar-increment-month m y -1) |
2317a7cf SM |
762 | (holiday-filter-visible-calendar |
763 | (list | |
d600b865 GM |
764 | (progn |
765 | (setq year y | |
766 | date (eval sexp)) | |
767 | (list date (if date (eval string)))) | |
768 | (progn | |
769 | (setq year (1+ y) | |
770 | date (eval sexp)) | |
771 | (list date (if date (eval string)))))))) | |
772 | ||
8ec105a0 | 773 | |
92dd6c93 GM |
774 | (defun holiday-advent (&optional n string) |
775 | "Date of Nth day after advent (named STRING), if visible in calendar window. | |
776 | Negative values of N are interpreted as days before advent. | |
777 | STRING is used purely for display purposes. The return value has | |
778 | the form ((MONTH DAY YEAR) STRING), where the date is that of the | |
779 | Nth day before or after advent. | |
780 | ||
8dad6f62 | 781 | For backwards compatibility, if this function is called with no |
92dd6c93 | 782 | arguments, then it returns the value appropriate for advent itself." |
8dad6f62 | 783 | ;; Backwards compatibility layer. |
92dd6c93 GM |
784 | (if (not n) |
785 | (holiday-advent 0 "Advent") | |
d600b865 GM |
786 | (let* ((year displayed-year) |
787 | (month displayed-month) | |
788 | (advent (progn | |
e803eab7 | 789 | (calendar-increment-month month year -1) |
d600b865 GM |
790 | (calendar-gregorian-from-absolute |
791 | (+ n | |
792 | (calendar-dayname-on-or-before | |
793 | 0 | |
794 | (calendar-absolute-from-gregorian | |
795 | (list 12 3 year)))))))) | |
796 | (if (calendar-date-is-visible-p advent) | |
797 | (list (list advent string)))))) | |
1a499493 | 798 | |
3cd74de7 GM |
799 | (defun holiday-easter-etc (&optional n string) |
800 | "Date of Nth day after Easter (named STRING), if visible in calendar window. | |
801 | Negative values of N are interpreted as days before Easter. | |
802 | STRING is used purely for display purposes. The return value has | |
803 | the form ((MONTH DAY YEAR) STRING), where the date is that of the | |
804 | Nth day before or after Easter. | |
805 | ||
8dad6f62 | 806 | For backwards compatibility, if this function is called with no |
3cd74de7 | 807 | arguments, then it returns a list of \"standard\" Easter-related |
1c76c939 | 808 | holidays (with more entries if `calendar-christian-all-holidays-flag' |
3cd74de7 | 809 | is non-nil)." |
8dad6f62 | 810 | ;; Backwards compatibility layer. |
3cd74de7 | 811 | (if (not n) |
1dbf6332 GM |
812 | (apply 'append |
813 | (mapcar (lambda (e) | |
814 | (apply 'holiday-easter-etc e)) | |
815 | ;; The combined list is not in order. | |
816 | (append | |
1c76c939 | 817 | (if calendar-christian-all-holidays-flag |
1dbf6332 GM |
818 | '((-63 "Septuagesima Sunday") |
819 | (-56 "Sexagesima Sunday") | |
820 | (-49 "Shrove Sunday") | |
821 | (-48 "Shrove Monday") | |
822 | (-47 "Shrove Tuesday") | |
823 | (-14 "Passion Sunday") | |
824 | (-7 "Palm Sunday") | |
825 | (-3 "Maundy Thursday") | |
826 | (35 "Rogation Sunday") | |
827 | (39 "Ascension Day") | |
828 | (49 "Pentecost (Whitsunday)") | |
829 | (50 "Whitmonday") | |
830 | (56 "Trinity Sunday") | |
831 | (60 "Corpus Christi"))) | |
832 | '((-46 "Ash Wednesday") | |
833 | (-2 "Good Friday") | |
834 | (0 "Easter Sunday"))))) | |
3cd74de7 | 835 | (let* ((century (1+ (/ displayed-year 100))) |
7e2f1bb5 | 836 | (shifted-epact ; age of moon for April 5... |
125001e9 | 837 | (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule |
7e2f1bb5 | 838 | (- ; ...corrected for the Gregorian century rule |
3cd74de7 | 839 | (/ (* 3 century) 4)) |
71855cc5 | 840 | (/ ; ...corrected for Metonic cycle inaccuracy |
3cd74de7 | 841 | (+ 5 (* 8 century)) 25) |
125001e9 | 842 | (* 30 century)) ; keeps value positive |
3cd74de7 | 843 | 30)) |
125001e9 | 844 | (adjusted-epact ; adjust for 29.5 day month |
3cd74de7 GM |
845 | (if (or (zerop shifted-epact) |
846 | (and (= shifted-epact 1) (< 10 (% displayed-year 19)))) | |
847 | (1+ shifted-epact) | |
848 | shifted-epact)) | |
7e2f1bb5 | 849 | (paschal-moon ; day after the full moon on or after March 21 |
3cd74de7 GM |
850 | (- (calendar-absolute-from-gregorian (list 4 19 displayed-year)) |
851 | adjusted-epact)) | |
1dbf6332 GM |
852 | (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7))) |
853 | (greg (calendar-gregorian-from-absolute (+ abs-easter n)))) | |
854 | (if (calendar-date-is-visible-p greg) | |
855 | (list (list greg string)))))) | |
1802278a | 856 | |
cfe199f6 | 857 | ;; Prior call to calendar-julian-from-absolute will autoload cal-julian. |
5c645a20 | 858 | (declare-function calendar-julian-to-absolute "cal-julian" (date)) |
cfe199f6 | 859 | |
8ec105a0 JB |
860 | (defun holiday-greek-orthodox-easter () |
861 | "Date of Easter according to the rule of the Council of Nicaea." | |
d600b865 GM |
862 | (let* ((m displayed-month) |
863 | (y displayed-year) | |
864 | (julian-year (progn | |
e803eab7 GM |
865 | (calendar-increment-month m y 1) |
866 | (calendar-extract-year | |
d600b865 GM |
867 | (calendar-julian-from-absolute |
868 | (calendar-absolute-from-gregorian | |
869 | (list m (calendar-last-day-of-month m y) y)))))) | |
870 | (shifted-epact ; age of moon for April 5 | |
871 | (% (+ 14 | |
872 | (* 11 (% julian-year 19))) | |
873 | 30)) | |
874 | (paschal-moon ; day after full moon on or after March 21 | |
5c645a20 | 875 | (- (calendar-julian-to-absolute (list 4 19 julian-year)) |
d600b865 GM |
876 | shifted-epact)) |
877 | (nicaean-easter ; Sunday following the Paschal moon | |
878 | (calendar-gregorian-from-absolute | |
879 | (calendar-dayname-on-or-before 0 (+ paschal-moon 7))))) | |
880 | (if (calendar-date-is-visible-p nicaean-easter) | |
881 | (list (list nicaean-easter "Pascha (Greek Orthodox Easter)"))))) | |
7e1dae73 | 882 | |
49116ac0 JB |
883 | (provide 'holidays) |
884 | ||
2317a7cf | 885 | ;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37 |
1a06eabd | 886 | ;;; holidays.el ends here |