lisp/calendar/appt.el

   1 ;;; appt.el --- appointment notification functions
   2
   3 ;; Copyright (C) 1989, 1990, 1994, 1998 Free Software Foundation, Inc.
   4
   5 ;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
   6 ;; Maintainer: FSF
   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 the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  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 their diary file.
  39 ;;;
  40 ;;; A message will be displayed in the mode line of the Emacs buffer
  41 ;;; and (if you request) the terminal will beep and display a message
  42 ;;; from the diary in the mini-buffer, or you can choose to
  43 ;;; have a message displayed in a new buffer.
  44 ;;;
  45 ;;; The variable `appt-message-warning-time' allows the
  46 ;;; user to specify how much notice they want before the appointment. The
  47 ;;; variable `appt-issue-message' specifies whether the user wants
  48 ;;; to to be notified of a pending appointment.
  49 ;;;
  50 ;;; In order to use the appt package, you only need
  51 ;;; to load it---provided you have appointments.
  52 ;;;
  53 ;;; Before that, you can also set some options if you want
  54 ;;;   (setq view-diary-entries-initially t)
  55 ;;;   (setq appt-issue-message t)
  56 ;;;
  57 ;;;  This is an example of what can be in your diary file:
  58 ;;; Monday
  59 ;;;   9:30am Coffee break
  60 ;;;  12:00pm Lunch
  61 ;;;
  62 ;;; Based upon the above lines in your .emacs and diary files,
  63 ;;; the calendar and diary will be displayed when you enter
  64 ;;; Emacs and your appointments list will automatically be created.
  65 ;;; You will then be reminded at 9:20am about your coffee break
  66 ;;; and at 11:50am to go to lunch.
  67 ;;;
  68 ;;; Use describe-function on appt-check for a description of other variables
  69 ;;; that can be used to personalize the notification system.
  70 ;;;
  71 ;;;  In order to add or delete items from todays list, use appt-add
  72 ;;;  and appt-delete.
  73 ;;;
  74 ;;;  Additionally, the appointments list is recreated automatically
  75 ;;;  at 12:01am for those who do not logout every day or are programming
  76 ;;;  late.
  77 ;;;
  78 ;;; Brief internal description - Skip this if you are not interested!
  79 ;;;
  80 ;;; The function appt-make-list creates the appointments list which appt-check
  81 ;;; reads. This is all done automatically.
  82 ;;; It is invoked from the function list-diary-entries.
  83 ;;;
  84 ;;; You can change the way the appointment window is created/deleted by
  85 ;;; setting  the variables
  86 ;;;
  87 ;;;          appt-disp-window-function
  88 ;;; and
  89 ;;;          appt-delete-window-function
  90 ;;;
  91 ;;; For instance, these variables can be set to functions that display
  92 ;;; appointments in pop-up frames, which are lowered or iconified after
  93 ;;; appt-display-interval minutes.
  94 ;;;
  95
  96 ;;; Code:
  97
  98 ;; Make sure calendar is loaded when we compile this.
  99 (require 'calendar)
 100
 101 (provide 'appt)
 102
 103 ;;;###autoload
 104 (defcustom appt-issue-message t
 105   "*Non-nil means check for appointments in the diary buffer.
 106 To be detected, the diary entry must have the time
 107 as the first thing on a line."
 108   :type 'boolean
 109   :group 'appt)
 110
 111 ;;;###autoload
 112 (defcustom appt-message-warning-time 12
 113   "*Time in minutes before an appointment that the warning begins."
 114   :type 'integer
 115   :group 'appt)
 116
 117 ;;;###autoload
 118 (defcustom appt-audible t
 119   "*Non-nil means beep to indicate appointment."
 120   :type 'boolean
 121   :group 'appt)
 122
 123 ;;;###autoload
 124 (defcustom appt-visible t
 125   "*Non-nil means display appointment message in echo area."
 126   :type 'boolean
 127   :group 'appt)
 128
 129 ;;;###autoload
 130 (defcustom appt-display-mode-line t
 131   "*Non-nil means display minutes to appointment and time on the mode line."
 132   :type 'boolean
 133   :group 'appt)
 134
 135 ;;;###autoload
 136 (defcustom appt-msg-window t
 137   "*Non-nil means display appointment message in another window."
 138   :type 'boolean
 139   :group 'appt)
 140
 141 ;;;###autoload
 142 (defcustom appt-display-duration 10
 143   "*The number of seconds an appointment message is displayed."
 144   :type 'integer
 145   :group 'appt)
 146
 147 ;;;###autoload
 148 (defcustom appt-display-diary t
 149   "*Non-nil means to display the next days diary on the screen.
 150 This will occur at midnight when the appointment list is updated."
 151   :type 'boolean
 152   :group 'appt)
 153
 154 (defvar appt-time-msg-list nil
 155   "The list of appointments for today.
 156 Use `appt-add' and `appt-delete' to add and delete appointments from list.
 157 The original list is generated from the today's `diary-entries-list'.
 158 The number before each time/message is the time in minutes from midnight.")
 159
 160 (defconst appt-max-time 1439
 161   "11:59pm in minutes - number of minutes in a day minus 1.")
 162
 163 (defcustom appt-display-interval 3
 164   "*Number of minutes to wait between checking the appointment list."
 165   :type 'integer
 166   :group 'appt)
 167
 168 (defvar appt-buffer-name " *appt-buf*"
 169   "Name of the appointments buffer.")
 170
 171 (defvar appt-disp-window-function 'appt-disp-window
 172   "Function called to display appointment window.")
 173
 174 (defvar appt-delete-window-function 'appt-delete-window
 175   "Function called to remove appointment window and buffer.")
 176
 177 (defvar appt-mode-string nil
 178   "String being displayed in the mode line saying you have an appointment.
 179 The actual string includes the amount of time till the appointment.")
 180
 181 (defvar appt-prev-comp-time nil
 182   "Time of day (mins since midnight) at which we last checked appointments.")
 183
 184 (defvar appt-now-displayed nil
 185   "Non-nil when we have started notifying about a appointment that is near.")
 186
 187 (defvar appt-display-count nil)
 188
 189 (defun appt-check ()
 190   "Check for an appointment and update the mode line.
 191 Note: the time must be the first thing in the line in the diary
 192 for a warning to be issued.
 193
 194 The format of the time can be either 24 hour or am/pm.
 195 Example:
 196
 197                02/23/89
 198                  18:00 Dinner
 199
 200               Thursday
 201                 11:45am Lunch meeting.
 202
 203 Appointments are checked every `appt-display-interval' minutes.
 204 The following variables control appointment notification:
 205
 206 `appt-issue-message'
 207         If t, the diary buffer is checked for appointments.
 208
 209 `appt-message-warning-time'
 210         Variable used to determine if appointment message
 211         should be displayed.
 212
 213 `appt-audible'
 214         Variable used to determine if appointment is audible.
 215         Default is t.
 216
 217 `appt-visible'
 218         Variable used to determine if appointment message should be
 219         displayed in the mini-buffer.  Default is t.
 220
 221 `appt-msg-window'
 222         Variable used to determine if appointment message
 223         should temporarily appear in another window.  Mutually exclusive
 224         to `appt-visible'.
 225
 226 `appt-display-duration'
 227         The number of seconds an appointment message
 228         is displayed in another window.
 229
 230 `appt-disp-window-function'
 231         Function called to display appointment window.  You can customize
 232         appt.el by setting this variable to a function different from the
 233         one provided with this package.
 234
 235 `appt-delete-window-function'
 236         Function called to remove appointment window and buffer.  You can
 237         customize appt.el by setting this variable to a function different
 238         from the one provided with this package."
 239
 240   (let* ((min-to-app -1)
 241          (new-time "")
 242          (prev-appt-mode-string appt-mode-string)
 243          (prev-appt-display-count (or appt-display-count 0))
 244          ;; Non-nil means do a full check for pending appointments
 245          ;; and display in whatever ways the user has selected.
 246          ;; When no appointment is being displayed,
 247          ;; we always do a full check.
 248          (full-check
 249           (or (not appt-now-displayed)
 250               ;; This is true every appt-display-interval minutes.
 251               (= 0 (mod prev-appt-display-count appt-display-interval))))
 252          ;; Non-nil means only update the interval displayed in the mode line.
 253          (mode-line-only
 254           (and (not full-check) appt-now-displayed)))
 255
 256     (when (or full-check mode-line-only)
 257       (save-excursion
 258
 259         ;; Get the current time and convert it to minutes
 260         ;; from midnight. ie. 12:01am = 1, midnight = 0.
 261
 262         (let* ((now (decode-time))
 263                (cur-hour (nth 2 now))
 264                (cur-min (nth 1 now))
 265                (cur-comp-time (+ (* cur-hour 60) cur-min)))
 266
 267           ;; At the first check in any given day, update our
 268           ;; appointments to today's list.
 269
 270           (if (or (null appt-prev-comp-time)
 271                   (< cur-comp-time appt-prev-comp-time))
 272               (condition-case nil
 273                   (progn
 274                     (if (and view-diary-entries-initially appt-display-diary)
 275                         (diary)
 276                       (let ((diary-display-hook 'appt-make-list))
 277                         (diary))))
 278                 (error nil)))
 279           (setq appt-prev-comp-time cur-comp-time)
 280
 281           (setq appt-mode-string nil)
 282           (setq appt-display-count nil)
 283
 284           ;; If there are entries in the list, and the
 285           ;; user wants a message issued,
 286           ;; get the first time off of the list
 287           ;; and calculate the number of minutes until the appointment.
 288
 289           (if (and appt-issue-message appt-time-msg-list)
 290               (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
 291                 (setq min-to-app (- appt-comp-time cur-comp-time))
 292
 293                 (while (and appt-time-msg-list
 294                             (< appt-comp-time cur-comp-time))
 295                   (setq appt-time-msg-list (cdr appt-time-msg-list))
 296                   (if appt-time-msg-list
 297                       (setq appt-comp-time
 298                             (car (car (car appt-time-msg-list))))))
 299
 300                 ;; If we have an appointment between midnight and
 301                 ;; 'appt-message-warning-time' minutes after midnight,
 302                 ;; we must begin to issue a message before midnight.
 303                 ;; Midnight is considered 0 minutes and 11:59pm is
 304                 ;; 1439 minutes. Therefore we must recalculate the minutes
 305                 ;; to appointment variable. It is equal to the number of
 306                 ;; minutes before midnight plus the number of
 307                 ;; minutes after midnight our appointment is.
 308
 309                 (if (and (< appt-comp-time appt-message-warning-time)
 310                          (> (+ cur-comp-time appt-message-warning-time)
 311                             appt-max-time))
 312                     (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time))
 313                           appt-comp-time))
 314
 315                 ;; issue warning if the appointment time is
 316                 ;; within appt-message-warning time
 317
 318                 (when (and (<= min-to-app appt-message-warning-time)
 319                            (>= min-to-app 0))
 320                   (setq appt-now-displayed t)
 321                   (setq appt-display-count
 322                         (1+ prev-appt-display-count))
 323                   (unless mode-line-only
 324                     (if appt-msg-window
 325                         (progn
 326                           (setq new-time (format-time-string "%a %b %e "
 327                                                              (current-time)))
 328                           (funcall
 329                            appt-disp-window-function
 330                            (number-to-string min-to-app) new-time
 331                            (car (cdr (car appt-time-msg-list))))
 332
 333                           (run-at-time
 334                            (format "%d sec" appt-display-duration)
 335                            nil
 336                            appt-delete-window-function))
 337                               ;;; else
 338
 339                       (if appt-visible
 340                           (message "%s"
 341                                    (car (cdr (car appt-time-msg-list)))))
 342
 343                       (if appt-audible
 344                           (beep 1))))
 345
 346                   (when appt-display-mode-line
 347                     (setq appt-mode-string
 348                           (concat  " App't in "
 349                                    (number-to-string min-to-app)
 350                                    " min. ")))
 351
 352                   ;; When an appointment is reached,
 353                   ;; delete it from the list.
 354                   ;; Reset the count to 0 in case we display another
 355                   ;; appointment on the next cycle.
 356                   (if (= min-to-app 0)
 357                       (setq appt-time-msg-list
 358                             (cdr appt-time-msg-list)
 359                             appt-display-count nil)))))
 360
 361           ;; If we have changed the mode line string,
 362           ;; redisplay all mode lines.
 363           (and appt-display-mode-line
 364                (not (equal appt-mode-string
 365                            prev-appt-mode-string))
 366                (progn
 367                  (force-mode-line-update t)
 368                  ;; If the string now has a notification,
 369                  ;; redisplay right now.
 370                  (if appt-mode-string
 371                      (sit-for 0)))))))))
 372
 373
 374 (defun appt-disp-window (min-to-app new-time appt-msg)
 375   "Display appointment message APPT-MSG in a separate buffer."
 376   (require 'electric)
 377
 378   ;; Make sure we're not in the minibuffer
 379   ;; before splitting the window.
 380
 381   (if (equal (selected-window) (minibuffer-window))
 382       (if (other-window 1)
 383           (select-window (other-window 1))
 384         (if (display-multi-frame-p)
 385             (select-frame (other-frame 1)))))
 386
 387   (let* ((this-buffer (current-buffer))
 388          (this-window (selected-window))
 389          (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
 390
 391     (if (cdr (assq 'unsplittable (frame-parameters)))
 392         ;; In an unsplittable frame, use something somewhere else.
 393         (display-buffer appt-disp-buf)
 394       (unless (or (special-display-p (buffer-name appt-disp-buf))
 395                   (same-window-p (buffer-name appt-disp-buf)))
 396         ;; By default, split the bottom window and use the lower part.
 397         (appt-select-lowest-window)
 398         (split-window))
 399       (pop-to-buffer appt-disp-buf))
 400     (setq mode-line-format
 401           (concat "-------------------- Appointment in "
 402                   min-to-app " minutes. " new-time " %-"))
 403     (erase-buffer)
 404     (insert-string appt-msg)
 405     (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
 406     (set-buffer-modified-p nil)
 407     (raise-frame (selected-frame))
 408     (select-window this-window)
 409     (if appt-audible
 410         (beep 1))))
 411
 412 (defun appt-delete-window ()
 413   "Function called to undisplay appointment messages.
 414 Usually just deletes the appointment buffer."
 415   (let ((window (get-buffer-window appt-buffer-name t)))
 416     (and window
 417          (or (eq window (frame-root-window (window-frame window)))
 418              (delete-window window))))
 419   (kill-buffer appt-buffer-name)
 420   (if appt-audible
 421       (beep 1)))
 422
 423 (defun appt-select-lowest-window ()
 424 "Select the lowest window on the frame."
 425   (let ((lowest-window (selected-window))
 426         (bottom-edge (nth 3 (window-edges))))
 427     (walk-windows (lambda (w)
 428                     (let ((next-bottom-edge (nth 3 (window-edges w))))
 429                       (when (< bottom-edge next-bottom-edge)
 430                         (setq bottom-edge next-bottom-edge
 431                               lowest-window w)))))
 432     (select-window lowest-window)))
 433
 434 ;;;###autoload
 435 (defun appt-add (new-appt-time new-appt-msg)
 436   "Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG.
 437 The time should be in either 24 hour format or am/pm format."
 438
 439   (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
 440   (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
 441       nil
 442     (error "Unacceptable time-string"))
 443
 444   (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
 445          (appt-time (list (appt-convert-time new-appt-time)))
 446          (time-msg (cons appt-time (list appt-time-string))))
 447     (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg)))
 448     (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
 449
 450 ;;;###autoload
 451 (defun appt-delete ()
 452   "Delete an appointment from the list of appointments."
 453   (interactive)
 454   (let* ((tmp-msg-list appt-time-msg-list))
 455     (while tmp-msg-list
 456       (let* ((element (car tmp-msg-list))
 457              (prompt-string (concat "Delete "
 458                                     (prin1-to-string (car (cdr element)))
 459                                     " from list? "))
 460              (test-input (y-or-n-p prompt-string)))
 461         (setq tmp-msg-list (cdr tmp-msg-list))
 462         (if test-input
 463             (setq appt-time-msg-list (delq element appt-time-msg-list)))))
 464     (appt-check)
 465     (message "")))
 466
 467
 468 (eval-when-compile (defvar number)
 469                    (defvar original-date)
 470                    (defvar diary-entries-list))
 471 ;;;###autoload
 472 (defun appt-make-list ()
 473   "Create the appointments list from todays diary buffer.
 474 The time must be at the beginning of a line for it to be
 475 put in the appointments list.
 476   02/23/89
 477     12:00pm lunch
 478    Wednesday
 479      10:00am group meeting
 480 We assume that the variables DATE and NUMBER
 481 hold the arguments that `list-diary-entries' received.
 482 They specify the range of dates that the diary is being processed for."
 483
 484   ;; We have something to do if the range of dates that the diary is
 485   ;; considering includes the current date.
 486   (if (and (not (calendar-date-compare
 487                  (list (calendar-current-date))
 488                  (list original-date)))
 489            (calendar-date-compare
 490             (list (calendar-current-date))
 491             (list (calendar-gregorian-from-absolute
 492                    (+ (calendar-absolute-from-gregorian original-date)
 493                       number)))))
 494       (save-excursion
 495         ;; Clear the appointments list, then fill it in from the diary.
 496         (setq appt-time-msg-list nil)
 497         (if diary-entries-list
 498
 499             ;; Cycle through the entry-list (diary-entries-list)
 500             ;; looking for entries beginning with a time. If
 501             ;; the entry begins with a time, add it to the
 502             ;; appt-time-msg-list. Then sort the list.
 503
 504             (let ((entry-list diary-entries-list)
 505                   (new-time-string ""))
 506               ;; Skip diary entries for dates before today.
 507               (while (and entry-list
 508                           (calendar-date-compare
 509                            (car entry-list) (list (calendar-current-date))))
 510                 (setq entry-list (cdr entry-list)))
 511               ;; Parse the entries for today.
 512               (while (and entry-list
 513                           (calendar-date-equal
 514                            (calendar-current-date) (car (car entry-list))))
 515                 (let ((time-string (substring (prin1-to-string
 516                                                (cadr (car entry-list))) 1 -1)))
 517
 518                   (while (string-match
 519                           "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\(.*\n\\)*.*"
 520                           time-string)
 521                     (let* ((appt-time-string (match-string 0 time-string)))
 522
 523                       (if (< (match-end 0) (length time-string))
 524                           (setq new-time-string (substring time-string
 525                                                            (+ (match-end 0) 1)
 526                                                            nil))
 527                         (setq new-time-string ""))
 528
 529                       (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
 530                                     time-string)
 531
 532                       (let* ((appt-time (list (appt-convert-time
 533                                                (match-string 0 time-string))))
 534                              (time-msg (cons appt-time
 535                                              (list appt-time-string))))
 536                         (setq time-string new-time-string)
 537                         (setq appt-time-msg-list (nconc appt-time-msg-list
 538                                                         (list time-msg)))))))
 539                 (setq entry-list (cdr entry-list)))))
 540         (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
 541
 542         ;; Get the current time and convert it to minutes
 543         ;; from midnight. ie. 12:01am = 1, midnight = 0,
 544         ;; so that the elements in the list
 545         ;; that are earlier than the present time can
 546         ;; be removed.
 547
 548         (let* ((now (decode-time))
 549                (cur-hour (nth 2 now))
 550                (cur-min (nth 1 now))
 551                (cur-comp-time (+ (* cur-hour 60) cur-min))
 552                (appt-comp-time (car (car (car appt-time-msg-list)))))
 553
 554           (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
 555             (setq appt-time-msg-list (cdr appt-time-msg-list))
 556             (if appt-time-msg-list
 557                 (setq appt-comp-time (car (car (car appt-time-msg-list))))))))))
 558
 559
 560 (defun appt-sort-list (appt-list)
 561   "Simple sort to put the appointments list APPT-LIST in order.
 562 Scan the list for the smallest element left in the list.
 563 Append the smallest element left into the new list, and remove
 564 it from the original list."
 565   (let ((order-list nil))
 566     (while appt-list
 567       (let* ((element (car appt-list))
 568              (element-time (car (car element)))
 569              (tmp-list (cdr appt-list)))
 570         (while tmp-list
 571           (if (< element-time (car (car (car tmp-list))))
 572               nil
 573             (setq element (car tmp-list))
 574             (setq element-time (car (car element))))
 575           (setq tmp-list (cdr tmp-list)))
 576         (setq order-list (nconc order-list (list element)))
 577         (setq appt-list (delq element appt-list))))
 578     order-list))
 579
 580
 581 (defun appt-convert-time (time2conv)
 582   "Convert hour:min[am/pm] format to minutes from midnight."
 583
 584   (let ((conv-time 0)
 585         (hr 0)
 586         (min 0))
 587
 588     (string-match ":\\([0-9][0-9]\\)" time2conv)
 589     (setq min (string-to-int
 590                (match-string 1 time2conv)))
 591
 592     (string-match "[0-9]?[0-9]:" time2conv)
 593     (setq hr (string-to-int
 594               (match-string 0 time2conv)))
 595
 596     ;; convert the time appointment time into 24 hour time
 597
 598     (cond ((and (string-match "pm" time2conv) (< hr 12))
 599            (setq hr (+ 12 hr)))
 600           ((and (string-match "am" time2conv) (= hr 12))
 601            (setq hr 0)))
 602
 603     ;; convert the actual time
 604     ;; into minutes for comparison
 605     ;; against the actual time.
 606
 607     (setq conv-time (+ (* hr 60) min))
 608     conv-time))
 609
 610 (defvar appt-timer nil
 611   "Timer used for diary appointment notifications (`appt-check').")
 612
 613 (unless appt-timer
 614   (setq appt-timer (run-at-time t 60 'appt-check)))
 615
 616 (or global-mode-string (setq global-mode-string '("")))
 617 (or (memq 'appt-mode-string global-mode-string)
 618     (setq global-mode-string
 619           (append global-mode-string '(appt-mode-string))))
 620
 621 ;;; appt.el ends here