std11.el

   1 ;;; std11.el --- STD 11 parser for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
   4
   5 ;; Author:   MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Keywords: mail, news, RFC 822, STD 11
   7 ;; Version: $Id: std11.el,v 0.3 1996-08-28 12:41:58 morioka Exp $
   8
   9 ;; This file is part of tl (Tiny Library).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with This program; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Code:
  27
  28 (require 'emu)
  29
  30
  31 ;;; @ field
  32 ;;;
  33
  34 (defconst std11-field-name-regexp "[!-9;-~]+")
  35 (defconst std11-field-head-regexp
  36   (concat "\\(" std11-field-name-regexp "\\):"))
  37 (defconst std11-next-field-head-regexp
  38   (concat "\n" std11-field-head-regexp))
  39
  40 (defun std11-field-body (name &optional boundary)
  41   (save-excursion
  42     (save-restriction
  43       (std11-narrow-to-header)
  44       (goto-char (point-min))
  45       (let ((case-fold-search t))
  46         (if (re-search-forward (concat "^" name ":[ \t]*") nil t)
  47             (buffer-substring-no-properties (match-end 0) (std11-field-end))
  48           )))))
  49
  50 (defun std11-field-end ()
  51   (if (re-search-forward std11-next-field-head-regexp nil t)
  52       (goto-char (match-beginning 0))
  53     (if (re-search-forward "^$" nil t)
  54         (goto-char (1- (match-beginning 0)))
  55       (end-of-line)
  56       ))
  57   (point)
  58   )
  59
  60
  61 ;;; @ header
  62 ;;;
  63
  64 (defun std11-header-string (pat &optional boundary)
  65   (let ((case-fold-search t))
  66     (save-excursion
  67       (save-restriction
  68         (std11-narrow-to-header boundary)
  69         (goto-char (point-min))
  70         (let (field header)
  71           (while (re-search-forward std11-field-head-regexp nil t)
  72             (setq field
  73                   (buffer-substring (match-beginning 0) (std11-field-end)))
  74             (if (string-match pat field)
  75                 (setq header (concat header field "\n"))
  76               ))
  77           header)
  78         ))))
  79
  80 (defun std11-header-string-except (pat &optional boundary)
  81   (let ((case-fold-search t))
  82     (save-excursion
  83       (save-restriction
  84         (std11-narrow-to-header boundary)
  85         (goto-char (point-min))
  86         (let (field header)
  87           (while (re-search-forward std11-field-head-regexp nil t)
  88             (setq field
  89                   (buffer-substring (match-beginning 0) (std11-field-end)))
  90             (if (not (string-match pat field))
  91                 (setq header (concat header field "\n"))
  92               ))
  93           header)
  94         ))))
  95
  96 (defun std11-narrow-to-header (&optional boundary)
  97   (narrow-to-region
  98    (goto-char (point-min))
  99    (if (re-search-forward
 100         (concat "^\\(" (regexp-quote (or boundary "")) "\\)?$")
 101         nil t)
 102        (match-beginning 0)
 103      (point-max)
 104      )))
 105
 106
 107 ;;; @ end
 108 ;;;
 109
 110 (provide 'std11)
 111
 112 ;;; std11.el ends here