Mercurial > hg > xemacs-beta
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)) + ) ))))