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