HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(Frename_file): Undo last change: no need to ifdef away
[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
ccacbcec
MB		 546(defface diary-button '((((type pc) (class color))
547 (:foreground "lightblue")))
ebea495a 548 "Default face used for buttons."
bf247b6e 549 :version "22.1"
ebea495a 550 :group 'diary)
ccacbcec
MB		 551;; backward-compatibility alias
552(put 'diary-button-face 'face-alias 'diary-button)
86432f81
MR		 553
554(define-button-type 'diary-entry
555 'action #'diary-goto-entry
ccacbcec 556 'face 'diary-button)
86432f81
MR		 557
558(defun diary-goto-entry (button)
559 (let ((marker (button-get button 'marker)))
560 (when marker
561 (pop-to-buffer (marker-buffer marker))
562 (goto-char (marker-position marker)))))
563
0808d911
ER		 564(defun fancy-diary-display ()
565 "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
566This function is provided for optional use as the `diary-display-hook'."
567 (save-excursion;; Turn off selective-display in the diary file's buffer.
cdfeb73f 568 (set-buffer (find-buffer-visiting (substitute-in-file-name diary-file)))
0808d911
ER		 569 (let ((diary-modified (buffer-modified-p)))
570 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
571 (setq selective-display nil)
572 (kill-local-variable 'mode-line-format)
573 (set-buffer-modified-p diary-modified)))
574 (if (or (not diary-entries-list)
575 (and (not (cdr diary-entries-list))
576 (string-equal (car (cdr (car diary-entries-list))) "")))
577 (let* ((holiday-list (if holidays-in-diary-buffer
578 (check-calendar-holidays original-date)))
579 (msg (format "No diary entries for %s %s"
580 (concat date-string (if holiday-list ":" ""))
581 (mapconcat 'identity holiday-list "; "))))
582 (if (<= (length msg) (frame-width))
b3099c46 583 (message "%s" msg)
0808d911
ER		 584 (set-buffer (get-buffer-create holiday-buffer))
585 (setq buffer-read-only nil)
0808d911
ER		 586 (erase-buffer)
587 (insert (mapconcat 'identity holiday-list "\n"))
588 (goto-char (point-min))
589 (set-buffer-modified-p nil)
590 (setq buffer-read-only t)
591 (display-buffer holiday-buffer)
592 (message "No diary entries for %s" date-string)))
593 (save-excursion;; Prepare the fancy diary buffer.
594 (set-buffer (make-fancy-diary-buffer))
595 (setq buffer-read-only nil)
596 (let ((entry-list diary-entries-list)
597 (holiday-list)
598 (holiday-list-last-month 1)
599 (holiday-list-last-year 1)
600 (date (list 0 0 0)))
601 (while entry-list
602 (if (not (calendar-date-equal date (car (car entry-list))))
603 (progn
604 (setq date (car (car entry-list)))
605 (and holidays-in-diary-buffer
606 (calendar-date-compare
607 (list (list holiday-list-last-month
608 (calendar-last-day-of-month
609 holiday-list-last-month
610 holiday-list-last-year)
611 holiday-list-last-year))
612 (list date))
613 ;; We need to get the holidays for the next 3 months.
614 (setq holiday-list-last-month
615 (extract-calendar-month date))
616 (setq holiday-list-last-year
617 (extract-calendar-year date))
de3fce91
GM		 618 (progn
619 (increment-calendar-month
620 holiday-list-last-month holiday-list-last-year 1)
621 t)
0808d911
ER		 622 (setq holiday-list
623 (let ((displayed-month holiday-list-last-month)
624 (displayed-year holiday-list-last-year))
625 (calendar-holiday-list)))
626 (increment-calendar-month
627 holiday-list-last-month holiday-list-last-year 1))
628 (let* ((date-string (calendar-date-string date))
629 (date-holiday-list
630 (let ((h holiday-list)
631 (d))
632 ;; Make a list of all holidays for date.
633 (while h
634 (if (calendar-date-equal date (car (car h)))
635 (setq d (append d (cdr (car h)))))
636 (setq h (cdr h)))
637 d)))
638 (insert (if (= (point) (point-min)) "" ?\n) date-string)
639 (if date-holiday-list (insert ": "))
72fb78ce
ER		 640 (let* ((l (current-column))
641 (longest 0))
86855ebd
SM		 642 (insert (mapconcat (lambda (x)
643 (if (< longest (length x))
644 (setq longest (length x)))
645 x)
72fb78ce
ER		 646 date-holiday-list
647 (concat "\n" (make-string l ? ))))
648 (insert ?\n (make-string (+ l longest) ?=) ?\n)))))
c47a201a
JB		 649
650 (setq entry (car (cdr (car entry-list))))
651 (if (< 0 (length entry))
652 (progn
653 (if (nth 3 (car entry-list))
654 (insert-button (concat entry "\n")
655 'marker (nth 3 (car entry-list))
656 :type 'diary-entry)
657 (insert entry ?\n))
658 (save-excursion
61d094de
GM		 659 (let* ((marks (nth 4 (car entry-list)))
660 (temp-face (make-symbol
661 (apply
662 'concat "temp-face-"
663 (mapcar '(lambda (sym)
664 (if (stringp sym)
665 sym
666 (symbol-name sym)))
667 marks))))
6ecab45e
GM		 668 (faceinfo marks))
669 (make-face temp-face)
56d3bae7 670 ;; Remove :face info from the marks,
61d094de 671 ;; copy the face info into temp-face
61d094de
GM		 672 (while (setq faceinfo (memq :face faceinfo))
673 (copy-face (read (nth 1 faceinfo)) temp-face)
674 (setcar faceinfo nil)
675 (setcar (cdr faceinfo) nil))
676 (setq marks (delq nil marks))
c47a201a 677 ;; Apply the font aspects
61d094de
GM		 678 (apply 'set-face-attribute temp-face nil marks)
679 (search-backward entry)
680 (overlay-put
681 (make-overlay (match-beginning 0) (match-end 0))
682 'face temp-face)))))
c47a201a 683 (setq entry-list (cdr entry-list))))
0808d911
ER		 684 (set-buffer-modified-p nil)
685 (goto-char (point-min))
686 (setq buffer-read-only t)
687 (display-buffer fancy-diary-buffer)
86432f81 688 (fancy-diary-display-mode)
9edfb3d2 689 (calendar-set-mode-line date-string)
0808d911
ER		 690 (message "Preparing diary...done"))))
691
692(defun make-fancy-diary-buffer ()
693 "Create and return the initial fancy diary buffer."
694 (save-excursion
695 (set-buffer (get-buffer-create fancy-diary-buffer))
696 (setq buffer-read-only nil)
0808d911
ER		 697 (calendar-set-mode-line "Diary Entries")
698 (erase-buffer)
699 (set-buffer-modified-p nil)
700 (setq buffer-read-only t)
701 (get-buffer fancy-diary-buffer)))
702
703(defun print-diary-entries ()
704 "Print a hard copy of the diary display.
705
706If the simple diary display is being used, prepare a temp buffer with the
707visible lines of the diary buffer, add a heading line composed from the mode
708line, print the temp buffer, and destroy it.
709
710If the fancy diary display is being used, just print the buffer.
711
712The hooks given by the variable `print-diary-entries-hook' are called to do
713the actual printing."
714 (interactive)
715 (if (bufferp (get-buffer fancy-diary-buffer))
716 (save-excursion
717 (set-buffer (get-buffer fancy-diary-buffer))
718 (run-hooks 'print-diary-entries-hook))
719 (let ((diary-buffer
cdfeb73f 720 (find-buffer-visiting (substitute-in-file-name diary-file))))
0808d911
ER		 721 (if diary-buffer
722 (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*"))
723 (heading))
724 (save-excursion
725 (set-buffer diary-buffer)
726 (setq heading
727 (if (not (stringp mode-line-format))
728 "All Diary Entries"
729 (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
730 (substring mode-line-format
731 (match-beginning 1) (match-end 1))))
732 (copy-to-buffer temp-buffer (point-min) (point-max))
733 (set-buffer temp-buffer)
734 (while (re-search-forward "\^M.*$" nil t)
735 (replace-match ""))
736 (goto-char (point-min))
737 (insert heading "\n"
738 (make-string (length heading) ?=) "\n")
739 (run-hooks 'print-diary-entries-hook)
740 (kill-buffer temp-buffer)))
741 (error "You don't have a diary buffer!")))))
742
743(defun show-all-diary-entries ()
744 "Show all of the diary entries in the diary file.
745This function gets rid of the selective display of the diary file so that
746all entries, not just some, are visible. If there is no diary buffer, one
747is created."
748 (interactive)
6ecab45e
GM		 749 (let ((d-file (diary-check-diary-file))
750 (pop-up-frames (window-dedicated-p (selected-window))))
c87a1f38
GM		 751 (save-excursion
752 (set-buffer (or (find-buffer-visiting d-file)
753 (find-file-noselect d-file t)))
754 (let ((buffer-read-only nil)
755 (diary-modified (buffer-modified-p)))
756 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
757 (setq selective-display nil
758 mode-line-format default-mode-line-format)
759 (display-buffer (current-buffer))
760 (set-buffer-modified-p diary-modified)))))
8ffbfaa9 761
4dd618ff 762(defcustom diary-mail-addr
c87a1f38 763 (if (boundp 'user-mail-address) user-mail-address "")
8ffbfaa9
RS		 764 "*Email address that `diary-mail-entries' will send email to."
765 :group 'diary
c87a1f38 766 :type 'string
cd32a7ba 767 :version "20.3")
8ffbfaa9
RS		 768
769(defcustom diary-mail-days 7
c87a1f38 770 "*Default number of days for `diary-mail-entries' to check."
8ffbfaa9 771 :group 'diary
cd32a7ba
DN		 772 :type 'integer
773 :version "20.3")
8ffbfaa9 774
f91adf29 775;;;###autoload
8ffbfaa9
RS		 776(defun diary-mail-entries (&optional ndays)
777 "Send a mail message showing diary entries for next NDAYS days.
778If no prefix argument is given, NDAYS is set to `diary-mail-days'.
c87a1f38 779Mail is sent to the address specified by `diary-mail-addr'.
8ffbfaa9
RS		 780
781You can call `diary-mail-entries' every night using an at/cron job.
782For example, this script will run the program at 2am daily. Since
783`emacs -batch' does not load your `.emacs' file, you must ensure that
784all relevant variables are set, as done here.
785
786#!/bin/sh
787# diary-rem.sh -- repeatedly run the Emacs diary-reminder
788emacs -batch \\
789-eval \"(setq diary-mail-days 3 \\
c87a1f38 790 diary-file \\\"/path/to/diary.file\\\" \\
8ffbfaa9
RS		 791 european-calendar-style t \\
792 diary-mail-addr \\\"user@host.name\\\" )\" \\
4dd618ff 793-l diary-lib -f diary-mail-entries
8ffbfaa9
RS		 794at -f diary-rem.sh 0200 tomorrow
795
796You may have to tweak the syntax of the `at' command to suit your
797system. Alternatively, you can specify a cron entry:
7980 1 * * * diary-rem.sh
799to run it every morning at 1am."
d56aaa64 800 (interactive "P")
c87a1f38
GM		 801 (if (string-equal diary-mail-addr "")
802 (error "You must set `diary-mail-addr' to use this command")
803 (let ((diary-display-hook 'fancy-diary-display))
804 (list-diary-entries (calendar-current-date) (or ndays diary-mail-days)))
805 (compose-mail diary-mail-addr
806 (concat "Diary entries generated "
807 (calendar-date-string (calendar-current-date))))
808 (insert
809 (if (get-buffer fancy-diary-buffer)
810 (save-excursion
811 (set-buffer fancy-diary-buffer)
812 (buffer-substring (point-min) (point-max)))
813 "No entries found"))
814 (call-interactively (get mail-user-agent 'sendfunc))))
d56aaa64 815
ca2a5950
GM		 816(defun diary-name-pattern (string-array &optional abbrev-array paren)
817 "Return a regexp matching the strings in the array STRING-ARRAY.
818If the optional argument ABBREV-ARRAY is present, then the function
819`calendar-abbrev-construct' is used to construct abbreviations from the
820two supplied arrays. The returned regexp will then also match these
821abbreviations, with or without final `.' characters. If the optional
822argument PAREN is non-nil, the regexp is surrounded by parentheses."
823 (regexp-opt (append string-array
824 (if abbrev-array
825 (calendar-abbrev-construct abbrev-array
826 string-array))
827 (if abbrev-array
828 (calendar-abbrev-construct abbrev-array
829 string-array
830 'period))
831 nil)
832 paren))
0808d911
ER		 833
834(defvar marking-diary-entries nil
835 "True during the marking of diary entries, nil otherwise.")
836
837(defvar marking-diary-entry nil
838 "True during the marking of diary entries, if current entry is marking.")
839
81eb8a4a 840(defun mark-diary-entries (&optional redraw)
0808d911 841 "Mark days in the calendar window that have diary entries.
81eb8a4a
GM		 842Each entry in the diary file visible in the calendar window is
843marked. After the entries are marked, the hooks
844`nongregorian-diary-marking-hook' and `mark-diary-entries-hook'
845are run. If the optional argument REDRAW is non-nil (which is
846the case interactively, for example) then any existing diary
847marks are first removed. This is intended to deal with deleted
848diary entries."
849 (interactive "p")
850 ;; To remove any deleted diary entries. Do not redraw when:
851 ;; i) processing #include diary files (else only get the marks from
852 ;; the last #include file processed).
853 ;; ii) called via calendar-redraw (since calendar has already been
854 ;; erased).
855 ;; Use of REDRAW handles both of these cases.
856 (when (and redraw mark-diary-entries-in-calendar)
a46c339d
GM		 857 (setq mark-diary-entries-in-calendar nil)
858 (redraw-calendar))
c87a1f38
GM		 859 (let ((marking-diary-entries t)
860 file-glob-attrs marks)
861 (save-excursion
862 (set-buffer (find-file-noselect (diary-check-diary-file) t))
d0897fa5 863 (setq mark-diary-entries-in-calendar t)
c87a1f38
GM		 864 (message "Marking diary entries...")
865 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
866 (let ((d diary-date-forms)
867 (old-diary-syntax-table (syntax-table))
868 temp)
869 (set-syntax-table diary-syntax-table)
870 (while d
871 (let* ((date-form (if (equal (car (car d)) 'backup)
872 (cdr (car d))
873 (car d)));; ignore 'backup directive
ca2a5950
GM		 874 (dayname
875 (diary-name-pattern calendar-day-name-array
876 calendar-day-abbrev-array))
c87a1f38 877 (monthname
ca2a5950
GM		 878 (format "%s\\|\\*"
879 (diary-name-pattern calendar-month-name-array
880 calendar-month-abbrev-array)))
c87a1f38
GM		 881 (month "[0-9]+\\|\\*")
882 (day "[0-9]+\\|\\*")
883 (year "[0-9]+\\|\\*")
884 (l (length date-form))
885 (d-name-pos (- l (length (memq 'dayname date-form))))
886 (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
887 (m-name-pos (- l (length (memq 'monthname date-form))))
888 (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
889 (d-pos (- l (length (memq 'day date-form))))
890 (d-pos (if (/= l d-pos) (+ 2 d-pos)))
891 (m-pos (- l (length (memq 'month date-form))))
892 (m-pos (if (/= l m-pos) (+ 2 m-pos)))
893 (y-pos (- l (length (memq 'year date-form))))
894 (y-pos (if (/= l y-pos) (+ 2 y-pos)))
895 (regexp
896 (concat
897 "\\(\\`\\|\^M\\|\n\\)\\("
898 (mapconcat 'eval date-form "\\)\\(")
899 "\\)"))
900 (case-fold-search t))
901 (goto-char (point-min))
902 (while (re-search-forward regexp nil t)
903 (let* ((dd-name
904 (if d-name-pos
905 (buffer-substring-no-properties
906 (match-beginning d-name-pos)
907 (match-end d-name-pos))))
908 (mm-name
909 (if m-name-pos
910 (buffer-substring-no-properties
911 (match-beginning m-name-pos)
912 (match-end m-name-pos))))
027a4b6b 913 (mm (string-to-number
c87a1f38
GM		 914 (if m-pos
915 (buffer-substring-no-properties
916 (match-beginning m-pos)
917 (match-end m-pos))
918 "")))
027a4b6b 919 (dd (string-to-number
c87a1f38
GM		 920 (if d-pos
921 (buffer-substring-no-properties
922 (match-beginning d-pos)
923 (match-end d-pos))
924 "")))
925 (y-str (if y-pos
926 (buffer-substring-no-properties
927 (match-beginning y-pos)
928 (match-end y-pos))))
929 (yy (if (not y-str)
930 0
931 (if (and (= (length y-str) 2)
932 abbreviated-calendar-year)
933 (let* ((current-y
934 (extract-calendar-year
935 (calendar-current-date)))
027a4b6b 936 (y (+ (string-to-number y-str)
c87a1f38
GM		 937 (* 100
938 (/ current-y 100)))))
939 (if (> (- y current-y) 50)
940 (- y 100)
941 (if (> (- current-y y) 50)
942 (+ y 100)
943 y)))
027a4b6b 944 (string-to-number y-str))))
c87a1f38
GM		 945 (save-excursion
946 (setq entry (buffer-substring-no-properties
947 (point) (line-end-position))
948 temp (diary-pull-attrs entry file-glob-attrs)
949 entry (nth 0 temp)
950 marks (nth 1 temp))))
951 (if dd-name
952 (mark-calendar-days-named
abc178a0 953 (cdr (assoc-string
ca2a5950 954 dd-name
c87a1f38
GM		 955 (calendar-make-alist
956 calendar-day-name-array
abc178a0 957 0 nil calendar-day-abbrev-array) t)) marks)
c87a1f38 958 (if mm-name
ca2a5950
GM		 959 (setq mm
960 (if (string-equal mm-name "*") 0
abc178a0 961 (cdr (assoc-string
ca2a5950 962 mm-name
c87a1f38
GM		 963 (calendar-make-alist
964 calendar-month-name-array
abc178a0 965 1 nil calendar-month-abbrev-array) t)))))
c87a1f38
GM		 966 (mark-calendar-date-pattern mm dd yy marks))))
967 (setq d (cdr d))))
968 (mark-sexp-diary-entries)
969 (run-hooks 'nongregorian-diary-marking-hook
970 'mark-diary-entries-hook)
971 (set-syntax-table old-diary-syntax-table)
972 (message "Marking diary entries...done")))))
0808d911
ER		 973
974(defun mark-sexp-diary-entries ()
975 "Mark days in the calendar window that have sexp diary entries.
976Each entry in the diary file (or included files) visible in the calendar window
977is marked. See the documentation for the function `list-sexp-diary-entries'."
978 (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol))
979 (s-entry (concat "\\(\\`\\|\^M\\|\n\\)\\("
c87a1f38 980 sexp-mark "(\\)\\|\\("
0808d911 981 (regexp-quote diary-nonmarking-symbol)
c87a1f38
GM		 982 sexp-mark "(diary-remind\\)"))
983 (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
984 m y first-date last-date mark file-glob-attrs)
0808d911
ER		 985 (save-excursion
986 (set-buffer calendar-buffer)
987 (setq m displayed-month)
988 (setq y displayed-year))
989 (increment-calendar-month m y -1)
990 (setq first-date
991 (calendar-absolute-from-gregorian (list m 1 y)))
992 (increment-calendar-month m y 2)
993 (setq last-date
994 (calendar-absolute-from-gregorian
995 (list m (calendar-last-day-of-month m y) y)))
996 (goto-char (point-min))
997 (while (re-search-forward s-entry nil t)
c87a1f38 998 (setq marking-diary-entry (char-equal (preceding-char) ?\())
0808d911
ER		 999 (re-search-backward "(")
1000 (let ((sexp-start (point))
61d094de 1001 sexp entry entry-start line-start marks)
0808d911 1002 (forward-sexp)
e6c3bfbc 1003 (setq sexp (buffer-substring-no-properties sexp-start (point)))
0808d911
ER		 1004 (save-excursion
1005 (re-search-backward "\^M\\|\n\\|\\`")
1006 (setq line-start (point)))
1007 (forward-char 1)
1008 (if (and (or (char-equal (preceding-char) ?\^M)
1009 (char-equal (preceding-char) ?\n))
1010 (not (looking-at " \\|\^I")))
1011 (progn;; Diary entry consists only of the sexp
1012 (backward-char 1)
1013 (setq entry ""))
1014 (setq entry-start (point))
7ff02048 1015 ;; Find end of entry
0808d911
ER		 1016 (re-search-forward "\^M\\|\n" nil t)
1017 (while (looking-at " \\|\^I")
94d1817d
KH		 1018 (or (re-search-forward "\^M\\|\n" nil t)
1019 (re-search-forward "$" nil t)))
7ff02048
KH		 1020 (if (or (char-equal (preceding-char) ?\^M)
1021 (char-equal (preceding-char) ?\n))
1022 (backward-char 1))
e6c3bfbc 1023 (setq entry (buffer-substring-no-properties entry-start (point)))
0808d911
ER		 1024 (while (string-match "[\^M]" entry)
1025 (aset entry (match-beginning 0) ?\n )))
1026 (calendar-for-loop date from first-date to last-date do
fd4a98f0
RS		 1027 (if (setq mark (diary-sexp-entry sexp entry
1028 (calendar-gregorian-from-absolute date)))
c47a201a
JB		 1029 (progn
1030 (setq marks (diary-pull-attrs entry file-glob-attrs)
61d094de 1031 marks (nth 1 (diary-pull-attrs entry file-glob-attrs)))
c47a201a 1032 (mark-visible-calendar-date
4e80f517 1033 (calendar-gregorian-from-absolute date)
c47a201a
JB		 1034 (if (< 0 (length marks))
1035 marks
1036 (if (consp mark)
1037 (car mark)))))))))))
0808d911
ER		 1038
1039(defun mark-included-diary-files ()
1040 "Mark the diary entries from other diary files with those of the diary file.
1041This function is suitable for use as the `mark-diary-entries-hook'; it enables
1042you to use shared diary files together with your own. The files included are
1043specified in the diary-file by lines of this form:
1044 #include \"filename\"
1045This is recursive; that is, #include directives in diary files thus included
1046are obeyed. You can change the `#include' to some other string by
1047changing the variable `diary-include-string'."
1048 (goto-char (point-min))
1049 (while (re-search-forward
1050 (concat
1051 "\\(\\`\\|\^M\\|\n\\)"
1052 (regexp-quote diary-include-string)
1053 " \"\\([^\"]*\\)\"")
1054 nil t)
bf87510a
GM		 1055 (let* ((diary-file (substitute-in-file-name
1056 (match-string-no-properties 2)))
1057 (mark-diary-entries-hook 'mark-included-diary-files)
1058 (dbuff (find-buffer-visiting diary-file)))
0808d911
ER		 1059 (if (file-exists-p diary-file)
1060 (if (file-readable-p diary-file)
1061 (progn
1062 (mark-diary-entries)
bf87510a
GM		 1063 (unless dbuff
1064 (kill-buffer (find-buffer-visiting diary-file))))
0808d911
ER		 1065 (beep)
1066 (message "Can't read included diary file %s" diary-file)
1067 (sleep-for 2))
1068 (beep)
1069 (message "Can't find included diary file %s" diary-file)
1070 (sleep-for 2))))
1071 (goto-char (point-min)))
1072
c47a201a 1073(defun mark-calendar-days-named (dayname &optional color)
0808d911
ER		 1074 "Mark all dates in the calendar window that are day DAYNAME of the week.
10750 means all Sundays, 1 means all Mondays, and so on."
1076 (save-excursion
1077 (set-buffer calendar-buffer)
1078 (let ((prev-month displayed-month)
1079 (prev-year displayed-year)
1080 (succ-month displayed-month)
1081 (succ-year displayed-year)
1082 (last-day)
1083 (day))
1084 (increment-calendar-month succ-month succ-year 1)
1085 (increment-calendar-month prev-month prev-year -1)
1086 (setq day (calendar-absolute-from-gregorian
1087 (calendar-nth-named-day 1 dayname prev-month prev-year)))
1088 (setq last-day (calendar-absolute-from-gregorian
1089 (calendar-nth-named-day -1 dayname succ-month succ-year)))
1090 (while (<= day last-day)
c47a201a 1091 (mark-visible-calendar-date (calendar-gregorian-from-absolute day) color)
0808d911
ER		 1092 (setq day (+ day 7))))))
1093
c47a201a 1094(defun mark-calendar-date-pattern (month day year &optional color)
0808d911
ER		 1095 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
1096A value of 0 in any position is a wildcard."
1097 (save-excursion
1098 (set-buffer calendar-buffer)
1099 (let ((m displayed-month)
1100 (y displayed-year))
1101 (increment-calendar-month m y -1)
1102 (calendar-for-loop i from 0 to 2 do
c47a201a 1103 (mark-calendar-month m y month day year color)
0808d911
ER		 1104 (increment-calendar-month m y 1)))))
1105
c47a201a 1106(defun mark-calendar-month (month year p-month p-day p-year &optional color)
0808d911
ER		 1107 "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
1108A value of 0 in any position of the pattern is a wildcard."
1109 (if (or (and (= month p-month)
1110 (or (= p-year 0) (= year p-year)))
1111 (and (= p-month 0)
1112 (or (= p-year 0) (= year p-year))))
1113 (if (= p-day 0)
1114 (calendar-for-loop
1115 i from 1 to (calendar-last-day-of-month month year) do
c47a201a
JB		 1116 (mark-visible-calendar-date (list month i year) color))
1117 (mark-visible-calendar-date (list month p-day year) color))))
0808d911
ER		 1118
1119(defun sort-diary-entries ()
1120 "Sort the list of diary entries by time of day."
1121 (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
1122
1123(defun diary-entry-compare (e1 e2)
1124 "Returns t if E1 is earlier than E2."
1125 (or (calendar-date-compare e1 e2)
1126 (and (calendar-date-equal (car e1) (car e2))
4dd618ff
SS		 1127 (let* ((ts1 (cadr e1)) (t1 (diary-entry-time ts1))
1128 (ts2 (cadr e2)) (t2 (diary-entry-time ts2)))
1129 (or (< t1 t2)
1130 (and (= t1 t2)
1131 (string-lessp ts1 ts2)))))))
0808d911 1132
a14723d9
KH		 1133(defcustom diary-unknown-time
1134 -9999
1135 "*Value returned by diary-entry-time when no time is found.
1136The default value -9999 causes entries with no recognizable time to be placed
1137before those with times; 9999 would place entries with no recognizable time
1138after those with times."
1139 :type 'integer
cd32a7ba
DN		 1140 :group 'diary
1141 :version "20.3")
4dd618ff 1142
0808d911 1143(defun diary-entry-time (s)
fd4a98f0
RS		 1144 "Return time at the beginning of the string S as a military-style integer.
1145For example, returns 1325 for 1:25pm.
56d3bae7
TTN		 1146
1147Returns `diary-unknown-time' (default value -9999) if no time is recognized.
1148The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam,
6ecab45e
GM		 1149XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can
1150be used instead of a colon (:) to separate the hour and minute parts."
0488694c 1151 (let ((case-fold-search nil))
4dd618ff 1152 (cond ((string-match ; Military time
56d3bae7
TTN		 1153 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
1154 s)
027a4b6b 1155 (+ (* 100 (string-to-number
0488694c 1156 (substring s (match-beginning 1) (match-end 1))))
027a4b6b 1157 (string-to-number (substring s (match-beginning 2) (match-end 2)))))
4dd618ff 1158 ((string-match ; Hour only XXam or XXpm
619fdf3d 1159 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
027a4b6b 1160 (+ (* 100 (% (string-to-number
0488694c
RS		 1161 (substring s (match-beginning 1) (match-end 1)))
1162 12))
1163 (if (equal ?a (downcase (aref s (match-beginning 2))))
1164 0 1200)))
4dd618ff 1165 ((string-match ; Hour and minute XX:XXam or XX:XXpm
d14b04bc 1166 "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
027a4b6b 1167 (+ (* 100 (% (string-to-number
0488694c
RS		 1168 (substring s (match-beginning 1) (match-end 1)))
1169 12))
027a4b6b 1170 (string-to-number (substring s (match-beginning 2) (match-end 2)))
0488694c
RS		 1171 (if (equal ?a (downcase (aref s (match-beginning 3))))
1172 0 1200)))
4dd618ff 1173 (t diary-unknown-time)))) ; Unrecognizable
619fdf3d 1174
811a8484
JW		 1175;; Unrecognizable
1176
0808d911
ER		 1177(defun list-sexp-diary-entries (date)
1178 "Add sexp entries for DATE from the diary file to `diary-entries-list'.
1179Also, Make them visible in the diary file. Returns t if any entries were
1180found.
1181
1182Sexp diary entries must be prefaced by a `sexp-diary-entry-symbol' (normally
1183`%%'). The form of a sexp diary entry is
1184
1185 %%(SEXP) ENTRY
1186
1187Both ENTRY and DATE are globally available when the SEXP is evaluated. If the
1188SEXP yields the value nil, the diary entry does not apply. If it yields a
1189non-nil value, ENTRY will be taken to apply to DATE; if the non-nil value is a
1190string, that string will be the diary entry in the fancy diary display.
1191
1192For example, the following diary entry will apply to the 21st of the month
1193if it is a weekday and the Friday before if the 21st is on a weekend:
1194
1195 &%%(let ((dayname (calendar-day-of-week date))
1196 (day (extract-calendar-day date)))
1197 (or
1198 (and (= day 21) (memq dayname '(1 2 3 4 5)))
1199 (and (memq day '(19 20)) (= dayname 5)))
1200 ) UIUC pay checks deposited
1201
1202A number of built-in functions are available for this type of diary entry:
1203
fd4a98f0 1204 %%(diary-date MONTH DAY YEAR &optional MARK) text
0808d911
ER		 1205 Entry applies if date is MONTH, DAY, YEAR if
1206 `european-calendar-style' is nil, and DAY, MONTH, YEAR if
1207 `european-calendar-style' is t. DAY, MONTH, and YEAR
1208 can be lists of integers, the constant t, or an integer.
ee58da1b 1209 The constant t means all values. An optional parameter
fd4a98f0
RS		 1210 MARK specifies a face or single-character string to use
1211 when highlighting the day in the calendar.
0808d911 1212
fd4a98f0 1213 %%(diary-float MONTH DAYNAME N &optional DAY MARK) text
0808d911
ER		 1214 Entry will appear on the Nth DAYNAME of MONTH.
1215 (DAYNAME=0 means Sunday, 1 means Monday, and so on;
1216 if N is negative it counts backward from the end of
1217 the month. MONTH can be a list of months, a single
9b58d144
RS		 1218 month, or t to specify all months. Optional DAY means
1219 Nth DAYNAME of MONTH on or after/before DAY. DAY defaults
ee58da1b
SS		 1220 to 1 if N>0 and the last day of the month if N<0. An
1221 optional parameter MARK specifies a face or single-character
fd4a98f0 1222 string to use when highlighting the day in the calendar.
0808d911 1223
fd4a98f0 1224 %%(diary-block M1 D1 Y1 M2 D2 Y2 &optional MARK) text
0808d911
ER		 1225 Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
1226 inclusive. (If `european-calendar-style' is t, the
1227 order of the parameters should be changed to D1, M1, Y1,
ee58da1b
SS		 1228 D2, M2, Y2.) An optional parameter MARK specifies a face
1229 or single-character string to use when highlighting the
fd4a98f0 1230 day in the calendar.
0808d911 1231
fd4a98f0 1232 %%(diary-anniversary MONTH DAY YEAR &optional MARK) text
0808d911
ER		 1233 Entry will appear on anniversary dates of MONTH DAY, YEAR.
1234 (If `european-calendar-style' is t, the order of the
1235 parameters should be changed to DAY, MONTH, YEAR.) Text
1236 can contain %d or %d%s; %d will be replaced by the number
1237 of years since the MONTH DAY, YEAR and %s will be replaced
1238 by the ordinal ending of that number (that is, `st', `nd',
1239 `rd' or `th', as appropriate. The anniversary of February
ee58da1b
SS		 1240 29 is considered to be March 1 in a non-leap year. An
1241 optional parameter MARK specifies a face or single-character
fd4a98f0 1242 string to use when highlighting the day in the calendar.
0808d911 1243
fd4a98f0 1244 %%(diary-cyclic N MONTH DAY YEAR &optional MARK) text
0808d911
ER		 1245 Entry will appear every N days, starting MONTH DAY, YEAR.
1246 (If `european-calendar-style' is t, the order of the
1247 parameters should be changed to N, DAY, MONTH, YEAR.) Text
1248 can contain %d or %d%s; %d will be replaced by the number
1249 of repetitions since the MONTH DAY, YEAR and %s will
1250 be replaced by the ordinal ending of that number (that is,
ee58da1b
SS		 1251 `st', `nd', `rd' or `th', as appropriate. An optional
1252 parameter MARK specifies a face or single-character string
fd4a98f0 1253 to use when highlighting the day in the calendar.
0808d911
ER		 1254
1255 %%(diary-remind SEXP DAYS &optional MARKING) text
1256 Entry is a reminder for diary sexp SEXP. DAYS is either a
1257 single number or a list of numbers indicating the number(s)
1258 of days before the event that the warning(s) should occur.
1259 If the current date is (one of) DAYS before the event
1260 indicated by EXPR, then a suitable message (as specified
1261 by `diary-remind-message') appears. In addition to the
1262 reminders beforehand, the diary entry also appears on
1263 the date itself. If optional MARKING is non-nil then the
1264 *reminders* are marked on the calendar. Marking of
1265 reminders is independent of whether the entry *itself* is
1266 a marking or nonmarking one.
1267
1268 %%(diary-day-of-year)
1269 Diary entries giving the day of the year and the number of
1270 days remaining in the year will be made every day. Note
1271 that since there is no text, it makes sense only if the
1272 fancy diary display is used.
1273
1274 %%(diary-iso-date)
1275 Diary entries giving the corresponding ISO commercial date
1276 will be made every day. Note that since there is no text,
1277 it makes sense only if the fancy diary display is used.
1278
1279 %%(diary-french-date)
1280 Diary entries giving the corresponding French Revolutionary
1281 date will be made every day. Note that since there is no
1282 text, it makes sense only if the fancy diary display is used.
1283
1284 %%(diary-islamic-date)
1285 Diary entries giving the corresponding Islamic date will be
1286 made every day. Note that since there is no text, it
1287 makes sense only if the fancy diary display is used.
1288
1289 %%(diary-hebrew-date)
1290 Diary entries giving the corresponding Hebrew date will be
1291 made every day. Note that since there is no text, it
1292 makes sense only if the fancy diary display is used.
1293
1294 %%(diary-astro-day-number) Diary entries giving the corresponding
1295 astronomical (Julian) day number will be made every day.
1296 Note that since there is no text, it makes sense only if the
1297 fancy diary display is used.
1298
1299 %%(diary-julian-date) Diary entries giving the corresponding
1300 Julian date will be made every day. Note that since
1301 there is no text, it makes sense only if the fancy diary
1302 display is used.
1303
1304 %%(diary-sunrise-sunset)
1305 Diary entries giving the local times of sunrise and sunset
1306 will be made every day. Note that since there is no text,
1307 it makes sense only if the fancy diary display is used.
1308 Floating point required.
1309
1310 %%(diary-phases-of-moon)
1311 Diary entries giving the times of the phases of the moon
1312 will be when appropriate. Note that since there is no text,
1313 it makes sense only if the fancy diary display is used.
1314 Floating point required.
1315
1316 %%(diary-yahrzeit MONTH DAY YEAR) text
1317 Text is assumed to be the name of the person; the date is
1318 the date of death on the *civil* calendar. The diary entry
1319 will appear on the proper Hebrew-date anniversary and on the
1320 day before. (If `european-calendar-style' is t, the order
1321 of the parameters should be changed to DAY, MONTH, YEAR.)
4dd618ff 1322
0808d911
ER		 1323 %%(diary-rosh-hodesh)
1324 Diary entries will be made on the dates of Rosh Hodesh on
1325 the Hebrew calendar. Note that since there is no text, it
1326 makes sense only if the fancy diary display is used.
1327
1328 %%(diary-parasha)
1329 Diary entries giving the weekly parasha will be made on
1330 every Saturday. Note that since there is no text, it
1331 makes sense only if the fancy diary display is used.
1332
1333 %%(diary-omer)
1334 Diary entries giving the omer count will be made every day
59ba214d 1335 from Passover to Shavuot. Note that since there is no text,
0808d911
ER		 1336 it makes sense only if the fancy diary display is used.
1337
1338Marking these entries is *extremely* time consuming, so these entries are
1339best if they are nonmarking."
56d3bae7 1340 (let ((s-entry (concat "\\(\\`\\|\^M\\|\n\\)"
c87a1f38
GM		 1341 (regexp-quote diary-nonmarking-symbol)
1342 "?"
1343 (regexp-quote sexp-diary-entry-symbol)
1344 "("))
1345 entry-found file-glob-attrs marks)
0808d911 1346 (goto-char (point-min))
c47a201a
JB		 1347 (save-excursion
1348 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))))
0808d911
ER		 1349 (while (re-search-forward s-entry nil t)
1350 (backward-char 1)
1351 (let ((sexp-start (point))
c87a1f38 1352 sexp entry specifier entry-start line-start)
0808d911 1353 (forward-sexp)
e6c3bfbc 1354 (setq sexp (buffer-substring-no-properties sexp-start (point)))
0808d911
ER		 1355 (save-excursion
1356 (re-search-backward "\^M\\|\n\\|\\`")
1357 (setq line-start (point)))
a14723d9 1358 (setq specifier
86432f81
MR		 1359 (buffer-substring-no-properties (1+ line-start) (point))
1360 entry-start (1+ line-start))
0808d911
ER		 1361 (forward-char 1)
1362 (if (and (or (char-equal (preceding-char) ?\^M)
1363 (char-equal (preceding-char) ?\n))
1364 (not (looking-at " \\|\^I")))
1365 (progn;; Diary entry consists only of the sexp
1366 (backward-char 1)
1367 (setq entry ""))
1368 (setq entry-start (point))
1369 (re-search-forward "\^M\\|\n" nil t)
1370 (while (looking-at " \\|\^I")
1371 (re-search-forward "\^M\\|\n" nil t))
1372 (backward-char 1)
e6c3bfbc 1373 (setq entry (buffer-substring-no-properties entry-start (point)))
0808d911
ER		 1374 (while (string-match "[\^M]" entry)
1375 (aset entry (match-beginning 0) ?\n )))
61d094de
GM		 1376 (let ((diary-entry (diary-sexp-entry sexp entry date))
1377 temp)
c47a201a
JB		 1378 (setq entry (if (consp diary-entry)
1379 (cdr diary-entry)
1380 diary-entry))
0808d911 1381 (if diary-entry
c47a201a
JB		 1382 (progn
1383 (subst-char-in-region line-start (point) ?\^M ?\n t)
1384 (if (< 0 (length entry))
1385 (setq temp (diary-pull-attrs entry file-glob-attrs)
1386 entry (nth 0 temp)
1387 marks (nth 1 temp)))))
1388 (add-to-diary-list date
1389 entry
86432f81
MR		 1390 specifier
1391 (if entry-start (copy-marker entry-start)
4e80f517 1392 nil)
c47a201a 1393 marks)
fd4a98f0 1394 (setq entry-found (or entry-found diary-entry)))))
0808d911
ER		 1395 entry-found))
1396
1397(defun diary-sexp-entry (sexp entry date)
1398 "Process a SEXP diary ENTRY for DATE."
1399 (let ((result (if calendar-debug-sexp
1400 (let ((stack-trace-on-error t))
1401 (eval (car (read-from-string sexp))))
1402 (condition-case nil
1403 (eval (car (read-from-string sexp)))
1404 (error
1405 (beep)
1406 (message "Bad sexp at line %d in %s: %s"
1407 (save-excursion
1408 (save-restriction
1409 (narrow-to-region 1 (point))
1410 (goto-char (point-min))
1411 (let ((lines 1))
1412 (while (re-search-forward "\n\\|\^M" nil t)
1413 (setq lines (1+ lines)))
1414 lines)))
1415 diary-file sexp)
1416 (sleep-for 2))))))
fd4a98f0
RS		 1417 (cond ((stringp result) result)
1418 ((and (consp result)
1419 (stringp (cdr result))) result)
1420 (result entry)
1421 (t nil))))
0808d911 1422
fd4a98f0 1423(defun diary-date (month day year &optional mark)
0808d911
ER		 1424 "Specific date(s) diary entry.
1425Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil,
1426and DAY, MONTH, YEAR if `european-calendar-style' is t. DAY, MONTH, and YEAR
1427can be lists of integers, the constant t, or an integer. The constant t means
fd4a98f0
RS		 1428all values.
1429
ee58da1b 1430An optional parameter MARK specifies a face or single-character string to
fd4a98f0 1431use when highlighting the day in the calendar."
c87a1f38 1432 (let ((dd (if european-calendar-style
0808d911
ER		 1433 month
1434 day))
c87a1f38 1435 (mm (if european-calendar-style
0808d911
ER		 1436 day
1437 month))
c87a1f38
GM		 1438 (m (extract-calendar-month date))
1439 (y (extract-calendar-year date))
1440 (d (extract-calendar-day date)))
0808d911
ER		 1441 (if (and
1442 (or (and (listp dd) (memq d dd))
1443 (equal d dd)
1444 (eq dd t))
1445 (or (and (listp mm) (memq m mm))
1446 (equal m mm)
1447 (eq mm t))
1448 (or (and (listp year) (memq y year))
1449 (equal y year)
1450 (eq year t)))
86432f81 1451 (cons mark entry))))
0808d911 1452
fd4a98f0 1453(defun diary-block (m1 d1 y1 m2 d2 y2 &optional mark)
0808d911 1454 "Block diary entry.
5860ba6e
RS		 1455Entry applies if date is between, or on one of, two dates.
1456The order of the parameters is
666333c0 1457M1, D1, Y1, M2, D2, Y2 if `european-calendar-style' is nil, and
fd4a98f0
RS		 1458D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t.
1459
ee58da1b 1460An optional parameter MARK specifies a face or single-character string to
fd4a98f0
RS		 1461use when highlighting the day in the calendar."
1462
0808d911
ER		 1463 (let ((date1 (calendar-absolute-from-gregorian
1464 (if european-calendar-style
1465 (list d1 m1 y1)
1466 (list m1 d1 y1))))
1467 (date2 (calendar-absolute-from-gregorian
1468 (if european-calendar-style
1469 (list d2 m2 y2)
1470 (list m2 d2 y2))))
1471 (d (calendar-absolute-from-gregorian date)))
1472 (if (and (<= date1 d) (<= d date2))
fd4a98f0 1473 (cons mark entry))))
0808d911 1474
fd4a98f0 1475(defun diary-float (month dayname n &optional day mark)
0808d911
ER		 1476 "Floating diary entry--entry applies if date is the nth dayname of month.
1477Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, the constant
1478t, or an integer. The constant t means all months. If N is negative, count
9b58d144
RS		 1479backward from the end of the month.
1480
fd4a98f0 1481An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY.
ee58da1b 1482Optional MARK specifies a face or single-character string to use when
fd4a98f0 1483highlighting the day in the calendar."
9b58d144
RS		 1484;; This is messy because the diary entry may apply, but the date on which it
1485;; is based can be in a different month/year. For example, asking for the
1486;; first Monday after December 30. For large values of |n| the problem is
1487;; more grotesque.
1488 (and (= dayname (calendar-day-of-week date))
1489 (let* ((m (extract-calendar-month date))
1490 (d (extract-calendar-day date))
1491 (y (extract-calendar-year date))
1492 (limit; last (n>0) or first (n<0) possible base date for entry
1493 (calendar-nth-named-absday (- n) dayname m y d))
1494 (last-abs (if (> n 0) limit (+ limit 6)))
1495 (first-abs (if (> n 0) (- limit 6) limit))
1496 (last (calendar-gregorian-from-absolute last-abs))
1497 (first (calendar-gregorian-from-absolute first-abs))
1498 ; m1, d1 is first possible base date
1499 (m1 (extract-calendar-month first))
1500 (d1 (extract-calendar-day first))
1501 (y1 (extract-calendar-year first))
1502 ; m2, d2 is last possible base date
1503 (m2 (extract-calendar-month last))
1504 (d2 (extract-calendar-day last))
1505 (y2 (extract-calendar-year last)))
a2faecac 1506 (if (or (and (= m1 m2) ; only possible base dates in one month
d56aaa64
GM		 1507 (or (eq month t)
1508 (if (listp month)
1509 (memq m1 month)
1510 (= m1 month)))
9f596b33
RS		 1511 (let ((d (or day (if (> n 0)
1512 1
1513 (calendar-last-day-of-month m1 y1)))))
1514 (and (<= d1 d) (<= d d2))))
1515 ;; only possible base dates straddle two months
b5972d79
RS		 1516 (and (or (< y1 y2)
1517 (and (= y1 y2) (< m1 m2)))
9f596b33 1518 (or
a2faecac 1519 ;; m1, d1 works as a base date
9f596b33 1520 (and
d56aaa64
GM		 1521 (or (eq month t)
1522 (if (listp month)
1523 (memq m1 month)
1524 (= m1 month)))
9f596b33
RS		 1525 (<= d1 (or day (if (> n 0)
1526 1
1527 (calendar-last-day-of-month m1 y1)))))
a2faecac 1528 ;; m2, d2 works as a base date
d56aaa64
GM		 1529 (and (or (eq month t)
1530 (if (listp month)
1531 (memq m2 month)
1532 (= m2 month)))
9f596b33
RS		 1533 (<= (or day (if (> n 0)
1534 1
1535 (calendar-last-day-of-month m2 y2)))
1536 d2)))))
fd4a98f0 1537 (cons mark entry)))))
0808d911 1538
d56aaa64 1539
fd4a98f0 1540(defun diary-anniversary (month day year &optional mark)
0808d911
ER		 1541 "Anniversary diary entry.
1542Entry applies if date is the anniversary of MONTH, DAY, YEAR if
1543`european-calendar-style' is nil, and DAY, MONTH, YEAR if
1544`european-calendar-style' is t. Diary entry can contain `%d' or `%d%s'; the
1545%d will be replaced by the number of years since the MONTH DAY, YEAR and the
1546%s will be replaced by the ordinal ending of that number (that is, `st', `nd',
1547`rd' or `th', as appropriate. The anniversary of February 29 is considered
fd4a98f0
RS		 1548to be March 1 in non-leap years.
1549
ee58da1b 1550An optional parameter MARK specifies a face or single-character string to
fd4a98f0 1551use when highlighting the day in the calendar."
0808d911
ER		 1552 (let* ((d (if european-calendar-style
1553 month
1554 day))
1555 (m (if european-calendar-style
1556 day
1557 month))
1558 (y (extract-calendar-year date))
1559 (diff (- y year)))
1560 (if (and (= m 2) (= d 29) (not (calendar-leap-year-p y)))
1561 (setq m 3
1562 d 1))
1563 (if (and (> diff 0) (calendar-date-equal (list m d y) date))
fd4a98f0 1564 (cons mark (format entry diff (diary-ordinal-suffix diff))))))
0808d911 1565
fd4a98f0 1566(defun diary-cyclic (n month day year &optional mark)
0808d911
ER		 1567 "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
1568If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR.
1569ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of
d861718a
GM		 1570repetitions since the MONTH DAY, YEAR and %s will be replaced by the
1571ordinal ending of that number (that is, `st', `nd', `rd' or `th', as
fd4a98f0
RS		 1572appropriate.
1573
ee58da1b 1574An optional parameter MARK specifies a face or single-character string to
fd4a98f0 1575use when highlighting the day in the calendar."
0808d911
ER		 1576 (let* ((d (if european-calendar-style
1577 month
1578 day))
1579 (m (if european-calendar-style
1580 day
1581 month))
1582 (diff (- (calendar-absolute-from-gregorian date)
1583 (calendar-absolute-from-gregorian
1584 (list m d year))))
1585 (cycle (/ diff n)))
1586 (if (and (>= diff 0) (zerop (% diff n)))
fd4a98f0 1587 (cons mark (format entry cycle (diary-ordinal-suffix cycle))))))
0808d911
ER		 1588
1589(defun diary-ordinal-suffix (n)
1590 "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)"
1591 (if (or (memq (% n 100) '(11 12 13))
1592 (< 3 (% n 10)))
1593 "th"
1594 (aref ["th" "st" "nd" "rd"] (% n 10))))
1595
1596(defun diary-day-of-year ()
1597 "Day of year and number of days remaining in the year of date diary entry."
1598 (calendar-day-of-year-string date))
1599
5e11a170 1600(defcustom diary-remind-message
0808d911
ER		 1601 '("Reminder: Only "
1602 (if (= 0 (% days 7))
1603 (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks"))
1604 (concat (int-to-string days) (if (= 1 days) " day" " days")))
1605 " until "
1606 diary-entry)
1607 "*Pseudo-pattern giving form of reminder messages in the fancy diary
1608display.
4dd618ff 1609
0808d911
ER		 1610Used by the function `diary-remind', a pseudo-pattern is a list of
1611expressions that can involve the keywords `days' (a number), `date' (a list of
5e11a170
RS		 1612month, day, year), and `diary-entry' (a string)."
1613 :type 'sexp
1614 :group 'diary)
0808d911
ER		 1615
1616(defun diary-remind (sexp days &optional marking)
1617 "Provide a reminder of a diary entry.
1618SEXP is a diary-sexp. DAYS is either a single number or a list of numbers
1619indicating the number(s) of days before the event that the warning(s) should
1620occur on. If the current date is (one of) DAYS before the event indicated by
1621SEXP, then a suitable message (as specified by `diary-remind-message' is
1622returned.
1623
17b7580f
KH		 1624In addition to the reminders beforehand, the diary entry also appears on the
1625date itself.
1626
1627A `diary-nonmarking-symbol' at the beginning of the line of the diary-remind
1628entry specifies that the diary entry (not the reminder) is non-marking.
1629Marking of reminders is independent of whether the entry itself is a marking
1630or nonmarking; if optional parameter MARKING is non-nil then the reminders are
1631marked on the calendar."
1632 (let ((diary-entry (eval sexp)))
1633 (cond
1634 ;; Diary entry applies on date
1635 ((and diary-entry
1636 (or (not marking-diary-entries) marking-diary-entry))
1637 diary-entry)
1638 ;; Diary entry may apply to `days' before date
1639 ((and (integerp days)
1640 (not diary-entry); Diary entry does not apply to date
1641 (or (not marking-diary-entries) marking))
1642 (let ((date (calendar-gregorian-from-absolute
1643 (+ (calendar-absolute-from-gregorian date) days))))
07a66b97
GM		 1644 (when (setq diary-entry (eval sexp)) ; re-evaluate with adjusted date
1645 ;; Discard any mark portion from diary-anniversary, etc.
1646 (if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
1647 (mapconcat 'eval diary-remind-message ""))))
17b7580f
KH		 1648 ;; Diary entry may apply to one of a list of days before date
1649 ((and (listp days) days)
1650 (or (diary-remind sexp (car days) marking)
1651 (diary-remind sexp (cdr days) marking))))))
0808d911 1652
214e2d48 1653(defun add-to-diary-list (date string specifier &optional marker globcolor)
c47a201a 1654 "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'.
0808d911 1655Do nothing if DATE or STRING is nil."
61d094de
GM		 1656 (when (and date string)
1657 (if diary-file-name-prefix
1658 (let ((prefix (funcall diary-file-name-prefix-function
1659 (buffer-file-name))))
1660 (or (string= prefix "")
1661 (setq string (format "[%s] %s" prefix string)))))
1662 (setq diary-entries-list
1663 (append diary-entries-list
1664 (list (list date string specifier marker globcolor))))))
0808d911 1665
a46c339d
GM		 1666(defun diary-redraw-calendar ()
1667 "If `calendar-buffer' is live and diary entries are marked, redraw it."
1668 (and mark-diary-entries-in-calendar
81eb8a4a
GM		 1669 (save-excursion
1670 (redraw-calendar)))
a46c339d
GM		 1671 ;; Return value suitable for `write-contents-functions'.
1672 nil)
1673
0808d911
ER		 1674(defun make-diary-entry (string &optional nonmarking file)
1675 "Insert a diary entry STRING which may be NONMARKING in FILE.
a46c339d
GM		 1676If omitted, NONMARKING defaults to nil and FILE defaults to
1677`diary-file'. Adds `diary-redraw-calendar' to
1678`write-contents-functions' for FILE, so that the calendar will be
1679redrawn with the new entry marked, if necessary."
8ec6d48a
GM		 1680 (let ((pop-up-frames (window-dedicated-p (selected-window))))
1681 (find-file-other-window (substitute-in-file-name (or file diary-file))))
a46c339d
GM		 1682 (add-hook 'write-contents-functions 'diary-redraw-calendar nil t)
1683 (when selective-display
1684 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
1685 (setq selective-display nil)
1686 (kill-local-variable 'mode-line-format))
b8f2671f 1687 (widen)
0808d911 1688 (goto-char (point-max))
b8f2671f
JB		 1689 (when (let ((case-fold-search t))
1690 (search-backward "Local Variables:"
1691 (max (- (point-max) 3000) (point-min))
1692 t))
1693 (beginning-of-line)
1694 (insert "\n")
1695 (previous-line 1))
0808d911
ER		 1696 (insert
1697 (if (bolp) "" "\n")
1698 (if nonmarking diary-nonmarking-symbol "")
1699 string " "))
1700
1701(defun insert-diary-entry (arg)
1702 "Insert a diary entry for the date indicated by point.
1703Prefix arg will make the entry nonmarking."
1704 (interactive "P")
1705 (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t)
1706 arg))
1707
1708(defun insert-weekly-diary-entry (arg)
1709 "Insert a weekly diary entry for the day of the week indicated by point.
1710Prefix arg will make the entry nonmarking."
1711 (interactive "P")
1712 (make-diary-entry (calendar-day-name (calendar-cursor-to-date t))
1713 arg))
1714
1715(defun insert-monthly-diary-entry (arg)
1716 "Insert a monthly diary entry for the day of the month indicated by point.
1717Prefix arg will make the entry nonmarking."
1718 (interactive "P")
c87a1f38
GM		 1719 (let ((calendar-date-display-form
1720 (if european-calendar-style
1721 '(day " * ")
1722 '("* " day))))
0808d911
ER		 1723 (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
1724 arg)))
1725
1726(defun insert-yearly-diary-entry (arg)
1727 "Insert an annual diary entry for the day of the year indicated by point.
1728Prefix arg will make the entry nonmarking."
1729 (interactive "P")
c87a1f38
GM		 1730 (let ((calendar-date-display-form
1731 (if european-calendar-style
1732 '(day " " monthname)
1733 '(monthname " " day))))
0808d911
ER		 1734 (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
1735 arg)))
1736
1737(defun insert-anniversary-diary-entry (arg)
1738 "Insert an anniversary diary entry for the date given by point.
1739Prefix arg will make the entry nonmarking."
1740 (interactive "P")
c87a1f38
GM		 1741 (let ((calendar-date-display-form
1742 (if european-calendar-style
1743 '(day " " month " " year)
1744 '(month " " day " " year))))
0808d911
ER		 1745 (make-diary-entry
1746 (format "%s(diary-anniversary %s)"
1747 sexp-diary-entry-symbol
1748 (calendar-date-string (calendar-cursor-to-date t) nil t))
1749 arg)))
1750
1751(defun insert-block-diary-entry (arg)
1752 "Insert a block diary entry for the days between the point and marked date.
1753Prefix arg will make the entry nonmarking."
1754 (interactive "P")
c87a1f38
GM		 1755 (let ((calendar-date-display-form
1756 (if european-calendar-style
1757 '(day " " month " " year)
1758 '(month " " day " " year)))
0808d911
ER		 1759 (cursor (calendar-cursor-to-date t))
1760 (mark (or (car calendar-mark-ring)
1761 (error "No mark set in this buffer")))
c87a1f38 1762 start end)
0808d911
ER		 1763 (if (< (calendar-absolute-from-gregorian mark)
1764 (calendar-absolute-from-gregorian cursor))
1765 (setq start mark
1766 end cursor)
1767 (setq start cursor
1768 end mark))
1769 (make-diary-entry
1770 (format "%s(diary-block %s %s)"
1771 sexp-diary-entry-symbol
1772 (calendar-date-string start nil t)
1773 (calendar-date-string end nil t))
1774 arg)))
1775
1776(defun insert-cyclic-diary-entry (arg)
1777 "Insert a cyclic diary entry starting at the date given by point.
1778Prefix arg will make the entry nonmarking."
1779 (interactive "P")
c87a1f38
GM		 1780 (let ((calendar-date-display-form
1781 (if european-calendar-style
1782 '(day " " month " " year)
1783 '(month " " day " " year))))
0808d911
ER		 1784 (make-diary-entry
1785 (format "%s(diary-cyclic %d %s)"
1786 sexp-diary-entry-symbol
1787 (calendar-read "Repeat every how many days: "
86855ebd 1788 (lambda (x) (> x 0)))
0808d911
ER		 1789 (calendar-date-string (calendar-cursor-to-date t) nil t))
1790 arg)))
1791
86432f81 1792;;;###autoload
4fcf2701 1793(define-derived-mode diary-mode fundamental-mode
86432f81
MR		 1794 "Diary"
1795 "Major mode for editing the diary file."
1796 (set (make-local-variable 'font-lock-defaults)
1797 '(diary-font-lock-keywords t)))
1798
4fcf2701 1799(define-derived-mode fancy-diary-display-mode fundamental-mode
86432f81
MR		 1800 "Diary"
1801 "Major mode used while displaying diary entries using Fancy Display."
1802 (set (make-local-variable 'font-lock-defaults)
4e80f517
SS		 1803 '(fancy-diary-font-lock-keywords t))
1804 (define-key (current-local-map) "q" 'quit-window))
86432f81
MR		 1805
1806
1807(defvar fancy-diary-font-lock-keywords
1808 (list
1809 (cons
1810 (concat
ca2a5950
GM		 1811 (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
1812 (monthname (diary-name-pattern calendar-month-name-array nil t))
86432f81 1813 (day "[0-9]+")
e440b20e 1814 (month "[0-9]+")
86432f81
MR		 1815 (year "-?[0-9]+"))
1816 (mapconcat 'eval calendar-date-display-form ""))
1817 "\\(\\(: .*\\)\\|\\(\n +.*\\)\\)*\n=+$")
1818 'diary-face)
1819 '("^.*anniversary.*$" . font-lock-keyword-face)
1820 '("^.*birthday.*$" . font-lock-keyword-face)
1821 '("^.*Yahrzeit.*$" . font-lock-reference-face)
1822 '("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
1823 '("^Day.*omer.*$" . font-lock-builtin-face)
1824 '("^Parashat.*$" . font-lock-comment-face)
56d3bae7 1825 '("^[ \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		 1826 . font-lock-variable-name-face))
1827 "Keywords to highlight in fancy diary display")
1828
1829
1830(defun font-lock-diary-sexps (limit)
1831 "Recognize sexp diary entry for font-locking."
1832 (if (re-search-forward
1833 (concat "^" (regexp-quote diary-nonmarking-symbol)
1834 "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)")
1835 limit t)
1836 (condition-case nil
1837 (save-restriction
1838 (narrow-to-region (point-min) limit)
1839 (let ((start (point)))
1840 (forward-sexp 1)
1841 (store-match-data (list start (point)))
1842 t))
1843 (error t))))
1844
ca2a5950
GM		 1845(defun font-lock-diary-date-forms (month-array &optional symbol abbrev-array)
1846 "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
86432f81 1847If given, optional SYMBOL must be a prefix to entries.
ca2a5950
GM		 1848If optional ABBREV-ARRAY is present, the abbreviations constructed
1849from this array by the function `calendar-abbrev-construct' are
1850matched (with or without a final `.'), in addition to the full month
1851names."
1852 (let ((dayname (diary-name-pattern calendar-day-name-array
1853 calendar-day-abbrev-array t))
1854 (monthname (format "\\(%s\\|\\*\\)"
1855 (diary-name-pattern month-array abbrev-array)))
c87a1f38
GM		 1856 (month "\\([0-9]+\\|\\*\\)")
1857 (day "\\([0-9]+\\|\\*\\)")
1858 (year "-?\\([0-9]+\\|\\*\\)"))
86432f81
MR		 1859 (mapcar '(lambda (x)
1860 (cons
1861 (concat "^" (regexp-quote diary-nonmarking-symbol) "?"
1862 (if symbol (regexp-quote symbol) "") "\\("
1863 (mapconcat 'eval
1864 ;; If backup, omit first item (backup)
1865 ;; and last item (not part of date)
1866 (if (equal (car x) 'backup)
1867 (reverse (cdr (reverse (cdr x))))
1868 x)
1869 "")
1870 ;; With backup, last item is not part of date
1871 (if (equal (car x) 'backup)
1872 (concat "\\)" (eval (car (reverse x))))
1873 "\\)"))
1874 '(1 diary-face)))
1875 diary-date-forms)))
1876
ca2a5950
GM		 1877(eval-when-compile (require 'cal-hebrew)
1878 (require 'cal-islam))
1879
86432f81
MR		 1880(defvar diary-font-lock-keywords
1881 (append
ca2a5950
GM		 1882 (font-lock-diary-date-forms calendar-month-name-array
1883 nil calendar-month-abbrev-array)
c87a1f38
GM		 1884 (when (or (memq 'mark-hebrew-diary-entries
1885 nongregorian-diary-marking-hook)
1886 (memq 'list-hebrew-diary-entries
1887 nongregorian-diary-listing-hook))
1888 (require 'cal-hebrew)
1889 (font-lock-diary-date-forms
1890 calendar-hebrew-month-name-array-leap-year
ca2a5950 1891 hebrew-diary-entry-symbol))
c87a1f38
GM		 1892 (when (or (memq 'mark-islamic-diary-entries
1893 nongregorian-diary-marking-hook)
1894 (memq 'list-islamic-diary-entries
1895 nongregorian-diary-listing-hook))
1896 (require 'cal-islam)
1897 (font-lock-diary-date-forms
1898 calendar-islamic-month-name-array
ca2a5950 1899 islamic-diary-entry-symbol))
86432f81
MR		 1900 (list
1901 (cons
1902 (concat "^" (regexp-quote diary-include-string) ".*$")
1903 'font-lock-keyword-face)
1904 (cons
1905 (concat "^" (regexp-quote diary-nonmarking-symbol)
1906 "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)")
1907 '(1 font-lock-reference-face))
1908 (cons
1909 (concat "^" (regexp-quote diary-nonmarking-symbol))
1910 'font-lock-reference-face)
1911 (cons
1912 (concat "^" (regexp-quote diary-nonmarking-symbol)
1913 "?\\(" (regexp-quote hebrew-diary-entry-symbol) "\\)")
1914 '(1 font-lock-reference-face))
1915 (cons
1916 (concat "^" (regexp-quote diary-nonmarking-symbol)
1917 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
1918 '(1 font-lock-reference-face))
1919 '(font-lock-diary-sexps . font-lock-keyword-face)
56d3bae7 1920 '("[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		 1921 . font-lock-function-name-face)))
1922 "Forms to highlight in diary-mode")
a1506d29 1923
86432f81 1924
cb7c17be
GM		 1925;; Following code from Dave Love <fx@gnu.org>.
1926;; Import Outlook-format appointments from mail messages in Gnus or
1927;; Rmail using command `diary-from-outlook'. This, or the specialized
1928;; functions `diary-from-outlook-gnus' and `diary-from-outlook-rmail',
1929;; could be run from hooks to notice appointments automatically (in
1930;; which case they will prompt about adding to the diary). The
1931;; message formats recognized are customizable through
1932;; `diary-outlook-formats'.
1933
1934(defcustom diary-outlook-formats
1935 '(
1936 ;; When: 11 October 2001 12:00-14:00 (GMT) Greenwich Mean Time : Dublin, ...
1937 ;; [Current UK format? The timezone is meaningless. Sometimes the
1938 ;; Where is missing.]
1939 ("When: \\([0-9]+ [[:alpha:]]+ [0-9]+\\) \
1940\\([^ ]+\\) [^\n]+
1941\[^\n]+
1942\\(?:Where: \\([^\n]+\\)\n+\\)?
1943\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*"
1944 . "\\1\n \\2 %s, \\3")
1945 ;; When: Tuesday, April 30, 2002 03:00 PM-03:30 PM (GMT) Greenwich Mean ...
1946 ;; [Old UK format?]
1947 ("^When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \\([0-9]\\{4\\}\\) \
1948\\([^ ]+\\) [^\n]+
1949\[^\n]+
1950\\(?:Where: \\([^\n]+\\)\\)?\n+"
1951 . "\\2 \\1 \\3\n \\4 %s, \\5")
1952 (
1953 ;; German format, apparently.
1954 "^Zeit: [^ ]+, +\\([0-9]+\\)\. +\\([[:upper:]][[:lower:]][[:lower:]]\\)[^ ]* +\\([0-9]+\\) +\\([^ ]+\\).*$"
1955 . "\\1 \\2 \\3\n \\4 %s"))
1956 "Alist of regexps matching message text and replacement text.
1957
1958The regexp must match the start of the message text containing an
1959appointment, but need not include a leading `^'. If it matches the
1960current message, a diary entry is made from the corresponding
1961template. If the template is a string, it should be suitable for
1962passing to `replace-match', and so will have occurrences of `\\D' to
1963substitute the match for the Dth subexpression. It must also contain
1964a single `%s' which will be replaced with the text of the message's
1965Subject field. Any other `%' characters must be doubled, so that the
1966template can be passed to `format'.
1967
1968If the template is actually a function, it is called with the message
1969body text as argument, and may use `match-string' etc. to make a
1970template following the rules above."
1971 :type '(alist :key-type (regexp :tag "Regexp matching time/place")
1972 :value-type (choice
1973 (string :tag "Template for entry")
1974 (function :tag "Unary function providing template")))
bf247b6e 1975 :version "22.1"
cb7c17be
GM		 1976 :group 'diary)
1977
1978
1979;; Dynamically bound.
1980(defvar body)
1981(defvar subject)
1982
1983(defun diary-from-outlook-internal (&optional test-only)
1984 "Snarf a diary entry from a message assumed to be from MS Outlook.
1985Assumes `body' is bound to a string comprising the body of the message and
1986`subject' is bound to a string comprising its subject.
1987Arg TEST-ONLY non-nil means return non-nil if and only if the
1988message contains an appointment, don't make a diary entry."
1989 (catch 'finished
1990 (let (format-string)
1991 (dotimes (i (length diary-outlook-formats))
1992 (when (eq 0 (string-match (car (nth i diary-outlook-formats))
1993 body))
1994 (unless test-only
1995 (setq format-string (cdr (nth i diary-outlook-formats)))
1996 (save-excursion
1997 (save-window-excursion
1998 ;; Fixme: References to optional fields in the format
1999 ;; are treated literally, not replaced by the empty
2000 ;; string. I think this is an Emacs bug.
2001 (make-diary-entry
2002 (format (replace-match (if (functionp format-string)
2003 (funcall format-string body)
2004 format-string)
2005 t nil (match-string 0 body))
2006 subject))
2007 (save-buffer))))
2008 (throw 'finished t))))
2009 nil))
2010
3e58bf8b 2011(defun diary-from-outlook (&optional noconfirm)
cb7c17be 2012 "Maybe snarf diary entry from current Outlook-generated message.
e6a70f09 2013Currently knows about Gnus and Rmail modes. Unless the optional
3e58bf8b 2014argument NOCONFIRM is non-nil (which is the case when this
e6a70f09
GM		 2015function is called interactively), then if an entry is found the
2016user is asked to confirm its addition."
2017 (interactive "p")
cb7c17be
GM		 2018 (let ((func (cond
2019 ((eq major-mode 'rmail-mode)
2020 #'diary-from-outlook-rmail)
2021 ((memq major-mode '(gnus-summary-mode gnus-article-mode))
2022 #'diary-from-outlook-gnus)
2023 (t (error "Don't know how to snarf in `%s'" major-mode)))))
3e58bf8b 2024 (funcall func noconfirm)))
cb7c17be
GM		 2025
2026
2027(defvar gnus-article-mime-handles)
2028(defvar gnus-article-buffer)
2029
2030(autoload 'gnus-fetch-field "gnus-util")
2031(autoload 'gnus-narrow-to-body "gnus")
2032(autoload 'mm-get-part "mm-decode")
2033
3e58bf8b 2034(defun diary-from-outlook-gnus (&optional noconfirm)
cb7c17be 2035 "Maybe snarf diary entry from Outlook-generated message in Gnus.
3e58bf8b 2036Unless the optional argument NOCONFIRM is non-nil (which is the case when
e6a70f09
GM		 2037this function is called interactively), then if an entry is found the
2038user is asked to confirm its addition.
2039Add this function to `gnus-article-prepare-hook' to notice appointments
cb7c17be 2040automatically."
e6a70f09 2041 (interactive "p")
cb7c17be
GM		 2042 (with-current-buffer gnus-article-buffer
2043 (let ((subject (gnus-fetch-field "subject"))
2044 (body (if gnus-article-mime-handles
2045 ;; We're multipart. Don't get confused by part
2046 ;; buttons &c. Assume info is in first part.
2047 (mm-get-part (nth 1 gnus-article-mime-handles))
2048 (save-restriction
2049 (gnus-narrow-to-body)
2050 (buffer-string)))))
2051 (when (diary-from-outlook-internal t)
3e58bf8b 2052 (when (or noconfirm (y-or-n-p "Snarf diary entry? "))
cb7c17be
GM		 2053 (diary-from-outlook-internal)
2054 (message "Diary entry added"))))))
2055
2056(custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus)
2057
2058
2059(defvar rmail-buffer)
2060
3e58bf8b 2061(defun diary-from-outlook-rmail (&optional noconfirm)
e6a70f09 2062 "Maybe snarf diary entry from Outlook-generated message in Rmail.
3e58bf8b 2063Unless the optional argument NOCONFIRM is non-nil (which is the case when
e6a70f09
GM		 2064this function is called interactively), then if an entry is found the
2065user is asked to confirm its addition."
2066 (interactive "p")
cb7c17be
GM		 2067 (with-current-buffer rmail-buffer
2068 (let ((subject (mail-fetch-field "subject"))
2069 (body (buffer-substring (save-excursion
2070 (rfc822-goto-eoh)
2071 (point))
2072 (point-max))))
2073 (when (diary-from-outlook-internal t)
3e58bf8b 2074 (when (or noconfirm (y-or-n-p "Snarf diary entry? "))
cb7c17be
GM		 2075 (diary-from-outlook-internal)
2076 (message "Diary entry added"))))))
2077
2078
e4ca7ef9 2079(provide 'diary-lib)
0808d911 2080
ab5796a9 2081;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
e4ca7ef9 2082;;; diary-lib.el ends here
Unnamed repository; edit this file 'description' to name the repository.