mmgeneric.el

   1 ;;; mmgeneric.el --- MIME generic entity module
   2
   3 ;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Keywords: definition, 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 'luna)
  28
  29
  30 ;;; @ MIME entity
  31 ;;;
  32
  33 (autoload 'mime-entity-content-type "mime")
  34 (autoload 'mime-parse-multipart "mime-parse")
  35 (autoload 'mime-parse-encapsulated "mime-parse")
  36 (autoload 'mime-parse-external "mime-parse")
  37 (autoload 'mime-entity-content "mime")
  38
  39 (luna-define-class mime-entity ()
  40                    (location
  41                     content-type children parent
  42                     node-id
  43                     content-disposition encoding
  44                     ;; for other fields
  45                     original-header parsed-header))
  46
  47 (defalias 'mime-entity-representation-type-internal 'luna-class-name)
  48 (defalias 'mime-entity-set-representation-type-internal 'luna-set-class-name)
  49
  50 (luna-define-internal-accessors 'mime-entity)
  51
  52 (luna-define-method mime-entity-fetch-field ((entity mime-entity)
  53                                              field-name)
  54   (or (symbolp field-name)
  55       (setq field-name (intern (capitalize (capitalize field-name)))))
  56   (cdr (assq field-name
  57              (mime-entity-original-header-internal entity))))
  58
  59 (luna-define-method mime-entity-children ((entity mime-entity))
  60   (let* ((content-type (mime-entity-content-type entity))
  61          (primary-type (mime-content-type-primary-type content-type))
  62          sub-type)
  63     (cond ((eq primary-type 'multipart)
  64            (mime-parse-multipart entity))
  65           ((eq primary-type 'message)
  66            (setq sub-type (mime-content-type-subtype content-type))
  67            (cond ((eq sub-type 'external-body)
  68                   (mime-parse-external entity))
  69                  ((memq sub-type '(rfc822 news))
  70                   (mime-parse-encapsulated entity)
  71                   ;; [tomo] Should we make a variable to specify
  72                   ;; encapsulated media-types?
  73                   ))))))
  74
  75 (luna-define-method mime-insert-text-content ((entity mime-entity))
  76   (insert
  77    (decode-mime-charset-string (mime-entity-content entity)
  78                                (or (mime-content-type-parameter
  79                                     (mime-entity-content-type entity)
  80                                     "charset")
  81                                    default-mime-charset)
  82                                'CRLF)
  83    ))
  84
  85
  86 ;;; @ for mm-backend
  87 ;;;
  88
  89 (defmacro mm-expand-class-name (type)
  90   `(intern (format "mime-%s-entity" ,type)))
  91
  92 (defmacro mm-define-backend (type &optional parents)
  93   `(luna-define-class ,(mm-expand-class-name type)
  94                       ,(nconc (mapcar (lambda (parent)
  95                                         (mm-expand-class-name parent)
  96                                         )
  97                                       parents)
  98                               '(mime-entity))))
  99
 100 (defmacro mm-define-method (name args &rest body)
 101   (or (eq name 'initialize-instance)
 102       (setq name (intern (format "mime-%s" name))))
 103   (let ((spec (car args)))
 104     (setq args
 105           (cons (list (car spec)
 106                       (mm-expand-class-name (nth 1 spec)))
 107                 (cdr args)))
 108     `(luna-define-method ,name ,args ,@body)
 109     ))
 110
 111 (put 'mm-define-method 'lisp-indent-function 'defun)
 112
 113 (def-edebug-spec mm-define-method
 114   (&define name ((arg symbolp)
 115                  [&rest arg]
 116                  [&optional ["&optional" arg &rest arg]]
 117                  &optional ["&rest" arg]
 118                  )
 119            def-body))
 120
 121
 122 ;;; @ end
 123 ;;;
 124
 125 (provide 'mmgeneric)
 126
 127 ;;; mmgeneric.el ends here