[gnus git] branch master updated: m0-9-35-gbdfcf85 =3= * gnus.el (gnus-variable-list): Save Cloud variables. ; Prune old chunks ; * gnus-int.el (gnus-request-accept-article): Doc fix.
Lars Ingebrigtsen <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via bdfcf8589cc0c5a7b3aa4f908048831f007bbe5e (commit)
via 16c9f5a700804fb04d4f179f8df072a59a5e800a (commit)
via 098bafdb3e9280e6b9e9c8b3854fe26760af75dd (commit)
from 3c775cb50a079bb1d2ad132b2c5830d0a2ef887f (commit)
- Log -----------------------------------------------------------------
commit bdfcf8589cc0c5a7b3aa4f908048831f007bbe5e
Author: Lars Ingebrigtsen <[email protected]>
Date: Tue Feb 4 18:35:32 2014 -0800
* gnus.el (gnus-variable-list): Save Cloud variables.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6df17d2..40d6942 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,7 @@
2014-02-05 Lars Ingebrigtsen <[email protected]>
+ * gnus.el (gnus-variable-list): Save Cloud variables.
+
* gnus-int.el (gnus-request-accept-article): Doc fix.
2014-02-04 Lars Ingebrigtsen <[email protected]>
diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el
index 00e3b0d..f9f7fdc 100644
--- a/lisp/gnus-cloud.el
+++ b/lisp/gnus-cloud.el
@@ -238,19 +238,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: [email protected]\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)
diff --git a/lisp/gnus.el b/lisp/gnus.el
index 8164263..ab48361 100644
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -2699,7 +2699,9 @@ such as a mark that says whether an article is stored in the cache
gnus-newsrc-last-checked-date
gnus-newsrc-alist gnus-server-alist
gnus-killed-list gnus-zombie-list
- gnus-topic-topology gnus-topic-alist)
+ gnus-topic-topology gnus-topic-alist
+ gnus-cloud-sequence
+ gnus-cloud-file-timestamps)
"Gnus variables saved in the quick startup file.")
(defvar gnus-newsrc-alist nil
commit 16c9f5a700804fb04d4f179f8df072a59a5e800a
Author: Lars Ingebrigtsen <[email protected]>
Date: Tue Feb 4 17:53:11 2014 -0800
Prune old chunks
diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el
index 3a6d6cd..00e3b0d 100644
--- a/lisp/gnus-cloud.el
+++ b/lisp/gnus-cloud.el
@@ -32,7 +32,7 @@
:group 'gnus)
(defcustom gnus-cloud-synced-files
- '("~/.authinfo"
+ '(;;"~/.authinfo"
"~/.authinfo.gpg"
"~/.gnus.el"
(:directory "~/News" :match ".*.SCORE\\'"))
@@ -40,7 +40,10 @@
:group 'gnus-cloud
:type '(repeat regexp))
+(defvar gnus-cloud-group-name "*Emacs Cloud*")
+
(defvar gnus-cloud-version 1)
+(defvar gnus-cloud-sequence 1)
(defvar gnus-cloud-method nil
"The IMAP select method used to store the cloud data.")
@@ -224,6 +227,70 @@
(string< old timestamp))
timestamp)))
+(defun gnus-cloud-ensure-cloud-group ()
+ (let ((method (if (stringp gnus-cloud-method)
+ (gnus-server-to-method gnus-cloud-method)
+ gnus-cloud-method)))
+ (unless (or (gnus-active gnus-cloud-group-name)
+ (gnus-activate-group gnus-cloud-group-name nil nil
+ gnus-cloud-method))
+ (and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method)
+ (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
+ (gnus-subscribe-group gnus-cloud-group-name)))))
+
+(defun gnus-cloud-upload-data ()
+ (gnus-cloud-ensure-cloud-group)
+ (with-temp-buffer
+ (let* ((full t)
+ (elems (gnus-cloud-files-to-upload full)))
+ (insert (format "Subject: (sequence: %d type: %s)\n"
+ gnus-cloud-sequence
+ (if full :full :partial)))
+ (insert "From: [email protected]\n")
+ (insert "\n")
+ (insert (gnus-cloud-make-chunk elems))
+ (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method
+ t t))))
+
+(defun gnus-cloud-available-chunks ()
+ (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
+ (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))
+ (active (gnus-active group))
+ headers head)
+ (when (gnus-retrieve-headers (gnus-uncompress-range active) group)
+ (with-current-buffer nntp-server-buffer
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (setq head (nnheader-parse-head)))
+ (push head headers))))
+ (nreverse headers)))
+
+(defun gnus-cloud-chunk-sequence (string)
+ (if (string-match "sequence: \\([0-9]+\\)" string)
+ (string-to-number (match-string 1 string))
+ 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))))))
+ (found nil))
+ (while (and headers
+ (not found))
+ (when (string-match "type: :full" (mail-header-subject (car headers)))
+ (setq found t))
+ (pop headers))
+ ;; All the chunks that are older than the newest :full chunk can be
+ ;; deleted.
+ (when headers
+ (gnus-request-expire-articles
+ (mapcar (lambda (h)
+ (mail-header-number h))
+ (nreverse headers))
+ (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)))))
+
(provide 'gnus-cloud)
;;; gnus-cloud.el ends here
commit 098bafdb3e9280e6b9e9c8b3854fe26760af75dd
Author: Lars Ingebrigtsen <[email protected]>
Date: Tue Feb 4 16:48:59 2014 -0800
* gnus-int.el (gnus-request-accept-article): Doc fix.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c08d634..6df17d2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2014-02-05 Lars Ingebrigtsen <[email protected]>
+
+ * gnus-int.el (gnus-request-accept-article): Doc fix.
+
2014-02-04 Lars Ingebrigtsen <[email protected]>
* parse-time.el (parse-time-iso8601-regexp)
diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el
index 34bf78a..edf6119 100644
--- a/lisp/gnus-int.el
+++ b/lisp/gnus-int.el
@@ -754,7 +754,6 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(defun gnus-request-accept-article (group &optional gnus-command-method last
no-encode)
- ;; Make sure there's a newline at the end of the article.
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(when (and (not gnus-command-method)
@@ -762,6 +761,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(setq gnus-command-method (or (gnus-find-method-for-group group)
(gnus-group-name-to-method group))))
(goto-char (point-max))
+ ;; Make sure there's a newline at the end of the article.
(unless (bolp)
(insert "\n"))
(unless no-encode
-----------------------------------------------------------------------
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 | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++-
lisp/gnus-int.el | 2 +-
lisp/gnus.el | 4 ++-
4 files changed, 89 insertions(+), 3 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