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