Function: appt-make-list

appt-make-list is a byte-compiled function defined in appt.el.gz.

Signature

(appt-make-list)

Documentation

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 (see examples in documentation of the function appt-check). We assume that the variables original-date and number hold the arguments that diary-list-entries received. They specify the range of dates that the diary is being processed for.

Any appointments made with appt-add are not affected by this function.

Probably introduced at or before Emacs version 24.1.

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/appt.el.gz
(defun appt-make-list ()
  "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 (see examples in documentation of
the function `appt-check').  We assume that the variables `original-date' and
`number' hold the arguments that `diary-list-entries' received.
They specify the range of dates that the diary is being processed for.

Any appointments made with `appt-add' are not affected by this function."
  (with-no-warnings (defvar number) (defvar original-date))
  ;; We have something to do if the range of dates that the diary is
  ;; considering includes the current date.
  (if (and (not (calendar-date-compare
                 (list (calendar-current-date))
                 (list original-date)))
           (calendar-date-compare
            (list (calendar-current-date))
            (list (calendar-gregorian-from-absolute
                   (+ (calendar-absolute-from-gregorian original-date)
                      number)))))
      (save-excursion
        ;; Clear the appointments list, then fill it in from the diary.
        (dolist (elt appt-time-msg-list)
          ;; Delete any entries that were not made with appt-add.
          (unless (nth 2 elt)
            (setq appt-time-msg-list
                  (delq elt appt-time-msg-list))))
        (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)
                  time-string literal)
              ;; Below, we assume diary-entries-list was in date
              ;; order.  It is, unless something on
              ;; diary-list-entries-hook has changed it, eg
              ;; diary-include-other-files (bug#7019).  It must be
              ;; in date order if number = 1.
              (and diary-list-entries-hook
                   appt-display-diary
                   (not (eq diary-number-of-entries 1))
                   (not (memq (car (last diary-list-entries-hook))
                              '(diary-sort-entries sort-diary-entries)))
                   (setq entry-list (sort entry-list 'diary-entry-compare)))
              ;; Skip diary entries for dates before today.
              (while (and entry-list
                          (calendar-date-compare
                           (car entry-list) (list (calendar-current-date))))
                (setq entry-list (cdr entry-list)))
              ;; Parse the entries for today.
              (while (and entry-list
                          (calendar-date-equal
                           (calendar-current-date) (caar entry-list)))
                (setq time-string (cadr (car entry-list))
                      ;; Including any comments.
                      literal (or (nth 2 (nth 3 (car entry-list)))
                                  time-string))
                (while (string-match appt-time-regexp time-string)
                  (let* ((beg (match-beginning 0))
                         ;; Get just the time for this appointment.
                         (only-time (match-string 0 time-string))
                         ;; Find the end of this appointment
                         ;; (the start of the next).
                         (end (string-match
                               (concat "\n[ \t]*" appt-time-regexp)
                               time-string
                               (match-end 0)))
                         (warntime
                          (if (string-match appt-warning-time-regexp literal)
                              (string-to-number (match-string 1 literal))))
                         ;; 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)
                                    (if warntime (list nil warntime)))))
                    ;; Add this appointment to appt-time-msg-list.
                    (setq appt-time-msg-list
                          (nconc appt-time-msg-list (list time-msg))
                          ;; Discard this appointment from the string.
                          ;; (This allows for multiple appts per entry.)
                          time-string
                          (if end (substring time-string end) ""))
                    ;; Similarly, discard the start of literal.
                    (and (> (length time-string) 0)
                         (string-match appt-time-regexp literal)
                         (setq end (string-match
                                    (concat "\n[ \t]*" appt-time-regexp)
                                    literal (match-end 0)))
                         (setq literal (substring literal end)))))
                (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),
        ;; and remove elements in the list that are in the past.
        (let* ((now (decode-time))
               (now-mins (+ (* 60 (decoded-time-hour now))
                            (decoded-time-minute 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)))))))