aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-04-02 03:50:34 +0000
committerGlenn Morris2008-04-02 03:50:34 +0000
commitce5b3019bff73f83cd7b171c02ac46db0cbd30e3 (patch)
tree7e4e347ea96ec531f6b3bd20c3b44f8ed2229539
parent2475d1a3064e07f31d66cb38dea45f3806cd55a9 (diff)
downloademacs-ce5b3019bff73f83cd7b171c02ac46db0cbd30e3.tar.gz
emacs-ce5b3019bff73f83cd7b171c02ac46db0cbd30e3.zip
(appt-disp-window-function): Doc fix.
(appt-display-message): Move beep before display. (appt-check): Make interactive. Reduce the number of lets. Use string-equal to compare mode-line strings. (appt-disp-window): Pluralize "minute" as needed. Make appt buffer read-only. (appt-select-lowest-window, appt-make-list): Reduce the number of lets. (appt-delete): Simplify.
-rw-r--r--lisp/ChangeLog9
-rw-r--r--lisp/calendar/appt.el304
2 files changed, 157 insertions, 156 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8fc8562e203..380aa4c111e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,14 @@
12008-04-02 Glenn Morris <rgm@gnu.org> 12008-04-02 Glenn Morris <rgm@gnu.org>
2 2
3 * calendar/appt.el (appt-disp-window-function): Doc fix.
4 (appt-display-message): Move beep before display.
5 (appt-check): Make interactive. Reduce the number of lets.
6 Use string-equal to compare mode-line strings.
7 (appt-disp-window): Pluralize "minute" as needed. Make appt buffer
8 read-only.
9 (appt-select-lowest-window, appt-make-list): Reduce the number of lets.
10 (appt-delete): Simplify.
11
3 * calendar/cal-china.el (holiday-chinese-new-year): Use a single let. 12 * calendar/cal-china.el (holiday-chinese-new-year): Use a single let.
4 13
5 * calendar/cal-dst.el (calendar-time-zone-daylight-rules): Simplify. 14 * calendar/cal-dst.el (calendar-time-zone-daylight-rules): Simplify.
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 4cf67d084b0..c1d1c47b3f7 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -165,7 +165,9 @@ This will occur at midnight when the appointment list is updated."
165 165
166(defcustom appt-disp-window-function 'appt-disp-window 166(defcustom appt-disp-window-function 'appt-disp-window
167 "Function called to display appointment window. 167 "Function called to display appointment window.
168Only relevant if reminders are being displayed in a window." 168Only relevant if reminders are being displayed in a window.
169It should take three string arguments: the number of minutes till
170the appointment, the current time, and the text of the appointment."
169 :type '(choice (const appt-disp-window) 171 :type '(choice (const appt-disp-window)
170 function) 172 function)
171 :group 'appt) 173 :group 'appt)
@@ -232,6 +234,7 @@ The variable `appt-audible' controls the audible reminder."
232 (cond (appt-msg-window 'window) 234 (cond (appt-msg-window 'window)
233 (appt-visible 'echo)) 235 (appt-visible 'echo))
234 appt-display-format))) 236 appt-display-format)))
237 (if appt-audible (beep 1))
235 (cond ((eq appt-display-format 'window) 238 (cond ((eq appt-display-format 'window)
236 (funcall appt-disp-window-function 239 (funcall appt-disp-window-function
237 (number-to-string mins) 240 (number-to-string mins)
@@ -242,8 +245,7 @@ The variable `appt-audible' controls the audible reminder."
242 nil 245 nil
243 appt-delete-window-function)) 246 appt-delete-window-function))
244 ((eq appt-display-format 'echo) 247 ((eq appt-display-format 'echo)
245 (message "%s" string))) 248 (message "%s" string)))))
246 (if appt-audible (beep 1))))
247 249
248 250
249(defvar diary-selective-display) 251(defvar diary-selective-display)
@@ -300,6 +302,7 @@ displayed in a window:
300 302
301`appt-delete-window-function' 303`appt-delete-window-function'
302 Function called to remove appointment window and buffer." 304 Function called to remove appointment window and buffer."
305 (interactive "P") ; so people can force updates
303 (let* ((min-to-app -1) 306 (let* ((min-to-app -1)
304 (prev-appt-mode-string appt-mode-string) 307 (prev-appt-mode-string appt-mode-string)
305 (prev-appt-display-count (or appt-display-count 0)) 308 (prev-appt-display-count (or appt-display-count 0))
@@ -311,106 +314,97 @@ displayed in a window:
311 ;; This is true every appt-display-interval minutes. 314 ;; This is true every appt-display-interval minutes.
312 (zerop (mod prev-appt-display-count appt-display-interval)))) 315 (zerop (mod prev-appt-display-count appt-display-interval))))
313 ;; Non-nil means only update the interval displayed in the mode line. 316 ;; Non-nil means only update the interval displayed in the mode line.
314 (mode-line-only 317 (mode-line-only (unless full-check appt-now-displayed))
315 (and (not full-check) appt-now-displayed))) 318 now cur-comp-time appt-comp-time)
316 (when (or full-check mode-line-only) 319 (when (or full-check mode-line-only)
317 (save-excursion 320 (save-excursion
318 ;; Get the current time and convert it to minutes 321 ;; Convert current time to minutes after midnight (12.01am = 1).
319 ;; from midnight, i.e.: 12:01am = 1, midnight = 0. 322 (setq now (decode-time)
320 (let* ((now (decode-time)) 323 cur-comp-time (+ (* 60 (nth 2 now)) (nth 1 now)))
321 (cur-hour (nth 2 now)) 324 ;; At first check in any day, update appointments to today's list.
322 (cur-min (nth 1 now)) 325 (if (or force ; eg initialize, diary save
323 (cur-comp-time (+ (* cur-hour 60) cur-min))) 326 (null appt-prev-comp-time) ; first check
324 ;; At the first check in any given day, update our 327 (< cur-comp-time appt-prev-comp-time)) ; new day
325 ;; appointments to today's list. 328 (condition-case nil
326 (if (or force ; eg initialize, diary save 329 (if appt-display-diary
327 (null appt-prev-comp-time) ; first check 330 (let ((diary-hook
328 (< cur-comp-time appt-prev-comp-time)) ; new day 331 (if (assoc 'appt-make-list diary-hook)
329 (condition-case nil 332 diary-hook
330 (if appt-display-diary 333 (cons 'appt-make-list diary-hook))))
331 (let ((diary-hook 334 (diary))
332 (if (assoc 'appt-make-list diary-hook) 335 (let* ((diary-display-hook 'appt-make-list)
333 diary-hook 336 (d-buff (find-buffer-visiting
334 (cons 'appt-make-list diary-hook)))) 337 (substitute-in-file-name diary-file)))
335 (diary)) 338 (selective
336 (let* ((diary-display-hook 'appt-make-list) 339 (if d-buff ; diary buffer exists
337 (d-buff (find-buffer-visiting 340 (with-current-buffer d-buff
338 (substitute-in-file-name diary-file))) 341 diary-selective-display))))
339 (selective 342 (diary)
340 (if d-buff ; diary buffer exists 343 ;; If the diary buffer existed before this command,
341 (with-current-buffer d-buff 344 ;; restore its display state. Otherwise, kill it.
342 diary-selective-display)))) 345 (if d-buff
343 (diary) 346 ;; Displays the diary buffer.
344 ;; If the diary buffer existed before this command, 347 (or selective (diary-show-all-entries))
345 ;; restore its display state. Otherwise, kill it. 348 (and (setq d-buff (find-buffer-visiting
346 (if d-buff 349 (substitute-in-file-name diary-file)))
347 ;; Displays the diary buffer. 350 (kill-buffer d-buff)))))
348 (or selective (diary-show-all-entries)) 351 (error nil)))
349 (and 352 (setq appt-prev-comp-time cur-comp-time
350 (setq d-buff (find-buffer-visiting 353 appt-mode-string nil
351 (substitute-in-file-name diary-file))) 354 appt-display-count nil)
352 (kill-buffer d-buff))))) 355 ;; If there are entries in the list, and the user wants a
353 (error nil))) 356 ;; message issued, get the first time off of the list and
354 (setq appt-prev-comp-time cur-comp-time 357 ;; calculate the number of minutes until the appointment.
355 appt-mode-string nil 358 (when (and appt-issue-message appt-time-msg-list)
356 appt-display-count nil) 359 (setq appt-comp-time (caar (car appt-time-msg-list))
357 ;; If there are entries in the list, and the user wants a 360 min-to-app (- appt-comp-time cur-comp-time))
358 ;; message issued, get the first time off of the list and 361 (while (and appt-time-msg-list
359 ;; calculate the number of minutes until the appointment. 362 (< appt-comp-time cur-comp-time))
360 (if (and appt-issue-message appt-time-msg-list) 363 (setq appt-time-msg-list (cdr appt-time-msg-list))
361 (let ((appt-comp-time (caar (car appt-time-msg-list)))) 364 (if appt-time-msg-list
362 (setq min-to-app (- appt-comp-time cur-comp-time)) 365 (setq appt-comp-time (caar (car appt-time-msg-list)))))
363 366 ;; If we have an appointment between midnight and
364 (while (and appt-time-msg-list 367 ;; `appt-message-warning-time' minutes after midnight, we
365 (< appt-comp-time cur-comp-time)) 368 ;; must begin to issue a message before midnight. Midnight
366 (setq appt-time-msg-list (cdr appt-time-msg-list)) 369 ;; is considered 0 minutes and 11:59pm is 1439
367 (if appt-time-msg-list 370 ;; minutes. Therefore we must recalculate the minutes to
368 (setq appt-comp-time 371 ;; appointment variable. It is equal to the number of
369 (caar (car appt-time-msg-list))))) 372 ;; minutes before midnight plus the number of minutes after
370 ;; If we have an appointment between midnight and 373 ;; midnight our appointment is.
371 ;; `appt-message-warning-time' minutes after midnight, 374 (if (and (< appt-comp-time appt-message-warning-time)
372 ;; we must begin to issue a message before midnight. 375 (> (+ cur-comp-time appt-message-warning-time)
373 ;; Midnight is considered 0 minutes and 11:59pm is 376 appt-max-time))
374 ;; 1439 minutes. Therefore we must recalculate the 377 (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time)
375 ;; minutes to appointment variable. It is equal to the 378 appt-comp-time)))
376 ;; number of minutes before midnight plus the number 379 ;; Issue warning if the appointment time is within
377 ;; of minutes after midnight our appointment is. 380 ;; appt-message-warning time.
378 (if (and (< appt-comp-time appt-message-warning-time) 381 (when (and (<= min-to-app appt-message-warning-time)
379 (> (+ cur-comp-time appt-message-warning-time) 382 (>= min-to-app 0))
380 appt-max-time)) 383 (setq appt-now-displayed t
381 (setq min-to-app (+ (- (1+ appt-max-time) cur-comp-time) 384 appt-display-count (1+ prev-appt-display-count))
382 appt-comp-time))) 385 (unless mode-line-only
383 ;; Issue warning if the appointment time is within 386 (appt-display-message (cadr (car appt-time-msg-list))
384 ;; appt-message-warning time. 387 min-to-app))
385 (when (and (<= min-to-app appt-message-warning-time) 388 (when appt-display-mode-line
386 (>= min-to-app 0)) 389 (setq appt-mode-string
387 (setq appt-now-displayed t 390 (concat " " (propertize
388 appt-display-count (1+ prev-appt-display-count)) 391 (format "App't in %s min." min-to-app)
389 (unless mode-line-only 392 'face 'mode-line-emphasis))))
390 (appt-display-message (cadr (car appt-time-msg-list)) 393 ;; When an appointment is reached, delete it from the
391 min-to-app)) 394 ;; list. Reset the count to 0 in case we display another
392 (when appt-display-mode-line 395 ;; appointment on the next cycle.
393 (setq appt-mode-string 396 (if (zerop min-to-app)
394 (concat " " (propertize 397 (setq appt-time-msg-list (cdr appt-time-msg-list)
395 (format "App't in %s min." min-to-app) 398 appt-display-count nil))))
396 'face 'mode-line-emphasis)))) 399 ;; If we have changed the mode line string, redisplay all mode lines.
397 ;; When an appointment is reached, delete it from 400 (and appt-display-mode-line
398 ;; the list. Reset the count to 0 in case we 401 (not (string-equal appt-mode-string
399 ;; display another appointment on the next cycle. 402 prev-appt-mode-string))
400 (if (zerop min-to-app) 403 (progn
401 (setq appt-time-msg-list (cdr appt-time-msg-list) 404 (force-mode-line-update t)
402 appt-display-count nil))))) 405 ;; If the string now has a notification, redisplay right now.
403 ;; If we have changed the mode line string, redisplay all 406 (if appt-mode-string
404 ;; mode lines. 407 (sit-for 0))))))))
405 (and appt-display-mode-line
406 (not (equal appt-mode-string
407 prev-appt-mode-string))
408 (progn
409 (force-mode-line-update t)
410 ;; If the string now has a notification, redisplay
411 ;; right now.
412 (if appt-mode-string
413 (sit-for 0)))))))))
414 408
415(defun appt-disp-window (min-to-app new-time appt-msg) 409(defun appt-disp-window (min-to-app new-time appt-msg)
416 "Display appointment due in MIN-TO-APP (a string) minutes. 410 "Display appointment due in MIN-TO-APP (a string) minutes.
@@ -434,13 +428,20 @@ message APPT-MSG in a separate buffer."
434 (when (>= (window-height) (* 2 window-min-height)) 428 (when (>= (window-height) (* 2 window-min-height))
435 (select-window (split-window)))) 429 (select-window (split-window))))
436 (switch-to-buffer appt-disp-buf)) 430 (switch-to-buffer appt-disp-buf))
431 ;; FIXME Link to diary entry?
437 (calendar-set-mode-line 432 (calendar-set-mode-line
438 (format " Appointment in %s minutes. %s " min-to-app new-time)) 433 (format " Appointment %s. %s "
439 (buffer-disable-undo) 434 (if (string-equal "0" min-to-app) "now"
435 (format "in %s minute%s" min-to-app
436 (if (string-equal "1" min-to-app) "" "s")))
437 new-time))
438 (setq buffer-read-only nil
439 buffer-undo-list t)
440 (erase-buffer) 440 (erase-buffer)
441 (insert appt-msg) 441 (insert appt-msg)
442 (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t)) 442 (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
443 (set-buffer-modified-p nil) 443 (set-buffer-modified-p nil)
444 (setq buffer-read-only t)
444 (raise-frame (selected-frame)) 445 (raise-frame (selected-frame))
445 (select-window this-window))) 446 (select-window this-window)))
446 447
@@ -458,12 +459,13 @@ Usually just deletes the appointment buffer."
458(defun appt-select-lowest-window () 459(defun appt-select-lowest-window ()
459"Select the lowest window on the frame." 460"Select the lowest window on the frame."
460 (let ((lowest-window (selected-window)) 461 (let ((lowest-window (selected-window))
461 (bottom-edge (nth 3 (window-edges)))) 462 (bottom-edge (nth 3 (window-edges)))
463 next-bottom-edge)
462 (walk-windows (lambda (w) 464 (walk-windows (lambda (w)
463 (let ((next-bottom-edge (nth 3 (window-edges w)))) 465 (when (< bottom-edge (setq next-bottom-edge
464 (when (< bottom-edge next-bottom-edge) 466 (nth 3 (window-edges w))))
465 (setq bottom-edge next-bottom-edge 467 (setq bottom-edge next-bottom-edge
466 lowest-window w)))) 'nomini) 468 lowest-window w))) 'nomini)
467 (select-window lowest-window))) 469 (select-window lowest-window)))
468 470
469(defconst appt-time-regexp 471(defconst appt-time-regexp
@@ -487,22 +489,16 @@ The time should be in either 24 hour format or am/pm format."
487 "Delete an appointment from the list of appointments." 489 "Delete an appointment from the list of appointments."
488 (interactive) 490 (interactive)
489 (let ((tmp-msg-list appt-time-msg-list)) 491 (let ((tmp-msg-list appt-time-msg-list))
490 (while tmp-msg-list 492 (dolist (element tmp-msg-list)
491 (let* ((element (car tmp-msg-list)) 493 (if (y-or-n-p (concat "Delete "
492 (prompt-string (concat "Delete " 494 ;; We want to quote any doublequotes in the
493 ;; We want to quote any doublequotes 495 ;; string, as well as put doublequotes around it.
494 ;; in the string, as well as put 496 (prin1-to-string
495 ;; doublequotes around it. 497 (substring-no-properties (cadr element) 0))
496 (prin1-to-string 498 " from list? "))
497 (substring-no-properties 499 (setq appt-time-msg-list (delq element appt-time-msg-list)))))
498 (cadr element) 0)) 500 (appt-check)
499 " from list? ")) 501 (message ""))
500 (test-input (y-or-n-p prompt-string)))
501 (setq tmp-msg-list (cdr tmp-msg-list))
502 (if test-input
503 (setq appt-time-msg-list (delq element appt-time-msg-list)))))
504 (appt-check)
505 (message "")))
506 502
507 503
508(defvar number) 504(defvar number)
@@ -517,8 +513,7 @@ the function `appt-check'). We assume that the variables DATE and
517NUMBER hold the arguments that `diary-list-entries' received. 513NUMBER hold the arguments that `diary-list-entries' received.
518They specify the range of dates that the diary is being processed for. 514They specify the range of dates that the diary is being processed for.
519 515
520Any appointments made with `appt-add' are not affected by this 516Any appointments made with `appt-add' are not affected by this function.
521function.
522 517
523For backwards compatibility, this function activates the 518For backwards compatibility, this function activates the
524appointment package (if it is not already active)." 519appointment package (if it is not already active)."
@@ -548,7 +543,8 @@ appointment package (if it is not already active)."
548 ;; entry begins with a time, add it to the 543 ;; entry begins with a time, add it to the
549 ;; appt-time-msg-list. Then sort the list. 544 ;; appt-time-msg-list. Then sort the list.
550 (let ((entry-list diary-entries-list) 545 (let ((entry-list diary-entries-list)
551 (new-time-string "")) 546 (new-time-string "")
547 time-string)
552 ;; Skip diary entries for dates before today. 548 ;; Skip diary entries for dates before today.
553 (while (and entry-list 549 (while (and entry-list
554 (calendar-date-compare 550 (calendar-date-compare
@@ -558,40 +554,36 @@ appointment package (if it is not already active)."
558 (while (and entry-list 554 (while (and entry-list
559 (calendar-date-equal 555 (calendar-date-equal
560 (calendar-current-date) (caar entry-list))) 556 (calendar-current-date) (caar entry-list)))
561 (let ((time-string (cadr (car entry-list)))) 557 (setq time-string (cadr (car entry-list)))
562 (while (string-match appt-time-regexp time-string) 558 (while (string-match appt-time-regexp time-string)
563 (let* ((beg (match-beginning 0)) 559 (let* ((beg (match-beginning 0))
564 ;; Get just the time for this appointment. 560 ;; Get just the time for this appointment.
565 (only-time (match-string 0 time-string)) 561 (only-time (match-string 0 time-string))
566 ;; Find the end of this appointment 562 ;; Find the end of this appointment
567 ;; (the start of the next). 563 ;; (the start of the next).
568 (end (string-match 564 (end (string-match
569 (concat "\n[ \t]*" appt-time-regexp) 565 (concat "\n[ \t]*" appt-time-regexp)
570 time-string 566 time-string
571 (match-end 0))) 567 (match-end 0)))
572 ;; Get the whole string for this appointment. 568 ;; Get the whole string for this appointment.
573 (appt-time-string 569 (appt-time-string
574 (substring time-string beg (if end (1- end))))) 570 (substring time-string beg (if end (1- end))))
575 ;; Add this appointment to appt-time-msg-list. 571 (appt-time (list (appt-convert-time only-time)))
576 (let* ((appt-time (list (appt-convert-time only-time))) 572 (time-msg (list appt-time appt-time-string)))
577 (time-msg (list appt-time appt-time-string))) 573 ;; Add this appointment to appt-time-msg-list.
578 (setq appt-time-msg-list 574 (setq appt-time-msg-list
579 (nconc appt-time-msg-list (list time-msg)))) 575 (nconc appt-time-msg-list (list time-msg))
580 ;; Discard this appointment from the string. 576 ;; Discard this appointment from the string.
581 (setq time-string 577 time-string
582 (if end (substring time-string end) ""))))) 578 (if end (substring time-string end) ""))))
583 (setq entry-list (cdr entry-list))))) 579 (setq entry-list (cdr entry-list)))))
584 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)) 580 (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
585 ;; Get the current time and convert it to minutes from 581 ;; Convert current time to minutes after midnight (12:01am = 1),
586 ;; midnight, i.e. 12:01am = 1, midnight = 0, so that the 582 ;; so that elements in the list that are earlier than the
587 ;; elements in the list that are earlier than the present 583 ;; present time can be removed.
588 ;; time can be removed.
589 (let* ((now (decode-time)) 584 (let* ((now (decode-time))
590 (cur-hour (nth 2 now)) 585 (cur-comp-time (+ (* 60 (nth 2 now)) (nth 1 now)))
591 (cur-min (nth 1 now))
592 (cur-comp-time (+ (* cur-hour 60) cur-min))
593 (appt-comp-time (caar (car appt-time-msg-list)))) 586 (appt-comp-time (caar (car appt-time-msg-list))))
594
595 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) 587 (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
596 (setq appt-time-msg-list (cdr appt-time-msg-list)) 588 (setq appt-time-msg-list (cdr appt-time-msg-list))
597 (if appt-time-msg-list 589 (if appt-time-msg-list