holidays.el 37 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928
  1. ;;; holidays.el --- holiday functions for the calendar package
  2. ;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2012
  3. ;; Free Software Foundation, Inc.
  4. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
  5. ;; Maintainer: Glenn Morris <rgm@gnu.org>
  6. ;; Keywords: holidays, calendar
  7. ;; Package: calendar
  8. ;; This file is part of GNU Emacs.
  9. ;; GNU Emacs is free software: you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation, either version 3 of the License, or
  12. ;; (at your option) any later version.
  13. ;; GNU Emacs is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. ;; GNU General Public License for more details.
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  19. ;;; Commentary:
  20. ;; See calendar.el.
  21. ;;; Code:
  22. (require 'calendar)
  23. (load "hol-loaddefs" nil t)
  24. (defgroup holidays nil
  25. "Holidays support in calendar."
  26. :group 'calendar
  27. :prefix "holidays-"
  28. :group 'local)
  29. ;; The various holiday variables are autoloaded because people
  30. ;; are used to using them to set calendar-holidays without having to
  31. ;; explicitly load this file.
  32. ;;;###autoload
  33. (define-obsolete-variable-alias 'general-holidays
  34. 'holiday-general-holidays "23.1")
  35. ;;;###autoload
  36. (defcustom holiday-general-holidays
  37. (mapcar 'purecopy
  38. '((holiday-fixed 1 1 "New Year's Day")
  39. (holiday-float 1 1 3 "Martin Luther King Day")
  40. (holiday-fixed 2 2 "Groundhog Day")
  41. (holiday-fixed 2 14 "Valentine's Day")
  42. (holiday-float 2 1 3 "President's Day")
  43. (holiday-fixed 3 17 "St. Patrick's Day")
  44. (holiday-fixed 4 1 "April Fools' Day")
  45. (holiday-float 5 0 2 "Mother's Day")
  46. (holiday-float 5 1 -1 "Memorial Day")
  47. (holiday-fixed 6 14 "Flag Day")
  48. (holiday-float 6 0 3 "Father's Day")
  49. (holiday-fixed 7 4 "Independence Day")
  50. (holiday-float 9 1 1 "Labor Day")
  51. (holiday-float 10 1 2 "Columbus Day")
  52. (holiday-fixed 10 31 "Halloween")
  53. (holiday-fixed 11 11 "Veteran's Day")
  54. (holiday-float 11 4 4 "Thanksgiving")))
  55. "General holidays. Default value is for the United States.
  56. See the documentation for `calendar-holidays' for details."
  57. :type 'sexp
  58. :group 'holidays)
  59. ;;;###autoload
  60. (put 'holiday-general-holidays 'risky-local-variable t)
  61. ;;;###autoload
  62. (define-obsolete-variable-alias 'oriental-holidays
  63. 'holiday-oriental-holidays "23.1")
  64. ;;;###autoload
  65. (defcustom holiday-oriental-holidays
  66. (mapcar 'purecopy
  67. '((holiday-chinese-new-year)
  68. (if calendar-chinese-all-holidays-flag
  69. (append
  70. (holiday-chinese 1 15 "Lantern Festival")
  71. (holiday-chinese-qingming)
  72. (holiday-chinese 5 5 "Dragon Boat Festival")
  73. (holiday-chinese 7 7 "Double Seventh Festival")
  74. (holiday-chinese 8 15 "Mid-Autumn Festival")
  75. (holiday-chinese 9 9 "Double Ninth Festival")
  76. (holiday-chinese-winter-solstice)
  77. ))))
  78. "Oriental holidays.
  79. See the documentation for `calendar-holidays' for details."
  80. :version "23.1" ; added more holidays
  81. :type 'sexp
  82. :group 'holidays)
  83. ;;;###autoload
  84. (put 'holiday-oriental-holidays 'risky-local-variable t)
  85. ;;;###autoload
  86. (define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1")
  87. ;;;###autoload
  88. (defcustom holiday-local-holidays nil
  89. "Local holidays.
  90. See the documentation for `calendar-holidays' for details."
  91. :type 'sexp
  92. :group 'holidays)
  93. ;;;###autoload
  94. (put 'holiday-local-holidays 'risky-local-variable t)
  95. ;;;###autoload
  96. (define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1")
  97. ;;;###autoload
  98. (defcustom holiday-other-holidays nil
  99. "User defined holidays.
  100. See the documentation for `calendar-holidays' for details."
  101. :type 'sexp
  102. :group 'holidays)
  103. ;;;###autoload
  104. (put 'holiday-other-holidays 'risky-local-variable t)
  105. ;;;###autoload
  106. (defvar hebrew-holidays-1
  107. (mapcar 'purecopy
  108. '((holiday-hebrew-rosh-hashanah)
  109. (if calendar-hebrew-all-holidays-flag
  110. (holiday-julian
  111. 11
  112. (let ((m displayed-month)
  113. (y displayed-year)
  114. year)
  115. (calendar-increment-month m y -1)
  116. (setq year (calendar-extract-year
  117. (calendar-julian-from-absolute
  118. (calendar-absolute-from-gregorian (list m 1 y)))))
  119. (if (zerop (% (1+ year) 4))
  120. 22
  121. 21)) "\"Tal Umatar\" (evening)"))))
  122. "Component of the old default value of `holiday-hebrew-holidays'.")
  123. ;;;###autoload
  124. (put 'hebrew-holidays-1 'risky-local-variable t)
  125. (make-obsolete-variable 'hebrew-holidays-1 'hebrew-holidays "23.1")
  126. ;;;###autoload
  127. (defvar hebrew-holidays-2
  128. (mapcar 'purecopy
  129. '((holiday-hebrew-hanukkah) ; respects calendar-hebrew-all-holidays-flag
  130. (if calendar-hebrew-all-holidays-flag
  131. (holiday-hebrew
  132. 10
  133. (let ((h-year (calendar-extract-year
  134. (calendar-hebrew-from-absolute
  135. (calendar-absolute-from-gregorian
  136. (list displayed-month 28 displayed-year))))))
  137. (if (= 6 (% (calendar-hebrew-to-absolute (list 10 10 h-year))
  138. 7))
  139. 11 10))
  140. "Tzom Teveth"))
  141. (if calendar-hebrew-all-holidays-flag
  142. (holiday-hebrew 11 15 "Tu B'Shevat"))))
  143. "Component of the old default value of `holiday-hebrew-holidays'.")
  144. ;;;###autoload
  145. (put 'hebrew-holidays-2 'risky-local-variable t)
  146. (make-obsolete-variable 'hebrew-holidays-2 'hebrew-holidays "23.1")
  147. ;;;###autoload
  148. (defvar hebrew-holidays-3
  149. (mapcar 'purecopy
  150. '((if calendar-hebrew-all-holidays-flag
  151. (holiday-hebrew
  152. 11
  153. (let* ((m displayed-month)
  154. (y displayed-year)
  155. (h-year (progn
  156. (calendar-increment-month m y 1)
  157. (calendar-extract-year
  158. (calendar-hebrew-from-absolute
  159. (calendar-absolute-from-gregorian
  160. (list m (calendar-last-day-of-month m y) y))))))
  161. (s-s
  162. (calendar-hebrew-from-absolute
  163. (if (= 6
  164. (% (calendar-hebrew-to-absolute
  165. (list 7 1 h-year))
  166. 7))
  167. (calendar-dayname-on-or-before
  168. 6 (calendar-hebrew-to-absolute
  169. (list 11 17 h-year)))
  170. (calendar-dayname-on-or-before
  171. 6 (calendar-hebrew-to-absolute
  172. (list 11 16 h-year))))))
  173. (day (calendar-extract-day s-s)))
  174. day)
  175. "Shabbat Shirah"))))
  176. "Component of the old default value of `holiday-hebrew-holidays'.")
  177. ;;;###autoload
  178. (put 'hebrew-holidays-3 'risky-local-variable t)
  179. (make-obsolete-variable 'hebrew-holidays-3 'hebrew-holidays "23.1")
  180. ;;;###autoload
  181. (defvar hebrew-holidays-4
  182. (mapcar 'purecopy
  183. '((holiday-hebrew-passover)
  184. (and calendar-hebrew-all-holidays-flag
  185. (let* ((m displayed-month)
  186. (y displayed-year)
  187. (year (progn
  188. (calendar-increment-month m y -1)
  189. (calendar-extract-year
  190. (calendar-julian-from-absolute
  191. (calendar-absolute-from-gregorian (list m 1 y)))))))
  192. (= 21 (% year 28)))
  193. (holiday-julian 3 26 "Kiddush HaHamah"))
  194. (if calendar-hebrew-all-holidays-flag
  195. (holiday-hebrew-tisha-b-av))))
  196. "Component of the old default value of `holiday-hebrew-holidays'.")
  197. ;;;###autoload
  198. (put 'hebrew-holidays-4 'risky-local-variable t)
  199. (make-obsolete-variable 'hebrew-holidays-4 'hebrew-holidays "23.1")
  200. ;;;###autoload
  201. (define-obsolete-variable-alias 'hebrew-holidays
  202. 'holiday-hebrew-holidays "23.1")
  203. ;;;###autoload
  204. (defcustom holiday-hebrew-holidays
  205. (mapcar 'purecopy
  206. '((holiday-hebrew-passover)
  207. (holiday-hebrew-rosh-hashanah)
  208. (holiday-hebrew-hanukkah)
  209. (if calendar-hebrew-all-holidays-flag
  210. (append
  211. (holiday-hebrew-tisha-b-av)
  212. (holiday-hebrew-misc)))))
  213. "Jewish holidays.
  214. See the documentation for `calendar-holidays' for details."
  215. :type 'sexp
  216. :version "23.1" ; removed dependency on hebrew-holidays-N
  217. :group 'holidays)
  218. ;;;###autoload
  219. (put 'holiday-hebrew-holidays 'risky-local-variable t)
  220. ;;;###autoload
  221. (define-obsolete-variable-alias 'christian-holidays
  222. 'holiday-christian-holidays "23.1")
  223. ;;;###autoload
  224. (defcustom holiday-christian-holidays
  225. (mapcar 'purecopy
  226. '((holiday-easter-etc) ; respects calendar-christian-all-holidays-flag
  227. (holiday-fixed 12 25 "Christmas")
  228. (if calendar-christian-all-holidays-flag
  229. (append
  230. (holiday-fixed 1 6 "Epiphany")
  231. (holiday-julian 12 25 "Eastern Orthodox Christmas")
  232. (holiday-greek-orthodox-easter)
  233. (holiday-fixed 8 15 "Assumption")
  234. (holiday-advent 0 "Advent")))))
  235. "Christian holidays.
  236. See the documentation for `calendar-holidays' for details."
  237. :type 'sexp
  238. :group 'holidays)
  239. ;;;###autoload
  240. (put 'holiday-christian-holidays 'risky-local-variable t)
  241. ;;;###autoload
  242. (define-obsolete-variable-alias 'islamic-holidays
  243. 'holiday-islamic-holidays "23.1")
  244. ;;;###autoload
  245. (defcustom holiday-islamic-holidays
  246. (mapcar 'purecopy
  247. '((holiday-islamic-new-year)
  248. (holiday-islamic 9 1 "Ramadan Begins")
  249. (if calendar-islamic-all-holidays-flag
  250. (append
  251. (holiday-islamic 1 10 "Ashura")
  252. (holiday-islamic 3 12 "Mulad-al-Nabi")
  253. (holiday-islamic 7 26 "Shab-e-Mi'raj")
  254. (holiday-islamic 8 15 "Shab-e-Bara't")
  255. (holiday-islamic 9 27 "Shab-e Qadr")
  256. (holiday-islamic 10 1 "Id-al-Fitr")
  257. (holiday-islamic 12 10 "Id-al-Adha")))))
  258. "Islamic holidays.
  259. See the documentation for `calendar-holidays' for details."
  260. :type 'sexp
  261. :group 'holidays)
  262. ;;;###autoload
  263. (put 'holiday-islamic-holidays 'risky-local-variable t)
  264. ;;;###autoload
  265. (define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1")
  266. ;;;###autoload
  267. (defcustom holiday-bahai-holidays
  268. (mapcar 'purecopy
  269. '((holiday-bahai-new-year)
  270. (holiday-bahai-ridvan) ; respects calendar-bahai-all-holidays-flag
  271. (holiday-fixed 5 23 "Declaration of the Báb")
  272. (holiday-fixed 5 29 "Ascension of Bahá'u'lláh")
  273. (holiday-fixed 7 9 "Martyrdom of the Báb")
  274. (holiday-fixed 10 20 "Birth of the Báb")
  275. (holiday-fixed 11 12 "Birth of Bahá'u'lláh")
  276. (if calendar-bahai-all-holidays-flag
  277. (append
  278. (holiday-fixed 11 26 "Day of the Covenant")
  279. (holiday-fixed 11 28 "Ascension of `Abdu'l-Bahá")))))
  280. "Bahá'í holidays.
  281. See the documentation for `calendar-holidays' for details."
  282. :type 'sexp
  283. :group 'holidays)
  284. ;;;###autoload
  285. (put 'holiday-bahai-holidays 'risky-local-variable t)
  286. ;;;###autoload
  287. (define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1")
  288. ;;;###autoload
  289. (defcustom holiday-solar-holidays
  290. (mapcar 'purecopy
  291. '((solar-equinoxes-solstices)
  292. (holiday-sexp calendar-daylight-savings-starts
  293. (format "Daylight Saving Time Begins %s"
  294. (solar-time-string
  295. (/ calendar-daylight-savings-starts-time (float 60))
  296. calendar-standard-time-zone-name)))
  297. (holiday-sexp calendar-daylight-savings-ends
  298. (format "Daylight Saving Time Ends %s"
  299. (solar-time-string
  300. (/ calendar-daylight-savings-ends-time (float 60))
  301. calendar-daylight-time-zone-name)))))
  302. "Sun-related holidays.
  303. See the documentation for `calendar-holidays' for details."
  304. :type 'sexp
  305. :group 'holidays)
  306. ;;;###autoload
  307. (put 'holiday-solar-holidays 'risky-local-variable t)
  308. ;; This one should not be autoloaded, else .emacs changes of
  309. ;; holiday-general-holidays etc have no effect.
  310. ;; FIXME should have some :set-after.
  311. (defcustom calendar-holidays
  312. (append holiday-general-holidays holiday-local-holidays
  313. holiday-other-holidays holiday-christian-holidays
  314. holiday-hebrew-holidays holiday-islamic-holidays
  315. holiday-bahai-holidays holiday-oriental-holidays
  316. holiday-solar-holidays)
  317. "List of notable days for the command \\[holidays].
  318. Additional holidays are easy to add to the list, just put them in the
  319. list `holiday-other-holidays' in your .emacs file. Similarly, by setting
  320. any of `holiday-general-holidays', `holiday-local-holidays',
  321. `holiday-christian-holidays', `holiday-hebrew-holidays',
  322. `holiday-islamic-holidays', `holiday-bahai-holidays',
  323. `holiday-oriental-holidays', or `holiday-solar-holidays' to nil in your
  324. .emacs file, you can eliminate unwanted categories of holidays.
  325. The aforementioned variables control the holiday choices offered
  326. by the function `holiday-list' when it is called interactively.
  327. They also initialize the default value of `calendar-holidays',
  328. which is the default list of holidays used by the function
  329. `holiday-list' in the non-interactive case. Note that these
  330. variables have no effect on `calendar-holidays' after it has been
  331. set (e.g. after the calendar is loaded). In that case, customize
  332. `calendar-holidays' directly.
  333. The intention is that (in the US) `holiday-local-holidays' be set in
  334. site-init.el and `holiday-other-holidays' be set by the user.
  335. Entries on the list are expressions that return (possibly empty) lists of
  336. items of the form ((month day year) string) of a holiday in the
  337. three-month period centered around `displayed-month' of `displayed-year'.
  338. Several basic functions are provided for this purpose:
  339. (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar
  340. (holiday-float MONTH DAYNAME K STRING &optional DAY) is the Kth DAYNAME
  341. (0 for Sunday, etc.) after/before Gregorian
  342. MONTH DAY. K<0 means count back from the end
  343. of the month. Optional DAY defaults to 1 if
  344. K>0, and MONTH's last day otherwise.
  345. (holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar
  346. (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
  347. (holiday-bahai MONTH DAY STRING) a fixed date on the Bahá'í calendar
  348. (holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar
  349. (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression
  350. in the variable `year'; if it evaluates to
  351. a visible date, that's the holiday; if it
  352. evaluates to nil, there's no holiday. STRING
  353. is an expression in the variable `date'.
  354. For example, to add Bastille Day, celebrated in France on July 14, add
  355. (holiday-fixed 7 14 \"Bastille Day\")
  356. to the list. To add Hurricane Supplication Day, celebrated in the Virgin
  357. Islands on the fourth Monday in August, add
  358. (holiday-float 8 1 4 \"Hurricane Supplication Day\")
  359. to the list (the last Monday would be specified with `-1' instead of `4').
  360. To add the last day of Hanukkah to the list, use
  361. (holiday-hebrew 10 2 \"Last day of Hanukkah\")
  362. since the Hebrew months are numbered with 1 starting from Nisan.
  363. To add the Islamic feast celebrating Mohammed's birthday, use
  364. (holiday-islamic 3 12 \"Mohammed's Birthday\")
  365. since the Islamic months are numbered from 1 starting with Muharram.
  366. To add an entry for the Bahá'í festival of Ridvan, use
  367. (holiday-bahai 2 13 \"Festival of Ridvan\")
  368. since the Bahá'í months are numbered from 1 starting with Bahá.
  369. To add Thomas Jefferson's birthday, April 2, 1743 (Julian), use
  370. (holiday-julian 4 2 \"Jefferson's Birthday\")
  371. To include a holiday conditionally, use the sexp form or a conditional. For
  372. example, to include American presidential elections, which occur on the first
  373. Tuesday after the first Monday in November of years divisible by 4, add
  374. (holiday-sexp
  375. '(if (zerop (% year 4))
  376. (calendar-gregorian-from-absolute
  377. (1+ (calendar-dayname-on-or-before
  378. 1 (+ 6 (calendar-absolute-from-gregorian
  379. (list 11 1 year)))))))
  380. \"US Presidential Election\")
  381. or
  382. (if (zerop (% displayed-year 4))
  383. (holiday-fixed 11
  384. (calendar-extract-day
  385. (calendar-gregorian-from-absolute
  386. (1+ (calendar-dayname-on-or-before
  387. 1 (+ 6 (calendar-absolute-from-gregorian
  388. (list 11 1 displayed-year)))))))
  389. \"US Presidential Election\"))
  390. to the list. To include the phases of the moon, add
  391. (lunar-phases)
  392. to the holiday list, where `lunar-phases' is an Emacs-Lisp function that
  393. you've written to return a (possibly empty) list of the relevant VISIBLE dates
  394. with descriptive strings such as
  395. (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... )."
  396. :type 'sexp
  397. :group 'holidays)
  398. ;;;###autoload
  399. (put 'calendar-holidays 'risky-local-variable t)
  400. ;;; End of user options.
  401. ;; FIXME name that makes sense
  402. ;;;###diary-autoload
  403. (defun calendar-holiday-list ()
  404. "Form the list of holidays that occur on dates in the calendar window.
  405. The holidays are those in the list `calendar-holidays'."
  406. (let (res h)
  407. (sort
  408. (dolist (p calendar-holidays res)
  409. (if (setq h (if calendar-debug-sexp
  410. (let ((debug-on-error t))
  411. (eval p))
  412. (condition-case nil
  413. (eval p)
  414. (error (beep)
  415. (message "Bad holiday list item: %s" p)
  416. (sleep-for 2)))))
  417. (setq res (append h res))))
  418. 'calendar-date-compare)))
  419. (defvar displayed-month) ; from calendar-generate
  420. (defvar displayed-year)
  421. ;; FIXME name that makes sense
  422. ;;;###cal-autoload
  423. (defun calendar-list-holidays (&optional event)
  424. "Create a buffer containing the holidays for the current calendar window.
  425. The holidays are those in the list `calendar-notable-days'.
  426. Returns non-nil if any holidays are found.
  427. If EVENT is non-nil, it's an event indicating the buffer position to
  428. use instead of point."
  429. (interactive (list last-nonmenu-event))
  430. ;; If called from a menu, with the calendar window not selected.
  431. (with-current-buffer
  432. (if event (window-buffer (posn-window (event-start event)))
  433. (current-buffer))
  434. (message "Looking up holidays...")
  435. (let ((holiday-list (calendar-holiday-list))
  436. (m1 displayed-month)
  437. (y1 displayed-year)
  438. (m2 displayed-month)
  439. (y2 displayed-year))
  440. (if (not holiday-list)
  441. (message "Looking up holidays...none found")
  442. (calendar-in-read-only-buffer holiday-buffer
  443. (calendar-increment-month m1 y1 -1)
  444. (calendar-increment-month m2 y2 1)
  445. (calendar-set-mode-line
  446. (if (= y1 y2)
  447. (format "Notable Dates from %s to %s, %d%%-"
  448. (calendar-month-name m1) (calendar-month-name m2) y2)
  449. (format "Notable Dates from %s, %d to %s, %d%%-"
  450. (calendar-month-name m1) y1 (calendar-month-name m2) y2)))
  451. (insert
  452. (mapconcat
  453. (lambda (x) (concat (calendar-date-string (car x))
  454. ": " (cadr x)))
  455. holiday-list "\n")))
  456. (message "Looking up holidays...done"))
  457. holiday-list)))
  458. (define-obsolete-function-alias
  459. 'list-calendar-holidays 'calendar-list-holidays "23.1")
  460. ;;;###autoload
  461. (defun holidays (&optional arg)
  462. "Display the holidays for last month, this month, and next month.
  463. If called with an optional prefix argument ARG, prompts for month and year.
  464. This function is suitable for execution in a .emacs file."
  465. (interactive "P")
  466. (save-excursion
  467. (let* ((completion-ignore-case t)
  468. (date (if arg (calendar-read-date t)
  469. (calendar-current-date)))
  470. (displayed-month (calendar-extract-month date))
  471. (displayed-year (calendar-extract-year date)))
  472. (calendar-list-holidays))))
  473. ;; rms: "Emacs commands to display a list of something generally start
  474. ;; with `list-'. Please make `list-holidays' the principal name."
  475. ;;;###autoload
  476. (defun list-holidays (y1 &optional y2 l label)
  477. "Display holidays for years Y1 to Y2 (inclusive).
  478. Y2 defaults to Y1. The optional list of holidays L defaults to
  479. `calendar-holidays'. If you want to control what holidays are
  480. displayed, use a different list. For example,
  481. (list-holidays 2006 2006
  482. (append holiday-general-holidays holiday-local-holidays))
  483. will display holidays for the year 2006 defined in the two
  484. mentioned lists, and nothing else.
  485. When called interactively, this command offers a choice of
  486. holidays, based on the variables `holiday-solar-holidays' etc. See the
  487. documentation of `calendar-holidays' for a list of the variables
  488. that control the choices, as well as a description of the format
  489. of a holiday list.
  490. The optional LABEL is used to label the buffer created."
  491. (interactive
  492. (let* ((start-year (calendar-read
  493. "Starting year of holidays (>0): "
  494. (lambda (x) (> x 0))
  495. (number-to-string (calendar-extract-year
  496. (calendar-current-date)))))
  497. (end-year (calendar-read
  498. (format "Ending year (inclusive) of holidays (>=%s): "
  499. start-year)
  500. (lambda (x) (>= x start-year))
  501. (number-to-string start-year)))
  502. (completion-ignore-case t)
  503. (lists
  504. (list
  505. (cons "All" calendar-holidays)
  506. (cons "Equinoxes/Solstices"
  507. (list (list 'solar-equinoxes-solstices)))
  508. (if holiday-general-holidays
  509. (cons "General" holiday-general-holidays))
  510. (if holiday-local-holidays
  511. (cons "Local" holiday-local-holidays))
  512. (if holiday-other-holidays
  513. (cons "Other" holiday-other-holidays))
  514. (if holiday-christian-holidays
  515. (cons "Christian" holiday-christian-holidays))
  516. (if holiday-hebrew-holidays
  517. (cons "Hebrew" holiday-hebrew-holidays))
  518. (if holiday-islamic-holidays
  519. (cons "Islamic" holiday-islamic-holidays))
  520. (if holiday-bahai-holidays
  521. (cons "Bahá'í" holiday-bahai-holidays))
  522. (if holiday-oriental-holidays
  523. (cons "Oriental" holiday-oriental-holidays))
  524. (if holiday-solar-holidays
  525. (cons "Solar" holiday-solar-holidays))
  526. (cons "Ask" nil)))
  527. (choice (capitalize
  528. (completing-read "List (TAB for choices): " lists nil t)))
  529. (which (if (string-equal choice "Ask")
  530. (eval (read-variable "Enter list name: "))
  531. (cdr (assoc choice lists))))
  532. (name (if (string-equal choice "Equinoxes/Solstices")
  533. choice
  534. (if (member choice '("Ask" ""))
  535. "Holidays"
  536. (format "%s Holidays" choice)))))
  537. (list start-year end-year which name)))
  538. (unless y2 (setq y2 y1))
  539. (message "Computing holidays...")
  540. (let ((calendar-holidays (or l calendar-holidays))
  541. (title (or label "Holidays"))
  542. (s (calendar-absolute-from-gregorian (list 2 1 y1)))
  543. (e (calendar-absolute-from-gregorian (list 11 1 y2)))
  544. (displayed-month 2)
  545. (displayed-year y1)
  546. holiday-list)
  547. (while (<= s e)
  548. (setq holiday-list (append holiday-list (calendar-holiday-list)))
  549. (calendar-increment-month displayed-month displayed-year 3)
  550. (setq s (calendar-absolute-from-gregorian
  551. (list displayed-month 1 displayed-year))))
  552. (save-excursion
  553. (calendar-in-read-only-buffer holiday-buffer
  554. (calendar-set-mode-line
  555. (if (= y1 y2)
  556. (format "%s for %s" title y1)
  557. (format "%s for %s-%s" title y1 y2)))
  558. (insert
  559. (mapconcat
  560. (lambda (x) (concat (calendar-date-string (car x))
  561. ": " (cadr x)))
  562. holiday-list "\n")))
  563. (message "Computing holidays...done"))))
  564. ;;;###autoload
  565. (defalias 'holiday-list 'list-holidays)
  566. ;;;###diary-autoload
  567. (defun calendar-check-holidays (date)
  568. "Check the list of holidays for any that occur on DATE.
  569. DATE is a list (month day year). This function considers the
  570. holidays from the list `calendar-holidays', and returns a list of
  571. strings describing those holidays that apply on DATE, or nil if none do."
  572. (let ((displayed-month (calendar-extract-month date))
  573. (displayed-year (calendar-extract-year date))
  574. holiday-list)
  575. (dolist (h (calendar-holiday-list) holiday-list)
  576. (if (calendar-date-equal date (car h))
  577. (setq holiday-list (append holiday-list (cdr h)))))))
  578. (define-obsolete-function-alias
  579. 'check-calendar-holidays 'calendar-check-holidays "23.1")
  580. (declare-function x-popup-menu "menu.c" (position menu))
  581. ;;;###cal-autoload
  582. (defun calendar-cursor-holidays (&optional date event)
  583. "Find holidays for the date specified by the cursor in the calendar window.
  584. Optional DATE is a list (month day year) to use instead of the
  585. cursor position. EVENT specifies a buffer position to use for a date."
  586. (interactive (list nil last-nonmenu-event))
  587. (message "Checking holidays...")
  588. (or date (setq date (calendar-cursor-to-date t event)))
  589. (let ((date-string (calendar-date-string date))
  590. (holiday-list (calendar-check-holidays date))
  591. selection msg)
  592. (if (mouse-event-p event)
  593. (and (setq selection (cal-menu-x-popup-menu event
  594. (format "Holidays for %s" date-string)
  595. (if holiday-list
  596. (mapcar 'list holiday-list)
  597. '("None"))))
  598. (call-interactively selection))
  599. (if (not holiday-list)
  600. (message "No holidays known for %s" date-string)
  601. (if (<= (length (setq msg
  602. (format "%s: %s" date-string
  603. (mapconcat 'identity holiday-list "; "))))
  604. (frame-width))
  605. (message "%s" msg)
  606. (calendar-in-read-only-buffer holiday-buffer
  607. (calendar-set-mode-line date-string)
  608. (insert (mapconcat 'identity holiday-list "\n")))
  609. (message "Checking holidays...done"))))))
  610. ;; FIXME move to calendar?
  611. ;;;###cal-autoload
  612. (defun calendar-mark-holidays (&optional event)
  613. "Mark notable days in the calendar window.
  614. If EVENT is non-nil, it's an event indicating the buffer position to
  615. use instead of point."
  616. (interactive (list last-nonmenu-event))
  617. ;; If called from a menu, with the calendar window not selected.
  618. (with-current-buffer
  619. (if event (window-buffer (posn-window (event-start event)))
  620. (current-buffer))
  621. (setq calendar-mark-holidays-flag t)
  622. (message "Marking holidays...")
  623. (dolist (holiday (calendar-holiday-list))
  624. (calendar-mark-visible-date (car holiday) calendar-holiday-marker))
  625. (message "Marking holidays...done")))
  626. (define-obsolete-function-alias
  627. 'mark-calendar-holidays 'calendar-mark-holidays "23.1")
  628. ;; Below are the functions that calculate the dates of holidays; these
  629. ;; are eval'ed in the function calendar-holiday-list. If you
  630. ;; write other such functions, be sure to imitate the style used below.
  631. ;; Remember that each function must return a list of items of the form
  632. ;; ((month day year) string) of VISIBLE dates in the calendar window.
  633. (defun holiday-fixed (month day string)
  634. "Holiday on MONTH, DAY (Gregorian) called STRING.
  635. If MONTH, DAY is visible, the value returned is the list (((MONTH DAY year)
  636. STRING)). Returns nil if it is not visible in the current calendar window."
  637. ;; This determines whether a given month is visible in the calendar.
  638. ;; cf calendar-date-is-visible-p (which also checks the year part).
  639. ;; The day is irrelevant since only full months are displayed.
  640. ;; Since the calendar displays three months at a time, month N
  641. ;; is visible if displayed-month = N-1, N, N+1.
  642. ;; In particular, November is visible if d-m = 10, 11, 12.
  643. ;; This is useful, because we can do a one-sided test:
  644. ;; November is visible if d-m > 9. (Similarly, February is visible if
  645. ;; d-m < 4.)
  646. ;; To determine if December is visible, we can shift the calendar
  647. ;; back a month and ask if November is visible; to determine if
  648. ;; October is visible, we can shift it forward a month and ask if
  649. ;; November is visible; etc.
  650. (let ((m displayed-month)
  651. (y displayed-year))
  652. (calendar-increment-month m y (- 11 month))
  653. (if (> m 9) ; Is November visible?
  654. (list (list (list month day y) string)))))
  655. (defun holiday-float (month dayname n string &optional day)
  656. "Holiday called STRING on the Nth DAYNAME after/before MONTH DAY.
  657. DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
  658. If N>0, use the Nth DAYNAME after MONTH DAY.
  659. If N<0, use the Nth DAYNAME before MONTH DAY.
  660. DAY defaults to 1 if N>0, and MONTH's last day otherwise.
  661. If the holiday is visible in the calendar window, returns a
  662. list (((month day year) STRING)). Otherwise returns nil."
  663. ;; This is messy because the holiday may be visible, while the date
  664. ;; on which it is based is not. For example, the first Monday after
  665. ;; December 30 may be visible when January is not. For large values
  666. ;; of |n| the problem is more grotesque. If we didn't have to worry
  667. ;; about such cases, we could just use the original version of this
  668. ;; function:
  669. ;; (let ((m displayed-month)
  670. ;; (y displayed-year))
  671. ;; (calendar-increment-month m y (- 11 month))
  672. ;; (if (> m 9); month in year y is visible
  673. ;; (list (list (calendar-nth-named-day n dayname month y day) string)))))
  674. (let* ((m1 displayed-month)
  675. (y1 displayed-year)
  676. (m2 displayed-month)
  677. (y2 displayed-year)
  678. (d1 (progn ; first possible base date for holiday
  679. (calendar-increment-month m1 y1 -1)
  680. (+ (calendar-nth-named-absday 1 dayname m1 y1)
  681. (* -7 n)
  682. (if (> n 0) 1 -7))))
  683. (d2 ; last possible base date for holiday
  684. (progn
  685. (calendar-increment-month m2 y2 1)
  686. (+ (calendar-nth-named-absday -1 dayname m2 y2)
  687. (* -7 n)
  688. (if (> n 0) 7 -1))))
  689. (y1 (calendar-extract-year (calendar-gregorian-from-absolute d1)))
  690. (y2 (calendar-extract-year (calendar-gregorian-from-absolute d2)))
  691. (y ; year of base date
  692. (if (or (= y1 y2) (> month 9))
  693. y1
  694. y2))
  695. (d ; day of base date
  696. (or day (if (> n 0)
  697. 1
  698. (calendar-last-day-of-month month y))))
  699. (date ; base date for holiday
  700. (calendar-absolute-from-gregorian (list month d y))))
  701. (and (<= d1 date) (<= date d2)
  702. (list (list (calendar-nth-named-day n dayname month y d)
  703. string)))))
  704. (defun holiday-filter-visible-calendar (hlist)
  705. "Filter list of holidays HLIST, and return only the visible ones.
  706. HLIST is a list of elements of the form (DATE) TEXT."
  707. (delq nil (mapcar (lambda (p)
  708. (and (car p) (calendar-date-is-visible-p (car p)) p))
  709. hlist)))
  710. (define-obsolete-function-alias
  711. 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1")
  712. (defun holiday-sexp (sexp string)
  713. "Sexp holiday for dates in the calendar window.
  714. SEXP is an expression in variable `year' that is evaluated to
  715. give `date'. STRING is an expression in `date' that evaluates to
  716. the holiday description of `date'. If `date' is visible in the
  717. calendar window, the holiday STRING is on that date. If date is
  718. nil, or if the date is not visible, there is no holiday."
  719. (let ((m displayed-month)
  720. (y displayed-year)
  721. year date)
  722. (calendar-increment-month m y -1)
  723. (holiday-filter-visible-calendar
  724. (list
  725. (progn
  726. (setq year y
  727. date (eval sexp))
  728. (list date (if date (eval string))))
  729. (progn
  730. (setq year (1+ y)
  731. date (eval sexp))
  732. (list date (if date (eval string))))))))
  733. (defun holiday-advent (&optional n string)
  734. "Date of Nth day after advent (named STRING), if visible in calendar window.
  735. Negative values of N are interpreted as days before advent.
  736. STRING is used purely for display purposes. The return value has
  737. the form ((MONTH DAY YEAR) STRING), where the date is that of the
  738. Nth day before or after advent.
  739. For backwards compatibility, if this function is called with no
  740. arguments, then it returns the value appropriate for advent itself."
  741. ;; Backwards compatibility layer.
  742. (if (not n)
  743. (holiday-advent 0 "Advent")
  744. (let* ((year displayed-year)
  745. (month displayed-month)
  746. (advent (progn
  747. (calendar-increment-month month year -1)
  748. (calendar-gregorian-from-absolute
  749. (+ n
  750. (calendar-dayname-on-or-before
  751. 0
  752. (calendar-absolute-from-gregorian
  753. (list 12 3 year))))))))
  754. (if (calendar-date-is-visible-p advent)
  755. (list (list advent string))))))
  756. (defun holiday-easter-etc (&optional n string)
  757. "Date of Nth day after Easter (named STRING), if visible in calendar window.
  758. Negative values of N are interpreted as days before Easter.
  759. STRING is used purely for display purposes. The return value has
  760. the form ((MONTH DAY YEAR) STRING), where the date is that of the
  761. Nth day before or after Easter.
  762. For backwards compatibility, if this function is called with no
  763. arguments, then it returns a list of \"standard\" Easter-related
  764. holidays (with more entries if `calendar-christian-all-holidays-flag'
  765. is non-nil)."
  766. ;; Backwards compatibility layer.
  767. (if (not n)
  768. (apply 'append
  769. (mapcar (lambda (e)
  770. (apply 'holiday-easter-etc e))
  771. ;; The combined list is not in order.
  772. (append
  773. (if calendar-christian-all-holidays-flag
  774. '((-63 "Septuagesima Sunday")
  775. (-56 "Sexagesima Sunday")
  776. (-49 "Shrove Sunday")
  777. (-48 "Shrove Monday")
  778. (-47 "Shrove Tuesday")
  779. (-14 "Passion Sunday")
  780. (-7 "Palm Sunday")
  781. (-3 "Maundy Thursday")
  782. (35 "Rogation Sunday")
  783. (39 "Ascension Day")
  784. (49 "Pentecost (Whitsunday)")
  785. (50 "Whitmonday")
  786. (56 "Trinity Sunday")
  787. (60 "Corpus Christi")))
  788. '((-46 "Ash Wednesday")
  789. (-2 "Good Friday")
  790. (0 "Easter Sunday")))))
  791. (let* ((century (1+ (/ displayed-year 100)))
  792. (shifted-epact ; age of moon for April 5...
  793. (% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule
  794. (- ; ...corrected for the Gregorian century rule
  795. (/ (* 3 century) 4))
  796. (/ ; ...corrected for Metonic cycle inaccuracy
  797. (+ 5 (* 8 century)) 25)
  798. (* 30 century)) ; keeps value positive
  799. 30))
  800. (adjusted-epact ; adjust for 29.5 day month
  801. (if (or (zerop shifted-epact)
  802. (and (= shifted-epact 1) (< 10 (% displayed-year 19))))
  803. (1+ shifted-epact)
  804. shifted-epact))
  805. (paschal-moon ; day after the full moon on or after March 21
  806. (- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
  807. adjusted-epact))
  808. (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
  809. (greg (calendar-gregorian-from-absolute (+ abs-easter n))))
  810. (if (calendar-date-is-visible-p greg)
  811. (list (list greg string))))))
  812. ;; Prior call to calendar-julian-from-absolute will autoload cal-julian.
  813. (declare-function calendar-julian-to-absolute "cal-julian" (date))
  814. (defun holiday-greek-orthodox-easter ()
  815. "Date of Easter according to the rule of the Council of Nicaea."
  816. (let* ((m displayed-month)
  817. (y displayed-year)
  818. (julian-year (progn
  819. (calendar-increment-month m y 1)
  820. (calendar-extract-year
  821. (calendar-julian-from-absolute
  822. (calendar-absolute-from-gregorian
  823. (list m (calendar-last-day-of-month m y) y))))))
  824. (shifted-epact ; age of moon for April 5
  825. (% (+ 14
  826. (* 11 (% julian-year 19)))
  827. 30))
  828. (paschal-moon ; day after full moon on or after March 21
  829. (- (calendar-julian-to-absolute (list 4 19 julian-year))
  830. shifted-epact))
  831. (nicaean-easter ; Sunday following the Paschal moon
  832. (calendar-gregorian-from-absolute
  833. (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))))
  834. (if (calendar-date-is-visible-p nicaean-easter)
  835. (list (list nicaean-easter "Pascha (Greek Orthodox Easter)")))))
  836. (provide 'holidays)
  837. ;; Local Variables:
  838. ;; coding: utf-8
  839. ;; End:
  840. ;;; holidays.el ends here