From 9fe7cf94b373e21d85ae49b7267784444ed5a8f0 Mon Sep 17 00:00:00 2001 From: morioka Date: Mon, 1 Jun 1998 08:39:16 +0000 Subject: [PATCH] Sync up with remi-1_4_0_91. --- ChangeLog | 97 ++++++++++++++++++++++++++++++++++++++ README.en | 2 +- mime-parse.el | 143 ++++++++++++++++++++++++++++++++------------------------- mime-text.el | 55 ++++++++++++---------- mime-view.el | 52 ++++++++++----------- 5 files changed, 236 insertions(+), 113 deletions(-) diff --git a/ChangeLog b/ChangeLog index dc5b3c1..fdb494a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,100 @@ +1998-05-28 MORIOKA Tomohiko + + * mime-text.el (mime-text-insert-decoded-body): New function; + abolish 'mime-text-decode-body. + (mime-preview-text/plain): Use 'mime-text-insert-decoded-body. + (mime-preview-text/richtext): Use 'mime-text-insert-decoded-body. + (mime-preview-text/enriched): Use 'mime-text-insert-decoded-body. + +1998-05-28 MORIOKA Tomohiko + + * mime-view.el (mime-preview-condition): Set up for + 'mime-preview-text/enriched instead of + 'mime-preview-filter-for-text/enriched. + + * mime-text.el (mime-preview-text/enriched): New function; abolish + 'mime-preview-filter-for-text/enriched. + +1998-05-28 MORIOKA Tomohiko + + * mime-view.el (mime-preview-condition): Set up for + 'mime-preview-text/richtext instead of + 'mime-preview-filter-for-text/richtext. + + * mime-text.el (mime-preview-text/richtext): New function; abolish + 'mime-preview-filter-for-text/richtext. + +1998-05-28 MORIOKA Tomohiko + + * mime-view.el: Rename 'mime-view-insert-message/partial-button to + 'mime-preview-message/partial-button. + +1998-05-28 MORIOKA Tomohiko + + * mime-view.el (mime-preview-condition): Set up for + 'mime-preview-text/plain instead of + 'mime-preview-filter-for-text/plain. + (mime-view-insert-message/partial-button): Change interface for + new spec of body-presentation-method. + (mime-view-display-entity): Change interface of + body-presentation-method. + + * mime-text.el (mime-preview-text/plain): New function; abolish + 'mime-preview-filter-for-text/plain. + +1998-05-28 MORIOKA Tomohiko + + * mime-parse.el (make-mime-entity): Change format. + (mime-entity-header-start): New function. + (mime-entity-header-end): New function. + (mime-entity-body-start): New function. + (mime-entity-body-end): New function. + (mime-entity-content-type): Modify for new format. + (mime-entity-content-disposition): Modify for new format. + (mime-entity-encoding): Modify for new format. + (mime-entity-children): Modify for new format. + (mime-entity-point-min): Change to alias of + 'mime-entity-header-start. + (mime-entity-point-max): Change to alias of 'mime-entity-body-end. + (mime-parse-multipart): Modify for 'make-mime-entity. + (mime-parse-message): Modify for 'make-mime-entity. + +1998-05-28 MORIOKA Tomohiko + + * mime-parse.el (mime-parse-multipart): Change interface; abolish + local variable 'beg and 'end. + (mime-parse-message): Modify for 'mime-parse-multipart. + +1998-05-28 MORIOKA Tomohiko + + * mime-parse.el (mime-parse-multipart): Use + 'mime-content-type-parameter. + +1998-05-28 MORIOKA Tomohiko + + * mime-parse.el (mime-parse-Content-Transfer-Encoding): New + function. + (mime-read-Content-Transfer-Encoding): Use function + 'mime-parse-Content-Transfer-Encoding. + (mime-parse-message): Use 'mime-parse-* instead of 'mime-read-*. + +1998-05-28 MORIOKA Tomohiko + + * mime-parse.el: Move 'regexp-* and 'regexp-or to mime-def.el of + FLIM (Chao); move 'std11-quoted-pair-regexp, 'std11-qtext-regexp + and 'std11-quoted-string-regexp to mime-def.el of FLIM (Chao). + +1998-05-28 MORIOKA Tomohiko + + * mime-parse.el: Rename 'rfc822/quoted-string-regexp -> + 'std11-quoted-string-regexp. + + * mime-parse.el: Rename 'rfc822/qtext-regexp -> + 'std11-qtext-regexp. + + * mime-parse.el: Rename 'rfc822/quoted-pair-regexp -> + 'std11-quoted-pair-regexp. + 1998-05-29 Katsumi Yamaoka * mime-view.el (mime-preview-scroll-down-entity): Use (not (bobp)) diff --git a/README.en b/README.en index 1e2941f..e3b70d3 100644 --- a/README.en +++ b/README.en @@ -204,7 +204,7 @@ Other authors Hisashi Miyashita Kazuhiro Ohta Alexandre Oliva - Fran-Agois Pinard + François Pinard Artur Pioro Dan Rich (contribute to evolve mime-image.el with XEmacs) diff --git a/mime-parse.el b/mime-parse.el index 2741a04..7f9e4da 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -32,25 +32,9 @@ ;;; @ 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 @@ -176,39 +160,46 @@ and return parsed it." ;;; @ 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 content-disposition encoding - children) - (vector node-id point-min point-max +(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-point-min (entity) (aref entity 1)) -(defsubst mime-entity-point-max (entity) (aref entity 2)) -(defsubst mime-entity-content-type (entity) (aref entity 3)) -(defsubst mime-entity-content-disposition (entity) (aref entity 4)) -(defsubst mime-entity-encoding (entity) (aref entity 5)) -(defsubst mime-entity-children (entity) (aref entity 6)) - +(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) @@ -219,22 +210,16 @@ If is is not found, return DEFAULT-ENCODING." (mime-type/subtype-string (mime-entity-media-type entity-info) (mime-entity-media-subtype entity-info))) -(defun mime-parse-multipart (content-type content-disposition 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 "--" (std11-strip-quoted-string - (cdr (assoc "boundary" - (mime-content-type-parameters content-type)))))) + (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) @@ -242,9 +227,13 @@ If is is not found, return DEFAULT-ENCODING." (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) @@ -266,7 +255,9 @@ If is is not found, return DEFAULT-ENCODING." ) (setq children (cons ret children)) ) - (make-mime-entity node-id beg (point-max) + (make-mime-entity node-id + header-start header-end + body-start body-end content-type content-disposition encoding (nreverse children)) )) @@ -276,34 +267,62 @@ If is is not found, return DEFAULT-ENCODING." 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)) - (content-disposition (mime-read-Content-Disposition)) - (primary-type (mime-content-type-primary-type content-type)) - (encoding (mime-read-Content-Transfer-Encoding default-encoding))) + (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 content-type content-disposition encoding + (mime-parse-multipart header-start header-end + body-start body-end + content-type content-disposition encoding node-id) ) ((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) + (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) + (make-mime-entity node-id + header-start header-end + body-start body-end content-type content-disposition encoding nil) )) )) diff --git a/mime-text.el b/mime-text.el index 6a22fbd..8d3021f 100644 --- a/mime-text.el +++ b/mime-text.el @@ -64,8 +64,8 @@ See also variable `mime-charset-coding-system-alist'." (mime-text-decode-buffer charset) )) -(defun mime-text-decode-body (situation) - "Decode current buffer as text body. +(defun mime-text-insert-decoded-body (entity situation) + "Insert text body of ENTITY in SITUATION. It decodes MIME-encoding then code-converts as MIME-charset. MIME-encoding is value of field 'encoding of SITUATION. It must be 'nil or string. MIME-charset is value of field \"charset\" of @@ -73,6 +73,9 @@ SITUATION. It must be symbol. This function calls text-decoder for MIME-charset specified by buffer local variable `mime-text-decoder' and variable `mime-text-decoder-alist'." + (insert-buffer-substring mime-raw-buffer + (mime-entity-body-start entity) + (mime-entity-body-end entity)) (let ((encoding (cdr (assq 'encoding situation)))) (mime-decode-region (point-min) (point-max) encoding) (goto-char (point-min)) @@ -132,29 +135,35 @@ local variable `mime-text-decoder' and variable ;;; @ content filters for mime-text ;;; -(defun mime-preview-filter-for-text/plain (situation) - (mime-text-decode-body situation) - (goto-char (point-max)) - (if (not (eq (char-after (1- (point))) ?\n)) - (insert "\n") - ) - (mime-text-add-url-buttons) - (run-hooks 'mime-preview-text/plain-hook) - ) - -(defun mime-preview-filter-for-text/richtext (situation) - (let ((beg (point-min))) - (remove-text-properties beg (point-max) '(face nil)) - (mime-text-decode-body situation) - (richtext-decode beg (point-max)) +(defun mime-preview-text/plain (entity situation) + (save-restriction + (narrow-to-region (point-max)(point-max)) + (mime-text-insert-decoded-body entity situation) + (goto-char (point-max)) + (if (not (eq (char-after (1- (point))) ?\n)) + (insert "\n") + ) + (mime-text-add-url-buttons) + (run-hooks 'mime-preview-text/plain-hook) )) -(defun mime-preview-filter-for-text/enriched (situation) - (let ((beg (point-min))) - (remove-text-properties beg (point-max) '(face nil)) - (mime-text-decode-body situation) - (enriched-decode beg (point-max)) - )) +(defun mime-preview-text/richtext (entity situation) + (save-restriction + (narrow-to-region (point-max)(point-max)) + (mime-text-insert-decoded-body entity situation) + (let ((beg (point-min))) + (remove-text-properties beg (point-max) '(face nil)) + (richtext-decode beg (point-max)) + ))) + +(defun mime-preview-text/enriched (entity situation) + (save-restriction + (narrow-to-region (point-max)(point-max)) + (mime-text-insert-decoded-body entity situation) + (let ((beg (point-min))) + (remove-text-properties beg (point-max) '(face nil)) + (enriched-decode beg (point-max)) + ))) ;;; @ end diff --git a/mime-view.el b/mime-view.el index eab86e7..03bdcbf 100644 --- a/mime-view.el +++ b/mime-view.el @@ -406,40 +406,38 @@ Each elements are regexp of field-name.") (body . visible))) (ctree-set-calist-strictly - 'mime-preview-condition '((body . visible) - (body-presentation-method . with-filter) - (body-filter . mime-preview-filter-for-text/plain))) + 'mime-preview-condition + '((body . visible) + (body-presentation-method . mime-preview-text/plain))) (ctree-set-calist-strictly - 'mime-preview-condition '((type . nil) - (body . visible) - (body-presentation-method . with-filter) - (body-filter . mime-preview-filter-for-text/plain))) + 'mime-preview-condition + '((type . nil) + (body . visible) + (body-presentation-method . mime-preview-text/plain))) (ctree-set-calist-strictly - 'mime-preview-condition '((type . text)(subtype . enriched) - (body . visible) - (body-presentation-method . with-filter) - (body-filter - . mime-preview-filter-for-text/enriched))) + 'mime-preview-condition + '((type . text)(subtype . enriched) + (body . visible) + (body-presentation-method . mime-preview-text/enriched))) (ctree-set-calist-strictly - 'mime-preview-condition '((type . text)(subtype . richtext) - (body . visible) - (body-presentation-method . with-filter) - (body-filter - . mime-preview-filter-for-text/richtext))) + 'mime-preview-condition + '((type . text)(subtype . richtext) + (body . visible) + (body-presentation-method . mime-preview-text/richtext))) (ctree-set-calist-strictly - 'mime-preview-condition '((type . text)(subtype . t) - (body . visible) - (body-presentation-method . with-filter) - (body-filter . mime-preview-filter-for-text/plain))) + 'mime-preview-condition + '((type . text)(subtype . t) + (body . visible) + (body-presentation-method . mime-preview-text/plain))) (ctree-set-calist-strictly 'mime-preview-condition '((type . message)(subtype . partial) (body-presentation-method - . mime-view-insert-message/partial-button))) + . mime-preview-message/partial-button))) (ctree-set-calist-strictly 'mime-preview-condition '((type . message)(subtype . rfc822) @@ -457,9 +455,9 @@ Each elements are regexp of field-name.") ;;; @@@ entity filter ;;; -(autoload 'mime-preview-filter-for-text/plain "mime-text") -(autoload 'mime-preview-filter-for-text/enriched "mime-text") -(autoload 'mime-preview-filter-for-text/richtext "mime-text") +(autoload 'mime-preview-text/plain "mime-text") +(autoload 'mime-preview-text/enriched "mime-text") +(autoload 'mime-preview-text/richtext "mime-text") (defvar mime-text-decoder-alist '((mime-show-message-mode . mime-text-decode-buffer) @@ -488,7 +486,7 @@ if it is not nil.") \[[ Please press `v' key in this buffer. ]]" )) -(defun mime-view-insert-message/partial-button (&optional situation) +(defun mime-preview-message/partial-button (&optional entity situation) (save-restriction (goto-char (point-max)) (if (not (search-backward "\n\n" nil t)) @@ -801,7 +799,7 @@ The compressed face will be piped to this command.") (funcall body-filter situation) ))) ((functionp body-presentation-method) - (funcall body-presentation-method situation) + (funcall body-presentation-method entity situation) )) (or header-is-visible body-presentation-method -- 1.7.10.4