;;; calendar.el --- calendar functions
;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Islamic calendar, to the Baha'i 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. When floating point is
-;; available, 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 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-china.el Chinese calendar
-;; cal-coptic.el Coptic/Ethiopic calendars
-;; cal-dst.el Daylight saving time rules
-;; cal-hebrew.el Hebrew calendar
-;; cal-islam.el Islamic calendar
-;; cal-bahai.el Baha'i 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 X-windows dedicated frame functions
-;; diary-lib.el Diary functions
-;; holidays.el Holiday functions
-;; lunar.el Phases of the moon
-;; solar.el Sunrise/sunset, equinoxes/solstices
+;; appt.el Appointment notification
+;; cal-bahai.el Baha'i 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
;; 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 generate-calendar, 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 list-sexp-diary-entries (qv)
+
+;; Bound in diary-list-entries:
+;; diary-entries-list: use in d-l, appt.el, and by add-to-diary-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:
-(defvar displayed-month)
-(defvar displayed-year)
-(defvar calendar-month-name-array)
-(defvar calendar-starred-day)
+;; (elisp) Eval During Compile: "Effectively `require' is
+;; automatically `eval-and-compile'" [but `load' is not]
+(eval-and-compile
+ (load "cal-loaddefs" nil 'quiet))
+
+;; Avoid recursive load of calendar when loading cal-menu.
+(provide 'calendar)
+(require 'cal-menu)
-(defun calendar-version ()
- (interactive)
- (message "Version 6, October 12, 1995"))
(defgroup calendar nil
"Calendar and time management support."
:group 'applications)
-(defgroup diary nil
- "Emacs diary."
+(defgroup calendar-hooks nil
+ "Calendar hooks."
+ :prefix "calendar-"
:group 'calendar)
-(defgroup appt nil
- "Appointment notification."
+(defgroup diary nil
+ "Emacs diary."
:group 'calendar)
(defgroup holidays nil
:prefix "calendar-"
:group 'local)
-(defgroup chinese-calendar nil
- "Chinese calendar support."
- :group 'calendar)
-(defgroup calendar-tex nil
- "Options for printing calendar with LaTeX."
- :prefix "cal-tex-"
+(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)
-(defgroup calendar-hooks nil
- "Calendar hooks."
- :prefix "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 `view-diary-entries-initially'."
+ :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 `generate-calendar-window' should use for calendar window."
+ :type 'integer
+ :version "22.1"
+ :group 'calendar)
-(defconst calendar-buffer "*Calendar*"
- "Name of the buffer used for the 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.
-;;;###autoload
-(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."
+If you change this variable directly (without using customize)
+after starting `calendar', you should call `redraw-calendar' 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)
+ (redraw-calendar))
:group 'calendar)
-;;;###autoload
(defcustom view-diary-entries-initially 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,
:type 'boolean
:group 'diary)
-;;;###autoload
(defcustom mark-diary-entries-in-calendar 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)
-;;;###autoload
-(defcustom calendar-remove-frame-by-deleting nil
+(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
- :group 'view)
+ :version "23.1" ; changed from nil to t
+ :group 'view
+ :group 'calendar)
+
+(defface calendar-today
+ '((t (:underline t)))
+ "Face for indicating today's date."
+ :group 'diary)
+;; Backward-compatibility alias. FIXME make obsolete.
+(put 'calendar-today-face 'face-alias 'calendar-today)
-(defvar diary-face 'diary
- "Face name to use for diary entries.")
(defface diary
'((((min-colors 88) (class color) (background light))
:foreground "red1")
:weight bold))
"Face for highlighting diary entries."
:group 'diary)
-;; backward-compatibility alias
+;; Backward-compatibility alias. FIXME make obsolete.
(put 'diary-face 'face-alias 'diary)
-(defface calendar-today
- '((t (:underline t)))
- "Face for indicating today's date."
- :group 'diary)
-;; backward-compatibility alias
-(put 'calendar-today-face 'face-alias 'calendar-today)
-
(defface holiday
'((((class color) (background light))
:background "pink")
:inverse-video t))
"Face for indicating dates that have holidays."
:group 'diary)
-;; backward-compatibility alias
+;; Backward-compatibility alias. FIXME make obsolete.
(put 'holiday-face 'face-alias 'holiday)
-(defcustom diary-entry-marker
- (if (not (display-color-p))
- "+"
- 'diary)
+(defcustom diary-entry-marker (if (display-color-p) 'diary "+")
"How to mark dates that have diary entries.
The value can be either a single-character string or a face."
:type '(choice string face)
:group 'diary)
-(defcustom calendar-today-marker
- (if (not (display-color-p))
- "="
- 'calendar-today)
+(defcustom calendar-today-marker (if (display-color-p) 'calendar-today "=")
"How to mark today's date in the calendar.
The value can be either a single-character string or a face.
-Marking today's date is done only if you set up `today-visible-calendar-hook'
-to request that."
+Used by `calendar-mark-today'."
:type '(choice string face)
:group 'calendar)
-(defcustom calendar-holiday-marker
- (if (not (display-color-p))
- "*"
- 'holiday)
+(defcustom calendar-holiday-marker (if (display-color-p) 'holiday "*")
"How to mark notable dates in the calendar.
The value can be either a single-character string or a face."
:type '(choice string face)
:group 'calendar)
-;;;###autoload
(defcustom view-calendar-holidays-initially 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
:type 'boolean
:group 'holidays)
-;;;###autoload
(defcustom mark-holidays-in-calendar 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)
-;;;###autoload
-(defcustom all-hebrew-calendar-holidays nil
- "If nil, show only major holidays from the Hebrew calendar.
-This means only those Jewish holidays that appear on secular calendars.
-
-If t, show all the holidays that would appear in a complete Hebrew calendar."
- :type 'boolean
- :group 'holidays)
-
-;;;###autoload
-(defcustom all-christian-calendar-holidays nil
- "If nil, show only major holidays from the Christian calendar.
-This means only those Christian holidays that appear on secular calendars.
-
-If t, show all the holidays that would appear in a complete Christian
-calendar."
- :type 'boolean
- :group 'holidays)
-
-;;;###autoload
-(defcustom all-islamic-calendar-holidays nil
- "If nil, show only major holidays from the Islamic calendar.
-This means only those Islamic holidays that appear on secular calendars.
-
-If t, show all the holidays that would appear in a complete Islamic
-calendar."
- :type 'boolean
- :group 'holidays)
-
-(defcustom diary-file-name-prefix-function (function (lambda (str) str))
- "The function that will take a diary file name and return the desired prefix."
- :type 'function
- :group 'diary)
-
-;;;###autoload
-(defcustom all-bahai-calendar-holidays nil
- "If nil, show only major holidays from the Baha'i calendar.
-These are the days on which work and school must be suspended.
-
-If t, show all the holidays that would appear in a complete Baha'i
-calendar."
- :type 'boolean
- :group 'holidays)
-
(defcustom calendar-mode-hook nil
"Hook run when entering `calendar-mode'."
:type 'hook
:group 'calendar-hooks)
-;;;###autoload
(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)
-;;;###autoload
(defcustom 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."
+ "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)
-;;;###autoload
(defcustom 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 can also be used to mark the current date with `calendar-today-marker';
-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."
+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 `today-invisible-calendar-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)
-;;;###autoload
(defcustom 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."
+See also `today-visible-calendar-hook'."
:type 'hook
:group 'calendar-hooks)
-;;;###autoload
(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)))
"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 `american-date-diary-pattern', by default:
+specified by the variable `diary-date-forms', which by default
+uses the forms of `american-date-diary-pattern':
MONTH/DAY
MONTH/DAY/YEAR
number and may be written in full or abbreviated to the final two
digits (if `abbreviated-calendar-year' 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'),
+`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,
-capitalized or not. 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.
-
-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 (see `european-date-diary-pattern') 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 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.
+`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: `american-date-diary-pattern',
+`european-date-diary-pattern', and `iso-date-diary-pattern'.
+You can choose between these by setting `calendar-date-style' in your
+.emacs 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.
%%(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', `diary-day-of-year',
-`diary-iso-date', `diary-french-date', `diary-hebrew-date',
-`diary-islamic-date', `diary-bahai-date', `diary-mayan-date',
-`diary-chinese-date', `diary-coptic-date', `diary-ethiopic-date',
-`diary-persian-date', `diary-yahrzeit', `diary-sunrise-sunset',
-`diary-phases-of-moon', `diary-parasha', `diary-omer',
-`diary-rosh-hodesh', and `diary-sabbath-candles'. See the
-documentation for the function `list-sexp-diary-entries' for more
-details.
+November 10, 1990. See the documentation for the function
+`list-sexp-diary-entries' for more details.
Diary entries based on the Hebrew, the Islamic and/or the Baha'i
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.
+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 `list-diary-entries-hook'."
:type 'file
:group 'diary)
-;;;###autoload
+;; 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)
-;;;###autoload
(defcustom hebrew-diary-entry-symbol "H"
"Symbol indicating a diary entry according to the Hebrew calendar."
:type 'string
:group 'diary)
-;;;###autoload
(defcustom islamic-diary-entry-symbol "I"
"Symbol indicating a diary entry according to the Islamic calendar."
:type 'string
:group 'diary)
-;;;###autoload
(defcustom bahai-diary-entry-symbol "B"
"Symbol indicating a diary entry according to the Baha'i calendar."
:type 'string
:group 'diary)
;;;###autoload
-(defcustom diary-include-string "#include"
- "The string indicating inclusion of another file of diary entries.
-See the documentation for the function `include-other-diary-files'."
- :type 'string
- :group 'diary)
-
-(defcustom diary-glob-file-regexp-prefix "^\\#"
- "The regular expression that gets pre-pended to each of the attribute-regexp's for file-wide specifiers."
- :type 'regexp
- :group 'diary)
-
-(defcustom diary-face-attrs
- '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string)
- (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string)
- (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol)
- (" *\\[height:\\([-0-9a-z]+\\)\\]$" 1 :height int)
- (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol)
- (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol)
- (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil)
- (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil)
- (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil)
- (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil)
- (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string)
- (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string)
- ;; Unsupported.
-;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box)
-;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple)
- )
- "A list of (regexp regnum attr attrtype) lists where the
-regexp says how to find the tag, the regnum says which
-parenthetical sub-regexp this regexp looks for, and the attr says
-which attribute of the face (or that this _is_ a face) is being
-modified."
- :type 'sexp
- :group 'diary)
+(defcustom european-calendar-style nil
+ "Non-nil means use the European style of dates in the diary and display.
+In this case, a date like 1/2/1990 would be interpreted as
+February 1, 1990. See `european-date-diary-pattern' for the
+default European diary date styles.
-(defcustom diary-file-name-prefix nil
- "If non-nil each diary entry is prefixed with the name of the file where it is defined."
+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'."
:type 'boolean
+ ;; Without :initialize (require 'calendar) throws an error because
+ ;; calendar-set-date-style is undefined at this point.
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (if value
+ (calendar-set-date-style 'european)
+ (calendar-set-date-style 'american)))
:group 'diary)
;;;###autoload
-(defcustom 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'."
- :type 'string
- :group 'diary)
-
-;;;###autoload
-(defcustom abbreviated-calendar-year t
- "Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
-For the Gregorian calendar; similarly for the Hebrew, Islamic and
-Baha'i calendars. If this variable is nil, years must be written in
-full."
- :type 'boolean
- :group 'diary)
+(make-obsolete-variable 'european-calendar-style 'calendar-date-style "23.1")
+;; Used by various other packages.
;;;###autoload
-(defcustom 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 default European date styles (see `european-date-diary-pattern')
-are
-
- DAY/MONTH
- DAY/MONTH/YEAR
- DAY MONTHNAME
- DAY MONTHNAME YEAR
- DAYNAME
-
-Names can be capitalized or not, written in full (as specified by the
-variable `calendar-day-name-array'), or abbreviated (as specified by
-`calendar-day-abbrev-array') with or without a period.
+(defcustom calendar-date-style (if european-calendar-style 'european
+ '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 functions `european-calendar' and
-`american-calendar'."
- :type 'boolean
- ;; Without :initialize (require 'calendar) throws an error because
- ;; american-calendar is undefined at this point.
+\\[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)
- (if value
- (european-calendar)
- (american-calendar)))
- :group 'diary)
+ (calendar-set-date-style value))
+ :group 'calendar)
+
+;; Next three are provided to aid in setting diary-date-forms.
+(defcustom iso-date-diary-pattern
+ '((month "[-/]" day "[^-/0-9]")
+ (year "[-/]" month "[-/]" day "[^0-9]")
+ (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.1"
+ :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)
-;;;###autoload
(defcustom 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 explanation."
+ "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)))))
+ :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)
-;;;###autoload
(defcustom european-date-diary-pattern
'((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 patterns of date used.
-See the documentation of `diary-date-forms' for an explanation."
+ "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)))))
+ :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)
-(autoload 'diary-font-lock-keywords "diary-lib")
-(autoload 'diary-live-p "diary-lib")
(defvar diary-font-lock-keywords)
-(defcustom diary-date-forms
- (if european-calendar-style
- european-date-diary-pattern
- american-date-diary-pattern)
+(defcustom diary-date-forms (cond ((eq calendar-date-style 'iso)
+ iso-date-diary-pattern)
+ ((eq calendar-date-style 'european)
+ european-date-diary-pattern)
+ (t 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 should not match
any portion of the diary entry itself, just the date component.
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."
+a portion of the first word of the diary entry.
+
+For examples of three common styles, see `american-date-diary-pattern',
+`european-date-diary-pattern', and `iso-date-diary-pattern'."
: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)))))
+ :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)))))
:initialize 'custom-initialize-default
:set (lambda (symbol value)
(unless (equal value (eval symbol))
(diary))))
:group 'diary)
-;;;###autoload
+;; Next three are provided to aid in setting calendar-date-display-form.
+(defcustom iso-calendar-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
+ :version "23.1"
+ :group 'calendar)
+
(defcustom european-calendar-display-form
'((if dayname (concat dayname ", ")) day " " monthname " " year)
"Pseudo-pattern governing the way a date appears in the European style.
-See the documentation of `calendar-date-display-form' for an explanation."
+Normally you should not customize this, but `calendar-date-display-form'
+\(which see)."
:type 'sexp
:group 'calendar)
-;;;###autoload
(defcustom american-calendar-display-form
'((if dayname (concat dayname ", ")) monthname " " day ", " year)
"Pseudo-pattern governing the way a date appears in the American style.
-See the documentation of `calendar-date-display-form' for an explanation."
+Normally you should not customize this, but `calendar-date-display-form'
+\(which see)."
:type 'sexp
:group 'calendar)
-(defcustom calendar-date-display-form
- (if european-calendar-style
- european-calendar-display-form
- american-calendar-display-form)
- "Pseudo-pattern governing the way a date appears.
-
-Used by the function `calendar-date-string', a pseudo-pattern is a list of
-expressions that can involve the keywords `month', `day', and `year', all
-numbers in string form, and `monthname' and `dayname', both alphabetic
-strings. For example, the ISO standard would use the pseudo- pattern
-
- '(year \"-\" month \"-\" day)
-
-while a typical American form would be
+(defcustom calendar-date-display-form (cond ((eq calendar-date-style 'iso)
+ iso-calendar-display-form)
+ ((eq calendar-date-style 'european)
+ european-calendar-display-form)
+ (t american-calendar-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))
-and
+whereas
'((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'."
+would give the usual American style in fixed-length fields. The variables
+`iso-calendar-display-form', `european-calendar-display-form', and
+`american-calendar-display-form' provide some defaults for three common
+styles."
:type 'sexp
:group 'calendar)
+(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 "%s-calendar-display-form" style)))
+ diary-date-forms
+ (symbol-value (intern-soft (format "%s-date-diary-pattern" style))))
+ (update-calendar-mode-line))
+
(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))
+ (calendar-set-date-style 'european))
+
+(make-obsolete 'european-calendar 'calendar-set-date-style "23.1")
(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))
-
-;;;###autoload
-(defcustom print-diary-entries-hook 'lpr-buffer
- "List of functions called after a temporary diary buffer is prepared.
-The buffer shows only the diary entries currently visible in the diary
-buffer. The default just does the printing. Other uses might include, for
-example, rearranging the lines into order by day and time, saving the buffer
-instead of deleting it, or changing the function used to do the printing."
- :type 'hook
- :group 'diary)
-
-;;;###autoload
-(defcustom list-diary-entries-hook nil
- "List of functions called after diary file is culled for relevant entries.
-It is to be used for diary entries that are not found in the diary file.
+ (calendar-set-date-style 'american))
-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
+(make-obsolete 'american-calendar 'calendar-set-date-style "23.1")
- #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 `mark-diary-entries-hook'.
-
-For example, you could use
-
- (setq list-diary-entries-hook
- '(include-other-diary-files sort-diary-entries))
- (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."
- :type 'hook
- :options '(include-other-diary-files sort-diary-entries)
- :group 'diary)
-
-;;;###autoload
+;; FIXME move to diary-lib and adjust appt.
+;; Add appt-make-list as an option?
(defcustom diary-hook nil
"List of functions called after the display of the diary.
Can be used for appointment notification."
:type 'hook
:group 'diary)
-(autoload 'diary-set-maybe-redraw "diary-lib")
-
-;;;###autoload
(defcustom diary-display-hook nil
"List of functions that handle the display of the diary.
-If nil (the default), `simple-diary-display' is used. Use `ignore' for no
-diary display.
-
-Ordinarily, this just displays the diary buffer (with holidays indicated in
-the mode line), if there are any relevant entries. At the time these
-functions are called, the variable `diary-entries-list' is a list, in order
-by date, of all relevant diary entries in the form of ((MONTH DAY YEAR)
-STRING), where string is the diary entry for the given date. This can be
-used, for example, 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."
+If nil (the default), `simple-diary-display' is used. Use
+`ignore' for no diary display.
+
+Ordinarily, this just displays the diary buffer (with holidays
+indicated in the mode line), if there are any relevant entries.
+At the time these functions are called, the variable
+`diary-entries-list' is a list, in order by date, of all relevant
+diary entries in the form of ((MONTH DAY YEAR) STRING), where
+string is the diary entry for the given date. This can be used,
+for example, a different buffer for display (perhaps combined
+with holidays), or produce hard copy output.
+
+A function `fancy-diary-display' is provided for use with 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' non-nil."
:type 'hook
:options '(fancy-diary-display)
:initialize 'custom-initialize-default
:set 'diary-set-maybe-redraw
:group 'diary)
-;;;###autoload
-(defcustom nongregorian-diary-listing-hook nil
- "List of functions called for listing diary file and included files.
-As the files are processed for diary entries, these functions are used
-to cull relevant entries. You can use either or both of
-`list-hebrew-diary-entries', `list-islamic-diary-entries' and
-`diary-bahai-list-entries'. The documentation for these functions
-describes the style of such diary entries."
- :type 'hook
- :options '(list-hebrew-diary-entries
- list-islamic-diary-entries
- diary-bahai-list-entries)
- :group 'diary)
-
-;;;###autoload
-(defcustom 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 `list-diary-entries-hook'."
- :type 'hook
- :options '(mark-included-diary-files)
- :group 'diary)
-
-;;;###autoload
-(defcustom nongregorian-diary-marking-hook nil
- "List of functions called for marking diary file and included files.
-As the files are processed for diary entries, these functions are used
-to cull relevant entries. You can use either or both of
-`mark-hebrew-diary-entries', `mark-islamic-diary-entries' and
-`mark-bahai-diary-entries'. The documentation for these functions
-describes the style of such diary entries."
- :type 'hook
- :options '(mark-hebrew-diary-entries
- mark-islamic-diary-entries
- diary-bahai-mark-entries)
- :group 'diary)
-
-;;;###autoload
-(defcustom 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 fancy diary buffer, even if they
-are holidays."
- :type 'boolean
- :group 'diary)
-
-;;;###autoload
(defcustom holidays-in-diary-buffer t
"Non-nil means include holidays in the diary display.
The holidays appear in the mode line of the diary buffer, or in the
:type 'boolean
:group 'holidays)
-(defvar calendar-mark-ring nil)
+(defcustom calendar-debug-sexp nil
+ "Turn debugging on when evaluating a sexp in the diary or holiday list."
+ :type 'boolean
+ :group 'calendar)
+
+;; The various holiday variables are autoloaded because people
+;; are used to using them to set calendar-holidays without having to
+;; explicitly load this file.
-;;;###autoload
-(put 'general-holidays 'risky-local-variable t)
;;;###autoload
(defcustom general-holidays
'((holiday-fixed 1 1 "New Year's Day")
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
-
;;;###autoload
-(put 'oriental-holidays 'risky-local-variable t)
+(put 'general-holidays 'risky-local-variable t)
+
;;;###autoload
(defcustom oriental-holidays
- '((if (fboundp 'atan)
- (holiday-chinese-new-year)))
+ '((holiday-chinese-new-year))
"Oriental holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
-
;;;###autoload
-(put 'local-holidays 'risky-local-variable t)
+(put 'oriental-holidays 'risky-local-variable t)
+
;;;###autoload
(defcustom local-holidays nil
"Local holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
-
;;;###autoload
-(put 'other-holidays 'risky-local-variable t)
+(put 'local-holidays 'risky-local-variable t)
+
;;;###autoload
(defcustom other-holidays nil
"User defined holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
-
;;;###autoload
-(put 'hebrew-holidays-1 'risky-local-variable t)
+(put 'other-holidays 'risky-local-variable t)
+
+(defcustom all-hebrew-calendar-holidays 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)
+
;;;###autoload
(defvar hebrew-holidays-1
'((holiday-rosh-hashanah-etc)
(if all-hebrew-calendar-holidays
(holiday-julian
11
- (let* ((m displayed-month)
- (y displayed-year)
- (year))
+ (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)"))))
-
+ (setq 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)")))
+ "Component of the default value of `hebrew-holidays'.")
;;;###autoload
-(put 'hebrew-holidays-2 'risky-local-variable t)
+(put 'hebrew-holidays-1 'risky-local-variable t)
+
;;;###autoload
(defvar hebrew-holidays-2
'((if all-hebrew-calendar-holidays
(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)
+ (if (= 6 (% (calendar-absolute-from-hebrew (list 10 10 h-year))
+ 7))
11 10))
"Tzom Teveth"))
(if all-hebrew-calendar-holidays
- (holiday-hebrew 11 15 "Tu B'Shevat"))))
+ (holiday-hebrew 11 15 "Tu B'Shevat")))
+ "Component of the default value of `hebrew-holidays'.")
+;;;###autoload
+(put 'hebrew-holidays-2 'risky-local-variable t)
-;;;###autoload
-(put 'hebrew-holidays-3 'risky-local-variable t)
;;;###autoload
(defvar hebrew-holidays-3
'((if all-hebrew-calendar-holidays
y)))))
(s-s
(calendar-hebrew-from-absolute
- (if (=
- (% (calendar-absolute-from-hebrew
- (list 7 1 h-year))
- 7)
- 6)
+ (if (= 6
+ (% (calendar-absolute-from-hebrew
+ (list 7 1 h-year))
+ 7))
(calendar-dayname-on-or-before
6 (calendar-absolute-from-hebrew
(list 11 17 h-year)))
(list 11 16 h-year))))))
(day (extract-calendar-day s-s)))
day))
- "Shabbat Shirah"))))
-
+ "Shabbat Shirah")))
+ "Component of the default value of `hebrew-holidays'.")
;;;###autoload
-(put 'hebrew-holidays-4 'risky-local-variable t)
+(put 'hebrew-holidays-3 'risky-local-variable t)
+
;;;###autoload
(defvar hebrew-holidays-4
'((holiday-passover-etc)
(if (and all-hebrew-calendar-holidays
- (let* ((m displayed-month)
- (y displayed-year)
- (year))
+ (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)))))
+ (setq year (extract-calendar-year
+ (calendar-julian-from-absolute
+ (calendar-absolute-from-gregorian
+ (list m 1 y)))))
+ (= 21 (% year 28))))
(holiday-julian 3 26 "Kiddush HaHamah"))
(if all-hebrew-calendar-holidays
- (holiday-tisha-b-av-etc))))
-
+ (holiday-tisha-b-av-etc)))
+ "Component of the default value of `hebrew-holidays'.")
;;;###autoload
-(put 'hebrew-holidays 'risky-local-variable t)
+(put 'hebrew-holidays-4 'risky-local-variable t)
+
;;;###autoload
(defcustom hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2
- hebrew-holidays-3 hebrew-holidays-4)
+ hebrew-holidays-3 hebrew-holidays-4)
"Jewish holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
-
;;;###autoload
-(put 'christian-holidays 'risky-local-variable t)
+(put 'hebrew-holidays 'risky-local-variable t)
+
+(defcustom all-christian-calendar-holidays 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)
+
;;;###autoload
(defcustom christian-holidays
'((if all-christian-calendar-holidays
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
-
;;;###autoload
-(put 'islamic-holidays 'risky-local-variable t)
+(put 'christian-holidays 'risky-local-variable t)
+
+(defcustom all-islamic-calendar-holidays 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)
+
;;;###autoload
(defcustom islamic-holidays
'((holiday-islamic
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
-
;;;###autoload
-(put 'bahai-holidays 'risky-local-variable t)
+(put 'islamic-holidays 'risky-local-variable t)
+
+(defcustom all-bahai-calendar-holidays nil
+ "If nil, show only major holidays from the Baha'i calendar.
+These are the days on which work and school must be suspended.
+Otherwise, show all the holidays that would appear in a complete Baha'i
+calendar."
+ :type 'boolean
+ :group 'holidays)
+
;;;###autoload
(defcustom bahai-holidays
'((holiday-fixed
(format "Baha'i New Year (Naw-Ruz) %d" (- displayed-year (1- 1844))))
(holiday-fixed 4 21 "First Day of Ridvan")
(if all-bahai-calendar-holidays
- (holiday-fixed 4 22 "Second Day of Ridvan"))
+ (holiday-fixed 4 22 "Second Day of Ridvan"))
(if all-bahai-calendar-holidays
- (holiday-fixed 4 23 "Third Day of Ridvan"))
+ (holiday-fixed 4 23 "Third Day of Ridvan"))
(if all-bahai-calendar-holidays
- (holiday-fixed 4 24 "Fourth Day of Ridvan"))
+ (holiday-fixed 4 24 "Fourth Day of Ridvan"))
(if all-bahai-calendar-holidays
- (holiday-fixed 4 25 "Fifth Day of Ridvan"))
+ (holiday-fixed 4 25 "Fifth Day of Ridvan"))
(if all-bahai-calendar-holidays
- (holiday-fixed 4 26 "Sixth Day of Ridvan"))
+ (holiday-fixed 4 26 "Sixth Day of Ridvan"))
(if all-bahai-calendar-holidays
- (holiday-fixed 4 27 "Seventh Day of Ridvan"))
+ (holiday-fixed 4 27 "Seventh Day of Ridvan"))
(if all-bahai-calendar-holidays
- (holiday-fixed 4 28 "Eighth Day of Ridvan"))
+ (holiday-fixed 4 28 "Eighth Day of Ridvan"))
(holiday-fixed 4 29 "Ninth Day of Ridvan")
(if all-bahai-calendar-holidays
- (holiday-fixed 4 30 "Tenth Day of Ridvan"))
+ (holiday-fixed 4 30 "Tenth Day of Ridvan"))
(if all-bahai-calendar-holidays
- (holiday-fixed 5 1 "Eleventh Day of Ridvan"))
+ (holiday-fixed 5 1 "Eleventh Day of Ridvan"))
(holiday-fixed 5 2 "Twelfth Day of Ridvan")
(holiday-fixed 5 23 "Declaration of the Bab")
(holiday-fixed 5 29 "Ascension of Baha'u'llah")
(holiday-fixed 10 20 "Birth of the Bab")
(holiday-fixed 11 12 "Birth of Baha'u'llah")
(if all-bahai-calendar-holidays
- (holiday-fixed 11 26 "Day of the Covenant"))
+ (holiday-fixed 11 26 "Day of the Covenant"))
(if all-bahai-calendar-holidays
- (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha")))
+ (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha")))
"Baha'i holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
-
;;;###autoload
-(put 'solar-holidays 'risky-local-variable t)
+(put 'bahai-holidays 'risky-local-variable t)
+
;;;###autoload
(defcustom solar-holidays
- '((if (fboundp 'atan)
- (solar-equinoxes-solstices))
- (if (progn
- (require 'cal-dst)
- t)
- (funcall
- 'holiday-sexp
- calendar-daylight-savings-starts
- '(format "Daylight Saving Time Begins %s"
- (if (fboundp 'atan)
- (solar-time-string
- (/ calendar-daylight-savings-starts-time (float 60))
- calendar-standard-time-zone-name)
- ""))))
- (funcall
- 'holiday-sexp
- calendar-daylight-savings-ends
- '(format "Daylight Saving Time Ends %s"
- (if (fboundp 'atan)
- (solar-time-string
- (/ calendar-daylight-savings-ends-time (float 60))
- calendar-daylight-time-zone-name)
- ""))))
+ '((solar-equinoxes-solstices)
+ (holiday-sexp calendar-daylight-savings-starts
+ (format "Daylight Saving Time Begins %s"
+ (solar-time-string
+ (/ calendar-daylight-savings-starts-time (float 60))
+ calendar-standard-time-zone-name)))
+ (holiday-sexp calendar-daylight-savings-ends
+ (format "Daylight Saving Time Ends %s"
+ (solar-time-string
+ (/ calendar-daylight-savings-ends-time (float 60))
+ calendar-daylight-time-zone-name))))
"Sun-related holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
+;;;###autoload
+(put 'solar-holidays 'risky-local-variable t)
;;;###autoload
-(put 'calendar-holidays 'risky-local-variable t)
(defcustom calendar-holidays
(append general-holidays local-holidays other-holidays
christian-holidays hebrew-holidays islamic-holidays
(((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... )."
:type 'sexp
:group 'holidays)
+;;;###autoload
+(put 'calendar-holidays 'risky-local-variable t)
+
+;;; End of user options.
+
+(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 lunar-phases-buffer "*Phases of Moon*"
"Name of the buffer used for the lunar phases.")
-(defmacro increment-calendar-month (mon yr n)
+(defconst cal-hebrew-yahrzeit-buffer "*Yahrzeits*"
+ "Name of the buffer used by `list-yahrzeit-dates'.")
+
+(defmacro increment-calendar-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."
- `(let (macro-y)
+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 12) ,mon -1 ,n)
- ,mon (1+ (mod macro-y 12))
- ,yr (/ macro-y 12))
+ (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 (n &optional mon yr)
"Return the Nth month after MON/YR.
The return value is a pair (MONTH . YEAR).
(defmacro calendar-for-loop (var from init to final do &rest body)
"Execute a for loop.
Evaluate BODY with VAR bound to successive integers from INIT to FINAL,
-inclusive."
- (declare (debug (symbolp "from" form "to" form "do" body)))
+inclusive. The standard macro `dotimes' is preferable in most cases."
+ (declare (debug (symbolp "from" form "to" form "do" body))
+ (indent defun))
`(let ((,var (1- ,init)))
(while (>= ,final (setq ,var (1+ ,var)))
,@body)))
(defmacro calendar-sum (index initial condition expression)
- "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
+ "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))
- (setq ,index (1+ ,index)))
+ (setq sum (+ sum ,expression)
+ ,index (1+ ,index)))
sum))
+;; FIXME bind q to bury-buffer?
+(defmacro calendar-in-read-only-buffer (buffer &rest body)
+ "Switch to BUFFER and executes 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))
+ (setq buffer-read-only nil
+ buffer-undo-list t)
+ (erase-buffer)
+ ,@body
+ (goto-char (point-min))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (display-buffer ,buffer)))
+
;; 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
;; 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 extract-calendar-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).
-(defsubst extract-calendar-day (date)
- "Extract the day part of DATE which has the form (month day year)."
- (car (cdr date)))
-
-(defsubst extract-calendar-year (date)
- "Extract the year part of DATE which has the form (month day year)."
- (car (cdr (cdr 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)
-;; "Returns t if YEAR is a Gregorian leap year."
-;; (or
-;; (and (= (% year 4) 0)
-;; (/= (% year 100) 0))
-;; (= (% year 400) 0)))
-
-(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 (extract-calendar-month date))
- (day (extract-calendar-day date))
- (year (extract-calendar-year date))
- (day-of-year (+ day (* 31 (1- month)))))
- (if (> month 2)
- (progn
- (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 (extract-calendar-year date))
- offset-years)
- (cond ((= year 0)
- (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-years 100)) ; - century years
- (/ offset-years 400))) ; + Gregorian leap years
- (t
- ;; Years between date and 1 BC, excluding 1 BC (1 for 2 BC, etc).
- (setq offset-years (abs (1+ year)))
- (- (calendar-day-number date)
- (* 365 offset-years)
- (/ offset-years 4)
- (- (/ offset-years 100))
- (/ offset-years 400)
- (calendar-day-number '(12 31 -1))))))) ; days in year 1 BC
-
-(autoload 'calendar-goto-today "cal-move"
- "Reposition the calendar window so the current date is visible."
- t)
-
-(autoload 'calendar-forward-month "cal-move"
- "Move the cursor forward ARG months."
- t)
-
-(autoload 'calendar-forward-year "cal-move"
- "Move the cursor forward by ARG years."
- t)
-
-(autoload 'calendar-backward-month "cal-move"
- "Move the cursor backward by ARG months."
- t)
-
-(autoload 'calendar-backward-year "cal-move"
- "Move the cursor backward ARG years."
- t)
-
-(autoload 'calendar-scroll-left "cal-move"
- "Scroll the displayed calendar left by ARG months."
- t)
-
-(autoload 'calendar-scroll-right "cal-move"
- "Scroll the displayed calendar window right by ARG months."
- t)
-
-(autoload 'calendar-scroll-left-three-months "cal-move"
- "Scroll the displayed calendar window left by 3*ARG months."
- t)
-
-(autoload 'calendar-scroll-right-three-months "cal-move"
- "Scroll the displayed calendar window right by 3*ARG months."
- t)
-
-(autoload 'calendar-cursor-to-nearest-date "cal-move"
- "Move the cursor to the closest date."
- t)
-
-(autoload 'calendar-forward-day "cal-move"
- "Move the cursor forward ARG days."
- t)
-
-(autoload 'calendar-backward-day "cal-move"
- "Move the cursor back ARG days."
- t)
-
-(autoload 'calendar-forward-week "cal-move"
- "Move the cursor forward ARG weeks."
- t)
-
-(autoload 'calendar-backward-week "cal-move"
- "Move the cursor back ARG weeks."
- t)
-
-(autoload 'calendar-beginning-of-week "cal-move"
- "Move the cursor back ARG calendar-week-start-day's."
- t)
-
-(autoload 'calendar-end-of-week "cal-move"
- "Move the cursor forward ARG calendar-week-start-day+6's."
- t)
-
-(autoload 'calendar-beginning-of-month "cal-move"
- "Move the cursor backward ARG month beginnings."
- t)
-
-(autoload 'calendar-end-of-month "cal-move"
- "Move the cursor forward ARG month ends."
- t)
-
-(autoload 'calendar-beginning-of-year "cal-move"
- "Move the cursor backward ARG year beginnings."
- t)
-
-(autoload 'calendar-end-of-year "cal-move"
- "Move the cursor forward ARG year beginnings."
- t)
-
-(autoload 'calendar-cursor-to-visible-date "cal-move"
- "Move the cursor to DATE that is on the screen."
- t)
-
-(autoload 'calendar-goto-date "cal-move"
- "Move cursor to DATE."
- t)
-
-(autoload 'calendar-goto-day-of-year "cal-move"
- "Move cursor to day of year."
- t)
-
-(autoload 'calendar-only-one-frame-setup "cal-x"
- "Start calendar and display it in a dedicated frame.")
-
-(autoload 'calendar-one-frame-setup "cal-x"
- "Start calendar and display it in a dedicated frame together with the diary.")
-
-(autoload 'calendar-two-frame-setup "cal-x"
- "Start calendar and diary in separate, dedicated frames.")
-
-;;;###autoload
-(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 `view-diary-entries-initially'."
- :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 `generate-calendar-window' should use for calendar window."
- :type 'integer
- :version "22.1"
- :group 'calendar)
-
-;;;###autoload
-(defun calendar (&optional arg)
- "Choose between the one frame, two frame, or basic calendar displays.
-If called with an optional prefix argument, prompts for month and year.
-
-The original function `calendar' has been renamed `calendar-basic-setup'.
-See the documentation of that function for more information."
- (interactive "P")
- (cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg))
- ((equal calendar-setup 'two-frames) (calendar-two-frame-setup arg))
- ((equal calendar-setup 'calendar-only)
- (calendar-only-one-frame-setup arg))
- (t (calendar-basic-setup arg))))
-
-(autoload 'diary-view-entries "diary-lib"
- "Prepare and display a buffer with diary entries.
-Searches your diary file for entries that match ARG days starting with
-the date indicated by the cursor position in the displayed three-month
-calendar."
- t)
-
-(autoload 'calendar-list-holidays "holidays"
- "Create a buffer containing the holidays for the current calendar window.
-The holidays are those in the list `calendar-notable-days'. Returns t if any
-holidays are found, nil if not."
- t)
-
-(defun calendar-basic-setup (&optional arg)
- "Display a three-month calendar in another window.
-The three months appear side by side, with the current month in the middle
-surrounded by the previous and next months. The cursor is put on today's date.
-
-If called with an optional prefix argument, prompts for month and year.
-
-This function is suitable for execution in a .emacs file; appropriate setting
-of the variable `view-diary-entries-initially' will cause the diary entries for
-the current date to be displayed in another window. The value of the variable
-`number-of-diary-entries' controls the number of days of diary entries
-displayed upon initial display of the calendar.
-
-Once in the calendar window, future or past months can be moved into view.
-Arbitrary months can be displayed, or the calendar can be scrolled forward
-or backward.
-
-The cursor can be moved forward or backward by one day, one week, one month,
-or one year. All of these commands take prefix arguments which, when negative,
-cause movement in the opposite direction. For convenience, the digit keys
-and the minus sign are automatically prefixes. The window is replotted as
-necessary to display the desired date.
-
-Diary entries can be marked on the calendar or displayed in another window.
-
-Use \\[describe-mode] for details of the key bindings in the calendar window.
-
-The Gregorian calendar is assumed.
-
-After loading the calendar, the hooks given by the variable
-`calendar-load-hook' are run. This is the place to add key bindings to the
-calendar-mode-map.
-
-After preparing the calendar window initially, the hooks given by the variable
-`initial-calendar-window-hook' are run.
-
-The hooks given by the variable `today-visible-calendar-hook' are run
-every time the calendar window gets scrolled, if the current date is visible
-in the window. If it is not visible, the hooks given by the variable
-`today-invisible-calendar-hook' are run. Thus, for example, setting
-`today-visible-calendar-hook' to 'calendar-star-date will cause today's date
-to be replaced by asterisks to highlight it whenever it is in the window."
- (interactive "P")
- (set-buffer (get-buffer-create calendar-buffer))
- (calendar-mode)
- (let* ((pop-up-windows t)
- (split-height-threshold 1000)
- (date (if arg
- (calendar-read-date t)
- (calendar-current-date)))
- (month (extract-calendar-month date))
- (year (extract-calendar-year date)))
- ;; (calendar-read-date t) returns a date with day = nil, which is
- ;; not a legal date for the visible test in the diary section.
- (if arg (setcar (cdr date) 1))
- (increment-calendar-month month year (- calendar-offset))
- ;; Display the buffer before calling generate-calendar-window so that it
- ;; can get a chance to adjust the window sizes to the frame size.
- (pop-to-buffer calendar-buffer)
- (generate-calendar-window month year)
- (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
- (diary-view-entries)))
- (let* ((diary-buffer (get-file-buffer diary-file))
- (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
- (split-height-threshold (if diary-window 2 1000)))
- (if view-calendar-holidays-initially
- (calendar-list-holidays)))
- (run-hooks 'initial-calendar-window-hook))
-
-(autoload 'view-other-diary-entries "diary-lib"
- "Prepare and display buffer of diary entries from an alternative diary file.
-Searches for entries that match ARG days, starting with the date indicated
-by the cursor position in the displayed three-month calendar.
-D-FILE specifies the file to use as the diary file."
- t)
-
-(autoload 'calendar-sunrise-sunset "solar"
- "Local time of sunrise and sunset for date under cursor."
- t)
-
-(autoload 'calendar-phases-of-moon "lunar"
- "Create a buffer of the phases of the moon for the current calendar window."
- t)
-
-(autoload 'calendar-print-french-date "cal-french"
- "Show the French Revolutionary calendar equivalent of the date under the cursor."
- t)
-
-(autoload 'calendar-goto-french-date "cal-french"
- "Move cursor to French Revolutionary date."
- t)
-
-(autoload 'calendar-french-date-string "cal-french"
- "String of French Revolutionary date of Gregorian date.")
-
-(autoload 'calendar-mayan-date-string "cal-mayan"
- "String of Mayan date of Gregorian date.")
-
-(autoload 'calendar-print-mayan-date "cal-mayan"
- "Show the Mayan long count, Tzolkin, and Haab equivalents of the date under the cursor."
- t)
-
-(autoload 'calendar-goto-mayan-long-count-date "cal-mayan"
- "Move cursor to Mayan long count date."
- t)
-
-(autoload 'calendar-next-haab-date "cal-mayan"
- "Move cursor to next instance of Mayan Haab date."
- t)
-
-(autoload 'calendar-previous-haab-date "cal-mayan"
- "Move cursor to previous instance of Mayan Haab date."
- t)
-
-(autoload 'calendar-next-tzolkin-date "cal-mayan"
- "Move cursor to next instance of Mayan Tzolkin date."
- t)
-
-(autoload 'calendar-previous-tzolkin-date "cal-mayan"
- "Move cursor to previous instance of Mayan Tzolkin date."
- t)
-
-(autoload 'calendar-next-calendar-round-date "cal-mayan"
- "Move cursor to next instance of Mayan Haab/Tzolkin combination."
- t)
-
-(autoload 'calendar-previous-calendar-round-date "cal-mayan"
- "Move cursor to previous instance of Mayan Haab/Tzolkin combination."
- t)
-
-(autoload 'calendar-goto-chinese-date "cal-china"
- "Move cursor to Chinese date."
- t)
-
-(autoload 'calendar-print-chinese-date "cal-china"
- "Show the Chinese date equivalents of date."
- t)
-
-(autoload 'calendar-chinese-date-string "cal-china"
- "String of Chinese date of Gregorian date.")
-
-(autoload 'calendar-absolute-from-astro "cal-julian"
- "Absolute date of astronomical (Julian) day number D."
- t )
-
-(autoload 'calendar-astro-from-absolute "cal-julian"
- "Astronomical (Julian) day number of absolute date D.")
-
-(autoload 'calendar-astro-date-string "cal-julian"
- "String of astronomical (Julian) day number of Gregorian date.")
-
-(autoload 'calendar-goto-astro-day-number "cal-julian"
- "Move cursor to astronomical (Julian) day number."
- t)
-
-(autoload 'calendar-print-astro-day-number "cal-julian"
- "Show the astro date equivalents of date."
- t)
-
-(autoload 'calendar-julian-from-absolute "cal-julian"
- "Compute the Julian (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.")
-
-(autoload 'calendar-goto-julian-date "cal-julian"
- "Move cursor to Julian DATE; echo Julian date unless NOECHO is t."
- t)
-
-(autoload 'calendar-print-julian-date "cal-julian"
- "Show the Julian calendar equivalent of the date under the cursor."
- t)
-
-(autoload 'calendar-julian-date-string "cal-julian"
- "String of Julian date of Gregorian DATE.
-Defaults to today's date if DATE is not given.
-Driven by the variable `calendar-date-display-form'.")
-
-(autoload 'calendar-goto-iso-date "cal-iso"
- "Move cursor to ISO date."
- t)
-
-(autoload 'calendar-goto-iso-week "cal-iso"
- "Move cursor to start of ISO week."
- t)
-
-(autoload 'calendar-print-iso-date "cal-iso"
- "Show the ISO date equivalents of date."
- t)
-
-(autoload 'calendar-iso-date-string "cal-iso"
- "String of ISO date of Gregorian date.")
-
-(autoload 'calendar-goto-islamic-date "cal-islam"
- "Move cursor to Islamic date."
- t)
-
-(autoload 'calendar-print-islamic-date "cal-islam"
- "Show the Islamic date equivalents of date."
- t)
-
-(autoload 'calendar-islamic-date-string "cal-islam"
- "String of Islamic date of Gregorian date.")
-
-(autoload 'calendar-bahai-goto-date "cal-bahai"
- "Move cursor to Baha'i date DATE.
-Echo Baha'i date unless NOECHO is t."
- t)
-
-(autoload 'calendar-print-bahai-date "cal-bahai"
- "Show the Baha'i date equivalents of date."
- t)
-
-(autoload 'calendar-bahai-date-string "cal-bahai"
- "String of Baha'i date of Gregorian date.")
-
-(autoload 'calendar-goto-hebrew-date "cal-hebrew"
- "Move cursor to Hebrew date."
- t)
-
-(autoload 'calendar-print-hebrew-date "cal-hebrew"
- "Show the Hebrew date equivalents of date."
- t)
-
-(autoload 'calendar-hebrew-date-string "cal-hebrew"
- "String of Hebrew date of Gregorian date.")
-
-(autoload 'calendar-goto-coptic-date "cal-coptic"
- "Move cursor to Coptic date."
- t)
-
-(autoload 'calendar-print-coptic-date "cal-coptic"
- "Show the Coptic date equivalents of date."
- t)
-
-(autoload 'calendar-coptic-date-string "cal-coptic"
- "String of Coptic date of Gregorian date.")
-
-(autoload 'calendar-goto-ethiopic-date "cal-coptic"
- "Move cursor to Ethiopic date."
- t)
-
-(autoload 'calendar-print-ethiopic-date "cal-coptic"
- "Show the Ethiopic date equivalents of date."
- t)
-
-(autoload 'calendar-ethiopic-date-string "cal-coptic"
- "String of Ethiopic date of Gregorian date.")
-
-(autoload 'calendar-goto-persian-date "cal-persia"
- "Move cursor to Persian date."
- t)
-
-(autoload 'calendar-print-persian-date "cal-persia"
- "Show the Persian date equivalents of date."
- t)
-
-(autoload 'calendar-persian-date-string "cal-persia"
- "String of Persian date of Gregorian date.")
-
-(autoload 'diary-show-all-entries "diary-lib"
- "Show all of the diary entries in the diary file.
-This function gets rid of the selective display of the diary file so that
-all entries, not just some, are visible. If there is no diary buffer, one
-is created."
- t)
-
-(autoload 'mark-diary-entries "diary-lib"
- "Mark days in the calendar window that have diary entries.
-Each entry in diary file visible in the calendar window is marked."
- t)
-
-(autoload 'make-diary-entry "diary-lib"
- "Insert a diary entry STRING which may be NONMARKING in FILE.")
-
-(autoload 'insert-diary-entry "diary-lib"
- "Insert a diary entry for the date indicated by point."
- t)
-
-(autoload 'insert-weekly-diary-entry "diary-lib"
- "Insert a weekly diary entry for the day of the week indicated by point."
- t)
-
-
-(autoload 'insert-monthly-diary-entry "diary-lib"
- "Insert a monthly diary entry for the day of the month indicated by point."
- t)
-
-(autoload 'insert-yearly-diary-entry "diary-lib"
- "Insert an annual diary entry for the day of the year indicated by point."
- t)
-
-(autoload 'insert-anniversary-diary-entry "diary-lib"
- "Insert an anniversary diary entry for the date indicated by point."
- t)
-
-(autoload 'insert-block-diary-entry "diary-lib"
- "Insert a block diary entry for the dates indicated by point and mark."
- t)
-
-(autoload 'insert-cyclic-diary-entry "diary-lib"
- "Insert a cyclic diary entry starting at the date indicated by point."
- t)
-
-(autoload 'insert-hebrew-diary-entry "cal-hebrew"
- "Insert a diary entry for the Hebrew date corresponding to the date
-indicated by point."
- t)
+;;
+;; The use of these seven macros eliminates the overhead of 92% of the function
+;; calls; it's faster this way.
-(autoload 'insert-monthly-hebrew-diary-entry "cal-hebrew"
- "Insert a monthly diary entry for the day of the Hebrew month corresponding
-to the date indicated by point."
- t)
+(defsubst extract-calendar-month (date)
+ "Extract the month part of DATE which has the form (month day year)."
+ (car date))
-(autoload 'insert-yearly-hebrew-diary-entry "cal-hebrew"
- "Insert an annual diary entry for the day of the Hebrew year corresponding
-to the date indicated by point."
- t)
+;; Note gives wrong answer for result of (calendar-read-date 'noday),
+;; but that is only used by `calendar-other-month'.
+(defsubst extract-calendar-day (date)
+ "Extract the day part of DATE which has the form (month day year)."
+ (cadr date))
-(autoload 'insert-islamic-diary-entry "cal-islam"
- "Insert a diary entry for the Islamic date corresponding to the date
-indicated by point."
- t)
+(defsubst extract-calendar-year (date)
+ "Extract the year part of DATE which has the form (month day year)."
+ (nth 2 date))
-(autoload 'insert-monthly-islamic-diary-entry "cal-islam"
- "Insert a monthly diary entry for the day of the Islamic month corresponding
-to the date indicated by point."
- t)
+(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)))))
-(autoload 'insert-yearly-islamic-diary-entry "cal-islam"
- "Insert an annual diary entry for the day of the Islamic year corresponding
-to the date indicated by point."
- t)
+;; 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)))
-(autoload 'diary-bahai-insert-entry "cal-bahai"
- "Insert a diary entry for the Baha'i date corresponding to the date
-indicated by point."
- t)
+(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))))
-(autoload 'diary-bahai-insert-monthly-entry "cal-bahai"
- "Insert a monthly diary entry for the day of the Baha'i month corresponding
-to the date indicated by point."
- t)
+;; An explanation of the calculation can be found in PascAlgorithms by
+;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
-(autoload 'diary-bahai-insert-yearly-entry "cal-bahai"
- "Insert an annual diary entry for the day of the Baha'i year corresponding
-to the date indicated by point."
- t)
+(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 (extract-calendar-month date))
+ (day (extract-calendar-day date))
+ (year (extract-calendar-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))
-(autoload 'cal-tex-cursor-month "cal-tex"
- "Make a buffer with LaTeX commands for the month cursor is on.
-Optional prefix argument specifies number of months to be produced.
-Calendar is condensed onto one page." t)
-
-(autoload 'cal-tex-cursor-month-landscape "cal-tex"
- "Make a buffer with LaTeX commands for the month cursor is on.
-Optional prefix argument specifies number of months to be produced." t)
-
-(autoload 'cal-tex-cursor-day "cal-tex"
- "Make a buffer with LaTeX commands for the day cursor is on." t)
-
-(autoload 'cal-tex-cursor-week "cal-tex"
- "Make a buffer with LaTeX commands for a two-page one-week calendar.
-It applies to the week that point is in.
-Optional prefix argument specifies number of weeks.
-Holidays are included if `cal-tex-holidays' is t." t)
-
-(autoload 'cal-tex-cursor-week2 "cal-tex"
- "Make a buffer with LaTeX commands for a two-page one-week calendar.
-It applies to the week that point is in.
-Optional prefix argument specifies number of weeks.
-Holidays are included if `cal-tex-holidays' is t." t)
-
-(autoload 'cal-tex-cursor-week-iso "cal-tex"
- "Make a buffer with LaTeX commands for a one page ISO-style weekly calendar.
-Optional prefix argument specifies number of weeks.
-Diary entries are included if `cal-tex-diary' is t.
-Holidays are included if `cal-tex-holidays' is t." t)
-
-(autoload 'cal-tex-cursor-week-monday "cal-tex"
- "Make a buffer with LaTeX commands for a two-page one-week calendar.
-It applies to the week that point is in, and starts on Monday.
-Optional prefix argument specifies number of weeks.
-Holidays are included if `cal-tex-holidays' is t." t)
-
-(autoload 'cal-tex-cursor-filofax-2week "cal-tex"
- "Two-weeks-at-a-glance Filofax style calendar for week indicated by cursor.
-Optional prefix argument specifies number of weeks.
-Diary entries are included if cal-tex-diary is t.
-Holidays are included if `cal-tex-holidays' is t." t)
-
-(autoload 'cal-tex-cursor-filofax-week "cal-tex"
- "One-week-at-a-glance Filofax style calendar for week indicated by cursor.
-Optional prefix argument specifies number of weeks.
-Weeks start on Monday.
-Diary entries are included if cal-tex-diary is t.
-Holidays are included if `cal-tex-holidays' is t." t)
-
-(autoload 'cal-tex-cursor-filofax-daily "cal-tex"
- "Day-per-page Filofax style calendar for week indicated by cursor.
-Optional prefix argument specifies number of weeks. Weeks start on Monday.
-Diary entries are included if `cal-tex-diary' is t.
-Holidays are included if `cal-tex-holidays' is t." t)
-
-(autoload 'cal-tex-cursor-year "cal-tex"
- "Make a buffer with LaTeX commands for a year's calendar.
-Optional prefix argument specifies number of years." t)
-
-(autoload 'cal-tex-cursor-year-landscape "cal-tex"
- "Make a buffer with LaTeX commands for a year's calendar (landscape).
-Optional prefix argument specifies number of years." t)
-
-(autoload 'cal-tex-cursor-filofax-year "cal-tex"
- "Make a buffer with LaTeX commands for a year's calendar (Filofax).
-Optional prefix argument specifies number of years." t)
-
-(autoload 'cal-html-cursor-month "cal-html"
- "Write an HTML calendar file for numeric MONTH of four-digit YEAR.
-The output directory DIR is created if necessary. Interactively,
-MONTH and YEAR are taken from the calendar cursor position. Note
-that any existing output files are overwritten." t)
-
-(autoload 'cal-html-cursor-year "cal-html"
- "Write HTML calendar files (index and monthly pages) for four-digit YEAR.
-The output directory DIR is created if necessary. Interactively,
-YEAR is taken from the calendar cursor position. Note that any
-existing output files are overwritten." t)
-
-(autoload 'mark-calendar-holidays "holidays"
- "Mark notable days in the calendar window."
- t)
+(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 (extract-calendar-year date))
+ offset-years)
+ (cond ((zerop year)
+ (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-years 100)) ; - century years
+ (/ offset-years 400))) ; + Gregorian leap years
+ (t
+ ;; Years between date and 1 BC, excluding 1 BC (1 for 2 BC, etc).
+ (setq offset-years (abs (1+ year)))
+ (- (calendar-day-number date)
+ (* 365 offset-years)
+ (/ offset-years 4)
+ (- (/ offset-years 100))
+ (/ offset-years 400)
+ (calendar-day-number '(12 31 -1))))))) ; days in year 1 BC
-(autoload 'calendar-cursor-holidays "holidays"
- "Find holidays for the date specified by the cursor in the calendar window."
- t)
+;;;###autoload
+(defun calendar (&optional arg)
+ "Display a three-month Gregorian calendar.
+The three months appear side by side, with the current month in
+the middle surrounded by the previous and next months. The
+cursor is put on today's date. If optional prefix argument ARG
+is non-nil, prompts for the central month and year.
+
+Once in the calendar window, future or past months can be moved
+into view. Arbitrary months can be displayed, or the calendar
+can be scrolled forward or backward. The cursor can be moved
+forward or backward by one day, one week, one month, or one year.
+All of these commands take prefix arguments which, when negative,
+cause movement in the opposite direction. For convenience, the
+digit keys and the minus sign are automatically prefixes. Use
+\\[describe-mode] for details of the key bindings in the calendar
+window.
+
+Displays the calendar in a separate window, or optionally in a
+separate frame, depending on the value of `calendar-setup'.
+
+If `view-diary-entries-initially' is non-nil, also displays the
+diary entries for the current date (or however many days
+`number-of-diary-entries' specifies). This variable can be
+overridden by `calendar-setup'. As well as being displayed,
+diary entries can also be marked on the calendar (see
+`mark-diary-entries-in-calendar').
+
+Runs the following hooks:
+
+`calendar-load-hook' - after loading calendar.el
+`today-visible-calendar-hook', `today-invisible-calendar-hook' - after
+ generating a calendar, if today's date is visible or not, respectively
+`initial-calendar-window-hook' - after first creating a calendar
+
+This function is suitable for execution in a .emacs file."
+ (interactive "P")
+ ;; Avoid loading cal-x unless it will be used.
+ (if (and (memq calendar-setup '(one-frame two-frames calendar-only))
+ (display-multi-frame-p))
+ (calendar-frame-setup calendar-setup arg)
+ (calendar-basic-setup arg)))
+
+(defun calendar-basic-setup (&optional arg nodisplay)
+ "Create a three-month calendar.
+If optional prefix argument ARG is non-nil, prompts for the month
+and year, else uses the current date. If NODISPLAY is non-nil, don't
+display the generated calendar."
+ (interactive "P")
+ (set-buffer (get-buffer-create calendar-buffer))
+ (calendar-mode)
+ (let* ((pop-up-windows t)
+ (split-height-threshold 1000)
+ (date (if arg (calendar-read-date t)
+ (calendar-current-date)))
+ (month (extract-calendar-month date))
+ (year (extract-calendar-year date)))
+ (increment-calendar-month month year (- calendar-offset))
+ ;; Display the buffer before calling generate-calendar-window so that it
+ ;; can get a chance to adjust the window sizes to the frame size.
+ (or nodisplay (pop-to-buffer calendar-buffer))
+ (generate-calendar-window month year)
+ (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
+ (diary-view-entries)))
+ (if view-calendar-holidays-initially
+ (let* ((diary-buffer (get-file-buffer diary-file))
+ (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
+ (split-height-threshold (if diary-window 2 1000)))
+ ;; FIXME display buffer?
+ (calendar-list-holidays)))
+ (run-hooks 'initial-calendar-window-hook))
(defun generate-calendar-window (&optional mon yr)
"Generate the calendar window for the current date.
-Or, for optional MON, YR."
+Optional integers MON and YR are used instead of today's date."
(let* ((inhibit-read-only t)
(today (calendar-current-date))
(month (extract-calendar-month today))
(if today-visible today (list displayed-month 1 displayed-year)))
(set-buffer-modified-p nil)
;; Don't do any window-related stuff if we weren't called from a
- ;; window displaying the calendar
+ ;; window displaying the calendar.
(when in-calendar-window
(if (or (one-window-p t) (not (window-full-width-p)))
;; Don't mess with the window size, but ensure that the first
- ;; line is fully visible
+ ;; line is fully visible.
(set-window-vscroll nil 0)
- ;; Adjust the window to exactly fit the displayed calendar
+ ;; Adjust the window to exactly fit the displayed calendar.
(fit-window-to-buffer nil nil calendar-minimum-window-height))
(sit-for 0))
(if (and (boundp 'font-lock-mode)
- font-lock-mode)
- (font-lock-fontify-buffer))
+ font-lock-mode)
+ (font-lock-fontify-buffer))
(and mark-holidays-in-calendar
-;;; (calendar-date-is-legal-p today) ; useful for BC dates
- (mark-calendar-holidays)
+;;; (calendar-date-is-valid-p today) ; useful for BC dates
+ (calendar-mark-holidays)
(and in-calendar-window (sit-for 0)))
(unwind-protect
(if mark-diary-entries-in-calendar (mark-diary-entries))
located, but indented INDENT spaces. The indentation is done from the first
character on the line and does not disturb the first INDENT characters on the
line."
- (let* ((blank-days;; at start of month
- (mod
- (- (calendar-day-of-week (list month 1 year))
- calendar-week-start-day)
- 7))
- (last (calendar-last-day-of-month month year)))
+ (let ((blank-days ; at start of month
+ (mod
+ (- (calendar-day-of-week (list month 1 year))
+ calendar-week-start-day)
+ 7))
+ (last (calendar-last-day-of-month month year)))
(goto-char (point-min))
(calendar-insert-indented
(calendar-string-spread
(list (format "%s %d" (calendar-month-name month) year)) ? 20)
indent t)
- (calendar-insert-indented "" indent);; Go to proper spot
+ (calendar-insert-indented "" indent) ; go to proper spot
;; Use the first two characters of each day to head the columns.
(dotimes (i 7)
(insert
(truncate-string-to-width string 2)
(substring string 0 2)))
" "))
- (calendar-insert-indented "" 0 t);; Force onto following line
- (calendar-insert-indented "" indent);; Go to proper spot
- ;; Add blank days before the first of the month
+ (calendar-insert-indented "" 0 t) ; force onto following line
+ (calendar-insert-indented "" indent) ; go to proper spot
+ ;; Add blank days before the first of the month.
(dotimes (idummy blank-days) (insert " "))
- ;; Put in the days of the month
- (calendar-for-loop i from 1 to last do
- (insert (format "%2d " i))
- (add-text-properties
- (- (point) 3) (1- (point))
- '(mouse-face highlight
- help-echo "mouse-2: menu of operations for this date"))
- (and (zerop (mod (+ i blank-days) 7))
- (/= i last)
- (calendar-insert-indented "" 0 t) ;; Force onto following line
- (calendar-insert-indented "" indent)))));; Go to proper spot
+ ;; Put in the days of the month.
+ (dotimes (i last)
+ (insert (format "%2d " (1+ i)))
+ (add-text-properties
+ (- (point) 3) (1- (point))
+ '(mouse-face highlight
+ help-echo "mouse-2: menu of operations for this date"))
+ (and (zerop (mod (+ i 1 blank-days) 7))
+ (/= i (1- last))
+ (calendar-insert-indented "" 0 t) ; force onto following line
+ (calendar-insert-indented "" indent))))) ; go to proper spot
(defun calendar-insert-indented (string indent &optional newline)
"Insert STRING at column INDENT.
-If the optional parameter NEWLINE is t, leave point at start of next line,
-inserting a newline if there was no next line; otherwise, leave point after
-the inserted text. Value is always t."
+If the optional parameter NEWLINE is non-nil, leave point at start of next
+line, inserting a newline if there was no next line; otherwise, leave point
+after the inserted text. Returns t."
;; Try to move to that column.
(move-to-column indent)
;; If line is too short, indent out to that column.
(indent-to indent))
(insert string)
;; Advance to next line, if requested.
- (if newline
- (progn
- (end-of-line)
- (if (eobp)
- (newline)
- (forward-line 1))))
+ (when newline
+ (end-of-line)
+ (if (eobp)
+ (newline)
+ (forward-line 1)))
t)
(defun redraw-calendar ()
(generate-calendar-window displayed-month displayed-year)
(calendar-cursor-to-visible-date cursor-date)))))
-;;;###autoload
-(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 `redraw-calendar' 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)
- (redraw-calendar))
- :group 'calendar)
-
-(defcustom calendar-debug-sexp nil
- "Turn debugging on when evaluating a sexp in the diary or holiday list."
- :type 'boolean
- :group 'calendar)
-
-(require 'cal-menu)
-
(defvar calendar-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map "q" 'exit-calendar)
(define-key map "a" 'calendar-list-holidays)
(define-key map "h" 'calendar-cursor-holidays)
- (define-key map "x" 'mark-calendar-holidays)
+ (define-key map "x" 'calendar-mark-holidays)
(define-key map "u" 'calendar-unmark)
(define-key map "m" 'mark-diary-entries)
(define-key map "d" 'diary-view-entries)
(easy-menu-define nil map nil cal-menu-holidays-menu)
(easy-menu-define nil map nil cal-menu-goto-menu)
(easy-menu-define nil map nil cal-menu-scroll-menu)
-
+
(define-key map [down-mouse-3]
(easy-menu-binding cal-menu-context-mouse-menu))
(define-key map [down-mouse-2]
(easy-menu-binding cal-menu-global-mouse-menu))
- map))
+ map)
+ "Keymap for `calendar-mode'.")
(defun describe-calendar-mode ()
"Create a help buffer with a brief description of the `calendar-mode'."
;; Calendar mode is suitable only for specially formatted data.
(put 'calendar-mode 'mode-class 'special)
-(defvar calendar-mode-line-format
+;; After calendar-mode-map.
+(defcustom calendar-mode-line-format
(list
(propertize "<"
- 'help-echo "mouse-1: previous month"
- 'mouse-face 'mode-line-highlight
- 'keymap (make-mode-line-mouse-map 'mouse-1
- 'calendar-scroll-right))
+ 'help-echo "mouse-1: previous month"
+ 'mouse-face 'mode-line-highlight
+ 'keymap (make-mode-line-mouse-map 'mouse-1
+ 'calendar-scroll-right))
"Calendar"
(concat
(propertize
'help-echo "mouse-1: choose another month"
'mouse-face 'mode-line-highlight
'keymap (make-mode-line-mouse-map
- 'mouse-1 'mouse-calendar-other-month))
+ 'mouse-1 'mouse-calendar-other-month))
" / "
(propertize
(substitute-command-keys
'keymap (make-mode-line-mouse-map 'mouse-1 #'calendar-goto-today)))
'(calendar-date-string (calendar-current-date) t)
(propertize ">"
- 'help-echo "mouse-1: next month"
- 'mouse-face 'mode-line-highlight
- 'keymap (make-mode-line-mouse-map
- 'mouse-1 'calendar-scroll-left)))
+ 'help-echo "mouse-1: next month"
+ 'mouse-face 'mode-line-highlight
+ 'keymap (make-mode-line-mouse-map
+ 'mouse-1 'calendar-scroll-left)))
"The mode line of the calendar buffer.
This must be a list of items that evaluate to strings--those strings are
defaults to the current date if it is otherwise undefined. Here is an example
value that has the Hebrew date, the day number/days remaining in the year,
and the ISO week/year numbers in the mode. When `calendar-move-hook' is set
-to `update-calendar-mode-line', these mode line shows these values for the date
+to `update-calendar-mode-line', the mode line shows these values for the date
under the cursor:
(list
(format \"ISO week %d of %d\"
(extract-calendar-month iso-date)
(extract-calendar-year iso-date)))
- \"\"))")
+ \"\"))"
+ :type 'sexp
+ :group 'calendar)
(defun mouse-calendar-other-month (event)
- "Display a three-month calendar centered around a specified month and year."
+ "Display a three-month calendar centered around a specified month and year.
+EVENT is the last mouse event."
(interactive "e")
(save-selected-window
(select-window (posn-window (event-start event)))
(call-interactively 'calendar-other-month)))
-;; (require 'info) will define these.
-(declare-function Info-find-emacs-command-nodes "info" (command))
-(declare-function Info-find-node "info"
- (filename nodename &optional no-going-back))
-
(defun calendar-goto-info-node ()
"Go to the info node for the calendar."
(interactive)
- (require 'info)
- (let ((where (save-window-excursion
- (Info-find-emacs-command-nodes 'calendar))))
- (if (not where)
- (error "Couldn't find documentation for the calendar")
- (let (same-window-buffer-names)
- (info))
- (Info-find-node (car (car where)) (car (cdr (car where)))))))
-
+ (info "(emacs)Calendar/Diary"))
+(defvar calendar-mark-ring nil
+ "Used by `calendar-set-mark'.")
(defun calendar-mode ()
"A major mode for the calendar window.
\\<calendar-mode-map>\\{calendar-mode-map}"
(kill-all-local-variables)
- (setq major-mode 'calendar-mode)
- (setq mode-name "Calendar")
+ (setq major-mode 'calendar-mode
+ mode-name "Calendar"
+ buffer-read-only t
+ buffer-undo-list t
+ indent-tabs-mode nil)
(use-local-map calendar-mode-map)
- (setq buffer-read-only t)
- (setq indent-tabs-mode nil)
(update-calendar-mode-line)
(make-local-variable 'calendar-mark-ring)
- (make-local-variable 'displayed-month) ;; Month in middle of window.
- (make-local-variable 'displayed-year) ;; Year in middle of window.
+ (make-local-variable 'displayed-month) ; month in middle of window
+ (make-local-variable 'displayed-year) ; year in middle of window
;; Most functions only work if displayed-month and displayed-year are set,
;; so let's make sure they're always set. Most likely, this will be reset
;; soon in generate-calendar, but better safe than sorry.
the STRINGS are just concatenated and the result truncated."
;; The algorithm is based on equation (3.25) on page 85 of Concrete
;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
-;; Addison-Wesley, Reading, MA, 1989
+;; Addison-Wesley, Reading, MA, 1989.
(let* ((strings (mapcar 'eval
(if (< (length strings) 2)
(append (list "") strings (list ""))
(dolist (string strings)
(setq s (concat s
(make-string (max 0 (/ (+ n i) m)) char)
- string))
- (setq i (1+ i)))
+ string)
+ i (1+ i)))
(substring s 0 length)))
(defun update-calendar-mode-line ()
(let ((calendar-buffers (calendar-buffer-list))
list)
(walk-windows (lambda (w)
- (if (memq (window-buffer w) calendar-buffers)
- (push w list)))
+ (if (memq (window-buffer w) calendar-buffers)
+ (push w list)))
nil t)
list))
(defun calendar-buffer-list ()
- "List of all calendar-related buffers."
- (let* ((diary-buffer (get-file-buffer diary-file))
- (buffers (list "*Yahrzeits*" lunar-phases-buffer holiday-buffer
- fancy-diary-buffer diary-buffer calendar-buffer
- other-calendars-buffer))
- (buffer-list nil))
- (dolist (b buffers)
- (setq b (cond ((stringp b) (get-buffer b))
- ((bufferp b) b)
- (t nil)))
- (if b (push b buffer-list)))
- buffer-list))
+ "List of all calendar-related buffers (as buffers, not strings)."
+ (let (buffs)
+ (dolist (b (list cal-hebrew-yahrzeit-buffer lunar-phases-buffer
+ holiday-buffer fancy-diary-buffer
+ (get-file-buffer diary-file)
+ calendar-buffer other-calendars-buffer))
+ (and b (setq b (get-buffer b))
+ (push b buffs)))
+ buffs))
(defun exit-calendar ()
"Get out of the calendar window and hide it and related buffers."
(interactive)
- (let* ((diary-buffer (get-file-buffer diary-file)))
+ (let ((diary-buffer (get-file-buffer diary-file)))
(if (or (not diary-buffer)
(not (buffer-modified-p diary-buffer))
(yes-or-no-p
"Diary modified; do you really want to exit the calendar? "))
- ;; Need to do this multiple times because one time can replace some
- ;; calendar-related buffers with other calendar-related buffers
- (mapcar (lambda (x)
- (mapcar 'calendar-hide-window (calendar-window-list)))
+ ;; Need to do this multiple times because one time can replace some
+ ;; calendar-related buffers with other calendar-related buffers.
+ (mapc (lambda (x)
+ (mapc 'calendar-hide-window (calendar-window-list)))
(calendar-window-list)))))
(defun calendar-hide-window (window)
(defun calendar-cursor-to-date (&optional error)
"Return a list (month day year) of current cursor position.
If cursor is not on a specific date, signals an error if optional parameter
-ERROR is t, otherwise just returns nil."
+ERROR is non-nil, otherwise just returns nil."
(let* ((segment (/ (current-column) 25))
(month (% (+ displayed-month segment -1) 12))
- (month (if (= 0 month) 12 month))
+ (month (if (zerop month) 12 month))
(year
(cond
- ((and (= 12 month) (= segment 0)) (1- displayed-year))
+ ((and (= 12 month) (zerop segment)) (1- displayed-year))
((and (= 1 month) (= segment 2)) (1+ displayed-year))
(t displayed-year))))
(if (and (looking-at "[ 0-9]?[0-9][^0-9]")
(list month
(string-to-number (buffer-substring (1+ (point)) (+ 4 (point))))
year))
- (if (and (looking-at "\\*")
- (save-excursion
- (re-search-backward "[^*]")
- (looking-at ".\\*\\*")))
- (list month calendar-starred-day year)
- (if error (error "Not on a date!"))))))
+ (if error (error "Not on a date!")))))
(add-to-list 'debug-ignored-errors "Not on a 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.
+;; (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.
+;; (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.
+;; (day ; calculate the day by subtraction
;; (- date
;; (1- (calendar-absolute-from-gregorian (list month 1 year))))))
;; (list month day year)))
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC. This function does not
handle dates in years BC."
-;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
-;; Three Historical Calendars'' by E. M. Reingold, N. Dershowitz, and S. M.
-;; Clamen, Software--Practice and Experience, Volume 23, Number 4
-;; (April, 1993), pages 383-404 for an explanation.
+ ;; 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))
(defun calendar-other-month (month year)
"Display a three-month calendar centered around MONTH and YEAR."
(interactive (calendar-read-date 'noday))
- (if (and (= month displayed-month)
- (= year displayed-year))
- nil
+ (unless (and (= month displayed-month)
+ (= year displayed-year))
(let ((old-date (calendar-cursor-to-date))
(today (calendar-current-date)))
(generate-calendar-window month year)
(defun calendar-set-mark (arg)
"Mark the date under the cursor, or jump to marked date.
With no prefix argument, push current date onto marked date ring.
-With argument, jump to mark, pop it, and put point at end of ring."
+With argument ARG, jump to mark, pop it, and put point at end of ring."
(interactive "P")
(let ((date (calendar-cursor-to-date t)))
- (if (null arg)
- (progn
- (push date calendar-mark-ring)
- ;; Since the top of the mark ring is the marked date in the
- ;; calendar, the mark ring in the calendar is one longer than
- ;; in other buffers to get the same effect.
- (if (> (length calendar-mark-ring) (1+ mark-ring-max))
- (setcdr (nthcdr mark-ring-max calendar-mark-ring) nil))
- (message "Mark set"))
- (if (null calendar-mark-ring)
- (error "No mark set in this buffer")
- (calendar-goto-date (car calendar-mark-ring))
- (setq calendar-mark-ring
- (cdr (nconc calendar-mark-ring (list date))))))))
+ (if arg
+ (if (null calendar-mark-ring)
+ (error "No mark set in this buffer")
+ (calendar-goto-date (car calendar-mark-ring))
+ (setq calendar-mark-ring
+ (cdr (nconc calendar-mark-ring (list date)))))
+ (push date calendar-mark-ring)
+ ;; Since the top of the mark ring is the marked date in the
+ ;; calendar, the mark ring in the calendar is one longer than
+ ;; in other buffers to get the same effect.
+ (if (> (length calendar-mark-ring) (1+ mark-ring-max))
+ (setcdr (nthcdr mark-ring-max calendar-mark-ring) nil))
+ (message "Mark set"))))
(defun calendar-exchange-point-and-mark ()
"Exchange the current cursor position with the marked date."
(setq value (read-minibuffer prompt initial-contents)))
value))
-(defun calendar-read-date (&optional noday)
- "Prompt for Gregorian date. Return a list (month day year).
-If optional NODAY is t, does not ask for day, but just returns
-\(month nil year); if NODAY is any other non-nil value the value returned is
-\(month year)"
- (let* ((year (calendar-read
- "Year (>0): "
- (lambda (x) (> x 0))
- (int-to-string (extract-calendar-year
- (calendar-current-date)))))
- (month-array calendar-month-name-array)
- (completion-ignore-case t)
- (month (cdr (assoc-string
- (completing-read
- "Month name: "
- (mapcar 'list (append month-array nil))
- nil t)
- (calendar-make-alist month-array 1) t)))
- (last (calendar-last-day-of-month month year)))
- (if noday
- (if (eq noday t)
- (list month nil year)
- (list month year))
- (list month
- (calendar-read (format "Day (1-%d): " last)
- (lambda (x) (and (< 0 x) (<= x last))))
- year))))
-
-(defun calendar-interval (mon1 yr1 mon2 yr2)
- "The number of months difference between MON1, YR1 and MON2, YR2.
-The result is positive if the second date is later than the first.
-Negative years are interpreted as years BC; -1 being 1 BC, and so on."
- (if (< yr1 0) (setq yr1 (1+ yr1))) ; -1 BC -> 0 AD, etc
- (if (< yr2 0) (setq yr2 (1+ yr2)))
- (+ (* 12 (- yr2 yr1))
- (- mon2 mon1)))
(defvar calendar-abbrev-length 3
"*Length of abbreviations to be used for day and month names.
See also `calendar-day-abbrev-array' and `calendar-month-abbrev-array'.")
-(defvar calendar-day-name-array
+;; FIXME does it have to start from Sunday?
+(defcustom calendar-day-name-array
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
- "*Array of capitalized strings giving, in order, the day names.
+ "Array of capitalized strings giving, in order, the day names.
The first two characters of each string will be used to head the
day columns in the calendar. See also the variable
-`calendar-day-abbrev-array'.")
+`calendar-day-abbrev-array'."
+ :group 'calendar
+ :type '(vector (string :tag "Sunday")
+ (string :tag "Monday")
+ (string :tag "Tuesday")
+ (string :tag "Wednesday")
+ (string :tag "Thursday")
+ (string :tag "Friday")
+ (string :tag "Saturday")))
(defvar calendar-day-abbrev-array
[nil nil nil nil nil nil nil]
is nil, then the abbreviation will be constructed as the first
`calendar-abbrev-length' characters of the corresponding full name.")
-(defvar calendar-month-name-array
+(defcustom calendar-month-name-array
["January" "February" "March" "April" "May" "June"
"July" "August" "September" "October" "November" "December"]
- "*Array of capitalized strings giving, in order, the month names.
-See also the variable `calendar-month-abbrev-array'.")
+ "Array of capitalized strings giving, in order, the month names.
+See also the variable `calendar-month-abbrev-array'."
+ :group 'calendar
+ :type '(vector (string :tag "January")
+ (string :tag "February")
+ (string :tag "March")
+ (string :tag "April")
+ (string :tag "May")
+ (string :tag "June")
+ (string :tag "July")
+ (string :tag "August")
+ (string :tag "September")
+ (string :tag "October")
+ (string :tag "November")
+ (string :tag "December")))
(defvar calendar-month-abbrev-array
[nil nil nil nil nil nil nil nil nil nil nil nil]
constructed as the first `calendar-abbrev-length' characters of the
corresponding full name.")
+(defun calendar-make-alist (sequence &optional start-index filter abbrevs)
+ "Make an assoc list corresponding to SEQUENCE.
+Each element of sequence will be associated with an integer, starting
+from 1, or from START-INDEX if that is non-nil. If a sequence ABBREVS
+is supplied, the function `calendar-abbrev-construct' is used to
+construct abbreviations corresponding to the elements in SEQUENCE.
+Each abbreviation is entered into the alist with the same
+association index as the full name it represents.
+If FILTER is provided, apply it to each key in the alist."
+ (let ((index 0)
+ (offset (or start-index 1))
+ (aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence)))
+ (aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence
+ 'period)))
+ alist elem)
+ (dotimes (i (length sequence) (reverse alist))
+ (setq index (+ i offset)
+ elem (elt sequence i)
+ alist
+ (cons (cons (if filter (funcall filter elem) elem) index) alist))
+ (if aseq
+ (setq elem (elt aseq i)
+ alist (cons (cons (if filter (funcall filter elem) elem)
+ index) alist)))
+ (if aseqp
+ (setq elem (elt aseqp i)
+ alist (cons (cons (if filter (funcall filter elem) elem)
+ index) alist))))))
+
+(defun calendar-read-date (&optional noday)
+ "Prompt for Gregorian date. Return a list (month day year).
+If optional NODAY is t, does not ask for day, but just returns
+\(month 1 year); if NODAY is any other non-nil value the value returned is
+\(month year)"
+ (let* ((year (calendar-read
+ "Year (>0): "
+ (lambda (x) (> x 0))
+ (int-to-string (extract-calendar-year
+ (calendar-current-date)))))
+ (month-array calendar-month-name-array)
+ (completion-ignore-case t)
+ (month (cdr (assoc-string
+ (completing-read
+ "Month name: "
+ (mapcar 'list (append month-array nil))
+ nil t)
+ (calendar-make-alist month-array 1) t)))
+ (last (calendar-last-day-of-month month year)))
+ (if noday
+ (if (eq noday t)
+ (list month 1 year)
+ (list month year))
+ (list month
+ (calendar-read (format "Day (1-%d): " last)
+ (lambda (x) (and (< 0 x) (<= x last))))
+ year))))
+
+(defun calendar-interval (mon1 yr1 mon2 yr2)
+ "The number of months difference between MON1, YR1 and MON2, YR2.
+The result is positive if the second date is later than the first.
+Negative years are interpreted as years BC; -1 being 1 BC, and so on."
+ (if (< yr1 0) (setq yr1 (1+ yr1))) ; -1 BC -> 0 AD, etc
+ (if (< yr2 0) (setq yr2 (1+ yr2)))
+ (+ (* 12 (- yr2 yr1))
+ (- mon2 mon1)))
+
(defun calendar-abbrev-construct (abbrev full &optional period)
"Internal calendar function to return a complete abbreviation array.
ABBREV is an array of abbreviations, FULL the corresponding array
(defvar calendar-font-lock-keywords
`((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
- " -?[0-9]+")
+ " -?[0-9]+")
. font-lock-function-name-face) ; month and year
(,(regexp-opt
(list (substring (aref calendar-day-name-array 6) 0 2)
- (substring (aref calendar-day-name-array 0) 0 2)))
- ;; Saturdays and Sundays are hilited differently.
+ (substring (aref calendar-day-name-array 0) 0 2)))
+ ;; Saturdays and Sundays are highlighted differently.
. font-lock-comment-face)
;; First two chars of each day are used in the calendar.
- (,(regexp-opt (mapcar (lambda (x) (substring x 0 2)) calendar-day-name-array))
+ (,(regexp-opt (mapcar (lambda (x) (substring x 0 2))
+ calendar-day-name-array))
. font-lock-reference-face))
"Default keywords to highlight in Calendar mode.")
calendar-day-name-array)
(if absolute date (calendar-day-of-week date))))
-(defun calendar-make-alist (sequence &optional start-index filter abbrevs)
- "Make an assoc list corresponding to SEQUENCE.
-Each element of sequence will be associated with an integer, starting
-from 1, or from START-INDEX if that is non-nil. If a sequence ABBREVS
-is supplied, the function `calendar-abbrev-construct' is used to
-construct abbreviations corresponding to the elements in SEQUENCE.
-Each abbreviation is entered into the alist with the same
-association index as the full name it represents.
-If FILTER is provided, apply it to each key in the alist."
- (let ((index 0)
- (offset (or start-index 1))
- (aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence)))
- (aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence
- 'period)))
- alist elem)
- (dotimes (i (length sequence) (reverse alist))
- (setq index (+ i offset)
- elem (elt sequence i)
- alist
- (cons (cons (if filter (funcall filter elem) elem) index) alist))
- (if aseq
- (setq elem (elt aseq i)
- alist (cons (cons (if filter (funcall filter elem) elem)
- index) alist)))
- (if aseqp
- (setq elem (elt aseqp i)
- alist (cons (cons (if filter (funcall filter elem) elem)
- index) alist))))))
-
(defun calendar-month-name (month &optional abbrev)
"Return a string with the name of month number MONTH.
Months are numbered from one. Month names are taken from the
(defun calendar-unmark ()
"Delete all diary/holiday marks/highlighting from the calendar."
(interactive)
- (setq mark-holidays-in-calendar nil)
- (setq mark-diary-entries-in-calendar nil)
- (redraw-calendar))
+ (setq mark-holidays-in-calendar nil
+ mark-diary-entries-in-calendar nil)
+ (with-current-buffer calendar-buffer
+ (mapc 'delete-overlay (overlays-in (point-min) (point-max)))))
(defun calendar-date-is-visible-p (date)
- "Return t if DATE is valid and is visible in the calendar window."
- (let ((gap (calendar-interval
- displayed-month displayed-year
- (extract-calendar-month date) (extract-calendar-year date))))
- (and (calendar-date-is-legal-p date) (> 2 gap) (< -2 gap))))
-
-(defun calendar-date-is-legal-p (date)
+ "Return non-nil if DATE is valid and is visible in the calendar window."
+ (and (calendar-date-is-valid-p date)
+ (< (abs (calendar-interval
+ displayed-month displayed-year
+ (extract-calendar-month date) (extract-calendar-year date)))
+ 2)))
+
+(defun calendar-nongregorian-visible-p (month day toabs fromabs switch)
+ "Return non-nil if MONTH, DAY is visible in the calendar window.
+MONTH and DAY are in some non-Gregorian calendar system. The
+functions TOABS and FROMABS convert that system to and from
+absolute, respectively. SWITCH is a function that takes a single
+argument (a local month number). It applies when the local year
+changes across the calendar window, and returns non-nil if the
+specified month should be associated with the higher year.
+Returns the corresponding Gregorian date."
+ ;; We need to choose the local year associated with month and day
+ ;; that might make them visible.
+ (let* ((m1 displayed-month)
+ (y1 displayed-year)
+ (m2 displayed-month)
+ (y2 displayed-year)
+ ;; Absolute date of first/last dates in calendar window.
+ (start-date (progn
+ (increment-calendar-month m1 y1 -1)
+ (calendar-absolute-from-gregorian (list m1 1 y1))))
+ (end-date (progn
+ (increment-calendar-month m2 y2 1)
+ (calendar-absolute-from-gregorian
+ (list m2 (calendar-last-day-of-month m2 y2) y2))))
+ ;; Local date of first/last date in calendar window.
+ (local-start (funcall fromabs start-date))
+ (local-end (funcall fromabs end-date))
+ ;; Local year of first/last dates.
+ ;; Can only differ if displayed-month = 12, 1, 2.
+ (local-y1 (extract-calendar-year local-start))
+ (local-y2 (extract-calendar-year local-end))
+ ;; Choose which year might be visible in the window.
+ ;; Obviously it only matters when y1 and y2 differ, ie
+ ;; when the _local_ new year is visible.
+ (year (if (funcall switch month) local-y2 local-y1))
+ (date (calendar-gregorian-from-absolute
+ (funcall toabs (list month day year)))))
+ (if (calendar-date-is-visible-p date)
+ date)))
+
+(defun calendar-date-is-valid-p (date)
"Return t if DATE is a valid date."
(let ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date)))
(and (<= 1 month) (<= month 12)
- ;; (calendar-read-date t) returns a date with day = nil.
+ ;; (calendar-read-date t) used to return a date with day = nil.
;; Should not be valid (?), since many funcs prob assume integer.
;; (calendar-read-date 'noday) returns (month year), which
;; currently results in extract-calendar-year returning nil.
;; Note there are side effects on calendar navigation.
(<= 1 year))))
+(define-obsolete-function-alias 'calendar-date-is-legal-p
+ 'calendar-date-is-valid-p "23.1")
+
(defun calendar-date-equal (date1 date2)
"Return t if the DATE1 and DATE2 are the same."
(and
(= (extract-calendar-day date1) (extract-calendar-day date2))
(= (extract-calendar-year date1) (extract-calendar-year date2))))
+(defun calendar-make-temp-face (attrlist)
+ "Return a temporary face based on the attributes in ATTRLIST.
+ATTRLIST is a list with elements of the form :face face :foreground color."
+ (let ((attrs attrlist)
+ faceinfo face temp-face)
+ ;; Separate :face from the other attributes. Use the last :face
+ ;; if there are more than one. FIXME is merging meaningful?
+ (while attrs
+ (if (eq (car attrs) :face)
+ (setq face (intern-soft (cadr attrs))
+ attrs (cddr attrs))
+ (push (car attrs) faceinfo)
+ (setq attrs (cdr attrs))))
+ (or (facep face) (setq face 'default))
+ (if (not faceinfo)
+ ;; No attributes to apply, so just use an existing-face.
+ face
+ ;; FIXME should we be using numbered temp-faces, re-using where poss?
+ (setq temp-face
+ (make-symbol
+ (concat ":caltemp"
+ (mapconcat (lambda (sym)
+ (cond
+ ((symbolp sym) (symbol-name sym))
+ ((numberp sym) (number-to-string sym))
+ (t sym)))
+ attrlist ""))))
+ (make-face temp-face)
+ (copy-face face temp-face)
+ ;; Apply the font aspects.
+ (apply 'set-face-attribute temp-face nil (nreverse faceinfo))
+ temp-face)))
+
(defun mark-visible-calendar-date (date &optional mark)
"Mark DATE in the calendar window with MARK.
MARK is a single-character string, a list of face attributes/values, or a face.
MARK defaults to `diary-entry-marker'."
- (if (calendar-date-is-legal-p date)
+ (if (calendar-date-is-valid-p date)
(with-current-buffer calendar-buffer
(save-excursion
(calendar-cursor-to-visible-date date)
(and (facep mark) mark) ; face-name
diary-entry-marker))
(cond
- ;; face or an attr-list that contained a face
+ ;; Face or an attr-list that contained a face.
((facep mark)
(overlay-put
(make-overlay (1- (point)) (1+ (point))) 'face mark))
- ;; single-char
+ ;; Single-character mark, goes after the date.
((and (stringp mark) (= (length mark) 1))
- (let ((inhibit-read-only t))
- (forward-char 1)
- ;; Insert before delete so as to better preserve markers.
- (insert mark)
- (delete-char 1)
- (forward-char -2)))
- (t ;; attr list
- (let ((temp-face
- (make-symbol
- (apply 'concat "temp-"
- (mapcar (lambda (sym)
- (cond
- ((symbolp sym) (symbol-name sym))
- ((numberp sym) (number-to-string sym))
- (t sym)))
- mark))))
- (faceinfo mark))
- (make-face temp-face)
- ;; Remove :face info from the mark, copy the face info into
- ;; temp-face
- (while (setq faceinfo (memq :face faceinfo))
- (copy-face (read (nth 1 faceinfo)) temp-face)
- (setcar faceinfo nil)
- (setcar (cdr faceinfo) nil))
- (setq mark (delq nil mark))
- ;; Apply the font aspects
- (apply 'set-face-attribute temp-face nil mark)
- (overlay-put
- (make-overlay (1- (point)) (1+ (point))) 'face temp-face))))))))
+ (overlay-put
+ (make-overlay (1+ (point)) (+ 2 (point))) 'display mark))
+ (t ; attr list
+ (overlay-put
+ (make-overlay (1- (point)) (1+ (point))) 'face
+ (calendar-make-temp-face mark))))))))
(defun calendar-star-date ()
"Replace the date under the cursor in the calendar window with asterisks.
-This function can be used with the `today-visible-calendar-hook' run after the
-calendar window has been prepared."
- (let ((inhibit-read-only t)
- (modified (buffer-modified-p)))
- (forward-char 1)
- (set (make-local-variable 'calendar-starred-day)
- (string-to-number
- (buffer-substring (point) (- (point) 2))))
- ;; Insert before deleting, to better preserve markers.
- (insert "**")
- (forward-char -2)
- (delete-char -2)
- (forward-char 1)
- (restore-buffer-modified-p modified)))
+You might want to add this function to `today-visible-calendar-hook'."
+ (unless (catch 'found
+ (dolist (ol (overlays-at (point)))
+ (and (overlay-get ol 'calendar-star)
+ (throw 'found t))))
+ (let ((ol (make-overlay (1- (point)) (point))))
+ (overlay-put ol 'display "*")
+ (overlay-put ol 'calendar-star t)
+ ;; Use copy-sequence to avoid merging of identical 'display props.
+ ;; Use two overlays so as not to mess up
+ ;; calendar-cursor-to-nearest-date (and calendar-forward-day).
+ (overlay-put (setq ol (make-overlay (point) (1+ (point))))
+ 'display (copy-sequence "*"))
+ (overlay-put ol 'calendar-star t))))
(defun calendar-mark-today ()
"Mark the date under the cursor in the calendar window.
-The date is marked with `calendar-today-marker'. This function can be used with
-the `today-visible-calendar-hook' run after the calendar window has been
-prepared."
- (mark-visible-calendar-date
- (calendar-cursor-to-date)
- calendar-today-marker))
+The date is marked with `calendar-today-marker'. You might want to add
+this function to `today-visible-calendar-hook'."
+ (mark-visible-calendar-date (calendar-cursor-to-date) calendar-today-marker))
(defun calendar-date-compare (date1 date2)
"Return t if DATE1 is before DATE2, nil otherwise.
`calendar-month-abbrev-array' and `calendar-day-abbrev-array',
respectively. An optional parameter NODAYNAME, when t, omits the
name of the day of the week."
- (let* ((dayname
- (unless nodayname
- (calendar-day-name date abbreviate)))
+ (let* ((dayname (unless nodayname (calendar-day-name date abbreviate)))
(month (extract-calendar-month date))
(monthname (calendar-month-name month abbreviate))
(day (int-to-string (extract-calendar-day date)))
If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
(if (> n 0)
(+ (* 7 (1- n))
- (calendar-dayname-on-or-before
- dayname
- (+ 6 (calendar-absolute-from-gregorian
- (list month (or day 1) year)))))
+ (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))))))
+ dayname
+ (calendar-absolute-from-gregorian
+ (list month
+ (or day (calendar-last-day-of-month month year))
+ year))))))
(defun calendar-nth-named-day (n dayname month year &optional day)
"The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
(format "Day %d of %d; %d day%s remaining in the year"
day year days-remaining (if (= days-remaining 1) "" "s"))))
+(defun calendar-other-dates (date)
+ "Return a list of strings giving Gregorian DATE in other calendars.
+DATE is (month day year). Calendars that do not apply are omitted."
+ (let (odate)
+ (delq nil
+ (list
+ (calendar-day-of-year-string date)
+ (format "ISO date: %s" (calendar-iso-date-string date))
+ (format "Julian date: %s"
+ (calendar-julian-date-string date))
+ (format "Astronomical (Julian) day number (at noon UTC): %s.0"
+ (calendar-astro-date-string date))
+ (format "Fixed (RD) date: %s"
+ (calendar-absolute-from-gregorian date))
+ (format "Hebrew date (before sunset): %s"
+ (calendar-hebrew-date-string date))
+ (format "Persian date: %s"
+ (calendar-persian-date-string date))
+ (unless (string-equal
+ (setq odate (calendar-islamic-date-string date))
+ "")
+ (format "Islamic date (before sunset): %s" odate))
+ (unless (string-equal
+ (setq odate (calendar-bahai-date-string date))
+ "")
+ (format "Baha'i date: %s" odate))
+ (format "Chinese date: %s"
+ (calendar-chinese-date-string date))
+ (unless (string-equal
+ (setq odate (calendar-coptic-date-string date))
+ "")
+ (format "Coptic date: %s" odate))
+ (unless (string-equal
+ (setq odate (calendar-ethiopic-date-string date))
+ "")
+ (format "Ethiopic date: %s" odate))
+ (unless (string-equal
+ (setq odate (calendar-french-date-string date))
+ "")
+ (format "French Revolutionary date: %s" odate))
+ (format "Mayan date: %s"
+ (calendar-mayan-date-string date))))))
+
(defun calendar-print-other-dates ()
"Show dates on other calendars for date under the cursor."
(interactive)
- (let* ((date (calendar-cursor-to-date t)))
- (with-current-buffer (get-buffer-create other-calendars-buffer)
- (let ((inhibit-read-only t)
- (modified (buffer-modified-p)))
- (calendar-set-mode-line
- (concat (calendar-date-string date) " (Gregorian)"))
- (erase-buffer)
- (apply
- 'insert
- (delq nil
- (list
- (calendar-day-of-year-string date) "\n"
- (format "ISO date: %s\n" (calendar-iso-date-string date))
- (format "Julian date: %s\n"
- (calendar-julian-date-string date))
- (format "Astronomical (Julian) day number (at noon UTC): %s.0\n"
- (calendar-astro-date-string date))
- (format "Fixed (RD) date: %s\n"
- (calendar-absolute-from-gregorian date))
- (format "Hebrew date (before sunset): %s\n"
- (calendar-hebrew-date-string date))
- (format "Persian date: %s\n"
- (calendar-persian-date-string date))
- (let ((i (calendar-islamic-date-string date)))
- (if (not (string-equal i ""))
- (format "Islamic date (before sunset): %s\n" i)))
- (let ((b (calendar-bahai-date-string date)))
- (if (not (string-equal b ""))
- (format "Baha'i date (before sunset): %s\n" b)))
- (format "Chinese date: %s\n"
- (calendar-chinese-date-string date))
- (let ((c (calendar-coptic-date-string date)))
- (if (not (string-equal c ""))
- (format "Coptic date: %s\n" c)))
- (let ((e (calendar-ethiopic-date-string date)))
- (if (not (string-equal e ""))
- (format "Ethiopic date: %s\n" e)))
- (let ((f (calendar-french-date-string date)))
- (if (not (string-equal f ""))
- (format "French Revolutionary date: %s\n" f)))
- (format "Mayan date: %s\n"
- (calendar-mayan-date-string date)))))
- (goto-char (point-min))
- (restore-buffer-modified-p modified))
- (display-buffer other-calendars-buffer))))
+ (let ((date (calendar-cursor-to-date t)))
+ (calendar-in-read-only-buffer other-calendars-buffer
+ (calendar-set-mode-line (format "%s (Gregorian)"
+ (calendar-date-string date)))
+ (insert (mapconcat 'identity (calendar-other-dates date) "\n")))))
(defun calendar-print-day-of-year ()
"Show day number in year/days remaining in year for date under the cursor."
"Set mode line to STR, centered, surrounded by dashes."
(let* ((edges (window-edges))
;; As per doc of window-width, total visible mode-line length.
- (width (- (nth 2 edges) (nth 0 edges))))
+ (width (- (nth 2 edges) (car edges))))
(setq mode-line-format
(if buffer-file-name
`("-" mode-line-modified
"---")
(calendar-string-spread (list str) ?- width)))))
-(defun calendar-mod (m n)
- "Non-negative remainder of M/N with N instead of 0."
- (1+ (mod (1- m) n)))
+(defun calendar-version ()
+ "Display the Calendar version."
+ (interactive)
+ (message "GNU Emacs %s" emacs-version))
+
+(make-obsolete 'calendar-version 'emacs-version "23.1")
+
(run-hooks 'calendar-load-hook)