X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-cloud.el;h=c47976bdcfa851db94c72b5ff6b7d175babde027;hb=073ff61fbe32f1ee26096dba8da9243c0269fe6f;hp=f9f7fdcc1cf92098d366bece45a1020222fd60bd;hpb=bdfcf8589cc0c5a7b3aa4f908048831f007bbe5e;p=gnus diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el index f9f7fdcc1..c47976bdc 100644 --- a/lisp/gnus-cloud.el +++ b/lisp/gnus-cloud.el @@ -26,6 +26,7 @@ (eval-when-compile (require 'cl)) (require 'parse-time) +(require 'nnimap) (defgroup gnus-cloud nil "Syncing Gnus data via IMAP." @@ -41,6 +42,7 @@ :type '(repeat regexp)) (defvar gnus-cloud-group-name "*Emacs Cloud*") +(defvar gnus-cloud-covered-servers nil) (defvar gnus-cloud-version 1) (defvar gnus-cloud-sequence 1) @@ -123,7 +125,7 @@ (let ((spec (ignore-errors (read (current-buffer)))) length) (when (and (consp spec) - (memq (getf spec :type) '(:file :data :deleta))) + (memq (plist-get spec :type) '(:file :data :deleta))) (setq length (plist-get spec :length)) (push (append spec (list @@ -227,6 +229,11 @@ (string< old timestamp)) timestamp))) +(declare-function gnus-activate-group "gnus-start" + (group &optional scan dont-check method dont-sub-check)) +(declare-function gnus-subscribe-group "gnus-start" + (group &optional previous method)) + (defun gnus-cloud-ensure-cloud-group () (let ((method (if (stringp gnus-cloud-method) (gnus-server-to-method gnus-cloud-method) @@ -274,7 +281,10 @@ (while (and (not (eobp)) (setq head (nnheader-parse-head))) (push head headers)))) - (nreverse headers))) + (sort (nreverse headers) + (lambda (h1 h2) + (> (gnus-cloud-chunk-sequence (mail-header-subject h1)) + (gnus-cloud-chunk-sequence (mail-header-subject h2))))))) (defun gnus-cloud-chunk-sequence (string) (if (string-match "sequence: \\([0-9]+\\)" string) @@ -282,11 +292,7 @@ 0)) (defun gnus-cloud-prune-old-chunks (headers) - (let ((headers - (sort (reverse headers) - (lambda (h1 h2) - (> (gnus-cloud-chunk-sequence (mail-header-subject h1)) - (gnus-cloud-chunk-sequence (mail-header-subject h2)))))) + (let ((headers (reverse headers)) (found nil)) (while (and headers (not found)) @@ -302,6 +308,25 @@ (nreverse headers)) (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))))) +(defun gnus-cloud-download-data () + (let ((articles nil) + chunks) + (dolist (header (gnus-cloud-available-chunks)) + (when (> (gnus-cloud-chunk-sequence (mail-header-subject header)) + gnus-cloud-sequence) + (push (mail-header-number header) articles))) + (when articles + (nnimap-request-articles (nreverse articles) gnus-cloud-group-name) + (with-current-buffer nntp-server-buffer + (goto-char (point-min)) + (while (re-search-forward "^Version " nil t) + (beginning-of-line) + (push (gnus-cloud-parse-chunk) chunks) + (forward-line 1)))))) + +(defun gnus-cloud-server-p (server) + (member server gnus-cloud-covered-servers)) + (provide 'gnus-cloud) ;;; gnus-cloud.el ends here