;;; gnus-cloud.el --- storing and retrieving data via IMAP
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail
(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
(: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)
(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
(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)
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-activate-group gnus-cloud-group-name nil nil method))
+ (and (gnus-request-create-group gnus-cloud-group-name method)
+ (gnus-activate-group gnus-cloud-group-name nil nil method)
(gnus-subscribe-group gnus-cloud-group-name)))))
(defun gnus-cloud-upload-data (&optional full)
(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)
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))
(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