mmcooked.el

   1 ;;; mmcooked.el --- MIME entity implementation for binary 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 'mmbuffer)
  28
  29 (defun mmcooked-open-entity (location)
  30   (mime-parse-buffer location 'cooked)
  31   )
  32
  33 (defalias 'mmcooked-entity-point-min    'mmbuffer-entity-point-min)
  34 (defalias 'mmcooked-entity-point-max    'mmbuffer-entity-point-max)
  35 (defalias 'mmcooked-fetch-field         'mmbuffer-fetch-field)
  36
  37 (defun mmcooked-cooked-p () t)
  38
  39 (defalias 'mmcooked-entity-content      'mmbuffer-entity-content)
  40
  41 (defun mmcooked-write-entity-content (entity filename)
  42   (save-excursion
  43     (set-buffer (mime-entity-buffer-internal entity))
  44     (let ((encoding (or (mime-entity-encoding entity) "7bit")))
  45       (if (member encoding '("7bit" "8bit" "binary"))
  46           (write-region (mime-entity-body-start-internal entity)
  47                         (mime-entity-body-end-internal entity) filename)
  48         (mime-write-decoded-region (mime-entity-body-start-internal entity)
  49                                    (mime-entity-body-end-internal entity)
  50                                    filename encoding)
  51         ))))
  52
  53 (defun mmcooked-write-entity (entity filename)
  54   (save-excursion
  55     (set-buffer (mime-entity-buffer entity))
  56     (write-region (mime-entity-point-min entity)
  57                   (mime-entity-point-max entity) filename)
  58     ))
  59
  60 (defun mmcooked-write-entity-body (entity filename)
  61   (save-excursion
  62     (set-buffer (mime-entity-buffer entity))
  63     (write-region (mime-entity-body-start entity)
  64                   (mime-entity-body-end entity) filename)
  65     ))
  66
  67 (defun mmcooked-insert-decoded-header (entity &optional invisible-fields
  68                                               visible-fields)
  69   (save-restriction
  70     (narrow-to-region (point)(point))
  71     (let ((the-buf (current-buffer))
  72           (src-buf (mime-entity-buffer entity))
  73           (h-end (mime-entity-header-end entity))
  74           beg p end field-name len field)
  75       (save-excursion
  76         (set-buffer src-buf)
  77         (goto-char (mime-entity-header-start entity))
  78         (save-restriction
  79           (narrow-to-region (point) h-end)
  80           (while (re-search-forward std11-field-head-regexp nil t)
  81             (setq beg (match-beginning 0)
  82                   p (match-end 0)
  83                   field-name (buffer-substring beg (1- p))
  84                   len (string-width field-name)
  85                   end (std11-field-end))
  86             (when (eword-visible-field-p field-name
  87                                          visible-fields invisible-fields)
  88               (setq field (intern (capitalize field-name)))
  89               (save-excursion
  90                 (set-buffer the-buf)
  91                 (insert field-name)
  92                 (insert ":")
  93                 (cond ((memq field eword-decode-ignored-field-list)
  94                        ;; Don't decode
  95                        (insert-buffer-substring src-buf p end)
  96                        )
  97                       ((memq field eword-decode-structured-field-list)
  98                        ;; Decode as structured field
  99                        (let ((body (save-excursion
 100                                      (set-buffer src-buf)
 101                                      (buffer-substring p end)
 102                                      ))
 103                              default-mime-charset)
 104                          (insert (eword-decode-and-fold-structured-field
 105                                   body (1+ len)))
 106                          ))
 107                       (t
 108                        ;; Decode as unstructured field
 109                        (let ((body (save-excursion
 110                                      (set-buffer src-buf)
 111                                      (buffer-substring p end)
 112                                      ))
 113                              default-mime-charset)
 114                          (insert (eword-decode-unstructured-field-body
 115                                   body (1+ len)))
 116                          )))
 117                 (insert "\n")
 118                 ))))))))
 119
 120
 121 ;;; @ end
 122 ;;;
 123
 124 (provide 'mmcooked)
 125
 126 ;;; mmcooked.el ends here