diff lisp/mu/std11.el @ 8:4b173ad71786 r19-15b5

Import from CVS: tag r19-15b5
author cvs
date Mon, 13 Aug 2007 08:47:35 +0200
parents b82b59fe008d
children ec9a17fef872
line wrap: on
line diff
--- a/lisp/mu/std11.el	Mon Aug 13 08:47:16 2007 +0200
+++ b/lisp/mu/std11.el	Mon Aug 13 08:47:35 2007 +0200
@@ -4,7 +4,7 @@
 
 ;; Author:   MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Keywords: mail, news, RFC 822, STD 11
-;; Version: $Id: std11.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $
+;; Version: $Id: std11.el,v 1.2 1996/12/22 00:29:20 steve Exp $
 
 ;; This file is part of MU (Message Utilities).
 
@@ -200,37 +200,48 @@
 ;;; @ quoted-string
 ;;;
 
+(defun std11-wrap-as-quoted-pairs (string specials)
+  (let (dest
+	(i 0)
+	(b 0)
+	(len (length string))
+	)
+    (while (< i len)
+      (let ((chr (aref string i)))
+	(if (memq chr specials)
+	    (setq dest (concat dest (substring string b i) "\\")
+		  b i)
+	  ))
+      (setq i (1+ i))
+      )
+    (concat dest (substring string b))
+    ))
+
 (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
 
 (defun std11-wrap-as-quoted-string (string)
   "Wrap STRING as RFC 822 quoted-string. [std11.el]"
   (concat "\""
-	  (mapconcat (function
-		      (lambda (chr)
-			(if (memq chr std11-non-qtext-char-list)
-			    (concat "\\" (char-to-string chr))
-			  (char-to-string chr)
-			  )
-			)) string "")
+	  (std11-wrap-as-quoted-pairs string std11-non-qtext-char-list)
 	  "\""))
 
-(defun std11-strip-quoted-pair (str)
-  (let ((dest "")
+(defun std11-strip-quoted-pair (string)
+  "Strip quoted-pairs in STRING. [std11.el]"
+  (let (dest
+	(b 0)
 	(i 0)
-	(len (length str))
-	chr flag)
+	(len (length string))
+	)
     (while (< i len)
-      (setq chr (aref str i))
-      (if (or flag (not (eq chr ?\\)))
-	  (progn
-	    (setq dest (concat dest (char-to-string chr)))
-	    (setq flag nil)
-	    )
-	(setq flag t)
-	)
-      (setq i (+ i 1))
-      )
-    dest))
+      (let ((chr (aref string i)))
+	(if (eq chr ?\\)
+	    (setq dest (concat dest (substring string b i))
+		  b (1+ i)
+		  i (+ i 2))
+	  (setq i (1+ i))
+	  )))
+    (concat dest (substring string b))
+    ))
 
 (defun std11-strip-quoted-string (string)
   "Strip quoted-string STRING. [std11.el]"
@@ -294,13 +305,28 @@
 	       (comment (nth 2 address))
 	       phrase)
 	   (if (eq (car addr) 'phrase-route-addr)
-	       (setq phrase (mapconcat (function
-					(lambda (token)
-					  (cdr token)
-					  ))
-				       (nth 1 addr) ""))
+	       (setq phrase
+		     (mapconcat
+		      (function
+		       (lambda (token)
+			 (let ((type (car token)))
+			   (cond ((eq type 'quoted-string)
+				  (std11-strip-quoted-pair (cdr token))
+				  )
+				 ((eq type 'comment)
+				  (concat
+				   "("
+				   (std11-strip-quoted-pair (cdr token))
+				   ")")
+				  )
+				 (t
+				  (cdr token)
+				  )))))
+		      (nth 1 addr) ""))
 	     )
-	   (or phrase comment)
+	   (cond ((> (length phrase) 0) phrase)
+		 (comment (std11-strip-quoted-pair comment))
+		 )
 	   ))))