/[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.42 by pj, Mon Nov 26 16:19:08 2001 UTC revision 1.42.4.1 by miles, Fri Apr 4 06:20:15 2003 UTC
# Line 34  Line 34 
34  ;;; And to many others for bug fixes and suggestions.  ;;; And to many others for bug fixes and suggestions.
35  ;;;  ;;;
36  ;;;  ;;;
37  ;;; This functions in this file will alert the user of a  ;;; This functions in this file will alert the user of a
38  ;;; pending appointment based on their diary file.  ;;; pending appointment based on their diary file.
39  ;;;  ;;;
40  ;;; A message will be displayed in the mode line of the Emacs buffer  ;;; A message will be displayed in the mode line of the Emacs buffer
41  ;;; and (if you request) the terminal will beep and display a message  ;;; and (if you request) the terminal will beep and display a message
42  ;;; from the diary in the mini-buffer, or you can choose to  ;;; from the diary in the mini-buffer, or you can choose to
43  ;;; have a message displayed in a new buffer.  ;;; have a message displayed in a new buffer.
44  ;;;  ;;;
45  ;;; The variable `appt-message-warning-time' allows the  ;;; The variable `appt-message-warning-time' allows the
46  ;;; user to specify how much notice they want before the appointment. The  ;;; user to specify how much notice they want before the appointment. The
47  ;;; variable `appt-issue-message' specifies whether the user wants  ;;; variable `appt-issue-message' specifies whether the user wants
48  ;;; to to be notified of a pending appointment.  ;;; to be notified of a pending appointment.
49  ;;;  ;;;
50  ;;; In order to use the appt package, you only need  ;;; In order to use the appt package, you only need
51  ;;; to load it---provided you have appointments.  ;;; to load it---provided you have appointments.
52  ;;;  ;;;
53  ;;; Before that, you can also set some options if you want  ;;; Before that, you can also set some options if you want
54  ;;;   (setq view-diary-entries-initially t)  ;;;   (setq view-diary-entries-initially t)
55  ;;;   (setq appt-issue-message t)  ;;;   (setq appt-issue-message t)
56  ;;;  ;;;
57  ;;;  This is an example of what can be in your diary file:  ;;;  This is an example of what can be in your diary file:
58  ;;; Monday  ;;; Monday
59  ;;;   9:30am Coffee break  ;;;   9:30am Coffee break
60  ;;;  12:00pm Lunch          ;;;  12:00pm Lunch
61  ;;;  ;;;
62  ;;; Based upon the above lines in your .emacs and diary files,  ;;; Based upon the above lines in your .emacs and diary files,
63  ;;; the calendar and diary will be displayed when you enter  ;;; the calendar and diary will be displayed when you enter
64  ;;; Emacs and your appointments list will automatically be created.  ;;; Emacs and your appointments list will automatically be created.
65  ;;; You will then be reminded at 9:20am about your coffee break  ;;; You will then be reminded at 9:20am about your coffee break
66  ;;; and at 11:50am to go to lunch.  ;;; and at 11:50am to go to lunch.
67  ;;;  ;;;
68  ;;; Use describe-function on appt-check for a description of other variables  ;;; Use describe-function on appt-check for a description of other variables
69  ;;; that can be used to personalize the notification system.  ;;; that can be used to personalize the notification system.
# Line 146  as the first thing on a line." Line 146  as the first thing on a line."
146    
147  ;;;###autoload  ;;;###autoload
148  (defcustom appt-display-diary t  (defcustom appt-display-diary t
149    "*Non-nil means to display the next days diary on the screen.    "*Non-nil means to display the next days diary on the screen.
150  This will occur at midnight when the appointment list is updated."  This will occur at midnight when the appointment list is updated."
151    :type 'boolean    :type 'boolean
152    :group 'appt)    :group 'appt)
# Line 164  The number before each time/message is t Line 164  The number before each time/message is t
164    "*Number of minutes to wait between checking the appointment list."    "*Number of minutes to wait between checking the appointment list."
165    :type 'integer    :type 'integer
166    :group 'appt)    :group 'appt)
167      
168  (defvar appt-buffer-name " *appt-buf*"  (defvar appt-buffer-name " *appt-buf*"
169    "Name of the appointments buffer.")    "Name of the appointments buffer.")
170      
171  (defvar appt-disp-window-function 'appt-disp-window  (defvar appt-disp-window-function 'appt-disp-window
172    "Function called to display appointment window.")    "Function called to display appointment window.")
173      
174  (defvar appt-delete-window-function 'appt-delete-window  (defvar appt-delete-window-function 'appt-delete-window
175    "Function called to remove appointment window and buffer.")    "Function called to remove appointment window and buffer.")
176    
# Line 192  Note: the time must be the first thing i Line 192  Note: the time must be the first thing i
192  for a warning to be issued.  for a warning to be issued.
193    
194  The format of the time can be either 24 hour or am/pm.  The format of the time can be either 24 hour or am/pm.
195  Example:  Example:
196    
197                 02/23/89                 02/23/89
198                   18:00 Dinner                   18:00 Dinner
199                
200                Thursday                Thursday
201                  11:45am Lunch meeting.                  11:45am Lunch meeting.
202    
# Line 231  The following variables control appointm Line 231  The following variables control appointm
231          Function called to display appointment window.  You can customize          Function called to display appointment window.  You can customize
232          appt.el by setting this variable to a function different from the          appt.el by setting this variable to a function different from the
233          one provided with this package.          one provided with this package.
234      
235  `appt-delete-window-function'  `appt-delete-window-function'
236          Function called to remove appointment window and buffer.  You can          Function called to remove appointment window and buffer.  You can
237          customize appt.el by setting this variable to a function different          customize appt.el by setting this variable to a function different
# Line 264  The following variables control appointm Line 264  The following variables control appointm
264                 (cur-min (nth 1 now))                 (cur-min (nth 1 now))
265                 (cur-comp-time (+ (* cur-hour 60) cur-min)))                 (cur-comp-time (+ (* cur-hour 60) cur-min)))
266    
267            ;; At the first check in any given day, update our            ;; At the first check in any given day, update our
268            ;; appointments to today's list.            ;; appointments to today's list.
269    
270            (if (or (null appt-prev-comp-time)            (if (or (null appt-prev-comp-time)
# Line 290  The following variables control appointm Line 290  The following variables control appointm
290                (let ((appt-comp-time (car (car (car appt-time-msg-list)))))                (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
291                  (setq min-to-app (- appt-comp-time cur-comp-time))                  (setq min-to-app (- appt-comp-time cur-comp-time))
292    
293                  (while (and appt-time-msg-list                  (while (and appt-time-msg-list
294                              (< appt-comp-time cur-comp-time))                              (< appt-comp-time cur-comp-time))
295                    (setq appt-time-msg-list (cdr appt-time-msg-list))                    (setq appt-time-msg-list (cdr appt-time-msg-list))
296                    (if appt-time-msg-list                    (if appt-time-msg-list
297                        (setq appt-comp-time                        (setq appt-comp-time
298                              (car (car (car appt-time-msg-list))))))                              (car (car (car appt-time-msg-list))))))
299    
300                  ;; If we have an appointment between midnight and                  ;; If we have an appointment between midnight and
# Line 302  The following variables control appointm Line 302  The following variables control appointm
302                  ;; we must begin to issue a message before midnight.                  ;; we must begin to issue a message before midnight.
303                  ;; Midnight is considered 0 minutes and 11:59pm is                  ;; Midnight is considered 0 minutes and 11:59pm is
304                  ;; 1439 minutes. Therefore we must recalculate the minutes                  ;; 1439 minutes. Therefore we must recalculate the minutes
305                  ;; to appointment variable. It is equal to the number of                  ;; to appointment variable. It is equal to the number of
306                  ;; minutes before midnight plus the number of                  ;; minutes before midnight plus the number of
307                  ;; minutes after midnight our appointment is.                  ;; minutes after midnight our appointment is.
308    
309                  (if (and (< appt-comp-time appt-message-warning-time)                  (if (and (< appt-comp-time appt-message-warning-time)
# Line 312  The following variables control appointm Line 312  The following variables control appointm
312                      (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time))                      (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time))
313                            appt-comp-time))                            appt-comp-time))
314    
315                  ;; issue warning if the appointment time is                  ;; issue warning if the appointment time is
316                  ;; within appt-message-warning time                  ;; within appt-message-warning time
317    
318                  (when (and (<= min-to-app appt-message-warning-time)                  (when (and (<= min-to-app appt-message-warning-time)
# Line 337  The following variables control appointm Line 337  The following variables control appointm
337                                ;;; else                                ;;; else
338    
339                        (if appt-visible                        (if appt-visible
340                            (message "%s"                            (message "%s"
341                                     (car (cdr (car appt-time-msg-list)))))                                     (car (cdr (car appt-time-msg-list)))))
342    
343                        (if appt-audible                        (if appt-audible
# Line 379  The following variables control appointm Line 379  The following variables control appointm
379    ;; before splitting the window.    ;; before splitting the window.
380    
381    (if (equal (selected-window) (minibuffer-window))    (if (equal (selected-window) (minibuffer-window))
382        (if (other-window 1)        (if (other-window 1)
383            (select-window (other-window 1))            (select-window (other-window 1))
384          (if (display-multi-frame-p)          (if (display-multi-frame-p)
385              (select-frame (other-frame 1)))))              (select-frame (other-frame 1)))))
386          
387    (let* ((this-buffer (current-buffer))    (let* ((this-buffer (current-buffer))
388           (this-window (selected-window))           (this-window (selected-window))
389           (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))           (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
# Line 397  The following variables control appointm Line 397  The following variables control appointm
397          (appt-select-lowest-window)          (appt-select-lowest-window)
398          (split-window))          (split-window))
399        (pop-to-buffer appt-disp-buf))        (pop-to-buffer appt-disp-buf))
400      (setq mode-line-format      (setq mode-line-format
401            (concat "-------------------- Appointment in "            (concat "-------------------- Appointment in "
402                    min-to-app " minutes. " new-time " %-"))                    min-to-app " minutes. " new-time " %-"))
403      (erase-buffer)      (erase-buffer)
# Line 408  The following variables control appointm Line 408  The following variables control appointm
408      (select-window this-window)      (select-window this-window)
409      (if appt-audible      (if appt-audible
410          (beep 1))))          (beep 1))))
411          
412  (defun appt-delete-window ()  (defun appt-delete-window ()
413    "Function called to undisplay appointment messages.    "Function called to undisplay appointment messages.
414  Usually just deletes the appointment buffer."  Usually just deletes the appointment buffer."
# Line 440  The time should be in either 24 hour for Line 440  The time should be in either 24 hour for
440    (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)    (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
441        nil        nil
442      (error "Unacceptable time-string"))      (error "Unacceptable time-string"))
443      
444    (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))    (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
445           (appt-time (list (appt-convert-time new-appt-time)))           (appt-time (list (appt-convert-time new-appt-time)))
446           (time-msg (cons appt-time (list appt-time-string))))           (time-msg (cons appt-time (list appt-time-string))))
447      (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg)))      (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg)))
448      (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))      (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
449    
450  ;;;###autoload  ;;;###autoload
451  (defun appt-delete ()  (defun appt-delete ()
# Line 454  The time should be in either 24 hour for Line 454  The time should be in either 24 hour for
454    (let* ((tmp-msg-list appt-time-msg-list))    (let* ((tmp-msg-list appt-time-msg-list))
455      (while tmp-msg-list      (while tmp-msg-list
456        (let* ((element (car tmp-msg-list))        (let* ((element (car tmp-msg-list))
457               (prompt-string (concat "Delete "               (prompt-string (concat "Delete "
458                                      (prin1-to-string (car (cdr element)))                                      ;; We want to quote any doublequotes
459                                        ;; in the string, as well as put
460                                        ;; doublequotes around it.
461                                        (prin1-to-string
462                                         (substring-no-properties
463                                          (car (cdr element)) 0))
464                                      " from list? "))                                      " from list? "))
465               (test-input (y-or-n-p prompt-string)))               (test-input (y-or-n-p prompt-string)))
466          (setq tmp-msg-list (cdr tmp-msg-list))          (setq tmp-msg-list (cdr tmp-msg-list))
# Line 463  The time should be in either 24 hour for Line 468  The time should be in either 24 hour for
468              (setq appt-time-msg-list (delq element appt-time-msg-list)))))              (setq appt-time-msg-list (delq element appt-time-msg-list)))))
469      (appt-check)      (appt-check)
470      (message "")))      (message "")))
471                    
472    
473  (eval-when-compile (defvar number)  (eval-when-compile (defvar number)
474                     (defvar original-date)                     (defvar original-date)
# Line 497  They specify the range of dates that the Line 502  They specify the range of dates that the
502          (if diary-entries-list          (if diary-entries-list
503    
504              ;; Cycle through the entry-list (diary-entries-list)              ;; Cycle through the entry-list (diary-entries-list)
505              ;; looking for entries beginning with a time. If              ;; looking for entries beginning with a time. If
506              ;; the entry begins with a time, add it to the              ;; the entry begins with a time, add it to the
507              ;; appt-time-msg-list. Then sort the list.              ;; appt-time-msg-list. Then sort the list.
508    
# Line 509  They specify the range of dates that the Line 514  They specify the range of dates that the
514                             (car entry-list) (list (calendar-current-date))))                             (car entry-list) (list (calendar-current-date))))
515                  (setq entry-list (cdr entry-list)))                  (setq entry-list (cdr entry-list)))
516                ;; Parse the entries for today.                ;; Parse the entries for today.
517                (while (and entry-list                (while (and entry-list
518                            (calendar-date-equal                            (calendar-date-equal
519                             (calendar-current-date) (car (car entry-list))))                             (calendar-current-date) (car (car entry-list))))
520                  (let ((time-string (substring (prin1-to-string                  (let ((time-string (cadr (car entry-list))))
                                                (cadr (car entry-list))) 1 -1)))  
   
521                    (while (string-match                    (while (string-match
522                            "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\(.*\n\\)*.*"                            "\\([0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\).*"
523                            time-string)                            time-string)
524                      (let* ((appt-time-string (match-string 0 time-string)))                      (let* ((beg (match-beginning 0))
525                               ;; Get just the time for this appointment.
526                        (if (< (match-end 0) (length time-string))                             (only-time (match-string 1 time-string))
527                            (setq new-time-string (substring time-string                             ;; Find the end of this appointment
528                                                             (+ (match-end 0) 1)                             ;; (the start of the next).
529                                                             nil))                             (end (string-match
530                          (setq new-time-string ""))                                   "^[ \t]*[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
531                                     time-string
532                        (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"                                   (match-end 0)))
533                                      time-string)                             ;; Get the whole string for this appointment.
534                               (appt-time-string
535                        (let* ((appt-time (list (appt-convert-time                              (substring time-string beg (if end (1- end)))))
536                                                 (match-string 0 time-string))))  
537                               (time-msg (cons appt-time                        ;; Add this appointment to appt-time-msg-list.
538                                               (list appt-time-string))))                        (let* ((appt-time (list (appt-convert-time only-time)))
539                          (setq time-string new-time-string)                               (time-msg (list appt-time appt-time-string)))
540                          (setq appt-time-msg-list (nconc appt-time-msg-list                          (setq appt-time-msg-list
541                                                          (list time-msg)))))))                                (nconc appt-time-msg-list (list time-msg))))
542    
543                          ;; Discard this appointment from the string.
544                          (setq time-string
545                                (if end (substring time-string end) "")))))
546                  (setq entry-list (cdr entry-list)))))                  (setq entry-list (cdr entry-list)))))
547          (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))          (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
548    
# Line 552  They specify the range of dates that the Line 559  They specify the range of dates that the
559                 (appt-comp-time (car (car (car appt-time-msg-list)))))                 (appt-comp-time (car (car (car appt-time-msg-list)))))
560    
561            (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))            (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
562              (setq appt-time-msg-list (cdr appt-time-msg-list))              (setq appt-time-msg-list (cdr appt-time-msg-list))
563              (if appt-time-msg-list              (if appt-time-msg-list
564                  (setq appt-comp-time (car (car (car appt-time-msg-list))))))))))                  (setq appt-comp-time (car (car (car appt-time-msg-list))))))))))
565      
566    
567  (defun appt-sort-list (appt-list)  (defun appt-sort-list (appt-list)
568    "Simple sort to put the appointments list APPT-LIST in order.    "Simple sort to put the appointments list APPT-LIST in order.
# Line 586  it from the original list." Line 593  it from the original list."
593          (min 0))          (min 0))
594    
595      (string-match ":\\([0-9][0-9]\\)" time2conv)      (string-match ":\\([0-9][0-9]\\)" time2conv)
596      (setq min (string-to-int      (setq min (string-to-int
597                 (match-string 1 time2conv)))                 (match-string 1 time2conv)))
598      
599      (string-match "[0-9]?[0-9]:" time2conv)      (string-match "[0-9]?[0-9]:" time2conv)
600      (setq hr (string-to-int      (setq hr (string-to-int
601                (match-string 0 time2conv)))                (match-string 0 time2conv)))
602      
603      ;; convert the time appointment time into 24 hour time      ;; convert the time appointment time into 24 hour time
604      
605      (cond ((and (string-match "pm" time2conv) (< hr 12))      (cond ((and (string-match "pm" time2conv) (< hr 12))
606             (setq hr (+ 12 hr)))             (setq hr (+ 12 hr)))
607            ((and (string-match "am" time2conv) (= hr 12))            ((and (string-match "am" time2conv) (= hr 12))
608             (setq hr 0)))             (setq hr 0)))
609      
610      ;; convert the actual time      ;; convert the actual time
611      ;; into minutes for comparison      ;; into minutes for comparison
612      ;; against the actual time.      ;; against the actual time.
613      
614      (setq conv-time (+ (* hr 60) min))      (setq conv-time (+ (* hr 60) min))
615      conv-time))      conv-time))
616    

Legend:
Removed from v.1.42  
changed lines
  Added in v.1.42.4.1

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