Mercurial > emacs
diff 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!
| author | Jim Blandy <jimb@redhat.com> |
|---|---|
| date | Tue, 22 Jun 1993 03:22:12 +0000 |
| parents | 747d54c5e139 |
| children | 26e6084c5885 |
line wrap: on
line diff
--- a/lisp/calendar/calendar.el Tue Jun 22 02:51:26 1993 +0000 +++ b/lisp/calendar/calendar.el Tue Jun 22 03:22:12 1993 +0000 @@ -8,7 +8,7 @@ ;; 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. @@ -57,6 +57,7 @@ ;; 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 @@ -133,9 +134,9 @@ ;;;###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 @@ -148,24 +149,33 @@ ;;;###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 @@ -307,24 +317,20 @@ ;;;###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 "%%" @@ -333,15 +339,15 @@ ;;;###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 @@ -403,28 +409,26 @@ ;;;###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.") + "*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 explanation.") + "*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) @@ -440,164 +444,6 @@ 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) @@ -616,17 +462,16 @@ ;;;###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 @@ -675,10 +520,11 @@ ;;;###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 @@ -697,46 +543,48 @@ ;;;###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 @@ -750,38 +598,40 @@ ;;;###autoload (defvar hebrew-holidays - '((rosh-hashanah-etc) + '((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)")) + (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 - (hanukkah) - (hebrew 9 25 "Hanukkah")) + (holiday-hanukkah) + (holiday-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-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")) + (holiday-hebrew 11 15 "Tu B'Shevat")) (if all-hebrew-calendar-holidays - (hebrew + (holiday-hebrew 11 (let ((m displayed-month) (y displayed-year)) @@ -808,7 +658,7 @@ (day (extract-calendar-day s-s))) day)) "Shabbat Shirah")) - (passover-etc) + (holiday-passover-etc) (if (and all-hebrew-calendar-holidays (let* ((m displayed-month) (y displayed-year) @@ -819,54 +669,57 @@ (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))) "*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))))))) - (if all-islamic-calendar-holidays - (islamic 1 10 "Ashura")) + '((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 3 12 "Mulad-al-Nabi")) + (holiday-islamic 1 10 "Ashura")) (if all-islamic-calendar-holidays - (islamic 7 26 "Shab-e-Mi'raj")) + (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 - (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.") @@ -874,18 +727,39 @@ (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 - solar-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 @@ -896,64 +770,66 @@ `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\") - -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\") + (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)) - (fixed 11 + (holiday-fixed 11 (extract-calendar-day (calendar-gregorian-from-absolute (1+ (calendar-dayname-on-or-before @@ -965,18 +841,11 @@ (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.") +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.") @@ -988,8 +857,8 @@ "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))))) @@ -1001,8 +870,7 @@ (,@ 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) @@ -1065,10 +933,25 @@ (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 @@ -1125,9 +1008,7 @@ (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 @@ -1136,9 +1017,7 @@ ;;(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 @@ -1308,6 +1187,7 @@ "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) @@ -1470,6 +1350,9 @@ (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 @@ -1822,10 +1705,10 @@ (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 @@ -2153,26 +2036,57 @@ (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." @@ -2617,21 +2531,27 @@ 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 @@ -2646,8 +2566,8 @@ 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 @@ -2682,8 +2602,7 @@ 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) @@ -2872,8 +2791,7 @@ 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 @@ -3006,9 +2924,9 @@ ;;;###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)) @@ -3079,8 +2997,7 @@ (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 UTC: %d"