X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/a54640143dc093c1d3572f344b231da2d4508c8f..78be8b64657aeca0472d708450ea1ce2bc142606:/lisp/calendar/appt.el diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index 25f3ae0e8e..ea3a5b2caf 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -1,7 +1,7 @@ ;;; appt.el --- appointment notification functions -;; Copyright (C) 1989-1990, 1994, 1998, 2001-2011 -;; Free Software Foundation, Inc. +;; Copyright (C) 1989-1990, 1994, 1998, 2001-2013 Free Software +;; Foundation, Inc. ;; Author: Neil Mager ;; Maintainer: Glenn Morris @@ -62,15 +62,10 @@ ;; `appt-check' reads. ;; ;; You can change the way the appointment window is created/deleted by -;; setting the variables -;; -;; appt-disp-window-function -;; and -;; appt-delete-window-function -;; -;; 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. +;; setting the variables `appt-disp-window-function' and +;; `appt-delete-window-function'. For instance, you could be set them +;; to functions that display appointments in pop-up frames, which are +;; lowered or iconified after `appt-display-interval' minutes. ;; ;;; Code: @@ -84,7 +79,8 @@ :group 'calendar) (defcustom appt-message-warning-time 12 - "Default time in minutes before an appointment that the warning begins." + "Default time in minutes before an appointment that the warning begins. +You probably want to make `appt-display-interval' a factor of this." :type 'integer :group 'appt) @@ -122,7 +118,9 @@ See also `appt-audible' and `appt-display-mode-line'." (defcustom appt-display-mode-line t "Non-nil means display minutes to appointment and time on the mode line. -This is in addition to any other display of appointment messages." +This is in addition to any other display of appointment messages. +The mode line updates every minute, independent of the value of +`appt-display-interval'." :type 'boolean :group 'appt) @@ -134,12 +132,21 @@ Only relevant if reminders are to be displayed in their own window." (defcustom appt-display-diary t "Non-nil displays the diary when the appointment list is first initialized. -This will occur at midnight when the appointment list is updated." +This occurs when this package is first activated, and then at +midnight when the appointment list updates." :type 'boolean :group 'appt) (defcustom appt-display-interval 3 - "Number of minutes to wait between checking the appointment list." + "Interval in minutes at which to display appointment reminders. +Once an appointment becomes due, Emacs displays reminders every +`appt-display-interval' minutes. You probably want to make +`appt-message-warning-time' be a multiple of this, so that you get +a final message displayed precisely when the appointment is due. + +Note that this variable controls the interval at which +`appt-display-message' is called. The mode line display (if active) +always updates every minute." :type 'integer :group 'appt) @@ -147,16 +154,16 @@ This will occur at midnight when the appointment list is updated." "Function called to display appointment window. Only relevant if reminders are being displayed in a window. It should take three string arguments: the number of minutes till -the appointment, the current time, and the text of the appointment." - :type '(choice (const appt-disp-window) - function) +the appointment, the current time, and the text of the appointment. +Each argument may also be a list, if multiple appointments are +relevant at any one time." + :type '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) + :type 'function :group 'appt) @@ -194,10 +201,9 @@ Only used if `appt-display-mode-line' is non-nil.") (put 'appt-mode-string 'risky-local-variable t) ; for 'face property (defvar appt-prev-comp-time nil - "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.") + "Time of day (mins since midnight) at which we last checked appointments.") -(defvar appt-display-count nil +(defvar appt-display-count 0 "Internal variable used to count number of consecutive reminders.") (defvar appt-timer nil @@ -210,21 +216,60 @@ If this is non-nil, appointment checking is active.") (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." +The arguments may also be lists, where each element relates to a +separate appointment. The variable `appt-display-format' controls +the format of the visible reminder. If `appt-audible' is non-nil, +also calls `beep' for an audible reminder." (if appt-audible (beep 1)) + ;; Backwards compatibility: avoid passing lists to a-d-w-f if not necessary. + (and (listp mins) + (= (length mins) 1) + (setq mins (car mins) + string (car string))) (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) + ;; TODO use calendar-month-abbrev-array rather than %b? + (let ((time (format-time-string "%a %b %e " (current-time))) + err) + (condition-case err + (funcall appt-disp-window-function + (if (listp mins) + (mapcar 'number-to-string mins) + (number-to-string mins)) + time string) + (wrong-type-argument + (if (not (listp mins)) + (signal (car err) (cdr err)) + (message "Argtype error in `appt-disp-window-function' - \ +update it for multiple appts?") + ;; Fallback to just displaying the first appt, as we used to. + (funcall appt-disp-window-function + (number-to-string (car mins)) time + (car string)))))) (run-at-time (format "%d sec" appt-display-duration) nil appt-delete-window-function)) ((eq appt-display-format 'echo) - (message "%s" string)))) - + (message "%s" (if (listp string) + (mapconcat 'identity string "\n") + string))))) + +(defun appt-mode-line (min-to-app &optional abbrev) + "Return an appointment string suitable for use in the mode-line. +MIN-TO-APP is a list of minutes, as strings. +If ABBREV is non-nil, abbreviates some text." + ;; All this silliness is just to make the formatting slightly nicer. + (let* ((multiple (> (length min-to-app) 1)) + (imin (if (or (not multiple) + (not (delete (car min-to-app) min-to-app))) + (car min-to-app)))) + (format "%s%s %s" + (if abbrev "App't" "Appointment") + (if multiple "s" "") + (if (equal imin "0") "now" + (format "in %s %s" + (or imin (mapconcat 'identity min-to-app ",")) + (if abbrev "min." + (format "minute%s" (if (equal imin "1") "" "s")))))))) (defun appt-check (&optional force) "Check for an appointment and update any reminder display. @@ -249,29 +294,28 @@ The following variables control appointment notification: Controls the format in which reminders are displayed. `appt-audible' - Variable used to determine if reminder is audible. - Default is t. + Non-nil means there is an audible component to reminders. `appt-message-warning-time' - Variable used to determine when appointment message - should first be displayed. + The default number of minutes in advance at which reminders + should start. `appt-display-mode-line' - If non-nil, a generic message giving the time remaining - is shown in the mode-line when an appointment is due. + Non-nil means show in the mode line a countdown to the + time of each appointment, once reminders start. `appt-display-interval' - Interval in minutes at which to check for pending appointments. + Interval in minutes at which to display appointment messages. `appt-display-diary' - Display the diary buffer when the appointment list is - initialized for the first time in a day. + Non-nil means display the diary whenever the appointment list is + initialized (e.g. the first time we check for appointments each day). The following variables are only relevant if reminders are being displayed in a window: `appt-display-duration' - The number of seconds an appointment message is displayed. + Number of seconds for which an appointment message is displayed. `appt-disp-window-function' Function called to display appointment window. @@ -279,18 +323,17 @@ displayed in a window: `appt-delete-window-function' Function called to remove appointment window and buffer." (interactive "P") ; so people can force updates - (let* ((min-to-app -1) - (prev-appt-mode-string appt-mode-string) - (prev-appt-display-count (or appt-display-count 0)) - now cur-comp-time appt-comp-time appt-warn-time) + (let* ((prev-appt-mode-string appt-mode-string) + (prev-appt-display-count appt-display-count) + ;; Convert current time to minutes after midnight (12.01am = 1). + (now (decode-time)) + (now-mins (+ (* 60 (nth 2 now)) (nth 1 now))) + appt-mins appt-warn-time min-to-app min-list string-list) (save-excursion ; FIXME ? - ;; Convert current time to minutes after midnight (12.01am = 1). - (setq now (decode-time) - cur-comp-time (+ (* 60 (nth 2 now)) (nth 1 now))) ;; At first check in any day, update appointments to today's list. (if (or force ; eg initialize, diary save (null appt-prev-comp-time) ; first check - (< cur-comp-time appt-prev-comp-time)) ; new day + (< now-mins appt-prev-comp-time)) ; new day (ignore-errors (let ((diary-hook (if (assoc 'appt-make-list diary-hook) diary-hook @@ -301,61 +344,76 @@ displayed in a window: ;; diary-number-of-entries. Since appt.el only ;; works on a daily basis, no need for more entries. (diary-list-entries (calendar-current-date) 1 t))))) - (setq appt-prev-comp-time cur-comp-time + ;; Reset everything now in case we somehow missed a minute, + ;; or (more likely) an appt was deleted. (This is the only + ;; reason we need prev-appt-display-count.) + (setq appt-prev-comp-time now-mins appt-mode-string 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. - (when appt-time-msg-list - (setq appt-comp-time (caar (car appt-time-msg-list)) - appt-warn-time (or (nth 3 (car appt-time-msg-list)) - appt-message-warning-time) - 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 (caar (car appt-time-msg-list))))) - ;; If we have an appointment between midnight and - ;; `appt-warn-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. - (if (and (< appt-comp-time appt-warn-time) - (> (+ cur-comp-time appt-warn-time) - appt-max-time)) - (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time) - appt-comp-time))) - ;; Issue warning if the appointment time is within - ;; appt-message-warning time. - (when (and (<= min-to-app appt-warn-time) - (>= min-to-app 0)) - (setq appt-display-count (1+ prev-appt-display-count)) - ;; This is true every appt-display-interval minutes. - (and (zerop (mod prev-appt-display-count appt-display-interval)) - (appt-display-message (cadr (car appt-time-msg-list)) - min-to-app)) - (when appt-display-mode-line - (setq appt-mode-string - (concat " " (propertize - (format "App't %s" - (if (zerop min-to-app) "NOW" - (format "in %s min." min-to-app))) - 'face 'mode-line-emphasis)))) - ;; 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 (zerop min-to-app) - (setq appt-time-msg-list (cdr appt-time-msg-list) - appt-display-count nil)))) + appt-display-count 0) + ;; If there are entries in the list get each time off of the + ;; list and calculate the number of minutes until the appointment. + ;; TODO we are looping over all the appointments each time. + ;; We could instead sort them by the time at which we need to + ;; start warning. But then removing entries in the past becomes + ;; less straightforward. + (dolist (appt appt-time-msg-list) + ;; Remove any entries that are in the past. + ;; FIXME how can there be any such entries, given that this + ;; function removes entries when they hit zero minutes, + ;; and appt-make-list doesn't add any in the past in the first place? + (if (< (setq appt-mins (caar appt)) now-mins) + (setq appt-time-msg-list (cdr appt-time-msg-list)) + (setq appt-warn-time (or (nth 3 appt) appt-message-warning-time) + min-to-app (- appt-mins now-mins)) + ;; If we have an appointment between midnight and + ;; `appt-warn-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. + ;; FIXME but appt-make-list constructs appt-time-msg-list to only + ;; contain entries with today's date, so this cannot work? + ;; Also above we just removed anything with appt-mins < now-mins. + (if (and (< appt-mins appt-warn-time) + (> (+ now-mins appt-warn-time) appt-max-time)) + (setq min-to-app (+ (- (1+ appt-max-time) now-mins) + appt-mins))) + ;; Issue warning if the appointment time is within the warning time. + (when (and (<= min-to-app appt-warn-time) + (>= min-to-app 0)) + (push min-to-app min-list) + (push (cadr appt) string-list) + ;; When an appointment is reached, delete it from the list. + (if (zerop min-to-app) + (setq appt-time-msg-list (delete appt appt-time-msg-list)))))) + (when min-list + (setq min-list (nreverse min-list) + string-list (nreverse string-list)) + ;; This is true every appt-display-interval minutes from the + ;; time at which we first started reminding. + ;; TODO in the case of multiple appointments, whose interval + ;; should we respect? The first one that we started warning about? + ;; That's what we do now, and this makes sense if you interpret + ;; a-d-i as "don't remind me any more frequently than this". + ;; But should we always show a message when a new appt becomes due? + ;; When one appt gets removed, should we switch to the interval + ;; of the next? + (and (zerop (mod prev-appt-display-count appt-display-interval)) + (appt-display-message string-list min-list)) + (when appt-display-mode-line + (setq appt-mode-string + (concat " " (propertize + (appt-mode-line (mapcar 'number-to-string + min-list) t) + 'face 'mode-line-emphasis)))) + ;; Reset count to 0 in case we display another appt on the next cycle. + (setq appt-display-count (if (eq '(0) min-list) 0 + (1+ prev-appt-display-count)))) ;; If we have changed the mode line string, redisplay all mode lines. (and appt-display-mode-line - (not (string-equal appt-mode-string - prev-appt-mode-string)) + (not (string-equal appt-mode-string prev-appt-mode-string)) (progn (force-mode-line-update t) ;; If the string now has a notification, redisplay right now. @@ -364,8 +422,10 @@ displayed in a window: (defun appt-disp-window (min-to-app new-time appt-msg) "Display appointment due in MIN-TO-APP (a string) minutes. -NEW-TIME is a string giving the date. Displays the appointment -message APPT-MSG in a separate buffer." +NEW-TIME is a string giving the current date. +Displays the appointment message APPT-MSG in a separate buffer. +The arguments may also be lists, where each element relates to a +separate appointment." (let ((this-window (selected-window)) (appt-disp-buf (get-buffer-create appt-buffer-name))) ;; Make sure we're not in the minibuffer before splitting the window. @@ -386,17 +446,29 @@ message APPT-MSG in a separate buffer." (when (>= (window-height) (* 2 window-min-height)) (select-window (split-window)))) (switch-to-buffer appt-disp-buf)) + (or (listp min-to-app) + (setq min-to-app (list min-to-app) + appt-msg (list appt-msg))) + ;; I don't really see the point of the new-time argument. + ;; It repeatedly reminds you of the date? + ;; It would make more sense if it was eg the time of the appointment. + ;; Let's allow it to be a list or not independent of the other elements. + (or (listp new-time) + (setq new-time (list new-time))) ;; FIXME Link to diary entry? (calendar-set-mode-line - (format " Appointment %s. %s " - (if (string-equal "0" min-to-app) "now" - (format "in %s minute%s" min-to-app - (if (string-equal "1" min-to-app) "" "s"))) - new-time)) + (format " %s. %s" (appt-mode-line min-to-app) + (mapconcat 'identity new-time ", "))) (setq buffer-read-only nil buffer-undo-list t) (erase-buffer) - (insert appt-msg) + ;; If we have appointments at different times, prepend the times. + (if (or (= 1 (length min-to-app)) + (not (delete (car min-to-app) min-to-app))) + (insert (mapconcat 'identity appt-msg "\n")) + (dotimes (i (length appt-msg)) + (insert (format "%s%sm: %s" (if (> i 0) "\n" "") + (nth i min-to-app) (nth i appt-msg))))) (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t)) (set-buffer-modified-p nil) (setq buffer-read-only t) @@ -436,7 +508,7 @@ The time should be in either 24 hour format or am/pm format. Optional argument WARNTIME is an integer (or string) giving the number of minutes before the appointment at which to start warning. The default is `appt-message-warning-time'." - (interactive "sTime (hh:mm[am/pm]): \nsMessage: + (interactive "sTime (hh:mm[am/pm]): \nsMessage: \n\ sMinutes before the appointment to start warning: ") (unless (string-match appt-time-regexp time) (error "Unacceptable time-string")) @@ -449,7 +521,7 @@ sMinutes before the appointment to start warning: ") (or appt-timer (appt-activate)) (let ((time-msg (list (list (appt-convert-time time)) (concat time " " msg) t))) - ;; It is presently non-sensical to have multiple warnings about + ;; It is presently nonsensical to have multiple warnings about ;; the same appointment with just different delays, but it might ;; not always be so. TODO (if warntime (setq time-msg (append time-msg (list warntime))))