X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=std11.el;h=1a70c5e50e2fc932ec48b7ba1ed1d62a44daf4f2;hb=778bc8332a0fe2579a270f0852a7ab9b21ee6c81;hp=220b8d3c0f5ae4a5bfa56e485e616952508a373c;hpb=96f4339afd68ceb8d09f3bf3d2686ed8c793b22e;p=elisp%2Fapel.git diff --git a/std11.el b/std11.el index 220b8d3..1a70c5e 100644 --- a/std11.el +++ b/std11.el @@ -1,10 +1,9 @@ ;;; std11.el --- STD 11 functions for GNU Emacs -;; Copyright (C) 1995,1996 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: mail, news, RFC 822, STD 11 -;; Version: $Id: std11.el,v 0.29 1996-09-08 18:03:51 morioka Exp $ ;; This file is part of MU (Message Utilities). @@ -19,8 +18,8 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with This program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; 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. ;;; Code: @@ -28,6 +27,10 @@ (autoload 'buffer-substring-no-properties "emu") (autoload 'member "emu") +(eval-when-compile + (provide 'std11) + (require 'std11-parse)) + ;;; @ field ;;; @@ -113,8 +116,11 @@ header separator. [std11.el]" (defun std11-unfold-string (string) "Unfold STRING as message header field. [std11.el]" (let ((dest "")) - (while (string-match "\n\\s +" string) - (setq dest (concat dest (substring string 0 (match-beginning 0)) " ")) + (while (string-match "\n\\([ \t]\\)" string) + (setq dest (concat dest + (substring string 0 (match-beginning 0)) + (match-string 1 string) + )) (setq string (substring string (match-end 0))) ) (concat dest string) @@ -197,20 +203,60 @@ If BOUNDARY is not nil, it is used as message header separator. ;;; @ 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 rfc822/wrap-as-quoted-string (str) - "Wrap string STR as RFC 822 quoted-string. [tl-822.el]" +(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) - ) - )) str "") + (std11-wrap-as-quoted-pairs string std11-non-qtext-char-list) "\"")) +(defun std11-strip-quoted-pair (string) + "Strip quoted-pairs in STRING. [std11.el]" + (let (dest + (b 0) + (i 0) + (len (length string)) + ) + (while (< i len) + (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]" + (let ((len (length string))) + (or (and (>= len 2) + (let ((max (1- len))) + (and (eq (aref string 0) ?\") + (eq (aref string max) ?\") + (std11-strip-quoted-pair (substring string 1 max)) + ))) + string))) + ;;; @ composer ;;; @@ -220,13 +266,14 @@ If BOUNDARY is not nil, it is used as message header separator. represents addr-spec of RFC 822. [std11.el]" (mapconcat (function (lambda (token) - (if (let ((name (car token))) - (or (eq name 'spaces) - (eq name 'comment) - )) - "" - (cdr token) - ))) + (let ((name (car token))) + (cond + ((eq name 'spaces) "") + ((eq name 'comment) "") + ((eq name 'quoted-string) + (concat "\"" (cdr token) "\"")) + (t (cdr token))) + ))) seq "") ) @@ -262,15 +309,72 @@ represents addr-spec of RFC 822. [std11.el]" (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)) + ) )))) +(defun std11-msg-id-string (msg-id) + "Return string from parsed MSG-ID of RFC 822." + (concat "<" (std11-addr-to-string (cdr msg-id)) ">") + ) + +(defun std11-fill-msg-id-list-string (string &optional column) + "Fill list of msg-id in STRING, and return the result." + (or column + (setq column 12)) + (let ((lal (std11-lexical-analyze string)) + dest) + (let ((ret (std11-parse-msg-id lal))) + (if ret + (let* ((str (std11-msg-id-string (car ret))) + (len (length str))) + (setq lal (cdr ret)) + (if (> (+ len column) 76) + (setq dest (concat dest "\n " str) + column (1+ len)) + (setq dest str + column (+ column len)) + )) + (setq dest (concat dest (cdr (car lal))) + lal (cdr lal)) + )) + (while lal + (let ((ret (std11-parse-msg-id lal))) + (if ret + (let* ((str (std11-msg-id-string (car ret))) + (len (1+ (length str)))) + (setq lal (cdr ret)) + (if (> (+ len column) 76) + (setq dest (concat dest "\n " str) + column len) + (setq dest (concat dest " " str) + column (+ column len)) + )) + (setq dest (concat dest (cdr (car lal))) + lal (cdr lal)) + ))) + dest)) + ;;; @ parser ;;;