release.

[elisp/flim.git] / mime-def.el

diff --git a/mime-def.el b/mime-def.el
index 685318b..35bda0d 100644 (file)
--- a/mime-def.el
+++ b/mime-def.el
@@ -32,26 +32,24 @@
 (require 'mcharset)
 (require 'alist)
 
 (require 'mcharset)
 (require 'alist)
 

-(eval-when-compile (require 'cl))      ; list*
-

 (eval-and-compile
 (eval-and-compile

-  (defconst mime-library-product ["Chao" (1 13 0) "JR Fujinomori"]
+  (defconst mime-library-product ["CLIME" (1 13 3) "\e$BJ?C<\e(B"]

     "Product name, version number and code name of MIME-library package.")
   )
 
 (defmacro mime-product-name (product)
     "Product name, version number and code name of MIME-library package.")
   )
 
 (defmacro mime-product-name (product)

-  `(aref ,product 0))
+  (` (aref (, product) 0)))

 
 (defmacro mime-product-version (product)
 
 (defmacro mime-product-version (product)

-  `(aref ,product 1))
+  (` (aref (, product) 1)))

 
 (defmacro mime-product-code-name (product)
 
 (defmacro mime-product-code-name (product)

-  `(aref ,product 2))
+  (` (aref (, product) 2)))

 
 (defconst mime-library-version
   (eval-when-compile
     (concat (mime-product-name mime-library-product) " "
 
 (defconst mime-library-version
   (eval-when-compile
     (concat (mime-product-name mime-library-product) " "

-           (mapconcat #'number-to-string
+           (mapconcat (function int-to-string)

                       (mime-product-version mime-library-product) ".")
            " - \"" (mime-product-code-name mime-library-product) "\"")))
 
                       (mime-product-version mime-library-product) ".")
            " - \"" (mime-product-code-name mime-library-product) "\"")))
 

@@ -59,8 +57,6 @@
 ;;; @ variables
 ;;;
 
 ;;; @ variables
 ;;;
 

-(require 'custom)
-

 (defgroup mime '((default-mime-charset custom-variable))
   "Emacs MIME Interfaces"
   :group 'news
 (defgroup mime '((default-mime-charset custom-variable))
   "Emacs MIME Interfaces"
   :group 'news

@@ -157,10 +153,9 @@
 ;;;
 
 (defsubst make-mime-content-type (type subtype &optional parameters)
 ;;;
 
 (defsubst make-mime-content-type (type subtype &optional parameters)

-  (list* (cons 'type type)
-        (cons 'subtype subtype)
-        (nreverse parameters))
-  )
+  (cons (cons 'type type)
+       (cons (cons 'subtype subtype)
+             (nreverse parameters))))

 
 (defsubst mime-content-type-primary-type (content-type)
   "Return primary-type of CONTENT-TYPE."
 
 (defsubst mime-content-type-primary-type (content-type)
   "Return primary-type of CONTENT-TYPE."

@@ -212,6 +207,11 @@
 
 (require 'luna)
 
 
 (require 'luna)
 

+(autoload 'mime-entity-content-type "mime")
+(autoload 'mime-parse-multipart "mime-parse")
+(autoload 'mime-parse-encapsulated "mime-parse")
+(autoload 'mime-entity-content "mime")
+

 (luna-define-class mime-entity ()
                   (location
                    content-type children parent
 (luna-define-class mime-entity ()
                   (location
                    content-type children parent

@@ -232,20 +232,45 @@
   (cdr (assq field-name
             (mime-entity-original-header-internal entity))))
 
   (cdr (assq field-name
             (mime-entity-original-header-internal entity))))
 

+(luna-define-method mime-entity-children ((entity mime-entity))
+  (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)
+          ))
+    ))
+
+(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
 ;;;
 
 (defmacro mm-expand-class-name (type)
 
 ;;; @ for mm-backend
 ;;;
 
 (defmacro mm-expand-class-name (type)

-  `(intern (format "mime-%s-entity" ,type)))
+  (` (intern (format "mime-%s-entity" (, type)))))

 
 (defmacro mm-define-backend (type &optional parents)
 
 (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))))
+  (` (luna-define-class (, (mm-expand-class-name type))
+                       (, (nconc (mapcar (function
+                                          (lambda (parent)
+                                            (mm-expand-class-name parent)
+                                            ))
+                                         parents)
+                                 '(mime-entity))))))

 
 (defmacro mm-define-method (name args &rest body)
   (or (eq name 'initialize-instance)
 
 (defmacro mm-define-method (name args &rest body)
   (or (eq name 'initialize-instance)

@@ -255,7 +280,7 @@
          (cons (list (car spec)
                      (mm-expand-class-name (nth 1 spec)))
                (cdr args)))
          (cons (list (car spec)
                      (mm-expand-class-name (nth 1 spec)))
                (cdr args)))

-    `(luna-define-method ,name ,args ,@body)
+    (` (luna-define-method (, name) (, args) (,@ body)))

     ))
 
 (put 'mm-define-method 'lisp-indent-function 'defun)
     ))
 
 (put 'mm-define-method 'lisp-indent-function 'defun)

@@ -290,61 +315,6 @@ message/rfc822, `mime-entity' structures of them are included in
 
 (make-variable-buffer-local 'mime-message-structure)
 
 
 (make-variable-buffer-local 'mime-message-structure)
 

-
-;;; @ for mm-backend
-;;;
-
-(defvar mime-entity-implementation-alist nil)
-
-(defmacro mm-define-backend (type &optional parents)
-  "Define TYPE as a mm-backend.
-If PARENTS is specified, TYPE inherits PARENTS.
-Each parent must be backend name (symbol)."
-  (if parents
-      `(let ((rest ',(reverse parents)))
-        (while rest
-          (set-alist 'mime-entity-implementation-alist
-                     ',type
-                     (copy-alist
-                      (cdr (assq (car rest)
-                                 mime-entity-implementation-alist))))
-          (setq rest (cdr rest))
-          ))))
-
-(defmacro mm-define-method (name args &rest body)
-  "Define NAME as a method function of (nth 1 (car ARGS)) backend.
-
-ARGS is like an argument list of lambda, but (car ARGS) must be
-specialized parameter.  (car (car ARGS)) is name of variable and (nth
-1 (car ARGS)) is name of backend."
-  (let* ((specializer (car args))
-        (class (nth 1 specializer))
-        (self (car specializer)))
-    `(let ((imps (cdr (assq ',class mime-entity-implementation-alist)))
-          (func (lambda ,(if self
-                             (cons self (cdr args))
-                           (cdr args))
-                  ,@body)))
-       (if imps
-          (set-alist 'mime-entity-implementation-alist
-                     ',class (put-alist ',name func imps))
-        (set-alist 'mime-entity-implementation-alist
-                   ',class
-                   (list (cons ',name func)))
-        ))))
-
-(put 'mm-define-method 'lisp-indent-function 'defun)
-
-(eval-when-compile
-  (defmacro eval-module-depended-macro (module definition)
-    (condition-case nil
-       (progn
-         (require (eval module))
-         definition)
-      (error `(eval-after-load ,(symbol-name (eval module)) ',definition))
-      ))
-  )
-

 (make-obsolete-variable 'mime-message-structure "should not use it.")
 
 
 (make-obsolete-variable 'mime-message-structure "should not use it.")
 
 

@@ -357,16 +327,17 @@ specialized parameter.  (car (car ARGS)) is name of variable and (nth
   "Define NAME as a service for Content-Transfer-Encodings.
 If ARGS is specified, NAME is defined as a generic function for the
 service."
   "Define NAME as a service for Content-Transfer-Encodings.
 If ARGS is specified, NAME is defined as a generic function for the
 service."

-  `(progn
-     (add-to-list 'mel-service-list ',name)
-     (defvar ,(intern (format "%s-obarray" name)) (make-vector 7 0))
-     ,@(if args
-          `((defun ,name ,args
-              ,@rest
-              (funcall (mel-find-function ',name ,(car (last args)))
-                       ,@(luna-arglist-to-arguments (butlast args)))
-              )))
-     ))
+  (` (progn
+       (add-to-list 'mel-service-list '(, name))
+       (defvar (, (intern (format "%s-obarray" name))) (make-vector 7 0))
+       (,@ (if args
+              (` ((defun (, name) (, args)
+                    (,@ rest)
+                    (funcall (mel-find-function '(, name)
+                                                (, (car (last args))))
+                             (,@ (luna-arglist-to-arguments (butlast args))))
+                    )))))
+       )))

 
 (put 'mel-define-service 'lisp-indent-function 'defun)
 
 
 (put 'mel-define-service 'lisp-indent-function 'defun)
 

@@ -407,9 +378,10 @@ service."
 If PARENTS is specified, TYPE inherits PARENTS.
 Each parent must be backend name (string)."
   (cons 'progn
 If PARENTS is specified, TYPE inherits PARENTS.
 Each parent must be backend name (string)."
   (cons 'progn

-       (mapcar (lambda (parent)
-                 `(mel-copy-backend ,parent ,type)
-                 )
+       (mapcar (function
+                (lambda (parent)
+                  (` (mel-copy-backend (, parent) (, type)))
+                  ))

                parents)))
 
 (defmacro mel-define-method (name args &rest body)
                parents)))
 
 (defmacro mel-define-method (name args &rest body)

@@ -419,11 +391,12 @@ specialized parameter.  (car (car (last ARGS))) is name of variable
 and (nth 1 (car (last ARGS))) is name of backend (encoding)."
   (let* ((specializer (car (last args)))
         (class (nth 1 specializer)))
 and (nth 1 (car (last ARGS))) is name of backend (encoding)."
   (let* ((specializer (car (last args)))
         (class (nth 1 specializer)))

-    `(progn
-       (mel-define-service ,name)
-       (fset (intern ,class ,(intern (format "%s-obarray" name)))
-            (lambda ,(butlast args)
-              ,@body)))))
+    (` (progn
+        (mel-define-service (, name))
+        (fset (intern (, class) (, (intern (format "%s-obarray" name))))
+              (function
+               (lambda (, (butlast args))
+                 (,@ body))))))))

 
 (put 'mel-define-method 'lisp-indent-function 'defun)
 
 
 (put 'mel-define-method 'lisp-indent-function 'defun)
 

@@ -437,21 +410,21 @@ variable and (nth 1 (car (last ARGS))) is name of backend (encoding)."
         (args (cdr spec))
         (specializer (car (last args)))
         (class (nth 1 specializer)))
         (args (cdr spec))
         (specializer (car (last args)))
         (class (nth 1 specializer)))

-    `(let (sym)
-       (mel-define-service ,name)
-       (setq sym (intern ,class ,(intern (format "%s-obarray" name))))
-       (or (fboundp sym)
-          (fset sym (symbol-function ,function))))))
+    (` (let (sym)
+        (mel-define-service (, name))
+        (setq sym (intern (, class) (, (intern (format "%s-obarray" name)))))
+        (or (fboundp sym)
+            (fset sym (symbol-function (, function))))))))

 
 (defmacro mel-define-function (function spec)
   (let* ((name (car spec))
         (args (cdr spec))
         (specializer (car (last args)))
         (class (nth 1 specializer)))
 
 (defmacro mel-define-function (function spec)
   (let* ((name (car spec))
         (args (cdr spec))
         (specializer (car (last args)))
         (class (nth 1 specializer)))

-    `(progn
-       (define-function ,function
-        (intern ,class ,(intern (format "%s-obarray" name))))
-       )))
+    (` (progn
+        (define-function (, function)
+          (intern (, class) (, (intern (format "%s-obarray" name)))))
+        ))))

 
 (defvar base64-dl-module
   (if (and (fboundp 'base64-encode-string)
 
 (defvar base64-dl-module
   (if (and (fboundp 'base64-encode-string)