mmbuffer.el

   1 ;;; mmbuffer.el --- MIME entity module for binary buffer
   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 'mmgeneric)
  28 (require 'mime)
  29
  30 (eval-and-compile
  31   (luna-define-class mime-buffer-entity (mime-entity)
  32                      (buffer
  33                       header-start
  34                       header-end
  35                       body-start
  36                       body-end))
  37
  38   (luna-define-internal-accessors 'mime-buffer-entity)
  39   )
  40
  41 (luna-define-method initialize-instance :after ((entity mime-buffer-entity)
  42                                                 &rest init-args)
  43   (or (mime-buffer-entity-buffer-internal entity)
  44       (mime-buffer-entity-set-buffer-internal
  45        entity (mime-entity-location-internal entity)))
  46   (save-excursion
  47     (set-buffer (mime-buffer-entity-buffer-internal entity))
  48     (let ((header-start
  49            (or (mime-buffer-entity-header-start-internal entity)
  50                (mime-buffer-entity-set-header-start-internal
  51                 entity (point-min))))
  52           (header-end (mime-buffer-entity-header-end-internal entity))
  53           (body-start (mime-buffer-entity-body-start-internal entity))
  54           (body-end
  55            (or (mime-buffer-entity-body-end-internal entity)
  56                (mime-buffer-entity-set-body-end-internal entity (point-max)))))
  57       (goto-char header-start)
  58       (unless (and header-end body-start)
  59         (if (re-search-forward "^$" body-end t)
  60             (setq header-end (match-end 0)
  61                   body-start (if (= header-end body-end)
  62                                  body-end
  63                                (1+ header-end)))
  64           (setq header-end (point-min)
  65                 body-start (point-min)))
  66         (mime-buffer-entity-set-header-end-internal entity header-end)
  67         (mime-buffer-entity-set-body-start-internal entity body-start)
  68         )
  69       (or (mime-entity-content-type-internal entity)
  70           (save-restriction
  71             (narrow-to-region header-start header-end)
  72             (mime-entity-set-content-type-internal
  73              entity
  74              (let ((str (std11-fetch-field "Content-Type")))
  75                (if str
  76                    (mime-parse-Content-Type str)
  77                  )))
  78             ))
  79       ))
  80   entity)
  81
  82 (luna-define-method mime-entity-name ((entity mime-buffer-entity))
  83   (buffer-name (mime-buffer-entity-buffer-internal entity))
  84   )
  85
  86
  87 (luna-define-method mime-insert-header ((entity mime-buffer-entity)
  88                                         &optional invisible-fields
  89                                         visible-fields)
  90   (mime-insert-header-from-buffer
  91    (mime-buffer-entity-buffer-internal entity)
  92    (mime-buffer-entity-header-start-internal entity)
  93    (mime-buffer-entity-header-end-internal entity)
  94    invisible-fields visible-fields)
  95   )
  96
  97 (luna-define-method mime-entity-content ((entity mime-buffer-entity))
  98   (save-excursion
  99     (set-buffer (mime-buffer-entity-buffer-internal entity))
 100     (mime-decode-string
 101      (buffer-substring (mime-buffer-entity-body-start-internal entity)
 102                        (mime-buffer-entity-body-end-internal entity))
 103      (mime-entity-encoding entity))))
 104
 105 (luna-define-method mime-entity-body ((entity mime-buffer-entity))
 106   (save-excursion
 107     (set-buffer (mime-buffer-entity-buffer-internal entity))
 108     (buffer-substring (mime-buffer-entity-body-start-internal entity)
 109                       (mime-buffer-entity-body-end-internal entity))))
 110
 111 (luna-define-method mime-entity-fetch-field :around
 112   ((entity mime-buffer-entity) field-name)
 113   (or (luna-call-next-method)
 114       (save-excursion
 115         (set-buffer (mime-buffer-entity-buffer-internal entity))
 116         (save-restriction
 117           (narrow-to-region (mime-buffer-entity-header-start-internal entity)
 118                             (mime-buffer-entity-header-end-internal entity))
 119           (let ((ret (std11-fetch-field field-name)))
 120             (when ret
 121               (or (symbolp field-name)
 122                   (setq field-name
 123                         (intern (capitalize (capitalize field-name)))))
 124               (mime-entity-set-original-header-internal
 125                entity
 126                (put-alist field-name ret
 127                           (mime-entity-original-header-internal entity)))
 128               ret))))))
 129
 130 (mm-define-method insert-entity-content ((entity buffer))
 131   (insert (with-current-buffer (mime-buffer-entity-buffer-internal entity)
 132             (mime-decode-string
 133              (buffer-substring (mime-buffer-entity-body-start-internal entity)
 134                                (mime-buffer-entity-body-end-internal entity))
 135              (mime-entity-encoding entity)))))
 136
 137 (mm-define-method write-entity-content ((entity buffer) filename)
 138   (save-excursion
 139     (set-buffer (mime-buffer-entity-buffer-internal entity))
 140     (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity)
 141                                (mime-buffer-entity-body-end-internal entity)
 142                                filename
 143                                (or (mime-entity-encoding entity) "7bit"))
 144     ))
 145
 146 (mm-define-method insert-entity ((entity buffer))
 147   (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
 148                            (mime-buffer-entity-header-start-internal entity)
 149                            (mime-buffer-entity-body-end-internal entity))
 150   )
 151
 152 (mm-define-method write-entity ((entity buffer) filename)
 153   (save-excursion
 154     (set-buffer (mime-buffer-entity-buffer-internal entity))
 155     (write-region-as-raw-text-CRLF
 156      (mime-buffer-entity-header-start-internal entity)
 157      (mime-buffer-entity-body-end-internal entity)
 158      filename)
 159     ))
 160
 161 (mm-define-method write-entity-body ((entity buffer) filename)
 162   (save-excursion
 163     (set-buffer (mime-buffer-entity-buffer-internal entity))
 164     (write-region-as-binary (mime-buffer-entity-body-start-internal entity)
 165                             (mime-buffer-entity-body-end-internal entity)
 166                             filename)
 167     ))
 168
 169
 170 ;;; @ header buffer
 171 ;;;
 172
 173 (luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity))
 174   (mime-buffer-entity-buffer-internal entity)
 175   )
 176
 177 (luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity))
 178   (set-buffer (mime-buffer-entity-buffer-internal entity))
 179   (goto-char (mime-buffer-entity-header-start-internal entity))
 180   )
 181
 182 (luna-define-method mime-entity-header-start-point ((entity
 183                                                      mime-buffer-entity))
 184   (mime-buffer-entity-header-start-internal entity)
 185   )
 186
 187 (luna-define-method mime-entity-header-end-point ((entity
 188                                                    mime-buffer-entity))
 189   (mime-buffer-entity-header-end-internal entity)
 190   )
 191
 192
 193 ;;; @ body buffer
 194 ;;;
 195
 196 (luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity))
 197   (mime-buffer-entity-buffer-internal entity)
 198   )
 199
 200 (luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity))
 201   (set-buffer (mime-buffer-entity-buffer-internal entity))
 202   (goto-char (mime-buffer-entity-body-start-internal entity))
 203   )
 204
 205 (luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity))
 206   (set-buffer (mime-buffer-entity-buffer-internal entity))
 207   (goto-char (mime-buffer-entity-body-end-internal entity))
 208   )
 209
 210 (luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity))
 211   (mime-buffer-entity-body-start-internal entity)
 212   )
 213
 214 (luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity))
 215   (mime-buffer-entity-body-end-internal entity)
 216   )
 217
 218
 219 ;;; @ buffer (obsolete)
 220 ;;;
 221
 222 (luna-define-method mime-entity-buffer ((entity mime-buffer-entity))
 223   (mime-buffer-entity-buffer-internal entity)
 224   )
 225
 226 (luna-define-method mime-entity-point-min ((entity mime-buffer-entity))
 227   (mime-buffer-entity-header-start-internal entity)
 228   )
 229
 230 (luna-define-method mime-entity-point-max ((entity mime-buffer-entity))
 231   (mime-buffer-entity-body-end-internal entity)
 232   )
 233
 234
 235 ;;; @ end
 236 ;;;
 237
 238 (provide 'mmbuffer)
 239
 240 ;;; mmbuffer.el ends here