emacs: lisp/calendar/appt.el comparison

comparison lisp/calendar/appt.el @ 88155:d7ddb3e565de

sync with trunk

author	Henrik Enberg <henrik.enberg@telia.com>
date	Mon, 16 Jan 2006 00:03:54 +0000
parents	0d8b17d428b5
children

comparison

equal deleted inserted replaced

-:8ce476d3ba36
+:d7ddb3e565de
 ;;; appt.el --- appointment notification functions
-;; Copyright (C) 1989, 1990, 1994, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1990, 1994, 1998, 2001, 2002, 2003, 2004, 2005
+;;   Free Software Foundation, Inc.
 ;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
-;; Maintainer: FSF
+;; Maintainer: Glenn Morris <rgm@gnu.org>
 ;; Keywords: calendar
 ;; This file is part of GNU Emacs.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; 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 GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02111-1307, USA.
+;; Boston, MA 02110-1301, USA.
 ;;; Commentary:
 ;;
 ;; appt.el - visible and/or audible notification of
-;;           appointments from ~/diary file.
+;;           appointments from diary file.
 ;;
 ;;;
 ;;; 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.
+;;; pending appointment based on his/her diary file.  This package
-;;;
+;;; is documented in the Emacs manual.
-;;; A message will be displayed in the mode line of the Emacs buffer
+;;;
-;;; and (if you request) the terminal will beep and display a message
+;;; To activate this package, simply use (appt-activate 1).
-;;; from the diary in the mini-buffer, or you can choose to
+;;; A `diary-file' with appointments of the format described in the
-;;; have a message displayed in a new buffer.
+;;; documentation of the function `appt-check' is required.
-;;;
+;;; Relevant customizable variables are also listed in the
-;;; The variable `appt-message-warning-time' allows the
+;;; documentation of that function.
-;;; user to specify how much notice they want before the appointment. The
+;;;
-;;; variable `appt-issue-message' specifies whether the user wants
+;;; Today's appointment list is initialized from the diary when this
-;;; to be notified of a pending appointment.
+;;; package is activated. Additionally, the appointments list is
-;;;
+;;; recreated automatically at 12:01am for those who do not logout
-;;; In order to use the appt package, you only need
+;;; every day or are programming late. It is also updated when the
-;;; to load it---provided you have appointments.
+;;; `diary-file' is saved. Calling `appt-check' with an argument forces
-;;;
+;;; a re-initialization at any time.
-;;; Before that, you can also set some options if you want
+;;;
-;;;   (setq view-diary-entries-initially t)
+;;; In order to add or delete items from today's list, without
-;;;   (setq appt-issue-message t)
+;;; changing the diary file, use `appt-add' and `appt-delete'.
 ;;;
-;;;  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 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.
-;;;
-;;; Use describe-function on appt-check for a description of other variables
-;;; that can be used to personalize the notification system.
-;;;
-;;;  In order to add or delete items from todays list, use appt-add
-;;;  and appt-delete.
-;;;
-;;;  Additionally, the appointments list is recreated automatically
-;;;  at 12:01am for those who do not logout every day or are programming
-;;;  late.
-;;;
 ;;; Brief internal description - Skip this if you are not interested!
 ;;;
-;;; The function appt-make-list creates the appointments list which appt-check
+;;; The function `appt-make-list' creates the appointments list which
-;;; reads. This is all done automatically.
+;;; `appt-check' reads.
-;;; It is invoked from the function list-diary-entries.
 ;;;
 ;;; You can change the way the appointment window is created/deleted by
-;;; setting  the variables
+;;; setting the variables
 ;;;
 ;;;	     appt-disp-window-function
 ;;; and
 ;;; 	     appt-delete-window-function
 ;;;
-;;; For instance, these variables can be set to functions that display
+;;; For instance, these variables could be set to functions that display
 ;;; appointments in pop-up frames, which are lowered or iconified after
-;;; appt-display-interval minutes.
+;;; `appt-display-interval' minutes.
 ;;;
 ;;; Code:
 ;; Make sure calendar is loaded when we compile this.
 (require 'calendar)
-(provide 'appt)
 ;;;###autoload
 (defcustom appt-issue-message t
 "*Non-nil means check for appointments in the diary buffer.
-To be detected, the diary entry must have the time
+To be detected, the diary entry must have the format described in the
-as the first thing on a line."
+documentation of the function `appt-check'."
 :type 'boolean
 :group 'appt)
+(make-obsolete-variable 'appt-issue-message
+"use the function `appt-activate', and the \
+variable `appt-display-format' instead." "22.1")
 ;;;###autoload
 (defcustom appt-message-warning-time 12
 "*Time in minutes before an appointment that the warning begins."
 :type 'integer
 :type 'boolean
 :group 'appt)
 ;;;###autoload
 (defcustom appt-visible t
-"*Non-nil means display appointment message in echo area."
+"*Non-nil means display appointment message in echo area.
+This variable is only relevant if `appt-msg-window' is nil."
 :type 'boolean
 :group 'appt)
+(make-obsolete-variable 'appt-visible 'appt-display-format "22.1")
+;;;###autoload
+(defcustom appt-msg-window t
+"*Non-nil means display appointment message in another window.
+If non-nil, this variable overrides `appt-visible'."
+:type 'boolean
+:group 'appt)
+(make-obsolete-variable 'appt-msg-window 'appt-display-format "22.1")
+;; TODO - add popup.
+(defcustom appt-display-format 'ignore
+"How appointment reminders should be displayed.
+The options are:
+window - use a separate window
+echo   - use the echo area
+nil    - no visible reminder.
+See also `appt-audible' and `appt-display-mode-line'.
+The default value is 'ignore, which means to fall back on the value
+of the (obsolete) variables `appt-msg-window' and `appt-visible'."
+:type '(choice
+(const :tag "Separate window" window)
+(const :tag "Echo-area" echo)
+(const :tag "No visible display" nil))
+:group 'appt
+:version "22.1")
 ;;;###autoload
 (defcustom appt-display-mode-line t
-"*Non-nil means display minutes to appointment and time on the mode line."
+"*Non-nil means display minutes to appointment and time on the mode line.
+This is in addition to any other display of appointment messages."
 :type 'boolean
 :group 'appt)
 ;;;###autoload
-(defcustom appt-msg-window t
-"*Non-nil means display appointment message in another window."
-:type 'boolean
-:group 'appt)
-;;;###autoload
 (defcustom appt-display-duration 10
-"*The number of seconds an appointment message is displayed."
+"*The number of seconds an appointment message is displayed.
+Only relevant if reminders are to be displayed in their own window."
 :type 'integer
 :group 'appt)
 ;;;###autoload
 (defcustom appt-display-diary t
-"*Non-nil means to display the next days diary on the screen.
+"*Non-nil displays the diary when the appointment list is first initialized.
 This will occur at midnight when the appointment list is updated."
 :type 'boolean
 :group 'appt)
-(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 from midnight.")
-(defconst appt-max-time 1439
-"11:59pm in minutes - number of minutes in a day minus 1.")
 (defcustom appt-display-interval 3
 "*Number of minutes to wait between checking the appointment list."
 :type 'integer
 :group 'appt)
-(defvar appt-buffer-name " *appt-buf*"
+(defcustom appt-disp-window-function 'appt-disp-window
+"Function called to display appointment window.
+Only relevant if reminders are being displayed in a window."
+:type '(choice (const appt-disp-window)
+function)
+:group 'appt)
+(defcustom appt-delete-window-function 'appt-delete-window
+"Function called to remove appointment window and buffer.
+Only relevant if reminders are being displayed in a window."
+:type '(choice (const appt-delete-window)
+function)
+:group 'appt)
+;;; Internal variables below this point.
+(defconst appt-buffer-name " *appt-buf*"
 "Name of the appointments buffer.")
-(defvar appt-disp-window-function 'appt-disp-window
+(defvar appt-time-msg-list nil
-"Function called to display appointment window.")
+"The list of appointments for today.
+Use `appt-add' and `appt-delete' to add and delete appointments.
-(defvar appt-delete-window-function 'appt-delete-window
+The original list is generated from today's `diary-entries-list', and
-"Function called to remove appointment window and buffer.")
+can be regenerated using the function `appt-check'.
+Each element of the generated list has the form (MINUTES STRING [FLAG]); where
+MINUTES is the time in minutes of the appointment after midnight, and
+STRING is the description of the appointment.
+FLAG, if non-nil, says that the element was made with `appt-add'
+so calling `appt-make-list' again should preserve it.")
+(defconst appt-max-time (1- (* 24 60))
+"11:59pm in minutes - number of minutes in a day minus 1.")
 (defvar appt-mode-string nil
 "String being displayed in the mode line saying you have an appointment.
-The actual string includes the amount of time till the appointment.")
+The actual string includes the amount of time till the appointment.
+Only used if `appt-display-mode-line' is non-nil.")
 (defvar appt-prev-comp-time nil
-"Time of day (mins since midnight) at which we last checked appointments.")
+"Time of day (mins since midnight) at which we last checked appointments.
+A nil value forces the diary file to be (re-)checked for appointments.")
 (defvar appt-now-displayed nil
 "Non-nil when we have started notifying about a appointment that is near.")
-(defvar appt-display-count nil)
+(defvar appt-display-count nil
+"Internal variable used to count number of consecutive reminders.")
-(defun appt-check ()
-"Check for an appointment and update the mode line.
+(defvar appt-timer nil
+"Timer used for diary appointment notifications (`appt-check').
+If this is non-nil, appointment checking is active.")
+;;; Functions.
+(defun appt-display-message (string mins)
+"Display a reminder about an appointment.
+The string STRING describes the appointment, due in integer MINS minutes.
+The format of the visible reminder is controlled by `appt-display-format'.
+The variable `appt-audible' controls the audible reminder."
+;; let binding for backwards compatability. Remove when obsolete
+;; vars appt-msg-window and appt-visible are dropped.
+(let ((appt-display-format
+(if (eq appt-display-format 'ignore)
+(cond (appt-msg-window 'window)
+(appt-visible 'echo))
+appt-display-format)))
+(cond ((eq appt-display-format 'window)
+(funcall appt-disp-window-function
+(number-to-string mins)
+;; TODO - use calendar-month-abbrev-array rather
+;; than %b?
+(format-time-string "%a %b %e " (current-time))
+string)
+(run-at-time (format "%d sec" appt-display-duration)
+nil
+appt-delete-window-function))
+((eq appt-display-format 'echo)
+(message "%s" string)))
+(if appt-audible (beep 1))))
+(defun appt-check (&optional force)
+"Check for an appointment and update any reminder display.
+If optional argument FORCE is non-nil, reparse the diary file for
+appointments.  Otherwise the diary file is only parsed once per day,
+and when saved.
 Note: the time must be the first thing in the line in the diary
-for a warning to be issued.
+for a warning to be issued.  The format of the time can be either
+24 hour or am/pm.  For example:
-The format of the time can be either 24 hour or am/pm.
-Example:
+02/23/89
+18:00 Dinner
-02/23/89
-18:00 Dinner
 Thursday
 11:45am Lunch meeting.
 Appointments are checked every `appt-display-interval' minutes.
 The following variables control appointment notification:
-`appt-issue-message'
+`appt-display-format'
-	If t, the diary buffer is checked for appointments.
+Controls the format in which reminders are displayed.
+`appt-audible'
+	Variable used to determine if reminder is audible.
+	Default is t.
 `appt-message-warning-time'
-	Variable used to determine if appointment message
+	Variable used to determine when appointment message
-	should be displayed.
+	should first be displayed.
-`appt-audible'
+`appt-display-mode-line'
-	Variable used to determine if appointment is audible.
+If non-nil, a generic message giving the time remaining
-	Default is t.
+is shown in the mode-line when an appointment is due.
-`appt-visible'
+`appt-display-interval'
-	Variable used to determine if appointment message should be
+Interval in minutes at which to check for pending appointments.
-	displayed in the mini-buffer.  Default is t.
+`appt-display-diary'
-`appt-msg-window'
+Display the diary buffer when the appointment list is
-	Variable used to determine if appointment message
+initialized for the first time in a day.
-	should temporarily appear in another window.  Mutually exclusive
-	to `appt-visible'.
+The following variables are only relevant if reminders are being
+displayed in a window:
 `appt-display-duration'
-	The number of seconds an appointment message
+	The number of seconds an appointment message is displayed.
-	is displayed in another window.
 `appt-disp-window-function'
-	Function called to display appointment window.  You can customize
+	Function called to display appointment window.
-	appt.el by setting this variable to a function different from the
-	one provided with this package.
 `appt-delete-window-function'
-	Function called to remove appointment window and buffer.  You can
+	Function called to remove appointment window and buffer."
-	customize appt.el by setting this variable to a function different
-	from the one provided with this package."
 (let* ((min-to-app -1)
-	 (new-time "")
 	 (prev-appt-mode-string appt-mode-string)
 	 (prev-appt-display-count (or appt-display-count 0))
 	 ;; Non-nil means do a full check for pending appointments
 	 ;; and display in whatever ways the user has selected.
 	 ;; When no appointment is being displayed,
 	 ;; we always do a full check.
 	 (full-check
 	  (or (not appt-now-displayed)
 	      ;; This is true every appt-display-interval minutes.
-	      (= 0 (mod prev-appt-display-count appt-display-interval))))
+	      (zerop (mod prev-appt-display-count appt-display-interval))))
 	 ;; Non-nil means only update the interval displayed in the mode line.
 	 (mode-line-only
 	  (and (not full-check) appt-now-displayed)))
 (when (or full-check mode-line-only)
 	       (cur-comp-time (+ (* cur-hour 60) cur-min)))
 	  ;; At the first check in any given day, update our
 	  ;; appointments to today's list.
-	  (if (or (null appt-prev-comp-time)
+	  (if (or force                 ; eg initialize, diary save
-		  (< cur-comp-time appt-prev-comp-time))
+(null appt-prev-comp-time)             ; first check
+		  (< cur-comp-time appt-prev-comp-time)) ; new day
 	      (condition-case nil
-		  (progn
+(if appt-display-diary
-		    (if (and view-diary-entries-initially appt-display-diary)
+(let ((diary-hook
-			(diary)
+(if (assoc 'appt-make-list diary-hook)
-		      (let ((diary-display-hook 'appt-make-list))
+diary-hook
-			(diary))))
+(cons 'appt-make-list diary-hook))))
+(diary))
+(let* ((diary-display-hook 'appt-make-list)
+(d-buff (find-buffer-visiting
+(substitute-in-file-name diary-file)))
+(selective
+(if d-buff        ; Diary buffer exists.
+(with-current-buffer d-buff
+diary-selective-display))))
+(diary)
+;; If the diary buffer existed before this command,
+;; restore its display state. Otherwise, kill it.
+(if d-buff
+;; Displays the diary buffer.
+(or selective (show-all-diary-entries))
+(and
+(setq d-buff (find-buffer-visiting
+(substitute-in-file-name diary-file)))
+(kill-buffer d-buff)))))
 		(error nil)))
-	  (setq appt-prev-comp-time cur-comp-time)
+	  (setq appt-prev-comp-time cur-comp-time
-	  (setq appt-mode-string nil)
+appt-mode-string nil
-	  (setq appt-display-count nil)
+appt-display-count nil)
 	  ;; If there are entries in the list, and the
 	  ;; user wants a message issued,
 	  ;; get the first time off of the list
 	  ;; and calculate the number of minutes until the appointment.
 		;; issue warning if the appointment time is
 		;; within appt-message-warning time
 		(when (and (<= min-to-app appt-message-warning-time)
 			   (>= min-to-app 0))
-		  (setq appt-now-displayed t)
+		  (setq appt-now-displayed t
-		  (setq appt-display-count
+appt-display-count (1+ prev-appt-display-count))
-			(1+ prev-appt-display-count))
 		  (unless mode-line-only
-		    (if appt-msg-window
+(appt-display-message (cadr (car appt-time-msg-list))
-			(progn
+min-to-app))
-			  (setq new-time (format-time-string "%a %b %e "
-							     (current-time)))
-			  (funcall
-			   appt-disp-window-function
-			   (number-to-string min-to-app) new-time
-			   (car (cdr (car appt-time-msg-list))))
-			  (run-at-time
-			   (format "%d sec" appt-display-duration)
-			   nil
-			   appt-delete-window-function))
-			      ;;; else
-		      (if appt-visible
-			  (message "%s"
-				   (car (cdr (car appt-time-msg-list)))))
-		      (if appt-audible
-			  (beep 1))))
 		  (when appt-display-mode-line
 		    (setq appt-mode-string
-			  (concat  " App't in "
+(format " App't in %s min." min-to-app)))
-				   (number-to-string min-to-app)
-				   " min. ")))
 		  ;; When an appointment is reached,
 		  ;; delete it from the list.
 		  ;; Reset the count to 0 in case we display another
 		  ;; appointment on the next cycle.
-		  (if (= min-to-app 0)
+		  (if (zerop min-to-app)
-		      (setq appt-time-msg-list
+		      (setq appt-time-msg-list (cdr appt-time-msg-list)
-			    (cdr appt-time-msg-list)
 			    appt-display-count nil)))))
 	  ;; If we have changed the mode line string,
 	  ;; redisplay all mode lines.
 	  (and appt-display-mode-line
 		 (if appt-mode-string
 		     (sit-for 0)))))))))
 (defun appt-disp-window (min-to-app new-time appt-msg)
-"Display appointment message APPT-MSG in a separate buffer."
+"Display appointment message APPT-MSG in a separate buffer.
+The appointment is due in MIN-TO-APP (a string) minutes.
+NEW-TIME is a string giving the date."
 (require 'electric)
 ;; Make sure we're not in the minibuffer
 ;; before splitting the window.
 (if (other-window 1)
 	  (select-window (other-window 1))
 	(if (display-multi-frame-p)
 	    (select-frame (other-frame 1)))))
-(let* ((this-buffer (current-buffer))
+(let ((this-window (selected-window))
-	 (this-window (selected-window))
+(appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
-	 (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
 (if (cdr (assq 'unsplittable (frame-parameters)))
 	;; In an unsplittable frame, use something somewhere else.
 	(display-buffer appt-disp-buf)
 (unless (or (special-display-p (buffer-name appt-disp-buf))
 		  (same-window-p (buffer-name appt-disp-buf)))
 	;; By default, split the bottom window and use the lower part.
 	(appt-select-lowest-window)
-	(split-window))
+(select-window (split-window)))
-(pop-to-buffer appt-disp-buf))
+(switch-to-buffer appt-disp-buf))
-(setq mode-line-format
+(calendar-set-mode-line
-	  (concat "-------------------- Appointment in "
+(format " Appointment in %s minutes. %s " min-to-app new-time))
-		  min-to-app " minutes. " new-time " %-"))
 (erase-buffer)
 (insert appt-msg)
 (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
 (set-buffer-modified-p nil)
 (raise-frame (selected-frame))
-(select-window this-window)
+(select-window this-window)))
-(if appt-audible
-	(beep 1))))
 (defun appt-delete-window ()
 "Function called to undisplay appointment messages.
 Usually just deletes the appointment buffer."
 (let ((window (get-buffer-window appt-buffer-name t)))
 		      (when (< bottom-edge next-bottom-edge)
 			(setq bottom-edge next-bottom-edge
 			      lowest-window w)))))
 (select-window lowest-window)))
+(defconst appt-time-regexp
+"[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?")
 ;;;###autoload
 (defun appt-add (new-appt-time new-appt-msg)
-"Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG.
+"Add an appointment for today at NEW-APPT-TIME with message NEW-APPT-MSG.
 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)
+(unless (string-match appt-time-regexp 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))))
+(time-msg (list appt-time appt-time-string t)))
 (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg)))
 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
 ;;;###autoload
 (defun appt-delete ()
 "Delete an appointment from the list of appointments."
 (interactive)
-(let* ((tmp-msg-list appt-time-msg-list))
+(let ((tmp-msg-list appt-time-msg-list))
 (while tmp-msg-list
 (let* ((element (car tmp-msg-list))
 (prompt-string (concat "Delete "
 				    ;; We want to quote any doublequotes
 				    ;; in the string, as well as put
 (eval-when-compile (defvar number)
 		   (defvar original-date)
 		   (defvar diary-entries-list))
 ;;;###autoload
 (defun appt-make-list ()
-"Create the appointments list from todays diary buffer.
+"Update the appointments list from today's diary buffer.
 The time must be at the beginning of a line for it to be
-put in the appointments list.
+put in the appointments list (see examples in documentation of
-02/23/89
+the function `appt-check').  We assume that the variables DATE and
-12:00pm lunch
+NUMBER hold the arguments that `list-diary-entries' received.
-Wednesday
+They specify the range of dates that the diary is being processed for.
-10:00am group meeting
-We assume that the variables DATE and NUMBER
+Any appointments made with `appt-add' are not affected by this
-hold the arguments that `list-diary-entries' received.
+function.
-They specify the range of dates that the diary is being processed for."
+For backwards compatibility, this function activates the
-;; We have something to do if the range of dates that the diary is
+appointment package (if it is not already active)."
-;; considering includes the current date.
+;; See comments above appt-activate defun.
-(if (and (not (calendar-date-compare
+(if (not appt-timer)
-		 (list (calendar-current-date))
+(appt-activate 1)
-		 (list original-date)))
+;; We have something to do if the range of dates that the diary is
-	   (calendar-date-compare
+;; considering includes the current date.
-	    (list (calendar-current-date))
+(if (and (not (calendar-date-compare
-(list (calendar-gregorian-from-absolute
+(list (calendar-current-date))
-		   (+ (calendar-absolute-from-gregorian original-date)
+(list original-date)))
-		      number)))))
+(calendar-date-compare
-(save-excursion
+(list (calendar-current-date))
-	;; Clear the appointments list, then fill it in from the diary.
+(list (calendar-gregorian-from-absolute
-	(setq appt-time-msg-list nil)
+(+ (calendar-absolute-from-gregorian original-date)
-	(if diary-entries-list
+number)))))
+(save-excursion
-	    ;; Cycle through the entry-list (diary-entries-list)
+;; Clear the appointments list, then fill it in from the diary.
-	    ;; looking for entries beginning with a time. If
+(dolist (elt appt-time-msg-list)
-	    ;; the entry begins with a time, add it to the
+;; Delete any entries that were not made with appt-add.
-	    ;; appt-time-msg-list. Then sort the list.
+(unless (nth 2 elt)
+(setq appt-time-msg-list
-	    (let ((entry-list diary-entries-list)
+(delq elt appt-time-msg-list))))
-		  (new-time-string ""))
+(if diary-entries-list
-	      ;; Skip diary entries for dates before today.
-	      (while (and entry-list
+;; Cycle through the entry-list (diary-entries-list)
-			  (calendar-date-compare
+;; looking for entries beginning with a time. If
-			   (car entry-list) (list (calendar-current-date))))
+;; the entry begins with a time, add it to the
-		(setq entry-list (cdr entry-list)))
+;; appt-time-msg-list. Then sort the list.
-	      ;; Parse the entries for today.
-	      (while (and entry-list
+(let ((entry-list diary-entries-list)
-			  (calendar-date-equal
+(new-time-string ""))
-			   (calendar-current-date) (car (car entry-list))))
+;; Skip diary entries for dates before today.
-		(let ((time-string (cadr (car entry-list))))
+(while (and entry-list
-		  (while (string-match
+(calendar-date-compare
-			  "\\([0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\).*"
+(car entry-list) (list (calendar-current-date))))
-			  time-string)
+(setq entry-list (cdr entry-list)))
-		    (let* ((beg (match-beginning 0))
+;; Parse the entries for today.
-			   ;; Get just the time for this appointment.
+(while (and entry-list
-			   (only-time (match-string 1 time-string))
+(calendar-date-equal
-			   ;; Find the end of this appointment
+(calendar-current-date) (car (car entry-list))))
-			   ;; (the start of the next).
+(let ((time-string (cadr (car entry-list))))
-			   (end (string-match
+(while (string-match appt-time-regexp time-string)
-				 "^[ \t]*[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
+(let* ((beg (match-beginning 0))
-				 time-string
+;; Get just the time for this appointment.
-				 (match-end 0)))
+(only-time (match-string 0 time-string))
-			   ;; Get the whole string for this appointment.
+;; Find the end of this appointment
-			   (appt-time-string
+;; (the start of the next).
-			    (substring time-string beg (if end (1- end)))))
+(end (string-match
+(concat "\n[ \t]*" appt-time-regexp)
-		      ;; Add this appointment to appt-time-msg-list.
+time-string
-		      (let* ((appt-time (list (appt-convert-time only-time)))
+(match-end 0)))
-			     (time-msg (list appt-time appt-time-string)))
+;; Get the whole string for this appointment.
-			(setq appt-time-msg-list
+(appt-time-string
-			      (nconc appt-time-msg-list (list time-msg))))
+(substring time-string beg (if end (1- end)))))
-		      ;; Discard this appointment from the string.
+;; Add this appointment to appt-time-msg-list.
-		      (setq time-string
+(let* ((appt-time (list (appt-convert-time only-time)))
-			    (if end (substring time-string end) "")))))
+(time-msg (list appt-time appt-time-string)))
-		(setq entry-list (cdr entry-list)))))
+(setq appt-time-msg-list
-	(setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
+(nconc appt-time-msg-list (list time-msg))))
-	;; Get the current time and convert it to minutes
+;; Discard this appointment from the string.
-	;; from midnight. ie. 12:01am = 1, midnight = 0,
+(setq time-string
-	;; so that the elements in the list
+(if end (substring time-string end) "")))))
-	;; that are earlier than the present time can
+(setq entry-list (cdr entry-list)))))
-	;; be removed.
+(setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
-	(let* ((now (decode-time))
+;; Get the current time and convert it to minutes
-	       (cur-hour (nth 2 now))
+;; from midnight. ie. 12:01am = 1, midnight = 0,
-	       (cur-min (nth 1 now))
+;; so that the elements in the list
-	       (cur-comp-time (+ (* cur-hour 60) cur-min))
+;; that are earlier than the present time can
-	       (appt-comp-time (car (car (car appt-time-msg-list)))))
+;; be removed.
-	  (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
+(let* ((now (decode-time))
-	    (setq appt-time-msg-list (cdr appt-time-msg-list))
+(cur-hour (nth 2 now))
-	    (if appt-time-msg-list
+(cur-min (nth 1 now))
-		(setq appt-comp-time (car (car (car appt-time-msg-list))))))))))
+(cur-comp-time (+ (* cur-hour 60) cur-min))
+(appt-comp-time (car (caar 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 (caar appt-time-msg-list))))))))))
 (defun appt-sort-list (appt-list)
-"Simple sort to put the appointments list APPT-LIST in order.
+"Sort an appointment list, putting earlier items at the front.
-Scan the list for the smallest element left in the list.
+APPT-LIST is a list of the same format as `appt-time-msg-list'."
-Append the smallest element left into the new list, and remove
+(sort appt-list (lambda (e1 e2) (< (caar e1) (caar e2)))))
-it from the original list."
-(let ((order-list nil))
-(while appt-list
-(let* ((element (car appt-list))
-(element-time (car (car element)))
-(tmp-list (cdr appt-list)))
-(while tmp-list
-(if (< element-time (car (car (car tmp-list))))
-nil
-(setq element (car tmp-list))
-(setq element-time (car (car element))))
-(setq tmp-list (cdr tmp-list)))
-(setq order-list (nconc order-list (list element)))
-(setq appt-list (delq element appt-list))))
-order-list))
 (defun appt-convert-time (time2conv)
-"Convert hour:min[am/pm] format to minutes from midnight."
+"Convert hour:min[am/pm] format to minutes from midnight.
+A period (.) can be used instead of a colon (:) to separate the
-(let ((conv-time 0)
+hour and minute parts."
-(hr 0)
+;; Formats that should be accepted:
-(min 0))
+;;   10:00 10.00 10h00 10h 10am 10:00am 10.00am
+(let ((min (if (string-match "[h:.]\\([0-9][0-9]\\)" time2conv)
-(string-match ":\\([0-9][0-9]\\)" time2conv)
+(string-to-number (match-string 1 time2conv))
-(setq min (string-to-int
+0))
-(match-string 1 time2conv)))
+(hr (if (string-match "[0-9]*[0-9]" time2conv)
+(string-to-number (match-string 0 time2conv))
-(string-match "[0-9]?[0-9]:" time2conv)
+0)))
-(setq hr (string-to-int
-(match-string 0 time2conv)))
 ;; convert the time appointment time into 24 hour time
 (cond ((and (string-match "pm" time2conv) (< hr 12))
 	   (setq hr (+ 12 hr)))
 	  ((and (string-match "am" time2conv) (= hr 12))
 (setq hr 0)))
-;; convert the actual time
+;; convert the actual time into minutes.
-;; into minutes for comparison
+(+ (* hr 60) min)))
-;; against the actual time.
-(setq conv-time (+ (* hr 60) min))
+(defun appt-update-list ()
-conv-time))
+"If the current buffer is visiting the diary, update appointments.
+This function is intended for use with `write-file-functions'."
-(defvar appt-timer nil
+(and (string-equal buffer-file-name (expand-file-name diary-file))
-"Timer used for diary appointment notifications (`appt-check').")
+appt-timer
+(let ((appt-display-diary nil))
-(unless appt-timer
+(appt-check t)))
-(setq appt-timer (run-at-time t 60 'appt-check)))
+nil)
-(or global-mode-string (setq global-mode-string '("")))
-(or (memq 'appt-mode-string global-mode-string)
+;; In Emacs-21.3, the manual documented the following procedure to
-(setq global-mode-string
+;; activate this package:
-	  (append global-mode-string '(appt-mode-string))))
+;;     (display-time)
+;;     (add-hook 'diary-hook 'appt-make-list)
+;;     (diary 0)
+;; The display-time call was not necessary, AFAICS.
+;; What was really needed was to add the hook and load this file.
+;; Calling (diary 0) once the hook had been added was in some sense a
+;; roundabout way of loading this file. This file used to have code at
+;; the top-level that set up the appt-timer and global-mode-string.
+;; One way to maintain backwards compatibility would be to call
+;; (appt-activate 1) at top-level. However, this goes against the
+;; convention that just loading an Emacs package should not activate
+;; it. Instead, we make appt-make-list activate the package (after a
+;; suggestion from rms). This means that one has to call diary in
+;; order to get it to work, but that is in line with the old (weird,
+;; IMO) documented behavior for activating the package.
+;; Actually, since (diary 0) does not run diary-hook, I don't think
+;; the documented behavior in Emacs-21.3 would ever have worked.
+;; Oh well, at least with the changes to appt-make-list it will now
+;; work as well as it ever did.
+;; The new method is just to use (appt-activate 1).
+;; -- gmorris
+;;;###autoload
+(defun appt-activate (&optional arg)
+"Toggle checking of appointments.
+With optional numeric argument ARG, turn appointment checking on if
+ARG is positive, otherwise off."
+(interactive "P")
+(let ((appt-active appt-timer))
+(setq appt-active (if arg (> (prefix-numeric-value arg) 0)
+(not appt-active)))
+(remove-hook 'write-file-functions 'appt-update-list)
+(or global-mode-string (setq global-mode-string '("")))
+(delq 'appt-mode-string global-mode-string)
+(when appt-timer
+(cancel-timer appt-timer)
+(setq appt-timer nil))
+(when appt-active
+(add-hook 'write-file-functions 'appt-update-list)
+(setq appt-timer (run-at-time t 60 'appt-check)
+global-mode-string
+(append global-mode-string '(appt-mode-string)))
+(appt-check t))))
+(provide 'appt)
+;; arch-tag: bf5791c4-8921-499e-a26f-772b1788d347
 ;;; appt.el ends here

Mercurial > emacs

comparison lisp/calendar/appt.el @ 88155:d7ddb3e565de