; Update a comment
[emacs.git] / lisp / calendar / diary-lib.el
Commit [+]AuthorDateLineData
3afbc435 Pavel Janík2001-07-16 07:46:48 +00001;;; diary-lib.el --- diary functions
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002
7e09ef09
PE
Paul Eggert2015-01-01 14:26:41 -08003;; Copyright (C) 1989-1990, 1992-1995, 2001-2015 Free Software
4;; Foundation, Inc.
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00005
6;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
aff88519 Glenn Morris2005-10-08 04:49:48 +00007;; Maintainer: Glenn Morris <rgm@gnu.org>
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00008;; Keywords: calendar
9
10;; This file is part of GNU Emacs.
11
2ed66575 Glenn Morris2008-05-06 03:07:58 +000012;; GNU Emacs is free software: you can redistribute it and/or modify
0808d911 Edward M. Reingold1995-09-21 03:11:06 +000013;; it under the terms of the GNU General Public License as published by
2ed66575
GM
Glenn Morris2008-05-06 03:07:58 +000014;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +000016
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
2ed66575 Glenn Morris2008-05-06 03:07:58 +000023;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +000024
25;;; Commentary:
26
bf276a50 Glenn Morris2008-04-01 02:47:05 +000027;; See calendar.el.
0808d911 Edward M. Reingold1995-09-21 03:11:06 +000028
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +000029;;; Code:
30
31(require 'calendar)
4f8f657f Glenn Morris2009-11-05 03:22:18 +000032(eval-and-compile (load "diary-loaddefs" nil t))
a53b53b3 Glenn Morris2008-03-13 05:54:57 +000033
fe5ffe0b
GM
Glenn Morris2008-04-11 03:46:35 +000034(defgroup diary nil
35 "Emacs diary."
36 :prefix "diary-"
37 :group 'calendar)
38
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +000039(defcustom diary-include-string "#include"
40 "The string indicating inclusion of another file of diary entries.
efe9409a Glenn Morris2008-04-06 20:53:14 +000041See the documentation for the function `diary-include-other-diary-files'."
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +000042 :type 'string
43 :group 'diary)
44
45(defcustom diary-list-include-blanks nil
46 "If nil, do not include days with no diary entry in the list of diary entries.
47Such days will then not be shown in the fancy diary buffer, even if they
48are holidays."
49 :type 'boolean
50 :group 'diary)
51
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +000052(defface diary-anniversary '((t :inherit font-lock-keyword-face))
53 "Face used for anniversaries in the fancy diary display."
54 :version "22.1"
6a979a50 Glenn Morris2008-04-12 03:11:49 +000055 :group 'calendar-faces)
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +000056
57(defface diary-time '((t :inherit font-lock-variable-name-face))
6a979a50 Glenn Morris2008-04-12 03:11:49 +000058 "Face used for times of day in the fancy diary display."
1435831f Glenn Morris2008-03-17 02:33:49 +000059 :version "22.1"
6a979a50 Glenn Morris2008-04-12 03:11:49 +000060 :group 'calendar-faces)
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +000061
62(defface diary-button '((((type pc) (class color))
63 (:foreground "lightblue")))
6a979a50 Glenn Morris2008-04-12 03:11:49 +000064 "Face used for buttons in the fancy diary display."
1435831f Glenn Morris2008-03-17 02:33:49 +000065 :version "22.1"
6a979a50 Glenn Morris2008-04-12 03:11:49 +000066 :group 'calendar-faces)
e7d3b898 Glenn Morris2009-08-31 01:33:58 +000067
55e8cf94
GM
Glenn Morris2008-03-10 02:44:51 +000068;; Face markup of calendar and diary displays: Any entry line that
69;; ends with [foo:value] where foo is a face attribute (except :box
70;; :stipple) or with [face:blah] tags, will have these values applied
71;; to the calendar and fancy diary displays. These attributes "stack"
72;; on calendar displays. File-wide attributes can be defined as
73;; follows: the first line matching "^# [tag:value]" defines the value
74;; for that particular tag.
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +000075(defcustom diary-face-attrs
76 '((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string)
77 (" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string)
78d2cbe1
GM
Glenn Morris2008-03-27 06:12:25 +000078 (" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol)
79 (" *\\[height:\\([.0-9]+\\)\\]$" 1 :height int)
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +000080 (" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol)
81 (" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol)
82 (" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil)
83 (" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil)
84 (" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil)
85 (" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil)
86 (" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string)
87 (" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string)
88 ;; Unsupported.
89;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box)
90;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple)
91 )
55e8cf94
GM
Glenn Morris2008-03-10 02:44:51 +000092 "Alist of (REGEXP SUBEXP ATTRIBUTE TYPE) elements.
93This is used by `diary-pull-attrs' to fontify certain diary
94elements. REGEXP is a regular expression to for, and SUBEXP is
95the numbered sub-expression to extract. `diary-glob-file-regexp-prefix'
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +000096is pre-pended to REGEXP for file-wide specifiers. ATTRIBUTE
55e8cf94
GM
Glenn Morris2008-03-10 02:44:51 +000097specifies which face attribute (e.g. `:foreground') to modify, or
98that this is a face (`:face') to apply. TYPE is the type of
99attribute being applied. Available TYPES (see `diary-attrtype-convert')
8fc29035 Juanma Barranquero2008-11-14 13:05:18 +0000100are: `string', `symbol', `int', `tnil', `stringtnil.'"
55e8cf94 Glenn Morris2008-03-10 02:44:51 +0000101 :type '(repeat (list (string :tag "Regular expression")
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000102 (integer :tag "Sub-expression")
103 (symbol :tag "Attribute (e.g. :foreground)")
104 (choice (const string :tag "A string")
105 (const symbol :tag "A symbol")
106 (const int :tag "An integer")
107 (const tnil :tag "`t' or `nil'")
108 (const stringtnil
109 :tag "A string, `t', or `nil'"))))
55e8cf94
GM
Glenn Morris2008-03-10 02:44:51 +0000110 :group 'diary)
111
112(defcustom diary-glob-file-regexp-prefix "^\\#"
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +0000113 "Regular expression pre-pended to `diary-face-attrs' for file-wide specifiers."
55e8cf94 Glenn Morris2008-03-10 02:44:51 +0000114 :type 'regexp
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000115 :group 'diary)
116
117(defcustom diary-file-name-prefix nil
118 "Non-nil means prefix each diary entry with the name of the file defining it."
119 :type 'boolean
120 :group 'diary)
121
122(defcustom diary-file-name-prefix-function 'identity
123 "The function that will take a diary file name and return the desired prefix."
124 :type 'function
125 :group 'diary)
126
efe9409a Glenn Morris2008-04-06 20:53:14 +0000127(defcustom diary-sexp-entry-symbol "%%"
c9baab11 Glenn Morris2008-03-08 03:47:36 +0000128 "The string used to indicate a sexp diary entry in `diary-file'.
efe9409a Glenn Morris2008-04-06 20:53:14 +0000129See the documentation for the function `diary-list-sexp-entries'."
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000130 :type 'string
131 :group 'diary)
132
548d0a63
GM
Glenn Morris2011-05-05 21:28:53 -0700133(defcustom diary-comment-start nil
134 "String marking the start of a comment in the diary, or nil.
135Nil means there are no comments. The diary does not display
136parts of entries that are inside comments. You can use comments
137for whatever you like, e.g. for meta-data that packages such as
e1dbe924 Paul Eggert2011-11-19 18:29:42 -0800138`appt.el' can use. Comments may not span multiple lines, and there
314347b9 Glenn Morris2011-05-06 18:20:47 -0700139can be only one comment on any line.
548d0a63
GM
Glenn Morris2011-05-05 21:28:53 -0700140See also `diary-comment-end'."
141 :version "24.1"
142 :type '(choice (const :tag "No comment" nil) string)
143 :group 'diary)
144
145(defcustom diary-comment-end ""
146 "String marking the end of a comment in the diary.
147The empty string means comments finish at the end of a line.
148See also `diary-comment-start'."
149 :version "24.1"
150 :type 'string
151 :group 'diary)
152
66d20000
GM
Glenn Morris2008-04-10 03:45:26 +0000153(defcustom diary-hook nil
154 "List of functions called after the display of the diary.
155Used for example by the appointment package - see `appt-activate'."
156 :type 'hook
157 :group 'diary)
158
2b8e87c4 Glenn Morris2009-09-15 02:34:54 +0000159(defcustom diary-display-function 'diary-fancy-display
f8c8f32b Glenn Morris2008-05-30 02:57:27 +0000160 "Function used to display the diary.
2b8e87c4 Glenn Morris2009-09-15 02:34:54 +0000161The two standard options are `diary-fancy-display' and `diary-simple-display'.
f8c8f32b Glenn Morris2008-05-30 02:57:27 +0000162
f8c8f32b
GM
Glenn Morris2008-05-30 02:57:27 +0000163When this function is called, the variable `diary-entries-list'
164is a list, in order by date, of all relevant diary entries in the
165form of ((MONTH DAY YEAR) STRING), where string is the diary
166entry for the given date. This can be used, for example, to
167produce a different buffer for display (perhaps combined with
168holidays), or hard copy output."
2b8e87c4
GM
Glenn Morris2009-09-15 02:34:54 +0000169 :type '(choice (const diary-fancy-display :tag "Fancy display")
170 (const diary-simple-display :tag "Basic display")
ab7af022
GM
Glenn Morris2014-10-10 19:54:11 -0700171 (const :tag "No display" ignore)
172 (function :tag "User-specified function"))
66d20000
GM
Glenn Morris2008-04-10 03:45:26 +0000173 :initialize 'custom-initialize-default
174 :set 'diary-set-maybe-redraw
2b8e87c4 Glenn Morris2009-09-15 02:34:54 +0000175 :version "23.2" ; simple->fancy
66d20000
GM
Glenn Morris2008-04-10 03:45:26 +0000176 :group 'diary)
177
efe9409a Glenn Morris2008-04-06 20:53:14 +0000178(defcustom diary-list-entries-hook nil
865fe16f
CY
Chong Yidong2012-09-17 13:41:04 +0800179 "Hook run after diary file is culled for relevant entries.
180
181If you add `diary-include-other-diary-files' to this hook, you
182will probably also want to add `diary-mark-included-diary-files'
183to `diary-mark-entries-hook'. For example, to cause the fancy
184diary buffer to be displayed with diary entries from various
185included files, each day's entries sorted into lexicographic
186order, add the following to your init file:
c9baab11 Glenn Morris2008-03-08 03:47:36 +0000187
f8c8f32b Glenn Morris2008-05-30 02:57:27 +0000188 (setq diary-display-function 'diary-fancy-display)
efe9409a Glenn Morris2008-04-06 20:53:14 +0000189 (add-hook 'diary-list-entries-hook 'diary-include-other-diary-files)
67ae9766 Glenn Morris2010-09-14 01:02:28 -0700190 (add-hook 'diary-list-entries-hook 'diary-sort-entries t)
c9baab11 Glenn Morris2008-03-08 03:47:36 +0000191
865fe16f
CY
Chong Yidong2012-09-17 13:41:04 +0800192Note how the sort function is placed last, so that it can sort
193the entries included from other files.
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700194
195This hook runs after `diary-nongregorian-listing-hook'. These two hooks
196differ only if you are using included diary files. In that case,
197`diary-nongregorian-listing-hook' runs for each file, whereas
198`diary-list-entries-hook' only runs once, for the main diary file.
199So for example, to sort the complete list of diary entries you would
200use the list-entries hook, whereas to process e.g. Islamic entries in
201the main file and all included files, you would use the nongregorian hook."
c9baab11 Glenn Morris2008-03-08 03:47:36 +0000202 :type 'hook
efe9409a Glenn Morris2008-04-06 20:53:14 +0000203 :options '(diary-include-other-diary-files diary-sort-entries)
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000204 :group 'diary)
205
efe9409a Glenn Morris2008-04-06 20:53:14 +0000206(defcustom diary-mark-entries-hook nil
c9baab11 Glenn Morris2008-03-08 03:47:36 +0000207 "List of functions called after marking diary entries in the calendar.
efe9409a
GM
Glenn Morris2008-04-06 20:53:14 +0000208You might wish to add `diary-mark-included-diary-files', in which case
209you will probably also want to add `diary-include-other-diary-files' to
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700210`diary-list-entries-hook'.
211
212This hook runs after `diary-nongregorian-marking-hook'. These two hooks
213differ only if you are using included diary files. In that case,
214`diary-nongregorian-marking-hook' runs for each file, whereas
215`diary-mark-entries-hook' only runs once, for the main diary file."
c9baab11 Glenn Morris2008-03-08 03:47:36 +0000216 :type 'hook
efe9409a Glenn Morris2008-04-06 20:53:14 +0000217 :options '(diary-mark-included-diary-files)
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000218 :group 'diary)
219
efe9409a Glenn Morris2008-04-06 20:53:14 +0000220(defcustom diary-nongregorian-listing-hook nil
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000221 "List of functions called for listing diary file and included files.
222As the files are processed for diary entries, these functions are used
1435831f Glenn Morris2008-03-17 02:33:49 +0000223to cull relevant entries. You can use any or all of
192e3e20
GM
Glenn Morris2008-04-05 20:58:26 +0000224`diary-bahai-list-entries', `diary-hebrew-list-entries', and
225`diary-islamic-list-entries'. The documentation for these functions
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700226describes the style of such diary entries.
227
228You can use this hook for other functions as well, if you want them to
229be run on the main diary file and any included diary files. Otherwise,
230use `diary-list-entries-hook', which runs only for the main diary file."
c9baab11 Glenn Morris2008-03-08 03:47:36 +0000231 :type 'hook
192e3e20
GM
Glenn Morris2008-04-05 20:58:26 +0000232 :options '(diary-bahai-list-entries
233 diary-hebrew-list-entries
234 diary-islamic-list-entries)
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000235 :group 'diary)
236
efe9409a Glenn Morris2008-04-06 20:53:14 +0000237(defcustom diary-nongregorian-marking-hook nil
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000238 "List of functions called for marking diary file and included files.
239As the files are processed for diary entries, these functions are used
1435831f Glenn Morris2008-03-17 02:33:49 +0000240to cull relevant entries. You can use any or all of
192e3e20
GM
Glenn Morris2008-04-05 20:58:26 +0000241`diary-bahai-mark-entries', `diary-hebrew-mark-entries' and
242`diary-islamic-mark-entries'. The documentation for these functions
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700243describes the style of such diary entries.
244
245You can use this hook for other functions as well, if you want them to
246be run on the main diary file and any included diary files. Otherwise,
247use `diary-mark-entries-hook', which runs only for the main diary file."
c9baab11 Glenn Morris2008-03-08 03:47:36 +0000248 :type 'hook
192e3e20
GM
Glenn Morris2008-04-05 20:58:26 +0000249 :options '(diary-bahai-mark-entries
250 diary-hebrew-mark-entries
251 diary-islamic-mark-entries)
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000252 :group 'diary)
253
efe9409a
GM
Glenn Morris2008-04-06 20:53:14 +0000254(defcustom diary-print-entries-hook 'lpr-buffer
255 "Run by `diary-print-entries' after preparing a temporary diary buffer.
1baf9da4
GM
Glenn Morris2008-03-28 02:47:59 +0000256The buffer shows only the diary entries currently visible in the
257diary buffer. The default just does the printing. Other uses
258might include, for example, rearranging the lines into order by
259day and time, saving the buffer instead of deleting it, or
260changing the function used to do the printing."
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000261 :type 'hook
262 :group 'diary)
263
264(defcustom diary-unknown-time -9999
55e8cf94 Glenn Morris2008-03-10 02:44:51 +0000265 "Value returned by `diary-entry-time' when no time is found.
1baf9da4
GM
Glenn Morris2008-03-28 02:47:59 +0000266The default value -9999 causes entries with no recognizable time
267to be placed before those with times; 9999 would place entries
268with no recognizable time after those with times."
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000269 :type 'integer
270 :group 'diary
271 :version "20.3")
272
273(defcustom diary-mail-addr
7cd59c73 Glenn Morris2008-04-03 03:33:37 +0000274 (or (bound-and-true-p user-mail-address) "")
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000275 "Email address that `diary-mail-entries' will send email to."
276 :group 'diary
277 :type 'string
278 :version "20.3")
279
280(defcustom diary-mail-days 7
281 "Default number of days for `diary-mail-entries' to check."
282 :group 'diary
283 :type 'integer
284 :version "20.3")
285
286(defcustom diary-remind-message
287 '("Reminder: Only "
55e8cf94 Glenn Morris2008-03-10 02:44:51 +0000288 (if (zerop (% days 7))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000289 (format "%d week%s" (/ days 7) (if (= 7 days) "" "s"))
290 (format "%d day%s" days (if (= 1 days) "" "s")))
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000291 " until "
292 diary-entry)
293 "Pseudo-pattern giving form of reminder messages in the fancy diary display.
294
295Used by the function `diary-remind', a pseudo-pattern is a list of
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +0000296expressions that can involve the keywords `days' (a number), `date'
297\(a list of month, day, year), and `diary-entry' (a string)."
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000298 :type 'sexp
299 :group 'diary)
300
efe9409a Glenn Morris2008-04-06 20:53:14 +0000301(defcustom diary-abbreviated-year-flag t
1baf9da4 Glenn Morris2008-03-28 02:47:59 +0000302 "Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
6818b449 Glenn Morris2012-02-17 22:08:15 -0500303This applies to the Gregorian, Hebrew, Islamic, and Bahá'í calendars.
1baf9da4
GM
Glenn Morris2008-03-28 02:47:59 +0000304When the current century is added to a two-digit year, if the result
305is more than 50 years in the future, the previous century is assumed.
306If the result is more than 50 years in the past, the next century is assumed.
307If this variable is nil, years must be written in full."
308 :type 'boolean
309 :group 'diary)
310
d01d7b8d
GM
Glenn Morris2010-11-25 19:10:16 -0800311(defun diary-outlook-format-1 (body)
312 "Return a replace-match template for an element of `diary-outlook-formats'.
313Returns a string using match elements 1-5, where:
3141 = month name, 2 = day, 3 = year, 4 = time, 5 = location; also uses
92c56fe7
GM
Glenn Morris2010-11-25 19:14:03 -0800315%s = message subject. BODY is the string from which the matches derive."
316 (let* ((monthname (match-string 1 body))
317 (day (match-string 2 body))
318 (year (match-string 3 body))
d01d7b8d
GM
Glenn Morris2010-11-25 19:10:16 -0800319 ;; Blech.
320 (month (catch 'found
321 (dotimes (i (length calendar-month-name-array))
322 (if (string-equal (aref calendar-month-name-array i)
323 monthname)
324 (throw 'found (1+ i))))
325 nil)))
326 ;; If we could convert the monthname to a numeric month, we can
327 ;; use the standard function calendar-date-string.
328 (concat (if month
e5468a77 Glenn Morris2010-11-25 19:19:58 -0800329 (calendar-date-string (list month (string-to-number day)
472a3834 Glenn Morris2013-05-11 18:34:30 -0700330 (string-to-number year)) nil t)
d01d7b8d
GM
Glenn Morris2010-11-25 19:10:16 -0800331 (cond ((eq calendar-date-style 'iso) "\\3 \\1 \\2") ; YMD
332 ((eq calendar-date-style 'european) "\\2 \\1 \\3") ; DMY
333 (t "\\1 \\2 \\3"))) ; MDY
334 "\n \\4 %s, \\5")))
335;; TODO Sometimes the time is in a different time-zone to the one you
336;; are in. Eg in PST, you might still get an email referring to:
337;; "7:00 PM-8:00 PM. Greenwich Standard Time".
338;; Note that it doesn't use a standard abbreviation for the timezone,
339;; or anything helpful like that.
340;; Sigh, this could cause the meeting to even be on a different day
341;; to that given in the When: string.
342;; These things seem to come in a multipart mail with a calendar part,
343;; it's probably better to use that rather than this whole thing.
344;; So this is unlikely to get improved.
345
346;; TODO Is the format of these messages actually documented anywhere?
c9baab11 Glenn Morris2008-03-08 03:47:36 +0000347(defcustom diary-outlook-formats
d01d7b8d
GM
Glenn Morris2010-11-25 19:10:16 -0800348 '(;; When: Tuesday, November 9, 2010 7:00 PM-8:00 PM. Greenwich Standard Time
349 ;; Where: Meeting room B
350 ("[ \t\n]*When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \
351\\([0-9]\\{4\\}\\),? \\(.+\\)\n\
1e8aa221 Glenn Morris2010-11-25 19:22:49 -0800352\\(?:Where: \\(.+\n\\)\\)?" . diary-outlook-format-1))
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000353 "Alist of regexps matching message text and replacement text.
354
355The regexp must match the start of the message text containing an
356appointment, but need not include a leading `^'. If it matches the
357current message, a diary entry is made from the corresponding
358template. If the template is a string, it should be suitable for
359passing to `replace-match', and so will have occurrences of `\\D' to
360substitute the match for the Dth subexpression. It must also contain
361a single `%s' which will be replaced with the text of the message's
362Subject field. Any other `%' characters must be doubled, so that the
363template can be passed to `format'.
364
365If the template is actually a function, it is called with the message
366body text as argument, and may use `match-string' etc. to make a
367template following the rules above."
368 :type '(alist :key-type (regexp :tag "Regexp matching time/place")
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000369 :value-type (choice
370 (string :tag "Template for entry")
371 (function :tag
372 "Unary function providing template")))
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000373 :version "22.1"
374 :group 'diary)
375
1baf9da4
GM
Glenn Morris2008-03-28 02:47:59 +0000376(defvar diary-header-line-flag)
377(defvar diary-header-line-format)
26f43550 Glenn Morris2008-03-26 03:26:43 +0000378
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000379(defun diary-set-header (symbol value)
380 "Set SYMBOL's value to VALUE, and redraw the diary header if necessary."
381 (let ((oldvalue (symbol-value symbol))
6dd2d9b9 Glenn Morris2009-09-03 06:34:19 +0000382 (dbuff (and diary-file (find-buffer-visiting diary-file))))
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000383 (custom-set-default symbol value)
384 (and dbuff
385 (not (equal value oldvalue))
386 (with-current-buffer dbuff
387 (if (eq major-mode 'diary-mode)
388 (setq header-line-format (and diary-header-line-flag
389 diary-header-line-format)))))))
390
391;; This can be removed once the kill/yank treatment of invisible text
392;; (see etc/TODO) is fixed. -- gm
393(defcustom diary-header-line-flag t
efe9409a Glenn Morris2008-04-06 20:53:14 +0000394 "Non-nil means `diary-simple-display' will show a header line.
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000395The format of the header is specified by `diary-header-line-format'."
396 :group 'diary
397 :type 'boolean
398 :initialize 'custom-initialize-default
399 :set 'diary-set-header
400 :version "22.1")
401
402(defvar diary-selective-display nil
403 "Internal diary variable; non-nil if some diary text is hidden.")
404
405(defcustom diary-header-line-format
406 '(:eval (calendar-string-spread
407 (list (if diary-selective-display
34755291 Roland Winkler2012-11-27 09:40:49 -0600408 "Some text is hidden - press \"C-c C-s\" before edit/copy"
cc16dac3 Glenn Morris2008-03-27 02:50:38 +0000409 "Diary"))
721dce17 Glenn Morris2010-08-13 18:56:35 -0700410 ?\s (window-width)))
efe9409a Glenn Morris2008-04-06 20:53:14 +0000411 "Format of the header line displayed by `diary-simple-display'.
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000412Only used if `diary-header-line-flag' is non-nil."
413 :group 'diary
414 :type 'sexp
415 :initialize 'custom-initialize-default
416 :set 'diary-set-header
ec1339fb Glenn Morris2010-08-13 19:23:56 -0700417 :version "23.3") ; frame-width -> window-width
cc16dac3 Glenn Morris2008-03-27 02:50:38 +0000418
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +0000419;; The first version of this also checked for diary-selective-display
420;; in the non-fancy case. This was an attempt to distinguish between
421;; displaying the diary and just visiting the diary file. However,
422;; when using fancy diary, calling diary when there are no entries to
423;; display does not create the fancy buffer, nor does it set
424;; diary-selective-display in the diary buffer. This means some
425;; customizations will not take effect, eg:
426;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00466.html
427;; So the check for diary-selective-display was dropped. This means the
428;; diary will be displayed if one customizes a diary variable while
429;; just visiting the diary-file. This is i) unlikely, and ii) no great loss.
430;;;###cal-autoload
431(defun diary-live-p ()
9025db71
GM
Glenn Morris2014-09-07 23:03:19 -0700432 "Return non-nil if the diary is being displayed.
433The actual return value is a diary buffer."
e803eab7 Glenn Morris2008-04-07 01:59:37 +0000434 (or (get-buffer diary-fancy-buffer)
6dd2d9b9 Glenn Morris2009-09-03 06:34:19 +0000435 (and diary-file (find-buffer-visiting diary-file))))
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +0000436
437;;;###cal-autoload
438(defun diary-set-maybe-redraw (symbol value)
439 "Set SYMBOL's value to VALUE, and redraw the diary if necessary.
440Redraws the diary if it is being displayed (note this is not the same as
441just visiting the `diary-file'), and SYMBOL's value is to be changed."
cc16dac3 Glenn Morris2008-03-27 02:50:38 +0000442 (let ((oldvalue (symbol-value symbol)))
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +0000443 (custom-set-default symbol value)
444 (and (not (equal value oldvalue))
445 (diary-live-p)
446 ;; Note this assumes diary was called without prefix arg.
447 (diary))))
448
efe9409a Glenn Morris2008-04-06 20:53:14 +0000449(defcustom diary-number-of-entries 1
26f43550 Glenn Morris2008-03-26 03:26:43 +0000450 "Specifies how many days of diary entries are to be displayed initially.
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +0000451This variable affects the diary display when the command \\[diary] is
452used, or if the value of the variable `calendar-view-diary-initially-flag'
453is non-nil. For example, if the default value 1 is used, then only the
454current day's diary entries will be displayed. If the value 2 is used,
455then both the current day's and the next day's entries will be displayed.
456
457The value can also be a vector such as [0 2 2 2 2 4 1]; this value says
458to display no diary entries on Sunday, the entries for the current date
459and the day after on Monday through Thursday, Friday through Monday's
460entries on Friday, and only Saturday's entries on Saturday.
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +0000461
462This variable does not affect the diary display with the `d' command
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +0000463from the calendar; in that case, the prefix argument controls the number
464of days of diary entries displayed."
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +0000465 :type '(choice (integer :tag "Entries")
466 (vector :value [0 0 0 0 0 0 0]
467 (integer :tag "Sunday")
468 (integer :tag "Monday")
469 (integer :tag "Tuesday")
470 (integer :tag "Wednesday")
471 (integer :tag "Thursday")
472 (integer :tag "Friday")
473 (integer :tag "Saturday")))
474 :initialize 'custom-initialize-default
475 :set 'diary-set-maybe-redraw
476 :group 'diary)
477
6a979a50 Glenn Morris2008-04-12 03:11:49 +0000478;;; More user options in calendar.el, holidays.el.
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +0000479
480
c87a1f38
GM
Glenn Morris2003-06-22 01:02:22 +0000481(defun diary-check-diary-file ()
482 "Check that the file specified by `diary-file' exists and is readable.
483If so, return the expanded file name, otherwise signal an error."
6dd2d9b9
GM
Glenn Morris2009-09-03 06:34:19 +0000484 (if (and diary-file (file-exists-p diary-file))
485 (if (file-readable-p diary-file)
486 diary-file
487 (error "Diary file `%s' is not readable" diary-file))
488 (error "Diary file `%s' does not exist" diary-file)))
c87a1f38 Glenn Morris2003-06-22 01:02:22 +0000489
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +0000490;;;###autoload
491(defun diary (&optional arg)
492 "Generate the diary window for ARG days starting with the current date.
493If no argument is provided, the number of days of diary entries is governed
efe9409a Glenn Morris2008-04-06 20:53:14 +0000494by the variable `diary-number-of-entries'. A value of ARG less than 1
865fe16f Chong Yidong2012-09-17 13:41:04 +0800495does nothing. This function is suitable for execution in an init file."
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000496 (interactive "P")
c87a1f38 Glenn Morris2003-06-22 01:02:22 +0000497 (diary-check-diary-file)
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000498 (diary-list-entries (calendar-current-date)
499 (if arg (prefix-numeric-value arg))))
01a7778e Stefan Monnier2005-09-12 21:21:42 +0000500
a53b53b3 Glenn Morris2008-03-13 05:54:57 +0000501;;;###cal-autoload
01a7778e Stefan Monnier2005-09-12 21:21:42 +0000502(defun diary-view-entries (&optional arg)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000503 "Prepare and display a buffer with diary entries.
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +0000504Searches the file named in `diary-file' for entries that match
505ARG days starting with the date indicated by the cursor position
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +0000506in the displayed three-month calendar."
507 (interactive "p")
c87a1f38 Glenn Morris2003-06-22 01:02:22 +0000508 (diary-check-diary-file)
01a7778e Stefan Monnier2005-09-12 21:21:42 +0000509 (diary-list-entries (calendar-cursor-to-date t) arg))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000510
26f43550 Glenn Morris2008-03-26 03:26:43 +0000511
a53b53b3 Glenn Morris2008-03-13 05:54:57 +0000512;;;###cal-autoload
efe9409a Glenn Morris2008-04-06 20:53:14 +0000513(defun diary-view-other-diary-entries (arg dfile)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000514 "Prepare and display buffer of diary entries from an alternative diary file.
c87a1f38
GM
Glenn Morris2003-06-22 01:02:22 +0000515Searches for entries that match ARG days, starting with the date indicated
516by the cursor position in the displayed three-month calendar.
f1700e26 Glenn Morris2008-03-16 01:27:15 +0000517DFILE specifies the file to use as the diary file."
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000518 (interactive
3b554221 Glenn Morris2004-12-20 18:09:22 +0000519 (list (prefix-numeric-value current-prefix-arg)
892e6825 Edward M. Reingold1998-06-09 21:50:58 +0000520 (read-file-name "Enter diary file name: " default-directory nil t)))
f1700e26 Glenn Morris2008-03-16 01:27:15 +0000521 (let ((diary-file dfile))
1cebb838 Glenn Morris2006-04-22 00:11:11 +0000522 (diary-view-entries arg)))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000523
01a7778e
SM
Stefan Monnier2005-09-12 21:21:42 +0000524(defvar diary-syntax-table
525 (let ((st (copy-syntax-table (standard-syntax-table))))
526 (modify-syntax-entry ?* "w" st)
527 (modify-syntax-entry ?: "w" st)
528 st)
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +0000529 "The syntax table used when parsing dates in the diary file.
530It is the standard syntax table used in Fundamental mode, but with the
c87a1f38 Glenn Morris2003-06-22 01:02:22 +0000531syntax of `*' and `:' changed to be word constituents.")
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000532
c47a201a Juanma Barranquero2003-02-11 23:26:55 +0000533(defun diary-attrtype-convert (attrvalue type)
c87a1f38
GM
Glenn Morris2003-06-22 01:02:22 +0000534 "Convert string ATTRVALUE to TYPE appropriate for a face description.
535Valid TYPEs are: string, symbol, int, stringtnil, tnil."
55e8cf94 Glenn Morris2008-03-10 02:44:51 +0000536 (cond ((eq type 'string) attrvalue)
cc16dac3 Glenn Morris2008-03-27 02:50:38 +0000537 ((eq type 'symbol) (intern-soft attrvalue))
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000538 ((eq type 'int) (string-to-number attrvalue))
539 ((eq type 'stringtnil)
540 (cond ((string-equal "t" attrvalue) t)
541 ((string-equal "nil" attrvalue) nil)
542 (t attrvalue)))
543 ((eq type 'tnil) (string-equal "t" attrvalue))))
c47a201a
JB
Juanma Barranquero2003-02-11 23:26:55 +0000544
545(defun diary-pull-attrs (entry fileglobattrs)
55e8cf94
GM
Glenn Morris2008-03-10 02:44:51 +0000546 "Search for matches for regexps from `diary-face-attrs'.
547If ENTRY is nil, searches from the start of the current buffer, and
548prepends all regexps with `diary-glob-file-regexp-prefix'.
549If ENTRY is a string, search for matches in that string, and remove them.
550Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs.
551When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE)
552pairs."
553 (let (regexp regnum attrname attrname attrvalue type ret-attr)
554 (if (null entry)
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000555 (save-excursion
556 (dolist (attr diary-face-attrs)
557 ;; FIXME inefficient searching.
558 (goto-char (point-min))
559 (setq regexp (concat diary-glob-file-regexp-prefix (car attr))
560 regnum (cadr attr)
561 attrname (nth 2 attr)
562 type (nth 3 attr)
563 attrvalue (if (re-search-forward regexp nil t)
564 (match-string-no-properties regnum)))
565 (and attrvalue
566 (setq attrvalue (diary-attrtype-convert attrvalue type))
567 (setq ret-attr (append ret-attr
568 (list attrname attrvalue))))))
55e8cf94
GM
Glenn Morris2008-03-10 02:44:51 +0000569 (setq ret-attr fileglobattrs)
570 (dolist (attr diary-face-attrs)
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000571 (setq regexp (car attr)
572 regnum (cadr attr)
573 attrname (nth 2 attr)
574 type (nth 3 attr)
575 attrvalue nil)
1baf9da4
GM
Glenn Morris2008-03-28 02:47:59 +0000576 ;; If multiple matches, replace all, use the last (which may
577 ;; be the first instance in the line, if the regexp is
578 ;; anchored with $).
579 (while (string-match regexp entry)
580 (setq attrvalue (match-string-no-properties regnum entry)
581 entry (replace-match "" t t entry)))
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +0000582 (and attrvalue
583 (setq attrvalue (diary-attrtype-convert attrvalue type))
584 (setq ret-attr (append ret-attr (list attrname attrvalue))))))
55e8cf94 Glenn Morris2008-03-10 02:44:51 +0000585 (list entry ret-attr)))
4e80f517 Sam Steingold2003-04-25 01:58:49 +0000586
01a7778e Stefan Monnier2005-09-12 21:21:42 +0000587
e652c999
GM
Glenn Morris2006-05-19 08:24:51 +0000588
589(defvar diary-modify-entry-list-string-function nil
590 "Function applied to entry string before putting it into the entries list.
591Can be used by programs integrating a diary list into other buffers (e.g.
592org.el and planner.el) to modify the string or add properties to it.
593The function takes a string argument and must return a string.")
594
71ea27ee Glenn Morris2008-03-13 06:29:28 +0000595(defvar diary-entries-list) ; bound in diary-list-entries
55e8cf94 Glenn Morris2008-03-10 02:44:51 +0000596
efe9409a Glenn Morris2008-04-06 20:53:14 +0000597(defun diary-add-to-list (date string specifier &optional marker
e652c999
GM
Glenn Morris2006-05-19 08:24:51 +0000598 globcolor literal)
599 "Add an entry to `diary-entries-list'.
64ba814f Juanma Barranquero2008-11-30 01:01:18 +0000600Do nothing if DATE or STRING are nil. DATE is the (MONTH DAY
e652c999
GM
Glenn Morris2006-05-19 08:24:51 +0000601YEAR) for which the entry applies; STRING is the text of the
602entry as it will appear in the diary (i.e. with any format
45380d42 Glenn Morris2006-05-19 08:42:50 +0000603strings such as \"%d\" expanded); SPECIFIER is the date part of
e652c999 Glenn Morris2006-05-19 08:24:51 +0000604the entry as it appears in the diary-file; LITERAL is the entry
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +0000605as it appears in the diary-file (i.e. before expansion).
606If LITERAL is nil, it is taken to be the same as STRING.
e652c999
GM
Glenn Morris2006-05-19 08:24:51 +0000607
608The entry is added to the list as (DATE STRING SPECIFIER LOCATOR
609GLOBCOLOR), where LOCATOR has the form (MARKER FILENAME LITERAL),
548d0a63
GM
Glenn Morris2011-05-05 21:28:53 -0700610FILENAME being the file containing the diary entry.
611
612Modifies STRING using `diary-modify-entry-list-string-function', if non-nil.
613Also removes the region between `diary-comment-start' and
614`diary-comment-end', if the former is non-nil."
e652c999 Glenn Morris2006-05-19 08:24:51 +0000615 (when (and date string)
17a46341 Glenn Morris2010-09-28 21:19:30 -0700616 ;; b-f-n is nil if we are visiting an include file in a temp-buffer.
548d0a63
GM
Glenn Morris2011-05-05 21:28:53 -0700617 (let ((dfile (or (buffer-file-name) diary-file))
618 cstart)
17a46341
GM
Glenn Morris2010-09-28 21:19:30 -0700619 (if diary-file-name-prefix
620 (let ((prefix (funcall diary-file-name-prefix-function dfile)))
621 (or (string-equal prefix "")
622 (setq string (format "[%s] %s" prefix string)))))
623 (and diary-modify-entry-list-string-function
624 (setq string (funcall diary-modify-entry-list-string-function
625 string)))
548d0a63
GM
Glenn Morris2011-05-05 21:28:53 -0700626 (when (and diary-comment-start
627 (string-match (setq cstart (regexp-quote diary-comment-start))
628 string))
629 ;; Preserve the value with the comments.
630 (or literal (setq literal string))
314347b9
GM
Glenn Morris2011-05-06 18:20:47 -0700631 ;; Handles multiple comments per entry, so long as each is on
632 ;; a single line, and each line has no more than one comment.
548d0a63 Glenn Morris2011-05-05 21:28:53 -0700633 (setq string (replace-regexp-in-string
897f8f20 Glenn Morris2011-05-06 00:30:20 -0700634 (format "%s.*%s" cstart (regexp-quote diary-comment-end))
548d0a63 Glenn Morris2011-05-05 21:28:53 -0700635 "" string)))
17a46341
GM
Glenn Morris2010-09-28 21:19:30 -0700636 (setq diary-entries-list
637 (append diary-entries-list
638 (list (list date string specifier
639 (list marker dfile literal)
640 globcolor)))))))
e652c999 Glenn Morris2006-05-19 08:24:51 +0000641
f1700e26 Glenn Morris2008-03-16 01:27:15 +0000642(defun diary-list-entries-2 (date mark globattr list-only
ac145600 Glenn Morris2008-06-11 02:57:35 +0000643 &optional months symbol gdate)
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000644 "Internal subroutine of `diary-list-entries'.
645Find diary entries applying to DATE, by searching from point-min for
646each element of `diary-date-forms'. MARK indicates an entry is non-marking.
647GLOBATTR is the list of global file attributes. If LIST-ONLY is
648non-nil, don't change the buffer, only return a list of entries.
649Optional array MONTHS replaces `calendar-month-name-array', and
650means months cannot be abbreviated. Optional string SYMBOL marks diary
ac145600
GM
Glenn Morris2008-06-11 02:57:35 +0000651entries of the desired type. If DATE is not Gregorian, then the
652Gregorian equivalent should be provided via GDATE. Returns non-nil if
653any entries were found."
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +0000654 (let* ((month (calendar-extract-month date))
655 (day (calendar-extract-day date))
656 (year (calendar-extract-year date))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000657 (dayname (format "%s\\|%s\\.?" (calendar-day-name date)
658 (calendar-day-name date 'abbrev)))
659 (calendar-month-name-array (or months calendar-month-name-array))
660 (monthname (format "\\*\\|%s%s" (calendar-month-name month)
661 (if months ""
662 (format "\\|%s\\.?"
663 (calendar-month-name month 'abbrev)))))
664 (month (format "\\*\\|0*%d" month))
665 (day (format "\\*\\|0*%d" day))
666 (year (format "\\*\\|0*%d%s" year
efe9409a Glenn Morris2008-04-06 20:53:14 +0000667 (if diary-abbreviated-year-flag
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000668 (format "\\|%02d" (% year 100))
669 "")))
670 (case-fold-search t)
671 entry-found)
672 (dolist (date-form diary-date-forms)
673 (let ((backup (when (eq (car date-form) 'backup)
674 (setq date-form (cdr date-form))
675 t))
676 ;; date-form uses day etc as set above.
677 (regexp (format "^%s?%s\\(%s\\)" (regexp-quote mark)
678 (if symbol (regexp-quote symbol) "")
679 (mapconcat 'eval date-form "\\)\\(?:")))
680 entry-start date-start temp)
681 (goto-char (point-min))
682 (while (re-search-forward regexp nil t)
683 (if backup (re-search-backward "\\<" nil t))
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +0000684 ;; regexp moves us past the end of date, onto the next line.
685 ;; Trailing whitespace after date not allowed (see diary-file).
f1700e26 Glenn Morris2008-03-16 01:27:15 +0000686 (if (and (bolp) (not (looking-at "[ \t]")))
6dd2d9b9 Glenn Morris2009-09-03 06:34:19 +0000687 ;; Diary entry that consists only of date.
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000688 (backward-char 1)
689 ;; Found a nonempty diary entry--make it
690 ;; visible and add it to the list.
1baf9da4 Glenn Morris2008-03-28 02:47:59 +0000691 (setq date-start (line-end-position 0))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000692 ;; Actual entry starts on the next-line?
693 (if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
694 (setq entry-found t
1baf9da4 Glenn Morris2008-03-28 02:47:59 +0000695 entry-start (point))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000696 (forward-line 1)
697 (while (looking-at "[ \t]") ; continued entry
698 (forward-line 1))
699 (unless (and (eobp) (not (bolp)))
700 (backward-char 1))
701 (unless list-only
702 (remove-overlays date-start (point) 'invisible 'diary))
703 (setq temp (diary-pull-attrs
704 (buffer-substring-no-properties
705 entry-start (point)) globattr))
efe9409a Glenn Morris2008-04-06 20:53:14 +0000706 (diary-add-to-list
ac145600 Glenn Morris2008-06-11 02:57:35 +0000707 (or gdate date) (car temp)
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000708 (buffer-substring-no-properties (1+ date-start) (1- entry-start))
709 (copy-marker entry-start) (cadr temp))))))
710 entry-found))
711
712(defvar original-date) ; from diary-list-entries
713(defvar file-glob-attrs)
714(defvar list-only)
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +0000715(defvar number)
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +0000716
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +0000717(defun diary-list-entries-1 (months symbol absfunc)
718 "List diary entries of a certain type.
719MONTHS is an array of month names. SYMBOL marks diary entries of the type
720in question. ABSFUNC is a function that converts absolute dates to dates
721of the appropriate type."
f1700e26 Glenn Morris2008-03-16 01:27:15 +0000722 (let ((gdate original-date))
bc4f7f3d Glenn Morris2011-04-18 21:11:01 -0700723 (dotimes (_idummy number)
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000724 (diary-list-entries-2
725 (funcall absfunc (calendar-absolute-from-gregorian gdate))
ac145600 Glenn Morris2008-06-11 02:57:35 +0000726 diary-nonmarking-symbol file-glob-attrs list-only months symbol gdate)
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +0000727 (setq gdate
728 (calendar-gregorian-from-absolute
729 (1+ (calendar-absolute-from-gregorian gdate))))))
730 (goto-char (point-min)))
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +0000731
92b99a01 Glenn Morris2010-09-14 00:15:06 -0700732(defvar diary-included-files nil
f6ba4cc9
GM
Glenn Morris2011-06-25 15:22:47 -0700733 "List of any diary files included in the last call to `diary-list-entries'.
734Or to `diary-mark-entries'.")
92b99a01 Glenn Morris2010-09-14 00:15:06 -0700735
1aee45ed Stefan Monnier2005-10-06 16:22:13 +0000736(defun diary-list-entries (date number &optional list-only)
01a7778e Stefan Monnier2005-09-12 21:21:42 +0000737 "Create and display a buffer containing the relevant lines in `diary-file'.
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700738Selects entries for NUMBER days starting with date DATE. Hides any
739other entries using overlays. If NUMBER is less than 1, this function
740does nothing.
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000741
87e798a7 Glenn Morris2010-09-14 19:34:39 -0700742Returns a list of all relevant diary entries found.
1aee45ed
SM
Stefan Monnier2005-10-06 16:22:13 +0000743The list entries have the form ((MONTH DAY YEAR) STRING SPECIFIER) where
744\(MONTH DAY YEAR) is the date of the entry, STRING is the entry text, and
745SPECIFIER is the applicability. If the variable `diary-list-include-blanks'
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +0000746is non-nil, this list includes a dummy diary entry consisting of the empty
747string for a date with no diary entries.
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000748
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700749If producing entries for multiple dates (i.e., NUMBER > 1), then
750this function normally returns the entries from any given diary
751file in date order. The entries for any given day are in the
752order in which they were found in the file, not necessarily in
753time-of-day order. Note that any functions present on the
87e798a7
GM
Glenn Morris2010-09-14 19:34:39 -0700754hooks (see below) may add entries, or change the order. For
755example, `diary-include-other-diary-files' adds entries from any
756include files that it finds to the end of the original list. The
757entries from each file will be in date order, but the overall
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700758list will not be. If you want the entire list to be in time
759order, add `diary-sort-entries' to the end of `diary-list-entries-hook'.
87e798a7 Glenn Morris2010-09-14 19:34:39 -0700760
4f99f44b Glenn Morris2011-05-09 19:22:55 -0700761After preparing the initial list, hooks run in this order:
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000762
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700763 `diary-nongregorian-listing-hook' runs for the main diary file,
764 and each included file. For example, this is the appropriate hook
765 to process Islamic entries in all diary files.
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000766
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700767 `diary-list-entries-hook' runs once only, for the main diary file.
768 For example, this is appropriate for sorting all the entries.
769 If not using include files, there is no difference from the previous
770 hook.
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000771
4f99f44b Glenn Morris2011-05-09 19:22:55 -0700772 `diary-hook' runs last, after the diary is displayed.
f8c8f32b Glenn Morris2008-05-30 02:57:27 +0000773 This is used e.g. by `appt-check'.
1aee45ed Stefan Monnier2005-10-06 16:22:13 +0000774
ffcd9e20
GM
Glenn Morris2008-03-09 19:57:36 +0000775Functions called by these hooks may use the variables ORIGINAL-DATE
776and NUMBER, which are the arguments with which this function was called.
777Note that hook functions should _not_ use DATE, but ORIGINAL-DATE.
efe9409a Glenn Morris2008-04-06 20:53:14 +0000778\(Sexp diary entries may use DATE - see `diary-list-sexp-entries'.)
7e8a1629 Glenn Morris2008-03-09 03:42:20 +0000779
f8c8f32b
GM
Glenn Morris2008-05-30 02:57:27 +0000780This function displays the list using `diary-display-function', unless
781LIST-ONLY is non-nil, in which case it just returns the list."
01a7778e Stefan Monnier2005-09-12 21:21:42 +0000782 (unless number
efe9409a
GM
Glenn Morris2008-04-06 20:53:14 +0000783 (setq number (if (vectorp diary-number-of-entries)
784 (aref diary-number-of-entries (calendar-day-of-week date))
785 diary-number-of-entries)))
6ecab45e Glenn Morris2004-01-11 22:25:33 +0000786 (when (> number 0)
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +0000787 (let* ((original-date date) ; save for possible use in the hooks
788 (date-string (calendar-date-string date))
6dd2d9b9 Glenn Morris2009-09-03 06:34:19 +0000789 (diary-buffer (find-buffer-visiting diary-file))
e9246b20 Glenn Morris2011-06-25 15:33:29 -0700790 ;; Dynamically bound in diary-include-files.
7161e329 Glenn Morris2010-09-28 21:10:34 -0700791 (d-incp (and (boundp 'diary-including) diary-including))
17a46341 Glenn Morris2010-09-28 21:19:30 -0700792 diary-entries-list file-glob-attrs temp-buff)
7161e329
GM
Glenn Morris2010-09-28 21:10:34 -0700793 (unless d-incp
794 (setq diary-included-files nil)
795 (message "Preparing diary..."))
17a46341
GM
Glenn Morris2010-09-28 21:19:30 -0700796 (unwind-protect
797 (with-current-buffer (or diary-buffer
798 (if list-only
799 (setq temp-buff (generate-new-buffer
800 " *diary-temp*"))
801 (find-file-noselect diary-file t)))
802 (if diary-buffer
803 (or (verify-visited-file-modtime diary-buffer)
804 (revert-buffer t t)))
805 (if temp-buff
806 ;; If including, caller has already verified it is readable.
807 (insert-file-contents diary-file)
808 ;; Setup things like the header-line-format and invisibility-spec.
809 (if (eq major-mode (default-value 'major-mode))
810 (diary-mode)
811 ;; This kludge is to make customizations to
812 ;; diary-header-line-flag after diary has been displayed
813 ;; take effect. Unconditionally calling (diary-mode)
814 ;; clobbers file local variables.
815 ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00363.html
816 ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-04/msg00404.html
817 (if (eq major-mode 'diary-mode)
818 (setq header-line-format (and diary-header-line-flag
819 diary-header-line-format)))))
820 ;; d-s-p is passed to the diary display function.
821 (let ((diary-saved-point (point)))
822 (save-excursion
823 (save-restriction
824 (widen) ; bug#5093
825 (setq file-glob-attrs (cadr (diary-pull-attrs nil "")))
826 (with-syntax-table diary-syntax-table
827 (goto-char (point-min))
828 (unless list-only
829 (let ((ol (make-overlay (point-min) (point-max) nil t nil)))
830 (set (make-local-variable 'diary-selective-display) t)
831 (overlay-put ol 'invisible 'diary)
832 (overlay-put ol 'evaporate t)))
bc4f7f3d Glenn Morris2011-04-18 21:11:01 -0700833 (dotimes (_idummy number)
17a46341
GM
Glenn Morris2010-09-28 21:19:30 -0700834 (let ((sexp-found (diary-list-sexp-entries date))
835 (entry-found (diary-list-entries-2
836 date diary-nonmarking-symbol
837 file-glob-attrs list-only)))
838 (if diary-list-include-blanks
839 (or sexp-found entry-found
840 (diary-add-to-list date "" "" "" "")))
841 (setq date
842 (calendar-gregorian-from-absolute
843 (1+ (calendar-absolute-from-gregorian date)))))))
844 (goto-char (point-min))
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700845 ;; Although it looks like list-entries-hook runs
846 ;; every time, diary-include-other-diary-files
847 ;; binds it to nil (essentially) when it runs
848 ;; in included files.
17a46341
GM
Glenn Morris2010-09-28 21:19:30 -0700849 (run-hooks 'diary-nongregorian-listing-hook
850 'diary-list-entries-hook)
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700851 ;; We could make this explicit:
852 ;;; (run-hooks 'diary-nongregorian-listing-hook)
853 ;;; (if d-incp
854 ;;; (diary-include-other-diary-files) ; recurse
855 ;;; (run-hooks 'diary-list-entries-hook))
17a46341 Glenn Morris2010-09-28 21:19:30 -0700856 (unless list-only
d7a3bb02
GM
Glenn Morris2014-09-09 14:09:54 -0400857 ;; Avoid M-x diary; M-x calendar; M-x diary
858 ;; clobbering the calendar window.
859 ;; FIXME this is not the right solution.
860 (let ((display-buffer-fallback-action
861 (list (delq
862 'display-buffer-in-previous-window
863 (copy-sequence
864 (car display-buffer-fallback-action))))))
ab7af022 Glenn Morris2014-10-10 19:54:11 -0700865 (funcall diary-display-function)))
17a46341
GM
Glenn Morris2010-09-28 21:19:30 -0700866 (run-hooks 'diary-hook)))))
867 (and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff)))
868 (or d-incp (message "Preparing diary...done"))
869 diary-entries-list)))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000870
01a7778e Stefan Monnier2005-09-12 21:21:42 +0000871(defun diary-unhide-everything ()
55e8cf94 Glenn Morris2008-03-10 02:44:51 +0000872 "Show all invisible text in the diary."
1aee45ed Stefan Monnier2005-10-06 16:22:13 +0000873 (kill-local-variable 'diary-selective-display)
7d82a738
SB
Stephen Berman2010-01-26 20:00:54 -0800874 (save-restriction ; bug#5477
875 (widen)
876 (remove-overlays (point-min) (point-max) 'invisible 'diary))
01a7778e
SM
Stefan Monnier2005-09-12 21:21:42 +0000877 (kill-local-variable 'mode-line-format))
878
71ea27ee Glenn Morris2008-03-13 06:29:28 +0000879(defvar original-date) ; bound in diary-list-entries
d01d7b8d Glenn Morris2010-11-25 19:10:16 -0800880;(defvar number) ; already declared above
55e8cf94 Glenn Morris2008-03-10 02:44:51 +0000881
f6ba4cc9
GM
Glenn Morris2011-06-25 15:22:47 -0700882(defun diary-include-files (&optional mark)
883 "Process diary entries from included diary files.
884By default, lists included entries, but if optional argument MARK is non-nil
885marks entries instead.
4f99f44b Glenn Morris2011-05-09 19:22:55 -0700886For example, this enables you to share common diary files.
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -0700887Specify include files using lines matching `diary-include-string', e.g.
888 #include \"filename\"
f6ba4cc9 Glenn Morris2011-06-25 15:22:47 -0700889This is recursive; that is, included files may include other files."
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +0000890 (goto-char (point-min))
891 (while (re-search-forward
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +0000892 (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000893 nil t)
6dd2d9b9 Glenn Morris2009-09-03 06:34:19 +0000894 (let ((diary-file (match-string-no-properties 1))
f6ba4cc9 Glenn Morris2011-06-25 15:22:47 -0700895 (diary-mark-entries-hook 'diary-mark-included-diary-files)
efe9409a Glenn Morris2008-04-06 20:53:14 +0000896 (diary-list-entries-hook 'diary-include-other-diary-files)
92b99a01 Glenn Morris2010-09-14 00:15:06 -0700897 (diary-including t)
d0de6cba Glenn Morris2010-09-28 21:00:50 -0700898 diary-hook diary-list-include-blanks efile)
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +0000899 (if (file-exists-p diary-file)
900 (if (file-readable-p diary-file)
7161e329
GM
Glenn Morris2010-09-28 21:10:34 -0700901 (if (member (setq efile (expand-file-name diary-file))
902 diary-included-files)
903 (error "Recursive diary include for %s" diary-file)
904 (setq diary-included-files
f6ba4cc9
GM
Glenn Morris2011-06-25 15:22:47 -0700905 (append diary-included-files (list efile)))
906 (if mark
907 (diary-mark-entries)
908 (setq diary-entries-list
909 (append diary-entries-list
910 (diary-list-entries original-date number t)))))
32757648
GM
Glenn Morris2012-08-20 14:13:03 -0400911 (display-warning
912 :error
913 (format "Can't read included diary file %s\n" diary-file)))
914 (display-warning
915 :error
916 (format "Can't find included diary file %s\n" diary-file)))))
71ea27ee Glenn Morris2008-03-13 06:29:28 +0000917 (goto-char (point-min)))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000918
f6ba4cc9
GM
Glenn Morris2011-06-25 15:22:47 -0700919(defun diary-include-other-diary-files ()
920 "Add diary entries from included diary files to `diary-entries-list'.
921To use, add this function to `diary-list-entries-hook'.
922For details, see `diary-include-files'.
923See also `diary-mark-included-diary-files'."
924 (diary-include-files))
925
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000926(defvar date-string) ; bound in diary-list-entries
927
928(defun diary-display-no-entries ()
efe9409a Glenn Morris2008-04-06 20:53:14 +0000929 "Common subroutine of `diary-simple-display' and `diary-fancy-display'.
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000930Handles the case where there are no diary entries.
931Returns a cons (NOENTRIES . HOLIDAY-STRING)."
e803eab7 Glenn Morris2008-04-07 01:59:37 +0000932 (let* ((holiday-list (if diary-show-holidays-flag
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000933 (calendar-check-holidays original-date)))
934 (hol-string (format "%s%s%s"
935 date-string
936 (if holiday-list ": " "")
937 (mapconcat 'identity holiday-list "; ")))
938 (msg (format "No diary entries for %s" hol-string))
939 ;; Empty list, or single item with no text.
940 ;; FIXME multiple items with no text?
941 (noentries (or (not diary-entries-list)
942 (and (not (cdr diary-entries-list))
943 (string-equal "" (cadr
944 (car diary-entries-list)))))))
945 ;; Inconsistency: whether or not the holidays are displayed in a
946 ;; separate buffer depends on if there are diary entries.
947 (when noentries
948 (if (or (< (length msg) (frame-width))
949 (not holiday-list))
b3099c46 Karl Heuer1996-01-25 00:52:17 +0000950 (message "%s" msg)
cc16dac3 Glenn Morris2008-03-27 02:50:38 +0000951 ;; holiday-list which is too wide for a message gets a buffer.
1435831f Glenn Morris2008-03-17 02:33:49 +0000952 (calendar-in-read-only-buffer holiday-buffer
cc16dac3 Glenn Morris2008-03-27 02:50:38 +0000953 (calendar-set-mode-line (format "Holidays for %s" date-string))
1435831f Glenn Morris2008-03-17 02:33:49 +0000954 (insert (mapconcat 'identity holiday-list "\n")))
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000955 (message "No diary entries for %s" date-string)))
956 (cons noentries hol-string)))
957
958
959(defvar diary-saved-point) ; bound in diary-list-entries
960
efe9409a Glenn Morris2008-04-06 20:53:14 +0000961(defun diary-simple-display ()
f8c8f32b
GM
Glenn Morris2008-05-30 02:57:27 +0000962 "Display the diary buffer if there are any relevant entries or holidays.
963Entries that do not apply are made invisible. Holidays are shown
964in the mode line. This is an option for `diary-display-function'."
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000965 ;; If selected window is dedicated (to the calendar), need a new one
966 ;; to display the diary.
290d5b58 Dmitry Antipov2013-08-05 18:26:57 +0400967 (let* ((pop-up-frames (or pop-up-frames (window-dedicated-p)))
6dd2d9b9 Glenn Morris2009-09-03 06:34:19 +0000968 (dbuff (find-buffer-visiting diary-file))
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000969 (empty (diary-display-no-entries)))
970 ;; This may be too wide, but when simple diary is used there is
971 ;; nowhere else for the holidays to go. Also, it is documented in
e803eab7 Glenn Morris2008-04-07 01:59:37 +0000972 ;; diary-show-holidays-flag that the holidays go in the mode-line.
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +0000973 ;; FIXME however if there are no diary entries a separate buffer
974 ;; is displayed - this is inconsistent.
975 (with-current-buffer dbuff
976 (calendar-set-mode-line (format "Diary for %s" (cdr empty))))
977 (unless (car empty) ; no entries
978 (with-current-buffer dbuff
ba55e59f Glenn Morris2004-09-28 22:24:47 +0000979 (let ((window (display-buffer (current-buffer))))
55e8cf94 Glenn Morris2008-03-10 02:44:51 +0000980 ;; d-s-p is passed from diary-list-entries.
ba55e59f Glenn Morris2004-09-28 22:24:47 +0000981 (set-window-point window diary-saved-point)
7161e329 Glenn Morris2010-09-28 21:10:34 -0700982 (set-window-start window (point-min)))))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +0000983
a8f4bb83
SB
Stephen Berman2013-06-18 18:05:01 +0200984(defvar diary-goto-entry-function 'diary-goto-entry
985 "Function called to jump to a diary entry.
986Modes that require special handling of the included file
987containing the diary entry can assign a suitable function to this
988variable.")
989
990(define-button-type 'diary-entry
991 'action (lambda (button) (funcall diary-goto-entry-function button))
c8dc27bf
GM
Glenn Morris2009-09-05 21:11:34 +0000992 'face 'diary-button 'help-echo "Find this diary entry"
993 'follow-link t)
86432f81
MR
Markus Rost2002-11-16 19:17:20 +0000994
995(defun diary-goto-entry (button)
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +0000996 "Jump to the diary entry for the BUTTON at point."
e652c999
GM
Glenn Morris2006-05-19 08:24:51 +0000997 (let* ((locator (button-get button 'locator))
998 (marker (car locator))
999 markbuf file)
1000 ;; If marker pointing to diary location is valid, use that.
1001 (if (and marker (setq markbuf (marker-buffer marker)))
1002 (progn
1003 (pop-to-buffer markbuf)
1004 (goto-char (marker-position marker)))
1005 ;; Marker is invalid (eg buffer has been killed).
1006 (or (and (setq file (cadr locator))
1007 (file-exists-p file)
1008 (find-file-other-window file)
1009 (progn
4d985ac2 Glenn Morris2009-08-28 03:18:49 +00001010 (when (eq major-mode (default-value 'major-mode)) (diary-mode))
e652c999
GM
Glenn Morris2006-05-19 08:24:51 +00001011 (goto-char (point-min))
1012 (if (re-search-forward (format "%s.*\\(%s\\)"
1013 (regexp-quote (nth 2 locator))
1014 (regexp-quote (nth 3 locator)))
1015 nil t)
1016 (goto-char (match-beginning 1)))))
1017 (message "Unable to locate this diary entry")))))
86432f81 Markus Rost2002-11-16 19:17:20 +00001018
efe9409a Glenn Morris2008-04-06 20:53:14 +00001019(defun diary-fancy-display ()
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001020 "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
f8c8f32b
GM
Glenn Morris2008-05-30 02:57:27 +00001021Holidays are shown unless `diary-show-holidays-flag' is nil.
1022Days with no diary entries are not shown (even if that day is a
1023holiday), unless `diary-list-include-blanks' is non-nil.
1024
1025This is an option for `diary-display-function'."
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00001026 ;; Turn off selective-display in the diary file's buffer.
6dd2d9b9 Glenn Morris2009-09-03 06:34:19 +00001027 (with-current-buffer (find-buffer-visiting diary-file)
01a7778e Stefan Monnier2005-09-12 21:21:42 +00001028 (diary-unhide-everything))
cc16dac3 Glenn Morris2008-03-27 02:50:38 +00001029 (unless (car (diary-display-no-entries)) ; no entries
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00001030 ;; Prepare the fancy diary buffer.
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001031 (calendar-in-read-only-buffer diary-fancy-buffer
1435831f Glenn Morris2008-03-17 02:33:49 +00001032 (calendar-set-mode-line "Diary Entries")
cc16dac3 Glenn Morris2008-03-27 02:50:38 +00001033 (let ((holiday-list-last-month 1)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001034 (holiday-list-last-year 1)
cc16dac3
GM
Glenn Morris2008-03-27 02:50:38 +00001035 (date (list 0 0 0))
1036 holiday-list)
1037 (dolist (entry diary-entries-list)
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001038 (unless (calendar-date-equal date (car entry))
1039 (setq date (car entry))
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001040 (and diary-show-holidays-flag
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001041 (calendar-date-compare
1042 (list (list holiday-list-last-month
1043 (calendar-last-day-of-month
1044 holiday-list-last-month
1045 holiday-list-last-year)
1046 holiday-list-last-year))
1047 (list date))
1048 ;; We need to get the holidays for the next 3 months.
1049 (setq holiday-list-last-month
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001050 (calendar-extract-month date)
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001051 holiday-list-last-year
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001052 (calendar-extract-year date))
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001053 (progn
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001054 (calendar-increment-month
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001055 holiday-list-last-month holiday-list-last-year 1)
1056 t)
1057 (setq holiday-list
1058 (let ((displayed-month holiday-list-last-month)
1059 (displayed-year holiday-list-last-year))
1060 (calendar-holiday-list)))
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001061 (calendar-increment-month
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001062 holiday-list-last-month holiday-list-last-year 1))
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001063 (let ((longest 0)
1064 date-holiday-list cc)
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001065 ;; Make a list of all holidays for date.
1066 (dolist (h holiday-list)
1067 (if (calendar-date-equal date (car h))
1068 (setq date-holiday-list (append date-holiday-list
1069 (cdr h)))))
1070 (insert (if (bobp) "" ?\n) (calendar-date-string date))
1071 (if date-holiday-list (insert ": "))
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001072 (setq cc (current-column))
1073 (insert (mapconcat (lambda (x)
1074 (setq longest (max longest (length x)))
1075 x)
1076 date-holiday-list
1077 (concat "\n" (make-string cc ?\s))))
1078 (insert ?\n (make-string (+ cc longest) ?=) ?\n)))
71ea27ee Glenn Morris2008-03-13 06:29:28 +00001079 (let ((this-entry (cadr entry))
2e73c671 Glenn Morris2008-04-02 03:34:23 +00001080 this-loc marks temp-face)
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00001081 (unless (zerop (length this-entry))
1082 (if (setq this-loc (nth 3 entry))
c8dc27bf Glenn Morris2009-09-05 21:11:34 +00001083 (insert-button this-entry
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00001084 ;; (MARKER FILENAME SPECIFIER LITERAL)
1085 'locator (list (car this-loc)
1086 (cadr this-loc)
1087 (nth 2 entry)
1088 (or (nth 2 this-loc)
1089 (nth 1 entry)))
1090 :type 'diary-entry)
c8dc27bf
GM
Glenn Morris2009-09-05 21:11:34 +00001091 (insert this-entry))
1092 (insert ?\n)
c253eff0
GM
Glenn Morris2009-02-08 01:52:26 +00001093 ;; Doesn't make sense to check font-lock-mode - see
1094 ;; comments above diary-entry-marker in calendar.el.
1095 (and ; font-lock-mode
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001096 (setq marks (nth 4 entry))
1097 (save-excursion
1098 (setq temp-face (calendar-make-temp-face marks))
1099 (search-backward this-entry)
1100 (overlay-put
1101 (make-overlay (match-beginning 0) (match-end 0))
1102 'face temp-face)))))))
2157a2be
GM
Glenn Morris2009-09-24 03:26:51 +00001103 ;; FIXME can't remember what this check was for.
1104 ;; To prevent something looping, or a minor optimization?
1105 (if (eq major-mode 'diary-fancy-display-mode)
1106 (run-hooks 'diary-fancy-display-mode-hook)
1107 (diary-fancy-display-mode))
7161e329 Glenn Morris2010-09-28 21:10:34 -07001108 (calendar-set-mode-line date-string))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001109
1435831f Glenn Morris2008-03-17 02:33:49 +00001110;; FIXME modernize?
efe9409a Glenn Morris2008-04-06 20:53:14 +00001111(defun diary-print-entries ()
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001112 "Print a hard copy of the diary display.
1113
1114If the simple diary display is being used, prepare a temp buffer with the
1115visible lines of the diary buffer, add a heading line composed from the mode
1116line, print the temp buffer, and destroy it.
1117
1118If the fancy diary display is being used, just print the buffer.
1119
efe9409a Glenn Morris2008-04-06 20:53:14 +00001120The hooks given by the variable `diary-print-entries-hook' are called to do
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001121the actual printing."
1122 (interactive)
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001123 (let ((diary-buffer (get-buffer diary-fancy-buffer))
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001124 temp-buffer heading start end)
1125 (if diary-buffer
1126 (with-current-buffer diary-buffer
efe9409a Glenn Morris2008-04-06 20:53:14 +00001127 (run-hooks 'diary-print-entries-hook))
6dd2d9b9 Glenn Morris2009-09-03 06:34:19 +00001128 (or (setq diary-buffer (find-buffer-visiting diary-file))
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001129 (error "You don't have a diary buffer!"))
1130 ;; Name affects printing?
1131 (setq temp-buffer (get-buffer-create " *Printable Diary Entries*"))
1132 (with-current-buffer diary-buffer
1133 (setq heading
1134 (if (not (stringp mode-line-format))
1135 "All Diary Entries"
1136 (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
1137 (match-string 1 mode-line-format))
1138 start (point-min))
1139 (while
1140 (progn
1141 (setq end (next-single-char-property-change start 'invisible))
1142 (unless (get-char-property start 'invisible)
1143 (with-current-buffer temp-buffer
1144 (insert-buffer-substring diary-buffer start end)))
1145 (setq start end)
1146 (and end (< end (point-max))))))
1147 (set-buffer temp-buffer)
1148 (goto-char (point-min))
1149 (insert heading "\n"
1150 (make-string (length heading) ?=) "\n")
efe9409a Glenn Morris2008-04-06 20:53:14 +00001151 (run-hooks 'diary-print-entries-hook)
2e73c671 Glenn Morris2008-04-02 03:34:23 +00001152 (kill-buffer temp-buffer))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001153
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00001154;;;###cal-autoload
01a7778e Stefan Monnier2005-09-12 21:21:42 +00001155(defun diary-show-all-entries ()
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001156 "Show all of the diary entries in the diary file.
1157This function gets rid of the selective display of the diary file so that
1158all entries, not just some, are visible. If there is no diary buffer, one
1159is created."
1160 (interactive)
4a34f065 Stefan Monnier2009-10-05 05:39:48 +00001161 (let* ((d-file (diary-check-diary-file))
290d5b58 Dmitry Antipov2013-08-05 18:26:57 +04001162 (pop-up-frames (or pop-up-frames (window-dedicated-p)))
4a34f065
SM
Stefan Monnier2009-10-05 05:39:48 +00001163 (win (selected-window))
1164 (height (window-height)))
01a7778e
SM
Stefan Monnier2005-09-12 21:21:42 +00001165 (with-current-buffer (or (find-buffer-visiting d-file)
1166 (find-file-noselect d-file t))
4d985ac2 Glenn Morris2009-08-28 03:18:49 +00001167 (when (eq major-mode (default-value 'major-mode)) (diary-mode))
0ffde81e Stefan Monnier2005-09-14 15:22:25 +00001168 (diary-unhide-everything)
4a34f065
SM
Stefan Monnier2009-10-05 05:39:48 +00001169 (display-buffer (current-buffer))
1170 (when (and (/= height (window-height win))
1171 (with-current-buffer (window-buffer win)
1172 (derived-mode-p 'calendar-mode)))
1173 (fit-window-to-buffer win)))))
8ffbfaa9 Richard M. Stallman1997-11-25 04:00:20 +00001174
f91adf29 Richard M. Stallman1998-05-06 07:38:44 +00001175;;;###autoload
8ffbfaa9
RS
Richard M. Stallman1997-11-25 04:00:20 +00001176(defun diary-mail-entries (&optional ndays)
1177 "Send a mail message showing diary entries for next NDAYS days.
1178If no prefix argument is given, NDAYS is set to `diary-mail-days'.
c87a1f38 Glenn Morris2003-06-22 01:02:22 +00001179Mail is sent to the address specified by `diary-mail-addr'.
8ffbfaa9 Richard M. Stallman1997-11-25 04:00:20 +00001180
8b00ec89
GM
Glenn Morris2008-03-27 08:26:17 +00001181Here is an example of a script to call `diary-mail-entries',
1182suitable for regular scheduling using cron (or at). Note that
865fe16f
CY
Chong Yidong2012-09-17 13:41:04 +08001183since `emacs -script' does not load your init file, you should
1184ensure that all relevant variables are set.
8b00ec89
GM
Glenn Morris2008-03-27 08:26:17 +00001185
1186#!/usr/bin/emacs -script
1187;; diary-rem.el - run the Emacs diary-reminder
1188
1189\(setq diary-mail-days 3
1190 diary-file \"/path/to/diary.file\"
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00001191 calendar-date-style 'european
8b00ec89
GM
Glenn Morris2008-03-27 08:26:17 +00001192 diary-mail-addr \"user@host.name\")
1193
1194\(diary-mail-entries)
1195
1196# diary-rem.el ends here
1197"
d56aaa64 Gerd Moellmann2001-01-24 11:48:19 +00001198 (interactive "P")
c87a1f38
GM
Glenn Morris2003-06-22 01:02:22 +00001199 (if (string-equal diary-mail-addr "")
1200 (error "You must set `diary-mail-addr' to use this command")
f8c8f32b Glenn Morris2008-05-30 02:57:27 +00001201 (let ((diary-display-function 'diary-fancy-display))
6f2ee245 Glenn Morris2006-05-13 06:12:10 +00001202 (diary-list-entries (calendar-current-date) (or ndays diary-mail-days)))
c87a1f38
GM
Glenn Morris2003-06-22 01:02:22 +00001203 (compose-mail diary-mail-addr
1204 (concat "Diary entries generated "
1205 (calendar-date-string (calendar-current-date))))
1206 (insert
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001207 (if (get-buffer diary-fancy-buffer)
1208 (with-current-buffer diary-fancy-buffer (buffer-string))
c87a1f38
GM
Glenn Morris2003-06-22 01:02:22 +00001209 "No entries found"))
1210 (call-interactively (get mail-user-agent 'sendfunc))))
d56aaa64 Gerd Moellmann2001-01-24 11:48:19 +00001211
ca2a5950
GM
Glenn Morris2003-08-03 14:00:56 +00001212(defun diary-name-pattern (string-array &optional abbrev-array paren)
1213 "Return a regexp matching the strings in the array STRING-ARRAY.
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07001214If the optional argument ABBREV-ARRAY is present, the regexp
1215also matches the supplied abbreviations, with or without final `.'
1216characters. If the optional argument PAREN is non-nil, surrounds
1217the regexp with parentheses."
ca2a5950 Glenn Morris2003-08-03 14:00:56 +00001218 (regexp-opt (append string-array
e565dd37 Glenn Morris2011-05-17 20:20:13 -07001219 abbrev-array
ca2a5950 Glenn Morris2003-08-03 14:00:56 +00001220 (if abbrev-array
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07001221 (mapcar (lambda (e) (format "%s." e))
1222 abbrev-array))
ca2a5950
GM
Glenn Morris2003-08-03 14:00:56 +00001223 nil)
1224 paren))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001225
efe9409a Glenn Morris2008-04-06 20:53:14 +00001226(defvar diary-marking-entries-flag nil
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001227 "True during the marking of diary entries, nil otherwise.")
1228
efe9409a Glenn Morris2008-04-06 20:53:14 +00001229(defvar diary-marking-entry-flag nil
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001230 "True during the marking of diary entries, if current entry is marking.")
1231
efe9409a Glenn Morris2008-04-06 20:53:14 +00001232;; file-glob-attrs bound in diary-mark-entries.
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001233(defun diary-mark-entries-1 (markfunc &optional months symbol absfunc)
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001234 "Mark diary entries of a certain type.
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001235MARKFUNC is a function that marks entries of the appropriate type
1236matching a given date pattern. MONTHS is an array of month names.
1237SYMBOL marks diary entries of the type in question. ABSFUNC is a
1238function that converts absolute dates to dates of the appropriate type. "
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001239 (let ((dayname (diary-name-pattern calendar-day-name-array
1240 calendar-day-abbrev-array))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001241 (monthname (format "%s\\|\\*"
1242 (if months
1243 (diary-name-pattern months)
1244 (diary-name-pattern calendar-month-name-array
1245 calendar-month-abbrev-array))))
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001246 (month "[0-9]+\\|\\*")
1247 (day "[0-9]+\\|\\*")
1248 (year "[0-9]+\\|\\*")
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001249 (case-fold-search t)
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001250 marks)
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001251 (dolist (date-form diary-date-forms)
1252 (if (eq (car date-form) 'backup) ; ignore 'backup directive
1253 (setq date-form (cdr date-form)))
1254 (let* ((l (length date-form))
1255 (d-name-pos (- l (length (memq 'dayname date-form))))
566f5ae6 Glenn Morris2008-03-27 06:19:47 +00001256 (d-name-pos (if (/= l d-name-pos) (1+ d-name-pos)))
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001257 (m-name-pos (- l (length (memq 'monthname date-form))))
566f5ae6 Glenn Morris2008-03-27 06:19:47 +00001258 (m-name-pos (if (/= l m-name-pos) (1+ m-name-pos)))
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001259 (d-pos (- l (length (memq 'day date-form))))
566f5ae6 Glenn Morris2008-03-27 06:19:47 +00001260 (d-pos (if (/= l d-pos) (1+ d-pos)))
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001261 (m-pos (- l (length (memq 'month date-form))))
566f5ae6 Glenn Morris2008-03-27 06:19:47 +00001262 (m-pos (if (/= l m-pos) (1+ m-pos)))
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001263 (y-pos (- l (length (memq 'year date-form))))
566f5ae6 Glenn Morris2008-03-27 06:19:47 +00001264 (y-pos (if (/= l y-pos) (1+ y-pos)))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001265 (regexp (format "^%s\\(%s\\)"
1266 (if symbol (regexp-quote symbol) "")
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001267 (mapconcat 'eval date-form "\\)\\("))))
1268 (goto-char (point-min))
1269 (while (re-search-forward regexp nil t)
1270 (let* ((dd-name
1271 (if d-name-pos
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001272 (match-string-no-properties d-name-pos)))
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001273 (mm-name
1274 (if m-name-pos
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001275 (match-string-no-properties m-name-pos)))
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001276 (mm (string-to-number
1277 (if m-pos
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001278 (match-string-no-properties m-pos)
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001279 "")))
1280 (dd (string-to-number
1281 (if d-pos
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001282 (match-string-no-properties d-pos)
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001283 "")))
1284 (y-str (if y-pos
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001285 (match-string-no-properties y-pos)))
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001286 (yy (if (not y-str)
1287 0
1288 (if (and (= (length y-str) 2)
efe9409a Glenn Morris2008-04-06 20:53:14 +00001289 diary-abbreviated-year-flag)
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001290 (let* ((current-y
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001291 (calendar-extract-year
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001292 (if absfunc
1293 (funcall
1294 absfunc
1295 (calendar-absolute-from-gregorian
1296 (calendar-current-date)))
1297 (calendar-current-date))))
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001298 (y (+ (string-to-number y-str)
1baf9da4
GM
Glenn Morris2008-03-28 02:47:59 +00001299 ;; Current century, eg 2000.
1300 (* 100 (/ current-y 100))))
1301 (offset (- y current-y)))
1302 ;; Add 2-digit year to current century.
1303 ;; If more than 50 years in the future,
1304 ;; assume last century. If more than 50
1305 ;; years in the past, assume next century.
1306 (if (> offset 50)
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001307 (- y 100)
1baf9da4 Glenn Morris2008-03-28 02:47:59 +00001308 (if (< offset -50)
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001309 (+ y 100)
1310 y)))
1311 (string-to-number y-str)))))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001312 (setq marks (cadr (diary-pull-attrs
1313 (buffer-substring-no-properties
1314 (point) (line-end-position))
1315 file-glob-attrs)))
977955fa
GM
Glenn Morris2009-08-22 19:47:42 +00001316 ;; Only mark all days of a given name if the pattern
1317 ;; contains no more specific elements.
1318 (if (and dd-name (not (or d-pos m-pos y-pos)))
efe9409a Glenn Morris2008-04-06 20:53:14 +00001319 (calendar-mark-days-named
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001320 (cdr (assoc-string dd-name
1321 (calendar-make-alist
1322 calendar-day-name-array
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07001323 0 nil calendar-day-abbrev-array
1324 (mapcar (lambda (e)
1325 (format "%s." e))
1326 calendar-day-abbrev-array))
1327 t)) marks)
4e11bcc2
GM
Glenn Morris2008-03-15 03:03:08 +00001328 (if mm-name
1329 (setq mm
1330 (if (string-equal mm-name "*") 0
1331 (cdr (assoc-string
1332 mm-name
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001333 (if months (calendar-make-alist months)
1334 (calendar-make-alist
1335 calendar-month-name-array
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07001336 1 nil calendar-month-abbrev-array
1337 (mapcar (lambda (e)
1338 (format "%s." e))
1339 calendar-month-abbrev-array)))
1340 t)))))
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001341 (funcall markfunc mm dd yy marks))))))))
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001342
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00001343;;;###cal-autoload
efe9409a Glenn Morris2008-04-06 20:53:14 +00001344(defun diary-mark-entries (&optional redraw)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001345 "Mark days in the calendar window that have diary entries.
4f99f44b
GM
Glenn Morris2011-05-09 19:22:55 -07001346Marks each entry in the diary that is visible in the calendar window.
1347
1348After marking the entries, runs `diary-nongregorian-marking-hook'
1349for the main diary file, and each included file. For example,
1350this is the appropriate hook to process Islamic entries in all
1351diary files. Next `diary-mark-entries-hook' runs, for the main diary
1352file only. If not using include files, there is no difference between
1353these two hooks.
1354
1355If the optional argument REDRAW is non-nil (which is the case
1356interactively, for example) then this first removes any existing diary
1357marks. This is intended to deal with deleted diary entries."
81eb8a4a
GM
Glenn Morris2005-03-16 13:23:55 +00001358 (interactive "p")
1359 ;; To remove any deleted diary entries. Do not redraw when:
1360 ;; i) processing #include diary files (else only get the marks from
1361 ;; the last #include file processed).
1362 ;; ii) called via calendar-redraw (since calendar has already been
1363 ;; erased).
1364 ;; Use of REDRAW handles both of these cases.
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001365 (when (and redraw calendar-mark-diary-entries-flag)
1366 (setq calendar-mark-diary-entries-flag nil)
1367 (calendar-redraw))
efe9409a Glenn Morris2008-04-06 20:53:14 +00001368 (let ((diary-marking-entries-flag t)
16712304 Glenn Morris2011-06-25 15:10:21 -07001369 (diary-buffer (find-buffer-visiting diary-file))
e9246b20 Glenn Morris2011-06-25 15:33:29 -07001370 ;; Dynamically bound in diary-include-files.
16712304
GM
Glenn Morris2011-06-25 15:10:21 -07001371 (d-incp (and (boundp 'diary-including) diary-including))
1372 file-glob-attrs temp-buff)
1373 (unless d-incp
f6ba4cc9 Glenn Morris2011-06-25 15:22:47 -07001374 (setq diary-included-files nil)
16712304
GM
Glenn Morris2011-06-25 15:10:21 -07001375 (message "Marking diary entries..."))
1376 (unwind-protect
1377 (with-current-buffer (or diary-buffer
1378 (if d-incp
1379 (setq temp-buff (generate-new-buffer
1380 " *diary-temp*"))
1381 (find-file-noselect
1382 (diary-check-diary-file) t)))
1383 (if temp-buff
1384 ;; If including, caller has already verified it is readable.
1385 (insert-file-contents diary-file)
1386 (if (eq major-mode (default-value 'major-mode)) (diary-mode)))
1387 (setq calendar-mark-diary-entries-flag t)
1388 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
1389 (with-syntax-table diary-syntax-table
1390 (save-excursion
1391 (diary-mark-entries-1 'calendar-mark-date-pattern)
1392 (diary-mark-sexp-entries)
1393 ;; Although it looks like mark-entries-hook runs every time,
1394 ;; diary-mark-included-diary-files binds it to nil
1395 ;; (essentially) when it runs in included files.
1396 (run-hooks 'diary-nongregorian-marking-hook
1397 'diary-mark-entries-hook))))
1398 (and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff)))
1399 (or d-incp (message "Marking diary entries...done"))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001400
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +00001401(defun diary-sexp-entry (sexp entry date)
1402 "Process a SEXP diary ENTRY for DATE."
1403 (let ((result (if calendar-debug-sexp
4d2d1ccd Glenn Morris2011-04-16 19:11:49 -07001404 (let ((debug-on-error t))
26f43550 Glenn Morris2008-03-26 03:26:43 +00001405 (eval (car (read-from-string sexp))))
32757648
GM
Glenn Morris2012-08-20 14:13:03 -04001406 (let (err)
1407 (condition-case err
1408 (eval (car (read-from-string sexp)))
1409 (error
1410 (display-warning
1411 :error
1412 (format "Bad diary sexp at line %d in %s:\n%s\n\
1413Error: %s\n"
1414 (count-lines (point-min) (point))
1415 diary-file sexp err))
1416 nil))))))
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +00001417 (cond ((stringp result) result)
1418 ((and (consp result)
1419 (stringp (cdr result))) result)
1420 (result entry)
1421 (t nil))))
1422
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001423(defvar displayed-year) ; bound in calendar-generate
55e8cf94
GM
Glenn Morris2008-03-10 02:44:51 +00001424(defvar displayed-month)
1425
efe9409a Glenn Morris2008-04-06 20:53:14 +00001426(defun diary-mark-sexp-entries ()
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001427 "Mark days in the calendar window that have sexp diary entries.
1428Each entry in the diary file (or included files) visible in the calendar window
efe9409a
GM
Glenn Morris2008-04-06 20:53:14 +00001429is marked. See the documentation for the function `diary-list-sexp-entries'."
1430 (let* ((sexp-mark (regexp-quote diary-sexp-entry-symbol))
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001431 (s-entry (format "^\\(%s(\\)\\|\\(%s%s(diary-remind\\)" sexp-mark
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001432 (regexp-quote diary-nonmarking-symbol)
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001433 sexp-mark))
c87a1f38 Glenn Morris2003-06-22 01:02:22 +00001434 (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001435 m y first-date last-date date mark file-glob-attrs
1436 sexp-start sexp entry entry-start)
01a7778e Stefan Monnier2005-09-12 21:21:42 +00001437 (with-current-buffer calendar-buffer
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001438 (setq m displayed-month
1439 y displayed-year))
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001440 (calendar-increment-month m y -1)
6e81a223 Glenn Morris2008-04-10 05:20:15 +00001441 (setq first-date (calendar-absolute-from-gregorian (list m 1 y)))
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001442 (calendar-increment-month m y 2)
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001443 (setq last-date
1444 (calendar-absolute-from-gregorian
1445 (list m (calendar-last-day-of-month m y) y)))
1446 (goto-char (point-min))
1447 (while (re-search-forward s-entry nil t)
efe9409a Glenn Morris2008-04-06 20:53:14 +00001448 (setq diary-marking-entry-flag (char-equal (preceding-char) ?\())
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001449 (re-search-backward "(")
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001450 (setq sexp-start (point))
1451 (forward-sexp)
1452 (setq sexp (buffer-substring-no-properties sexp-start (point)))
1453 (forward-char 1)
1454 (if (and (bolp) (not (looking-at "[ \t]")))
1455 ;; Diary entry consists only of the sexp.
1456 (progn
1457 (backward-char 1)
1458 (setq entry ""))
1459 (setq entry-start (point))
1460 ;; Find end of entry.
1461 (forward-line 1)
1462 (while (looking-at "[ \t]")
1463 (forward-line 1))
1464 (if (bolp) (backward-char 1))
1465 (setq entry (buffer-substring-no-properties entry-start (point))))
6e81a223 Glenn Morris2008-04-10 05:20:15 +00001466 (setq date (1- first-date))
fe5ffe0b
GM
Glenn Morris2008-04-11 03:46:35 +00001467 ;; FIXME this loops over all visible dates.
1468 ;; Could be optimized in many cases. Depends on whether t or * present.
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001469 (while (<= (setq date (1+ date)) last-date)
1470 (when (setq mark (diary-sexp-entry
1471 sexp entry
1472 (calendar-gregorian-from-absolute date)))
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001473 (calendar-mark-visible-date
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001474 (calendar-gregorian-from-absolute date)
1475 (or (cadr (diary-pull-attrs entry file-glob-attrs))
1476 (if (consp mark) (car mark)))))))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001477
efe9409a Glenn Morris2008-04-06 20:53:14 +00001478(defun diary-mark-included-diary-files ()
4f99f44b Glenn Morris2011-05-09 19:22:55 -07001479 "Mark diary entries from included diary files.
4f99f44b Glenn Morris2011-05-09 19:22:55 -07001480To use, add this function to `diary-mark-entries-hook'.
f6ba4cc9 Glenn Morris2011-06-25 15:22:47 -07001481For details, see `diary-include-files'.
4f99f44b Glenn Morris2011-05-09 19:22:55 -07001482See also `diary-include-other-diary-files'."
f6ba4cc9 Glenn Morris2011-06-25 15:22:47 -07001483 (diary-include-files t))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001484
efe9409a Glenn Morris2008-04-06 20:53:14 +00001485(defun calendar-mark-days-named (dayname &optional color)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001486 "Mark all dates in the calendar window that are day DAYNAME of the week.
55e8cf94 Glenn Morris2008-03-10 02:44:51 +000014870 means all Sundays, 1 means all Mondays, and so on.
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001488Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
01a7778e Stefan Monnier2005-09-12 21:21:42 +00001489 (with-current-buffer calendar-buffer
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001490 (let ((prev-month displayed-month)
1491 (prev-year displayed-year)
1492 (succ-month displayed-month)
1493 (succ-year displayed-year)
1494 (last-day)
1495 (day))
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001496 (calendar-increment-month succ-month succ-year 1)
1497 (calendar-increment-month prev-month prev-year -1)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001498 (setq day (calendar-absolute-from-gregorian
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00001499 (calendar-nth-named-day 1 dayname prev-month prev-year))
71ea27ee Glenn Morris2008-03-13 06:29:28 +00001500 last-day (calendar-absolute-from-gregorian
f6ca63d7 Glenn Morris2008-03-13 06:40:31 +00001501 (calendar-nth-named-day -1 dayname succ-month succ-year)))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001502 (while (<= day last-day)
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001503 (calendar-mark-visible-date (calendar-gregorian-from-absolute day)
71ea27ee Glenn Morris2008-03-13 06:29:28 +00001504 color)
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001505 (setq day (+ day 7))))))
1506
efe9409a Glenn Morris2008-04-06 20:53:14 +00001507(defun calendar-mark-month (month year p-month p-day p-year &optional color)
55e8cf94
GM
Glenn Morris2008-03-10 02:44:51 +00001508 "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P-DAY/P-YEAR.
1509A value of 0 in any position of the pattern is a wildcard.
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001510Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001511 (if (or (and (= month p-month)
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00001512 (or (zerop p-year) (= year p-year)))
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00001513 (and (zerop p-month)
55e8cf94
GM
Glenn Morris2008-03-10 02:44:51 +00001514 (or (zerop p-year) (= year p-year))))
1515 (if (zerop p-day)
4e11bcc2 Glenn Morris2008-03-15 03:03:08 +00001516 (dotimes (i (calendar-last-day-of-month month year))
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001517 (calendar-mark-visible-date (list month (1+ i) year) color))
1518 (calendar-mark-visible-date (list month p-day year) color))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001519
efe9409a Glenn Morris2008-04-06 20:53:14 +00001520(defun calendar-mark-date-pattern (month day year &optional color)
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00001521 "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
1522A value of 0 in any position is a wildcard. Optional argument COLOR is
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001523passed to `calendar-mark-visible-date' as MARK."
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00001524 (with-current-buffer calendar-buffer
1525 (let ((m displayed-month)
1526 (y displayed-year))
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001527 (calendar-increment-month m y -1)
bc4f7f3d Glenn Morris2011-04-18 21:11:01 -07001528 (dotimes (_idummy 3)
efe9409a Glenn Morris2008-04-06 20:53:14 +00001529 (calendar-mark-month m y month day year color)
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001530 (calendar-increment-month m y 1)))))
1435831f Glenn Morris2008-03-17 02:33:49 +00001531
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001532;; Bahai, Hebrew, Islamic.
1533(defun calendar-mark-complex (month day year fromabs &optional color)
1534 "Mark dates in the calendar conforming to MONTH DAY YEAR of some system.
1535The function FROMABS converts absolute dates to the appropriate date system.
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001536Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001537 ;; Not one of the simple cases--check all visible dates for match.
1538 ;; Actually, the following code takes care of ALL of the cases, but
1539 ;; it's much too slow to be used for the simple (common) cases.
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001540 (let* ((m displayed-month)
1541 (y displayed-year)
1542 (first-date (progn
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001543 (calendar-increment-month m y -1)
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001544 (calendar-absolute-from-gregorian (list m 1 y))))
1545 (last-date (progn
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001546 (calendar-increment-month m y 2)
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001547 (calendar-absolute-from-gregorian
1548 (list m (calendar-last-day-of-month m y) y))))
1549 (date (1- first-date))
1550 local-date)
1551 (while (<= (setq date (1+ date)) last-date)
1552 (setq local-date (funcall fromabs date))
1553 (and (or (zerop month)
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001554 (= month (calendar-extract-month local-date)))
2e73c671 Glenn Morris2008-04-02 03:34:23 +00001555 (or (zerop day)
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001556 (= day (calendar-extract-day local-date)))
2e73c671 Glenn Morris2008-04-02 03:34:23 +00001557 (or (zerop year)
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001558 (= year (calendar-extract-year local-date)))
1559 (calendar-mark-visible-date
2e73c671 Glenn Morris2008-04-02 03:34:23 +00001560 (calendar-gregorian-from-absolute date) color)))))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001561
1562;; Bahai, Islamic.
1563(defun calendar-mark-1 (month day year fromabs toabs &optional color)
1564 "Mark dates in the calendar conforming to MONTH DAY YEAR of some system.
1565The function FROMABS converts absolute dates to the appropriate date system.
64ba814f Juanma Barranquero2008-11-30 01:01:18 +00001566The function TOABS carries out the inverse operation. Optional argument
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001567COLOR is passed to `calendar-mark-visible-date' as MARK."
937e6a56 Stefan Monnier2009-11-03 02:04:29 +00001568 (with-current-buffer calendar-buffer
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001569 (if (and (not (zerop month)) (not (zerop day)))
1570 (if (not (zerop year))
1571 ;; Fully specified date.
1572 (let ((date (calendar-gregorian-from-absolute
1573 (funcall toabs (list month day year)))))
1574 (if (calendar-date-is-visible-p date)
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001575 (calendar-mark-visible-date date color)))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001576 ;; Month and day in any year--this taken from the holiday stuff.
1577 (let* ((i-date (funcall fromabs
1578 (calendar-absolute-from-gregorian
1579 (list displayed-month 15 displayed-year))))
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001580 (m (calendar-extract-month i-date))
1581 (y (calendar-extract-year i-date))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00001582 date)
1583 (unless (< m 1) ; calendar doesn't apply
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001584 (calendar-increment-month m y (- 10 month))
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001585 (and (> m 7) ; date might be visible
1586 (calendar-date-is-visible-p
1587 (setq date (calendar-gregorian-from-absolute
1588 (funcall toabs (list month day y)))))
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001589 (calendar-mark-visible-date date color)))))
b7b18c73 Leo Liu2014-11-23 15:51:24 +08001590 (calendar-mark-complex month day year fromabs color))))
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001591
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001592
1593(defun diary-entry-time (s)
fd4a98f0
RS
Richard M. Stallman2002-07-22 15:32:00 +00001594 "Return time at the beginning of the string S as a military-style integer.
1595For example, returns 1325 for 1:25pm.
56d3bae7
TTN
Thien-Thi Nguyen2004-01-08 23:31:47 +00001596
1597Returns `diary-unknown-time' (default value -9999) if no time is recognized.
1598The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam,
64ba814f Juanma Barranquero2008-11-30 01:01:18 +00001599XXAM, XXpm, XXPM, XX:XXam, XX:XXAM, XX:XXpm, or XX:XXPM. A period (.) can
6ecab45e Glenn Morris2004-01-11 22:25:33 +00001600be used instead of a colon (:) to separate the hour and minute parts."
2e73c671 Glenn Morris2008-04-02 03:34:23 +00001601 (let (case-fold-search)
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00001602 (cond ((string-match ; military time
1603 "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
56d3bae7 Thien-Thi Nguyen2004-01-08 23:31:47 +00001604 s)
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00001605 (+ (* 100 (string-to-number (match-string 1 s)))
1606 (string-to-number (match-string 2 s))))
1607 ((string-match ; hour only (XXam or XXpm)
1608 "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
1609 (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
1610 (if (equal ?a (downcase (aref s (match-beginning 2))))
1611 0 1200)))
f6ca63d7 Glenn Morris2008-03-13 06:40:31 +00001612 ((string-match ; hour and minute (XX:XXam or XX:XXpm)
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00001613 "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
1614 (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
1615 (string-to-number (match-string 2 s))
1616 (if (equal ?a (downcase (aref s (match-beginning 3))))
1617 0 1200)))
1618 (t diary-unknown-time)))) ; unrecognizable
619fdf3d Gerd Moellmann2000-11-30 12:27:36 +00001619
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00001620(defun diary-entry-compare (e1 e2)
1621 "Return t if E1 is earlier than E2."
1622 (or (calendar-date-compare e1 e2)
1623 (and (calendar-date-equal (car e1) (car e2))
1624 (let* ((ts1 (cadr e1)) (t1 (diary-entry-time ts1))
1625 (ts2 (cadr e2)) (t2 (diary-entry-time ts2)))
1626 (or (< t1 t2)
1627 (and (= t1 t2)
1628 (string-lessp ts1 ts2)))))))
1629
efe9409a Glenn Morris2008-04-06 20:53:14 +00001630(defun diary-sort-entries ()
67ae9766
GM
Glenn Morris2010-09-14 01:02:28 -07001631 "Sort the list of diary entries by time of day.
1632If you add this function to `diary-list-entries-hook', it should
1633be the last item in the hook, in case earlier items add diary
1634entries, or change the order."
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00001635 (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
1636
1637
efe9409a Glenn Morris2008-04-06 20:53:14 +00001638(defun diary-list-sexp-entries (date)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001639 "Add sexp entries for DATE from the diary file to `diary-entries-list'.
54f63811 Glenn Morris2008-03-27 07:58:31 +00001640Also, make them visible in the diary. Returns t if any entries are found.
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001641
efe9409a Glenn Morris2008-04-06 20:53:14 +00001642Sexp diary entries must be prefaced by a `diary-sexp-entry-symbol'
54f63811 Glenn Morris2008-03-27 07:58:31 +00001643\(normally `%%'). The form of a sexp diary entry is
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001644
1645 %%(SEXP) ENTRY
1646
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001647Both ENTRY and DATE are available when the SEXP is evaluated. If
1648the SEXP returns nil, the diary entry does not apply. If it
1649returns a non-nil value, ENTRY will be taken to apply to DATE; if
1650the value is a string, that string will be the diary entry in the
1651fancy diary display.
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001652
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001653For example, the following diary entry will apply to the 21st of
1654the month if it is a weekday and the Friday before if the 21st is
1655on a weekend:
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001656
1657 &%%(let ((dayname (calendar-day-of-week date))
e803eab7 Glenn Morris2008-04-07 01:59:37 +00001658 (day (calendar-extract-day date)))
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001659 (or
1660 (and (= day 21) (memq dayname '(1 2 3 4 5)))
1661 (and (memq day '(19 20)) (= dayname 5)))
1662 ) UIUC pay checks deposited
1663
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001664A number of built-in functions are available for this type of
1665diary entry. In the following, the optional parameter MARK
1666specifies a face or single-character string to use when
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001667highlighting the day in the calendar. For those functions that
1668take MONTH, DAY, and YEAR as arguments, the order of the input
1669parameters changes according to `calendar-date-style' (e.g. to
1670DAY MONTH YEAR in the European style).
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001671
1672 %%(diary-date MONTH DAY YEAR &optional MARK) text
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00001673 Entry applies if date is MONTH, DAY, YEAR. DAY, MONTH, and YEAR can
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001674 be a list of integers, `t' (meaning all values), or an integer.
1675
1676 %%(diary-float MONTH DAYNAME N &optional DAY MARK) text
a478b7bc
GM
Glenn Morris2008-04-29 03:34:40 +00001677 Entry will appear on the Nth DAYNAME after/before MONTH DAY.
1678 DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
1679 If N>0, use the Nth DAYNAME after MONTH DAY.
1680 If N<0, use the Nth DAYNAME before MONTH DAY.
1681 DAY defaults to 1 if N>0, and MONTH's last day otherwise.
1682 MONTH can be a list of months, a single month, or `t' to
1683 specify all months.
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001684
1685 %%(diary-block M1 D1 Y1 M2 D2 Y2 &optional MARK) text
1686 Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00001687 inclusive.
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001688
1689 %%(diary-anniversary MONTH DAY YEAR &optional MARK) text
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001690 Entry will appear on anniversary dates of MONTH DAY, YEAR.
1691 Text can contain `%d' or `%d%s'; `%d' will be replaced by the
1692 number of years since the MONTH DAY, YEAR, and `%s' by the
1693 ordinal ending of that number (i.e. `st', `nd', `rd' or `th',
1694 as appropriate). The anniversary of February 29 is
1695 considered to be March 1 in a non-leap year.
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001696
1697 %%(diary-cyclic N MONTH DAY YEAR &optional MARK) text
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001698 Entry will appear every N days, starting MONTH DAY, YEAR.
1699 Text can contain `%d' or `%d%s'; `%d' will be replaced by the
1700 number of repetitions since the MONTH DAY, YEAR and `%s' by
1701 the ordinal ending of that number (i.e. `st', `nd', `rd' or
1702 `th', as appropriate).
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001703
1704 %%(diary-remind SEXP DAYS &optional MARKING) text
1705 Entry is a reminder for diary sexp SEXP. DAYS is either a
1706 single number or a list of numbers indicating the number(s)
968560df
GM
Glenn Morris2008-04-23 03:06:11 +00001707 of days before the event that the warning(s) should occur.
1708 A negative number -DAYS has the same meaning as a list (1 2 ... DAYS).
1709 If the current date is (one of) DAYS before the event indicated
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001710 by EXPR, then a suitable message (as specified by
1711 `diary-remind-message') appears. In addition to the
1712 reminders beforehand, the diary entry also appears on the
1713 date itself. If optional MARKING is non-nil then the
1714 *reminders* are marked on the calendar. Marking of reminders
1715 is independent of whether the entry *itself* is a marking or
1716 non-marking one.
1717
192e3e20 Glenn Morris2008-04-05 20:58:26 +00001718 %%(diary-hebrew-yahrzeit MONTH DAY YEAR) text
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001719 Text is assumed to be the name of the person; the date is the
1720 date of death on the *civil* calendar. The diary entry will
1721 appear on the proper Hebrew-date anniversary and on the day
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00001722 before.
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001723
1724All the remaining functions do not accept any text, and so only
efe9409a Glenn Morris2008-04-06 20:53:14 +00001725make sense with `diary-fancy-display'. Most produce output every day.
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001726
1727`diary-day-of-year' - day of year and number of days remaining
1728`diary-iso-date' - ISO commercial date
1729`diary-astro-day-number' - astronomical (Julian) day number
1730`diary-sunrise-sunset' - local times of sunrise and sunset
1731
1732These functions give the date in alternative calendrical systems:
1733
1734`diary-bahai-date', `diary-chinese-date', `diary-coptic-date',
1735`diary-ethiopic-date', `diary-french-date', `diary-hebrew-date',
1736`diary-islamic-date', `diary-julian-date', `diary-mayan-date',
1737`diary-persian-date'
1738
1739Theses functions only produce output on certain dates:
1740
c4d6826b Glenn Morris2008-06-27 00:35:08 +00001741`diary-lunar-phases' - phases of moon (on the appropriate days)
a9df811d
GM
Glenn Morris2008-04-05 21:25:45 +00001742`diary-hebrew-omer' - Omer count, within 50 days after Passover
1743`diary-hebrew-parasha' - weekly parasha, every Saturday
1744`diary-hebrew-rosh-hodesh' - Rosh Hodesh, or the day or Saturday before
1745`diary-hebrew-sabbath-candles' - local time of candle lighting, on Fridays
54f63811
GM
Glenn Morris2008-03-27 07:58:31 +00001746
1747
1748Marking these entries is *extremely* time consuming, so it is
1749best if they are non-marking."
f1700e26 Glenn Morris2008-03-16 01:27:15 +00001750 (let ((s-entry (format "^%s?%s(" (regexp-quote diary-nonmarking-symbol)
efe9409a Glenn Morris2008-04-06 20:53:14 +00001751 (regexp-quote diary-sexp-entry-symbol)))
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001752 entry-found file-glob-attrs marks
1753 sexp-start sexp entry specifier entry-start line-start
1754 diary-entry temp literal)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001755 (goto-char (point-min))
5813f6ef Glenn Morris2009-12-02 03:03:48 +00001756 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001757 (while (re-search-forward s-entry nil t)
1758 (backward-char 1)
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001759 (setq sexp-start (point))
1760 (forward-sexp)
1761 (setq sexp (buffer-substring-no-properties sexp-start (point))
1762 line-start (line-end-position 0)
1763 specifier
1764 (buffer-substring-no-properties (1+ line-start) (point))
1765 entry-start (1+ line-start))
1766 (forward-char 1)
1767 (if (and (bolp) (not (looking-at "[ \t]")))
1768 ;; Diary entry consists only of the sexp.
1769 (progn
1770 (backward-char 1)
1771 (setq entry ""))
1772 (setq entry-start (point))
1773 (forward-line 1)
1774 (while (looking-at "[ \t]")
1775 (forward-line 1))
81ced43d Stephen Berman2010-12-08 17:50:08 -08001776 (if (bolp) (backward-char 1))
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001777 (setq entry (buffer-substring-no-properties entry-start (point))))
1778 (setq diary-entry (diary-sexp-entry sexp entry date)
1779 literal entry ; before evaluation
1780 entry (if (consp diary-entry)
1781 (cdr diary-entry)
1782 diary-entry))
1783 (when diary-entry
1784 (remove-overlays line-start (point) 'invisible 'diary)
1785 (if (< 0 (length entry))
1786 (setq temp (diary-pull-attrs entry file-glob-attrs)
1787 entry (nth 0 temp)
1788 marks (nth 1 temp))))
efe9409a Glenn Morris2008-04-06 20:53:14 +00001789 (diary-add-to-list date entry specifier
2e73c671
GM
Glenn Morris2008-04-02 03:34:23 +00001790 (if entry-start (copy-marker entry-start))
1791 marks literal)
1792 (setq entry-found (or entry-found diary-entry)))
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001793 entry-found))
1794
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001795(defun diary-make-date (a b c)
1796 "Convert A B C into the internal calendar date form.
1797The expected order of the inputs depends on `calendar-date-style',
1798e.g. in the European case, A = day, B = month, C = year. Returns
64ba814f Juanma Barranquero2008-11-30 01:01:18 +00001799a list (MONTH DAY YEAR), i.e. the American style, which is the
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001800form used internally by the calendar and diary."
1801 (cond ((eq calendar-date-style 'iso) ; YMD
1802 (list b c a))
1803 ((eq calendar-date-style 'european) ; DMY
1804 (list b a c))
1805 (t (list a b c))))
1806
1807
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +00001808;;; Sexp diary functions.
1809
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00001810(defvar date)
60495716
GM
Glenn Morris2008-03-08 23:38:06 +00001811(defvar entry)
1812
1813;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
fd4a98f0 Richard M. Stallman2002-07-22 15:32:00 +00001814(defun diary-date (month day year &optional mark)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001815 "Specific date(s) diary entry.
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +00001816Entry applies if date is MONTH, DAY, YEAR. Each parameter can be a
1817list of integers, `t' (meaning all values), or an integer. The order
1818of the input parameters changes according to `calendar-date-style'
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00001819\(e.g. to DAY MONTH YEAR in the European style).
fd4a98f0 Richard M. Stallman2002-07-22 15:32:00 +00001820
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +00001821An optional parameter MARK specifies a face or single-character string
1822to use when highlighting the day in the calendar."
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00001823 (let* ((ddate (diary-make-date month day year))
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001824 (dd (calendar-extract-day ddate))
1825 (mm (calendar-extract-month ddate))
1826 (yy (calendar-extract-year ddate))
1827 (m (calendar-extract-month date))
1828 (y (calendar-extract-year date))
1829 (d (calendar-extract-day date)))
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001830 (and
1831 (or (and (listp dd) (memq d dd))
1832 (equal d dd)
1833 (eq dd t))
1834 (or (and (listp mm) (memq m mm))
1835 (equal m mm)
1836 (eq mm t))
1837 (or (and (listp yy) (memq y yy))
1838 (equal y yy)
1839 (eq yy t))
1840 (cons mark entry))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001841
60495716 Glenn Morris2008-03-08 23:38:06 +00001842;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
fd4a98f0 Richard M. Stallman2002-07-22 15:32:00 +00001843(defun diary-block (m1 d1 y1 m2 d2 y2 &optional mark)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001844 "Block diary entry.
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +00001845Entry applies if date is between, or on one of, two dates. The order
1846of the input parameters changes according to `calendar-date-style'
1847\(e.g. to D1, M1, Y1, D2, M2, Y2 in the European style).
fd4a98f0 Richard M. Stallman2002-07-22 15:32:00 +00001848
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +00001849An optional parameter MARK specifies a face or single-character string
1850to use when highlighting the day in the calendar."
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001851 (let ((date1 (calendar-absolute-from-gregorian
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00001852 (diary-make-date m1 d1 y1)))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001853 (date2 (calendar-absolute-from-gregorian
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00001854 (diary-make-date m2 d2 y2)))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001855 (d (calendar-absolute-from-gregorian date)))
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001856 (and (<= date1 d) (<= d date2)
1857 (cons mark entry))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001858
60495716 Glenn Morris2008-03-08 23:38:06 +00001859;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
fd4a98f0 Richard M. Stallman2002-07-22 15:32:00 +00001860(defun diary-float (month dayname n &optional day mark)
a478b7bc
GM
Glenn Morris2008-04-29 03:34:40 +00001861 "Diary entry for the Nth DAYNAME after/before MONTH DAY.
1862DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
1863If N>0, use the Nth DAYNAME after MONTH DAY.
1864If N<0, use the Nth DAYNAME before MONTH DAY.
1865DAY defaults to 1 if N>0, and MONTH's last day otherwise.
1866MONTH can be a list of months, an integer, or `t' (meaning all months).
ee58da1b Sam Steingold2002-08-06 15:11:26 +00001867Optional MARK specifies a face or single-character string to use when
fd4a98f0 Richard M. Stallman2002-07-22 15:32:00 +00001868highlighting the day in the calendar."
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00001869 ;; This is messy because the diary entry may apply, but the date on which it
1870 ;; is based can be in a different month/year. For example, asking for the
1871 ;; first Monday after December 30. For large values of |n| the problem is
1872 ;; more grotesque.
9b58d144 Richard M. Stallman1997-05-20 05:18:15 +00001873 (and (= dayname (calendar-day-of-week date))
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001874 (let* ((m (calendar-extract-month date))
1875 (d (calendar-extract-day date))
1876 (y (calendar-extract-year date))
71ea27ee Glenn Morris2008-03-13 06:29:28 +00001877 ;; Last (n>0) or first (n<0) possible base date for entry.
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00001878 (limit
9b58d144
RS
Richard M. Stallman1997-05-20 05:18:15 +00001879 (calendar-nth-named-absday (- n) dayname m y d))
1880 (last-abs (if (> n 0) limit (+ limit 6)))
1881 (first-abs (if (> n 0) (- limit 6) limit))
1882 (last (calendar-gregorian-from-absolute last-abs))
1883 (first (calendar-gregorian-from-absolute first-abs))
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00001884 ;; m1, d1 is first possible base date.
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001885 (m1 (calendar-extract-month first))
1886 (d1 (calendar-extract-day first))
1887 (y1 (calendar-extract-year first))
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00001888 ;; m2, d2 is last possible base date.
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001889 (m2 (calendar-extract-month last))
1890 (d2 (calendar-extract-day last))
1891 (y2 (calendar-extract-year last)))
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00001892 (if (or (and (= m1 m2) ; only possible base dates in one month
1893 (or (eq month t)
1894 (if (listp month)
d56aaa64 Gerd Moellmann2001-01-24 11:48:19 +00001895 (memq m1 month)
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00001896 (= m1 month)))
1897 (let ((d (or day (if (> n 0)
1898 1
1899 (calendar-last-day-of-month m1 y1)))))
1900 (and (<= d1 d) (<= d d2))))
1901 ;; Only possible base dates straddle two months.
1902 (and (or (< y1 y2)
1903 (and (= y1 y2) (< m1 m2)))
1904 (or
1905 ;; m1, d1 works as a base date.
1906 (and
1907 (or (eq month t)
1908 (if (listp month)
d56aaa64 Gerd Moellmann2001-01-24 11:48:19 +00001909 (memq m1 month)
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00001910 (= m1 month)))
1911 (<= d1 (or day (if (> n 0)
1912 1
1913 (calendar-last-day-of-month m1 y1)))))
1914 ;; m2, d2 works as a base date.
1915 (and (or (eq month t)
1916 (if (listp month)
d56aaa64 Gerd Moellmann2001-01-24 11:48:19 +00001917 (memq m2 month)
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00001918 (= m2 month)))
1919 (<= (or day (if (> n 0)
1920 1
1921 (calendar-last-day-of-month m2 y2)))
1922 d2)))))
1923 (cons mark entry)))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001924
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00001925(defun diary-ordinal-suffix (n)
1926 "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)"
1927 (if (or (memq (% n 100) '(11 12 13))
1928 (< 3 (% n 10)))
1929 "th"
1930 (aref ["th" "st" "nd" "rd"] (% n 10))))
1931
60495716 Glenn Morris2008-03-08 23:38:06 +00001932;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
1aee45ed Stefan Monnier2005-10-06 16:22:13 +00001933(defun diary-anniversary (month day &optional year mark)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001934 "Anniversary diary entry.
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001935Entry applies if date is the anniversary of MONTH, DAY, YEAR.
1936The order of the input parameters changes according to
1937`calendar-date-style' (e.g. to DAY MONTH YEAR in the European style).
1938
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +00001939The diary entry can contain `%d' or `%d%s'; the %d will be replaced
1940by the number of years since the MONTH, DAY, YEAR, and the %s will
1941be replaced by the ordinal ending of that number (that is, `st',
1942`nd', `rd' or `th', as appropriate). The anniversary of February 29
1943is considered to be March 1 in non-leap years.
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001944
1945An optional parameter MARK specifies a face or single-character
1946string to use when highlighting the day in the calendar."
1947 (let* ((ddate (diary-make-date month day year))
e803eab7
GM
Glenn Morris2008-04-07 01:59:37 +00001948 (dd (calendar-extract-day ddate))
1949 (mm (calendar-extract-month ddate))
1950 (yy (calendar-extract-year ddate))
1951 (y (calendar-extract-year date))
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001952 (diff (if yy (- y yy) 100)))
1953 (and (= mm 2) (= dd 29) (not (calendar-leap-year-p y))
1954 (setq mm 3
1955 dd 1))
1956 (and (> diff 0) (calendar-date-equal (list mm dd y) date)
1957 (cons mark (format entry diff (diary-ordinal-suffix diff))))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001958
60495716 Glenn Morris2008-03-08 23:38:06 +00001959;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
fd4a98f0 Richard M. Stallman2002-07-22 15:32:00 +00001960(defun diary-cyclic (n month day year &optional mark)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001961 "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001962The order of the input parameters changes according to
1963`calendar-date-style' (e.g. to N DAY MONTH YEAR in the European
64ba814f Juanma Barranquero2008-11-30 01:01:18 +00001964style). The entry can contain `%d' or `%d%s'; the %d will be
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001965replaced by the number of repetitions since the MONTH DAY YEAR,
1966and %s by the ordinal ending of that number (that is, `st', `nd',
64ba814f Juanma Barranquero2008-11-30 01:01:18 +00001967`rd' or `th', as appropriate).
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001968
1969An optional parameter MARK specifies a face or single-character
1970string to use when highlighting the day in the calendar."
6f8eab73
GM
Glenn Morris2009-04-02 06:33:18 +00001971 (or (> n 0)
1972 (error "Day count must be positive"))
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00001973 (let* ((diff (- (calendar-absolute-from-gregorian date)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001974 (calendar-absolute-from-gregorian
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00001975 (diary-make-date month day year))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001976 (cycle (/ diff n)))
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00001977 (and (>= diff 0) (zerop (% diff n))
1978 (cons mark (format entry cycle (diary-ordinal-suffix cycle))))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00001979
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001980(defun diary-day-of-year ()
1981 "Day of year and number of days remaining in the year of date diary entry."
1982 (calendar-day-of-year-string date))
1983
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00001984(defun diary-remind (sexp days &optional marking)
1985 "Provide a reminder of a diary entry.
968560df
GM
Glenn Morris2008-04-23 03:06:11 +00001986SEXP is a diary-sexp. DAYS is either a single number or a list
1987of numbers indicating the number(s) of days before the event that
1988the warning(s) should occur on. A negative number -DAYS has the
1989same meaning as a list (1 2 ... DAYS). If the current date
1990is (one of) DAYS before the event indicated by SEXP, then this function
1991returns a suitable message (as specified by `diary-remind-message').
1992
1993In addition to the reminders beforehand, the diary entry also
1994appears on the date itself.
1995
1996A `diary-nonmarking-symbol' at the beginning of the line of the
1997`diary-remind' entry specifies that the diary entry (not the
1998reminder) is non-marking. Marking of reminders is independent of
1999whether the entry itself is a marking or nonmarking; if optional
2000parameter MARKING is non-nil then the reminders are marked on the
2001calendar."
a588d349 Glenn Morris2008-04-16 03:24:06 +00002002 ;; `date' has a value at this point, from diary-sexp-entry.
968560df
GM
Glenn Morris2008-04-23 03:06:11 +00002003 ;; Convert a negative number to a list of days.
2004 (and (integerp days)
2005 (< days 0)
2006 (setq days (number-sequence 1 (- days))))
a588d349 Glenn Morris2008-04-16 03:24:06 +00002007 (let ((diary-entry (eval sexp)))
17b7580f Karl Heuer1999-05-03 20:03:07 +00002008 (cond
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002009 ;; Diary entry applies on date.
17b7580f Karl Heuer1999-05-03 20:03:07 +00002010 ((and diary-entry
efe9409a Glenn Morris2008-04-06 20:53:14 +00002011 (or (not diary-marking-entries-flag) diary-marking-entry-flag))
17b7580f Karl Heuer1999-05-03 20:03:07 +00002012 diary-entry)
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002013 ;; Diary entry may apply to `days' before date.
17b7580f Karl Heuer1999-05-03 20:03:07 +00002014 ((and (integerp days)
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002015 (not diary-entry) ; diary entry does not apply to date
efe9409a Glenn Morris2008-04-06 20:53:14 +00002016 (or (not diary-marking-entries-flag) marking))
a588d349
GM
Glenn Morris2008-04-16 03:24:06 +00002017 ;; Adjust date, and re-evaluate.
2018 (let ((date (calendar-gregorian-from-absolute
2019 (+ (calendar-absolute-from-gregorian date) days))))
2020 (when (setq diary-entry (eval sexp))
2021 ;; Discard any mark portion from diary-anniversary, etc.
2022 (if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
2023 (mapconcat 'eval diary-remind-message ""))))
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002024 ;; Diary entry may apply to one of a list of days before date.
17b7580f
KH
Karl Heuer1999-05-03 20:03:07 +00002025 ((and (listp days) days)
2026 (or (diary-remind sexp (car days) marking)
2027 (diary-remind sexp (cdr days) marking))))))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002028
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +00002029
2030;;; Diary insertion functions.
a46c339d Glenn Morris2005-03-01 10:23:58 +00002031
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00002032;;;###cal-autoload
efe9409a Glenn Morris2008-04-06 20:53:14 +00002033(defun diary-make-entry (string &optional nonmarking file)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002034 "Insert a diary entry STRING which may be NONMARKING in FILE.
a46c339d Glenn Morris2005-03-01 10:23:58 +00002035If omitted, NONMARKING defaults to nil and FILE defaults to
1aee45ed Stefan Monnier2005-10-06 16:22:13 +00002036`diary-file'."
290d5b58 Dmitry Antipov2013-08-05 18:26:57 +04002037 (let ((pop-up-frames (or pop-up-frames (window-dedicated-p))))
6dd2d9b9 Glenn Morris2009-09-03 06:34:19 +00002038 (find-file-other-window (or file diary-file)))
4d985ac2 Glenn Morris2009-08-28 03:18:49 +00002039 (when (eq major-mode (default-value 'major-mode)) (diary-mode))
b8f2671f Juanma Barranquero2002-11-14 14:09:41 +00002040 (widen)
01a7778e Stefan Monnier2005-09-12 21:21:42 +00002041 (diary-unhide-everything)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002042 (goto-char (point-max))
b8f2671f
JB
Juanma Barranquero2002-11-14 14:09:41 +00002043 (when (let ((case-fold-search t))
2044 (search-backward "Local Variables:"
2045 (max (- (point-max) 3000) (point-min))
2046 t))
2047 (beginning-of-line)
2048 (insert "\n")
01a7778e Stefan Monnier2005-09-12 21:21:42 +00002049 (forward-line -1))
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00002050 (insert
2051 (if (bolp) "" "\n")
2052 (if nonmarking diary-nonmarking-symbol "")
2053 string " "))
2054
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00002055;;;###cal-autoload
10979c74 Stefan Monnier2008-06-17 15:42:19 +00002056(defun diary-insert-entry (arg &optional event)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002057 "Insert a diary entry for the date indicated by point.
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002058Prefix argument ARG makes the entry nonmarking."
10979c74
SM
Stefan Monnier2008-06-17 15:42:19 +00002059 (interactive
2060 (list current-prefix-arg last-nonmenu-event))
2061 (diary-make-entry (calendar-date-string (calendar-cursor-to-date t event) t t)
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00002062 arg))
2063
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00002064;;;###cal-autoload
efe9409a Glenn Morris2008-04-06 20:53:14 +00002065(defun diary-insert-weekly-entry (arg)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002066 "Insert a weekly diary entry for the day of the week indicated by point.
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002067Prefix argument ARG makes the entry nonmarking."
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002068 (interactive "P")
efe9409a Glenn Morris2008-04-06 20:53:14 +00002069 (diary-make-entry (calendar-day-name (calendar-cursor-to-date t))
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00002070 arg))
2071
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00002072(defun diary-date-display-form (&optional type)
64ba814f Juanma Barranquero2008-11-30 01:01:18 +00002073 "Return value for `calendar-date-display-form' using `calendar-date-style'.
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00002074Optional symbol TYPE is either `monthly' or `yearly'."
2075 (cond ((eq type 'monthly) (cond ((eq calendar-date-style 'iso)
2076 '((format "*-*-%.2d"
2077 (string-to-number day))))
2078 ((eq calendar-date-style 'european)
2079 '(day " * "))
2080 (t '("* " day ))))
2081 ((eq type 'yearly) (cond ((eq calendar-date-style 'iso)
2082 '((format "*-%.2d-%.2d"
2083 (string-to-number month)
2084 (string-to-number day))))
2085 ((eq calendar-date-style 'european)
2086 '(day " " monthname))
2087 (t '(monthname " " day))))
2088 ;; Iso cannot contain "-", because this form used eg by
31dfb76c Glenn Morris2011-05-03 19:03:30 -07002089 ;; diary-insert-anniversary-entry.
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00002090 (t (cond ((eq calendar-date-style 'iso)
2091 '((format "%s %.2d %.2d" year
2092 (string-to-number month) (string-to-number day))))
2093 ((eq calendar-date-style 'european)
2094 '(day " " month " " year))
2095 (t '(month " " day " " year))))))
2096
2097(defun diary-insert-entry-1 (&optional type nomark months symbol absfunc)
2098 "Subroutine to insert a diary entry related to the date at point.
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +00002099TYPE is the type of entry (`monthly' or `yearly'). NOMARK non-nil
2100means make the entry non-marking. Array MONTHS is used in place
2101of `calendar-month-name-array'. String SYMBOL marks the type of
2102diary entry. Function ABSFUNC converts absolute dates to dates of
2103the appropriate type."
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00002104 (let ((calendar-date-display-form (if type
2105 (diary-date-display-form type)
2106 calendar-date-display-form))
2107 (calendar-month-name-array (or months calendar-month-name-array))
2108 (date (calendar-cursor-to-date t)))
efe9409a Glenn Morris2008-04-06 20:53:14 +00002109 (diary-make-entry
cc4b5cd3
GM
Glenn Morris2008-03-29 02:44:24 +00002110 (format "%s%s" (or symbol "")
2111 (calendar-date-string
2112 (if absfunc
2113 (funcall absfunc (calendar-absolute-from-gregorian date))
2114 date)
2115 (not absfunc)
2116 (not type)))
2117 nomark)))
2118
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00002119;;;###cal-autoload
efe9409a Glenn Morris2008-04-06 20:53:14 +00002120(defun diary-insert-monthly-entry (arg)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002121 "Insert a monthly diary entry for the day of the month indicated by point.
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002122Prefix argument ARG makes the entry nonmarking."
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002123 (interactive "P")
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00002124 (diary-insert-entry-1 'monthly arg))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002125
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00002126;;;###cal-autoload
efe9409a Glenn Morris2008-04-06 20:53:14 +00002127(defun diary-insert-yearly-entry (arg)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002128 "Insert an annual diary entry for the day of the year indicated by point.
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002129Prefix argument ARG makes the entry nonmarking."
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002130 (interactive "P")
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00002131 (diary-insert-entry-1 'yearly arg))
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002132
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00002133;;;###cal-autoload
efe9409a Glenn Morris2008-04-06 20:53:14 +00002134(defun diary-insert-anniversary-entry (arg)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002135 "Insert an anniversary diary entry for the date given by point.
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002136Prefix argument ARG makes the entry nonmarking."
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002137 (interactive "P")
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00002138 (let ((calendar-date-display-form (diary-date-display-form)))
efe9409a Glenn Morris2008-04-06 20:53:14 +00002139 (diary-make-entry
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002140 (format "%s(diary-anniversary %s)"
efe9409a Glenn Morris2008-04-06 20:53:14 +00002141 diary-sexp-entry-symbol
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00002142 (calendar-date-string (calendar-cursor-to-date t) nil t))
2143 arg)))
2144
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00002145;;;###cal-autoload
efe9409a Glenn Morris2008-04-06 20:53:14 +00002146(defun diary-insert-block-entry (arg)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002147 "Insert a block diary entry for the days between the point and marked date.
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002148Prefix argument ARG makes the entry nonmarking."
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002149 (interactive "P")
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00002150 (let ((calendar-date-display-form (diary-date-display-form))
f6ca63d7
GM
Glenn Morris2008-03-13 06:40:31 +00002151 (cursor (calendar-cursor-to-date t))
2152 (mark (or (car calendar-mark-ring)
2153 (error "No mark set in this buffer")))
2154 start end)
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00002155 (if (< (calendar-absolute-from-gregorian mark)
2156 (calendar-absolute-from-gregorian cursor))
2157 (setq start mark
2158 end cursor)
2159 (setq start cursor
f6ca63d7 Glenn Morris2008-03-13 06:40:31 +00002160 end mark))
efe9409a Glenn Morris2008-04-06 20:53:14 +00002161 (diary-make-entry
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002162 (format "%s(diary-block %s %s)"
efe9409a Glenn Morris2008-04-06 20:53:14 +00002163 diary-sexp-entry-symbol
f6ca63d7
GM
Glenn Morris2008-03-13 06:40:31 +00002164 (calendar-date-string start nil t)
2165 (calendar-date-string end nil t))
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00002166 arg)))
2167
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00002168;;;###cal-autoload
efe9409a Glenn Morris2008-04-06 20:53:14 +00002169(defun diary-insert-cyclic-entry (arg)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002170 "Insert a cyclic diary entry starting at the date given by point.
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002171Prefix argument ARG makes the entry nonmarking."
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002172 (interactive "P")
cc4b5cd3 Glenn Morris2008-03-29 02:44:24 +00002173 (let ((calendar-date-display-form (diary-date-display-form)))
efe9409a Glenn Morris2008-04-06 20:53:14 +00002174 (diary-make-entry
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002175 (format "%s(diary-cyclic %d %s)"
efe9409a Glenn Morris2008-04-06 20:53:14 +00002176 diary-sexp-entry-symbol
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002177 (calendar-read "Repeat every how many days: "
86855ebd Stefan Monnier2000-04-17 10:47:01 +00002178 (lambda (x) (> x 0)))
0808d911
ER
Edward M. Reingold1995-09-21 03:11:06 +00002179 (calendar-date-string (calendar-cursor-to-date t) nil t))
2180 arg)))
2181
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002182;;; Diary mode.
2183
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +00002184(defun diary-redraw-calendar ()
2185 "If `calendar-buffer' is live and diary entries are marked, redraw it."
e803eab7 Glenn Morris2008-04-07 01:59:37 +00002186 (and calendar-mark-diary-entries-flag
26f43550 Glenn Morris2008-03-26 03:26:43 +00002187 (save-excursion
e803eab7 Glenn Morris2008-04-07 01:59:37 +00002188 (calendar-redraw)))
26f43550
GM
Glenn Morris2008-03-26 03:26:43 +00002189 ;; Return value suitable for `write-contents-functions'.
2190 nil)
2191
01a7778e
SM
Stefan Monnier2005-09-12 21:21:42 +00002192(defvar diary-mode-map
2193 (let ((map (make-sparse-keymap)))
2194 (define-key map "\C-c\C-s" 'diary-show-all-entries)
2195 (define-key map "\C-c\C-q" 'quit-window)
2196 map)
2197 "Keymap for `diary-mode'.")
2198
01a7778e Stefan Monnier2005-09-12 21:21:42 +00002199(defun diary-font-lock-sexps (limit)
55e8cf94 Glenn Morris2008-03-10 02:44:51 +00002200 "Recognize sexp diary entry up to LIMIT for font-locking."
86432f81 Markus Rost2002-11-16 19:17:20 +00002201 (if (re-search-forward
f1700e26 Glenn Morris2008-03-16 01:27:15 +00002202 (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol)
efe9409a Glenn Morris2008-04-06 20:53:14 +00002203 (regexp-quote diary-sexp-entry-symbol))
86432f81
MR
Markus Rost2002-11-16 19:17:20 +00002204 limit t)
2205 (condition-case nil
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00002206 (save-restriction
2207 (narrow-to-region (point-min) limit)
2208 (let ((start (point)))
2209 (forward-sexp 1)
2210 (store-match-data (list start (point)))
2211 t))
2212 (error t))))
86432f81 Markus Rost2002-11-16 19:17:20 +00002213
01a7778e Stefan Monnier2005-09-12 21:21:42 +00002214(defun diary-font-lock-date-forms (month-array &optional symbol abbrev-array)
ca2a5950 Glenn Morris2003-08-03 14:00:56 +00002215 "Create font-lock patterns for `diary-date-forms' using MONTH-ARRAY.
e565dd37
GM
Glenn Morris2011-05-17 20:20:13 -07002216If given, optional SYMBOL must be a prefix to entries. If
2217optional ABBREV-ARRAY is present, also matches the abbreviations
2218from this array (with or without a final `.'), in addition to the
2219full month names."
ca2a5950
GM
Glenn Morris2003-08-03 14:00:56 +00002220 (let ((dayname (diary-name-pattern calendar-day-name-array
2221 calendar-day-abbrev-array t))
2222 (monthname (format "\\(%s\\|\\*\\)"
2223 (diary-name-pattern month-array abbrev-array)))
c87a1f38
GM
Glenn Morris2003-06-22 01:02:22 +00002224 (month "\\([0-9]+\\|\\*\\)")
2225 (day "\\([0-9]+\\|\\*\\)")
2226 (year "-?\\([0-9]+\\|\\*\\)"))
01a7778e Stefan Monnier2005-09-12 21:21:42 +00002227 (mapcar (lambda (x)
f6ca63d7
GM
Glenn Morris2008-03-13 06:40:31 +00002228 (cons
2229 (concat "^" (regexp-quote diary-nonmarking-symbol) "?"
2230 (if symbol (regexp-quote symbol) "") "\\("
2231 (mapconcat 'eval
2232 ;; If backup, omit first item (backup)
2233 ;; and last item (not part of date).
2234 (if (equal (car x) 'backup)
01a7778e Stefan Monnier2005-09-12 21:21:42 +00002235 (nreverse (cdr (reverse (cdr x))))
f6ca63d7
GM
Glenn Morris2008-03-13 06:40:31 +00002236 x)
2237 "")
2238 ;; With backup, last item is not part of date.
2239 (if (equal (car x) 'backup)
2240 (concat "\\)" (eval (car (reverse x))))
2241 "\\)"))
3f659704 Glenn Morris2014-10-05 19:02:04 -07002242 '(1 'diary)))
86432f81
MR
Markus Rost2002-11-16 19:17:20 +00002243 diary-date-forms)))
2244
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00002245(defmacro diary-font-lock-keywords-1 (markfunc listfunc feature months symbol)
2246 "Subroutine of the function `diary-font-lock-keywords'.
efe9409a Glenn Morris2008-04-06 20:53:14 +00002247If MARKFUNC is a member of `diary-nongregorian-marking-hook', or
64ba814f
JB
Juanma Barranquero2008-11-30 01:01:18 +00002248LISTFUNC of `diary-nongregorian-listing-hook', then require FEATURE and
2249return a font-lock pattern matching array of MONTHS and marking SYMBOL."
efe9409a
GM
Glenn Morris2008-04-06 20:53:14 +00002250 `(when (or (memq ',markfunc diary-nongregorian-marking-hook)
2251 (memq ',listfunc diary-nongregorian-listing-hook))
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00002252 (require ',feature)
2253 (diary-font-lock-date-forms ,months ,symbol)))
2254
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002255(defconst diary-time-regexp
2256 ;; Accepted formats: 10:00 10.00 10h00 10h 10am 10:00am 10.00am
2257 ;; Use of "." as a separator annoyingly matches numbers, eg "123.45".
2258 ;; Hence often prefix this with "\\(^\\|\\s-\\)."
2259 (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
2260 "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
2261 "\\)\\([AaPp][Mm]\\)?\\)")
2262 "Regular expression matching a time of day.")
2263
c9baab11
GM
Glenn Morris2008-03-08 03:47:36 +00002264(defvar calendar-hebrew-month-name-array-leap-year)
2265(defvar calendar-islamic-month-name-array)
2266(defvar calendar-bahai-month-name-array)
f930a063 Leo Liu2014-05-05 07:49:33 +08002267(defvar calendar-chinese-month-name-array)
ca2a5950 Glenn Morris2003-08-03 14:00:56 +00002268
a53b53b3 Glenn Morris2008-03-13 05:54:57 +00002269;;;###cal-autoload
2ca695f2
GM
Glenn Morris2007-04-07 21:53:17 +00002270(defun diary-font-lock-keywords ()
2271 "Return a value for the variable `diary-font-lock-keywords'."
2272 (append
2273 (diary-font-lock-date-forms calendar-month-name-array
2274 nil calendar-month-abbrev-array)
192e3e20
GM
Glenn Morris2008-04-05 20:58:26 +00002275 (diary-font-lock-keywords-1 diary-hebrew-mark-entries
2276 diary-hebrew-list-entries
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00002277 cal-hebrew
2278 calendar-hebrew-month-name-array-leap-year
7cef0cef Glenn Morris2008-04-05 20:20:38 +00002279 diary-hebrew-entry-symbol)
26ce642a
GM
Glenn Morris2008-04-04 07:33:26 +00002280 (diary-font-lock-keywords-1 diary-islamic-mark-entries
2281 diary-islamic-list-entries
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00002282 cal-islam
2283 calendar-islamic-month-name-array
7cef0cef Glenn Morris2008-04-05 20:20:38 +00002284 diary-islamic-entry-symbol)
f1700e26
GM
Glenn Morris2008-03-16 01:27:15 +00002285 (diary-font-lock-keywords-1 diary-bahai-mark-entries
2286 diary-bahai-list-entries
2287 cal-bahai
2288 calendar-bahai-month-name-array
7cef0cef Glenn Morris2008-04-05 20:20:38 +00002289 diary-bahai-entry-symbol)
bbdcf64f
LL
Leo Liu2014-05-04 08:16:58 +08002290 (diary-font-lock-keywords-1 diary-chinese-mark-entries
2291 diary-chinese-list-entries
2292 cal-china
2293 calendar-chinese-month-name-array
2294 diary-chinese-entry-symbol)
2ca695f2
GM
Glenn Morris2007-04-07 21:53:17 +00002295 (list
2296 (cons
c9baab11 Glenn Morris2008-03-08 03:47:36 +00002297 (format "^%s.*$" (regexp-quote diary-include-string))
2ca695f2
GM
Glenn Morris2007-04-07 21:53:17 +00002298 'font-lock-keyword-face)
2299 (cons
c9baab11 Glenn Morris2008-03-08 03:47:36 +00002300 (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol)
efe9409a Glenn Morris2008-04-06 20:53:14 +00002301 (regexp-quote diary-sexp-entry-symbol))
6c27f0f8 Chong Yidong2012-09-24 19:39:33 +08002302 '(1 font-lock-constant-face))
2ca695f2 Glenn Morris2007-04-07 21:53:17 +00002303 (cons
c9baab11 Glenn Morris2008-03-08 03:47:36 +00002304 (format "^%s" (regexp-quote diary-nonmarking-symbol))
6c27f0f8 Chong Yidong2012-09-24 19:39:33 +08002305 'font-lock-constant-face)
2ca695f2 Glenn Morris2007-04-07 21:53:17 +00002306 (cons
c9baab11 Glenn Morris2008-03-08 03:47:36 +00002307 (format "^%s?%s" (regexp-quote diary-nonmarking-symbol)
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002308 (regexp-opt (mapcar 'regexp-quote
7cef0cef
GM
Glenn Morris2008-04-05 20:20:38 +00002309 (list diary-hebrew-entry-symbol
2310 diary-islamic-entry-symbol
bbdcf64f
LL
Leo Liu2014-05-04 08:16:58 +08002311 diary-bahai-entry-symbol
2312 diary-chinese-entry-symbol))
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002313 t))
6c27f0f8 Chong Yidong2012-09-24 19:39:33 +08002314 '(1 font-lock-constant-face))
2ca695f2 Glenn Morris2007-04-07 21:53:17 +00002315 '(diary-font-lock-sexps . font-lock-keyword-face)
9ad53e98
GM
Glenn Morris2011-02-03 19:23:55 -08002316 ;; Don't need to worry about space around "-" because the first
2317 ;; match takes care of that. It does mean the "-" itself may or
2318 ;; may not be fontified though.
2319 ;; diary-date-forms often include a final character that is not
2320 ;; part of the date (eg a non-digit to mark the end of the year).
2321 ;; This can use up the only space char between a date and time (b#7891).
2322 ;; Hence we use OVERRIDE, which can only override whitespace.
2323 ;; FIXME it's probably better to tighten up the diary-time-regexp
2324 ;; and drop the whitespace requirement below.
c9baab11 Glenn Morris2008-03-08 03:47:36 +00002325 `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002326 diary-time-regexp)
9ad53e98
GM
Glenn Morris2011-02-03 19:23:55 -08002327 . (0 'diary-time t)))))
2328; . 'diary-time))))
2ca695f2
GM
Glenn Morris2007-04-07 21:53:17 +00002329
2330(defvar diary-font-lock-keywords (diary-font-lock-keywords)
2331 "Forms to highlight in `diary-mode'.")
86432f81 Markus Rost2002-11-16 19:17:20 +00002332
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002333;;;###autoload
2334(define-derived-mode diary-mode fundamental-mode "Diary"
2335 "Major mode for editing the diary file."
2336 (set (make-local-variable 'font-lock-defaults)
2337 '(diary-font-lock-keywords t))
548d0a63
GM
Glenn Morris2011-05-05 21:28:53 -07002338 (set (make-local-variable 'comment-start) diary-comment-start)
2339 (set (make-local-variable 'comment-end) diary-comment-end)
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002340 (add-to-invisibility-spec '(diary . nil))
2341 (add-hook 'after-save-hook 'diary-redraw-calendar nil t)
7973bcea
SM
Stefan Monnier2011-01-10 18:31:47 -05002342 ;; In case the file was modified externally, refresh the calendar
2343 ;; after refreshing the diary buffer.
2344 (add-hook 'after-revert-hook 'diary-redraw-calendar nil t)
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002345 (if diary-header-line-flag
2346 (setq header-line-format diary-header-line-format)))
2347
2348
2349;;; Fancy Diary Mode.
2350
f330b642
GM
Glenn Morris2011-05-03 19:06:28 -07002351(defun diary-fancy-date-pattern ()
2352 "Return a regexp matching the first line of a fancy diary date header.
2353This depends on the calendar date style."
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002354 (concat
2355 (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
2356 (monthname (diary-name-pattern calendar-month-name-array nil t))
31dfb76c
GM
Glenn Morris2011-05-03 19:03:30 -07002357 (day "1")
2358 (month "2")
2359 ;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for?
2360 (year "3"))
2361 ;; This is ugly. c-d-d-form expects `day' etc to be "numbers in
2362 ;; string form"; eg the iso version calls string-to-number on some.
2363 ;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583).
2364 ;; Assumes no integers in c-day/month-name-array.
2365 (replace-regexp-in-string "[0-9]+" "[0-9]+"
2366 (mapconcat 'eval calendar-date-display-form "")
2367 nil t))
1435831f Glenn Morris2008-03-17 02:33:49 +00002368 ;; Optional ": holiday name" after the date.
f330b642
GM
Glenn Morris2011-05-03 19:06:28 -07002369 "\\(: .*\\)?"))
2370
2371(defun diary-fancy-date-matcher (limit)
2372 "Search for a fancy diary data header, up to LIMIT."
2373 ;; Any number of " other holiday name" lines, followed by "==" line.
2374 (when (re-search-forward
2375 (format "%s\\(\n +.*\\)*\n=+$" (diary-fancy-date-pattern)) limit t)
2376 (put-text-property (match-beginning 0) (match-end 0) 'font-lock-multiline t)
2377 t))
1435831f Glenn Morris2008-03-17 02:33:49 +00002378
efe9409a Glenn Morris2008-04-06 20:53:14 +00002379(defvar diary-fancy-font-lock-keywords
3f659704 Glenn Morris2014-10-05 19:02:04 -07002380 `((diary-fancy-date-matcher . 'diary)
f330b642 Glenn Morris2011-05-03 19:06:28 -07002381 ("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
6c27f0f8 Chong Yidong2012-09-24 19:39:33 +08002382 ("^.*Yahrzeit.*$" . font-lock-constant-face)
f330b642
GM
Glenn Morris2011-05-03 19:06:28 -07002383 ("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
2384 ("^Day.*omer.*$" . font-lock-builtin-face)
2385 ("^Parashat.*$" . font-lock-comment-face)
2386 (,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002387 diary-time-regexp) . 'diary-time))
2388 "Keywords to highlight in fancy diary display.")
2389
2390;; If region looks like it might start or end in the middle of a
2391;; multiline pattern, extend the region to encompass the whole pattern.
2392(defun diary-fancy-font-lock-fontify-region-function (beg end &optional verbose)
2393 "Function to use for `font-lock-fontify-region-function' in Fancy Diary.
efe9409a Glenn Morris2008-04-06 20:53:14 +00002394Needed to handle multiline keyword in `diary-fancy-font-lock-keywords'.
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002395Fontify the region between BEG and END, quietly unless VERBOSE is non-nil."
2396 (goto-char beg)
2397 (forward-line 0)
2398 (if (looking-at "=+$") (forward-line -1))
2399 (while (and (looking-at " +[^ ]")
2400 (zerop (forward-line -1))))
2401 ;; This check not essential.
f330b642 Glenn Morris2011-05-03 19:06:28 -07002402 (if (looking-at (diary-fancy-date-pattern))
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002403 (setq beg (line-beginning-position)))
2404 (goto-char end)
2405 (forward-line 0)
2406 (while (and (looking-at " +[^ ]")
2407 (zerop (forward-line 1))))
2408 (if (looking-at "=+$")
2409 (setq end (line-beginning-position 2)))
2410 (font-lock-default-fontify-region beg end verbose))
2411
abef340a Sam Steingold2011-02-01 16:22:21 -05002412(defvar diary-fancy-overriding-map (make-sparse-keymap)
b42d4989
GM
Glenn Morris2009-09-04 02:59:13 +00002413 "Keymap overriding minor-mode maps in `diary-fancy-display-mode'.")
2414
abef340a Sam Steingold2011-02-01 16:22:21 -05002415(define-derived-mode diary-fancy-display-mode special-mode
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002416 "Diary"
2417 "Major mode used while displaying diary entries using Fancy Display."
2418 (set (make-local-variable 'font-lock-defaults)
efe9409a Glenn Morris2008-04-06 20:53:14 +00002419 '(diary-fancy-font-lock-keywords
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002420 t nil nil nil
2421 (font-lock-fontify-region-function
2422 . diary-fancy-font-lock-fontify-region-function)))
b42d4989
GM
Glenn Morris2009-09-04 02:59:13 +00002423 (set (make-local-variable 'minor-mode-overriding-map-alist)
2424 (list (cons t diary-fancy-overriding-map)))
2425 (view-mode 1))
1435831f Glenn Morris2008-03-17 02:33:49 +00002426
cb7c17be
GM
Glenn Morris2004-04-30 18:50:08 +00002427;; Following code from Dave Love <fx@gnu.org>.
2428;; Import Outlook-format appointments from mail messages in Gnus or
2429;; Rmail using command `diary-from-outlook'. This, or the specialized
2430;; functions `diary-from-outlook-gnus' and `diary-from-outlook-rmail',
2431;; could be run from hooks to notice appointments automatically (in
2432;; which case they will prompt about adding to the diary). The
d01d7b8d Glenn Morris2010-11-25 19:10:16 -08002433;; message formats recognized are customizable through `diary-outlook-formats'.
cb7c17be Glenn Morris2004-04-30 18:50:08 +00002434
d01d7b8d Glenn Morris2010-11-25 19:10:16 -08002435(defun diary-from-outlook-internal (subject body &optional test-only)
cb7c17be Glenn Morris2004-04-30 18:50:08 +00002436 "Snarf a diary entry from a message assumed to be from MS Outlook.
d01d7b8d Glenn Morris2010-11-25 19:10:16 -08002437SUBJECT and BODY are strings giving the message subject and body.
cb7c17be
GM
Glenn Morris2004-04-30 18:50:08 +00002438Arg TEST-ONLY non-nil means return non-nil if and only if the
2439message contains an appointment, don't make a diary entry."
2440 (catch 'finished
2441 (let (format-string)
d01d7b8d
GM
Glenn Morris2010-11-25 19:10:16 -08002442 (dolist (fmt diary-outlook-formats)
2443 (when (eq 0 (string-match (car fmt) body))
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002444 (unless test-only
d01d7b8d Glenn Morris2010-11-25 19:10:16 -08002445 (setq format-string (cdr fmt))
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00002446 (save-excursion
2447 (save-window-excursion
efe9409a Glenn Morris2008-04-06 20:53:14 +00002448 (diary-make-entry
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00002449 (format (replace-match (if (functionp format-string)
2450 (funcall format-string body)
2451 format-string)
2452 t nil (match-string 0 body))
d01d7b8d Glenn Morris2010-11-25 19:10:16 -08002453 subject)))))
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002454 (throw 'finished t))))
cb7c17be
GM
Glenn Morris2004-04-30 18:50:08 +00002455 nil))
2456
cb7c17be
GM
Glenn Morris2004-04-30 18:50:08 +00002457(defvar gnus-article-mime-handles)
2458(defvar gnus-article-buffer)
2459
2460(autoload 'gnus-fetch-field "gnus-util")
2461(autoload 'gnus-narrow-to-body "gnus")
2462(autoload 'mm-get-part "mm-decode")
2463
3e58bf8b Glenn Morris2004-11-09 17:01:01 +00002464(defun diary-from-outlook-gnus (&optional noconfirm)
cb7c17be Glenn Morris2004-04-30 18:50:08 +00002465 "Maybe snarf diary entry from Outlook-generated message in Gnus.
3e58bf8b Glenn Morris2004-11-09 17:01:01 +00002466Unless the optional argument NOCONFIRM is non-nil (which is the case when
e6a70f09
GM
Glenn Morris2004-11-09 14:51:06 +00002467this function is called interactively), then if an entry is found the
2468user is asked to confirm its addition.
2469Add this function to `gnus-article-prepare-hook' to notice appointments
cb7c17be Glenn Morris2004-04-30 18:50:08 +00002470automatically."
e6a70f09 Glenn Morris2004-11-09 14:51:06 +00002471 (interactive "p")
cb7c17be
GM
Glenn Morris2004-04-30 18:50:08 +00002472 (with-current-buffer gnus-article-buffer
2473 (let ((subject (gnus-fetch-field "subject"))
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00002474 (body (if gnus-article-mime-handles
2475 ;; We're multipart. Don't get confused by part
2476 ;; buttons &c. Assume info is in first part.
2477 (mm-get-part (nth 1 gnus-article-mime-handles))
2478 (save-restriction
2479 (gnus-narrow-to-body)
2480 (buffer-string)))))
d01d7b8d Glenn Morris2010-11-25 19:10:16 -08002481 (when (diary-from-outlook-internal subject body t)
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002482 (when (or noconfirm (y-or-n-p "Snarf diary entry? "))
d01d7b8d Glenn Morris2010-11-25 19:10:16 -08002483 (diary-from-outlook-internal subject body)
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002484 (message "Diary entry added"))))))
cb7c17be
GM
Glenn Morris2004-04-30 18:50:08 +00002485
2486(custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus)
2487
cb7c17be
GM
Glenn Morris2004-04-30 18:50:08 +00002488(defvar rmail-buffer)
2489
3e58bf8b Glenn Morris2004-11-09 17:01:01 +00002490(defun diary-from-outlook-rmail (&optional noconfirm)
e6a70f09 Glenn Morris2004-11-09 14:51:06 +00002491 "Maybe snarf diary entry from Outlook-generated message in Rmail.
3e58bf8b Glenn Morris2004-11-09 17:01:01 +00002492Unless the optional argument NOCONFIRM is non-nil (which is the case when
e6a70f09
GM
Glenn Morris2004-11-09 14:51:06 +00002493this function is called interactively), then if an entry is found the
2494user is asked to confirm its addition."
2495 (interactive "p")
d01d7b8d
GM
Glenn Morris2010-11-25 19:10:16 -08002496 ;; FIXME maybe the body needs rmail-mm decoding, in which case
2497 ;; there is no single buffer with both body and subject, sigh.
cb7c17be
GM
Glenn Morris2004-04-30 18:50:08 +00002498 (with-current-buffer rmail-buffer
2499 (let ((subject (mail-fetch-field "subject"))
71ea27ee
GM
Glenn Morris2008-03-13 06:29:28 +00002500 (body (buffer-substring (save-excursion
2501 (rfc822-goto-eoh)
2502 (point))
2503 (point-max))))
d01d7b8d Glenn Morris2010-11-25 19:10:16 -08002504 (when (diary-from-outlook-internal subject body t)
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002505 (when (or noconfirm (y-or-n-p "Snarf diary entry? "))
d01d7b8d Glenn Morris2010-11-25 19:10:16 -08002506 (diary-from-outlook-internal subject body)
71ea27ee Glenn Morris2008-03-13 06:29:28 +00002507 (message "Diary entry added"))))))
cb7c17be Glenn Morris2004-04-30 18:50:08 +00002508
fd3a9a6b
GM
Glenn Morris2013-05-04 16:55:57 -07002509(defvar diary-from-outlook-function nil
2510 "If non-nil, a function of one argument for `diary-from-outlook' to call.
2511If the current buffer contains an Outlook-style appointment message,
2512this function should extract it into a diary entry. If the argument is
2513nil, it should ask for confirmation before adding this entry to the diary.
2514For examples, see `diary-from-outlook-rmail' and `diary-from-outlook-gnus'.")
2515
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002516(defun diary-from-outlook (&optional noconfirm)
2517 "Maybe snarf diary entry from current Outlook-generated message.
fd3a9a6b
GM
Glenn Morris2013-05-04 16:55:57 -07002518Uses `diary-from-outlook-function' if that is non-nil, else
2519`diary-from-outlook-rmail' for Rmail or `diary-from-outlook-gnus' for Gnus.
2520Unless the optional argument NOCONFIRM is non-nil (which is the
2521case when this function is called interactively), then if an
2522entry is found the user is asked to confirm its addition."
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002523 (interactive "p")
2524 (let ((func (cond
fd3a9a6b Glenn Morris2013-05-04 16:55:57 -07002525 (diary-from-outlook-function)
1435831f
GM
Glenn Morris2008-03-17 02:33:49 +00002526 ((eq major-mode 'rmail-mode)
2527 #'diary-from-outlook-rmail)
2528 ((memq major-mode '(gnus-summary-mode gnus-article-mode))
2529 #'diary-from-outlook-gnus)
2530 (t (error "Don't know how to snarf in `%s'" major-mode)))))
2531 (funcall func noconfirm)))
cb7c17be Glenn Morris2004-04-30 18:50:08 +00002532
e4ca7ef9 Richard M. Stallman1995-11-25 05:39:20 +00002533(provide 'diary-lib)
0808d911 Edward M. Reingold1995-09-21 03:11:06 +00002534
6818b449
GM
Glenn Morris2012-02-17 22:08:15 -05002535;; Local Variables:
2536;; coding: utf-8
2537;; End:
2538
e4ca7ef9 Richard M. Stallman1995-11-25 05:39:20 +00002539;;; diary-lib.el ends here