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

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