Mercurial > emacs

changeset 109770:30994c3466ad

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix compilation of xmenu.c and unexcoff.c, clean up MSDOS source files. unexcoff.c: Remove the parts used when "emacs" is not defined. (report_error, report_error_1): Ditto. (write_segment): Remove "#if 0" unused code. (make_hdr): Remove code that was "#ifndef NO_REMAP" before NO_REMAP was removed (in revno 100928). (start_of_text): Remove unused function (was used only if NO_REMAP was NOT defined). msdos.c (IT_set_face): Fix format string to match argument types. (IT_write_glyphs, IT_note_mode_line_highlight) (IT_set_frame_parameters): Remove unused variables. (x_set_menu_bar_lines): Declare set_menu_bar_lines. (IT_set_terminal_modes): Disambiguate expression in if clause. (Fmsdos_remember_default_colors): Return Qnil. (IT_set_frame_parameters): Add parens to disambiguate boolean expression for logging the cursor type to termscript. (keyboard_layout_list, keypad_translate_map) (grey_key_translate_map): Add braces in inner initializers. (dos_rawgetc): Add parens in condition for mouse-3 button-press. (dos_rawgetc): Remove unused label. (XMenuActivate): Add braces to remove ambiguous `else'. (dos_ttraw): Always return a value. (spawnve): Declare. (run_msdos_command): Cast 3rd arg of spawnve to "char **". dosfns.h (x_set_title): Declare. w16select.c (Fw16_set_clipboard_data, Fw16_get_clipboard_data): Remove unused variables. dosfns.c (Fint86, Fdos_memget, Fdos_memput): Remove unused variables. (init_dosfns): Declare get_lim_data. (system_process_attributes): Declare Fget_internal_run_time. xmenu.c (xmenu_show) [!USE_X_TOOLKIT && !USE_GTK]: Fix argument list to be consistent with menu.h.
author Eli Zaretskii <eliz@gnu.org>
date Fri, 13 Aug 2010 14:09:51 +0300
parents fe81389a263d (diff) 8186d147fb99 (current diff)
children 3c2274d0da65
files
diffstat 6 files changed, 290 insertions(+), 16 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Fri Aug 13 13:29:48 2010 +0300
+++ b/lisp/gnus/ChangeLog	Fri Aug 13 14:09:51 2010 +0300
@@ -1,3 +1,46 @@
+2010-08-12  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	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  <tzz@lifelogs.com>
+
+	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  <wence@gmx.li>
+
+	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  <tzz@lifelogs.com>
+
+	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  <yamaoka@jpl.org>
 
 	* rfc2047.el (rfc2047-encode): Use utf-8 as a last resort if
--- a/lisp/gnus/gnus-registry.el	Fri Aug 13 13:29:48 2010 +0300
+++ b/lisp/gnus/gnus-registry.el	Fri Aug 13 14:09:51 2010 +0300
@@ -661,10 +661,10 @@
   "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 @@
 			  (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.
 
--- a/lisp/gnus/gnus-start.el	Fri Aug 13 13:29:48 2010 +0300
+++ b/lisp/gnus/gnus-start.el	Fri Aug 13 14:09:51 2010 +0300
@@ -813,6 +813,7 @@
 	  (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")
--- a/lisp/gnus/gnus-sum.el	Fri Aug 13 13:29:48 2010 +0300
+++ b/lisp/gnus/gnus-sum.el	Fri Aug 13 14:09:51 2010 +0300
@@ -3406,8 +3406,10 @@
   (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 @@
   (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.
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/gnus/gnus-sync.el	Fri Aug 13 14:09:51 2010 +0300
@@ -0,0 +1,230 @@
+;;; gnus-sync.el --- synchronization facility for Gnus
+
+;;; Copyright (C) 2010
+;;; Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <tzz@lifelogs.com>
+;; 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:user@yourhosthere.com:/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 <jdc@chow.mat.jhu.edu>
+            ;; 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
--- a/lisp/gnus/gnus-util.el	Fri Aug 13 13:29:48 2010 +0300
+++ b/lisp/gnus/gnus-util.el	Fri Aug 13 14:09:51 2010 +0300
@@ -1297,6 +1297,14 @@
 	(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)