From: morioka Date: Wed, 28 Aug 1996 13:13:12 +0000 (+0000) Subject: (std11-field-bodies): New function. X-Git-Tag: XEmacs-20_3-b27-viet~78 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=37cc43deec58b78af677886bac3faa1902608949;p=elisp%2Fmu-cite.git (std11-field-bodies): New function. --- diff --git a/std11.el b/std11.el index 36ffe43..eae9d83 100644 --- a/std11.el +++ b/std11.el @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko ;; Keywords: mail, news, RFC 822, STD 11 -;; Version: $Id: std11.el,v 0.4 1996-08-28 13:03:23 morioka Exp $ +;; Version: $Id: std11.el,v 0.5 1996-08-28 13:13:12 morioka Exp $ ;; This file is part of tl (Tiny Library). @@ -58,6 +58,42 @@ (point) ) +(defun std11-field-names (&optional boundary) + (save-excursion + (save-restriction + (std11-narrow-to-header boundary) + (goto-char (point-min)) + (let (dest name) + (while (re-search-forward std11-field-head-regexp nil t) + (setq name (buffer-substring-no-properties + (match-beginning 0)(1- (match-end 0)))) + (or (member name dest) + (setq dest (cons name dest)) + ) + ) + dest)))) + +(defun std11-field-bodies (field-names &optional default-value boundary) + (save-excursion + (save-restriction + (std11-narrow-to-header boundary) + (let* ((case-fold-search t) + (dest (make-list (length field-names) default-value)) + (s-rest field-names) + (d-rest dest) + field-name) + (while (setq field-name (car s-rest)) + (goto-char (point-min)) + (if (re-search-forward (concat "^" field-name ":[ \t]*") nil t) + (setcar d-rest + (buffer-substring-no-properties + (match-end 0) (std11-field-end))) + ) + (setq s-rest (cdr s-rest) + d-rest (cdr d-rest)) + ) + dest)))) + ;;; @ header ;;; @@ -104,21 +140,6 @@ header) )))) -(defun std11-field-names (&optional boundary) - (save-excursion - (save-restriction - (std11-narrow-to-header boundary) - (goto-char (point-min)) - (let (dest name) - (while (re-search-forward std11-field-head-regexp nil t) - (setq name (buffer-substring-no-properties - (match-beginning 0)(1- (match-end 0)))) - (or (member name dest) - (setq dest (cons name dest)) - ) - ) - dest)))) - ;;; @ end ;;;