Commit 9f2d52e7 authored by Gnus developers's avatar Gnus developers Committed by Katsumi Yamaoka
Browse files

Merge changes made in Gnus trunk.

sieve-manage.el (sieve-manage-default-stream): Make default stream customizable.
nnimap.el (nnimap-request-accept-article): Send a "." at the end, which may or may not help.
nnimap.el (nnimap-open-connection): Have the `network' nnimap connection use STARTTLS opportunistically.
gnus-sum.el (gnus-summary-insert-new-articles): Copy the old-high watermark so that nothing alters it while scanning for new messages.
nnimap.el (nnimap-request-accept-article): Remove the "." at the end, since some servers don't like it.
nnimap.el (nnimap-open-connection): Forget credentials if the server says the password was wrong.
nnimap.el (nnimap-parse-line): Protect against invalid data.
gnus-art.el, gnus-sum.el, nnimap.el: Allow setting the partial fetch per server instead of globally.
message.el (message-cite-prefix-regexp): Revert last edit.
nnmairix.el: Make it work with latest changes in nnimap.
gnus-sum.el (gnus-summary-move-article): Don't alter gnus-newsgroup-active.
gnus-sum.el (gnus-summary-exit): Kill the article buffer later, so that you don't get flashes of other buffers.
nnimap.el: Fix up partial nnimap fetching.
gnus-sum.el: Rework the `/ N' based on the new gnus-newsgroup-highest variable.
parent 8ea189f7
2010-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-sum.el (gnus-summary-read-group-1): Set gnus-newsgroup-highest.
(gnus-summary-insert-new-articles): Use gnus-newsgroup-highest to get
new articles.
* nnimap.el (nnimap-request-article): Don't partial-fetch single-part
parts.
(nnimap-request-article): Work with the t setting, too.
* gnus-sum.el (gnus-summary-exit): Kill the article buffer later, so
that you don't get flashes of other buffers.
(gnus-summary-show-complete-article): Intern before setting.
2010-09-27 David Engster <dengste@eml.cc>
* nnmairix.el: (nnmairix-replace-group-and-numbers): Deal with NOV as
well as HEADERS.
(nnmairix-retrieve-headers): Provide new argument for the above.
2010-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-sum.el (gnus-summary-move-article): Don't alter
gnus-newsgroup-active. This makes `/ N' work after copying to the same
group.
* nnimap.el (nnimap-update-info): Don't destructively alter active.
* message.el (message-cite-prefix-regexp): Revert my last edit.
* gnus-sum.el (gnus-summary-show-complete-article): Bind the server
variable instead of the Gnus variable.
* nnimap.el (nnimap-find-wanted-parts-1): Use it.
* gnus-art.el (gnus-fetch-partial-articles): Moved back to nnimap
again.
* nnimap.el (nnimap-request-accept-article): Remove the "." at the end,
since some servers don't like it.
(nnimap-open-connection): Forget credentials if the server says the
password was wrong.
(nnimap-parse-line): Protect against invalid data.
* gnus-sum.el (gnus-summary-move-article): Add comment.
(gnus-summary-insert-new-articles): Copy the old-high watermark so that
nothing alters it while scanning for new messages.
* nnimap.el (nnimap-request-accept-article): Send a "." at the end,
which may or may not help.
(nnimap-open-connection): If we're doing a stream connection, and then
discover we're on a STARTTLS-capable server, then open a STARTTLS
connection instead.
2010-09-27 Florian Ragwitz <rafl@debian.org> (tiny change)
* sieve-manage.el (sieve-manage-default-stream): Make default stream
customizable.
2010-09-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
 
* nnimap.el (utf7): Required.
......@@ -18,7 +77,7 @@
 
* gnus-art.el (gnus-mime-delete-part): Fix Lisp type of byte(s).
 
2010-09-26 Florian Ragwitz <rafl@debian.org>
2010-09-26 Florian Ragwitz <rafl@debian.org> (tiny change)
 
* gnus-html.el (gnus-html-wash-tags): Decode URL entities to avoid
handing broken links to browse-url.
......
......@@ -257,22 +257,6 @@ This can also be a list of the above values."
(regexp :value ".*"))
:group 'gnus-article-signature)
(defcustom gnus-fetch-partial-articles nil
"If non-nil, Gnus will fetch partial articles.
If t, nnimap will fetch only the first part. If a string, it
will fetch all parts that have types that match that string. A
likely value would be \"text/\" to automatically fetch all
textual parts.
Currently only the nnimap backend actually supports partial
article fetching. If the backend doesn't support it, it has no
effect."
:version "24.1"
:type '(choice (const nil)
(const t)
(regexp))
:group 'gnus-article)
(defcustom gnus-hidden-properties '(invisible t intangible t)
"Property list to use for hiding text."
:type 'sexp
......
......@@ -1431,6 +1431,7 @@ the type of the variable (string, integer, character, etc).")
(defvar gnus-newsgroup-last-directory nil)
(defvar gnus-newsgroup-auto-expire nil)
(defvar gnus-newsgroup-active nil)
(defvar gnus-newsgroup-highest nil)
(defvar gnus-newsgroup-data nil)
(defvar gnus-newsgroup-data-reverse nil)
......@@ -1582,6 +1583,7 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
(gnus-summary-mark-below . global)
(gnus-orphan-score . global)
gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-highest
gnus-newsgroup-history gnus-newsgroup-ancient
gnus-newsgroup-sparse gnus-newsgroup-process-stack
(gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
......@@ -3957,6 +3959,7 @@ If NO-DISPLAY, don't generate a summary buffer."
(setq gnus-newsgroup-active
(gnus-copy-sequence
(gnus-active gnus-newsgroup-name)))
(setq gnus-newsgroup-highest (cdr gnus-newsgroup-active))
;; You can change the summary buffer in some way with this hook.
(gnus-run-hooks 'gnus-select-group-hook)
(when (memq 'summary (gnus-update-format-specifications
......@@ -7090,15 +7093,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(when gnus-use-scoring
(gnus-score-save)))
(gnus-run-hooks 'gnus-summary-prepare-exit-hook)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
;; Don't kill sticky article buffers
(unless (eq major-mode 'gnus-sticky-article-mode)
(gnus-kill-buffer gnus-article-buffer)
(setq gnus-article-current nil))))
(gnus-kill-buffer gnus-original-article-buffer))
(when gnus-use-cache
(gnus-cache-possibly-remove-articles)
(gnus-cache-save-buffers))
......@@ -7147,6 +7141,17 @@ If FORCE (the prefix), also save the .newsrc file(s)."
;; Return to group mode buffer.
(when (eq mode 'gnus-summary-mode)
(gnus-kill-buffer buf)))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(when (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
;; Don't kill sticky article buffers
(unless (eq major-mode 'gnus-sticky-article-mode)
(gnus-kill-buffer gnus-article-buffer)
(setq gnus-article-current nil))))
(gnus-kill-buffer gnus-original-article-buffer))
(setq gnus-current-select-method gnus-select-method)
(set-buffer gnus-group-buffer)
(if quit-config
......@@ -9360,9 +9365,19 @@ article currently."
(let ((gnus-keep-backlog nil)
(gnus-use-cache nil)
(gnus-agent nil)
(gnus-fetch-partial-articles nil))
(gnus-flush-original-article-buffer)
(gnus-summary-show-article)))
(variable (intern
(format "%s-fetch-partial-articles"
(car (gnus-find-method-for-group
gnus-newsgroup-name)))
obarray))
old-val)
(unwind-protect
(progn
(setq old-val (symbol-value variable))
(set variable nil)
(gnus-flush-original-article-buffer)
(gnus-summary-show-article))
(set variable old-val))))
(defun gnus-summary-show-article (&optional arg)
"Force redisplaying of the current article.
......@@ -9797,8 +9812,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
(not (memq article gnus-newsgroup-unreads)))
;; Mark this article as read in this group.
(push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
;; Increase the active status of this group.
(setcdr (gnus-active to-group) to-article)
(setcdr gnus-newsgroup-active to-article))
(setcdr gnus-newsgroup-active to-article))
(while marks
(when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
......@@ -12624,13 +12640,15 @@ If ALL is a number, fetch this number of articles."
(interactive)
(prog1
(let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
(old-active gnus-newsgroup-active)
(old-high gnus-newsgroup-highest)
(nnmail-fetched-sources (list t))
i new)
(setq gnus-newsgroup-active
(gnus-activate-group gnus-newsgroup-name 'scan))
(setq i (cdr gnus-newsgroup-active))
(while (> i (cdr old-active))
(gnus-copy-sequence
(gnus-activate-group gnus-newsgroup-name 'scan)))
(setq i (cdr gnus-newsgroup-active)
gnus-newsgroup-highest i)
(while (> i old-high)
(push i new)
(decf i))
(if (not new)
......
......@@ -85,6 +85,13 @@ some servers.")
(defvoo nnimap-current-infos nil)
(defvoo nnimap-fetch-partial-articles nil
"If non-nil, Gnus will fetch partial articles.
If t, nnimap will fetch only the first part. If a string, it
will fetch all parts that have types that match that string. A
likely value would be \"text/\" to automatically fetch all
textual parts.")
(defvar nnimap-process nil)
(defvar nnimap-status-string "")
......@@ -271,91 +278,110 @@ some servers.")
(unless nnimap-keepalive-timer
(setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
'nnimap-keepalive)))
(with-current-buffer (nnimap-make-process-buffer buffer)
(let* ((coding-system-for-read 'binary)
(coding-system-for-write 'binary)
(port nil)
(ports
(cond
((eq nnimap-stream 'network)
(open-network-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port
(or nnimap-server-port
(if (netrc-find-service-number "imap")
"imap"
"143"))))
'("143" "imap"))
((eq nnimap-stream 'shell)
(nnimap-open-shell-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port (or nnimap-server-port "imap")))
'("imap"))
((eq nnimap-stream 'starttls)
(starttls-open-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port (or nnimap-server-port "imap")))
'("imap"))
((eq nnimap-stream 'ssl)
(open-tls-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port
(or nnimap-server-port
(if (netrc-find-service-number "imaps")
"imaps"
"993"))))
'("143" "993" "imap" "imaps"))))
connection-result login-result credentials)
(setf (nnimap-process nnimap-object)
(get-buffer-process (current-buffer)))
(if (not (and (nnimap-process nnimap-object)
(memq (process-status (nnimap-process nnimap-object))
'(open run))))
(nnheader-report 'nnimap "Unable to contact %s:%s via %s"
nnimap-address port nnimap-stream)
(gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
(if (not (setq connection-result (nnimap-wait-for-connection)))
(nnheader-report 'nnimap
"%s" (buffer-substring
(point) (line-end-position)))
(setf (nnimap-greeting nnimap-object)
(buffer-substring (line-beginning-position)
(line-end-position)))
(when (eq nnimap-stream 'starttls)
(nnimap-command "STARTTLS")
(starttls-negotiate (nnimap-process nnimap-object)))
(when nnimap-server-port
(push (format "%s" nnimap-server-port) ports))
(unless (equal connection-result "PREAUTH")
(if (not (setq credentials
(if (eq nnimap-authenticator 'anonymous)
(list "anonymous"
(message-make-address))
(or
;; First look for the credentials based
;; on the virtual server name.
(nnimap-credentials
(nnoo-current-server 'nnimap) ports t)
;; Then look them up based on the
;; physical address.
(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))
(setq nnimap-object nil))))
(when nnimap-object
(block nil
(with-current-buffer (nnimap-make-process-buffer buffer)
(let* ((coding-system-for-read 'binary)
(coding-system-for-write 'binary)
(port nil)
(ports
(cond
((eq nnimap-stream 'network)
(open-network-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port
(or nnimap-server-port
(if (netrc-find-service-number "imap")
"imap"
"143"))))
'("143" "imap"))
((eq nnimap-stream 'shell)
(nnimap-open-shell-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port (or nnimap-server-port "imap")))
'("imap"))
((eq nnimap-stream 'starttls)
(starttls-open-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port (or nnimap-server-port "imap")))
'("imap"))
((eq nnimap-stream 'ssl)
(open-tls-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port
(or nnimap-server-port
(if (netrc-find-service-number "imaps")
"imaps"
"993"))))
'("143" "993" "imap" "imaps"))))
connection-result login-result credentials)
(setf (nnimap-process nnimap-object)
(get-buffer-process (current-buffer)))
(if (not (and (nnimap-process nnimap-object)
(memq (process-status (nnimap-process nnimap-object))
'(open run))))
(nnheader-report 'nnimap "Unable to contact %s:%s via %s"
nnimap-address port nnimap-stream)
(gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
(if (not (setq connection-result (nnimap-wait-for-connection)))
(nnheader-report 'nnimap
"%s" (buffer-substring
(point) (line-end-position)))
;; Store the greeting (for debugging purposes).
(setf (nnimap-greeting nnimap-object)
(buffer-substring (line-beginning-position)
(line-end-position)))
;; Store the capabilities.
(setf (nnimap-capabilities nnimap-object)
(mapcar
#'upcase
(or (nnimap-find-parameter "CAPABILITY" (cdr login-result))
(nnimap-find-parameter
"CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
(when (member "QRESYNC" (nnimap-capabilities nnimap-object))
(nnimap-command "ENABLE QRESYNC"))
t))))))
(nnimap-find-parameter
"CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
(when (eq nnimap-stream 'starttls)
(nnimap-command "STARTTLS")
(starttls-negotiate (nnimap-process nnimap-object)))
;; If this is a STARTTLS-capable server, then sever the
;; connection and start a STARTTLS connection instead.
(when (and (eq nnimap-stream 'network)
(member "STARTTLS" (nnimap-capabilities nnimap-object)))
(let ((nnimap-stream 'starttls))
(delete-process (nnimap-process nnimap-object))
(kill-buffer (current-buffer))
(return
(nnimap-open-connection buffer))))
(when nnimap-server-port
(push (format "%s" nnimap-server-port) ports))
(unless (equal connection-result "PREAUTH")
(if (not (setq credentials
(if (eq nnimap-authenticator 'anonymous)
(list "anonymous"
(message-make-address))
(or
;; First look for the credentials based
;; on the virtual server name.
(nnimap-credentials
(nnoo-current-server 'nnimap) ports t)
;; Then look them up based on the
;; physical address.
(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)
;; If the login failed, then forget the credentials
;; that are now possibly cached.
(dolist (host (list (nnoo-current-server 'nnimap)
nnimap-address))
(dolist (port ports)
(dolist (element '("login" "password"))
(auth-source-forget-user-or-password
element host port))))
(delete-process (nnimap-process nnimap-object))
(setq nnimap-object nil))))
(when nnimap-object
(when (member "QRESYNC" (nnimap-capabilities nnimap-object))
(nnimap-command "ENABLE QRESYNC"))
t)))))))
(defun nnimap-find-parameter (parameter elems)
(let (result)
......@@ -395,14 +421,12 @@ some servers.")
(erase-buffer)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(when gnus-fetch-partial-articles
(if (eq gnus-fetch-partial-articles t)
(setq parts '(1))
(nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
(goto-char (point-min))
(when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
(setq structure (ignore-errors (read (current-buffer)))
parts (nnimap-find-wanted-parts structure)))))
(when nnimap-fetch-partial-articles
(nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
(goto-char (point-min))
(when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
(setq structure (ignore-errors (read (current-buffer)))
parts (nnimap-find-wanted-parts structure))))
(when (if parts
(nnimap-get-partial-article article parts structure)
(nnimap-get-whole-article article))
......@@ -525,7 +549,9 @@ some servers.")
(number-to-string num)
(format "%s.%s" prefix num))))
(setcar (nthcdr 9 sub) id)
(when (string-match gnus-fetch-partial-articles type)
(when (if (eq nnimap-fetch-partial-articles t)
(equal id "1")
(string-match nnimap-fetch-partial-articles type))
(push id parts))))
(incf num)))
(nreverse parts)))
......@@ -941,7 +967,10 @@ some servers.")
(t
;; No articles and no uidnext.
nil)))
(setcdr (gnus-active group) (or high (1- uidnext))))
(gnus-set-active
group
(cons (car (gnus-active group))
(or high (1- uidnext)))))
(when (and (not high)
uidnext)
(setq high (1- uidnext)))
......@@ -1193,13 +1222,18 @@ some servers.")
(cond
((eql char ?\[)
(split-string (buffer-substring
(1+ (point)) (1- (search-forward "]")))))
(1+ (point))
(1- (search-forward "]" (line-end-position) 'move)))))
((eql char ?\()
(split-string (buffer-substring
(1+ (point)) (1- (search-forward ")")))))
(1+ (point))
(1- (search-forward ")" (line-end-position) 'move)))))
((eql char ?\")
(forward-char 1)
(buffer-substring (point) (1- (search-forward "\""))))
(buffer-substring
(point)
(1- (or (search-forward "\"" (line-end-position) 'move)
(point)))))
(t
(buffer-substring (point) (if (search-forward " " nil t)
(1- (point))
......
......@@ -562,9 +562,8 @@ Other back ends might or might not work.")
"retrieve-headers" articles folder nnmairix-backend-server fetch-old))
(nnmairix-call-backend
"retrieve-headers" articles folder nnmairix-backend-server fetch-old)))
(when (eq rval 'nov)
(nnmairix-replace-group-and-numbers articles folder group numcorr)
rval)))
(nnmairix-replace-group-and-numbers articles folder group numcorr rval)
rval))
(deffoo nnmairix-request-article (article &optional group server to-buffer)
(when server (nnmairix-open-server server))
......@@ -1413,43 +1412,55 @@ nnmairix with nnml backends."
(setq cur lastplusone))
(setq lastplusone (1+ cur)))))
(defun nnmairix-replace-group-and-numbers (articles backendgroup mairixgroup numc)
(defun nnmairix-replace-group-and-numbers (articles backendgroup mairixgroup numc type)
"Replace folder names in Xref header and correct article numbers.
Do this for all ARTICLES on BACKENDGROUP. Replace using
MAIRIXGROUP. NUMC contains values for article number correction."
(let ((buf (get-buffer-create " *nnmairix buffer*"))
(corr (not (zerop numc)))
(name (buffer-name nntp-server-buffer))
header cur xref)
(with-current-buffer buf
(erase-buffer)
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(nnheader-message 7 "nnmairix: Rewriting headers...")
(mapc
(lambda (article)
(when (or (looking-at (number-to-string article))
(nnheader-find-nov-line article))
(setq cur (nnheader-parse-nov))
(when corr
(setq article (+ (mail-header-number cur) numc))
(mail-header-set-number cur article))
(setq xref (mail-header-xref cur))
(when (and (stringp xref)
(string-match (format "[ \t]%s:[0-9]+" backendgroup) xref))
(setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref))
(mail-header-set-xref cur xref))
(set-buffer buf)
(nnheader-insert-nov cur)
(set-buffer nntp-server-buffer)
(when (not (eobp))
(forward-line 1))))
articles)
(nnheader-message 7 "nnmairix: Rewriting headers... done")
(kill-buffer nntp-server-buffer)
(set-buffer buf)
(rename-buffer name)
(setq nntp-server-buffer buf))))
MAIRIXGROUP. NUMC contains values for article number correction.
TYPE is either 'nov or 'headers."
(nnheader-message 7 "nnmairix: Rewriting headers...")
(cond
((eq type 'nov)
(let ((buf (get-buffer-create " *nnmairix buffer*"))
(corr (not (zerop numc)))
(name (buffer-name nntp-server-buffer))
header cur xref)
(with-current-buffer buf
(erase-buffer)
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(mapc
(lambda (article)
(when (or (looking-at (number-to-string article))
(nnheader-find-nov-line article))
(setq cur (nnheader-parse-nov))
(when corr
(setq article (+ (mail-header-number cur) numc))
(mail-header-set-number cur article))
(setq xref (mail-header-xref cur))
(when (and (stringp xref)
(string-match (format "[ \t]%s:[0-9]+" backendgroup) xref))
(setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref))
(mail-header-set-xref cur xref))
(set-buffer buf)
(nnheader-insert-nov cur)
(set-buffer nntp-server-buffer)
(when (not (eobp))
(forward-line 1))))
articles)
(kill-buffer nntp-server-buffer)
(set-buffer buf)
(rename-buffer name)
(setq nntp-server-buffer buf))))
((and (eq type 'headers)
(not (zerop numc)))
(with-current-buffer nntp-server-buffer
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^[23][0-9]+ \\([0-9]+\\)" nil t)
(replace-match (number-to-string
(+ (string-to-number (match-string 1)) numc))
t t nil 1))))))
(nnheader-message 7 "nnmairix: Rewriting headers... done"))
(defun nnmairix-backend-to-server (server)
"Return nnmairix server most probably responsible for back end SERVER.
......
......@@ -162,6 +162,12 @@ for doing the actual authentication."
:type 'integer
:group 'sieve-manage)
(defcustom sieve-manage-default-stream 'network
"Default stream type to use for `sieve-manage'.
Must be a name of a stream in `sieve-manage-stream-alist'."
:type 'symbol
:group 'sieve-manage)
;; Internal variables:
(defconst sieve-manage-local-variables '(sieve-manage-server
......@@ -174,7 +180,6 @@ for doing the actual authentication."
sieve-manage-client-eol
sieve-manage-server-eol
sieve-manage-capability))
(defconst sieve-manage-default-stream 'network)
(defconst sieve-manage-coding-system-for-read 'binary)
(defconst sieve-manage-coding-system-for-write 'binary)
(defvar sieve-manage-stream nil)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment