/[emacs]/emacs/lisp/calendar/appt.el
ViewVC logotype

Diff of /emacs/lisp/calendar/appt.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.59 by lektu, Mon May 16 11:11:48 2005 UTC revision 1.60 by gm, Tue Jun 21 13:10:39 2005 UTC
# Line 534  NUMBER hold the arguments that `list-dia Line 534  NUMBER hold the arguments that `list-dia
534  They specify the range of dates that the diary is being processed for.  They specify the range of dates that the diary is being processed for.
535    
536  Any appointments made with `appt-add' are not affected by this  Any appointments made with `appt-add' are not affected by this
537  function."  function.
538    
539    ;; We have something to do if the range of dates that the diary is  For backwards compatibility, this function activates the
540    ;; considering includes the current date.  appointment package (if it is not already active)."
541    (if (and (not (calendar-date-compare    ;; See comments above appt-activate defun.
542                   (list (calendar-current-date))    (if (not appt-timer)
543                   (list original-date)))        (appt-activate 1)
544             (calendar-date-compare      ;; We have something to do if the range of dates that the diary is
545              (list (calendar-current-date))      ;; considering includes the current date.
546              (list (calendar-gregorian-from-absolute      (if (and (not (calendar-date-compare
547                     (+ (calendar-absolute-from-gregorian original-date)                     (list (calendar-current-date))
548                        number)))))                     (list original-date)))
549        (save-excursion               (calendar-date-compare
550          ;; Clear the appointments list, then fill it in from the diary.                (list (calendar-current-date))
551          (dolist (elt appt-time-msg-list)                (list (calendar-gregorian-from-absolute
552            ;; Delete any entries that were not made with appt-add.                       (+ (calendar-absolute-from-gregorian original-date)
553            (unless (nth 2 elt)                          number)))))
554              (setq appt-time-msg-list          (save-excursion
555                    (delq elt appt-time-msg-list))))            ;; Clear the appointments list, then fill it in from the diary.
556          (if diary-entries-list            (dolist (elt appt-time-msg-list)
557                ;; Delete any entries that were not made with appt-add.
558              ;; Cycle through the entry-list (diary-entries-list)              (unless (nth 2 elt)
559              ;; looking for entries beginning with a time. If                (setq appt-time-msg-list
560              ;; the entry begins with a time, add it to the                      (delq elt appt-time-msg-list))))
561              ;; appt-time-msg-list. Then sort the list.            (if diary-entries-list
562    
563              (let ((entry-list diary-entries-list)                ;; Cycle through the entry-list (diary-entries-list)
564                    (new-time-string ""))                ;; looking for entries beginning with a time. If
565                ;; Skip diary entries for dates before today.                ;; the entry begins with a time, add it to the
566                (while (and entry-list                ;; appt-time-msg-list. Then sort the list.
567                            (calendar-date-compare  
568                             (car entry-list) (list (calendar-current-date))))                (let ((entry-list diary-entries-list)
569                  (setq entry-list (cdr entry-list)))                      (new-time-string ""))
570                ;; Parse the entries for today.                  ;; Skip diary entries for dates before today.
571                (while (and entry-list                  (while (and entry-list
572                            (calendar-date-equal                              (calendar-date-compare
573                             (calendar-current-date) (car (car entry-list))))                               (car entry-list) (list (calendar-current-date))))
574                  (let ((time-string (cadr (car entry-list))))                    (setq entry-list (cdr entry-list)))
575                    (while (string-match                  ;; Parse the entries for today.
576                            "\\([0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?\\).*"                  (while (and entry-list
577                            time-string)                              (calendar-date-equal
578                      (let* ((beg (match-beginning 0))                               (calendar-current-date) (car (car entry-list))))
579                             ;; Get just the time for this appointment.                    (let ((time-string (cadr (car entry-list))))
580                             (only-time (match-string 1 time-string))                      (while (string-match
581                             ;; Find the end of this appointment                              "\\([0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?\\).*"
582                             ;; (the start of the next).                              time-string)
583                             (end (string-match                        (let* ((beg (match-beginning 0))
584                                   "^[ \t]*[0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?"                               ;; Get just the time for this appointment.
585                                   time-string                               (only-time (match-string 1 time-string))
586                                   (match-end 0)))                               ;; Find the end of this appointment
587                             ;; Get the whole string for this appointment.                               ;; (the start of the next).
588                             (appt-time-string                               (end (string-match
589                              (substring time-string beg (if end (1- end)))))                                     "^[ \t]*[0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?"
590                                       time-string
591                        ;; Add this appointment to appt-time-msg-list.                                     (match-end 0)))
592                        (let* ((appt-time (list (appt-convert-time only-time)))                               ;; Get the whole string for this appointment.
593                               (time-msg (list appt-time appt-time-string)))                               (appt-time-string
594                          (setq appt-time-msg-list                                (substring time-string beg (if end (1- end)))))
595                                (nconc appt-time-msg-list (list time-msg))))  
596                            ;; Add this appointment to appt-time-msg-list.
597                        ;; Discard this appointment from the string.                          (let* ((appt-time (list (appt-convert-time only-time)))
598                        (setq time-string                                 (time-msg (list appt-time appt-time-string)))
599                              (if end (substring time-string end) "")))))                            (setq appt-time-msg-list
600                  (setq entry-list (cdr entry-list)))))                                  (nconc appt-time-msg-list (list time-msg))))
601          (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))  
602                            ;; Discard this appointment from the string.
603          ;; Get the current time and convert it to minutes                          (setq time-string
604          ;; from midnight. ie. 12:01am = 1, midnight = 0,                                (if end (substring time-string end) "")))))
605          ;; so that the elements in the list                    (setq entry-list (cdr entry-list)))))
606          ;; that are earlier than the present time can            (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
607          ;; be removed.  
608              ;; Get the current time and convert it to minutes
609          (let* ((now (decode-time))            ;; from midnight. ie. 12:01am = 1, midnight = 0,
610                 (cur-hour (nth 2 now))            ;; so that the elements in the list
611                 (cur-min (nth 1 now))            ;; that are earlier than the present time can
612                 (cur-comp-time (+ (* cur-hour 60) cur-min))            ;; be removed.
613                 (appt-comp-time (car (caar appt-time-msg-list))))  
614              (let* ((now (decode-time))
615            (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))                   (cur-hour (nth 2 now))
616              (setq appt-time-msg-list (cdr appt-time-msg-list))                   (cur-min (nth 1 now))
617              (if appt-time-msg-list                   (cur-comp-time (+ (* cur-hour 60) cur-min))
618                  (setq appt-comp-time (car (caar appt-time-msg-list)))))))))                   (appt-comp-time (car (caar appt-time-msg-list))))
619    
620                (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
621                  (setq appt-time-msg-list (cdr appt-time-msg-list))
622                  (if appt-time-msg-list
623                      (setq appt-comp-time (car (caar appt-time-msg-list))))))))))
624    
625    
626  (defun appt-sort-list (appt-list)  (defun appt-sort-list (appt-list)
# Line 665  This function is intended for use with ` Line 670  This function is intended for use with `
670    nil)    nil)
671    
672    
673    ;; In Emacs-21.3, the manual documented the following procedure to
674    ;; activate this package:
675    ;;     (display-time)
676    ;;     (add-hook 'diary-hook 'appt-make-list)
677    ;;     (diary 0)
678    ;; The display-time call was not necessary, AFAICS.
679    ;; What was really needed was to add the hook and load this file.
680    ;; Calling (diary 0) once the hook had been added was in some sense a
681    ;; roundabout way of loading this file. This file used to have code at
682    ;; the top-level that set up the appt-timer and global-mode-string.
683    ;; One way to maintain backwards compatibility would be to call
684    ;; (appt-activate 1) at top-level. However, this goes against the
685    ;; convention that just loading an Emacs package should not activate
686    ;; it. Instead, we make appt-make-list activate the package (after a
687    ;; suggestion from rms). This means that one has to call diary in
688    ;; order to get it to work, but that is in line with the old (weird,
689    ;; IMO) documented behavior for activating the package.
690    ;; Actually, since (diary 0) does not run diary-hook, I don't think
691    ;; the documented behavior in Emacs-21.3 would ever have worked.
692    ;; Oh well, at least with the changes to appt-make-list it will now
693    ;; work as well as it ever did.
694    ;; The new method is just to use (appt-activate 1).
695    ;; -- gmorris
696    
697  ;;;###autoload  ;;;###autoload
698  (defun appt-activate (&optional arg)  (defun appt-activate (&optional arg)
699  "Toggle checking of appointments.  "Toggle checking of appointments.

Legend:
Removed from v.1.59  
changed lines
  Added in v.1.60

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26