;;; @ Content-Type
;;;
+;;;###autoload
(defun mime-parse-Content-Type (string)
"Parse STRING as field-body of Content-Type field.
Return value is
(nreverse dest))
)))
+;;;###autoload
(defun mime-read-Content-Type ()
"Read field-body of Content-Type field from current-buffer,
and return parsed it. Format of return value is as same as
(defconst mime-disposition-type-regexp mime-token-regexp)
+;;;###autoload
(defun mime-parse-Content-Disposition (string)
"Parse STRING as field-body of Content-Disposition field."
(setq string (std11-unfold-string string))
(nreverse dest))
)))
+;;;###autoload
(defun mime-read-Content-Disposition ()
"Read field-body of Content-Disposition field from current-buffer,
and return parsed it."
(mime-parse-Content-Disposition str)
)))
-(defsubst mime-content-disposition-type (content-disposition)
- "Return disposition-type of CONTENT-DISPOSITION."
- (cdr (car content-disposition)))
-
-(defsubst mime-content-disposition-parameters (content-disposition)
- "Return disposition-parameters of CONTENT-DISPOSITION."
- (cdr content-disposition))
-
-(defsubst mime-content-disposition-parameter (content-disposition parameter)
- "Return PARAMETER value of CONTENT-DISPOSITION."
- (cdr (assoc parameter (cdr content-disposition))))
-
-(defsubst mime-content-disposition-filename (content-disposition)
- "Return filename of CONTENT-DISPOSITION."
- (mime-content-disposition-parameter content-disposition "filename"))
-
;;; @ Content-Transfer-Encoding
;;;
+;;;###autoload
(defun mime-parse-Content-Transfer-Encoding (string)
"Parse STRING as field-body of Content-Transfer-Encoding field."
(if (string-match "[ \t\n\r]+$" string)
)
(downcase string))
+;;;###autoload
(defun mime-read-Content-Transfer-Encoding (&optional default-encoding)
"Read field-body of Content-Transfer-Encoding field from
current-buffer, and return it.
;;; @ message parser
;;;
-(defalias 'mime-entity-point-min 'mime-entity-header-start)
-(defalias 'mime-entity-point-max 'mime-entity-body-end)
-
-(defsubst mime-entity-media-type (entity)
- (mime-content-type-primary-type (mime-entity-content-type entity)))
-(defsubst mime-entity-media-subtype (entity)
- (mime-content-type-subtype (mime-entity-content-type entity)))
-(defsubst mime-entity-parameters (entity)
- (mime-content-type-parameters (mime-entity-content-type entity)))
-
-(defsubst mime-entity-type/subtype (entity-info)
- (mime-type/subtype-string (mime-entity-media-type entity-info)
- (mime-entity-media-subtype entity-info)))
-
-(defun mime-parse-multipart (header-start header-end body-start body-end
- content-type content-disposition
- encoding node-id)
+(defun mime-parse-multipart (entity)
(goto-char (point-min))
- (let* ((dash-boundary
- (concat "--"
- (std11-strip-quoted-string
- (mime-content-type-parameter content-type "boundary"))))
+ (let* ((content-type (mime-entity-content-type-internal entity))
+ (dash-boundary
+ (concat "--" (mime-content-type-parameter content-type "boundary")))
(delimiter (concat "\n" (regexp-quote dash-boundary)))
(close-delimiter (concat delimiter "--[ \t]*$"))
(rsep (concat delimiter "[ \t]*\n"))
(make-mime-content-type 'message 'rfc822)
(make-mime-content-type 'text 'plain)
))
+ (header-end (mime-entity-header-end-internal entity))
+ (body-end (mime-entity-body-end-internal entity))
+ (node-id (mime-entity-node-id-internal entity))
cb ce ret ncb children (i 0))
(save-restriction
(goto-char body-end)
(setq ncb (match-end 0))
(save-restriction
(narrow-to-region cb ce)
- (setq ret (mime-parse-message dc-ctl "7bit" (cons i node-id)))
+ (setq ret (mime-parse-message dc-ctl (cons i node-id)))
)
(setq children (cons ret children))
(goto-char (setq cb ncb))
(setq ce (point-max))
(save-restriction
(narrow-to-region cb ce)
- (setq ret (mime-parse-message dc-ctl "7bit" (cons i node-id)))
+ (setq ret (mime-parse-message dc-ctl (cons i node-id)))
)
(setq children (cons ret children))
)
- (make-mime-entity (current-buffer)
- header-start header-end body-start body-end
- node-id content-type content-disposition encoding
- (nreverse children))
- ))
-
-(defun mime-parse-message (&optional default-ctl default-encoding node-id)
+ (mime-entity-set-children-internal entity (nreverse children))
+ entity))
+
+(defun mime-parse-encapsulated (entity)
+ (mime-entity-set-children-internal
+ entity
+ (save-restriction
+ (narrow-to-region (mime-entity-body-start-internal entity)
+ (mime-entity-body-end-internal entity))
+ (list (mime-parse-message
+ nil (cons 0 (mime-entity-node-id-internal entity))))
+ ))
+ entity)
+
+;;;###autoload
+(defun mime-parse-message (&optional default-ctl node-id)
"Parse current-buffer as a MIME message.
DEFAULT-CTL is used when an entity does not have valid Content-Type
field. Its format must be as same as return value of
header-end
body-start
(body-end (point-max))
- content-type content-disposition encoding
- primary-type)
+ content-type primary-type entity)
(goto-char header-start)
(if (re-search-forward "^$" nil t)
(setq header-end (match-end 0)
- body-start (1+ header-end))
+ body-start (if (= header-end body-end)
+ body-end
+ (1+ header-end)))
(setq header-end (point-min)
- body-start (point-min))
- )
+ body-start (point-min)))
(save-restriction
(narrow-to-region header-start header-end)
(setq content-type (or (let ((str (std11-fetch-field "Content-Type")))
(mime-parse-Content-Type str)
))
default-ctl)
- content-disposition (let ((str (std11-fetch-field
- "Content-Disposition")))
- (if str
- (mime-parse-Content-Disposition str)
- ))
- encoding (let ((str (std11-fetch-field
- "Content-Transfer-Encoding")))
- (if str
- (mime-parse-Content-Transfer-Encoding str)
- default-encoding))
primary-type (mime-content-type-primary-type content-type))
)
+ (setq entity
+ (make-mime-entity-internal
+ (current-buffer) header-start header-end body-start body-end
+ node-id content-type))
(cond ((eq primary-type 'multipart)
- (mime-parse-multipart header-start header-end
- body-start body-end
- content-type content-disposition encoding
- node-id)
+ (mime-parse-multipart entity)
)
((and (eq primary-type 'message)
(memq (mime-content-type-subtype content-type)
'(rfc822 news external-body)
))
- (make-mime-entity (current-buffer)
- header-start header-end body-start body-end
- node-id
- content-type content-disposition encoding
- (save-restriction
- (narrow-to-region body-start body-end)
- (list (mime-parse-message
- nil nil (cons 0 node-id)))
- ))
+ (mime-parse-encapsulated entity)
)
- (t
- (make-mime-entity (current-buffer)
- header-start header-end body-start body-end
- node-id
- content-type content-disposition encoding nil)
- ))
- ))
+ (t entity))))
;;; @ for buffer
;;;
-(defvar mime-message-structure nil
- "Information about structure of message.
-Please use reference function `mime-entity-SLOT' to get value of SLOT.
-
-Following is a list of slots of the structure:
-
-buffer buffer includes this entity (buffer).
-node-id node-id (list of integers)
-header-start minimum point of header in raw-buffer
-header-end maximum point of header in raw-buffer
-body-start minimum point of body in raw-buffer
-body-end maximum point of body in raw-buffer
-content-type content-type (content-type)
-content-disposition content-disposition (content-disposition)
-encoding Content-Transfer-Encoding (string or nil)
-children entities included in this entity (list of entity)
-
-If an entity includes other entities in its body, such as multipart or
-message/rfc822, `mime-entity' structures of them are included in
-`children', so the `mime-entity' structure become a tree.")
-(make-variable-buffer-local 'mime-message-structure)
-
+;;;###autoload
(defun mime-parse-buffer (&optional buffer)
"Parse BUFFER as a MIME message.
If buffer is omitted, it parses current-buffer."
))
-;;; @ utilities
-;;;
-
-(defsubst mime-root-entity-p (entity)
- "Return t if ENTITY is root-entity (message)."
- (null (mime-entity-node-id entity)))
-
-
;;; @ end
;;;
projects / elisp / flim.git / blobdiff