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