Mercurial > emacs
annotate lisp/gnus/gnus-srvr.el @ 107429:024cba2776d2
(hide-sublevels): Don't hide trailing newline (and fix paren typo).
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Thu, 18 Mar 2010 23:32:47 -0400 |
parents | 1d1d5d9bd884 |
children | 8d09094063d0 376148b31b5e |
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, |
106815 | 4 ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 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) |
104789
aa91debbb2f2
Mark face aliases with "-face" in the name as obsolete.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
180 (put 'gnus-server-agent-face 'obsolete-face "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
|
181 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
182 (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
|
183 '((((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
|
184 (((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
|
185 (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
|
186 "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
|
187 :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
|
188 ;; 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
|
189 (put 'gnus-server-opened-face 'face-alias 'gnus-server-opened) |
104789
aa91debbb2f2
Mark face aliases with "-face" in the name as obsolete.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
190 (put 'gnus-server-opened-face 'obsolete-face "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
|
191 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
192 (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
|
193 '((((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
|
194 (((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
|
195 (: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
|
196 (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
|
197 "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
|
198 :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
|
199 ;; 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
|
200 (put 'gnus-server-closed-face 'face-alias 'gnus-server-closed) |
104789
aa91debbb2f2
Mark face aliases with "-face" in the name as obsolete.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
201 (put 'gnus-server-closed-face 'obsolete-face "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
|
202 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
203 (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
|
204 '((((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
|
205 (((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
|
206 (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
|
207 "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
|
208 :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
|
209 ;; 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
|
210 (put 'gnus-server-denied-face 'face-alias 'gnus-server-denied) |
104789
aa91debbb2f2
Mark face aliases with "-face" in the name as obsolete.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
211 (put 'gnus-server-denied-face 'obsolete-face "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
|
212 |
63480
53e7abe8917f
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-425
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
213 (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
|
214 '((((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
|
215 (((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
|
216 (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
|
217 "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
|
218 :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
|
219 ;; 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
|
220 (put 'gnus-server-offline-face 'face-alias 'gnus-server-offline) |
104789
aa91debbb2f2
Mark face aliases with "-face" in the name as obsolete.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
221 (put 'gnus-server-offline-face 'obsolete-face "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
|
222 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
223 (defvar gnus-server-font-lock-keywords |
78204 | 224 '(("(\\(agent\\))" 1 'gnus-server-agent) |
225 ("(\\(opened\\))" 1 'gnus-server-opened) | |
226 ("(\\(closed\\))" 1 'gnus-server-closed) | |
227 ("(\\(offline\\))" 1 'gnus-server-offline) | |
228 ("(\\(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
|
229 |
17493 | 230 (defun gnus-server-mode () |
231 "Major mode for listing and editing servers. | |
232 | |
233 All normal editing commands are switched off. | |
234 \\<gnus-server-mode-map> | |
235 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
|
236 \(`\\[gnus-info-find-node]'). |
17493 | 237 |
238 The following commands are available: | |
239 | |
240 \\{gnus-server-mode-map}" | |
241 (interactive) | |
242 (when (gnus-visual-p 'server-menu 'menu) | |
243 (gnus-server-make-menu-bar)) | |
244 (kill-all-local-variables) | |
245 (gnus-simplify-mode-line) | |
246 (setq major-mode 'gnus-server-mode) | |
247 (setq mode-name "Server") | |
248 (gnus-set-default-directory) | |
249 (setq mode-line-process nil) | |
250 (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
|
251 (buffer-disable-undo) |
17493 | 252 (setq truncate-lines t) |
253 (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
|
254 (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
|
255 (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
|
256 (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
|
257 '(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
|
258 (gnus-run-mode-hooks 'gnus-server-mode-hook)) |
17493 | 259 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
260 (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
|
261 (let* ((gnus-tmp-how (car method)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
262 (gnus-tmp-where (nth 1 method)) |
17493 | 263 (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
|
264 (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
|
265 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
266 ((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
|
267 ((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
|
268 (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
|
269 (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
|
270 (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
|
271 (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
|
272 "(opened)" |
06ab5586085a
(gnus-server-insert-server-line): Don't let an error querying a backend
Miles Bader <miles@gnu.org>
parents:
39312
diff
changeset
|
273 "(closed)") |
06ab5586085a
(gnus-server-insert-server-line): Don't let an error querying a backend
Miles Bader <miles@gnu.org>
parents:
39312
diff
changeset
|
274 ((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
|
275 (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
|
276 (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
|
277 " (agent)" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
278 ""))) |
17493 | 279 (beginning-of-line) |
280 (gnus-add-text-properties | |
281 (point) | |
282 (prog1 (1+ (point)) | |
283 ;; Insert the text. | |
284 (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
|
285 (list 'gnus-server (intern gnus-tmp-name) |
87097 | 286 'gnus-named-server (intern (gnus-method-to-server method t)))))) |
17493 | 287 |
288 (defun gnus-enter-server-buffer () | |
289 "Set up the server buffer." | |
290 (gnus-server-setup-buffer) | |
291 (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
|
292 ;; 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
|
293 ;; `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
|
294 ;; 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
|
295 ;; 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
|
296 (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
|
297 (gnus-server-prepare))) |
17493 | 298 |
299 (defun gnus-server-setup-buffer () | |
300 "Initialize the server buffer." | |
301 (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
|
302 (with-current-buffer (gnus-get-buffer-create gnus-server-buffer) |
17493 | 303 (gnus-server-mode) |
304 (when gnus-carpal | |
305 (gnus-carpal-setup-buffer 'server))))) | |
306 | |
307 (defun gnus-server-prepare () | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
308 (gnus-set-format 'server-mode) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
309 (gnus-set-format 'server t) |
17493 | 310 (let ((alist gnus-server-alist) |
311 (buffer-read-only nil) | |
312 done server op-ser) | |
313 (erase-buffer) | |
314 (setq gnus-inserted-opened-servers nil) | |
315 ;; First we do the real list of servers. | |
316 (while alist | |
317 (unless (member (cdar alist) done) | |
318 (push (cdar alist) done) | |
54589
3227aa4e7994
(gnus-server-prepare): Remove spurious call to `cdr'.
Juanma Barranquero <lekktu@gmail.com>
parents:
52401
diff
changeset
|
319 (setq server (pop alist)) |
17493 | 320 (when (and server (car server) (cdr server)) |
321 (gnus-server-insert-server-line (car server) (cdr server)))) | |
322 (when (member (cdar alist) done) | |
323 (pop alist))) | |
324 ;; Then we insert the list of servers that have been opened in | |
325 ;; 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
|
326 (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
|
327 (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
|
328 ;; 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
|
329 (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
|
330 (push (car open) done) |
17493 | 331 (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
|
332 (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
|
333 (car open)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
334 (push (list op-ser (car open)) gnus-inserted-opened-servers)))) |
17493 | 335 (goto-char (point-min)) |
336 (gnus-server-position-point)) | |
337 | |
338 (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
|
339 (let ((server (get-text-property (point-at-bol) 'gnus-server))) |
17493 | 340 (and server (symbol-name server)))) |
341 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
342 (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
|
343 "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
|
344 `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
|
345 (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
|
346 (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
|
347 |
17493 | 348 (defalias 'gnus-server-position-point 'gnus-goto-colon) |
349 | |
350 (defconst gnus-server-edit-buffer "*Gnus edit server*") | |
351 | |
352 (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
|
353 (with-current-buffer gnus-server-buffer |
17493 | 354 (let* ((buffer-read-only nil) |
355 (entry (assoc server gnus-server-alist)) | |
356 (oentry (assoc (gnus-server-to-method server) | |
357 gnus-opened-servers))) | |
358 (when entry | |
359 (gnus-dribble-enter | |
360 (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
|
361 (gnus-prin1-to-string (cdr entry)) ")\n"))) |
17493 | 362 (when (or entry oentry) |
363 ;; Buffer may be narrowed. | |
364 (save-restriction | |
365 (widen) | |
366 (when (gnus-server-goto-server server) | |
367 (gnus-delete-line)) | |
368 (if entry | |
369 (gnus-server-insert-server-line (car entry) (cdr entry)) | |
370 (gnus-server-insert-server-line | |
371 (format "%s:%s" (caar oentry) (nth 1 (car oentry))) | |
372 (car oentry))) | |
373 (gnus-server-position-point)))))) | |
374 | |
375 (defun gnus-server-set-info (server info) | |
376 ;; Enter a select method into the virtual server alist. | |
377 (when (and server info) | |
378 (gnus-dribble-enter | |
379 (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
|
380 (gnus-prin1-to-string info) ")")) |
17493 | 381 (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
|
382 (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
|
383 (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
|
384 (if cached |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
385 (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
|
386 (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
|
387 (if entry |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
388 (progn |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
389 ;; 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
|
390 ;; 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
|
391 (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
|
392 ;; 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
|
393 (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
|
394 (setcdr (cdr entry) (cdr info))) |
17493 | 395 (setq gnus-server-alist |
396 (nconc gnus-server-alist (list (cons server info)))))))) | |
397 | |
398 ;;; Interactive server functions. | |
399 | |
400 (defun gnus-server-kill-server (server) | |
401 "Kill the server on the current line." | |
402 (interactive (list (gnus-server-server-name))) | |
403 (unless (gnus-server-goto-server server) | |
404 (if server (error "No such server: %s" server) | |
405 (error "No server on the current line"))) | |
406 (unless (assoc server gnus-server-alist) | |
407 (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
|
408 (gnus-dribble-touch) |
17493 | 409 (let ((buffer-read-only nil)) |
410 (gnus-delete-line)) | |
411 (push (assoc server gnus-server-alist) gnus-server-killed-servers) | |
412 (setq gnus-server-alist (delq (car gnus-server-killed-servers) | |
413 gnus-server-alist)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
414 (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
|
415 (when (and groups |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
416 (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
|
417 (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
|
418 (length groups)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
419 (dolist (group groups) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
420 (setq gnus-newsrc-alist |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
421 (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
|
422 gnus-newsrc-alist)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
423 (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
|
424 (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
|
425 group gnus-level-killed 3))))) |
17493 | 426 (gnus-server-position-point)) |
427 | |
428 (defun gnus-server-yank-server () | |
429 "Yank the previously killed server." | |
430 (interactive) | |
431 (unless gnus-server-killed-servers | |
432 (error "No killed servers to be yanked")) | |
433 (let ((alist gnus-server-alist) | |
434 (server (gnus-server-server-name)) | |
435 (killed (car gnus-server-killed-servers))) | |
436 (if (not server) | |
437 (setq gnus-server-alist (nconc gnus-server-alist (list killed))) | |
438 (if (string= server (caar gnus-server-alist)) | |
439 (push killed gnus-server-alist) | |
440 (while (and (cdr alist) | |
441 (not (string= server (caadr alist)))) | |
442 (setq alist (cdr alist))) | |
443 (if alist | |
444 (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
|
445 (setq gnus-server-alist (list killed))))) |
17493 | 446 (gnus-server-update-server (car killed)) |
447 (setq gnus-server-killed-servers (cdr gnus-server-killed-servers)) | |
448 (gnus-server-position-point))) | |
449 | |
450 (defun gnus-server-exit () | |
451 "Return to the group buffer." | |
452 (interactive) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
453 (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
|
454 (gnus-kill-buffer (current-buffer)) |
17493 | 455 (gnus-configure-windows 'group t)) |
456 | |
457 (defun gnus-server-list-servers () | |
458 "List all available servers." | |
459 (interactive) | |
460 (let ((cur (gnus-server-server-name))) | |
461 (gnus-server-prepare) | |
462 (if cur (gnus-server-goto-server cur) | |
463 (goto-char (point-max)) | |
464 (forward-line -1)) | |
465 (gnus-server-position-point))) | |
466 | |
467 (defun gnus-server-set-status (method status) | |
468 "Make METHOD have STATUS." | |
469 (let ((entry (assoc method gnus-opened-servers))) | |
470 (if entry | |
471 (setcar (cdr entry) status) | |
472 (push (list method status) gnus-opened-servers)))) | |
473 | |
474 (defun gnus-opened-servers-remove (method) | |
475 "Remove METHOD from the list of opened servers." | |
476 (setq gnus-opened-servers (delq (assoc method gnus-opened-servers) | |
477 gnus-opened-servers))) | |
478 | |
479 (defun gnus-server-open-server (server) | |
480 "Force an open of SERVER." | |
481 (interactive (list (gnus-server-server-name))) | |
482 (let ((method (gnus-server-to-method server))) | |
483 (unless method | |
484 (error "No such server: %s" server)) | |
485 (gnus-server-set-status method 'ok) | |
486 (prog1 | |
487 (or (gnus-open-server method) | |
488 (progn (message "Couldn't open %s" server) nil)) | |
489 (gnus-server-update-server server) | |
490 (gnus-server-position-point)))) | |
491 | |
492 (defun gnus-server-open-all-servers () | |
493 "Open all servers." | |
494 (interactive) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
495 (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
|
496 (gnus-server-open-server (car server)))) |
17493 | 497 |
498 (defun gnus-server-close-server (server) | |
499 "Close SERVER." | |
500 (interactive (list (gnus-server-server-name))) | |
501 (let ((method (gnus-server-to-method server))) | |
502 (unless method | |
503 (error "No such server: %s" server)) | |
504 (gnus-server-set-status method 'closed) | |
505 (prog1 | |
506 (gnus-close-server method) | |
507 (gnus-server-update-server server) | |
508 (gnus-server-position-point)))) | |
509 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
510 (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
|
511 "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
|
512 (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
|
513 (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
|
514 (unless method |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
515 (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
|
516 (prog1 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
517 (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
|
518 (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
|
519 (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
|
520 (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
|
521 |
17493 | 522 (defun gnus-server-close-all-servers () |
523 "Close all servers." | |
524 (interactive) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
525 (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
|
526 (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
|
527 (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
|
528 (gnus-server-close-server (car server)))) |
17493 | 529 |
530 (defun gnus-server-deny-server (server) | |
531 "Make sure SERVER will never be attempted opened." | |
532 (interactive (list (gnus-server-server-name))) | |
533 (let ((method (gnus-server-to-method server))) | |
534 (unless method | |
535 (error "No such server: %s" server)) | |
536 (gnus-server-set-status method 'denied)) | |
537 (gnus-server-update-server server) | |
538 (gnus-server-position-point) | |
539 t) | |
540 | |
541 (defun gnus-server-remove-denials () | |
542 "Make all denied servers into closed servers." | |
543 (interactive) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
544 (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
|
545 (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
|
546 (setcar (nthcdr 1 server) 'closed))) |
17493 | 547 (gnus-server-list-servers)) |
548 | |
549 (defun gnus-server-copy-server (from to) | |
550 (interactive | |
551 (list | |
552 (or (gnus-server-server-name) | |
553 (error "No server on the current line")) | |
554 (read-string "Copy to: "))) | |
555 (unless from | |
556 (error "No server on current line")) | |
557 (unless (and to (not (string= to ""))) | |
558 (error "No name to copy to")) | |
559 (when (assoc to gnus-server-alist) | |
560 (error "%s already exists" to)) | |
561 (unless (gnus-server-to-method from) | |
562 (error "%s: no such server" from)) | |
563 (let ((to-entry (cons from (gnus-copy-sequence | |
564 (gnus-server-to-method from))))) | |
565 (setcar to-entry to) | |
566 (setcar (nthcdr 2 to-entry) to) | |
567 (push to-entry gnus-server-killed-servers) | |
568 (gnus-server-yank-server))) | |
569 | |
570 (defun gnus-server-add-server (how where) | |
571 (interactive | |
572 (list (intern (completing-read "Server method: " | |
573 gnus-valid-select-methods nil t)) | |
574 (read-string "Server name: "))) | |
575 (when (assq where gnus-server-alist) | |
576 (error "Server with that name already defined")) | |
577 (push (list where how where) gnus-server-killed-servers) | |
578 (gnus-server-yank-server)) | |
579 | |
580 (defun gnus-server-goto-server (server) | |
581 "Jump to a server line." | |
582 (interactive | |
583 (list (completing-read "Goto server: " gnus-server-alist nil t))) | |
584 (let ((to (text-property-any (point-min) (point-max) | |
585 'gnus-server (intern server)))) | |
586 (when to | |
587 (goto-char to) | |
588 (gnus-server-position-point)))) | |
589 | |
590 (defun gnus-server-edit-server (server) | |
591 "Edit the server on the current line." | |
592 (interactive (list (gnus-server-server-name))) | |
593 (unless server | |
594 (error "No server on current line")) | |
595 (unless (assoc server gnus-server-alist) | |
596 (error "This server can't be edited")) | |
597 (let ((info (cdr (assoc server gnus-server-alist)))) | |
598 (gnus-close-server info) | |
599 (gnus-edit-form | |
600 info "Editing the server." | |
601 `(lambda (form) | |
602 (gnus-server-set-info ,server form) | |
603 (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
|
604 (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
|
605 'edit-server))) |
17493 | 606 |
607 (defun gnus-server-scan-server (server) | |
608 "Request a scan from the current server." | |
609 (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
|
610 (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
|
611 (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
|
612 (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
|
613 (gnus-message 3 "Scanning %s..." server) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
614 (gnus-request-scan nil method) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
615 (gnus-message 3 "Scanning %s...done" server)))) |
17493 | 616 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
617 (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
|
618 "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
|
619 (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
|
620 (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
|
621 (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
|
622 |
17493 | 623 (defun gnus-server-read-server (server) |
624 "Browse a server." | |
625 (interactive (list (gnus-server-server-name))) | |
626 (let ((buf (current-buffer))) | |
627 (prog1 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
628 (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
|
629 (with-current-buffer buf |
17493 | 630 (gnus-server-update-server (gnus-server-server-name)) |
631 (gnus-server-position-point))))) | |
632 | |
633 (defun gnus-server-pick-server (e) | |
634 (interactive "e") | |
635 (mouse-set-point e) | |
636 (gnus-server-read-server (gnus-server-server-name))) | |
637 | |
638 | |
639 ;;; | |
640 ;;; Browse Server Mode | |
641 ;;; | |
642 | |
643 (defvar gnus-browse-menu-hook nil | |
644 "*Hook run after the creation of the browse mode menu.") | |
645 | |
646 (defvar gnus-browse-mode-hook nil) | |
647 (defvar gnus-browse-mode-map nil) | |
648 (put 'gnus-browse-mode 'mode-class 'special) | |
649 | |
650 (unless gnus-browse-mode-map | |
651 (setq gnus-browse-mode-map (make-keymap)) | |
652 (suppress-keymap gnus-browse-mode-map) | |
653 | |
654 (gnus-define-keys | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
655 gnus-browse-mode-map |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
656 " " gnus-browse-read-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
657 "=" gnus-browse-select-group |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
658 "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
|
659 "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
|
660 "\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
|
661 [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
|
662 "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
|
663 "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
|
664 "\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
|
665 "\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
|
666 "\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
|
667 "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
|
668 "l" gnus-browse-exit |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
669 "L" gnus-browse-exit |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
670 "q" gnus-browse-exit |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
671 "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
|
672 "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
|
673 "\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
|
674 "?" gnus-browse-describe-briefly |
17493 | 675 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
676 "\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
|
677 "\C-c\C-b" gnus-bug)) |
17493 | 678 |
679 (defun gnus-browse-make-menu-bar () | |
680 (gnus-turn-off-edit-menu 'browse) | |
681 (unless (boundp 'gnus-browse-menu) | |
682 (easy-menu-define | |
683 gnus-browse-menu gnus-browse-mode-map "" | |
684 '("Browse" | |
685 ["Subscribe" gnus-browse-unsubscribe-current-group t] | |
686 ["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
|
687 ["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
|
688 ["Describe" gnus-browse-describe-group t] |
17493 | 689 ["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
|
690 ["Prev" gnus-browse-prev-group t] |
17493 | 691 ["Exit" gnus-browse-exit t])) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
692 (gnus-run-hooks 'gnus-browse-menu-hook))) |
17493 | 693 |
694 (defvar gnus-browse-current-method nil) | |
695 (defvar gnus-browse-return-buffer nil) | |
696 | |
697 (defvar gnus-browse-buffer "*Gnus Browse Server*") | |
698 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
699 (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
|
700 "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
|
701 (setq gnus-browse-current-method (gnus-server-to-method server)) |
17493 | 702 (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
|
703 (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
|
704 (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
|
705 (gnus-select-method method) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
706 groups group) |
17493 | 707 (gnus-message 5 "Connecting to %s..." (nth 1 method)) |
708 (cond | |
709 ((not (gnus-check-server method)) | |
710 (gnus-message | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19521
diff
changeset
|
711 1 "Unable to contact server %s: %s" (nth 1 method) |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19521
diff
changeset
|
712 (gnus-status-message method)) |
17493 | 713 nil) |
714 ((not | |
715 (prog2 | |
716 (gnus-message 6 "Reading active file...") | |
717 (gnus-request-list method) | |
718 (gnus-message 6 "Reading active file...done"))) | |
719 (gnus-message | |
720 1 "Couldn't request list: %s" (gnus-status-message method)) | |
721 nil) | |
722 (t | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
723 (with-current-buffer nntp-server-buffer |
17493 | 724 (let ((cur (current-buffer))) |
725 (goto-char (point-min)) | |
726 (unless (string= gnus-ignored-newsgroups "") | |
727 (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
|
728 ;; 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
|
729 ;; 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
|
730 ;; 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
|
731 (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
|
732 (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
|
733 (ignore-errors |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
734 (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
|
735 (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
|
736 (buffer-substring |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
737 (point) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
738 (progn |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
739 (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
|
740 (point)))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
741 (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
|
742 (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
|
743 groups)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
744 (forward-line)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
745 (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
|
746 (ignore-errors |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
747 (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
|
748 (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
|
749 (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
|
750 (read cur) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
751 (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
|
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 (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
|
754 (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
|
755 (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
|
756 (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
|
757 (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
|
758 (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
|
759 p (point))))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
760 name))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
761 (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
|
762 (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
|
763 groups)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
764 (forward-line))))) |
17493 | 765 (setq groups (sort groups |
766 (lambda (l1 l2) | |
767 (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
|
768 (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
|
769 (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
|
770 (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
|
771 (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
|
772 (let ((name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
773 (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
|
774 (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
|
775 (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
|
776 name)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
777 groups))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
778 (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
|
779 (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
|
780 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
|
781 (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
|
782 (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
|
783 (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
|
784 (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
|
785 (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
|
786 (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
|
787 (erase-buffer)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
788 (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
|
789 (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
|
790 (list |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
791 (format |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
792 "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
|
793 (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
|
794 name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
795 (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
|
796 (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
|
797 (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
|
798 (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
|
799 (point) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
800 (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
|
801 (insert |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
802 (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
|
803 (let ((level |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
804 (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
|
805 (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
|
806 (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
|
807 (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
|
808 (cond |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
809 ((<= 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
|
810 ((<= 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
|
811 ((= 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
|
812 (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
|
813 (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
|
814 ;; 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
|
815 (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
|
816 (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
|
817 name |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
818 (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
|
819 name |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
820 (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
|
821 (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
|
822 ))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
823 (switch-to-buffer (current-buffer))) |
17493 | 824 (goto-char (point-min)) |
825 (gnus-group-position-point) | |
826 (gnus-message 5 "Connecting to %s...done" (nth 1 method)) | |
827 t)))) | |
828 | |
829 (defun gnus-browse-mode () | |
830 "Major mode for browsing a foreign server. | |
831 | |
832 All normal editing commands are switched off. | |
833 | |
834 \\<gnus-browse-mode-map> | |
835 The only things you can do in this buffer is | |
836 | |
837 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. | |
838 The group will be inserted into the group buffer upon exit from this | |
839 buffer. | |
840 | |
841 2) `\\[gnus-browse-read-group]' to read a group ephemerally. | |
842 | |
843 3) `\\[gnus-browse-exit]' to return to the group buffer." | |
844 (interactive) | |
845 (kill-all-local-variables) | |
846 (when (gnus-visual-p 'browse-menu 'menu) | |
847 (gnus-browse-make-menu-bar)) | |
848 (gnus-simplify-mode-line) | |
849 (setq major-mode 'gnus-browse-mode) | |
850 (setq mode-name "Browse Server") | |
851 (setq mode-line-process nil) | |
852 (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
|
853 (buffer-disable-undo) |
17493 | 854 (setq truncate-lines t) |
855 (gnus-set-default-directory) | |
856 (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
|
857 (gnus-run-mode-hooks 'gnus-browse-mode-hook)) |
17493 | 858 |
61126
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
859 (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
|
860 "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
|
861 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
|
862 (interactive "P") |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
863 (let ((group (gnus-browse-group-name))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
864 (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
|
865 (gnus-ephemeral-group-p group)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
866 (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
|
867 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
|
868 (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
|
869 nil nil nil number) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
870 (error "Couldn't enter %s" group)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
871 (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
|
872 (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
|
873 |
61126
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
874 (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
|
875 "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
|
876 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
|
877 (interactive "P") |
c0aa521e0ca7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-220
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
878 (gnus-browse-read-group 'no number)) |
17493 | 879 |
880 (defun gnus-browse-next-group (n) | |
881 "Go to the next group." | |
882 (interactive "p") | |
883 (prog1 | |
884 (forward-line n) | |
885 (gnus-group-position-point))) | |
886 | |
887 (defun gnus-browse-prev-group (n) | |
888 "Go to the next group." | |
889 (interactive "p") | |
890 (gnus-browse-next-group (- n))) | |
891 | |
892 (defun gnus-browse-unsubscribe-current-group (arg) | |
893 "(Un)subscribe to the next ARG groups." | |
894 (interactive "p") | |
895 (when (eobp) | |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19521
diff
changeset
|
896 (error "No group at current line")) |
17493 | 897 (let ((ward (if (< arg 0) -1 1)) |
898 (arg (abs arg))) | |
899 (while (and (> arg 0) | |
900 (not (eobp)) | |
901 (gnus-browse-unsubscribe-group) | |
902 (zerop (gnus-browse-next-group ward))) | |
903 (decf arg)) | |
904 (gnus-group-position-point) | |
905 (when (/= 0 arg) | |
906 (gnus-message 7 "No more newsgroups")) | |
907 arg)) | |
908 | |
909 (defun gnus-browse-group-name () | |
910 (save-excursion | |
911 (beginning-of-line) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
912 (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
|
913 (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
|
914 (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
|
915 (or name |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
916 (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
|
917 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
918 (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
|
919 "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
|
920 (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
|
921 (gnus-group-describe-group nil group)) |
17493 | 922 |
923 (defun gnus-browse-unsubscribe-group () | |
924 "Toggle subscription of the current group in the browse buffer." | |
925 (let ((sub nil) | |
926 (buffer-read-only nil) | |
927 group) | |
928 (save-excursion | |
929 (beginning-of-line) | |
930 ;; 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
|
931 (unless (eq (char-after) ? ) |
17493 | 932 (setq sub t)) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
933 (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
|
934 (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
|
935 (setq group (gnus-group-real-name group))) |
17493 | 936 (if sub |
937 (progn | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19969
diff
changeset
|
938 ;; 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
|
939 ;; subscribe to it. |
72009 | 940 (if (gnus-ephemeral-group-p group) |
941 (gnus-kill-ephemeral-group group)) | |
942 ;; We need to discern between killed/zombie groups and | |
943 ;; just unsubscribed ones. | |
17493 | 944 (gnus-group-change-level |
72009 | 945 (or (gnus-group-entry group) |
946 (list t group gnus-level-default-subscribed | |
947 nil nil (if (gnus-server-equal | |
948 gnus-browse-current-method "native") | |
949 nil | |
950 (gnus-method-simplify | |
951 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
|
952 gnus-level-default-subscribed (gnus-group-level group) |
17493 | 953 (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
|
954 (gnus-group-entry (car (nth 1 gnus-newsrc-alist)))) |
72009 | 955 (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
|
956 (delete-char 1) |
17493 | 957 (insert ? )) |
958 (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
|
959 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
|
960 (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
|
961 (insert ?U))) |
17493 | 962 t)) |
963 | |
964 (defun gnus-browse-exit () | |
965 "Quit browsing and return to the group buffer." | |
966 (interactive) | |
967 (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
|
968 (gnus-kill-buffer (current-buffer))) |
17493 | 969 ;; 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
|
970 (with-current-buffer gnus-group-buffer |
17493 | 971 (gnus-group-list-groups nil)) |
972 (if gnus-browse-return-buffer | |
973 (gnus-configure-windows 'server 'force) | |
974 (gnus-configure-windows 'group 'force))) | |
975 | |
976 (defun gnus-browse-describe-briefly () | |
977 "Give a one line description of the group mode commands." | |
978 (interactive) | |
979 (gnus-message 6 | |
980 (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"))) | |
981 | |
982 (defun gnus-server-regenerate-server () | |
983 "Issue a command to the server to regenerate all its data structures." | |
984 (interactive) | |
985 (let ((server (gnus-server-server-name))) | |
986 (unless server | |
987 (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
|
988 (condition-case () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
989 (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
|
990 'request-regenerate) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
54589
diff
changeset
|
991 (error |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
992 (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
|
993 (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
|
994 (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
|
995 (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
|
996 (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
|
997 (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
|
998 (gnus-message 5 "Couldn't regenerate %s" server)))) |
17493 | 999 |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1000 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1001 ;;; |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1002 ;;; 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
|
1003 ;;; |
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 ;; #### 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
|
1006 ;; #### appearance. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1007 (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
|
1008 "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
|
1009 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1010 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
|
1011 (interactive) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1012 (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
|
1013 (unless server |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1014 (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
|
1015 (condition-case () |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1016 (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
|
1017 'request-compact) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1018 (error |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1019 (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
|
1020 (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
|
1021 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
|
1022 server) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
1023 (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
|
1024 (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
|
1025 (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
|
1026 (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
|
1027 (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
|
1028 ;; 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
|
1029 ;; #### 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
|
1030 ;; #### 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
|
1031 (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
|
1032 (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
|
1033 |
17493 | 1034 (provide 'gnus-srvr) |
1035 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
1036 ;; 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
|
1037 ;;; gnus-srvr.el ends here |