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