X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-cloud.el;h=f965f989b71fe84ed3313484a49701bb0dd9f611;hb=2e08bfa0d105cd6146dd45f2052a19a8b58b2440;hp=00e3b0dc1b137417a20948f4a3fce9e1512175cc;hpb=16c9f5a700804fb04d4f179f8df072a59a5e800a;p=gnus

diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el
index 00e3b0dc1..f965f989b 100644
--- a/lisp/gnus-cloud.el
+++ b/lisp/gnus-cloud.el
@@ -1,6 +1,6 @@
 ;;; gnus-cloud.el --- storing and retrieving data via IMAP
 
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail
@@ -26,9 +26,11 @@
 
 (eval-when-compile (require 'cl))
 (require 'parse-time)
+(require 'nnimap)
 
 (defgroup gnus-cloud nil
   "Syncing Gnus data via IMAP."
+  :version "25.1"
   :group 'gnus)
 
 (defcustom gnus-cloud-synced-files
@@ -38,9 +40,11 @@
     (:directory "~/News" :match ".*.SCORE\\'"))
   "List of file regexps that should be kept up-to-date via the cloud."
   :group 'gnus-cloud
+  ;; FIXME this type does not match the default.  Nor does the documentation.
   :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 +127,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 :delete)))
 	    (setq length (plist-get spec :length))
 	    (push (append spec
 			  (list
@@ -227,6 +231,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)
@@ -238,19 +247,30 @@
 	   (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
 	   (gnus-subscribe-group gnus-cloud-group-name)))))
 
-(defun gnus-cloud-upload-data ()
+(defun gnus-cloud-upload-data (&optional full)
   (gnus-cloud-ensure-cloud-group)
   (with-temp-buffer
-    (let* ((full t)
-	   (elems (gnus-cloud-files-to-upload full)))
+    (let ((elems (gnus-cloud-files-to-upload full)))
       (insert (format "Subject: (sequence: %d type: %s)\n"
 		      gnus-cloud-sequence
 		      (if full :full :partial)))
       (insert "From: nobody@invalid.com\n")
       (insert "\n")
       (insert (gnus-cloud-make-chunk elems))
-      (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method
-				   t t))))
+      (when (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method
+					 t t)
+	(setq gnus-cloud-sequence (1+ gnus-cloud-sequence))
+	(gnus-cloud-add-timestamps elems)))))
+
+(defun gnus-cloud-add-timestamps (elems)
+  (dolist (elem elems)
+    (let* ((file-name (plist-get elem :file-name))
+	   (old (assoc file-name gnus-cloud-file-timestamps)))
+      (when old
+	(setq gnus-cloud-file-timestamps
+	      (delq old gnus-cloud-file-timestamps)))
+      (push (list file-name (plist-get elem :timestamp))
+	    gnus-cloud-file-timestamps))))
 
 (defun gnus-cloud-available-chunks ()
   (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
@@ -263,7 +283,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)
@@ -271,11 +294,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))
@@ -291,6 +310,34 @@
 	     (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))
+
+(defun gnus-cloud-collect-full-newsrc ()
+  (let ((infos nil))
+    (dolist (info (cdr gnus-newsrc-alist))
+      (when (gnus-cloud-server-p
+	     (gnus-method-to-server
+	      (gnus-find-method-for-group (gnus-info-group info))))
+	(push info infos)))
+    ))
+
 (provide 'gnus-cloud)
 
 ;;; gnus-cloud.el ends here