diff lisp/calendar/appt.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/calendar/appt.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,723 @@
+;;; appt.el --- appointment notification functions.
+;; Keywords: calendar
+
+;;; -*- Mode:Emacs-Lisp -*-
+;; Appointment notification functions.
+;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; 29-nov-89	created by Neil Mager <neilm@juliet.ll.mit.edu>.
+;;; 23-feb-91	hacked upon by Jamie Zawinski <jwz@lucid.com>.
+;;;  1-apr-91	some more.
+;;; 12-jul-95   updated for XEmacs 19.12 by Greg Veres <gveres@cgl.uwaterloo.ca>
+;;;
+;; appt.el - visible and/or audible notification of
+;;           appointments from ~/diary file generated from
+;;           Edward M. Reingold's calendar.el.
+;;
+;; Version 2.1
+;;
+;; Comments, corrections, and improvements should be sent to
+;; Neil M. Mager
+;; Net                     <neilm@juliet.ll.mit.edu>
+;; Voice                   (617) 981-4803
+;;;
+;;; Thanks to  Edward M. Reingold for much help and many suggestions, 
+;;; And to many others for bug fixes and suggestions.
+;;;
+;;;
+;;; This functions in this file will alert the user of a 
+;;; pending appointment based on their diary file.
+;;;
+;;; ******* It is necessary to invoke 'display-time' and ********
+;;; ******* 'appt-initialize' for this to work properly. ********
+;;; 
+;;; A message will be displayed in the mode line of the emacs buffer and (if
+;;; the user desires) the terminal will beep and display a message from the
+;;; diary in the mini-buffer, or the user may select to have a message
+;;; displayed in a new buffer.
+;;;
+;;; Variables of note:
+;;;
+;;; appt-issue-message		If this variable is nil, then the code in this
+;;;				file does nothing.
+;;; appt-msg-countdown-list	Specifies how much warning you want before 
+;;;				appointments.
+;;; appt-audible		Whether to beep when it's notification-time.
+;;; appt-display-mode-line	Whether to display a countdown to the next 
+;;;				appointment in the mode-line.
+;;; appt-announce-method	The function used to do the notifications.
+;;;	'appt-window-announce		   do it in a pop-up window.
+;;;     'appt-frame-announce		   do it in a pop-up frame (v19 only)
+;;;	'appt-message-announce		   do it in the echo area.
+;;;	'appt-persistent-message-announce  do it in the echo area, but make the
+;;;				    messages not go away at the next keystroke.
+;;; appt-display-duration	If appt-announce-method is set to the function
+;;;				'appt-window-announce, this specifies how many
+;;;				seconds the pop-up window should stick around.
+;;;
+;;; In order to use this, create a diary file, and add the following to your
+;;; .emacs file:
+;;;
+;;;    (require 'appt)
+;;;    (display-time)
+;;;    (appt-initialize)
+;;;
+;;; If you wish to see a list of appointments, or a full calendar, when emacs
+;;; starts up, you can add a call to (diary) or (calendar) after this.
+;;;
+;;;  This is an example of what can be in your diary file:
+;;;	 Monday
+;;;	   9:30am Coffee break
+;;;	  12:00pm Lunch
+;;; 
+;;; Based upon the above lines in your .emacs and diary files, the calendar
+;;; and/or diary will be displayed when you enter emacs and your appointments
+;;; list will automatically be created.  You will then be reminded at 9:20am
+;;; about your coffee break and at 11:50am to go to lunch.
+;;;
+;;; In order to interactively add or delete items from today's list, use 
+;;; Meta-x appt-add and Meta-x appt-delete.  (This does not modify your 
+;;; diary file, so these will be forgotten when you exit emacs.)
+;;;
+;;; Additionally, the appointments list is recreated automatically at 12:01am 
+;;; for those who do not logout every day or are programming late.
+;;;
+;;; You can have special appointments which execute arbitrary code rather than
+;;; simply notifying you -- sort of like the unix "cron" facility.  The syntax
+;;; for this is borrowed from the Calendar's special-date format.  If you have
+;;; a diary entry like
+;;;
+;;;  Monday
+;;;    3:00am	%%(save-all-modified-buffers)
+;;;
+;;; then on monday at 3AM, the function `save-all-modified-buffers' will be
+;;; invoked.  (Presumably this function is defined in your .emacs file.)
+;;; There will be no notification that these "special" appointments are being
+;;; triggered, unless the form evaluated produces a notification.
+;;;
+;;; It is necessary for the entire list after the "%%" to be on one line in 
+;;; your .diary file -- there may not be embedded newlines in it.  This is a
+;;; bit of a misfeature.
+;;;
+;;; This also interacts correctly with Benjamin Pierce's reportmail.el package.
+;;;
+;;; Brief internal description - Skip this if your not interested!
+;;;
+;;; The function appt-initialize invokes 'diary' to get a list of today's
+;;; appointments, and parses the lines beginning with date descriptions.
+;;; This list is cached away.  'diary' is invoked in such a way so as to
+;;; not pop up a window displaying the diary buffer.
+;;;
+;;; The function appt-check is run from the 'loadst' process (or the 'wakeup'
+;;; process in emacs 18.57 or newer) which is started by invoking display-time.
+;;; It checks this cached list, and announces as appropriate.  At midnight,
+;;; appt-initialize is called again to rebuild this list.
+;;;
+;;; display-time-filter is modified to invoke appt-check.
+;;;
+;;; TO DO:
+;;;
+;;;  o  multiple adjascent appointments are not handled gracefully.  If there 
+;;;     is an appointment at 3:30 and another at 3:35, and you have set things
+;;;     up so that you get a notification twenty minutes before each appt,
+;;;     then a notification should come at 3:10 for the first appt, and at
+;;;     3:15 for the second.  Currently, no notifications are generated for an
+;;;     appointment until all preceeding appointments have completely expired.
+;;;
+;;;  o  If there are two appointments at the same time, all but the first are
+;;;     ignored (not announced.)
+;;;
+;;;  o  Appointments which are early enough in the morning that their 
+;;;     announcements should begin before midnight are not announced until
+;;;     midnight.
+;;;
+;;;  o  There should be some way to mark certain appointments as "important,"
+;;;     so that you will be harassed about them even after they have expired.
+
+
+(require 'calendar)
+(require 'diary-lib)
+
+(defvar appt-issue-message t
+  "*If T, the diary buffer is checked for appointments.  For an
+ appointment warning to be made, the time must be the first thing on
+ the line.")
+
+(defvar appt-msg-countdown-list '(20 15 10 5 3 1)
+  "*A list of the intervals in minutes before the appointment when
+ the warnings will be given.  That is, if this were the list '(5 3 1),
+ then a notification would be given five minutes, three minutes, and
+ one minute before the appointment.")
+
+(defvar appt-check-time-syntax nil
+  "*Whether all diary entries are intended to beging with time specifications.
+Appt will beep and issue a warning message when encountering unparsable 
+lines.")
+
+(defvar appt-audible t
+  "*Controls whether appointment announcements should beep.
+Appt uses two sound-types for beeps: `appt' and `appt-final'.
+If this is a number, then that many beeps will occur.
+If this is a cons, the car is how many beeps, and the cdr is the
+  delay between them (a float, fraction of a second to sleep.)
+See also the variable `appt-msg-countdown-list'")
+
+(defvar appt-display-mode-line t
+  "*Controls if minutes-to-appointment should be displayed on the mode line.")
+
+(defvar appt-announce-method 'appt-window-announce
+  "*The name of the function used to notify the user of an impending 
+appointment.  This is called with two arguments, the number of minutes
+until the appointment, and the appointment description list.
+
+Reasonable values for this variable are 'appt-window-announce,
+'appt-message-announce, or 'appt-persistent-message-announce.")
+
+
+(defvar appt-time-msg-list nil
+  "The list of appointments for today.  Use appt-add and appt-delete
+ to add and delete appointments from list.  The original list is generated
+ from the today's diary-entries-list. The number before each time/message
+ is the time in minutes after midnight.")
+
+(defconst max-time 1439
+  "11:59pm in minutes - number of minutes in a day minus 1.")
+
+(defconst appt-check-tick -1)
+
+(defvar appt-disp-frame nil
+  "If non-nil, frame to display appointments in.")
+(defvaralias 'appt-disp-screen 'appt-disp-frame)
+  
+
+;;; Announcement methods
+
+(defun appt-message-announce (min-to-app appt)
+  "Set appt-announce-method to the name of this function to cause appointment
+notifications to be given via messages in the minibuffer."
+  (message (if (eq min-to-app 0) "App't NOW."
+	       (format "App't in %d minute%s -- %s"
+		       min-to-app
+		       (if (eq 1 min-to-app) "" "s")
+		       (car (cdr appt))))))
+
+
+(defun appt-persistent-message-announce (min-to-app appt)
+  "Set appt-announce-method to the name of this function to cause appointment
+notifications to be given via messages in the minibuffer, but have those 
+messages stay around even if you type something (unlike normal messages)."
+  (let ((str (if (eq min-to-app 0)
+		 (format "App't NOW -- %s" (car (cdr appt)))
+		 (format "App't in %d minute%s -- %s"
+			 min-to-app
+			 (if (eq 1 min-to-app) "" "s")
+			 (car (cdr appt)))))
+	(in-echo-area-already (eq (selected-window) (minibuffer-window))))
+    (if (not in-echo-area-already)
+	;; don't stomp the echo-area-buffer if reading from the minibuffer now.
+	(save-excursion
+	  (save-window-excursion
+	    (select-window (minibuffer-window))
+	    (delete-region (point-min) (point-max))
+	    (insert str))))
+    ;; if we're reading from the echo-area, and all we were going to do is
+    ;; clear the thing, like, don't bother, that's annoying.
+    (if (and in-echo-area-already (string= "" str))
+	nil
+      (message "%s" str))
+    ))
+
+
+(defvar appt-display-duration 5
+  "*The number of seconds an appointment message is displayed in its own 
+ window if appt-announce-method is 'appt-window-announce.")
+
+(defun appt-window-announce (min-to-app appt)
+  "Set appt-announce-method to the name of this function to cause appointment 
+notifications to be given via messages in a pop-up window.  The variable
+appt-display-duration controls how long this window should be left up."
+  (require 'electric)
+  (save-excursion
+   (save-window-excursion
+    ;; Make sure we're not in the minibuffer
+    ;; before splitting the window.
+     (if (window-minibuffer-p (selected-window))
+	 nil
+       (select-window (frame-lowest-window))
+       (split-window))
+    (let (appt-disp-buf)
+      (unwind-protect
+	   (progn
+	     (setq appt-disp-buf (set-buffer (get-buffer-create "*appt-buf*")))
+	     ;; set the mode-line of the pop-up window
+	     (setq modeline-format 
+	       (concat "-------------------- Appointment "
+		 (if (eq min-to-app 0)
+		     "NOW"
+		   (concat "in " min-to-app
+		     (if (eq min-to-app 1) " minute" " minutes")))
+		 ". ("
+		 (let ((h (string-to-int
+			    (substring (current-time-string) 11 13))))
+		   (concat (if (> h 12) (- h 12) h) ":"
+			   (substring (current-time-string) 14 16)
+			   (if (< h 12) "am" "pm")))
+		 ") %-"))
+	     (pop-to-buffer appt-disp-buf)
+	     (insert (car (cdr appt)))
+	     (shrink-window-if-larger-than-buffer
+	       (get-buffer-window appt-disp-buf))
+	     (set-buffer-modified-p nil)
+	     (sit-for appt-display-duration))
+	(and appt-disp-buf (kill-buffer appt-disp-buf)))))))
+
+(defvar appt-frame-defaults nil)
+(defvaralias 'appt-screen-defaults 'appt-frame-defaults)
+
+(defun appt-frame-announce (min-to-app appt)
+  "Set appt-announce-method to the name of this function to cause appointment 
+notifications to be given via messages in a pop-up frame."
+  (let ()
+    (save-excursion
+      (set-buffer (get-buffer-create "*appt-buf*"))
+      (erase-buffer)
+      ;; set the mode-line of the pop-up window
+      (setq modeline-format 
+	    (concat "-------------------- Appointment "
+		    (if (eq min-to-app 0)
+			"NOW"
+		      (concat "in " min-to-app
+			      (if (eq min-to-app 1) " minute" " minutes")))
+		    ". ("
+		    (let ((h (string-to-int
+			      (substring (current-time-string) 11 13))))
+		      (concat (if (> h 12) (- h 12) h) ":"
+			      (substring (current-time-string) 14 16)
+			      (if (< h 12) "am" "pm")))
+		    ") %-"))
+      (insert (car (cdr appt)))
+      (let ((height (max 10 (min 20 (+ 2 (count-lines (point-min)
+						      (point-max)))))))
+        ;; If we already have a frame constructed, use it. If not, or it has
+        ;; been deleted, then make a new one
+	(if (and appt-disp-frame (frame-live-p appt-disp-frame))
+	    (let ((s (selected-frame)))
+	      (select-frame appt-disp-frame)
+	      (make-frame-visible appt-disp-frame)
+	      (set-frame-height appt-disp-frame height)
+	      (sit-for 0)
+	      (select-frame s))
+          (progn
+            (setq appt-disp-frame (make-frame))
+            (set-frame-height appt-disp-frame height)
+            )
+          )
+        )
+      )
+    )
+  )
+(defalias 'appt-screen-announce 'appt-frame-announce)
+
+;;; To display stuff in the mode line, we use a new variable instead of
+;;; just adding stuff to the display-time-string -- this causes less
+;;; flicker.
+
+(defvar appt-mode-line-string ""
+  "*The string displayed in the mode line by the appointment package.")
+
+(defun appt-display-mode-line (min-to-app)
+  "Add an appointment annotation to the mode line."
+  (setq appt-mode-line-string
+	(if (and appt-display-mode-line min-to-app)
+	    (if (eq 0 min-to-app)
+		"App't NOW "
+		(concat "App't in " min-to-app
+			(if (eq 1 min-to-app) " minute  " " minutes ")))
+	    ""))
+  ;; make sure our variable is visible in global-mode-string.
+  (cond ((not appt-display-mode-line) nil)
+	((null global-mode-string)
+	 (setq global-mode-string (list "" 'appt-mode-line-string)))
+	((stringp global-mode-string)
+	 (setq global-mode-string
+	       (list global-mode-string 'appt-mode-line-string)))
+	((not (memq 'appt-mode-line-string global-mode-string))
+	 (setq global-mode-string
+	       (append global-mode-string (list 'appt-mode-line-string)))))
+  ;; force mode line updates - from time.el
+  (save-excursion (set-buffer (other-buffer)))
+  (set-buffer-modified-p (buffer-modified-p))
+  (sit-for 0))
+
+
+;;; Internal stuff
+
+(defun appt-convert-time (time2conv)
+  " Convert hour:min[am/pm] format to minutes from midnight."
+  (cond ((string-match "^[ \t]*midni\\(ght\\|te\\)[ \t]*\\'" time2conv)
+	 0)
+	((string-match "^[ \t]*noon[ \t]*\\'" time2conv)
+	 (* 12 60))
+	(t
+	 (let ((hr 0)
+	       (min 0))
+	   (or (string-match
+		 "\\`[ \t]*\\([0-9][0-9]?\\)[ \t]*\\(:[ \t]*\\([0-9][0-9]\\)\\)?[ \t]*\\(am\\|pm\\)?"
+		 time2conv)
+	       (error "unparsable time \"%s\"" time2conv))
+	   (setq hr (string-to-int
+		      (substring time2conv
+				 (match-beginning 1) (match-end 1))))
+	   (if (match-beginning 3)
+	       (setq min (string-to-int 
+			   (substring time2conv 
+				      (match-beginning 3) (match-end 3)))))
+	   ;; convert the time appointment time into 24 hour time
+	   (if (match-beginning 4)
+	       (progn
+		 (if (or (= hr 0) (> hr 12))
+		     (error "mixing 12hr and 24 hr time!  %s" time2conv))
+		 (if (string-match "am"
+				   (substring time2conv (match-beginning 4)))
+		     (if (= hr 12) (setq hr 0))
+		   (if (< hr 12) (setq hr (+ 12 hr))))))
+	   (if (> min 59) (error "minutes outa bounds - %s" time2conv))
+	   (+ (* hr 60) min)))))
+
+
+(defun appt-current-time-in-seconds ()
+  "returns the current time in seconds since midnight."
+  (let* ((str (current-time-string))
+	 (hour (string-to-int (substring str 11 13)))
+	 (min  (string-to-int (substring str 14 16))))
+    (+ (* hour 60) min)))
+
+
+(defun appt-sort-list (appt-list)
+  (sort (copy-sequence appt-list)
+	(function (lambda (x y)
+	  (< (car (car x)) (car (car y)))))))
+
+(defun appt-diary-entries ()
+  (let ((list-diary-entries-hook '(appt-make-list))
+	(diary-display-hook nil)
+	(diary-list-include-blanks nil))
+    ;; this will set appt-time-msg-list.
+    (diary 1)
+    appt-time-msg-list))
+
+(defun appt-initialize ()
+  " Read your `diary-file' and remember today's appointments.  Call this from 
+ your .emacs file, or any time you want your .diary file re-read (this happens 
+ automatically at midnight to move to notice the next day's appointments).
+ 
+ The time must be at the beginning of a line for it to be put in the 
+ appointments list.
+               02/23/89
+                  12:00pm    lunch
+                Wednesday
+                  10:00am    group meeting"
+  (install-display-time-hook)
+  (let ((n (length (appt-diary-entries))))
+    (cond ((= n 0) (message "no appointments today."))
+	  ((= n 1) (message "1 appointment today."))
+	  (t (message (format "%d appointments today." n))))))
+
+(defun appt-make-list ()
+  "Don't call this directly; call appt-initialize or appt-diary-entries."
+  (setq appt-time-msg-list nil)
+  (if diary-entries-list
+      ;; Cycle through the entry-list (diary-entries-list) looking for
+      ;; entries beginning with a time. If the entry begins with a time,
+      ;; add it to the appt-time-msg-list. Then sort the list.
+      ;;
+      (let ((entry-list diary-entries-list)
+	    (new-appts '()))
+	(while (and entry-list
+		    (calendar-date-equal
+		      (calendar-current-date) (car (car entry-list))))
+	  (let ((time-string (car (cdr (car entry-list)))))
+	    (while (string-match
+		    "\\`[ \t\n]*\\([0-9]?[0-9]\\(:[0-9][0-9]\\)?[ \t]*\\(am\\|pm\\)?\\|noon\\|midnight\\|midnite\\).*$"
+		     time-string)
+	      (let* ((eol (match-end 0))
+		     (appt-time-string
+		      (substring time-string (match-beginning 1)
+				 (match-end 1)))
+		     (appt-msg-string
+		      (substring time-string (match-end 1) eol))
+		     (appt-time (list (appt-convert-time appt-time-string))))
+		(setq time-string (substring time-string eol)
+		      new-appts (cons (cons appt-time
+					    (list (concat appt-time-string ":"
+							  appt-msg-string)))
+				      new-appts))))
+	    (if appt-check-time-syntax
+		(while (string-match "\n*\\([^\n]+\\)$" time-string)
+		  (beep)
+		  (message "Unparsable time: %s"
+			   (substring time-string (match-beginning 1)
+				      (match-end 1)))
+		  (sit-for 3)
+		  (setq time-string (substring time-string (match-end 0)))))
+					       
+	    )
+	  (setq entry-list (cdr entry-list)))
+	(setq appt-time-msg-list ; seems we can't nconc this list...
+	      (append (nreverse new-appts) appt-time-msg-list))))
+  (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
+  ;;
+  ;; Get the current time and convert it to minutes from midnight. ie. 12:01am
+  ;; = 1, midnight = 0, so that the elements in the list that are earlier than
+  ;; the present time can be removed.
+  ;;
+  (let ((cur-comp-time (appt-current-time-in-seconds))
+	(appt-comp-time (car (car (car appt-time-msg-list)))))
+    (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
+      (setq appt-time-msg-list (cdr appt-time-msg-list)) 
+      (if appt-time-msg-list
+          (setq appt-comp-time (car (car (car appt-time-msg-list)))))))
+  appt-time-msg-list)
+
+
+(defun appt-beep (&optional final-p)
+  (cond ((null appt-audible) nil)
+	((numberp appt-audible)
+	 (let ((i appt-audible))
+	   (while (> i 0) (beep) (setq i (1- i)))))
+	((consp appt-audible)
+	 (let ((i (car appt-audible))
+	       (j (cdr appt-audible)))
+	   (if (consp j) (setq j (car j)))
+	   (while (> i 0)
+	     (if (fboundp 'play-sound)
+		 (beep nil (if final-p 'appt-final 'appt))
+	       (beep))
+             (sleep-for j)
+	     (setq i (1- i)))))
+	(t (beep))))
+
+
+(defun appt-check ()
+  "Check for an appointment and update the mode line and minibuffer if
+ desired. Note: the time must be the first thing in the line in the diary
+ for a warning to be issued.
+  The format of the time can be either 24 hour or am/pm.  Example: 
+ 
+               02/23/89
+                 18:00 Dinner
+              Thursday
+                11:45am Lunch meeting.
+  
+ The following variables control the action of the notification:
+ 
+ appt-issue-message		If this variable is nil, then the code in this
+				file does nothing.
+ appt-msg-countdown-list	Specifies how much warning you want before 
+				appointments.
+ appt-audible			Whether to beep when it's notification-time.
+ appt-display-mode-line		Whether to display a countdown to the next 
+				appointment in the mode-line.
+ appt-announce-method   	The function used to do the notifications.
+				'appt-window-announce to do it in a pop-up
+				window, 'appt-message-announce or 
+				'appt-persistent-message-announce to do it 
+				in the echo-area.
+ appt-display-duration  	If appt-announce-method is set to the function
+				'appt-window-announce, this specifies how many
+				seconds the pop-up window should stick around.
+ 
+ This function is run from the `loadst' or `wakeup' process for display-time.
+ Therefore, you need to have (display-time) in your .emacs file."
+  (if appt-issue-message
+   (let ((min-to-app -1))
+     ;; Get the current time and convert it to minutes
+     ;; from midnight. ie. 12:01am = 1, midnight = 0.
+     (let* ((cur-comp-time (appt-current-time-in-seconds))
+	    ;; If the current time is the same as the tick, just return.
+	    ;; This means that this function has been called more than once
+	    ;; in the current minute, which is not useful.
+	    (shut-up-this-time (= cur-comp-time appt-check-tick))
+	    (turnover-p (> appt-check-tick cur-comp-time)))
+       (setq appt-check-tick cur-comp-time)
+       ;;
+       ;; If it is now the next day (we have crossed midnight since the last
+       ;; time this was called) then we should update our appointments to
+       ;; today's list.
+       (if turnover-p (appt-diary-entries))
+       ;;
+       ;; Get the first time off of the list and calculate the number
+       ;; of minutes until the appointment.
+       (if appt-time-msg-list
+	   (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
+	     (setq min-to-app (- appt-comp-time cur-comp-time))
+	     (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
+	       (setq appt-time-msg-list (cdr appt-time-msg-list)) 
+	       (if appt-time-msg-list
+		   (setq appt-comp-time (car (car (car appt-time-msg-list))))))
+	     ;;
+	     ;; If we have an appointment between midnight and warning-time
+	     ;; minutes after midnight, we must begin to issue a message
+	     ;; before midnight.  Midnight is considered 0 minutes and 11:59pm
+	     ;; is 1439 minutes. Therefore we must recalculate the minutes to
+	     ;; appointment variable. It is equal to the number of minutes
+	     ;; before midnight plus the number of minutes after midnight our
+	     ;; appointment is.
+	     ;;
+	     ;; ## I don't think this does anything -- it would if it were
+	     ;; (for example) a 12:01am appt on the list at 11:55pm, but that
+	     ;; can't ever happen, because the applicable 12:01am appt is for
+	     ;; tomorrow, not today, and we only have today's diary list.
+	     ;; It's not simply a matter of concatenating two days together,
+	     ;; either, because then tuesday's appts would be signalled on
+	     ;; monday.  We have to do a real one-day lookahead -- keep a list
+	     ;; of tomorrow's appts, and check it when near midnight.
+	     ;;
+	     (if (and (< appt-comp-time (apply 'max appt-msg-countdown-list))
+		      (> (+ cur-comp-time (apply 'max appt-msg-countdown-list))
+			 max-time))
+		 (setq min-to-app (+ (- (1+ max-time) cur-comp-time))
+		       appt-comp-time))
+	     ;;
+	     ;; issue warning if the appointment time is within warning-time
+	     (cond
+	       ;; if there should not be any notifications in the mode-line,
+	       ;; clear it.
+	       ((> min-to-app (apply 'max appt-msg-countdown-list))
+		(appt-display-mode-line nil))
+	       ;; do nothing if this is the second time this minute we've
+	       ;; gotten here, of if we shouldn't be notifying right now.
+	       ((or shut-up-this-time
+		    (and (not (= min-to-app 0))
+			 (not (memq min-to-app appt-msg-countdown-list))))
+		nil)
+
+	       ((and (= min-to-app 0)
+		     (string-match "%%(" (nth 1 (car appt-time-msg-list))))
+		;;
+		;; If this is a magic evaluating-notification, evaluate it.
+		;; these kinds of notifications aren't subject to the
+		;; appt-msg-countdown-list.
+		;;
+		(let* ((list-string (substring (nth 1 (car appt-time-msg-list))
+					       (1- (match-end 0))))
+		       (form (condition-case ()
+				 (read list-string)
+			       (error
+				 (ding)
+				 (message "Appt: error reading from \"%s\""
+					  (nth 1 (car appt-time-msg-list)))
+				 (sit-for 2)
+				 nil))))
+		  (eval form)))
+
+	       ((and (<= min-to-app (apply 'max appt-msg-countdown-list))
+		     (>= min-to-app 0))
+		;;
+		;; produce a notification.
+		(appt-beep (= min-to-app 0))
+		(funcall appt-announce-method min-to-app
+			 (car appt-time-msg-list))
+		;; update mode line and expire if necessary
+		(appt-display-mode-line min-to-app)
+		;; if it's expired, remove it.
+		(if (= min-to-app 0)
+		    (setq appt-time-msg-list (cdr appt-time-msg-list))))
+	       (t
+		;; else we're not near any appointment, or there are no
+		;; apointments; make sure mode line is clear.
+		(appt-display-mode-line nil))))
+	   (appt-display-mode-line nil))))))
+
+
+
+;;; Interactively adding and deleting appointments
+
+(defun appt-add (new-appt-time new-appt-msg)
+  "Adds an appointment to the list of appointments for the day at TIME
+ and issue MESSAGE. The time should be in either 24 hour format or
+ am/pm format. "
+ 
+  (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
+  (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
+      nil
+    (error "Unacceptable time-string"))
+  
+  (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
+         (appt-time (list (appt-convert-time new-appt-time)))
+         (time-msg (cons appt-time (list appt-time-string))))
+    (setq appt-time-msg-list (append appt-time-msg-list
+                                     (list time-msg)))
+    (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) 
+
+(defun appt-delete ()
+  "Deletes an appointment from the list of appointments."
+  (interactive)
+  (let* ((tmp-msg-list appt-time-msg-list))
+    (while tmp-msg-list
+      (let* ((element (car tmp-msg-list))
+             (prompt-string (concat "Delete " 
+                                    (prin1-to-string (car (cdr element))) 
+                                    " from list? "))
+             (test-input (y-or-n-p prompt-string)))
+        (setq tmp-msg-list (cdr tmp-msg-list))
+        (if test-input
+            (setq appt-time-msg-list (delq element appt-time-msg-list)))))
+    (message "")))
+
+
+;;; Patching in to existing time code to install our hook.
+
+(defvar display-time-hook nil
+  "*List of functions to be called when the time is updated on the mode line.")
+
+(setq display-time-hook 'appt-check)
+
+(defvar display-time-hook-installed nil)
+
+(defun install-display-time-hook ()
+ (if display-time-hook-installed         ;; only do this stuff once!
+    nil
+  (let ((old-fn (if (or (featurep 'reportmail)
+			;; old reportmail without a provide statement
+			(and (fboundp 'display-time-filter-18-55)
+			     (fboundp 'display-time-filter-18-57)))
+		    (if (and (featurep 'itimer)  ; XEmacs reportmail.el
+			     (fboundp 'display-time-timer-function))
+			'display-time-timer-function
+		      ;; older reportmail, or no timer.el.
+		      (if (string-match "18\\.5[0-5]" (emacs-version))
+			  'display-time-filter-18-55
+			'display-time-filter-18-57))
+		  ;; othewise, time.el
+		  (if (and (featurep 'itimer)
+			   (fboundp 'display-time-function)) ; XEmacs
+		      'display-time-function
+		    'display-time-filter))))
+    ;; we're about to redefine it...
+    (fset 'old-display-time-filter (symbol-function old-fn))
+    (fset old-fn
+	  (function (lambda (&rest args)  ;; ...here's the revised definition
+	    "Revised version of the original function: this version calls a hook."
+	    (apply 'old-display-time-filter args)
+	    (run-hooks 'display-time-hook)))))
+  (setq display-time-hook-installed t)
+  ))
+
+(provide 'appt)