]> code.delx.au - gnu-emacs/blobdiff - lisp/mail/mail-utils.el
lisp/mail/rmail.el: Update autoload checksum.
[gnu-emacs] / lisp / mail / mail-utils.el
index 2311efc37ee9da81ced5e29a36fdf2c68d92c310..1c527f22113afbb683ed75bbee66877a1ad28198 100644 (file)
@@ -1,7 +1,7 @@
 ;;; mail-utils.el --- utility functions used both by rmail and rnews
 
 ;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;;   2009  Free Software Foundation, Inc.
+;;   2009, 2010  Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: mail, news
@@ -33,8 +33,8 @@
 (require 'lisp-mode)
 
 ;;;###autoload
-(defcustom mail-use-rfc822 nil "\
-*If non-nil, use a full, hairy RFC822 parser on mail addresses.
+(defcustom mail-use-rfc822 nil
+  "If non-nil, use a full, hairy RFC822 parser on mail addresses.
 Otherwise, (the default) use a smaller, somewhat faster, and
 often correct parser."
   :type 'boolean
@@ -43,13 +43,10 @@ often correct parser."
 ;; Returns t if file FILE is an Rmail file.
 ;;;###autoload
 (defun mail-file-babyl-p (file)
-  (let ((buf (generate-new-buffer " *rmail-file-p*")))
-    (unwind-protect
-       (save-excursion
-         (set-buffer buf)
-         (insert-file-contents file nil 0 100)
-         (looking-at "BABYL OPTIONS:"))
-      (kill-buffer buf))))
+  "Return non-nil if FILE is a Babyl file."
+  (with-temp-buffer
+    (insert-file-contents file nil 0 100)
+    (looking-at "BABYL OPTIONS:")))
 
 (defun mail-string-delete (string start end)
   "Returns a string containing all of STRING except the part
@@ -126,16 +123,21 @@ we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=."
        (setq i (match-end 0)))
       (apply 'concat (nreverse (cons (substring string i) strings))))))
 
+;; FIXME Gnus for some reason has `quoted-printable-decode-region' in qp.el.
 ;;;###autoload
 (defun mail-unquote-printable-region (beg end &optional wrapper noerror
                                          unibyte)
   "Undo the \"quoted printable\" encoding in buffer from BEG to END.
 If the optional argument WRAPPER is non-nil,
 we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=.
-If NOERROR is non-nil, return t if successful.
+On encountering malformed quoted-printable text, exits with an error,
+unless NOERROR is non-nil, in which case it continues, and returns nil
+when finished.  Returns non-nil on successful completion.
 If UNIBYTE is non-nil, insert converted characters as unibyte.
 That is useful if you are going to character code decoding afterward,
 as Rmail does."
+  ;; FIXME: `unibyte' should always be non-nil, and the iso-latin-1
+  ;; specific handling should be removed (or moved elsewhere and generalized).
   (interactive "r\nP")
   (let (failed)
     (save-match-data
@@ -247,6 +249,10 @@ Return a modified address list."
   "Prune addresses from DESTINATIONS, a list of recipient addresses.
 All addresses matching `rmail-dont-reply-to-names' are removed from
 the comma-separated list.  The pruned list is returned."
+  ;; FIXME this (setting a user option the first time a command is used)
+  ;; is somewhat strange.  Normally one would never set the option,
+  ;; but instead fall back to the default so long as it was nil.
+  ;; Or just set the default directly in the defcustom.
   (if (null rmail-dont-reply-to-names)
       (setq rmail-dont-reply-to-names
            (concat (if rmail-default-dont-reply-to-names
@@ -389,6 +395,20 @@ matches may be returned from the message body."
            (substring s (match-beginning 3) (match-end 3)) " "
            (mail-rfc822-time-zone time))))
 
+(defun mail-mbox-from ()
+  "Return an mbox \"From \" line for the current message.
+The buffer should be narrowed to just the header."
+  (let ((from (or (mail-fetch-field "from")
+                 (mail-fetch-field "really-from")
+                 (mail-fetch-field "sender")
+                 "unknown"))
+       (date (mail-fetch-field "date")))
+    (format "From %s %s\n" (mail-strip-quoted-names from)
+           (or (and date
+                    (ignore-errors
+                     (current-time-string (date-to-time date))))
+               (current-time-string)))))
+
 (provide 'mail-utils)
 
 ;; arch-tag: b24aec2f-fd65-4ceb-9e39-3cc2827036fd