X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnimap.el;h=b29b5b4cf578eb55c73054c1b86f695156d125fc;hb=e5bec5d05f433a43fa2d14cdb7bebeeefab8835f;hp=917f994c9e524c07fedec8fcc6646c560fefa337;hpb=a707b63af25b91cb730c12e65156ca364bf49a44;p=elisp%2Fgnus.git- diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 917f994..b29b5b4 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -58,14 +58,13 @@ ;;; Code: -(eval-and-compile - (require 'cl) - (require 'imap)) +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) +(eval-and-compile (require 'imap)) (require 'nnoo) (require 'nnmail) (require 'nnheader) -(require 'mm-util) (require 'gnus) (require 'gnus-range) (require 'gnus-start) @@ -335,7 +334,7 @@ If SERVER is nil, uses the current server." (file-exists-p (expand-file-name nameuid dir))) (expand-file-name nameuid dir) (expand-file-name - (mm-encode-coding-string + (encode-coding-string (nnheader-replace-chars-in-string nameuid ?. ?/) nnmail-pathname-coding-system) dir)))) @@ -425,6 +424,8 @@ If EXAMINE is non-nil the group is selected read-only." (with-temp-buffer (buffer-disable-undo) (insert headers) + (nnheader-fold-continuation-lines) + (subst-char-in-region (point-min) (point-max) ?\t ? ) (nnheader-ms-strip-cr) (nnheader-fold-continuation-lines) (subst-char-in-region (point-min) (point-max) ?\t ? ) @@ -459,38 +460,38 @@ If EXAMINE is non-nil the group is selected read-only." (defun nnimap-group-overview-filename (group server) "Make pathname for GROUP on SERVER." (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory))) - (uidvalidity (gnus-group-get-parameter - (gnus-group-prefixed-name - group (gnus-server-to-method - (format "nnimap:%s" server))) - 'uidvalidity)) - (name (nnheader-translate-file-chars - (concat nnimap-nov-file-name - (if (equal server "") - "unnamed" - server) "." group nnimap-nov-file-name-suffix) t)) - (nameuid (nnheader-translate-file-chars - (concat nnimap-nov-file-name - (if (equal server "") - "unnamed" - server) "." group "." uidvalidity - nnimap-nov-file-name-suffix) t)) - (oldfile (if (or nnmail-use-long-file-names - (file-exists-p (expand-file-name name dir))) - (expand-file-name name dir) - (expand-file-name - (mm-encode-coding-string - (nnheader-replace-chars-in-string name ?. ?/) - nnmail-pathname-coding-system) - dir))) - (newfile (if (or nnmail-use-long-file-names - (file-exists-p (expand-file-name nameuid dir))) - (expand-file-name nameuid dir) - (expand-file-name - (mm-encode-coding-string - (nnheader-replace-chars-in-string nameuid ?. ?/) - nnmail-pathname-coding-system) - dir)))) + (uidvalidity (gnus-group-get-parameter + (gnus-group-prefixed-name + group (gnus-server-to-method + (format "nnimap:%s" server))) + 'uidvalidity)) + (name (nnheader-translate-file-chars + (concat nnimap-nov-file-name + (if (equal server "") + "unnamed" + server) "." group nnimap-nov-file-name-suffix) t)) + (nameuid (nnheader-translate-file-chars + (concat nnimap-nov-file-name + (if (equal server "") + "unnamed" + server) "." group "." uidvalidity + nnimap-nov-file-name-suffix) t)) + (oldfile (if (or nnmail-use-long-file-names + (file-exists-p (expand-file-name name dir))) + (expand-file-name name dir) + (expand-file-name + (encode-coding-string + (nnheader-replace-chars-in-string name ?. ?/) + nnmail-pathname-coding-system) + dir))) + (newfile (if (or nnmail-use-long-file-names + (file-exists-p (expand-file-name nameuid dir))) + (expand-file-name nameuid dir) + (expand-file-name + (encode-coding-string + (nnheader-replace-chars-in-string nameuid ?. ?/) + nnmail-pathname-coding-system) + dir)))) (when (and (file-exists-p oldfile) (not (file-exists-p newfile))) (message "nnimap: Upgrading novcache filename...") (sit-for 1) @@ -505,7 +506,7 @@ If EXAMINE is non-nil the group is selected read-only." (with-current-buffer nntp-server-buffer (let ((nov (nnimap-group-overview-filename group server))) (when (file-exists-p nov) - (mm-insert-file-contents nov) + (nnheader-insert-file-contents nov) (set-buffer-modified-p nil) (let ((min (ignore-errors (goto-char (point-min)) (read (current-buffer)))) @@ -537,7 +538,7 @@ If EXAMINE is non-nil the group is selected read-only." (> nnimap-length nnmail-large-newsgroup) (nnheader-message 6 "nnimap: Retrieving headers...done"))))) -(defun nnimap-use-nov-p (group server) +(defun nnimap-dont-use-nov-p (group server) (or gnus-nov-is-evil nnimap-nov-is-evil (unless (and (gnus-make-directory (file-name-directory @@ -551,7 +552,7 @@ If EXAMINE is non-nil the group is selected read-only." (when (nnimap-possibly-change-group group server) (with-current-buffer nntp-server-buffer (erase-buffer) - (if (nnimap-use-nov-p group server) + (if (nnimap-dont-use-nov-p group server) (nnimap-retrieve-headers-from-server (gnus-compress-sequence articles) group server) (let (uids cached low high) @@ -682,17 +683,16 @@ function is generally only called when Gnus is shutting down." (with-current-buffer nnimap-callback-buffer (insert (with-current-buffer nnimap-server-buffer - (nnimap-demule - (if (imap-capability 'IMAP4rev1) - ;; xxx don't just use car? alist doesn't contain - ;; anything else now, but it might... - (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL))) - (imap-message-get (imap-current-message) 'RFC822))))) + (if (imap-capability 'IMAP4rev1) + ;; xxx don't just use car? alist doesn't contain + ;; anything else now, but it might... + (nth 2 (car (imap-message-get (imap-current-message) 'BODYDETAIL))) + (imap-message-get (imap-current-message) 'RFC822)))) (nnheader-ms-strip-cr) (funcall nnimap-callback-callback-function t))) (defun nnimap-request-article-part (article part prop &optional - group server to-buffer detail) + group server to-buffer detail) (when (nnimap-possibly-change-group group server) (let ((article (if (stringp article) (car-safe (imap-search @@ -704,18 +704,18 @@ function is generally only called when Gnus is shutting down." (if (not nnheader-callback-function) (with-current-buffer (or to-buffer nntp-server-buffer) (erase-buffer) - (let ((data (imap-fetch article part prop nil - nnimap-server-buffer))) - (insert (nnimap-demule (if detail - (nth 2 (car data)) - data)))) - (nnheader-ms-strip-cr) - (gnus-message 10 "nnimap: Fetching (part of) article %d...done" - article) - (if (bobp) - (nnheader-report 'nnimap "No such article: %s" - (imap-error-text nnimap-server-buffer)) - (cons group article))) + (let ((data (imap-fetch article part prop nil + nnimap-server-buffer))) + (when data + (insert (if detail (nth 2 (car data)) data)) + (nnheader-ms-strip-cr) + (gnus-message 10 + "nnimap: Fetching (part of) article %d...done" + article) + (if (bobp) + (nnheader-report 'nnimap "No such article: %s" + (imap-error-text nnimap-server-buffer)) + (cons group article))))) (add-hook 'imap-fetch-data-hook 'nnimap-callback) (setq nnimap-callback-callback-function nnheader-callback-function nnimap-callback-buffer nntp-server-buffer) @@ -816,8 +816,8 @@ function is generally only called when Gnus is shutting down." (deffoo nnimap-request-post (&optional server) (let ((success t)) (dolist (mbx (message-unquote-tokens - (message-tokenize-header - (message-fetch-field "Newsgroups") ", ")) success) + (message-tokenize-header + (message-fetch-field "Newsgroups") ", ")) success) (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method))) (or (gnus-active to-newsgroup) (gnus-activate-group to-newsgroup) @@ -1066,9 +1066,9 @@ function is generally only called when Gnus is shutting down." nil) (let ((info (nnimap-find-minmax-uid mbx 'examine))) (when info - (insert (format "\"%s\" %d %d y\n" - mbx (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1))))))))) + (insert (format "\"%s\" %d %d y\n" + mbx (or (nth 2 info) 0) + (max 1 (or (nth 1 info) 1))))))))) (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done" (if (> (length server) 0) " on " "") server)) t)) @@ -1100,22 +1100,37 @@ function is generally only called when Gnus is shutting down." (gnus-message 5 "nnimap: Marking article %d for deletion..." imap-current-message)) + +(defun nnimap-expiry-target (arts group server) + (unless (eq nnmail-expiry-target 'delete) + (with-current-buffer nntp-server-buffer + (dolist (art (gnus-uncompress-sequence arts)) + (nnimap-request-article art group server) + ;; hints for optimization in `nnimap-request-accept-article' + (let ((nnimap-current-move-article art) + (nnimap-current-move-group group) + (nnimap-current-move-server server)) + (nnmail-expiry-target-group nnmail-expiry-target group)))))) + ;; Notice that we don't actually delete anything, we just mark them deleted. (deffoo nnimap-request-expire-articles (articles group &optional server force) (let ((artseq (gnus-compress-sequence articles))) (when (and artseq (nnimap-possibly-change-group group server)) (with-current-buffer nnimap-server-buffer (if force - (and (imap-message-flags-add - (imap-range-to-message-set artseq) "\\Deleted") - (setq articles nil)) + (progn + (nnimap-expiry-target artseq group server) + (when (imap-message-flags-add (imap-range-to-message-set artseq) + "\\Deleted") + (setq articles nil))) (let ((days (or (and nnmail-expiry-wait-function (funcall nnmail-expiry-wait-function group)) nnmail-expiry-wait))) (cond ((eq days 'immediate) - (and (imap-message-flags-add - (imap-range-to-message-set artseq) "\\Deleted") - (setq articles nil))) + (nnimap-expiry-target artseq group server) + (when (imap-message-flags-add + (imap-range-to-message-set artseq) "\\Deleted") + (setq articles nil))) ((numberp days) (let ((oldarts (imap-search (format "UID %s NOT SINCE %s" @@ -1123,6 +1138,7 @@ function is generally only called when Gnus is shutting down." (nnimap-date-days-ago days)))) (imap-fetch-data-hook '(nnimap-request-expire-articles-progress))) + (nnimap-expiry-target oldarts group server) (and oldarts (imap-message-flags-add (imap-range-to-message-set