Mercurial > emacs
annotate lisp/gnus/gnus-srvr.el @ 83445:1b1b0cb2e2a8
Experimental change: don't restore kboard after temporary changes if Emacs wasn't in single kboard state.
* src/keyboard.c (pop_kboard): Help debugging by not changing
current_kboard unnecessarily.
(temporarily_switch_to_single_kboard, record_single_kboard_state):
Don't push_kboard if we weren't in single kboard state.
Don't pop_kboard if we popped into any kboard state.
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-485
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Mon, 02 Jan 2006 07:54:50 +0000 |
parents | fafd692d1e40 |
children | 1077b8039c32 2d92f5c9d6ae |
rev | line source |
---|---|
17493 | 1 ;;; gnus-srvr.el --- virtual server support for Gnus |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
2 |
62890
4b7fa3ee8e9e
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-336
Miles Bader <miles@gnu.org>
parents:
61126
diff
changeset
|
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
4 ;; 2004, 2005 Free Software Foundation, Inc. |
17493 | 5 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
17493 | 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 2, or (at your option) | |
14 ;; 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; see the file COPYING. If not, write to the | |
64085 | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 ;; Boston, MA 02110-1301, USA. | |
17493 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;;; Code: | |
29 | |
19521
6f6cf9184e93
Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
30 (eval-when-compile (require 'cl)) |
6f6cf9184e93
Require cl at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
31 |
17493 | 32 (require 'gnus) |
33 (require 'gnus-spec) | |
34 (require 'gnus-group) | |
35 (require 'gnus-int) | |
36 (require 'gnus-range) | |
37 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
38 (defcustom gnus-server-mode-hook nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
39 "Hook run in `gnus-server-mode' buffers." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
40 :group 'gnus-server |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
41 :type 'hook) |
17493 | 42 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
43 (defcustom gnus-server-exit-hook nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
44 "Hook run when exiting the server buffer." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
45 :group 'gnus-server |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
46 :type 'hook) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
47 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
48 (defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n" |
17493 | 49 "Format of server lines. |
50 It works along the same lines as a normal formatting string, | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
51 with some simple extensions. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
52 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
53 The following specs are understood: |
17493 | 54 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
55 %h backend |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
56 %n name |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
57 %w address |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
58 %s status |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
59 %a agent covered |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
60 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
61 General format specifiers can also be used. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
62 See Info node `(gnus)Formatting Variables'." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
63 :link '(custom-manual "(gnus)Formatting Variables") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
64 :group 'gnus-server-visual |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
65 :type 'string) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
66 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
67 (defcustom gnus-server-mode-line-format "Gnus: %%b" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
68 "The format specification for the server mode line." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
69 :group 'gnus-server-visual |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
70 :type 'string) |
17493 | 71 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
72 (defcustom gnus-server-browse-in-group-buffer nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
73 "Whether server browsing should take place in the group buffer. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
74 If nil, a faster, but more primitive, buffer is used instead." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
75 :version "22.1" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
76 :group 'gnus-server-visual |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
77 :type 'boolean) |
17493 | 78 |
79 ;;; Internal variables. | |
80 | |
81 (defvar gnus-inserted-opened-servers nil) | |
82 | |
83 (defvar gnus-server-line-format-alist | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
84 `((?h gnus-tmp-how ?s) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
85 (?n gnus-tmp-name ?s) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
86 (?w gnus-tmp-where ?s) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
87 (?s gnus-tmp-status ?s) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
88 (?a gnus-tmp-agent ?s))) |
17493 | 89 |
90 (defvar gnus-server-mode-line-format-alist | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
91 `((?S gnus-tmp-news-server ?s) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
92 (?M gnus-tmp-news-method ?s) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
93 (?u gnus-tmp-user-defined ?s))) |
17493 | 94 |
95 (defvar gnus-server-line-format-spec nil) | |
96 (defvar gnus-server-mode-line-format-spec nil) | |
97 (defvar gnus-server-killed-servers nil) | |
98 | |
99 (defvar gnus-server-mode-map) | |
100 | |
101 (defvar gnus-server-menu-hook nil | |
102 "*Hook run after the creation of the server mode menu.") | |
103 | |
104 (defun gnus-server-make-menu-bar () | |
105 (gnus-turn-off-edit-menu 'server) | |
106 (unless (boundp 'gnus-server-server-menu) | |
107 (easy-menu-define | |
108 gnus-server-server-menu gnus-server-mode-map "" | |
109 '("Server" | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
110 ["Add..." gnus-server-add-server t] |
17493 | 111 ["Browse" gnus-server-read-server t] |
112 ["Scan" gnus-server-scan-server t] | |
113 ["List" gnus-server-list-servers t] | |
114 ["Kill" gnus-server-kill-server t] | |
115 ["Yank" gnus-server-yank-server t] | |
116 ["Copy" gnus-server-copy-server t] | |
117 ["Edit" gnus-server-edit-server t] | |
118 ["Regenerate" gnus-server-regenerate-server t] | |
119 ["Exit" gnus-server-exit t])) | |
120 | |
121 (easy-menu-define | |
122 gnus-server-connections-menu gnus-server-mode-map "" | |
123 '("Connections" | |
124 ["Open" gnus-server-open-server t] | |
125 ["Close" gnus-server-close-server t] | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
126 ["Offline" gnus-server-offline-server t] |
17493 | 127 ["Deny" gnus-server-deny-server t] |
128 "---" | |
129 ["Open All" gnus-server-open-all-servers t] | |
130 ["Close All" gnus-server-close-all-servers t] | |
131 ["Reset All" gnus-server-remove-denials t])) | |
132 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
133 (gnus-run-hooks 'gnus-server-menu-hook))) |
17493 | 134 |
135 (defvar gnus-server-mode-map nil) | |
136 (put 'gnus-server-mode 'mode-class 'special) | |
137 | |
138 (unless gnus-server-mode-map | |
139 (setq gnus-server-mode-map (make-sparse-keymap)) | |
140 (suppress-keymap gnus-server-mode-map) | |
141 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
142 (gnus-define-keys gnus-server-mode-map |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
143 " " gnus-server-read-server-in-server-buffer |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
144 "\r" gnus-server-read-server |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
145 gnus-mouse-2 gnus-server-pick-server |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
146 "q" gnus-server-exit |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
147 "l" gnus-server-list-servers |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
148 "k" gnus-server-kill-server |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
149 "y" gnus-server-yank-server |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
150 "c" gnus-server-copy-server |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
151 "a" gnus-server-add-server |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
152 "e" gnus-server-edit-server |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
153 "s" gnus-server-scan-server |
17493 | 154 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
155 "O" gnus-server-open-server |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
156 "\M-o" gnus-server-open-all-servers |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
157 "C" gnus-server-close-server |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
158 "\M-c" gnus-server-close-all-servers |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
159 "D" gnus-server-deny-server |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
160 "L" gnus-server-offline-server |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
161 "R" gnus-server-remove-denials |
17493 | 162 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
163 "n" next-line |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
164 "p" previous-line |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
39322
diff
changeset
|
165 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
166 "g" gnus-server-regenerate-server |
17493 | 167 |
168 "\C-c\C-i" gnus-info-find-node | |
169 "\C-c\C-b" gnus-bug)) | |
170 | |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
171 (defface gnus-server-agent |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
172 '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
173 (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
174 (t (:bold t))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
175 "Face used for displaying AGENTIZED servers" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
176 :group 'gnus-server-visual) |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
177 ;; backward-compatibility alias |
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
178 (put 'gnus-server-agent-face 'face-alias 'gnus-server-agent) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
179 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
180 (defface gnus-server-opened |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
181 '((((class color) (background light)) (:foreground "Green3" :bold t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
182 (((class color) (background dark)) (:foreground "Green1" :bold t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
183 (t (:bold t))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
184 "Face used for displaying OPENED servers" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
185 :group 'gnus-server-visual) |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
186 ;; backward-compatibility alias |
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
187 (put 'gnus-server-opened-face 'face-alias 'gnus-server-opened) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
188 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
189 (defface gnus-server-closed |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
190 '((((class color) (background light)) (:foreground "Steel Blue" :italic t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
191 (((class color) (background dark)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
192 (:foreground "Light Steel Blue" :italic t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
193 (t (:italic t))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
194 "Face used for displaying CLOSED servers" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
195 :group 'gnus-server-visual) |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
196 ;; backward-compatibility alias |
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
197 (put 'gnus-server-closed-face 'face-alias 'gnus-server-closed) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
198 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
199 (defface gnus-server-denied |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
200 '((((class color) (background light)) (:foreground "Red" :bold t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
201 (((class color) (background dark)) (:foreground "Pink" :bold t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
202 (t (:inverse-video t :bold t))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
203 "Face used for displaying DENIED servers" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
204 :group 'gnus-server-visual) |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
205 ;; backward-compatibility alias |
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
206 (put 'gnus-server-denied-face 'face-alias 'gnus-server-denied) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
207 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
208 (defface gnus-server-offline |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
209 '((((class color) (background light)) (:foreground "Orange" :bold t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
210 (((class color) (background dark)) (:foreground "Yellow" :bold t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
211 (t (:inverse-video t :bold t))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
212 "Face used for displaying OFFLINE servers" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
213 :group 'gnus-server-visual) |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
214 ;; backward-compatibility alias |
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
215 (put 'gnus-server-offline-face 'face-alias 'gnus-server-offline) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
216 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
217 (defcustom gnus-server-agent-face 'gnus-server-agent |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
218 "Face name to use on AGENTIZED servers." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
219 :version "22.1" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
220 :group 'gnus-server-visual |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
221 :type 'face) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
222 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
223 (defcustom gnus-server-opened-face 'gnus-server-opened |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
224 "Face name to use on OPENED servers." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
225 :version "22.1" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
226 :group 'gnus-server-visual |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
227 :type 'face) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
228 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
229 (defcustom gnus-server-closed-face 'gnus-server-closed |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
230 "Face name to use on CLOSED servers." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
231 :version "22.1" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
232 :group 'gnus-server-visual |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
233 :type 'face) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
234 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
235 (defcustom gnus-server-denied-face 'gnus-server-denied |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
236 "Face name to use on DENIED servers." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
237 :version "22.1" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
238 :group 'gnus-server-visual |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
239 :type 'face) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
240 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
241 (defcustom gnus-server-offline-face 'gnus-server-offline |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
242 "Face name to use on OFFLINE servers." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
243 :version "22.1" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
244 :group 'gnus-server-visual |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
245 :type 'face) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
246 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
247 (defvar gnus-server-font-lock-keywords |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
248 (list |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
249 '("(\\(agent\\))" 1 gnus-server-agent-face) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
250 '("(\\(opened\\))" 1 gnus-server-opened-face) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
251 '("(\\(closed\\))" 1 gnus-server-closed-face) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
252 '("(\\(offline\\))" 1 gnus-server-offline-face) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
253 '("(\\(denied\\))" 1 gnus-server-denied-face))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
254 |
17493 | 255 (defun gnus-server-mode () |
256 "Major mode for listing and editing servers. | |
257 | |
258 All normal editing commands are switched off. | |
259 \\<gnus-server-mode-map> | |
260 For more in-depth information on this mode, read the manual | |
39312
8da06f1bcda8
(gnus-server-mode): Doc fix.
Gerd Moellmann <gerd@gnu.org>
parents:
38413
diff
changeset
|
261 \(`\\[gnus-info-find-node]'). |
17493 | 262 |
263 The following commands are available: | |
264 | |
265 \\{gnus-server-mode-map}" | |
266 (interactive) | |
267 (when (gnus-visual-p 'server-menu 'menu) | |
268 (gnus-server-make-menu-bar)) | |
269 (kill-all-local-variables) | |
270 (gnus-simplify-mode-line) | |
271 (setq major-mode 'gnus-server-mode) | |
272 (setq mode-name "Server") | |
273 (gnus-set-default-directory) | |
274 (setq mode-line-process nil) | |
275 (use-local-map gnus-server-mode-map) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
276 (buffer-disable-undo) |
17493 | 277 (setq truncate-lines t) |
278 (setq buffer-read-only t) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
279 (if (featurep 'xemacs) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
280 (put 'gnus-server-mode 'font-lock-defaults '(gnus-server-font-lock-keywords t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
281 (set (make-local-variable 'font-lock-defaults) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
282 '(gnus-server-font-lock-keywords t))) |
62890
4b7fa3ee8e9e
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-336
Miles Bader <miles@gnu.org>
parents:
61126
diff
changeset
|
283 (gnus-run-mode-hooks 'gnus-server-mode-hook)) |
17493 | 284 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
285 (defun gnus-server-insert-server-line (gnus-tmp-name method) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
286 (let* ((gnus-tmp-how (car method)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
287 (gnus-tmp-where (nth 1 method)) |
17493 | 288 (elem (assoc method gnus-opened-servers)) |
39322
06ab5586085a
(gnus-server-insert-server-line): Don't let an error querying a backend
Miles Bader <miles@gnu.org>
parents:
39312
diff
changeset
|
289 (gnus-tmp-status |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
290 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
291 ((eq (nth 1 elem) 'denied) "(denied)") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
292 ((eq (nth 1 elem) 'offline) "(offline)") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
293 (t |
39322
06ab5586085a
(gnus-server-insert-server-line): Don't let an error querying a backend
Miles Bader <miles@gnu.org>
parents:
39312
diff
changeset
|
294 (condition-case nil |
06ab5586085a
(gnus-server-insert-server-line): Don't let an error querying a backend
Miles Bader <miles@gnu.org>
parents:
39312
diff
changeset
|
295 (if (or (gnus-server-opened method) |
06ab5586085a
(gnus-server-insert-server-line): Don't let an error querying a backend
Miles Bader <miles@gnu.org>
parents:
39312
diff
changeset
|
296 (eq (nth 1 elem) 'ok)) |
06ab5586085a
(gnus-server-insert-server-line): Don't let an error querying a backend
Miles Bader <miles@gnu.org>
parents:
39312
diff
changeset
|
297 "(opened)" |
06ab5586085a
(gnus-server-insert-server-line): Don't let an error querying a backend
Miles Bader <miles@gnu.org>
parents:
39312
diff
changeset
|
298 "(closed)") |
06ab5586085a
(gnus-server-insert-server-line): Don't let an error querying a backend
Miles Bader <miles@gnu.org>
parents:
39312
diff
changeset
|
299 ((error) "(error)"))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
300 (gnus-tmp-agent (if (and gnus-agent |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
301 (gnus-agent-method-p method)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
302 " (agent)" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
303 ""))) |
17493 | 304 (beginning-of-line) |
305 (gnus-add-text-properties | |
306 (point) | |
307 (prog1 (1+ (point)) | |
308 ;; Insert the text. | |
309 (eval gnus-server-line-format-spec)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
310 (list 'gnus-server (intern gnus-tmp-name) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
311 'gnus-named-server (intern (gnus-method-to-server method)))))) |
17493 | 312 |
313 (defun gnus-enter-server-buffer () | |
314 "Set up the server buffer." | |
315 (gnus-server-setup-buffer) | |
316 (gnus-configure-windows 'server) | |
317 (gnus-server-prepare)) | |
318 | |
319 (defun gnus-server-setup-buffer () | |
320 "Initialize the server buffer." | |
321 (unless (get-buffer gnus-server-buffer) | |
322 (save-excursion | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
323 (set-buffer (gnus-get-buffer-create gnus-server-buffer)) |
17493 | 324 (gnus-server-mode) |
325 (when gnus-carpal | |
326 (gnus-carpal-setup-buffer 'server))))) | |
327 | |
328 (defun gnus-server-prepare () | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
329 (gnus-set-format 'server-mode) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
330 (gnus-set-format 'server t) |
17493 | 331 (let ((alist gnus-server-alist) |
332 (buffer-read-only nil) | |
333 (opened gnus-opened-servers) | |
334 done server op-ser) | |
335 (erase-buffer) | |
336 (setq gnus-inserted-opened-servers nil) | |
337 ;; First we do the real list of servers. | |
338 (while alist | |
339 (unless (member (cdar alist) done) | |
340 (push (cdar alist) done) | |
54589
3227aa4e7994
(gnus-server-prepare): Remove spurious call to `cdr'.
Juanma Barranquero <lekktu@gmail.com>
parents:
52401
diff
changeset
|
341 (setq server (pop alist)) |
17493 | 342 (when (and server (car server) (cdr server)) |
343 (gnus-server-insert-server-line (car server) (cdr server)))) | |
344 (when (member (cdar alist) done) | |
345 (pop alist))) | |
346 ;; Then we insert the list of servers that have been opened in | |
347 ;; this session. | |
348 (while opened | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
349 (when (and (not (member (caar opened) done)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
350 ;; Just ignore ephemeral servers. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
351 (not (member (caar opened) gnus-ephemeral-servers))) |
17493 | 352 (push (caar opened) done) |
353 (gnus-server-insert-server-line | |
354 (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened)))) | |
355 (caar opened)) | |
356 (push (list op-ser (caar opened)) gnus-inserted-opened-servers)) | |
357 (setq opened (cdr opened)))) | |
358 (goto-char (point-min)) | |
359 (gnus-server-position-point)) | |
360 | |
361 (defun gnus-server-server-name () | |
362 (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) | |
363 (and server (symbol-name server)))) | |
364 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
365 (defun gnus-server-named-server () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
366 "Returns a server name that matches one of the names returned by |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
367 gnus-method-to-server." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
368 (let ((server (get-text-property (gnus-point-at-bol) 'gnus-named-server))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
369 (and server (symbol-name server)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
370 |
17493 | 371 (defalias 'gnus-server-position-point 'gnus-goto-colon) |
372 | |
373 (defconst gnus-server-edit-buffer "*Gnus edit server*") | |
374 | |
375 (defun gnus-server-update-server (server) | |
376 (save-excursion | |
377 (set-buffer gnus-server-buffer) | |
378 (let* ((buffer-read-only nil) | |
379 (entry (assoc server gnus-server-alist)) | |
380 (oentry (assoc (gnus-server-to-method server) | |
381 gnus-opened-servers))) | |
382 (when entry | |
383 (gnus-dribble-enter | |
384 (concat "(gnus-server-set-info \"" server "\" '" | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
385 (gnus-prin1-to-string (cdr entry)) ")\n"))) |
17493 | 386 (when (or entry oentry) |
387 ;; Buffer may be narrowed. | |
388 (save-restriction | |
389 (widen) | |
390 (when (gnus-server-goto-server server) | |
391 (gnus-delete-line)) | |
392 (if entry | |
393 (gnus-server-insert-server-line (car entry) (cdr entry)) | |
394 (gnus-server-insert-server-line | |
395 (format "%s:%s" (caar oentry) (nth 1 (car oentry))) | |
396 (car oentry))) | |
397 (gnus-server-position-point)))))) | |
398 | |
399 (defun gnus-server-set-info (server info) | |
400 ;; Enter a select method into the virtual server alist. | |
401 (when (and server info) | |
402 (gnus-dribble-enter | |
403 (concat "(gnus-server-set-info \"" server "\" '" | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
404 (gnus-prin1-to-string info) ")")) |
17493 | 405 (let* ((server (nth 1 info)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
406 (entry (assoc server gnus-server-alist)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
407 (cached (assoc server gnus-server-method-cache))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
408 (if cached |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
409 (setq gnus-server-method-cache |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
410 (delq cached gnus-server-method-cache))) |
17493 | 411 (if entry (setcdr entry info) |
412 (setq gnus-server-alist | |
413 (nconc gnus-server-alist (list (cons server info)))))))) | |
414 | |
415 ;;; Interactive server functions. | |
416 | |
417 (defun gnus-server-kill-server (server) | |
418 "Kill the server on the current line." | |
419 (interactive (list (gnus-server-server-name))) | |
420 (unless (gnus-server-goto-server server) | |
421 (if server (error "No such server: %s" server) | |
422 (error "No server on the current line"))) | |
423 (unless (assoc server gnus-server-alist) | |
424 (error "Read-only server %s" server)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
425 (gnus-dribble-touch) |
17493 | 426 (let ((buffer-read-only nil)) |
427 (gnus-delete-line)) | |
428 (push (assoc server gnus-server-alist) gnus-server-killed-servers) | |
429 (setq gnus-server-alist (delq (car gnus-server-killed-servers) | |
430 gnus-server-alist)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
431 (let ((groups (gnus-groups-from-server server))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
432 (when (and groups |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
433 (gnus-yes-or-no-p |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
434 (format "Kill all %s groups from this server? " |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
435 (length groups)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
436 (dolist (group groups) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
437 (setq gnus-newsrc-alist |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
438 (delq (assoc group gnus-newsrc-alist) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
439 gnus-newsrc-alist)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
440 (when gnus-group-change-level-function |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
441 (funcall gnus-group-change-level-function |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
442 group gnus-level-killed 3))))) |
17493 | 443 (gnus-server-position-point)) |
444 | |
445 (defun gnus-server-yank-server () | |
446 "Yank the previously killed server." | |
447 (interactive) | |
448 (unless gnus-server-killed-servers | |
449 (error "No killed servers to be yanked")) | |
450 (let ((alist gnus-server-alist) | |
451 (server (gnus-server-server-name)) | |
452 (killed (car gnus-server-killed-servers))) | |
453 (if (not server) | |
454 (setq gnus-server-alist (nconc gnus-server-alist (list killed))) | |
455 (if (string= server (caar gnus-server-alist)) | |
456 (push killed gnus-server-alist) | |
457 (while (and (cdr alist) | |
458 (not (string= server (caadr alist)))) | |
459 (setq alist (cdr alist))) | |
460 (if alist | |
461 (setcdr alist (cons killed (cdr alist))) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
462 (setq gnus-server-alist (list killed))))) |
17493 | 463 (gnus-server-update-server (car killed)) |
464 (setq gnus-server-killed-servers (cdr gnus-server-killed-servers)) | |
465 (gnus-server-position-point))) | |
466 | |
467 (defun gnus-server-exit () | |
468 "Return to the group buffer." | |
469 (interactive) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
470 (gnus-run-hooks 'gnus-server-exit-hook) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
471 (gnus-kill-buffer (current-buffer)) |
17493 | 472 (gnus-configure-windows 'group t)) |
473 | |
474 (defun gnus-server-list-servers () | |
475 "List all available servers." | |
476 (interactive) | |
477 (let ((cur (gnus-server-server-name))) | |
478 (gnus-server-prepare) | |
479 (if cur (gnus-server-goto-server cur) | |
480 (goto-char (point-max)) | |
481 (forward-line -1)) | |
482 (gnus-server-position-point))) | |
483 | |
484 (defun gnus-server-set-status (method status) | |
485 "Make METHOD have STATUS." | |
486 (let ((entry (assoc method gnus-opened-servers))) | |
487 (if entry | |
488 (setcar (cdr entry) status) | |
489 (push (list method status) gnus-opened-servers)))) | |
490 | |
491 (defun gnus-opened-servers-remove (method) | |
492 "Remove METHOD from the list of opened servers." | |
493 (setq gnus-opened-servers (delq (assoc method gnus-opened-servers) | |
494 gnus-opened-servers))) | |
495 | |
496 (defun gnus-server-open-server (server) | |
497 "Force an open of SERVER." | |
498 (interactive (list (gnus-server-server-name))) | |
499 (let ((method (gnus-server-to-method server))) | |
500 (unless method | |
501 (error "No such server: %s" server)) | |
502 (gnus-server-set-status method 'ok) | |
503 (prog1 | |
504 (or (gnus-open-server method) | |
505 (progn (message "Couldn't open %s" server) nil)) | |
506 (gnus-server-update-server server) | |
507 (gnus-server-position-point)))) | |
508 | |
509 (defun gnus-server-open-all-servers () | |
510 "Open all servers." | |
511 (interactive) | |
512 (let ((servers gnus-inserted-opened-servers)) | |
513 (while servers | |
514 (gnus-server-open-server (car (pop servers)))))) | |
515 | |
516 (defun gnus-server-close-server (server) | |
517 "Close SERVER." | |
518 (interactive (list (gnus-server-server-name))) | |
519 (let ((method (gnus-server-to-method server))) | |
520 (unless method | |
521 (error "No such server: %s" server)) | |
522 (gnus-server-set-status method 'closed) | |
523 (prog1 | |
524 (gnus-close-server method) | |
525 (gnus-server-update-server server) | |
526 (gnus-server-position-point)))) | |
527 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
528 (defun gnus-server-offline-server (server) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
529 "Set SERVER to offline." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
530 (interactive (list (gnus-server-server-name))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
531 (let ((method (gnus-server-to-method server))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
532 (unless method |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
533 (error "No such server: %s" server)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
534 (prog1 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
535 (gnus-close-server method) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
536 (gnus-server-set-status method 'offline) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
537 (gnus-server-update-server server) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
538 (gnus-server-position-point)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
539 |
17493 | 540 (defun gnus-server-close-all-servers () |
541 "Close all servers." | |
542 (interactive) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
543 (dolist (server gnus-inserted-opened-servers) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
544 (gnus-server-close-server (car server)))) |
17493 | 545 |
546 (defun gnus-server-deny-server (server) | |
547 "Make sure SERVER will never be attempted opened." | |
548 (interactive (list (gnus-server-server-name))) | |
549 (let ((method (gnus-server-to-method server))) | |
550 (unless method | |
551 (error "No such server: %s" server)) | |
552 (gnus-server-set-status method 'denied)) | |
553 (gnus-server-update-server server) | |
554 (gnus-server-position-point) | |
555 t) | |
556 | |
557 (defun gnus-server-remove-denials () | |
558 "Make all denied servers into closed servers." | |
559 (interactive) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
560 (dolist (server gnus-opened-servers) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
561 (when (eq (nth 1 server) 'denied) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
562 (setcar (nthcdr 1 server) 'closed))) |
17493 | 563 (gnus-server-list-servers)) |
564 | |
565 (defun gnus-server-copy-server (from to) | |
566 (interactive | |
567 (list | |
568 (or (gnus-server-server-name) | |
569 (error "No server on the current line")) | |
570 (read-string "Copy to: "))) | |
571 (unless from | |
572 (error "No server on current line")) | |
573 (unless (and to (not (string= to ""))) | |
574 (error "No name to copy to")) | |
575 (when (assoc to gnus-server-alist) | |
576 (error "%s already exists" to)) | |
577 (unless (gnus-server-to-method from) | |
578 (error "%s: no such server" from)) | |
579 (let ((to-entry (cons from (gnus-copy-sequence | |
580 (gnus-server-to-method from))))) | |
581 (setcar to-entry to) | |
582 (setcar (nthcdr 2 to-entry) to) | |
583 (push to-entry gnus-server-killed-servers) | |
584 (gnus-server-yank-server))) | |
585 | |
586 (defun gnus-server-add-server (how where) | |
587 (interactive | |
588 (list (intern (completing-read "Server method: " | |
589 gnus-valid-select-methods nil t)) | |
590 (read-string "Server name: "))) | |
591 (when (assq where gnus-server-alist) | |
592 (error "Server with that name already defined")) | |
593 (push (list where how where) gnus-server-killed-servers) | |
594 (gnus-server-yank-server)) | |
595 | |
596 (defun gnus-server-goto-server (server) | |
597 "Jump to a server line." | |
598 (interactive | |
599 (list (completing-read "Goto server: " gnus-server-alist nil t))) | |
600 (let ((to (text-property-any (point-min) (point-max) | |
601 'gnus-server (intern server)))) | |
602 (when to | |
603 (goto-char to) | |
604 (gnus-server-position-point)))) | |
605 | |
606 (defun gnus-server-edit-server (server) | |
607 "Edit the server on the current line." | |
608 (interactive (list (gnus-server-server-name))) | |
609 (unless server | |
610 (error "No server on current line")) | |
611 (unless (assoc server gnus-server-alist) | |
612 (error "This server can't be edited")) | |
613 (let ((info (cdr (assoc server gnus-server-alist)))) | |
614 (gnus-close-server info) | |
615 (gnus-edit-form | |
616 info "Editing the server." | |
617 `(lambda (form) | |
618 (gnus-server-set-info ,server form) | |
619 (gnus-server-list-servers) | |
620 (gnus-server-position-point))))) | |
621 | |
622 (defun gnus-server-scan-server (server) | |
623 "Request a scan from the current server." | |
624 (interactive (list (gnus-server-server-name))) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
625 (let ((method (gnus-server-to-method server))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
626 (if (not (gnus-get-function method 'request-scan)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
627 (error "Server %s can't scan" (car method)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
628 (gnus-message 3 "Scanning %s..." server) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
629 (gnus-request-scan nil method) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
630 (gnus-message 3 "Scanning %s...done" server)))) |
17493 | 631 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
632 (defun gnus-server-read-server-in-server-buffer (server) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
633 "Browse a server in server buffer." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
634 (interactive (list (gnus-server-server-name))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
635 (let (gnus-server-browse-in-group-buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
636 (gnus-server-read-server server))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
637 |
17493 | 638 (defun gnus-server-read-server (server) |
639 "Browse a server." | |
640 (interactive (list (gnus-server-server-name))) | |
641 (let ((buf (current-buffer))) | |
642 (prog1 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
643 (gnus-browse-foreign-server server buf) |
17493 | 644 (save-excursion |
645 (set-buffer buf) | |
646 (gnus-server-update-server (gnus-server-server-name)) | |
647 (gnus-server-position-point))))) | |
648 | |
649 (defun gnus-server-pick-server (e) | |
650 (interactive "e") | |
651 (mouse-set-point e) | |
652 (gnus-server-read-server (gnus-server-server-name))) | |
653 | |
654 | |
655 ;;; | |
656 ;;; Browse Server Mode | |
657 ;;; | |
658 | |
659 (defvar gnus-browse-menu-hook nil | |
660 "*Hook run after the creation of the browse mode menu.") | |
661 | |
662 (defvar gnus-browse-mode-hook nil) | |
663 (defvar gnus-browse-mode-map nil) | |
664 (put 'gnus-browse-mode 'mode-class 'special) | |
665 | |
666 (unless gnus-browse-mode-map | |
667 (setq gnus-browse-mode-map (make-keymap)) | |
668 (suppress-keymap gnus-browse-mode-map) | |
669 | |
670 (gnus-define-keys | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
671 gnus-browse-mode-map |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
672 " " gnus-browse-read-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
673 "=" gnus-browse-select-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
674 "n" gnus-browse-next-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
675 "p" gnus-browse-prev-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
676 "\177" gnus-browse-prev-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
677 [delete] gnus-browse-prev-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
678 "N" gnus-browse-next-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
679 "P" gnus-browse-prev-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
680 "\M-n" gnus-browse-next-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
681 "\M-p" gnus-browse-prev-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
682 "\r" gnus-browse-select-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
683 "u" gnus-browse-unsubscribe-current-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
684 "l" gnus-browse-exit |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
685 "L" gnus-browse-exit |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
686 "q" gnus-browse-exit |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
687 "Q" gnus-browse-exit |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
688 "d" gnus-browse-describe-group |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
689 "\C-c\C-c" gnus-browse-exit |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
690 "?" gnus-browse-describe-briefly |
17493 | 691 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
692 "\C-c\C-i" gnus-info-find-node |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
693 "\C-c\C-b" gnus-bug)) |
17493 | 694 |
695 (defun gnus-browse-make-menu-bar () | |
696 (gnus-turn-off-edit-menu 'browse) | |
697 (unless (boundp 'gnus-browse-menu) | |
698 (easy-menu-define | |
699 gnus-browse-menu gnus-browse-mode-map "" | |
700 '("Browse" | |
701 ["Subscribe" gnus-browse-unsubscribe-current-group t] | |
702 ["Read" gnus-browse-read-group t] | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
703 ["Select" gnus-browse-select-group t] |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
704 ["Describe" gnus-browse-describe-group t] |
17493 | 705 ["Next" gnus-browse-next-group t] |
38384
2bdf0118b0a8
(gnus-browse-make-menu-bar): Changed one of the
Gerd Moellmann <gerd@gnu.org>
parents:
31716
diff
changeset
|
706 ["Prev" gnus-browse-prev-group t] |
17493 | 707 ["Exit" gnus-browse-exit t])) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
708 (gnus-run-hooks 'gnus-browse-menu-hook))) |
17493 | 709 |
710 (defvar gnus-browse-current-method nil) | |
711 (defvar gnus-browse-return-buffer nil) | |
712 | |
713 (defvar gnus-browse-buffer "*Gnus Browse Server*") | |
714 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
715 (defun gnus-browse-foreign-server (server &optional return-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
716 "Browse the server SERVER." |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
717 (setq gnus-browse-current-method (gnus-server-to-method server)) |
17493 | 718 (setq gnus-browse-return-buffer return-buffer) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
719 (let* ((method gnus-browse-current-method) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
720 (orig-select-method gnus-select-method) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
721 (gnus-select-method method) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
722 groups group) |
17493 | 723 (gnus-message 5 "Connecting to %s..." (nth 1 method)) |
724 (cond | |
725 ((not (gnus-check-server method)) | |
726 (gnus-message | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19521
diff
changeset
|
727 1 "Unable to contact server %s: %s" (nth 1 method) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19521
diff
changeset
|
728 (gnus-status-message method)) |
17493 | 729 nil) |
730 ((not | |
731 (prog2 | |
732 (gnus-message 6 "Reading active file...") | |
733 (gnus-request-list method) | |
734 (gnus-message 6 "Reading active file...done"))) | |
735 (gnus-message | |
736 1 "Couldn't request list: %s" (gnus-status-message method)) | |
737 nil) | |
738 (t | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
739 (with-current-buffer nntp-server-buffer |
17493 | 740 (let ((cur (current-buffer))) |
741 (goto-char (point-min)) | |
742 (unless (string= gnus-ignored-newsgroups "") | |
743 (delete-matching-lines gnus-ignored-newsgroups)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
744 ;; We treat NNTP as a special case to avoid problems with |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
745 ;; garbage group names like `"foo' that appear in some badly |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
746 ;; managed active files. -jh. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
747 (if (eq (car method) 'nntp) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
748 (while (not (eobp)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
749 (ignore-errors |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
750 (push (cons |
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
751 (buffer-substring |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
752 (point) |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
753 (progn |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
754 (skip-chars-forward "^ \t") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
755 (point))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
756 (let ((last (read cur))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
757 (cons (read cur) last))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
758 groups)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
759 (forward-line)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
760 (while (not (eobp)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
761 (ignore-errors |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
762 (push (cons |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
763 (if (eq (char-after) ?\") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
764 (read cur) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
765 (let ((p (point)) (name "")) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
766 (skip-chars-forward "^ \t\\\\") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
767 (setq name (buffer-substring p (point))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
768 (while (eq (char-after) ?\\) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
769 (setq p (1+ (point))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
770 (forward-char 2) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
771 (skip-chars-forward "^ \t\\\\") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
772 (setq name (concat name (buffer-substring |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
773 p (point))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
774 name)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
775 (let ((last (read cur))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
776 (cons (read cur) last))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
777 groups)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
778 (forward-line))))) |
17493 | 779 (setq groups (sort groups |
780 (lambda (l1 l2) | |
781 (string< (car l1) (car l2))))) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
782 (if gnus-server-browse-in-group-buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
783 (let* ((gnus-select-method orig-select-method) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
784 (gnus-group-listed-groups |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
785 (mapcar (lambda (group) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
786 (let ((name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
787 (gnus-group-prefixed-name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
788 (car group) method))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
789 (gnus-set-active name (cdr group)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
790 name)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
791 groups))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
792 (gnus-configure-windows 'group) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
793 (funcall gnus-group-prepare-function |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
794 gnus-level-killed 'ignore 1 'ignore)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
795 (gnus-get-buffer-create gnus-browse-buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
796 (when gnus-carpal |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
797 (gnus-carpal-setup-buffer 'browse)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
798 (gnus-configure-windows 'browse) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
799 (buffer-disable-undo) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
800 (let ((buffer-read-only nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
801 (erase-buffer)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
802 (gnus-browse-mode) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
803 (setq mode-line-buffer-identification |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
804 (list |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
805 (format |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
806 "Gnus: %%b {%s:%s}" (car method) (cadr method)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
807 (let ((buffer-read-only nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
808 name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
809 (prefix (let ((gnus-select-method orig-select-method)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
810 (gnus-group-prefixed-name "" method)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
811 (while (setq group (pop groups)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
812 (gnus-add-text-properties |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
813 (point) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
814 (prog1 (1+ (point)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
815 (insert |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
816 (format "%c%7d: %s\n" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
817 (let ((level (gnus-group-level |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
818 (concat prefix (setq name (car group)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
819 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
820 ((<= level gnus-level-subscribed) ? ) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
821 ((<= level gnus-level-unsubscribed) ?U) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
822 ((= level gnus-level-zombie) ?Z) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
823 (t ?K))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
824 (max 0 (- (1+ (cddr group)) (cadr group))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
825 (mm-decode-coding-string |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
826 name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
827 (inline (gnus-group-name-charset method name)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
828 (list 'gnus-group name)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
829 (switch-to-buffer (current-buffer))) |
17493 | 830 (goto-char (point-min)) |
831 (gnus-group-position-point) | |
832 (gnus-message 5 "Connecting to %s...done" (nth 1 method)) | |
833 t)))) | |
834 | |
835 (defun gnus-browse-mode () | |
836 "Major mode for browsing a foreign server. | |
837 | |
838 All normal editing commands are switched off. | |
839 | |
840 \\<gnus-browse-mode-map> | |
841 The only things you can do in this buffer is | |
842 | |
843 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. | |
844 The group will be inserted into the group buffer upon exit from this | |
845 buffer. | |
846 | |
847 2) `\\[gnus-browse-read-group]' to read a group ephemerally. | |
848 | |
849 3) `\\[gnus-browse-exit]' to return to the group buffer." | |
850 (interactive) | |
851 (kill-all-local-variables) | |
852 (when (gnus-visual-p 'browse-menu 'menu) | |
853 (gnus-browse-make-menu-bar)) | |
854 (gnus-simplify-mode-line) | |
855 (setq major-mode 'gnus-browse-mode) | |
856 (setq mode-name "Browse Server") | |
857 (setq mode-line-process nil) | |
858 (use-local-map gnus-browse-mode-map) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
859 (buffer-disable-undo) |
17493 | 860 (setq truncate-lines t) |
861 (gnus-set-default-directory) | |
862 (setq buffer-read-only t) | |
62890
4b7fa3ee8e9e
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-336
Miles Bader <miles@gnu.org>
parents:
61126
diff
changeset
|
863 (gnus-run-mode-hooks 'gnus-browse-mode-hook)) |
17493 | 864 |
61126
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
865 (defun gnus-browse-read-group (&optional no-article number) |
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
866 "Enter the group at the current line. |
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
867 If NUMBER, fetch this number of articles." |
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
868 (interactive "P") |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
869 (let ((group (gnus-browse-group-name))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
870 (if (or (not (gnus-get-info group)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
871 (gnus-ephemeral-group-p group)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
872 (unless (gnus-group-read-ephemeral-group |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
873 group gnus-browse-current-method nil |
61126
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
874 (cons (current-buffer) 'browse) |
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
875 nil nil nil number) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
876 (error "Couldn't enter %s" group)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
877 (unless (gnus-group-read-group nil no-article group) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
878 (error "Couldn't enter %s" group))))) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
879 |
61126
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
880 (defun gnus-browse-select-group (&optional number) |
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
881 "Select the current group. |
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
882 If NUMBER, fetch this number of articles." |
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
883 (interactive "P") |
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
884 (gnus-browse-read-group 'no number)) |
17493 | 885 |
886 (defun gnus-browse-next-group (n) | |
887 "Go to the next group." | |
888 (interactive "p") | |
889 (prog1 | |
890 (forward-line n) | |
891 (gnus-group-position-point))) | |
892 | |
893 (defun gnus-browse-prev-group (n) | |
894 "Go to the next group." | |
895 (interactive "p") | |
896 (gnus-browse-next-group (- n))) | |
897 | |
898 (defun gnus-browse-unsubscribe-current-group (arg) | |
899 "(Un)subscribe to the next ARG groups." | |
900 (interactive "p") | |
901 (when (eobp) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19521
diff
changeset
|
902 (error "No group at current line")) |
17493 | 903 (let ((ward (if (< arg 0) -1 1)) |
904 (arg (abs arg))) | |
905 (while (and (> arg 0) | |
906 (not (eobp)) | |
907 (gnus-browse-unsubscribe-group) | |
908 (zerop (gnus-browse-next-group ward))) | |
909 (decf arg)) | |
910 (gnus-group-position-point) | |
911 (when (/= 0 arg) | |
912 (gnus-message 7 "No more newsgroups")) | |
913 arg)) | |
914 | |
915 (defun gnus-browse-group-name () | |
916 (save-excursion | |
917 (beginning-of-line) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
918 (let ((name (get-text-property (point) 'gnus-group))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
919 (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
920 (concat (gnus-method-to-server-name gnus-browse-current-method) ":" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
921 (or name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
922 (match-string-no-properties 1))))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
923 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
924 (defun gnus-browse-describe-group (group) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
925 "Describe the current group." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
926 (interactive (list (gnus-browse-group-name))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
927 (gnus-group-describe-group nil group)) |
17493 | 928 |
929 (defun gnus-browse-unsubscribe-group () | |
930 "Toggle subscription of the current group in the browse buffer." | |
931 (let ((sub nil) | |
932 (buffer-read-only nil) | |
933 group) | |
934 (save-excursion | |
935 (beginning-of-line) | |
936 ;; If this group it killed, then we want to subscribe it. | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
937 (unless (eq (char-after) ? ) |
17493 | 938 (setq sub t)) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
939 (setq group (gnus-browse-group-name)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
940 (when (gnus-server-equal gnus-browse-current-method "native") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
941 (setq group (gnus-group-real-name group))) |
17493 | 942 (if sub |
943 (progn | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
944 ;; Make sure the group has been properly removed before we |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
945 ;; subscribe to it. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
946 (gnus-kill-ephemeral-group group) |
17493 | 947 (gnus-group-change-level |
948 (list t group gnus-level-default-subscribed | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
949 nil nil (if (gnus-server-equal |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
950 gnus-browse-current-method "native") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
951 nil |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
39322
diff
changeset
|
952 (gnus-method-simplify |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
953 gnus-browse-current-method))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
954 gnus-level-default-subscribed (gnus-group-level group) |
17493 | 955 (and (car (nth 1 gnus-newsrc-alist)) |
956 (gnus-gethash (car (nth 1 gnus-newsrc-alist)) | |
957 gnus-newsrc-hashtb)) | |
958 t) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
959 (delete-char 1) |
17493 | 960 (insert ? )) |
961 (gnus-group-change-level | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
962 group gnus-level-unsubscribed gnus-level-default-subscribed) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
963 (delete-char 1) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
964 (insert ?U))) |
17493 | 965 t)) |
966 | |
967 (defun gnus-browse-exit () | |
968 "Quit browsing and return to the group buffer." | |
969 (interactive) | |
970 (when (eq major-mode 'gnus-browse-mode) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
971 (gnus-kill-buffer (current-buffer))) |
17493 | 972 ;; Insert the newly subscribed groups in the group buffer. |
973 (save-excursion | |
974 (set-buffer gnus-group-buffer) | |
975 (gnus-group-list-groups nil)) | |
976 (if gnus-browse-return-buffer | |
977 (gnus-configure-windows 'server 'force) | |
978 (gnus-configure-windows 'group 'force))) | |
979 | |
980 (defun gnus-browse-describe-briefly () | |
981 "Give a one line description of the group mode commands." | |
982 (interactive) | |
983 (gnus-message 6 | |
984 (substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) | |
985 | |
986 (defun gnus-server-regenerate-server () | |
987 "Issue a command to the server to regenerate all its data structures." | |
988 (interactive) | |
989 (let ((server (gnus-server-server-name))) | |
990 (unless server | |
991 (error "No server on the current line")) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
992 (condition-case () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
993 (gnus-get-function (gnus-server-to-method server) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
994 'request-regenerate) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
995 (error |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
996 (error "This backend doesn't support regeneration"))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
997 (gnus-message 5 "Requesting regeneration of %s..." server) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
998 (unless (gnus-open-server server) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
999 (error "Couldn't open server")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
1000 (if (gnus-request-regenerate server) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
1001 (gnus-message 5 "Requesting regeneration of %s...done" server) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
1002 (gnus-message 5 "Couldn't regenerate %s" server)))) |
17493 | 1003 |
1004 (provide 'gnus-srvr) | |
1005 | |
52401 | 1006 ;;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25 |
38413
a26d9b55abb6
Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents:
38384
diff
changeset
|
1007 ;;; gnus-srvr.el ends here |