lisp/calendar/appt.el

   1 ;;; appt.el --- appointment notification functions.
   2
   3 ;; Copyright (C) 1989, 1990 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 1, or (at your option)
  10 ;; any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21 ;;
  22 ;; appt.el - visible and/or audible notification of
  23 ;;           appointments from ~/diary file generated from
  24 ;;           Edward M. Reingold's calendar.el.
  25 ;;
  26 ;; Version 2.1
  27 ;;
  28 ;; Comments, corrections, and improvements should be sent to
  29 ;; Neil M. Mager
  30 ;; Net                     <neilm@juliet.ll.mit.edu>
  31 ;; Voice                   (617) 981-4803
  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 their diary file.
  39 ;;;
  40 ;;;
  41 ;;; ******* It is necessary to invoke 'display-time' ********
  42 ;;; *******  and 'diary' for this to work properly.  ********
  43 ;;;
  44 ;;; A message will be displayed in the mode line of the emacs buffer
  45 ;;; and (if the user desires) the terminal will beep and display a message
  46 ;;; from the diary in the mini-buffer, or the user may select to
  47 ;;; have a message displayed in a new buffer.
  48 ;;;
  49 ;;; The variable 'appt-message-warning-time' allows the
  50 ;;; user to specify how much notice they want before the appointment. The
  51 ;;; variable 'appt-issue-message' specifies whether the user wants
  52 ;;; to to be notified of a pending appointment.
  53 ;;;
  54 ;;; In order to use, the following should be in your .emacs file in addition to
  55 ;;; creating a diary file and invoking calendar:
  56 ;;;
  57 ;;;    Set some options
  58 ;;; (setq view-diary-entries-initially t)
  59 ;;; (setq appt-issue-message t)
  60 ;;;
  61 ;;;   The following three lines are required:
  62 ;;; (display-time)
  63 ;;; (autoload 'appt-make-list "appt.el" nil t)
  64 ;;; (setq diary-display-hook
  65 ;;;     (list 'appt-make-list 'prepare-fancy-diary-buffer))
  66 ;;;
  67 ;;;
  68 ;;;  This is an example of what can be in your diary file:
  69 ;;; Monday
  70 ;;;   9:30am Coffee break
  71 ;;;  12:00pm Lunch
  72 ;;;
  73 ;;; Based upon the above lines in your .emacs and diary files,
  74 ;;; the calendar and diary will be displayed when you enter
  75 ;;; emacs and your appointments list will automatically be created.
  76 ;;; You will then be reminded at 9:20am about your coffee break
  77 ;;; and at 11:50am to go to lunch.
  78 ;;;
  79 ;;; Use describe-function on appt-check for a description of other variables
  80 ;;; that can be used to personalize the notification system.
  81 ;;;
  82 ;;;  In order to add or delete items from todays list, use appt-add
  83 ;;;  and appt-delete.
  84 ;;;
  85 ;;;  Additionally, the appointments list is recreated automatically
  86 ;;;  at 12:01am for those who do not logout every day or are programming
  87 ;;;  late.
  88 ;;;
  89 ;;; Brief internal description - Skip this if your not interested!
  90 ;;;
  91 ;;; The function appt-check is run from the 'loadst' process which is started
  92 ;;; by invoking (display-time). A temporary function below modifies
  93 ;;; display-time-filter
  94 ;;; (from original time.el) to include a hook which will invoke appt-check.
  95 ;;; This will not be necessary in the next version of gnuemacs.
  96 ;;;
  97 ;;;
  98 ;;; The function appt-make-list creates the appointments list which appt-check
  99 ;;; reads. This is all done automatically.
 100 ;;; It is invoked from the function list-diary-entries.
 101 ;;;
 102 (defvar appt-issue-message t
 103   "*Non-nil means check for appointments in the diary buffer.
 104 To be detected, the diary entry must have the time
 105 as the first thing on a line.")
 106
 107 (defvar appt-message-warning-time 10
 108   "*Time in minutes before an appointment that the warning begins.")
 109
 110 (defvar appt-audible t
 111   "*Non-nil means beep to indicate appointment.")
 112
 113 (defvar appt-visible t
 114   "*Non-nil means display appointment message in echo area.")
 115
 116 (defvar appt-display-mode-line t
 117   "*Non-nil means display minutes to appointment and time on the mode line.")
 118
 119 (defvar appt-msg-window t
 120   "*Non-nil means display appointment message in another window.")
 121
 122 (defvar appt-display-duration 5
 123   "*The number of seconds an appointment message is displayed.")
 124
 125 (defvar appt-display-diary t
 126   "*Non-nil means to display the next days diary on the screen.
 127 This will occur at midnight when the appointment list is updated.")
 128
 129 (defvar appt-time-msg-list nil
 130   "The list of appointments for today.
 131 Use `appt-add' and `appt-delete' to add and delete appointments from list.
 132 The original list is generated from the today's `diary-entries-list'.
 133 The number before each time/message is the time in minutes from midnight.")
 134
 135 (defconst max-time 1439
 136   "11:59pm in minutes - number of minutes in a day minus 1.")
 137
 138 (defun appt-check ()
 139   "Check for an appointment and update the mode line.
 140 Note: the time must be the first thing in the line in the diary
 141 for a warning to be issued.
 142
 143 The format of the time can be either 24 hour or am/pm.
 144 Example:
 145
 146                02/23/89
 147                  18:00 Dinner
 148
 149               Thursday
 150                 11:45am Lunch meeting.
 151
 152 The following variables control the action of the notification:
 153
 154 appt-issue-message
 155         If T, the diary buffer is checked for appointments.
 156
 157 appt-message-warning-time
 158        Variable used to determine if appointment message
 159         should be displayed.
 160
 161 appt-audible
 162         Variable used to determine if appointment is audible.
 163         Default is t.
 164
 165 appt-visible
 166         Variable used to determine if appointment message should be
 167         displayed in the mini-buffer. Default is t.
 168
 169 appt-msg-window
 170        Variable used to determine if appointment message
 171        should temporarily appear in another window. Mutually exclusive
 172        to appt-visible.
 173
 174 appt-display-duration
 175       The number of seconds an appointment message
 176       is displayed in another window.
 177
 178 This function is run from the loadst process for display time.
 179 Therefore, you need to have `(display-time)' in your .emacs file."
 180
 181
 182   (let ((min-to-app -1)
 183         (new-time ""))
 184     (save-excursion
 185
 186       ;; Get the current time and convert it to minutes
 187       ;; from midnight. ie. 12:01am = 1, midnight = 0.
 188
 189       (let* ((cur-hour(string-to-int
 190                        (substring (current-time-string) 11 13)))
 191              (cur-min (string-to-int
 192                        (substring (current-time-string) 14 16)))
 193              (cur-comp-time (+ (* cur-hour 60) cur-min)))
 194
 195         ;; If the time is 12:01am, we should update our
 196         ;; appointments to todays list.
 197
 198         (if (= cur-comp-time 1)
 199             (if (and view-diary-entries-initially appt-display-diary)
 200                 (diary)
 201               (let ((diary-display-hook 'appt-make-list))
 202                 (diary))))
 203
 204         ;; If there are entries in the list, and the
 205         ;; user wants a message issued
 206         ;; get the first time off of the list
 207         ;; and calculate the number of minutes until
 208         ;; the appointment.
 209
 210         (if (and appt-issue-message appt-time-msg-list)
 211             (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
 212               (setq min-to-app (- appt-comp-time cur-comp-time))
 213
 214               (while (and appt-time-msg-list
 215                           (< appt-comp-time cur-comp-time))
 216                 (setq appt-time-msg-list (cdr appt-time-msg-list))
 217                 (if appt-time-msg-list
 218                     (setq appt-comp-time
 219                           (car (car (car appt-time-msg-list))))))
 220
 221               ;; If we have an appointment between midnight and
 222               ;; 'appt-message-warning-time' minutes after midnight,
 223               ;; we must begin to issue a message before midnight.
 224               ;; Midnight is considered 0 minutes and 11:59pm is
 225               ;; 1439 minutes. Therefore we must recalculate the minutes
 226               ;; to appointment variable. It is equal to the number of
 227               ;; minutes before midnight plus the number of
 228               ;; minutes after midnight our appointment is.
 229
 230               (if (and (< appt-comp-time appt-message-warning-time)
 231                        (> (+ cur-comp-time appt-message-warning-time)
 232                           max-time))
 233                   (setq min-to-app (+ (- (1+ max-time) cur-comp-time))
 234                         appt-comp-time))
 235
 236               ;; issue warning if the appointment time is
 237               ;; within appt-message-warning time
 238
 239               (if (and (<= min-to-app appt-message-warning-time)
 240                        (>= min-to-app 0))
 241                   (progn
 242                     (if appt-msg-window
 243                         (progn
 244                           (string-match
 245                            "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
 246                            display-time-string)
 247
 248                           (setq new-time (substring display-time-string
 249                                                     (match-beginning 0)
 250                                                     (match-end 0)))
 251                           (appt-disp-window min-to-app new-time
 252                                             (car (cdr (car appt-time-msg-list)))))
 253                       ;;; else
 254
 255                       (if appt-visible
 256                           (message "%s"
 257                                    (car (cdr (car appt-time-msg-list)))))
 258
 259                       (if appt-audible
 260                           (beep 1)))
 261
 262                     (if appt-display-mode-line
 263                         (progn
 264                           (string-match
 265                            "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
 266                            display-time-string)
 267
 268                           (setq new-time (substring display-time-string
 269                                                     (match-beginning 0)
 270                                                     (match-end 0)))
 271                           (setq display-time-string
 272                                 (concat  "App't in "
 273                                          min-to-app " min. " new-time " "))
 274
 275                           ;; force mode line updates - from time.el
 276
 277                           (save-excursion (set-buffer (other-buffer)))
 278                           (set-buffer-modified-p (buffer-modified-p))
 279                           (sit-for 0)))
 280
 281                     (if (= min-to-app 0)
 282                         (setq appt-time-msg-list
 283                               (cdr appt-time-msg-list)))))))))))
 284
 285
 286 ;; Display appointment message in a separate buffer.
 287 (defun appt-disp-window (min-to-app new-time appt-msg)
 288   (require 'electric)
 289   (save-window-excursion
 290
 291     ;; Make sure we're not in the minibuffer
 292     ;; before splitting the window.
 293
 294     (if (= (frame-height)
 295            (nth 3 (window-edges (selected-window))))
 296         nil
 297       (appt-select-lowest-window)
 298       (split-window))
 299
 300     (let* ((this-buffer (current-buffer))
 301            (appt-disp-buf (set-buffer (get-buffer-create "appt-buf"))))
 302       (setq mode-line-format
 303             (concat "-------------------- Appointment in "
 304                     min-to-app " minutes. " new-time " %-"))
 305       (pop-to-buffer appt-disp-buf)
 306       (insert-string appt-msg)
 307       (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf))
 308       (set-buffer-modified-p nil)
 309       (if appt-audible
 310           (beep 1))
 311       (sit-for appt-display-duration)
 312       (if appt-audible
 313           (beep 1))
 314       (kill-buffer appt-disp-buf))))
 315
 316 ;; Select the lowest window on the frame.
 317 (defun appt-select-lowest-window ()
 318   (setq lowest-window (selected-window))
 319   (let* ((bottom-edge (car (cdr (cdr (cdr (window-edges))))))
 320          (last-window (previous-window))
 321          (window-search t))
 322     (while window-search
 323       (let* ((this-window (next-window))
 324              (next-bottom-edge (car (cdr (cdr (cdr
 325                                                (window-edges this-window)))))))
 326         (if (< bottom-edge next-bottom-edge)
 327             (progn
 328               (setq bottom-edge next-bottom-edge)
 329               (setq lowest-window this-window)))
 330
 331         (select-window this-window)
 332         (if (eq last-window this-window)
 333             (progn
 334               (select-window lowest-window)
 335               (setq window-search nil)))))))
 336
 337
 338 (defun appt-add (new-appt-time new-appt-msg)
 339   "Add an appointment for the day at TIME and issue MESSAGE.
 340 The time should be in either 24 hour format or am/pm format."
 341
 342   (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
 343   (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
 344       nil
 345     (error "Unacceptable time-string"))
 346
 347   (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
 348          (appt-time (list (appt-convert-time new-appt-time)))
 349          (time-msg (cons appt-time (list appt-time-string))))
 350     (setq appt-time-msg-list (append appt-time-msg-list
 351                                      (list time-msg)))
 352     (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
 353
 354 (defun appt-delete ()
 355   "Delete an appointment from the list of appointments."
 356   (interactive)
 357   (let* ((tmp-msg-list appt-time-msg-list))
 358     (while tmp-msg-list
 359       (let* ((element (car tmp-msg-list))
 360              (prompt-string (concat "Delete "
 361                                     (prin1-to-string (car (cdr element)))
 362                                     " from list? "))
 363              (test-input (y-or-n-p prompt-string)))
 364         (setq tmp-msg-list (cdr tmp-msg-list))
 365         (if test-input
 366             (setq appt-time-msg-list (delq element appt-time-msg-list)))
 367         (setq tmp-appt-msg-list nil)))
 368     (message "")))
 369
 370
 371 ;; Create the appointments list from todays diary buffer.
 372 ;; The time must be at the beginning of a line for it to be
 373 ;; put in the appointments list.
 374 ;;                02/23/89
 375 ;;                  12:00pm lunch
 376 ;;                 Wednesday
 377 ;;                   10:00am group meeting"
 378
 379 (defun appt-make-list ()
 380   (setq appt-time-msg-list nil)
 381
 382   (save-excursion
 383     (if diary-entries-list
 384
 385         ;; Cycle through the entry-list (diary-entries-list)
 386         ;; looking for entries beginning with a time. If
 387         ;; the entry begins with a time, add it to the
 388         ;; appt-time-msg-list. Then sort the list.
 389
 390         (let ((entry-list diary-entries-list)
 391               (new-time-string ""))
 392           (while (and entry-list
 393                       (calendar-date-equal
 394                        (calendar-current-date) (car (car entry-list))))
 395             (let ((time-string (substring (prin1-to-string
 396                                            (cdr (car entry-list))) 2 -2)))
 397
 398               (while (string-match
 399                       "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?.*"
 400                       time-string)
 401                 (let* ((appt-time-string (substring time-string
 402                                                     (match-beginning 0)
 403                                                     (match-end 0))))
 404
 405                   (if (< (match-end 0) (length time-string))
 406                       (setq new-time-string (substring time-string
 407                                                        (+ (match-end 0) 1)
 408                                                        nil))
 409                     (setq new-time-string ""))
 410
 411                   (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
 412                                 time-string)
 413
 414                   (let* ((appt-time (list (appt-convert-time
 415                                            (substring time-string
 416                                                       (match-beginning 0)
 417                                                       (match-end 0)))))
 418                          (time-msg (cons appt-time
 419                                          (list appt-time-string))))
 420                     (setq time-string new-time-string)
 421                     (setq appt-time-msg-list (append appt-time-msg-list
 422                                                      (list time-msg)))))))
 423             (setq entry-list (cdr entry-list)))))
 424   (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
 425
 426   ;; Get the current time and convert it to minutes
 427   ;; from midnight. ie. 12:01am = 1, midnight = 0,
 428   ;; so that the elements in the list
 429   ;; that are earlier than the present time can
 430   ;; be removed.
 431
 432   (let* ((cur-hour(string-to-int
 433                    (substring (current-time-string) 11 13)))
 434          (cur-min (string-to-int
 435                    (substring (current-time-string) 14 16)))
 436          (cur-comp-time (+ (* cur-hour 60) cur-min))
 437          (appt-comp-time (car (car (car appt-time-msg-list)))))
 438
 439     (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
 440       (setq appt-time-msg-list (cdr appt-time-msg-list))
 441       (if appt-time-msg-list
 442           (setq appt-comp-time (car (car (car appt-time-msg-list)))))))))
 443
 444
 445 ;;Simple sort to put the appointments list in order.
 446 ;;Scan the list for the smallest element left in the list.
 447 ;;Append the smallest element left into the new list, and remove
 448 ;;it from the original list.
 449 (defun appt-sort-list (appt-list)
 450   (let ((order-list nil))
 451     (while appt-list
 452       (let* ((element (car appt-list))
 453              (element-time (car (car element)))
 454              (tmp-list (cdr appt-list)))
 455         (while tmp-list
 456           (if (< element-time (car (car (car tmp-list))))
 457               nil
 458             (setq element (car tmp-list))
 459             (setq element-time (car (car element))))
 460           (setq tmp-list (cdr tmp-list)))
 461         (setq order-list (append order-list (list element)))
 462         (setq appt-list (delq element appt-list))))
 463     order-list))
 464
 465
 466 (defun appt-convert-time (time2conv)
 467   "Convert hour:min[am/pm] format to minutes from midnight."
 468
 469   (let ((conv-time 0)
 470         (hr 0)
 471         (min 0))
 472
 473     (string-match ":[0-9][0-9]" time2conv)
 474     (setq min (string-to-int
 475                (substring time2conv
 476                           (+ (match-beginning 0) 1) (match-end 0))))
 477
 478     (string-match "[0-9]?[0-9]:" time2conv)
 479     (setq hr (string-to-int
 480               (substring time2conv
 481                          (match-beginning 0)
 482                          (match-end 0))))
 483
 484     ;; convert the time appointment time into 24 hour time
 485
 486     (if (and (string-match  "[p][m]" time2conv) (< hr 12))
 487         (progn
 488           (string-match "[0-9]?[0-9]:" time2conv)
 489           (setq hr (+ 12 hr))))
 490
 491     ;; convert the actual time
 492     ;; into minutes for comparison
 493     ;; against the actual time.
 494
 495     (setq conv-time (+ (* hr 60) min))
 496     conv-time))
 497
 498 (setq display-time-hook 'appt-check)
 499
 500 ;;; appt.el ends here