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