Mercurial > hg > xemacs-beta
diff lisp/vm/vm-mime.el @ 126:1370575f1259 xemacs-20-1p1
Import from CVS: tag xemacs-20-1p1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:27:39 +0200 |
parents | cca96a509cfe |
children | 869e1851236b |
line wrap: on
line diff
--- a/lisp/vm/vm-mime.el Mon Aug 13 09:26:41 2007 +0200 +++ b/lisp/vm/vm-mime.el Mon Aug 13 09:27:39 2007 +0200 @@ -1394,9 +1394,12 @@ (vm-mime-get-parameter layout "name")))) (vm-mime-send-body-to-file layout default-filename))) t ) -(fset 'vm-mime-display-button-application +(fset 'vm-mime-display-button-application/octet-stream 'vm-mime-display-internal-application/octet-stream) +(defun vm-mime-display-button-application (layout) + (vm-mime-display-button-xxxx layout nil)) + (defun vm-mime-display-button-image (layout) (vm-mime-display-button-xxxx layout t)) @@ -1797,13 +1800,15 @@ (defvar vm-menu-mime-dispose-menu) (defun vm-mime-set-extent-glyph-for-type (e type) - (if (and vm-xemacs-p (fboundp 'make-glyph) - (eq (device-type) 'x) (> (device-bitplanes) 7)) + (if (and vm-xemacs-p + (featurep 'xpm) + (eq (device-type) 'x) + (> (device-bitplanes) 7)) (let ((dir vm-image-directory) (colorful (> (device-bitplanes) 15)) (tuples '(("text" "document-simple.xpm" "document-colorful.xpm") - ("image" "mona_stamp-simple.gif" "mona_stamp-colorful.gif") + ("image" "mona_stamp-simple.xpm" "mona_stamp-colorful.xpm") ("audio" "audio_stamp-simple.xpm" "audio_stamp-colorful.xpm") ("video" "film-simple.xpm" "film-colorful.xpm") ("message" "message-simple.xpm" "message-colorful.xpm") @@ -2264,7 +2269,7 @@ (put-text-property start end 'vm-mime-object object)) (vm-xemacs-p (setq e (make-extent start end)) - (vm-mime-set-extent-glyph-for-type e type) + (vm-mime-set-extent-glyph-for-type e (or type "text/plain")) (set-extent-property e 'start-open t) (set-extent-property e 'face vm-mime-button-face) (set-extent-property e 'duplicable t) @@ -2383,15 +2388,17 @@ encoding )) (defun vm-mime-transfer-encode-layout (layout) - (if (vm-mime-text-type-p layout) - (vm-mime-transfer-encode-region (vm-mm-layout-encoding layout) - (vm-mm-layout-body-start layout) - (vm-mm-layout-body-end layout) - t) - (vm-mime-transfer-encode-region (vm-mm-layout-encoding layout) - (vm-mm-layout-body-start layout) - (vm-mm-layout-body-end layout) - nil))) + (let ((encoding + (vm-mime-transfer-encode-region (vm-mm-layout-encoding layout) + (vm-mm-layout-body-start layout) + (vm-mm-layout-body-end layout) + (vm-mime-text-type-p layout)))) + (save-excursion + (save-restriction + (goto-char (vm-mm-layout-header-start layout)) + (narrow-to-region (point) (vm-mm-layout-body-start layout)) + (vm-reorder-message-headers nil nil "Content-Transfer-Encoding:") + (insert "Content-Transfer-Encoding: " encoding "\n"))))) (defun vm-mime-encode-composition () "MIME encode the current mail composition buffer. @@ -2549,7 +2556,7 @@ ;; then any subpart that contains 8bit data must ;; have an opaque (qp or base64) 8->7bit ;; conversion performed on it so that the - ;; enclosing entity can use an non-opqaue + ;; enclosing entity can use a non-opaque ;; encoding. ;; ;; message/partial requires a "7bit" encoding so @@ -2691,8 +2698,8 @@ (if params (if vm-mime-avoid-folding-content-type (insert "; " (mapconcat 'identity params "; ") "\n") - (insert ";\n\t" (mapconcat 'identity params ";\n\t")))) - (insert "\n")) + (insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n")) + (insert "\n"))) (if just-one (and description (insert "Content-Description: " description "\n"))) @@ -2700,10 +2707,12 @@ (progn (insert "Content-Disposition: " (car disposition)) (if (cdr disposition) - (insert ";\n\t" (mapconcat 'identity - (cdr disposition) - ";\n\t"))) - (insert "\n"))) + (if vm-mime-avoid-folding-content-type + (insert "; " (mapconcat 'identity (cdr disposition) "; ") + "\n") + (insert ";\n\t" (mapconcat 'identity (cdr disposition) + ";\n\t"))) + (insert "\n")))) (if just-one (insert "Content-Transfer-Encoding: " encoding "\n") (if 8bit @@ -2864,7 +2873,7 @@ ;; then any subpart that contains 8bit data must ;; have an opaque (qp or base64) 8->7bit ;; conversion performed on it so that the - ;; enclosing entity can use an non-opqaue + ;; enclosing entity can use a non-opaque ;; encoding. ;; ;; message/partial requires a "7bit" encoding so @@ -3006,8 +3015,8 @@ (if params (if vm-mime-avoid-folding-content-type (insert "; " (mapconcat 'identity params "; ") "\n") - (insert ";\n\t" (mapconcat 'identity params ";\n\t")))) - (insert "\n")) + (insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n")) + (insert "\n"))) (if just-one (and description (insert "Content-Description: " description "\n"))) @@ -3015,10 +3024,12 @@ (progn (insert "Content-Disposition: " (car disposition)) (if (cdr disposition) - (insert ";\n\t" (mapconcat 'identity - (cdr disposition) - ";\n\t"))) - (insert "\n"))) + (if vm-mime-avoid-folding-content-type + (insert "; " (mapconcat 'identity (cdr disposition) "; ") + "\n") + (insert ";\n\t" (mapconcat 'identity (cdr disposition) + ";\n\t"))) + (insert "\n")))) (if just-one (insert "Content-Transfer-Encoding: " encoding "\n") (if 8bit @@ -3108,10 +3119,9 @@ (progn (setq temp-buffer (generate-new-buffer "composition preview")) (set-buffer temp-buffer) - ;; so vm-mime-encode-composition won't complain + ;; so vm-mime-xxxx-encode-composition won't complain (setq major-mode 'mail-mode) (vm-insert-region-from-buffer mail-buffer) - (vm-remove-mail-mode-header-separator) (goto-char (point-min)) (or (vm-mail-mode-get-header-contents "From") (insert "From: " (user-login-name) "\n")) @@ -3125,6 +3135,7 @@ (and vm-send-using-mime (null (vm-mail-mode-get-header-contents "MIME-Version:")) (vm-mime-encode-composition)) + (vm-remove-mail-mode-header-separator) (goto-char (point-min)) (insert (vm-leading-message-separator 'From_)) (goto-char (point-max))