From 52215102ec5cf922af059113118d80370a861dba Mon Sep 17 00:00:00 2001 From: morioka Date: Thu, 25 Apr 1996 22:15:52 +0000 Subject: [PATCH] (rfc822/get-field-names): New function. --- tl-822.el | 113 ++++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 64 insertions(+), 49 deletions(-) diff --git a/tl-822.el b/tl-822.el index 9580607..46d9b9e 100644 --- a/tl-822.el +++ b/tl-822.el @@ -30,10 +30,57 @@ (defconst rfc822/RCS-ID - "$Id: tl-822.el,v 7.21 1996-04-25 21:30:12 morioka Exp $") + "$Id: tl-822.el,v 7.22 1996-04-25 22:15:52 morioka Exp $") (defconst rfc822/version (get-version-string rfc822/RCS-ID)) +;;; @ header +;;; + +(defun rfc822/narrow-to-header (&optional boundary) + (narrow-to-region (goto-char (point-min)) + (if (re-search-forward + (concat "^\\(" (regexp-quote + (or boundary "")) "\\)?$") nil t) + (match-beginning 0) + (point-max) + ))) + +(defun rfc822/get-header-string (pat &optional boundary) + (let ((case-fold-search t)) + (save-excursion + (save-restriction + (rfc822/narrow-to-header boundary) + (goto-char (point-min)) + (let (field header) + (while (re-search-forward rfc822/field-top-regexp nil t) + (setq field (buffer-substring (match-beginning 0) + (rfc822/field-end) + )) + (if (string-match pat field) + (setq header (concat header field "\n")) + )) + header) + )))) + +(defun rfc822/get-header-string-except (pat &optional boundary) + (let ((case-fold-search t)) + (save-excursion + (save-restriction + (rfc822/narrow-to-header boundary) + (goto-char (point-min)) + (let (field header) + (while (re-search-forward rfc822/field-top-regexp nil t) + (setq field (buffer-substring (match-beginning 0) + (rfc822/field-end) + )) + (if (not (string-match pat field)) + (setq header (concat header field "\n")) + )) + header) + )))) + + ;;; @ field ;;; @@ -44,6 +91,21 @@ (defconst rfc822::next-field-top-regexp (concat "\n" rfc822/field-top-regexp)) +(defun rfc822/get-field-names (&optional boundary) + (save-excursion + (save-restriction + (rfc822/narrow-to-header boundary) + (goto-char (point-min)) + (let ((pat (concat "^\\(" rfc822/field-name-regexp "\\):")) + dest name) + (while (re-search-forward pat nil t) + (setq name (buffer-substring (match-beginning 1)(match-end 1))) + (or (member name dest) + (setq dest (cons name dest)) + ) + ) + dest)))) + (defun rfc822/field-end () (if (re-search-forward rfc822::next-field-top-regexp nil t) (goto-char (match-beginning 0)) @@ -72,12 +134,12 @@ (save-excursion (save-restriction (rfc822/narrow-to-header boundary) - (goto-char (point-min)) (let* ((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 @@ -89,53 +151,6 @@ dest))))) -;;; @ header -;;; - -(defun rfc822/narrow-to-header (&optional boundary) - (narrow-to-region (goto-char (point-min)) - (if (re-search-forward - (concat "^\\(" (regexp-quote - (or boundary "")) "\\)?$") nil t) - (match-end 0) - (point-max) - ))) - -(defun rfc822/get-header-string (pat &optional boundary) - (let ((case-fold-search t)) - (save-excursion - (save-restriction - (rfc822/narrow-to-header boundary) - (goto-char (point-min)) - (let (field header) - (while (re-search-forward rfc822/field-top-regexp nil t) - (setq field (buffer-substring (match-beginning 0) - (rfc822/field-end) - )) - (if (string-match pat field) - (setq header (concat header field "\n")) - )) - header) - )))) - -(defun rfc822/get-header-string-except (pat &optional boundary) - (let ((case-fold-search t)) - (save-excursion - (save-restriction - (rfc822/narrow-to-header boundary) - (goto-char (point-min)) - (let (field header) - (while (re-search-forward rfc822/field-top-regexp nil t) - (setq field (buffer-substring (match-beginning 0) - (rfc822/field-end) - )) - (if (not (string-match pat field)) - (setq header (concat header field "\n")) - )) - header) - )))) - - ;;; @ quoting ;;; -- 1.7.10.4