lisp/calendar/appt.el

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