Mercurial > emacs
comparison lisp/calendar/holidays.el @ 93809:3ff2b47de8f2
Update for calendar.el name changes.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Mon, 07 Apr 2008 01:59:37 +0000 |
parents | 59cfcdcb1474 |
children | bf9ef749c23e |
comparison
equal
deleted
inserted
replaced
93808:2c72483f42c9 | 93809:3ff2b47de8f2 |
---|---|
49 (message "Bad holiday list item: %s" p) | 49 (message "Bad holiday list item: %s" p) |
50 (sleep-for 2))))) | 50 (sleep-for 2))))) |
51 (setq res (append h res)))) | 51 (setq res (append h res)))) |
52 'calendar-date-compare))) | 52 'calendar-date-compare))) |
53 | 53 |
54 (defvar displayed-month) ; from generate-calendar | 54 (defvar displayed-month) ; from calendar-generate |
55 (defvar displayed-year) | 55 (defvar displayed-year) |
56 | 56 |
57 ;;;###cal-autoload | 57 ;;;###cal-autoload |
58 (defun calendar-list-holidays () | 58 (defun calendar-list-holidays () |
59 "Create a buffer containing the holidays for the current calendar window. | 59 "Create a buffer containing the holidays for the current calendar window. |
67 (m2 displayed-month) | 67 (m2 displayed-month) |
68 (y2 displayed-year)) | 68 (y2 displayed-year)) |
69 (if (not holiday-list) | 69 (if (not holiday-list) |
70 (message "Looking up holidays...none found") | 70 (message "Looking up holidays...none found") |
71 (calendar-in-read-only-buffer holiday-buffer | 71 (calendar-in-read-only-buffer holiday-buffer |
72 (increment-calendar-month m1 y1 -1) | 72 (calendar-increment-month m1 y1 -1) |
73 (increment-calendar-month m2 y2 1) | 73 (calendar-increment-month m2 y2 1) |
74 (calendar-set-mode-line | 74 (calendar-set-mode-line |
75 (if (= y1 y2) | 75 (if (= y1 y2) |
76 (format "Notable Dates from %s to %s, %d%%-" | 76 (format "Notable Dates from %s to %s, %d%%-" |
77 (calendar-month-name m1) (calendar-month-name m2) y2) | 77 (calendar-month-name m1) (calendar-month-name m2) y2) |
78 (format "Notable Dates from %s, %d to %s, %d%%-" | 78 (format "Notable Dates from %s, %d to %s, %d%%-" |
96 (interactive "P") | 96 (interactive "P") |
97 (save-excursion | 97 (save-excursion |
98 (let* ((completion-ignore-case t) | 98 (let* ((completion-ignore-case t) |
99 (date (if arg (calendar-read-date t) | 99 (date (if arg (calendar-read-date t) |
100 (calendar-current-date))) | 100 (calendar-current-date))) |
101 (displayed-month (extract-calendar-month date)) | 101 (displayed-month (calendar-extract-month date)) |
102 (displayed-year (extract-calendar-year date))) | 102 (displayed-year (calendar-extract-year date))) |
103 (calendar-list-holidays)))) | 103 (calendar-list-holidays)))) |
104 | 104 |
105 ;; rms: "Emacs commands to display a list of something generally start | 105 ;; rms: "Emacs commands to display a list of something generally start |
106 ;; with `list-'. Please make `list-holidays' the principal name." | 106 ;; with `list-'. Please make `list-holidays' the principal name." |
107 ;;;###autoload | 107 ;;;###autoload |
110 Y2 defaults to Y1. The optional list of holidays L defaults to | 110 Y2 defaults to Y1. The optional list of holidays L defaults to |
111 `calendar-holidays'. If you want to control what holidays are | 111 `calendar-holidays'. If you want to control what holidays are |
112 displayed, use a different list. For example, | 112 displayed, use a different list. For example, |
113 | 113 |
114 (list-holidays 2006 2006 | 114 (list-holidays 2006 2006 |
115 (append general-holidays local-holidays other-holidays)) | 115 (append holiday-general-holidays holiday-local-holidays)) |
116 | 116 |
117 will display holidays for the year 2006 defined in the 3 | 117 will display holidays for the year 2006 defined in the two |
118 mentioned lists, and nothing else. | 118 mentioned lists, and nothing else. |
119 | 119 |
120 When called interactively, this command offers a choice of | 120 When called interactively, this command offers a choice of |
121 holidays, based on the variables `solar-holidays' etc. See the | 121 holidays, based on the variables `holiday-solar-holidays' etc. See the |
122 documentation of `calendar-holidays' for a list of the variables | 122 documentation of `calendar-holidays' for a list of the variables |
123 that control the choices, as well as a description of the format | 123 that control the choices, as well as a description of the format |
124 of a holiday list. | 124 of a holiday list. |
125 | 125 |
126 The optional LABEL is used to label the buffer created." | 126 The optional LABEL is used to label the buffer created." |
127 (interactive | 127 (interactive |
128 (let* ((start-year (calendar-read | 128 (let* ((start-year (calendar-read |
129 "Starting year of holidays (>0): " | 129 "Starting year of holidays (>0): " |
130 (lambda (x) (> x 0)) | 130 (lambda (x) (> x 0)) |
131 (int-to-string (extract-calendar-year | 131 (int-to-string (calendar-extract-year |
132 (calendar-current-date))))) | 132 (calendar-current-date))))) |
133 (end-year (calendar-read | 133 (end-year (calendar-read |
134 (format "Ending year (inclusive) of holidays (>=%s): " | 134 (format "Ending year (inclusive) of holidays (>=%s): " |
135 start-year) | 135 start-year) |
136 (lambda (x) (>= x start-year)) | 136 (lambda (x) (>= x start-year)) |
139 (lists | 139 (lists |
140 (list | 140 (list |
141 (cons "All" calendar-holidays) | 141 (cons "All" calendar-holidays) |
142 (cons "Equinoxes/Solstices" | 142 (cons "Equinoxes/Solstices" |
143 (list (list 'solar-equinoxes-solstices))) | 143 (list (list 'solar-equinoxes-solstices))) |
144 (if general-holidays (cons "General" general-holidays)) | 144 (if holiday-general-holidays |
145 (if local-holidays (cons "Local" local-holidays)) | 145 (cons "General" holiday-general-holidays)) |
146 (if other-holidays (cons "Other" other-holidays)) | 146 (if holiday-local-holidays |
147 (if christian-holidays (cons "Christian" christian-holidays)) | 147 (cons "Local" holiday-local-holidays)) |
148 (if hebrew-holidays (cons "Hebrew" hebrew-holidays)) | 148 (if holiday-other-holidays |
149 (if islamic-holidays (cons "Islamic" islamic-holidays)) | 149 (cons "Other" holiday-other-holidays)) |
150 (if bahai-holidays (cons "Baha'i" bahai-holidays)) | 150 (if holiday-christian-holidays |
151 (if oriental-holidays (cons "Oriental" oriental-holidays)) | 151 (cons "Christian" holiday-christian-holidays)) |
152 (if solar-holidays (cons "Solar" solar-holidays)) | 152 (if holiday-hebrew-holidays |
153 (cons "Hebrew" holiday-hebrew-holidays)) | |
154 (if holiday-islamic-holidays | |
155 (cons "Islamic" holiday-islamic-holidays)) | |
156 (if holiday-bahai-holidays | |
157 (cons "Baha'i" holiday-bahai-holidays)) | |
158 (if holiday-oriental-holidays | |
159 (cons "Oriental" holiday-oriental-holidays)) | |
160 (if holiday-solar-holidays | |
161 (cons "Solar" holiday-solar-holidays)) | |
153 (cons "Ask" nil))) | 162 (cons "Ask" nil))) |
154 (choice (capitalize | 163 (choice (capitalize |
155 (completing-read "List (TAB for choices): " lists nil t))) | 164 (completing-read "List (TAB for choices): " lists nil t))) |
156 (which (if (string-equal choice "Ask") | 165 (which (if (string-equal choice "Ask") |
157 (eval (read-variable "Enter list name: ")) | 166 (eval (read-variable "Enter list name: ")) |
171 (displayed-month 2) | 180 (displayed-month 2) |
172 (displayed-year y1) | 181 (displayed-year y1) |
173 holiday-list) | 182 holiday-list) |
174 (while (<= s e) | 183 (while (<= s e) |
175 (setq holiday-list (append holiday-list (calendar-holiday-list))) | 184 (setq holiday-list (append holiday-list (calendar-holiday-list))) |
176 (increment-calendar-month displayed-month displayed-year 3) | 185 (calendar-increment-month displayed-month displayed-year 3) |
177 (setq s (calendar-absolute-from-gregorian | 186 (setq s (calendar-absolute-from-gregorian |
178 (list displayed-month 1 displayed-year)))) | 187 (list displayed-month 1 displayed-year)))) |
179 (save-excursion | 188 (save-excursion |
180 (calendar-in-read-only-buffer holiday-buffer | 189 (calendar-in-read-only-buffer holiday-buffer |
181 (calendar-set-mode-line | 190 (calendar-set-mode-line |
195 ;;;###diary-autoload | 204 ;;;###diary-autoload |
196 (defun calendar-check-holidays (date) | 205 (defun calendar-check-holidays (date) |
197 "Check the list of holidays for any that occur on DATE. | 206 "Check the list of holidays for any that occur on DATE. |
198 The value returned is a list of strings of relevant holiday descriptions. | 207 The value returned is a list of strings of relevant holiday descriptions. |
199 The holidays are those in the list `calendar-holidays'." | 208 The holidays are those in the list `calendar-holidays'." |
200 (let ((displayed-month (extract-calendar-month date)) | 209 (let ((displayed-month (calendar-extract-month date)) |
201 (displayed-year (extract-calendar-year date)) | 210 (displayed-year (calendar-extract-year date)) |
202 holiday-list) | 211 holiday-list) |
203 (dolist (h (calendar-holiday-list) holiday-list) | 212 (dolist (h (calendar-holiday-list) holiday-list) |
204 (if (calendar-date-equal date (car h)) | 213 (if (calendar-date-equal date (car h)) |
205 (setq holiday-list (append holiday-list (cdr h))))))) | 214 (setq holiday-list (append holiday-list (cdr h))))))) |
206 | 215 |
228 | 237 |
229 ;;;###cal-autoload | 238 ;;;###cal-autoload |
230 (defun calendar-mark-holidays () | 239 (defun calendar-mark-holidays () |
231 "Mark notable days in the calendar window." | 240 "Mark notable days in the calendar window." |
232 (interactive) | 241 (interactive) |
233 (setq mark-holidays-in-calendar t) | 242 (setq calendar-mark-holidays-flag t) |
234 (message "Marking holidays...") | 243 (message "Marking holidays...") |
235 (dolist (holiday (calendar-holiday-list)) | 244 (dolist (holiday (calendar-holiday-list)) |
236 (mark-visible-calendar-date (car holiday) calendar-holiday-marker)) | 245 (calendar-mark-visible-date (car holiday) calendar-holiday-marker)) |
237 (message "Marking holidays...done")) | 246 (message "Marking holidays...done")) |
238 | 247 |
239 (define-obsolete-function-alias | 248 (define-obsolete-function-alias |
240 'mark-calendar-holidays 'calendar-mark-holidays "23.1") | 249 'mark-calendar-holidays 'calendar-mark-holidays "23.1") |
241 | 250 |
262 ;; back a month and ask if November is visible; to determine if | 271 ;; back a month and ask if November is visible; to determine if |
263 ;; October is visible, we can shift it forward a month and ask if | 272 ;; October is visible, we can shift it forward a month and ask if |
264 ;; November is visible; etc. | 273 ;; November is visible; etc. |
265 (let ((m displayed-month) | 274 (let ((m displayed-month) |
266 (y displayed-year)) | 275 (y displayed-year)) |
267 (increment-calendar-month m y (- 11 month)) | 276 (calendar-increment-month m y (- 11 month)) |
268 (if (> m 9) ; is november visible? | 277 (if (> m 9) ; is november visible? |
269 (list (list (list month day y) string))))) | 278 (list (list (list month day y) string))))) |
270 | 279 |
271 (defun holiday-float (month dayname n string &optional day) | 280 (defun holiday-float (month dayname n string &optional day) |
272 "Holiday on MONTH, DAYNAME (Nth occurrence) called STRING. | 281 "Holiday on MONTH, DAYNAME (Nth occurrence) called STRING. |
284 ;; of |n| the problem is more grotesque. If we didn't have to worry | 293 ;; of |n| the problem is more grotesque. If we didn't have to worry |
285 ;; about such cases, we could just use the original version of this | 294 ;; about such cases, we could just use the original version of this |
286 ;; function: | 295 ;; function: |
287 ;; (let ((m displayed-month) | 296 ;; (let ((m displayed-month) |
288 ;; (y displayed-year)) | 297 ;; (y displayed-year)) |
289 ;; (increment-calendar-month m y (- 11 month)) | 298 ;; (calendar-increment-month m y (- 11 month)) |
290 ;; (if (> m 9); month in year y is visible | 299 ;; (if (> m 9); month in year y is visible |
291 ;; (list (list (calendar-nth-named-day n dayname month y day) string))))) | 300 ;; (list (list (calendar-nth-named-day n dayname month y day) string))))) |
292 (let* ((m1 displayed-month) | 301 (let* ((m1 displayed-month) |
293 (y1 displayed-year) | 302 (y1 displayed-year) |
294 (m2 displayed-month) | 303 (m2 displayed-month) |
295 (y2 displayed-year) | 304 (y2 displayed-year) |
296 (d1 (progn ; first possible base date for holiday | 305 (d1 (progn ; first possible base date for holiday |
297 (increment-calendar-month m1 y1 -1) | 306 (calendar-increment-month m1 y1 -1) |
298 (+ (calendar-nth-named-absday 1 dayname m1 y1) | 307 (+ (calendar-nth-named-absday 1 dayname m1 y1) |
299 (* -7 n) | 308 (* -7 n) |
300 (if (> n 0) 1 -7)))) | 309 (if (> n 0) 1 -7)))) |
301 (d2 ; last possible base date for holiday | 310 (d2 ; last possible base date for holiday |
302 (progn | 311 (progn |
303 (increment-calendar-month m2 y2 1) | 312 (calendar-increment-month m2 y2 1) |
304 (+ (calendar-nth-named-absday -1 dayname m2 y2) | 313 (+ (calendar-nth-named-absday -1 dayname m2 y2) |
305 (* -7 n) | 314 (* -7 n) |
306 (if (> n 0) 7 -1)))) | 315 (if (> n 0) 7 -1)))) |
307 (y1 (extract-calendar-year (calendar-gregorian-from-absolute d1))) | 316 (y1 (calendar-extract-year (calendar-gregorian-from-absolute d1))) |
308 (y2 (extract-calendar-year (calendar-gregorian-from-absolute d2))) | 317 (y2 (calendar-extract-year (calendar-gregorian-from-absolute d2))) |
309 (y ; year of base date | 318 (y ; year of base date |
310 (if (or (= y1 y2) (> month 9)) | 319 (if (or (= y1 y2) (> month 9)) |
311 y1 | 320 y1 |
312 y2)) | 321 y2)) |
313 (d ; day of base date | 322 (d ; day of base date |
338 calendar window, the holiday STRING is on that date. If date is | 347 calendar window, the holiday STRING is on that date. If date is |
339 nil, or if the date is not visible, there is no holiday." | 348 nil, or if the date is not visible, there is no holiday." |
340 (let ((m displayed-month) | 349 (let ((m displayed-month) |
341 (y displayed-year) | 350 (y displayed-year) |
342 year date) | 351 year date) |
343 (increment-calendar-month m y -1) | 352 (calendar-increment-month m y -1) |
344 (holiday-filter-visible-calendar | 353 (holiday-filter-visible-calendar |
345 (list | 354 (list |
346 (progn | 355 (progn |
347 (setq year y | 356 (setq year y |
348 date (eval sexp)) | 357 date (eval sexp)) |
366 (if (not n) | 375 (if (not n) |
367 (holiday-advent 0 "Advent") | 376 (holiday-advent 0 "Advent") |
368 (let* ((year displayed-year) | 377 (let* ((year displayed-year) |
369 (month displayed-month) | 378 (month displayed-month) |
370 (advent (progn | 379 (advent (progn |
371 (increment-calendar-month month year -1) | 380 (calendar-increment-month month year -1) |
372 (calendar-gregorian-from-absolute | 381 (calendar-gregorian-from-absolute |
373 (+ n | 382 (+ n |
374 (calendar-dayname-on-or-before | 383 (calendar-dayname-on-or-before |
375 0 | 384 0 |
376 (calendar-absolute-from-gregorian | 385 (calendar-absolute-from-gregorian |
442 (defun holiday-greek-orthodox-easter () | 451 (defun holiday-greek-orthodox-easter () |
443 "Date of Easter according to the rule of the Council of Nicaea." | 452 "Date of Easter according to the rule of the Council of Nicaea." |
444 (let* ((m displayed-month) | 453 (let* ((m displayed-month) |
445 (y displayed-year) | 454 (y displayed-year) |
446 (julian-year (progn | 455 (julian-year (progn |
447 (increment-calendar-month m y 1) | 456 (calendar-increment-month m y 1) |
448 (extract-calendar-year | 457 (calendar-extract-year |
449 (calendar-julian-from-absolute | 458 (calendar-julian-from-absolute |
450 (calendar-absolute-from-gregorian | 459 (calendar-absolute-from-gregorian |
451 (list m (calendar-last-day-of-month m y) y)))))) | 460 (list m (calendar-last-day-of-month m y) y)))))) |
452 (shifted-epact ; age of moon for April 5 | 461 (shifted-epact ; age of moon for April 5 |
453 (% (+ 14 | 462 (% (+ 14 |