holidays.el 33.7 KB
Newer Older
1
;;; holidays.el --- holiday functions for the calendar package  -*- lexical-binding:t -*-
Eric S. Raymond's avatar
Eric S. Raymond committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2019 Free Software
Paul Eggert's avatar
Paul Eggert committed
4
;; Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
5

Eric S. Raymond's avatar
Eric S. Raymond committed
6
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
Glenn Morris's avatar
Glenn Morris committed
7
;; Maintainer: emacs-devel@gnu.org
Jim Blandy's avatar
Jim Blandy committed
8
;; Keywords: holidays, calendar
9
;; Package: calendar
Eric S. Raymond's avatar
Eric S. Raymond committed
10

Jim Blandy's avatar
Jim Blandy committed
11 12
;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
17

Jim Blandy's avatar
Jim Blandy committed
18
;; GNU Emacs is distributed in the hope that it will be useful,
19 20 21 22 23
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Jim Blandy's avatar
Jim Blandy committed
25

Eric S. Raymond's avatar
Eric S. Raymond committed
26 27
;;; Commentary:

28
;; See calendar.el.
Jim Blandy's avatar
Jim Blandy committed
29

Eric S. Raymond's avatar
Eric S. Raymond committed
30 31
;;; Code:

Jim Blandy's avatar
Jim Blandy committed
32
(require 'calendar)
33
(load "hol-loaddefs" nil t)
Jim Blandy's avatar
Jim Blandy committed
34

35 36 37 38 39 40 41 42 43 44 45 46
(defgroup holidays nil
  "Holidays support in calendar."
  :group 'calendar
  :prefix "holidays-"
  :group 'local)

;; The various holiday variables are autoloaded because people
;; are used to using them to set calendar-holidays without having to
;; explicitly load this file.

;;;###autoload
(defcustom holiday-general-holidays
47
  (mapcar 'purecopy
48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
  '((holiday-fixed 1 1 "New Year's Day")
    (holiday-float 1 1 3 "Martin Luther King Day")
    (holiday-fixed 2 2 "Groundhog Day")
    (holiday-fixed 2 14 "Valentine's Day")
    (holiday-float 2 1 3 "President's Day")
    (holiday-fixed 3 17 "St. Patrick's Day")
    (holiday-fixed 4 1 "April Fools' Day")
    (holiday-float 5 0 2 "Mother's Day")
    (holiday-float 5 1 -1 "Memorial Day")
    (holiday-fixed 6 14 "Flag Day")
    (holiday-float 6 0 3 "Father's Day")
    (holiday-fixed 7 4 "Independence Day")
    (holiday-float 9 1 1 "Labor Day")
    (holiday-float 10 1 2 "Columbus Day")
    (holiday-fixed 10 31 "Halloween")
    (holiday-fixed 11 11 "Veteran's Day")
64
    (holiday-float 11 4 4 "Thanksgiving")))
65 66
  "General holidays.  Default value is for the United States.
See the documentation for `calendar-holidays' for details."
67
  :type 'sexp)
68 69 70 71 72
;;;###autoload
(put 'holiday-general-holidays 'risky-local-variable t)

;;;###autoload
(defcustom holiday-oriental-holidays
73
  (mapcar 'purecopy
74 75 76 77 78 79 80 81 82 83
  '((holiday-chinese-new-year)
    (if calendar-chinese-all-holidays-flag
        (append
         (holiday-chinese 1 15 "Lantern Festival")
         (holiday-chinese-qingming)
         (holiday-chinese 5  5 "Dragon Boat Festival")
         (holiday-chinese 7  7 "Double Seventh Festival")
         (holiday-chinese 8 15 "Mid-Autumn Festival")
         (holiday-chinese 9  9 "Double Ninth Festival")
         (holiday-chinese-winter-solstice)
84
         ))))
85 86
  "Oriental holidays.
See the documentation for `calendar-holidays' for details."
87
  :version "23.1"                       ; added more holidays
88
  :type 'sexp)
89 90 91 92 93 94 95
;;;###autoload
(put 'holiday-oriental-holidays 'risky-local-variable t)

;;;###autoload
(defcustom holiday-local-holidays nil
  "Local holidays.
See the documentation for `calendar-holidays' for details."
96
  :type 'sexp)
97 98 99 100 101 102 103
;;;###autoload
(put 'holiday-local-holidays 'risky-local-variable t)

;;;###autoload
(defcustom holiday-other-holidays nil
  "User defined holidays.
See the documentation for `calendar-holidays' for details."
104
  :type 'sexp)
105 106 107 108 109
;;;###autoload
(put 'holiday-other-holidays 'risky-local-variable t)

;;;###autoload
(defcustom holiday-hebrew-holidays
110
  (mapcar 'purecopy
111 112 113 114 115 116
  '((holiday-hebrew-passover)
    (holiday-hebrew-rosh-hashanah)
    (holiday-hebrew-hanukkah)
    (if calendar-hebrew-all-holidays-flag
        (append
         (holiday-hebrew-tisha-b-av)
117
         (holiday-hebrew-misc)))))
118 119 120
  "Jewish holidays.
See the documentation for `calendar-holidays' for details."
  :type 'sexp
121 122
  :version "23.1")            ; removed dependency on hebrew-holidays-N

123 124 125 126 127
;;;###autoload
(put 'holiday-hebrew-holidays 'risky-local-variable t)

;;;###autoload
(defcustom holiday-christian-holidays
128
  (mapcar 'purecopy
129 130 131 132 133
  '((holiday-easter-etc)    ; respects calendar-christian-all-holidays-flag
    (holiday-fixed 12 25 "Christmas")
    (if calendar-christian-all-holidays-flag
        (append
         (holiday-fixed 1 6 "Epiphany")
134
         (holiday-julian 12 25 "Christmas (Julian calendar)")
135 136
         (holiday-greek-orthodox-easter)
         (holiday-fixed 8 15 "Assumption")
137
         (holiday-advent 0 "Advent")))))
138 139
  "Christian holidays.
See the documentation for `calendar-holidays' for details."
140
  :type 'sexp)
141 142 143 144 145
;;;###autoload
(put 'holiday-christian-holidays 'risky-local-variable t)

;;;###autoload
(defcustom holiday-islamic-holidays
146
  (mapcar 'purecopy
147 148 149 150 151 152 153 154 155 156
  '((holiday-islamic-new-year)
    (holiday-islamic 9 1 "Ramadan Begins")
    (if calendar-islamic-all-holidays-flag
        (append
         (holiday-islamic 1 10 "Ashura")
         (holiday-islamic 3 12 "Mulad-al-Nabi")
         (holiday-islamic 7 26 "Shab-e-Mi'raj")
         (holiday-islamic 8 15 "Shab-e-Bara't")
         (holiday-islamic 9 27 "Shab-e Qadr")
         (holiday-islamic 10 1 "Id-al-Fitr")
157
         (holiday-islamic 12 10 "Id-al-Adha")))))
158 159
  "Islamic holidays.
See the documentation for `calendar-holidays' for details."
160
  :type 'sexp)
161 162 163 164 165
;;;###autoload
(put 'holiday-islamic-holidays 'risky-local-variable t)

;;;###autoload
(defcustom holiday-bahai-holidays
166
  (mapcar 'purecopy
167 168
  '((holiday-bahai-new-year)
    (holiday-bahai-ridvan)      ; respects calendar-bahai-all-holidays-flag
169
    (holiday-fixed  5 23 "Declaration of the Báb")
170
    (holiday-fixed  5 29 "Ascension of Bahá’u’lláh")
171 172
    (holiday-fixed  7  9 "Martyrdom of the Báb")
    (holiday-fixed 10 20 "Birth of the Báb")
173
    (holiday-fixed 11 12 "Birth of Bahá’u’lláh")
174 175 176
    (if calendar-bahai-all-holidays-flag
        (append
         (holiday-fixed 11 26 "Day of the Covenant")
177 178
         (holiday-fixed 11 28 "Ascension of `Abdu’l-Bahá")))))
  "Bahá’í holidays.
179
See the documentation for `calendar-holidays' for details."
180
  :type 'sexp)
181 182 183 184 185
;;;###autoload
(put 'holiday-bahai-holidays 'risky-local-variable t)

;;;###autoload
(defcustom holiday-solar-holidays
186
  (mapcar 'purecopy
187 188 189 190 191 192 193 194 195 196
  '((solar-equinoxes-solstices)
    (holiday-sexp calendar-daylight-savings-starts
                  (format "Daylight Saving Time Begins %s"
                          (solar-time-string
                           (/ calendar-daylight-savings-starts-time (float 60))
                           calendar-standard-time-zone-name)))
    (holiday-sexp calendar-daylight-savings-ends
                  (format "Daylight Saving Time Ends %s"
                          (solar-time-string
                           (/ calendar-daylight-savings-ends-time (float 60))
197
                           calendar-daylight-time-zone-name)))))
198 199
  "Sun-related holidays.
See the documentation for `calendar-holidays' for details."
200
  :type 'sexp)
201 202 203
;;;###autoload
(put 'holiday-solar-holidays 'risky-local-variable t)

204 205 206
;; This one should not be autoloaded, else .emacs changes of
;; holiday-general-holidays etc have no effect.
;; FIXME should have some :set-after.
207 208 209 210 211 212 213 214 215
(defcustom calendar-holidays
  (append holiday-general-holidays holiday-local-holidays
          holiday-other-holidays holiday-christian-holidays
          holiday-hebrew-holidays holiday-islamic-holidays
          holiday-bahai-holidays holiday-oriental-holidays
          holiday-solar-holidays)
  "List of notable days for the command \\[holidays].

Additional holidays are easy to add to the list, just put them in the
216
list `holiday-other-holidays' in your init file.  Similarly, by setting
217 218 219 220
any of `holiday-general-holidays', `holiday-local-holidays',
`holiday-christian-holidays', `holiday-hebrew-holidays',
`holiday-islamic-holidays', `holiday-bahai-holidays',
`holiday-oriental-holidays', or `holiday-solar-holidays' to nil in your
221
init file, you can eliminate unwanted categories of holidays.
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241

The aforementioned variables control the holiday choices offered
by the function `holiday-list' when it is called interactively.

They also initialize the default value of `calendar-holidays',
which is the default list of holidays used by the function
`holiday-list' in the non-interactive case.  Note that these
variables have no effect on `calendar-holidays' after it has been
set (e.g. after the calendar is loaded).  In that case, customize
`calendar-holidays' directly.

The intention is that (in the US) `holiday-local-holidays' be set in
site-init.el and `holiday-other-holidays' be set by the user.

Entries on the list are expressions that return (possibly empty) lists of
items of the form ((month day year) string) of a holiday in the
three-month period centered around `displayed-month' of `displayed-year'.
Several basic functions are provided for this purpose:

    (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar
Glenn Morris's avatar
Glenn Morris committed
242 243 244 245 246
    (holiday-float MONTH DAYNAME K STRING &optional DAY) is the Kth DAYNAME
                               (0 for Sunday, etc.) after/before Gregorian
                               MONTH DAY.  K<0 means count back from the end
                               of the month.  Optional DAY defaults to 1 if
                               K>0, and MONTH's last day otherwise.
247 248
    (holiday-hebrew MONTH DAY STRING)  a fixed date on the Hebrew calendar
    (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
249
    (holiday-bahai MONTH DAY STRING)   a fixed date on the Bahá’í calendar
250 251 252 253 254 255 256 257 258 259 260 261
    (holiday-julian MONTH DAY STRING)  a fixed date on the Julian calendar
    (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression
                               in the variable `year'; if it evaluates to
                               a visible date, that's the holiday; if it
                               evaluates to nil, there's no holiday.  STRING
                               is an expression in the variable `date'.

For example, to add Bastille Day, celebrated in France on July 14, add

     (holiday-fixed 7 14 \"Bastille Day\")

to the list.  To add Hurricane Supplication Day, celebrated in the Virgin
262
Islands on the fourth Monday in July, add
263

264
     (holiday-float 7 1 4 \"Hurricane Supplication Day\")
265 266 267 268 269 270 271 272 273 274 275 276

to the list (the last Monday would be specified with `-1' instead of `4').
To add the last day of Hanukkah to the list, use

     (holiday-hebrew 10 2 \"Last day of Hanukkah\")

since the Hebrew months are numbered with 1 starting from Nisan.
To add the Islamic feast celebrating Mohammed's birthday, use

     (holiday-islamic 3 12 \"Mohammed's Birthday\")

since the Islamic months are numbered from 1 starting with Muharram.
277
To add an entry for the Bahá’í festival of Ridvan, use
278 279 280

     (holiday-bahai 2 13 \"Festival of Ridvan\")

281
since the Bahá’í months are numbered from 1 starting with Bahá.
282 283 284 285 286 287 288 289 290
To add Thomas Jefferson's birthday, April 2, 1743 (Julian), use

     (holiday-julian 4 2 \"Jefferson's Birthday\")

To include a holiday conditionally, use the sexp form or a conditional.  For
example, to include American presidential elections, which occur on the first
Tuesday after the first Monday in November of years divisible by 4, add

     (holiday-sexp
291
       \\='(if (zerop (% year 4))
292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317
           (calendar-gregorian-from-absolute
             (1+ (calendar-dayname-on-or-before
                   1 (+ 6 (calendar-absolute-from-gregorian
                            (list 11 1 year)))))))
       \"US Presidential Election\")

or

     (if (zerop (% displayed-year 4))
         (holiday-fixed 11
                (calendar-extract-day
                 (calendar-gregorian-from-absolute
                  (1+ (calendar-dayname-on-or-before
                       1 (+ 6 (calendar-absolute-from-gregorian
                               (list 11 1 displayed-year)))))))
                \"US Presidential Election\"))

to the list.  To include the phases of the moon, add

     (lunar-phases)

to the holiday list, where `lunar-phases' is an Emacs-Lisp function that
you've written to return a (possibly empty) list of the relevant VISIBLE dates
with descriptive strings such as

     (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... )."
318
  :type 'sexp)
319 320 321 322 323 324
;;;###autoload
(put 'calendar-holidays 'risky-local-variable t)

;;; End of user options.


325
;; FIXME name that makes sense
326 327 328 329
;;;###diary-autoload
(defun calendar-holiday-list ()
  "Form the list of holidays that occur on dates in the calendar window.
The holidays are those in the list `calendar-holidays'."
330
  (let (res h)
331 332 333
    (sort
     (dolist (p calendar-holidays res)
       (if (setq h (if calendar-debug-sexp
334
                       (let ((debug-on-error t))
335
                         (eval p t))
336
                     (condition-case err
337
                         (eval p t)
338 339
                       (error
                        (display-warning
340
                         'holidays
341
                         (format "Bad holiday list item: %s\nError: %s\n"
342 343
                                 p err)
                         :error)
344
                        nil))))
345 346
           (setq res (append h res))))
     'calendar-date-compare)))
347

348
(defvar displayed-month)                ; from calendar-generate
349 350
(defvar displayed-year)

351
;; FIXME name that makes sense
352
;;;###cal-autoload
353
(defun calendar-list-holidays (&optional event)
354
  "Create a buffer containing the holidays for the current calendar window.
355
The holidays are those in the list `calendar-notable-days'.
356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387
Returns non-nil if any holidays are found.
If EVENT is non-nil, it's an event indicating the buffer position to
use instead of point."
  (interactive (list last-nonmenu-event))
  ;; If called from a menu, with the calendar window not selected.
  (with-current-buffer
      (if event (window-buffer (posn-window (event-start event)))
        (current-buffer))
    (message "Looking up holidays...")
    (let ((holiday-list (calendar-holiday-list))
          (m1 displayed-month)
          (y1 displayed-year)
          (m2 displayed-month)
          (y2 displayed-year))
      (if (not holiday-list)
          (message "Looking up holidays...none found")
        (calendar-in-read-only-buffer holiday-buffer
          (calendar-increment-month m1 y1 -1)
          (calendar-increment-month m2 y2 1)
          (calendar-set-mode-line
           (if (= y1 y2)
               (format "Notable Dates from %s to %s, %d%%-"
                       (calendar-month-name m1) (calendar-month-name m2) y2)
             (format "Notable Dates from %s, %d to %s, %d%%-"
                     (calendar-month-name m1) y1 (calendar-month-name m2) y2)))
          (insert
           (mapconcat
            (lambda (x) (concat (calendar-date-string (car x))
                                ": " (cadr x)))
            holiday-list "\n")))
        (message "Looking up holidays...done"))
      holiday-list)))
388

389
;;;###autoload
Jim Blandy's avatar
Jim Blandy committed
390
(defun holidays (&optional arg)
Jim Blandy's avatar
Jim Blandy committed
391
  "Display the holidays for last month, this month, and next month.
Glenn Morris's avatar
Glenn Morris committed
392
If called with an optional prefix argument ARG, prompts for month and year.
393
This function is suitable for execution in an init file."
Jim Blandy's avatar
Jim Blandy committed
394
  (interactive "P")
Jim Blandy's avatar
Jim Blandy committed
395
  (save-excursion
Jim Blandy's avatar
Jim Blandy committed
396
    (let* ((completion-ignore-case t)
397
           (date (if arg (calendar-read-date t)
398
                   (calendar-current-date)))
399 400
           (displayed-month (calendar-extract-month date))
           (displayed-year (calendar-extract-year date)))
401
      (calendar-list-holidays))))
Jim Blandy's avatar
Jim Blandy committed
402

403 404
;; rms: "Emacs commands to display a list of something generally start
;; with `list-'.  Please make `list-holidays' the principal name."
405
;;;###autoload
406
(defun list-holidays (y1 &optional y2 l label)
407
  "Display holidays for years Y1 to Y2 (inclusive).
Glenn Morris's avatar
Glenn Morris committed
408 409 410
Y2 defaults to Y1.  The optional list of holidays L defaults to
`calendar-holidays'.  If you want to control what holidays are
displayed, use a different list.  For example,
Eli Zaretskii's avatar
Eli Zaretskii committed
411

412
  (list-holidays 2006 2006
413
    (append holiday-general-holidays holiday-local-holidays))
Eli Zaretskii's avatar
Eli Zaretskii committed
414

415
will display holidays for the year 2006 defined in the two
Eli Zaretskii's avatar
Eli Zaretskii committed
416 417
mentioned lists, and nothing else.

Glenn Morris's avatar
Glenn Morris committed
418
When called interactively, this command offers a choice of
419
holidays, based on the variables `holiday-solar-holidays' etc.  See the
Glenn Morris's avatar
Glenn Morris committed
420 421 422
documentation of `calendar-holidays' for a list of the variables
that control the choices, as well as a description of the format
of a holiday list.
423 424 425 426 427

The optional LABEL is used to label the buffer created."
  (interactive
   (let* ((start-year (calendar-read
                       "Starting year of holidays (>0): "
Glenn Morris's avatar
Glenn Morris committed
428
                       (lambda (x) (> x 0))
429
                       (number-to-string (calendar-extract-year
430 431
                                       (calendar-current-date)))))
          (end-year (calendar-read
432 433 434
                     (format "Ending year (inclusive) of holidays (>=%s): "
                             start-year)
                     (lambda (x) (>= x start-year))
435
                     (number-to-string start-year)))
436 437 438 439
          (completion-ignore-case t)
          (lists
           (list
            (cons "All" calendar-holidays)
440 441
            (cons "Equinoxes/Solstices"
                  (list (list 'solar-equinoxes-solstices)))
442 443 444 445 446 447 448 449 450 451 452 453 454
            (if holiday-general-holidays
                (cons "General" holiday-general-holidays))
            (if holiday-local-holidays
                (cons "Local" holiday-local-holidays))
            (if holiday-other-holidays
                (cons "Other" holiday-other-holidays))
            (if holiday-christian-holidays
                (cons "Christian" holiday-christian-holidays))
            (if holiday-hebrew-holidays
                (cons "Hebrew" holiday-hebrew-holidays))
            (if holiday-islamic-holidays
                (cons "Islamic" holiday-islamic-holidays))
            (if holiday-bahai-holidays
455
                (cons "Bahá’í" holiday-bahai-holidays))
456 457 458 459
            (if holiday-oriental-holidays
                (cons "Oriental" holiday-oriental-holidays))
            (if holiday-solar-holidays
                (cons "Solar" holiday-solar-holidays))
460 461 462 463
            (cons "Ask" nil)))
          (choice (capitalize
                   (completing-read "List (TAB for choices): " lists nil t)))
          (which (if (string-equal choice "Ask")
464
                     (symbol-value (read-variable "Enter list name: "))
465 466 467
                   (cdr (assoc choice lists))))
          (name (if (string-equal choice "Equinoxes/Solstices")
                    choice
468
                  (if (member choice '("Ask" ""))
469
                      "Holidays"
470 471
                    (format "%s Holidays" choice)))))
     (list start-year end-year which name)))
472
  (unless y2 (setq y2 y1))
473
  (message "Computing holidays...")
474 475 476 477 478 479 480 481 482
  (let ((calendar-holidays (or l calendar-holidays))
        (title (or label "Holidays"))
        (s (calendar-absolute-from-gregorian (list 2 1 y1)))
        (e (calendar-absolute-from-gregorian (list 11 1 y2)))
        (displayed-month 2)
        (displayed-year y1)
        holiday-list)
    (while (<= s e)
      (setq holiday-list (append holiday-list (calendar-holiday-list)))
483
      (calendar-increment-month displayed-month displayed-year 3)
484
      (setq s (calendar-absolute-from-gregorian
485
               (list displayed-month 1 displayed-year))))
486
    (save-excursion
487 488 489 490 491 492 493 494 495 496
      (calendar-in-read-only-buffer holiday-buffer
        (calendar-set-mode-line
         (if (= y1 y2)
             (format "%s for %s" title y1)
           (format "%s for %s-%s" title y1 y2)))
        (insert
         (mapconcat
          (lambda (x) (concat (calendar-date-string (car x))
                              ": " (cadr x)))
          holiday-list "\n")))
497 498
      (message "Computing holidays...done"))))

499
;;;###autoload
500
(defalias 'holiday-list 'list-holidays)
501

502
;;;###diary-autoload
503
(defun calendar-check-holidays (date)
Jim Blandy's avatar
Jim Blandy committed
504
  "Check the list of holidays for any that occur on DATE.
505 506
DATE is a list (month day year).  This function considers the
holidays from the list `calendar-holidays', and returns a list of
507
strings describing those holidays that apply on DATE, or nil if none do."
508 509
  (let ((displayed-month (calendar-extract-month date))
        (displayed-year (calendar-extract-year date))
510 511
        holiday-list)
    (dolist (h (calendar-holiday-list) holiday-list)
512
      (if (calendar-date-equal date (car h))
513
          (setq holiday-list (append holiday-list (cdr h)))))))
Jim Blandy's avatar
Jim Blandy committed
514

515 516 517 518 519 520 521 522 523 524 525 526 527 528 529

(defun holiday-in-range (d1 d2)
  "Generate a list of all holidays in range from absolute date D1 to D2."
  (let* ((start (calendar-gregorian-from-absolute d1))
         (displayed-month (calendar-extract-month start))
         (displayed-year (calendar-extract-year start))
         (end (calendar-gregorian-from-absolute d2))
         (end-month (calendar-extract-month end))
         (end-year (calendar-extract-year end))
         (number-of-intervals
          (1+ (/ (calendar-interval displayed-month displayed-year
                                    end-month end-year)
                 3)))
         holidays in-range a)
    (calendar-increment-month displayed-month displayed-year 1)
530
    (dotimes (_ number-of-intervals)
531 532 533 534 535 536 537 538 539 540
      (setq holidays (append holidays (calendar-holiday-list)))
      (calendar-increment-month displayed-month displayed-year 3))
    (dolist (hol holidays)
      (and (car hol)
           (setq a (calendar-absolute-from-gregorian (car hol)))
           (and (<= d1 a) (<= a d2))
           (setq in-range (append (list hol) in-range))))
    in-range))


541
(declare-function x-popup-menu "menu.c" (position menu))
542

543
;;;###cal-autoload
544
(defun calendar-cursor-holidays (&optional date event)
545 546
  "Find holidays for the date specified by the cursor in the calendar window.
Optional DATE is a list (month day year) to use instead of the
547 548
cursor position.  EVENT specifies a buffer position to use for a date."
  (interactive (list nil last-nonmenu-event))
Jim Blandy's avatar
Jim Blandy committed
549
  (message "Checking holidays...")
550 551 552 553 554 555 556 557 558 559 560
  (or date (setq date (calendar-cursor-to-date t event)))
  (let ((date-string (calendar-date-string date))
        (holiday-list (calendar-check-holidays date))
        selection msg)
    (if (mouse-event-p event)
        (and (setq selection (cal-menu-x-popup-menu event
                                 (format "Holidays for %s" date-string)
                               (if holiday-list
                                   (mapcar 'list holiday-list)
                                 '("None"))))
             (call-interactively selection))
Jim Blandy's avatar
Jim Blandy committed
561 562
    (if (not holiday-list)
        (message "No holidays known for %s" date-string)
563 564 565 566
      (if (<= (length (setq msg
                            (format "%s:  %s" date-string
                                    (mapconcat 'identity holiday-list ";  "))))
              (frame-width))
567
          (message "%s" msg)
568 569 570
        (calendar-in-read-only-buffer holiday-buffer
          (calendar-set-mode-line date-string)
          (insert (mapconcat 'identity holiday-list "\n")))
571
        (message "Checking holidays...done"))))))
Jim Blandy's avatar
Jim Blandy committed
572

573
;; FIXME move to calendar?
574
;;;###cal-autoload
575 576 577 578 579 580 581 582 583 584 585 586 587 588
(defun calendar-mark-holidays (&optional event)
  "Mark notable days in the calendar window.
If EVENT is non-nil, it's an event indicating the buffer position to
use instead of point."
  (interactive (list last-nonmenu-event))
  ;; If called from a menu, with the calendar window not selected.
  (with-current-buffer
      (if event (window-buffer (posn-window (event-start event)))
        (current-buffer))
    (setq calendar-mark-holidays-flag t)
    (message "Marking holidays...")
    (dolist (holiday (calendar-holiday-list))
      (calendar-mark-visible-date (car holiday) calendar-holiday-marker))
    (message "Marking holidays...done")))
Jim Blandy's avatar
Jim Blandy committed
589 590

;; Below are the functions that calculate the dates of holidays; these
591 592 593 594 595 596 597 598 599
;; are eval'ed in the function calendar-holiday-list.  If you
;; write other such functions, be sure to imitate the style used below.
;; Remember that each function must return a list of items of the form
;; ((month day year) string) of VISIBLE dates in the calendar window.

(defun holiday-fixed (month day string)
  "Holiday on MONTH, DAY (Gregorian) called STRING.
If MONTH, DAY is visible, the value returned is the list (((MONTH DAY year)
STRING)).  Returns nil if it is not visible in the current calendar window."
Glenn Morris's avatar
Glenn Morris committed
600 601 602 603 604 605 606 607 608 609 610 611 612
  ;; This determines whether a given month is visible in the calendar.
  ;; cf calendar-date-is-visible-p (which also checks the year part).
  ;; The day is irrelevant since only full months are displayed.
  ;; Since the calendar displays three months at a time, month N
  ;; is visible if displayed-month = N-1, N, N+1.
  ;; In particular, November is visible if d-m = 10, 11, 12.
  ;; This is useful, because we can do a one-sided test:
  ;; November is visible if d-m > 9. (Similarly, February is visible if
  ;; d-m < 4.)
  ;; To determine if December is visible, we can shift the calendar
  ;; back a month and ask if November is visible; to determine if
  ;; October is visible, we can shift it forward a month and ask if
  ;; November is visible; etc.
613 614
  (let ((m displayed-month)
        (y displayed-year))
615
    (calendar-increment-month m y (- 11 month))
Paul Eggert's avatar
Paul Eggert committed
616
    (if (> m 9)                         ; Is November visible?
617
        (list (list (list month day y) string)))))
Jim Blandy's avatar
Jim Blandy committed
618

619
(defun holiday-float (month dayname n string &optional day)
Glenn Morris's avatar
Glenn Morris committed
620 621 622 623 624 625 626
  "Holiday called STRING on the Nth DAYNAME after/before MONTH DAY.
DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
If N>0, use the Nth DAYNAME after MONTH DAY.
If N<0, use the Nth DAYNAME before MONTH DAY.
DAY defaults to 1 if N>0, and MONTH's last day otherwise.
If the holiday is visible in the calendar window, returns a
list (((month day year) STRING)).  Otherwise returns nil."
627 628 629 630 631 632
  ;; This is messy because the holiday may be visible, while the date
  ;; on which it is based is not.  For example, the first Monday after
  ;; December 30 may be visible when January is not.  For large values
  ;; of |n| the problem is more grotesque.  If we didn't have to worry
  ;; about such cases, we could just use the original version of this
  ;; function:
633 634
  ;;  (let ((m displayed-month)
  ;;        (y displayed-year))
635
  ;;    (calendar-increment-month m y (- 11 month))
636 637
  ;;    (if (> m 9); month in year y is visible
  ;;      (list (list (calendar-nth-named-day n dayname month y day) string)))))
638 639
  (let* ((m1 displayed-month)
         (y1 displayed-year)
640 641 642
         (m2 displayed-month)
         (y2 displayed-year)
         (d1 (progn             ; first possible base date for holiday
643
               (calendar-increment-month m1 y1 -1)
644 645 646 647 648
               (+ (calendar-nth-named-absday 1 dayname m1 y1)
                  (* -7 n)
                  (if (> n 0) 1 -7))))
         (d2                     ; last possible base date for holiday
          (progn
649
            (calendar-increment-month m2 y2 1)
650 651
            (+ (calendar-nth-named-absday -1 dayname m2 y2)
               (* -7 n)
652
               (if (> n 0) 7 -1))))
653 654
         (y1 (calendar-extract-year (calendar-gregorian-from-absolute d1)))
         (y2 (calendar-extract-year (calendar-gregorian-from-absolute d2)))
655 656 657 658 659 660 661 662 663 664 665 666 667
         (y                             ; year of base date
          (if (or (= y1 y2) (> month 9))
              y1
            y2))
         (d                             ; day of base date
          (or day (if (> n 0)
                      1
                    (calendar-last-day-of-month month y))))
         (date                        ; base date for holiday
          (calendar-absolute-from-gregorian (list month d y))))
    (and (<= d1 date) (<= date d2)
         (list (list (calendar-nth-named-day n dayname month y d)
                     string)))))
668

669 670 671 672 673 674
(defun holiday-filter-visible-calendar (hlist)
  "Filter list of holidays HLIST, and return only the visible ones.
HLIST is a list of elements of the form (DATE) TEXT."
  (delq nil (mapcar (lambda (p)
                      (and (car p) (calendar-date-is-visible-p (car p)) p))
                    hlist)))
675

676
(defun holiday-sexp (sexp string)
Jim Blandy's avatar
Jim Blandy committed
677
  "Sexp holiday for dates in the calendar window.
678 679 680 681 682
SEXP is an expression in variable `year' that is evaluated to
give `date'.  STRING is an expression in `date' that evaluates to
the holiday description of `date'.  If `date' is visible in the
calendar window, the holiday STRING is on that date.  If date is
nil, or if the date is not visible, there is no holiday."
Jim Blandy's avatar
Jim Blandy committed
683
  (let ((m displayed-month)
684
        (y displayed-year))
685
    (calendar-increment-month m y -1)
686
    (holiday-filter-visible-calendar
687 688 689 690 691 692 693 694 695 696
     (calendar-dlet* (year date)
       (list
        (progn
          (setq year y
                date (eval sexp t))
          (list date (if date (eval string t))))
        (progn
          (setq year (1+ y)
                date (eval sexp t))
          (list date (if date (eval string t)))))))))
697

698

699 700 701 702 703 704 705
(defun holiday-advent (&optional n string)
  "Date of Nth day after advent (named STRING), if visible in calendar window.
Negative values of N are interpreted as days before advent.
STRING is used purely for display purposes.  The return value has
the form ((MONTH DAY YEAR) STRING), where the date is that of the
Nth day before or after advent.

706
For backwards compatibility, if this function is called with no
707
arguments, then it returns the value appropriate for advent itself."
708
  ;; Backwards compatibility layer.
709 710
  (if (not n)
      (holiday-advent 0 "Advent")
711 712 713
    (let* ((year displayed-year)
           (month displayed-month)
           (advent (progn
714
                     (calendar-increment-month month year -1)
715 716 717 718 719 720 721 722
                     (calendar-gregorian-from-absolute
                      (+ n
                         (calendar-dayname-on-or-before
                          0
                          (calendar-absolute-from-gregorian
                           (list 12 3 year))))))))
      (if (calendar-date-is-visible-p advent)
          (list (list advent string))))))
723

724 725 726 727 728 729 730
(defun holiday-easter-etc (&optional n string)
  "Date of Nth day after Easter (named STRING), if visible in calendar window.
Negative values of N are interpreted as days before Easter.
STRING is used purely for display purposes.  The return value has
the form ((MONTH DAY YEAR) STRING), where the date is that of the
Nth day before or after Easter.

731
For backwards compatibility, if this function is called with no
732
arguments, then it returns a list of \"standard\" Easter-related
733
holidays (with more entries if `calendar-christian-all-holidays-flag'
734
is non-nil)."
735
  ;; Backwards compatibility layer.
736
  (if (not n)
737 738 739 740 741
      (apply 'append
             (mapcar (lambda (e)
                       (apply 'holiday-easter-etc e))
                     ;; The combined list is not in order.
                     (append
742
                      (if calendar-christian-all-holidays-flag
743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759
                          '((-63 "Septuagesima Sunday")
                            (-56 "Sexagesima Sunday")
                            (-49 "Shrove Sunday")
                            (-48 "Shrove Monday")
                            (-47 "Shrove Tuesday")
                            (-14 "Passion Sunday")
                            (-7 "Palm Sunday")
                            (-3 "Maundy Thursday")
                            (35 "Rogation Sunday")
                            (39 "Ascension Day")
                            (49 "Pentecost (Whitsunday)")
                            (50 "Whitmonday")
                            (56 "Trinity Sunday")
                            (60 "Corpus Christi")))
                      '((-46 "Ash Wednesday")
                        (-2 "Good Friday")
                        (0 "Easter Sunday")))))
760
    (let* ((century (1+ (/ displayed-year 100)))
Glenn Morris's avatar
Glenn Morris committed
761
           (shifted-epact               ; age of moon for April 5...
762
            (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule
Glenn Morris's avatar
Glenn Morris committed
763
                  (-     ; ...corrected for the Gregorian century rule
764
                   (/ (* 3 century) 4))
765
                  (/       ; ...corrected for Metonic cycle inaccuracy
766
                   (+ 5 (* 8 century)) 25)
767
                  (* 30 century))       ; keeps value positive
768
               30))
769
           (adjusted-epact              ; adjust for 29.5 day month
770 771 772 773
            (if (or (zerop shifted-epact)
                    (and (= shifted-epact 1) (< 10 (% displayed-year 19))))
                (1+ shifted-epact)
              shifted-epact))
Glenn Morris's avatar
Glenn Morris committed
774
           (paschal-moon ; day after the full moon on or after March 21
775 776
            (- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
               adjusted-epact))
777 778 779 780
           (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
           (greg (calendar-gregorian-from-absolute (+ abs-easter n))))
      (if (calendar-date-is-visible-p greg)
          (list (list greg string))))))
Jim Blandy's avatar
Jim Blandy committed
781

782
;; Prior call to calendar-julian-from-absolute will autoload cal-julian.
783
(declare-function calendar-julian-to-absolute "cal-julian" (date))
784

785 786 787 788 789 790 791 792 793 794
(defun holiday-greek-orthodox-easter (&optional n string)
  "Date of Nth day after Easter (named STRING), if visible in calendar window.
It is calculated according to the rule of the Council of Nicaea.
Negative values of N are interpreted as days before Easter.
STRING is used purely for display purposes.  The return value has
the form ((MONTH DAY YEAR) STRING), where the date is that of the
Nth day before or after Easter.

For backwards compatibility, if this function is called with no
arguments, it returns the date of Pascha (Greek Orthodox Easter)."
795 796 797
  (let* ((m displayed-month)
         (y displayed-year)
         (julian-year (progn
798 799
                        (calendar-increment-month m y 1)
                        (calendar-extract-year
800 801 802 803 804 805 806 807
                         (calendar-julian-from-absolute
                          (calendar-absolute-from-gregorian
                           (list m (calendar-last-day-of-month m y) y))))))
         (shifted-epact                 ; age of moon for April 5
          (% (+ 14
                (* 11 (% julian-year 19)))
             30))
         (paschal-moon      ; day after full moon on or after March 21
808
          (- (calendar-julian-to-absolute (list 4 19 julian-year))
809
             shifted-epact))
810 811 812 813
	 (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
	 (greg (calendar-gregorian-from-absolute (+ abs-easter (or n 0)))))
    (if (calendar-date-is-visible-p greg)
	(list (list greg (or string "Pascha (Greek Orthodox Easter)"))))))
Jim Blandy's avatar
Jim Blandy committed
814

Jim Blandy's avatar
Jim Blandy committed
815 816
(provide 'holidays)

Eric S. Raymond's avatar
Eric S. Raymond committed
817
;;; holidays.el ends here