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