;;; @ field parser
;;;
-(defsubst regexp-* (regexp)
- (concat regexp "*"))
-
-(defsubst regexp-or (&rest args)
- (concat "\\(" (mapconcat (function identity) args "\\|") "\\)"))
-
-(defconst rfc822/quoted-pair-regexp "\\\\.")
-(defconst rfc822/qtext-regexp
- (concat "[^" (char-list-to-string std11-non-qtext-char-list) "]"))
-(defconst rfc822/quoted-string-regexp
- (concat "\""
- (regexp-*
- (regexp-or rfc822/qtext-regexp rfc822/quoted-pair-regexp)
- )
- "\""))
-
(defconst mime/content-parameter-value-regexp
(concat "\\("
- rfc822/quoted-string-regexp
+ std11-quoted-string-regexp
"\\|[^; \t\n]*\\)"))
(defconst mime::parameter-regexp
"Return primary-type of CONTENT-TYPE."
(cddr content-type))
+(defsubst mime-content-type-parameter (content-type parameter)
+ "Return PARAMETER value of CONTENT-TYPE."
+ (cdr (assoc parameter (mime-content-type-parameters content-type))))
+
;;; @ 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
;;;
+(defun mime-parse-Content-Transfer-Encoding (string)
+ "Parse STRING as field-body of Content-Transfer-Encoding field."
+ (if (string-match "[ \t\n\r]+$" string)
+ (setq string (match-string 0 string))
+ )
+ (downcase string))
+
(defun mime-read-Content-Transfer-Encoding (&optional default-encoding)
"Read field-body of Content-Transfer-Encoding field from
current-buffer, and return it.
If is is not found, return DEFAULT-ENCODING."
(let ((str (std11-field-body "Content-Transfer-Encoding")))
(if str
- (progn
- (if (string-match "[ \t\n\r]+$" str)
- (setq str (substring str 0 (match-beginning 0)))
- )
- (downcase str)
- )
+ (mime-parse-Content-Transfer-Encoding str)
default-encoding)))
;;; @ message parser
;;;
-(defsubst make-mime-entity (node-id
- point-min point-max
- content-type encoding children)
- (vector node-id point-min point-max
- content-type encoding children))
-
-(defsubst mime-entity-node-id (entity-info) (aref entity-info 0))
-(defsubst mime-entity-point-min (entity-info) (aref entity-info 1))
-(defsubst mime-entity-point-max (entity-info) (aref entity-info 2))
-(defsubst mime-entity-content-type (entity-info) (aref entity-info 3))
-(defsubst mime-entity-encoding (entity-info) (aref entity-info 4))
-(defsubst mime-entity-children (entity-info) (aref entity-info 5))
-
+(defsubst make-mime-entity (node-id header-start header-end
+ body-start body-end
+ content-type content-disposition
+ encoding children)
+ (vector node-id
+ header-start header-end body-start body-end
+ content-type content-disposition encoding children))
+
+(defsubst mime-entity-node-id (entity) (aref entity 0))
+(defsubst mime-entity-header-start (entity) (aref entity 1))
+(defsubst mime-entity-header-end (entity) (aref entity 2))
+(defsubst mime-entity-body-start (entity) (aref entity 3))
+(defsubst mime-entity-body-end (entity) (aref entity 4))
+(defsubst mime-entity-content-type (entity) (aref entity 5))
+(defsubst mime-entity-content-disposition (entity) (aref entity 6))
+(defsubst mime-entity-encoding (entity) (aref entity 7))
+(defsubst mime-entity-children (entity) (aref entity 8))
+
+(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-type/subtype-string (mime-entity-media-type entity-info)
(mime-entity-media-subtype entity-info)))
-(defun mime-parse-multipart (boundary content-type encoding node-id)
+(defun mime-parse-multipart (header-start header-end body-start body-end
+ content-type content-disposition
+ encoding node-id)
(goto-char (point-min))
- (let* ((dash-boundary (concat "--" boundary))
+ (let* ((dash-boundary
+ (concat "--"
+ (std11-strip-quoted-string
+ (mime-content-type-parameter content-type "boundary"))))
(delimiter (concat "\n" (regexp-quote dash-boundary)))
(close-delimiter (concat delimiter "--[ \t]*$"))
- (beg (point-min))
- (end (progn
- (goto-char (point-max))
- (if (re-search-backward close-delimiter nil t)
- (match-beginning 0)
- (point-max)
- )))
(rsep (concat delimiter "[ \t]*\n"))
(dc-ctl
(if (eq (mime-content-type-subtype content-type) 'digest)
(make-mime-content-type 'text 'plain)
))
cb ce ret ncb children (i 0))
+ (goto-char body-end)
+ (if (re-search-backward close-delimiter nil t)
+ (setq body-end (match-beginning 0))
+ )
(save-restriction
- (narrow-to-region beg end)
- (goto-char beg)
+ (narrow-to-region header-end body-end)
+ (goto-char header-start)
(re-search-forward rsep nil t)
(setq cb (match-end 0))
(while (re-search-forward rsep nil t)
)
(setq children (cons ret children))
)
- (make-mime-entity node-id beg (point-max)
- content-type encoding (nreverse children))
+ (make-mime-entity node-id
+ header-start header-end
+ body-start body-end
+ content-type content-disposition encoding
+ (nreverse children))
))
(defun mime-parse-message (&optional default-ctl default-encoding node-id)
DEFAULT-CTL is used when an entity does not have valid Content-Type
field. Its format must be as same as return value of
mime-{parse|read}-Content-Type."
- (let* ((content-type (or (mime-read-Content-Type) default-ctl))
- (encoding (mime-read-Content-Transfer-Encoding default-encoding))
- (boundary (assoc "boundary"
- (mime-content-type-parameters content-type))))
- (cond (boundary
- (setq boundary (std11-strip-quoted-string (cdr boundary)))
- (mime-parse-multipart boundary content-type encoding node-id)
+ (let ((header-start (point-min))
+ header-end
+ body-start
+ (body-end (point-max))
+ content-type content-disposition encoding
+ primary-type)
+ (goto-char header-start)
+ (if (re-search-forward "^$" nil t)
+ (setq header-end (match-end 0)
+ body-start (1+ header-end))
+ (setq header-end (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")))
+ (if str
+ (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))
+ )
+ (cond ((eq primary-type 'multipart)
+ (mime-parse-multipart header-start header-end
+ body-start body-end
+ content-type content-disposition encoding
+ node-id)
)
- ((and (eq (mime-content-type-primary-type content-type)
- 'message)
+ ((and (eq primary-type 'message)
(memq (mime-content-type-subtype content-type)
- '(rfc822 news))
- )
- (goto-char (point-min))
- (make-mime-entity node-id (point-min) (point-max)
- content-type encoding
+ '(rfc822 news)
+ ))
+ (make-mime-entity node-id
+ header-start header-end
+ body-start body-end
+ content-type content-disposition encoding
(save-restriction
- (narrow-to-region
- (if (re-search-forward "^$" nil t)
- (1+ (match-end 0))
- (point-min)
- )
- (point-max))
+ (narrow-to-region body-start body-end)
(list (mime-parse-message
nil nil (cons 0 node-id)))
))
)
(t
- (make-mime-entity node-id (point-min) (point-max)
- content-type encoding nil)
+ (make-mime-entity node-id
+ header-start header-end
+ body-start body-end
+ content-type content-disposition encoding nil)
))
))
projects / elisp / semi.git / blobdiff