diff lisp/vm/vm-mime.el @ 140:585fb297b004 r20-2b4

Import from CVS: tag r20-2b4
author cvs
date Mon, 13 Aug 2007 09:32:43 +0200
parents b980b6286996
children 2af401a6ecca
line wrap: on
line diff
--- a/lisp/vm/vm-mime.el	Mon Aug 13 09:31:48 2007 +0200
+++ b/lisp/vm/vm-mime.el	Mon Aug 13 09:32:43 2007 +0200
@@ -825,7 +825,7 @@
 	     (make-local-variable 'scroll-in-place)
 	     (setq scroll-in-place nil)
 	     (and vm-xemacs-mule-p
-		  (set-file-coding-system 'binary t))
+		  (set-buffer-file-coding-system 'binary t))
 	     (cond (vm-fsfemacs-19-p
 		    ;; need to do this outside the let because
 		    ;; loading disp-table initializes
@@ -859,6 +859,8 @@
 	(set-buffer b)
 	(widen)
 	(let ((buffer-read-only nil)
+	      ;; disable read-only text properties
+	      (inhibit-read-only t)
 	      (modified (buffer-modified-p)))
 	  (unwind-protect
 	      (progn
@@ -890,7 +892,7 @@
 (fset 'vm-presentation-mode 'vm-mode)
 (put 'vm-presentation-mode 'mode-class 'special)
 
-(defvar file-coding-system)
+(defvar buffer-file-coding-system)
 
 (defun vm-determine-proper-charset (beg end)
   (save-excursion
@@ -904,8 +906,9 @@
 		     "us-ascii")
 		    ((cdr charsets)
 		     (or (car (cdr
-			       (assoc (coding-system-name file-coding-system)
-				      vm-mime-mule-coding-to-charset-alist)))
+			       (assq (coding-system-name
+				      buffer-file-coding-system)
+				     vm-mime-mule-coding-to-charset-alist)))
 			 "iso-2022-jp"))
 		    (t
 		     (or (car (cdr
@@ -1341,15 +1344,15 @@
 	     (vm-mime-transfer-decode-region layout start end)
 	     (setq tempfile (vm-make-tempfile-name))
 	     (let ((buffer-file-type buffer-file-type)
-		   file-coding-system)
+		   buffer-file-coding-system)
 	       ;; Tell DOS/Windows NT whether the file is binary
 	       (setq buffer-file-type (not (vm-mime-text-type-p layout)))
 	       ;; Tell XEmacs/MULE not to mess with the bits unless
 	       ;; this is a text type.
 	       (if vm-xemacs-mule-p
 		   (if (vm-mime-text-type-p layout)
-		       (set-file-coding-system 'no-conversion nil)
-		     (set-file-coding-system 'binary t)))
+		       (set-buffer-file-coding-system 'no-conversion nil)
+		     (set-buffer-file-coding-system 'binary t)))
 	       (write-region start end tempfile nil 0))
 	     (delete-region start end)
 	     (save-excursion
@@ -1532,7 +1535,13 @@
 
 (defun vm-mime-display-internal-message/rfc822 (layout)
   (if (vectorp layout)
-      (vm-mime-display-internal-text/plain layout)
+      (let ((start (point)))
+	(vm-mime-insert-mime-headers layout)
+	(insert ?\n)
+	(save-restriction
+	  (narrow-to-region start (point))
+	  (vm-decode-mime-encoded-words))
+	(vm-mime-display-internal-multipart/mixed layout))
     (goto-char (vm-extent-start-position layout))
     (setq layout (vm-extent-property layout 'vm-mime-layout))
     (set-buffer (generate-new-buffer
@@ -1931,8 +1940,8 @@
 	    ;; this is a text type.
 	    (if vm-xemacs-mule-p
 		(if (vm-mime-text-type-p layout)
-		    (set-file-coding-system 'no-conversion nil)
-		  (set-file-coding-system 'binary t)))
+		    (set-buffer-file-coding-system 'no-conversion nil)
+		  (set-buffer-file-coding-system 'binary t)))
 	    (vm-mime-insert-mime-body layout)
 	    (vm-mime-transfer-decode-region layout (point-min) (point-max))
 	    (or (not (file-exists-p file))
@@ -2458,6 +2467,8 @@
 	 (error "don't know how to MIME encode composition for %s"
 		(emacs-version)))))
 
+(defvar enriched-mode)
+
 (defun vm-mime-xemacs-encode-composition ()
   (save-restriction
     (widen)
@@ -2468,6 +2479,7 @@
     (let ((8bit nil)
 	  (just-one nil)
 	  (boundary-positions nil)
+	  (enriched (and (boundp 'enriched-mode) enriched-mode))
 	  already-mimed layout e e-list boundary
 	  type encoding charset params description disposition object
 	  opoint-min)
@@ -2495,8 +2507,15 @@
       (if (null e-list)
 	  (progn
 	    (narrow-to-region (point) (point-max))
+	    ;; support enriched-mode for text/enriched composition
+	    (if enriched
+		(let ((enriched-initial-annotation ""))
+		  (enriched-encode (point-min) (point-max))))
 	    (setq charset (vm-determine-proper-charset (point-min)
 						       (point-max)))
+	    (if vm-xemacs-mule-p
+		(encode-coding-region (point-min) (point-max)
+				      buffer-file-coding-system))
 	    (setq encoding (vm-determine-proper-content-transfer-encoding
 			    (point-min)
 			    (point-max))
@@ -2510,7 +2529,9 @@
 	    (vm-reorder-message-headers
 	     nil nil "\\(Content-Type:\\|Content-Transfer-Encoding\\|MIME-Version:\\)")
 	    (insert "MIME-Version: 1.0\n")
-	    (insert "Content-Type: text/plain; charset=" charset "\n")
+	    (if enriched
+		(insert "Content-Type: text/enriched; charset=" charset "\n")
+	      (insert "Content-Type: text/plain; charset=" charset "\n"))
 	    (insert "Content-Transfer-Encoding: " encoding "\n")
 	    (vm-add-mail-mode-header-separator))
 	(while e-list
@@ -2518,8 +2539,14 @@
 	  (if (or just-one (= (point) (extent-start-position e)))
 	      nil
 	    (narrow-to-region (point) (extent-start-position e))
+	    (if enriched
+		(let ((enriched-initial-annotation ""))
+		  (enriched-encode (point-min) (point-max))))
 	    (setq charset (vm-determine-proper-charset (point-min)
 						       (point-max)))
+	    (if vm-xemacs-mule-p
+		(encode-coding-region (point-min) (point-max)
+				      buffer-file-coding-system))
 	    (setq encoding (vm-determine-proper-content-transfer-encoding
 			    (point-min)
 			    (point-max))
@@ -2528,7 +2555,9 @@
 							   (point-max)
 							   t))
 	    (setq boundary-positions (cons (point-marker) boundary-positions))
-	    (insert "Content-Type: text/plain; charset=" charset "\n")
+	    (if enriched
+		(insert "Content-Type: text/enriched; charset=" charset "\n")
+	      (insert "Content-Type: text/plain; charset=" charset "\n"))
 	    (insert "Content-Transfer-Encoding: " encoding "\n\n")
 	    (widen))
 	  (goto-char (extent-start-position e))
@@ -2538,11 +2567,11 @@
 	  (cond ((bufferp object)
 		 (insert-buffer-substring object))
 		((stringp object)
-		 (let ((overriding-file-coding-system 'no-conversion)
-		       ;; don't let file-coding-system be changed
+		 (let ((coding-system-for-read 'no-conversion)
+		       ;; don't let buffer-file-coding-system be changed
 		       ;; by insert-file-contents-literally.  The
 		       ;; value we bind to it to here isn't important.
-		       (file-coding-system 'no-conversion))
+		       (buffer-file-coding-system 'no-conversion))
 		   (insert-file-contents-literally object))))
 	  ;; gather information about the object from the extent.
 	  (if (setq already-mimed (extent-property e 'vm-mime-encoded))
@@ -2652,8 +2681,14 @@
 	;; extent, if any.
 	(if (or just-one (= (point) (point-max)))
 	    nil
+	  (if enriched
+	      (let ((enriched-initial-annotation ""))
+		(enriched-encode (point) (point-max))))
 	  (setq charset (vm-determine-proper-charset (point)
 						     (point-max)))
+	  (if vm-xemacs-mule-p
+	      (encode-coding-region (point) (point-max)
+				    buffer-file-coding-system))
 	  (setq encoding (vm-determine-proper-content-transfer-encoding
 			  (point)
 			  (point-max))
@@ -2663,7 +2698,9 @@
 							 t))
 	  (setq 8bit (or 8bit (equal encoding "8bit")))
 	  (setq boundary-positions (cons (point-marker) boundary-positions))
-	  (insert "Content-Type: text/plain; charset=" charset "\n")
+	  (if enriched
+	      (insert "Content-Type: text/enriched; charset=" charset "\n")
+	    (insert "Content-Type: text/plain; charset=" charset "\n"))
 	  (insert "Content-Transfer-Encoding: " encoding "\n\n")
 	  (goto-char (point-max)))
 	(setq boundary (vm-mime-make-multipart-boundary))
@@ -2742,6 +2779,7 @@
     (let ((8bit nil)
 	  (just-one nil)
 	  (boundary-positions nil)
+	  (enriched (and (boundp 'enriched-mode) enriched-mode))
 	  already-mimed layout o o-list boundary
 	  type encoding charset params description disposition object
 	  opoint-min)
@@ -2769,6 +2807,10 @@
       (if (null o-list)
 	  (progn
 	    (narrow-to-region (point) (point-max))
+	    ;; support enriched-mode for text/enriched composition
+	    (if enriched
+		(let ((enriched-initial-annotation ""))
+		  (enriched-encode (point-min) (point-max))))
 	    (setq charset (vm-determine-proper-charset (point-min)
 						       (point-max)))
 	    (setq encoding (vm-determine-proper-content-transfer-encoding
@@ -2784,7 +2826,9 @@
 	    (vm-reorder-message-headers
 	     nil nil "\\(Content-Type:\\|Content-Transfer-Encoding\\|MIME-Version:\\)")
 	    (insert "MIME-Version: 1.0\n")
-	    (insert "Content-Type: text/plain; charset=" charset "\n")
+	    (if enriched
+		(insert "Content-Type: text/enriched; charset=" charset "\n")
+	      (insert "Content-Type: text/plain; charset=" charset "\n"))
 	    (insert "Content-Transfer-Encoding: " encoding "\n")
 	    (vm-add-mail-mode-header-separator))
 	(while o-list
@@ -2792,6 +2836,21 @@
 	  (if (or just-one (= (point) (overlay-start o)))
 	      nil
 	    (narrow-to-region (point) (overlay-start o))
+	    ;; support enriched-mode for text/enriched composition
+	    (if enriched
+		(let ((enriched-initial-annotation ""))
+		  (save-excursion
+		    ;; insert/delete trick needed to avoid
+		    ;; enriched-mode tags from seeping into the
+		    ;; attachment overlays.  I really wish
+		    ;; front-advance / rear-aadvance overlay
+		    ;; endpoint properties actually worked.
+		    (goto-char (point-max))
+		    (insert-before-markers "\n")
+		    (enriched-encode (point-min) (1- (point)))
+		    (goto-char (point-max))
+		    (delete-char -1)
+		    '(goto-char (point-min)))))
 	    (setq charset (vm-determine-proper-charset (point-min)
 						       (point-max)))
 	    (setq encoding (vm-determine-proper-content-transfer-encoding
@@ -2802,7 +2861,9 @@
 							   (point-max)
 							   t))
 	    (setq boundary-positions (cons (point-marker) boundary-positions))
-	    (insert "Content-Type: text/plain; charset=" charset "\n")
+	    (if enriched
+		(insert "Content-Type: text/enriched; charset=" charset "\n")
+	      (insert "Content-Type: text/plain; charset=" charset "\n"))
 	    (insert "Content-Transfer-Encoding: " encoding "\n\n")
 	    (widen))
 	  (goto-char (overlay-start o))
@@ -2935,6 +2996,10 @@
 	;; extent, if any.
 	(if (or just-one (= (point) (point-max)))
 	    nil
+	  ;; support enriched-mode for text/enriched composition
+	  (if enriched
+	      (let ((enriched-initial-annotation ""))
+		(enriched-encode (point) (point-max))))
 	  (setq charset (vm-determine-proper-charset (point)
 						     (point-max)))
 	  (setq encoding (vm-determine-proper-content-transfer-encoding
@@ -2946,7 +3011,9 @@
 							 t))
 	  (setq 8bit (or 8bit (equal encoding "8bit")))
 	  (setq boundary-positions (cons (point-marker) boundary-positions))
-	  (insert "Content-Type: text/plain; charset=" charset "\n")
+	  (if enriched
+	      (insert "Content-Type: text/enriched; charset=" charset "\n")
+	    (insert "Content-Type: text/plain; charset=" charset "\n"))
 	  (insert "Content-Transfer-Encoding: " encoding "\n\n")
 	  (goto-char (point-max)))
 	(setq boundary (vm-mime-make-multipart-boundary))