;; Hebrew calendar, Islamic calendar, ISO calendar, Julian day number,
;; diary, holidays
-(defconst calendar-version "Version 5, released August 10, 1992")
+(defconst calendar-version "Version 5.1, released June 18, 1993")
;; This file is part of GNU Emacs.
;; calendar, to the Islamic calendar, to the French Revolutionary calendar,
;; to the Mayan calendar, and to the astronomical (Julian) day number.
;; When floating point is available, times of sunrise/sunset can be displayed,
-;; as can the phases of the moon. Appointment notication for diary entries
+;; as can the phases of the moon. Appointment notification for diary entries
;; is available.
;; The following files are part of the calendar/diary code:
;; 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
;;;###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.")
+ "*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
;;;###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.")
+ "*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, 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.")
+ "*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, 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.")
+ "*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
;;;###autoload
(defvar diary-nonmarking-symbol "&"
- "*The symbol used to indicate that a diary entry is not to be marked in the
-calendar window.")
+ "*Symbol indicating that a diary entry is not to be marked in the calendar.")
;;;###autoload
(defvar hebrew-diary-entry-symbol "H"
- "*The symbol used to indicate that a diary entry is according to the
-Hebrew calendar.")
+ "*Symbol indicating a diary entry 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.")
+ "*Symbol indicating a diary entry 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'.")
+ "*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 "%%"
;;;###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.")
+ "*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
+ "*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
(monthname " *" day ", *" year "[^0-9]")
(dayname "\\W"))
"*List of pseudo-patterns describing the American patterns of date used.
-See the documentation of diary-date-forms for an explanantion.")
+See the documentation of diary-date-forms for an explanation.")
;;;###autoload
(defvar european-date-diary-pattern
(day " *" monthname " *" year "[^0-9]")
(dayname "\\W"))
"*List of pseudo-patterns describing the European patterns of date used.
-See the documentation of diary-date-forms for an explanantion.")
+See the documentation of diary-date-forms for an explanation.")
-;;;###autoload
(defvar diary-date-forms
(if european-calendar-style
european-date-diary-pattern
;;;###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 explanantion.")
+ "*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)
- "*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 explanantion.")
+ "*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)
- "*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
+ "*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)
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 offset, savings state, and names for the current time zone.
-This returns a list of the form (OFFSET SAVINGS-FLAG STANDARD SAVINGS).
-This list is calculated from a heuristic that is usually correct;
-to get more reliable results, use current-time-zone.
-OFFSET is an integer specifying how many minutes east of Greenwich the
- current time zone is located. A negative value means west of
- Greenwich. This describes the standard time; if daylight
- savings time is in effect, it does not affect this value.
-SAVINGS-FLAG is non-nil iff daylight savings time or some other sort
- of seasonal time adjustment is ever in effect.
-STANDARD is a string giving the name of the time zone when no seasonal
- time adjustment is in effect.
-SAVINGS 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,
-SAVINGS-FLAG is always nil, and STANDARD and SAVINGS 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* ((quarter-year-seconds 7889238.0) ; # number of seconds in 1/4 year
- (current-time-arithmetic-base 65536.0)
- (now (current-time))
- (now-zone (current-time-zone now))
- (now-offset (car now-zone))
- (now-name (car (cdr now-zone)))
- probe-zone
- (probe-offset now-offset)
- (i 0))
- ;; Heuristic: probe the time zone offset in the next three calendar
- ;; quarters, looking for a time zone offset different from now.
- (while (and (< i 4) (eq now-offset probe-offset))
- (let ((probe
- (list (+ (car now) (round (/ (* i quarter-year-seconds)
- current-time-arithmetic-base)))
- 0 0)))
- (setq probe-zone (current-time-zone probe))
- (setq probe-offset (car probe-zone))
- (setq i (1+ i))))
- (if (or (eq now-offset probe-offset) (not now-offset) (not probe-offset))
- (list (and now-offset (/ now-offset 60)) nil now-name now-name)
- (let ((std-offset (min now-offset probe-offset))
- (probe-name (car (cdr probe-zone))))
- (list (/ std-offset 60)
- t
- (if (eq std-offset now-offset) now-name probe-name)
- (if (eq std-offset now-offset) probe-name now-name))))))
-
-;;; Since the following three defvars are marked to go into
-;;; loaddefs.el, they will be evaluated when Emacs is dumped.
-;;; However, these variables' appropriate values really depend on the
-;;; conditions under which the code is invoked; so it's inappropriate
-;;; to initialize them when Emacs is dumped. Thus we initialize them
-;;; to nil now, and if they are still nil when this file is actually
-;;; loaded, we give them their real values then.
-
-;;;###autoload
-(defvar calendar-time-zone nil
- "*Number of minutes difference between local standard time at
-`calendar-location-name' and Universal (Greenwich) Time. For example, -300
-for New York City, -480 for Los Angeles.
-
-If this is nil, it will be set to the local time zone when the calendar
-package loads.")
-;;; If the user has given this a real value, don't wipe it out.
-(or calendar-time-zone
- (setq calendar-time-zone (car (calendar-current-time-zone))))
-
-;;;###autoload
-(defvar calendar-standard-time-zone-name nil
- "*Abbreviated name of standard time zone at `calendar-location-name'.
-For example, \"EST\" in New York City, \"PST\" for Los Angeles.
-
-If this is nil, it will be set for the local time zone when the calendar
-package loads.")
-;;; If the user has given this a value, don't wipe it out.
-(or calendar-standard-time-zone-name
- (setq calendar-standard-time-zone-name
- (car (nthcdr 2 (calendar-current-time-zone)))))
-
-;;;###autoload
-(defvar calendar-daylight-time-zone-name nil
- "*Abbreviated name of daylight-savings time zone at `calendar-location-name'.
-For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.
-
-If this is nil, it will be set for the local time zone when the calendar
-package loads.")
-;;; If the user has given this a value, don't wipe it out.
-(or calendar-daylight-time-zone-name
- (setq calendar-daylight-time-zone-name
- (car (nthcdr 3 (calendar-current-time-zone)))))
-
-;;;###autoload
-(defvar calendar-daylight-savings-starts nil
- "*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 this is nil and the locale ever uses daylight savings time,
-it will be set to the American rule of the first Sunday in April
-when the calendar package loads.")
-;;; If the user has given this a value, don't wipe it out.
-(or calendar-daylight-savings-starts
- (setq calendar-daylight-savings-starts
- (and (car (cdr (calendar-current-time-zone)))
- '(calendar-nth-named-day 1 0 4 year))))
-
-;;;###autoload
-(defvar calendar-daylight-savings-ends nil
- "*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 ever uses daylight savings time, otherwise nil.
-See the documentation for `calendar-daylight-savings-starts' for other
-examples.")
-;;; If the user has given this a value, don't wipe it out.
-(or calendar-daylight-savings-ends
- (setq calendar-daylight-savings-ends
- (and (car (cdr (calendar-current-time-zone)))
- '(calendar-nth-named-day -1 0 10 year))))
-
(defun european-calendar ()
"Set the interpretation and display of dates to the European style."
(interactive)
;;;###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.")
+ "*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 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.
+ "*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
lexicographic order.")
;;;###autoload
-(defvar diary-display-hook 'simple-diary-display
+(defvar diary-hook nil
+ "*List of functions called after the display of the diary.
+Can be used for appointment notification.")
+
+;;;###autoload
+(defvar diary-display-hook nil
"*List of functions that handle the display of the diary.
+If nil (the default), `simple-diary-display' will be used. Use `ignore' for no
+diary display.
Ordinarily, this just displays the diary buffer (with holidays indicated in
the mode line), if there are any relevant entries. At the time these
functions are called, the variable `diary-entries-list' is a list, in order
by date, of all relevant diary entries in the form of ((MONTH DAY YEAR)
STRING), where string is the diary entry for the given date. This can be
-used, for example, to handle appointment notification, prepare a different
-buffer for display (perhaps combined with holidays), or produce hard copy
-output.
+used, for example, a different buffer for display (perhaps combined with
+holidays), or produce hard copy output.
A function `fancy-diary-display' is provided as an alternative
choice for this hook; this function prepares a special noneditable diary
;;;###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.")
+ "*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
;;;###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.")
+ "*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.")
+ "*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.")
+ "*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
- '((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.")
+ '((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
See the documentation for `calendar-holidays' for details.")
;;;###autoload
-(defvar hebrew-holidays
- '((rosh-hashanah-etc)
+(defvar hebrew-holidays-1
+ '((holiday-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"))
+ (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)"))))
+
+;;;###autoload
+(defvar hebrew-holidays-2
+ '((if all-hebrew-calendar-holidays
+ (holiday-hanukkah)
+ (holiday-hebrew 9 25 "Hanukkah"))
(if all-hebrew-calendar-holidays
- (hebrew 11 15 "Tu B'Shevat"))
+ (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
- (hebrew
+ (holiday-hebrew 11 15 "Tu B'Shevat"))))
+
+;;;###autoload
+(defvar hebrew-holiday-3
+ '((if all-hebrew-calendar-holidays
+ (holiday-hebrew
11
(let ((m displayed-month)
(y displayed-year))
(list 11 16 h-year))))))
(day (extract-calendar-day s-s)))
day))
- "Shabbat Shirah"))
- (passover-etc)
+ "Shabbat Shirah"))))
+
+;;;###autoload
+(defvar hebrew-holidays-4
+ '((holiday-passover-etc)
(if (and all-hebrew-calendar-holidays
(let* ((m displayed-month)
(y displayed-year)
(calendar-absolute-from-gregorian
(list m 1 y))))))
(= 21 (% year 28)))))
- (julian 3 26 "Kiddush HaHamah"))
+ (holiday-julian 3 26 "Kiddush HaHamah"))
(if all-hebrew-calendar-holidays
- (tisha-b-av-etc)))
+ (holiday-tisha-b-av-etc))))
+
+;;;###autoload
+(defvar hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2
+ hebrew-holidays-3 hebrew-holidays-4)
"*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)
+ (holiday-fixed 1 6 "Epiphany"))
+ (holiday-easter-etc)
(if all-christian-calendar-holidays
- (greek-orthodox-easter))
+ (holiday-greek-orthodox-easter))
(if all-christian-calendar-holidays
- (fixed 8 15 "Assumption"))
+ (holiday-fixed 8 15 "Assumption"))
(if all-christian-calendar-holidays
- (advent))
- (fixed 12 25 "Christmas")
+ (holiday-advent))
+ (holiday-fixed 12 25 "Christmas")
(if all-christian-calendar-holidays
- (julian 12 25 "Eastern Orthodox Christmas")))
+ (holiday-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)))))))
+ '((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
- (islamic 1 10 "Ashura"))
+ (holiday-islamic 1 10 "Ashura"))
(if all-islamic-calendar-holidays
- (islamic 3 12 "Mulad-al-Nabi"))
+ (holiday-islamic 3 12 "Mulad-al-Nabi"))
(if all-islamic-calendar-holidays
- (islamic 7 26 "Shab-e-Mi'raj"))
+ (holiday-islamic 7 26 "Shab-e-Mi'raj"))
(if all-islamic-calendar-holidays
- (islamic 8 15 "Shab-e-Bara't"))
- (islamic 9 1 "Ramadan Begins")
+ (holiday-islamic 8 15 "Shab-e-Bara't"))
+ (holiday-islamic 9 1 "Ramadan Begins")
(if all-islamic-calendar-holidays
- (islamic 9 27 "Shab-e Qadr"))
+ (holiday-islamic 9 27 "Shab-e Qadr"))
(if all-islamic-calendar-holidays
- (islamic 10 1 "Id-al-Fitr"))
+ (holiday-islamic 10 1 "Id-al-Fitr"))
(if all-islamic-calendar-holidays
- (islamic 12 10 "Id-al-Adha")))
+ (holiday-islamic 12 10 "Id-al-Adha")))
"*Islamic holidays.
See the documentation for `calendar-holidays' for details.")
(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"))
+ (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
`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
+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
- (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'
+ 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
- (fixed 7 14 \"Bastille Day\")
+ (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
- (float 8 1 4 \"Hurricane Supplication Day\")
+ (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
- (hebrew 10 2 \"Last day of Hanukkah\")
+ (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
- (islamic 3 12 \"Mohammed's Birthday\")
+ (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
- (julian 4 2 \"Jefferson's Birthday\")
+ (holiday-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 divisble by 4, add
+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
- (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\")
+ (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))
- (fixed 11
+ (holiday-fixed 11
(extract-calendar-day
(calendar-gregorian-from-absolute
(1+ (calendar-dayname-on-or-before
(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\") ... )
+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
-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.")
+ (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... ).")
(defconst calendar-buffer "*Calendar*"
"Name of the buffer used for the calendar.")
"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."
+ "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)))))
(,@ body)))))
(defmacro calendar-sum (index initial condition expression)
- "For INDEX = INITIAL and successive integers, as long as CONDITION holds,
-sum EXPRESSION."
+ "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
(` (let (( (, index) (, initial))
(sum 0))
(while (, condition)
(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))))
+ (` (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
(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)))))))
+ (` (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
;;(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)))
+;; (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
"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)
(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
(define-key calendar-mode-map "\e<" 'calendar-beginning-of-year)
(define-key calendar-mode-map "\e>" 'calendar-end-of-year)
(define-key calendar-mode-map "\C-@" 'calendar-set-mark)
+ ;; Many people are used to typing C-SPC and getting C-@.
+ (define-key calendar-mode-map [?\C-\ ] 'calendar-set-mark)
(define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark)
(define-key calendar-mode-map "\e=" 'calendar-count-days-region)
(define-key calendar-mode-map "gd" 'calendar-goto-date)
\\[print-diary-entries] print diary entries
Displaying the diary entries causes the diary entries from the diary-file
-(for the date indicated by the cursor in the calendar window) to be
+\(for the date indicated by the cursor in the calendar window) to be
displayed in another window. This function takes an integer argument that
specifies the number of days of calendar entries to be displayed, starting
with the date indicated by the cursor.
\\[calendar-print-french-date] show equivalent date on the French Revolutionary calendar
\\[calendar-print-mayan-date] show equivalent date on the Mayan calendar
-The astromonical (Julian) day number of a date is found with
+The astronomical (Julian) day number of a date is found with
\\[calendar-print-astro-day-number] show equivalent astronomical (Julian) day number
The times given will be at latitude `solar-latitude', longitude
`solar-longitude' in time zone `solar-time-zone'. These variables, and the
variables `solar-location-name', `solar-standard-time-zone-name',
-`solar-daylight-time-zone-name', `solar-daylight-savings-starts', and
-`solar-daylight-savings-ends', should be set for your location.
+`solar-daylight-time-zone-name', `solar-daylight-savings-starts',
+`solar-daylight-savings-ends', `calendar-daylight-time-offset',
+and `calendar-daylight-savings-switchover-time' should be set for
+your location.
To exit from the calendar use
(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
+ "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
(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."
- (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)))
+;; 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."
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."
+(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)
- (+ (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))))))
+ (+ (* 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
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
+ "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
year)))
(defun calendar-print-iso-date ()
- "Show the equivalent date on the `ISO commercial calendar' for the date
-under the cursor."
+ "Show equivalent ISO date for the date under the cursor."
(interactive)
(let* ((greg-date
(or (calendar-cursor-to-date)
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."
+ "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
;;;###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."
+ "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))
(message "Computing yahrzeits...done")))
(defun calendar-print-astro-day-number ()
- "Show the astronomical (Julian) day number of afternoon on date
-shown by cursor."
+ "Show astronomical (Julian) day number of afternoon on date shown by cursor."
(interactive)
(message
- "Astronomical (Julian) day number after noon Universal Time: %d"
+ "Astronomical (Julian) day number after noon UTC: %d"
(+ 1721425
(calendar-absolute-from-gregorian
(or (calendar-cursor-to-date)
"Move cursor to astronomical (Julian) DAYNUMBER.
Echo astronomical (Julian) day number unless NOECHO is t."
(interactive (list (calendar-read
- "Astromonical (Julian) day number (>1721425): "
+ "Astronomical (Julian) day number (>1721425): "
'(lambda (x) (> x 1721425)))))
(calendar-goto-date (calendar-gregorian-from-absolute (- daynumber 1721425)))
(or noecho (calendar-print-astro-day-number)))