Commit ecaa0527 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

Initial revision

parent f22cd786
;; Calendar functions.
;; Copyright (C) 1988, 1989, 1990, 1991 Free Software Foundation, Inc.
;; 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
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;; This collection of functions implements a calendar window. It generates
;; generates a calendar for the current month, together with the previous and
;; coming months, or for any other three-month period. The calendar can be
;; scrolled forward and backward in the window to show months in the past or
;; future; the cursor can move forward and backward by days, weeks, or months,
;; making it possible, for instance, to jump to the date a specified number of
;; days, weeks, or months from the date under the cursor. The user can
;; display a list of holidays and other notable days for the period shown; the
;; notable days can be marked on the calendar, if desired. The user can also
;; specify that dates having corresponding diary entries (in a file that the
;; user specifies) be marked; the diary entries for any date can be viewed in
;; a separate window. The diary and the notable days can be viewed
;; independently of the calendar. Dates can be translated from the (usual)
;; Gregorian calendar to the day of the year/days remaining in year, to the
;; ISO commercial calendar, to the Julian (old style) calendar, to the Hebrew
;; calendar, to the Islamic calendar, and to the French Revolutionary calendar.
;; The diary related functions are in diary.el; the holiday related functions
;; are in holiday.el
;; Comments, corrections, and improvements should be sent to
;; Edward M. Reingold Department of Computer Science
;; (217) 333-6733 University of Illinois at Urbana-Champaign
;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
;; Urbana, Illinois 61801
;; GNU Emacs users too numerous to list pointed out a variety of problems
;; with earlier forms of the `infinite' sliding calendar and suggested some
;; of the features included in this package. Especially significant in this
;; regard was the suggestion of mark-diary-entries and view-diary-entries,
;; together ideas for their implementation, by
;; Michael S. Littman Cognitive Science Research Group
;; (201) 829-5155 Bell Communications Research
;; mlittman@wind.bellcore.com 445 South St. Box 1961 (2L-331)
;; Morristown, NJ 07960
;; The algorithms for the Hebrew calendar are those of the Rambam (Rabbi Moses
;; Maimonides), from his Mishneh Torah, as implemented by
;; Nachum Dershowitz Department of Computer Science
;; (217) 333-4219 University of Illinois at Urbana-Champaign
;; nachum@cs.uiuc.edu 1304 West Springfield Avenue
;; Urbana, Illinois 61801
;; Technical details of all the calendrical calculations can be found in
;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
;; pages 899-928.
(defconst calendar-version "Version 4.01, released August 20, 1991")
(defvar view-diary-entries-initially nil
"*If T, the diary entries for the current date will be displayed on entry.
The diary is displayed in another window when the calendar is first displayed,
if the current date is visible. The number of days of diary entries displayed
is governed by the variable `number-of-diary-entries'.")
(defvar number-of-diary-entries 1
"*Specifies how many days of diary entries are to be displayed initially.
This variable affects the diary display when the command M-x diary is used,
or if the value of the variable `view-diary-entries-initially' is t. For
example, if the default value 1 is used, then only the current day's diary
entries will be displayed. If the value 2 is used, then both the current
day's and the next day's entries will be displayed. The value can also be
a vector such as [0 2 2 2 2 4 1]; this value will cause no diary entries to
be displayed on Sunday, the current date's and the next day's diary entries
to be displayed Monday through Thursday, Friday through Monday's entries to
be displayed on Friday, and only Saturday's entries to be displayed on
Saturday. This variable does not affect the diary display with the `d'
command from the calendar; in that case, the prefix argument controls the
number of days of diary entries displayed.")
(defvar mark-diary-entries-in-calendar nil
"*If t, dates with diary entries will be marked in the calendar window.
The marking symbol is specified by the variable `diary-entry-marker'.")
(defvar diary-entry-marker "+"
"*The symbol used to mark dates that have diary entries.")
(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.")
(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.")
(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.")
(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.")
(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.")
(defvar initial-calendar-window-hook nil
"*List of functions to be called when the calendar window is first opened.
The functions invoked are called after the calendar window is opened, but
once opened is never called again. Leaving the calendar with the `q' command
and reentering it will cause these functions to be called again.")
(defvar today-visible-calendar-hook nil
"*List of functions called whenever the current date is visible.
This can be used, for example, to replace today's date with asterisks; a
function `calendar-star-date' is included for this purpose:
(setq today-visible-calendar-hook 'calendar-star-date)
It could also be used to mark the current date with `='; a function is also
provided for this:
(setq today-visible-calendar-hook 'calendar-mark-today)
The corresponding variable `today-invisible-calendar-hook' is the list of
functions called when the calendar function was called when the current
date is not visible in the window.
Other than the use of the provided functions, the changing of any
characters in the calendar buffer by the hooks may cause the failure of the
functions that move by days and weeks.")
(defvar today-invisible-calendar-hook nil
"*List of functions called whenever the current date is not visible.
The corresponding variable `today-visible-calendar-hook' is the list of
functions called when the calendar function was called when the current
date is visible in the window.
Other than the use of the provided functions, the changing of any
characters in the calendar buffer by the hooks may cause the failure of the
functions that move by days and weeks.")
(defvar diary-file "~/diary"
"*Name of the file in which one's personal diary of dates is kept.
The file's entries are lines in any of the forms
MONTH/DAY
MONTH/DAY/YEAR
MONTHNAME DAY
MONTHNAME DAY, YEAR
DAYNAME
at the beginning of the line; the remainder of the line is the diary entry
string for that date. MONTH and DAY are one or two digit numbers, YEAR is
a number and may be written in full or abbreviated to the final two digits.
If the date does not contain a year, it is generic and applies to any year.
DAYNAME entries apply to any date on which is on that day of the week.
MONTHNAME and DAYNAME can be spelled in full, abbreviated to three
characters (with or without a period), capitalized or not. Any of DAY,
MONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year,
respectively.
The European style (in which the day precedes the month) can be used
instead, if you execute `european-calendar' when in the calendar, or set
`european-calendar-style' to t in your .emacs file. The European forms are
DAY/MONTH
DAY/MONTH/YEAR
DAY MONTHNAME
DAY MONTHNAME YEAR
DAYNAME
To revert to the default American style from the European style, execute
`american-calendar' in the calendar.
A diary entry can be preceded by a diary-nonmarking-symbol (ordinarily `&')
to make that entry nonmarking--that is, it will not be marked on dates in
the calendar window but will appear in a diary window.
Multiline diary entries are made by indenting lines after the first with
either a TAB or one or more spaces.
Lines not in one the above formats are ignored. Here are some sample diary
entries (in the default American style):
12/22/1988 Twentieth wedding anniversary!!
&1/1. Happy New Year!
10/22 Ruth's birthday.
21: Payday
Tuesday--weekly meeting with grad students at 10am
Supowit, Shen, Bitner, and Kapoor to attend.
1/13/89 Friday the thirteenth!!
&thu 4pm squash game with Lloyd.
mar 16 Dad's birthday
April 15, 1989 Income tax due.
&* 15 time cards due.
If the first line of a diary entry consists only of the date or day name with
no trailing blanks or punctuation, then that line will not be displayed in the
diary window; only the continuation lines will be shown. For example, the
single diary entry
02/11/1989
Bill Blattner visits Princeton today
2pm Cognitive Studies Committee meeting
2:30-5:30 Lizzie at Lawrenceville for `Group Initiative'
4:00pm Jamie Tappenden
7:30pm Dinner at George and Ed's for Alan Ryan
7:30-10:00pm dance at Stewart Country Day School
will appear in the diary window without the date line at the beginning. This
facility allows the diary window to look neater, but can cause confusion if
used with more than one day's entries displayed.
Diary entries can be based on Lisp sexps. For example, the diary entry
%%(diary-block 11 1 1990 11 10 1990) Vacation
causes the diary entry \"Vacation\" to appear from November 1 through November
10, 1990. Other functions available are `diary-float', `diary-anniversary',
`diary-cyclic', `day-of-year', `iso-date', `commercial-date', `french-date',
`hebrew-date', `islamic-date', `parasha', `omer', and `rosh-hodesh'. See the
documentation for the function `list-sexp-diary-entries' for more details.
Diary entries based on the Hebrew and/or the Islamic calendar are also
possible, but because these are somewhat slow, they are ignored
unless you set the `nongregorian-diary-listing-hook' and the
`nongregorian-diary-marking-hook' appropriately. See the documentation
for these functions for details.
Diary files can contain directives to include the contents of other files; for
details, see the documentation for the variable `list-diary-entries-hook'.")
(defvar diary-nonmarking-symbol "&"
"*The symbol used to indicate that a diary entry is not to be marked in the
calendar window.")
(defvar hebrew-diary-entry-symbol "H"
"*The symbol used to indicate that a diary entry is according to the
Hebrew calendar.")
(defvar islamic-diary-entry-symbol "I"
"*The symbol used to indicate that a diary entry is according to the
Islamic calendar.")
(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'.")
(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'.")
(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.")
(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
DAYNAME
Names can be capitalized or not, written in full, or abbreviated to three
characters with or without a period.")
(defvar american-date-diary-pattern
'((month "/" day "[^/0-9]")
(month "/" day "/" year "[^0-9]")
(monthname " *" day "[^,0-9]")
(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.")
(defvar european-date-diary-pattern
'((day "/" month "[^/0-9]")
(day "/" month "/" year "[^0-9]")
(backup day " *" monthname "\\W+\\<[^*0-9]")
(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.")
(defvar diary-date-forms
(if european-calendar-style
european-date-diary-pattern
american-date-diary-pattern)
"*List of pseudo-patterns describing the forms of date used in the diary.
The patterns on the list must be MUTUALLY EXCLUSIVE and must should not match
any portion of the diary entry itself, just the date component.
A pseudo-pattern is a list of regular expressions and the keywords `month',
`day', `year', `monthname', and `dayname'. The keyword `monthname' will
match the name of the month, capitalized or not, or its three-letter
abbreviation, followed by a period or not; it will also match `*'.
Similarly, `dayname' will match the name of the day, capitalized or not, or
its three-letter abbreviation, followed by a period or not. The keywords
`month', `day', and `year' will match those numerical values, preceded by
arbitrarily many zeros; they will also match `*'.
The matching of the diary entries with the date forms is done with the
standard syntax table from Fundamental mode, but with the `*' changed so
that it is a word constituent.
If, to be mutually exclusive, a pseudo-pattern must match a portion of the
diary entry itself, the first element of the pattern MUST be `backup'. This
directive causes the the date recognizer to back up to the beginning of the
current word of the diary entry, so in no case can the pattern match more
than a portion of the first word of the diary entry.")
(defvar european-calendar-display-form
'(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.")
(defvar american-calendar-display-form
'(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.")
(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
'(month \"/\" day \"/\" (substring year -2))
and
'((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 calendar-date-display-form european-calendar-display-form)
(setq diary-date-forms european-date-diary-pattern)
(update-calendar-mode-line))
(defun american-calendar ()
"Set the interpretation and display of dates to the American style."
(interactive)
(setq european-calendar-style nil)
(setq calendar-date-display-form american-calendar-display-form)
(setq diary-date-forms american-date-diary-pattern)
(update-calendar-mode-line))
(defvar print-diary-entries-hook
'(add-diary-heading lpr-buffer (lambda nil (kill-buffer temp-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
value adds a heading (formed from the information in the mode line of the
diary buffer), does the printing, and kills the buffer. 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.")
(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
#include \"filename\"
This is recursive; that is, #include directives in files thus included are
obeyed. You can change the \"#include\" to some other string by changing
the variable `diary-include-string'. When you use `include-other-diary-files'
as part of the list-diary-entries-hook, you will probably also want to use the
function `mark-included-diary-files' as part of the mark-diary-entries-hook.
For example, you could use
(setq list-diary-entries-hook
'(include-other-diary-files
(lambda nil
(setq diary-entries-list
(sort diary-entries-list 'diary-entry-compare)))))
(setq diary-display-hook 'fancy-diary-display)
in your .emacs file to cause the fancy diary buffer to be displayed with
diary entries from various included files, each day's entries sorted into
lexicographic order.")
(defvar diary-display-hook 'simple-diary-display
"*List of functions that handle the display of the diary.
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.
A function `fancy-diary-display' is provided as an alternative
choice for this hook; this function prepares a special noneditable diary
buffer with the relevant diary entries that has neat day-by-day arrangement
with headings. The fancy diary buffer will show the holidays unless the
variable `holidays-in-diary-buffer' is set to nil. Ordinarily, the fancy
diary buffer will not show days for which there are no diary entries, even
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.")
(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', `yahrzeit-diary-entry', and
`list-islamic-diary-entries'. The documentation for these functions
describes the style of such diary entries.")
(defvar mark-diary-entries-hook nil
"*List of functions called after marking diary entries in the calendar.
A function `mark-included-diary-files' is also provided for use as the
mark-diary-entries-hook; it 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
#include \"filename\"
This is recursive; that is, #include directives in files thus included are
obeyed. You can change the \"#include\" to some other string by changing the
variable `diary-include-string'. When you use `mark-included-diary-files' as
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.")
(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.")
(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.")
(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-holidays
'(
;; General Holidays (American)
(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 4 0 1 "Daylight Savings Time Begins")
(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")
(float 10 0 -1 "Daylight Savings Time Ends")
(fixed 10 31 "Halloween")
(fixed 11 11 "Veteran's Day")
(float 11 4 4 "Thanksgiving")
;; Christian Holidays
(if all-christian-calendar-holidays
(fixed 1 6 "Epiphany"))
(easter-etc)
(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"))
;; Jewish 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
(calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian
(list m
(calendar-last-day-of-month m y)
y)))))
(s-s
(calendar-hebrew-from-absolute
(if (=
(% (calendar-absolute-from-hebrew
(list 7 1 h-year))
7)
6)
(calendar-dayname-on-or-before
6 (calendar-absolute-from-hebrew
(list 11 17 h-year)))
(calendar-dayname-on-or-before
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))
;; 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")))
"List of notable days for the command M-x holidays.
Additional holidays are easy to add to the list. 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