|
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
|
|
134
|
160 (defcustom appt-issue-message t
|
|
0
|
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
|
|
134
|
163 the line."
|
|
|
164 :type 'boolean
|
|
|
165 :group 'appt)
|
|
0
|
166
|
|
134
|
167 (defcustom appt-msg-countdown-list '(20 15 10 5 3 1)
|
|
0
|
168 "*A list of the intervals in minutes before the appointment when
|
|
|
169 the warnings will be given. That is, if this were the list '(5 3 1),
|
|
|
170 then a notification would be given five minutes, three minutes, and
|
|
134
|
171 one minute before the appointment."
|
|
|
172 :type '(repeat integer)
|
|
|
173 :group 'appt)
|
|
0
|
174
|
|
134
|
175 (defcustom appt-check-time-syntax nil
|
|
0
|
176 "*Whether all diary entries are intended to beging with time specifications.
|
|
|
177 Appt will beep and issue a warning message when encountering unparsable
|
|
134
|
178 lines."
|
|
|
179 :type 'boolean
|
|
|
180 :group 'appt)
|
|
0
|
181
|
|
134
|
182 (defcustom appt-audible t
|
|
0
|
183 "*Controls whether appointment announcements should beep.
|
|
|
184 Appt uses two sound-types for beeps: `appt' and `appt-final'.
|
|
|
185 If this is a number, then that many beeps will occur.
|
|
|
186 If this is a cons, the car is how many beeps, and the cdr is the
|
|
|
187 delay between them (a float, fraction of a second to sleep.)
|
|
134
|
188 See also the variable `appt-msg-countdown-list'"
|
|
|
189 :type 'boolean
|
|
|
190 :group 'appt)
|
|
0
|
191
|
|
134
|
192 (defcustom appt-display-mode-line t
|
|
|
193 "*Controls if minutes-to-appointment should be displayed on the mode line."
|
|
|
194 :type 'boolean
|
|
|
195 :group 'appt)
|
|
0
|
196
|
|
134
|
197 (defcustom appt-announce-method 'appt-window-announce
|
|
0
|
198 "*The name of the function used to notify the user of an impending
|
|
|
199 appointment. This is called with two arguments, the number of minutes
|
|
|
200 until the appointment, and the appointment description list.
|
|
|
201
|
|
|
202 Reasonable values for this variable are 'appt-window-announce,
|
|
134
|
203 'appt-message-announce, or 'appt-persistent-message-announce."
|
|
|
204 :type 'function
|
|
|
205 :group 'appt)
|
|
0
|
206
|
|
|
207
|
|
|
208 (defvar appt-time-msg-list nil
|
|
|
209 "The list of appointments for today. Use appt-add and appt-delete
|
|
|
210 to add and delete appointments from list. The original list is generated
|
|
|
211 from the today's diary-entries-list. The number before each time/message
|
|
|
212 is the time in minutes after midnight.")
|
|
|
213
|
|
|
214 (defconst max-time 1439
|
|
|
215 "11:59pm in minutes - number of minutes in a day minus 1.")
|
|
|
216
|
|
|
217 (defconst appt-check-tick -1)
|
|
|
218
|
|
|
219 (defvar appt-disp-frame nil
|
|
|
220 "If non-nil, frame to display appointments in.")
|
|
|
221 (defvaralias 'appt-disp-screen 'appt-disp-frame)
|
|
|
222
|
|
|
223
|
|
|
224 ;;; Announcement methods
|
|
|
225
|
|
|
226 (defun appt-message-announce (min-to-app appt)
|
|
|
227 "Set appt-announce-method to the name of this function to cause appointment
|
|
|
228 notifications to be given via messages in the minibuffer."
|
|
|
229 (message (if (eq min-to-app 0) "App't NOW."
|
|
|
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
|
|
|
235
|
|
|
236 (defun appt-persistent-message-announce (min-to-app appt)
|
|
|
237 "Set appt-announce-method to the name of this function to cause appointment
|
|
|
238 notifications to be given via messages in the minibuffer, but have those
|
|
|
239 messages stay around even if you type something (unlike normal messages)."
|
|
|
240 (let ((str (if (eq min-to-app 0)
|
|
|
241 (format "App't NOW -- %s" (car (cdr appt)))
|
|
|
242 (format "App't in %d minute%s -- %s"
|
|
|
243 min-to-app
|
|
|
244 (if (eq 1 min-to-app) "" "s")
|
|
|
245 (car (cdr appt)))))
|
|
|
246 (in-echo-area-already (eq (selected-window) (minibuffer-window))))
|
|
|
247 (if (not in-echo-area-already)
|
|
|
248 ;; don't stomp the echo-area-buffer if reading from the minibuffer now.
|
|
|
249 (save-excursion
|
|
|
250 (save-window-excursion
|
|
|
251 (select-window (minibuffer-window))
|
|
|
252 (delete-region (point-min) (point-max))
|
|
|
253 (insert str))))
|
|
|
254 ;; if we're reading from the echo-area, and all we were going to do is
|
|
|
255 ;; clear the thing, like, don't bother, that's annoying.
|
|
|
256 (if (and in-echo-area-already (string= "" str))
|
|
|
257 nil
|
|
|
258 (message "%s" str))
|
|
|
259 ))
|
|
|
260
|
|
|
261
|
|
134
|
262 (defcustom appt-display-duration 5
|
|
0
|
263 "*The number of seconds an appointment message is displayed in its own
|
|
134
|
264 window if appt-announce-method is 'appt-window-announce."
|
|
|
265 :type 'integer
|
|
|
266 :group 'appt)
|
|
0
|
267
|
|
|
268 (defun appt-window-announce (min-to-app appt)
|
|
|
269 "Set appt-announce-method to the name of this function to cause appointment
|
|
|
270 notifications to be given via messages in a pop-up window. The variable
|
|
|
271 appt-display-duration controls how long this window should be left up."
|
|
|
272 (require 'electric)
|
|
|
273 (save-excursion
|
|
|
274 (save-window-excursion
|
|
|
275 ;; Make sure we're not in the minibuffer
|
|
|
276 ;; before splitting the window.
|
|
|
277 (if (window-minibuffer-p (selected-window))
|
|
|
278 nil
|
|
|
279 (select-window (frame-lowest-window))
|
|
|
280 (split-window))
|
|
|
281 (let (appt-disp-buf)
|
|
|
282 (unwind-protect
|
|
|
283 (progn
|
|
|
284 (setq appt-disp-buf (set-buffer (get-buffer-create "*appt-buf*")))
|
|
|
285 ;; set the mode-line of the pop-up window
|
|
|
286 (setq modeline-format
|
|
|
287 (concat "-------------------- Appointment "
|
|
|
288 (if (eq min-to-app 0)
|
|
|
289 "NOW"
|
|
|
290 (concat "in " min-to-app
|
|
|
291 (if (eq min-to-app 1) " minute" " minutes")))
|
|
|
292 ". ("
|
|
|
293 (let ((h (string-to-int
|
|
|
294 (substring (current-time-string) 11 13))))
|
|
|
295 (concat (if (> h 12) (- h 12) h) ":"
|
|
|
296 (substring (current-time-string) 14 16)
|
|
|
297 (if (< h 12) "am" "pm")))
|
|
|
298 ") %-"))
|
|
|
299 (pop-to-buffer appt-disp-buf)
|
|
|
300 (insert (car (cdr appt)))
|
|
|
301 (shrink-window-if-larger-than-buffer
|
|
|
302 (get-buffer-window appt-disp-buf))
|
|
|
303 (set-buffer-modified-p nil)
|
|
|
304 (sit-for appt-display-duration))
|
|
|
305 (and appt-disp-buf (kill-buffer appt-disp-buf)))))))
|
|
|
306
|
|
|
307 (defvar appt-frame-defaults nil)
|
|
|
308 (defvaralias 'appt-screen-defaults 'appt-frame-defaults)
|
|
|
309
|
|
|
310 (defun appt-frame-announce (min-to-app appt)
|
|
|
311 "Set appt-announce-method to the name of this function to cause appointment
|
|
|
312 notifications to be given via messages in a pop-up frame."
|
|
|
313 (let ()
|
|
|
314 (save-excursion
|
|
|
315 (set-buffer (get-buffer-create "*appt-buf*"))
|
|
|
316 (erase-buffer)
|
|
|
317 ;; set the mode-line of the pop-up window
|
|
|
318 (setq modeline-format
|
|
|
319 (concat "-------------------- Appointment "
|
|
|
320 (if (eq min-to-app 0)
|
|
|
321 "NOW"
|
|
|
322 (concat "in " min-to-app
|
|
|
323 (if (eq min-to-app 1) " minute" " minutes")))
|
|
|
324 ". ("
|
|
|
325 (let ((h (string-to-int
|
|
|
326 (substring (current-time-string) 11 13))))
|
|
|
327 (concat (if (> h 12) (- h 12) h) ":"
|
|
|
328 (substring (current-time-string) 14 16)
|
|
|
329 (if (< h 12) "am" "pm")))
|
|
|
330 ") %-"))
|
|
|
331 (insert (car (cdr appt)))
|
|
|
332 (let ((height (max 10 (min 20 (+ 2 (count-lines (point-min)
|
|
|
333 (point-max)))))))
|
|
|
334 ;; If we already have a frame constructed, use it. If not, or it has
|
|
|
335 ;; been deleted, then make a new one
|
|
|
336 (if (and appt-disp-frame (frame-live-p appt-disp-frame))
|
|
|
337 (let ((s (selected-frame)))
|
|
|
338 (select-frame appt-disp-frame)
|
|
|
339 (make-frame-visible appt-disp-frame)
|
|
|
340 (set-frame-height appt-disp-frame height)
|
|
|
341 (sit-for 0)
|
|
|
342 (select-frame s))
|
|
|
343 (progn
|
|
|
344 (setq appt-disp-frame (make-frame))
|
|
|
345 (set-frame-height appt-disp-frame height)
|
|
|
346 )
|
|
|
347 )
|
|
|
348 )
|
|
|
349 )
|
|
|
350 )
|
|
|
351 )
|
|
|
352 (defalias 'appt-screen-announce 'appt-frame-announce)
|
|
|
353
|
|
|
354 ;;; To display stuff in the mode line, we use a new variable instead of
|
|
|
355 ;;; just adding stuff to the display-time-string -- this causes less
|
|
|
356 ;;; flicker.
|
|
|
357
|
|
134
|
358 (defcustom appt-mode-line-string ""
|
|
|
359 "*The string displayed in the mode line by the appointment package."
|
|
|
360 :type 'string
|
|
|
361 :group 'appt)
|
|
0
|
362
|
|
|
363 (defun appt-display-mode-line (min-to-app)
|
|
|
364 "Add an appointment annotation to the mode line."
|
|
|
365 (setq appt-mode-line-string
|
|
|
366 (if (and appt-display-mode-line min-to-app)
|
|
|
367 (if (eq 0 min-to-app)
|
|
|
368 "App't NOW "
|
|
|
369 (concat "App't in " min-to-app
|
|
|
370 (if (eq 1 min-to-app) " minute " " minutes ")))
|
|
|
371 ""))
|
|
|
372 ;; make sure our variable is visible in global-mode-string.
|
|
|
373 (cond ((not appt-display-mode-line) nil)
|
|
|
374 ((null global-mode-string)
|
|
|
375 (setq global-mode-string (list "" 'appt-mode-line-string)))
|
|
|
376 ((stringp global-mode-string)
|
|
|
377 (setq global-mode-string
|
|
|
378 (list global-mode-string 'appt-mode-line-string)))
|
|
|
379 ((not (memq 'appt-mode-line-string global-mode-string))
|
|
|
380 (setq global-mode-string
|
|
|
381 (append global-mode-string (list 'appt-mode-line-string)))))
|
|
|
382 ;; force mode line updates - from time.el
|
|
|
383 (save-excursion (set-buffer (other-buffer)))
|
|
|
384 (set-buffer-modified-p (buffer-modified-p))
|
|
|
385 (sit-for 0))
|
|
|
386
|
|
|
387
|
|
|
388 ;;; Internal stuff
|
|
|
389
|
|
|
390 (defun appt-convert-time (time2conv)
|
|
116
|
391 "Convert hour:min[am/pm] format to minutes from midnight."
|
|
0
|
392 (cond ((string-match "^[ \t]*midni\\(ght\\|te\\)[ \t]*\\'" time2conv)
|
|
|
393 0)
|
|
|
394 ((string-match "^[ \t]*noon[ \t]*\\'" time2conv)
|
|
|
395 (* 12 60))
|
|
|
396 (t
|
|
|
397 (let ((hr 0)
|
|
|
398 (min 0))
|
|
|
399 (or (string-match
|
|
|
400 "\\`[ \t]*\\([0-9][0-9]?\\)[ \t]*\\(:[ \t]*\\([0-9][0-9]\\)\\)?[ \t]*\\(am\\|pm\\)?"
|
|
|
401 time2conv)
|
|
|
402 (error "unparsable time \"%s\"" time2conv))
|
|
|
403 (setq hr (string-to-int
|
|
|
404 (substring time2conv
|
|
|
405 (match-beginning 1) (match-end 1))))
|
|
|
406 (if (match-beginning 3)
|
|
|
407 (setq min (string-to-int
|
|
|
408 (substring time2conv
|
|
|
409 (match-beginning 3) (match-end 3)))))
|
|
|
410 ;; convert the time appointment time into 24 hour time
|
|
|
411 (if (match-beginning 4)
|
|
|
412 (progn
|
|
|
413 (if (or (= hr 0) (> hr 12))
|
|
|
414 (error "mixing 12hr and 24 hr time! %s" time2conv))
|
|
|
415 (if (string-match "am"
|
|
|
416 (substring time2conv (match-beginning 4)))
|
|
|
417 (if (= hr 12) (setq hr 0))
|
|
|
418 (if (< hr 12) (setq hr (+ 12 hr))))))
|
|
|
419 (if (> min 59) (error "minutes outa bounds - %s" time2conv))
|
|
|
420 (+ (* hr 60) min)))))
|
|
|
421
|
|
|
422
|
|
116
|
423 (defun appt-current-time-in-minutes ()
|
|
|
424 "Returns the current time in minutes since midnight."
|
|
0
|
425 (let* ((str (current-time-string))
|
|
|
426 (hour (string-to-int (substring str 11 13)))
|
|
|
427 (min (string-to-int (substring str 14 16))))
|
|
|
428 (+ (* hour 60) min)))
|
|
|
429
|
|
|
430
|
|
|
431 (defun appt-sort-list (appt-list)
|
|
|
432 (sort (copy-sequence appt-list)
|
|
|
433 (function (lambda (x y)
|
|
|
434 (< (car (car x)) (car (car y)))))))
|
|
|
435
|
|
|
436 (defun appt-diary-entries ()
|
|
116
|
437 "Return an updated list of appointments for today."
|
|
0
|
438 (let ((list-diary-entries-hook '(appt-make-list))
|
|
116
|
439 (diary-display-hook 'ignore)
|
|
0
|
440 (diary-list-include-blanks nil))
|
|
|
441 ;; this will set appt-time-msg-list.
|
|
|
442 (diary 1)
|
|
|
443 appt-time-msg-list))
|
|
|
444
|
|
|
445 (defun appt-initialize ()
|
|
116
|
446 "Read your `diary-file' and remember today's appointments. Call this from
|
|
0
|
447 your .emacs file, or any time you want your .diary file re-read (this happens
|
|
116
|
448 automatically at midnight to notice the next day's appointments).
|
|
0
|
449
|
|
|
450 The time must be at the beginning of a line for it to be put in the
|
|
|
451 appointments list.
|
|
|
452 02/23/89
|
|
|
453 12:00pm lunch
|
|
|
454 Wednesday
|
|
|
455 10:00am group meeting"
|
|
|
456 (install-display-time-hook)
|
|
|
457 (let ((n (length (appt-diary-entries))))
|
|
|
458 (cond ((= n 0) (message "no appointments today."))
|
|
|
459 ((= n 1) (message "1 appointment today."))
|
|
70
|
460 (t (message "%d appointments today." n)))))
|
|
0
|
461
|
|
|
462 (defun appt-make-list ()
|
|
|
463 "Don't call this directly; call appt-initialize or appt-diary-entries."
|
|
|
464 (setq appt-time-msg-list nil)
|
|
|
465 (if diary-entries-list
|
|
|
466 ;; Cycle through the entry-list (diary-entries-list) looking for
|
|
|
467 ;; entries beginning with a time. If the entry begins with a time,
|
|
|
468 ;; add it to the appt-time-msg-list. Then sort the list.
|
|
|
469 ;;
|
|
|
470 (let ((entry-list diary-entries-list)
|
|
|
471 (new-appts '()))
|
|
|
472 (while (and entry-list
|
|
|
473 (calendar-date-equal
|
|
|
474 (calendar-current-date) (car (car entry-list))))
|
|
|
475 (let ((time-string (car (cdr (car entry-list)))))
|
|
|
476 (while (string-match
|
|
|
477 "\\`[ \t\n]*\\([0-9]?[0-9]\\(:[0-9][0-9]\\)?[ \t]*\\(am\\|pm\\)?\\|noon\\|midnight\\|midnite\\).*$"
|
|
|
478 time-string)
|
|
|
479 (let* ((eol (match-end 0))
|
|
|
480 (appt-time-string
|
|
|
481 (substring time-string (match-beginning 1)
|
|
|
482 (match-end 1)))
|
|
|
483 (appt-msg-string
|
|
|
484 (substring time-string (match-end 1) eol))
|
|
|
485 (appt-time (list (appt-convert-time appt-time-string))))
|
|
|
486 (setq time-string (substring time-string eol)
|
|
|
487 new-appts (cons (cons appt-time
|
|
|
488 (list (concat appt-time-string ":"
|
|
|
489 appt-msg-string)))
|
|
|
490 new-appts))))
|
|
|
491 (if appt-check-time-syntax
|
|
|
492 (while (string-match "\n*\\([^\n]+\\)$" time-string)
|
|
|
493 (beep)
|
|
|
494 (message "Unparsable time: %s"
|
|
|
495 (substring time-string (match-beginning 1)
|
|
|
496 (match-end 1)))
|
|
|
497 (sit-for 3)
|
|
|
498 (setq time-string (substring time-string (match-end 0)))))
|
|
|
499
|
|
|
500 )
|
|
|
501 (setq entry-list (cdr entry-list)))
|
|
|
502 (setq appt-time-msg-list ; seems we can't nconc this list...
|
|
|
503 (append (nreverse new-appts) appt-time-msg-list))))
|
|
|
504 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
|
|
|
505 ;;
|
|
116
|
506 ;; Get the current time and convert it to minutes from midnight, i.e.,
|
|
|
507 ;; 12:01am = 1, midnight = 0, so that the elements in the list that
|
|
|
508 ;; are earlier than the present time can be removed.
|
|
0
|
509 ;;
|
|
116
|
510 (let ((cur-comp-time (appt-current-time-in-minutes))
|
|
0
|
511 (appt-comp-time (car (car (car appt-time-msg-list)))))
|
|
|
512 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
|
|
|
513 (setq appt-time-msg-list (cdr appt-time-msg-list))
|
|
|
514 (if appt-time-msg-list
|
|
|
515 (setq appt-comp-time (car (car (car appt-time-msg-list)))))))
|
|
|
516 appt-time-msg-list)
|
|
|
517
|
|
|
518
|
|
|
519 (defun appt-beep (&optional final-p)
|
|
|
520 (cond ((null appt-audible) nil)
|
|
|
521 ((numberp appt-audible)
|
|
|
522 (let ((i appt-audible))
|
|
|
523 (while (> i 0) (beep) (setq i (1- i)))))
|
|
|
524 ((consp appt-audible)
|
|
|
525 (let ((i (car appt-audible))
|
|
|
526 (j (cdr appt-audible)))
|
|
|
527 (if (consp j) (setq j (car j)))
|
|
|
528 (while (> i 0)
|
|
|
529 (if (fboundp 'play-sound)
|
|
|
530 (beep nil (if final-p 'appt-final 'appt))
|
|
|
531 (beep))
|
|
|
532 (sleep-for j)
|
|
|
533 (setq i (1- i)))))
|
|
|
534 (t (beep))))
|
|
|
535
|
|
|
536
|
|
|
537 (defun appt-check ()
|
|
|
538 "Check for an appointment and update the mode line and minibuffer if
|
|
|
539 desired. Note: the time must be the first thing in the line in the diary
|
|
|
540 for a warning to be issued.
|
|
|
541 The format of the time can be either 24 hour or am/pm. Example:
|
|
|
542
|
|
|
543 02/23/89
|
|
|
544 18:00 Dinner
|
|
|
545 Thursday
|
|
|
546 11:45am Lunch meeting.
|
|
|
547
|
|
|
548 The following variables control the action of the notification:
|
|
|
549
|
|
|
550 appt-issue-message If this variable is nil, then the code in this
|
|
|
551 file does nothing.
|
|
|
552 appt-msg-countdown-list Specifies how much warning you want before
|
|
|
553 appointments.
|
|
|
554 appt-audible Whether to beep when it's notification-time.
|
|
|
555 appt-display-mode-line Whether to display a countdown to the next
|
|
|
556 appointment in the mode-line.
|
|
|
557 appt-announce-method The function used to do the notifications.
|
|
|
558 'appt-window-announce to do it in a pop-up
|
|
|
559 window, 'appt-message-announce or
|
|
|
560 'appt-persistent-message-announce to do it
|
|
|
561 in the echo-area.
|
|
|
562 appt-display-duration If appt-announce-method is set to the function
|
|
|
563 'appt-window-announce, this specifies how many
|
|
|
564 seconds the pop-up window should stick around.
|
|
|
565
|
|
|
566 This function is run from the `loadst' or `wakeup' process for display-time.
|
|
|
567 Therefore, you need to have (display-time) in your .emacs file."
|
|
|
568 (if appt-issue-message
|
|
|
569 (let ((min-to-app -1))
|
|
|
570 ;; Get the current time and convert it to minutes
|
|
116
|
571 ;; from midnight, i.e., 12:01am = 1, midnight = 0.
|
|
|
572 (let* ((cur-comp-time (appt-current-time-in-minutes))
|
|
0
|
573 ;; If the current time is the same as the tick, just return.
|
|
|
574 ;; This means that this function has been called more than once
|
|
|
575 ;; in the current minute, which is not useful.
|
|
|
576 (shut-up-this-time (= cur-comp-time appt-check-tick))
|
|
|
577 (turnover-p (> appt-check-tick cur-comp-time)))
|
|
|
578 (setq appt-check-tick cur-comp-time)
|
|
|
579 ;;
|
|
|
580 ;; If it is now the next day (we have crossed midnight since the last
|
|
|
581 ;; time this was called) then we should update our appointments to
|
|
116
|
582 ;; today's list. Show the diary entries (tjc).
|
|
|
583 (if turnover-p (diary 1))
|
|
0
|
584 ;;
|
|
|
585 ;; Get the first time off of the list and calculate the number
|
|
|
586 ;; of minutes until the appointment.
|
|
|
587 (if appt-time-msg-list
|
|
|
588 (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
|
|
|
589 (setq min-to-app (- appt-comp-time cur-comp-time))
|
|
|
590 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
|
|
|
591 (setq appt-time-msg-list (cdr appt-time-msg-list))
|
|
|
592 (if appt-time-msg-list
|
|
|
593 (setq appt-comp-time (car (car (car appt-time-msg-list))))))
|
|
|
594 ;;
|
|
|
595 ;; If we have an appointment between midnight and warning-time
|
|
|
596 ;; minutes after midnight, we must begin to issue a message
|
|
|
597 ;; before midnight. Midnight is considered 0 minutes and 11:59pm
|
|
|
598 ;; is 1439 minutes. Therefore we must recalculate the minutes to
|
|
|
599 ;; appointment variable. It is equal to the number of minutes
|
|
|
600 ;; before midnight plus the number of minutes after midnight our
|
|
|
601 ;; appointment is.
|
|
|
602 ;;
|
|
|
603 ;; ## I don't think this does anything -- it would if it were
|
|
|
604 ;; (for example) a 12:01am appt on the list at 11:55pm, but that
|
|
|
605 ;; can't ever happen, because the applicable 12:01am appt is for
|
|
|
606 ;; tomorrow, not today, and we only have today's diary list.
|
|
|
607 ;; It's not simply a matter of concatenating two days together,
|
|
|
608 ;; either, because then tuesday's appts would be signalled on
|
|
|
609 ;; monday. We have to do a real one-day lookahead -- keep a list
|
|
|
610 ;; of tomorrow's appts, and check it when near midnight.
|
|
|
611 ;;
|
|
|
612 (if (and (< appt-comp-time (apply 'max appt-msg-countdown-list))
|
|
|
613 (> (+ cur-comp-time (apply 'max appt-msg-countdown-list))
|
|
|
614 max-time))
|
|
|
615 (setq min-to-app (+ (- (1+ max-time) cur-comp-time))
|
|
|
616 appt-comp-time))
|
|
|
617 ;;
|
|
|
618 ;; issue warning if the appointment time is within warning-time
|
|
|
619 (cond
|
|
|
620 ;; if there should not be any notifications in the mode-line,
|
|
|
621 ;; clear it.
|
|
|
622 ((> min-to-app (apply 'max appt-msg-countdown-list))
|
|
|
623 (appt-display-mode-line nil))
|
|
|
624 ;; do nothing if this is the second time this minute we've
|
|
|
625 ;; gotten here, of if we shouldn't be notifying right now.
|
|
|
626 ((or shut-up-this-time
|
|
|
627 (and (not (= min-to-app 0))
|
|
|
628 (not (memq min-to-app appt-msg-countdown-list))))
|
|
|
629 nil)
|
|
|
630
|
|
|
631 ((and (= min-to-app 0)
|
|
|
632 (string-match "%%(" (nth 1 (car appt-time-msg-list))))
|
|
|
633 ;;
|
|
|
634 ;; If this is a magic evaluating-notification, evaluate it.
|
|
|
635 ;; these kinds of notifications aren't subject to the
|
|
|
636 ;; appt-msg-countdown-list.
|
|
|
637 ;;
|
|
|
638 (let* ((list-string (substring (nth 1 (car appt-time-msg-list))
|
|
|
639 (1- (match-end 0))))
|
|
|
640 (form (condition-case ()
|
|
|
641 (read list-string)
|
|
|
642 (error
|
|
|
643 (ding)
|
|
|
644 (message "Appt: error reading from \"%s\""
|
|
|
645 (nth 1 (car appt-time-msg-list)))
|
|
|
646 (sit-for 2)
|
|
|
647 nil))))
|
|
|
648 (eval form)))
|
|
|
649
|
|
|
650 ((and (<= min-to-app (apply 'max appt-msg-countdown-list))
|
|
|
651 (>= min-to-app 0))
|
|
|
652 ;;
|
|
|
653 ;; produce a notification.
|
|
|
654 (appt-beep (= min-to-app 0))
|
|
|
655 (funcall appt-announce-method min-to-app
|
|
|
656 (car appt-time-msg-list))
|
|
|
657 ;; update mode line and expire if necessary
|
|
|
658 (appt-display-mode-line min-to-app)
|
|
|
659 ;; if it's expired, remove it.
|
|
|
660 (if (= min-to-app 0)
|
|
|
661 (setq appt-time-msg-list (cdr appt-time-msg-list))))
|
|
|
662 (t
|
|
|
663 ;; else we're not near any appointment, or there are no
|
|
|
664 ;; apointments; make sure mode line is clear.
|
|
|
665 (appt-display-mode-line nil))))
|
|
|
666 (appt-display-mode-line nil))))))
|
|
|
667
|
|
|
668
|
|
|
669
|
|
|
670 ;;; Interactively adding and deleting appointments
|
|
|
671
|
|
|
672 (defun appt-add (new-appt-time new-appt-msg)
|
|
|
673 "Adds an appointment to the list of appointments for the day at TIME
|
|
|
674 and issue MESSAGE. The time should be in either 24 hour format or
|
|
|
675 am/pm format. "
|
|
|
676
|
|
|
677 (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
|
|
|
678 (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
|
|
|
679 nil
|
|
|
680 (error "Unacceptable time-string"))
|
|
|
681
|
|
|
682 (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
|
|
|
683 (appt-time (list (appt-convert-time new-appt-time)))
|
|
|
684 (time-msg (cons appt-time (list appt-time-string))))
|
|
|
685 (setq appt-time-msg-list (append appt-time-msg-list
|
|
|
686 (list time-msg)))
|
|
|
687 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))))
|
|
|
688
|
|
|
689 (defun appt-delete ()
|
|
|
690 "Deletes an appointment from the list of appointments."
|
|
|
691 (interactive)
|
|
|
692 (let* ((tmp-msg-list appt-time-msg-list))
|
|
|
693 (while tmp-msg-list
|
|
|
694 (let* ((element (car tmp-msg-list))
|
|
|
695 (prompt-string (concat "Delete "
|
|
|
696 (prin1-to-string (car (cdr element)))
|
|
|
697 " from list? "))
|
|
|
698 (test-input (y-or-n-p prompt-string)))
|
|
|
699 (setq tmp-msg-list (cdr tmp-msg-list))
|
|
|
700 (if test-input
|
|
|
701 (setq appt-time-msg-list (delq element appt-time-msg-list)))))
|
|
|
702 (message "")))
|
|
|
703
|
|
|
704
|
|
|
705 ;;; Patching in to existing time code to install our hook.
|
|
|
706
|
|
|
707
|
|
|
708 (defvar display-time-hook-installed nil)
|
|
|
709
|
|
|
710 (defun install-display-time-hook ()
|
|
118
|
711 (unless display-time-hook-installed ; only do this stuff once!
|
|
|
712 (unless (boundp 'display-time-hook) ; Need to wrapper it.
|
|
|
713 (defvar display-time-hook nil
|
|
|
714 "*List of functions to be called when the time is updated on the mode line.")
|
|
|
715 (let ((old-fn (if (or (featurep 'reportmail)
|
|
|
716 ;; old reportmail without a provide statement
|
|
|
717 (and (fboundp 'display-time-filter-18-55)
|
|
|
718 (fboundp 'display-time-filter-18-57)))
|
|
|
719 (if (and (featurep 'itimer) ; XEmacs reportmail.el
|
|
|
720 (fboundp 'display-time-timer-function))
|
|
|
721 'display-time-timer-function
|
|
|
722 ;; older reportmail, or no timer.el.
|
|
|
723 (if (string-match "18\\.5[0-5]" (emacs-version))
|
|
|
724 'display-time-filter-18-55
|
|
|
725 'display-time-filter-18-57))
|
|
|
726 ;; othewise, time.el
|
|
|
727 (if (and (featurep 'itimer)
|
|
|
728 (fboundp 'display-time-function)) ; XEmacs
|
|
|
729 'display-time-function
|
|
|
730 'display-time-filter))))
|
|
0
|
731 ;; we're about to redefine it...
|
|
118
|
732 (fset 'old-display-time-filter (symbol-function old-fn))
|
|
|
733 (fset old-fn
|
|
124
|
734 (lambda (&rest args) ;; ...here's the revised definition
|
|
|
735 "Revised version of the original function: this version calls a hook."
|
|
|
736 (apply 'old-display-time-filter args)
|
|
|
737 (run-hooks 'display-time-hook)))))
|
|
118
|
738 (setq display-time-hook-installed t)
|
|
|
739 (if (fboundp 'add-hook)
|
|
|
740 (add-hook 'display-time-hook 'appt-check)
|
|
|
741 (setq display-time-hook (cons appt-check display-time-hook)))
|
|
|
742 ))
|
|
0
|
743
|
|
|
744 (provide 'appt)
|
