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