code.delx.au - gnu-emacs/blob - lisp/calendar/calendar.el

   1 ;;; calendar.el --- calendar functions
   2
   3 ;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997,
   4 ;;      2000, 2001, 2003, 2004, 2005  Free Software Foundation, Inc.
   5
   6 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
   7 ;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
   8 ;; Keywords: calendar
   9 ;; Human-Keywords: calendar, Gregorian calendar, diary, holidays
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; This collection of functions implements a calendar window.  It
  31 ;; generates a calendar for the current month, together with the
  32 ;; previous and coming months, or for any other three-month period.
  33 ;; The calendar can be scrolled forward and backward in the window to
  34 ;; show months in the past or future; the cursor can move forward and
  35 ;; backward by days, weeks, or months, making it possible, for
  36 ;; instance, to jump to the date a specified number of days, weeks, or
  37 ;; months from the date under the cursor.  The user can display a list
  38 ;; of holidays and other notable days for the period shown; the
  39 ;; notable days can be marked on the calendar, if desired.  The user
  40 ;; can also specify that dates having corresponding diary entries (in
  41 ;; a file that the user specifies) be marked; the diary entries for
  42 ;; any date can be viewed in a separate window.  The diary and the
  43 ;; notable days can be viewed independently of the calendar.  Dates
  44 ;; can be translated from the (usual) Gregorian calendar to the day of
  45 ;; the year/days remaining in year, to the ISO commercial calendar, to
  46 ;; the Julian (old style) calendar, to the Hebrew calendar, to the
  47 ;; Islamic calendar, to the Baha'i calendar, to the French
  48 ;; Revolutionary calendar, to the Mayan calendar, to the Chinese
  49 ;; calendar, to the Coptic calendar, to the Ethiopic calendar, and to
  50 ;; the astronomical (Julian) day number.  When floating point is
  51 ;; available, times of sunrise/sunset can be displayed, as can the
  52 ;; phases of the moon.  Appointment notification for diary entries is
  53 ;; available.  Calendar printing via LaTeX is available.
  54
  55 ;; The following files are part of the calendar/diary code:
  56
  57 ;;       appt.el                       Appointment notification
  58 ;;       cal-china.el                  Chinese calendar
  59 ;;       cal-coptic.el                 Coptic/Ethiopic calendars
  60 ;;       cal-dst.el                    Daylight savings time rules
  61 ;;       cal-hebrew.el                 Hebrew calendar
  62 ;;       cal-islam.el                  Islamic calendar
  63 ;;       cal-bahai.el                  Baha'i calendar
  64 ;;       cal-iso.el                    ISO calendar
  65 ;;       cal-julian.el                 Julian/astronomical calendars
  66 ;;       cal-mayan.el                  Mayan calendars
  67 ;;       cal-menu.el                   Menu support
  68 ;;       cal-move.el                   Movement in the calendar
  69 ;;       cal-persia.el                 Persian calendar
  70 ;;       cal-tex.el                    Calendars in LaTeX
  71 ;;       cal-x.el                      X-windows dedicated frame functions
  72 ;;       diary-lib.el                  Diary functions
  73 ;;       holidays.el                   Holiday functions
  74 ;;       lunar.el                      Phases of the moon
  75 ;;       solar.el                      Sunrise/sunset, equinoxes/solstices
  76
  77 ;; Technical details of all the calendrical calculations can be found in
  78 ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
  79 ;; Cambridge University Press (1997).
  80
  81 ;; An earlier version of the technical details appeared in
  82 ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
  83 ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
  84 ;; pages 899-928.  ``Calendrical Calculations, Part II: Three Historical
  85 ;; Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M. Clamen,
  86 ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
  87 ;; pages 383-404.
  88
  89 ;; Hard copies of these two papers can be obtained by sending email to
  90 ;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
  91 ;; the message BODY containing your mailing address (snail).
  92
  93 ;; Comments, corrections, and improvements should be sent to
  94 ;;  Edward M. Reingold               Department of Computer Science
  95 ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
  96 ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
  97 ;;                                   Urbana, Illinois 61801
  98
  99 ;;; Code:
 100
 101 (eval-when-compile
 102   (defvar displayed-month)
 103   (defvar displayed-year)
 104   (defvar calendar-month-name-array)
 105   (defvar calendar-starred-day))
 106
 107 (defun calendar-version ()
 108   (interactive)
 109   (message "Version 6, October 12, 1995"))
 110
 111 (defgroup calendar nil
 112   "Calendar and time management support."
 113   :group 'applications)
 114
 115 (defgroup diary nil
 116   "Emacs diary."
 117   :group 'calendar)
 118
 119 (defgroup appt nil
 120   "Appointment notification."
 121   :group 'calendar)
 122
 123 (defgroup holidays nil
 124   "Holidays support in calendar."
 125   :group 'calendar
 126   :prefix "calendar-"
 127   :group 'local)
 128
 129 (defgroup chinese-calendar nil
 130   "Chinese calendar support."
 131   :group 'calendar)
 132
 133 (defgroup calendar-tex nil
 134   "Options for printing calendar with LaTeX."
 135   :prefix "cal-tex-"
 136   :group 'calendar)
 137
 138 (defgroup calendar-hooks nil
 139   "Calendar hooks."
 140   :prefix "calendar-"
 141   :group 'calendar)
 142
 143
 144 (defconst calendar-buffer "*Calendar*"
 145   "Name of the buffer used for the calendar.")
 146
 147 ;;;###autoload
 148 (defcustom calendar-offset 0
 149   "*The offset of the principal month from the center of the calendar window.
 150 0 means the principal month is in the center (default), -1 means on the left,
 151 +1 means on the right.  Larger (or smaller) values push the principal month off
 152 the screen."
 153   :type 'integer
 154   :group 'calendar)
 155
 156 ;;;###autoload
 157 (defcustom view-diary-entries-initially nil
 158   "*Non-nil means display current date's diary entries on entry to calendar.
 159 The diary is displayed in another window when the calendar is first displayed,
 160 if the current date is visible.  The number of days of diary entries displayed
 161 is governed by the variable `number-of-diary-entries'.  This variable can
 162 be overridden by the value of `calendar-setup'."
 163   :type 'boolean
 164   :group 'diary)
 165
 166 ;;;###autoload
 167 (defcustom number-of-diary-entries 1
 168   "*Specifies how many days of diary entries are to be displayed initially.
 169 This variable affects the diary display when the command \\[diary] is used,
 170 or if the value of the variable `view-diary-entries-initially' is t.  For
 171 example, if the default value 1 is used, then only the current day's diary
 172 entries will be displayed.  If the value 2 is used, then both the current
 173 day's and the next day's entries will be displayed.
 174
 175 The value can also be a vector such as [0 2 2 2 2 4 1]; this value
 176 says to display no diary entries on Sunday, the display the entries
 177 for the current date and the day after on Monday through Thursday,
 178 display Friday through Monday's entries on Friday, and display only
 179 Saturday's entries on Saturday.
 180
 181 This variable does not affect the diary display with the `d' command
 182 from the calendar; in that case, the prefix argument controls the
 183 number of days of diary entries displayed."
 184   :type '(choice (integer :tag "Entries")
 185                  (vector :value [0 0 0 0 0 0 0]
 186                          (integer :tag "Sunday")
 187                          (integer :tag "Monday")
 188                          (integer :tag "Tuesday")
 189                          (integer :tag "Wednesday")
 190                          (integer :tag "Thursday")
 191                          (integer :tag "Friday")
 192                          (integer :tag "Saturday")))
 193   :group 'diary)
 194
 195 ;;;###autoload
 196 (defcustom mark-diary-entries-in-calendar nil
 197   "*Non-nil means mark dates with diary entries, in the calendar window.
 198 The marking symbol is specified by the variable `diary-entry-marker'."
 199   :type 'boolean
 200   :group 'diary)
 201
 202 ;;;###autoload
 203 (defcustom calendar-remove-frame-by-deleting nil
 204   "*Determine how the calendar mode removes a frame no longer needed.
 205 If nil, make an icon of the frame.  If non-nil, delete the frame."
 206   :type 'boolean
 207   :group 'view)
 208
 209 (defvar diary-face 'diary-face
 210   "Face name to use for diary entries.")
 211 (defface diary-face
 212   '((((class color) (background light))
 213      :foreground "red")
 214     (((class color) (background dark))
 215      :foreground "yellow")
 216     (t
 217      :weight bold))
 218   "Face for highlighting diary entries."
 219   :group 'diary)
 220
 221 (defface calendar-today-face
 222   '((t (:underline t)))
 223   "Face for indicating today's date."
 224   :group 'diary)
 225
 226 (defface holiday-face
 227   '((((class color) (background light))
 228      :background "pink")
 229     (((class color) (background dark))
 230      :background "chocolate4")
 231     (t
 232      :inverse-video t))
 233   "Face for indicating dates that have holidays."
 234   :group 'diary)
 235
 236 (eval-after-load "facemenu"
 237   '(progn
 238      (add-to-list 'facemenu-unlisted-faces 'diary-face)
 239      (add-to-list 'facemenu-unlisted-faces 'calendar-today-face)
 240      (add-to-list 'facemenu-unlisted-faces 'holiday-face)))
 241
 242 (defcustom diary-entry-marker
 243   (if (not (display-color-p))
 244       "+"
 245     'diary-face)
 246   "*How to mark dates that have diary entries.
 247 The value can be either a single-character string or a face."
 248   :type '(choice string face)
 249   :group 'diary)
 250
 251 (defcustom calendar-today-marker
 252   (if (not (display-color-p))
 253       "="
 254     'calendar-today-face)
 255   "*How to mark today's date in the calendar.
 256 The value can be either a single-character string or a face.
 257 Marking today's date is done only if you set up `today-visible-calendar-hook'
 258 to request that."
 259   :type '(choice string face)
 260   :group 'calendar)
 261
 262 (defcustom calendar-holiday-marker
 263   (if (not (display-color-p))
 264       "*"
 265     'holiday-face)
 266   "*How to mark notable dates in the calendar.
 267 The value can be either a single-character string or a face."
 268   :type '(choice string face)
 269   :group 'calendar)
 270
 271 ;;;###autoload
 272 (defcustom view-calendar-holidays-initially nil
 273   "*Non-nil means display holidays for current three month period on entry.
 274 The holidays are displayed in another window when the calendar is first
 275 displayed."
 276   :type 'boolean
 277   :group 'holidays)
 278
 279 ;;;###autoload
 280 (defcustom mark-holidays-in-calendar nil
 281   "*Non-nil means mark dates of holidays in the calendar window.
 282 The marking symbol is specified by the variable `calendar-holiday-marker'."
 283   :type 'boolean
 284   :group 'holidays)
 285
 286 ;;;###autoload
 287 (defcustom all-hebrew-calendar-holidays nil
 288   "*If nil, show only major holidays from the Hebrew calendar.
 289 This means only those Jewish holidays that appear on secular calendars.
 290
 291 If t, show all the holidays that would appear in a complete Hebrew calendar."
 292   :type 'boolean
 293   :group 'holidays)
 294
 295 ;;;###autoload
 296 (defcustom all-christian-calendar-holidays nil
 297   "*If nil, show only major holidays from the Christian calendar.
 298 This means only those Christian holidays that appear on secular calendars.
 299
 300 If t, show all the holidays that would appear in a complete Christian
 301 calendar."
 302   :type 'boolean
 303   :group 'holidays)
 304
 305 ;;;###autoload
 306 (defcustom all-islamic-calendar-holidays nil
 307   "*If nil, show only major holidays from the Islamic calendar.
 308 This means only those Islamic holidays that appear on secular calendars.
 309
 310 If t, show all the holidays that would appear in a complete Islamic
 311 calendar."
 312   :type 'boolean
 313   :group 'holidays)
 314
 315 (defcustom diary-file-name-prefix-function (function (lambda (str) str))
 316   "*The function that will take a diary file name and return the desired prefix."
 317   :type 'function
 318   :group 'diary)
 319
 320 ;;;###autoload
 321 (defcustom all-bahai-calendar-holidays nil
 322   "*If nil, show only major holidays from the Baha'i calendar.
 323 These are the days on which work and school must be suspended.
 324
 325 If t, show all the holidays that would appear in a complete Baha'i
 326 calendar."
 327   :type 'boolean
 328   :group 'holidays)
 329
 330 ;;;###autoload
 331 (defcustom calendar-load-hook nil
 332   "*List of functions to be called after the calendar is first loaded.
 333 This is the place to add key bindings to `calendar-mode-map'."
 334   :type 'hook
 335   :group 'calendar-hooks)
 336
 337 ;;;###autoload
 338 (defcustom initial-calendar-window-hook nil
 339   "*List of functions to be called when the calendar window is first opened.
 340 The functions invoked are called after the calendar window is opened, but
 341 once opened is never called again.  Leaving the calendar with the `q' command
 342 and reentering it will cause these functions to be called again."
 343   :type 'hook
 344   :group 'calendar-hooks)
 345
 346 ;;;###autoload
 347 (defcustom today-visible-calendar-hook nil
 348   "*List of functions called whenever the current date is visible.
 349 This can be used, for example, to replace today's date with asterisks; a
 350 function `calendar-star-date' is included for this purpose:
 351     (setq today-visible-calendar-hook 'calendar-star-date)
 352 It can also be used to mark the current date with `calendar-today-marker';
 353 a function is also provided for this:
 354     (setq today-visible-calendar-hook 'calendar-mark-today)
 355
 356 The corresponding variable `today-invisible-calendar-hook' is the list of
 357 functions called when the calendar function was called when the current
 358 date is not visible in the window.
 359
 360 Other than the use of the provided functions, the changing of any
 361 characters in the calendar buffer by the hooks may cause the failure of the
 362 functions that move by days and weeks."
 363   :type 'hook
 364   :group 'calendar-hooks)
 365
 366 ;;;###autoload
 367 (defcustom today-invisible-calendar-hook nil
 368   "*List of functions called whenever the current date is not visible.
 369
 370 The corresponding variable `today-visible-calendar-hook' is the list of
 371 functions called when the calendar function was called when the current
 372 date is visible in the window.
 373
 374 Other than the use of the provided functions, the changing of any
 375 characters in the calendar buffer by the hooks may cause the failure of the
 376 functions that move by days and weeks."
 377   :type 'hook
 378   :group 'calendar-hooks)
 379
 380 ;;;###autoload
 381 (defcustom calendar-move-hook nil
 382   "*List of functions called whenever the cursor moves in the calendar.
 383
 384 For example,
 385
 386   (add-hook 'calendar-move-hook (lambda () (view-diary-entries 1)))
 387
 388 redisplays the diary for whatever date the cursor is moved to."
 389   :type 'hook
 390   :group 'calendar-hooks)
 391
 392 ;;;###autoload
 393 (defcustom diary-file "~/diary"
 394   "*Name of the file in which one's personal diary of dates is kept.
 395
 396 The file's entries are lines beginning with any of the forms
 397 specified by the variable `american-date-diary-pattern', by default:
 398
 399             MONTH/DAY
 400             MONTH/DAY/YEAR
 401             MONTHNAME DAY
 402             MONTHNAME DAY, YEAR
 403             DAYNAME
 404
 405 with the remainder of the line being the diary entry string for
 406 that date.  MONTH and DAY are one or two digit numbers, YEAR is a
 407 number and may be written in full or abbreviated to the final two
 408 digits (if `abbreviated-calendar-year' is non-nil).  MONTHNAME
 409 and DAYNAME can be spelled in full (as specified by the variables
 410 `calendar-month-name-array' and `calendar-day-name-array'),
 411 abbreviated (as specified by `calendar-month-abbrev-array' and
 412 `calendar-day-abbrev-array') with or without a period,
 413 capitalized or not.  Any of DAY, MONTH, or MONTHNAME, YEAR can be
 414 `*' which matches any day, month, or year, respectively. If the
 415 date does not contain a year, it is generic and applies to any
 416 year.  A DAYNAME entry applies to the appropriate day of the week
 417 in every week.
 418
 419 The European style (in which the day precedes the month) can be
 420 used instead, if you execute `european-calendar' when in the
 421 calendar, or set `european-calendar-style' to t in your .emacs
 422 file.  The European forms (see `european-date-diary-pattern') are
 423
 424             DAY/MONTH
 425             DAY/MONTH/YEAR
 426             DAY MONTHNAME
 427             DAY MONTHNAME YEAR
 428             DAYNAME
 429
 430 To revert to the default American style from the European style, execute
 431 `american-calendar' in the calendar.
 432
 433 A diary entry can be preceded by the character
 434 `diary-nonmarking-symbol' (ordinarily `&') to make that entry
 435 nonmarking--that is, it will not be marked on dates in the calendar
 436 window but will appear in a diary window.
 437
 438 Multiline diary entries are made by indenting lines after the first with
 439 either a TAB or one or more spaces.
 440
 441 Lines not in one the above formats are ignored.  Here are some sample diary
 442 entries (in the default American style):
 443
 444      12/22/1988 Twentieth wedding anniversary!!
 445      &1/1. Happy New Year!
 446      10/22 Ruth's birthday.
 447      21: Payday
 448      Tuesday--weekly meeting with grad students at 10am
 449               Supowit, Shen, Bitner, and Kapoor to attend.
 450      1/13/89 Friday the thirteenth!!
 451      &thu 4pm squash game with Lloyd.
 452      mar 16 Dad's birthday
 453      April 15, 1989 Income tax due.
 454      &* 15 time cards due.
 455
 456 If the first line of a diary entry consists only of the date or day name with
 457 no trailing blanks or punctuation, then that line is not displayed in the
 458 diary window; only the continuation lines is shown.  For example, the
 459 single diary entry
 460
 461      02/11/1989
 462       Bill Blattner visits Princeton today
 463       2pm Cognitive Studies Committee meeting
 464       2:30-5:30 Lizzie at Lawrenceville for `Group Initiative'
 465       4:00pm Jamie Tappenden
 466       7:30pm Dinner at George and Ed's for Alan Ryan
 467       7:30-10:00pm dance at Stewart Country Day School
 468
 469 will appear in the diary window without the date line at the beginning.  This
 470 facility allows the diary window to look neater, but can cause confusion if
 471 used with more than one day's entries displayed.
 472
 473 Diary entries can be based on Lisp sexps.  For example, the diary entry
 474
 475       %%(diary-block 11 1 1990 11 10 1990) Vacation
 476
 477 causes the diary entry \"Vacation\" to appear from November 1 through
 478 November 10, 1990.  Other functions available are `diary-float',
 479 `diary-anniversary', `diary-cyclic', `diary-day-of-year',
 480 `diary-iso-date', `diary-french-date', `diary-hebrew-date',
 481 `diary-islamic-date', `diary-bahai-date', `diary-mayan-date',
 482 `diary-chinese-date', `diary-coptic-date', `diary-ethiopic-date',
 483 `diary-persian-date', `diary-yahrzeit', `diary-sunrise-sunset',
 484 `diary-phases-of-moon', `diary-parasha', `diary-omer',
 485 `diary-rosh-hodesh', and `diary-sabbath-candles'.  See the
 486 documentation for the function `list-sexp-diary-entries' for more
 487 details.
 488
 489 Diary entries based on the Hebrew, the Islamic and/or the Baha'i
 490 calendar are also possible, but because these are somewhat slow, they
 491 are ignored unless you set the `nongregorian-diary-listing-hook' and
 492 the `nongregorian-diary-marking-hook' appropriately.  See the
 493 documentation for these functions for details.
 494
 495 Diary files can contain directives to include the contents of other files; for
 496 details, see the documentation for the variable `list-diary-entries-hook'."
 497   :type 'file
 498   :group 'diary)
 499
 500 ;;;###autoload
 501 (defcustom diary-nonmarking-symbol "&"
 502   "*Symbol indicating that a diary entry is not to be marked in the calendar."
 503   :type 'string
 504   :group 'diary)
 505
 506 ;;;###autoload
 507 (defcustom hebrew-diary-entry-symbol "H"
 508   "*Symbol indicating a diary entry according to the Hebrew calendar."
 509   :type 'string
 510   :group 'diary)
 511
 512 ;;;###autoload
 513 (defcustom islamic-diary-entry-symbol "I"
 514   "*Symbol indicating a diary entry according to the Islamic calendar."
 515   :type 'string
 516   :group 'diary)
 517
 518 ;;;###autoload
 519 (defcustom bahai-diary-entry-symbol "B"
 520   "*Symbol indicating a diary entry according to the Baha'i calendar."
 521   :type 'string
 522   :group 'diary)
 523
 524 ;;;###autoload
 525 (defcustom diary-include-string "#include"
 526   "*The string indicating inclusion of another file of diary entries.
 527 See the documentation for the function `include-other-diary-files'."
 528   :type 'string
 529   :group 'diary)
 530
 531 (defcustom diary-glob-file-regexp-prefix "^\\#"
 532   "*The regular expression that gets pre-pended to each of the attribute-regexp's for file-wide specifiers."
 533   :type 'regexp
 534   :group 'diary)
 535
 536 (defcustom diary-face-attrs
 537   '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string)
 538     (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string)
 539     (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol)
 540     (" *\\[height:\\([-0-9a-z]+\\)\\]$" 1 :height int)
 541     (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol)
 542     (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol)
 543     (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil)
 544     (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil)
 545     (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil)
 546     (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil)
 547     (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string)
 548     (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string)
 549     ;; Unsupported.
 550 ;;;    (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box)
 551 ;;;    (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple)
 552     )
 553   "*A list of (regexp regnum attr attrtype) lists where the
 554 regexp says how to find the tag, the regnum says which
 555 parenthetical sub-regexp this regexp looks for, and the attr says
 556 which attribute of the face (or that this _is_ a face) is being
 557 modified."
 558   :type 'sexp
 559   :group 'diary)
 560
 561 (defcustom diary-file-name-prefix nil
 562   "If non-nil each diary entry is prefixed with the name of the file where it is defined."
 563   :type 'boolean
 564   :group 'diary)
 565
 566 ;;;###autoload
 567 (defcustom sexp-diary-entry-symbol "%%"
 568   "*The string used to indicate a sexp diary entry in `diary-file'.
 569 See the documentation for the function `list-sexp-diary-entries'."
 570   :type 'string
 571   :group 'diary)
 572
 573 ;;;###autoload
 574 (defcustom abbreviated-calendar-year t
 575   "*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
 576 For the Gregorian calendar; similarly for the Hebrew, Islamic and
 577 Baha'i calendars.  If this variable is nil, years must be written in
 578 full."
 579   :type 'boolean
 580   :group 'diary)
 581
 582 ;;;###autoload
 583 (defcustom european-calendar-style nil
 584   "*Use the European style of dates in the diary and in any displays.
 585 If this variable is t, a date 1/2/1990 would be interpreted as February 1,
 586 1990.  The default European date styles (see `european-date-diary-pattern')
 587 are
 588
 589             DAY/MONTH
 590             DAY/MONTH/YEAR
 591             DAY MONTHNAME
 592             DAY MONTHNAME YEAR
 593             DAYNAME
 594
 595 Names can be capitalized or not, written in full (as specified by the
 596 variable `calendar-day-name-array'), or abbreviated (as specified by
 597 `calendar-day-abbrev-array') with or without a period.  To take effect,
 598 this variable should be set before the calendar package and its associates
 599 are loaded.  Otherwise, use one of the functions `european-calendar' or
 600 `american-calendar' to force the appropriate update."
 601   :type 'boolean
 602   :group 'diary)
 603
 604 ;;;###autoload
 605 (defcustom american-date-diary-pattern
 606   '((month "/" day "[^/0-9]")
 607     (month "/" day "/" year "[^0-9]")
 608     (monthname " *" day "[^,0-9]")
 609     (monthname " *" day ", *" year "[^0-9]")
 610     (dayname "\\W"))
 611   "*List of pseudo-patterns describing the American patterns of date used.
 612 See the documentation of `diary-date-forms' for an explanation."
 613   :type '(repeat (choice (cons :tag "Backup"
 614                                :value (backup . nil)
 615                                (const backup)
 616                                (repeat (list :inline t :format "%v"
 617                                              (symbol :tag "Keyword")
 618                                              (choice symbol regexp))))
 619                          (repeat (list :inline t :format "%v"
 620                                        (symbol :tag "Keyword")
 621                                        (choice symbol regexp)))))
 622   :group 'diary)
 623
 624 ;;;###autoload
 625 (defcustom european-date-diary-pattern
 626   '((day "/" month "[^/0-9]")
 627     (day "/" month "/" year "[^0-9]")
 628     (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)")
 629     (day " *" monthname " *" year "[^0-9]")
 630     (dayname "\\W"))
 631   "*List of pseudo-patterns describing the European patterns of date used.
 632 See the documentation of `diary-date-forms' for an explanation."
 633   :type '(repeat (choice (cons :tag "Backup"
 634                                :value (backup . nil)
 635                                (const backup)
 636                                (repeat (list :inline t :format "%v"
 637                                              (symbol :tag "Keyword")
 638                                              (choice symbol regexp))))
 639                          (repeat (list :inline t :format "%v"
 640                                        (symbol :tag "Keyword")
 641                                        (choice symbol regexp)))))
 642   :group 'diary)
 643
 644 (defcustom diary-date-forms
 645   (if european-calendar-style
 646       european-date-diary-pattern
 647     american-date-diary-pattern)
 648   "*List of pseudo-patterns describing the forms of date used in the diary.
 649 The patterns on the list must be MUTUALLY EXCLUSIVE and should not match
 650 any portion of the diary entry itself, just the date component.
 651
 652 A pseudo-pattern is a list of regular expressions and the keywords `month',
 653 `day', `year', `monthname', and `dayname'.  The keyword `monthname' will
 654 match the name of the month (see `calendar-month-name-array'), capitalized
 655 or not, or its user-specified abbreviation (see `calendar-month-abbrev-array'),
 656 followed by a period or not; it will also match `*'.  Similarly, `dayname'
 657 will match the name of the day (see `calendar-day-name-array'), capitalized or
 658 not, or its user-specified abbreviation (see `calendar-day-abbrev-array'),
 659 followed by a period or not.  The keywords `month', `day', and `year' will
 660 match those numerical values, preceded by arbitrarily many zeros; they will
 661 also match `*'.
 662
 663 The matching of the diary entries with the date forms is done with the
 664 standard syntax table from Fundamental mode, but with the `*' changed so
 665 that it is a word constituent.
 666
 667 If, to be mutually exclusive, a pseudo-pattern must match a portion of the
 668 diary entry itself, the first element of the pattern MUST be `backup'.  This
 669 directive causes the date recognizer to back up to the beginning of the
 670 current word of the diary entry, so in no case can the pattern match more than
 671 a portion of the first word of the diary entry."
 672   :type '(repeat (choice (cons :tag "Backup"
 673                                :value (backup . nil)
 674                                (const backup)
 675                                (repeat (list :inline t :format "%v"
 676                                              (symbol :tag "Keyword")
 677                                              (choice symbol regexp))))
 678                          (repeat (list :inline t :format "%v"
 679                                        (symbol :tag "Keyword")
 680                                        (choice symbol regexp)))))
 681   :group 'diary)
 682
 683 ;;;###autoload
 684 (defcustom european-calendar-display-form
 685   '((if dayname (concat dayname ", ")) day " " monthname " " year)
 686   "*Pseudo-pattern governing the way a date appears in the European style.
 687 See the documentation of `calendar-date-display-form' for an explanation."
 688   :type 'sexp
 689   :group 'calendar)
 690
 691 ;;;###autoload
 692 (defcustom american-calendar-display-form
 693   '((if dayname (concat dayname ", ")) monthname " " day ", " year)
 694   "*Pseudo-pattern governing the way a date appears in the American style.
 695 See the documentation of `calendar-date-display-form' for an explanation."
 696   :type 'sexp
 697   :group 'calendar)
 698
 699 (defcustom calendar-date-display-form
 700   (if european-calendar-style
 701       european-calendar-display-form
 702     american-calendar-display-form)
 703   "*Pseudo-pattern governing the way a date appears.
 704
 705 Used by the function `calendar-date-string', a pseudo-pattern is a list of
 706 expressions that can involve the keywords `month', `day', and `year', all
 707 numbers in string form, and `monthname' and `dayname', both alphabetic
 708 strings.  For example, the ISO standard would use the pseudo- pattern
 709
 710        '(year \"-\" month \"-\" day)
 711
 712 while a typical American form would be
 713
 714        '(month \"/\" day \"/\" (substring year -2))
 715
 716 and
 717
 718        '((format \"%9s, %9s %2s, %4s\" dayname monthname day year))
 719
 720 would give the usual American style in fixed-length fields.
 721
 722 See the documentation of the function `calendar-date-string'."
 723   :type 'sexp
 724   :group 'calendar)
 725
 726 (defun european-calendar ()
 727   "Set the interpretation and display of dates to the European style."
 728   (interactive)
 729   (setq european-calendar-style t)
 730   (setq calendar-date-display-form european-calendar-display-form)
 731   (setq diary-date-forms european-date-diary-pattern)
 732   (update-calendar-mode-line))
 733
 734 (defun american-calendar ()
 735   "Set the interpretation and display of dates to the American style."
 736   (interactive)
 737   (setq european-calendar-style nil)
 738   (setq calendar-date-display-form american-calendar-display-form)
 739   (setq diary-date-forms american-date-diary-pattern)
 740   (update-calendar-mode-line))
 741
 742 ;;;###autoload
 743 (defcustom print-diary-entries-hook 'lpr-buffer
 744   "*List of functions called after a temporary diary buffer is prepared.
 745 The buffer shows only the diary entries currently visible in the diary
 746 buffer.  The default just does the printing.  Other uses might include, for
 747 example, rearranging the lines into order by day and time, saving the buffer
 748 instead of deleting it, or changing the function used to do the printing."
 749   :type 'hook
 750   :group 'diary)
 751
 752 ;;;###autoload
 753 (defcustom list-diary-entries-hook nil
 754   "*List of functions called after diary file is culled for relevant entries.
 755 It is to be used for diary entries that are not found in the diary file.
 756
 757 A function `include-other-diary-files' is provided for use as the value of
 758 this hook.  This function enables you to use shared diary files together
 759 with your own.  The files included are specified in the diary file by lines
 760 of the form
 761
 762         #include \"filename\"
 763
 764 This is recursive; that is, #include directives in files thus included are
 765 obeyed.  You can change the \"#include\" to some other string by changing
 766 the variable `diary-include-string'.  When you use `include-other-diary-files'
 767 as part of the list-diary-entries-hook, you will probably also want to use the
 768 function `mark-included-diary-files' as part of `mark-diary-entries-hook'.
 769
 770 For example, you could use
 771
 772      (setq list-diary-entries-hook
 773        '(include-other-diary-files sort-diary-entries))
 774      (setq diary-display-hook 'fancy-diary-display)
 775
 776 in your `.emacs' file to cause the fancy diary buffer to be displayed with
 777 diary entries from various included files, each day's entries sorted into
 778 lexicographic order."
 779   :type 'hook
 780   :options '(include-other-diary-files sort-diary-entries)
 781   :group 'diary)
 782
 783 ;;;###autoload
 784 (defcustom diary-hook nil
 785   "*List of functions called after the display of the diary.
 786 Can be used for appointment notification."
 787   :type 'hook
 788   :group 'diary)
 789
 790 ;;;###autoload
 791 (defcustom diary-display-hook nil
 792   "*List of functions that handle the display of the diary.
 793 If nil (the default), `simple-diary-display' is used.  Use `ignore' for no
 794 diary display.
 795
 796 Ordinarily, this just displays the diary buffer (with holidays indicated in
 797 the mode line), if there are any relevant entries.  At the time these
 798 functions are called, the variable `diary-entries-list' is a list, in order
 799 by date, of all relevant diary entries in the form of ((MONTH DAY YEAR)
 800 STRING), where string is the diary entry for the given date.  This can be
 801 used, for example, a different buffer for display (perhaps combined with
 802 holidays), or produce hard copy output.
 803
 804 A function `fancy-diary-display' is provided as an alternative
 805 choice for this hook; this function prepares a special noneditable diary
 806 buffer with the relevant diary entries that has neat day-by-day arrangement
 807 with headings.  The fancy diary buffer will show the holidays unless the
 808 variable `holidays-in-diary-buffer' is set to nil.  Ordinarily, the fancy
 809 diary buffer will not show days for which there are no diary entries, even
 810 if that day is a holiday; if you want such days to be shown in the fancy
 811 diary buffer, set the variable `diary-list-include-blanks' to t."
 812   :type 'hook
 813   :options '(fancy-diary-display)
 814   :group 'diary)
 815
 816 ;;;###autoload
 817 (defcustom nongregorian-diary-listing-hook nil
 818   "*List of functions called for listing diary file and included files.
 819 As the files are processed for diary entries, these functions are used
 820 to cull relevant entries.  You can use either or both of
 821 `list-hebrew-diary-entries', `list-islamic-diary-entries' and
 822 `list-bahai-diary-entries'.  The documentation for these functions
 823 describes the style of such diary entries."
 824   :type 'hook
 825   :options '(list-hebrew-diary-entries
 826              list-islamic-diary-entries
 827              list-bahai-diary-entries)
 828   :group 'diary)
 829
 830 ;;;###autoload
 831 (defcustom mark-diary-entries-hook nil
 832   "*List of functions called after marking diary entries in the calendar.
 833
 834 A function `mark-included-diary-files' is also provided for use as the
 835 `mark-diary-entries-hook'; it enables you to use shared diary files together
 836 with your own.  The files included are specified in the diary file by lines
 837 of the form
 838         #include \"filename\"
 839 This is recursive; that is, #include directives in files thus included are
 840 obeyed.  You can change the \"#include\" to some other string by changing the
 841 variable `diary-include-string'.  When you use `mark-included-diary-files' as
 842 part of the mark-diary-entries-hook, you will probably also want to use the
 843 function `include-other-diary-files' as part of `list-diary-entries-hook'."
 844   :type 'hook
 845   :options '(mark-included-diary-files)
 846   :group 'diary)
 847
 848 ;;;###autoload
 849 (defcustom nongregorian-diary-marking-hook nil
 850   "*List of functions called for marking diary file and included files.
 851 As the files are processed for diary entries, these functions are used
 852 to cull relevant entries.  You can use either or both of
 853 `mark-hebrew-diary-entries', `mark-islamic-diary-entries' and
 854 `mark-bahai-diary-entries'.  The documentation for these functions
 855 describes the style of such diary entries."
 856   :type 'hook
 857   :options '(mark-hebrew-diary-entries
 858              mark-islamic-diary-entries
 859              mark-bahai-diary-entries)
 860   :group 'diary)
 861
 862 ;;;###autoload
 863 (defcustom diary-list-include-blanks nil
 864   "*If nil, do not include days with no diary entry in the list of diary entries.
 865 Such days will then not be shown in the fancy diary buffer, even if they
 866 are holidays."
 867   :type 'boolean
 868   :group 'diary)
 869
 870 ;;;###autoload
 871 (defcustom holidays-in-diary-buffer t
 872   "*Non-nil means include holidays in the diary display.
 873 The holidays appear in the mode line of the diary buffer, or in the
 874 fancy diary buffer next to the date.  This slows down the diary functions
 875 somewhat; setting it to nil makes the diary display faster."
 876   :type 'boolean
 877   :group 'holidays)
 878
 879 (defvar calendar-mark-ring nil)
 880
 881 ;;;###autoload
 882 (put 'general-holidays 'risky-local-variable t)
 883 ;;;###autoload
 884 (defcustom general-holidays
 885   '((holiday-fixed 1 1 "New Year's Day")
 886     (holiday-float 1 1 3 "Martin Luther King Day")
 887     (holiday-fixed 2 2 "Groundhog Day")
 888     (holiday-fixed 2 14 "Valentine's Day")
 889     (holiday-float 2 1 3 "President's Day")
 890     (holiday-fixed 3 17 "St. Patrick's Day")
 891     (holiday-fixed 4 1 "April Fools' Day")
 892     (holiday-float 5 0 2 "Mother's Day")
 893     (holiday-float 5 1 -1 "Memorial Day")
 894     (holiday-fixed 6 14 "Flag Day")
 895     (holiday-float 6 0 3 "Father's Day")
 896     (holiday-fixed 7 4 "Independence Day")
 897     (holiday-float 9 1 1 "Labor Day")
 898     (holiday-float 10 1 2 "Columbus Day")
 899     (holiday-fixed 10 31 "Halloween")
 900     (holiday-fixed 11 11 "Veteran's Day")
 901     (holiday-float 11 4 4 "Thanksgiving"))
 902   "*General holidays.  Default value is for the United States.
 903 See the documentation for `calendar-holidays' for details."
 904   :type 'sexp
 905   :group 'holidays)
 906
 907 ;;;###autoload
 908 (put 'oriental-holidays 'risky-local-variable t)
 909 ;;;###autoload
 910 (defcustom oriental-holidays
 911   '((if (fboundp 'atan)
 912         (holiday-chinese-new-year)))
 913   "*Oriental holidays.
 914 See the documentation for `calendar-holidays' for details."
 915   :type 'sexp
 916   :group 'holidays)
 917
 918 ;;;###autoload
 919 (put 'local-holidays 'risky-local-variable t)
 920 ;;;###autoload
 921 (defcustom local-holidays nil
 922   "*Local holidays.
 923 See the documentation for `calendar-holidays' for details."
 924   :type 'sexp
 925   :group 'holidays)
 926
 927 ;;;###autoload
 928 (put 'other-holidays 'risky-local-variable t)
 929 ;;;###autoload
 930 (defcustom other-holidays nil
 931   "*User defined holidays.
 932 See the documentation for `calendar-holidays' for details."
 933   :type 'sexp
 934   :group 'holidays)
 935
 936 ;;;###autoload
 937 (put 'hebrew-holidays-1 'risky-local-variable t)
 938 ;;;###autoload
 939 (defvar hebrew-holidays-1
 940   '((holiday-rosh-hashanah-etc)
 941     (if all-hebrew-calendar-holidays
 942         (holiday-julian
 943          11
 944          (let* ((m displayed-month)
 945                 (y displayed-year)
 946                 (year))
 947            (increment-calendar-month m y -1)
 948            (let ((year (extract-calendar-year
 949                         (calendar-julian-from-absolute
 950                          (calendar-absolute-from-gregorian
 951                           (list m 1 y))))))
 952              (if (zerop (% (1+ year) 4))
 953                  22
 954                21))) "\"Tal Umatar\" (evening)"))))
 955
 956 ;;;###autoload
 957 (put 'hebrew-holidays-2 'risky-local-variable t)
 958 ;;;###autoload
 959 (defvar hebrew-holidays-2
 960   '((if all-hebrew-calendar-holidays
 961         (holiday-hanukkah)
 962       (holiday-hebrew 9 25 "Hanukkah"))
 963     (if all-hebrew-calendar-holidays
 964       (holiday-hebrew
 965        10
 966        (let ((h-year (extract-calendar-year
 967                       (calendar-hebrew-from-absolute
 968                        (calendar-absolute-from-gregorian
 969                         (list displayed-month 28 displayed-year))))))
 970          (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year))
 971                    7)
 972                 6)
 973              11 10))
 974        "Tzom Teveth"))
 975     (if all-hebrew-calendar-holidays
 976         (holiday-hebrew 11 15 "Tu B'Shevat"))))
 977
 978 ;;;###autoload
 979 (put 'hebrew-holidays-3 'risky-local-variable t)
 980 ;;;###autoload
 981 (defvar hebrew-holidays-3
 982   '((if all-hebrew-calendar-holidays
 983         (holiday-hebrew
 984          11
 985          (let ((m displayed-month)
 986                (y displayed-year))
 987            (increment-calendar-month m y 1)
 988            (let* ((h-year (extract-calendar-year
 989                            (calendar-hebrew-from-absolute
 990                             (calendar-absolute-from-gregorian
 991                              (list m
 992                                    (calendar-last-day-of-month m y)
 993                                    y)))))
 994                   (s-s
 995                    (calendar-hebrew-from-absolute
 996                     (if (=
 997                          (% (calendar-absolute-from-hebrew
 998                              (list 7 1 h-year))
 999                             7)
1000                          6)
1001                         (calendar-dayname-on-or-before
1002                          6 (calendar-absolute-from-hebrew
1003                             (list 11 17 h-year)))
1004                       (calendar-dayname-on-or-before
1005                        6 (calendar-absolute-from-hebrew
1006                           (list 11 16 h-year))))))
1007                   (day (extract-calendar-day s-s)))
1008              day))
1009          "Shabbat Shirah"))))
1010
1011 ;;;###autoload
1012 (put 'hebrew-holidays-4 'risky-local-variable t)
1013 ;;;###autoload
1014 (defvar hebrew-holidays-4
1015   '((holiday-passover-etc)
1016     (if (and all-hebrew-calendar-holidays
1017              (let* ((m displayed-month)
1018                     (y displayed-year)
1019                     (year))
1020                (increment-calendar-month m y -1)
1021                (let ((year (extract-calendar-year
1022                             (calendar-julian-from-absolute
1023                              (calendar-absolute-from-gregorian
1024                               (list m 1 y))))))
1025                  (= 21 (% year 28)))))
1026         (holiday-julian 3 26 "Kiddush HaHamah"))
1027     (if all-hebrew-calendar-holidays
1028         (holiday-tisha-b-av-etc))))
1029
1030 ;;;###autoload
1031 (put 'hebrew-holidays 'risky-local-variable t)
1032 ;;;###autoload
1033 (defcustom hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2
1034                                 hebrew-holidays-3 hebrew-holidays-4)
1035   "*Jewish holidays.
1036 See the documentation for `calendar-holidays' for details."
1037   :type 'sexp
1038   :group 'holidays)
1039
1040 ;;;###autoload
1041 (put 'christian-holidays 'risky-local-variable t)
1042 ;;;###autoload
1043 (defcustom christian-holidays
1044   '((if all-christian-calendar-holidays
1045         (holiday-fixed 1 6 "Epiphany"))
1046     (holiday-easter-etc 0 "Easter Sunday")
1047     (holiday-easter-etc -2 "Good Friday")
1048     (holiday-easter-etc -46 "Ash Wednesday")
1049     (if all-christian-calendar-holidays
1050         (holiday-easter-etc -63 "Septuagesima Sunday"))
1051     (if all-christian-calendar-holidays
1052         (holiday-easter-etc -56 "Sexagesima Sunday"))
1053     (if all-christian-calendar-holidays
1054         (holiday-easter-etc -49 "Shrove Sunday"))
1055     (if all-christian-calendar-holidays
1056         (holiday-easter-etc -48 "Shrove Monday"))
1057     (if all-christian-calendar-holidays
1058         (holiday-easter-etc -47 "Shrove Tuesday"))
1059     (if all-christian-calendar-holidays
1060         (holiday-easter-etc -14 "Passion Sunday"))
1061     (if all-christian-calendar-holidays
1062         (holiday-easter-etc -7 "Palm Sunday"))
1063     (if all-christian-calendar-holidays
1064         (holiday-easter-etc -3 "Maundy Thursday"))
1065     (if all-christian-calendar-holidays
1066         (holiday-easter-etc 35 "Rogation Sunday"))
1067     (if all-christian-calendar-holidays
1068         (holiday-easter-etc 39 "Ascension Day"))
1069     (if all-christian-calendar-holidays
1070         (holiday-easter-etc 49 "Pentecost (Whitsunday)"))
1071     (if all-christian-calendar-holidays
1072         (holiday-easter-etc 50 "Whitmonday"))
1073     (if all-christian-calendar-holidays
1074         (holiday-easter-etc 56 "Trinity Sunday"))
1075     (if all-christian-calendar-holidays
1076         (holiday-easter-etc 60 "Corpus Christi"))
1077     (if all-christian-calendar-holidays
1078         (holiday-greek-orthodox-easter))
1079     (if all-christian-calendar-holidays
1080         (holiday-fixed 8 15 "Assumption"))
1081     (if all-christian-calendar-holidays
1082         (holiday-advent 0 "Advent"))
1083     (holiday-fixed 12 25 "Christmas")
1084     (if all-christian-calendar-holidays
1085         (holiday-julian 12 25 "Eastern Orthodox Christmas")))
1086   "*Christian holidays.
1087 See the documentation for `calendar-holidays' for details."
1088   :type 'sexp
1089   :group 'holidays)
1090
1091 ;;;###autoload
1092 (put 'islamic-holidays 'risky-local-variable t)
1093 ;;;###autoload
1094 (defcustom islamic-holidays
1095   '((holiday-islamic
1096      1 1
1097      (format "Islamic New Year %d"
1098              (let ((m displayed-month)
1099                    (y displayed-year))
1100                (increment-calendar-month m y 1)
1101                (extract-calendar-year
1102                 (calendar-islamic-from-absolute
1103                  (calendar-absolute-from-gregorian
1104                   (list
1105                    m (calendar-last-day-of-month m y) y)))))))
1106     (if all-islamic-calendar-holidays
1107         (holiday-islamic 1 10 "Ashura"))
1108     (if all-islamic-calendar-holidays
1109         (holiday-islamic 3 12 "Mulad-al-Nabi"))
1110     (if all-islamic-calendar-holidays
1111         (holiday-islamic 7 26 "Shab-e-Mi'raj"))
1112     (if all-islamic-calendar-holidays
1113         (holiday-islamic 8 15 "Shab-e-Bara't"))
1114     (holiday-islamic 9 1 "Ramadan Begins")
1115     (if all-islamic-calendar-holidays
1116         (holiday-islamic 9 27 "Shab-e Qadr"))
1117     (if all-islamic-calendar-holidays
1118         (holiday-islamic 10 1 "Id-al-Fitr"))
1119     (if all-islamic-calendar-holidays
1120         (holiday-islamic 12 10 "Id-al-Adha")))
1121   "*Islamic holidays.
1122 See the documentation for `calendar-holidays' for details."
1123   :type 'sexp
1124   :group 'holidays)
1125
1126 ;;;###autoload
1127 (put 'bahai-holidays 'risky-local-variable t)
1128 ;;;###autoload
1129 (defcustom bahai-holidays
1130   '((holiday-fixed
1131      3 21
1132      (format "Baha'i New Year (Naw-Ruz) %d" (- displayed-year (1- 1844))))
1133     (holiday-fixed  4 21 "First Day of Ridvan")
1134     (if all-bahai-calendar-holidays
1135         (holiday-fixed  4 22 "Second Day of Ridvan"))
1136     (if all-bahai-calendar-holidays
1137         (holiday-fixed  4 23 "Third Day of Ridvan"))
1138     (if all-bahai-calendar-holidays
1139         (holiday-fixed  4 24 "Fourth Day of Ridvan"))
1140     (if all-bahai-calendar-holidays
1141         (holiday-fixed  4 25 "Fifth Day of Ridvan"))
1142     (if all-bahai-calendar-holidays
1143         (holiday-fixed  4 26 "Sixth Day of Ridvan"))
1144     (if all-bahai-calendar-holidays
1145         (holiday-fixed  4 27 "Seventh Day of Ridvan"))
1146     (if all-bahai-calendar-holidays
1147         (holiday-fixed  4 28 "Eighth Day of Ridvan"))
1148     (holiday-fixed  4 29 "Ninth Day of Ridvan")
1149     (if all-bahai-calendar-holidays
1150         (holiday-fixed  4 30 "Tenth Day of Ridvan"))
1151     (if all-bahai-calendar-holidays
1152         (holiday-fixed  5  1 "Eleventh Day of Ridvan"))
1153     (holiday-fixed  5  2 "Twelfth Day of Ridvan")
1154     (holiday-fixed  5 23 "Declaration of the Bab")
1155     (holiday-fixed  5 29 "Ascension of Baha'u'llah")
1156     (holiday-fixed  7  9 "Martyrdom of the Bab")
1157     (holiday-fixed 10 20 "Birth of the Bab")
1158     (holiday-fixed 11 12 "Birth of Baha'u'llah")
1159     (if all-bahai-calendar-holidays
1160         (holiday-fixed 11 26 "Day of the Covenant"))
1161     (if all-bahai-calendar-holidays
1162         (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha")))
1163   "*Baha'i holidays.
1164 See the documentation for `calendar-holidays' for details."
1165   :type 'sexp
1166   :group 'holidays)
1167
1168 ;;;###autoload
1169 (put 'solar-holidays 'risky-local-variable t)
1170 ;;;###autoload
1171 (defcustom solar-holidays
1172   '((if (fboundp 'atan)
1173         (solar-equinoxes-solstices))
1174     (if (progn
1175           (require 'cal-dst)
1176           t)
1177       (funcall
1178        'holiday-sexp
1179         calendar-daylight-savings-starts
1180         '(format "Daylight Savings Time Begins %s"
1181                   (if (fboundp 'atan)
1182                       (solar-time-string
1183                        (/ calendar-daylight-savings-starts-time (float 60))
1184                        calendar-standard-time-zone-name)
1185                     ""))))
1186     (funcall
1187      'holiday-sexp
1188      calendar-daylight-savings-ends
1189      '(format "Daylight Savings Time Ends %s"
1190               (if (fboundp 'atan)
1191                   (solar-time-string
1192                    (/ calendar-daylight-savings-ends-time (float 60))
1193                    calendar-daylight-time-zone-name)
1194                 ""))))
1195   "*Sun-related holidays.
1196 See the documentation for `calendar-holidays' for details."
1197   :type 'sexp
1198   :group 'holidays)
1199
1200 ;;;###autoload
1201 (put 'calendar-holidays 'risky-local-variable t)
1202 (defcustom calendar-holidays
1203   (append general-holidays local-holidays other-holidays
1204           christian-holidays hebrew-holidays islamic-holidays
1205           bahai-holidays oriental-holidays solar-holidays)
1206   "*List of notable days for the command \\[holidays].
1207
1208 Additional holidays are easy to add to the list, just put them in the
1209 list `other-holidays' in your .emacs file.  Similarly, by setting any
1210 of `general-holidays', `local-holidays' `christian-holidays',
1211 `hebrew-holidays', `islamic-holidays', `bahai-holidays',
1212 `oriental-holidays', or `solar-holidays' to nil in your .emacs file,
1213 you can eliminate unwanted categories of holidays.  The intention is
1214 that (in the US) `local-holidays' be set in site-init.el and
1215 `other-holidays' be set by the user.
1216
1217 Entries on the list are expressions that return (possibly empty) lists of
1218 items of the form ((month day year) string) of a holiday in the in the
1219 three-month period centered around `displayed-month' of `displayed-year'.
1220 Several basic functions are provided for this purpose:
1221
1222     (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar
1223     (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in
1224                                MONTH on the Gregorian calendar (0 for Sunday,
1225                                etc.); K<0 means count back from the end of the
1226                                month.  An optional parameter DAY means the Kth
1227                                DAYNAME after/before MONTH DAY.
1228     (holiday-hebrew MONTH DAY STRING)  a fixed date on the Hebrew calendar
1229     (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
1230     (holiday-bahai MONTH DAY STRING)   a fixed date on the Baha'i calendar
1231     (holiday-julian MONTH DAY STRING)  a fixed date on the Julian calendar
1232     (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression
1233                                in the variable `year'; if it evaluates to
1234                                a visible date, that's the holiday; if it
1235                                evaluates to nil, there's no holiday.  STRING
1236                                is an expression in the variable `date'.
1237
1238 For example, to add Bastille Day, celebrated in France on July 14, add
1239
1240      (holiday-fixed 7 14 \"Bastille Day\")
1241
1242 to the list.  To add Hurricane Supplication Day, celebrated in the Virgin
1243 Islands on the fourth Monday in August, add
1244
1245      (holiday-float 8 1 4 \"Hurricane Supplication Day\")
1246
1247 to the list (the last Monday would be specified with `-1' instead of `4').
1248 To add the last day of Hanukkah to the list, use
1249
1250      (holiday-hebrew 10 2 \"Last day of Hanukkah\")
1251
1252 since the Hebrew months are numbered with 1 starting from Nisan, while to
1253 add the Islamic feast celebrating Mohammed's birthday use
1254
1255      (holiday-islamic 3 12 \"Mohammed's Birthday\")
1256
1257 since the Islamic months are numbered from 1 starting with Muharram.  To
1258 add an entry for the Baha'i festival of Ridvan, use
1259
1260      (holiday-bahai 2 13 \"Festival of Ridvan\")
1261
1262 since the Baha'i months are numbered from 1 starting with Baha.  To
1263 add Thomas Jefferson's birthday, April 2, 1743 (Julian), use
1264
1265      (holiday-julian 4 2 \"Jefferson's Birthday\")
1266
1267 To include a holiday conditionally, use the sexp form or a conditional.  For
1268 example, to include American presidential elections, which occur on the first
1269 Tuesday after the first Monday in November of years divisible by 4, add
1270
1271      (holiday-sexp
1272        '(if (zerop (% year 4))
1273            (calendar-gregorian-from-absolute
1274              (1+ (calendar-dayname-on-or-before
1275                    1 (+ 6 (calendar-absolute-from-gregorian
1276                             (list 11 1 year)))))))
1277        \"US Presidential Election\")
1278
1279 or
1280
1281      (if (zerop (% displayed-year 4))
1282          (holiday-fixed 11
1283                 (extract-calendar-day
1284                  (calendar-gregorian-from-absolute
1285                   (1+ (calendar-dayname-on-or-before
1286                        1 (+ 6 (calendar-absolute-from-gregorian
1287                                (list 11 1 displayed-year)))))))
1288                 \"US Presidential Election\"))
1289
1290 to the list.  To include the phases of the moon, add
1291
1292      (lunar-phases)
1293
1294 to the holiday list, where `lunar-phases' is an Emacs-Lisp function that
1295 you've written to return a (possibly empty) list of the relevant VISIBLE dates
1296 with descriptive strings such as
1297
1298      (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... )."
1299   :type 'sexp
1300   :group 'holidays)
1301
1302 (defconst holiday-buffer "*Holidays*"
1303   "Name of the buffer used for the displaying the holidays.")
1304
1305 (defconst fancy-diary-buffer "*Fancy Diary Entries*"
1306   "Name of the buffer used for the optional fancy display of the diary.")
1307
1308 (defconst other-calendars-buffer "*Other Calendars*"
1309   "Name of the buffer used for the display of date on other calendars.")
1310
1311 (defconst lunar-phases-buffer "*Phases of Moon*"
1312   "Name of the buffer used for the lunar phases.")
1313
1314 (defmacro increment-calendar-month (mon yr n)
1315   "Increment the variables MON and YR by N months.
1316 Forward if N is positive or backward if N is negative.
1317 A negative YR is interpreted as BC; -1 being 1 BC, and so on."
1318   `(let (macro-y)
1319      (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc
1320      (setq macro-y (+ (* ,yr 12) ,mon -1 ,n)
1321            ,mon (1+ (mod macro-y 12))
1322            ,yr (/ macro-y 12))
1323      (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
1324      (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
1325
1326 (defmacro calendar-for-loop (var from init to final do &rest body)
1327   "Execute a for loop."
1328   `(let ((,var (1- ,init)))
1329     (while (>= ,final (setq ,var (1+ ,var)))
1330       ,@body)))
1331
1332 (defmacro calendar-sum (index initial condition expression)
1333   "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
1334   `(let ((,index ,initial)
1335          (sum 0))
1336     (while ,condition
1337       (setq sum (+ sum ,expression))
1338       (setq ,index (1+ ,index)))
1339     sum))
1340
1341 ;; The following are in-line for speed; they can be called thousands of times
1342 ;; when looking up holidays or processing the diary.  Here, for example, are
1343 ;; the numbers of calls to calendar/diary/holiday functions in preparing the
1344 ;; fancy diary display, for a moderately complex diary file, with functions
1345 ;; used instead of macros.  There were a total of 10000 such calls:
1346 ;;
1347 ;;  1934   extract-calendar-month
1348 ;;  1852   extract-calendar-year
1349 ;;  1819   extract-calendar-day
1350 ;;   845   calendar-leap-year-p
1351 ;;   837   calendar-day-number
1352 ;;   775   calendar-absolute-from-gregorian
1353 ;;   346   calendar-last-day-of-month
1354 ;;   286   hebrew-calendar-last-day-of-month
1355 ;;   188   hebrew-calendar-leap-year-p
1356 ;;   180   hebrew-calendar-elapsed-days
1357 ;;   163   hebrew-calendar-last-month-of-year
1358 ;;    66   calendar-date-compare
1359 ;;    65   hebrew-calendar-days-in-year
1360 ;;    60   calendar-absolute-from-julian
1361 ;;    50   calendar-absolute-from-hebrew
1362 ;;    43   calendar-date-equal
1363 ;;    38   calendar-gregorian-from-absolute
1364 ;;     .
1365 ;;     .
1366 ;;     .
1367 ;;
1368 ;; The use of these seven macros eliminates the overhead of 92% of the function
1369 ;; calls; it's faster this way.
1370
1371 (defsubst extract-calendar-month (date)
1372   "Extract the month part of DATE which has the form (month day year)."
1373   (car date))
1374
1375 (defsubst extract-calendar-day (date)
1376   "Extract the day part of DATE which has the form (month day year)."
1377   (car (cdr date)))
1378
1379 (defsubst extract-calendar-year (date)
1380   "Extract the year part of DATE which has the form (month day year)."
1381   (car (cdr (cdr date))))
1382
1383 (defsubst calendar-leap-year-p (year)
1384   "Return t if YEAR is a Gregorian leap year.
1385 A negative year is interpreted as BC; -1 being 1 BC, and so on."
1386   ;; 1 BC = 0 AD, 2 BC acts like 1 AD, etc.
1387   (if (< year 0) (setq year (1- (abs year))))
1388   (and (zerop (% year 4))
1389        (or (not (zerop (% year 100)))
1390            (zerop (% year 400)))))
1391
1392 ;; The foregoing is a bit faster, but not as clear as the following:
1393 ;;
1394 ;;(defsubst calendar-leap-year-p (year)
1395 ;;  "Returns t if YEAR is a Gregorian leap year."
1396 ;;  (or
1397 ;;    (and (=  (% year   4) 0)
1398 ;;         (/= (% year 100) 0))
1399 ;;    (= (% year 400) 0)))
1400
1401 (defsubst calendar-last-day-of-month (month year)
1402   "The last day in MONTH during YEAR."
1403   (if (and (= month 2) (calendar-leap-year-p year))
1404       29
1405     (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
1406
1407 ;; An explanation of the calculation can be found in PascAlgorithms by
1408 ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
1409
1410 (defsubst calendar-day-number (date)
1411   "Return the day number within the year of the date DATE.
1412 For example, (calendar-day-number '(1 1 1987)) returns the value 1,
1413 while (calendar-day-number '(12 31 1980)) returns 366."
1414     (let* ((month (extract-calendar-month date))
1415            (day (extract-calendar-day date))
1416            (year (extract-calendar-year date))
1417          (day-of-year (+ day (* 31 (1- month)))))
1418       (if (> month 2)
1419           (progn
1420             (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
1421             (if (calendar-leap-year-p year)
1422                 (setq day-of-year (1+ day-of-year)))))
1423       day-of-year))
1424
1425 (defsubst calendar-absolute-from-gregorian (date)
1426   "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
1427 The Gregorian date Sunday, December 31, 1 BC is imaginary.
1428 DATE is a list of the form (month day year).  A negative year is
1429 interpreted as BC; -1 being 1 BC, and so on.  Dates before 12/31/1 BC
1430 return negative results."
1431   (let ((year (extract-calendar-year date))
1432         offset-years)
1433     (cond ((= year 0)
1434            (error "There was no year zero"))
1435           ((> year 0)
1436            (setq offset-years (1- year))
1437            (+ (calendar-day-number date) ; Days this year
1438               (* 365 offset-years)       ; + Days in prior years
1439               (/ offset-years 4)         ; + Julian leap years
1440               (- (/ offset-years 100))   ; - century years
1441               (/ offset-years 400)))     ; + Gregorian leap years
1442           (t
1443            ;; Years between date and 1 BC, excluding 1 BC (1 for 2 BC, etc).
1444            (setq offset-years (abs (1+ year)))
1445            (- (calendar-day-number date)
1446               (* 365 offset-years)
1447               (/ offset-years 4)
1448               (- (/ offset-years 100))
1449               (/ offset-years 400)
1450               (calendar-day-number '(12 31 -1))))))) ; days in year 1 BC
1451
1452 (autoload 'calendar-goto-today "cal-move"
1453   "Reposition the calendar window so the current date is visible."
1454   t)
1455
1456 (autoload 'calendar-forward-month "cal-move"
1457   "Move the cursor forward ARG months."
1458   t)
1459
1460 (autoload 'calendar-forward-year "cal-move"
1461   "Move the cursor forward by ARG years."
1462   t)
1463
1464 (autoload 'calendar-backward-month "cal-move"
1465   "Move the cursor backward by ARG months."
1466   t)
1467
1468 (autoload 'calendar-backward-year "cal-move"
1469   "Move the cursor backward ARG years."
1470   t)
1471
1472 (autoload 'scroll-calendar-left "cal-move"
1473   "Scroll the displayed calendar left by ARG months."
1474   t)
1475
1476 (autoload 'scroll-calendar-right "cal-move"
1477   "Scroll the displayed calendar window right by ARG months."
1478   t)
1479
1480 (autoload 'scroll-calendar-left-three-months "cal-move"
1481   "Scroll the displayed calendar window left by 3*ARG months."
1482   t)
1483
1484 (autoload 'scroll-calendar-right-three-months "cal-move"
1485   "Scroll the displayed calendar window right by 3*ARG months."
1486   t)
1487
1488 (autoload 'calendar-cursor-to-nearest-date "cal-move"
1489   "Move the cursor to the closest date."
1490   t)
1491
1492 (autoload 'calendar-forward-day "cal-move"
1493   "Move the cursor forward ARG days."
1494   t)
1495
1496 (autoload 'calendar-backward-day "cal-move"
1497   "Move the cursor back ARG days."
1498   t)
1499
1500 (autoload 'calendar-forward-week "cal-move"
1501   "Move the cursor forward ARG weeks."
1502   t)
1503
1504 (autoload 'calendar-backward-week "cal-move"
1505   "Move the cursor back ARG weeks."
1506   t)
1507
1508 (autoload 'calendar-beginning-of-week "cal-move"
1509   "Move the cursor back ARG calendar-week-start-day's."
1510   t)
1511
1512 (autoload 'calendar-end-of-week "cal-move"
1513   "Move the cursor forward ARG calendar-week-start-day+6's."
1514   t)
1515
1516 (autoload 'calendar-beginning-of-month "cal-move"
1517   "Move the cursor backward ARG month beginnings."
1518   t)
1519
1520 (autoload 'calendar-end-of-month "cal-move"
1521   "Move the cursor forward ARG month ends."
1522   t)
1523
1524 (autoload 'calendar-beginning-of-year "cal-move"
1525   "Move the cursor backward ARG year beginnings."
1526   t)
1527
1528 (autoload 'calendar-end-of-year "cal-move"
1529   "Move the cursor forward ARG year beginnings."
1530   t)
1531
1532 (autoload 'calendar-cursor-to-visible-date "cal-move"
1533   "Move the cursor to DATE that is on the screen."
1534   t)
1535
1536 (autoload 'calendar-goto-date "cal-move"
1537   "Move cursor to DATE."
1538   t)
1539
1540 (autoload 'calendar-goto-day-of-year "cal-move"
1541   "Move cursor to day of year."
1542   t)
1543
1544 (autoload 'calendar-only-one-frame-setup "cal-x"
1545  "Start calendar and display it in a dedicated frame.")
1546
1547 (autoload 'calendar-one-frame-setup "cal-x"
1548   "Start calendar and display it in a dedicated frame together with the diary.")
1549
1550 (autoload 'calendar-two-frame-setup "cal-x"
1551   "Start calendar and diary in separate, dedicated frames.")
1552
1553 ;;;###autoload
1554 (defcustom calendar-setup nil
1555   "The frame setup of the calendar.
1556 The choices are: `one-frame' (calendar and diary together in one separate,
1557 dedicated frame); `two-frames' (calendar and diary in separate, dedicated
1558 frames); `calendar-only' (calendar in a separate, dedicated frame); with
1559 any other value the current frame is used.  Using any of the first
1560 three options overrides the value of `view-diary-entries-initially'."
1561   :type '(choice
1562           (const :tag "calendar and diary in separate frame" one-frame)
1563           (const :tag "calendar and diary each in own frame" two-frames)
1564           (const :tag "calendar in separate frame" calendar-only)
1565           (const :tag "use current frame" nil))
1566   :group 'calendar)
1567
1568 (defcustom calendar-minimum-window-height 8
1569   "Minimum height `generate-calendar-window' should use for calendar window."
1570   :type 'integer
1571   :version "22.1"
1572   :group 'calendar)
1573
1574 ;;;###autoload
1575 (defun calendar (&optional arg)
1576   "Choose between the one frame, two frame, or basic calendar displays.
1577 If called with an optional prefix argument, prompts for month and year.
1578
1579 The original function `calendar' has been renamed `calendar-basic-setup'.
1580 See the documentation of that function for more information."
1581   (interactive "P")
1582   (cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg))
1583         ((equal calendar-setup 'two-frames) (calendar-two-frame-setup arg))
1584         ((equal calendar-setup 'calendar-only)
1585          (calendar-only-one-frame-setup arg))
1586         (t (calendar-basic-setup arg))))
1587
1588 (defun calendar-basic-setup (&optional arg)
1589   "Display a three-month calendar in another window.
1590 The three months appear side by side, with the current month in the middle
1591 surrounded by the previous and next months.  The cursor is put on today's date.
1592
1593 If called with an optional prefix argument, prompts for month and year.
1594
1595 This function is suitable for execution in a .emacs file; appropriate setting
1596 of the variable `view-diary-entries-initially' will cause the diary entries for
1597 the current date to be displayed in another window.  The value of the variable
1598 `number-of-diary-entries' controls the number of days of diary entries
1599 displayed upon initial display of the calendar.
1600
1601 Once in the calendar window, future or past months can be moved into view.
1602 Arbitrary months can be displayed, or the calendar can be scrolled forward
1603 or backward.
1604
1605 The cursor can be moved forward or backward by one day, one week, one month,
1606 or one year.  All of these commands take prefix arguments which, when negative,
1607 cause movement in the opposite direction.  For convenience, the digit keys
1608 and the minus sign are automatically prefixes.  The window is replotted as
1609 necessary to display the desired date.
1610
1611 Diary entries can be marked on the calendar or displayed in another window.
1612
1613 Use \\[describe-mode] for details of the key bindings in the calendar window.
1614
1615 The Gregorian calendar is assumed.
1616
1617 After loading the calendar, the hooks given by the variable
1618 `calendar-load-hook' are run.  This is the place to add key bindings to the
1619 calendar-mode-map.
1620
1621 After preparing the calendar window initially, the hooks given by the variable
1622 `initial-calendar-window-hook' are run.
1623
1624 The hooks given by the variable `today-visible-calendar-hook' are run
1625 every time the calendar window gets scrolled, if the current date is visible
1626 in the window.  If it is not visible, the hooks given by the variable
1627 `today-invisible-calendar-hook' are run.  Thus, for example, setting
1628 `today-visible-calendar-hook' to 'calendar-star-date will cause today's date
1629 to be replaced by asterisks to highlight it whenever it is in the window."
1630   (interactive "P")
1631   (set-buffer (get-buffer-create calendar-buffer))
1632   (calendar-mode)
1633   (let* ((pop-up-windows t)
1634          (split-height-threshold 1000)
1635          (date (if arg
1636                    (calendar-read-date t)
1637                  (calendar-current-date)))
1638          (month (extract-calendar-month date))
1639          (year (extract-calendar-year date)))
1640     (pop-to-buffer calendar-buffer)
1641     (increment-calendar-month month year (- calendar-offset))
1642     (generate-calendar-window month year)
1643     (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
1644         (view-diary-entries
1645          (if (vectorp number-of-diary-entries)
1646              (aref number-of-diary-entries (calendar-day-of-week date))
1647            number-of-diary-entries))))
1648   (let* ((diary-buffer (get-file-buffer diary-file))
1649          (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
1650          (split-height-threshold (if diary-window 2 1000)))
1651     (if view-calendar-holidays-initially
1652         (list-calendar-holidays)))
1653   (run-hooks 'initial-calendar-window-hook))
1654
1655 (autoload 'view-diary-entries "diary-lib"
1656   "Prepare and display a buffer with diary entries.
1657 Searches your diary file for entries that match ARG days starting with
1658 the date indicated by the cursor position in the displayed three-month
1659 calendar."
1660   t)
1661
1662 (autoload 'view-other-diary-entries "diary-lib"
1663   "Prepare and display buffer of diary entries from an alternative diary file.
1664 Searches for entries that match ARG days, starting with the date indicated
1665 by the cursor position in the displayed three-month calendar.
1666 D-FILE specifies the file to use as the diary file."
1667   t)
1668
1669 (autoload 'calendar-sunrise-sunset "solar"
1670   "Local time of sunrise and sunset for date under cursor."
1671   t)
1672
1673 (autoload 'calendar-phases-of-moon "lunar"
1674   "Create a buffer of the phases of the moon for the current calendar window."
1675   t)
1676
1677 (autoload 'calendar-print-french-date "cal-french"
1678   "Show the French Revolutionary calendar equivalent of the date under the cursor."
1679   t)
1680
1681 (autoload 'calendar-goto-french-date "cal-french"
1682  "Move cursor to French Revolutionary date."
1683   t)
1684
1685 (autoload 'calendar-french-date-string "cal-french"
1686   "String of French Revolutionary date of Gregorian date."
1687   t)
1688
1689 (autoload 'calendar-mayan-date-string "cal-mayan"
1690   "String of Mayan date of Gregorian date."
1691   t)
1692
1693 (autoload 'calendar-print-mayan-date "cal-mayan"
1694   "Show the Mayan long count, Tzolkin, and Haab equivalents of the date under the cursor."
1695   t)
1696
1697 (autoload 'calendar-goto-mayan-long-count-date "cal-mayan"
1698  "Move cursor to Mayan long count date."
1699   t)
1700
1701 (autoload 'calendar-next-haab-date "cal-mayan"
1702   "Move cursor to next instance of Mayan Haab date."
1703   t)
1704
1705 (autoload 'calendar-previous-haab-date "cal-mayan"
1706   "Move cursor to previous instance of Mayan Haab date."
1707   t)
1708
1709 (autoload 'calendar-next-tzolkin-date "cal-mayan"
1710   "Move cursor to next instance of Mayan Tzolkin date."
1711   t)
1712
1713 (autoload 'calendar-previous-tzolkin-date "cal-mayan"
1714   "Move cursor to previous instance of Mayan Tzolkin date."
1715   t)
1716
1717 (autoload 'calendar-next-calendar-round-date "cal-mayan"
1718   "Move cursor to next instance of Mayan Haab/Tzolkin combination."
1719   t)
1720
1721 (autoload 'calendar-previous-calendar-round-date "cal-mayan"
1722   "Move cursor to previous instance of Mayan Haab/Tzolkin combination."
1723   t)
1724
1725 (autoload 'calendar-goto-chinese-date "cal-china"
1726    "Move cursor to Chinese date."
1727    t)
1728
1729 (autoload 'calendar-print-chinese-date "cal-china"
1730  "Show the Chinese date equivalents of date."
1731  t)
1732
1733 (autoload 'calendar-chinese-date-string "cal-china"
1734   "String of Chinese date of Gregorian date."
1735   t)
1736
1737 (autoload 'calendar-absolute-from-astro  "cal-julian"
1738   "Absolute date of astronomical (Julian) day number D."
1739   t )
1740
1741 (autoload 'calendar-astro-from-absolute "cal-julian"
1742   "Astronomical (Julian) day number of absolute date D.")
1743
1744 (autoload 'calendar-astro-date-string "cal-julian"
1745   "String of astronomical (Julian) day number of Gregorian date."
1746   t)
1747
1748 (autoload 'calendar-goto-astro-day-number "cal-julian"
1749    "Move cursor to astronomical (Julian) day number."
1750    t)
1751
1752 (autoload 'calendar-print-astro-day-number "cal-julian"
1753    "Show the astro date equivalents of date."
1754    t)
1755
1756 (autoload 'calendar-julian-from-absolute "cal-julian"
1757   "Compute the Julian (month day year) corresponding to the absolute DATE.
1758 The absolute date is the number of days elapsed since the (imaginary)
1759 Gregorian date Sunday, December 31, 1 BC.")
1760
1761 (autoload 'calendar-goto-julian-date "cal-julian"
1762   "Move cursor to Julian DATE; echo Julian date unless NOECHO is t."
1763   t)
1764
1765 (autoload 'calendar-print-julian-date "cal-julian"
1766   "Show the Julian calendar equivalent of the date under the cursor."
1767   t)
1768
1769 (autoload 'calendar-julian-date-string "cal-julian"
1770   "String of Julian date of Gregorian DATE.
1771 Defaults to today's date if DATE is not given.
1772 Driven by the variable `calendar-date-display-form'.")
1773
1774 (autoload 'calendar-goto-iso-date "cal-iso"
1775   "Move cursor to ISO date."
1776   t)
1777
1778 (autoload 'calendar-goto-iso-week "cal-iso"
1779   "Move cursor to start of ISO week."
1780   t)
1781
1782 (autoload 'calendar-print-iso-date "cal-iso"
1783   "Show the ISO date equivalents of date."
1784   t)
1785
1786 (autoload 'calendar-iso-date-string "cal-iso"
1787   "String of ISO date of Gregorian date."
1788   t)
1789
1790 (autoload 'calendar-goto-islamic-date "cal-islam"
1791   "Move cursor to Islamic date."
1792   t)
1793
1794 (autoload 'calendar-print-islamic-date "cal-islam"
1795   "Show the Islamic date equivalents of date."
1796   t)
1797
1798 (autoload 'calendar-islamic-date-string "cal-islam"
1799   "String of Islamic date of Gregorian date."
1800   t)
1801
1802 (autoload 'calendar-print-bahai-date "cal-bahai"
1803   "Show the Baha'i date equivalents of date."
1804   t)
1805
1806 (autoload 'calendar-bahai-date-string "cal-bahai"
1807   "String of Baha'i date of Gregorian date."
1808   t)
1809
1810 (autoload 'calendar-goto-hebrew-date "cal-hebrew"
1811   "Move cursor to Hebrew date date."
1812   t)
1813
1814 (autoload 'calendar-print-hebrew-date "cal-hebrew"
1815   "Show the Hebrew date equivalents of date."
1816   t)
1817
1818 (autoload 'calendar-hebrew-date-string "cal-hebrew"
1819   "String of Hebrew date of Gregorian date."
1820   t)
1821
1822 (autoload 'calendar-goto-coptic-date "cal-coptic"
1823    "Move cursor to Coptic date date."
1824    t)
1825
1826 (autoload 'calendar-print-coptic-date "cal-coptic"
1827  "Show the Coptic date equivalents of date."
1828  t)
1829
1830 (autoload 'calendar-coptic-date-string "cal-coptic"
1831   "String of Coptic date of Gregorian date."
1832   t)
1833
1834 (autoload 'calendar-goto-ethiopic-date "cal-coptic"
1835    "Move cursor to Ethiopic date date."
1836    t)
1837
1838 (autoload 'calendar-print-ethiopic-date "cal-coptic"
1839  "Show the Ethiopic date equivalents of date."
1840  t)
1841
1842 (autoload 'calendar-ethiopic-date-string "cal-coptic"
1843   "String of Ethiopic date of Gregorian date."
1844   t)
1845
1846 (autoload 'calendar-goto-persian-date "cal-persia"
1847    "Move cursor to Persian date date."
1848    t)
1849
1850 (autoload 'calendar-print-persian-date "cal-persia"
1851  "Show the Persian date equivalents of date."
1852  t)
1853
1854 (autoload 'calendar-persian-date-string "cal-persia"
1855   "String of Persian date of Gregorian date."
1856   t)
1857
1858 (autoload 'show-all-diary-entries "diary-lib"
1859   "Show all of the diary entries in the diary file.
1860 This function gets rid of the selective display of the diary file so that
1861 all entries, not just some, are visible.  If there is no diary buffer, one
1862 is created."
1863   t)
1864
1865 (autoload 'mark-diary-entries "diary-lib"
1866   "Mark days in the calendar window that have diary entries.
1867 Each entry in diary file visible in the calendar window is marked."
1868   t)
1869
1870 (autoload 'make-diary-entry "diary-lib"
1871   "Insert a diary entry STRING which may be NONMARKING in FILE."
1872   t)
1873
1874 (autoload 'insert-diary-entry "diary-lib"
1875   "Insert a diary entry for the date indicated by point."
1876   t)
1877
1878 (autoload 'insert-weekly-diary-entry "diary-lib"
1879   "Insert a weekly diary entry for the day of the week indicated by point."
1880   t)
1881
1882
1883 (autoload 'insert-monthly-diary-entry "diary-lib"
1884   "Insert a monthly diary entry for the day of the month indicated by point."
1885   t)
1886
1887 (autoload 'insert-yearly-diary-entry "diary-lib"
1888   "Insert an annual diary entry for the day of the year indicated by point."
1889   t)
1890
1891 (autoload 'insert-anniversary-diary-entry "diary-lib"
1892   "Insert an anniversary diary entry for the date indicated by point."
1893   t)
1894
1895 (autoload 'insert-block-diary-entry "diary-lib"
1896   "Insert a block diary entry for the dates indicated by point and mark."
1897   t)
1898
1899 (autoload 'insert-cyclic-diary-entry "diary-lib"
1900   "Insert a cyclic diary entry starting at the date indicated by point."
1901   t)
1902
1903 (autoload 'insert-hebrew-diary-entry "cal-hebrew"
1904   "Insert a diary entry for the Hebrew date corresponding to the date
1905 indicated by point."
1906   t)
1907
1908 (autoload 'insert-monthly-hebrew-diary-entry "cal-hebrew"
1909   "Insert a monthly diary entry for the day of the Hebrew month corresponding
1910 to the date indicated by point."
1911   t)
1912
1913 (autoload 'insert-yearly-hebrew-diary-entry "cal-hebrew"
1914   "Insert an annual diary entry for the day of the Hebrew year corresponding
1915 to the date indicated by point."
1916   t)
1917
1918 (autoload 'insert-islamic-diary-entry "cal-islam"
1919   "Insert a diary entry for the Islamic date corresponding to the date
1920 indicated by point."
1921   t)
1922
1923 (autoload 'insert-monthly-islamic-diary-entry "cal-islam"
1924   "Insert a monthly diary entry for the day of the Islamic month corresponding
1925 to the date indicated by point."
1926   t)
1927
1928 (autoload 'insert-yearly-islamic-diary-entry "cal-islam"
1929   "Insert an annual diary entry for the day of the Islamic year corresponding
1930 to the date indicated by point."
1931   t)
1932
1933 (autoload 'insert-bahai-diary-entry "cal-bahai"
1934   "Insert a diary entry for the Baha'i date corresponding to the date
1935 indicated by point."
1936   t)
1937
1938 (autoload 'insert-monthly-bahai-diary-entry "cal-bahai"
1939   "Insert a monthly diary entry for the day of the Baha'i month corresponding
1940 to the date indicated by point."
1941   t)
1942
1943 (autoload 'insert-yearly-bahai-diary-entry "cal-bahai"
1944   "Insert an annual diary entry for the day of the Baha'i year corresponding
1945 to the date indicated by point."
1946   t)
1947
1948 (autoload 'list-calendar-holidays "holidays"
1949   "Create a buffer containing the holidays for the current calendar window.
1950 The holidays are those in the list `calendar-notable-days'.  Returns t if any
1951 holidays are found, nil if not."
1952   t)
1953
1954 (autoload 'cal-tex-cursor-month "cal-tex"
1955   "Make a buffer with LaTeX commands for the month cursor is on.
1956 Optional prefix argument specifies number of months to be produced.
1957 Calendar is condensed onto one page.")
1958
1959 (autoload 'cal-tex-cursor-month-landscape "cal-tex"
1960   "Make a buffer with LaTeX commands for the month cursor is on.
1961 Optional prefix argument specifies number of months to be produced.")
1962
1963 (autoload 'cal-tex-cursor-day "cal-tex"
1964   "Make a buffer with LaTeX commands for the day cursor is on.")
1965
1966 (autoload 'cal-tex-cursor-week "cal-tex"
1967   "Make a buffer with LaTeX commands for a two-page one-week calendar.
1968 It applies to the week that point is in.
1969 Optional prefix argument specifies number of weeks.
1970 Holidays are included if `cal-tex-holidays' is t.")
1971
1972 (autoload 'cal-tex-cursor-week2 "cal-tex"
1973   "Make a buffer with LaTeX commands for a two-page one-week calendar.
1974 It applies to the week that point is in.
1975 Optional prefix argument specifies number of weeks.
1976 Holidays are included if `cal-tex-holidays' is t.")
1977
1978 (autoload 'cal-tex-cursor-week-iso "cal-tex"
1979   "Make a buffer with LaTeX commands for a one page ISO-style weekly calendar.
1980 Optional prefix argument specifies number of weeks.
1981 Diary entries are included if `cal-tex-diary' is t.
1982 Holidays are included if `cal-tex-holidays' is t.")
1983
1984 (autoload 'cal-tex-cursor-week-monday "cal-tex"
1985   "Make a buffer with LaTeX commands for a two-page one-week calendar.
1986 It applies to the week that point is in, and starts on Monday.
1987 Optional prefix argument specifies number of weeks.
1988 Holidays are included if `cal-tex-holidays' is t.")
1989
1990 (autoload 'cal-tex-cursor-filofax-2week "cal-tex"
1991   "Two-weeks-at-a-glance Filofax style calendar for week indicated by cursor.
1992 Optional prefix argument specifies number of weeks.
1993 Diary entries are included if cal-tex-diary is t.
1994 Holidays are included if `cal-tex-holidays' is t.")
1995
1996 (autoload 'cal-tex-cursor-filofax-week "cal-tex"
1997   "One-week-at-a-glance Filofax style calendar for week indicated by cursor.
1998 Optional prefix argument specifies number of weeks.
1999 Weeks start on Monday.
2000 Diary entries are included if cal-tex-diary is t.
2001 Holidays are included if `cal-tex-holidays' is t.")
2002
2003 (autoload 'cal-tex-cursor-filofax-daily "cal-tex"
2004   "Day-per-page Filofax style calendar for week indicated by cursor.
2005 Optional prefix argument specifies number of weeks.  Weeks start on Monday.
2006 Diary entries are included if `cal-tex-diary' is t.
2007 Holidays are included if `cal-tex-holidays' is t.")
2008
2009 (autoload 'cal-tex-cursor-year "cal-tex"
2010   "Make a buffer with LaTeX commands for a year's calendar.
2011 Optional prefix argument specifies number of years.")
2012
2013 (autoload 'cal-tex-cursor-year-landscape "cal-tex"
2014   "Make a buffer with LaTeX commands for a year's calendar (landscape).
2015 Optional prefix argument specifies number of years.")
2016
2017 (autoload 'cal-tex-cursor-filofax-year "cal-tex"
2018   "Make a buffer with LaTeX commands for a year's calendar (Filofax).
2019 Optional prefix argument specifies number of years.")
2020
2021 (autoload 'mark-calendar-holidays "holidays"
2022   "Mark notable days in the calendar window."
2023   t)
2024
2025 (autoload 'calendar-cursor-holidays "holidays"
2026   "Find holidays for the date specified by the cursor in the calendar window."
2027   t)
2028
2029 (defun generate-calendar-window (&optional mon yr)
2030   "Generate the calendar window for the current date.
2031 Or, for optional MON, YR."
2032   (let* ((buffer-read-only nil)
2033          (today (calendar-current-date))
2034          (month (extract-calendar-month today))
2035          (day (extract-calendar-day today))
2036          (year (extract-calendar-year today))
2037          (today-visible
2038           (or (not mon)
2039               (let ((offset (calendar-interval mon yr month year)))
2040                 (and (<= offset 1) (>= offset -1)))))
2041          (day-in-week (calendar-day-of-week today))
2042          (in-calendar-window (eq (window-buffer (selected-window))
2043                                  (get-buffer calendar-buffer))))
2044     (update-calendar-mode-line)
2045     (if mon
2046         (generate-calendar mon yr)
2047       (generate-calendar month year))
2048     (calendar-cursor-to-visible-date
2049      (if today-visible today (list displayed-month 1 displayed-year)))
2050     (set-buffer-modified-p nil)
2051     ;; Don't do any window-related stuff if we weren't called from a
2052     ;; window displaying the calendar
2053     (when in-calendar-window
2054       (if (or (one-window-p t) (/= (frame-width) (window-width)))
2055           ;; Don't mess with the window size, but ensure that the first
2056           ;; line is fully visible
2057           (set-window-vscroll nil 0)
2058         ;; Adjust the window to exactly fit the displayed calendar
2059         (fit-window-to-buffer nil nil calendar-minimum-window-height))
2060       (sit-for 0))
2061     (if (and (boundp 'font-lock-mode)
2062              font-lock-mode)
2063         (font-lock-fontify-buffer))
2064     (and mark-holidays-in-calendar
2065 ;;;         (calendar-date-is-legal-p today) ; useful for BC dates
2066          (mark-calendar-holidays)
2067          (and in-calendar-window (sit-for 0)))
2068     (unwind-protect
2069         (if mark-diary-entries-in-calendar (mark-diary-entries))
2070       (if today-visible
2071           (run-hooks 'today-visible-calendar-hook)
2072         (run-hooks 'today-invisible-calendar-hook)))))
2073
2074 (defun generate-calendar (month year)
2075   "Generate a three-month Gregorian calendar centered around MONTH, YEAR."
2076 ;;; A negative YEAR is interpreted as BC; -1 being 1 BC, and so on.
2077 ;;; Note that while calendars for years BC could be displayed as it
2078 ;;; stands, almost all other calendar functions (eg holidays) would
2079 ;;; at best have unpredictable results for such dates.
2080   (if (< (+ month (* 12 (1- year))) 2)
2081       (error "Months before January, 1 AD cannot be displayed"))
2082   (setq displayed-month month
2083         displayed-year year)
2084   (erase-buffer)
2085   (increment-calendar-month month year -1)
2086   (calendar-for-loop i from 0 to 2 do
2087        (generate-calendar-month month year (+ 5 (* 25 i)))
2088        (increment-calendar-month month year 1)))
2089
2090 (defun generate-calendar-month (month year indent)
2091   "Produce a calendar for MONTH, YEAR on the Gregorian calendar.
2092 The calendar is inserted at the top of the buffer in which point is currently
2093 located, but indented INDENT spaces.  The indentation is done from the first
2094 character on the line and does not disturb the first INDENT characters on the
2095 line."
2096   (let* ((blank-days;; at start of month
2097           (mod
2098            (- (calendar-day-of-week (list month 1 year))
2099               calendar-week-start-day)
2100            7))
2101          (last (calendar-last-day-of-month month year)))
2102    (goto-char (point-min))
2103    (calendar-insert-indented
2104     (calendar-string-spread
2105      (list (format "%s %d" (calendar-month-name month) year)) ?  20)
2106     indent t)
2107    (calendar-insert-indented "" indent);; Go to proper spot
2108    ;; Use the first two characters of each day to head the columns.
2109    (calendar-for-loop i from 0 to 6 do
2110       (insert
2111        (let ((string
2112               (calendar-day-name (mod (+ calendar-week-start-day i) 7) nil t)))
2113          (if enable-multibyte-characters
2114              (truncate-string-to-width string 2)
2115            (substring string 0 2)))
2116        " "))
2117    (calendar-insert-indented "" 0 t);; Force onto following line
2118    (calendar-insert-indented "" indent);; Go to proper spot
2119    ;; Add blank days before the first of the month
2120    (calendar-for-loop i from 1 to blank-days do (insert "   "))
2121    ;; Put in the days of the month
2122    (calendar-for-loop i from 1 to last do
2123       (insert (format "%2d " i))
2124       (add-text-properties
2125        (- (point) 3) (1- (point))
2126        '(mouse-face highlight
2127          help-echo "mouse-2: menu of operations for this date"))
2128       (and (zerop (mod (+ i blank-days) 7))
2129            (/= i last)
2130            (calendar-insert-indented "" 0 t)    ;; Force onto following line
2131            (calendar-insert-indented "" indent)))));; Go to proper spot
2132
2133 (defun calendar-insert-indented (string indent &optional newline)
2134   "Insert STRING at column INDENT.
2135 If the optional parameter NEWLINE is t, leave point at start of next line,
2136 inserting a newline if there was no next line; otherwise, leave point after
2137 the inserted text.  Value is always t."
2138   ;; Try to move to that column.
2139   (move-to-column indent)
2140   ;; If line is too short, indent out to that column.
2141   (if (< (current-column) indent)
2142       (indent-to indent))
2143   (insert string)
2144   ;; Advance to next line, if requested.
2145   (if newline
2146       (progn
2147         (end-of-line)
2148         (if (eobp)
2149             (newline)
2150           (forward-line 1))))
2151   t)
2152
2153 (defun redraw-calendar ()
2154   "Redraw the calendar display, if `calendar-buffer' is live."
2155   (interactive)
2156   (if (get-buffer calendar-buffer)
2157       (save-excursion
2158         (with-current-buffer calendar-buffer
2159           (let ((cursor-date (calendar-cursor-to-nearest-date)))
2160             (generate-calendar-window displayed-month displayed-year)
2161             (calendar-cursor-to-visible-date cursor-date))))))
2162
2163 ;;;###autoload
2164 (defcustom calendar-week-start-day 0
2165   "*The day of the week on which a week in the calendar begins.
2166 0 means Sunday (default), 1 means Monday, and so on.
2167
2168 If you change this variable directly (without using customize)
2169 after starting `calendar', you should call `redraw-calendar' to
2170 update the calendar display to reflect the change, otherwise
2171 movement commands will not work correctly."
2172   :type 'integer
2173   :set (lambda (sym val)
2174          (set sym val)
2175          (redraw-calendar))
2176   :group 'calendar)
2177
2178 (defcustom calendar-debug-sexp nil
2179   "*Turn debugging on when evaluating a sexp in the diary or holiday list."
2180   :type 'boolean
2181   :group 'calendar)
2182
2183 (defvar calendar-mode-map nil)
2184 (if calendar-mode-map
2185     nil
2186   (setq calendar-mode-map (make-sparse-keymap))
2187   (require 'cal-menu)
2188   (calendar-for-loop i from 0 to 9 do
2189        (define-key calendar-mode-map (int-to-string i) 'digit-argument))
2190   (let ((l (list 'narrow-to-region 'mark-word 'mark-sexp 'mark-paragraph
2191                  'mark-defun 'mark-whole-buffer 'mark-page
2192                  'downcase-region 'upcase-region 'kill-region
2193                  'copy-region-as-kill 'capitalize-region 'write-region)))
2194     (while l
2195       (substitute-key-definition (car l) 'calendar-not-implemented
2196                                  calendar-mode-map global-map)
2197       (setq l (cdr l))))
2198   (define-key calendar-mode-map "-"     'negative-argument)
2199   (define-key calendar-mode-map "\C-x>" 'scroll-calendar-right)
2200   (define-key calendar-mode-map [prior] 'scroll-calendar-right-three-months)
2201   (define-key calendar-mode-map "\ev"   'scroll-calendar-right-three-months)
2202   (define-key calendar-mode-map "\C-x<" 'scroll-calendar-left)
2203   (define-key calendar-mode-map [next]  'scroll-calendar-left-three-months)
2204   (define-key calendar-mode-map "\C-v"  'scroll-calendar-left-three-months)
2205   (define-key calendar-mode-map "\C-b"  'calendar-backward-day)
2206   (define-key calendar-mode-map "\C-p"  'calendar-backward-week)
2207   (define-key calendar-mode-map "\e{"   'calendar-backward-month)
2208   (define-key calendar-mode-map "\C-x[" 'calendar-backward-year)
2209   (define-key calendar-mode-map "\C-f"  'calendar-forward-day)
2210   (define-key calendar-mode-map "\C-n"  'calendar-forward-week)
2211   (define-key calendar-mode-map [left]  'calendar-backward-day)
2212   (define-key calendar-mode-map [up]    'calendar-backward-week)
2213   (define-key calendar-mode-map [right] 'calendar-forward-day)
2214   (define-key calendar-mode-map [down]  'calendar-forward-week)
2215   (define-key calendar-mode-map "\e}"   'calendar-forward-month)
2216   (define-key calendar-mode-map "\C-x]" 'calendar-forward-year)
2217   (define-key calendar-mode-map "\C-a"  'calendar-beginning-of-week)
2218   (define-key calendar-mode-map "\C-e"  'calendar-end-of-week)
2219   (define-key calendar-mode-map "\ea"   'calendar-beginning-of-month)
2220   (define-key calendar-mode-map "\ee"   'calendar-end-of-month)
2221   (define-key calendar-mode-map "\e<"   'calendar-beginning-of-year)
2222   (define-key calendar-mode-map "\e>"   'calendar-end-of-year)
2223   (define-key calendar-mode-map "\C-@"  'calendar-set-mark)
2224   ;; Many people are used to typing C-SPC and getting C-@.
2225   (define-key calendar-mode-map [?\C- ] 'calendar-set-mark)
2226   (define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark)
2227   (define-key calendar-mode-map "\e=" 'calendar-count-days-region)
2228   (define-key calendar-mode-map "gd"  'calendar-goto-date)
2229   (define-key calendar-mode-map "gD"  'calendar-goto-day-of-year)
2230   (define-key calendar-mode-map "gj"  'calendar-goto-julian-date)
2231   (define-key calendar-mode-map "ga"  'calendar-goto-astro-day-number)
2232   (define-key calendar-mode-map "gh"  'calendar-goto-hebrew-date)
2233   (define-key calendar-mode-map "gi"  'calendar-goto-islamic-date)
2234   (define-key calendar-mode-map "gb"  'calendar-goto-bahai-date)
2235   (define-key calendar-mode-map "gC"  'calendar-goto-chinese-date)
2236   (define-key calendar-mode-map "gk"  'calendar-goto-coptic-date)
2237   (define-key calendar-mode-map "ge"  'calendar-goto-ethiopic-date)
2238   (define-key calendar-mode-map "gp"  'calendar-goto-persian-date)
2239   (define-key calendar-mode-map "gc"  'calendar-goto-iso-date)
2240   (define-key calendar-mode-map "gw"  'calendar-goto-iso-week)
2241   (define-key calendar-mode-map "gf"  'calendar-goto-french-date)
2242   (define-key calendar-mode-map "gml"  'calendar-goto-mayan-long-count-date)
2243   (define-key calendar-mode-map "gmpc" 'calendar-previous-calendar-round-date)
2244   (define-key calendar-mode-map "gmnc" 'calendar-next-calendar-round-date)
2245   (define-key calendar-mode-map "gmph" 'calendar-previous-haab-date)
2246   (define-key calendar-mode-map "gmnh" 'calendar-next-haab-date)
2247   (define-key calendar-mode-map "gmpt" 'calendar-previous-tzolkin-date)
2248   (define-key calendar-mode-map "gmnt" 'calendar-next-tzolkin-date)
2249   (define-key calendar-mode-map "Aa"   'appt-add)
2250   (define-key calendar-mode-map "Ad"   'appt-delete)
2251   (define-key calendar-mode-map "S"   'calendar-sunrise-sunset)
2252   (define-key calendar-mode-map "M"   'calendar-phases-of-moon)
2253   (define-key calendar-mode-map " "   'scroll-other-window)
2254   (define-key calendar-mode-map (kbd "DEL") 'scroll-other-window-down)
2255   (define-key calendar-mode-map "\C-c\C-l" 'redraw-calendar)
2256   (define-key calendar-mode-map "."   'calendar-goto-today)
2257   (define-key calendar-mode-map "o"   'calendar-other-month)
2258   (define-key calendar-mode-map "q"   'exit-calendar)
2259   (define-key calendar-mode-map "a"   'list-calendar-holidays)
2260   (define-key calendar-mode-map "h"   'calendar-cursor-holidays)
2261   (define-key calendar-mode-map "x"   'mark-calendar-holidays)
2262   (define-key calendar-mode-map "u"   'calendar-unmark)
2263   (define-key calendar-mode-map "m"   'mark-diary-entries)
2264   (define-key calendar-mode-map "d"   'view-diary-entries)
2265   (define-key calendar-mode-map "D"   'view-other-diary-entries)
2266   (define-key calendar-mode-map "s"   'show-all-diary-entries)
2267   (define-key calendar-mode-map "pd"  'calendar-print-day-of-year)
2268   (define-key calendar-mode-map "pC"  'calendar-print-chinese-date)
2269   (define-key calendar-mode-map "pk"  'calendar-print-coptic-date)
2270   (define-key calendar-mode-map "pe"  'calendar-print-ethiopic-date)
2271   (define-key calendar-mode-map "pp"  'calendar-print-persian-date)
2272   (define-key calendar-mode-map "pc"  'calendar-print-iso-date)
2273   (define-key calendar-mode-map "pj"  'calendar-print-julian-date)
2274   (define-key calendar-mode-map "pa"  'calendar-print-astro-day-number)
2275   (define-key calendar-mode-map "ph"  'calendar-print-hebrew-date)
2276   (define-key calendar-mode-map "pi"  'calendar-print-islamic-date)
2277   (define-key calendar-mode-map "pb"  'calendar-print-bahai-date)
2278   (define-key calendar-mode-map "pf"  'calendar-print-french-date)
2279   (define-key calendar-mode-map "pm"  'calendar-print-mayan-date)
2280   (define-key calendar-mode-map "po"  'calendar-print-other-dates)
2281   (define-key calendar-mode-map "id"  'insert-diary-entry)
2282   (define-key calendar-mode-map "iw"  'insert-weekly-diary-entry)
2283   (define-key calendar-mode-map "im"  'insert-monthly-diary-entry)
2284   (define-key calendar-mode-map "iy"  'insert-yearly-diary-entry)
2285   (define-key calendar-mode-map "ia"  'insert-anniversary-diary-entry)
2286   (define-key calendar-mode-map "ib"  'insert-block-diary-entry)
2287   (define-key calendar-mode-map "ic"  'insert-cyclic-diary-entry)
2288   (define-key calendar-mode-map "ihd" 'insert-hebrew-diary-entry)
2289   (define-key calendar-mode-map "ihm" 'insert-monthly-hebrew-diary-entry)
2290   (define-key calendar-mode-map "ihy" 'insert-yearly-hebrew-diary-entry)
2291   (define-key calendar-mode-map "iid" 'insert-islamic-diary-entry)
2292   (define-key calendar-mode-map "iim" 'insert-monthly-islamic-diary-entry)
2293   (define-key calendar-mode-map "iiy" 'insert-yearly-islamic-diary-entry)
2294   (define-key calendar-mode-map "iBd" 'insert-bahai-diary-entry)
2295   (define-key calendar-mode-map "iBm" 'insert-monthly-bahai-diary-entry)
2296   (define-key calendar-mode-map "iBy" 'insert-yearly-bahai-diary-entry)
2297   (define-key calendar-mode-map "?"   'calendar-goto-info-node)
2298   (define-key calendar-mode-map "tm" 'cal-tex-cursor-month)
2299   (define-key calendar-mode-map "tM" 'cal-tex-cursor-month-landscape)
2300   (define-key calendar-mode-map "td" 'cal-tex-cursor-day)
2301   (define-key calendar-mode-map "tw1" 'cal-tex-cursor-week)
2302   (define-key calendar-mode-map "tw2" 'cal-tex-cursor-week2)
2303   (define-key calendar-mode-map "tw3" 'cal-tex-cursor-week-iso)
2304   (define-key calendar-mode-map "tw4" 'cal-tex-cursor-week-monday)
2305   (define-key calendar-mode-map "tfd" 'cal-tex-cursor-filofax-daily)
2306   (define-key calendar-mode-map "tfw" 'cal-tex-cursor-filofax-2week)
2307   (define-key calendar-mode-map "tfW" 'cal-tex-cursor-filofax-week)
2308   (define-key calendar-mode-map "tfy" 'cal-tex-cursor-filofax-year)
2309   (define-key calendar-mode-map "ty" 'cal-tex-cursor-year)
2310   (define-key calendar-mode-map "tY" 'cal-tex-cursor-year-landscape))
2311
2312 (defun describe-calendar-mode ()
2313   "Create a help buffer with a brief description of the `calendar-mode'."
2314   (interactive)
2315   (with-output-to-temp-buffer "*Help*"
2316     (princ
2317      (format
2318       "Calendar Mode:\nFor a complete description, type %s\n%s\n"
2319       (substitute-command-keys
2320        "\\<calendar-mode-map>\\[describe-mode] from within the calendar")
2321       (substitute-command-keys "\\{calendar-mode-map}")))
2322     (save-excursion
2323       (set-buffer standard-output)
2324       (help-mode))
2325     (print-help-return-message)))
2326
2327 ;; Calendar mode is suitable only for specially formatted data.
2328 (put 'calendar-mode 'mode-class 'special)
2329
2330 (defvar calendar-mode-line-format
2331   (list
2332    (propertize (substitute-command-keys
2333                 "\\<calendar-mode-map>\\[scroll-calendar-left]")
2334                'help-echo "mouse-2: scroll left"
2335                'keymap (make-mode-line-mouse-map 'mouse-2
2336                                                  'mouse-scroll-calendar-left))
2337    "Calendar"
2338    (concat
2339     (propertize
2340      (substitute-command-keys
2341       "\\<calendar-mode-map>\\[calendar-goto-info-node] info")
2342      'help-echo "mouse-2: read Info on Calendar"
2343      'keymap (make-mode-line-mouse-map 'mouse-2 'calendar-goto-info-node))
2344     "/"
2345     (propertize
2346      (substitute-command-keys
2347      "\\<calendar-mode-map>\\[calendar-other-month] other")
2348      'help-echo "mouse-2: choose another month"
2349      'keymap (make-mode-line-mouse-map
2350               'mouse-2 'mouse-calendar-other-month))
2351     "/"
2352     (propertize
2353      (substitute-command-keys
2354      "\\<calendar-mode-map>\\[calendar-goto-today] today")
2355      'help-echo "mouse-2: go to today's date"
2356      'keymap (make-mode-line-mouse-map 'mouse-2 #'calendar-goto-today)))
2357    '(calendar-date-string (calendar-current-date) t)
2358    (propertize (substitute-command-keys
2359                 "\\<calendar-mode-map>\\[scroll-calendar-right]")
2360                'help-echo "mouse-2: scroll right"
2361                'keymap (make-mode-line-mouse-map
2362                         'mouse-2 'mouse-scroll-calendar-right)))
2363   "The mode line of the calendar buffer.
2364
2365 This must be a list of items that evaluate to strings--those strings are
2366 evaluated and concatenated together, evenly separated by blanks.  The variable
2367 `date' is available for use as the date under (or near) the cursor; `date'
2368 defaults to the current date if it is otherwise undefined.  Here is an example
2369 value that has the Hebrew date, the day number/days remaining in the year,
2370 and the ISO week/year numbers in the mode.  When calendar-move-hook is set to
2371 'update-calendar-mode-line, these mode line shows these values for the date
2372 under the cursor:
2373
2374       (list
2375        \"\"
2376        '(calendar-hebrew-date-string date)
2377        '(let* ((year (extract-calendar-year date))
2378                (d (calendar-day-number date))
2379                (days-remaining
2380                 (- (calendar-day-number (list 12 31 year)) d)))
2381           (format \"%d/%d\" d days-remaining))
2382        '(let* ((d (calendar-absolute-from-gregorian date))
2383                (iso-date (calendar-iso-from-absolute d)))
2384           (format \"ISO week %d of %d\"
2385             (extract-calendar-month iso-date)
2386             (extract-calendar-year iso-date)))
2387        \"\"))
2388 ")
2389
2390 (defun mouse-scroll-calendar-left (event)
2391   "Scroll the displayed calendar left by one month.
2392 Maintains the relative position of the cursor
2393 with respect to the calendar as well as possible."
2394   (interactive "e")
2395   (save-selected-window
2396     (select-window (posn-window (event-start event)))
2397     (scroll-calendar-left 1)))
2398
2399 (defun mouse-scroll-calendar-right (event)
2400   "Scroll the displayed calendar right by one month.
2401 Maintains the relative position of the cursor
2402 with respect to the calendar as well as possible."
2403   (interactive "e")
2404   (save-selected-window
2405     (select-window (posn-window (event-start event)))
2406     (scroll-calendar-right 1)))
2407
2408 (defun mouse-calendar-other-month (event)
2409   "Display a three-month calendar centered around a specified month and year."
2410   (interactive "e")
2411   (save-selected-window
2412     (select-window (posn-window (event-start event)))
2413     (call-interactively 'calendar-other-month)))
2414
2415 (defun calendar-goto-info-node ()
2416   "Go to the info node for the calendar."
2417   (interactive)
2418   (require 'info)
2419   (let ((where (save-window-excursion
2420                  (Info-find-emacs-command-nodes 'calendar))))
2421     (if (not where)
2422         (error "Couldn't find documentation for the calendar")
2423       (let (same-window-buffer-names)
2424         (info))
2425       (Info-find-node (car (car where)) (car (cdr (car where)))))))
2426
2427
2428
2429 (defun calendar-mode ()
2430   "A major mode for the calendar window.
2431
2432 For a complete description, type \
2433 \\<calendar-mode-map>\\[calendar-goto-info-node] from within the calendar.
2434
2435 \\<calendar-mode-map>\\{calendar-mode-map}"
2436
2437   (kill-all-local-variables)
2438   (setq major-mode 'calendar-mode)
2439   (setq mode-name "Calendar")
2440   (use-local-map calendar-mode-map)
2441   (setq buffer-read-only t)
2442   (setq indent-tabs-mode nil)
2443   (update-calendar-mode-line)
2444   (add-hook 'activate-menubar-hook 'cal-menu-update nil t)
2445   (make-local-variable 'calendar-mark-ring)
2446   (make-local-variable 'displayed-month);;  Month in middle of window.
2447   (make-local-variable 'displayed-year) ;;  Year in middle of window.
2448   (set (make-local-variable 'font-lock-defaults)
2449        '(calendar-font-lock-keywords t)))
2450
2451 (defun calendar-string-spread (strings char length)
2452   "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH.
2453 The effect is like mapconcat but the separating pieces are as balanced as
2454 possible.  Each item of STRINGS is evaluated before concatenation so it can
2455 actually be an expression that evaluates to a string.  If LENGTH is too short,
2456 the STRINGS are just concatenated and the result truncated."
2457 ;; The algorithm is based on equation (3.25) on page 85 of Concrete
2458 ;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
2459 ;; Addison-Wesley, Reading, MA, 1989
2460   (let* ((strings (mapcar 'eval
2461                           (if (< (length strings) 2)
2462                               (append (list "") strings (list ""))
2463                             strings)))
2464          (n (- length (length (apply 'concat strings))))
2465          (m (1- (length strings)))
2466          (s (car strings))
2467          (strings (cdr strings))
2468          (i 0))
2469     (while strings
2470       (setq s (concat s
2471                       (make-string (max 0 (/ (+ n i) m)) char)
2472                       (car strings)))
2473       (setq i (1+ i))
2474       (setq strings (cdr strings)))
2475     (substring s 0 length)))
2476
2477 (defun update-calendar-mode-line ()
2478   "Update the calendar mode line with the current date and date style."
2479   (if (bufferp (get-buffer calendar-buffer))
2480       (save-excursion
2481         (set-buffer calendar-buffer)
2482         (setq mode-line-format
2483               (calendar-string-spread
2484                (let ((date (condition-case nil
2485                                (calendar-cursor-to-nearest-date)
2486                              (error (calendar-current-date)))))
2487                  (mapcar 'eval  calendar-mode-line-format))
2488                ?  (frame-width)))
2489         (force-mode-line-update))))
2490
2491 (defun calendar-window-list ()
2492   "List of all calendar-related windows."
2493   (let ((calendar-buffers (calendar-buffer-list))
2494         list)
2495     (walk-windows (lambda (w)
2496                     (if (memq (window-buffer w) calendar-buffers)
2497                         (setq list (cons w list))))
2498                   nil t)
2499     list))
2500
2501 (defun calendar-buffer-list ()
2502   "List of all calendar-related buffers."
2503   (let* ((diary-buffer (get-file-buffer diary-file))
2504          (buffers (list "*Yahrzeits*" lunar-phases-buffer holiday-buffer
2505                         fancy-diary-buffer diary-buffer calendar-buffer
2506                         other-calendars-buffer))
2507          (buffer-list nil)
2508          b)
2509     (while buffers
2510       (setq b (car buffers))
2511       (setq b (cond ((stringp b) (get-buffer b))
2512                     ((bufferp b) b)
2513                     (t nil)))
2514       (if b (setq buffer-list (cons b buffer-list)))
2515       (setq buffers (cdr buffers)))
2516     buffer-list))
2517
2518 (defun exit-calendar ()
2519   "Get out of the calendar window and hide it and related buffers."
2520   (interactive)
2521   (let* ((diary-buffer (get-file-buffer diary-file)))
2522     (if (or (not diary-buffer)
2523             (not (buffer-modified-p diary-buffer))
2524             (yes-or-no-p
2525              "Diary modified; do you really want to exit the calendar? "))
2526       ;; Need to do this multiple times because one time can replace some
2527       ;; calendar-related buffers with other calendar-related buffers
2528       (mapcar (lambda (x)
2529                 (mapcar 'calendar-hide-window (calendar-window-list)))
2530               (calendar-window-list)))))
2531
2532 (defun calendar-hide-window (window)
2533   "Hide WINDOW if it is calendar-related."
2534   (let ((buffer (if (window-live-p window) (window-buffer window))))
2535     (if (memq buffer (calendar-buffer-list))
2536         (cond
2537          ((and (display-multi-frame-p)
2538                (eq 'icon (cdr (assoc 'visibility
2539                                      (frame-parameters
2540                                       (window-frame window))))))
2541           nil)
2542          ((and (display-multi-frame-p) (window-dedicated-p window))
2543           (if calendar-remove-frame-by-deleting
2544               (delete-frame (window-frame window))
2545               (iconify-frame (window-frame window))))
2546          ((not (and (select-window window) (one-window-p window)))
2547           (delete-window window))
2548          (t (set-buffer buffer)
2549             (bury-buffer))))))
2550
2551 (defun calendar-current-date ()
2552   "Return the current date in a list (month day year)."
2553   (let ((now (decode-time)))
2554     (list (nth 4 now) (nth 3 now) (nth 5 now))))
2555
2556 (defun calendar-cursor-to-date (&optional error)
2557   "Return a list (month day year) of current cursor position.
2558 If cursor is not on a specific date, signals an error if optional parameter
2559 ERROR is t, otherwise just returns nil."
2560   (let* ((segment (/ (current-column) 25))
2561          (month (% (+ displayed-month segment -1) 12))
2562          (month (if (= 0 month) 12 month))
2563          (year
2564           (cond
2565            ((and (=  12 month) (= segment 0)) (1- displayed-year))
2566            ((and (=   1 month) (= segment 2)) (1+ displayed-year))
2567            (t displayed-year))))
2568     (if (and (looking-at "[ 0-9]?[0-9][^0-9]")
2569              (< 2 (count-lines (point-min) (point))))
2570         (save-excursion
2571           (if (not (looking-at " "))
2572                    (re-search-backward "[^0-9]"))
2573           (list month
2574                 (string-to-int (buffer-substring (1+ (point)) (+ 4 (point))))
2575                 year))
2576       (if (looking-at "\\*")
2577           (save-excursion
2578             (re-search-backward "[^*]")
2579             (if (looking-at ".\\*\\*")
2580                 (list month calendar-starred-day year)
2581               (if error (error "Not on a date!"))))
2582         (if error (error "Not on a date!"))))))
2583
2584 ;; The following version of calendar-gregorian-from-absolute is preferred for
2585 ;; reasons of clarity, BUT it's much slower than the version that follows it.
2586
2587 ;;(defun calendar-gregorian-from-absolute (date)
2588 ;;  "Compute the list (month day year) corresponding to the absolute DATE.
2589 ;;The absolute date is the number of days elapsed since the (imaginary)
2590 ;;Gregorian date Sunday, December 31, 1 BC."
2591 ;;  (let* ((approx (/ date 366));; Approximation from below.
2592 ;;         (year                ;; Search forward from the approximation.
2593 ;;          (+ approx
2594 ;;             (calendar-sum y approx
2595 ;;                 (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y))))
2596 ;;                  1)))
2597 ;;         (month         ;; Search forward from January.
2598 ;;          (1+ (calendar-sum m 1
2599 ;;                   (> date
2600 ;;                      (calendar-absolute-from-gregorian
2601 ;;                       (list m (calendar-last-day-of-month m year) year)))
2602 ;;                   1)))
2603 ;;         (day           ;; Calculate the day by subtraction.
2604 ;;          (- date
2605 ;;             (1- (calendar-absolute-from-gregorian (list month 1 year))))))
2606 ;;    (list month day year)))
2607
2608 (defun calendar-gregorian-from-absolute (date)
2609   "Compute the list (month day year) corresponding to the absolute DATE.
2610 The absolute date is the number of days elapsed since the (imaginary)
2611 Gregorian date Sunday, December 31, 1 BC.  This function does not
2612 handle dates in years BC."
2613 ;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
2614 ;; Three Historical Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M.
2615 ;; Clamen, Software--Practice and Experience, Volume 23, Number 4
2616 ;; (April, 1993), pages 383-404 for an explanation.
2617   (let* ((d0 (1- date))
2618          (n400 (/ d0 146097))
2619          (d1 (% d0 146097))
2620          (n100 (/ d1 36524))
2621          (d2 (% d1 36524))
2622          (n4 (/ d2 1461))
2623          (d3 (% d2 1461))
2624          (n1 (/ d3 365))
2625          (day (1+ (% d3 365)))
2626          (year (+ (* 400 n400) (* 100 n100) (* n4 4) n1)))
2627     (if (or (= n100 4) (= n1 4))
2628         (list 12 31 year)
2629       (let ((year (1+ year))
2630             (month 1))
2631         (while (let ((mdays (calendar-last-day-of-month month year)))
2632                  (and (< mdays day)
2633                       (setq day (- day mdays))))
2634           (setq month (1+ month)))
2635         (list month day year)))))
2636
2637 (defun calendar-other-month (month year)
2638   "Display a three-month calendar centered around MONTH and YEAR."
2639   (interactive (calendar-read-date 'noday))
2640   (if (and (= month displayed-month)
2641            (= year displayed-year))
2642       nil
2643     (let ((old-date (calendar-cursor-to-date))
2644           (today (calendar-current-date)))
2645       (generate-calendar-window month year)
2646       (calendar-cursor-to-visible-date
2647        (cond
2648         ((calendar-date-is-visible-p old-date) old-date)
2649         ((calendar-date-is-visible-p today) today)
2650         (t (list month 1 year)))))))
2651
2652 (defun calendar-set-mark (arg)
2653   "Mark the date under the cursor, or jump to marked date.
2654 With no prefix argument, push current date onto marked date ring.
2655 With argument, jump to mark, pop it, and put point at end of ring."
2656   (interactive "P")
2657   (let ((date (calendar-cursor-to-date t)))
2658     (if (null arg)
2659         (progn
2660           (setq calendar-mark-ring (cons date calendar-mark-ring))
2661           ;; Since the top of the mark ring is the marked date in the
2662           ;; calendar, the mark ring in the calendar is one longer than
2663           ;; in other buffers to get the same effect.
2664           (if (> (length calendar-mark-ring) (1+ mark-ring-max))
2665               (setcdr (nthcdr mark-ring-max calendar-mark-ring) nil))
2666           (message "Mark set"))
2667       (if (null calendar-mark-ring)
2668           (error "No mark set in this buffer")
2669         (calendar-goto-date (car calendar-mark-ring))
2670         (setq calendar-mark-ring
2671               (cdr (nconc calendar-mark-ring (list date))))))))
2672
2673 (defun calendar-exchange-point-and-mark ()
2674   "Exchange the current cursor position with the marked date."
2675   (interactive)
2676   (let ((mark (car calendar-mark-ring))
2677         (date (calendar-cursor-to-date t)))
2678     (if (null mark)
2679         (error "No mark set in this buffer")
2680       (setq calendar-mark-ring (cons date (cdr calendar-mark-ring)))
2681       (calendar-goto-date mark))))
2682
2683 (defun calendar-count-days-region ()
2684   "Count the number of days (inclusive) between point and the mark."
2685   (interactive)
2686   (let* ((days (- (calendar-absolute-from-gregorian
2687                    (calendar-cursor-to-date t))
2688                   (calendar-absolute-from-gregorian
2689                    (or (car calendar-mark-ring)
2690                        (error "No mark set in this buffer")))))
2691          (days (1+ (if (> days 0) days (- days)))))
2692     (message "Region has %d day%s (inclusive)"
2693              days (if (> days 1) "s" ""))))
2694
2695 (defun calendar-not-implemented ()
2696   "Not implemented."
2697   (interactive)
2698   (error "%s not available in the calendar"
2699          (global-key-binding (this-command-keys))))
2700
2701 (defun calendar-read (prompt acceptable &optional initial-contents)
2702   "Return an object read from the minibuffer.
2703 Prompt with the string PROMPT and use the function ACCEPTABLE to decide if
2704 entered item is acceptable.  If non-nil, optional third arg INITIAL-CONTENTS
2705 is a string to insert in the minibuffer before reading."
2706   (let ((value (read-minibuffer prompt initial-contents)))
2707     (while (not (funcall acceptable value))
2708       (setq value (read-minibuffer prompt initial-contents)))
2709     value))
2710
2711 (defun calendar-read-date (&optional noday)
2712   "Prompt for Gregorian date.  Return a list (month day year).
2713 If optional NODAY is t, does not ask for day, but just returns
2714 \(month nil year); if NODAY is any other non-nil value the value returned is
2715 \(month year)"
2716   (let* ((year (calendar-read
2717                 "Year (>0): "
2718                 (lambda (x) (> x 0))
2719                 (int-to-string (extract-calendar-year
2720                                 (calendar-current-date)))))
2721          (month-array calendar-month-name-array)
2722          (completion-ignore-case t)
2723          (month (cdr (assoc-string
2724                        (completing-read
2725                         "Month name: "
2726                         (mapcar 'list (append month-array nil))
2727                         nil t)
2728                       (calendar-make-alist month-array 1) t)))
2729          (last (calendar-last-day-of-month month year)))
2730     (if noday
2731         (if (eq noday t)
2732             (list month nil year)
2733           (list month year))
2734       (list month
2735             (calendar-read (format "Day (1-%d): " last)
2736                            (lambda (x) (and (< 0 x) (<= x last))))
2737             year))))
2738
2739 (defun calendar-interval (mon1 yr1 mon2 yr2)
2740   "The number of months difference between MON1, YR1 and MON2, YR2.
2741 The result is positive if the second date is later than the first.
2742 Negative years are interpreted as years BC; -1 being 1 BC, and so on."
2743   (if (< yr1 0) (setq yr1 (1+ yr1)))      ; -1 BC -> 0 AD, etc
2744   (if (< yr2 0) (setq yr2 (1+ yr2)))
2745   (+ (* 12 (- yr2 yr1))
2746      (- mon2 mon1)))
2747
2748 (defvar calendar-abbrev-length 3
2749   "*Length of abbreviations to be used for day and month names.
2750 See also `calendar-day-abbrev-array' and `calendar-month-abbrev-array'.")
2751
2752 (defvar calendar-day-name-array
2753   ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
2754   "*Array of capitalized strings giving, in order, the day names.
2755 The first two characters of each string will be used to head the
2756 day columns in the calendar.  See also the variable
2757 `calendar-day-abbrev-array'.")
2758
2759 (defvar calendar-day-abbrev-array
2760   [nil nil nil nil nil nil nil]
2761   "*Array of capitalized strings giving the abbreviated day names.
2762 The order should be the same as that of the full names specified
2763 in `calendar-day-name-array'.  These abbreviations may be used
2764 instead of the full names in the diary file.  Do not include a
2765 trailing `.' in the strings specified in this variable, though
2766 you may use such in the diary file.  If any element of this array
2767 is nil, then the abbreviation will be constructed as the first
2768 `calendar-abbrev-length' characters of the corresponding full name.")
2769
2770 (defvar calendar-month-name-array
2771   ["January" "February" "March"     "April"   "May"      "June"
2772    "July"    "August"   "September" "October" "November" "December"]
2773   "*Array of capitalized strings giving, in order, the month names.
2774 See also the variable `calendar-month-abbrev-array'.")
2775
2776 (defvar calendar-month-abbrev-array
2777   [nil nil nil nil nil nil nil nil nil nil nil nil]
2778  "*Array of capitalized strings giving the abbreviated month names.
2779 The order should be the same as that of the full names specified
2780 in `calendar-month-name-array'.  These abbreviations are used in
2781 the calendar menu entries, and can also be used in the diary
2782 file.  Do not include a trailing `.' in the strings specified in
2783 this variable, though you may use such in the diary file.  If any
2784 element of this array is nil, then the abbreviation will be
2785 constructed as the first `calendar-abbrev-length' characters of the
2786 corresponding full name.")
2787
2788 (defun calendar-abbrev-construct (abbrev full &optional period)
2789   "Internal calendar function to return a complete abbreviation array.
2790 ABBREV is an array of abbreviations, FULL the corresponding array
2791 of full names.  The return value is the ABBREV array, with any nil
2792 elements replaced by the first three characters taken from the
2793 corresponding element of FULL.  If optional argument PERIOD is non-nil,
2794 each element returned has a final `.' character."
2795   (let (elem array name)
2796     (dotimes (i (length full))
2797       (setq name (aref full i)
2798             elem (or (aref abbrev i)
2799                      (substring name 0
2800                                 (min calendar-abbrev-length (length name))))
2801             elem (format "%s%s" elem (if period "." ""))
2802             array (append array (list elem))))
2803     (vconcat array)))
2804
2805 (defvar calendar-font-lock-keywords
2806   `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
2807               " -?[0-9]+")
2808      . font-lock-function-name-face) ; month and year
2809     (,(regexp-opt
2810        (list (substring (aref calendar-day-name-array 6) 0 2)
2811              (substring (aref calendar-day-name-array 0) 0 2)))
2812      ;; Saturdays and Sundays are hilited differently.
2813      . font-lock-comment-face)
2814     ;; First two chars of each day are used in the calendar.
2815     (,(regexp-opt (mapcar (lambda (x) (substring x 0 2)) calendar-day-name-array))
2816      . font-lock-reference-face))
2817   "Default keywords to highlight in Calendar mode.")
2818
2819 (defun calendar-day-name (date &optional abbrev absolute)
2820   "Return a string with the name of the day of the week of DATE.
2821 DATE should be a list in the format (MONTH DAY YEAR), unless the
2822 optional argument ABSOLUTE is non-nil, in which case DATE should
2823 be an integer in the range 0 to 6 corresponding to the day of the
2824 week.  Day names are taken from the variable `calendar-day-name-array',
2825 unless the optional argument ABBREV is non-nil, in which case
2826 the variable `calendar-day-abbrev-array' is used."
2827   (aref (if abbrev
2828             (calendar-abbrev-construct calendar-day-abbrev-array
2829                                        calendar-day-name-array)
2830           calendar-day-name-array)
2831         (if absolute date (calendar-day-of-week date))))
2832
2833 (defun calendar-make-alist (sequence &optional start-index filter abbrevs)
2834   "Make an assoc list corresponding to SEQUENCE.
2835 Each element of sequence will be associated with an integer, starting
2836 from 1, or from START-INDEX if that is non-nil.  If a sequence ABBREVS
2837 is supplied, the function `calendar-abbrev-construct' is used to
2838 construct abbreviations corresponding to the elements in SEQUENCE.
2839 Each abbreviation is entered into the alist with the same
2840 association index as the full name it represents.
2841 If FILTER is provided, apply it to each key in the alist."
2842   (let ((index 0)
2843         (offset (or start-index 1))
2844         (aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence)))
2845         (aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence
2846                                                       'period)))
2847         alist elem)
2848     (dotimes (i (length sequence) (reverse alist))
2849       (setq index (+ i offset)
2850             elem (elt sequence i)
2851             alist
2852             (cons (cons (if filter (funcall filter elem) elem) index) alist))
2853       (if aseq
2854           (setq elem (elt aseq i)
2855                 alist (cons (cons (if filter (funcall filter elem) elem)
2856                                   index) alist)))
2857       (if aseqp
2858           (setq elem (elt aseqp i)
2859                 alist (cons (cons (if filter (funcall filter elem) elem)
2860                                   index) alist))))))
2861
2862 (defun calendar-month-name (month &optional abbrev)
2863   "Return a string with the name of month number MONTH.
2864 Months are numbered from one.  Month names are taken from the
2865 variable `calendar-month-name-array', unless the optional
2866 argument ABBREV is non-nil, in which case
2867 `calendar-month-abbrev-array' is used."
2868   (aref (if abbrev
2869             (calendar-abbrev-construct calendar-month-abbrev-array
2870                                        calendar-month-name-array)
2871           calendar-month-name-array)
2872         (1- month)))
2873
2874 (defun calendar-day-of-week (date)
2875   "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc.
2876 DATE is a list of the form (month day year).  A negative year is
2877 interpreted as BC; -1 being 1 BC, and so on."
2878   (mod (calendar-absolute-from-gregorian date) 7))
2879
2880 (defun calendar-unmark ()
2881   "Delete all diary/holiday marks/highlighting from the calendar."
2882   (interactive)
2883   (setq mark-holidays-in-calendar nil)
2884   (setq mark-diary-entries-in-calendar nil)
2885   (redraw-calendar))
2886
2887 (defun calendar-date-is-visible-p (date)
2888   "Return t if DATE is legal and is visible in the calendar window."
2889   (let ((gap (calendar-interval
2890               displayed-month displayed-year
2891               (extract-calendar-month date) (extract-calendar-year date))))
2892     (and (calendar-date-is-legal-p date) (> 2 gap) (< -2 gap))))
2893
2894 (defun calendar-date-is-legal-p (date)
2895   "Return t if DATE is a legal date."
2896   (let ((month (extract-calendar-month date))
2897         (day (extract-calendar-day date))
2898         (year (extract-calendar-year date)))
2899     (and (<= 1 month) (<= month 12)
2900          (<= 1 day) (<= day (calendar-last-day-of-month month year))
2901          ;; BC dates left as non-legal, to suppress errors from
2902          ;; complex holiday algorithms not suitable for years BC.
2903          ;; Note there are side effects on calendar navigation.
2904          (<= 1 year))))
2905
2906 (defun calendar-date-equal (date1 date2)
2907   "Return t if the DATE1 and DATE2 are the same."
2908   (and
2909    (= (extract-calendar-month date1) (extract-calendar-month date2))
2910    (= (extract-calendar-day date1) (extract-calendar-day date2))
2911    (= (extract-calendar-year date1) (extract-calendar-year date2))))
2912
2913 (defun mark-visible-calendar-date (date &optional mark)
2914   "Mark DATE in the calendar window with MARK.
2915 MARK is a single-character string, a list of face attributes/values, or a face.
2916 MARK defaults to `diary-entry-marker'."
2917   (if (calendar-date-is-legal-p date)
2918       (save-excursion
2919         (set-buffer calendar-buffer)
2920         (calendar-cursor-to-visible-date date)
2921         (let ((mark (or (and (stringp mark) (= (length mark) 1) mark) ; single-char
2922                         (and (listp mark) (> (length mark) 0) mark) ; attr list
2923                         (and (facep mark) mark) ; face-name
2924                         diary-entry-marker)))
2925           (if (facep mark)
2926               (progn ; face or an attr-list that contained a face
2927                 (overlay-put
2928                  (make-overlay (1- (point)) (1+ (point))) 'face mark))
2929             (if (and (stringp mark)
2930                      (= (length mark) 1)) ; single-char
2931                 (let ((buffer-read-only nil))
2932                   (forward-char 1)
2933                   (delete-char 1)
2934                   (insert mark)
2935                   (forward-char -2))
2936               (let ; attr list
2937                   ((temp-face
2938                     (make-symbol (apply 'concat "temp-face-"
2939                                         (mapcar '(lambda (sym)
2940                                                    (cond ((symbolp sym) (symbol-name sym))
2941                                                          ((numberp sym) (int-to-string sym))
2942                                                          (t sym))) mark))))
2943                    (faceinfo mark))
2944                 (make-face temp-face)
2945                 ;; Remove :face info from the mark, copy the face info into temp-face
2946                 (while (setq faceinfo (memq :face faceinfo))
2947                   (copy-face (read (nth 1 faceinfo)) temp-face)
2948                   (setcar faceinfo nil)
2949                   (setcar (cdr faceinfo) nil))
2950                 (setq mark (delq nil mark))
2951                 ;; Apply the font aspects
2952                 (apply 'set-face-attribute temp-face nil mark)
2953                 (overlay-put
2954                  (make-overlay (1- (point)) (1+ (point))) 'face temp-face))))))))
2955
2956 (defun calendar-star-date ()
2957   "Replace the date under the cursor in the calendar window with asterisks.
2958 This function can be used with the `today-visible-calendar-hook' run after the
2959 calendar window has been prepared."
2960   (let ((inhibit-read-only t))
2961     (make-local-variable 'calendar-starred-day)
2962     (forward-char 1)
2963     (setq calendar-starred-day
2964           (string-to-int
2965            (buffer-substring (point) (- (point) 2))))
2966     (delete-char -2)
2967     (insert "**")
2968     (backward-char 1)
2969     (set-buffer-modified-p nil)))
2970
2971 (defun calendar-mark-today ()
2972   "Mark the date under the cursor in the calendar window.
2973 The date is marked with `calendar-today-marker'.  This function can be used with
2974 the `today-visible-calendar-hook' run after the calendar window has been
2975 prepared."
2976   (mark-visible-calendar-date
2977    (calendar-cursor-to-date)
2978    calendar-today-marker))
2979
2980 (defun calendar-date-compare (date1 date2)
2981   "Return t if DATE1 is before DATE2, nil otherwise.
2982 The actual dates are in the car of DATE1 and DATE2."
2983   (< (calendar-absolute-from-gregorian (car date1))
2984      (calendar-absolute-from-gregorian (car date2))))
2985
2986 (defun calendar-date-string (date &optional abbreviate nodayname)
2987   "A string form of DATE, driven by the variable `calendar-date-display-form'.
2988 An optional parameter ABBREVIATE, when non-nil, causes the month
2989 and day names to be abbreviated as specified by
2990 `calendar-month-abbrev-array' and `calendar-day-abbrev-array',
2991 respectively.  An optional parameter NODAYNAME, when t, omits the
2992 name of the day of the week."
2993   (let* ((dayname
2994           (unless nodayname
2995             (calendar-day-name date abbreviate)))
2996          (month (extract-calendar-month date))
2997          (monthname (calendar-month-name month abbreviate))
2998          (day (int-to-string (extract-calendar-day date)))
2999          (month (int-to-string month))
3000          (year (int-to-string (extract-calendar-year date))))
3001     (mapconcat 'eval calendar-date-display-form "")))
3002
3003 (defun calendar-dayname-on-or-before (dayname date)
3004   "Return the absolute date of the DAYNAME on or before absolute DATE.
3005 DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
3006
3007 Note: Applying this function to d+6 gives us the DAYNAME on or after an
3008 absolute day d.  Similarly, applying it to d+3 gives the DAYNAME nearest to
3009 absolute date d, applying it to d-1 gives the DAYNAME previous to absolute
3010 date d, and applying it to d+7 gives the DAYNAME following absolute date d."
3011   (- date (% (- date dayname) 7)))
3012
3013 (defun calendar-nth-named-absday (n dayname month year &optional day)
3014   "The absolute date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
3015 A DAYNAME of 0 means Sunday, 1 means Monday, and so on.  If N<0,
3016 return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
3017 If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
3018
3019 If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
3020   (if (> n 0)
3021       (+ (* 7 (1- n))
3022          (calendar-dayname-on-or-before
3023           dayname
3024           (+ 6 (calendar-absolute-from-gregorian
3025                 (list month (or day 1) year)))))
3026     (+ (* 7 (1+ n))
3027        (calendar-dayname-on-or-before
3028         dayname
3029         (calendar-absolute-from-gregorian
3030          (list month
3031                (or day (calendar-last-day-of-month month year))
3032                year))))))
3033
3034 (defun calendar-nth-named-day (n dayname month year &optional day)
3035   "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
3036 A DAYNAME of 0 means Sunday, 1 means Monday, and so on.  If N<0,
3037 return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
3038 If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
3039
3040 If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
3041   (calendar-gregorian-from-absolute
3042    (calendar-nth-named-absday n dayname month year day)))
3043
3044 (defun calendar-day-of-year-string (&optional date)
3045   "String of day number of year of Gregorian DATE.
3046 Defaults to today's date if DATE is not given."
3047   (let* ((d (or date (calendar-current-date)))
3048          (year (extract-calendar-year d))
3049          (day (calendar-day-number d))
3050          (days-remaining (- (calendar-day-number (list 12 31 year)) day)))
3051     (format "Day %d of %d; %d day%s remaining in the year"
3052             day year days-remaining (if (= days-remaining 1) "" "s"))))
3053
3054 (defun calendar-print-other-dates ()
3055   "Show dates on other calendars for date under the cursor."
3056   (interactive)
3057   (let* ((date (calendar-cursor-to-date t)))
3058     (save-excursion
3059       (set-buffer (get-buffer-create other-calendars-buffer))
3060       (setq buffer-read-only nil)
3061       (calendar-set-mode-line
3062        (concat (calendar-date-string date) " (Gregorian)"))
3063       (erase-buffer)
3064       (insert
3065        (mapconcat 'identity
3066                   (list (calendar-day-of-year-string date)
3067                         (format "ISO date: %s" (calendar-iso-date-string date))
3068                         (format "Julian date: %s"
3069                                 (calendar-julian-date-string date))
3070                         (format
3071                          "Astronomical (Julian) day number (at noon UTC): %s.0"
3072                          (calendar-astro-date-string date))
3073                         (format "Fixed (RD) date: %s"
3074                                 (calendar-absolute-from-gregorian date))
3075                         (format "Hebrew date (before sunset): %s"
3076                                 (calendar-hebrew-date-string date))
3077                         (format "Persian date: %s"
3078                                 (calendar-persian-date-string date))
3079                         (let ((i (calendar-islamic-date-string date)))
3080                           (if (not (string-equal i ""))
3081                               (format "Islamic date (before sunset): %s" i)))
3082                         (let ((b (calendar-bahai-date-string date)))
3083                           (if (not (string-equal b ""))
3084                               (format "Baha'i date (before sunset): %s" b)))
3085                         (format "Chinese date: %s"
3086                                 (calendar-chinese-date-string date))
3087                         (let ((c (calendar-coptic-date-string date)))
3088                           (if (not (string-equal c ""))
3089                               (format "Coptic date: %s" c)))
3090                         (let ((e (calendar-ethiopic-date-string date)))
3091                           (if (not (string-equal e ""))
3092                               (format "Ethiopic date: %s" e)))
3093                         (let ((f (calendar-french-date-string date)))
3094                           (if (not (string-equal f ""))
3095                               (format "French Revolutionary date: %s" f)))
3096                         (format "Mayan date: %s"
3097                                 (calendar-mayan-date-string date)))
3098                   "\n"))
3099       (goto-char (point-min))
3100       (set-buffer-modified-p nil)
3101       (setq buffer-read-only t)
3102       (display-buffer other-calendars-buffer))))
3103
3104 (defun calendar-print-day-of-year ()
3105   "Show day number in year/days remaining in year for date under the cursor."
3106   (interactive)
3107   (message (calendar-day-of-year-string (calendar-cursor-to-date t))))
3108
3109 (defun calendar-set-mode-line (str)
3110   "Set mode line to STR, centered, surrounded by dashes."
3111   (setq mode-line-format
3112         (calendar-string-spread
3113          (list str) ?-
3114          ;; As per doc of window-width, total visible mode-line length.
3115          (let ((edges (window-edges))) (- (nth 2 edges) (nth 0 edges))))))
3116
3117 (defun calendar-mod (m n)
3118   "Non-negative remainder of M/N with N instead of 0."
3119   (1+ (mod (1- m) n)))
3120
3121 (run-hooks 'calendar-load-hook)
3122
3123 (provide 'calendar)
3124
3125 ;;; Local variables:
3126 ;;; byte-compile-dynamic: t
3127 ;;; End:
3128
3129 ;;; arch-tag: 19c61596-c8fb-4c69-bcf1-7dd739919cd8
3130 ;;; calendar.el ends here