X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime.el;h=5f4fe72a366e7521654c8d370e9373313654a0c6;hb=8e2dea37380e8e615fcfb35e9d68fbc98d74d182;hp=338aa9c2eee582e0c5a8841ce45698529717f325;hpb=f21480cf7b52fecadea6c52495d55fcc745fb5a7;p=elisp%2Fflim.git diff --git a/mime.el b/mime.el index 338aa9c..5f4fe72 100644 --- a/mime.el +++ b/mime.el @@ -1,6 +1,6 @@ ;;; mime.el --- MIME library module -;; Copyright (C) 1998 Free Software Foundation, Inc. +;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news @@ -73,22 +73,13 @@ current-buffer, and return it.") (mime-find-function service (mime-entity-representation-type-internal entity))) -(defsubst mime-entity-send (entity service &rest args) +(defsubst mime-entity-send (entity message &rest args) + "Send MESSAGE to ENTITY with ARGS, and return the result." (apply (mime-find-function - service (mime-entity-representation-type-internal entity)) + message (mime-entity-representation-type-internal entity)) entity args)) -(defsubst mm-arglist-to-arguments (arglist) - (let (dest) - (while arglist - (let ((arg (car arglist))) - (or (memq arg '(&optional &rest)) - (setq dest (cons arg dest))) - ) - (setq arglist (cdr arglist))) - (nreverse dest))) - (defmacro mm-define-generic (name args &optional doc) (if doc `(defun ,(intern (format "mime-%s" name)) ,args @@ -199,39 +190,86 @@ If MESSAGE is specified, it is regarded as root entity." (setq field-name (intern (capitalize (capitalize field-name))))) (or entity (setq entity mime-message-structure)) - (let* ((header (mime-entity-original-header-internal entity)) - (field-body (cdr (assq field-name header)))) - (or field-body - (progn - (if (setq field-body - (mime-entity-send entity 'fetch-field - (symbol-name field-name))) - (mime-entity-set-original-header-internal - entity (put-alist field-name field-body header)) - ) - field-body)))) - -(defalias 'mime-entity-content-type 'mime-entity-content-type-internal) + (cond ((eq field-name 'Date) + (or (mime-entity-date-internal entity) + (mime-entity-set-date-internal + entity (mime-entity-send entity 'fetch-field "Date")) + )) + ((eq field-name 'Message-Id) + (or (mime-entity-message-id-internal entity) + (mime-entity-set-message-id-internal + entity (mime-entity-send entity 'fetch-field "Message-Id")) + )) + ((eq field-name 'References) + (or (mime-entity-references-internal entity) + (mime-entity-set-references-internal + entity (mime-entity-send entity 'fetch-field "References")) + )) + (t + (let* ((header (mime-entity-original-header-internal entity)) + (field-body (cdr (assq field-name header)))) + (or field-body + (progn + (if (setq field-body + (mime-entity-send entity 'fetch-field + (symbol-name field-name))) + (mime-entity-set-original-header-internal + entity (put-alist field-name field-body header)) + ) + field-body)) + )))) + +(defun mime-entity-content-type (entity) + (or (mime-entity-content-type-internal entity) + (let ((ret (mime-fetch-field 'Content-Type entity))) + (if ret + (mime-entity-set-content-type-internal + entity (mime-parse-Content-Type ret)) + )))) (defun mime-entity-content-disposition (entity) (or (mime-entity-content-disposition-internal entity) (let ((ret (mime-fetch-field 'Content-Disposition entity))) (if ret - (let ((disposition (mime-parse-Content-Disposition ret))) - (when disposition - (mime-entity-set-content-disposition-internal - entity disposition) - disposition)))))) + (mime-entity-set-content-disposition-internal + entity (mime-parse-Content-Disposition ret)) + )))) (defun mime-entity-encoding (entity &optional default-encoding) (or (mime-entity-encoding-internal entity) - (let ((encoding - (or (let ((ret (mime-fetch-field - 'Content-Transfer-Encoding entity))) - (and ret (mime-parse-Content-Transfer-Encoding ret))) - default-encoding "7bit"))) - (mime-entity-set-encoding-internal entity encoding) - encoding))) + (let ((ret (mime-fetch-field 'Content-Transfer-Encoding entity))) + (mime-entity-set-encoding-internal + entity + (or (and ret (mime-parse-Content-Transfer-Encoding ret)) + default-encoding "7bit")) + ))) + +(defvar mime-field-parser-alist + '((Return-Path . std11-parse-route-addr) + + (Reply-To . std11-parse-addresses) + + (Sender . std11-parse-mailbox) + (From . std11-parse-addresses) + + (Resent-Reply-To . std11-parse-addresses) + + (Resent-Sender . std11-parse-mailbox) + (Resent-From . std11-parse-addresses) + + (To . std11-parse-addresses) + (Resent-To . std11-parse-addresses) + (Cc . std11-parse-addresses) + (Resent-Cc . std11-parse-addresses) + (Bcc . std11-parse-addresses) + (Resent-Bcc . std11-parse-addresses) + + (Message-Id . std11-parse-msg-id) + (Recent-Message-Id . std11-parse-msg-id) + + (In-Reply-To . std11-parse-msg-ids) + (References . std11-parse-msg-ids) + )) (defun mime-read-field (field-name &optional entity) (or (symbolp field-name) @@ -251,37 +289,29 @@ If MESSAGE is specified, it is regarded as root entity." (let* ((header (mime-entity-parsed-header-internal entity)) (field (cdr (assq field-name header)))) (or field - (let ((field-body (mime-fetch-field field-name entity))) + (let ((field-body (mime-fetch-field field-name entity)) + parser) (when field-body - (cond ((memq field-name '(From Resent-From - To Resent-To - Cc Resent-Cc - Bcc Resent-Bcc - Reply-To Resent-Reply-To)) - (setq field (std11-parse-addresses - (eword-lexical-analyze field-body))) - ) - ((memq field-name '(Sender Resent-Sender)) - (setq field (std11-parse-address - (eword-lexical-analyze field-body))) - ) - ((memq field-name eword-decode-ignored-field-list) - (setq field field-body)) - ((memq field-name eword-decode-structured-field-list) - (setq field (eword-decode-structured-field-body - field-body))) - (t - (setq field (eword-decode-unstructured-field-body - field-body)) - )) + (setq parser + (cdr (assq field-name mime-field-parser-alist))) + (setq field + (if parser + (funcall parser + (eword-lexical-analyze field-body)) + (mime-decode-field-body + field-body field-name 'native) + )) (mime-entity-set-parsed-header-internal entity (put-alist field-name field header)) field))))))) -(mm-define-generic insert-decoded-header (entity &optional invisible-fields - visible-fields) +(mm-define-generic insert-header (entity &optional invisible-fields + visible-fields) "Insert before point a decoded header of ENTITY.") +(define-obsolete-function-alias + 'mime-insert-decoded-header 'mime-insert-header) + ;;; @ Entity Attributes ;;; @@ -326,9 +356,15 @@ If MESSAGE is specified, it is regarded as root entity." (mm-define-generic entity-content (entity) "Return content of ENTITY as byte sequence (string).") +(mm-define-generic insert-text-content (entity) + "Insert decoded text body of ENTITY.") + (mm-define-generic write-entity-content (entity filename) "Write content of ENTITY into FILENAME.") +(mm-define-generic insert-entity (entity) + "Insert header and body of ENTITY at point.") + (mm-define-generic write-entity (entity filename) "Write header and body of ENTITY into FILENAME.")