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