;;; holidays.el --- holiday functions for the calendar package
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1997, 2004 Free
-;; Software Foundation, Inc.
+;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1997, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
+;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Keywords: holidays, calendar
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
;; the message BODY containing your mailing address (snail).
-;; Comments, corrections, and improvements should be sent to
-;; Edward M. Reingold Department of Computer Science
-;; (217) 333-6733 University of Illinois at Urbana-Champaign
-;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
-;; Urbana, Illinois 61801
-
;;; Code:
(defvar displayed-month)
(calendar-current-date)))
(displayed-month (extract-calendar-month date))
(displayed-year (extract-calendar-year date)))
- (list-calendar-holidays))))
+ (calendar-list-holidays))))
+;; rms: "Emacs commands to display a list of something generally start
+;; with `list-'. Please make `list-holidays' the principal name."
;;;###autoload
(defun list-holidays (y1 y2 &optional l label)
"Display holidays for years Y1 to Y2 (inclusive).
-The optional list of holidays L defaults to `calendar-holidays'. See the
-documentation for that variable for a description of holiday lists.
+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
(display-buffer holiday-buffer)
(message "Computing holidays...done"))))
+(defalias 'holiday-list 'list-holidays)
-(defun check-calendar-holidays (date)
+(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))
- (h (calendar-holiday-list))
- (holiday-list))
- (while h
- (if (calendar-date-equal date (car (car h)))
- (setq holiday-list (append holiday-list (cdr (car h)))))
- (setq h (cdr h)))
+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))
+ (if (calendar-date-equal date (car h))
+ (setq holiday-list (append holiday-list (cdr h)))))
holiday-list))
(defun calendar-cursor-holidays ()
(message "Checking holidays...")
(let* ((date (calendar-cursor-to-date t))
(date-string (calendar-date-string date))
- (holiday-list (check-calendar-holidays date))
+ (holiday-list (calendar-check-holidays date))
(holiday-string (mapconcat 'identity holiday-list "; "))
(msg (format "%s: %s" date-string holiday-string)))
(if (not holiday-list)
(display-buffer holiday-buffer)
(message "Checking holidays...done")))))
-(defun mark-calendar-holidays ()
+(defun calendar-mark-holidays ()
"Mark notable days in the calendar window."
(interactive)
(setq mark-holidays-in-calendar t)
(message "Marking holidays...")
- (let ((holiday-list (calendar-holiday-list)))
- (while holiday-list
- (mark-visible-calendar-date
- (car (car holiday-list)) calendar-holiday-marker)
- (setq holiday-list (cdr holiday-list))))
+ (dolist (holiday (calendar-holiday-list))
+ (mark-visible-calendar-date
+ (car holiday) calendar-holiday-marker))
(message "Marking holidays...done"))
-(defun list-calendar-holidays ()
+(defun calendar-list-holidays ()
"Create a buffer containing the holidays for the current calendar window.
-The holidays are those in the list calendar-notable-days. Returns t if any
+The holidays are those in the list `calendar-notable-days'. Returns t if any
holidays are found, nil if not."
(interactive)
(message "Looking up holidays...")
(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."
- (let ((p calendar-holidays)
- (holiday-list))
- (while p
+The holidays are those in the list `calendar-holidays'."
+ (let ((holiday-list ()))
+ (dolist (p calendar-holidays)
(let* ((holidays
(if calendar-debug-sexp
(let ((stack-trace-on-error t))
- (eval (car p)))
+ (eval p))
(condition-case nil
- (eval (car p))
+ (eval p)
(error (beep)
- (message "Bad holiday list item: %s" (car p))
+ (message "Bad holiday list item: %s" p)
(sleep-for 2))))))
(if holidays
- (setq holiday-list (append holidays holiday-list))))
- (setq p (cdr p)))
+ (setq holiday-list (append holidays holiday-list)))))
(setq holiday-list (sort holiday-list 'calendar-date-compare))))
;; Below are the functions that calculate the dates of holidays; these
(let ((m displayed-month)
(y displayed-year))
(increment-calendar-month m y -1)
- (filter-visible-calendar-holidays
- (append
+ (holiday-filter-visible-calendar
+ (list
(let* ((year y)
(date (eval sexp))
(string (if date (eval string))))
- (list (list date string)))
+ (list date string))
(let* ((year (1+ y))
(date (eval sexp))
(string (if date (eval string))))
- (list (list date string)))))))
+ (list date string))))))
(defun holiday-advent (&optional n string)
"Date of Nth day after advent (named STRING), if visible in calendar window.
(- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
adjusted-epact))
(abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7))))
- (filter-visible-calendar-holidays
+ (holiday-filter-visible-calendar
(list (list (calendar-gregorian-from-absolute (+ abs-easter n))
string))))))
(if (calendar-date-is-visible-p nicaean-easter)
(list (list nicaean-easter "Pascha (Greek Orthodox Easter)"))))))
-(defun filter-visible-calendar-holidays (l)
+(defun holiday-filter-visible-calendar (l)
"Return a list of all visible holidays of those on L."
- (let ((visible)
- (p l))
- (while p
- (and (car (car p))
- (calendar-date-is-visible-p (car (car p)))
- (setq visible (append (list (car p)) visible)))
- (setq p (cdr p)))
+ (let ((visible ()))
+ (dolist (p l)
+ (and (car p)
+ (calendar-date-is-visible-p (car p))
+ (push p visible)))
visible))
+;; Backward compatibility.
+(define-obsolete-function-alias
+ 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1")
+(define-obsolete-function-alias
+ 'list-calendar-holidays 'calendar-list-holidays "23.1")
+(define-obsolete-function-alias
+ 'mark-calendar-holidays 'calendar-mark-holidays "23.1")
+(define-obsolete-function-alias
+ 'check-calendar-holidays 'calendar-check-holidays "23.1")
+;;;###autoload
+(define-obsolete-function-alias 'list-holidays 'holiday-list "23.1")
+
(provide 'holidays)
-;;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37
+;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37
;;; holidays.el ends here
HCoop / bpt / emacs.git / blobdiff