;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
(require 'lisp-mode)
;;;###autoload
-(defvar mail-use-rfc822 nil "\
+(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.")
+often correct parser."
+ :type 'boolean
+ :group 'mail)
;; Returns t if file FILE is an Rmail file.
;;;###autoload
(concat (substring string 0 start)
(substring string end nil))))
+(defun mail-quote-printable (string &optional wrapper)
+ "Convert a string to the \"quoted printable\" Q encoding.
+If the optional argument WRAPPER is non-nil,
+we add the wrapper characters =?ISO-8859-1?Q?....?=."
+ (let ((i 0) (result ""))
+ (save-match-data
+ (while (string-match "[?=\"\200-\377]" string i)
+ (setq result
+ (concat result (substring string i (match-beginning 0))
+ (upcase (format "=%02x"
+ (aref string (match-beginning 0))))))
+ (setq i (match-end 0)))
+ (if wrapper
+ (concat "=?ISO-8859-1?Q?"
+ result (substring string i)
+ "?=")
+ (concat result (substring string i))))))
+
+(defun mail-unquote-printable-hexdigit (char)
+ (if (>= char ?A)
+ (+ (- char ?A) 10)
+ (- char ?0)))
+
+(defun mail-unquote-printable (string &optional wrapper)
+ "Undo the \"quoted printable\" encoding.
+If the optional argument WRAPPER is non-nil,
+we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=."
+ (save-match-data
+ (and wrapper
+ (string-match "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?" string)
+ (setq string (match-string 1 string)))
+ (let ((i 0) (result ""))
+ (while (string-match "=\\(..\\)" string i)
+ (setq result
+ (concat result (substring string i (match-beginning 0))
+ (make-string 1
+ (+ (* 16 (mail-unquote-printable-hexdigit
+ (aref string (match-beginning 1))))
+ (mail-unquote-printable-hexdigit
+ (aref string (1+ (match-beginning 1))))))))
+ (setq i (match-end 0)))
+ (concat result (substring string i)))))
+
(defun mail-strip-quoted-names (address)
"Delete comments and quoted strings in an address list ADDRESS.
Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR.
(progn (require 'rfc822)
(mapconcat 'identity (rfc822-addresses address) ", "))
(let (pos)
- (string-match "\\`[ \t\n]*" address)
- ;; strip surrounding whitespace
- (setq address (substring address
- (match-end 0)
- (string-match "[ \t\n]*\\'" address
- (match-end 0))))
;; Detect nested comments.
- (if (string-match "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*(" address)
+ (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address)
;; Strip nested comments.
(save-excursion
(set-buffer (get-buffer-create " *temp*"))
(while (setq pos (string-match
;; This doesn't hack rfc822 nested comments
;; `(xyzzy (foo) whinge)' properly. Big deal.
- "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)"
+ "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)"
address))
(setq address
(mail-string-delete address
pos (match-end 0)))))
+ ;; strip surrounding whitespace
+ (string-match "\\`[ \t\n]*" address)
+ (setq address (substring address
+ (match-end 0)
+ (string-match "[ \t\n]*\\'" address
+ (match-end 0))))
+
;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>')
(setq pos 0)
(while (setq pos (string-match
- "[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*"
+ "\\([ \t]?\\)[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*"
address pos))
;; If the next thing is "@", we have "foo bar"@host. Leave it.
(if (and (> (length address) (match-end 0))
(setq pos (match-end 0))
(setq address
(mail-string-delete address
- pos (match-end 0)))))
+ (match-end 1) (match-end 0)))))
;; Retain only part of address in <> delims, if there is such a thing.
- (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,]*>\\)"
+ (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,:]*>\\)"
address))
(let ((junk-beg (match-end 1))
(junk-end (match-beginning 2))
(setq address (mail-string-delete address (1- close) close))
(setq address (mail-string-delete address junk-beg junk-end))))
address))))
-
-(or (and (boundp 'rmail-default-dont-reply-to-names)
- (not (null rmail-default-dont-reply-to-names)))
- (setq rmail-default-dont-reply-to-names "info-"))
; rmail-dont-reply-to-names is defined in loaddefs
(defun rmail-dont-reply-to (userids)
"")
(concat (regexp-quote (user-login-name))
"\\>"))))
- (let ((match (concat "\\(^\\|,\\)[ \t\n]*\\([^,\n]*!\\|\\)\\("
- rmail-dont-reply-to-names
+ (let ((match (concat "\\(^\\|,\\)[ \t\n]*"
+ ;; Can anyone figure out what this is for?
+ ;; Is it an obsolete remnant of another way of
+ ;; handling Foo Bar <foo@machine>?
+ "\\([^,\n]*[!<]\\|\\)"
+ "\\("
+ rmail-dont-reply-to-names
+ "\\|"
+ ;; Include the human name that precedes <foo@bar>.
+ "\\([^\,.<\"]\\|\"[^\"]*\"\\)*"
+ "<\\(" rmail-dont-reply-to-names "\\)"
"\\)"))
(case-fold-search t)
pos epos)
- (while (setq pos (string-match match userids))
- (if (> pos 0) (setq pos (1+ pos)))
+ (while (setq pos (string-match match userids pos))
+ (if (> pos 0) (setq pos (match-beginning 2)))
(setq epos
- (if (string-match "[ \t\n,]+" userids (match-end 0))
+ ;; Delete thru the next comma, plus whitespace after.
+ (if (string-match ",[ \t\n]*" userids (match-end 0))
(match-end 0)
(length userids)))
- (setq userids
- (mail-string-delete
- userids pos epos)))
+ ;; Count the double-quotes since the beginning of the list.
+ ;; Reject this match if it is inside a pair of doublequotes.
+ (let (quote-pos inside-quotes)
+ (while (and (setq quote-pos (string-match "\"" userids quote-pos))
+ (< quote-pos pos))
+ (setq quote-pos (1+ quote-pos))
+ (setq inside-quotes (not inside-quotes)))
+ (if inside-quotes
+ ;; Advance to next even-parity quote, and scan from there.
+ (setq pos (string-match "\"" userids pos))
+ (setq userids
+ (mail-string-delete
+ userids pos epos)))))
;; get rid of any trailing commas
(if (setq pos (string-match "[ ,\t\n]*\\'" userids))
(setq userids (substring userids 0 pos)))
userids)))
\f
;;;###autoload
-(defun mail-fetch-field (field-name &optional last all)
- "Return the value of the header field FIELD-NAME.
-The buffer is expected to be narrowed to just the headers of the message.
-If second arg LAST is non-nil, use the last such field if there are several.
-If third arg ALL is non-nil, concatenate all such fields with commas between."
+(defun mail-fetch-field (field-name &optional last all list)
+ "Return the value of the header field whose type is FIELD-NAME.
+The buffer is expected to be narrowed to just the header of the message.
+If second arg LAST is non-nil, use the last field of type FIELD-NAME.
+If third arg ALL is non-nil, concatenate all such fields with commas between.
+If 4th arg LIST is non-nil, return a list of all such fields."
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t)
(name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*")))
- (if all
- (let ((value ""))
+ (if (or all list)
+ (let ((value (if all "")))
(while (re-search-forward name nil t)
(let ((opoint (point)))
(while (progn (forward-line 1)
(looking-at "[ \t]")))
;; Back up over newline, then trailing spaces or tabs
(forward-char -1)
- (while (member (preceding-char) '(? ?\t))
- (forward-char -1))
- (setq value (concat value
- (if (string= value "") "" ", ")
- (buffer-substring-no-properties
- opoint (point))))))
- (and (not (string= value "")) value))
+ (skip-chars-backward " \t" opoint)
+ (if list
+ (setq value (cons (buffer-substring-no-properties
+ opoint (point))
+ value))
+ (setq value (concat value
+ (if (string= value "") "" ", ")
+ (buffer-substring-no-properties
+ opoint (point)))))))
+ (if list
+ value
+ (and (not (string= value "")) value)))
(if (re-search-forward name nil t)
(progn
(if last (while (re-search-forward name nil t)))
(looking-at "[ \t]")))
;; Back up over newline, then trailing spaces or tabs
(forward-char -1)
- (while (member (preceding-char) '(? ?\t))
- (forward-char -1))
+ (skip-chars-backward " \t" opoint)
(buffer-substring-no-properties opoint (point)))))))))
\f
;; Parse a list of tokens separated by commas.
(defun mail-parse-comma-list ()
(let (accumulated
beg)
- (skip-chars-forward " ")
+ (skip-chars-forward " \t\n")
(while (not (eobp))
(setq beg (point))
(skip-chars-forward "^,")
- (skip-chars-backward " ")
+ (skip-chars-backward " \t\n")
(setq accumulated
- (cons (buffer-substring beg (point))
+ (cons (buffer-substring-no-properties beg (point))
accumulated))
(skip-chars-forward "^,")
- (skip-chars-forward ", "))
+ (skip-chars-forward ", \t\n"))
accumulated))
(defun mail-comma-list-regexp (labels)