X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/dacbc44ca3fc825c9e5ffa799f1a0937c1da0020..68ce800e9200724d36a0b1bf1923401682bce96d:/lisp/gnus/gnus-sync.el diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el index 3d20c238a5..249eb087b0 100644 --- a/lisp/gnus/gnus-sync.el +++ b/lisp/gnus/gnus-sync.el @@ -1,6 +1,6 @@ ;;; gnus-sync.el --- synchronization facility for Gnus -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. +;; Copyright (C) 2010-2016 Free Software Foundation, Inc. ;; Author: Ted Zlatanov ;; Keywords: news synchronization nntp nnrss @@ -90,10 +90,7 @@ (require 'gnus-util) (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")) +(autoload 'gnus-group-topic "gnus-topic") (defgroup gnus-sync nil "The Gnus synchronization facility." @@ -112,8 +109,9 @@ this setting is harmless until the user chooses a sync backend." (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))) + (const :tag "Marks" 3))) (defcustom gnus-sync-global-vars nil "List of global variables to be synchronized. @@ -137,6 +135,12 @@ 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 @@ -175,16 +179,15 @@ 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 - (let ((url-request-method method) - (url-request-extra-headers headers) - (url-request-data (if kvdata (json-encode kvdata) nil))) - (with-current-buffer (url-retrieve-synchronously url) - (let ((data (gnus-sync-lesync-parse))) - (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S" - method url `((headers . ,headers) (data ,kvdata)) data) - (kill-buffer (current-buffer)) - data))))) + (let ((url-request-method method) + (url-request-extra-headers headers) + (url-request-data (if kvdata (json-encode kvdata) nil))) + (with-current-buffer (url-retrieve-synchronously url) + (let ((data (gnus-sync-lesync-parse))) + (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S" + method url `((headers . ,headers) (data ,kvdata)) data) + (kill-buffer (current-buffer)) + data)))) (defun gnus-sync-lesync-PUT (url headers &optional data) (gnus-sync-lesync-call url "PUT" headers data)) @@ -198,27 +201,6 @@ KVDATA must be an alist." (defun gnus-sync-lesync-DELETE (url headers &optional data) (gnus-sync-lesync-call url "DELETE" headers data)) -;; this is not necessary with newer versions of json.el but 1.2 or older -;; (which are in Emacs 24.1 and earlier) need it -(defun gnus-sync-json-alist-p (list) - "Non-null if and only if LIST is an alist." - (while (consp list) - (setq list (if (consp (car list)) - (cdr list) - 'not-alist))) - (null list)) - -;; this is not necessary with newer versions of json.el but 1.2 or older -;; (which are in Emacs 24.1 and earlier) need it -(defun gnus-sync-json-plist-p (list) - "Non-null if and only if LIST is a plist." - (while (consp list) - (setq list (if (and (keywordp (car list)) - (consp (cdr list))) - (cddr list) - 'not-plist))) - (null list)) - ; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t) ; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz") @@ -599,6 +581,10 @@ unwanted groups via the LeSync URL." loc name gnus-sync-lesync-name (or sources ""))) nil))) +(declare-function gnus-topic-create-topic "gnus-topic" + (topic parent &optional previous full-topic)) +(declare-function gnus-topic-enter-dribble "gnus-topic" ()) + (defun gnus-sync-lesync-install-group-entry (name) (let* ((master (assoc name gnus-newsrc-alist)) (old-topic-name (gnus-group-topic name)) @@ -762,6 +748,9 @@ With a prefix, FORCE is set and all groups will be saved." (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")