|
0
|
1 ;;; appt.el --- appointment notification functions.
|
|
|
2 ;; Keywords: calendar
|
|
|
3
|
|
|
4 ;;; -*- Mode:Emacs-Lisp -*-
|
|
|
5 ;; Appointment notification functions.
|
|
|
6 ;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
70
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
0
|
23
|
|
|
24 ;;; 29-nov-89 created by Neil Mager <neilm@juliet.ll.mit.edu>.
|
|
|
25 ;;; 23-feb-91 hacked upon by Jamie Zawinski <jwz@lucid.com>.
|
|
|
26 ;;; 1-apr-91 some more.
|
|
116
|
27 ;;; 12-jul-95 updated for XEmacs 19.12 by Greg Veres
|
|
|
28 ;;; <gveres@cgl.uwaterloo.ca>
|
|
|
29 ;;; 21-mar-97 better support for fancy diary display by Tomasz J. Cholewo
|
|
|
30 ;;; <t.cholewo@ieee.org>
|
|
0
|
31 ;;;
|
|
|
32 ;; appt.el - visible and/or audible notification of
|
|
|
33 ;; appointments from ~/diary file generated from
|
|
|
34 ;; Edward M. Reingold's calendar.el.
|
|
|
35 ;;
|
|
|
36 ;; Version 2.1
|
|
|
37 ;;
|
|
|
38 ;; Comments, corrections, and improvements should be sent to
|
|
|
39 ;; Neil M. Mager
|
|
|
40 ;; Net <neilm@juliet.ll.mit.edu>
|
|
|
41 ;; Voice (617) 981-4803
|
|
|
42 ;;;
|
|
|
43 ;;; Thanks to Edward M. Reingold for much help and many suggestions,
|
|
|
44 ;;; And to many others for bug fixes and suggestions.
|
|
|
45 ;;;
|
|
|
46 ;;;
|
|
|
47 ;;; This functions in this file will alert the user of a
|
|
|
48 ;;; pending appointment based on their diary file.
|
|
|
49 ;;;
|
|
|
50 ;;; ******* It is necessary to invoke 'display-time' and ********
|
|
|
51 ;;; ******* 'appt-initialize' for this to work properly. ********
|
|
|
52 ;;;
|
|
|
53 ;;; A message will be displayed in the mode line of the emacs buffer and (if
|
|
|
54 ;;; the user desires) the terminal will beep and display a message from the
|
|
|
55 ;;; diary in the mini-buffer, or the user may select to have a message
|
|
|
56 ;;; displayed in a new buffer.
|
|
|
57 ;;;
|
|
|
58 ;;; Variables of note:
|
|
|
59 ;;;
|
|
|
60 ;;; appt-issue-message If this variable is nil, then the code in this
|
|
|
61 ;;; file does nothing.
|
|
|
62 ;;; appt-msg-countdown-list Specifies how much warning you want before
|
|
|
63 ;;; appointments.
|
|
|
64 ;;; appt-audible Whether to beep when it's notification-time.
|
|
|
65 ;;; appt-display-mode-line Whether to display a countdown to the next
|
|
|
66 ;;; appointment in the mode-line.
|
|
|
67 ;;; appt-announce-method The function used to do the notifications.
|
|
|
68 ;;; 'appt-window-announce do it in a pop-up window.
|
|
|
69 ;;; 'appt-frame-announce do it in a pop-up frame (v19 only)
|
|
|
70 ;;; 'appt-message-announce do it in the echo area.
|
|
|
71 ;;; 'appt-persistent-message-announce do it in the echo area, but make the
|
|
|
72 ;;; messages not go away at the next keystroke.
|
|
|
73 ;;; appt-display-duration If appt-announce-method is set to the function
|
|
|
74 ;;; 'appt-window-announce, this specifies how many
|
|
|
75 ;;; seconds the pop-up window should stick around.
|
|
|
76 ;;;
|
|
|
77 ;;; In order to use this, create a diary file, and add the following to your
|
|
|
78 ;;; .emacs file:
|
|
|
79 ;;;
|
|
|
80 ;;; (require 'appt)
|
|
|
81 ;;; (display-time)
|
|
|
82 ;;; (appt-initialize)
|
|
|
83 ;;;
|
|
|
84 ;;; If you wish to see a list of appointments, or a full calendar, when emacs
|
|
|
85 ;;; starts up, you can add a call to (diary) or (calendar) after this.
|
|
|
86 ;;;
|
|
|
87 ;;; This is an example of what can be in your diary file:
|
|
|
88 ;;; Monday
|
|
|
89 ;;; 9:30am Coffee break
|
|
|
90 ;;; 12:00pm Lunch
|
|
|
91 ;;;
|
|
|
92 ;;; Based upon the above lines in your .emacs and diary files, the calendar
|
|
|
93 ;;; and/or diary will be displayed when you enter emacs and your appointments
|
|
|
94 ;;; list will automatically be created. You will then be reminded at 9:20am
|
|
|
95 ;;; about your coffee break and at 11:50am to go to lunch.
|
|
|
96 ;;;
|
|
|
97 ;;; In order to interactively add or delete items from today's list, use
|
|
|
98 ;;; Meta-x appt-add and Meta-x appt-delete. (This does not modify your
|
|
|
99 ;;; diary file, so these will be forgotten when you exit emacs.)
|
|
|
100 ;;;
|
|
|
101 ;;; Additionally, the appointments list is recreated automatically at 12:01am
|
|
|
102 ;;; for those who do not logout every day or are programming late.
|
|
|
103 ;;;
|
|
|
104 ;;; You can have special appointments which execute arbitrary code rather than
|
|
|
105 ;;; simply notifying you -- sort of like the unix "cron" facility. The syntax
|
|
|
106 ;;; for this is borrowed from the Calendar's special-date format. If you have
|
|
|
107 ;;; a diary entry like
|
|
|
108 ;;;
|
|
|
109 ;;; Monday
|
|
|
110 ;;; 3:00am %%(save-all-modified-buffers)
|
|
|
111 ;;;
|
|
|
112 ;;; then on monday at 3AM, the function `save-all-modified-buffers' will be
|
|
|
113 ;;; invoked. (Presumably this function is defined in your .emacs file.)
|
|
|
114 ;;; There will be no notification that these "special" appointments are being
|
|
|
115 ;;; triggered, unless the form evaluated produces a notification.
|
|
|
116 ;;;
|
|
|
117 ;;; It is necessary for the entire list after the "%%" to be on one line in
|
|
|
118 ;;; your .diary file -- there may not be embedded newlines in it. This is a
|
|
|
119 ;;; bit of a misfeature.
|
|
|
120 ;;;
|
|
|
121 ;;; This also interacts correctly with Benjamin Pierce's reportmail.el package.
|
|
|
122 ;;;
|
|
116
|
123 ;;; Brief internal description - Skip this if you are not interested!
|
|
0
|
124 ;;;
|
|
|
125 ;;; The function appt-initialize invokes 'diary' to get a list of today's
|
|
|
126 ;;; appointments, and parses the lines beginning with date descriptions.
|
|
|
127 ;;; This list is cached away. 'diary' is invoked in such a way so as to
|
|
|
128 ;;; not pop up a window displaying the diary buffer.
|
|
|
129 ;;;
|
|
|
130 ;;; The function appt-check is run from the 'loadst' process (or the 'wakeup'
|
|
|
131 ;;; process in emacs 18.57 or newer) which is started by invoking display-time.
|
|
|
132 ;;; It checks this cached list, and announces as appropriate. At midnight,
|
|
|
133 ;;; appt-initialize is called again to rebuild this list.
|
|
|
134 ;;;
|
|
|
135 ;;; display-time-filter is modified to invoke appt-check.
|
|
|
136 ;;;
|
|
|
137 ;;; TO DO:
|
|
|
138 ;;;
|
|
116
|
139 ;;; o multiple adjacent appointments are not handled gracefully. If there
|
|
0
|
140 ;;; is an appointment at 3:30 and another at 3:35, and you have set things
|
|
|
141 ;;; up so that you get a notification twenty minutes before each appt,
|
|
|
142 ;;; then a notification should come at 3:10 for the first appt, and at
|
|
|
143 ;;; 3:15 for the second. Currently, no notifications are generated for an
|
|
108
|
144 ;;; appointment until all preceding appointments have completely expired.
|
|
0
|
145 ;;;
|
|
|
146 ;;; o If there are two appointments at the same time, all but the first are
|
|
|
147 ;;; ignored (not announced.)
|
|
|
148 ;;;
|
|
|
149 ;;; o Appointments which are early enough in the morning that their
|
|
|
150 ;;; announcements should begin before midnight are not announced until
|
|
|
151 ;;; midnight.
|
|
|
152 ;;;
|
|
|
153 ;;; o There should be some way to mark certain appointments as "important,"
|
|
|
154 ;;; so that you will be harassed about them even after they have expired.
|
|
|
155
|
|
|
156
|
|
|
157 (require 'calendar)
|
|
|
158 (require 'diary-lib)
|
|
|
159
|
|
|
160 (defvar appt-issue-message t
|
|
|
161 "*If T, the diary buffer is checked for appointments. For an
|
|
|
162 appointment warning to be made, the time must be the first thing on
|
|
|
163 the line.")
|
|
|
164
|
|
|
165 (defvar appt-msg-countdown-list '(20 15 10 5 3 1)
|
|
|
166 "*A list of the intervals in minutes before the appointment when
|
|
|
167 the warnings will be given. That is, if this were the list '(5 3 1),
|
|
|
168 then a notification would be given five minutes, three minutes, and
|
|
|
169 one minute before the appointment.")
|
|
|
170
|
|
|
171 (defvar appt-check-time-syntax nil
|
|
|
172 "*Whether all diary entries are intended to beging with time specifications.
|
|
|
173 Appt will beep and issue a warning message when encountering unparsable
|
|
|
174 lines.")
|
|
|
175
|
|
|
176 (defvar appt-audible t
|
|
|
177 "*Controls whether appointment announcements should beep.
|
|
|
178 Appt uses two sound-types for beeps: `appt' and `appt-final'.
|
|
|
179 If this is a number, then that many beeps will occur.
|
|
|
180 If this is a cons, the car is how many beeps, and the cdr is the
|
|
|
181 delay between them (a float, fraction of a second to sleep.)
|
|
|
182 See also the variable `appt-msg-countdown-list'")
|
|
|
183
|
|
|
184 (defvar appt-display-mode-line t
|
|
|
185 "*Controls if minutes-to-appointment should be displayed on the mode line.")
|
|
|
186
|
|
|
187 (defvar appt-announce-method 'appt-window-announce
|
|
|
188 "*The name of the function used to notify the user of an impending
|
|
|
189 appointment. This is called with two arguments, the number of minutes
|
|
|
190 until the appointment, and the appointment description list.
|
|
|
191
|
|
|
192 Reasonable values for this variable are 'appt-window-announce,
|
|
|
193 'appt-message-announce, or 'appt-persistent-message-announce.")
|
|
|
194
|
|
|
195
|
|
|
196 (defvar appt-time-msg-list nil
|
|
|
197 "The list of appointments for today. Use appt-add and appt-delete
|
|
|
198 to add and delete appointments from list. The original list is generated
|
|
|
199 from the today's diary-entries-list. The number before each time/message
|
|
|
200 is the time in minutes after midnight.")
|
|
|
201
|
|
|
202 (defconst max-time 1439
|
|
|
203 "11:59pm in minutes - number of minutes in a day minus 1.")
|
|
|
204
|
|
|
205 (defconst appt-check-tick -1)
|
|
|
206
|
|
|
207 (defvar appt-disp-frame nil
|
|
|
208 "If non-nil, frame to display appointments in.")
|
|
|
209 (defvaralias 'appt-disp-screen 'appt-disp-frame)
|
|
|
210
|
|
|
211
|
|
|
212 ;;; Announcement methods
|
|
|
213
|
|
|
214 (defun appt-message-announce (min-to-app appt)
|
|
|
215 "Set appt-announce-method to the name of this function to cause appointment
|
|
|
216 notifications to be given via messages in the minibuffer."
|
|
|
217 (message (if (eq min-to-app 0) "App't NOW."
|
|
|
218 (format "App't in %d minute%s -- %s"
|
|
|
219 min-to-app
|
|
|
220 (if (eq 1 min-to-app) "" "s")
|
|
|
221 (car (cdr appt))))))
|
|
|
222
|
|
|
223
|
|
|
224 (defun appt-persistent-message-announce (min-to-app appt)
|
|
|
225 "Set appt-announce-method to the name of this function to cause appointment
|
|
|
226 notifications to be given via messages in the minibuffer, but have those
|
|
|
227 messages stay around even if you type something (unlike normal messages)."
|
|
|
228 (let ((str (if (eq min-to-app 0)
|
|
|
229 (format "App't NOW -- %s" (car (cdr appt)))
|
|
|
230 (format "App't in %d minute%s -- %s"
|
|
|
231 min-to-app
|
|
|
232 (if (eq 1 min-to-app) "" "s")
|
|
|
233 (car (cdr appt)))))
|
|
|
234 (in-echo-area-already (eq (selected-window) (minibuffer-window))))
|
|
|
235 (if (not in-echo-area-already)
|
|
|
236 ;; don't stomp the echo-area-buffer if reading from the minibuffer now.
|
|
|
237 (save-excursion
|
|
|
238 (save-window-excursion
|
|
|
239 (select-window (minibuffer-window))
|
|
|
240 (delete-region (point-min) (point-max))
|
|
|
241 (insert str))))
|
|
|
242 ;; if we're reading from the echo-area, and all we were going to do is
|
|
|
243 ;; clear the thing, like, don't bother, that's annoying.
|
|
|
244 (if (and in-echo-area-already (string= "" str))
|
|
|
245 nil
|
|
|
246 (message "%s" str))
|
|
|
247 ))
|
|
|
248
|
|
|
249
|
|
|
250 (defvar appt-display-duration 5
|
|
|
251 "*The number of seconds an appointment message is displayed in its own
|
|
|
252 window if appt-announce-method is 'appt-window-announce.")
|
|
|
253
|
|
|
254 (defun appt-window-announce (min-to-app appt)
|
|
|
255 "Set appt-announce-method to the name of this function to cause appointment
|
|
|
256 notifications to be given via messages in a pop-up window. The variable
|
|
|
257 appt-display-duration controls how long this window should be left up."
|
|
|
258 (require 'electric)
|
|
|
259 (save-excursion
|
|
|
260 (save-window-excursion
|
|
|
261 ;; Make sure we're not in the minibuffer
|
|
|
262 ;; before splitting the window.
|
|
|
263 (if (window-minibuffer-p (selected-window))
|
|
|
264 nil
|
|
|
265 (select-window (frame-lowest-window))
|
|
|
266 (split-window))
|
|
|
267 (let (appt-disp-buf)
|
|
|
268 (unwind-protect
|
|
|
269 (progn
|
|
|
270 (setq appt-disp-buf (set-buffer (get-buffer-create "*appt-buf*")))
|
|
|
271 ;; set the mode-line of the pop-up window
|
|
|
272 (setq modeline-format
|
|
|
273 (concat "-------------------- Appointment "
|
|
|
274 (if (eq min-to-app 0)
|
|
|
275 "NOW"
|
|
|
276 (concat "in " min-to-app
|
|
|
277 (if (eq min-to-app 1) " minute" " minutes")))
|
|
|
278 ". ("
|
|
|
279 (let ((h (string-to-int
|
|
|
280 (substring (current-time-string) 11 13))))
|
|
|
281 (concat (if (> h 12) (- h 12) h) ":"
|
|
|
282 (substring (current-time-string) 14 16)
|
|
|
283 (if (< h 12) "am" "pm")))
|
|
|
284 ") %-"))
|
|
|
285 (pop-to-buffer appt-disp-buf)
|
|
|
286 (insert (car (cdr appt)))
|
|
|
287 (shrink-window-if-larger-than-buffer
|
|
|
288 (get-buffer-window appt-disp-buf))
|
|
|
289 (set-buffer-modified-p nil)
|
|
|
290 (sit-for appt-display-duration))
|
|
|
291 (and appt-disp-buf (kill-buffer appt-disp-buf)))))))
|
|
|
292
|
|
|
293 (defvar appt-frame-defaults nil)
|
|
|
294 (defvaralias 'appt-screen-defaults 'appt-frame-defaults)
|
|
|
295
|
|
|
296 (defun appt-frame-announce (min-to-app appt)
|
|
|
297 "Set appt-announce-method to the name of this function to cause appointment
|
|
|
298 notifications to be given via messages in a pop-up frame."
|
|
|
299 (let ()
|
|
|
300 (save-excursion
|
|
|
301 (set-buffer (get-buffer-create "*appt-buf*"))
|
|
|
302 (erase-buffer)
|
|
|
303 ;; set the mode-line of the pop-up window
|
|
|
304 (setq modeline-format
|
|
|
305 (concat "-------------------- Appointment "
|
|
|
306 (if (eq min-to-app 0)
|
|
|
307 "NOW"
|
|
|
308 (concat "in " min-to-app
|
|
|
309 (if (eq min-to-app 1) " minute" " minutes")))
|
|
|
310 ". ("
|
|
|
311 (let ((h (string-to-int
|
|
|
312 (substring (current-time-string) 11 13))))
|
|
|
313 (concat (if (> h 12) (- h 12) h) ":"
|
|
|
314 (substring (current-time-string) 14 16)
|
|
|
315 (if (< h 12) "am" "pm")))
|
|
|
316 ") %-"))
|
|
|
317 (insert (car (cdr appt)))
|
|
|
318 (let ((height (max 10 (min 20 (+ 2 (count-lines (point-min)
|
|
|
319 (point-max)))))))
|
|
|
320 ;; If we already have a frame constructed, use it. If not, or it has
|
|
|
321 ;; been deleted, then make a new one
|
|
|
322 (if (and appt-disp-frame (frame-live-p appt-disp-frame))
|
|
|
323 (let ((s (selected-frame)))
|
|
|
324 (select-frame appt-disp-frame)
|
|
|
325 (make-frame-visible appt-disp-frame)
|
|
|
326 (set-frame-height appt-disp-frame height)
|
|
|
327 (sit-for 0)
|
|
|
328 (select-frame s))
|
|
|
329 (progn
|
|
|
330 (setq appt-disp-frame (make-frame))
|
|
|
331 (set-frame-height appt-disp-frame height)
|
|
|
332 )
|
|
|
333 )
|
|
|
334 )
|
|
|
335 )
|
|
|
336 )
|
|
|
337 )
|
|
|
338 (defalias 'appt-screen-announce 'appt-frame-announce)
|
|
|
339
|
|
|
340 ;;; To display stuff in the mode line, we use a new variable instead of
|
|
|
341 ;;; just adding stuff to the display-time-string -- this causes less
|
|
|
342 ;;; flicker.
|
|
|
343
|
|
|
344 (defvar appt-mode-line-string ""
|
|
|
345 "*The string displayed in the mode line by the appointment package.")
|
|
|
346
|
|
|
347 (defun appt-display-mode-line (min-to-app)
|
|
|
348 "Add an appointment annotation to the mode line."
|
|
|
349 (setq appt-mode-line-string
|
|
|
350 (if (and appt-display-mode-line min-to-app)
|
|
|
351 (if (eq 0 min-to-app)
|
|
|
352 "App't NOW "
|
|
|
353 (concat "App't in " min-to-app
|
|
|
354 (if (eq 1 min-to-app) " minute " " minutes ")))
|
|
|
355 ""))
|
|
|
356 ;; make sure our variable is visible in global-mode-string.
|
|
|
357 (cond ((not appt-display-mode-line) nil)
|
|
|
358 ((null global-mode-string)
|
|
|
359 (setq global-mode-string (list "" 'appt-mode-line-string)))
|
|
|
360 ((stringp global-mode-string)
|
|
|
361 (setq global-mode-string
|
|
|
362 (list global-mode-string 'appt-mode-line-string)))
|
|
|
363 ((not (memq 'appt-mode-line-string global-mode-string))
|
|
|
364 (setq global-mode-string
|
|
|
365 (append global-mode-string (list 'appt-mode-line-string)))))
|
|
|
366 ;; force mode line updates - from time.el
|
|
|
367 (save-excursion (set-buffer (other-buffer)))
|
|
|
368 (set-buffer-modified-p (buffer-modified-p))
|
|
|
369 (sit-for 0))
|
|
|
370
|
|
|
371
|
|
|
372 ;;; Internal stuff
|
|
|
373
|
|
|
374 (defun appt-convert-time (time2conv)
|
|
116
|
375 "Convert hour:min[am/pm] format to minutes from midnight."
|
|
0
|
376 (cond ((string-match "^[ \t]*midni\\(ght\\|te\\)[ \t]*\\'" time2conv)
|
|
|
377 0)
|
|
|
378 ((string-match "^[ \t]*noon[ \t]*\\'" time2conv)
|
|
|
379 (* 12 60))
|
|
|
380 (t
|
|
|
381 (let ((hr 0)
|
|
|
382 (min 0))
|
|
|
383 (or (string-match
|
|
|
384 "\\`[ \t]*\\([0-9][0-9]?\\)[ \t]*\\(:[ \t]*\\([0-9][0-9]\\)\\)?[ \t]*\\(am\\|pm\\)?"
|
|
|
385 time2conv)
|
|
|
386 (error "unparsable time \"%s\"" time2conv))
|
|
|
387 (setq hr (string-to-int
|
|
|
388 (substring time2conv
|
|
|
389 (match-beginning 1) (match-end 1))))
|
|
|
390 (if (match-beginning 3)
|
|
|
391 (setq min (string-to-int
|
|
|
392 (substring time2conv
|
|
|
393 (match-beginning 3) (match-end 3)))))
|
|
|
394 ;; convert the time appointment time into 24 hour time
|
|
|
395 (if (match-beginning 4)
|
|
|
396 (progn
|
|
|
397 (if (or (= hr 0) (> hr 12))
|
|
|
398 (error "mixing 12hr and 24 hr time! %s" time2conv))
|
|
|
399 (if (string-match "am"
|
|
|
400 (substring time2conv (match-beginning 4)))
|
|
|
401 (if (= hr 12) (setq hr 0))
|
|
|
402 (if (< hr 12) (setq hr (+ 12 hr))))))
|
|
|
403 (if (> min 59) (error "minutes outa bounds - %s" time2conv))
|
|
|
404 (+ (* hr 60) min)))))
|
|
|
405
|
|
|
406
|
|
116
|
407 (defun appt-current-time-in-minutes ()
|
|
|
408 "Returns the current time in minutes since midnight."
|
|
0
|
409 (let* ((str (current-time-string))
|
|
|
410 (hour (string-to-int (substring str 11 13)))
|
|
|
411 (min (string-to-int (substring str 14 16))))
|
|
|
412 (+ (* hour 60) min)))
|
|
|
413
|
|
|
414
|
|
|
415 (defun appt-sort-list (appt-list)
|
|
|
416 (sort (copy-sequence appt-list)
|
|
|
417 (function (lambda (x y)
|
|
|
418 (< (car (car x)) (car (car y)))))))
|
|
|
419
|
|
|
420 (defun appt-diary-entries ()
|
|
116
|
421 "Return an updated list of appointments for today."
|
|
0
|
422 (let ((list-diary-entries-hook '(appt-make-list))
|
|
116
|
423 (diary-display-hook 'ignore)
|
|
0
|
424 (diary-list-include-blanks nil))
|
|
|
425 ;; this will set appt-time-msg-list.
|
|
|
426 (diary 1)
|
|
|
427 appt-time-msg-list))
|
|
|
428
|
|
|
429 (defun appt-initialize ()
|
|
116
|
430 "Read your `diary-file' and remember today's appointments. Call this from
|
|
0
|
431 your .emacs file, or any time you want your .diary file re-read (this happens
|
|
116
|
432 automatically at midnight to notice the next day's appointments).
|
|
0
|
433
|
|
|
434 The time must be at the beginning of a line for it to be put in the
|
|
|
435 appointments list.
|
|
|
436 02/23/89
|
|
|
437 12:00pm lunch
|
|
|
438 Wednesday
|
|
|
439 10:00am group meeting"
|
|
|
440 (install-display-time-hook)
|
|
|
441 (let ((n (length (appt-diary-entries))))
|
|
|
442 (cond ((= n 0) (message "no appointments today."))
|
|
|
443 ((= n 1) (message "1 appointment today."))
|
|
70
|
444 (t (message "%d appointments today." n)))))
|
|
0
|
445
|
|
|
446 (defun appt-make-list ()
|
|
|
447 "Don't call this directly; call appt-initialize or appt-diary-entries."
|
|
|
448 (setq appt-time-msg-list nil)
|
|
|
449 (if diary-entries-list
|
|
|
450 ;; Cycle through the entry-list (diary-entries-list) looking for
|
|
|
451 ;; entries beginning with a time. If the entry begins with a time,
|
|
|
452 ;; add it to the appt-time-msg-list. Then sort the list.
|
|
|
453 ;;
|
|
|
454 (let ((entry-list diary-entries-list)
|
|
|
455 (new-appts '()))
|
|
|
456 (while (and entry-list
|
|
|
457 (calendar-date-equal
|
|
|
458 (calendar-current-date) (car (car entry-list))))
|
|
|
459 (let ((time-string (car (cdr (car entry-list)))))
|
|
|
460 (while (string-match
|
|
|
461 "\\`[ \t\n]*\\([0-9]?[0-9]\\(:[0-9][0-9]\\)?[ \t]*\\(am\\|pm\\)?\\|noon\\|midnight\\|midnite\\).*$"
|
|
|
462 time-string)
|
|
|
463 (let* ((eol (match-end 0))
|
|
|
464 (appt-time-string
|
|
|
465 (substring time-string (match-beginning 1)
|
|
|
466 (match-end 1)))
|
|
|
467 (appt-msg-string
|
|
|
468 (substring time-string (match-end 1) eol))
|
|
|
469 (appt-time (list (appt-convert-time appt-time-string))))
|
|
|
470 (setq time-string (substring time-string eol)
|
|
|
471 new-appts (cons (cons appt-time
|
|
|
472 (list (concat appt-time-string ":"
|
|
|
473 appt-msg-string)))
|
|
|
474 new-appts))))
|
|
|
475 (if appt-check-time-syntax
|
|
|
476 (while (string-match "\n*\\([^\n]+\\)$" time-string)
|
|
|
477 (beep)
|
|
|
478 (message "Unparsable time: %s"
|
|
|
479 (substring time-string (match-beginning 1)
|
|
|
480 (match-end 1)))
|
|
|
481 (sit-for 3)
|
|
|
482 (setq time-string (substring time-string (match-end 0)))))
|
|
|
483
|
|
|
484 )
|
|
|
485 (setq entry-list (cdr entry-list)))
|
|
|
486 (setq appt-time-msg-list ; seems we can't nconc this list...
|
|
|
487 (append (nreverse new-appts) appt-time-msg-list))))
|
|
|
488 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
|
|
|
489 ;;
|
|
116
|
490 ;; Get the current time and convert it to minutes from midnight, i.e.,
|
|
|
491 ;; 12:01am = 1, midnight = 0, so that the elements in the list that
|
|
|
492 ;; are earlier than the present time can be removed.
|
|
0
|
493 ;;
|
|
116
|
494 (let ((cur-comp-time (appt-current-time-in-minutes))
|
|
0
|
495 (appt-comp-time (car (car (car appt-time-msg-list)))))
|
|
|
496 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
|
|
|
497 (setq appt-time-msg-list (cdr appt-time-msg-list))
|
|
|
498 (if appt-time-msg-list
|
|
|
499 (setq appt-comp-time (car (car (car appt-time-msg-list)))))))
|
|
|
500 appt-time-msg-list)
|
|
|
501
|
|
|
502
|
|
|
503 (defun appt-beep (&optional final-p)
|
|
|
504 (cond ((null appt-audible) nil)
|
|
|
505 ((numberp appt-audible)
|
|
|
506 (let ((i appt-audible))
|
|
|
507 (while (> i 0) (beep) (setq i (1- i)))))
|
|
|
508 ((consp appt-audible)
|
|
|
509 (let ((i (car appt-audible))
|
|
|
510 (j (cdr appt-audible)))
|
|
|
511 (if (consp j) (setq j (car j)))
|
|
|
512 (while (> i 0)
|
|
|
513 (if (fboundp 'play-sound)
|
|
|
514 (beep nil (if final-p 'appt-final 'appt))
|
|
|
515 (beep))
|
|
|
516 (sleep-for j)
|
|
|
517 (setq i (1- i)))))
|
|
|
518 (t (beep))))
|
|
|
519
|
|
|
520
|
|
|
521 (defun appt-check ()
|
|
|
522 "Check for an appointment and update the mode line and minibuffer if
|
|
|
523 desired. Note: the time must be the first thing in the line in the diary
|
|
|
524 for a warning to be issued.
|
|
|
525 The format of the time can be either 24 hour or am/pm. Example:
|
|
|
526
|
|
|
527 02/23/89
|
|
|
528 18:00 Dinner
|
|
|
529 Thursday
|
|
|
530 11:45am Lunch meeting.
|
|
|
531
|
|
|
532 The following variables control the action of the notification:
|
|
|
533
|
|
|
534 appt-issue-message If this variable is nil, then the code in this
|
|
|
535 file does nothing.
|
|
|
536 appt-msg-countdown-list Specifies how much warning you want before
|
|
|
537 appointments.
|
|
|
538 appt-audible Whether to beep when it's notification-time.
|
|
|
539 appt-display-mode-line Whether to display a countdown to the next
|
|
|
540 appointment in the mode-line.
|
|
|
541 appt-announce-method The function used to do the notifications.
|
|
|
542 'appt-window-announce to do it in a pop-up
|
|
|
543 window, 'appt-message-announce or
|
|
|
544 'appt-persistent-message-announce to do it
|
|
|
545 in the echo-area.
|
|
|
546 appt-display-duration If appt-announce-method is set to the function
|
|
|
547 'appt-window-announce, this specifies how many
|
|
|
548 seconds the pop-up window should stick around.
|
|
|
549
|
|
|
550 This function is run from the `loadst' or `wakeup' process for display-time.
|
|
|
551 Therefore, you need to have (display-time) in your .emacs file."
|
|
|
552 (if appt-issue-message
|
|
|
553 (let ((min-to-app -1))
|
|
|
554 ;; Get the current time and convert it to minutes
|
|
116
|
555 ;; from midnight, i.e., 12:01am = 1, midnight = 0.
|
|
|
556 (let* ((cur-comp-time (appt-current-time-in-minutes))
|
|
0
|
557 ;; If the current time is the same as the tick, just return.
|
|
|
558 ;; This means that this function has been called more than once
|
|
|
559 ;; in the current minute, which is not useful.
|
|
|
560 (shut-up-this-time (= cur-comp-time appt-check-tick))
|
|
|
561 (turnover-p (> appt-check-tick cur-comp-time)))
|
|
|
562 (setq appt-check-tick cur-comp-time)
|
|
|
563 ;;
|
|
|
564 ;; If it is now the next day (we have crossed midnight since the last
|
|
|
565 ;; time this was called) then we should update our appointments to
|
|
116
|
566 ;; today's list. Show the diary entries (tjc).
|
|
|
567 (if turnover-p (diary 1))
|
|
0
|
568 ;;
|
|
|
569 ;; Get the first time off of the list and calculate the number
|
|
|
570 ;; of minutes until the appointment.
|
|
|
571 (if appt-time-msg-list
|
|
|
572 (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
|
|
|
573 (setq min-to-app (- appt-comp-time cur-comp-time))
|
|
|
574 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
|
|
|
575 (setq appt-time-msg-list (cdr appt-time-msg-list))
|
|
|
576 (if appt-time-msg-list
|
|
|
577 (setq appt-comp-time (car (car (car appt-time-msg-list))))))
|
|
|
578 ;;
|
|
|
579 ;; If we have an appointment between midnight and warning-time
|
|
|
580 ;; minutes after midnight, we must begin to issue a message
|
|
|
581 ;; before midnight. Midnight is considered 0 minutes and 11:59pm
|
|
|
582 ;; is 1439 minutes. Therefore we must recalculate the minutes to
|
|
|
583 ;; appointment variable. It is equal to the number of minutes
|
|
|
584 ;; before midnight plus the number of minutes after midnight our
|
|
|
585 ;; appointment is.
|
|
|
586 ;;
|
|
|
587 ;; ## I don't think this does anything -- it would if it were
|
|
|
588 ;; (for example) a 12:01am appt on the list at 11:55pm, but that
|
|
|
589 ;; can't ever happen, because the applicable 12:01am appt is for
|
|
|
590 ;; tomorrow, not today, and we only have today's diary list.
|
|
|
591 ;; It's not simply a matter of concatenating two days together,
|
|
|
592 ;; either, because then tuesday's appts would be signalled on
|
|
|
593 ;; monday. We have to do a real one-day lookahead -- keep a list
|
|
|
594 ;; of tomorrow's appts, and check it when near midnight.
|
|
|
595 ;;
|
|
|
596 (if (and (< appt-comp-time (apply 'max appt-msg-countdown-list))
|
|
|
597 (> (+ cur-comp-time (apply 'max appt-msg-countdown-list))
|
|
|
598 max-time))
|
|
|
599 (setq min-to-app (+ (- (1+ max-time) cur-comp-time))
|
|
|
600 appt-comp-time))
|
|
|
601 ;;
|
|
|
602 ;; issue warning if the appointment time is within warning-time
|
|
|
603 (cond
|
|
|
604 ;; if there should not be any notifications in the mode-line,
|
|
|
605 ;; clear it.
|
|
|
606 ((> min-to-app (apply 'max appt-msg-countdown-list))
|
|
|
607 (appt-display-mode-line nil))
|
|
|
608 ;; do nothing if this is the second time this minute we've
|
|
|
609 ;; gotten here, of if we shouldn't be notifying right now.
|
|
|
610 ((or shut-up-this-time
|
|
|
611 (and (not (= min-to-app 0))
|
|
|
612 (not (memq min-to-app appt-msg-countdown-list))))
|
|
|
613 nil)
|
|
|
614
|
|
|
615 ((and (= min-to-app 0)
|
|
|
616 (string-match "%%(" (nth 1 (car appt-time-msg-list))))
|
|
|
617 ;;
|
|
|
618 ;; If this is a magic evaluating-notification, evaluate it.
|
|
|
619 ;; these kinds of notifications aren't subject to the
|
|
|
620 ;; appt-msg-countdown-list.
|
|
|
621 ;;
|
|
|
622 (let* ((list-string (substring (nth 1 (car appt-time-msg-list))
|
|
|
623 (1- (match-end 0))))
|
|
|
624 (form (condition-case ()
|
|
|
625 (read list-string)
|
|
|
626 (error
|
|
|
627 (ding)
|
|
|
628 (message "Appt: error reading from \"%s\""
|
|
|
629 (nth 1 (car appt-time-msg-list)))
|
|
|
630 (sit-for 2)
|
|
|
631 nil))))
|
|
|
632 (eval form)))
|
|
|
633
|
|
|
634 ((and (<= min-to-app (apply 'max appt-msg-countdown-list))
|
|
|
635 (>= min-to-app 0))
|
|
|
636 ;;
|
|
|
637 ;; produce a notification.
|
|
|
638 (appt-beep (= min-to-app 0))
|
|
|
639 (funcall appt-announce-method min-to-app
|
|
|
640 (car appt-time-msg-list))
|
|
|
641 ;; update mode line and expire if necessary
|
|
|
642 (appt-display-mode-line min-to-app)
|
|
|
643 ;; if it's expired, remove it.
|
|
|
644 (if (= min-to-app 0)
|
|
|
645 (setq appt-time-msg-list (cdr appt-time-msg-list))))
|
|
|
646 (t
|
|
|
647 ;; else we're not near any appointment, or there are no
|
|
|
648 ;; apointments; make sure mode line is clear.
|
|
|
649 (appt-display-mode-line nil))))
|
|
|
650 (appt-display-mode-line nil))))))
|
|
|
651
|
|
|
652
|
|
|
653
|
|
|
654 ;;; Interactively adding and deleting appointments
|
|
|
655
|
|
|
656 (defun appt-add (new-appt-time new-appt-msg)
|
|
|
657 "Adds an appointment to the list of appointments for the day at TIME
|
|
|
658 and issue MESSAGE. The time should be in either 24 hour format or
|
|
|
659 am/pm format. "
|
|
|
660
|
|
|
661 (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
|
|
|
662 (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
|
|
|
663 nil
|
|
|
664 (error "Unacceptable time-string"))
|
|
|
665
|
|
|
666 (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
|
|
|
667 (appt-time (list (appt-convert-time new-appt-time)))
|
|
|
668 (time-msg (cons appt-time (list appt-time-string))))
|
|
|
669 (setq appt-time-msg-list (append appt-time-msg-list
|
|
|
670 (list time-msg)))
|
|
|
671 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
|
|
|
672
|
|
|
673 (defun appt-delete ()
|
|
|
674 "Deletes an appointment from the list of appointments."
|
|
|
675 (interactive)
|
|
|
676 (let* ((tmp-msg-list appt-time-msg-list))
|
|
|
677 (while tmp-msg-list
|
|
|
678 (let* ((element (car tmp-msg-list))
|
|
|
679 (prompt-string (concat "Delete "
|
|
|
680 (prin1-to-string (car (cdr element)))
|
|
|
681 " from list? "))
|
|
|
682 (test-input (y-or-n-p prompt-string)))
|
|
|
683 (setq tmp-msg-list (cdr tmp-msg-list))
|
|
|
684 (if test-input
|
|
|
685 (setq appt-time-msg-list (delq element appt-time-msg-list)))))
|
|
|
686 (message "")))
|
|
|
687
|
|
|
688
|
|
|
689 ;;; Patching in to existing time code to install our hook.
|
|
|
690
|
|
|
691
|
|
|
692 (defvar display-time-hook-installed nil)
|
|
|
693
|
|
|
694 (defun install-display-time-hook ()
|
|
118
|
695 (unless display-time-hook-installed ; only do this stuff once!
|
|
|
696 (unless (boundp 'display-time-hook) ; Need to wrapper it.
|
|
|
697 (defvar display-time-hook nil
|
|
|
698 "*List of functions to be called when the time is updated on the mode line.")
|
|
|
699 (let ((old-fn (if (or (featurep 'reportmail)
|
|
|
700 ;; old reportmail without a provide statement
|
|
|
701 (and (fboundp 'display-time-filter-18-55)
|
|
|
702 (fboundp 'display-time-filter-18-57)))
|
|
|
703 (if (and (featurep 'itimer) ; XEmacs reportmail.el
|
|
|
704 (fboundp 'display-time-timer-function))
|
|
|
705 'display-time-timer-function
|
|
|
706 ;; older reportmail, or no timer.el.
|
|
|
707 (if (string-match "18\\.5[0-5]" (emacs-version))
|
|
|
708 'display-time-filter-18-55
|
|
|
709 'display-time-filter-18-57))
|
|
|
710 ;; othewise, time.el
|
|
|
711 (if (and (featurep 'itimer)
|
|
|
712 (fboundp 'display-time-function)) ; XEmacs
|
|
|
713 'display-time-function
|
|
|
714 'display-time-filter))))
|
|
0
|
715 ;; we're about to redefine it...
|
|
118
|
716 (fset 'old-display-time-filter (symbol-function old-fn))
|
|
|
717 (fset old-fn
|
|
|
718 '(lambda (&rest args) ;; ...here's the revised definition
|
|
|
719 "Revised version of the original function: this version calls a hook."
|
|
|
720 (apply 'old-display-time-filter args)
|
|
|
721 (run-hooks 'display-time-hook)))))
|
|
|
722 (setq display-time-hook-installed t)
|
|
|
723 (if (fboundp 'add-hook)
|
|
|
724 (add-hook 'display-time-hook 'appt-check)
|
|
|
725 (setq display-time-hook (cons appt-check display-time-hook)))
|
|
|
726 ))
|
|
0
|
727
|
|
|
728 (provide 'appt)
|
