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