Revision: emacs@sv.gnu.org/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

7 files changed, 207 insertions, 106 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index cd98afa3da5..87a3f1918d6 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,8 +1,60 @@
+2006-01-31  Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
+
+        * 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.
+
+2006-01-31  Romain Francoise  <romain@orebokech.com>
+
+        * 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.
+
+2006-01-31  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * mm-uu.el (mm-uu-emacs-sources-extract): Say the part has been
+        decoded.
+        (mm-uu-diff-extract): Ditto.
+
+2006-01-31  Kevin Ryde  <user42@zip.com.au>
+
+        * 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.
+
+2006-01-30  Reiner Steib  <Reiner.Steib@gmx.de>
+
+        * nnweb.el (nnweb-google-parse-1): Clarify some comments.
+
+2006-01-30  Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
+
+        * nnweb.el (nnweb-type-definition, nnweb-google-parse-1)
+        (nnweb-google-create-mapping, nnweb-google-search): Adapt to
+        current Google Groups.
+
+2006-01-26  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * Makefile.in (clean): New rule.
+        (distclean): Use it.
+
 2006-01-25  Katsumi Yamaoka  <yamaoka@jpl.org>
 
         * 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  <user42@zip.com.au>
 
diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el
index 80153645819..f0d93f38655 100644
--- a/lisp/gnus/mailcap.el
+++ b/lisp/gnus/mailcap.el
@@ -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 <wmperry@aventail.com>
 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -640,30 +640,31 @@ to supply to the test."
          (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)))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 797d2233fe5..28325b73e26 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1388,8 +1388,13 @@ should be sent in several parts.  If it is nil, the size is unlimited."
                  (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 @@ are not included."
     (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 @@ are not included."
   (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 @@ regexp VARSTR."
       (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 @@ regexp VARSTR."
                 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"))))
 
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index fa36582af01..eb5afa794f5 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -266,7 +266,7 @@ Return that buffer."
 
 (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 @@ Return that buffer."
 
 (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 @@ value of `mm-uu-text-plain-type'."
         (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 @@ value of `mm-uu-text-plain-type'."
                  (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)
 
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index d3737cd66fd..4723a694182 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -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 <larsi@gnus.org>
 ;; 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 @@ Valid types include `google', `dejanews', and `gmane'.")
 (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 @@ Valid types include `google', `dejanews', and `gmane'.")
      (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 @@ Valid types include `google', `dejanews', and `gmane'.")
 
 (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 @@ Valid types include `google', `dejanews', and `gmane'.")
 (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 @@ Valid types include `google', `dejanews', and `gmane'.")
   (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 @@ Valid types include `google', `dejanews', and `gmane'.")
 (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 @@ Valid types include `google', `dejanews', and `gmane'.")
     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 @@ Valid types include `google', `dejanews', and `gmane'.")
       (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 @@ Valid types include `google', `dejanews', and `gmane'.")
       (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 @@ Valid types include `google', `dejanews', and `gmane'.")
             (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 @@ Valid types include `google', `dejanews', and `gmane'.")
        ("hl" . "en")
        ("lr" . "")
        ("safe" . "off")
-       ("sites" . "groups")))))
+       ("sites" . "groups")
+       ("filter" . "0")))))
   t)
 
 (defun nnweb-google-identity (url)
diff --git a/man/ChangeLog b/man/ChangeLog
index 8fc41f40f11..e7c90d400bc 100644
--- a/man/ChangeLog
+++ b/man/ChangeLog
@@ -1,3 +1,9 @@
+2006-01-31  Romain Francoise  <romain@orebokech.com>
+
+        * message.texi (Message Headers): Explain what
+        `message-alternative-emails' does in more detail.
+        Update copyright year.
+
 2006-01-31  Richard M. Stallman  <rms@gnu.org>
 
         * display.texi (Scrolling, Horizontal Scrolling, Follow Mode):
diff --git a/man/message.texi b/man/message.texi
index b2cd3aa782d..2cb2de02a8b 100644
--- a/man/message.texi
+++ b/man/message.texi
@@ -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 @@ trailing old subject.  In this case,
 
 @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