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