-;;; mmgeneric.el --- MIME entity module for generic buffer
+;;; mmgeneric.el --- MIME generic entity module
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Keywords: MIME, multimedia, mail, news
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; Keywords: definition, MIME, multimedia, mail, news
;; This file is part of FLIM (Faithful Library about Internet Message).
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Code:
-(require 'mime)
-(require 'mime-parse)
+(require 'luna)
-(mm-define-backend generic)
+(eval-when-compile
+ (require 'eword-decode) ; mime-find-field-presentation-method
+ )
-(mm-define-method entity-header-start ((entity generic))
- (mime-entity-set-header-start-internal
- entity
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- (point-min)
- )))
-(mm-define-method entity-header-end ((entity generic))
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- (mime-entity-header-end-internal entity)
- ))
+;;; @ MIME entity
+;;;
-(mm-define-method entity-body-start ((entity generic))
- (mime-entity-set-body-start-internal
- entity
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- (mime-entity-body-start-internal entity)
- )))
-
-(mm-define-method entity-body-end ((entity generic))
- (mime-entity-set-body-end-internal
- entity
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- (point-max)
- )))
-
-(mm-define-method entity-point-min ((entity generic))
- (or (mime-entity-header-start-internal entity)
- (mime-entity-send entity 'entity-header-start)))
-
-(mm-define-method entity-point-max ((entity generic))
- (or (mime-entity-body-end-internal entity)
- (mime-entity-send entity 'entity-body-end)))
-
-(mm-define-method fetch-field ((entity generic) field-name)
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- (save-restriction
- (narrow-to-region (mime-entity-header-start-internal entity)
- (mime-entity-header-end-internal entity))
- (std11-fetch-field field-name)
- )))
-
-(mm-define-method entity-cooked-p ((entity generic)) nil)
-
-(mm-define-method entity-children ((entity generic))
- (let* ((content-type (mime-entity-content-type entity))
- (primary-type (mime-content-type-primary-type content-type)))
- (cond ((eq primary-type 'multipart)
- (mime-parse-multipart entity)
- )
- ((and (eq primary-type 'message)
- (memq (mime-content-type-subtype content-type)
- '(rfc822 news external-body)
- ))
- (mime-parse-encapsulated entity)
- ))
- ))
+(autoload 'mime-entity-content-type "mime")
+(autoload 'mime-parse-multipart "mime-parse")
+(autoload 'mime-parse-message "mime-parse")
+;; (autoload 'mime-parse-encapsulated "mime-parse")
+;; (autoload 'mime-parse-external "mime-parse")
+(autoload 'mime-entity-content "mime")
+
+(eval-and-compile
+ (luna-define-class mime-entity ()
+ (location
+ content-type children parent
+ node-id
+ content-disposition encoding
+ ;; for other fields
+ original-header parsed-header))
+
+ (luna-define-internal-accessors 'mime-entity)
+ )
-(mm-define-method entity-content ((entity generic))
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- (mime-decode-string
- (buffer-substring (mime-entity-body-start-internal entity)
- (mime-entity-body-end-internal entity))
- (mime-entity-encoding entity))))
-
-(mm-define-method insert-entity-content ((entity generic))
- (insert (with-current-buffer (mime-entity-buffer entity)
- (mime-decode-string
- (buffer-substring (mime-entity-body-start-internal entity)
- (mime-entity-body-end-internal entity))
- (mime-entity-encoding entity)))))
-
-(mm-define-method write-entity-content ((entity generic) filename)
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- (mime-write-decoded-region (mime-entity-body-start-internal entity)
- (mime-entity-body-end-internal entity)
- filename
- (or (mime-entity-encoding entity) "7bit"))
- ))
+(defalias 'mime-entity-representation-type-internal 'luna-class-name)
+(defalias 'mime-entity-set-representation-type-internal 'luna-set-class-name)
-(mm-define-method insert-entity ((entity generic))
- (insert-buffer-substring (mime-entity-buffer entity)
- (mime-entity-header-start-internal entity)
- (mime-entity-body-end-internal entity))
- )
+(luna-define-method mime-entity-fetch-field ((entity mime-entity)
+ field-name)
+ (or (symbolp field-name)
+ (setq field-name (intern (capitalize field-name))))
+ (cdr (assq field-name
+ (mime-entity-original-header-internal entity))))
-(mm-define-method write-entity ((entity generic) filename)
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- (write-region-as-raw-text-CRLF (mime-entity-header-start-internal entity)
- (mime-entity-body-end-internal entity)
- filename)
- ))
+(luna-define-method mime-insert-text-content ((entity mime-entity))
+ (insert
+ (decode-mime-charset-string (mime-entity-content entity)
+ (or (mime-content-type-parameter
+ (mime-entity-content-type entity)
+ "charset")
+ default-mime-charset)
+ 'CRLF)
+ ))
+
+
+;;; @ for mm-backend
+;;;
-(mm-define-method write-entity-body ((entity generic) filename)
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- (write-region-as-binary (mime-entity-body-start-internal entity)
- (mime-entity-body-end-internal entity)
- filename)
+(defmacro mm-expand-class-name (type)
+ `(intern (format "mime-%s-entity" ,type)))
+
+(defmacro mm-define-backend (type &optional parents)
+ `(luna-define-class ,(mm-expand-class-name type)
+ ,(nconc (mapcar (lambda (parent)
+ (mm-expand-class-name parent)
+ )
+ parents)
+ '(mime-entity))))
+
+(defmacro mm-define-method (name args &rest body)
+ (or (eq name 'initialize-instance)
+ (setq name (intern (format "mime-%s" name))))
+ (let ((spec (car args)))
+ (setq args
+ (cons (list (car spec)
+ (mm-expand-class-name (nth 1 spec)))
+ (cdr args)))
+ `(luna-define-method ,name ,args ,@body)
))
+(put 'mm-define-method 'lisp-indent-function 'defun)
+
+(def-edebug-spec mm-define-method
+ (&define name ((arg symbolp)
+ [&rest arg]
+ [&optional ["&optional" arg &rest arg]]
+ &optional ["&rest" arg]
+ )
+ def-body))
+
+
+;;; @ header filter
+;;;
+
+;; [tomo] We should think about specification of better filtering
+;; mechanism. Please discuss in the emacs-mime mailing lists.
+
(defun mime-visible-field-p (field-name visible-fields invisible-fields)
(or (catch 'found
(while visible-fields
(insert "\n")
)))))))
-(mm-define-method insert-header ((entity generic)
- &optional invisible-fields visible-fields)
- (mime-insert-header-from-buffer
- (mime-entity-buffer entity)
- (mime-entity-header-start-internal entity)
- (mime-entity-header-end-internal entity)
- invisible-fields visible-fields)
- )
-
-(mm-define-method insert-text-content ((entity generic))
- (insert
- (decode-mime-charset-string (mime-entity-content entity)
- (or (mime-content-type-parameter
- (mime-entity-content-type entity)
- "charset")
- default-mime-charset)
- 'CRLF)
- ))
-
;;; @ end
;;;
projects / elisp / flim.git / blobdiff