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 (mm-define-method insert-header ((entity generic)
 148                                  &optional invisible-fields visible-fields)
 149   (save-restriction
 150     (narrow-to-region (point)(point))
 151     (let ((the-buf (current-buffer))
 152           (src-buf (mime-entity-buffer entity))
 153           (h-end (mime-entity-header-end-internal entity))
 154           beg p end field-name len field)
 155       (save-excursion
 156         (set-buffer src-buf)
 157         (goto-char (mime-entity-header-start-internal entity))
 158         (save-restriction
 159           (narrow-to-region (point) h-end)
 160           (while (re-search-forward std11-field-head-regexp nil t)
 161             (setq beg (match-beginning 0)
 162                   p (match-end 0)
 163                   field-name (buffer-substring beg (1- p))
 164                   len (string-width field-name)
 165                   end (std11-field-end))
 166             (when (mime-visible-field-p field-name
 167                                         visible-fields invisible-fields)
 168               (setq field (intern (capitalize field-name)))
 169               (save-excursion
 170                 (set-buffer the-buf)
 171                 (insert field-name)
 172                 (insert ":")
 173                 (cond ((memq field eword-decode-ignored-field-list)
 174                        ;; Don't decode
 175                        (insert-buffer-substring src-buf p end)
 176                        )
 177                       ((memq field eword-decode-structured-field-list)
 178                        ;; Decode as structured field
 179                        (let ((body (save-excursion
 180                                      (set-buffer src-buf)
 181                                      (buffer-substring p end)
 182                                      )))
 183                          (insert (eword-decode-and-fold-structured-field
 184                                   body (1+ len)))
 185                          ))
 186                       (t
 187                        ;; Decode as unstructured field
 188                        (let ((body (save-excursion
 189                                      (set-buffer src-buf)
 190                                      (buffer-substring p end)
 191                                      )))
 192                          (insert (eword-decode-unstructured-field-body
 193                                   body (1+ len)))
 194                          )))
 195                 (insert "\n")
 196                 ))))))))
 197
 198 (mm-define-method insert-text-content ((entity generic))
 199   (insert
 200    (decode-mime-charset-string (mime-entity-content entity)
 201                                (or (mime-content-type-parameter
 202                                     (mime-entity-content-type entity)
 203                                     "charset")
 204                                    default-mime-charset)
 205                                'CRLF)
 206    ))
 207
 208
 209 ;;; @ end
 210 ;;;
 211
 212 (provide 'mmgeneric)
 213
 214 ;;; mmgeneric.el ends here