;;; holidays.el --- holiday functions for the calendar package
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1997, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2011
+;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Keywords: holidays, calendar
+;; Package: calendar
;; This file is part of GNU Emacs.
;;; Code:
(require 'calendar)
-(require 'hol-loaddefs)
+(load "hol-loaddefs" nil t)
(defgroup holidays nil
"Holidays support in calendar."
;; are used to using them to set calendar-holidays without having to
;; explicitly load this file.
+;;;###autoload
+(define-obsolete-variable-alias 'general-holidays
+ 'holiday-general-holidays "23.1")
;;;###autoload
(defcustom holiday-general-holidays
+ (mapcar 'purecopy
'((holiday-fixed 1 1 "New Year's Day")
(holiday-float 1 1 3 "Martin Luther King Day")
(holiday-fixed 2 2 "Groundhog Day")
(holiday-float 10 1 2 "Columbus Day")
(holiday-fixed 10 31 "Halloween")
(holiday-fixed 11 11 "Veteran's Day")
- (holiday-float 11 4 4 "Thanksgiving"))
+ (holiday-float 11 4 4 "Thanksgiving")))
"General holidays. Default value is for the United States.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
;;;###autoload
(put 'holiday-general-holidays 'risky-local-variable t)
-;;;###autoload
-(define-obsolete-variable-alias 'general-holidays
- 'holiday-general-holidays "23.1")
+;;;###autoload
+(define-obsolete-variable-alias 'oriental-holidays
+ 'holiday-oriental-holidays "23.1")
;;;###autoload
(defcustom holiday-oriental-holidays
+ (mapcar 'purecopy
'((holiday-chinese-new-year)
(if calendar-chinese-all-holidays-flag
(append
(holiday-chinese 8 15 "Mid-Autumn Festival")
(holiday-chinese 9 9 "Double Ninth Festival")
(holiday-chinese-winter-solstice)
- )))
+ ))))
"Oriental holidays.
See the documentation for `calendar-holidays' for details."
:version "23.1" ; added more holidays
:group 'holidays)
;;;###autoload
(put 'holiday-oriental-holidays 'risky-local-variable t)
-;;;###autoload
-(define-obsolete-variable-alias 'oriental-holidays
- 'holiday-oriental-holidays "23.1")
+;;;###autoload
+(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1")
;;;###autoload
(defcustom holiday-local-holidays nil
"Local holidays.
:group 'holidays)
;;;###autoload
(put 'holiday-local-holidays 'risky-local-variable t)
-;;;###autoload
-(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1")
+;;;###autoload
+(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1")
;;;###autoload
(defcustom holiday-other-holidays nil
"User defined holidays.
:group 'holidays)
;;;###autoload
(put 'holiday-other-holidays 'risky-local-variable t)
-;;;###autoload
-(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1")
;;;###autoload
(defvar hebrew-holidays-1
+ (mapcar 'purecopy
'((holiday-hebrew-rosh-hashanah)
(if calendar-hebrew-all-holidays-flag
(holiday-julian
(calendar-absolute-from-gregorian (list m 1 y)))))
(if (zerop (% (1+ year) 4))
22
- 21)) "\"Tal Umatar\" (evening)")))
+ 21)) "\"Tal Umatar\" (evening)"))))
"Component of the old default value of `holiday-hebrew-holidays'.")
;;;###autoload
(put 'hebrew-holidays-1 'risky-local-variable t)
;;;###autoload
(defvar hebrew-holidays-2
+ (mapcar 'purecopy
'((holiday-hebrew-hanukkah) ; respects calendar-hebrew-all-holidays-flag
(if calendar-hebrew-all-holidays-flag
(holiday-hebrew
11 10))
"Tzom Teveth"))
(if calendar-hebrew-all-holidays-flag
- (holiday-hebrew 11 15 "Tu B'Shevat")))
+ (holiday-hebrew 11 15 "Tu B'Shevat"))))
"Component of the old default value of `holiday-hebrew-holidays'.")
;;;###autoload
(put 'hebrew-holidays-2 'risky-local-variable t)
;;;###autoload
(defvar hebrew-holidays-3
+ (mapcar 'purecopy
'((if calendar-hebrew-all-holidays-flag
(holiday-hebrew
11
(list 11 16 h-year))))))
(day (calendar-extract-day s-s)))
day)
- "Shabbat Shirah")))
+ "Shabbat Shirah"))))
"Component of the old default value of `holiday-hebrew-holidays'.")
;;;###autoload
(put 'hebrew-holidays-3 'risky-local-variable t)
;;;###autoload
(defvar hebrew-holidays-4
+ (mapcar 'purecopy
'((holiday-hebrew-passover)
(and calendar-hebrew-all-holidays-flag
(let* ((m displayed-month)
(= 21 (% year 28)))
(holiday-julian 3 26 "Kiddush HaHamah"))
(if calendar-hebrew-all-holidays-flag
- (holiday-hebrew-tisha-b-av)))
+ (holiday-hebrew-tisha-b-av))))
"Component of the old default value of `holiday-hebrew-holidays'.")
;;;###autoload
(put 'hebrew-holidays-4 'risky-local-variable t)
(make-obsolete-variable 'hebrew-holidays-4 'hebrew-holidays "23.1")
+;;;###autoload
+(define-obsolete-variable-alias 'hebrew-holidays
+ 'holiday-hebrew-holidays "23.1")
;;;###autoload
(defcustom holiday-hebrew-holidays
+ (mapcar 'purecopy
'((holiday-hebrew-passover)
(holiday-hebrew-rosh-hashanah)
(holiday-hebrew-hanukkah)
(if calendar-hebrew-all-holidays-flag
(append
(holiday-hebrew-tisha-b-av)
- (holiday-hebrew-misc))))
+ (holiday-hebrew-misc)))))
"Jewish holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
;;;###autoload
(put 'holiday-hebrew-holidays 'risky-local-variable t)
-;;;###autoload
-(define-obsolete-variable-alias 'hebrew-holidays
- 'holiday-hebrew-holidays "23.1")
+;;;###autoload
+(define-obsolete-variable-alias 'christian-holidays
+ 'holiday-christian-holidays "23.1")
;;;###autoload
(defcustom holiday-christian-holidays
+ (mapcar 'purecopy
'((holiday-easter-etc) ; respects calendar-christian-all-holidays-flag
(holiday-fixed 12 25 "Christmas")
(if calendar-christian-all-holidays-flag
(holiday-julian 12 25 "Eastern Orthodox Christmas")
(holiday-greek-orthodox-easter)
(holiday-fixed 8 15 "Assumption")
- (holiday-advent 0 "Advent"))))
+ (holiday-advent 0 "Advent")))))
"Christian holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
;;;###autoload
(put 'holiday-christian-holidays 'risky-local-variable t)
-;;;###autoload
-(define-obsolete-variable-alias 'christian-holidays
- 'holiday-christian-holidays "23.1")
+;;;###autoload
+(define-obsolete-variable-alias 'islamic-holidays
+ 'holiday-islamic-holidays "23.1")
;;;###autoload
(defcustom holiday-islamic-holidays
+ (mapcar 'purecopy
'((holiday-islamic-new-year)
(holiday-islamic 9 1 "Ramadan Begins")
(if calendar-islamic-all-holidays-flag
(holiday-islamic 8 15 "Shab-e-Bara't")
(holiday-islamic 9 27 "Shab-e Qadr")
(holiday-islamic 10 1 "Id-al-Fitr")
- (holiday-islamic 12 10 "Id-al-Adha"))))
+ (holiday-islamic 12 10 "Id-al-Adha")))))
"Islamic holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
;;;###autoload
(put 'holiday-islamic-holidays 'risky-local-variable t)
-;;;###autoload
-(define-obsolete-variable-alias 'islamic-holidays
- 'holiday-islamic-holidays "23.1")
+;;;###autoload
+(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1")
;;;###autoload
(defcustom holiday-bahai-holidays
+ (mapcar 'purecopy
'((holiday-bahai-new-year)
(holiday-bahai-ridvan) ; respects calendar-bahai-all-holidays-flag
(holiday-fixed 5 23 "Declaration of the Bab")
(if calendar-bahai-all-holidays-flag
(append
(holiday-fixed 11 26 "Day of the Covenant")
- (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha"))))
+ (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha")))))
"Baha'i holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
;;;###autoload
(put 'holiday-bahai-holidays 'risky-local-variable t)
-;;;###autoload
-(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1")
+;;;###autoload
+(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1")
;;;###autoload
(defcustom holiday-solar-holidays
+ (mapcar 'purecopy
'((solar-equinoxes-solstices)
(holiday-sexp calendar-daylight-savings-starts
(format "Daylight Saving Time Begins %s"
(format "Daylight Saving Time Ends %s"
(solar-time-string
(/ calendar-daylight-savings-ends-time (float 60))
- calendar-daylight-time-zone-name))))
+ calendar-daylight-time-zone-name)))))
"Sun-related holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
;;;###autoload
(put 'holiday-solar-holidays 'risky-local-variable t)
-;;;###autoload
-(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1")
-;;;###autoload
+;; This one should not be autoloaded, else .emacs changes of
+;; holiday-general-holidays etc have no effect.
+;; FIXME should have some :set-after.
(defcustom calendar-holidays
(append holiday-general-holidays holiday-local-holidays
holiday-other-holidays holiday-christian-holidays
Several basic functions are provided for this purpose:
(holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar
- (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in
- MONTH on the Gregorian calendar (0 for Sunday,
- etc.); K<0 means count back from the end of the
- month. An optional parameter DAY means the Kth
- DAYNAME after/before MONTH DAY.
+ (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.
(holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar
(holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
(holiday-bahai MONTH DAY STRING) a fixed date on the Baha'i calendar
(sort
(dolist (p calendar-holidays res)
(if (setq h (if calendar-debug-sexp
- (let ((stack-trace-on-error t))
+ (let ((debug-on-error t))
(eval p))
(condition-case nil
(eval p)
;; FIXME name that makes sense
;;;###cal-autoload
-(defun calendar-list-holidays ()
+(defun calendar-list-holidays (&optional event)
"Create a buffer containing the holidays for the current calendar window.
The holidays are those in the list `calendar-notable-days'.
-Returns non-nil if any holidays are found."
- (interactive)
- (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))
+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)))
(define-obsolete-function-alias
'list-calendar-holidays 'calendar-list-holidays "23.1")
;;;###diary-autoload
(defun calendar-check-holidays (date)
"Check the list of holidays for any that occur on DATE.
-The value returned is a list of strings of relevant holiday descriptions.
-The holidays are those in the list `calendar-holidays'."
+DATE is a list (month day year). This function considers the
+holidays from the list `calendar-holidays', and returns a list of
+strings describing those holidays that apply on DATE."
(let ((displayed-month (calendar-extract-month date))
(displayed-year (calendar-extract-year date))
holiday-list)
(define-obsolete-function-alias
'check-calendar-holidays 'calendar-check-holidays "23.1")
+(declare-function x-popup-menu "menu.c" (position menu))
+
;;;###cal-autoload
-(defun calendar-cursor-holidays ()
- "Find holidays for the date specified by the cursor in the calendar window."
- (interactive)
+(defun calendar-cursor-holidays (&optional date event)
+ "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
+cursor position. EVENT specifies a buffer position to use for a date."
+ (interactive (list nil last-nonmenu-event))
(message "Checking holidays...")
- (let* ((date (calendar-cursor-to-date t))
- (date-string (calendar-date-string date))
- (holiday-list (calendar-check-holidays date))
- (holiday-string (mapconcat 'identity holiday-list "; "))
- (msg (format "%s: %s" date-string holiday-string)))
+ (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))
(if (not holiday-list)
(message "No holidays known for %s" date-string)
- (if (<= (length msg) (frame-width))
+ (if (<= (length (setq msg
+ (format "%s: %s" date-string
+ (mapconcat 'identity holiday-list "; "))))
+ (frame-width))
(message "%s" msg)
(calendar-in-read-only-buffer holiday-buffer
(calendar-set-mode-line date-string)
(insert (mapconcat 'identity holiday-list "\n")))
- (message "Checking holidays...done")))))
+ (message "Checking holidays...done"))))))
;; FIXME move to calendar?
;;;###cal-autoload
-(defun calendar-mark-holidays ()
- "Mark notable days in the calendar window."
- (interactive)
- (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"))
+(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")))
(define-obsolete-function-alias
'mark-calendar-holidays 'calendar-mark-holidays "23.1")
(provide 'holidays)
-;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37
;;; holidays.el ends here