mime/mmbabyl.el

   1 ;;; mmbabyl.el --- MIME entity module for Babyl buffer
   2
   3 ;; Copyright (C) 2000 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Keywords: Babyl, RMAIL, MIME, multimedia, mail
   7
   8 ;; This file is part of GNU Emacs.
   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 (eval-and-compile
  30   (luna-define-class mime-babyl-entity (mime-buffer-entity)
  31                      (visible-header-start
  32                       visible-header-end))
  33
  34   (luna-define-internal-accessors 'mime-babyl-entity))
  35
  36 (luna-define-method initialize-instance
  37   :after ((entity mime-babyl-entity) &rest init-args)
  38   "Initialize slots of ENTITY.
  39 ENTITY is an instance of `mime-babyl-entity'."
  40   (or (mime-buffer-entity-buffer-internal entity)
  41       (mime-buffer-entity-set-buffer-internal
  42        entity (get-buffer (mime-entity-location-internal entity))))
  43   (save-excursion
  44     (set-buffer (mime-buffer-entity-buffer-internal entity))
  45     (goto-char (point-min))
  46     (let (header-start
  47           header-end
  48           visible-header-start
  49           visible-header-end
  50           body-start)
  51       (forward-line 1)
  52       (if (= (following-char) ?0)
  53           (progn
  54             (forward-line 2)
  55             ;; If there's a Summary-line in the (otherwise empty)
  56             ;; header, we didn't yet get past the EOOH line.
  57             (if (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n")
  58                 (forward-line 1))
  59             (setq header-start (point))
  60             (search-forward "\n\n" nil t)
  61             (setq header-end (1+ (match-beginning 0)))
  62             (setq body-start (match-end 0))
  63             (setq visible-header-start header-start
  64                   visible-header-end header-end))
  65         (forward-line 1)
  66         (setq header-start (point))
  67         (search-forward "\n*** EOOH ***\n" nil t)
  68         (setq header-end (match-beginning 0))
  69         (setq visible-header-start (match-end 0))
  70         (search-forward "\n\n" nil t)
  71         (setq visible-header-end (1+ (match-beginning 0)))
  72         (setq body-start (match-end 0)))
  73       (mime-buffer-entity-set-header-start-internal entity header-start)
  74       (mime-buffer-entity-set-header-end-internal entity header-end)
  75       (mime-buffer-entity-set-body-start-internal entity body-start)
  76       (mime-buffer-entity-set-body-end-internal entity (point-max))
  77       (mime-babyl-entity-set-visible-header-start-internal
  78        entity visible-header-start)
  79       (mime-babyl-entity-set-visible-header-end-internal
  80        entity visible-header-end)
  81       (or (mime-entity-content-type-internal entity)
  82           (save-restriction
  83             (narrow-to-region header-start header-end)
  84             (mime-entity-set-content-type-internal
  85              entity
  86              (let ((str (std11-fetch-field "Content-Type")))
  87                (if str
  88                    (mime-parse-Content-Type str)
  89                  )))
  90             ))
  91       ))
  92   entity)
  93
  94
  95 ;;; @ entity
  96 ;;;
  97
  98 (luna-define-method mime-insert-entity ((entity mime-babyl-entity))
  99    "Insert ENTITY into the current buffer.
 100 ENTITY is an instance of `mime-babyl-entity'.
 101 The header part and the body part of ENTITY are separated by a blank
 102 line."
 103   (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
 104                            (mime-buffer-entity-header-start-internal entity)
 105                            (mime-buffer-entity-header-end-internal entity))
 106   (insert "\n")
 107   (insert-buffer-substring (mime-buffer-entity-buffer-internal entity)
 108                            (mime-buffer-entity-body-start-internal entity)
 109                            (mime-buffer-entity-body-end-internal entity))
 110   )
 111
 112 (luna-define-method mime-write-entity ((entity mime-babyl-entity)
 113                                        filename)
 114   "Write ENTITY into FILENAME.
 115 ENTITY is an instance of `mime-babyl-entity'."
 116   (with-temp-buffer
 117     (mime-insert-entity entity)
 118     (raw-message-write-region (point-min) (point-max) filename)))
 119
 120
 121 ;;; @ entity header
 122 ;;;
 123
 124
 125 ;;; @ entity body
 126 ;;;
 127
 128
 129 ;;; @ entity content
 130 ;;;
 131
 132
 133 ;;; @ header field
 134 ;;;
 135
 136 (luna-define-method mime-insert-header ((entity mime-babyl-entity)
 137                                         &optional invisible-fields
 138                                         visible-fields)
 139   "Insert the header of ENTITY in the current buffer.
 140 ENTITY is an instance of `mime-babyl-entity'.
 141 The optional arguemnts are currently ignored."
 142   (mime-insert-header-from-buffer
 143    (mime-buffer-entity-buffer-internal entity)
 144    (mime-babyl-entity-visible-header-start-internal entity)
 145    (mime-babyl-entity-visible-header-end-internal entity)
 146    nil nil)
 147   )
 148
 149
 150 ;;; @ children
 151 ;;;
 152
 153 ;;;%%% docstring \e$B9g$C$F$k!)\e(B
 154
 155 (luna-define-method mime-entity-children ((entity mime-babyl-entity))
 156   "Return a list of ENTITY's children.
 157 ENTITY is an instance of `mime-babyl-entity'."
 158   (let* ((content-type (mime-entity-content-type entity))
 159          (primary-type (mime-content-type-primary-type content-type))
 160          sub-type)
 161     (cond ((eq primary-type 'multipart)
 162            (mmbuffer-parse-multipart entity 'mime-buffer-entity))
 163           ((eq primary-type 'message)
 164            (setq sub-type (mime-content-type-subtype content-type))
 165            (cond ((eq sub-type 'external-body)
 166                   (mmbuffer-parse-encapsulated entity 'external
 167                                                'mime-buffer-entity))
 168                  ((memq sub-type '(rfc822 news))
 169                   (mmbuffer-parse-encapsulated entity nil
 170                                                'mime-buffer-entity)))))))
 171
 172
 173 ;;; @ end
 174 ;;;
 175
 176 (provide 'mmbabyl)
 177
 178 ;;; mmbabyl.el ends here