HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Update copyright notices for 2013.
[bpt/emacs.git] / lisp / gnus / gnus-group.el
CommitLineData
eec82323 1;;; gnus-group.el --- group mode commands for Gnus
e84b4b86 2
ab422c4d 3;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
eec82323 4
6748645f 5;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
eec82323
LMI		 6;; Keywords: news
7
8;; This file is part of GNU Emacs.
9
5e809f55 10;; GNU Emacs is free software: you can redistribute it and/or modify
eec82323 11;; it under the terms of the GNU General Public License as published by
5e809f55
GM		 12;; the Free Software Foundation, either version 3 of the License, or
13;; (at your option) any later version.
eec82323
LMI		 14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
5e809f55 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
eec82323
LMI		 18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
5e809f55 21;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
eec82323
LMI		 22
23;;; Commentary:
24
25;;; Code:
26
f0b7f5a8 27;; For Emacs <22.2 and XEmacs.
39c7e99d
GM		 28(eval-and-compile
29 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
30
23f87bed 31(eval-when-compile
9efa445f
DN		 32 (require 'cl))
33(defvar tool-bar-mode)
5ab7173c 34
eec82323
LMI		 35(require 'gnus)
36(require 'gnus-start)
37(require 'nnmail)
38(require 'gnus-spec)
39(require 'gnus-int)
40(require 'gnus-range)
41(require 'gnus-win)
42(require 'gnus-undo)
18c06a99 43(require 'gmm-utils)
16409b0b 44(require 'time-date)
23f87bed
MB		 45(require 'gnus-ems)
46
4a43ee9b
MB		 47(eval-when-compile
48 (require 'mm-url)
49 (let ((features (cons 'gnus-group features)))
50 (require 'gnus-sum))
01c52d31
MB		 51 (unless (boundp 'gnus-cache-active-hashtb)
52 (defvar gnus-cache-active-hashtb nil)))
53
54(autoload 'gnus-agent-total-fetched-for "gnus-agent")
55(autoload 'gnus-cache-total-fetched-for "gnus-cache")
eec82323 56
de635afe
G		 57(autoload 'gnus-group-make-nnir-group "nnir")
58
89b163db 59(defcustom gnus-no-groups-message "No news is good news"
eec82323
LMI		 60 "*Message displayed by Gnus when no groups are available."
61 :group 'gnus-start
62 :type 'string)
63
64(defcustom gnus-keep-same-level nil
65 "*Non-nil means that the next newsgroup after the current will be on the same level.
66When you type, for instance, `n' after reading the last article in the
67current newsgroup, you will go to the next newsgroup. If this variable
68is nil, the next newsgroup will be the next from the group
69buffer.
70If this variable is non-nil, Gnus will either put you in the
71next newsgroup with the same level, or, if no such newsgroup is
72available, the next newsgroup with the lowest possible level higher
73than the current level.
74If this variable is `best', Gnus will make the next newsgroup the one
75with the best level."
76 :group 'gnus-group-levels
77 :type '(choice (const nil)
78 (const best)
79 (sexp :tag "other" t)))
80
81(defcustom gnus-group-goto-unread t
82 "*If non-nil, movement commands will go to the next unread and subscribed group."
83 :link '(custom-manual "(gnus)Group Maneuvering")
84 :group 'gnus-group-various
85 :type 'boolean)
86
87(defcustom gnus-goto-next-group-when-activating t
88 "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group."
89 :link '(custom-manual "(gnus)Scanning New Messages")
90 :group 'gnus-group-various
91 :type 'boolean)
92
93(defcustom gnus-permanently-visible-groups nil
94 "*Regexp to match groups that should always be listed in the group buffer.
a8151ef7
LMI		 95This means that they will still be listed even when there are no
96unread articles in the groups.
97
98If nil, no groups are permanently visible."
eec82323 99 :group 'gnus-group-listing
eb284ea1 100 :type '(choice regexp (const nil)))
eec82323 101
b0b63450
MB		 102(defcustom gnus-safe-html-newsgroups "\\`nnrss[+:]"
103 "Groups in which links in html articles are considered all safe.
104The value may be a regexp matching those groups, a list of group names,
105or nil. This overrides `mm-w3m-safe-url-regexp' (which see). This is
106effective only when emacs-w3m renders html articles, i.e., in the case
107`mm-text-html-renderer' is set to `w3m'."
108 :version "23.2"
109 :group 'gnus-group-various
110 :type '(choice regexp
111 (repeat :tag "List of group names" (string :tag "Group"))
112 (const nil)))
113
eec82323
LMI		 114(defcustom gnus-list-groups-with-ticked-articles t
115 "*If non-nil, list groups that have only ticked articles.
116If nil, only list groups that have unread articles."
117 :group 'gnus-group-listing
118 :type 'boolean)
119
120(defcustom gnus-group-default-list-level gnus-level-subscribed
11a5db4a 121 "Default listing level.
eec82323
LMI		 122Ignored if `gnus-group-use-permanent-levels' is non-nil."
123 :group 'gnus-group-listing
11a5db4a
JD		 124 :type '(choice (integer :tag "Level")
125 (function :tag "Function returning level")))
eec82323
LMI		 126
127(defcustom gnus-group-list-inactive-groups t
128 "*If non-nil, inactive groups will be listed."
129 :group 'gnus-group-listing
130 :group 'gnus-group-levels
131 :type 'boolean)
132
133(defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet
134 "*Function used for sorting the group buffer.
135This function will be called with group info entries as the arguments
136for the groups to be sorted. Pre-made functions include
137`gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
138`gnus-group-sort-by-unread', `gnus-group-sort-by-level',
23f87bed
MB		 139`gnus-group-sort-by-score', `gnus-group-sort-by-method',
140`gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
eec82323 141
c30ba437 142This variable can also be a list of sorting functions. In that case,
eec82323
LMI		 143the most significant sort function should be the last function in the
144list."
145 :group 'gnus-group-listing
146 :link '(custom-manual "(gnus)Sorting Groups")
23f87bed
MB		 147 :type '(repeat :value-to-internal (lambda (widget value)
148 (if (listp value) value (list value)))
149 :match (lambda (widget value)
150 (or (symbolp value)
151 (widget-editable-list-match widget value)))
152 (choice (function-item gnus-group-sort-by-alphabet)
153 (function-item gnus-group-sort-by-real-name)
154 (function-item gnus-group-sort-by-unread)
155 (function-item gnus-group-sort-by-level)
156 (function-item gnus-group-sort-by-score)
157 (function-item gnus-group-sort-by-method)
158 (function-item gnus-group-sort-by-server)
159 (function-item gnus-group-sort-by-rank)
160 (function :tag "other" nil))))
161
e5500d2a 162(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)\n"
eec82323
LMI		 163 "*Format of group lines.
164It works along the same lines as a normal formatting string,
165with some simple extensions.
166
167%M Only marked articles (character, \"*\" or \" \")
168%S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
169%L Level of subscribedness (integer)
170%N Number of unread articles (integer)
171%I Number of dormant articles (integer)
172%i Number of ticked and dormant (integer)
173%T Number of ticked articles (integer)
174%R Number of read articles (integer)
23f87bed 175%U Number of unseen articles (integer)
eec82323
LMI		 176%t Estimated total number of articles (integer)
177%y Number of unread, unticked articles (integer)
178%G Group name (string)
179%g Qualified group name (string)
23f87bed
MB		 180%c Short (collapsed) group name. See `gnus-group-uncollapsed-levels'.
181%C Group comment (string)
eec82323
LMI		 182%D Group description (string)
183%s Select method (string)
184%o Moderated group (char, \"m\")
185%p Process mark (char)
23f87bed 186%B Whether a summary buffer for the group is open (char, \"*\")
eec82323
LMI		 187%O Moderated group (string, \"(m)\" or \"\")
188%P Topic indentation (string)
189%m Whether there is new(ish) mail in the group (char, \"%\")
eec82323
LMI		 190%n Select from where (string)
191%z A string that look like `<%s:%n>' if a foreign select method is used
192%d The date the group was last entered.
16409b0b 193%E Icon as defined by `gnus-group-icon-list'.
01c52d31 194%F The disk space used by the articles fetched by both the cache and agent.
eec82323
LMI		 195%u User defined specifier. The next character in the format string should
196 be a letter. Gnus will call the function gnus-user-format-function-X,
23f87bed
MB		 197 where X is the letter following %u. The function will be passed a
198 single dummy parameter as argument. The function should return a
199 string, which will be inserted into the buffer just like information
200 from any other group specifier.
eec82323
LMI		 201
202Note that this format specification is not always respected. For
203reasons of efficiency, when listing killed groups, this specification
c30ba437 204is ignored altogether. If the spec is changed considerably, your
eec82323
LMI		 205output may end up looking strange when listing both alive and killed
206groups.
207
208If you use %o or %O, reading the active file will be slower and quite
01c52d31
MB		 209a bit of extra memory will be used. %D and %F will also worsen
210performance. Also note that if you change the format specification to
211include any of these specs, you must probably re-start Gnus to see
212them go into effect.
23f87bed
MB		 213
214General format specifiers can also be used.
215See Info node `(gnus)Formatting Variables'."
216 :link '(custom-manual "(gnus)Formatting Variables")
eec82323
LMI		 217 :group 'gnus-group-visual
218 :type 'string)
219
220(defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
221 "*The format specification for the group mode line.
222It works along the same lines as a normal formatting string,
223with some simple extensions:
224
225%S The native news server.
226%M The native select method.
227%: \":\" if %S isn't \"\"."
228 :group 'gnus-group-visual
229 :type 'string)
230
23f87bed
MB		 231;; Extracted from gnus-xmas-redefine in order to preserve user settings
232(when (featurep 'xemacs)
233 (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
234 (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
eec82323
LMI		 235
236(defcustom gnus-group-menu-hook nil
237 "Hook run after the creation of the group mode menu."
238 :group 'gnus-group-various
239 :type 'hook)
240
241(defcustom gnus-group-catchup-group-hook nil
242 "Hook run when catching up a group from the group buffer."
243 :group 'gnus-group-various
244 :link '(custom-manual "(gnus)Group Data")
245 :type 'hook)
246
247(defcustom gnus-group-update-group-hook nil
248 "Hook called when updating group lines."
249 :group 'gnus-group-visual
250 :type 'hook)
251
252(defcustom gnus-group-prepare-function 'gnus-group-prepare-flat
253 "*A function that is called to generate the group buffer.
254The function is called with three arguments: The first is a number;
255all group with a level less or equal to that number should be listed,
256if the second is non-nil, empty groups should also be displayed. If
257the third is non-nil, it is a number. No groups with a level lower
258than this number should be displayed.
259
260The only current function implemented is `gnus-group-prepare-flat'."
261 :group 'gnus-group-listing
262 :type 'function)
263
264(defcustom gnus-group-prepare-hook nil
265 "Hook called after the group buffer has been generated.
266If you want to modify the group buffer, you can use this hook."
267 :group 'gnus-group-listing
268 :type 'hook)
269
270(defcustom gnus-suspend-gnus-hook nil
271 "Hook called when suspending (not exiting) Gnus."
272 :group 'gnus-exit
273 :type 'hook)
274
275(defcustom gnus-exit-gnus-hook nil
276 "Hook called when exiting Gnus."
277 :group 'gnus-exit
278 :type 'hook)
279
280(defcustom gnus-after-exiting-gnus-hook nil
281 "Hook called after exiting Gnus."
282 :group 'gnus-exit
283 :type 'hook)
284
b069e5a6
G		 285(defcustom gnus-group-update-hook nil
286 "Hook called when a group line is changed."
eec82323 287 :group 'gnus-group-visual
7228f056 288 :version "24.1"
eec82323
LMI		 289 :type 'hook)
290
291(defcustom gnus-useful-groups
7dafe00b
MB		 292 '(("(ding) mailing list mirrored at gmane.org"
293 "gmane.emacs.gnus.general"
294 (nntp "Gmane"
295 (nntp-address "news.gmane.org")))
296 ("Gnus bug archive"
297 "gnus.gnus-bug"
298 (nntp "news.gnus.org"
299 (nntp-address "news.gnus.org")))
300 ("Local Gnus help group"
eec82323
LMI		 301 "gnus-help"
302 (nndoc "gnus-help"
303 (nndoc-article-type mbox)
304 (eval `(nndoc-address
305 ,(let ((file (nnheader-find-etc-directory
306 "gnus-tut.txt" t)))
307 (unless file
308 (error "Couldn't find doc group"))
309 file))))))
6748645f 310 "*Alist of useful group-server pairs."
eec82323
LMI		 311 :group 'gnus-group-listing
312 :type '(repeat (list (string :tag "Description")
313 (string :tag "Name")
314 (sexp :tag "Method"))))
315
316(defcustom gnus-group-highlight
23f87bed
MB		 317 '(;; Mail.
318 ((and mailp (= unread 0) (eq level 1)) .
0f49874b 319 gnus-group-mail-1-empty)
23f87bed 320 ((and mailp (eq level 1)) .
0f49874b 321 gnus-group-mail-1)
23f87bed 322 ((and mailp (= unread 0) (eq level 2)) .
0f49874b 323 gnus-group-mail-2-empty)
23f87bed 324 ((and mailp (eq level 2)) .
0f49874b 325 gnus-group-mail-2)
23f87bed 326 ((and mailp (= unread 0) (eq level 3)) .
0f49874b 327 gnus-group-mail-3-empty)
23f87bed 328 ((and mailp (eq level 3)) .
0f49874b 329 gnus-group-mail-3)
23f87bed 330 ((and mailp (= unread 0)) .
0f49874b 331 gnus-group-mail-low-empty)
23f87bed 332 ((and mailp) .
0f49874b 333 gnus-group-mail-low)
23f87bed
MB		 334 ;; News.
335 ((and (= unread 0) (eq level 1)) .
0f49874b 336 gnus-group-news-1-empty)
23f87bed 337 ((and (eq level 1)) .
0f49874b 338 gnus-group-news-1)
23f87bed 339 ((and (= unread 0) (eq level 2)) .
0f49874b 340 gnus-group-news-2-empty)
23f87bed 341 ((and (eq level 2)) .
0f49874b 342 gnus-group-news-2)
23f87bed 343 ((and (= unread 0) (eq level 3)) .
0f49874b 344 gnus-group-news-3-empty)
23f87bed 345 ((and (eq level 3)) .
0f49874b 346 gnus-group-news-3)
23f87bed 347 ((and (= unread 0) (eq level 4)) .
0f49874b 348 gnus-group-news-4-empty)
23f87bed 349 ((and (eq level 4)) .
0f49874b 350 gnus-group-news-4)
23f87bed 351 ((and (= unread 0) (eq level 5)) .
0f49874b 352 gnus-group-news-5-empty)
23f87bed 353 ((and (eq level 5)) .
0f49874b 354 gnus-group-news-5)
23f87bed 355 ((and (= unread 0) (eq level 6)) .
0f49874b 356 gnus-group-news-6-empty)
23f87bed 357 ((and (eq level 6)) .
0f49874b 358 gnus-group-news-6)
23f87bed 359 ((and (= unread 0)) .
0f49874b 360 gnus-group-news-low-empty)
eec82323 361 (t .
0f49874b 362 gnus-group-news-low))
6748645f 363 "*Controls the highlighting of group buffer lines.
eec82323 364
20db1522 365Below is a list of `Form'/`Face' pairs. When deciding how a
eec82323
LMI		 366particular group line should be displayed, each form is
367evaluated. The content of the face field after the first true form is
368used. You can change how those group lines are displayed by
369editing the face field.
370
371It is also possible to change and add form fields, but currently that
372requires an understanding of Lisp expressions. Hopefully this will
373change in a future release. For now, you can use the following
374variables in the Lisp expression:
375
376group: The name of the group.
377unread: The number of unread articles in the group.
378method: The select method used.
379mailp: Whether it's a mail group or not.
380level: The level of the group.
381score: The score of the group.
382ticked: The number of ticked articles."
383 :group 'gnus-group-visual
384 :type '(repeat (cons (sexp :tag "Form") face)))
4b576f7d 385(put 'gnus-group-highlight 'risky-local-variable t)
eec82323
LMI		 386
387(defcustom gnus-new-mail-mark ?%
388 "Mark used for groups with new mail."
389 :group 'gnus-group-visual
390 :type 'character)
391
16409b0b 392(defgroup gnus-group-icons nil
d10edbae 393 "Add Icons to your group buffer."
16409b0b
GM		 394 :group 'gnus-group-visual)
395
396(defcustom gnus-group-icon-list
397 nil
398 "*Controls the insertion of icons into group buffer lines.
399
400Below is a list of `Form'/`File' pairs. When deciding how a
401particular group line should be displayed, each form is evaluated.
402The icon from the file field after the first true form is used. You
403can change how those group lines are displayed by editing the file
404field. The File will either be found in the
35ef97a5 405`gnus-group-glyph-directory' or by designating absolute name of the
16409b0b
GM		 406file.
407
408It is also possible to change and add form fields, but currently that
409requires an understanding of Lisp expressions. Hopefully this will
410change in a future release. For now, you can use the following
411variables in the Lisp expression:
412
413group: The name of the group.
414unread: The number of unread articles in the group.
415method: The select method used.
416mailp: Whether it's a mail group or not.
16409b0b
GM		 417level: The level of the group.
418score: The score of the group.
419ticked: The number of ticked articles."
420 :group 'gnus-group-icons
421 :type '(repeat (cons (sexp :tag "Form") file)))
60ece9b0 422(put 'gnus-group-icon-list 'risky-local-variable t)
16409b0b
GM		 423
424(defcustom gnus-group-name-charset-method-alist nil
23f87bed 425 "Alist of method and the charset for group names.
16409b0b
GM		 426
427For example:
23f87bed 428 (((nntp \"news.com.cn\") . cn-gb-2312))"
5002cc5c 429 :version "21.1"
16409b0b
GM		 430 :group 'gnus-charset
431 :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
432
23f87bed
MB		 433(defcustom gnus-group-name-charset-group-alist
434 (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
435 (mm-coding-system-p 'utf-8))
436 '((".*" . utf-8))
437 nil)
438 "Alist of group regexp and the charset for group names.
16409b0b
GM		 439
440For example:
23f87bed 441 ((\"\\.com\\.cn:\" . cn-gb-2312))"
16409b0b
GM		 442 :group 'gnus-charset
443 :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
444
23f87bed
MB		 445(defcustom gnus-group-jump-to-group-prompt nil
446 "Default prompt for `gnus-group-jump-to-group'.
01c52d31
MB		 447
448If non-nil, the value should be a string or an alist. If it is a string,
449e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group:
450nnml:\" in the minibuffer prompt.
451
452If it is an alist, it must consist of \(NUMBER . PROMPT\) pairs, for example:
453\((1 . \"\") (2 . \"nnfolder+archive:\")). The element with number 0 is
454used when no prefix argument is given to `gnus-group-jump-to-group'."
bf247b6e 455 :version "22.1"
23f87bed
MB		 456 :group 'gnus-group-various
457 :type '(choice (string :tag "Prompt string")
01c52d31
MB		 458 (const :tag "Empty" nil)
459 (repeat (cons (integer :tag "Argument")
460 (string :tag "Prompt string")))))
23f87bed
MB		 461
462(defvar gnus-group-listing-limit 1000
463 "*A limit of the number of groups when listing.
464If the number of groups is larger than the limit, list them in a
465simple manner.")
466
eec82323
LMI		 467;;; Internal variables
468
23f87bed
MB		 469(defvar gnus-group-is-exiting-p nil)
470(defvar gnus-group-is-exiting-without-update-p nil)
eec82323
LMI		 471(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
472 "Function for sorting the group buffer.")
473
474(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
475 "Function for sorting the selected groups in the group buffer.")
476
477(defvar gnus-group-indentation-function nil)
478(defvar gnus-goto-missing-group-function nil)
479(defvar gnus-group-update-group-function nil)
480(defvar gnus-group-goto-next-group-function nil
481 "Function to override finding the next group after listing groups.")
482
483(defvar gnus-group-edit-buffer nil)
484
485(defvar gnus-group-line-format-alist
486 `((?M gnus-tmp-marked-mark ?c)
487 (?S gnus-tmp-subscribed ?c)
488 (?L gnus-tmp-level ?d)
489 (?N (cond ((eq number t) "*" )
490 ((numberp number)
491 (int-to-string
492 (+ number
493 (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
494 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
495 (t number)) ?s)
496 (?R gnus-tmp-number-of-read ?s)
0617bb00
LMI		 497 (?U (if (gnus-active gnus-tmp-group)
498 (gnus-number-of-unseen-articles-in-group gnus-tmp-group)
499 "*")
500 ?s)
eec82323
LMI		 501 (?t gnus-tmp-number-total ?d)
502 (?y gnus-tmp-number-of-unread ?s)
503 (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
504 (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
505 (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
506 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
91472578
MB		 507 (?g (if (boundp 'gnus-tmp-decoded-group)
508 gnus-tmp-decoded-group
509 gnus-tmp-group)
510 ?s)
eec82323 511 (?G gnus-tmp-qualified-group ?s)
91472578
MB		 512 (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
513 gnus-tmp-decoded-group
514 gnus-tmp-group))
515 ?s)
23f87bed 516 (?C gnus-tmp-comment ?s)
eec82323
LMI		 517 (?D gnus-tmp-newsgroup-description ?s)
518 (?o gnus-tmp-moderated ?c)
519 (?O gnus-tmp-moderated-string ?s)
520 (?p gnus-tmp-process-marked ?c)
521 (?s gnus-tmp-news-server ?s)
5153a47a
MB		 522 (?n ,(if (featurep 'xemacs)
523 '(symbol-name gnus-tmp-news-method)
524 'gnus-tmp-news-method)
525 ?s)
eec82323 526 (?P gnus-group-indentation ?s)
16409b0b 527 (?E gnus-tmp-group-icon ?s)
23f87bed 528 (?B gnus-tmp-summary-live ?c)
eec82323
LMI		 529 (?z gnus-tmp-news-method-string ?s)
530 (?m (gnus-group-new-mail gnus-tmp-group) ?c)
531 (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
01c52d31
MB		 532 (?u gnus-tmp-user-defined ?s)
533 (?F (gnus-total-fetched-for gnus-tmp-group) ?s)
534 ))
eec82323
LMI		 535
536(defvar gnus-group-mode-line-format-alist
537 `((?S gnus-tmp-news-server ?s)
538 (?M gnus-tmp-news-method ?s)
539 (?u gnus-tmp-user-defined ?s)
540 (?: gnus-tmp-colon ?s)))
541
542(defvar gnus-topic-topology nil
543 "The complete topic hierarchy.")
544
545(defvar gnus-topic-alist nil
546 "The complete topic-group alist.")
547
548(defvar gnus-group-marked nil)
549
550(defvar gnus-group-list-mode nil)
551
16409b0b 552
23f87bed
MB		 553(defvar gnus-group-listed-groups nil)
554(defvar gnus-group-list-option nil)
555
eec82323
LMI		 556;;;
557;;; Gnus group mode
558;;;
559
560(put 'gnus-group-mode 'mode-class 'special)
561
23f87bed
MB		 562(gnus-define-keys gnus-group-mode-map
563 " " gnus-group-read-group
564 "=" gnus-group-select-group
565 "\r" gnus-group-select-group
566 "\M-\r" gnus-group-quick-select-group
567 "\M- " gnus-group-visible-select-group
568 [(meta control return)] gnus-group-select-group-ephemerally
569 "j" gnus-group-jump-to-group
570 "n" gnus-group-next-unread-group
571 "p" gnus-group-prev-unread-group
572 "\177" gnus-group-prev-unread-group
573 [delete] gnus-group-prev-unread-group
574 [backspace] gnus-group-prev-unread-group
575 "N" gnus-group-next-group
576 "P" gnus-group-prev-group
577 "\M-n" gnus-group-next-unread-group-same-level
578 "\M-p" gnus-group-prev-unread-group-same-level
579 "," gnus-group-best-unread-group
580 "." gnus-group-first-unread-group
581 "u" gnus-group-unsubscribe-current-group
582 "U" gnus-group-unsubscribe-group
583 "c" gnus-group-catchup-current
584 "C" gnus-group-catchup-current-all
585 "\M-c" gnus-group-clear-data
586 "l" gnus-group-list-groups
587 "L" gnus-group-list-all-groups
588 "m" gnus-group-mail
589 "i" gnus-group-news
590 "g" gnus-group-get-new-news
591 "\M-g" gnus-group-get-new-news-this-group
592 "R" gnus-group-restart
593 "r" gnus-group-read-init-file
594 "B" gnus-group-browse-foreign-server
595 "b" gnus-group-check-bogus-groups
596 "F" gnus-group-find-new-groups
597 "\C-c\C-d" gnus-group-describe-group
598 "\M-d" gnus-group-describe-all-groups
599 "\C-c\C-a" gnus-group-apropos
600 "\C-c\M-\C-a" gnus-group-description-apropos
601 "a" gnus-group-post-news
602 "\ek" gnus-group-edit-local-kill
603 "\eK" gnus-group-edit-global-kill
604 "\C-k" gnus-group-kill-group
605 "\C-y" gnus-group-yank-group
606 "\C-w" gnus-group-kill-region
607 "\C-x\C-t" gnus-group-transpose-groups
608 "\C-c\C-l" gnus-group-list-killed
609 "\C-c\C-x" gnus-group-expire-articles
610 "\C-c\M-\C-x" gnus-group-expire-all-groups
611 "V" gnus-version
612 "s" gnus-group-save-newsrc
613 "z" gnus-group-suspend
614 "q" gnus-group-exit
615 "Q" gnus-group-quit
616 "?" gnus-group-describe-briefly
617 "\C-c\C-i" gnus-info-find-node
618 "\M-e" gnus-group-edit-group-method
619 "^" gnus-group-enter-server-mode
620 gnus-mouse-2 gnus-mouse-pick-group
1c497624 621 [follow-link] mouse-face
23f87bed
MB		 622 "<" beginning-of-buffer
623 ">" end-of-buffer
624 "\C-c\C-b" gnus-bug
625 "\C-c\C-s" gnus-group-sort-groups
626 "t" gnus-topic-mode
627 "\C-c\M-g" gnus-activate-all-groups
628 "\M-&" gnus-group-universal-argument
629 "#" gnus-group-mark-group
630 "\M-#" gnus-group-unmark-group)
631
632(gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
633 "m" gnus-group-mark-group
634 "u" gnus-group-unmark-group
635 "w" gnus-group-mark-region
636 "b" gnus-group-mark-buffer
637 "r" gnus-group-mark-regexp
638 "U" gnus-group-unmark-all-groups)
639
640(gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
641 "u" gnus-sieve-update
642 "g" gnus-sieve-generate)
643
644(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
645 "d" gnus-group-make-directory-group
646 "h" gnus-group-make-help-group
647 "u" gnus-group-make-useful-group
23f87bed
MB		 648 "l" gnus-group-nnimap-edit-acl
649 "m" gnus-group-make-group
650 "E" gnus-group-edit-group
651 "e" gnus-group-edit-group-method
652 "p" gnus-group-edit-group-parameters
653 "v" gnus-group-add-to-virtual
654 "V" gnus-group-make-empty-virtual
655 "D" gnus-group-enter-directory
656 "f" gnus-group-make-doc-group
657 "w" gnus-group-make-web-group
de635afe 658 "G" gnus-group-make-nnir-group
23f87bed
MB		 659 "M" gnus-group-read-ephemeral-group
660 "r" gnus-group-rename-group
661 "R" gnus-group-make-rss-group
662 "c" gnus-group-customize
01c52d31 663 "z" gnus-group-compact-group
0617bb00 664 "x" gnus-group-expunge-group
23f87bed
MB		 665 "\177" gnus-group-delete-group
666 [delete] gnus-group-delete-group)
667
23f87bed
MB		 668(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
669 "s" gnus-group-sort-groups
670 "a" gnus-group-sort-groups-by-alphabet
671 "u" gnus-group-sort-groups-by-unread
672 "l" gnus-group-sort-groups-by-level
673 "v" gnus-group-sort-groups-by-score
674 "r" gnus-group-sort-groups-by-rank
675 "m" gnus-group-sort-groups-by-method
676 "n" gnus-group-sort-groups-by-real-name)
677
678(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
679 "s" gnus-group-sort-selected-groups
680 "a" gnus-group-sort-selected-groups-by-alphabet
681 "u" gnus-group-sort-selected-groups-by-unread
682 "l" gnus-group-sort-selected-groups-by-level
683 "v" gnus-group-sort-selected-groups-by-score
684 "r" gnus-group-sort-selected-groups-by-rank
685 "m" gnus-group-sort-selected-groups-by-method
686 "n" gnus-group-sort-selected-groups-by-real-name)
687
688(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
689 "k" gnus-group-list-killed
690 "z" gnus-group-list-zombies
691 "s" gnus-group-list-groups
692 "u" gnus-group-list-all-groups
693 "A" gnus-group-list-active
694 "a" gnus-group-apropos
695 "d" gnus-group-description-apropos
696 "m" gnus-group-list-matching
697 "M" gnus-group-list-all-matching
698 "l" gnus-group-list-level
699 "c" gnus-group-list-cached
1518e4f0
G		 700 "?" gnus-group-list-dormant
701 "!" gnus-group-list-ticked)
23f87bed
MB		 702
703(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
704 "k" gnus-group-list-limit
705 "z" gnus-group-list-limit
706 "s" gnus-group-list-limit
707 "u" gnus-group-list-limit
708 "A" gnus-group-list-limit
709 "m" gnus-group-list-limit
710 "M" gnus-group-list-limit
711 "l" gnus-group-list-limit
712 "c" gnus-group-list-limit
be00b56e
AC		 713 "?" gnus-group-list-limit
714 "!" gnus-group-list-limit)
23f87bed
MB		 715
716(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
717 "k" gnus-group-list-flush
718 "z" gnus-group-list-flush
719 "s" gnus-group-list-flush
720 "u" gnus-group-list-flush
721 "A" gnus-group-list-flush
722 "m" gnus-group-list-flush
723 "M" gnus-group-list-flush
724 "l" gnus-group-list-flush
725 "c" gnus-group-list-flush
be00b56e
AC		 726 "?" gnus-group-list-flush
727 "!" gnus-group-list-flush)
23f87bed
MB		 728
729(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
730 "k" gnus-group-list-plus
731 "z" gnus-group-list-plus
732 "s" gnus-group-list-plus
733 "u" gnus-group-list-plus
734 "A" gnus-group-list-plus
735 "m" gnus-group-list-plus
736 "M" gnus-group-list-plus
737 "l" gnus-group-list-plus
738 "c" gnus-group-list-plus
be00b56e
AC		 739 "?" gnus-group-list-plus
740 "!" gnus-group-list-plus)
23f87bed
MB		 741
742(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
01c52d31
MB		 743 "f" gnus-score-flush-cache
744 "e" gnus-score-edit-all-score)
23f87bed
MB		 745
746(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
23f87bed 747 "d" gnus-group-describe-group
23f87bed
MB		 748 "v" gnus-version)
749
750(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
751 "l" gnus-group-set-current-level
752 "t" gnus-group-unsubscribe-current-group
753 "s" gnus-group-unsubscribe-group
754 "k" gnus-group-kill-group
755 "y" gnus-group-yank-group
756 "w" gnus-group-kill-region
757 "\C-k" gnus-group-kill-level
758 "z" gnus-group-kill-all-zombies)
759
760(defun gnus-topic-mode-p ()
761 "Return non-nil in `gnus-topic-mode'."
762 (and (boundp 'gnus-topic-mode)
763 (symbol-value 'gnus-topic-mode)))
eec82323
LMI		 764
765(defun gnus-group-make-menu-bar ()
eec82323
LMI		 766 (unless (boundp 'gnus-group-reading-menu)
767
768 (easy-menu-define
769 gnus-group-reading-menu gnus-group-mode-map ""
23f87bed
MB		 770 `("Group"
771 ["Read" gnus-group-read-group
772 :included (not (gnus-topic-mode-p))
773 :active (gnus-group-group-name)]
774 ["Read " gnus-topic-read-group
775 :included (gnus-topic-mode-p)]
776 ["Select" gnus-group-select-group
777 :included (not (gnus-topic-mode-p))
778 :active (gnus-group-group-name)]
779 ["Select " gnus-topic-select-group
780 :included (gnus-topic-mode-p)]
eec82323
LMI		 781 ["See old articles" (gnus-group-select-group 'all)
782 :keys "C-u SPC" :active (gnus-group-group-name)]
23f87bed
MB		 783 ["Catch up" gnus-group-catchup-current
784 :included (not (gnus-topic-mode-p))
785 :active (gnus-group-group-name)
786 ,@(if (featurep 'xemacs) nil
787 '(:help "Mark unread articles in the current group as read"))]
788 ["Catch up " gnus-topic-catchup-articles
789 :included (gnus-topic-mode-p)
790 ,@(if (featurep 'xemacs) nil
791 '(:help "Mark unread articles in the current group or topic as read"))]
eec82323
LMI		 792 ["Catch up all articles" gnus-group-catchup-current-all
793 (gnus-group-group-name)]
794 ["Check for new articles" gnus-group-get-new-news-this-group
23f87bed 795 :included (not (gnus-topic-mode-p))
84b9b23e 796 :active (gnus-group-group-name)
23f87bed
MB		 797 ,@(if (featurep 'xemacs) nil
798 '(:help "Check for new messages in current group"))]
799 ["Check for new articles " gnus-topic-get-new-news-this-topic
800 :included (gnus-topic-mode-p)
801 ,@(if (featurep 'xemacs) nil
802 '(:help "Check for new messages in current group or topic"))]
eec82323
LMI		 803 ["Toggle subscription" gnus-group-unsubscribe-current-group
804 (gnus-group-group-name)]
84b9b23e 805 ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
23f87bed
MB		 806 ,@(if (featurep 'xemacs) nil
807 '(:help "Kill (remove) current group"))]
eec82323 808 ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
84b9b23e 809 ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
23f87bed
MB		 810 ,@(if (featurep 'xemacs) nil
811 '(:help "Display description of the current group"))]
eec82323
LMI		 812 ;; Actually one should check, if any of the marked groups gives t for
813 ;; (gnus-check-backend-function 'request-expire-articles ...)
814 ["Expire articles" gnus-group-expire-articles
23f87bed
MB		 815 :included (not (gnus-topic-mode-p))
816 :active (or (and (gnus-group-group-name)
817 (gnus-check-backend-function
818 'request-expire-articles
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
eec82323
LMI		 823 (gnus-group-group-name)]
824 ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
825 ["Customize" gnus-group-customize (gnus-group-group-name)]
01c52d31
MB		 826 ["Compact" gnus-group-compact-group
827 :active (gnus-group-group-name)]
eec82323
LMI		 828 ("Edit"
829 ["Parameters" gnus-group-edit-group-parameters
23f87bed
MB		 830 :included (not (gnus-topic-mode-p))
831 :active (gnus-group-group-name)]
832 ["Parameters " gnus-topic-edit-parameters
833 :included (gnus-topic-mode-p)]
eec82323
LMI		 834 ["Select method" gnus-group-edit-group-method
835 (gnus-group-group-name)]
836 ["Info" gnus-group-edit-group (gnus-group-group-name)]
837 ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
a8151ef7 838 ["Global kill file" gnus-group-edit-global-kill t])))
eec82323
LMI		 839
840 (easy-menu-define
841 gnus-group-group-menu gnus-group-mode-map ""
842 '("Groups"
843 ("Listing"
844 ["List unread subscribed groups" gnus-group-list-groups t]
845 ["List (un)subscribed groups" gnus-group-list-all-groups t]
846 ["List killed groups" gnus-group-list-killed gnus-killed-list]
847 ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
848 ["List level..." gnus-group-list-level t]
849 ["Describe all groups" gnus-group-describe-all-groups t]
850 ["Group apropos..." gnus-group-apropos t]
851 ["Group and description apropos..." gnus-group-description-apropos t]
852 ["List groups matching..." gnus-group-list-matching t]
853 ["List all groups matching..." gnus-group-list-all-matching t]
16409b0b
GM		 854 ["List active file" gnus-group-list-active t]
855 ["List groups with cached" gnus-group-list-cached t]
1518e4f0
G		 856 ["List groups with dormant" gnus-group-list-dormant t]
857 ["List groups with ticked" gnus-group-list-ticked t])
eec82323
LMI		 858 ("Sort"
859 ["Default sort" gnus-group-sort-groups t]
860 ["Sort by method" gnus-group-sort-groups-by-method t]
861 ["Sort by rank" gnus-group-sort-groups-by-rank t]
862 ["Sort by score" gnus-group-sort-groups-by-score t]
863 ["Sort by level" gnus-group-sort-groups-by-level t]
864 ["Sort by unread" gnus-group-sort-groups-by-unread t]
23f87bed
MB		 865 ["Sort by name" gnus-group-sort-groups-by-alphabet t]
866 ["Sort by real name" gnus-group-sort-groups-by-real-name t])
eec82323
LMI		 867 ("Sort process/prefixed"
868 ["Default sort" gnus-group-sort-selected-groups
23f87bed 869 (not (gnus-topic-mode-p))]
eec82323 870 ["Sort by method" gnus-group-sort-selected-groups-by-method
23f87bed 871 (not (gnus-topic-mode-p))]
eec82323 872 ["Sort by rank" gnus-group-sort-selected-groups-by-rank
23f87bed 873 (not (gnus-topic-mode-p))]
eec82323 874 ["Sort by score" gnus-group-sort-selected-groups-by-score
23f87bed 875 (not (gnus-topic-mode-p))]
eec82323 876 ["Sort by level" gnus-group-sort-selected-groups-by-level
23f87bed 877 (not (gnus-topic-mode-p))]
eec82323 878 ["Sort by unread" gnus-group-sort-selected-groups-by-unread
23f87bed 879 (not (gnus-topic-mode-p))]
eec82323 880 ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
23f87bed
MB		 881 (not (gnus-topic-mode-p))]
882 ["Sort by real name" gnus-group-sort-selected-groups-by-real-name
883 (not (gnus-topic-mode-p))])
eec82323
LMI		 884 ("Mark"
885 ["Mark group" gnus-group-mark-group
886 (and (gnus-group-group-name)
887 (not (memq (gnus-group-group-name) gnus-group-marked)))]
888 ["Unmark group" gnus-group-unmark-group
889 (and (gnus-group-group-name)
890 (memq (gnus-group-group-name) gnus-group-marked))]
891 ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
892 ["Mark regexp..." gnus-group-mark-regexp t]
23f87bed 893 ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
eec82323
LMI		 894 ["Mark buffer" gnus-group-mark-buffer t]
895 ["Execute command" gnus-group-universal-argument
896 (or gnus-group-marked (gnus-group-group-name))])
897 ("Subscribe"
23f87bed
MB		 898 ["Subscribe to a group..." gnus-group-unsubscribe-group t]
899 ["Kill all newsgroups in region" gnus-group-kill-region
900 :active (gnus-mark-active-p)]
eec82323
LMI		 901 ["Kill all zombie groups" gnus-group-kill-all-zombies
902 gnus-zombie-list]
903 ["Kill all groups on level..." gnus-group-kill-level t])
904 ("Foreign groups"
23f87bed
MB		 905 ["Make a foreign group..." gnus-group-make-group t]
906 ["Add a directory group..." gnus-group-make-directory-group t]
eec82323 907 ["Add the help group" gnus-group-make-help-group t]
23f87bed
MB		 908 ["Make a doc group..." gnus-group-make-doc-group t]
909 ["Make a web group..." gnus-group-make-web-group t]
de635afe 910 ["Make a search group..." gnus-group-make-nnir-group t]
23f87bed
MB		 911 ["Make a virtual group..." gnus-group-make-empty-virtual t]
912 ["Add a group to a virtual..." gnus-group-add-to-virtual t]
913 ["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
914 ["Make an RSS group..." gnus-group-make-rss-group t]
915 ["Rename group..." gnus-group-rename-group
eec82323
LMI		 916 (gnus-check-backend-function
917 'request-rename-group (gnus-group-group-name))]
918 ["Delete group" gnus-group-delete-group
919 (gnus-check-backend-function
920 'request-delete-group (gnus-group-group-name))])
921 ("Move"
922 ["Next" gnus-group-next-group t]
923 ["Previous" gnus-group-prev-group t]
924 ["Next unread" gnus-group-next-unread-group t]
925 ["Previous unread" gnus-group-prev-unread-group t]
926 ["Next unread same level" gnus-group-next-unread-group-same-level t]
927 ["Previous unread same level"
928 gnus-group-prev-unread-group-same-level t]
23f87bed 929 ["Jump to group..." gnus-group-jump-to-group t]
eec82323
LMI		 930 ["First unread group" gnus-group-first-unread-group t]
931 ["Best unread group" gnus-group-best-unread-group t])
23f87bed
MB		 932 ("Sieve"
933 ["Generate" gnus-sieve-generate t]
934 ["Generate and update" gnus-sieve-update t])
eec82323 935 ["Delete bogus groups" gnus-group-check-bogus-groups t]
a8151ef7 936 ["Find new newsgroups" gnus-group-find-new-groups t]
eec82323
LMI		 937 ["Transpose" gnus-group-transpose-groups
938 (gnus-group-group-name)]
a8151ef7 939 ["Read a directory as a group..." gnus-group-enter-directory t]))
eec82323
LMI		 940
941 (easy-menu-define
942 gnus-group-misc-menu gnus-group-mode-map ""
23f87bed 943 `("Gnus"
eec82323 944 ["Send a mail" gnus-group-mail t]
23f87bed
MB		 945 ["Send a message (mail or news)" gnus-group-post-news t]
946 ["Create a local message" gnus-group-news t]
84b9b23e 947 ["Check for new news" gnus-group-get-new-news
23f87bed
MB		 948 ,@(if (featurep 'xemacs) '(t)
949 '(:help "Get newly arrived articles"))
950 ]
951 ["Send queued messages" gnus-delay-send-queue
952 ,@(if (featurep 'xemacs) '(t)
953 '(:help "Send all messages that are scheduled to be sent now"))
954 ]
eec82323
LMI		 955 ["Activate all groups" gnus-activate-all-groups t]
956 ["Restart Gnus" gnus-group-restart t]
957 ["Read init file" gnus-group-read-init-file t]
23f87bed 958 ["Browse foreign server..." gnus-group-browse-foreign-server t]
eec82323
LMI		 959 ["Enter server buffer" gnus-group-enter-server-mode t]
960 ["Expire all expirable articles" gnus-group-expire-all-groups t]
eec82323
LMI		 961 ["Gnus version" gnus-version t]
962 ["Save .newsrc files" gnus-group-save-newsrc t]
963 ["Suspend Gnus" gnus-group-suspend t]
964 ["Clear dribble buffer" gnus-group-clear-dribble t]
965 ["Read manual" gnus-info-find-node t]
966 ["Flush score cache" gnus-score-flush-cache t]
967 ["Toggle topics" gnus-topic-mode t]
6748645f 968 ["Send a bug report" gnus-bug t]
84b9b23e 969 ["Exit from Gnus" gnus-group-exit
23f87bed
MB		 970 ,@(if (featurep 'xemacs) '(t)
971 '(:help "Quit reading news"))]
a8151ef7 972 ["Exit without saving" gnus-group-quit t]))
eec82323 973
6748645f 974 (gnus-run-hooks 'gnus-group-menu-hook)))
eec82323 975
18c06a99
RS		 976
977(defvar gnus-group-tool-bar-map nil)
978
979(defun gnus-group-tool-bar-update (&optional symbol value)
980 "Update group buffer toolbar.
981Setter function for custom variables."
982 (when symbol
983 (set-default symbol value))
984 ;; (setq-default gnus-group-tool-bar-map nil)
985 ;; (use-local-map gnus-group-mode-map)
986 (when (gnus-alive-p)
987 (with-current-buffer gnus-group-buffer
988 (gnus-group-make-tool-bar t))))
989
990(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
991 'gnus-group-tool-bar-gnome
992 'gnus-group-tool-bar-retro)
993 "Specifies the Gnus group tool bar.
994
fac916bf 995It can be either a list or a symbol referring to a list. See
18c06a99
RS		 996`gmm-tool-bar-from-list' for the format of the list. The
997default key map is `gnus-group-mode-map'.
998
999Pre-defined symbols include `gnus-group-tool-bar-gnome' and
1000`gnus-group-tool-bar-retro'."
1001 :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
1002 (const :tag "Retro look" gnus-group-tool-bar-retro)
1003 (repeat :tag "User defined list" gmm-tool-bar-item)
1004 (symbol))
330f707b 1005 :version "23.1" ;; No Gnus
18c06a99
RS		 1006 :initialize 'custom-initialize-default
1007 :set 'gnus-group-tool-bar-update
1008 :group 'gnus-group)
1009
1010(defcustom gnus-group-tool-bar-gnome
1011 '((gnus-group-post-news "mail/compose")
1012 ;; Some useful agent icons? I don't use the agent so agent users should
1013 ;; suggest useful commands:
ae97e645 1014 (gnus-agent-toggle-plugged "unplugged" t
9b9e104e
MB		 1015 :help "Gnus is currently unplugged. Click to work online."
1016 :visible (and gnus-agent (not gnus-plugged)))
ae97e645 1017 (gnus-agent-toggle-plugged "plugged" t
9b9e104e 1018 :help "Gnus is currently plugged. Click to work offline."
18c06a99
RS		 1019 :visible (and gnus-agent gnus-plugged))
1020 ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
1021 ;; should have a better help text.
1022 (gnus-group-send-queue "mail/outbox" t
1023 :visible (and gnus-agent gnus-plugged)
1024 :help "Send articles from the queue group")
1025 (gnus-group-get-new-news "mail/inbox" nil
1026 :visible (or (not gnus-agent)
1027 gnus-plugged))
1028 ;; FIXME: gnus-*-read-group should have a better help text.
1029 (gnus-topic-read-group "open" nil
1030 :visible (and (boundp 'gnus-topic-mode)
1031 gnus-topic-mode))
1032 (gnus-group-read-group "open" nil
1033 :visible (not (and (boundp 'gnus-topic-mode)
1034 gnus-topic-mode)))
1035 ;; (gnus-group-find-new-groups "???" nil)
1036 (gnus-group-save-newsrc "save")
1037 (gnus-group-describe-group "describe")
1038 (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
1039 (gnus-group-prev-unread-group "left-arrow")
1040 (gnus-group-next-unread-group "right-arrow")
1041 (gnus-group-exit "exit")
1042 (gmm-customize-mode "preferences" t :help "Edit mode preferences")
1043 (gnus-info-find-node "help"))
1044 "List of functions for the group tool bar (GNOME style).
1045
1046See `gmm-tool-bar-from-list' for the format of the list."
1047 :type '(repeat gmm-tool-bar-item)
330f707b 1048 :version "23.1" ;; No Gnus
18c06a99
RS		 1049 :initialize 'custom-initialize-default
1050 :set 'gnus-group-tool-bar-update
1051 :group 'gnus-group)
1052
1053(defcustom gnus-group-tool-bar-retro
1054 '((gnus-group-get-new-news "gnus/get-news")
1055 (gnus-group-get-new-news-this-group "gnus/gnntg")
1056 (gnus-group-catchup-current "gnus/catchup")
1057 (gnus-group-describe-group "gnus/describe-group")
1058 (gnus-group-subscribe "gnus/subscribe" t
1059 :help "Subscribe to the current group")
1060 (gnus-group-unsubscribe "gnus/unsubscribe" t
1061 :help "Unsubscribe from the current group")
1062 (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
1063 "List of functions for the group tool bar (retro look).
1064
1065See `gmm-tool-bar-from-list' for the format of the list."
1066 :type '(repeat gmm-tool-bar-item)
330f707b 1067 :version "23.1" ;; No Gnus
18c06a99
RS		 1068 :initialize 'custom-initialize-default
1069 :set 'gnus-group-tool-bar-update
1070 :group 'gnus-group)
1071
1072(defcustom gnus-group-tool-bar-zap-list t
1073 "List of icon items from the global tool bar.
1074These items are not displayed in the Gnus group mode tool bar.
1075
1076See `gmm-tool-bar-from-list' for the format of the list."
1077 :type 'gmm-tool-bar-zap-list
330f707b 1078 :version "23.1" ;; No Gnus
18c06a99
RS		 1079 :initialize 'custom-initialize-default
1080 :set 'gnus-group-tool-bar-update
1081 :group 'gnus-group)
1082
1083(defvar image-load-path)
aea499b2 1084(defvar tool-bar-map)
18c06a99
RS		 1085
1086(defun gnus-group-make-tool-bar (&optional force)
1087 "Make a group mode tool bar from `gnus-group-tool-bar'.
1088When FORCE, rebuild the tool bar."
1089 (when (and (not (featurep 'xemacs))
1090 (boundp 'tool-bar-mode)
1091 tool-bar-mode
86741733 1092 (display-graphic-p)
18c06a99
RS		 1093 (or (not gnus-group-tool-bar-map) force))
1094 (let* ((load-path
1095 (gmm-image-load-path-for-library "gnus"
1096 "gnus/toggle-subscription.xpm"
1097 nil t))
1098 (image-load-path (cons (car load-path)
1099 (when (boundp 'image-load-path)
1100 image-load-path)))
1101 (map (gmm-tool-bar-from-list gnus-group-tool-bar
1102 gnus-group-tool-bar-zap-list
1103 'gnus-group-mode-map)))
1104 (if map
1105 (set (make-local-variable 'tool-bar-map) map))))
1106 gnus-group-tool-bar-map)
84b9b23e 1107
eec82323
LMI		 1108(defun gnus-group-mode ()
1109 "Major mode for reading news.
1110
1111All normal editing commands are switched off.
1112\\<gnus-group-mode-map>
c30ba437 1113The group buffer lists (some of) the groups available. For instance,
eec82323
LMI		 1114`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
1115lists all zombie groups.
1116
1117Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe
1118to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
1119
1120For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
1121
1122The following commands are available:
1123
1124\\{gnus-group-mode-map}"
1125 (interactive)
619a6b30 1126 (kill-all-local-variables)
eec82323 1127 (when (gnus-visual-p 'group-menu 'menu)
84b9b23e
DL		 1128 (gnus-group-make-menu-bar)
1129 (gnus-group-make-tool-bar))
eec82323
LMI		 1130 (gnus-simplify-mode-line)
1131 (setq major-mode 'gnus-group-mode)
1132 (setq mode-name "Group")
1133 (gnus-group-set-mode-line)
1134 (setq mode-line-process nil)
1135 (use-local-map gnus-group-mode-map)
16409b0b 1136 (buffer-disable-undo)
eec82323 1137 (setq truncate-lines t)
01c52d31
MB		 1138 (setq buffer-read-only t
1139 show-trailing-whitespace nil)
eec82323
LMI		 1140 (gnus-set-default-directory)
1141 (gnus-update-format-specifications nil 'group 'group-mode)
1142 (gnus-update-group-mark-positions)
eec82323
LMI		 1143 (when gnus-use-undo
1144 (gnus-undo-mode 1))
6748645f
LMI		 1145 (when gnus-slave
1146 (gnus-slave-mode))
cfcd5c91 1147 (gnus-run-mode-hooks 'gnus-group-mode-hook))
eec82323
LMI		 1148
1149(defun gnus-update-group-mark-positions ()
1150 (save-excursion
6748645f 1151 (let ((gnus-process-mark ?\200)
23f87bed 1152 (gnus-group-update-hook nil)
eec82323 1153 (gnus-group-marked '("dummy.group"))
6748645f
LMI		 1154 (gnus-active-hashtb (make-vector 10 0))
1155 (topic ""))
eec82323
LMI		 1156 (gnus-set-active "dummy.group" '(0 . 0))
1157 (gnus-set-work-buffer)
1158 (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
1159 (goto-char (point-min))
1160 (setq gnus-group-mark-positions
7c3bb5a5 1161 (list (cons 'process (and (search-forward
dacb905a
SM		 1162 (mm-string-to-multibyte "\200") nil t)
1163 (- (point) (point-min) 1))))))))
eec82323 1164
eec82323
LMI		 1165(defun gnus-mouse-pick-group (e)
1166 "Enter the group under the mouse pointer."
1167 (interactive "e")
1168 (mouse-set-point e)
1169 (gnus-group-read-group nil))
1170
11a5db4a
JD		 1171(defun gnus-group-default-list-level ()
1172 "Return the real value for `gnus-group-default-list-level'."
1173 (if (functionp gnus-group-default-list-level)
1174 (funcall gnus-group-default-list-level)
1175 gnus-group-default-list-level))
1176
eec82323
LMI		 1177;; Look at LEVEL and find out what the level is really supposed to be.
1178;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
1179;; will depend on whether `gnus-group-use-permanent-levels' is used.
1180(defun gnus-group-default-level (&optional level number-or-nil)
1181 (cond
1182 (gnus-group-use-permanent-levels
1183 (or (setq gnus-group-use-permanent-levels
1184 (or level (if (numberp gnus-group-use-permanent-levels)
1185 gnus-group-use-permanent-levels
11a5db4a 1186 (or (gnus-group-default-list-level)
eec82323 1187 gnus-level-subscribed))))
11a5db4a 1188 (gnus-group-default-list-level) gnus-level-subscribed))
eec82323
LMI		 1189 (number-or-nil
1190 level)
1191 (t
11a5db4a 1192 (or level (gnus-group-default-list-level) gnus-level-subscribed))))
eec82323
LMI		 1193
1194(defun gnus-group-setup-buffer ()
6748645f 1195 (set-buffer (gnus-get-buffer-create gnus-group-buffer))
eec82323 1196 (unless (eq major-mode 'gnus-group-mode)
71e691a5 1197 (gnus-group-mode)))
eec82323 1198
23f87bed 1199(defun gnus-group-name-charset (method group)
3eacc9cd
LMI		 1200 (unless method
1201 (setq method (gnus-find-method-for-group group)))
1202 (when (stringp method)
1203 (setq method (gnus-server-to-method method)))
1204 (if (eq (car method) 'nnimap)
1205 ;; IMAP groups should not be encoded, since they do the encoding
1206 ;; in utf7 in the protocol.
e21bac42 1207 'utf-8
3eacc9cd
LMI		 1208 (let ((item (or (assoc method gnus-group-name-charset-method-alist)
1209 (and (consp method)
1210 (assoc (list (car method) (cadr method))
1211 gnus-group-name-charset-method-alist))))
1212 (alist gnus-group-name-charset-group-alist)
1213 result)
1214 (if item
1215 (cdr item)
1216 (while (setq item (pop alist))
1217 (if (string-match (car item) group)
1218 (setq alist nil
1219 result (cdr item))))
1220 result))))
16409b0b 1221
23f87bed
MB		 1222(defun gnus-group-name-decode (string charset)
1223 ;; Fixme: Don't decode in unibyte mode.
16409b0b
GM		 1224 (if (and string charset (featurep 'mule))
1225 (mm-decode-coding-string string charset)
1226 string))
1227
1228(defun gnus-group-decoded-name (string)
1229 (let ((charset (gnus-group-name-charset nil string)))
1230 (gnus-group-name-decode string charset)))
1231
eec82323
LMI		 1232(defun gnus-group-list-groups (&optional level unread lowest)
1233 "List newsgroups with level LEVEL or lower that have unread articles.
1234Default is all subscribed groups.
1235If argument UNREAD is non-nil, groups with no unread articles are also
1236listed.
1237
1238Also see the `gnus-group-use-permanent-levels' variable."
1239 (interactive
1240 (list (if current-prefix-arg
1241 (prefix-numeric-value current-prefix-arg)
1242 (or
1243 (gnus-group-default-level nil t)
11a5db4a 1244 (gnus-group-default-list-level)
eec82323 1245 gnus-level-subscribed))))
eec82323
LMI		 1246 (unless level
1247 (setq level (car gnus-group-list-mode)
1248 unread (cdr gnus-group-list-mode)))
1249 (setq level (gnus-group-default-level level))
1250 (gnus-group-setup-buffer)
1251 (gnus-update-format-specifications nil 'group 'group-mode)
1252 (let ((case-fold-search nil)
01c52d31 1253 (props (text-properties-at (point-at-bol)))
eec82323
LMI		 1254 (empty (= (point-min) (point-max)))
1255 (group (gnus-group-group-name))
1256 number)
1257 (set-buffer gnus-group-buffer)
1258 (setq number (funcall gnus-group-prepare-function level unread lowest))
1259 (when (or (and (numberp number)
1260 (zerop number))
1261 (zerop (buffer-size)))
1262 ;; No groups in the buffer.
bdaa75c7 1263 (gnus-message 5 "%s" gnus-no-groups-message))
eec82323
LMI		 1264 ;; We have some groups displayed.
1265 (goto-char (point-max))
1266 (when (or (not gnus-group-goto-next-group-function)
1267 (not (funcall gnus-group-goto-next-group-function
1268 group props)))
1269 (cond
1270 (empty
1271 (goto-char (point-min)))
1272 ((not group)
1273 ;; Go to the first group with unread articles.
1274 (gnus-group-search-forward t))
1275 (t
1276 ;; Find the right group to put point on. If the current group
1277 ;; has disappeared in the new listing, try to find the next
1278 ;; one. If no next one can be found, just leave point at the
1279 ;; first newsgroup in the buffer.
1280 (when (not (gnus-goto-char
1281 (text-property-any
1282 (point-min) (point-max)
1283 'gnus-group (gnus-intern-safe
1284 group gnus-active-hashtb))))
01c52d31 1285 (let ((newsrc (cdddr (gnus-group-entry group))))
eec82323
LMI		 1286 (while (and newsrc
1287 (not (gnus-goto-char
1288 (text-property-any
1289 (point-min) (point-max) 'gnus-group
1290 (gnus-intern-safe
1291 (caar newsrc) gnus-active-hashtb)))))
1292 (setq newsrc (cdr newsrc)))
1293 (unless newsrc
1294 (goto-char (point-max))
1295 (forward-line -1)))))))
1296 ;; Adjust cursor point.
1297 (gnus-group-position-point)))
1298
1299(defun gnus-group-list-level (level &optional all)
1300 "List groups on LEVEL.
1301If ALL (the prefix), also list groups that have no unread articles."
1302 (interactive "nList groups on level: \nP")
1303 (gnus-group-list-groups level all level))
1304
23f87bed
MB		 1305(defun gnus-group-prepare-logic (group test)
1306 (or (and gnus-group-listed-groups
1307 (null gnus-group-list-option)
1308 (member group gnus-group-listed-groups))
1309 (cond
1310 ((null gnus-group-listed-groups) test)
1311 ((null gnus-group-list-option) test)
1312 (t (and (member group gnus-group-listed-groups)
1313 (if (eq gnus-group-list-option 'flush)
1314 (not test)
1315 test))))))
1316
1317(defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
eec82323 1318 "List all newsgroups with unread articles of level LEVEL or lower.
23f87bed
MB		 1319If PREDICATE is a function, list groups that the function returns non-nil;
1320if it is t, list groups that have no unread articles.
eec82323 1321If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
23f87bed
MB		 1322If REGEXP is a function, list dead groups that the function returns non-nil;
1323if it is a string, only list groups matching REGEXP."
eec82323
LMI		 1324 (set-buffer gnus-group-buffer)
1325 (let ((buffer-read-only nil)
1326 (newsrc (cdr gnus-newsrc-alist))
1327 (lowest (or lowest 1))
23f87bed
MB		 1328 (not-in-list (and gnus-group-listed-groups
1329 (copy-sequence gnus-group-listed-groups)))
eec82323
LMI		 1330 info clevel unread group params)
1331 (erase-buffer)
23f87bed
MB		 1332 (when (or (< lowest gnus-level-zombie)
1333 gnus-group-listed-groups)
eec82323
LMI		 1334 ;; List living groups.
1335 (while newsrc
1336 (setq info (car newsrc)
1337 group (gnus-info-group info)
1338 params (gnus-info-params info)
1339 newsrc (cdr newsrc)
01c52d31 1340 unread (gnus-group-unread group))
23f87bed
MB		 1341 (when not-in-list
1342 (setq not-in-list (delete group not-in-list)))
1343 (when (gnus-group-prepare-logic
1344 group
7fa123c8
KY		 1345 (and (or unread ; This group might be unchecked
1346 predicate) ; Check if this group should be listed
23f87bed
MB		 1347 (or (not (stringp regexp))
1348 (string-match regexp group))
1349 (<= (setq clevel (gnus-info-level info)) level)
1350 (>= clevel lowest)
1351 (cond
1352 ((functionp predicate)
1353 (funcall predicate info))
1354 (predicate t) ; We list all groups?
1355 (t
1356 (or
e9a452d9 1357 (if (eq unread t) ; Inactive?
23f87bed 1358 gnus-group-list-inactive-groups
e4920bc9 1359 ; We list inactive
7fa123c8 1360 (and (numberp unread) (> unread 0)))
23f87bed
MB		 1361 ; We list groups with unread articles
1362 (and gnus-list-groups-with-ticked-articles
1363 (cdr (assq 'tick (gnus-info-marks info))))
40ba43b4 1364 ; And groups with ticked articles
23f87bed
MB		 1365 ;; Check for permanent visibility.
1366 (and gnus-permanently-visible-groups
1367 (string-match gnus-permanently-visible-groups
1368 group))
1369 (memq 'visible params)
1370 (cdr (assq 'visible params)))))))
1371 (gnus-group-insert-group-line
1372 group (gnus-info-level info)
1373 (gnus-info-marks info) unread (gnus-info-method info)))))
eec82323
LMI		 1374
1375 ;; List dead groups.
23f87bed
MB		 1376 (when (or gnus-group-listed-groups
1377 (and (>= level gnus-level-zombie)
1378 (<= lowest gnus-level-zombie)))
1379 (gnus-group-prepare-flat-list-dead
1380 (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
1381 gnus-level-zombie ?Z
1382 regexp))
1383 (when not-in-list
1384 (dolist (group gnus-zombie-list)
1385 (setq not-in-list (delete group not-in-list))))
1386 (when (or gnus-group-listed-groups
1387 (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
1388 (gnus-group-prepare-flat-list-dead
1389 (gnus-union
1390 not-in-list
1391 (setq gnus-killed-list (sort gnus-killed-list 'string<)))
1392 gnus-level-killed ?K regexp))
eec82323
LMI		 1393
1394 (gnus-group-set-mode-line)
23f87bed 1395 (setq gnus-group-list-mode (cons level predicate))
6748645f 1396 (gnus-run-hooks 'gnus-group-prepare-hook)
eec82323
LMI		 1397 t))
1398
1399(defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
1400 ;; List zombies and killed lists somewhat faster, which was
1401 ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
1402 ;; this by ignoring the group format specification altogether.
1403 (let (group)
23f87bed 1404 (if (> (length groups) gnus-group-listing-limit)
eec82323
LMI		 1405 (while groups
1406 (setq group (pop groups))
23f87bed
MB		 1407 (when (gnus-group-prepare-logic
1408 group
1409 (or (not regexp)
1410 (and (stringp regexp) (string-match regexp group))
1411 (and (functionp regexp) (funcall regexp group))))
eec82323
LMI		 1412 (gnus-add-text-properties
1413 (point) (prog1 (1+ (point))
16409b0b 1414 (insert " " mark " *: "
23f87bed 1415 (gnus-group-decoded-name group)
16409b0b 1416 "\n"))
eec82323
LMI		 1417 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
1418 'gnus-unread t
1419 'gnus-level level))))
eec82323 1420 (while groups
16409b0b 1421 (setq group (pop groups))
23f87bed
MB		 1422 (when (gnus-group-prepare-logic
1423 group
1424 (or (not regexp)
1425 (and (stringp regexp) (string-match regexp group))
1426 (and (functionp regexp) (funcall regexp group))))
1427 (gnus-group-insert-group-line
1428 group level nil
1429 (let ((active (gnus-active group)))
1430 (if active
1431 (if (zerop (cdr active))
1432 0
1433 (- (1+ (cdr active)) (car active)))
1434 nil))
1435 (gnus-method-simplify (gnus-find-method-for-group group))))))))
eec82323
LMI		 1436
1437(defun gnus-group-update-group-line ()
1438 "Update the current line in the group buffer."
1439 (let* ((buffer-read-only nil)
1440 (group (gnus-group-group-name))
01c52d31 1441 (entry (and group (gnus-group-entry group)))
eec82323
LMI		 1442 gnus-group-indentation)
1443 (when group
1444 (and entry
1445 (not (gnus-ephemeral-group-p group))
1446 (gnus-dribble-enter
1447 (concat "(gnus-group-set-info '"
1448 (gnus-prin1-to-string (nth 2 entry))
b229f37d
KY		 1449 ")")
1450 (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\"")))
eec82323
LMI		 1451 (setq gnus-group-indentation (gnus-group-group-indentation))
1452 (gnus-delete-line)
1453 (gnus-group-insert-group-line-info group)
1454 (forward-line -1)
1455 (gnus-group-position-point))))
1456
1457(defun gnus-group-insert-group-line-info (group)
1458 "Insert GROUP on the current line."
01c52d31 1459 (let ((entry (gnus-group-entry group))
eec82323
LMI		 1460 (gnus-group-indentation (gnus-group-group-indentation))
1461 active info)
1462 (if entry
1463 (progn
1464 ;; (Un)subscribed group.
1465 (setq info (nth 2 entry))
1466 (gnus-group-insert-group-line
1467 group (gnus-info-level info) (gnus-info-marks info)
1468 (or (car entry) t) (gnus-info-method info)))
1469 ;; This group is dead.
1470 (gnus-group-insert-group-line
1471 group
1472 (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
1473 nil
1474 (if (setq active (gnus-active group))
1475 (if (zerop (cdr active))
1476 0
1477 (- (1+ (cdr active)) (car active)))
1478 nil)
23f87bed
MB		 1479 (gnus-method-simplify (gnus-find-method-for-group group))))))
1480
1481(defun gnus-number-of-unseen-articles-in-group (group)
1482 (let* ((info (nth 2 (gnus-group-entry group)))
1483 (marked (gnus-info-marks info))
1484 (seen (cdr (assq 'seen marked)))
1485 (active (gnus-active group)))
1486 (if (not active)
1487 0
1488 (length (gnus-uncompress-range
1489 (gnus-range-difference
1490 (gnus-range-difference (list active) (gnus-info-read info))
1491 seen))))))
eec82323 1492
18c06a99 1493;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
25bf7349
MB		 1494;; update the state (enabled/disabled) of the icon `gnus-group-describe-group'
1495;; automatically. After `C-l' the state is correct. See the following report
1496;; on emacs-devel
18c06a99 1497;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>:
18c06a99
RS		 1498;; From: Reiner Steib
1499;; Subject: tool bar icons not updated according to :active condition
1500;; Newsgroups: gmane.emacs.devel
1501;; Date: Mon, 23 Jan 2006 19:59:13 +0100
1502;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de>
1503
85fd8002
RS		 1504(defcustom gnus-group-update-tool-bar
1505 (and (not (featurep 'xemacs))
1506 (boundp 'tool-bar-mode)
1507 tool-bar-mode
5843126b 1508 ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs might
85fd8002
RS		 1509 ;; be confusing, so maybe we shouldn't call it by default.
1510 (fboundp 'force-window-update))
1511 "Force updating the group buffer tool bar."
1512 :group 'gnus-group
1513 :version "22.1"
5af68e28
MB		 1514 :initialize 'custom-initialize-default
1515 :set (lambda (symbol value)
1516 (set-default symbol value)
1517 (when (gnus-alive-p)
1518 (with-current-buffer gnus-group-buffer
1519 ;; FIXME: Is there a better way to redraw the group buffer?
1520 (gnus-group-get-new-news 0))))
85fd8002
RS		 1521 :type 'boolean)
1522
eec82323
LMI		 1523(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
1524 gnus-tmp-marked number
1525 gnus-tmp-method)
1526 "Insert a group line in the group buffer."
16409b0b 1527 (let* ((gnus-tmp-method
a1506d29 1528 (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
16409b0b
GM		 1529 (group-name-charset (gnus-group-name-charset gnus-tmp-method
1530 gnus-tmp-group))
1531 (gnus-tmp-active (gnus-active gnus-tmp-group))
eec82323
LMI		 1532 (gnus-tmp-number-total
1533 (if gnus-tmp-active
1534 (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
1535 0))
1536 (gnus-tmp-number-of-unread
1537 (if (numberp number) (int-to-string (max 0 number))
1538 "*"))
1539 (gnus-tmp-number-of-read
1540 (if (numberp number)
1541 (int-to-string (max 0 (- gnus-tmp-number-total number)))
1542 "*"))
1543 (gnus-tmp-subscribed
1544 (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
1545 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
1546 ((= gnus-tmp-level gnus-level-zombie) ?Z)
1547 (t ?K)))
a1506d29 1548 (gnus-tmp-qualified-group
16409b0b
GM		 1549 (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
1550 group-name-charset))
23f87bed
MB		 1551 (gnus-tmp-comment
1552 (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
1553 gnus-tmp-group))
eec82323
LMI		 1554 (gnus-tmp-newsgroup-description
1555 (if gnus-description-hashtb
16409b0b 1556 (or (gnus-group-name-decode
a1506d29 1557 (gnus-gethash gnus-tmp-group gnus-description-hashtb)
16409b0b 1558 group-name-charset) "")
eec82323
LMI		 1559 ""))
1560 (gnus-tmp-moderated
1561 (if (and gnus-moderated-hashtb
1562 (gnus-gethash gnus-tmp-group gnus-moderated-hashtb))
1563 ?m ? ))
1564 (gnus-tmp-moderated-string
1565 (if (eq gnus-tmp-moderated ?m) "(m)" ""))
0d2d1bdc 1566 (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-group))
eec82323
LMI		 1567 (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
1568 (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
1569 (gnus-tmp-news-method-string
1570 (if gnus-tmp-method
1571 (format "(%s:%s)" (car gnus-tmp-method)
1572 (cadr gnus-tmp-method)) ""))
1573 (gnus-tmp-marked-mark
1574 (if (and (numberp number)
1575 (zerop number)
1576 (cdr (assq 'tick gnus-tmp-marked)))
1577 ?* ? ))
23f87bed
MB		 1578 (gnus-tmp-summary-live
1579 (if (and (not gnus-group-is-exiting-p)
1580 (gnus-buffer-live-p (gnus-summary-buffer-name
1581 gnus-tmp-group)))
1582 ?* ? ))
eec82323
LMI		 1583 (gnus-tmp-process-marked
1584 (if (member gnus-tmp-group gnus-group-marked)
1585 gnus-process-mark ? ))
eec82323 1586 (buffer-read-only nil)
85fd8002 1587 beg end
eec82323
LMI		 1588 header gnus-tmp-header) ; passed as parameter to user-funcs.
1589 (beginning-of-line)
85fd8002 1590 (setq beg (point))
eec82323
LMI		 1591 (gnus-add-text-properties
1592 (point)
1593 (prog1 (1+ (point))
1594 ;; Insert the text.
91472578
MB		 1595 (let ((gnus-tmp-decoded-group (gnus-group-name-decode
1596 gnus-tmp-group group-name-charset)))
23f87bed 1597 (eval gnus-group-line-format-spec)))
eec82323
LMI		 1598 `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
1599 gnus-unread ,(if (numberp number)
e9bd5782 1600 (string-to-number gnus-tmp-number-of-unread)
eec82323
LMI		 1601 t)
1602 gnus-marked ,gnus-tmp-marked-mark
1603 gnus-indentation ,gnus-group-indentation
1604 gnus-level ,gnus-tmp-level))
85fd8002
RS		 1605 (setq end (point))
1606 (when gnus-group-update-tool-bar
1607 (gnus-put-text-property beg end 'point-entered
1608 'gnus-tool-bar-update)
1609 (gnus-put-text-property beg end 'point-left
1610 'gnus-tool-bar-update))
16409b0b 1611 (forward-line -1)
eec82323 1612 (when (inline (gnus-visual-p 'group-highlight 'highlight))
b069e5a6
G		 1613 (gnus-group-highlight-line gnus-tmp-group beg end))
1614 (gnus-run-hooks 'gnus-group-update-hook)
86741733 1615 (forward-line)))
eec82323 1616
b069e5a6
G		 1617(defun gnus-group-update-eval-form (group list)
1618 "Eval `car' of each element of LIST, and return the first that return t.
1619Some value are bound so the form can use them."
1620 (when list
1621 (let* ((entry (gnus-group-entry group))
1622 (unread (if (numberp (car entry)) (car entry) 0))
1623 (active (gnus-active group))
1624 (total (if active (1+ (- (cdr active) (car active))) 0))
1625 (info (nth 2 entry))
1626 (method (inline (gnus-server-get-method group (gnus-info-method info))))
1627 (marked (gnus-info-marks info))
1628 (mailp (apply 'append
1629 (mapcar
1630 (lambda (x)
1631 (memq x (assoc (symbol-name
1632 (car (or method gnus-select-method)))
1633 gnus-valid-select-methods)))
1634 '(mail post-mail))))
1635 (level (or (gnus-info-level info) gnus-level-killed))
1636 (score (or (gnus-info-score info) 0))
1637 (ticked (gnus-range-length (cdr (assq 'tick marked))))
1638 (group-age (gnus-group-timestamp-delta group)))
1639 ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
1640 ;; ======================================================================
1641 ;; From: Richard Stallman
1642 ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
1643 ;; Cc: ding@gnus.org
1644 ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
1645 ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
1646 ;;
1647 ;; [...]
1648 ;; The kludge is that the alist elements contain expressions that refer
1649 ;; to local variables with short names. Perhaps write your own tiny
1650 ;; evaluator that handles just `and', `or', and numeric comparisons
1651 ;; and just a few specific variables.
1652 ;; ======================================================================
1653 ;;
1654 ;; Similar for other evaluated variables. Grep for risky-local-variable
1655 ;; to find them! -- rsteib
1656 ;;
1657 ;; Eval the cars of the lists until we find a match.
1658 (while (and list
1659 (not (eval (caar list))))
1660 (setq list (cdr list)))
1661 list)))
1662
1663(defun gnus-group-highlight-line (group beg end)
1664 "Highlight the current line according to `gnus-group-highlight'.
7228f056 1665GROUP is current group, and the line to highlight starts at BEG
b069e5a6
G		 1666and ends at END."
1667 (let ((face (cdar (gnus-group-update-eval-form
1668 group
1669 gnus-group-highlight))))
1670 (unless (eq face (get-text-property beg 'face))
1671 (let ((inhibit-read-only t))
1d43a35f
CY		 1672 (gnus-put-text-property-excluding-characters-with-faces
1673 beg end 'face
1674 (if (boundp face) (symbol-value face) face)))
b069e5a6
G		 1675 (gnus-extent-start-open beg))))
1676
1677(defun gnus-group-get-icon (group)
1678 "Return an icon for GROUP according to `gnus-group-icon-list'."
1679 (if gnus-group-icon-list
1680 (let ((image-path
1681 (cdar (gnus-group-update-eval-form group gnus-group-icon-list))))
1682 (if image-path
1683 (propertize " "
1684 'display
1685 (append
1686 (gnus-create-image (expand-file-name image-path))
1687 '(:ascent center)))
1688 " "))
1689 " "))
c7e2ef4e 1690
9e928ac9
G		 1691
1692(defun gnus-group-refresh-group (group)
1693 (gnus-activate-group group)
1694 (gnus-get-unread-articles-in-group (gnus-get-info group)
1695 (gnus-active group))
5d85ab5e 1696 (gnus-group-update-group group))
9e928ac9 1697
b229f37d
KY		 1698(defun gnus-group-update-group (group &optional visible-only
1699 info-unchanged)
eec82323
LMI		 1700 "Update all lines where GROUP appear.
1701If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
b229f37d 1702already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
765abcce
SM		 1703 (with-current-buffer gnus-group-buffer
1704 (save-excursion
1705 ;; The buffer may be narrowed.
1706 (save-restriction
1707 (widen)
1708 (let ((ident (gnus-intern-safe group gnus-active-hashtb))
1709 (loc (point-min))
1710 found buffer-read-only)
b229f37d
KY		 1711 (unless info-unchanged
1712 ;; Enter the current status into the dribble buffer.
1713 (let ((entry (gnus-group-entry group)))
1714 (when (and entry
1715 (not (gnus-ephemeral-group-p group)))
1716 (gnus-dribble-enter
1717 (concat "(gnus-group-set-info '"
1718 (gnus-prin1-to-string (nth 2 entry))
1719 ")")
1720 (concat "^(gnus-group-set-info '(\""
1721 (regexp-quote group) "\"")))))
765abcce
SM		 1722 ;; Find all group instances. If topics are in use, each group
1723 ;; may be listed in more than once.
1724 (while (setq loc (text-property-any
1725 loc (point-max) 'gnus-group ident))
1726 (setq found t)
1727 (goto-char loc)
1728 (let ((gnus-group-indentation (gnus-group-group-indentation)))
1729 (gnus-delete-line)
1730 (gnus-group-insert-group-line-info group)
1731 (save-excursion
1732 (forward-line -1)
1733 (gnus-run-hooks 'gnus-group-update-group-hook)))
1734 (setq loc (1+ loc)))
1735 (unless (or found visible-only)
1736 ;; No such line in the buffer, find out where it's supposed to
1737 ;; go, and insert it there (or at the end of the buffer).
1738 (if gnus-goto-missing-group-function
1739 (funcall gnus-goto-missing-group-function group)
1740 (let ((entry (cddr (gnus-group-entry group))))
1741 (while (and entry (car entry)
1742 (not
1743 (gnus-goto-char
1744 (text-property-any
1745 (point-min) (point-max)
1746 'gnus-group (gnus-intern-safe
1747 (caar entry)
1748 gnus-active-hashtb)))))
1749 (setq entry (cdr entry)))
1750 (or entry (goto-char (point-max)))))
1751 ;; Finally insert the line.
1752 (let ((gnus-group-indentation (gnus-group-group-indentation)))
1753 (gnus-group-insert-group-line-info group)
1754 (save-excursion
1755 (forward-line -1)
1756 (gnus-run-hooks 'gnus-group-update-group-hook))))
1757 (when gnus-group-update-group-function
1758 (funcall gnus-group-update-group-function group))
1759 (gnus-group-set-mode-line))))))
eec82323
LMI		 1760
1761(defun gnus-group-set-mode-line ()
1762 "Update the mode line in the group buffer."
1763 (when (memq 'group gnus-updated-mode-lines)
1764 ;; Yes, we want to keep this mode line updated.
765abcce 1765 (with-current-buffer gnus-group-buffer
eec82323 1766 (let* ((gformat (or gnus-group-mode-line-format-spec
6748645f 1767 (gnus-set-format 'group-mode)))
eec82323
LMI		 1768 (gnus-tmp-news-server (cadr gnus-select-method))
1769 (gnus-tmp-news-method (car gnus-select-method))
1770 (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
1771 (max-len 60)
1772 gnus-tmp-header ;Dummy binding for user-defined formats
1773 ;; Get the resulting string.
1774 (modified
1775 (and gnus-dribble-buffer
1776 (buffer-name gnus-dribble-buffer)
1777 (buffer-modified-p gnus-dribble-buffer)
765abcce 1778 (with-current-buffer gnus-dribble-buffer
eec82323
LMI		 1779 (not (zerop (buffer-size))))))
1780 (mode-string (eval gformat)))
1781 ;; Say whether the dribble buffer has been modified.
a8151ef7
LMI		 1782 (setq mode-line-modified
1783 (if modified (car gnus-mode-line-modified)
1784 (cdr gnus-mode-line-modified)))
eec82323
LMI		 1785 ;; If the line is too long, we chop it off.
1786 (when (> (length mode-string) max-len)
1787 (setq mode-string (substring mode-string 0 (- max-len 4))))
1788 (prog1
1789 (setq mode-line-buffer-identification
1790 (gnus-mode-line-buffer-identification
1791 (list mode-string)))
1792 (set-buffer-modified-p modified))))))
1793
1794(defun gnus-group-group-name ()
1795 "Get the name of the newsgroup on the current line."
01c52d31 1796 (let ((group (get-text-property (point-at-bol) 'gnus-group)))
6748645f
LMI		 1797 (when group
1798 (symbol-name group))))
eec82323
LMI		 1799
1800(defun gnus-group-group-level ()
1801 "Get the level of the newsgroup on the current line."
01c52d31 1802 (get-text-property (point-at-bol) 'gnus-level))
eec82323
LMI		 1803
1804(defun gnus-group-group-indentation ()
1805 "Get the indentation of the newsgroup on the current line."
01c52d31 1806 (or (get-text-property (point-at-bol) 'gnus-indentation)
eec82323
LMI		 1807 (and gnus-group-indentation-function
1808 (funcall gnus-group-indentation-function))
1809 ""))
1810
1811(defun gnus-group-group-unread ()
1812 "Get the number of unread articles of the newsgroup on the current line."
01c52d31 1813 (get-text-property (point-at-bol) 'gnus-unread))
eec82323
LMI		 1814
1815(defun gnus-group-new-mail (group)
1816 (if (nnmail-new-mail-p (gnus-group-real-name group))
1817 gnus-new-mail-mark
1818 ? ))
1819
1820(defun gnus-group-level (group)
1821 "Return the estimated level of GROUP."
1822 (or (gnus-info-level (gnus-get-info group))
6748645f
LMI		 1823 (and (member group gnus-zombie-list) gnus-level-zombie)
1824 gnus-level-killed))
eec82323
LMI		 1825
1826(defun gnus-group-search-forward (&optional backward all level first-too)
1827 "Find the next newsgroup with unread articles.
1828If BACKWARD is non-nil, find the previous newsgroup instead.
1829If ALL is non-nil, just find any newsgroup.
1830If LEVEL is non-nil, find group with level LEVEL, or higher if no such
1831group exists.
1832If FIRST-TOO, the current line is also eligible as a target."
1833 (let ((way (if backward -1 1))
1834 (low gnus-level-killed)
1835 (beg (point))
1836 pos found lev)
1837 (if (and backward (progn (beginning-of-line)) (bobp))
1838 nil
1839 (unless first-too
1840 (forward-line way))
1841 (while (and
1842 (not (eobp))
1843 (not (setq
1844 found
a8151ef7
LMI		 1845 (and
1846 (get-text-property (point) 'gnus-group)
1847 (or all
1848 (and
1849 (let ((unread
1850 (get-text-property (point) 'gnus-unread)))
1851 (and (numberp unread) (> unread 0)))
1852 (setq lev (get-text-property (point)
1853 'gnus-level))
1854 (<= lev gnus-level-subscribed)))
1855 (or (not level)
1856 (and (setq lev (get-text-property (point)
eec82323 1857 'gnus-level))
a8151ef7
LMI		 1858 (or (= lev level)
1859 (and (< lev low)
1860 (< level lev)
1861 (progn
1862 (setq low lev)
1863 (setq pos (point))
1864 nil))))))))
eec82323
LMI		 1865 (zerop (forward-line way)))))
1866 (if found
1867 (progn (gnus-group-position-point) t)
1868 (goto-char (or pos beg))
1869 (and pos t))))
1870
01c52d31
MB		 1871(defun gnus-total-fetched-for (group)
1872 (let* ((size-in-cache (or (gnus-cache-total-fetched-for group) 0))
1873 (size-in-agent (or (gnus-agent-total-fetched-for group) 0))
1874 (size (+ size-in-cache size-in-agent))
1875 (suffix '("B" "K" "M" "G"))
1876 (scale 1024.0)
1877 (cutoff scale))
1878 (while (> size cutoff)
1879 (setq size (/ size scale)
1880 suffix (cdr suffix)))
1881 (format "%5.1f%s" size (car suffix))))
1882
eec82323
LMI		 1883;;; Gnus group mode commands
1884
1885;; Group marking.
1886
16409b0b
GM		 1887(defun gnus-group-mark-line-p ()
1888 (save-excursion
1889 (beginning-of-line)
1890 (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
1891 (eq (char-after) gnus-process-mark)))
1892
eec82323
LMI		 1893(defun gnus-group-mark-group (n &optional unmark no-advance)
1894 "Mark the current group."
1895 (interactive "p")
1896 (let ((buffer-read-only nil)
1897 group)
1898 (while (and (> n 0)
1899 (not (eobp)))
1900 (when (setq group (gnus-group-group-name))
1901 ;; Go to the mark position.
1902 (beginning-of-line)
1903 (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
01c52d31
MB		 1904 (delete-char 1)
1905 (if unmark
1906 (progn
1907 (setq gnus-group-marked (delete group gnus-group-marked))
1908 (insert-char ? 1 t))
eec82323
LMI		 1909 (setq gnus-group-marked
1910 (cons group (delete group gnus-group-marked)))
01c52d31 1911 (insert-char gnus-process-mark 1 t)))
eec82323
LMI		 1912 (unless no-advance
1913 (gnus-group-next-group 1))
1914 (decf n))
280f417b 1915 (gnus-group-position-point)
eec82323
LMI		 1916 n))
1917
1918(defun gnus-group-unmark-group (n)
1919 "Remove the mark from the current group."
1920 (interactive "p")
1921 (gnus-group-mark-group n 'unmark)
1922 (gnus-group-position-point))
1923
1924(defun gnus-group-unmark-all-groups ()
1925 "Unmark all groups."
1926 (interactive)
01c52d31
MB		 1927 (save-excursion
1928 (mapc 'gnus-group-remove-mark gnus-group-marked))
eec82323
LMI		 1929 (gnus-group-position-point))
1930
1931(defun gnus-group-mark-region (unmark beg end)
1932 "Mark all groups between point and mark.
1933If UNMARK, remove the mark instead."
1934 (interactive "P\nr")
1935 (let ((num (count-lines beg end)))
1936 (save-excursion
1937 (goto-char beg)
1938 (- num (gnus-group-mark-group num unmark)))))
1939
1940(defun gnus-group-mark-buffer (&optional unmark)
1941 "Mark all groups in the buffer.
1942If UNMARK, remove the mark instead."
1943 (interactive "P")
1944 (gnus-group-mark-region unmark (point-min) (point-max)))
1945
1946(defun gnus-group-mark-regexp (regexp)
1947 "Mark all groups that match some regexp."
1948 (interactive "sMark (regexp): ")
1949 (let ((alist (cdr gnus-newsrc-alist))
1950 group)
23f87bed
MB		 1951 (save-excursion
1952 (while alist
1953 (when (string-match regexp (setq group (gnus-info-group (pop alist))))
1954 (gnus-group-jump-to-group group)
1955 (gnus-group-set-mark group)))))
eec82323
LMI		 1956 (gnus-group-position-point))
1957
16409b0b 1958(defun gnus-group-remove-mark (group &optional test-marked)
eec82323
LMI		 1959 "Remove the process mark from GROUP and move point there.
1960Return nil if the group isn't displayed."
16409b0b 1961 (if (gnus-group-goto-group group nil test-marked)
eec82323
LMI		 1962 (save-excursion
1963 (gnus-group-mark-group 1 'unmark t)
1964 t)
1965 (setq gnus-group-marked
1966 (delete group gnus-group-marked))
1967 nil))
1968
1969(defun gnus-group-set-mark (group)
1970 "Set the process mark on GROUP."
1971 (if (gnus-group-goto-group group)
1972 (save-excursion
1973 (gnus-group-mark-group 1 nil t))
1974 (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
1975
1976(defun gnus-group-universal-argument (arg &optional groups func)
1977 "Perform any command on all groups according to the process/prefix convention."
1978 (interactive "P")
1979 (if (eq (setq func (or func
1980 (key-binding
1981 (read-key-sequence
1982 (substitute-command-keys
1983 "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
1984 'undefined)
1985 (gnus-error 1 "Undefined key")
1986 (gnus-group-iterate arg
1987 (lambda (group)
1988 (command-execute func))))
1989 (gnus-group-position-point))
1990
1991(defun gnus-group-process-prefix (n)
1992 "Return a list of groups to work on.
1993Take into consideration N (the prefix) and the list of marked groups."
1994 (cond
1995 (n
1996 (setq n (prefix-numeric-value n))
1997 ;; There is a prefix, so we return a list of the N next
1998 ;; groups.
1999 (let ((way (if (< n 0) -1 1))
2000 (n (abs n))
2001 group groups)
2002 (save-excursion
6748645f
LMI		 2003 (while (> n 0)
2004 (if (setq group (gnus-group-group-name))
2005 (push group groups))
eec82323
LMI		 2006 (setq n (1- n))
2007 (gnus-group-next-group way)))
2008 (nreverse groups)))
23f87bed 2009 ((and (gnus-region-active-p) (mark))
eec82323
LMI		 2010 ;; Work on the region between point and mark.
2011 (let ((max (max (point) (mark)))
2012 groups)
2013 (save-excursion
2014 (goto-char (min (point) (mark)))
2015 (while
2016 (and
2017 (push (gnus-group-group-name) groups)
2018 (zerop (gnus-group-next-group 1))
2019 (< (point) max)))
2020 (nreverse groups))))
2021 (gnus-group-marked
2022 ;; No prefix, but a list of marked articles.
2023 (reverse gnus-group-marked))
2024 (t
2025 ;; Neither marked articles or a prefix, so we return the
2026 ;; current group.
2027 (let ((group (gnus-group-group-name)))
2028 (and group (list group))))))
2029
6748645f
LMI		 2030;;; !!!Surely gnus-group-iterate should be a macro instead? I can't
2031;;; imagine why I went through these contortions...
2032(eval-and-compile
2033 (let ((function (make-symbol "gnus-group-iterate-function"))
2034 (window (make-symbol "gnus-group-iterate-window"))
2035 (groups (make-symbol "gnus-group-iterate-groups"))
2036 (group (make-symbol "gnus-group-iterate-group")))
2037 (eval
2038 `(defun gnus-group-iterate (arg ,function)
2039 "Iterate FUNCTION over all process/prefixed groups.
16409b0b 2040FUNCTION will be called with the group name as the parameter
eec82323 2041and with point over the group in question."
6748645f
LMI		 2042 (let ((,groups (gnus-group-process-prefix arg))
2043 (,window (selected-window))
2044 ,group)
16409b0b
GM		 2045 (while ,groups
2046 (setq ,group (car ,groups)
2047 ,groups (cdr ,groups))
6748645f
LMI		 2048 (select-window ,window)
2049 (gnus-group-remove-mark ,group)
2050 (save-selected-window
2051 (save-excursion
2052 (funcall ,function ,group)))))))))
eec82323
LMI		 2053
2054(put 'gnus-group-iterate 'lisp-indent-function 1)
2055
2056;; Selecting groups.
2057
6748645f 2058(defun gnus-group-read-group (&optional all no-article group select-articles)
eec82323
LMI		 2059 "Read news in this newsgroup.
2060If the prefix argument ALL is non-nil, already read articles become
52bec650
MB		 2061readable.
2062
2063If ALL is a positive number, fetch this number of the latest
2064articles in the group. If ALL is a negative number, fetch this
2065number of the earliest articles in the group.
2066
2067If the optional argument NO-ARTICLE is non-nil, no article will
2068be auto-selected upon group entry. If GROUP is non-nil, fetch
2069that group."
eec82323
LMI		 2070 (interactive "P")
2071 (let ((no-display (eq all 0))
2072 (group (or group (gnus-group-group-name)))
2073 number active marked entry)
2074 (when (eq all 0)
2075 (setq all nil))
2076 (unless group
2077 (error "No group on current line"))
2078 (setq marked (gnus-info-marks
01c52d31 2079 (nth 2 (setq entry (gnus-group-entry group)))))
eec82323
LMI		 2080 ;; This group might be a dead group. In that case we have to get
2081 ;; the number of unread articles from `gnus-active-hashtb'.
2082 (setq number
2083 (cond ((numberp all) all)
2084 (entry (car entry))
2085 ((setq active (gnus-active group))
2086 (- (1+ (cdr active)) (car active)))))
2087 (gnus-summary-read-group
2088 group (or all (and (numberp number)
2089 (zerop (+ number (gnus-range-length
2090 (cdr (assq 'tick marked)))
2091 (gnus-range-length
2092 (cdr (assq 'dormant marked)))))))
6748645f 2093 no-article nil no-display nil select-articles)))
eec82323
LMI		 2094
2095(defun gnus-group-select-group (&optional all)
2096 "Select this newsgroup.
2097No article is selected automatically.
23f87bed 2098If the group is opened, just switch the summary buffer.
eec82323 2099If ALL is non-nil, already read articles become readable.
827dc73d
MB		 2100If ALL is a positive number, fetch this number of the latest
2101articles in the group.
2102If ALL is a negative number, fetch this number of the earliest
2103articles in the group."
eec82323 2104 (interactive "P")
23f87bed
MB		 2105 (when (and (eobp) (not (gnus-group-group-name)))
2106 (forward-line -1))
eec82323
LMI		 2107 (gnus-group-read-group all t))
2108
01c52d31
MB		 2109(defun gnus-group-quick-select-group (&optional all group)
2110 "Select the GROUP \"quickly\".
2111This means that no highlighting or scoring will be performed. If
2112ALL (the prefix argument) is 0, don't even generate the summary
2113buffer. If GROUP is nil, use current group.
6748645f
LMI		 2114
2115This might be useful if you want to toggle threading
2116before entering the group."
eec82323
LMI		 2117 (interactive "P")
2118 (require 'gnus-score)
2119 (let (gnus-visual
2120 gnus-score-find-score-files-function
2121 gnus-home-score-file
2122 gnus-apply-kill-hook
2123 gnus-summary-expunge-below)
01c52d31 2124 (gnus-group-read-group all t group)))
eec82323
LMI		 2125
2126(defun gnus-group-visible-select-group (&optional all)
2127 "Select the current group without hiding any articles."
2128 (interactive "P")
2129 (let ((gnus-inhibit-limiting t))
2130 (gnus-group-read-group all t)))
2131
2132(defun gnus-group-select-group-ephemerally ()
2133 "Select the current group without doing any processing whatsoever.
2134You will actually be entered into a group that's a copy of
2135the current group; no changes you make while in this group will
2136be permanent."
2137 (interactive)
2138 (require 'gnus-score)
2139 (let* (gnus-visual
2140 gnus-score-find-score-files-function gnus-apply-kill-hook
2141 gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates
2142 gnus-summary-mode-hook gnus-select-group-hook
2143 (group (gnus-group-group-name))
2144 (method (gnus-find-method-for-group group)))
eec82323
LMI		 2145 (gnus-group-read-ephemeral-group
2146 (gnus-group-prefixed-name group method) method)))
2147
01c52d31
MB		 2148(defun gnus-group-name-at-point ()
2149 "Return a group name from around point if it exists, or nil."
2150 (if (eq major-mode 'gnus-group-mode)
2151 (let ((group (gnus-group-group-name)))
2152 (when group
2153 (gnus-group-decoded-name group)))
2154 (let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\
2155\\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\
2156\[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\
2157\\|[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)+\\)")
2158 (start (point))
2159 (case-fold-search nil))
2160 (prog1
2161 (if (or (and (not (or (eobp)
2162 (looking-at "[][\C-@-*,/;-@\\^`{-\C-?]")))
2163 (prog1 t
2164 (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2165 (point-at-bol))))
2166 (and (looking-at "[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*$")
2167 (prog1 t
2168 (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?")
2169 (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2170 (point-at-bol))))
2171 (string-match "\\`[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*\\'"
2172 (buffer-substring (point-at-bol) (point))))
2173 (when (looking-at regexp)
2174 (match-string 1))
2175 (let (group distance)
2176 (when (looking-at regexp)
2177 (setq group (match-string 1)
2178 distance (- (match-beginning 1) (match-beginning 0))))
2179 (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?")
2180 (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2181 (point-at-bol))
2182 (if (looking-at regexp)
2183 (if (and group (<= distance (- start (match-end 0))))
2184 group
2185 (match-string 1))
2186 group)))
2187 (goto-char start)))))
2188
229b59da 2189(defun gnus-group-completing-read (&optional prompt collection
61c47336
KY		 2190 require-match initial-input hist
2191 def)
01c52d31
MB		 2192 "Read a group name with completion. Non-ASCII group names are allowed.
2193The arguments are the same as `completing-read' except that COLLECTION
2194and HIST default to `gnus-active-hashtb' and `gnus-group-history'
61c47336
KY		 2195respectively if they are omitted. Regards COLLECTION as a hash table
2196if it is not a list."
2197 (or collection (setq collection gnus-active-hashtb))
2198 (let (choices group)
2199 (if (listp collection)
2200 (dolist (symbol collection)
2201 (setq group (symbol-name symbol))
2202 (push (if (string-match "[^\000-\177]" group)
2203 (gnus-group-decoded-name group)
2204 group)
2205 choices))
2206 (mapatoms (lambda (symbol)
2207 (setq group (symbol-name symbol))
2208 (push (if (string-match "[^\000-\177]" group)
2209 (gnus-group-decoded-name group)
2210 group)
2211 choices))
2212 collection))
2213 (setq group (gnus-completing-read (or prompt "Group") (nreverse choices)
2214 require-match initial-input
2215 (or hist 'gnus-group-history)
2216 def))
530f7b67
LMI		 2217 (unless (if (listp collection)
2218 (member group (mapcar 'symbol-name collection))
2219 (symbol-value (intern-soft group collection)))
2220 (setq group
2221 (mm-encode-coding-string
2222 group (gnus-group-name-charset nil group))))
e617ab06 2223 (gnus-replace-in-string group "\n" "")))
01c52d31 2224
eec82323 2225;;;###autoload
23f87bed 2226(defun gnus-fetch-group (group &optional articles)
eec82323 2227 "Start Gnus if necessary and enter GROUP.
01c52d31 2228If ARTICLES, display those articles.
eec82323 2229Returns whether the fetching was successful or not."
229b59da
G		 2230 (interactive (list (gnus-group-completing-read nil
2231 nil nil
01c52d31
MB		 2232 (gnus-group-name-at-point))))
2233 (unless (gnus-alive-p)
6748645f 2234 (gnus-no-server))
01c52d31 2235 (gnus-group-read-group (if articles nil t) nil group articles))
eec82323 2236
6748645f
LMI		 2237;;;###autoload
2238(defun gnus-fetch-group-other-frame (group)
2239 "Pop up a frame and enter GROUP."
2240 (interactive "P")
2241 (let ((window (get-buffer-window gnus-group-buffer)))
2242 (cond (window
2243 (select-frame (window-frame window)))
2244 ((= (length (frame-list)) 1)
2245 (select-frame (make-frame)))
2246 (t
2247 (other-frame 1))))
2248 (gnus-fetch-group group))
2249
23f87bed
MB		 2250(defcustom gnus-large-ephemeral-newsgroup 200
2251 "The number of articles which indicates a large ephemeral newsgroup.
2252Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups.
2253
2254If the number of articles in a newsgroup is greater than this value,
2255confirmation is required for selecting the newsgroup. If it is nil, no
2256confirmation is required."
bf247b6e 2257 :version "22.1"
23f87bed
MB		 2258 :group 'gnus-group-select
2259 :type '(choice (const :tag "No limit" nil)
2260 integer))
2261
2262(defcustom gnus-fetch-old-ephemeral-headers nil
2263 "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups."
bf247b6e 2264 :version "22.1"
23f87bed
MB		 2265 :group 'gnus-thread
2266 :type '(choice (const :tag "off" nil)
2267 (const some)
2268 number
2269 (sexp :menu-tag "other" t)))
2270
eec82323
LMI		 2271;; Enter a group that is not in the group buffer. Non-nil is returned
2272;; if selection was successful.
2273(defun gnus-group-read-ephemeral-group (group method &optional activate
6748645f 2274 quit-config request-only
23f87bed 2275 select-articles
10ace8ea
MB		 2276 parameters
2277 number)
eec82323
LMI		 2278 "Read GROUP from METHOD as an ephemeral group.
2279If ACTIVATE, request the group first.
e7719ea1
G		 2280If QUIT-CONFIG, use that Gnus window configuration name when
2281exiting from the ephemeral group.
eec82323 2282If REQUEST-ONLY, don't actually read the group; just request it.
6748645f 2283If SELECT-ARTICLES, only select those articles.
23f87bed 2284If PARAMETERS, use those as the group parameters.
10ace8ea 2285If NUMBER, fetch this number of articles.
eec82323 2286
16409b0b 2287Return the name of the group if selection was successful."
23f87bed
MB		 2288 (interactive
2289 (list
2290 ;; (gnus-read-group "Group name: ")
229b59da 2291 (gnus-group-completing-read)
1fe0787f 2292 (gnus-read-method "From method")))
64a465b2 2293 (unless (gnus-alive-p)
89b163db
G		 2294 (nnheader-init-server-buffer)
2295 ;; Necessary because of funky inlining.
2296 (require 'gnus-cache)
2297 (setq gnus-newsrc-hashtb (gnus-make-hashtable)))
2298 ;; Transform the select method into a unique server.
6748645f
LMI		 2299 (when (stringp method)
2300 (setq method (gnus-server-to-method method)))
dc637e3d
LI		 2301 (let ((address-slot
2302 (intern (format "%s-address" (car method)))))
2303 (setq method
2304 (if (assq address-slot (cddr method))
2305 `(,(car method) ,(concat (cadr method) "-ephemeral")
2306 ,@(cddr method))
2307 `(,(car method) ,(concat (cadr method) "-ephemeral")
2308 (,address-slot ,(cadr method))
2309 ,@(cddr method)))))
eec82323 2310 (let ((group (if (gnus-group-foreign-p group) group
23f87bed
MB		 2311 (gnus-group-prefixed-name (gnus-group-real-name group)
2312 method))))
eec82323
LMI		 2313 (gnus-sethash
2314 group
2315 `(-1 nil (,group
2316 ,gnus-level-default-subscribed nil nil ,method
23f87bed 2317 ,(cons
89b163db
G		 2318 (cons 'quit-config
2319 (cond
2320 (quit-config
2321 quit-config)
2322 ((assq gnus-current-window-configuration
2323 gnus-buffer-configuration)
23f87bed 2324 (cons gnus-summary-buffer
89b163db
G		 2325 gnus-current-window-configuration))
2326 (t
2327 (cons (current-buffer)
2328 (current-window-configuration)))))
23f87bed 2329 parameters)))
eec82323 2330 gnus-newsrc-hashtb)
6748645f 2331 (push method gnus-ephemeral-servers)
89b163db
G		 2332 (when (gnus-buffer-live-p gnus-group-buffer)
2333 (set-buffer gnus-group-buffer))
eec82323
LMI		 2334 (unless (gnus-check-server method)
2335 (error "Unable to contact server: %s" (gnus-status-message method)))
2336 (when activate
2337 (gnus-activate-group group 'scan)
2338 (unless (gnus-request-group group)
2339 (error "Couldn't request group: %s"
2340 (nnheader-get-report (car method)))))
2341 (if request-only
2342 group
2343 (condition-case ()
23f87bed
MB		 2344 (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup)
2345 (gnus-fetch-old-headers
2346 gnus-fetch-old-ephemeral-headers))
10ace8ea 2347 (gnus-group-read-group (or number t) t group select-articles))
eec82323 2348 group)
2491844d 2349 (quit
a123622d
G		 2350 (if debug-on-quit
2351 (debug "Quit")
2352 (message "Quit reading the ephemeral group"))
2491844d 2353 nil)))))
eec82323 2354
9b3ebcb6 2355(defcustom gnus-gmane-group-download-format
95838435
MB		 2356 "http://download.gmane.org/%s/%s/%s"
2357 "URL for downloading mbox files.
2358It must contain three \"%s\". They correspond to the group, the
2359minimal and maximal article numbers, respectively."
2360 :group 'gnus-group-foreign
330f707b 2361 :version "23.1" ;; No Gnus
95838435 2362 :type 'string)
d82cf70b 2363
95838435
MB		 2364(autoload 'url-insert-file-contents "url-handlers")
2365;; FIXME:
2366;; - Add documentation, menu, key bindings, ...
d82cf70b 2367
9b3ebcb6 2368(defun gnus-read-ephemeral-gmane-group (group start &optional range)
d82cf70b 2369 "Read articles from Gmane group GROUP as an ephemeral group.
95838435
MB		 2370START is the first article. RANGE specifies how many articles
2371are fetched. The articles are downloaded via HTTP using the URL
9b3ebcb6 2372specified by `gnus-gmane-group-download-format'."
d82cf70b
MB		 2373 ;; See <http://gmane.org/export.php> for more information.
2374 (interactive
2375 (list
229b59da 2376 (gnus-group-completing-read "Gmane group")
d82cf70b 2377 (read-number "Start article number: ")
95838435
MB		 2378 (read-number "How many articles: ")))
2379 (unless range (setq range 500))
2380 (when (< range 1)
2381 (error "Invalid range: %s" range))
765d4319 2382 (let ((tmpfile (mm-make-temp-file
95838435
MB		 2383 (format "%s.start-%s.range-%s." group start range)))
2384 (gnus-thread-sort-functions '(gnus-thread-sort-by-number)))
d82cf70b
MB		 2385 (with-temp-file tmpfile
2386 (url-insert-file-contents
9b3ebcb6 2387 (format gnus-gmane-group-download-format
95838435 2388 group start (+ start range)))
d82cf70b
MB		 2389 (write-region (point-min) (point-max) tmpfile)
2390 (gnus-group-read-ephemeral-group
845ce106 2391 (format "nndoc+ephemeral:%s.start-%s.range-%s" group start range)
d82cf70b 2392 `(nndoc ,tmpfile
8f7abae3 2393 (nndoc-article-type mbox))))
d82cf70b
MB		 2394 (delete-file tmpfile)))
2395
9b3ebcb6 2396(defun gnus-read-ephemeral-gmane-group-url (url)
95838435
MB		 2397 "Create an ephemeral Gmane group from URL.
2398
2399Valid input formats include:
2400\"http://thread.gmane.org/gmane.foo.bar/12300/focus=12399\",
2401\"http://thread.gmane.org/gmane.foo.bar/12345/\",
2402\"http://article.gmane.org/gmane.foo.bar/12345/\",
2403\"http://news.gmane.org/group/gmane.foo.bar/thread=12345\""
2404 ;; - Feel free to add other useful Gmane URLs here! Maybe the URLs should
2405 ;; be customizable?
2406 ;; - The URLs should be added to `gnus-button-alist'. Probably we should
2407 ;; prompt the user to decide: "View via `browse-url' or in Gnus? "
9b3ebcb6 2408 ;; (`gnus-read-ephemeral-gmane-group-url')
95838435 2409 (interactive
229b59da 2410 (list (gnus-group-completing-read "Gmane URL")))
95838435
MB		 2411 (let (group start range)
2412 (cond
2413 ;; URLs providing `group', `start' and `range':
2414 ((string-match
2415 ;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525
2416 "^http://thread\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$"
2417 url)
2418 (setq group (match-string 1 url)
2419 start (string-to-number (match-string 2 url))
2420 ;; Ensure that `range' is large enough to ensure focus article is
2421 ;; included.
2422 range (- (string-to-number (match-string 3 url))
2423 start -1)))
2424 ;; URLs providing `group' and `start':
2425 ((or (string-match
2426 ;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584
8f7abae3 2427 "^http://\\(?:thread\\|article\\|permalink\\)\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
95838435
MB		 2428 url)
2429 (string-match
834ee131 2430 ;; Don't advertise these in the doc string yet:
95838435
MB		 2431 "^\\(?:nntp\\|news\\)://news\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
2432 url)
2433 (string-match
2434 ;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t
2435 "^http://news\.gmane\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)"
2436 url))
2437 (setq group (match-string 1 url)
2438 start (string-to-number (match-string 2 url))))
2439 (t
2440 (error "Can't parse URL %s" url)))
9b3ebcb6
MB		 2441 (gnus-read-ephemeral-gmane-group group start range)))
2442
2443(defcustom gnus-bug-group-download-format-alist
0b007ea9 2444 '((emacs . "http://debbugs.gnu.org/%s;mboxmaint=yes;mboxstat=yes")
9b3ebcb6 2445 (debian
8c7c1f6d 2446 . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes;mboxmaint=yes"))
9b3ebcb6
MB		 2447 "Alist of symbols for bug trackers and the corresponding URL format string.
2448The URL format string must contain a single \"%s\", specifying
2449the bug number, and browsing the URL must return mbox output."
2450 :group 'gnus-group-foreign
8c7c1f6d
GM		 2451 ;; Added mboxmaint=yes. This gets the version with the messages as
2452 ;; they went out, not as they came in.
99451919
GM		 2453 ;; Eg bug-gnu-emacs is replaced by ###@debbugs.
2454 :version "24.1"
9b3ebcb6
MB		 2455 :type '(repeat (cons (symbol) (string :tag "URL format string"))))
2456
d30dd079 2457(defun gnus-read-ephemeral-bug-group (ids mbox-url &optional window-conf)
9b3ebcb6
MB		 2458 "Browse bug NUMBER as ephemeral group."
2459 (interactive (list (read-string "Enter bug number: "
2460 (thing-at-point 'word) nil)
2461 ;; FIXME: Add completing-read from
2462 ;; `gnus-emacs-bug-group-download-format' ...
2463 (cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
d30dd079
G		 2464 (when (stringp ids)
2465 (setq ids (string-to-number ids)))
2466 (unless (listp ids)
2467 (setq ids (list ids)))
cd865a33
G		 2468 (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))
2469 (coding-system-for-write 'binary)
2470 (coding-system-for-read 'binary))
9b3ebcb6 2471 (with-temp-file tmpfile
d30dd079
G		 2472 (dolist (id ids)
2473 (url-insert-file-contents (format mbox-url id)))
8ccbef23
G		 2474 (goto-char (point-min))
2475 ;; Add the debbugs address so that we can respond to reports easily.
2476 (while (re-search-forward "^To: " nil t)
2477 (end-of-line)
d30dd079 2478 (insert (format ", %s@%s" (car ids)
e617ab06
KY		 2479 (gnus-replace-in-string
2480 (gnus-replace-in-string mbox-url "^http://" "")
2481 "/.*$" ""))))
9b3ebcb6
MB		 2482 (write-region (point-min) (point-max) tmpfile)
2483 (gnus-group-read-ephemeral-group
845ce106 2484 (format "nndoc+ephemeral:bug#%s"
067b39d4 2485 (mapconcat 'number-to-string ids ","))
9b3ebcb6 2486 `(nndoc ,tmpfile
b09c3fe0
G		 2487 (nndoc-article-type mbox))
2488 nil window-conf))
9b3ebcb6
MB		 2489 (delete-file tmpfile)))
2490
2491(defun gnus-read-ephemeral-debian-bug-group (number)
2492 "Browse Debian bug NUMBER as ephemeral group."
2493 (interactive (list (read-string "Enter bug number: "
2494 (thing-at-point 'word) nil)))
2495 (gnus-read-ephemeral-bug-group
2496 number
2497 (cdr (assoc 'debian gnus-bug-group-download-format-alist))))
2498
61243ace 2499(defvar debbugs-gnu-bug-number) ; debbugs-gnu
929ca925 2500
d30dd079
G		 2501(defun gnus-read-ephemeral-emacs-bug-group (ids &optional window-conf)
2502 "Browse Emacs bugs IDS as an ephemeral group."
cd865a33
G		 2503 (interactive (list (string-to-number
2504 (read-string "Enter bug number: "
2505 (thing-at-point 'word) nil))))
d30dd079
G		 2506 (unless (listp ids)
2507 (setq ids (list ids)))
9b3ebcb6 2508 (gnus-read-ephemeral-bug-group
d30dd079 2509 ids
b09c3fe0 2510 (cdr (assoc 'emacs gnus-bug-group-download-format-alist))
cd865a33 2511 window-conf)
61243ace 2512 (when (fboundp 'debbugs-gnu-summary-mode)
cd865a33 2513 (with-current-buffer (window-buffer (selected-window))
61243ace
LMI		 2514 (debbugs-gnu-summary-mode 1)
2515 (set (make-local-variable 'debbugs-gnu-bug-number) (car ids)))))
95838435 2516
01c52d31
MB		 2517(defun gnus-group-jump-to-group (group &optional prompt)
2518 "Jump to newsgroup GROUP.
2519
2520If PROMPT (the prefix) is a number, use the prompt specified in
2521`gnus-group-jump-to-group-prompt'."
eec82323 2522 (interactive
01c52d31 2523 (list (gnus-group-completing-read
e389d61f 2524 nil nil nil
229b59da
G		 2525 (if current-prefix-arg
2526 (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
2527 (or (and (stringp gnus-group-jump-to-group-prompt)
2528 gnus-group-jump-to-group-prompt)
2529 (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
2530 (and (stringp p) p)))))))
eec82323
LMI		 2531
2532 (when (equal group "")
2533 (error "Empty group name"))
2534
2535 (unless (gnus-ephemeral-group-p group)
2536 ;; Either go to the line in the group buffer...
2537 (unless (gnus-group-goto-group group)
2538 ;; ... or insert the line.
2539 (gnus-group-update-group group)
2540 (gnus-group-goto-group group)))
2541 ;; Adjust cursor point.
2542 (gnus-group-position-point))
2543
16409b0b 2544(defun gnus-group-goto-group (group &optional far test-marked)
eec82323 2545 "Goto to newsgroup GROUP.
16409b0b
GM		 2546If FAR, it is likely that the group is not on the current line.
2547If TEST-MARKED, the line must be marked."
eec82323 2548 (when group
16409b0b
GM		 2549 (beginning-of-line)
2550 (cond
2551 ;; It's quite likely that we are on the right line, so
2552 ;; we check the current line first.
2553 ((and (not far)
2554 (eq (get-text-property (point) 'gnus-group)
2555 (gnus-intern-safe group gnus-active-hashtb))
2556 (or (not test-marked) (gnus-group-mark-line-p)))
2557 (point))
2558 ;; Previous and next line are also likely, so we check them as well.
2559 ((and (not far)
2560 (save-excursion
2561 (forward-line -1)
2562 (and (eq (get-text-property (point) 'gnus-group)
2563 (gnus-intern-safe group gnus-active-hashtb))
2564 (or (not test-marked) (gnus-group-mark-line-p)))))
2565 (forward-line -1)
2566 (point))
2567 ((and (not far)
2568 (save-excursion
2569 (forward-line 1)
2570 (and (eq (get-text-property (point) 'gnus-group)
2571 (gnus-intern-safe group gnus-active-hashtb))
2572 (or (not test-marked) (gnus-group-mark-line-p)))))
2573 (forward-line 1)
2574 (point))
2575 (test-marked
2576 (goto-char (point-min))
2577 (let (found)
a1506d29 2578 (while (and (not found)
16409b0b
GM		 2579 (gnus-goto-char
2580 (text-property-any
2581 (point) (point-max)
a1506d29 2582 'gnus-group
16409b0b
GM		 2583 (gnus-intern-safe group gnus-active-hashtb))))
2584 (if (gnus-group-mark-line-p)
2585 (setq found t)
2586 (forward-line 1)))
2587 found))
2588 (t
2589 ;; Search through the entire buffer.
2590 (gnus-goto-char
2591 (text-property-any
2592 (point-min) (point-max)
2593 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))
eec82323
LMI		 2594
2595(defun gnus-group-next-group (n &optional silent)
2596 "Go to next N'th newsgroup.
2597If N is negative, search backward instead.
2598Returns the difference between N and the number of skips actually
2599done."
2600 (interactive "p")
2601 (gnus-group-next-unread-group n t nil silent))
2602
2603(defun gnus-group-next-unread-group (n &optional all level silent)
2604 "Go to next N'th unread newsgroup.
2605If N is negative, search backward instead.
2606If ALL is non-nil, choose any newsgroup, unread or not.
2607If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
2608such group can be found, the next group with a level higher than
2609LEVEL.
2610Returns the difference between N and the number of skips actually
2611made."
2612 (interactive "p")
2613 (let ((backward (< n 0))
2614 (n (abs n)))
2615 (while (and (> n 0)
2616 (gnus-group-search-forward
2617 backward (or (not gnus-group-goto-unread) all) level))
2618 (setq n (1- n)))
2619 (when (and (/= 0 n)
2620 (not silent))
2621 (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
2622 (if level " on this level or higher" "")))
2623 n))
2624
2625(defun gnus-group-prev-group (n)
2626 "Go to previous N'th newsgroup.
2627Returns the difference between N and the number of skips actually
2628done."
2629 (interactive "p")
2630 (gnus-group-next-unread-group (- n) t))
2631
2632(defun gnus-group-prev-unread-group (n)
2633 "Go to previous N'th unread newsgroup.
2634Returns the difference between N and the number of skips actually
2635done."
2636 (interactive "p")
2637 (gnus-group-next-unread-group (- n)))
2638
2639(defun gnus-group-next-unread-group-same-level (n)
2640 "Go to next N'th unread newsgroup on the same level.
2641If N is negative, search backward instead.
2642Returns the difference between N and the number of skips actually
2643done."
2644 (interactive "p")
2645 (gnus-group-next-unread-group n t (gnus-group-group-level))
2646 (gnus-group-position-point))
2647
2648(defun gnus-group-prev-unread-group-same-level (n)
2649 "Go to next N'th unread newsgroup on the same level.
2650Returns the difference between N and the number of skips actually
2651done."
2652 (interactive "p")
2653 (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
2654 (gnus-group-position-point))
2655
2656(defun gnus-group-best-unread-group (&optional exclude-group)
2657 "Go to the group with the highest level.
2658If EXCLUDE-GROUP, do not go to that group."
2659 (interactive)
2660 (goto-char (point-min))
2661 (let ((best 100000)
2662 unread best-point)
2663 (while (not (eobp))
2664 (setq unread (get-text-property (point) 'gnus-unread))
2665 (when (and (numberp unread) (> unread 0))
2666 (when (and (get-text-property (point) 'gnus-level)
2667 (< (get-text-property (point) 'gnus-level) best)
2668 (or (not exclude-group)
2669 (not (equal exclude-group (gnus-group-group-name)))))
2670 (setq best (get-text-property (point) 'gnus-level))
2671 (setq best-point (point))))
2672 (forward-line 1))
2673 (when best-point
2674 (goto-char best-point))
23f87bed 2675 (gnus-group-position-point)
eec82323
LMI		 2676 (and best-point (gnus-group-group-name))))
2677
01c52d31
MB		 2678;; Is there something like an after-point-motion-hook?
2679;; (inhibit-point-motion-hooks?). Is there a tool-bar-update function?
2680
2681;; (defun gnus-group-menu-bar-update ()
2682;; (let* ((buf (list (with-current-buffer gnus-group-buffer
2683;; (current-buffer))))
2684;; (name (buffer-name (car buf))))
2685;; (setcdr buf
2686;; (if (> (length name) 27)
2687;; (concat (substring name 0 12)
2688;; "..."
2689;; (substring name -12))
2690;; name))
2691;; (menu-bar-update-buffers-1 buf)))
2692
2693;; (defun gnus-group-position-point ()
2694;; (gnus-goto-colon)
2695;; (gnus-group-menu-bar-update))
2696
eec82323
LMI		 2697(defun gnus-group-first-unread-group ()
2698 "Go to the first group with unread articles."
2699 (interactive)
2700 (prog1
2701 (let ((opoint (point))
2702 unread)
2703 (goto-char (point-min))
2704 (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
2705 (and (numberp unread) ; Not a topic.
2706 (not (zerop unread))) ; Has unread articles.
2707 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
2708 (point) ; Success.
2709 (goto-char opoint)
2710 nil)) ; Not success.
2711 (gnus-group-position-point)))
2712
2713(defun gnus-group-enter-server-mode ()
2714 "Jump to the server buffer."
2715 (interactive)
2716 (gnus-enter-server-buffer))
2717
01c52d31
MB		 2718(defun gnus-group-make-group-simple (&optional group)
2719 "Add a new newsgroup.
2720The user will be prompted for GROUP."
229b59da 2721 (interactive (list (gnus-group-completing-read)))
01c52d31
MB		 2722 (gnus-group-make-group (gnus-group-real-name group)
2723 (gnus-group-server group)
2724 nil nil t))
2725
2726(defun gnus-group-make-group (name &optional method address args encoded)
eec82323
LMI		 2727 "Add a new newsgroup.
2728The user will be prompted for a NAME, for a select METHOD, and an
01c52d31 2729ADDRESS. NAME should be a human-readable string (i.e., not be encoded
130e977f
LMI		 2730even if it contains non-ASCII characters) unless ENCODED is non-nil.
2731
2732If the backend supports it, the group will also be created on the
2733server."
eec82323
LMI		 2734 (interactive
2735 (list
2736 (gnus-read-group "Group name: ")
1fe0787f 2737 (gnus-read-method "From method")))
eec82323 2738
6748645f 2739 (when (stringp method)
16409b0b 2740 (setq method (or (gnus-server-to-method method) method)))
01c52d31
MB		 2741 (unless encoded
2742 (setq name (mm-encode-coding-string
2743 name
2744 (gnus-group-name-charset method name))))
16409b0b
GM		 2745 (let* ((meth (gnus-method-simplify
2746 (when (and method
2747 (not (gnus-server-equal method gnus-select-method)))
2748 (if address (list (intern method) address)
2749 method))))
eec82323
LMI		 2750 (nname (if method (gnus-group-prefixed-name name meth) name))
2751 backend info)
01c52d31 2752 (when (gnus-group-entry nname)
91472578 2753 (error "Group %s already exists" (gnus-group-decoded-name nname)))
eec82323
LMI		 2754 ;; Subscribe to the new group.
2755 (gnus-group-change-level
2756 (setq info (list t nname gnus-level-default-subscribed nil nil meth))
2757 gnus-level-default-subscribed gnus-level-killed
2758 (and (gnus-group-group-name)
01c52d31 2759 (gnus-group-entry (gnus-group-group-name)))
eec82323
LMI		 2760 t)
2761 ;; Make it active.
2762 (gnus-set-active nname (cons 1 0))
2763 (unless (gnus-ephemeral-group-p name)
2764 (gnus-dribble-enter
2765 (concat "(gnus-group-set-info '"
b229f37d
KY		 2766 (gnus-prin1-to-string (cdr info)) ")")
2767 (concat "^(gnus-group-set-info '(\"" (regexp-quote name) "\"")))
eec82323
LMI		 2768 ;; Insert the line.
2769 (gnus-group-insert-group-line-info nname)
2770 (forward-line -1)
2771 (gnus-group-position-point)
2772
23f87bed 2773 ;; Load the back end and try to make the back end create
eec82323
LMI		 2774 ;; the group as well.
2775 (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
2776 nil meth))))
2777 gnus-valid-select-methods)
2778 (require backend))
2779 (gnus-check-server meth)
2780 (when (gnus-check-backend-function 'request-create-group nname)
23f87bed
MB		 2781 (unless (gnus-request-create-group nname nil args)
2782 (error "Could not create group on server: %s"
2783 (nnheader-get-report backend))))
eec82323
LMI		 2784 t))
2785
16409b0b
GM		 2786(defun gnus-group-delete-groups (&optional arg)
2787 "Delete the current group. Only meaningful with editable groups."
2788 (interactive "P")
2789 (let ((n (length (gnus-group-process-prefix arg))))
2790 (when (gnus-yes-or-no-p
2791 (if (= n 1)
2792 "Delete this 1 group? "
2793 (format "Delete these %d groups? " n)))
2794 (gnus-group-iterate arg
2795 (lambda (group)
2796 (gnus-group-delete-group group nil t))))))
2797
70041e9a
G		 2798(defun gnus-group-delete-articles (group)
2799 "Delete all articles in the current group."
2800 (interactive (list (gnus-group-group-name)))
2801 (let ((articles (gnus-uncompress-range (gnus-active group))))
2802 (when (gnus-yes-or-no-p
2803 (format "Do you really want to delete these %d articles forever? "
2804 (length articles)))
2805 (gnus-request-expire-articles articles group 'force))))
2806
16409b0b
GM		 2807(defun gnus-group-delete-group (group &optional force no-prompt)
2808 "Delete the current group. Only meaningful with editable groups.
eec82323
LMI		 2809If FORCE (the prefix) is non-nil, all the articles in the group will
2810be deleted. This is \"deleted\" as in \"removed forever from the face
c30ba437 2811of the Earth\". There is no undo. The user will be prompted before
23f87bed
MB		 2812doing the deletion.
2813Note that you also have to specify FORCE if you want the group to
2814be removed from the server, even when it's empty."
eec82323
LMI		 2815 (interactive
2816 (list (gnus-group-group-name)
2817 current-prefix-arg))
2818 (unless group
23f87bed 2819 (error "No group to delete"))
eec82323 2820 (unless (gnus-check-backend-function 'request-delete-group group)
23f87bed 2821 (error "This back end does not support group deletion"))
eec82323 2822 (prog1
91472578
MB		 2823 (let ((group-decoded (gnus-group-decoded-name group)))
2824 (if (and (not no-prompt)
2825 (not (gnus-yes-or-no-p
2826 (format
2827 "Do you really want to delete %s%s? "
2828 group-decoded (if force " and all its contents" "")))))
2829 () ; Whew!
2830 (gnus-message 6 "Deleting group %s..." group-decoded)
2831 (if (not (gnus-request-delete-group group force))
2832 (gnus-error 3 "Couldn't delete group %s" group-decoded)
2833 (gnus-message 6 "Deleting group %s...done" group-decoded)
2834 (gnus-group-goto-group group)
2835 (gnus-group-kill-group 1 t)
01c52d31 2836 (gnus-set-active group nil)
91472578 2837 t)))
eec82323
LMI		 2838 (gnus-group-position-point)))
2839
2840(defun gnus-group-rename-group (group new-name)
2841 "Rename group from GROUP to NEW-NAME.
2842When used interactively, GROUP is the group under point
2843and NEW-NAME will be prompted for."
2844 (interactive
4d8a28ec
MB		 2845 (let ((group (gnus-group-group-name))
2846 method new-name)
2847 (unless (gnus-check-backend-function 'request-rename-group group)
2848 (error "This back end does not support renaming groups"))
2849 (setq new-name (gnus-read-group
2850 "Rename group to: "
2851 (gnus-group-real-name (gnus-group-decoded-name group)))
2852 method (gnus-info-method (gnus-get-info group)))
2853 (list group (mm-encode-coding-string
2854 new-name
2855 (gnus-group-name-charset
2856 method
2857 (gnus-group-prefixed-name new-name method))))))
eec82323
LMI		 2858
2859 (unless (gnus-check-backend-function 'request-rename-group group)
23f87bed 2860 (error "This back end does not support renaming groups"))
eec82323
LMI		 2861 (unless group
2862 (error "No group to rename"))
2863 (when (equal (gnus-group-real-name group) new-name)
2864 (error "Can't rename to the same name"))
2865
2866 ;; We find the proper prefixed name.
2867 (setq new-name
2868 (if (gnus-group-native-p group)
2869 ;; Native group.
2870 new-name
2871 ;; Foreign group.
2872 (gnus-group-prefixed-name
2873 (gnus-group-real-name new-name)
2874 (gnus-info-method (gnus-get-info group)))))
2875
4d8a28ec
MB		 2876 (let ((decoded-group (gnus-group-decoded-name group))
2877 (decoded-new-name (gnus-group-decoded-name new-name)))
2878 (when (gnus-active new-name)
2879 (error "The group %s already exists" decoded-new-name))
2880
2881 (gnus-message 6 "Renaming group %s to %s..."
2882 decoded-group decoded-new-name)
2883 (prog1
2884 (if (progn
2885 (gnus-group-goto-group group)
2886 (not (when (< (gnus-group-group-level) gnus-level-zombie)
2887 (gnus-request-rename-group group new-name))))
2888 (gnus-error 3 "Couldn't rename group %s to %s"
2889 decoded-group decoded-new-name)
2890 ;; We rename the group internally by killing it...
2891 (gnus-group-kill-group)
2892 ;; ... changing its name ...
2893 (setcar (cdar gnus-list-of-killed-groups) new-name)
2894 ;; ... and then yanking it. Magic!
2895 (gnus-group-yank-group)
2896 (gnus-set-active new-name (gnus-active group))
2897 (gnus-message 6 "Renaming group %s to %s...done"
2898 decoded-group decoded-new-name)
2899 new-name)
2900 (setq gnus-killed-list (delete group gnus-killed-list))
2901 (gnus-set-active group nil)
2902 (gnus-dribble-touch)
2903 (gnus-group-position-point))))
eec82323
LMI		 2904
2905(defun gnus-group-edit-group (group &optional part)
2906 "Edit the group on the current line."
2907 (interactive (list (gnus-group-group-name)))
2908 (let ((part (or part 'info))
2909 info)
2910 (unless group
2911 (error "No group on current line"))
2912 (unless (setq info (gnus-get-info group))
2913 (error "Killed group; can't be edited"))
2914 (ignore-errors
2915 (gnus-close-group group))
2916 (gnus-edit-form
2917 ;; Find the proper form to edit.
2918 (cond ((eq part 'method)
2919 (or (gnus-info-method info) "native"))
2920 ((eq part 'params)
2921 (gnus-info-params info))
2922 (t info))
2923 ;; The proper documentation.
2924 (format
2925 "Editing the %s for `%s'."
2926 (cond
2927 ((eq part 'method) "select method")
2928 ((eq part 'params) "group parameters")
2929 (t "group info"))
16409b0b 2930 (gnus-group-decoded-name group))
eec82323 2931 `(lambda (form)
23f87bed
MB		 2932 (gnus-group-edit-group-done ',part ,group form)))
2933 (local-set-key
2934 "\C-c\C-i"
2935 (gnus-create-info-command
2936 (cond
2937 ((eq part 'method)
2938 "(gnus)Select Methods")
2939 ((eq part 'params)
2940 "(gnus)Group Parameters")
2941 (t
2942 "(gnus)Group Info"))))))
eec82323
LMI		 2943
2944(defun gnus-group-edit-group-method (group)
2945 "Edit the select method of GROUP."
2946 (interactive (list (gnus-group-group-name)))
2947 (gnus-group-edit-group group 'method))
2948
2949(defun gnus-group-edit-group-parameters (group)
2950 "Edit the group parameters of GROUP."
2951 (interactive (list (gnus-group-group-name)))
2952 (gnus-group-edit-group group 'params))
2953
2954(defun gnus-group-edit-group-done (part group form)
2955 "Update variables."
2956 (let* ((method (cond ((eq part 'info) (nth 4 form))
2957 ((eq part 'method) form)
2958 (t nil)))
2959 (info (cond ((eq part 'info) form)
2960 ((eq part 'method) (gnus-get-info group))
2961 (t nil)))
2962 (new-group (if info
2963 (if (or (not method)
2964 (gnus-server-equal
2965 gnus-select-method method))
2966 (gnus-group-real-name (car info))
2967 (gnus-group-prefixed-name
2968 (gnus-group-real-name (car info)) method))
2969 nil)))
2970 (when (and new-group
2971 (not (equal new-group group)))
2972 (when (gnus-group-goto-group group)
2973 (gnus-group-kill-group 1))
2974 (gnus-activate-group new-group))
2975 ;; Set the info.
2976 (if (not (and info new-group))
2977 (gnus-group-set-info form (or new-group group) part)
2978 (setq info (gnus-copy-sequence info))
2979 (setcar info new-group)
2980 (unless (gnus-server-equal method "native")
2981 (unless (nthcdr 3 info)
2982 (nconc info (list nil nil)))
2983 (unless (nthcdr 4 info)
2984 (nconc info (list nil)))
2985 (gnus-info-set-method info method))
2986 (gnus-group-set-info info))
2987 (gnus-group-update-group (or new-group group))
2988 (gnus-group-position-point)))
2989
2990(defun gnus-group-make-useful-group (group method)
6748645f 2991 "Create one of the groups described in `gnus-useful-groups'."
eec82323 2992 (interactive
229b59da
G		 2993 (let ((entry (assoc (gnus-completing-read "Create group"
2994 (mapcar 'car gnus-useful-groups)
2995 t)
eec82323 2996 gnus-useful-groups)))
1ae03cd5
KY		 2997 (list (cadr entry)
2998 ;; Don't use `caddr' here since macros within the `interactive'
2999 ;; form won't be expanded.
3000 (car (cddr entry)))))
eec82323
LMI		 3001 (setq method (gnus-copy-sequence method))
3002 (let (entry)
3003 (while (setq entry (memq (assq 'eval method) method))
3004 (setcar entry (eval (cadar entry)))))
3005 (gnus-group-make-group group method))
3006
23f87bed
MB		 3007(defun gnus-group-make-help-group (&optional noerror)
3008 "Create the Gnus documentation group.
3009Optional argument NOERROR modifies the behavior of this function when the
3010group already exists:
3011- if not given, and error is signaled,
3012- if t, stay silent,
3013- if anything else, just print a message."
eec82323
LMI		 3014 (interactive)
3015 (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
6748645f 3016 (file (nnheader-find-etc-directory "gnus-tut.txt" t)))
01c52d31 3017 (if (gnus-group-entry name)
23f87bed
MB		 3018 (cond ((eq noerror nil)
3019 (error "Documentation group already exists"))
3020 ((eq noerror t)
3021 ;; stay silent
3022 )
3023 (t
3024 (gnus-message 1 "Documentation group already exists")))
3025 ;; else:
3026 (if (not file)
3027 (gnus-message 1 "Couldn't find doc group")
3028 (gnus-group-make-group
3029 (gnus-group-real-name name)
3030 (list 'nndoc "gnus-help"
3031 (list 'nndoc-address file)
3032 (list 'nndoc-article-type 'mbox))))
3033 ))
eec82323
LMI		 3034 (gnus-group-position-point))
3035
3036(defun gnus-group-make-doc-group (file type)
270a576a
MB		 3037 "Create a group that uses a single file as the source.
3038
3039If called with a prefix argument, ask for the file type."
eec82323
LMI		 3040 (interactive
3041 (list (read-file-name "File name: ")
3042 (and current-prefix-arg 'ask)))
3043 (when (eq type 'ask)
3044 (let ((err "")
3045 char found)
3046 (while (not found)
3047 (message
270a576a 3048 "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: "
eec82323
LMI		 3049 err)
3050 (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
3051 ((= char ?b) 'babyl)
3052 ((= char ?d) 'digest)
3053 ((= char ?f) 'forward)
3054 ((= char ?a) 'mmfd)
16409b0b 3055 ((= char ?g) 'guess)
eec82323
LMI		 3056 (t (setq err (format "%c unknown. " char))
3057 nil))))
3058 (setq type found)))
c86d4601 3059 (setq file (expand-file-name file))
01c52d31
MB		 3060 (let* ((name (gnus-generate-new-group-name
3061 (gnus-group-prefixed-name
3062 (file-name-nondirectory file) '(nndoc ""))))
3063 (method (list 'nndoc file
3064 (list 'nndoc-address file)
3065 (list 'nndoc-article-type (or type 'guess))))
3066 (coding (gnus-group-name-charset method name)))
3067 (setcar (cdr method) (mm-encode-coding-string file coding))
eec82323 3068 (gnus-group-make-group
01c52d31
MB		 3069 (mm-encode-coding-string (gnus-group-real-name name) coding)
3070 method nil nil t)))
eec82323
LMI		 3071
3072(defvar nnweb-type-definition)
3073(defvar gnus-group-web-type-history nil)
3074(defvar gnus-group-web-search-history nil)
3075(defun gnus-group-make-web-group (&optional solid)
3076 "Create an ephemeral nnweb group.
3077If SOLID (the prefix), create a solid group."
3078 (interactive "P")
3079 (require 'nnweb)
3080 (let* ((group
3081 (if solid (gnus-read-group "Group name: ")
3082 (message-unique-id)))
a8151ef7
LMI		 3083 (default-type (or (car gnus-group-web-type-history)
3084 (symbol-name (caar nnweb-type-definition))))
eec82323 3085 (type
a8151ef7 3086 (gnus-string-or
229b59da
G		 3087 (gnus-completing-read
3088 "Search engine type"
3089 (mapcar (lambda (elem) (symbol-name (car elem)))
a8151ef7 3090 nnweb-type-definition)
229b59da 3091 t nil 'gnus-group-web-type-history)
a8151ef7 3092 default-type))
eec82323
LMI		 3093 (search
3094 (read-string
3095 "Search string: "
3096 (cons (or (car gnus-group-web-search-history) "") 0)
3097 'gnus-group-web-search-history))
3098 (method
3099 `(nnweb ,group (nnweb-search ,search)
3100 (nnweb-type ,(intern type))
3101 (nnweb-ephemeral-p t))))
3102 (if solid
23f87bed 3103 (progn
36d3245f 3104 (gnus-alist-pull 'nnweb-ephemeral-p method)
23f87bed 3105 (gnus-group-make-group group method))
eec82323
LMI		 3106 (gnus-group-read-ephemeral-group
3107 group method t
3108 (cons (current-buffer)
3109 (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
3110
9efa445f 3111(defvar nnrss-group-alist)
23f87bed 3112(eval-when-compile
23f87bed
MB		 3113 (defun nnrss-discover-feed (arg))
3114 (defun nnrss-save-server-data (arg)))
3115(defun gnus-group-make-rss-group (&optional url)
3116 "Given a URL, discover if there is an RSS feed.
3117If there is, use Gnus to create an nnrss group"
3118 (interactive)
3119 (require 'nnrss)
3120 (if (not url)
3121 (setq url (read-from-minibuffer "URL to Search for RSS: ")))
3122 (let ((feedinfo (nnrss-discover-feed url)))
3123 (if feedinfo
01c52d31
MB		 3124 (let* ((title (gnus-newsgroup-savable-name
3125 (read-from-minibuffer "Title: "
3126 (gnus-newsgroup-savable-name
ee5a613e
KY		 3127 (mapconcat
3128 'identity
3129 (split-string
3130 (or (cdr (assoc 'title
3131 feedinfo))
3132 ""))
3133 " ")))))
01c52d31 3134 (desc (read-from-minibuffer "Description: "
ee5a613e
KY		 3135 (mapconcat
3136 'identity
3137 (split-string
3138 (or (cdr (assoc 'description
3139 feedinfo))
3140 ""))
3141 " ")))
01c52d31
MB		 3142 (href (cdr (assoc 'href feedinfo)))
3143 (coding (gnus-group-name-charset '(nnrss "") title)))
3144 (when coding
91472578
MB		 3145 ;; Unify non-ASCII text.
3146 (setq title (mm-decode-coding-string
01c52d31
MB		 3147 (mm-encode-coding-string title coding)
3148 coding)))
3149 (gnus-group-make-group title '(nnrss ""))
91472578 3150 (push (list title href desc) nnrss-group-alist)
23f87bed
MB		 3151 (nnrss-save-server-data nil))
3152 (error "No feeds found for %s" url))))
3153
eec82323
LMI		 3154(defun gnus-group-make-directory-group (dir)
3155 "Create an nndir group.
3156The user will be prompted for a directory. The contents of this
c30ba437 3157directory will be used as a newsgroup. The directory should contain
eec82323
LMI		 3158mail messages or news articles in files that have numeric names."
3159 (interactive
7e27ce9c 3160 (list (read-directory-name "Create group from directory: ")))
eec82323
LMI		 3161 (unless (file-exists-p dir)
3162 (error "No such directory"))
3163 (unless (file-directory-p dir)
3164 (error "Not a directory"))
3165 (let ((ext "")
3166 (i 0)
3167 group)
01c52d31 3168 (while (or (not group) (gnus-group-entry group))
eec82323
LMI		 3169 (setq group
3170 (gnus-group-prefixed-name
c6e7b580 3171 (expand-file-name ext dir)
eec82323
LMI		 3172 '(nndir "")))
3173 (setq ext (format "<%d>" (setq i (1+ i)))))
3174 (gnus-group-make-group
3175 (gnus-group-real-name group)
3176 (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
3177
eec82323
LMI		 3178(defun gnus-group-add-to-virtual (n vgroup)
3179 "Add the current group to a virtual group."
3180 (interactive
3181 (list current-prefix-arg
229b59da
G		 3182 (gnus-group-completing-read "Add to virtual group"
3183 nil t "nnvirtual:")))
eec82323
LMI		 3184 (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
3185 (error "%s is not an nnvirtual group" vgroup))
3186 (gnus-close-group vgroup)
3187 (let* ((groups (gnus-group-process-prefix n))
3188 (method (gnus-info-method (gnus-get-info vgroup))))
3189 (setcar (cdr method)
3190 (concat
3191 (nth 1 method) "\\|"
3192 (mapconcat
3193 (lambda (s)
3194 (gnus-group-remove-mark s)
3195 (concat "\\(^" (regexp-quote s) "$\\)"))
3196 groups "\\|"))))
3197 (gnus-group-position-point))
3198
3199(defun gnus-group-make-empty-virtual (group)
3200 "Create a new, fresh, empty virtual group."
3201 (interactive "sCreate new, empty virtual group: ")
3202 (let* ((method (list 'nnvirtual "^$"))
3203 (pgroup (gnus-group-prefixed-name group method)))
3204 ;; Check whether it exists already.
01c52d31 3205 (when (gnus-group-entry pgroup)
a8151ef7 3206 (error "Group %s already exists" pgroup))
eec82323
LMI		 3207 ;; Subscribe the new group after the group on the current line.
3208 (gnus-subscribe-group pgroup (gnus-group-group-name) method)
3209 (gnus-group-update-group pgroup)
3210 (forward-line -1)
3211 (gnus-group-position-point)))
3212
3213(defun gnus-group-enter-directory (dir)
3214 "Enter an ephemeral nneething group."
3215 (interactive "DDirectory to read: ")
3216 (let* ((method (list 'nneething dir '(nneething-read-only t)))
3217 (leaf (gnus-group-prefixed-name
3218 (file-name-nondirectory (directory-file-name dir))
3219 method))
3220 (name (gnus-generate-new-group-name leaf)))
3221 (unless (gnus-group-read-ephemeral-group
3222 name method t
3223 (cons (current-buffer)
3224 (if (eq major-mode 'gnus-summary-mode)
3225 'summary 'group)))
3226 (error "Couldn't enter %s" dir))))
3227
0617bb00 3228(defun gnus-group-expunge-group (group)
16409b0b
GM		 3229 "Expunge deleted articles in current nnimap GROUP."
3230 (interactive (list (gnus-group-group-name)))
0617bb00
LMI		 3231 (let ((method (gnus-find-method-for-group group)))
3232 (if (not (gnus-check-backend-function
3233 'request-expunge-group (car method)))
3234 (error "%s does not support expunging" (car method))
3235 (gnus-request-expunge-group group method))))
3236
3237(autoload 'nnimap-acl-get "nnimap")
3238(autoload 'nnimap-acl-edit "nnimap")
16409b0b
GM		 3239
3240(defun gnus-group-nnimap-edit-acl (group)
3241 "Edit the Access Control List of current nnimap GROUP."
3242 (interactive (list (gnus-group-group-name)))
3243 (let ((mailbox (gnus-group-real-name group)) method acl)
3244 (unless group
3245 (error "No group on current line"))
3246 (unless (gnus-get-info group)
3247 (error "Killed group; can't be edited"))
3248 (unless (eq (car (setq method (gnus-find-method-for-group group))) 'nnimap)
3249 (error "%s is not an nnimap group" group))
2491844d
DL		 3250 (unless (setq acl (nnimap-acl-get mailbox (cadr method)))
3251 (error "Server does not support ACL's"))
3252 (gnus-edit-form acl (format "Editing the access control list for `%s'.
16409b0b
GM		 3253
3254 An access control list is a list of (identifier . rights) elements.
3255
3256 The identifier string specifies the corresponding user. The
3257 identifier \"anyone\" is reserved to refer to the universal identity.
3258
3259 Rights is a string listing a (possibly empty) set of alphanumeric
3260 characters, each character listing a set of operations which is being
3261 controlled. Letters are reserved for ``standard'' rights, listed
3262 below. Digits are reserved for implementation or site defined rights.
3263
3264 l - lookup (mailbox is visible to LIST/LSUB commands)
3265 r - read (SELECT the mailbox, perform CHECK, FETCH, PARTIAL,
3266 SEARCH, COPY from mailbox)
3267 s - keep seen/unseen information across sessions (STORE \\SEEN flag)
3268 w - write (STORE flags other than \\SEEN and \\DELETED)
3269 i - insert (perform APPEND, COPY into mailbox)
3270 p - post (send mail to submission address for mailbox,
3271 not enforced by IMAP4 itself)
3272 c - create and delete mailbox (CREATE new sub-mailboxes in any
3273 implementation-defined hierarchy, RENAME or DELETE mailbox)
3274 d - delete messages (STORE \\DELETED flag, perform EXPUNGE)
3275 a - administer (perform SETACL)" group)
3276 `(lambda (form)
3277 (nnimap-acl-edit
3278 ,mailbox ',method ',acl form)))))
3279
eec82323
LMI		 3280;; Group sorting commands
3281;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
3282
3283(defun gnus-group-sort-groups (func &optional reverse)
3284 "Sort the group buffer according to FUNC.
3285When used interactively, the sorting function used will be
3286determined by the `gnus-group-sort-function' variable.
3287If REVERSE (the prefix), reverse the sorting order."
3288 (interactive (list gnus-group-sort-function current-prefix-arg))
3289 (funcall gnus-group-sort-alist-function
3290 (gnus-make-sort-function func) reverse)
23f87bed 3291 (gnus-group-unmark-all-groups)
eec82323
LMI		 3292 (gnus-group-list-groups)
3293 (gnus-dribble-touch))
3294
3295(defun gnus-group-sort-flat (func reverse)
3296 ;; We peel off the dummy group from the alist.
3297 (when func
3298 (when (equal (gnus-info-group (car gnus-newsrc-alist)) "dummy.group")
3299 (pop gnus-newsrc-alist))
3300 ;; Do the sorting.
3301 (setq gnus-newsrc-alist
3302 (sort gnus-newsrc-alist func))
3303 (when reverse
3304 (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
3305 ;; Regenerate the hash table.
3306 (gnus-make-hashtable-from-newsrc-alist)))
3307
3308(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
3309 "Sort the group buffer alphabetically by group name.
3310If REVERSE, sort in reverse order."
3311 (interactive "P")
3312 (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
3313
23f87bed
MB		 3314(defun gnus-group-sort-groups-by-real-name (&optional reverse)
3315 "Sort the group buffer alphabetically by real (unprefixed) group name.
3316If REVERSE, sort in reverse order."
3317 (interactive "P")
3318 (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse))
3319
eec82323
LMI		 3320(defun gnus-group-sort-groups-by-unread (&optional reverse)
3321 "Sort the group buffer by number of unread articles.
3322If REVERSE, sort in reverse order."
3323 (interactive "P")
3324 (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
3325
3326(defun gnus-group-sort-groups-by-level (&optional reverse)
3327 "Sort the group buffer by group level.
3328If REVERSE, sort in reverse order."
3329 (interactive "P")
3330 (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
3331
3332(defun gnus-group-sort-groups-by-score (&optional reverse)
3333 "Sort the group buffer by group score.
3334If REVERSE, sort in reverse order."
3335 (interactive "P")
3336 (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
3337
3338(defun gnus-group-sort-groups-by-rank (&optional reverse)
3339 "Sort the group buffer by group rank.
3340If REVERSE, sort in reverse order."
3341 (interactive "P")
3342 (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
3343
3344(defun gnus-group-sort-groups-by-method (&optional reverse)
23f87bed 3345 "Sort the group buffer alphabetically by back end name.
eec82323
LMI		 3346If REVERSE, sort in reverse order."
3347 (interactive "P")
3348 (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
3349
23f87bed
MB		 3350(defun gnus-group-sort-groups-by-server (&optional reverse)
3351 "Sort the group buffer alphabetically by server name.
3352If REVERSE, sort in reverse order."
3353 (interactive "P")
3354 (gnus-group-sort-groups 'gnus-group-sort-by-server reverse))
3355
eec82323
LMI		 3356;;; Selected group sorting.
3357
3358(defun gnus-group-sort-selected-groups (n func &optional reverse)
3359 "Sort the process/prefixed groups."
3360 (interactive (list current-prefix-arg gnus-group-sort-function))
3361 (let ((groups (gnus-group-process-prefix n)))
3362 (funcall gnus-group-sort-selected-function
3363 groups (gnus-make-sort-function func) reverse)
23f87bed
MB		 3364 (gnus-group-unmark-all-groups)
3365 (gnus-group-list-groups)
3366 (gnus-dribble-touch)))
eec82323
LMI		 3367
3368(defun gnus-group-sort-selected-flat (groups func reverse)
3369 (let (entries infos)
3370 ;; First find all the group entries for these groups.
3371 (while groups
01c52d31 3372 (push (nthcdr 2 (gnus-group-entry (pop groups)))
eec82323
LMI		 3373 entries))
3374 ;; Then sort the infos.
3375 (setq infos
3376 (sort
3377 (mapcar
3378 (lambda (entry) (car entry))
3379 (setq entries (nreverse entries)))
3380 func))
3381 (when reverse
3382 (setq infos (nreverse infos)))
3383 ;; Go through all the infos and replace the old entries
3384 ;; with the new infos.
3385 (while infos
16409b0b 3386 (setcar (car entries) (pop infos))
eec82323
LMI		 3387 (pop entries))
3388 ;; Update the hashtable.
3389 (gnus-make-hashtable-from-newsrc-alist)))
3390
16409b0b 3391(defun gnus-group-sort-selected-groups-by-alphabet (&optional n reverse)
eec82323 3392 "Sort the group buffer alphabetically by group name.
16409b0b
GM		 3393Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
3394sort in reverse order."
3395 (interactive (gnus-interactive "P\ny"))
3396 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
eec82323 3397
23f87bed
MB		 3398(defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse)
3399 "Sort the group buffer alphabetically by real group name.
3400Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
3401sort in reverse order."
3402 (interactive (gnus-interactive "P\ny"))
3403 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse))
3404
16409b0b 3405(defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
eec82323 3406 "Sort the group buffer by number of unread articles.
16409b0b
GM		 3407Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
3408sort in reverse order."
3409 (interactive (gnus-interactive "P\ny"))
3410 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse))
eec82323 3411
16409b0b 3412(defun gnus-group-sort-selected-groups-by-level (&optional n reverse)
eec82323 3413 "Sort the group buffer by group level.
16409b0b
GM		 3414Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
3415sort in reverse order."
3416 (interactive (gnus-interactive "P\ny"))
3417 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse))
eec82323 3418
16409b0b 3419(defun gnus-group-sort-selected-groups-by-score (&optional n reverse)
eec82323 3420 "Sort the group buffer by group score.
16409b0b
GM		 3421Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
3422sort in reverse order."
3423 (interactive (gnus-interactive "P\ny"))
3424 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse))
eec82323 3425
16409b0b 3426(defun gnus-group-sort-selected-groups-by-rank (&optional n reverse)
eec82323 3427 "Sort the group buffer by group rank.
16409b0b
GM		 3428Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
3429sort in reverse order."
3430 (interactive (gnus-interactive "P\ny"))
3431 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
eec82323 3432
16409b0b 3433(defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
23f87bed 3434 "Sort the group buffer alphabetically by back end name.
16409b0b
GM		 3435Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
3436sort in reverse order."
3437 (interactive (gnus-interactive "P\ny"))
3438 (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse))
eec82323
LMI		 3439
3440;;; Sorting predicates.
3441
3442(defun gnus-group-sort-by-alphabet (info1 info2)
3443 "Sort alphabetically."
3444 (string< (gnus-info-group info1) (gnus-info-group info2)))
3445
3446(defun gnus-group-sort-by-real-name (info1 info2)
3447 "Sort alphabetically on real (unprefixed) names."
3448 (string< (gnus-group-real-name (gnus-info-group info1))
3449 (gnus-group-real-name (gnus-info-group info2))))
3450
3451(defun gnus-group-sort-by-unread (info1 info2)
3452 "Sort by number of unread articles."
01c52d31
MB		 3453 (let ((n1 (gnus-group-unread (gnus-info-group info1)))
3454 (n2 (gnus-group-unread (gnus-info-group info2))))
eec82323
LMI		 3455 (< (or (and (numberp n1) n1) 0)
3456 (or (and (numberp n2) n2) 0))))
3457
3458(defun gnus-group-sort-by-level (info1 info2)
3459 "Sort by level."
3460 (< (gnus-info-level info1) (gnus-info-level info2)))
3461
3462(defun gnus-group-sort-by-method (info1 info2)
23f87bed
MB		 3463 "Sort alphabetically by back end name."
3464 (string< (car (gnus-find-method-for-group
3465 (gnus-info-group info1) info1))
3466 (car (gnus-find-method-for-group
3467 (gnus-info-group info2) info2))))
3468
3469(defun gnus-group-sort-by-server (info1 info2)
3470 "Sort alphabetically by server name."
3471 (string< (gnus-method-to-full-server-name
3472 (gnus-find-method-for-group
3473 (gnus-info-group info1) info1))
3474 (gnus-method-to-full-server-name
3475 (gnus-find-method-for-group
3476 (gnus-info-group info2) info2))))
eec82323
LMI		 3477
3478(defun gnus-group-sort-by-score (info1 info2)
3479 "Sort by group score."
23f87bed 3480 (> (gnus-info-score info1) (gnus-info-score info2)))
eec82323
LMI		 3481
3482(defun gnus-group-sort-by-rank (info1 info2)
3483 "Sort by level and score."
3484 (let ((level1 (gnus-info-level info1))
3485 (level2 (gnus-info-level info2)))
3486 (or (< level1 level2)
3487 (and (= level1 level2)
3488 (> (gnus-info-score info1) (gnus-info-score info2))))))
3489
3490;;; Clearing data
3491
3492(defun gnus-group-clear-data (&optional arg)
ff4d3926
MB		 3493 "Clear all marks and read ranges from the current group.
3494Obeys the process/prefix convention."
eec82323 3495 (interactive "P")
4d9db491
G		 3496 (when (gnus-y-or-n-p "Really clear data? ")
3497 (gnus-group-iterate arg
3498 (lambda (group)
3499 (let (info)
3500 (gnus-info-clear-data (setq info (gnus-get-info group)))
3501 (gnus-get-unread-articles-in-group info (gnus-active group) t)
3502 (when (gnus-group-goto-group group)
3503 (gnus-group-update-group-line)))))))
eec82323
LMI		 3504
3505(defun gnus-group-clear-data-on-native-groups ()
3506 "Clear all marks and read ranges from all native groups."
3507 (interactive)
3508 (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ")
3509 (let ((alist (cdr gnus-newsrc-alist))
3510 info)
3511 (while (setq info (pop alist))
3512 (when (gnus-group-native-p (gnus-info-group info))
3513 (gnus-info-clear-data info)))
3514 (gnus-get-unread-articles)
6748645f 3515 (gnus-dribble-touch)
eec82323
LMI		 3516 (when (gnus-y-or-n-p
3517 "Move the cache away to avoid problems in the future? ")
3518 (call-interactively 'gnus-cache-move-cache)))))
3519
3520(defun gnus-info-clear-data (info)
3521 "Clear all marks and read ranges from INFO."
23f87bed
MB		 3522 (let ((group (gnus-info-group info))
3523 action)
3524 (dolist (el (gnus-info-marks info))
3525 (push `(,(cdr el) add (,(car el))) action))
3526 (push `(,(gnus-info-read info) add (read)) action)
eec82323
LMI		 3527 (gnus-undo-register
3528 `(progn
23f87bed 3529 (gnus-request-set-mark ,group ',action)
eec82323
LMI		 3530 (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
3531 (gnus-info-set-read ',info ',(gnus-info-read info))
3532 (when (gnus-group-goto-group ,group)
23f87bed 3533 (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t)
eec82323 3534 (gnus-group-update-group-line))))
23f87bed
MB		 3535 (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el)))
3536 action))
3537 (gnus-request-set-mark group action)
eec82323
LMI		 3538 (gnus-info-set-read info nil)
3539 (when (gnus-info-marks info)
3540 (gnus-info-set-marks info nil))))
3541
3542;; Group catching up.
3543
3544(defun gnus-group-catchup-current (&optional n all)
16409b0b 3545 "Mark all unread articles in the current newsgroup as read.
6748645f 3546If prefix argument N is numeric, the next N newsgroups will be
eec82323
LMI		 3547caught up. If ALL is non-nil, marked articles will also be marked as
3548read. Cross references (Xref: header) of articles are ignored.
6748645f
LMI		 3549The number of newsgroups that this function was unable to catch
3550up is returned."
eec82323 3551 (interactive "P")
eec82323 3552 (let ((groups (gnus-group-process-prefix n))
16409b0b
GM		 3553 (ret 0)
3554 group)
6748645f 3555 (unless groups (error "No groups selected"))
eec82323
LMI		 3556 (if (not
3557 (or (not gnus-interactive-catchup) ;Without confirmation?
3558 gnus-expert-user
3559 (gnus-y-or-n-p
3560 (format
3561 (if all
3562 "Do you really want to mark all articles in %s as read? "
3563 "Mark all unread articles in %s as read? ")
3564 (if (= (length groups) 1)
91472578 3565 (gnus-group-decoded-name (car groups))
eec82323
LMI		 3566 (format "these %d groups" (length groups)))))))
3567 n
16409b0b
GM		 3568 (while (setq group (pop groups))
3569 (gnus-group-remove-mark group)
eec82323 3570 ;; Virtual groups have to be given special treatment.
16409b0b 3571 (let ((method (gnus-find-method-for-group group)))
eec82323
LMI		 3572 (when (eq 'nnvirtual (car method))
3573 (nnvirtual-catchup-group
16409b0b 3574 (gnus-group-real-name group) (nth 1 method) all)))
01c52d31
MB		 3575 (cond
3576 ((>= (gnus-group-level group) gnus-level-zombie)
3577 (gnus-message 2 "Dead groups can't be caught up"))
3578 ((prog1
3579 (gnus-group-goto-group group)
3580 (gnus-group-catchup group all))
3581 (gnus-group-update-group-line))
3582 (t
3583 (setq ret (1+ ret)))))
eec82323
LMI		 3584 (gnus-group-next-unread-group 1)
3585 ret)))
3586
3587(defun gnus-group-catchup-current-all (&optional n)
3588 "Mark all articles in current newsgroup as read.
3589Cross references (Xref: header) of articles are ignored."
3590 (interactive "P")
3591 (gnus-group-catchup-current n 'all))
3592
3593(defun gnus-group-catchup (group &optional all)
3594 "Mark all articles in GROUP as read.
3595If ALL is non-nil, all articles are marked as read.
3596The return value is the number of articles that were marked as read,
3597or nil if no action could be taken."
01c52d31 3598 (let* ((entry (gnus-group-entry group))
23f87bed 3599 (num (car entry))
01c52d31 3600 (marks (gnus-info-marks (nth 2 entry)))
54506618 3601 (unread (gnus-sequence-of-unread-articles group)))
16409b0b
GM		 3602 ;; Remove entries for this group.
3603 (nnmail-purge-split-history (gnus-group-real-name group))
eec82323
LMI		 3604 ;; Do the updating only if the newsgroup isn't killed.
3605 (if (not (numberp (car entry)))
3606 (gnus-message 1 "Can't catch up %s; non-active group" group)
23f87bed
MB		 3607 (gnus-update-read-articles group nil)
3608 (when all
3609 ;; Nix out the lists of marks and dormants.
3610 (gnus-request-set-mark group (list (list (cdr (assq 'tick marks))
3611 'del '(tick))
3612 (list (cdr (assq 'dormant marks))
3613 'del '(dormant))))
54506618 3614 (setq unread (gnus-range-add (gnus-range-add
01c52d31
MB		 3615 unread (cdr (assq 'dormant marks)))
3616 (cdr (assq 'tick marks))))
23f87bed
MB		 3617 (gnus-add-marked-articles group 'tick nil nil 'force)
3618 (gnus-add-marked-articles group 'dormant nil nil 'force))
eec82323 3619 ;; Do auto-expirable marks if that's required.
b5244046
LMI		 3620 (when (and (gnus-group-auto-expirable-p group)
3621 (not (gnus-group-read-only-p group)))
01c52d31
MB		 3622 (gnus-range-map
3623 (lambda (article)
3624 (gnus-add-marked-articles group 'expire (list article))
3625 (gnus-request-set-mark group (list (list (list article)
3626 'add '(expire)))))
3627 unread))
23f87bed
MB		 3628 (let ((gnus-newsgroup-name group))
3629 (gnus-run-hooks 'gnus-group-catchup-group-hook))
3630 num)))
eec82323
LMI		 3631
3632(defun gnus-group-expire-articles (&optional n)
23f87bed
MB		 3633 "Expire all expirable articles in the current newsgroup.
3634Uses the process/prefix convention."
eec82323
LMI		 3635 (interactive "P")
3636 (let ((groups (gnus-group-process-prefix n))
3637 group)
3638 (unless groups
3639 (error "No groups to expire"))
3640 (while (setq group (pop groups))
3641 (gnus-group-remove-mark group)
16409b0b 3642 (gnus-group-expire-articles-1 group)
eec82323
LMI		 3643 (gnus-dribble-touch)
3644 (gnus-group-position-point))))
3645
16409b0b
GM		 3646(defun gnus-group-expire-articles-1 (group)
3647 (when (gnus-check-backend-function 'request-expire-articles group)
91472578
MB		 3648 (gnus-message 6 "Expiring articles in %s..."
3649 (gnus-group-decoded-name group))
16409b0b
GM		 3650 (let* ((info (gnus-get-info group))
3651 (expirable (if (gnus-group-total-expirable-p group)
3652 (cons nil (gnus-list-of-read-articles group))
3653 (assq 'expire (gnus-info-marks info))))
3654 (expiry-wait (gnus-group-find-parameter group 'expiry-wait))
3655 (nnmail-expiry-target
3656 (or (gnus-group-find-parameter group 'expiry-target)
3657 nnmail-expiry-target)))
3658 (when expirable
3659 (gnus-check-group group)
3660 (setcdr
3661 expirable
3662 (gnus-compress-sequence
3663 (if expiry-wait
3664 ;; We set the expiry variables to the group
3665 ;; parameter.
3666 (let ((nnmail-expiry-wait-function nil)
3667 (nnmail-expiry-wait expiry-wait))
3668 (gnus-request-expire-articles
3669 (gnus-uncompress-sequence (cdr expirable)) group))
3670 ;; Just expire using the normal expiry values.
3671 (gnus-request-expire-articles
3672 (gnus-uncompress-sequence (cdr expirable)) group))))
3673 (gnus-close-group group))
91472578
MB		 3674 (gnus-message 6 "Expiring articles in %s...done"
3675 (gnus-group-decoded-name group))
16409b0b
GM		 3676 ;; Return the list of un-expired articles.
3677 (cdr expirable))))
3678
eec82323
LMI		 3679(defun gnus-group-expire-all-groups ()
3680 "Expire all expirable articles in all newsgroups."
3681 (interactive)
3682 (save-excursion
3683 (gnus-message 5 "Expiring...")
3684 (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
3685 (cdr gnus-newsrc-alist))))
3686 (gnus-group-expire-articles nil)))
3687 (gnus-group-position-point)
3688 (gnus-message 5 "Expiring...done"))
3689
3690(defun gnus-group-set-current-level (n level)
3691 "Set the level of the next N groups to LEVEL."
3692 (interactive
3693 (list
3694 current-prefix-arg
23f87bed
MB		 3695 (progn
3696 (unless (gnus-group-process-prefix current-prefix-arg)
3697 (error "No group on the current line"))
e9bd5782 3698 (string-to-number
23f87bed
MB		 3699 (let ((s (read-string
3700 (format "Level (default %s): "
3701 (or (gnus-group-group-level)
3702 gnus-level-default-subscribed)))))
3703 (if (string-match "^\\s-*$" s)
3704 (int-to-string (or (gnus-group-group-level)
3705 gnus-level-default-subscribed))
3706 s))))))
eec82323 3707 (unless (and (>= level 1) (<= level gnus-level-killed))
16409b0b 3708 (error "Invalid level: %d" level))
01c52d31
MB		 3709 (dolist (group (gnus-group-process-prefix n))
3710 (gnus-group-remove-mark group)
3711 (gnus-message 6 "Changed level of %s from %d to %d"
3712 (gnus-group-decoded-name group)
3713 (or (gnus-group-group-level) gnus-level-killed)
3714 level)
3715 (gnus-group-change-level
3716 group level (or (gnus-group-group-level) gnus-level-killed))
3717 (gnus-group-update-group-line))
eec82323
LMI		 3718 (gnus-group-position-point))
3719
3720(defun gnus-group-unsubscribe (&optional n)
3721 "Unsubscribe the current group."
3722 (interactive "P")
3723 (gnus-group-unsubscribe-current-group n 'unsubscribe))
3724
3725(defun gnus-group-subscribe (&optional n)
3726 "Subscribe the current group."
3727 (interactive "P")
3728 (gnus-group-unsubscribe-current-group n 'subscribe))
3729
3730(defun gnus-group-unsubscribe-current-group (&optional n do-sub)
3731 "Toggle subscription of the current group.
3732If given numerical prefix, toggle the N next groups."
3733 (interactive "P")
23f87bed
MB		 3734 (dolist (group (gnus-group-process-prefix n))
3735 (gnus-group-remove-mark group)
3736 (gnus-group-unsubscribe-group
3737 group
3738 (cond
3739 ((eq do-sub 'unsubscribe)
3740 gnus-level-default-unsubscribed)
3741 ((eq do-sub 'subscribe)
3742 gnus-level-default-subscribed)
3743 ((<= (gnus-group-group-level) gnus-level-subscribed)
3744 gnus-level-default-unsubscribed)
3745 (t
3746 gnus-level-default-subscribed))
3747 t)
3748 (gnus-group-update-group-line))
3749 (gnus-group-next-group 1))
eec82323
LMI		 3750
3751(defun gnus-group-unsubscribe-group (group &optional level silent)
3752 "Toggle subscription to GROUP.
3753Killed newsgroups are subscribed. If SILENT, don't try to update the
3754group line."
01c52d31 3755 (interactive (list (gnus-group-completing-read
e0da801a 3756 nil nil (gnus-read-active-file-p))))
01c52d31 3757 (let ((newsrc (gnus-group-entry group)))
eec82323 3758 (cond
6748645f 3759 ((string-match "^[ \t]*$" group)
eec82323
LMI		 3760 (error "Empty group name"))
3761 (newsrc
3762 ;; Toggle subscription flag.
3763 (gnus-group-change-level
3764 newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc))
3765 gnus-level-subscribed)
3766 (1+ gnus-level-subscribed)
3767 gnus-level-default-subscribed)))
3768 (unless silent
3769 (gnus-group-update-group group)))
3770 ((and (stringp group)
3771 (or (not (gnus-read-active-file-p))
3772 (gnus-active group)))
3773 ;; Add new newsgroup.
3774 (gnus-group-change-level
3775 group
3776 (if level level gnus-level-default-subscribed)
3777 (or (and (member group gnus-zombie-list)
3778 gnus-level-zombie)
3779 gnus-level-killed)
3780 (when (gnus-group-group-name)
01c52d31 3781 (gnus-group-entry (gnus-group-group-name))))
eec82323
LMI		 3782 (unless silent
3783 (gnus-group-update-group group)))
3784 (t (error "No such newsgroup: %s" group)))
3785 (gnus-group-position-point)))
3786
3787(defun gnus-group-transpose-groups (n)
3788 "Move the current newsgroup up N places.
c30ba437 3789If given a negative prefix, move down instead. The difference between
eec82323
LMI		 3790N and the number of steps taken is returned."
3791 (interactive "p")
3792 (unless (gnus-group-group-name)
3793 (error "No group on current line"))
3794 (gnus-group-kill-group 1)
3795 (prog1
3796 (forward-line (- n))
3797 (gnus-group-yank-group)
3798 (gnus-group-position-point)))
3799
16409b0b
GM		 3800(defun gnus-group-kill-all-zombies (&optional dummy)
3801 "Kill all zombie newsgroups.
3802The optional DUMMY should always be nil."
3803 (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? "))))
3804 (unless dummy
3805 (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
3806 (setq gnus-zombie-list nil)
3807 (gnus-dribble-touch)
3808 (gnus-group-list-groups)))
eec82323
LMI		 3809
3810(defun gnus-group-kill-region (begin end)
3811 "Kill newsgroups in current region (excluding current point).
3812The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
3813 (interactive "r")
3814 (let ((lines
3815 ;; Count lines.
3816 (save-excursion
3817 (count-lines
3818 (progn
3819 (goto-char begin)
01c52d31 3820 (point-at-bol))
eec82323
LMI		 3821 (progn
3822 (goto-char end)
01c52d31 3823 (point-at-bol))))))
eec82323
LMI		 3824 (goto-char begin)
3825 (beginning-of-line) ;Important when LINES < 1
3826 (gnus-group-kill-group lines)))
3827
3828(defun gnus-group-kill-group (&optional n discard)
3829 "Kill the next N groups.
3830The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
3831However, only groups that were alive can be yanked; already killed
3832groups or zombie groups can't be yanked.
3833The return value is the name of the group that was killed, or a list
3834of groups killed."
3835 (interactive "P")
3836 (let ((buffer-read-only nil)
3837 (groups (gnus-group-process-prefix n))
3838 group entry level out)
3839 (if (< (length groups) 10)
3840 ;; This is faster when there are few groups.
3841 (while groups
3842 (push (setq group (pop groups)) out)
3843 (gnus-group-remove-mark group)
3844 (setq level (gnus-group-group-level))
3845 (gnus-delete-line)
3846 (when (and (not discard)
01c52d31 3847 (setq entry (gnus-group-entry group)))
eec82323
LMI		 3848 (gnus-undo-register
3849 `(progn
3850 (gnus-group-goto-group ,(gnus-group-group-name))
3851 (gnus-group-yank-group)))
3852 (push (cons (car entry) (nth 2 entry))
3853 gnus-list-of-killed-groups))
3854 (gnus-group-change-level
16409b0b 3855 (if entry entry group) gnus-level-killed (if entry nil level))
bb7f5cbc
G		 3856 (when (numberp (gnus-group-unread group))
3857 (gnus-request-update-group-status group 'unsubscribe))
91472578 3858 (message "Killed group %s" (gnus-group-decoded-name group)))
eec82323
LMI		 3859 ;; If there are lots and lots of groups to be killed, we use
3860 ;; this thing instead.
23f87bed
MB		 3861 (dolist (group (nreverse groups))
3862 (gnus-group-remove-mark group)
3863 (gnus-delete-line)
3864 (push group gnus-killed-list)
3865 (setq gnus-newsrc-alist
3866 (delq (assoc group gnus-newsrc-alist)
3867 gnus-newsrc-alist))
3868 (when gnus-group-change-level-function
3869 (funcall gnus-group-change-level-function
3870 group gnus-level-killed 3))
3871 (cond
01c52d31 3872 ((setq entry (gnus-group-entry group))
23f87bed
MB		 3873 (push (cons (car entry) (nth 2 entry))
3874 gnus-list-of-killed-groups)
3875 (setcdr (cdr entry) (cdddr entry)))
3876 ((member group gnus-zombie-list)
3877 (setq gnus-zombie-list (delete group gnus-zombie-list))))
3878 ;; There may be more than one instance displayed.
3879 (while (gnus-group-goto-group group)
549c9aed 3880 (gnus-delete-line))
bb7f5cbc
G		 3881 (when (numberp (gnus-group-unread group))
3882 (gnus-request-update-group-status group 'unsubscribe)))
23f87bed 3883 (gnus-make-hashtable-from-newsrc-alist))
eec82323
LMI		 3884
3885 (gnus-group-position-point)
3886 (if (< (length out) 2) (car out) (nreverse out))))
3887
3888(defun gnus-group-yank-group (&optional arg)
6748645f
LMI		 3889 "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup.
3890The numeric ARG specifies how many newsgroups are to be yanked. The
3891name of the newsgroup yanked is returned, or (if several groups are
3892yanked) a list of yanked groups is returned."
eec82323
LMI		 3893 (interactive "p")
3894 (setq arg (or arg 1))
3895 (let (info group prev out)
3896 (while (>= (decf arg) 0)
3897 (when (not (setq info (pop gnus-list-of-killed-groups)))
3898 (error "No more newsgroups to yank"))
3899 (push (setq group (nth 1 info)) out)
3900 ;; Find which newsgroup to insert this one before - search
3901 ;; backward until something suitable is found. If there are no
3902 ;; other newsgroups in this buffer, just make this newsgroup the
3903 ;; first newsgroup.
3904 (setq prev (gnus-group-group-name))
3905 (gnus-group-change-level
3906 info (gnus-info-level (cdr info)) gnus-level-killed
01c52d31 3907 (and prev (gnus-group-entry prev))
eec82323
LMI		 3908 t)
3909 (gnus-group-insert-group-line-info group)
549c9aed 3910 (gnus-request-update-group-status group 'subscribe)
eec82323
LMI		 3911 (gnus-undo-register
3912 `(when (gnus-group-goto-group ,group)
3913 (gnus-group-kill-group 1))))
3914 (forward-line -1)
3915 (gnus-group-position-point)
3916 (if (< (length out) 2) (car out) (nreverse out))))
3917
3918(defun gnus-group-kill-level (level)
3919 "Kill all groups that is on a certain LEVEL."
3920 (interactive "nKill all groups on level: ")
3921 (cond
3922 ((= level gnus-level-zombie)
3923 (setq gnus-killed-list
3924 (nconc gnus-zombie-list gnus-killed-list))
3925 (setq gnus-zombie-list nil))
3926 ((and (< level gnus-level-zombie)
3927 (> level 0)
3928 (or gnus-expert-user
3929 (gnus-yes-or-no-p
3930 (format
3931 "Do you really want to kill all groups on level %d? "
3932 level))))
3933 (let* ((prev gnus-newsrc-alist)
3934 (alist (cdr prev)))
3935 (while alist
3936 (if (= (gnus-info-level (car alist)) level)
3937 (progn
3938 (push (gnus-info-group (car alist)) gnus-killed-list)
3939 (setcdr prev (cdr alist)))
3940 (setq prev alist))
3941 (setq alist (cdr alist)))
3942 (gnus-make-hashtable-from-newsrc-alist)
3943 (gnus-group-list-groups)))
3944 (t
16409b0b 3945 (error "Can't kill; invalid level: %d" level))))
eec82323
LMI		 3946
3947(defun gnus-group-list-all-groups (&optional arg)
3948 "List all newsgroups with level ARG or lower.
23f87bed 3949Default is `gnus-level-unsubscribed', which lists all subscribed and most
eec82323
LMI		 3950unsubscribed groups."
3951 (interactive "P")
3952 (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
3953
3954;; Redefine this to list ALL killed groups if prefix arg used.
3955;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
3956(defun gnus-group-list-killed (&optional arg)
3957 "List all killed newsgroups in the group buffer.
3958If ARG is non-nil, list ALL killed groups known to Gnus. This may
3959entail asking the server for the groups."
3960 (interactive "P")
3961 ;; Find all possible killed newsgroups if arg.
3962 (when arg
3963 (gnus-get-killed-groups))
3964 (if (not gnus-killed-list)
3965 (gnus-message 6 "No killed groups")
3966 (let (gnus-group-list-mode)
3967 (funcall gnus-group-prepare-function
3968 gnus-level-killed t gnus-level-killed))
3969 (goto-char (point-min)))
3970 (gnus-group-position-point))
3971
3972(defun gnus-group-list-zombies ()
3973 "List all zombie newsgroups in the group buffer."
3974 (interactive)
3975 (if (not gnus-zombie-list)
3976 (gnus-message 6 "No zombie groups")
3977 (let (gnus-group-list-mode)
3978 (funcall gnus-group-prepare-function
3979 gnus-level-zombie t gnus-level-zombie))
3980 (goto-char (point-min)))
3981 (gnus-group-position-point))
3982
3983(defun gnus-group-list-active ()
3984 "List all groups that are available from the server(s)."
3985 (interactive)
3986 ;; First we make sure that we have really read the active file.
3987 (unless (gnus-read-active-file-p)
16409b0b 3988 (let ((gnus-read-active-file t)
54506618 3989 (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent.
eec82323
LMI		 3990 (gnus-read-active-file)))
3991 ;; Find all groups and sort them.
3992 (let ((groups
3993 (sort
3994 (let (list)
3995 (mapatoms
3996 (lambda (sym)
3997 (and (boundp sym)
3998 (symbol-value sym)
3999 (push (symbol-name sym) list)))
4000 gnus-active-hashtb)
4001 list)
4002 'string<))
4003 (buffer-read-only nil)
4004 group)
4005 (erase-buffer)
4006 (while groups
16409b0b 4007 (setq group (pop groups))
eec82323
LMI		 4008 (gnus-add-text-properties
4009 (point) (prog1 (1+ (point))
4010 (insert " *: "
23f87bed 4011 (gnus-group-decoded-name group)
16409b0b 4012 "\n"))
eec82323
LMI		 4013 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4014 'gnus-unread t
4015 'gnus-level (inline (gnus-group-level group)))))
4016 (goto-char (point-min))))
4017
4018(defun gnus-activate-all-groups (level)
4019 "Activate absolutely all groups."
6748645f 4020 (interactive (list gnus-level-unsubscribed))
eec82323
LMI		 4021 (let ((gnus-activate-level level)
4022 (gnus-activate-foreign-newsgroups level))
4023 (gnus-group-get-new-news)))
4024
89b163db 4025(defun gnus-group-get-new-news (&optional arg one-level)
eec82323
LMI		 4026 "Get newly arrived articles.
4027If ARG is a number, it specifies which levels you are interested in
4028re-scanning. If ARG is non-nil and not a number, this will force
89b163db
G		 4029\"hard\" re-reading of the active files from all servers.
4030If ONE-LEVEL is not nil, then re-scan only the specified level,
4031otherwise all levels below ARG will be scanned too."
eec82323 4032 (interactive "P")
16409b0b
GM		 4033 (require 'nnmail)
4034 (let ((gnus-inhibit-demon t)
4035 ;; Binding this variable will inhibit multiple fetchings
4036 ;; of the same mail source.
4037 (nnmail-fetched-sources (list t)))
23f87bed 4038 (gnus-run-hooks 'gnus-get-top-new-news-hook)
6748645f 4039 (gnus-run-hooks 'gnus-get-new-news-hook)
eec82323
LMI		 4040
4041 ;; Read any slave files.
4042 (unless gnus-slave
4043 (gnus-master-read-slave-newsrc))
4044
89b163db
G		 4045 (gnus-get-unread-articles (gnus-group-default-level arg t)
4046 nil one-level)
8c3e17f8
LMI		 4047
4048 ;; If the user wants it, we scan for new groups.
4049 (when (eq gnus-check-new-newsgroups 'always)
4050 (gnus-find-new-newsgroups))
4051
01c52d31 4052 (gnus-check-reasonable-setup)
6748645f 4053 (gnus-run-hooks 'gnus-after-getting-new-news-hook)
eec82323
LMI		 4054 (gnus-group-list-groups (and (numberp arg)
4055 (max (car gnus-group-list-mode) arg)))))
4056
a8151ef7 4057(defun gnus-group-get-new-news-this-group (&optional n dont-scan)
eec82323
LMI		 4058 "Check for newly arrived news in the current group (and the N-1 next groups).
4059The difference between N and the number of newsgroup checked is returned.
531e5812
MB		 4060If N is negative, this group and the N-1 previous groups will be checked.
4061If DONT-SCAN is non-nil, scan non-activated groups as well."
eec82323
LMI		 4062 (interactive "P")
4063 (let* ((groups (gnus-group-process-prefix n))
4064 (ret (if (numberp n) (- n (length groups)) 0))
4065 (beg (unless n
99e65b2d 4066 (point-marker)))
16409b0b
GM		 4067 group method
4068 (gnus-inhibit-demon t)
4069 ;; Binding this variable will inhibit multiple fetchings
4070 ;; of the same mail source.
4071 (nnmail-fetched-sources (list t)))
4072 (gnus-run-hooks 'gnus-get-new-news-hook)
eec82323
LMI		 4073 (while (setq group (pop groups))
4074 (gnus-group-remove-mark group)
4075 ;; Bypass any previous denials from the server.
6748645f 4076 (gnus-remove-denial (setq method (gnus-find-method-for-group group)))
01c52d31
MB		 4077 (if (gnus-activate-group group (if dont-scan nil 'scan) nil method)
4078 (let ((info (gnus-get-info group))
4079 (active (gnus-active group)))
4080 (when info
4081 (gnus-request-update-info info method))
4082 (gnus-get-unread-articles-in-group info active)
eec82323
LMI		 4083 (unless (gnus-virtual-group-p group)
4084 (gnus-close-group group))
16409b0b
GM		 4085 (when gnus-agent
4086 (gnus-agent-save-group-info
01c52d31 4087 method (gnus-group-real-name group) active))
b229f37d 4088 (gnus-group-update-group group nil t))
02e8d7e9 4089 (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
eec82323
LMI		 4090 (when beg
4091 (goto-char beg))
4092 (when gnus-goto-next-group-when-activating
4093 (gnus-group-next-unread-group 1 t))
280f417b 4094 (gnus-group-position-point)
eec82323
LMI		 4095 ret))
4096
eec82323
LMI		 4097(defun gnus-group-describe-group (force &optional group)
4098 "Display a description of the current newsgroup."
4099 (interactive (list current-prefix-arg (gnus-group-group-name)))
4100 (let* ((method (gnus-find-method-for-group group))
4101 (mname (gnus-group-prefixed-name "" method))
4102 desc)
4103 (when (and force
4104 gnus-description-hashtb)
4105 (gnus-sethash mname nil gnus-description-hashtb))
4106 (unless group
4107 (error "No group name given"))
4108 (when (or (and gnus-description-hashtb
4109 ;; We check whether this group's method has been
4110 ;; queried for a description file.
4111 (gnus-gethash mname gnus-description-hashtb))
4112 (setq desc (gnus-group-get-description group))
4113 (gnus-read-descriptions-file method))
bdaa75c7 4114 (gnus-message 1 "%s"
eec82323
LMI		 4115 (or desc (gnus-gethash group gnus-description-hashtb)
4116 "No description available")))))
4117
4118;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
4119(defun gnus-group-describe-all-groups (&optional force)
4120 "Pop up a buffer with descriptions of all newsgroups."
4121 (interactive "P")
4122 (when force
4123 (setq gnus-description-hashtb nil))
4124 (when (not (or gnus-description-hashtb
4125 (gnus-read-all-descriptions-files)))
4126 (error "Couldn't request descriptions file"))
4127 (let ((buffer-read-only nil)
4128 b)
4129 (erase-buffer)
4130 (mapatoms
4131 (lambda (group)
4132 (setq b (point))
16409b0b 4133 (let ((charset (gnus-group-name-charset nil (symbol-name group))))
a1506d29 4134 (insert (format " *: %-20s %s\n"
16409b0b
GM		 4135 (gnus-group-name-decode
4136 (symbol-name group) charset)
4137 (gnus-group-name-decode
4138 (symbol-value group) charset))))
eec82323
LMI		 4139 (gnus-add-text-properties
4140 b (1+ b) (list 'gnus-group group
4141 'gnus-unread t 'gnus-marked nil
4142 'gnus-level (1+ gnus-level-subscribed))))
4143 gnus-description-hashtb)
4144 (goto-char (point-min))
4145 (gnus-group-position-point)))
4146
4147;; Suggested by Daniel Quinlan <quinlan@best.com>.
4148(defun gnus-group-apropos (regexp &optional search-description)
4149 "List all newsgroups that have names that match a regexp."
4150 (interactive "sGnus apropos (regexp): ")
4151 (let ((prev "")
4152 (obuf (current-buffer))
4153 groups des)
4154 ;; Go through all newsgroups that are known to Gnus.
4155 (mapatoms
4156 (lambda (group)
4157 (and (symbol-name group)
4158 (string-match regexp (symbol-name group))
6748645f 4159 (symbol-value group)
eec82323
LMI		 4160 (push (symbol-name group) groups)))
4161 gnus-active-hashtb)
4162 ;; Also go through all descriptions that are known to Gnus.
4163 (when search-description
4164 (mapatoms
4165 (lambda (group)
4166 (and (string-match regexp (symbol-value group))
eec82323
LMI		 4167 (push (symbol-name group) groups)))
4168 gnus-description-hashtb))
4169 (if (not groups)
4170 (gnus-message 3 "No groups matched \"%s\"." regexp)
4171 ;; Print out all the groups.
4172 (save-excursion
4173 (pop-to-buffer "*Gnus Help*")
16409b0b 4174 (buffer-disable-undo)
eec82323
LMI		 4175 (erase-buffer)
4176 (setq groups (sort groups 'string<))
4177 (while groups
4178 ;; Groups may be entered twice into the list of groups.
4179 (when (not (string= (car groups) prev))
16409b0b
GM		 4180 (setq prev (car groups))
4181 (let ((charset (gnus-group-name-charset nil prev)))
4182 (insert (gnus-group-name-decode prev charset) "\n")
4183 (when (and gnus-description-hashtb
4184 (setq des (gnus-gethash (car groups)
4185 gnus-description-hashtb)))
4186 (insert " " (gnus-group-name-decode des charset) "\n"))))
eec82323
LMI		 4187 (setq groups (cdr groups)))
4188 (goto-char (point-min))))
4189 (pop-to-buffer obuf)))
4190
4191(defun gnus-group-description-apropos (regexp)
23f87bed 4192 "List all newsgroups that have names or descriptions that match REGEXP."
eec82323
LMI		 4193 (interactive "sGnus description apropos (regexp): ")
4194 (when (not (or gnus-description-hashtb
4195 (gnus-read-all-descriptions-files)))
4196 (error "Couldn't request descriptions file"))
4197 (gnus-group-apropos regexp t))
4198
4199;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
4200(defun gnus-group-list-matching (level regexp &optional all lowest)
4201 "List all groups with unread articles that match REGEXP.
4202If the prefix LEVEL is non-nil, it should be a number that says which
4203level to cut off listing groups.
4204If ALL, also list groups with no unread articles.
4205If LOWEST, don't list groups with level lower than LOWEST.
4206
4207This command may read the active file."
4208 (interactive "P\nsList newsgroups matching: ")
4209 ;; First make sure active file has been read.
4210 (when (and level
4211 (> (prefix-numeric-value level) gnus-level-killed))
4212 (gnus-get-killed-groups))
23f87bed
MB		 4213 (funcall gnus-group-prepare-function
4214 (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
eec82323
LMI		 4215 (goto-char (point-min))
4216 (gnus-group-position-point))
4217
4218(defun gnus-group-list-all-matching (level regexp &optional lowest)
4219 "List all groups that match REGEXP.
4220If the prefix LEVEL is non-nil, it should be a number that says which
4221level to cut off listing groups.
4222If LOWEST, don't list groups with level lower than LOWEST."
4223 (interactive "P\nsList newsgroups matching: ")
4224 (when level
4225 (setq level (prefix-numeric-value level)))
4226 (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
4227
4228;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
4229(defun gnus-group-save-newsrc (&optional force)
4230 "Save the Gnus startup files.
4231If FORCE, force saving whether it is necessary or not."
4232 (interactive "P")
4233 (gnus-save-newsrc-file force))
4234
4235(defun gnus-group-restart (&optional arg)
4236 "Force Gnus to read the .newsrc file."
4237 (interactive "P")
4238 (when (gnus-yes-or-no-p
4239 (format "Are you sure you want to restart Gnus? "))
4240 (gnus-save-newsrc-file)
4241 (gnus-clear-system)
4242 (gnus)))
4243
4244(defun gnus-group-read-init-file ()
4245 "Read the Gnus elisp init file."
4246 (interactive)
a8151ef7
LMI		 4247 (gnus-read-init-file)
4248 (gnus-message 5 "Read %s" gnus-init-file))
eec82323
LMI		 4249
4250(defun gnus-group-check-bogus-groups (&optional silent)
4251 "Check bogus newsgroups.
4252If given a prefix, don't ask for confirmation before removing a bogus
4253group."
4254 (interactive "P")
4255 (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
4256 (gnus-group-list-groups))
4257
a8151ef7
LMI		 4258(defun gnus-group-find-new-groups (&optional arg)
4259 "Search for new groups and add them.
54cf8092 4260Each new group will be treated with `gnus-subscribe-newsgroup-method'.
6748645f
LMI		 4261With 1 C-u, use the `ask-server' method to query the server for new
4262groups.
4263With 2 C-u's, use most complete method possible to query the server
4264for new groups, and subscribe the new groups as zombies."
4265 (interactive "p")
9310f19d
LMI		 4266 (let ((new-groups (gnus-find-new-newsgroups (or arg 1)))
4267 current-group)
4268 (gnus-group-list-groups)
4269 (setq current-group (gnus-group-group-name))
4270 (dolist (group new-groups)
4271 (gnus-group-jump-to-group group))
4272 (when current-group
4273 (gnus-group-jump-to-group current-group))))
6748645f 4274
eec82323
LMI		 4275(defun gnus-group-edit-global-kill (&optional article group)
4276 "Edit the global kill file.
4277If GROUP, edit that local kill file instead."
4278 (interactive "P")
4279 (setq gnus-current-kill-article article)
4280 (gnus-kill-file-edit-file group)
bdaa75c7
LMI		 4281 (gnus-message 6 "Editing a %s kill file (Type %s to exit)"
4282 (if group "local" "global")
4283 (substitute-command-keys "\\[gnus-kill-file-exit]")))
eec82323
LMI		 4284
4285(defun gnus-group-edit-local-kill (article group)
4286 "Edit a local kill file."
4287 (interactive (list nil (gnus-group-group-name)))
4288 (gnus-group-edit-global-kill article group))
4289
4290(defun gnus-group-force-update ()
4291 "Update `.newsrc' file."
4292 (interactive)
4293 (gnus-save-newsrc-file))
4294
23f87bed
MB		 4295(defvar gnus-backlog-articles)
4296
eec82323
LMI		 4297(defun gnus-group-suspend ()
4298 "Suspend the current Gnus session.
4299In fact, cleanup buffers except for group mode buffer.
23f87bed 4300The hook `gnus-suspend-gnus-hook' is called before actually suspending."
eec82323 4301 (interactive)
6748645f 4302 (gnus-run-hooks 'gnus-suspend-gnus-hook)
23f87bed 4303 (gnus-offer-save-summaries)
eec82323 4304 ;; Kill Gnus buffers except for group mode buffer.
6748645f 4305 (let ((group-buf (get-buffer gnus-group-buffer)))
01c52d31
MB		 4306 (dolist (buf (gnus-buffers))
4307 (unless (or (eq buf group-buf)
4308 (eq buf gnus-dribble-buffer)
4309 (with-current-buffer buf
4310 (eq major-mode 'message-mode)))
4311 (gnus-kill-buffer buf)))
23f87bed 4312 (setq gnus-backlog-articles nil)
eec82323
LMI		 4313 (gnus-kill-gnus-frames)
4314 (when group-buf
eec82323
LMI		 4315 (bury-buffer group-buf)
4316 (delete-windows-on group-buf t))))
4317
4318(defun gnus-group-clear-dribble ()
4319 "Clear all information from the dribble buffer."
4320 (interactive)
4321 (gnus-dribble-clear)
4322 (gnus-message 7 "Cleared dribble buffer"))
4323
4324(defun gnus-group-exit ()
4325 "Quit reading news after updating .newsrc.eld and .newsrc.
4326The hook `gnus-exit-gnus-hook' is called before actually exiting."
4327 (interactive)
4328 (when
4329 (or noninteractive ;For gnus-batch-kill
4330 (not gnus-interactive-exit) ;Without confirmation
4331 gnus-expert-user
4332 (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
6748645f 4333 (gnus-run-hooks 'gnus-exit-gnus-hook)
eec82323
LMI		 4334 ;; Offer to save data from non-quitted summary buffers.
4335 (gnus-offer-save-summaries)
4336 ;; Save the newsrc file(s).
4337 (gnus-save-newsrc-file)
4338 ;; Kill-em-all.
4339 (gnus-close-backends)
4340 ;; Reset everything.
4341 (gnus-clear-system)
4342 ;; Allow the user to do things after cleaning up.
6748645f 4343 (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
eec82323
LMI		 4344
4345(defun gnus-group-quit ()
4346 "Quit reading news without updating .newsrc.eld or .newsrc.
4347The hook `gnus-exit-gnus-hook' is called before actually exiting."
4348 (interactive)
4349 (when (or noninteractive ;For gnus-batch-kill
4350 (zerop (buffer-size))
4351 (not (gnus-server-opened gnus-select-method))
4352 gnus-expert-user
4353 (not gnus-current-startup-file)
4354 (gnus-yes-or-no-p
4355 (format "Quit reading news without saving %s? "
4356 (file-name-nondirectory gnus-current-startup-file))))
6748645f 4357 (gnus-run-hooks 'gnus-exit-gnus-hook)
eec82323 4358 (gnus-configure-windows 'group t)
23f87bed 4359 (when (and (gnus-buffer-live-p gnus-dribble-buffer)
765abcce 4360 (not (zerop (with-current-buffer gnus-dribble-buffer
23f87bed
MB		 4361 (buffer-size)))))
4362 (gnus-dribble-enter
4363 ";;; Gnus was exited on purpose without saving the .newsrc files."))
eec82323
LMI		 4364 (gnus-dribble-save)
4365 (gnus-close-backends)
4366 (gnus-clear-system)
4367 (gnus-kill-buffer gnus-group-buffer)
4368 ;; Allow the user to do things after cleaning up.
6748645f 4369 (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
eec82323
LMI		 4370
4371(defun gnus-group-describe-briefly ()
4372 "Give a one line description of the group mode commands."
4373 (interactive)
bdaa75c7 4374 (gnus-message 7 "%s" (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
eec82323
LMI		 4375
4376(defun gnus-group-browse-foreign-server (method)
4377 "Browse a foreign news server.
4378If called interactively, this function will ask for a select method
4379 (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
4380If not, METHOD should be a list where the first element is the method
4381and the second element is the address."
4382 (interactive
229b59da
G		 4383 (list (let ((how (gnus-completing-read
4384 "Which back end"
3d319c8f
LMI		 4385 (mapcar 'car (append gnus-valid-select-methods
4386 gnus-server-alist))
229b59da 4387 t (cons "nntp" 0) 'gnus-method-history)))
23f87bed 4388 ;; We either got a back end name or a virtual server name.
eec82323
LMI		 4389 ;; If the first, we also need an address.
4390 (if (assoc how gnus-valid-select-methods)
4391 (list (intern how)
4392 ;; Suggested by mapjph@bath.ac.uk.
229b59da
G		 4393 (gnus-completing-read
4394 "Address"
4395 gnus-secondary-servers))
eec82323
LMI		 4396 ;; We got a server name.
4397 how))))
4398 (gnus-browse-foreign-server method))
4399
4400(defun gnus-group-set-info (info &optional method-only-group part)
16409b0b 4401 (when (or info part)
01c52d31
MB		 4402 (let* ((entry (gnus-group-entry
4403 (or method-only-group (gnus-info-group info))))
16409b0b
GM		 4404 (part-info info)
4405 (info (if method-only-group (nth 2 entry) info))
4406 method)
4407 (when method-only-group
4408 (unless entry
4409 (error "Trying to change non-existent group %s" method-only-group))
4410 ;; We have received parts of the actual group info - either the
c30ba437 4411 ;; select method or the group parameters. We first check
16409b0b
GM		 4412 ;; whether we have to extend the info, and if so, do that.
4413 (let ((len (length info))
4414 (total (if (eq part 'method) 5 6)))
4415 (when (< len total)
4416 (setcdr (nthcdr (1- len) info)
4417 (make-list (- total len) nil)))
4418 ;; Then we enter the new info.
4419 (setcar (nthcdr (1- total) info) part-info)))
eec82323 4420 (unless entry
16409b0b 4421 ;; This is a new group, so we just create it.
765abcce 4422 (with-current-buffer gnus-group-buffer
16409b0b
GM		 4423 (setq method (gnus-info-method info))
4424 (when (gnus-server-equal method "native")
4425 (setq method nil))
765abcce 4426 (with-current-buffer gnus-group-buffer
16409b0b
GM		 4427 (if method
4428 ;; It's a foreign group...
4429 (gnus-group-make-group
4430 (gnus-group-real-name (gnus-info-group info))
4431 (if (stringp method) method
4432 (prin1-to-string (car method)))
4433 (and (consp method)
01c52d31
MB		 4434 (nth 1 (gnus-info-method info)))
4435 nil t)
16409b0b 4436 ;; It's a native group.
01c52d31 4437 (gnus-group-make-group (gnus-info-group info) nil nil nil t)))
16409b0b
GM		 4438 (gnus-message 6 "Note: New group created")
4439 (setq entry
01c52d31
MB		 4440 (gnus-group-entry (gnus-group-prefixed-name
4441 (gnus-group-real-name (gnus-info-group info))
4442 (or (gnus-info-method info) gnus-select-method))))))
16409b0b
GM		 4443 ;; Whether it was a new group or not, we now have the entry, so we
4444 ;; can do the update.
4445 (if entry
4446 (progn
4447 (setcar (nthcdr 2 entry) info)
4448 (when (and (not (eq (car entry) t))
4449 (gnus-active (gnus-info-group info)))
23f87bed
MB		 4450 (setcar entry (length
4451 (gnus-list-of-unread-articles (car info))))))
16409b0b 4452 (error "No such group: %s" (gnus-info-group info))))))
eec82323 4453
85e75ded
LI		 4454;; Ad-hoc function for inserting data from a different newsrc.eld
4455;; file. Use with caution, if at all.
4456(defun gnus-import-other-newsrc-file (file)
4457 (with-temp-buffer
072be7db 4458 (insert-file-contents file)
85e75ded
LI		 4459 (let (form)
4460 (while (ignore-errors
4461 (setq form (read (current-buffer))))
4462 (when (and (consp form)
4463 (eq (cadr form) 'gnus-newsrc-alist))
4464 (let ((infos (cadr (nth 2 form))))
4465 (dolist (info infos)
4466 (when (gnus-get-info (car info))
4467 (gnus-set-info (car info) info)))))))))
4468
eec82323
LMI		 4469(defun gnus-add-marked-articles (group type articles &optional info force)
4470 ;; Add ARTICLES of TYPE to the info of GROUP.
16409b0b 4471 ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
eec82323
LMI		 4472 ;; add, but replace marked articles of TYPE with ARTICLES.
4473 (let ((info (or info (gnus-get-info group)))
eec82323
LMI		 4474 marked m)
4475 (or (not info)
4476 (and (not (setq marked (nthcdr 3 info)))
4477 (or (null articles)
4478 (setcdr (nthcdr 2 info)
4479 (list (list (cons type (gnus-compress-sequence
4480 articles t)))))))
4481 (and (not (setq m (assq type (car marked))))
4482 (or (null articles)
4483 (setcar marked
4484 (cons (cons type (gnus-compress-sequence articles t) )
4485 (car marked)))))
4486 (if force
4487 (if (null articles)
4488 (setcar (nthcdr 3 info)
6748645f 4489 (gnus-delete-alist type (car marked)))
eec82323
LMI		 4490 (setcdr m (gnus-compress-sequence articles t)))
4491 (setcdr m (gnus-compress-sequence
4492 (sort (nconc (gnus-uncompress-range (cdr m))
4493 (copy-sequence articles)) '<) t))))))
4494
23f87bed
MB		 4495(defun gnus-add-mark (group mark article)
4496 "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
4497 (let ((buffer (gnus-summary-buffer-name group)))
4498 (if (gnus-buffer-live-p buffer)
765abcce 4499 (with-current-buffer (get-buffer buffer)
23f87bed
MB		 4500 (gnus-summary-add-mark article mark))
4501 (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
4502 (list article)))))
4503
eec82323
LMI		 4504;;;
4505;;; Group timestamps
4506;;;
4507
4508(defun gnus-group-set-timestamp ()
4509 "Change the timestamp of the current group to the current time.
4510This function can be used in hooks like `gnus-select-group-hook'
4511or `gnus-group-catchup-group-hook'."
4512 (when gnus-newsgroup-name
4513 (let ((time (current-time)))
4514 (setcdr (cdr time) nil)
4515 (gnus-group-set-parameter gnus-newsgroup-name 'timestamp time))))
4516
4517(defsubst gnus-group-timestamp (group)
4518 "Return the timestamp for GROUP."
6748645f 4519 (gnus-group-get-parameter group 'timestamp t))
eec82323
LMI		 4520
4521(defun gnus-group-timestamp-delta (group)
4522 "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
4523 (let* ((time (or (gnus-group-timestamp group)
16409b0b 4524 (list 0 0)))
23f87bed 4525 (delta (subtract-time (current-time) time)))
eec82323
LMI		 4526 (+ (* (nth 0 delta) 65536.0)
4527 (nth 1 delta))))
4528
4529(defun gnus-group-timestamp-string (group)
4530 "Return a string of the timestamp for GROUP."
4531 (let ((time (gnus-group-timestamp group)))
4532 (if (not time)
4533 ""
4534 (gnus-time-iso8601 time))))
4535
16409b0b
GM		 4536(defun gnus-group-list-cached (level &optional lowest)
4537 "List all groups with cached articles.
4538If the prefix LEVEL is non-nil, it should be a number that says which
4539level to cut off listing groups.
4540If LOWEST, don't list groups with level lower than LOWEST.
4541
4542This command may read the active file."
4543 (interactive "P")
4544 (when level
4545 (setq level (prefix-numeric-value level)))
4546 (when (or (not level) (>= level gnus-level-zombie))
4547 (gnus-cache-open))
23f87bed
MB		 4548 (funcall gnus-group-prepare-function
4549 (or level gnus-level-subscribed)
4550 #'(lambda (info)
4551 (let ((marks (gnus-info-marks info)))
4552 (assq 'cache marks)))
4553 lowest
4554 #'(lambda (group)
4555 (or (gnus-gethash group
4556 gnus-cache-active-hashtb)
4557 ;; Cache active file might use "."
4558 ;; instead of ":".
4559 (gnus-gethash
4560 (mapconcat 'identity
4561 (split-string group ":")
4562 ".")
4563 gnus-cache-active-hashtb))))
16409b0b
GM		 4564 (goto-char (point-min))
4565 (gnus-group-position-point))
4566
4567(defun gnus-group-list-dormant (level &optional lowest)
4568 "List all groups with dormant articles.
4569If the prefix LEVEL is non-nil, it should be a number that says which
4570level to cut off listing groups.
4571If LOWEST, don't list groups with level lower than LOWEST.
4572
4573This command may read the active file."
4574 (interactive "P")
4575 (when level
4576 (setq level (prefix-numeric-value level)))
4577 (when (or (not level) (>= level gnus-level-zombie))
4578 (gnus-cache-open))
23f87bed
MB		 4579 (funcall gnus-group-prepare-function
4580 (or level gnus-level-subscribed)
4581 #'(lambda (info)
4582 (let ((marks (gnus-info-marks info)))
4583 (assq 'dormant marks)))
4584 lowest
4585 'ignore)
16409b0b
GM		 4586 (goto-char (point-min))
4587 (gnus-group-position-point))
4588
1518e4f0
G		 4589(defun gnus-group-list-ticked (level &optional lowest)
4590 "List all groups with ticked articles.
4591If the prefix LEVEL is non-nil, it should be a number that says which
4592level to cut off listing groups.
4593If LOWEST, don't list groups with level lower than LOWEST.
4594
4595This command may read the active file."
4596 (interactive "P")
4597 (when level
4598 (setq level (prefix-numeric-value level)))
4599 (when (or (not level) (>= level gnus-level-zombie))
4600 (gnus-cache-open))
4601 (funcall gnus-group-prepare-function
4602 (or level gnus-level-subscribed)
4603 #'(lambda (info)
4604 (let ((marks (gnus-info-marks info)))
4605 (assq 'tick marks)))
4606 lowest
4607 'ignore)
4608 (goto-char (point-min))
4609 (gnus-group-position-point))
4610
23f87bed
MB		 4611(defun gnus-group-listed-groups ()
4612 "Return a list of listed groups."
4613 (let (point groups)
4614 (goto-char (point-min))
4615 (while (setq point (text-property-not-all (point) (point-max)
4616 'gnus-group nil))
4617 (goto-char point)
4618 (push (symbol-name (get-text-property point 'gnus-group)) groups)
4619 (forward-char 1))
4620 groups))
4621
4622(defun gnus-group-list-plus (&optional args)
4623 "List groups plus the current selection."
4624 (interactive "P")
4625 (let ((gnus-group-listed-groups (gnus-group-listed-groups))
4626 (gnus-group-list-mode gnus-group-list-mode) ;; Save it.
4627 func)
4628 (push last-command-event unread-command-events)
4629 (if (featurep 'xemacs)
4630 (push (make-event 'key-press '(key ?A)) unread-command-events)
4631 (push ?A unread-command-events))
4632 (let (gnus-pick-mode keys)
4633 (setq keys (if (featurep 'xemacs)
4634 (events-to-keys (read-key-sequence nil))
4635 (read-key-sequence nil)))
4636 (setq func (lookup-key (current-local-map) keys)))
4637 (if (or (not func)
4638 (numberp func))
4639 (ding)
4640 (call-interactively func))))
4641
4642(defun gnus-group-list-flush (&optional args)
4643 "Flush groups from the current selection."
4644 (interactive "P")
4645 (let ((gnus-group-list-option 'flush))
4646 (gnus-group-list-plus args)))
4647
4648(defun gnus-group-list-limit (&optional args)
0afb49a1
LMI		 4649 "List groups limited within the current selection.
4650If you've limited the groups, you can further limit the selection
4651with this command. If you've first limited to groups with
4652dormant articles with `A ?', you can then further limit with
4653`A / c', which will then limit to groups with cached articles, giving
4654you the groups that have both dormant articles and cached articles."
23f87bed
MB		 4655 (interactive "P")
4656 (let ((gnus-group-list-option 'limit))
4657 (gnus-group-list-plus args)))
4658
4659(defun gnus-group-mark-article-read (group article)
4660 "Mark ARTICLE read."
4661 (let ((buffer (gnus-summary-buffer-name group))
4662 (mark gnus-read-mark)
4663 active n)
4664 (if (get-buffer buffer)
4665 (with-current-buffer buffer
4666 (setq active gnus-newsgroup-active)
4667 (gnus-activate-group group)
4668 (when gnus-newsgroup-prepared
4669 (when (and gnus-newsgroup-auto-expire
4670 (memq mark gnus-auto-expirable-marks))
4671 (setq mark gnus-expirable-mark))
4672 (setq mark (gnus-request-update-mark
4673 group article mark))
350a1888
G		 4674 (gnus-request-set-mark
4675 group (list (list (list article) 'add '(read))))
23f87bed
MB		 4676 (gnus-mark-article-as-read article mark)
4677 (setq gnus-newsgroup-active (gnus-active group))
4678 (when active
4679 (setq n (1+ (cdr active)))
4680 (while (<= n (cdr gnus-newsgroup-active))
4681 (unless (eq n article)
4682 (push n gnus-newsgroup-unselected))
4683 (setq n (1+ n)))
4684 (setq gnus-newsgroup-unselected
b5244046 4685 (sort gnus-newsgroup-unselected '<)))))
23f87bed
MB		 4686 (gnus-activate-group group)
4687 (gnus-group-make-articles-read group (list article))
b5244046
LMI		 4688 (when (and (gnus-group-auto-expirable-p group)
4689 (not (gnus-group-read-only-p group)))
23f87bed
MB		 4690 (gnus-add-marked-articles
4691 group 'expire (list article))))))
4692
01c52d31
MB		 4693
4694;;;
4695;;; Group compaction. -- dvl
4696;;;
4697
4698(defun gnus-group-compact-group (group)
4699 "Compact the current group.
4700Compaction means removing gaps between article numbers. Hence, this
4701operation is only meaningful for back ends using one file per article
4702\(e.g. nnml).
4703
4704Note: currently only implemented in nnml."
4705 (interactive (list (gnus-group-group-name)))
4706 (unless group
4707 (error "No group to compact"))
4708 (unless (gnus-check-backend-function 'request-compact-group group)
4709 (error "This back end does not support group compaction"))
4710 (let ((group-decoded (gnus-group-decoded-name group)))
4711 (gnus-message 6 "\
4712Compacting group %s... (this may take a long time)"
4713 group-decoded)
4714 (prog1
4715 (if (not (gnus-request-compact-group group))
4716 (gnus-error 3 "Couldn't compact group %s" group-decoded)
4717 (gnus-message 6 "Compacting group %s...done" group-decoded)
4718 t)
4719 ;; Invalidate the "original article" buffer which might be out of date.
4720 ;; #### NOTE: Yes, this might be a bit rude, but since compaction
4721 ;; #### will not happen very often, I think this is acceptable.
4722 (let ((original (get-buffer gnus-original-article-buffer)))
4723 (and original (gnus-kill-buffer original)))
4724 ;; Update the group line to reflect new information (art number etc).
4725 (gnus-group-update-group-line))))
4726
eec82323
LMI		 4727(provide 'gnus-group)
4728
4729;;; gnus-group.el ends here
Unnamed repository; edit this file 'description' to name the repository.