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