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