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