HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Replace `string-to-int' by `string-to-number'.
[bpt/emacs.git] / lisp / calendar / diary-lib.el
CommitLineData
3afbc435 1;;; diary-lib.el --- diary functions
0808d911 2
a46c339d 3;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2003, 2004, 2005
c87a1f38 4;; Free Software Foundation, Inc.
0808d911
ER		 5
6;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
ba55e59f 7;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
0808d911
ER		 8;; Keywords: calendar
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
b578f267
EN		 23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
0808d911
ER		 26
27;;; Commentary:
28
29;; This collection of functions implements the diary features as described
30;; in calendar.el.
31
32;; Comments, corrections, and improvements should be sent to
33;; Edward M. Reingold Department of Computer Science
34;; (217) 333-6733 University of Illinois at Urbana-Champaign
35;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
36;; Urbana, Illinois 61801
37
38;;; Code:
39
40(require 'calendar)
41
c87a1f38
GM		 42(defun diary-check-diary-file ()
43 "Check that the file specified by `diary-file' exists and is readable.
44If so, return the expanded file name, otherwise signal an error."
45 (let ((d-file (substitute-in-file-name diary-file)))
46 (if (and d-file (file-exists-p d-file))
47 (if (file-readable-p d-file)
48 d-file
49 (error "Diary file `%s' is not readable" diary-file))
50 (error "Diary file `%s' does not exist" diary-file))))
51
0808d911
ER		 52;;;###autoload
53(defun diary (&optional arg)
54 "Generate the diary window for ARG days starting with the current date.
55If no argument is provided, the number of days of diary entries is governed
6ecab45e
GM		 56by the variable `number-of-diary-entries'. A value of ARG less than 1
57does nothing. This function is suitable for execution in a `.emacs' file."
0808d911 58 (interactive "P")
c87a1f38
GM		 59 (diary-check-diary-file)
60 (let ((date (calendar-current-date)))
61 (list-diary-entries
62 date
63 (cond (arg (prefix-numeric-value arg))
64 ((vectorp number-of-diary-entries)
65 (aref number-of-diary-entries (calendar-day-of-week date)))
66 (t number-of-diary-entries)))))
0808d911
ER		 67
68(defun view-diary-entries (arg)
69 "Prepare and display a buffer with diary entries.
70Searches the file named in `diary-file' for entries that
71match ARG days starting with the date indicated by the cursor position
72in the displayed three-month calendar."
73 (interactive "p")
c87a1f38
GM		 74 (diary-check-diary-file)
75 (list-diary-entries (calendar-cursor-to-date t) arg))
0808d911 76
892e6825 77(defun view-other-diary-entries (arg d-file)
0808d911 78 "Prepare and display buffer of diary entries from an alternative diary file.
c87a1f38
GM		 79Searches for entries that match ARG days, starting with the date indicated
80by the cursor position in the displayed three-month calendar.
81D-FILE specifies the file to use as the diary file."
0808d911 82 (interactive
3b554221 83 (list (prefix-numeric-value current-prefix-arg)
892e6825
ER		 84 (read-file-name "Enter diary file name: " default-directory nil t)))
85 (let ((diary-file d-file))
86 (view-diary-entries arg)))
0808d911
ER		 87
88(autoload 'check-calendar-holidays "holidays"
89 "Check the list of holidays for any that occur on DATE.
90The value returned is a list of strings of relevant holiday descriptions.
fd4a98f0 91The holidays are those in the list `calendar-holidays'.")
0808d911
ER		 92
93(autoload 'calendar-holiday-list "holidays"
94 "Form the list of holidays that occur on dates in the calendar window.
fd4a98f0 95The holidays are those in the list `calendar-holidays'.")
0808d911
ER		 96
97(autoload 'diary-french-date "cal-french"
fd4a98f0 98 "French calendar equivalent of date diary entry.")
0808d911
ER		 99
100(autoload 'diary-mayan-date "cal-mayan"
fd4a98f0 101 "Mayan calendar equivalent of date diary entry.")
0808d911 102
c36baedb 103(autoload 'diary-iso-date "cal-iso"
fd4a98f0 104 "ISO calendar equivalent of date diary entry.")
c36baedb 105
0808d911 106(autoload 'diary-julian-date "cal-julian"
fd4a98f0 107 "Julian calendar equivalent of date diary entry.")
0808d911
ER		 108
109(autoload 'diary-astro-day-number "cal-julian"
fd4a98f0 110 "Astronomical (Julian) day number diary entry.")
0808d911 111
327b6868 112(autoload 'diary-chinese-date "cal-china"
fd4a98f0 113 "Chinese calendar equivalent of date diary entry.")
0808d911 114
327b6868 115(autoload 'diary-islamic-date "cal-islam"
fd4a98f0 116 "Islamic calendar equivalent of date diary entry.")
0808d911 117
327b6868 118(autoload 'list-islamic-diary-entries "cal-islam"
fd4a98f0 119 "Add any Islamic date entries from the diary file to `diary-entries-list'.")
0808d911 120
327b6868 121(autoload 'mark-islamic-diary-entries "cal-islam"
fd4a98f0 122 "Mark days in the calendar window that have Islamic date diary entries.")
0808d911 123
327b6868 124(autoload 'mark-islamic-calendar-date-pattern "cal-islam"
fd4a98f0 125 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.")
0808d911 126
811a8484
JW		 127(autoload 'diary-bahai-date "cal-bahai"
128 "Baha'i calendar equivalent of date diary entry."
129 t)
130
131(autoload 'list-bahai-diary-entries "cal-bahai"
132 "Add any Baha'i date entries from the diary file to `diary-entries-list'."
133 t)
134
135(autoload 'mark-bahai-diary-entries "cal-bahai"
136 "Mark days in the calendar window that have Baha'i date diary entries."
137 t)
138
139(autoload 'mark-bahai-calendar-date-pattern "cal-bahai"
140 "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR."
141 t)
142
0808d911 143(autoload 'diary-hebrew-date "cal-hebrew"
fd4a98f0 144 "Hebrew calendar equivalent of date diary entry.")
0808d911
ER		 145
146(autoload 'diary-omer "cal-hebrew"
fd4a98f0 147 "Omer count diary entry.")
0808d911
ER		 148
149(autoload 'diary-yahrzeit "cal-hebrew"
fd4a98f0 150 "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.")
0808d911
ER		 151
152(autoload 'diary-parasha "cal-hebrew"
fd4a98f0 153 "Parasha diary entry--entry applies if date is a Saturday.")
0808d911
ER		 154
155(autoload 'diary-rosh-hodesh "cal-hebrew"
fd4a98f0 156 "Rosh Hodesh diary entry.")
0808d911
ER		 157
158(autoload 'list-hebrew-diary-entries "cal-hebrew"
fd4a98f0 159 "Add any Hebrew date entries from the diary file to `diary-entries-list'.")
0808d911
ER		 160
161(autoload 'mark-hebrew-diary-entries "cal-hebrew"
fd4a98f0 162 "Mark days in the calendar window that have Hebrew date diary entries.")
0808d911
ER		 163
164(autoload 'mark-hebrew-calendar-date-pattern "cal-hebrew"
fd4a98f0 165 "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.")
0808d911
ER		 166
167(autoload 'diary-coptic-date "cal-coptic"
fd4a98f0 168 "Coptic calendar equivalent of date diary entry.")
0808d911
ER		 169
170(autoload 'diary-ethiopic-date "cal-coptic"
fd4a98f0 171 "Ethiopic calendar equivalent of date diary entry.")
0808d911 172
a45eee72 173(autoload 'diary-persian-date "cal-persia"
fd4a98f0 174 "Persian calendar equivalent of date diary entry.")
72fb78ce 175
fd4a98f0 176(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry.")
0808d911
ER		 177
178(autoload 'diary-sunrise-sunset "solar"
fd4a98f0 179 "Local time of sunrise and sunset as a diary entry.")
0808d911
ER		 180
181(autoload 'diary-sabbath-candles "solar"
182 "Local time of candle lighting diary entry--applies if date is a Friday.
fd4a98f0 183No diary entry if there is no sunset on that date.")
0808d911
ER		 184
185(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table))
186 "The syntax table used when parsing dates in the diary file.
187It is the standard syntax table used in Fundamental mode, but with the
c87a1f38 188syntax of `*' and `:' changed to be word constituents.")
0808d911
ER		 189
190(modify-syntax-entry ?* "w" diary-syntax-table)
cfd1d0ec 191(modify-syntax-entry ?: "w" diary-syntax-table)
0808d911 192
ee58da1b
SS		 193(defvar diary-entries-list)
194(defvar displayed-year)
195(defvar displayed-month)
196(defvar entry)
197(defvar date)
198(defvar number)
199(defvar date-string)
ee58da1b
SS		 200(defvar original-date)
201
c47a201a 202(defun diary-attrtype-convert (attrvalue type)
c87a1f38
GM		 203 "Convert string ATTRVALUE to TYPE appropriate for a face description.
204Valid TYPEs are: string, symbol, int, stringtnil, tnil."
c47a201a
JB		 205 (let (ret)
206 (setq ret (cond ((eq type 'string) attrvalue)
207 ((eq type 'symbol) (read attrvalue))
027a4b6b 208 ((eq type 'int) (string-to-number attrvalue))
c47a201a
JB		 209 ((eq type 'stringtnil)
210 (cond ((string= "t" attrvalue) t)
211 ((string= "nil" attrvalue) nil)
212 (t attrvalue)))
213 ((eq type 'tnil)
214 (cond ((string= "t" attrvalue) t)
215 ((string= "nil" attrvalue) nil)))))
216; (message "(%s)[%s]=[%s]" (print type) attrvalue ret)
217 ret))
4e80f517 218
c47a201a
JB		 219
220(defun diary-pull-attrs (entry fileglobattrs)
4e80f517
SS		 221 "Pull the face-related attributes off the entry, merge with the
222fileglobattrs, and return the (possibly modified) entry and face
223data in a list of attrname attrvalue values.
c47a201a 224The entry will be modified to drop all tags that are used for face matching.
4e80f517
SS		 225If entry is nil, then the fileglobattrs are being searched for,
226the fileglobattrs variable is ignored, and
227diary-glob-file-regexp-prefix is prepended to the regexps before each
c47a201a
JB		 228search."
229 (save-excursion
61d094de
GM		 230 (let (regexp regnum attrname attr-list attrname attrvalue type
231 ret-attr attr)
c47a201a
JB		 232 (if (null entry)
233 (progn
234 (setq ret-attr '()
235 attr-list diary-face-attrs)
236 (while attr-list
237 (goto-char (point-min))
238 (setq attr (car attr-list)
239 regexp (nth 0 attr)
240 regnum (nth 1 attr)
241 attrname (nth 2 attr)
242 type (nth 3 attr)
243 regexp (concat diary-glob-file-regexp-prefix regexp))
244 (setq attrvalue nil)
245 (if (re-search-forward regexp (point-max) t)
246 (setq attrvalue (buffer-substring-no-properties
247 (match-beginning regnum)
248 (match-end regnum))))
249 (if (and attrvalue
250 (setq attrvalue (diary-attrtype-convert attrvalue type)))
251 (setq ret-attr (append ret-attr (list attrname attrvalue))))
252 (setq attr-list (cdr attr-list)))
253 (setq fileglobattrs ret-attr))
254 (progn
255 (setq ret-attr fileglobattrs
256 attr-list diary-face-attrs)
257 (while attr-list
258 (goto-char (point-min))
259 (setq attr (car attr-list)
260 regexp (nth 0 attr)
261 regnum (nth 1 attr)
262 attrname (nth 2 attr)
263 type (nth 3 attr))
264 (setq attrvalue nil)
265 (if (string-match regexp entry)
4e80f517 266 (progn
c47a201a
JB		 267 (setq attrvalue (substring-no-properties entry
268 (match-beginning regnum)
269 (match-end regnum)))
270 (setq entry (replace-match "" t t entry))))
271 (if (and attrvalue
272 (setq attrvalue (diary-attrtype-convert attrvalue type)))
273 (setq ret-attr (append ret-attr (list attrname attrvalue))))
61d094de
GM		 274 (setq attr-list (cdr attr-list)))))
275 (list entry ret-attr))))
4e80f517
SS		 276
277
3bd9ca85
GM		 278;; This can be removed once the kill/yank treatment of invisible text
279;; (see etc/TODO) is fixed. -- gm
280(defcustom diary-header-line-flag t
281 "*If non-nil, `simple-diary-display' will show a header line.
282The format of the header is specified by `diary-header-line-format'."
283 :group 'diary
284 :type 'boolean
bf247b6e 285 :version "22.1")
3bd9ca85
GM		 286
287(defcustom diary-header-line-format
288 '(:eval (calendar-string-spread
289 (list (if selective-display
290 "Selective display active - press \"s\" in calendar \
291before edit/copy"
292 "Diary"))
293 ?\ (frame-width)))
294 "*Format of the header line displayed by `simple-diary-display'.
295Only used if `diary-header-line-flag' is non-nil."
296 :group 'diary
297 :type 'sexp
bf247b6e 298 :version "22.1")
c47a201a 299
ba55e59f
GM		 300(defvar diary-saved-point) ; internal
301
0808d911
ER		 302(defun list-diary-entries (date number)
303 "Create and display a buffer containing the relevant lines in diary-file.
304The arguments are DATE and NUMBER; the entries selected are those
305for NUMBER days starting with date DATE. The other entries are hidden
6ecab45e 306using selective display. If NUMBER is less than 1, this function does nothing.
0808d911
ER		 307
308Returns a list of all relevant diary entries found, if any, in order by date.
a14723d9
KH		 309The list entries have the form ((month day year) string specifier) where
310\(month day year) is the date of the entry, string is the entry text, and
311specifier is the applicability. If the variable `diary-list-include-blanks'
312is t, this list includes a dummy diary entry consisting of the empty string)
313for a date with no diary entries.
0808d911
ER		 314
315After the list is prepared, the hooks `nongregorian-diary-listing-hook',
316`list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run.
317These hooks have the following distinct roles:
318
319 `nongregorian-diary-listing-hook' can cull dates from the diary
320 and each included file. Usually used for Hebrew or Islamic
321 diary entries in files. Applied to *each* file.
322
323 `list-diary-entries-hook' adds or manipulates diary entries from
324 external sources. Used, for example, to include diary entries
325 from other files or to sort the diary entries. Invoked *once* only,
326 before the display hook is run.
327
328 `diary-display-hook' does the actual display of information. If this is
329 nil, simple-diary-display will be used. Use add-hook to set this to
330 fancy-diary-display, if desired. If you want no diary display, use
331 add-hook to set this to ignore.
332
333 `diary-hook' is run last. This can be used for an appointment
334 notification function."
335
6ecab45e
GM		 336 (when (> number 0)
337 (let ((original-date date);; save for possible use in the hooks
338 old-diary-syntax-table
339 diary-entries-list
340 file-glob-attrs
341 (date-string (calendar-date-string date))
342 (d-file (substitute-in-file-name diary-file)))
343 (message "Preparing diary...")
344 (save-excursion
345 (let ((diary-buffer (find-buffer-visiting d-file)))
346 (if (not diary-buffer)
347 (set-buffer (find-file-noselect d-file t))
348 (set-buffer diary-buffer)
349 (or (verify-visited-file-modtime diary-buffer)
350 (revert-buffer t t))))
ba55e59f
GM		 351 ;; d-s-p is passed to the diary display function.
352 (let ((diary-saved-point (point)))
353 (save-excursion
354 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil "")))
355 (setq selective-display t)
356 (setq selective-display-ellipses nil)
357 (if diary-header-line-flag
358 (setq header-line-format diary-header-line-format))
359 (setq old-diary-syntax-table (syntax-table))
360 (set-syntax-table diary-syntax-table)
361 (unwind-protect
362 (let ((buffer-read-only nil)
363 (diary-modified (buffer-modified-p))
364 (mark (regexp-quote diary-nonmarking-symbol)))
365 ;; First and last characters must be ^M or \n for
366 ;; selective display to work properly
367 (goto-char (1- (point-max)))
368 (if (not (looking-at "\^M\\|\n"))
369 (progn
370 (goto-char (point-max))
371 (insert "\^M")))
372 (goto-char (point-min))
373 (if (not (looking-at "\^M\\|\n"))
374 (insert "\^M"))
375 (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
376 (calendar-for-loop
377 i from 1 to number do
378 (let ((d diary-date-forms)
379 (month (extract-calendar-month date))
380 (day (extract-calendar-day date))
381 (year (extract-calendar-year date))
382 (entry-found (list-sexp-diary-entries date)))
383 (while d
384 (let*
385 ((date-form (if (equal (car (car d)) 'backup)
386 (cdr (car d))
387 (car d)))
388 (backup (equal (car (car d)) 'backup))
389 (dayname
390 (format "%s\\|%s\\.?"
391 (calendar-day-name date)
392 (calendar-day-name date 'abbrev)))
393 (monthname
394 (format "\\*\\|%s\\|%s\\.?"
395 (calendar-month-name month)
396 (calendar-month-name month 'abbrev)))
397 (month (concat "\\*\\|0*" (int-to-string month)))
398 (day (concat "\\*\\|0*" (int-to-string day)))
399 (year
400 (concat
401 "\\*\\|0*" (int-to-string year)
402 (if abbreviated-calendar-year
403 (concat "\\|" (format "%02d" (% year 100)))
404 "")))
405 (regexp
406 (concat
407 "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
408 (mapconcat 'eval date-form "\\)\\(")
409 "\\)"))
410 (case-fold-search t))
411 (goto-char (point-min))
412 (while (re-search-forward regexp nil t)
413 (if backup (re-search-backward "\\<" nil t))
414 (if (and (or (char-equal (preceding-char) ?\^M)
415 (char-equal (preceding-char) ?\n))
416 (not (looking-at " \\|\^I")))
417 ;; Diary entry that consists only of date.
418 (backward-char 1)
419 ;; Found a nonempty diary entry--make it
420 ;; visible and add it to the list.
421 (setq entry-found t)
422 (let ((entry-start (point))
423 date-start temp)
424 (re-search-backward "\^M\\|\n\\|\\`")
425 (setq date-start (point))
426 (re-search-forward "\^M\\|\n" nil t 2)
427 (while (looking-at " \\|\^I")
428 (re-search-forward "\^M\\|\n" nil t))
429 (backward-char 1)
430 (subst-char-in-region date-start
431 (point) ?\^M ?\n t)
432 (setq entry (buffer-substring entry-start (point))
433 temp (diary-pull-attrs entry file-glob-attrs)
434 entry (nth 0 temp))
435 (add-to-diary-list
436 date
437 entry
438 (buffer-substring
439 (1+ date-start) (1- entry-start))
440 (copy-marker entry-start) (nth 1 temp))))))
441 (setq d (cdr d)))
442 (or entry-found
443 (not diary-list-include-blanks)
444 (setq diary-entries-list
445 (append diary-entries-list
446 (list (list date "" "" "" "")))))
447 (setq date
448 (calendar-gregorian-from-absolute
449 (1+ (calendar-absolute-from-gregorian date))))
450 (setq entry-found nil)))
451 (set-buffer-modified-p diary-modified))
452 (set-syntax-table old-diary-syntax-table))
453 (goto-char (point-min))
454 (run-hooks 'nongregorian-diary-listing-hook
455 'list-diary-entries-hook)
456 (if diary-display-hook
457 (run-hooks 'diary-display-hook)
458 (simple-diary-display))
459 (run-hooks 'diary-hook)
460 diary-entries-list))))))
0808d911
ER		 461
462(defun include-other-diary-files ()
463 "Include the diary entries from other diary files with those of diary-file.
464This function is suitable for use in `list-diary-entries-hook';
465it enables you to use shared diary files together with your own.
466The files included are specified in the diaryfile by lines of this form:
467 #include \"filename\"
468This is recursive; that is, #include directives in diary files thus included
469are obeyed. You can change the `#include' to some other string by
470changing the variable `diary-include-string'."
471 (goto-char (point-min))
472 (while (re-search-forward
473 (concat
474 "\\(\\`\\|\^M\\|\n\\)"
475 (regexp-quote diary-include-string)
476 " \"\\([^\"]*\\)\"")
477 nil t)
cb8325bf
GM		 478 (let* ((diary-file (substitute-in-file-name
479 (buffer-substring-no-properties
480 (match-beginning 2) (match-end 2))))
481 (diary-list-include-blanks nil)
482 (list-diary-entries-hook 'include-other-diary-files)
483 (diary-display-hook 'ignore)
484 (diary-hook nil)
485 (d-buffer (find-buffer-visiting diary-file))
486 (diary-modified (if d-buffer
487 (save-excursion
488 (set-buffer d-buffer)
489 (buffer-modified-p)))))
0808d911
ER		 490 (if (file-exists-p diary-file)
491 (if (file-readable-p diary-file)
492 (unwind-protect
493 (setq diary-entries-list
494 (append diary-entries-list
495 (list-diary-entries original-date number)))
8b431855
GM		 496 (save-excursion
497 (set-buffer (find-buffer-visiting diary-file))
73e19344
RS		 498 (let ((inhibit-read-only t))
499 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))
8b431855
GM		 500 (setq selective-display nil)
501 (set-buffer-modified-p diary-modified)))
0808d911
ER		 502 (beep)
503 (message "Can't read included diary file %s" diary-file)
504 (sleep-for 2))
505 (beep)
506 (message "Can't find included diary file %s" diary-file)
507 (sleep-for 2))))
508 (goto-char (point-min)))
509
510(defun simple-diary-display ()
511 "Display the diary buffer if there are any relevant entries or holidays."
512 (let* ((holiday-list (if holidays-in-diary-buffer
513 (check-calendar-holidays original-date)))
8ec6d48a
GM		 514 (hol-string (format "%s%s%s"
515 date-string
516 (if holiday-list ": " "")
517 (mapconcat 'identity holiday-list "; ")))
518 (msg (format "No diary entries for %s" hol-string))
519 ;; If selected window is dedicated (to the calendar),
520 ;; need a new one to display the diary.
521 (pop-up-frames (window-dedicated-p (selected-window))))
522 (calendar-set-mode-line (format "Diary for %s" hol-string))
0808d911
ER		 523 (if (or (not diary-entries-list)
524 (and (not (cdr diary-entries-list))
525 (string-equal (car (cdr (car diary-entries-list))) "")))
8ec6d48a 526 (if (< (length msg) (frame-width))
b3099c46 527 (message "%s" msg)
0808d911
ER		 528 (set-buffer (get-buffer-create holiday-buffer))
529 (setq buffer-read-only nil)
530 (calendar-set-mode-line date-string)
531 (erase-buffer)
532 (insert (mapconcat 'identity holiday-list "\n"))
533 (goto-char (point-min))
534 (set-buffer-modified-p nil)
535 (setq buffer-read-only t)
536 (display-buffer holiday-buffer)
537 (message "No diary entries for %s" date-string))
ba55e59f
GM		 538 (with-current-buffer
539 (find-buffer-visiting (substitute-in-file-name diary-file))
540 (let ((window (display-buffer (current-buffer))))
541 ;; d-s-p is passed from list-diary-entries.
542 (set-window-point window diary-saved-point)
543 (set-window-start window (point-min))))
0808d911
ER		 544 (message "Preparing diary...done"))))
545
86432f81
MR		 546(defface diary-button-face '((((type pc) (class color))
547 (:foreground "lightblue")))
ebea495a 548 "Default face used for buttons."
bf247b6e 549 :version "22.1"
ebea495a 550 :group 'diary)
86432f81
MR		 551
552(define-button-type 'diary-entry
553 'action #'diary-goto-entry
554 'face #'diary-button-face)
555
556(defun diary-goto-entry (button)
557 (let ((marker (button-get button 'marker)))
558 (when marker
559 (pop-to-buffer (marker-buffer marker))
560 (goto-char (marker-position marker)))))
561
0808d911
ER		 562(defun fancy-diary-display ()
563 "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
564This function is provided for optional use as the `diary-display-hook'."
565 (save-excursion;; Turn off selective-display in the diary file's buffer.
cdfeb73f 566 (set-buffer (find-buffer-visiting (substitute-in-file-name diary-file)))
0808d911
ER		 567 (let ((diary-modified (buffer-modified-p)))
568 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
569 (setq selective-display nil)
570 (kill-local-variable 'mode-line-format)
571 (set-buffer-modified-p diary-modified)))
572 (if (or (not diary-entries-list)
573 (and (not (cdr diary-entries-list))
574 (string-equal (car (cdr (car diary-entries-list))) "")))
575 (let* ((holiday-list (if holidays-in-diary-buffer
576 (check-calendar-holidays original-date)))
577 (msg (format "No diary entries for %s %s"
578 (concat date-string (if holiday-list ":" ""))
579 (mapconcat 'identity holiday-list "; "))))
580 (if (<= (length msg) (frame-width))
b3099c46 581 (message "%s" msg)
0808d911
ER		 582 (set-buffer (get-buffer-create holiday-buffer))
583 (setq buffer-read-only nil)
0808d911
ER		 584 (erase-buffer)
585 (insert (mapconcat 'identity holiday-list "\n"))
586 (goto-char (point-min))
587 (set-buffer-modified-p nil)
588 (setq buffer-read-only t)
589 (display-buffer holiday-buffer)
590 (message "No diary entries for %s" date-string)))
591 (save-excursion;; Prepare the fancy diary buffer.
592 (set-buffer (make-fancy-diary-buffer))
593 (setq buffer-read-only nil)
594 (let ((entry-list diary-entries-list)
595 (holiday-list)
596 (holiday-list-last-month 1)
597 (holiday-list-last-year 1)
598 (date (list 0 0 0)))
599 (while entry-list
600 (if (not (calendar-date-equal date (car (car entry-list))))
601 (progn
602 (setq date (car (car entry-list)))
603 (and holidays-in-diary-buffer
604 (calendar-date-compare
605 (list (list holiday-list-last-month
606 (calendar-last-day-of-month
607 holiday-list-last-month
608 holiday-list-last-year)
609 holiday-list-last-year))
610 (list date))
611 ;; We need to get the holidays for the next 3 months.
612 (setq holiday-list-last-month
613 (extract-calendar-month date))
614 (setq holiday-list-last-year
615 (extract-calendar-year date))
de3fce91
GM		 616 (progn
617 (increment-calendar-month
618 holiday-list-last-month holiday-list-last-year 1)
619 t)
0808d911
ER		 620 (setq holiday-list
621 (let ((displayed-month holiday-list-last-month)
622 (displayed-year holiday-list-last-year))
623 (calendar-holiday-list)))
624 (increment-calendar-month
625 holiday-list-last-month holiday-list-last-year 1))
626 (let* ((date-string (calendar-date-string date))
627 (date-holiday-list
628 (let ((h holiday-list)
629 (d))
630 ;; Make a list of all holidays for date.
631 (while h
632 (if (calendar-date-equal date (car (car h)))
633 (setq d (append d (cdr (car h)))))
634 (setq h (cdr h)))
635 d)))
636 (insert (if (= (point) (point-min)) "" ?\n) date-string)
637 (if date-holiday-list (insert ": "))
72fb78ce
ER		 638 (let* ((l (current-column))
639 (longest 0))
86855ebd
SM		 640 (insert (mapconcat (lambda (x)
641 (if (< longest (length x))
642 (setq longest (length x)))
643 x)
72fb78ce
ER		 644 date-holiday-list
645 (concat "\n" (make-string l ? ))))
646 (insert ?\n (make-string (+ l longest) ?=) ?\n)))))
c47a201a
JB		 647
648 (setq entry (car (cdr (car entry-list))))
649 (if (< 0 (length entry))
650 (progn
651 (if (nth 3 (car entry-list))
652 (insert-button (concat entry "\n")
653 'marker (nth 3 (car entry-list))
654 :type 'diary-entry)
655 (insert entry ?\n))
656 (save-excursion
61d094de
GM		 657 (let* ((marks (nth 4 (car entry-list)))
658 (temp-face (make-symbol
659 (apply
660 'concat "temp-face-"
661 (mapcar '(lambda (sym)
662 (if (stringp sym)
663 sym
664 (symbol-name sym)))
665 marks))))
6ecab45e
GM		 666 (faceinfo marks))
667 (make-face temp-face)
56d3bae7 668 ;; Remove :face info from the marks,
61d094de 669 ;; copy the face info into temp-face
61d094de
GM		 670 (while (setq faceinfo (memq :face faceinfo))
671 (copy-face (read (nth 1 faceinfo)) temp-face)
672 (setcar faceinfo nil)
673 (setcar (cdr faceinfo) nil))
674 (setq marks (delq nil marks))
c47a201a 675 ;; Apply the font aspects
61d094de
GM		 676 (apply 'set-face-attribute temp-face nil marks)
677 (search-backward entry)
678 (overlay-put
679 (make-overlay (match-beginning 0) (match-end 0))
680 'face temp-face)))))
c47a201a 681 (setq entry-list (cdr entry-list))))
0808d911
ER		 682 (set-buffer-modified-p nil)
683 (goto-char (point-min))
684 (setq buffer-read-only t)
685 (display-buffer fancy-diary-buffer)
86432f81 686 (fancy-diary-display-mode)
9edfb3d2 687 (calendar-set-mode-line date-string)
0808d911
ER		 688 (message "Preparing diary...done"))))
689
690(defun make-fancy-diary-buffer ()
691 "Create and return the initial fancy diary buffer."
692 (save-excursion
693 (set-buffer (get-buffer-create fancy-diary-buffer))
694 (setq buffer-read-only nil)
0808d911
ER		 695 (calendar-set-mode-line "Diary Entries")
696 (erase-buffer)
697 (set-buffer-modified-p nil)
698 (setq buffer-read-only t)
699 (get-buffer fancy-diary-buffer)))
700
701(defun print-diary-entries ()
702 "Print a hard copy of the diary display.
703
704If the simple diary display is being used, prepare a temp buffer with the
705visible lines of the diary buffer, add a heading line composed from the mode
706line, print the temp buffer, and destroy it.
707
708If the fancy diary display is being used, just print the buffer.
709
710The hooks given by the variable `print-diary-entries-hook' are called to do
711the actual printing."
712 (interactive)
713 (if (bufferp (get-buffer fancy-diary-buffer))
714 (save-excursion
715 (set-buffer (get-buffer fancy-diary-buffer))
716 (run-hooks 'print-diary-entries-hook))
717 (let ((diary-buffer
cdfeb73f 718 (find-buffer-visiting (substitute-in-file-name diary-file))))
0808d911
ER		 719 (if diary-buffer
720 (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*"))
721 (heading))
722 (save-excursion
723 (set-buffer diary-buffer)
724 (setq heading
725 (if (not (stringp mode-line-format))
726 "All Diary Entries"
727 (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
728 (substring mode-line-format
729 (match-beginning 1) (match-end 1))))
730 (copy-to-buffer temp-buffer (point-min) (point-max))
731 (set-buffer temp-buffer)
732 (while (re-search-forward "\^M.*$" nil t)
733 (replace-match ""))
734 (goto-char (point-min))
735 (insert heading "\n"
736 (make-string (length heading) ?=) "\n")
737 (run-hooks 'print-diary-entries-hook)
738 (kill-buffer temp-buffer)))
739 (error "You don't have a diary buffer!")))))
740
741(defun show-all-diary-entries ()
742 "Show all of the diary entries in the diary file.
743This function gets rid of the selective display of the diary file so that
744all entries, not just some, are visible. If there is no diary buffer, one
745is created."
746 (interactive)
6ecab45e
GM		 747 (let ((d-file (diary-check-diary-file))
748 (pop-up-frames (window-dedicated-p (selected-window))))
c87a1f38
GM		 749 (save-excursion
750 (set-buffer (or (find-buffer-visiting d-file)
751 (find-file-noselect d-file t)))
752 (let ((buffer-read-only nil)
753 (diary-modified (buffer-modified-p)))
754 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
755 (setq selective-display nil
756 mode-line-format default-mode-line-format)
757 (display-buffer (current-buffer))
758 (set-buffer-modified-p diary-modified)))))
8ffbfaa9 759
4dd618ff 760(defcustom diary-mail-addr
c87a1f38 761 (if (boundp 'user-mail-address) user-mail-address "")
8ffbfaa9
RS		 762 "*Email address that `diary-mail-entries' will send email to."
763 :group 'diary
c87a1f38 764 :type 'string
cd32a7ba 765 :version "20.3")
8ffbfaa9
RS		 766
767(defcustom diary-mail-days 7
c87a1f38 768 "*Default number of days for `diary-mail-entries' to check."
8ffbfaa9 769 :group 'diary
cd32a7ba
DN		 770 :type 'integer
771 :version "20.3")
8ffbfaa9 772
f91adf29 773;;;###autoload
8ffbfaa9
RS		 774(defun diary-mail-entries (&optional ndays)
775 "Send a mail message showing diary entries for next NDAYS days.
776If no prefix argument is given, NDAYS is set to `diary-mail-days'.
c87a1f38 777Mail is sent to the address specified by `diary-mail-addr'.
8ffbfaa9
RS		 778
779You can call `diary-mail-entries' every night using an at/cron job.
780For example, this script will run the program at 2am daily. Since
781`emacs -batch' does not load your `.emacs' file, you must ensure that
782all relevant variables are set, as done here.
783
784#!/bin/sh
785# diary-rem.sh -- repeatedly run the Emacs diary-reminder
786emacs -batch \\
787-eval \"(setq diary-mail-days 3 \\
c87a1f38 788 diary-file \\\"/path/to/diary.file\\\" \\
8ffbfaa9
RS		 789 european-calendar-style t \\
790 diary-mail-addr \\\"user@host.name\\\" )\" \\
4dd618ff 791-l diary-lib -f diary-mail-entries
8ffbfaa9
RS		 792at -f diary-rem.sh 0200 tomorrow
793
794You may have to tweak the syntax of the `at' command to suit your
795system. Alternatively, you can specify a cron entry:
7960 1 * * * diary-rem.sh
797to run it every morning at 1am."
d56aaa64 798 (interactive "P")
c87a1f38
GM		 799 (if (string-equal diary-mail-addr "")
800 (error "You must set `diary-mail-addr' to use this command")
801 (let ((diary-display-hook 'fancy-diary-display))
802 (list-diary-entries (calendar-current-date) (or ndays diary-mail-days)))
803 (compose-mail diary-mail-addr
804 (concat "Diary entries generated "
805 (calendar-date-string (calendar-current-date))))
806 (insert
807 (if (get-buffer fancy-diary-buffer)
808 (save-excursion
809 (set-buffer fancy-diary-buffer)
810 (buffer-substring (point-min) (point-max)))
811 "No entries found"))
812 (call-interactively (get mail-user-agent 'sendfunc))))
d56aaa64 813
ca2a5950
GM		 814(defun diary-name-pattern (string-array &optional abbrev-array paren)
815 "Return a regexp matching the strings in the array STRING-ARRAY.
816If the optional argument ABBREV-ARRAY is present, then the function
817`calendar-abbrev-construct' is used to construct abbreviations from the
818two supplied arrays. The returned regexp will then also match these
819abbreviations, with or without final `.' characters. If the optional
820argument PAREN is non-nil, the regexp is surrounded by parentheses."
821 (regexp-opt (append string-array
822 (if abbrev-array
823 (calendar-abbrev-construct abbrev-array
824 string-array))
825 (if abbrev-array
826 (calendar-abbrev-construct abbrev-array
827 string-array
828 'period))
829 nil)
830 paren))
0808d911
ER		 831
832(defvar marking-diary-entries nil
833 "True during the marking of diary entries, nil otherwise.")
834
835(defvar marking-diary-entry nil
836 "True during the marking of diary entries, if current entry is marking.")
837
81eb8a4a 838(defun mark-diary-entries (&optional redraw)
0808d911 839 "Mark days in the calendar window that have diary entries.
81eb8a4a
GM		 840Each entry in the diary file visible in the calendar window is
841marked. After the entries are marked, the hooks
842`nongregorian-diary-marking-hook' and `mark-diary-entries-hook'
843are run. If the optional argument REDRAW is non-nil (which is
844the case interactively, for example) then any existing diary
845marks are first removed. This is intended to deal with deleted
846diary entries."
847 (interactive "p")
848 ;; To remove any deleted diary entries. Do not redraw when:
849 ;; i) processing #include diary files (else only get the marks from
850 ;; the last #include file processed).
851 ;; ii) called via calendar-redraw (since calendar has already been
852 ;; erased).
853 ;; Use of REDRAW handles both of these cases.
854 (when (and redraw mark-diary-entries-in-calendar)
a46c339d
GM		 855 (setq mark-diary-entries-in-calendar nil)
856 (redraw-calendar))
c87a1f38
GM		 857 (let ((marking-diary-entries t)
858 file-glob-attrs marks)
859 (save-excursion
860 (set-buffer (find-file-noselect (diary-check-diary-file) t))
d0897fa5 861 (setq mark-diary-entries-in-calendar t)
c87a1f38
GM		 862 (message "Marking diary entries...")
863 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
864 (let ((d diary-date-forms)
865 (old-diary-syntax-table (syntax-table))
866 temp)
867 (set-syntax-table diary-syntax-table)
868 (while d
869 (let* ((date-form (if (equal (car (car d)) 'backup)
870 (cdr (car d))
871 (car d)));; ignore 'backup directive
ca2a5950
GM		 872 (dayname
873 (diary-name-pattern calendar-day-name-array
874 calendar-day-abbrev-array))
c87a1f38 875 (monthname
ca2a5950
GM		 876 (format "%s\\|\\*"
877 (diary-name-pattern calendar-month-name-array
878 calendar-month-abbrev-array)))
c87a1f38
GM		 879 (month "[0-9]+\\|\\*")
880 (day "[0-9]+\\|\\*")
881 (year "[0-9]+\\|\\*")
882 (l (length date-form))
883 (d-name-pos (- l (length (memq 'dayname date-form))))
884 (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
885 (m-name-pos (- l (length (memq 'monthname date-form))))
886 (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
887 (d-pos (- l (length (memq 'day date-form))))
888 (d-pos (if (/= l d-pos) (+ 2 d-pos)))
889 (m-pos (- l (length (memq 'month date-form))))
890 (m-pos (if (/= l m-pos) (+ 2 m-pos)))
891 (y-pos (- l (length (memq 'year date-form))))
892 (y-pos (if (/= l y-pos) (+ 2 y-pos)))
893 (regexp
894 (concat
895 "\\(\\`\\|\^M\\|\n\\)\\("
896 (mapconcat 'eval date-form "\\)\\(")
897 "\\)"))
898 (case-fold-search t))
899 (goto-char (point-min))
900 (while (re-search-forward regexp nil t)
901 (let* ((dd-name
902 (if d-name-pos
903 (buffer-substring-no-properties
904 (match-beginning d-name-pos)
905 (match-end d-name-pos))))
906 (mm-name
907 (if m-name-pos
908 (buffer-substring-no-properties
909 (match-beginning m-name-pos)
910 (match-end m-name-pos))))
027a4b6b 911 (mm (string-to-number
c87a1f38
GM		 912 (if m-pos
913 (buffer-substring-no-properties
914 (match-beginning m-pos)
915 (match-end m-pos))
916 "")))
027a4b6b 917 (dd (string-to-number
c87a1f38
GM		 918 (if d-pos
919 (buffer-substring-no-properties
920 (match-beginning d-pos)
921 (match-end d-pos))
922 "")))
923 (y-str (if y-pos
924 (buffer-substring-no-properties
925 (match-beginning y-pos)
926 (match-end y-pos))))
927 (yy (if (not y-str)
928 0
929 (if (and (= (length y-str) 2)
930 abbreviated-calendar-year)
931 (let* ((current-y
932 (extract-calendar-year
933 (calendar-current-date)))
027a4b6b 934 (y (+ (string-to-number y-str)
c87a1f38
GM		 935 (* 100
936 (/ current-y 100)))))
937 (if (> (- y current-y) 50)
938 (- y 100)
939 (if (> (- current-y y) 50)
940 (+ y 100)
941 y)))
027a4b6b 942 (string-to-number y-str))))
c87a1f38
GM		 943 (save-excursion
944 (setq entry (buffer-substring-no-properties
945 (point) (line-end-position))
946 temp (diary-pull-attrs entry file-glob-attrs)
947 entry (nth 0 temp)
948 marks (nth 1 temp))))
949 (if dd-name
950 (mark-calendar-days-named
abc178a0 951 (cdr (assoc-string
ca2a5950 952 dd-name
c87a1f38
GM		 953 (calendar-make-alist
954 calendar-day-name-array
abc178a0 955 0 nil calendar-day-abbrev-array) t)) marks)
c87a1f38 956 (if mm-name
ca2a5950
GM		 957 (setq mm
958 (if (string-equal mm-name "*") 0
abc178a0 959 (cdr (assoc-string
ca2a5950 960 mm-name
c87a1f38
GM		 961 (calendar-make-alist
962 calendar-month-name-array
abc178a0 963 1 nil calendar-month-abbrev-array) t)))))
c87a1f38
GM		 964 (mark-calendar-date-pattern mm dd yy marks))))
965 (setq d (cdr d))))
966 (mark-sexp-diary-entries)
967 (run-hooks 'nongregorian-diary-marking-hook
968 'mark-diary-entries-hook)
969 (set-syntax-table old-diary-syntax-table)
970 (message "Marking diary entries...done")))))
0808d911
ER		 971
972(defun mark-sexp-diary-entries ()
973 "Mark days in the calendar window that have sexp diary entries.
974Each entry in the diary file (or included files) visible in the calendar window
975is marked. See the documentation for the function `list-sexp-diary-entries'."
976 (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol))
977 (s-entry (concat "\\(\\`\\|\^M\\|\n\\)\\("
c87a1f38 978 sexp-mark "(\\)\\|\\("
0808d911 979 (regexp-quote diary-nonmarking-symbol)
c87a1f38
GM		 980 sexp-mark "(diary-remind\\)"))
981 (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
982 m y first-date last-date mark file-glob-attrs)
0808d911
ER		 983 (save-excursion
984 (set-buffer calendar-buffer)
985 (setq m displayed-month)
986 (setq y displayed-year))
987 (increment-calendar-month m y -1)
988 (setq first-date
989 (calendar-absolute-from-gregorian (list m 1 y)))
990 (increment-calendar-month m y 2)
991 (setq last-date
992 (calendar-absolute-from-gregorian
993 (list m (calendar-last-day-of-month m y) y)))
994 (goto-char (point-min))
995 (while (re-search-forward s-entry nil t)
c87a1f38 996 (setq marking-diary-entry (char-equal (preceding-char) ?\())
0808d911
ER		 997 (re-search-backward "(")
998 (let ((sexp-start (point))
61d094de 999 sexp entry entry-start line-start marks)
0808d911 1000 (forward-sexp)
e6c3bfbc 1001 (setq sexp (buffer-substring-no-properties sexp-start (point)))
0808d911
ER		 1002 (save-excursion
1003 (re-search-backward "\^M\\|\n\\|\\`")
1004 (setq line-start (point)))
1005 (forward-char 1)
1006 (if (and (or (char-equal (preceding-char) ?\^M)
1007 (char-equal (preceding-char) ?\n))
1008 (not (looking-at " \\|\^I")))
1009 (progn;; Diary entry consists only of the sexp
1010 (backward-char 1)
1011 (setq entry ""))
1012 (setq entry-start (point))
7ff02048 1013 ;; Find end of entry
0808d911
ER		 1014 (re-search-forward "\^M\\|\n" nil t)
1015 (while (looking-at " \\|\^I")
94d1817d
KH		 1016 (or (re-search-forward "\^M\\|\n" nil t)
1017 (re-search-forward "$" nil t)))
7ff02048
KH		 1018 (if (or (char-equal (preceding-char) ?\^M)
1019 (char-equal (preceding-char) ?\n))
1020 (backward-char 1))
e6c3bfbc 1021 (setq entry (buffer-substring-no-properties entry-start (point)))
0808d911
ER		 1022 (while (string-match "[\^M]" entry)
1023 (aset entry (match-beginning 0) ?\n )))
1024 (calendar-for-loop date from first-date to last-date do
fd4a98f0
RS		 1025 (if (setq mark (diary-sexp-entry sexp entry
1026 (calendar-gregorian-from-absolute date)))
c47a201a
JB		 1027 (progn
1028 (setq marks (diary-pull-attrs entry file-glob-attrs)
61d094de 1029 marks (nth 1 (diary-pull-attrs entry file-glob-attrs)))
c47a201a 1030 (mark-visible-calendar-date
4e80f517 1031 (calendar-gregorian-from-absolute date)
c47a201a
JB		 1032 (if (< 0 (length marks))
1033 marks
1034 (if (consp mark)
1035 (car mark)))))))))))
0808d911
ER		 1036
1037(defun mark-included-diary-files ()
1038 "Mark the diary entries from other diary files with those of the diary file.
1039This function is suitable for use as the `mark-diary-entries-hook'; it enables
1040you to use shared diary files together with your own. The files included are
1041specified in the diary-file by lines of this form:
1042 #include \"filename\"
1043This is recursive; that is, #include directives in diary files thus included
1044are obeyed. You can change the `#include' to some other string by
1045changing the variable `diary-include-string'."
1046 (goto-char (point-min))
1047 (while (re-search-forward
1048 (concat
1049 "\\(\\`\\|\^M\\|\n\\)"
1050 (regexp-quote diary-include-string)
1051 " \"\\([^\"]*\\)\"")
1052 nil t)
1053 (let ((diary-file (substitute-in-file-name
e6c3bfbc
ER		 1054 (buffer-substring-no-properties
1055 (match-beginning 2) (match-end 2))))
0808d911
ER		 1056 (mark-diary-entries-hook 'mark-included-diary-files))
1057 (if (file-exists-p diary-file)
1058 (if (file-readable-p diary-file)
1059 (progn
1060 (mark-diary-entries)
cdfeb73f 1061 (kill-buffer (find-buffer-visiting diary-file)))
0808d911
ER		 1062 (beep)
1063 (message "Can't read included diary file %s" diary-file)
1064 (sleep-for 2))
1065 (beep)
1066 (message "Can't find included diary file %s" diary-file)
1067 (sleep-for 2))))
1068 (goto-char (point-min)))
1069
c47a201a 1070(defun mark-calendar-days-named (dayname &optional color)
0808d911
ER		 1071 "Mark all dates in the calendar window that are day DAYNAME of the week.
10720 means all Sundays, 1 means all Mondays, and so on."
1073 (save-excursion
1074 (set-buffer calendar-buffer)
1075 (let ((prev-month displayed-month)
1076 (prev-year displayed-year)
1077 (succ-month displayed-month)
1078 (succ-year displayed-year)
1079 (last-day)
1080 (day))
1081 (increment-calendar-month succ-month succ-year 1)
1082 (increment-calendar-month prev-month prev-year -1)
1083 (setq day (calendar-absolute-from-gregorian
1084 (calendar-nth-named-day 1 dayname prev-month prev-year)))
1085 (setq last-day (calendar-absolute-from-gregorian
1086 (calendar-nth-named-day -1 dayname succ-month succ-year)))
1087 (while (<= day last-day)
c47a201a 1088 (mark-visible-calendar-date (calendar-gregorian-from-absolute day) color)
0808d911
ER		 1089 (setq day (+ day 7))))))
1090
c47a201a 1091(defun mark-calendar-date-pattern (month day year &optional color)
0808d911
ER		 1092 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
1093A value of 0 in any position is a wildcard."
1094 (save-excursion
1095 (set-buffer calendar-buffer)
1096 (let ((m displayed-month)
1097 (y displayed-year))
1098 (increment-calendar-month m y -1)
1099 (calendar-for-loop i from 0 to 2 do
c47a201a 1100 (mark-calendar-month m y month day year color)
0808d911
ER		 1101 (increment-calendar-month m y 1)))))
1102
c47a201a 1103(defun mark-calendar-month (month year p-month p-day p-year &optional color)
0808d911
ER		 1104 "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
1105A value of 0 in any position of the pattern is a wildcard."
1106 (if (or (and (= month p-month)
1107 (or (= p-year 0) (= year p-year)))
1108 (and (= p-month 0)
1109 (or (= p-year 0) (= year p-year))))
1110 (if (= p-day 0)
1111 (calendar-for-loop
1112 i from 1 to (calendar-last-day-of-month month year) do
c47a201a
JB		 1113 (mark-visible-calendar-date (list month i year) color))
1114 (mark-visible-calendar-date (list month p-day year) color))))
0808d911
ER		 1115
1116(defun sort-diary-entries ()
1117 "Sort the list of diary entries by time of day."
1118 (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
1119
1120(defun diary-entry-compare (e1 e2)
1121 "Returns t if E1 is earlier than E2."
1122 (or (calendar-date-compare e1 e2)
1123 (and (calendar-date-equal (car e1) (car e2))
4dd618ff
SS		 1124 (let* ((ts1 (cadr e1)) (t1 (diary-entry-time ts1))
1125 (ts2 (cadr e2)) (t2 (diary-entry-time ts2)))
1126 (or (< t1 t2)
1127 (and (= t1 t2)
1128 (string-lessp ts1 ts2)))))))
0808d911 1129
a14723d9
KH		 1130(defcustom diary-unknown-time
1131 -9999
1132 "*Value returned by diary-entry-time when no time is found.
1133The default value -9999 causes entries with no recognizable time to be placed
1134before those with times; 9999 would place entries with no recognizable time
1135after those with times."
1136 :type 'integer
cd32a7ba
DN		 1137 :group 'diary
1138 :version "20.3")
4dd618ff 1139
0808d911 1140(defun diary-entry-time (s)
fd4a98f0
RS		 1141 "Return time at the beginning of the string S as a military-style integer.
1142For example, returns 1325 for 1:25pm.
56d3bae7
TTN		 1143
1144Returns `diary-unknown-time' (default value -9999) if no time is recognized.
1145The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam,
6ecab45e
GM		 1146XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can
1147be used instead of a colon (:) to separate the hour and minute parts."
0488694c 1148 (let ((case-fold-search nil))
4dd618ff 1149 (cond ((string-match ; Military time
56d3bae7
TTN		 1150 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
1151 s)
027a4b6b 1152 (+ (* 100 (string-to-number
0488694c 1153 (substring s (match-beginning 1) (match-end 1))))
027a4b6b 1154 (string-to-number (substring s (match-beginning 2) (match-end 2)))))
4dd618ff 1155 ((string-match ; Hour only XXam or XXpm
619fdf3d 1156 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
027a4b6b 1157 (+ (* 100 (% (string-to-number
0488694c
RS		 1158 (substring s (match-beginning 1) (match-end 1)))
1159 12))
1160 (if (equal ?a (downcase (aref s (match-beginning 2))))
1161 0 1200)))
4dd618ff 1162 ((string-match ; Hour and minute XX:XXam or XX:XXpm
d14b04bc 1163 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
027a4b6b 1164 (+ (* 100 (% (string-to-number
0488694c
RS		 1165 (substring s (match-beginning 1) (match-end 1)))
1166 12))
027a4b6b 1167 (string-to-number (substring s (match-beginning 2) (match-end 2)))
0488694c
RS		 1168 (if (equal ?a (downcase (aref s (match-beginning 3))))
1169 0 1200)))
4dd618ff 1170 (t diary-unknown-time)))) ; Unrecognizable
619fdf3d 1171
811a8484
JW		 1172;; Unrecognizable
1173
0808d911
ER		 1174(defun list-sexp-diary-entries (date)
1175 "Add sexp entries for DATE from the diary file to `diary-entries-list'.
1176Also, Make them visible in the diary file. Returns t if any entries were
1177found.
1178
1179Sexp diary entries must be prefaced by a `sexp-diary-entry-symbol' (normally
1180`%%'). The form of a sexp diary entry is
1181
1182 %%(SEXP) ENTRY
1183
1184Both ENTRY and DATE are globally available when the SEXP is evaluated. If the
1185SEXP yields the value nil, the diary entry does not apply. If it yields a
1186non-nil value, ENTRY will be taken to apply to DATE; if the non-nil value is a
1187string, that string will be the diary entry in the fancy diary display.
1188
1189For example, the following diary entry will apply to the 21st of the month
1190if it is a weekday and the Friday before if the 21st is on a weekend:
1191
1192 &%%(let ((dayname (calendar-day-of-week date))
1193 (day (extract-calendar-day date)))
1194 (or
1195 (and (= day 21) (memq dayname '(1 2 3 4 5)))
1196 (and (memq day '(19 20)) (= dayname 5)))
1197 ) UIUC pay checks deposited
1198
1199A number of built-in functions are available for this type of diary entry:
1200
fd4a98f0 1201 %%(diary-date MONTH DAY YEAR &optional MARK) text
0808d911
ER		 1202 Entry applies if date is MONTH, DAY, YEAR if
1203 `european-calendar-style' is nil, and DAY, MONTH, YEAR if
1204 `european-calendar-style' is t. DAY, MONTH, and YEAR
1205 can be lists of integers, the constant t, or an integer.
ee58da1b 1206 The constant t means all values. An optional parameter
fd4a98f0
RS		 1207 MARK specifies a face or single-character string to use
1208 when highlighting the day in the calendar.
0808d911 1209
fd4a98f0 1210 %%(diary-float MONTH DAYNAME N &optional DAY MARK) text
0808d911
ER		 1211 Entry will appear on the Nth DAYNAME of MONTH.
1212 (DAYNAME=0 means Sunday, 1 means Monday, and so on;
1213 if N is negative it counts backward from the end of
1214 the month. MONTH can be a list of months, a single
9b58d144
RS		 1215 month, or t to specify all months. Optional DAY means
1216 Nth DAYNAME of MONTH on or after/before DAY. DAY defaults
ee58da1b
SS		 1217 to 1 if N>0 and the last day of the month if N<0. An
1218 optional parameter MARK specifies a face or single-character
fd4a98f0 1219 string to use when highlighting the day in the calendar.
0808d911 1220
fd4a98f0 1221 %%(diary-block M1 D1 Y1 M2 D2 Y2 &optional MARK) text
0808d911
ER		 1222 Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
1223 inclusive. (If `european-calendar-style' is t, the
1224 order of the parameters should be changed to D1, M1, Y1,
ee58da1b
SS		 1225 D2, M2, Y2.) An optional parameter MARK specifies a face
1226 or single-character string to use when highlighting the
fd4a98f0 1227 day in the calendar.
0808d911 1228
fd4a98f0 1229 %%(diary-anniversary MONTH DAY YEAR &optional MARK) text
0808d911
ER		 1230 Entry will appear on anniversary dates of MONTH DAY, YEAR.
1231 (If `european-calendar-style' is t, the order of the
1232 parameters should be changed to DAY, MONTH, YEAR.) Text
1233 can contain %d or %d%s; %d will be replaced by the number
1234 of years since the MONTH DAY, YEAR and %s will be replaced
1235 by the ordinal ending of that number (that is, `st', `nd',
1236 `rd' or `th', as appropriate. The anniversary of February
ee58da1b
SS		 1237 29 is considered to be March 1 in a non-leap year. An
1238 optional parameter MARK specifies a face or single-character
fd4a98f0 1239 string to use when highlighting the day in the calendar.
0808d911 1240
fd4a98f0 1241 %%(diary-cyclic N MONTH DAY YEAR &optional MARK) text
0808d911
ER		 1242 Entry will appear every N days, starting MONTH DAY, YEAR.
1243 (If `european-calendar-style' is t, the order of the
1244 parameters should be changed to N, DAY, MONTH, YEAR.) Text
1245 can contain %d or %d%s; %d will be replaced by the number
1246 of repetitions since the MONTH DAY, YEAR and %s will
1247 be replaced by the ordinal ending of that number (that is,
ee58da1b
SS		 1248 `st', `nd', `rd' or `th', as appropriate. An optional
1249 parameter MARK specifies a face or single-character string
fd4a98f0 1250 to use when highlighting the day in the calendar.
0808d911
ER		 1251
1252 %%(diary-remind SEXP DAYS &optional MARKING) text
1253 Entry is a reminder for diary sexp SEXP. DAYS is either a
1254 single number or a list of numbers indicating the number(s)
1255 of days before the event that the warning(s) should occur.
1256 If the current date is (one of) DAYS before the event
1257 indicated by EXPR, then a suitable message (as specified
1258 by `diary-remind-message') appears. In addition to the
1259 reminders beforehand, the diary entry also appears on
1260 the date itself. If optional MARKING is non-nil then the
1261 *reminders* are marked on the calendar. Marking of
1262 reminders is independent of whether the entry *itself* is
1263 a marking or nonmarking one.
1264
1265 %%(diary-day-of-year)
1266 Diary entries giving the day of the year and the number of
1267 days remaining in the year will be made every day. Note
1268 that since there is no text, it makes sense only if the
1269 fancy diary display is used.
1270
1271 %%(diary-iso-date)
1272 Diary entries giving the corresponding ISO commercial date
1273 will be made every day. Note that since there is no text,
1274 it makes sense only if the fancy diary display is used.
1275
1276 %%(diary-french-date)
1277 Diary entries giving the corresponding French Revolutionary
1278 date will be made every day. Note that since there is no
1279 text, it makes sense only if the fancy diary display is used.
1280
1281 %%(diary-islamic-date)
1282 Diary entries giving the corresponding Islamic date will be
1283 made every day. Note that since there is no text, it
1284 makes sense only if the fancy diary display is used.
1285
1286 %%(diary-hebrew-date)
1287 Diary entries giving the corresponding Hebrew date will be
1288 made every day. Note that since there is no text, it
1289 makes sense only if the fancy diary display is used.
1290
1291 %%(diary-astro-day-number) Diary entries giving the corresponding
1292 astronomical (Julian) day number will be made every day.
1293 Note that since there is no text, it makes sense only if the
1294 fancy diary display is used.
1295
1296 %%(diary-julian-date) Diary entries giving the corresponding
1297 Julian date will be made every day. Note that since
1298 there is no text, it makes sense only if the fancy diary
1299 display is used.
1300
1301 %%(diary-sunrise-sunset)
1302 Diary entries giving the local times of sunrise and sunset
1303 will be made every day. Note that since there is no text,
1304 it makes sense only if the fancy diary display is used.
1305 Floating point required.
1306
1307 %%(diary-phases-of-moon)
1308 Diary entries giving the times of the phases of the moon
1309 will be when appropriate. Note that since there is no text,
1310 it makes sense only if the fancy diary display is used.
1311 Floating point required.
1312
1313 %%(diary-yahrzeit MONTH DAY YEAR) text
1314 Text is assumed to be the name of the person; the date is
1315 the date of death on the *civil* calendar. The diary entry
1316 will appear on the proper Hebrew-date anniversary and on the
1317 day before. (If `european-calendar-style' is t, the order
1318 of the parameters should be changed to DAY, MONTH, YEAR.)
4dd618ff 1319
0808d911
ER		 1320 %%(diary-rosh-hodesh)
1321 Diary entries will be made on the dates of Rosh Hodesh on
1322 the Hebrew calendar. Note that since there is no text, it
1323 makes sense only if the fancy diary display is used.
1324
1325 %%(diary-parasha)
1326 Diary entries giving the weekly parasha will be made on
1327 every Saturday. Note that since there is no text, it
1328 makes sense only if the fancy diary display is used.
1329
1330 %%(diary-omer)
1331 Diary entries giving the omer count will be made every day
59ba214d 1332 from Passover to Shavuot. Note that since there is no text,
0808d911
ER		 1333 it makes sense only if the fancy diary display is used.
1334
1335Marking these entries is *extremely* time consuming, so these entries are
1336best if they are nonmarking."
56d3bae7 1337 (let ((s-entry (concat "\\(\\`\\|\^M\\|\n\\)"
c87a1f38
GM		 1338 (regexp-quote diary-nonmarking-symbol)
1339 "?"
1340 (regexp-quote sexp-diary-entry-symbol)
1341 "("))
1342 entry-found file-glob-attrs marks)
0808d911 1343 (goto-char (point-min))
c47a201a
JB		 1344 (save-excursion
1345 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))))
0808d911
ER		 1346 (while (re-search-forward s-entry nil t)
1347 (backward-char 1)
1348 (let ((sexp-start (point))
c87a1f38 1349 sexp entry specifier entry-start line-start)
0808d911 1350 (forward-sexp)
e6c3bfbc 1351 (setq sexp (buffer-substring-no-properties sexp-start (point)))
0808d911
ER		 1352 (save-excursion
1353 (re-search-backward "\^M\\|\n\\|\\`")
1354 (setq line-start (point)))
a14723d9 1355 (setq specifier
86432f81
MR		 1356 (buffer-substring-no-properties (1+ line-start) (point))
1357 entry-start (1+ line-start))
0808d911
ER		 1358 (forward-char 1)
1359 (if (and (or (char-equal (preceding-char) ?\^M)
1360 (char-equal (preceding-char) ?\n))
1361 (not (looking-at " \\|\^I")))
1362 (progn;; Diary entry consists only of the sexp
1363 (backward-char 1)
1364 (setq entry ""))
1365 (setq entry-start (point))
1366 (re-search-forward "\^M\\|\n" nil t)
1367 (while (looking-at " \\|\^I")
1368 (re-search-forward "\^M\\|\n" nil t))
1369 (backward-char 1)
e6c3bfbc 1370 (setq entry (buffer-substring-no-properties entry-start (point)))
0808d911
ER		 1371 (while (string-match "[\^M]" entry)
1372 (aset entry (match-beginning 0) ?\n )))
61d094de
GM		 1373 (let ((diary-entry (diary-sexp-entry sexp entry date))
1374 temp)
c47a201a
JB		 1375 (setq entry (if (consp diary-entry)
1376 (cdr diary-entry)
1377 diary-entry))
0808d911 1378 (if diary-entry
c47a201a
JB		 1379 (progn
1380 (subst-char-in-region line-start (point) ?\^M ?\n t)
1381 (if (< 0 (length entry))
1382 (setq temp (diary-pull-attrs entry file-glob-attrs)
1383 entry (nth 0 temp)
1384 marks (nth 1 temp)))))
1385 (add-to-diary-list date
1386 entry
86432f81
MR		 1387 specifier
1388 (if entry-start (copy-marker entry-start)
4e80f517 1389 nil)
c47a201a 1390 marks)
fd4a98f0 1391 (setq entry-found (or entry-found diary-entry)))))
0808d911
ER		 1392 entry-found))
1393
1394(defun diary-sexp-entry (sexp entry date)
1395 "Process a SEXP diary ENTRY for DATE."
1396 (let ((result (if calendar-debug-sexp
1397 (let ((stack-trace-on-error t))
1398 (eval (car (read-from-string sexp))))
1399 (condition-case nil
1400 (eval (car (read-from-string sexp)))
1401 (error
1402 (beep)
1403 (message "Bad sexp at line %d in %s: %s"
1404 (save-excursion
1405 (save-restriction
1406 (narrow-to-region 1 (point))
1407 (goto-char (point-min))
1408 (let ((lines 1))
1409 (while (re-search-forward "\n\\|\^M" nil t)
1410 (setq lines (1+ lines)))
1411 lines)))
1412 diary-file sexp)
1413 (sleep-for 2))))))
fd4a98f0
RS		 1414 (cond ((stringp result) result)
1415 ((and (consp result)
1416 (stringp (cdr result))) result)
1417 (result entry)
1418 (t nil))))
0808d911 1419
fd4a98f0 1420(defun diary-date (month day year &optional mark)
0808d911
ER		 1421 "Specific date(s) diary entry.
1422Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil,
1423and DAY, MONTH, YEAR if `european-calendar-style' is t. DAY, MONTH, and YEAR
1424can be lists of integers, the constant t, or an integer. The constant t means
fd4a98f0
RS		 1425all values.
1426
ee58da1b 1427An optional parameter MARK specifies a face or single-character string to
fd4a98f0 1428use when highlighting the day in the calendar."
c87a1f38 1429 (let ((dd (if european-calendar-style
0808d911
ER		 1430 month
1431 day))
c87a1f38 1432 (mm (if european-calendar-style
0808d911
ER		 1433 day
1434 month))
c87a1f38
GM		 1435 (m (extract-calendar-month date))
1436 (y (extract-calendar-year date))
1437 (d (extract-calendar-day date)))
0808d911
ER		 1438 (if (and
1439 (or (and (listp dd) (memq d dd))
1440 (equal d dd)
1441 (eq dd t))
1442 (or (and (listp mm) (memq m mm))
1443 (equal m mm)
1444 (eq mm t))
1445 (or (and (listp year) (memq y year))
1446 (equal y year)
1447 (eq year t)))
86432f81 1448 (cons mark entry))))
0808d911 1449
fd4a98f0 1450(defun diary-block (m1 d1 y1 m2 d2 y2 &optional mark)
0808d911 1451 "Block diary entry.
5860ba6e
RS		 1452Entry applies if date is between, or on one of, two dates.
1453The order of the parameters is
666333c0 1454M1, D1, Y1, M2, D2, Y2 if `european-calendar-style' is nil, and
fd4a98f0
RS		 1455D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t.
1456
ee58da1b 1457An optional parameter MARK specifies a face or single-character string to
fd4a98f0
RS		 1458use when highlighting the day in the calendar."
1459
0808d911
ER		 1460 (let ((date1 (calendar-absolute-from-gregorian
1461 (if european-calendar-style
1462 (list d1 m1 y1)
1463 (list m1 d1 y1))))
1464 (date2 (calendar-absolute-from-gregorian
1465 (if european-calendar-style
1466 (list d2 m2 y2)
1467 (list m2 d2 y2))))
1468 (d (calendar-absolute-from-gregorian date)))
1469 (if (and (<= date1 d) (<= d date2))
fd4a98f0 1470 (cons mark entry))))
0808d911 1471
fd4a98f0 1472(defun diary-float (month dayname n &optional day mark)
0808d911
ER		 1473 "Floating diary entry--entry applies if date is the nth dayname of month.
1474Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, the constant
1475t, or an integer. The constant t means all months. If N is negative, count
9b58d144
RS		 1476backward from the end of the month.
1477
fd4a98f0 1478An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY.
ee58da1b 1479Optional MARK specifies a face or single-character string to use when
fd4a98f0 1480highlighting the day in the calendar."
9b58d144
RS		 1481;; This is messy because the diary entry may apply, but the date on which it
1482;; is based can be in a different month/year. For example, asking for the
1483;; first Monday after December 30. For large values of |n| the problem is
1484;; more grotesque.
1485 (and (= dayname (calendar-day-of-week date))
1486 (let* ((m (extract-calendar-month date))
1487 (d (extract-calendar-day date))
1488 (y (extract-calendar-year date))
1489 (limit; last (n>0) or first (n<0) possible base date for entry
1490 (calendar-nth-named-absday (- n) dayname m y d))
1491 (last-abs (if (> n 0) limit (+ limit 6)))
1492 (first-abs (if (> n 0) (- limit 6) limit))
1493 (last (calendar-gregorian-from-absolute last-abs))
1494 (first (calendar-gregorian-from-absolute first-abs))
1495 ; m1, d1 is first possible base date
1496 (m1 (extract-calendar-month first))
1497 (d1 (extract-calendar-day first))
1498 (y1 (extract-calendar-year first))
1499 ; m2, d2 is last possible base date
1500 (m2 (extract-calendar-month last))
1501 (d2 (extract-calendar-day last))
1502 (y2 (extract-calendar-year last)))
a2faecac 1503 (if (or (and (= m1 m2) ; only possible base dates in one month
d56aaa64
GM		 1504 (or (eq month t)
1505 (if (listp month)
1506 (memq m1 month)
1507 (= m1 month)))
9f596b33
RS		 1508 (let ((d (or day (if (> n 0)
1509 1
1510 (calendar-last-day-of-month m1 y1)))))
1511 (and (<= d1 d) (<= d d2))))
1512 ;; only possible base dates straddle two months
b5972d79
RS		 1513 (and (or (< y1 y2)
1514 (and (= y1 y2) (< m1 m2)))
9f596b33 1515 (or
a2faecac 1516 ;; m1, d1 works as a base date
9f596b33 1517 (and
d56aaa64
GM		 1518 (or (eq month t)
1519 (if (listp month)
1520 (memq m1 month)
1521 (= m1 month)))
9f596b33
RS		 1522 (<= d1 (or day (if (> n 0)
1523 1
1524 (calendar-last-day-of-month m1 y1)))))
a2faecac 1525 ;; m2, d2 works as a base date
d56aaa64
GM		 1526 (and (or (eq month t)
1527 (if (listp month)
1528 (memq m2 month)
1529 (= m2 month)))
9f596b33
RS		 1530 (<= (or day (if (> n 0)
1531 1
1532 (calendar-last-day-of-month m2 y2)))
1533 d2)))))
fd4a98f0 1534 (cons mark entry)))))
0808d911 1535
d56aaa64 1536
fd4a98f0 1537(defun diary-anniversary (month day year &optional mark)
0808d911
ER		 1538 "Anniversary diary entry.
1539Entry applies if date is the anniversary of MONTH, DAY, YEAR if
1540`european-calendar-style' is nil, and DAY, MONTH, YEAR if
1541`european-calendar-style' is t. Diary entry can contain `%d' or `%d%s'; the
1542%d will be replaced by the number of years since the MONTH DAY, YEAR and the
1543%s will be replaced by the ordinal ending of that number (that is, `st', `nd',
1544`rd' or `th', as appropriate. The anniversary of February 29 is considered
fd4a98f0
RS		 1545to be March 1 in non-leap years.
1546
ee58da1b 1547An optional parameter MARK specifies a face or single-character string to
fd4a98f0 1548use when highlighting the day in the calendar."
0808d911
ER		 1549 (let* ((d (if european-calendar-style
1550 month
1551 day))
1552 (m (if european-calendar-style
1553 day
1554 month))
1555 (y (extract-calendar-year date))
1556 (diff (- y year)))
1557 (if (and (= m 2) (= d 29) (not (calendar-leap-year-p y)))
1558 (setq m 3
1559 d 1))
1560 (if (and (> diff 0) (calendar-date-equal (list m d y) date))
fd4a98f0 1561 (cons mark (format entry diff (diary-ordinal-suffix diff))))))
0808d911 1562
fd4a98f0 1563(defun diary-cyclic (n month day year &optional mark)
0808d911
ER		 1564 "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
1565If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR.
1566ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of
d861718a
GM		 1567repetitions since the MONTH DAY, YEAR and %s will be replaced by the
1568ordinal ending of that number (that is, `st', `nd', `rd' or `th', as
fd4a98f0
RS		 1569appropriate.
1570
ee58da1b 1571An optional parameter MARK specifies a face or single-character string to
fd4a98f0 1572use when highlighting the day in the calendar."
0808d911
ER		 1573 (let* ((d (if european-calendar-style
1574 month
1575 day))
1576 (m (if european-calendar-style
1577 day
1578 month))
1579 (diff (- (calendar-absolute-from-gregorian date)
1580 (calendar-absolute-from-gregorian
1581 (list m d year))))
1582 (cycle (/ diff n)))
1583 (if (and (>= diff 0) (zerop (% diff n)))
fd4a98f0 1584 (cons mark (format entry cycle (diary-ordinal-suffix cycle))))))
0808d911
ER		 1585
1586(defun diary-ordinal-suffix (n)
1587 "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)"
1588 (if (or (memq (% n 100) '(11 12 13))
1589 (< 3 (% n 10)))
1590 "th"
1591 (aref ["th" "st" "nd" "rd"] (% n 10))))
1592
1593(defun diary-day-of-year ()
1594 "Day of year and number of days remaining in the year of date diary entry."
1595 (calendar-day-of-year-string date))
1596
5e11a170 1597(defcustom diary-remind-message
0808d911
ER		 1598 '("Reminder: Only "
1599 (if (= 0 (% days 7))
1600 (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks"))
1601 (concat (int-to-string days) (if (= 1 days) " day" " days")))
1602 " until "
1603 diary-entry)
1604 "*Pseudo-pattern giving form of reminder messages in the fancy diary
1605display.
4dd618ff 1606
0808d911
ER		 1607Used by the function `diary-remind', a pseudo-pattern is a list of
1608expressions that can involve the keywords `days' (a number), `date' (a list of
5e11a170
RS		 1609month, day, year), and `diary-entry' (a string)."
1610 :type 'sexp
1611 :group 'diary)
0808d911
ER		 1612
1613(defun diary-remind (sexp days &optional marking)
1614 "Provide a reminder of a diary entry.
1615SEXP is a diary-sexp. DAYS is either a single number or a list of numbers
1616indicating the number(s) of days before the event that the warning(s) should
1617occur on. If the current date is (one of) DAYS before the event indicated by
1618SEXP, then a suitable message (as specified by `diary-remind-message' is
1619returned.
1620
17b7580f
KH		 1621In addition to the reminders beforehand, the diary entry also appears on the
1622date itself.
1623
1624A `diary-nonmarking-symbol' at the beginning of the line of the diary-remind
1625entry specifies that the diary entry (not the reminder) is non-marking.
1626Marking of reminders is independent of whether the entry itself is a marking
1627or nonmarking; if optional parameter MARKING is non-nil then the reminders are
1628marked on the calendar."
1629 (let ((diary-entry (eval sexp)))
1630 (cond
1631 ;; Diary entry applies on date
1632 ((and diary-entry
1633 (or (not marking-diary-entries) marking-diary-entry))
1634 diary-entry)
1635 ;; Diary entry may apply to `days' before date
1636 ((and (integerp days)
1637 (not diary-entry); Diary entry does not apply to date
1638 (or (not marking-diary-entries) marking))
1639 (let ((date (calendar-gregorian-from-absolute
1640 (+ (calendar-absolute-from-gregorian date) days))))
07a66b97
GM		 1641 (when (setq diary-entry (eval sexp)) ; re-evaluate with adjusted date
1642 ;; Discard any mark portion from diary-anniversary, etc.
1643 (if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
1644 (mapconcat 'eval diary-remind-message ""))))
17b7580f
KH		 1645 ;; Diary entry may apply to one of a list of days before date
1646 ((and (listp days) days)
1647 (or (diary-remind sexp (car days) marking)
1648 (diary-remind sexp (cdr days) marking))))))
0808d911 1649
214e2d48 1650(defun add-to-diary-list (date string specifier &optional marker globcolor)
c47a201a 1651 "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'.
0808d911 1652Do nothing if DATE or STRING is nil."
61d094de
GM		 1653 (when (and date string)
1654 (if diary-file-name-prefix
1655 (let ((prefix (funcall diary-file-name-prefix-function
1656 (buffer-file-name))))
1657 (or (string= prefix "")
1658 (setq string (format "[%s] %s" prefix string)))))
1659 (setq diary-entries-list
1660 (append diary-entries-list
1661 (list (list date string specifier marker globcolor))))))
0808d911 1662
a46c339d
GM		 1663(defun diary-redraw-calendar ()
1664 "If `calendar-buffer' is live and diary entries are marked, redraw it."
1665 (and mark-diary-entries-in-calendar
81eb8a4a
GM		 1666 (save-excursion
1667 (redraw-calendar)))
a46c339d
GM		 1668 ;; Return value suitable for `write-contents-functions'.
1669 nil)
1670
0808d911
ER		 1671(defun make-diary-entry (string &optional nonmarking file)
1672 "Insert a diary entry STRING which may be NONMARKING in FILE.
a46c339d
GM		 1673If omitted, NONMARKING defaults to nil and FILE defaults to
1674`diary-file'. Adds `diary-redraw-calendar' to
1675`write-contents-functions' for FILE, so that the calendar will be
1676redrawn with the new entry marked, if necessary."
8ec6d48a
GM		 1677 (let ((pop-up-frames (window-dedicated-p (selected-window))))
1678 (find-file-other-window (substitute-in-file-name (or file diary-file))))
a46c339d
GM		 1679 (add-hook 'write-contents-functions 'diary-redraw-calendar nil t)
1680 (when selective-display
1681 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
1682 (setq selective-display nil)
1683 (kill-local-variable 'mode-line-format))
b8f2671f 1684 (widen)
0808d911 1685 (goto-char (point-max))
b8f2671f
JB		 1686 (when (let ((case-fold-search t))
1687 (search-backward "Local Variables:"
1688 (max (- (point-max) 3000) (point-min))
1689 t))
1690 (beginning-of-line)
1691 (insert "\n")
1692 (previous-line 1))
0808d911
ER		 1693 (insert
1694 (if (bolp) "" "\n")
1695 (if nonmarking diary-nonmarking-symbol "")
1696 string " "))
1697
1698(defun insert-diary-entry (arg)
1699 "Insert a diary entry for the date indicated by point.
1700Prefix arg will make the entry nonmarking."
1701 (interactive "P")
1702 (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t)
1703 arg))
1704
1705(defun insert-weekly-diary-entry (arg)
1706 "Insert a weekly diary entry for the day of the week indicated by point.
1707Prefix arg will make the entry nonmarking."
1708 (interactive "P")
1709 (make-diary-entry (calendar-day-name (calendar-cursor-to-date t))
1710 arg))
1711
1712(defun insert-monthly-diary-entry (arg)
1713 "Insert a monthly diary entry for the day of the month indicated by point.
1714Prefix arg will make the entry nonmarking."
1715 (interactive "P")
c87a1f38
GM		 1716 (let ((calendar-date-display-form
1717 (if european-calendar-style
1718 '(day " * ")
1719 '("* " day))))
0808d911
ER		 1720 (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
1721 arg)))
1722
1723(defun insert-yearly-diary-entry (arg)
1724 "Insert an annual diary entry for the day of the year indicated by point.
1725Prefix arg will make the entry nonmarking."
1726 (interactive "P")
c87a1f38
GM		 1727 (let ((calendar-date-display-form
1728 (if european-calendar-style
1729 '(day " " monthname)
1730 '(monthname " " day))))
0808d911
ER		 1731 (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
1732 arg)))
1733
1734(defun insert-anniversary-diary-entry (arg)
1735 "Insert an anniversary diary entry for the date given by point.
1736Prefix arg will make the entry nonmarking."
1737 (interactive "P")
c87a1f38
GM		 1738 (let ((calendar-date-display-form
1739 (if european-calendar-style
1740 '(day " " month " " year)
1741 '(month " " day " " year))))
0808d911
ER		 1742 (make-diary-entry
1743 (format "%s(diary-anniversary %s)"
1744 sexp-diary-entry-symbol
1745 (calendar-date-string (calendar-cursor-to-date t) nil t))
1746 arg)))
1747
1748(defun insert-block-diary-entry (arg)
1749 "Insert a block diary entry for the days between the point and marked date.
1750Prefix arg will make the entry nonmarking."
1751 (interactive "P")
c87a1f38
GM		 1752 (let ((calendar-date-display-form
1753 (if european-calendar-style
1754 '(day " " month " " year)
1755 '(month " " day " " year)))
0808d911
ER		 1756 (cursor (calendar-cursor-to-date t))
1757 (mark (or (car calendar-mark-ring)
1758 (error "No mark set in this buffer")))
c87a1f38 1759 start end)
0808d911
ER		 1760 (if (< (calendar-absolute-from-gregorian mark)
1761 (calendar-absolute-from-gregorian cursor))
1762 (setq start mark
1763 end cursor)
1764 (setq start cursor
1765 end mark))
1766 (make-diary-entry
1767 (format "%s(diary-block %s %s)"
1768 sexp-diary-entry-symbol
1769 (calendar-date-string start nil t)
1770 (calendar-date-string end nil t))
1771 arg)))
1772
1773(defun insert-cyclic-diary-entry (arg)
1774 "Insert a cyclic diary entry starting at the date given by point.
1775Prefix arg will make the entry nonmarking."
1776 (interactive "P")
c87a1f38
GM		 1777 (let ((calendar-date-display-form
1778 (if european-calendar-style
1779 '(day " " month " " year)
1780 '(month " " day " " year))))
0808d911
ER		 1781 (make-diary-entry
1782 (format "%s(diary-cyclic %d %s)"
1783 sexp-diary-entry-symbol
1784 (calendar-read "Repeat every how many days: "
86855ebd 1785 (lambda (x) (> x 0)))
0808d911
ER		 1786 (calendar-date-string (calendar-cursor-to-date t) nil t))
1787 arg)))
1788
86432f81 1789;;;###autoload
4fcf2701 1790(define-derived-mode diary-mode fundamental-mode
86432f81
MR		 1791 "Diary"
1792 "Major mode for editing the diary file."
1793 (set (make-local-variable 'font-lock-defaults)
1794 '(diary-font-lock-keywords t)))
1795
4fcf2701 1796(define-derived-mode fancy-diary-display-mode fundamental-mode
86432f81
MR		 1797 "Diary"
1798 "Major mode used while displaying diary entries using Fancy Display."
1799 (set (make-local-variable 'font-lock-defaults)
4e80f517
SS		 1800 '(fancy-diary-font-lock-keywords t))
1801 (define-key (current-local-map) "q" 'quit-window))
86432f81
MR		 1802
1803
1804(defvar fancy-diary-font-lock-keywords
1805 (list
1806 (cons
1807 (concat
ca2a5950
GM		 1808 (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
1809 (monthname (diary-name-pattern calendar-month-name-array nil t))
86432f81 1810 (day "[0-9]+")
e440b20e 1811 (month "[0-9]+")
86432f81
MR		 1812 (year "-?[0-9]+"))
1813 (mapconcat 'eval calendar-date-display-form ""))
1814 "\\(\\(: .*\\)\\|\\(\n +.*\\)\\)*\n=+$")
1815 'diary-face)
1816 '("^.*anniversary.*$" . font-lock-keyword-face)
1817 '("^.*birthday.*$" . font-lock-keyword-face)
1818 '("^.*Yahrzeit.*$" . font-lock-reference-face)
1819 '("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
1820 '("^Day.*omer.*$" . font-lock-builtin-face)
1821 '("^Parashat.*$" . font-lock-comment-face)
56d3bae7 1822 '("^[ \t]*[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\)?"
86432f81
MR		 1823 . font-lock-variable-name-face))
1824 "Keywords to highlight in fancy diary display")
1825
1826
1827(defun font-lock-diary-sexps (limit)
1828 "Recognize sexp diary entry for font-locking."
1829 (if (re-search-forward
1830 (concat "^" (regexp-quote diary-nonmarking-symbol)
1831 "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)")
1832 limit t)
1833 (condition-case nil
1834 (save-restriction
1835 (narrow-to-region (point-min) limit)
1836 (let ((start (point)))
1837 (forward-sexp 1)
1838 (store-match-data (list start (point)))
1839 t))
1840 (error t))))
1841
ca2a5950
GM		 1842(defun font-lock-diary-date-forms (month-array &optional symbol abbrev-array)
1843 "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
86432f81 1844If given, optional SYMBOL must be a prefix to entries.
ca2a5950
GM		 1845If optional ABBREV-ARRAY is present, the abbreviations constructed
1846from this array by the function `calendar-abbrev-construct' are
1847matched (with or without a final `.'), in addition to the full month
1848names."
1849 (let ((dayname (diary-name-pattern calendar-day-name-array
1850 calendar-day-abbrev-array t))
1851 (monthname (format "\\(%s\\|\\*\\)"
1852 (diary-name-pattern month-array abbrev-array)))
c87a1f38
GM		 1853 (month "\\([0-9]+\\|\\*\\)")
1854 (day "\\([0-9]+\\|\\*\\)")
1855 (year "-?\\([0-9]+\\|\\*\\)"))
86432f81
MR		 1856 (mapcar '(lambda (x)
1857 (cons
1858 (concat "^" (regexp-quote diary-nonmarking-symbol) "?"
1859 (if symbol (regexp-quote symbol) "") "\\("
1860 (mapconcat 'eval
1861 ;; If backup, omit first item (backup)
1862 ;; and last item (not part of date)
1863 (if (equal (car x) 'backup)
1864 (reverse (cdr (reverse (cdr x))))
1865 x)
1866 "")
1867 ;; With backup, last item is not part of date
1868 (if (equal (car x) 'backup)
1869 (concat "\\)" (eval (car (reverse x))))
1870 "\\)"))
1871 '(1 diary-face)))
1872 diary-date-forms)))
1873
ca2a5950
GM		 1874(eval-when-compile (require 'cal-hebrew)
1875 (require 'cal-islam))
1876
86432f81
MR		 1877(defvar diary-font-lock-keywords
1878 (append
ca2a5950
GM		 1879 (font-lock-diary-date-forms calendar-month-name-array
1880 nil calendar-month-abbrev-array)
c87a1f38
GM		 1881 (when (or (memq 'mark-hebrew-diary-entries
1882 nongregorian-diary-marking-hook)
1883 (memq 'list-hebrew-diary-entries
1884 nongregorian-diary-listing-hook))
1885 (require 'cal-hebrew)
1886 (font-lock-diary-date-forms
1887 calendar-hebrew-month-name-array-leap-year
ca2a5950 1888 hebrew-diary-entry-symbol))
c87a1f38
GM		 1889 (when (or (memq 'mark-islamic-diary-entries
1890 nongregorian-diary-marking-hook)
1891 (memq 'list-islamic-diary-entries
1892 nongregorian-diary-listing-hook))
1893 (require 'cal-islam)
1894 (font-lock-diary-date-forms
1895 calendar-islamic-month-name-array
ca2a5950 1896 islamic-diary-entry-symbol))
86432f81
MR		 1897 (list
1898 (cons
1899 (concat "^" (regexp-quote diary-include-string) ".*$")
1900 'font-lock-keyword-face)
1901 (cons
1902 (concat "^" (regexp-quote diary-nonmarking-symbol)
1903 "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)")
1904 '(1 font-lock-reference-face))
1905 (cons
1906 (concat "^" (regexp-quote diary-nonmarking-symbol))
1907 'font-lock-reference-face)
1908 (cons
1909 (concat "^" (regexp-quote diary-nonmarking-symbol)
1910 "?\\(" (regexp-quote hebrew-diary-entry-symbol) "\\)")
1911 '(1 font-lock-reference-face))
1912 (cons
1913 (concat "^" (regexp-quote diary-nonmarking-symbol)
1914 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
1915 '(1 font-lock-reference-face))
1916 '(font-lock-diary-sexps . font-lock-keyword-face)
56d3bae7 1917 '("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"
86432f81
MR		 1918 . font-lock-function-name-face)))
1919 "Forms to highlight in diary-mode")
a1506d29 1920
86432f81 1921
cb7c17be
GM		 1922;; Following code from Dave Love <fx@gnu.org>.
1923;; Import Outlook-format appointments from mail messages in Gnus or
1924;; Rmail using command `diary-from-outlook'. This, or the specialized
1925;; functions `diary-from-outlook-gnus' and `diary-from-outlook-rmail',
1926;; could be run from hooks to notice appointments automatically (in
1927;; which case they will prompt about adding to the diary). The
1928;; message formats recognized are customizable through
1929;; `diary-outlook-formats'.
1930
1931(defcustom diary-outlook-formats
1932 '(
1933 ;; When: 11 October 2001 12:00-14:00 (GMT) Greenwich Mean Time : Dublin, ...
1934 ;; [Current UK format? The timezone is meaningless. Sometimes the
1935 ;; Where is missing.]
1936 ("When: \\([0-9]+ [[:alpha:]]+ [0-9]+\\) \
1937\\([^ ]+\\) [^\n]+
1938\[^\n]+
1939\\(?:Where: \\([^\n]+\\)\n+\\)?
1940\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*"
1941 . "\\1\n \\2 %s, \\3")
1942 ;; When: Tuesday, April 30, 2002 03:00 PM-03:30 PM (GMT) Greenwich Mean ...
1943 ;; [Old UK format?]
1944 ("^When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \\([0-9]\\{4\\}\\) \
1945\\([^ ]+\\) [^\n]+
1946\[^\n]+
1947\\(?:Where: \\([^\n]+\\)\\)?\n+"
1948 . "\\2 \\1 \\3\n \\4 %s, \\5")
1949 (
1950 ;; German format, apparently.
1951 "^Zeit: [^ ]+, +\\([0-9]+\\)\. +\\([[:upper:]][[:lower:]][[:lower:]]\\)[^ ]* +\\([0-9]+\\) +\\([^ ]+\\).*$"
1952 . "\\1 \\2 \\3\n \\4 %s"))
1953 "Alist of regexps matching message text and replacement text.
1954
1955The regexp must match the start of the message text containing an
1956appointment, but need not include a leading `^'. If it matches the
1957current message, a diary entry is made from the corresponding
1958template. If the template is a string, it should be suitable for
1959passing to `replace-match', and so will have occurrences of `\\D' to
1960substitute the match for the Dth subexpression. It must also contain
1961a single `%s' which will be replaced with the text of the message's
1962Subject field. Any other `%' characters must be doubled, so that the
1963template can be passed to `format'.
1964
1965If the template is actually a function, it is called with the message
1966body text as argument, and may use `match-string' etc. to make a
1967template following the rules above."
1968 :type '(alist :key-type (regexp :tag "Regexp matching time/place")
1969 :value-type (choice
1970 (string :tag "Template for entry")
1971 (function :tag "Unary function providing template")))
bf247b6e 1972 :version "22.1"
cb7c17be
GM		 1973 :group 'diary)
1974
1975
1976;; Dynamically bound.
1977(defvar body)
1978(defvar subject)
1979
1980(defun diary-from-outlook-internal (&optional test-only)
1981 "Snarf a diary entry from a message assumed to be from MS Outlook.
1982Assumes `body' is bound to a string comprising the body of the message and
1983`subject' is bound to a string comprising its subject.
1984Arg TEST-ONLY non-nil means return non-nil if and only if the
1985message contains an appointment, don't make a diary entry."
1986 (catch 'finished
1987 (let (format-string)
1988 (dotimes (i (length diary-outlook-formats))
1989 (when (eq 0 (string-match (car (nth i diary-outlook-formats))
1990 body))
1991 (unless test-only
1992 (setq format-string (cdr (nth i diary-outlook-formats)))
1993 (save-excursion
1994 (save-window-excursion
1995 ;; Fixme: References to optional fields in the format
1996 ;; are treated literally, not replaced by the empty
1997 ;; string. I think this is an Emacs bug.
1998 (make-diary-entry
1999 (format (replace-match (if (functionp format-string)
2000 (funcall format-string body)
2001 format-string)
2002 t nil (match-string 0 body))
2003 subject))
2004 (save-buffer))))
2005 (throw 'finished t))))
2006 nil))
2007
3e58bf8b 2008(defun diary-from-outlook (&optional noconfirm)
cb7c17be 2009 "Maybe snarf diary entry from current Outlook-generated message.
e6a70f09 2010Currently knows about Gnus and Rmail modes. Unless the optional
3e58bf8b 2011argument NOCONFIRM is non-nil (which is the case when this
e6a70f09
GM		 2012function is called interactively), then if an entry is found the
2013user is asked to confirm its addition."
2014 (interactive "p")
cb7c17be
GM		 2015 (let ((func (cond
2016 ((eq major-mode 'rmail-mode)
2017 #'diary-from-outlook-rmail)
2018 ((memq major-mode '(gnus-summary-mode gnus-article-mode))
2019 #'diary-from-outlook-gnus)
2020 (t (error "Don't know how to snarf in `%s'" major-mode)))))
3e58bf8b 2021 (funcall func noconfirm)))
cb7c17be
GM		 2022
2023
2024(defvar gnus-article-mime-handles)
2025(defvar gnus-article-buffer)
2026
2027(autoload 'gnus-fetch-field "gnus-util")
2028(autoload 'gnus-narrow-to-body "gnus")
2029(autoload 'mm-get-part "mm-decode")
2030
3e58bf8b 2031(defun diary-from-outlook-gnus (&optional noconfirm)
cb7c17be 2032 "Maybe snarf diary entry from Outlook-generated message in Gnus.
3e58bf8b 2033Unless the optional argument NOCONFIRM is non-nil (which is the case when
e6a70f09
GM		 2034this function is called interactively), then if an entry is found the
2035user is asked to confirm its addition.
2036Add this function to `gnus-article-prepare-hook' to notice appointments
cb7c17be 2037automatically."
e6a70f09 2038 (interactive "p")
cb7c17be
GM		 2039 (with-current-buffer gnus-article-buffer
2040 (let ((subject (gnus-fetch-field "subject"))
2041 (body (if gnus-article-mime-handles
2042 ;; We're multipart. Don't get confused by part
2043 ;; buttons &c. Assume info is in first part.
2044 (mm-get-part (nth 1 gnus-article-mime-handles))
2045 (save-restriction
2046 (gnus-narrow-to-body)
2047 (buffer-string)))))
2048 (when (diary-from-outlook-internal t)
3e58bf8b 2049 (when (or noconfirm (y-or-n-p "Snarf diary entry? "))
cb7c17be
GM		 2050 (diary-from-outlook-internal)
2051 (message "Diary entry added"))))))
2052
2053(custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus)
2054
2055
2056(defvar rmail-buffer)
2057
3e58bf8b 2058(defun diary-from-outlook-rmail (&optional noconfirm)
e6a70f09 2059 "Maybe snarf diary entry from Outlook-generated message in Rmail.
3e58bf8b 2060Unless the optional argument NOCONFIRM is non-nil (which is the case when
e6a70f09
GM		 2061this function is called interactively), then if an entry is found the
2062user is asked to confirm its addition."
2063 (interactive "p")
cb7c17be
GM		 2064 (with-current-buffer rmail-buffer
2065 (let ((subject (mail-fetch-field "subject"))
2066 (body (buffer-substring (save-excursion
2067 (rfc822-goto-eoh)
2068 (point))
2069 (point-max))))
2070 (when (diary-from-outlook-internal t)
3e58bf8b 2071 (when (or noconfirm (y-or-n-p "Snarf diary entry? "))
cb7c17be
GM		 2072 (diary-from-outlook-internal)
2073 (message "Diary entry added"))))))
2074
2075
e4ca7ef9 2076(provide 'diary-lib)
0808d911 2077
ab5796a9 2078;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
e4ca7ef9 2079;;; diary-lib.el ends here
Unnamed repository; edit this file 'description' to name the repository.