X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=std11.el;h=c051a167a04ac88387cb7bee3a6bbabaa0c86dbd;hb=4322c50bd8ffb15420914bd4162de9bf57f50ee3;hp=33c8588f25c84e9d134d666211676ccaa50507c5;hpb=66eec7cca1eb73ad4719385602b28ff07b96af5a;p=elisp%2Fapel.git diff --git a/std11.el b/std11.el index 33c8588..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.19 1996-08-28 21:01:41 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: @@ -49,7 +49,7 @@ (point) ) -(defun std11-find-field-body (name &optional boundary) +(defun std11-field-body (name &optional boundary) "Return body of field NAME. If BOUNDARY is not nil, it is used as message header separator. \[std11.el]" @@ -62,7 +62,27 @@ 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-bodies (field-names &optional default-value boundary) +(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 header separator. [std11.el]" @@ -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,35 +197,86 @@ If BOUNDARY is not nil, it is used as message header separator. dest)))) -;;; @ parser +;;; @ quoted-string ;;; -(provide 'std11) +(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)) + )) -(mapcar (function - (lambda (func) - (autoload func "std11-parse") - )) - '(std11-lexical-analyze - std11-parse-address std11-parse-addresses - std11-parse-address-string)) +(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-parse-address-string (string) - "Parse STRING as mail address. [std11.el]" - (std11-parse-address (std11-lexical-analyze string)) - ) +(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 +;;; (defun std11-addr-to-string (seq) + "Return string from lexical analyzed list SEQ +represents addr-spec of RFC 822. [std11.el]" (mapconcat (function (lambda (token) - (if (eq (car token) 'spaces) - "" - (cdr token) - ))) + (let ((name (car token))) + (cond + ((eq name 'spaces) "") + ((eq name 'comment) "") + ((eq name 'quoted-string) + (concat "\"" (cdr token) "\"")) + (t (cdr token))) + ))) seq "") ) (defun std11-address-string (address) + "Return string of address part from parsed ADDRESS of RFC 822. +\[std11.el]" (cond ((eq (car address) 'group) (mapconcat (function std11-address-string) (car (cdr address)) @@ -217,6 +291,81 @@ If BOUNDARY is not nil, it is used as message header separator. ) ))))) +(defun std11-full-name-string (address) + "Return string of full-name part from parsed ADDRESS of RFC 822. +\[std11.el]" + (cond ((eq (car address) 'group) + (mapconcat (function + (lambda (token) + (cdr token) + )) + (nth 1 address) "") + ) + ((eq (car address) 'mailbox) + (let ((addr (nth 1 address)) + (comment (nth 2 address)) + phrase) + (if (eq (car addr) 'phrase-route-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) "")) + ) + (cond ((> (length phrase) 0) phrase) + (comment (std11-strip-quoted-pair comment)) + ) + )))) + + +;;; @ parser +;;; + +(defun std11-parse-address-string (string) + "Parse STRING as mail address. [std11.el]" + (std11-parse-address (std11-lexical-analyze string)) + ) + +(defun std11-parse-addresses-string (string) + "Parse STRING as mail address list. [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 + (lambda (func) + (autoload func "std11-parse") + )) + '(std11-lexical-analyze + std11-parse-address std11-parse-addresses + std11-parse-address-string)) + ;;; @ end ;;;