comparison lisp/calendar/appt.el @ 49598:0d8b17d428b5

Trailing whitepace deleted.
author Juanma Barranquero <lekktu@gmail.com>
date Tue, 04 Feb 2003 13:24:35 +0000
parents eb47511f3556
children 695cf19ef79e d7ddb3e565de
comparison
equal deleted inserted replaced
49597:e88404e8f2cf 49598:0d8b17d428b5
32 ;;; 32 ;;;
33 ;;; Thanks to Edward M. Reingold for much help and many suggestions, 33 ;;; Thanks to Edward M. Reingold for much help and many suggestions,
34 ;;; And to many others for bug fixes and suggestions. 34 ;;; And to many others for bug fixes and suggestions.
35 ;;; 35 ;;;
36 ;;; 36 ;;;
37 ;;; This functions in this file will alert the user of a 37 ;;; This functions in this file will alert the user of a
38 ;;; pending appointment based on their diary file. 38 ;;; pending appointment based on their diary file.
39 ;;; 39 ;;;
40 ;;; A message will be displayed in the mode line of the Emacs buffer 40 ;;; 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 41 ;;; 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 42 ;;; from the diary in the mini-buffer, or you can choose to
43 ;;; have a message displayed in a new buffer. 43 ;;; have a message displayed in a new buffer.
44 ;;; 44 ;;;
45 ;;; The variable `appt-message-warning-time' allows the 45 ;;; The variable `appt-message-warning-time' allows the
46 ;;; user to specify how much notice they want before the appointment. The 46 ;;; user to specify how much notice they want before the appointment. The
47 ;;; variable `appt-issue-message' specifies whether the user wants 47 ;;; variable `appt-issue-message' specifies whether the user wants
48 ;;; to be notified of a pending appointment. 48 ;;; to be notified of a pending appointment.
49 ;;; 49 ;;;
50 ;;; In order to use the appt package, you only need 50 ;;; In order to use the appt package, you only need
51 ;;; to load it---provided you have appointments. 51 ;;; to load it---provided you have appointments.
52 ;;; 52 ;;;
53 ;;; Before that, you can also set some options if you want 53 ;;; Before that, you can also set some options if you want
54 ;;; (setq view-diary-entries-initially t) 54 ;;; (setq view-diary-entries-initially t)
55 ;;; (setq appt-issue-message t) 55 ;;; (setq appt-issue-message t)
56 ;;; 56 ;;;
57 ;;; This is an example of what can be in your diary file: 57 ;;; This is an example of what can be in your diary file:
58 ;;; Monday 58 ;;; Monday
59 ;;; 9:30am Coffee break 59 ;;; 9:30am Coffee break
60 ;;; 12:00pm Lunch 60 ;;; 12:00pm Lunch
61 ;;; 61 ;;;
62 ;;; Based upon the above lines in your .emacs and diary files, 62 ;;; Based upon the above lines in your .emacs and diary files,
63 ;;; the calendar and diary will be displayed when you enter 63 ;;; the calendar and diary will be displayed when you enter
64 ;;; Emacs and your appointments list will automatically be created. 64 ;;; Emacs and your appointments list will automatically be created.
65 ;;; You will then be reminded at 9:20am about your coffee break 65 ;;; You will then be reminded at 9:20am about your coffee break
66 ;;; and at 11:50am to go to lunch. 66 ;;; and at 11:50am to go to lunch.
67 ;;; 67 ;;;
68 ;;; Use describe-function on appt-check for a description of other variables 68 ;;; Use describe-function on appt-check for a description of other variables
69 ;;; that can be used to personalize the notification system. 69 ;;; that can be used to personalize the notification system.
70 ;;; 70 ;;;
71 ;;; In order to add or delete items from todays list, use appt-add 71 ;;; In order to add or delete items from todays list, use appt-add
144 :type 'integer 144 :type 'integer
145 :group 'appt) 145 :group 'appt)
146 146
147 ;;;###autoload 147 ;;;###autoload
148 (defcustom appt-display-diary t 148 (defcustom appt-display-diary t
149 "*Non-nil means to display the next days diary on the screen. 149 "*Non-nil means to display the next days diary on the screen.
150 This will occur at midnight when the appointment list is updated." 150 This will occur at midnight when the appointment list is updated."
151 :type 'boolean 151 :type 'boolean
152 :group 'appt) 152 :group 'appt)
153 153
154 (defvar appt-time-msg-list nil 154 (defvar appt-time-msg-list nil
162 162
163 (defcustom appt-display-interval 3 163 (defcustom appt-display-interval 3
164 "*Number of minutes to wait between checking the appointment list." 164 "*Number of minutes to wait between checking the appointment list."
165 :type 'integer 165 :type 'integer
166 :group 'appt) 166 :group 'appt)
167 167
168 (defvar appt-buffer-name " *appt-buf*" 168 (defvar appt-buffer-name " *appt-buf*"
169 "Name of the appointments buffer.") 169 "Name of the appointments buffer.")
170 170
171 (defvar appt-disp-window-function 'appt-disp-window 171 (defvar appt-disp-window-function 'appt-disp-window
172 "Function called to display appointment window.") 172 "Function called to display appointment window.")
173 173
174 (defvar appt-delete-window-function 'appt-delete-window 174 (defvar appt-delete-window-function 'appt-delete-window
175 "Function called to remove appointment window and buffer.") 175 "Function called to remove appointment window and buffer.")
176 176
177 (defvar appt-mode-string nil 177 (defvar appt-mode-string nil
178 "String being displayed in the mode line saying you have an appointment. 178 "String being displayed in the mode line saying you have an appointment.
190 "Check for an appointment and update the mode line. 190 "Check for an appointment and update the mode line.
191 Note: the time must be the first thing in the line in the diary 191 Note: the time must be the first thing in the line in the diary
192 for a warning to be issued. 192 for a warning to be issued.
193 193
194 The format of the time can be either 24 hour or am/pm. 194 The format of the time can be either 24 hour or am/pm.
195 Example: 195 Example:
196 196
197 02/23/89 197 02/23/89
198 18:00 Dinner 198 18:00 Dinner
199 199
200 Thursday 200 Thursday
201 11:45am Lunch meeting. 201 11:45am Lunch meeting.
202 202
203 Appointments are checked every `appt-display-interval' minutes. 203 Appointments are checked every `appt-display-interval' minutes.
204 The following variables control appointment notification: 204 The following variables control appointment notification:
229 229
230 `appt-disp-window-function' 230 `appt-disp-window-function'
231 Function called to display appointment window. You can customize 231 Function called to display appointment window. You can customize
232 appt.el by setting this variable to a function different from the 232 appt.el by setting this variable to a function different from the
233 one provided with this package. 233 one provided with this package.
234 234
235 `appt-delete-window-function' 235 `appt-delete-window-function'
236 Function called to remove appointment window and buffer. You can 236 Function called to remove appointment window and buffer. You can
237 customize appt.el by setting this variable to a function different 237 customize appt.el by setting this variable to a function different
238 from the one provided with this package." 238 from the one provided with this package."
239 239
262 (let* ((now (decode-time)) 262 (let* ((now (decode-time))
263 (cur-hour (nth 2 now)) 263 (cur-hour (nth 2 now))
264 (cur-min (nth 1 now)) 264 (cur-min (nth 1 now))
265 (cur-comp-time (+ (* cur-hour 60) cur-min))) 265 (cur-comp-time (+ (* cur-hour 60) cur-min)))
266 266
267 ;; At the first check in any given day, update our 267 ;; At the first check in any given day, update our
268 ;; appointments to today's list. 268 ;; appointments to today's list.
269 269
270 (if (or (null appt-prev-comp-time) 270 (if (or (null appt-prev-comp-time)
271 (< cur-comp-time appt-prev-comp-time)) 271 (< cur-comp-time appt-prev-comp-time))
272 (condition-case nil 272 (condition-case nil
288 288
289 (if (and appt-issue-message appt-time-msg-list) 289 (if (and appt-issue-message appt-time-msg-list)
290 (let ((appt-comp-time (car (car (car appt-time-msg-list))))) 290 (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
291 (setq min-to-app (- appt-comp-time cur-comp-time)) 291 (setq min-to-app (- appt-comp-time cur-comp-time))
292 292
293 (while (and appt-time-msg-list 293 (while (and appt-time-msg-list
294 (< appt-comp-time cur-comp-time)) 294 (< appt-comp-time cur-comp-time))
295 (setq appt-time-msg-list (cdr appt-time-msg-list)) 295 (setq appt-time-msg-list (cdr appt-time-msg-list))
296 (if appt-time-msg-list 296 (if appt-time-msg-list
297 (setq appt-comp-time 297 (setq appt-comp-time
298 (car (car (car appt-time-msg-list)))))) 298 (car (car (car appt-time-msg-list))))))
299 299
300 ;; If we have an appointment between midnight and 300 ;; If we have an appointment between midnight and
301 ;; 'appt-message-warning-time' minutes after midnight, 301 ;; 'appt-message-warning-time' minutes after midnight,
302 ;; we must begin to issue a message before midnight. 302 ;; we must begin to issue a message before midnight.
303 ;; Midnight is considered 0 minutes and 11:59pm is 303 ;; Midnight is considered 0 minutes and 11:59pm is
304 ;; 1439 minutes. Therefore we must recalculate the minutes 304 ;; 1439 minutes. Therefore we must recalculate the minutes
305 ;; to appointment variable. It is equal to the number of 305 ;; to appointment variable. It is equal to the number of
306 ;; minutes before midnight plus the number of 306 ;; minutes before midnight plus the number of
307 ;; minutes after midnight our appointment is. 307 ;; minutes after midnight our appointment is.
308 308
309 (if (and (< appt-comp-time appt-message-warning-time) 309 (if (and (< appt-comp-time appt-message-warning-time)
310 (> (+ cur-comp-time appt-message-warning-time) 310 (> (+ cur-comp-time appt-message-warning-time)
311 appt-max-time)) 311 appt-max-time))
312 (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time)) 312 (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time))
313 appt-comp-time)) 313 appt-comp-time))
314 314
315 ;; issue warning if the appointment time is 315 ;; issue warning if the appointment time is
316 ;; within appt-message-warning time 316 ;; within appt-message-warning time
317 317
318 (when (and (<= min-to-app appt-message-warning-time) 318 (when (and (<= min-to-app appt-message-warning-time)
319 (>= min-to-app 0)) 319 (>= min-to-app 0))
320 (setq appt-now-displayed t) 320 (setq appt-now-displayed t)
335 nil 335 nil
336 appt-delete-window-function)) 336 appt-delete-window-function))
337 ;;; else 337 ;;; else
338 338
339 (if appt-visible 339 (if appt-visible
340 (message "%s" 340 (message "%s"
341 (car (cdr (car appt-time-msg-list))))) 341 (car (cdr (car appt-time-msg-list)))))
342 342
343 (if appt-audible 343 (if appt-audible
344 (beep 1)))) 344 (beep 1))))
345 345
377 377
378 ;; Make sure we're not in the minibuffer 378 ;; Make sure we're not in the minibuffer
379 ;; before splitting the window. 379 ;; before splitting the window.
380 380
381 (if (equal (selected-window) (minibuffer-window)) 381 (if (equal (selected-window) (minibuffer-window))
382 (if (other-window 1) 382 (if (other-window 1)
383 (select-window (other-window 1)) 383 (select-window (other-window 1))
384 (if (display-multi-frame-p) 384 (if (display-multi-frame-p)
385 (select-frame (other-frame 1))))) 385 (select-frame (other-frame 1)))))
386 386
387 (let* ((this-buffer (current-buffer)) 387 (let* ((this-buffer (current-buffer))
388 (this-window (selected-window)) 388 (this-window (selected-window))
389 (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name)))) 389 (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
390 390
391 (if (cdr (assq 'unsplittable (frame-parameters))) 391 (if (cdr (assq 'unsplittable (frame-parameters)))
395 (same-window-p (buffer-name appt-disp-buf))) 395 (same-window-p (buffer-name appt-disp-buf)))
396 ;; By default, split the bottom window and use the lower part. 396 ;; By default, split the bottom window and use the lower part.
397 (appt-select-lowest-window) 397 (appt-select-lowest-window)
398 (split-window)) 398 (split-window))
399 (pop-to-buffer appt-disp-buf)) 399 (pop-to-buffer appt-disp-buf))
400 (setq mode-line-format 400 (setq mode-line-format
401 (concat "-------------------- Appointment in " 401 (concat "-------------------- Appointment in "
402 min-to-app " minutes. " new-time " %-")) 402 min-to-app " minutes. " new-time " %-"))
403 (erase-buffer) 403 (erase-buffer)
404 (insert appt-msg) 404 (insert appt-msg)
405 (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t)) 405 (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
406 (set-buffer-modified-p nil) 406 (set-buffer-modified-p nil)
407 (raise-frame (selected-frame)) 407 (raise-frame (selected-frame))
408 (select-window this-window) 408 (select-window this-window)
409 (if appt-audible 409 (if appt-audible
410 (beep 1)))) 410 (beep 1))))
411 411
412 (defun appt-delete-window () 412 (defun appt-delete-window ()
413 "Function called to undisplay appointment messages. 413 "Function called to undisplay appointment messages.
414 Usually just deletes the appointment buffer." 414 Usually just deletes the appointment buffer."
415 (let ((window (get-buffer-window appt-buffer-name t))) 415 (let ((window (get-buffer-window appt-buffer-name t)))
416 (and window 416 (and window
438 438
439 (interactive "sTime (hh:mm[am/pm]): \nsMessage: ") 439 (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
440 (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time) 440 (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
441 nil 441 nil
442 (error "Unacceptable time-string")) 442 (error "Unacceptable time-string"))
443 443
444 (let* ((appt-time-string (concat new-appt-time " " new-appt-msg)) 444 (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
445 (appt-time (list (appt-convert-time new-appt-time))) 445 (appt-time (list (appt-convert-time new-appt-time)))
446 (time-msg (cons appt-time (list appt-time-string)))) 446 (time-msg (cons appt-time (list appt-time-string))))
447 (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg))) 447 (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)))) 448 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
449 449
450 ;;;###autoload 450 ;;;###autoload
451 (defun appt-delete () 451 (defun appt-delete ()
452 "Delete an appointment from the list of appointments." 452 "Delete an appointment from the list of appointments."
453 (interactive) 453 (interactive)
454 (let* ((tmp-msg-list appt-time-msg-list)) 454 (let* ((tmp-msg-list appt-time-msg-list))
455 (while tmp-msg-list 455 (while tmp-msg-list
456 (let* ((element (car tmp-msg-list)) 456 (let* ((element (car tmp-msg-list))
457 (prompt-string (concat "Delete " 457 (prompt-string (concat "Delete "
458 ;; We want to quote any doublequotes 458 ;; We want to quote any doublequotes
459 ;; in the string, as well as put 459 ;; in the string, as well as put
460 ;; doublequotes around it. 460 ;; doublequotes around it.
461 (prin1-to-string 461 (prin1-to-string
462 (substring-no-properties 462 (substring-no-properties
463 (car (cdr element)) 0)) 463 (car (cdr element)) 0))
464 " from list? ")) 464 " from list? "))
465 (test-input (y-or-n-p prompt-string))) 465 (test-input (y-or-n-p prompt-string)))
466 (setq tmp-msg-list (cdr tmp-msg-list)) 466 (setq tmp-msg-list (cdr tmp-msg-list))
467 (if test-input 467 (if test-input
468 (setq appt-time-msg-list (delq element appt-time-msg-list))))) 468 (setq appt-time-msg-list (delq element appt-time-msg-list)))))
469 (appt-check) 469 (appt-check)
470 (message ""))) 470 (message "")))
471 471
472 472
473 (eval-when-compile (defvar number) 473 (eval-when-compile (defvar number)
474 (defvar original-date) 474 (defvar original-date)
475 (defvar diary-entries-list)) 475 (defvar diary-entries-list))
476 ;;;###autoload 476 ;;;###autoload
500 ;; Clear the appointments list, then fill it in from the diary. 500 ;; Clear the appointments list, then fill it in from the diary.
501 (setq appt-time-msg-list nil) 501 (setq appt-time-msg-list nil)
502 (if diary-entries-list 502 (if diary-entries-list
503 503
504 ;; Cycle through the entry-list (diary-entries-list) 504 ;; Cycle through the entry-list (diary-entries-list)
505 ;; looking for entries beginning with a time. If 505 ;; looking for entries beginning with a time. If
506 ;; the entry begins with a time, add it to the 506 ;; the entry begins with a time, add it to the
507 ;; appt-time-msg-list. Then sort the list. 507 ;; appt-time-msg-list. Then sort the list.
508 508
509 (let ((entry-list diary-entries-list) 509 (let ((entry-list diary-entries-list)
510 (new-time-string "")) 510 (new-time-string ""))
512 (while (and entry-list 512 (while (and entry-list
513 (calendar-date-compare 513 (calendar-date-compare
514 (car entry-list) (list (calendar-current-date)))) 514 (car entry-list) (list (calendar-current-date))))
515 (setq entry-list (cdr entry-list))) 515 (setq entry-list (cdr entry-list)))
516 ;; Parse the entries for today. 516 ;; Parse the entries for today.
517 (while (and entry-list 517 (while (and entry-list
518 (calendar-date-equal 518 (calendar-date-equal
519 (calendar-current-date) (car (car entry-list)))) 519 (calendar-current-date) (car (car entry-list))))
520 (let ((time-string (cadr (car entry-list)))) 520 (let ((time-string (cadr (car entry-list))))
521 (while (string-match 521 (while (string-match
522 "\\([0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\).*" 522 "\\([0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\).*"
523 time-string) 523 time-string)
557 (cur-min (nth 1 now)) 557 (cur-min (nth 1 now))
558 (cur-comp-time (+ (* cur-hour 60) cur-min)) 558 (cur-comp-time (+ (* cur-hour 60) cur-min))
559 (appt-comp-time (car (car (car appt-time-msg-list))))) 559 (appt-comp-time (car (car (car appt-time-msg-list)))))
560 560
561 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) 561 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
562 (setq appt-time-msg-list (cdr appt-time-msg-list)) 562 (setq appt-time-msg-list (cdr appt-time-msg-list))
563 (if appt-time-msg-list 563 (if appt-time-msg-list
564 (setq appt-comp-time (car (car (car appt-time-msg-list)))))))))) 564 (setq appt-comp-time (car (car (car appt-time-msg-list))))))))))
565 565
566 566
567 (defun appt-sort-list (appt-list) 567 (defun appt-sort-list (appt-list)
568 "Simple sort to put the appointments list APPT-LIST in order. 568 "Simple sort to put the appointments list APPT-LIST in order.
569 Scan the list for the smallest element left in the list. 569 Scan the list for the smallest element left in the list.
570 Append the smallest element left into the new list, and remove 570 Append the smallest element left into the new list, and remove
591 (let ((conv-time 0) 591 (let ((conv-time 0)
592 (hr 0) 592 (hr 0)
593 (min 0)) 593 (min 0))
594 594
595 (string-match ":\\([0-9][0-9]\\)" time2conv) 595 (string-match ":\\([0-9][0-9]\\)" time2conv)
596 (setq min (string-to-int 596 (setq min (string-to-int
597 (match-string 1 time2conv))) 597 (match-string 1 time2conv)))
598 598
599 (string-match "[0-9]?[0-9]:" time2conv) 599 (string-match "[0-9]?[0-9]:" time2conv)
600 (setq hr (string-to-int 600 (setq hr (string-to-int
601 (match-string 0 time2conv))) 601 (match-string 0 time2conv)))
602 602
603 ;; convert the time appointment time into 24 hour time 603 ;; convert the time appointment time into 24 hour time
604 604
605 (cond ((and (string-match "pm" time2conv) (< hr 12)) 605 (cond ((and (string-match "pm" time2conv) (< hr 12))
606 (setq hr (+ 12 hr))) 606 (setq hr (+ 12 hr)))
607 ((and (string-match "am" time2conv) (= hr 12)) 607 ((and (string-match "am" time2conv) (= hr 12))
608 (setq hr 0))) 608 (setq hr 0)))
609 609
610 ;; convert the actual time 610 ;; convert the actual time
611 ;; into minutes for comparison 611 ;; into minutes for comparison
612 ;; against the actual time. 612 ;; against the actual time.
613 613
614 (setq conv-time (+ (* hr 60) min)) 614 (setq conv-time (+ (* hr 60) min))
615 conv-time)) 615 conv-time))
616 616
617 (defvar appt-timer nil 617 (defvar appt-timer nil
618 "Timer used for diary appointment notifications (`appt-check').") 618 "Timer used for diary appointment notifications (`appt-check').")