Download
(require 'calendar)
(require 'diary-lib)
(require 'cl)
(require 'solar nil t)
(require 'misc-fns nil t)
(require 'icicles nil t)
(autoload 'filter-visible-calendar-holidays "holidays")
(provide 'calendar+)
(require 'calendar+)
(setq fancy-diary-buffer "*Diary Entries*")
(defvar calendar-mouse-3-menu-items
(list "Calendar"
(list ""
'("Show Diary" . show-all-diary-entries)
'("Lunar Phases" . calendar-phases-of-moon)
'("Unmark All" . calendar-unmark)
'("Mark Holidays" . mark-calendar-holidays)
'("List Holidays" . list-calendar-holidays)
'("Mark Diary Entries" . mark-diary-entries)
'("Scroll Backward" . scroll-calendar-right-three-months)
'("Scroll Forward" . scroll-calendar-left-three-months)
'("--")
'("Count Region Days" . calendar-count-days-region)
'("Count Region Weekdays" . calendar-count-weekdays-region)
'("--")
'("Exit calendar" . exit-calendar))))
(defun calendar-mouse-3-menu (event)
"Pop up menu for Mouse-3 in the calendar window."
(interactive "e")
(let ((selection (x-popup-menu event calendar-mouse-3-menu-items)))
(and selection (call-interactively selection))))
(let ((map (current-local-map)))
(when (and (boundp 'calendar-mode-map) (keymapp calendar-mode-map))
(define-key calendar-mode-map [down-mouse-3] 'calendar-mouse-3-menu)
(define-key calendar-mode-map [C-down-mouse-3] 'calendar-mouse-3-menu)
(define-key calendar-mode-map [mouse-3] 'ignore)
(use-local-map calendar-mode-map)
(local-unset-key [menu-bar moon])
(define-key calendar-mode-map [down-mouse-1] 'calendar-mouse-drag-region)
(define-key calendar-mode-map "=" 'calendar-count-days-region)
(define-key calendar-mode-map [menu-bar diary view-cursor]
'("Cursor Date" . view-diary-entries))
)
(use-local-map map))
(setq european-date-diary-pattern
'((day "/" month "\\s-*[^/0-9][ \t]*:?\\s-*")
(day "/" month "/" year "\\s-*[^0-9][ \t]*:?\\s-*")
(backup day "[ \t]*" monthname "[ \t]*:?\\s-*")
(day "[ \t]*" monthname "[ \t]*" year "[ \t]*:?\\s-*")
(dayname "\\W")))
(setq american-date-diary-pattern
'((month "/" day "\\s-*[^/0-9]")
(month "/" day "/" year "\\s-*[^0-9]")
(monthname "[ \t]*" day "\\s-*[^,0-9]")
(monthname "[ \t]*" day ",[ \t]*" year "\\s-*[^0-9]")
(dayname "\\W")))
(defvar weekend-face
(and (fboundp 'set-face-background)
(prog1 (make-face 'weekend-face)
(set-face-background 'weekend-face "Gray")))
"*Default face used in *Calendar* buffer to display weekend days.")
(defvar cal-mode-line-key-help
"\\<calendar-mode-map>\\[calendar-goto-today]\\[calendar-other-month]g \
p\\[calendar-cursor-holidays] \\[view-diary-entries]i\
\\[show-all-diary-entries] \\[calendar-unmark]\\[mark-calendar-holidays]\
\\[mark-diary-entries] \\[calendar-phases-of-moon]\\[calendar-sunrise-sunset]"
"*Help string to be put in *Calendar* buffer's mode-line." )
(setq calendar-mode-line-format
(list
(substitute-command-keys
"<=\\<calendar-mode-map>\\[scroll-calendar-right-three-months]")
(substitute-command-keys (concat "[" cal-mode-line-key-help "]"))
(substitute-command-keys
"(\\<calendar-mode-map>\\[calendar-goto-info-node] = help)")
'(calendar-date-string (calendar-current-date) t)
(substitute-command-keys
"\\<calendar-mode-map>\\[scroll-calendar-left-three-months]=>")))
(if (fboundp 'calendar-update-mode-line)
(calendar-update-mode-line)
(update-calendar-mode-line))
(defcustom diary-entry-marker
(if (not window-system)
"+"
(require 'faces)
(make-face 'diary-face)
(if (x-display-color-p)
(set-face-foreground 'diary-face "Red")
(copy-face 'bold 'diary-face))
'diary-face)
"*Used to mark dates that have diary entries.
Can be either a single-character string or a face."
:type '(choice string face)
:group 'diary)
(defcustom calendar-region-marker
(if (not window-system)
"X"
(require 'faces)
(make-face 'calendar-region-face)
(if (x-display-color-p)
(set-face-background 'calendar-region-face "LightGray")
(copy-face 'bold 'calendar-region-face))
'calendar-region-face)
"*Used to mark days in calendar region.
Can be either a single-character string or a face."
:type '(choice string face)
:group 'calendar)
(when (fboundp 'set-face-foreground)
(set-face-background 'holiday-face "PaleTurquoise"))
(defcustom calendar-local-holiday-marker
(if (not window-system)
"*"
(require 'faces)
(make-face 'local-holiday-face)
(if (x-display-color-p)
(set-face-background 'local-holiday-face "Pink")
(set-face-background 'local-holiday-face "Black")
(set-face-foreground 'local-holiday-face "White"))
'local-holiday-face)
"*Used to mark local holidays in the calendar.
Can be either a single-character string or a face."
:type '(choice string face)
:group 'holidays)
(put 'calendar-location-name 'variable-documentation
"*Sexp that evals to name of `calendar-latitude', `calendar-longitude',
which is the calendar's geographical position, e.g. \"New York City\".
Default just gives the latitude, longitude pair, as in \"48.3N, 3.7E\".")
(defconst new-diary-file-doc
"*Name of the file in which your personal diary of dates is kept.
The diary file's entries are lines that begin with a date in any of
the following formats. (This is the American date notation---see
below for European notation):
MONTH/DAY
MONTH/DAY/YEAR
MONTHNAME DAY
MONTHNAME DAY, YEAR (Note the `,' in this form.)
DAYNAME
The remainder of a diary entry line is the entry string proper for the
given date.
- MONTH and DAY are one or two digit numbers.
- YEAR is a number and may be written in full or abbreviated to the
final two digits. If the date does not explicitly contain a YEAR,
it is generic and applies to any year.
- DAYNAME entries apply to any date which is on that day of the week.
- MONTHNAME and DAYNAME can be spelled in full, abbreviated to three
characters (with or without a period), capitalized or not.
- Any of DAY, MONTH, or MONTHNAME, YEAR can be `*' which matches any
day, month, or year, respectively.
The European style (in which the day precedes the month) can be used
instead, if you execute `european-calendar' when in the calendar, or
set `european-calendar-style' to t in your ~/.emacs file.
The European forms are:
DAY/MONTH
DAY/MONTH/YEAR
DAY MONTHNAME
DAY MONTHNAME YEAR : (Note the `:' in this form.)
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.
Multiline diary entries are made by indenting lines after the first
with either a TAB or one or more spaces.
Lines not in one the above formats are ignored. Here are some sample
diary entries (in the default American style):
12/22/1988 Twentieth wedding anniversary!!
&1/1. Happy New Year!
10/22 Ruth's birthday.
21: Payday
Tuesday--weekly meeting with grad students at 10am
Supowit, Shen, Bitner, and Kapoor to attend.
1/13/89 Friday the thirteenth!!
&thu 4pm squash game with Lloyd.
mar 16 Dad's birthday
April 15, 1989 Income tax due.
&* 15 time cards due.
If the first line of a diary entry consists only of the date or day
name, with no trailing blanks or punctuation, then that line is not
displayed in the diary window; only the continuation lines are shown.
For example, the following (single) diary entry will appear in the
diary window without the date line at the beginning:
02/11/1989
Bill Blattner visits Princeton today
2pm Cognitive Studies Committee meeting
2:30-5:30 Lizzie at Lawrenceville for `Group Initiative'
4:00pm Jamie Tappenden
7:30pm Dinner at George and Ed's for Alan Ryan
7:30-10:00pm dance at Stewart Country Day School
This can allow the diary window to look neater, but it can also cause
confusion when more than one day's entries are displayed.
Diary entries can be based on Lisp sexps. For example, this diary
entry causes \"Vacation\" to appear from Nov 1 through Nov 10, 2002:
%%(diary-block 11 1 2002 11 10 2002) Vacation
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-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 doc for the function `list-sexp-diary-entries' for more
details.
Diary entries based on the Hebrew and/or the Islamic calendar are also
possible, but because these are somewhat slow, they are ignored unless
you set the hooks `nongregorian-diary-listing-hook' and
`nongregorian-diary-marking-hook' appropriately. See the doc for
these functions for details.
Diary files can contain directives to include the contents of other
files. For details, see the documentation for the variable
`list-diary-entries-hook'.")
(put 'diary-file 'variable-documentation new-diary-file-doc)
(defun show-calendar ()
"Show *Calendar* buffer, generating it if not already present.
If the calendar has already been generated, then, unlike the command
`calendar', this does not activate hooks that do things like display
your diary, appointments, holidays etc."
(interactive)
(get-buffer-create calendar-buffer)
(if (save-excursion (set-buffer calendar-buffer)
(equal major-mode 'calendar-mode))
(pop-to-buffer calendar-buffer)
(calendar)))
(or (fboundp 'old-calendar-mode)
(fset 'old-calendar-mode (symbol-function 'calendar-mode)))
(defun calendar-mode ()
"Major mode for the \"*Calendar*\" buffer.
For more information, type \
\\<calendar-mode-map>\\[calendar-goto-info-node] in that buffer.
Whenever it makes sense, calendar commands take prefix arguments that
multiply their effect. The digit keys (0-9) and the minus sign (-)
are bound to `digit-argument', so they need not be prefixed with `M-'.
For example, `2 \\[calendar-forward-week]' provides prefix argument 2 to \
command `\\[calendar-forward-week]'.
Mouse Menus
-----------
The mouse provides two popup menus in Calendar Mode (provided your
Emacs has a mouse):
[mouse-2] provides a menu specific to the date under the mouse
[mouse-3] provides a more general menu
Calendar Movement, Display
--------------------------
The calendar window can be refreshed at any time with `\\[redraw-calendar]'.
The commands for calendar movement are:
`\\[scroll-calendar-right]' scroll one month right \
`\\[scroll-calendar-left]' scroll one month left
`\\[scroll-calendar-right-three-months]' scroll 3 months right \
`\\[scroll-calendar-left-three-months]' scroll 3 months left
`\\[calendar-goto-today]' display current month \
`\\[calendar-other-month]' display another month
Cursor Movement
---------------
Cursor movement in Calendar mode is a bit special. It is as if the
only possible places for the cursor (point) and the mark were on
dates, and buffer positions were ordered chronologically rather than
from the top left of the buffer to the bottom right. Thus, if the
cursor is at the end of a week and is then moved forward, it does not
move to the right, but rather to the next day.
The commands for cursor movement are:\\<calendar-mode-map>
`\\[calendar-forward-day]' one day forward \
`\\[calendar-backward-day]' one day backward
`\\[calendar-forward-week]' one week forward \
`\\[calendar-backward-week]' one week backward
`\\[calendar-forward-month]' one month forward \
`\\[calendar-backward-month]' one month backward
`\\[calendar-forward-year]' one year forward \
`\\[calendar-backward-year]' one year backward
`\\[calendar-beginning-of-week]' beginning of week \
`\\[calendar-end-of-week]' end of week
`\\[calendar-beginning-of-month]' beginning of month \
`\\[calendar-end-of-month]' end of month
`\\[calendar-beginning-of-year]' beginning of year \
`\\[calendar-end-of-year]' end of year
`\\[calendar-goto-date]' go to date
`\\[calendar-goto-julian-date]' go to Julian date \
`\\[calendar-goto-astro-day-number]' go to astro. (Julian) day
`\\[calendar-goto-hebrew-date]' go to Hebrew date \
`\\[calendar-goto-islamic-date]' go to Islamic date
`\\[calendar-goto-iso-date]' go to ISO date \
`\\[calendar-goto-french-date]' go to French Revol'y date
`\\[calendar-goto-mayan-long-count-date]' go to Mayan Long Count date
`\\[calendar-next-haab-date]' go to next occurrence of Mayan Haab date
`\\[calendar-previous-haab-date]' go to previous occurrence of Mayan \
Haab date
`\\[calendar-next-tzolkin-date]' go to next occurrence of Mayan Tzolkin \
date
`\\[calendar-previous-tzolkin-date]' go to previous occurrence of Mayan \
Tzolkin date
`\\[calendar-next-calendar-round-date]' go to next occurrence of Mayan \
Calendar Round date
`\\[calendar-previous-calendar-round-date]' go to previous occurrence \
of Mayan Calendar Round date
The \"one\" in some of these descriptions is the default. A prefix
arg serves as a multiplier, as described above. Thus, e.g. \
`2 \\[calendar-forward-year]'
moves the cursor forward two years.
The Region
----------
You can set the mark at a date in the calendar. After moving the
cursor, a calendar region is defined between the cursor date and the
mark date. You can then exchange the cursor and the mark positions.
`\\[calendar-set-mark]' mark date \
`\\[calendar-exchange-point-and-mark]' exchange point and mark
The region may also be defined as usual via the mouse (if your Emacs
has a mouse). In addition, double clicking [mouse-1] on a date
selects that date as the region, and highlights it. Triple clicking
\[mouse-1] on a date selects that date's week as the region, and
highlights it.
You can determine the number of days in the calendar region (including
the cursor date and the marked date) by:
`\\[calendar-count-days-region]' count days in calendar region
With a prefix argument (C-u), only weekdays (Mon-Fri) in the region
are counted. If the entire region is visible, then \
`\\[calendar-count-days-region]' highlights it.
Holidays
--------
The following commands deal with holidays:
`\\[calendar-cursor-holidays]' give holidays for the date specified by \
the cursor
`\\[mark-calendar-holidays]' mark holidays in the calendar
`\\[list-calendar-holidays]' display holidays
`\\[calendar-unmark]' unmark all dates (not just holidays)
The command `\\[mark-calendar-holidays]' causes holidays to be \"marked\" \
\(visually highlighted).
`\\[mark-local-holidays]' does the same thing for local holidays. The
variable `local-holidays' determines which dates are thus highlighted.
Set `view-calendar-holidays-initially' to a non-nil value to display
holidays for the current three month period on entry to the calendar.
Independently of the calendar, the command `\\[holidays]' displays the
holidays for the current, previous, and following month.
Solar & Lunar Information
-------------------------
To find the times of sunrise and sunset and the dates and times of
lunar phases:
`\\[calendar-sunrise-sunset]' show times of sunrise and sunset
`\\[calendar-phases-of-moon]' show times of quarters of the moon
The times given apply to location `calendar-location-name' at latitude
`calendar-latitude', and longitude `calendar-longitude'. Set these
variables for your location. The following variables are also
consulted, and you must set them if your system does not initialize
them properly:
`calendar-time-zone',
`calendar-daylight-time-offset',
`calendar-standard-time-zone-name',
`calendar-daylight-time-zone-name',
`calendar-daylight-savings-starts',
`calendar-daylight-savings-ends',
`calendar-daylight-savings-starts-time',
`calendar-daylight-savings-ends-time'.
Equivalent Dates
----------------
These commands express the cursor's date in other ways:
`\\[calendar-print-day-of-year]' show day number and number of days \
remaining in year
`\\[calendar-print-iso-date]' show equivalent date on the ISO \
commercial calendar
`\\[calendar-print-julian-date]' show equivalent date on the Julian \
calendar
`\\[calendar-print-astro-day-number]' show equivalent astronomical \
\(Julian) day number
`\\[calendar-print-hebrew-date]' show equivalent date on the Hebrew \
calendar
`\\[calendar-print-islamic-date]' show equivalent date on the Islamic \
calendar
`\\[calendar-print-french-date]' show equivalent date on the French \
Revolutionary calendar
`\\[calendar-print-mayan-date]' show equivalent date on the Mayan \
calendar
The day number in the year and the number of days remaining in the
year can be determined by:
Your Diary
----------
The following calendar mode commands control your diary:
`\\[mark-diary-entries]' mark diary entries \
`\\[calendar-unmark]' unmark all dates
`\\[view-diary-entries]' display diary entries \
`\\[show-all-diary-entries]' show all diary entries
`\\[print-diary-entries]' print diary entries
The command `\\[mark-diary-entries]' causes diary entries to be \"marked\", \
that is, visually
highlighted. `\\[calendar-unmark]' removes all such calendar highlighting, \
not just
diary entry marks.
The command `\\[print-diary-entries]' prints the diary entries that
are shown by `\\[diary]'.
The command `\\[diary]' causes the diary entries for the cursor's date
to be displayed, independently of the calendar. The number of days of
entries is governed by `number-of-diary-entries', but this is
overridden by a prefix argument.
Unless the variable `diary-display-hook' causes another sort of
display (see below), `\\[diary]' displays your diary file itself. You
can then edit the diary entries there. (The format of the entries is
described in the documentation for variable `diary-file'.)
\\<global-map>BE CAREFUL WHEN EDITING DIARY ENTRIES VIA `\\[diary]':
The buffer displayed by `\\[diary]' contains your *entire* diary file,
even though you can only see part of it. This means, for instance,
that the command `\\[forward-char]' can put the cursor at what appears to be \
the
end of the line, but is in reality the middle of some concealed line.
\(Inserting additional lines or adding/ deleting characters in the
middle of a visible line will not cause problems. Watch out for \
`\\[end-of-line]',
however--it may put you at the end of a concealed line far from where
the cursor appears to be.)
\\<calendar-mode-map>Because of this potential for confusion, if you do not use
`diary-display-hook', then before editing your diary it is best to
display the entire file with `\\[show-all-diary-entries]'. (Be sure to save \
any changes you
make to the file.)
The following calendar mode commands assist in making diary entries:
`\\[insert-diary-entry]' insert a diary entry for the selected date
`\\[insert-weekly-diary-entry]' insert a diary entry for the selected \
day of the week
`\\[insert-monthly-diary-entry]' insert a diary entry for the selected \
day of the month
`\\[insert-yearly-diary-entry]' insert a diary entry for the selected \
day of the year
`\\[insert-block-diary-entry]' insert a diary entry for the days \
between point and mark
`\\[insert-anniversary-diary-entry]' insert an anniversary diary entry \
for the selected date
`\\[insert-cyclic-diary-entry]' insert a cyclic diary entry
There are corresponding commands to assist in making Hebrew or Islamic
date diary entries:
`\\[insert-hebrew-diary-entry]' insert a diary entry for the Hebrew \
date corresponding
to the selected date
`\\[insert-monthly-hebrew-diary-entry]' insert a diary entry for the \
day of the Hebrew month
corresponding to the selected day
`\\[insert-yearly-hebrew-diary-entry]' insert a diary entry for the day \
of the Hebrew year
corresponding to the selected day
`\\[insert-islamic-diary-entry]' insert a diary entry for the Islamic \
date corresponding
to the selected date
`\\[insert-monthly-islamic-diary-entry]' insert a diary entry for the \
day of the Islamic month
corresponding to the selected day
`\\[insert-yearly-islamic-diary-entry]' insert a diary entry for the \
day of the Islamic year
corresponding to the selected day
All of the diary entry commands make nonmarking (i.e. nonhighlighting)
entries when given a prefix argument. With no prefix arg, the diary
entries are marking.
Set variable `view-diary-entries-initially' to a non-nil value to
display today's diary entries in another window when the calendar is
first displayed, if today's date is visible. The variable
`number-of-diary-entries' controls the number of days of diary entries
to display initially or with the command `\\[diary]'. E.g., the
default value 1 means display only today's diary entries. The value 2
means display both today's and tomorrow's entries.
The value of `number-of-diary-entries' can also be a vector such as
\[0 2 2 2 2 4 1]. This value means: display no diary entries on
Sunday, display the entries for the current day and the following day
on Monday through Thursday, display Friday through Monday's entries on
Friday, and display only Saturday's entries on Saturday.
Set `mark-diary-entries-in-calendar' to a non-nil value to mark
\(highlight), in the calendar, all the dates that have diary entries.
The variable `diary-entry-marker' determines how to mark them.
The variable `diary-display-hook' is the list of functions called
after the diary buffer is prepared. The default value simply displays
the diary file using selective-display to conceal irrelevant diary
entries. An alternative function `fancy-diary-display' is provided
that, when used as the `diary-display-hook', causes a noneditable
buffer to be prepared with a neatly organized day-by-day listing of
relevant diary entries, together with any known holidays. The
inclusion of the holidays slows this fancy display of the diary.
To speed it up, set the variable `holidays-in-diary-buffer' to nil.
The variable `print-diary-entries-hook' is the list of functions
called after a temporary buffer is prepared with the diary entries
currently visible in the diary buffer. The default value of this hook
adds a heading (composed from the diary buffer's mode line), does the
printing with the command lpr-buffer, and kills the temporary buffer.
Other uses might include, for example, rearranging the lines into
order by day and time.
Appointment Reminding
---------------------
For information on making appointment reminders, and interfacing these
with your diary, see the documentation in file `appt.el' for functions
`appt-make-list', `appt-add', `appt-remind', `reminders-mode', and
variables `appt-checking-p' and `view-appointments-initially'.
Miscellaneous Calendar Variables and Hooks
------------------------------------------
The variable `calendar-load-hook', whose default value is nil, is a
list of functions to be called when the calendar is first loaded.
The variable `initial-calendar-window-hook', whose default value is
nil, is 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.
The variable `today-visible-calendar-hook', whose default value is
nil, is the list of functions called after the \"*Calendar*\" buffer
has been prepared with the calendar when today's date is visible in
the window. This can be used, for example, to replace today's date
with asterisks. The function `calendar-star-date' is included for
this purpose: (setq today-visible-calendar-hook 'calendar-star-date)
It could also be used to mark (highlight) today's date. The function
`calendar-mark-today' is provided for this:
(setq today-visible-calendar-hook 'calendar-mark-today)
The variable `today-invisible-calendar-hook', whose default value is
nil, is the list of functions called after the calendar buffer has
been prepared with the calendar when doday's date is not visible in
the window.
Calendar Mode Bindings
----------------------
\\{calendar-mode-map}---------------------------------------------------\
---------"
(old-calendar-mode))
(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 (unless prefix ARG---see below).
Optional prefix argument ARG controls what 3-month period is used---
that is, what month takes the place of the current month. Whenever a
different month is used in place of the current, the cursor is placed
on the first day of that month.
If called with an explicit numerical ARG (e.g. `\\[universal-argument] 2'), \
the calendar
is displayed ARG months in the future (ARG > 0) or in the past (< 0).
If called with just `\\[universal-argument]', without an \
explicit number (so that ARG is
a consp), then `calendar' prompts for the month (and year) to use in
place of the current month.
This function is suitable for execution in your `~/.emacs' file.
Appropriate setting of the variable `view-diary-entries-initially'
causes the diary entries for today's 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 a day, a week, a month,
or a year. All such commands take prefix arguments which, when
negative, cause movement in the opposite direction. The digit keys
\(0-9) and the minus sign (-) are automatically prefixes. The window
is redisplayed as necessary to show the desired date.
Diary entries can be marked (i.e. highlighted) on the calendar, or
shown in another window.
Use `\\[describe-mode]' for details of key bindings in the calendar window.
The Gregorian calendar is assumed.
After loading calendar, the hooks in `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
`initial-calendar-window-hook' are run.
The hooks given by variable `today-visible-calendar-hook' are run
every time the calendar window gets scrolled, provided today's date is
visible in the window. If it is not visible, the hooks given by the
variable `today-invisible-calendar-hook' are run instead. Thus, for
example, setting `today-visible-calendar-hook' to `calendar-star-date'
will cause today's date to be replaced by asterisks whenever it is in
the window."
(interactive "P")
(require 'calendar)
(set-buffer (get-buffer-create calendar-buffer))
(calendar-mode)
(let* ((completion-ignore-case t)
(pop-up-windows t)
(split-height-threshold 1000)
(date (if arg (calendar-read-date t) (calendar-current-date)))
(just-ctl-u (consp arg))
(month
(cond (just-ctl-u
(cdr (assoc
(capitalize
(completing-read
"Month name: "
(mapcar (function list)
(append calendar-month-name-array nil))
nil t))
(calendar-make-alist calendar-month-name-array))))
(arg
(% (+ arg (extract-calendar-month date)) 12))
(t
(extract-calendar-month date))))
(year
(cond (just-ctl-u
(calendar-read
"Year (>0): "
'(lambda (x) (> x 0))
(int-to-string (extract-calendar-year date))))
(arg
(+ (/ (+ arg (extract-calendar-month date)) 12)
(extract-calendar-year date)))
(t
(extract-calendar-year date)))))
(unless month (setq month (extract-calendar-month date)))
(while (< month 0)
(incf month 12) (decf year 1))
(pop-to-buffer calendar-buffer)
(increment-calendar-month month year (- calendar-offset))
(if (fboundp 'calendar-generate-window)
(calendar-generate-window month year)
(generate-calendar-window month year))
(when (and view-diary-entries-initially (calendar-date-is-visible-p date))
(view-diary-entries
(if (vectorp number-of-diary-entries)
(aref number-of-diary-entries (calendar-day-of-week date))
number-of-diary-entries)))
(let* ((diary-buffer (get-file-buffer diary-file))
(diary-window (and diary-buffer (get-buffer-window diary-buffer)))
(split-height-threshold (if diary-window 2 1000)))
(when view-calendar-holidays-initially
(increment-calendar-month displayed-month displayed-year 1)
(save-excursion (list-calendar-holidays))
(increment-calendar-month displayed-month displayed-year -1))))
(when (fboundp 'make-transient-mark-mode-buffer-local)
(make-transient-mark-mode-buffer-local))
(run-hooks 'initial-calendar-window-hook))
(defun insert-diary-entry (arg)
"Insert a diary entry for the date indicated by point.
Prefix ARG makes the entry nonmarking."
(interactive "P")
(make-diary-entry
(concat (calendar-date-string (calendar-cursor-to-date t) t t)
(and european-calendar-style " :"))
arg))
(defun generate-calendar-month (month year indent)
"Produce a calendar for MONTH, YEAR on the Gregorian calendar.
The calendar is inserted in the buffer starting at the line on which point
is currently 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."
(require 'calendar)
(let* ((blank-days (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)
(calendar-for-loop i from 0 to 6 do
(insert (calendar-day-name (mod (+ calendar-week-start-day i) 7)
2 t))
(insert " "))
(calendar-insert-indented "" 0 t)
(calendar-insert-indented "" indent)
(calendar-for-loop i from 1 to blank-days do (insert " "))
(calendar-for-loop i from 1 to last do
(insert (format "%2d " i))
(put-text-property (- (point) (if (< i 10) 2 3)) (1- (point))
'mouse-face 'highlight)
(when (memq (calendar-day-of-week (list month i year)) '(0 6))
(put-text-property (- (point) 3) (1- (point))
'face weekend-face))
(and (zerop (mod (+ i blank-days) 7))
(/= i last)
(calendar-insert-indented "" 0 t)
(calendar-insert-indented "" indent)))))
(defun calendar-count-days-region (&optional weekdays-only-p)
"Count days between point and mark (inclusive). Weekdays if prefix.
If WEEKDAYS-ONLY-P arg is non-nil, only weekdays (Mon-Fri) are counted.
Mark the days in the calendar region, provided it is entirely visible.
Return the number of days in the calendar region, in any case."
(interactive "P")
(if weekdays-only-p
(calendar-count-weekdays-region)
(require 'calendar)
(let* ((point-date (calendar-cursor-to-date t))
(mark-date (or (car calendar-mark-ring)
(error "No region in Calendar (no mark set)")))
(max-date-pt-mark (if (calendar-date-compare (list point-date)
(list mark-date))
mark-date
point-date))
(cons-max-date (list max-date-pt-mark))
return-value)
(save-excursion
(let* ((num-days (- (calendar-absolute-from-gregorian point-date)
(calendar-absolute-from-gregorian mark-date)))
(num-days (1+ (if (> num-days 0) num-days (- num-days)))))
(setq return-value num-days)
(when (calendar-date-is-visible-p point-date)
(cond ((= 1 num-days)
(redraw-calendar)
(mark-visible-calendar-date (calendar-cursor-to-date t)
calendar-region-marker 100))
((calendar-date-is-visible-p mark-date)
(message "Marking days in region...")
(redraw-calendar)
(unless (calendar-date-compare (list point-date)
(list mark-date))
(calendar-exchange-point-and-mark))
(while (> num-days 0)
(mark-visible-calendar-date (calendar-cursor-to-date t)
calendar-region-marker 100)
(when (calendar-date-compare
(list (calendar-cursor-to-date t)) cons-max-date)
(calendar-forward-day 1))
(decf num-days)))))))
(when (mark-marker) (set-marker (mark-marker) nil))
(unless (calendar-date-equal (calendar-cursor-to-nearest-date)
max-date-pt-mark)
(if (calendar-date-equal mark-date max-date-pt-mark)
(calendar-goto-date point-date)
(calendar-goto-date mark-date)
(calendar-exchange-point-and-mark)))
(message "Region has %d day%s (including cursor and marked dates)."
return-value (if (> return-value 1) "s" ""))
return-value)))
(defun calendar-count-weekdays-region ()
"Count the weekdays between the point and the mark (inclusive).
Mark the days in the calendar region, provided it is entirely visible.
Return the number of weekdays in the calendar region, in any case."
(interactive)
(require 'calendar)
(let ((point-date (calendar-cursor-to-date t))
(mark-date (or (car calendar-mark-ring)
(error "No region in Calendar (no mark set)")))
(num-weekdays 0)
(mark-days-p nil)
max-date-pt-mark
cons-max-date+1
temp-date
return-value)
(if (calendar-date-compare (list point-date) (list mark-date))
(setq max-date-pt-mark mark-date)
(setq max-date-pt-mark point-date)
(calendar-exchange-point-and-mark))
(setq cons-max-date+1
(list (calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian max-date-pt-mark)))))
(when (setq mark-days-p (and (calendar-date-is-visible-p point-date)
(calendar-date-is-visible-p mark-date)))
(message "Marking days in region...")
(redraw-calendar))
(while (calendar-date-compare
(list (setq temp-date (calendar-cursor-to-date t)))
cons-max-date+1)
(when (memq (calendar-day-of-week temp-date) '(1 2 3 4 5))
(incf num-weekdays)
(when mark-days-p
(mark-visible-calendar-date temp-date
calendar-region-marker 100)))
(calendar-forward-day 1))
(setq return-value num-weekdays)
(when (mark-marker) (set-marker (mark-marker) nil))
(if (calendar-date-equal mark-date max-date-pt-mark)
(calendar-goto-date point-date)
(calendar-goto-date mark-date)
(calendar-exchange-point-and-mark))
(message "Region has %d weekday%s (including cursor and marked dates)."
return-value (if (> return-value 1) "s" ""))
return-value))
(defun mark-visible-calendar-date (date &optional mark priority)
"Mark DATE in the calendar window with MARK, if not so marked already.
MARK is either a single-character string or a face.
MARK defaults to `diary-entry-marker'.
PRIORITY is an optional priority to give to MARK's face overlay."
(require 'calendar)
(when (calendar-date-is-legal-p date)
(save-excursion
(set-buffer calendar-buffer)
(calendar-cursor-to-visible-date date)
(let ((mark (or mark diary-entry-marker)))
(if (stringp mark)
(let ((buffer-read-only nil))
(forward-char 1)
(delete-char 1)
(insert mark)
(forward-char -2))
(unless (memq mark
(mapcar (function (lambda (ovr)
(overlay-get ovr 'face)))
(overlays-at (point))))
(let ((ovrly (make-overlay (1-(point)) (1+ (point)))))
(overlay-put ovrly 'face mark)
(when priority (overlay-put ovrly 'priority priority)))))))))
(defun solar-sunrise-sunset-string (date)
"String of *local* times of sunrise, sunset, and daylight on Gregorian DATE."
(require 'solar)
(let* ((l (solar-sunrise-sunset date))
(daylight (car (cdr (cdr l))))
(len (length daylight)))
(format
"%s, %s at %s (%s hr, %s min daylight)"
(if (car l)
(concat "Sunrise " (apply 'solar-time-string (car l)))
"No sunrise")
(if (car (cdr l))
(concat "sunset " (apply 'solar-time-string (car (cdr l))))
"no sunset")
(eval calendar-location-name)
(if (= len 5)(substring daylight 0 2)(substring daylight 0 1))
(if (= len 5)(substring daylight 3 5)(substring daylight 2 4)))))
(defun calendar-mouse-drag-region (event)
"Like `mouse-drag-region', and marks days if dragged or multi-clicked.
Double click marks the day under pointer. Triple click marks the week.
Dragging marks the days dragged over."
(interactive "e")
(let ((click-count (event-click-count event)))
(mouse-drag-region event)
(if (> click-count 1)
(forward-char -1)
(calendar-cursor-to-nearest-date))
(case click-count
(1 (when (and mark-active (mark) (/= (point) (mark)))
(set-calendar-region-from-region)))
(2 (set-calendar-region-from-region)
(mouse-set-point event))
(3 (mouse-set-point event)
(let ((beg-week (progn (calendar-beginning-of-week 1) (point))))
(when (consp calendar-mark-ring)
(pop calendar-mark-ring))
(calendar-set-mark nil)
(calendar-end-of-week 1)
(calendar-count-days-region)
(calendar-exchange-point-and-mark))))))
(defun set-calendar-region-from-region ()
"Set the calendar region to include the days in the region."
(interactive)
(calendar-cursor-to-nearest-date)
(calendar-set-mark nil)
(exchange-point-and-mark)
(calendar-cursor-to-nearest-date)
(calendar-count-days-region))
(defun mark-local-holidays ()
"Mark local holidays in the calendar window."
(interactive)
(message "Marking local holidays...")
(let ((holiday-list (calendar-local-holiday-list)))
(while holiday-list
(mark-visible-calendar-date
(caar holiday-list) calendar-local-holiday-marker)
(setq holiday-list (cdr holiday-list))))
(message "Marking local holidays...done"))
(defsubst calendar-local-holiday-list ()
"Form list of local holidays that occur on dates in calendar window.
The holidays are those in the list `local-holidays'."
(let ((calendar-holidays local-holidays))
(calendar-holiday-list)))
(defun monday-after-easter ()
"Monday after Easter, as visible in calendar window."
(unless (and (> displayed-month 5) (not all-christian-calendar-holidays))
(let* ((century (1+ (/ displayed-year 100)))
(shifted-epact
(% (+ 14 (* 11 (% displayed-year 19))
(-
(/ (* 3 century) 4))
(/
(+ 5 (* 8 century)) 25)
(* 30 century))
30))
(adjusted-epact
(if (or (= shifted-epact 0)
(and (= shifted-epact 1) (< 10 (% displayed-year 19))))
(1+ shifted-epact)
shifted-epact))
(paschal-moon
(- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
adjusted-epact))
(abs-easter
(calendar-dayname-on-or-before 0 (+ paschal-moon 7))))
(filter-visible-calendar-holidays
(list (list (calendar-gregorian-from-absolute (1+ abs-easter))
"Lundi de Pâques -- Ferié"))))))