1 ;;; diary-lib.el --- diary functions
3 ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003,
4 ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
6 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
7 ;; Maintainer: Glenn Morris <rgm@gnu.org>
10 ;; This file is part of GNU Emacs.
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 3, or (at your option)
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.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
34 (require 'diary-loaddefs
)
41 (defcustom diary-include-string
"#include"
42 "The string indicating inclusion of another file of diary entries.
43 See the documentation for the function `diary-include-other-diary-files'."
47 (defcustom diary-list-include-blanks nil
48 "If nil, do not include days with no diary entry in the list of diary entries.
49 Such days will then not be shown in the fancy diary buffer, even if they
54 (defcustom diary-face
'diary
55 "Face name to use for diary entries."
57 :group
'calendar-faces
)
58 (make-obsolete-variable 'diary-face
"customize the face `diary' instead."
61 (defface diary-anniversary
'((t :inherit font-lock-keyword-face
))
62 "Face used for anniversaries in the fancy diary display."
64 :group
'calendar-faces
)
66 (defface diary-time
'((t :inherit font-lock-variable-name-face
))
67 "Face used for times of day in the fancy diary display."
69 :group
'calendar-faces
)
71 (defface diary-button
'((((type pc
) (class color
))
72 (:foreground
"lightblue")))
73 "Face used for buttons in the fancy diary display."
75 :group
'calendar-faces
)
76 ;; Backward-compatibility alias. FIXME make obsolete.
77 (put 'diary-button-face
'face-alias
'diary-button
)
79 ;; Face markup of calendar and diary displays: Any entry line that
80 ;; ends with [foo:value] where foo is a face attribute (except :box
81 ;; :stipple) or with [face:blah] tags, will have these values applied
82 ;; to the calendar and fancy diary displays. These attributes "stack"
83 ;; on calendar displays. File-wide attributes can be defined as
84 ;; follows: the first line matching "^# [tag:value]" defines the value
85 ;; for that particular tag.
86 (defcustom diary-face-attrs
87 '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string
)
88 (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string
)
89 (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol
)
90 (" *\\[height:\\([.0-9]+\\)\\]$" 1 :height int
)
91 (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol
)
92 (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol
)
93 (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil
)
94 (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil
)
95 (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil
)
96 (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil
)
97 (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string
)
98 (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string
)
100 ;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box)
101 ;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple)
103 "Alist of (REGEXP SUBEXP ATTRIBUTE TYPE) elements.
104 This is used by `diary-pull-attrs' to fontify certain diary
105 elements. REGEXP is a regular expression to for, and SUBEXP is
106 the numbered sub-expression to extract. `diary-glob-file-regexp-prefix'
107 is pre-pended to REGEXP for file-wide specifiers. ATTRIBUTE
108 specifies which face attribute (e.g. `:foreground') to modify, or
109 that this is a face (`:face') to apply. TYPE is the type of
110 attribute being applied. Available TYPES (see `diary-attrtype-convert')
111 are: `string', `symbol', `int', `tnil',`stringtnil.'"
112 :type
'(repeat (list (string :tag
"Regular expression")
113 (integer :tag
"Sub-expression")
114 (symbol :tag
"Attribute (e.g. :foreground)")
115 (choice (const string
:tag
"A string")
116 (const symbol
:tag
"A symbol")
117 (const int
:tag
"An integer")
118 (const tnil
:tag
"`t' or `nil'")
120 :tag
"A string, `t', or `nil'"))))
123 (defcustom diary-glob-file-regexp-prefix
"^\\#"
124 "Regular expression pre-pended to `diary-face-attrs' for file-wide specifiers."
128 (defcustom diary-file-name-prefix nil
129 "Non-nil means prefix each diary entry with the name of the file defining it."
133 (defcustom diary-file-name-prefix-function
'identity
134 "The function that will take a diary file name and return the desired prefix."
138 (define-obsolete-variable-alias 'sexp-diary-entry-symbol
139 'diary-sexp-entry-symbol
"23.1")
141 (defcustom diary-sexp-entry-symbol
"%%"
142 "The string used to indicate a sexp diary entry in `diary-file'.
143 See the documentation for the function `diary-list-sexp-entries'."
147 (defcustom diary-hook nil
148 "List of functions called after the display of the diary.
149 Used for example by the appointment package - see `appt-activate'."
153 (defcustom diary-display-hook nil
154 "List of functions that handle the display of the diary.
155 If nil (the default), `diary-simple-display' is used. Use
156 `ignore' for no diary display.
158 Ordinarily, this just displays the diary buffer (with holidays
159 indicated in the mode line), if there are any relevant entries.
160 At the time these functions are called, the variable
161 `diary-entries-list' is a list, in order by date, of all relevant
162 diary entries in the form of ((MONTH DAY YEAR) STRING), where
163 string is the diary entry for the given date. This can be used,
164 for example, a different buffer for display (perhaps combined
165 with holidays), or produce hard copy output.
167 A function `diary-fancy-display' is provided for use with this
168 hook; this function prepares a special noneditable diary buffer
169 with the relevant diary entries that has neat day-by-day
170 arrangement with headings. The fancy diary buffer will show the
171 holidays unless the variable `diary-show-holidays-flag' is set to
172 nil. Ordinarily, the fancy diary buffer will not show days for
173 which there are no diary entries, even if that day is a holiday;
174 if you want such days to be shown in the fancy diary buffer, set
175 the variable `diary-list-include-blanks' non-nil."
177 :options
'(diary-fancy-display)
178 :initialize
'custom-initialize-default
179 :set
'diary-set-maybe-redraw
182 (define-obsolete-variable-alias 'list-diary-entries-hook
183 'diary-list-entries-hook
"23.1")
185 (defcustom diary-list-entries-hook nil
186 "List of functions called after diary file is culled for relevant entries.
187 You might wish to add `diary-include-other-diary-files', in which case
188 you will probably also want to add `diary-mark-included-diary-files' to
189 `diary-mark-entries-hook'. For example, you could use
191 (add-hook 'diary-list-entries-hook 'diary-include-other-diary-files)
192 (add-hook 'diary-list-entries-hook 'diary-sort-entries)
193 (add-hook 'diary-display-hook 'diary-fancy-display)
195 in your `.emacs' file to cause the fancy diary buffer to be displayed with
196 diary entries from various included files, each day's entries sorted into
197 lexicographic order."
199 :options
'(diary-include-other-diary-files diary-sort-entries
)
202 (define-obsolete-variable-alias 'mark-diary-entries-hook
203 'diary-mark-entries-hook
"23.1")
205 (defcustom diary-mark-entries-hook nil
206 "List of functions called after marking diary entries in the calendar.
207 You might wish to add `diary-mark-included-diary-files', in which case
208 you will probably also want to add `diary-include-other-diary-files' to
209 `diary-list-entries-hook'."
211 :options
'(diary-mark-included-diary-files)
214 (define-obsolete-variable-alias 'nongregorian-diary-listing-hook
215 'diary-nongregorian-listing-hook
"23.1")
217 (defcustom diary-nongregorian-listing-hook nil
218 "List of functions called for listing diary file and included files.
219 As the files are processed for diary entries, these functions are used
220 to cull relevant entries. You can use any or all of
221 `diary-bahai-list-entries', `diary-hebrew-list-entries', and
222 `diary-islamic-list-entries'. The documentation for these functions
223 describes the style of such diary entries."
225 :options
'(diary-bahai-list-entries
226 diary-hebrew-list-entries
227 diary-islamic-list-entries
)
230 (define-obsolete-variable-alias 'nongregorian-diary-marking-hook
231 'diary-nongregorian-marking-hook
"23.1")
233 (defcustom diary-nongregorian-marking-hook nil
234 "List of functions called for marking diary file and included files.
235 As the files are processed for diary entries, these functions are used
236 to cull relevant entries. You can use any or all of
237 `diary-bahai-mark-entries', `diary-hebrew-mark-entries' and
238 `diary-islamic-mark-entries'. The documentation for these functions
239 describes the style of such diary entries."
241 :options
'(diary-bahai-mark-entries
242 diary-hebrew-mark-entries
243 diary-islamic-mark-entries
)
246 (define-obsolete-variable-alias 'print-diary-entries-hook
247 'diary-print-entries-hook
"23.1")
249 (defcustom diary-print-entries-hook
'lpr-buffer
250 "Run by `diary-print-entries' after preparing a temporary diary buffer.
251 The buffer shows only the diary entries currently visible in the
252 diary buffer. The default just does the printing. Other uses
253 might include, for example, rearranging the lines into order by
254 day and time, saving the buffer instead of deleting it, or
255 changing the function used to do the printing."
259 (defcustom diary-unknown-time -
9999
260 "Value returned by `diary-entry-time' when no time is found.
261 The default value -9999 causes entries with no recognizable time
262 to be placed before those with times; 9999 would place entries
263 with no recognizable time after those with times."
268 (defcustom diary-mail-addr
269 (or (bound-and-true-p user-mail-address
) "")
270 "Email address that `diary-mail-entries' will send email to."
275 (defcustom diary-mail-days
7
276 "Default number of days for `diary-mail-entries' to check."
281 (defcustom diary-remind-message
283 (if (zerop (% days
7))
284 (format "%d week%s" (/ days
7) (if (= 7 days
) "" "s"))
285 (format "%d day%s" days
(if (= 1 days
) "" "s")))
288 "Pseudo-pattern giving form of reminder messages in the fancy diary display.
290 Used by the function `diary-remind', a pseudo-pattern is a list of
291 expressions that can involve the keywords `days' (a number), `date' (a list of
292 month, day, year), and `diary-entry' (a string)."
296 (define-obsolete-variable-alias 'abbreviated-calendar-year
297 'diary-abbreviated-year-flag
"23.1")
299 (defcustom diary-abbreviated-year-flag t
300 "Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
301 This applies to the Gregorian, Hebrew, Islamic, and Baha'i calendars.
302 When the current century is added to a two-digit year, if the result
303 is more than 50 years in the future, the previous century is assumed.
304 If the result is more than 50 years in the past, the next century is assumed.
305 If this variable is nil, years must be written in full."
309 (defcustom diary-outlook-formats
311 ;; When: 11 October 2001 12:00-14:00 (GMT) Greenwich Mean Time : Dublin, ...
312 ;; [Current UK format? The timezone is meaningless. Sometimes the
313 ;; Where is missing.]
314 ("When: \\([0-9]+ [[:alpha:]]+ [0-9]+\\) \
317 \\(?:Where: \\([^\n]+\\)\n+\\)?
318 \\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*"
319 .
"\\1\n \\2 %s, \\3")
320 ;; When: Tuesday, April 30, 2002 03:00 PM-03:30 PM (GMT) Greenwich Mean ...
322 ("^When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \\([0-9]\\{4\\}\\) \
325 \\(?:Where: \\([^\n]+\\)\\)?\n+"
326 .
"\\2 \\1 \\3\n \\4 %s, \\5")
328 ;; German format, apparently.
329 "^Zeit: [^ ]+, +\\([0-9]+\\)\. +\\([[:upper:]][[:lower:]][[:lower:]]\\)[^ ]* +\\([0-9]+\\) +\\([^ ]+\\).*$"
330 .
"\\1 \\2 \\3\n \\4 %s"))
331 "Alist of regexps matching message text and replacement text.
333 The regexp must match the start of the message text containing an
334 appointment, but need not include a leading `^'. If it matches the
335 current message, a diary entry is made from the corresponding
336 template. If the template is a string, it should be suitable for
337 passing to `replace-match', and so will have occurrences of `\\D' to
338 substitute the match for the Dth subexpression. It must also contain
339 a single `%s' which will be replaced with the text of the message's
340 Subject field. Any other `%' characters must be doubled, so that the
341 template can be passed to `format'.
343 If the template is actually a function, it is called with the message
344 body text as argument, and may use `match-string' etc. to make a
345 template following the rules above."
346 :type
'(alist :key-type
(regexp :tag
"Regexp matching time/place")
348 (string :tag
"Template for entry")
350 "Unary function providing template")))
354 (defvar diary-header-line-flag
)
355 (defvar diary-header-line-format
)
357 (defun diary-set-header (symbol value
)
358 "Set SYMBOL's value to VALUE, and redraw the diary header if necessary."
359 (let ((oldvalue (symbol-value symbol
))
360 (dbuff (and diary-file
361 (find-buffer-visiting
362 (substitute-in-file-name diary-file
)))))
363 (custom-set-default symbol value
)
365 (not (equal value oldvalue
))
366 (with-current-buffer dbuff
367 (if (eq major-mode
'diary-mode
)
368 (setq header-line-format
(and diary-header-line-flag
369 diary-header-line-format
)))))))
371 ;; This can be removed once the kill/yank treatment of invisible text
372 ;; (see etc/TODO) is fixed. -- gm
373 (defcustom diary-header-line-flag t
374 "Non-nil means `diary-simple-display' will show a header line.
375 The format of the header is specified by `diary-header-line-format'."
378 :initialize
'custom-initialize-default
379 :set
'diary-set-header
382 (defvar diary-selective-display nil
383 "Internal diary variable; non-nil if some diary text is hidden.")
385 (defcustom diary-header-line-format
386 '(:eval
(calendar-string-spread
387 (list (if diary-selective-display
388 "Some text is hidden - press \"s\" in calendar \
392 "Format of the header line displayed by `diary-simple-display'.
393 Only used if `diary-header-line-flag' is non-nil."
396 :initialize
'custom-initialize-default
397 :set
'diary-set-header
400 ;; The first version of this also checked for diary-selective-display
401 ;; in the non-fancy case. This was an attempt to distinguish between
402 ;; displaying the diary and just visiting the diary file. However,
403 ;; when using fancy diary, calling diary when there are no entries to
404 ;; display does not create the fancy buffer, nor does it set
405 ;; diary-selective-display in the diary buffer. This means some
406 ;; customizations will not take effect, eg:
407 ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00466.html
408 ;; So the check for diary-selective-display was dropped. This means the
409 ;; diary will be displayed if one customizes a diary variable while
410 ;; just visiting the diary-file. This is i) unlikely, and ii) no great loss.
412 (defun diary-live-p ()
413 "Return non-nil if the diary is being displayed."
414 (or (get-buffer diary-fancy-buffer
)
416 (find-buffer-visiting (substitute-in-file-name diary-file
)))))
419 (defun diary-set-maybe-redraw (symbol value
)
420 "Set SYMBOL's value to VALUE, and redraw the diary if necessary.
421 Redraws the diary if it is being displayed (note this is not the same as
422 just visiting the `diary-file'), and SYMBOL's value is to be changed."
423 (let ((oldvalue (symbol-value symbol
)))
424 (custom-set-default symbol value
)
425 (and (not (equal value oldvalue
))
427 ;; Note this assumes diary was called without prefix arg.
430 (define-obsolete-variable-alias 'number-of-diary-entries
431 'diary-number-of-entries
"23.1")
433 (defcustom diary-number-of-entries
1
434 "Specifies how many days of diary entries are to be displayed initially.
435 This variable affects the diary display when the command \\[diary] is used,
436 or if the value of the variable `calendar-view-diary-initially-flag' is non-nil.
437 For example, if the default value 1 is used, then only the current day's diary
438 entries will be displayed. If the value 2 is used, then both the current
439 day's and the next day's entries will be displayed.
441 The value can also be a vector such as [0 2 2 2 2 4 1]; this value
442 says to display no diary entries on Sunday, the entries for
443 the current date and the day after on Monday through Thursday,
444 Friday through Monday's entries on Friday, and only Saturday's
447 This variable does not affect the diary display with the `d' command
448 from the calendar; in that case, the prefix argument controls the
449 number of days of diary entries displayed."
450 :type
'(choice (integer :tag
"Entries")
451 (vector :value
[0 0 0 0 0 0 0]
452 (integer :tag
"Sunday")
453 (integer :tag
"Monday")
454 (integer :tag
"Tuesday")
455 (integer :tag
"Wednesday")
456 (integer :tag
"Thursday")
457 (integer :tag
"Friday")
458 (integer :tag
"Saturday")))
459 :initialize
'custom-initialize-default
460 :set
'diary-set-maybe-redraw
463 ;;; More user options in calendar.el, holidays.el.
466 (defun diary-check-diary-file ()
467 "Check that the file specified by `diary-file' exists and is readable.
468 If so, return the expanded file name, otherwise signal an error."
469 (let ((d-file (substitute-in-file-name diary-file
)))
470 (if (and d-file
(file-exists-p d-file
))
471 (if (file-readable-p d-file
)
473 (error "Diary file `%s' is not readable" diary-file
))
474 (error "Diary file `%s' does not exist" diary-file
))))
477 (defun diary (&optional arg
)
478 "Generate the diary window for ARG days starting with the current date.
479 If no argument is provided, the number of days of diary entries is governed
480 by the variable `diary-number-of-entries'. A value of ARG less than 1
481 does nothing. This function is suitable for execution in a `.emacs' file."
483 (diary-check-diary-file)
484 (diary-list-entries (calendar-current-date)
485 (if arg
(prefix-numeric-value arg
))))
488 (defun diary-view-entries (&optional arg
)
489 "Prepare and display a buffer with diary entries.
490 Searches the file named in `diary-file' for entries that
491 match ARG days starting with the date indicated by the cursor position
492 in the displayed three-month calendar."
494 (diary-check-diary-file)
495 (diary-list-entries (calendar-cursor-to-date t
) arg
))
497 (define-obsolete-function-alias 'view-diary-entries
'diary-view-entries
"22.1")
501 (defun diary-view-other-diary-entries (arg dfile
)
502 "Prepare and display buffer of diary entries from an alternative diary file.
503 Searches for entries that match ARG days, starting with the date indicated
504 by the cursor position in the displayed three-month calendar.
505 DFILE specifies the file to use as the diary file."
507 (list (prefix-numeric-value current-prefix-arg
)
508 (read-file-name "Enter diary file name: " default-directory nil t
)))
509 (let ((diary-file dfile
))
510 (diary-view-entries arg
)))
513 (define-obsolete-function-alias 'view-other-diary-entries
514 'diary-view-other-diary-entries
"23.1")
516 (defvar diary-syntax-table
517 (let ((st (copy-syntax-table (standard-syntax-table))))
518 (modify-syntax-entry ?
* "w" st
)
519 (modify-syntax-entry ?
: "w" st
)
521 "The syntax table used when parsing dates in the diary file.
522 It is the standard syntax table used in Fundamental mode, but with the
523 syntax of `*' and `:' changed to be word constituents.")
525 (defun diary-attrtype-convert (attrvalue type
)
526 "Convert string ATTRVALUE to TYPE appropriate for a face description.
527 Valid TYPEs are: string, symbol, int, stringtnil, tnil."
528 (cond ((eq type
'string
) attrvalue
)
529 ((eq type
'symbol
) (intern-soft attrvalue
))
530 ((eq type
'int
) (string-to-number attrvalue
))
531 ((eq type
'stringtnil
)
532 (cond ((string-equal "t" attrvalue
) t
)
533 ((string-equal "nil" attrvalue
) nil
)
535 ((eq type
'tnil
) (string-equal "t" attrvalue
))))
537 (defun diary-pull-attrs (entry fileglobattrs
)
538 "Search for matches for regexps from `diary-face-attrs'.
539 If ENTRY is nil, searches from the start of the current buffer, and
540 prepends all regexps with `diary-glob-file-regexp-prefix'.
541 If ENTRY is a string, search for matches in that string, and remove them.
542 Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs.
543 When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE)
545 (let (regexp regnum attrname attrname attrvalue type ret-attr
)
548 (dolist (attr diary-face-attrs
)
549 ;; FIXME inefficient searching.
550 (goto-char (point-min))
551 (setq regexp
(concat diary-glob-file-regexp-prefix
(car attr
))
553 attrname
(nth 2 attr
)
555 attrvalue
(if (re-search-forward regexp nil t
)
556 (match-string-no-properties regnum
)))
558 (setq attrvalue
(diary-attrtype-convert attrvalue type
))
559 (setq ret-attr
(append ret-attr
560 (list attrname attrvalue
))))))
561 (setq ret-attr fileglobattrs
)
562 (dolist (attr diary-face-attrs
)
563 (setq regexp
(car attr
)
565 attrname
(nth 2 attr
)
568 ;; If multiple matches, replace all, use the last (which may
569 ;; be the first instance in the line, if the regexp is
571 (while (string-match regexp entry
)
572 (setq attrvalue
(match-string-no-properties regnum entry
)
573 entry
(replace-match "" t t entry
)))
575 (setq attrvalue
(diary-attrtype-convert attrvalue type
))
576 (setq ret-attr
(append ret-attr
(list attrname attrvalue
))))))
577 (list entry ret-attr
)))
581 (defvar diary-modify-entry-list-string-function nil
582 "Function applied to entry string before putting it into the entries list.
583 Can be used by programs integrating a diary list into other buffers (e.g.
584 org.el and planner.el) to modify the string or add properties to it.
585 The function takes a string argument and must return a string.")
587 (defvar diary-entries-list
) ; bound in diary-list-entries
589 (defun diary-add-to-list (date string specifier
&optional marker
591 "Add an entry to `diary-entries-list'.
592 Do nothing if DATE or STRING is nil. DATE is the (MONTH DAY
593 YEAR) for which the entry applies; STRING is the text of the
594 entry as it will appear in the diary (i.e. with any format
595 strings such as \"%d\" expanded); SPECIFIER is the date part of
596 the entry as it appears in the diary-file; LITERAL is the entry
597 as it appears in the diary-file (i.e. before expansion). If
598 LITERAL is nil, it is taken to be the same as STRING.
600 The entry is added to the list as (DATE STRING SPECIFIER LOCATOR
601 GLOBCOLOR), where LOCATOR has the form (MARKER FILENAME LITERAL),
602 FILENAME being the file containing the diary entry."
603 (when (and date string
)
604 (if diary-file-name-prefix
605 (let ((prefix (funcall diary-file-name-prefix-function
606 (buffer-file-name))))
607 (or (string-equal prefix
"")
608 (setq string
(format "[%s] %s" prefix string
)))))
609 (and diary-modify-entry-list-string-function
610 (setq string
(funcall diary-modify-entry-list-string-function
612 (setq diary-entries-list
613 (append diary-entries-list
614 (list (list date string specifier
615 (list marker
(buffer-file-name) literal
)
618 (define-obsolete-function-alias 'add-to-diary-list
'diary-add-to-list
"23.1")
620 (defun diary-list-entries-2 (date mark globattr list-only
621 &optional months symbol
)
622 "Internal subroutine of `diary-list-entries'.
623 Find diary entries applying to DATE, by searching from point-min for
624 each element of `diary-date-forms'. MARK indicates an entry is non-marking.
625 GLOBATTR is the list of global file attributes. If LIST-ONLY is
626 non-nil, don't change the buffer, only return a list of entries.
627 Optional array MONTHS replaces `calendar-month-name-array', and
628 means months cannot be abbreviated. Optional string SYMBOL marks diary
629 entries of the desired type. Returns non-nil if any entries were found."
630 (let* ((month (calendar-extract-month date
))
631 (day (calendar-extract-day date
))
632 (year (calendar-extract-year date
))
633 (dayname (format "%s\\|%s\\.?" (calendar-day-name date
)
634 (calendar-day-name date
'abbrev
)))
635 (calendar-month-name-array (or months calendar-month-name-array
))
636 (monthname (format "\\*\\|%s%s" (calendar-month-name month
)
639 (calendar-month-name month
'abbrev
)))))
640 (month (format "\\*\\|0*%d" month
))
641 (day (format "\\*\\|0*%d" day
))
642 (year (format "\\*\\|0*%d%s" year
643 (if diary-abbreviated-year-flag
644 (format "\\|%02d" (% year
100))
648 (dolist (date-form diary-date-forms
)
649 (let ((backup (when (eq (car date-form
) 'backup
)
650 (setq date-form
(cdr date-form
))
652 ;; date-form uses day etc as set above.
653 (regexp (format "^%s?%s\\(%s\\)" (regexp-quote mark
)
654 (if symbol
(regexp-quote symbol
) "")
655 (mapconcat 'eval date-form
"\\)\\(?:")))
656 entry-start date-start temp
)
657 (goto-char (point-min))
658 (while (re-search-forward regexp nil t
)
659 (if backup
(re-search-backward "\\<" nil t
))
660 ;; regexp moves us past the end of date, onto the next line.
661 ;; Trailing whitespace after date not allowed (see diary-file).
662 (if (and (bolp) (not (looking-at "[ \t]")))
663 ;; Diary entry that consists only of date.
665 ;; Found a nonempty diary entry--make it
666 ;; visible and add it to the list.
667 (setq date-start
(line-end-position 0))
668 ;; Actual entry starts on the next-line?
669 (if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
673 (while (looking-at "[ \t]") ; continued entry
675 (unless (and (eobp) (not (bolp)))
678 (remove-overlays date-start
(point) 'invisible
'diary
))
679 (setq temp
(diary-pull-attrs
680 (buffer-substring-no-properties
681 entry-start
(point)) globattr
))
684 (buffer-substring-no-properties (1+ date-start
) (1- entry-start
))
685 (copy-marker entry-start
) (cadr temp
))))))
688 (defvar original-date
) ; from diary-list-entries
689 (defvar file-glob-attrs
)
693 (defun diary-list-entries-1 (months symbol absfunc
)
694 "List diary entries of a certain type.
695 MONTHS is an array of month names. SYMBOL marks diary entries of the type
696 in question. ABSFUNC is a function that converts absolute dates to dates
697 of the appropriate type."
698 (let ((gdate original-date
))
699 (dotimes (idummy number
)
700 (diary-list-entries-2
701 (funcall absfunc
(calendar-absolute-from-gregorian gdate
))
702 diary-nonmarking-symbol file-glob-attrs list-only months symbol
)
704 (calendar-gregorian-from-absolute
705 (1+ (calendar-absolute-from-gregorian gdate
))))))
706 (goto-char (point-min)))
708 ;; FIXME non-greg and list hooks run same number of times?
709 (defun diary-list-entries (date number
&optional list-only
)
710 "Create and display a buffer containing the relevant lines in `diary-file'.
711 The arguments are DATE and NUMBER; the entries selected are those
712 for NUMBER days starting with date DATE. The other entries are hidden
713 using overlays. If NUMBER is less than 1, this function does nothing.
715 Returns a list of all relevant diary entries found, if any, in order by date.
716 The list entries have the form ((MONTH DAY YEAR) STRING SPECIFIER) where
717 \(MONTH DAY YEAR) is the date of the entry, STRING is the entry text, and
718 SPECIFIER is the applicability. If the variable `diary-list-include-blanks'
719 is non-nil, this list includes a dummy diary entry consisting of the empty
720 string for a date with no diary entries.
722 After the list is prepared, the following hooks are run:
724 `diary-nongregorian-listing-hook' can cull dates from the diary
725 and each included file, for example to process Islamic diary
726 entries. Applied to *each* file.
728 `diary-list-entries-hook' adds or manipulates diary entries from
729 external sources. Used, for example, to include diary entries
730 from other files or to sort the diary entries. Invoked *once*
731 only, before the display hook is run.
733 `diary-display-hook' does the actual display of information. If nil,
734 `diary-simple-display' is used. Use `add-hook' to use
735 `diary-fancy-display', if desired, or `ignore' for no display.
737 `diary-hook' is run last. This is used e.g. by `appt-check'.
739 Functions called by these hooks may use the variables ORIGINAL-DATE
740 and NUMBER, which are the arguments with which this function was called.
741 Note that hook functions should _not_ use DATE, but ORIGINAL-DATE.
742 \(Sexp diary entries may use DATE - see `diary-list-sexp-entries'.)
744 If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
746 (setq number
(if (vectorp diary-number-of-entries
)
747 (aref diary-number-of-entries
(calendar-day-of-week date
))
748 diary-number-of-entries
)))
750 (let* ((original-date date
) ; save for possible use in the hooks
751 (date-string (calendar-date-string date
))
752 (d-file (substitute-in-file-name diary-file
))
753 (diary-buffer (find-buffer-visiting d-file
))
754 diary-entries-list file-glob-attrs
)
755 (message "Preparing diary...")
757 (if (not diary-buffer
)
758 (set-buffer (find-file-noselect d-file t
))
759 (set-buffer diary-buffer
)
760 (or (verify-visited-file-modtime diary-buffer
)
761 (revert-buffer t t
)))
762 ;; Setup things like the header-line-format and invisibility-spec.
763 (if (eq major-mode default-major-mode
)
765 ;; This kludge is to make customizations to
766 ;; diary-header-line-flag after diary has been displayed
767 ;; take effect. Unconditionally calling (diary-mode)
768 ;; clobbers file local variables.
769 ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00363.html
770 ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-04/msg00404.html
771 (if (eq major-mode
'diary-mode
)
772 (setq header-line-format
(and diary-header-line-flag
773 diary-header-line-format
))))
774 ;; d-s-p is passed to the diary display function.
775 (let ((diary-saved-point (point)))
777 (setq file-glob-attrs
(cadr (diary-pull-attrs nil
"")))
778 (with-syntax-table diary-syntax-table
779 (goto-char (point-min))
781 (let ((ol (make-overlay (point-min) (point-max) nil t nil
)))
782 (set (make-local-variable 'diary-selective-display
) t
)
783 (overlay-put ol
'invisible
'diary
)
784 (overlay-put ol
'evaporate t
)))
785 (dotimes (idummy number
)
786 (let ((sexp-found (diary-list-sexp-entries date
))
787 (entry-found (diary-list-entries-2
788 date diary-nonmarking-symbol
789 file-glob-attrs list-only
)))
790 (if diary-list-include-blanks
791 (or sexp-found entry-found
792 (diary-add-to-list date
"" "" "" "")))
794 (calendar-gregorian-from-absolute
795 (1+ (calendar-absolute-from-gregorian date
)))))))
796 (goto-char (point-min))
797 (run-hooks 'diary-nongregorian-listing-hook
798 'diary-list-entries-hook
)
800 (if diary-display-hook
801 (run-hooks 'diary-display-hook
)
802 (diary-simple-display)))
803 (run-hooks 'diary-hook
)
804 diary-entries-list
))))))
806 (define-obsolete-function-alias 'list-diary-entries
'diary-list-entries
"22.1")
808 (defun diary-unhide-everything ()
809 "Show all invisible text in the diary."
810 (kill-local-variable 'diary-selective-display
)
811 (remove-overlays (point-min) (point-max) 'invisible
'diary
)
812 (kill-local-variable 'mode-line-format
))
814 (defvar original-date
) ; bound in diary-list-entries
817 (defun diary-include-other-diary-files ()
818 "Include the diary entries from other diary files with those of `diary-file'.
819 This function is suitable for use with `diary-list-entries-hook';
820 it enables you to use shared diary files together with your own.
821 The files included are specified in the `diary-file' by lines of this form:
822 #include \"filename\"
823 This is recursive; that is, #include directives in diary files thus included
824 are obeyed. You can change the `#include' to some other string by
825 changing the variable `diary-include-string'."
826 (goto-char (point-min))
827 (while (re-search-forward
828 (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string
))
830 (let ((diary-file (substitute-in-file-name
831 (match-string-no-properties 1)))
832 (diary-list-include-blanks nil
)
833 (diary-list-entries-hook 'diary-include-other-diary-files
)
834 (diary-display-hook 'ignore
)
836 (if (file-exists-p diary-file
)
837 (if (file-readable-p diary-file
)
839 (setq diary-entries-list
840 (append diary-entries-list
841 (diary-list-entries original-date number
)))
842 (with-current-buffer (find-buffer-visiting diary-file
)
843 (diary-unhide-everything)))
845 (message "Can't read included diary file %s" diary-file
)
848 (message "Can't find included diary file %s" diary-file
)
850 (goto-char (point-min)))
852 (define-obsolete-function-alias 'include-other-diary-files
853 'diary-include-other-diary-files
"23.1")
855 (defvar date-string
) ; bound in diary-list-entries
857 (defun diary-display-no-entries ()
858 "Common subroutine of `diary-simple-display' and `diary-fancy-display'.
859 Handles the case where there are no diary entries.
860 Returns a cons (NOENTRIES . HOLIDAY-STRING)."
861 (let* ((holiday-list (if diary-show-holidays-flag
862 (calendar-check-holidays original-date
)))
863 (hol-string (format "%s%s%s"
865 (if holiday-list
": " "")
866 (mapconcat 'identity holiday-list
"; ")))
867 (msg (format "No diary entries for %s" hol-string
))
868 ;; Empty list, or single item with no text.
869 ;; FIXME multiple items with no text?
870 (noentries (or (not diary-entries-list
)
871 (and (not (cdr diary-entries-list
))
872 (string-equal "" (cadr
873 (car diary-entries-list
)))))))
874 ;; Inconsistency: whether or not the holidays are displayed in a
875 ;; separate buffer depends on if there are diary entries.
877 (if (or (< (length msg
) (frame-width))
880 ;; holiday-list which is too wide for a message gets a buffer.
881 (calendar-in-read-only-buffer holiday-buffer
882 (calendar-set-mode-line (format "Holidays for %s" date-string
))
883 (insert (mapconcat 'identity holiday-list
"\n")))
884 (message "No diary entries for %s" date-string
)))
885 (cons noentries hol-string
)))
888 (defvar diary-saved-point
) ; bound in diary-list-entries
890 (defun diary-simple-display ()
891 "Display the diary buffer if there are any relevant entries or holidays."
892 ;; If selected window is dedicated (to the calendar), need a new one
893 ;; to display the diary.
894 (let* ((pop-up-frames (or pop-up-frames
895 (window-dedicated-p (selected-window))))
896 (dbuff (find-buffer-visiting (substitute-in-file-name diary-file
)))
897 (empty (diary-display-no-entries)))
898 ;; This may be too wide, but when simple diary is used there is
899 ;; nowhere else for the holidays to go. Also, it is documented in
900 ;; diary-show-holidays-flag that the holidays go in the mode-line.
901 ;; FIXME however if there are no diary entries a separate buffer
902 ;; is displayed - this is inconsistent.
903 (with-current-buffer dbuff
904 (calendar-set-mode-line (format "Diary for %s" (cdr empty
))))
905 (unless (car empty
) ; no entries
906 (with-current-buffer dbuff
907 (let ((window (display-buffer (current-buffer))))
908 ;; d-s-p is passed from diary-list-entries.
909 (set-window-point window diary-saved-point
)
910 (set-window-start window
(point-min))))
911 (message "Preparing diary...done"))))
913 (define-obsolete-function-alias 'simple-diary-display
914 'diary-simple-display
"23.1")
916 (define-button-type 'diary-entry
917 'action
#'diary-goto-entry
920 (defun diary-goto-entry (button)
921 "Jump to the diary entry for the BUTTON at point."
922 (let* ((locator (button-get button
'locator
))
923 (marker (car locator
))
925 ;; If marker pointing to diary location is valid, use that.
926 (if (and marker
(setq markbuf
(marker-buffer marker
)))
928 (pop-to-buffer markbuf
)
929 (goto-char (marker-position marker
)))
930 ;; Marker is invalid (eg buffer has been killed).
931 (or (and (setq file
(cadr locator
))
933 (find-file-other-window file
)
935 (when (eq major-mode default-major-mode
) (diary-mode))
936 (goto-char (point-min))
937 (if (re-search-forward (format "%s.*\\(%s\\)"
938 (regexp-quote (nth 2 locator
))
939 (regexp-quote (nth 3 locator
)))
941 (goto-char (match-beginning 1)))))
942 (message "Unable to locate this diary entry")))))
944 (defun diary-fancy-display ()
945 "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
946 To use this function, add it to `diary-display-hook'."
947 ;; Turn off selective-display in the diary file's buffer.
949 (find-buffer-visiting (substitute-in-file-name diary-file
))
950 (diary-unhide-everything))
951 (unless (car (diary-display-no-entries)) ; no entries
952 ;; Prepare the fancy diary buffer.
953 (calendar-in-read-only-buffer diary-fancy-buffer
954 (calendar-set-mode-line "Diary Entries")
955 (let ((holiday-list-last-month 1)
956 (holiday-list-last-year 1)
959 (dolist (entry diary-entries-list
)
960 (unless (calendar-date-equal date
(car entry
))
961 (setq date
(car entry
))
962 (and diary-show-holidays-flag
963 (calendar-date-compare
964 (list (list holiday-list-last-month
965 (calendar-last-day-of-month
966 holiday-list-last-month
967 holiday-list-last-year
)
968 holiday-list-last-year
))
970 ;; We need to get the holidays for the next 3 months.
971 (setq holiday-list-last-month
972 (calendar-extract-month date
)
973 holiday-list-last-year
974 (calendar-extract-year date
))
976 (calendar-increment-month
977 holiday-list-last-month holiday-list-last-year
1)
980 (let ((displayed-month holiday-list-last-month
)
981 (displayed-year holiday-list-last-year
))
982 (calendar-holiday-list)))
983 (calendar-increment-month
984 holiday-list-last-month holiday-list-last-year
1))
986 date-holiday-list cc
)
987 ;; Make a list of all holidays for date.
988 (dolist (h holiday-list
)
989 (if (calendar-date-equal date
(car h
))
990 (setq date-holiday-list
(append date-holiday-list
992 (insert (if (bobp) "" ?
\n) (calendar-date-string date
))
993 (if date-holiday-list
(insert ": "))
994 (setq cc
(current-column))
995 (insert (mapconcat (lambda (x)
996 (setq longest
(max longest
(length x
)))
999 (concat "\n" (make-string cc ?\s
))))
1000 (insert ?
\n (make-string (+ cc longest
) ?
=) ?
\n)))
1001 (let ((this-entry (cadr entry
))
1002 this-loc marks temp-face
)
1003 (unless (zerop (length this-entry
))
1004 (if (setq this-loc
(nth 3 entry
))
1005 (insert-button (concat this-entry
"\n")
1006 ;; (MARKER FILENAME SPECIFIER LITERAL)
1007 'locator
(list (car this-loc
)
1010 (or (nth 2 this-loc
)
1013 (insert this-entry ?
\n))
1015 (setq marks
(nth 4 entry
))
1017 (setq temp-face
(calendar-make-temp-face marks
))
1018 (search-backward this-entry
)
1020 (make-overlay (match-beginning 0) (match-end 0))
1021 'face temp-face
)))))))
1022 (diary-fancy-display-mode)
1023 (calendar-set-mode-line date-string
)
1024 (message "Preparing diary...done"))))
1026 (define-obsolete-function-alias 'fancy-diary-display
1027 'diary-fancy-display
"23.1")
1030 (defun diary-print-entries ()
1031 "Print a hard copy of the diary display.
1033 If the simple diary display is being used, prepare a temp buffer with the
1034 visible lines of the diary buffer, add a heading line composed from the mode
1035 line, print the temp buffer, and destroy it.
1037 If the fancy diary display is being used, just print the buffer.
1039 The hooks given by the variable `diary-print-entries-hook' are called to do
1040 the actual printing."
1042 (let ((diary-buffer (get-buffer diary-fancy-buffer
))
1043 temp-buffer heading start end
)
1045 (with-current-buffer diary-buffer
1046 (run-hooks 'diary-print-entries-hook
))
1047 (or (setq diary-buffer
1048 (find-buffer-visiting (substitute-in-file-name diary-file
)))
1049 (error "You don't have a diary buffer!"))
1050 ;; Name affects printing?
1051 (setq temp-buffer
(get-buffer-create " *Printable Diary Entries*"))
1052 (with-current-buffer diary-buffer
1054 (if (not (stringp mode-line-format
))
1056 (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format
)
1057 (match-string 1 mode-line-format
))
1061 (setq end
(next-single-char-property-change start
'invisible
))
1062 (unless (get-char-property start
'invisible
)
1063 (with-current-buffer temp-buffer
1064 (insert-buffer-substring diary-buffer start end
)))
1066 (and end
(< end
(point-max))))))
1067 (set-buffer temp-buffer
)
1068 (goto-char (point-min))
1069 (insert heading
"\n"
1070 (make-string (length heading
) ?
=) "\n")
1071 (run-hooks 'diary-print-entries-hook
)
1072 (kill-buffer temp-buffer
))))
1074 (define-obsolete-function-alias 'print-diary-entries
1075 'diary-print-entries
"23.1")
1078 (defun diary-show-all-entries ()
1079 "Show all of the diary entries in the diary file.
1080 This function gets rid of the selective display of the diary file so that
1081 all entries, not just some, are visible. If there is no diary buffer, one
1084 (let ((d-file (diary-check-diary-file))
1085 (pop-up-frames (or pop-up-frames
1086 (window-dedicated-p (selected-window)))))
1087 (with-current-buffer (or (find-buffer-visiting d-file
)
1088 (find-file-noselect d-file t
))
1089 (when (eq major-mode default-major-mode
) (diary-mode))
1090 (diary-unhide-everything)
1091 (display-buffer (current-buffer)))))
1093 (define-obsolete-function-alias 'show-all-diary-entries
1094 'diary-show-all-entries
"22.1")
1097 (defun diary-mail-entries (&optional ndays
)
1098 "Send a mail message showing diary entries for next NDAYS days.
1099 If no prefix argument is given, NDAYS is set to `diary-mail-days'.
1100 Mail is sent to the address specified by `diary-mail-addr'.
1102 Here is an example of a script to call `diary-mail-entries',
1103 suitable for regular scheduling using cron (or at). Note that
1104 since `emacs -script' does not load your `.emacs' file, you
1105 should ensure that all relevant variables are set.
1107 #!/usr/bin/emacs -script
1108 ;; diary-rem.el - run the Emacs diary-reminder
1110 \(setq diary-mail-days 3
1111 diary-file \"/path/to/diary.file\"
1112 calendar-date-style 'european
1113 diary-mail-addr \"user@host.name\")
1115 \(diary-mail-entries)
1117 # diary-rem.el ends here
1120 (if (string-equal diary-mail-addr
"")
1121 (error "You must set `diary-mail-addr' to use this command")
1122 (let ((diary-display-hook 'diary-fancy-display
))
1123 (diary-list-entries (calendar-current-date) (or ndays diary-mail-days
)))
1124 (compose-mail diary-mail-addr
1125 (concat "Diary entries generated "
1126 (calendar-date-string (calendar-current-date))))
1128 (if (get-buffer diary-fancy-buffer
)
1129 (with-current-buffer diary-fancy-buffer
(buffer-string))
1130 "No entries found"))
1131 (call-interactively (get mail-user-agent
'sendfunc
))))
1133 (defun diary-name-pattern (string-array &optional abbrev-array paren
)
1134 "Return a regexp matching the strings in the array STRING-ARRAY.
1135 If the optional argument ABBREV-ARRAY is present, then the function
1136 `calendar-abbrev-construct' is used to construct abbreviations from the
1137 two supplied arrays. The returned regexp will then also match these
1138 abbreviations, with or without final `.' characters. If the optional
1139 argument PAREN is non-nil, the regexp is surrounded by parentheses."
1140 (regexp-opt (append string-array
1142 (calendar-abbrev-construct abbrev-array
1145 (calendar-abbrev-construct abbrev-array
1151 (defvar diary-marking-entries-flag nil
1152 "True during the marking of diary entries, nil otherwise.")
1154 (defvar diary-marking-entry-flag nil
1155 "True during the marking of diary entries, if current entry is marking.")
1157 ;; file-glob-attrs bound in diary-mark-entries.
1158 (defun diary-mark-entries-1 (markfunc &optional months symbol absfunc
)
1159 "Mark diary entries of a certain type.
1160 MARKFUNC is a function that marks entries of the appropriate type
1161 matching a given date pattern. MONTHS is an array of month names.
1162 SYMBOL marks diary entries of the type in question. ABSFUNC is a
1163 function that converts absolute dates to dates of the appropriate type. "
1164 (let ((dayname (diary-name-pattern calendar-day-name-array
1165 calendar-day-abbrev-array
))
1166 (monthname (format "%s\\|\\*"
1168 (diary-name-pattern months
)
1169 (diary-name-pattern calendar-month-name-array
1170 calendar-month-abbrev-array
))))
1171 (month "[0-9]+\\|\\*")
1172 (day "[0-9]+\\|\\*")
1173 (year "[0-9]+\\|\\*")
1174 (case-fold-search t
)
1176 (dolist (date-form diary-date-forms
)
1177 (if (eq (car date-form
) 'backup
) ; ignore 'backup directive
1178 (setq date-form
(cdr date-form
)))
1179 (let* ((l (length date-form
))
1180 (d-name-pos (- l
(length (memq 'dayname date-form
))))
1181 (d-name-pos (if (/= l d-name-pos
) (1+ d-name-pos
)))
1182 (m-name-pos (- l
(length (memq 'monthname date-form
))))
1183 (m-name-pos (if (/= l m-name-pos
) (1+ m-name-pos
)))
1184 (d-pos (- l
(length (memq 'day date-form
))))
1185 (d-pos (if (/= l d-pos
) (1+ d-pos
)))
1186 (m-pos (- l
(length (memq 'month date-form
))))
1187 (m-pos (if (/= l m-pos
) (1+ m-pos
)))
1188 (y-pos (- l
(length (memq 'year date-form
))))
1189 (y-pos (if (/= l y-pos
) (1+ y-pos
)))
1190 (regexp (format "^%s\\(%s\\)"
1191 (if symbol
(regexp-quote symbol
) "")
1192 (mapconcat 'eval date-form
"\\)\\("))))
1193 (goto-char (point-min))
1194 (while (re-search-forward regexp nil t
)
1197 (match-string-no-properties d-name-pos
)))
1200 (match-string-no-properties m-name-pos
)))
1201 (mm (string-to-number
1203 (match-string-no-properties m-pos
)
1205 (dd (string-to-number
1207 (match-string-no-properties d-pos
)
1210 (match-string-no-properties y-pos
)))
1213 (if (and (= (length y-str
) 2)
1214 diary-abbreviated-year-flag
)
1216 (calendar-extract-year
1220 (calendar-absolute-from-gregorian
1221 (calendar-current-date)))
1222 (calendar-current-date))))
1223 (y (+ (string-to-number y-str
)
1224 ;; Current century, eg 2000.
1225 (* 100 (/ current-y
100))))
1226 (offset (- y current-y
)))
1227 ;; Add 2-digit year to current century.
1228 ;; If more than 50 years in the future,
1229 ;; assume last century. If more than 50
1230 ;; years in the past, assume next century.
1236 (string-to-number y-str
)))))
1237 (setq marks
(cadr (diary-pull-attrs
1238 (buffer-substring-no-properties
1239 (point) (line-end-position))
1242 (calendar-mark-days-named
1243 (cdr (assoc-string dd-name
1244 (calendar-make-alist
1245 calendar-day-name-array
1246 0 nil calendar-day-abbrev-array
) t
)) marks
)
1249 (if (string-equal mm-name
"*") 0
1252 (if months
(calendar-make-alist months
)
1253 (calendar-make-alist
1254 calendar-month-name-array
1255 1 nil calendar-month-abbrev-array
)) t
)))))
1256 (funcall markfunc mm dd yy marks
))))))))
1259 (defun diary-mark-entries (&optional redraw
)
1260 "Mark days in the calendar window that have diary entries.
1261 Each entry in the diary file visible in the calendar window is
1262 marked. After the entries are marked, the hooks
1263 `diary-nongregorian-marking-hook' and `diary-mark-entries-hook'
1264 are run. If the optional argument REDRAW is non-nil (which is
1265 the case interactively, for example) then any existing diary
1266 marks are first removed. This is intended to deal with deleted
1269 ;; To remove any deleted diary entries. Do not redraw when:
1270 ;; i) processing #include diary files (else only get the marks from
1271 ;; the last #include file processed).
1272 ;; ii) called via calendar-redraw (since calendar has already been
1274 ;; Use of REDRAW handles both of these cases.
1275 (when (and redraw calendar-mark-diary-entries-flag
)
1276 (setq calendar-mark-diary-entries-flag nil
)
1278 (let ((diary-marking-entries-flag t
)
1280 (with-current-buffer (find-file-noselect (diary-check-diary-file) t
)
1282 (when (eq major-mode default-major-mode
) (diary-mode))
1283 (setq calendar-mark-diary-entries-flag t
)
1284 (message "Marking diary entries...")
1285 (setq file-glob-attrs
(nth 1 (diary-pull-attrs nil
'())))
1286 (with-syntax-table diary-syntax-table
1287 (diary-mark-entries-1 'calendar-mark-date-pattern
)
1288 (diary-mark-sexp-entries)
1289 (run-hooks 'diary-nongregorian-marking-hook
1290 'diary-mark-entries-hook
))
1291 (message "Marking diary entries...done")))))
1294 (define-obsolete-function-alias 'mark-diary-entries
'diary-mark-entries
"23.1")
1296 (defun diary-sexp-entry (sexp entry date
)
1297 "Process a SEXP diary ENTRY for DATE."
1298 (let ((result (if calendar-debug-sexp
1299 (let ((stack-trace-on-error t
))
1300 (eval (car (read-from-string sexp
))))
1302 (eval (car (read-from-string sexp
)))
1305 (message "Bad sexp at line %d in %s: %s"
1306 (count-lines (point-min) (point))
1309 (cond ((stringp result
) result
)
1310 ((and (consp result
)
1311 (stringp (cdr result
))) result
)
1315 (defvar displayed-year
) ; bound in calendar-generate
1316 (defvar displayed-month
)
1318 (defun diary-mark-sexp-entries ()
1319 "Mark days in the calendar window that have sexp diary entries.
1320 Each entry in the diary file (or included files) visible in the calendar window
1321 is marked. See the documentation for the function `diary-list-sexp-entries'."
1322 (let* ((sexp-mark (regexp-quote diary-sexp-entry-symbol
))
1323 (s-entry (format "^\\(%s(\\)\\|\\(%s%s(diary-remind\\)" sexp-mark
1324 (regexp-quote diary-nonmarking-symbol
)
1326 (file-glob-attrs (nth 1 (diary-pull-attrs nil
'())))
1327 m y first-date last-date date mark file-glob-attrs
1328 sexp-start sexp entry entry-start
)
1329 (with-current-buffer calendar-buffer
1330 (setq m displayed-month
1332 (calendar-increment-month m y -
1)
1333 (setq first-date
(calendar-absolute-from-gregorian (list m
1 y
)))
1334 (calendar-increment-month m y
2)
1336 (calendar-absolute-from-gregorian
1337 (list m
(calendar-last-day-of-month m y
) y
)))
1338 (goto-char (point-min))
1339 (while (re-search-forward s-entry nil t
)
1340 (setq diary-marking-entry-flag
(char-equal (preceding-char) ?\
())
1341 (re-search-backward "(")
1342 (setq sexp-start
(point))
1344 (setq sexp
(buffer-substring-no-properties sexp-start
(point)))
1346 (if (and (bolp) (not (looking-at "[ \t]")))
1347 ;; Diary entry consists only of the sexp.
1351 (setq entry-start
(point))
1352 ;; Find end of entry.
1354 (while (looking-at "[ \t]")
1356 (if (bolp) (backward-char 1))
1357 (setq entry
(buffer-substring-no-properties entry-start
(point))))
1358 (setq date
(1- first-date
))
1359 ;; FIXME this loops over all visible dates.
1360 ;; Could be optimized in many cases. Depends on whether t or * present.
1361 (while (<= (setq date
(1+ date
)) last-date
)
1362 (when (setq mark
(diary-sexp-entry
1364 (calendar-gregorian-from-absolute date
)))
1365 (calendar-mark-visible-date
1366 (calendar-gregorian-from-absolute date
)
1367 (or (cadr (diary-pull-attrs entry file-glob-attrs
))
1368 (if (consp mark
) (car mark
)))))))))
1370 (define-obsolete-function-alias 'mark-sexp-diary-entries
1371 'diary-mark-sexp-entries
"23.1")
1373 (defun diary-mark-included-diary-files ()
1374 "Mark the diary entries from other diary files with those of the diary file.
1375 This function is suitable for use with `diary-mark-entries-hook'; it enables
1376 you to use shared diary files together with your own. The files included are
1377 specified in the `diary-file' by lines of this form:
1378 #include \"filename\"
1379 This is recursive; that is, #include directives in diary files thus included
1380 are obeyed. You can change the `#include' to some other string by
1381 changing the variable `diary-include-string'."
1382 (goto-char (point-min))
1383 (while (re-search-forward
1384 (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string
))
1386 (let* ((diary-file (substitute-in-file-name
1387 (match-string-no-properties 1)))
1388 (diary-mark-entries-hook 'diary-mark-included-diary-files
)
1389 (dbuff (find-buffer-visiting diary-file
)))
1390 (if (file-exists-p diary-file
)
1391 (if (file-readable-p diary-file
)
1393 (diary-mark-entries)
1395 (kill-buffer (find-buffer-visiting diary-file
))))
1397 (message "Can't read included diary file %s" diary-file
)
1400 (message "Can't find included diary file %s" diary-file
)
1402 (goto-char (point-min)))
1404 (define-obsolete-function-alias 'mark-included-diary-files
1405 'diary-mark-included-diary-files
"23.1")
1407 (defun calendar-mark-days-named (dayname &optional color
)
1408 "Mark all dates in the calendar window that are day DAYNAME of the week.
1409 0 means all Sundays, 1 means all Mondays, and so on.
1410 Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
1411 (with-current-buffer calendar-buffer
1412 (let ((prev-month displayed-month
)
1413 (prev-year displayed-year
)
1414 (succ-month displayed-month
)
1415 (succ-year displayed-year
)
1418 (calendar-increment-month succ-month succ-year
1)
1419 (calendar-increment-month prev-month prev-year -
1)
1420 (setq day
(calendar-absolute-from-gregorian
1421 (calendar-nth-named-day 1 dayname prev-month prev-year
))
1422 last-day
(calendar-absolute-from-gregorian
1423 (calendar-nth-named-day -
1 dayname succ-month succ-year
)))
1424 (while (<= day last-day
)
1425 (calendar-mark-visible-date (calendar-gregorian-from-absolute day
)
1427 (setq day
(+ day
7))))))
1429 (define-obsolete-function-alias 'mark-calendar-days-named
1430 'calendar-mark-days-named
"23.1")
1432 (defun calendar-mark-month (month year p-month p-day p-year
&optional color
)
1433 "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P-DAY/P-YEAR.
1434 A value of 0 in any position of the pattern is a wildcard.
1435 Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
1436 (if (or (and (= month p-month
)
1437 (or (zerop p-year
) (= year p-year
)))
1438 (and (zerop p-month
)
1439 (or (zerop p-year
) (= year p-year
))))
1441 (dotimes (i (calendar-last-day-of-month month year
))
1442 (calendar-mark-visible-date (list month
(1+ i
) year
) color
))
1443 (calendar-mark-visible-date (list month p-day year
) color
))))
1445 (define-obsolete-function-alias 'mark-calendar-month
1446 'calendar-mark-month
"23.1")
1448 (defun calendar-mark-date-pattern (month day year
&optional color
)
1449 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
1450 A value of 0 in any position is a wildcard. Optional argument COLOR is
1451 passed to `calendar-mark-visible-date' as MARK."
1452 (with-current-buffer calendar-buffer
1453 (let ((m displayed-month
)
1455 (calendar-increment-month m y -
1)
1457 (calendar-mark-month m y month day year color
)
1458 (calendar-increment-month m y
1)))))
1460 (define-obsolete-function-alias 'mark-calendar-date-pattern
1461 'calendar-mark-date-pattern
"23.1")
1463 ;; Bahai, Hebrew, Islamic.
1464 (defun calendar-mark-complex (month day year fromabs
&optional color
)
1465 "Mark dates in the calendar conforming to MONTH DAY YEAR of some system.
1466 The function FROMABS converts absolute dates to the appropriate date system.
1467 Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
1468 ;; Not one of the simple cases--check all visible dates for match.
1469 ;; Actually, the following code takes care of ALL of the cases, but
1470 ;; it's much too slow to be used for the simple (common) cases.
1471 (let* ((m displayed-month
)
1474 (calendar-increment-month m y -
1)
1475 (calendar-absolute-from-gregorian (list m
1 y
))))
1477 (calendar-increment-month m y
2)
1478 (calendar-absolute-from-gregorian
1479 (list m
(calendar-last-day-of-month m y
) y
))))
1480 (date (1- first-date
))
1482 (while (<= (setq date
(1+ date
)) last-date
)
1483 (setq local-date
(funcall fromabs date
))
1484 (and (or (zerop month
)
1485 (= month
(calendar-extract-month local-date
)))
1487 (= day
(calendar-extract-day local-date
)))
1489 (= year
(calendar-extract-year local-date
)))
1490 (calendar-mark-visible-date
1491 (calendar-gregorian-from-absolute date
) color
)))))
1494 (defun calendar-mark-1 (month day year fromabs toabs
&optional color
)
1495 "Mark dates in the calendar conforming to MONTH DAY YEAR of some system.
1496 The function FROMABS converts absolute dates to the appropriate date system.
1497 The function TOABDS carries out the inverse operation. Optional argument
1498 COLOR is passed to `calendar-mark-visible-date' as MARK."
1500 (set-buffer calendar-buffer
)
1501 (if (and (not (zerop month
)) (not (zerop day
)))
1502 (if (not (zerop year
))
1503 ;; Fully specified date.
1504 (let ((date (calendar-gregorian-from-absolute
1505 (funcall toabs
(list month day year
)))))
1506 (if (calendar-date-is-visible-p date
)
1507 (calendar-mark-visible-date date color
)))
1508 ;; Month and day in any year--this taken from the holiday stuff.
1509 (let* ((i-date (funcall fromabs
1510 (calendar-absolute-from-gregorian
1511 (list displayed-month
15 displayed-year
))))
1512 (m (calendar-extract-month i-date
))
1513 (y (calendar-extract-year i-date
))
1515 (unless (< m
1) ; calendar doesn't apply
1516 (calendar-increment-month m y
(- 10 month
))
1517 (and (> m
7) ; date might be visible
1518 (calendar-date-is-visible-p
1519 (setq date
(calendar-gregorian-from-absolute
1520 (funcall toabs
(list month day y
)))))
1521 (calendar-mark-visible-date date color
)))))
1522 (calendar-mark-complex month day year
1523 'calendar-bahai-from-absolute color
))))
1526 (defun diary-entry-time (s)
1527 "Return time at the beginning of the string S as a military-style integer.
1528 For example, returns 1325 for 1:25pm.
1530 Returns `diary-unknown-time' (default value -9999) if no time is recognized.
1531 The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam,
1532 XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can
1533 be used instead of a colon (:) to separate the hour and minute parts."
1534 (let (case-fold-search)
1535 (cond ((string-match ; military time
1536 "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
1538 (+ (* 100 (string-to-number (match-string 1 s
)))
1539 (string-to-number (match-string 2 s
))))
1540 ((string-match ; hour only (XXam or XXpm)
1541 "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s
)
1542 (+ (* 100 (%
(string-to-number (match-string 1 s
)) 12))
1543 (if (equal ?a
(downcase (aref s
(match-beginning 2))))
1545 ((string-match ; hour and minute (XX:XXam or XX:XXpm)
1546 "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s
)
1547 (+ (* 100 (%
(string-to-number (match-string 1 s
)) 12))
1548 (string-to-number (match-string 2 s
))
1549 (if (equal ?a
(downcase (aref s
(match-beginning 3))))
1551 (t diary-unknown-time
)))) ; unrecognizable
1553 (defun diary-entry-compare (e1 e2
)
1554 "Return t if E1 is earlier than E2."
1555 (or (calendar-date-compare e1 e2
)
1556 (and (calendar-date-equal (car e1
) (car e2
))
1557 (let* ((ts1 (cadr e1
)) (t1 (diary-entry-time ts1
))
1558 (ts2 (cadr e2
)) (t2 (diary-entry-time ts2
)))
1561 (string-lessp ts1 ts2
)))))))
1563 (defun diary-sort-entries ()
1564 "Sort the list of diary entries by time of day."
1565 (setq diary-entries-list
(sort diary-entries-list
'diary-entry-compare
)))
1567 (define-obsolete-function-alias 'sort-diary-entries
'diary-sort-entries
"23.1")
1570 (defun diary-list-sexp-entries (date)
1571 "Add sexp entries for DATE from the diary file to `diary-entries-list'.
1572 Also, make them visible in the diary. Returns t if any entries are found.
1574 Sexp diary entries must be prefaced by a `diary-sexp-entry-symbol'
1575 \(normally `%%'). The form of a sexp diary entry is
1579 Both ENTRY and DATE are available when the SEXP is evaluated. If
1580 the SEXP returns nil, the diary entry does not apply. If it
1581 returns a non-nil value, ENTRY will be taken to apply to DATE; if
1582 the value is a string, that string will be the diary entry in the
1583 fancy diary display.
1585 For example, the following diary entry will apply to the 21st of
1586 the month if it is a weekday and the Friday before if the 21st is
1589 &%%(let ((dayname (calendar-day-of-week date))
1590 (day (calendar-extract-day date)))
1592 (and (= day 21) (memq dayname '(1 2 3 4 5)))
1593 (and (memq day '(19 20)) (= dayname 5)))
1594 ) UIUC pay checks deposited
1596 A number of built-in functions are available for this type of
1597 diary entry. In the following, the optional parameter MARK
1598 specifies a face or single-character string to use when
1599 highlighting the day in the calendar. For those functions that
1600 take MONTH, DAY, and YEAR as arguments, the order of the input
1601 parameters changes according to `calendar-date-style' (e.g. to
1602 DAY MONTH YEAR in the European style).
1604 %%(diary-date MONTH DAY YEAR &optional MARK) text
1605 Entry applies if date is MONTH, DAY, YEAR. DAY, MONTH, and YEAR can
1606 be a list of integers, `t' (meaning all values), or an integer.
1608 %%(diary-float MONTH DAYNAME N &optional DAY MARK) text
1609 Entry will appear on the Nth DAYNAME of MONTH (0 being Sunday,
1610 1 Monday, etc; if N is negative it counts backward from the end
1611 of the month. MONTH can be a list of months, a single month, or `t'
1612 to specify all months. Optional DAY means the Nth DAYNAME of MONTH
1613 on or after/before DAY. DAY defaults to 1 if N>0 and the last day of
1616 %%(diary-block M1 D1 Y1 M2 D2 Y2 &optional MARK) text
1617 Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
1620 %%(diary-anniversary MONTH DAY YEAR &optional MARK) text
1621 Entry will appear on anniversary dates of MONTH DAY, YEAR.
1622 Text can contain `%d' or `%d%s'; `%d' will be replaced by the
1623 number of years since the MONTH DAY, YEAR, and `%s' by the
1624 ordinal ending of that number (i.e. `st', `nd', `rd' or `th',
1625 as appropriate). The anniversary of February 29 is
1626 considered to be March 1 in a non-leap year.
1628 %%(diary-cyclic N MONTH DAY YEAR &optional MARK) text
1629 Entry will appear every N days, starting MONTH DAY, YEAR.
1630 Text can contain `%d' or `%d%s'; `%d' will be replaced by the
1631 number of repetitions since the MONTH DAY, YEAR and `%s' by
1632 the ordinal ending of that number (i.e. `st', `nd', `rd' or
1633 `th', as appropriate).
1635 %%(diary-remind SEXP DAYS &optional MARKING) text
1636 Entry is a reminder for diary sexp SEXP. DAYS is either a
1637 single number or a list of numbers indicating the number(s)
1638 of days before the event that the warning(s) should occur.
1639 A negative number -DAYS has the same meaning as a list (1 2 ... DAYS).
1640 If the current date is (one of) DAYS before the event indicated
1641 by EXPR, then a suitable message (as specified by
1642 `diary-remind-message') appears. In addition to the
1643 reminders beforehand, the diary entry also appears on the
1644 date itself. If optional MARKING is non-nil then the
1645 *reminders* are marked on the calendar. Marking of reminders
1646 is independent of whether the entry *itself* is a marking or
1649 %%(diary-hebrew-yahrzeit MONTH DAY YEAR) text
1650 Text is assumed to be the name of the person; the date is the
1651 date of death on the *civil* calendar. The diary entry will
1652 appear on the proper Hebrew-date anniversary and on the day
1655 All the remaining functions do not accept any text, and so only
1656 make sense with `diary-fancy-display'. Most produce output every day.
1658 `diary-day-of-year' - day of year and number of days remaining
1659 `diary-iso-date' - ISO commercial date
1660 `diary-astro-day-number' - astronomical (Julian) day number
1661 `diary-sunrise-sunset' - local times of sunrise and sunset
1663 These functions give the date in alternative calendrical systems:
1665 `diary-bahai-date', `diary-chinese-date', `diary-coptic-date',
1666 `diary-ethiopic-date', `diary-french-date', `diary-hebrew-date',
1667 `diary-islamic-date', `diary-julian-date', `diary-mayan-date',
1668 `diary-persian-date'
1670 Theses functions only produce output on certain dates:
1672 `diary-phases-of-moon' - phases of moon (on the appropriate days)
1673 `diary-hebrew-omer' - Omer count, within 50 days after Passover
1674 `diary-hebrew-parasha' - weekly parasha, every Saturday
1675 `diary-hebrew-rosh-hodesh' - Rosh Hodesh, or the day or Saturday before
1676 `diary-hebrew-sabbath-candles' - local time of candle lighting, on Fridays
1679 Marking these entries is *extremely* time consuming, so it is
1680 best if they are non-marking."
1681 (let ((s-entry (format "^%s?%s(" (regexp-quote diary-nonmarking-symbol
)
1682 (regexp-quote diary-sexp-entry-symbol
)))
1683 entry-found file-glob-attrs marks
1684 sexp-start sexp entry specifier entry-start line-start
1685 diary-entry temp literal
)
1686 (goto-char (point-min))
1688 (setq file-glob-attrs
(nth 1 (diary-pull-attrs nil
'()))))
1689 (while (re-search-forward s-entry nil t
)
1691 (setq sexp-start
(point))
1693 (setq sexp
(buffer-substring-no-properties sexp-start
(point))
1694 line-start
(line-end-position 0)
1696 (buffer-substring-no-properties (1+ line-start
) (point))
1697 entry-start
(1+ line-start
))
1699 (if (and (bolp) (not (looking-at "[ \t]")))
1700 ;; Diary entry consists only of the sexp.
1704 (setq entry-start
(point))
1706 (while (looking-at "[ \t]")
1709 (setq entry
(buffer-substring-no-properties entry-start
(point))))
1710 (setq diary-entry
(diary-sexp-entry sexp entry date
)
1711 literal entry
; before evaluation
1712 entry
(if (consp diary-entry
)
1716 (remove-overlays line-start
(point) 'invisible
'diary
)
1717 (if (< 0 (length entry
))
1718 (setq temp
(diary-pull-attrs entry file-glob-attrs
)
1720 marks
(nth 1 temp
))))
1721 (diary-add-to-list date entry specifier
1722 (if entry-start
(copy-marker entry-start
))
1724 (setq entry-found
(or entry-found diary-entry
)))
1727 (define-obsolete-function-alias 'list-sexp-diary-entries
1728 'diary-list-sexp-entries
"23.1")
1730 (defun diary-make-date (a b c
)
1731 "Convert A B C into the internal calendar date form.
1732 The expected order of the inputs depends on `calendar-date-style',
1733 e.g. in the European case, A = day, B = month, C = year. Returns
1734 a list\(MONTH DAY YEAR), i.e. the American style, which is the
1735 form used internally by the calendar and diary."
1736 (cond ((eq calendar-date-style
'iso
) ; YMD
1738 ((eq calendar-date-style
'european
) ; DMY
1743 ;;; Sexp diary functions.
1748 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
1749 (defun diary-date (month day year
&optional mark
)
1750 "Specific date(s) diary entry.
1751 Entry applies if date is MONTH, DAY, YEAR. Each parameter can be
1752 a list of integers, `t' (meaning all values), or an integer. The
1753 order of the input parameters changes according to `calendar-date-style'
1754 \(e.g. to DAY MONTH YEAR in the European style).
1756 An optional parameter MARK specifies a face or single-character string to
1757 use when highlighting the day in the calendar."
1758 (let* ((ddate (diary-make-date month day year
))
1759 (dd (calendar-extract-day ddate
))
1760 (mm (calendar-extract-month ddate
))
1761 (yy (calendar-extract-year ddate
))
1762 (m (calendar-extract-month date
))
1763 (y (calendar-extract-year date
))
1764 (d (calendar-extract-day date
)))
1766 (or (and (listp dd
) (memq d dd
))
1769 (or (and (listp mm
) (memq m mm
))
1772 (or (and (listp yy
) (memq y yy
))
1775 (cons mark entry
))))
1777 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
1778 (defun diary-block (m1 d1 y1 m2 d2 y2
&optional mark
)
1780 Entry applies if date is between, or on one of, two dates. The
1781 order of the input parameters changes according to
1782 `calendar-date-style' (e.g. to D1, M1, Y1, D2, M2, Y2 in the European style).
1784 An optional parameter MARK specifies a face or single-character string to
1785 use when highlighting the day in the calendar."
1786 (let ((date1 (calendar-absolute-from-gregorian
1787 (diary-make-date m1 d1 y1
)))
1788 (date2 (calendar-absolute-from-gregorian
1789 (diary-make-date m2 d2 y2
)))
1790 (d (calendar-absolute-from-gregorian date
)))
1791 (and (<= date1 d
) (<= d date2
)
1792 (cons mark entry
))))
1794 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
1795 (defun diary-float (month dayname n
&optional day mark
)
1796 "Floating diary entry--entry applies if date is the nth dayname of month.
1797 Parameters are MONTH, DAYNAME, N. MONTH can be a list of months, an integer,
1798 or `t' (meaning all months). If N is negative, count backward from the end
1801 An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY.
1802 Optional MARK specifies a face or single-character string to use when
1803 highlighting the day in the calendar."
1804 ;; This is messy because the diary entry may apply, but the date on which it
1805 ;; is based can be in a different month/year. For example, asking for the
1806 ;; first Monday after December 30. For large values of |n| the problem is
1808 (and (= dayname
(calendar-day-of-week date
))
1809 (let* ((m (calendar-extract-month date
))
1810 (d (calendar-extract-day date
))
1811 (y (calendar-extract-year date
))
1812 ;; Last (n>0) or first (n<0) possible base date for entry.
1814 (calendar-nth-named-absday (- n
) dayname m y d
))
1815 (last-abs (if (> n
0) limit
(+ limit
6)))
1816 (first-abs (if (> n
0) (- limit
6) limit
))
1817 (last (calendar-gregorian-from-absolute last-abs
))
1818 (first (calendar-gregorian-from-absolute first-abs
))
1819 ;; m1, d1 is first possible base date.
1820 (m1 (calendar-extract-month first
))
1821 (d1 (calendar-extract-day first
))
1822 (y1 (calendar-extract-year first
))
1823 ;; m2, d2 is last possible base date.
1824 (m2 (calendar-extract-month last
))
1825 (d2 (calendar-extract-day last
))
1826 (y2 (calendar-extract-year last
)))
1827 (if (or (and (= m1 m2
) ; only possible base dates in one month
1832 (let ((d (or day
(if (> n
0)
1834 (calendar-last-day-of-month m1 y1
)))))
1835 (and (<= d1 d
) (<= d d2
))))
1836 ;; Only possible base dates straddle two months.
1838 (and (= y1 y2
) (< m1 m2
)))
1840 ;; m1, d1 works as a base date.
1846 (<= d1
(or day
(if (> n
0)
1848 (calendar-last-day-of-month m1 y1
)))))
1849 ;; m2, d2 works as a base date.
1850 (and (or (eq month t
)
1854 (<= (or day
(if (> n
0)
1856 (calendar-last-day-of-month m2 y2
)))
1858 (cons mark entry
)))))
1860 (defun diary-ordinal-suffix (n)
1861 "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)"
1862 (if (or (memq (% n
100) '(11 12 13))
1865 (aref ["th" "st" "nd" "rd"] (% n
10))))
1867 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
1868 (defun diary-anniversary (month day
&optional year mark
)
1869 "Anniversary diary entry.
1870 Entry applies if date is the anniversary of MONTH, DAY, YEAR.
1871 The order of the input parameters changes according to
1872 `calendar-date-style' (e.g. to DAY MONTH YEAR in the European style).
1874 The diary entry can contain `%d' or `%d%s'; the %d will be
1875 replaced by the number of years since the MONTH, DAY, YEAR, and the
1876 %s will be replaced by the ordinal ending of that number (that
1877 is, `st', `nd', `rd' or `th', as appropriate. The anniversary of
1878 February 29 is considered to be March 1 in non-leap years.
1880 An optional parameter MARK specifies a face or single-character
1881 string to use when highlighting the day in the calendar."
1882 (let* ((ddate (diary-make-date month day year
))
1883 (dd (calendar-extract-day ddate
))
1884 (mm (calendar-extract-month ddate
))
1885 (yy (calendar-extract-year ddate
))
1886 (y (calendar-extract-year date
))
1887 (diff (if yy
(- y yy
) 100)))
1888 (and (= mm
2) (= dd
29) (not (calendar-leap-year-p y
))
1891 (and (> diff
0) (calendar-date-equal (list mm dd y
) date
)
1892 (cons mark
(format entry diff
(diary-ordinal-suffix diff
))))))
1894 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
1895 (defun diary-cyclic (n month day year
&optional mark
)
1896 "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
1897 The order of the input parameters changes according to
1898 `calendar-date-style' (e.g. to N DAY MONTH YEAR in the European
1899 style). ENTRY can contain `%d' or `%d%s'; the %d will be
1900 replaced by the number of repetitions since the MONTH DAY YEAR,
1901 and %s by the ordinal ending of that number (that is, `st', `nd',
1902 `rd' or `th', as appropriate.
1904 An optional parameter MARK specifies a face or single-character
1905 string to use when highlighting the day in the calendar."
1906 (let* ((diff (- (calendar-absolute-from-gregorian date
)
1907 (calendar-absolute-from-gregorian
1908 (diary-make-date month day year
))))
1910 (and (>= diff
0) (zerop (% diff n
))
1911 (cons mark
(format entry cycle
(diary-ordinal-suffix cycle
))))))
1913 (defun diary-day-of-year ()
1914 "Day of year and number of days remaining in the year of date diary entry."
1915 (calendar-day-of-year-string date
))
1917 (defun diary-remind (sexp days
&optional marking
)
1918 "Provide a reminder of a diary entry.
1919 SEXP is a diary-sexp. DAYS is either a single number or a list
1920 of numbers indicating the number(s) of days before the event that
1921 the warning(s) should occur on. A negative number -DAYS has the
1922 same meaning as a list (1 2 ... DAYS). If the current date
1923 is (one of) DAYS before the event indicated by SEXP, then this function
1924 returns a suitable message (as specified by `diary-remind-message').
1926 In addition to the reminders beforehand, the diary entry also
1927 appears on the date itself.
1929 A `diary-nonmarking-symbol' at the beginning of the line of the
1930 `diary-remind' entry specifies that the diary entry (not the
1931 reminder) is non-marking. Marking of reminders is independent of
1932 whether the entry itself is a marking or nonmarking; if optional
1933 parameter MARKING is non-nil then the reminders are marked on the
1935 ;; `date' has a value at this point, from diary-sexp-entry.
1936 ;; Convert a negative number to a list of days.
1937 (and (integerp days
)
1939 (setq days
(number-sequence 1 (- days
))))
1940 (let ((diary-entry (eval sexp
)))
1942 ;; Diary entry applies on date.
1944 (or (not diary-marking-entries-flag
) diary-marking-entry-flag
))
1946 ;; Diary entry may apply to `days' before date.
1947 ((and (integerp days
)
1948 (not diary-entry
) ; diary entry does not apply to date
1949 (or (not diary-marking-entries-flag
) marking
))
1950 ;; Adjust date, and re-evaluate.
1951 (let ((date (calendar-gregorian-from-absolute
1952 (+ (calendar-absolute-from-gregorian date
) days
))))
1953 (when (setq diary-entry
(eval sexp
))
1954 ;; Discard any mark portion from diary-anniversary, etc.
1955 (if (consp diary-entry
) (setq diary-entry
(cdr diary-entry
)))
1956 (mapconcat 'eval diary-remind-message
""))))
1957 ;; Diary entry may apply to one of a list of days before date.
1958 ((and (listp days
) days
)
1959 (or (diary-remind sexp
(car days
) marking
)
1960 (diary-remind sexp
(cdr days
) marking
))))))
1963 ;;; Diary insertion functions.
1966 (defun diary-make-entry (string &optional nonmarking file
)
1967 "Insert a diary entry STRING which may be NONMARKING in FILE.
1968 If omitted, NONMARKING defaults to nil and FILE defaults to
1970 (let ((pop-up-frames (or pop-up-frames
1971 (window-dedicated-p (selected-window)))))
1972 (find-file-other-window (substitute-in-file-name (or file diary-file
))))
1973 (when (eq major-mode default-major-mode
) (diary-mode))
1975 (diary-unhide-everything)
1976 (goto-char (point-max))
1977 (when (let ((case-fold-search t
))
1978 (search-backward "Local Variables:"
1979 (max (- (point-max) 3000) (point-min))
1986 (if nonmarking diary-nonmarking-symbol
"")
1990 (define-obsolete-function-alias 'make-diary-entry
'diary-make-entry
"23.1")
1993 (defun diary-insert-entry (arg)
1994 "Insert a diary entry for the date indicated by point.
1995 Prefix argument ARG makes the entry nonmarking."
1997 (diary-make-entry (calendar-date-string (calendar-cursor-to-date t
) t t
)
2001 (define-obsolete-function-alias 'insert-diary-entry
'diary-insert-entry
"23.1")
2004 (defun diary-insert-weekly-entry (arg)
2005 "Insert a weekly diary entry for the day of the week indicated by point.
2006 Prefix argument ARG makes the entry nonmarking."
2008 (diary-make-entry (calendar-day-name (calendar-cursor-to-date t
))
2012 (define-obsolete-function-alias 'insert-weekly-diary-entry
2013 'diary-insert-weekly-entry
"23.1")
2015 (defun diary-date-display-form (&optional type
)
2016 "Return value for `calendar-date-display-form' using `calendar-date-style.'
2017 Optional symbol TYPE is either `monthly' or `yearly'."
2018 (cond ((eq type
'monthly
) (cond ((eq calendar-date-style
'iso
)
2019 '((format "*-*-%.2d"
2020 (string-to-number day
))))
2021 ((eq calendar-date-style
'european
)
2024 ((eq type
'yearly
) (cond ((eq calendar-date-style
'iso
)
2025 '((format "*-%.2d-%.2d"
2026 (string-to-number month
)
2027 (string-to-number day
))))
2028 ((eq calendar-date-style
'european
)
2029 '(day " " monthname
))
2030 (t '(monthname " " day
))))
2031 ;; Iso cannot contain "-", because this form used eg by
2032 ;; insert-anniversary-diary-entry.
2033 (t (cond ((eq calendar-date-style
'iso
)
2034 '((format "%s %.2d %.2d" year
2035 (string-to-number month
) (string-to-number day
))))
2036 ((eq calendar-date-style
'european
)
2037 '(day " " month
" " year
))
2038 (t '(month " " day
" " year
))))))
2040 (defun diary-insert-entry-1 (&optional type nomark months symbol absfunc
)
2041 "Subroutine to insert a diary entry related to the date at point.
2042 TYPE is the type of entry (`monthly' or `yearly'). NOMARK
2043 non-nil means make the entry non-marking. Array MONTHS is used
2044 in place of `calendar-month-name-array'. String SYMBOL marks the
2045 type of diary entry. Function ABSFUNC converts absolute dates to
2046 dates of the appropriate type."
2047 (let ((calendar-date-display-form (if type
2048 (diary-date-display-form type
)
2049 calendar-date-display-form
))
2050 (calendar-month-name-array (or months calendar-month-name-array
))
2051 (date (calendar-cursor-to-date t
)))
2053 (format "%s%s" (or symbol
"")
2054 (calendar-date-string
2056 (funcall absfunc
(calendar-absolute-from-gregorian date
))
2063 (defun diary-insert-monthly-entry (arg)
2064 "Insert a monthly diary entry for the day of the month indicated by point.
2065 Prefix argument ARG makes the entry nonmarking."
2067 (diary-insert-entry-1 'monthly arg
))
2070 (define-obsolete-function-alias 'insert-monthly-diary-entry
2071 'diary-insert-monthly-entry
"23.1")
2074 (defun diary-insert-yearly-entry (arg)
2075 "Insert an annual diary entry for the day of the year indicated by point.
2076 Prefix argument ARG makes the entry nonmarking."
2078 (diary-insert-entry-1 'yearly arg
))
2081 (define-obsolete-function-alias 'insert-yearly-diary-entry
2082 'diary-insert-yearly-entry
"23.1")
2085 (defun diary-insert-anniversary-entry (arg)
2086 "Insert an anniversary diary entry for the date given by point.
2087 Prefix argument ARG makes the entry nonmarking."
2089 (let ((calendar-date-display-form (diary-date-display-form)))
2091 (format "%s(diary-anniversary %s)"
2092 diary-sexp-entry-symbol
2093 (calendar-date-string (calendar-cursor-to-date t
) nil t
))
2097 (define-obsolete-function-alias 'insert-anniversary-diary-entry
2098 'diary-insert-anniversary-entry
"23.1")
2101 (defun diary-insert-block-entry (arg)
2102 "Insert a block diary entry for the days between the point and marked date.
2103 Prefix argument ARG makes the entry nonmarking."
2105 (let ((calendar-date-display-form (diary-date-display-form))
2106 (cursor (calendar-cursor-to-date t
))
2107 (mark (or (car calendar-mark-ring
)
2108 (error "No mark set in this buffer")))
2110 (if (< (calendar-absolute-from-gregorian mark
)
2111 (calendar-absolute-from-gregorian cursor
))
2117 (format "%s(diary-block %s %s)"
2118 diary-sexp-entry-symbol
2119 (calendar-date-string start nil t
)
2120 (calendar-date-string end nil t
))
2124 (define-obsolete-function-alias 'insert-block-diary-entry
2125 'diary-insert-block-entry
"23.1")
2128 (defun diary-insert-cyclic-entry (arg)
2129 "Insert a cyclic diary entry starting at the date given by point.
2130 Prefix argument ARG makes the entry nonmarking."
2132 (let ((calendar-date-display-form (diary-date-display-form)))
2134 (format "%s(diary-cyclic %d %s)"
2135 diary-sexp-entry-symbol
2136 (calendar-read "Repeat every how many days: "
2137 (lambda (x) (> x
0)))
2138 (calendar-date-string (calendar-cursor-to-date t
) nil t
))
2142 (define-obsolete-function-alias 'insert-cyclic-diary-entry
2143 'diary-insert-cyclic-entry
"23.1")
2147 (defun diary-redraw-calendar ()
2148 "If `calendar-buffer' is live and diary entries are marked, redraw it."
2149 (and calendar-mark-diary-entries-flag
2152 ;; Return value suitable for `write-contents-functions'.
2155 (defvar diary-mode-map
2156 (let ((map (make-sparse-keymap)))
2157 (define-key map
"\C-c\C-s" 'diary-show-all-entries
)
2158 (define-key map
"\C-c\C-q" 'quit-window
)
2160 "Keymap for `diary-mode'.")
2162 (defun diary-font-lock-sexps (limit)
2163 "Recognize sexp diary entry up to LIMIT for font-locking."
2164 (if (re-search-forward
2165 (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol
)
2166 (regexp-quote diary-sexp-entry-symbol
))
2170 (narrow-to-region (point-min) limit
)
2171 (let ((start (point)))
2173 (store-match-data (list start
(point)))
2177 (defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array
)
2178 "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
2179 If given, optional SYMBOL must be a prefix to entries.
2180 If optional ABBREV-ARRAY is present, the abbreviations constructed
2181 from this array by the function `calendar-abbrev-construct' are
2182 matched (with or without a final `.'), in addition to the full month
2184 (let ((dayname (diary-name-pattern calendar-day-name-array
2185 calendar-day-abbrev-array t
))
2186 (monthname (format "\\(%s\\|\\*\\)"
2187 (diary-name-pattern month-array abbrev-array
)))
2188 (month "\\([0-9]+\\|\\*\\)")
2189 (day "\\([0-9]+\\|\\*\\)")
2190 (year "-?\\([0-9]+\\|\\*\\)"))
2193 (concat "^" (regexp-quote diary-nonmarking-symbol
) "?"
2194 (if symbol
(regexp-quote symbol
) "") "\\("
2196 ;; If backup, omit first item (backup)
2197 ;; and last item (not part of date).
2198 (if (equal (car x
) 'backup
)
2199 (nreverse (cdr (reverse (cdr x
))))
2202 ;; With backup, last item is not part of date.
2203 (if (equal (car x
) 'backup
)
2204 (concat "\\)" (eval (car (reverse x
))))
2209 (defmacro diary-font-lock-keywords-1
(markfunc listfunc feature months symbol
)
2210 "Subroutine of the function `diary-font-lock-keywords'.
2211 If MARKFUNC is a member of `diary-nongregorian-marking-hook', or
2212 LISTFUNC of `diary-nongregorian-listing-hook', then require FEATURE
2213 and return a font-lock pattern matching array of MONTHS and marking SYMBOL."
2214 `(when (or (memq ',markfunc diary-nongregorian-marking-hook
)
2215 (memq ',listfunc diary-nongregorian-listing-hook
))
2217 (diary-font-lock-date-forms ,months
,symbol
)))
2219 (defconst diary-time-regexp
2220 ;; Accepted formats: 10:00 10.00 10h00 10h 10am 10:00am 10.00am
2221 ;; Use of "." as a separator annoyingly matches numbers, eg "123.45".
2222 ;; Hence often prefix this with "\\(^\\|\\s-\\)."
2223 (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
2224 "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
2225 "\\)\\([AaPp][Mm]\\)?\\)")
2226 "Regular expression matching a time of day.")
2228 (defvar calendar-hebrew-month-name-array-leap-year
)
2229 (defvar calendar-islamic-month-name-array
)
2230 (defvar calendar-bahai-month-name-array
)
2233 (defun diary-font-lock-keywords ()
2234 "Return a value for the variable `diary-font-lock-keywords'."
2236 (diary-font-lock-date-forms calendar-month-name-array
2237 nil calendar-month-abbrev-array
)
2238 (diary-font-lock-keywords-1 diary-hebrew-mark-entries
2239 diary-hebrew-list-entries
2241 calendar-hebrew-month-name-array-leap-year
2242 diary-hebrew-entry-symbol
)
2243 (diary-font-lock-keywords-1 diary-islamic-mark-entries
2244 diary-islamic-list-entries
2246 calendar-islamic-month-name-array
2247 diary-islamic-entry-symbol
)
2248 (diary-font-lock-keywords-1 diary-bahai-mark-entries
2249 diary-bahai-list-entries
2251 calendar-bahai-month-name-array
2252 diary-bahai-entry-symbol
)
2255 (format "^%s.*$" (regexp-quote diary-include-string
))
2256 'font-lock-keyword-face
)
2258 (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol
)
2259 (regexp-quote diary-sexp-entry-symbol
))
2260 '(1 font-lock-reference-face
))
2262 (format "^%s" (regexp-quote diary-nonmarking-symbol
))
2263 'font-lock-reference-face
)
2265 (format "^%s?%s" (regexp-quote diary-nonmarking-symbol
)
2266 (regexp-opt (mapcar 'regexp-quote
2267 (list diary-hebrew-entry-symbol
2268 diary-islamic-entry-symbol
2269 diary-bahai-entry-symbol
))
2271 '(1 font-lock-reference-face
))
2272 '(diary-font-lock-sexps . font-lock-keyword-face
)
2273 `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
2277 (defvar diary-font-lock-keywords
(diary-font-lock-keywords)
2278 "Forms to highlight in `diary-mode'.")
2281 (define-derived-mode diary-mode fundamental-mode
"Diary"
2282 "Major mode for editing the diary file."
2283 (set (make-local-variable 'font-lock-defaults
)
2284 '(diary-font-lock-keywords t
))
2285 (add-to-invisibility-spec '(diary . nil
))
2286 (add-hook 'after-save-hook
'diary-redraw-calendar nil t
)
2287 (if diary-header-line-flag
2288 (setq header-line-format diary-header-line-format
)))
2291 ;;; Fancy Diary Mode.
2293 (defvar diary-fancy-date-pattern
2295 (let ((dayname (diary-name-pattern calendar-day-name-array nil t
))
2296 (monthname (diary-name-pattern calendar-month-name-array nil t
))
2300 (mapconcat 'eval calendar-date-display-form
""))
2301 ;; Optional ": holiday name" after the date.
2303 "Regular expression matching a date header in Fancy Diary.")
2305 (define-obsolete-variable-alias 'fancy-diary-font-lock-keywords
2306 'diary-fancy-font-lock-keywords
"23.1")
2308 (defvar diary-fancy-font-lock-keywords
2311 ;; Any number of " other holiday name" lines, followed by "==" line.
2312 (concat diary-fancy-date-pattern
"\\(\n +.*\\)*\n=+$")
2313 '(0 (progn (put-text-property (match-beginning 0) (match-end 0)
2314 'font-lock-multiline t
)
2316 '("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" .
'diary-anniversary
)
2317 '("^.*Yahrzeit.*$" . font-lock-reference-face
)
2318 '("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face
)
2319 '("^Day.*omer.*$" . font-lock-builtin-face
)
2320 '("^Parashat.*$" . font-lock-comment-face
)
2321 `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
2322 diary-time-regexp
) .
'diary-time
))
2323 "Keywords to highlight in fancy diary display.")
2325 ;; If region looks like it might start or end in the middle of a
2326 ;; multiline pattern, extend the region to encompass the whole pattern.
2327 (defun diary-fancy-font-lock-fontify-region-function (beg end
&optional verbose
)
2328 "Function to use for `font-lock-fontify-region-function' in Fancy Diary.
2329 Needed to handle multiline keyword in `diary-fancy-font-lock-keywords'.
2330 Fontify the region between BEG and END, quietly unless VERBOSE is non-nil."
2333 (if (looking-at "=+$") (forward-line -
1))
2334 (while (and (looking-at " +[^ ]")
2335 (zerop (forward-line -
1))))
2336 ;; This check not essential.
2337 (if (looking-at diary-fancy-date-pattern
)
2338 (setq beg
(line-beginning-position)))
2341 (while (and (looking-at " +[^ ]")
2342 (zerop (forward-line 1))))
2343 (if (looking-at "=+$")
2344 (setq end
(line-beginning-position 2)))
2345 (font-lock-default-fontify-region beg end verbose
))
2347 (define-derived-mode diary-fancy-display-mode fundamental-mode
2349 "Major mode used while displaying diary entries using Fancy Display."
2350 (set (make-local-variable 'font-lock-defaults
)
2351 '(diary-fancy-font-lock-keywords
2353 (font-lock-fontify-region-function
2354 . diary-fancy-font-lock-fontify-region-function
)))
2355 (local-set-key "q" 'quit-window
))
2357 (define-obsolete-function-alias 'fancy-diary-display-mode
2358 'diary-fancy-display-mode
"23.1")
2360 ;; Following code from Dave Love <fx@gnu.org>.
2361 ;; Import Outlook-format appointments from mail messages in Gnus or
2362 ;; Rmail using command `diary-from-outlook'. This, or the specialized
2363 ;; functions `diary-from-outlook-gnus' and `diary-from-outlook-rmail',
2364 ;; could be run from hooks to notice appointments automatically (in
2365 ;; which case they will prompt about adding to the diary). The
2366 ;; message formats recognized are customizable through
2367 ;; `diary-outlook-formats'.
2369 (defvar subject
) ; bound in diary-from-outlook-gnus
2371 (defun diary-from-outlook-internal (&optional test-only
)
2372 "Snarf a diary entry from a message assumed to be from MS Outlook.
2373 Assumes `body' is bound to a string comprising the body of the message and
2374 `subject' is bound to a string comprising its subject.
2375 Arg TEST-ONLY non-nil means return non-nil if and only if the
2376 message contains an appointment, don't make a diary entry."
2378 (let (format-string)
2379 (dotimes (i (length diary-outlook-formats
))
2380 (when (eq 0 (string-match (car (nth i diary-outlook-formats
))
2383 (setq format-string
(cdr (nth i diary-outlook-formats
)))
2385 (save-window-excursion
2386 ;; Fixme: References to optional fields in the format
2387 ;; are treated literally, not replaced by the empty
2388 ;; string. I think this is an Emacs bug.
2390 (format (replace-match (if (functionp format-string
)
2391 (funcall format-string body
)
2393 t nil
(match-string 0 body
))
2396 (throw 'finished t
))))
2399 (defvar gnus-article-mime-handles
)
2400 (defvar gnus-article-buffer
)
2402 (autoload 'gnus-fetch-field
"gnus-util")
2403 (autoload 'gnus-narrow-to-body
"gnus")
2404 (autoload 'mm-get-part
"mm-decode")
2406 (defun diary-from-outlook-gnus (&optional noconfirm
)
2407 "Maybe snarf diary entry from Outlook-generated message in Gnus.
2408 Unless the optional argument NOCONFIRM is non-nil (which is the case when
2409 this function is called interactively), then if an entry is found the
2410 user is asked to confirm its addition.
2411 Add this function to `gnus-article-prepare-hook' to notice appointments
2414 (with-current-buffer gnus-article-buffer
2415 (let ((subject (gnus-fetch-field "subject"))
2416 (body (if gnus-article-mime-handles
2417 ;; We're multipart. Don't get confused by part
2418 ;; buttons &c. Assume info is in first part.
2419 (mm-get-part (nth 1 gnus-article-mime-handles
))
2421 (gnus-narrow-to-body)
2423 (when (diary-from-outlook-internal t
)
2424 (when (or noconfirm
(y-or-n-p "Snarf diary entry? "))
2425 (diary-from-outlook-internal)
2426 (message "Diary entry added"))))))
2428 (custom-add-option 'gnus-article-prepare-hook
'diary-from-outlook-gnus
)
2430 (defvar rmail-buffer
)
2432 (defun diary-from-outlook-rmail (&optional noconfirm
)
2433 "Maybe snarf diary entry from Outlook-generated message in Rmail.
2434 Unless the optional argument NOCONFIRM is non-nil (which is the case when
2435 this function is called interactively), then if an entry is found the
2436 user is asked to confirm its addition."
2438 (with-current-buffer rmail-buffer
2439 (let ((subject (mail-fetch-field "subject"))
2440 (body (buffer-substring (save-excursion
2444 (when (diary-from-outlook-internal t
)
2445 (when (or noconfirm
(y-or-n-p "Snarf diary entry? "))
2446 (diary-from-outlook-internal)
2447 (message "Diary entry added"))))))
2449 (defun diary-from-outlook (&optional noconfirm
)
2450 "Maybe snarf diary entry from current Outlook-generated message.
2451 Currently knows about Gnus and Rmail modes. Unless the optional
2452 argument NOCONFIRM is non-nil (which is the case when this
2453 function is called interactively), then if an entry is found the
2454 user is asked to confirm its addition."
2457 ((eq major-mode
'rmail-mode
)
2458 #'diary-from-outlook-rmail
)
2459 ((memq major-mode
'(gnus-summary-mode gnus-article-mode
))
2460 #'diary-from-outlook-gnus
)
2461 (t (error "Don't know how to snarf in `%s'" major-mode
)))))
2462 (funcall func noconfirm
)))
2464 (provide 'diary-lib
)
2466 ;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
2467 ;;; diary-lib.el ends here