X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=std11.el;h=c051a167a04ac88387cb7bee3a6bbabaa0c86dbd;hb=4322c50bd8ffb15420914bd4162de9bf57f50ee3;hp=13642721cb0dc6252d4d1300a8939b59ed56b0b0;hpb=6a041377ee42df3013239dcae732e9aada620789;p=elisp%2Fapel.git diff --git a/std11.el b/std11.el index 1364272..c051a16 100644 --- a/std11.el +++ b/std11.el @@ -1,12 +1,12 @@ ;;; std11.el --- STD 11 functions for GNU Emacs -;; Copyright (C) 1995,1996 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: mail, news, RFC 822, STD 11 -;; Version: $Id: std11.el,v 0.24 1996-08-30 06:11:58 morioka Exp $ +;; Version: $Id: std11.el,v 0.40 1997-03-03 08:03:06 shuhei-k Exp $ -;; This file is part of tl (Tiny Library). +;; This file is part of MU (Message Utilities). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -19,8 +19,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: @@ -62,6 +62,26 @@ If BOUNDARY is not nil, it is used as message header separator. (buffer-substring-no-properties (match-end 0) (std11-field-end)) ))))) +(defun std11-find-field-body (field-names &optional boundary) + "Return the first found field-body specified by FIELD-NAMES +of the message header in current buffer. If BOUNDARY is not nil, it is +used as message header separator. [std11.el]" + (save-excursion + (save-restriction + (std11-narrow-to-header boundary) + (let ((case-fold-search t) + field-name) + (catch 'tag + (while (setq field-name (car field-names)) + (goto-char (point-min)) + (if (re-search-forward (concat "^" field-name ":[ \t]*") nil t) + (throw 'tag + (buffer-substring-no-properties + (match-end 0) (std11-field-end))) + ) + (setq field-names (cdr field-names)) + )))))) + (defun std11-field-bodies (field-names &optional default-value boundary) "Return list of each field-bodies of FIELD-NAMES of the message header in current buffer. If BOUNDARY is not nil, it is used as message @@ -93,8 +113,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) @@ -174,6 +197,64 @@ If BOUNDARY is not nil, it is used as message header separator. dest)))) +;;; @ 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 "\"" + (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 ;;; @@ -182,13 +263,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 "") ) @@ -224,13 +306,28 @@ 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)) + ) )))) @@ -247,6 +344,18 @@ represents addr-spec of RFC 822. [std11.el]" (std11-parse-addresses (std11-lexical-analyze string)) ) +(defun std11-extract-address-components (string) + "Extract full name and canonical address from STRING. +Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). +If no name can be extracted, FULL-NAME will be nil. [std11.el]" + (let* ((structure (car (std11-parse-address-string + (std11-unfold-string string)))) + (phrase (std11-full-name-string structure)) + (address (std11-address-string structure)) + ) + (list phrase address) + )) + (provide 'std11) (mapcar (function