[gnus git] branch master updated: m0-9-27-gbd022d8 =3= Fix typo in last checkin ; Decode Cloud packages ; Decode Cloud data
Lars Ingebrigtsen <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via bd022d8c6ff37fa84f219f8a17a704b65440f33e (commit)
via 87c92ba1ae4d5e358c94a03825b436e95fcea8df (commit)
via 6881984b54f99d443d7a8f1a13bae5b3a7f4f84b (commit)
from d9b71806204d830c8fc8eb2428226718df204505 (commit)
- Log -----------------------------------------------------------------
commit bd022d8c6ff37fa84f219f8a17a704b65440f33e
Author: Lars Ingebrigtsen <[email protected]>
Date: Mon Feb 3 15:37:41 2014 -0800
Fix typo in last checkin
diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el
index d20a7dc..75c1416 100644
--- a/lisp/gnus-cloud.el
+++ b/lisp/gnus-cloud.el
@@ -147,9 +147,7 @@
(and (file-exists-p file-name)
(mm-with-unibyte-buffer
(insert-file-contents-literally file-name)
- (not
- (equal (buffer-string (point-min) (point-max))
- contents)))))
+ (not (equal (buffer-string) contents)))))
(gnus-cloud-replace-file file-name date contents))))
(defun gnus-cloud-replace-file (file-name date new-contents)
commit 87c92ba1ae4d5e358c94a03825b436e95fcea8df
Author: Lars Ingebrigtsen <[email protected]>
Date: Mon Feb 3 15:36:36 2014 -0800
Decode Cloud packages
diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el
index 9812d85..d20a7dc 100644
--- a/lisp/gnus-cloud.el
+++ b/lisp/gnus-cloud.el
@@ -38,12 +38,16 @@
:group 'gnus-cloud
:type '(repeat regexp))
-(defvar gnus-cloud-version "0.1")
+(defvar gnus-cloud-version 1)
+
+(defvar gnus-cloud-method nil
+ "The IMAP select method used to store the cloud data.")
(defun gnus-cloud-make-chunk (elems)
(with-temp-buffer
(insert (format "Version %s\n" gnus-cloud-version))
- (insert (gnus-cloud-insert-data elems))))
+ (insert (gnus-cloud-insert-data elems))
+ (buffer-string)))
(defun gnus-cloud-insert-data (elems)
(mm-with-unibyte-buffer
@@ -55,7 +59,7 @@
(insert-file-contents-literally (cadr elem))
(setq length (buffer-size)
data (buffer-string)))
- (insert (format "file %S %s %d\n"
+ (insert (format "(:file %S %S %d)\n"
(cadr elem)
(format-time-string
"%FT%T%z" (nth 5 (file-attributes (cadr elem))))
@@ -63,7 +67,7 @@
(insert data)
(insert "\n")))
((eq (car elem) :buffer)
- (insert (format "data %S %d\n" (cadr elem)
+ (insert (format "(:data %S %d)\n" (cadr elem)
(with-current-buffer (caddr elem)
(buffer-size))))
(insert-buffer-substring (caddr elem))
@@ -84,7 +88,84 @@
"-c"))
(defun gnus-cloud-parse-chunk ()
+ (save-excursion
+ (goto-char (point-min))
+ (unless (looking-at "Version \\([0-9]+\\)")
+ (error "Not a valid Cloud chunk in the current buffer"))
+ (forward-line 1)
+ (let ((version (string-to-number (match-string 1)))
+ (data (buffer-substring (point) (point-max))))
+ (mm-with-unibyte-buffer
+ (insert data)
+ (cond
+ ((= version 1)
+ (gnus-cloud-decode-data)
+ (gnus-cloud-parse-version-1))
+ (t
+ (error "Unsupported Cloud chunk version %s" version)))))))
+
+(defun gnus-cloud-parse-version-1 ()
+ (let ((elems nil))
+ (while (not (eobp))
+ (while (and (not (eobp))
+ (not (looking-at "(:file\\|(:data")))
+ (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)))
+ (setq length (car (last spec)))
+ (push (append (butlast spec)
+ (list
+ (buffer-substring (1+ (point))
+ (+ (point) 1 length))))
+ elems)
+ (goto-char (+ (point) 1 length))))))
+ (nreverse elems)))
+
+(defun gnus-cloud-update-data (elems)
+ (dolist (elem elems)
+ (cond
+ ((eq (car elem) :data)
)
+ ((eq (car elem) :file)
+ (unless (= (length elem) 4)
+ (error "Invalid length of a file spec: %s" (length elem)))
+ (gnus-cloud-update-file (cdr elem)))
+ (t
+ (error "Unknown type %s" (car elem))))))
+
+(defun gnus-cloud-update-file (elem)
+ (let ((file-name (pop elem))
+ (date (pop elem))
+ (contents (pop elem)))
+ (unless (gnus-cloud-file-covered-p file-name)
+ (message "%s isn't covered by the cloud; ignoring" file-name))
+ (when (or (not (file-exists-p file-name))
+ (and (file-exists-p file-name)
+ (mm-with-unibyte-buffer
+ (insert-file-contents-literally file-name)
+ (not
+ (equal (buffer-string (point-min) (point-max))
+ contents)))))
+ (gnus-cloud-replace-file file-name date contents))))
+
+(defun gnus-cloud-replace-file (file-name date new-contents)
+ (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)))
+
+(defun gnus-cloud-file-covered-p (file-name)
+ (let ((matched nil))
+ (dolist (regexp gnus-cloud-synced-files)
+ (when (string-match regexp file-name)
+ (setq matched t)))
+ matched))
(provide 'gnus-cloud)
commit 6881984b54f99d443d7a8f1a13bae5b3a7f4f84b
Author: Lars Ingebrigtsen <[email protected]>
Date: Sat Feb 1 20:54:36 2014 -0800
Decode Cloud data
diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el
index 2018dc2..9812d85 100644
--- a/lisp/gnus-cloud.el
+++ b/lisp/gnus-cloud.el
@@ -72,10 +72,20 @@
(buffer-string)))
(defun gnus-cloud-encode-data ()
- (call-process-region (point-min) (point-max) "gzip" t (current-buffer) nil
+ (call-process-region (point-min) (point-max) "gzip"
+ t (current-buffer) nil
"-c")
(base64-encode-region (point-min) (point-max)))
+(defun gnus-cloud-decode-data ()
+ (base64-decode-region (point-min) (point-max))
+ (call-process-region (point-min) (point-max) "gunzip"
+ t (current-buffer) nil
+ "-c"))
+
+(defun gnus-cloud-parse-chunk ()
+ )
+
(provide 'gnus-cloud)
;;; gnus-cloud.el ends here
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/gnus-cloud.el | 99 +++++++++++++++++++++++++++++++++++++++++++++++++---
1 file changed, 94 insertions(+), 5 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project