| 1 | ;;; appt.el --- appointment notification functions |
| 2 | |
| 3 | ;; Copyright (C) 1989-1990, 1994, 1998, 2001-2011 |
| 4 | ;; Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Neil Mager <neilm@juliet.ll.mit.edu> |
| 7 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
| 8 | ;; Keywords: calendar |
| 9 | ;; Package: calendar |
| 10 | |
| 11 | ;; This file is part of GNU Emacs. |
| 12 | |
| 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 14 | ;; it under the terms of the GNU General Public License as published by |
| 15 | ;; the Free Software Foundation, either version 3 of the License, or |
| 16 | ;; (at your option) any later version. |
| 17 | |
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 21 | ;; GNU General Public License for more details. |
| 22 | |
| 23 | ;; You should have received a copy of the GNU General Public License |
| 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 25 | |
| 26 | ;;; Commentary: |
| 27 | |
| 28 | ;; |
| 29 | ;; appt.el - visible and/or audible notification of |
| 30 | ;; appointments from diary file. |
| 31 | ;; |
| 32 | ;; |
| 33 | ;; Thanks to Edward M. Reingold for much help and many suggestions, |
| 34 | ;; And to many others for bug fixes and suggestions. |
| 35 | ;; |
| 36 | ;; |
| 37 | ;; This functions in this file will alert the user of a |
| 38 | ;; pending appointment based on his/her diary file. This package |
| 39 | ;; is documented in the Emacs manual. |
| 40 | ;; |
| 41 | ;; To activate this package, simply use (appt-activate 1). |
| 42 | ;; A `diary-file' with appointments of the format described in the |
| 43 | ;; documentation of the function `appt-check' is required. |
| 44 | ;; Relevant customizable variables are also listed in the |
| 45 | ;; documentation of that function. |
| 46 | ;; |
| 47 | ;; Today's appointment list is initialized from the diary when this |
| 48 | ;; package is activated. Additionally, the appointments list is |
| 49 | ;; recreated automatically at 12:01am for those who do not logout |
| 50 | ;; every day or are programming late. It is also updated when the |
| 51 | ;; `diary-file' (or a file it includes) is saved. Calling |
| 52 | ;; `appt-check' with an argument (or re-enabling the package) forces a |
| 53 | ;; re-initialization at any time. |
| 54 | ;; |
| 55 | ;; In order to add or delete items from today's list, without |
| 56 | ;; changing the diary file, use `appt-add' and `appt-delete'. |
| 57 | ;; |
| 58 | |
| 59 | ;; Brief internal description - Skip this if you are not interested! |
| 60 | ;; |
| 61 | ;; The function `appt-make-list' creates the appointments list which |
| 62 | ;; `appt-check' reads. |
| 63 | ;; |
| 64 | ;; You can change the way the appointment window is created/deleted by |
| 65 | ;; setting the variables `appt-disp-window-function' and |
| 66 | ;; `appt-delete-window-function'. For instance, you could be set them |
| 67 | ;; to functions that display appointments in pop-up frames, which are |
| 68 | ;; lowered or iconified after `appt-display-interval' minutes. |
| 69 | ;; |
| 70 | |
| 71 | ;;; Code: |
| 72 | |
| 73 | (require 'diary-lib) |
| 74 | |
| 75 | |
| 76 | (defgroup appt nil |
| 77 | "Appointment notification." |
| 78 | :prefix "appt-" |
| 79 | :group 'calendar) |
| 80 | |
| 81 | (defcustom appt-message-warning-time 12 |
| 82 | "Default time in minutes before an appointment that the warning begins. |
| 83 | You probably want to make `appt-display-interval' a factor of this." |
| 84 | :type 'integer |
| 85 | :group 'appt) |
| 86 | |
| 87 | (defcustom appt-warning-time-regexp "warntime \\([0-9]+\\)" |
| 88 | "Regexp matching a string giving the warning time for an appointment. |
| 89 | The first subexpression matches the time in minutes (an integer). |
| 90 | This overrides the default `appt-message-warning-time'. |
| 91 | You may want to put this inside a diary comment (see `diary-comment-start'). |
| 92 | For example, to be warned 30 minutes in advance of an appointment: |
| 93 | 2011/06/01 12:00 Do something ## warntime 30 |
| 94 | " |
| 95 | :version "24.1" |
| 96 | :type 'regexp |
| 97 | :group 'appt) |
| 98 | |
| 99 | (defcustom appt-audible t |
| 100 | "Non-nil means beep to indicate appointment." |
| 101 | :type 'boolean |
| 102 | :group 'appt) |
| 103 | |
| 104 | ;; TODO - add popup. |
| 105 | (defcustom appt-display-format 'window |
| 106 | "How appointment reminders should be displayed. |
| 107 | The options are: |
| 108 | window - use a separate window |
| 109 | echo - use the echo area |
| 110 | nil - no visible reminder. |
| 111 | See also `appt-audible' and `appt-display-mode-line'." |
| 112 | :type '(choice |
| 113 | (const :tag "Separate window" window) |
| 114 | (const :tag "Echo-area" echo) |
| 115 | (const :tag "No visible display" nil)) |
| 116 | :group 'appt |
| 117 | :version "24.1") ; no longer inherit from deleted obsolete variables |
| 118 | |
| 119 | (defcustom appt-display-mode-line t |
| 120 | "Non-nil means display minutes to appointment and time on the mode line. |
| 121 | This is in addition to any other display of appointment messages. |
| 122 | The mode line updates every minute, independent of the value of |
| 123 | `appt-display-interval'." |
| 124 | :type 'boolean |
| 125 | :group 'appt) |
| 126 | |
| 127 | (defcustom appt-display-duration 10 |
| 128 | "The number of seconds an appointment message is displayed. |
| 129 | Only relevant if reminders are to be displayed in their own window." |
| 130 | :type 'integer |
| 131 | :group 'appt) |
| 132 | |
| 133 | (defcustom appt-display-diary t |
| 134 | "Non-nil displays the diary when the appointment list is first initialized. |
| 135 | This occurs when this package is first activated, and then at |
| 136 | midnight when the appointment list updates." |
| 137 | :type 'boolean |
| 138 | :group 'appt) |
| 139 | |
| 140 | (defcustom appt-display-interval 3 |
| 141 | "Interval in minutes at which to display appointment reminders. |
| 142 | Once an appointment becomes due, Emacs displays reminders every |
| 143 | `appt-display-interval' minutes. You probably want to make |
| 144 | `appt-message-warning-time' be a multiple of this, so that you get |
| 145 | a final message displayed precisely when the appointment is due. |
| 146 | |
| 147 | Note that this variable controls the interval at which |
| 148 | `appt-display-message' is called. The mode line display (if active) |
| 149 | always updates every minute." |
| 150 | :type 'integer |
| 151 | :group 'appt) |
| 152 | |
| 153 | (defcustom appt-disp-window-function 'appt-disp-window |
| 154 | "Function called to display appointment window. |
| 155 | Only relevant if reminders are being displayed in a window. |
| 156 | It should take three string arguments: the number of minutes till |
| 157 | the appointment, the current time, and the text of the appointment." |
| 158 | :type 'function |
| 159 | :group 'appt) |
| 160 | |
| 161 | (defcustom appt-delete-window-function 'appt-delete-window |
| 162 | "Function called to remove appointment window and buffer. |
| 163 | Only relevant if reminders are being displayed in a window." |
| 164 | :type 'function |
| 165 | :group 'appt) |
| 166 | |
| 167 | |
| 168 | ;;; Internal variables below this point. |
| 169 | |
| 170 | (defconst appt-buffer-name "*appt-buf*" |
| 171 | "Name of the appointments buffer.") |
| 172 | |
| 173 | ;; TODO Turn this into an alist? It would be easier to add more |
| 174 | ;; optional elements. |
| 175 | ;; Why is the first element (MINUTES) rather than just MINUTES? |
| 176 | ;; It may just inherit from diary-entries-list, where we have |
| 177 | ;; ((MONTH DAY YEAR) ENTRY) |
| 178 | (defvar appt-time-msg-list nil |
| 179 | "The list of appointments for today. |
| 180 | Use `appt-add' and `appt-delete' to add and delete appointments. |
| 181 | The original list is generated from today's `diary-entries-list', and |
| 182 | can be regenerated using the function `appt-check'. |
| 183 | Each element of the generated list has the form |
| 184 | \((MINUTES) STRING [FLAG] [WARNTIME]) |
| 185 | where MINUTES is the time in minutes of the appointment after midnight, |
| 186 | and STRING is the description of the appointment. |
| 187 | FLAG and WARNTIME are not always present. A non-nil FLAG |
| 188 | indicates that the element was made with `appt-add', so calling |
| 189 | `appt-make-list' again should preserve it. If WARNTIME is non-nil, |
| 190 | it is an integer to use in place of `appt-message-warning-time'.") |
| 191 | |
| 192 | (defconst appt-max-time (1- (* 24 60)) |
| 193 | "11:59pm in minutes - number of minutes in a day minus 1.") |
| 194 | |
| 195 | (defvar appt-mode-string nil |
| 196 | "String being displayed in the mode line saying you have an appointment. |
| 197 | The actual string includes the amount of time till the appointment. |
| 198 | Only used if `appt-display-mode-line' is non-nil.") |
| 199 | (put 'appt-mode-string 'risky-local-variable t) ; for 'face property |
| 200 | |
| 201 | (defvar appt-prev-comp-time nil |
| 202 | "Time of day (mins since midnight) at which we last checked appointments.") |
| 203 | |
| 204 | (defvar appt-display-count 0 |
| 205 | "Internal variable used to count number of consecutive reminders.") |
| 206 | |
| 207 | (defvar appt-timer nil |
| 208 | "Timer used for diary appointment notifications (`appt-check'). |
| 209 | If this is non-nil, appointment checking is active.") |
| 210 | |
| 211 | |
| 212 | ;;; Functions. |
| 213 | |
| 214 | (defun appt-display-message (string mins) |
| 215 | "Display a reminder about an appointment. |
| 216 | The string STRING describes the appointment, due in integer MINS minutes. |
| 217 | The arguments may also be lists, where each element relates to a |
| 218 | separate appointment. The variable `appt-display-format' controls |
| 219 | the format of the visible reminder. If `appt-audible' is non-nil, |
| 220 | also calls `beep' for an audible reminder." |
| 221 | (if appt-audible (beep 1)) |
| 222 | ;; Backwards compatibility: avoid passing lists to a-d-w-f if not necessary. |
| 223 | (and (listp mins) |
| 224 | (= (length mins) 1) |
| 225 | (setq mins (car mins) |
| 226 | string (car string))) |
| 227 | (cond ((eq appt-display-format 'window) |
| 228 | ;; TODO use calendar-month-abbrev-array rather than %b? |
| 229 | (let ((time (format-time-string "%a %b %e " (current-time))) |
| 230 | err) |
| 231 | (condition-case err |
| 232 | (funcall appt-disp-window-function |
| 233 | (if (listp mins) |
| 234 | (mapcar 'number-to-string mins) |
| 235 | (number-to-string mins)) |
| 236 | time string) |
| 237 | (wrong-type-argument |
| 238 | (if (not (listp mins)) |
| 239 | (signal (car err) (cdr err)) |
| 240 | (message "Argtype error in `appt-disp-window-function' - \ |
| 241 | update it for multiple appts?") |
| 242 | ;; Fallback to just displaying the first appt, as we used to. |
| 243 | (funcall appt-disp-window-function |
| 244 | (number-to-string (car mins)) time |
| 245 | (car string)))))) |
| 246 | (run-at-time (format "%d sec" appt-display-duration) |
| 247 | nil |
| 248 | appt-delete-window-function)) |
| 249 | ((eq appt-display-format 'echo) |
| 250 | (message "%s" (if (listp string) |
| 251 | (mapconcat 'identity string "\n") |
| 252 | string))))) |
| 253 | |
| 254 | |
| 255 | (defun appt-check (&optional force) |
| 256 | "Check for an appointment and update any reminder display. |
| 257 | If optional argument FORCE is non-nil, reparse the diary file for |
| 258 | appointments. Otherwise the diary file is only parsed once per day, |
| 259 | or when it (or a file it includes) is saved. |
| 260 | |
| 261 | Note: the time must be the first thing in the line in the diary |
| 262 | for a warning to be issued. The format of the time can be either |
| 263 | 24 hour or am/pm. For example: |
| 264 | |
| 265 | 02/23/89 |
| 266 | 18:00 Dinner |
| 267 | |
| 268 | Thursday |
| 269 | 11:45am Lunch meeting. |
| 270 | |
| 271 | Appointments are checked every `appt-display-interval' minutes. |
| 272 | The following variables control appointment notification: |
| 273 | |
| 274 | `appt-display-format' |
| 275 | Controls the format in which reminders are displayed. |
| 276 | |
| 277 | `appt-audible' |
| 278 | Non-nil means there is an audible component to reminders. |
| 279 | |
| 280 | `appt-message-warning-time' |
| 281 | The default number of minutes in advance at which reminders |
| 282 | should start. |
| 283 | |
| 284 | `appt-display-mode-line' |
| 285 | Non-nil means show in the mode line a countdown to the |
| 286 | time of each appointment, once reminders start. |
| 287 | |
| 288 | `appt-display-interval' |
| 289 | Interval in minutes at which to display appointment messages. |
| 290 | |
| 291 | `appt-display-diary' |
| 292 | Non-nil means display the diary whenever the appointment list is |
| 293 | initialized (e.g. the first time we check for appointments each day). |
| 294 | |
| 295 | The following variables are only relevant if reminders are being |
| 296 | displayed in a window: |
| 297 | |
| 298 | `appt-display-duration' |
| 299 | Number of seconds for which an appointment message is displayed. |
| 300 | |
| 301 | `appt-disp-window-function' |
| 302 | Function called to display appointment window. |
| 303 | |
| 304 | `appt-delete-window-function' |
| 305 | Function called to remove appointment window and buffer." |
| 306 | (interactive "P") ; so people can force updates |
| 307 | (let* ((min-to-app -1) |
| 308 | (prev-appt-mode-string appt-mode-string) |
| 309 | (prev-appt-display-count appt-display-count) |
| 310 | ;; Convert current time to minutes after midnight (12.01am = 1). |
| 311 | (now (decode-time)) |
| 312 | (now-mins (+ (* 60 (nth 2 now)) (nth 1 now))) |
| 313 | appt-mins appt-warn-time) |
| 314 | (save-excursion ; FIXME ? |
| 315 | ;; At first check in any day, update appointments to today's list. |
| 316 | (if (or force ; eg initialize, diary save |
| 317 | (null appt-prev-comp-time) ; first check |
| 318 | (< now-mins appt-prev-comp-time)) ; new day |
| 319 | (ignore-errors |
| 320 | (let ((diary-hook (if (assoc 'appt-make-list diary-hook) |
| 321 | diary-hook |
| 322 | (cons 'appt-make-list diary-hook)))) |
| 323 | (if appt-display-diary |
| 324 | (diary) |
| 325 | ;; Not displaying the diary, so we can ignore |
| 326 | ;; diary-number-of-entries. Since appt.el only |
| 327 | ;; works on a daily basis, no need for more entries. |
| 328 | (diary-list-entries (calendar-current-date) 1 t))))) |
| 329 | ;; Reset everything now in case we somehow missed a minute, |
| 330 | ;; or (more likely) an appt was deleted. (This is the only |
| 331 | ;; reason we need prev-appt-display-count.) |
| 332 | (setq appt-prev-comp-time now-mins |
| 333 | appt-mode-string nil |
| 334 | appt-display-count 0) |
| 335 | ;; Remove any entries that are in the past. |
| 336 | ;; FIXME how can there be any such entries, given that this |
| 337 | ;; function removes entries when they hit zero minutes, |
| 338 | ;; and appt-make-list doesn't add any in the past in the first place? |
| 339 | (while (and appt-time-msg-list |
| 340 | (< (setq appt-mins (caar (car appt-time-msg-list))) |
| 341 | now-mins)) |
| 342 | (setq appt-time-msg-list (cdr appt-time-msg-list))) |
| 343 | ;; If there are entries in the list, and the user wants a |
| 344 | ;; message issued, get the first time off of the list and |
| 345 | ;; calculate the number of minutes until the appointment. |
| 346 | (when appt-time-msg-list |
| 347 | (setq appt-warn-time (or (nth 3 (car appt-time-msg-list)) |
| 348 | appt-message-warning-time) |
| 349 | min-to-app (- appt-mins now-mins)) |
| 350 | ;; If we have an appointment between midnight and |
| 351 | ;; `appt-warn-time' minutes after midnight, we |
| 352 | ;; must begin to issue a message before midnight. Midnight |
| 353 | ;; is considered 0 minutes and 11:59pm is 1439 |
| 354 | ;; minutes. Therefore we must recalculate the minutes to |
| 355 | ;; appointment variable. It is equal to the number of |
| 356 | ;; minutes before midnight plus the number of minutes after |
| 357 | ;; midnight our appointment is. |
| 358 | ;; FIXME but appt-make-list constructs appt-time-msg-list to only |
| 359 | ;; contain entries with today's date, so this cannot work? |
| 360 | ;; Also above we just removed anything with appt-mins < now-mins. |
| 361 | (if (and (< appt-mins appt-warn-time) |
| 362 | (> (+ now-mins appt-warn-time) appt-max-time)) |
| 363 | (setq min-to-app (+ (- (1+ appt-max-time) now-mins) |
| 364 | appt-mins))) |
| 365 | ;; Issue warning if the appointment time is within |
| 366 | ;; appt-message-warning time. |
| 367 | (when (and (<= min-to-app appt-warn-time) |
| 368 | (>= min-to-app 0)) |
| 369 | ;; This is true every appt-display-interval minutes. |
| 370 | (and (zerop (mod prev-appt-display-count appt-display-interval)) |
| 371 | (appt-display-message (cadr (car appt-time-msg-list)) |
| 372 | min-to-app)) |
| 373 | (when appt-display-mode-line |
| 374 | (setq appt-mode-string |
| 375 | (concat " " (propertize |
| 376 | (format "App't %s" |
| 377 | (if (zerop min-to-app) "NOW" |
| 378 | (format "in %s min." min-to-app))) |
| 379 | 'face 'mode-line-emphasis)))) |
| 380 | ;; When an appointment is reached, delete it from the |
| 381 | ;; list. Reset the count to 0 in case we display another |
| 382 | ;; appointment on the next cycle. |
| 383 | (if (zerop min-to-app) |
| 384 | (setq appt-time-msg-list (cdr appt-time-msg-list) |
| 385 | appt-display-count 0) |
| 386 | (setq appt-display-count (1+ prev-appt-display-count))))) |
| 387 | ;; If we have changed the mode line string, redisplay all mode lines. |
| 388 | (and appt-display-mode-line |
| 389 | (not (string-equal appt-mode-string prev-appt-mode-string)) |
| 390 | (progn |
| 391 | (force-mode-line-update t) |
| 392 | ;; If the string now has a notification, redisplay right now. |
| 393 | (if appt-mode-string |
| 394 | (sit-for 0))))))) |
| 395 | |
| 396 | (defun appt-disp-window (min-to-app new-time appt-msg) |
| 397 | "Display appointment due in MIN-TO-APP (a string) minutes. |
| 398 | NEW-TIME is a string giving the current date. |
| 399 | Displays the appointment message APPT-MSG in a separate buffer. |
| 400 | The arguments may also be lists, where each element relates to a |
| 401 | separate appointment." |
| 402 | (let ((this-window (selected-window)) |
| 403 | (appt-disp-buf (get-buffer-create appt-buffer-name))) |
| 404 | ;; Make sure we're not in the minibuffer before splitting the window. |
| 405 | ;; FIXME this seems needlessly complicated? |
| 406 | (when (minibufferp) |
| 407 | (other-window 1) |
| 408 | (and (minibufferp) (display-multi-frame-p) (other-frame 1))) |
| 409 | (if (cdr (assq 'unsplittable (frame-parameters))) |
| 410 | ;; In an unsplittable frame, use something somewhere else. |
| 411 | (progn |
| 412 | (set-buffer appt-disp-buf) |
| 413 | (display-buffer appt-disp-buf)) |
| 414 | (unless (or (special-display-p (buffer-name appt-disp-buf)) |
| 415 | (same-window-p (buffer-name appt-disp-buf))) |
| 416 | ;; By default, split the bottom window and use the lower part. |
| 417 | (appt-select-lowest-window) |
| 418 | ;; Split the window, unless it's too small to do so. |
| 419 | (when (>= (window-height) (* 2 window-min-height)) |
| 420 | (select-window (split-window)))) |
| 421 | (switch-to-buffer appt-disp-buf)) |
| 422 | (or (listp min-to-app) |
| 423 | (setq min-to-app (list min-to-app) |
| 424 | appt-msg (list appt-msg))) |
| 425 | ;; I don't really see the point of the new-time argument. |
| 426 | ;; It repeatedly reminds you of the date? |
| 427 | ;; It would make more sense if it was eg the time of the appointment. |
| 428 | ;; Let's allow it to be a list or not independent of the other elements. |
| 429 | (or (listp new-time) |
| 430 | (setq new-time (list new-time))) |
| 431 | ;; All this silliness is just to make the formatting slightly nicer. |
| 432 | (let* ((multiple (> (length min-to-app) 1)) |
| 433 | (sametime (or (not multiple) |
| 434 | (not (delete (car min-to-app) min-to-app)))) |
| 435 | (imin (if sametime (car min-to-app)))) |
| 436 | ;; FIXME Link to diary entry? |
| 437 | (calendar-set-mode-line |
| 438 | (format " Appointment%s %s. %s " |
| 439 | (if multiple "s" "") |
| 440 | (if (equal imin "0") |
| 441 | "now" |
| 442 | (format "in %s minute%s" |
| 443 | (or imin (mapconcat 'identity min-to-app ",")) |
| 444 | (if (equal imin "1") |
| 445 | "" "s"))) |
| 446 | (mapconcat 'identity new-time ", "))) |
| 447 | (setq buffer-read-only nil |
| 448 | buffer-undo-list t) |
| 449 | (erase-buffer) |
| 450 | ;; If we have appointments at different times, prepend the times. |
| 451 | (if sametime |
| 452 | (insert (mapconcat 'identity appt-msg "\n")) |
| 453 | (dotimes (i (length appt-msg)) |
| 454 | (insert (format "%s%sm: %s" (if (> i 0) "\n" "") |
| 455 | (nth i min-to-app) (nth i appt-msg)))))) |
| 456 | (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t)) |
| 457 | (set-buffer-modified-p nil) |
| 458 | (setq buffer-read-only t) |
| 459 | (raise-frame (selected-frame)) |
| 460 | (select-window this-window))) |
| 461 | |
| 462 | (defun appt-delete-window () |
| 463 | "Function called to undisplay appointment messages. |
| 464 | Usually just deletes the appointment buffer." |
| 465 | (let ((window (get-buffer-window appt-buffer-name t))) |
| 466 | (and window |
| 467 | (or (eq window (frame-root-window (window-frame window))) |
| 468 | (delete-window window)))) |
| 469 | (kill-buffer appt-buffer-name) |
| 470 | (if appt-audible |
| 471 | (beep 1))) |
| 472 | |
| 473 | (defun appt-select-lowest-window () |
| 474 | "Select the lowest window on the frame." |
| 475 | (let ((lowest-window (selected-window)) |
| 476 | (bottom-edge (nth 3 (window-edges))) |
| 477 | next-bottom-edge) |
| 478 | (walk-windows (lambda (w) |
| 479 | (when (< bottom-edge (setq next-bottom-edge |
| 480 | (nth 3 (window-edges w)))) |
| 481 | (setq bottom-edge next-bottom-edge |
| 482 | lowest-window w))) 'nomini) |
| 483 | (select-window lowest-window))) |
| 484 | |
| 485 | (defconst appt-time-regexp |
| 486 | "[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?") |
| 487 | |
| 488 | ;;;###autoload |
| 489 | (defun appt-add (time msg &optional warntime) |
| 490 | "Add an appointment for today at TIME with message MSG. |
| 491 | The time should be in either 24 hour format or am/pm format. |
| 492 | Optional argument WARNTIME is an integer (or string) giving the number |
| 493 | of minutes before the appointment at which to start warning. |
| 494 | The default is `appt-message-warning-time'." |
| 495 | (interactive "sTime (hh:mm[am/pm]): \nsMessage: |
| 496 | sMinutes before the appointment to start warning: ") |
| 497 | (unless (string-match appt-time-regexp time) |
| 498 | (error "Unacceptable time-string")) |
| 499 | (and (stringp warntime) |
| 500 | (setq warntime (unless (string-equal warntime "") |
| 501 | (string-to-number warntime)))) |
| 502 | (and warntime |
| 503 | (not (integerp warntime)) |
| 504 | (error "Argument WARNTIME must be an integer, or nil")) |
| 505 | (or appt-timer (appt-activate)) |
| 506 | (let ((time-msg (list (list (appt-convert-time time)) |
| 507 | (concat time " " msg) t))) |
| 508 | ;; It is presently non-sensical to have multiple warnings about |
| 509 | ;; the same appointment with just different delays, but it might |
| 510 | ;; not always be so. TODO |
| 511 | (if warntime (setq time-msg (append time-msg (list warntime)))) |
| 512 | (unless (member time-msg appt-time-msg-list) |
| 513 | (setq appt-time-msg-list |
| 514 | (appt-sort-list (nconc appt-time-msg-list (list time-msg))))))) |
| 515 | |
| 516 | (defun appt-delete () |
| 517 | "Delete an appointment from the list of appointments." |
| 518 | (interactive) |
| 519 | (let ((tmp-msg-list appt-time-msg-list)) |
| 520 | (dolist (element tmp-msg-list) |
| 521 | (if (y-or-n-p (concat "Delete " |
| 522 | ;; We want to quote any doublequotes in the |
| 523 | ;; string, as well as put doublequotes around it. |
| 524 | (prin1-to-string |
| 525 | (substring-no-properties (cadr element) 0)) |
| 526 | " from list? ")) |
| 527 | (setq appt-time-msg-list (delq element appt-time-msg-list))))) |
| 528 | (appt-check) |
| 529 | (message "")) |
| 530 | |
| 531 | |
| 532 | (defvar number) |
| 533 | (defvar original-date) |
| 534 | (defvar diary-entries-list) |
| 535 | |
| 536 | (defun appt-make-list () |
| 537 | "Update the appointments list from today's diary buffer. |
| 538 | The time must be at the beginning of a line for it to be |
| 539 | put in the appointments list (see examples in documentation of |
| 540 | the function `appt-check'). We assume that the variables DATE and |
| 541 | NUMBER hold the arguments that `diary-list-entries' received. |
| 542 | They specify the range of dates that the diary is being processed for. |
| 543 | |
| 544 | Any appointments made with `appt-add' are not affected by this function." |
| 545 | ;; We have something to do if the range of dates that the diary is |
| 546 | ;; considering includes the current date. |
| 547 | (if (and (not (calendar-date-compare |
| 548 | (list (calendar-current-date)) |
| 549 | (list original-date))) |
| 550 | (calendar-date-compare |
| 551 | (list (calendar-current-date)) |
| 552 | (list (calendar-gregorian-from-absolute |
| 553 | (+ (calendar-absolute-from-gregorian original-date) |
| 554 | number))))) |
| 555 | (save-excursion |
| 556 | ;; Clear the appointments list, then fill it in from the diary. |
| 557 | (dolist (elt appt-time-msg-list) |
| 558 | ;; Delete any entries that were not made with appt-add. |
| 559 | (unless (nth 2 elt) |
| 560 | (setq appt-time-msg-list |
| 561 | (delq elt appt-time-msg-list)))) |
| 562 | (if diary-entries-list |
| 563 | ;; Cycle through the entry-list (diary-entries-list) |
| 564 | ;; looking for entries beginning with a time. If the |
| 565 | ;; entry begins with a time, add it to the |
| 566 | ;; appt-time-msg-list. Then sort the list. |
| 567 | (let ((entry-list diary-entries-list) |
| 568 | time-string literal) |
| 569 | ;; Below, we assume diary-entries-list was in date |
| 570 | ;; order. It is, unless something on |
| 571 | ;; diary-list-entries-hook has changed it, eg |
| 572 | ;; diary-include-other-files (bug#7019). It must be |
| 573 | ;; in date order if number = 1. |
| 574 | (and diary-list-entries-hook |
| 575 | appt-display-diary |
| 576 | (not (eq diary-number-of-entries 1)) |
| 577 | (not (memq (car (last diary-list-entries-hook)) |
| 578 | '(diary-sort-entries sort-diary-entries))) |
| 579 | (setq entry-list (sort entry-list 'diary-entry-compare))) |
| 580 | ;; Skip diary entries for dates before today. |
| 581 | (while (and entry-list |
| 582 | (calendar-date-compare |
| 583 | (car entry-list) (list (calendar-current-date)))) |
| 584 | (setq entry-list (cdr entry-list))) |
| 585 | ;; Parse the entries for today. |
| 586 | (while (and entry-list |
| 587 | (calendar-date-equal |
| 588 | (calendar-current-date) (caar entry-list))) |
| 589 | (setq time-string (cadr (car entry-list)) |
| 590 | ;; Including any comments. |
| 591 | literal (or (nth 2 (nth 3 (car entry-list))) |
| 592 | time-string)) |
| 593 | (while (string-match appt-time-regexp time-string) |
| 594 | (let* ((beg (match-beginning 0)) |
| 595 | ;; Get just the time for this appointment. |
| 596 | (only-time (match-string 0 time-string)) |
| 597 | ;; Find the end of this appointment |
| 598 | ;; (the start of the next). |
| 599 | (end (string-match |
| 600 | (concat "\n[ \t]*" appt-time-regexp) |
| 601 | time-string |
| 602 | (match-end 0))) |
| 603 | (warntime |
| 604 | (if (string-match appt-warning-time-regexp literal) |
| 605 | (string-to-number (match-string 1 literal)))) |
| 606 | ;; Get the whole string for this appointment. |
| 607 | (appt-time-string |
| 608 | (substring time-string beg end)) |
| 609 | ;; FIXME why the list? It makes the first |
| 610 | ;; element (MINUTES) rather than MINUTES. |
| 611 | (appt-time (list (appt-convert-time only-time))) |
| 612 | (time-msg (append |
| 613 | (list appt-time appt-time-string) |
| 614 | (if warntime (list nil warntime))))) |
| 615 | ;; Add this appointment to appt-time-msg-list. |
| 616 | (setq appt-time-msg-list |
| 617 | (nconc appt-time-msg-list (list time-msg)) |
| 618 | ;; Discard this appointment from the string. |
| 619 | ;; (This allows for multiple appts per entry.) |
| 620 | time-string |
| 621 | (if end (substring time-string end) "")) |
| 622 | ;; Similarly, discard the start of literal. |
| 623 | (and (> (length time-string) 0) |
| 624 | (string-match appt-time-regexp literal) |
| 625 | (setq end (string-match |
| 626 | (concat "\n[ \t]*" appt-time-regexp) |
| 627 | literal (match-end 0))) |
| 628 | (setq literal (substring literal end))))) |
| 629 | (setq entry-list (cdr entry-list))))) |
| 630 | (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)) |
| 631 | ;; Convert current time to minutes after midnight (12:01am = 1), |
| 632 | ;; and remove elements in the list that are in the past. |
| 633 | (let* ((now (decode-time)) |
| 634 | (now-mins (+ (* 60 (nth 2 now)) (nth 1 now)))) |
| 635 | (while (and appt-time-msg-list |
| 636 | (< (caar (car appt-time-msg-list)) now-mins)) |
| 637 | (setq appt-time-msg-list (cdr appt-time-msg-list))))))) |
| 638 | |
| 639 | |
| 640 | (defun appt-sort-list (appt-list) |
| 641 | "Sort an appointment list, putting earlier items at the front. |
| 642 | APPT-LIST is a list of the same format as `appt-time-msg-list'." |
| 643 | (sort appt-list (lambda (e1 e2) (< (caar e1) (caar e2))))) |
| 644 | |
| 645 | |
| 646 | (defun appt-convert-time (time2conv) |
| 647 | "Convert hour:min[am/pm] format TIME2CONV to minutes from midnight. |
| 648 | A period (.) can be used instead of a colon (:) to separate the |
| 649 | hour and minute parts." |
| 650 | ;; Formats that should be accepted: |
| 651 | ;; 10:00 10.00 10h00 10h 10am 10:00am 10.00am |
| 652 | (let ((min (if (string-match "[h:.]\\([0-9][0-9]\\)" time2conv) |
| 653 | (string-to-number (match-string 1 time2conv)) |
| 654 | 0)) |
| 655 | (hr (if (string-match "[0-9]*[0-9]" time2conv) |
| 656 | (string-to-number (match-string 0 time2conv)) |
| 657 | 0))) |
| 658 | ;; Convert the time appointment time into 24 hour time. |
| 659 | (cond ((and (string-match "pm" time2conv) (< hr 12)) |
| 660 | (setq hr (+ 12 hr))) |
| 661 | ((and (string-match "am" time2conv) (= hr 12)) |
| 662 | (setq hr 0))) |
| 663 | ;; Convert the actual time into minutes. |
| 664 | (+ (* hr 60) min))) |
| 665 | |
| 666 | (defun appt-update-list () |
| 667 | "If the current buffer is visiting the diary, update appointments. |
| 668 | This function also acts on any file listed in `diary-included-files'. |
| 669 | It is intended for use with `write-file-functions'." |
| 670 | (and (member buffer-file-name (append diary-included-files |
| 671 | (list (expand-file-name diary-file)))) |
| 672 | appt-timer |
| 673 | (let ((appt-display-diary nil)) |
| 674 | (appt-check t))) |
| 675 | nil) |
| 676 | |
| 677 | ;;;###autoload |
| 678 | (defun appt-activate (&optional arg) |
| 679 | "Toggle checking of appointments. |
| 680 | With optional numeric argument ARG, turn appointment checking on if |
| 681 | ARG is positive, otherwise off." |
| 682 | (interactive "P") |
| 683 | (let ((appt-active appt-timer)) |
| 684 | (setq appt-active (if arg (> (prefix-numeric-value arg) 0) |
| 685 | (not appt-active))) |
| 686 | (remove-hook 'write-file-functions 'appt-update-list) |
| 687 | (or global-mode-string (setq global-mode-string '(""))) |
| 688 | (delq 'appt-mode-string global-mode-string) |
| 689 | (when appt-timer |
| 690 | (cancel-timer appt-timer) |
| 691 | (setq appt-timer nil)) |
| 692 | (if appt-active |
| 693 | (progn |
| 694 | (add-hook 'write-file-functions 'appt-update-list) |
| 695 | (setq appt-timer (run-at-time t 60 'appt-check) |
| 696 | global-mode-string |
| 697 | (append global-mode-string '(appt-mode-string))) |
| 698 | (appt-check t) |
| 699 | (message "Appointment reminders enabled%s" |
| 700 | ;; Someone might want to use appt-add without a diary. |
| 701 | (if (ignore-errors (diary-check-diary-file)) |
| 702 | "" |
| 703 | " (no diary file found)"))) |
| 704 | (message "Appointment reminders disabled")))) |
| 705 | |
| 706 | |
| 707 | (provide 'appt) |
| 708 | |
| 709 | ;;; appt.el ends here |