[gnus git] branch master updated: m0-9-30-g3a6517d =3= Find the new Cloud files ; `parse-iso8601-time-string': New function ; Change how cloud files are specified
Lars Ingebrigtsen <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 3a6517dc001027ab8616fbabb5bfa9f50a8a6ce5 (commit)
via 4aa3fbe8762f86d09de17860bbb27ce9091890f8 (commit)
via 7ad464af4737b14cd4c6dff2c2dc18bc0c40fca4 (commit)
from bd022d8c6ff37fa84f219f8a17a704b65440f33e (commit)
- Log -----------------------------------------------------------------
commit 3a6517dc001027ab8616fbabb5bfa9f50a8a6ce5
Author: Lars Ingebrigtsen <[email protected]>
Date: Mon Feb 3 17:32:52 2014 -0800
Find the new Cloud files
diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el
index 133e6c1..34acf45 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
commit 4aa3fbe8762f86d09de17860bbb27ce9091890f8
Author: Lars Ingebrigtsen <[email protected]>
Date: Mon Feb 3 16:23:39 2014 -0800
`parse-iso8601-time-string': New function
* parse-time.el (parse-time-iso8601-regexp)
(parse-iso8601-time-string): Copied from `url-dav' so that we can use
it more generally.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 73a6428..c08d634 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2014-02-04 Lars Ingebrigtsen <[email protected]>
+
+ * parse-time.el (parse-time-iso8601-regexp)
+ (parse-iso8601-time-string): Copied from `url-dav' so that we can use
+ it more generally.
+
2014-02-01 Lars Ingebrigtsen <[email protected]>
* gnus-cloud.el: New file to provide the Emacs Cloud.
diff --git a/lisp/parse-time.el b/lisp/parse-time.el
index f80f3ad..42b4991 100644
--- a/lisp/parse-time.el
+++ b/lisp/parse-time.el
@@ -238,6 +238,68 @@ unknown are returned as nil."
(rplaca (nthcdr (pop slots) time) new-val))))))))
time))
+(defconst parse-time-iso8601-regexp
+ (let* ((dash "-?")
+ (colon ":?")
+ (4digit "\\([0-9][0-9][0-9][0-9]\\)")
+ (2digit "\\([0-9][0-9]\\)")
+ (date-fullyear 4digit)
+ (date-month 2digit)
+ (date-mday 2digit)
+ (time-hour 2digit)
+ (time-minute 2digit)
+ (time-second 2digit)
+ (time-secfrac "\\(\\.[0-9]+\\)?")
+ (time-numoffset (concat "[-+]\\(" time-hour "\\):" time-minute))
+ (time-offset (concat "Z" time-numoffset))
+ (partial-time (concat time-hour colon time-minute colon time-second
+ time-secfrac))
+ (full-date (concat date-fullyear dash date-month dash date-mday))
+ (full-time (concat partial-time time-offset))
+ (date-time (concat full-date "T" full-time)))
+ (list (concat "^" full-date)
+ (concat "T" partial-time)
+ (concat "Z" time-numoffset)))
+ "List of regular expressions matching ISO 8601 dates.
+1st regular expression matches the date.
+2nd regular expression matches the time.
+3rd regular expression matches the (optional) timezone specification.")
+
+(defun parse-iso8601-time-string (date-string)
+ (let* ((date-re (nth 0 parse-time-iso8601-regexp))
+ (time-re (nth 1 parse-time-iso8601-regexp))
+ (tz-re (nth 2 parse-time-iso8601-regexp))
+ re-start
+ time seconds minute hour fractional-seconds
+ day month year day-of-week dst tz)
+ ;; We need to populate 'time' with
+ ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
+
+ ;; Nobody else handles iso8601 correctly, let's do it ourselves.
+ (when (string-match date-re date-string re-start)
+ (setq year (string-to-number (match-string 1 date-string))
+ month (string-to-number (match-string 2 date-string))
+ day (string-to-number (match-string 3 date-string))
+ re-start (match-end 0))
+ (when (string-match time-re date-string re-start)
+ (setq hour (string-to-number (match-string 1 date-string))
+ minute (string-to-number (match-string 2 date-string))
+ seconds (string-to-number (match-string 3 date-string))
+ fractional-seconds (string-to-number (or
+ (match-string 4 date-string)
+ "0"))
+ re-start (match-end 0))
+ (when (string-match tz-re date-string re-start)
+ (setq tz (match-string 1 date-string)))
+ (setq time (list seconds minute hour day month year day-of-week dst tz))))
+
+ ;; Fall back to having Gnus do fancy things for us.
+ (when (not time)
+ (setq time (parse-time-string date-string)))
+
+ (and time
+ (apply 'encode-time time))))
+
(provide 'parse-time)
;;; parse-time.el ends here
commit 7ad464af4737b14cd4c6dff2c2dc18bc0c40fca4
Author: Lars Ingebrigtsen <[email protected]>
Date: Mon Feb 3 16:07:03 2014 -0800
Change how cloud files are specified
diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el
index 75c1416..133e6c1 100644
--- a/lisp/gnus-cloud.el
+++ b/lisp/gnus-cloud.el
@@ -30,10 +30,11 @@
"Syncing Gnus data via IMAP."
:group 'gnus)
-(defcustom gnus-cloud-synced-files '("~/\\.authinfo"
- "~/\\.authinfo\\.gpg"
- "~/\\.gnus\\.el"
- "~/News/.*.SCORE")
+(defcustom gnus-cloud-synced-files
+ '("~/.authinfo"
+ "~/.authinfo.gpg"
+ "~/.gnus.el"
+ (:directory "~/News" :match ".*.SCORE\\'"))
"List of file regexps that should be kept up-to-date via the cloud."
:group 'gnus-cloud
:type '(repeat regexp))
@@ -160,9 +161,17 @@
(defun gnus-cloud-file-covered-p (file-name)
(let ((matched nil))
- (dolist (regexp gnus-cloud-synced-files)
- (when (string-match regexp file-name)
+ (dolist (elem gnus-cloud-synced-files)
+ (cond
+ ((stringp elem)
+ (when (equal elem file-name)
(setq matched t)))
+ ((consp elem)
+ (when (and (equal (directory-file-name (plist-get elem :directory))
+ (directory-file-name (file-name-directory file-name)))
+ (string-match (plist-get elem :match)
+ (file-name-nondirectory file-name)))
+ (setq matched t)))))
matched))
(provide 'gnus-cloud)
-----------------------------------------------------------------------
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/ChangeLog | 6 ++++
lisp/gnus-cloud.el | 81 +++++++++++++++++++++++++++++++++++++++++++---------
lisp/parse-time.el | 62 ++++++++++++++++++++++++++++++++++++++++
3 files changed, 136 insertions(+), 13 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