Mercurial > emacs
annotate lisp/calendar/holidays.el @ 54880:f23c0b924770
*** empty log message ***
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Wed, 14 Apr 2004 18:58:45 +0000 |
parents | 695cf19ef79e |
children | b278cb498cc8 375f2633d815 |
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 |
20462
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
3 ;; Copyright (C) 1989, 90, 92, 93, 94, 1997 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 |
14169 | 21 ;; along with GNU Emacs; 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. | |
406 | 24 |
793
6fb68a1460a6
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
778
diff
changeset
|
25 ;;; Commentary: |
6fb68a1460a6
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
778
diff
changeset
|
26 |
406 | 27 ;; This collection of functions implements the holiday features as described |
28 ;; in calendar.el. | |
29 | |
20462
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
30 ;; Technical details of all the calendrical calculations can be found in |
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
31 ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, |
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
32 ;; Cambridge University Press (1997). |
406 | 33 |
20462
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
34 ;; An earlier version of the technical details appeared in |
406 | 35 ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, |
36 ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990), | |
957 | 37 ;; pages 899-928. ``Calendrical Calculations, Part II: Three Historical |
38 ;; 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
|
39 ;; 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
|
40 ;; pages 383-404. |
957 | 41 |
42 ;; Hard copies of these two papers can be obtained by sending email to | |
43 ;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and | |
44 ;; the message BODY containing your mailing address (snail). | |
406 | 45 |
20462
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
46 ;; Comments, corrections, and improvements should be sent to |
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
47 ;; Edward M. Reingold Department of Computer Science |
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
48 ;; (217) 333-6733 University of Illinois at Urbana-Champaign |
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
49 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue |
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
50 ;; Urbana, Illinois 61801 |
d179de7ad92e
Add reference to new Calendrical Calculations book.
Paul Eggert <eggert@twinsun.com>
parents:
17891
diff
changeset
|
51 |
793
6fb68a1460a6
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
778
diff
changeset
|
52 ;;; Code: |
6fb68a1460a6
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
778
diff
changeset
|
53 |
52112
e7d0572ccca5
(displayed-month, displayed-year): Define for compiler.
Glenn Morris <rgm@gnu.org>
parents:
49598
diff
changeset
|
54 (defvar displayed-month) |
e7d0572ccca5
(displayed-month, displayed-year): Define for compiler.
Glenn Morris <rgm@gnu.org>
parents:
49598
diff
changeset
|
55 (defvar displayed-year) |
e7d0572ccca5
(displayed-month, displayed-year): Define for compiler.
Glenn Morris <rgm@gnu.org>
parents:
49598
diff
changeset
|
56 |
406 | 57 (require 'calendar) |
732 | 58 |
13043
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
59 (autoload 'holiday-julian "cal-julian" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
60 "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
|
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-hebrew "cal-hebrew" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
64 "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
|
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-rosh-hashanah-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 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
|
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-hanukkah "cal-hebrew" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
72 "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
|
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-passover-etc "cal-hebrew" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
76 "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
|
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-tisha-b-av-etc "cal-hebrew" |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
80 "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
|
81 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
82 |
14687
0d4ff7e4d6a3
Use the new file names in autoloads.
Karl Heuer <kwzh@gnu.org>
parents:
14318
diff
changeset
|
83 (autoload 'holiday-islamic "cal-islam" |
13043
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
84 "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
|
85 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
86 |
14687
0d4ff7e4d6a3
Use the new file names in autoloads.
Karl Heuer <kwzh@gnu.org>
parents:
14318
diff
changeset
|
87 (autoload 'holiday-chinese-new-year "cal-china" |
13043
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
88 "Date of Chinese New Year." |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
89 t) |
2072d3ab4119
Moved stuff to other files.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
9712
diff
changeset
|
90 |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
91 (autoload 'solar-equinoxes-solstices "solar" |
957 | 92 "Date and time of equinoxes and solstices, if visible in the calendar window. |
93 Requires floating point." | |
94 t) | |
95 | |
37631
00c265302412
(holidays): Add an autoload cookie. From Pavel Jank <Pavel@Janik.cz>.
Eli Zaretskii <eliz@gnu.org>
parents:
37001
diff
changeset
|
96 ;;;###autoload |
957 | 97 (defun holidays (&optional arg) |
406 | 98 "Display the holidays for last month, this month, and next month. |
957 | 99 If called with an optional prefix argument, prompts for month and year. |
100 | |
406 | 101 This function is suitable for execution in a .emacs file." |
957 | 102 (interactive "P") |
406 | 103 (save-excursion |
957 | 104 (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
|
105 (date (if arg |
275845a98fa8
Use new form of calendar-read-date.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
7639
diff
changeset
|
106 (calendar-read-date t) |
275845a98fa8
Use new form of calendar-read-date.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
7639
diff
changeset
|
107 (calendar-current-date))) |
275845a98fa8
Use new form of calendar-read-date.
Edward M. Reingold <reingold@emr.cs.iit.edu>
parents:
7639
diff
changeset
|
108 (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
|
109 (displayed-year (extract-calendar-year date))) |
406 | 110 (list-calendar-holidays)))) |
111 | |
17388
5c4602f0c45d
(list-holidays): Add autoload cookie.
Richard M. Stallman <rms@gnu.org>
parents:
17385
diff
changeset
|
112 ;;;###autoload |
17385
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
113 (defun list-holidays (y1 y2 &optional l label) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
114 "Display holidays for years Y1 to Y2 (inclusive). |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
115 |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
116 The optional list of holidays L defaults to `calendar-holidays'. See the |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
117 documentation for that variable for a description of holiday lists. |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
118 |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
119 The optional LABEL is used to label the buffer created." |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
120 (interactive |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
121 (let* ((start-year (calendar-read |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
122 "Starting year of holidays (>0): " |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
123 '(lambda (x) (> x 0)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
124 (int-to-string (extract-calendar-year |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
125 (calendar-current-date))))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
126 (end-year (calendar-read |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
127 (format "Ending year (inclusive) of holidays (>=%s): " |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
128 start-year) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
129 '(lambda (x) (>= x start-year)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
130 (int-to-string start-year))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
131 (completion-ignore-case t) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
132 (lists |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
133 (list |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
134 (cons "All" calendar-holidays) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
135 (if (fboundp 'atan) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
136 (cons "Equinoxes/Solstices" |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
137 (list (list 'solar-equinoxes-solstices)))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
138 (if general-holidays (cons "General" general-holidays)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
139 (if local-holidays (cons "Local" local-holidays)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
140 (if other-holidays (cons "Other" other-holidays)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
141 (if christian-holidays (cons "Christian" christian-holidays)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
142 (if hebrew-holidays (cons "Hebrew" hebrew-holidays)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
143 (if islamic-holidays (cons "Islamic" islamic-holidays)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
144 (if oriental-holidays (cons "Oriental" oriental-holidays)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
145 (if solar-holidays (cons "Solar" solar-holidays)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
146 (cons "Ask" nil))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
147 (choice (capitalize |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
148 (completing-read "List (TAB for choices): " lists nil t))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
149 (which (if (string-equal choice "Ask") |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
150 (eval (read-variable "Enter list name: ")) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
151 (cdr (assoc choice lists)))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
152 (name (if (string-equal choice "Equinoxes/Solstices") |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
153 choice |
17643
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
154 (if (member choice '("Ask" "")) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
37631
diff
changeset
|
155 "Holidays" |
17385
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
156 (format "%s Holidays" choice))))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
157 (list start-year end-year which name))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
158 (message "Computing holidays...") |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
159 (let* ((holiday-buffer "*Holidays*") |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
160 (calendar-holidays (if l l calendar-holidays)) |
17643
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
161 (title (or label "Holidays")) |
17385
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
162 (holiday-list nil) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
163 (s (calendar-absolute-from-gregorian (list 2 1 y1))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
164 (e (calendar-absolute-from-gregorian (list 11 1 y2))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
165 (d s) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
166 (never t) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
167 (displayed-month 2) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
168 (displayed-year y1)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
169 (while (or never (<= d e)) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
170 (setq holiday-list (append holiday-list (calendar-holiday-list))) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
171 (setq never nil) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
172 (increment-calendar-month displayed-month displayed-year 3) |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
173 (setq d (calendar-absolute-from-gregorian |
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
174 (list displayed-month 1 displayed-year)))) |
17643
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
175 (save-excursion |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
176 (set-buffer (get-buffer-create holiday-buffer)) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
177 (setq buffer-read-only nil) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
178 (calendar-set-mode-line |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
179 (if (= y1 y2) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
180 (format "%s for %s" title y1) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
181 (format "%s for %s-%s" title y1 y2))) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
182 (erase-buffer) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
183 (goto-char (point-min)) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
184 (insert |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
185 (mapconcat |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
186 '(lambda (x) (concat (calendar-date-string (car x)) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
187 ": " (car (cdr x)))) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
188 holiday-list "\n")) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
189 (goto-char (point-min)) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
190 (set-buffer-modified-p nil) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
191 (setq buffer-read-only t) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
192 (display-buffer holiday-buffer) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
193 (message "Computing holidays...done")))) |
fd27882450bd
(list-holidays): Fix buffer title when list is
Richard M. Stallman <rms@gnu.org>
parents:
17388
diff
changeset
|
194 |
17385
259d4c9aae0e
(list-holidays): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14687
diff
changeset
|
195 |
406 | 196 (defun check-calendar-holidays (date) |
197 "Check the list of holidays for any that occur on DATE. | |
198 The value returned is a list of strings of relevant holiday descriptions. | |
199 The holidays are those in the list calendar-holidays." | |
200 (let* ((displayed-month (extract-calendar-month date)) | |
201 (displayed-year (extract-calendar-year date)) | |
202 (h (calendar-holiday-list)) | |
203 (holiday-list)) | |
204 (while h | |
205 (if (calendar-date-equal date (car (car h))) | |
206 (setq holiday-list (append holiday-list (cdr (car h))))) | |
207 (setq h (cdr h))) | |
208 holiday-list)) | |
209 | |
210 (defun calendar-cursor-holidays () | |
211 "Find holidays for the date specified by the cursor in the calendar window." | |
212 (interactive) | |
213 (message "Checking holidays...") | |
5831
7a4647230b22
(calendar-cursor-holidays): Use new error arg
Richard M. Stallman <rms@gnu.org>
parents:
5696
diff
changeset
|
214 (let* ((date (calendar-cursor-to-date t)) |
406 | 215 (date-string (calendar-date-string date)) |
216 (holiday-list (check-calendar-holidays date)) | |
217 (holiday-string (mapconcat 'identity holiday-list "; ")) | |
218 (msg (format "%s: %s" date-string holiday-string))) | |
219 (if (not holiday-list) | |
220 (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
|
221 (if (<= (length msg) (frame-width)) |
14318
faae84d059c1
(calendar-cursor-holidays): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
222 (message "%s" msg) |
406 | 223 (set-buffer (get-buffer-create holiday-buffer)) |
224 (setq buffer-read-only nil) | |
957 | 225 (calendar-set-mode-line date-string) |
406 | 226 (erase-buffer) |
227 (insert (mapconcat 'identity holiday-list "\n")) | |
228 (goto-char (point-min)) | |
229 (set-buffer-modified-p nil) | |
230 (setq buffer-read-only t) | |
231 (display-buffer holiday-buffer) | |
232 (message "Checking holidays...done"))))) | |
233 | |
234 (defun mark-calendar-holidays () | |
235 "Mark notable days in the calendar window." | |
236 (interactive) | |
237 (setq mark-holidays-in-calendar t) | |
238 (message "Marking holidays...") | |
239 (let ((holiday-list (calendar-holiday-list))) | |
240 (while holiday-list | |
241 (mark-visible-calendar-date | |
242 (car (car holiday-list)) calendar-holiday-marker) | |
243 (setq holiday-list (cdr holiday-list)))) | |
244 (message "Marking holidays...done")) | |
245 | |
246 (defun list-calendar-holidays () | |
247 "Create a buffer containing the holidays for the current calendar window. | |
248 The holidays are those in the list calendar-notable-days. Returns t if any | |
249 holidays are found, nil if not." | |
250 (interactive) | |
251 (message "Looking up holidays...") | |
252 (let ((holiday-list (calendar-holiday-list)) | |
253 (m1 displayed-month) | |
254 (y1 displayed-year) | |
255 (m2 displayed-month) | |
256 (y2 displayed-year)) | |
257 (if (not holiday-list) | |
258 (progn | |
259 (message "Looking up holidays...none found") | |
260 nil) | |
261 (set-buffer (get-buffer-create holiday-buffer)) | |
262 (setq buffer-read-only nil) | |
263 (increment-calendar-month m1 y1 -1) | |
264 (increment-calendar-month m2 y2 1) | |
957 | 265 (calendar-set-mode-line |
5696
baab03aaf3b9
(list-calendar-holidays): Fix mode line.
Richard M. Stallman <rms@gnu.org>
parents:
4864
diff
changeset
|
266 (if (= y1 y2) |
baab03aaf3b9
(list-calendar-holidays): Fix mode line.
Richard M. Stallman <rms@gnu.org>
parents:
4864
diff
changeset
|
267 (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
|
268 (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
|
269 (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
|
270 (calendar-month-name m1) y1 (calendar-month-name m2) y2))) |
406 | 271 (erase-buffer) |
272 (insert | |
273 (mapconcat | |
274 '(lambda (x) (concat (calendar-date-string (car x)) | |
275 ": " (car (cdr x)))) | |
276 holiday-list "\n")) | |
277 (goto-char (point-min)) | |
278 (set-buffer-modified-p nil) | |
279 (setq buffer-read-only t) | |
280 (display-buffer holiday-buffer) | |
281 (message "Looking up holidays...done") | |
282 t))) | |
283 | |
284 (defun calendar-holiday-list () | |
285 "Form the list of holidays that occur on dates in the calendar window. | |
286 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
|
287 (let ((p calendar-holidays) |
406 | 288 (holiday-list)) |
289 (while p | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
290 (let* ((holidays |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
291 (if calendar-debug-sexp |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
292 (let ((stack-trace-on-error t)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
293 (eval (car p))) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
294 (condition-case nil |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
295 (eval (car p)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
296 (error (beep) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
297 (message "Bad holiday list item: %s" (car p)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
298 (sleep-for 2)))))) |
406 | 299 (if holidays |
300 (setq holiday-list (append holidays holiday-list)))) | |
301 (setq p (cdr p))) | |
302 (setq holiday-list (sort holiday-list 'calendar-date-compare)))) | |
303 | |
304 ;; 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
|
305 ;; 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
|
306 ;; 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
|
307 ;; 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
|
308 ;; ((month day year) string) of VISIBLE dates in the calendar window. |
406 | 309 |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
310 (defun holiday-fixed (month day string) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
311 "Holiday on MONTH, DAY (Gregorian) called STRING. |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
312 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
|
313 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
|
314 (let ((m displayed-month) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
315 (y displayed-year)) |
406 | 316 (increment-calendar-month m y (- 11 month)) |
317 (if (> m 9) | |
318 (list (list (list month day y) string))))) | |
319 | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
320 (defun holiday-float (month dayname n string &optional day) |
17891
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
321 "Holiday on MONTH, DAYNAME (Nth occurrence) called STRING. |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
322 If the Nth DAYNAME in MONTH is visible, the value returned is the list |
7639 | 323 \(((MONTH DAY year) STRING)). |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
324 |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
325 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
|
326 |
17891
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
327 An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY. |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
328 |
406 | 329 Returns nil if it is not visible in the current calendar window." |
17891
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
330 ;; This is messy because the holiday may be visible, while the date on which |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
331 ;; it is based is not. For example, the first Monday after December 30 may be |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
332 ;; visible when January is not. For large values of |n| the problem is more |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
333 ;; grotesque. If we didn't have to worry about such cases, we could just use |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
334 |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
335 ;; (let ((m displayed-month) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
336 ;; (y displayed-year)) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
337 ;; (increment-calendar-month m y (- 11 month)) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
338 ;; (if (> m 9); month in year y is visible |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
339 ;; (list (list (calendar-nth-named-day n dayname month y day) string))))) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
340 |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
341 ;; which is the way the function was originally written. |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
342 |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
343 (let* ((m1 displayed-month) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
344 (y1 displayed-year) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
345 (m2 m1) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
346 (y2 y1)) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
347 (increment-calendar-month m1 y1 -1) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
348 (increment-calendar-month m2 y2 1) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
349 (let* ((d1; first possible base date for holiday |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
350 (+ (calendar-nth-named-absday 1 dayname m1 y1) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
351 (* -7 n) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
352 (if (> n 0) 1 -7))) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
353 (d2; last possible base date for holiday |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
354 (+ (calendar-nth-named-absday -1 dayname m2 y2) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
355 (* -7 n) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
356 (if (> n 0) 7 -1))) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
357 (y1 (extract-calendar-year (calendar-gregorian-from-absolute d1))) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
358 (y2 (extract-calendar-year (calendar-gregorian-from-absolute d2))) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
359 (y; year of base date |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
360 (if (or (= y1 y2) (> month 9)) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
361 y1 |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
362 y2)) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
363 (d; day of base date |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
364 (or day (if (> n 0) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
365 1 |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
366 (calendar-last-day-of-month month y)))) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
367 (date; base date for holiday |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
368 (calendar-absolute-from-gregorian (list month d y)))) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
369 (if (and (<= d1 date) (<= date d2)) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
370 (list (list (calendar-nth-named-day n dayname month y d) |
6eb7095ca7ab
(holiday-float): Rewritten to fix bug when base date
Richard M. Stallman <rms@gnu.org>
parents:
17643
diff
changeset
|
371 string)))))) |
406 | 372 |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
373 (defun holiday-sexp (sexp string) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
374 "Sexp holiday for dates in the calendar window. |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
375 SEXP is an expression in variable `year' evaluates to `date'. |
406 | 376 |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
377 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
|
378 of `date'. |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
379 |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
380 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
|
381 date. If date is nil, or if the date is not visible, there is no holiday." |
957 | 382 (let ((m displayed-month) |
383 (y displayed-year)) | |
384 (increment-calendar-month m y -1) | |
385 (filter-visible-calendar-holidays | |
386 (append | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
387 (let* ((year y) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
388 (date (eval sexp)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
389 (string (if date (eval string)))) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
390 (list (list date string))) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
391 (let* ((year (1+ y)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
392 (date (eval sexp)) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
393 (string (if date (eval string)))) |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
394 (list (list date string))))))) |
957 | 395 |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
396 (defun holiday-advent () |
406 | 397 "Date of Advent, if visible in calendar window." |
398 (let ((year displayed-year) | |
399 (month displayed-month)) | |
400 (increment-calendar-month month year -1) | |
401 (let ((advent (calendar-gregorian-from-absolute | |
402 (calendar-dayname-on-or-before 0 | |
403 (calendar-absolute-from-gregorian | |
404 (list 12 3 year)))))) | |
405 (if (calendar-date-is-visible-p advent) | |
406 (list (list advent "Advent")))))) | |
407 | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
408 (defun holiday-easter-etc () |
406 | 409 "List of dates related to Easter, as visible in calendar window." |
410 (if (and (> displayed-month 5) (not all-christian-calendar-holidays)) | |
411 nil;; Ash Wednesday, Good Friday, and Easter are not visible. | |
412 (let* ((century (1+ (/ displayed-year 100))) | |
413 (shifted-epact ;; Age of moon for April 5... | |
414 (% (+ 14 (* 11 (% displayed-year 19));; ...by Nicaean rule | |
415 (- ;; ...corrected for the Gregorian century rule | |
416 (/ (* 3 century) 4)) | |
417 (/ ;; ...corrected for Metonic cycle inaccuracy. | |
418 (+ 5 (* 8 century)) 25) | |
419 (* 30 century));; Keeps value positive. | |
420 30)) | |
421 (adjusted-epact ;; Adjust for 29.5 day month. | |
422 (if (or (= shifted-epact 0) | |
423 (and (= shifted-epact 1) (< 10 (% displayed-year 19)))) | |
424 (1+ shifted-epact) | |
425 shifted-epact)) | |
426 (paschal-moon ;; Day after the full moon on or after March 21. | |
427 (- (calendar-absolute-from-gregorian (list 4 19 displayed-year)) | |
428 adjusted-epact)) | |
429 (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7))) | |
430 (mandatory | |
431 (list | |
432 (list (calendar-gregorian-from-absolute abs-easter) | |
433 "Easter Sunday") | |
434 (list (calendar-gregorian-from-absolute (- abs-easter 2)) | |
435 "Good Friday") | |
436 (list (calendar-gregorian-from-absolute (- abs-easter 46)) | |
437 "Ash Wednesday"))) | |
438 (optional | |
439 (list | |
440 (list (calendar-gregorian-from-absolute (- abs-easter 63)) | |
441 "Septuagesima Sunday") | |
442 (list (calendar-gregorian-from-absolute (- abs-easter 56)) | |
443 "Sexagesima Sunday") | |
444 (list (calendar-gregorian-from-absolute (- abs-easter 49)) | |
445 "Shrove Sunday") | |
446 (list (calendar-gregorian-from-absolute (- abs-easter 48)) | |
447 "Shrove Monday") | |
448 (list (calendar-gregorian-from-absolute (- abs-easter 47)) | |
449 "Shrove Tuesday") | |
450 (list (calendar-gregorian-from-absolute (- abs-easter 14)) | |
451 "Passion Sunday") | |
452 (list (calendar-gregorian-from-absolute (- abs-easter 7)) | |
453 "Palm Sunday") | |
454 (list (calendar-gregorian-from-absolute (- abs-easter 3)) | |
455 "Maundy Thursday") | |
456 (list (calendar-gregorian-from-absolute (+ abs-easter 35)) | |
457 "Rogation Sunday") | |
458 (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
|
459 "Ascension Day") |
406 | 460 (list (calendar-gregorian-from-absolute (+ abs-easter 49)) |
461 "Pentecost (Whitsunday)") | |
462 (list (calendar-gregorian-from-absolute (+ abs-easter 50)) | |
13669
e411b827878f
(holiday-easter-etc): Fix misspelling of "Whitmonday".
Paul Eggert <eggert@twinsun.com>
parents:
13043
diff
changeset
|
463 "Whitmonday") |
406 | 464 (list (calendar-gregorian-from-absolute (+ abs-easter 56)) |
465 "Trinity Sunday") | |
466 (list (calendar-gregorian-from-absolute (+ abs-easter 60)) | |
467 "Corpus Christi"))) | |
468 (output-list | |
469 (filter-visible-calendar-holidays mandatory))) | |
470 (if all-christian-calendar-holidays | |
471 (setq output-list | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
37631
diff
changeset
|
472 (append |
406 | 473 (filter-visible-calendar-holidays optional) |
474 output-list))) | |
475 output-list))) | |
476 | |
3870
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
477 (defun holiday-greek-orthodox-easter () |
4acdfdf2a7c9
* holidays.el (calendar-holiday-function-fixed,
Jim Blandy <jimb@redhat.com>
parents:
3728
diff
changeset
|
478 "Date of Easter according to the rule of the Council of Nicaea." |
957 | 479 (let ((m displayed-month) |
480 (y displayed-year)) | |
481 (increment-calendar-month m y 1) | |
482 (let* ((julian-year | |
483 (extract-calendar-year | |
484 (calendar-julian-from-absolute | |
485 (calendar-absolute-from-gregorian | |
486 (list m (calendar-last-day-of-month m y) y))))) | |
487 (shifted-epact ;; Age of moon for April 5. | |
488 (% (+ 14 | |
489 (* 11 (% julian-year 19))) | |
490 30)) | |
491 (paschal-moon ;; Day after full moon on or after March 21. | |
492 (- (calendar-absolute-from-julian (list 4 19 julian-year)) | |
493 shifted-epact)) | |
494 (nicaean-easter;; Sunday following the Paschal moon | |
495 (calendar-gregorian-from-absolute | |
496 (calendar-dayname-on-or-before 0 (+ paschal-moon 7))))) | |
497 (if (calendar-date-is-visible-p nicaean-easter) | |
498 (list (list nicaean-easter "Pascha (Greek Orthodox Easter)")))))) | |
499 | |
406 | 500 (defun filter-visible-calendar-holidays (l) |
501 "Return a list of all visible holidays of those on L." | |
502 (let ((visible) | |
503 (p l)) | |
504 (while p | |
2945
2c1f0215fcc3
* holidays.el: Update reference to the papers in S-P&E.
Jim Blandy <jimb@redhat.com>
parents:
957
diff
changeset
|
505 (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
|
506 (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
|
507 (setq visible (append (list (car p)) visible))) |
406 | 508 (setq p (cdr p))) |
509 visible)) | |
584 | 510 |
511 (provide 'holidays) | |
512 | |
52401 | 513 ;;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37 |
660
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
514 ;;; holidays.el ends here |