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