/lisp/calendar/calendar.el
Emacs Lisp | 2644 lines | 2070 code | 245 blank | 329 comment | 77 complexity | 349736d40172406872d0885f4066383b MD5 | raw file
Possible License(s): GPL-3.0, LGPL-2.0, GPL-2.0, AGPL-3.0
Large files files are truncated, but you can click here to view the full file
- ;;; calendar.el --- calendar functions
- ;; Copyright (C) 1988-1995, 1997, 2000-2016 Free Software Foundation,
- ;; Inc.
- ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
- ;; Maintainer: Glenn Morris <rgm@gnu.org>
- ;; Keywords: calendar
- ;; Human-Keywords: calendar, Gregorian calendar, diary, holidays
- ;; This file is part of GNU Emacs.
- ;; GNU Emacs is free software: you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
- ;;; Commentary:
- ;; This collection of functions implements a calendar window. It
- ;; 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, to the Bahá’í calendar, to the French
- ;; Revolutionary calendar, to the Mayan calendar, to the Chinese
- ;; calendar, to the Coptic calendar, to the Ethiopic calendar, and to
- ;; the astronomical (Julian) day number. Times of sunrise/sunset can
- ;; be displayed, as can the phases of the moon. Appointment
- ;; notification for diary entries is available. Calendar printing via
- ;; LaTeX is available.
- ;; The following files are part of the calendar/diary code:
- ;; appt.el Appointment notification
- ;; cal-bahai.el Bahá’í calendar
- ;; cal-china.el Chinese calendar
- ;; cal-coptic.el Coptic/Ethiopic calendars
- ;; cal-dst.el Daylight saving time rules
- ;; cal-french.el French revolutionary calendar
- ;; cal-hebrew.el Hebrew calendar
- ;; cal-html.el Calendars in HTML
- ;; cal-islam.el Islamic calendar
- ;; cal-iso.el ISO calendar
- ;; cal-julian.el Julian/astronomical calendars
- ;; cal-mayan.el Mayan calendars
- ;; cal-menu.el Menu support
- ;; cal-move.el Movement in the calendar
- ;; cal-persia.el Persian calendar
- ;; cal-tex.el Calendars in LaTeX
- ;; cal-x.el Dedicated frame functions
- ;; calendar.el This file
- ;; diary-lib.el Diary functions
- ;; holidays.el Holiday functions
- ;; lunar.el Phases of the moon
- ;; solar.el Sunrise/sunset, equinoxes/solstices
- ;; Technical details of all the calendrical calculations can be found in
- ;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
- ;; and Nachum Dershowitz, Cambridge University Press (2001).
- ;; An earlier version of the technical details appeared in
- ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
- ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
- ;; pages 899-928, and in ``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.
- ;; Hard copies of these two papers can be obtained by sending email to
- ;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
- ;; the message BODY containing your mailing address (snail).
- ;; A note on free variables:
- ;; The calendar passes around a few dynamically bound variables, which
- ;; unfortunately have rather common names. They are meant to be
- ;; available for external functions, so the names can't be changed.
- ;; displayed-month, displayed-year: bound in calendar-generate, the
- ;; central month of the 3 month calendar window
- ;; original-date, number: bound in diary-list-entries, the arguments
- ;; with which that function was called.
- ;; date, entry: bound in diary-list-sexp-entries (qv)
- ;; Bound in diary-list-entries:
- ;; diary-entries-list: use in d-l, appt.el, and by diary-add-to-list
- ;; diary-saved-point: only used in diary-lib.el, passed to the display func
- ;; date-string: only used in diary-lib.el
- ;; list-only: don't modify the diary-buffer, just return a list of entries
- ;; file-glob-attrs: yuck
- ;;; Code:
- (load "cal-loaddefs" nil t)
- ;; Avoid recursive load of calendar when loading cal-menu. Yuck.
- (provide 'calendar)
- (require 'cal-menu)
- (defgroup calendar nil
- "Calendar and time management support."
- :prefix "calendar-"
- :group 'applications)
- (defgroup calendar-hooks nil
- "Calendar hooks."
- :prefix "calendar-"
- :group 'calendar)
- (defgroup calendar-faces nil
- "Calendar faces."
- :prefix "calendar-"
- :group 'calendar)
- (defcustom calendar-offset 0
- "The offset of the principal month from the center of the calendar window.
- 0 means the principal month is in the center (default), -1 means on the left,
- +1 means on the right. Larger (or smaller) values push the principal month off
- the screen."
- :type 'integer
- :group 'calendar)
- (defcustom calendar-setup nil
- "The frame setup of the calendar.
- The choices are: `one-frame' (calendar and diary together in one separate,
- dedicated frame); `two-frames' (calendar and diary in separate, dedicated
- frames); `calendar-only' (calendar in a separate, dedicated frame); with
- any other value the current frame is used. Using any of the first
- three options overrides the value of `calendar-view-diary-initially-flag'."
- :type '(choice
- (const :tag "calendar and diary in separate frame" one-frame)
- (const :tag "calendar and diary each in own frame" two-frames)
- (const :tag "calendar in separate frame" calendar-only)
- (const :tag "use current frame" nil))
- :group 'calendar)
- (defcustom calendar-minimum-window-height 8
- "Minimum height `calendar-generate-window' should use for calendar window."
- :type 'integer
- :version "22.1"
- :group 'calendar)
- ;; See discussion in bug#1806.
- (defcustom calendar-split-width-threshold nil
- "Value to use for `split-width-threshold' when creating a calendar.
- This only affects frames wider than the default value of
- `split-width-threshold'."
- :type '(choice (const nil)
- (integer))
- :version "23.2"
- :group 'calendar)
- (defcustom calendar-week-start-day 0
- "The day of the week on which a week in the calendar begins.
- 0 means Sunday (default), 1 means Monday, and so on.
- If you change this variable directly (without using customize)
- after starting `calendar', you should call `calendar-redraw' to
- update the calendar display to reflect the change, otherwise
- movement commands will not work correctly."
- :type 'integer
- ;; Change the initialize so that if you reload calendar.el, it will not
- ;; cause a redraw (which may fail, e.g. with "invalid byte-code in
- ;; calendar.elc" because of the "byte-compile-dynamic").
- :initialize 'custom-initialize-default
- :set (lambda (sym val)
- (set sym val)
- (calendar-redraw))
- :group 'calendar)
- (defcustom calendar-weekend-days '(0 6)
- "Days of the week considered weekend days.
- 0 means Sunday, 1 means Monday, and so on.
- Determines which day headers are fontified with
- `calendar-weekend-header'."
- :type '(repeat integer)
- :version "25.1"
- :group 'calendar)
- (defcustom calendar-view-diary-initially-flag nil
- "Non-nil means display current date's diary entries on entry to calendar.
- 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 `diary-number-of-entries'. This variable can
- be overridden by the value of `calendar-setup'."
- :type 'boolean
- :group 'diary)
- ;; FIXME :set
- (defcustom calendar-mark-diary-entries-flag nil
- "Non-nil means mark dates with diary entries, in the calendar window.
- The marking symbol is specified by the variable `diary-entry-marker'."
- :type 'boolean
- :group 'diary)
- (defcustom calendar-remove-frame-by-deleting t
- "Determine how the calendar mode removes a frame no longer needed.
- If nil, make an icon of the frame. If non-nil, delete the frame."
- :type 'boolean
- :version "23.1" ; changed from nil to t
- :group 'view
- :group 'calendar)
- (defface calendar-today
- '((t (:underline t)))
- "Face for indicating today's date in the calendar.
- See the variable `calendar-today-marker'."
- :group 'calendar-faces)
- (defface diary
- '((((min-colors 88) (class color) (background light))
- :foreground "red1")
- (((class color) (background light))
- :foreground "red")
- (((min-colors 88) (class color) (background dark))
- :foreground "yellow1")
- (((class color) (background dark))
- :foreground "yellow")
- (t
- :weight bold))
- "Face for highlighting diary entries.
- Used to mark diary entries in the calendar (see `diary-entry-marker'),
- and to highlight the date header in the fancy diary."
- :group 'calendar-faces)
- (defface holiday
- '((((class color) (background light))
- :background "pink")
- (((class color) (background dark))
- :background "chocolate4")
- (t
- :inverse-video t))
- "Face for indicating in the calendar dates that have holidays.
- See `calendar-holiday-marker'."
- :group 'calendar-faces)
- (defface calendar-weekday-header '((t :inherit font-lock-constant-face))
- "Face used for weekday column headers in the calendar.
- See also the face `calendar-weekend-header'."
- :version "24.4"
- :group 'calendar-faces)
- (defface calendar-weekend-header '((t :inherit font-lock-comment-face))
- "Face used for weekend column headers in the calendar.
- See also the face `calendar-weekday-header'."
- :version "24.4"
- :group 'calendar-faces)
- (defface calendar-month-header '((t :inherit font-lock-function-name-face))
- "Face used for month headers in the calendar."
- :version "24.4"
- :group 'calendar-faces)
- ;; These briefly checked font-lock-mode, but that is broken, since it
- ;; is a buffer-local variable, and which buffer happens to be current
- ;; when this file is loaded shouldn't make a difference. One could
- ;; perhaps check global-font-lock-mode, or font-lock-global-modes; but
- ;; this feature doesn't use font-lock, so there's no real reason it
- ;; should respect those either. See bug#2199.
- ;; They also used to check display-color-p, but that is a problem if
- ;; loaded from --daemon. Since BW displays are rare now, this was
- ;; also taken out. The way to keep it would be to have nil mean do a
- ;; runtime check whenever this variable is used.
- (defcustom diary-entry-marker 'diary
- "How to mark dates that have diary entries.
- The value can be either a single-character string (e.g. \"+\") or a face."
- :type '(choice (string :tag "Single character string") face)
- :group 'diary
- :version "23.1")
- (defcustom calendar-today-marker 'calendar-today
- "How to mark today's date in the calendar.
- The value can be either a single-character string (e.g. \"=\") or a face.
- Used by `calendar-mark-today'."
- :type '(choice (string :tag "Single character string") face)
- :group 'calendar
- :version "23.1")
- (defcustom calendar-holiday-marker 'holiday
- "How to mark notable dates in the calendar.
- The value can be either a single-character string (e.g. \"*\") or a face."
- :type '(choice (string :tag "Single character string") face)
- :group 'holidays
- :version "23.1")
- (defcustom calendar-view-holidays-initially-flag nil
- "Non-nil means display holidays for current three month period on entry.
- The holidays are displayed in another window when the calendar is first
- displayed."
- :type 'boolean
- :group 'holidays)
- ;; FIXME :set
- (defcustom calendar-mark-holidays-flag nil
- "Non-nil means mark dates of holidays in the calendar window.
- The marking symbol is specified by the variable `calendar-holiday-marker'."
- :type 'boolean
- :group 'holidays)
- (defcustom calendar-mode-hook nil
- "Hook run when entering `calendar-mode'."
- :type 'hook
- :group 'calendar-hooks)
- (defcustom calendar-load-hook nil
- "List of functions to be called after the calendar is first loaded.
- This is the place to add key bindings to `calendar-mode-map'."
- :type 'hook
- :group 'calendar-hooks)
- (defcustom calendar-initial-window-hook nil
- "List of functions to be called when the calendar window is created.
- Quitting the calendar and re-entering it will cause these functions
- to be called again."
- :type 'hook
- :group 'calendar-hooks)
- (defcustom calendar-today-visible-hook nil
- "List of functions called whenever the current date is visible.
- To mark today's date, add the function `calendar-mark-today'.
- To replace the date with asterisks, add the function `calendar-star-date'.
- See also `calendar-today-invisible-hook'.
- In general, be careful about changing characters in the calendar buffer,
- since it may cause the movement commands to fail."
- :type 'hook
- :options '(calendar-mark-today calendar-star-date)
- :group 'calendar-hooks)
- (defcustom calendar-today-invisible-hook nil
- "List of functions called whenever the current date is not visible.
- See also `calendar-today-visible-hook'."
- :type 'hook
- :group 'calendar-hooks)
- (defcustom calendar-move-hook nil
- "List of functions called whenever the cursor moves in the calendar.
- For example,
- (add-hook \\='calendar-move-hook (lambda () (diary-view-entries 1)))
- redisplays the diary for whatever date the cursor is moved to."
- :type 'hook
- :options '(calendar-update-mode-line)
- :group 'calendar-hooks)
- (defcustom calendar-date-echo-text
- "mouse-2: general menu\nmouse-3: menu for this date"
- "String displayed when the cursor is over a date in the calendar.
- Can be either a fixed string, or a lisp expression that returns one.
- When this expression is evaluated, DAY, MONTH, and YEAR are
- integers appropriate to the relevant date. For example, to
- display the ISO date:
- (setq calendar-date-echo-text \\='(format \"ISO date: %s\"
- (calendar-iso-date-string
- (list month day year))))
- Changing this variable without using customize has no effect on
- pre-existing calendar windows."
- :group 'calendar
- :initialize 'custom-initialize-default
- :risky t
- :set (lambda (sym val)
- (set sym val)
- (calendar-redraw))
- :type '(choice (string :tag "Fixed string")
- (sexp :value
- (format "ISO date: %s"
- (calendar-iso-date-string
- (list month day year)))))
- :version "23.1")
- (defvar calendar-month-digit-width nil
- "Width of the region with numbers in each month in the calendar.")
- (defvar calendar-month-width nil
- "Full width of each month in the calendar.")
- (defvar calendar-right-margin nil
- "Right margin of the calendar.")
- (defvar calendar-month-edges nil
- "Alist of month edge columns.
- Each element has the form (N LEFT FIRST LAST RIGHT), where
- LEFT is the leftmost column associated with month segment N,
- FIRST and LAST are the first and last columns with day digits in,
- and LAST is the rightmost column.")
- (defun calendar-month-edges (segment)
- "Compute the month edge columns for month SEGMENT.
- Returns a list (LEFT FIRST LAST RIGHT), where LEFT is the
- leftmost column associated with a month, FIRST and LAST are the
- first and last columns with day digits in, and LAST is the
- rightmost column."
- ;; The leftmost column with a digit in it in this month segment.
- (let* ((first (+ calendar-left-margin
- (* segment calendar-month-width)))
- ;; The rightmost column with a digit in it in this month segment.
- (last (+ first (1- calendar-month-digit-width)))
- (left (if (eq segment 0)
- 0
- (+ calendar-left-margin
- (* segment calendar-month-width)
- (- (/ calendar-intermonth-spacing 2)))))
- ;; The rightmost edge of this month segment, dividing the
- ;; space between months in two.
- (right (+ calendar-left-margin
- (* (1+ segment) calendar-month-width)
- (- (/ calendar-intermonth-spacing 2)))))
- (list left first last right)))
- (defun calendar-recompute-layout-variables ()
- "Recompute some layout-related calendar \"constants\"."
- (setq calendar-month-digit-width (+ (* 6 calendar-column-width)
- calendar-day-digit-width)
- calendar-month-width (+ (* 7 calendar-column-width)
- calendar-intermonth-spacing)
- calendar-right-margin (+ calendar-left-margin
- (* 3 (* 7 calendar-column-width))
- (* 2 calendar-intermonth-spacing))
- calendar-month-edges nil)
- (dotimes (i 3)
- (push (cons i (calendar-month-edges i)) calendar-month-edges))
- (setq calendar-month-edges (reverse calendar-month-edges)))
- (defun calendar-set-layout-variable (symbol value &optional minmax)
- "Set SYMBOL's value to VALUE, an integer.
- A positive/negative MINMAX enforces a minimum/maximum value.
- Then redraw the calendar, if necessary."
- (let ((oldvalue (symbol-value symbol)))
- (custom-set-default symbol (if minmax
- (if (< minmax 0)
- (min value (- minmax))
- (max value minmax))
- value))
- (unless (equal value oldvalue)
- (calendar-recompute-layout-variables)
- (calendar-redraw))))
- (defcustom calendar-left-margin 5
- "Empty space to the left of the first month in the calendar."
- :group 'calendar
- :initialize 'custom-initialize-default
- :set 'calendar-set-layout-variable
- :type 'integer
- :version "23.1")
- ;; Or you can view it as columns of width 2, with 1 space, no space
- ;; after the last column, and a 5 space gap between month.
- ;; FIXME check things work if this is odd.
- (defcustom calendar-intermonth-spacing 4
- "Space between months in the calendar. Minimum value is 1."
- :group 'calendar
- :initialize 'custom-initialize-default
- :set (lambda (sym val)
- (calendar-set-layout-variable sym val 1))
- :type 'integer
- :version "23.1")
- ;; FIXME calendar-month-column-width?
- (defcustom calendar-column-width 3
- "Width of each day column in the calendar. Minimum value is 3."
- :initialize 'custom-initialize-default
- :set (lambda (sym val)
- (calendar-set-layout-variable sym val 3))
- :type 'integer
- :version "23.1")
- (defun calendar-day-header-construct (&optional width)
- "Return the default value for `calendar-day-header-array'.
- WIDTH defaults to `calendar-day-header-width'."
- (or width (setq width calendar-day-header-width))
- (calendar-abbrev-construct (if (<= width calendar-abbrev-length)
- calendar-day-abbrev-array
- calendar-day-name-array)
- width))
- ;; FIXME better to use a format spec?
- (defcustom calendar-day-header-width 2
- "Width of the day column headers in the calendar.
- Must be at least one less than `calendar-column-width'."
- :group 'calendar
- :initialize 'custom-initialize-default
- :set (lambda (sym val)
- (or (calendar-customized-p 'calendar-day-header-array)
- (setq calendar-day-header-array
- (calendar-day-header-construct val)))
- (calendar-set-layout-variable sym val (- 1 calendar-column-width)))
- :type 'integer
- :version "23.1")
- ;; FIXME a format specifier instead?
- (defcustom calendar-day-digit-width 2
- "Width of the day digits in the calendar. Minimum value is 2."
- :group 'calendar
- :initialize 'custom-initialize-default
- :set (lambda (sym val)
- (calendar-set-layout-variable sym val 2))
- :type 'integer
- :version "23.1")
- (defcustom calendar-intermonth-header nil
- "Header text to display in the space to the left of each calendar month.
- See `calendar-intermonth-text'."
- :group 'calendar
- :initialize 'custom-initialize-default
- :risky t
- :set (lambda (sym val)
- (set sym val)
- (calendar-redraw))
- :type '(choice (const nil :tag "Nothing")
- (string :tag "Fixed string")
- (sexp :value
- (propertize "WK" 'font-lock-face
- 'font-lock-function-name-face)))
- :version "23.1")
- (defcustom calendar-intermonth-text nil
- "Text to display in the space to the left of each calendar month.
- Can be nil, a fixed string, or a lisp expression that returns a string.
- When the expression is evaluated, the variables DAY, MONTH and YEAR
- are integers appropriate for the first day in each week.
- Will be truncated to the smaller of `calendar-left-margin' and
- `calendar-intermonth-spacing'. The last character is forced to be a space.
- For example, to display the ISO week numbers:
- (setq calendar-week-start-day 1
- calendar-intermonth-text
- \\='(propertize
- (format \"%2d\"
- (car
- (calendar-iso-from-absolute
- (calendar-absolute-from-gregorian (list month day year)))))
- \\='font-lock-face \\='font-lock-function-name-face))
- See also `calendar-intermonth-header'."
- :group 'calendar
- :initialize 'custom-initialize-default
- :risky t
- :set (lambda (sym val)
- (set sym val)
- (calendar-redraw))
- :type '(choice (const nil :tag "Nothing")
- (string :tag "Fixed string")
- (sexp :value
- (propertize
- (format "%2d"
- (car
- (calendar-iso-from-absolute
- (calendar-absolute-from-gregorian
- (list month day year)))))
- 'font-lock-face 'font-lock-function-name-face)))
- :version "23.1")
- (defcustom diary-file (locate-user-emacs-file "diary" "diary")
- "Name of the file in which one's personal diary of dates is kept.
- The file's entries are lines beginning with any of the forms
- specified by the variable `diary-date-forms', which by default
- uses the forms of `diary-american-date-forms':
- MONTH/DAY
- MONTH/DAY/YEAR
- MONTHNAME DAY
- MONTHNAME DAY, YEAR
- DAYNAME
- with the remainder of the line being 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 `diary-abbreviated-year-flag' is non-nil). MONTHNAME
- and DAYNAME can be spelled in full (as specified by the variables
- `calendar-month-name-array' and `calendar-day-name-array'), or
- abbreviated (as specified by `calendar-month-abbrev-array' and
- `calendar-day-abbrev-array') with or without a period. Case is
- ignored. Any of DAY, MONTH, or MONTHNAME, YEAR can be `*' which
- matches any day, month, or year, respectively. If the date does
- not contain a year, it is generic and applies to any year. A
- DAYNAME entry applies to the appropriate day of the week in every week.
- You can customize `diary-date-forms' to your preferred format.
- Three default styles are provided: `diary-american-date-forms',
- `diary-european-date-forms', and `diary-iso-date-forms'.
- You can choose between these by setting `calendar-date-style' in your
- init file, or by using `calendar-set-date-style' when in the calendar.
- A diary entry can be preceded by the character `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 is not displayed in the
- diary window; only the continuation lines is 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. See the documentation for the function
- `diary-list-sexp-entries' for more details.
- Diary entries based on the Hebrew, the Islamic and/or the Bahá’í
- calendar are also possible, but because these are somewhat slow, they
- are ignored unless you set the `diary-nongregorian-listing-hook' and
- the `diary-nongregorian-marking-hook' appropriately. See the
- documentation of these hooks for details.
- Diary files can contain directives to include the contents of other files; for
- details, see the documentation for the variable `diary-list-entries-hook'."
- :version "25.1" ; ~/diary -> locate-user-emacs-file
- :type 'file
- :group 'diary)
- ;; FIXME do these have to be single characters?
- (defcustom diary-nonmarking-symbol "&"
- "Symbol indicating that a diary entry is not to be marked in the calendar."
- :type 'string
- :group 'diary)
- (defcustom diary-chinese-entry-symbol "C"
- "Symbol indicating a diary entry according to the Chinese calendar."
- :type 'string
- :group 'diary
- :version "25.1")
- (defcustom diary-hebrew-entry-symbol "H"
- "Symbol indicating a diary entry according to the Hebrew calendar."
- :type 'string
- :group 'diary)
- (defcustom diary-islamic-entry-symbol "I"
- "Symbol indicating a diary entry according to the Islamic calendar."
- :type 'string
- :group 'diary)
- (defcustom diary-bahai-entry-symbol "B"
- "Symbol indicating a diary entry according to the Bahá’í calendar."
- :type 'string
- :group 'diary)
- (defcustom calendar-date-style 'american
- "Your preferred style for writing dates.
- The options are:
- `american' - month/day/year
- `european' - day/month/year
- `iso' - year/month/day
- This affects how dates written in your diary are interpreted.
- It also affects date display, as well as those calendar and diary
- functions that take a date as an argument, e.g. `diary-date', by
- changing the order in which the arguments are interpreted.
- Setting this variable directly does not take effect (if the
- calendar package is already loaded). Rather, use either
- \\[customize] or the function `calendar-set-date-style'."
- :version "23.1"
- :type '(choice (const american :tag "Month/Day/Year")
- (const european :tag "Day/Month/Year")
- (const iso :tag "Year/Month/Day"))
- :initialize 'custom-initialize-default
- :set (lambda (symbol value)
- (calendar-set-date-style value))
- :group 'calendar)
- ;; Next three are provided to aid in setting diary-date-forms.
- ;; FIXME move to diary-lib?
- (defcustom diary-iso-date-forms
- '((month "[-/]" day "[^-/0-9]")
- (year "[-/]" month "[-/]" day "[^0-9]")
- ;; Cannot allow [-/] as separators here, since it would also match
- ;; the first element (bug#7377).
- (monthname " *" day "[^-0-9]")
- (year " *" monthname " *" day "[^0-9]")
- (dayname "\\W"))
- "List of pseudo-patterns describing the ISO style of dates.
- The defaults are: MONTH[-/]DAY; YEAR[-/]MONTH[-/]DAY; MONTHNAME DAY;
- YEAR MONTHNAME DAY; DAYNAME. Normally you should not customize this,
- but `diary-date-forms' (which see)."
- :version "23.3" ; bug#7377
- :type '(repeat (choice (cons :tag "Backup"
- :value (backup . nil)
- (const backup)
- (repeat (list :inline t :format "%v"
- (symbol :tag "Keyword")
- (choice symbol regexp))))
- (repeat (list :inline t :format "%v"
- (symbol :tag "Keyword")
- (choice symbol regexp)))))
- :group 'diary)
- (defcustom diary-american-date-forms
- '((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 style of dates.
- The defaults are: MONTH/DAY; MONTH/DAY/YEAR; MONTHNAME DAY;
- MONTHNAME DAY, YEAR; DAYNAME. Normally you should not customize this,
- but `diary-date-forms' (which see)."
- :type '(repeat (choice (cons :tag "Backup"
- :value (backup . nil)
- (const backup)
- (repeat (list :inline t :format "%v"
- (symbol :tag "Keyword")
- (choice symbol regexp))))
- (repeat (list :inline t :format "%v"
- (symbol :tag "Keyword")
- (choice symbol regexp)))))
- :group 'diary)
- (defcustom diary-european-date-forms
- '((day "/" month "[^/0-9]")
- (day "/" month "/" year "[^0-9]")
- (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)")
- (day " *" monthname " *" year "[^0-9]")
- (dayname "\\W"))
- "List of pseudo-patterns describing the European style of dates.
- The defaults are: DAY/MONTH; DAY/MONTH/YEAR; DAY MONTHNAME;
- DAY MONTHNAME YEAR; DAYNAME. Normally you should not customize this, but
- `diary-date-forms' (which see)."
- :type '(repeat (choice (cons :tag "Backup"
- :value (backup . nil)
- (const backup)
- (repeat (list :inline t :format "%v"
- (symbol :tag "Keyword")
- (choice symbol regexp))))
- (repeat (list :inline t :format "%v"
- (symbol :tag "Keyword")
- (choice symbol regexp)))))
- :group 'diary)
- (defvar diary-font-lock-keywords)
- (defcustom diary-date-forms (cond ((eq calendar-date-style 'iso)
- diary-iso-date-forms)
- ((eq calendar-date-style 'european)
- diary-european-date-forms)
- (t diary-american-date-forms))
- "List of pseudo-patterns describing the forms of date used in the diary.
- The patterns on the list must be MUTUALLY EXCLUSIVE and 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 (see `calendar-month-name-array'), capitalized
- or not, or its user-specified abbreviation (see `calendar-month-abbrev-array'),
- followed by a period or not; it will also match `*'. Similarly, `dayname'
- will match the name of the day (see `calendar-day-name-array'), capitalized or
- not, or its user-specified abbreviation (see `calendar-day-abbrev-array'),
- 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 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.
- For examples of three common styles, see `diary-american-date-forms',
- `diary-european-date-forms', and `diary-iso-date-forms'."
- :type '(repeat (choice (cons :tag "Backup"
- :value (backup . nil)
- (const backup)
- (repeat (list :inline t :format "%v"
- (symbol :tag "Keyword")
- (choice symbol regexp))))
- (repeat (list :inline t :format "%v"
- (symbol :tag "Keyword")
- (choice symbol regexp)))))
- :set-after '(calendar-date-style diary-iso-date-forms
- diary-european-date-forms
- diary-american-date-forms)
- :initialize 'custom-initialize-default
- :set (lambda (symbol value)
- (unless (equal value (eval symbol))
- (custom-set-default symbol value)
- (setq diary-font-lock-keywords (diary-font-lock-keywords))
- ;; Need to redraw not just to get new font-locking, but also
- ;; to pick up any newly recognized entries.
- (and (diary-live-p)
- (diary))))
- :group 'diary)
- ;; Next three are provided to aid in setting calendar-date-display-form.
- (defcustom calendar-iso-date-display-form '((format "%s-%.2d-%.2d" year
- (string-to-number month)
- (string-to-number day)))
- "Pseudo-pattern governing the way a date appears in the ISO style.
- Normally you should not customize this, but `calendar-date-display-form'
- \(which see)."
- :type 'sexp
- :risky t
- :version "23.1"
- :group 'calendar)
- (defcustom calendar-european-date-display-form
- '((if dayname (concat dayname ", ")) day " " monthname " " year)
- "Pseudo-pattern governing the way a date appears in the European style.
- Normally you should not customize this, but `calendar-date-display-form'
- \(which see)."
- :type 'sexp
- :risky t
- :group 'calendar)
- (defcustom calendar-american-date-display-form
- '((if dayname (concat dayname ", ")) monthname " " day ", " year)
- "Pseudo-pattern governing the way a date appears in the American style.
- Normally you should not customize this, but `calendar-date-display-form'
- \(which see)."
- :type 'sexp
- :risky t
- :group 'calendar)
- (defcustom calendar-date-display-form
- (cond ((eq calendar-date-style 'iso)
- calendar-iso-date-display-form)
- ((eq calendar-date-style 'european)
- calendar-european-date-display-form)
- (t calendar-american-date-display-form))
- "Pseudo-pattern governing the way a calendar date appears.
- Used by the function `calendar-date-string' (which see), 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, a typical American form would be
- (month \"/\" day \"/\" (substring year -2))
- whereas
- ((format \"%9s, %9s %2s, %4s\" dayname monthname day year))
- would give the usual American style in fixed-length fields. The variables
- `calendar-iso-date-display-form', `calendar-european-date-display-form', and
- `calendar-american-date-display-form' provide some defaults for three common
- styles."
- :type 'sexp
- :risky t
- :set-after '(calendar-date-style calendar-iso-date-display-form
- calendar-european-date-display-form
- calendar-american-date-display-form)
- :group 'calendar)
- (defcustom calendar-american-month-header
- '(propertize (format "%s %d" (calendar-month-name month) year)
- 'font-lock-face 'calendar-month-header)
- "Default format for calendar month headings with the American date style.
- Normally you should not customize this, but `calender-month-header'."
- :group 'calendar
- :risky t
- :type 'sexp
- :version "24.4") ; font-lock-function-name-face -> calendar-month-header
- (defcustom calendar-european-month-header
- '(propertize (format "%s %d" (calendar-month-name month) year)
- 'font-lock-face 'calendar-month-header)
- "Default format for calendar month headings with the European date style.
- Normally you should not customize this, but `calender-month-header'."
- :group 'calendar
- :risky t
- :type 'sexp
- :version "24.4") ; font-lock-function-name-face -> calendar-month-header
- (defcustom calendar-iso-month-header
- '(propertize (format "%d %s" year (calendar-month-name month))
- 'font-lock-face 'calendar-month-header)
- "Default format for calendar month headings with the ISO date style.
- Normally you should not customize this, but `calender-month-header'."
- :group 'calendar
- :risky t
- :type 'sexp
- :version "24.4") ; font-lock-function-name-face -> calendar-month-header
- (defcustom calendar-month-header
- (cond ((eq calendar-date-style 'iso)
- calendar-iso-month-header)
- ((eq calendar-date-style 'european)
- calendar-european-month-header)
- (t calendar-american-month-header))
- "Expression to evaluate to return the calendar month headings.
- When this expression is evaluated, the variables MONTH and YEAR are
- integers appropriate to the relevant month. The result is padded
- to the width of `calendar-month-digit-width'.
- For examples of three common styles, see `calendar-american-month-header',
- `calendar-european-month-header', and `calendar-iso-month-header'.
- Changing this variable without using customize has no effect on
- pre-existing calendar windows."
- :group 'calendar
- :initialize 'custom-initialize-default
- :risky t
- :set (lambda (sym val)
- (set sym val)
- (calendar-redraw))
- :set-after '(calendar-date-style calendar-american-month-header
- calendar-european-month-header
- calendar-iso-month-header)
- :type 'sexp
- :version "24.3")
- (defun calendar-set-date-style (style)
- "Set the style of calendar and diary dates to STYLE (a symbol).
- The valid styles are described in the documentation of `calendar-date-style'."
- (interactive (list (intern
- (completing-read "Date style: "
- '("american" "european" "iso") nil t
- nil nil "american"))))
- (or (memq style '(american european iso))
- (setq style 'american))
- (setq calendar-date-style style
- calendar-date-display-form
- (symbol-value (intern-soft
- (format "calendar-%s-date-display-form" style)))
- calendar-month-header
- (symbol-value (intern-soft (format "calendar-%s-month-header" style)))
- diary-date-forms
- (symbol-value (intern-soft (format "diary-%s-date-forms" style))))
- (calendar-redraw)
- (calendar-update-mode-line))
- (defcustom diary-show-holidays-flag t
- "Non-nil means include holidays in the diary display.
- The holidays appear 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 makes the diary display faster."
- :type 'boolean
- :group 'holidays)
- (defcustom calendar-debug-sexp nil
- "Turn debugging on when evaluating a sexp in the diary or holiday list."
- :type 'boolean
- :group 'calendar)
- (defcustom calendar-hebrew-all-holidays-flag nil
- "If nil, show only major holidays from the Hebrew calendar.
- This means only those Jewish holidays that appear on secular calendars.
- Otherwise, show all the holidays that would appear in a complete Hebrew
- calendar."
- :type 'boolean
- :group 'holidays)
- (defcustom calendar-christian-all-holidays-flag nil
- "If nil, show only major holidays from the Christian calendar.
- This means only those Christian holidays that appear on secular calendars.
- Otherwise, show all the holidays that would appear in a complete Christian
- calendar."
- :type 'boolean
- :group 'holidays)
- (defcustom calendar-islamic-all-holidays-flag nil
- "If nil, show only major holidays from the Islamic calendar.
- This means only those Islamic holidays that appear on secular calendars.
- Otherwise, show all the holidays that would appear in a complete Islamic
- calendar."
- :type 'boolean
- :group 'holidays)
- (defcustom calendar-bahai-all-holidays-flag nil
- "If nil, show only major holidays from the Bahá’í calendar.
- These are the days on which work and school must be suspended.
- Otherwise, show all the holidays that would appear in a complete Bahá’í
- calendar."
- :type 'boolean
- :group 'holidays)
- (defcustom calendar-chinese-all-holidays-flag nil
- "If nil, show only the major holidays from the Chinese calendar."
- :version "23.1"
- :type 'boolean
- :group 'holidays)
- ;;; End of user options.
- (calendar-recompute-layout-variables)
- (defconst calendar-first-date-row 3
- "First row in the calendar with actual dates.")
- (defconst calendar-buffer "*Calendar*"
- "Name of the buffer used for the calendar.")
- (defconst holiday-buffer "*Holidays*"
- "Name of the buffer used for the displaying the holidays.")
- (defconst diary-fancy-buffer "*Fancy Diary Entries*"
- "Name of the buffer used for the optional fancy display of the diary.")
- (defconst calendar-other-calendars-buffer "*Other Calendars*"
- "Name of the buffer used for the display of date on other calendars.")
- (defconst lunar-phases-buffer "*Phases of Moon*"
- "Name of the buffer used for the lunar phases.")
- (defconst solar-sunrises-buffer "*Sunrise/Sunset Times*"
- "Name of buffer used for sunrise/sunset times.")
- (defconst calendar-hebrew-yahrzeit-buffer "*Yahrzeits*"
- "Name of the buffer used by `list-yahrzeit-dates'.")
- (defmacro calendar-increment-month (mon yr n &optional nmonths)
- "Increment the variables MON and YR by N months.
- Forward if N is positive or backward if N is negative.
- A negative YR is interpreted as BC; -1 being 1 BC, and so on.
- Optional NMONTHS is the number of months per year (default 12)."
- ;; Can view this as a form of base-nmonths arithmetic, in which "a
- ;; year" = "ten", and we never bother to use hundreds.
- `(let ((nmonths (or ,nmonths 12))
- macro-y)
- (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc
- (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n)
- ,mon (1+ (mod macro-y nmonths))
- ,yr (/ macro-y nmonths))
- ;; Alternative:
- ;;; (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n)
- ;;; ,yr (/ macro-y nmonths)
- ;;; ,mon (- macro-y (* ,yr nmonths)))
- (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
- (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
- (defvar displayed-month)
- (defvar displayed-year)
- (defun calendar-increment-month-cons (n &optional mon yr)
- "Return the Nth month after MON/YR.
- The return value is a pair (MONTH . YEAR).
- MON defaults to `displayed-month'. YR defaults to `displayed-year'."
- (unless mon (setq mon displayed-month))
- (unless yr (setq yr displayed-year))
- (calendar-increment-month mon yr n)
- (cons mon yr))
- (defmacro calendar-sum (index initial condition expression)
- "For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION."
- (declare (debug (symbolp form form form)))
- `(let ((,index ,initial)
- (sum 0))
- (while ,condition
- (setq sum (+ sum ,expression)
- ,index (1+ ,index)))
- sum))
- (defmacro calendar-in-read-only-buffer (buffer &rest body)
- "Switch to BUFFER and execute the forms in BODY.
- First creates or erases BUFFER as needed. Leaves BUFFER read-only,
- with disabled undo. Leaves point at point-min, displays BUFFER."
- (declare (indent 1) (debug t))
- `(progn
- (set-buffer (get-buffer-create ,buffer))
- (or (derived-mode-p 'special-mode) (special-mode))
- (setq buffer-read-only nil
- buffer-undo-list t)
- (erase-buffer)
- (display-buffer ,buffer)
- ,@body
- (goto-char (point-min))
- (set-buffer-modified-p nil)
- (setq buffer-read-only t)))
- ;; The following are in-line for speed; they can be called thousands of times
- ;; when looking up holidays or processing the diary. Here, for example, are
- ;; the numbers of calls to calendar/diary/holiday functions in preparing the
- ;; fancy diary display, for a moderately complex diary file, with functions
- ;; used instead of macros. There were a total of 10000 such calls:
- ;;
- ;; 1934 calendar-extract-month
- ;; 1852 calendar-extract-year
- ;; 1819 calendar-extract-day
- ;; 845 calendar-leap-year-p
- ;; 837 calendar-day-number
- ;; 775 calendar-absolute-from-gregorian
- ;; 346 calendar-last-day-of-month
- ;; 286 calendar-hebrew-last-day-of-month
- ;; 188 calendar-hebrew-leap-year-p
- ;; 180 calendar-hebrew-elapsed-days
- ;; 163 calendar-hebrew-last-month-of-year
- ;; 66 calendar-date-compare
- ;; 65 calendar-hebrew-days-in-year
- ;; 60 calendar-julian-to-absolute
- ;; 50 calendar-hebrew-to-absolute
- ;; 43 calendar-date-equal
- ;; 38 calendar-gregorian-from-absolute
- ;; .
- ;;
- ;; The use of these seven macros eliminates the overhead of 92% of the function
- ;; calls; it's faster this way.
- (defsubst calendar-extract-month (date)
- "Extract the month part of DATE which has the form (month day year)."
- (car date))
- ;; Note gives wrong answer for result of (calendar-read-date 'noday),
- ;; but that is only used by `calendar-other-month'.
- (defsubst calendar-extract-day (date)
- "Extract the day part of DATE which has the form (month day year)."
- (cadr date))
- (defsubst calendar-extract-year (date)
- "Extract the year part of DATE which has the form (month day year)."
- (nth 2 date))
- (defsubst calendar-leap-year-p (year)
- "Return t if YEAR is a Gregorian leap year.
- A negative year is interpreted as BC; -1 being 1 BC, and so on."
- ;; 1 BC = 0 AD, 2 BC acts like 1 AD, etc.
- (if (< year 0) (setq year (1- (abs 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:
- ;;
- ;;(defsubst calendar-leap-year-p (year)
- ;; "Return t if YEAR is a Gregorian leap year."
- ;; (or
- ;; (and (zerop (% year 4))
- ;; (not (zerop (% year 100))))
- ;; (zerop (% year 400)))
- (defsubst calendar-last-day-of-month (month year)
- "The last day in MONTH during YEAR."
- (if (and (= month 2) (calendar-leap-year-p year))
- 29
- (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
- ;; An explanation of the calculation can be found in PascAlgorithms by
- ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
- (defsubst calendar-day-number (date)
- "Return the day number within the year of the date DATE.
- For example, (calendar-day-number \\='(1 1 1987)) returns the value 1,
- while (calendar-day-number \\='(12 31 1980)) returns 366."
- (let* ((month (calendar-extract-month date))
- (day (calendar-extract-day date))
- (year (calendar-extract-year date))
- (day-of-year (+ day (* 31 (1- month)))))
- (when (> month 2)
- (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
- (if (calendar-leap-year-p year)
- (setq day-of-year (1+ day-of-year))))
- day-of-year))
- (defsubst 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.
- DATE is a list of the form (month day year). A negative year is
- interpreted as BC; -1 being 1 BC, and so on. Dates before 12/31/1 BC
- return negative results."
- (let ((year (calendar-extract-year date))
- offset-years)
- (cond ((zerop year)
- (user-error "There was no year zero"))
- ((> year 0)
- (setq offset-years (1- year))
- (+ (calendar-day-number date) ; days this year
- (* 365 offset-years) ; + days in prior years
- (/ offset-years 4) ; + Julian leap years
- (- (/ offset-ye…
Large files files are truncated, but you can click here to view the full file