X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-sync.el;h=058724e5e1681bf080529c5e7e13203cc5369689;hp=6a45c672ed1fd4dcdde09fbd88724cb160481f70;hb=b83561e18ceb438203812786590893bd5fc2a6cc;hpb=d38bed32440e3c3b979152602f37d6d2d5e0fa36 diff --git a/lisp/gnus-sync.el b/lisp/gnus-sync.el index 6a45c672e..058724e5e 100644 --- a/lisp/gnus-sync.el +++ b/lisp/gnus-sync.el @@ -1,6 +1,6 @@ ;;; gnus-sync.el --- synchronization facility for Gnus -;; Copyright (C) 2010-2012 Free Software Foundation, Inc. +;; Copyright (C) 2010-2015 Free Software Foundation, Inc. ;; Author: Ted Zlatanov ;; Keywords: news synchronization nntp nnrss @@ -99,6 +99,13 @@ (require 'gnus) (require 'gnus-start) (require 'gnus-util) +(require 'gmm-utils) + +(defvar gnus-topic-alist) ;; gnus-group.el +(eval-when-compile + (autoload 'gnus-group-topic "gnus-topic") + (autoload 'gnus-topic-create-topic "gnus-topic" nil t) + (autoload 'gnus-topic-enter-dribble "gnus-topic")) (defgroup gnus-sync nil "The Gnus synchronization facility." @@ -114,6 +121,13 @@ this setting is harmless until the user chooses a sync backend." :group 'gnus-sync :type '(repeat regexp)) +(defcustom gnus-sync-newsrc-offsets '(2 3) + "List of per-group data to be synchronized." + :group 'gnus-sync + :version "24.4" + :type '(set (const :tag "Read ranges" 2) + (const :tag "Marks" 3))) + (defcustom gnus-sync-global-vars nil "List of global variables to be synchronized. You may want to sync `gnus-newsrc-last-checked-date' but pretty @@ -136,14 +150,22 @@ and `gnus-topic-alist'. Also see `gnus-variable-list'." (defvar gnus-sync-newsrc-loader nil "Carrier for newsrc data") +(defcustom gnus-sync-file-encrypt-to nil + "If non-nil, set `epa-file-encrypt-to' from this for encrypting the Sync file." + :version "24.4" + :type '(choice string (repeat string)) + :group 'gnus-sync) + (defcustom gnus-sync-lesync-name (system-name) "The LeSync name for this machine." :group 'gnus-sync + :version "24.3" :type 'string) -(defcustom gnus-sync-lesync-install-topics 'ask +(defcustom gnus-sync-lesync-install-topics 'ask "Should LeSync install the recorded topics?" :group 'gnus-sync + :version "24.3" :type '(choice (const :tag "Never Install" nil) (const :tag "Always Install" t) (const :tag "Ask Me Once" ask))) @@ -172,7 +194,7 @@ and `gnus-topic-alist'. Also see `gnus-variable-list'." (defun gnus-sync-lesync-call (url method headers &optional kvdata) "Make an access request to URL using KVDATA and METHOD. KVDATA must be an alist." - (flet ((json-alist-p (list) (gnus-sync-json-alist-p list))) ; temp patch + (gmm-flet ((json-alist-p (list) (gnus-sync-json-alist-p list))) ; temp patch (let ((url-request-method method) (url-request-extra-headers headers) (url-request-data (if kvdata (json-encode kvdata) nil))) @@ -230,7 +252,7 @@ When SALT is nil, a random one will be generated using `random'." (security-object (concat url "/_security")) (user-record `((names . [,user]) (roles . []))) (couch-user-name (format "org.couchdb.user:%s" user)) - (salt (or salt (sha1 (format "%s" (random t))))) + (salt (or salt (sha1 (format "%s" (random))))) (couch-user-record `((_id . ,couch-user-name) (type . user) @@ -746,11 +768,22 @@ With a prefix, FORCE is set and all groups will be saved." ;; entry in gnus-newsrc-alist whose group matches any of the ;; gnus-sync-newsrc-groups ;; TODO: keep the old contents for groups we don't have! - (let ((gnus-sync-newsrc-loader (gnus-sync-newsrc-loader-builder))) + (let ((gnus-sync-newsrc-loader + (loop for entry in (cdr gnus-newsrc-alist) + when (gnus-grep-in-list + (car entry) ;the group name + gnus-sync-newsrc-groups) + collect (cons (car entry) + (mapcar (lambda (offset) + (cons offset (nth offset entry))) + gnus-sync-newsrc-offsets))))) (with-temp-file gnus-sync-backend (progn (let ((coding-system-for-write gnus-ding-file-coding-system) (standard-output (current-buffer))) + (when gnus-sync-file-encrypt-to + (set (make-local-variable 'epa-file-encrypt-to) + gnus-sync-file-encrypt-to)) (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" gnus-ding-file-coding-system)) (princ ";; Gnus sync data v. 0.0.1\n") @@ -810,24 +843,24 @@ With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed." (stringp (nth 1 gnus-sync-backend))) (let ((errored nil) name ftime) - (mapcar (lambda (entry) - (setq name (cdr (assq 'id entry))) - ;; set ftime the FIRST time through this loop, that - ;; way it reflects the time we FINISHED reading - (unless ftime (setq ftime (float-time))) - - (unless errored - (setq errored - (when (equal name - (gnus-sync-lesync-read-group-entry - (nth 1 gnus-sync-backend) - name - (cdr (assq 'value entry)) - `(read-time ,ftime) - `(subscribe-all ,subscribe-all))) - (gnus-sync-lesync-install-group-entry - (cdr (assq 'id entry))))))) - (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend))))) + (mapc (lambda (entry) + (setq name (cdr (assq 'id entry))) + ;; set ftime the FIRST time through this loop, that + ;; way it reflects the time we FINISHED reading + (unless ftime (setq ftime (float-time))) + + (unless errored + (setq errored + (when (equal name + (gnus-sync-lesync-read-group-entry + (nth 1 gnus-sync-backend) + name + (cdr (assq 'value entry)) + `(read-time ,ftime) + `(subscribe-all ,subscribe-all))) + (gnus-sync-lesync-install-group-entry + (cdr (assq 'id entry))))))) + (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend))))) ((stringp gnus-sync-backend) ;; read data here...