annotate lisp/packages/reportmail.el @ 76:c0c698873ce1 r20-0b33

Import from CVS: tag r20-0b33
author cvs
date Mon, 13 Aug 2007 09:05:10 +0200
parents 131b0175ea99
children 4be1180a9e89
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 ;; REPORTMAIL: Display time and load in mode line of Emacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2 ;; Originally time.el in the emacs distribution.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3 ;; Mods by BCP, DCP, and JWZ to display incoming mail.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5 ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 ;; This file is part of GNU Emacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 ;; GNU Emacs is distributed in the hope that it will be useful,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;; but WITHOUT ANY WARRANTY. No author or distributor
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11 ;; accepts responsibility to anyone for the consequences of using it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ;; or for whether it serves any particular purpose or works at all,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13 ;; unless he says so in writing. Refer to the GNU Emacs General Public
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 ;; License for full details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 ;; Everyone is granted permission to copy, modify and redistribute
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 ;; GNU Emacs, but only under the conditions described in the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18 ;; GNU Emacs General Public License. A copy of this license is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 ;; supposed to have been given to you along with GNU Emacs so you
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 ;; can know your rights and responsibilities. It should be in a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21 ;; file named COPYING. Among other things, the copyright notice
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22 ;; and this notice must be preserved on all copies.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
24 ;;; Synched up with: Not in FSF.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
25 ;;; #### Appears to duplicate time.el. Perhaps should be nuked.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
26
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29 ; Installation
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30 ; ------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 ; To use reportmail, add the following to your .emacs file:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34 ; (load-library "reportmail")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36 ; ;; Edit this list as appropriate
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37 ; (setq display-time-my-addresses
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38 ; '("Benjamin.Pierce" "bcp" "Benjamin Pierce" "Benjamin C. Pierce"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40 ; ;; By default, mail arrival is reported with a message but no beep
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41 ; (setq display-time-mail-ring-bell t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43 ; (display-time)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 ; When new mail arrives, a brief blurb about it will be displayed in the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 ; mode line, and a more verbose message will be printed in the echo area.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47 ; But unlike most echo-area messages, this message will not go away at
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48 ; the next keystroke - it doesn't go away until the next extended-command
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49 ; is used. This is cool because that means you won't miss seeing the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
50 ; subject of the newly-arrived mail because you happened to be typing when
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51 ; it arrived.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
52 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 ; But if you set the variable `display-time-flush-echo-area' to t, then this
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 ; message will be cleared every `display-time-interval' seconds. This means
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 ; the message will be around for at most 30 seconds or so, which you may
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 ; prefer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 ; Site Configuration
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 ; ------------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 ; The variables display-time-incoming-mail-file and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62 ; display-time-message-separator identify the location and format of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63 ; your waiting messages. If you are in the CMU SCS environment, or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64 ; are on a generic BSD unix system, this code should work right away.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 ; Otherwise, you might need to modify the values of these to make things
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 ; work.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 ; Junk Mail
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69 ; ---------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 ; The reportmail package has a notion of "junk mail," which can be used to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 ; reduce the frequency of irritating interruptions by reporting only the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 ; arrival of messages that seem to be interesting. If you're on a lot
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 ; of high-volume mailing lists, this can be quite convenient. To use
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 ; this facility, add something like the following to your .emacs file:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 ; ;; The value of this variable is a list of lists, where the first
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78 ; ;; element in each list is the name of a header field and the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79 ; ;; remaining elements are various elements of the value of this
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80 ; ;; header field that signal the junkiness of a message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 ; (setq display-time-junk-mail-checklist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82 ; '(("From" "bcp" "Benjamin Pierce" "Benjamin.Pierce"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 ; "Mail Delivery Subsystem" "network" "daemon@bartok")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 ; ("To" "sml-request" "sml-redistribution-request"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 ; "scheme" "TeXhax-Distribution-list")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 ; ("Resent-From" "Benjamin.Pierce")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 ; ("Sender" "WRITERS" "Haskell" "Electronic Music Digest" "NEW-LIST")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 ; By default, the entries in this list are matched exactly as
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90 ; substrings of the given header fields. If an entry begins with
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 ; the character ^ it will be matched as a regular expression. If the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 ; variable display-time-match-using-regexps is set, then all entries
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93 ; will be matched as regular expressions.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 ; Note that elements of display-time-my-addresses are NOT automatically
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 ; included in display-time-junk-mail-checklist. If you want mail from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 ; yourself to be considered junkmail, you must add your addresses to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98 ; display-time-junk-mail-checklist too.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101 ; Xbiff Interface
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102 ; ---------------
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104 ; If you normally keep your emacs window iconified, reportmail can
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 ; maintain an xbiff or xbiff++ display as well. The xbiff window will only
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106 ; be highlighted when non-junk mail is waiting to be read. For example:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 ; (if window-system-version
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109 ; (setq display-time-use-xbiff t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
110 ; (setq display-time-xbiff-arg-list '("-update" "30" "-geometry" "+0+0"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111 ; (setq display-time-xbiff-program "xbiff++")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 ; Other
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114 ; -----
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 ; There are several other user-customization variables that you may wish
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117 ; to modify. These are documented below.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
119
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122 ; HISTORY
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123 ;
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
124 ; 19 dec 93 Jamie Zawinski <jwz@netscape.com>
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125 ; Protected it from edits of the *reportmail* buffer; made the process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 ; filters not interfere with the match data.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127 ;
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
128 ; 15 dec 93 Jamie Zawinski <jwz@netscape.com>
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129 ; Kyle renamed timer.el to itimer.el; made this use the new names.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 ;
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
131 ; 27 aug 93 Jamie Zawinski <jwz@netscape.com>
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
132 ; Use mail-extr to parse addresses if it is loadable.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
133 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 ; 15 oct 92 Benjamin Pierce (bcp@cs.cmu.edu)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135 ; Merged recent changes
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136 ;
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
137 ; 14 oct 92 Jamie Zawinski <jwz@netscape.com>
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
138 ; Added support for xbiff++.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
139 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
140 ; 17 sep 92 Benjamin Pierce (bcp@cs.cmu.edu)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
141 ; Improvements to message display code.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
142 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
143 ; 15 sep 92 Benjamin Pierce (bcp@cs.cmu.edu)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
144 ; Minor bug fixes.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
145 ;
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
146 ; 1 may 92 Jamie Zawinski <jwz@netscape.com>
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
147 ; Converted to work with Kyle Jones' timer.el package.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
148 ;
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
149 ; 3 may 91 Jamie Zawinski <jwz@netscape.com>
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
150 ; Made the display-time-sentinel make a fuss when the process dies.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
151 ;
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
152 ; 26 mar 91 Jamie Zawinski <jwz@netscape.com>
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
153 ; Merged with BCP's latest posted version
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
154 ;
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
155 ; 5 mar 91 Jamie Zawinski <jwz@netscape.com>
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
156 ; Added compatibility with Emacs 18.57.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
157 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
158 ; 25 Jan 91 Benjamin Pierce (bcp@cs.cmu.edu)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
159 ; Added facility for regular-expression matching of junk-mail
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
160 ; checklist. Set inhibit-local-variables to t inside of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
161 ; display-time-process-new-mail to prevent letterbombs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
162 ; (suggested by jwz).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
163 ;
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
164 ; 15 feb 91 Jamie Zawinski <jwz@netscape.com>
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
165 ; Made the values of display-time-message-separator and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
166 ; display-time-incoming-mail-file be initialized when this code
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
167 ; starts, instead of forcing the user to do it. This means that
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
168 ; this code can safely be dumped with emacs. Also, it now notices
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
169 ; when it's at CMU, and defaults to something reasonable. Removed
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
170 ; display-time-wait-hard, because I learned how to make echo-area
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
171 ; messages be persistent (not go away at the first key). I wish
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
172 ; GC messages didn't destroy it, though...
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
173 ;
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
174 ; 20 Dec 90 Jamie Zawinski <jwz@netscape.com>
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
175 ; Added new variables: display-time-no-file-means-no-mail,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
176 ; display-time-wait-hard, and display-time-junk-mail-ring-bell.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
177 ; Made display-time-message-separator be compared case-insensitively.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
178 ; Made the junk-mail checklist use a member-search rather than a
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
179 ; prefix-search.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
180 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
181 ; 22 Jul 90 Benjamin Pierce (bcp@cs.cmu.edu)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
182 ; Added support for debugging.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
183 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
184 ; 19 Jul 90 Benjamin Pierce (bcp@cs.cmu.edu)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
185 ; Improved user documentation and eliminated known CMU dependencies.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
186 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
187 ; 13 Jul 90 Mark Leone (mleone@cs.cmu.edu)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
188 ; Added display-time-use-xbiff option. Various layout changes.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
189 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
190 ; 20 May 90 Benjamin Pierce (bcp@proof)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
191 ; Fixed a bug that occasionally caused fields to be extracted
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
192 ; from the wrong buffer.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
193 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
194 ; 14 May 90 Benjamin Pierce (bcp@proof)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
195 ; Added concept of junk mail and ability to display message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
196 ; recipient in addition to sender and subject. (Major internal
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
197 ; reorganization was needed to implement this cleanly.)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
198 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
199 ; 18 Nov 89 Benjamin Pierce (bcp@proof)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
200 ; Fixed to work when display-time is called with
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
201 ; global-mode-string not a list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
202 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
203 ; 15 Jan 89 David Plaut (dcp@k)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
204 ; Added ability to discard load from displayed string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
205 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
206 ; To use: (setq display-time-load nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
207 ;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
208 ; Added facility for reporting incoming mail (modeled after gosmacs
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
209 ; reportmail.ml package written by Benjamin Pierce).
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
210
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
211 (require 'itimer) ; this is xemacs, so why conditionalize?
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
212 (require 'mail-extr)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
213
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
214 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
215 ;;; User Variables ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
216 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
217
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
218 (defvar display-time-announce-mail t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
219 "*Toggles whether name of mail sender is displayed in mode line.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
220
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
221 (defvar display-time-announce-junk-mail-too nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
222 "*When non-NIL, announce incoming junk mail as well as interesting mail")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
223
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
224 (defvar display-time-time t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
225 "*Toggles whether the time is displayed.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
226
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
227 (defvar display-time-load nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
228 "*Toggles whether machine load is displayed.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
229
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
230 (defvar display-time-day-and-date nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
231 "*Toggles whether day and date are displayed.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
232
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
233 (defvar display-time-mail-ring-bell nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
234 "*Toggles whether bell is rung on mail arrival.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
235
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
236 (defvar display-time-junk-mail-ring-bell nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
237 "*Toggles whether bell is rung on junk mail arrival.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
238 If display-time-mail-ring-bell is nil, this variable is ignored.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
239
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
240 (defvar display-time-my-addresses nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
241 "*Report the addressee of incoming mail in the message announcement,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
242 unless it appears in this list (See also display-time-match-using-regexps.)")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
243 ;; For example:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
244 ;; (setq display-time-my-addresses
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
245 ;; '("Benjamin.Pierce" "bcp" "Benjamin Pierce" "Benjamin C. Pierce"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
246
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
247 (defvar display-time-junk-mail-checklist nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
248 "*A list of lists of strings. In each sublist, the first component is the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
249 name of a message field and the rest are values that flag a piece of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
250 junk mail. If an entry begins with the character ^ it is matched as
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
251 a regular expression rather than an exact prefix of the given header
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
252 field. (See also display-time-match-using-regexps.)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
253
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
254 Note: elements of display-time-my-addresses are NOT automatically
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
255 included in display-time-junk-mail-checklist")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
256 ;; For example:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
257 ;; (setq display-time-junk-mail-checklist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
258 ;; '(("From" "bcp" "Benjamin Pierce" "Benjamin.Pierce"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
259 ;; "Mail Delivery Subsystem" "network" "daemon@bartok")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
260 ;; ("To" "sml-request" "sml-redistribution-request" "computermusic"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
261 ;; "scheme" "TeXhax-Distribution-list")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
262 ;; ("Resent-From" "Benjamin.Pierce")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
263 ;; ("Sender" "WRITERS" "Haskell" "Electronic Music Digest" "NEW-LIST")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
264
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
265 (defvar display-time-match-using-regexps nil "*When non-nil, elements of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
266 display-time-junk-mail-checklist and display-time-my-addresses are matched
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
267 as regular expressions instead of literal prefixes of header fields.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
268
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
269 (defvar display-time-max-from-length 35
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
270 "*Truncate sender name to this length in mail announcements")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
271
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
272 (defvar display-time-max-to-length 11
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
273 "*Truncate addressee name to this length in mail announcements")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
274
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
275 (defvar display-time-interval 30
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
276 "*Seconds between updates of time in the mode line. Also used
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
277 as interval for checking incoming mail.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
278
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
279 (defvar display-time-no-file-means-no-mail t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
280 "*Set this to T if you are on a system which deletes your mail-spool file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
281 when there is no new mail.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
282
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
283 (defvar display-time-incoming-mail-file nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
284 "*User's incoming mail file. Default is value of environment variable MAIL,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
285 if set; otherwise /usr/spool/mail/$USER is used.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
286
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
287 (defvar display-time-message-separator nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
288
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
289 (defvar display-time-flush-echo-area nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
290 "*If true, then display-time's echo-area message will be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
291 automatically cleared when display-time-interval has expired.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
292
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
293 (defvar display-time-use-xbiff nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
294 "*If set, display-time uses xbiff to announce new mail.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
295
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
296 (defvar display-time-xbiff-program "xbiff") ; xbiff++ if you're cool
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
297
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
298 (defvar display-time-xbiff-arg-list nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
299 "*List of arguments passed to xbiff. Useful for setting geometry, etc.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
300 ;;; For example:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
301 ;;; (setq display-time-xbiff-arg-list '("-update" "30" "-geometry" "+0+0"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
302
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
303 (defvar display-time-mail-arrived-file nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
304 "New mail announcements saved in this file if xbiff used. Deleted when
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
305 mail is read. Xbiff is used to monitor existence of this file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
306 This file will contain the headers (and only the headers) of all of the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
307 messages in your inbox. If you do not wish this to be readable by others,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
308 you should name a file here which is in a protected directory. Protecting
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
309 the file itself is not sufficient, because the file gets deleted and
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
310 recreated, and emacs does not make it easy to create protected files.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
311
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
312 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
313 ;;; Internal Variables ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
314 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
315
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
316 (defvar display-time-loadst-process nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
317 "The process providing time, load, and mail info.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
318
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
319 (defvar display-time-xbiff-process nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
320 "The xbiff process used to announce incoming mail.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
321
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
322 (defvar display-time-string nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
323 "Time displayed in mode line")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
324
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
325 (defvar display-time-mail-buffer-name "*reportmail*"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
326 "Name of buffer used for announcing mail.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
327
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
328 (defvar display-time-may-need-to-reset t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
329 "Set to NIL when display-time-total-reset has not been called
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
330 since the last time we changed from having mail in the queue to an empty
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
331 queue.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
332
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
333 (defvar display-time-debugging nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
334 "*When non-NIL, reportmail records various status information
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
335 as it's working.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
336
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
337 (defvar display-time-debugging-delay nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
338 "*When non-nil and display-time-debugging is set, sit for this
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
339 long after displaying each debugging message in mode line")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
340
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
341 (defvar display-time-debugging-buffer "*Reportmail-Debugging*"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
342 "Status messages are appended here.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
343
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
344 (defvar display-time-max-debug-info 20000
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
345 "Maximum size of debugging buffer")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
346
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
347 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
348 ;;; Macros ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
349 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
350
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
351 (defmacro display-time-del-file (filename)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
352 (list 'if (list 'file-exists-p filename) (list 'delete-file filename)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
353
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
354 (defmacro display-time-debug (mesg &rest args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
355 (list
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
356 'if 'display-time-debugging
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
357 (list 'display-time-debug-mesg
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
358 (append (list 'format mesg) args))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
359
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
360 (defun display-time-init ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
361 ;; If the mail-file isn't set, figure it out.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
362 (or display-time-incoming-mail-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
363 (setq display-time-incoming-mail-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
364 (or (getenv "MAIL")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
365 (let ((user-name (or (getenv "USER") (user-login-name))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
366 (and user-name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
367 (cond ((file-directory-p "/usr/spool/mail/") ; bsd
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
368 (concat "/usr/spool/mail/" user-name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
369 ((file-directory-p "/var/mail/") ; sysv
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
370 (concat "/usr/spool/mail/" user-name)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
371 "")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
372 ;; If the message-separator isn't set, set it to "From " unless
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
373 ;; the local hostname ends in ".CMU.EDU", where "^C" is used.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
374 (or display-time-message-separator
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
375 (setq display-time-message-separator
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
376 (let ((case-fold-search t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
377 (if (string-match "\\.cmu\\.edu" (system-name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
378 "\^C"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
379 "From "))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
380 ;; if this isn't set, these are probably right...
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
381 (or display-time-my-addresses
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
382 (setq display-time-my-addresses
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
383 (list (user-full-name) (user-login-name))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
384 ;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
385 (or display-time-mail-arrived-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
386 (setq display-time-mail-arrived-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
387 (expand-file-name ".mail-arrived" (getenv "HOME"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
388 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
389
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
390 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
391 ;;; Time Display ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
392 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
393
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
394 (defun display-time-kill ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
395 "Kill all display-time processes. Done automatically if display-time
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
396 is re-invoked."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
397 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
398 (display-time-debug "display-time-kill")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
399 (if display-time-loadst-process (delete-process display-time-loadst-process))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
400 (if display-time-xbiff-process (delete-process display-time-xbiff-process))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
401 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
402
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
403 (defun display-time ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
404 "Displays current time, date, load level, and incoming mail status in
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
405 mode line of each buffer (if corresponding user variables are set)."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
406 (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
407 (display-time-debug "display-time")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
408 (display-time-init)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
409 (let ((process-connection-type nil)) ; UIUCDCS mod
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
410 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
411 (display-time-kill)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
412 (if (or (string-equal "" display-time-incoming-mail-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
413 (and (not display-time-no-file-means-no-mail)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
414 (not (file-exists-p display-time-incoming-mail-file))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
415 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
416 (message "Reportmail: mail spool file \"%s\" not found"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
417 display-time-incoming-mail-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
418 (sit-for 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
419 (beep)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
420 (if (not global-mode-string) (setq global-mode-string '("")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
421 (if (not (listp global-mode-string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
422 (setq global-mode-string (list global-mode-string " ")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
423 (if (not (memq 'display-time-string global-mode-string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
424 (setq global-mode-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
425 (append global-mode-string '(display-time-string))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
426 (setq display-time-string "time and load")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
427
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
428 (let ((old (get-itimer "display-time")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
429 (if old (delete-itimer old))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
430 (start-itimer "display-time" 'display-time-timer-function
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
431 display-time-interval display-time-interval)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
432 (display-time-timer-function))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
433
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
434 (if display-time-use-xbiff
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
435 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
436 (display-time-del-file display-time-mail-arrived-file)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
437 (setq display-time-xbiff-process
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
438 (apply 'start-process "display-time-xbiff" nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
439 display-time-xbiff-program
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
440 "-file" display-time-mail-arrived-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
441 display-time-xbiff-arg-list))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
442 (process-kill-without-query display-time-xbiff-process)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
443 (sit-for 1) ; Need time to see if xbiff fails.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
444 (if (/= 0 (process-exit-status display-time-xbiff-process))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
445 (error "Display time: xbiff failed. Check xbiff-arg-list"))))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
446 (display-time-total-reset))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
447
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
448 (defun display-time-timer-function ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
449 ;; was: (defun display-time-filter-18-57 (proc string) ; args are ignored
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
450 ;; but we're not supporting version 18 here and I'm trimming excess
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
451 (save-match-data
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
452 (display-time-debug "display-time-timer-function")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
453 (if display-time-flush-echo-area
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
454 (progn
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
455 (display-time-debug "flush echo area")
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
456 (display-time-message "")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
457 (let ((mailp (and (file-exists-p display-time-incoming-mail-file)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
458 (not (eq 0 (nth 7 (file-attributes
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
459 display-time-incoming-mail-file)))))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
460 (if display-time-announce-mail
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
461 (if mailp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
462 (display-time-process-new-mail)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
463 (display-time-total-reset)))
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
464 ;; Format the mode line time display
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
465 (let ((time-string (if mailp
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
466 (if display-time-announce-mail
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
467 display-time-mail-modeline
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
468 "Mail "))))
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
469 (if display-time-time
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
470 (let* ((time (current-time-string))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
471 (hour (read (substring time 11 13)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
472 (pm (>= hour 12)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
473 (if (> hour 12) (setq hour (- hour 12)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
474 (if (= hour 0) (setq hour 12))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
475 (setq time-string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
476 (concat time-string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
477 (format "%d" hour) (substring time 13 16)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
478 (if pm "pm " "am ")))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
479 (if display-time-day-and-date
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
480 (setq time-string
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
481 (concat time-string
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
482 (substring (current-time-string) 0 11))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
483 (if display-time-load
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
484 (setq time-string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
485 (concat time-string
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
486 (condition-case ()
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
487 (let* ((la (car (load-average)))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
488 (load (if (zerop la)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
489 nil
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
490 (format "%03d" la))))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
491 (if load
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
492 (concat (substring load 0 -2)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
493 "." (substring load -2))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
494 ""))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
495 (error "load-error"))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
496 " ")))
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
497 ;; Install the new time for display.
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
498 (setq display-time-string time-string)
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
499 (force-mode-line-update t)))))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
500
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
501 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
502 ;;; Mail processing ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
503 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
504
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
505 (defvar display-time-mail-who-from ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
506 "Short-form name of sender of last piece of interesting unread mail")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
507
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
508 (defvar display-time-mail-modeline ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
509 "Terse mail announcement (displayed in modeline)")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
510
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
511 (defvar display-time-previous-mail-buffer-max 1
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
512 "The length of the mail buffer the last time we looked at it")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
513
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
514 (defvar display-time-msg-count 0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
515 "How many interesting messages have arrived")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
516
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
517 (defvar display-time-junk-msg-count 0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
518 "How many junk messages have arrived")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
519
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
520 (defvar display-time-last-message nil) ; enormous hack
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
521
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
522
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
523 ;; A test procedure for trying out new display-time features
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
524 ;(defun display-time-test ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
525 ; (interactive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
526 ; (display-time-reset-mail-processing)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
527 ; (display-time-process-new-mail))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
528
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
529 (defun display-time-manual-reset ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
530 "Utility function to be called externally to make reportmail notice
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
531 that things may have changed."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
532 (display-time-debug "Manual reset")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
533 (display-time-timer-function))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
534
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
535 (defun display-time-total-reset ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
536 (display-time-debug "display-time-total-reset")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
537 (if display-time-may-need-to-reset
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
538 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
539 (setq display-time-may-need-to-reset nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
540 (display-time-debug "Resetting mail processing")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
541 (let ((mail-buffer (get-buffer display-time-mail-buffer-name)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
542 (cond (mail-buffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
543 ;; unmodify it before killing it in case it has accidentally
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
544 ;; been typed in to.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
545 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
546 (set-buffer mail-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
547 (set-buffer-modified-p nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
548 (kill-buffer mail-buffer))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
549 (if display-time-use-xbiff
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
550 ;; This function is only called when no mail is in the spool.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
551 ;; Hence we should delete the mail-arrived file.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
552 (display-time-del-file display-time-mail-arrived-file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
553 (display-time-reset)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
554 )))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
555
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
556 (defun display-time-reset ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
557 (display-time-debug "display-time-reset")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
558 (setq display-time-msg-count 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
559 (setq display-time-junk-msg-count 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
560 (setq display-time-mail-who-from "Junk mail")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
561 (setq display-time-mail-modeline "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
562 (setq display-time-previous-mail-buffer-max 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
563 (display-time-message "") ; clear the echo-area.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
564 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
565
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
566 (defun display-time-process-new-mail ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
567 (setq display-time-may-need-to-reset t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
568 (let ((mail-buffer (get-buffer display-time-mail-buffer-name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
569 (inhibit-local-variables t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
570 (enable-local-variables nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
571 (if (not (and mail-buffer (verify-visited-file-modtime mail-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
572 (save-window-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
573 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
574 (display-time-debug "Spool file has changed... rereading...")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
575 (cond (mail-buffer
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
576 ;; unmodify it before killing it in case it has accidentally
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
577 ;; been typed in to.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
578 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
579 (set-buffer mail-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
580 (set-buffer-modified-p nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
581 (kill-buffer mail-buffer))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
582 ;; Change to pop-to-buffer when we're debugging:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
583 (set-buffer (get-buffer-create display-time-mail-buffer-name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
584 (buffer-disable-undo (current-buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
585 (erase-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
586 (condition-case nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
587 ;; I wish we didn't have to mark the buffer as visiting the file,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
588 ;; since that interferes with the user's ability to use find-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
589 ;; on their spool file, but there's no way to simulate what
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
590 ;; verify-visited-file-modtime does. Lose lose.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
591 (let ((buffer-read-only nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
592 (insert-file-contents display-time-incoming-mail-file t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
593 (file-error nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
594 ;; this buffer belongs to us; hands off.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
595 (setq buffer-read-only t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
596 (display-time-process-mail-buffer)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
597
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
598 (defun display-time-process-mail-buffer ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
599 (if (< display-time-previous-mail-buffer-max (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
600 (let ((case-fold-search nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
601 (goto-char display-time-previous-mail-buffer-max)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
602 (if (not (looking-at
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
603 (regexp-quote display-time-message-separator)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
604 (display-time-reset)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
605 (display-time-reset))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
606 (goto-char display-time-previous-mail-buffer-max)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
607 (if display-time-use-xbiff
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
608 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
609 (set-buffer (get-buffer-create " *reportmail-tmp*"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
610 (erase-buffer)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
611 (let ((case-fold-search nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
612 (start (point))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
613 end junkp ring-bell)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
614 (while (not (eobp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
615 (if (search-forward (concat "\n" display-time-message-separator)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
616 nil 'end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
617 (setq end (1+ (match-beginning 0)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
618 (setq end (point-max)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
619 (narrow-to-region start end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
620 (setq junkp (display-time-process-this-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
621 (if (and display-time-mail-ring-bell (not ring-bell))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
622 (setq ring-bell (if junkp display-time-junk-mail-ring-bell t)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
623 (widen)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
624 (goto-char (if (= end (point-max)) (point-max) (1+ end)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
625 (setq start end))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
626
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
627 (if ring-bell
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
628 (if (string-match "XEmacs" emacs-version)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
629 (beep nil 'reportmail)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
630 (beep))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
631
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
632 (if display-time-use-xbiff
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
633 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
634 (set-buffer (get-buffer-create " *reportmail-tmp*"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
635 (if (zerop (buffer-size))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
636 nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
637 (write-region (point-min) (point-max)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
638 display-time-mail-arrived-file
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
639 t 'nomsg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
640 (erase-buffer)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
641 ; ;; there's no way to get append-to-file to not dump the message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
642 ; ;; "Wrote file ..." in the echo area, so re-write the last message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
643 ; ;; we intended to write.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
644 ; (if display-time-last-message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
645 ; (display-time-message "%s" display-time-last-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
646 )))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
647
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
648 (setq display-time-previous-mail-buffer-max (point-max)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
649
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
650 (defun display-time-process-this-message ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
651 (display-time-debug "display-time-process-this-message")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
652 (let ((junk-p (display-time-junk-message)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
653 (if junk-p
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
654 (display-time-process-junk-message)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
655 (display-time-process-good-message))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
656 ;; Update mode line contents
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
657 (setq display-time-mail-modeline
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
658 (concat "[" (display-time-format-msg-count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
659 display-time-mail-who-from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
660 "] "))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
661 (display-time-debug "New mode line: %s " display-time-mail-modeline)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
662 junk-p))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
663
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
664 (defun display-time-junk-message ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
665 "Check to see whether this message is interesting"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
666
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
667 (display-time-debug "Comparing current message to junk mail checklist")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
668
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
669 (let ((checklist display-time-junk-mail-checklist)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
670 (junk nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
671 (while (and checklist (not junk))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
672 (if (display-time-member
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
673 (display-time-get-field (car (car checklist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
674 (cdr (car checklist)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
675 (setq junk t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
676 (setq checklist (cdr checklist))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
677 junk))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
678
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
679 (defun display-time-message (&rest message-args)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
680 (let ((str (apply 'format message-args))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
681 (in-echo-area-already (eq (selected-window) (minibuffer-window))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
682 (setq display-time-last-message str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
683 ;; don't stomp the echo-area-buffer if reading from the minibuffer now.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
684 (display-time-debug "display-time-message (%s)" str)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
685 (if (not in-echo-area-already)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
686 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
687 (save-window-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
688 (display-time-debug "Overwriting echo area with message")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
689 (select-window (minibuffer-window))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
690 (delete-region (point-min) (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
691 (insert str))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
692 ;; if we're reading from the echo-area, and all we were going to do is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
693 ;; clear the thing, like, don't bother, that's annoying.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
694 (if (and in-echo-area-already (string= "" str))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
695 nil
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
696 ;; XEmacs version fix
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
697 (if (and (string= str "") (not (string-match "^18" emacs-version)))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
698 (message nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
699 (message "%s" str)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
700
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
701 (defun display-time-process-good-message ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
702 (display-time-debug "Formatting message announcement (good message)")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
703
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
704 ;; Update the message counter
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
705 (setq display-time-msg-count (+ display-time-msg-count 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
706
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
707 ;; Format components of announcement
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
708 (let* ((subject (display-time-get-field "Subject" ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
709 (from (display-time-get-field "From" ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
710 (to (display-time-get-field "To" ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
711 (print-subject (if (string= subject "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
712 ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
713 (concat " (" subject ")")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
714 (print-from (display-time-truncate from display-time-max-from-length))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
715 (short-from (display-time-truncate
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
716 (display-time-extract-short-addr from) 25))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
717 (print-to (if (display-time-member to display-time-my-addresses)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
718 ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
719 (display-time-truncate
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
720 (display-time-extract-short-addr to)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
721 display-time-max-to-length))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
722
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
723 ;; Announce message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
724 (let ((msg (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
725 (display-time-format-msg-count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
726 "Mail "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
727 (if (string= print-to "") ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
728 (concat "to " print-to " "))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
729 "from " print-from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
730 print-subject)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
731 (if display-time-use-xbiff
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
732 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
733 (let* ((tmp-buf (get-buffer-create " *reportmail-tmp*"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
734 (buf (current-buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
735 (start (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
736 (end (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
737 (goto-char start)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
738 (search-forward "\n\n" nil 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
739 (point))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
740 (set-buffer tmp-buf)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
741 (goto-char (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
742 (insert-buffer-substring buf start end)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
743 (insert "\n\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
744 )))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
745 (display-time-debug "Message: %s" msg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
746 (display-time-message "%s" msg))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
747 ;; Update mode line information
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
748 (setq display-time-mail-who-from short-from)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
749
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
750 (defun display-time-process-junk-message ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
751 (display-time-debug "Formatting message announcement (junk message)")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
752
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
753 ;; Update the message counter
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
754 (setq display-time-junk-msg-count (+ display-time-junk-msg-count 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
755
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
756 ;; Format components of announcement
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
757 (let* ((subject (display-time-get-field "Subject" ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
758 (from (display-time-get-field "From" ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
759 (to (display-time-get-field "To" ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
760 (print-subject (if (string= subject "")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
761 ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
762 (concat " (" subject ")")))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
763 (print-from (display-time-truncate from display-time-max-from-length))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
764 (print-to (if (display-time-member to display-time-my-addresses)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
765 ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
766 (display-time-truncate
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
767 (display-time-extract-short-addr to)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
768 display-time-max-to-length))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
769
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
770 ;; Announce message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
771 (if display-time-announce-junk-mail-too
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
772 (let ((msg (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
773 (display-time-format-msg-count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
774 "Junk Mail "
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
775 (if (string= print-to "") ""
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
776 (concat "to " print-to " "))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
777 "from " print-from
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
778 print-subject)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
779 (display-time-message "%s" msg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
780 (display-time-debug "Message: %s" msg)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
781
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
782 (defun display-time-format-msg-count ()
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
783 (if (> (+ display-time-msg-count display-time-junk-msg-count) 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
784 (concat
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
785 (int-to-string display-time-msg-count)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
786 (if (> display-time-junk-msg-count 0)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
787 (concat "(" (int-to-string display-time-junk-msg-count) ")"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
788 ": ")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
789 ""))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
790
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
791 (defun display-time-get-field (field &optional default)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
792 (cond ((not (equal (buffer-name) display-time-mail-buffer-name))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
793 (beep)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
794 (message "reportmail bug: processing buffer %s, not %s"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
795 (buffer-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
796 display-time-mail-buffer-name)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
797 (sit-for 2)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
798 (goto-char (point-min))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
799 (let* ((case-fold-search t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
800 (result
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
801 (if (re-search-forward (concat "^" field ":[ |\C-i]*") nil t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
802 (let ((start (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
803 (end-of-line)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
804 (while (looking-at "\n[ \t]")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
805 (forward-line 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
806 (end-of-line))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
807 (buffer-substring start (point)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
808 (or default "<unknown>"))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
809 (display-time-debug "value of %s field is %s" field result)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
810 result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
811
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
812 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
813 ;;; Auxilliary Functions ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
814 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
815
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
816 (defun display-time-member (e l)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
817 "Is string E matched by an element of list L?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
818 When an element of L begins with ^, match it as a regexp. Otherwise,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
819 ignore case and match exactly. If display-time-match-using-regexps is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
820 non-nil, always match using regexps."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
821 (let ((done nil)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
822 (result nil))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
823 (while (not done)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
824 (cond
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
825 ((null l) (setq done t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
826 ((or display-time-match-using-regexps (= (elt (car l) 0) ?^))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
827 (if (string-match (car l) e)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
828 (setq result l done t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
829 (setq l (cdr l))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
830 ((string-match (regexp-quote (downcase (car l))) (downcase e))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
831 (setq result l done t))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
832 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
833 (setq l (cdr l)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
834 result))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
835
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
836 (defun display-time-truncate (s max)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
837 (if (and s (>= (length s) max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
838 (concat (substring s 0 max) "\\")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
839 s))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
840
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
841 (defun display-time-extract-short-addr (long-addr)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
842 (let ((result (and (fboundp 'mail-extract-address-components)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
843 (mail-extract-address-components long-addr))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
844 (or (nth 0 result) ; hairily extracted real name
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
845 (let ((name "\\([A-Za-z0-9-_+\\. ]+\\)"))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
846 (setq long-addr (or (nth 2 result) long-addr))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
847 (if (or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
848 ;; David Plaut <dcp@CS.CMU.EDU> -> David Plaut
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
849 ;; (doesn't happen if mail-extr loaded)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
850 (string-match (concat name "[ | ]+<.+>") long-addr)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
851
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
852 ;; anything (David Plaut) anything -> David Plaut
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
853 ;; (doesn't happen if mail-extr loaded)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
854 (string-match ".+(\\(.+\\)).*" long-addr)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
855
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
856 ;; plaut%address.bitnet@vma.cc.cmu.edu -> plaut
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
857 (string-match (concat name "%.+@.+") long-addr)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
858
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
859 ;; random!uucp!addresses!dcp@uu.relay.net -> dcp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
860 (string-match (concat ".*!" name "@.+") long-addr)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
861
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
862 ;; David.Plaut@CS.CMU.EDU -> David.Plaut
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
863 (string-match (concat name "@.+") long-addr)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
864 )
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
865 (substring long-addr (match-beginning 1) (match-end 1))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
866 long-addr)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
867
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
868 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
869 ;;; Debugging Support ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
870 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
871
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
872 (defvar display-time-debugging-messages nil
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
873 "When non-NIL, reportmail displays status messages in real time.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
874
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
875 (defun display-time-debug-mesg (mesg)
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 24
diff changeset
876 (save-match-data
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
877 (if display-time-debugging-messages
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
878 (progn
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
879 (message "Reportmail: %s" mesg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
880 (sit-for 1)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
881 ))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
882 (save-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
883 (save-window-excursion
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
884 (set-buffer (get-buffer-create display-time-debugging-buffer))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
885 (goto-char (point-max))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
886 (insert (substring (current-time-string) 11 16) " " mesg "\n")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
887 ;; Make sure the debugging buffer doesn't get out of hand
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
888 (if (> (point-max) display-time-max-debug-info)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
889 (delete-region (point-min)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
890 (- (point-max) display-time-max-debug-info)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
891 (if display-time-debugging-delay
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
892 (progn (message "Reportmail: %s" mesg)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
893 (sit-for display-time-debugging-delay)))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
894
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
895 (provide 'reportmail)