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