;;; mail-utils.el --- utility functions used both by rmail and rnews
-;; Copyright (C) 1985, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;; 2009 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail, news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
"?=")
(concat result (substring string i))))))
+;;;###autoload
+(defun mail-quote-printable-region (beg end &optional wrapper)
+ "Convert the region to the \"quoted printable\" Q encoding.
+If the optional argument WRAPPER is non-nil,
+we add the wrapper characters =?ISO-8859-1?Q?....?=."
+ (interactive "r\nP")
+ (save-match-data
+ (save-excursion
+ (goto-char beg)
+ (save-restriction
+ (narrow-to-region beg end)
+ (while (re-search-forward "[?=\"\200-\377]" nil t)
+ (replace-match (upcase (format "=%02x" (preceding-char)))
+ t t))
+ (when wrapper
+ (goto-char beg)
+ (insert "=?ISO-8859-1?Q?")
+ (goto-char end)
+ (insert "?="))))))
+
(defun mail-unquote-printable-hexdigit (char)
+ (setq char (upcase char))
(if (>= char ?A)
(+ (- char ?A) 10)
(- char ?0)))
(apply 'concat (nreverse (cons (substring string i) strings))))))
;;;###autoload
-(defun mail-unquote-printable-region (beg end &optional wrapper)
+(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?....?=."
+we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=.
+If NOERROR is non-nil, return t if successful.
+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."
(interactive "r\nP")
- (save-match-data
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (when (and wrapper
- (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?"))
- (delete-region (match-end 1) end)
- (delete-region (point) (match-beginning 1)))
- (while (re-search-forward "=\\(..\\|\n\\)" nil t)
- (goto-char (match-end 0))
- (replace-match
- (if (= (char-after (match-beginning 1)) ?\n)
- ""
- (make-string 1
- (+ (* 16 (mail-unquote-printable-hexdigit
- (char-after (match-beginning 1))))
- (mail-unquote-printable-hexdigit
- (char-after (1+ (match-beginning 1)))))))
- t t))))))
+ (let (failed)
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (when (and wrapper
+ (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?"))
+ (delete-region (match-end 1) end)
+ (delete-region (point) (match-beginning 1)))
+ (while (re-search-forward "=\\(\\([0-9A-F][0-9A-F]\\)\\|[=\n]\\|..\\)" nil t)
+ (goto-char (match-end 0))
+ (cond ((= (char-after (match-beginning 1)) ?\n)
+ (replace-match ""))
+ ((= (char-after (match-beginning 1)) ?=)
+ (replace-match "="))
+ ((match-beginning 2)
+ (let ((char (+ (* 16 (mail-unquote-printable-hexdigit
+ (char-after (match-beginning 2))))
+ (mail-unquote-printable-hexdigit
+ (char-after (1+ (match-beginning 2)))))))
+ (if unibyte
+ (progn
+ (replace-match "")
+ ;; insert-byte will insert this as a
+ ;; corresponding eight-bit character.
+ (insert-byte char 1))
+ (replace-match (make-string 1 char) t t))))
+ (noerror
+ (setq failed t))
+ (t
+ (error "Malformed MIME quoted-printable message"))))
+ (not failed))))))
(eval-when-compile (require 'rfc822))
"")
(if (and user-mail-address
(not (equal user-mail-address user-login-name)))
- (concat (regexp-quote user-mail-address) "\\|")
+ ;; Anchor the login name and email address so
+ ;; that we don't match substrings: if the
+ ;; login name is "foo", we shouldn't match
+ ;; "barfoo@baz.com".
+ (concat "\\`"
+ (regexp-quote user-mail-address)
+ "\\'\\|")
"")
- (concat (regexp-quote user-login-name) "\\>"))))
+ (concat "\\`" (regexp-quote user-login-name) "@"))))
;; Split up DESTINATIONS and match each element separately.
(let ((start-pos 0) (cur-pos 0)
(case-fold-search t))
;;;###autoload
(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."
+If 4th arg LIST is non-nil, return a list of all such fields.
+The buffer should be narrowed to just the header, else false
+matches may be returned from the message body."
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t)
(provide 'mail-utils)
+;; arch-tag: b24aec2f-fd65-4ceb-9e39-3cc2827036fd
;;; mail-utils.el ends here
HCoop / bpt / emacs.git / blobdiff