Mercurial > emacs

--- a/doc/misc/ChangeLog	Thu Dec 02 20:34:31 2010 +0100
+++ b/doc/misc/ChangeLog	Thu Dec 02 22:21:31 2010 +0000
@@ -1,3 +1,12 @@
+2010-12-02  Julien Danjou  <julien@danjou.info>
+
+	* gnus.texi (Archived Messages): Remove gnus-outgoing-message-group.
+
+2010-11-28  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* gnus.texi (Customizing the IMAP Connection): Note the new defaults.
+	(Direct Functions): Note the STARTTLS upgrade.
+
 2010-11-27  Glenn Morris  <rgm@gnu.org>
 	    James Clark  <none@example.com>
--- a/doc/misc/gnus.texi	Thu Dec 02 20:34:31 2010 +0100
+++ b/doc/misc/gnus.texi	Thu Dec 02 22:21:31 2010 +0000
@@ -13342,21 +13342,6 @@
 this will disable archiving.

 @table @code
-@item gnus-outgoing-message-group
-@vindex gnus-outgoing-message-group
-All outgoing messages will be put in this group.  If you want to store
-all your outgoing mail and articles in the group @samp{nnml:archive},
-you set this variable to that value.  This variable can also be a list of
-group names.
-
-If you want to have greater control over what group to put each
-message in, you can set this variable to a function that checks the
-current newsgroup name and then returns a suitable group name (or list
-of names).
-
-This variable can be used instead of @code{gnus-message-archive-group},
-but the latter is the preferred method.
-
 @item gnus-gcc-mark-as-read
 @vindex gnus-gcc-mark-as-read
 If non-@code{nil}, automatically mark @code{Gcc} articles as read.
@@ -14453,7 +14438,9 @@
 @findex nntp-open-network-stream
 @item nntp-open-network-stream
 This is the default, and simply connects to some port or other on the
-remote system.
+remote system.  If both Emacs and the server supports it, the
+connection will be upgraded to an encrypted @acronym{STARTTLS}
+connection automatically.

 @findex nntp-open-tls-stream
 @item nntp-open-tls-stream
@@ -14887,12 +14874,17 @@
 How @code{nnimap} should connect to the server.  Possible values are:

 @table @code
+@item undecided
+This is the default, and this first tries the @code{ssl} setting, and
+then tries the @code{network} setting.
+
 @item ssl
-This is the default, and this uses standard
-@acronym{TLS}/@acronym{SSL} connection.
+This uses standard @acronym{TLS}/@acronym{SSL} connections.

 @item network
-Non-encrypted and unsafe straight socket connection.
+Non-encrypted and unsafe straight socket connection, but will upgrade
+to encrypted @acronym{STARTTLS} if both Emacs and the server
+supports it.

 @item starttls
 Encrypted @acronym{STARTTLS} over the normal @acronym{IMAP} port.
--- a/lisp/gnus/ChangeLog	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/ChangeLog	Thu Dec 02 22:21:31 2010 +0000
@@ -1,3 +1,228 @@
+2010-12-02  Andrew Cohen  <cohen@andy.bu.edu>
+
+	* nnir.el (nnir-summary-line-format): New variable.
+	(nnir-mode): Use it.
+	(nnir-artlist-*,nnir-aritem-*): Reimplement as macros.
+	(nnir-article-ids): Reimplement as defsubst.
+	(nnir-retrieve-headers): Don't mangle the subject header.
+	(nnir-run-imap): Use 100 as RSV score.
+	(nnir-run-find-grep): Fix for full server searching.
+	(nnir-run-gmane): Better restriction to gmane groups.
+
+	* gnus-sum.el (gnus-summary-line-format-alist): Add specs for nnir
+	summary buffers.
+
+2010-12-02  Julien Danjou  <julien@danjou.info>
+
+	* gnus-win.el (gnus-configure-frame): Remove old compatibility code.
+
+	* gnus-msg.el: Mark gnus-outgoing-message-group as obsolete.
+
+	* gnus-win.el (gnus-configure-windows): Remove Gnus 3.x setting
+	support.
+
+2010-12-01  Andrew Cohen  <cohen@andy.bu.edu>
+
+	* nnir.el: Update to handle the registry better.
+	(autoload): Silence byte-compiler.
+	(nnir-open-server): Add a hook for nnir groups.
+	(nnir-request-move-article): Don't mangle the header. Better to use
+	formating variables (which will be added in the future).
+	(nnir-registry-action): Update the registry using the original article
+	group name.
+	(nnir-mode): Install nnir-specific hooks for updating the registry.
+
+	* gnus-sum.el
+	(gnus-article-original-subject,gnus-newsgroup-original-name): Remove
+	obsolete variables.
+	(gnus-summary-move-article): Remove use of obsolete variables.
+	(gnus-summary-local-variables): Make move and delete hooks local to
+	summary buffers.
+
+2010-12-01  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* rtree.el: New file.
+
+2010-12-01  Julien Danjou  <julien@danjou.info>
+
+	* message.el (message-user-organization): Do not use
+	gnus-local-organization.
+
+	* gnus.el: Remove gnus-local-organization.
+
+	* gnus-msg.el: Remove nastygram thing.
+
+2010-12-01  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* nnmaildir.el (nnmaildir-request-set-mark): Add article to add-mark
+	funcall.
+
+2010-12-01  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-gravatar.el (gnus-gravatar-insert): Allow LWSP in the middle of
+	names.
+
+	* shr.el (shr-find-fill-point): Don't break line between kinsoku-bol
+	characters.
+
+	* gnus-gravatar.el (gnus-gravatar-insert): Delete unnecessary binding
+	to t of inhibit-read-only since it is inside gnus-with-article-headers.
+	Suggested by Štěpán Němec <stepnem@gmail.com>.
+	(gnus-gravatar-transform-address): Use mail-extract-address-components
+	that supports non-ASCII names rather than mail-header-parse-addresses.
+
+2010-11-30  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* proto-stream.el (open-protocol-stream): All starttls connections are
+	handled by the network handler.
+
+2010-11-30  Julien Danjou  <julien@danjou.info>
+
+	* nnimap.el (nnimap-open-connection-1): Use gnus-string-match-p.
+	(nnimap-open-connection-1): Fix PREAUTH.
+
+	* gnus-gravatar.el (gnus-gravatar-size): Set gnus-gravatar-size to nil.
+
+2010-11-30  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* shr.el (shr-char-breakable-p, shr-char-nospace-p)
+	(shr-char-kinsoku-bol-p, shr-char-kinsoku-eol-p): New macros.
+	(shr-insert): Use them.
+	(shr-find-fill-point): Work better for kinsoku chars and apostrophes.
+
+2010-11-29  Andrew Cohen  <cohen@andy.bu.edu>
+
+	* nnir.el (nnir-request-move-article): Bail out if original group
+	doesn't support article moves.
+	(nnir-get-active): Improve active list retrieval.
+
+2010-11-29  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* shr.el (shr-find-fill-point): Don't break before apostrophes.
+
+2010-11-29  Binjo  <binjo.cn@gmail.com>  (tiny change)
+
+	* nnimap.el (nnimap-open-connection-1): w32 open-network-stream doesn't
+	seem to accept strings-with-numbers as port numbers,
+
+2010-11-29  Andrew Cohen  <cohen@andy.bu.edu>
+
+	* gnus-sum.el (gnus-summary-delete-article): If delete fails don't
+	change the registry.
+
+2010-11-29  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* nnir.el (nnir-run-gmane): Use mm-delete-duplicates instead of
+	delete-dups that is not available in XEmacs 21.4.
+
+	* mm-util.el (mm-delete-duplicates): Add comment.
+
+2010-11-28  Andrew Cohen  <cohen@andy.bu.edu>
+
+	* nnir.el (nnir-ignored-newsgroups): New variable.
+	(nnir-get-active): Use it.
+
+2010-11-28  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* proto-stream.el (proto-stream-open-network): Add some comments.
+
+	* nntp.el (nntp-open-connection): Provide a :success condition.
+
+	* nnimap.el (nnimap-open-connection-1): Ditto.
+
+	* proto-stream.el (proto-stream-open-network): See what the response to
+	the STARTTLS command is.
+
+	* nnimap.el (nnimap-open-connection-1): Always upgrade to STARTTLS (for
+	backwards compatibility).
+	(nnimap-open-connection-1): Really respect nnimap-server-port.
+
+	* proto-stream.el (proto-stream-open-network): When doing opportunistic
+	TLS upgrades we don't really care about the identity of the peer.
+	(proto-stream-open-network): Force starttls.el to use gnutls-cli, since
+	that what we've checked for.
+	(proto-stream-always-use-starttls): Only default to t if
+	open-gnutls-stream exists.
+	(proto-stream-open-network): If STARTTLS failed, then just open a
+	normal connection.
+	(proto-stream-open-network): Wait until the greeting before doing
+	STARTTLS.
+
+	* nntp.el (nntp-open-connection): Report what the connection error is.
+
+	* proto-stream.el (open-protocol-stream): Renamed from
+	open-proto-stream.
+
+2010-11-27  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* nnimap.el (nnimap-stream): Change default to `undecided'.
+	(nnimap-open-connection): If `nnimap-stream' is `undecided', try ssl
+	first, and then network.
+	(nnimap-open-connection-1): Respect nnimap-server-port.
+	(nnimap-open-connection): Be more backwards-compatible.
+
+	* proto-stream.el (proto-stream-always-use-starttls): New variable.
+	(proto-stream-open-starttls): De-duplicate the starttls code.
+	(proto-stream-open-starttls): Folded back into the main function.
+	(proto-stream-open-network): Fix typo in the gnutls path.
+	(proto-stream-command): Refactor out.
+
+	* nntp.el (nntp-open-connection): Fix the STARTTLS command syntax.
+
+	* proto-stream.el (proto-stream-open-starttls): Actually implement the
+	starttls.el STARTTLS.
+
+	* color.el (color-lab->srgb): Fix function call name.
+
+	* proto-stream.el (proto-stream-open-tls): Delete output from openssl
+	if we're using tls.el.
+	(proto-stream-open-network): If we don't have gnutls-cli or gnutls
+	built in, then don't try to establish a STARTTLS connection.
+
+	* nntp.el (nntp-open-connection): Switch on STARTTLS on supported
+	servers.
+
+	* proto-stream.el (open-proto-stream): Use network, not stream.
+	(open-proto-stream): Add a way to specify what the end of a command is.
+
+	* nntp.el (nntp-open-connection): Use proto-streams for the relevant
+	connections types.
+	(nntp-open-network-stream): Remove.
+	(nntp-open-ssl-stream): Remove.
+	(nntp-open-tls-stream): Remove.
+	(nntp-ssl-program): Remove.
+
+	* nnimap.el (nnimap-open-connection): Check for "OK" from the greeting.
+
+2010-11-27  Andrew Cohen  <cohen@andy.bu.edu>
+
+	* nnir.el: Fix typos.
+	(nnir-retrieve-headers-override-function): Rename variable to reflect
+	new semantics.
+	(nnir-article-group, nnir-article-number, nnir-article-rsv): New helper
+	macros.
+	(nnir-request-article, nnir-request-move-article): Use them.
+	(nnir-categorize): New function.
+	(nnir-run-query): Use it.
+	(nnir-retrieve-headers): Rewrite to batch header retrieval.
+	(nnir-run-gmane): nnir-retrieve-headers now returns the headers already
+	sorted.
+	(nnir-group-full-name): Use gnus-group-full-name instead.
+	(nnir-artlist-artitem-group, nnir-artlist-artitem-number)
+	(nnir-artlist-artitem-rsv, nnir-sort-groups-by-server): Obsolete.
+
+2010-11-27  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* nnimap.el (nnimap-open-connection): Fix typo in STARTTLS command.
+
+	* proto-stream.el: New library to provide protocol-specific
+	TLS/STARTTLS connections for IMAP, NNTP, SMTP, POP3 and similar
+	protocols.
+	(open-proto-stream): Complete the documentation.
+	(proto-stream-open-network): Fix some typos.
+
+	* nnimap.el (nnimap-open-connection): Use it.
+
 2010-11-27  Yuri Karaban  <tech@askold.net>  (tiny change)

 	* pop3.el (pop3-open-server): Read server greeting before starting TLS
--- a/lisp/gnus/color.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/color.el	Thu Dec 02 22:21:31 2010 +0000
@@ -36,7 +36,7 @@

 (defun color-rgb->hex  (red green blue)
   "Return hexadecimal notation for RED GREEN BLUE color.
-RED GREEN BLUE must be values between [0,1]."
+RED GREEN BLUE must be values between 0 and 1 inclusively."
   (format "#%02x%02x%02x"
           (* red 255) (* green 255) (* blue 255)))

@@ -53,7 +53,8 @@

 (defun color-rgb->hsv (red green blue)
   "Convert RED GREEN BLUE values to HSV representation.
-Hue is in radian. Saturation and values are between [0,1]."
+Hue is in radians. Saturation and values are between 0 and 1
+inclusively."
    (let* ((r (float red))
 	 (g (float green))
 	 (b (float blue))
@@ -80,7 +81,7 @@

 (defun color-rgb->hsl (red green blue)
   "Convert RED GREEN BLUE colors to their HSL representation.
-RED, GREEN and BLUE must be between [0,1]."
+RED, GREEN and BLUE must be between 0 and 1 inclusively."
   (let* ((r red)
          (g green)
          (b blue)
@@ -108,7 +109,7 @@

 (defun color-srgb->xyz (red green blue)
   "Converts RED GREEN BLUE colors from the sRGB color space to CIE XYZ.
-RED, BLUE and GREEN must be between [0,1]."
+RED, BLUE and GREEN must be between 0 and 1 inclusively."
   (let ((r (if (<= red 0.04045)
                (/ red 12.95)
              (expt (/ (+ red 0.055) 1.055) 2.4)))
@@ -191,12 +192,12 @@
   (apply 'color-xyz->lab (color-srgb->xyz red green blue)))

 (defun color-rgb->normalize (color)
-  "Normalize a RGB color to values between [0,1]."
+  "Normalize a RGB color to values between 0 and 1 inclusively."
   (mapcar (lambda (x) (/ x 65535.0)) (x-color-values color)))

 (defun color-lab->srgb (L a b)
   "Converts CIE L*a*b* to RGB."
-  (apply 'color-xyz->rgb (color-lab->xyz L a b)))
+  (apply 'color-xyz->srgb (color-lab->xyz L a b)))

 (defun color-cie-de2000 (color1 color2 &optional kL kC kH)
   "Computes the CIEDE2000 color distance between COLOR1 and COLOR2.
--- a/lisp/gnus/gnus-gravatar.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/gnus-gravatar.el	Thu Dec 02 22:21:31 2010 +0000
@@ -26,13 +26,15 @@

 (require 'gravatar)
 (require 'gnus-art)
+(require 'mail-extr) ;; Because of binding `mail-extr-disable-voodoo'.

 (defgroup gnus-gravatar nil
   "Gnus Gravatar."
   :group 'gnus-visual)

-(defcustom gnus-gravatar-size 32
-  "How big should gravatars be displayed."
+(defcustom gnus-gravatar-size nil
+  "How big should gravatars be displayed.
+If nil, default to `gravatar-size'."
   :type 'integer
   :version "24.1"
   :group 'gnus-gravatar)
@@ -51,30 +53,25 @@

 (defun gnus-gravatar-transform-address (header category &optional force)
   (gnus-with-article-headers
-    (let ((addresses
-           (mail-header-parse-addresses
-            ;; mail-header-parse-addresses does not work (reliably) on
-            ;; decoded headers.
-            (or
-             (ignore-errors
-               (mail-encode-encoded-word-string
-                (or (mail-fetch-field header) "")))
-             (mail-fetch-field header))))
-	  (gravatar-size gnus-gravatar-size)
-	  name)
+    (let* ((mail-extr-disable-voodoo t)
+	   (addresses (mail-extract-address-components
+		       (or (mail-fetch-field header) "") t))
+	   (gravatar-size gnus-gravatar-size)
+	   name)
       (dolist (address addresses)
-	(when (setq name (cdr address))
-	  (setcdr address (setq name (mail-decode-encoded-word-string name))))
+	(when (and (setq name (car address))
+		   (string-match "\\` +" name))
+	  (setcar address (setq name (substring name (match-end 0)))))
 	(when (or force
 		  (not (and gnus-gravatar-too-ugly
 			    (or (string-match gnus-gravatar-too-ugly
-					      (car address))
+					      (cadr address))
 				(and name
 				     (string-match gnus-gravatar-too-ugly
 						   name))))))
 	  (ignore-errors
 	    (gravatar-retrieve
-	     (car address)
+	     (cadr address)
 	     'gnus-gravatar-insert
 	     (list header address category))))))))

@@ -87,12 +84,15 @@
       (when (buffer-live-p (current-buffer))
         (gnus-article-goto-header header)
         (mail-header-narrow-to-field)
-        (let ((real-name (cdr address))
-              (mail-address (car address)))
+        (let ((real-name (car address))
+              (mail-address (cadr address)))
           (when (if real-name
-		    (re-search-forward (concat (regexp-quote real-name) "\\|"
-					       (regexp-quote mail-address))
-				       nil t)
+		    (re-search-forward
+		     (concat (gnus-replace-in-string
+			      (regexp-quote real-name) "[\t ]+" "[\t\n ]+")
+			     "\\|"
+			     (regexp-quote mail-address))
+		     nil t)
 		  (search-forward mail-address nil t))
 	    (goto-char (1- (match-beginning 0)))
             ;; If we're on the " quoting the name, go backward
@@ -103,8 +103,7 @@
             ;; example we were fetching someaddress, and then we change to
             ;; another mail with the same someaddress.
             (unless (memq 'gnus-gravatar (text-properties-at (point)))
-              (let ((inhibit-read-only t)
-                    (point (point)))
+              (let ((point (point)))
                 (unless (featurep 'xemacs)
                   (setq gravatar (append gravatar gnus-gravatar-properties)))
                 (gnus-put-image gravatar nil category)
--- a/lisp/gnus/gnus-msg.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/gnus-msg.el	Thu Dec 02 22:21:31 2010 +0000
@@ -55,7 +55,7 @@
 		 (sexp :tag "Methods" ,gnus-select-method)))

 (defcustom gnus-outgoing-message-group nil
-  "*All outgoing messages will be put in this group.
+  "All outgoing messages will be put in this group.
 If you want to store all your outgoing mail and articles in the group
 \"nnml:archive\", you set this variable to that value.  This variable
 can also be a list of group names.
@@ -70,6 +70,8 @@
 		 (string :tag "Group")
 		 (repeat :tag "List of groups" (string :tag "Group"))))

+(make-obsolete-variable 'gnus-outgoing-message-group 'gnus-message-archive-group "24.1")
+
 (defcustom gnus-mailing-list-groups nil
   "*If non-nil a regexp matching groups that are really mailing lists.
 This is useful when you're reading a mailing list that has been
@@ -397,7 +399,6 @@
 	   (message-mode-hook (copy-sequence message-mode-hook)))
        (setq mml-buffer-list nil)
        (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
-       (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
        ;; message-newsreader and message-mailer were formerly set in
        ;; gnus-inews-add-send-actions, but this is too late when
        ;; message-generate-headers-first is used. --ansel
@@ -826,7 +827,6 @@
 	       (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
        message-send-actions)
       ;; Add Gcc header.
-      (gnus-inews-insert-archive-gcc)
       (gnus-inews-insert-gcc))))


@@ -1294,7 +1294,6 @@
 	(goto-char (point-max))
 	(insert mail-header-separator)
 	;; Add Gcc header.
-	(gnus-inews-insert-archive-gcc)
 	(gnus-inews-insert-gcc)
 	(goto-char (point-min))
 	(when (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
@@ -1307,24 +1306,6 @@
   (interactive "P")
   (gnus-summary-mail-forward arg t))

-(defvar gnus-nastygram-message
-  "The following article was inappropriately posted to %s.\n\n"
-  "Format string to insert in nastygrams.
-The current group name will be inserted at \"%s\".")
-
-(defun gnus-summary-mail-nastygram (n)
-  "Send a nastygram to the author of the current article."
-  (interactive "P")
-  (when (or gnus-expert-user
-	    (gnus-y-or-n-p
-	     "Really send a nastygram to the author of the current article? "))
-    (let ((group gnus-newsgroup-name))
-      (gnus-summary-reply-with-original n)
-      (set-buffer gnus-message-buffer)
-      (message-goto-body)
-      (insert (format gnus-nastygram-message group))
-      (message-send-and-exit))))
-
 (defun gnus-summary-mail-crosspost-complaint (n)
   "Send a complaint about crossposting to the current article(s)."
   (interactive "P")
@@ -1580,7 +1561,6 @@
     (gnus-setup-message 'compose-bounce
       (message-bounce)
       ;; Add Gcc header.
-      (gnus-inews-insert-archive-gcc)
       (gnus-inews-insert-gcc)
       ;; If there are references, we fetch the article we answered to.
       (when parent
@@ -1694,44 +1674,13 @@
 		(gnus-group-mark-article-read group (cdr group-art)))
 	      (kill-buffer (current-buffer)))))))))

-(defun gnus-inews-insert-gcc ()
-  "Insert Gcc headers based on `gnus-outgoing-message-group'."
-  (save-excursion
-    (save-restriction
-      (message-narrow-to-headers)
-      (let* ((group gnus-outgoing-message-group)
-	     (gcc (cond
-		   ((functionp group)
-		    (funcall group))
-		   ((or (stringp group) (listp group))
-		    group))))
-	(when gcc
-	  (insert "Gcc: "
-		  (if (stringp gcc)
-		      (if (string-match " " gcc)
-			  (concat "\"" gcc "\"")
-			gcc)
-		    (mapconcat (lambda (group)
-				 (if (string-match " " group)
-				     (concat "\"" group "\"")
-				   group))
-			       gcc " "))
-		  "\n"))))))
-
-(defun gnus-inews-insert-archive-gcc (&optional group)
+(defun gnus-inews-insert-gcc (&optional group)
   "Insert the Gcc to say where the article is to be archived."
-  (setq group (cond (group
-		     (gnus-group-decoded-name group))
-		    (gnus-newsgroup-name
-		     (gnus-group-decoded-name gnus-newsgroup-name))
-		    (t
-		     "")))
-  (let* ((var gnus-message-archive-group)
+  (let* ((group (or group gnus-newsgroup-name))
+         (group (when group (gnus-group-decoded-name group)))
+         (var (or gnus-outgoing-message-group gnus-message-archive-group))
 	 (gcc-self-val
-	  (and gnus-newsgroup-name
-	       (not (equal gnus-newsgroup-name ""))
-	       (gnus-group-find-parameter
-		gnus-newsgroup-name 'gcc-self)))
+	  (and group (gnus-group-find-parameter group 'gcc-self)))
 	 result
 	 (groups
 	  (cond
--- a/lisp/gnus/gnus-sum.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/gnus-sum.el	Thu Dec 02 22:21:31 2010 +0000
@@ -1310,7 +1310,6 @@
 (defvar gnus-article-decoded-p nil)
 (defvar gnus-article-charset nil)
 (defvar gnus-article-ignored-charsets nil)
-(defvar gnus-article-original-subject nil)
 (defvar gnus-scores-exclude-files nil)
 (defvar gnus-page-broken nil)

@@ -1336,7 +1335,6 @@
 (defvar gnus-current-copy-group nil)
 (defvar gnus-current-crosspost-group nil)
 (defvar gnus-newsgroup-display nil)
-(defvar gnus-newsgroup-original-name nil)

 (defvar gnus-newsgroup-dependencies nil)
 (defvar gnus-newsgroup-adaptive nil)
@@ -1363,6 +1361,16 @@
     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
     (?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
     (?L gnus-tmp-lines ?s)
+    (?Z (or ,(macroexpand-all
+	      '(nnir-article-rsv (mail-header-number gnus-tmp-header)))
+	    0) ?d)
+    (?G (or ,(macroexpand-all
+	      '(nnir-article-group (mail-header-number gnus-tmp-header)))
+	    "") ?s)
+    (?g (or ,(macroexpand-all
+	      '(gnus-group-short-name
+		(nnir-article-group (mail-header-number gnus-tmp-header))))
+	    "") ?s)
     (?O gnus-tmp-downloaded ?c)
     (?I gnus-tmp-indentation ?s)
     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
@@ -1583,6 +1591,8 @@
     gnus-newsgroup-prepared gnus-summary-highlight-line-function
     gnus-current-article gnus-current-headers gnus-have-all-headers
     gnus-last-article gnus-article-internal-prepare-hook
+    (gnus-summary-article-delete-hook . global)
+    (gnus-summary-article-move-hook . global)
     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
     gnus-newsgroup-scored gnus-newsgroup-kill-headers
     gnus-thread-expunge-below
@@ -9731,210 +9741,203 @@
       ;; Set any marks that may have changed in the summary buffer.
       (when gnus-preserve-marks
 	(gnus-summary-push-marks-to-backend article))
-      (let ((gnus-newsgroup-original-name gnus-newsgroup-name)
-	    (gnus-article-original-subject
-	     (mail-header-subject
-	      (gnus-data-header (assoc article (gnus-data-list nil))))))
-	(setq
-	 art-group
-	 (cond
-	  ;; Move the article.
-	  ((eq action 'move)
-	   ;; Remove this article from future suppression.
-	   (gnus-dup-unsuppress-article article)
-	   (let* ((from-method (gnus-find-method-for-group
-				gnus-newsgroup-name))
-		  (to-method (or select-method
-				 (gnus-find-method-for-group to-newsgroup)))
-		  (move-is-internal (gnus-server-equal from-method to-method)))
-	     (gnus-request-move-article
-	      article			; Article to move
-	      gnus-newsgroup-name	; From newsgroup
-	      (nth 1 (gnus-find-method-for-group
-		      gnus-newsgroup-name)) ; Server
-	      (list 'gnus-request-accept-article
-		    to-newsgroup (list 'quote select-method)
-		    (not articles) t)	; Accept form
-	      (not articles)		; Only save nov last time
-	      (and move-is-internal
-		   to-newsgroup		; Not respooling
+      (setq
+       art-group
+       (cond
+	;; Move the article.
+	((eq action 'move)
+	 ;; Remove this article from future suppression.
+	 (gnus-dup-unsuppress-article article)
+	 (let* ((from-method (gnus-find-method-for-group
+			      gnus-newsgroup-name))
+		(to-method (or select-method
+			       (gnus-find-method-for-group to-newsgroup)))
+		(move-is-internal (gnus-server-equal from-method to-method)))
+	   (gnus-request-move-article
+	    article			; Article to move
+	    gnus-newsgroup-name         ; From newsgroup
+	    (nth 1 (gnus-find-method-for-group
+		    gnus-newsgroup-name)) ; Server
+	    (list 'gnus-request-accept-article
+		  to-newsgroup (list 'quote select-method)
+		  (not articles) t)	; Accept form
+	    (not articles)		; Only save nov last time
+	    (and move-is-internal
+		 to-newsgroup		; Not respooling
 					; Is this move internal?
-		   (gnus-group-real-name to-newsgroup)))))
-	  ;; Copy the article.
-	  ((eq action 'copy)
+		 (gnus-group-real-name to-newsgroup)))))
+	;; Copy the article.
+	((eq action 'copy)
+	 (with-current-buffer copy-buf
+	   (when (gnus-request-article-this-buffer article
+						   gnus-newsgroup-name)
+	     (save-restriction
+	       (nnheader-narrow-to-headers)
+	       (dolist (hdr gnus-copy-article-ignored-headers)
+		 (message-remove-header hdr t)))
+	     (gnus-request-accept-article
+	      to-newsgroup select-method (not articles) t))))
+	;; Crosspost the article.
+	((eq action 'crosspost)
+	 (let ((xref (message-tokenize-header
+		      (mail-header-xref (gnus-summary-article-header
+					 article))
+		      " ")))
+	   (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
+				  ":" (number-to-string article)))
+	   (unless xref
+	     (setq xref (list (system-name))))
+	   (setq new-xref
+		 (concat
+		  (mapconcat 'identity
+			     (delete "Xref:" (delete new-xref xref))
+			     " ")
+		  " " new-xref))
 	   (with-current-buffer copy-buf
-	     (when (gnus-request-article-this-buffer article
-						     gnus-newsgroup-name)
-	       (save-restriction
-		 (nnheader-narrow-to-headers)
-		 (dolist (hdr gnus-copy-article-ignored-headers)
-		   (message-remove-header hdr t)))
-	       (gnus-request-accept-article
-		to-newsgroup select-method (not articles) t))))
-	  ;; Crosspost the article.
-	  ((eq action 'crosspost)
-	   (let ((xref (message-tokenize-header
-			(mail-header-xref (gnus-summary-article-header
-					   article))
-			" ")))
-	     (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
-				    ":" (number-to-string article)))
-	     (unless xref
-	       (setq xref (list (system-name))))
-	     (setq new-xref
-		   (concat
-		    (mapconcat 'identity
-			       (delete "Xref:" (delete new-xref xref))
-			       " ")
-		    " " new-xref))
-	     (with-current-buffer copy-buf
-	       ;; First put the article in the destination group.
-	       (gnus-request-article-this-buffer article gnus-newsgroup-name)
-	       (when (consp (setq art-group
-				  (gnus-request-accept-article
-				   to-newsgroup select-method (not articles)
-				   t)))
-		 (setq new-xref (concat new-xref " " (car art-group)
-					":"
-					(number-to-string (cdr art-group))))
-		 ;; Now we have the new Xrefs header, so we insert
-		 ;; it and replace the new article.
-		 (nnheader-replace-header "Xref" new-xref)
-		 (gnus-request-replace-article
-		  (cdr art-group) to-newsgroup (current-buffer) t)
-		 art-group))))))
-	(cond
-	 ((not art-group)
-	  (gnus-message 1 "Couldn't %s article %s: %s"
-			(cadr (assq action names)) article
-			(nnheader-get-report (car to-method))))
-	 ((eq art-group 'junk)
-	  (when (eq action 'move)
-	    (gnus-summary-mark-article article gnus-canceled-mark)
-	    (gnus-message 4 "Deleted article %s" article)
-	    ;; run the delete hook
-	    (run-hook-with-args 'gnus-summary-article-delete-hook
-				action
-				(gnus-data-header
-				 (assoc article (gnus-data-list nil)))
-				gnus-newsgroup-original-name nil
-				select-method)))
-	 (t
-	  (let* ((pto-group (gnus-group-prefixed-name
-			     (car art-group) to-method))
-		 (info (gnus-get-info pto-group))
-		 (to-group (gnus-info-group info))
-		 to-marks)
-	    ;; Update the group that has been moved to.
-	    (when (and info
-		       (memq action '(move copy)))
-	      (unless (member to-group to-groups)
-		(push to-group to-groups))
-
-	      (unless (memq article gnus-newsgroup-unreads)
-		(push 'read to-marks)
-		(gnus-info-set-read
-		 info (gnus-add-to-range (gnus-info-read info)
-					 (list (cdr art-group)))))
-
-	      ;; See whether the article is to be put in the cache.
-	      (let* ((expirable (gnus-group-auto-expirable-p to-group))
-		     (marks (if expirable
-				gnus-article-mark-lists
-			      (delete '(expirable . expire)
-				      (copy-sequence
-				       gnus-article-mark-lists))))
-		     (to-article (cdr art-group)))
-
-		;; Enter the article into the cache in the new group,
-		;; if that is required.
-		(when gnus-use-cache
-		  (gnus-cache-possibly-enter-article
-		   to-group to-article
-		   (memq article gnus-newsgroup-marked)
-		   (memq article gnus-newsgroup-dormant)
-		   (memq article gnus-newsgroup-unreads)))
-
-		(when gnus-preserve-marks
-		  ;; Copy any marks over to the new group.
-		  (when (and (equal to-group gnus-newsgroup-name)
-			     (not (memq article gnus-newsgroup-unreads)))
-		    ;; Mark this article as read in this group.
-		    (push (cons to-article gnus-read-mark)
-			  gnus-newsgroup-reads)
-		    ;; Increase the active status of this group.
-		    (setcdr (gnus-active to-group) to-article)
-		    (setcdr gnus-newsgroup-active to-article))
-
-		  (while marks
-		    (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
-		      (when (memq article (symbol-value
-					   (intern (format "gnus-newsgroup-%s"
-							   (caar marks)))))
-			(push (cdar marks) to-marks)
-			;; If the other group is the same as this group,
-			;; then we have to add the mark to the list.
-			(when (equal to-group gnus-newsgroup-name)
-			  (set (intern (format "gnus-newsgroup-%s"
-					       (caar marks)))
-			       (cons to-article
-				     (symbol-value
-				      (intern (format "gnus-newsgroup-%s"
-						      (caar marks)))))))
-			;; Copy the marks to other group.
-			(gnus-add-marked-articles
-			 to-group (cdar marks) (list to-article) info)))
-		    (setq marks (cdr marks)))
-
-		  (when (and expirable
-			     gnus-mark-copied-or-moved-articles-as-expirable
-			     (not (memq 'expire to-marks)))
-		    ;; Mark this article as expirable.
-		    (push 'expire to-marks)
-		    (when (equal to-group gnus-newsgroup-name)
-		      (push to-article gnus-newsgroup-expirable))
-		    ;; Copy the expirable mark to other group.
-		    (gnus-add-marked-articles
-		     to-group 'expire (list to-article) info))
-
-		  (when to-marks
-		    (gnus-request-set-mark
-		     to-group (list (list (list to-article) 'add to-marks)))))
-
-		(gnus-dribble-enter
-		 (concat "(gnus-group-set-info '"
-			 (gnus-prin1-to-string (gnus-get-info to-group))
-			 ")"))))
-
-	    ;; Update the Xref header in this article to point to
-	    ;; the new crossposted article we have just created.
-	    (when (eq action 'crosspost)
-	      (with-current-buffer copy-buf
-		(gnus-request-article-this-buffer article gnus-newsgroup-name)
-		(nnheader-replace-header "Xref" new-xref)
-		(gnus-request-replace-article
-		 article gnus-newsgroup-name (current-buffer) t)))
-
-	    ;; run the move/copy/crosspost/respool hook
-	    (let ((header (gnus-data-header
-			   (assoc article (gnus-data-list nil)))))
-	      (mail-header-set-subject header gnus-article-original-subject)
-	      (run-hook-with-args 'gnus-summary-article-move-hook
-				  action
-				  (gnus-data-header
-				   (assoc article (gnus-data-list nil)))
-				  gnus-newsgroup-original-name
-				  to-newsgroup
-				  select-method)))
-
-	  ;;;!!!Why is this necessary?
-	  (set-buffer gnus-summary-buffer)
-
-	  (when (eq action 'move)
-	    (save-excursion
-	      (gnus-summary-goto-subject article)
-	      (gnus-summary-mark-article article gnus-canceled-mark)))))
-	(push article articles-to-update-marks)))
+	     ;; First put the article in the destination group.
+	     (gnus-request-article-this-buffer article gnus-newsgroup-name)
+	     (when (consp (setq art-group
+				(gnus-request-accept-article
+				 to-newsgroup select-method (not articles)
+				 t)))
+	       (setq new-xref (concat new-xref " " (car art-group)
+				      ":"
+				      (number-to-string (cdr art-group))))
+	       ;; Now we have the new Xrefs header, so we insert
+	       ;; it and replace the new article.
+	       (nnheader-replace-header "Xref" new-xref)
+	       (gnus-request-replace-article
+		(cdr art-group) to-newsgroup (current-buffer) t)
+	       art-group))))))
+      (cond
+       ((not art-group)
+	(gnus-message 1 "Couldn't %s article %s: %s"
+		      (cadr (assq action names)) article
+		      (nnheader-get-report (car to-method))))
+       ((eq art-group 'junk)
+	(when (eq action 'move)
+	  (gnus-summary-mark-article article gnus-canceled-mark)
+	  (gnus-message 4 "Deleted article %s" article)
+	  ;; run the delete hook
+	  (run-hook-with-args 'gnus-summary-article-delete-hook
+			      action
+			      (gnus-data-header
+			       (assoc article (gnus-data-list nil)))
+			      gnus-newsgroup-name nil
+			      select-method)))
+       (t
+	(let* ((pto-group (gnus-group-prefixed-name
+			   (car art-group) to-method))
+	       (info (gnus-get-info pto-group))
+	       (to-group (gnus-info-group info))
+	       to-marks)
+	  ;; Update the group that has been moved to.
+	  (when (and info
+		     (memq action '(move copy)))
+	    (unless (member to-group to-groups)
+	      (push to-group to-groups))
+
+	    (unless (memq article gnus-newsgroup-unreads)
+	      (push 'read to-marks)
+	      (gnus-info-set-read
+	       info (gnus-add-to-range (gnus-info-read info)
+				       (list (cdr art-group)))))
+
+	    ;; See whether the article is to be put in the cache.
+	    (let* ((expirable (gnus-group-auto-expirable-p to-group))
+		   (marks (if expirable
+			      gnus-article-mark-lists
+			    (delete '(expirable . expire)
+				    (copy-sequence
+				     gnus-article-mark-lists))))
+		   (to-article (cdr art-group)))
+
+	      ;; Enter the article into the cache in the new group,
+	      ;; if that is required.
+	      (when gnus-use-cache
+		(gnus-cache-possibly-enter-article
+		 to-group to-article
+		 (memq article gnus-newsgroup-marked)
+		 (memq article gnus-newsgroup-dormant)
+		 (memq article gnus-newsgroup-unreads)))
+
+	      (when gnus-preserve-marks
+		;; Copy any marks over to the new group.
+		(when (and (equal to-group gnus-newsgroup-name)
+			   (not (memq article gnus-newsgroup-unreads)))
+		  ;; Mark this article as read in this group.
+		  (push (cons to-article gnus-read-mark)
+			gnus-newsgroup-reads)
+		  ;; Increase the active status of this group.
+		  (setcdr (gnus-active to-group) to-article)
+		  (setcdr gnus-newsgroup-active to-article))
+
+		(while marks
+		  (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
+		    (when (memq article (symbol-value
+					 (intern (format "gnus-newsgroup-%s"
+							 (caar marks)))))
+		      (push (cdar marks) to-marks)
+		      ;; If the other group is the same as this group,
+		      ;; then we have to add the mark to the list.
+		      (when (equal to-group gnus-newsgroup-name)
+			(set (intern (format "gnus-newsgroup-%s"
+					     (caar marks)))
+			     (cons to-article
+				   (symbol-value
+				    (intern (format "gnus-newsgroup-%s"
+						    (caar marks)))))))
+		      ;; Copy the marks to other group.
+		      (gnus-add-marked-articles
+		       to-group (cdar marks) (list to-article) info)))
+		  (setq marks (cdr marks)))
+
+		(when (and expirable
+			   gnus-mark-copied-or-moved-articles-as-expirable
+			   (not (memq 'expire to-marks)))
+		  ;; Mark this article as expirable.
+		  (push 'expire to-marks)
+		  (when (equal to-group gnus-newsgroup-name)
+		    (push to-article gnus-newsgroup-expirable))
+		  ;; Copy the expirable mark to other group.
+		  (gnus-add-marked-articles
+		   to-group 'expire (list to-article) info))
+
+		(when to-marks
+		  (gnus-request-set-mark
+		   to-group (list (list (list to-article) 'add to-marks)))))
+
+	      (gnus-dribble-enter
+	       (concat "(gnus-group-set-info '"
+		       (gnus-prin1-to-string (gnus-get-info to-group))
+		       ")"))))
+
+	  ;; Update the Xref header in this article to point to
+	  ;; the new crossposted article we have just created.
+	  (when (eq action 'crosspost)
+	    (with-current-buffer copy-buf
+	      (gnus-request-article-this-buffer article gnus-newsgroup-name)
+	      (nnheader-replace-header "Xref" new-xref)
+	      (gnus-request-replace-article
+	       article gnus-newsgroup-name (current-buffer) t)))
+
+	  ;; run the move/copy/crosspost/respool hook
+	  (run-hook-with-args 'gnus-summary-article-move-hook
+			      action
+			      (gnus-data-header
+			       (assoc article (gnus-data-list nil)))
+			      gnus-newsgroup-name
+			      to-newsgroup
+			      select-method))
+
+        ;;;!!!Why is this necessary?
+	(set-buffer gnus-summary-buffer)
+
+	(when (eq action 'move)
+	  (save-excursion
+	    (gnus-summary-goto-subject article)
+	    (gnus-summary-mark-article article gnus-canceled-mark)))))
+      (push article articles-to-update-marks))

     (save-excursion
       (apply 'gnus-summary-remove-process-mark articles-to-update-marks))
@@ -10213,13 +10216,13 @@
 	  ;; The backend might not have been able to delete the article
 	  ;; after all.
 	  (unless (memq (car articles) not-deleted)
-	    (gnus-summary-mark-article (car articles) gnus-canceled-mark))
-	  (let* ((article (car articles))
-		 (ghead  (gnus-data-header
-			  (assoc article (gnus-data-list nil)))))
-	    (run-hook-with-args 'gnus-summary-article-delete-hook
-				'delete ghead gnus-newsgroup-name nil
-				nil))
+	    (gnus-summary-mark-article (car articles) gnus-canceled-mark)
+	    (let* ((article (car articles))
+		   (ghead  (gnus-data-header
+			    (assoc article (gnus-data-list nil)))))
+	      (run-hook-with-args 'gnus-summary-article-delete-hook
+				  'delete ghead gnus-newsgroup-name nil
+				  nil)))
 	  (setq articles (cdr articles))))
       (when not-deleted
 	(gnus-message 4 "Couldn't delete articles %s" not-deleted)))
--- a/lisp/gnus/gnus-win.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/gnus-win.el	Thu Dec 02 22:21:31 2010 +0000
@@ -228,50 +228,6 @@
     (pop list))
   (cadr (assq (car list) gnus-window-configuration)))

-(defun gnus-windows-old-to-new (setting)
-  ;; First we take care of the really, really old Gnus 3 actions.
-  (when (symbolp setting)
-    (setq setting
-	  ;; Take care of ooold GNUS 3.x values.
-	  (cond ((eq setting 'SelectArticle) 'article)
-		((memq setting '(SelectNewsgroup SelectSubject ExpandSubject))
-		 'summary)
-		((memq setting '(ExitNewsgroup)) 'group)
-		(t setting))))
-  (if (or (listp setting)
-	  (not (and gnus-window-configuration
-		    (memq setting '(group summary article)))))
-      setting
-    (let* ((elem
-	    (cond
-	     ((eq setting 'group)
-	      (gnus-window-configuration-element
-	       '(group newsgroups ExitNewsgroup)))
-	     ((eq setting 'summary)
-	      (gnus-window-configuration-element
-	       '(summary SelectNewsgroup SelectSubject ExpandSubject)))
-	     ((eq setting 'article)
-	      (gnus-window-configuration-element
-	       '(article SelectArticle)))))
-	   (total (apply '+ elem))
-	   (types '(group summary article))
-	   (pbuf (if (eq setting 'newsgroups) 'group 'summary))
-	   (i 0)
-	   perc out)
-      (while (< i 3)
-	(or (not (numberp (nth i elem)))
-	    (zerop (nth i elem))
-	    (progn
-	      (setq perc (if (= i 2)
-			     1.0
-			   (/ (float (nth i elem)) total)))
-	      (push (if (eq pbuf (nth i types))
-			(list (nth i types) perc 'point)
-		      (list (nth i types) perc))
-		    out)))
-	(incf i))
-      `(vertical 1.0 ,@(nreverse out)))))
-
 ;;;###autoload
 (defun gnus-add-configuration (conf)
   "Add the window configuration CONF to `gnus-buffer-configuration'."
@@ -293,18 +249,9 @@

 (defun gnus-configure-frame (split &optional window)
   "Split WINDOW according to SPLIT."
-  (let ((current-window
-	 (or (get-buffer-window (current-buffer)) (selected-window))))
-    (unless window
-      (setq window current-window))
+  (let* ((current-window (or (get-buffer-window (current-buffer)) (selected-window)))
+         (window (or window current-window)))
     (select-window window)
-    ;; This might be an old-style buffer config.
-    (when (vectorp split)
-      (setq split (append split nil)))
-    (when (or (consp (car split))
-	      (vectorp (car split)))
-      (push 1.0 split)
-      (push 'vertical split))
     ;; The SPLIT might be something that is to be evaled to
     ;; return a new SPLIT.
     (while (and (not (assq (car split) gnus-window-to-buffer))
@@ -423,56 +370,55 @@
       (set-window-configuration setting)
     (setq gnus-current-window-configuration setting)
     (setq force (or force gnus-always-force-window-configuration))
-    (setq setting (gnus-windows-old-to-new setting))
     (let ((split (if (symbolp setting)
-		     (cadr (assq setting gnus-buffer-configuration))
-		   setting))
-	  all-visible)
+                     (cadr (assq setting gnus-buffer-configuration))
+                   setting))
+          all-visible)

       (setq gnus-frame-split-p nil)

       (unless split
-	(error "No such setting in `gnus-buffer-configuration': %s" setting))
+        (error "No such setting in `gnus-buffer-configuration': %s" setting))

       (if (and (setq all-visible (gnus-all-windows-visible-p split))
-	       (not force))
-	  ;; All the windows mentioned are already visible, so we just
-	  ;; put point in the assigned buffer, and do not touch the
-	  ;; winconf.
-	  (select-window all-visible)
+               (not force))
+          ;; All the windows mentioned are already visible, so we just
+          ;; put point in the assigned buffer, and do not touch the
+          ;; winconf.
+          (select-window all-visible)

-	;; Make sure "the other" buffer, nntp-server-buffer, is live.
-	(unless (gnus-buffer-live-p nntp-server-buffer)
-	  (nnheader-init-server-buffer))
+        ;; Make sure "the other" buffer, nntp-server-buffer, is live.
+        (unless (gnus-buffer-live-p nntp-server-buffer)
+          (nnheader-init-server-buffer))

-	;; Either remove all windows or just remove all Gnus windows.
-	(let ((frame (selected-frame)))
-	  (unwind-protect
-	      (if gnus-use-full-window
-		  ;; We want to remove all other windows.
-		  (if (not gnus-frame-split-p)
-		      ;; This is not a `frame' split, so we ignore the
-		      ;; other frames.
-		      (delete-other-windows)
-		  ;; This is a `frame' split, so we delete all windows
-		    ;; on all frames.
-		    (gnus-delete-windows-in-gnusey-frames))
-		;; Just remove some windows.
-		(gnus-remove-some-windows)
-		(if (featurep 'xemacs)
-		    (switch-to-buffer nntp-server-buffer)
-		  (set-buffer nntp-server-buffer)))
-	    (select-frame frame)))
+        ;; Either remove all windows or just remove all Gnus windows.
+        (let ((frame (selected-frame)))
+          (unwind-protect
+              (if gnus-use-full-window
+                  ;; We want to remove all other windows.
+                  (if (not gnus-frame-split-p)
+                      ;; This is not a `frame' split, so we ignore the
+                      ;; other frames.
+                      (delete-other-windows)
+                    ;; This is a `frame' split, so we delete all windows
+                    ;; on all frames.
+                    (gnus-delete-windows-in-gnusey-frames))
+                ;; Just remove some windows.
+                (gnus-remove-some-windows)
+                (if (featurep 'xemacs)
+                    (switch-to-buffer nntp-server-buffer)
+                  (set-buffer nntp-server-buffer)))
+            (select-frame frame)))

-	(let (gnus-window-frame-focus)
-	  (if (featurep 'xemacs)
-	      (switch-to-buffer nntp-server-buffer)
-	    (set-buffer nntp-server-buffer))
-	  (gnus-configure-frame split)
-	  (run-hooks 'gnus-configure-windows-hook)
-	  (when gnus-window-frame-focus
-	    (gnus-select-frame-set-input-focus
-	     (window-frame gnus-window-frame-focus))))))))
+        (let (gnus-window-frame-focus)
+          (if (featurep 'xemacs)
+              (switch-to-buffer nntp-server-buffer)
+            (set-buffer nntp-server-buffer))
+          (gnus-configure-frame split)
+          (run-hooks 'gnus-configure-windows-hook)
+          (when gnus-window-frame-focus
+            (gnus-select-frame-set-input-focus
+             (window-frame gnus-window-frame-focus))))))))

 (defun gnus-delete-windows-in-gnusey-frames ()
   "Do a `delete-other-windows' in all frames that have Gnus windows."
--- a/lisp/gnus/gnus.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/gnus.el	Thu Dec 02 22:21:31 2010 +0000
@@ -1401,10 +1401,6 @@
 		 string))
 (make-obsolete-variable 'gnus-local-domain nil "Emacs 24.1")

-(defvar gnus-local-organization nil
-  "String with a description of what organization (if any) the user belongs to.
-Obsolete variable; use `message-user-organization' instead.")
-
 ;; Customization variables

 (defcustom gnus-refer-article-method 'current
--- a/lisp/gnus/message.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/message.el	Thu Dec 02 22:21:31 2010 +0000
@@ -160,8 +160,12 @@
   :group 'message-interface
   :type 'regexp)

-(defcustom message-from-style mail-from-style
-  "*Specifies how \"From\" headers look.
+(defcustom message-from-style 'default
+  ;; In Emacs 24.1 this defaults to the value of `mail-from-style'
+  ;; that defaults to:
+  ;; `angles' in Emacs 22.1~23.1, XEmacs 21.4, 21.5, and SXEmacs 22.1;
+  ;; `system-default' in Emacs 23.2, and 24.1
+  "Specifies how \"From\" headers look.

 If nil, they contain just the return address like:
 	king@grassland.com
@@ -507,14 +511,9 @@
   :group 'message-buffers
   :type 'boolean)

-(defvar gnus-local-organization)
 (defcustom message-user-organization
-  (or (and (boundp 'gnus-local-organization)
-	   (stringp gnus-local-organization)
-	   gnus-local-organization)
-      (getenv "ORGANIZATION")
-      t)
-  "*String to be used as an Organization header.
+  (or (getenv "ORGANIZATION") t)
+  "String to be used as an Organization header.
 If t, use `message-user-organization-file'."
   :group 'message-headers
   :type '(choice string
--- a/lisp/gnus/mm-util.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/mm-util.el	Thu Dec 02 22:21:31 2010 +0000
@@ -974,6 +974,7 @@
     ;; This is for XEmacs.
     (mm-mule-charset-to-mime-charset charset)))

+;; `delete-dups' is not available in XEmacs 21.4.
 (if (fboundp 'delete-dups)
     (defalias 'mm-delete-duplicates 'delete-dups)
   (defun mm-delete-duplicates (list)
--- a/lisp/gnus/nnimap.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/nnimap.el	Thu Dec 02 22:21:31 2010 +0000
@@ -45,6 +45,7 @@
 (require 'tls)
 (require 'parse-time)
 (require 'nnmail)
+(require 'proto-stream)

 (eval-when-compile
   (require 'gnus-sum))
@@ -62,9 +63,10 @@
 If nnimap-stream is `ssl', this will default to `imaps'.  If not,
 it will default to `imap'.")

-(defvoo nnimap-stream 'ssl
+(defvoo nnimap-stream 'undecided
   "How nnimap will talk to the IMAP server.
-Values are `ssl', `network', `starttls' or `shell'.")
+Values are `ssl', `network', `starttls' or `shell'.
+The default is to try `ssl' first, and then `network'.")

 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
 				 (if (listp imap-shell-program)
@@ -271,16 +273,6 @@
     (push (current-buffer) nnimap-process-buffers)
     (current-buffer)))

-(defun nnimap-open-shell-stream (name buffer host port)
-  (let ((process-connection-type nil))
-    (start-process name buffer shell-file-name
-		   shell-command-switch
-		   (format-spec
-		    nnimap-shell-program
-		    (format-spec-make
-		     ?s host
-		     ?p port)))))
-
 (defun nnimap-credentials (address ports &optional inhibit-create)
   (let (port credentials)
     ;; Request the credentials from all ports, but only query on the
@@ -310,111 +302,79 @@
 			(* 5 60)))
 	    (nnimap-send-command "NOOP")))))))

-(declare-function gnutls-negotiate "gnutls"
-		  (proc type &optional priority-string trustfiles keyfiles))
+(defun nnimap-open-connection (buffer)
+  ;; Be backwards-compatible -- the earlier value of nnimap-stream was
+  ;; `ssl' when nnimap-server-port was nil.  Sort of.
+  (when (and nnimap-server-port
+	     (eq nnimap-stream 'undecided))
+    (setq nnimap-stream 'ssl))
+  (let ((stream
+	 (if (eq nnimap-stream 'undecided)
+	     (loop for type in '(ssl network)
+		   for stream = (let ((nnimap-stream type))
+				  (nnimap-open-connection-1 buffer))
+		   while (eq stream 'no-connect)
+		   finally (return stream))
+	   (nnimap-open-connection-1 buffer))))
+    (if (eq stream 'no-connect)
+	nil
+      stream)))

-(defun nnimap-open-connection (buffer)
+(defun nnimap-open-connection-1 (buffer)
   (unless nnimap-keepalive-timer
     (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
 					      'nnimap-keepalive)))
-  (block nil
-    (with-current-buffer (nnimap-make-process-buffer buffer)
-      (let* ((coding-system-for-read 'binary)
-	     (coding-system-for-write 'binary)
-	     (port nil)
-	     (ports
-	      (cond
-	       ((or (eq nnimap-stream 'network)
-		    (and (eq nnimap-stream 'starttls)
-			 (fboundp 'open-gnutls-stream)))
-		(nnheader-message 7 "Opening connection to %s..."
-				  nnimap-address)
-		(open-network-stream
-		 "*nnimap*" (current-buffer) nnimap-address
-		 (setq port
-		       (or nnimap-server-port
-			   (if (netrc-find-service-number "imap")
-			       "imap"
-			     "143"))))
-		'("143" "imap"))
-	       ((eq nnimap-stream 'shell)
-		(nnheader-message 7 "Opening connection to %s via shell..."
-				  nnimap-address)
-		(nnimap-open-shell-stream
-		 "*nnimap*" (current-buffer) nnimap-address
-		 (setq port (or nnimap-server-port "imap")))
-		'("imap"))
-	       ((eq nnimap-stream 'starttls)
-		(nnheader-message 7 "Opening connection to %s via starttls..."
-			 nnimap-address)
-		(let ((tls-program
-		       '("openssl s_client -connect %h:%p -no_ssl2 -ign_eof -starttls imap")))
-		  (open-tls-stream
-		   "*nnimap*" (current-buffer) nnimap-address
-		   (setq port (or nnimap-server-port "imap"))))
-		'("imap"))
-	       ((memq nnimap-stream '(ssl tls))
-		(nnheader-message 7 "Opening connection to %s via tls..."
-				  nnimap-address)
-		(funcall (if (fboundp 'open-gnutls-stream)
-			     'open-gnutls-stream
-			   'open-tls-stream)
-			 "*nnimap*" (current-buffer) nnimap-address
-			 (setq port
-			       (or nnimap-server-port
-				   (if (netrc-find-service-number "imaps")
-				       "imaps"
-				     "993"))))
-		'("143" "993" "imap" "imaps"))
-	       (t
-		(error "Unknown stream type: %s" nnimap-stream))))
-	     connection-result login-result credentials)
-	(setf (nnimap-process nnimap-object)
-	      (get-buffer-process (current-buffer)))
-	(if (not (and (nnimap-process nnimap-object)
-		      (memq (process-status (nnimap-process nnimap-object))
-			    '(open run))))
-	    (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
-			     nnimap-address port nnimap-stream)
-	  (gnus-set-process-query-on-exit-flag
-	   (nnimap-process nnimap-object) nil)
-	  (if (not (setq connection-result (nnimap-wait-for-connection)))
-	      (nnheader-report 'nnimap
-			       "%s" (buffer-substring
-				     (point) (line-end-position)))
+  (with-current-buffer (nnimap-make-process-buffer buffer)
+    (let* ((coding-system-for-read 'binary)
+	   (coding-system-for-write 'binary)
+	   (port nil)
+	   (ports
+	    (cond
+	     ((or (eq nnimap-stream 'network)
+		  (eq nnimap-stream 'starttls))
+	      (nnheader-message 7 "Opening connection to %s..."
+				nnimap-address)
+	      '("143" "imap"))
+	     ((eq nnimap-stream 'shell)
+	      (nnheader-message 7 "Opening connection to %s via shell..."
+				nnimap-address)
+	      '("imap"))
+	     ((memq nnimap-stream '(ssl tls))
+	      (nnheader-message 7 "Opening connection to %s via tls..."
+				nnimap-address)
+	      '("143" "993" "imap" "imaps"))
+	     (t
+	      (error "Unknown stream type: %s" nnimap-stream))))
+	   (proto-stream-always-use-starttls t)
+           login-result credentials)
+      (when nnimap-server-port
+	(setq ports (append ports (list nnimap-server-port))))
+      (destructuring-bind (stream greeting capabilities)
+	  (open-protocol-stream
+	   "*nnimap*" (current-buffer) nnimap-address (car (last ports))
+	   :type nnimap-stream
+	   :shell-command nnimap-shell-program
+	   :capability-command "1 CAPABILITY\r\n"
+	   :success " OK "
+	   :starttls-function
+	   (lambda (capabilities)
+	     (when (gnus-string-match-p "STARTTLS" capabilities)
+	       "1 STARTTLS\r\n")))
+	(setf (nnimap-process nnimap-object) stream)
+	(if (not stream)
+	    (progn
+	      (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
+			       nnimap-address port nnimap-stream)
+	      'no-connect)
+	  (gnus-set-process-query-on-exit-flag stream nil)
+	  (if (not (gnus-string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting))
+	      (nnheader-report 'nnimap "%s" greeting)
 	    ;; Store the greeting (for debugging purposes).
-	    (setf (nnimap-greeting nnimap-object)
-		  (buffer-substring (line-beginning-position)
-				    (line-end-position)))
-	    (nnimap-get-capabilities)
-	    (when nnimap-server-port
-	      (push (format "%s" nnimap-server-port) ports))
-	    ;; If this is a STARTTLS-capable server, then sever the
-	    ;; connection and start a STARTTLS connection instead.
-	    (cond
-	     ((and (or (and (eq nnimap-stream 'network)
-			    (nnimap-capability "STARTTLS"))
-		       (eq nnimap-stream 'starttls))
-		   (fboundp 'open-gnutls-stream))
-	      (nnimap-command "STARTTLS")
-	      (gnutls-negotiate (nnimap-process nnimap-object) nil)
-	      ;; Get the capabilities again -- they may have changed
-	      ;; after doing STARTTLS.
-	      (nnimap-get-capabilities))
-	     ((and (eq nnimap-stream 'network)
-		   (nnimap-capability "STARTTLS"))
-	      (let ((nnimap-stream 'starttls))
-		(let ((tls-process
-		       (nnimap-open-connection buffer)))
-		  ;; If the STARTTLS connection was successful, we
-		  ;; kill our first non-encrypted connection.  If it
-		  ;; wasn't successful, we just use our unencrypted
-		  ;; connection.
-		  (when (memq (process-status tls-process) '(open run))
-		    (delete-process (nnimap-process nnimap-object))
-		    (kill-buffer (current-buffer))
-		    (return tls-process))))))
-	    (unless (equal connection-result "PREAUTH")
+	    (setf (nnimap-greeting nnimap-object) greeting)
+	    (setf (nnimap-capabilities nnimap-object)
+		  (mapcar #'upcase
+			  (split-string capabilities)))
+	    (unless (gnus-string-match-p "[*.] PREAUTH" greeting)
 	      (if (not (setq credentials
 			     (if (eq nnimap-authenticator 'anonymous)
 				 (list "anonymous"
@@ -456,13 +416,6 @@
 		(nnimap-command "ENABLE QRESYNC"))
 	      (nnimap-process nnimap-object))))))))

-(defun nnimap-get-capabilities ()
-  (setf (nnimap-capabilities nnimap-object)
-	(mapcar
-	 #'upcase
-	 (nnimap-find-parameter
-	  "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
-
 (defun nnimap-quote-specials (string)
   (with-temp-buffer
     (insert string)
@@ -1110,7 +1063,7 @@
 		   uidvalidity
 		   modseq)
 	      (push
-	       (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
+	       (list (nnimap-send-command "EXAMINE %S (QRESYNC  (%s %s))"
 					  (utf7-encode group t)
 					  uidvalidity modseq)
 		     'qresync
--- a/lisp/gnus/nnir.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/nnir.el	Thu Dec 02 22:21:31 2010 +0000
@@ -42,7 +42,7 @@

 ;; When looking at the retrieval result (in the Summary buffer) you
 ;; can type `A W' (aka M-x gnus-warp-to-article RET) on an article.  You
-;; will be warped into the group this article came from. Typing `A W'
+;; will be warped into the group this article came from. Typing `A T'
 ;; (aka M-x gnus-summary-refer-thread RET) will warp to the group and
 ;; also show the thread this article is part of.

@@ -181,7 +181,8 @@
 (eval-when-compile
   (autoload 'nnimap-buffer "nnimap")
   (autoload 'nnimap-command "nnimap")
-  (autoload 'nnimap-possibly-change-group "nnimap"))
+  (autoload 'nnimap-possibly-change-group "nnimap")
+  (autoload 'gnus-registry-action "gnus-registry"))

 (nnoo-declare nnir)
 (nnoo-define-basics nnir)
@@ -198,14 +199,34 @@
 (defcustom nnir-method-default-engines
   '((nnimap . imap)
     (nntp . gmane))
-  "*Alist of default search engines keyed by server method"
+  "*Alist of default search engines keyed by server method."
   :type '(alist)
   :group 'nnir)

+(defcustom nnir-ignored-newsgroups ""
+  "*A regexp to match newsgroups in the active file that should
+  be skipped when searching."
+  :type '(regexp)
+  :group 'nnir)
+
+(defcustom nnir-summary-line-format nil
+  "*The format specification of the lines in an nnir summary buffer.
+
+All the items from `gnus-summary-line-format' are available, along
+with three items unique to nnir summary buffers:
+
+%Z    Search retrieval score value (integer)
+%G    Article original full group name (string)
+%g    Article original short group name (string)
+
+If nil this will use `gnus-summary-line-format'."
+  :type '(regexp)
+  :group 'nnir)
+
 (defcustom nnir-imap-default-search-key "Whole message"
   "*The default IMAP search key for an nnir search. Must be one of
   the keys in `nnir-imap-search-arguments'. To use raw imap queries
-  by default set this to \"Imap\""
+  by default set this to \"Imap\"."
   :type '(string)
   :group 'nnir)

@@ -423,9 +444,11 @@

 Add an entry here when adding a new search engine.")

-(defvar nnir-get-article-nov-override-function nil
-  "If non-nil, a function that will be passed each search result.  This
-should return a message's headers in NOV format.
+(defvar nnir-retrieve-headers-override-function nil
+  "If non-nil, a function that accepts an article list and group
+and populates the `nntp-server-buffer' with the retrieved
+headers. Must return either 'nov or 'headers indicating the
+retrieved header format.

 If this variable is nil, or if the provided function returns nil for a search
 result, `gnus-retrieve-headers' will be called instead.")
@@ -455,6 +478,68 @@

 ;;; Code:

+;;; Helper macros
+
+;; Data type article list.
+
+(defmacro nnir-artlist-length (artlist)
+  "Returns number of articles in artlist."
+  `(length ,artlist))
+
+(defmacro nnir-artlist-article (artlist n)
+  "Returns from ARTLIST the Nth artitem (counting starting at 1)."
+  `(when (> ,n 0)
+     (elt ,artlist (1- ,n))))
+
+(defmacro nnir-artitem-group (artitem)
+  "Returns the group from the ARTITEM."
+  `(elt ,artitem 0))
+
+(defmacro nnir-artitem-number (artitem)
+  "Returns the number from the ARTITEM."
+  `(elt ,artitem 1))
+
+(defmacro nnir-artitem-rsv (artitem)
+  "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
+  `(elt ,artitem 2))
+
+(defmacro nnir-article-group (article)
+  "Returns the group for ARTICLE"
+  `(nnir-artitem-group (nnir-artlist-article nnir-artlist ,article)))
+
+(defmacro nnir-article-number (article)
+  "Returns the number for ARTICLE"
+  `(nnir-artitem-number (nnir-artlist-article nnir-artlist ,article)))
+
+(defmacro nnir-article-rsv (article)
+  "Returns the rsv for ARTICLE"
+  `(nnir-artitem-rsv (nnir-artlist-article nnir-artlist ,article)))
+
+(defsubst nnir-article-ids (article)
+  "Returns the pair `(nnir id . real id)' of ARTICLE"
+  (cons article (nnir-article-number article)))
+
+(defmacro nnir-categorize (sequence keyfunc &optional valuefunc)
+  "Sorts a sequence into categories and returns a list of the form
+`((key1 (element11 element12)) (key2 (element21 element22))'.
+The category key for a member of the sequence is obtained
+as `(keyfunc member)' and the corresponding element is just
+`member'. If `valuefunc' is non-nil, the element of the list
+is `(valuefunc member)'."
+  `(unless (null ,sequence)
+     (let (value)
+       (mapcar
+	(lambda (member)
+	  (let ((y (,keyfunc member))
+		(x ,(if valuefunc
+			`(,valuefunc member)
+		      'member)))
+	    (if (assoc y value)
+		(push x (cadr (assoc y value)))
+	      (push (list y (list x)) value))))
+	,sequence)
+       value)))
+
 ;; Gnus glue.

 (defun gnus-group-make-nnir-group (nnir-extra-parms)
@@ -479,6 +564,7 @@

 (deffoo nnir-open-server (server &optional definitions)
   ;; Just set the server variables appropriately.
+  (add-hook 'gnus-summary-mode-hook 'nnir-mode)
   (nnoo-change-server 'nnir server definitions))

 (deffoo nnir-request-group (group &optional server fast info)
@@ -506,77 +592,76 @@
 		       group))))      ; group name

 (deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
-  (save-excursion
-    (let ((artlist (copy-sequence articles))
-          art artitem artgroup artno artrsv artfullgroup
-          novitem novdata foo server)
-      (while (not (null artlist))
-        (setq art (car artlist))
-        (or (numberp art)
-            (nnheader-report
-             'nnir
-             "nnir-retrieve-headers doesn't grok message ids: %s"
-             art))
-        (setq artitem (nnir-artlist-article nnir-artlist art))
-        (setq artrsv (nnir-artitem-rsv artitem))
-        (setq artfullgroup (nnir-artitem-group artitem))
-        (setq artno (nnir-artitem-number artitem))
-        (setq artgroup (gnus-group-real-name artfullgroup))
-	(setq server (gnus-group-server artfullgroup))
-        ;; retrieve NOV or HEAD data for this article, transform into
-        ;; NOV data and prepend to `novdata'
-        (set-buffer nntp-server-buffer)
-	(nnir-possibly-change-server server)
-        (let ((gnus-override-method
-	       (gnus-server-to-method server)))
-	  ;; if nnir-get-article-nov-override-function is set, use it
-	  (if nnir-get-article-nov-override-function
-	      (setq novitem (funcall nnir-get-article-nov-override-function
-				     artitem))
-	    ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
-	    (case (setq foo (gnus-retrieve-headers (list artno)
-						   artfullgroup nil))
-	      (nov
-	       (goto-char (point-min))
-	       (setq novitem (nnheader-parse-nov)))
-	      (headers
-	       (goto-char (point-min))
-	       (setq novitem (nnheader-parse-head)))
-	      (t (error "Unknown header type %s while requesting article %s of group %s"
-			foo artno artfullgroup)))))
-	;; replace article number in original group with article number
-        ;; in nnir group
-	(when novitem
-	  (mail-header-set-number novitem art)
-	  (mail-header-set-subject
-	   novitem
-	   (format "[%d: %s/%d] %s"
-		   artrsv artgroup artno
-		   (mail-header-subject novitem)))
-	  (push novitem novdata)
-	  (setq artlist (cdr artlist))))
-      (setq novdata (nreverse novdata))
-      (set-buffer nntp-server-buffer) (erase-buffer)
-      (mapc 'nnheader-insert-nov novdata)
+  (with-current-buffer nntp-server-buffer
+    (let ((gnus-inhibit-demon t)
+	  (articles-by-group (nnir-categorize
+			      articles nnir-article-group nnir-article-ids))
+	  headers)
+      (while (not (null articles-by-group))
+	(let* ((group-articles (pop articles-by-group))
+	       (artgroup (car group-articles))
+	       (articleids (cadr group-articles))
+	       (artlist (sort (mapcar 'cdr articleids) '<))
+	       (server (gnus-group-server artgroup))
+	       (gnus-override-method (gnus-server-to-method server))
+	       parsefunc)
+	  ;; (or (numberp art)
+	  ;;     (nnheader-report
+	  ;;      'nnir
+	  ;;      "nnir-retrieve-headers doesn't grok message ids: %s"
+	  ;;      art))
+	  (nnir-possibly-change-server server)
+	  ;; is this needed?
+	  (erase-buffer)
+	  (case (setq gnus-headers-retrieved-by
+		      (or
+		       (and
+			nnir-retrieve-headers-override-function
+			(funcall nnir-retrieve-headers-override-function
+				 artlist artgroup))
+		       (gnus-retrieve-headers artlist artgroup nil)))
+	    (nov
+	     (setq parsefunc 'nnheader-parse-nov))
+	    (headers
+	     (setq parsefunc 'nnheader-parse-head))
+	    (t (error "Unknown header type %s while requesting articles \
+                    of group %s" gnus-headers-retrieved-by artgroup)))
+	  (goto-char (point-min))
+	  (while (not (eobp))
+	    (let* ((novitem (funcall parsefunc))
+		   (artno (mail-header-number novitem))
+		   (art (car (rassoc artno articleids))))
+	      (when art
+		(mail-header-set-number novitem art)
+		;; (mail-header-set-subject
+		;;  novitem
+		;;  (format "[%d: %s/%d] %s"
+		;; 	 (nnir-article-rsv art) artgroup artno
+		;; 	 (mail-header-subject novitem)))
+		(push novitem headers))
+	      (forward-line 1)))))
+      (setq headers
+	    (sort headers
+		  (lambda (x y)
+		    (< (mail-header-number x) (mail-header-number y)))))
+      (erase-buffer)
+      (mapc 'nnheader-insert-nov headers)
       'nov)))

-(deffoo nnir-request-article (article
-                              &optional group server to-buffer)
+(deffoo nnir-request-article (article &optional group server to-buffer)
   (if (stringp article)
       (nnheader-report
        'nnir
        "nnir-retrieve-headers doesn't grok message ids: %s"
        article)
     (save-excursion
-      (let* ((artitem (nnir-artlist-article nnir-artlist
-					    article))
-	     (artfullgroup (nnir-artitem-group artitem))
-	     (artno (nnir-artitem-number artitem))
-	     ;; Bug?
-	     ;; Why must we bind nntp-server-buffer here?  It won't
-	     ;; work if `buf' is used, say.  (Of course, the set-buffer
-	     ;; line below must then be updated, too.)
-	     (nntp-server-buffer (or to-buffer nntp-server-buffer)))
+      (let ((artfullgroup (nnir-article-group article))
+	    (artno (nnir-article-number article))
+	    ;; Bug?
+	    ;; Why must we bind nntp-server-buffer here?  It won't
+	    ;; work if `buf' is used, say.  (Of course, the set-buffer
+	    ;; line below must then be updated, too.)
+	    (nntp-server-buffer (or to-buffer nntp-server-buffer)))
 	(set-buffer nntp-server-buffer)
 	(erase-buffer)
 	(message "Requesting article %d from group %s"
@@ -586,10 +671,8 @@

 (deffoo nnir-request-move-article (article group server accept-form
 					   &optional last internal-move-group)
-  (let* ((artitem (nnir-artlist-article nnir-artlist
-					article))
-	 (artfullgroup (nnir-artitem-group artitem))
-	 (artno (nnir-artitem-number artitem))
+  (let* ((artfullgroup (nnir-article-group article))
+	 (artno (nnir-article-number article))
 	 (to-newsgroup (nth 1 accept-form))
 	 (to-method (gnus-find-method-for-group to-newsgroup))
 	 (from-method (gnus-find-method-for-group artfullgroup))
@@ -597,9 +680,9 @@
 	 (artsubject (mail-header-subject
 		      (gnus-data-header
 		       (assoc article (gnus-data-list nil))))))
-    (setq gnus-newsgroup-original-name artfullgroup)
-    (string-match "^\\[[0-9]+:.+/[0-9]+\\] " artsubject)
-    (setq gnus-article-original-subject (substring artsubject (match-end 0)))
+    (unless (gnus-check-backend-function
+	     'request-move-article artfullgroup)
+      (error "The group %s does not support article moving" artfullgroup))
     (gnus-request-move-article
      artno
      artfullgroup
@@ -614,8 +697,8 @@
   (let* ((cur (if (> (gnus-summary-article-number) 0)
 		  (gnus-summary-article-number)
 		(error "This is not a real article.")))
-         (gnus-newsgroup-name (nnir-artlist-artitem-group nnir-artlist cur))
-         (backend-number (nnir-artlist-artitem-number nnir-artlist cur)))
+	 (gnus-newsgroup-name (nnir-article-group cur))
+         (backend-number (nnir-article-number cur)))
     (gnus-summary-read-group-1 gnus-newsgroup-name t t gnus-summary-buffer
 			       nil (list backend-number))))

@@ -654,7 +737,7 @@
                  (gnus-replace-in-string dirnam "^[./\\]" "" t)
                  "[/\\]" "." t)))

-    (vector (nnir-group-full-name group server)
+    (vector (gnus-group-full-name group server)
 	    (if (string= (gnus-group-server server) "nnmaildir")
 		(nnmaildir-base-name-to-article-number
 		 (substring article 0 (string-match ":" article))
@@ -696,7 +779,7 @@
 						    (nnir-imap-make-query
 						     criteria qstring)))))
 		      (mapc
-		       (lambda (artnum) (push (vector group artnum 1) artlist)
+		       (lambda (artnum) (push (vector group artnum 100) artlist)
 			 (setq arts (1+ arts)))
 		       (and (car result)
 			    (delete 0 (mapcar #'string-to-number
@@ -1056,7 +1139,7 @@
             ;; Windows "\\" -> "."
             (setq group (gnus-replace-in-string group "\\\\" "."))

-            (push (vector (nnir-group-full-name group server)
+            (push (vector (gnus-group-full-name group server)
                           (string-to-number artno)
                           (string-to-number score))
                   artlist))))
@@ -1125,7 +1208,7 @@
 	      score (match-string 3))
 	(when (string-match prefix dirnam)
 	  (setq dirnam (replace-match "" t t dirnam)))
-	(push (vector (nnir-group-full-name
+	(push (vector (gnus-group-full-name
                        (gnus-replace-in-string dirnam "/" ".") server)
 		      (string-to-number artno)
 		      (string-to-number score))
@@ -1218,6 +1301,7 @@
 	 (directory (cadr (assoc sym (cddr method))))
 	 (regexp (cdr (assoc 'query query)))
 	 (grep-options (cdr (assoc 'grep-options query)))
+	 (grouplist (or grouplist (nnir-get-active server)))
 	 artlist)
     (unless directory
       (error "No directory found in method specification of server %s"
@@ -1283,7 +1367,7 @@
 						 (nreverse res))
 					       ".")))
 			 (push
-			  (vector (nnir-group-full-name group server) art 0)
+			  (vector (gnus-group-full-name group server) art 0)
 			  artlist))
 		       (forward-line 1)))
 		   (message "Searching %s using find-grep...done"
@@ -1297,15 +1381,14 @@
 ;; gmane interface
 (defun nnir-run-gmane (query srv &optional groups)
   "Run a search against a gmane back-end server."
-  (if (gnus-string-match-p "gmane" srv)
+  (if (gnus-string-match-p "gmane.org$" srv)
       (let* ((case-fold-search t)
 	     (qstring (cdr (assq 'query query)))
 	     (server (cadr (gnus-server-to-method srv)))
 	     (groupspec (if groups
 			    (mapconcat
-			     (function (lambda (x)
-					 (format "group:%s"
-						 (gnus-group-short-name x))))
+			     (lambda (x)
+			       (format "group:%s" (gnus-group-short-name x)))
 			     groups " ") ""))
 	     (authorspec
 	      (if (assq 'author query)
@@ -1341,12 +1424,7 @@
 		      (string-to-number (match-string 2 xref)) xscore)
 		     artlist)))))
 	    (forward-line 1)))
-	;; Sort by score
-	(apply 'vector
-	       (sort artlist
-		     (function (lambda (x y)
-				 (> (nnir-artitem-rsv x)
-				    (nnir-artitem-rsv y)))))))
+	(apply 'vector (nreverse (mm-delete-duplicates artlist))))
     (message "Can't search non-gmane nntp groups")
     nil))

@@ -1380,33 +1458,34 @@
         (groups (if (string= "all-ephemeral" nserver)
 		    (with-current-buffer gnus-server-buffer
 		      (list (list (gnus-server-server-name))))
-		  (nnir-sort-groups-by-server
+		  (nnir-categorize
 		   (or gnus-group-marked
 		       (if (gnus-group-group-name)
 			   (list (gnus-group-group-name))
 			 (cdr (assoc (gnus-group-topic-name)
-				     gnus-topic-alist))))))))
+				     gnus-topic-alist))))
+		   gnus-group-server))))
     (apply 'vconcat
-           (mapcar (lambda (x)
-                     (let* ((server (car x))
-                            (nnir-search-engine
-                             (or (nnir-read-server-parm 'nnir-search-engine
-                                                        server)
-                                 (cdr (assoc (car
-                                              (gnus-server-to-method server))
-                                             nnir-method-default-engines))))
-                            search-func)
-                       (setq search-func (cadr
-                                          (assoc nnir-search-engine
-						 nnir-engines)))
-                       (if search-func
-			   (funcall search-func
-				    (if nnir-extra-parms
-					(nnir-read-parms q nnir-search-engine)
-				      q)
-				    server (cdr x))
-                         nil)))
-                   groups))))
+           (mapcar
+	    (lambda (x)
+	      (let* ((server (car x))
+		     (nnir-search-engine
+		      (or (nnir-read-server-parm 'nnir-search-engine
+						 server)
+			  (cdr (assoc (car
+				       (gnus-server-to-method server))
+				      nnir-method-default-engines))))
+		     search-func)
+		(setq search-func (cadr (assoc nnir-search-engine
+					       nnir-engines)))
+		(if search-func
+		    (funcall search-func
+			     (if nnir-extra-parms
+				 (nnir-read-parms q nnir-search-engine)
+			       q)
+			     server (cadr x))
+		  nil)))
+	    groups))))

 (defun nnir-read-server-parm (key server)
   "Returns the parameter value of key for the given server, where
@@ -1416,50 +1495,11 @@
     	   (nth 1 (assq key (cddr method))))
     	  (t nil))))

-(defun nnir-group-full-name (shortname server)
-  "For the given group name, return a full Gnus group name.
-The Gnus backend/server information is added."
-  (gnus-group-prefixed-name shortname (gnus-server-to-method server)))
-
 (defun nnir-possibly-change-server (server)
   (unless (and server (nnir-server-opened server))
     (nnir-open-server server)))


-;; Data type article list.
-
-(defun nnir-artlist-length (artlist)
-  "Returns number of articles in artlist."
-  (length artlist))
-
-(defun nnir-artlist-article (artlist n)
-  "Returns from ARTLIST the Nth artitem (counting starting at 1)."
-  (elt artlist (1- n)))
-
-(defun nnir-artitem-group (artitem)
-  "Returns the group from the ARTITEM."
-  (elt artitem 0))
-
-(defun nnir-artlist-artitem-group (artlist n)
-  "Returns from ARTLIST the group of the Nth artitem (counting from 1)."
-  (nnir-artitem-group (nnir-artlist-article artlist n)))
-
-(defun nnir-artitem-number (artitem)
-  "Returns the number from the ARTITEM."
-  (elt artitem 1))
-
-(defun nnir-artlist-artitem-number (artlist n)
-  "Returns from ARTLIST the number of the Nth artitem (counting from 1)."
-  (nnir-artitem-number (nnir-artlist-article artlist n)))
-
-(defun nnir-artitem-rsv (artitem)
-  "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
-  (elt artitem 2))
-
-(defun nnir-artlist-artitem-rsv (artlist n)
-  "Returns from ARTLIST the Retrieval Status Value of the Nth
-artitem (counting from 1)."
-  (nnir-artitem-rsv (nnir-artlist-article artlist n)))

 ;; unused?
 (defun nnir-artlist-groups (artlist)
@@ -1473,18 +1513,6 @@
             with-dups)
     res))

-(defun nnir-sort-groups-by-server (groups)
-  "sorts a list of groups into an alist keyed by server"
-(if (car groups)
-  (let (value)
-    (dolist (var groups value)
-      (let ((server (gnus-group-server var)))
-	(if (assoc server value)
-	    (nconc (cdr (assoc server value)) (list var))
-	  (push (cons server (list var)) value))))
-    value)
-  nil))
-
 (defun nnir-get-active (srv)
   (let ((method (gnus-server-to-method srv))
 	groups)
@@ -1493,19 +1521,59 @@
       (let ((cur (current-buffer))
 	    name)
 	(goto-char (point-min))
-	(unless (string= gnus-ignored-newsgroups "")
-	  (delete-matching-lines gnus-ignored-newsgroups))
-	(while (not (eobp))
-	  (ignore-errors
-	    (push (mm-string-as-unibyte
-		   (let ((p (point)))
-		     (skip-chars-forward "^ \t\\\\")
-		     (setq name (buffer-substring (+ p 1) (- (point) 1)))
-		     (gnus-group-full-name name method)))
-		  groups))
-	  (forward-line))))
+	(unless (string= nnir-ignored-newsgroups "")
+	  (delete-matching-lines nnir-ignored-newsgroups))
+	(if (eq (car method) 'nntp)
+	    (while (not (eobp))
+	      (ignore-errors
+		(push (mm-string-as-unibyte
+		       (gnus-group-full-name
+			(buffer-substring
+			 (point)
+			 (progn
+			   (skip-chars-forward "^ \t")
+			   (point))) method))
+		      groups))
+	      (forward-line))
+	  (while (not (eobp))
+	    (ignore-errors
+	      (push (mm-string-as-unibyte
+		     (if (eq (char-after) ?\")
+			 (gnus-group-full-name (read cur) method)
+		       (let ((p (point)) (name ""))
+			 (skip-chars-forward "^ \t\\\\")
+			 (setq name (buffer-substring p (point)))
+			 (while (eq (char-after) ?\\)
+			   (setq p (1+ (point)))
+			   (forward-char 2)
+			   (skip-chars-forward "^ \t\\\\")
+			   (setq name (concat name (buffer-substring
+						    p (point)))))
+			 (gnus-group-full-name name method))))
+		    groups))
+	    (forward-line)))))
     groups))

+(defun nnir-registry-action (action data-header from &optional to method)
+  "Call `gnus-registry-action' with the original article group."
+  (gnus-registry-action
+   action
+   data-header
+   (nnir-article-group (mail-header-number data-header))
+   to
+   method))
+
+(defun nnir-mode ()
+  (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnir)
+    (setq gnus-summary-line-format
+	  (or nnir-summary-line-format gnus-summary-line-format))
+    (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t)
+    (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t)
+    (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t)
+    (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t)))
+
+
+
 ;; The end.
 (provide 'nnir)
--- a/lisp/gnus/nnmaildir.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/nnmaildir.el	Thu Dec 02 22:21:31 2010 +0000
@@ -1559,7 +1559,7 @@
 		  (t (signal (car err) (cdr err))))))
 	     todo-marks))
 	  set-action (lambda (article)
-		       (funcall add-action)
+		       (funcall add-action article)
 		       (mapcar (lambda (mark)
 				 (unless (memq mark todo-marks)
 				   (funcall del-mark mark)))
--- a/lisp/gnus/nntp.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/nntp.el	Thu Dec 02 22:21:31 2010 +0000
@@ -34,6 +34,7 @@
 (require 'nnoo)
 (require 'gnus-util)
 (require 'gnus)
+(require 'proto-stream)
 (require 'gnus-group) ;; gnus-group-name-charset

 (nnoo-declare nntp)
@@ -305,13 +306,6 @@
 (defvar nntp-async-timer nil)
 (defvar nntp-async-process-list nil)

-(defvar nntp-ssl-program
-  "openssl s_client -quiet -ssl3 -connect %s:%p"
-"A string containing commands for SSL connections.
-Within a string, %s is replaced with the server address and %p with
-port number on server.  The program should accept IMAP commands on
-stdin and return responses to stdout.")
-
 (defvar nntp-authinfo-rejected nil
 "A custom error condition used to report 'Authentication Rejected' errors.
 Condition handlers that match just this condition ensure that the nntp
@@ -1268,11 +1262,28 @@
 		`(lambda ()
 		   (nntp-kill-buffer ,pbuffer)))))
 	 (process
-	  (condition-case ()
+	  (condition-case err
 	      (let ((coding-system-for-read nntp-coding-system-for-read)
-		    (coding-system-for-write nntp-coding-system-for-write))
-		(funcall nntp-open-connection-function pbuffer))
-	    (error nil)
+		    (coding-system-for-write nntp-coding-system-for-write)
+		    (map '((nntp-open-network-stream network)
+			   (nntp-open-ssl-stream tls)
+			   (nntp-open-tls-stream tls))))
+		(if (assoc nntp-open-connection-function map)
+		    (car (open-protocol-stream
+			  "nntpd" pbuffer nntp-address nntp-port-number
+			  :type (cadr
+				 (assoc nntp-open-connection-function map))
+			  :end-of-command "^\\([2345]\\|[.]\\).*\n"
+			  :capability-command "CAPABILITIES\r\n"
+			  :success "^3"
+			  :starttls-function
+			  (lambda (capabilities)
+			    (if (not (string-match "STARTTLS" capabilities))
+				nil
+			      "STARTTLS\r\n"))))
+		  (funcall nntp-open-connection-function pbuffer)))
+	    (error
+	     (nnheader-report 'nntp "%s" err))
 	    (quit
 	     (message "Quit opening connection to %s" nntp-address)
 	     (nntp-kill-buffer pbuffer)
@@ -1300,40 +1311,6 @@
 	(nntp-kill-buffer (process-buffer process))
 	nil))))

-(defun nntp-open-network-stream (buffer)
-  (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
-
-(autoload 'format-spec "format-spec")
-(autoload 'format-spec-make "format-spec")
-(autoload 'open-tls-stream "tls")
-
-(defun nntp-open-ssl-stream (buffer)
-  (let* ((process-connection-type nil)
-	 (proc (start-process "nntpd" buffer
-			      shell-file-name
-			      shell-command-switch
-			      (format-spec nntp-ssl-program
-					   (format-spec-make
-					    ?s nntp-address
-					    ?p nntp-port-number)))))
-    (gnus-set-process-query-on-exit-flag proc nil)
-    (with-current-buffer buffer
-      (let ((nntp-connection-alist (list proc buffer nil)))
-	(nntp-wait-for-string "^\r*20[01]"))
-      (beginning-of-line)
-      (delete-region (point-min) (point))
-      proc)))
-
-(defun nntp-open-tls-stream (buffer)
-  (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number)))
-    (gnus-set-process-query-on-exit-flag proc nil)
-    (with-current-buffer buffer
-      (let ((nntp-connection-alist (list proc buffer nil)))
-	(nntp-wait-for-string "^\r*20[01]"))
-      (beginning-of-line)
-      (delete-region (point-min) (point))
-      proc)))
-
 (defun nntp-read-server-type ()
   "Find out what the name of the server we have connected to is."
   ;; Wait for the status string to arrive.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/gnus/proto-stream.el	Thu Dec 02 22:21:31 2010 +0000
@@ -0,0 +1,262 @@
+;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: network
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; This library is meant to provide the glue between modules that want
+;; to establish a network connection to a server for protocols such as
+;; IMAP, NNTP, SMTP and POP3.
+
+;; The main problem is that there's more than a couple of interfaces
+;; towards doing this.  You have normal, plain connections, which are
+;; no trouble at all, but you also have TLS/SSL connections, and you
+;; have STARTTLS.  Negotiating this for each protocol can be rather
+;; tedious, so this library provides a single entry point, and hides
+;; much of the ugliness.
+
+;; Usage example:
+
+;; (open-protocol-stream
+;;  "*nnimap*" buffer address port
+;;  :type 'network
+;;  :capability-command "1 CAPABILITY\r\n"
+;;  :success " OK "
+;;  :starttls-function
+;;  (lambda (capabilities)
+;;    (if (not (string-match "STARTTLS" capabilities))
+;;        nil
+;;      "1 STARTTLS\r\n")))
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+(require 'tls)
+(require 'starttls)
+(require 'format-spec)
+
+(defcustom proto-stream-always-use-starttls (fboundp 'open-gnutls-stream)
+  "If non-nil, always try to upgrade network connections with STARTTLS."
+  :version "24.1"
+  :type 'boolean
+  :group 'comm)
+
+(declare-function gnutls-negotiate "gnutls"
+		  (proc type &optional priority-string trustfiles keyfiles))
+
+;;;###autoload
+(defun open-protocol-stream (name buffer host service &rest parameters)
+  "Open a network stream to HOST, upgrading to STARTTLS if possible.
+The first four parameters have the same meaning as in
+`open-network-stream'.  The function returns a list where the
+first element is the stream, the second element is the greeting
+the server replied with after connecting, and the third element
+is a string representing the capabilities of the server (if any).
+
+The PARAMETERS is a keyword list that can have the following
+values:
+
+:type -- either `network', `tls', `shell' or `starttls'.  If
+omitted, the default is `network'.  `network' will be
+opportunistically upgraded to STARTTLS if both the server and
+Emacs supports it.
+
+:end-of-command -- a regexp saying what the end of a command is.
+This defaults to \"\\n\".
+
+:success -- a regexp saying whether the STARTTLS command was
+successful or not.  For instance, for NNTP this is \"^3\".
+
+:capability-command -- a string representing the command used to
+query server for capabilities.  For instance, for IMAP this is
+\"1 CAPABILITY\\r\\n\".
+
+:starttls-function -- a function that takes one parameter, which
+is the response to the capaibility command.  It should return nil
+if it turns out that the server doesn't support STARTTLS, or the
+command to switch on STARTTLS otherwise."
+  (let ((type (or (cadr (memq :type parameters)) 'network)))
+    (cond
+     ((eq type 'starttls)
+      (setq type 'network))
+     ((eq type 'ssl)
+      (setq type 'tls)))
+    (destructuring-bind (stream greeting capabilities)
+	(funcall (intern (format "proto-stream-open-%s" type) obarray)
+		 name buffer host service parameters)
+      (list (and stream
+		 (memq (process-status stream)
+		       '(open run))
+		 stream)
+	    greeting capabilities))))
+
+(defun proto-stream-open-network (name buffer host service parameters)
+  (let* ((start (with-current-buffer buffer (point)))
+	 (stream (open-network-stream name buffer host service))
+	 (capability-command (cadr (memq :capability-command parameters)))
+	 (eoc (proto-stream-eoc parameters))
+	 (type (cadr (memq :type parameters)))
+	 (greeting (proto-stream-get-response stream start eoc))
+	 success)
+    (if (not capability-command)
+	(list stream greeting nil)
+      (let* ((capabilities
+	      (proto-stream-command stream capability-command eoc))
+	     (starttls-command
+	      (funcall (cadr (memq :starttls-function parameters))
+		       capabilities)))
+	(cond
+	  ;; If this server doesn't support STARTTLS, but we have
+	  ;; requested it explicitly, then close the connection and
+	  ;; return nil.
+	 ((or (not starttls-command)
+	      (and (not (eq type 'starttls))
+		   (not proto-stream-always-use-starttls)))
+	  (if (eq type 'starttls)
+	      (progn
+		(delete-process stream)
+		nil)
+	    ;; Otherwise, just return this plain network connection.
+	    (list stream greeting capabilities)))
+	 ;; We have some kind of STARTTLS support, so we try to
+	 ;; upgrade the connection opportunistically.
+	 ((or (fboundp 'open-gnutls-stream)
+	      (executable-find "gnutls-cli"))
+	  (unless (fboundp 'open-gnutls-stream)
+	    (delete-process stream)
+	    (setq start (with-current-buffer buffer (point-max)))
+	    (let* ((starttls-use-gnutls t)
+		   (starttls-extra-arguments
+		    (if (not (eq type 'starttls))
+			;; When doing opportunistic TLS upgrades we
+			;; don't really care about the identity of the
+			;; peer.
+			(cons "--insecure" starttls-extra-arguments)
+		      starttls-extra-arguments)))
+	      (setq stream (starttls-open-stream name buffer host service)))
+	    (proto-stream-get-response stream start eoc))
+	  (if (not
+	       (string-match
+		(cadr (memq :success parameters))
+		(proto-stream-command stream starttls-command eoc)))
+	      ;; We got an error back from the STARTTLS command.
+	      (progn
+		(if (eq type 'starttls)
+		    (progn
+		      (delete-process stream)
+		      nil)
+		  (list stream greeting capabilities)))
+	    ;; The server said it was OK to start doing STARTTLS negotiations.
+	    (if (fboundp 'open-gnutls-stream)
+		(gnutls-negotiate stream nil)
+	      (unless (starttls-negotiate stream)
+		(delete-process stream)
+		(setq stream nil)))
+	    (when (or (null stream)
+		      (not (memq (process-status stream)
+				 '(open run))))
+	      ;; It didn't successfully negotiate STARTTLS, so we reopen
+	      ;; the connection.
+	      (setq stream (open-network-stream name buffer host service))
+	      (proto-stream-get-response stream start eoc))
+	    ;; Re-get the capabilities, since they may have changed
+	    ;; after switching to TLS.
+	    (list stream greeting
+		  (proto-stream-command stream capability-command eoc))))
+	 ;; We don't have STARTTLS support available, but the caller
+	 ;; requested a STARTTLS connection, so we give up.
+	 ((eq (cadr (memq :type parameters)) 'starttls)
+	  (delete-process stream)
+	  nil)
+	 ;; Fall back on using a plain network stream.
+	 (t
+	  (list stream greeting capabilities)))))))
+
+(defun proto-stream-command (stream command eoc)
+  (let ((start (with-current-buffer (process-buffer stream) (point-max))))
+    (process-send-string stream command)
+    (proto-stream-get-response stream start eoc)))
+
+(defun proto-stream-get-response (stream start end-of-command)
+  (with-current-buffer (process-buffer stream)
+    (save-excursion
+      (goto-char start)
+      (while (and (memq (process-status stream)
+			'(open run))
+		  (not (re-search-forward end-of-command nil t)))
+	(accept-process-output stream 0 50)
+	(goto-char start))
+      (if (= start (point))
+	  ;; The process died; return nil.
+	  nil
+	;; Return the data we got back.
+	(buffer-substring start (point))))))
+
+(defun proto-stream-open-tls (name buffer host service parameters)
+  (with-current-buffer buffer
+    (let ((start (point-max))
+	  (stream
+	   (funcall (if (fboundp 'open-gnutls-stream)
+			'open-gnutls-stream
+		      'open-tls-stream)
+		    name buffer host service)))
+      ;; If we're using tls.el, we have to delete the output from
+      ;; openssl/gnutls-cli.
+      (unless (fboundp 'open-gnutls-stream)
+	(proto-stream-get-response
+	 stream start (proto-stream-eoc parameters))
+	(goto-char (point-min))
+	(when (re-search-forward (proto-stream-eoc parameters) nil t)
+	  (goto-char (match-beginning 0))
+	  (delete-region (point-min) (line-beginning-position))))
+      (proto-stream-capability-open start stream parameters))))
+
+(defun proto-stream-open-shell (name buffer host service parameters)
+  (proto-stream-capability-open
+   (with-current-buffer buffer (point))
+   (let ((process-connection-type nil))
+     (start-process name buffer shell-file-name
+		    shell-command-switch
+		    (format-spec
+		     (cadr (memq :shell-command parameters))
+		     (format-spec-make
+		      ?s host
+		      ?p service))))
+   parameters))
+
+(defun proto-stream-capability-open (start stream parameters)
+  (let ((capability-command (cadr (memq :capability-command parameters)))
+	(greeting (proto-stream-get-response
+		   stream start (proto-stream-eoc parameters))))
+    (list stream greeting
+	  (and capability-command
+	       (proto-stream-command
+		stream capability-command (proto-stream-eoc parameters))))))
+
+(defun proto-stream-eoc (parameters)
+  (or (cadr (memq :end-of-command parameters))
+      "\r\n"))
+
+(provide 'proto-stream)
+
+;;; proto-stream.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/gnus/rtree.el	Thu Dec 02 22:21:31 2010 +0000
@@ -0,0 +1,279 @@
+;;; rtree.el --- functions for manipulating range trees
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; A "range tree" is a binary tree that stores ranges.  They are
+;; similar to interval trees, but do not allow overlapping intervals.
+
+;; A range is an ordered list of number intervals, like this:
+
+;; ((10 . 25) 56 78 (98 . 201))
+
+;; Common operations, like lookup, deletion and insertion are O(n) in
+;; a range, but an rtree is O(log n) in all these operations.
+;; Transformation between a range and an rtree is O(n).
+
+;; The rtrees are quite simple.  The structure of each node is
+
+;; (cons (cons low high) (cons left right))
+
+;; That is, they are three cons cells, where the car of the top cell
+;; is the actual range, and the cdr has the left and right child.  The
+;; rtrees aren't automatically balanced, but are balanced when
+;; created, and can be rebalanced when deemed necessary.
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+
+(defmacro rtree-make-node ()
+  `(list (list nil) nil))
+
+(defmacro rtree-set-left (node left)
+  `(setcar (cdr ,node) ,left))
+
+(defmacro rtree-set-right (node right)
+  `(setcdr (cdr ,node) ,right))
+
+(defmacro rtree-set-range (node range)
+  `(setcar ,node ,range))
+
+(defmacro rtree-low (node)
+  `(caar ,node))
+
+(defmacro rtree-high (node)
+  `(cdar ,node))
+
+(defmacro rtree-set-low (node number)
+  `(setcar (car ,node) ,number))
+
+(defmacro rtree-set-high (node number)
+  `(setcdr (car ,node) ,number))
+
+(defmacro rtree-left (node)
+  `(cadr ,node))
+
+(defmacro rtree-right (node)
+  `(cddr ,node))
+
+(defmacro rtree-range (node)
+  `(car ,node))
+
+(defsubst rtree-normalise-range (range)
+  (when (numberp range)
+    (setq range (cons range range)))
+  range)
+
+(defun rtree-make (range)
+  "Make an rtree from RANGE."
+  ;; Normalize the range.
+  (unless (listp (cdr-safe range))
+    (setq range (list range)))
+  (rtree-make-1 (cons nil range) (length range)))
+
+(defun rtree-make-1 (range length)
+  (let ((mid (/ length 2))
+	(node (rtree-make-node)))
+    (when (> mid 0)
+      (rtree-set-left node (rtree-make-1 range mid)))
+    (rtree-set-range node (rtree-normalise-range (cadr range)))
+    (setcdr range (cddr range))
+    (when (> (- length mid 1) 0)
+      (rtree-set-right node (rtree-make-1 range (- length mid 1))))
+    node))
+
+(defun rtree-memq (tree number)
+  "Return non-nil if NUMBER is present in TREE."
+  (while (and tree
+	      (not (and (>= number (rtree-low tree))
+			(<= number (rtree-high tree)))))
+    (setq tree
+	  (if (< number (rtree-low tree))
+	      (rtree-left tree)
+	    (rtree-right tree))))
+  tree)
+
+(defun rtree-add (tree number)
+  "Add NUMBER to TREE."
+  (while tree
+    (cond
+     ;; It's already present, so we don't have to do anything.
+     ((and (>= number (rtree-low tree))
+	   (<= number (rtree-high tree)))
+      (setq tree nil))
+     ((< number (rtree-low tree))
+      (cond
+       ;; Extend the low range.
+       ((= number (1- (rtree-low tree)))
+	(rtree-set-low tree number)
+	;; Check whether we need to merge this node with the child.
+	(when (and (rtree-left tree)
+		   (= (rtree-high (rtree-left tree)) (1- number)))
+	  ;; Extend the range to the low from the child.
+	  (rtree-set-low tree (rtree-low (rtree-left tree)))
+	  ;; The child can't have a right child, so just transplant the
+	  ;; child's left tree to our left tree.
+	  (rtree-set-left tree (rtree-left (rtree-left tree))))
+	(setq tree nil))
+       ;; Descend further to the left.
+       ((rtree-left tree)
+	(setq tree (rtree-left tree)))
+       ;; Add a new node.
+       (t
+	(let ((new-node (rtree-make-node)))
+	  (rtree-set-low new-node number)
+	  (rtree-set-high new-node number)
+	  (rtree-set-left tree new-node)
+	  (setq tree nil)))))
+     (t
+      (cond
+       ;; Extend the high range.
+       ((= number (1+ (rtree-high tree)))
+	(rtree-set-high tree number)
+	;; Check whether we need to merge this node with the child.
+	(when (and (rtree-right tree)
+		   (= (rtree-low (rtree-right tree)) (1+ number)))
+	  ;; Extend the range to the high from the child.
+	  (rtree-set-high tree (rtree-high (rtree-right tree)))
+	  ;; The child can't have a left child, so just transplant the
+	  ;; child's left right to our right tree.
+	  (rtree-set-right tree (rtree-right (rtree-right tree))))
+	(setq tree nil))
+       ;; Descend further to the right.
+       ((rtree-right tree)
+	(setq tree (rtree-right tree)))
+       ;; Add a new node.
+       (t
+	(let ((new-node (rtree-make-node)))
+	  (rtree-set-low new-node number)
+	  (rtree-set-high new-node number)
+	  (rtree-set-right tree new-node)
+	  (setq tree nil))))))))
+
+(defun rtree-delq (tree number)
+  "Remove NUMBER from TREE destructively.  Returns the new tree."
+  (let ((result tree)
+	prev)
+    (while tree
+      (cond
+       ((< number (rtree-low tree))
+	(setq prev tree
+	      tree (rtree-left tree)))
+       ((> number (rtree-high tree))
+	(setq prev tree
+	      tree (rtree-right tree)))
+       ;; The number is in this node.
+       (t
+	(cond
+	 ;; The only entry; delete the node.
+	 ((= (rtree-low tree) (rtree-high tree))
+	  (cond
+	   ;; Two children.  Replace with successor value.
+	   ((and (rtree-left tree) (rtree-right tree))
+	    (let ((parent tree)
+		  (successor (rtree-right tree)))
+	      (while (rtree-left successor)
+		(setq parent successor
+		      successor (rtree-left successor)))
+	      ;; We now have the leftmost child of our right child.
+	      (rtree-set-range tree (rtree-range successor))
+	      ;; Transplant the child (if any) to the parent.
+	      (rtree-set-left parent (rtree-right successor))))
+	   (t
+	    (let ((rest (or (rtree-left tree)
+			    (rtree-right tree))))
+	      ;; One or zero children.  Remove the node.
+	      (cond
+	       ((null prev)
+		(setq result rest))
+	       ((eq (rtree-left prev) tree)
+		(rtree-set-left prev rest))
+	       (t
+		(rtree-set-right prev rest)))))))
+	 ;; The lowest in the range; just adjust.
+	 ((= number (rtree-low tree))
+	  (rtree-set-low tree (1+ number)))
+	 ;; The highest in the range; just adjust.
+	 ((= number (rtree-high tree))
+	  (rtree-set-high tree (1- number)))
+	 ;; We have to split this range.
+	 (t
+	  (let ((new-node (rtree-make-node)))
+	    (rtree-set-low new-node (rtree-low tree))
+	    (rtree-set-high new-node (1- number))
+	    (rtree-set-low tree (1+ number))
+	    (cond
+	     ;; Two children; insert the new node as the predecessor
+	     ;; node.
+	     ((and (rtree-left tree) (rtree-right tree))
+	      (let ((predecessor (rtree-left tree)))
+		(while (rtree-right predecessor)
+		  (setq predecessor (rtree-right predecessor)))
+		(rtree-set-right predecessor new-node)))
+	     ((rtree-left tree)
+	      (rtree-set-right new-node tree)
+	      (rtree-set-left new-node (rtree-left tree))
+	      (rtree-set-left tree nil)
+	      (cond
+	       ((null prev)
+		(setq result new-node))
+	       ((eq (rtree-left prev) tree)
+		(rtree-set-left prev new-node))
+	       (t
+		(rtree-set-right prev new-node))))
+	     (t
+	      (rtree-set-left tree new-node))))))
+	(setq tree nil))))
+    result))
+
+(defun rtree-extract (tree)
+  "Convert TREE to range form."
+  (let (stack result)
+    (while (or stack
+	       tree)
+      (if tree
+	  (progn
+	    (push tree stack)
+	    (setq tree (rtree-right tree)))
+	(setq tree (pop stack))
+	(push (if (= (rtree-low tree)
+		     (rtree-high tree))
+		  (rtree-low tree)
+		(rtree-range tree))
+	      result)
+	(setq tree (rtree-left tree))))
+    result))
+
+(defun rtree-length (tree)
+  "Return the number of numbers stored in TREE."
+  (if (null tree)
+      0
+    (+ (rtree-length (rtree-left tree))
+       (1+ (- (rtree-high tree)
+	      (rtree-low tree)))
+       (rtree-length (rtree-right tree)))))
+
+(provide 'rtree)
+
+;;; rtree.el ends here
--- a/lisp/gnus/shr.el	Thu Dec 02 20:34:31 2010 +0100
+++ b/lisp/gnus/shr.el	Thu Dec 02 22:21:31 2010 +0000
@@ -32,8 +32,6 @@

 (eval-when-compile (require 'cl))
 (require 'browse-url)
-(unless (aref (char-category-set (make-char 'japanese-jisx0208 33 35)) ?>)
-  (load "kinsoku" nil t))

 (defgroup shr nil
   "Simple HTML Renderer"
@@ -214,6 +212,26 @@
      ((listp (cdr sub))
       (shr-descend sub)))))

+(defmacro shr-char-breakable-p (char)
+  "Return non-nil if a line can be broken before and after CHAR."
+  `(aref fill-find-break-point-function-table ,char))
+(defmacro shr-char-nospace-p (char)
+  "Return non-nil if no space is required before and after CHAR."
+  `(aref fill-nospace-between-words-table ,char))
+
+;; KINSOKU is a Japanese word meaning a rule that should not be violated.
+;; In Emacs, it is a term used for characters, e.g. punctuation marks,
+;; parentheses, and so on, that should not be placed in the beginning
+;; of a line or the end of a line.
+(defmacro shr-char-kinsoku-bol-p (char)
+  "Return non-nil if a line ought not to begin with CHAR."
+  `(aref (char-category-set ,char) ?>))
+(defmacro shr-char-kinsoku-eol-p (char)
+  "Return non-nil if a line ought not to end with CHAR."
+  `(aref (char-category-set ,char) ?<))
+(unless (shr-char-kinsoku-bol-p (make-char 'japanese-jisx0208 33 35))
+  (load "kinsoku" nil t))
+
 (defun shr-insert (text)
   (when (and (eq shr-state 'image)
 	     (not (string-match "\\`[ \t\n]+\\'" text)))
@@ -242,12 +260,11 @@
       (let (prev)
 	(when (and (eq (preceding-char) ? )
 		   (or (= (line-beginning-position) (1- (point)))
-		       (and (aref fill-find-break-point-function-table
-				  (setq prev (char-after (- (point) 2))))
-			    (aref (char-category-set prev) ?>))
-		       (and (aref fill-nospace-between-words-table prev)
-			    (aref fill-nospace-between-words-table
-				  (aref elem 0)))))
+		       (and (shr-char-breakable-p
+			     (setq prev (char-after (- (point) 2))))
+			    (shr-char-kinsoku-bol-p prev))
+		       (and (shr-char-nospace-p prev)
+			    (shr-char-nospace-p (aref elem 0)))))
 	  (delete-char -1)))
       (insert elem)
       (let (found)
@@ -273,67 +290,88 @@
 (defun shr-find-fill-point ()
   (when (> (move-to-column shr-width) shr-width)
     (backward-char 1))
-  (let (failed)
-    (while (not
-	    (or (setq failed (= (current-column) shr-indentation))
-		(eq (preceding-char) ? )
-		(eq (following-char) ? )
-		(aref fill-find-break-point-function-table (preceding-char))
-		(aref (char-category-set (preceding-char)) ?>)))
+  (let ((bp (point))
+	failed)
+    (while (not (or (setq failed (= (current-column) shr-indentation))
+		    (eq (preceding-char) ? )
+		    (eq (following-char) ? )
+		    (shr-char-breakable-p (preceding-char))
+		    (shr-char-breakable-p (following-char))
+		    (and (eq (preceding-char) ?')
+			 (not (memq (char-after (- (point) 2))
+				    (list nil ?\n ? ))))
+		    ;; There're some kinsoku CJK chars that aren't breakable.
+		    (and (shr-char-kinsoku-bol-p (preceding-char))
+			 (not (shr-char-kinsoku-bol-p (following-char))))
+		    (shr-char-kinsoku-eol-p (following-char))))
       (backward-char 1))
+    (if (and (not (or failed (eolp)))
+	     (eq (preceding-char) ?'))
+	(while (not (or (setq failed (eolp))
+			(eq (following-char) ? )
+			(shr-char-breakable-p (following-char))
+			(shr-char-kinsoku-eol-p (following-char))))
+	  (forward-char 1)))
     (if failed
 	;; There's no breakable point, so we give it up.
-	(progn
-	  (end-of-line)
-	  (while (aref fill-find-break-point-function-table (preceding-char))
-	    (backward-char 1))
-	  nil)
+	(let (found)
+	  (goto-char bp)
+	  (unless shr-kinsoku-shorten
+	    (while (and (setq found (re-search-forward
+				     "\\(\\c>\\)\\| \\|\\c<\\|\\c|"
+				     (line-end-position) 'move))
+			(eq (preceding-char) ?')))
+	    (if (and found (not (match-beginning 1)))
+		(goto-char (match-beginning 0)))))
       (or
        (eolp)
-       (progn
-	 ;; Don't put kinsoku-bol characters at the beginning of a line,
-	 ;; or kinsoku-eol characters at the end of a line.
-	 (cond
-	  (shr-kinsoku-shorten
-	   (while (and
-		   (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
-		   (not (or (aref (char-category-set (preceding-char)) ?>)
-			    (aref (char-category-set (following-char)) ?<)))
-		   (or (aref (char-category-set (preceding-char)) ?<)
-		       (aref (char-category-set (following-char)) ?>)))
-	     (backward-char 1)))
-	  ((aref (char-category-set (preceding-char)) ?<)
-	   (let ((count 3))
-	     (while (progn
-		      (backward-char 1)
-		      (and
-		       (> (setq count (1- count)) 0)
-		       (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
-		       (or (aref (char-category-set (preceding-char)) ?<)
-			   (aref (char-category-set (following-char)) ?>))))))
-	   (if (and (setq failed (= (current-column) shr-indentation))
-		    (re-search-forward "\\c|" (line-end-position) 'move))
+       ;; Don't put kinsoku-bol characters at the beginning of a line,
+       ;; or kinsoku-eol characters at the end of a line.
+       (cond
+	(shr-kinsoku-shorten
+	 (while (and (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
+		     (shr-char-kinsoku-eol-p (preceding-char)))
+	   (backward-char 1))
+	 (when (setq failed (= (current-column) shr-indentation))
+	   ;; There's no breakable point that doesn't violate kinsoku,
+	   ;; so we look for the second best position.
+	   (while (and (progn
+			 (forward-char 1)
+			 (<= (current-column) shr-width))
+		       (progn
+			 (setq bp (point))
+			 (shr-char-kinsoku-eol-p (following-char)))))
+	   (goto-char bp)))
+	((shr-char-kinsoku-eol-p (preceding-char))
+	 (if (shr-char-kinsoku-eol-p (following-char))
+	     ;; There are consecutive kinsoku-eol characters.
+	     (setq failed t)
+	   (let ((count 4))
+	     (while
+		 (progn
+		   (backward-char 1)
+		   (and (> (setq count (1- count)) 0)
+			(not (memq (preceding-char) (list ?\C-@ ?\n ? )))
+			(or (shr-char-kinsoku-eol-p (preceding-char))
+			    (shr-char-kinsoku-bol-p (following-char)))))))
+	   (if (setq failed (= (current-column) shr-indentation))
 	       ;; There's no breakable point that doesn't violate kinsoku,
-	       ;; so we look for the second best position.
-	       (let (bp)
-		 (while (and (<= (current-column) shr-width)
-			     (progn
-			       (setq bp (point))
-			       (not (eolp)))
-			     (aref fill-find-break-point-function-table
-				   (following-char)))
-		   (forward-char 1))
-		 (goto-char (or bp (line-end-position))))))
-	  (t
+	       ;; so we go to the second best position.
+	       (if (looking-at "\\(\\c<+\\)\\c<")
+		   (goto-char (match-end 1))
+		 (forward-char 1)))))
+	(t
+	 (if (shr-char-kinsoku-bol-p (preceding-char))
+	     ;; There are consecutive kinsoku-bol characters.
+	     (setq failed t)
 	   (let ((count 4))
 	     (while (and (>= (setq count (1- count)) 0)
-			 (aref (char-category-set (following-char)) ?>)
-			 (aref fill-find-break-point-function-table
-			       (following-char)))
-	       (forward-char 1)))))
-	 (when (eq (following-char) ? )
-	   (forward-char 1))
-	 (not failed))))))
+			 (shr-char-kinsoku-bol-p (following-char))
+			 (shr-char-breakable-p (following-char)))
+	       (forward-char 1))))))
+       (when (eq (following-char) ? )
+	 (forward-char 1))))
+    (not failed)))

 (defun shr-ensure-newline ()
   (unless (zerop (current-column))