Mercurial > emacs
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').") |