;; TODO Turn this into an alist? It would be easier to add more
;; optional elements.
-;; TODO There should be a way to set WARNTIME (and other properties)
-;; from the diary-file. Implementing that would be a good reason
-;; to change this to an alist.
+;; Why is the first element (MINUTES) rather than just MINUTES?
+;; It may just inherit from diary-entries-list, where we have
+;; ((MONTH DAY YEAR) ENTRY)
(defvar appt-time-msg-list nil
"The list of appointments for today.
Use `appt-add' and `appt-delete' to add and delete appointments.
The original list is generated from today's `diary-entries-list', and
can be regenerated using the function `appt-check'.
Each element of the generated list has the form
-\(MINUTES STRING [FLAG] [WARNTIME])
+\((MINUTES) STRING [FLAG] [WARNTIME])
where MINUTES is the time in minutes of the appointment after midnight,
and STRING is the description of the appointment.
FLAG and WARNTIME are not always present. A non-nil FLAG
(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)
+ now now-mins appt-mins appt-warn-time)
(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)))
+ now-mins (+ (* 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
;; 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
+ (setq appt-prev-comp-time now-mins
appt-mode-string nil
appt-display-count nil)
+ ;; 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?
+ (while (and appt-time-msg-list
+ (< (setq appt-mins (caar (car appt-time-msg-list)))
+ now-mins))
+ (setq appt-time-msg-list (cdr appt-time-msg-list)))
;; 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))
+ (setq 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)))))
+ 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
;; 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)))
+ ;; 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
;; 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))
(when appt-display-mode-line
(setq appt-mode-string
(concat " " (propertize
- (format "App't in %s min." min-to-app)
+ (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 nil)
+ (setq appt-display-count (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.
;; Get the whole string for this appointment.
(appt-time-string
(substring time-string beg end))
+ ;; FIXME why the list? It makes the first
+ ;; element (MINUTES) rather than MINUTES.
(appt-time (list (appt-convert-time only-time)))
(time-msg (append
(list appt-time appt-time-string)
(setq entry-list (cdr entry-list)))))
(setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
;; Convert current time to minutes after midnight (12:01am = 1),
- ;; so that elements in the list that are earlier than the
- ;; present time can be removed.
+ ;; and remove elements in the list that are in the past.
(let* ((now (decode-time))
- (cur-comp-time (+ (* 60 (nth 2 now)) (nth 1 now)))
- (appt-comp-time (caar (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 (caar (car appt-time-msg-list)))))))))
+ (now-mins (+ (* 60 (nth 2 now)) (nth 1 now))))
+ (while (and appt-time-msg-list
+ (< (caar (car appt-time-msg-list)) now-mins))
+ (setq appt-time-msg-list (cdr appt-time-msg-list)))))))
(defun appt-sort-list (appt-list)
HCoop / bpt / emacs.git / blobdiff