Mercurial > emacs

--- a/lisp/gnus/ChangeLog	Sat Oct 22 01:33:17 2005 +0000
+++ b/lisp/gnus/ChangeLog	Sat Oct 22 09:02:46 2005 +0000
@@ -1,3 +1,37 @@
+2005-10-20  Hiroshi Fujishima  <hiroshi.fujishima@gmail.com>  (tiny change)
+
+	* mail-source.el (mail-source-fetch-pop): Require pop3.
+	(mail-source-check-pop): Ditto.
+
+2005-10-20  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* rfc2047.el (rfc2047-decode-encoded-words): Fix the handling of
+	errors.
+
+2005-10-19  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* gnus-art.el (gnus-treat-strip-trailing-blank-lines)
+	(gnus-treat-strip-leading-blank-lines): Improve doc string.
+
+	* message.el (message-tool-bar-local-item-from-menu): Fix comment.
+
+2005-10-19  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* rfc2047.el (rfc2047-allow-incomplete-encoded-text): New variable.
+	(rfc2047-charset-to-coding-system): New function.
+	(rfc2047-decode-encoded-words): New function.
+	(rfc2047-decode-region): Use them.
+	(rfc2047-decode-cte): Remove.
+	(rfc2047-parse-and-decode): Remove.
+	(rfc2047-decode): Remove.
+
+2005-10-15  Kenichi Handa  <handa@m17n.org>
+
+	* rfc2047.el (rfc2047-decode-cte): New function.
+	(rfc2047-decode-region): Change the way to decode successive
+	encoded-words: decode B- or Q-encoding in each encoded-word,
+	concatenate them, and decode it as charset.
+
 2005-10-17  Chong Yidong  <cyd@stupidchicken.com>

 	* gnus-cus.el (gnus-custom-map): New variable.  Bind mouse-1 to
--- a/lisp/gnus/gnus-art.el	Sat Oct 22 01:33:17 2005 +0000
+++ b/lisp/gnus/gnus-art.el	Sat Oct 22 09:02:46 2005 +0000
@@ -1181,7 +1181,10 @@
 (defcustom gnus-treat-strip-trailing-blank-lines nil
   "Strip trailing blank lines.
 Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
+See Info node `(gnus)Customizing Articles' for details.
+
+When set to t, it also strips trailing blanks in all MIME parts.
+Consider to use `last' instead."
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1189,7 +1192,9 @@
 (defcustom gnus-treat-strip-leading-blank-lines nil
   "Strip leading blank lines.
 Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
+See Info node `(gnus)Customizing Articles' for details.
+
+When set to t, it also strips trailing blanks in all MIME parts."
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
--- a/lisp/gnus/mail-source.el	Sat Oct 22 01:33:17 2005 +0000
+++ b/lisp/gnus/mail-source.el	Sat Oct 22 09:02:46 2005 +0000
@@ -740,6 +740,7 @@
 	      (funcall function mail-source-crash-box))
 	     ;; The default is to use pop3.el.
 	     (t
+	      (require 'pop3)
 	      (let ((pop3-password password)
 		    (pop3-maildrop user)
 		    (pop3-mailhost server)
@@ -801,6 +802,7 @@
 	     (function)
 	     ;; The default is to use pop3.el.
 	     (t
+	      (require 'pop3)
 	      (let ((pop3-password password)
 		    (pop3-maildrop user)
 		    (pop3-mailhost server)
--- a/lisp/gnus/message.el	Sat Oct 22 01:33:17 2005 +0000
+++ b/lisp/gnus/message.el	Sat Oct 22 09:02:46 2005 +0000
@@ -6565,9 +6565,8 @@

 (defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
   ;; We need to make tool bar entries in local keymaps with
-  ;; `tool-bar-local-item-from-menu' in Emacs > 21.3
+  ;; `tool-bar-local-item-from-menu' in Emacs >= 22
   (if (fboundp 'tool-bar-local-item-from-menu)
-      ;; This is for Emacs 21.3
       (tool-bar-local-item-from-menu command icon in-map from-map props)
     (tool-bar-add-item-from-menu command icon from-map props)))
--- a/lisp/gnus/rfc2047.el	Sat Oct 22 01:33:17 2005 +0000
+++ b/lisp/gnus/rfc2047.el	Sat Oct 22 09:02:46 2005 +0000
@@ -812,6 +812,85 @@
 (defvar rfc2047-quote-decoded-words-containing-tspecials nil
   "If non-nil, quote decoded words containing special characters.")

+(defvar rfc2047-allow-incomplete-encoded-text t
+  "*Non-nil means allow incomplete encoded-text in successive encoded-words.
+Dividing of encoded-text in the place other than character boundaries
+violates RFC2047 section 5, while we have a capability to decode it.
+If it is non-nil, the decoder will decode B- or Q-encoding in each
+encoded-word, concatenate them, and decode it by charset.  Otherwise,
+the decoder will fully decode each encoded-word before concatenating
+them.")
+
+(defun rfc2047-charset-to-coding-system (charset)
+  "Return coding-system corresponding to MIME CHARSET.
+If your Emacs implementation can't decode CHARSET, return nil."
+  (when (stringp charset)
+    (setq charset (intern (downcase charset))))
+  (when (or (not charset)
+	    (eq 'gnus-all mail-parse-ignored-charsets)
+	    (memq 'gnus-all mail-parse-ignored-charsets)
+	    (memq charset mail-parse-ignored-charsets))
+    (setq charset mail-parse-charset))
+  (let ((cs (mm-coding-system-p (mm-charset-to-coding-system charset))))
+    (cond ((eq cs 'ascii)
+	   (setq cs (or (mm-charset-to-coding-system mail-parse-charset)
+			'raw-text)))
+	  (cs)
+	  ((and charset
+		(listp mail-parse-ignored-charsets)
+		(memq 'gnus-unknown mail-parse-ignored-charsets))
+	   (setq cs (mm-charset-to-coding-system mail-parse-charset))))
+    (if (eq cs 'ascii)
+	'raw-text
+      cs)))
+
+(defun rfc2047-decode-encoded-words (words)
+  "Decode successive encoded-words in WORDS and return a decoded string.
+Each element of WORDS looks like (CHARSET ENCODING ENCODED-TEXT
+ENCODED-WORD)."
+  (let (word charset cs encoding text rest)
+    (while words
+      (setq word (pop words))
+      (if (and (or (setq cs (rfc2047-charset-to-coding-system
+			     (setq charset (car word))))
+		   (progn
+		     (message "Unknown charset: %s" charset)
+		     nil))
+	       (condition-case code
+		   (cond ((char-equal ?B (nth 1 word))
+			  (setq text (base64-decode-string
+				      (rfc2047-pad-base64 (nth 2 word)))))
+			 ((char-equal ?Q (nth 1 word))
+			  (setq text (quoted-printable-decode-string
+				      (mm-subst-char-in-string
+				       ?_ ?  (nth 2 word) t)))))
+		 (error
+		  (message "%s" (error-message-string code))
+		  nil)))
+	  (if (and rfc2047-allow-incomplete-encoded-text
+		   (eq cs (caar rest)))
+	      ;; Concatenate text of which the charset is the same.
+	      (setcdr (car rest) (concat (cdar rest) text))
+	    (push (cons cs text) rest))
+	;; Don't decode encoded-word.
+	(push (cons nil (nth 3 word)) rest)))
+    (while rest
+      (setq words (concat
+		   (or (and (setq cs (caar rest))
+			    (condition-case code
+				(mm-decode-coding-string (cdar rest) cs)
+			      (error
+			       (message "%s" (error-message-string code))
+			       nil)))
+		       (concat (when (cdr rest) " ")
+			       (cdar rest)
+			       (when (and words
+					  (not (eq (string-to-char words) ? )))
+				 " ")))
+		   words)
+	    rest (cdr rest)))
+    words))
+
 ;; Fixme: This should decode in place, not cons intermediate strings.
 ;; Also check whether it needs to worry about delimiting fields like
 ;; encoding.
@@ -826,32 +905,32 @@
   "Decode MIME-encoded words in region between START and END."
   (interactive "r")
   (let ((case-fold-search t)
-	b e)
+	(eword-regexp (eval-when-compile
+			;; Ignore whitespace between encoded-words.
+			(concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp
+				"\\)")))
+	b e match words)
     (save-excursion
       (save-restriction
 	(narrow-to-region start end)
-	(goto-char (point-min))
-	;; Remove whitespace between encoded words.
-	(while (re-search-forward
-		(eval-when-compile
-		  (concat "\\(" rfc2047-encoded-word-regexp "\\)"
-			  "\\(\n?[ \t]\\)+"
-			  "\\(" rfc2047-encoded-word-regexp "\\)"))
-		nil t)
-	  (delete-region (goto-char (match-end 1)) (match-beginning 7)))
-	;; Decode the encoded words.
-	(setq b (goto-char (point-min)))
-	(while (re-search-forward rfc2047-encoded-word-regexp nil t)
-	  (setq e (match-beginning 0))
-	  (insert (rfc2047-parse-and-decode
-		   (prog1
-		       (match-string 0)
-		     (delete-region e (match-end 0)))))
-	  (while (looking-at rfc2047-encoded-word-regexp)
-	    (insert (rfc2047-parse-and-decode
-		     (prog1
-			 (match-string 0)
-		       (delete-region (point) (match-end 0))))))
+	(goto-char (setq b start))
+	;; Look for the encoded-words.
+	(while (setq match (re-search-forward eword-regexp nil t))
+	  (setq e (match-beginning 1)
+		end (match-end 0)
+		words nil)
+	  (while match
+	    (push (list (match-string 2) ;; charset
+			(char-after (match-beginning 4)) ;; encoding
+			(match-string 5) ;; encoded-text
+			(match-string 1)) ;; encoded-word
+		  words)
+	    ;; Look for the subsequent encoded-words.
+	    (when (setq match (looking-at eword-regexp))
+	      (goto-char (setq end (match-end 0)))))
+	  ;; Replace the encoded-words with the decoded one.
+	  (delete-region e end)
+	  (insert (rfc2047-decode-encoded-words (nreverse words)))
 	  (save-restriction
 	    (narrow-to-region e (point))
 	    (goto-char e)
@@ -957,21 +1036,6 @@
 	    (mm-decode-coding-string string mail-parse-charset))
 	(mm-string-as-multibyte string)))))

-(defun rfc2047-parse-and-decode (word)
-  "Decode WORD and return it if it is an encoded word.
-Return WORD if it is not not an encoded word or if the charset isn't
-decodable."
-  (if (not (string-match rfc2047-encoded-word-regexp word))
-      word
-    (or
-     (condition-case nil
-	 (rfc2047-decode
-	  (match-string 1 word)
-	  (string-to-char (match-string 3 word))
-	  (match-string 4 word))
-       (error word))
-     word)))				; un-decodable
-
 (defun rfc2047-pad-base64 (string)
   "Pad STRING to quartets."
   ;; Be more liberal to accept buggy base64 strings. If
@@ -987,36 +1051,6 @@
       (2 (concat string "=="))
       (3 (concat string "=")))))

-(defun rfc2047-decode (charset encoding string)
-  "Decode STRING from the given MIME CHARSET in the given ENCODING.
-Valid ENCODINGs are the characters \"B\" and \"Q\".
-If your Emacs implementation can't decode CHARSET, return nil."
-  (if (stringp charset)
-      (setq charset (intern (downcase charset))))
-  (if (or (not charset)
-	  (eq 'gnus-all mail-parse-ignored-charsets)
-	  (memq 'gnus-all mail-parse-ignored-charsets)
-	  (memq charset mail-parse-ignored-charsets))
-      (setq charset mail-parse-charset))
-  (let ((cs (mm-charset-to-coding-system charset)))
-    (if (and (not cs) charset
-	     (listp mail-parse-ignored-charsets)
-	     (memq 'gnus-unknown mail-parse-ignored-charsets))
-	(setq cs (mm-charset-to-coding-system mail-parse-charset)))
-    (when cs
-      (when (eq cs 'ascii)
-	(setq cs (or mail-parse-charset 'raw-text)))
-      (mm-decode-coding-string
-       (cond
-	((char-equal ?B encoding)
-	 (base64-decode-string
-	  (rfc2047-pad-base64 string)))
-	((char-equal ?Q encoding)
-	 (quoted-printable-decode-string
-	  (mm-subst-char-in-string ?_ ? string t)))
-	(t (error "Invalid encoding: %c" encoding)))
-       cs))))
-
 (provide 'rfc2047)

 ;;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6
--- a/man/ChangeLog	Sat Oct 22 01:33:17 2005 +0000
+++ b/man/ChangeLog	Sat Oct 22 09:02:46 2005 +0000
@@ -1,3 +1,7 @@
+2005-10-17  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus.texi (Document Groups): Remove duplicate item.
+
 2005-10-21  Juri Linkov  <juri@jurta.org>

 	* custom.texi (Examining): Mention accessing the old variable
--- a/man/gnus.texi	Sat Oct 22 01:33:17 2005 +0000
+++ b/man/gnus.texi	Sat Oct 22 09:02:46 2005 +0000
@@ -16753,12 +16753,11 @@
 @table @code
 @cindex Babyl
 @cindex Rmail mbox
-
 @item babyl
 The Babyl (Rmail) mail box.
+
 @cindex mbox
 @cindex Unix mbox
-
 @item mbox
 The standard Unix mbox file.

@@ -16769,13 +16768,9 @@
 @item news
 Several news articles appended into a file.

+@cindex rnews batch files
 @item rnews
-@cindex rnews batch files
 The rnews batch transport format.
-@cindex forwarded messages
-
-@item forward
-Forwarded articles.

 @item nsmail
 Netscape mail boxes.
@@ -16792,6 +16787,7 @@
 @item lanl-gov-announce
 Announcement messages from LANL Gov Announce.

+@cindex forwarded messages
 @item rfc822-forward
 A message forwarded according to RFC822.