Trailing whitepace deleted.
[emacs.git] / lisp / calendar / appt.el
blobc3f4d77fcaef925531becc83b5c4b3efe87cd484
1 ;;; appt.el --- appointment notification functions
3 ;; Copyright (C) 1989, 1990, 1994, 1998 Free Software Foundation, Inc.
5 ;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
6 ;; Maintainer: FSF
7 ;; Keywords: calendar
9 ;; This file is part of GNU Emacs.
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
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
26 ;;; Commentary:
29 ;; appt.el - visible and/or audible notification of
30 ;; appointments from ~/diary file.
32 ;;;
33 ;;; Thanks to Edward M. Reingold for much help and many suggestions,
34 ;;; And to many others for bug fixes and suggestions.
35 ;;;
36 ;;;
37 ;;; This functions in this file will alert the user of a
38 ;;; pending appointment based on their diary file.
39 ;;;
40 ;;; A message will be displayed in the mode line of the Emacs buffer
41 ;;; and (if you request) the terminal will beep and display a message
42 ;;; from the diary in the mini-buffer, or you can choose to
43 ;;; have a message displayed in a new buffer.
44 ;;;
45 ;;; The variable `appt-message-warning-time' allows the
46 ;;; user to specify how much notice they want before the appointment. The
47 ;;; variable `appt-issue-message' specifies whether the user wants
48 ;;; to be notified of a pending appointment.
49 ;;;
50 ;;; In order to use the appt package, you only need
51 ;;; to load it---provided you have appointments.
52 ;;;
53 ;;; Before that, you can also set some options if you want
54 ;;; (setq view-diary-entries-initially t)
55 ;;; (setq appt-issue-message t)
56 ;;;
57 ;;; This is an example of what can be in your diary file:
58 ;;; Monday
59 ;;; 9:30am Coffee break
60 ;;; 12:00pm Lunch
61 ;;;
62 ;;; Based upon the above lines in your .emacs and diary files,
63 ;;; the calendar and diary will be displayed when you enter
64 ;;; Emacs and your appointments list will automatically be created.
65 ;;; You will then be reminded at 9:20am about your coffee break
66 ;;; and at 11:50am to go to lunch.
67 ;;;
68 ;;; Use describe-function on appt-check for a description of other variables
69 ;;; that can be used to personalize the notification system.
70 ;;;
71 ;;; In order to add or delete items from todays list, use appt-add
72 ;;; and appt-delete.
73 ;;;
74 ;;; Additionally, the appointments list is recreated automatically
75 ;;; at 12:01am for those who do not logout every day or are programming
76 ;;; late.
77 ;;;
78 ;;; Brief internal description - Skip this if you are not interested!
79 ;;;
80 ;;; The function appt-make-list creates the appointments list which appt-check
81 ;;; reads. This is all done automatically.
82 ;;; It is invoked from the function list-diary-entries.
83 ;;;
84 ;;; You can change the way the appointment window is created/deleted by
85 ;;; setting the variables
86 ;;;
87 ;;; appt-disp-window-function
88 ;;; and
89 ;;; appt-delete-window-function
90 ;;;
91 ;;; For instance, these variables can be set to functions that display
92 ;;; appointments in pop-up frames, which are lowered or iconified after
93 ;;; appt-display-interval minutes.
94 ;;;
96 ;;; Code:
98 ;; Make sure calendar is loaded when we compile this.
99 (require 'calendar)
101 (provide 'appt)
103 ;;;###autoload
104 (defcustom appt-issue-message t
105 "*Non-nil means check for appointments in the diary buffer.
106 To be detected, the diary entry must have the time
107 as the first thing on a line."
108 :type 'boolean
109 :group 'appt)
111 ;;;###autoload
112 (defcustom appt-message-warning-time 12
113 "*Time in minutes before an appointment that the warning begins."
114 :type 'integer
115 :group 'appt)
117 ;;;###autoload
118 (defcustom appt-audible t
119 "*Non-nil means beep to indicate appointment."
120 :type 'boolean
121 :group 'appt)
123 ;;;###autoload
124 (defcustom appt-visible t
125 "*Non-nil means display appointment message in echo area."
126 :type 'boolean
127 :group 'appt)
129 ;;;###autoload
130 (defcustom appt-display-mode-line t
131 "*Non-nil means display minutes to appointment and time on the mode line."
132 :type 'boolean
133 :group 'appt)
135 ;;;###autoload
136 (defcustom appt-msg-window t
137 "*Non-nil means display appointment message in another window."
138 :type 'boolean
139 :group 'appt)
141 ;;;###autoload
142 (defcustom appt-display-duration 10
143 "*The number of seconds an appointment message is displayed."
144 :type 'integer
145 :group 'appt)
147 ;;;###autoload
148 (defcustom appt-display-diary t
149 "*Non-nil means to display the next days diary on the screen.
150 This will occur at midnight when the appointment list is updated."
151 :type 'boolean
152 :group 'appt)
154 (defvar appt-time-msg-list nil
155 "The list of appointments for today.
156 Use `appt-add' and `appt-delete' to add and delete appointments from list.
157 The original list is generated from the today's `diary-entries-list'.
158 The number before each time/message is the time in minutes from midnight.")
160 (defconst appt-max-time 1439
161 "11:59pm in minutes - number of minutes in a day minus 1.")
163 (defcustom appt-display-interval 3
164 "*Number of minutes to wait between checking the appointment list."
165 :type 'integer
166 :group 'appt)
168 (defvar appt-buffer-name " *appt-buf*"
169 "Name of the appointments buffer.")
171 (defvar appt-disp-window-function 'appt-disp-window
172 "Function called to display appointment window.")
174 (defvar appt-delete-window-function 'appt-delete-window
175 "Function called to remove appointment window and buffer.")
177 (defvar appt-mode-string nil
178 "String being displayed in the mode line saying you have an appointment.
179 The actual string includes the amount of time till the appointment.")
181 (defvar appt-prev-comp-time nil
182 "Time of day (mins since midnight) at which we last checked appointments.")
184 (defvar appt-now-displayed nil
185 "Non-nil when we have started notifying about a appointment that is near.")
187 (defvar appt-display-count nil)
189 (defun appt-check ()
190 "Check for an appointment and update the mode line.
191 Note: the time must be the first thing in the line in the diary
192 for a warning to be issued.
194 The format of the time can be either 24 hour or am/pm.
195 Example:
197 02/23/89
198 18:00 Dinner
200 Thursday
201 11:45am Lunch meeting.
203 Appointments are checked every `appt-display-interval' minutes.
204 The following variables control appointment notification:
206 `appt-issue-message'
207 If t, the diary buffer is checked for appointments.
209 `appt-message-warning-time'
210 Variable used to determine if appointment message
211 should be displayed.
213 `appt-audible'
214 Variable used to determine if appointment is audible.
215 Default is t.
217 `appt-visible'
218 Variable used to determine if appointment message should be
219 displayed in the mini-buffer. Default is t.
221 `appt-msg-window'
222 Variable used to determine if appointment message
223 should temporarily appear in another window. Mutually exclusive
224 to `appt-visible'.
226 `appt-display-duration'
227 The number of seconds an appointment message
228 is displayed in another window.
230 `appt-disp-window-function'
231 Function called to display appointment window. You can customize
232 appt.el by setting this variable to a function different from the
233 one provided with this package.
235 `appt-delete-window-function'
236 Function called to remove appointment window and buffer. You can
237 customize appt.el by setting this variable to a function different
238 from the one provided with this package."
240 (let* ((min-to-app -1)
241 (new-time "")
242 (prev-appt-mode-string appt-mode-string)
243 (prev-appt-display-count (or appt-display-count 0))
244 ;; Non-nil means do a full check for pending appointments
245 ;; and display in whatever ways the user has selected.
246 ;; When no appointment is being displayed,
247 ;; we always do a full check.
248 (full-check
249 (or (not appt-now-displayed)
250 ;; This is true every appt-display-interval minutes.
251 (= 0 (mod prev-appt-display-count appt-display-interval))))
252 ;; Non-nil means only update the interval displayed in the mode line.
253 (mode-line-only
254 (and (not full-check) appt-now-displayed)))
256 (when (or full-check mode-line-only)
257 (save-excursion
259 ;; Get the current time and convert it to minutes
260 ;; from midnight. ie. 12:01am = 1, midnight = 0.
262 (let* ((now (decode-time))
263 (cur-hour (nth 2 now))
264 (cur-min (nth 1 now))
265 (cur-comp-time (+ (* cur-hour 60) cur-min)))
267 ;; At the first check in any given day, update our
268 ;; appointments to today's list.
270 (if (or (null appt-prev-comp-time)
271 (< cur-comp-time appt-prev-comp-time))
272 (condition-case nil
273 (progn
274 (if (and view-diary-entries-initially appt-display-diary)
275 (diary)
276 (let ((diary-display-hook 'appt-make-list))
277 (diary))))
278 (error nil)))
279 (setq appt-prev-comp-time cur-comp-time)
281 (setq appt-mode-string nil)
282 (setq appt-display-count nil)
284 ;; If there are entries in the list, and the
285 ;; user wants a message issued,
286 ;; get the first time off of the list
287 ;; and calculate the number of minutes until the appointment.
289 (if (and appt-issue-message appt-time-msg-list)
290 (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
291 (setq min-to-app (- appt-comp-time cur-comp-time))
293 (while (and appt-time-msg-list
294 (< appt-comp-time cur-comp-time))
295 (setq appt-time-msg-list (cdr appt-time-msg-list))
296 (if appt-time-msg-list
297 (setq appt-comp-time
298 (car (car (car appt-time-msg-list))))))
300 ;; If we have an appointment between midnight and
301 ;; 'appt-message-warning-time' minutes after midnight,
302 ;; we must begin to issue a message before midnight.
303 ;; Midnight is considered 0 minutes and 11:59pm is
304 ;; 1439 minutes. Therefore we must recalculate the minutes
305 ;; to appointment variable. It is equal to the number of
306 ;; minutes before midnight plus the number of
307 ;; minutes after midnight our appointment is.
309 (if (and (< appt-comp-time appt-message-warning-time)
310 (> (+ cur-comp-time appt-message-warning-time)
311 appt-max-time))
312 (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time))
313 appt-comp-time))
315 ;; issue warning if the appointment time is
316 ;; within appt-message-warning time
318 (when (and (<= min-to-app appt-message-warning-time)
319 (>= min-to-app 0))
320 (setq appt-now-displayed t)
321 (setq appt-display-count
322 (1+ prev-appt-display-count))
323 (unless mode-line-only
324 (if appt-msg-window
325 (progn
326 (setq new-time (format-time-string "%a %b %e "
327 (current-time)))
328 (funcall
329 appt-disp-window-function
330 (number-to-string min-to-app) new-time
331 (car (cdr (car appt-time-msg-list))))
333 (run-at-time
334 (format "%d sec" appt-display-duration)
336 appt-delete-window-function))
337 ;;; else
339 (if appt-visible
340 (message "%s"
341 (car (cdr (car appt-time-msg-list)))))
343 (if appt-audible
344 (beep 1))))
346 (when appt-display-mode-line
347 (setq appt-mode-string
348 (concat " App't in "
349 (number-to-string min-to-app)
350 " min. ")))
352 ;; When an appointment is reached,
353 ;; delete it from the list.
354 ;; Reset the count to 0 in case we display another
355 ;; appointment on the next cycle.
356 (if (= min-to-app 0)
357 (setq appt-time-msg-list
358 (cdr appt-time-msg-list)
359 appt-display-count nil)))))
361 ;; If we have changed the mode line string,
362 ;; redisplay all mode lines.
363 (and appt-display-mode-line
364 (not (equal appt-mode-string
365 prev-appt-mode-string))
366 (progn
367 (force-mode-line-update t)
368 ;; If the string now has a notification,
369 ;; redisplay right now.
370 (if appt-mode-string
371 (sit-for 0)))))))))
374 (defun appt-disp-window (min-to-app new-time appt-msg)
375 "Display appointment message APPT-MSG in a separate buffer."
376 (require 'electric)
378 ;; Make sure we're not in the minibuffer
379 ;; before splitting the window.
381 (if (equal (selected-window) (minibuffer-window))
382 (if (other-window 1)
383 (select-window (other-window 1))
384 (if (display-multi-frame-p)
385 (select-frame (other-frame 1)))))
387 (let* ((this-buffer (current-buffer))
388 (this-window (selected-window))
389 (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
391 (if (cdr (assq 'unsplittable (frame-parameters)))
392 ;; In an unsplittable frame, use something somewhere else.
393 (display-buffer appt-disp-buf)
394 (unless (or (special-display-p (buffer-name appt-disp-buf))
395 (same-window-p (buffer-name appt-disp-buf)))
396 ;; By default, split the bottom window and use the lower part.
397 (appt-select-lowest-window)
398 (split-window))
399 (pop-to-buffer appt-disp-buf))
400 (setq mode-line-format
401 (concat "-------------------- Appointment in "
402 min-to-app " minutes. " new-time " %-"))
403 (erase-buffer)
404 (insert appt-msg)
405 (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
406 (set-buffer-modified-p nil)
407 (raise-frame (selected-frame))
408 (select-window this-window)
409 (if appt-audible
410 (beep 1))))
412 (defun appt-delete-window ()
413 "Function called to undisplay appointment messages.
414 Usually just deletes the appointment buffer."
415 (let ((window (get-buffer-window appt-buffer-name t)))
416 (and window
417 (or (eq window (frame-root-window (window-frame window)))
418 (delete-window window))))
419 (kill-buffer appt-buffer-name)
420 (if appt-audible
421 (beep 1)))
423 (defun appt-select-lowest-window ()
424 "Select the lowest window on the frame."
425 (let ((lowest-window (selected-window))
426 (bottom-edge (nth 3 (window-edges))))
427 (walk-windows (lambda (w)
428 (let ((next-bottom-edge (nth 3 (window-edges w))))
429 (when (< bottom-edge next-bottom-edge)
430 (setq bottom-edge next-bottom-edge
431 lowest-window w)))))
432 (select-window lowest-window)))
434 ;;;###autoload
435 (defun appt-add (new-appt-time new-appt-msg)
436 "Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG.
437 The time should be in either 24 hour format or am/pm format."
439 (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
440 (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
442 (error "Unacceptable time-string"))
444 (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
445 (appt-time (list (appt-convert-time new-appt-time)))
446 (time-msg (cons appt-time (list appt-time-string))))
447 (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg)))
448 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
450 ;;;###autoload
451 (defun appt-delete ()
452 "Delete an appointment from the list of appointments."
453 (interactive)
454 (let* ((tmp-msg-list appt-time-msg-list))
455 (while tmp-msg-list
456 (let* ((element (car tmp-msg-list))
457 (prompt-string (concat "Delete "
458 ;; We want to quote any doublequotes
459 ;; in the string, as well as put
460 ;; doublequotes around it.
461 (prin1-to-string
462 (substring-no-properties
463 (car (cdr element)) 0))
464 " from list? "))
465 (test-input (y-or-n-p prompt-string)))
466 (setq tmp-msg-list (cdr tmp-msg-list))
467 (if test-input
468 (setq appt-time-msg-list (delq element appt-time-msg-list)))))
469 (appt-check)
470 (message "")))
473 (eval-when-compile (defvar number)
474 (defvar original-date)
475 (defvar diary-entries-list))
476 ;;;###autoload
477 (defun appt-make-list ()
478 "Create the appointments list from todays diary buffer.
479 The time must be at the beginning of a line for it to be
480 put in the appointments list.
481 02/23/89
482 12:00pm lunch
483 Wednesday
484 10:00am group meeting
485 We assume that the variables DATE and NUMBER
486 hold the arguments that `list-diary-entries' received.
487 They specify the range of dates that the diary is being processed for."
489 ;; We have something to do if the range of dates that the diary is
490 ;; considering includes the current date.
491 (if (and (not (calendar-date-compare
492 (list (calendar-current-date))
493 (list original-date)))
494 (calendar-date-compare
495 (list (calendar-current-date))
496 (list (calendar-gregorian-from-absolute
497 (+ (calendar-absolute-from-gregorian original-date)
498 number)))))
499 (save-excursion
500 ;; Clear the appointments list, then fill it in from the diary.
501 (setq appt-time-msg-list nil)
502 (if diary-entries-list
504 ;; Cycle through the entry-list (diary-entries-list)
505 ;; looking for entries beginning with a time. If
506 ;; the entry begins with a time, add it to the
507 ;; appt-time-msg-list. Then sort the list.
509 (let ((entry-list diary-entries-list)
510 (new-time-string ""))
511 ;; Skip diary entries for dates before today.
512 (while (and entry-list
513 (calendar-date-compare
514 (car entry-list) (list (calendar-current-date))))
515 (setq entry-list (cdr entry-list)))
516 ;; Parse the entries for today.
517 (while (and entry-list
518 (calendar-date-equal
519 (calendar-current-date) (car (car entry-list))))
520 (let ((time-string (cadr (car entry-list))))
521 (while (string-match
522 "\\([0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\).*"
523 time-string)
524 (let* ((beg (match-beginning 0))
525 ;; Get just the time for this appointment.
526 (only-time (match-string 1 time-string))
527 ;; Find the end of this appointment
528 ;; (the start of the next).
529 (end (string-match
530 "^[ \t]*[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
531 time-string
532 (match-end 0)))
533 ;; Get the whole string for this appointment.
534 (appt-time-string
535 (substring time-string beg (if end (1- end)))))
537 ;; Add this appointment to appt-time-msg-list.
538 (let* ((appt-time (list (appt-convert-time only-time)))
539 (time-msg (list appt-time appt-time-string)))
540 (setq appt-time-msg-list
541 (nconc appt-time-msg-list (list time-msg))))
543 ;; Discard this appointment from the string.
544 (setq time-string
545 (if end (substring time-string end) "")))))
546 (setq entry-list (cdr entry-list)))))
547 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
549 ;; Get the current time and convert it to minutes
550 ;; from midnight. ie. 12:01am = 1, midnight = 0,
551 ;; so that the elements in the list
552 ;; that are earlier than the present time can
553 ;; be removed.
555 (let* ((now (decode-time))
556 (cur-hour (nth 2 now))
557 (cur-min (nth 1 now))
558 (cur-comp-time (+ (* cur-hour 60) cur-min))
559 (appt-comp-time (car (car (car appt-time-msg-list)))))
561 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
562 (setq appt-time-msg-list (cdr appt-time-msg-list))
563 (if appt-time-msg-list
564 (setq appt-comp-time (car (car (car appt-time-msg-list))))))))))
567 (defun appt-sort-list (appt-list)
568 "Simple sort to put the appointments list APPT-LIST in order.
569 Scan the list for the smallest element left in the list.
570 Append the smallest element left into the new list, and remove
571 it from the original list."
572 (let ((order-list nil))
573 (while appt-list
574 (let* ((element (car appt-list))
575 (element-time (car (car element)))
576 (tmp-list (cdr appt-list)))
577 (while tmp-list
578 (if (< element-time (car (car (car tmp-list))))
580 (setq element (car tmp-list))
581 (setq element-time (car (car element))))
582 (setq tmp-list (cdr tmp-list)))
583 (setq order-list (nconc order-list (list element)))
584 (setq appt-list (delq element appt-list))))
585 order-list))
588 (defun appt-convert-time (time2conv)
589 "Convert hour:min[am/pm] format to minutes from midnight."
591 (let ((conv-time 0)
592 (hr 0)
593 (min 0))
595 (string-match ":\\([0-9][0-9]\\)" time2conv)
596 (setq min (string-to-int
597 (match-string 1 time2conv)))
599 (string-match "[0-9]?[0-9]:" time2conv)
600 (setq hr (string-to-int
601 (match-string 0 time2conv)))
603 ;; convert the time appointment time into 24 hour time
605 (cond ((and (string-match "pm" time2conv) (< hr 12))
606 (setq hr (+ 12 hr)))
607 ((and (string-match "am" time2conv) (= hr 12))
608 (setq hr 0)))
610 ;; convert the actual time
611 ;; into minutes for comparison
612 ;; against the actual time.
614 (setq conv-time (+ (* hr 60) min))
615 conv-time))
617 (defvar appt-timer nil
618 "Timer used for diary appointment notifications (`appt-check').")
620 (unless appt-timer
621 (setq appt-timer (run-at-time t 60 'appt-check)))
623 (or global-mode-string (setq global-mode-string '("")))
624 (or (memq 'appt-mode-string global-mode-string)
625 (setq global-mode-string
626 (append global-mode-string '(appt-mode-string))))
628 ;;; appt.el ends here