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) |
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. |