comparison lisp/gnus/gnus-group.el @ 88155:d7ddb3e565de

sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 0d8b17d428b5
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; gnus-group.el --- group mode commands for Gnus 1 ;;; gnus-group.el --- group mode commands for Gnus
2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000 2
3 ;; Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
4 5
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> 6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: news 7 ;; Keywords: news
7 8
8 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details. 19 ;; GNU General Public License for more details.
19 20
20 ;; You should have received a copy of the GNU General Public License 21 ;; 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 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02110-1301, USA.
24 25
25 ;;; Commentary: 26 ;;; Commentary:
26 27
27 ;;; Code: 28 ;;; Code:
28 29
29 (eval-when-compile (require 'cl)) 30 (eval-when-compile
31 (require 'cl)
32 (defvar tool-bar-map))
30 33
31 (require 'gnus) 34 (require 'gnus)
32 (require 'gnus-start) 35 (require 'gnus-start)
33 (require 'nnmail) 36 (require 'nnmail)
34 (require 'gnus-spec) 37 (require 'gnus-spec)
35 (require 'gnus-int) 38 (require 'gnus-int)
36 (require 'gnus-range) 39 (require 'gnus-range)
37 (require 'gnus-win) 40 (require 'gnus-win)
38 (require 'gnus-undo) 41 (require 'gnus-undo)
39 (require 'time-date) 42 (require 'time-date)
43 (require 'gnus-ems)
44
45 (eval-when-compile
46 (require 'mm-url)
47 (let ((features (cons 'gnus-group features)))
48 (require 'gnus-sum))
49 (defvar gnus-cache-active-hashtb))
40 50
41 (defcustom gnus-group-archive-directory 51 (defcustom gnus-group-archive-directory
42 "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" 52 "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
43 "*The address of the (ding) archives." 53 "*The address of the (ding) archives."
44 :group 'gnus-group-foreign 54 :group 'gnus-group-foreign
45 :type 'directory) 55 :type 'directory)
46 56
47 (defcustom gnus-group-recent-archive-directory 57 (defcustom gnus-group-recent-archive-directory
48 "*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" 58 "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
49 "*The address of the most recent (ding) articles." 59 "*The address of the most recent (ding) articles."
50 :group 'gnus-group-foreign 60 :group 'gnus-group-foreign
51 :type 'directory) 61 :type 'directory)
52 62
53 (defcustom gnus-no-groups-message "No gnus is bad news" 63 (defcustom gnus-no-groups-message "No gnus is bad news"
115 "*Function used for sorting the group buffer. 125 "*Function used for sorting the group buffer.
116 This function will be called with group info entries as the arguments 126 This function will be called with group info entries as the arguments
117 for the groups to be sorted. Pre-made functions include 127 for the groups to be sorted. Pre-made functions include
118 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name', 128 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
119 `gnus-group-sort-by-unread', `gnus-group-sort-by-level', 129 `gnus-group-sort-by-unread', `gnus-group-sort-by-level',
120 `gnus-group-sort-by-score', `gnus-group-sort-by-method', and 130 `gnus-group-sort-by-score', `gnus-group-sort-by-method',
121 `gnus-group-sort-by-rank'. 131 `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
122 132
123 This variable can also be a list of sorting functions. In that case, 133 This variable can also be a list of sorting functions. In that case,
124 the most significant sort function should be the last function in the 134 the most significant sort function should be the last function in the
125 list." 135 list."
126 :group 'gnus-group-listing 136 :group 'gnus-group-listing
127 :link '(custom-manual "(gnus)Sorting Groups") 137 :link '(custom-manual "(gnus)Sorting Groups")
128 :type '(radio (function-item gnus-group-sort-by-alphabet) 138 :type '(repeat :value-to-internal (lambda (widget value)
129 (function-item gnus-group-sort-by-real-name) 139 (if (listp value) value (list value)))
130 (function-item gnus-group-sort-by-unread) 140 :match (lambda (widget value)
131 (function-item gnus-group-sort-by-level) 141 (or (symbolp value)
132 (function-item gnus-group-sort-by-score) 142 (widget-editable-list-match widget value)))
133 (function-item gnus-group-sort-by-method) 143 (choice (function-item gnus-group-sort-by-alphabet)
134 (function-item gnus-group-sort-by-rank) 144 (function-item gnus-group-sort-by-real-name)
135 (function :tag "other" nil))) 145 (function-item gnus-group-sort-by-unread)
136 146 (function-item gnus-group-sort-by-level)
137 (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n" 147 (function-item gnus-group-sort-by-score)
148 (function-item gnus-group-sort-by-method)
149 (function-item gnus-group-sort-by-server)
150 (function-item gnus-group-sort-by-rank)
151 (function :tag "other" nil))))
152
153 (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n"
138 "*Format of group lines. 154 "*Format of group lines.
139 It works along the same lines as a normal formatting string, 155 It works along the same lines as a normal formatting string,
140 with some simple extensions. 156 with some simple extensions.
141 157
142 %M Only marked articles (character, \"*\" or \" \") 158 %M Only marked articles (character, \"*\" or \" \")
145 %N Number of unread articles (integer) 161 %N Number of unread articles (integer)
146 %I Number of dormant articles (integer) 162 %I Number of dormant articles (integer)
147 %i Number of ticked and dormant (integer) 163 %i Number of ticked and dormant (integer)
148 %T Number of ticked articles (integer) 164 %T Number of ticked articles (integer)
149 %R Number of read articles (integer) 165 %R Number of read articles (integer)
166 %U Number of unseen articles (integer)
150 %t Estimated total number of articles (integer) 167 %t Estimated total number of articles (integer)
151 %y Number of unread, unticked articles (integer) 168 %y Number of unread, unticked articles (integer)
152 %G Group name (string) 169 %G Group name (string)
153 %g Qualified group name (string) 170 %g Qualified group name (string)
171 %c Short (collapsed) group name. See `gnus-group-uncollapsed-levels'.
172 %C Group comment (string)
154 %D Group description (string) 173 %D Group description (string)
155 %s Select method (string) 174 %s Select method (string)
156 %o Moderated group (char, \"m\") 175 %o Moderated group (char, \"m\")
157 %p Process mark (char) 176 %p Process mark (char)
177 %B Whether a summary buffer for the group is open (char, \"*\")
158 %O Moderated group (string, \"(m)\" or \"\") 178 %O Moderated group (string, \"(m)\" or \"\")
159 %P Topic indentation (string) 179 %P Topic indentation (string)
160 %m Whether there is new(ish) mail in the group (char, \"%\") 180 %m Whether there is new(ish) mail in the group (char, \"%\")
161 %l Whether there are GroupLens predictions for this group (string) 181 %l Whether there are GroupLens predictions for this group (string)
162 %n Select from where (string) 182 %n Select from where (string)
163 %z A string that look like `<%s:%n>' if a foreign select method is used 183 %z A string that look like `<%s:%n>' if a foreign select method is used
164 %d The date the group was last entered. 184 %d The date the group was last entered.
165 %E Icon as defined by `gnus-group-icon-list'. 185 %E Icon as defined by `gnus-group-icon-list'.
166 %u User defined specifier. The next character in the format string should 186 %u User defined specifier. The next character in the format string should
167 be a letter. Gnus will call the function gnus-user-format-function-X, 187 be a letter. Gnus will call the function gnus-user-format-function-X,
168 where X is the letter following %u. The function will be passed the 188 where X is the letter following %u. The function will be passed a
169 current header as argument. The function should return a string, which 189 single dummy parameter as argument. The function should return a
170 will be inserted into the buffer just like information from any other 190 string, which will be inserted into the buffer just like information
171 group specifier. 191 from any other group specifier.
172
173 Text between %( and %) will be highlighted with `gnus-mouse-face' when
174 the mouse point move inside the area. There can only be one such area.
175 192
176 Note that this format specification is not always respected. For 193 Note that this format specification is not always respected. For
177 reasons of efficiency, when listing killed groups, this specification 194 reasons of efficiency, when listing killed groups, this specification
178 is ignored altogether. If the spec is changed considerably, your 195 is ignored altogether. If the spec is changed considerably, your
179 output may end up looking strange when listing both alive and killed 196 output may end up looking strange when listing both alive and killed
181 198
182 If you use %o or %O, reading the active file will be slower and quite 199 If you use %o or %O, reading the active file will be slower and quite
183 a bit of extra memory will be used. %D will also worsen performance. 200 a bit of extra memory will be used. %D will also worsen performance.
184 Also note that if you change the format specification to include any 201 Also note that if you change the format specification to include any
185 of these specs, you must probably re-start Gnus to see them go into 202 of these specs, you must probably re-start Gnus to see them go into
186 effect." 203 effect.
204
205 General format specifiers can also be used.
206 See Info node `(gnus)Formatting Variables'."
207 :link '(custom-manual "(gnus)Formatting Variables")
187 :group 'gnus-group-visual 208 :group 'gnus-group-visual
188 :type 'string) 209 :type 'string)
189 210
190 (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}" 211 (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
191 "*The format specification for the group mode line. 212 "*The format specification for the group mode line.
196 %M The native select method. 217 %M The native select method.
197 %: \":\" if %S isn't \"\"." 218 %: \":\" if %S isn't \"\"."
198 :group 'gnus-group-visual 219 :group 'gnus-group-visual
199 :type 'string) 220 :type 'string)
200 221
201 (defcustom gnus-group-mode-hook nil 222 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
202 "Hook for Gnus group mode." 223 (when (featurep 'xemacs)
203 :group 'gnus-group-various 224 (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
204 :options '(gnus-topic-mode) 225 (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
205 :type 'hook)
206 226
207 (defcustom gnus-group-menu-hook nil 227 (defcustom gnus-group-menu-hook nil
208 "Hook run after the creation of the group mode menu." 228 "Hook run after the creation of the group mode menu."
209 :group 'gnus-group-various 229 :group 'gnus-group-various
210 :type 'hook) 230 :type 'hook)
262 variable." 282 variable."
263 :group 'gnus-group-visual 283 :group 'gnus-group-visual
264 :type 'hook) 284 :type 'hook)
265 285
266 (defcustom gnus-useful-groups 286 (defcustom gnus-useful-groups
267 '(("(ding) mailing list mirrored at sunsite.auc.dk" 287 '(("(ding) mailing list mirrored at gmane.org"
268 "emacs.ding" 288 "gmane.emacs.gnus.general"
269 (nntp "sunsite.auc.dk" 289 (nntp "Gmane"
270 (nntp-address "sunsite.auc.dk"))) 290 (nntp-address "news.gmane.org")))
271 ("gnus-bug archive" 291 ("Gnus bug archive"
272 "gnus-bug" 292 "gnus.gnus-bug"
273 (nndir "/ftp@ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/")) 293 (nntp "news.gnus.org"
274 ("Gnus help group" 294 (nntp-address "news.gnus.org")))
295 ("Local Gnus help group"
275 "gnus-help" 296 "gnus-help"
276 (nndoc "gnus-help" 297 (nndoc "gnus-help"
277 (nndoc-article-type mbox) 298 (nndoc-article-type mbox)
278 (eval `(nndoc-address 299 (eval `(nndoc-address
279 ,(let ((file (nnheader-find-etc-directory 300 ,(let ((file (nnheader-find-etc-directory
286 :type '(repeat (list (string :tag "Description") 307 :type '(repeat (list (string :tag "Description")
287 (string :tag "Name") 308 (string :tag "Name")
288 (sexp :tag "Method")))) 309 (sexp :tag "Method"))))
289 310
290 (defcustom gnus-group-highlight 311 (defcustom gnus-group-highlight
291 '(;; News. 312 '(;; Mail.
292 ((and (= unread 0) (not mailp) (eq level 1)) . 313 ((and mailp (= unread 0) (eq level 1)) .
293 gnus-group-news-1-empty-face) 314 gnus-group-mail-1-empty)
294 ((and (not mailp) (eq level 1)) . 315 ((and mailp (eq level 1)) .
295 gnus-group-news-1-face) 316 gnus-group-mail-1)
296 ((and (= unread 0) (not mailp) (eq level 2)) . 317 ((and mailp (= unread 0) (eq level 2)) .
297 gnus-group-news-2-empty-face) 318 gnus-group-mail-2-empty)
298 ((and (not mailp) (eq level 2)) . 319 ((and mailp (eq level 2)) .
299 gnus-group-news-2-face) 320 gnus-group-mail-2)
300 ((and (= unread 0) (not mailp) (eq level 3)) . 321 ((and mailp (= unread 0) (eq level 3)) .
301 gnus-group-news-3-empty-face) 322 gnus-group-mail-3-empty)
302 ((and (not mailp) (eq level 3)) . 323 ((and mailp (eq level 3)) .
303 gnus-group-news-3-face) 324 gnus-group-mail-3)
304 ((and (= unread 0) (not mailp) (eq level 4)) . 325 ((and mailp (= unread 0)) .
305 gnus-group-news-4-empty-face) 326 gnus-group-mail-low-empty)
306 ((and (not mailp) (eq level 4)) . 327 ((and mailp) .
307 gnus-group-news-4-face) 328 gnus-group-mail-low)
308 ((and (= unread 0) (not mailp) (eq level 5)) . 329 ;; News.
309 gnus-group-news-5-empty-face)
310 ((and (not mailp) (eq level 5)) .
311 gnus-group-news-5-face)
312 ((and (= unread 0) (not mailp) (eq level 6)) .
313 gnus-group-news-6-empty-face)
314 ((and (not mailp) (eq level 6)) .
315 gnus-group-news-6-face)
316 ((and (= unread 0) (not mailp)) .
317 gnus-group-news-low-empty-face)
318 ((and (not mailp)) .
319 gnus-group-news-low-face)
320 ;; Mail.
321 ((and (= unread 0) (eq level 1)) . 330 ((and (= unread 0) (eq level 1)) .
322 gnus-group-mail-1-empty-face) 331 gnus-group-news-1-empty)
323 ((eq level 1) . 332 ((and (eq level 1)) .
324 gnus-group-mail-1-face) 333 gnus-group-news-1)
325 ((and (= unread 0) (eq level 2)) . 334 ((and (= unread 0) (eq level 2)) .
326 gnus-group-mail-2-empty-face) 335 gnus-group-news-2-empty)
327 ((eq level 2) . 336 ((and (eq level 2)) .
328 gnus-group-mail-2-face) 337 gnus-group-news-2)
329 ((and (= unread 0) (eq level 3)) . 338 ((and (= unread 0) (eq level 3)) .
330 gnus-group-mail-3-empty-face) 339 gnus-group-news-3-empty)
331 ((eq level 3) . 340 ((and (eq level 3)) .
332 gnus-group-mail-3-face) 341 gnus-group-news-3)
333 ((= unread 0) . 342 ((and (= unread 0) (eq level 4)) .
334 gnus-group-mail-low-empty-face) 343 gnus-group-news-4-empty)
344 ((and (eq level 4)) .
345 gnus-group-news-4)
346 ((and (= unread 0) (eq level 5)) .
347 gnus-group-news-5-empty)
348 ((and (eq level 5)) .
349 gnus-group-news-5)
350 ((and (= unread 0) (eq level 6)) .
351 gnus-group-news-6-empty)
352 ((and (eq level 6)) .
353 gnus-group-news-6)
354 ((and (= unread 0)) .
355 gnus-group-news-low-empty)
335 (t . 356 (t .
336 gnus-group-mail-low-face)) 357 gnus-group-news-low))
337 "*Controls the highlighting of group buffer lines. 358 "*Controls the highlighting of group buffer lines.
338 359
339 Below is a list of `Form'/`Face' pairs. When deciding how a a 360 Below is a list of `Form'/`Face' pairs. When deciding how a a
340 particular group line should be displayed, each form is 361 particular group line should be displayed, each form is
341 evaluated. The content of the face field after the first true form is 362 evaluated. The content of the face field after the first true form is
361 "Mark used for groups with new mail." 382 "Mark used for groups with new mail."
362 :group 'gnus-group-visual 383 :group 'gnus-group-visual
363 :type 'character) 384 :type 'character)
364 385
365 (defgroup gnus-group-icons nil 386 (defgroup gnus-group-icons nil
366 "Add Icons to your group buffer. " 387 "Add Icons to your group buffer."
367 :group 'gnus-group-visual) 388 :group 'gnus-group-visual)
368 389
369 (defcustom gnus-group-icon-list 390 (defcustom gnus-group-icon-list
370 nil 391 nil
371 "*Controls the insertion of icons into group buffer lines. 392 "*Controls the insertion of icons into group buffer lines.
393 ticked: The number of ticked articles." 414 ticked: The number of ticked articles."
394 :group 'gnus-group-icons 415 :group 'gnus-group-icons
395 :type '(repeat (cons (sexp :tag "Form") file))) 416 :type '(repeat (cons (sexp :tag "Form") file)))
396 417
397 (defcustom gnus-group-name-charset-method-alist nil 418 (defcustom gnus-group-name-charset-method-alist nil
398 "*Alist of method and the charset for group names. 419 "Alist of method and the charset for group names.
399 420
400 For example: 421 For example:
401 (((nntp \"news.com.cn\") . cn-gb-2312)) 422 (((nntp \"news.com.cn\") . cn-gb-2312))"
402 "
403 :version "21.1" 423 :version "21.1"
404 :group 'gnus-charset 424 :group 'gnus-charset
405 :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset")))) 425 :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
406 426
407 (defcustom gnus-group-name-charset-group-alist nil 427 (defcustom gnus-group-name-charset-group-alist
408 "*Alist of group regexp and the charset for group names. 428 (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
429 (mm-coding-system-p 'utf-8))
430 '((".*" . utf-8))
431 nil)
432 "Alist of group regexp and the charset for group names.
409 433
410 For example: 434 For example:
411 ((\"\\.com\\.cn:\" . cn-gb-2312)) 435 ((\"\\.com\\.cn:\" . cn-gb-2312))"
412 "
413 :group 'gnus-charset 436 :group 'gnus-charset
414 :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset")))) 437 :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
415 438
439 (defcustom gnus-group-jump-to-group-prompt nil
440 "Default prompt for `gnus-group-jump-to-group'.
441 If non-nil, the value should be a string, e.g. \"nnml:\",
442 in which case `gnus-group-jump-to-group' offers \"Group: nnml:\"
443 in the minibuffer prompt."
444 :version "22.1"
445 :group 'gnus-group-various
446 :type '(choice (string :tag "Prompt string")
447 (const :tag "Empty" nil)))
448
449 (defvar gnus-group-listing-limit 1000
450 "*A limit of the number of groups when listing.
451 If the number of groups is larger than the limit, list them in a
452 simple manner.")
453
416 ;;; Internal variables 454 ;;; Internal variables
417 455
456 (defvar gnus-group-is-exiting-p nil)
457 (defvar gnus-group-is-exiting-without-update-p nil)
418 (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat 458 (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
419 "Function for sorting the group buffer.") 459 "Function for sorting the group buffer.")
420 460
421 (defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat 461 (defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
422 "Function for sorting the selected groups in the group buffer.") 462 "Function for sorting the selected groups in the group buffer.")
439 (+ number 479 (+ number
440 (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) 480 (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
441 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) 481 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
442 (t number)) ?s) 482 (t number)) ?s)
443 (?R gnus-tmp-number-of-read ?s) 483 (?R gnus-tmp-number-of-read ?s)
484 (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
444 (?t gnus-tmp-number-total ?d) 485 (?t gnus-tmp-number-total ?d)
445 (?y gnus-tmp-number-of-unread ?s) 486 (?y gnus-tmp-number-of-unread ?s)
446 (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) 487 (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
447 (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) 488 (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
448 (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) 489 (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
449 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) 490 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
450 (?g gnus-tmp-group ?s) 491 (?g (if (boundp 'gnus-tmp-decoded-group)
492 gnus-tmp-decoded-group
493 gnus-tmp-group)
494 ?s)
451 (?G gnus-tmp-qualified-group ?s) 495 (?G gnus-tmp-qualified-group ?s)
452 (?c (gnus-short-group-name gnus-tmp-group) ?s) 496 (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
497 gnus-tmp-decoded-group
498 gnus-tmp-group))
499 ?s)
500 (?C gnus-tmp-comment ?s)
453 (?D gnus-tmp-newsgroup-description ?s) 501 (?D gnus-tmp-newsgroup-description ?s)
454 (?o gnus-tmp-moderated ?c) 502 (?o gnus-tmp-moderated ?c)
455 (?O gnus-tmp-moderated-string ?s) 503 (?O gnus-tmp-moderated-string ?s)
456 (?p gnus-tmp-process-marked ?c) 504 (?p gnus-tmp-process-marked ?c)
457 (?s gnus-tmp-news-server ?s) 505 (?s gnus-tmp-news-server ?s)
458 (?n gnus-tmp-news-method ?s) 506 (?n ,(if (featurep 'xemacs)
507 '(symbol-name gnus-tmp-news-method)
508 'gnus-tmp-news-method)
509 ?s)
459 (?P gnus-group-indentation ?s) 510 (?P gnus-group-indentation ?s)
460 (?E gnus-tmp-group-icon ?s) 511 (?E gnus-tmp-group-icon ?s)
512 (?B gnus-tmp-summary-live ?c)
461 (?l gnus-tmp-grouplens ?s) 513 (?l gnus-tmp-grouplens ?s)
462 (?z gnus-tmp-news-method-string ?s) 514 (?z gnus-tmp-news-method-string ?s)
463 (?m (gnus-group-new-mail gnus-tmp-group) ?c) 515 (?m (gnus-group-new-mail gnus-tmp-group) ?c)
464 (?d (gnus-group-timestamp-string gnus-tmp-group) ?s) 516 (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
465 (?u gnus-tmp-user-defined ?s))) 517 (?u gnus-tmp-user-defined ?s)))
481 (defvar gnus-group-list-mode nil) 533 (defvar gnus-group-list-mode nil)
482 534
483 535
484 (defvar gnus-group-icon-cache nil) 536 (defvar gnus-group-icon-cache nil)
485 537
538 (defvar gnus-group-listed-groups nil)
539 (defvar gnus-group-list-option nil)
540
486 ;;; 541 ;;;
487 ;;; Gnus group mode 542 ;;; Gnus group mode
488 ;;; 543 ;;;
489 544
490 (put 'gnus-group-mode 'mode-class 'special) 545 (put 'gnus-group-mode 'mode-class 'special)
491 546
492 (when t 547 (gnus-define-keys gnus-group-mode-map
493 (gnus-define-keys gnus-group-mode-map 548 " " gnus-group-read-group
494 " " gnus-group-read-group 549 "=" gnus-group-select-group
495 "=" gnus-group-select-group 550 "\r" gnus-group-select-group
496 "\r" gnus-group-select-group 551 "\M-\r" gnus-group-quick-select-group
497 "\M-\r" gnus-group-quick-select-group 552 "\M- " gnus-group-visible-select-group
498 "\M- " gnus-group-visible-select-group 553 [(meta control return)] gnus-group-select-group-ephemerally
499 [(meta control return)] gnus-group-select-group-ephemerally 554 "j" gnus-group-jump-to-group
500 "j" gnus-group-jump-to-group 555 "n" gnus-group-next-unread-group
501 "n" gnus-group-next-unread-group 556 "p" gnus-group-prev-unread-group
502 "p" gnus-group-prev-unread-group 557 "\177" gnus-group-prev-unread-group
503 "\177" gnus-group-prev-unread-group 558 [delete] gnus-group-prev-unread-group
504 [delete] gnus-group-prev-unread-group 559 [backspace] gnus-group-prev-unread-group
505 [backspace] gnus-group-prev-unread-group 560 "N" gnus-group-next-group
506 "N" gnus-group-next-group 561 "P" gnus-group-prev-group
507 "P" gnus-group-prev-group 562 "\M-n" gnus-group-next-unread-group-same-level
508 "\M-n" gnus-group-next-unread-group-same-level 563 "\M-p" gnus-group-prev-unread-group-same-level
509 "\M-p" gnus-group-prev-unread-group-same-level 564 "," gnus-group-best-unread-group
510 "," gnus-group-best-unread-group 565 "." gnus-group-first-unread-group
511 "." gnus-group-first-unread-group 566 "u" gnus-group-unsubscribe-current-group
512 "u" gnus-group-unsubscribe-current-group 567 "U" gnus-group-unsubscribe-group
513 "U" gnus-group-unsubscribe-group 568 "c" gnus-group-catchup-current
514 "c" gnus-group-catchup-current 569 "C" gnus-group-catchup-current-all
515 "C" gnus-group-catchup-current-all 570 "\M-c" gnus-group-clear-data
516 "\M-c" gnus-group-clear-data 571 "l" gnus-group-list-groups
517 "l" gnus-group-list-groups 572 "L" gnus-group-list-all-groups
518 "L" gnus-group-list-all-groups 573 "m" gnus-group-mail
519 "m" gnus-group-mail 574 "i" gnus-group-news
520 "g" gnus-group-get-new-news 575 "g" gnus-group-get-new-news
521 "\M-g" gnus-group-get-new-news-this-group 576 "\M-g" gnus-group-get-new-news-this-group
522 "R" gnus-group-restart 577 "R" gnus-group-restart
523 "r" gnus-group-read-init-file 578 "r" gnus-group-read-init-file
524 "B" gnus-group-browse-foreign-server 579 "B" gnus-group-browse-foreign-server
525 "b" gnus-group-check-bogus-groups 580 "b" gnus-group-check-bogus-groups
526 "F" gnus-group-find-new-groups 581 "F" gnus-group-find-new-groups
527 "\C-c\C-d" gnus-group-describe-group 582 "\C-c\C-d" gnus-group-describe-group
528 "\M-d" gnus-group-describe-all-groups 583 "\M-d" gnus-group-describe-all-groups
529 "\C-c\C-a" gnus-group-apropos 584 "\C-c\C-a" gnus-group-apropos
530 "\C-c\M-\C-a" gnus-group-description-apropos 585 "\C-c\M-\C-a" gnus-group-description-apropos
531 "a" gnus-group-post-news 586 "a" gnus-group-post-news
532 "\ek" gnus-group-edit-local-kill 587 "\ek" gnus-group-edit-local-kill
533 "\eK" gnus-group-edit-global-kill 588 "\eK" gnus-group-edit-global-kill
534 "\C-k" gnus-group-kill-group 589 "\C-k" gnus-group-kill-group
535 "\C-y" gnus-group-yank-group 590 "\C-y" gnus-group-yank-group
536 "\C-w" gnus-group-kill-region 591 "\C-w" gnus-group-kill-region
537 "\C-x\C-t" gnus-group-transpose-groups 592 "\C-x\C-t" gnus-group-transpose-groups
538 "\C-c\C-l" gnus-group-list-killed 593 "\C-c\C-l" gnus-group-list-killed
539 "\C-c\C-x" gnus-group-expire-articles 594 "\C-c\C-x" gnus-group-expire-articles
540 "\C-c\M-\C-x" gnus-group-expire-all-groups 595 "\C-c\M-\C-x" gnus-group-expire-all-groups
541 "V" gnus-version 596 "V" gnus-version
542 "s" gnus-group-save-newsrc 597 "s" gnus-group-save-newsrc
543 "z" gnus-group-suspend 598 "z" gnus-group-suspend
544 "q" gnus-group-exit 599 "q" gnus-group-exit
545 "Q" gnus-group-quit 600 "Q" gnus-group-quit
546 "?" gnus-group-describe-briefly 601 "?" gnus-group-describe-briefly
547 "\C-c\C-i" gnus-info-find-node 602 "\C-c\C-i" gnus-info-find-node
548 "\M-e" gnus-group-edit-group-method 603 "\M-e" gnus-group-edit-group-method
549 "^" gnus-group-enter-server-mode 604 "^" gnus-group-enter-server-mode
550 gnus-mouse-2 gnus-mouse-pick-group 605 gnus-mouse-2 gnus-mouse-pick-group
551 "<" beginning-of-buffer 606 [follow-link] mouse-face
552 ">" end-of-buffer 607 "<" beginning-of-buffer
553 "\C-c\C-b" gnus-bug 608 ">" end-of-buffer
554 "\C-c\C-s" gnus-group-sort-groups 609 "\C-c\C-b" gnus-bug
555 "t" gnus-topic-mode 610 "\C-c\C-s" gnus-group-sort-groups
556 "\C-c\M-g" gnus-activate-all-groups 611 "t" gnus-topic-mode
557 "\M-&" gnus-group-universal-argument 612 "\C-c\M-g" gnus-activate-all-groups
558 "#" gnus-group-mark-group 613 "\M-&" gnus-group-universal-argument
559 "\M-#" gnus-group-unmark-group) 614 "#" gnus-group-mark-group
560 615 "\M-#" gnus-group-unmark-group)
561 (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) 616
562 "m" gnus-group-mark-group 617 (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
563 "u" gnus-group-unmark-group 618 "m" gnus-group-mark-group
564 "w" gnus-group-mark-region 619 "u" gnus-group-unmark-group
565 "b" gnus-group-mark-buffer 620 "w" gnus-group-mark-region
566 "r" gnus-group-mark-regexp 621 "b" gnus-group-mark-buffer
567 "U" gnus-group-unmark-all-groups) 622 "r" gnus-group-mark-regexp
568 623 "U" gnus-group-unmark-all-groups)
569 (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) 624
570 "d" gnus-group-make-directory-group 625 (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
571 "h" gnus-group-make-help-group 626 "u" gnus-sieve-update
572 "u" gnus-group-make-useful-group 627 "g" gnus-sieve-generate)
573 "a" gnus-group-make-archive-group 628
574 "k" gnus-group-make-kiboze-group 629 (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
575 "l" gnus-group-nnimap-edit-acl 630 "d" gnus-group-make-directory-group
576 "m" gnus-group-make-group 631 "h" gnus-group-make-help-group
577 "E" gnus-group-edit-group 632 "u" gnus-group-make-useful-group
578 "e" gnus-group-edit-group-method 633 "a" gnus-group-make-archive-group
579 "p" gnus-group-edit-group-parameters 634 "k" gnus-group-make-kiboze-group
580 "v" gnus-group-add-to-virtual 635 "l" gnus-group-nnimap-edit-acl
581 "V" gnus-group-make-empty-virtual 636 "m" gnus-group-make-group
582 "D" gnus-group-enter-directory 637 "E" gnus-group-edit-group
583 "f" gnus-group-make-doc-group 638 "e" gnus-group-edit-group-method
584 "w" gnus-group-make-web-group 639 "p" gnus-group-edit-group-parameters
585 "r" gnus-group-rename-group 640 "v" gnus-group-add-to-virtual
586 "c" gnus-group-customize 641 "V" gnus-group-make-empty-virtual
587 "x" gnus-group-nnimap-expunge 642 "D" gnus-group-enter-directory
588 "\177" gnus-group-delete-group 643 "f" gnus-group-make-doc-group
589 [delete] gnus-group-delete-group) 644 "w" gnus-group-make-web-group
590 645 "M" gnus-group-read-ephemeral-group
591 (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) 646 "r" gnus-group-rename-group
592 "b" gnus-group-brew-soup 647 "R" gnus-group-make-rss-group
593 "w" gnus-soup-save-areas 648 "c" gnus-group-customize
594 "s" gnus-soup-send-replies 649 "x" gnus-group-nnimap-expunge
595 "p" gnus-soup-pack-packet 650 "\177" gnus-group-delete-group
596 "r" nnsoup-pack-replies) 651 [delete] gnus-group-delete-group)
597 652
598 (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) 653 (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
599 "s" gnus-group-sort-groups 654 "b" gnus-group-brew-soup
600 "a" gnus-group-sort-groups-by-alphabet 655 "w" gnus-soup-save-areas
601 "u" gnus-group-sort-groups-by-unread 656 "s" gnus-soup-send-replies
602 "l" gnus-group-sort-groups-by-level 657 "p" gnus-soup-pack-packet
603 "v" gnus-group-sort-groups-by-score 658 "r" nnsoup-pack-replies)
604 "r" gnus-group-sort-groups-by-rank 659
605 "m" gnus-group-sort-groups-by-method) 660 (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
606 661 "s" gnus-group-sort-groups
607 (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) 662 "a" gnus-group-sort-groups-by-alphabet
608 "s" gnus-group-sort-selected-groups 663 "u" gnus-group-sort-groups-by-unread
609 "a" gnus-group-sort-selected-groups-by-alphabet 664 "l" gnus-group-sort-groups-by-level
610 "u" gnus-group-sort-selected-groups-by-unread 665 "v" gnus-group-sort-groups-by-score
611 "l" gnus-group-sort-selected-groups-by-level 666 "r" gnus-group-sort-groups-by-rank
612 "v" gnus-group-sort-selected-groups-by-score 667 "m" gnus-group-sort-groups-by-method
613 "r" gnus-group-sort-selected-groups-by-rank 668 "n" gnus-group-sort-groups-by-real-name)
614 "m" gnus-group-sort-selected-groups-by-method) 669
615 670 (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
616 (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) 671 "s" gnus-group-sort-selected-groups
617 "k" gnus-group-list-killed 672 "a" gnus-group-sort-selected-groups-by-alphabet
618 "z" gnus-group-list-zombies 673 "u" gnus-group-sort-selected-groups-by-unread
619 "s" gnus-group-list-groups 674 "l" gnus-group-sort-selected-groups-by-level
620 "u" gnus-group-list-all-groups 675 "v" gnus-group-sort-selected-groups-by-score
621 "A" gnus-group-list-active 676 "r" gnus-group-sort-selected-groups-by-rank
622 "a" gnus-group-apropos 677 "m" gnus-group-sort-selected-groups-by-method
623 "d" gnus-group-description-apropos 678 "n" gnus-group-sort-selected-groups-by-real-name)
624 "m" gnus-group-list-matching 679
625 "M" gnus-group-list-all-matching 680 (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
626 "l" gnus-group-list-level 681 "k" gnus-group-list-killed
627 "c" gnus-group-list-cached 682 "z" gnus-group-list-zombies
628 "?" gnus-group-list-dormant) 683 "s" gnus-group-list-groups
629 684 "u" gnus-group-list-all-groups
630 (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) 685 "A" gnus-group-list-active
631 "f" gnus-score-flush-cache) 686 "a" gnus-group-apropos
632 687 "d" gnus-group-description-apropos
633 (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) 688 "m" gnus-group-list-matching
634 "d" gnus-group-describe-group 689 "M" gnus-group-list-all-matching
635 "f" gnus-group-fetch-faq 690 "l" gnus-group-list-level
636 "v" gnus-version) 691 "c" gnus-group-list-cached
637 692 "?" gnus-group-list-dormant)
638 (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) 693
639 "l" gnus-group-set-current-level 694 (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
640 "t" gnus-group-unsubscribe-current-group 695 "k" gnus-group-list-limit
641 "s" gnus-group-unsubscribe-group 696 "z" gnus-group-list-limit
642 "k" gnus-group-kill-group 697 "s" gnus-group-list-limit
643 "y" gnus-group-yank-group 698 "u" gnus-group-list-limit
644 "w" gnus-group-kill-region 699 "A" gnus-group-list-limit
645 "\C-k" gnus-group-kill-level 700 "m" gnus-group-list-limit
646 "z" gnus-group-kill-all-zombies)) 701 "M" gnus-group-list-limit
702 "l" gnus-group-list-limit
703 "c" gnus-group-list-limit
704 "?" gnus-group-list-limit)
705
706 (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
707 "k" gnus-group-list-flush
708 "z" gnus-group-list-flush
709 "s" gnus-group-list-flush
710 "u" gnus-group-list-flush
711 "A" gnus-group-list-flush
712 "m" gnus-group-list-flush
713 "M" gnus-group-list-flush
714 "l" gnus-group-list-flush
715 "c" gnus-group-list-flush
716 "?" gnus-group-list-flush)
717
718 (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
719 "k" gnus-group-list-plus
720 "z" gnus-group-list-plus
721 "s" gnus-group-list-plus
722 "u" gnus-group-list-plus
723 "A" gnus-group-list-plus
724 "m" gnus-group-list-plus
725 "M" gnus-group-list-plus
726 "l" gnus-group-list-plus
727 "c" gnus-group-list-plus
728 "?" gnus-group-list-plus)
729
730 (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
731 "f" gnus-score-flush-cache)
732
733 (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
734 "c" gnus-group-fetch-charter
735 "C" gnus-group-fetch-control
736 "d" gnus-group-describe-group
737 "f" gnus-group-fetch-faq
738 "v" gnus-version)
739
740 (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
741 "l" gnus-group-set-current-level
742 "t" gnus-group-unsubscribe-current-group
743 "s" gnus-group-unsubscribe-group
744 "k" gnus-group-kill-group
745 "y" gnus-group-yank-group
746 "w" gnus-group-kill-region
747 "\C-k" gnus-group-kill-level
748 "z" gnus-group-kill-all-zombies)
749
750 (defun gnus-topic-mode-p ()
751 "Return non-nil in `gnus-topic-mode'."
752 (and (boundp 'gnus-topic-mode)
753 (symbol-value 'gnus-topic-mode)))
647 754
648 (defun gnus-group-make-menu-bar () 755 (defun gnus-group-make-menu-bar ()
649 (gnus-turn-off-edit-menu 'group) 756 (gnus-turn-off-edit-menu 'group)
650 (unless (boundp 'gnus-group-reading-menu) 757 (unless (boundp 'gnus-group-reading-menu)
651 758
652 (easy-menu-define 759 (easy-menu-define
653 gnus-group-reading-menu gnus-group-mode-map "" 760 gnus-group-reading-menu gnus-group-mode-map ""
654 '("Group" 761 `("Group"
655 ["Read" gnus-group-read-group (gnus-group-group-name)] 762 ["Read" gnus-group-read-group
656 ["Select" gnus-group-select-group (gnus-group-group-name)] 763 :included (not (gnus-topic-mode-p))
764 :active (gnus-group-group-name)]
765 ["Read " gnus-topic-read-group
766 :included (gnus-topic-mode-p)]
767 ["Select" gnus-group-select-group
768 :included (not (gnus-topic-mode-p))
769 :active (gnus-group-group-name)]
770 ["Select " gnus-topic-select-group
771 :included (gnus-topic-mode-p)]
657 ["See old articles" (gnus-group-select-group 'all) 772 ["See old articles" (gnus-group-select-group 'all)
658 :keys "C-u SPC" :active (gnus-group-group-name)] 773 :keys "C-u SPC" :active (gnus-group-group-name)]
659 ["Catch up" gnus-group-catchup-current :active (gnus-group-group-name) 774 ["Catch up" gnus-group-catchup-current
660 :help "Mark unread articles in the current group as read"] 775 :included (not (gnus-topic-mode-p))
776 :active (gnus-group-group-name)
777 ,@(if (featurep 'xemacs) nil
778 '(:help "Mark unread articles in the current group as read"))]
779 ["Catch up " gnus-topic-catchup-articles
780 :included (gnus-topic-mode-p)
781 ,@(if (featurep 'xemacs) nil
782 '(:help "Mark unread articles in the current group or topic as read"))]
661 ["Catch up all articles" gnus-group-catchup-current-all 783 ["Catch up all articles" gnus-group-catchup-current-all
662 (gnus-group-group-name)] 784 (gnus-group-group-name)]
663 ["Check for new articles" gnus-group-get-new-news-this-group 785 ["Check for new articles" gnus-group-get-new-news-this-group
786 :included (not (gnus-topic-mode-p))
664 :active (gnus-group-group-name) 787 :active (gnus-group-group-name)
665 :help "Check for new messages in current group"] 788 ,@(if (featurep 'xemacs) nil
789 '(:help "Check for new messages in current group"))]
790 ["Check for new articles " gnus-topic-get-new-news-this-topic
791 :included (gnus-topic-mode-p)
792 ,@(if (featurep 'xemacs) nil
793 '(:help "Check for new messages in current group or topic"))]
666 ["Toggle subscription" gnus-group-unsubscribe-current-group 794 ["Toggle subscription" gnus-group-unsubscribe-current-group
667 (gnus-group-group-name)] 795 (gnus-group-group-name)]
668 ["Kill" gnus-group-kill-group :active (gnus-group-group-name) 796 ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
669 :help "Kill (remove) current group"] 797 ,@(if (featurep 'xemacs) nil
798 '(:help "Kill (remove) current group"))]
670 ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] 799 ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
671 ["Describe" gnus-group-describe-group :active (gnus-group-group-name) 800 ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
672 :help "Display description of the current group"] 801 ,@(if (featurep 'xemacs) nil
802 '(:help "Display description of the current group"))]
673 ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] 803 ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
804 ["Fetch charter" gnus-group-fetch-charter
805 :active (gnus-group-group-name)
806 ,@(if (featurep 'xemacs) nil
807 '(:help "Display the charter of the current group"))]
808 ["Fetch control message" gnus-group-fetch-control
809 :active (gnus-group-group-name)
810 ,@(if (featurep 'xemacs) nil
811 '(:help "Display the archived control message for the current group"))]
674 ;; Actually one should check, if any of the marked groups gives t for 812 ;; Actually one should check, if any of the marked groups gives t for
675 ;; (gnus-check-backend-function 'request-expire-articles ...) 813 ;; (gnus-check-backend-function 'request-expire-articles ...)
676 ["Expire articles" gnus-group-expire-articles 814 ["Expire articles" gnus-group-expire-articles
677 (or (and (gnus-group-group-name) 815 :included (not (gnus-topic-mode-p))
678 (gnus-check-backend-function 816 :active (or (and (gnus-group-group-name)
679 'request-expire-articles 817 (gnus-check-backend-function
680 (gnus-group-group-name))) gnus-group-marked)] 818 'request-expire-articles
681 ["Set group level" gnus-group-set-current-level 819 (gnus-group-group-name))) gnus-group-marked)]
820 ["Expire articles " gnus-topic-expire-articles
821 :included (gnus-topic-mode-p)]
822 ["Set group level..." gnus-group-set-current-level
682 (gnus-group-group-name)] 823 (gnus-group-group-name)]
683 ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] 824 ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
684 ["Customize" gnus-group-customize (gnus-group-group-name)] 825 ["Customize" gnus-group-customize (gnus-group-group-name)]
685 ("Edit" 826 ("Edit"
686 ["Parameters" gnus-group-edit-group-parameters 827 ["Parameters" gnus-group-edit-group-parameters
687 (gnus-group-group-name)] 828 :included (not (gnus-topic-mode-p))
829 :active (gnus-group-group-name)]
830 ["Parameters " gnus-topic-edit-parameters
831 :included (gnus-topic-mode-p)]
688 ["Select method" gnus-group-edit-group-method 832 ["Select method" gnus-group-edit-group-method
689 (gnus-group-group-name)] 833 (gnus-group-group-name)]
690 ["Info" gnus-group-edit-group (gnus-group-group-name)] 834 ["Info" gnus-group-edit-group (gnus-group-group-name)]
691 ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] 835 ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
692 ["Global kill file" gnus-group-edit-global-kill t]))) 836 ["Global kill file" gnus-group-edit-global-kill t])))
713 ["Sort by method" gnus-group-sort-groups-by-method t] 857 ["Sort by method" gnus-group-sort-groups-by-method t]
714 ["Sort by rank" gnus-group-sort-groups-by-rank t] 858 ["Sort by rank" gnus-group-sort-groups-by-rank t]
715 ["Sort by score" gnus-group-sort-groups-by-score t] 859 ["Sort by score" gnus-group-sort-groups-by-score t]
716 ["Sort by level" gnus-group-sort-groups-by-level t] 860 ["Sort by level" gnus-group-sort-groups-by-level t]
717 ["Sort by unread" gnus-group-sort-groups-by-unread t] 861 ["Sort by unread" gnus-group-sort-groups-by-unread t]
718 ["Sort by name" gnus-group-sort-groups-by-alphabet t]) 862 ["Sort by name" gnus-group-sort-groups-by-alphabet t]
863 ["Sort by real name" gnus-group-sort-groups-by-real-name t])
719 ("Sort process/prefixed" 864 ("Sort process/prefixed"
720 ["Default sort" gnus-group-sort-selected-groups 865 ["Default sort" gnus-group-sort-selected-groups
721 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] 866 (not (gnus-topic-mode-p))]
722 ["Sort by method" gnus-group-sort-selected-groups-by-method 867 ["Sort by method" gnus-group-sort-selected-groups-by-method
723 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] 868 (not (gnus-topic-mode-p))]
724 ["Sort by rank" gnus-group-sort-selected-groups-by-rank 869 ["Sort by rank" gnus-group-sort-selected-groups-by-rank
725 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] 870 (not (gnus-topic-mode-p))]
726 ["Sort by score" gnus-group-sort-selected-groups-by-score 871 ["Sort by score" gnus-group-sort-selected-groups-by-score
727 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] 872 (not (gnus-topic-mode-p))]
728 ["Sort by level" gnus-group-sort-selected-groups-by-level 873 ["Sort by level" gnus-group-sort-selected-groups-by-level
729 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] 874 (not (gnus-topic-mode-p))]
730 ["Sort by unread" gnus-group-sort-selected-groups-by-unread 875 ["Sort by unread" gnus-group-sort-selected-groups-by-unread
731 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] 876 (not (gnus-topic-mode-p))]
732 ["Sort by name" gnus-group-sort-selected-groups-by-alphabet 877 ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
733 (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]) 878 (not (gnus-topic-mode-p))]
879 ["Sort by real name" gnus-group-sort-selected-groups-by-real-name
880 (not (gnus-topic-mode-p))])
734 ("Mark" 881 ("Mark"
735 ["Mark group" gnus-group-mark-group 882 ["Mark group" gnus-group-mark-group
736 (and (gnus-group-group-name) 883 (and (gnus-group-group-name)
737 (not (memq (gnus-group-group-name) gnus-group-marked)))] 884 (not (memq (gnus-group-group-name) gnus-group-marked)))]
738 ["Unmark group" gnus-group-unmark-group 885 ["Unmark group" gnus-group-unmark-group
739 (and (gnus-group-group-name) 886 (and (gnus-group-group-name)
740 (memq (gnus-group-group-name) gnus-group-marked))] 887 (memq (gnus-group-group-name) gnus-group-marked))]
741 ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] 888 ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
742 ["Mark regexp..." gnus-group-mark-regexp t] 889 ["Mark regexp..." gnus-group-mark-regexp t]
743 ["Mark region" gnus-group-mark-region t] 890 ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
744 ["Mark buffer" gnus-group-mark-buffer t] 891 ["Mark buffer" gnus-group-mark-buffer t]
745 ["Execute command" gnus-group-universal-argument 892 ["Execute command" gnus-group-universal-argument
746 (or gnus-group-marked (gnus-group-group-name))]) 893 (or gnus-group-marked (gnus-group-group-name))])
747 ("Subscribe" 894 ("Subscribe"
748 ["Subscribe to a group" gnus-group-unsubscribe-group t] 895 ["Subscribe to a group..." gnus-group-unsubscribe-group t]
749 ["Kill all newsgroups in region" gnus-group-kill-region t] 896 ["Kill all newsgroups in region" gnus-group-kill-region
897 :active (gnus-mark-active-p)]
750 ["Kill all zombie groups" gnus-group-kill-all-zombies 898 ["Kill all zombie groups" gnus-group-kill-all-zombies
751 gnus-zombie-list] 899 gnus-zombie-list]
752 ["Kill all groups on level..." gnus-group-kill-level t]) 900 ["Kill all groups on level..." gnus-group-kill-level t])
753 ("Foreign groups" 901 ("Foreign groups"
754 ["Make a foreign group" gnus-group-make-group t] 902 ["Make a foreign group..." gnus-group-make-group t]
755 ["Add a directory group" gnus-group-make-directory-group t] 903 ["Add a directory group..." gnus-group-make-directory-group t]
756 ["Add the help group" gnus-group-make-help-group t] 904 ["Add the help group" gnus-group-make-help-group t]
757 ["Add the archive group" gnus-group-make-archive-group t] 905 ["Add the archive group" gnus-group-make-archive-group t]
758 ["Make a doc group" gnus-group-make-doc-group t] 906 ["Make a doc group..." gnus-group-make-doc-group t]
759 ["Make a web group" gnus-group-make-web-group t] 907 ["Make a web group..." gnus-group-make-web-group t]
760 ["Make a kiboze group" gnus-group-make-kiboze-group t] 908 ["Make a kiboze group..." gnus-group-make-kiboze-group t]
761 ["Make a virtual group" gnus-group-make-empty-virtual t] 909 ["Make a virtual group..." gnus-group-make-empty-virtual t]
762 ["Add a group to a virtual" gnus-group-add-to-virtual t] 910 ["Add a group to a virtual..." gnus-group-add-to-virtual t]
763 ["Rename group" gnus-group-rename-group 911 ["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
912 ["Make an RSS group..." gnus-group-make-rss-group t]
913 ["Rename group..." gnus-group-rename-group
764 (gnus-check-backend-function 914 (gnus-check-backend-function
765 'request-rename-group (gnus-group-group-name))] 915 'request-rename-group (gnus-group-group-name))]
766 ["Delete group" gnus-group-delete-group 916 ["Delete group" gnus-group-delete-group
767 (gnus-check-backend-function 917 (gnus-check-backend-function
768 'request-delete-group (gnus-group-group-name))]) 918 'request-delete-group (gnus-group-group-name))])
772 ["Next unread" gnus-group-next-unread-group t] 922 ["Next unread" gnus-group-next-unread-group t]
773 ["Previous unread" gnus-group-prev-unread-group t] 923 ["Previous unread" gnus-group-prev-unread-group t]
774 ["Next unread same level" gnus-group-next-unread-group-same-level t] 924 ["Next unread same level" gnus-group-next-unread-group-same-level t]
775 ["Previous unread same level" 925 ["Previous unread same level"
776 gnus-group-prev-unread-group-same-level t] 926 gnus-group-prev-unread-group-same-level t]
777 ["Jump to group" gnus-group-jump-to-group t] 927 ["Jump to group..." gnus-group-jump-to-group t]
778 ["First unread group" gnus-group-first-unread-group t] 928 ["First unread group" gnus-group-first-unread-group t]
779 ["Best unread group" gnus-group-best-unread-group t]) 929 ["Best unread group" gnus-group-best-unread-group t])
930 ("Sieve"
931 ["Generate" gnus-sieve-generate t]
932 ["Generate and update" gnus-sieve-update t])
780 ["Delete bogus groups" gnus-group-check-bogus-groups t] 933 ["Delete bogus groups" gnus-group-check-bogus-groups t]
781 ["Find new newsgroups" gnus-group-find-new-groups t] 934 ["Find new newsgroups" gnus-group-find-new-groups t]
782 ["Transpose" gnus-group-transpose-groups 935 ["Transpose" gnus-group-transpose-groups
783 (gnus-group-group-name)] 936 (gnus-group-group-name)]
784 ["Read a directory as a group..." gnus-group-enter-directory t])) 937 ["Read a directory as a group..." gnus-group-enter-directory t]))
785 938
786 (easy-menu-define 939 (easy-menu-define
787 gnus-group-misc-menu gnus-group-mode-map "" 940 gnus-group-misc-menu gnus-group-mode-map ""
788 '("Misc" 941 `("Gnus"
789 ("SOUP" 942 ("SOUP"
790 ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] 943 ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
791 ["Send replies" gnus-soup-send-replies 944 ["Send replies" gnus-soup-send-replies
792 (fboundp 'gnus-soup-pack-packet)] 945 (fboundp 'gnus-soup-pack-packet)]
793 ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] 946 ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
794 ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] 947 ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
795 ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)]) 948 ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
796 ["Send a mail" gnus-group-mail t] 949 ["Send a mail" gnus-group-mail t]
797 ["Post an article..." gnus-group-post-news t] 950 ["Send a message (mail or news)" gnus-group-post-news t]
951 ["Create a local message" gnus-group-news t]
798 ["Check for new news" gnus-group-get-new-news 952 ["Check for new news" gnus-group-get-new-news
799 :help "Get newly arrived articles"] 953 ,@(if (featurep 'xemacs) '(t)
954 '(:help "Get newly arrived articles"))
955 ]
956 ["Send queued messages" gnus-delay-send-queue
957 ,@(if (featurep 'xemacs) '(t)
958 '(:help "Send all messages that are scheduled to be sent now"))
959 ]
800 ["Activate all groups" gnus-activate-all-groups t] 960 ["Activate all groups" gnus-activate-all-groups t]
801 ["Restart Gnus" gnus-group-restart t] 961 ["Restart Gnus" gnus-group-restart t]
802 ["Read init file" gnus-group-read-init-file t] 962 ["Read init file" gnus-group-read-init-file t]
803 ["Browse foreign server" gnus-group-browse-foreign-server t] 963 ["Browse foreign server..." gnus-group-browse-foreign-server t]
804 ["Enter server buffer" gnus-group-enter-server-mode t] 964 ["Enter server buffer" gnus-group-enter-server-mode t]
805 ["Expire all expirable articles" gnus-group-expire-all-groups t] 965 ["Expire all expirable articles" gnus-group-expire-all-groups t]
806 ["Generate any kiboze groups" nnkiboze-generate-groups t] 966 ["Generate any kiboze groups" nnkiboze-generate-groups t]
807 ["Gnus version" gnus-version t] 967 ["Gnus version" gnus-version t]
808 ["Save .newsrc files" gnus-group-save-newsrc t] 968 ["Save .newsrc files" gnus-group-save-newsrc t]
811 ["Read manual" gnus-info-find-node t] 971 ["Read manual" gnus-info-find-node t]
812 ["Flush score cache" gnus-score-flush-cache t] 972 ["Flush score cache" gnus-score-flush-cache t]
813 ["Toggle topics" gnus-topic-mode t] 973 ["Toggle topics" gnus-topic-mode t]
814 ["Send a bug report" gnus-bug t] 974 ["Send a bug report" gnus-bug t]
815 ["Exit from Gnus" gnus-group-exit 975 ["Exit from Gnus" gnus-group-exit
816 :help "Quit reading news"] 976 ,@(if (featurep 'xemacs) '(t)
977 '(:help "Quit reading news"))]
817 ["Exit without saving" gnus-group-quit t])) 978 ["Exit without saving" gnus-group-quit t]))
818 979
819 (gnus-run-hooks 'gnus-group-menu-hook))) 980 (gnus-run-hooks 'gnus-group-menu-hook)))
820 981
821 (defvar gnus-group-toolbar-map nil) 982 (defvar gnus-group-toolbar-map nil)
826 (condition-case nil (require 'tool-bar) (error nil)) 987 (condition-case nil (require 'tool-bar) (error nil))
827 (fboundp 'tool-bar-add-item-from-menu) 988 (fboundp 'tool-bar-add-item-from-menu)
828 (default-value 'tool-bar-mode) 989 (default-value 'tool-bar-mode)
829 (not gnus-group-toolbar-map)) 990 (not gnus-group-toolbar-map))
830 (setq gnus-group-toolbar-map 991 (setq gnus-group-toolbar-map
831 (let ((tool-bar-map (make-sparse-keymap))) 992 (let ((tool-bar-map (make-sparse-keymap))
993 (load-path (mm-image-load-path)))
832 (tool-bar-add-item-from-menu 994 (tool-bar-add-item-from-menu
833 'gnus-group-get-new-news "get-news" gnus-group-mode-map) 995 'gnus-group-get-new-news "get-news" gnus-group-mode-map)
834 (tool-bar-add-item-from-menu 996 (tool-bar-add-item-from-menu
835 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map) 997 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map)
836 (tool-bar-add-item-from-menu 998 (tool-bar-add-item-from-menu
884 (gnus-update-group-mark-positions) 1046 (gnus-update-group-mark-positions)
885 (when gnus-use-undo 1047 (when gnus-use-undo
886 (gnus-undo-mode 1)) 1048 (gnus-undo-mode 1))
887 (when gnus-slave 1049 (when gnus-slave
888 (gnus-slave-mode)) 1050 (gnus-slave-mode))
889 (gnus-run-hooks 'gnus-group-mode-hook)) 1051 (gnus-run-mode-hooks 'gnus-group-mode-hook))
890 1052
891 (defun gnus-update-group-mark-positions () 1053 (defun gnus-update-group-mark-positions ()
892 (save-excursion 1054 (save-excursion
893 (let ((gnus-process-mark ?\200) 1055 (let ((gnus-process-mark ?\200)
1056 (gnus-group-update-hook nil)
894 (gnus-group-marked '("dummy.group")) 1057 (gnus-group-marked '("dummy.group"))
895 (gnus-active-hashtb (make-vector 10 0)) 1058 (gnus-active-hashtb (make-vector 10 0))
896 (topic "")) 1059 (topic ""))
897 (gnus-set-active "dummy.group" '(0 . 0)) 1060 (gnus-set-active "dummy.group" '(0 . 0))
898 (gnus-set-work-buffer) 1061 (gnus-set-work-buffer)
899 (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) 1062 (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
900 (goto-char (point-min)) 1063 (goto-char (point-min))
901 (setq gnus-group-mark-positions 1064 (setq gnus-group-mark-positions
902 (list (cons 'process (and (search-forward "\200" nil t) 1065 (list (cons 'process (and (search-forward
1066 (mm-string-as-multibyte "\200") nil t)
903 (- (point) 2)))))))) 1067 (- (point) 2))))))))
904 1068
905 (defun gnus-mouse-pick-group (e) 1069 (defun gnus-mouse-pick-group (e)
906 "Enter the group under the mouse pointer." 1070 "Enter the group under the mouse pointer."
907 (interactive "e") 1071 (interactive "e")
930 (unless (eq major-mode 'gnus-group-mode) 1094 (unless (eq major-mode 'gnus-group-mode)
931 (gnus-group-mode) 1095 (gnus-group-mode)
932 (when gnus-carpal 1096 (when gnus-carpal
933 (gnus-carpal-setup-buffer 'group)))) 1097 (gnus-carpal-setup-buffer 'group))))
934 1098
935 (defsubst gnus-group-name-charset (method group) 1099 (defun gnus-group-name-charset (method group)
936 (if (null method) 1100 (if (null method)
937 (setq method (gnus-find-method-for-group group))) 1101 (setq method (gnus-find-method-for-group group)))
938 (let ((item (assoc method gnus-group-name-charset-method-alist)) 1102 (let ((item (assoc method gnus-group-name-charset-method-alist))
939 (alist gnus-group-name-charset-group-alist) 1103 (alist gnus-group-name-charset-group-alist)
940 result) 1104 result)
944 (if (string-match (car item) group) 1108 (if (string-match (car item) group)
945 (setq alist nil 1109 (setq alist nil
946 result (cdr item)))) 1110 result (cdr item))))
947 result))) 1111 result)))
948 1112
949 (defsubst gnus-group-name-decode (string charset) 1113 (defun gnus-group-name-decode (string charset)
1114 ;; Fixme: Don't decode in unibyte mode.
950 (if (and string charset (featurep 'mule)) 1115 (if (and string charset (featurep 'mule))
951 (mm-decode-coding-string string charset) 1116 (mm-decode-coding-string string charset)
952 string)) 1117 string))
953 1118
954 (defun gnus-group-decoded-name (string) 1119 (defun gnus-group-decoded-name (string)
1026 "List groups on LEVEL. 1191 "List groups on LEVEL.
1027 If ALL (the prefix), also list groups that have no unread articles." 1192 If ALL (the prefix), also list groups that have no unread articles."
1028 (interactive "nList groups on level: \nP") 1193 (interactive "nList groups on level: \nP")
1029 (gnus-group-list-groups level all level)) 1194 (gnus-group-list-groups level all level))
1030 1195
1031 (defun gnus-group-prepare-flat (level &optional all lowest regexp) 1196 (defun gnus-group-prepare-logic (group test)
1197 (or (and gnus-group-listed-groups
1198 (null gnus-group-list-option)
1199 (member group gnus-group-listed-groups))
1200 (cond
1201 ((null gnus-group-listed-groups) test)
1202 ((null gnus-group-list-option) test)
1203 (t (and (member group gnus-group-listed-groups)
1204 (if (eq gnus-group-list-option 'flush)
1205 (not test)
1206 test))))))
1207
1208 (defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
1032 "List all newsgroups with unread articles of level LEVEL or lower. 1209 "List all newsgroups with unread articles of level LEVEL or lower.
1033 If ALL is non-nil, list groups that have no unread articles. 1210 If PREDICATE is a function, list groups that the function returns non-nil;
1211 if it is t, list groups that have no unread articles.
1034 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. 1212 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
1035 If REGEXP, only list groups matching REGEXP." 1213 If REGEXP is a function, list dead groups that the function returns non-nil;
1214 if it is a string, only list groups matching REGEXP."
1036 (set-buffer gnus-group-buffer) 1215 (set-buffer gnus-group-buffer)
1037 (let ((buffer-read-only nil) 1216 (let ((buffer-read-only nil)
1038 (newsrc (cdr gnus-newsrc-alist)) 1217 (newsrc (cdr gnus-newsrc-alist))
1039 (lowest (or lowest 1)) 1218 (lowest (or lowest 1))
1219 (not-in-list (and gnus-group-listed-groups
1220 (copy-sequence gnus-group-listed-groups)))
1040 info clevel unread group params) 1221 info clevel unread group params)
1041 (erase-buffer) 1222 (erase-buffer)
1042 (when (< lowest gnus-level-zombie) 1223 (when (or (< lowest gnus-level-zombie)
1224 gnus-group-listed-groups)
1043 ;; List living groups. 1225 ;; List living groups.
1044 (while newsrc 1226 (while newsrc
1045 (setq info (car newsrc) 1227 (setq info (car newsrc)
1046 group (gnus-info-group info) 1228 group (gnus-info-group info)
1047 params (gnus-info-params info) 1229 params (gnus-info-params info)
1048 newsrc (cdr newsrc) 1230 newsrc (cdr newsrc)
1049 unread (car (gnus-gethash group gnus-newsrc-hashtb))) 1231 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
1050 (and unread ; This group might be unchecked 1232 (when not-in-list
1051 (or (not regexp) 1233 (setq not-in-list (delete group not-in-list)))
1052 (string-match regexp group)) 1234 (when (gnus-group-prepare-logic
1053 (<= (setq clevel (gnus-info-level info)) level) 1235 group
1054 (>= clevel lowest) 1236 (and unread ; This group might be unchecked
1055 (or all ; We list all groups? 1237 (or (not (stringp regexp))
1056 (if (eq unread t) ; Unactivated? 1238 (string-match regexp group))
1057 gnus-group-list-inactive-groups ; We list unactivated 1239 (<= (setq clevel (gnus-info-level info)) level)
1058 (> unread 0)) ; We list groups with unread articles 1240 (>= clevel lowest)
1059 (and gnus-list-groups-with-ticked-articles 1241 (cond
1060 (cdr (assq 'tick (gnus-info-marks info)))) 1242 ((functionp predicate)
1243 (funcall predicate info))
1244 (predicate t) ; We list all groups?
1245 (t
1246 (or
1247 (if (eq unread t) ; Unactivated?
1248 gnus-group-list-inactive-groups
1249 ; We list unactivated
1250 (> unread 0))
1251 ; We list groups with unread articles
1252 (and gnus-list-groups-with-ticked-articles
1253 (cdr (assq 'tick (gnus-info-marks info))))
1061 ; And groups with tickeds 1254 ; And groups with tickeds
1062 ;; Check for permanent visibility. 1255 ;; Check for permanent visibility.
1063 (and gnus-permanently-visible-groups 1256 (and gnus-permanently-visible-groups
1064 (string-match gnus-permanently-visible-groups 1257 (string-match gnus-permanently-visible-groups
1065 group)) 1258 group))
1066 (memq 'visible params) 1259 (memq 'visible params)
1067 (cdr (assq 'visible params))) 1260 (cdr (assq 'visible params)))))))
1068 (gnus-group-insert-group-line 1261 (gnus-group-insert-group-line
1069 group (gnus-info-level info) 1262 group (gnus-info-level info)
1070 (gnus-info-marks info) unread (gnus-info-method info))))) 1263 (gnus-info-marks info) unread (gnus-info-method info)))))
1071 1264
1072 ;; List dead groups. 1265 ;; List dead groups.
1073 (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) 1266 (when (or gnus-group-listed-groups
1074 (gnus-group-prepare-flat-list-dead 1267 (and (>= level gnus-level-zombie)
1075 (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 1268 (<= lowest gnus-level-zombie)))
1076 gnus-level-zombie ?Z 1269 (gnus-group-prepare-flat-list-dead
1077 regexp)) 1270 (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
1078 (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) 1271 gnus-level-zombie ?Z
1079 (gnus-group-prepare-flat-list-dead 1272 regexp))
1080 (setq gnus-killed-list (sort gnus-killed-list 'string<)) 1273 (when not-in-list
1081 gnus-level-killed ?K regexp)) 1274 (dolist (group gnus-zombie-list)
1275 (setq not-in-list (delete group not-in-list))))
1276 (when (or gnus-group-listed-groups
1277 (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
1278 (gnus-group-prepare-flat-list-dead
1279 (gnus-union
1280 not-in-list
1281 (setq gnus-killed-list (sort gnus-killed-list 'string<)))
1282 gnus-level-killed ?K regexp))
1082 1283
1083 (gnus-group-set-mode-line) 1284 (gnus-group-set-mode-line)
1084 (setq gnus-group-list-mode (cons level all)) 1285 (setq gnus-group-list-mode (cons level predicate))
1085 (gnus-run-hooks 'gnus-group-prepare-hook) 1286 (gnus-run-hooks 'gnus-group-prepare-hook)
1086 t)) 1287 t))
1087 1288
1088 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) 1289 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
1089 ;; List zombies and killed lists somewhat faster, which was 1290 ;; List zombies and killed lists somewhat faster, which was
1090 ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does 1291 ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
1091 ;; this by ignoring the group format specification altogether. 1292 ;; this by ignoring the group format specification altogether.
1092 (let (group) 1293 (let (group)
1093 (if regexp 1294 (if (> (length groups) gnus-group-listing-limit)
1094 ;; This loop is used when listing groups that match some
1095 ;; regexp.
1096 (while groups 1295 (while groups
1097 (setq group (pop groups)) 1296 (setq group (pop groups))
1098 (when (string-match regexp group) 1297 (when (gnus-group-prepare-logic
1298 group
1299 (or (not regexp)
1300 (and (stringp regexp) (string-match regexp group))
1301 (and (functionp regexp) (funcall regexp group))))
1099 (gnus-add-text-properties 1302 (gnus-add-text-properties
1100 (point) (prog1 (1+ (point)) 1303 (point) (prog1 (1+ (point))
1101 (insert " " mark " *: " 1304 (insert " " mark " *: "
1102 (gnus-group-name-decode group 1305 (gnus-group-decoded-name group)
1103 (gnus-group-name-charset
1104 nil group))
1105 "\n")) 1306 "\n"))
1106 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 1307 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
1107 'gnus-unread t 1308 'gnus-unread t
1108 'gnus-level level)))) 1309 'gnus-level level))))
1109 ;; This loop is used when listing all groups.
1110 (while groups 1310 (while groups
1111 (setq group (pop groups)) 1311 (setq group (pop groups))
1112 (gnus-add-text-properties 1312 (when (gnus-group-prepare-logic
1113 (point) (prog1 (1+ (point)) 1313 group
1114 (insert " " mark " *: " 1314 (or (not regexp)
1115 (gnus-group-name-decode group 1315 (and (stringp regexp) (string-match regexp group))
1116 (gnus-group-name-charset 1316 (and (functionp regexp) (funcall regexp group))))
1117 nil group)) 1317 (gnus-group-insert-group-line
1118 "\n")) 1318 group level nil
1119 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 1319 (let ((active (gnus-active group)))
1120 'gnus-unread t 1320 (if active
1121 'gnus-level level)))))) 1321 (if (zerop (cdr active))
1322 0
1323 (- (1+ (cdr active)) (car active)))
1324 nil))
1325 (gnus-method-simplify (gnus-find-method-for-group group))))))))
1122 1326
1123 (defun gnus-group-update-group-line () 1327 (defun gnus-group-update-group-line ()
1124 "Update the current line in the group buffer." 1328 "Update the current line in the group buffer."
1125 (let* ((buffer-read-only nil) 1329 (let* ((buffer-read-only nil)
1126 (group (gnus-group-group-name)) 1330 (group (gnus-group-group-name))
1159 (if (setq active (gnus-active group)) 1363 (if (setq active (gnus-active group))
1160 (if (zerop (cdr active)) 1364 (if (zerop (cdr active))
1161 0 1365 0
1162 (- (1+ (cdr active)) (car active))) 1366 (- (1+ (cdr active)) (car active)))
1163 nil) 1367 nil)
1164 nil)))) 1368 (gnus-method-simplify (gnus-find-method-for-group group))))))
1369
1370 (defun gnus-number-of-unseen-articles-in-group (group)
1371 (let* ((info (nth 2 (gnus-group-entry group)))
1372 (marked (gnus-info-marks info))
1373 (seen (cdr (assq 'seen marked)))
1374 (active (gnus-active group)))
1375 (if (not active)
1376 0
1377 (length (gnus-uncompress-range
1378 (gnus-range-difference
1379 (gnus-range-difference (list active) (gnus-info-read info))
1380 seen))))))
1165 1381
1166 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level 1382 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
1167 gnus-tmp-marked number 1383 gnus-tmp-marked number
1168 gnus-tmp-method) 1384 gnus-tmp-method)
1169 "Insert a group line in the group buffer." 1385 "Insert a group line in the group buffer."
1189 ((= gnus-tmp-level gnus-level-zombie) ?Z) 1405 ((= gnus-tmp-level gnus-level-zombie) ?Z)
1190 (t ?K))) 1406 (t ?K)))
1191 (gnus-tmp-qualified-group 1407 (gnus-tmp-qualified-group
1192 (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) 1408 (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
1193 group-name-charset)) 1409 group-name-charset))
1410 (gnus-tmp-comment
1411 (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
1412 gnus-tmp-group))
1194 (gnus-tmp-newsgroup-description 1413 (gnus-tmp-newsgroup-description
1195 (if gnus-description-hashtb 1414 (if gnus-description-hashtb
1196 (or (gnus-group-name-decode 1415 (or (gnus-group-name-decode
1197 (gnus-gethash gnus-tmp-group gnus-description-hashtb) 1416 (gnus-gethash gnus-tmp-group gnus-description-hashtb)
1198 group-name-charset) "") 1417 group-name-charset) "")
1213 (gnus-tmp-marked-mark 1432 (gnus-tmp-marked-mark
1214 (if (and (numberp number) 1433 (if (and (numberp number)
1215 (zerop number) 1434 (zerop number)
1216 (cdr (assq 'tick gnus-tmp-marked))) 1435 (cdr (assq 'tick gnus-tmp-marked)))
1217 ?* ? )) 1436 ?* ? ))
1437 (gnus-tmp-summary-live
1438 (if (and (not gnus-group-is-exiting-p)
1439 (gnus-buffer-live-p (gnus-summary-buffer-name
1440 gnus-tmp-group)))
1441 ?* ? ))
1218 (gnus-tmp-process-marked 1442 (gnus-tmp-process-marked
1219 (if (member gnus-tmp-group gnus-group-marked) 1443 (if (member gnus-tmp-group gnus-group-marked)
1220 gnus-process-mark ? )) 1444 gnus-process-mark ? ))
1221 (gnus-tmp-grouplens 1445 (gnus-tmp-grouplens
1222 (or (and gnus-use-grouplens 1446 (or (and gnus-use-grouplens
1227 (beginning-of-line) 1451 (beginning-of-line)
1228 (gnus-add-text-properties 1452 (gnus-add-text-properties
1229 (point) 1453 (point)
1230 (prog1 (1+ (point)) 1454 (prog1 (1+ (point))
1231 ;; Insert the text. 1455 ;; Insert the text.
1232 (eval gnus-group-line-format-spec)) 1456 (let ((gnus-tmp-decoded-group (gnus-group-name-decode
1457 gnus-tmp-group group-name-charset)))
1458 (eval gnus-group-line-format-spec)))
1233 `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) 1459 `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
1234 gnus-unread ,(if (numberp number) 1460 gnus-unread ,(if (numberp number)
1235 (string-to-int gnus-tmp-number-of-unread) 1461 (string-to-number gnus-tmp-number-of-unread)
1236 t) 1462 t)
1237 gnus-marked ,gnus-tmp-marked-mark 1463 gnus-marked ,gnus-tmp-marked-mark
1238 gnus-indentation ,gnus-group-indentation 1464 gnus-indentation ,gnus-group-indentation
1239 gnus-level ,gnus-tmp-level)) 1465 gnus-level ,gnus-tmp-level))
1240 (forward-line -1) 1466 (forward-line -1)
1246 1472
1247 (defun gnus-group-highlight-line () 1473 (defun gnus-group-highlight-line ()
1248 "Highlight the current line according to `gnus-group-highlight'." 1474 "Highlight the current line according to `gnus-group-highlight'."
1249 (let* ((list gnus-group-highlight) 1475 (let* ((list gnus-group-highlight)
1250 (p (point)) 1476 (p (point))
1251 (end (progn (end-of-line) (point))) 1477 (end (gnus-point-at-eol))
1252 ;; now find out where the line starts and leave point there. 1478 ;; now find out where the line starts and leave point there.
1253 (beg (progn (beginning-of-line) (point))) 1479 (beg (progn (beginning-of-line) (point)))
1254 (group (gnus-group-group-name)) 1480 (group (gnus-group-group-name))
1255 (entry (gnus-group-entry group)) 1481 (entry (gnus-group-entry group))
1256 (unread (if (numberp (car entry)) (car entry) 0)) 1482 (unread (if (numberp (car entry)) (car entry) 0))
1257 (active (gnus-active group)) 1483 (active (gnus-active group))
1258 (total (if active (1+ (- (cdr active) (car active))) 0)) 1484 (total (if active (1+ (- (cdr active) (car active))) 0))
1259 (info (nth 2 entry)) 1485 (info (nth 2 entry))
1260 (method (gnus-server-get-method group (gnus-info-method info))) 1486 (method (inline (gnus-server-get-method group (gnus-info-method info))))
1261 (marked (gnus-info-marks info)) 1487 (marked (gnus-info-marks info))
1262 (mailp (memq 'mail (assoc (symbol-name 1488 (mailp (apply 'append
1263 (car (or method gnus-select-method))) 1489 (mapcar
1264 gnus-valid-select-methods))) 1490 (lambda (x)
1491 (memq x (assoc (symbol-name
1492 (car (or method gnus-select-method)))
1493 gnus-valid-select-methods)))
1494 '(mail post-mail))))
1265 (level (or (gnus-info-level info) gnus-level-killed)) 1495 (level (or (gnus-info-level info) gnus-level-killed))
1266 (score (or (gnus-info-score info) 0)) 1496 (score (or (gnus-info-score info) 0))
1267 (ticked (gnus-range-length (cdr (assq 'tick marked)))) 1497 (ticked (gnus-range-length (cdr (assq 'tick marked))))
1268 (group-age (gnus-group-timestamp-delta group)) 1498 (group-age (gnus-group-timestamp-delta group))
1269 (inhibit-read-only t)) 1499 (inhibit-read-only t))
1524 (defun gnus-group-mark-regexp (regexp) 1754 (defun gnus-group-mark-regexp (regexp)
1525 "Mark all groups that match some regexp." 1755 "Mark all groups that match some regexp."
1526 (interactive "sMark (regexp): ") 1756 (interactive "sMark (regexp): ")
1527 (let ((alist (cdr gnus-newsrc-alist)) 1757 (let ((alist (cdr gnus-newsrc-alist))
1528 group) 1758 group)
1529 (while alist 1759 (save-excursion
1530 (when (string-match regexp (setq group (gnus-info-group (pop alist)))) 1760 (while alist
1531 (gnus-group-set-mark group)))) 1761 (when (string-match regexp (setq group (gnus-info-group (pop alist))))
1762 (gnus-group-jump-to-group group)
1763 (gnus-group-set-mark group)))))
1532 (gnus-group-position-point)) 1764 (gnus-group-position-point))
1533 1765
1534 (defun gnus-group-remove-mark (group &optional test-marked) 1766 (defun gnus-group-remove-mark (group &optional test-marked)
1535 "Remove the process mark from GROUP and move point there. 1767 "Remove the process mark from GROUP and move point there.
1536 Return nil if the group isn't displayed." 1768 Return nil if the group isn't displayed."
1580 (if (setq group (gnus-group-group-name)) 1812 (if (setq group (gnus-group-group-name))
1581 (push group groups)) 1813 (push group groups))
1582 (setq n (1- n)) 1814 (setq n (1- n))
1583 (gnus-group-next-group way))) 1815 (gnus-group-next-group way)))
1584 (nreverse groups))) 1816 (nreverse groups)))
1585 ((gnus-region-active-p) 1817 ((and (gnus-region-active-p) (mark))
1586 ;; Work on the region between point and mark. 1818 ;; Work on the region between point and mark.
1587 (let ((max (max (point) (mark))) 1819 (let ((max (max (point) (mark)))
1588 groups) 1820 groups)
1589 (save-excursion 1821 (save-excursion
1590 (goto-char (min (point) (mark))) 1822 (goto-char (min (point) (mark)))
1665 no-article nil no-display nil select-articles))) 1897 no-article nil no-display nil select-articles)))
1666 1898
1667 (defun gnus-group-select-group (&optional all) 1899 (defun gnus-group-select-group (&optional all)
1668 "Select this newsgroup. 1900 "Select this newsgroup.
1669 No article is selected automatically. 1901 No article is selected automatically.
1902 If the group is opened, just switch the summary buffer.
1670 If ALL is non-nil, already read articles become readable. 1903 If ALL is non-nil, already read articles become readable.
1671 If ALL is a number, fetch this number of articles." 1904 If ALL is a number, fetch this number of articles."
1672 (interactive "P") 1905 (interactive "P")
1906 (when (and (eobp) (not (gnus-group-group-name)))
1907 (forward-line -1))
1673 (gnus-group-read-group all t)) 1908 (gnus-group-read-group all t))
1674 1909
1675 (defun gnus-group-quick-select-group (&optional all) 1910 (defun gnus-group-quick-select-group (&optional all)
1676 "Select the current group \"quickly\". 1911 "Select the current group \"quickly\".
1677 This means that no highlighting or scoring will be performed. 1912 This means that no highlighting or scoring will be performed.
1710 (method (gnus-find-method-for-group group))) 1945 (method (gnus-find-method-for-group group)))
1711 (gnus-group-read-ephemeral-group 1946 (gnus-group-read-ephemeral-group
1712 (gnus-group-prefixed-name group method) method))) 1947 (gnus-group-prefixed-name group method) method)))
1713 1948
1714 ;;;###autoload 1949 ;;;###autoload
1715 (defun gnus-fetch-group (group) 1950 (defun gnus-fetch-group (group &optional articles)
1716 "Start Gnus if necessary and enter GROUP. 1951 "Start Gnus if necessary and enter GROUP.
1717 Returns whether the fetching was successful or not." 1952 Returns whether the fetching was successful or not."
1718 (interactive (list (completing-read "Group name: " gnus-active-hashtb))) 1953 (interactive (list (completing-read "Group name: " gnus-active-hashtb)))
1719 (unless (get-buffer gnus-group-buffer) 1954 (unless (get-buffer gnus-group-buffer)
1720 (gnus-no-server)) 1955 (gnus-no-server))
1721 (gnus-group-read-group nil nil group)) 1956 (gnus-group-read-group articles nil group))
1722 1957
1723 ;;;###autoload 1958 ;;;###autoload
1724 (defun gnus-fetch-group-other-frame (group) 1959 (defun gnus-fetch-group-other-frame (group)
1725 "Pop up a frame and enter GROUP." 1960 "Pop up a frame and enter GROUP."
1726 (interactive "P") 1961 (interactive "P")
1733 (other-frame 1)))) 1968 (other-frame 1))))
1734 (gnus-fetch-group group)) 1969 (gnus-fetch-group group))
1735 1970
1736 (defvar gnus-ephemeral-group-server 0) 1971 (defvar gnus-ephemeral-group-server 0)
1737 1972
1973 (defcustom gnus-large-ephemeral-newsgroup 200
1974 "The number of articles which indicates a large ephemeral newsgroup.
1975 Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups.
1976
1977 If the number of articles in a newsgroup is greater than this value,
1978 confirmation is required for selecting the newsgroup. If it is nil, no
1979 confirmation is required."
1980 :version "22.1"
1981 :group 'gnus-group-select
1982 :type '(choice (const :tag "No limit" nil)
1983 integer))
1984
1985 (defcustom gnus-fetch-old-ephemeral-headers nil
1986 "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups."
1987 :version "22.1"
1988 :group 'gnus-thread
1989 :type '(choice (const :tag "off" nil)
1990 (const some)
1991 number
1992 (sexp :menu-tag "other" t)))
1993
1738 ;; Enter a group that is not in the group buffer. Non-nil is returned 1994 ;; Enter a group that is not in the group buffer. Non-nil is returned
1739 ;; if selection was successful. 1995 ;; if selection was successful.
1740 (defun gnus-group-read-ephemeral-group (group method &optional activate 1996 (defun gnus-group-read-ephemeral-group (group method &optional activate
1741 quit-config request-only 1997 quit-config request-only
1742 select-articles) 1998 select-articles
1999 parameters
2000 number)
1743 "Read GROUP from METHOD as an ephemeral group. 2001 "Read GROUP from METHOD as an ephemeral group.
1744 If ACTIVATE, request the group first. 2002 If ACTIVATE, request the group first.
1745 If QUIT-CONFIG, use that window configuration when exiting from the 2003 If QUIT-CONFIG, use that window configuration when exiting from the
1746 ephemeral group. 2004 ephemeral group.
1747 If REQUEST-ONLY, don't actually read the group; just request it. 2005 If REQUEST-ONLY, don't actually read the group; just request it.
1748 If SELECT-ARTICLES, only select those articles. 2006 If SELECT-ARTICLES, only select those articles.
2007 If PARAMETERS, use those as the group parameters.
2008 If NUMBER, fetch this number of articles.
1749 2009
1750 Return the name of the group if selection was successful." 2010 Return the name of the group if selection was successful."
2011 (interactive
2012 (list
2013 ;; (gnus-read-group "Group name: ")
2014 (completing-read
2015 "Group: " gnus-active-hashtb
2016 nil nil nil
2017 'gnus-group-history)
2018 (gnus-read-method "From method: ")))
1751 ;; Transform the select method into a unique server. 2019 ;; Transform the select method into a unique server.
1752 (when (stringp method) 2020 (when (stringp method)
1753 (setq method (gnus-server-to-method method))) 2021 (setq method (gnus-server-to-method method)))
1754 (setq method 2022 (setq method
1755 `(,(car method) ,(concat (cadr method) "-ephemeral") 2023 `(,(car method) ,(concat (cadr method) "-ephemeral")
1756 (,(intern (format "%s-address" (car method))) ,(cadr method)) 2024 (,(intern (format "%s-address" (car method))) ,(cadr method))
1757 ,@(cddr method))) 2025 ,@(cddr method)))
1758 (let ((group (if (gnus-group-foreign-p group) group 2026 (let ((group (if (gnus-group-foreign-p group) group
1759 (gnus-group-prefixed-name group method)))) 2027 (gnus-group-prefixed-name (gnus-group-real-name group)
2028 method))))
1760 (gnus-sethash 2029 (gnus-sethash
1761 group 2030 group
1762 `(-1 nil (,group 2031 `(-1 nil (,group
1763 ,gnus-level-default-subscribed nil nil ,method 2032 ,gnus-level-default-subscribed nil nil ,method
1764 ((quit-config . 2033 ,(cons
1765 ,(if quit-config quit-config 2034 (if quit-config
1766 (cons gnus-summary-buffer 2035 (cons 'quit-config quit-config)
1767 gnus-current-window-configuration)))))) 2036 (cons 'quit-config
2037 (cons gnus-summary-buffer
2038 gnus-current-window-configuration)))
2039 parameters)))
1768 gnus-newsrc-hashtb) 2040 gnus-newsrc-hashtb)
1769 (push method gnus-ephemeral-servers) 2041 (push method gnus-ephemeral-servers)
1770 (set-buffer gnus-group-buffer) 2042 (set-buffer gnus-group-buffer)
1771 (unless (gnus-check-server method) 2043 (unless (gnus-check-server method)
1772 (error "Unable to contact server: %s" (gnus-status-message method))) 2044 (error "Unable to contact server: %s" (gnus-status-message method)))
1776 (error "Couldn't request group: %s" 2048 (error "Couldn't request group: %s"
1777 (nnheader-get-report (car method))))) 2049 (nnheader-get-report (car method)))))
1778 (if request-only 2050 (if request-only
1779 group 2051 group
1780 (condition-case () 2052 (condition-case ()
1781 (when (gnus-group-read-group t t group select-articles) 2053 (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup)
2054 (gnus-fetch-old-headers
2055 gnus-fetch-old-ephemeral-headers))
2056 (gnus-group-read-group (or number t) t group select-articles))
1782 group) 2057 group)
1783 ;;(error nil) 2058 ;;(error nil)
1784 (quit 2059 (quit
1785 (message "Quit reading the ephemeral group") 2060 (message "Quit reading the ephemeral group")
1786 nil))))) 2061 nil)))))
1787 2062
1788 (defun gnus-group-jump-to-group (group) 2063 (defun gnus-group-jump-to-group (group)
1789 "Jump to newsgroup GROUP." 2064 "Jump to newsgroup GROUP."
1790 (interactive 2065 (interactive
1791 (list (completing-read 2066 (list (mm-string-make-unibyte
1792 "Group: " gnus-active-hashtb nil 2067 (completing-read
1793 (gnus-read-active-file-p) 2068 "Group: " gnus-active-hashtb nil
1794 nil 2069 (gnus-read-active-file-p)
1795 'gnus-group-history))) 2070 gnus-group-jump-to-group-prompt
2071 'gnus-group-history))))
1796 2072
1797 (when (equal group "") 2073 (when (equal group "")
1798 (error "Empty group name")) 2074 (error "Empty group name"))
1799 2075
1800 (unless (gnus-ephemeral-group-p group) 2076 (unless (gnus-ephemeral-group-p group)
1935 (setq best (get-text-property (point) 'gnus-level)) 2211 (setq best (get-text-property (point) 'gnus-level))
1936 (setq best-point (point)))) 2212 (setq best-point (point))))
1937 (forward-line 1)) 2213 (forward-line 1))
1938 (when best-point 2214 (when best-point
1939 (goto-char best-point)) 2215 (goto-char best-point))
1940 (gnus-summary-position-point) 2216 (gnus-group-position-point)
1941 (and best-point (gnus-group-group-name)))) 2217 (and best-point (gnus-group-group-name))))
1942 2218
1943 (defun gnus-group-first-unread-group () 2219 (defun gnus-group-first-unread-group ()
1944 "Go to the first group with unread articles." 2220 "Go to the first group with unread articles."
1945 (interactive) 2221 (interactive)
1978 (if address (list (intern method) address) 2254 (if address (list (intern method) address)
1979 method)))) 2255 method))))
1980 (nname (if method (gnus-group-prefixed-name name meth) name)) 2256 (nname (if method (gnus-group-prefixed-name name meth) name))
1981 backend info) 2257 backend info)
1982 (when (gnus-gethash nname gnus-newsrc-hashtb) 2258 (when (gnus-gethash nname gnus-newsrc-hashtb)
1983 (error "Group %s already exists" nname)) 2259 (error "Group %s already exists" (gnus-group-decoded-name nname)))
1984 ;; Subscribe to the new group. 2260 ;; Subscribe to the new group.
1985 (gnus-group-change-level 2261 (gnus-group-change-level
1986 (setq info (list t nname gnus-level-default-subscribed nil nil meth)) 2262 (setq info (list t nname gnus-level-default-subscribed nil nil meth))
1987 gnus-level-default-subscribed gnus-level-killed 2263 gnus-level-default-subscribed gnus-level-killed
1988 (and (gnus-group-group-name) 2264 (and (gnus-group-group-name)
1998 ;; Insert the line. 2274 ;; Insert the line.
1999 (gnus-group-insert-group-line-info nname) 2275 (gnus-group-insert-group-line-info nname)
2000 (forward-line -1) 2276 (forward-line -1)
2001 (gnus-group-position-point) 2277 (gnus-group-position-point)
2002 2278
2003 ;; Load the backend and try to make the backend create 2279 ;; Load the back end and try to make the back end create
2004 ;; the group as well. 2280 ;; the group as well.
2005 (when (assoc (symbol-name (setq backend (car (gnus-server-get-method 2281 (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
2006 nil meth)))) 2282 nil meth))))
2007 gnus-valid-select-methods) 2283 gnus-valid-select-methods)
2008 (require backend)) 2284 (require backend))
2009 (gnus-check-server meth) 2285 (gnus-check-server meth)
2010 (when (gnus-check-backend-function 'request-create-group nname) 2286 (when (gnus-check-backend-function 'request-create-group nname)
2011 (gnus-request-create-group nname nil args)) 2287 (unless (gnus-request-create-group nname nil args)
2288 (error "Could not create group on server: %s"
2289 (nnheader-get-report backend))))
2012 t)) 2290 t))
2013 2291
2014 (defun gnus-group-delete-groups (&optional arg) 2292 (defun gnus-group-delete-groups (&optional arg)
2015 "Delete the current group. Only meaningful with editable groups." 2293 "Delete the current group. Only meaningful with editable groups."
2016 (interactive "P") 2294 (interactive "P")
2026 (defun gnus-group-delete-group (group &optional force no-prompt) 2304 (defun gnus-group-delete-group (group &optional force no-prompt)
2027 "Delete the current group. Only meaningful with editable groups. 2305 "Delete the current group. Only meaningful with editable groups.
2028 If FORCE (the prefix) is non-nil, all the articles in the group will 2306 If FORCE (the prefix) is non-nil, all the articles in the group will
2029 be deleted. This is \"deleted\" as in \"removed forever from the face 2307 be deleted. This is \"deleted\" as in \"removed forever from the face
2030 of the Earth\". There is no undo. The user will be prompted before 2308 of the Earth\". There is no undo. The user will be prompted before
2031 doing the deletion." 2309 doing the deletion.
2310 Note that you also have to specify FORCE if you want the group to
2311 be removed from the server, even when it's empty."
2032 (interactive 2312 (interactive
2033 (list (gnus-group-group-name) 2313 (list (gnus-group-group-name)
2034 current-prefix-arg)) 2314 current-prefix-arg))
2035 (unless group 2315 (unless group
2036 (error "No group to rename")) 2316 (error "No group to delete"))
2037 (unless (gnus-check-backend-function 'request-delete-group group) 2317 (unless (gnus-check-backend-function 'request-delete-group group)
2038 (error "This backend does not support group deletion")) 2318 (error "This back end does not support group deletion"))
2039 (prog1 2319 (prog1
2040 (if (and (not no-prompt) 2320 (let ((group-decoded (gnus-group-decoded-name group)))
2041 (not (gnus-yes-or-no-p 2321 (if (and (not no-prompt)
2042 (format 2322 (not (gnus-yes-or-no-p
2043 "Do you really want to delete %s%s? " 2323 (format
2044 group (if force " and all its contents" ""))))) 2324 "Do you really want to delete %s%s? "
2045 () ; Whew! 2325 group-decoded (if force " and all its contents" "")))))
2046 (gnus-message 6 "Deleting group %s..." group) 2326 () ; Whew!
2047 (if (not (gnus-request-delete-group group force)) 2327 (gnus-message 6 "Deleting group %s..." group-decoded)
2048 (gnus-error 3 "Couldn't delete group %s" group) 2328 (if (not (gnus-request-delete-group group force))
2049 (gnus-message 6 "Deleting group %s...done" group) 2329 (gnus-error 3 "Couldn't delete group %s" group-decoded)
2050 (gnus-group-goto-group group) 2330 (gnus-message 6 "Deleting group %s...done" group-decoded)
2051 (gnus-group-kill-group 1 t) 2331 (gnus-group-goto-group group)
2052 (gnus-sethash group nil gnus-active-hashtb) 2332 (gnus-group-kill-group 1 t)
2053 t)) 2333 (gnus-sethash group nil gnus-active-hashtb)
2334 t)))
2054 (gnus-group-position-point))) 2335 (gnus-group-position-point)))
2055 2336
2056 (defun gnus-group-rename-group (group new-name) 2337 (defun gnus-group-rename-group (group new-name)
2057 "Rename group from GROUP to NEW-NAME. 2338 "Rename group from GROUP to NEW-NAME.
2058 When used interactively, GROUP is the group under point 2339 When used interactively, GROUP is the group under point
2061 (list 2342 (list
2062 (gnus-group-group-name) 2343 (gnus-group-group-name)
2063 (progn 2344 (progn
2064 (unless (gnus-check-backend-function 2345 (unless (gnus-check-backend-function
2065 'request-rename-group (gnus-group-group-name)) 2346 'request-rename-group (gnus-group-group-name))
2066 (error "This backend does not support renaming groups")) 2347 (error "This back end does not support renaming groups"))
2067 (gnus-read-group "Rename group to: " 2348 (gnus-read-group "Rename group to: "
2068 (gnus-group-real-name (gnus-group-group-name)))))) 2349 (gnus-group-real-name (gnus-group-group-name))))))
2069 2350
2070 (unless (gnus-check-backend-function 'request-rename-group group) 2351 (unless (gnus-check-backend-function 'request-rename-group group)
2071 (error "This backend does not support renaming groups")) 2352 (error "This back end does not support renaming groups"))
2072 (unless group 2353 (unless group
2073 (error "No group to rename")) 2354 (error "No group to rename"))
2074 (when (equal (gnus-group-real-name group) new-name) 2355 (when (equal (gnus-group-real-name group) new-name)
2075 (error "Can't rename to the same name")) 2356 (error "Can't rename to the same name"))
2076 2357
2081 new-name 2362 new-name
2082 ;; Foreign group. 2363 ;; Foreign group.
2083 (gnus-group-prefixed-name 2364 (gnus-group-prefixed-name
2084 (gnus-group-real-name new-name) 2365 (gnus-group-real-name new-name)
2085 (gnus-info-method (gnus-get-info group))))) 2366 (gnus-info-method (gnus-get-info group)))))
2367
2368 (when (gnus-active new-name)
2369 (error "The group %s already exists" new-name))
2086 2370
2087 (gnus-message 6 "Renaming group %s to %s..." group new-name) 2371 (gnus-message 6 "Renaming group %s to %s..." group new-name)
2088 (prog1 2372 (prog1
2089 (if (progn 2373 (if (progn
2090 (gnus-group-goto-group group) 2374 (gnus-group-goto-group group)
2130 ((eq part 'method) "select method") 2414 ((eq part 'method) "select method")
2131 ((eq part 'params) "group parameters") 2415 ((eq part 'params) "group parameters")
2132 (t "group info")) 2416 (t "group info"))
2133 (gnus-group-decoded-name group)) 2417 (gnus-group-decoded-name group))
2134 `(lambda (form) 2418 `(lambda (form)
2135 (gnus-group-edit-group-done ',part ,group form))))) 2419 (gnus-group-edit-group-done ',part ,group form)))
2420 (local-set-key
2421 "\C-c\C-i"
2422 (gnus-create-info-command
2423 (cond
2424 ((eq part 'method)
2425 "(gnus)Select Methods")
2426 ((eq part 'params)
2427 "(gnus)Group Parameters")
2428 (t
2429 "(gnus)Group Info"))))))
2136 2430
2137 (defun gnus-group-edit-group-method (group) 2431 (defun gnus-group-edit-group-method (group)
2138 "Edit the select method of GROUP." 2432 "Edit the select method of GROUP."
2139 (interactive (list (gnus-group-group-name))) 2433 (interactive (list (gnus-group-group-name)))
2140 (gnus-group-edit-group group 'method)) 2434 (gnus-group-edit-group group 'method))
2191 (let (entry) 2485 (let (entry)
2192 (while (setq entry (memq (assq 'eval method) method)) 2486 (while (setq entry (memq (assq 'eval method) method))
2193 (setcar entry (eval (cadar entry))))) 2487 (setcar entry (eval (cadar entry)))))
2194 (gnus-group-make-group group method)) 2488 (gnus-group-make-group group method))
2195 2489
2196 (defun gnus-group-make-help-group () 2490 (defun gnus-group-make-help-group (&optional noerror)
2197 "Create the Gnus documentation group." 2491 "Create the Gnus documentation group.
2492 Optional argument NOERROR modifies the behavior of this function when the
2493 group already exists:
2494 - if not given, and error is signaled,
2495 - if t, stay silent,
2496 - if anything else, just print a message."
2198 (interactive) 2497 (interactive)
2199 (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) 2498 (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
2200 (file (nnheader-find-etc-directory "gnus-tut.txt" t))) 2499 (file (nnheader-find-etc-directory "gnus-tut.txt" t)))
2201 (when (gnus-gethash name gnus-newsrc-hashtb) 2500 (if (gnus-gethash name gnus-newsrc-hashtb)
2202 (error "Documentation group already exists")) 2501 (cond ((eq noerror nil)
2203 (if (not file) 2502 (error "Documentation group already exists"))
2204 (gnus-message 1 "Couldn't find doc group") 2503 ((eq noerror t)
2205 (gnus-group-make-group 2504 ;; stay silent
2206 (gnus-group-real-name name) 2505 )
2207 (list 'nndoc "gnus-help" 2506 (t
2208 (list 'nndoc-address file) 2507 (gnus-message 1 "Documentation group already exists")))
2209 (list 'nndoc-article-type 'mbox))))) 2508 ;; else:
2509 (if (not file)
2510 (gnus-message 1 "Couldn't find doc group")
2511 (gnus-group-make-group
2512 (gnus-group-real-name name)
2513 (list 'nndoc "gnus-help"
2514 (list 'nndoc-address file)
2515 (list 'nndoc-article-type 'mbox))))
2516 ))
2210 (gnus-group-position-point)) 2517 (gnus-group-position-point))
2211 2518
2212 (defun gnus-group-make-doc-group (file type) 2519 (defun gnus-group-make-doc-group (file type)
2213 "Create a group that uses a single file as the source." 2520 "Create a group that uses a single file as the source.
2521
2522 If called with a prefix argument, ask for the file type."
2214 (interactive 2523 (interactive
2215 (list (read-file-name "File name: ") 2524 (list (read-file-name "File name: ")
2216 (and current-prefix-arg 'ask))) 2525 (and current-prefix-arg 'ask)))
2217 (when (eq type 'ask) 2526 (when (eq type 'ask)
2218 (let ((err "") 2527 (let ((err "")
2219 char found) 2528 char found)
2220 (while (not found) 2529 (while (not found)
2221 (message 2530 (message
2222 "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: " 2531 "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: "
2223 err) 2532 err)
2224 (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) 2533 (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
2225 ((= char ?b) 'babyl) 2534 ((= char ?b) 'babyl)
2226 ((= char ?d) 'digest) 2535 ((= char ?d) 'digest)
2227 ((= char ?f) 'forward) 2536 ((= char ?f) 'forward)
2269 (method 2578 (method
2270 `(nnweb ,group (nnweb-search ,search) 2579 `(nnweb ,group (nnweb-search ,search)
2271 (nnweb-type ,(intern type)) 2580 (nnweb-type ,(intern type))
2272 (nnweb-ephemeral-p t)))) 2581 (nnweb-ephemeral-p t))))
2273 (if solid 2582 (if solid
2274 (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search)) 2583 (progn
2584 (gnus-pull 'nnweb-ephemeral-p method)
2585 (gnus-group-make-group group method))
2275 (gnus-group-read-ephemeral-group 2586 (gnus-group-read-ephemeral-group
2276 group method t 2587 group method t
2277 (cons (current-buffer) 2588 (cons (current-buffer)
2278 (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) 2589 (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
2590
2591 (eval-when-compile
2592 (defvar nnrss-group-alist)
2593 (defun nnrss-discover-feed (arg))
2594 (defun nnrss-save-server-data (arg)))
2595 (defun gnus-group-make-rss-group (&optional url)
2596 "Given a URL, discover if there is an RSS feed.
2597 If there is, use Gnus to create an nnrss group"
2598 (interactive)
2599 (require 'nnrss)
2600 (if (not url)
2601 (setq url (read-from-minibuffer "URL to Search for RSS: ")))
2602 (let ((feedinfo (nnrss-discover-feed url)))
2603 (if feedinfo
2604 (let ((title (gnus-newsgroup-savable-name
2605 (read-from-minibuffer "Title: "
2606 (gnus-newsgroup-savable-name
2607 (or (cdr (assoc 'title
2608 feedinfo))
2609 "")))))
2610 (desc (read-from-minibuffer "Description: "
2611 (cdr (assoc 'description
2612 feedinfo))))
2613 (href (cdr (assoc 'href feedinfo)))
2614 (encodable (mm-coding-system-p 'utf-8)))
2615 (when encodable
2616 ;; Unify non-ASCII text.
2617 (setq title (mm-decode-coding-string
2618 (mm-encode-coding-string title 'utf-8) 'utf-8)))
2619 (gnus-group-make-group (if encodable
2620 (mm-encode-coding-string title 'utf-8)
2621 title)
2622 '(nnrss ""))
2623 (push (list title href desc) nnrss-group-alist)
2624 (nnrss-save-server-data nil))
2625 (error "No feeds found for %s" url))))
2279 2626
2280 (defvar nnwarchive-type-definition) 2627 (defvar nnwarchive-type-definition)
2281 (defvar gnus-group-warchive-type-history nil) 2628 (defvar gnus-group-warchive-type-history nil)
2282 (defvar gnus-group-warchive-login-history nil) 2629 (defvar gnus-group-warchive-login-history nil)
2283 (defvar gnus-group-warchive-address-history nil) 2630 (defvar gnus-group-warchive-address-history nil)
2351 (setq ext (format "<%d>" (setq i (1+ i))))) 2698 (setq ext (format "<%d>" (setq i (1+ i)))))
2352 (gnus-group-make-group 2699 (gnus-group-make-group
2353 (gnus-group-real-name group) 2700 (gnus-group-real-name group)
2354 (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) 2701 (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
2355 2702
2356 (eval-when-compile (defvar nnkiboze-score-file)) 2703 (defvar nnkiboze-score-file)
2357 (defun gnus-group-make-kiboze-group (group address scores) 2704 (defun gnus-group-make-kiboze-group (group address scores)
2358 "Create an nnkiboze group. 2705 "Create an nnkiboze group.
2359 The user will be prompted for a name, a regexp to match groups, and 2706 The user will be prompted for a name, a regexp to match groups, and
2360 score file entries for articles to include in the group." 2707 score file entries for articles to include in the group."
2361 (interactive 2708 (interactive
2382 (score-dir (file-name-directory score-file))) 2729 (score-dir (file-name-directory score-file)))
2383 (unless (file-exists-p score-dir) 2730 (unless (file-exists-p score-dir)
2384 (make-directory score-dir)) 2731 (make-directory score-dir))
2385 (with-temp-file score-file 2732 (with-temp-file score-file
2386 (let (emacs-lisp-mode-hook) 2733 (let (emacs-lisp-mode-hook)
2387 (pp scores (current-buffer)))))) 2734 (gnus-pp scores)))))
2388 2735
2389 (defun gnus-group-add-to-virtual (n vgroup) 2736 (defun gnus-group-add-to-virtual (n vgroup)
2390 "Add the current group to a virtual group." 2737 "Add the current group to a virtual group."
2391 (interactive 2738 (interactive
2392 (list current-prefix-arg 2739 (list current-prefix-arg
2502 determined by the `gnus-group-sort-function' variable. 2849 determined by the `gnus-group-sort-function' variable.
2503 If REVERSE (the prefix), reverse the sorting order." 2850 If REVERSE (the prefix), reverse the sorting order."
2504 (interactive (list gnus-group-sort-function current-prefix-arg)) 2851 (interactive (list gnus-group-sort-function current-prefix-arg))
2505 (funcall gnus-group-sort-alist-function 2852 (funcall gnus-group-sort-alist-function
2506 (gnus-make-sort-function func) reverse) 2853 (gnus-make-sort-function func) reverse)
2854 (gnus-group-unmark-all-groups)
2507 (gnus-group-list-groups) 2855 (gnus-group-list-groups)
2508 (gnus-dribble-touch)) 2856 (gnus-dribble-touch))
2509 2857
2510 (defun gnus-group-sort-flat (func reverse) 2858 (defun gnus-group-sort-flat (func reverse)
2511 ;; We peel off the dummy group from the alist. 2859 ;; We peel off the dummy group from the alist.
2524 "Sort the group buffer alphabetically by group name. 2872 "Sort the group buffer alphabetically by group name.
2525 If REVERSE, sort in reverse order." 2873 If REVERSE, sort in reverse order."
2526 (interactive "P") 2874 (interactive "P")
2527 (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) 2875 (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
2528 2876
2877 (defun gnus-group-sort-groups-by-real-name (&optional reverse)
2878 "Sort the group buffer alphabetically by real (unprefixed) group name.
2879 If REVERSE, sort in reverse order."
2880 (interactive "P")
2881 (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse))
2882
2529 (defun gnus-group-sort-groups-by-unread (&optional reverse) 2883 (defun gnus-group-sort-groups-by-unread (&optional reverse)
2530 "Sort the group buffer by number of unread articles. 2884 "Sort the group buffer by number of unread articles.
2531 If REVERSE, sort in reverse order." 2885 If REVERSE, sort in reverse order."
2532 (interactive "P") 2886 (interactive "P")
2533 (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) 2887 (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
2549 If REVERSE, sort in reverse order." 2903 If REVERSE, sort in reverse order."
2550 (interactive "P") 2904 (interactive "P")
2551 (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) 2905 (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
2552 2906
2553 (defun gnus-group-sort-groups-by-method (&optional reverse) 2907 (defun gnus-group-sort-groups-by-method (&optional reverse)
2554 "Sort the group buffer alphabetically by backend name. 2908 "Sort the group buffer alphabetically by back end name.
2555 If REVERSE, sort in reverse order." 2909 If REVERSE, sort in reverse order."
2556 (interactive "P") 2910 (interactive "P")
2557 (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) 2911 (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
2912
2913 (defun gnus-group-sort-groups-by-server (&optional reverse)
2914 "Sort the group buffer alphabetically by server name.
2915 If REVERSE, sort in reverse order."
2916 (interactive "P")
2917 (gnus-group-sort-groups 'gnus-group-sort-by-server reverse))
2558 2918
2559 ;;; Selected group sorting. 2919 ;;; Selected group sorting.
2560 2920
2561 (defun gnus-group-sort-selected-groups (n func &optional reverse) 2921 (defun gnus-group-sort-selected-groups (n func &optional reverse)
2562 "Sort the process/prefixed groups." 2922 "Sort the process/prefixed groups."
2563 (interactive (list current-prefix-arg gnus-group-sort-function)) 2923 (interactive (list current-prefix-arg gnus-group-sort-function))
2564 (let ((groups (gnus-group-process-prefix n))) 2924 (let ((groups (gnus-group-process-prefix n)))
2565 (funcall gnus-group-sort-selected-function 2925 (funcall gnus-group-sort-selected-function
2566 groups (gnus-make-sort-function func) reverse) 2926 groups (gnus-make-sort-function func) reverse)
2567 (gnus-group-list-groups))) 2927 (gnus-group-unmark-all-groups)
2928 (gnus-group-list-groups)
2929 (gnus-dribble-touch)))
2568 2930
2569 (defun gnus-group-sort-selected-flat (groups func reverse) 2931 (defun gnus-group-sort-selected-flat (groups func reverse)
2570 (let (entries infos) 2932 (let (entries infos)
2571 ;; First find all the group entries for these groups. 2933 ;; First find all the group entries for these groups.
2572 (while groups 2934 (while groups
2594 Obeys the process/prefix convention. If REVERSE (the symbolic prefix), 2956 Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
2595 sort in reverse order." 2957 sort in reverse order."
2596 (interactive (gnus-interactive "P\ny")) 2958 (interactive (gnus-interactive "P\ny"))
2597 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse)) 2959 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
2598 2960
2961 (defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse)
2962 "Sort the group buffer alphabetically by real group name.
2963 Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
2964 sort in reverse order."
2965 (interactive (gnus-interactive "P\ny"))
2966 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse))
2967
2599 (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse) 2968 (defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
2600 "Sort the group buffer by number of unread articles. 2969 "Sort the group buffer by number of unread articles.
2601 Obeys the process/prefix convention. If REVERSE (the symbolic prefix), 2970 Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
2602 sort in reverse order." 2971 sort in reverse order."
2603 (interactive (gnus-interactive "P\ny")) 2972 (interactive (gnus-interactive "P\ny"))
2623 sort in reverse order." 2992 sort in reverse order."
2624 (interactive (gnus-interactive "P\ny")) 2993 (interactive (gnus-interactive "P\ny"))
2625 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse)) 2994 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
2626 2995
2627 (defun gnus-group-sort-selected-groups-by-method (&optional n reverse) 2996 (defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
2628 "Sort the group buffer alphabetically by backend name. 2997 "Sort the group buffer alphabetically by back end name.
2629 Obeys the process/prefix convention. If REVERSE (the symbolic prefix), 2998 Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
2630 sort in reverse order." 2999 sort in reverse order."
2631 (interactive (gnus-interactive "P\ny")) 3000 (interactive (gnus-interactive "P\ny"))
2632 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse)) 3001 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse))
2633 3002
2652 (defun gnus-group-sort-by-level (info1 info2) 3021 (defun gnus-group-sort-by-level (info1 info2)
2653 "Sort by level." 3022 "Sort by level."
2654 (< (gnus-info-level info1) (gnus-info-level info2))) 3023 (< (gnus-info-level info1) (gnus-info-level info2)))
2655 3024
2656 (defun gnus-group-sort-by-method (info1 info2) 3025 (defun gnus-group-sort-by-method (info1 info2)
2657 "Sort alphabetically by backend name." 3026 "Sort alphabetically by back end name."
2658 (string< (symbol-name (car (gnus-find-method-for-group 3027 (string< (car (gnus-find-method-for-group
2659 (gnus-info-group info1) info1))) 3028 (gnus-info-group info1) info1))
2660 (symbol-name (car (gnus-find-method-for-group 3029 (car (gnus-find-method-for-group
2661 (gnus-info-group info2) info2))))) 3030 (gnus-info-group info2) info2))))
3031
3032 (defun gnus-group-sort-by-server (info1 info2)
3033 "Sort alphabetically by server name."
3034 (string< (gnus-method-to-full-server-name
3035 (gnus-find-method-for-group
3036 (gnus-info-group info1) info1))
3037 (gnus-method-to-full-server-name
3038 (gnus-find-method-for-group
3039 (gnus-info-group info2) info2))))
2662 3040
2663 (defun gnus-group-sort-by-score (info1 info2) 3041 (defun gnus-group-sort-by-score (info1 info2)
2664 "Sort by group score." 3042 "Sort by group score."
2665 (< (gnus-info-score info1) (gnus-info-score info2))) 3043 (> (gnus-info-score info1) (gnus-info-score info2)))
2666 3044
2667 (defun gnus-group-sort-by-rank (info1 info2) 3045 (defun gnus-group-sort-by-rank (info1 info2)
2668 "Sort by level and score." 3046 "Sort by level and score."
2669 (let ((level1 (gnus-info-level info1)) 3047 (let ((level1 (gnus-info-level info1))
2670 (level2 (gnus-info-level info2))) 3048 (level2 (gnus-info-level info2)))
2673 (> (gnus-info-score info1) (gnus-info-score info2)))))) 3051 (> (gnus-info-score info1) (gnus-info-score info2))))))
2674 3052
2675 ;;; Clearing data 3053 ;;; Clearing data
2676 3054
2677 (defun gnus-group-clear-data (&optional arg) 3055 (defun gnus-group-clear-data (&optional arg)
2678 "Clear all marks and read ranges from the current group." 3056 "Clear all marks and read ranges from the current group.
3057 Obeys the process/prefix convention."
2679 (interactive "P") 3058 (interactive "P")
2680 (gnus-group-iterate arg 3059 (gnus-group-iterate arg
2681 (lambda (group) 3060 (lambda (group)
2682 (let (info) 3061 (let (info)
2683 (gnus-info-clear-data (setq info (gnus-get-info group))) 3062 (gnus-info-clear-data (setq info (gnus-get-info group)))
2700 "Move the cache away to avoid problems in the future? ") 3079 "Move the cache away to avoid problems in the future? ")
2701 (call-interactively 'gnus-cache-move-cache))))) 3080 (call-interactively 'gnus-cache-move-cache)))))
2702 3081
2703 (defun gnus-info-clear-data (info) 3082 (defun gnus-info-clear-data (info)
2704 "Clear all marks and read ranges from INFO." 3083 "Clear all marks and read ranges from INFO."
2705 (let ((group (gnus-info-group info))) 3084 (let ((group (gnus-info-group info))
3085 action)
3086 (dolist (el (gnus-info-marks info))
3087 (push `(,(cdr el) add (,(car el))) action))
3088 (push `(,(gnus-info-read info) add (read)) action)
2706 (gnus-undo-register 3089 (gnus-undo-register
2707 `(progn 3090 `(progn
3091 (gnus-request-set-mark ,group ',action)
2708 (gnus-info-set-marks ',info ',(gnus-info-marks info) t) 3092 (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
2709 (gnus-info-set-read ',info ',(gnus-info-read info)) 3093 (gnus-info-set-read ',info ',(gnus-info-read info))
2710 (when (gnus-group-goto-group ,group) 3094 (when (gnus-group-goto-group ,group)
3095 (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t)
2711 (gnus-group-update-group-line)))) 3096 (gnus-group-update-group-line))))
3097 (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el)))
3098 action))
3099 (gnus-request-set-mark group action)
2712 (gnus-info-set-read info nil) 3100 (gnus-info-set-read info nil)
2713 (when (gnus-info-marks info) 3101 (when (gnus-info-marks info)
2714 (gnus-info-set-marks info nil)))) 3102 (gnus-info-set-marks info nil))))
2715 3103
2716 ;; Group catching up. 3104 ;; Group catching up.
2734 (format 3122 (format
2735 (if all 3123 (if all
2736 "Do you really want to mark all articles in %s as read? " 3124 "Do you really want to mark all articles in %s as read? "
2737 "Mark all unread articles in %s as read? ") 3125 "Mark all unread articles in %s as read? ")
2738 (if (= (length groups) 1) 3126 (if (= (length groups) 1)
2739 (car groups) 3127 (gnus-group-decoded-name (car groups))
2740 (format "these %d groups" (length groups))))))) 3128 (format "these %d groups" (length groups)))))))
2741 n 3129 n
2742 (while (setq group (pop groups)) 3130 (while (setq group (pop groups))
2743 (gnus-group-remove-mark group) 3131 (gnus-group-remove-mark group)
2744 ;; Virtual groups have to be given special treatment. 3132 ;; Virtual groups have to be given special treatment.
2766 "Mark all articles in GROUP as read. 3154 "Mark all articles in GROUP as read.
2767 If ALL is non-nil, all articles are marked as read. 3155 If ALL is non-nil, all articles are marked as read.
2768 The return value is the number of articles that were marked as read, 3156 The return value is the number of articles that were marked as read,
2769 or nil if no action could be taken." 3157 or nil if no action could be taken."
2770 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) 3158 (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
2771 (num (car entry))) 3159 (num (car entry))
3160 (marks (nth 3 (nth 2 entry)))
3161 (unread (gnus-sequence-of-unread-articles group)))
2772 ;; Remove entries for this group. 3162 ;; Remove entries for this group.
2773 (nnmail-purge-split-history (gnus-group-real-name group)) 3163 (nnmail-purge-split-history (gnus-group-real-name group))
2774 ;; Do the updating only if the newsgroup isn't killed. 3164 ;; Do the updating only if the newsgroup isn't killed.
2775 (if (not (numberp (car entry))) 3165 (if (not (numberp (car entry)))
2776 (gnus-message 1 "Can't catch up %s; non-active group" group) 3166 (gnus-message 1 "Can't catch up %s; non-active group" group)
3167 (gnus-update-read-articles group nil)
3168 (when all
3169 ;; Nix out the lists of marks and dormants.
3170 (gnus-request-set-mark group (list (list (cdr (assq 'tick marks))
3171 'del '(tick))
3172 (list (cdr (assq 'dormant marks))
3173 'del '(dormant))))
3174 (setq unread (gnus-range-add (gnus-range-add
3175 unread (cdr (assq 'dormant marks)))
3176 (cdr (assq 'tick marks))))
3177 (gnus-add-marked-articles group 'tick nil nil 'force)
3178 (gnus-add-marked-articles group 'dormant nil nil 'force))
2777 ;; Do auto-expirable marks if that's required. 3179 ;; Do auto-expirable marks if that's required.
2778 (when (gnus-group-auto-expirable-p group) 3180 (when (gnus-group-auto-expirable-p group)
2779 (gnus-add-marked-articles 3181 (gnus-range-map (lambda (article)
2780 group 'expire (gnus-list-of-unread-articles group)) 3182 (gnus-add-marked-articles group 'expire (list article))
2781 (when all 3183 (gnus-request-set-mark group (list (list (list article) 'add '(expire)))))
2782 (let ((marks (nth 3 (nth 2 entry)))) 3184 unread))
2783 (gnus-add-marked-articles 3185 (let ((gnus-newsgroup-name group))
2784 group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) 3186 (gnus-run-hooks 'gnus-group-catchup-group-hook))
2785 (gnus-add-marked-articles 3187 num)))
2786 group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
2787 (when entry
2788 (gnus-update-read-articles group nil)
2789 ;; Also nix out the lists of marks and dormants.
2790 (when all
2791 (gnus-add-marked-articles group 'tick nil nil 'force)
2792 (gnus-add-marked-articles group 'dormant nil nil 'force))
2793 (let ((gnus-newsgroup-name group))
2794 (gnus-run-hooks 'gnus-group-catchup-group-hook))
2795 num))))
2796 3188
2797 (defun gnus-group-expire-articles (&optional n) 3189 (defun gnus-group-expire-articles (&optional n)
2798 "Expire all expirable articles in the current newsgroup." 3190 "Expire all expirable articles in the current newsgroup.
3191 Uses the process/prefix convention."
2799 (interactive "P") 3192 (interactive "P")
2800 (let ((groups (gnus-group-process-prefix n)) 3193 (let ((groups (gnus-group-process-prefix n))
2801 group) 3194 group)
2802 (unless groups 3195 (unless groups
2803 (error "No groups to expire")) 3196 (error "No groups to expire"))
2807 (gnus-dribble-touch) 3200 (gnus-dribble-touch)
2808 (gnus-group-position-point)))) 3201 (gnus-group-position-point))))
2809 3202
2810 (defun gnus-group-expire-articles-1 (group) 3203 (defun gnus-group-expire-articles-1 (group)
2811 (when (gnus-check-backend-function 'request-expire-articles group) 3204 (when (gnus-check-backend-function 'request-expire-articles group)
2812 (gnus-message 6 "Expiring articles in %s..." group) 3205 (gnus-message 6 "Expiring articles in %s..."
3206 (gnus-group-decoded-name group))
2813 (let* ((info (gnus-get-info group)) 3207 (let* ((info (gnus-get-info group))
2814 (expirable (if (gnus-group-total-expirable-p group) 3208 (expirable (if (gnus-group-total-expirable-p group)
2815 (cons nil (gnus-list-of-read-articles group)) 3209 (cons nil (gnus-list-of-read-articles group))
2816 (assq 'expire (gnus-info-marks info)))) 3210 (assq 'expire (gnus-info-marks info))))
2817 (expiry-wait (gnus-group-find-parameter group 'expiry-wait)) 3211 (expiry-wait (gnus-group-find-parameter group 'expiry-wait))
2832 (gnus-uncompress-sequence (cdr expirable)) group)) 3226 (gnus-uncompress-sequence (cdr expirable)) group))
2833 ;; Just expire using the normal expiry values. 3227 ;; Just expire using the normal expiry values.
2834 (gnus-request-expire-articles 3228 (gnus-request-expire-articles
2835 (gnus-uncompress-sequence (cdr expirable)) group)))) 3229 (gnus-uncompress-sequence (cdr expirable)) group))))
2836 (gnus-close-group group)) 3230 (gnus-close-group group))
2837 (gnus-message 6 "Expiring articles in %s...done" group) 3231 (gnus-message 6 "Expiring articles in %s...done"
3232 (gnus-group-decoded-name group))
2838 ;; Return the list of un-expired articles. 3233 ;; Return the list of un-expired articles.
2839 (cdr expirable)))) 3234 (cdr expirable))))
2840 3235
2841 (defun gnus-group-expire-all-groups () 3236 (defun gnus-group-expire-all-groups ()
2842 "Expire all expirable articles in all newsgroups." 3237 "Expire all expirable articles in all newsgroups."
2852 (defun gnus-group-set-current-level (n level) 3247 (defun gnus-group-set-current-level (n level)
2853 "Set the level of the next N groups to LEVEL." 3248 "Set the level of the next N groups to LEVEL."
2854 (interactive 3249 (interactive
2855 (list 3250 (list
2856 current-prefix-arg 3251 current-prefix-arg
2857 (string-to-int 3252 (progn
2858 (let ((s (read-string 3253 (unless (gnus-group-process-prefix current-prefix-arg)
2859 (format "Level (default %s): " 3254 (error "No group on the current line"))
2860 (or (gnus-group-group-level) 3255 (string-to-number
2861 gnus-level-default-subscribed))))) 3256 (let ((s (read-string
2862 (if (string-match "^\\s-*$" s) 3257 (format "Level (default %s): "
2863 (int-to-string (or (gnus-group-group-level) 3258 (or (gnus-group-group-level)
2864 gnus-level-default-subscribed)) 3259 gnus-level-default-subscribed)))))
2865 s))))) 3260 (if (string-match "^\\s-*$" s)
3261 (int-to-string (or (gnus-group-group-level)
3262 gnus-level-default-subscribed))
3263 s))))))
2866 (unless (and (>= level 1) (<= level gnus-level-killed)) 3264 (unless (and (>= level 1) (<= level gnus-level-killed))
2867 (error "Invalid level: %d" level)) 3265 (error "Invalid level: %d" level))
2868 (let ((groups (gnus-group-process-prefix n)) 3266 (let ((groups (gnus-group-process-prefix n))
2869 group) 3267 group)
2870 (while (setq group (pop groups)) 3268 (while (setq group (pop groups))
2871 (gnus-group-remove-mark group) 3269 (gnus-group-remove-mark group)
2872 (gnus-message 6 "Changed level of %s from %d to %d" 3270 (gnus-message 6 "Changed level of %s from %d to %d"
2873 group (or (gnus-group-group-level) gnus-level-killed) 3271 (gnus-group-decoded-name group)
3272 (or (gnus-group-group-level) gnus-level-killed)
2874 level) 3273 level)
2875 (gnus-group-change-level 3274 (gnus-group-change-level
2876 group level (or (gnus-group-group-level) gnus-level-killed)) 3275 group level (or (gnus-group-group-level) gnus-level-killed))
2877 (gnus-group-update-group-line))) 3276 (gnus-group-update-group-line)))
2878 (gnus-group-position-point)) 3277 (gnus-group-position-point))
2889 3288
2890 (defun gnus-group-unsubscribe-current-group (&optional n do-sub) 3289 (defun gnus-group-unsubscribe-current-group (&optional n do-sub)
2891 "Toggle subscription of the current group. 3290 "Toggle subscription of the current group.
2892 If given numerical prefix, toggle the N next groups." 3291 If given numerical prefix, toggle the N next groups."
2893 (interactive "P") 3292 (interactive "P")
2894 (let ((groups (gnus-group-process-prefix n)) 3293 (dolist (group (gnus-group-process-prefix n))
2895 group) 3294 (gnus-group-remove-mark group)
2896 (while groups 3295 (gnus-group-unsubscribe-group
2897 (setq group (car groups) 3296 group
2898 groups (cdr groups)) 3297 (cond
2899 (gnus-group-remove-mark group) 3298 ((eq do-sub 'unsubscribe)
2900 (gnus-group-unsubscribe-group 3299 gnus-level-default-unsubscribed)
2901 group 3300 ((eq do-sub 'subscribe)
2902 (cond 3301 gnus-level-default-subscribed)
2903 ((eq do-sub 'unsubscribe) 3302 ((<= (gnus-group-group-level) gnus-level-subscribed)
2904 gnus-level-default-unsubscribed) 3303 gnus-level-default-unsubscribed)
2905 ((eq do-sub 'subscribe) 3304 (t
2906 gnus-level-default-subscribed) 3305 gnus-level-default-subscribed))
2907 ((<= (gnus-group-group-level) gnus-level-subscribed) 3306 t)
2908 gnus-level-default-unsubscribed) 3307 (gnus-group-update-group-line))
2909 (t 3308 (gnus-group-next-group 1))
2910 gnus-level-default-subscribed))
2911 t)
2912 (gnus-group-update-group-line))
2913 (gnus-group-next-group 1)))
2914 3309
2915 (defun gnus-group-unsubscribe-group (group &optional level silent) 3310 (defun gnus-group-unsubscribe-group (group &optional level silent)
2916 "Toggle subscription to GROUP. 3311 "Toggle subscription to GROUP.
2917 Killed newsgroups are subscribed. If SILENT, don't try to update the 3312 Killed newsgroups are subscribed. If SILENT, don't try to update the
2918 group line." 3313 group line."
3021 (gnus-group-yank-group))) 3416 (gnus-group-yank-group)))
3022 (push (cons (car entry) (nth 2 entry)) 3417 (push (cons (car entry) (nth 2 entry))
3023 gnus-list-of-killed-groups)) 3418 gnus-list-of-killed-groups))
3024 (gnus-group-change-level 3419 (gnus-group-change-level
3025 (if entry entry group) gnus-level-killed (if entry nil level)) 3420 (if entry entry group) gnus-level-killed (if entry nil level))
3026 (message "Killed group %s" group)) 3421 (message "Killed group %s" (gnus-group-decoded-name group)))
3027 ;; If there are lots and lots of groups to be killed, we use 3422 ;; If there are lots and lots of groups to be killed, we use
3028 ;; this thing instead. 3423 ;; this thing instead.
3029 (let (entry) 3424 (dolist (group (nreverse groups))
3030 (setq groups (nreverse groups)) 3425 (gnus-group-remove-mark group)
3031 (while groups 3426 (gnus-delete-line)
3032 (gnus-group-remove-mark (setq group (pop groups))) 3427 (push group gnus-killed-list)
3033 (gnus-delete-line) 3428 (setq gnus-newsrc-alist
3034 (push group gnus-killed-list) 3429 (delq (assoc group gnus-newsrc-alist)
3035 (setq gnus-newsrc-alist 3430 gnus-newsrc-alist))
3036 (delq (assoc group gnus-newsrc-alist) 3431 (when gnus-group-change-level-function
3037 gnus-newsrc-alist)) 3432 (funcall gnus-group-change-level-function
3038 (when gnus-group-change-level-function 3433 group gnus-level-killed 3))
3039 (funcall gnus-group-change-level-function 3434 (cond
3040 group gnus-level-killed 3)) 3435 ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
3041 (cond 3436 (push (cons (car entry) (nth 2 entry))
3042 ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) 3437 gnus-list-of-killed-groups)
3043 (push (cons (car entry) (nth 2 entry)) 3438 (setcdr (cdr entry) (cdddr entry)))
3044 gnus-list-of-killed-groups) 3439 ((member group gnus-zombie-list)
3045 (setcdr (cdr entry) (cdddr entry))) 3440 (setq gnus-zombie-list (delete group gnus-zombie-list))))
3046 ((member group gnus-zombie-list) 3441 ;; There may be more than one instance displayed.
3047 (setq gnus-zombie-list (delete group gnus-zombie-list)))) 3442 (while (gnus-group-goto-group group)
3048 ;; There may be more than one instance displayed. 3443 (gnus-delete-line)))
3049 (while (gnus-group-goto-group group) 3444 (gnus-make-hashtable-from-newsrc-alist))
3050 (gnus-delete-line)))
3051 (gnus-make-hashtable-from-newsrc-alist)))
3052 3445
3053 (gnus-group-position-point) 3446 (gnus-group-position-point)
3054 (if (< (length out) 2) (car out) (nreverse out)))) 3447 (if (< (length out) 2) (car out) (nreverse out))))
3055 3448
3056 (defun gnus-group-yank-group (&optional arg) 3449 (defun gnus-group-yank-group (&optional arg)
3111 (t 3504 (t
3112 (error "Can't kill; invalid level: %d" level)))) 3505 (error "Can't kill; invalid level: %d" level))))
3113 3506
3114 (defun gnus-group-list-all-groups (&optional arg) 3507 (defun gnus-group-list-all-groups (&optional arg)
3115 "List all newsgroups with level ARG or lower. 3508 "List all newsgroups with level ARG or lower.
3116 Default is gnus-level-unsubscribed, which lists all subscribed and most 3509 Default is `gnus-level-unsubscribed', which lists all subscribed and most
3117 unsubscribed groups." 3510 unsubscribed groups."
3118 (interactive "P") 3511 (interactive "P")
3119 (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) 3512 (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
3120 3513
3121 ;; Redefine this to list ALL killed groups if prefix arg used. 3514 ;; Redefine this to list ALL killed groups if prefix arg used.
3151 "List all groups that are available from the server(s)." 3544 "List all groups that are available from the server(s)."
3152 (interactive) 3545 (interactive)
3153 ;; First we make sure that we have really read the active file. 3546 ;; First we make sure that we have really read the active file.
3154 (unless (gnus-read-active-file-p) 3547 (unless (gnus-read-active-file-p)
3155 (let ((gnus-read-active-file t) 3548 (let ((gnus-read-active-file t)
3156 (gnus-agent nil)) ; Trick the agent into ignoring the active file. 3549 (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent.
3157 (gnus-read-active-file))) 3550 (gnus-read-active-file)))
3158 ;; Find all groups and sort them. 3551 ;; Find all groups and sort them.
3159 (let ((groups 3552 (let ((groups
3160 (sort 3553 (sort
3161 (let (list) 3554 (let (list)
3173 (while groups 3566 (while groups
3174 (setq group (pop groups)) 3567 (setq group (pop groups))
3175 (gnus-add-text-properties 3568 (gnus-add-text-properties
3176 (point) (prog1 (1+ (point)) 3569 (point) (prog1 (1+ (point))
3177 (insert " *: " 3570 (insert " *: "
3178 (gnus-group-name-decode group 3571 (gnus-group-decoded-name group)
3179 (gnus-group-name-charset
3180 nil group))
3181 "\n")) 3572 "\n"))
3182 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 3573 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
3183 'gnus-unread t 3574 'gnus-unread t
3184 'gnus-level (inline (gnus-group-level group))))) 3575 'gnus-level (inline (gnus-group-level group)))))
3185 (goto-char (point-min)))) 3576 (goto-char (point-min))))
3200 (require 'nnmail) 3591 (require 'nnmail)
3201 (let ((gnus-inhibit-demon t) 3592 (let ((gnus-inhibit-demon t)
3202 ;; Binding this variable will inhibit multiple fetchings 3593 ;; Binding this variable will inhibit multiple fetchings
3203 ;; of the same mail source. 3594 ;; of the same mail source.
3204 (nnmail-fetched-sources (list t))) 3595 (nnmail-fetched-sources (list t)))
3596 (gnus-run-hooks 'gnus-get-top-new-news-hook)
3205 (gnus-run-hooks 'gnus-get-new-news-hook) 3597 (gnus-run-hooks 'gnus-get-new-news-hook)
3206 3598
3207 ;; Read any slave files. 3599 ;; Read any slave files.
3208 (unless gnus-slave 3600 (unless gnus-slave
3209 (gnus-master-read-slave-newsrc)) 3601 (gnus-master-read-slave-newsrc))
3234 (max (car gnus-group-list-mode) arg))))) 3626 (max (car gnus-group-list-mode) arg)))))
3235 3627
3236 (defun gnus-group-get-new-news-this-group (&optional n dont-scan) 3628 (defun gnus-group-get-new-news-this-group (&optional n dont-scan)
3237 "Check for newly arrived news in the current group (and the N-1 next groups). 3629 "Check for newly arrived news in the current group (and the N-1 next groups).
3238 The difference between N and the number of newsgroup checked is returned. 3630 The difference between N and the number of newsgroup checked is returned.
3239 If N is negative, this group and the N-1 previous groups will be checked." 3631 If N is negative, this group and the N-1 previous groups will be checked.
3632 If DONT-SCAN is non-nil, scan non-activated groups as well."
3240 (interactive "P") 3633 (interactive "P")
3241 (let* ((groups (gnus-group-process-prefix n)) 3634 (let* ((groups (gnus-group-process-prefix n))
3242 (ret (if (numberp n) (- n (length groups)) 0)) 3635 (ret (if (numberp n) (- n (length groups)) 0))
3243 (beg (unless n 3636 (beg (unless n
3244 (point))) 3637 (point)))
3298 (if (not (file-exists-p file)) 3691 (if (not (file-exists-p file))
3299 (gnus-message 1 "No such file: %s" file) 3692 (gnus-message 1 "No such file: %s" file)
3300 (let ((enable-local-variables nil)) 3693 (let ((enable-local-variables nil))
3301 (find-file file) 3694 (find-file file)
3302 (setq found t)))))) 3695 (setq found t))))))
3696
3697 (defun gnus-group-fetch-charter (group)
3698 "Fetch the charter for the current group.
3699 If given a prefix argument, prompt for a group."
3700 (interactive
3701 (list (or (when current-prefix-arg
3702 (completing-read "Group: " gnus-active-hashtb))
3703 (gnus-group-group-name)
3704 gnus-newsgroup-name)))
3705 (unless group
3706 (error "No group name given"))
3707 (require 'mm-url)
3708 (condition-case nil (require 'url-http) (error nil))
3709 (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group)))
3710 url hierarchy)
3711 (when (string-match "\\(^[^\\.]+\\)\\..*" name)
3712 (setq hierarchy (match-string 1 name))
3713 (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist)))
3714 (if (fboundp 'url-http-file-exists-p)
3715 (url-http-file-exists-p (eval url))
3716 t))
3717 (browse-url (eval url))
3718 (setq url (concat "http://" hierarchy
3719 ".news-admin.org/charters/" name))
3720 (if (and (fboundp 'url-http-file-exists-p)
3721 (url-http-file-exists-p url))
3722 (browse-url url)
3723 (gnus-group-fetch-control group))))))
3724
3725 (defun gnus-group-fetch-control (group)
3726 "Fetch the archived control messages for the current group.
3727 If given a prefix argument, prompt for a group."
3728 (interactive
3729 (list (or (when current-prefix-arg
3730 (completing-read "Group: " gnus-active-hashtb))
3731 (gnus-group-group-name)
3732 gnus-newsgroup-name)))
3733 (unless group
3734 (error "No group name given"))
3735 (let ((name (gnus-group-real-name group))
3736 hierarchy)
3737 (when (string-match "\\(^[^\\.]+\\)\\..*" name)
3738 (setq hierarchy (match-string 1 name))
3739 (if gnus-group-fetch-control-use-browse-url
3740 (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
3741 hierarchy "/" name ".gz"))
3742 (let ((enable-local-variables nil))
3743 (gnus-group-read-ephemeral-group
3744 group
3745 `(nndoc ,group (nndoc-address
3746 ,(find-file-noselect
3747 (concat "/ftp@ftp.isc.org:/usenet/control/"
3748 hierarchy "/" name ".gz")))
3749 (nndoc-article-type mbox)) t nil nil))))))
3303 3750
3304 (defun gnus-group-describe-group (force &optional group) 3751 (defun gnus-group-describe-group (force &optional group)
3305 "Display a description of the current newsgroup." 3752 "Display a description of the current newsgroup."
3306 (interactive (list current-prefix-arg (gnus-group-group-name))) 3753 (interactive (list current-prefix-arg (gnus-group-group-name)))
3307 (let* ((method (gnus-find-method-for-group group)) 3754 (let* ((method (gnus-find-method-for-group group))
3394 (setq groups (cdr groups))) 3841 (setq groups (cdr groups)))
3395 (goto-char (point-min)))) 3842 (goto-char (point-min))))
3396 (pop-to-buffer obuf))) 3843 (pop-to-buffer obuf)))
3397 3844
3398 (defun gnus-group-description-apropos (regexp) 3845 (defun gnus-group-description-apropos (regexp)
3399 "List all newsgroups that have names or descriptions that match a regexp." 3846 "List all newsgroups that have names or descriptions that match REGEXP."
3400 (interactive "sGnus description apropos (regexp): ") 3847 (interactive "sGnus description apropos (regexp): ")
3401 (when (not (or gnus-description-hashtb 3848 (when (not (or gnus-description-hashtb
3402 (gnus-read-all-descriptions-files))) 3849 (gnus-read-all-descriptions-files)))
3403 (error "Couldn't request descriptions file")) 3850 (error "Couldn't request descriptions file"))
3404 (gnus-group-apropos regexp t)) 3851 (gnus-group-apropos regexp t))
3415 (interactive "P\nsList newsgroups matching: ") 3862 (interactive "P\nsList newsgroups matching: ")
3416 ;; First make sure active file has been read. 3863 ;; First make sure active file has been read.
3417 (when (and level 3864 (when (and level
3418 (> (prefix-numeric-value level) gnus-level-killed)) 3865 (> (prefix-numeric-value level) gnus-level-killed))
3419 (gnus-get-killed-groups)) 3866 (gnus-get-killed-groups))
3420 (gnus-group-prepare-flat 3867 (funcall gnus-group-prepare-function
3421 (or level gnus-level-subscribed) all (or lowest 1) regexp) 3868 (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
3422 (goto-char (point-min)) 3869 (goto-char (point-min))
3423 (gnus-group-position-point)) 3870 (gnus-group-position-point))
3424 3871
3425 (defun gnus-group-list-all-matching (level regexp &optional lowest) 3872 (defun gnus-group-list-all-matching (level regexp &optional lowest)
3426 "List all groups that match REGEXP. 3873 "List all groups that match REGEXP.
3493 (defun gnus-group-force-update () 3940 (defun gnus-group-force-update ()
3494 "Update `.newsrc' file." 3941 "Update `.newsrc' file."
3495 (interactive) 3942 (interactive)
3496 (gnus-save-newsrc-file)) 3943 (gnus-save-newsrc-file))
3497 3944
3945 (defvar gnus-backlog-articles)
3946
3498 (defun gnus-group-suspend () 3947 (defun gnus-group-suspend ()
3499 "Suspend the current Gnus session. 3948 "Suspend the current Gnus session.
3500 In fact, cleanup buffers except for group mode buffer. 3949 In fact, cleanup buffers except for group mode buffer.
3501 The hook gnus-suspend-gnus-hook is called before actually suspending." 3950 The hook `gnus-suspend-gnus-hook' is called before actually suspending."
3502 (interactive) 3951 (interactive)
3503 (gnus-run-hooks 'gnus-suspend-gnus-hook) 3952 (gnus-run-hooks 'gnus-suspend-gnus-hook)
3953 (gnus-offer-save-summaries)
3504 ;; Kill Gnus buffers except for group mode buffer. 3954 ;; Kill Gnus buffers except for group mode buffer.
3505 (let ((group-buf (get-buffer gnus-group-buffer))) 3955 (let ((group-buf (get-buffer gnus-group-buffer)))
3506 (mapcar (lambda (buf) 3956 (mapcar (lambda (buf)
3507 (unless (member buf (list group-buf gnus-dribble-buffer)) 3957 (unless (or (member buf (list group-buf gnus-dribble-buffer))
3508 (kill-buffer buf))) 3958 (progn
3959 (save-excursion
3960 (set-buffer buf)
3961 (eq major-mode 'message-mode))))
3962 (gnus-kill-buffer buf)))
3509 (gnus-buffers)) 3963 (gnus-buffers))
3964 (setq gnus-backlog-articles nil)
3510 (gnus-kill-gnus-frames) 3965 (gnus-kill-gnus-frames)
3511 (when group-buf 3966 (when group-buf
3512 (bury-buffer group-buf) 3967 (bury-buffer group-buf)
3513 (delete-windows-on group-buf t)))) 3968 (delete-windows-on group-buf t))))
3514 3969
3551 (gnus-yes-or-no-p 4006 (gnus-yes-or-no-p
3552 (format "Quit reading news without saving %s? " 4007 (format "Quit reading news without saving %s? "
3553 (file-name-nondirectory gnus-current-startup-file)))) 4008 (file-name-nondirectory gnus-current-startup-file))))
3554 (gnus-run-hooks 'gnus-exit-gnus-hook) 4009 (gnus-run-hooks 'gnus-exit-gnus-hook)
3555 (gnus-configure-windows 'group t) 4010 (gnus-configure-windows 'group t)
4011 (when (and (gnus-buffer-live-p gnus-dribble-buffer)
4012 (not (zerop (save-excursion
4013 (set-buffer gnus-dribble-buffer)
4014 (buffer-size)))))
4015 (gnus-dribble-enter
4016 ";;; Gnus was exited on purpose without saving the .newsrc files."))
3556 (gnus-dribble-save) 4017 (gnus-dribble-save)
3557 (gnus-close-backends) 4018 (gnus-close-backends)
3558 (gnus-clear-system) 4019 (gnus-clear-system)
3559 (gnus-kill-buffer gnus-group-buffer) 4020 (gnus-kill-buffer gnus-group-buffer)
3560 ;; Allow the user to do things after cleaning up. 4021 ;; Allow the user to do things after cleaning up.
3571 (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). 4032 (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
3572 If not, METHOD should be a list where the first element is the method 4033 If not, METHOD should be a list where the first element is the method
3573 and the second element is the address." 4034 and the second element is the address."
3574 (interactive 4035 (interactive
3575 (list (let ((how (completing-read 4036 (list (let ((how (completing-read
3576 "Which backend: " 4037 "Which back end: "
3577 (append gnus-valid-select-methods gnus-server-alist) 4038 (append gnus-valid-select-methods gnus-server-alist)
3578 nil t (cons "nntp" 0) 'gnus-method-history))) 4039 nil t (cons "nntp" 0) 'gnus-method-history)))
3579 ;; We either got a backend name or a virtual server name. 4040 ;; We either got a back end name or a virtual server name.
3580 ;; If the first, we also need an address. 4041 ;; If the first, we also need an address.
3581 (if (assoc how gnus-valid-select-methods) 4042 (if (assoc how gnus-valid-select-methods)
3582 (list (intern how) 4043 (list (intern how)
3583 ;; Suggested by mapjph@bath.ac.uk. 4044 ;; Suggested by mapjph@bath.ac.uk.
3584 (completing-read 4045 (completing-read
3640 (if entry 4101 (if entry
3641 (progn 4102 (progn
3642 (setcar (nthcdr 2 entry) info) 4103 (setcar (nthcdr 2 entry) info)
3643 (when (and (not (eq (car entry) t)) 4104 (when (and (not (eq (car entry) t))
3644 (gnus-active (gnus-info-group info))) 4105 (gnus-active (gnus-info-group info)))
3645 (setcar entry (length (gnus-list-of-unread-articles (car info)))))) 4106 (setcar entry (length
4107 (gnus-list-of-unread-articles (car info))))))
3646 (error "No such group: %s" (gnus-info-group info)))))) 4108 (error "No such group: %s" (gnus-info-group info))))))
3647 4109
3648 (defun gnus-group-set-method-info (group select-method) 4110 (defun gnus-group-set-method-info (group select-method)
3649 (gnus-group-set-info select-method group 'method)) 4111 (gnus-group-set-info select-method group 'method))
3650 4112
3675 (setcdr m (gnus-compress-sequence articles t))) 4137 (setcdr m (gnus-compress-sequence articles t)))
3676 (setcdr m (gnus-compress-sequence 4138 (setcdr m (gnus-compress-sequence
3677 (sort (nconc (gnus-uncompress-range (cdr m)) 4139 (sort (nconc (gnus-uncompress-range (cdr m))
3678 (copy-sequence articles)) '<) t)))))) 4140 (copy-sequence articles)) '<) t))))))
3679 4141
4142 (defun gnus-add-mark (group mark article)
4143 "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
4144 (let ((buffer (gnus-summary-buffer-name group)))
4145 (if (gnus-buffer-live-p buffer)
4146 (save-excursion
4147 (set-buffer (get-buffer buffer))
4148 (gnus-summary-add-mark article mark))
4149 (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
4150 (list article)))))
4151
3680 ;;; 4152 ;;;
3681 ;;; Group timestamps 4153 ;;; Group timestamps
3682 ;;; 4154 ;;;
3683 4155
3684 (defun gnus-group-set-timestamp () 4156 (defun gnus-group-set-timestamp ()
3696 4168
3697 (defun gnus-group-timestamp-delta (group) 4169 (defun gnus-group-timestamp-delta (group)
3698 "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." 4170 "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
3699 (let* ((time (or (gnus-group-timestamp group) 4171 (let* ((time (or (gnus-group-timestamp group)
3700 (list 0 0))) 4172 (list 0 0)))
3701 (delta (subtract-time (current-time) time))) 4173 (delta (subtract-time (current-time) time)))
3702 (+ (* (nth 0 delta) 65536.0) 4174 (+ (* (nth 0 delta) 65536.0)
3703 (nth 1 delta)))) 4175 (nth 1 delta))))
3704 4176
3705 (defun gnus-group-timestamp-string (group) 4177 (defun gnus-group-timestamp-string (group)
3706 "Return a string of the timestamp for GROUP." 4178 "Return a string of the timestamp for GROUP."
3707 (let ((time (gnus-group-timestamp group))) 4179 (let ((time (gnus-group-timestamp group)))
3708 (if (not time) 4180 (if (not time)
3709 "" 4181 ""
3710 (gnus-time-iso8601 time)))) 4182 (gnus-time-iso8601 time))))
3711 4183
3712 (defun gnus-group-prepare-flat-list-dead-predicate
3713 (groups level mark predicate)
3714 (let (group)
3715 (if predicate
3716 ;; This loop is used when listing groups that match some
3717 ;; regexp.
3718 (while (setq group (pop groups))
3719 (when (funcall predicate group)
3720 (gnus-add-text-properties
3721 (point) (prog1 (1+ (point))
3722 (insert " " mark " *: "
3723 (gnus-group-name-decode group
3724 (gnus-group-name-charset
3725 nil group))
3726 "\n"))
3727 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
3728 'gnus-unread t
3729 'gnus-level level)))))))
3730
3731 (defun gnus-group-prepare-flat-predicate (level predicate &optional lowest
3732 dead-predicate)
3733 "List all newsgroups with unread articles of level LEVEL or lower.
3734 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
3735 If PREDICATE, only list groups which PREDICATE returns non-nil.
3736 If DEAD-PREDICATE, list dead groups which DEAD-PREDICATE returns non-nil."
3737 (set-buffer gnus-group-buffer)
3738 (let ((buffer-read-only nil)
3739 (newsrc (cdr gnus-newsrc-alist))
3740 (lowest (or lowest 1))
3741 info clevel unread group params)
3742 (erase-buffer)
3743 ;; List living groups.
3744 (while newsrc
3745 (setq info (car newsrc)
3746 group (gnus-info-group info)
3747 params (gnus-info-params info)
3748 newsrc (cdr newsrc)
3749 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
3750 (and unread ; This group might be unchecked
3751 (funcall predicate info)
3752 (<= (setq clevel (gnus-info-level info)) level)
3753 (>= clevel lowest)
3754 (gnus-group-insert-group-line
3755 group (gnus-info-level info)
3756 (gnus-info-marks info) unread (gnus-info-method info))))
3757
3758 ;; List dead groups.
3759 (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
3760 (gnus-group-prepare-flat-list-dead-predicate
3761 (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
3762 gnus-level-zombie ?Z
3763 dead-predicate))
3764 (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
3765 (gnus-group-prepare-flat-list-dead-predicate
3766 (setq gnus-killed-list (sort gnus-killed-list 'string<))
3767 gnus-level-killed ?K dead-predicate))
3768
3769 (gnus-group-set-mode-line)
3770 (setq gnus-group-list-mode (cons level t))
3771 (gnus-run-hooks 'gnus-group-prepare-hook)
3772 t))
3773
3774 (defun gnus-group-list-cached (level &optional lowest) 4184 (defun gnus-group-list-cached (level &optional lowest)
3775 "List all groups with cached articles. 4185 "List all groups with cached articles.
3776 If the prefix LEVEL is non-nil, it should be a number that says which 4186 If the prefix LEVEL is non-nil, it should be a number that says which
3777 level to cut off listing groups. 4187 level to cut off listing groups.
3778 If LOWEST, don't list groups with level lower than LOWEST. 4188 If LOWEST, don't list groups with level lower than LOWEST.
3781 (interactive "P") 4191 (interactive "P")
3782 (when level 4192 (when level
3783 (setq level (prefix-numeric-value level))) 4193 (setq level (prefix-numeric-value level)))
3784 (when (or (not level) (>= level gnus-level-zombie)) 4194 (when (or (not level) (>= level gnus-level-zombie))
3785 (gnus-cache-open)) 4195 (gnus-cache-open))
3786 (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed) 4196 (funcall gnus-group-prepare-function
3787 #'(lambda (info) 4197 (or level gnus-level-subscribed)
3788 (let ((marks (gnus-info-marks info))) 4198 #'(lambda (info)
3789 (assq 'cache marks))) 4199 (let ((marks (gnus-info-marks info)))
3790 lowest 4200 (assq 'cache marks)))
3791 #'(lambda (group) 4201 lowest
3792 (or (gnus-gethash group 4202 #'(lambda (group)
3793 gnus-cache-active-hashtb) 4203 (or (gnus-gethash group
3794 ;; Cache active file might use "." 4204 gnus-cache-active-hashtb)
3795 ;; instead of ":". 4205 ;; Cache active file might use "."
3796 (gnus-gethash 4206 ;; instead of ":".
3797 (mapconcat 'identity 4207 (gnus-gethash
3798 (split-string group ":") 4208 (mapconcat 'identity
3799 ".") 4209 (split-string group ":")
3800 gnus-cache-active-hashtb)))) 4210 ".")
4211 gnus-cache-active-hashtb))))
3801 (goto-char (point-min)) 4212 (goto-char (point-min))
3802 (gnus-group-position-point)) 4213 (gnus-group-position-point))
3803 4214
3804 (defun gnus-group-list-dormant (level &optional lowest) 4215 (defun gnus-group-list-dormant (level &optional lowest)
3805 "List all groups with dormant articles. 4216 "List all groups with dormant articles.
3811 (interactive "P") 4222 (interactive "P")
3812 (when level 4223 (when level
3813 (setq level (prefix-numeric-value level))) 4224 (setq level (prefix-numeric-value level)))
3814 (when (or (not level) (>= level gnus-level-zombie)) 4225 (when (or (not level) (>= level gnus-level-zombie))
3815 (gnus-cache-open)) 4226 (gnus-cache-open))
3816 (gnus-group-prepare-flat-predicate (or level gnus-level-subscribed) 4227 (funcall gnus-group-prepare-function
3817 #'(lambda (info) 4228 (or level gnus-level-subscribed)
3818 (let ((marks (gnus-info-marks info))) 4229 #'(lambda (info)
3819 (assq 'dormant marks))) 4230 (let ((marks (gnus-info-marks info)))
3820 lowest) 4231 (assq 'dormant marks)))
4232 lowest
4233 'ignore)
3821 (goto-char (point-min)) 4234 (goto-char (point-min))
3822 (gnus-group-position-point)) 4235 (gnus-group-position-point))
3823 4236
4237 (defun gnus-group-listed-groups ()
4238 "Return a list of listed groups."
4239 (let (point groups)
4240 (goto-char (point-min))
4241 (while (setq point (text-property-not-all (point) (point-max)
4242 'gnus-group nil))
4243 (goto-char point)
4244 (push (symbol-name (get-text-property point 'gnus-group)) groups)
4245 (forward-char 1))
4246 groups))
4247
4248 (defun gnus-group-list-plus (&optional args)
4249 "List groups plus the current selection."
4250 (interactive "P")
4251 (let ((gnus-group-listed-groups (gnus-group-listed-groups))
4252 (gnus-group-list-mode gnus-group-list-mode) ;; Save it.
4253 func)
4254 (push last-command-event unread-command-events)
4255 (if (featurep 'xemacs)
4256 (push (make-event 'key-press '(key ?A)) unread-command-events)
4257 (push ?A unread-command-events))
4258 (let (gnus-pick-mode keys)
4259 (setq keys (if (featurep 'xemacs)
4260 (events-to-keys (read-key-sequence nil))
4261 (read-key-sequence nil)))
4262 (setq func (lookup-key (current-local-map) keys)))
4263 (if (or (not func)
4264 (numberp func))
4265 (ding)
4266 (call-interactively func))))
4267
4268 (defun gnus-group-list-flush (&optional args)
4269 "Flush groups from the current selection."
4270 (interactive "P")
4271 (let ((gnus-group-list-option 'flush))
4272 (gnus-group-list-plus args)))
4273
4274 (defun gnus-group-list-limit (&optional args)
4275 "List groups limited within the current selection."
4276 (interactive "P")
4277 (let ((gnus-group-list-option 'limit))
4278 (gnus-group-list-plus args)))
4279
4280 (defun gnus-group-mark-article-read (group article)
4281 "Mark ARTICLE read."
4282 (let ((buffer (gnus-summary-buffer-name group))
4283 (mark gnus-read-mark)
4284 active n)
4285 (if (get-buffer buffer)
4286 (with-current-buffer buffer
4287 (setq active gnus-newsgroup-active)
4288 (gnus-activate-group group)
4289 (when gnus-newsgroup-prepared
4290 (when (and gnus-newsgroup-auto-expire
4291 (memq mark gnus-auto-expirable-marks))
4292 (setq mark gnus-expirable-mark))
4293 (setq mark (gnus-request-update-mark
4294 group article mark))
4295 (gnus-mark-article-as-read article mark)
4296 (setq gnus-newsgroup-active (gnus-active group))
4297 (when active
4298 (setq n (1+ (cdr active)))
4299 (while (<= n (cdr gnus-newsgroup-active))
4300 (unless (eq n article)
4301 (push n gnus-newsgroup-unselected))
4302 (setq n (1+ n)))
4303 (setq gnus-newsgroup-unselected
4304 (nreverse gnus-newsgroup-unselected)))))
4305 (gnus-activate-group group)
4306 (gnus-group-make-articles-read group (list article))
4307 (when (gnus-group-auto-expirable-p group)
4308 (gnus-add-marked-articles
4309 group 'expire (list article))))))
4310
3824 (provide 'gnus-group) 4311 (provide 'gnus-group)
3825 4312
4313 ;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6
3826 ;;; gnus-group.el ends here 4314 ;;; gnus-group.el ends here