PageRenderTime 54ms CodeModel.GetById 14ms RepoModel.GetById 0ms app.codeStats 1ms

/lisp/calendar/calendar.el

http://github.com/davidswelt/aquamacs-emacs
Emacs Lisp | 2644 lines | 2070 code | 245 blank | 329 comment | 77 complexity | 349736d40172406872d0885f4066383b MD5 | raw file
Possible License(s): GPL-3.0, LGPL-2.0, GPL-2.0, AGPL-3.0

Large files files are truncated, but you can click here to view the full file

  1. ;;; calendar.el --- calendar functions
  2. ;; Copyright (C) 1988-1995, 1997, 2000-2016 Free Software Foundation,
  3. ;; Inc.
  4. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
  5. ;; Maintainer: Glenn Morris <rgm@gnu.org>
  6. ;; Keywords: calendar
  7. ;; Human-Keywords: calendar, Gregorian calendar, diary, holidays
  8. ;; This file is part of GNU Emacs.
  9. ;; GNU Emacs is free software: you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation, either version 3 of the License, or
  12. ;; (at your option) any later version.
  13. ;; GNU Emacs is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. ;; GNU General Public License for more details.
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  19. ;;; Commentary:
  20. ;; This collection of functions implements a calendar window. It
  21. ;; generates a calendar for the current month, together with the
  22. ;; previous and coming months, or for any other three-month period.
  23. ;; The calendar can be scrolled forward and backward in the window to
  24. ;; show months in the past or future; the cursor can move forward and
  25. ;; backward by days, weeks, or months, making it possible, for
  26. ;; instance, to jump to the date a specified number of days, weeks, or
  27. ;; months from the date under the cursor. The user can display a list
  28. ;; of holidays and other notable days for the period shown; the
  29. ;; notable days can be marked on the calendar, if desired. The user
  30. ;; can also specify that dates having corresponding diary entries (in
  31. ;; a file that the user specifies) be marked; the diary entries for
  32. ;; any date can be viewed in a separate window. The diary and the
  33. ;; notable days can be viewed independently of the calendar. Dates
  34. ;; can be translated from the (usual) Gregorian calendar to the day of
  35. ;; the year/days remaining in year, to the ISO commercial calendar, to
  36. ;; the Julian (old style) calendar, to the Hebrew calendar, to the
  37. ;; Islamic calendar, to the Baháí calendar, to the French
  38. ;; Revolutionary calendar, to the Mayan calendar, to the Chinese
  39. ;; calendar, to the Coptic calendar, to the Ethiopic calendar, and to
  40. ;; the astronomical (Julian) day number. Times of sunrise/sunset can
  41. ;; be displayed, as can the phases of the moon. Appointment
  42. ;; notification for diary entries is available. Calendar printing via
  43. ;; LaTeX is available.
  44. ;; The following files are part of the calendar/diary code:
  45. ;; appt.el Appointment notification
  46. ;; cal-bahai.el Baháí calendar
  47. ;; cal-china.el Chinese calendar
  48. ;; cal-coptic.el Coptic/Ethiopic calendars
  49. ;; cal-dst.el Daylight saving time rules
  50. ;; cal-french.el French revolutionary calendar
  51. ;; cal-hebrew.el Hebrew calendar
  52. ;; cal-html.el Calendars in HTML
  53. ;; cal-islam.el Islamic calendar
  54. ;; cal-iso.el ISO calendar
  55. ;; cal-julian.el Julian/astronomical calendars
  56. ;; cal-mayan.el Mayan calendars
  57. ;; cal-menu.el Menu support
  58. ;; cal-move.el Movement in the calendar
  59. ;; cal-persia.el Persian calendar
  60. ;; cal-tex.el Calendars in LaTeX
  61. ;; cal-x.el Dedicated frame functions
  62. ;; calendar.el This file
  63. ;; diary-lib.el Diary functions
  64. ;; holidays.el Holiday functions
  65. ;; lunar.el Phases of the moon
  66. ;; solar.el Sunrise/sunset, equinoxes/solstices
  67. ;; Technical details of all the calendrical calculations can be found in
  68. ;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
  69. ;; and Nachum Dershowitz, Cambridge University Press (2001).
  70. ;; An earlier version of the technical details appeared in
  71. ;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
  72. ;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
  73. ;; pages 899-928, and in ``Calendrical Calculations, Part II: Three Historical
  74. ;; Calendars'' by E. M. Reingold, N. Dershowitz, and S. M. Clamen,
  75. ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
  76. ;; pages 383-404.
  77. ;; Hard copies of these two papers can be obtained by sending email to
  78. ;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
  79. ;; the message BODY containing your mailing address (snail).
  80. ;; A note on free variables:
  81. ;; The calendar passes around a few dynamically bound variables, which
  82. ;; unfortunately have rather common names. They are meant to be
  83. ;; available for external functions, so the names can't be changed.
  84. ;; displayed-month, displayed-year: bound in calendar-generate, the
  85. ;; central month of the 3 month calendar window
  86. ;; original-date, number: bound in diary-list-entries, the arguments
  87. ;; with which that function was called.
  88. ;; date, entry: bound in diary-list-sexp-entries (qv)
  89. ;; Bound in diary-list-entries:
  90. ;; diary-entries-list: use in d-l, appt.el, and by diary-add-to-list
  91. ;; diary-saved-point: only used in diary-lib.el, passed to the display func
  92. ;; date-string: only used in diary-lib.el
  93. ;; list-only: don't modify the diary-buffer, just return a list of entries
  94. ;; file-glob-attrs: yuck
  95. ;;; Code:
  96. (load "cal-loaddefs" nil t)
  97. ;; Avoid recursive load of calendar when loading cal-menu. Yuck.
  98. (provide 'calendar)
  99. (require 'cal-menu)
  100. (defgroup calendar nil
  101. "Calendar and time management support."
  102. :prefix "calendar-"
  103. :group 'applications)
  104. (defgroup calendar-hooks nil
  105. "Calendar hooks."
  106. :prefix "calendar-"
  107. :group 'calendar)
  108. (defgroup calendar-faces nil
  109. "Calendar faces."
  110. :prefix "calendar-"
  111. :group 'calendar)
  112. (defcustom calendar-offset 0
  113. "The offset of the principal month from the center of the calendar window.
  114. 0 means the principal month is in the center (default), -1 means on the left,
  115. +1 means on the right. Larger (or smaller) values push the principal month off
  116. the screen."
  117. :type 'integer
  118. :group 'calendar)
  119. (defcustom calendar-setup nil
  120. "The frame setup of the calendar.
  121. The choices are: `one-frame' (calendar and diary together in one separate,
  122. dedicated frame); `two-frames' (calendar and diary in separate, dedicated
  123. frames); `calendar-only' (calendar in a separate, dedicated frame); with
  124. any other value the current frame is used. Using any of the first
  125. three options overrides the value of `calendar-view-diary-initially-flag'."
  126. :type '(choice
  127. (const :tag "calendar and diary in separate frame" one-frame)
  128. (const :tag "calendar and diary each in own frame" two-frames)
  129. (const :tag "calendar in separate frame" calendar-only)
  130. (const :tag "use current frame" nil))
  131. :group 'calendar)
  132. (defcustom calendar-minimum-window-height 8
  133. "Minimum height `calendar-generate-window' should use for calendar window."
  134. :type 'integer
  135. :version "22.1"
  136. :group 'calendar)
  137. ;; See discussion in bug#1806.
  138. (defcustom calendar-split-width-threshold nil
  139. "Value to use for `split-width-threshold' when creating a calendar.
  140. This only affects frames wider than the default value of
  141. `split-width-threshold'."
  142. :type '(choice (const nil)
  143. (integer))
  144. :version "23.2"
  145. :group 'calendar)
  146. (defcustom calendar-week-start-day 0
  147. "The day of the week on which a week in the calendar begins.
  148. 0 means Sunday (default), 1 means Monday, and so on.
  149. If you change this variable directly (without using customize)
  150. after starting `calendar', you should call `calendar-redraw' to
  151. update the calendar display to reflect the change, otherwise
  152. movement commands will not work correctly."
  153. :type 'integer
  154. ;; Change the initialize so that if you reload calendar.el, it will not
  155. ;; cause a redraw (which may fail, e.g. with "invalid byte-code in
  156. ;; calendar.elc" because of the "byte-compile-dynamic").
  157. :initialize 'custom-initialize-default
  158. :set (lambda (sym val)
  159. (set sym val)
  160. (calendar-redraw))
  161. :group 'calendar)
  162. (defcustom calendar-weekend-days '(0 6)
  163. "Days of the week considered weekend days.
  164. 0 means Sunday, 1 means Monday, and so on.
  165. Determines which day headers are fontified with
  166. `calendar-weekend-header'."
  167. :type '(repeat integer)
  168. :version "25.1"
  169. :group 'calendar)
  170. (defcustom calendar-view-diary-initially-flag nil
  171. "Non-nil means display current date's diary entries on entry to calendar.
  172. The diary is displayed in another window when the calendar is first displayed,
  173. if the current date is visible. The number of days of diary entries displayed
  174. is governed by the variable `diary-number-of-entries'. This variable can
  175. be overridden by the value of `calendar-setup'."
  176. :type 'boolean
  177. :group 'diary)
  178. ;; FIXME :set
  179. (defcustom calendar-mark-diary-entries-flag nil
  180. "Non-nil means mark dates with diary entries, in the calendar window.
  181. The marking symbol is specified by the variable `diary-entry-marker'."
  182. :type 'boolean
  183. :group 'diary)
  184. (defcustom calendar-remove-frame-by-deleting t
  185. "Determine how the calendar mode removes a frame no longer needed.
  186. If nil, make an icon of the frame. If non-nil, delete the frame."
  187. :type 'boolean
  188. :version "23.1" ; changed from nil to t
  189. :group 'view
  190. :group 'calendar)
  191. (defface calendar-today
  192. '((t (:underline t)))
  193. "Face for indicating today's date in the calendar.
  194. See the variable `calendar-today-marker'."
  195. :group 'calendar-faces)
  196. (defface diary
  197. '((((min-colors 88) (class color) (background light))
  198. :foreground "red1")
  199. (((class color) (background light))
  200. :foreground "red")
  201. (((min-colors 88) (class color) (background dark))
  202. :foreground "yellow1")
  203. (((class color) (background dark))
  204. :foreground "yellow")
  205. (t
  206. :weight bold))
  207. "Face for highlighting diary entries.
  208. Used to mark diary entries in the calendar (see `diary-entry-marker'),
  209. and to highlight the date header in the fancy diary."
  210. :group 'calendar-faces)
  211. (defface holiday
  212. '((((class color) (background light))
  213. :background "pink")
  214. (((class color) (background dark))
  215. :background "chocolate4")
  216. (t
  217. :inverse-video t))
  218. "Face for indicating in the calendar dates that have holidays.
  219. See `calendar-holiday-marker'."
  220. :group 'calendar-faces)
  221. (defface calendar-weekday-header '((t :inherit font-lock-constant-face))
  222. "Face used for weekday column headers in the calendar.
  223. See also the face `calendar-weekend-header'."
  224. :version "24.4"
  225. :group 'calendar-faces)
  226. (defface calendar-weekend-header '((t :inherit font-lock-comment-face))
  227. "Face used for weekend column headers in the calendar.
  228. See also the face `calendar-weekday-header'."
  229. :version "24.4"
  230. :group 'calendar-faces)
  231. (defface calendar-month-header '((t :inherit font-lock-function-name-face))
  232. "Face used for month headers in the calendar."
  233. :version "24.4"
  234. :group 'calendar-faces)
  235. ;; These briefly checked font-lock-mode, but that is broken, since it
  236. ;; is a buffer-local variable, and which buffer happens to be current
  237. ;; when this file is loaded shouldn't make a difference. One could
  238. ;; perhaps check global-font-lock-mode, or font-lock-global-modes; but
  239. ;; this feature doesn't use font-lock, so there's no real reason it
  240. ;; should respect those either. See bug#2199.
  241. ;; They also used to check display-color-p, but that is a problem if
  242. ;; loaded from --daemon. Since BW displays are rare now, this was
  243. ;; also taken out. The way to keep it would be to have nil mean do a
  244. ;; runtime check whenever this variable is used.
  245. (defcustom diary-entry-marker 'diary
  246. "How to mark dates that have diary entries.
  247. The value can be either a single-character string (e.g. \"+\") or a face."
  248. :type '(choice (string :tag "Single character string") face)
  249. :group 'diary
  250. :version "23.1")
  251. (defcustom calendar-today-marker 'calendar-today
  252. "How to mark today's date in the calendar.
  253. The value can be either a single-character string (e.g. \"=\") or a face.
  254. Used by `calendar-mark-today'."
  255. :type '(choice (string :tag "Single character string") face)
  256. :group 'calendar
  257. :version "23.1")
  258. (defcustom calendar-holiday-marker 'holiday
  259. "How to mark notable dates in the calendar.
  260. The value can be either a single-character string (e.g. \"*\") or a face."
  261. :type '(choice (string :tag "Single character string") face)
  262. :group 'holidays
  263. :version "23.1")
  264. (defcustom calendar-view-holidays-initially-flag nil
  265. "Non-nil means display holidays for current three month period on entry.
  266. The holidays are displayed in another window when the calendar is first
  267. displayed."
  268. :type 'boolean
  269. :group 'holidays)
  270. ;; FIXME :set
  271. (defcustom calendar-mark-holidays-flag nil
  272. "Non-nil means mark dates of holidays in the calendar window.
  273. The marking symbol is specified by the variable `calendar-holiday-marker'."
  274. :type 'boolean
  275. :group 'holidays)
  276. (defcustom calendar-mode-hook nil
  277. "Hook run when entering `calendar-mode'."
  278. :type 'hook
  279. :group 'calendar-hooks)
  280. (defcustom calendar-load-hook nil
  281. "List of functions to be called after the calendar is first loaded.
  282. This is the place to add key bindings to `calendar-mode-map'."
  283. :type 'hook
  284. :group 'calendar-hooks)
  285. (defcustom calendar-initial-window-hook nil
  286. "List of functions to be called when the calendar window is created.
  287. Quitting the calendar and re-entering it will cause these functions
  288. to be called again."
  289. :type 'hook
  290. :group 'calendar-hooks)
  291. (defcustom calendar-today-visible-hook nil
  292. "List of functions called whenever the current date is visible.
  293. To mark today's date, add the function `calendar-mark-today'.
  294. To replace the date with asterisks, add the function `calendar-star-date'.
  295. See also `calendar-today-invisible-hook'.
  296. In general, be careful about changing characters in the calendar buffer,
  297. since it may cause the movement commands to fail."
  298. :type 'hook
  299. :options '(calendar-mark-today calendar-star-date)
  300. :group 'calendar-hooks)
  301. (defcustom calendar-today-invisible-hook nil
  302. "List of functions called whenever the current date is not visible.
  303. See also `calendar-today-visible-hook'."
  304. :type 'hook
  305. :group 'calendar-hooks)
  306. (defcustom calendar-move-hook nil
  307. "List of functions called whenever the cursor moves in the calendar.
  308. For example,
  309. (add-hook \\='calendar-move-hook (lambda () (diary-view-entries 1)))
  310. redisplays the diary for whatever date the cursor is moved to."
  311. :type 'hook
  312. :options '(calendar-update-mode-line)
  313. :group 'calendar-hooks)
  314. (defcustom calendar-date-echo-text
  315. "mouse-2: general menu\nmouse-3: menu for this date"
  316. "String displayed when the cursor is over a date in the calendar.
  317. Can be either a fixed string, or a lisp expression that returns one.
  318. When this expression is evaluated, DAY, MONTH, and YEAR are
  319. integers appropriate to the relevant date. For example, to
  320. display the ISO date:
  321. (setq calendar-date-echo-text \\='(format \"ISO date: %s\"
  322. (calendar-iso-date-string
  323. (list month day year))))
  324. Changing this variable without using customize has no effect on
  325. pre-existing calendar windows."
  326. :group 'calendar
  327. :initialize 'custom-initialize-default
  328. :risky t
  329. :set (lambda (sym val)
  330. (set sym val)
  331. (calendar-redraw))
  332. :type '(choice (string :tag "Fixed string")
  333. (sexp :value
  334. (format "ISO date: %s"
  335. (calendar-iso-date-string
  336. (list month day year)))))
  337. :version "23.1")
  338. (defvar calendar-month-digit-width nil
  339. "Width of the region with numbers in each month in the calendar.")
  340. (defvar calendar-month-width nil
  341. "Full width of each month in the calendar.")
  342. (defvar calendar-right-margin nil
  343. "Right margin of the calendar.")
  344. (defvar calendar-month-edges nil
  345. "Alist of month edge columns.
  346. Each element has the form (N LEFT FIRST LAST RIGHT), where
  347. LEFT is the leftmost column associated with month segment N,
  348. FIRST and LAST are the first and last columns with day digits in,
  349. and LAST is the rightmost column.")
  350. (defun calendar-month-edges (segment)
  351. "Compute the month edge columns for month SEGMENT.
  352. Returns a list (LEFT FIRST LAST RIGHT), where LEFT is the
  353. leftmost column associated with a month, FIRST and LAST are the
  354. first and last columns with day digits in, and LAST is the
  355. rightmost column."
  356. ;; The leftmost column with a digit in it in this month segment.
  357. (let* ((first (+ calendar-left-margin
  358. (* segment calendar-month-width)))
  359. ;; The rightmost column with a digit in it in this month segment.
  360. (last (+ first (1- calendar-month-digit-width)))
  361. (left (if (eq segment 0)
  362. 0
  363. (+ calendar-left-margin
  364. (* segment calendar-month-width)
  365. (- (/ calendar-intermonth-spacing 2)))))
  366. ;; The rightmost edge of this month segment, dividing the
  367. ;; space between months in two.
  368. (right (+ calendar-left-margin
  369. (* (1+ segment) calendar-month-width)
  370. (- (/ calendar-intermonth-spacing 2)))))
  371. (list left first last right)))
  372. (defun calendar-recompute-layout-variables ()
  373. "Recompute some layout-related calendar \"constants\"."
  374. (setq calendar-month-digit-width (+ (* 6 calendar-column-width)
  375. calendar-day-digit-width)
  376. calendar-month-width (+ (* 7 calendar-column-width)
  377. calendar-intermonth-spacing)
  378. calendar-right-margin (+ calendar-left-margin
  379. (* 3 (* 7 calendar-column-width))
  380. (* 2 calendar-intermonth-spacing))
  381. calendar-month-edges nil)
  382. (dotimes (i 3)
  383. (push (cons i (calendar-month-edges i)) calendar-month-edges))
  384. (setq calendar-month-edges (reverse calendar-month-edges)))
  385. (defun calendar-set-layout-variable (symbol value &optional minmax)
  386. "Set SYMBOL's value to VALUE, an integer.
  387. A positive/negative MINMAX enforces a minimum/maximum value.
  388. Then redraw the calendar, if necessary."
  389. (let ((oldvalue (symbol-value symbol)))
  390. (custom-set-default symbol (if minmax
  391. (if (< minmax 0)
  392. (min value (- minmax))
  393. (max value minmax))
  394. value))
  395. (unless (equal value oldvalue)
  396. (calendar-recompute-layout-variables)
  397. (calendar-redraw))))
  398. (defcustom calendar-left-margin 5
  399. "Empty space to the left of the first month in the calendar."
  400. :group 'calendar
  401. :initialize 'custom-initialize-default
  402. :set 'calendar-set-layout-variable
  403. :type 'integer
  404. :version "23.1")
  405. ;; Or you can view it as columns of width 2, with 1 space, no space
  406. ;; after the last column, and a 5 space gap between month.
  407. ;; FIXME check things work if this is odd.
  408. (defcustom calendar-intermonth-spacing 4
  409. "Space between months in the calendar. Minimum value is 1."
  410. :group 'calendar
  411. :initialize 'custom-initialize-default
  412. :set (lambda (sym val)
  413. (calendar-set-layout-variable sym val 1))
  414. :type 'integer
  415. :version "23.1")
  416. ;; FIXME calendar-month-column-width?
  417. (defcustom calendar-column-width 3
  418. "Width of each day column in the calendar. Minimum value is 3."
  419. :initialize 'custom-initialize-default
  420. :set (lambda (sym val)
  421. (calendar-set-layout-variable sym val 3))
  422. :type 'integer
  423. :version "23.1")
  424. (defun calendar-day-header-construct (&optional width)
  425. "Return the default value for `calendar-day-header-array'.
  426. WIDTH defaults to `calendar-day-header-width'."
  427. (or width (setq width calendar-day-header-width))
  428. (calendar-abbrev-construct (if (<= width calendar-abbrev-length)
  429. calendar-day-abbrev-array
  430. calendar-day-name-array)
  431. width))
  432. ;; FIXME better to use a format spec?
  433. (defcustom calendar-day-header-width 2
  434. "Width of the day column headers in the calendar.
  435. Must be at least one less than `calendar-column-width'."
  436. :group 'calendar
  437. :initialize 'custom-initialize-default
  438. :set (lambda (sym val)
  439. (or (calendar-customized-p 'calendar-day-header-array)
  440. (setq calendar-day-header-array
  441. (calendar-day-header-construct val)))
  442. (calendar-set-layout-variable sym val (- 1 calendar-column-width)))
  443. :type 'integer
  444. :version "23.1")
  445. ;; FIXME a format specifier instead?
  446. (defcustom calendar-day-digit-width 2
  447. "Width of the day digits in the calendar. Minimum value is 2."
  448. :group 'calendar
  449. :initialize 'custom-initialize-default
  450. :set (lambda (sym val)
  451. (calendar-set-layout-variable sym val 2))
  452. :type 'integer
  453. :version "23.1")
  454. (defcustom calendar-intermonth-header nil
  455. "Header text to display in the space to the left of each calendar month.
  456. See `calendar-intermonth-text'."
  457. :group 'calendar
  458. :initialize 'custom-initialize-default
  459. :risky t
  460. :set (lambda (sym val)
  461. (set sym val)
  462. (calendar-redraw))
  463. :type '(choice (const nil :tag "Nothing")
  464. (string :tag "Fixed string")
  465. (sexp :value
  466. (propertize "WK" 'font-lock-face
  467. 'font-lock-function-name-face)))
  468. :version "23.1")
  469. (defcustom calendar-intermonth-text nil
  470. "Text to display in the space to the left of each calendar month.
  471. Can be nil, a fixed string, or a lisp expression that returns a string.
  472. When the expression is evaluated, the variables DAY, MONTH and YEAR
  473. are integers appropriate for the first day in each week.
  474. Will be truncated to the smaller of `calendar-left-margin' and
  475. `calendar-intermonth-spacing'. The last character is forced to be a space.
  476. For example, to display the ISO week numbers:
  477. (setq calendar-week-start-day 1
  478. calendar-intermonth-text
  479. \\='(propertize
  480. (format \"%2d\"
  481. (car
  482. (calendar-iso-from-absolute
  483. (calendar-absolute-from-gregorian (list month day year)))))
  484. \\='font-lock-face \\='font-lock-function-name-face))
  485. See also `calendar-intermonth-header'."
  486. :group 'calendar
  487. :initialize 'custom-initialize-default
  488. :risky t
  489. :set (lambda (sym val)
  490. (set sym val)
  491. (calendar-redraw))
  492. :type '(choice (const nil :tag "Nothing")
  493. (string :tag "Fixed string")
  494. (sexp :value
  495. (propertize
  496. (format "%2d"
  497. (car
  498. (calendar-iso-from-absolute
  499. (calendar-absolute-from-gregorian
  500. (list month day year)))))
  501. 'font-lock-face 'font-lock-function-name-face)))
  502. :version "23.1")
  503. (defcustom diary-file (locate-user-emacs-file "diary" "diary")
  504. "Name of the file in which one's personal diary of dates is kept.
  505. The file's entries are lines beginning with any of the forms
  506. specified by the variable `diary-date-forms', which by default
  507. uses the forms of `diary-american-date-forms':
  508. MONTH/DAY
  509. MONTH/DAY/YEAR
  510. MONTHNAME DAY
  511. MONTHNAME DAY, YEAR
  512. DAYNAME
  513. with the remainder of the line being the diary entry string for
  514. that date. MONTH and DAY are one or two digit numbers, YEAR is a
  515. number and may be written in full or abbreviated to the final two
  516. digits (if `diary-abbreviated-year-flag' is non-nil). MONTHNAME
  517. and DAYNAME can be spelled in full (as specified by the variables
  518. `calendar-month-name-array' and `calendar-day-name-array'), or
  519. abbreviated (as specified by `calendar-month-abbrev-array' and
  520. `calendar-day-abbrev-array') with or without a period. Case is
  521. ignored. Any of DAY, MONTH, or MONTHNAME, YEAR can be `*' which
  522. matches any day, month, or year, respectively. If the date does
  523. not contain a year, it is generic and applies to any year. A
  524. DAYNAME entry applies to the appropriate day of the week in every week.
  525. You can customize `diary-date-forms' to your preferred format.
  526. Three default styles are provided: `diary-american-date-forms',
  527. `diary-european-date-forms', and `diary-iso-date-forms'.
  528. You can choose between these by setting `calendar-date-style' in your
  529. init file, or by using `calendar-set-date-style' when in the calendar.
  530. A diary entry can be preceded by the character `diary-nonmarking-symbol'
  531. \(ordinarily `&') to make that entry nonmarking--that is, it will not be
  532. marked on dates in the calendar window but will appear in a diary window.
  533. Multiline diary entries are made by indenting lines after the first with
  534. either a TAB or one or more spaces.
  535. Lines not in one the above formats are ignored. Here are some sample diary
  536. entries (in the default American style):
  537. 12/22/1988 Twentieth wedding anniversary!!
  538. &1/1. Happy New Year!
  539. 10/22 Ruth's birthday.
  540. 21: Payday
  541. Tuesday--weekly meeting with grad students at 10am
  542. Supowit, Shen, Bitner, and Kapoor to attend.
  543. 1/13/89 Friday the thirteenth!!
  544. &thu 4pm squash game with Lloyd.
  545. mar 16 Dad's birthday
  546. April 15, 1989 Income tax due.
  547. &* 15 time cards due.
  548. If the first line of a diary entry consists only of the date or day name with
  549. no trailing blanks or punctuation, then that line is not displayed in the
  550. diary window; only the continuation lines is shown. For example, the
  551. single diary entry
  552. 02/11/1989
  553. Bill Blattner visits Princeton today
  554. 2pm Cognitive Studies Committee meeting
  555. 2:30-5:30 Lizzie at Lawrenceville for `Group Initiative'
  556. 4:00pm Jamie Tappenden
  557. 7:30pm Dinner at George and Ed's for Alan Ryan
  558. 7:30-10:00pm dance at Stewart Country Day School
  559. will appear in the diary window without the date line at the beginning. This
  560. facility allows the diary window to look neater, but can cause confusion if
  561. used with more than one day's entries displayed.
  562. Diary entries can be based on Lisp sexps. For example, the diary entry
  563. %%(diary-block 11 1 1990 11 10 1990) Vacation
  564. causes the diary entry \"Vacation\" to appear from November 1 through
  565. November 10, 1990. See the documentation for the function
  566. `diary-list-sexp-entries' for more details.
  567. Diary entries based on the Hebrew, the Islamic and/or the Baháí
  568. calendar are also possible, but because these are somewhat slow, they
  569. are ignored unless you set the `diary-nongregorian-listing-hook' and
  570. the `diary-nongregorian-marking-hook' appropriately. See the
  571. documentation of these hooks for details.
  572. Diary files can contain directives to include the contents of other files; for
  573. details, see the documentation for the variable `diary-list-entries-hook'."
  574. :version "25.1" ; ~/diary -> locate-user-emacs-file
  575. :type 'file
  576. :group 'diary)
  577. ;; FIXME do these have to be single characters?
  578. (defcustom diary-nonmarking-symbol "&"
  579. "Symbol indicating that a diary entry is not to be marked in the calendar."
  580. :type 'string
  581. :group 'diary)
  582. (defcustom diary-chinese-entry-symbol "C"
  583. "Symbol indicating a diary entry according to the Chinese calendar."
  584. :type 'string
  585. :group 'diary
  586. :version "25.1")
  587. (defcustom diary-hebrew-entry-symbol "H"
  588. "Symbol indicating a diary entry according to the Hebrew calendar."
  589. :type 'string
  590. :group 'diary)
  591. (defcustom diary-islamic-entry-symbol "I"
  592. "Symbol indicating a diary entry according to the Islamic calendar."
  593. :type 'string
  594. :group 'diary)
  595. (defcustom diary-bahai-entry-symbol "B"
  596. "Symbol indicating a diary entry according to the Bahá’í calendar."
  597. :type 'string
  598. :group 'diary)
  599. (defcustom calendar-date-style 'american
  600. "Your preferred style for writing dates.
  601. The options are:
  602. `american' - month/day/year
  603. `european' - day/month/year
  604. `iso' - year/month/day
  605. This affects how dates written in your diary are interpreted.
  606. It also affects date display, as well as those calendar and diary
  607. functions that take a date as an argument, e.g. `diary-date', by
  608. changing the order in which the arguments are interpreted.
  609. Setting this variable directly does not take effect (if the
  610. calendar package is already loaded). Rather, use either
  611. \\[customize] or the function `calendar-set-date-style'."
  612. :version "23.1"
  613. :type '(choice (const american :tag "Month/Day/Year")
  614. (const european :tag "Day/Month/Year")
  615. (const iso :tag "Year/Month/Day"))
  616. :initialize 'custom-initialize-default
  617. :set (lambda (symbol value)
  618. (calendar-set-date-style value))
  619. :group 'calendar)
  620. ;; Next three are provided to aid in setting diary-date-forms.
  621. ;; FIXME move to diary-lib?
  622. (defcustom diary-iso-date-forms
  623. '((month "[-/]" day "[^-/0-9]")
  624. (year "[-/]" month "[-/]" day "[^0-9]")
  625. ;; Cannot allow [-/] as separators here, since it would also match
  626. ;; the first element (bug#7377).
  627. (monthname " *" day "[^-0-9]")
  628. (year " *" monthname " *" day "[^0-9]")
  629. (dayname "\\W"))
  630. "List of pseudo-patterns describing the ISO style of dates.
  631. The defaults are: MONTH[-/]DAY; YEAR[-/]MONTH[-/]DAY; MONTHNAME DAY;
  632. YEAR MONTHNAME DAY; DAYNAME. Normally you should not customize this,
  633. but `diary-date-forms' (which see)."
  634. :version "23.3" ; bug#7377
  635. :type '(repeat (choice (cons :tag "Backup"
  636. :value (backup . nil)
  637. (const backup)
  638. (repeat (list :inline t :format "%v"
  639. (symbol :tag "Keyword")
  640. (choice symbol regexp))))
  641. (repeat (list :inline t :format "%v"
  642. (symbol :tag "Keyword")
  643. (choice symbol regexp)))))
  644. :group 'diary)
  645. (defcustom diary-american-date-forms
  646. '((month "/" day "[^/0-9]")
  647. (month "/" day "/" year "[^0-9]")
  648. (monthname " *" day "[^,0-9]")
  649. (monthname " *" day ", *" year "[^0-9]")
  650. (dayname "\\W"))
  651. "List of pseudo-patterns describing the American style of dates.
  652. The defaults are: MONTH/DAY; MONTH/DAY/YEAR; MONTHNAME DAY;
  653. MONTHNAME DAY, YEAR; DAYNAME. Normally you should not customize this,
  654. but `diary-date-forms' (which see)."
  655. :type '(repeat (choice (cons :tag "Backup"
  656. :value (backup . nil)
  657. (const backup)
  658. (repeat (list :inline t :format "%v"
  659. (symbol :tag "Keyword")
  660. (choice symbol regexp))))
  661. (repeat (list :inline t :format "%v"
  662. (symbol :tag "Keyword")
  663. (choice symbol regexp)))))
  664. :group 'diary)
  665. (defcustom diary-european-date-forms
  666. '((day "/" month "[^/0-9]")
  667. (day "/" month "/" year "[^0-9]")
  668. (backup day " *" monthname "\\W+\\<\\([^*0-9]\\|\\([0-9]+[:aApP]\\)\\)")
  669. (day " *" monthname " *" year "[^0-9]")
  670. (dayname "\\W"))
  671. "List of pseudo-patterns describing the European style of dates.
  672. The defaults are: DAY/MONTH; DAY/MONTH/YEAR; DAY MONTHNAME;
  673. DAY MONTHNAME YEAR; DAYNAME. Normally you should not customize this, but
  674. `diary-date-forms' (which see)."
  675. :type '(repeat (choice (cons :tag "Backup"
  676. :value (backup . nil)
  677. (const backup)
  678. (repeat (list :inline t :format "%v"
  679. (symbol :tag "Keyword")
  680. (choice symbol regexp))))
  681. (repeat (list :inline t :format "%v"
  682. (symbol :tag "Keyword")
  683. (choice symbol regexp)))))
  684. :group 'diary)
  685. (defvar diary-font-lock-keywords)
  686. (defcustom diary-date-forms (cond ((eq calendar-date-style 'iso)
  687. diary-iso-date-forms)
  688. ((eq calendar-date-style 'european)
  689. diary-european-date-forms)
  690. (t diary-american-date-forms))
  691. "List of pseudo-patterns describing the forms of date used in the diary.
  692. The patterns on the list must be MUTUALLY EXCLUSIVE and should not match
  693. any portion of the diary entry itself, just the date component.
  694. A pseudo-pattern is a list of regular expressions and the keywords `month',
  695. `day', `year', `monthname', and `dayname'. The keyword `monthname' will
  696. match the name of the month (see `calendar-month-name-array'), capitalized
  697. or not, or its user-specified abbreviation (see `calendar-month-abbrev-array'),
  698. followed by a period or not; it will also match `*'. Similarly, `dayname'
  699. will match the name of the day (see `calendar-day-name-array'), capitalized or
  700. not, or its user-specified abbreviation (see `calendar-day-abbrev-array'),
  701. followed by a period or not. The keywords `month', `day', and `year' will
  702. match those numerical values, preceded by arbitrarily many zeros; they will
  703. also match `*'.
  704. The matching of the diary entries with the date forms is done with the
  705. standard syntax table from Fundamental mode, but with the `*' changed so
  706. that it is a word constituent.
  707. If, to be mutually exclusive, a pseudo-pattern must match a portion of the
  708. diary entry itself, the first element of the pattern MUST be `backup'. This
  709. directive causes the date recognizer to back up to the beginning of the
  710. current word of the diary entry, so in no case can the pattern match more than
  711. a portion of the first word of the diary entry.
  712. For examples of three common styles, see `diary-american-date-forms',
  713. `diary-european-date-forms', and `diary-iso-date-forms'."
  714. :type '(repeat (choice (cons :tag "Backup"
  715. :value (backup . nil)
  716. (const backup)
  717. (repeat (list :inline t :format "%v"
  718. (symbol :tag "Keyword")
  719. (choice symbol regexp))))
  720. (repeat (list :inline t :format "%v"
  721. (symbol :tag "Keyword")
  722. (choice symbol regexp)))))
  723. :set-after '(calendar-date-style diary-iso-date-forms
  724. diary-european-date-forms
  725. diary-american-date-forms)
  726. :initialize 'custom-initialize-default
  727. :set (lambda (symbol value)
  728. (unless (equal value (eval symbol))
  729. (custom-set-default symbol value)
  730. (setq diary-font-lock-keywords (diary-font-lock-keywords))
  731. ;; Need to redraw not just to get new font-locking, but also
  732. ;; to pick up any newly recognized entries.
  733. (and (diary-live-p)
  734. (diary))))
  735. :group 'diary)
  736. ;; Next three are provided to aid in setting calendar-date-display-form.
  737. (defcustom calendar-iso-date-display-form '((format "%s-%.2d-%.2d" year
  738. (string-to-number month)
  739. (string-to-number day)))
  740. "Pseudo-pattern governing the way a date appears in the ISO style.
  741. Normally you should not customize this, but `calendar-date-display-form'
  742. \(which see)."
  743. :type 'sexp
  744. :risky t
  745. :version "23.1"
  746. :group 'calendar)
  747. (defcustom calendar-european-date-display-form
  748. '((if dayname (concat dayname ", ")) day " " monthname " " year)
  749. "Pseudo-pattern governing the way a date appears in the European style.
  750. Normally you should not customize this, but `calendar-date-display-form'
  751. \(which see)."
  752. :type 'sexp
  753. :risky t
  754. :group 'calendar)
  755. (defcustom calendar-american-date-display-form
  756. '((if dayname (concat dayname ", ")) monthname " " day ", " year)
  757. "Pseudo-pattern governing the way a date appears in the American style.
  758. Normally you should not customize this, but `calendar-date-display-form'
  759. \(which see)."
  760. :type 'sexp
  761. :risky t
  762. :group 'calendar)
  763. (defcustom calendar-date-display-form
  764. (cond ((eq calendar-date-style 'iso)
  765. calendar-iso-date-display-form)
  766. ((eq calendar-date-style 'european)
  767. calendar-european-date-display-form)
  768. (t calendar-american-date-display-form))
  769. "Pseudo-pattern governing the way a calendar date appears.
  770. Used by the function `calendar-date-string' (which see), a pseudo-pattern
  771. is a list of expressions that can involve the keywords `month', `day',
  772. and `year' (all numbers in string form), and `monthname' and `dayname'
  773. \(both alphabetic strings). For example, a typical American form would be
  774. (month \"/\" day \"/\" (substring year -2))
  775. whereas
  776. ((format \"%9s, %9s %2s, %4s\" dayname monthname day year))
  777. would give the usual American style in fixed-length fields. The variables
  778. `calendar-iso-date-display-form', `calendar-european-date-display-form', and
  779. `calendar-american-date-display-form' provide some defaults for three common
  780. styles."
  781. :type 'sexp
  782. :risky t
  783. :set-after '(calendar-date-style calendar-iso-date-display-form
  784. calendar-european-date-display-form
  785. calendar-american-date-display-form)
  786. :group 'calendar)
  787. (defcustom calendar-american-month-header
  788. '(propertize (format "%s %d" (calendar-month-name month) year)
  789. 'font-lock-face 'calendar-month-header)
  790. "Default format for calendar month headings with the American date style.
  791. Normally you should not customize this, but `calender-month-header'."
  792. :group 'calendar
  793. :risky t
  794. :type 'sexp
  795. :version "24.4") ; font-lock-function-name-face -> calendar-month-header
  796. (defcustom calendar-european-month-header
  797. '(propertize (format "%s %d" (calendar-month-name month) year)
  798. 'font-lock-face 'calendar-month-header)
  799. "Default format for calendar month headings with the European date style.
  800. Normally you should not customize this, but `calender-month-header'."
  801. :group 'calendar
  802. :risky t
  803. :type 'sexp
  804. :version "24.4") ; font-lock-function-name-face -> calendar-month-header
  805. (defcustom calendar-iso-month-header
  806. '(propertize (format "%d %s" year (calendar-month-name month))
  807. 'font-lock-face 'calendar-month-header)
  808. "Default format for calendar month headings with the ISO date style.
  809. Normally you should not customize this, but `calender-month-header'."
  810. :group 'calendar
  811. :risky t
  812. :type 'sexp
  813. :version "24.4") ; font-lock-function-name-face -> calendar-month-header
  814. (defcustom calendar-month-header
  815. (cond ((eq calendar-date-style 'iso)
  816. calendar-iso-month-header)
  817. ((eq calendar-date-style 'european)
  818. calendar-european-month-header)
  819. (t calendar-american-month-header))
  820. "Expression to evaluate to return the calendar month headings.
  821. When this expression is evaluated, the variables MONTH and YEAR are
  822. integers appropriate to the relevant month. The result is padded
  823. to the width of `calendar-month-digit-width'.
  824. For examples of three common styles, see `calendar-american-month-header',
  825. `calendar-european-month-header', and `calendar-iso-month-header'.
  826. Changing this variable without using customize has no effect on
  827. pre-existing calendar windows."
  828. :group 'calendar
  829. :initialize 'custom-initialize-default
  830. :risky t
  831. :set (lambda (sym val)
  832. (set sym val)
  833. (calendar-redraw))
  834. :set-after '(calendar-date-style calendar-american-month-header
  835. calendar-european-month-header
  836. calendar-iso-month-header)
  837. :type 'sexp
  838. :version "24.3")
  839. (defun calendar-set-date-style (style)
  840. "Set the style of calendar and diary dates to STYLE (a symbol).
  841. The valid styles are described in the documentation of `calendar-date-style'."
  842. (interactive (list (intern
  843. (completing-read "Date style: "
  844. '("american" "european" "iso") nil t
  845. nil nil "american"))))
  846. (or (memq style '(american european iso))
  847. (setq style 'american))
  848. (setq calendar-date-style style
  849. calendar-date-display-form
  850. (symbol-value (intern-soft
  851. (format "calendar-%s-date-display-form" style)))
  852. calendar-month-header
  853. (symbol-value (intern-soft (format "calendar-%s-month-header" style)))
  854. diary-date-forms
  855. (symbol-value (intern-soft (format "diary-%s-date-forms" style))))
  856. (calendar-redraw)
  857. (calendar-update-mode-line))
  858. (defcustom diary-show-holidays-flag t
  859. "Non-nil means include holidays in the diary display.
  860. The holidays appear in the mode line of the diary buffer, or in the
  861. fancy diary buffer next to the date. This slows down the diary functions
  862. somewhat; setting it to nil makes the diary display faster."
  863. :type 'boolean
  864. :group 'holidays)
  865. (defcustom calendar-debug-sexp nil
  866. "Turn debugging on when evaluating a sexp in the diary or holiday list."
  867. :type 'boolean
  868. :group 'calendar)
  869. (defcustom calendar-hebrew-all-holidays-flag nil
  870. "If nil, show only major holidays from the Hebrew calendar.
  871. This means only those Jewish holidays that appear on secular calendars.
  872. Otherwise, show all the holidays that would appear in a complete Hebrew
  873. calendar."
  874. :type 'boolean
  875. :group 'holidays)
  876. (defcustom calendar-christian-all-holidays-flag nil
  877. "If nil, show only major holidays from the Christian calendar.
  878. This means only those Christian holidays that appear on secular calendars.
  879. Otherwise, show all the holidays that would appear in a complete Christian
  880. calendar."
  881. :type 'boolean
  882. :group 'holidays)
  883. (defcustom calendar-islamic-all-holidays-flag nil
  884. "If nil, show only major holidays from the Islamic calendar.
  885. This means only those Islamic holidays that appear on secular calendars.
  886. Otherwise, show all the holidays that would appear in a complete Islamic
  887. calendar."
  888. :type 'boolean
  889. :group 'holidays)
  890. (defcustom calendar-bahai-all-holidays-flag nil
  891. "If nil, show only major holidays from the Bahá’í calendar.
  892. These are the days on which work and school must be suspended.
  893. Otherwise, show all the holidays that would appear in a complete Bahá’í
  894. calendar."
  895. :type 'boolean
  896. :group 'holidays)
  897. (defcustom calendar-chinese-all-holidays-flag nil
  898. "If nil, show only the major holidays from the Chinese calendar."
  899. :version "23.1"
  900. :type 'boolean
  901. :group 'holidays)
  902. ;;; End of user options.
  903. (calendar-recompute-layout-variables)
  904. (defconst calendar-first-date-row 3
  905. "First row in the calendar with actual dates.")
  906. (defconst calendar-buffer "*Calendar*"
  907. "Name of the buffer used for the calendar.")
  908. (defconst holiday-buffer "*Holidays*"
  909. "Name of the buffer used for the displaying the holidays.")
  910. (defconst diary-fancy-buffer "*Fancy Diary Entries*"
  911. "Name of the buffer used for the optional fancy display of the diary.")
  912. (defconst calendar-other-calendars-buffer "*Other Calendars*"
  913. "Name of the buffer used for the display of date on other calendars.")
  914. (defconst lunar-phases-buffer "*Phases of Moon*"
  915. "Name of the buffer used for the lunar phases.")
  916. (defconst solar-sunrises-buffer "*Sunrise/Sunset Times*"
  917. "Name of buffer used for sunrise/sunset times.")
  918. (defconst calendar-hebrew-yahrzeit-buffer "*Yahrzeits*"
  919. "Name of the buffer used by `list-yahrzeit-dates'.")
  920. (defmacro calendar-increment-month (mon yr n &optional nmonths)
  921. "Increment the variables MON and YR by N months.
  922. Forward if N is positive or backward if N is negative.
  923. A negative YR is interpreted as BC; -1 being 1 BC, and so on.
  924. Optional NMONTHS is the number of months per year (default 12)."
  925. ;; Can view this as a form of base-nmonths arithmetic, in which "a
  926. ;; year" = "ten", and we never bother to use hundreds.
  927. `(let ((nmonths (or ,nmonths 12))
  928. macro-y)
  929. (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc
  930. (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n)
  931. ,mon (1+ (mod macro-y nmonths))
  932. ,yr (/ macro-y nmonths))
  933. ;; Alternative:
  934. ;;; (setq macro-y (+ (* ,yr nmonths) ,mon -1 ,n)
  935. ;;; ,yr (/ macro-y nmonths)
  936. ;;; ,mon (- macro-y (* ,yr nmonths)))
  937. (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
  938. (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
  939. (defvar displayed-month)
  940. (defvar displayed-year)
  941. (defun calendar-increment-month-cons (n &optional mon yr)
  942. "Return the Nth month after MON/YR.
  943. The return value is a pair (MONTH . YEAR).
  944. MON defaults to `displayed-month'. YR defaults to `displayed-year'."
  945. (unless mon (setq mon displayed-month))
  946. (unless yr (setq yr displayed-year))
  947. (calendar-increment-month mon yr n)
  948. (cons mon yr))
  949. (defmacro calendar-sum (index initial condition expression)
  950. "For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION."
  951. (declare (debug (symbolp form form form)))
  952. `(let ((,index ,initial)
  953. (sum 0))
  954. (while ,condition
  955. (setq sum (+ sum ,expression)
  956. ,index (1+ ,index)))
  957. sum))
  958. (defmacro calendar-in-read-only-buffer (buffer &rest body)
  959. "Switch to BUFFER and execute the forms in BODY.
  960. First creates or erases BUFFER as needed. Leaves BUFFER read-only,
  961. with disabled undo. Leaves point at point-min, displays BUFFER."
  962. (declare (indent 1) (debug t))
  963. `(progn
  964. (set-buffer (get-buffer-create ,buffer))
  965. (or (derived-mode-p 'special-mode) (special-mode))
  966. (setq buffer-read-only nil
  967. buffer-undo-list t)
  968. (erase-buffer)
  969. (display-buffer ,buffer)
  970. ,@body
  971. (goto-char (point-min))
  972. (set-buffer-modified-p nil)
  973. (setq buffer-read-only t)))
  974. ;; The following are in-line for speed; they can be called thousands of times
  975. ;; when looking up holidays or processing the diary. Here, for example, are
  976. ;; the numbers of calls to calendar/diary/holiday functions in preparing the
  977. ;; fancy diary display, for a moderately complex diary file, with functions
  978. ;; used instead of macros. There were a total of 10000 such calls:
  979. ;;
  980. ;; 1934 calendar-extract-month
  981. ;; 1852 calendar-extract-year
  982. ;; 1819 calendar-extract-day
  983. ;; 845 calendar-leap-year-p
  984. ;; 837 calendar-day-number
  985. ;; 775 calendar-absolute-from-gregorian
  986. ;; 346 calendar-last-day-of-month
  987. ;; 286 calendar-hebrew-last-day-of-month
  988. ;; 188 calendar-hebrew-leap-year-p
  989. ;; 180 calendar-hebrew-elapsed-days
  990. ;; 163 calendar-hebrew-last-month-of-year
  991. ;; 66 calendar-date-compare
  992. ;; 65 calendar-hebrew-days-in-year
  993. ;; 60 calendar-julian-to-absolute
  994. ;; 50 calendar-hebrew-to-absolute
  995. ;; 43 calendar-date-equal
  996. ;; 38 calendar-gregorian-from-absolute
  997. ;; .
  998. ;;
  999. ;; The use of these seven macros eliminates the overhead of 92% of the function
  1000. ;; calls; it's faster this way.
  1001. (defsubst calendar-extract-month (date)
  1002. "Extract the month part of DATE which has the form (month day year)."
  1003. (car date))
  1004. ;; Note gives wrong answer for result of (calendar-read-date 'noday),
  1005. ;; but that is only used by `calendar-other-month'.
  1006. (defsubst calendar-extract-day (date)
  1007. "Extract the day part of DATE which has the form (month day year)."
  1008. (cadr date))
  1009. (defsubst calendar-extract-year (date)
  1010. "Extract the year part of DATE which has the form (month day year)."
  1011. (nth 2 date))
  1012. (defsubst calendar-leap-year-p (year)
  1013. "Return t if YEAR is a Gregorian leap year.
  1014. A negative year is interpreted as BC; -1 being 1 BC, and so on."
  1015. ;; 1 BC = 0 AD, 2 BC acts like 1 AD, etc.
  1016. (if (< year 0) (setq year (1- (abs year))))
  1017. (and (zerop (% year 4))
  1018. (or (not (zerop (% year 100)))
  1019. (zerop (% year 400)))))
  1020. ;; The foregoing is a bit faster, but not as clear as the following:
  1021. ;;
  1022. ;;(defsubst calendar-leap-year-p (year)
  1023. ;; "Return t if YEAR is a Gregorian leap year."
  1024. ;; (or
  1025. ;; (and (zerop (% year 4))
  1026. ;; (not (zerop (% year 100))))
  1027. ;; (zerop (% year 400)))
  1028. (defsubst calendar-last-day-of-month (month year)
  1029. "The last day in MONTH during YEAR."
  1030. (if (and (= month 2) (calendar-leap-year-p year))
  1031. 29
  1032. (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
  1033. ;; An explanation of the calculation can be found in PascAlgorithms by
  1034. ;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
  1035. (defsubst calendar-day-number (date)
  1036. "Return the day number within the year of the date DATE.
  1037. For example, (calendar-day-number \\='(1 1 1987)) returns the value 1,
  1038. while (calendar-day-number \\='(12 31 1980)) returns 366."
  1039. (let* ((month (calendar-extract-month date))
  1040. (day (calendar-extract-day date))
  1041. (year (calendar-extract-year date))
  1042. (day-of-year (+ day (* 31 (1- month)))))
  1043. (when (> month 2)
  1044. (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
  1045. (if (calendar-leap-year-p year)
  1046. (setq day-of-year (1+ day-of-year))))
  1047. day-of-year))
  1048. (defsubst calendar-absolute-from-gregorian (date)
  1049. "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
  1050. The Gregorian date Sunday, December 31, 1 BC is imaginary.
  1051. DATE is a list of the form (month day year). A negative year is
  1052. interpreted as BC; -1 being 1 BC, and so on. Dates before 12/31/1 BC
  1053. return negative results."
  1054. (let ((year (calendar-extract-year date))
  1055. offset-years)
  1056. (cond ((zerop year)
  1057. (user-error "There was no year zero"))
  1058. ((> year 0)
  1059. (setq offset-years (1- year))
  1060. (+ (calendar-day-number date) ; days this year
  1061. (* 365 offset-years) ; + days in prior years
  1062. (/ offset-years 4) ; + Julian leap years
  1063. (- (/ offset-ye…

Large files files are truncated, but you can click here to view the full file