Mercurial > emacs
comparison lisp/calendar/appt.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
comparison
equal
deleted
inserted
replaced
88154:8ce476d3ba36 | 88155:d7ddb3e565de |
---|---|
1 ;;; appt.el --- appointment notification functions | 1 ;;; appt.el --- appointment notification functions |
2 | 2 |
3 ;; Copyright (C) 1989, 1990, 1994, 1998 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1989, 1990, 1994, 1998, 2001, 2002, 2003, 2004, 2005 |
4 ;; Free Software Foundation, Inc. | |
4 | 5 |
5 ;; Author: Neil Mager <neilm@juliet.ll.mit.edu> | 6 ;; Author: Neil Mager <neilm@juliet.ll.mit.edu> |
6 ;; Maintainer: FSF | 7 ;; Maintainer: Glenn Morris <rgm@gnu.org> |
7 ;; Keywords: calendar | 8 ;; Keywords: calendar |
8 | 9 |
9 ;; This file is part of GNU Emacs. | 10 ;; This file is part of GNU Emacs. |
10 | 11 |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | 12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
19 ;; GNU General Public License for more details. | 20 ;; GNU General Public License for more details. |
20 | 21 |
21 ;; You should have received a copy of the GNU General Public License | 22 ;; You should have received a copy of the GNU General Public License |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | 23 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 ;; Boston, MA 02111-1307, USA. | 25 ;; Boston, MA 02110-1301, USA. |
25 | 26 |
26 ;;; Commentary: | 27 ;;; Commentary: |
27 | 28 |
28 ;; | 29 ;; |
29 ;; appt.el - visible and/or audible notification of | 30 ;; appt.el - visible and/or audible notification of |
30 ;; appointments from ~/diary file. | 31 ;; appointments from diary file. |
31 ;; | 32 ;; |
32 ;;; | 33 ;;; |
33 ;;; Thanks to Edward M. Reingold for much help and many suggestions, | 34 ;;; Thanks to Edward M. Reingold for much help and many suggestions, |
34 ;;; And to many others for bug fixes and suggestions. | 35 ;;; And to many others for bug fixes and suggestions. |
35 ;;; | 36 ;;; |
36 ;;; | 37 ;;; |
37 ;;; This functions in this file will alert the user of a | 38 ;;; This functions in this file will alert the user of a |
38 ;;; pending appointment based on their diary file. | 39 ;;; pending appointment based on his/her diary file. This package |
39 ;;; | 40 ;;; is documented in the Emacs manual. |
40 ;;; A message will be displayed in the mode line of the Emacs buffer | 41 ;;; |
41 ;;; and (if you request) the terminal will beep and display a message | 42 ;;; To activate this package, simply use (appt-activate 1). |
42 ;;; from the diary in the mini-buffer, or you can choose to | 43 ;;; A `diary-file' with appointments of the format described in the |
43 ;;; have a message displayed in a new buffer. | 44 ;;; documentation of the function `appt-check' is required. |
44 ;;; | 45 ;;; Relevant customizable variables are also listed in the |
45 ;;; The variable `appt-message-warning-time' allows the | 46 ;;; documentation of that function. |
46 ;;; user to specify how much notice they want before the appointment. The | 47 ;;; |
47 ;;; variable `appt-issue-message' specifies whether the user wants | 48 ;;; Today's appointment list is initialized from the diary when this |
48 ;;; to be notified of a pending appointment. | 49 ;;; package is activated. Additionally, the appointments list is |
49 ;;; | 50 ;;; recreated automatically at 12:01am for those who do not logout |
50 ;;; In order to use the appt package, you only need | 51 ;;; every day or are programming late. It is also updated when the |
51 ;;; to load it---provided you have appointments. | 52 ;;; `diary-file' is saved. Calling `appt-check' with an argument forces |
52 ;;; | 53 ;;; a re-initialization at any time. |
53 ;;; Before that, you can also set some options if you want | 54 ;;; |
54 ;;; (setq view-diary-entries-initially t) | 55 ;;; In order to add or delete items from today's list, without |
55 ;;; (setq appt-issue-message t) | 56 ;;; changing the diary file, use `appt-add' and `appt-delete'. |
56 ;;; | 57 ;;; |
57 ;;; This is an example of what can be in your diary file: | 58 |
58 ;;; Monday | |
59 ;;; 9:30am Coffee break | |
60 ;;; 12:00pm Lunch | |
61 ;;; | |
62 ;;; Based upon the above lines in your .emacs and diary files, | |
63 ;;; the calendar and diary will be displayed when you enter | |
64 ;;; Emacs and your appointments list will automatically be created. | |
65 ;;; You will then be reminded at 9:20am about your coffee break | |
66 ;;; and at 11:50am to go to lunch. | |
67 ;;; | |
68 ;;; Use describe-function on appt-check for a description of other variables | |
69 ;;; that can be used to personalize the notification system. | |
70 ;;; | |
71 ;;; In order to add or delete items from todays list, use appt-add | |
72 ;;; and appt-delete. | |
73 ;;; | |
74 ;;; Additionally, the appointments list is recreated automatically | |
75 ;;; at 12:01am for those who do not logout every day or are programming | |
76 ;;; late. | |
77 ;;; | |
78 ;;; Brief internal description - Skip this if you are not interested! | 59 ;;; Brief internal description - Skip this if you are not interested! |
79 ;;; | 60 ;;; |
80 ;;; The function appt-make-list creates the appointments list which appt-check | 61 ;;; The function `appt-make-list' creates the appointments list which |
81 ;;; reads. This is all done automatically. | 62 ;;; `appt-check' reads. |
82 ;;; It is invoked from the function list-diary-entries. | |
83 ;;; | 63 ;;; |
84 ;;; You can change the way the appointment window is created/deleted by | 64 ;;; You can change the way the appointment window is created/deleted by |
85 ;;; setting the variables | 65 ;;; setting the variables |
86 ;;; | 66 ;;; |
87 ;;; appt-disp-window-function | 67 ;;; appt-disp-window-function |
88 ;;; and | 68 ;;; and |
89 ;;; appt-delete-window-function | 69 ;;; appt-delete-window-function |
90 ;;; | 70 ;;; |
91 ;;; For instance, these variables can be set to functions that display | 71 ;;; For instance, these variables could be set to functions that display |
92 ;;; appointments in pop-up frames, which are lowered or iconified after | 72 ;;; appointments in pop-up frames, which are lowered or iconified after |
93 ;;; appt-display-interval minutes. | 73 ;;; `appt-display-interval' minutes. |
94 ;;; | 74 ;;; |
95 | 75 |
96 ;;; Code: | 76 ;;; Code: |
97 | 77 |
98 ;; Make sure calendar is loaded when we compile this. | 78 ;; Make sure calendar is loaded when we compile this. |
99 (require 'calendar) | 79 (require 'calendar) |
100 | 80 |
101 (provide 'appt) | |
102 | 81 |
103 ;;;###autoload | 82 ;;;###autoload |
104 (defcustom appt-issue-message t | 83 (defcustom appt-issue-message t |
105 "*Non-nil means check for appointments in the diary buffer. | 84 "*Non-nil means check for appointments in the diary buffer. |
106 To be detected, the diary entry must have the time | 85 To be detected, the diary entry must have the format described in the |
107 as the first thing on a line." | 86 documentation of the function `appt-check'." |
108 :type 'boolean | 87 :type 'boolean |
109 :group 'appt) | 88 :group 'appt) |
89 | |
90 (make-obsolete-variable 'appt-issue-message | |
91 "use the function `appt-activate', and the \ | |
92 variable `appt-display-format' instead." "22.1") | |
110 | 93 |
111 ;;;###autoload | 94 ;;;###autoload |
112 (defcustom appt-message-warning-time 12 | 95 (defcustom appt-message-warning-time 12 |
113 "*Time in minutes before an appointment that the warning begins." | 96 "*Time in minutes before an appointment that the warning begins." |
114 :type 'integer | 97 :type 'integer |
120 :type 'boolean | 103 :type 'boolean |
121 :group 'appt) | 104 :group 'appt) |
122 | 105 |
123 ;;;###autoload | 106 ;;;###autoload |
124 (defcustom appt-visible t | 107 (defcustom appt-visible t |
125 "*Non-nil means display appointment message in echo area." | 108 "*Non-nil means display appointment message in echo area. |
109 This variable is only relevant if `appt-msg-window' is nil." | |
126 :type 'boolean | 110 :type 'boolean |
127 :group 'appt) | 111 :group 'appt) |
128 | 112 |
113 (make-obsolete-variable 'appt-visible 'appt-display-format "22.1") | |
114 | |
115 ;;;###autoload | |
116 (defcustom appt-msg-window t | |
117 "*Non-nil means display appointment message in another window. | |
118 If non-nil, this variable overrides `appt-visible'." | |
119 :type 'boolean | |
120 :group 'appt) | |
121 | |
122 (make-obsolete-variable 'appt-msg-window 'appt-display-format "22.1") | |
123 | |
124 ;; TODO - add popup. | |
125 (defcustom appt-display-format 'ignore | |
126 "How appointment reminders should be displayed. | |
127 The options are: | |
128 window - use a separate window | |
129 echo - use the echo area | |
130 nil - no visible reminder. | |
131 See also `appt-audible' and `appt-display-mode-line'. | |
132 | |
133 The default value is 'ignore, which means to fall back on the value | |
134 of the (obsolete) variables `appt-msg-window' and `appt-visible'." | |
135 :type '(choice | |
136 (const :tag "Separate window" window) | |
137 (const :tag "Echo-area" echo) | |
138 (const :tag "No visible display" nil)) | |
139 :group 'appt | |
140 :version "22.1") | |
141 | |
129 ;;;###autoload | 142 ;;;###autoload |
130 (defcustom appt-display-mode-line t | 143 (defcustom appt-display-mode-line t |
131 "*Non-nil means display minutes to appointment and time on the mode line." | 144 "*Non-nil means display minutes to appointment and time on the mode line. |
145 This is in addition to any other display of appointment messages." | |
132 :type 'boolean | 146 :type 'boolean |
133 :group 'appt) | 147 :group 'appt) |
134 | 148 |
135 ;;;###autoload | 149 ;;;###autoload |
136 (defcustom appt-msg-window t | |
137 "*Non-nil means display appointment message in another window." | |
138 :type 'boolean | |
139 :group 'appt) | |
140 | |
141 ;;;###autoload | |
142 (defcustom appt-display-duration 10 | 150 (defcustom appt-display-duration 10 |
143 "*The number of seconds an appointment message is displayed." | 151 "*The number of seconds an appointment message is displayed. |
152 Only relevant if reminders are to be displayed in their own window." | |
144 :type 'integer | 153 :type 'integer |
145 :group 'appt) | 154 :group 'appt) |
146 | 155 |
147 ;;;###autoload | 156 ;;;###autoload |
148 (defcustom appt-display-diary t | 157 (defcustom appt-display-diary t |
149 "*Non-nil means to display the next days diary on the screen. | 158 "*Non-nil displays the diary when the appointment list is first initialized. |
150 This will occur at midnight when the appointment list is updated." | 159 This will occur at midnight when the appointment list is updated." |
151 :type 'boolean | 160 :type 'boolean |
152 :group 'appt) | 161 :group 'appt) |
153 | |
154 (defvar appt-time-msg-list nil | |
155 "The list of appointments for today. | |
156 Use `appt-add' and `appt-delete' to add and delete appointments from list. | |
157 The original list is generated from the today's `diary-entries-list'. | |
158 The number before each time/message is the time in minutes from midnight.") | |
159 | |
160 (defconst appt-max-time 1439 | |
161 "11:59pm in minutes - number of minutes in a day minus 1.") | |
162 | 162 |
163 (defcustom appt-display-interval 3 | 163 (defcustom appt-display-interval 3 |
164 "*Number of minutes to wait between checking the appointment list." | 164 "*Number of minutes to wait between checking the appointment list." |
165 :type 'integer | 165 :type 'integer |
166 :group 'appt) | 166 :group 'appt) |
167 | 167 |
168 (defvar appt-buffer-name " *appt-buf*" | 168 (defcustom appt-disp-window-function 'appt-disp-window |
169 "Function called to display appointment window. | |
170 Only relevant if reminders are being displayed in a window." | |
171 :type '(choice (const appt-disp-window) | |
172 function) | |
173 :group 'appt) | |
174 | |
175 (defcustom appt-delete-window-function 'appt-delete-window | |
176 "Function called to remove appointment window and buffer. | |
177 Only relevant if reminders are being displayed in a window." | |
178 :type '(choice (const appt-delete-window) | |
179 function) | |
180 :group 'appt) | |
181 | |
182 | |
183 ;;; Internal variables below this point. | |
184 | |
185 (defconst appt-buffer-name " *appt-buf*" | |
169 "Name of the appointments buffer.") | 186 "Name of the appointments buffer.") |
170 | 187 |
171 (defvar appt-disp-window-function 'appt-disp-window | 188 (defvar appt-time-msg-list nil |
172 "Function called to display appointment window.") | 189 "The list of appointments for today. |
173 | 190 Use `appt-add' and `appt-delete' to add and delete appointments. |
174 (defvar appt-delete-window-function 'appt-delete-window | 191 The original list is generated from today's `diary-entries-list', and |
175 "Function called to remove appointment window and buffer.") | 192 can be regenerated using the function `appt-check'. |
193 Each element of the generated list has the form (MINUTES STRING [FLAG]); where | |
194 MINUTES is the time in minutes of the appointment after midnight, and | |
195 STRING is the description of the appointment. | |
196 FLAG, if non-nil, says that the element was made with `appt-add' | |
197 so calling `appt-make-list' again should preserve it.") | |
198 | |
199 (defconst appt-max-time (1- (* 24 60)) | |
200 "11:59pm in minutes - number of minutes in a day minus 1.") | |
176 | 201 |
177 (defvar appt-mode-string nil | 202 (defvar appt-mode-string nil |
178 "String being displayed in the mode line saying you have an appointment. | 203 "String being displayed in the mode line saying you have an appointment. |
179 The actual string includes the amount of time till the appointment.") | 204 The actual string includes the amount of time till the appointment. |
205 Only used if `appt-display-mode-line' is non-nil.") | |
180 | 206 |
181 (defvar appt-prev-comp-time nil | 207 (defvar appt-prev-comp-time nil |
182 "Time of day (mins since midnight) at which we last checked appointments.") | 208 "Time of day (mins since midnight) at which we last checked appointments. |
209 A nil value forces the diary file to be (re-)checked for appointments.") | |
183 | 210 |
184 (defvar appt-now-displayed nil | 211 (defvar appt-now-displayed nil |
185 "Non-nil when we have started notifying about a appointment that is near.") | 212 "Non-nil when we have started notifying about a appointment that is near.") |
186 | 213 |
187 (defvar appt-display-count nil) | 214 (defvar appt-display-count nil |
188 | 215 "Internal variable used to count number of consecutive reminders.") |
189 (defun appt-check () | 216 |
190 "Check for an appointment and update the mode line. | 217 (defvar appt-timer nil |
218 "Timer used for diary appointment notifications (`appt-check'). | |
219 If this is non-nil, appointment checking is active.") | |
220 | |
221 | |
222 ;;; Functions. | |
223 | |
224 (defun appt-display-message (string mins) | |
225 "Display a reminder about an appointment. | |
226 The string STRING describes the appointment, due in integer MINS minutes. | |
227 The format of the visible reminder is controlled by `appt-display-format'. | |
228 The variable `appt-audible' controls the audible reminder." | |
229 ;; let binding for backwards compatability. Remove when obsolete | |
230 ;; vars appt-msg-window and appt-visible are dropped. | |
231 (let ((appt-display-format | |
232 (if (eq appt-display-format 'ignore) | |
233 (cond (appt-msg-window 'window) | |
234 (appt-visible 'echo)) | |
235 appt-display-format))) | |
236 (cond ((eq appt-display-format 'window) | |
237 (funcall appt-disp-window-function | |
238 (number-to-string mins) | |
239 ;; TODO - use calendar-month-abbrev-array rather | |
240 ;; than %b? | |
241 (format-time-string "%a %b %e " (current-time)) | |
242 string) | |
243 (run-at-time (format "%d sec" appt-display-duration) | |
244 nil | |
245 appt-delete-window-function)) | |
246 ((eq appt-display-format 'echo) | |
247 (message "%s" string))) | |
248 (if appt-audible (beep 1)))) | |
249 | |
250 | |
251 (defun appt-check (&optional force) | |
252 "Check for an appointment and update any reminder display. | |
253 If optional argument FORCE is non-nil, reparse the diary file for | |
254 appointments. Otherwise the diary file is only parsed once per day, | |
255 and when saved. | |
256 | |
191 Note: the time must be the first thing in the line in the diary | 257 Note: the time must be the first thing in the line in the diary |
192 for a warning to be issued. | 258 for a warning to be issued. The format of the time can be either |
193 | 259 24 hour or am/pm. For example: |
194 The format of the time can be either 24 hour or am/pm. | 260 |
195 Example: | 261 02/23/89 |
196 | 262 18:00 Dinner |
197 02/23/89 | |
198 18:00 Dinner | |
199 | 263 |
200 Thursday | 264 Thursday |
201 11:45am Lunch meeting. | 265 11:45am Lunch meeting. |
202 | 266 |
203 Appointments are checked every `appt-display-interval' minutes. | 267 Appointments are checked every `appt-display-interval' minutes. |
204 The following variables control appointment notification: | 268 The following variables control appointment notification: |
205 | 269 |
206 `appt-issue-message' | 270 `appt-display-format' |
207 If t, the diary buffer is checked for appointments. | 271 Controls the format in which reminders are displayed. |
272 | |
273 `appt-audible' | |
274 Variable used to determine if reminder is audible. | |
275 Default is t. | |
208 | 276 |
209 `appt-message-warning-time' | 277 `appt-message-warning-time' |
210 Variable used to determine if appointment message | 278 Variable used to determine when appointment message |
211 should be displayed. | 279 should first be displayed. |
212 | 280 |
213 `appt-audible' | 281 `appt-display-mode-line' |
214 Variable used to determine if appointment is audible. | 282 If non-nil, a generic message giving the time remaining |
215 Default is t. | 283 is shown in the mode-line when an appointment is due. |
216 | 284 |
217 `appt-visible' | 285 `appt-display-interval' |
218 Variable used to determine if appointment message should be | 286 Interval in minutes at which to check for pending appointments. |
219 displayed in the mini-buffer. Default is t. | 287 |
220 | 288 `appt-display-diary' |
221 `appt-msg-window' | 289 Display the diary buffer when the appointment list is |
222 Variable used to determine if appointment message | 290 initialized for the first time in a day. |
223 should temporarily appear in another window. Mutually exclusive | 291 |
224 to `appt-visible'. | 292 The following variables are only relevant if reminders are being |
293 displayed in a window: | |
225 | 294 |
226 `appt-display-duration' | 295 `appt-display-duration' |
227 The number of seconds an appointment message | 296 The number of seconds an appointment message is displayed. |
228 is displayed in another window. | |
229 | 297 |
230 `appt-disp-window-function' | 298 `appt-disp-window-function' |
231 Function called to display appointment window. You can customize | 299 Function called to display appointment window. |
232 appt.el by setting this variable to a function different from the | |
233 one provided with this package. | |
234 | 300 |
235 `appt-delete-window-function' | 301 `appt-delete-window-function' |
236 Function called to remove appointment window and buffer. You can | 302 Function called to remove appointment window and buffer." |
237 customize appt.el by setting this variable to a function different | |
238 from the one provided with this package." | |
239 | 303 |
240 (let* ((min-to-app -1) | 304 (let* ((min-to-app -1) |
241 (new-time "") | |
242 (prev-appt-mode-string appt-mode-string) | 305 (prev-appt-mode-string appt-mode-string) |
243 (prev-appt-display-count (or appt-display-count 0)) | 306 (prev-appt-display-count (or appt-display-count 0)) |
244 ;; Non-nil means do a full check for pending appointments | 307 ;; Non-nil means do a full check for pending appointments |
245 ;; and display in whatever ways the user has selected. | 308 ;; and display in whatever ways the user has selected. |
246 ;; When no appointment is being displayed, | 309 ;; When no appointment is being displayed, |
247 ;; we always do a full check. | 310 ;; we always do a full check. |
248 (full-check | 311 (full-check |
249 (or (not appt-now-displayed) | 312 (or (not appt-now-displayed) |
250 ;; This is true every appt-display-interval minutes. | 313 ;; This is true every appt-display-interval minutes. |
251 (= 0 (mod prev-appt-display-count appt-display-interval)))) | 314 (zerop (mod prev-appt-display-count appt-display-interval)))) |
252 ;; Non-nil means only update the interval displayed in the mode line. | 315 ;; Non-nil means only update the interval displayed in the mode line. |
253 (mode-line-only | 316 (mode-line-only |
254 (and (not full-check) appt-now-displayed))) | 317 (and (not full-check) appt-now-displayed))) |
255 | 318 |
256 (when (or full-check mode-line-only) | 319 (when (or full-check mode-line-only) |
265 (cur-comp-time (+ (* cur-hour 60) cur-min))) | 328 (cur-comp-time (+ (* cur-hour 60) cur-min))) |
266 | 329 |
267 ;; At the first check in any given day, update our | 330 ;; At the first check in any given day, update our |
268 ;; appointments to today's list. | 331 ;; appointments to today's list. |
269 | 332 |
270 (if (or (null appt-prev-comp-time) | 333 (if (or force ; eg initialize, diary save |
271 (< cur-comp-time appt-prev-comp-time)) | 334 (null appt-prev-comp-time) ; first check |
335 (< cur-comp-time appt-prev-comp-time)) ; new day | |
272 (condition-case nil | 336 (condition-case nil |
273 (progn | 337 (if appt-display-diary |
274 (if (and view-diary-entries-initially appt-display-diary) | 338 (let ((diary-hook |
275 (diary) | 339 (if (assoc 'appt-make-list diary-hook) |
276 (let ((diary-display-hook 'appt-make-list)) | 340 diary-hook |
277 (diary)))) | 341 (cons 'appt-make-list diary-hook)))) |
342 (diary)) | |
343 (let* ((diary-display-hook 'appt-make-list) | |
344 (d-buff (find-buffer-visiting | |
345 (substitute-in-file-name diary-file))) | |
346 (selective | |
347 (if d-buff ; Diary buffer exists. | |
348 (with-current-buffer d-buff | |
349 diary-selective-display)))) | |
350 (diary) | |
351 ;; If the diary buffer existed before this command, | |
352 ;; restore its display state. Otherwise, kill it. | |
353 (if d-buff | |
354 ;; Displays the diary buffer. | |
355 (or selective (show-all-diary-entries)) | |
356 (and | |
357 (setq d-buff (find-buffer-visiting | |
358 (substitute-in-file-name diary-file))) | |
359 (kill-buffer d-buff))))) | |
278 (error nil))) | 360 (error nil))) |
279 (setq appt-prev-comp-time cur-comp-time) | 361 |
280 | 362 (setq appt-prev-comp-time cur-comp-time |
281 (setq appt-mode-string nil) | 363 appt-mode-string nil |
282 (setq appt-display-count nil) | 364 appt-display-count nil) |
283 | 365 |
284 ;; If there are entries in the list, and the | 366 ;; If there are entries in the list, and the |
285 ;; user wants a message issued, | 367 ;; user wants a message issued, |
286 ;; get the first time off of the list | 368 ;; get the first time off of the list |
287 ;; and calculate the number of minutes until the appointment. | 369 ;; and calculate the number of minutes until the appointment. |
315 ;; issue warning if the appointment time is | 397 ;; issue warning if the appointment time is |
316 ;; within appt-message-warning time | 398 ;; within appt-message-warning time |
317 | 399 |
318 (when (and (<= min-to-app appt-message-warning-time) | 400 (when (and (<= min-to-app appt-message-warning-time) |
319 (>= min-to-app 0)) | 401 (>= min-to-app 0)) |
320 (setq appt-now-displayed t) | 402 (setq appt-now-displayed t |
321 (setq appt-display-count | 403 appt-display-count (1+ prev-appt-display-count)) |
322 (1+ prev-appt-display-count)) | |
323 (unless mode-line-only | 404 (unless mode-line-only |
324 (if appt-msg-window | 405 (appt-display-message (cadr (car appt-time-msg-list)) |
325 (progn | 406 min-to-app)) |
326 (setq new-time (format-time-string "%a %b %e " | |
327 (current-time))) | |
328 (funcall | |
329 appt-disp-window-function | |
330 (number-to-string min-to-app) new-time | |
331 (car (cdr (car appt-time-msg-list)))) | |
332 | |
333 (run-at-time | |
334 (format "%d sec" appt-display-duration) | |
335 nil | |
336 appt-delete-window-function)) | |
337 ;;; else | |
338 | |
339 (if appt-visible | |
340 (message "%s" | |
341 (car (cdr (car appt-time-msg-list))))) | |
342 | |
343 (if appt-audible | |
344 (beep 1)))) | |
345 | |
346 (when appt-display-mode-line | 407 (when appt-display-mode-line |
347 (setq appt-mode-string | 408 (setq appt-mode-string |
348 (concat " App't in " | 409 (format " App't in %s min." min-to-app))) |
349 (number-to-string min-to-app) | |
350 " min. "))) | |
351 | 410 |
352 ;; When an appointment is reached, | 411 ;; When an appointment is reached, |
353 ;; delete it from the list. | 412 ;; delete it from the list. |
354 ;; Reset the count to 0 in case we display another | 413 ;; Reset the count to 0 in case we display another |
355 ;; appointment on the next cycle. | 414 ;; appointment on the next cycle. |
356 (if (= min-to-app 0) | 415 (if (zerop min-to-app) |
357 (setq appt-time-msg-list | 416 (setq appt-time-msg-list (cdr appt-time-msg-list) |
358 (cdr appt-time-msg-list) | |
359 appt-display-count nil))))) | 417 appt-display-count nil))))) |
360 | 418 |
361 ;; If we have changed the mode line string, | 419 ;; If we have changed the mode line string, |
362 ;; redisplay all mode lines. | 420 ;; redisplay all mode lines. |
363 (and appt-display-mode-line | 421 (and appt-display-mode-line |
370 (if appt-mode-string | 428 (if appt-mode-string |
371 (sit-for 0))))))))) | 429 (sit-for 0))))))))) |
372 | 430 |
373 | 431 |
374 (defun appt-disp-window (min-to-app new-time appt-msg) | 432 (defun appt-disp-window (min-to-app new-time appt-msg) |
375 "Display appointment message APPT-MSG in a separate buffer." | 433 "Display appointment message APPT-MSG in a separate buffer. |
434 The appointment is due in MIN-TO-APP (a string) minutes. | |
435 NEW-TIME is a string giving the date." | |
376 (require 'electric) | 436 (require 'electric) |
377 | 437 |
378 ;; Make sure we're not in the minibuffer | 438 ;; Make sure we're not in the minibuffer |
379 ;; before splitting the window. | 439 ;; before splitting the window. |
380 | 440 |
382 (if (other-window 1) | 442 (if (other-window 1) |
383 (select-window (other-window 1)) | 443 (select-window (other-window 1)) |
384 (if (display-multi-frame-p) | 444 (if (display-multi-frame-p) |
385 (select-frame (other-frame 1))))) | 445 (select-frame (other-frame 1))))) |
386 | 446 |
387 (let* ((this-buffer (current-buffer)) | 447 (let ((this-window (selected-window)) |
388 (this-window (selected-window)) | 448 (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name)))) |
389 (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name)))) | |
390 | 449 |
391 (if (cdr (assq 'unsplittable (frame-parameters))) | 450 (if (cdr (assq 'unsplittable (frame-parameters))) |
392 ;; In an unsplittable frame, use something somewhere else. | 451 ;; In an unsplittable frame, use something somewhere else. |
393 (display-buffer appt-disp-buf) | 452 (display-buffer appt-disp-buf) |
394 (unless (or (special-display-p (buffer-name appt-disp-buf)) | 453 (unless (or (special-display-p (buffer-name appt-disp-buf)) |
395 (same-window-p (buffer-name appt-disp-buf))) | 454 (same-window-p (buffer-name appt-disp-buf))) |
396 ;; By default, split the bottom window and use the lower part. | 455 ;; By default, split the bottom window and use the lower part. |
397 (appt-select-lowest-window) | 456 (appt-select-lowest-window) |
398 (split-window)) | 457 (select-window (split-window))) |
399 (pop-to-buffer appt-disp-buf)) | 458 (switch-to-buffer appt-disp-buf)) |
400 (setq mode-line-format | 459 (calendar-set-mode-line |
401 (concat "-------------------- Appointment in " | 460 (format " Appointment in %s minutes. %s " min-to-app new-time)) |
402 min-to-app " minutes. " new-time " %-")) | |
403 (erase-buffer) | 461 (erase-buffer) |
404 (insert appt-msg) | 462 (insert appt-msg) |
405 (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t)) | 463 (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t)) |
406 (set-buffer-modified-p nil) | 464 (set-buffer-modified-p nil) |
407 (raise-frame (selected-frame)) | 465 (raise-frame (selected-frame)) |
408 (select-window this-window) | 466 (select-window this-window))) |
409 (if appt-audible | |
410 (beep 1)))) | |
411 | 467 |
412 (defun appt-delete-window () | 468 (defun appt-delete-window () |
413 "Function called to undisplay appointment messages. | 469 "Function called to undisplay appointment messages. |
414 Usually just deletes the appointment buffer." | 470 Usually just deletes the appointment buffer." |
415 (let ((window (get-buffer-window appt-buffer-name t))) | 471 (let ((window (get-buffer-window appt-buffer-name t))) |
429 (when (< bottom-edge next-bottom-edge) | 485 (when (< bottom-edge next-bottom-edge) |
430 (setq bottom-edge next-bottom-edge | 486 (setq bottom-edge next-bottom-edge |
431 lowest-window w))))) | 487 lowest-window w))))) |
432 (select-window lowest-window))) | 488 (select-window lowest-window))) |
433 | 489 |
490 (defconst appt-time-regexp | |
491 "[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?") | |
492 | |
434 ;;;###autoload | 493 ;;;###autoload |
435 (defun appt-add (new-appt-time new-appt-msg) | 494 (defun appt-add (new-appt-time new-appt-msg) |
436 "Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG. | 495 "Add an appointment for today at NEW-APPT-TIME with message NEW-APPT-MSG. |
437 The time should be in either 24 hour format or am/pm format." | 496 The time should be in either 24 hour format or am/pm format." |
438 | |
439 (interactive "sTime (hh:mm[am/pm]): \nsMessage: ") | 497 (interactive "sTime (hh:mm[am/pm]): \nsMessage: ") |
440 (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time) | 498 (unless (string-match appt-time-regexp new-appt-time) |
441 nil | |
442 (error "Unacceptable time-string")) | 499 (error "Unacceptable time-string")) |
443 | |
444 (let* ((appt-time-string (concat new-appt-time " " new-appt-msg)) | 500 (let* ((appt-time-string (concat new-appt-time " " new-appt-msg)) |
445 (appt-time (list (appt-convert-time new-appt-time))) | 501 (appt-time (list (appt-convert-time new-appt-time))) |
446 (time-msg (cons appt-time (list appt-time-string)))) | 502 (time-msg (list appt-time appt-time-string t))) |
447 (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg))) | 503 (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg))) |
448 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) | 504 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) |
449 | 505 |
450 ;;;###autoload | 506 ;;;###autoload |
451 (defun appt-delete () | 507 (defun appt-delete () |
452 "Delete an appointment from the list of appointments." | 508 "Delete an appointment from the list of appointments." |
453 (interactive) | 509 (interactive) |
454 (let* ((tmp-msg-list appt-time-msg-list)) | 510 (let ((tmp-msg-list appt-time-msg-list)) |
455 (while tmp-msg-list | 511 (while tmp-msg-list |
456 (let* ((element (car tmp-msg-list)) | 512 (let* ((element (car tmp-msg-list)) |
457 (prompt-string (concat "Delete " | 513 (prompt-string (concat "Delete " |
458 ;; We want to quote any doublequotes | 514 ;; We want to quote any doublequotes |
459 ;; in the string, as well as put | 515 ;; in the string, as well as put |
473 (eval-when-compile (defvar number) | 529 (eval-when-compile (defvar number) |
474 (defvar original-date) | 530 (defvar original-date) |
475 (defvar diary-entries-list)) | 531 (defvar diary-entries-list)) |
476 ;;;###autoload | 532 ;;;###autoload |
477 (defun appt-make-list () | 533 (defun appt-make-list () |
478 "Create the appointments list from todays diary buffer. | 534 "Update the appointments list from today's diary buffer. |
479 The time must be at the beginning of a line for it to be | 535 The time must be at the beginning of a line for it to be |
480 put in the appointments list. | 536 put in the appointments list (see examples in documentation of |
481 02/23/89 | 537 the function `appt-check'). We assume that the variables DATE and |
482 12:00pm lunch | 538 NUMBER hold the arguments that `list-diary-entries' received. |
483 Wednesday | 539 They specify the range of dates that the diary is being processed for. |
484 10:00am group meeting | 540 |
485 We assume that the variables DATE and NUMBER | 541 Any appointments made with `appt-add' are not affected by this |
486 hold the arguments that `list-diary-entries' received. | 542 function. |
487 They specify the range of dates that the diary is being processed for." | 543 |
488 | 544 For backwards compatibility, this function activates the |
489 ;; We have something to do if the range of dates that the diary is | 545 appointment package (if it is not already active)." |
490 ;; considering includes the current date. | 546 ;; See comments above appt-activate defun. |
491 (if (and (not (calendar-date-compare | 547 (if (not appt-timer) |
492 (list (calendar-current-date)) | 548 (appt-activate 1) |
493 (list original-date))) | 549 ;; We have something to do if the range of dates that the diary is |
494 (calendar-date-compare | 550 ;; considering includes the current date. |
495 (list (calendar-current-date)) | 551 (if (and (not (calendar-date-compare |
496 (list (calendar-gregorian-from-absolute | 552 (list (calendar-current-date)) |
497 (+ (calendar-absolute-from-gregorian original-date) | 553 (list original-date))) |
498 number))))) | 554 (calendar-date-compare |
499 (save-excursion | 555 (list (calendar-current-date)) |
500 ;; Clear the appointments list, then fill it in from the diary. | 556 (list (calendar-gregorian-from-absolute |
501 (setq appt-time-msg-list nil) | 557 (+ (calendar-absolute-from-gregorian original-date) |
502 (if diary-entries-list | 558 number))))) |
503 | 559 (save-excursion |
504 ;; Cycle through the entry-list (diary-entries-list) | 560 ;; Clear the appointments list, then fill it in from the diary. |
505 ;; looking for entries beginning with a time. If | 561 (dolist (elt appt-time-msg-list) |
506 ;; the entry begins with a time, add it to the | 562 ;; Delete any entries that were not made with appt-add. |
507 ;; appt-time-msg-list. Then sort the list. | 563 (unless (nth 2 elt) |
508 | 564 (setq appt-time-msg-list |
509 (let ((entry-list diary-entries-list) | 565 (delq elt appt-time-msg-list)))) |
510 (new-time-string "")) | 566 (if diary-entries-list |
511 ;; Skip diary entries for dates before today. | 567 |
512 (while (and entry-list | 568 ;; Cycle through the entry-list (diary-entries-list) |
513 (calendar-date-compare | 569 ;; looking for entries beginning with a time. If |
514 (car entry-list) (list (calendar-current-date)))) | 570 ;; the entry begins with a time, add it to the |
515 (setq entry-list (cdr entry-list))) | 571 ;; appt-time-msg-list. Then sort the list. |
516 ;; Parse the entries for today. | 572 |
517 (while (and entry-list | 573 (let ((entry-list diary-entries-list) |
518 (calendar-date-equal | 574 (new-time-string "")) |
519 (calendar-current-date) (car (car entry-list)))) | 575 ;; Skip diary entries for dates before today. |
520 (let ((time-string (cadr (car entry-list)))) | 576 (while (and entry-list |
521 (while (string-match | 577 (calendar-date-compare |
522 "\\([0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\).*" | 578 (car entry-list) (list (calendar-current-date)))) |
523 time-string) | 579 (setq entry-list (cdr entry-list))) |
524 (let* ((beg (match-beginning 0)) | 580 ;; Parse the entries for today. |
525 ;; Get just the time for this appointment. | 581 (while (and entry-list |
526 (only-time (match-string 1 time-string)) | 582 (calendar-date-equal |
527 ;; Find the end of this appointment | 583 (calendar-current-date) (car (car entry-list)))) |
528 ;; (the start of the next). | 584 (let ((time-string (cadr (car entry-list)))) |
529 (end (string-match | 585 (while (string-match appt-time-regexp time-string) |
530 "^[ \t]*[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" | 586 (let* ((beg (match-beginning 0)) |
531 time-string | 587 ;; Get just the time for this appointment. |
532 (match-end 0))) | 588 (only-time (match-string 0 time-string)) |
533 ;; Get the whole string for this appointment. | 589 ;; Find the end of this appointment |
534 (appt-time-string | 590 ;; (the start of the next). |
535 (substring time-string beg (if end (1- end))))) | 591 (end (string-match |
536 | 592 (concat "\n[ \t]*" appt-time-regexp) |
537 ;; Add this appointment to appt-time-msg-list. | 593 time-string |
538 (let* ((appt-time (list (appt-convert-time only-time))) | 594 (match-end 0))) |
539 (time-msg (list appt-time appt-time-string))) | 595 ;; Get the whole string for this appointment. |
540 (setq appt-time-msg-list | 596 (appt-time-string |
541 (nconc appt-time-msg-list (list time-msg)))) | 597 (substring time-string beg (if end (1- end))))) |
542 | 598 |
543 ;; Discard this appointment from the string. | 599 ;; Add this appointment to appt-time-msg-list. |
544 (setq time-string | 600 (let* ((appt-time (list (appt-convert-time only-time))) |
545 (if end (substring time-string end) ""))))) | 601 (time-msg (list appt-time appt-time-string))) |
546 (setq entry-list (cdr entry-list))))) | 602 (setq appt-time-msg-list |
547 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)) | 603 (nconc appt-time-msg-list (list time-msg)))) |
548 | 604 |
549 ;; Get the current time and convert it to minutes | 605 ;; Discard this appointment from the string. |
550 ;; from midnight. ie. 12:01am = 1, midnight = 0, | 606 (setq time-string |
551 ;; so that the elements in the list | 607 (if end (substring time-string end) ""))))) |
552 ;; that are earlier than the present time can | 608 (setq entry-list (cdr entry-list))))) |
553 ;; be removed. | 609 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)) |
554 | 610 |
555 (let* ((now (decode-time)) | 611 ;; Get the current time and convert it to minutes |
556 (cur-hour (nth 2 now)) | 612 ;; from midnight. ie. 12:01am = 1, midnight = 0, |
557 (cur-min (nth 1 now)) | 613 ;; so that the elements in the list |
558 (cur-comp-time (+ (* cur-hour 60) cur-min)) | 614 ;; that are earlier than the present time can |
559 (appt-comp-time (car (car (car appt-time-msg-list))))) | 615 ;; be removed. |
560 | 616 |
561 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) | 617 (let* ((now (decode-time)) |
562 (setq appt-time-msg-list (cdr appt-time-msg-list)) | 618 (cur-hour (nth 2 now)) |
563 (if appt-time-msg-list | 619 (cur-min (nth 1 now)) |
564 (setq appt-comp-time (car (car (car appt-time-msg-list)))))))))) | 620 (cur-comp-time (+ (* cur-hour 60) cur-min)) |
621 (appt-comp-time (car (caar appt-time-msg-list)))) | |
622 | |
623 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) | |
624 (setq appt-time-msg-list (cdr appt-time-msg-list)) | |
625 (if appt-time-msg-list | |
626 (setq appt-comp-time (car (caar appt-time-msg-list)))))))))) | |
565 | 627 |
566 | 628 |
567 (defun appt-sort-list (appt-list) | 629 (defun appt-sort-list (appt-list) |
568 "Simple sort to put the appointments list APPT-LIST in order. | 630 "Sort an appointment list, putting earlier items at the front. |
569 Scan the list for the smallest element left in the list. | 631 APPT-LIST is a list of the same format as `appt-time-msg-list'." |
570 Append the smallest element left into the new list, and remove | 632 (sort appt-list (lambda (e1 e2) (< (caar e1) (caar e2))))) |
571 it from the original list." | |
572 (let ((order-list nil)) | |
573 (while appt-list | |
574 (let* ((element (car appt-list)) | |
575 (element-time (car (car element))) | |
576 (tmp-list (cdr appt-list))) | |
577 (while tmp-list | |
578 (if (< element-time (car (car (car tmp-list)))) | |
579 nil | |
580 (setq element (car tmp-list)) | |
581 (setq element-time (car (car element)))) | |
582 (setq tmp-list (cdr tmp-list))) | |
583 (setq order-list (nconc order-list (list element))) | |
584 (setq appt-list (delq element appt-list)))) | |
585 order-list)) | |
586 | 633 |
587 | 634 |
588 (defun appt-convert-time (time2conv) | 635 (defun appt-convert-time (time2conv) |
589 "Convert hour:min[am/pm] format to minutes from midnight." | 636 "Convert hour:min[am/pm] format to minutes from midnight. |
590 | 637 A period (.) can be used instead of a colon (:) to separate the |
591 (let ((conv-time 0) | 638 hour and minute parts." |
592 (hr 0) | 639 ;; Formats that should be accepted: |
593 (min 0)) | 640 ;; 10:00 10.00 10h00 10h 10am 10:00am 10.00am |
594 | 641 (let ((min (if (string-match "[h:.]\\([0-9][0-9]\\)" time2conv) |
595 (string-match ":\\([0-9][0-9]\\)" time2conv) | 642 (string-to-number (match-string 1 time2conv)) |
596 (setq min (string-to-int | 643 0)) |
597 (match-string 1 time2conv))) | 644 (hr (if (string-match "[0-9]*[0-9]" time2conv) |
598 | 645 (string-to-number (match-string 0 time2conv)) |
599 (string-match "[0-9]?[0-9]:" time2conv) | 646 0))) |
600 (setq hr (string-to-int | |
601 (match-string 0 time2conv))) | |
602 | 647 |
603 ;; convert the time appointment time into 24 hour time | 648 ;; convert the time appointment time into 24 hour time |
604 | |
605 (cond ((and (string-match "pm" time2conv) (< hr 12)) | 649 (cond ((and (string-match "pm" time2conv) (< hr 12)) |
606 (setq hr (+ 12 hr))) | 650 (setq hr (+ 12 hr))) |
607 ((and (string-match "am" time2conv) (= hr 12)) | 651 ((and (string-match "am" time2conv) (= hr 12)) |
608 (setq hr 0))) | 652 (setq hr 0))) |
609 | 653 |
610 ;; convert the actual time | 654 ;; convert the actual time into minutes. |
611 ;; into minutes for comparison | 655 (+ (* hr 60) min))) |
612 ;; against the actual time. | 656 |
613 | 657 |
614 (setq conv-time (+ (* hr 60) min)) | 658 (defun appt-update-list () |
615 conv-time)) | 659 "If the current buffer is visiting the diary, update appointments. |
616 | 660 This function is intended for use with `write-file-functions'." |
617 (defvar appt-timer nil | 661 (and (string-equal buffer-file-name (expand-file-name diary-file)) |
618 "Timer used for diary appointment notifications (`appt-check').") | 662 appt-timer |
619 | 663 (let ((appt-display-diary nil)) |
620 (unless appt-timer | 664 (appt-check t))) |
621 (setq appt-timer (run-at-time t 60 'appt-check))) | 665 nil) |
622 | 666 |
623 (or global-mode-string (setq global-mode-string '(""))) | 667 |
624 (or (memq 'appt-mode-string global-mode-string) | 668 ;; In Emacs-21.3, the manual documented the following procedure to |
625 (setq global-mode-string | 669 ;; activate this package: |
626 (append global-mode-string '(appt-mode-string)))) | 670 ;; (display-time) |
627 | 671 ;; (add-hook 'diary-hook 'appt-make-list) |
672 ;; (diary 0) | |
673 ;; The display-time call was not necessary, AFAICS. | |
674 ;; What was really needed was to add the hook and load this file. | |
675 ;; Calling (diary 0) once the hook had been added was in some sense a | |
676 ;; roundabout way of loading this file. This file used to have code at | |
677 ;; the top-level that set up the appt-timer and global-mode-string. | |
678 ;; One way to maintain backwards compatibility would be to call | |
679 ;; (appt-activate 1) at top-level. However, this goes against the | |
680 ;; convention that just loading an Emacs package should not activate | |
681 ;; it. Instead, we make appt-make-list activate the package (after a | |
682 ;; suggestion from rms). This means that one has to call diary in | |
683 ;; order to get it to work, but that is in line with the old (weird, | |
684 ;; IMO) documented behavior for activating the package. | |
685 ;; Actually, since (diary 0) does not run diary-hook, I don't think | |
686 ;; the documented behavior in Emacs-21.3 would ever have worked. | |
687 ;; Oh well, at least with the changes to appt-make-list it will now | |
688 ;; work as well as it ever did. | |
689 ;; The new method is just to use (appt-activate 1). | |
690 ;; -- gmorris | |
691 | |
692 ;;;###autoload | |
693 (defun appt-activate (&optional arg) | |
694 "Toggle checking of appointments. | |
695 With optional numeric argument ARG, turn appointment checking on if | |
696 ARG is positive, otherwise off." | |
697 (interactive "P") | |
698 (let ((appt-active appt-timer)) | |
699 (setq appt-active (if arg (> (prefix-numeric-value arg) 0) | |
700 (not appt-active))) | |
701 (remove-hook 'write-file-functions 'appt-update-list) | |
702 (or global-mode-string (setq global-mode-string '(""))) | |
703 (delq 'appt-mode-string global-mode-string) | |
704 (when appt-timer | |
705 (cancel-timer appt-timer) | |
706 (setq appt-timer nil)) | |
707 (when appt-active | |
708 (add-hook 'write-file-functions 'appt-update-list) | |
709 (setq appt-timer (run-at-time t 60 'appt-check) | |
710 global-mode-string | |
711 (append global-mode-string '(appt-mode-string))) | |
712 (appt-check t)))) | |
713 | |
714 | |
715 (provide 'appt) | |
716 | |
717 ;; arch-tag: bf5791c4-8921-499e-a26f-772b1788d347 | |
628 ;;; appt.el ends here | 718 ;;; appt.el ends here |