appt.el 31.4 KB
Newer Older
1
;;; appt.el --- appointment notification functions  -*- lexical-binding:t -*-
Eric S. Raymond's avatar
Eric S. Raymond committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1989-1990, 1994, 1998, 2001-2019 Free Software
4
;; Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
5

Eric S. Raymond's avatar
Eric S. Raymond committed
6
;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
Glenn Morris's avatar
Glenn Morris committed
7
;; Maintainer: emacs-devel@gnu.org
Eric S. Raymond's avatar
Eric S. Raymond committed
8
;; Keywords: calendar
9
;; Package: calendar
Eric S. Raymond's avatar
Eric S. Raymond committed
10

Jim Blandy's avatar
Jim Blandy committed
11 12
;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
17 18 19 20 21 22 23

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Jim Blandy's avatar
Jim Blandy committed
25

Eric S. Raymond's avatar
Eric S. Raymond committed
26 27
;;; Commentary:

Jim Blandy's avatar
Jim Blandy committed
28 29
;;
;; appt.el - visible and/or audible notification of
30
;;           appointments from diary file.
Jim Blandy's avatar
Jim Blandy committed
31
;;
32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
;;
;; Thanks to  Edward M. Reingold for much help and many suggestions,
;; And to many others for bug fixes and suggestions.
;;
;;
;; This functions in this file will alert the user of a
;; pending appointment based on his/her diary file.  This package
;; is documented in the Emacs manual.
;;
;; To activate this package, simply use (appt-activate 1).
;; A `diary-file' with appointments of the format described in the
;; documentation of the function `appt-check' is required.
;; Relevant customizable variables are also listed in the
;; documentation of that function.
;;
;; Today's appointment list is initialized from the diary when this
Glenn Morris's avatar
Glenn Morris committed
48
;; package is activated.  Additionally, the appointments list is
49
;; recreated automatically at 12:01am for those who do not logout
Glenn Morris's avatar
Glenn Morris committed
50
;; every day or are programming late.  It is also updated when the
51 52 53
;; `diary-file' (or a file it includes) is saved.  Calling
;; `appt-check' with an argument (or re-enabling the package) forces a
;; re-initialization at any time.
54 55 56 57 58 59 60 61 62 63 64
;;
;; In order to add or delete items from today's list, without
;; changing the diary file, use `appt-add' and `appt-delete'.
;;

;; Brief internal description - Skip this if you are not interested!
;;
;; The function `appt-make-list' creates the appointments list which
;; `appt-check' reads.
;;
;; You can change the way the appointment window is created/deleted by
Glenn Morris's avatar
Glenn Morris committed
65 66 67 68
;; setting the variables `appt-disp-window-function' and
;; `appt-delete-window-function'.  For instance, you could be set them
;; to functions that display appointments in pop-up frames, which are
;; lowered or iconified after `appt-display-interval' minutes.
69
;;
Eric S. Raymond's avatar
Eric S. Raymond committed
70 71 72

;;; Code:

73
(require 'diary-lib)
Richard M. Stallman's avatar
Richard M. Stallman committed
74

75 76 77

(defgroup appt nil
  "Appointment notification."
78
  :prefix "appt-"
79 80
  :group 'calendar)

81
(defcustom appt-message-warning-time 12
Glenn Morris's avatar
Glenn Morris committed
82 83
  "Default time in minutes before an appointment that the warning begins.
You probably want to make `appt-display-interval' a factor of this."
84 85
  :type 'integer
  :group 'appt)
Jim Blandy's avatar
Jim Blandy committed
86

87 88 89 90 91 92
(defcustom appt-warning-time-regexp "warntime \\([0-9]+\\)"
  "Regexp matching a string giving the warning time for an appointment.
The first subexpression matches the time in minutes (an integer).
This overrides the default `appt-message-warning-time'.
You may want to put this inside a diary comment (see `diary-comment-start').
For example, to be warned 30 minutes in advance of an appointment:
93
   2011/06/01 12:00 Do something ## warntime 30"
94 95 96 97
  :version "24.1"
  :type 'regexp
  :group 'appt)

98
(defcustom appt-audible t
99
  "Non-nil means beep to indicate appointment."
100 101
  :type 'boolean
  :group 'appt)
Jim Blandy's avatar
Jim Blandy committed
102

103
;; TODO - add popup.
104
(defcustom appt-display-format 'window
105 106 107 108 109
  "How appointment reminders should be displayed.
The options are:
   window - use a separate window
   echo   - use the echo area
   nil    - no visible reminder.
110
See also `appt-audible' and `appt-display-mode-line'."
111 112 113
  :type '(choice
          (const :tag "Separate window" window)
          (const :tag "Echo-area" echo)
114
          (const :tag "No visible display" nil))
115
  :group 'appt
116
  :version "24.1") ; no longer inherit from deleted obsolete variables
117 118

(defcustom appt-display-mode-line t
119
  "Non-nil means display minutes to appointment and time on the mode line.
Glenn Morris's avatar
Glenn Morris committed
120
This is in addition to any other display of appointment messages.
121
The mode line updates every minute, independent of the value of
Glenn Morris's avatar
Glenn Morris committed
122
`appt-display-interval'."
123 124
  :type 'boolean
  :group 'appt)
Jim Blandy's avatar
Jim Blandy committed
125

126
(defcustom appt-display-duration 10
127
  "The number of seconds an appointment message is displayed.
128
Only relevant if reminders are to be displayed in their own window."
129 130
  :type 'integer
  :group 'appt)
Jim Blandy's avatar
Jim Blandy committed
131

132
(defcustom appt-display-diary t
133
  "Non-nil displays the diary when the appointment list is first initialized.
Glenn Morris's avatar
Glenn Morris committed
134 135
This occurs when this package is first activated, and then at
midnight when the appointment list updates."
136 137
  :type 'boolean
  :group 'appt)
Jim Blandy's avatar
Jim Blandy committed
138

139
(defcustom appt-display-interval 3
Glenn Morris's avatar
Glenn Morris committed
140 141 142 143 144 145 146 147 148
  "Interval in minutes at which to display appointment reminders.
Once an appointment becomes due, Emacs displays reminders every
`appt-display-interval' minutes.  You probably want to make
`appt-message-warning-time' be a multiple of this, so that you get
a final message displayed precisely when the appointment is due.

Note that this variable controls the interval at which
`appt-display-message' is called.  The mode line display (if active)
always updates every minute."
149 150
  :type 'integer
  :group 'appt)
151

152
(defcustom appt-disp-window-function #'appt-disp-window
153
  "Function called to display appointment window.
154 155
Only relevant if reminders are being displayed in a window.
It should take three string arguments: the number of minutes till
156 157 158
the appointment, the current time, and the text of the appointment.
Each argument may also be a list, if multiple appointments are
relevant at any one time."
Glenn Morris's avatar
Glenn Morris committed
159
  :type 'function
160 161
  :group 'appt)

162
(defcustom appt-delete-window-function #'appt-delete-window
163 164
  "Function called to remove appointment window and buffer.
Only relevant if reminders are being displayed in a window."
Glenn Morris's avatar
Glenn Morris committed
165
  :type 'function
166 167 168 169 170
  :group 'appt)


;;; Internal variables below this point.

171
(defconst appt-buffer-name "*appt-buf*"
172
  "Name of the appointments buffer.")
173

Glenn Morris's avatar
Glenn Morris committed
174 175
;; TODO Turn this into an alist?  It would be easier to add more
;; optional elements.
176 177 178
;; Why is the first element (MINUTES) rather than just MINUTES?
;; It may just inherit from diary-entries-list, where we have
;; ((MONTH DAY YEAR) ENTRY)
179 180 181 182 183
(defvar appt-time-msg-list nil
  "The list of appointments for today.
Use `appt-add' and `appt-delete' to add and delete appointments.
The original list is generated from today's `diary-entries-list', and
can be regenerated using the function `appt-check'.
Glenn Morris's avatar
Glenn Morris committed
184
Each element of the generated list has the form
185
\((MINUTES) STRING [FLAG] [WARNTIME])
Glenn Morris's avatar
Glenn Morris committed
186 187
where MINUTES is the time in minutes of the appointment after midnight,
and STRING is the description of the appointment.
188 189 190 191
FLAG and WARNTIME are not always present.  A non-nil FLAG
indicates that the element was made with `appt-add', so calling
`appt-make-list' again should preserve it.  If WARNTIME is non-nil,
it is an integer to use in place of `appt-message-warning-time'.")
192

Stefan Monnier's avatar
Stefan Monnier committed
193
(defconst appt-max-time (1- (* 24 60))
194
  "11:59pm in minutes - number of minutes in a day minus 1.")
195

196
(defvar appt-mode-string nil
197
  "String being displayed in the mode line saying you have an appointment.
198 199
The actual string includes the amount of time till the appointment.
Only used if `appt-display-mode-line' is non-nil.")
200
(put 'appt-mode-string 'risky-local-variable t) ; for 'face property
201 202

(defvar appt-prev-comp-time nil
Glenn Morris's avatar
Glenn Morris committed
203
  "Time of day (mins since midnight) at which we last checked appointments.")
204

Glenn Morris's avatar
Glenn Morris committed
205
(defvar appt-display-count 0
206
  "Internal variable used to count number of consecutive reminders.")
207

208 209 210 211 212 213 214 215 216 217
(defvar appt-timer nil
  "Timer used for diary appointment notifications (`appt-check').
If this is non-nil, appointment checking is active.")


;;; Functions.

(defun appt-display-message (string mins)
  "Display a reminder about an appointment.
The string STRING describes the appointment, due in integer MINS minutes.
218 219 220 221
The arguments may also be lists, where each element relates to a
separate appointment.  The variable `appt-display-format' controls
the format of the visible reminder.  If `appt-audible' is non-nil,
also calls `beep' for an audible reminder."
222
  (if appt-audible (beep 1))
223 224 225 226 227
  ;; Backwards compatibility: avoid passing lists to a-d-w-f if not necessary.
  (and (listp mins)
       (= (length mins) 1)
       (setq mins (car mins)
             string (car string)))
228
  (cond ((eq appt-display-format 'window)
229
         ;; TODO use calendar-month-abbrev-array rather than %b?
230
         (let ((time (format-time-string "%a %b %e ")))
231 232 233
           (condition-case err
               (funcall appt-disp-window-function
                        (if (listp mins)
234
                            (mapcar #'number-to-string mins)
235 236 237 238 239
                          (number-to-string mins))
                        time string)
             (wrong-type-argument
              (if (not (listp mins))
                  (signal (car err) (cdr err))
240
                (message "Argtype error in `appt-disp-window-function' - \
241 242 243 244 245
update it for multiple appts?")
                ;; Fallback to just displaying the first appt, as we used to.
                (funcall appt-disp-window-function
                         (number-to-string (car mins)) time
                         (car string))))))
246 247 248 249
         (run-at-time (format "%d sec" appt-display-duration)
                      nil
                      appt-delete-window-function))
        ((eq appt-display-format 'echo)
250
         (message "%s" (if (listp string)
251
                           (mapconcat #'identity string "\n")
252
                         string)))))
253

254 255 256 257 258 259
(defun appt-mode-line (min-to-app &optional abbrev)
  "Return an appointment string suitable for use in the mode-line.
MIN-TO-APP is a list of minutes, as strings.
If ABBREV is non-nil, abbreviates some text."
  ;; All this silliness is just to make the formatting slightly nicer.
  (let* ((multiple (> (length min-to-app) 1))
260 261 262
         (imin (if (or (not multiple)
                       (not (delete (car min-to-app) min-to-app)))
                   (car min-to-app))))
263 264 265 266 267
    (format "%s%s %s"
            (if abbrev "App't" "Appointment")
            (if multiple "s" "")
            (if (equal imin "0") "now"
              (format "in %s %s"
268
                      (or imin (mapconcat #'identity min-to-app ","))
269 270
                      (if abbrev "min."
                        (format "minute%s" (if (equal imin "1") "" "s"))))))))
271 272 273 274 275

(defun appt-check (&optional force)
  "Check for an appointment and update any reminder display.
If optional argument FORCE is non-nil, reparse the diary file for
appointments.  Otherwise the diary file is only parsed once per day,
276
or when it (or a file it includes) is saved.
Jim Blandy's avatar
Jim Blandy committed
277

278 279 280
Note: the time must be the first thing in the line in the diary
for a warning to be issued.  The format of the time can be either
24 hour or am/pm.  For example:
Jim Blandy's avatar
Jim Blandy committed
281

282 283
              02/23/89
                18:00 Dinner
284

Jim Blandy's avatar
Jim Blandy committed
285 286 287
              Thursday
                11:45am Lunch meeting.

288 289
Appointments are checked every `appt-display-interval' minutes.
The following variables control appointment notification:
Jim Blandy's avatar
Jim Blandy committed
290

291 292
`appt-display-format'
        Controls the format in which reminders are displayed.
Jim Blandy's avatar
Jim Blandy committed
293

294
`appt-audible'
Glenn Morris's avatar
Glenn Morris committed
295
        Non-nil means there is an audible component to reminders.
Jim Blandy's avatar
Jim Blandy committed
296

297
`appt-message-warning-time'
Glenn Morris's avatar
Glenn Morris committed
298 299
        The default number of minutes in advance at which reminders
        should start.
300 301

`appt-display-mode-line'
Glenn Morris's avatar
Glenn Morris committed
302 303
        Non-nil means show in the mode line a countdown to the
        time of each appointment, once reminders start.
304 305

`appt-display-interval'
Glenn Morris's avatar
Glenn Morris committed
306
        Interval in minutes at which to display appointment messages.
Jim Blandy's avatar
Jim Blandy committed
307

308
`appt-display-diary'
Glenn Morris's avatar
Glenn Morris committed
309 310
        Non-nil means display the diary whenever the appointment list is
        initialized (e.g. the first time we check for appointments each day).
311 312 313

The following variables are only relevant if reminders are being
displayed in a window:
Jim Blandy's avatar
Jim Blandy committed
314

315
`appt-display-duration'
Glenn Morris's avatar
Glenn Morris committed
316
        Number of seconds for which an appointment message is displayed.
317

318
`appt-disp-window-function'
Glenn Morris's avatar
Glenn Morris committed
319
        Function called to display appointment window.
320

321
`appt-delete-window-function'
Glenn Morris's avatar
Glenn Morris committed
322
        Function called to remove appointment window and buffer."
323
  (interactive "P")                     ; so people can force updates
324
  (let* ((prev-appt-mode-string appt-mode-string)
Glenn Morris's avatar
Glenn Morris committed
325
         (prev-appt-display-count appt-display-count)
326 327 328
         ;; Convert current time to minutes after midnight (12.01am = 1).
         (now (decode-time))
         (now-mins (+ (* 60 (nth 2 now)) (nth 1 now)))
329
         appt-mins appt-warn-time min-to-app min-list string-list)
Glenn Morris's avatar
Glenn Morris committed
330 331 332 333
    (save-excursion                   ; FIXME ?
      ;; At first check in any day, update appointments to today's list.
      (if (or force                      ; eg initialize, diary save
              (null appt-prev-comp-time) ; first check
Glenn Morris's avatar
Glenn Morris committed
334
              (< now-mins appt-prev-comp-time)) ; new day
Glenn Morris's avatar
Glenn Morris committed
335
          (ignore-errors
336
            (let ((diary-hook (if (memq #'appt-make-list diary-hook)
Glenn Morris's avatar
Glenn Morris committed
337
                                  diary-hook
338
                                (cons #'appt-make-list diary-hook))))
Glenn Morris's avatar
Glenn Morris committed
339 340 341 342 343 344
              (if appt-display-diary
                  (diary)
                ;; Not displaying the diary, so we can ignore
                ;; diary-number-of-entries.  Since appt.el only
                ;; works on a daily basis, no need for more entries.
                (diary-list-entries (calendar-current-date) 1 t)))))
Glenn Morris's avatar
Glenn Morris committed
345 346 347
      ;; Reset everything now in case we somehow missed a minute,
      ;; or (more likely) an appt was deleted.  (This is the only
      ;; reason we need prev-appt-display-count.)
Glenn Morris's avatar
Glenn Morris committed
348
      (setq appt-prev-comp-time now-mins
Glenn Morris's avatar
Glenn Morris committed
349
            appt-mode-string nil
Glenn Morris's avatar
Glenn Morris committed
350
            appt-display-count 0)
351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405
      ;; If there are entries in the list get each time off of the
      ;; list and calculate the number of minutes until the appointment.
      ;; TODO we are looping over all the appointments each time.
      ;; We could instead sort them by the time at which we need to
      ;; start warning.  But then removing entries in the past becomes
      ;; less straightforward.
      (dolist (appt appt-time-msg-list)
        ;; Remove any entries that are in the past.
        ;; FIXME how can there be any such entries, given that this
        ;; function removes entries when they hit zero minutes,
        ;; and appt-make-list doesn't add any in the past in the first place?
        (if (< (setq appt-mins (caar appt)) now-mins)
            (setq appt-time-msg-list (cdr appt-time-msg-list))
          (setq appt-warn-time (or (nth 3 appt) appt-message-warning-time)
                min-to-app (- appt-mins now-mins))
          ;; If we have an appointment between midnight and
          ;; `appt-warn-time' minutes after midnight, we
          ;; must begin to issue a message before midnight.  Midnight
          ;; is considered 0 minutes and 11:59pm is 1439
          ;; minutes.  Therefore we must recalculate the minutes to
          ;; appointment variable.  It is equal to the number of
          ;; minutes before midnight plus the number of minutes after
          ;; midnight our appointment is.
          ;; FIXME but appt-make-list constructs appt-time-msg-list to only
          ;; contain entries with today's date, so this cannot work?
          ;; Also above we just removed anything with appt-mins < now-mins.
          (if (and (< appt-mins appt-warn-time)
                   (> (+ now-mins appt-warn-time) appt-max-time))
              (setq min-to-app (+ (- (1+ appt-max-time) now-mins)
                                  appt-mins)))
          ;; Issue warning if the appointment time is within the warning time.
          (when (and (<= min-to-app appt-warn-time)
                     (>= min-to-app 0))
            (push min-to-app min-list)
            (push (cadr appt) string-list)
            ;; When an appointment is reached, delete it from the list.
            (if (zerop min-to-app)
                (setq appt-time-msg-list (delete appt appt-time-msg-list))))))
      (when min-list
        (setq min-list (nreverse min-list)
              string-list (nreverse string-list))
        ;; This is true every appt-display-interval minutes from the
        ;; time at which we first started reminding.
        ;; TODO in the case of multiple appointments, whose interval
        ;; should we respect?  The first one that we started warning about?
        ;; That's what we do now, and this makes sense if you interpret
        ;; a-d-i as "don't remind me any more frequently than this".
        ;; But should we always show a message when a new appt becomes due?
        ;; When one appt gets removed, should we switch to the interval
        ;; of the next?
        (and (zerop (mod prev-appt-display-count appt-display-interval))
             (appt-display-message string-list min-list))
        (when appt-display-mode-line
          (setq appt-mode-string
                (concat " " (propertize
406 407 408
                             (appt-mode-line (mapcar #'number-to-string
                                                     min-list)
                                             t)
409 410 411 412
                             'face 'mode-line-emphasis))))
        ;; Reset count to 0 in case we display another appt on the next cycle.
        (setq appt-display-count (if (eq '(0) min-list) 0
                                   (1+ prev-appt-display-count))))
Glenn Morris's avatar
Glenn Morris committed
413 414
      ;; If we have changed the mode line string, redisplay all mode lines.
      (and appt-display-mode-line
Glenn Morris's avatar
Glenn Morris committed
415
           (not (string-equal appt-mode-string prev-appt-mode-string))
Glenn Morris's avatar
Glenn Morris committed
416 417 418 419 420
           (progn
             (force-mode-line-update t)
             ;; If the string now has a notification, redisplay right now.
             (if appt-mode-string
                 (sit-for 0)))))))
Jim Blandy's avatar
Jim Blandy committed
421 422

(defun appt-disp-window (min-to-app new-time appt-msg)
423
  "Display appointment due in MIN-TO-APP (a string) minutes.
424 425 426 427
NEW-TIME is a string giving the current date.
Displays the appointment message APPT-MSG in a separate buffer.
The arguments may also be lists, where each element relates to a
separate appointment."
428
  (let ((this-window (selected-window))
429 430 431 432 433 434
        (appt-disp-buf (get-buffer-create appt-buffer-name)))
    ;; Make sure we're not in the minibuffer before splitting the window.
    ;; FIXME this seems needlessly complicated?
    (when (minibufferp)
      (other-window 1)
      (and (minibufferp) (display-multi-frame-p) (other-frame 1)))
435
    (if (cdr (assq 'unsplittable (frame-parameters)))
Glenn Morris's avatar
Glenn Morris committed
436
        ;; In an unsplittable frame, use something somewhere else.
437 438 439
	(progn
	  (set-buffer appt-disp-buf)
	  (display-buffer appt-disp-buf))
440
      (unless (or (special-display-p (buffer-name appt-disp-buf))
Glenn Morris's avatar
Glenn Morris committed
441 442 443
                  (same-window-p (buffer-name appt-disp-buf)))
        ;; By default, split the bottom window and use the lower part.
        (appt-select-lowest-window)
444 445 446
        ;; Split the window, unless it's too small to do so.
        (when (>= (window-height) (* 2 window-min-height))
          (select-window (split-window))))
447
      (switch-to-buffer appt-disp-buf))
448 449 450 451 452 453 454 455 456
    (or (listp min-to-app)
        (setq min-to-app (list min-to-app)
              appt-msg (list appt-msg)))
    ;; I don't really see the point of the new-time argument.
    ;; It repeatedly reminds you of the date?
    ;; It would make more sense if it was eg the time of the appointment.
    ;; Let's allow it to be a list or not independent of the other elements.
    (or (listp new-time)
        (setq new-time (list new-time)))
457 458 459
    ;; FIXME Link to diary entry?
    (calendar-set-mode-line
     (format " %s. %s" (appt-mode-line min-to-app)
460
             (mapconcat #'identity new-time ", ")))
461 462 463 464 465 466
    (setq buffer-read-only nil
          buffer-undo-list t)
    (erase-buffer)
    ;; If we have appointments at different times, prepend the times.
    (if (or (= 1 (length min-to-app))
            (not (delete (car min-to-app) min-to-app)))
467
        (insert (mapconcat #'identity appt-msg "\n"))
468 469 470
      (dotimes (i (length appt-msg))
        (insert (format "%s%sm: %s" (if (> i 0) "\n" "")
                        (nth i min-to-app) (nth i appt-msg)))))
471
    (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
472
    (set-buffer-modified-p nil)
473
    (setq buffer-read-only t)
474
    (raise-frame)
475
    (select-window this-window)))
476

477 478 479
(defun appt-delete-window ()
  "Function called to undisplay appointment messages.
Usually just deletes the appointment buffer."
480 481
  (let ((window (get-buffer-window appt-buffer-name t)))
    (and window
Glenn Morris's avatar
Glenn Morris committed
482 483
         (or (eq window (frame-root-window (window-frame window)))
             (delete-window window))))
484 485 486
  (let ((buffer (get-buffer appt-buffer-name)))
    (when buffer
      (kill-buffer buffer)))
487 488
  (if appt-audible
      (beep 1)))
Jim Blandy's avatar
Jim Blandy committed
489 490

(defun appt-select-lowest-window ()
Glenn Morris's avatar
Glenn Morris committed
491
  "Select the lowest window on the frame."
492
  (let ((lowest-window (selected-window))
Glenn Morris's avatar
Glenn Morris committed
493
        (bottom-edge (nth 3 (window-edges)))
494
        next-bottom-edge)
495
    (walk-windows (lambda (w)
Glenn Morris's avatar
Glenn Morris committed
496 497 498 499
                    (when (< bottom-edge (setq next-bottom-edge
                                               (nth 3 (window-edges w))))
                      (setq bottom-edge next-bottom-edge
                            lowest-window w))) 'nomini)
500
    (select-window lowest-window)))
Jim Blandy's avatar
Jim Blandy committed
501

Stefan Monnier's avatar
Stefan Monnier committed
502 503 504
(defconst appt-time-regexp
  "[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?")

505
;;;###autoload
Glenn Morris's avatar
Glenn Morris committed
506 507 508 509 510 511
(defun appt-add (time msg &optional warntime)
  "Add an appointment for today at TIME with message MSG.
The time should be in either 24 hour format or am/pm format.
Optional argument WARNTIME is an integer (or string) giving the number
of minutes before the appointment at which to start warning.
The default is `appt-message-warning-time'."
Glenn Morris's avatar
Glenn Morris committed
512
  (interactive "sTime (hh:mm[am/pm]): \nsMessage: \n\
Glenn Morris's avatar
Glenn Morris committed
513 514
sMinutes before the appointment to start warning: ")
  (unless (string-match appt-time-regexp time)
515
    (user-error "Unacceptable time-string"))
Glenn Morris's avatar
Glenn Morris committed
516 517 518 519 520
  (and (stringp warntime)
       (setq warntime (unless (string-equal warntime "")
                        (string-to-number warntime))))
  (and warntime
       (not (integerp warntime))
521
       (user-error "Argument WARNTIME must be an integer, or nil"))
Glenn Morris's avatar
Glenn Morris committed
522
  (or appt-timer (appt-activate))
Glenn Morris's avatar
Glenn Morris committed
523 524
  (let ((time-msg (list (list (appt-convert-time time))
                        (concat time " " msg) t)))
Paul Eggert's avatar
Paul Eggert committed
525
    ;; It is presently nonsensical to have multiple warnings about
Glenn Morris's avatar
Glenn Morris committed
526 527 528
    ;; the same appointment with just different delays, but it might
    ;; not always be so.  TODO
    (if warntime (setq time-msg (append time-msg (list warntime))))
529 530 531
    (unless (member time-msg appt-time-msg-list)
      (setq appt-time-msg-list
            (appt-sort-list (nconc appt-time-msg-list (list time-msg)))))))
Jim Blandy's avatar
Jim Blandy committed
532 533 534 535

(defun appt-delete ()
  "Delete an appointment from the list of appointments."
  (interactive)
536
  (let ((tmp-msg-list appt-time-msg-list))
537 538 539 540 541 542 543 544 545 546
    (dolist (element tmp-msg-list)
      (if (y-or-n-p (concat "Delete "
                            ;; We want to quote any doublequotes in the
                            ;; string, as well as put doublequotes around it.
                            (prin1-to-string
                             (substring-no-properties (cadr element) 0))
                            " from list? "))
          (setq appt-time-msg-list (delq element appt-time-msg-list)))))
  (appt-check)
  (message ""))
547

Jim Blandy's avatar
Jim Blandy committed
548

549
(defvar diary-entries-list)
550

Jim Blandy's avatar
Jim Blandy committed
551
(defun appt-make-list ()
552
  "Update the appointments list from today's diary buffer.
Dave Love's avatar
Dave Love committed
553
The time must be at the beginning of a line for it to be
554
put in the appointments list (see examples in documentation of
555 556
the function `appt-check').  We assume that the variables `original-date' and
`number' hold the arguments that `diary-list-entries' received.
557 558
They specify the range of dates that the diary is being processed for.

559
Any appointments made with `appt-add' are not affected by this function."
560
  (with-no-warnings (defvar number) (defvar original-date))
561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583
  ;; We have something to do if the range of dates that the diary is
  ;; considering includes the current date.
  (if (and (not (calendar-date-compare
                 (list (calendar-current-date))
                 (list original-date)))
           (calendar-date-compare
            (list (calendar-current-date))
            (list (calendar-gregorian-from-absolute
                   (+ (calendar-absolute-from-gregorian original-date)
                      number)))))
      (save-excursion
        ;; Clear the appointments list, then fill it in from the diary.
        (dolist (elt appt-time-msg-list)
          ;; Delete any entries that were not made with appt-add.
          (unless (nth 2 elt)
            (setq appt-time-msg-list
                  (delq elt appt-time-msg-list))))
        (if diary-entries-list
            ;; Cycle through the entry-list (diary-entries-list)
            ;; looking for entries beginning with a time.  If the
            ;; entry begins with a time, add it to the
            ;; appt-time-msg-list.  Then sort the list.
            (let ((entry-list diary-entries-list)
584
                  time-string literal)
585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604
              ;; Below, we assume diary-entries-list was in date
              ;; order.  It is, unless something on
              ;; diary-list-entries-hook has changed it, eg
              ;; diary-include-other-files (bug#7019).  It must be
              ;; in date order if number = 1.
              (and diary-list-entries-hook
                   appt-display-diary
                   (not (eq diary-number-of-entries 1))
                   (not (memq (car (last diary-list-entries-hook))
                              '(diary-sort-entries sort-diary-entries)))
                   (setq entry-list (sort entry-list 'diary-entry-compare)))
              ;; Skip diary entries for dates before today.
              (while (and entry-list
                          (calendar-date-compare
                           (car entry-list) (list (calendar-current-date))))
                (setq entry-list (cdr entry-list)))
              ;; Parse the entries for today.
              (while (and entry-list
                          (calendar-date-equal
                           (calendar-current-date) (caar entry-list)))
605 606 607 608
                (setq time-string (cadr (car entry-list))
                      ;; Including any comments.
                      literal (or (nth 2 (nth 3 (car entry-list)))
                                  time-string))
609 610 611 612 613 614 615 616 617 618
                (while (string-match appt-time-regexp time-string)
                  (let* ((beg (match-beginning 0))
                         ;; Get just the time for this appointment.
                         (only-time (match-string 0 time-string))
                         ;; Find the end of this appointment
                         ;; (the start of the next).
                         (end (string-match
                               (concat "\n[ \t]*" appt-time-regexp)
                               time-string
                               (match-end 0)))
619 620 621
                         (warntime
                          (if (string-match appt-warning-time-regexp literal)
                              (string-to-number (match-string 1 literal))))
622 623 624
                         ;; Get the whole string for this appointment.
                         (appt-time-string
                          (substring time-string beg end))
625 626
                         ;; FIXME why the list?  It makes the first
                         ;; element (MINUTES) rather than MINUTES.
627
                         (appt-time (list (appt-convert-time only-time)))
628 629 630
                         (time-msg (append
                                    (list appt-time appt-time-string)
                                    (if warntime (list nil warntime)))))
631 632 633 634
                    ;; Add this appointment to appt-time-msg-list.
                    (setq appt-time-msg-list
                          (nconc appt-time-msg-list (list time-msg))
                          ;; Discard this appointment from the string.
635
                          ;; (This allows for multiple appts per entry.)
636
                          time-string
637 638 639 640 641 642 643 644
                          (if end (substring time-string end) ""))
                    ;; Similarly, discard the start of literal.
                    (and (> (length time-string) 0)
                         (string-match appt-time-regexp literal)
                         (setq end (string-match
                                    (concat "\n[ \t]*" appt-time-regexp)
                                    literal (match-end 0)))
                         (setq literal (substring literal end)))))
645 646 647
                (setq entry-list (cdr entry-list)))))
        (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
        ;; Convert current time to minutes after midnight (12:01am = 1),
648
        ;; and remove elements in the list that are in the past.
649
        (let* ((now (decode-time))
650 651 652 653
               (now-mins (+ (* 60 (nth 2 now)) (nth 1 now))))
          (while (and appt-time-msg-list
                      (< (caar (car appt-time-msg-list)) now-mins))
            (setq appt-time-msg-list (cdr appt-time-msg-list)))))))
654

Jim Blandy's avatar
Jim Blandy committed
655 656

(defun appt-sort-list (appt-list)
657 658
  "Sort an appointment list, putting earlier items at the front.
APPT-LIST is a list of the same format as `appt-time-msg-list'."
659
  (sort appt-list (lambda (e1 e2) (< (caar e1) (caar e2)))))
Jim Blandy's avatar
Jim Blandy committed
660 661 662


(defun appt-convert-time (time2conv)
663
  "Convert hour:min[am/pm] format TIME2CONV to minutes from midnight.
664 665
A period (.) can be used instead of a colon (:) to separate the
hour and minute parts."
Stefan Monnier's avatar
Stefan Monnier committed
666 667 668 669 670 671 672 673
  ;; Formats that should be accepted:
  ;;   10:00 10.00 10h00 10h 10am 10:00am 10.00am
  (let ((min (if (string-match "[h:.]\\([0-9][0-9]\\)" time2conv)
                 (string-to-number (match-string 1 time2conv))
               0))
        (hr (if (string-match "[0-9]*[0-9]" time2conv)
                (string-to-number (match-string 0 time2conv))
              0)))
Glenn Morris's avatar
Glenn Morris committed
674
    ;; Convert the time appointment time into 24 hour time.
675
    (cond ((and (string-match "pm" time2conv) (< hr 12))
Glenn Morris's avatar
Glenn Morris committed
676 677
           (setq hr (+ 12 hr)))
          ((and (string-match "am" time2conv) (= hr 12))
678
           (setq hr 0)))
Glenn Morris's avatar
Glenn Morris committed
679
    ;; Convert the actual time into minutes.
Stefan Monnier's avatar
Stefan Monnier committed
680
    (+ (* hr 60) min)))
Jim Blandy's avatar
Jim Blandy committed
681

682 683
(defun appt-update-list ()
  "If the current buffer is visiting the diary, update appointments.
Glenn Morris's avatar
Glenn Morris committed
684 685 686 687
This function also acts on any file listed in `diary-included-files'.
It is intended for use with `write-file-functions'."
  (and (member buffer-file-name (append diary-included-files
                                        (list (expand-file-name diary-file))))
688 689 690 691 692 693 694
       appt-timer
       (let ((appt-display-diary nil))
         (appt-check t)))
  nil)

;;;###autoload
(defun appt-activate (&optional arg)
Glenn Morris's avatar
Glenn Morris committed
695
  "Toggle checking of appointments.
696 697 698 699 700 701
With optional numeric argument ARG, turn appointment checking on if
ARG is positive, otherwise off."
  (interactive "P")
  (let ((appt-active appt-timer))
    (setq appt-active (if arg (> (prefix-numeric-value arg) 0)
                        (not appt-active)))
702
    (remove-hook 'write-file-functions #'appt-update-list)
703 704
    (or global-mode-string (setq global-mode-string '("")))
    (delq 'appt-mode-string global-mode-string)
705 706 707
    (when appt-timer
      (cancel-timer appt-timer)
      (setq appt-timer nil))
Glenn Morris's avatar
Glenn Morris committed
708 709
    (if appt-active
        (progn
710 711
          (add-hook 'write-file-functions #'appt-update-list)
          (setq appt-timer (run-at-time t 60 #'appt-check)
Glenn Morris's avatar
Glenn Morris committed
712 713 714
                global-mode-string
                (append global-mode-string '(appt-mode-string)))
          (appt-check t)
Glenn Morris's avatar
Glenn Morris committed
715 716 717 718 719
          (message "Appointment reminders enabled%s"
                   ;; Someone might want to use appt-add without a diary.
                   (if (ignore-errors (diary-check-diary-file))
                       ""
                     " (no diary file found)")))
Glenn Morris's avatar
Glenn Morris committed
720
      (message "Appointment reminders disabled"))))
721

722

723
(provide 'appt)
724

725
;;; appt.el ends here