|
0
|
1 ;;; holidays.el --- holiday functions for the calendar package
|
|
|
2
|
|
|
3 ;;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
|
|
|
6 ;; Keywords: holidays, calendar
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; 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.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
16
|
21 ;; along with XEmacs; 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.
|
|
0
|
24
|
|
|
25 ;;; Commentary:
|
|
|
26
|
|
|
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),
|
|
|
39 ;; pages 899-928. ``Calendrical Calculations, Part II: Three Historical
|
|
|
40 ;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
|
|
|
41 ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
|
|
|
42 ;; pages 383-404.
|
|
|
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).
|
|
|
47
|
|
|
48 ;;; Code:
|
|
|
49
|
|
|
50 (require 'calendar)
|
|
|
51
|
|
|
52 (autoload '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 ;;;###autoload
|
|
|
58 (defun holidays (&optional arg)
|
|
|
59 "Display the holidays for last month, this month, and next month.
|
|
|
60 If called with an optional prefix argument, prompts for month and year.
|
|
|
61
|
|
|
62 This function is suitable for execution in a .emacs file."
|
|
|
63 (interactive "P")
|
|
|
64 (save-excursion
|
|
|
65 (let* ((completion-ignore-case t)
|
|
|
66 (date (if arg
|
|
|
67 (calendar-read-date t)
|
|
|
68 (calendar-current-date)))
|
|
|
69 (displayed-month (extract-calendar-month date))
|
|
|
70 (displayed-year (extract-calendar-year date)))
|
|
|
71 (list-calendar-holidays))))
|
|
|
72
|
|
|
73 (defun check-calendar-holidays (date)
|
|
|
74 "Check the list of holidays for any that occur on DATE.
|
|
|
75 The value returned is a list of strings of relevant holiday descriptions.
|
|
|
76 The holidays are those in the list calendar-holidays."
|
|
|
77 (let* ((displayed-month (extract-calendar-month date))
|
|
|
78 (displayed-year (extract-calendar-year date))
|
|
|
79 (h (calendar-holiday-list))
|
|
|
80 (holiday-list))
|
|
|
81 (while h
|
|
|
82 (if (calendar-date-equal date (car (car h)))
|
|
|
83 (setq holiday-list (append holiday-list (cdr (car h)))))
|
|
|
84 (setq h (cdr h)))
|
|
|
85 holiday-list))
|
|
|
86
|
|
|
87 (defun calendar-cursor-holidays ()
|
|
|
88 "Find holidays for the date specified by the cursor in the calendar window."
|
|
|
89 (interactive)
|
|
|
90 (message "Checking holidays...")
|
|
|
91 (let* ((date (calendar-cursor-to-date t))
|
|
|
92 (date-string (calendar-date-string date))
|
|
|
93 (holiday-list (check-calendar-holidays date))
|
|
|
94 (holiday-string (mapconcat 'identity holiday-list "; "))
|
|
|
95 (msg (format "%s: %s" date-string holiday-string)))
|
|
|
96 (if (not holiday-list)
|
|
|
97 (message "No holidays known for %s" date-string)
|
|
|
98 (if (<= (length msg) (frame-width))
|
|
|
99 (message msg)
|
|
|
100 (set-buffer (get-buffer-create holiday-buffer))
|
|
|
101 (setq buffer-read-only nil)
|
|
|
102 (calendar-set-mode-line date-string)
|
|
|
103 (erase-buffer)
|
|
|
104 (insert (mapconcat 'identity holiday-list "\n"))
|
|
|
105 (goto-char (point-min))
|
|
|
106 (set-buffer-modified-p nil)
|
|
|
107 (setq buffer-read-only t)
|
|
|
108 (display-buffer holiday-buffer)
|
|
|
109 (message "Checking holidays...done")))))
|
|
|
110
|
|
|
111 (defun mark-calendar-holidays ()
|
|
|
112 "Mark notable days in the calendar window."
|
|
|
113 (interactive)
|
|
|
114 (setq mark-holidays-in-calendar t)
|
|
|
115 (message "Marking holidays...")
|
|
|
116 (let ((holiday-list (calendar-holiday-list)))
|
|
|
117 (while holiday-list
|
|
|
118 (mark-visible-calendar-date
|
|
|
119 (car (car holiday-list)) calendar-holiday-marker)
|
|
|
120 (setq holiday-list (cdr holiday-list))))
|
|
|
121 (message "Marking holidays...done"))
|
|
|
122
|
|
|
123 (defun list-calendar-holidays ()
|
|
|
124 "Create a buffer containing the holidays for the current calendar window.
|
|
|
125 The holidays are those in the list calendar-notable-days. Returns t if any
|
|
|
126 holidays are found, nil if not."
|
|
|
127 (interactive)
|
|
|
128 (message "Looking up holidays...")
|
|
|
129 (let ((holiday-list (calendar-holiday-list))
|
|
|
130 (m1 displayed-month)
|
|
|
131 (y1 displayed-year)
|
|
|
132 (m2 displayed-month)
|
|
|
133 (y2 displayed-year))
|
|
|
134 (if (not holiday-list)
|
|
|
135 (progn
|
|
|
136 (message "Looking up holidays...none found")
|
|
|
137 nil)
|
|
|
138 (set-buffer (get-buffer-create holiday-buffer))
|
|
|
139 (setq buffer-read-only nil)
|
|
|
140 (increment-calendar-month m1 y1 -1)
|
|
|
141 (increment-calendar-month m2 y2 1)
|
|
|
142 (calendar-set-mode-line
|
|
|
143 (if (= y1 y2)
|
|
|
144 (format "Notable Dates from %s to %s, %d%%-"
|
|
|
145 (calendar-month-name m1) (calendar-month-name m2) y2)
|
|
|
146 (format "Notable Dates from %s, %d to %s, %d%%-"
|
|
|
147 (calendar-month-name m1) y1 (calendar-month-name m2) y2)))
|
|
|
148 (erase-buffer)
|
|
|
149 (insert
|
|
|
150 (mapconcat
|
|
|
151 '(lambda (x) (concat (calendar-date-string (car x))
|
|
|
152 ": " (car (cdr x))))
|
|
|
153 holiday-list "\n"))
|
|
|
154 (goto-char (point-min))
|
|
|
155 (set-buffer-modified-p nil)
|
|
|
156 (setq buffer-read-only t)
|
|
|
157 (display-buffer holiday-buffer)
|
|
|
158 (message "Looking up holidays...done")
|
|
|
159 t)))
|
|
|
160
|
|
|
161 (defun calendar-holiday-list ()
|
|
|
162 "Form the list of holidays that occur on dates in the calendar window.
|
|
|
163 The holidays are those in the list calendar-holidays."
|
|
|
164 (let ((p calendar-holidays)
|
|
|
165 (holiday-list))
|
|
|
166 (while p
|
|
|
167 (let* ((holidays
|
|
|
168 (if calendar-debug-sexp
|
|
|
169 (let ((stack-trace-on-error t))
|
|
|
170 (eval (car p)))
|
|
|
171 (condition-case nil
|
|
|
172 (eval (car p))
|
|
|
173 (error (beep)
|
|
|
174 (message "Bad holiday list item: %s" (car p))
|
|
|
175 (sleep-for 2))))))
|
|
|
176 (if holidays
|
|
|
177 (setq holiday-list (append holidays holiday-list))))
|
|
|
178 (setq p (cdr p)))
|
|
|
179 (setq holiday-list (sort holiday-list 'calendar-date-compare))))
|
|
|
180
|
|
|
181 ;; Below are the functions that calculate the dates of holidays; these
|
|
|
182 ;; are eval'ed in the function calendar-holiday-list. If you
|
|
|
183 ;; write other such functions, be sure to imitate the style used below.
|
|
|
184 ;; Remember that each function must return a list of items of the form
|
|
|
185 ;; ((month day year) string) of VISIBLE dates in the calendar window.
|
|
|
186
|
|
|
187 (defun holiday-fixed (month day string)
|
|
|
188 "Holiday on MONTH, DAY (Gregorian) called STRING.
|
|
|
189 If MONTH, DAY is visible, the value returned is the list (((MONTH DAY year)
|
|
|
190 STRING)). Returns nil if it is not visible in the current calendar window."
|
|
|
191 (let ((m displayed-month)
|
|
|
192 (y displayed-year))
|
|
|
193 (increment-calendar-month m y (- 11 month))
|
|
|
194 (if (> m 9)
|
|
|
195 (list (list (list month day y) string)))))
|
|
|
196
|
|
|
197 (defun holiday-float (month dayname n string &optional day)
|
|
|
198 "Holiday on MONTH, DAYNAME (Nth occurrence, Gregorian) called STRING.
|
|
|
199 If the Nth DAYNAME in MONTH is visible, the value returned is the list
|
|
|
200 \(((MONTH DAY year) STRING)).
|
|
|
201
|
|
|
202 If N<0, count backward from the end of MONTH.
|
|
|
203
|
|
|
204 An optional parameter DAY means the Nth DAYNAME after/before MONTH DAY.
|
|
|
205
|
|
|
206 Returns nil if it is not visible in the current calendar window."
|
|
|
207 (let ((m displayed-month)
|
|
|
208 (y displayed-year))
|
|
|
209 (increment-calendar-month m y (- 11 month))
|
|
|
210 (if (> m 9)
|
|
|
211 (list (list (calendar-nth-named-day n dayname month y day) string)))))
|
|
|
212
|
|
|
213 (defun holiday-julian (month day string)
|
|
|
214 "Holiday on MONTH, DAY (Julian) called STRING.
|
|
|
215 If MONTH, DAY (Julian) is visible, the value returned is corresponding
|
|
|
216 Gregorian date in the form of the list (((month day year) STRING)). Returns
|
|
|
217 nil if it is not visible in the current calendar window."
|
|
|
218 (let ((m1 displayed-month)
|
|
|
219 (y1 displayed-year)
|
|
|
220 (m2 displayed-month)
|
|
|
221 (y2 displayed-year)
|
|
|
222 (year))
|
|
|
223 (increment-calendar-month m1 y1 -1)
|
|
|
224 (increment-calendar-month m2 y2 1)
|
|
|
225 (let* ((start-date (calendar-absolute-from-gregorian
|
|
|
226 (list m1 1 y1)))
|
|
|
227 (end-date (calendar-absolute-from-gregorian
|
|
|
228 (list m2 (calendar-last-day-of-month m2 y2) y2)))
|
|
|
229 (julian-start (calendar-julian-from-absolute start-date))
|
|
|
230 (julian-end (calendar-julian-from-absolute end-date))
|
|
|
231 (julian-y1 (extract-calendar-year julian-start))
|
|
|
232 (julian-y2 (extract-calendar-year julian-end)))
|
|
|
233 (setq year (if (< 10 month) julian-y1 julian-y2))
|
|
|
234 (let ((date (calendar-gregorian-from-absolute
|
|
|
235 (calendar-absolute-from-julian
|
|
|
236 (list month day year)))))
|
|
|
237 (if (calendar-date-is-visible-p date)
|
|
|
238 (list (list date string)))))))
|
|
|
239
|
|
|
240 (defun holiday-islamic (month day string)
|
|
|
241 "Holiday on MONTH, DAY (Islamic) called STRING.
|
|
|
242 If MONTH, DAY (Islamic) is visible, the value returned is corresponding
|
|
|
243 Gregorian date in the form of the list (((month day year) STRING)). Returns
|
|
|
244 nil if it is not visible in the current calendar window."
|
|
|
245 (let* ((islamic-date (calendar-islamic-from-absolute
|
|
|
246 (calendar-absolute-from-gregorian
|
|
|
247 (list displayed-month 15 displayed-year))))
|
|
|
248 (m (extract-calendar-month islamic-date))
|
|
|
249 (y (extract-calendar-year islamic-date))
|
|
|
250 (date))
|
|
|
251 (if (< m 1)
|
|
|
252 nil;; Islamic calendar doesn't apply.
|
|
|
253 (increment-calendar-month m y (- 10 month))
|
|
|
254 (if (> m 7);; Islamic date might be visible
|
|
|
255 (let ((date (calendar-gregorian-from-absolute
|
|
|
256 (calendar-absolute-from-islamic (list month day y)))))
|
|
|
257 (if (calendar-date-is-visible-p date)
|
|
|
258 (list (list date string))))))))
|
|
|
259
|
|
|
260 (defun holiday-hebrew (month day string)
|
|
|
261 "Holiday on MONTH, DAY (Hebrew) called STRING.
|
|
|
262 If MONTH, DAY (Hebrew) is visible, the value returned is corresponding
|
|
|
263 Gregorian date in the form of the list (((month day year) STRING)). Returns
|
|
|
264 nil if it is not visible in the current calendar window."
|
|
|
265 (if (memq displayed-month;; This test is only to speed things up a bit;
|
|
|
266 (list ;; it works fine without the test too.
|
|
|
267 (if (< 11 month) (- month 11) (+ month 1))
|
|
|
268 (if (< 10 month) (- month 10) (+ month 2))
|
|
|
269 (if (< 9 month) (- month 9) (+ month 3))
|
|
|
270 (if (< 8 month) (- month 8) (+ month 4))
|
|
|
271 (if (< 7 month) (- month 7) (+ month 5))))
|
|
|
272 (let ((m1 displayed-month)
|
|
|
273 (y1 displayed-year)
|
|
|
274 (m2 displayed-month)
|
|
|
275 (y2 displayed-year)
|
|
|
276 (year))
|
|
|
277 (increment-calendar-month m1 y1 -1)
|
|
|
278 (increment-calendar-month m2 y2 1)
|
|
|
279 (let* ((start-date (calendar-absolute-from-gregorian
|
|
|
280 (list m1 1 y1)))
|
|
|
281 (end-date (calendar-absolute-from-gregorian
|
|
|
282 (list m2 (calendar-last-day-of-month m2 y2) y2)))
|
|
|
283 (hebrew-start (calendar-hebrew-from-absolute start-date))
|
|
|
284 (hebrew-end (calendar-hebrew-from-absolute end-date))
|
|
|
285 (hebrew-y1 (extract-calendar-year hebrew-start))
|
|
|
286 (hebrew-y2 (extract-calendar-year hebrew-end)))
|
|
|
287 (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
|
|
|
288 (let ((date (calendar-gregorian-from-absolute
|
|
|
289 (calendar-absolute-from-hebrew
|
|
|
290 (list month day year)))))
|
|
|
291 (if (calendar-date-is-visible-p date)
|
|
|
292 (list (list date string))))))))
|
|
|
293
|
|
|
294 (defun holiday-sexp (sexp string)
|
|
|
295 "Sexp holiday for dates in the calendar window.
|
|
|
296 SEXP is an expression in variable `year' evaluates to `date'.
|
|
|
297
|
|
|
298 STRING is an expression in `date' that evaluates to the holiday description
|
|
|
299 of `date'.
|
|
|
300
|
|
|
301 If `date' is visible in the calendar window, the holiday STRING is on that
|
|
|
302 date. If date is nil, or if the date is not visible, there is no holiday."
|
|
|
303 (let ((m displayed-month)
|
|
|
304 (y displayed-year))
|
|
|
305 (increment-calendar-month m y -1)
|
|
|
306 (filter-visible-calendar-holidays
|
|
|
307 (append
|
|
|
308 (let* ((year y)
|
|
|
309 (date (eval sexp))
|
|
|
310 (string (if date (eval string))))
|
|
|
311 (list (list date string)))
|
|
|
312 (let* ((year (1+ y))
|
|
|
313 (date (eval sexp))
|
|
|
314 (string (if date (eval string))))
|
|
|
315 (list (list date string)))))))
|
|
|
316
|
|
|
317 (defun holiday-advent ()
|
|
|
318 "Date of Advent, if visible in calendar window."
|
|
|
319 (let ((year displayed-year)
|
|
|
320 (month displayed-month))
|
|
|
321 (increment-calendar-month month year -1)
|
|
|
322 (let ((advent (calendar-gregorian-from-absolute
|
|
|
323 (calendar-dayname-on-or-before 0
|
|
|
324 (calendar-absolute-from-gregorian
|
|
|
325 (list 12 3 year))))))
|
|
|
326 (if (calendar-date-is-visible-p advent)
|
|
|
327 (list (list advent "Advent"))))))
|
|
|
328
|
|
|
329 (defun holiday-easter-etc ()
|
|
|
330 "List of dates related to Easter, as visible in calendar window."
|
|
|
331 (if (and (> displayed-month 5) (not all-christian-calendar-holidays))
|
|
|
332 nil;; Ash Wednesday, Good Friday, and Easter are not visible.
|
|
|
333 (let* ((century (1+ (/ displayed-year 100)))
|
|
|
334 (shifted-epact ;; Age of moon for April 5...
|
|
|
335 (% (+ 14 (* 11 (% displayed-year 19));; ...by Nicaean rule
|
|
|
336 (- ;; ...corrected for the Gregorian century rule
|
|
|
337 (/ (* 3 century) 4))
|
|
|
338 (/ ;; ...corrected for Metonic cycle inaccuracy.
|
|
|
339 (+ 5 (* 8 century)) 25)
|
|
|
340 (* 30 century));; Keeps value positive.
|
|
|
341 30))
|
|
|
342 (adjusted-epact ;; Adjust for 29.5 day month.
|
|
|
343 (if (or (= shifted-epact 0)
|
|
|
344 (and (= shifted-epact 1) (< 10 (% displayed-year 19))))
|
|
|
345 (1+ shifted-epact)
|
|
|
346 shifted-epact))
|
|
|
347 (paschal-moon ;; Day after the full moon on or after March 21.
|
|
|
348 (- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
|
|
|
349 adjusted-epact))
|
|
|
350 (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
|
|
|
351 (mandatory
|
|
|
352 (list
|
|
|
353 (list (calendar-gregorian-from-absolute abs-easter)
|
|
|
354 "Easter Sunday")
|
|
|
355 (list (calendar-gregorian-from-absolute (- abs-easter 2))
|
|
|
356 "Good Friday")
|
|
|
357 (list (calendar-gregorian-from-absolute (- abs-easter 46))
|
|
|
358 "Ash Wednesday")))
|
|
|
359 (optional
|
|
|
360 (list
|
|
|
361 (list (calendar-gregorian-from-absolute (- abs-easter 63))
|
|
|
362 "Septuagesima Sunday")
|
|
|
363 (list (calendar-gregorian-from-absolute (- abs-easter 56))
|
|
|
364 "Sexagesima Sunday")
|
|
|
365 (list (calendar-gregorian-from-absolute (- abs-easter 49))
|
|
|
366 "Shrove Sunday")
|
|
|
367 (list (calendar-gregorian-from-absolute (- abs-easter 48))
|
|
|
368 "Shrove Monday")
|
|
|
369 (list (calendar-gregorian-from-absolute (- abs-easter 47))
|
|
|
370 "Shrove Tuesday")
|
|
|
371 (list (calendar-gregorian-from-absolute (- abs-easter 14))
|
|
|
372 "Passion Sunday")
|
|
|
373 (list (calendar-gregorian-from-absolute (- abs-easter 7))
|
|
|
374 "Palm Sunday")
|
|
|
375 (list (calendar-gregorian-from-absolute (- abs-easter 3))
|
|
|
376 "Maundy Thursday")
|
|
|
377 (list (calendar-gregorian-from-absolute (+ abs-easter 35))
|
|
|
378 "Rogation Sunday")
|
|
|
379 (list (calendar-gregorian-from-absolute (+ abs-easter 39))
|
|
|
380 "Ascension Day")
|
|
|
381 (list (calendar-gregorian-from-absolute (+ abs-easter 49))
|
|
|
382 "Pentecost (Whitsunday)")
|
|
|
383 (list (calendar-gregorian-from-absolute (+ abs-easter 50))
|
|
|
384 "Whitmunday")
|
|
|
385 (list (calendar-gregorian-from-absolute (+ abs-easter 56))
|
|
|
386 "Trinity Sunday")
|
|
|
387 (list (calendar-gregorian-from-absolute (+ abs-easter 60))
|
|
|
388 "Corpus Christi")))
|
|
|
389 (output-list
|
|
|
390 (filter-visible-calendar-holidays mandatory)))
|
|
|
391 (if all-christian-calendar-holidays
|
|
|
392 (setq output-list
|
|
|
393 (append
|
|
|
394 (filter-visible-calendar-holidays optional)
|
|
|
395 output-list)))
|
|
|
396 output-list)))
|
|
|
397
|
|
|
398 (defun holiday-greek-orthodox-easter ()
|
|
|
399 "Date of Easter according to the rule of the Council of Nicaea."
|
|
|
400 (let ((m displayed-month)
|
|
|
401 (y displayed-year))
|
|
|
402 (increment-calendar-month m y 1)
|
|
|
403 (let* ((julian-year
|
|
|
404 (extract-calendar-year
|
|
|
405 (calendar-julian-from-absolute
|
|
|
406 (calendar-absolute-from-gregorian
|
|
|
407 (list m (calendar-last-day-of-month m y) y)))))
|
|
|
408 (shifted-epact ;; Age of moon for April 5.
|
|
|
409 (% (+ 14
|
|
|
410 (* 11 (% julian-year 19)))
|
|
|
411 30))
|
|
|
412 (paschal-moon ;; Day after full moon on or after March 21.
|
|
|
413 (- (calendar-absolute-from-julian (list 4 19 julian-year))
|
|
|
414 shifted-epact))
|
|
|
415 (nicaean-easter;; Sunday following the Paschal moon
|
|
|
416 (calendar-gregorian-from-absolute
|
|
|
417 (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))))
|
|
|
418 (if (calendar-date-is-visible-p nicaean-easter)
|
|
|
419 (list (list nicaean-easter "Pascha (Greek Orthodox Easter)"))))))
|
|
|
420
|
|
|
421 (defun holiday-rosh-hashanah-etc ()
|
|
|
422 "List of dates related to Rosh Hashanah, as visible in calendar window."
|
|
|
423 (if (or (< displayed-month 8)
|
|
|
424 (> displayed-month 11))
|
|
|
425 nil;; None of the dates is visible
|
|
|
426 (let* ((abs-r-h (calendar-absolute-from-hebrew
|
|
|
427 (list 7 1 (+ displayed-year 3761))))
|
|
|
428 (mandatory
|
|
|
429 (list
|
|
|
430 (list (calendar-gregorian-from-absolute abs-r-h)
|
|
|
431 (format "Rosh HaShanah %d" (+ 3761 displayed-year)))
|
|
|
432 (list (calendar-gregorian-from-absolute (+ abs-r-h 9))
|
|
|
433 "Yom Kippur")
|
|
|
434 (list (calendar-gregorian-from-absolute (+ abs-r-h 14))
|
|
|
435 "Sukkot")
|
|
|
436 (list (calendar-gregorian-from-absolute (+ abs-r-h 21))
|
|
|
437 "Shemini Atzeret")
|
|
|
438 (list (calendar-gregorian-from-absolute (+ abs-r-h 22))
|
|
|
439 "Simchat Torah")))
|
|
|
440 (optional
|
|
|
441 (list
|
|
|
442 (list (calendar-gregorian-from-absolute
|
|
|
443 (calendar-dayname-on-or-before 6 (- abs-r-h 4)))
|
|
|
444 "Selichot (night)")
|
|
|
445 (list (calendar-gregorian-from-absolute (1- abs-r-h))
|
|
|
446 "Erev Rosh HaShannah")
|
|
|
447 (list (calendar-gregorian-from-absolute (1+ abs-r-h))
|
|
|
448 "Rosh HaShanah (second day)")
|
|
|
449 (list (calendar-gregorian-from-absolute
|
|
|
450 (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2)))
|
|
|
451 "Tzom Gedaliah")
|
|
|
452 (list (calendar-gregorian-from-absolute
|
|
|
453 (calendar-dayname-on-or-before 6 (+ 7 abs-r-h)))
|
|
|
454 "Shabbat Shuvah")
|
|
|
455 (list (calendar-gregorian-from-absolute (+ abs-r-h 8))
|
|
|
456 "Erev Yom Kippur")
|
|
|
457 (list (calendar-gregorian-from-absolute (+ abs-r-h 13))
|
|
|
458 "Erev Sukkot")
|
|
|
459 (list (calendar-gregorian-from-absolute (+ abs-r-h 15))
|
|
|
460 "Sukkot (second day)")
|
|
|
461 (list (calendar-gregorian-from-absolute (+ abs-r-h 16))
|
|
|
462 "Hol Hamoed Sukkot (first day)")
|
|
|
463 (list (calendar-gregorian-from-absolute (+ abs-r-h 17))
|
|
|
464 "Hol Hamoed Sukkot (second day)")
|
|
|
465 (list (calendar-gregorian-from-absolute (+ abs-r-h 18))
|
|
|
466 "Hol Hamoed Sukkot (third day)")
|
|
|
467 (list (calendar-gregorian-from-absolute (+ abs-r-h 19))
|
|
|
468 "Hol Hamoed Sukkot (fourth day)")
|
|
|
469 (list (calendar-gregorian-from-absolute (+ abs-r-h 20))
|
|
|
470 "Hoshannah Rabbah")))
|
|
|
471 (output-list
|
|
|
472 (filter-visible-calendar-holidays mandatory)))
|
|
|
473 (if all-hebrew-calendar-holidays
|
|
|
474 (setq output-list
|
|
|
475 (append
|
|
|
476 (filter-visible-calendar-holidays optional)
|
|
|
477 output-list)))
|
|
|
478 output-list)))
|
|
|
479
|
|
|
480 (defun holiday-hanukkah ()
|
|
|
481 "List of dates related to Hanukkah, as visible in calendar window."
|
|
|
482 (if (memq displayed-month;; This test is only to speed things up a bit;
|
|
|
483 '(10 11 12 1 2));; it works fine without the test too.
|
|
|
484 (let ((m displayed-month)
|
|
|
485 (y displayed-year))
|
|
|
486 (increment-calendar-month m y 1)
|
|
|
487 (let* ((h-y (extract-calendar-year
|
|
|
488 (calendar-hebrew-from-absolute
|
|
|
489 (calendar-absolute-from-gregorian
|
|
|
490 (list m (calendar-last-day-of-month m y) y)))))
|
|
|
491 (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y))))
|
|
|
492 (filter-visible-calendar-holidays
|
|
|
493 (list
|
|
|
494 (list (calendar-gregorian-from-absolute (1- abs-h))
|
|
|
495 "Erev Hanukkah")
|
|
|
496 (list (calendar-gregorian-from-absolute abs-h)
|
|
|
497 "Hanukkah (first day)")
|
|
|
498 (list (calendar-gregorian-from-absolute (1+ abs-h))
|
|
|
499 "Hanukkah (second day)")
|
|
|
500 (list (calendar-gregorian-from-absolute (+ abs-h 2))
|
|
|
501 "Hanukkah (third day)")
|
|
|
502 (list (calendar-gregorian-from-absolute (+ abs-h 3))
|
|
|
503 "Hanukkah (fourth day)")
|
|
|
504 (list (calendar-gregorian-from-absolute (+ abs-h 4))
|
|
|
505 "Hanukkah (fifth day)")
|
|
|
506 (list (calendar-gregorian-from-absolute (+ abs-h 5))
|
|
|
507 "Hanukkah (sixth day)")
|
|
|
508 (list (calendar-gregorian-from-absolute (+ abs-h 6))
|
|
|
509 "Hanukkah (seventh day)")
|
|
|
510 (list (calendar-gregorian-from-absolute (+ abs-h 7))
|
|
|
511 "Hanukkah (eighth day)")))))))
|
|
|
512
|
|
|
513 (defun holiday-passover-etc ()
|
|
|
514 "List of dates related to Passover, as visible in calendar window."
|
|
|
515 (if (< 7 displayed-month)
|
|
|
516 nil;; None of the dates is visible
|
|
|
517 (let* ((abs-p (calendar-absolute-from-hebrew
|
|
|
518 (list 1 15 (+ displayed-year 3760))))
|
|
|
519 (mandatory
|
|
|
520 (list
|
|
|
521 (list (calendar-gregorian-from-absolute abs-p)
|
|
|
522 "Passover")
|
|
|
523 (list (calendar-gregorian-from-absolute (+ abs-p 50))
|
|
|
524 "Shavuot")))
|
|
|
525 (optional
|
|
|
526 (list
|
|
|
527 (list (calendar-gregorian-from-absolute
|
|
|
528 (calendar-dayname-on-or-before 6 (- abs-p 43)))
|
|
|
529 "Shabbat Shekalim")
|
|
|
530 (list (calendar-gregorian-from-absolute
|
|
|
531 (calendar-dayname-on-or-before 6 (- abs-p 30)))
|
|
|
532 "Shabbat Zachor")
|
|
|
533 (list (calendar-gregorian-from-absolute
|
|
|
534 (if (= (% abs-p 7) 2) (- abs-p 33) (- abs-p 31)))
|
|
|
535 "Fast of Esther")
|
|
|
536 (list (calendar-gregorian-from-absolute (- abs-p 31))
|
|
|
537 "Erev Purim")
|
|
|
538 (list (calendar-gregorian-from-absolute (- abs-p 30))
|
|
|
539 "Purim")
|
|
|
540 (list (calendar-gregorian-from-absolute
|
|
|
541 (if (zerop (% abs-p 7)) (- abs-p 28) (- abs-p 29)))
|
|
|
542 "Shushan Purim")
|
|
|
543 (list (calendar-gregorian-from-absolute
|
|
|
544 (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7))
|
|
|
545 "Shabbat Parah")
|
|
|
546 (list (calendar-gregorian-from-absolute
|
|
|
547 (calendar-dayname-on-or-before 6 (- abs-p 14)))
|
|
|
548 "Shabbat HaHodesh")
|
|
|
549 (list (calendar-gregorian-from-absolute
|
|
|
550 (calendar-dayname-on-or-before 6 (1- abs-p)))
|
|
|
551 "Shabbat HaGadol")
|
|
|
552 (list (calendar-gregorian-from-absolute (1- abs-p))
|
|
|
553 "Erev Passover")
|
|
|
554 (list (calendar-gregorian-from-absolute (1+ abs-p))
|
|
|
555 "Passover (second day)")
|
|
|
556 (list (calendar-gregorian-from-absolute (+ abs-p 2))
|
|
|
557 "Hol Hamoed Passover (first day)")
|
|
|
558 (list (calendar-gregorian-from-absolute (+ abs-p 3))
|
|
|
559 "Hol Hamoed Passover (second day)")
|
|
|
560 (list (calendar-gregorian-from-absolute (+ abs-p 4))
|
|
|
561 "Hol Hamoed Passover (third day)")
|
|
|
562 (list (calendar-gregorian-from-absolute (+ abs-p 5))
|
|
|
563 "Hol Hamoed Passover (fourth day)")
|
|
|
564 (list (calendar-gregorian-from-absolute (+ abs-p 6))
|
|
|
565 "Passover (seventh day)")
|
|
|
566 (list (calendar-gregorian-from-absolute (+ abs-p 7))
|
|
|
567 "Passover (eighth day)")
|
|
|
568 (list (calendar-gregorian-from-absolute (+ abs-p 12))
|
|
|
569 "Yom HaShoah")
|
|
|
570 (list (calendar-gregorian-from-absolute
|
|
|
571 (if (zerop (% abs-p 7))
|
|
|
572 (+ abs-p 18)
|
|
|
573 (if (= (% abs-p 7) 6)
|
|
|
574 (+ abs-p 19)
|
|
|
575 (+ abs-p 20))))
|
|
|
576 "Yom HaAtzma'ut")
|
|
|
577 (list (calendar-gregorian-from-absolute (+ abs-p 33))
|
|
|
578 "Lag BaOmer")
|
|
|
579 (list (calendar-gregorian-from-absolute (+ abs-p 43))
|
|
|
580 "Yom Yerushalim")
|
|
|
581 (list (calendar-gregorian-from-absolute (+ abs-p 49))
|
|
|
582 "Erev Shavuot")
|
|
|
583 (list (calendar-gregorian-from-absolute (+ abs-p 51))
|
|
|
584 "Shavuot (second day)")))
|
|
|
585 (output-list
|
|
|
586 (filter-visible-calendar-holidays mandatory)))
|
|
|
587 (if all-hebrew-calendar-holidays
|
|
|
588 (setq output-list
|
|
|
589 (append
|
|
|
590 (filter-visible-calendar-holidays optional)
|
|
|
591 output-list)))
|
|
|
592 output-list)))
|
|
|
593
|
|
|
594 (defun holiday-tisha-b-av-etc ()
|
|
|
595 "List of dates around Tisha B'Av, as visible in calendar window."
|
|
|
596 (if (or (< displayed-month 5)
|
|
|
597 (> displayed-month 9))
|
|
|
598 nil;; None of the dates is visible
|
|
|
599 (let* ((abs-t-a (calendar-absolute-from-hebrew
|
|
|
600 (list 5 9 (+ displayed-year 3760)))))
|
|
|
601
|
|
|
602 (filter-visible-calendar-holidays
|
|
|
603 (list
|
|
|
604 (list (calendar-gregorian-from-absolute
|
|
|
605 (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))
|
|
|
606 "Tzom Tammuz")
|
|
|
607 (list (calendar-gregorian-from-absolute
|
|
|
608 (calendar-dayname-on-or-before 6 abs-t-a))
|
|
|
609 "Shabbat Hazon")
|
|
|
610 (list (calendar-gregorian-from-absolute
|
|
|
611 (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a))
|
|
|
612 "Tisha B'Av")
|
|
|
613 (list (calendar-gregorian-from-absolute
|
|
|
614 (calendar-dayname-on-or-before 6 (+ abs-t-a 7)))
|
|
|
615 "Shabbat Nahamu"))))))
|
|
|
616
|
|
|
617 (defun filter-visible-calendar-holidays (l)
|
|
|
618 "Return a list of all visible holidays of those on L."
|
|
|
619 (let ((visible)
|
|
|
620 (p l))
|
|
|
621 (while p
|
|
|
622 (and (car (car p))
|
|
|
623 (calendar-date-is-visible-p (car (car p)))
|
|
|
624 (setq visible (append (list (car p)) visible)))
|
|
|
625 (setq p (cdr p)))
|
|
|
626 visible))
|
|
|
627
|
|
|
628 (provide 'holidays)
|
|
|
629
|
|
|
630 ;;; holidays.el ends here
|
