release.

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

diff --git a/mime-def.el b/mime-def.el
index 88e788e..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)

@@ -302,16 +327,17 @@ message/rfc822, `mime-entity' structures of them are included in
   "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)
 

@@ -352,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)

@@ -364,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)
 

@@ -382,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)