From: Lars Ingebrigtsen <larsi@building.gnus.org>
Date: Tue, 4 Feb 2014 01:32:52 +0000 (-0800)
Subject: Find the new Cloud files
X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=commitdiff_plain;h=3a6517dc001027ab8616fbabb5bfa9f50a8a6ce5

Find the new Cloud files
---

diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el
index 133e6c18d..34acf4548 100644
--- a/lisp/gnus-cloud.el
+++ b/lisp/gnus-cloud.el
@@ -72,7 +72,9 @@
 			(with-current-buffer (caddr elem)
 			  (buffer-size))))
 	(insert-buffer-substring (caddr elem))
-	(insert "\n"))))
+	(insert "\n"))
+       ((eq (car elem) :delete)
+	(insert (format ("(:delete %S)\n") (cadr elem))))))
     (gnus-cloud-encode-data)
     (buffer-string)))
 
@@ -109,14 +111,15 @@
   (let ((elems nil))
     (while (not (eobp))
       (while (and (not (eobp))
-		  (not (looking-at "(:file\\|(:data")))
+		  (not (looking-at "(:file\\|(:data\\|(:delete")))
 	(forward-line 1))
       (unless (eobp)
 	(let ((spec (ignore-errors (read (current-buffer))))
 	      length)
 	  (when (and (consp spec)
 		     (or (eq (car spec) :file)
-			 (eq (car spec) :data)))
+			 (eq (car spec) :data)
+			 (eq (car spec) :delete)))
 	    (setq length (car (last spec)))
 	    (push (append (butlast spec)
 			  (list
@@ -131,6 +134,9 @@
     (cond
      ((eq (car elem) :data)
       )
+     ((eq (car elem) :delete)
+      (gnus-cloud-delete-file (cadr elem))
+      )
      ((eq (car elem) :file)
       (unless (= (length elem) 4)
 	(error "Invalid length of a file spec: %s" (length elem)))
@@ -155,9 +161,15 @@
   (mm-with-unibyte-buffer
     (insert new-contents)
     (when (file-exists-p file-name)
-      (let ((backup (car (find-backup-file-name file-name))))
-	(rename-file file-name backup)))
-    (write-region (point-min) (point-max) file-name)))
+      (rename-file file-name (car (find-backup-file-name file-name))))
+    (write-region (point-min) (point-max) file-name)
+    (set-file-times file-name (parse-iso8601-time-string date))))
+
+(defun gnus-cloud-delete-file (file-name)
+  (unless (gnus-cloud-file-covered-p file-name)
+    (message "%s isn't covered by the cloud; ignoring" file-name))
+  (when (file-exists-p file-name)
+    (rename-file file-name (car (find-backup-file-name file-name)))))
 
 (defun gnus-cloud-file-covered-p (file-name)
   (let ((matched nil))
@@ -174,6 +186,40 @@
 	  (setq matched t)))))
     matched))
 
+(defun gnus-cloud-all-files ()
+  (let ((files nil))
+    (dolist (elem gnus-cloud-synced-files)
+      (cond
+       ((stringp elem)
+	(push elem files))
+       ((consp elem)
+	(dolist (file (directory-files (plist-get elem :directory)
+				       nil
+				       (plist-get elem :match)))
+	  (push (expand-file-name file (plist-get elem :directory))
+		files)))))
+    (nreverse files)))
+
+(defvar gnus-cloud-file-timestamps nil)
+
+(defun gnus-cloud-files-to-upload (&optional full)
+  (let ((files nil))
+    (dolist (file (gnus-cloud-all-files))
+      (if (file-exists-p file)
+	  (when (or full
+		    (gnus-cloud-file-new-p file))
+	    (push `(:file ,file) files))
+	(when (assoc file gnus-cloud-file-timestamps)
+	  (push `(:delete ,file) files))))
+    (nreverse files)))
+
+(defun gnus-cloud-file-new-p (file)
+  (let ((timestamp (format-time-string
+		    "%FT%T%z" (nth 5 (file-attributes file))))
+	(old (cadr (assoc file gnus-cloud-file-timestamps))))
+    (or (null old)
+	(string< old timestamp))))
+
 (provide 'gnus-cloud)
 
 ;;; gnus-cloud.el ends here