From dab0271f8dfd284e0ecd5022745a67c182410b81 Mon Sep 17 00:00:00 2001 From: Gnus developers Date: Sun, 10 Oct 2010 22:48:40 +0000 Subject: [PATCH] Merge changes made in Gnus trunk. 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. --- lisp/gnus/ChangeLog | 38 ++++++++++++++ lisp/gnus/auth-source.el | 5 +- lisp/gnus/gnus-sum.el | 3 +- lisp/gnus/nnimap.el | 110 ++++++++++++++++++++++++++++----------- lisp/gnus/nnir.el | 84 +++++++++++++++++------------- 5 files changed, 170 insertions(+), 70 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 3b2a61e3d3d..2b88592be9d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,41 @@ +2010-10-10 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * nnimap.el (nnimap-wait-for-response): If the user hits `C-g', kill + the process, too. + 2010-10-09 Lars Magne Ingebrigtsen * spam.el (gnus-summary-mode-map): Bind to "$". Suggested by Russ diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 0b1d8eb57af..20e4af189d9 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -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)))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index a0566900757..1a8d4549b26 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -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. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index b30e5868669..73b7fbdb733 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -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)) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 86acad16638..2a264d1fa32 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -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))))) -- 2.39.2