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