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