Mercurial > emacs

changeset 110908:2a4bfc24abf0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge changes made in Gnus trunk. nnimap.el (nnimap-wait-for-response): If the user hits `C-g', kill the process, too. nnir.el (gnus-summary-nnir-goto-thread): Modify to work with imap. nnimap.el (nnimap-update-info): If the server doesn't return any useful info, just use the previous info. nnimap.el (nnimap-update-info): Prefer old info over start-article. nnimap.el (nnimap-update-qresync-info): Finish implementing QRESYNC. auth-source.el (auth-source-create): Use (user-login-name) for the user name default. nnimap.el (nnimap-open-connection): Use gnutls STARTTLS, if available. nnimap.el (nnimap-update-info): Rely more on the current active than the param active to avoid marking articles as read too much. gnus-sum.el (gnus-summary-set-local-parameters): Ignore the `active' non-variable, too. nnimap.el (nnimap-update-qresync-info): \Flagged messages are read for Gnus. nnimap.el (nnimap-retrieve-group-data-early): utf7-encode the group parameters. nnimap.el (nnimap-update-qresync-info): Mark \Seen articles as read.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Sun, 10 Oct 2010 22:48:40 +0000
parents 1ccdcdef34fc
children cc035ccb9275
files lisp/gnus/ChangeLog lisp/gnus/auth-source.el lisp/gnus/gnus-sum.el lisp/gnus/nnimap.el lisp/gnus/nnir.el
diffstat 5 files changed, 170 insertions(+), 70 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Sun Oct 10 20:47:45 2010 +0200
+++ b/lisp/gnus/ChangeLog	Sun Oct 10 22:48:40 2010 +0000
@@ -1,3 +1,41 @@
+2010-10-10  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* nnimap.el (nnimap-update-qresync-info): \Flagged messages are read
+	for Gnus.
+	(nnimap-retrieve-group-data-early): utf7-encode the group parameters.
+	(nnimap-update-qresync-info): Mark \Seen articles as read.
+
+	* gnus-sum.el (gnus-summary-set-local-parameters): Ignore the `active'
+	non-variable, too.
+
+	* nnimap.el (nnimap-open-connection): Use gnutls STARTTLS, if
+	available.
+	(nnimap-update-info): Rely more on the current active than the param
+	active to avoid marking articles as read too much.
+
+	* auth-source.el (auth-source-create): Use (user-login-name) for the
+	user name default.
+
+	* nnimap.el (nnimap-update-info): If the server doesn't return any
+	useful info, just use the previous info.
+	(nnimap-update-info): Prefer old info over start-article.
+	(nnimap-update-qresync-info): Finish implementing QRESYNC.
+
+2010-10-10  Andrew Cohen  <cohen@andy.bu.edu>
+
+	* nnir.el (autoload): Clean up autoloads.
+	(nnir-imap-default-search-key): Renamed from
+	nnir-imap-search-field. Use key rather than value.
+	(nnir-imap-search-other): New variable.
+	(nnir-read-parm): Use it.
+	(nnir-imap-expr-to-imap): Use %S rather than imap-quote-specials.
+	(gnus-summary-nnir-goto-thread): Modify to work with imap.
+
+2010-10-10  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* nnimap.el (nnimap-wait-for-response): If the user hits `C-g', kill
+	the process, too.
+
 2010-10-09  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* spam.el (gnus-summary-mode-map): Bind to "$".  Suggested by Russ
--- a/lisp/gnus/auth-source.el	Sun Oct 10 20:47:45 2010 +0200
+++ b/lisp/gnus/auth-source.el	Sun Oct 10 22:48:40 2010 +0000
@@ -336,7 +336,10 @@
                   passwd))
                ((equal "login" m)
                 (or user
-                    (read-string (format "User name for %s on %s: " prot host))))
+                    (read-string
+		     (format "User name for %s on %s (default %s): " prot host
+			     (user-login-name))
+		     nil nil (user-login-name))))
                (t
                 "unknownuser"))))
            (if (consp mode) mode (list mode))))
--- a/lisp/gnus/gnus-sum.el	Sun Oct 10 20:47:45 2010 +0200
+++ b/lisp/gnus/gnus-sum.el	Sun Oct 10 22:48:40 2010 +0000
@@ -3841,7 +3841,8 @@
 
 (defun gnus-summary-set-local-parameters (group)
   "Go through the local params of GROUP and set all variable specs in that list."
-  (let ((vars '(quit-config)))          ; Ignore quit-config.
+  (let ((vars '(quit-config active)))	; Ignore things that aren't
+					; really variables.
     (dolist (elem (gnus-group-find-parameter group))
       (and (consp elem)			; Has to be a cons.
 	   (consp (cdr elem))		; The cdr has to be a list.
--- a/lisp/gnus/nnimap.el	Sun Oct 10 20:47:45 2010 +0200
+++ b/lisp/gnus/nnimap.el	Sun Oct 10 22:48:40 2010 +0000
@@ -295,7 +295,9 @@
 	     (port nil)
 	     (ports
 	      (cond
-	       ((eq nnimap-stream 'network)
+	       ((or (eq nnimap-stream 'network)
+		    (and (eq nnimap-stream 'starttls)
+			 (fboundp 'open-gnutls-stream)))
 		(open-network-stream
 		 "*nnimap*" (current-buffer) nnimap-address
 		 (setq port
@@ -357,8 +359,16 @@
 	      (push (format "%s" nnimap-server-port) ports))
 	    ;; If this is a STARTTLS-capable server, then sever the
 	    ;; connection and start a STARTTLS connection instead.
-	    (when (and (eq nnimap-stream 'network)
-		       (member "STARTTLS" (nnimap-capabilities nnimap-object)))
+	    (cond
+	     ((and (or (and (eq nnimap-stream 'network)
+			    (member "STARTTLS"
+				    (nnimap-capabilities nnimap-object)))
+		       (eq nnimap-stream 'starttls))
+		   (fboundp 'open-gnutls-stream))
+	      (nnimap-command "STARTTLS")
+	      (gnutls-negotiate (nnimap-process nnimap-object) nil))
+	     ((and (eq nnimap-stream 'network)
+		   (member "STARTTLS" (nnimap-capabilities nnimap-object)))
 	      (let ((nnimap-stream 'starttls))
 		(let ((tls-process
 		       (nnimap-open-connection buffer)))
@@ -369,7 +379,7 @@
 		  (when (memq (process-status tls-process) '(open run))
 		    (delete-process (nnimap-process nnimap-object))
 		    (kill-buffer (current-buffer))
-		    (return tls-process)))))
+		    (return tls-process))))))
 	    (unless (equal connection-result "PREAUTH")
 	      (if (not (setq credentials
 			     (if (eq nnimap-authenticator 'anonymous)
@@ -949,7 +959,7 @@
       (erase-buffer)
       (setf (nnimap-group nnimap-object) nil)
       ;; QRESYNC handling isn't implemented.
-      (let ((qresyncp (member "notQRESYNC" (nnimap-capabilities nnimap-object)))
+      (let ((qresyncp (member "QRESYNC" (nnimap-capabilities nnimap-object)))
 	    params groups sequences active uidvalidity modseq group)
 	;; Go through the infos and gather the data needed to know
 	;; what and how to request the data.
@@ -964,7 +974,8 @@
 		   modseq)
 	      (push
 	       (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
-					  group uidvalidity modseq)
+					  (utf7-encode group t)
+					  uidvalidity modseq)
 		     'qresync
 		     nil group 'qresync)
 	       sequences)
@@ -982,7 +993,8 @@
 		     ;; examine), but will tell us whether the group
 		     ;; is read-only or not.
 		     "SELECT")))
-	      (push (list (nnimap-send-command "%s %S" command group)
+	      (push (list (nnimap-send-command "%s %S" command
+					       (utf7-encode group t))
 			  (nnimap-send-command "UID FETCH %d:* FLAGS" start)
 			  start group command)
 		    sequences)))
@@ -1038,7 +1050,9 @@
      ;; completely empty groups.
      ((and (not existing)
 	   (not uidnext))
-      )
+      (let ((active (cdr (assq 'active (gnus-info-params info)))))
+	(when active
+	  (gnus-set-active (gnus-info-group info) active))))
      ;; We have a mismatch between the old and new UIDVALIDITY
      ;; identifiers, so we have to re-request the group info (the next
      ;; time).  This virtually never happens.
@@ -1051,9 +1065,11 @@
       (gnus-group-remove-parameter info 'modseq))
      ;; We have the data needed to update.
      (t
-      (let ((group (gnus-info-group info))
-	    (completep (and start-article
-			    (= start-article 1))))
+      (let* ((group (gnus-info-group info))
+	     (completep (and start-article
+			     (= start-article 1)))
+	     (active (or (gnus-active group)
+			 (cdr (assq 'active (gnus-info-params info))))))
 	(when uidnext
 	  (setq high (1- uidnext)))
 	;; First set the active ranges based on high/low.
@@ -1066,6 +1082,8 @@
 			      (uidnext
 			       ;; No articles in this group.
 			       (cons uidnext (1- uidnext)))
+			      (active
+			       active)
 			      (start-article
 			       (cons start-article (1- start-article)))
 			      (t
@@ -1073,7 +1091,7 @@
 			       nil)))
 	  (gnus-set-active
 	   group
-	   (cons (car (gnus-active group))
+	   (cons (car active)
 		 (or high (1- uidnext)))))
 	;; See whether this is a read-only group.
 	(unless (eq permanent-flags 'not-scanned)
@@ -1089,7 +1107,7 @@
 		   (not start-article))
 	      ;; We've gotten the data by QRESYNCing.
 	      (nnimap-update-qresync-info
-	       info (nnimap-imap-ranges-to-gnus-ranges vanished) flags)
+	       info existing (nnimap-imap-ranges-to-gnus-ranges vanished) flags)
 	    ;; Do normal non-QRESYNC flag updates.
 	    ;; Update the list of read articles.
 	    (let* ((unread
@@ -1137,13 +1155,35 @@
 	(gnus-group-set-parameter info 'modseq highestmodseq)
 	(nnimap-store-info info (gnus-active group)))))))
 
-(defun nnimap-update-qresync-info (info vanished flags)
+(defun nnimap-update-qresync-info (info existing vanished flags)
   ;; Add all the vanished articles to the list of read articles.
   (gnus-info-set-read
    info
-   (gnus-range-add (gnus-info-read info)
-		   vanished))
-  )
+   (gnus-add-to-range
+    (gnus-add-to-range
+     (gnus-range-add (gnus-info-read info)
+		     vanished)
+     (cdr (assq '%Flagged flags)))
+    (cdr (assq '%Seen flags))))
+  (let ((marks (gnus-info-marks info)))
+    (dolist (type (cdr nnimap-mark-alist))
+      (let ((ticks (assoc (car type) marks))
+	    (new-marks
+	     (cdr (or (assoc (caddr type) flags) ; %Flagged
+		      (assoc (intern (cadr type) obarray) flags)
+		      (assoc (cadr type) flags))))) ; "\Flagged"
+	(setq marks (delq ticks marks))
+	(pop ticks)
+	;; Add the new marks we got.
+	(setq ticks (gnus-add-to-range ticks new-marks))
+	;; Remove the marks from messages that don't have them.
+	(setq ticks (gnus-remove-from-range
+		     ticks
+		     (gnus-compress-sequence
+		      (gnus-sorted-complement existing new-marks))))
+	(when ticks
+	  (push (cons (car type) ticks) marks)))
+      (gnus-info-set-marks info marks t))))
 
 (defun nnimap-imap-ranges-to-gnus-ranges (irange)
   (if (zerop (length irange))
@@ -1355,20 +1395,28 @@
 (defun nnimap-wait-for-response (sequence &optional messagep)
   (let ((process (get-buffer-process (current-buffer)))
 	openp)
-    (goto-char (point-max))
-    (while (and (setq openp (memq (process-status process)
-				  '(open run)))
-		(not (re-search-backward
-		      (format "^%d .*\n" sequence)
-		      (if nnimap-streaming
-			  (max (point-min) (- (point) 500))
-			(point-min))
-		      t)))
-      (when messagep
-	(message "nnimap read %dk" (/ (buffer-size) 1000)))
-      (nnheader-accept-process-output process)
-      (goto-char (point-max)))
-    openp))
+    (condition-case nil
+        (progn
+	  (goto-char (point-max))
+	  (while (and (setq openp (memq (process-status process)
+					'(open run)))
+		      (not (re-search-backward
+			    (format "^%d .*\n" sequence)
+			    (if nnimap-streaming
+				(max (point-min) (- (point) 500))
+			      (point-min))
+			    t)))
+	    (when messagep
+	      (message "nnimap read %dk" (/ (buffer-size) 1000)))
+	    (nnheader-accept-process-output process)
+	    (goto-char (point-max)))
+          openp)
+      (quit
+       ;; The user hit C-g while we were waiting: kill the process, in case
+       ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind
+       ;; NAT routers).
+       (delete-process process)
+       nil))))
 
 (defun nnimap-parse-response ()
   (let ((lines (split-string (nnimap-last-response-string) "\r\n" t))
--- a/lisp/gnus/nnir.el	Sun Oct 10 20:47:45 2010 +0200
+++ b/lisp/gnus/nnir.el	Sun Oct 10 22:48:40 2010 +0000
@@ -339,23 +339,34 @@
 (eval-when-compile
   (require 'cl))
 
+
+(eval-when-compile
+  (autoload 'nnimap-buffer "nnimap")
+  (autoload 'nnimap-command "nnimap")
+  (autoload 'nnimap-possibly-change-group "nnimap"))
+
 (nnoo-declare nnir)
 (nnoo-define-basics nnir)
 
 (gnus-declare-backend "nnir" 'mail)
 
-(defvar nnir-imap-search-field "TEXT"
-  "The IMAP search item when doing an nnir search. To use raw
-  imap queries by default set this to \"\"")
+(defvar 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\"")
 
 (defvar nnir-imap-search-arguments
   '(("Whole message" . "TEXT")
     ("Subject" . "SUBJECT")
     ("To" . "TO")
     ("From" . "FROM")
-    ("Head" . "HEADER \"%s\"")
-    (nil . ""))
-  "Mapping from user readable strings to IMAP search items for use in nnir")
+    ("Imap" . ""))
+  "Mapping from user readable keys to IMAP search items for use in nnir")
+
+(defvar nnir-imap-search-other "HEADER %S"
+  "The IMAP search item to use for anything other than
+  nnir-imap-search-arguments. By default this is the name of an
+  email header field")
 
 (defvar nnir-imap-search-argument-history ()
   "The history for querying search options in nnir")
@@ -375,12 +386,12 @@
              ())
     (imap    nnir-run-imap
              ((criteria
-	       "Search in: "                      ; Prompt
+	       "Search in"                        ; Prompt
 	       ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing
 	       nil                                ; allow any user input
 	       nil                                ; initial value
 	       nnir-imap-search-argument-history  ; the history to use
-	       ,nnir-imap-search-field            ; default
+	       ,nnir-imap-default-search-key      ; default
 	       )))
     (swish++ nnir-run-swish++
              ((group . "Group spec: ")))
@@ -702,19 +713,30 @@
   (let* ((cur (gnus-summary-article-number))
          (group (nnir-artlist-artitem-group nnir-artlist cur))
          (backend-number (nnir-artlist-artitem-number nnir-artlist cur))
-	 server backend-group)
-    (setq server (nnir-group-server group))
-    (setq backend-group (gnus-group-real-name group))
-    (gnus-group-read-ephemeral-group
-     backend-group
-     (gnus-server-to-method server)
-     t                                  ; activate
-     (cons (current-buffer)
-           'summary)                    ; window config
-     nil
-     (list backend-number))
-    (gnus-summary-limit (list backend-number))
-    (gnus-summary-refer-thread)))
+	 (id (mail-header-id (gnus-summary-article-header)))
+	 (refs (split-string
+		(mail-header-references (gnus-summary-article-header)))))
+    (if (string= (car (gnus-group-method group)) "nnimap")
+	(with-current-buffer (nnimap-buffer)
+	  (let* ((cmd (let ((value
+			     (format
+			      "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
+			      id id)))
+			(dolist (refid refs value)
+			  (setq value (format
+				       "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
+				       refid refid value)))))
+		 (result (nnimap-command
+			  "UID SEARCH %s" cmd)))
+	    (gnus-summary-read-group-1 group t t gnus-summary-buffer nil
+				       (and (car result)
+					    (delete 0 (mapcar #'string-to-number
+							      (cdr (assoc "SEARCH" (cdr result)))))))))
+      (gnus-summary-read-group-1 group t t gnus-summary-buffer
+				 nil (list backend-number))
+      (gnus-summary-limit (list backend-number))
+      (gnus-summary-refer-thread))))
+
 
 (if (fboundp 'eval-after-load)
     (eval-after-load "gnus-sum"
@@ -936,22 +958,9 @@
 
 ;; IMAP interface.
 ;; todo:
-;; nnir invokes this two (2) times???!
-;; we should not use nnimap at all but open our own server connection
-;; we should not LIST * but use nnimap-list-pattern from defs
 ;; send queries as literals
 ;; handle errors
 
-(autoload 'nnimap-open-server "nnimap")
-(defvar nnimap-server-buffer) ;; nnimap.el
-(autoload 'imap-mailbox-select "imap")
-(autoload 'imap-search "imap")
-(autoload 'imap-quote-specials "imap")
-
-(eval-when-compile
-  (autoload 'nnimap-buffer "nnimap")
-  (autoload 'nnimap-command "nnimap")
-  (autoload 'nnimap-possibly-change-group "nnimap"))
 
 (defun nnir-run-imap (query srv &optional group-option)
   "Run a search against an IMAP back-end server.
@@ -963,7 +972,8 @@
 	  (group (or group-option (gnus-group-group-name)))
 	  (defs (caddr (gnus-server-to-method srv)))
 	  (criteria (or (cdr (assq 'criteria query))
-			nnir-imap-search-field))
+			(cdr (assoc nnir-imap-default-search-key
+				    nnir-imap-search-arguments))))
 	  (gnus-inhibit-demon t)
 	  artlist)
       (message "Opening server %s" server)
@@ -1044,7 +1054,7 @@
   (cond
    ;; Simple string term
    ((stringp expr)
-    (format "%s \"%s\"" criteria (imap-quote-specials expr)))
+    (format "%s %S" criteria expr))
    ;; Trivial term: and
    ((eq expr 'and) nil)
    ;; Composite term: or expression
@@ -1580,7 +1590,7 @@
     (if (listp prompt)
 	(let* ((result (apply 'gnus-completing-read prompt))
 	       (mapping (or (assoc result nnir-imap-search-arguments)
-			    (assoc nil nnir-imap-search-arguments))))
+			    (cons nil nnir-imap-search-other))))
 	  (cons sym (format (cdr mapping) result)))
       (cons sym (read-string prompt)))))