X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/2f043267ee5d544100fdf62f54e38b72fdf08216..77ab81d0545e980c57c0a35510ade29a9e43b4cd:/lisp/mail/rfc822.el diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el index c641253665..ddaf762598 100644 --- a/lisp/mail/rfc822.el +++ b/lisp/mail/rfc822.el @@ -1,7 +1,7 @@ ;;; rfc822.el --- hairy rfc822 parser for mail and news and suchlike ;; Copyright (C) 1986, 1987, 1990, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. ;; Author: Richard Mlynarik ;; Maintainer: FSF @@ -9,10 +9,10 @@ ;; 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 3, 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 @@ -20,9 +20,7 @@ ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -280,44 +278,51 @@ (list (substring header-text (match-beginning 1) (match-end 1))) (let ((buf (generate-new-buffer " rfc822"))) (unwind-protect - (save-excursion - (set-buffer buf) - (make-local-variable 'case-fold-search) - (setq case-fold-search nil) ;For speed(?) - (insert header-text) - ;; unfold continuation lines - (goto-char (point-min)) + (with-current-buffer buf + (make-local-variable 'case-fold-search) + (setq case-fold-search nil) ;For speed(?) + (insert header-text) + ;; unfold continuation lines + (goto-char (point-min)) - (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t) - (replace-match "\\1 " t)) + (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" + nil t) + (replace-match "\\1 " t)) - (goto-char (point-min)) - (let ((list ()) - tem - rfc822-address-start); this is for rfc822-bad-address - (rfc822-nuke-whitespace) - (while (not (eobp)) - (setq rfc822-address-start (point)) - (setq tem - (catch 'address ; this is for rfc822-bad-address - (cond ((rfc822-looking-at ?\,) - nil) - ((looking-at "[][\000-\037@;:\\.>)]") - (forward-char) - (rfc822-bad-address - (format "Strange character \\%c found" - (preceding-char)))) - (t - (rfc822-addresses-1 t))))) - (cond ((null tem)) - ((stringp tem) - (setq list (cons tem list))) - (t - (setq list (nconc (nreverse tem) list))))) - (nreverse list))) - (and buf (kill-buffer buf)))))) + (goto-char (point-min)) + ;; Give `rfc822-address-start' a non-nil initial value to + ;; prevent `rfc822-bad-address' from raising a + ;; `wrong-type-argument' error. + (let* ((rfc822-address-start (point)) + list tem + (err + (catch 'address + ;; Note that `rfc822-nuke-whitespace' and + ;; `rfc822-looking-at' can throw. + (rfc822-nuke-whitespace) + (while (not (eobp)) + (setq rfc822-address-start (point)) + (setq tem + (cond ((rfc822-looking-at ?\,) + nil) + ((looking-at "[][\000-\037@;:\\.>)]") + (forward-char) + (catch 'address ; For rfc822-bad-address + (rfc822-bad-address + (format "Strange character \\%c found" + (preceding-char))))) + (t + (rfc822-addresses-1 t)))) + (cond ((null tem)) + ((stringp tem) + (setq list (cons tem list))) + (t + (setq list (nconc (nreverse tem) list))))) + nil))) + (nreverse (append (if err (list err)) list)))) + (and buf (kill-buffer buf)))))) (provide 'rfc822) -;;; arch-tag: 5d388a24-e173-40fb-9b8e-85269de44b37 +;; arch-tag: 5d388a24-e173-40fb-9b8e-85269de44b37 ;;; rfc822.el ends here