Mercurial > emacs

--- a/lisp/gnus/ChangeLog	Thu Nov 16 09:07:16 2006 +0000
+++ b/lisp/gnus/ChangeLog	Thu Nov 16 11:10:48 2006 +0000
@@ -1,3 +1,44 @@
+2006-11-15  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* gnus-util.el (gnus-extract-address-components): Improve comment.
+
+2006-11-14  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-util.el (gnus-extract-address-components): Work with address in
+	which the name portion contains @.
+
+2006-11-14  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* gnus.el (gnus-start): Move custom group up.
+	(gnus-select-method): Don't autoload, but make it available for
+	`customize-variable'.
+	(gnus-getenv-nntpserver): Don't autoload.
+
+2006-11-14  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* mml.el (mml-generate-mime-1): Use mm-string-as-unibyte instead of
+	mm-with-unibyte-current-buffer to make string unibyte.
+
+	* mm-decode.el (mm-insert-part): Use mm-string-to-multibyte instead of
+	mm-string-as-multibyte.
+
+2006-11-09  Reiner Steib  <Reiner.Steib@gmx.de>
+
+	* message.el: Merge from the trunk to fix the bug WRT double encoded
+	subjects.
+	(message-replacement-char): New variable.
+	(message-fix-before-sending): Use it.
+	(message-simplify-subject): New function to remove duplicate code.
+	(message-reply, message-followup): Use it.
+	(message-simplify-subject-functions): New variable.
+	(message-strip-subject-encoded-words): New function
+
+2006-11-08  Wolfgang Jenkner  <wjenkner@inode.at>  (tiny change)
+
+	* gnus-sum.el (gnus-summary-catchup): Use gnus-sorted-intersection
+	instead of gnus-intersection because arguments of gnus-sorted-nunion
+	must be sorted.  This avoids corruption of gnus-newsgroup-unreads.
+
 2006-11-03  Juanma Barranquero  <lekktu@gmail.com>

 	* gnus-diary.el (gnus-diary-delay-format-function):
--- a/lisp/gnus/gnus-sum.el	Thu Nov 16 09:07:16 2006 +0000
+++ b/lisp/gnus/gnus-sum.el	Thu Nov 16 11:10:48 2006 +0000
@@ -10470,8 +10470,8 @@
 			gnus-newsgroup-dormant nil))
 		(setq gnus-newsgroup-unreads
 		      (gnus-sorted-nunion
-                       (gnus-intersection gnus-newsgroup-unreads
-                                          gnus-newsgroup-downloadable)
+                       (gnus-sorted-intersection gnus-newsgroup-unreads
+						 gnus-newsgroup-downloadable)
                        gnus-newsgroup-unfetched)))
 	    ;; We actually mark all articles as canceled, which we
 	    ;; have to do when using auto-expiry or adaptive scoring.
--- a/lisp/gnus/gnus-util.el	Thu Nov 16 09:07:16 2006 +0000
+++ b/lisp/gnus/gnus-util.el	Thu Nov 16 11:10:48 2006 +0000
@@ -202,8 +202,13 @@
     ;; First find the address - the thing with the @ in it.  This may
     ;; not be accurate in mail addresses, but does the trick most of
     ;; the time in news messages.
-    (when (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
-      (setq address (substring from (match-beginning 0) (match-end 0))))
+    (cond (;; Check ``<foo@bar>'' first in order to handle the quite common
+	   ;; form ``"abc@xyz" <foo@bar>'' (i.e. ``@'' as part of a comment)
+	   ;; correctly.
+	   (string-match "<\\([^@ \t<>]+[!@][^@ \t<>]+\\)>" from)
+	   (setq address (substring from (match-beginning 1) (match-end 1))))
+	  ((string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
+	   (setq address (substring from (match-beginning 0) (match-end 0)))))
     ;; Then we check whether the "name <address>" format is used.
     (and address
 	 ;; Linear white space is not required.
--- a/lisp/gnus/gnus.el	Thu Nov 16 09:07:16 2006 +0000
+++ b/lisp/gnus/gnus.el	Thu Nov 16 11:10:48 2006 +0000
@@ -51,6 +51,10 @@
   :group 'news
   :group 'mail)

+(defgroup gnus-start nil
+  "Starting your favorite newsreader."
+  :group 'gnus)
+
 (defgroup gnus-format nil
   "Dealing with formatting issues."
   :group 'gnus)
@@ -70,10 +74,6 @@
   "Article Registry."
   :group 'gnus)

-(defgroup gnus-start nil
-  "Starting your favorite newsreader."
-  :group 'gnus)
-
 (defgroup gnus-start-server nil
   "Server options at startup."
   :group 'gnus-start)
@@ -1239,7 +1239,6 @@
   :group 'gnus-server
   :type 'file)

-;;;###autoload
 (defun gnus-getenv-nntpserver ()
   "Find default nntp server.
 Check the NNTPSERVER environment variable and the
@@ -1251,7 +1250,11 @@
 	     (when (re-search-forward "[^ \t\n\r]+" nil t)
 	       (match-string 0))))))

-;;;###autoload
+;; `M-x customize-variable RET gnus-select-method RET' should work without
+;; starting or even loading Gnus.
+;;;###autoload(when (fboundp 'custom-autoload)
+;;;###autoload  (custom-autoload 'gnus-select-method "gnus"))
+
 (defcustom gnus-select-method
   (condition-case nil
       (nconc
@@ -1285,6 +1288,8 @@
 There is a lot more to know about select methods and virtual servers -
 see the manual for details."
   :group 'gnus-server
+  :group 'gnus-start
+  :initialize 'custom-initialize-default
   :type 'gnus-select-method)

 (defcustom gnus-message-archive-method "archive"
--- a/lisp/gnus/message.el	Thu Nov 16 09:07:16 2006 +0000
+++ b/lisp/gnus/message.el	Thu Nov 16 11:10:48 2006 +0000
@@ -1786,6 +1786,96 @@
       (substring subject (match-end 0))
     subject))

+(defcustom message-replacement-char "."
+  "Replacement character used instead of unprintable or not decodable chars."
+  :group 'message-various
+  :version "22.1" ;; Gnus 5.10.9
+  :type '(choice string
+		 (const ".")
+		 (const "?")))
+
+;; FIXME: We also should call `message-strip-subject-encoded-words'
+;; when forwarding.  Probably in `message-make-forward-subject' and
+;; `message-forward-make-body'.
+
+(defun message-strip-subject-encoded-words (subject)
+  "Fix non-decodable words in SUBJECT."
+  ;; Cf. `gnus-simplify-subject-fully'.
+  (let* ((case-fold-search t)
+	 (replacement-chars (format "[%s%s%s]"
+				    message-replacement-char
+				    message-replacement-char
+				    message-replacement-char))
+	 (enc-word-re "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)")
+	 cs-string
+	 (have-marker
+	  (with-temp-buffer
+	    (insert subject)
+	    (goto-char (point-min))
+	    (when (re-search-forward enc-word-re nil t)
+	      (setq cs-string (match-string 1)))))
+	 cs-coding q-or-b word-beg word-end)
+    (if (or (not have-marker) ;; No encoded word found...
+	    ;; ... or double encoding was correct:
+	    (and (stringp cs-string)
+		 (setq cs-string (downcase cs-string))
+		 (mm-coding-system-p (intern cs-string))
+		 (not (prog1
+			  (y-or-n-p
+			   (format "\
+Decoded Subject \"%s\"
+contains a valid encoded word.  Decode again? "
+				   subject))
+			(setq cs-coding (intern cs-string))))))
+	subject
+      (with-temp-buffer
+	(insert subject)
+	(goto-char (point-min))
+	(while (re-search-forward enc-word-re nil t)
+	  (setq cs-string (downcase (match-string 1))
+		q-or-b    (match-string 2)
+		word-beg (match-beginning 0)
+		word-end (match-end 0))
+	  (setq cs-coding
+		(if (mm-coding-system-p (intern cs-string))
+		    (setq cs-coding (intern cs-string))
+		  nil))
+	  ;; No double encoded subject? => bogus charset.
+	  (unless cs-coding
+	    (setq cs-coding
+		  (mm-read-coding-system
+		   (format "\
+Decoded Subject \"%s\"
+contains an encoded word.  The charset `%s' is unknown or invalid.
+Hit RET to replace non-decodable characters with \"%s\" or enter replacement
+charset: "
+			   subject cs-string message-replacement-char)))
+	    (if cs-coding
+		(replace-match (concat "=?" (symbol-name cs-coding)
+				       "?\\2?\\3\\4\\5"))
+	      (save-excursion
+		(goto-char word-beg)
+		(re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end t)
+		(replace-match "")
+		;; QP or base64
+		(if (string-match "\\`Q\\'" q-or-b)
+		    ;; QP
+		    (progn
+		      (message "Replacing non-decodable characters with \"%s\"."
+			       message-replacement-char)
+		      (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+"
+						word-end t)
+			(replace-match message-replacement-char)))
+		  ;; base64
+		  (message "Replacing non-decodable characters with \"%s\"."
+			   replacement-chars)
+		  (re-search-forward "[^?]+" word-end t)
+		  (replace-match replacement-chars))
+		(re-search-forward "\\?=")
+		(replace-match "")))))
+	(rfc2047-decode-region (point-min) (point-max))
+	(buffer-string)))))
+
 ;;; Start of functions adopted from `message-utils.el'.

 (defun message-strip-subject-trailing-was (subject)
@@ -3614,8 +3704,10 @@
 	(setq choice
 	      (gnus-multiple-choice
 	       "Non-printable characters found.  Continue sending?"
-	       '((?d "Remove non-printable characters and send")
-		 (?r "Replace non-printable characters with dots and send")
+	       `((?d "Remove non-printable characters and send")
+		 (?r ,(format
+		       "Replace non-printable characters with \"%s\" and send"
+		       message-replacement-char))
 		 (?i "Ignore non-printable characters and send")
 		 (?e "Continue editing"))))
 	(if (eq choice ?e)
@@ -3638,7 +3730,7 @@
 		(message-kill-all-overlays)
 	      (delete-char 1)
 	      (when (eq choice ?r)
-		(insert "."))))
+		(insert message-replacement-char))))
 	  (forward-char)
 	  (skip-chars-forward mm-7bit-chars))))))

@@ -5816,6 +5908,39 @@
 	(push (cons 'Cc recipients) follow-to)))
     follow-to))

+(defcustom message-simplify-subject-functions
+  '(message-strip-list-identifiers
+    message-strip-subject-re
+    message-strip-subject-trailing-was
+    message-strip-subject-encoded-words)
+  "List of functions taking a string argument that simplify subjects.
+The functions are applied when replying to a message.
+
+Useful functions to put in this list include:
+`message-strip-list-identifiers', `message-strip-subject-re',
+`message-strip-subject-trailing-was', and
+`message-strip-subject-encoded-words'."
+  :version "22.1" ;; Gnus 5.10.9
+  :group 'message-various
+  :type '(repeat function))
+
+(defun message-simplify-subject (subject &optional functions)
+  "Return simplified SUBJECT."
+  (unless functions
+    ;; Simplify fully:
+    (setq functions message-simplify-subject-functions))
+  (when (and (memq 'message-strip-list-identifiers functions)
+	     gnus-list-identifiers)
+    (setq subject (message-strip-list-identifiers subject)))
+  (when (memq 'message-strip-subject-re functions)
+    (setq subject (concat "Re: " (message-strip-subject-re subject))))
+  (when (and (memq 'message-strip-subject-trailing-was functions)
+	     message-subject-trailing-was-query)
+    (setq subject (message-strip-subject-trailing-was subject)))
+  (when (memq 'message-strip-subject-encoded-words functions)
+    (setq subject (message-strip-subject-encoded-words subject)))
+  subject)
+
 ;;;###autoload
 (defun message-reply (&optional to-address wide)
   "Start editing a reply to the article in the current buffer."
@@ -5845,11 +5970,9 @@
 	    date (message-fetch-field "date")
 	    from (or (message-fetch-field "from") "nobody")
 	    subject (or (message-fetch-field "subject") "none"))
-      (when gnus-list-identifiers
-	(setq subject (message-strip-list-identifiers subject)))
-      (setq subject (concat "Re: " (message-strip-subject-re subject)))
-      (when message-subject-trailing-was-query
-	(setq subject (message-strip-subject-trailing-was subject)))
+
+      ;; Strip list identifiers, "Re: ", and "was:"
+      (setq subject (message-simplify-subject subject))

       (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
 		 (string-match "<[^>]+>" gnus-warning))
@@ -5919,11 +6042,8 @@
 		 (let ((case-fold-search t))
 		   (string-match "world" distribution)))
 	(setq distribution nil))
-      (if gnus-list-identifiers
-	  (setq subject (message-strip-list-identifiers subject)))
-      (setq subject (concat "Re: " (message-strip-subject-re subject)))
-      (when message-subject-trailing-was-query
-	(setq subject (message-strip-subject-trailing-was subject)))
+      ;; Strip list identifiers, "Re: ", and "was:"
+      (setq subject (message-simplify-subject subject))
       (widen))

     (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
--- a/lisp/gnus/mm-decode.el	Thu Nov 16 09:07:16 2006 +0000
+++ b/lisp/gnus/mm-decode.el	Thu Nov 16 11:10:48 2006 +0000
@@ -1135,7 +1135,7 @@
 	    (with-current-buffer (mm-handle-buffer handle)
 	      (buffer-string)))
 	   ((mm-multibyte-p)
-	    (mm-string-as-multibyte (mm-get-part handle no-cache)))
+	    (mm-string-to-multibyte (mm-get-part handle no-cache)))
 	   (t
 	    (mm-get-part handle no-cache))))))
--- a/lisp/gnus/mml.el	Thu Nov 16 09:07:16 2006 +0000
+++ b/lisp/gnus/mml.el	Thu Nov 16 11:10:48 2006 +0000
@@ -501,9 +501,9 @@
 	    (mm-with-unibyte-buffer
 	      (cond
 	       ((cdr (assq 'buffer cont))
-		(insert (with-current-buffer (cdr (assq 'buffer cont))
-			  (mm-with-unibyte-current-buffer
-			    (buffer-string)))))
+		(insert (mm-string-as-unibyte
+			 (with-current-buffer (cdr (assq 'buffer cont))
+			   (buffer-string)))))
 	       ((and filename
 		     (not (equal (cdr (assq 'nofile cont)) "yes")))
 		(let ((coding-system-for-read mm-binary-coding-system))