;;; mime.el --- MIME library module
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: MIME, multimedia, mail, news
(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
(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)
(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
;;;
(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.")
projects / elisp / flim.git / blobdiff