X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=03bdcbf41f8aadf50511782bc620c6d5c289a4e2;hb=9fe7cf94b373e21d85ae49b7267784444ed5a8f0;hp=c4fb8f07f40626d82201d43324852358aea44c68;hpb=49032be1ca32cba664b8c42a8f0d046ca24d1c24;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index c4fb8f0..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)) @@ -726,7 +724,11 @@ The compressed face will be piped to this command.") (setq mime-preview-original-major-mode mode) (setq major-mode 'mime-view-mode) (setq mode-name "MIME-View") - (mime-view-display-message message-info the-buf obuf) + (mime-view-display-entity message-info message-info + the-buf obuf + '((entity-button . invisible) + (header . visible) + )) (set-buffer-modified-p nil) ) (setq buffer-read-only t) @@ -735,94 +737,12 @@ The compressed face will be piped to this command.") (setq mime-preview-buffer obuf) ) -(defun mime-view-display-message (message-info ibuf obuf) - (let* ((start (mime-entity-point-min message-info)) - (end (mime-entity-point-max message-info)) - (media-type (mime-entity-media-type message-info)) - (media-subtype (mime-entity-media-subtype message-info)) - (params (mime-entity-parameters message-info)) - (encoding (mime-entity-encoding message-info)) - end-of-header e nb ne subj) - (set-buffer ibuf) - (goto-char start) - (setq end-of-header (if (re-search-forward "^$" nil t) - (1+ (match-end 0)) - end)) - (if (> end-of-header end) - (setq end-of-header end) - ) - (save-restriction - (narrow-to-region start end) - (setq subj - (eword-decode-string - (mime-raw-get-subject params encoding))) - ) - (set-buffer obuf) - (setq nb (point)) - (narrow-to-region nb nb) - ;; Insert message-header - (save-restriction - (narrow-to-region (point)(point)) - (insert-buffer-substring mime-raw-buffer start end-of-header) - (let ((f (cdr (assq mime-preview-original-major-mode - mime-view-content-header-filter-alist)))) - (if (functionp f) - (funcall f) - (mime-view-default-content-header-filter) - )) - (run-hooks 'mime-view-content-header-filter-hook) - ) - (let* ((situation - (ctree-match-calist mime-preview-condition - (list* (cons 'type media-type) - (cons 'subtype media-subtype) - (cons 'encoding encoding) - (cons 'major-mode major-mode) - params))) - (message-button - (cdr (assq 'message-button situation))) - (body-presentation-method - (cdr (assq 'body-presentation-method situation)))) - (when (eq message-button 'visible) - (goto-char (point-max)) - (mime-view-insert-entity-button message-info message-info subj) - ) - (cond ((eq body-presentation-method 'with-filter) - (let ((body-filter (cdr (assq 'body-filter situation)))) - (save-restriction - (narrow-to-region (point-max)(point-max)) - (insert-buffer-substring mime-raw-buffer end-of-header end) - (funcall body-filter situation) - ))) - ((functionp body-presentation-method) - (funcall body-presentation-method situation) - ) - ((null (mime-entity-children message-info)) - (goto-char (point-max)) - (mime-view-insert-entity-button message-info message-info subj) - )) - (setq ne (point-max)) - (widen) - (put-text-property nb ne 'mime-view-raw-buffer ibuf) - (put-text-property nb ne 'mime-view-entity message-info) - (goto-char ne) - (let ((children (mime-entity-children message-info)) - (default-situation - (cdr (assq 'childrens-situation situation)))) - (while children - (mime-view-display-entity (car children) message-info ibuf obuf - default-situation) - (setq children (cdr children)) - ))))) - (defun mime-view-display-entity (entity message-info ibuf obuf default-situation) (let* ((start (mime-entity-point-min entity)) (end (mime-entity-point-max entity)) - (media-type (mime-entity-media-type entity)) - (media-subtype (mime-entity-media-subtype entity)) - (params (mime-entity-parameters entity)) - (encoding (mime-entity-encoding entity)) + (content-type (mime-entity-content-type entity)) + (encoding (mime-entity-encoding entity)) end-of-header e nb ne subj) (set-buffer ibuf) (goto-char start) @@ -834,18 +754,18 @@ The compressed face will be piped to this command.") ) (save-restriction (narrow-to-region start end) - (setq subj - (eword-decode-string - (mime-raw-get-subject params encoding))) + (setq subj (eword-decode-string (mime-raw-get-subject entity))) ) (let* ((situation - (ctree-match-calist mime-preview-condition - (list* (cons 'type media-type) - (cons 'subtype media-subtype) - (cons 'encoding encoding) - (cons 'major-mode major-mode) - (append params - default-situation)))) + (or + (ctree-match-calist mime-preview-condition + (append + (or content-type + (make-mime-content-type 'text 'plain)) + (list* (cons 'encoding encoding) + (cons 'major-mode major-mode) + default-situation))) + default-situation)) (button-is-invisible (eq (cdr (assq 'entity-button situation)) 'invisible)) (header-is-visible @@ -879,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 @@ -901,31 +821,33 @@ The compressed face will be piped to this command.") (setq children (cdr children)) ))))) -(defun mime-raw-get-uu-filename (param &optional encoding) - (if (member (or encoding - (cdr (assq 'encoding param)) - ) - mime-view-uuencode-encoding-name-list) - (save-excursion - (or (if (re-search-forward "^begin [0-9]+ " nil t) - (if (looking-at ".+$") - (buffer-substring (match-beginning 0)(match-end 0)) - )) - "")) - )) +(defun mime-raw-get-uu-filename () + (save-excursion + (if (re-search-forward "^begin [0-9]+ " nil t) + (if (looking-at ".+$") + (buffer-substring (match-beginning 0)(match-end 0)) + )))) -(defun mime-raw-get-subject (param &optional encoding) +(defun mime-raw-get-subject (entity) (or (std11-find-field-body '("Content-Description" "Subject")) - (let (ret) - (if (or (and (setq ret (mime/Content-Disposition)) - (setq ret (assoc "filename" (cdr ret))) - ) - (setq ret (assoc "name" param)) - (setq ret (assoc "x-name" param)) - ) - (std11-strip-quoted-string (cdr ret)) - )) - (mime-raw-get-uu-filename param encoding) + (let ((ret (mime-entity-content-disposition entity))) + (and ret + (setq ret (mime-content-disposition-filename ret)) + (std11-strip-quoted-string ret) + )) + (let ((ret (mime-entity-content-type entity))) + (and ret + (setq ret + (cdr + (let ((param (mime-content-type-parameters ret))) + (or (assoc "name" param) + (assoc "x-name" param)) + ))) + (std11-strip-quoted-string ret) + )) + (if (member (mime-entity-encoding entity) + mime-view-uuencode-encoding-name-list) + (mime-raw-get-uu-filename)) "")) @@ -1328,10 +1250,13 @@ variable `mime-view-over-to-previous-method-alist'." (while (null (get-text-property (point) 'mime-view-entity)) (backward-char) ) - (let ((point - (previous-single-property-change (point) 'mime-view-entity))) + (let ((point (previous-single-property-change (point) 'mime-view-entity))) (if point - (goto-char point) + (if (get-text-property (1- point) 'mime-view-entity) + (goto-char point) + (goto-char (1- point)) + (mime-preview-move-to-previous) + ) (let ((f (assq mime-preview-original-major-mode mime-view-over-to-previous-method-alist))) (if f @@ -1344,9 +1269,16 @@ variable `mime-view-over-to-previous-method-alist'." If there is no previous entity, it calls function registered in variable `mime-view-over-to-next-method-alist'." (interactive) + (while (null (get-text-property (point) 'mime-view-entity)) + (forward-char) + ) (let ((point (next-single-property-change (point) 'mime-view-entity))) (if point - (goto-char point) + (progn + (goto-char point) + (if (null (get-text-property point 'mime-view-entity)) + (mime-preview-move-to-next) + )) (let ((f (assq mime-preview-original-major-mode mime-view-over-to-next-method-alist))) (if f @@ -1394,7 +1326,7 @@ If reached to (point-min), it calls function registered in variable (let (point) (save-excursion (catch 'tag - (while (> (point) 1) + (while (not (bobp)) (if (setq point (previous-single-property-change (point) 'mime-view-entity))