X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnimap.el;h=e0bb5a0e134a148847e3f061d2a242f1a63d2c83;hp=c3b36709904e3277ed28ce0c5768f6a98fe5520e;hb=4598d7eb56ad42593c8aee7189d3b31e6c476344;hpb=674439465f70ff04dc483df45a4581a113ca44cf diff --git a/lisp/nnimap.el b/lisp/nnimap.el index c3b367099..e0bb5a0e1 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -189,25 +189,32 @@ textual parts.") (defun nnimap-transform-headers () (goto-char (point-min)) - (let (article bytes lines size string) + (let (article lines size string) (block nil (while (not (eobp)) - (while (not (looking-at "\\* [0-9]+ FETCH.+?UID \\([0-9]+\\)")) + (while (not (looking-at "\\* [0-9]+ FETCH")) (delete-region (point) (progn (forward-line 1) (point))) (when (eobp) (return))) - (setq article (match-string 1)) + (goto-char (match-end 0)) ;; Unfold quoted {number} strings. - (while (re-search-forward "[^]][ (]{\\([0-9]+\\)}\r?\n" - (1+ (line-end-position)) t) + (while (re-search-forward + "[^]][ (]{\\([0-9]+\\)}\r?\n" + (save-excursion + (or (re-search-forward "\\* [0-9]+ FETCH" nil t) + (point-max))) + t) (setq size (string-to-number (match-string 1))) (delete-region (+ (match-beginning 0) 2) (point)) (setq string (buffer-substring (point) (+ (point) size))) (delete-region (point) (+ (point) size)) - (insert (format "%S" string))) - (setq bytes (nnimap-get-length) - lines nil) + (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string)))) (beginning-of-line) + (setq article + (and (re-search-forward "UID \\([0-9]+\\)" (line-end-position) + t) + (match-string 1))) + (setq lines nil) (setq size (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)" (line-end-position) @@ -269,18 +276,20 @@ textual parts.") result)) (mapconcat #'identity (nreverse result) ","))))) -(deffoo nnimap-open-server (server &optional defs) +(deffoo nnimap-open-server (server &optional defs no-reconnect) (if (nnimap-server-opened server) t (unless (assq 'nnimap-address defs) (setq defs (append defs (list (list 'nnimap-address server))))) (nnoo-change-server 'nnimap server defs) - (or (nnimap-find-connection nntp-server-buffer) - (nnimap-open-connection nntp-server-buffer)))) + (if no-reconnect + (nnimap-find-connection nntp-server-buffer) + (or (nnimap-find-connection nntp-server-buffer) + (nnimap-open-connection nntp-server-buffer))))) (defun nnimap-make-process-buffer (buffer) (with-current-buffer - (generate-new-buffer (format "*nnimap %s %s %s*" + (generate-new-buffer (format " *nnimap %s %s %s*" nnimap-address nnimap-server-port (gnus-buffer-exists-p buffer))) (mm-disable-multibyte) @@ -1221,7 +1230,8 @@ textual parts.") (setf (nnimap-group nnimap-object) nil) (setf (nnimap-initial-resync nnimap-object) 0) (let ((qresyncp (nnimap-capability "QRESYNC")) - params groups sequences active uidvalidity modseq group) + params groups sequences active uidvalidity modseq group + unexist) ;; Go through the infos and gather the data needed to know ;; what and how to request the data. (dolist (info infos) @@ -1229,13 +1239,15 @@ textual parts.") group (nnimap-decode-gnus-group (gnus-group-real-name (gnus-info-group info))) active (cdr (assq 'active params)) + unexist (assq 'unexist (gnus-info-marks info)) uidvalidity (cdr (assq 'uidvalidity params)) modseq (cdr (assq 'modseq params))) (setf (nnimap-examined nnimap-object) group) (if (and qresyncp uidvalidity active - modseq) + modseq + unexist) (push (list (nnimap-send-command "EXAMINE %S (%s (%s %s))" (utf7-encode group t) @@ -1244,12 +1256,7 @@ textual parts.") 'qresync nil group 'qresync) sequences) - (let ((start - (if (and active uidvalidity) - ;; Fetch the last 100 flags. - (max 1 (- (cdr active) 100)) - 1)) - (command + (let ((command (if uidvalidity "EXAMINE" ;; If we don't have a UIDVALIDITY, then this is @@ -1257,9 +1264,13 @@ textual parts.") ;; have to do a SELECT (which is slower than an ;; examine), but will tell us whether the group ;; is read-only or not. - "SELECT"))) - (setf (nnimap-initial-resync nnimap-object) - (1+ (nnimap-initial-resync nnimap-object))) + "SELECT")) + start) + (if (and active uidvalidity unexist) + ;; Fetch the last 100 flags. + (setq start (max 1 (- (cdr active) 100))) + (incf (nnimap-initial-resync nnimap-object)) + (setq start 1)) (push (list (nnimap-send-command "%s %S" command (utf7-encode group t)) (nnimap-send-command "UID FETCH %d:* FLAGS" start) @@ -1278,7 +1289,7 @@ textual parts.") (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) (when (and sequences - (nnimap-possibly-change-group nil server) + (nnimap-possibly-change-group nil server t) ;; Check that the process is still alive. (get-buffer-process (nnimap-buffer)) (memq (process-status (get-buffer-process (nnimap-buffer))) @@ -1435,6 +1446,20 @@ textual parts.") (setq new-marks (gnus-range-nconcat old-marks new-marks))) (when new-marks (push (cons (car type) new-marks) marks))))) + ;; Keep track of non-existing articles. + (let* ((old-unexists (assq 'unexist marks)) + (unexists + (if completep + (gnus-range-difference + (gnus-active group) + (gnus-compress-sequence existing)) + (gnus-add-to-range + (cdr old-unexists) + (gnus-list-range-difference + existing (gnus-active group)))))) + (if old-unexists + (setcdr old-unexists unexists) + (push (cons 'unexist unexists) marks))) (gnus-info-set-marks info marks t)))) ;; Tell Gnus whether there are any \Recent messages in any of ;; the groups. @@ -1478,6 +1503,14 @@ textual parts.") (gnus-sorted-complement existing new-marks)))) (when ticks (push (cons (car type) ticks) marks))) + (gnus-info-set-marks info marks t)) + ;; Add vanished to the list of unexisting articles. + (when vanished + (let* ((old-unexists (assq 'unexist marks)) + (unexists (gnus-range-add (cdr old-unexists) vanished))) + (if old-unexists + (setcdr old-unexists unexists) + (push (cons 'unexist unexists) marks))) (gnus-info-set-marks info marks t)))) (defun nnimap-imap-ranges-to-gnus-ranges (irange) @@ -1530,7 +1563,8 @@ textual parts.") (defun nnimap-parse-flags (sequences) (goto-char (point-min)) - ;; Change \Delete etc to %Delete, so that the reader can read it. + ;; Change \Delete etc to %Delete, so that the Emacs Lisp reader can + ;; read it. (subst-char-in-region (point-min) (point-max) ?\\ ?% t) ;; Remove any MODSEQ entries in the buffer, because they may contain @@ -1601,7 +1635,9 @@ textual parts.") vanished highestmodseq) articles) groups) - (goto-char end) + (if (eq flag-sequence 'qresync) + (goto-char end) + (setq end (point))) (setq articles nil)))) groups)) @@ -1633,11 +1669,11 @@ textual parts.") (cdr (assoc "SEARCH" (cdr result)))))) nil t)))))) -(defun nnimap-possibly-change-group (group server) +(defun nnimap-possibly-change-group (group server &optional no-reconnect) (let ((open-result t)) (when (and server (not (nnimap-server-opened server))) - (setq open-result (nnimap-open-server server))) + (setq open-result (nnimap-open-server server nil no-reconnect))) (cond ((not open-result) nil) @@ -1684,13 +1720,17 @@ textual parts.") (nnimap-wait-for-response nnimap-sequence)) nnimap-sequence) +(defvar nnimap-record-commands nil + "If non-nil, log commands to the \"*imap log*\" buffer.") + (defun nnimap-log-command (command) - (with-current-buffer (get-buffer-create "*imap log*") - (goto-char (point-max)) - (insert (format-time-string "%H:%M:%S") " " - (if nnimap-inhibit-logging - "(inhibited)\n" - command))) + (when nnimap-record-commands + (with-current-buffer (get-buffer-create "*imap log*") + (goto-char (point-max)) + (insert (format-time-string "%H:%M:%S") " " + (if nnimap-inhibit-logging + "(inhibited)\n" + command)))) command) (defun nnimap-command (&rest args) @@ -1745,8 +1785,11 @@ textual parts.") 7 "nnimap read %dk from %s%s" (/ (buffer-size) 1000) nnimap-address (if (not (zerop (nnimap-initial-resync nnimap-object))) - (format " (initial sync of %d groups; please wait)" - (nnimap-initial-resync nnimap-object)) + (format " (initial sync of %d group%s; please wait)" + (nnimap-initial-resync nnimap-object) + (if (= (nnimap-initial-resync nnimap-object) 1) + "" + "s")) ""))) (nnheader-accept-process-output process) (goto-char (point-max)))