Mercurial > emacs

--- a/lisp/gnus/ChangeLog	Mon Jan 16 05:41:26 2006 +0000
+++ b/lisp/gnus/ChangeLog	Mon Jan 16 09:27:43 2006 +0000
@@ -1,3 +1,29 @@
+2006-01-16  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* mm-uu.el (mm-uu-text-plain-type): New variable.
+	(mm-uu-pgp-signed-extract-1): Use it.
+	(mm-uu-pgp-encrypted-extract-1): Use it.
+	(mm-uu-dissect): Use it; allow two optional arguments; one is a
+	flag specifying whether there's no message header; the other is
+	for a MIME type and parameters; bind mm-uu-text-plain-type with
+	the later one.
+	(mm-uu-dissect-text-parts): New function.
+
+	* gnus-art.el (gnus-display-mime): Use mm-uu-dissect-text-parts to
+	dissect text parts.
+
+2006-01-13  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (article-wash-html): Use
+	gnus-summary-show-article-charset-alist if a numeric arg is given.
+	(gnus-article-wash-html-with-w3m-standalone): New function.
+
+	* mm-view.el (mm-text-html-renderer-alist): Map w3m-standalone to
+	mm-inline-text-html-render-with-w3m-standalone.
+	(mm-text-html-washer-alist): Map w3m-standalone to
+	gnus-article-wash-html-with-w3m-standalone.
+	(mm-inline-text-html-render-with-w3m-standalone): New function.
+
 2006-01-10  Katsumi Yamaoka  <yamaoka@jpl.org>

 	* nnrss.el (nnrss-wash-html-in-text-plain-parts): New variable.
--- a/lisp/gnus/gnus-art.el	Mon Jan 16 05:41:26 2006 +0000
+++ b/lisp/gnus/gnus-art.el	Mon Jan 16 09:27:43 2006 +0000
@@ -2467,25 +2467,36 @@

 (defun article-wash-html (&optional read-charset)
   "Format an HTML article.
-If READ-CHARSET, ask for a coding system."
+If READ-CHARSET, ask for a coding system.  If it is a number, the
+charset defined in `gnus-summary-show-article-charset-alist' is used."
   (interactive "P")
   (save-excursion
     (let ((inhibit-read-only t)
 	  charset)
-      (when (gnus-buffer-live-p gnus-original-article-buffer)
-	(with-current-buffer gnus-original-article-buffer
-	  (let* ((ct (gnus-fetch-field "content-type"))
-		 (ctl (and ct
-			   (ignore-errors
-			     (mail-header-parse-content-type ct)))))
-	    (setq charset (and ctl
-			       (mail-content-type-get ctl 'charset)))
-	    (when (stringp charset)
-	      (setq charset (intern (downcase charset)))))))
-      (when read-charset
-	(setq charset (mm-read-coding-system "Charset: " charset)))
-      (unless charset
-	(setq charset gnus-newsgroup-charset))
+      (if read-charset
+	  (if (or (and (numberp read-charset)
+		       (setq charset
+			     (cdr
+			      (assq read-charset
+				    gnus-summary-show-article-charset-alist))))
+		  (setq charset (mm-read-coding-system "Charset: ")))
+	      (let ((gnus-summary-show-article-charset-alist
+		     (list (cons 1 charset))))
+		(with-current-buffer gnus-summary-buffer
+		  (gnus-summary-show-article 1)))
+	    (error "No charset is given"))
+	(when (gnus-buffer-live-p gnus-original-article-buffer)
+	  (with-current-buffer gnus-original-article-buffer
+	    (let* ((ct (gnus-fetch-field "content-type"))
+		   (ctl (and ct
+			     (ignore-errors
+			       (mail-header-parse-content-type ct)))))
+	      (setq charset (and ctl
+				 (mail-content-type-get ctl 'charset)))
+	      (when (stringp charset)
+		(setq charset (intern (downcase charset)))))))
+	(unless charset
+	  (setq charset gnus-newsgroup-charset)))
       (article-goto-body)
       (save-window-excursion
 	(save-restriction
@@ -2526,6 +2537,20 @@
 	   ;; Put the mark meaning this part was rendered by emacs-w3m.
 	   'mm-inline-text-html-with-w3m t))))

+(eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'.
+
+(defun gnus-article-wash-html-with-w3m-standalone ()
+  "Wash the current buffer with w3m."
+  (unless (mm-coding-system-p charset)
+    ;; The default.
+    (setq charset 'iso-8859-1))
+  (let ((coding-system-for-write charset)
+	(coding-system-for-read charset))
+    (call-process-region
+     (point-min) (point-max)
+     "w3m" t t nil "-dump" "-T" "text/html"
+     "-I" (symbol-name charset) "-O" (symbol-name charset))))
+
 (defun article-hide-list-identifiers ()
   "Remove list identifies from the Subject header.
 The `gnus-list-identifiers' variable specifies what to do."
@@ -4718,11 +4743,15 @@
 	  ;; We have to do this since selecting the window
 	  ;; may change the point.  So we set the window point.
 	  (set-window-point window point)))
-      (let* ((handles (or ihandles
-			  (mm-dissect-buffer nil gnus-article-loose-mime)
-			  (and gnus-article-emulate-mime
-			       (mm-uu-dissect))))
-	     (inhibit-read-only t) handle name type b e display)
+      (let ((handles ihandles)
+	    (inhibit-read-only t)
+	    handle)
+	(cond (handles)
+	      ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime))
+	       (when gnus-article-emulate-mime
+		 (mm-uu-dissect-text-parts handles)))
+	      (gnus-article-emulate-mime
+	       (setq handles (mm-uu-dissect))))
 	(when (and (not ihandles)
 		   (not gnus-displaying-mime))
 	  ;; Top-level call; we clean up.
--- a/lisp/gnus/mm-uu.el	Mon Jan 16 05:41:26 2006 +0000
+++ b/lisp/gnus/mm-uu.el	Mon Jan 16 09:27:43 2006 +0000
@@ -174,6 +174,10 @@
 		   mm-uu-type-alist)
   :group 'gnus-article-mime)

+(defvar mm-uu-text-plain-type '("text/plain" (charset . gnus-decoded))
+  "MIME type and parameters for text/plain parts.
+`gnus-decoded' is a fake charset, which means no further decoding.")
+
 ;; functions

 (defsubst mm-uu-type (entry)
@@ -375,7 +379,7 @@
       (while (re-search-forward "^- " nil t)
 	(replace-match "" t t)
 	(forward-line 1)))
-    (list (mm-make-handle buf '("text/plain" (charset . gnus-decoded))))))
+    (list (mm-make-handle buf mm-uu-text-plain-type))))

 (defun mm-uu-pgp-signed-extract ()
   (let ((mm-security-handle (list (format "multipart/signed"))))
@@ -407,9 +411,7 @@
 	(with-current-buffer buf
 	  (mml2015-clean-buffer)
 	  (funcall (mml2015-clear-decrypt-function))))
-    (list
-     (mm-make-handle buf
-		     '("text/plain"  (charset . gnus-decoded))))))
+    (list (mm-make-handle buf mm-uu-text-plain-type))))

 (defun mm-uu-pgp-encrypted-extract ()
   (let ((mm-security-handle (list (format "multipart/encrypted"))))
@@ -443,23 +445,24 @@
 		    '("application/pgp-keys"))))

 ;;;###autoload
-(defun mm-uu-dissect ()
-  "Dissect the current buffer and return a list of uu handles."
+(defun mm-uu-dissect (&optional noheader mime-type)
+  "Dissect the current buffer and return a list of uu handles.
+The optional NOHEADER means there's no header in the buffer.
+MIME-TYPE specifies a MIME type and parameters, which defaults to the
+value of `mm-uu-text-plain-type'."
   (let ((case-fold-search t)
-	text-start start-point end-point file-name result
-	text-plain-type entry func)
+	(mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type))
+	text-start start-point end-point file-name result entry func)
     (save-excursion
       (goto-char (point-min))
       (cond
+       (noheader)
        ((looking-at "\n")
 	(forward-line))
        ((search-forward "\n\n" nil t)
 	t)
        (t (goto-char (point-max))))
-      ;;; gnus-decoded is a fake charset, which means no further
-      ;;; decoding.
-      (setq text-start (point)
-	    text-plain-type '("text/plain"  (charset . gnus-decoded)))
+      (setq text-start (point))
       (while (re-search-forward mm-uu-beginning-regexp nil t)
 	(setq start-point (match-beginning 0))
 	(let ((alist mm-uu-type-alist)
@@ -488,7 +491,7 @@
 		     (re-search-forward "." start-point t)))
 	      (push
 	       (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
-			       text-plain-type)
+			       mm-uu-text-plain-type)
 	       result))
 	  (push
 	   (funcall (mm-uu-function-extract entry))
@@ -501,11 +504,32 @@
 		   (re-search-forward "." nil t)))
 	    (push
 	     (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
-			     text-plain-type)
+			     mm-uu-text-plain-type)
 	     result))
 	(setq result (cons "multipart/mixed" (nreverse result))))
       result)))

+(defun mm-uu-dissect-text-parts (handle)
+  "Dissect text parts and put uu handles into HANDLE."
+  (let ((buffer (mm-handle-buffer handle))
+	type children)
+    (cond ((stringp buffer)
+	   (dolist (elem (cdr handle))
+	     (mm-uu-dissect-text-parts elem)))
+	  ((bufferp buffer)
+	   (when (and (setq type (mm-handle-media-type handle))
+		      (stringp type)
+		      (string-match "\\`text/" type)
+		      (with-current-buffer buffer
+			(setq children
+			      (mm-uu-dissect t (mm-handle-type handle)))))
+	     (kill-buffer buffer)
+	     (setcar handle (car children))
+	     (setcdr handle (cdr children))))
+	  (t
+	   (dolist (elem handle)
+	     (mm-uu-dissect-text-parts elem))))))
+
 (provide 'mm-uu)

 ;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c
--- a/lisp/gnus/mm-view.el	Mon Jan 16 05:41:26 2006 +0000
+++ b/lisp/gnus/mm-view.el	Mon Jan 16 09:27:43 2006 +0000
@@ -51,8 +51,7 @@
 (defvar mm-text-html-renderer-alist
   '((w3  . mm-inline-text-html-render-with-w3)
     (w3m . mm-inline-text-html-render-with-w3m)
-    (w3m-standalone mm-inline-render-with-stdin nil
-		    "w3m" "-dump" "-T" "text/html")
+    (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone)
     (links mm-inline-render-with-file
 	   mm-links-remove-leading-blank
 	   "links" "-dump" file)
@@ -64,8 +63,7 @@
 (defvar mm-text-html-washer-alist
   '((w3  . gnus-article-wash-html-with-w3)
     (w3m . gnus-article-wash-html-with-w3m)
-    (w3m-standalone mm-inline-wash-with-stdin nil
-		    "w3m" "-dump" "-T" "text/html")
+    (w3m-standalone . gnus-article-wash-html-with-w3m-standalone)
     (links mm-inline-wash-with-file
 	   mm-links-remove-leading-blank
 	   "links" "-dump" file)
@@ -264,6 +262,30 @@
 	      (delete-region ,(point-min-marker)
 			     ,(point-max-marker)))))))))

+(defun mm-inline-text-html-render-with-w3m-standalone (handle)
+  "Render a text/html part using w3m."
+  (let ((source (mm-get-part handle))
+	(charset (mail-content-type-get (mm-handle-type handle) 'charset))
+	cs)
+    (unless (and charset
+		 (setq cs (mm-charset-to-coding-system charset))
+		 (not (eq cs 'ascii)))
+      ;; The default.
+      (setq charset "iso-8859-1"
+	    cs 'iso-8859-1))
+    (mm-insert-inline
+     handle
+     (mm-with-unibyte-buffer
+       (insert source)
+       (mm-enable-multibyte)
+       (let ((coding-system-for-write 'binary)
+	     (coding-system-for-read cs))
+	 (call-process-region
+	  (point-min) (point-max)
+	  "w3m" t t nil "-dump" "-T" "text/html"
+	  "-I" charset "-O" charset))
+       (buffer-string)))))
+
 (defun mm-links-remove-leading-blank ()
   ;; Delete the annoying three spaces preceding each line of links
   ;; output.
--- a/man/ChangeLog	Mon Jan 16 05:41:26 2006 +0000
+++ b/man/ChangeLog	Mon Jan 16 09:27:43 2006 +0000
@@ -1,3 +1,11 @@
+2006-01-13  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus.texi (Article Washing): Additions.
+
+2006-01-08  Alex Schroeder  <alex@gnu.org>
+
+	* pgg.texi (Caching passphrase): Rewording.
+
 2006-01-14  Richard M. Stallman  <rms@gnu.org>

 	* basic.texi (Inserting Text): Minor cleanup.
--- a/man/gnus.texi	Mon Jan 16 05:41:26 2006 +0000
+++ b/man/gnus.texi	Mon Jan 16 09:27:43 2006 +0000
@@ -8571,7 +8571,9 @@
 usually done automatically by Gnus if the message in question has a
 @code{Content-Type} header that says that the message is @acronym{HTML}.

-If a prefix is given, a charset will be asked for.
+If a prefix is given, a charset will be asked for.  If it is a number,
+the charset defined in @code{gnus-summary-show-article-charset-alist}
+(@pxref{Paging the Article}) will be used.

 @vindex gnus-article-wash-function
 The default is to use the function specified by
@@ -8582,12 +8584,15 @@
 can use include:

 @table @code
-@item W3
+@item w3
 Use Emacs/W3.

 @item w3m
 Use @uref{http://emacs-w3m.namazu.org/, emacs-w3m}.

+@item w3m-standalone
+Use @uref{http://w3m.sourceforge.net/, w3m}.
+
 @item links
 Use @uref{http://links.sf.net/, Links}.