diff options
| author | Katsumi Yamaoka | 2010-08-31 00:38:32 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2010-08-31 00:38:32 +0000 |
| commit | 390dd504ebe2e9b9d7b0a5ac2076301c35acc8fe (patch) | |
| tree | aed9229d6f9934ec67121c11395f5372061e1686 | |
| parent | f02566ce1e47303059374c38d995d41e9e724793 (diff) | |
| download | emacs-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/ChangeLog | 2 | ||||
| -rw-r--r-- | lisp/gnus/gnus-move.el | 181 | ||||
| -rw-r--r-- | lisp/gnus/gnus.el | 2 |
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 @@ | |||
| 1 | 2010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org> | 1 | 2010-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. | ||
| 42 | Update 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 |