comparison lisp/calendar/appt.el @ 116:9f59509498e1 r20-1b10

Import from CVS: tag r20-1b10
author cvs
date Mon, 13 Aug 2007 09:23:06 +0200
parents 360340f9fd5f
children 7d55a9ba150c
comparison
equal deleted inserted replaced
115:f109f7dabbe2 116:9f59509498e1
22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23 23
24 ;;; 29-nov-89 created by Neil Mager <neilm@juliet.ll.mit.edu>. 24 ;;; 29-nov-89 created by Neil Mager <neilm@juliet.ll.mit.edu>.
25 ;;; 23-feb-91 hacked upon by Jamie Zawinski <jwz@lucid.com>. 25 ;;; 23-feb-91 hacked upon by Jamie Zawinski <jwz@lucid.com>.
26 ;;; 1-apr-91 some more. 26 ;;; 1-apr-91 some more.
27 ;;; 12-jul-95 updated for XEmacs 19.12 by Greg Veres <gveres@cgl.uwaterloo.ca> 27 ;;; 12-jul-95 updated for XEmacs 19.12 by Greg Veres
28 ;;; <gveres@cgl.uwaterloo.ca>
29 ;;; 21-mar-97 better support for fancy diary display by Tomasz J. Cholewo
30 ;;; <t.cholewo@ieee.org>
28 ;;; 31 ;;;
29 ;; appt.el - visible and/or audible notification of 32 ;; appt.el - visible and/or audible notification of
30 ;; appointments from ~/diary file generated from 33 ;; appointments from ~/diary file generated from
31 ;; Edward M. Reingold's calendar.el. 34 ;; Edward M. Reingold's calendar.el.
32 ;; 35 ;;
115 ;;; your .diary file -- there may not be embedded newlines in it. This is a 118 ;;; your .diary file -- there may not be embedded newlines in it. This is a
116 ;;; bit of a misfeature. 119 ;;; bit of a misfeature.
117 ;;; 120 ;;;
118 ;;; This also interacts correctly with Benjamin Pierce's reportmail.el package. 121 ;;; This also interacts correctly with Benjamin Pierce's reportmail.el package.
119 ;;; 122 ;;;
120 ;;; Brief internal description - Skip this if your not interested! 123 ;;; Brief internal description - Skip this if you are not interested!
121 ;;; 124 ;;;
122 ;;; The function appt-initialize invokes 'diary' to get a list of today's 125 ;;; The function appt-initialize invokes 'diary' to get a list of today's
123 ;;; appointments, and parses the lines beginning with date descriptions. 126 ;;; appointments, and parses the lines beginning with date descriptions.
124 ;;; This list is cached away. 'diary' is invoked in such a way so as to 127 ;;; This list is cached away. 'diary' is invoked in such a way so as to
125 ;;; not pop up a window displaying the diary buffer. 128 ;;; not pop up a window displaying the diary buffer.
131 ;;; 134 ;;;
132 ;;; display-time-filter is modified to invoke appt-check. 135 ;;; display-time-filter is modified to invoke appt-check.
133 ;;; 136 ;;;
134 ;;; TO DO: 137 ;;; TO DO:
135 ;;; 138 ;;;
136 ;;; o multiple adjascent appointments are not handled gracefully. If there 139 ;;; o multiple adjacent appointments are not handled gracefully. If there
137 ;;; is an appointment at 3:30 and another at 3:35, and you have set things 140 ;;; is an appointment at 3:30 and another at 3:35, and you have set things
138 ;;; up so that you get a notification twenty minutes before each appt, 141 ;;; up so that you get a notification twenty minutes before each appt,
139 ;;; then a notification should come at 3:10 for the first appt, and at 142 ;;; then a notification should come at 3:10 for the first appt, and at
140 ;;; 3:15 for the second. Currently, no notifications are generated for an 143 ;;; 3:15 for the second. Currently, no notifications are generated for an
141 ;;; appointment until all preceding appointments have completely expired. 144 ;;; appointment until all preceding appointments have completely expired.
367 370
368 371
369 ;;; Internal stuff 372 ;;; Internal stuff
370 373
371 (defun appt-convert-time (time2conv) 374 (defun appt-convert-time (time2conv)
372 " Convert hour:min[am/pm] format to minutes from midnight." 375 "Convert hour:min[am/pm] format to minutes from midnight."
373 (cond ((string-match "^[ \t]*midni\\(ght\\|te\\)[ \t]*\\'" time2conv) 376 (cond ((string-match "^[ \t]*midni\\(ght\\|te\\)[ \t]*\\'" time2conv)
374 0) 377 0)
375 ((string-match "^[ \t]*noon[ \t]*\\'" time2conv) 378 ((string-match "^[ \t]*noon[ \t]*\\'" time2conv)
376 (* 12 60)) 379 (* 12 60))
377 (t 380 (t
399 (if (< hr 12) (setq hr (+ 12 hr)))))) 402 (if (< hr 12) (setq hr (+ 12 hr))))))
400 (if (> min 59) (error "minutes outa bounds - %s" time2conv)) 403 (if (> min 59) (error "minutes outa bounds - %s" time2conv))
401 (+ (* hr 60) min))))) 404 (+ (* hr 60) min)))))
402 405
403 406
404 (defun appt-current-time-in-seconds () 407 (defun appt-current-time-in-minutes ()
405 "returns the current time in seconds since midnight." 408 "Returns the current time in minutes since midnight."
406 (let* ((str (current-time-string)) 409 (let* ((str (current-time-string))
407 (hour (string-to-int (substring str 11 13))) 410 (hour (string-to-int (substring str 11 13)))
408 (min (string-to-int (substring str 14 16)))) 411 (min (string-to-int (substring str 14 16))))
409 (+ (* hour 60) min))) 412 (+ (* hour 60) min)))
410 413
413 (sort (copy-sequence appt-list) 416 (sort (copy-sequence appt-list)
414 (function (lambda (x y) 417 (function (lambda (x y)
415 (< (car (car x)) (car (car y))))))) 418 (< (car (car x)) (car (car y)))))))
416 419
417 (defun appt-diary-entries () 420 (defun appt-diary-entries ()
421 "Return an updated list of appointments for today."
418 (let ((list-diary-entries-hook '(appt-make-list)) 422 (let ((list-diary-entries-hook '(appt-make-list))
419 (diary-display-hook nil) 423 (diary-display-hook 'ignore)
420 (diary-list-include-blanks nil)) 424 (diary-list-include-blanks nil))
421 ;; this will set appt-time-msg-list. 425 ;; this will set appt-time-msg-list.
422 (diary 1) 426 (diary 1)
423 appt-time-msg-list)) 427 appt-time-msg-list))
424 428
425 (defun appt-initialize () 429 (defun appt-initialize ()
426 " Read your `diary-file' and remember today's appointments. Call this from 430 "Read your `diary-file' and remember today's appointments. Call this from
427 your .emacs file, or any time you want your .diary file re-read (this happens 431 your .emacs file, or any time you want your .diary file re-read (this happens
428 automatically at midnight to move to notice the next day's appointments). 432 automatically at midnight to notice the next day's appointments).
429 433
430 The time must be at the beginning of a line for it to be put in the 434 The time must be at the beginning of a line for it to be put in the
431 appointments list. 435 appointments list.
432 02/23/89 436 02/23/89
433 12:00pm lunch 437 12:00pm lunch
481 (setq entry-list (cdr entry-list))) 485 (setq entry-list (cdr entry-list)))
482 (setq appt-time-msg-list ; seems we can't nconc this list... 486 (setq appt-time-msg-list ; seems we can't nconc this list...
483 (append (nreverse new-appts) appt-time-msg-list)))) 487 (append (nreverse new-appts) appt-time-msg-list))))
484 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)) 488 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
485 ;; 489 ;;
486 ;; Get the current time and convert it to minutes from midnight. ie. 12:01am 490 ;; Get the current time and convert it to minutes from midnight, i.e.,
487 ;; = 1, midnight = 0, so that the elements in the list that are earlier than 491 ;; 12:01am = 1, midnight = 0, so that the elements in the list that
488 ;; the present time can be removed. 492 ;; are earlier than the present time can be removed.
489 ;; 493 ;;
490 (let ((cur-comp-time (appt-current-time-in-seconds)) 494 (let ((cur-comp-time (appt-current-time-in-minutes))
491 (appt-comp-time (car (car (car appt-time-msg-list))))) 495 (appt-comp-time (car (car (car appt-time-msg-list)))))
492 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) 496 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
493 (setq appt-time-msg-list (cdr appt-time-msg-list)) 497 (setq appt-time-msg-list (cdr appt-time-msg-list))
494 (if appt-time-msg-list 498 (if appt-time-msg-list
495 (setq appt-comp-time (car (car (car appt-time-msg-list))))))) 499 (setq appt-comp-time (car (car (car appt-time-msg-list)))))))
546 This function is run from the `loadst' or `wakeup' process for display-time. 550 This function is run from the `loadst' or `wakeup' process for display-time.
547 Therefore, you need to have (display-time) in your .emacs file." 551 Therefore, you need to have (display-time) in your .emacs file."
548 (if appt-issue-message 552 (if appt-issue-message
549 (let ((min-to-app -1)) 553 (let ((min-to-app -1))
550 ;; Get the current time and convert it to minutes 554 ;; Get the current time and convert it to minutes
551 ;; from midnight. ie. 12:01am = 1, midnight = 0. 555 ;; from midnight, i.e., 12:01am = 1, midnight = 0.
552 (let* ((cur-comp-time (appt-current-time-in-seconds)) 556 (let* ((cur-comp-time (appt-current-time-in-minutes))
553 ;; If the current time is the same as the tick, just return. 557 ;; If the current time is the same as the tick, just return.
554 ;; This means that this function has been called more than once 558 ;; This means that this function has been called more than once
555 ;; in the current minute, which is not useful. 559 ;; in the current minute, which is not useful.
556 (shut-up-this-time (= cur-comp-time appt-check-tick)) 560 (shut-up-this-time (= cur-comp-time appt-check-tick))
557 (turnover-p (> appt-check-tick cur-comp-time))) 561 (turnover-p (> appt-check-tick cur-comp-time)))
558 (setq appt-check-tick cur-comp-time) 562 (setq appt-check-tick cur-comp-time)
559 ;; 563 ;;
560 ;; If it is now the next day (we have crossed midnight since the last 564 ;; If it is now the next day (we have crossed midnight since the last
561 ;; time this was called) then we should update our appointments to 565 ;; time this was called) then we should update our appointments to
562 ;; today's list. 566 ;; today's list. Show the diary entries (tjc).
563 (if turnover-p (appt-diary-entries)) 567 (if turnover-p (diary 1))
564 ;; 568 ;;
565 ;; Get the first time off of the list and calculate the number 569 ;; Get the first time off of the list and calculate the number
566 ;; of minutes until the appointment. 570 ;; of minutes until the appointment.
567 (if appt-time-msg-list 571 (if appt-time-msg-list
568 (let ((appt-comp-time (car (car (car appt-time-msg-list))))) 572 (let ((appt-comp-time (car (car (car appt-time-msg-list)))))