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