changeset 68521:04c2548593f7

Revision: [e-mail]/emacs--devo--0--patch-33 Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 8-13) - Merge from emacs--devo--0 - Update from CVS

--- a/lisp/gnus/ChangeLog	Tue Jan 31 20:46:15 2006 +0000
+++ b/lisp/gnus/ChangeLog	Wed Feb 01 10:02:36 2006 +0000
@@ -1,8 +1,60 @@
[phone]  Andreas Seltenreich <[e-mail]>
+
+	* nnweb.el (nnweb-group-alist): Use defvar instead of defvoo,
+	there's only one active file for all servers.
+	(nnweb-request-scan): Make sure nnweb-articles is initialized on
+	solid groups.  Gnus might have used a FAST request to select the
+	group.
+	(nnweb-request-group, nnweb-google-parse-1): Don't keep nnweb-type
+	and nnweb-search redundantly in the active file.
+	(nnweb-request-list): Don't list bogus groups.  There can only be
+	one.
+	(nnweb-request-create-group): Don't use ARGS.
+	(nnweb-possibly-change-server, nnweb-request-group): Remove some
+	initialisations.  Let nnoo do the work.
+
[phone]  Romain Francoise  <[e-mail]>
+
+	* message.el (message-alternative-emails): Improve docstring.
+	(message-setup-1): Call `message-use-alternative-email-as-from'
+	after `message-setup-hook' to give it precedence over posting
+	styles, etc.
+	(message-use-alternative-email-as-from): Add docstring.  Remove
+	the original From header if present.
+
[phone]  Katsumi Yamaoka  <[e-mail]>
+
+	* mm-uu.el (mm-uu-emacs-sources-extract): Say the part has been
+	decoded.
+	(mm-uu-diff-extract): Ditto.
+
[phone]  Kevin Ryde  <[e-mail]>
+
+	* mailcap.el (mailcap-viewer-passes-test): Don't put "(nil t)" into
+	mailcap-viewer-test-cache when there's no 'test clause, since that
+	will invert the meaning of a "nil" test previously determined by
+	mailcap-mailcap-entry-passes-test.
+
[phone]  Reiner Steib  <[e-mail]>
+
+	* nnweb.el (nnweb-google-parse-1): Clarify some comments.
+
[phone]  Andreas Seltenreich <[e-mail]>
+
+	* nnweb.el (nnweb-type-definition, nnweb-google-parse-1)
+	(nnweb-google-create-mapping, nnweb-google-search): Adapt to
+	current Google Groups.
+
[phone]  Katsumi Yamaoka  <[e-mail]>
+
+	* Makefile.in (clean): New rule.
+	(distclean): Use it.
+
 2006-01-25  Katsumi Yamaoka  <[e-mail]>
 
 	* mm-uu.el (mm-uu-dissect-text-parts): Ignore it if a given part
 	is dissected into a single part of which the type is the same as
-	the given one.
+	the given one; decode charset.
 
 2006-01-21  Kevin Ryde  <[e-mail]>
 

--- a/lisp/gnus/mailcap.el	Tue Jan 31 20:46:15 2006 +0000
+++ b/lisp/gnus/mailcap.el	Wed Feb 01 10:02:36 2006 +0000
@@ -1,7 +1,7 @@
 ;;; mailcap.el --- MIME media types configuration
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: William M. Perry <[e-mail]>
 ;;	Lars Magne Ingebrigtsen <[e-mail]>
@@ -640,30 +640,31 @@
 	 (viewer (cdr (assoc 'viewer viewer-info)))
 	 (default-directory (expand-file-name "~/"))
 	 status parsed-test cache result)
-    (if (setq cache (assoc test mailcap-viewer-test-cache))
-	(cadr cache)
-      (setq
-       result
-       (cond
-	((not test-info) t)		; No test clause
-	((not test) nil)		; Already failed test
-	((eq test t) t)			; Already passed test
-	((functionp test)		; Lisp function as test
-	 (funcall test type-info))
-	((and (symbolp test)		; Lisp variable as test
-	      (boundp test))
-	 (symbol-value test))
-	((and (listp test)		; List to be eval'd
-	      (symbolp (car test)))
-	 (eval test))
-	(t
-	 (setq test (mailcap-unescape-mime-test test type-info)
-	       test (list shell-file-name nil nil nil
-			  shell-command-switch test)
-	       status (apply 'call-process test))
-	 (eq 0 status))))
-      (push (list otest result) mailcap-viewer-test-cache)
-      result)))
+    (cond ((setq cache (assoc test mailcap-viewer-test-cache))
+	   (cadr cache))
+	  ((not test-info) t)		; No test clause
+	  (t
+	   (setq
+	    result
+	    (cond
+	     ((not test) nil)		; Already failed test
+	     ((eq test t) t)		; Already passed test
+	     ((functionp test)		; Lisp function as test
+	      (funcall test type-info))
+	     ((and (symbolp test)	; Lisp variable as test
+		   (boundp test))
+	      (symbol-value test))
+	     ((and (listp test)		; List to be eval'd
+		   (symbolp (car test)))
+	      (eval test))
+	     (t
+	      (setq test (mailcap-unescape-mime-test test type-info)
+		    test (list shell-file-name nil nil nil
+			       shell-command-switch test)
+		    status (apply 'call-process test))
+	      (eq 0 status))))
+	   (push (list otest result) mailcap-viewer-test-cache)
+	   result))))
 
 (defun mailcap-add-mailcap-entry (major minor info)
   (let ((old-major (assoc major mailcap-mime-data)))

--- a/lisp/gnus/message.el	Tue Jan 31 20:46:15 2006 +0000
+++ b/lisp/gnus/message.el	Wed Feb 01 10:02:36 2006 +0000
@@ -1388,8 +1388,13 @@
 		 (integer 1000000)))
 
 (defcustom message-alternative-emails nil
-  "A regexp to match the alternative email addresses.
-The first matched address (not primary one) is used in the From field."
+  "*Regexp matching alternative email addresses.
+The first address in the To, Cc or From headers of the original
+article matching this variable is used as the From field of
+outgoing messages.
+
+This variable has precedence over posting styles and anything that runs
+off `message-setup-hook'."
   :group 'message-headers
   :link '(custom-manual "(message)Message Headers")
   :type '(choice (const :tag "Always use primary" nil)
@@ -5546,10 +5551,6 @@
     (when message-default-mail-headers
       (insert message-default-mail-headers)
       (or (bolp) (insert ?\n)))
-    (save-restriction
-      (message-narrow-to-headers)
-      (if message-alternative-emails
-	  (message-use-alternative-email-as-from)))
     (when message-generate-headers-first
       (message-generate-headers
        (message-headers-to-generate
@@ -5565,6 +5566,12 @@
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
   (run-hooks 'message-setup-hook)
+  ;; Do this last to give it precedence over posting styles, etc.
+  (when (message-mail-p)
+    (save-restriction
+      (message-narrow-to-headers)
+      (if message-alternative-emails
+	  (message-use-alternative-email-as-from))))
   (message-position-point)
   (undo-boundary))
 
@@ -6848,6 +6855,9 @@
       (read-string prompt initial-contents))))
 
 (defun message-use-alternative-email-as-from ()
+  "Set From field of the outgoing message to the first matching
+address in `message-alternative-emails', looking at To, Cc and
+From headers in the original article."
   (require 'mail-utils)
   (let* ((fields '("To" "Cc"))
 	 (emails
@@ -6862,6 +6872,7 @@
 		emails nil))
       (pop emails))
     (unless (or (not email) (equal email user-mail-address))
+      (message-remove-header "From")
       (goto-char (point-max))
       (insert "From: " email "\n"))))
 

--- a/lisp/gnus/mm-uu.el	Tue Jan 31 20:46:15 2006 +0000
+++ b/lisp/gnus/mm-uu.el	Wed Feb 01 10:02:36 2006 +0000
@@ -266,7 +266,7 @@
 
 (defun mm-uu-emacs-sources-extract ()
   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
-		  '("application/emacs-lisp")
+		  '("application/emacs-lisp" (charset . gnus-decoded))
 		  nil nil
 		  (list mm-dissect-disposition
 			(cons 'filename file-name))))
@@ -282,7 +282,7 @@
 
 (defun mm-uu-diff-extract ()
   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
-		  '("text/x-patch")))
+		  '("text/x-patch" (charset . gnus-decoded))))
 
 (defun mm-uu-diff-test ()
   (and gnus-newsgroup-name
@@ -509,31 +509,53 @@
 	(setq result (cons "multipart/mixed" (nreverse result))))
       result)))
 
-(defun mm-uu-dissect-text-parts (handle)
-  "Dissect text parts and put uu handles into HANDLE."
+;;;###autoload
+(defun mm-uu-dissect-text-parts (handle &optional decoded)
+  "Dissect text parts and put uu handles into HANDLE.
+Assume text has been decoded if DECODED is non-nil."
   (let ((buffer (mm-handle-buffer handle)))
     (cond ((stringp buffer)
 	   (dolist (elem (cdr handle))
-	     (mm-uu-dissect-text-parts elem)))
+	     (mm-uu-dissect-text-parts elem decoded)))
 	  ((bufferp buffer)
 	   (let ((type (mm-handle-media-type handle))
 		 (case-fold-search t) ;; string-match
-		 encoding children)
+		 children charset encoding)
 	     (when (and
 		    (stringp type)
 		    ;; Mutt still uses application/pgp even though
 		    ;; it has already been withdrawn.
 		    (string-match "\\`text/\\|\\`application/pgp\\'" type)
-		    (setq children
-			  (with-current-buffer buffer
-			    (if (setq encoding (mm-handle-encoding handle))
-				;; Inherit the multibyteness of the `buffer'.
-				(with-temp-buffer
-				  (insert-buffer-substring buffer)
-				  (mm-decode-content-transfer-encoding
-				   encoding type)
-				  (mm-uu-dissect t (mm-handle-type handle)))
-			      (mm-uu-dissect t (mm-handle-type handle))))))
+		    (setq
+		     children
+		     (with-current-buffer buffer
+		       (cond
+			((or decoded
+			     (eq (setq charset (mail-content-type-get
+						(mm-handle-type handle)
+						'charset))
+				 'gnus-decoded))
+			 (setq decoded t)
+			 (mm-uu-dissect
+			  t (cons type '((charset . gnus-decoded)))))
+			(charset
+			 (setq decoded t)
+			 (mm-with-multibyte-buffer
+			   (insert (mm-decode-string (mm-get-part handle)
+						     charset))
+			   (mm-uu-dissect
+			    t (cons type '((charset . gnus-decoded))))))
+			((setq encoding (mm-handle-encoding handle))
+			 (setq decoded nil)
+			 ;; Inherit the multibyteness of the `buffer'.
+			 (with-temp-buffer
+			   (insert-buffer-substring buffer)
+			   (mm-decode-content-transfer-encoding
+			    encoding type)
+			   (mm-uu-dissect t (list type))))
+			(t
+			 (setq decoded nil)
+			 (mm-uu-dissect t (list type)))))))
 	       ;; Ignore it if a given part is dissected into a single
 	       ;; part of which the type is the same as the given one.
 	       (if (and (<= (length children) 2)
@@ -544,10 +566,10 @@
 		 (setcdr handle (cdr children))
 		 (setcar handle (car children)) ;; "multipart/mixed"
 		 (dolist (elem (cdr children))
-		   (mm-uu-dissect-text-parts elem))))))
+		   (mm-uu-dissect-text-parts elem decoded))))))
 	  (t
 	   (dolist (elem handle)
-	     (mm-uu-dissect-text-parts elem))))))
+	     (mm-uu-dissect-text-parts elem decoded))))))
 
 (provide 'mm-uu)
 

--- a/lisp/gnus/nnweb.el	Tue Jan 31 20:46:15 2006 +0000
+++ b/lisp/gnus/nnweb.el	Wed Feb 01 10:02:36 2006 +0000
@@ -1,7 +1,7 @@
 ;;; nnweb.el --- retrieving articles via web search engines
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005 Free Software Foundation, Inc.
+;;   2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <[e-mail]>
 ;; Keywords: news
@@ -27,11 +27,8 @@
 
 ;; Note: You need to have `w3' installed for some functions to work.
 
-;; FIXME: Due to changes in the HTML output of Google Groups and Gmane, stuff
-;; related to web groups (gnus-group-make-web-group) doesn't work anymore.
-
-;; Fetching an article by MID (cf. gnus-refer-article-method) over Google
-;; Groups should work.
+;; FIXME: Due to changes in the HTML output of Gmane, stuff related to Gmane
+;; web groups (`gnus-group-make-web-group') doesn't work anymore.
 
 ;;; Code:
 
@@ -61,6 +58,7 @@
 (defvar nnweb-type-definition
   '((google
      (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source")
+     (result . "http://groups.google.com/group/%s/msg/%s?dmode=source")
      (article . nnweb-google-wash-article)
      (reference . identity)
      (map . nnweb-google-create-mapping)
@@ -69,8 +67,9 @@
      (base    . "http://groups.google.com")
      (identifier . nnweb-google-identity))
     (dejanews ;; alias of google
-     (article . ignore)
-     (id . "http://groups.google.com/groups?selm=%s&output=gplain")
+     (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source")
+     (result . "http://groups.google.com/group/%s/msg/%s?dmode=source")
+     (article . nnweb-google-wash-article)
      (reference . identity)
      (map . nnweb-google-create-mapping)
      (search . nnweb-google-search)
@@ -100,7 +99,7 @@
 
 (defvoo nnweb-articles nil)
 (defvoo nnweb-buffer nil)
-(defvoo nnweb-group-alist nil)
+(defvar nnweb-group-alist nil)
 (defvoo nnweb-group nil)
 (defvoo nnweb-hashtb nil)
 
@@ -123,25 +122,19 @@
 (deffoo nnweb-request-scan (&optional group server)
   (nnweb-possibly-change-server group server)
   (if nnweb-ephemeral-p
-      (setq nnweb-hashtb (gnus-make-hashtable 4095)))
+      (setq nnweb-hashtb (gnus-make-hashtable 4095))
+    (unless nnweb-articles
+      (nnweb-read-overview group)))
   (funcall (nnweb-definition 'map))
   (unless nnweb-ephemeral-p
     (nnweb-write-active)
     (nnweb-write-overview group)))
 
 (deffoo nnweb-request-group (group &optional server dont-check)
-  (nnweb-possibly-change-server nil server)
-  (when (and group
-	     (not (equal group nnweb-group))
-	     (not nnweb-ephemeral-p))
-    (setq nnweb-group group
-	  nnweb-articles nil)
-    (let ((info (assoc group nnweb-group-alist)))
-      (when info
-	(setq nnweb-type (nth 2 info))
-	(setq nnweb-search (nth 3 info))
-	(unless dont-check
-	  (nnweb-read-overview group)))))
+  (nnweb-possibly-change-server group server)
+  (unless (or nnweb-ephemeral-p
+	      dont-check)
+    (nnweb-read-overview group))
   (cond
    ((not nnweb-articles)
     (nnheader-report 'nnweb "No matching articles"))
@@ -205,7 +198,7 @@
   (nnweb-possibly-change-server nil server)
   (save-excursion
     (set-buffer nntp-server-buffer)
-    (nnmail-generate-active nnweb-group-alist)
+    (nnmail-generate-active (list (assoc server nnweb-group-alist)))
     t))
 
 (deffoo nnweb-request-update-info (group info &optional server)
@@ -217,7 +210,7 @@
 (deffoo nnweb-request-create-group (group &optional server args)
   (nnweb-possibly-change-server nil server)
   (nnweb-request-delete-group group)
-  (push `(,group ,(cons 1 0) ,@args) nnweb-group-alist)
+  (push `(,group ,(cons 1 0)) nnweb-group-alist)
   (nnweb-write-active)
   t)
 
@@ -287,18 +280,16 @@
     def))
 
 (defun nnweb-possibly-change-server (&optional group server)
-  (nnweb-init server)
   (when server
     (unless (nnweb-server-opened server)
-      (nnweb-open-server server)))
+      (nnweb-open-server server))
+    (nnweb-init server))
   (unless nnweb-group-alist
     (nnweb-read-active))
   (unless nnweb-hashtb
     (setq nnweb-hashtb (gnus-make-hashtable 4095)))
   (when group
-    (when (and (not nnweb-ephemeral-p)
-	       (equal group nnweb-group))
-      (nnweb-request-group group nil t))))
+    (setq nnweb-group group)))
 
 (defun nnweb-init (server)
   "Initialize buffers and such."
@@ -337,22 +328,27 @@
       (mm-url-decode-entities))))
 
 (defun nnweb-google-parse-1 (&optional Message-ID)
+  "Parse search result in current buffer."
   (let ((i 0)
 	(case-fold-search t)
 	(active (cadr (assoc nnweb-group nnweb-group-alist)))
 	Subject Score Date Newsgroups From
 	map url mid)
     (unless active
-      (push (list nnweb-group (setq active (cons 1 0))
-		  nnweb-type nnweb-search)
+      (push (list nnweb-group (setq active (cons 1 0)))
 	    nnweb-group-alist))
     ;; Go through all the article hits on this page.
     (goto-char (point-min))
-    (while (re-search-forward
-	    "a href=/groups\\(\\?[^ \">]*selm=\\([^ &\">]+\\)\\)" nil t)
-      (setq mid (match-string 2)
+    (while
+	(re-search-forward
+	 "a +href=\"/group/\\([^>\"]+\\)/browse_thread/[^>]+#\\([0-9a-f]+\\)"
+	 nil t)
+      (setq Newsgroups (match-string-no-properties 1)
+	    ;; Note: Starting with Google Groups 2, `mid' is a Google-internal
+	    ;; ID, not a proper Message-ID.
+	    mid (match-string-no-properties 2)
 	    url (format
-		 (nnweb-definition 'id) mid))
+		 (nnweb-definition 'result) Newsgroups mid))
       (narrow-to-region (search-forward ">" nil t)
 			(search-forward "</a>" nil t))
       (mm-url-remove-markup)
@@ -360,25 +356,22 @@
       (setq Subject (buffer-string))
       (goto-char (point-max))
       (widen)
-      (forward-line 2)
-      (when (looking-at "<br><font[^>]+>")
-	(goto-char (match-end 0)))
-      (if (not (looking-at "<a[^>]+>"))
-	  (skip-chars-forward " \t")
-	(narrow-to-region (point)
-			  (search-forward "</a>" nil t))
-	(mm-url-remove-markup)
-	(mm-url-decode-entities)
-	(setq Newsgroups (buffer-string))
-	(goto-char (point-max))
-	(widen)
-	(skip-chars-forward "- \t"))
+      (narrow-to-region (point)
+			(search-forward "</td" nil t))
+
+      (mm-url-remove-markup)
+      (mm-url-decode-entities)
+      (search-backward " - ")
       (when (looking-at
-	     "\\([0-9]+\\)[/ ]\\([A-Za-z]+\\)[/ ]\\([0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a")
+	     " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?, [^\n]+by \\([^<\n]+\\)\n")
 	(setq From (match-string 4)
 	      Date (format "%s %s 00:00:00 %s"
-			   (match-string 2) (match-string 1)
-			   (match-string 3))))
+			   (match-string 1)
+			   (match-string 2)
+			   (or (match-string 3)
+			       (substring (current-time-string) -4)))))
+
+      (widen)
       (forward-line 1)
       (incf i)
       (unless (nnweb-get-hashtb url)
@@ -419,7 +412,7 @@
 	    (goto-char (point-min))
 	    (incf i 100)
 	    (if (or (not (re-search-forward
-			  "<td nowrap><a href=\\([^>]+\\).*<span class=b>Next</span>" nil t))
+			  "<td><a href=\"\n\\([^>\"]+\\)\"><img src=\"/img/nav_next" nil t))
 		    (>= i nnweb-max-hits))
 		(setq more nil)
 	      ;; Yup, there are more articles
@@ -443,7 +436,8 @@
        ("hl" . "en")
        ("lr" . "")
        ("safe" . "off")
-       ("sites" . "groups")))))
+       ("sites" . "groups")
+       ("filter" . "0")))))
   t)
 
 (defun nnweb-google-identity (url)

--- a/man/ChangeLog	Tue Jan 31 20:46:15 2006 +0000
+++ b/man/ChangeLog	Wed Feb 01 10:02:36 2006 +0000
@@ -1,3 +1,9 @@
[phone]  Romain Francoise  <[e-mail]>
+
+	* message.texi (Message Headers): Explain what
+	`message-alternative-emails' does in more detail.
+	Update copyright year.
+
 2006-01-31  Richard M. Stallman  <[e-mail]>
 
 	* display.texi (Scrolling, Horizontal Scrolling, Follow Mode):

--- a/man/message.texi	Tue Jan 31 20:46:15 2006 +0000
+++ b/man/message.texi	Wed Feb 01 10:02:36 2006 +0000
@@ -9,7 +9,7 @@
 This file documents Message, the Emacs message composition mode.
 
 Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-   2005 Free Software Foundation, Inc.
+   2005, 2006 Free Software Foundation, Inc.
 
 @quotation
 Permission is granted to copy, distribute and/or modify this document
@@ -1386,8 +1386,23 @@
 
 @item message-alternative-emails
 @vindex message-alternative-emails
-A regexp to match the alternative email addresses.  The first matched
-address (not primary one) is used in the @code{From} field.
+Regexp matching alternative email addresses.  The first address in the
+To, Cc or From headers of the original article matching this variable is
+used as the From field of outgoing messages, replacing the default From
+value.
+
+For example, if you have two secondary email addresses john@@home.net
+and john.doe@@work.com and want to use them in the From field when
+composing a reply to a message addressed to one of them, you could set
+this variable like this:
+
+@lisp
+(setq message-alternative-emails
+      (regexp-opt '("john@@home.net" "john.doe@@work.com")))
+@end lisp
+
+This variable has precedence over posting styles and anything that runs
+off @code{message-setup-hook}.
 
 @item message-allow-no-recipients
 @vindex message-allow-no-recipients