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-fetch-field :around
 106   ((entity mime-buffer-entity) field-name)
 107   (or (luna-call-next-method)
 108       (save-excursion
 109         (set-buffer (mime-buffer-entity-buffer-internal entity))
 110         (save-restriction
 111           (narrow-to-region (mime-buffer-entity-header-start-internal entity)
 112                             (mime-buffer-entity-header-end-internal entity))
 113           (let ((ret (std11-fetch-field field-name)))
 114             (when ret
 115               (or (symbolp field-name)
 116                   (setq field-name
 117                         (intern (capitalize (capitalize field-name)))))
 118               (mime-entity-set-original-header-internal
 119                entity
 120                (put-alist field-name ret
 121                           (mime-entity-original-header-internal entity)))
 122               ret))))))
 123
 124 (mm-define-method insert-entity-content ((entity buffer))
 125   (insert (with-current-buffer (mime-buffer-entity-buffer-internal entity)
 126             (mime-decode-string
 127              (buffer-substring (mime-buffer-entity-body-start-internal entity)
 128                                (mime-buffer-entity-body-end-internal entity))
 129              (mime-entity-encoding entity)))))
 130
 131 (mm-define-method write-entity-content ((entity buffer) filename)
 132   (save-excursion
 133     (set-buffer (mime-buffer-entity-buffer-internal entity))
 134     (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity)
 135                                (mime-buffer-entity-body-end-internal entity)
 136                                filename
 137                                (or (mime-entity-encoding entity) "7bit"))
 138     ))
 139
 140 (mm-define-method insert-entity ((entity buffer))
 141   (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
 142                            (mime-buffer-entity-header-start-internal entity)
 143                            (mime-buffer-entity-body-end-internal entity))
 144   )
 145
 146 (mm-define-method write-entity ((entity buffer) filename)
 147   (save-excursion
 148     (set-buffer (mime-buffer-entity-buffer-internal entity))
 149     (write-region-as-raw-text-CRLF
 150      (mime-buffer-entity-header-start-internal entity)
 151      (mime-buffer-entity-body-end-internal entity)
 152      filename)
 153     ))
 154
 155 (mm-define-method write-entity-body ((entity buffer) filename)
 156   (save-excursion
 157     (set-buffer (mime-buffer-entity-buffer-internal entity))
 158     (write-region-as-binary (mime-buffer-entity-body-start-internal entity)
 159                             (mime-buffer-entity-body-end-internal entity)
 160                             filename)
 161     ))
 162
 163
 164 ;;; @ header buffer
 165 ;;;
 166
 167 (luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity))
 168   (mime-buffer-entity-buffer-internal entity)
 169   )
 170
 171 (luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity))
 172   (set-buffer (mime-buffer-entity-buffer-internal entity))
 173   (goto-char (mime-buffer-entity-header-start-internal entity))
 174   )
 175
 176 (luna-define-method mime-entity-header-start-point ((entity
 177                                                      mime-buffer-entity))
 178   (mime-buffer-entity-header-start-internal entity)
 179   )
 180
 181 (luna-define-method mime-entity-header-end-point ((entity
 182                                                    mime-buffer-entity))
 183   (mime-buffer-entity-header-end-internal entity)
 184   )
 185
 186
 187 ;;; @ body buffer
 188 ;;;
 189
 190 (luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity))
 191   (mime-buffer-entity-buffer-internal entity)
 192   )
 193
 194 (luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity))
 195   (set-buffer (mime-buffer-entity-buffer-internal entity))
 196   (goto-char (mime-buffer-entity-body-start-internal entity))
 197   )
 198
 199 (luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity))
 200   (set-buffer (mime-buffer-entity-buffer-internal entity))
 201   (goto-char (mime-buffer-entity-body-end-internal entity))
 202   )
 203
 204 (luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity))
 205   (mime-buffer-entity-body-start-internal entity)
 206   )
 207
 208 (luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity))
 209   (mime-buffer-entity-body-end-internal entity)
 210   )
 211
 212
 213 ;;; @ buffer (obsolete)
 214 ;;;
 215
 216 (luna-define-method mime-entity-buffer ((entity mime-buffer-entity))
 217   (mime-buffer-entity-buffer-internal entity)
 218   )
 219
 220 (luna-define-method mime-entity-point-min ((entity mime-buffer-entity))
 221   (mime-buffer-entity-header-start-internal entity)
 222   )
 223
 224 (luna-define-method mime-entity-point-max ((entity mime-buffer-entity))
 225   (mime-buffer-entity-body-end-internal entity)
 226   )
 227
 228
 229 ;;; @ end
 230 ;;;
 231
 232 (provide 'mmbuffer)
 233
 234 ;;; mmbuffer.el ends here