diff options
Diffstat (limited to 'lisp/gnus/gnus-cloud.el')
| -rw-r--r-- | lisp/gnus/gnus-cloud.el | 32 |
1 files changed, 16 insertions, 16 deletions
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index 00b85f546c2..3bc94f11e79 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -1,4 +1,4 @@ -;;; gnus-cloud.el --- storing and retrieving data via IMAP +;;; gnus-cloud.el --- storing and retrieving data via IMAP -*- lexical-binding: t; -*- ;; Copyright (C) 2014-2021 Free Software Foundation, Inc. @@ -30,8 +30,6 @@ (require 'parse-time) (require 'nnimap) -(declare-function gnus-fetch-headers "gnus-sum") -(defvar gnus-alter-header-function) (eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor' (autoload 'epg-make-context "epg") @@ -54,14 +52,12 @@ Each element may be either a string or a property list. The latter should have a :directory element whose value is a string, and a :match element whose value is a regular expression to match against the basename of files in said directory." - :group 'gnus-cloud :type '(repeat (choice (string :tag "File") (plist :tag "Property list")))) (defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip) "Storage method for cloud data, defaults to EPG if that's available." :version "26.1" - :group 'gnus-cloud :type '(radio (const :tag "No encoding" nil) (const :tag "Base64" base64) (const :tag "Base64+gzip" base64-gzip) @@ -70,7 +66,6 @@ against the basename of files in said directory." (defcustom gnus-cloud-interactive t "Whether Gnus Cloud changes should be confirmed." :version "26.1" - :group 'gnus-cloud :type 'boolean) (defvar gnus-cloud-group-name "Emacs-Cloud") @@ -83,7 +78,6 @@ against the basename of files in said directory." "The IMAP select method used to store the cloud data. See also `gnus-server-set-cloud-method-server' for an easy interactive way to set this from the Server buffer." - :group 'gnus-cloud :type '(radio (const :tag "Not set" nil) (string :tag "A Gnus server name as a string"))) @@ -134,7 +128,7 @@ easy interactive way to set this from the Server buffer." ((eq gnus-cloud-storage-method 'epg) (let ((context (epg-make-context 'OpenPGP)) - cipher) + ) ;; cipher (setf (epg-context-armor context) t) (setf (epg-context-textmode context) t) (let ((data (epg-encrypt-string context @@ -350,15 +344,15 @@ easy interactive way to set this from the Server buffer." (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))) + ;; (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))))) + (gnus-subscribe-group gnus-cloud-group-name)))) ;; ) (defun gnus-cloud-upload-all-data () "Upload all data (newsrc and files) to the Gnus Cloud." @@ -393,6 +387,8 @@ When FULL is t, upload everything, not just a difference from the last full." (gnus-group-refresh-group group)) (gnus-error 2 "Failed to upload Gnus Cloud data to %s" group))))) +(defvar gnus-alter-header-function) + (defun gnus-cloud-add-timestamps (elems) (dolist (elem elems) (let* ((file-name (plist-get elem :file-name)) @@ -407,10 +403,14 @@ When FULL is t, upload everything, not just a difference from the last full." (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)) - (gnus-newsgroup-name group) - (headers (gnus-fetch-headers (gnus-uncompress-range active)))) - (when gnus-alter-header-function - (mapc gnus-alter-header-function headers)) + headers head) + (when (gnus-retrieve-headers (gnus-uncompress-range active) group) + (with-current-buffer nntp-server-buffer + (goto-char (point-min)) + (while (setq head (nnheader-parse-head)) + (when gnus-alter-header-function + (funcall gnus-alter-header-function head)) + (push head headers)))) (sort (nreverse headers) (lambda (h1 h2) (> (gnus-cloud-chunk-sequence (mail-header-subject h1)) |