mmdbuffer.el

   1 ;;; mmdual.el --- MIME entity module for dual buffers
   2
   3 ;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   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
  29 (eval-and-compile
  30   (luna-define-class mime-dual-entity (mime-entity)
  31                      (header-buffer
  32                       body-buffer))
  33
  34   (luna-define-internal-accessors 'mime-dual-entity)
  35   )
  36
  37 (luna-define-method initialize-instance :after ((entity mime-dual-entity)
  38                                                 &rest init-args)
  39   (let ((buf (mime-dual-entity-header-buffer-internal entity)))
  40     (if buf
  41         (with-current-buffer buf
  42           (or (mime-entity-content-type-internal entity)
  43               (mime-entity-set-content-type-internal
  44                entity
  45                (let ((str (std11-fetch-field "Content-Type")))
  46                  (if str
  47                      (mime-parse-Content-Type str)
  48                    )))))))
  49   entity)
  50
  51 (luna-define-method mime-entity-name ((entity mime-dual-entity))
  52   (buffer-name (mime-dual-entity-header-buffer-internal entity))
  53   )
  54
  55
  56 (luna-define-method mime-insert-header ((entity mime-dual-entity)
  57                                         &optional invisible-fields
  58                                         visible-fields)
  59   (let* ((buf (mime-dual-entity-header-buffer-internal entity))
  60          header-start header-end)
  61     (with-current-buffer buf
  62       (setq header-start (point-min)
  63             header-end (point-max)))
  64     (mime-insert-header-from-buffer buf header-start header-end
  65                                     invisible-fields visible-fields)
  66     ))
  67
  68 (luna-define-method mime-entity-content ((entity mime-dual-entity))
  69   (mime-decode-string
  70    (with-current-buffer (mime-dual-entity-body-buffer-internal entity)
  71      (buffer-string))
  72    (mime-entity-encoding entity)))
  73
  74 (luna-define-method mime-entity-fetch-field :around
  75   ((entity mime-dual-entity) field-name)
  76   (or (luna-call-next-method)
  77       (with-current-buffer (mime-dual-entity-header-buffer-internal entity)
  78         (let ((ret (std11-fetch-field field-name)))
  79           (when ret
  80             (or (symbolp field-name)
  81                 (setq field-name
  82                       (intern (capitalize (capitalize field-name)))))
  83             (mime-entity-set-original-header-internal
  84              entity
  85              (put-alist field-name ret
  86                         (mime-entity-original-header-internal entity)))
  87             ret)))))
  88
  89 (luna-define-method mime-insert-entity-content ((entity mime-dual-entity))
  90   (insert
  91    (mime-decode-string
  92     (with-current-buffer (mime-dual-entity-body-buffer-internal entity)
  93       (buffer-substring (point-min)(point-max)))
  94     (mime-entity-encoding entity))))
  95
  96 (luna-define-method mime-write-entity-content ((entity mime-dual-entity)
  97                                                filename)
  98   (with-current-buffer (mime-dual-entity-body-buffer-internal entity)
  99     (mime-write-decoded-region (point-min)
 100                                (point-max)
 101                                filename
 102                                (or (mime-entity-encoding entity) "7bit"))))
 103
 104 (luna-define-method mime-insert-entity ((entity mime-dual-entity))
 105   (let (buf)
 106     (setq buf (mime-dual-entity-header-buffer-internal entity))
 107     (when buf
 108       (insert-buffer (mime-dual-entity-header-buffer-internal entity))
 109       (setq buf (mime-dual-entity-body-buffer-internal entity))
 110       (when buf
 111         (insert "\n")
 112         (insert-buffer buf)))))
 113
 114 (luna-define-method mime-write-entity ((entity mime-dual-entity) filename)
 115   (let (buf)
 116     (setq buf (mime-dual-entity-header-buffer-internal entity))
 117     (if (null buf)
 118         (error "No header buffer.")
 119       (with-current-buffer buf
 120         (write-region-as-raw-text-CRLF
 121          (point-min)(point-max) filename))
 122       (setq buf (mime-dual-entity-body-buffer-internal entity))
 123       (when buf
 124         (with-temp-buffer
 125           (insert "\n")
 126           (write-region-as-raw-text-CRLF
 127            (point-min)(point-max)
 128            filename 'append))
 129         (with-current-buffer buf
 130           (write-region-as-raw-text-CRLF
 131            (point-min)(point-max)
 132            filename 'append))))))
 133
 134 (luna-define-method mime-write-entity-body ((entity mime-dual-entity) filename)
 135   (with-current-buffer (mime-dual-entity-body-buffer-internal entity)
 136     (write-region-as-binary (point-min)(point-max)
 137                             filename)))
 138
 139
 140 ;;; @ buffer
 141 ;;;
 142
 143 (luna-define-method mime-entity-header-buffer ((entity mime-dual-entity))
 144   (mime-dual-entity-header-buffer-internal entity))
 145
 146 (luna-define-method mime-entity-body-buffer ((entity mime-dual-entity))
 147   (mime-dual-entity-body-buffer-internal entity))
 148
 149 (luna-define-method mime-entity-buffer ((entity mime-dual-entity))
 150   (message "mime-dual-entity does not have mime-entity-buffer.")
 151   nil)
 152
 153 (luna-define-method mime-entity-body-start-point ((entity mime-dual-entity))
 154   (with-current-buffer (mime-entity-body-buffer entity)
 155     (point-min)))
 156
 157 (luna-define-method mime-entity-body-end-point ((entity mime-dual-entity))
 158   (with-current-buffer (mime-entity-body-buffer entity)
 159     (point-max)))
 160
 161 (luna-define-method mime-entity-point-min ((entity mime-dual-entity))
 162   (message "mime-dual-entity does not have mime-entity-point-min.")
 163   nil)
 164
 165 (luna-define-method mime-entity-point-max ((entity mime-dual-entity))
 166   (message "mime-dual-entity does not have mime-entity-point-max.")
 167   nil)
 168
 169 (luna-define-method mime-goto-header-start-point ((entity mime-dual-entity))
 170   (set-buffer (mime-dual-entity-header-buffer-internal entity))
 171   (goto-char (point-min)))
 172
 173 (luna-define-method mime-goto-body-start-point ((entity mime-dual-entity))
 174   (set-buffer (mime-dual-entity-body-buffer-internal entity))
 175   (goto-char (point-min)))
 176
 177 (luna-define-method mime-goto-body-end-point ((entity mime-dual-entity))
 178   (set-buffer (mime-dual-entity-body-buffer-internal entity))
 179   (goto-char (point-max)))
 180
 181
 182 ;;; @ end
 183 ;;;
 184
 185 (provide 'mmdual)
 186
 187 ;;; mmdual.el ends here