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