mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-07 16:10:46 -08:00
Code Issues Projects Releases Wiki Activity

Merge changes made in Gnus trunk.

Browse source 
nnimap.el (nnimap-wait-for-response): If the user hits `C-g', kill the process, too.
nnir.el (gnus-summary-nnir-goto-thread): Modify to work with imap.
nnimap.el (nnimap-update-info): If the server doesn't return any useful info, just use the previous info.
nnimap.el (nnimap-update-info): Prefer old info over start-article.
nnimap.el (nnimap-update-qresync-info): Finish implementing QRESYNC.
auth-source.el (auth-source-create): Use (user-login-name) for the user name default.
nnimap.el (nnimap-open-connection): Use gnutls STARTTLS, if available.
nnimap.el (nnimap-update-info): Rely more on the current active than the param active to avoid marking articles as read too much.
gnus-sum.el (gnus-summary-set-local-parameters): Ignore the `active' non-variable, too.
nnimap.el (nnimap-update-qresync-info): \Flagged messages are read for Gnus.
nnimap.el (nnimap-retrieve-group-data-early): utf7-encode the group parameters.
nnimap.el (nnimap-update-qresync-info): Mark \Seen articles as read.
This commit is contained in:
Gnus developers 2010-10-10 22:48:40 +00:00 • committed by Katsumi Yamaoka
parent 355cdaf37b
commit dab0271f8d
5 changed files with 170 additions and 70 deletions
Download patch file Download diff file Expand all files Collapse all files

38
lisp/gnus/ChangeLog
View file

@ -1,3 +1,41 @@
2010-10-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-update-qresync-info): \Flagged messages are read
for Gnus.
(nnimap-retrieve-group-data-early): utf7-encode the group parameters.
(nnimap-update-qresync-info): Mark \Seen articles as read.
* gnus-sum.el (gnus-summary-set-local-parameters): Ignore the `active'
non-variable, too.
* nnimap.el (nnimap-open-connection): Use gnutls STARTTLS, if
available.
(nnimap-update-info): Rely more on the current active than the param
active to avoid marking articles as read too much.
* auth-source.el (auth-source-create): Use (user-login-name) for the
user name default.
* nnimap.el (nnimap-update-info): If the server doesn't return any
useful info, just use the previous info.
(nnimap-update-info): Prefer old info over start-article.
(nnimap-update-qresync-info): Finish implementing QRESYNC.
2010-10-10 Andrew Cohen <cohen@andy.bu.edu>
* nnir.el (autoload): Clean up autoloads.
(nnir-imap-default-search-key): Renamed from
nnir-imap-search-field. Use key rather than value.
(nnir-imap-search-other): New variable.
(nnir-read-parm): Use it.
(nnir-imap-expr-to-imap): Use %S rather than imap-quote-specials.
(gnus-summary-nnir-goto-thread): Modify to work with imap.
2010-10-10 Stefan Monnier <monnier@iro.umontreal.ca>
* nnimap.el (nnimap-wait-for-response): If the user hits `C-g', kill
the process, too.
2010-10-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
* spam.el (gnus-summary-mode-map): Bind to "$". Suggested by Russ

5
lisp/gnus/auth-source.el
View file

@ -336,7 +336,10 @@ Return structure as specified by MODE."
passwd))
((equal "login" m)
(or user
(read-string (format "User name for %s on %s: " prot host))))
(read-string
(format "User name for %s on %s (default %s): " prot host
(user-login-name))
nil nil (user-login-name))))
(t
"unknownuser"))))
(if (consp mode) mode (list mode))))

3
lisp/gnus/gnus-sum.el
View file

@ -3841,7 +3841,8 @@ This function is intended to be used in
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
(let ((vars '(quit-config))) ; Ignore quit-config.
(let ((vars '(quit-config active))) ; Ignore things that aren't
; really variables.
(dolist (elem (gnus-group-find-parameter group))
(and (consp elem) ; Has to be a cons.
(consp (cdr elem)) ; The cdr has to be a list.

110
lisp/gnus/nnimap.el
View file

@ -295,7 +295,9 @@ textual parts.")
(port nil)
(ports
(cond
((eq nnimap-stream 'network)
((or (eq nnimap-stream 'network)
(and (eq nnimap-stream 'starttls)
(fboundp 'open-gnutls-stream)))
(open-network-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port
@ -357,8 +359,16 @@ textual parts.")
(push (format "%s" nnimap-server-port) ports))
;; If this is a STARTTLS-capable server, then sever the
;; connection and start a STARTTLS connection instead.
(when (and (eq nnimap-stream 'network)
(member "STARTTLS" (nnimap-capabilities nnimap-object)))
(cond
((and (or (and (eq nnimap-stream 'network)
(member "STARTTLS"
(nnimap-capabilities nnimap-object)))
(eq nnimap-stream 'starttls))
(fboundp 'open-gnutls-stream))
(nnimap-command "STARTTLS")
(gnutls-negotiate (nnimap-process nnimap-object) nil))
((and (eq nnimap-stream 'network)
(member "STARTTLS" (nnimap-capabilities nnimap-object)))
(let ((nnimap-stream 'starttls))
(let ((tls-process
(nnimap-open-connection buffer)))
@ -369,7 +379,7 @@ textual parts.")
(when (memq (process-status tls-process) '(open run))
(delete-process (nnimap-process nnimap-object))
(kill-buffer (current-buffer))
(return tls-process)))))
(return tls-process))))))
(unless (equal connection-result "PREAUTH")
(if (not (setq credentials
(if (eq nnimap-authenticator 'anonymous)
@ -949,7 +959,7 @@ textual parts.")
(erase-buffer)
(setf (nnimap-group nnimap-object) nil)
;; QRESYNC handling isn't implemented.
(let ((qresyncp (member "notQRESYNC" (nnimap-capabilities nnimap-object)))
(let ((qresyncp (member "QRESYNC" (nnimap-capabilities nnimap-object)))
params groups sequences active uidvalidity modseq group)
;; Go through the infos and gather the data needed to know
;; what and how to request the data.
@ -964,7 +974,8 @@ textual parts.")
modseq)
(push
(list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
group uidvalidity modseq)
(utf7-encode group t)
uidvalidity modseq)
'qresync
nil group 'qresync)
sequences)
@ -982,7 +993,8 @@ textual parts.")
;; examine), but will tell us whether the group
;; is read-only or not.
"SELECT")))
(push (list (nnimap-send-command "%s %S" command group)
(push (list (nnimap-send-command "%s %S" command
(utf7-encode group t))
(nnimap-send-command "UID FETCH %d:* FLAGS" start)
start group command)
sequences)))
@ -1038,7 +1050,9 @@ textual parts.")
;; completely empty groups.
((and (not existing)
(not uidnext))
)
(let ((active (cdr (assq 'active (gnus-info-params info)))))
(when active
(gnus-set-active (gnus-info-group info) active))))
;; We have a mismatch between the old and new UIDVALIDITY
;; identifiers, so we have to re-request the group info (the next
;; time). This virtually never happens.
@ -1051,9 +1065,11 @@ textual parts.")
(gnus-group-remove-parameter info 'modseq))
;; We have the data needed to update.
(t
(let ((group (gnus-info-group info))
(completep (and start-article
(= start-article 1))))
(let* ((group (gnus-info-group info))
(completep (and start-article
(= start-article 1)))
(active (or (gnus-active group)
(cdr (assq 'active (gnus-info-params info))))))
(when uidnext
(setq high (1- uidnext)))
;; First set the active ranges based on high/low.
@ -1066,6 +1082,8 @@ textual parts.")
(uidnext
;; No articles in this group.
(cons uidnext (1- uidnext)))
(active
active)
(start-article
(cons start-article (1- start-article)))
(t
@ -1073,7 +1091,7 @@ textual parts.")
nil)))
(gnus-set-active
group
(cons (car (gnus-active group))
(cons (car active)
(or high (1- uidnext)))))
;; See whether this is a read-only group.
(unless (eq permanent-flags 'not-scanned)
@ -1089,7 +1107,7 @@ textual parts.")
(not start-article))
;; We've gotten the data by QRESYNCing.
(nnimap-update-qresync-info
info (nnimap-imap-ranges-to-gnus-ranges vanished) flags)
info existing (nnimap-imap-ranges-to-gnus-ranges vanished) flags)
;; Do normal non-QRESYNC flag updates.
;; Update the list of read articles.
(let* ((unread
@ -1137,13 +1155,35 @@ textual parts.")
(gnus-group-set-parameter info 'modseq highestmodseq)
(nnimap-store-info info (gnus-active group)))))))
(defun nnimap-update-qresync-info (info vanished flags)
(defun nnimap-update-qresync-info (info existing vanished flags)
;; Add all the vanished articles to the list of read articles.
(gnus-info-set-read
info
(gnus-range-add (gnus-info-read info)
vanished))
)
(gnus-add-to-range
(gnus-add-to-range
(gnus-range-add (gnus-info-read info)
vanished)
(cdr (assq '%Flagged flags)))
(cdr (assq '%Seen flags))))
(let ((marks (gnus-info-marks info)))
(dolist (type (cdr nnimap-mark-alist))
(let ((ticks (assoc (car type) marks))
(new-marks
(cdr (or (assoc (caddr type) flags) ; %Flagged
(assoc (intern (cadr type) obarray) flags)
(assoc (cadr type) flags))))) ; "\Flagged"
(setq marks (delq ticks marks))
(pop ticks)
;; Add the new marks we got.
(setq ticks (gnus-add-to-range ticks new-marks))
;; Remove the marks from messages that don't have them.
(setq ticks (gnus-remove-from-range
ticks
(gnus-compress-sequence
(gnus-sorted-complement existing new-marks))))
(when ticks
(push (cons (car type) ticks) marks)))
(gnus-info-set-marks info marks t))))
(defun nnimap-imap-ranges-to-gnus-ranges (irange)
(if (zerop (length irange))
@ -1355,20 +1395,28 @@ textual parts.")
(defun nnimap-wait-for-response (sequence &optional messagep)
(let ((process (get-buffer-process (current-buffer)))
openp)
(goto-char (point-max))
(while (and (setq openp (memq (process-status process)
'(open run)))
(not (re-search-backward
(format "^%d .*\n" sequence)
(if nnimap-streaming
(max (point-min) (- (point) 500))
(point-min))
t)))
(when messagep
(message "nnimap read %dk" (/ (buffer-size) 1000)))
(nnheader-accept-process-output process)
(goto-char (point-max)))
openp))
(condition-case nil
(progn
(goto-char (point-max))
(while (and (setq openp (memq (process-status process)
'(open run)))
(not (re-search-backward
(format "^%d .*\n" sequence)
(if nnimap-streaming
(max (point-min) (- (point) 500))
(point-min))
t)))
(when messagep
(message "nnimap read %dk" (/ (buffer-size) 1000)))
(nnheader-accept-process-output process)
(goto-char (point-max)))
openp)
(quit
;; The user hit C-g while we were waiting: kill the process, in case
;; it's a gnutls-cli process that's stuck (tends to happen a lot behind
;; NAT routers).
(delete-process process)
nil))))
(defun nnimap-parse-response ()
(let ((lines (split-string (nnimap-last-response-string) "\r\n" t))

84
lisp/gnus/nnir.el
View file

@ -339,23 +339,34 @@
(eval-when-compile
(require 'cl))
(eval-when-compile
(autoload 'nnimap-buffer "nnimap")
(autoload 'nnimap-command "nnimap")
(autoload 'nnimap-possibly-change-group "nnimap"))
(nnoo-declare nnir)
(nnoo-define-basics nnir)
(gnus-declare-backend "nnir" 'mail)
(defvar nnir-imap-search-field "TEXT"
"The IMAP search item when doing an nnir search. To use raw
imap queries by default set this to \"\"")
(defvar nnir-imap-default-search-key "Whole message"
"The default IMAP search key for an nnir search. Must be one of
the keys in nnir-imap-search-arguments. To use raw imap queries
by default set this to \"Imap\"")
(defvar nnir-imap-search-arguments
'(("Whole message" . "TEXT")
("Subject" . "SUBJECT")
("To" . "TO")
("From" . "FROM")
("Head" . "HEADER \"%s\"")
(nil . ""))
"Mapping from user readable strings to IMAP search items for use in nnir")
("Imap" . ""))
"Mapping from user readable keys to IMAP search items for use in nnir")
(defvar nnir-imap-search-other "HEADER %S"
"The IMAP search item to use for anything other than
nnir-imap-search-arguments. By default this is the name of an
email header field")
(defvar nnir-imap-search-argument-history ()
"The history for querying search options in nnir")
@ -375,12 +386,12 @@ result, `gnus-retrieve-headers' will be called instead.")
())
(imap nnir-run-imap
((criteria
"Search in: " ; Prompt
"Search in" ; Prompt
,(mapcar 'car nnir-imap-search-arguments) ; alist for completing
nil ; allow any user input
nil ; initial value
nnir-imap-search-argument-history ; the history to use
,nnir-imap-search-field ; default
,nnir-imap-default-search-key ; default
)))
(swish++ nnir-run-swish++
((group . "Group spec: ")))
@ -702,19 +713,30 @@ and show thread that contains this article."
(let* ((cur (gnus-summary-article-number))
(group (nnir-artlist-artitem-group nnir-artlist cur))
(backend-number (nnir-artlist-artitem-number nnir-artlist cur))
server backend-group)
(setq server (nnir-group-server group))
(setq backend-group (gnus-group-real-name group))
(gnus-group-read-ephemeral-group
backend-group
(gnus-server-to-method server)
t ; activate
(cons (current-buffer)
'summary) ; window config
nil
(list backend-number))
(gnus-summary-limit (list backend-number))
(gnus-summary-refer-thread)))
(id (mail-header-id (gnus-summary-article-header)))
(refs (split-string
(mail-header-references (gnus-summary-article-header)))))
(if (string= (car (gnus-group-method group)) "nnimap")
(with-current-buffer (nnimap-buffer)
(let* ((cmd (let ((value
(format
"(OR HEADER REFERENCES %s HEADER Message-Id %s)"
id id)))
(dolist (refid refs value)
(setq value (format
"(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
refid refid value)))))
(result (nnimap-command
"UID SEARCH %s" cmd)))
(gnus-summary-read-group-1 group t t gnus-summary-buffer nil
(and (car result)
(delete 0 (mapcar #'string-to-number
(cdr (assoc "SEARCH" (cdr result)))))))))
(gnus-summary-read-group-1 group t t gnus-summary-buffer
nil (list backend-number))
(gnus-summary-limit (list backend-number))
(gnus-summary-refer-thread))))
(if (fboundp 'eval-after-load)
(eval-after-load "gnus-sum"
@ -936,22 +958,9 @@ pairs (also vectors, actually)."
;; IMAP interface.
;; todo:
;; nnir invokes this two (2) times???!
;; we should not use nnimap at all but open our own server connection
;; we should not LIST * but use nnimap-list-pattern from defs
;; send queries as literals
;; handle errors
(autoload 'nnimap-open-server "nnimap")
(defvar nnimap-server-buffer) ;; nnimap.el
(autoload 'imap-mailbox-select "imap")
(autoload 'imap-search "imap")
(autoload 'imap-quote-specials "imap")
(eval-when-compile
(autoload 'nnimap-buffer "nnimap")
(autoload 'nnimap-command "nnimap")
(autoload 'nnimap-possibly-change-group "nnimap"))
(defun nnir-run-imap (query srv &optional group-option)
"Run a search against an IMAP back-end server.
@ -963,7 +972,8 @@ details on the language and supported extensions"
(group (or group-option (gnus-group-group-name)))
(defs (caddr (gnus-server-to-method srv)))
(criteria (or (cdr (assq 'criteria query))
nnir-imap-search-field))
(cdr (assoc nnir-imap-default-search-key
nnir-imap-search-arguments))))
(gnus-inhibit-demon t)
artlist)
(message "Opening server %s" server)
@ -1044,7 +1054,7 @@ In future the following will be added to the language:
(cond
;; Simple string term
((stringp expr)
(format "%s \"%s\"" criteria (imap-quote-specials expr)))
(format "%s %S" criteria expr))
;; Trivial term: and
((eq expr 'and) nil)
;; Composite term: or expression
@ -1580,7 +1590,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
(if (listp prompt)
(let* ((result (apply 'gnus-completing-read prompt))
(mapping (or (assoc result nnir-imap-search-arguments)
(assoc nil nnir-imap-search-arguments))))
(cons nil nnir-imap-search-other))))
(cons sym (format (cdr mapping) result)))
(cons sym (read-string prompt)))))