Mercurial > emacs
annotate lisp/calendar/holidays.el @ 13106:22011e724596
(Qmouse_leave_buffer_hook): New variable.
(syms_of_frame_1): Initialize it.
(Fhandle_switch_frame): Run the hooks.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 03 Oct 1995 09:14:54 +0000 |
parents | 2072d3ab4119 |
children | e411b827878f |
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 |
13043
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
51 (autoload 'holiday-julian "cal-julian" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
52 "Holiday on MONTH, DAY (Julian) called STRING." |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
53 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
54 |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
55 (autoload 'holiday-hebrew "cal-hebrew" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
56 "Holiday on MONTH, DAY (Hebrew) called STRING." |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
57 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
58 |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
59 (autoload 'holiday-rosh-hashanah-etc "cal-hebrew" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
60 "List of dates related to Rosh Hashanah, as visible in calendar window." |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
61 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
62 |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
63 (autoload 'holiday-hanukkah "cal-hebrew" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
64 "List of dates related to Hanukkah, as visible in calendar window." |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
65 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
66 |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
67 (autoload 'holiday-passover-etc "cal-hebrew" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
68 "List of dates related to Passover, as visible in calendar window." |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
69 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
70 |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
71 (autoload 'holiday-tisha-b-av-etc "cal-hebrew" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
72 "List of dates around Tisha B'Av, as visible in calendar window." |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
73 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
74 |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
75 (autoload 'holiday-islamic "cal-islamic" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
76 "Holiday on MONTH, DAY (Islamic) called STRING." |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
77 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
78 |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
79 (autoload 'holiday-chinese-new-year "cal-chinese" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
80 "Date of Chinese New Year." |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
81 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
82 |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
83 (autoload 'solar-equinoxes-solstices "solar" |
957 | 84 "Date and time of equinoxes and solstices, if visible in the calendar window. |
85 Requires floating point." | |
86 t) | |
87 | |
88 (defun holidays (&optional arg) | |
406 | 89 "Display the holidays for last month, this month, and next month. |
957 | 90 If called with an optional prefix argument, prompts for month and year. |
91 | |
406 | 92 This function is suitable for execution in a .emacs file." |
957 | 93 (interactive "P") |
406 | 94 (save-excursion |
957 | 95 (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
|
96 (date (if arg |
275845a98fa8
Use new form of calendar-read-date.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
7639
diff
changeset
|
97 (calendar-read-date t) |
275845a98fa8
Use new form of calendar-read-date.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
7639
diff
changeset
|
98 (calendar-current-date))) |
275845a98fa8
Use new form of calendar-read-date.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
7639
diff
changeset
|
99 (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
|
100 (displayed-year (extract-calendar-year date))) |
406 | 101 (list-calendar-holidays)))) |
102 | |
103 (defun check-calendar-holidays (date) | |
104 "Check the list of holidays for any that occur on DATE. | |
105 The value returned is a list of strings of relevant holiday descriptions. | |
106 The holidays are those in the list calendar-holidays." | |
107 (let* ((displayed-month (extract-calendar-month date)) | |
108 (displayed-year (extract-calendar-year date)) | |
109 (h (calendar-holiday-list)) | |
110 (holiday-list)) | |
111 (while h | |
112 (if (calendar-date-equal date (car (car h))) | |
113 (setq holiday-list (append holiday-list (cdr (car h))))) | |
114 (setq h (cdr h))) | |
115 holiday-list)) | |
116 | |
117 (defun calendar-cursor-holidays () | |
118 "Find holidays for the date specified by the cursor in the calendar window." | |
119 (interactive) | |
120 (message "Checking holidays...") | |
5831
7a4647230b22
(calendar-cursor-holidays): Use new error arg
Richard M. Stallman <rms@gnu.org>
parents:
5696
diff
changeset
|
121 (let* ((date (calendar-cursor-to-date t)) |
406 | 122 (date-string (calendar-date-string date)) |
123 (holiday-list (check-calendar-holidays date)) | |
124 (holiday-string (mapconcat 'identity holiday-list "; ")) | |
125 (msg (format "%s: %s" date-string holiday-string))) | |
126 (if (not holiday-list) | |
127 (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
|
128 (if (<= (length msg) (frame-width)) |
406 | 129 (message msg) |
130 (set-buffer (get-buffer-create holiday-buffer)) | |
131 (setq buffer-read-only nil) | |
957 | 132 (calendar-set-mode-line date-string) |
406 | 133 (erase-buffer) |
134 (insert (mapconcat 'identity holiday-list "\n")) | |
135 (goto-char (point-min)) | |
136 (set-buffer-modified-p nil) | |
137 (setq buffer-read-only t) | |
138 (display-buffer holiday-buffer) | |
139 (message "Checking holidays...done"))))) | |
140 | |
141 (defun mark-calendar-holidays () | |
142 "Mark notable days in the calendar window." | |
143 (interactive) | |
144 (setq mark-holidays-in-calendar t) | |
145 (message "Marking holidays...") | |
146 (let ((holiday-list (calendar-holiday-list))) | |
147 (while holiday-list | |
148 (mark-visible-calendar-date | |
149 (car (car holiday-list)) calendar-holiday-marker) | |
150 (setq holiday-list (cdr holiday-list)))) | |
151 (message "Marking holidays...done")) | |
152 | |
153 (defun list-calendar-holidays () | |
154 "Create a buffer containing the holidays for the current calendar window. | |
155 The holidays are those in the list calendar-notable-days. Returns t if any | |
156 holidays are found, nil if not." | |
157 (interactive) | |
158 (message "Looking up holidays...") | |
159 (let ((holiday-list (calendar-holiday-list)) | |
160 (m1 displayed-month) | |
161 (y1 displayed-year) | |
162 (m2 displayed-month) | |
163 (y2 displayed-year)) | |
164 (if (not holiday-list) | |
165 (progn | |
166 (message "Looking up holidays...none found") | |
167 nil) | |
168 (set-buffer (get-buffer-create holiday-buffer)) | |
169 (setq buffer-read-only nil) | |
170 (increment-calendar-month m1 y1 -1) | |
171 (increment-calendar-month m2 y2 1) | |
957 | 172 (calendar-set-mode-line |
5696
baab03aaf3b9
(list-calendar-holidays): Fix mode line.
Richard M. Stallman <rms@gnu.org>
parents:
4864
diff
changeset
|
173 (if (= y1 y2) |
baab03aaf3b9
(list-calendar-holidays): Fix mode line.
Richard M. Stallman <rms@gnu.org>
parents:
4864
diff
changeset
|
174 (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
|
175 (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
|
176 (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
|
177 (calendar-month-name m1) y1 (calendar-month-name m2) y2))) |
406 | 178 (erase-buffer) |
179 (insert | |
180 (mapconcat | |
181 '(lambda (x) (concat (calendar-date-string (car x)) | |
182 ": " (car (cdr x)))) | |
183 holiday-list "\n")) | |
184 (goto-char (point-min)) | |
185 (set-buffer-modified-p nil) | |
186 (setq buffer-read-only t) | |
187 (display-buffer holiday-buffer) | |
188 (message "Looking up holidays...done") | |
189 t))) | |
190 | |
191 (defun calendar-holiday-list () | |
192 "Form the list of holidays that occur on dates in the calendar window. | |
193 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
|
194 (let ((p calendar-holidays) |
406 | 195 (holiday-list)) |
196 (while p | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
197 (let* ((holidays |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
198 (if calendar-debug-sexp |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
199 (let ((stack-trace-on-error t)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
200 (eval (car p))) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
201 (condition-case nil |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
202 (eval (car p)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
203 (error (beep) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
204 (message "Bad holiday list item: %s" (car p)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
205 (sleep-for 2)))))) |
406 | 206 (if holidays |
207 (setq holiday-list (append holidays holiday-list)))) | |
208 (setq p (cdr p))) | |
209 (setq holiday-list (sort holiday-list 'calendar-date-compare)))) | |
210 | |
211 ;; 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
|
212 ;; 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
|
213 ;; 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
|
214 ;; 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
|
215 ;; ((month day year) string) of VISIBLE dates in the calendar window. |
406 | 216 |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
217 (defun holiday-fixed (month day string) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
218 "Holiday on MONTH, DAY (Gregorian) called STRING. |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
219 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
|
220 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
|
221 (let ((m displayed-month) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
222 (y displayed-year)) |
406 | 223 (increment-calendar-month m y (- 11 month)) |
224 (if (> m 9) | |
225 (list (list (list month day y) string))))) | |
226 | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
227 (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
|
228 "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
|
229 If the Nth DAYNAME in MONTH is visible, the value returned is the list |
7639 | 230 \(((MONTH DAY year) STRING)). |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
231 |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
232 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
|
233 |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
234 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
|
235 |
406 | 236 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
|
237 (let ((m displayed-month) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
238 (y displayed-year)) |
406 | 239 (increment-calendar-month m y (- 11 month)) |
240 (if (> m 9) | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
241 (list (list (calendar-nth-named-day n dayname month y day) string))))) |
406 | 242 |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
243 (defun holiday-sexp (sexp string) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
244 "Sexp holiday for dates in the calendar window. |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
245 SEXP is an expression in variable `year' evaluates to `date'. |
406 | 246 |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
247 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
|
248 of `date'. |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
249 |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
250 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
|
251 date. If date is nil, or if the date is not visible, there is no holiday." |
957 | 252 (let ((m displayed-month) |
253 (y displayed-year)) | |
254 (increment-calendar-month m y -1) | |
255 (filter-visible-calendar-holidays | |
256 (append | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
257 (let* ((year y) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
258 (date (eval sexp)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
259 (string (if date (eval string)))) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
260 (list (list date string))) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
261 (let* ((year (1+ y)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
262 (date (eval sexp)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
263 (string (if date (eval string)))) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
264 (list (list date string))))))) |
957 | 265 |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
266 (defun holiday-advent () |
406 | 267 "Date of Advent, if visible in calendar window." |
268 (let ((year displayed-year) | |
269 (month displayed-month)) | |
270 (increment-calendar-month month year -1) | |
271 (let ((advent (calendar-gregorian-from-absolute | |
272 (calendar-dayname-on-or-before 0 | |
273 (calendar-absolute-from-gregorian | |
274 (list 12 3 year)))))) | |
275 (if (calendar-date-is-visible-p advent) | |
276 (list (list advent "Advent")))))) | |
277 | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
278 (defun holiday-easter-etc () |
406 | 279 "List of dates related to Easter, as visible in calendar window." |
280 (if (and (> displayed-month 5) (not all-christian-calendar-holidays)) | |
281 nil;; Ash Wednesday, Good Friday, and Easter are not visible. | |
282 (let* ((century (1+ (/ displayed-year 100))) | |
283 (shifted-epact ;; Age of moon for April 5... | |
284 (% (+ 14 (* 11 (% displayed-year 19));; ...by Nicaean rule | |
285 (- ;; ...corrected for the Gregorian century rule | |
286 (/ (* 3 century) 4)) | |
287 (/ ;; ...corrected for Metonic cycle inaccuracy. | |
288 (+ 5 (* 8 century)) 25) | |
289 (* 30 century));; Keeps value positive. | |
290 30)) | |
291 (adjusted-epact ;; Adjust for 29.5 day month. | |
292 (if (or (= shifted-epact 0) | |
293 (and (= shifted-epact 1) (< 10 (% displayed-year 19)))) | |
294 (1+ shifted-epact) | |
295 shifted-epact)) | |
296 (paschal-moon ;; Day after the full moon on or after March 21. | |
297 (- (calendar-absolute-from-gregorian (list 4 19 displayed-year)) | |
298 adjusted-epact)) | |
299 (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7))) | |
300 (mandatory | |
301 (list | |
302 (list (calendar-gregorian-from-absolute abs-easter) | |
303 "Easter Sunday") | |
304 (list (calendar-gregorian-from-absolute (- abs-easter 2)) | |
305 "Good Friday") | |
306 (list (calendar-gregorian-from-absolute (- abs-easter 46)) | |
307 "Ash Wednesday"))) | |
308 (optional | |
309 (list | |
310 (list (calendar-gregorian-from-absolute (- abs-easter 63)) | |
311 "Septuagesima Sunday") | |
312 (list (calendar-gregorian-from-absolute (- abs-easter 56)) | |
313 "Sexagesima Sunday") | |
314 (list (calendar-gregorian-from-absolute (- abs-easter 49)) | |
315 "Shrove Sunday") | |
316 (list (calendar-gregorian-from-absolute (- abs-easter 48)) | |
317 "Shrove Monday") | |
318 (list (calendar-gregorian-from-absolute (- abs-easter 47)) | |
319 "Shrove Tuesday") | |
320 (list (calendar-gregorian-from-absolute (- abs-easter 14)) | |
321 "Passion Sunday") | |
322 (list (calendar-gregorian-from-absolute (- abs-easter 7)) | |
323 "Palm Sunday") | |
324 (list (calendar-gregorian-from-absolute (- abs-easter 3)) | |
325 "Maundy Thursday") | |
326 (list (calendar-gregorian-from-absolute (+ abs-easter 35)) | |
327 "Rogation Sunday") | |
328 (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
|
329 "Ascension Day") |
406 | 330 (list (calendar-gregorian-from-absolute (+ abs-easter 49)) |
331 "Pentecost (Whitsunday)") | |
332 (list (calendar-gregorian-from-absolute (+ abs-easter 50)) | |
333 "Whitmunday") | |
334 (list (calendar-gregorian-from-absolute (+ abs-easter 56)) | |
335 "Trinity Sunday") | |
336 (list (calendar-gregorian-from-absolute (+ abs-easter 60)) | |
337 "Corpus Christi"))) | |
338 (output-list | |
339 (filter-visible-calendar-holidays mandatory))) | |
340 (if all-christian-calendar-holidays | |
341 (setq output-list | |
342 (append | |
343 (filter-visible-calendar-holidays optional) | |
344 output-list))) | |
345 output-list))) | |
346 | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
347 (defun holiday-greek-orthodox-easter () |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
348 "Date of Easter according to the rule of the Council of Nicaea." |
957 | 349 (let ((m displayed-month) |
350 (y displayed-year)) | |
351 (increment-calendar-month m y 1) | |
352 (let* ((julian-year | |
353 (extract-calendar-year | |
354 (calendar-julian-from-absolute | |
355 (calendar-absolute-from-gregorian | |
356 (list m (calendar-last-day-of-month m y) y))))) | |
357 (shifted-epact ;; Age of moon for April 5. | |
358 (% (+ 14 | |
359 (* 11 (% julian-year 19))) | |
360 30)) | |
361 (paschal-moon ;; Day after full moon on or after March 21. | |
362 (- (calendar-absolute-from-julian (list 4 19 julian-year)) | |
363 shifted-epact)) | |
364 (nicaean-easter;; Sunday following the Paschal moon | |
365 (calendar-gregorian-from-absolute | |
366 (calendar-dayname-on-or-before 0 (+ paschal-moon 7))))) | |
367 (if (calendar-date-is-visible-p nicaean-easter) | |
368 (list (list nicaean-easter "Pascha (Greek Orthodox Easter)")))))) | |
369 | |
406 | 370 (defun filter-visible-calendar-holidays (l) |
371 "Return a list of all visible holidays of those on L." | |
372 (let ((visible) | |
373 (p l)) | |
374 (while p | |
2945
2c1f0215fcc3
* holidays.el: Update reference to the papers in S-P&E.
Jim Blandy <jimb@redhat.com>
parents:
957
diff
changeset
|
375 (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
|
376 (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
|
377 (setq visible (append (list (car p)) visible))) |
406 | 378 (setq p (cdr p))) |
379 visible)) | |
584 | 380 |
381 (provide 'holidays) | |
382 | |
660
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
383 ;;; holidays.el ends here |