aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKatsumi Yamaoka2010-08-31 00:38:32 +0000
committerKatsumi Yamaoka2010-08-31 00:38:32 +0000
commit390dd504ebe2e9b9d7b0a5ac2076301c35acc8fe (patch)
treeaed9229d6f9934ec67121c11395f5372061e1686
parentf02566ce1e47303059374c38d995d41e9e724793 (diff)
downloademacs-390dd504ebe2e9b9d7b0a5ac2076301c35acc8fe.tar.gz
emacs-390dd504ebe2e9b9d7b0a5ac2076301c35acc8fe.zip
Removed gnus-move.el and pointers to it, since it doesn't really work; by Lars Magne Ingebrigtsen <larsi@gnus.org>.
-rw-r--r--lisp/gnus/ChangeLog2
-rw-r--r--lisp/gnus/gnus-move.el181
-rw-r--r--lisp/gnus/gnus.el2
3 files changed, 2 insertions, 183 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 12c84e53ba5..61f6963ca9e 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,5 +1,7 @@
12010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org> 12010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
2 2
3 * gnus-move.el: Removed file, since it doesn't really work.
4
3 * gnus-html.el (gnus-article-html): Tell w3m that the input is 5 * gnus-html.el (gnus-article-html): Tell w3m that the input is
4 UTF-8. This seems to fix problems with some German web feeds. 6 UTF-8. This seems to fix problems with some German web feeds.
5 7
diff --git a/lisp/gnus/gnus-move.el b/lisp/gnus/gnus-move.el
deleted file mode 100644
index 2c7a9585fec..00000000000
--- a/lisp/gnus/gnus-move.el
+++ /dev/null
@@ -1,181 +0,0 @@
1;;; gnus-move.el --- commands for moving Gnus from one server to another
2
3;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7;; Keywords: news
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;;; Code:
27
28(eval-when-compile (require 'cl))
29
30(require 'gnus)
31(require 'gnus-start)
32(require 'gnus-int)
33(require 'gnus-range)
34
35;;;
36;;; Moving by comparing Message-ID's.
37;;;
38
39;;;###autoload
40(defun gnus-change-server (from-server to-server)
41 "Move from FROM-SERVER to TO-SERVER.
42Update the .newsrc.eld file to reflect the change of nntp server."
43 (interactive
44 (list gnus-select-method (gnus-read-method "Move to method: ")))
45
46 ;; First start Gnus.
47 (let ((gnus-activate-level 0)
48 (mail-sources nil))
49 (gnus))
50
51 (save-excursion
52 ;; Go through all groups and translate.
53 (let ((nntp-nov-gap nil))
54 (dolist (info gnus-newsrc-alist)
55 (when (gnus-group-native-p (gnus-info-group info))
56 (gnus-move-group-to-server info from-server to-server))))))
57
58(defun gnus-move-group-to-server (info from-server to-server)
59 "Move group INFO from FROM-SERVER to TO-SERVER."
60 (let ((group (gnus-info-group info))
61 to-active hashtb type mark marks
62 to-article to-reads to-marks article
63 act-articles)
64 (gnus-message 7 "Translating %s..." group)
65 (when (gnus-request-group group nil to-server)
66 (setq to-active (gnus-parse-active)
67 hashtb (gnus-make-hashtable 1024)
68 act-articles (gnus-uncompress-range to-active))
69 ;; Fetch the headers from the `to-server'.
70 (when (and to-active
71 act-articles
72 (setq type (gnus-retrieve-headers
73 act-articles
74 group to-server)))
75 ;; Convert HEAD headers. I don't care.
76 (when (eq type 'headers)
77 (nnvirtual-convert-headers))
78 ;; Create a mapping from Message-ID to article number.
79 (set-buffer nntp-server-buffer)
80 (goto-char (point-min))
81 (while (looking-at
82 "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
83 (gnus-sethash
84 (buffer-substring (match-beginning 1) (match-end 1))
85 (read (current-buffer))
86 hashtb)
87 (forward-line 1))
88 ;; Then we read the headers from the `from-server'.
89 (when (and (gnus-request-group group nil from-server)
90 (gnus-active group)
91 (gnus-uncompress-range
92 (gnus-active group))
93 (setq type (gnus-retrieve-headers
94 (gnus-uncompress-range
95 (gnus-active group))
96 group from-server)))
97 ;; Make it easier to map marks.
98 (let ((mark-lists (gnus-info-marks info))
99 ms type m)
100 (while mark-lists
101 (setq type (caar mark-lists)
102 ms (gnus-uncompress-range (cdr (pop mark-lists))))
103 (while ms
104 (if (setq m (assq (car ms) marks))
105 (setcdr m (cons type (cdr m)))
106 (push (list (car ms) type) marks))
107 (pop ms))))
108 ;; Convert.
109 (when (eq type 'headers)
110 (nnvirtual-convert-headers))
111 ;; Go through the headers and map away.
112 (set-buffer nntp-server-buffer)
113 (goto-char (point-min))
114 (while (looking-at
115 "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
116 (when (setq to-article
117 (gnus-gethash
118 (buffer-substring (match-beginning 1) (match-end 1))
119 hashtb))
120 ;; Add this article to the list of read articles.
121 (push to-article to-reads)
122 ;; See if there are any marks and then add them.
123 (when (setq mark (assq (read (current-buffer)) marks))
124 (setq marks (delq mark marks))
125 (setcar mark to-article)
126 (push mark to-marks))
127 (forward-line 1)))
128 ;; Now we know what the read articles are and what the
129 ;; article marks are. We transform the information
130 ;; into the Gnus info format.
131 (setq to-reads
132 (gnus-range-add
133 (gnus-compress-sequence
134 (and (setq to-reads (delq nil to-reads))
135 (sort to-reads '<))
136 t)
137 (cons 1 (1- (car to-active)))))
138 (gnus-info-set-read info to-reads)
139 ;; Do the marks. I'm sure y'all understand what's
140 ;; going on down below, so I won't bother with any
141 ;; further comments. <duck>
142 (let ((mlists gnus-article-mark-lists)
143 lists ms a)
144 (while mlists
145 (push (list (cdr (pop mlists))) lists))
146 (while (setq ms (pop marks))
147 (setq article (pop ms))
148 (while ms
149 (setcdr (setq a (assq (pop ms) lists))
150 (cons article (cdr a)))))
151 (setq a lists)
152 (while a
153 (setcdr (car a) (gnus-compress-sequence
154 (and (cdar a) (sort (cdar a) '<))))
155 (pop a))
156 (gnus-info-set-marks info lists t)))))
157 (gnus-message 7 "Translating %s...done" group)))
158
159(defun gnus-group-move-group-to-server (info from-server to-server)
160 "Move the group on the current line from FROM-SERVER to TO-SERVER."
161 (interactive
162 (let ((info (gnus-get-info (gnus-group-group-name))))
163 (list info (gnus-find-method-for-group (gnus-info-group info))
164 (gnus-read-method (format "Move group %s to method: "
165 (gnus-info-group info))))))
166 (save-excursion
167 (gnus-move-group-to-server info from-server to-server)
168 ;; We have to update the group info to point use the right server.
169 (gnus-info-set-method info to-server t)
170 ;; We also have to change the name of the group and stuff.
171 (let* ((group (gnus-info-group info))
172 (new-name (gnus-group-prefixed-name
173 (gnus-group-real-name group) to-server)))
174 (gnus-info-set-group info new-name)
175 (gnus-sethash new-name (gnus-group-entry group) gnus-newsrc-hashtb)
176 (gnus-sethash group nil gnus-newsrc-hashtb))))
177
178(provide 'gnus-move)
179
180;; arch-tag: 503742b8-7d66-4d79-bb31-4a698070707b
181;;; gnus-move.el ends here
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 0f8111c32ba..9fc96c7601b 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3026,8 +3026,6 @@ gnus-registry.el will populate this if it's loaded.")
3026 gnus-dup-enter-articles) 3026 gnus-dup-enter-articles)
3027 ("gnus-range" gnus-copy-sequence) 3027 ("gnus-range" gnus-copy-sequence)
3028 ("gnus-eform" gnus-edit-form) 3028 ("gnus-eform" gnus-edit-form)
3029 ("gnus-move" :interactive t
3030 gnus-group-move-group-to-server gnus-change-server)
3031 ("gnus-logic" gnus-score-advanced) 3029 ("gnus-logic" gnus-score-advanced)
3032 ("gnus-undo" gnus-undo-mode gnus-undo-register) 3030 ("gnus-undo" gnus-undo-mode gnus-undo-register)
3033 ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next 3031 ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next