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 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 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                                     ;; We want to quote any doublequotes
 459                                     ;; in the string, as well as put
 460                                     ;; doublequotes around it.
 461                                     (prin1-to-string
 462                                      (substring-no-properties
 463                                       (car (cdr element)) 0))
 464                                     " from list? "))
 465              (test-input (y-or-n-p prompt-string)))
 466         (setq tmp-msg-list (cdr tmp-msg-list))
 467         (if test-input
 468             (setq appt-time-msg-list (delq element appt-time-msg-list)))))
 469     (appt-check)
 470     (message "")))
 471
 472
 473 (eval-when-compile (defvar number)
 474                    (defvar original-date)
 475                    (defvar diary-entries-list))
 476 ;;;###autoload
 477 (defun appt-make-list ()
 478   "Create the appointments list from todays diary buffer.
 479 The time must be at the beginning of a line for it to be
 480 put in the appointments list.
 481   02/23/89
 482     12:00pm lunch
 483    Wednesday
 484      10:00am group meeting
 485 We assume that the variables DATE and NUMBER
 486 hold the arguments that `list-diary-entries' received.
 487 They specify the range of dates that the diary is being processed for."
 488
 489   ;; We have something to do if the range of dates that the diary is
 490   ;; considering includes the current date.
 491   (if (and (not (calendar-date-compare
 492                  (list (calendar-current-date))
 493                  (list original-date)))
 494            (calendar-date-compare
 495             (list (calendar-current-date))
 496             (list (calendar-gregorian-from-absolute
 497                    (+ (calendar-absolute-from-gregorian original-date)
 498                       number)))))
 499       (save-excursion
 500         ;; Clear the appointments list, then fill it in from the diary.
 501         (setq appt-time-msg-list nil)
 502         (if diary-entries-list
 503
 504             ;; Cycle through the entry-list (diary-entries-list)
 505             ;; looking for entries beginning with a time. If
 506             ;; the entry begins with a time, add it to the
 507             ;; appt-time-msg-list. Then sort the list.
 508
 509             (let ((entry-list diary-entries-list)
 510                   (new-time-string ""))
 511               ;; Skip diary entries for dates before today.
 512               (while (and entry-list
 513                           (calendar-date-compare
 514                            (car entry-list) (list (calendar-current-date))))
 515                 (setq entry-list (cdr entry-list)))
 516               ;; Parse the entries for today.
 517               (while (and entry-list
 518                           (calendar-date-equal
 519                            (calendar-current-date) (car (car entry-list))))
 520                 (let ((time-string (cadr (car entry-list))))
 521                   (while (string-match
 522                           "\\([0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\).*"
 523                           time-string)
 524                     (let* ((beg (match-beginning 0))
 525                            ;; Get just the time for this appointment.
 526                            (only-time (match-string 1 time-string))
 527                            ;; Find the end of this appointment
 528                            ;; (the start of the next).
 529                            (end (string-match
 530                                  "^[ \t]*[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
 531                                  time-string
 532                                  (match-end 0)))
 533                            ;; Get the whole string for this appointment.
 534                            (appt-time-string
 535                             (substring time-string beg (if end (1- end)))))
 536
 537                       ;; Add this appointment to appt-time-msg-list.
 538                       (let* ((appt-time (list (appt-convert-time only-time)))
 539                              (time-msg (list appt-time appt-time-string)))
 540                         (setq appt-time-msg-list
 541                               (nconc appt-time-msg-list (list time-msg))))
 542
 543                       ;; Discard this appointment from the string.
 544                       (setq time-string
 545                             (if end (substring time-string end) "")))))
 546                 (setq entry-list (cdr entry-list)))))
 547         (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
 548
 549         ;; Get the current time and convert it to minutes
 550         ;; from midnight. ie. 12:01am = 1, midnight = 0,
 551         ;; so that the elements in the list
 552         ;; that are earlier than the present time can
 553         ;; be removed.
 554
 555         (let* ((now (decode-time))
 556                (cur-hour (nth 2 now))
 557                (cur-min (nth 1 now))
 558                (cur-comp-time (+ (* cur-hour 60) cur-min))
 559                (appt-comp-time (car (car (car appt-time-msg-list)))))
 560
 561           (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
 562             (setq appt-time-msg-list (cdr appt-time-msg-list))
 563             (if appt-time-msg-list
 564                 (setq appt-comp-time (car (car (car appt-time-msg-list))))))))))
 565
 566
 567 (defun appt-sort-list (appt-list)
 568   "Simple sort to put the appointments list APPT-LIST in order.
 569 Scan the list for the smallest element left in the list.
 570 Append the smallest element left into the new list, and remove
 571 it from the original list."
 572   (let ((order-list nil))
 573     (while appt-list
 574       (let* ((element (car appt-list))
 575              (element-time (car (car element)))
 576              (tmp-list (cdr appt-list)))
 577         (while tmp-list
 578           (if (< element-time (car (car (car tmp-list))))
 579               nil
 580             (setq element (car tmp-list))
 581             (setq element-time (car (car element))))
 582           (setq tmp-list (cdr tmp-list)))
 583         (setq order-list (nconc order-list (list element)))
 584         (setq appt-list (delq element appt-list))))
 585     order-list))
 586
 587
 588 (defun appt-convert-time (time2conv)
 589   "Convert hour:min[am/pm] format to minutes from midnight."
 590
 591   (let ((conv-time 0)
 592         (hr 0)
 593         (min 0))
 594
 595     (string-match ":\\([0-9][0-9]\\)" time2conv)
 596     (setq min (string-to-int
 597                (match-string 1 time2conv)))
 598
 599     (string-match "[0-9]?[0-9]:" time2conv)
 600     (setq hr (string-to-int
 601               (match-string 0 time2conv)))
 602
 603     ;; convert the time appointment time into 24 hour time
 604
 605     (cond ((and (string-match "pm" time2conv) (< hr 12))
 606            (setq hr (+ 12 hr)))
 607           ((and (string-match "am" time2conv) (= hr 12))
 608            (setq hr 0)))
 609
 610     ;; convert the actual time
 611     ;; into minutes for comparison
 612     ;; against the actual time.
 613
 614     (setq conv-time (+ (* hr 60) min))
 615     conv-time))
 616
 617 (defvar appt-timer nil
 618   "Timer used for diary appointment notifications (`appt-check').")
 619
 620 (unless appt-timer
 621   (setq appt-timer (run-at-time t 60 'appt-check)))
 622
 623 (or global-mode-string (setq global-mode-string '("")))
 624 (or (memq 'appt-mode-string global-mode-string)
 625     (setq global-mode-string
 626           (append global-mode-string '(appt-mode-string))))
 627
 628 ;;; arch-tag: bf5791c4-8921-499e-a26f-772b1788d347
 629 ;;; appt.el ends here