mmgeneric.el

   1 ;;; mmgeneric.el --- MIME entity module for generic buffer
   2
   3 ;; Copyright (C) 1998 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Keywords: MIME, multimedia, mail, news
   7
   8 ;; This file is part of FLIM (Faithful Library about Internet Message).
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'mime)
  28 (require 'mime-parse)
  29
  30 (mm-define-backend generic)
  31
  32 (mm-define-method entity-header-start ((entity generic))
  33   (mime-entity-set-header-start-internal
  34    entity
  35    (save-excursion
  36      (set-buffer (mime-entity-buffer entity))
  37      (point-min)
  38      )))
  39
  40 (mm-define-method entity-header-end ((entity generic))
  41   (save-excursion
  42     (set-buffer (mime-entity-buffer entity))
  43     (mime-entity-header-end-internal entity)
  44     ))
  45
  46 (mm-define-method entity-body-start ((entity generic))
  47   (mime-entity-set-body-start-internal
  48    entity
  49    (save-excursion
  50      (set-buffer (mime-entity-buffer entity))
  51      (mime-entity-body-start-internal entity)
  52      )))
  53
  54 (mm-define-method entity-body-end ((entity generic))
  55   (mime-entity-set-body-end-internal
  56    entity
  57    (save-excursion
  58      (set-buffer (mime-entity-buffer entity))
  59      (point-max)
  60      )))
  61
  62 (mm-define-method entity-point-min ((entity generic))
  63   (or (mime-entity-header-start-internal entity)
  64       (mime-entity-send entity 'entity-header-start)))
  65
  66 (mm-define-method entity-point-max ((entity generic))
  67   (or (mime-entity-body-end-internal entity)
  68       (mime-entity-send entity 'entity-body-end)))
  69
  70 (mm-define-method fetch-field ((entity generic) field-name)
  71   (save-excursion
  72     (set-buffer (mime-entity-buffer entity))
  73     (save-restriction
  74       (narrow-to-region (mime-entity-header-start-internal entity)
  75                         (mime-entity-header-end-internal entity))
  76       (std11-fetch-field field-name)
  77       )))
  78
  79 (mm-define-method entity-cooked-p ((entity generic)) nil)
  80
  81 (mm-define-method entity-children ((entity generic))
  82   (let* ((content-type (mime-entity-content-type entity))
  83          (primary-type (mime-content-type-primary-type content-type)))
  84     (cond ((eq primary-type 'multipart)
  85            (mime-parse-multipart entity)
  86            )
  87           ((and (eq primary-type 'message)
  88                 (memq (mime-content-type-subtype content-type)
  89                       '(rfc822 news external-body)
  90                       ))
  91            (mime-parse-encapsulated entity)
  92            ))
  93     ))
  94
  95 (mm-define-method entity-content ((entity generic))
  96   (save-excursion
  97     (set-buffer (mime-entity-buffer entity))
  98     (mime-decode-string
  99      (buffer-substring (mime-entity-body-start-internal entity)
 100                        (mime-entity-body-end-internal entity))
 101      (mime-entity-encoding entity))))
 102
 103 (mm-define-method write-entity-content ((entity generic) filename)
 104   (save-excursion
 105     (set-buffer (mime-entity-buffer entity))
 106     (mime-write-decoded-region (mime-entity-body-start-internal entity)
 107                                (mime-entity-body-end-internal entity)
 108                                filename
 109                                (or (mime-entity-encoding entity) "7bit"))
 110     ))
 111
 112 (mm-define-method write-entity ((entity generic) filename)
 113   (save-excursion
 114     (set-buffer (mime-entity-buffer entity))
 115     (write-region-as-raw-text-CRLF (mime-entity-header-start-internal entity)
 116                                    (mime-entity-body-end-internal entity)
 117                                    filename)
 118     ))
 119
 120 (mm-define-method write-entity-body ((entity generic) filename)
 121   (save-excursion
 122     (set-buffer (mime-entity-buffer entity))
 123     (write-region-as-binary (mime-entity-body-start-internal entity)
 124                             (mime-entity-body-end-internal entity)
 125                             filename)
 126     ))
 127
 128 (defun mime-visible-field-p (field-name visible-fields invisible-fields)
 129   (or (catch 'found
 130         (while visible-fields
 131           (let ((regexp (car visible-fields)))
 132             (if (string-match regexp field-name)
 133                 (throw 'found t)
 134               ))
 135           (setq visible-fields (cdr visible-fields))
 136           ))
 137       (catch 'found
 138         (while invisible-fields
 139           (let ((regexp (car invisible-fields)))
 140             (if (string-match regexp field-name)
 141                 (throw 'found nil)
 142               ))
 143           (setq invisible-fields (cdr invisible-fields))
 144           )
 145         t)))
 146
 147 (defun mime-insert-header-from-buffer (buffer start end
 148                                               &optional invisible-fields
 149                                               visible-fields)
 150   (let ((the-buf (current-buffer))
 151         f-b p f-e field-name len field field-body)
 152     (save-excursion
 153       (set-buffer buffer)
 154       (save-restriction
 155         (narrow-to-region start end)
 156         (goto-char start)
 157         (while (re-search-forward std11-field-head-regexp nil t)
 158           (setq f-b (match-beginning 0)
 159                 p (match-end 0)
 160                 field-name (buffer-substring f-b p)
 161                 len (string-width field-name)
 162                 f-e (std11-field-end))
 163           (when (mime-visible-field-p field-name
 164                                       visible-fields invisible-fields)
 165             (setq field (intern
 166                          (capitalize (buffer-substring f-b (1- p))))
 167                   field-body (buffer-substring p f-e))
 168             (with-current-buffer the-buf
 169               (insert field-name)
 170               (insert
 171                (if (memq field eword-decode-ignored-field-list)
 172                    ;; Don't decode
 173                    field-body
 174                  (if (memq field eword-decode-structured-field-list)
 175                      ;; Decode as structured field
 176                      (eword-decode-and-fold-structured-field field-body len)
 177                    ;; Decode as unstructured field
 178                    (eword-decode-unstructured-field-body field-body len)
 179                    )))
 180               (insert "\n")
 181               )))))))
 182
 183 (mm-define-method insert-header ((entity generic)
 184                                  &optional invisible-fields visible-fields)
 185   (mime-insert-header-from-buffer
 186    (mime-entity-buffer entity)
 187    (mime-entity-header-start-internal entity)
 188    (mime-entity-header-end-internal entity)
 189    invisible-fields visible-fields)
 190   )
 191
 192 (mm-define-method insert-text-content ((entity generic))
 193   (insert
 194    (decode-mime-charset-string (mime-entity-content entity)
 195                                (or (mime-content-type-parameter
 196                                     (mime-entity-content-type entity)
 197                                     "charset")
 198                                    default-mime-charset)
 199                                'CRLF)
 200    ))
 201
 202
 203 ;;; @ end
 204 ;;;
 205
 206 (provide 'mmgeneric)
 207
 208 ;;; mmgeneric.el ends here