comparison lisp/calendar/calendar.el @ 3865:2c6883d0a1b2

* calendar.el (calendar-version): Update to 5.1. Fixed a variety of spelling error in comments and doc strings. (calendar-sexp-debug): New variable to turn off error catching. (calendar-absolute-from-gregorian): Removed unused vars month, day. (view-calendar-holidays-initially, all-hebrew-calendar-holidays, all-christian-calendar-holidays, all-christian-islamic-holidays, diary-nonmarking-symbol, hebrew-diary-entry-symbol, islamic-diary-entry-symbol, diary-include-string, abbreviated-calendar-year, european-calendar-style, european-calendar-display-form, american-calendar-display-form, calendar-date-display-form, print-diary-entries-hook, list-diary-entries-hook, nongregorian-diary-listing-hook, nongregorian-diary-marking-hook, diary-list-include-blanks, holidays-in-diary-buffer, general-holidays, increment-calendar-month, calendar-sum, calendar-string-spread, calendar-absolute-from-iso, calendar-print-iso-date, hebrew-calendar-elapsed-days, list-yahrzeit-dates, calendar-print-astro-day-number): Fix doc strings. (calendar-nth-named-day): Rewritten to include optional day of month. (general-holidays, calendar-holidays, hebrew-holidays, christian-holidays, islamic-holidays, solar-holidays): Rewritten to include require of cal-dst.el and to show the time of the change to/from daylight savings time. (calendar-current-time-zone, calendar-time-zone, calendar-daylight-time-offset, calendar-standard-time-zone-name, calendar-daylight-time-zone-name, calendar-daylight-savings-starts, calendar-daylight-savings-ends, calendar-daylight-savings-switchover-time): Moved to cal-dst.el. (calendar-location-name, calendar-time-display-form, calendar-latitude, calendar-longitude): Moved to solar.el. (calendar-holidays): Unquote it!

3864:ee987f852b10

;; Keywords: calendar
;; Human-Keywords: calendar, Gregorian calendar, Julian calendar, 
;;	Hebrew calendar, Islamic calendar, ISO calendar, Julian day number,
;;	diary, holidays

(defconst calendar-version "Version 5, released August 10, 1992")

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor

;;       diary.el, diary-ins.el        Diary functions
;;       holidays.el                   Holiday functions
;;       cal-french.el                 French Revolutionary calendar
;;       cal-mayan.el                  Mayan calendars
;;       solar.el                      Sunrise/sunset, equinoxes/solstices
;;       lunar.el                      Phases of the moon
;;       appt.el                       Appointment notification

;; Comments, corrections, and improvements should be sent to

(defvar diary-entry-marker "+"
  "*The symbol used to mark dates that have diary entries.")

;;;###autoload
(defvar view-calendar-holidays-initially nil
  "*If t, the holidays for the current three month period will be displayed
on entry.  The holidays are displayed in another window when the calendar is
first displayed.")

;;;###autoload
(defvar mark-holidays-in-calendar nil
  "*If t, dates of holidays will be marked in the calendar window.
The marking symbol is specified by the variable `calendar-holiday-marker'.")

(defvar calendar-holiday-marker "*"
  "*The symbol used to mark notable dates in the calendar.")

;;;###autoload
(defvar all-hebrew-calendar-holidays nil
  "*If nil, the holidays from the Hebrew calendar that are shown will
include only those days of such major interest as to appear on secular
calendars.  If t, the holidays shown in the calendar will include all
special days that would be shown on a complete Hebrew calendar.")

;;;###autoload
(defvar all-christian-calendar-holidays nil
  "*If nil, the holidays from the Christian calendar that are shown will
include only those days of such major interest as to appear on secular
calendars.  If t, the holidays shown in the calendar will include all
special days that would be shown on a complete Christian calendar.")

;;;###autoload
(defvar all-islamic-calendar-holidays nil
  "*If nil, the holidays from the Islamic calendar that are shown will
include only those days of such major interest as to appear on secular
calendars.  If t, the holidays shown in the calendar will include all
special days that would be shown on a complete Islamic calendar.")

;;;###autoload
(defvar calendar-load-hook nil
  "*List of functions to be called after the calendar is first loaded.
This is the place to add key bindings to calendar-mode-map.")

Diary files can contain directives to include the contents of other files; for
details, see the documentation for the variable `list-diary-entries-hook'.")

;;;###autoload
(defvar diary-nonmarking-symbol "&"
  "*The symbol used to indicate that a diary entry is not to be marked in the
calendar window.")

;;;###autoload
(defvar hebrew-diary-entry-symbol "H"
  "*The symbol used to indicate that a diary entry is according to the
Hebrew calendar.")

;;;###autoload
(defvar islamic-diary-entry-symbol "I"
  "*The symbol used to indicate that a diary entry is according to the
Islamic calendar.")

;;;###autoload
(defvar diary-include-string "#include"
  "*The string used to indicate the inclusion of another file of diary entries
in diary-file.  See the documentation for the function
`include-other-diary-files'.")

;;;###autoload
(defvar sexp-diary-entry-symbol "%%"
  "*The string used to indicate a sexp diary entry in diary-file.
See the documentation for the function `list-sexp-diary-entries'.")

;;;###autoload
(defvar abbreviated-calendar-year t
  "*Interpret a two-digit year DD in a diary entry as being either 19DD or
20DD, as appropriate, for the Gregorian calendar; similarly for the Hebrew and
Islamic calendars.  If this variable is nil, years must be written in full.")

;;;###autoload
(defvar european-calendar-style nil
  "*Use the European style of dates in the diary and in any displays.  If this
variable is t, a date 1/2/1990 would be interpreted as February 1, 1990.
The accepted European date styles are

            DAY/MONTH
            DAY/MONTH/YEAR
            DAY MONTHNAME
            DAY MONTHNAME YEAR

a portion of the first word of the diary entry.")

;;;###autoload
(defvar european-calendar-display-form
  '((if dayname (concat dayname ", ")) day " " monthname " " year)
  "*The pseudo-pattern that governs the way a Gregorian date is formatted
in the European style.  See the documentation of calendar-date-display-forms
for an explanation.")

;;;###autoload
(defvar american-calendar-display-form
  '((if dayname (concat dayname ", ")) monthname " " day ", " year)
  "*The pseudo-pattern that governs the way a Gregorian date is formatted
in the American style.  See the documentation of calendar-date-display-forms
for an explanation.")

;;;###autoload
(defvar calendar-date-display-form
  (if european-calendar-style
      european-calendar-display-form
    american-calendar-display-form)
  "*The pseudo-pattern that governs the way a Gregorian date is formatted
as a string by the function `calendar-date-string'.  A pseudo-pattern is a
list of expressions that can involve the keywords `month', `day', and
`year', all numbers in string form, and `monthname' and `dayname', both
alphabetic strings.  For example, the ISO standard would use the pseudo-
pattern

       '(year \"-\" month \"-\" day)

while a typical American form would be

       '((format \"%9s, %9s %2s, %4s\" dayname monthname day year))

would give the usual American style in fixed-length fields.

See the documentation of the function `calendar-date-string'.")

;;;###autoload
(defvar calendar-time-display-form
  '(12-hours ":" minutes am-pm
    (if time-zone " (") time-zone (if time-zone ")"))
  "*The pseudo-pattern that governs the way a time of day is formatted.

A pseudo-pattern is a list of expressions that can involve the keywords
`12-hours', `24-hours', and `minutes',  all numbers in string form,
and `am-pm' and `time-zone',  both alphabetic strings.

For example, the form

  '(24-hours \":\" minutes
    (if time-zone \" (\") time-zone (if time-zone \")\"))

would give military-style times like `21:07 (UT)'.")

;;;###autoload
(defvar calendar-latitude nil
  "*Latitude of `calendar-location-name' in degrees, + north, - south.
For example, 40.7 for New York City.")

;;;###autoload
(defvar calendar-longitude nil
  "*Longitude of `calendar-location-name' in degrees, + east, - west.
For example, -74.0 for New York City.")

;;;###autoload
(defvar calendar-location-name
  '(let ((float-output-format "%.1f"))
     (format "%s%s, %s%s"
	     (abs calendar-latitude)
	     (if (> calendar-latitude 0) "N" "S")
	     (abs calendar-longitude)
	     (if (> calendar-longitude 0) "E" "W")))
  "*An expression that evaluates to the name of the location at
`calendar-longitude', calendar-latitude'.  Default value is just the latitude,
longitude pair.")

(defun calendar-current-time-zone ()
  "Return the UTC difference, dst offset, and names for the current time zone.

Returns a list of the form (UTC-DIFF DST-OFFSET STD-ZONE DST-ZONE), based on
a heuristic probing of what the system knows:

UTC-DIFF is an integer specifying the number of minutes difference between
    standard time in the current time zone and Coordinated Universal Time
    (Greenwich Mean Time).  A negative value means west of Greenwich.
DST-OFFSET is an integer giving the daylight savings time offset in minutes.
STD-ZONE is a string giving the name of the time zone when no seasonal time
    adjustment is in effect.
DST-ZONE is a string giving the name of the time zone when there is a seasonal
    time adjustment in effect.

If the local area does not use a seasonal time adjustment, OFFSET is 0, and
STD-ZONE and DST-ZONE are equal.

Some operating systems cannot provide all this information to Emacs; in this
case, `calendar-current-time-zone' returns a list containing nil for the data
it can't find."
  (let* ((now (current-time))
         (now-zone (current-time-zone now))
         (now-utc-diff (car now-zone))
         (now-name (car (cdr now-zone)))
         probe-zone
         (probe-utc-diff now-utc-diff)
         (i 1))
    ;; Heuristic: probe the time zone offset in the next three calendar
    ;; quarters, looking for a time zone offset different from now.
    ;; There about 120 * 2^16 seconds in a quarter year
    (while (and (< i 4) (eq now-utc-diff probe-utc-diff))
      (setq probe-zone (current-time-zone (list (+ (car now) (* i 120)) 0)))
      (setq probe-utc-diff (car probe-zone))
      (setq i (1+ i)))
    (if (or (eq now-utc-diff probe-utc-diff)
            (not now-utc-diff)
            (not probe-utc-diff))
        ;; No change found
        (list (and now-utc-diff (/ now-utc-diff 60)) 0 now-name now-name)
      ;; Found a different utc-diff
      (let ((utc-diff (min now-utc-diff probe-utc-diff))
            (probe-name (car (cdr probe-zone))))
        (list (/ utc-diff 60)
              (/ (abs (- now-utc-diff probe-utc-diff)) 60)
              (if (eq utc-diff now-utc-diff) now-name probe-name)
              (if (eq utc-diff now-utc-diff) probe-name now-name))))))

;;; The following six defvars relating to daylight savings time should NOT be
;;; marked to go into loaddefs.el where they would be evaluated when Emacs is
;;; dumped.  These variables' appropriate values really on the conditions under
;;; which the code is INVOKED; so it's inappropriate to initialize them when
;;; Emacs is dumped---they should be initialized when calendar.el is loaded.

(defvar calendar-time-zone (car (calendar-current-time-zone))
  "*Number of minutes difference between local standard time at
`calendar-location-name' and Coordinated Universal (Greenwich) Time.  For
example, -300 for New York City, -480 for Los Angeles.")

(defvar calendar-daylight-time-offset (car (cdr (calendar-current-time-zone)))
  "*A sexp in the variable `year' that gives the number of minutes difference
between daylight savings time and standard time.

Should be set to 0 if locale has no daylight savings time.")

(defvar calendar-standard-time-zone-name
  (car (nthcdr 2 (calendar-current-time-zone)))
  "*Abbreviated name of standard time zone at `calendar-location-name'.
For example, \"EST\" in New York City, \"PST\" for Los Angeles.")

(defvar calendar-daylight-time-zone-name
  (car (nthcdr 3 (calendar-current-time-zone)))
  "*Abbreviated name of daylight-savings time zone at `calendar-location-name'.
For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.")
  
(defvar calendar-daylight-savings-starts
  (if (not (eq calendar-daylight-time-offset 0))
      '(calendar-nth-named-day 1 0 4 year))
  "*A sexp in the variable `year' that gives the Gregorian date, in the form
of a list (month day year), on which daylight savings time starts.  This is
used to determine the starting date of daylight savings time for the holiday
list and for correcting times of day in the solar and lunar calculations.

For example, if daylight savings time is mandated to start on October 1,
you would set `calendar-daylight-savings-starts' to

      '(10 1 year)

For a more complex example, if daylight savings time begins on the first of
Nisan on the Hebrew calendar, we would set `calendar-daylight-savings-starts'
to

      '(calendar-gregorian-from-absolute
         (calendar-absolute-from-hebrew
            (list 1 1 (+ year 3760))))

because Nisan is the first month in the Hebrew calendar.

If the locale never uses daylight savings time, set this to nil.")

(defvar calendar-daylight-savings-ends
  (if (not (eq calendar-daylight-time-offset 0))
      '(calendar-nth-named-day -1 0 10 year))
  "*An expression in the variable `year' that gives the Gregorian date, in the
form of a list (month day year), on which daylight savings time ends.  This
is used to determine the ending date of daylight savings time for the holiday
list and for correcting times of day in the solar and lunar calculations.

The default value is the American rule of the last Sunday in October,

If the locale never uses daylight savings time, set this to nil.

See the documentation for `calendar-daylight-savings-starts' for other
examples.")

(defvar calendar-daylight-savings-switchover-time 120
  "*A sexp in the variable `year' that gives the number of minutes after
midnight that daylight savings time begins and ends.")

(defun european-calendar ()
  "Set the interpretation and display of dates to the European style."
  (interactive)
  (setq european-calendar-style t)

  (setq diary-date-forms american-date-diary-pattern)
  (update-calendar-mode-line))

;;;###autoload
(defvar print-diary-entries-hook 'lpr-buffer
  "*List of functions to be called after a temporary buffer is prepared with
the diary entries currently visible in the diary buffer.  The default just
does the printing.  Other uses might include, for example, rearranging the
lines into order by day and time, saving the buffer instead of deleting it, or
changing the function used to do the printing.")

;;;###autoload
(defvar list-diary-entries-hook nil
  "*List of functions to be called after the diary file is culled for
relevant entries. It is to be used for diary entries that are not found in
the diary file.

A function `include-other-diary-files' is provided for use as the value of
this hook.  This function enables you to use shared diary files together
with your own.  The files included are specified in the diary-file by lines
of the form

if that day is a holiday; if you want such days to be shown in the fancy
diary buffer, set the variable `diary-list-include-blanks' to t.")

;;;###autoload
(defvar nongregorian-diary-listing-hook nil
  "*List of functions to be called for the diary file and included files as
they are processed for listing diary entries.  You can use any or all of
`list-hebrew-diary-entries' and `list-islamic-diary-entries'.  The
documentation for these functions describes the style of such diary entries.")

;;;###autoload
(defvar mark-diary-entries-hook nil
  "*List of functions called after marking diary entries in the calendar.

part of the mark-diary-entries-hook, you will probably also want to use the
function `include-other-diary-files' as part of the list-diary-entries-hook.")

;;;###autoload
(defvar nongregorian-diary-marking-hook nil
  "*List of functions to be called as the diary file and included files are
processed for marking diary entries.  You can use either or both of
mark-hebrew-diary-entries and mark-islamic-diary-entries.  The documentation
for these functions describes the style of such diary entries.")

;;;###autoload
(defvar diary-list-include-blanks nil
  "*If nil, do not include days with no diary entry in the list of diary
entries.  Such days will then not be shown in the the fancy diary buffer,
even if they are holidays.")

;;;###autoload
(defvar holidays-in-diary-buffer t
  "*If t, the holidays will be indicated in the mode line of the diary buffer
(or in the fancy diary buffer next to the date).  This slows down the diary
functions somewhat; setting it to nil will make the diary display faster.")

(defvar calendar-mark-ring nil)

;;;###autoload
(defvar general-holidays
  '((fixed 1 1 "New Year's Day")
    (float 1 1 3 "Martin Luther King Day")
    (fixed 2 2 "Ground Hog Day")
    (fixed 2 14 "Valentine's Day")
    (float 2 1 3 "President's Day")
    (fixed 3 17 "St. Patrick's Day")
    (fixed 4 1 "April Fool's Day")
    (float 5 0 2 "Mother's Day")
    (float 5 1 -1 "Memorial Day")
    (fixed 6 14 "Flag Day")
    (float 6 0 3 "Father's Day")
    (fixed 7 4 "Independence Day")
    (float 9 1 1 "Labor Day")
    (float 10 1 2 "Columbus Day")
    (fixed 10 31 "Halloween")
    (fixed 11 11 "Veteran's Day")
    (float 11 4 4 "Thanksgiving"))
  "*General holidays.  Default value is for the United States.  See the
documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar local-holidays nil
  "*Local holidays.
See the documentation for `calendar-holidays' for details.")

  "*User defined holidays.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar hebrew-holidays
  '((rosh-hashanah-etc)
    (if all-hebrew-calendar-holidays
        (julian 11
                (let* ((m displayed-month)
                       (y displayed-year)
                       (year))
                  (increment-calendar-month m y -1)
                  (let ((year (extract-calendar-year
                               (calendar-julian-from-absolute
                                (calendar-absolute-from-gregorian
                                 (list m 1 y))))))
                    (if (zerop (% (1+ year) 4))
                        22
                      21))) "\"Tal Umatar\" (evening)"))
    (if all-hebrew-calendar-holidays
        (hanukkah)
      (hebrew 9 25 "Hanukkah"))
    (if all-hebrew-calendar-holidays
      (hebrew 10
              (let ((h-year (extract-calendar-year
                             (calendar-hebrew-from-absolute
                              (calendar-absolute-from-gregorian
                               (list displayed-month 28 displayed-year))))))
                (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year))
                        7)
                       6)
                    11 10))
              "Tzom Teveth"))
    (if all-hebrew-calendar-holidays
        (hebrew 11 15 "Tu B'Shevat"))
    (if all-hebrew-calendar-holidays
        (hebrew
         11
         (let ((m displayed-month)
               (y displayed-year))
           (increment-calendar-month m y 1)
           (let* ((h-year (extract-calendar-year

                       6 (calendar-absolute-from-hebrew
                          (list 11 16 h-year))))))
                  (day (extract-calendar-day s-s)))
             day))
         "Shabbat Shirah"))
    (passover-etc)
    (if (and all-hebrew-calendar-holidays
             (let* ((m displayed-month)
                    (y displayed-year)
                    (year))
               (increment-calendar-month m y -1)
               (let ((year (extract-calendar-year
                            (calendar-julian-from-absolute
                             (calendar-absolute-from-gregorian
                              (list m 1 y))))))
                 (= 21 (% year 28)))))
        (julian 3 26 "Kiddush HaHamah"))
    (if all-hebrew-calendar-holidays
        (tisha-b-av-etc)))
  "*Jewish holidays.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar christian-holidays
  '((if all-christian-calendar-holidays
        (fixed 1 6 "Epiphany"))
    (easter-etc)
    (if all-christian-calendar-holidays
        (greek-orthodox-easter))
    (if all-christian-calendar-holidays
        (fixed 8 15 "Assumption"))
    (if all-christian-calendar-holidays
        (advent))
    (fixed 12 25 "Christmas")
    (if all-christian-calendar-holidays
        (julian 12 25 "Eastern Orthodox Christmas")))
  "*Christian holidays.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar islamic-holidays
  '((islamic 1 1 (format "Islamic New Year %d"
                         (let ((m displayed-month)
                               (y displayed-year))
                           (increment-calendar-month m y 1)
                           (extract-calendar-year
                            (calendar-islamic-from-absolute
                             (calendar-absolute-from-gregorian
                              (list m (calendar-last-day-of-month m y) y)))))))
    (if all-islamic-calendar-holidays
        (islamic 1 10 "Ashura"))
    (if all-islamic-calendar-holidays
        (islamic 3 12 "Mulad-al-Nabi"))
    (if all-islamic-calendar-holidays
        (islamic 7 26 "Shab-e-Mi'raj"))
    (if all-islamic-calendar-holidays
        (islamic 8 15 "Shab-e-Bara't"))
    (islamic 9 1 "Ramadan Begins")
    (if all-islamic-calendar-holidays
        (islamic 9 27 "Shab-e Qadr"))
    (if all-islamic-calendar-holidays
        (islamic 10 1 "Id-al-Fitr"))
    (if all-islamic-calendar-holidays
        (islamic 12 10 "Id-al-Adha")))
  "*Islamic holidays.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar solar-holidays
  '((if (fboundp 'atan)
	(solar-equinoxes-solstices))
    (sexp (eval calendar-daylight-savings-starts)
          "Daylight Savings Time Begins")
    (sexp (eval calendar-daylight-savings-ends)
          "Daylight Savings Time Ends"))
  "*Sun-related holidays.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar calendar-holidays
  '(append general-holidays local-holidays other-holidays
           christian-holidays hebrew-holidays islamic-holidays
           solar-holidays)
  "*List of notable days for the command M-x holidays.

Additional holidays are easy to add to the list, just put them in the list
`other-holidays' in your .emacs file.  Similarly, by setting any of
`general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays',
`islamic-holidays', or `solar-holidays' to nil in your .emacs file, you can
eliminate unwanted categories of holidays.  The intention is that (in the US)
`local-holidays' be set in site-init.el and `other-holidays' be set by the
user.

The possible holiday-forms are as follows:

    (fixed MONTH DAY STRING)   a fixed date on the Gregorian calendar
    (float MONTH DAYNAME K STRING) the Kth DAYNAME in MONTH on the Gregorian
                               calendar (0 for Sunday, etc.); K<0 means
                               count back from the end of the month
    (hebrew MONTH DAY STRING)  a fixed date on the Hebrew calendar
    (islamic MONTH DAY STRING) a fixed date on the Islamic calendar
    (julian MONTH DAY STRING)  a fixed date on the Julian calendar
    (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
    (if BOOLEAN HOLIDAY-FORM &optional HOLIDAY-FORM) gives a choice between
                               two holidays based on the value of BOOLEAN
    (FUNCTION &optional ARGS)  dates requiring special computation; ARGS,
                               if any, are passed in a list to the function
                               `calendar-holiday-function-FUNCTION'

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

     (fixed 7 14 \"Bastille Day\")

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

     (float 8 1 4 \"Hurricane Supplication Day\")

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

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

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

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

since the Islamic months are numbered from 1 starting with Muharram.  To
add Thomas Jefferson's birthday, April 2, 1743 (Julian), use

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

To include a holiday conditionally, use the if or the sexp form.  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

     (sexp (if (zerop (% year 4))
               (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))
         (fixed 11
                (extract-calendar-day
                 (calendar-gregorian-from-absolute
                  (1+ (calendar-dayname-on-or-before
                       1 (+ 6 (calendar-absolute-from-gregorian
                               (list 11 1 displayed-year)))))))

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

     (lunar-phases)

to the holiday list, where `calendar-holiday-function-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\") ... )

The fixed, float, hebrew, islamic, julian, sexp, and if forms are implemented
by the inclusion of the functions `calendar-holiday-function-fixed',
`calendar-holiday-function-float', `calendar-holiday-function-hebrew',
`calendar-holiday-function-islamic', `calendar-holiday-function-julian',
`calendar-holiday-function-sexp', and `calendar-holiday-function-if',
respectively.")

(defconst calendar-buffer "*Calendar*"
  "Name of the buffer used for the calendar.")

(defconst holiday-buffer "*Holidays*"

(defconst fancy-diary-buffer "*Fancy Diary Entries*"
  "Name of the buffer used for the optional fancy display of the diary.")

(defmacro increment-calendar-month (mon yr n)
  "Move the variables MON and YR to the month and year N months forward
if N is positive or backward if N is negative."
  (` (let (( macro-y (+ (* (, yr) 12) (, mon) -1 (, n) )))
       (setq (, mon) (1+ (% macro-y 12) ))
       (setq (, yr) (/ macro-y 12)))))

(defmacro calendar-for-loop (var from init to final do &rest body)

  (` (let (( (, var) (1- (, init)) ))
       (while (>= (, final) (setq (, var) (1+ (, var))))
         (,@ body)))))

(defmacro calendar-sum (index initial condition expression)
  "For INDEX = INITIAL and successive integers, as long as CONDITION holds,
sum EXPRESSION."
  (` (let (( (, index) (, initial))
             (sum 0))
       (while (, condition)
         (setq sum (+ sum (, expression) ))
         (setq (, index) (1+ (, index))))

;;  "Extract the year part of DATE which has the form (month day year)."
;;  (car (cdr (cdr date))))

(defmacro calendar-leap-year-p (year)
  "Returns t if YEAR is a Gregorian leap year."
  (` (or
        (and (=  (% (, year) 4) 0)
             (/= (% (, year) 100) 0))
        (= (% (, year) 400) 0))))
;;(defun calendar-leap-year-p (year)
;;  "Returns t if YEAR is a Gregorian leap year."
;;  (or
;;    (and (=  (% year   4) 0)
;;         (/= (% year 100) 0))

;;      day-of-year))

(defmacro calendar-absolute-from-gregorian (date)
  "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
The Gregorian date Sunday, December 31, 1 BC is imaginary."
  (` (let ((month (, (macroexpand (` (extract-calendar-month (, date))))))
           (day (, (macroexpand (` (extract-calendar-day (, date))))))
           (year  (, (macroexpand (` (extract-calendar-year (, date)))))))
       (+ (, (macroexpand (` (calendar-day-number (, date)))));; Days this year
          (* 365 (1- year));;        + Days in prior years
          (/ (1- year) 4);;          + Julian leap years
          (- (/ (1- year) 100));;    - century years
          (/ (1- year) 400)))));;     + Gregorian leap years
;;(defun calendar-absolute-from-gregorian (date)
;;  "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
;;The Gregorian date Sunday, December 31, 1 BC is imaginary."
;;  (let ((month (extract-calendar-month date))
;;        (day (extract-calendar-day date))
;;        (year (extract-calendar-year date)))
;;    (+ (calendar-day-number date);; Days this year
;;       (* 365 (1- year));;        + Days in prior years
;;       (/ (1- year) 4);;          + Julian leap years
;;       (- (/ (1- year) 100));;    - century years
;;       (/ (1- year) 400))));;     + Gregorian leap years

(autoload 'insert-weekly-diary-entry "diary-ins"
  "Insert a weekly diary entry for the day of the week indicated by point."
  t)

(autoload 'insert-monthly-diary-entry "diary-ins"
  "Insert a monthly diary entry for the day of the month indicated by point."
  t)

(autoload 'insert-yearly-diary-entry "diary-ins"

  "Redraw the calendar display."
  (interactive)
  (let ((cursor-date (calendar-cursor-to-date)))
    (generate-calendar-window displayed-month displayed-year)
    (calendar-cursor-to-visible-date cursor-date)))

(defvar calendar-mode-map nil)
(if calendar-mode-map
    nil
  (setq calendar-mode-map (make-sparse-keymap))

  (make-local-variable 'calendar-mark-ring)
  (make-local-variable 'displayed-month);;  Month in middle of window.
  (make-local-variable 'displayed-year));;  Year in middle of window.

(defun calendar-string-spread (strings char length)
  "A list of STRINGS is concatenated separated by copies of CHAR so that it
fills LENGTH; there must be at least 2 strings.  The effect is like mapconcat
but the separating pieces are as balanced as possible.  Each item of STRINGS
is evaluated before concatenation so it can actually be an expression that
evaluates to a string.  If LENGTH is too short, the STRINGS are just
concatenated and the result truncated."
;; The algorithm is based on equation (3.25) on page 85 of Concrete
;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
;; Addison-Wesley, Reading, MA, 1989

               (calendar-date-is-visible-p dec-31))
          (calendar-cursor-to-visible-date dec-31)
        (calendar-other-month 12 (- year (1- arg)))
        (calendar-cursor-to-visible-date (list 12 31 displayed-year))))))

(defun calendar-gregorian-from-absolute (date)
  "Compute the list (month day year) corresponding to the absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
  (let* ((approx (/ date 366));; Approximation from below.
         (year                ;; Search forward from the approximation.
          (+ approx
             (calendar-sum y approx
                 (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y))))
                  1)))
         (month         ;; Search forward from January.
          (1+ (calendar-sum m 1
                   (> date
                      (calendar-absolute-from-gregorian
                       (list m (calendar-last-day-of-month m year) year)))
                   1)))
         (day           ;; Calculate the day by subtraction.
          (- date
             (1- (calendar-absolute-from-gregorian (list month 1 year))))))
    (list month day year)))

(defun calendar-cursor-to-visible-date (date)
  "Move the cursor to DATE that is on the screen."
    (let ((month (extract-calendar-month date))
          (day (extract-calendar-day date))

absolute day d.  Similarly, applying it to d+3 gives the DAYNAME nearest to
absolute date d, applying it to d-1 gives the DAYNAME previous to absolute
date d, and applying it to d+7 gives the DAYNAME following absolute date d."
  (- date (% (- date dayname) 7)))

(defun calendar-nth-named-day (n dayname month year)
  "Returns the date of the  Nth DAYNAME in MONTH, YEAR.
A DAYNAME of 0 means Sunday, 1 means Monday, and so on.  If N<0, the
date returned is the Nth DAYNAME from the end of MONTH, YEAR (that is, -1 is
the last DAYNAME, -2 is the penultimate DAYNAME, and so on."
  (calendar-gregorian-from-absolute
   (if (> n 0)
       (+ (calendar-dayname-on-or-before
           dayname (calendar-absolute-from-gregorian (list month 7 year)))
          (* 7 (1- n)))
     (+ (calendar-dayname-on-or-before
         dayname
         (calendar-absolute-from-gregorian
          (list month (calendar-last-day-of-month month year) year)))
        (* 7 (1+ n))))))

(defun calendar-print-day-of-year ()
  "Show the day number in the year and the number of days remaining in the
year for the date under the cursor."
  (interactive)

         (days-remaining (- (calendar-day-number (list 12 31 year)) day)))
    (message "Day %d of %d; %d day%s remaining in the year"
             day year days-remaining (if (= days-remaining 1) "" "s"))))

(defun calendar-absolute-from-iso (date)
  "The number of days elapsed between the Gregorian date 12/31/1 BC and
DATE.  The `ISO year' corresponds approximately to the Gregorian year, but
weeks start on Monday and end on Sunday.  The first week of the ISO year is
the first such week in which at least 4 days are in a year.  The ISO
commercial DATE has the form (week day year) in which week is in the range
1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 =
Sunday).  The The Gregorian date Sunday, December 31, 1 BC is imaginary."

     (1+ (/ (- date (calendar-absolute-from-iso (list 1 1 year))) 7))
     (% date 7)
     year)))

(defun calendar-print-iso-date ()
  "Show the equivalent date on the `ISO commercial calendar' for the date
under the cursor."
  (interactive)
  (let* ((greg-date
          (or (calendar-cursor-to-date)
              (error "Cursor is not on a date!")))
         (day (% (calendar-absolute-from-gregorian greg-date) 7))

          (and (= month 9) (hebrew-calendar-short-kislev-p year)))
      29
    30))

(defun hebrew-calendar-elapsed-days (year)
  "Number of days elapsed from the Sunday prior to the start of the Hebrew
calendar to the mean conjunction of Tishri of Hebrew YEAR."
  (let* ((months-elapsed
          (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far.
             (* 12 (% (1- year) 19))      ;; Regular months in this cycle
             (/ (1+ (* 7 (% (1- year) 19))) 19)));; Leap months this cycle
         (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))

  (setq mode-line-format
        (calendar-string-spread (list "" str "") ?- (frame-width))))

;;;###autoload
(defun list-yahrzeit-dates (death-date start-year end-year)
  "List of Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to
END-YEAR.  When called interactively from the calendar window,
the date of death is taken from the cursor position."
  (interactive
   (let* ((death-date
           (if (equal (current-buffer) (get-buffer calendar-buffer))
               (calendar-cursor-to-date)
             (let* ((today (calendar-current-date))

    (setq buffer-read-only t)
    (display-buffer yahrzeit-buffer)
    (message "Computing yahrzeits...done")))

(defun calendar-print-astro-day-number ()
  "Show the astronomical (Julian) day number of afternoon on date
shown by cursor."
  (interactive)
  (message
   "Astronomical (Julian) day number after noon UTC: %d"
   (+ 1721425
      (calendar-absolute-from-gregorian

3865:2c6883d0a1b2

;; Keywords: calendar
;; Human-Keywords: calendar, Gregorian calendar, Julian calendar, 
;;	Hebrew calendar, Islamic calendar, ISO calendar, Julian day number,
;;	diary, holidays

(defconst calendar-version "Version 5.1, released June 18, 1993")

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor

;;       diary.el, diary-ins.el        Diary functions
;;       holidays.el                   Holiday functions
;;       cal-french.el                 French Revolutionary calendar
;;       cal-mayan.el                  Mayan calendars
;;       cal-dst.el                    Daylight savings time rules
;;       solar.el                      Sunrise/sunset, equinoxes/solstices
;;       lunar.el                      Phases of the moon
;;       appt.el                       Appointment notification

;; Comments, corrections, and improvements should be sent to

(defvar diary-entry-marker "+"
  "*The symbol used to mark dates that have diary entries.")

;;;###autoload
(defvar view-calendar-holidays-initially nil
  "*If t, holidays for current three month period will be displayed on entry.
The holidays are displayed in another window when the calendar is first
displayed.")

;;;###autoload
(defvar mark-holidays-in-calendar nil
  "*If t, dates of holidays will be marked in the calendar window.
The marking symbol is specified by the variable `calendar-holiday-marker'.")

(defvar calendar-holiday-marker "*"
  "*The symbol used to mark notable dates in the calendar.")

;;;###autoload
(defvar all-hebrew-calendar-holidays nil
  "*If nil, show only major holidays from the Hebrew calendar.

If nil, the only holidays from the Hebrew calendar shown will be those days of
such major interest as to appear on secular calendars.

If t, the holidays shown in the calendar will include all special days that
would be shown on a complete Hebrew calendar.")

;;;###autoload
(defvar all-christian-calendar-holidays nil
  "*If nil, show only major holidays from the Christian calendar.

If nil, the only holidays from the Christian calendar shown will be those days
of such major interest as to appear on secular calendars.

If t, the holidays shown in the calendar will include all special days that
would be shown on a complete Christian calendar.")

;;;###autoload
(defvar all-islamic-calendar-holidays nil
  "*If nil, show only major holidays from the Islamic calendar.

If nil, the only holidays from the Islamic calendar shown will be those days
of such major interest as to appear on secular calendars.

If t, the holidays shown in the calendar will include all special days that
would be shown on a complete Islamic calendar.")

;;;###autoload
(defvar calendar-load-hook nil
  "*List of functions to be called after the calendar is first loaded.
This is the place to add key bindings to calendar-mode-map.")

Diary files can contain directives to include the contents of other files; for
details, see the documentation for the variable `list-diary-entries-hook'.")

;;;###autoload
(defvar diary-nonmarking-symbol "&"
  "*Symbol indicating that a diary entry is not to be marked in the calendar.")

;;;###autoload
(defvar hebrew-diary-entry-symbol "H"
  "*Symbol indicating a diary entry according to the Hebrew calendar.")

;;;###autoload
(defvar islamic-diary-entry-symbol "I"
  "*Symbol indicating a diary entry according to the Islamic calendar.")

;;;###autoload
(defvar diary-include-string "#include"
  "*The string indicating inclusion of another file of diary entries.
See the documentation for the function `include-other-diary-files'.")

;;;###autoload
(defvar sexp-diary-entry-symbol "%%"
  "*The string used to indicate a sexp diary entry in diary-file.
See the documentation for the function `list-sexp-diary-entries'.")

;;;###autoload
(defvar abbreviated-calendar-year t
  "*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
For the Gregorian calendar; similarly for the Hebrew and Islamic calendars.
If this variable is nil, years must be written in full.")

;;;###autoload
(defvar european-calendar-style nil
  "*Use the European style of dates in the diary and in any displays.
If this variable is t, a date 1/2/1990 would be interpreted as February 1,
1990.  The accepted European date styles are

            DAY/MONTH
            DAY/MONTH/YEAR
            DAY MONTHNAME
            DAY MONTHNAME YEAR

a portion of the first word of the diary entry.")

;;;###autoload
(defvar european-calendar-display-form
  '((if dayname (concat dayname ", ")) day " " monthname " " year)
  "*Pseudo-pattern governing the way a date appears in the European style.
See the documentation of calendar-date-display-forms for an explanation.")

;;;###autoload
(defvar american-calendar-display-form
  '((if dayname (concat dayname ", ")) monthname " " day ", " year)
  "*Pseudo-pattern governing the way a date appears in the American style.
See the documentation of calendar-date-display-forms for an explanation.")

;;;###autoload
(defvar calendar-date-display-form
  (if european-calendar-style
      european-calendar-display-form
    american-calendar-display-form)
  "*Pseudo-pattern governing the way a date appears.

Used by the function `calendar-date-string', a pseudo-pattern is a list of
expressions that can involve the keywords `month', `day', and `year', all
numbers in string form, and `monthname' and `dayname', both alphabetic
strings.  For example, the ISO standard would use the pseudo- pattern

       '(year \"-\" month \"-\" day)

while a typical American form would be

       '((format \"%9s, %9s %2s, %4s\" dayname monthname day year))

would give the usual American style in fixed-length fields.

See the documentation of the function `calendar-date-string'.")

(defun european-calendar ()
  "Set the interpretation and display of dates to the European style."
  (interactive)
  (setq european-calendar-style t)

  (setq diary-date-forms american-date-diary-pattern)
  (update-calendar-mode-line))

;;;###autoload
(defvar print-diary-entries-hook 'lpr-buffer
  "*List of functions called after a temporary diary buffer is prepared.
The buffer shows only the diary entries currently visible in the diary
buffer.  The default just does the printing.  Other uses might include, for
example, rearranging the lines into order by day and time, saving the buffer
instead of deleting it, or changing the function used to do the printing.")

;;;###autoload
(defvar list-diary-entries-hook nil
  "*List of functions called after diary file is culled for relevant entries.
It is to be used for diary entries that are not found in the diary file.

A function `include-other-diary-files' is provided for use as the value of
this hook.  This function enables you to use shared diary files together
with your own.  The files included are specified in the diary-file by lines
of the form

if that day is a holiday; if you want such days to be shown in the fancy
diary buffer, set the variable `diary-list-include-blanks' to t.")

;;;###autoload
(defvar nongregorian-diary-listing-hook nil
  "*List of functions called for listing diary file and included files.
As the files are processed for diary entries, these functions are used to cull
relevant entries.  You can use either or both of `list-hebrew-diary-entries'
and `list-islamic-diary-entries'.  The documentation for these functions
describes the style of such diary entries.")

;;;###autoload
(defvar mark-diary-entries-hook nil
  "*List of functions called after marking diary entries in the calendar.

part of the mark-diary-entries-hook, you will probably also want to use the
function `include-other-diary-files' as part of the list-diary-entries-hook.")

;;;###autoload
(defvar nongregorian-diary-marking-hook nil
  "*List of functions called for marking diary file and included files.
As the files are processed for diary entries, these functions are used to cull
relevant entries.  You can use either or both of `mark-hebrew-diary-entries'
and `mark-islamic-diary-entries'.  The documentation for these functions
describes the style of such diary entries.")

;;;###autoload
(defvar diary-list-include-blanks nil
  "*If nil, do not include days with no diary entry in the list of diary entries.
Such days will then not be shown in the the fancy diary buffer, even if they
are holidays.")

;;;###autoload
(defvar holidays-in-diary-buffer t
  "*If t, the holidays will be indicated in the diary display.
The holidays will be given in the mode line of the diary buffer, or in the
fancy diary buffer next to the date.  This slows down the diary functions
somewhat; setting it to nil will make the diary display faster.")

(defvar calendar-mark-ring nil)

;;;###autoload
(defvar general-holidays
  '((holiday-fixed 1 1 "New Year's Day")
    (holiday-float 1 1 3 "Martin Luther King Day")
    (holiday-fixed 2 2 "Ground Hog 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 Fool's 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")
    (holiday-float 11 4 4 "Thanksgiving"))
  "*General holidays.  Default value is for the United States.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar local-holidays nil
  "*Local holidays.
See the documentation for `calendar-holidays' for details.")

  "*User defined holidays.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar hebrew-holidays
  '((holiday-rosh-hashanah-etc)
    (if all-hebrew-calendar-holidays
        (holiday-julian
         11
         (let* ((m displayed-month)
                (y displayed-year)
                (year))
           (increment-calendar-month m y -1)
           (let ((year (extract-calendar-year
                        (calendar-julian-from-absolute
                         (calendar-absolute-from-gregorian
                          (list m 1 y))))))
             (if (zerop (% (1+ year) 4))
                 22
               21))) "\"Tal Umatar\" (evening)"))
    (if all-hebrew-calendar-holidays
        (holiday-hanukkah)
      (holiday-hebrew 9 25 "Hanukkah"))
    (if all-hebrew-calendar-holidays
      (holiday-hebrew
       10
       (let ((h-year (extract-calendar-year
                      (calendar-hebrew-from-absolute
                       (calendar-absolute-from-gregorian
                        (list displayed-month 28 displayed-year))))))
         (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year))
                   7)
                6)
             11 10))
       "Tzom Teveth"))
    (if all-hebrew-calendar-holidays
        (holiday-hebrew 11 15 "Tu B'Shevat"))
    (if all-hebrew-calendar-holidays
        (holiday-hebrew
         11
         (let ((m displayed-month)
               (y displayed-year))
           (increment-calendar-month m y 1)
           (let* ((h-year (extract-calendar-year

                       6 (calendar-absolute-from-hebrew
                          (list 11 16 h-year))))))
                  (day (extract-calendar-day s-s)))
             day))
         "Shabbat Shirah"))
    (holiday-passover-etc)
    (if (and all-hebrew-calendar-holidays
             (let* ((m displayed-month)
                    (y displayed-year)
                    (year))
               (increment-calendar-month m y -1)
               (let ((year (extract-calendar-year
                            (calendar-julian-from-absolute
                             (calendar-absolute-from-gregorian
                              (list m 1 y))))))
                 (= 21 (% year 28)))))
        (holiday-julian 3 26 "Kiddush HaHamah"))
    (if all-hebrew-calendar-holidays
        (holiday-tisha-b-av-etc)))
  "*Jewish holidays.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar christian-holidays
  '((if all-christian-calendar-holidays
        (holiday-fixed 1 6 "Epiphany"))
    (holiday-easter-etc)
    (if all-christian-calendar-holidays
        (holiday-greek-orthodox-easter))
    (if all-christian-calendar-holidays
        (holiday-fixed 8 15 "Assumption"))
    (if all-christian-calendar-holidays
        (holiday-advent))
    (holiday-fixed 12 25 "Christmas")
    (if all-christian-calendar-holidays
        (holiday-julian 12 25 "Eastern Orthodox Christmas")))
  "*Christian holidays.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar islamic-holidays
  '((holiday-islamic
     1 1
     (format "Islamic New Year %d"
             (let ((m displayed-month)
                   (y displayed-year))
               (increment-calendar-month m y 1)
               (extract-calendar-year
                (calendar-islamic-from-absolute
                 (calendar-absolute-from-gregorian
                  (list
                   m (calendar-last-day-of-month m y) y)))))))
    (if all-islamic-calendar-holidays
        (holiday-islamic 1 10 "Ashura"))
    (if all-islamic-calendar-holidays
        (holiday-islamic 3 12 "Mulad-al-Nabi"))
    (if all-islamic-calendar-holidays
        (holiday-islamic 7 26 "Shab-e-Mi'raj"))
    (if all-islamic-calendar-holidays
        (holiday-islamic 8 15 "Shab-e-Bara't"))
    (holiday-islamic 9 1 "Ramadan Begins")
    (if all-islamic-calendar-holidays
        (holiday-islamic 9 27 "Shab-e Qadr"))
    (if all-islamic-calendar-holidays
        (holiday-islamic 10 1 "Id-al-Fitr"))
    (if all-islamic-calendar-holidays
        (holiday-islamic 12 10 "Id-al-Adha")))
  "*Islamic holidays.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar solar-holidays
  '((if (fboundp 'atan)
	(solar-equinoxes-solstices))
    (progn
      (require 'cal-dst)
      (funcall
       'holiday-sexp 
        calendar-daylight-savings-starts
        '(format "Daylight Savings Time Begins %s"
                  (if (fboundp 'atan)
                      (solar-time-string
                       (/ calendar-daylight-savings-switchover-time
                          (float 60))
                       date
                       'standard)
                    ""))))
    (funcall
     'holiday-sexp
     calendar-daylight-savings-ends
     '(format "Daylight Savings Time Ends %s"
              (if (fboundp 'atan)
                  (solar-time-string
                   (/ (- calendar-daylight-savings-switchover-time
                         calendar-daylight-time-offset)
                      (float 60))
                   date
                   'daylight)
                ""))))
  "*Sun-related holidays.
See the documentation for `calendar-holidays' for details.")

;;;###autoload
(defvar calendar-holidays
  (append general-holidays local-holidays other-holidays
          christian-holidays hebrew-holidays islamic-holidays
          solar-holidays)
  "*List of notable days for the command M-x holidays.

Additional holidays are easy to add to the list, just put them in the list
`other-holidays' in your .emacs file.  Similarly, by setting any of
`general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays',
`islamic-holidays', or `solar-holidays' to nil in your .emacs file, you can
eliminate unwanted categories of holidays.  The intention is that (in the US)
`local-holidays' be set in site-init.el and `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 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
    (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-hebrew MONTH DAY STRING)  a fixed date on the Hebrew calendar
    (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
    (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
Islands on the fourth Monday in August, add

     (holiday-float 8 1 4 \"Hurricane Supplication Day\")

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, while 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.  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
       (if (zerop (% year 4))
           (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
                (extract-calendar-day
                 (calendar-gregorian-from-absolute
                  (1+ (calendar-dayname-on-or-before
                       1 (+ 6 (calendar-absolute-from-gregorian
                               (list 11 1 displayed-year)))))))

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\") ... ).")

(defconst calendar-buffer "*Calendar*"
  "Name of the buffer used for the calendar.")

(defconst holiday-buffer "*Holidays*"

(defconst fancy-diary-buffer "*Fancy Diary Entries*"
  "Name of the buffer used for the optional fancy display of the diary.")

(defmacro increment-calendar-month (mon yr n)
  "Move the variables MON and YR to the month and year by N months.
Forward if N is positive or backward if N is negative."
  (` (let (( macro-y (+ (* (, yr) 12) (, mon) -1 (, n) )))
       (setq (, mon) (1+ (% macro-y 12) ))
       (setq (, yr) (/ macro-y 12)))))

(defmacro calendar-for-loop (var from init to final do &rest body)

  (` (let (( (, var) (1- (, init)) ))
       (while (>= (, final) (setq (, var) (1+ (, var))))
         (,@ body)))))

(defmacro calendar-sum (index initial condition expression)
  "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
  (` (let (( (, index) (, initial))
             (sum 0))
       (while (, condition)
         (setq sum (+ sum (, expression) ))
         (setq (, index) (1+ (, index))))

;;  "Extract the year part of DATE which has the form (month day year)."
;;  (car (cdr (cdr date))))

(defmacro calendar-leap-year-p (year)
  "Returns t if YEAR is a Gregorian leap year."
  (` (and
	(zerop (% (, year) 4))
	(or (not (zerop (% (, year) 100)))
	    (zerop (% (, year) 400))))))
;;(defun calendar-leap-year-p (year)
;;  "Returns t if YEAR is a Gregorian leap year."
;;  (and
;;    (zerop (% year 4))
;;    (or ((not (zerop (% year 100))))
;;	  (zerop (% year 400)))))
;;
;; The foregoing is a bit faster, but not as clear as the following:
;;
;;(defmacro calendar-leap-year-p (year)
;;  "Returns t if YEAR is a Gregorian leap year."
;;  (` (or
;;        (and (=  (% (, year) 4) 0)
;;             (/= (% (, year) 100) 0))
;;        (= (% (, year) 400) 0))))
;;(defun calendar-leap-year-p (year)
;;  "Returns t if YEAR is a Gregorian leap year."
;;  (or
;;    (and (=  (% year   4) 0)
;;         (/= (% year 100) 0))

;;      day-of-year))

(defmacro calendar-absolute-from-gregorian (date)
  "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
The Gregorian date Sunday, December 31, 1 BC is imaginary."
  (` (let ((year  (, (macroexpand (` (extract-calendar-year (, date)))))))
       (+ (, (macroexpand (` (calendar-day-number (, date)))));; Days this year
          (* 365 (1- year));;        + Days in prior years
          (/ (1- year) 4);;          + Julian leap years
          (- (/ (1- year) 100));;    - century years
          (/ (1- year) 400)))));;     + Gregorian leap years
;;(defun calendar-absolute-from-gregorian (date)
;;  "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
;;The Gregorian date Sunday, December 31, 1 BC is imaginary."
;;  (let ((year (extract-calendar-year date)))
;;    (+ (calendar-day-number date);; Days this year
;;       (* 365 (1- year));;        + Days in prior years
;;       (/ (1- year) 4);;          + Julian leap years
;;       (- (/ (1- year) 100));;    - century years
;;       (/ (1- year) 400))));;     + Gregorian leap years

(autoload 'insert-weekly-diary-entry "diary-ins"
  "Insert a weekly diary entry for the day of the week indicated by point."
  t)


(autoload 'insert-monthly-diary-entry "diary-ins"
  "Insert a monthly diary entry for the day of the month indicated by point."
  t)

(autoload 'insert-yearly-diary-entry "diary-ins"

  "Redraw the calendar display."
  (interactive)
  (let ((cursor-date (calendar-cursor-to-date)))
    (generate-calendar-window displayed-month displayed-year)
    (calendar-cursor-to-visible-date cursor-date)))

(defvar calendar-debug-sexp nil
  "*Turn debugging on when evaluating a sexp in the diary or holiday list.")

(defvar calendar-mode-map nil)
(if calendar-mode-map
    nil
  (setq calendar-mode-map (make-sparse-keymap))

  (make-local-variable 'calendar-mark-ring)
  (make-local-variable 'displayed-month);;  Month in middle of window.
  (make-local-variable 'displayed-year));;  Year in middle of window.

(defun calendar-string-spread (strings char length)
  "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH
There must be at least 2 strings.  The effect is like mapconcat but the
separating pieces are as balanced as possible.  Each item of STRINGS is
evaluated before concatenation so it can actually be an expression that
evaluates to a string.  If LENGTH is too short, the STRINGS are just
concatenated and the result truncated."
;; The algorithm is based on equation (3.25) on page 85 of Concrete
;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
;; Addison-Wesley, Reading, MA, 1989

               (calendar-date-is-visible-p dec-31))
          (calendar-cursor-to-visible-date dec-31)
        (calendar-other-month 12 (- year (1- arg)))
        (calendar-cursor-to-visible-date (list 12 31 displayed-year))))))

;; The following version of calendar-gregorian-from-absolute is preferred for
;; reasons of clarity, BUT it's much slower than the version that follows it.

;;(defun calendar-gregorian-from-absolute (date)
;;  "Compute the list (month day year) corresponding to the absolute DATE.
;;The absolute date is the number of days elapsed since the (imaginary)
;;Gregorian date Sunday, December 31, 1 BC."
;;  (let* ((approx (/ date 366));; Approximation from below.
;;         (year                ;; Search forward from the approximation.
;;          (+ approx
;;             (calendar-sum y approx
;;                 (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y))))
;;                  1)))
;;         (month         ;; Search forward from January.
;;          (1+ (calendar-sum m 1
;;                   (> date
;;                      (calendar-absolute-from-gregorian
;;                       (list m (calendar-last-day-of-month m year) year)))
;;                   1)))
;;         (day           ;; Calculate the day by subtraction.
;;          (- date
;;             (1- (calendar-absolute-from-gregorian (list month 1 year))))))
;;    (list month day year)))

(defun calendar-gregorian-from-absolute (date)
  "Compute the list (month day year) corresponding to the absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
;; Three Historical Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M.
;; Clamen, Software--Practice and Experience, Volume 23, Number 4
;; (April, 1993), pages 383-404 for an explanation.
  (let* ((d0 (1- date))
         (n400 (/ d0 146097))
         (d1 (% d0 146097))
         (n100 (/ d1 36524))
         (d2 (% d1 36524))
         (n4 (/ d2 1461))
         (d3 (% d2 1461))
         (n1 (/ d3 365))
         (day (1+ (% d3 365)))
         (year (+ (* 400 n400) (* 100 n100) (* n4 4) n1)))
    (if (or (= n100 4) (= n1 4))
        (list 12 31 year)
      (let ((year (1+ year))
            (month 1))
        (while (let ((mdays (calendar-last-day-of-month month year)))
                 (and (< mdays day)
                      (setq day (- day mdays))))
          (setq month (1+ month)))
        (list month day year)))))

(defun calendar-cursor-to-visible-date (date)
  "Move the cursor to DATE that is on the screen."
    (let ((month (extract-calendar-month date))
          (day (extract-calendar-day date))

absolute day d.  Similarly, applying it to d+3 gives the DAYNAME nearest to
absolute date d, applying it to d-1 gives the DAYNAME previous to absolute
date d, and applying it to d+7 gives the DAYNAME following absolute date d."
  (- date (% (- date dayname) 7)))

(defun calendar-nth-named-day (n dayname month year &optional day)
  "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
A DAYNAME of 0 means Sunday, 1 means Monday, and so on.  If N<0,
return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).

If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
  (calendar-gregorian-from-absolute
   (if (> n 0)
       (+ (* 7 (1- n))
	  (calendar-dayname-on-or-before
	   dayname
	   (+ 6 (calendar-absolute-from-gregorian
		 (list month (or day 1) year)))))
     (+ (* 7 (1+ n))
	(calendar-dayname-on-or-before
	 dayname
	 (calendar-absolute-from-gregorian
	  (list month
                (or day (calendar-last-day-of-month month year))
                year)))))))

(defun calendar-print-day-of-year ()
  "Show the day number in the year and the number of days remaining in the
year for the date under the cursor."
  (interactive)

         (days-remaining (- (calendar-day-number (list 12 31 year)) day)))
    (message "Day %d of %d; %d day%s remaining in the year"
             day year days-remaining (if (= days-remaining 1) "" "s"))))

(defun calendar-absolute-from-iso (date)
  "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
The `ISO year' corresponds approximately to the Gregorian year, but
weeks start on Monday and end on Sunday.  The first week of the ISO year is
the first such week in which at least 4 days are in a year.  The ISO
commercial DATE has the form (week day year) in which week is in the range
1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 =
Sunday).  The The Gregorian date Sunday, December 31, 1 BC is imaginary."

     (1+ (/ (- date (calendar-absolute-from-iso (list 1 1 year))) 7))
     (% date 7)
     year)))

(defun calendar-print-iso-date ()
  "Show equivalent ISO date for the date under the cursor."
  (interactive)
  (let* ((greg-date
          (or (calendar-cursor-to-date)
              (error "Cursor is not on a date!")))
         (day (% (calendar-absolute-from-gregorian greg-date) 7))

          (and (= month 9) (hebrew-calendar-short-kislev-p year)))
      29
    30))

(defun hebrew-calendar-elapsed-days (year)
  "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
  (let* ((months-elapsed
          (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far.
             (* 12 (% (1- year) 19))      ;; Regular months in this cycle
             (/ (1+ (* 7 (% (1- year) 19))) 19)));; Leap months this cycle
         (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))

  (setq mode-line-format
        (calendar-string-spread (list "" str "") ?- (frame-width))))

;;;###autoload
(defun list-yahrzeit-dates (death-date start-year end-year)
  "List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR.
When called interactively from the calendar window, the date of death is taken
from the cursor position."
  (interactive
   (let* ((death-date
           (if (equal (current-buffer) (get-buffer calendar-buffer))
               (calendar-cursor-to-date)
             (let* ((today (calendar-current-date))

    (setq buffer-read-only t)
    (display-buffer yahrzeit-buffer)
    (message "Computing yahrzeits...done")))

(defun calendar-print-astro-day-number ()
  "Show astronomical (Julian) day number of afternoon on date shown by cursor."
  (interactive)
  (message
   "Astronomical (Julian) day number after noon UTC: %d"
   (+ 1721425
      (calendar-absolute-from-gregorian