comparison lisp/calendar/holidays.el @ 93809:3ff2b47de8f2

Update for calendar.el name changes.

93808:2c72483f42c9

                              (message "Bad holiday list item: %s" p)
                              (sleep-for 2)))))
           (setq res (append h res))))
     'calendar-date-compare)))

(defvar displayed-month)                ; from generate-calendar
(defvar displayed-year)

;;;###cal-autoload
(defun calendar-list-holidays ()
  "Create a buffer containing the holidays for the current calendar window.

        (m2 displayed-month)
        (y2 displayed-year))
    (if (not holiday-list)
        (message "Looking up holidays...none found")
      (calendar-in-read-only-buffer holiday-buffer
        (increment-calendar-month m1 y1 -1)
        (increment-calendar-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%%-"

  (interactive "P")
  (save-excursion
    (let* ((completion-ignore-case t)
           (date (if arg (calendar-read-date t)
                   (calendar-current-date)))
           (displayed-month (extract-calendar-month date))
           (displayed-year (extract-calendar-year date)))
      (calendar-list-holidays))))

;; rms: "Emacs commands to display a list of something generally start
;; with `list-'.  Please make `list-holidays' the principal name."
;;;###autoload

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,

  (list-holidays 2006 2006
    (append general-holidays local-holidays other-holidays))

will display holidays for the year 2006 defined in the 3
mentioned lists, and nothing else.

When called interactively, this command offers a choice of
holidays, based on the variables `solar-holidays' etc.  See the
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.

The optional LABEL is used to label the buffer created."
  (interactive
   (let* ((start-year (calendar-read
                       "Starting year of holidays (>0): "
                       (lambda (x) (> x 0))
                       (int-to-string (extract-calendar-year
                                       (calendar-current-date)))))
          (end-year (calendar-read
                     (format "Ending year (inclusive) of holidays (>=%s): "
                             start-year)
                     (lambda (x) (>= x start-year))

          (lists
           (list
            (cons "All" calendar-holidays)
            (cons "Equinoxes/Solstices"
                  (list (list 'solar-equinoxes-solstices)))
            (if general-holidays (cons "General" general-holidays))
            (if local-holidays (cons "Local" local-holidays))
            (if other-holidays (cons "Other" other-holidays))
            (if christian-holidays (cons "Christian" christian-holidays))
            (if hebrew-holidays (cons "Hebrew" hebrew-holidays))
            (if islamic-holidays (cons "Islamic" islamic-holidays))
            (if bahai-holidays (cons "Baha'i" bahai-holidays))
            (if oriental-holidays (cons "Oriental" oriental-holidays))
            (if solar-holidays (cons "Solar" solar-holidays))
            (cons "Ask" nil)))
          (choice (capitalize
                   (completing-read "List (TAB for choices): " lists nil t)))
          (which (if (string-equal choice "Ask")
                     (eval (read-variable "Enter list name: "))

        (displayed-month 2)
        (displayed-year y1)
        holiday-list)
    (while (<= s e)
      (setq holiday-list (append holiday-list (calendar-holiday-list)))
      (increment-calendar-month displayed-month displayed-year 3)
      (setq s (calendar-absolute-from-gregorian
               (list displayed-month 1 displayed-year))))
    (save-excursion
      (calendar-in-read-only-buffer holiday-buffer
        (calendar-set-mode-line

;;;###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'."
  (let ((displayed-month (extract-calendar-month date))
        (displayed-year (extract-calendar-year date))
        holiday-list)
    (dolist (h (calendar-holiday-list) holiday-list)
      (if (calendar-date-equal date (car h))
          (setq holiday-list (append holiday-list (cdr h)))))))

;;;###cal-autoload
(defun calendar-mark-holidays ()
  "Mark notable days in the calendar window."
  (interactive)
  (setq mark-holidays-in-calendar t)
  (message "Marking holidays...")
  (dolist (holiday (calendar-holiday-list))
    (mark-visible-calendar-date (car holiday) calendar-holiday-marker))
  (message "Marking holidays...done"))

(define-obsolete-function-alias
  'mark-calendar-holidays 'calendar-mark-holidays "23.1")

  ;; 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.
  (let ((m displayed-month)
        (y displayed-year))
    (increment-calendar-month m y (- 11 month))
    (if (> m 9)                         ; is november visible?
        (list (list (list month day y) string)))))

(defun holiday-float (month dayname n string &optional day)
  "Holiday on MONTH, DAYNAME (Nth occurrence) called STRING.

  ;; 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:
  ;;  (let ((m displayed-month)
  ;;        (y displayed-year))
  ;;    (increment-calendar-month m y (- 11 month))
  ;;    (if (> m 9); month in year y is visible
  ;;      (list (list (calendar-nth-named-day n dayname month y day) string)))))
  (let* ((m1 displayed-month)
         (y1 displayed-year)
         (m2 displayed-month)
         (y2 displayed-year)
         (d1 (progn             ; first possible base date for holiday
               (increment-calendar-month m1 y1 -1)
               (+ (calendar-nth-named-absday 1 dayname m1 y1)
                  (* -7 n)
                  (if (> n 0) 1 -7))))
         (d2                     ; last possible base date for holiday
          (progn
            (increment-calendar-month m2 y2 1)
            (+ (calendar-nth-named-absday -1 dayname m2 y2)
               (* -7 n)
               (if (> n 0) 7 -1))))
         (y1 (extract-calendar-year (calendar-gregorian-from-absolute d1)))
         (y2 (extract-calendar-year (calendar-gregorian-from-absolute d2)))
         (y                             ; year of base date
          (if (or (= y1 y2) (> month 9))
              y1
            y2))
         (d                             ; day of base date

calendar window, the holiday STRING is on that date.  If date is
nil, or if the date is not visible, there is no holiday."
  (let ((m displayed-month)
        (y displayed-year)
        year date)
    (increment-calendar-month m y -1)
    (holiday-filter-visible-calendar
     (list
      (progn
        (setq year y
              date (eval sexp))

  (if (not n)
      (holiday-advent 0 "Advent")
    (let* ((year displayed-year)
           (month displayed-month)
           (advent (progn
                     (increment-calendar-month month year -1)
                     (calendar-gregorian-from-absolute
                      (+ n
                         (calendar-dayname-on-or-before
                          0
                          (calendar-absolute-from-gregorian

(defun holiday-greek-orthodox-easter ()
  "Date of Easter according to the rule of the Council of Nicaea."
  (let* ((m displayed-month)
         (y displayed-year)
         (julian-year (progn
                        (increment-calendar-month m y 1)
                        (extract-calendar-year
                         (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

93809:3ff2b47de8f2

                              (message "Bad holiday list item: %s" p)
                              (sleep-for 2)))))
           (setq res (append h res))))
     'calendar-date-compare)))

(defvar displayed-month)                ; from calendar-generate
(defvar displayed-year)

;;;###cal-autoload
(defun calendar-list-holidays ()
  "Create a buffer containing the holidays for the current calendar window.

        (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%%-"

  (interactive "P")
  (save-excursion
    (let* ((completion-ignore-case t)
           (date (if arg (calendar-read-date t)
                   (calendar-current-date)))
           (displayed-month (calendar-extract-month date))
           (displayed-year (calendar-extract-year date)))
      (calendar-list-holidays))))

;; rms: "Emacs commands to display a list of something generally start
;; with `list-'.  Please make `list-holidays' the principal name."
;;;###autoload

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,

  (list-holidays 2006 2006
    (append holiday-general-holidays holiday-local-holidays))

will display holidays for the year 2006 defined in the two
mentioned lists, and nothing else.

When called interactively, this command offers a choice of
holidays, based on the variables `holiday-solar-holidays' etc.  See the
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.

The optional LABEL is used to label the buffer created."
  (interactive
   (let* ((start-year (calendar-read
                       "Starting year of holidays (>0): "
                       (lambda (x) (> x 0))
                       (int-to-string (calendar-extract-year
                                       (calendar-current-date)))))
          (end-year (calendar-read
                     (format "Ending year (inclusive) of holidays (>=%s): "
                             start-year)
                     (lambda (x) (>= x start-year))

          (lists
           (list
            (cons "All" calendar-holidays)
            (cons "Equinoxes/Solstices"
                  (list (list 'solar-equinoxes-solstices)))
            (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
                (cons "Baha'i" holiday-bahai-holidays))
            (if holiday-oriental-holidays
                (cons "Oriental" holiday-oriental-holidays))
            (if holiday-solar-holidays
                (cons "Solar" holiday-solar-holidays))
            (cons "Ask" nil)))
          (choice (capitalize
                   (completing-read "List (TAB for choices): " lists nil t)))
          (which (if (string-equal choice "Ask")
                     (eval (read-variable "Enter list name: "))

        (displayed-month 2)
        (displayed-year y1)
        holiday-list)
    (while (<= s e)
      (setq holiday-list (append holiday-list (calendar-holiday-list)))
      (calendar-increment-month displayed-month displayed-year 3)
      (setq s (calendar-absolute-from-gregorian
               (list displayed-month 1 displayed-year))))
    (save-excursion
      (calendar-in-read-only-buffer holiday-buffer
        (calendar-set-mode-line

;;;###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'."
  (let ((displayed-month (calendar-extract-month date))
        (displayed-year (calendar-extract-year date))
        holiday-list)
    (dolist (h (calendar-holiday-list) holiday-list)
      (if (calendar-date-equal date (car h))
          (setq holiday-list (append holiday-list (cdr h)))))))

;;;###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"))

(define-obsolete-function-alias
  'mark-calendar-holidays 'calendar-mark-holidays "23.1")

  ;; 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.
  (let ((m displayed-month)
        (y displayed-year))
    (calendar-increment-month m y (- 11 month))
    (if (> m 9)                         ; is november visible?
        (list (list (list month day y) string)))))

(defun holiday-float (month dayname n string &optional day)
  "Holiday on MONTH, DAYNAME (Nth occurrence) called STRING.

  ;; 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:
  ;;  (let ((m displayed-month)
  ;;        (y displayed-year))
  ;;    (calendar-increment-month m y (- 11 month))
  ;;    (if (> m 9); month in year y is visible
  ;;      (list (list (calendar-nth-named-day n dayname month y day) string)))))
  (let* ((m1 displayed-month)
         (y1 displayed-year)
         (m2 displayed-month)
         (y2 displayed-year)
         (d1 (progn             ; first possible base date for holiday
               (calendar-increment-month m1 y1 -1)
               (+ (calendar-nth-named-absday 1 dayname m1 y1)
                  (* -7 n)
                  (if (> n 0) 1 -7))))
         (d2                     ; last possible base date for holiday
          (progn
            (calendar-increment-month m2 y2 1)
            (+ (calendar-nth-named-absday -1 dayname m2 y2)
               (* -7 n)
               (if (> n 0) 7 -1))))
         (y1 (calendar-extract-year (calendar-gregorian-from-absolute d1)))
         (y2 (calendar-extract-year (calendar-gregorian-from-absolute d2)))
         (y                             ; year of base date
          (if (or (= y1 y2) (> month 9))
              y1
            y2))
         (d                             ; day of base date

calendar window, the holiday STRING is on that date.  If date is
nil, or if the date is not visible, there is no holiday."
  (let ((m displayed-month)
        (y displayed-year)
        year date)
    (calendar-increment-month m y -1)
    (holiday-filter-visible-calendar
     (list
      (progn
        (setq year y
              date (eval sexp))

  (if (not n)
      (holiday-advent 0 "Advent")
    (let* ((year displayed-year)
           (month displayed-month)
           (advent (progn
                     (calendar-increment-month month year -1)
                     (calendar-gregorian-from-absolute
                      (+ n
                         (calendar-dayname-on-or-before
                          0
                          (calendar-absolute-from-gregorian

(defun holiday-greek-orthodox-easter ()
  "Date of Easter according to the rule of the Council of Nicaea."
  (let* ((m displayed-month)
         (y displayed-year)
         (julian-year (progn
                        (calendar-increment-month m y 1)
                        (calendar-extract-year
                         (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