Mercurial > hg > xemacs-beta

comparison lisp/calendar/appt.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 56c54cf7c5b6
children 360340f9fd5f
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details. 18 ;; General Public License for more details.
19 19
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23 ;; Boston, MA 02111-1307, USA.
24 23
25 ;;; 29-nov-89 created by Neil Mager <neilm@juliet.ll.mit.edu>. 24 ;;; 29-nov-89 created by Neil Mager <neilm@juliet.ll.mit.edu>.
26 ;;; 23-feb-91 hacked upon by Jamie Zawinski <jwz@lucid.com>. 25 ;;; 23-feb-91 hacked upon by Jamie Zawinski <jwz@lucid.com>.
27 ;;; 1-apr-91 some more. 26 ;;; 1-apr-91 some more.
28 ;;; 12-jul-95 updated for XEmacs 19.12 by Greg Veres <gveres@cgl.uwaterloo.ca> 27 ;;; 12-jul-95 updated for XEmacs 19.12 by Greg Veres <gveres@cgl.uwaterloo.ca>
137 ;;; o multiple adjascent appointments are not handled gracefully. If there 136 ;;; o multiple adjascent appointments are not handled gracefully. If there
138 ;;; is an appointment at 3:30 and another at 3:35, and you have set things 137 ;;; is an appointment at 3:30 and another at 3:35, and you have set things
139 ;;; up so that you get a notification twenty minutes before each appt, 138 ;;; up so that you get a notification twenty minutes before each appt,
140 ;;; then a notification should come at 3:10 for the first appt, and at 139 ;;; then a notification should come at 3:10 for the first appt, and at
141 ;;; 3:15 for the second. Currently, no notifications are generated for an 140 ;;; 3:15 for the second. Currently, no notifications are generated for an
142 ;;; appointment until all preceding appointments have completely expired. 141 ;;; appointment until all preceeding appointments have completely expired.
143 ;;; 142 ;;;
144 ;;; o If there are two appointments at the same time, all but the first are 143 ;;; o If there are two appointments at the same time, all but the first are
145 ;;; ignored (not announced.) 144 ;;; ignored (not announced.)
146 ;;; 145 ;;;
147 ;;; o Appointments which are early enough in the morning that their 146 ;;; o Appointments which are early enough in the morning that their
436 10:00am group meeting" 435 10:00am group meeting"
437 (install-display-time-hook) 436 (install-display-time-hook)
438 (let ((n (length (appt-diary-entries)))) 437 (let ((n (length (appt-diary-entries))))
439 (cond ((= n 0) (message "no appointments today.")) 438 (cond ((= n 0) (message "no appointments today."))
440 ((= n 1) (message "1 appointment today.")) 439 ((= n 1) (message "1 appointment today."))
441 (t (message (format "%d appointments today." n)))))) 440 (t (message "%d appointments today." n)))))
442 441
443 (defun appt-make-list () 442 (defun appt-make-list ()
444 "Don't call this directly; call appt-initialize or appt-diary-entries." 443 "Don't call this directly; call appt-initialize or appt-diary-entries."
445 (setq appt-time-msg-list nil) 444 (setq appt-time-msg-list nil)
446 (if diary-entries-list 445 (if diary-entries-list
683 (message ""))) 682 (message "")))
684 683
685 684
686 ;;; Patching in to existing time code to install our hook. 685 ;;; Patching in to existing time code to install our hook.
687 686
687 (defvar display-time-hook nil
688 "*List of functions to be called when the time is updated on the mode line.")
689
690 (setq display-time-hook 'appt-check)
688 691
689 (defvar display-time-hook-installed nil) 692 (defvar display-time-hook-installed nil)
690 693
691 (defun install-display-time-hook () 694 (defun install-display-time-hook ()
692 (unless display-time-hook-installed ; only do this stuff once! 695 (if display-time-hook-installed ;; only do this stuff once!
693 (unless (boundp 'display-time-hook) ; Need to wrapper it. 696 nil
694 (defvar display-time-hook nil 697 (let ((old-fn (if (or (featurep 'reportmail)
695 "*List of functions to be called when the time is updated on the mode line.") 698 ;; old reportmail without a provide statement
696 (let ((old-fn (if (or (featurep 'reportmail) 699 (and (fboundp 'display-time-filter-18-55)
697 ;; old reportmail without a provide statement 700 (fboundp 'display-time-filter-18-57)))
698 (and (fboundp 'display-time-filter-18-55) 701 (if (and (featurep 'itimer) ; XEmacs reportmail.el
699 (fboundp 'display-time-filter-18-57))) 702 (fboundp 'display-time-timer-function))
700 (if (and (featurep 'itimer) ; XEmacs reportmail.el 703 'display-time-timer-function
701 (fboundp 'display-time-timer-function)) 704 ;; older reportmail, or no timer.el.
702 'display-time-timer-function 705 (if (string-match "18\\.5[0-5]" (emacs-version))
703 ;; older reportmail, or no timer.el. 706 'display-time-filter-18-55
704 (if (string-match "18\\.5[0-5]" (emacs-version)) 707 'display-time-filter-18-57))
705 'display-time-filter-18-55 708 ;; othewise, time.el
706 'display-time-filter-18-57)) 709 (if (and (featurep 'itimer)
707 ;; othewise, time.el 710 (fboundp 'display-time-function)) ; XEmacs
708 (if (and (featurep 'itimer) 711 'display-time-function
709 (fboundp 'display-time-function)) ; XEmacs 712 'display-time-filter))))
710 'display-time-function
711 'display-time-filter))))
712 ;; we're about to redefine it... 713 ;; we're about to redefine it...
713 (fset 'old-display-time-filter (symbol-function old-fn)) 714 (fset 'old-display-time-filter (symbol-function old-fn))
714 (fset old-fn 715 (fset old-fn
715 '(lambda (&rest args) ;; ...here's the revised definition 716 (function (lambda (&rest args) ;; ...here's the revised definition
716 "Revised version of the original function: this version calls a hook." 717 "Revised version of the original function: this version calls a hook."
717 (apply 'old-display-time-filter args) 718 (apply 'old-display-time-filter args)
718 (run-hooks 'display-time-hook))))) 719 (run-hooks 'display-time-hook)))))
719 (setq display-time-hook-installed t) 720 (setq display-time-hook-installed t)
720 (if (fboundp 'add-hook) 721 ))
721 (add-hook 'display-time-hook 'appt-check)
722 (setq display-time-hook (cons appt-check display-time-hook)))
723 ))
724 722
725 (provide 'appt) 723 (provide 'appt)