aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lisp/gnus/ChangeLog43
-rw-r--r--lisp/gnus/gnus-registry.el12
-rw-r--r--lisp/gnus/gnus-start.el1
-rw-r--r--lisp/gnus/gnus-sum.el12
-rw-r--r--lisp/gnus/gnus-sync.el230
-rw-r--r--lisp/gnus/gnus-util.el8
6 files changed, 290 insertions, 16 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index fb4f6e64d0..40e4fe8ab6 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,46 @@
+2010-08-12 Teodor Zlatanov <[email protected]>
+
+ Optimizations for gnus-sync.el.
+
+ * gnus-sync.el: Add docs about gnus-sync-backend
+ possibilities.
+ (gnus-sync-save): Remove unnecessary message.
+ (gnus-sync-read): Optimize and show what groups were skipped.
+
+2010-08-12 Teodor Zlatanov <[email protected]>
+
+ Minor bug fixes for gnus-sync.el.
+
+ * gnus-sync.el (gnus-sync-unload-hook, gnus-sync-install-hooks): Don't
+ read the sync on get-new-news.
+
+ * gnus-sync.el (gnus-sync-save): Define `variable' so the compiler is
+ quiet.
+
+ * gnus-sync.el (gnus-sync-read): Use `gnus-sync-newsrc-offsets' (fix typo).
+
+2010-07-30 Lawrence Mitchell <[email protected]>
+
+ Make saving and restoring of hidden threads work with overlays.
+ Patch applied by Ted Zlatanov.
+
+ * gnus-sum.el (gnus-hidden-threads-configuration)
+ (gnus-restore-hidden-threads-configuration): Update to deal with text
+ properties, rather than searching for a magic character.
+
+2010-08-12 Teodor Zlatanov <[email protected]>
+
+ New gnus-sync.el library for synchronization of marks.
+
+ * gnus-sync.el: New library for synchronization of marks.
+
+ * gnus-util.el (gnus-grep-in-list): Moved from gnus-registry.el and
+ renamed from `gnus-registry-grep-in-list'.
+
+ * gnus-registry.el (gnus-registry-follow-group-p): Use `gnus-grep-in-list'.
+
+ * gnus-start.el (gnus-start-draft-setup): Make it interactive.
+
2010-08-06 Katsumi Yamaoka <[email protected]>
* rfc2047.el (rfc2047-encode): Use utf-8 as a last resort if
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index db10440116..e3af088278 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -661,10 +661,10 @@ necessary."
"Determines if a group name should be followed.
Consults `gnus-registry-unfollowed-groups' and
`nnmail-split-fancy-with-parent-ignore-groups'."
- (not (or (gnus-registry-grep-in-list
+ (not (or (gnus-grep-in-list
group
gnus-registry-unfollowed-groups)
- (gnus-registry-grep-in-list
+ (gnus-grep-in-list
group
nnmail-split-fancy-with-parent-ignore-groups))))
@@ -745,14 +745,6 @@ Consults `gnus-registry-unfollowed-groups' and
(assoc article (gnus-data-list nil)))))
nil))
-(defun gnus-registry-grep-in-list (word list)
-"Find if a WORD matches any regular expression in the given LIST."
- (when (and word list)
- (catch 'found
- (dolist (r list)
- (when (string-match r word)
- (throw 'found r))))))
-
(defun gnus-registry-do-marks (type function)
"For each known mark, call FUNCTION for each cell of type TYPE.
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 9ef251f214..91cb5932f4 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -813,6 +813,7 @@ prompt the user for the name of an NNTP server to use."
(gnus-run-hooks 'gnus-started-hook))))))
(defun gnus-start-draft-setup ()
+ (interactive)
"Make sure the draft group exists."
(gnus-request-create-group "drafts" '(nndraft ""))
(unless (gnus-group-entry "nndraft:drafts")
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 93024e0728..53a247078c 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -3406,8 +3406,10 @@ marks of articles."
(save-excursion
(let (config)
(goto-char (point-min))
- (while (search-forward "\r" nil t)
- (push (1- (point)) config))
+ (while (not (eobp))
+ (when (eq (get-char-property (point-at-eol) 'invisible) 'gnus-sum)
+ (push (save-excursion (forward-line 0) (point)) config))
+ (forward-line 1))
config)))
(defun gnus-restore-hidden-threads-configuration (config)
@@ -3415,10 +3417,8 @@ marks of articles."
(save-excursion
(let (point (inhibit-read-only t))
(while (setq point (pop config))
- (when (and (< point (point-max))
- (goto-char point)
- (eq (char-after) ?\n))
- (subst-char-in-region point (1+ point) ?\n ?\r))))))
+ (goto-char point)
+ (gnus-summary-hide-thread)))))
;; Various summary mode internalish functions.
diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el
new file mode 100644
index 0000000000..236a874263
--- /dev/null
+++ b/lisp/gnus/gnus-sync.el
@@ -0,0 +1,230 @@
+;;; gnus-sync.el --- synchronization facility for Gnus
+
+;;; Copyright (C) 2010
+;;; Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <[email protected]>
+;; Keywords: news synchronization nntp nnrss
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is the gnus-sync.el package.
+
+;; Put this in your startup file (~/.gnus.el for instance)
+
+;; possibilities for gnus-sync-backend:
+;; Tramp over SSH: /ssh:user@host:/path/to/filename
+;; Tramp over IMAP: /imaps:[email protected]:/INBOX.test/filename
+;; ...or any other file Tramp and Emacs can handle...
+
+;; (setq gnus-sync-backend `("/remote:/path.gpg") ; will use Tramp+EPA if loaded
+;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date)
+;; gnus-sync-newsrc-groups `("nntp" "nnrss")
+;; gnus-sync-newsrc-vars `(read marks))
+
+;; TODO:
+
+;; - after gnus-sync-read, the message counts are wrong
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'gnus-util)
+
+(defgroup gnus-sync nil
+ "The Gnus synchronization facility."
+ :version "23.1"
+ :group 'gnus)
+
+(defcustom gnus-sync-newsrc-groups `("nntp" "nnrss")
+ "List of groups to be synchronized in the gnus-newsrc-alist.
+The group names are matched, they don't have to be fully
+qualified. Typically you would choose all of these. That's the
+default because there is no active sync backend by default, so
+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
+ :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
+much any symbol is fair game. You could additionally sync
+`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology',
+and `gnus-topic-alist' to cover all the variables in
+newsrc.eld (except for `gnus-format-specs' which should not be
+synchronized, I believe). Also see `gnus-variable-list'."
+ :group 'gnus-sync
+ :type '(repeat (choice (variable :tag "A known variable")
+ (symbol :tag "Any symbol"))))
+
+(defcustom gnus-sync-backend nil
+ "The synchronization backend."
+ :group 'gnus-sync
+ :type '(radio (const :format "None" nil)
+ (string :tag "Sync to a file")))
+
+(defvar gnus-sync-newsrc-loader nil
+ "Carrier for newsrc data")
+
+(defun gnus-sync-save ()
+"Save the Gnus sync data to the backend."
+ (interactive)
+ (cond
+ ((stringp gnus-sync-backend)
+ (gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend)
+ ;; populate gnus-sync-newsrc-loader from all but the first dummy
+ ;; entry in gnus-newsrc-alist whose group matches any of the
+ ;; gnus-sync-newsrc-groups
+ (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)))
+ (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
+ gnus-ding-file-coding-system))
+ (princ ";; Gnus sync data v. 0.0.1\n")
+ (let* ((print-quoted t)
+ (print-readably t)
+ (print-escape-multibyte nil)
+ (print-escape-nonascii t)
+ (print-length nil)
+ (print-level nil)
+ (print-circle nil)
+ (print-escape-newlines t)
+ (variables (cons 'gnus-sync-newsrc-loader
+ gnus-sync-global-vars))
+ variable)
+ (while variables
+ (when (and (boundp (setq variable (pop variables)))
+ (symbol-value variable))
+ (princ "\n(setq ")
+ (princ (symbol-name variable))
+ (princ " '")
+ (prin1 (symbol-value variable))
+ (princ ")\n"))))
+ (gnus-message
+ 7
+ "gnus-sync: stored variables %s and %d groups in %s"
+ gnus-sync-global-vars
+ (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+
+ ;; Idea from Dan Christensen <[email protected]>
+ ;; Save the .eld file with extra line breaks.
+ (gnus-message 8 "gnus-sync: adding whitespace to %s"
+ gnus-sync-backend)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^(\\|(\\\"" nil t)
+ (replace-match "\n\\&" t))
+ (goto-char (point-min))
+ (while (re-search-forward " $" nil t)
+ (replace-match "" t t))))))))
+ ;; the pass-through case: gnus-sync-backend is not a known choice
+ (nil)))
+
+(defun gnus-sync-read ()
+"Load the Gnus sync data from the backend."
+ (interactive)
+ (when gnus-sync-backend
+ (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend)
+ (cond ((stringp gnus-sync-backend)
+ ;; read data here...
+ (if (or debug-on-error debug-on-quit)
+ (load gnus-sync-backend nil t)
+ (condition-case var
+ (load gnus-sync-backend nil t)
+ (error
+ (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
+ (let ((valid-count 0)
+ invalid-groups)
+ (dolist (node gnus-sync-newsrc-loader)
+ (if (gnus-gethash (car node) gnus-newsrc-hashtb)
+ (progn
+ (incf valid-count)
+ (loop for store in (cdr node)
+ do (setf (nth (car store)
+ (assoc (car node) gnus-newsrc-alist))
+ (cdr store))))
+ (push (car node) invalid-groups)))
+ (gnus-message
+ 7
+ "gnus-sync: loaded %d groups (out of %d) from %s"
+ valid-count (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (when invalid-groups
+ (gnus-message
+ 7
+ "gnus-sync: skipped %d groups (out of %d) from %s"
+ (length invalid-groups)
+ (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (gnus-message 9 "gnus-sync: skipped groups: %s"
+ (mapconcat 'identity invalid-groups ", ")))
+ (setq gnus-sync-newsrc-loader nil)))
+ (nil))
+ ;; make the hashtable again because the newsrc-alist may have been modified
+ (when gnus-sync-newsrc-offsets
+ (gnus-message 9 "gnus-sync: remaking the newsrc hashtable")
+ (gnus-make-hashtable-from-newsrc-alist))))
+
+;;;###autoload
+(defun gnus-sync-initialize ()
+"Initialize the Gnus sync facility."
+ (interactive)
+ (gnus-message 5 "Initializing the sync facility")
+ (gnus-sync-install-hooks))
+
+;;;###autoload
+(defun gnus-sync-install-hooks ()
+ "Install the sync hooks."
+ (interactive)
+ ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read)
+ (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
+ (add-hook 'gnus-read-newsrc-el-hoo4a 'gnus-sync-read))
+
+(defun gnus-sync-unload-hook ()
+ "Uninstall the sync hooks."
+ (interactive)
+ ;; (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read)
+ (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
+ (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
+
+(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook)
+
+;; this is harmless by default, until the gnus-sync-backend is set
+(gnus-sync-initialize)
+
+(provide 'gnus-sync)
+
+;;; gnus-sync.el ends here
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index b8a1c266c9..93cc1f0a54 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1297,6 +1297,14 @@ Return the modified alist."
(setq alist (delq entry alist)))
alist)))
+(defun gnus-grep-in-list (word list)
+ "Find if a WORD matches any regular expression in the given LIST."
+ (when (and word list)
+ (catch 'found
+ (dolist (r list)
+ (when (string-match r word)
+ (throw 'found r))))))
+
(defmacro gnus-pull (key alist &optional assoc-p)
"Modify ALIST to be without KEY."
(unless (symbolp alist)