| 1 |
|
|---|
| 2 |
|
|---|
| 3 |
|
|---|
| 4 |
|
|---|
| 5 |
|
|---|
| 6 |
|
|---|
| 7 |
|
|---|
| 8 |
|
|---|
| 9 |
|
|---|
| 10 |
|
|---|
| 11 |
|
|---|
| 12 |
|
|---|
| 13 |
|
|---|
| 14 |
|
|---|
| 15 |
|
|---|
| 16 |
|
|---|
| 17 |
|
|---|
| 18 |
|
|---|
| 19 |
|
|---|
| 20 |
|
|---|
| 21 |
|
|---|
| 22 |
|
|---|
| 23 |
|
|---|
| 24 |
|
|---|
| 25 |
|
|---|
| 26 |
|
|---|
| 27 |
|
|---|
| 28 |
|
|---|
| 29 |
|
|---|
| 30 |
|
|---|
| 31 |
|
|---|
| 32 |
|
|---|
| 33 |
|
|---|
| 34 |
|
|---|
| 35 |
|
|---|
| 36 |
|
|---|
| 37 |
|
|---|
| 38 |
|
|---|
| 39 |
|
|---|
| 40 |
|
|---|
| 41 |
|
|---|
| 42 |
|
|---|
| 43 |
|
|---|
| 44 |
|
|---|
| 45 |
|
|---|
| 46 |
|
|---|
| 47 |
|
|---|
| 48 |
|
|---|
| 49 |
|
|---|
| 50 |
|
|---|
| 51 |
|
|---|
| 52 |
|
|---|
| 53 |
|
|---|
| 54 |
|
|---|
| 55 |
|
|---|
| 56 |
|
|---|
| 57 |
|
|---|
| 58 |
|
|---|
| 59 |
|
|---|
| 60 |
|
|---|
| 61 |
|
|---|
| 62 |
|
|---|
| 63 |
|
|---|
| 64 |
|
|---|
| 65 |
|
|---|
| 66 |
|
|---|
| 67 |
|
|---|
| 68 |
|
|---|
| 69 |
|
|---|
| 70 |
|
|---|
| 71 |
|
|---|
| 72 |
|
|---|
| 73 |
|
|---|
| 74 |
|
|---|
| 75 |
|
|---|
| 76 |
|
|---|
| 77 |
|
|---|
| 78 |
|
|---|
| 79 |
(require 'calendar) |
|---|
| 80 |
|
|---|
| 81 |
(defvar diary-selective-display) |
|---|
| 82 |
|
|---|
| 83 |
|
|---|
| 84 |
(defcustom appt-issue-message t |
|---|
| 85 |
"*Non-nil means check for appointments in the diary buffer. |
|---|
| 86 |
To be detected, the diary entry must have the format described in the |
|---|
| 87 |
documentation of the function `appt-check'." |
|---|
| 88 |
:type 'boolean |
|---|
| 89 |
:group 'appt) |
|---|
| 90 |
|
|---|
| 91 |
(make-obsolete-variable 'appt-issue-message |
|---|
| 92 |
"use the function `appt-activate', and the \ |
|---|
| 93 |
variable `appt-display-format' instead." "22.1") |
|---|
| 94 |
|
|---|
| 95 |
|
|---|
| 96 |
(defcustom appt-message-warning-time 12 |
|---|
| 97 |
"*Time in minutes before an appointment that the warning begins." |
|---|
| 98 |
:type 'integer |
|---|
| 99 |
:group 'appt) |
|---|
| 100 |
|
|---|
| 101 |
|
|---|
| 102 |
(defcustom appt-audible t |
|---|
| 103 |
"*Non-nil means beep to indicate appointment." |
|---|
| 104 |
:type 'boolean |
|---|
| 105 |
:group 'appt) |
|---|
| 106 |
|
|---|
| 107 |
|
|---|
| 108 |
(defcustom appt-visible t |
|---|
| 109 |
"*Non-nil means display appointment message in echo area. |
|---|
| 110 |
This variable is only relevant if `appt-msg-window' is nil." |
|---|
| 111 |
:type 'boolean |
|---|
| 112 |
:group 'appt) |
|---|
| 113 |
|
|---|
| 114 |
(make-obsolete-variable 'appt-visible 'appt-display-format "22.1") |
|---|
| 115 |
|
|---|
| 116 |
|
|---|
| 117 |
(defcustom appt-msg-window t |
|---|
| 118 |
"*Non-nil means display appointment message in another window. |
|---|
| 119 |
If non-nil, this variable overrides `appt-visible'." |
|---|
| 120 |
:type 'boolean |
|---|
| 121 |
:group 'appt) |
|---|
| 122 |
|
|---|
| 123 |
(make-obsolete-variable 'appt-msg-window 'appt-display-format "22.1") |
|---|
| 124 |
|
|---|
| 125 |
|
|---|
| 126 |
(defcustom appt-display-format 'ignore |
|---|
| 127 |
"How appointment reminders should be displayed. |
|---|
| 128 |
The options are: |
|---|
| 129 |
window - use a separate window |
|---|
| 130 |
echo - use the echo area |
|---|
| 131 |
nil - no visible reminder. |
|---|
| 132 |
See also `appt-audible' and `appt-display-mode-line'. |
|---|
| 133 |
|
|---|
| 134 |
The default value is 'ignore, which means to fall back on the value |
|---|
| 135 |
of the (obsolete) variables `appt-msg-window' and `appt-visible'." |
|---|
| 136 |
:type '(choice |
|---|
| 137 |
(const :tag "Separate window" window) |
|---|
| 138 |
(const :tag "Echo-area" echo) |
|---|
| 139 |
(const :tag "No visible display" nil) |
|---|
| 140 |
(const :tag "Backwards compatibility setting - choose another value" |
|---|
| 141 |
ignore)) |
|---|
| 142 |
:group 'appt |
|---|
| 143 |
:version "22.1") |
|---|
| 144 |
|
|---|
| 145 |
|
|---|
| 146 |
(defcustom appt-display-mode-line t |
|---|
| 147 |
"*Non-nil means display minutes to appointment and time on the mode line. |
|---|
| 148 |
This is in addition to any other display of appointment messages." |
|---|
| 149 |
:type 'boolean |
|---|
| 150 |
:group 'appt) |
|---|
| 151 |
|
|---|
| 152 |
|
|---|
| 153 |
(defcustom appt-display-duration 10 |
|---|
| 154 |
"*The number of seconds an appointment message is displayed. |
|---|
| 155 |
Only relevant if reminders are to be displayed in their own window." |
|---|
| 156 |
:type 'integer |
|---|
| 157 |
:group 'appt) |
|---|
| 158 |
|
|---|
| 159 |
|
|---|
| 160 |
(defcustom appt-display-diary t |
|---|
| 161 |
"*Non-nil displays the diary when the appointment list is first initialized. |
|---|
| 162 |
This will occur at midnight when the appointment list is updated." |
|---|
| 163 |
:type 'boolean |
|---|
| 164 |
:group 'appt) |
|---|
| 165 |
|
|---|
| 166 |
(defcustom appt-display-interval 3 |
|---|
| 167 |
"*Number of minutes to wait between checking the appointment list." |
|---|
| 168 |
:type 'integer |
|---|
| 169 |
:group 'appt) |
|---|
| 170 |
|
|---|
| 171 |
(defcustom appt-disp-window-function 'appt-disp-window |
|---|
| 172 |
"Function called to display appointment window. |
|---|
| 173 |
Only relevant if reminders are being displayed in a window." |
|---|
| 174 |
:type '(choice (const appt-disp-window) |
|---|
| 175 |
function) |
|---|
| 176 |
:group 'appt) |
|---|
| 177 |
|
|---|
| 178 |
(defcustom appt-delete-window-function 'appt-delete-window |
|---|
| 179 |
"Function called to remove appointment window and buffer. |
|---|
| 180 |
Only relevant if reminders are being displayed in a window." |
|---|
| 181 |
:type '(choice (const appt-delete-window) |
|---|
| 182 |
function) |
|---|
| 183 |
:group 'appt) |
|---|
| 184 |
|
|---|
| 185 |
|
|---|
| 186 |
|
|---|
| 187 |
|
|---|
| 188 |
(defconst appt-buffer-name " *appt-buf*" |
|---|
| 189 |
"Name of the appointments buffer.") |
|---|
| 190 |
|
|---|
| 191 |
(defvar appt-time-msg-list nil |
|---|
| 192 |
"The list of appointments for today. |
|---|
| 193 |
Use `appt-add' and `appt-delete' to add and delete appointments. |
|---|
| 194 |
The original list is generated from today's `diary-entries-list', and |
|---|
| 195 |
can be regenerated using the function `appt-check'. |
|---|
| 196 |
Each element of the generated list has the form (MINUTES STRING [FLAG]); where |
|---|
| 197 |
MINUTES is the time in minutes of the appointment after midnight, and |
|---|
| 198 |
STRING is the description of the appointment. |
|---|
| 199 |
FLAG, if non-nil, says that the element was made with `appt-add' |
|---|
| 200 |
so calling `appt-make-list' again should preserve it.") |
|---|
| 201 |
|
|---|
| 202 |
(defconst appt-max-time (1- (* 24 60)) |
|---|
| 203 |
"11:59pm in minutes - number of minutes in a day minus 1.") |
|---|
| 204 |
|
|---|
| 205 |
(defvar appt-mode-string nil |
|---|
| 206 |
"String being displayed in the mode line saying you have an appointment. |
|---|
| 207 |
The actual string includes the amount of time till the appointment. |
|---|
| 208 |
Only used if `appt-display-mode-line' is non-nil.") |
|---|
| 209 |
|
|---|
| 210 |
(defvar appt-prev-comp-time nil |
|---|
| 211 |
"Time of day (mins since midnight) at which we last checked appointments. |
|---|
| 212 |
A nil value forces the diary file to be (re-)checked for appointments.") |
|---|
| 213 |
|
|---|
| 214 |
(defvar appt-now-displayed nil |
|---|
| 215 |
"Non-nil when we have started notifying about a appointment that is near.") |
|---|
| 216 |
|
|---|
| 217 |
(defvar appt-display-count nil |
|---|
| 218 |
"Internal variable used to count number of consecutive reminders.") |
|---|
| 219 |
|
|---|
| 220 |
(defvar appt-timer nil |
|---|
| 221 |
"Timer used for diary appointment notifications (`appt-check'). |
|---|
| 222 |
If this is non-nil, appointment checking is active.") |
|---|
| 223 |
|
|---|
| 224 |
|
|---|
| 225 |
|
|---|
| 226 |
|
|---|
| 227 |
(defun appt-display-message (string mins) |
|---|
| 228 |
"Display a reminder about an appointment. |
|---|
| 229 |
The string STRING describes the appointment, due in integer MINS minutes. |
|---|
| 230 |
The format of the visible reminder is controlled by `appt-display-format'. |
|---|
| 231 |
The variable `appt-audible' controls the audible reminder." |
|---|
| 232 |
|
|---|
| 233 |
|
|---|
| 234 |
(let ((appt-display-format |
|---|
| 235 |
(if (eq appt-display-format 'ignore) |
|---|
| 236 |
(cond (appt-msg-window 'window) |
|---|
| 237 |
(appt-visible 'echo)) |
|---|
| 238 |
appt-display-format))) |
|---|
| 239 |
(cond ((eq appt-display-format 'window) |
|---|
| 240 |
(funcall appt-disp-window-function |
|---|
| 241 |
(number-to-string mins) |
|---|
| 242 |
|
|---|
| 243 |
|
|---|
| 244 |
(format-time-string "%a %b %e " (current-time)) |
|---|
| 245 |
string) |
|---|
| 246 |
(run-at-time (format "%d sec" appt-display-duration) |
|---|
| 247 |
nil |
|---|
| 248 |
appt-delete-window-function)) |
|---|
| 249 |
((eq appt-display-format 'echo) |
|---|
| 250 |
(message "%s" string))) |
|---|
| 251 |
(if appt-audible (beep 1)))) |
|---|
| 252 |
|
|---|
| 253 |
|
|---|
| 254 |
(defun appt-check (&optional force) |
|---|
| 255 |
"Check for an appointment and update any reminder display. |
|---|
| 256 |
If optional argument FORCE is non-nil, reparse the diary file for |
|---|
| 257 |
appointments. Otherwise the diary file is only parsed once per day, |
|---|
| 258 |
and when saved. |
|---|
| 259 |
|
|---|
| 260 |
Note: the time must be the first thing in the line in the diary |
|---|
| 261 |
for a warning to be issued. The format of the time can be either |
|---|
| 262 |
24 hour or am/pm. For example: |
|---|
| 263 |
|
|---|
| 264 |
02/23/89 |
|---|
| 265 |
18:00 Dinner |
|---|
| 266 |
|
|---|
| 267 |
Thursday |
|---|
| 268 |
11:45am Lunch meeting. |
|---|
| 269 |
|
|---|
| 270 |
Appointments are checked every `appt-display-interval' minutes. |
|---|
| 271 |
The following variables control appointment notification: |
|---|
| 272 |
|
|---|
| 273 |
`appt-display-format' |
|---|
| 274 |
Controls the format in which reminders are displayed. |
|---|
| 275 |
|
|---|
| 276 |
`appt-audible' |
|---|
| 277 |
Variable used to determine if reminder is audible. |
|---|
| 278 |
Default is t. |
|---|
| 279 |
|
|---|
| 280 |
`appt-message-warning-time' |
|---|
| 281 |
Variable used to determine when appointment message |
|---|
| 282 |
should first be displayed. |
|---|
| 283 |
|
|---|
| 284 |
`appt-display-mode-line' |
|---|
| 285 |
If non-nil, a generic message giving the time remaining |
|---|
| 286 |
is shown in the mode-line when an appointment is due. |
|---|
| 287 |
|
|---|
| 288 |
`appt-display-interval' |
|---|
| 289 |
Interval in minutes at which to check for pending appointments. |
|---|
| 290 |
|
|---|
| 291 |
`appt-display-diary' |
|---|
| 292 |
Display the diary buffer when the appointment list is |
|---|
| 293 |
initialized for the first time in a day. |
|---|
| 294 |
|
|---|
| 295 |
The following variables are only relevant if reminders are being |
|---|
| 296 |
displayed in a window: |
|---|
| 297 |
|
|---|
| 298 |
`appt-display-duration' |
|---|
| 299 |
The number of seconds an appointment message is displayed. |
|---|
| 300 |
|
|---|
| 301 |
`appt-disp-window-function' |
|---|
| 302 |
Function called to display appointment window. |
|---|
| 303 |
|
|---|
| 304 |
`appt-delete-window-function' |
|---|
| 305 |
Function called to remove appointment window and buffer." |
|---|
| 306 |
|
|---|
| 307 |
(let* ((min-to-app -1) |
|---|
| 308 |
(prev-appt-mode-string appt-mode-string) |
|---|
| 309 |
(prev-appt-display-count (or appt-display-count 0)) |
|---|
| 310 |
|
|---|
| 311 |
|
|---|
| 312 |
|
|---|
| 313 |
|
|---|
| 314 |
(full-check |
|---|
| 315 |
(or (not appt-now-displayed) |
|---|
| 316 |
|
|---|
| 317 |
(zerop (mod prev-appt-display-count appt-display-interval)))) |
|---|
| 318 |
|
|---|
| 319 |
(mode-line-only |
|---|
| 320 |
(and (not full-check) appt-now-displayed))) |
|---|
| 321 |
|
|---|
| 322 |
(when (or full-check mode-line-only) |
|---|
| 323 |
(save-excursion |
|---|
| 324 |
|
|---|
| 325 |
|
|---|
| 326 |
|
|---|
| 327 |
|
|---|
| 328 |
(let* ((now (decode-time)) |
|---|
| 329 |
(cur-hour (nth 2 now)) |
|---|
| 330 |
(cur-min (nth 1 now)) |
|---|
| 331 |
(cur-comp-time (+ (* cur-hour 60) cur-min))) |
|---|
| 332 |
|
|---|
| 333 |
|
|---|
| 334 |
|
|---|
| 335 |
|
|---|
| 336 |
(if (or force |
|---|
| 337 |
(null appt-prev-comp-time) |
|---|
| 338 |
(< cur-comp-time appt-prev-comp-time)) |
|---|
| 339 |
(condition-case nil |
|---|
| 340 |
(if appt-display-diary |
|---|
| 341 |
(let ((diary-hook |
|---|
| 342 |
(if (assoc 'appt-make-list diary-hook) |
|---|
| 343 |
diary-hook |
|---|
| 344 |
(cons 'appt-make-list diary-hook)))) |
|---|
| 345 |
(diary)) |
|---|
| 346 |
(let* ((diary-display-hook 'appt-make-list) |
|---|
| 347 |
(d-buff (find-buffer-visiting |
|---|
| 348 |
(substitute-in-file-name diary-file))) |
|---|
| 349 |
(selective |
|---|
| 350 |
(if d-buff |
|---|
| 351 |
(with-current-buffer d-buff |
|---|
| 352 |
diary-selective-display)))) |
|---|
| 353 |
(diary) |
|---|
| 354 |
|
|---|
| 355 |
|
|---|
| 356 |
(if d-buff |
|---|
| 357 |
|
|---|
| 358 |
(or selective (diary-show-all-entries)) |
|---|
| 359 |
(and |
|---|
| 360 |
(setq d-buff (find-buffer-visiting |
|---|
| 361 |
(substitute-in-file-name diary-file))) |
|---|
| 362 |
(kill-buffer d-buff))))) |
|---|
| 363 |
(error nil))) |
|---|
| 364 |
|
|---|
| 365 |
(setq appt-prev-comp-time cur-comp-time |
|---|
| 366 |
appt-mode-string nil |
|---|
| 367 |
appt-display-count nil) |
|---|
| 368 |
|
|---|
| 369 |
|
|---|
| 370 |
|
|---|
| 371 |
|
|---|
| 372 |
|
|---|
| 373 |
|
|---|
| 374 |
(if (and appt-issue-message appt-time-msg-list) |
|---|
| 375 |
(let ((appt-comp-time (car (car (car appt-time-msg-list))))) |
|---|
| 376 |
(setq min-to-app (- appt-comp-time cur-comp-time)) |
|---|
| 377 |
|
|---|
| 378 |
(while (and appt-time-msg-list |
|---|
| 379 |
(< appt-comp-time cur-comp-time)) |
|---|
| 380 |
(setq appt-time-msg-list (cdr appt-time-msg-list)) |
|---|
| 381 |
(if appt-time-msg-list |
|---|
| 382 |
(setq appt-comp-time |
|---|
| 383 |
(car (car (car appt-time-msg-list)))))) |
|---|
| 384 |
|
|---|
| 385 |
|
|---|
| 386 |
|
|---|
| 387 |
|
|---|
| 388 |
|
|---|
| 389 |
|
|---|
| 390 |
|
|---|
| 391 |
|
|---|
| 392 |
|
|---|
| 393 |
|
|---|
| 394 |
(if (and (< appt-comp-time appt-message-warning-time) |
|---|
| 395 |
(> (+ cur-comp-time appt-message-warning-time) |
|---|
| 396 |
appt-max-time)) |
|---|
| 397 |
(setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time) |
|---|
| 398 |
appt-comp-time))) |
|---|
| 399 |
|
|---|
| 400 |
|
|---|
| 401 |
|
|---|
| 402 |
|
|---|
| 403 |
(when (and (<= min-to-app appt-message-warning-time) |
|---|
| 404 |
(>= min-to-app 0)) |
|---|
| 405 |
(setq appt-now-displayed t |
|---|
| 406 |
appt-display-count (1+ prev-appt-display-count)) |
|---|
| 407 |
(unless mode-line-only |
|---|
| 408 |
(appt-display-message (cadr (car appt-time-msg-list)) |
|---|
| 409 |
min-to-app)) |
|---|
| 410 |
(when appt-display-mode-line |
|---|
| 411 |
(setq appt-mode-string |
|---|
| 412 |
(format " App't in %s min." min-to-app))) |
|---|
| 413 |
|
|---|
| 414 |
|
|---|
| 415 |
|
|---|
| 416 |
|
|---|
| 417 |
|
|---|
| 418 |
(if (zerop min-to-app) |
|---|
| 419 |
(setq appt-time-msg-list (cdr appt-time-msg-list) |
|---|
| 420 |
appt-display-count nil))))) |
|---|
| 421 |
|
|---|
| 422 |
|
|---|
| 423 |
|
|---|
| 424 |
(and appt-display-mode-line |
|---|
| 425 |
(not (equal appt-mode-string |
|---|
| 426 |
prev-appt-mode-string)) |
|---|
| 427 |
(progn |
|---|
| 428 |
(force-mode-line-update t) |
|---|
| 429 |
|
|---|
| 430 |
|
|---|
| 431 |
(if appt-mode-string |
|---|
| 432 |
(sit-for 0))))))))) |
|---|
| 433 |
|
|---|
| 434 |
|
|---|
| 435 |
(defun appt-disp-window (min-to-app new-time appt-msg) |
|---|
| 436 |
"Display appointment message APPT-MSG in a separate buffer. |
|---|
| 437 |
The appointment is due in MIN-TO-APP (a string) minutes. |
|---|
| 438 |
NEW-TIME is a string giving the date." |
|---|
| 439 |
(require 'electric) |
|---|
| 440 |
|
|---|
| 441 |
|
|---|
| 442 |
|
|---|
| 443 |
|
|---|
| 444 |
(if (equal (selected-window) (minibuffer-window)) |
|---|
| 445 |
(if (other-window 1) |
|---|
| 446 |
(select-window (other-window 1)) |
|---|
| 447 |
(if (display-multi-frame-p) |
|---|
| 448 |
(select-frame (other-frame 1))))) |
|---|
| 449 |
|
|---|
| 450 |
(let ((this-window (selected-window)) |
|---|
| 451 |
(appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name)))) |
|---|
| 452 |
|
|---|
| 453 |
(if (cdr (assq 'unsplittable (frame-parameters))) |
|---|
| 454 |
|
|---|
| 455 |
(display-buffer appt-disp-buf) |
|---|
| 456 |
(unless (or (special-display-p (buffer-name appt-disp-buf)) |
|---|
| 457 |
(same-window-p (buffer-name appt-disp-buf))) |
|---|
| 458 |
|
|---|
| 459 |
(appt-select-lowest-window) |
|---|
| 460 |
|
|---|
| 461 |
(when (>= (window-height) (* 2 window-min-height)) |
|---|
| 462 |
(select-window (split-window)))) |
|---|
| 463 |
(switch-to-buffer appt-disp-buf)) |
|---|
| 464 |
(calendar-set-mode-line |
|---|
| 465 |
(format " Appointment in %s minutes. %s " min-to-app new-time)) |
|---|
| 466 |
(erase-buffer) |
|---|
| 467 |
(insert appt-msg) |
|---|
| 468 |
(shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t)) |
|---|
| 469 |
(set-buffer-modified-p nil) |
|---|
| 470 |
(raise-frame (selected-frame)) |
|---|
| 471 |
(select-window this-window))) |
|---|
| 472 |
|
|---|
| 473 |
(defun appt-delete-window () |
|---|
| 474 |
"Function called to undisplay appointment messages. |
|---|
| 475 |
Usually just deletes the appointment buffer." |
|---|
| 476 |
(let ((window (get-buffer-window appt-buffer-name t))) |
|---|
| 477 |
(and window |
|---|
| 478 |
(or (eq window (frame-root-window (window-frame window))) |
|---|
| 479 |
(delete-window window)))) |
|---|
| 480 |
(kill-buffer appt-buffer-name) |
|---|
| 481 |
(if appt-audible |
|---|
| 482 |
(beep 1))) |
|---|
| 483 |
|
|---|
| 484 |
(defun appt-select-lowest-window () |
|---|
| 485 |
"Select the lowest window on the frame." |
|---|
| 486 |
(let ((lowest-window (selected-window)) |
|---|
| 487 |
(bottom-edge (nth 3 (window-edges)))) |
|---|
| 488 |
(walk-windows (lambda (w) |
|---|
| 489 |
(let ((next-bottom-edge (nth 3 (window-edges w)))) |
|---|
| 490 |
(when (< bottom-edge next-bottom-edge) |
|---|
| 491 |
(setq bottom-edge next-bottom-edge |
|---|
| 492 |
lowest-window w))))) |
|---|
| 493 |
(select-window lowest-window))) |
|---|
| 494 |
|
|---|
| 495 |
(defconst appt-time-regexp |
|---|
| 496 |
"[0-9]?[0-9]\\(h\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]\\)\\(am\\|pm\\)?") |
|---|
| 497 |
|
|---|
| 498 |
|
|---|
| 499 |
(defun appt-add (new-appt-time new-appt-msg) |
|---|
| 500 |
"Add an appointment for today at NEW-APPT-TIME with message NEW-APPT-MSG. |
|---|
| 501 |
The time should be in either 24 hour format or am/pm format." |
|---|
| 502 |
(interactive "sTime (hh:mm[am/pm]): \nsMessage: ") |
|---|
| 503 |
(unless (string-match appt-time-regexp new-appt-time) |
|---|
| 504 |
(error "Unacceptable time-string")) |
|---|
| 505 |
(let ((time-msg (list (list (appt-convert-time new-appt-time)) |
|---|
| 506 |
(concat new-appt-time " " new-appt-msg) t))) |
|---|
| 507 |
(unless (member time-msg appt-time-msg-list) |
|---|
| 508 |
(setq appt-time-msg-list |
|---|
| 509 |
(appt-sort-list (nconc appt-time-msg-list (list time-msg))))))) |
|---|
| 510 |
|
|---|
| 511 |
|
|---|
| 512 |
(defun appt-delete () |
|---|
| 513 |
"Delete an appointment from the list of appointments." |
|---|
| 514 |
(interactive) |
|---|
| 515 |
(let ((tmp-msg-list appt-time-msg-list)) |
|---|
| 516 |
(while tmp-msg-list |
|---|
| 517 |
(let* ((element (car tmp-msg-list)) |
|---|
| 518 |
(prompt-string (concat "Delete " |
|---|
| 519 |
|
|---|
| 520 |
|
|---|
| 521 |
|
|---|
| 522 |
(prin1-to-string |
|---|
| 523 |
(substring-no-properties |
|---|
| 524 |
(car (cdr element)) 0)) |
|---|
| 525 |
" from list? ")) |
|---|
| 526 |
(test-input (y-or-n-p prompt-string))) |
|---|
| 527 |
(setq tmp-msg-list (cdr tmp-msg-list)) |
|---|
| 528 |
(if test-input |
|---|
| 529 |
(setq appt-time-msg-list (delq element appt-time-msg-list))))) |
|---|
| 530 |
(appt-check) |
|---|
| 531 |
(message ""))) |
|---|
| 532 |
|
|---|
| 533 |
|
|---|
| 534 |
(eval-when-compile (defvar number) |
|---|
| 535 |
(defvar original-date) |
|---|
| 536 |
(defvar diary-entries-list)) |
|---|
| 537 |
|
|---|
| 538 |
(defun appt-make-list () |
|---|
| 539 |
"Update the appointments list from today's diary buffer. |
|---|
| 540 |
The time must be at the beginning of a line for it to be |
|---|
| 541 |
put in the appointments list (see examples in documentation of |
|---|
| 542 |
the function `appt-check'). We assume that the variables DATE and |
|---|
| 543 |
NUMBER hold the arguments that `diary-list-entries' received. |
|---|
| 544 |
They specify the range of dates that the diary is being processed for. |
|---|
| 545 |
|
|---|
| 546 |
Any appointments made with `appt-add' are not affected by this |
|---|
| 547 |
function. |
|---|
| 548 |
|
|---|
| 549 |
For backwards compatibility, this function activates the |
|---|
| 550 |
appointment package (if it is not already active)." |
|---|
| 551 |
|
|---|
| 552 |
(if (not appt-timer) |
|---|
| 553 |
(appt-activate 1) |
|---|
| 554 |
|
|---|
| 555 |
|
|---|
| 556 |
(if (and (not (calendar-date-compare |
|---|
| 557 |
(list (calendar-current-date)) |
|---|
| 558 |
(list original-date))) |
|---|
| 559 |
(calendar-date-compare |
|---|
| 560 |
(list (calendar-current-date)) |
|---|
| 561 |
(list (calendar-gregorian-from-absolute |
|---|
| 562 |
(+ (calendar-absolute-from-gregorian original-date) |
|---|
| 563 |
number))))) |
|---|
| 564 |
(save-excursion |
|---|
| 565 |
|
|---|
| 566 |
(dolist (elt appt-time-msg-list) |
|---|
| 567 |
|
|---|
| 568 |
(unless (nth 2 elt) |
|---|
| 569 |
(setq appt-time-msg-list |
|---|
| 570 |
(delq elt appt-time-msg-list)))) |
|---|
| 571 |
(if diary-entries-list |
|---|
| 572 |
|
|---|
| 573 |
|
|---|
| 574 |
|
|---|
| 575 |
|
|---|
| 576 |
|
|---|
| 577 |
|
|---|
| 578 |
(let ((entry-list diary-entries-list) |
|---|
| 579 |
(new-time-string "")) |
|---|
| 580 |
|
|---|
| 581 |
(while (and entry-list |
|---|
| 582 |
(calendar-date-compare |
|---|
| 583 |
(car entry-list) (list (calendar-current-date)))) |
|---|
| 584 |
(setq entry-list (cdr entry-list))) |
|---|
| 585 |
|
|---|
| 586 |
(while (and entry-list |
|---|
| 587 |
(calendar-date-equal |
|---|
| 588 |
(calendar-current-date) (car (car entry-list)))) |
|---|
| 589 |
(let ((time-string (cadr (car entry-list)))) |
|---|
| 590 |
(while (string-match appt-time-regexp time-string) |
|---|
| 591 |
(let* ((beg (match-beginning 0)) |
|---|
| 592 |
|
|---|
| 593 |
(only-time (match-string 0 time-string)) |
|---|
| 594 |
|
|---|
| 595 |
|
|---|
| 596 |
(end (string-match |
|---|
| 597 |
(concat "\n[ \t]*" appt-time-regexp) |
|---|
| 598 |
time-string |
|---|
| 599 |
(match-end 0))) |
|---|
| 600 |
|
|---|
| 601 |
(appt-time-string |
|---|
| 602 |
(substring time-string beg (if end (1- end))))) |
|---|
| 603 |
|
|---|
| 604 |
|
|---|
| 605 |
(let* ((appt-time (list (appt-convert-time only-time))) |
|---|
| 606 |
(time-msg (list appt-time appt-time-string))) |
|---|
| 607 |
(setq appt-time-msg-list |
|---|
| 608 |
(nconc appt-time-msg-list (list time-msg)))) |
|---|
| 609 |
|
|---|
| 610 |
|
|---|
| 611 |
(setq time-string |
|---|
| 612 |
(if end (substring time-string end) ""))))) |
|---|
| 613 |
(setq entry-list (cdr entry-list))))) |
|---|
| 614 |
(setq appt-time-msg-list (appt-sort-list appt-time-msg-list)) |
|---|
| 615 |
|
|---|
| 616 |
|
|---|
| 617 |
|
|---|
| 618 |
|
|---|
| 619 |
|
|---|
| 620 |
|
|---|
| 621 |
|
|---|
| 622 |
(let* ((now (decode-time)) |
|---|
| 623 |
(cur-hour (nth 2 now)) |
|---|
| 624 |
(cur-min (nth 1 now)) |
|---|
| 625 |
(cur-comp-time (+ (* cur-hour 60) cur-min)) |
|---|
| 626 |
(appt-comp-time (car (caar appt-time-msg-list)))) |
|---|
| 627 |
|
|---|
| 628 |
(while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) |
|---|
| 629 |
(setq appt-time-msg-list (cdr appt-time-msg-list)) |
|---|
| 630 |
(if appt-time-msg-list |
|---|
| 631 |
(setq appt-comp-time (car (caar appt-time-msg-list)))))))))) |
|---|
| 632 |
|
|---|
| 633 |
|
|---|
| 634 |
(defun appt-sort-list (appt-list) |
|---|
| 635 |
"Sort an appointment list, putting earlier items at the front. |
|---|
| 636 |
APPT-LIST is a list of the same format as `appt-time-msg-list'." |
|---|
| 637 |
(sort appt-list (lambda (e1 e2) (< (caar e1) (caar e2))))) |
|---|
| 638 |
|
|---|
| 639 |
|
|---|
| 640 |
(defun appt-convert-time (time2conv) |
|---|
| 641 |
"Convert hour:min[am/pm] format to minutes from midnight. |
|---|
| 642 |
A period (.) can be used instead of a colon (:) to separate the |
|---|
| 643 |
hour and minute parts." |
|---|
| 644 |
|
|---|
| 645 |
|
|---|
| 646 |
(let ((min (if (string-match "[h:.]\\([0-9][0-9]\\)" time2conv) |
|---|
| 647 |
(string-to-number (match-string 1 time2conv)) |
|---|
| 648 |
0)) |
|---|
| 649 |
(hr (if (string-match "[0-9]*[0-9]" time2conv) |
|---|
| 650 |
(string-to-number (match-string 0 time2conv)) |
|---|
| 651 |
0))) |
|---|
| 652 |
|
|---|
| 653 |
|
|---|
| 654 |
(cond ((and (string-match "pm" time2conv) (< hr 12)) |
|---|
| 655 |
(setq hr (+ 12 hr))) |
|---|
| 656 |
((and (string-match "am" time2conv) (= hr 12)) |
|---|
| 657 |
(setq hr 0))) |
|---|
| 658 |
|
|---|
| 659 |
|
|---|
| 660 |
(+ (* hr 60) min))) |
|---|
| 661 |
|
|---|
| 662 |
|
|---|
| 663 |
(defun appt-update-list () |
|---|
| 664 |
"If the current buffer is visiting the diary, update appointments. |
|---|
| 665 |
This function is intended for use with `write-file-functions'." |
|---|
| 666 |
(and (string-equal buffer-file-name (expand-file-name diary-file)) |
|---|
| 667 |
appt-timer |
|---|
| 668 |
(let ((appt-display-diary nil)) |
|---|
| 669 |
(appt-check t))) |
|---|
| 670 |
nil) |
|---|
| 671 |
|
|---|
| 672 |
|
|---|
| 673 |
|
|---|
| 674 |
|
|---|
| 675 |
|
|---|
| 676 |
|
|---|
| 677 |
|
|---|
| 678 |
|
|---|
| 679 |
|
|---|
| 680 |
|
|---|
| 681 |
|
|---|
| 682 |
|
|---|
| 683 |
|
|---|
| 684 |
|
|---|
| 685 |
|
|---|
| 686 |
|
|---|
| 687 |
|
|---|
| 688 |
|
|---|
| 689 |
|
|---|
| 690 |
|
|---|
| 691 |
|
|---|
| 692 |
|
|---|
| 693 |
|
|---|
| 694 |
|
|---|
| 695 |
|
|---|
| 696 |
|
|---|
| 697 |
|
|---|
| 698 |
(defun appt-activate (&optional arg) |
|---|
| 699 |
"Toggle checking of appointments. |
|---|
| 700 |
With optional numeric argument ARG, turn appointment checking on if |
|---|
| 701 |
ARG is positive, otherwise off." |
|---|
| 702 |
(interactive "P") |
|---|
| 703 |
(let ((appt-active appt-timer)) |
|---|
| 704 |
(setq appt-active (if arg (> (prefix-numeric-value arg) 0) |
|---|
| 705 |
(not appt-active))) |
|---|
| 706 |
(remove-hook 'write-file-functions 'appt-update-list) |
|---|
| 707 |
(or global-mode-string (setq global-mode-string '(""))) |
|---|
| 708 |
(delq 'appt-mode-string global-mode-string) |
|---|
| 709 |
(when appt-timer |
|---|
| 710 |
(cancel-timer appt-timer) |
|---|
| 711 |
(setq appt-timer nil)) |
|---|
| 712 |
(when appt-active |
|---|
| 713 |
(add-hook 'write-file-functions 'appt-update-list) |
|---|
| 714 |
(setq appt-timer (run-at-time t 60 'appt-check) |
|---|
| 715 |
global-mode-string |
|---|
| 716 |
(append global-mode-string '(appt-mode-string))) |
|---|
| 717 |
(appt-check t)))) |
|---|
| 718 |
|
|---|
| 719 |
|
|---|
| 720 |
(provide 'appt) |
|---|
| 721 |
|
|---|
| 722 |
|
|---|
| 723 |
|
|---|
| 724 |
|
|---|