Update copyright notices for 2013.
[bpt/emacs.git] / lisp / calendar / appt.el
CommitLineData
55535639 1;;; appt.el --- appointment notification functions
c0274f38 2
ab422c4d
PE
3;; Copyright (C) 1989-1990, 1994, 1998, 2001-2013 Free Software
4;; Foundation, Inc.
3a801d0c 5
e5167999 6;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
aff88519 7;; Maintainer: Glenn Morris <rgm@gnu.org>
e5167999 8;; Keywords: calendar
bd78fa1d 9;; Package: calendar
e5167999 10
902a0e3c
JB
11;; This file is part of GNU Emacs.
12
2ed66575 13;; GNU Emacs is free software: you can redistribute it and/or modify
902a0e3c 14;; it under the terms of the GNU General Public License as published by
2ed66575
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
902a0e3c
JB
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
2ed66575 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
902a0e3c 25
e5167999
ER
26;;; Commentary:
27
902a0e3c
JB
28;;
29;; appt.el - visible and/or audible notification of
8d638c1b 30;; appointments from diary file.
902a0e3c 31;;
e1422141
SM
32;;
33;; Thanks to Edward M. Reingold for much help and many suggestions,
34;; And to many others for bug fixes and suggestions.
35;;
36;;
37;; This functions in this file will alert the user of a
38;; pending appointment based on his/her diary file. This package
39;; is documented in the Emacs manual.
40;;
41;; To activate this package, simply use (appt-activate 1).
42;; A `diary-file' with appointments of the format described in the
43;; documentation of the function `appt-check' is required.
44;; Relevant customizable variables are also listed in the
45;; documentation of that function.
46;;
47;; Today's appointment list is initialized from the diary when this
12b2a018 48;; package is activated. Additionally, the appointments list is
e1422141 49;; recreated automatically at 12:01am for those who do not logout
12b2a018 50;; every day or are programming late. It is also updated when the
08151ec5
GM
51;; `diary-file' (or a file it includes) is saved. Calling
52;; `appt-check' with an argument (or re-enabling the package) forces a
53;; re-initialization at any time.
e1422141
SM
54;;
55;; In order to add or delete items from today's list, without
56;; changing the diary file, use `appt-add' and `appt-delete'.
57;;
58
59;; Brief internal description - Skip this if you are not interested!
60;;
61;; The function `appt-make-list' creates the appointments list which
62;; `appt-check' reads.
63;;
64;; You can change the way the appointment window is created/deleted by
3952e9d8
GM
65;; setting the variables `appt-disp-window-function' and
66;; `appt-delete-window-function'. For instance, you could be set them
67;; to functions that display appointments in pop-up frames, which are
68;; lowered or iconified after `appt-display-interval' minutes.
e1422141 69;;
e5167999
ER
70
71;;; Code:
72
467f174b 73(require 'diary-lib)
6afadb57 74
d589fa52
GM
75
76(defgroup appt nil
77 "Appointment notification."
467f174b 78 :prefix "appt-"
d589fa52
GM
79 :group 'calendar)
80
8db540c5 81(defcustom appt-message-warning-time 12
3952e9d8
GM
82 "Default time in minutes before an appointment that the warning begins.
83You probably want to make `appt-display-interval' a factor of this."
8db540c5
RS
84 :type 'integer
85 :group 'appt)
902a0e3c 86
5006e634
GM
87(defcustom appt-warning-time-regexp "warntime \\([0-9]+\\)"
88 "Regexp matching a string giving the warning time for an appointment.
89The first subexpression matches the time in minutes (an integer).
90This overrides the default `appt-message-warning-time'.
91You may want to put this inside a diary comment (see `diary-comment-start').
92For example, to be warned 30 minutes in advance of an appointment:
93 2011/06/01 12:00 Do something ## warntime 30
94"
95 :version "24.1"
96 :type 'regexp
97 :group 'appt)
98
8db540c5 99(defcustom appt-audible t
40f79f5b 100 "Non-nil means beep to indicate appointment."
8db540c5
RS
101 :type 'boolean
102 :group 'appt)
902a0e3c 103
8d638c1b 104;; TODO - add popup.
3536dea8 105(defcustom appt-display-format 'window
8d638c1b
GM
106 "How appointment reminders should be displayed.
107The options are:
108 window - use a separate window
109 echo - use the echo area
110 nil - no visible reminder.
3536dea8 111See also `appt-audible' and `appt-display-mode-line'."
8d638c1b
GM
112 :type '(choice
113 (const :tag "Separate window" window)
114 (const :tag "Echo-area" echo)
3536dea8 115 (const :tag "No visible display" nil))
8d638c1b 116 :group 'appt
3536dea8 117 :version "24.1") ; no longer inherit from deleted obsolete variables
8d638c1b 118
8d638c1b 119(defcustom appt-display-mode-line t
40f79f5b 120 "Non-nil means display minutes to appointment and time on the mode line.
3952e9d8 121This is in addition to any other display of appointment messages.
7edd2093 122The mode line updates every minute, independent of the value of
3952e9d8 123`appt-display-interval'."
8db540c5
RS
124 :type 'boolean
125 :group 'appt)
902a0e3c 126
8db540c5 127(defcustom appt-display-duration 10
40f79f5b 128 "The number of seconds an appointment message is displayed.
8d638c1b 129Only relevant if reminders are to be displayed in their own window."
8db540c5
RS
130 :type 'integer
131 :group 'appt)
902a0e3c 132
8db540c5 133(defcustom appt-display-diary t
40f79f5b 134 "Non-nil displays the diary when the appointment list is first initialized.
3952e9d8
GM
135This occurs when this package is first activated, and then at
136midnight when the appointment list updates."
8db540c5
RS
137 :type 'boolean
138 :group 'appt)
902a0e3c 139
8db540c5 140(defcustom appt-display-interval 3
3952e9d8
GM
141 "Interval in minutes at which to display appointment reminders.
142Once an appointment becomes due, Emacs displays reminders every
143`appt-display-interval' minutes. You probably want to make
144`appt-message-warning-time' be a multiple of this, so that you get
145a final message displayed precisely when the appointment is due.
146
147Note that this variable controls the interval at which
148`appt-display-message' is called. The mode line display (if active)
149always updates every minute."
8db540c5
RS
150 :type 'integer
151 :group 'appt)
a1506d29 152
8d638c1b
GM
153(defcustom appt-disp-window-function 'appt-disp-window
154 "Function called to display appointment window.
ce5b3019
GM
155Only relevant if reminders are being displayed in a window.
156It should take three string arguments: the number of minutes till
0a2bb1a9
GM
157the appointment, the current time, and the text of the appointment.
158Each argument may also be a list, if multiple appointments are
159relevant at any one time."
3952e9d8 160 :type 'function
8d638c1b
GM
161 :group 'appt)
162
163(defcustom appt-delete-window-function 'appt-delete-window
164 "Function called to remove appointment window and buffer.
165Only relevant if reminders are being displayed in a window."
3952e9d8 166 :type 'function
8d638c1b
GM
167 :group 'appt)
168
169
170;;; Internal variables below this point.
171
e1422141 172(defconst appt-buffer-name "*appt-buf*"
5b586155 173 "Name of the appointments buffer.")
a1506d29 174
d7cd4abb
GM
175;; TODO Turn this into an alist? It would be easier to add more
176;; optional elements.
4accbca6
GM
177;; Why is the first element (MINUTES) rather than just MINUTES?
178;; It may just inherit from diary-entries-list, where we have
179;; ((MONTH DAY YEAR) ENTRY)
8d638c1b
GM
180(defvar appt-time-msg-list nil
181 "The list of appointments for today.
182Use `appt-add' and `appt-delete' to add and delete appointments.
183The original list is generated from today's `diary-entries-list', and
184can be regenerated using the function `appt-check'.
d7cd4abb 185Each element of the generated list has the form
4accbca6 186\((MINUTES) STRING [FLAG] [WARNTIME])
d7cd4abb
GM
187where MINUTES is the time in minutes of the appointment after midnight,
188and STRING is the description of the appointment.
915d1300
GM
189FLAG and WARNTIME are not always present. A non-nil FLAG
190indicates that the element was made with `appt-add', so calling
191`appt-make-list' again should preserve it. If WARNTIME is non-nil,
192it is an integer to use in place of `appt-message-warning-time'.")
a1506d29 193
0cb7f2c0 194(defconst appt-max-time (1- (* 24 60))
8d638c1b 195 "11:59pm in minutes - number of minutes in a day minus 1.")
b570e652 196
efa434d9 197(defvar appt-mode-string nil
f3e7c0dc 198 "String being displayed in the mode line saying you have an appointment.
8d638c1b
GM
199The actual string includes the amount of time till the appointment.
200Only used if `appt-display-mode-line' is non-nil.")
464e8258 201(put 'appt-mode-string 'risky-local-variable t) ; for 'face property
f3e7c0dc
KH
202
203(defvar appt-prev-comp-time nil
3952e9d8 204 "Time of day (mins since midnight) at which we last checked appointments.")
f3e7c0dc 205
3952e9d8 206(defvar appt-display-count 0
8d638c1b 207 "Internal variable used to count number of consecutive reminders.")
efa434d9 208
8d638c1b
GM
209(defvar appt-timer nil
210 "Timer used for diary appointment notifications (`appt-check').
211If this is non-nil, appointment checking is active.")
212
213
214;;; Functions.
215
216(defun appt-display-message (string mins)
217 "Display a reminder about an appointment.
218The string STRING describes the appointment, due in integer MINS minutes.
35d7dbd3
GM
219The arguments may also be lists, where each element relates to a
220separate appointment. The variable `appt-display-format' controls
221the format of the visible reminder. If `appt-audible' is non-nil,
222also calls `beep' for an audible reminder."
3536dea8 223 (if appt-audible (beep 1))
35d7dbd3
GM
224 ;; Backwards compatibility: avoid passing lists to a-d-w-f if not necessary.
225 (and (listp mins)
226 (= (length mins) 1)
227 (setq mins (car mins)
228 string (car string)))
3536dea8 229 (cond ((eq appt-display-format 'window)
35d7dbd3
GM
230 ;; TODO use calendar-month-abbrev-array rather than %b?
231 (let ((time (format-time-string "%a %b %e " (current-time)))
232 err)
233 (condition-case err
234 (funcall appt-disp-window-function
235 (if (listp mins)
236 (mapcar 'number-to-string mins)
237 (number-to-string mins))
238 time string)
239 (wrong-type-argument
240 (if (not (listp mins))
241 (signal (car err) (cdr err))
242 (message "Argtype error in `appt-disp-window-function' - \
243update it for multiple appts?")
244 ;; Fallback to just displaying the first appt, as we used to.
245 (funcall appt-disp-window-function
246 (number-to-string (car mins)) time
247 (car string))))))
3536dea8
GM
248 (run-at-time (format "%d sec" appt-display-duration)
249 nil
250 appt-delete-window-function))
251 ((eq appt-display-format 'echo)
35d7dbd3
GM
252 (message "%s" (if (listp string)
253 (mapconcat 'identity string "\n")
254 string)))))
8d638c1b 255
80675c21
GM
256(defun appt-mode-line (min-to-app &optional abbrev)
257 "Return an appointment string suitable for use in the mode-line.
258MIN-TO-APP is a list of minutes, as strings.
259If ABBREV is non-nil, abbreviates some text."
260 ;; All this silliness is just to make the formatting slightly nicer.
261 (let* ((multiple (> (length min-to-app) 1))
5b4d6e0e
GM
262 (imin (if (or (not multiple)
263 (not (delete (car min-to-app) min-to-app)))
264 (car min-to-app))))
80675c21
GM
265 (format "%s%s %s"
266 (if abbrev "App't" "Appointment")
267 (if multiple "s" "")
268 (if (equal imin "0") "now"
269 (format "in %s %s"
270 (or imin (mapconcat 'identity min-to-app ","))
271 (if abbrev "min."
272 (format "minute%s" (if (equal imin "1") "" "s"))))))))
8d638c1b
GM
273
274(defun appt-check (&optional force)
275 "Check for an appointment and update any reminder display.
276If optional argument FORCE is non-nil, reparse the diary file for
277appointments. Otherwise the diary file is only parsed once per day,
08151ec5 278or when it (or a file it includes) is saved.
902a0e3c 279
8d638c1b
GM
280Note: the time must be the first thing in the line in the diary
281for a warning to be issued. The format of the time can be either
28224 hour or am/pm. For example:
902a0e3c 283
8d638c1b
GM
284 02/23/89
285 18:00 Dinner
a1506d29 286
902a0e3c
JB
287 Thursday
288 11:45am Lunch meeting.
289
f3e7c0dc
KH
290Appointments are checked every `appt-display-interval' minutes.
291The following variables control appointment notification:
902a0e3c 292
8d638c1b
GM
293`appt-display-format'
294 Controls the format in which reminders are displayed.
902a0e3c 295
efa434d9 296`appt-audible'
3952e9d8 297 Non-nil means there is an audible component to reminders.
902a0e3c 298
8d638c1b 299`appt-message-warning-time'
3952e9d8
GM
300 The default number of minutes in advance at which reminders
301 should start.
8d638c1b
GM
302
303`appt-display-mode-line'
3952e9d8
GM
304 Non-nil means show in the mode line a countdown to the
305 time of each appointment, once reminders start.
8d638c1b
GM
306
307`appt-display-interval'
3952e9d8 308 Interval in minutes at which to display appointment messages.
902a0e3c 309
8d638c1b 310`appt-display-diary'
3952e9d8
GM
311 Non-nil means display the diary whenever the appointment list is
312 initialized (e.g. the first time we check for appointments each day).
8d638c1b
GM
313
314The following variables are only relevant if reminders are being
315displayed in a window:
902a0e3c 316
efa434d9 317`appt-display-duration'
3952e9d8 318 Number of seconds for which an appointment message is displayed.
b570e652 319
f3e7c0dc 320`appt-disp-window-function'
debf91fd 321 Function called to display appointment window.
a1506d29 322
f3e7c0dc 323`appt-delete-window-function'
debf91fd 324 Function called to remove appointment window and buffer."
ce5b3019 325 (interactive "P") ; so people can force updates
0a2bb1a9 326 (let* ((prev-appt-mode-string appt-mode-string)
3952e9d8 327 (prev-appt-display-count appt-display-count)
0de12c52
IK
328 ;; Convert current time to minutes after midnight (12.01am = 1).
329 (now (decode-time))
330 (now-mins (+ (* 60 (nth 2 now)) (nth 1 now)))
0a2bb1a9 331 appt-mins appt-warn-time min-to-app min-list string-list)
98dc3df3 332 (save-excursion ; FIXME ?
98dc3df3
GM
333 ;; At first check in any day, update appointments to today's list.
334 (if (or force ; eg initialize, diary save
335 (null appt-prev-comp-time) ; first check
4691905a 336 (< now-mins appt-prev-comp-time)) ; new day
98dc3df3
GM
337 (ignore-errors
338 (let ((diary-hook (if (assoc 'appt-make-list diary-hook)
339 diary-hook
340 (cons 'appt-make-list diary-hook))))
341 (if appt-display-diary
342 (diary)
343 ;; Not displaying the diary, so we can ignore
344 ;; diary-number-of-entries. Since appt.el only
345 ;; works on a daily basis, no need for more entries.
346 (diary-list-entries (calendar-current-date) 1 t)))))
3952e9d8
GM
347 ;; Reset everything now in case we somehow missed a minute,
348 ;; or (more likely) an appt was deleted. (This is the only
349 ;; reason we need prev-appt-display-count.)
4691905a 350 (setq appt-prev-comp-time now-mins
98dc3df3 351 appt-mode-string nil
3952e9d8 352 appt-display-count 0)
0a2bb1a9
GM
353 ;; If there are entries in the list get each time off of the
354 ;; list and calculate the number of minutes until the appointment.
355 ;; TODO we are looping over all the appointments each time.
356 ;; We could instead sort them by the time at which we need to
357 ;; start warning. But then removing entries in the past becomes
358 ;; less straightforward.
359 (dolist (appt appt-time-msg-list)
360 ;; Remove any entries that are in the past.
361 ;; FIXME how can there be any such entries, given that this
362 ;; function removes entries when they hit zero minutes,
363 ;; and appt-make-list doesn't add any in the past in the first place?
364 (if (< (setq appt-mins (caar appt)) now-mins)
365 (setq appt-time-msg-list (cdr appt-time-msg-list))
366 (setq appt-warn-time (or (nth 3 appt) appt-message-warning-time)
367 min-to-app (- appt-mins now-mins))
368 ;; If we have an appointment between midnight and
369 ;; `appt-warn-time' minutes after midnight, we
370 ;; must begin to issue a message before midnight. Midnight
371 ;; is considered 0 minutes and 11:59pm is 1439
372 ;; minutes. Therefore we must recalculate the minutes to
373 ;; appointment variable. It is equal to the number of
374 ;; minutes before midnight plus the number of minutes after
375 ;; midnight our appointment is.
376 ;; FIXME but appt-make-list constructs appt-time-msg-list to only
377 ;; contain entries with today's date, so this cannot work?
378 ;; Also above we just removed anything with appt-mins < now-mins.
379 (if (and (< appt-mins appt-warn-time)
380 (> (+ now-mins appt-warn-time) appt-max-time))
381 (setq min-to-app (+ (- (1+ appt-max-time) now-mins)
382 appt-mins)))
383 ;; Issue warning if the appointment time is within the warning time.
384 (when (and (<= min-to-app appt-warn-time)
385 (>= min-to-app 0))
386 (push min-to-app min-list)
387 (push (cadr appt) string-list)
388 ;; When an appointment is reached, delete it from the list.
389 (if (zerop min-to-app)
390 (setq appt-time-msg-list (delete appt appt-time-msg-list))))))
391 (when min-list
392 (setq min-list (nreverse min-list)
393 string-list (nreverse string-list))
394 ;; This is true every appt-display-interval minutes from the
395 ;; time at which we first started reminding.
396 ;; TODO in the case of multiple appointments, whose interval
397 ;; should we respect? The first one that we started warning about?
398 ;; That's what we do now, and this makes sense if you interpret
399 ;; a-d-i as "don't remind me any more frequently than this".
400 ;; But should we always show a message when a new appt becomes due?
401 ;; When one appt gets removed, should we switch to the interval
402 ;; of the next?
403 (and (zerop (mod prev-appt-display-count appt-display-interval))
404 (appt-display-message string-list min-list))
405 (when appt-display-mode-line
406 (setq appt-mode-string
407 (concat " " (propertize
408 (appt-mode-line (mapcar 'number-to-string
409 min-list) t)
410 'face 'mode-line-emphasis))))
411 ;; Reset count to 0 in case we display another appt on the next cycle.
412 (setq appt-display-count (if (eq '(0) min-list) 0
413 (1+ prev-appt-display-count))))
98dc3df3
GM
414 ;; If we have changed the mode line string, redisplay all mode lines.
415 (and appt-display-mode-line
4691905a 416 (not (string-equal appt-mode-string prev-appt-mode-string))
98dc3df3
GM
417 (progn
418 (force-mode-line-update t)
419 ;; If the string now has a notification, redisplay right now.
420 (if appt-mode-string
421 (sit-for 0)))))))
902a0e3c 422
902a0e3c 423(defun appt-disp-window (min-to-app new-time appt-msg)
754c5007 424 "Display appointment due in MIN-TO-APP (a string) minutes.
35d7dbd3
GM
425NEW-TIME is a string giving the current date.
426Displays the appointment message APPT-MSG in a separate buffer.
427The arguments may also be lists, where each element relates to a
428separate appointment."
8d638c1b 429 (let ((this-window (selected-window))
bc5777c1
MR
430 (appt-disp-buf (get-buffer-create appt-buffer-name)))
431 ;; Make sure we're not in the minibuffer before splitting the window.
432 ;; FIXME this seems needlessly complicated?
433 (when (minibufferp)
434 (other-window 1)
435 (and (minibufferp) (display-multi-frame-p) (other-frame 1)))
d5b22d88 436 (if (cdr (assq 'unsplittable (frame-parameters)))
debf91fd 437 ;; In an unsplittable frame, use something somewhere else.
0836e2c3
MR
438 (progn
439 (set-buffer appt-disp-buf)
440 (display-buffer appt-disp-buf))
058961dd 441 (unless (or (special-display-p (buffer-name appt-disp-buf))
debf91fd
GM
442 (same-window-p (buffer-name appt-disp-buf)))
443 ;; By default, split the bottom window and use the lower part.
444 (appt-select-lowest-window)
a291c1b7
GM
445 ;; Split the window, unless it's too small to do so.
446 (when (>= (window-height) (* 2 window-min-height))
447 (select-window (split-window))))
3b316424 448 (switch-to-buffer appt-disp-buf))
35d7dbd3
GM
449 (or (listp min-to-app)
450 (setq min-to-app (list min-to-app)
451 appt-msg (list appt-msg)))
452 ;; I don't really see the point of the new-time argument.
453 ;; It repeatedly reminds you of the date?
454 ;; It would make more sense if it was eg the time of the appointment.
455 ;; Let's allow it to be a list or not independent of the other elements.
456 (or (listp new-time)
457 (setq new-time (list new-time)))
80675c21
GM
458 ;; FIXME Link to diary entry?
459 (calendar-set-mode-line
460 (format " %s. %s" (appt-mode-line min-to-app)
461 (mapconcat 'identity new-time ", ")))
462 (setq buffer-read-only nil
463 buffer-undo-list t)
464 (erase-buffer)
465 ;; If we have appointments at different times, prepend the times.
466 (if (or (= 1 (length min-to-app))
467 (not (delete (car min-to-app) min-to-app)))
468 (insert (mapconcat 'identity appt-msg "\n"))
469 (dotimes (i (length appt-msg))
470 (insert (format "%s%sm: %s" (if (> i 0) "\n" "")
471 (nth i min-to-app) (nth i appt-msg)))))
d5b22d88 472 (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
5b586155 473 (set-buffer-modified-p nil)
ce5b3019 474 (setq buffer-read-only t)
725ec4bc 475 (raise-frame (selected-frame))
8d638c1b 476 (select-window this-window)))
a1506d29 477
5b586155
RS
478(defun appt-delete-window ()
479 "Function called to undisplay appointment messages.
480Usually just deletes the appointment buffer."
95cdbff5
RS
481 (let ((window (get-buffer-window appt-buffer-name t)))
482 (and window
debf91fd
GM
483 (or (eq window (frame-root-window (window-frame window)))
484 (delete-window window))))
5b586155
RS
485 (kill-buffer appt-buffer-name)
486 (if appt-audible
487 (beep 1)))
902a0e3c 488
902a0e3c 489(defun appt-select-lowest-window ()
debf91fd 490 "Select the lowest window on the frame."
7c0d9b89 491 (let ((lowest-window (selected-window))
debf91fd 492 (bottom-edge (nth 3 (window-edges)))
ce5b3019 493 next-bottom-edge)
7c0d9b89 494 (walk-windows (lambda (w)
debf91fd
GM
495 (when (< bottom-edge (setq next-bottom-edge
496 (nth 3 (window-edges w))))
497 (setq bottom-edge next-bottom-edge
498 lowest-window w))) 'nomini)
7c0d9b89 499 (select-window lowest-window)))
902a0e3c 500
0cb7f2c0
SM
501(defconst appt-time-regexp
502 "[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?")
503
f3e7c0dc 504;;;###autoload
d7cd4abb
GM
505(defun appt-add (time msg &optional warntime)
506 "Add an appointment for today at TIME with message MSG.
507The time should be in either 24 hour format or am/pm format.
508Optional argument WARNTIME is an integer (or string) giving the number
509of minutes before the appointment at which to start warning.
510The default is `appt-message-warning-time'."
5158face 511 (interactive "sTime (hh:mm[am/pm]): \nsMessage: \n\
d7cd4abb
GM
512sMinutes before the appointment to start warning: ")
513 (unless (string-match appt-time-regexp time)
902a0e3c 514 (error "Unacceptable time-string"))
d7cd4abb
GM
515 (and (stringp warntime)
516 (setq warntime (unless (string-equal warntime "")
517 (string-to-number warntime))))
518 (and warntime
519 (not (integerp warntime))
520 (error "Argument WARNTIME must be an integer, or nil"))
b4593555 521 (or appt-timer (appt-activate))
d7cd4abb
GM
522 (let ((time-msg (list (list (appt-convert-time time))
523 (concat time " " msg) t)))
c80e3b4a 524 ;; It is presently nonsensical to have multiple warnings about
d7cd4abb
GM
525 ;; the same appointment with just different delays, but it might
526 ;; not always be so. TODO
527 (if warntime (setq time-msg (append time-msg (list warntime))))
74139994
RW
528 (unless (member time-msg appt-time-msg-list)
529 (setq appt-time-msg-list
530 (appt-sort-list (nconc appt-time-msg-list (list time-msg)))))))
902a0e3c
JB
531
532(defun appt-delete ()
533 "Delete an appointment from the list of appointments."
534 (interactive)
8d638c1b 535 (let ((tmp-msg-list appt-time-msg-list))
ce5b3019
GM
536 (dolist (element tmp-msg-list)
537 (if (y-or-n-p (concat "Delete "
538 ;; We want to quote any doublequotes in the
539 ;; string, as well as put doublequotes around it.
540 (prin1-to-string
541 (substring-no-properties (cadr element) 0))
542 " from list? "))
543 (setq appt-time-msg-list (delq element appt-time-msg-list)))))
544 (appt-check)
545 (message ""))
a1506d29 546
902a0e3c 547
11361a8b
SM
548(defvar number)
549(defvar original-date)
550(defvar diary-entries-list)
3536dea8 551
902a0e3c 552(defun appt-make-list ()
5fac723a 553 "Update the appointments list from today's diary buffer.
d073fa5b 554The time must be at the beginning of a line for it to be
8d638c1b
GM
555put in the appointments list (see examples in documentation of
556the function `appt-check'). We assume that the variables DATE and
59b79385 557NUMBER hold the arguments that `diary-list-entries' received.
5fac723a
RS
558They specify the range of dates that the diary is being processed for.
559
3536dea8
GM
560Any appointments made with `appt-add' are not affected by this function."
561 ;; We have something to do if the range of dates that the diary is
562 ;; considering includes the current date.
563 (if (and (not (calendar-date-compare
564 (list (calendar-current-date))
565 (list original-date)))
566 (calendar-date-compare
567 (list (calendar-current-date))
568 (list (calendar-gregorian-from-absolute
569 (+ (calendar-absolute-from-gregorian original-date)
570 number)))))
571 (save-excursion
572 ;; Clear the appointments list, then fill it in from the diary.
573 (dolist (elt appt-time-msg-list)
574 ;; Delete any entries that were not made with appt-add.
575 (unless (nth 2 elt)
576 (setq appt-time-msg-list
577 (delq elt appt-time-msg-list))))
578 (if diary-entries-list
579 ;; Cycle through the entry-list (diary-entries-list)
580 ;; looking for entries beginning with a time. If the
581 ;; entry begins with a time, add it to the
582 ;; appt-time-msg-list. Then sort the list.
583 (let ((entry-list diary-entries-list)
5006e634 584 time-string literal)
3536dea8
GM
585 ;; Below, we assume diary-entries-list was in date
586 ;; order. It is, unless something on
587 ;; diary-list-entries-hook has changed it, eg
588 ;; diary-include-other-files (bug#7019). It must be
589 ;; in date order if number = 1.
590 (and diary-list-entries-hook
591 appt-display-diary
592 (not (eq diary-number-of-entries 1))
593 (not (memq (car (last diary-list-entries-hook))
594 '(diary-sort-entries sort-diary-entries)))
595 (setq entry-list (sort entry-list 'diary-entry-compare)))
596 ;; Skip diary entries for dates before today.
597 (while (and entry-list
598 (calendar-date-compare
599 (car entry-list) (list (calendar-current-date))))
600 (setq entry-list (cdr entry-list)))
601 ;; Parse the entries for today.
602 (while (and entry-list
603 (calendar-date-equal
604 (calendar-current-date) (caar entry-list)))
5006e634
GM
605 (setq time-string (cadr (car entry-list))
606 ;; Including any comments.
607 literal (or (nth 2 (nth 3 (car entry-list)))
608 time-string))
3536dea8
GM
609 (while (string-match appt-time-regexp time-string)
610 (let* ((beg (match-beginning 0))
611 ;; Get just the time for this appointment.
612 (only-time (match-string 0 time-string))
613 ;; Find the end of this appointment
614 ;; (the start of the next).
615 (end (string-match
616 (concat "\n[ \t]*" appt-time-regexp)
617 time-string
618 (match-end 0)))
5006e634
GM
619 (warntime
620 (if (string-match appt-warning-time-regexp literal)
621 (string-to-number (match-string 1 literal))))
3536dea8
GM
622 ;; Get the whole string for this appointment.
623 (appt-time-string
624 (substring time-string beg end))
4accbca6
GM
625 ;; FIXME why the list? It makes the first
626 ;; element (MINUTES) rather than MINUTES.
3536dea8 627 (appt-time (list (appt-convert-time only-time)))
5006e634
GM
628 (time-msg (append
629 (list appt-time appt-time-string)
630 (if warntime (list nil warntime)))))
3536dea8
GM
631 ;; Add this appointment to appt-time-msg-list.
632 (setq appt-time-msg-list
633 (nconc appt-time-msg-list (list time-msg))
634 ;; Discard this appointment from the string.
5006e634 635 ;; (This allows for multiple appts per entry.)
3536dea8 636 time-string
5006e634
GM
637 (if end (substring time-string end) ""))
638 ;; Similarly, discard the start of literal.
639 (and (> (length time-string) 0)
640 (string-match appt-time-regexp literal)
641 (setq end (string-match
642 (concat "\n[ \t]*" appt-time-regexp)
643 literal (match-end 0)))
644 (setq literal (substring literal end)))))
3536dea8
GM
645 (setq entry-list (cdr entry-list)))))
646 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
647 ;; Convert current time to minutes after midnight (12:01am = 1),
5233edd7 648 ;; and remove elements in the list that are in the past.
3536dea8 649 (let* ((now (decode-time))
5233edd7
GM
650 (now-mins (+ (* 60 (nth 2 now)) (nth 1 now))))
651 (while (and appt-time-msg-list
652 (< (caar (car appt-time-msg-list)) now-mins))
653 (setq appt-time-msg-list (cdr appt-time-msg-list)))))))
a1506d29 654
902a0e3c 655
902a0e3c 656(defun appt-sort-list (appt-list)
8d638c1b
GM
657 "Sort an appointment list, putting earlier items at the front.
658APPT-LIST is a list of the same format as `appt-time-msg-list'."
11361a8b 659 (sort appt-list (lambda (e1 e2) (< (caar e1) (caar e2)))))
902a0e3c
JB
660
661
662(defun appt-convert-time (time2conv)
754c5007 663 "Convert hour:min[am/pm] format TIME2CONV to minutes from midnight.
8d638c1b
GM
664A period (.) can be used instead of a colon (:) to separate the
665hour and minute parts."
0cb7f2c0
SM
666 ;; Formats that should be accepted:
667 ;; 10:00 10.00 10h00 10h 10am 10:00am 10.00am
668 (let ((min (if (string-match "[h:.]\\([0-9][0-9]\\)" time2conv)
669 (string-to-number (match-string 1 time2conv))
670 0))
671 (hr (if (string-match "[0-9]*[0-9]" time2conv)
672 (string-to-number (match-string 0 time2conv))
673 0)))
cb17eeae 674 ;; Convert the time appointment time into 24 hour time.
85bbde63 675 (cond ((and (string-match "pm" time2conv) (< hr 12))
debf91fd
GM
676 (setq hr (+ 12 hr)))
677 ((and (string-match "am" time2conv) (= hr 12))
85bbde63 678 (setq hr 0)))
cb17eeae 679 ;; Convert the actual time into minutes.
0cb7f2c0 680 (+ (* hr 60) min)))
902a0e3c 681
8d638c1b
GM
682(defun appt-update-list ()
683 "If the current buffer is visiting the diary, update appointments.
92b99a01
GM
684This function also acts on any file listed in `diary-included-files'.
685It is intended for use with `write-file-functions'."
686 (and (member buffer-file-name (append diary-included-files
687 (list (expand-file-name diary-file))))
8d638c1b
GM
688 appt-timer
689 (let ((appt-display-diary nil))
690 (appt-check t)))
691 nil)
692
8d638c1b
GM
693;;;###autoload
694(defun appt-activate (&optional arg)
debf91fd 695 "Toggle checking of appointments.
8d638c1b
GM
696With optional numeric argument ARG, turn appointment checking on if
697ARG is positive, otherwise off."
698 (interactive "P")
699 (let ((appt-active appt-timer))
700 (setq appt-active (if arg (> (prefix-numeric-value arg) 0)
701 (not appt-active)))
702 (remove-hook 'write-file-functions 'appt-update-list)
703 (or global-mode-string (setq global-mode-string '("")))
704 (delq 'appt-mode-string global-mode-string)
a19de628
GM
705 (when appt-timer
706 (cancel-timer appt-timer)
707 (setq appt-timer nil))
b4593555
GM
708 (if appt-active
709 (progn
b4593555
GM
710 (add-hook 'write-file-functions 'appt-update-list)
711 (setq appt-timer (run-at-time t 60 'appt-check)
712 global-mode-string
713 (append global-mode-string '(appt-mode-string)))
714 (appt-check t)
7e1e2a6e
GM
715 (message "Appointment reminders enabled%s"
716 ;; Someone might want to use appt-add without a diary.
717 (if (ignore-errors (diary-check-diary-file))
718 ""
719 " (no diary file found)")))
b4593555 720 (message "Appointment reminders disabled"))))
8d638c1b 721
efa434d9 722
8d638c1b 723(provide 'appt)
5b586155 724
efa434d9 725;;; appt.el ends here