cgit.sxemacs.org Git - gnus/blob - lisp/gnus-group.el

   1 ;;; gnus-group.el --- group mode commands for Gnus
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 ;; For Emacs < 22.2.
  29 (eval-and-compile
  30   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  31
  32 (eval-when-compile
  33   (require 'cl))
  34 (defvar tool-bar-mode)
  35
  36 (require 'gnus)
  37 (require 'gnus-start)
  38 (require 'nnmail)
  39 (require 'gnus-spec)
  40 (require 'gnus-int)
  41 (require 'gnus-range)
  42 (require 'gnus-win)
  43 (require 'gnus-undo)
  44 (require 'gmm-utils)
  45 (require 'time-date)
  46 (require 'gnus-ems)
  47
  48 (eval-when-compile
  49   (require 'mm-url)
  50   (let ((features (cons 'gnus-group features)))
  51     (require 'gnus-sum))
  52   (unless (boundp 'gnus-cache-active-hashtb)
  53     (defvar gnus-cache-active-hashtb nil)))
  54
  55 (autoload 'gnus-agent-total-fetched-for "gnus-agent")
  56 (autoload 'gnus-cache-total-fetched-for "gnus-cache")
  57
  58 (defcustom gnus-group-archive-directory
  59   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
  60   "*The address of the (ding) archives."
  61   :group 'gnus-group-foreign
  62   :type 'directory)
  63
  64 (defcustom gnus-group-recent-archive-directory
  65   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
  66   "*The address of the most recent (ding) articles."
  67   :group 'gnus-group-foreign
  68   :type 'directory)
  69
  70 (defcustom gnus-no-groups-message "No Gnus is good news"
  71   "*Message displayed by Gnus when no groups are available."
  72   :group 'gnus-start
  73   :type 'string)
  74
  75 (defcustom gnus-keep-same-level nil
  76   "*Non-nil means that the next newsgroup after the current will be on the same level.
  77 When you type, for instance, `n' after reading the last article in the
  78 current newsgroup, you will go to the next newsgroup.  If this variable
  79 is nil, the next newsgroup will be the next from the group
  80 buffer.
  81 If this variable is non-nil, Gnus will either put you in the
  82 next newsgroup with the same level, or, if no such newsgroup is
  83 available, the next newsgroup with the lowest possible level higher
  84 than the current level.
  85 If this variable is `best', Gnus will make the next newsgroup the one
  86 with the best level."
  87   :group 'gnus-group-levels
  88   :type '(choice (const nil)
  89                  (const best)
  90                  (sexp :tag "other" t)))
  91
  92 (defcustom gnus-group-goto-unread t
  93   "*If non-nil, movement commands will go to the next unread and subscribed group."
  94   :link '(custom-manual "(gnus)Group Maneuvering")
  95   :group 'gnus-group-various
  96   :type 'boolean)
  97
  98 (defcustom gnus-goto-next-group-when-activating t
  99   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group."
 100   :link '(custom-manual "(gnus)Scanning New Messages")
 101   :group 'gnus-group-various
 102   :type 'boolean)
 103
 104 (defcustom gnus-permanently-visible-groups nil
 105   "*Regexp to match groups that should always be listed in the group buffer.
 106 This means that they will still be listed even when there are no
 107 unread articles in the groups.
 108
 109 If nil, no groups are permanently visible."
 110   :group 'gnus-group-listing
 111   :type '(choice regexp (const nil)))
 112
 113 (defcustom gnus-safe-html-newsgroups "\\`nnrss[+:]"
 114   "Groups in which links in html articles are considered all safe.
 115 The value may be a regexp matching those groups, a list of group names,
 116 or nil.  This overrides `mm-w3m-safe-url-regexp' (which see).  This is
 117 effective only when emacs-w3m renders html articles, i.e., in the case
 118 `mm-text-html-renderer' is set to `w3m'."
 119   :version "23.2"
 120   :group 'gnus-group-various
 121   :type '(choice regexp
 122                  (repeat :tag "List of group names" (string :tag "Group"))
 123                  (const nil)))
 124
 125 (defcustom gnus-list-groups-with-ticked-articles t
 126   "*If non-nil, list groups that have only ticked articles.
 127 If nil, only list groups that have unread articles."
 128   :group 'gnus-group-listing
 129   :type 'boolean)
 130
 131 (defcustom gnus-group-default-list-level gnus-level-subscribed
 132   "*Default listing level.
 133 Ignored if `gnus-group-use-permanent-levels' is non-nil."
 134   :group 'gnus-group-listing
 135   :type 'integer)
 136
 137 (defcustom gnus-group-list-inactive-groups t
 138   "*If non-nil, inactive groups will be listed."
 139   :group 'gnus-group-listing
 140   :group 'gnus-group-levels
 141   :type 'boolean)
 142
 143 (defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet
 144   "*Function used for sorting the group buffer.
 145 This function will be called with group info entries as the arguments
 146 for the groups to be sorted.  Pre-made functions include
 147 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
 148 `gnus-group-sort-by-unread', `gnus-group-sort-by-level',
 149 `gnus-group-sort-by-score', `gnus-group-sort-by-method',
 150 `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
 151
 152 This variable can also be a list of sorting functions.  In that case,
 153 the most significant sort function should be the last function in the
 154 list."
 155   :group 'gnus-group-listing
 156   :link '(custom-manual "(gnus)Sorting Groups")
 157   :type '(repeat :value-to-internal (lambda (widget value)
 158                                       (if (listp value) value (list value)))
 159                  :match (lambda (widget value)
 160                           (or (symbolp value)
 161                               (widget-editable-list-match widget value)))
 162                  (choice (function-item gnus-group-sort-by-alphabet)
 163                          (function-item gnus-group-sort-by-real-name)
 164                          (function-item gnus-group-sort-by-unread)
 165                          (function-item gnus-group-sort-by-level)
 166                          (function-item gnus-group-sort-by-score)
 167                          (function-item gnus-group-sort-by-method)
 168                          (function-item gnus-group-sort-by-server)
 169                          (function-item gnus-group-sort-by-rank)
 170                          (function :tag "other" nil))))
 171
 172 (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)\n"
 173   "*Format of group lines.
 174 It works along the same lines as a normal formatting string,
 175 with some simple extensions.
 176
 177 %M    Only marked articles (character, \"*\" or \" \")
 178 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
 179 %L    Level of subscribedness (integer)
 180 %N    Number of unread articles (integer)
 181 %I    Number of dormant articles (integer)
 182 %i    Number of ticked and dormant (integer)
 183 %T    Number of ticked articles (integer)
 184 %R    Number of read articles (integer)
 185 %U    Number of unseen articles (integer)
 186 %t    Estimated total number of articles (integer)
 187 %y    Number of unread, unticked articles (integer)
 188 %G    Group name (string)
 189 %g    Qualified group name (string)
 190 %c    Short (collapsed) group name.  See `gnus-group-uncollapsed-levels'.
 191 %C    Group comment (string)
 192 %D    Group description (string)
 193 %s    Select method (string)
 194 %o    Moderated group (char, \"m\")
 195 %p    Process mark (char)
 196 %B    Whether a summary buffer for the group is open (char, \"*\")
 197 %O    Moderated group (string, \"(m)\" or \"\")
 198 %P    Topic indentation (string)
 199 %m    Whether there is new(ish) mail in the group (char, \"%\")
 200 %n    Select from where (string)
 201 %z    A string that look like `<%s:%n>' if a foreign select method is used
 202 %d    The date the group was last entered.
 203 %E    Icon as defined by `gnus-group-icon-list'.
 204 %F    The disk space used by the articles fetched by both the cache and agent.
 205 %u    User defined specifier.  The next character in the format string should
 206       be a letter.  Gnus will call the function gnus-user-format-function-X,
 207       where X is the letter following %u.  The function will be passed a
 208       single dummy parameter as argument.  The function should return a
 209       string, which will be inserted into the buffer just like information
 210       from any other group specifier.
 211
 212 Note that this format specification is not always respected.  For
 213 reasons of efficiency, when listing killed groups, this specification
 214 is ignored altogether.  If the spec is changed considerably, your
 215 output may end up looking strange when listing both alive and killed
 216 groups.
 217
 218 If you use %o or %O, reading the active file will be slower and quite
 219 a bit of extra memory will be used.  %D and %F will also worsen
 220 performance.  Also note that if you change the format specification to
 221 include any of these specs, you must probably re-start Gnus to see
 222 them go into effect.
 223
 224 General format specifiers can also be used.
 225 See Info node `(gnus)Formatting Variables'."
 226   :link '(custom-manual "(gnus)Formatting Variables")
 227   :group 'gnus-group-visual
 228   :type 'string)
 229
 230 (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
 231   "*The format specification for the group mode line.
 232 It works along the same lines as a normal formatting string,
 233 with some simple extensions:
 234
 235 %S   The native news server.
 236 %M   The native select method.
 237 %:   \":\" if %S isn't \"\"."
 238   :group 'gnus-group-visual
 239   :type 'string)
 240
 241 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 242 (when (featurep 'xemacs)
 243   (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
 244   (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
 245
 246 (defcustom gnus-group-menu-hook nil
 247   "Hook run after the creation of the group mode menu."
 248   :group 'gnus-group-various
 249   :type 'hook)
 250
 251 (defcustom gnus-group-catchup-group-hook nil
 252   "Hook run when catching up a group from the group buffer."
 253   :group 'gnus-group-various
 254   :link '(custom-manual "(gnus)Group Data")
 255   :type 'hook)
 256
 257 (defcustom gnus-group-update-group-hook nil
 258   "Hook called when updating group lines."
 259   :group 'gnus-group-visual
 260   :type 'hook)
 261
 262 (defcustom gnus-group-prepare-function 'gnus-group-prepare-flat
 263   "*A function that is called to generate the group buffer.
 264 The function is called with three arguments: The first is a number;
 265 all group with a level less or equal to that number should be listed,
 266 if the second is non-nil, empty groups should also be displayed.  If
 267 the third is non-nil, it is a number.  No groups with a level lower
 268 than this number should be displayed.
 269
 270 The only current function implemented is `gnus-group-prepare-flat'."
 271   :group 'gnus-group-listing
 272   :type 'function)
 273
 274 (defcustom gnus-group-prepare-hook nil
 275   "Hook called after the group buffer has been generated.
 276 If you want to modify the group buffer, you can use this hook."
 277   :group 'gnus-group-listing
 278   :type 'hook)
 279
 280 (defcustom gnus-suspend-gnus-hook nil
 281   "Hook called when suspending (not exiting) Gnus."
 282   :group 'gnus-exit
 283   :type 'hook)
 284
 285 (defcustom gnus-exit-gnus-hook nil
 286   "Hook called when exiting Gnus."
 287   :group 'gnus-exit
 288   :type 'hook)
 289
 290 (defcustom gnus-after-exiting-gnus-hook nil
 291   "Hook called after exiting Gnus."
 292   :group 'gnus-exit
 293   :type 'hook)
 294
 295 (defcustom gnus-group-update-hook '(gnus-group-highlight-line)
 296   "Hook called when a group line is changed.
 297 The hook will not be called if `gnus-visual' is nil.
 298
 299 The default function `gnus-group-highlight-line' will
 300 highlight the line according to the `gnus-group-highlight'
 301 variable."
 302   :group 'gnus-group-visual
 303   :type 'hook)
 304
 305 (defcustom gnus-useful-groups
 306   '(("(ding) mailing list mirrored at gmane.org"
 307      "gmane.emacs.gnus.general"
 308      (nntp "Gmane"
 309            (nntp-address "news.gmane.org")))
 310     ("Gnus bug archive"
 311      "gnus.gnus-bug"
 312      (nntp "news.gnus.org"
 313            (nntp-address "news.gnus.org")))
 314     ("Local Gnus help group"
 315      "gnus-help"
 316      (nndoc "gnus-help"
 317             (nndoc-article-type mbox)
 318             (eval `(nndoc-address
 319                     ,(let ((file (nnheader-find-etc-directory
 320                                   "gnus-tut.txt" t)))
 321                        (unless file
 322                          (error "Couldn't find doc group"))
 323                        file))))))
 324   "*Alist of useful group-server pairs."
 325   :group 'gnus-group-listing
 326   :type '(repeat (list (string :tag "Description")
 327                        (string :tag "Name")
 328                        (sexp :tag "Method"))))
 329
 330 (defcustom gnus-group-highlight
 331   '(;; Mail.
 332     ((and mailp (= unread 0) (eq level 1)) .
 333      gnus-group-mail-1-empty)
 334     ((and mailp (eq level 1)) .
 335      gnus-group-mail-1)
 336     ((and mailp (= unread 0) (eq level 2)) .
 337      gnus-group-mail-2-empty)
 338     ((and mailp (eq level 2)) .
 339      gnus-group-mail-2)
 340     ((and mailp (= unread 0) (eq level 3)) .
 341      gnus-group-mail-3-empty)
 342     ((and mailp (eq level 3)) .
 343      gnus-group-mail-3)
 344     ((and mailp (= unread 0)) .
 345      gnus-group-mail-low-empty)
 346     ((and mailp) .
 347      gnus-group-mail-low)
 348     ;; News.
 349     ((and (= unread 0) (eq level 1)) .
 350      gnus-group-news-1-empty)
 351     ((and (eq level 1)) .
 352      gnus-group-news-1)
 353     ((and (= unread 0) (eq level 2)) .
 354      gnus-group-news-2-empty)
 355     ((and (eq level 2)) .
 356      gnus-group-news-2)
 357     ((and (= unread 0) (eq level 3)) .
 358      gnus-group-news-3-empty)
 359     ((and (eq level 3)) .
 360      gnus-group-news-3)
 361     ((and (= unread 0) (eq level 4)) .
 362      gnus-group-news-4-empty)
 363     ((and (eq level 4)) .
 364      gnus-group-news-4)
 365     ((and (= unread 0) (eq level 5)) .
 366      gnus-group-news-5-empty)
 367     ((and (eq level 5)) .
 368      gnus-group-news-5)
 369     ((and (= unread 0) (eq level 6)) .
 370      gnus-group-news-6-empty)
 371     ((and (eq level 6)) .
 372      gnus-group-news-6)
 373     ((and (= unread 0)) .
 374      gnus-group-news-low-empty)
 375     (t .
 376      gnus-group-news-low))
 377   "*Controls the highlighting of group buffer lines.
 378
 379 Below is a list of `Form'/`Face' pairs.  When deciding how a a
 380 particular group line should be displayed, each form is
 381 evaluated.  The content of the face field after the first true form is
 382 used.  You can change how those group lines are displayed by
 383 editing the face field.
 384
 385 It is also possible to change and add form fields, but currently that
 386 requires an understanding of Lisp expressions.  Hopefully this will
 387 change in a future release.  For now, you can use the following
 388 variables in the Lisp expression:
 389
 390 group: The name of the group.
 391 unread: The number of unread articles in the group.
 392 method: The select method used.
 393 mailp: Whether it's a mail group or not.
 394 level: The level of the group.
 395 score: The score of the group.
 396 ticked: The number of ticked articles."
 397   :group 'gnus-group-visual
 398   :type '(repeat (cons (sexp :tag "Form") face)))
 399 (put 'gnus-group-highlight 'risky-local-variable t)
 400
 401 (defcustom gnus-new-mail-mark ?%
 402   "Mark used for groups with new mail."
 403   :group 'gnus-group-visual
 404   :type 'character)
 405
 406 (defgroup gnus-group-icons nil
 407   "Add Icons to your group buffer."
 408   :group 'gnus-group-visual)
 409
 410 (defcustom gnus-group-icon-list
 411   nil
 412   "*Controls the insertion of icons into group buffer lines.
 413
 414 Below is a list of `Form'/`File' pairs.  When deciding how a
 415 particular group line should be displayed, each form is evaluated.
 416 The icon from the file field after the first true form is used.  You
 417 can change how those group lines are displayed by editing the file
 418 field.  The File will either be found in the
 419 `gnus-group-glyph-directory' or by designating absolute name of the
 420 file.
 421
 422 It is also possible to change and add form fields, but currently that
 423 requires an understanding of Lisp expressions.  Hopefully this will
 424 change in a future release.  For now, you can use the following
 425 variables in the Lisp expression:
 426
 427 group: The name of the group.
 428 unread: The number of unread articles in the group.
 429 method: The select method used.
 430 mailp: Whether it's a mail group or not.
 431 newsp: Whether it's a news group or not
 432 level: The level of the group.
 433 score: The score of the group.
 434 ticked: The number of ticked articles."
 435   :group 'gnus-group-icons
 436   :type '(repeat (cons (sexp :tag "Form") file)))
 437 (put 'gnus-group-icon-list 'risky-local-variable t)
 438
 439 (defcustom gnus-group-name-charset-method-alist nil
 440   "Alist of method and the charset for group names.
 441
 442 For example:
 443     (((nntp \"news.com.cn\") . cn-gb-2312))"
 444   :version "21.1"
 445   :group 'gnus-charset
 446   :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
 447
 448 (defcustom gnus-group-name-charset-group-alist
 449   (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
 450           (mm-coding-system-p 'utf-8))
 451       '((".*" . utf-8))
 452     nil)
 453   "Alist of group regexp and the charset for group names.
 454
 455 For example:
 456     ((\"\\.com\\.cn:\" . cn-gb-2312))"
 457   :group 'gnus-charset
 458   :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
 459
 460 (defcustom gnus-group-jump-to-group-prompt nil
 461   "Default prompt for `gnus-group-jump-to-group'.
 462
 463 If non-nil, the value should be a string or an alist.  If it is a string,
 464 e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group:
 465 nnml:\" in the minibuffer prompt.
 466
 467 If it is an alist, it must consist of \(NUMBER .  PROMPT\) pairs, for example:
 468 \((1 .  \"\") (2 .  \"nnfolder+archive:\")).  The element with number 0 is
 469 used when no prefix argument is given to `gnus-group-jump-to-group'."
 470   :version "22.1"
 471   :group 'gnus-group-various
 472   :type '(choice (string :tag "Prompt string")
 473                  (const :tag "Empty" nil)
 474                  (repeat (cons (integer :tag "Argument")
 475                                (string :tag "Prompt string")))))
 476
 477 (defvar gnus-group-listing-limit 1000
 478   "*A limit of the number of groups when listing.
 479 If the number of groups is larger than the limit, list them in a
 480 simple manner.")
 481
 482 ;;; Internal variables
 483
 484 (defvar gnus-group-is-exiting-p nil)
 485 (defvar gnus-group-is-exiting-without-update-p nil)
 486 (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
 487   "Function for sorting the group buffer.")
 488
 489 (defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
 490   "Function for sorting the selected groups in the group buffer.")
 491
 492 (defvar gnus-group-indentation-function nil)
 493 (defvar gnus-goto-missing-group-function nil)
 494 (defvar gnus-group-update-group-function nil)
 495 (defvar gnus-group-goto-next-group-function nil
 496   "Function to override finding the next group after listing groups.")
 497
 498 (defvar gnus-group-edit-buffer nil)
 499
 500 (defvar gnus-group-line-format-alist
 501   `((?M gnus-tmp-marked-mark ?c)
 502     (?S gnus-tmp-subscribed ?c)
 503     (?L gnus-tmp-level ?d)
 504     (?N (cond ((eq number t) "*" )
 505               ((numberp number)
 506                (int-to-string
 507                 (+ number
 508                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
 509                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
 510               (t number)) ?s)
 511     (?R gnus-tmp-number-of-read ?s)
 512     (?U (if (gnus-active gnus-tmp-group)
 513             (gnus-number-of-unseen-articles-in-group gnus-tmp-group)
 514           "*")
 515         ?s)
 516     (?t gnus-tmp-number-total ?d)
 517     (?y gnus-tmp-number-of-unread ?s)
 518     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
 519     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
 520     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
 521            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
 522     (?g (if (boundp 'gnus-tmp-decoded-group)
 523             gnus-tmp-decoded-group
 524           gnus-tmp-group)
 525         ?s)
 526     (?G gnus-tmp-qualified-group ?s)
 527     (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
 528                                    gnus-tmp-decoded-group
 529                                  gnus-tmp-group))
 530         ?s)
 531     (?C gnus-tmp-comment ?s)
 532     (?D gnus-tmp-newsgroup-description ?s)
 533     (?o gnus-tmp-moderated ?c)
 534     (?O gnus-tmp-moderated-string ?s)
 535     (?p gnus-tmp-process-marked ?c)
 536     (?s gnus-tmp-news-server ?s)
 537     (?n ,(if (featurep 'xemacs)
 538              '(symbol-name gnus-tmp-news-method)
 539            'gnus-tmp-news-method)
 540         ?s)
 541     (?P gnus-group-indentation ?s)
 542     (?E gnus-tmp-group-icon ?s)
 543     (?B gnus-tmp-summary-live ?c)
 544     (?z gnus-tmp-news-method-string ?s)
 545     (?m (gnus-group-new-mail gnus-tmp-group) ?c)
 546     (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
 547     (?u gnus-tmp-user-defined ?s)
 548     (?F (gnus-total-fetched-for gnus-tmp-group) ?s)
 549     ))
 550
 551 (defvar gnus-group-mode-line-format-alist
 552   `((?S gnus-tmp-news-server ?s)
 553     (?M gnus-tmp-news-method ?s)
 554     (?u gnus-tmp-user-defined ?s)
 555     (?: gnus-tmp-colon ?s)))
 556
 557 (defvar gnus-topic-topology nil
 558   "The complete topic hierarchy.")
 559
 560 (defvar gnus-topic-alist nil
 561   "The complete topic-group alist.")
 562
 563 (defvar gnus-group-marked nil)
 564
 565 (defvar gnus-group-list-mode nil)
 566
 567
 568 (defvar gnus-group-icon-cache nil)
 569
 570 (defvar gnus-group-listed-groups nil)
 571 (defvar gnus-group-list-option nil)
 572
 573 ;;;
 574 ;;; Gnus group mode
 575 ;;;
 576
 577 (put 'gnus-group-mode 'mode-class 'special)
 578
 579 (gnus-define-keys gnus-group-mode-map
 580   " " gnus-group-read-group
 581   "=" gnus-group-select-group
 582   "\r" gnus-group-select-group
 583   "\M-\r" gnus-group-quick-select-group
 584   "\M- " gnus-group-visible-select-group
 585   [(meta control return)] gnus-group-select-group-ephemerally
 586   "j" gnus-group-jump-to-group
 587   "n" gnus-group-next-unread-group
 588   "p" gnus-group-prev-unread-group
 589   "\177" gnus-group-prev-unread-group
 590   [delete] gnus-group-prev-unread-group
 591   [backspace] gnus-group-prev-unread-group
 592   "N" gnus-group-next-group
 593   "P" gnus-group-prev-group
 594   "\M-n" gnus-group-next-unread-group-same-level
 595   "\M-p" gnus-group-prev-unread-group-same-level
 596   "," gnus-group-best-unread-group
 597   "." gnus-group-first-unread-group
 598   "u" gnus-group-unsubscribe-current-group
 599   "U" gnus-group-unsubscribe-group
 600   "c" gnus-group-catchup-current
 601   "C" gnus-group-catchup-current-all
 602   "\M-c" gnus-group-clear-data
 603   "l" gnus-group-list-groups
 604   "L" gnus-group-list-all-groups
 605   "m" gnus-group-mail
 606   "i" gnus-group-news
 607   "g" gnus-group-get-new-news
 608   "\M-g" gnus-group-get-new-news-this-group
 609   "R" gnus-group-restart
 610   "r" gnus-group-read-init-file
 611   "B" gnus-group-browse-foreign-server
 612   "b" gnus-group-check-bogus-groups
 613   "F" gnus-group-find-new-groups
 614   "\C-c\C-d" gnus-group-describe-group
 615   "\M-d" gnus-group-describe-all-groups
 616   "\C-c\C-a" gnus-group-apropos
 617   "\C-c\M-\C-a" gnus-group-description-apropos
 618   "a" gnus-group-post-news
 619   "\ek" gnus-group-edit-local-kill
 620   "\eK" gnus-group-edit-global-kill
 621   "\C-k" gnus-group-kill-group
 622   "\C-y" gnus-group-yank-group
 623   "\C-w" gnus-group-kill-region
 624   "\C-x\C-t" gnus-group-transpose-groups
 625   "\C-c\C-l" gnus-group-list-killed
 626   "\C-c\C-x" gnus-group-expire-articles
 627   "\C-c\M-\C-x" gnus-group-expire-all-groups
 628   "V" gnus-version
 629   "s" gnus-group-save-newsrc
 630   "z" gnus-group-suspend
 631   "q" gnus-group-exit
 632   "Q" gnus-group-quit
 633   "?" gnus-group-describe-briefly
 634   "\C-c\C-i" gnus-info-find-node
 635   "\M-e" gnus-group-edit-group-method
 636   "^" gnus-group-enter-server-mode
 637   gnus-mouse-2 gnus-mouse-pick-group
 638   [follow-link] mouse-face
 639   "<" beginning-of-buffer
 640   ">" end-of-buffer
 641   "\C-c\C-b" gnus-bug
 642   "\C-c\C-s" gnus-group-sort-groups
 643   "t" gnus-topic-mode
 644   "\C-c\M-g" gnus-activate-all-groups
 645   "\M-&" gnus-group-universal-argument
 646   "#" gnus-group-mark-group
 647   "\M-#" gnus-group-unmark-group)
 648
 649 (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
 650   "m" gnus-group-mark-group
 651   "u" gnus-group-unmark-group
 652   "w" gnus-group-mark-region
 653   "b" gnus-group-mark-buffer
 654   "r" gnus-group-mark-regexp
 655   "U" gnus-group-unmark-all-groups)
 656
 657 (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
 658   "u" gnus-sieve-update
 659   "g" gnus-sieve-generate)
 660
 661 (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
 662   "d" gnus-group-make-directory-group
 663   "h" gnus-group-make-help-group
 664   "u" gnus-group-make-useful-group
 665   "a" gnus-group-make-archive-group
 666   "l" gnus-group-nnimap-edit-acl
 667   "m" gnus-group-make-group
 668   "E" gnus-group-edit-group
 669   "e" gnus-group-edit-group-method
 670   "p" gnus-group-edit-group-parameters
 671   "v" gnus-group-add-to-virtual
 672   "V" gnus-group-make-empty-virtual
 673   "D" gnus-group-enter-directory
 674   "f" gnus-group-make-doc-group
 675   "w" gnus-group-make-web-group
 676   "M" gnus-group-read-ephemeral-group
 677   "r" gnus-group-rename-group
 678   "R" gnus-group-make-rss-group
 679   "c" gnus-group-customize
 680   "z" gnus-group-compact-group
 681   "x" gnus-group-expunge-group
 682   "\177" gnus-group-delete-group
 683   [delete] gnus-group-delete-group)
 684
 685 (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
 686   "s" gnus-group-sort-groups
 687   "a" gnus-group-sort-groups-by-alphabet
 688   "u" gnus-group-sort-groups-by-unread
 689   "l" gnus-group-sort-groups-by-level
 690   "v" gnus-group-sort-groups-by-score
 691   "r" gnus-group-sort-groups-by-rank
 692   "m" gnus-group-sort-groups-by-method
 693   "n" gnus-group-sort-groups-by-real-name)
 694
 695 (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
 696   "s" gnus-group-sort-selected-groups
 697   "a" gnus-group-sort-selected-groups-by-alphabet
 698   "u" gnus-group-sort-selected-groups-by-unread
 699   "l" gnus-group-sort-selected-groups-by-level
 700   "v" gnus-group-sort-selected-groups-by-score
 701   "r" gnus-group-sort-selected-groups-by-rank
 702   "m" gnus-group-sort-selected-groups-by-method
 703   "n" gnus-group-sort-selected-groups-by-real-name)
 704
 705 (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
 706   "k" gnus-group-list-killed
 707   "z" gnus-group-list-zombies
 708   "s" gnus-group-list-groups
 709   "u" gnus-group-list-all-groups
 710   "A" gnus-group-list-active
 711   "a" gnus-group-apropos
 712   "d" gnus-group-description-apropos
 713   "m" gnus-group-list-matching
 714   "M" gnus-group-list-all-matching
 715   "l" gnus-group-list-level
 716   "c" gnus-group-list-cached
 717   "?" gnus-group-list-dormant)
 718
 719 (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
 720   "k"  gnus-group-list-limit
 721   "z"  gnus-group-list-limit
 722   "s"  gnus-group-list-limit
 723   "u"  gnus-group-list-limit
 724   "A"  gnus-group-list-limit
 725   "m"  gnus-group-list-limit
 726   "M"  gnus-group-list-limit
 727   "l"  gnus-group-list-limit
 728   "c"  gnus-group-list-limit
 729   "?"  gnus-group-list-limit)
 730
 731 (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
 732   "k"  gnus-group-list-flush
 733   "z"  gnus-group-list-flush
 734   "s"  gnus-group-list-flush
 735   "u"  gnus-group-list-flush
 736   "A"  gnus-group-list-flush
 737   "m"  gnus-group-list-flush
 738   "M"  gnus-group-list-flush
 739   "l"  gnus-group-list-flush
 740   "c"  gnus-group-list-flush
 741   "?"  gnus-group-list-flush)
 742
 743 (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
 744   "k"  gnus-group-list-plus
 745   "z"  gnus-group-list-plus
 746   "s"  gnus-group-list-plus
 747   "u"  gnus-group-list-plus
 748   "A"  gnus-group-list-plus
 749   "m"  gnus-group-list-plus
 750   "M"  gnus-group-list-plus
 751   "l"  gnus-group-list-plus
 752   "c"  gnus-group-list-plus
 753   "?"  gnus-group-list-plus)
 754
 755 (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
 756   "f" gnus-score-flush-cache
 757   "e" gnus-score-edit-all-score)
 758
 759 (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
 760   "c" gnus-group-fetch-charter
 761   "C" gnus-group-fetch-control
 762   "d" gnus-group-describe-group
 763   "f" gnus-group-fetch-faq
 764   "v" gnus-version)
 765
 766 (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
 767   "l" gnus-group-set-current-level
 768   "t" gnus-group-unsubscribe-current-group
 769   "s" gnus-group-unsubscribe-group
 770   "k" gnus-group-kill-group
 771   "y" gnus-group-yank-group
 772   "w" gnus-group-kill-region
 773   "\C-k" gnus-group-kill-level
 774   "z" gnus-group-kill-all-zombies)
 775
 776 (defun gnus-topic-mode-p ()
 777   "Return non-nil in `gnus-topic-mode'."
 778   (and (boundp 'gnus-topic-mode)
 779        (symbol-value 'gnus-topic-mode)))
 780
 781 (defun gnus-group-make-menu-bar ()
 782   (gnus-turn-off-edit-menu 'group)
 783   (unless (boundp 'gnus-group-reading-menu)
 784
 785     (easy-menu-define
 786      gnus-group-reading-menu gnus-group-mode-map ""
 787      `("Group"
 788        ["Read" gnus-group-read-group
 789         :included (not (gnus-topic-mode-p))
 790         :active (gnus-group-group-name)]
 791        ["Read " gnus-topic-read-group
 792         :included (gnus-topic-mode-p)]
 793        ["Select" gnus-group-select-group
 794         :included (not (gnus-topic-mode-p))
 795         :active (gnus-group-group-name)]
 796        ["Select " gnus-topic-select-group
 797         :included (gnus-topic-mode-p)]
 798        ["See old articles" (gnus-group-select-group 'all)
 799         :keys "C-u SPC" :active (gnus-group-group-name)]
 800        ["Catch up" gnus-group-catchup-current
 801         :included (not (gnus-topic-mode-p))
 802         :active (gnus-group-group-name)
 803         ,@(if (featurep 'xemacs) nil
 804             '(:help "Mark unread articles in the current group as read"))]
 805        ["Catch up " gnus-topic-catchup-articles
 806         :included (gnus-topic-mode-p)
 807         ,@(if (featurep 'xemacs) nil
 808             '(:help "Mark unread articles in the current group or topic as read"))]
 809        ["Catch up all articles" gnus-group-catchup-current-all
 810         (gnus-group-group-name)]
 811        ["Check for new articles" gnus-group-get-new-news-this-group
 812         :included (not (gnus-topic-mode-p))
 813         :active (gnus-group-group-name)
 814         ,@(if (featurep 'xemacs) nil
 815             '(:help "Check for new messages in current group"))]
 816        ["Check for new articles " gnus-topic-get-new-news-this-topic
 817         :included (gnus-topic-mode-p)
 818         ,@(if (featurep 'xemacs) nil
 819             '(:help "Check for new messages in current group or topic"))]
 820        ["Toggle subscription" gnus-group-unsubscribe-current-group
 821         (gnus-group-group-name)]
 822        ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
 823         ,@(if (featurep 'xemacs) nil
 824               '(:help "Kill (remove) current group"))]
 825        ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
 826        ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
 827         ,@(if (featurep 'xemacs) nil
 828             '(:help "Display description of the current group"))]
 829        ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
 830        ["Fetch charter" gnus-group-fetch-charter
 831         :active (gnus-group-group-name)
 832         ,@(if (featurep 'xemacs) nil
 833             '(:help "Display the charter of the current group"))]
 834        ["Fetch control message" gnus-group-fetch-control
 835         :active (gnus-group-group-name)
 836         ,@(if (featurep 'xemacs) nil
 837             '(:help "Display the archived control message for the current group"))]
 838        ;; Actually one should check, if any of the marked groups gives t for
 839        ;; (gnus-check-backend-function 'request-expire-articles ...)
 840        ["Expire articles" gnus-group-expire-articles
 841         :included (not (gnus-topic-mode-p))
 842         :active (or (and (gnus-group-group-name)
 843                          (gnus-check-backend-function
 844                           'request-expire-articles
 845                           (gnus-group-group-name))) gnus-group-marked)]
 846        ["Expire articles " gnus-topic-expire-articles
 847         :included (gnus-topic-mode-p)]
 848        ["Set group level..." gnus-group-set-current-level
 849         (gnus-group-group-name)]
 850        ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
 851        ["Customize" gnus-group-customize (gnus-group-group-name)]
 852        ["Compact" gnus-group-compact-group
 853         :active (gnus-group-group-name)]
 854        ("Edit"
 855         ["Parameters" gnus-group-edit-group-parameters
 856          :included (not (gnus-topic-mode-p))
 857          :active (gnus-group-group-name)]
 858         ["Parameters " gnus-topic-edit-parameters
 859          :included (gnus-topic-mode-p)]
 860         ["Select method" gnus-group-edit-group-method
 861          (gnus-group-group-name)]
 862         ["Info" gnus-group-edit-group (gnus-group-group-name)]
 863         ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
 864         ["Global kill file" gnus-group-edit-global-kill t])))
 865
 866     (easy-menu-define
 867      gnus-group-group-menu gnus-group-mode-map ""
 868      '("Groups"
 869        ("Listing"
 870         ["List unread subscribed groups" gnus-group-list-groups t]
 871         ["List (un)subscribed groups" gnus-group-list-all-groups t]
 872         ["List killed groups" gnus-group-list-killed gnus-killed-list]
 873         ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
 874         ["List level..." gnus-group-list-level t]
 875         ["Describe all groups" gnus-group-describe-all-groups t]
 876         ["Group apropos..." gnus-group-apropos t]
 877         ["Group and description apropos..." gnus-group-description-apropos t]
 878         ["List groups matching..." gnus-group-list-matching t]
 879         ["List all groups matching..." gnus-group-list-all-matching t]
 880         ["List active file" gnus-group-list-active t]
 881         ["List groups with cached" gnus-group-list-cached t]
 882         ["List groups with dormant" gnus-group-list-dormant t])
 883        ("Sort"
 884         ["Default sort" gnus-group-sort-groups t]
 885         ["Sort by method" gnus-group-sort-groups-by-method t]
 886         ["Sort by rank" gnus-group-sort-groups-by-rank t]
 887         ["Sort by score" gnus-group-sort-groups-by-score t]
 888         ["Sort by level" gnus-group-sort-groups-by-level t]
 889         ["Sort by unread" gnus-group-sort-groups-by-unread t]
 890         ["Sort by name" gnus-group-sort-groups-by-alphabet t]
 891         ["Sort by real name" gnus-group-sort-groups-by-real-name t])
 892        ("Sort process/prefixed"
 893         ["Default sort" gnus-group-sort-selected-groups
 894          (not (gnus-topic-mode-p))]
 895         ["Sort by method" gnus-group-sort-selected-groups-by-method
 896          (not (gnus-topic-mode-p))]
 897         ["Sort by rank" gnus-group-sort-selected-groups-by-rank
 898          (not (gnus-topic-mode-p))]
 899         ["Sort by score" gnus-group-sort-selected-groups-by-score
 900          (not (gnus-topic-mode-p))]
 901         ["Sort by level" gnus-group-sort-selected-groups-by-level
 902          (not (gnus-topic-mode-p))]
 903         ["Sort by unread" gnus-group-sort-selected-groups-by-unread
 904          (not (gnus-topic-mode-p))]
 905         ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
 906          (not (gnus-topic-mode-p))]
 907         ["Sort by real name" gnus-group-sort-selected-groups-by-real-name
 908          (not (gnus-topic-mode-p))])
 909        ("Mark"
 910         ["Mark group" gnus-group-mark-group
 911          (and (gnus-group-group-name)
 912               (not (memq (gnus-group-group-name) gnus-group-marked)))]
 913         ["Unmark group" gnus-group-unmark-group
 914          (and (gnus-group-group-name)
 915               (memq (gnus-group-group-name) gnus-group-marked))]
 916         ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
 917         ["Mark regexp..." gnus-group-mark-regexp t]
 918         ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
 919         ["Mark buffer" gnus-group-mark-buffer t]
 920         ["Execute command" gnus-group-universal-argument
 921          (or gnus-group-marked (gnus-group-group-name))])
 922        ("Subscribe"
 923         ["Subscribe to a group..." gnus-group-unsubscribe-group t]
 924         ["Kill all newsgroups in region" gnus-group-kill-region
 925          :active (gnus-mark-active-p)]
 926         ["Kill all zombie groups" gnus-group-kill-all-zombies
 927          gnus-zombie-list]
 928         ["Kill all groups on level..." gnus-group-kill-level t])
 929        ("Foreign groups"
 930         ["Make a foreign group..." gnus-group-make-group t]
 931         ["Add a directory group..." gnus-group-make-directory-group t]
 932         ["Add the help group" gnus-group-make-help-group t]
 933         ["Add the archive group" gnus-group-make-archive-group t]
 934         ["Make a doc group..." gnus-group-make-doc-group t]
 935         ["Make a web group..." gnus-group-make-web-group t]
 936         ["Make a virtual group..." gnus-group-make-empty-virtual t]
 937         ["Add a group to a virtual..." gnus-group-add-to-virtual t]
 938         ["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
 939         ["Make an RSS group..." gnus-group-make-rss-group t]
 940         ["Rename group..." gnus-group-rename-group
 941          (gnus-check-backend-function
 942           'request-rename-group (gnus-group-group-name))]
 943         ["Delete group" gnus-group-delete-group
 944          (gnus-check-backend-function
 945           'request-delete-group (gnus-group-group-name))])
 946        ("Move"
 947         ["Next" gnus-group-next-group t]
 948         ["Previous" gnus-group-prev-group t]
 949         ["Next unread" gnus-group-next-unread-group t]
 950         ["Previous unread" gnus-group-prev-unread-group t]
 951         ["Next unread same level" gnus-group-next-unread-group-same-level t]
 952         ["Previous unread same level"
 953          gnus-group-prev-unread-group-same-level t]
 954         ["Jump to group..." gnus-group-jump-to-group t]
 955         ["First unread group" gnus-group-first-unread-group t]
 956         ["Best unread group" gnus-group-best-unread-group t])
 957        ("Sieve"
 958         ["Generate" gnus-sieve-generate t]
 959         ["Generate and update" gnus-sieve-update t])
 960        ["Delete bogus groups" gnus-group-check-bogus-groups t]
 961        ["Find new newsgroups" gnus-group-find-new-groups t]
 962        ["Transpose" gnus-group-transpose-groups
 963         (gnus-group-group-name)]
 964        ["Read a directory as a group..." gnus-group-enter-directory t]))
 965
 966     (easy-menu-define
 967      gnus-group-misc-menu gnus-group-mode-map ""
 968      `("Gnus"
 969        ["Send a mail" gnus-group-mail t]
 970        ["Send a message (mail or news)" gnus-group-post-news t]
 971        ["Create a local message" gnus-group-news t]
 972        ["Check for new news" gnus-group-get-new-news
 973         ,@(if (featurep 'xemacs) '(t)
 974             '(:help "Get newly arrived articles"))
 975         ]
 976        ["Send queued messages" gnus-delay-send-queue
 977         ,@(if (featurep 'xemacs) '(t)
 978             '(:help "Send all messages that are scheduled to be sent now"))
 979         ]
 980        ["Activate all groups" gnus-activate-all-groups t]
 981        ["Restart Gnus" gnus-group-restart t]
 982        ["Read init file" gnus-group-read-init-file t]
 983        ["Browse foreign server..." gnus-group-browse-foreign-server t]
 984        ["Enter server buffer" gnus-group-enter-server-mode t]
 985        ["Expire all expirable articles" gnus-group-expire-all-groups t]
 986        ["Gnus version" gnus-version t]
 987        ["Save .newsrc files" gnus-group-save-newsrc t]
 988        ["Suspend Gnus" gnus-group-suspend t]
 989        ["Clear dribble buffer" gnus-group-clear-dribble t]
 990        ["Read manual" gnus-info-find-node t]
 991        ["Flush score cache" gnus-score-flush-cache t]
 992        ["Toggle topics" gnus-topic-mode t]
 993        ["Send a bug report" gnus-bug t]
 994        ["Exit from Gnus" gnus-group-exit
 995         ,@(if (featurep 'xemacs) '(t)
 996             '(:help "Quit reading news"))]
 997        ["Exit without saving" gnus-group-quit t]))
 998
 999     (gnus-run-hooks 'gnus-group-menu-hook)))
1000
1001
1002 (defvar gnus-group-tool-bar-map nil)
1003
1004 (defun gnus-group-tool-bar-update (&optional symbol value)
1005   "Update group buffer toolbar.
1006 Setter function for custom variables."
1007   (when symbol
1008     (set-default symbol value))
1009   ;; (setq-default gnus-group-tool-bar-map nil)
1010   ;; (use-local-map gnus-group-mode-map)
1011   (when (gnus-alive-p)
1012     (with-current-buffer gnus-group-buffer
1013       (gnus-group-make-tool-bar t))))
1014
1015 (defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
1016                                    'gnus-group-tool-bar-gnome
1017                                  'gnus-group-tool-bar-retro)
1018   "Specifies the Gnus group tool bar.
1019
1020 It can be either a list or a symbol refering to a list.  See
1021 `gmm-tool-bar-from-list' for the format of the list.  The
1022 default key map is `gnus-group-mode-map'.
1023
1024 Pre-defined symbols include `gnus-group-tool-bar-gnome' and
1025 `gnus-group-tool-bar-retro'."
1026   :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
1027                  (const :tag "Retro look" gnus-group-tool-bar-retro)
1028                  (repeat :tag "User defined list" gmm-tool-bar-item)
1029                  (symbol))
1030   :version "23.1" ;; No Gnus
1031   :initialize 'custom-initialize-default
1032   :set 'gnus-group-tool-bar-update
1033   :group 'gnus-group)
1034
1035 (defcustom gnus-group-tool-bar-gnome
1036   '((gnus-group-post-news "mail/compose")
1037     ;; Some useful agent icons?  I don't use the agent so agent users should
1038     ;; suggest useful commands:
1039     (gnus-agent-toggle-plugged "disconnect" t
1040                                :help "Gnus is currently unplugged.  Click to work online."
1041                                :visible (and gnus-agent (not gnus-plugged)))
1042     (gnus-agent-toggle-plugged "connect" t
1043                                :help "Gnus is currently plugged.  Click to work offline."
1044                                :visible (and gnus-agent gnus-plugged))
1045     ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
1046     ;; should have a better help text.
1047     (gnus-group-send-queue "mail/outbox" t
1048                            :visible (and gnus-agent gnus-plugged)
1049                            :help "Send articles from the queue group")
1050     (gnus-group-get-new-news "mail/inbox" nil
1051                              :visible (or (not gnus-agent)
1052                                           gnus-plugged))
1053     ;; FIXME: gnus-*-read-group should have a better help text.
1054     (gnus-topic-read-group "open" nil
1055                            :visible (and (boundp 'gnus-topic-mode)
1056                                          gnus-topic-mode))
1057     (gnus-group-read-group "open" nil
1058                            :visible (not (and (boundp 'gnus-topic-mode)
1059                                               gnus-topic-mode)))
1060     ;; (gnus-group-find-new-groups "???" nil)
1061     (gnus-group-save-newsrc "save")
1062     (gnus-group-describe-group "describe")
1063     (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
1064     (gnus-group-prev-unread-group "left-arrow")
1065     (gnus-group-next-unread-group "right-arrow")
1066     (gnus-group-exit "exit")
1067     (gmm-customize-mode "preferences" t :help "Edit mode preferences")
1068     (gnus-info-find-node "help"))
1069   "List of functions for the group tool bar (GNOME style).
1070
1071 See `gmm-tool-bar-from-list' for the format of the list."
1072   :type '(repeat gmm-tool-bar-item)
1073   :version "23.1" ;; No Gnus
1074   :initialize 'custom-initialize-default
1075   :set 'gnus-group-tool-bar-update
1076   :group 'gnus-group)
1077
1078 (defcustom gnus-group-tool-bar-retro
1079   '((gnus-group-get-new-news "gnus/get-news")
1080     (gnus-group-get-new-news-this-group "gnus/gnntg")
1081     (gnus-group-catchup-current "gnus/catchup")
1082     (gnus-group-describe-group "gnus/describe-group")
1083     (gnus-group-subscribe "gnus/subscribe" t
1084                           :help "Subscribe to the current group")
1085     (gnus-group-unsubscribe "gnus/unsubscribe" t
1086                             :help "Unsubscribe from the current group")
1087     (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
1088   "List of functions for the group tool bar (retro look).
1089
1090 See `gmm-tool-bar-from-list' for the format of the list."
1091   :type '(repeat gmm-tool-bar-item)
1092   :version "23.1" ;; No Gnus
1093   :initialize 'custom-initialize-default
1094   :set 'gnus-group-tool-bar-update
1095   :group 'gnus-group)
1096
1097 (defcustom gnus-group-tool-bar-zap-list t
1098   "List of icon items from the global tool bar.
1099 These items are not displayed in the Gnus group mode tool bar.
1100
1101 See `gmm-tool-bar-from-list' for the format of the list."
1102   :type 'gmm-tool-bar-zap-list
1103   :version "23.1" ;; No Gnus
1104   :initialize 'custom-initialize-default
1105   :set 'gnus-group-tool-bar-update
1106   :group 'gnus-group)
1107
1108 (defvar image-load-path)
1109 (defvar tool-bar-map)
1110
1111 (defun gnus-group-make-tool-bar (&optional force)
1112   "Make a group mode tool bar from `gnus-group-tool-bar'.
1113 When FORCE, rebuild the tool bar."
1114   (when (and (not (featurep 'xemacs))
1115              (boundp 'tool-bar-mode)
1116              tool-bar-mode
1117              ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode).
1118              ;; Why?  --rsteib
1119              (or (not gnus-group-tool-bar-map) force))
1120     (let* ((load-path
1121             (gmm-image-load-path-for-library "gnus"
1122                                              "gnus/toggle-subscription.xpm"
1123                                              nil t))
1124            (image-load-path (cons (car load-path)
1125                                   (when (boundp 'image-load-path)
1126                                     image-load-path)))
1127            (map (gmm-tool-bar-from-list gnus-group-tool-bar
1128                                         gnus-group-tool-bar-zap-list
1129                                         'gnus-group-mode-map)))
1130       (if map
1131           (set (make-local-variable 'tool-bar-map) map))))
1132   gnus-group-tool-bar-map)
1133
1134 (defun gnus-group-mode ()
1135   "Major mode for reading news.
1136
1137 All normal editing commands are switched off.
1138 \\<gnus-group-mode-map>
1139 The group buffer lists (some of) the groups available.  For instance,
1140 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
1141 lists all zombie groups.
1142
1143 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
1144 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
1145
1146 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
1147
1148 The following commands are available:
1149
1150 \\{gnus-group-mode-map}"
1151   (interactive)
1152   (kill-all-local-variables)
1153   (when (gnus-visual-p 'group-menu 'menu)
1154     (gnus-group-make-menu-bar)
1155     (gnus-group-make-tool-bar))
1156   (gnus-simplify-mode-line)
1157   (setq major-mode 'gnus-group-mode)
1158   (setq mode-name "Group")
1159   (gnus-group-set-mode-line)
1160   (setq mode-line-process nil)
1161   (use-local-map gnus-group-mode-map)
1162   (buffer-disable-undo)
1163   (setq truncate-lines t)
1164   (setq buffer-read-only t
1165         show-trailing-whitespace nil)
1166   (gnus-set-default-directory)
1167   (gnus-update-format-specifications nil 'group 'group-mode)
1168   (gnus-update-group-mark-positions)
1169   (when gnus-use-undo
1170     (gnus-undo-mode 1))
1171   (when gnus-slave
1172     (gnus-slave-mode))
1173   (gnus-run-mode-hooks 'gnus-group-mode-hook))
1174
1175 (defun gnus-update-group-mark-positions ()
1176   (save-excursion
1177     (let ((gnus-process-mark ?\200)
1178           (gnus-group-update-hook nil)
1179           (gnus-group-marked '("dummy.group"))
1180           (gnus-active-hashtb (make-vector 10 0))
1181           (topic ""))
1182       (gnus-set-active "dummy.group" '(0 . 0))
1183       (gnus-set-work-buffer)
1184       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
1185       (goto-char (point-min))
1186       (setq gnus-group-mark-positions
1187             (list (cons 'process (and (search-forward
1188                                        (mm-string-to-multibyte "\200") nil t)
1189                                       (- (point) (point-min) 1))))))))
1190
1191 (defun gnus-mouse-pick-group (e)
1192   "Enter the group under the mouse pointer."
1193   (interactive "e")
1194   (mouse-set-point e)
1195   (gnus-group-read-group nil))
1196
1197 ;; Look at LEVEL and find out what the level is really supposed to be.
1198 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
1199 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
1200 (defun gnus-group-default-level (&optional level number-or-nil)
1201   (cond
1202    (gnus-group-use-permanent-levels
1203     (or (setq gnus-group-use-permanent-levels
1204               (or level (if (numberp gnus-group-use-permanent-levels)
1205                             gnus-group-use-permanent-levels
1206                           (or gnus-group-default-list-level
1207                               gnus-level-subscribed))))
1208         gnus-group-default-list-level gnus-level-subscribed))
1209    (number-or-nil
1210     level)
1211    (t
1212     (or level gnus-group-default-list-level gnus-level-subscribed))))
1213
1214 (defun gnus-group-setup-buffer ()
1215   (set-buffer (gnus-get-buffer-create gnus-group-buffer))
1216   (unless (eq major-mode 'gnus-group-mode)
1217     (gnus-group-mode)
1218     (when gnus-carpal
1219       (gnus-carpal-setup-buffer 'group))))
1220
1221 (defun gnus-group-name-charset (method group)
1222   (if (null method)
1223       (setq method (gnus-find-method-for-group group)))
1224   (let ((item (or (assoc method gnus-group-name-charset-method-alist)
1225                   (and (consp method)
1226                        (assoc (list (car method) (cadr method))
1227                               gnus-group-name-charset-method-alist))))
1228         (alist gnus-group-name-charset-group-alist)
1229         result)
1230     (if item
1231         (cdr item)
1232       (while (setq item (pop alist))
1233         (if (string-match (car item) group)
1234             (setq alist nil
1235                   result (cdr item))))
1236       result)))
1237
1238 (defun gnus-group-name-decode (string charset)
1239   ;; Fixme: Don't decode in unibyte mode.
1240   (if (and string charset (featurep 'mule))
1241       (mm-decode-coding-string string charset)
1242     string))
1243
1244 (defun gnus-group-decoded-name (string)
1245   (let ((charset (gnus-group-name-charset nil string)))
1246     (gnus-group-name-decode string charset)))
1247
1248 (defun gnus-group-list-groups (&optional level unread lowest)
1249   "List newsgroups with level LEVEL or lower that have unread articles.
1250 Default is all subscribed groups.
1251 If argument UNREAD is non-nil, groups with no unread articles are also
1252 listed.
1253
1254 Also see the `gnus-group-use-permanent-levels' variable."
1255   (interactive
1256    (list (if current-prefix-arg
1257              (prefix-numeric-value current-prefix-arg)
1258            (or
1259             (gnus-group-default-level nil t)
1260             gnus-group-default-list-level
1261             gnus-level-subscribed))))
1262   (unless level
1263     (setq level (car gnus-group-list-mode)
1264           unread (cdr gnus-group-list-mode)))
1265   (setq level (gnus-group-default-level level))
1266   (gnus-group-setup-buffer)
1267   (gnus-update-format-specifications nil 'group 'group-mode)
1268   (let ((case-fold-search nil)
1269         (props (text-properties-at (point-at-bol)))
1270         (empty (= (point-min) (point-max)))
1271         (group (gnus-group-group-name))
1272         number)
1273     (set-buffer gnus-group-buffer)
1274     (setq number (funcall gnus-group-prepare-function level unread lowest))
1275     (when (or (and (numberp number)
1276                    (zerop number))
1277               (zerop (buffer-size)))
1278       ;; No groups in the buffer.
1279       (gnus-message 5 "%s" gnus-no-groups-message))
1280     ;; We have some groups displayed.
1281     (goto-char (point-max))
1282     (when (or (not gnus-group-goto-next-group-function)
1283               (not (funcall gnus-group-goto-next-group-function
1284                             group props)))
1285       (cond
1286        (empty
1287         (goto-char (point-min)))
1288        ((not group)
1289         ;; Go to the first group with unread articles.
1290         (gnus-group-search-forward t))
1291        (t
1292         ;; Find the right group to put point on.  If the current group
1293         ;; has disappeared in the new listing, try to find the next
1294         ;; one.  If no next one can be found, just leave point at the
1295         ;; first newsgroup in the buffer.
1296         (when (not (gnus-goto-char
1297                     (text-property-any
1298                      (point-min) (point-max)
1299                      'gnus-group (gnus-intern-safe
1300                                   group gnus-active-hashtb))))
1301           (let ((newsrc (cdddr (gnus-group-entry group))))
1302             (while (and newsrc
1303                         (not (gnus-goto-char
1304                               (text-property-any
1305                                (point-min) (point-max) 'gnus-group
1306                                (gnus-intern-safe
1307                                 (caar newsrc) gnus-active-hashtb)))))
1308               (setq newsrc (cdr newsrc)))
1309             (unless newsrc
1310               (goto-char (point-max))
1311               (forward-line -1)))))))
1312     ;; Adjust cursor point.
1313     (gnus-group-position-point)))
1314
1315 (defun gnus-group-list-level (level &optional all)
1316   "List groups on LEVEL.
1317 If ALL (the prefix), also list groups that have no unread articles."
1318   (interactive "nList groups on level: \nP")
1319   (gnus-group-list-groups level all level))
1320
1321 (defun gnus-group-prepare-logic (group test)
1322   (or (and gnus-group-listed-groups
1323            (null gnus-group-list-option)
1324            (member group gnus-group-listed-groups))
1325       (cond
1326        ((null gnus-group-listed-groups) test)
1327        ((null gnus-group-list-option) test)
1328        (t (and (member group gnus-group-listed-groups)
1329                (if (eq gnus-group-list-option 'flush)
1330                    (not test)
1331                  test))))))
1332
1333 (defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
1334   "List all newsgroups with unread articles of level LEVEL or lower.
1335 If PREDICATE is a function, list groups that the function returns non-nil;
1336 if it is t, list groups that have no unread articles.
1337 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
1338 If REGEXP is a function, list dead groups that the function returns non-nil;
1339 if it is a string, only list groups matching REGEXP."
1340   (set-buffer gnus-group-buffer)
1341   (let ((buffer-read-only nil)
1342         (newsrc (cdr gnus-newsrc-alist))
1343         (lowest (or lowest 1))
1344         (not-in-list (and gnus-group-listed-groups
1345                           (copy-sequence gnus-group-listed-groups)))
1346         info clevel unread group params)
1347     (erase-buffer)
1348     (when (or (< lowest gnus-level-zombie)
1349               gnus-group-listed-groups)
1350       ;; List living groups.
1351       (while newsrc
1352         (setq info (car newsrc)
1353               group (gnus-info-group info)
1354               params (gnus-info-params info)
1355               newsrc (cdr newsrc)
1356               unread (gnus-group-unread group))
1357         (when not-in-list
1358           (setq not-in-list (delete group not-in-list)))
1359         (when (gnus-group-prepare-logic
1360                group
1361                (and (or unread          ; This group might be unchecked
1362                         predicate)      ; Check if this group should be listed
1363                     (or (not (stringp regexp))
1364                         (string-match regexp group))
1365                     (<= (setq clevel (gnus-info-level info)) level)
1366                     (>= clevel lowest)
1367                     (cond
1368                      ((functionp predicate)
1369                       (funcall predicate info))
1370                      (predicate t)      ; We list all groups?
1371                      (t
1372                       (or
1373                        (if (eq unread t) ; Unactivated?
1374                            gnus-group-list-inactive-groups
1375                                         ; We list unactivated
1376                          (and (numberp unread) (> unread 0)))
1377                                         ; We list groups with unread articles
1378                        (and gnus-list-groups-with-ticked-articles
1379                             (cdr (assq 'tick (gnus-info-marks info))))
1380                                         ; And groups with tickeds
1381                        ;; Check for permanent visibility.
1382                        (and gnus-permanently-visible-groups
1383                             (string-match gnus-permanently-visible-groups
1384                                           group))
1385                        (memq 'visible params)
1386                        (cdr (assq 'visible params)))))))
1387           (gnus-group-insert-group-line
1388            group (gnus-info-level info)
1389            (gnus-info-marks info) unread (gnus-info-method info)))))
1390
1391     ;; List dead groups.
1392     (when (or gnus-group-listed-groups
1393               (and (>= level gnus-level-zombie)
1394                    (<= lowest gnus-level-zombie)))
1395       (gnus-group-prepare-flat-list-dead
1396        (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
1397        gnus-level-zombie ?Z
1398        regexp))
1399     (when not-in-list
1400       (dolist (group gnus-zombie-list)
1401         (setq not-in-list (delete group not-in-list))))
1402     (when (or gnus-group-listed-groups
1403               (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
1404       (gnus-group-prepare-flat-list-dead
1405        (gnus-union
1406         not-in-list
1407         (setq gnus-killed-list (sort gnus-killed-list 'string<)))
1408        gnus-level-killed ?K regexp))
1409
1410     (gnus-group-set-mode-line)
1411     (setq gnus-group-list-mode (cons level predicate))
1412     (gnus-run-hooks 'gnus-group-prepare-hook)
1413     t))
1414
1415 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
1416   ;; List zombies and killed lists somewhat faster, which was
1417   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
1418   ;; this by ignoring the group format specification altogether.
1419   (let (group)
1420     (if (> (length groups) gnus-group-listing-limit)
1421         (while groups
1422           (setq group (pop groups))
1423           (when (gnus-group-prepare-logic
1424                  group
1425                  (or (not regexp)
1426                      (and (stringp regexp) (string-match regexp group))
1427                      (and (functionp regexp) (funcall regexp group))))
1428             (gnus-add-text-pr