X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fietf-drums.el;h=d846f8e8dfabeb56788b6586c90423a3a091000b;hb=db3bf8050c2867c4e32b8ae5d142ba4fb0421bd8;hp=c546316eb9d27929eed05b6463d1d9f89ed78d06;hpb=3935cea5f45657f855cc82795150c31fb7fd1513;p=gnus

diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el
index c546316eb..d846f8e8d 100644
--- a/lisp/ietf-drums.el
+++ b/lisp/ietf-drums.el
@@ -1,6 +1,7 @@
 ;;; ietf-drums.el --- Functions for parsing RFC822bis headers
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
@@ -17,8 +18,8 @@
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -27,6 +28,16 @@
 ;; Messages".  This library is based on
 ;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05.
 
+;; Pending a real regression self test suite, Simon Josefsson added
+;; various self test expressions snipped from bug reports, and their
+;; expected value, below.  I you believe it could be useful, please
+;; add your own test cases, or write a real self test suite, or just
+;; remove this.
+
+;; <m3oekvfd50.fsf@whitebox.m5r.de>
+;; (ietf-drums-parse-address "'foo' <foo@example.com>")
+;; => ("foo@example.com" . "'foo'")
+
 ;;; Code:
 
 (eval-when-compile (require 'cl))
@@ -64,9 +75,9 @@ backslash and doublequote.")
     (modify-syntax-entry ?> ")" table)
     (modify-syntax-entry ?@ "w" table)
     (modify-syntax-entry ?/ "w" table)
-    (modify-syntax-entry ?* " " table)
-    (modify-syntax-entry ?\; " " table)
-    (modify-syntax-entry ?\' " " table)
+    (modify-syntax-entry ?* "_" table)
+    (modify-syntax-entry ?\; "_" table)
+    (modify-syntax-entry ?\' "_" table)
     (if (featurep 'xemacs)
 	(let ((i 128))
 	  (while (< i 256)
@@ -88,14 +99,14 @@ backslash and doublequote.")
 	  (push c out)))
        (range
 	(while (<= b c)
-	  (push (mm-make-char 'ascii b) out)
+	  (push (make-char 'ascii b) out)
 	  (incf b))
 	(setq range nil))
        ((= i (length token))
-	(push (mm-make-char 'ascii c) out))
+	(push (make-char 'ascii c) out))
        (t
 	(when b
-	  (push (mm-make-char 'ascii b) out))
+	  (push (make-char 'ascii b) out))
 	(setq b c))))
     (nreverse out)))
 
@@ -133,7 +144,7 @@ backslash and doublequote.")
 	  (forward-sexp 1))
 	 ((eq c ?\()
 	  (forward-sexp 1))
-	 ((memq c '(? ?\t ?\n))
+	 ((memq c '(?\  ?\t ?\n))
 	  (delete-char 1))
 	 (t
 	  (forward-char 1))))
@@ -189,7 +200,9 @@ backslash and doublequote.")
 		  (buffer-substring
 		   (1+ (point))
 		   (progn (forward-sexp 1) (1- (point))))))))
-	 (t (error "Unknown symbol: %c" c))))
+	 (t
+	  (message "Unknown symbol: %c" c)
+	  (forward-char 1))))
       ;; If we found no display-name, then we look for comments.
       (if display-name
 	  (setq display-string
@@ -202,8 +215,10 @@ backslash and doublequote.")
 	     (ietf-drums-get-comment string)))
 	(cons mailbox display-string)))))
 
-(defun ietf-drums-parse-addresses (string)
-  "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
+(defun ietf-drums-parse-addresses (string &optional rawp)
+  "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs.
+If RAWP, don't actually parse the addresses, but instead return
+a list of address strings."
   (if (null string)
       nil
     (with-temp-buffer
@@ -220,20 +235,24 @@ backslash and doublequote.")
 	       (skip-chars-forward "^,"))))
 	   ((eq c ?,)
 	    (setq address
-		  (condition-case nil
-		      (ietf-drums-parse-address
-		       (buffer-substring beg (point)))
-		    (error nil)))
+		  (if rawp
+		      (buffer-substring beg (point))
+		    (condition-case nil
+			(ietf-drums-parse-address
+			 (buffer-substring beg (point)))
+		      (error nil))))
 	    (if address (push address pairs))
 	    (forward-char 1)
 	    (setq beg (point)))
 	   (t
 	    (forward-char 1))))
 	(setq address
-	      (condition-case nil
-		  (ietf-drums-parse-address
-		   (buffer-substring beg (point)))
-		(error nil)))
+	      (if rawp
+		  (buffer-substring beg (point))
+		(condition-case nil
+		    (ietf-drums-parse-address
+		     (buffer-substring beg (point)))
+		  (error nil))))
 	(if address (push address pairs))
 	(nreverse pairs)))))
 
@@ -263,6 +282,12 @@ backslash and doublequote.")
       (concat "\"" string "\"")
     string))
 
+(defun ietf-drums-make-address (name address)
+  (if name
+      (concat (ietf-drums-quote-string name) " <" address ">")
+    address))
+
 (provide 'ietf-drums)
 
+;;; arch-tag: 379a0191-dbae-4ca6-a0f5-d4202c209ef9
 ;;; ietf-drums.el ends here