gnus-group.el 168 KB
Newer Older
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1
;;; gnus-group.el --- group mode commands for Gnus
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1996-2019 Free Software Foundation, Inc.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
4

5
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
6 7 8 9
;; Keywords: news

;; This file is part of GNU Emacs.

10
;; GNU Emacs is free software: you can redistribute it and/or modify
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
11
;; it under the terms of the GNU General Public License as published by
12 13
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
14 15 16

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
18 19 20
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
21
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
22 23 24 25 26

;;; Commentary:

;;; Code:

27
(require 'cl-lib)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
28 29 30 31 32 33 34 35
(require 'gnus)
(require 'gnus-start)
(require 'nnmail)
(require 'gnus-spec)
(require 'gnus-int)
(require 'gnus-range)
(require 'gnus-win)
(require 'gnus-undo)
36
(require 'gmm-utils)
37
(require 'time-date)
38

39 40
(eval-when-compile
  (require 'mm-url)
41
  (require 'subr-x)
42 43
  (let ((features (cons 'gnus-group features)))
    (require 'gnus-sum))
44 45 46
  (unless (boundp 'gnus-cache-active-hashtb)
    (defvar gnus-cache-active-hashtb nil)))

47 48
(defvar tool-bar-mode)

49 50
(autoload 'gnus-agent-total-fetched-for "gnus-agent")
(autoload 'gnus-cache-total-fetched-for "gnus-cache")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
51

52 53
(autoload 'gnus-group-make-nnir-group "nnir")

54 55 56
(autoload 'gnus-cloud-upload-all-data "gnus-cloud")
(autoload 'gnus-cloud-download-all-data "gnus-cloud")

57
(defcustom gnus-no-groups-message "No news is good news"
58
  "Message displayed by Gnus when no groups are available."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
59 60 61 62
  :group 'gnus-start
  :type 'string)

(defcustom gnus-keep-same-level nil
63
  "Non-nil means that the next newsgroup after the current will be on the same level.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
When you type, for instance, `n' after reading the last article in the
current newsgroup, you will go to the next newsgroup.  If this variable
is nil, the next newsgroup will be the next from the group
buffer.
If this variable is non-nil, Gnus will either put you in the
next newsgroup with the same level, or, if no such newsgroup is
available, the next newsgroup with the lowest possible level higher
than the current level.
If this variable is `best', Gnus will make the next newsgroup the one
with the best level."
  :group 'gnus-group-levels
  :type '(choice (const nil)
		 (const best)
		 (sexp :tag "other" t)))

(defcustom gnus-group-goto-unread t
80
  "If non-nil, movement commands will go to the next unread and subscribed group."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
81 82 83 84 85
  :link '(custom-manual "(gnus)Group Maneuvering")
  :group 'gnus-group-various
  :type 'boolean)

(defcustom gnus-goto-next-group-when-activating t
86
  "If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
87 88 89 90 91
  :link '(custom-manual "(gnus)Scanning New Messages")
  :group 'gnus-group-various
  :type 'boolean)

(defcustom gnus-permanently-visible-groups nil
92
  "Regexp to match groups that should always be listed in the group buffer.
93 94 95 96
This means that they will still be listed even when there are no
unread articles in the groups.

If nil, no groups are permanently visible."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
97
  :group 'gnus-group-listing
98
  :type '(choice regexp (const nil)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
99

Miles Bader's avatar
Miles Bader committed
100 101 102 103 104 105 106 107 108 109 110 111
(defcustom gnus-safe-html-newsgroups "\\`nnrss[+:]"
  "Groups in which links in html articles are considered all safe.
The value may be a regexp matching those groups, a list of group names,
or nil.  This overrides `mm-w3m-safe-url-regexp' (which see).  This is
effective only when emacs-w3m renders html articles, i.e., in the case
`mm-text-html-renderer' is set to `w3m'."
  :version "23.2"
  :group 'gnus-group-various
  :type '(choice regexp
		 (repeat :tag "List of group names" (string :tag "Group"))
		 (const nil)))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
112
(defcustom gnus-list-groups-with-ticked-articles t
113
  "If non-nil, list groups that have only ticked articles.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
114 115 116 117 118
If nil, only list groups that have unread articles."
  :group 'gnus-group-listing
  :type 'boolean)

(defcustom gnus-group-default-list-level gnus-level-subscribed
119
  "Default listing level.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
120 121
Ignored if `gnus-group-use-permanent-levels' is non-nil."
  :group 'gnus-group-listing
122 123
  :type '(choice (integer :tag "Level")
                 (function :tag "Function returning level")))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
124 125

(defcustom gnus-group-list-inactive-groups t
126
  "If non-nil, inactive groups will be listed."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
127 128 129 130 131
  :group 'gnus-group-listing
  :group 'gnus-group-levels
  :type 'boolean)

(defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet
132
  "Function used for sorting the group buffer.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
133 134 135 136
This function will be called with group info entries as the arguments
for the groups to be sorted.  Pre-made functions include
`gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
`gnus-group-sort-by-unread', `gnus-group-sort-by-level',
137 138
`gnus-group-sort-by-score', `gnus-group-sort-by-method',
`gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
139

140
This variable can also be a list of sorting functions.  In that case,
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
141 142 143 144
the most significant sort function should be the last function in the
list."
  :group 'gnus-group-listing
  :link '(custom-manual "(gnus)Sorting Groups")
145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
  :type '(repeat :value-to-internal (lambda (widget value)
				      (if (listp value) value (list value)))
		 :match (lambda (widget value)
			  (or (symbolp value)
			      (widget-editable-list-match widget value)))
		 (choice (function-item gnus-group-sort-by-alphabet)
			 (function-item gnus-group-sort-by-real-name)
			 (function-item gnus-group-sort-by-unread)
			 (function-item gnus-group-sort-by-level)
			 (function-item gnus-group-sort-by-score)
			 (function-item gnus-group-sort-by-method)
			 (function-item gnus-group-sort-by-server)
			 (function-item gnus-group-sort-by-rank)
			 (function :tag "other" nil))))

160
(defcustom gnus-group-line-format "%M\ %S\ %p\ %P\ %5y:%B%(%g%)\n"
161
  "Format of group lines.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
162 163 164 165 166 167 168 169 170 171 172
It works along the same lines as a normal formatting string,
with some simple extensions.

%M    Only marked articles (character, \"*\" or \" \")
%S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
%L    Level of subscribedness (integer)
%N    Number of unread articles (integer)
%I    Number of dormant articles (integer)
%i    Number of ticked and dormant (integer)
%T    Number of ticked articles (integer)
%R    Number of read articles (integer)
173
%U    Number of unseen articles (integer)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
174 175 176 177
%t    Estimated total number of articles (integer)
%y    Number of unread, unticked articles (integer)
%G    Group name (string)
%g    Qualified group name (string)
178 179
%c    Short (collapsed) group name.  See `gnus-group-uncollapsed-levels'.
%C    Group comment (string)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
180 181 182 183
%D    Group description (string)
%s    Select method (string)
%o    Moderated group (char, \"m\")
%p    Process mark (char)
184
%B    Whether a summary buffer for the group is open (char, \"*\")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
185 186 187 188 189 190
%O    Moderated group (string, \"(m)\" or \"\")
%P    Topic indentation (string)
%m    Whether there is new(ish) mail in the group (char, \"%\")
%n    Select from where (string)
%z    A string that look like `<%s:%n>' if a foreign select method is used
%d    The date the group was last entered.
191
%E    Icon as defined by `gnus-group-icon-list'.
192
%F    The disk space used by the articles fetched by both the cache and agent.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
193 194
%u    User defined specifier.  The next character in the format string should
      be a letter.  Gnus will call the function gnus-user-format-function-X,
195 196 197 198
      where X is the letter following %u.  The function will be passed a
      single dummy parameter as argument.  The function should return a
      string, which will be inserted into the buffer just like information
      from any other group specifier.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
199 200 201

Note that this format specification is not always respected.  For
reasons of efficiency, when listing killed groups, this specification
202
is ignored altogether.  If the spec is changed considerably, your
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
203 204 205 206
output may end up looking strange when listing both alive and killed
groups.

If you use %o or %O, reading the active file will be slower and quite
207 208 209 210
a bit of extra memory will be used.  %D and %F will also worsen
performance.  Also note that if you change the format specification to
include any of these specs, you must probably re-start Gnus to see
them go into effect.
211 212 213 214

General format specifiers can also be used.
See Info node `(gnus)Formatting Variables'."
  :link '(custom-manual "(gnus)Formatting Variables")
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
215 216 217
  :group 'gnus-group-visual
  :type 'string)

218
(defcustom gnus-group-mode-line-format "Gnus: %%b {%M\ %:%S}"
219
  "The format specification for the group mode line.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245
It works along the same lines as a normal formatting string,
with some simple extensions:

%S   The native news server.
%M   The native select method.
%:   \":\" if %S isn't \"\"."
  :group 'gnus-group-visual
  :type 'string)

(defcustom gnus-group-menu-hook nil
  "Hook run after the creation of the group mode menu."
  :group 'gnus-group-various
  :type 'hook)

(defcustom gnus-group-catchup-group-hook nil
  "Hook run when catching up a group from the group buffer."
  :group 'gnus-group-various
  :link '(custom-manual "(gnus)Group Data")
  :type 'hook)

(defcustom gnus-group-update-group-hook nil
  "Hook called when updating group lines."
  :group 'gnus-group-visual
  :type 'hook)

(defcustom gnus-group-prepare-function 'gnus-group-prepare-flat
246
  "A function that is called to generate the group buffer.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277
The function is called with three arguments: The first is a number;
all group with a level less or equal to that number should be listed,
if the second is non-nil, empty groups should also be displayed.  If
the third is non-nil, it is a number.  No groups with a level lower
than this number should be displayed.

The only current function implemented is `gnus-group-prepare-flat'."
  :group 'gnus-group-listing
  :type 'function)

(defcustom gnus-group-prepare-hook nil
  "Hook called after the group buffer has been generated.
If you want to modify the group buffer, you can use this hook."
  :group 'gnus-group-listing
  :type 'hook)

(defcustom gnus-suspend-gnus-hook nil
  "Hook called when suspending (not exiting) Gnus."
  :group 'gnus-exit
  :type 'hook)

(defcustom gnus-exit-gnus-hook nil
  "Hook called when exiting Gnus."
  :group 'gnus-exit
  :type 'hook)

(defcustom gnus-after-exiting-gnus-hook nil
  "Hook called after exiting Gnus."
  :group 'gnus-exit
  :type 'hook)

278 279
(defcustom gnus-group-update-hook nil
  "Hook called when a group line is changed."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
280
  :group 'gnus-group-visual
281
  :version "24.1"
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
282 283 284
  :type 'hook)

(defcustom gnus-useful-groups
285 286 287 288 289 290 291 292 293
  '(("(ding) mailing list mirrored at gmane.org"
     "gmane.emacs.gnus.general"
     (nntp "Gmane"
	   (nntp-address "news.gmane.org")))
    ("Gnus bug archive"
     "gnus.gnus-bug"
     (nntp "news.gnus.org"
	   (nntp-address "news.gnus.org")))
    ("Local Gnus help group"
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
294 295 296 297 298 299 300 301 302
     "gnus-help"
     (nndoc "gnus-help"
	    (nndoc-article-type mbox)
	    (eval `(nndoc-address
		    ,(let ((file (nnheader-find-etc-directory
				  "gnus-tut.txt" t)))
		       (unless file
			 (error "Couldn't find doc group"))
		       file))))))
303
  "Alist of useful group-server pairs."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
304 305 306 307 308 309
  :group 'gnus-group-listing
  :type '(repeat (list (string :tag "Description")
		       (string :tag "Name")
		       (sexp :tag "Method"))))

(defcustom gnus-group-highlight
310 311
  '(;; Mail.
    ((and mailp (= unread 0) (eq level 1)) .
312
     gnus-group-mail-1-empty)
313
    ((and mailp (eq level 1)) .
314
     gnus-group-mail-1)
315
    ((and mailp (= unread 0) (eq level 2)) .
316
     gnus-group-mail-2-empty)
317
    ((and mailp (eq level 2)) .
318
     gnus-group-mail-2)
319
    ((and mailp (= unread 0) (eq level 3)) .
320
     gnus-group-mail-3-empty)
321
    ((and mailp (eq level 3)) .
322
     gnus-group-mail-3)
323
    ((and mailp (= unread 0)) .
324
     gnus-group-mail-low-empty)
325
    ((and mailp) .
326
     gnus-group-mail-low)
327 328
    ;; News.
    ((and (= unread 0) (eq level 1)) .
329
     gnus-group-news-1-empty)
330
    ((and (eq level 1)) .
331
     gnus-group-news-1)
332
    ((and (= unread 0) (eq level 2)) .
333
     gnus-group-news-2-empty)
334
    ((and (eq level 2)) .
335
     gnus-group-news-2)
336
    ((and (= unread 0) (eq level 3)) .
337
     gnus-group-news-3-empty)
338
    ((and (eq level 3)) .
339
     gnus-group-news-3)
340
    ((and (= unread 0) (eq level 4)) .
341
     gnus-group-news-4-empty)
342
    ((and (eq level 4)) .
343
     gnus-group-news-4)
344
    ((and (= unread 0) (eq level 5)) .
345
     gnus-group-news-5-empty)
346
    ((and (eq level 5)) .
347
     gnus-group-news-5)
348
    ((and (= unread 0) (eq level 6)) .
349
     gnus-group-news-6-empty)
350
    ((and (eq level 6)) .
351
     gnus-group-news-6)
352
    ((and (= unread 0)) .
353
     gnus-group-news-low-empty)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
354
    (t .
355
     gnus-group-news-low))
356
  "Controls the highlighting of group buffer lines.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
357

Juanma Barranquero's avatar
Juanma Barranquero committed
358
Below is a list of `Form'/`Face' pairs.  When deciding how a
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377
particular group line should be displayed, each form is
evaluated.  The content of the face field after the first true form is
used.  You can change how those group lines are displayed by
editing the face field.

It is also possible to change and add form fields, but currently that
requires an understanding of Lisp expressions.  Hopefully this will
change in a future release.  For now, you can use the following
variables in the Lisp expression:

group: The name of the group.
unread: The number of unread articles in the group.
method: The select method used.
mailp: Whether it's a mail group or not.
level: The level of the group.
score: The score of the group.
ticked: The number of ticked articles."
  :group 'gnus-group-visual
  :type '(repeat (cons (sexp :tag "Form") face)))
378
(put 'gnus-group-highlight 'risky-local-variable t)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
379 380 381 382 383 384

(defcustom gnus-new-mail-mark ?%
  "Mark used for groups with new mail."
  :group 'gnus-group-visual
  :type 'character)

385
(defgroup gnus-group-icons nil
386
  "Add Icons to your group buffer."
387 388 389 390
  :group 'gnus-group-visual)

(defcustom gnus-group-icon-list
  nil
391
  "Controls the insertion of icons into group buffer lines.
392 393 394 395 396 397

Below is a list of `Form'/`File' pairs.  When deciding how a
particular group line should be displayed, each form is evaluated.
The icon from the file field after the first true form is used.  You
can change how those group lines are displayed by editing the file
field.  The File will either be found in the
398
`gnus-group-glyph-directory' or by designating absolute name of the
399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414
file.

It is also possible to change and add form fields, but currently that
requires an understanding of Lisp expressions.  Hopefully this will
change in a future release.  For now, you can use the following
variables in the Lisp expression:

group: The name of the group.
unread: The number of unread articles in the group.
method: The select method used.
mailp: Whether it's a mail group or not.
level: The level of the group.
score: The score of the group.
ticked: The number of ticked articles."
  :group 'gnus-group-icons
  :type '(repeat (cons (sexp :tag "Form") file)))
Miles Bader's avatar
Miles Bader committed
415
(put 'gnus-group-icon-list 'risky-local-variable t)
416 417

(defcustom gnus-group-name-charset-method-alist nil
418
  "Alist of method and the charset for group names.
419 420

For example:
421
    (((nntp \"news.com.cn\") . cn-gb-2312))"
422
  :version "21.1"
423 424 425
  :group 'gnus-charset
  :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))

426
(defcustom gnus-group-name-charset-group-alist
427
  (if (mm-coding-system-p 'utf-8)
428 429 430
      '((".*" . utf-8))
    nil)
  "Alist of group regexp and the charset for group names.
431 432

For example:
433
    ((\"\\.com\\.cn:\" . cn-gb-2312))"
434 435 436
  :group 'gnus-charset
  :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))

437 438
(defcustom gnus-group-jump-to-group-prompt nil
  "Default prompt for `gnus-group-jump-to-group'.
439 440 441 442 443

If non-nil, the value should be a string or an alist.  If it is a string,
e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group:
nnml:\" in the minibuffer prompt.

444
If it is an alist, it must consist of \(NUMBER .  PROMPT) pairs, for example:
445 446
\((1 .  \"\") (2 .  \"nnfolder+archive:\")).  The element with number 0 is
used when no prefix argument is given to `gnus-group-jump-to-group'."
447
  :version "22.1"
448 449
  :group 'gnus-group-various
  :type '(choice (string :tag "Prompt string")
450 451 452
		 (const :tag "Empty" nil)
		 (repeat (cons (integer :tag "Argument")
			       (string :tag "Prompt string")))))
453

454 455
(defcustom gnus-group-listing-limit 1000
  "A limit of the number of groups when listing.
456
If the number of groups is larger than the limit, list them in a
457 458 459
simple manner."
  :group 'gnus-group-listing
  :type 'integer)
460

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
461 462
;;; Internal variables

463 464
(defvar gnus-group-is-exiting-p nil)
(defvar gnus-group-is-exiting-without-update-p nil)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
465 466 467 468 469 470 471 472 473 474 475 476 477 478
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
  "Function for sorting the group buffer.")

(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
  "Function for sorting the selected groups in the group buffer.")

(defvar gnus-group-indentation-function nil)
(defvar gnus-goto-missing-group-function nil)
(defvar gnus-group-update-group-function nil)
(defvar gnus-group-goto-next-group-function nil
  "Function to override finding the next group after listing groups.")

(defvar gnus-group-edit-buffer nil)

479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497
(defvar gnus-tmp-news-method)
(defvar gnus-tmp-colon)
(defvar gnus-tmp-news-server)
(defvar gnus-tmp-header)
(defvar gnus-tmp-process-marked)
(defvar gnus-tmp-summary-live)
(defvar gnus-tmp-news-method-string)
(defvar gnus-tmp-group-icon)
(defvar gnus-tmp-moderated-string)
(defvar gnus-tmp-newsgroup-description)
(defvar gnus-tmp-comment)
(defvar gnus-tmp-qualified-group)
(defvar gnus-tmp-subscribed)
(defvar gnus-tmp-number-of-read)
(defvar gnus-inhibit-demon)
(defvar gnus-pick-mode)
(defvar gnus-tmp-marked-mark)
(defvar gnus-tmp-number-of-unread)

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
498
(defvar gnus-group-line-format-alist
499
  '((?M gnus-tmp-marked-mark ?c)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
500 501 502 503 504 505 506 507 508 509
    (?S gnus-tmp-subscribed ?c)
    (?L gnus-tmp-level ?d)
    (?N (cond ((eq number t) "*" )
	      ((numberp number)
	       (int-to-string
		(+ number
		   (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
		   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
	      (t number)) ?s)
    (?R gnus-tmp-number-of-read ?s)
510 511 512 513
    (?U (if (gnus-active gnus-tmp-group)
	    (gnus-number-of-unseen-articles-in-group gnus-tmp-group)
	  "*")
	?s)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
514 515 516 517 518 519
    (?t gnus-tmp-number-total ?d)
    (?y gnus-tmp-number-of-unread ?s)
    (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
    (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
    (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
	   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
520
    (?g gnus-tmp-group ?s)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
521
    (?G gnus-tmp-qualified-group ?s)
522
    (?c (gnus-short-group-name gnus-tmp-group)
523
	?s)
524
    (?C gnus-tmp-comment ?s)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
525 526 527 528 529
    (?D gnus-tmp-newsgroup-description ?s)
    (?o gnus-tmp-moderated ?c)
    (?O gnus-tmp-moderated-string ?s)
    (?p gnus-tmp-process-marked ?c)
    (?s gnus-tmp-news-server ?s)
530
    (?n gnus-tmp-news-method ?s)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
531
    (?P gnus-group-indentation ?s)
532
    (?E gnus-tmp-group-icon ?s)
533
    (?B gnus-tmp-summary-live ?c)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
534 535 536
    (?z gnus-tmp-news-method-string ?s)
    (?m (gnus-group-new-mail gnus-tmp-group) ?c)
    (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
537 538 539
    (?u gnus-tmp-user-defined ?s)
    (?F (gnus-total-fetched-for gnus-tmp-group) ?s)
    ))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
540 541

(defvar gnus-group-mode-line-format-alist
542
  '((?S gnus-tmp-news-server ?s)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
543 544 545 546 547 548 549 550 551 552 553 554 555 556
    (?M gnus-tmp-news-method ?s)
    (?u gnus-tmp-user-defined ?s)
    (?: gnus-tmp-colon ?s)))

(defvar gnus-topic-topology nil
  "The complete topic hierarchy.")

(defvar gnus-topic-alist nil
  "The complete topic-group alist.")

(defvar gnus-group-marked nil)

(defvar gnus-group-list-mode nil)

557

558 559 560
(defvar gnus-group-listed-groups nil)
(defvar gnus-group-list-option nil)

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
561 562 563 564
;;;
;;; Gnus group mode
;;;

565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621
(gnus-define-keys gnus-group-mode-map
  " " gnus-group-read-group
  "=" gnus-group-select-group
  "\r" gnus-group-select-group
  "\M-\r" gnus-group-quick-select-group
  "\M- " gnus-group-visible-select-group
  [(meta control return)] gnus-group-select-group-ephemerally
  "j" gnus-group-jump-to-group
  "n" gnus-group-next-unread-group
  "p" gnus-group-prev-unread-group
  "\177" gnus-group-prev-unread-group
  [delete] gnus-group-prev-unread-group
  "N" gnus-group-next-group
  "P" gnus-group-prev-group
  "\M-n" gnus-group-next-unread-group-same-level
  "\M-p" gnus-group-prev-unread-group-same-level
  "," gnus-group-best-unread-group
  "." gnus-group-first-unread-group
  "u" gnus-group-unsubscribe-current-group
  "U" gnus-group-unsubscribe-group
  "c" gnus-group-catchup-current
  "C" gnus-group-catchup-current-all
  "\M-c" gnus-group-clear-data
  "l" gnus-group-list-groups
  "L" gnus-group-list-all-groups
  "m" gnus-group-mail
  "i" gnus-group-news
  "g" gnus-group-get-new-news
  "\M-g" gnus-group-get-new-news-this-group
  "R" gnus-group-restart
  "r" gnus-group-read-init-file
  "B" gnus-group-browse-foreign-server
  "b" gnus-group-check-bogus-groups
  "F" gnus-group-find-new-groups
  "\C-c\C-d" gnus-group-describe-group
  "\M-d" gnus-group-describe-all-groups
  "\C-c\C-a" gnus-group-apropos
  "\C-c\M-\C-a" gnus-group-description-apropos
  "a" gnus-group-post-news
  "\ek" gnus-group-edit-local-kill
  "\eK" gnus-group-edit-global-kill
  "\C-k" gnus-group-kill-group
  "\C-y" gnus-group-yank-group
  "\C-w" gnus-group-kill-region
  "\C-x\C-t" gnus-group-transpose-groups
  "\C-c\C-l" gnus-group-list-killed
  "\C-c\C-x" gnus-group-expire-articles
  "\C-c\M-\C-x" gnus-group-expire-all-groups
  "V" gnus-version
  "s" gnus-group-save-newsrc
  "z" gnus-group-suspend
  "q" gnus-group-exit
  "Q" gnus-group-quit
  "?" gnus-group-describe-briefly
  "\C-c\C-i" gnus-info-find-node
  "\M-e" gnus-group-edit-group-method
  "^" gnus-group-enter-server-mode
622
  [mouse-2] gnus-mouse-pick-group
623
  [follow-link] mouse-face
624 625 626 627 628 629 630 631 632 633
  "<" beginning-of-buffer
  ">" end-of-buffer
  "\C-c\C-b" gnus-bug
  "\C-c\C-s" gnus-group-sort-groups
  "t" gnus-topic-mode
  "\C-c\M-g" gnus-activate-all-groups
  "\M-&" gnus-group-universal-argument
  "#" gnus-group-mark-group
  "\M-#" gnus-group-unmark-group)

634 635 636 637 638 639
(gnus-define-keys (gnus-group-cloud-map "~" gnus-group-mode-map)
  "u" gnus-cloud-upload-all-data
  "~" gnus-cloud-upload-all-data
  "d" gnus-cloud-download-all-data
  "\r" gnus-cloud-download-all-data)

640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665
(gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
  "m" gnus-group-mark-group
  "u" gnus-group-unmark-group
  "w" gnus-group-mark-region
  "b" gnus-group-mark-buffer
  "r" gnus-group-mark-regexp
  "U" gnus-group-unmark-all-groups)

(gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
  "u" gnus-sieve-update
  "g" gnus-sieve-generate)

(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
  "d" gnus-group-make-directory-group
  "h" gnus-group-make-help-group
  "u" gnus-group-make-useful-group
  "l" gnus-group-nnimap-edit-acl
  "m" gnus-group-make-group
  "E" gnus-group-edit-group
  "e" gnus-group-edit-group-method
  "p" gnus-group-edit-group-parameters
  "v" gnus-group-add-to-virtual
  "V" gnus-group-make-empty-virtual
  "D" gnus-group-enter-directory
  "f" gnus-group-make-doc-group
  "w" gnus-group-make-web-group
666
  "G" gnus-group-make-nnir-group
667 668 669 670
  "M" gnus-group-read-ephemeral-group
  "r" gnus-group-rename-group
  "R" gnus-group-make-rss-group
  "c" gnus-group-customize
671
  "z" gnus-group-compact-group
672
  "x" gnus-group-expunge-group
673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707
  "\177" gnus-group-delete-group
  [delete] gnus-group-delete-group)

(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
  "s" gnus-group-sort-groups
  "a" gnus-group-sort-groups-by-alphabet
  "u" gnus-group-sort-groups-by-unread
  "l" gnus-group-sort-groups-by-level
  "v" gnus-group-sort-groups-by-score
  "r" gnus-group-sort-groups-by-rank
  "m" gnus-group-sort-groups-by-method
  "n" gnus-group-sort-groups-by-real-name)

(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
  "s" gnus-group-sort-selected-groups
  "a" gnus-group-sort-selected-groups-by-alphabet
  "u" gnus-group-sort-selected-groups-by-unread
  "l" gnus-group-sort-selected-groups-by-level
  "v" gnus-group-sort-selected-groups-by-score
  "r" gnus-group-sort-selected-groups-by-rank
  "m" gnus-group-sort-selected-groups-by-method
  "n" gnus-group-sort-selected-groups-by-real-name)

(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
  "k" gnus-group-list-killed
  "z" gnus-group-list-zombies
  "s" gnus-group-list-groups
  "u" gnus-group-list-all-groups
  "A" gnus-group-list-active
  "a" gnus-group-apropos
  "d" gnus-group-description-apropos
  "m" gnus-group-list-matching
  "M" gnus-group-list-all-matching
  "l" gnus-group-list-level
  "c" gnus-group-list-cached
708 709
  "?" gnus-group-list-dormant
  "!" gnus-group-list-ticked)
710 711 712 713 714 715 716 717 718 719 720

(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
  "k"  gnus-group-list-limit
  "z"  gnus-group-list-limit
  "s"  gnus-group-list-limit
  "u"  gnus-group-list-limit
  "A"  gnus-group-list-limit
  "m"  gnus-group-list-limit
  "M"  gnus-group-list-limit
  "l"  gnus-group-list-limit
  "c"  gnus-group-list-limit
721 722
  "?"  gnus-group-list-limit
  "!"  gnus-group-list-limit)
723 724 725 726 727 728 729 730 731 732 733

(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
  "k"  gnus-group-list-flush
  "z"  gnus-group-list-flush
  "s"  gnus-group-list-flush
  "u"  gnus-group-list-flush
  "A"  gnus-group-list-flush
  "m"  gnus-group-list-flush
  "M"  gnus-group-list-flush
  "l"  gnus-group-list-flush
  "c"  gnus-group-list-flush
734 735
  "?"  gnus-group-list-flush
  "!"  gnus-group-list-flush)
736 737 738 739 740 741 742 743 744 745 746

(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
  "k"  gnus-group-list-plus
  "z"  gnus-group-list-plus
  "s"  gnus-group-list-plus
  "u"  gnus-group-list-plus
  "A"  gnus-group-list-plus
  "m"  gnus-group-list-plus
  "M"  gnus-group-list-plus
  "l"  gnus-group-list-plus
  "c"  gnus-group-list-plus
747 748
  "?"  gnus-group-list-plus
  "!"  gnus-group-list-plus)
749 750

(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
751 752
  "f" gnus-score-flush-cache
  "e" gnus-score-edit-all-score)
753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771

(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
  "d" gnus-group-describe-group
  "v" gnus-version)

(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
  "l" gnus-group-set-current-level
  "t" gnus-group-unsubscribe-current-group
  "s" gnus-group-unsubscribe-group
  "k" gnus-group-kill-group
  "y" gnus-group-yank-group
  "w" gnus-group-kill-region
  "\C-k" gnus-group-kill-level
  "z" gnus-group-kill-all-zombies)

(defun gnus-topic-mode-p ()
  "Return non-nil in `gnus-topic-mode'."
  (and (boundp 'gnus-topic-mode)
       (symbol-value 'gnus-topic-mode)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
772 773 774 775 776 777

(defun gnus-group-make-menu-bar ()
  (unless (boundp 'gnus-group-reading-menu)

    (easy-menu-define
     gnus-group-reading-menu gnus-group-mode-map ""
778
     '("Group"
779 780 781 782 783 784 785 786 787 788
       ["Read" gnus-group-read-group
	:included (not (gnus-topic-mode-p))
	:active (gnus-group-group-name)]
       ["Read " gnus-topic-read-group
	:included (gnus-topic-mode-p)]
       ["Select" gnus-group-select-group
	:included (not (gnus-topic-mode-p))
	:active (gnus-group-group-name)]
       ["Select " gnus-topic-select-group
	:included (gnus-topic-mode-p)]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
789 790
       ["See old articles" (gnus-group-select-group 'all)
	:keys "C-u SPC" :active (gnus-group-group-name)]
791 792 793
       ["Catch up" gnus-group-catchup-current
	:included (not (gnus-topic-mode-p))
	:active (gnus-group-group-name)
794
	:help "Mark unread articles in the current group as read"]
795 796
       ["Catch up " gnus-topic-catchup-articles
	:included (gnus-topic-mode-p)
797
	:help "Mark unread articles in the current group or topic as read"]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
798 799 800
       ["Catch up all articles" gnus-group-catchup-current-all
	(gnus-group-group-name)]
       ["Check for new articles" gnus-group-get-new-news-this-group
801
	:included (not (gnus-topic-mode-p))
802
	:active (gnus-group-group-name)
803
	:help "Check for new messages in current group"]
804 805
       ["Check for new articles " gnus-topic-get-new-news-this-topic
	:included (gnus-topic-mode-p)
806
	:help "Check for new messages in current group or topic"]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
807 808
       ["Toggle subscription" gnus-group-unsubscribe-current-group
	(gnus-group-group-name)]
809
       ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
810
	:help "Kill (remove) current group"]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
811
       ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
812
       ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
813
	:help "Display description of the current group"]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
814 815 816
       ;; Actually one should check, if any of the marked groups gives t for
       ;; (gnus-check-backend-function 'request-expire-articles ...)
       ["Expire articles" gnus-group-expire-articles
817 818 819 820 821 822 823 824
	:included (not (gnus-topic-mode-p))
	:active (or (and (gnus-group-group-name)
			 (gnus-check-backend-function
			  'request-expire-articles
			  (gnus-group-group-name))) gnus-group-marked)]
       ["Expire articles " gnus-topic-expire-articles
	:included (gnus-topic-mode-p)]
       ["Set group level..." gnus-group-set-current-level
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
825 826 827
	(gnus-group-group-name)]
       ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
       ["Customize" gnus-group-customize (gnus-group-group-name)]
828 829
       ["Compact" gnus-group-compact-group
	:active (gnus-group-group-name)]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
830 831
       ("Edit"
	["Parameters" gnus-group-edit-group-parameters
832 833 834 835
	 :included (not (gnus-topic-mode-p))
	 :active (gnus-group-group-name)]
	["Parameters " gnus-topic-edit-parameters
	 :included (gnus-topic-mode-p)]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
836 837 838 839
	["Select method" gnus-group-edit-group-method
	 (gnus-group-group-name)]
	["Info" gnus-group-edit-group (gnus-group-group-name)]
	["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
840
	["Global kill file" gnus-group-edit-global-kill t])))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
841 842 843 844 845 846 847 848 849 850 851 852 853 854 855

    (easy-menu-define
     gnus-group-group-menu gnus-group-mode-map ""
     '("Groups"
       ("Listing"
	["List unread subscribed groups" gnus-group-list-groups t]
	["List (un)subscribed groups" gnus-group-list-all-groups t]
	["List killed groups" gnus-group-list-killed gnus-killed-list]
	["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
	["List level..." gnus-group-list-level t]
	["Describe all groups" gnus-group-describe-all-groups t]
	["Group apropos..." gnus-group-apropos t]
	["Group and description apropos..." gnus-group-description-apropos t]
	["List groups matching..." gnus-group-list-matching t]
	["List all groups matching..." gnus-group-list-all-matching t]
856 857
	["List active file" gnus-group-list-active t]
	["List groups with cached" gnus-group-list-cached t]
858 859
	["List groups with dormant" gnus-group-list-dormant t]
	["List groups with ticked" gnus-group-list-ticked t])
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
860 861 862 863 864 865 866
       ("Sort"
	["Default sort" gnus-group-sort-groups t]
	["Sort by method" gnus-group-sort-groups-by-method t]
	["Sort by rank" gnus-group-sort-groups-by-rank t]
	["Sort by score" gnus-group-sort-groups-by-score t]
	["Sort by level" gnus-group-sort-groups-by-level t]
	["Sort by unread" gnus-group-sort-groups-by-unread t]
867 868
	["Sort by name" gnus-group-sort-groups-by-alphabet t]
	["Sort by real name" gnus-group-sort-groups-by-real-name t])
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
869 870
       ("Sort process/prefixed"
	["Default sort" gnus-group-sort-selected-groups
871
	 (not (gnus-topic-mode-p))]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
872
	["Sort by method" gnus-group-sort-selected-groups-by-method
873
	 (not (gnus-topic-mode-p))]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
874
	["Sort by rank" gnus-group-sort-selected-groups-by-rank
875
	 (not (gnus-topic-mode-p))]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
876
	["Sort by score" gnus-group-sort-selected-groups-by-score
877
	 (not (gnus-topic-mode-p))]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
878
	["Sort by level" gnus-group-sort-selected-groups-by-level
879
	 (not (gnus-topic-mode-p))]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
880
	["Sort by unread" gnus-group-sort-selected-groups-by-unread
881
	 (not (gnus-topic-mode-p))]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
882
	["Sort by name" gnus-group-sort-selected-groups-by-alphabet
883 884 885
	 (not (gnus-topic-mode-p))]
	["Sort by real name" gnus-group-sort-selected-groups-by-real-name
	 (not (gnus-topic-mode-p))])
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
886 887 888 889 890 891 892 893 894
       ("Mark"
	["Mark group" gnus-group-mark-group
	 (and (gnus-group-group-name)
	      (not (memq (gnus-group-group-name) gnus-group-marked)))]
	["Unmark group" gnus-group-unmark-group
	 (and (gnus-group-group-name)
	      (memq (gnus-group-group-name) gnus-group-marked))]
	["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
	["Mark regexp..." gnus-group-mark-regexp t]
895
	["Mark region" gnus-group-mark-region :active mark-active]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
896 897 898 899
	["Mark buffer" gnus-group-mark-buffer t]
	["Execute command" gnus-group-universal-argument
	 (or gnus-group-marked (gnus-group-group-name))])
       ("Subscribe"
900 901
	["Subscribe to a group..." gnus-group-unsubscribe-group t]
	["Kill all newsgroups in region" gnus-group-kill-region
902
	 :active mark-active]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
903 904 905 906
	["Kill all zombie groups" gnus-group-kill-all-zombies
	 gnus-zombie-list]
	["Kill all groups on level..." gnus-group-kill-level t])
       ("Foreign groups"
907 908
	["Make a foreign group..." gnus-group-make-group t]
	["Add a directory group..." gnus-group-make-directory-group t]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
909
	["Add the help group" gnus-group-make-help-group t]
910 911
	["Make a doc group..." gnus-group-make-doc-group t]
	["Make a web group..." gnus-group-make-web-group t]
912
	["Make a search group..." gnus-group-make-nnir-group t]
913 914 915 916 917
	["Make a virtual group..." gnus-group-make-empty-virtual t]
	["Add a group to a virtual..." gnus-group-add-to-virtual t]
	["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
	["Make an RSS group..." gnus-group-make-rss-group t]
	["Rename group..." gnus-group-rename-group
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
918 919 920 921 922 923 924 925 926 927 928 929 930
	 (gnus-check-backend-function
	  'request-rename-group (gnus-group-group-name))]
	["Delete group" gnus-group-delete-group
	 (gnus-check-backend-function
	  'request-delete-group (gnus-group-group-name))])
       ("Move"
	["Next" gnus-group-next-group t]
	["Previous" gnus-group-prev-group t]
	["Next unread" gnus-group-next-unread-group t]
	["Previous unread" gnus-group-prev-unread-group t]
	["Next unread same level" gnus-group-next-unread-group-same-level t]
	["Previous unread same level"
	 gnus-group-prev-unread-group-same-level t]
931
	["Jump to group..." gnus-group-jump-to-group t]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
932 933
	["First unread group" gnus-group-first-unread-group t]
	["Best unread group" gnus-group-best-unread-group t])
934 935 936
       ("Sieve"
	["Generate" gnus-sieve-generate t]
	["Generate and update" gnus-sieve-update t])
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
937
       ["Delete bogus groups" gnus-group-check-bogus-groups t]
938
       ["Find new newsgroups" gnus-group-find-new-groups t]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
939 940
       ["Transpose" gnus-group-transpose-groups
	(gnus-group-group-name)]
941
       ["Read a directory as a group..." gnus-group-enter-directory t]))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
942 943 944

    (easy-menu-define
     gnus-group-misc-menu gnus-group-mode-map ""
945
     '("Gnus"
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
946
       ["Send a mail" gnus-group-mail t]
947 948
       ["Send a message (mail or news)" gnus-group-post-news t]
       ["Create a local message" gnus-group-news t]
949
       ["Check for new news" gnus-group-get-new-news
950
	:help "Get newly arrived articles"]
951
       ["Send queued messages" gnus-delay-send-queue
952
	:help "Send all messages that are scheduled to be sent now"]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
953 954 955
       ["Activate all groups" gnus-activate-all-groups t]
       ["Restart Gnus" gnus-group-restart t]
       ["Read init file" gnus-group-read-init-file t]
956
       ["Browse foreign server..." gnus-group-browse-foreign-server t]
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
957 958 959 960 961 962 963 964 965
       ["Enter server buffer" gnus-group-enter-server-mode t]
       ["Expire all expirable articles" gnus-group-expire-all-groups t]
       ["Gnus version" gnus-version t]
       ["Save .newsrc files" gnus-group-save-newsrc t]
       ["Suspend Gnus" gnus-group-suspend t]
       ["Clear dribble buffer" gnus-group-clear-dribble t]
       ["Read manual" gnus-info-find-node t]
       ["Flush score cache" gnus-score-flush-cache t]
       ["Toggle topics" gnus-topic-mode t]
966
       ["Send a bug report" gnus-bug t]
967
       ["Exit from Gnus" gnus-group-exit :help "Quit reading news"]
968
       ["Exit without saving" gnus-group-quit t]))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
969

970
    (gnus-run-hooks 'gnus-group-menu-hook)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
971

972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990

(defvar gnus-group-tool-bar-map nil)

(defun gnus-group-tool-bar-update (&optional symbol value)
  "Update group buffer toolbar.
Setter function for custom variables."
  (when symbol
    (set-default symbol value))
  ;; (setq-default gnus-group-tool-bar-map nil)
  ;; (use-local-map gnus-group-mode-map)
  (when (gnus-alive-p)
    (with-current-buffer gnus-group-buffer
      (gnus-group-make-tool-bar t))))

(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
				   'gnus-group-tool-bar-gnome
				 'gnus-group-tool-bar-retro)
  "Specifies the Gnus group tool bar.

Paul Eggert's avatar
Paul Eggert committed
991
It can be either a list or a symbol referring to a list.  See
992 993 994 995 996 997 998 999 1000
`gmm-tool-bar-from-list' for the format of the list.  The
default key map is `gnus-group-mode-map'.

Pre-defined symbols include `gnus-group-tool-bar-gnome' and
`gnus-group-tool-bar-retro'."
  :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
		 (const :tag "Retro look" gnus-group-tool-bar-retro)
		 (repeat :tag "User defined list" gmm-tool-bar-item)
		 (symbol))
1001
  :version "23.1" ;; No Gnus
1002 1003 1004 1005 1006 1007 1008 1009
  :initialize 'custom-initialize-default
  :set 'gnus-group-tool-bar-update
  :group 'gnus-group)

(defcustom gnus-group-tool-bar-gnome
  '((gnus-group-post-news "mail/compose")
    ;; Some useful agent icons?  I don't use the agent so agent users should
    ;; suggest useful commands:
1010
    (gnus-agent-toggle-plugged "unplugged" t
Miles Bader's avatar
Miles Bader committed
1011 1012
			       :help "Gnus is currently unplugged.  Click to work online."
     			       :visible (and gnus-agent (not gnus-plugged)))
1013
    (gnus-agent-toggle-plugged "plugged" t
Miles Bader's avatar
Miles Bader committed
1014
			       :help "Gnus is currently plugged.  Click to work offline."
1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043
     			       :visible (and gnus-agent gnus-plugged))
    ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
    ;; should have a better help text.
    (gnus-group-send-queue "mail/outbox" t
			   :visible (and gnus-agent gnus-plugged)
			   :help "Send articles from the queue group")
    (gnus-group-get-new-news "mail/inbox" nil
			     :visible (or (not gnus-agent)
					  gnus-plugged))
    ;; FIXME: gnus-*-read-group should have a better help text.
    (gnus-topic-read-group "open" nil
			   :visible (and (boundp 'gnus-topic-mode)
					 gnus-topic-mode))
    (gnus-group-read-group "open" nil
			   :visible (not (and (boundp 'gnus-topic-mode)
					      gnus-topic-mode)))
    ;; (gnus-group-find-new-groups "???" nil)
    (gnus-group-save-newsrc "save")
    (gnus-group-describe-group "describe")
    (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
    (gnus-group-prev-unread-group "left-arrow")
    (gnus-group-next-unread-group "right-arrow")
    (gnus-group-exit "exit")
    (gmm-customize-mode "preferences" t :help "Edit mode preferences")
    (gnus-info-find-node "help"))
  "List of functions for the group tool bar (GNOME style).

See `gmm-tool-bar-from-list' for the format of the list."
  :type '(repeat gmm-tool-bar-item)
1044
  :version "23.1" ;; No Gnus
1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062
  :initialize 'custom-initialize-default
  :set 'gnus-group-tool-bar-update
  :group 'gnus-group)

(defcustom gnus-group-tool-bar-retro
  '((gnus-group-get-new-news "gnus/get-news")
    (gnus-group-get-new-news-this-group "gnus/gnntg")
    (gnus-group-catchup-current "gnus/catchup")
    (gnus-group-describe-group "gnus/describe-group")
    (gnus-group-subscribe "gnus/subscribe" t
			  :help "Subscribe to the current group")
    (gnus-group-unsubscribe "gnus/unsubscribe" t
			    :help "Unsubscribe from the current group")
    (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
  "List of functions for the group tool bar (retro look).

See `gmm-tool-bar-from-list' for the format of the list."
  :type '(repeat gmm-tool-bar-item)
1063
  :version "23.1" ;; No Gnus
1064 1065 1066 1067 1068 1069 1070 1071 1072 1073
  :initialize 'custom-initialize-default
  :set 'gnus-group-tool-bar-update
  :group 'gnus-group)

(defcustom gnus-group-tool-bar-zap-list t
  "List of icon items from the global tool bar.
These items are not displayed in the Gnus group mode tool bar.

See `gmm-tool-bar-from-list' for the format of the list."
  :type 'gmm-tool-bar-zap-list
1074
  :version "23.1" ;; No Gnus
1075 1076 1077 1078 1079
  :initialize 'custom-initialize-default
  :set 'gnus-group-tool-bar-update
  :group 'gnus-group)

(defvar image-load-path)
1080
(defvar tool-bar-map)
1081 1082
(declare-function image-load-path-for-library "image"
		  (library image &optional path no-error))
1083 1084 1085 1086

(defun gnus-group-make-tool-bar (&optional force)
  "Make a group mode tool bar from `gnus-group-tool-bar'.
When FORCE, rebuild the tool bar."
1087
  (when (and (boundp 'tool-bar-mode)
1088
	     tool-bar-mode
1089
             (display-graphic-p)
1090 1091
	     (or (not gnus-group-tool-bar-map) force))
    (let* ((load-path
1092 1093
	    (image-load-path-for-library
	     "gnus" "gnus/toggle-subscription.xpm" nil t))
1094
           (image-load-path (cons (car load-path) image-load-path))
1095 1096 1097 1098 1099 1100
	   (map (gmm-tool-bar-from-list gnus-group-tool-bar
					gnus-group-tool-bar-zap-list
					'gnus-group-mode-map)))
      (if map
	  (set (make-local-variable 'tool-bar-map) map))))
  gnus-group-tool-bar-map)
1101

1102
(define-derived-mode gnus-group-mode gnus-mode "Group"
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1103 1104 1105
  "Major mode for reading news.
All normal editing commands are switched off.
\\<gnus-group-mode-map>
1106
The group buffer lists (some of) the groups available.  For instance,
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118
`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
lists all zombie groups.

Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.

For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').

The following commands are available:

\\{gnus-group-mode-map}"
  (when (gnus-visual-p 'group-menu 'menu)
1119 1120
    (gnus-group-make-menu-bar)
    (gnus-group-make-tool-bar))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1121 1122 1123
  (gnus-simplify-mode-line)
  (gnus-group-set-mode-line)
  (setq mode-line-process nil)
1124
  (buffer-disable-undo)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1125
  (setq truncate-lines t)
1126
  (setq show-trailing-whitespace nil)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1127 1128 1129 1130 1131
  (gnus-set-default-directory)
  (gnus-update-format-specifications nil 'group 'group-mode)
  (gnus-update-group-mark-positions)
  (when gnus-use-undo
    (gnus-undo-mode 1))
1132
  (when gnus-slave
1133
    (gnus-slave-mode)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1134 1135 1136

(defun gnus-update-group-mark-positions ()
  (save-excursion
1137
    (let ((gnus-process-mark ?\200)
1138
	  (gnus-group-update-hook nil)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1139
	  (gnus-group-marked '("dummy.group"))
1140
	  (gnus-active-hashtb (gnus-make-hashtable 10)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1141 1142 1143 1144 1145
      (gnus-set-active "dummy.group" '(0 . 0))
      (gnus-set-work-buffer)
      (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
      (goto-char (point-min))
      (setq gnus-group-mark-positions
1146
	    (list (cons 'process (and (search-forward
1147
				       (string gnus-process-mark) nil t)
1148
				      (- (point) (point-min) 1))))))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1149 1150 1151 1152 1153 1154 1155

(defun gnus-mouse-pick-group (e)
  "Enter the group under the mouse pointer."
  (interactive "e")
  (mouse-set-point e)
  (gnus-group-read-group nil))

1156 1157 1158 1159 1160 1161
(defun gnus-group-default-list-level ()
  "Return the real value for `gnus-group-default-list-level'."
  (if (functionp gnus-group-default-list-level)
      (funcall gnus-group-default-list-level)
    gnus-group-default-list-level))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1162 1163 1164 1165 1166 1167 1168 1169 1170
;; Look at LEVEL and find out what the level is really supposed to be.
;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
;; will depend on whether `gnus-group-use-permanent-levels' is used.
(defun gnus-group-default-level (&optional level number-or-nil)
  (cond
   (gnus-group-use-permanent-levels
    (or (setq gnus-group-use-permanent-levels
	      (or level (if (numberp gnus-group-use-permanent-levels)
			    gnus-group-use-permanent-levels
1171
			  (or (gnus-group-default-list-level)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1172
			      gnus-level-subscribed))))
1173
	(gnus-group-default-list-level) gnus-level-subscribed))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1174 1175 1176
   (number-or-nil
    level)
   (t
1177
    (or level (gnus-group-default-list-level) gnus-level-subscribed))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1178 1179

(defun gnus-group-setup-buffer ()
1180
  (set-buffer (gnus-get-buffer-create gnus-group-buffer))
1181
  (unless (derived-mode-p 'gnus-group-mode)
1182
    (gnus-group-mode)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1183

1184 1185 1186
;; FIXME: If we never have to coerce group names to unibyte now, how
;; much of this is necessary?  How much encoding/decoding do we still
;; have to do?
1187
(defun gnus-group-name-charset (method group)
1188 1189 1190 1191 1192 1193 1194
  (unless method
    (setq method (gnus-find-method-for-group group)))
  (when (stringp method)
    (setq method (gnus-server-to-method method)))
  (if (eq (car method) 'nnimap)
      ;; IMAP groups should not be encoded, since they do the encoding
      ;; in utf7 in the protocol.
1195
      'utf-8
1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208
    (let ((item (or (assoc method gnus-group-name-charset-method-alist)
		    (and (consp method)
			 (assoc (list (car method) (cadr method))
				gnus-group-name-charset-method-alist))))
	  (alist gnus-group-name-charset-group-alist)
	  result)
      (if item
	  (cdr item)
	(while (setq item (pop alist))
	  (if (string-match (car item) group)
	      (setq alist nil
		    result (cdr item))))
	result))))
1209

1210 1211
(defun gnus-group-name-decode (string charset)
  ;; Fixme: Don't decode in unibyte mode.
1212
  (if (and string charset)
1213
      (decode-coding-string string charset)
1214 1215 1216 1217 1218 1219
    string))

(defun gnus-group-decoded-name (string)
  (let ((charset (gnus-group-name-charset nil string)))
    (gnus-group-name-decode string charset)))

Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231
(defun gnus-group-list-groups (&optional level unread lowest)
  "List newsgroups with level LEVEL or lower that have unread articles.
Default is all subscribed groups.
If argument UNREAD is non-nil, groups with no unread articles are also
listed.

Also see the `gnus-group-use-permanent-levels' variable."
  (interactive
   (list (if current-prefix-arg
	     (prefix-numeric-value current-prefix-arg)
	   (or
	    (gnus-group-default-level nil t)
1232
	    (gnus-group-default-list-level)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1233 1234 1235 1236 1237 1238 1239 1240
	    gnus-level-subscribed))))
  (unless level
    (setq level (car gnus-group-list-mode)
	  unread (cdr gnus-group-list-mode)))
  (setq level (gnus-group-default-level level))
  (gnus-group-setup-buffer)
  (gnus-update-format-specifications nil 'group 'group-mode)
  (let ((case-fold-search nil)
1241
	(props (text-properties-at (point-at-bol)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1242 1243 1244 1245 1246 1247 1248 1249 1250
	(empty (= (point-min) (point-max)))
	(group (gnus-group-group-name))
	number)
    (set-buffer gnus-group-buffer)
    (setq number (funcall gnus-group-prepare-function level unread lowest))
    (when (or (and (numberp number)
		   (zerop number))
	      (zerop (buffer-size)))
      ;; No groups in the buffer.
1251
      (gnus-message 5 "%s" gnus-no-groups-message))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267
    ;; We have some groups displayed.
    (goto-char (point-max))
    (when (or (not gnus-group-goto-next-group-function)
	      (not (funcall gnus-group-goto-next-group-function
			    group props)))
      (cond
       (empty
	(goto-char (point-min)))
       ((not group)
	;; Go to the first group with unread articles.
	(gnus-group-search-forward t))
       (t
	;; Find the right group to put point on.  If the current group
	;; has disappeared in the new listing, try to find the next
	;; one.  If no next one can be found, just leave point at the
	;; first newsgroup in the buffer.
1268 1269 1270 1271 1272 1273 1274 1275
	(when (not (gnus-text-property-search
		    'gnus-group group nil 'goto))
	  (let ((groups (cdr-safe (member group gnus-group-list))))
	    (while (and groups
			(not (gnus-text-property-search
			      'gnus-group (car groups) 'forward 'goto)))
	      (setq groups (cdr groups)))
	    (unless groups
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286
	      (goto-char (point-max))
	      (forward-line -1)))))))
    ;; Adjust cursor point.
    (gnus-group-position-point)))

(defun gnus-group-list-level (level &optional all)
  "List groups on LEVEL.
If ALL (the prefix), also list groups that have no unread articles."
  (interactive "nList groups on level: \nP")
  (gnus-group-list-groups level all level))

1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299
(defun gnus-group-prepare-logic (group test)
  (or (and gnus-group-listed-groups
	   (null gnus-group-list-option)
	   (member group gnus-group-listed-groups))
      (cond
       ((null gnus-group-listed-groups) test)
       ((null gnus-group-list-option) test)
       (t (and (member group gnus-group-listed-groups)
	       (if (eq gnus-group-list-option 'flush)
		   (not test)
		 test))))))

(defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1300
  "List all newsgroups with unread articles of level LEVEL or lower.
1301 1302
If PREDICATE is a function, list groups that the function returns non-nil;
if it is t, list groups that have no unread articles.
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1303
If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
1304 1305
If REGEXP is a function, list dead groups that the function returns non-nil;
if it is a string, only list groups matching REGEXP."
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1306 1307 1308
  (set-buffer gnus-group-buffer)
  (let ((buffer-read-only nil)
	(lowest (or lowest 1))
1309 1310
	(not-in-list (and gnus-group-listed-groups
			  (copy-sequence gnus-group-listed-groups)))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1311 1312
	info clevel unread group params)
    (erase-buffer)
1313 1314
    (when (or (< lowest gnus-level-zombie)
	      gnus-group-listed-groups)
1315 1316
      ;; List living groups, according to order in `gnus-group-list'.
      (dolist (g (cdr gnus-group-list))
1317
        (setq info (gnus-get-info g)
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1318 1319
	      group (gnus-info-group info)
	      params (gnus-info-params info)
1320
	      unread (gnus-group-unread group))
1321 1322 1323 1324
	(when not-in-list
	  (setq not-in-list (delete group not-in-list)))
	(when (gnus-group-prepare-logic
	       group
1325 1326
	       (and (or unread		; This group might be unchecked
			predicate)	; Check if this group should be listed
1327 1328 1329 1330 1331 1332 1333 1334 1335 1336
		    (or (not (stringp regexp))
			(string-match regexp group))
		    (<= (setq clevel (gnus-info-level info)) level)
		    (>= clevel lowest)
		    (cond
		     ((functionp predicate)
		      (funcall predicate info))
		     (predicate t)	; We list all groups?
		     (t
		      (or
1337
		       (if (eq unread t) ; Inactive?
1338
			   gnus-group-list-inactive-groups
Paul Eggert's avatar
Paul Eggert committed
1339
					; We list inactive
1340
			 (and (numberp unread) (> unread 0)))
1341 1342 1343
					; We list groups with unread articles
		       (and gnus-list-groups-with-ticked-articles
			    (cdr (assq 'tick (gnus-info-marks info))))
Paul Eggert's avatar
Paul Eggert committed
1344
					; And groups with ticked articles
1345 1346 1347 1348
		       ;; Check for permanent visibility.
		       (and gnus-permanently-visible-groups
			    (string-match gnus-permanently-visible-groups
					  group))
1349 1350
		       ;; Marked groups are always visible.
		       (member group gnus-group-marked)
1351 1352 1353 1354 1355
		       (memq 'visible params)
		       (cdr (assq 'visible params)))))))
	  (gnus-group-insert-group-line
	   group (gnus-info-level info)
	   (gnus-info-marks info) unread (gnus-info-method info)))))
Lars Magne Ingebrigtsen's avatar
Lars Magne Ingebrigtsen committed
1356