]> git.eshelyaron.com Git - emacs.git/commitdiff
Merge changes made in Gnus trunk.
authorLars Magne Ingebrigtsen <larsi@gnus.org>
Sat, 18 Sep 2010 23:36:29 +0000 (23:36 +0000)
committerKatsumi Yamaoka <yamaoka@jpl.org>
Sat, 18 Sep 2010 23:36:29 +0000 (23:36 +0000)
nnimap.el (nnimap-request-group): Use the stored info for the dont-check case.
nnimap.el: Use deffoo instead of defun for interface functions.
gnus-int.el (gnus-request-group): Take an optional `info' parameter.
nnimap.el: Allow nnimap-request-group to do a complete marks sync on `M-g'.
nnimap.el: Get credentials for numerical equivalents of the port numbers.
gnus-html.el (gnus-html-wash-tags): Add support for i, b and u HTML tags.
nnimap.el (nnimap-update-info): Extend the info so that we can set the marks.
nnimap.el (nnimap-open-connection): Fix typo -- should be 'shell, not 'stream.
nnimap.el: Allow PREAUTH nnimap connections to log in without credentials.
nnimap.el (nnimap-update-info): Fix off-by-one error when concatenating ranges when doing a partial update.
gnus-html.el (gnus-html-schedule-image-fetching): Use `url' rather than curl to retrieve images.
nnimap.el (nnimap-update-info): When doing partial marks update, get the range update right.
nnimap.el (nnimap-wait-for-response): Be a bit more lax in finding the end of the command we're looking for.
nnimap.el: Allow sending \n instead of \r\n on 'shell streams.
gnus-html.el (gnus-html-schedule-image-fetching): Fetch all images in parallel.

24 files changed:
lisp/gnus/ChangeLog
lisp/gnus/gnus-html.el
lisp/gnus/gnus-int.el
lisp/gnus/gnus-start.el
lisp/gnus/nnagent.el
lisp/gnus/nnbabyl.el
lisp/gnus/nndiary.el
lisp/gnus/nndoc.el
lisp/gnus/nndraft.el
lisp/gnus/nneething.el
lisp/gnus/nnfolder.el
lisp/gnus/nnimap.el
lisp/gnus/nnir.el
lisp/gnus/nnmaildir.el
lisp/gnus/nnmairix.el
lisp/gnus/nnmbox.el
lisp/gnus/nnmh.el
lisp/gnus/nnml.el
lisp/gnus/nnnil.el
lisp/gnus/nnrss.el
lisp/gnus/nnspool.el
lisp/gnus/nntp.el
lisp/gnus/nnvirtual.el
lisp/gnus/nnweb.el

index 25e1753873051468773ce87285f68b173f0f2d8d..a7d29366cb7818156be3c6312db86a13eab93021 100644 (file)
@@ -1,6 +1,67 @@
+2010-09-18  Julien Danjou  <julien@danjou.info>
+
+       * gnus-html.el (gnus-html-schedule-image-fetching): Fetch all images in
+       parallel.
+
+2010-09-18  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * nnimap.el (nnimap-update-info): When doing partial marks update, get
+       the range update right.
+       (nnimap-request-group): Don't make `M-g' bug out on group with no
+       marks.
+       (nnoo): Required, so that other packages can require nnimap.
+       (nnimap-wait-for-response): Be a bit more lax in finding the end of the
+       command we're looking for.  This helps when the server sends more
+       responses after we've gotten everything we expected.
+       (nnimap): Add a `newlinep' field to keep track of end-of-line
+       conventions.
+       Don't send CRLF to things that don't want it.
+       (nnimap-request-accept-article): Ditto.
+
+2010-09-18  Julien Danjou  <julien@danjou.info>
+
+       * gnus-html.el (gnus-html-schedule-image-fetching): Use `url' rather
+       than curl to retrieve images.
+
+2010-09-18  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * nnimap.el (nnimap-update-info): Extend the info so that we can set
+       the marks.
+       (nnimap-open-connection): Fix typo -- should be 'shell, not 'stream.
+       (nnimap-wait-for-connection): New function.
+       (nnimap-open-connection): If we have PREAUTH, don't query for login
+       credentials.
+       (nnimap-update-info): Fix off-by-one error when concatenating ranges
+       when doing a partial update.
+
+2010-09-18  Julien Danjou  <julien@danjou.info>
+
+       * gnus-html.el (gnus-html-wash-tags): Add support for i, b and u HTML
+       tags.
+
 2010-09-18  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
-       * nnimap.el: Require nnoo and other files necessary.
+       * nnimap.el (nnimap-credentials): New function.
+       (nnimap-open-connection): Use the new function to look for credentials
+       also on the numeric equivalents of "imap" and "imaps".
+
+       * gnus-start.el (gnus-activate-group): Send the info to
+       gnus-request-group.
+
+       * nnimap.el (nnimap-request-group): Have the "check" version of the
+       function parse flags and update the info, so that a `M-g' get a total
+       resync of all flags from the group.
+
+       * gnus-int.el (gnus-request-group): Take an optional `info' parameter
+       to allow backends to alter the info on group selection.  Also alter all
+       the backend -request-group functions to take the parameter.
+
+       * nnimap.el (nnimap-store-info): New function.
+       (nnimap-update-info): Store the info for later usage.
+       (nnimap-request-group): Use the stored info for the dont-check case, so
+       that we don't retrieve all marks when we enter a group.
+
+       * nnimap.el: Use deffoo instead of defun for interface functions.
 
        * gnus-start.el (gnus-get-unread-articles): Allow the backends to
        update the group info.  This makes the nndraft groups, for instance, go
index c390ae0bcf2bda1dc0f426f807e2ddb661e6465b..b2ecb5cdf68e2a1bcbbf61db0ccea5e43ea2f1d2 100644 (file)
@@ -33,6 +33,7 @@
 
 (require 'gnus-art)
 (require 'mm-url)
+(require 'url)
 
 (defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/")
   "Where Gnus will cache images it downloads from the web."
@@ -253,6 +254,12 @@ fit these criteria."
        ((equal tag "IMG_ALT")
        (delete-region start end))
        ;; Whatever.  Just ignore the tag.
+       ((equal tag "b")
+        (gnus-overlay-put (gnus-make-overlay start end) 'face 'bold))
+       ((equal tag "U")
+        (gnus-overlay-put (gnus-make-overlay start end) 'face 'underline))
+       ((equal tag "i")
+        (gnus-overlay-put (gnus-make-overlay start end) 'face 'italic))
        (t
        ))
       (goto-char start))
@@ -290,42 +297,32 @@ fit these criteria."
 (defun gnus-html-schedule-image-fetching (buffer images)
   (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s"
                 buffer images)
-  (when (executable-find "curl")
-    (let* ((url (caar images))
-          (process (start-process
-                    "images" nil "curl"
-                    "-s" "--create-dirs"
-                    "--location"
-                    "--max-time" "60"
-                    "-o" (gnus-html-image-id url)
-                    (mm-url-decode-entities-string url))))
-      (gnus-set-process-query-on-exit-flag process nil)
-      (set-process-sentinel process 'gnus-html-curl-sentinel)
-      (gnus-set-process-plist process (list 'images images
-                                           'buffer buffer)))))
+  (dolist (image images)
+    (url-retrieve (car image)
+                  'gnus-html-image-fetched
+                  (list buffer image))))
 
 (defun gnus-html-image-id (url)
   (expand-file-name (sha1 url) gnus-html-cache-directory))
 
-(defun gnus-html-curl-sentinel (process event)
-  (when (string-match "finished" event)
-    (let* ((images (gnus-process-get process 'images))
-          (buffer (gnus-process-get process 'buffer))
-          (spec (pop images))
-          (file (gnus-html-image-id (car spec))))
-      (when (and (buffer-live-p buffer)
-                ;; If the position of the marker is 1, then that
-                ;; means that the text it was in has been deleted;
-                ;; i.e., that the user has selected a different
-                ;; article before the image arrived.
-                (not (= (marker-position (cadr spec)) (point-min))))
-       (with-current-buffer buffer
-         (let ((inhibit-read-only t)
-               (string (buffer-substring (cadr spec) (caddr spec))))
-           (delete-region (cadr spec) (caddr spec))
-           (gnus-html-put-image file (cadr spec) string))))
-      (when images
-       (gnus-html-schedule-image-fetching buffer images)))))
+(defun gnus-html-image-fetched (status buffer image)
+  (when (and (buffer-live-p buffer)
+             ;; If the position of the marker is 1, then that
+             ;; means that the text it was in has been deleted;
+             ;; i.e., that the user has selected a different
+             ;; article before the image arrived.
+             (not (= (marker-position (cadr image)) (point-min))))
+    (let ((file (gnus-html-image-id (car image))))
+      ;; Search the start of the image data
+      (search-forward "\n\n")
+      ;; Write region (image) silently
+      (write-region (point) (point-max) file nil 1)
+      (kill-buffer)
+      (with-current-buffer buffer
+        (let ((inhibit-read-only t)
+              (string (buffer-substring (cadr image) (caddr image))))
+          (delete-region (cadr image) (caddr image))
+          (gnus-html-put-image file (cadr image) string))))))
 
 (defun gnus-html-put-image (file point string &optional url alt-text)
   (when (gnus-graphic-display-p)
index 389b1a22a8bc565364d6728ca967c60797965f48..bcfc015c2df89768fd72f8ff83babb2485add238 100644 (file)
@@ -375,7 +375,7 @@ If it is down, start it up (again)."
   (funcall (gnus-get-function gnus-command-method 'request-compact)
           (nth 1 gnus-command-method)))
 
-(defun gnus-request-group (group &optional dont-check gnus-command-method)
+(defun gnus-request-group (group &optional dont-check gnus-command-method info)
   "Request GROUP.  If DONT-CHECK, no information is required."
   (let ((gnus-command-method
         (or gnus-command-method (inline (gnus-find-method-for-group group)))))
@@ -384,7 +384,8 @@ If it is down, start it up (again)."
            (inline (gnus-server-to-method gnus-command-method))))
     (funcall (inline (gnus-get-function gnus-command-method 'request-group))
             (gnus-group-real-name group) (nth 1 gnus-command-method)
-            dont-check)))
+            dont-check
+            info)))
 
 (defun gnus-list-active-group (group)
   "Request active information on GROUP."
index 84835428be216b108cbbe83a0bb7f6ec66f6d2a2..b421ceed6e5cb9fca6791fa63574865e922946ba 100644 (file)
@@ -1536,10 +1536,12 @@ If SCAN, request a scan of that group as well."
           t)
         (if (or debug-on-error debug-on-quit)
             (inline (gnus-request-group group (or dont-sub-check dont-check)
-                                        method))
+                                        method
+                                        (gnus-get-info group)))
           (condition-case nil
               (inline (gnus-request-group group (or dont-sub-check dont-check)
-                                          method))
+                                          method
+                                          (gnus-get-info group)))
             ;;(error nil)
             (quit
              (message "Quit activating %s" group)
index ccd4e890da7f6ae66b7d2c06874df8008a94b267..9f75b00bbca88d473fc70f0407fa2086a98e118b 100644 (file)
 (deffoo nnagent-request-expire-articles (articles group &optional server force)
   articles)
 
-(deffoo nnagent-request-group (group &optional server dont-check)
+(deffoo nnagent-request-group (group &optional server dont-check info)
   (nnoo-parent-function 'nnagent 'nnml-request-group
-                       (list group (nnagent-server server) dont-check)))
+                       (list group (nnagent-server server) dont-check info)))
 
 (deffoo nnagent-close-group (group &optional server)
   (nnoo-parent-function 'nnagent 'nnml-close-group
index 512de38559d61ffb9731a600a7097a7708c011a7..8f1f6ec7bc3ed0b56a173af195c0313adb186f61 100644 (file)
              (cons nnbabyl-current-group article)
            (nnbabyl-article-group-number)))))))
 
-(deffoo nnbabyl-request-group (group &optional server dont-check)
+(deffoo nnbabyl-request-group (group &optional server dont-check info)
   (let ((active (cadr (assoc group nnbabyl-group-alist))))
     (save-excursion
       (cond
index 790e390424e15df2c610a044e1980f1d0cd23e1c..7235e4b0332aa4e7c7165565038f2ddc9d5434b7 100644 (file)
@@ -482,7 +482,7 @@ all.  This may very well take some time.")
       (cons (if group-num (car group-num) group)
            (string-to-number (file-name-nondirectory path)))))))
 
-(deffoo nndiary-request-group (group &optional server dont-check)
+(deffoo nndiary-request-group (group &optional server dont-check info)
   (let ((file-name-coding-system nnmail-pathname-coding-system))
     (cond
      ((not (nndiary-possibly-change-directory group server))
index 2e492057003eca23ff39b15e98432d4d5735c34f..d6d455f078f171a6dab9a62abb408a591b7d08e2 100644 (file)
@@ -264,7 +264,7 @@ from the document.")
            (funcall nndoc-article-transform-function article))
          t))))))
 
-(deffoo nndoc-request-group (group &optional server dont-check)
+(deffoo nndoc-request-group (group &optional server dont-check info)
   "Select news GROUP."
   (let (number)
     (cond
index e92e00efe6f49698851e7d411117e58f99edb364..157c65da8d141e2daa9e0dd7d77f7bcc6410c0ae 100644 (file)
@@ -182,7 +182,7 @@ are generated if and only if they are also in `message-draft-headers'.")
       (add-hook hook 'nndraft-generate-headers nil t))
     article))
 
-(deffoo nndraft-request-group (group &optional server dont-check)
+(deffoo nndraft-request-group (group &optional server dont-check info)
   (nndraft-possibly-change-group group)
   (unless dont-check
     (let* ((pathname (nnmail-group-pathname group nndraft-directory))
index bd5bfba046826c56937bf87255abdb8c14fe0963..2de2dca82b93ef8cf75b731478c973785802be43 100644 (file)
@@ -144,7 +144,7 @@ included.")
             (insert "\n"))
           t))))
 
-(deffoo nneething-request-group (group &optional server dont-check)
+(deffoo nneething-request-group (group &optional server dont-check info)
   (nneething-possibly-change-directory group server)
   (unless dont-check
     (nneething-create-mapping)
index 5cebcb0e5fc90869778bfe5d70adab159667740c..1e0a950c40ee48779b8c6c390f3a439e6fc689fe 100644 (file)
@@ -289,7 +289,7 @@ the group.  Then the marks file will be regenerated properly by Gnus.")
                                      (point) (point-at-eol)))
                    -1))))))))
 
-(deffoo nnfolder-request-group (group &optional server dont-check)
+(deffoo nnfolder-request-group (group &optional server dont-check info)
   (nnfolder-possibly-change-group group server t)
   (save-excursion
     (cond ((not (assoc group nnfolder-group-alist))
index 1fc55f6b51b7376d8a256fac0465ed1b85e6f79c..601683e5941dc635e27260443df67c6f54eb9d1c 100644 (file)
@@ -67,6 +67,9 @@ This is always done if the server supports UID EXPUNGE, but it's
 not done by default on servers that doesn't support that command.")
 
 (defvoo nnimap-connection-alist nil)
+
+(defvoo nnimap-current-infos nil)
+
 (defvar nnimap-process nil)
 
 (defvar nnimap-status-string "")
@@ -75,7 +78,7 @@ not done by default on servers that doesn't support that command.")
   "Internal variable with default value for `nnimap-split-download-body'.")
 
 (defstruct nnimap
-  group process commands capabilities)
+  group process commands capabilities select-result newlinep)
 
 (defvar nnimap-object nil)
 
@@ -95,7 +98,7 @@ not done by default on servers that doesn't support that command.")
 (defun nnimap-buffer ()
   (nnimap-find-process-buffer nntp-server-buffer))
 
-(defun nnimap-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (when (nnimap-possibly-change-group group server)
@@ -171,7 +174,7 @@ not done by default on servers that doesn't support that command.")
         result))
       (mapconcat #'identity (nreverse result) ",")))))
 
-(defun nnimap-open-server (server &optional defs)
+(deffoo nnimap-open-server (server &optional defs)
   (if (nnimap-server-opened server)
       t
     (unless (assq 'nnimap-address defs)
@@ -203,55 +206,69 @@ not done by default on servers that doesn't support that command.")
                                  ?p port)))))
     process))
 
+(defun nnimap-credentials (address ports)
+  (let (port credentials)
+    ;; Request the credentials from all ports, but only query on the
+    ;; last port if all the previous ones have failed.
+    (while (and (null credentials)
+               (setq port (pop ports)))
+      (setq credentials
+           (auth-source-user-or-password
+            '("login" "password") address port nil (null ports))))
+    credentials))
+
 (defun nnimap-open-connection (buffer)
   (with-current-buffer (nnimap-make-process-buffer buffer)
     (let* ((coding-system-for-read 'binary)
           (coding-system-for-write 'binary)
-          (credentials
+          (ports
            (cond
             ((eq nnimap-stream 'network)
-             (open-network-stream "*nnimap*" (current-buffer) nnimap-address
-                                  (or nnimap-server-port
-                                      (if (netrc-find-service-number "imap")
-                                          "imap"
-                                        "143")))
-             (auth-source-user-or-password
-              '("login" "password") nnimap-address "imap" nil t))
-            ((eq nnimap-stream 'stream)
+             (open-network-stream
+              "*nnimap*" (current-buffer) nnimap-address
+              (or nnimap-server-port
+                  (if (netrc-find-service-number "imap")
+                      "imap"
+                    "143")))
+             '("143" "imap"))
+            ((eq nnimap-stream 'shell)
              (nnimap-open-shell-stream
               "*nnimap*" (current-buffer) nnimap-address
               (or nnimap-server-port "imap"))
-             (auth-source-user-or-password
-              '("login" "password") nnimap-address "imap" nil t))
+             '("imap"))
             ((eq nnimap-stream 'ssl)
-             (open-tls-stream "*nnimap*" (current-buffer) nnimap-address
-                              (or nnimap-server-port
-                                  (if (netrc-find-service-number "imaps")
-                                      "imaps"
-                                    "993")))
-             (or
-              (auth-source-user-or-password
-               '("login" "password") nnimap-address "imap")
-              (auth-source-user-or-password
-               '("login" "password") nnimap-address "imaps" nil t))))))
+             (open-tls-stream
+              "*nnimap*" (current-buffer) nnimap-address
+              (or nnimap-server-port
+                  (if (netrc-find-service-number "imaps")
+                      "imaps"
+                    "993")))
+             '("143" "993" "imap" "imaps"))))
+          connection-result login-result credentials)
       (setf (nnimap-process nnimap-object)
            (get-buffer-process (current-buffer)))
-      (unless credentials
-       (delete-process (nnimap-process nnimap-object)))
       (when (and (nnimap-process nnimap-object)
                 (memq (process-status (nnimap-process nnimap-object))
                       '(open run)))
        (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
-       (let ((result (nnimap-command "LOGIN %S %S"
-                                     (car credentials) (cadr credentials))))
-         (if (not (car result))
-             (progn
+       (when (setq connection-result (nnimap-wait-for-connection))
+         (unless (equal connection-result "PREAUTH")
+           (if (not (setq credentials
+                          (nnimap-credentials nnimap-address ports)))
+               (setq nnimap-object nil)
+             (setq login-result (nnimap-command "LOGIN %S %S"
+                                                (car credentials)
+                                                (cadr credentials)))
+             (unless (car login-result)
                (delete-process (nnimap-process nnimap-object))
-               nil)
+               (setq nnimap-object nil))))
+         (when nnimap-object
+           (when (eq nnimap-stream 'shell)
+             (setf (nnimap-newlinep nnimap-object) t))
            (setf (nnimap-capabilities nnimap-object)
                  (mapcar
                   #'upcase
-                  (or (nnimap-find-parameter "CAPABILITY" (cdr result))
+                  (or (nnimap-find-parameter "CAPABILITY" (cdr login-result))
                       (nnimap-find-parameter
                        "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
            (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
@@ -270,22 +287,22 @@ not done by default on servers that doesn't support that command.")
        (setq result (cdr (cadr elem))))))
     result))
 
-(defun nnimap-close-server (&optional server)
+(deffoo nnimap-close-server (&optional server)
   t)
 
-(defun nnimap-request-close ()
+(deffoo nnimap-request-close ()
   t)
 
-(defun nnimap-server-opened (&optional server)
+(deffoo nnimap-server-opened (&optional server)
   (and (nnoo-current-server-p 'nnimap server)
        nntp-server-buffer
        (gnus-buffer-live-p nntp-server-buffer)
        (nnimap-find-connection nntp-server-buffer)))
 
-(defun nnimap-status-message (&optional server)
+(deffoo nnimap-status-message (&optional server)
   nnimap-status-string)
 
-(defun nnimap-request-article (article &optional group server to-buffer)
+(deffoo nnimap-request-article (article &optional group server to-buffer)
   (with-current-buffer nntp-server-buffer
     (let ((result (nnimap-possibly-change-group group server)))
       (when (stringp article)
@@ -314,21 +331,46 @@ not done by default on servers that doesn't support that command.")
                (nnheader-ms-strip-cr))
              t)))))))
 
-(defun nnimap-request-group (group &optional server dont-check)
+(deffoo nnimap-request-group (group &optional server dont-check info)
   (with-current-buffer nntp-server-buffer
     (let ((result (nnimap-possibly-change-group group server))
-         articles)
+         articles active marks high low)
       (when result
-       (setq articles (nnimap-get-flags "1:*"))
-       (erase-buffer)
-       (insert
-        (format
-         "211 %d %d %d %S\n"
-         (length articles)
-         (or (caar articles) 0)
-         (or (caar (last articles)) 0)
-         group))
-       t))))
+       (if (and dont-check
+                (setq active (nth 2 (assoc group nnimap-current-infos))))
+           (insert (format "211 %d %d %d %S\n"
+                           (- (cdr active) (car active))
+                           (car active)
+                           (cdr active)
+                           group))
+         (with-current-buffer (nnimap-buffer)
+           (erase-buffer)
+           (let ((group-sequence
+                  (nnimap-send-command "SELECT %S" (utf7-encode group)))
+                 (flag-sequence
+                  (nnimap-send-command "UID FETCH 1:* FLAGS")))
+             (nnimap-wait-for-response flag-sequence)
+             (setq marks
+                   (nnimap-flags-to-marks
+                    (nnimap-parse-flags
+                     (list (list group-sequence flag-sequence 1 group)))))
+             (when info
+               (nnimap-update-infos marks (list info)))
+             (goto-char (point-max))
+             (cond
+              (marks
+               (setq high (nth 3 (car marks))
+                     low (nth 4 (car marks))))
+              ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t)
+               (setq high (string-to-number (match-string 1))
+                     low 1)))))
+         (erase-buffer)
+         (insert
+          (format
+           "211 %d %d %d %S\n"
+           (1+ (- high low))
+           low high group))))
+      t)))
 
 (defun nnimap-get-flags (spec)
   (let ((articles nil)
@@ -345,7 +387,7 @@ not done by default on servers that doesn't support that command.")
              articles)))
     (nreverse articles)))
 
-(defun nnimap-close-group (group &optional server)
+(deffoo nnimap-close-group (group &optional server)
   t)
 
 (deffoo nnimap-request-move-article (article group server accept-form
@@ -417,7 +459,7 @@ not done by default on servers that doesn't support that command.")
        (push flag flags)))
     flags))
 
-(defun nnimap-request-set-mark (group actions &optional server)
+(deffoo nnimap-request-set-mark (group actions &optional server)
   (when (nnimap-possibly-change-group group server)
     (let (sequence)
       (with-current-buffer (nnimap-buffer)
@@ -449,7 +491,10 @@ not done by default on servers that doesn't support that command.")
                        "APPEND %S {%d}" (utf7-encode group t)
                        (length message)))
        (process-send-string (get-buffer-process (current-buffer)) message)
-       (process-send-string (get-buffer-process (current-buffer)) "\r\n")
+       (process-send-string (get-buffer-process (current-buffer))
+                            (if (nnimap-newlinep nnimap-object)
+                                "\n"
+                              "\r\n"))
        (let ((result (nnimap-get-response sequence)))
          (when result
            (cons group
@@ -471,7 +516,7 @@ not done by default on servers that doesn't support that command.")
          (push (car (last line)) groups)))
       (nreverse groups))))
 
-(defun nnimap-request-list (&optional server)
+(deffoo nnimap-request-list (&optional server)
   (nnimap-possibly-change-group nil server)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
@@ -514,7 +559,7 @@ not done by default on servers that doesn't support that command.")
                                  (or highest exists)))))))))
        t))))
 
-(defun nnimap-retrieve-group-data-early (server infos)
+(deffoo nnimap-retrieve-group-data-early (server infos)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       ;; QRESYNC handling isn't implemented.
@@ -554,7 +599,7 @@ not done by default on servers that doesn't support that command.")
                    sequences))))
        sequences))))
 
-(defun nnimap-finish-retrieve-group-infos (server infos sequences)
+(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
   (when (and sequences
             (nnimap-possibly-change-group nil server))
     (with-current-buffer (nnimap-buffer)
@@ -601,9 +646,11 @@ not done by default on servers that doesn't support that command.")
          (when (> start-article 1)
            (setq read
                  (gnus-range-nconcat
-                  (gnus-sorted-range-intersection
-                   (cons 1 start-article)
-                   (gnus-info-read info))
+                  (if (> start-article 1)
+                      (gnus-sorted-range-intersection
+                       (cons 1 (1- start-article))
+                       (gnus-info-read info))
+                    (gnus-info-read info))
                   read)))
          (gnus-info-set-read info read)
          ;; Update the marks.
@@ -622,12 +669,20 @@ not done by default on servers that doesn't support that command.")
              (when (and old-marks
                         (> start-article 1))
                (setq old-marks (gnus-range-difference
-                                (cons start-article high)
-                                old-marks))
+                                old-marks
+                                (cons start-article high)))
                (setq new-marks (gnus-range-nconcat old-marks new-marks)))
              (when new-marks
                (push (cons (car type) new-marks) marks)))
-           (gnus-info-set-marks info marks)))))))
+           (gnus-info-set-marks info marks t)
+           (nnimap-store-info info (gnus-active group))))))))
+
+(defun nnimap-store-info (info active)
+  (let* ((group (gnus-group-real-name (gnus-info-group info)))
+        (entry (assoc group nnimap-current-infos)))
+    (if entry
+       (setcdr entry (list info active))
+      (push (list group info active) nnimap-current-infos))))
 
 (defun nnimap-flags-to-marks (groups)
   (let (data group totalp uidnext articles start-article mark)
@@ -681,7 +736,7 @@ not done by default on servers that doesn't support that command.")
 (defun nnimap-find-process-buffer (buffer)
   (cadr (assoc buffer nnimap-connection-alist)))
 
-(defun nnimap-request-post (&optional server)
+(deffoo nnimap-request-post (&optional server)
   (setq nnimap-status-string "Read-only server")
   nil)
 
@@ -701,7 +756,8 @@ not done by default on servers that doesn't support that command.")
            t
          (let ((result (nnimap-command "SELECT %S" (utf7-encode group t))))
            (when (car result)
-             (setf (nnimap-group nnimap-object) group)
+             (setf (nnimap-group nnimap-object) group
+                   (nnimap-select-result nnimap-object) result)
              result))))))))
 
 (defun nnimap-find-connection (buffer)
@@ -722,9 +778,12 @@ not done by default on servers that doesn't support that command.")
   (process-send-string
    (get-buffer-process (current-buffer))
    (nnimap-log-command
-    (format "%d %s\r\n"
+    (format "%d %s%s\n"
            (incf nnimap-sequence)
-           (apply #'format args))))
+           (apply #'format args)
+           (if (nnimap-newlinep nnimap-object)
+               ""
+             "\r"))))
   nnimap-sequence)
 
 (defun nnimap-log-command (command)
@@ -747,12 +806,22 @@ not done by default on servers that doesn't support that command.")
   (nnimap-wait-for-response sequence)
   (nnimap-parse-response))
 
+(defun nnimap-wait-for-connection ()
+  (let ((process (get-buffer-process (current-buffer))))
+    (goto-char (point-min))
+    (while (and (memq (process-status process)
+                     '(open run))
+               (not (re-search-forward "^\\* " nil t)))
+      (nnheader-accept-process-output process)
+      (goto-char (point-min)))
+    (and (looking-at "[A-Z0-9]+")
+        (match-string 0))))
+
 (defun nnimap-wait-for-response (sequence &optional messagep)
   (goto-char (point-max))
-  (while (or (bobp)
-            (progn
-              (forward-line -1)
-              (not (looking-at (format "^%d .*\n" sequence)))))
+  (while (not (re-search-backward (format "^%d .*\n" sequence)
+                                 (max (point-min) (- (point) 500))
+                                 t))
     (when messagep
       (message "Read %dKB" (/ (buffer-size) 1000)))
     (nnheader-accept-process-output (get-buffer-process (current-buffer)))
index 27610e7aba2f81a16f9eb82ff4810ef630e0e58b..a826b5be7915ddb20fec3e7c7afb197531d5ff20 100644 (file)
@@ -733,7 +733,7 @@ and show thread that contains this article."
   ;; Just set the server variables appropriately.
   (nnoo-change-server 'nnir server definitions))
 
-(deffoo nnir-request-group (group &optional server fast)
+(deffoo nnir-request-group (group &optional server fast info)
   "GROUP is the query string."
   (nnir-possibly-change-server server)
   ;; Check for cache and return that if appropriate.
index b79e7103cef0877ca83a65e29c375d193b4f826f..5b50ddb4b9931329592c993b3087433b4471131c 100644 (file)
@@ -983,7 +983,7 @@ by nnmaildir-request-article.")
       (setf (nnmaildir--grp-mmth group) new-mmth)
       info)))
 
-(defun nnmaildir-request-group (gname &optional server fast)
+(defun nnmaildir-request-group (gname &optional server fast info)
   (let ((group (nnmaildir--prepare server gname))
        deactivate-mark)
     (catch 'return
index b43a83e3a3355c36010aff6c98cfbcf962683bb4..26d95b21eb3ce891602ccb91f491a015bea7c77c 100644 (file)
@@ -424,7 +424,7 @@ Other back ends might or might not work.")
   (setq nnmairix-current-server server)
   (nnoo-change-server 'nnmairix server definitions))
 
-(deffoo nnmairix-request-group (group &optional server fast)
+(deffoo nnmairix-request-group (group &optional server fast info)
   ;; Call mairix and request group on back end server
   (when server (nnmairix-open-server server))
   (let* ((qualgroup (if server
index 4b01bfa5c6e4c80b71a86c7329fed9496135b6ef..bc5c01e51ad22be278d814385fe7f33cb09bfb89 100644 (file)
              (cons nnmbox-current-group article)
            (nnmbox-article-group-number nil)))))))
 
-(deffoo nnmbox-request-group (group &optional server dont-check)
+(deffoo nnmbox-request-group (group &optional server dont-check info)
   (nnmbox-possibly-change-newsgroup nil server)
   (let ((active (cadr (assoc group nnmbox-group-alist))))
     (cond
index 131861e03ecc33fd7d40eea2dd593a5e04073937..cdd540a993b6f8149d2d3aab0ba49ab0e5d503bd 100644 (file)
@@ -149,7 +149,7 @@ as unread by Gnus.")
         (save-excursion (nnmail-find-file file))
         (string-to-number (file-name-nondirectory file)))))
 
-(deffoo nnmh-request-group (group &optional server dont-check)
+(deffoo nnmh-request-group (group &optional server dont-check info)
   (nnheader-init-server-buffer)
   (nnmh-possibly-change-directory group server)
   (let ((pathname (nnmail-group-pathname group nnmh-directory))
index 5d62192819ec12581a3b2c8c2392a7d9a42f184c..8fca41eb4d294d07f3e2e5950a8b184eaba0f119 100644 (file)
@@ -254,7 +254,7 @@ non-nil.")
       (cons (if group-num (car group-num) group)
            (string-to-number (file-name-nondirectory path)))))))
 
-(deffoo nnml-request-group (group &optional server dont-check)
+(deffoo nnml-request-group (group &optional server dont-check info)
   (let ((file-name-coding-system nnmail-pathname-coding-system)
        (decoded (nnml-decoded-group-name group server)))
     (cond
index dd5e9841c15221dce2b3ae2f4b40b942d1c1501e..e40126d6e0d0c8eba96ca8373c604230bb23e962 100644 (file)
@@ -56,7 +56,7 @@
   (setq nnnil-status-string "No such group")
   nil)
 
-(defun nnnil-request-group (group &optional server fast)
+(defun nnnil-request-group (group &optional server fast info)
   (let (deactivate-mark)
     (with-current-buffer nntp-server-buffer
       (erase-buffer)
index f241e5b175b50ec2b9a58bcf6fd94b1d29a67be5..f93d811068d11d9193567a7c2b317f1a16742456 100644 (file)
@@ -178,7 +178,7 @@ used to render text.  If it is nil, text will simply be folded.")
                    "\n")))))
   'nov)
 
-(deffoo nnrss-request-group (group &optional server dont-check)
+(deffoo nnrss-request-group (group &optional server dont-check info)
   (setq group (nnrss-decode-group-name group))
   (nnheader-message 6 "nnrss: Requesting %s..." group)
   (nnrss-possibly-change-group group server)
index ee1e36f55c7c2f0808c75531a4388475857a4db7..35987277b3d312e5d04cb275ab0bc04d71153d52 100644 (file)
@@ -226,7 +226,7 @@ there.")
        (nnheader-fold-continuation-lines)))
     res))
 
-(deffoo nnspool-request-group (group &optional server dont-check)
+(deffoo nnspool-request-group (group &optional server dont-check info)
   "Select news GROUP."
   (let ((pathname (nnspool-article-pathname group))
        dir)
index 59f803d8c6a0db2549481984d9098038b944360b..50f11ad24f7fe5480a7d756a93e904d078b21a86 100644 (file)
@@ -987,7 +987,7 @@ command whose response triggered the error."
     "\r?\n\\.\r?\n" "BODY"
     (if (numberp article) (int-to-string article) article))))
 
-(deffoo nntp-request-group (group &optional server dont-check)
+(deffoo nntp-request-group (group &optional server dont-check info)
   (nntp-with-open-group
     nil server
     (when (nntp-send-command "^[245].*\n" "GROUP" group)
index 18faa23a80ea55a703324b0b7dac5d48f85f3434..88ff852e8545786b8b7e7cfff0b6a47dcd61282c 100644 (file)
@@ -247,7 +247,7 @@ component group will show up when you enter the virtual group.")
       t)))
 
 
-(deffoo nnvirtual-request-group (group &optional server dont-check)
+(deffoo nnvirtual-request-group (group &optional server dont-check info)
   (nnvirtual-possibly-change-server server)
   (setq nnvirtual-component-groups
        (delete (nnvirtual-current-group) nnvirtual-component-groups))
index e6289c57bca16767b15d944ab3524a35b220d7c2..fceb2a387aaa9e5ce4904343fe1832a0e4db535a 100644 (file)
@@ -124,7 +124,7 @@ Valid types include `google', `dejanews', and `gmane'.")
     (nnweb-write-active)
     (nnweb-write-overview group)))
 
-(deffoo nnweb-request-group (group &optional server dont-check)
+(deffoo nnweb-request-group (group &optional server dont-check info)
   (nnweb-possibly-change-server group server)
   (unless (or nnweb-ephemeral-p
              dont-check