From 286c4fc2a9d08ee184cda096760ad3e8c7cf0989 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Sat, 18 Sep 2010 23:36:29 +0000 Subject: [PATCH] Merge changes made in Gnus trunk. 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. --- lisp/gnus/ChangeLog | 63 +++++++++++- lisp/gnus/gnus-html.el | 61 ++++++------ lisp/gnus/gnus-int.el | 5 +- lisp/gnus/gnus-start.el | 6 +- lisp/gnus/nnagent.el | 4 +- lisp/gnus/nnbabyl.el | 2 +- lisp/gnus/nndiary.el | 2 +- lisp/gnus/nndoc.el | 2 +- lisp/gnus/nndraft.el | 2 +- lisp/gnus/nneething.el | 2 +- lisp/gnus/nnfolder.el | 2 +- lisp/gnus/nnimap.el | 207 ++++++++++++++++++++++++++-------------- lisp/gnus/nnir.el | 2 +- lisp/gnus/nnmaildir.el | 2 +- lisp/gnus/nnmairix.el | 2 +- lisp/gnus/nnmbox.el | 2 +- lisp/gnus/nnmh.el | 2 +- lisp/gnus/nnml.el | 2 +- lisp/gnus/nnnil.el | 2 +- lisp/gnus/nnrss.el | 2 +- lisp/gnus/nnspool.el | 2 +- lisp/gnus/nntp.el | 2 +- lisp/gnus/nnvirtual.el | 2 +- lisp/gnus/nnweb.el | 2 +- 24 files changed, 256 insertions(+), 126 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 25e17538730..a7d29366cb7 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,6 +1,67 @@ +2010-09-18 Julien Danjou + + * gnus-html.el (gnus-html-schedule-image-fetching): Fetch all images in + parallel. + +2010-09-18 Lars Magne Ingebrigtsen + + * 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 + + * gnus-html.el (gnus-html-schedule-image-fetching): Use `url' rather + than curl to retrieve images. + +2010-09-18 Lars Magne Ingebrigtsen + + * 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 + + * gnus-html.el (gnus-html-wash-tags): Add support for i, b and u HTML + tags. + 2010-09-18 Lars Magne Ingebrigtsen - * 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 diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index c390ae0bcf2..b2ecb5cdf68 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -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) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 389b1a22a8b..bcfc015c2df 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -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." diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 84835428be2..b421ceed6e5 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -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) diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index ccd4e890da7..9f75b00bbca 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -190,9 +190,9 @@ (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 diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 512de38559d..8f1f6ec7bc3 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -191,7 +191,7 @@ (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 diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 790e390424e..7235e4b0332 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -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)) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 2e492057003..d6d455f078f 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -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 diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index e92e00efe6f..157c65da8d1 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -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)) diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index bd5bfba0468..2de2dca82b9 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -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) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 5cebcb0e5fc..1e0a950c40e 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -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)) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 1fc55f6b51b..601683e5941 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -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))) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 27610e7aba2..a826b5be791 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -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. diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index b79e7103cef..5b50ddb4b99 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -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 diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index b43a83e3a33..26d95b21eb3 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -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 diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el index 4b01bfa5c6e..bc5c01e51ad 100644 --- a/lisp/gnus/nnmbox.el +++ b/lisp/gnus/nnmbox.el @@ -172,7 +172,7 @@ (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 diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index 131861e03ec..cdd540a993b 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -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)) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 5d62192819e..8fca41eb4d2 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -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 diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el index dd5e9841c15..e40126d6e0d 100644 --- a/lisp/gnus/nnnil.el +++ b/lisp/gnus/nnnil.el @@ -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) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index f241e5b175b..f93d811068d 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -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) diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index ee1e36f55c7..35987277b3d 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -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) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 59f803d8c6a..50f11ad24f7 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -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) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 18faa23a80e..88ff852e854 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -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)) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index e6289c57bca..fceb2a387aa 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -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 -- 2.39.2