code.delx.au - gnu-emacs/blob - lisp/calendar/appt.el

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