Mercurial > hg > xemacs-beta
diff lisp/vm/vm-mime.el @ 146:2af401a6ecca r20-2p1
Import from CVS: tag r20-2p1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:34:46 +0200 |
parents | 585fb297b004 |
children | 43dd3413c7c7 |
line wrap: on
line diff
--- a/lisp/vm/vm-mime.el Mon Aug 13 09:34:16 2007 +0200 +++ b/lisp/vm/vm-mime.el Mon Aug 13 09:34:46 2007 +0200 @@ -37,11 +37,13 @@ (defun vm-mm-layout-body-start (e) (aref e 8)) (defun vm-mm-layout-body-end (e) (aref e 9)) (defun vm-mm-layout-parts (e) (aref e 10)) +(defun vm-mm-layout-cache (e) (aref e 11)) ;; if display of MIME part fails, error string will be here. -(defun vm-mm-layout-cache (e) (aref e 11)) +(defun vm-mm-layout-display-error (e) (aref e 12)) (defun vm-set-mm-layout-type (e type) (aset e 0 type)) (defun vm-set-mm-layout-cache (e c) (aset e 11 c)) +(defun vm-set-mm-layout-display-error (e c) (aset e 12 c)) (defun vm-mm-layout (m) (or (vm-mime-layout-of m) @@ -624,7 +626,7 @@ (vm-headers-of m) (vm-text-of m) (vm-text-end-of m) - nil nil ))) + nil nil nil ))) ((null type) (goto-char (point-min)) (or (re-search-forward "^\n\\|\n\\'" nil t) @@ -635,7 +637,7 @@ (vm-marker (point-min)) (vm-marker (point)) (vm-marker (point-max)) - nil nil )) + nil nil nil )) ((null (string-match "[^/ ]+/[^/ ]+" (car type))) (vm-mime-error "Malformed MIME content type: %s" (car type))) ((and (string-match "^multipart/\\|^message/" (car type)) @@ -668,7 +670,7 @@ (narrow-to-region (point) (point-max)) (vm-mime-parse-entity-safe nil c-t c-t-e))) - nil ))) + nil nil ))) (t (goto-char (point-min)) (or (re-search-forward "^\n\\|\n\\'" nil t) @@ -679,7 +681,7 @@ (vm-marker (point-min)) (vm-marker (point)) (vm-marker (point-max)) - nil nil )))) + nil nil nil )))) (setq p (cdr type) boundary nil) (while p @@ -726,7 +728,7 @@ (vm-marker (point)) (vm-marker (point-max)) (nreverse multipart-list) - nil ))))))) + nil nil ))))))) (defun vm-mime-parse-entity-safe (&optional m c-t c-t-e) (or c-t (setq c-t '("text/plain" "charset=us-ascii"))) @@ -758,7 +760,7 @@ header text text-end - nil nil))))) + nil nil nil))))) (defun vm-mime-get-xxx-parameter (layout name param-list) (let ((match-end (1+ (length name))) @@ -1051,7 +1053,8 @@ (vm-marker (point)) (vm-marker (point-max)) nil - nil )))) + nil + nil)))) (defun vm-mime-should-display-button (layout dont-honor-content-disposition) (if (and vm-honor-mime-content-disposition @@ -1253,7 +1256,7 @@ (vm-mime-display-internal-text/plain layout))) (t (and extent (vm-mime-rewrite-failed-button extent - (or (vm-mm-layout-cache layout) + (or (vm-mm-layout-display-error layout) "no external viewer defined for type"))) (vm-mime-display-internal-application/octet-stream (or extent layout)))) @@ -1285,7 +1288,7 @@ (and work-buffer (kill-buffer work-buffer))) (message "Inlining text/html... done") t ) - (vm-set-mm-layout-cache layout "Need W3 to inline HTML") + (vm-set-mm-layout-display-error layout "Need W3 to inline HTML") nil )) (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting) @@ -1294,7 +1297,7 @@ (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) (if (not (vm-mime-charset-internally-displayable-p charset)) (progn - (vm-set-mm-layout-cache + (vm-set-mm-layout-display-error layout (concat "Undisplayable charset: " charset)) nil) (vm-mime-insert-mime-body layout) @@ -1353,6 +1356,11 @@ (if (vm-mime-text-type-p layout) (set-buffer-file-coding-system 'no-conversion nil) (set-buffer-file-coding-system 'binary t))) + ;; Write an empty tempfile out to disk and set its + ;; permissions to 0600, then write the actual buffer + ;; contents to tempfile. + (write-region start start tempfile nil 0) + (set-file-modes tempfile 384) (write-region start end tempfile nil 0)) (delete-region start end) (save-excursion @@ -1535,9 +1543,14 @@ (defun vm-mime-display-internal-message/rfc822 (layout) (if (vectorp layout) - (let ((start (point))) - (vm-mime-insert-mime-headers layout) + (let ((start (point)) + (buffer-read-only nil)) + (vm-mime-insert-mime-headers (car (vm-mm-layout-parts layout))) (insert ?\n) + (save-excursion + (goto-char start) + (vm-reorder-message-headers nil vm-visible-headers + vm-invisible-header-regexp)) (save-restriction (narrow-to-region start (point)) (vm-decode-mime-encoded-words)) @@ -1709,7 +1722,13 @@ (setq end (point-marker)) (vm-mime-transfer-decode-region layout start end) (setq tempfile (vm-make-tempfile-name)) - ;; coding system for presentation buffer is binary + ;; Write an empty tempfile out to disk and set its + ;; permissions to 0600, then write the actual buffer + ;; contents to tempfile. + (write-region start start tempfile nil 0) + (set-file-modes tempfile 384) + ;; coding system for presentation buffer is binary so + ;; we don't need to set it here. (write-region start end tempfile nil 0) (message "Creating %s glyph..." name) (setq g (make-glyph @@ -1761,7 +1780,13 @@ (setq end (point-marker)) (vm-mime-transfer-decode-region layout start end) (setq tempfile (vm-make-tempfile-name)) - ;; coding system for presentation buffer is binary + ;; Write an empty tempfile out to disk and set its + ;; permissions to 0600, then write the actual buffer + ;; contents to tempfile. + (write-region start start tempfile nil 0) + (set-file-modes tempfile 384) + ;; coding system for presentation buffer is binary, so + ;; we don't need to set it here. (write-region start end tempfile nil 0) (vm-set-mm-layout-cache layout tempfile) (save-excursion @@ -2082,6 +2107,24 @@ (setq done t) (setq p (cdr p)))) result ))) + +;; breadth first traversal +(defun vm-mime-find-digests-in-layout (layout) + (let ((layout-list (list layout)) + layout-type + (result nil)) + (while layout-list + (setq layout-type (car (vm-mm-layout-type (car layout-list)))) + (cond ((string-match "^multipart/digest\\|message/\\(rfc822\\|news\\)" + layout-type) + (setq result (nconc result (list (car layout-list))))) + ((vm-mime-composite-type-p layout-type) + (setq layout-list (nconc layout-list + (copy-sequence + (vm-mm-layout-parts + (car layout-list))))))) + (setq layout-list (cdr layout-list))) + result )) (defun vm-mime-plain-message-p (m) (save-match-data @@ -2843,7 +2886,7 @@ ;; insert/delete trick needed to avoid ;; enriched-mode tags from seeping into the ;; attachment overlays. I really wish - ;; front-advance / rear-aadvance overlay + ;; front-advance / rear-advance overlay ;; endpoint properties actually worked. (goto-char (point-max)) (insert-before-markers "\n") @@ -3159,6 +3202,7 @@ (error "Command must be used in a VM Mail mode buffer.")) (let ((temp-buffer nil) (mail-buffer (current-buffer)) + (enriched (and (boundp 'enriched-mode) enriched-mode)) e-list) (unwind-protect (progn @@ -3166,6 +3210,7 @@ (set-buffer temp-buffer) ;; so vm-mime-xxxx-encode-composition won't complain (setq major-mode 'mail-mode) + (set (make-local-variable 'enriched-mode) enriched) (vm-insert-region-from-buffer mail-buffer) (goto-char (point-min)) (or (vm-mail-mode-get-header-contents "From")