X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fflim.git;a=blobdiff_plain;f=mime.el;fp=mime.el;h=9dc2fcc5b74b6404fa5f1bf55b279141a867cbd5;hp=63af880a379814221e5df316f3ddd7f3fec65f7d;hb=7b2f72b7dcd91319f33f1d83c40dbef007e6f726;hpb=b464ad04f9f6fcb233bcf2350a0ac9b0573516ef diff --git a/mime.el b/mime.el index 63af880..9dc2fcc 100644 --- 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 ;; 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: @@ -31,9 +29,11 @@ (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