Merge remote-tracking branch 'remotes/origin/flim-1_14'.
[elisp/flim.git] / mime.el
diff --git a/mime.el b/mime.el
index 63af880..9dc2fcc 100644 (file)
--- a/mime.el
+++ b/mime.el
@@ -1,8 +1,6 @@
 ;;; mime.el --- MIME library module
 
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1998,1999,2000,2001,2003 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: MIME, multimedia, mail, news
@@ -21,8 +19,8 @@
 
 ;; 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-def)
 (require 'eword-decode)
 
+(eval-when-compile (require 'mmgeneric))
+
 (eval-and-compile
 
-(autoload 'eword-encode-header "eword-encode"
+(autoload 'mime-encode-header-in-buffer "eword-encode"
   "Encode header fields to network representation, such as MIME encoded-word.")
 
 (autoload 'mime-parse-Content-Type "mime-parse"
@@ -65,6 +65,10 @@ current-buffer, and return it.")
 
 )
 
+(autoload 'mime-encode-field-body "eword-encode"
+  "Encode FIELD-BODY as FIELD-NAME, and return the result.")
+
+
 ;;; @ Entity Representation and Implementation
 ;;;
 
@@ -87,20 +91,20 @@ representation-type."
 ;;;
 
 (defun mime-entity-children (entity)
+  "Return list of entities included in the ENTITY."
   (or (mime-entity-children-internal entity)
       (luna-send entity 'mime-entity-children entity)))
 
-(defalias 'mime-entity-node-id 'mime-entity-node-id-internal)
+(defun mime-entity-node-id (entity)
+  "Return node-id of ENTITY."
+  (mime-entity-node-id-internal entity))
 
 (defun mime-entity-number (entity)
   "Return entity-number of ENTITY."
   (reverse (mime-entity-node-id-internal entity)))
 
-(defun mime-find-entity-from-number (entity-number &optional message)
-  "Return entity from ENTITY-NUMBER in MESSAGE.
-If MESSAGE is not specified, `mime-message-structure' is used."
-  (or message
-      (setq message mime-message-structure))
+(defun mime-find-entity-from-number (entity-number message)
+  "Return entity from ENTITY-NUMBER in MESSAGE."
   (let ((sn (car entity-number)))
     (if (null sn)
        message
@@ -110,16 +114,12 @@ If MESSAGE is not specified, `mime-message-structure' is used."
          ))
       )))
 
-(defun mime-find-entity-from-node-id (entity-node-id &optional message)
-  "Return entity from ENTITY-NODE-ID in MESSAGE.
-If MESSAGE is not specified, `mime-message-structure' is used."
+(defun mime-find-entity-from-node-id (entity-node-id message)
+  "Return entity from ENTITY-NODE-ID in MESSAGE."
   (mime-find-entity-from-number (reverse entity-node-id) message))
 
-(defun mime-find-entity-from-content-id (cid &optional message)
-  "Return entity from CID in MESSAGE.
-If MESSAGE is not specified, `mime-message-structure' is used."
-  (or message
-      (setq message mime-message-structure))
+(defun mime-find-entity-from-content-id (cid message)
+  "Return entity from CID in MESSAGE."
   (if (equal cid (mime-entity-read-field message "Content-Id"))
       message
     (let ((children (mime-entity-children message))
@@ -142,78 +142,133 @@ If MESSAGE is specified, it is regarded as root entity."
 If MESSAGE is specified, it is regarded as root entity."
   (null (mime-entity-parent entity message)))
 
+(defun mime-find-root-entity (entity)
+  "Return root entity of ENTITY."
+  (while (not (mime-root-entity-p entity))
+    (setq entity (mime-entity-parent entity)))
+  entity)
+
 
-;;; @ Header buffer
+;;; @ Header buffer (obsolete)
 ;;;
 
-(luna-define-generic mime-entity-header-buffer (entity))
+;; (luna-define-generic mime-entity-header-buffer (entity))
 
-(luna-define-generic mime-goto-header-start-point (entity)
-  "Set buffer and point to header-start-position of ENTITY.")
+;; (luna-define-generic mime-goto-header-start-point (entity)
+;;   "Set buffer and point to header-start-position of ENTITY.")
 
-(luna-define-generic mime-entity-header-start-point (entity)
-  "Return header-start-position of ENTITY.")
+;; (luna-define-generic mime-entity-header-start-point (entity)
+;;   "Return header-start-position of ENTITY.")
 
-(luna-define-generic mime-entity-header-end-point (entity)
-  "Return header-end-position of ENTITY.")
+;; (luna-define-generic mime-entity-header-end-point (entity)
+;;   "Return header-end-position of ENTITY.")
 
+;; (make-obsolete 'mime-entity-header-buffer "don't use it.")
+;; (make-obsolete 'mime-goto-header-start-point "don't use it.")
+;; (make-obsolete 'mime-entity-header-start-point "don't use it.")
+;; (make-obsolete 'mime-entity-header-end-point "don't use it.")
 
-;;; @ Body buffer
+
+;;; @ Body buffer (obsolete)
 ;;;
 
-(luna-define-generic mime-entity-body-buffer (entity))
+;; (luna-define-generic mime-entity-body-buffer (entity))
 
-(luna-define-generic mime-goto-body-start-point (entity)
-  "Set buffer and point to body-start-position of ENTITY.")
+;; (luna-define-generic mime-goto-body-start-point (entity)
+;;   "Set buffer and point to body-start-position of ENTITY.")
 
-(luna-define-generic mime-goto-body-end-point (entity)
-  "Set buffer and point to body-end-position of ENTITY.")
+;; (luna-define-generic mime-goto-body-end-point (entity)
+;;   "Set buffer and point to body-end-position of ENTITY.")
 
-(luna-define-generic mime-entity-body-start-point (entity)
-  "Return body-start-position of ENTITY.")
+;; (luna-define-generic mime-entity-body-start-point (entity)
+;;   "Return body-start-position of ENTITY.")
 
-(define-obsolete-function-alias
-  'mime-entity-body-start 'mime-entity-body-start-point)
+;; (luna-define-generic mime-entity-body-end-point (entity)
+;;   "Return body-end-position of ENTITY.")
 
-(luna-define-generic mime-entity-body-end-point (entity)
-  "Return body-end-position of ENTITY.")
+;; (defalias 'mime-entity-body-start 'mime-entity-body-start-point)
+;; (defalias 'mime-entity-body-end 'mime-entity-body-end-point)
 
-(define-obsolete-function-alias
-  'mime-entity-body-end 'mime-entity-body-end-point)
+;; (make-obsolete 'mime-entity-body-buffer "don't use it.")
+;; (make-obsolete 'mime-goto-body-start-point "don't use it.")
+;; (make-obsolete 'mime-goto-body-end-point "don't use it.")
+;; (make-obsolete 'mime-entity-body-start-point "don't use it.")
+;; (make-obsolete 'mime-entity-body-end-point "don't use it.")
+;; (make-obsolete 'mime-entity-body-start "don't use it.")
+;; (make-obsolete 'mime-entity-body-end "don't use it.")
 
 
 ;;; @ Entity buffer (obsolete)
 ;;;
 
-(luna-define-generic mime-entity-buffer (entity))
-(make-obsolete 'mime-entity-buffer
- "use mime-entity-header-buffer or mime-entity-body-buffer instead.")
+;; (luna-define-generic mime-entity-buffer (entity))
+;; (make-obsolete 'mime-entity-buffer "don't use it.")
+
+;; (luna-define-generic mime-entity-point-min (entity))
+;; (make-obsolete 'mime-entity-point-min "don't use it.")
+
+;; (luna-define-generic mime-entity-point-max (entity))
+;; (make-obsolete 'mime-entity-point-max "don't use it.")
+
+
+;;; @ Entity
+;;;
+
+(luna-define-generic mime-insert-entity (entity)
+  "Insert header and body of ENTITY at point.")
+
+(luna-define-generic mime-write-entity (entity filename)
+  "Write header and body of ENTITY into FILENAME.")
+
+
+;;; @ Entity Body
+;;;
+
+(luna-define-generic mime-entity-body (entity)
+  "Return network representation of ENTITY body.")
+
+(luna-define-generic mime-insert-entity-body (entity)
+  "Insert network representation of ENTITY body at point.")
+
+(luna-define-generic mime-write-entity-body (entity filename)
+  "Write body of ENTITY into FILENAME.")
+
+
+;;; @ Entity Content
+;;;
+
+(luna-define-generic mime-entity-content (entity)
+  "Return content of ENTITY as byte sequence (string).")
+
+(luna-define-generic mime-insert-entity-content (entity)
+  "Insert content of ENTITY at point.")
 
-(luna-define-generic mime-entity-point-min (entity))
-(make-obsolete 'mime-entity-point-min 'mime-entity-header-start-point)
+(luna-define-generic mime-write-entity-content (entity filename)
+  "Write content of ENTITY into FILENAME.")
 
-(luna-define-generic mime-entity-point-max (entity))
-(make-obsolete 'mime-entity-point-max 'mime-entity-body-end-point)
+(luna-define-generic mime-insert-text-content (entity)
+  "Insert decoded text body of ENTITY.")
 
 
-;;; @ Entity Header
+;;; @ Header fields
 ;;;
 
 (luna-define-generic mime-entity-fetch-field (entity field-name)
   "Return the value of the ENTITY's header field whose type is FIELD-NAME.")
 
-(defun mime-fetch-field (field-name &optional entity)
-  "Return the value of the ENTITY's header field whose type is FIELD-NAME."
-  (if (symbolp field-name)
-      (setq field-name (symbol-name field-name))
-    )
-  (or entity
-      (setq entity mime-message-structure))
-  (mime-entity-fetch-field entity field-name)
-  )
-(make-obsolete 'mime-fetch-field 'mime-entity-fetch-field)
+;; (defun mime-fetch-field (field-name &optional entity)
+;;   "Return the value of the ENTITY's header field whose type is FIELD-NAME."
+;;   (if (symbolp field-name)
+;;       (setq field-name (symbol-name field-name))
+;;     )
+;;   (or entity
+;;       (setq entity mime-message-structure))
+;;   (mime-entity-fetch-field entity field-name)
+;;   )
+;; (make-obsolete 'mime-fetch-field 'mime-entity-fetch-field)
 
 (defun mime-entity-content-type (entity)
+  "Return content-type of ENTITY."
   (or (mime-entity-content-type-internal entity)
       (let ((ret (mime-entity-fetch-field entity "Content-Type")))
        (if ret
@@ -222,6 +277,7 @@ If MESSAGE is specified, it is regarded as root entity."
          ))))
 
 (defun mime-entity-content-disposition (entity)
+  "Return content-disposition of ENTITY."
   (or (mime-entity-content-disposition-internal entity)
       (let ((ret (mime-entity-fetch-field entity "Content-Disposition")))
        (if ret
@@ -230,6 +286,10 @@ If MESSAGE is specified, it is regarded as root entity."
          ))))
 
 (defun mime-entity-encoding (entity &optional default-encoding)
+  "Return content-transfer-encoding of ENTITY.
+If the ENTITY does not have Content-Transfer-Encoding field, this
+function returns DEFAULT-ENCODING.  If it is nil, \"7bit\" is used as
+default value."
   (or (mime-entity-encoding-internal entity)
       (let ((ret (mime-entity-fetch-field entity "Content-Transfer-Encoding")))
        (mime-entity-set-encoding-internal
@@ -272,7 +332,7 @@ If MESSAGE is specified, it is regarded as root entity."
                 (prog1
                     field-name
                   (setq field-name (symbol-name field-name)))
-              (capitalize (capitalize field-name)))))
+              (intern (capitalize field-name)))))
     (cond ((eq sym 'Content-Type)
           (mime-entity-content-type entity)
           )
@@ -301,12 +361,12 @@ If MESSAGE is specified, it is regarded as root entity."
                      entity (put-alist sym field header))
                     field))))))))
 
-(defun mime-read-field (field-name &optional entity)
-  (or entity
-      (setq entity mime-message-structure))
-  (mime-entity-read-field entity field-name)
-  )
-(make-obsolete 'mime-read-field 'mime-entity-read-field)
+;; (defun mime-read-field (field-name &optional entity)
+;;   (or entity
+;;       (setq entity mime-message-structure))
+;;   (mime-entity-read-field entity field-name)
+;;   )
+;; (make-obsolete 'mime-read-field 'mime-entity-read-field)
 
 (luna-define-generic mime-insert-header (entity &optional invisible-fields
                                                visible-fields)
@@ -321,10 +381,9 @@ If MESSAGE is specified, it is regarded as root entity."
 
 (defun mime-entity-uu-filename (entity)
   (if (member (mime-entity-encoding entity) mime-uuencode-encoding-name-list)
-      (save-excursion
-       (mime-goto-body-start-point entity)
-       (if (re-search-forward "^begin [0-9]+ "
-                              (mime-entity-body-end-point entity) t)
+      (with-temp-buffer
+       (mime-insert-entity-body entity)
+       (if (re-search-forward "^begin [0-9]+ " nil t)
            (if (looking-at ".+$")
                (buffer-substring (match-beginning 0)(match-end 0))
              )))))
@@ -332,49 +391,42 @@ If MESSAGE is specified, it is regarded as root entity."
 (defun mime-entity-filename (entity)
   "Return filename of ENTITY."
   (or (mime-entity-uu-filename entity)
-      (mime-content-disposition-filename
-       (mime-entity-content-disposition entity))
+      (let ((ret (mime-content-disposition-filename
+                 (mime-entity-content-disposition entity))))
+       (if (and mime-header-accept-quoted-encoded-words
+                ret)
+           (eword-decode-string ret)
+         ret))
       (cdr (let ((param (mime-content-type-parameters
                         (mime-entity-content-type entity))))
             (or (assoc "name" param)
-                (assoc "x-name" param))
-            ))))
+                (assoc "x-name" param))))))
 
 
 (defsubst mime-entity-media-type (entity)
+  "Return primary media-type of ENTITY."
   (mime-content-type-primary-type (mime-entity-content-type entity)))
+
 (defsubst mime-entity-media-subtype (entity)
+  "Return media-subtype of ENTITY."
   (mime-content-type-subtype (mime-entity-content-type entity)))
+
 (defsubst mime-entity-parameters (entity)
+  "Return parameters of Content-Type of ENTITY."
   (mime-content-type-parameters (mime-entity-content-type entity)))
+
 (defsubst mime-entity-type/subtype (entity-info)
+  "Return type/subtype of Content-Type of ENTITY."
   (mime-type/subtype-string (mime-entity-media-type entity-info)
                            (mime-entity-media-subtype entity-info)))
 
+(defun mime-entity-set-content-type (entity content-type)
+  "Set ENTITY's content-type to CONTENT-TYPE."
+  (mime-entity-set-content-type-internal entity content-type))
 
-;;; @ Entity Content
-;;;
-
-(luna-define-generic mime-entity-content (entity)
-  "Return content of ENTITY as byte sequence (string).")
-
-(luna-define-generic mime-insert-entity-content (entity)
-  "Insert content of ENTITY at point.")
-
-(luna-define-generic mime-write-entity-content (entity filename)
-  "Write content of ENTITY into FILENAME.")
-
-(luna-define-generic mime-insert-text-content (entity)
-  "Insert decoded text body of ENTITY.")
-
-(luna-define-generic mime-insert-entity (entity)
-  "Insert header and body of ENTITY at point.")
-
-(luna-define-generic mime-write-entity (entity filename)
-  "Write header and body of ENTITY into FILENAME.")
-
-(luna-define-generic mime-write-entity-body (entity filename)
-  "Write body of ENTITY into FILENAME.")
+(defun mime-entity-set-encoding (entity encoding)
+  "Set ENTITY's content-transfer-encoding to ENCODING."
+  (mime-entity-set-encoding-internal entity encoding))
 
 
 ;;; @ end