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

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