Mercurial > hg > xemacs-beta
comparison lisp/calendar/appt.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | 0293115a14e9 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; appt.el --- appointment notification functions. | |
| 2 ;; Keywords: calendar | |
| 3 | |
| 4 ;;; -*- Mode:Emacs-Lisp -*- | |
| 5 ;; Appointment notification functions. | |
| 6 ;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc. | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
| 10 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 11 ;; under the terms of the GNU General Public License as published by | |
| 12 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 13 ;; any later version. | |
| 14 | |
| 15 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 18 ;; General Public License for more details. | |
| 19 | |
| 20 ;; You should have received a copy of the GNU General Public License | |
| 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 23 | |
| 24 ;;; 29-nov-89 created by Neil Mager <neilm@juliet.ll.mit.edu>. | |
| 25 ;;; 23-feb-91 hacked upon by Jamie Zawinski <jwz@lucid.com>. | |
| 26 ;;; 1-apr-91 some more. | |
| 27 ;;; 12-jul-95 updated for XEmacs 19.12 by Greg Veres <gveres@cgl.uwaterloo.ca> | |
| 28 ;;; | |
| 29 ;; appt.el - visible and/or audible notification of | |
| 30 ;; appointments from ~/diary file generated from | |
| 31 ;; Edward M. Reingold's calendar.el. | |
| 32 ;; | |
| 33 ;; Version 2.1 | |
| 34 ;; | |
| 35 ;; Comments, corrections, and improvements should be sent to | |
| 36 ;; Neil M. Mager | |
| 37 ;; Net <neilm@juliet.ll.mit.edu> | |
| 38 ;; Voice (617) 981-4803 | |
| 39 ;;; | |
| 40 ;;; Thanks to Edward M. Reingold for much help and many suggestions, | |
| 41 ;;; And to many others for bug fixes and suggestions. | |
| 42 ;;; | |
| 43 ;;; | |
| 44 ;;; This functions in this file will alert the user of a | |
| 45 ;;; pending appointment based on their diary file. | |
| 46 ;;; | |
| 47 ;;; ******* It is necessary to invoke 'display-time' and ******** | |
| 48 ;;; ******* 'appt-initialize' for this to work properly. ******** | |
| 49 ;;; | |
| 50 ;;; A message will be displayed in the mode line of the emacs buffer and (if | |
| 51 ;;; the user desires) the terminal will beep and display a message from the | |
| 52 ;;; diary in the mini-buffer, or the user may select to have a message | |
| 53 ;;; displayed in a new buffer. | |
| 54 ;;; | |
| 55 ;;; Variables of note: | |
| 56 ;;; | |
| 57 ;;; appt-issue-message If this variable is nil, then the code in this | |
| 58 ;;; file does nothing. | |
| 59 ;;; appt-msg-countdown-list Specifies how much warning you want before | |
| 60 ;;; appointments. | |
| 61 ;;; appt-audible Whether to beep when it's notification-time. | |
| 62 ;;; appt-display-mode-line Whether to display a countdown to the next | |
| 63 ;;; appointment in the mode-line. | |
| 64 ;;; appt-announce-method The function used to do the notifications. | |
| 65 ;;; 'appt-window-announce do it in a pop-up window. | |
| 66 ;;; 'appt-frame-announce do it in a pop-up frame (v19 only) | |
| 67 ;;; 'appt-message-announce do it in the echo area. | |
| 68 ;;; 'appt-persistent-message-announce do it in the echo area, but make the | |
| 69 ;;; messages not go away at the next keystroke. | |
| 70 ;;; appt-display-duration If appt-announce-method is set to the function | |
| 71 ;;; 'appt-window-announce, this specifies how many | |
| 72 ;;; seconds the pop-up window should stick around. | |
| 73 ;;; | |
| 74 ;;; In order to use this, create a diary file, and add the following to your | |
| 75 ;;; .emacs file: | |
| 76 ;;; | |
| 77 ;;; (require 'appt) | |
| 78 ;;; (display-time) | |
| 79 ;;; (appt-initialize) | |
| 80 ;;; | |
| 81 ;;; If you wish to see a list of appointments, or a full calendar, when emacs | |
| 82 ;;; starts up, you can add a call to (diary) or (calendar) after this. | |
| 83 ;;; | |
| 84 ;;; This is an example of what can be in your diary file: | |
| 85 ;;; Monday | |
| 86 ;;; 9:30am Coffee break | |
| 87 ;;; 12:00pm Lunch | |
| 88 ;;; | |
| 89 ;;; Based upon the above lines in your .emacs and diary files, the calendar | |
| 90 ;;; and/or diary will be displayed when you enter emacs and your appointments | |
| 91 ;;; list will automatically be created. You will then be reminded at 9:20am | |
| 92 ;;; about your coffee break and at 11:50am to go to lunch. | |
| 93 ;;; | |
| 94 ;;; In order to interactively add or delete items from today's list, use | |
| 95 ;;; Meta-x appt-add and Meta-x appt-delete. (This does not modify your | |
| 96 ;;; diary file, so these will be forgotten when you exit emacs.) | |
| 97 ;;; | |
| 98 ;;; Additionally, the appointments list is recreated automatically at 12:01am | |
| 99 ;;; for those who do not logout every day or are programming late. | |
| 100 ;;; | |
| 101 ;;; You can have special appointments which execute arbitrary code rather than | |
| 102 ;;; simply notifying you -- sort of like the unix "cron" facility. The syntax | |
| 103 ;;; for this is borrowed from the Calendar's special-date format. If you have | |
| 104 ;;; a diary entry like | |
| 105 ;;; | |
| 106 ;;; Monday | |
| 107 ;;; 3:00am %%(save-all-modified-buffers) | |
| 108 ;;; | |
| 109 ;;; then on monday at 3AM, the function `save-all-modified-buffers' will be | |
| 110 ;;; invoked. (Presumably this function is defined in your .emacs file.) | |
| 111 ;;; There will be no notification that these "special" appointments are being | |
| 112 ;;; triggered, unless the form evaluated produces a notification. | |
| 113 ;;; | |
| 114 ;;; It is necessary for the entire list after the "%%" to be on one line in | |
| 115 ;;; your .diary file -- there may not be embedded newlines in it. This is a | |
| 116 ;;; bit of a misfeature. | |
| 117 ;;; | |
| 118 ;;; This also interacts correctly with Benjamin Pierce's reportmail.el package. | |
| 119 ;;; | |
| 120 ;;; Brief internal description - Skip this if your not interested! | |
| 121 ;;; | |
| 122 ;;; The function appt-initialize invokes 'diary' to get a list of today's | |
| 123 ;;; appointments, and parses the lines beginning with date descriptions. | |
| 124 ;;; This list is cached away. 'diary' is invoked in such a way so as to | |
| 125 ;;; not pop up a window displaying the diary buffer. | |
| 126 ;;; | |
| 127 ;;; The function appt-check is run from the 'loadst' process (or the 'wakeup' | |
| 128 ;;; process in emacs 18.57 or newer) which is started by invoking display-time. | |
| 129 ;;; It checks this cached list, and announces as appropriate. At midnight, | |
| 130 ;;; appt-initialize is called again to rebuild this list. | |
| 131 ;;; | |
| 132 ;;; display-time-filter is modified to invoke appt-check. | |
| 133 ;;; | |
| 134 ;;; TO DO: | |
| 135 ;;; | |
| 136 ;;; o multiple adjascent appointments are not handled gracefully. If there | |
| 137 ;;; is an appointment at 3:30 and another at 3:35, and you have set things | |
| 138 ;;; up so that you get a notification twenty minutes before each appt, | |
| 139 ;;; then a notification should come at 3:10 for the first appt, and at | |
| 140 ;;; 3:15 for the second. Currently, no notifications are generated for an | |
| 141 ;;; appointment until all preceeding appointments have completely expired. | |
| 142 ;;; | |
| 143 ;;; o If there are two appointments at the same time, all but the first are | |
| 144 ;;; ignored (not announced.) | |
| 145 ;;; | |
| 146 ;;; o Appointments which are early enough in the morning that their | |
| 147 ;;; announcements should begin before midnight are not announced until | |
| 148 ;;; midnight. | |
| 149 ;;; | |
| 150 ;;; o There should be some way to mark certain appointments as "important," | |
| 151 ;;; so that you will be harassed about them even after they have expired. | |
| 152 | |
| 153 | |
| 154 (require 'calendar) | |
| 155 (require 'diary-lib) | |
| 156 | |
| 157 (defvar appt-issue-message t | |
| 158 "*If T, the diary buffer is checked for appointments. For an | |
| 159 appointment warning to be made, the time must be the first thing on | |
| 160 the line.") | |
| 161 | |
| 162 (defvar appt-msg-countdown-list '(20 15 10 5 3 1) | |
| 163 "*A list of the intervals in minutes before the appointment when | |
| 164 the warnings will be given. That is, if this were the list '(5 3 1), | |
| 165 then a notification would be given five minutes, three minutes, and | |
| 166 one minute before the appointment.") | |
| 167 | |
| 168 (defvar appt-check-time-syntax nil | |
| 169 "*Whether all diary entries are intended to beging with time specifications. | |
| 170 Appt will beep and issue a warning message when encountering unparsable | |
| 171 lines.") | |
| 172 | |
| 173 (defvar appt-audible t | |
| 174 "*Controls whether appointment announcements should beep. | |
| 175 Appt uses two sound-types for beeps: `appt' and `appt-final'. | |
| 176 If this is a number, then that many beeps will occur. | |
| 177 If this is a cons, the car is how many beeps, and the cdr is the | |
| 178 delay between them (a float, fraction of a second to sleep.) | |
| 179 See also the variable `appt-msg-countdown-list'") | |
| 180 | |
| 181 (defvar appt-display-mode-line t | |
| 182 "*Controls if minutes-to-appointment should be displayed on the mode line.") | |
| 183 | |
| 184 (defvar appt-announce-method 'appt-window-announce | |
| 185 "*The name of the function used to notify the user of an impending | |
| 186 appointment. This is called with two arguments, the number of minutes | |
| 187 until the appointment, and the appointment description list. | |
| 188 | |
| 189 Reasonable values for this variable are 'appt-window-announce, | |
| 190 'appt-message-announce, or 'appt-persistent-message-announce.") | |
| 191 | |
| 192 | |
| 193 (defvar appt-time-msg-list nil | |
| 194 "The list of appointments for today. Use appt-add and appt-delete | |
| 195 to add and delete appointments from list. The original list is generated | |
| 196 from the today's diary-entries-list. The number before each time/message | |
| 197 is the time in minutes after midnight.") | |
| 198 | |
| 199 (defconst max-time 1439 | |
| 200 "11:59pm in minutes - number of minutes in a day minus 1.") | |
| 201 | |
| 202 (defconst appt-check-tick -1) | |
| 203 | |
| 204 (defvar appt-disp-frame nil | |
| 205 "If non-nil, frame to display appointments in.") | |
| 206 (defvaralias 'appt-disp-screen 'appt-disp-frame) | |
| 207 | |
| 208 | |
| 209 ;;; Announcement methods | |
| 210 | |
| 211 (defun appt-message-announce (min-to-app appt) | |
| 212 "Set appt-announce-method to the name of this function to cause appointment | |
| 213 notifications to be given via messages in the minibuffer." | |
| 214 (message (if (eq min-to-app 0) "App't NOW." | |
| 215 (format "App't in %d minute%s -- %s" | |
| 216 min-to-app | |
| 217 (if (eq 1 min-to-app) "" "s") | |
| 218 (car (cdr appt)))))) | |
| 219 | |
| 220 | |
| 221 (defun appt-persistent-message-announce (min-to-app appt) | |
| 222 "Set appt-announce-method to the name of this function to cause appointment | |
| 223 notifications to be given via messages in the minibuffer, but have those | |
| 224 messages stay around even if you type something (unlike normal messages)." | |
| 225 (let ((str (if (eq min-to-app 0) | |
| 226 (format "App't NOW -- %s" (car (cdr appt))) | |
| 227 (format "App't in %d minute%s -- %s" | |
| 228 min-to-app | |
| 229 (if (eq 1 min-to-app) "" "s") | |
| 230 (car (cdr appt))))) | |
| 231 (in-echo-area-already (eq (selected-window) (minibuffer-window)))) | |
| 232 (if (not in-echo-area-already) | |
| 233 ;; don't stomp the echo-area-buffer if reading from the minibuffer now. | |
| 234 (save-excursion | |
| 235 (save-window-excursion | |
| 236 (select-window (minibuffer-window)) | |
| 237 (delete-region (point-min) (point-max)) | |
| 238 (insert str)))) | |
| 239 ;; if we're reading from the echo-area, and all we were going to do is | |
| 240 ;; clear the thing, like, don't bother, that's annoying. | |
| 241 (if (and in-echo-area-already (string= "" str)) | |
| 242 nil | |
| 243 (message "%s" str)) | |
| 244 )) | |
| 245 | |
| 246 | |
| 247 (defvar appt-display-duration 5 | |
| 248 "*The number of seconds an appointment message is displayed in its own | |
| 249 window if appt-announce-method is 'appt-window-announce.") | |
| 250 | |
| 251 (defun appt-window-announce (min-to-app appt) | |
| 252 "Set appt-announce-method to the name of this function to cause appointment | |
| 253 notifications to be given via messages in a pop-up window. The variable | |
| 254 appt-display-duration controls how long this window should be left up." | |
| 255 (require 'electric) | |
| 256 (save-excursion | |
| 257 (save-window-excursion | |
| 258 ;; Make sure we're not in the minibuffer | |
| 259 ;; before splitting the window. | |
| 260 (if (window-minibuffer-p (selected-window)) | |
| 261 nil | |
| 262 (select-window (frame-lowest-window)) | |
| 263 (split-window)) | |
| 264 (let (appt-disp-buf) | |
| 265 (unwind-protect | |
| 266 (progn | |
| 267 (setq appt-disp-buf (set-buffer (get-buffer-create "*appt-buf*"))) | |
| 268 ;; set the mode-line of the pop-up window | |
| 269 (setq modeline-format | |
| 270 (concat "-------------------- Appointment " | |
| 271 (if (eq min-to-app 0) | |
| 272 "NOW" | |
| 273 (concat "in " min-to-app | |
| 274 (if (eq min-to-app 1) " minute" " minutes"))) | |
| 275 ". (" | |
| 276 (let ((h (string-to-int | |
| 277 (substring (current-time-string) 11 13)))) | |
| 278 (concat (if (> h 12) (- h 12) h) ":" | |
| 279 (substring (current-time-string) 14 16) | |
| 280 (if (< h 12) "am" "pm"))) | |
| 281 ") %-")) | |
| 282 (pop-to-buffer appt-disp-buf) | |
| 283 (insert (car (cdr appt))) | |
| 284 (shrink-window-if-larger-than-buffer | |
| 285 (get-buffer-window appt-disp-buf)) | |
| 286 (set-buffer-modified-p nil) | |
| 287 (sit-for appt-display-duration)) | |
| 288 (and appt-disp-buf (kill-buffer appt-disp-buf))))))) | |
| 289 | |
| 290 (defvar appt-frame-defaults nil) | |
| 291 (defvaralias 'appt-screen-defaults 'appt-frame-defaults) | |
| 292 | |
| 293 (defun appt-frame-announce (min-to-app appt) | |
| 294 "Set appt-announce-method to the name of this function to cause appointment | |
| 295 notifications to be given via messages in a pop-up frame." | |
| 296 (let () | |
| 297 (save-excursion | |
| 298 (set-buffer (get-buffer-create "*appt-buf*")) | |
| 299 (erase-buffer) | |
| 300 ;; set the mode-line of the pop-up window | |
| 301 (setq modeline-format | |
| 302 (concat "-------------------- Appointment " | |
| 303 (if (eq min-to-app 0) | |
| 304 "NOW" | |
| 305 (concat "in " min-to-app | |
| 306 (if (eq min-to-app 1) " minute" " minutes"))) | |
| 307 ". (" | |
| 308 (let ((h (string-to-int | |
| 309 (substring (current-time-string) 11 13)))) | |
| 310 (concat (if (> h 12) (- h 12) h) ":" | |
| 311 (substring (current-time-string) 14 16) | |
| 312 (if (< h 12) "am" "pm"))) | |
| 313 ") %-")) | |
| 314 (insert (car (cdr appt))) | |
| 315 (let ((height (max 10 (min 20 (+ 2 (count-lines (point-min) | |
| 316 (point-max))))))) | |
| 317 ;; If we already have a frame constructed, use it. If not, or it has | |
| 318 ;; been deleted, then make a new one | |
| 319 (if (and appt-disp-frame (frame-live-p appt-disp-frame)) | |
| 320 (let ((s (selected-frame))) | |
| 321 (select-frame appt-disp-frame) | |
| 322 (make-frame-visible appt-disp-frame) | |
| 323 (set-frame-height appt-disp-frame height) | |
| 324 (sit-for 0) | |
| 325 (select-frame s)) | |
| 326 (progn | |
| 327 (setq appt-disp-frame (make-frame)) | |
| 328 (set-frame-height appt-disp-frame height) | |
| 329 ) | |
| 330 ) | |
| 331 ) | |
| 332 ) | |
| 333 ) | |
| 334 ) | |
| 335 (defalias 'appt-screen-announce 'appt-frame-announce) | |
| 336 | |
| 337 ;;; To display stuff in the mode line, we use a new variable instead of | |
| 338 ;;; just adding stuff to the display-time-string -- this causes less | |
| 339 ;;; flicker. | |
| 340 | |
| 341 (defvar appt-mode-line-string "" | |
| 342 "*The string displayed in the mode line by the appointment package.") | |
| 343 | |
| 344 (defun appt-display-mode-line (min-to-app) | |
| 345 "Add an appointment annotation to the mode line." | |
| 346 (setq appt-mode-line-string | |
| 347 (if (and appt-display-mode-line min-to-app) | |
| 348 (if (eq 0 min-to-app) | |
| 349 "App't NOW " | |
| 350 (concat "App't in " min-to-app | |
| 351 (if (eq 1 min-to-app) " minute " " minutes "))) | |
| 352 "")) | |
| 353 ;; make sure our variable is visible in global-mode-string. | |
| 354 (cond ((not appt-display-mode-line) nil) | |
| 355 ((null global-mode-string) | |
| 356 (setq global-mode-string (list "" 'appt-mode-line-string))) | |
| 357 ((stringp global-mode-string) | |
| 358 (setq global-mode-string | |
| 359 (list global-mode-string 'appt-mode-line-string))) | |
| 360 ((not (memq 'appt-mode-line-string global-mode-string)) | |
| 361 (setq global-mode-string | |
| 362 (append global-mode-string (list 'appt-mode-line-string))))) | |
| 363 ;; force mode line updates - from time.el | |
| 364 (save-excursion (set-buffer (other-buffer))) | |
| 365 (set-buffer-modified-p (buffer-modified-p)) | |
| 366 (sit-for 0)) | |
| 367 | |
| 368 | |
| 369 ;;; Internal stuff | |
| 370 | |
| 371 (defun appt-convert-time (time2conv) | |
| 372 " Convert hour:min[am/pm] format to minutes from midnight." | |
| 373 (cond ((string-match "^[ \t]*midni\\(ght\\|te\\)[ \t]*\\'" time2conv) | |
| 374 0) | |
| 375 ((string-match "^[ \t]*noon[ \t]*\\'" time2conv) | |
| 376 (* 12 60)) | |
| 377 (t | |
| 378 (let ((hr 0) | |
| 379 (min 0)) | |
| 380 (or (string-match | |
| 381 "\\`[ \t]*\\([0-9][0-9]?\\)[ \t]*\\(:[ \t]*\\([0-9][0-9]\\)\\)?[ \t]*\\(am\\|pm\\)?" | |
| 382 time2conv) | |
| 383 (error "unparsable time \"%s\"" time2conv)) | |
| 384 (setq hr (string-to-int | |
| 385 (substring time2conv | |
| 386 (match-beginning 1) (match-end 1)))) | |
| 387 (if (match-beginning 3) | |
| 388 (setq min (string-to-int | |
| 389 (substring time2conv | |
| 390 (match-beginning 3) (match-end 3))))) | |
| 391 ;; convert the time appointment time into 24 hour time | |
| 392 (if (match-beginning 4) | |
| 393 (progn | |
| 394 (if (or (= hr 0) (> hr 12)) | |
| 395 (error "mixing 12hr and 24 hr time! %s" time2conv)) | |
| 396 (if (string-match "am" | |
| 397 (substring time2conv (match-beginning 4))) | |
| 398 (if (= hr 12) (setq hr 0)) | |
| 399 (if (< hr 12) (setq hr (+ 12 hr)))))) | |
| 400 (if (> min 59) (error "minutes outa bounds - %s" time2conv)) | |
| 401 (+ (* hr 60) min))))) | |
| 402 | |
| 403 | |
| 404 (defun appt-current-time-in-seconds () | |
| 405 "returns the current time in seconds since midnight." | |
| 406 (let* ((str (current-time-string)) | |
| 407 (hour (string-to-int (substring str 11 13))) | |
| 408 (min (string-to-int (substring str 14 16)))) | |
| 409 (+ (* hour 60) min))) | |
| 410 | |
| 411 | |
| 412 (defun appt-sort-list (appt-list) | |
| 413 (sort (copy-sequence appt-list) | |
| 414 (function (lambda (x y) | |
| 415 (< (car (car x)) (car (car y))))))) | |
| 416 | |
| 417 (defun appt-diary-entries () | |
| 418 (let ((list-diary-entries-hook '(appt-make-list)) | |
| 419 (diary-display-hook nil) | |
| 420 (diary-list-include-blanks nil)) | |
| 421 ;; this will set appt-time-msg-list. | |
| 422 (diary 1) | |
| 423 appt-time-msg-list)) | |
| 424 | |
| 425 (defun appt-initialize () | |
| 426 " Read your `diary-file' and remember today's appointments. Call this from | |
| 427 your .emacs file, or any time you want your .diary file re-read (this happens | |
| 428 automatically at midnight to move to notice the next day's appointments). | |
| 429 | |
| 430 The time must be at the beginning of a line for it to be put in the | |
| 431 appointments list. | |
| 432 02/23/89 | |
| 433 12:00pm lunch | |
| 434 Wednesday | |
| 435 10:00am group meeting" | |
| 436 (install-display-time-hook) | |
| 437 (let ((n (length (appt-diary-entries)))) | |
| 438 (cond ((= n 0) (message "no appointments today.")) | |
| 439 ((= n 1) (message "1 appointment today.")) | |
| 440 (t (message (format "%d appointments today." n)))))) | |
| 441 | |
| 442 (defun appt-make-list () | |
| 443 "Don't call this directly; call appt-initialize or appt-diary-entries." | |
| 444 (setq appt-time-msg-list nil) | |
| 445 (if diary-entries-list | |
| 446 ;; Cycle through the entry-list (diary-entries-list) looking for | |
| 447 ;; entries beginning with a time. If the entry begins with a time, | |
| 448 ;; add it to the appt-time-msg-list. Then sort the list. | |
| 449 ;; | |
| 450 (let ((entry-list diary-entries-list) | |
| 451 (new-appts '())) | |
| 452 (while (and entry-list | |
| 453 (calendar-date-equal | |
| 454 (calendar-current-date) (car (car entry-list)))) | |
| 455 (let ((time-string (car (cdr (car entry-list))))) | |
| 456 (while (string-match | |
| 457 "\\`[ \t\n]*\\([0-9]?[0-9]\\(:[0-9][0-9]\\)?[ \t]*\\(am\\|pm\\)?\\|noon\\|midnight\\|midnite\\).*$" | |
| 458 time-string) | |
| 459 (let* ((eol (match-end 0)) | |
| 460 (appt-time-string | |
| 461 (substring time-string (match-beginning 1) | |
| 462 (match-end 1))) | |
| 463 (appt-msg-string | |
| 464 (substring time-string (match-end 1) eol)) | |
| 465 (appt-time (list (appt-convert-time appt-time-string)))) | |
| 466 (setq time-string (substring time-string eol) | |
| 467 new-appts (cons (cons appt-time | |
| 468 (list (concat appt-time-string ":" | |
| 469 appt-msg-string))) | |
| 470 new-appts)))) | |
| 471 (if appt-check-time-syntax | |
| 472 (while (string-match "\n*\\([^\n]+\\)$" time-string) | |
| 473 (beep) | |
| 474 (message "Unparsable time: %s" | |
| 475 (substring time-string (match-beginning 1) | |
| 476 (match-end 1))) | |
| 477 (sit-for 3) | |
| 478 (setq time-string (substring time-string (match-end 0))))) | |
| 479 | |
| 480 ) | |
| 481 (setq entry-list (cdr entry-list))) | |
| 482 (setq appt-time-msg-list ; seems we can't nconc this list... | |
| 483 (append (nreverse new-appts) appt-time-msg-list)))) | |
| 484 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)) | |
| 485 ;; | |
| 486 ;; Get the current time and convert it to minutes from midnight. ie. 12:01am | |
| 487 ;; = 1, midnight = 0, so that the elements in the list that are earlier than | |
| 488 ;; the present time can be removed. | |
| 489 ;; | |
| 490 (let ((cur-comp-time (appt-current-time-in-seconds)) | |
| 491 (appt-comp-time (car (car (car appt-time-msg-list))))) | |
| 492 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) | |
| 493 (setq appt-time-msg-list (cdr appt-time-msg-list)) | |
| 494 (if appt-time-msg-list | |
| 495 (setq appt-comp-time (car (car (car appt-time-msg-list))))))) | |
| 496 appt-time-msg-list) | |
| 497 | |
| 498 | |
| 499 (defun appt-beep (&optional final-p) | |
| 500 (cond ((null appt-audible) nil) | |
| 501 ((numberp appt-audible) | |
| 502 (let ((i appt-audible)) | |
| 503 (while (> i 0) (beep) (setq i (1- i))))) | |
| 504 ((consp appt-audible) | |
| 505 (let ((i (car appt-audible)) | |
| 506 (j (cdr appt-audible))) | |
| 507 (if (consp j) (setq j (car j))) | |
| 508 (while (> i 0) | |
| 509 (if (fboundp 'play-sound) | |
| 510 (beep nil (if final-p 'appt-final 'appt)) | |
| 511 (beep)) | |
| 512 (sleep-for j) | |
| 513 (setq i (1- i))))) | |
| 514 (t (beep)))) | |
| 515 | |
| 516 | |
| 517 (defun appt-check () | |
| 518 "Check for an appointment and update the mode line and minibuffer if | |
| 519 desired. Note: the time must be the first thing in the line in the diary | |
| 520 for a warning to be issued. | |
| 521 The format of the time can be either 24 hour or am/pm. Example: | |
| 522 | |
| 523 02/23/89 | |
| 524 18:00 Dinner | |
| 525 Thursday | |
| 526 11:45am Lunch meeting. | |
| 527 | |
| 528 The following variables control the action of the notification: | |
| 529 | |
| 530 appt-issue-message If this variable is nil, then the code in this | |
| 531 file does nothing. | |
| 532 appt-msg-countdown-list Specifies how much warning you want before | |
| 533 appointments. | |
| 534 appt-audible Whether to beep when it's notification-time. | |
| 535 appt-display-mode-line Whether to display a countdown to the next | |
| 536 appointment in the mode-line. | |
| 537 appt-announce-method The function used to do the notifications. | |
| 538 'appt-window-announce to do it in a pop-up | |
| 539 window, 'appt-message-announce or | |
| 540 'appt-persistent-message-announce to do it | |
| 541 in the echo-area. | |
| 542 appt-display-duration If appt-announce-method is set to the function | |
| 543 'appt-window-announce, this specifies how many | |
| 544 seconds the pop-up window should stick around. | |
| 545 | |
| 546 This function is run from the `loadst' or `wakeup' process for display-time. | |
| 547 Therefore, you need to have (display-time) in your .emacs file." | |
| 548 (if appt-issue-message | |
| 549 (let ((min-to-app -1)) | |
| 550 ;; Get the current time and convert it to minutes | |
| 551 ;; from midnight. ie. 12:01am = 1, midnight = 0. | |
| 552 (let* ((cur-comp-time (appt-current-time-in-seconds)) | |
| 553 ;; If the current time is the same as the tick, just return. | |
| 554 ;; This means that this function has been called more than once | |
| 555 ;; in the current minute, which is not useful. | |
| 556 (shut-up-this-time (= cur-comp-time appt-check-tick)) | |
| 557 (turnover-p (> appt-check-tick cur-comp-time))) | |
| 558 (setq appt-check-tick cur-comp-time) | |
| 559 ;; | |
| 560 ;; If it is now the next day (we have crossed midnight since the last | |
| 561 ;; time this was called) then we should update our appointments to | |
| 562 ;; today's list. | |
| 563 (if turnover-p (appt-diary-entries)) | |
| 564 ;; | |
| 565 ;; Get the first time off of the list and calculate the number | |
| 566 ;; of minutes until the appointment. | |
| 567 (if appt-time-msg-list | |
| 568 (let ((appt-comp-time (car (car (car appt-time-msg-list))))) | |
| 569 (setq min-to-app (- appt-comp-time cur-comp-time)) | |
| 570 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) | |
| 571 (setq appt-time-msg-list (cdr appt-time-msg-list)) | |
| 572 (if appt-time-msg-list | |
| 573 (setq appt-comp-time (car (car (car appt-time-msg-list)))))) | |
| 574 ;; | |
| 575 ;; If we have an appointment between midnight and warning-time | |
| 576 ;; minutes after midnight, we must begin to issue a message | |
| 577 ;; before midnight. Midnight is considered 0 minutes and 11:59pm | |
| 578 ;; is 1439 minutes. Therefore we must recalculate the minutes to | |
| 579 ;; appointment variable. It is equal to the number of minutes | |
| 580 ;; before midnight plus the number of minutes after midnight our | |
| 581 ;; appointment is. | |
| 582 ;; | |
| 583 ;; ## I don't think this does anything -- it would if it were | |
| 584 ;; (for example) a 12:01am appt on the list at 11:55pm, but that | |
| 585 ;; can't ever happen, because the applicable 12:01am appt is for | |
| 586 ;; tomorrow, not today, and we only have today's diary list. | |
| 587 ;; It's not simply a matter of concatenating two days together, | |
| 588 ;; either, because then tuesday's appts would be signalled on | |
| 589 ;; monday. We have to do a real one-day lookahead -- keep a list | |
| 590 ;; of tomorrow's appts, and check it when near midnight. | |
| 591 ;; | |
| 592 (if (and (< appt-comp-time (apply 'max appt-msg-countdown-list)) | |
| 593 (> (+ cur-comp-time (apply 'max appt-msg-countdown-list)) | |
| 594 max-time)) | |
| 595 (setq min-to-app (+ (- (1+ max-time) cur-comp-time)) | |
| 596 appt-comp-time)) | |
| 597 ;; | |
| 598 ;; issue warning if the appointment time is within warning-time | |
| 599 (cond | |
| 600 ;; if there should not be any notifications in the mode-line, | |
| 601 ;; clear it. | |
| 602 ((> min-to-app (apply 'max appt-msg-countdown-list)) | |
| 603 (appt-display-mode-line nil)) | |
| 604 ;; do nothing if this is the second time this minute we've | |
| 605 ;; gotten here, of if we shouldn't be notifying right now. | |
| 606 ((or shut-up-this-time | |
| 607 (and (not (= min-to-app 0)) | |
| 608 (not (memq min-to-app appt-msg-countdown-list)))) | |
| 609 nil) | |
| 610 | |
| 611 ((and (= min-to-app 0) | |
| 612 (string-match "%%(" (nth 1 (car appt-time-msg-list)))) | |
| 613 ;; | |
| 614 ;; If this is a magic evaluating-notification, evaluate it. | |
| 615 ;; these kinds of notifications aren't subject to the | |
| 616 ;; appt-msg-countdown-list. | |
| 617 ;; | |
| 618 (let* ((list-string (substring (nth 1 (car appt-time-msg-list)) | |
| 619 (1- (match-end 0)))) | |
| 620 (form (condition-case () | |
| 621 (read list-string) | |
| 622 (error | |
| 623 (ding) | |
| 624 (message "Appt: error reading from \"%s\"" | |
| 625 (nth 1 (car appt-time-msg-list))) | |
| 626 (sit-for 2) | |
| 627 nil)))) | |
| 628 (eval form))) | |
| 629 | |
| 630 ((and (<= min-to-app (apply 'max appt-msg-countdown-list)) | |
| 631 (>= min-to-app 0)) | |
| 632 ;; | |
| 633 ;; produce a notification. | |
| 634 (appt-beep (= min-to-app 0)) | |
| 635 (funcall appt-announce-method min-to-app | |
| 636 (car appt-time-msg-list)) | |
| 637 ;; update mode line and expire if necessary | |
| 638 (appt-display-mode-line min-to-app) | |
| 639 ;; if it's expired, remove it. | |
| 640 (if (= min-to-app 0) | |
| 641 (setq appt-time-msg-list (cdr appt-time-msg-list)))) | |
| 642 (t | |
| 643 ;; else we're not near any appointment, or there are no | |
| 644 ;; apointments; make sure mode line is clear. | |
| 645 (appt-display-mode-line nil)))) | |
| 646 (appt-display-mode-line nil)))))) | |
| 647 | |
| 648 | |
| 649 | |
| 650 ;;; Interactively adding and deleting appointments | |
| 651 | |
| 652 (defun appt-add (new-appt-time new-appt-msg) | |
| 653 "Adds an appointment to the list of appointments for the day at TIME | |
| 654 and issue MESSAGE. The time should be in either 24 hour format or | |
| 655 am/pm format. " | |
| 656 | |
| 657 (interactive "sTime (hh:mm[am/pm]): \nsMessage: ") | |
| 658 (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time) | |
| 659 nil | |
| 660 (error "Unacceptable time-string")) | |
| 661 | |
| 662 (let* ((appt-time-string (concat new-appt-time " " new-appt-msg)) | |
| 663 (appt-time (list (appt-convert-time new-appt-time))) | |
| 664 (time-msg (cons appt-time (list appt-time-string)))) | |
| 665 (setq appt-time-msg-list (append appt-time-msg-list | |
| 666 (list time-msg))) | |
| 667 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) | |
| 668 | |
| 669 (defun appt-delete () | |
| 670 "Deletes an appointment from the list of appointments." | |
| 671 (interactive) | |
| 672 (let* ((tmp-msg-list appt-time-msg-list)) | |
| 673 (while tmp-msg-list | |
| 674 (let* ((element (car tmp-msg-list)) | |
| 675 (prompt-string (concat "Delete " | |
| 676 (prin1-to-string (car (cdr element))) | |
| 677 " from list? ")) | |
| 678 (test-input (y-or-n-p prompt-string))) | |
| 679 (setq tmp-msg-list (cdr tmp-msg-list)) | |
| 680 (if test-input | |
| 681 (setq appt-time-msg-list (delq element appt-time-msg-list))))) | |
| 682 (message ""))) | |
| 683 | |
| 684 | |
| 685 ;;; Patching in to existing time code to install our hook. | |
| 686 | |
| 687 (defvar display-time-hook nil | |
| 688 "*List of functions to be called when the time is updated on the mode line.") | |
| 689 | |
| 690 (setq display-time-hook 'appt-check) | |
| 691 | |
| 692 (defvar display-time-hook-installed nil) | |
| 693 | |
| 694 (defun install-display-time-hook () | |
| 695 (if display-time-hook-installed ;; only do this stuff once! | |
| 696 nil | |
| 697 (let ((old-fn (if (or (featurep 'reportmail) | |
| 698 ;; old reportmail without a provide statement | |
| 699 (and (fboundp 'display-time-filter-18-55) | |
| 700 (fboundp 'display-time-filter-18-57))) | |
| 701 (if (and (featurep 'itimer) ; XEmacs reportmail.el | |
| 702 (fboundp 'display-time-timer-function)) | |
| 703 'display-time-timer-function | |
| 704 ;; older reportmail, or no timer.el. | |
| 705 (if (string-match "18\\.5[0-5]" (emacs-version)) | |
| 706 'display-time-filter-18-55 | |
| 707 'display-time-filter-18-57)) | |
| 708 ;; othewise, time.el | |
| 709 (if (and (featurep 'itimer) | |
| 710 (fboundp 'display-time-function)) ; XEmacs | |
| 711 'display-time-function | |
| 712 'display-time-filter)))) | |
| 713 ;; we're about to redefine it... | |
| 714 (fset 'old-display-time-filter (symbol-function old-fn)) | |
| 715 (fset old-fn | |
| 716 (function (lambda (&rest args) ;; ...here's the revised definition | |
| 717 "Revised version of the original function: this version calls a hook." | |
| 718 (apply 'old-display-time-filter args) | |
| 719 (run-hooks 'display-time-hook))))) | |
| 720 (setq display-time-hook-installed t) | |
| 721 )) | |
| 722 | |
| 723 (provide 'appt) |