Mercurial > emacs
changeset 110516:4d2f8b81bb01
Merge changes made in Gnus trunk.
nnimap.el (nnimap-update-info): When UIDNEXT is present, use that for the active.
Split -request-update-info into -request-marks and -update-info.
nnimap.el (nnimap-transform-headers): Don't bug out on invalid BODYSTRUCTUREs.
nnimap.el (nnimap-transform-headers): Unfold quoted {42} headers.
nnir.el (nnir-run-imap): Fix up nnir to work with the new nnimap.
nnimap.el (nnimap-stream): Add starttls support.
gnus-int.el (gnus-request-update-info): Protect against backends not having the function.
gnus-html.el (gnus-html-rescale-image): Revert change that uses window-inside-pixel-edges.
gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): Remove.
nnimap.el (nnimap-retrieve-headers): Return 'headers.
gnus-sum.el (gnus-summary-local-variables): Prepare for list/range makeover.
gnus-start.el: Add new variable gnus-use-backend-marks, and start reading marks again.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Thu, 23 Sep 2010 23:14:02 +0000 |
| parents | 6248bcadfd21 |
| children | 64945cefe6a6 |
| files | doc/misc/gnus.texi lisp/gnus/ChangeLog lisp/gnus/gnus-html.el lisp/gnus/gnus-int.el lisp/gnus/gnus-start.el lisp/gnus/gnus-sum.el lisp/gnus/nnfolder.el lisp/gnus/nnimap.el lisp/gnus/nnir.el lisp/gnus/nnmaildir.el lisp/gnus/nnmairix.el lisp/gnus/nnml.el lisp/gnus/nntp.el lisp/gnus/nnweb.el |
| diffstat | 14 files changed, 182 insertions(+), 85 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/gnus.texi Thu Sep 23 22:57:48 2010 +0200 +++ b/doc/misc/gnus.texi Thu Sep 23 23:14:02 2010 +0000 @@ -1646,6 +1646,12 @@ Jingle to be played if the above variable is non-@code{nil}. The default is @samp{Tuxedomoon.Jingle4.au}. +@item gnus-use-backend-marks +@vindex gnus-use-backend-marks +If non-@code{nil}, Gnus will store article marks both in the +@file{.newsrc.eld} file and in the backends. This will slow down +group operation some. + @end table
--- a/lisp/gnus/ChangeLog Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/ChangeLog Thu Sep 23 23:14:02 2010 +0000 @@ -1,3 +1,61 @@ +2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-use-backend-marks): New variable. + (gnus-get-unread-articles-in-group): Use it. + + * gnus-sum.el (gnus-summary-local-variables): Prepare for list/range + makeover. + +2010-09-23 Andrew Cohen <cohen@andy.bu.edu> + + * nnimap.el (nnimap-retrieve-headers): Return 'headers. + +2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): + Removed. + (gnus-setup-news-hook): Removed + gnus-fixup-nnimap-unread-after-getting-new-news. + + * gnus-int.el (gnus-request-update-info): Protect against backends not + having the function. + + * nnimap.el (nnimap-stream): Mention starttls. + (nnimap-open-connection): Add starttls support. + +2010-09-23 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-run-imap): Fix up nnir to work with the new nnimap. + +2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-transform-headers): Don't bug out on invalid + BODYSTRUCTUREs. + (nnimap-transform-headers): Unfold quoted {42} headers. + + * gnus-start.el (gnus-get-unread-articles): Allow backends to update + the info. + (gnus-get-unread-articles): Only call updatep on backends that support + it. + + * nnweb.el (nnweb-request-update-info): NOOP. + + * nnmaildir.el (nnmaildir-request-marks): Renamed from -update-info. + + * nnfolder.el (nnfolder-request-marks): Renamed from -update-info, + since it only deals with marks. + + * gnus-int.el (gnus-request-marks): Renamed gnus-request-update-info to + gnus-request-marks, and make a new gnus-request-update-info. + + * nnimap.el (nnimap-update-info): When UIDNEXT is present, use that for + the active instead of the high number, which is usually too low. + +2010-09-23 Teodor Zlatanov <tzz@lifelogs.com> + + * netrc.el (netrc-parse): Remove encrypt.el mentions. + * encrypt.el: Removed. + 2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> * nnimap.el (nnimap-update-info): Sync non-standard flags from the @@ -22,11 +80,6 @@ `gnus-get-unread-articles-in-group' update info, since that can be really slow and doesn't seem to be needed? -2010-09-22 Dan Christensen <jdc@uwo.ca> - - * time-date.el (date-to-time): Try using parse-time-string first before - using the slower timezone-make-date-arpa-standard. - 2010-09-22 Julien Danjou <julien@danjou.info> * gnus-group.el (gnus-group-insert-group-line): Call @@ -84,11 +137,9 @@ 2010-09-22 Julien Danjou <julien@danjou.info> - * gnus-html.el (gnus-html-rescale-image): Use window-inside-pixel-edges - rather than window-pixel-edges. - (gnus-html-put-image): Stop using markers. They are harmful if you have - 2 images side-by-side, they can't be properly update on text deletion. - Using text-property is safer here. + * gnus-html.el (gnus-html-put-image): Stop using markers. They are + harmful if you have 2 images side-by-side, they can't be properly + update on text deletion. Using text-property is safer here. (gnus-html-image-fetched): Search also for \r\n\r\n to get the start of data.
--- a/lisp/gnus/gnus-html.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/gnus-html.el Thu Sep 23 23:14:02 2010 +0000 @@ -432,7 +432,7 @@ image (let* ((width (car size)) (height (cdr size)) - (edges (window-inside-pixel-edges (get-buffer-window (current-buffer)))) + (edges (window-pixel-edges (get-buffer-window (current-buffer)))) (window-width (truncate (* gnus-max-image-proportion (- (nth 2 edges) (nth 0 edges))))) (window-height (truncate (* gnus-max-image-proportion
--- a/lisp/gnus/gnus-int.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/gnus-int.el Thu Sep 23 23:14:02 2010 +0000 @@ -584,12 +584,21 @@ (and group (gnus-group-real-name group)) (nth 1 gnus-command-method))))) -(defsubst gnus-request-update-info (info gnus-command-method) +(defun gnus-request-update-info (info gnus-command-method) + (when (gnus-check-backend-function + 'request-update-info (car gnus-command-method)) + (when (stringp gnus-command-method) + (setq gnus-command-method (gnus-server-to-method gnus-command-method))) + (funcall (gnus-get-function gnus-command-method 'request-update-info) + (gnus-group-real-name (gnus-info-group info)) info + (nth 1 gnus-command-method)))) + +(defsubst gnus-request-marks (info gnus-command-method) "Request that GNUS-COMMAND-METHOD update INFO." (when (stringp gnus-command-method) (setq gnus-command-method (gnus-server-to-method gnus-command-method))) (when (gnus-check-backend-function - 'request-update-info (car gnus-command-method)) + 'request-marks (car gnus-command-method)) (let ((group (gnus-info-group info))) (and (funcall (gnus-get-function gnus-command-method 'request-update-info)
--- a/lisp/gnus/gnus-start.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/gnus-start.el Thu Sep 23 23:14:02 2010 +0000 @@ -380,6 +380,13 @@ :group 'gnus-newsrc :type 'boolean) +(defcustom gnus-use-backend-marks nil + "If non-nil, Gnus will store and retrieve marks from the backends. +This means that marks will be stored both in .newsrc.eld and in +the backend, and will slow operation down somewhat." + :group 'gnus-newsrc + :type 'boolean) + (defcustom gnus-check-bogus-groups-hook nil "A hook run after removing bogus groups." :group 'gnus-start-server @@ -402,8 +409,7 @@ :group 'gnus-start :type 'hook) -(defcustom gnus-setup-news-hook - '(gnus-fixup-nnimap-unread-after-getting-new-news) +(defcustom gnus-setup-news-hook nil "A hook after reading the .newsrc file, but before generating the buffer." :group 'gnus-start :type 'hook) @@ -420,8 +426,7 @@ :type 'hook) (defcustom gnus-after-getting-new-news-hook - '(gnus-display-time-event-handler - gnus-fixup-nnimap-unread-after-getting-new-news) + '(gnus-display-time-event-handler) "*A hook run after Gnus checks for new news when Gnus is already running." :group 'gnus-group-new :type 'hook) @@ -1580,6 +1585,13 @@ (gnus-info-group info))))) (gnus-activate-group (gnus-info-group info) nil t)) + ;; Allow backends to update marks, + (when gnus-use-backend-marks + (let ((method (inline (gnus-find-method-for-group + (gnus-info-group info))))) + (when (gnus-check-backend-function 'request-marks (car method)) + (gnus-request-marks info method)))) + (let* ((range (gnus-info-read info)) (num 0)) @@ -1765,11 +1777,14 @@ (dolist (elem type-cache) (destructuring-bind (method method-type infos early-data) elem (when (and method infos) - ;; See if any of the groups from this method require updating. - (gnus-read-active-for-groups method infos early-data) - (dolist (info infos) - (inline (gnus-get-unread-articles-in-group - info (gnus-active (gnus-info-group info)))))))) + (let ((updatep (gnus-check-backend-function + 'request-update-info (car method)))) + ;; See if any of the groups from this method require updating. + (gnus-read-active-for-groups method infos early-data) + (dolist (info infos) + (inline (gnus-get-unread-articles-in-group + info (gnus-active (gnus-info-group info)) + updatep))))))) (gnus-message 6 "Checking new news...done"))) (defun gnus-method-rank (type method) @@ -3145,20 +3160,6 @@ (gnus-boundp 'display-time-timer)) (display-time-event-handler))) -;;;###autoload -(defun gnus-fixup-nnimap-unread-after-getting-new-news () - (let (server group info) - (mapatoms - (lambda (sym) - (when (and (setq group (symbol-name sym)) - (gnus-group-entry group) - (setq info (symbol-value sym))) - (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group))) - gnus-newsrc-hashtb))) - (if (boundp 'nnimap-mailbox-info) - (symbol-value 'nnimap-mailbox-info) - (make-vector 1 0))))) - (defun gnus-check-reasonable-setup () ;; Check whether nnml and nnfolder share a directory. (let ((display-warn
--- a/lisp/gnus/gnus-sum.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/gnus-sum.el Thu Sep 23 23:14:02 2010 +0000 @@ -1539,22 +1539,34 @@ (defvar gnus-summary-local-variables '(gnus-newsgroup-name + + ;; Marks lists + gnus-newsgroup-unreads + gnus-newsgroup-unselected + gnus-newsgroup-marked + gnus-newsgroup-spam-marked + gnus-newsgroup-reads + gnus-newsgroup-saved + gnus-newsgroup-replied + gnus-newsgroup-forwarded + gnus-newsgroup-recent + gnus-newsgroup-expirable + gnus-newsgroup-killed + gnus-newsgroup-unseen + gnus-newsgroup-seen + gnus-newsgroup-cached + gnus-newsgroup-downloadable + gnus-newsgroup-undownloaded + gnus-newsgroup-unsendable + gnus-newsgroup-begin gnus-newsgroup-end gnus-newsgroup-last-rmail gnus-newsgroup-last-mail gnus-newsgroup-last-folder gnus-newsgroup-last-file gnus-newsgroup-last-directory - gnus-newsgroup-auto-expire gnus-newsgroup-unreads - gnus-newsgroup-unselected gnus-newsgroup-marked - gnus-newsgroup-spam-marked - gnus-newsgroup-reads gnus-newsgroup-saved - gnus-newsgroup-replied gnus-newsgroup-forwarded - gnus-newsgroup-recent - gnus-newsgroup-expirable - gnus-newsgroup-processable gnus-newsgroup-killed - gnus-newsgroup-downloadable gnus-newsgroup-undownloaded + gnus-newsgroup-auto-expire + gnus-newsgroup-processable gnus-newsgroup-unfetched - gnus-newsgroup-unsendable gnus-newsgroup-unseen - gnus-newsgroup-seen gnus-newsgroup-articles + gnus-newsgroup-articles gnus-newsgroup-bookmarks gnus-newsgroup-dormant gnus-newsgroup-headers gnus-newsgroup-threads gnus-newsgroup-prepared gnus-summary-highlight-line-function @@ -1573,7 +1585,7 @@ (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1) (gnus-newsgroup-expunged-tally . 0) - gnus-cache-removable-articles gnus-newsgroup-cached + gnus-cache-removable-articles gnus-newsgroup-data gnus-newsgroup-data-reverse gnus-newsgroup-limit gnus-newsgroup-limits gnus-newsgroup-charset gnus-newsgroup-display
--- a/lisp/gnus/nnfolder.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/nnfolder.el Thu Sep 23 23:14:02 2010 +0000 @@ -1202,7 +1202,7 @@ (nnfolder-save-marks group server)) nil) -(deffoo nnfolder-request-update-info (group info &optional server) +(deffoo nnfolder-request-marks (group info &optional server) ;; Change servers. (when (and server (not (nnfolder-server-opened server)))
--- a/lisp/gnus/nnimap.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/nnimap.el Thu Sep 23 23:14:02 2010 +0000 @@ -51,7 +51,7 @@ (defvoo nnimap-stream 'ssl "How nnimap will talk to the IMAP server. -Values are `ssl', `network' or `shell'.") +Values are `ssl', `network', `starttls' or `shell'.") (defvoo nnimap-shell-program (if (boundp 'imap-shell-program) (if (listp imap-shell-program) @@ -135,19 +135,26 @@ (nnimap-transform-headers)) (insert-buffer-substring (nnimap-find-process-buffer (current-buffer)))) - t)) + 'headers)) (defun nnimap-transform-headers () (goto-char (point-min)) - (let (article bytes lines size) + (let (article bytes lines size string) (block nil (while (not (eobp)) (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)")) (delete-region (point) (progn (forward-line 1) (point))) (when (eobp) (return))) - (setq article (match-string 1) - bytes (nnimap-get-length) + (setq article (match-string 1)) + ;; Unfold quoted {number} strings. + (while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n" + (1+ (line-end-position)) t) + (setq size (string-to-number (match-string 1))) + (delete-region (+ (match-beginning 0) 2) (point)) + (setq string (delete-region (point) (+ (point) size))) + (insert (format "%S" string))) + (setq bytes (nnimap-get-length) lines nil) (beginning-of-line) (setq size @@ -157,7 +164,8 @@ (match-string 1))) (beginning-of-line) (when (search-forward "BODYSTRUCTURE" (line-end-position) t) - (let ((structure (ignore-errors (read (current-buffer))))) + (let ((structure (ignore-errors + (read (current-buffer))))) (while (and (consp structure) (not (stringp (car structure)))) (setq structure (car structure))) @@ -257,6 +265,11 @@ "*nnimap*" (current-buffer) nnimap-address (or nnimap-server-port "imap")) '("imap")) + ((eq nnimap-stream 'starttls) + (starttls-open-stream + "*nnimap*" (current-buffer) nnimap-address + (or nnimap-server-port "imap")) + '("imap")) ((eq nnimap-stream 'ssl) (open-tls-stream "*nnimap*" (current-buffer) nnimap-address @@ -273,6 +286,9 @@ '(open run))) (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil) (when (setq connection-result (nnimap-wait-for-connection)) + (when (eq nnimap-stream 'starttls) + (nnimap-send-command "STARTTLS") + (starttls-negotiate (nnimap-process nnimap-object))) (unless (equal connection-result "PREAUTH") (if (not (setq credentials (if (eq nnimap-authenticator 'anonymous) @@ -419,14 +435,11 @@ (when info (nnimap-update-infos marks (list info))) (goto-char (point-max)) - (cond - (marks - (let ((uidnext (nth 5 (car marks)))) - (setq high (or (nth 3 (car marks)) (1- uidnext)) - low (or (nth 4 (car marks)) uidnext)))) - ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t) - (setq high (1- (string-to-number (match-string 1))) - low 1))))) + (let ((uidnext (nth 5 (car marks)))) + (setq high (if uidnext + (1- uidnext) + (nth 3 (car marks))) + low (or (nth 4 (car marks)) uidnext))))) (erase-buffer) (insert (format @@ -782,11 +795,13 @@ (let ((group (gnus-info-group info)) (completep (and start-article (= start-article 1)))) + (when uidnext + (setq high (1- uidnext))) ;; First set the active ranges based on high/low. (if (or completep (not (gnus-active group))) (gnus-set-active group - (if high + (if (and low high) (cons low high) ;; No articles in this group. (cons uidnext (1- uidnext))))
--- a/lisp/gnus/nnir.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/nnir.el Thu Sep 23 23:14:02 2010 +0000 @@ -967,23 +967,27 @@ (defs (caddr (gnus-server-to-method srv))) (criteria (or (cdr (assq 'criteria query)) nnir-imap-search-field)) - artlist buf) + (gnus-inhibit-demon t) + artlist) (message "Opening server %s" server) (condition-case () - (when (nnimap-open-server server defs) ;; xxx - (setq buf nnimap-server-buffer) ;; xxx - (message "Searching %s..." group) - (let ((arts 0) - (mbx (gnus-group-real-name group))) - (when (imap-mailbox-select mbx nil buf) - (mapc - (lambda (artnum) - (push (vector group artnum 1) artlist) - (setq arts (1+ arts))) - (imap-search (nnir-imap-make-query criteria qstring) buf)) - (message "Searching %s... %d matches" mbx arts))) - (message "Searching %s...done" group)) - (quit nil)) + (when (nnimap-possibly-change-group (gnus-group-short-name group) server) + (with-current-buffer (nnimap-buffer) + (message "Searching %s..." group) + (let ((arts 0) + (result + (nnimap-command "UID SEARCH %s" + (nnir-imap-make-query criteria qstring)))) + (mapc + (lambda (artnum) + (push (vector group artnum 1) artlist) + (setq arts (1+ arts))) + (and (car result) + (delete 0 (mapcar #'string-to-number + (cdr (assoc "SEARCH" (cdr result))))))) + (message "Searching %s... %d matches" group arts))) + (message "Searching %s...done" group)) + (quit nil)) (reverse artlist)))) (defun nnir-imap-make-query (criteria qstring)
--- a/lisp/gnus/nnmaildir.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/nnmaildir.el Thu Sep 23 23:14:02 2010 +0000 @@ -916,7 +916,7 @@ "\n"))))) 'group) -(defun nnmaildir-request-update-info (gname info &optional server) +(defun nnmaildir-request-marks (gname info &optional server) (let ((group (nnmaildir--prepare server gname)) pgname flist always-marks never-marks old-marks dotfile num dir markdirs marks mark ranges markdir article read end new-marks ls
--- a/lisp/gnus/nnmairix.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/nnmairix.el Thu Sep 23 23:14:02 2010 +0000 @@ -705,7 +705,7 @@ (autoload 'nnimap-request-update-info-internal "nnimap") -(deffoo nnmairix-request-update-info (group info &optional server) +(deffoo nnmairix-request-marks (group info &optional server) ;; propagate info from underlying IMAP folder to nnmairix group ;; This is currently experimental and must be explicitly activated ;; with nnmairix-propagate-marks-to-nnmairix-group
--- a/lisp/gnus/nnml.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/nnml.el Thu Sep 23 23:14:02 2010 +0000 @@ -1047,7 +1047,7 @@ (nnml-save-marks group server)) nil) -(deffoo nnml-request-update-info (group info &optional server) +(deffoo nnml-request-marks (group info &optional server) (nnml-possibly-change-directory group server) (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server)) (nnheader-message 8 "Updating marks for %s..." group)
--- a/lisp/gnus/nntp.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/nntp.el Thu Sep 23 23:14:02 2010 +0000 @@ -1130,7 +1130,7 @@ (nntp-save-marks group server)) nil) -(deffoo nntp-request-update-info (group info &optional server) +(deffoo nntp-request-marks (group info &optional server) (when (and (not nntp-marks-is-evil) nntp-marks-file-name) (nntp-possibly-create-directory group server)
--- a/lisp/gnus/nnweb.el Thu Sep 23 22:57:48 2010 +0200 +++ b/lisp/gnus/nnweb.el Thu Sep 23 23:14:02 2010 +0000 @@ -193,8 +193,7 @@ (nnmail-generate-active (list (assoc server nnweb-group-alist))) t)) -(deffoo nnweb-request-update-info (group info &optional server) - (nnweb-possibly-change-server group server)) +(deffoo nnweb-request-update-info (group info &optional server)) (deffoo nnweb-asynchronous-p () nil)