mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-23 07:19:15 +00:00
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.
This commit is contained in:
Lars Magne Ingebrigtsen
Katsumi Yamaoka
parent
77413977a3
commit
286c4fc2a9
@ -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: Require nnoo and other files necessary.
|
||||
* 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 (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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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."
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user