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