1 ;;; gnus-group.el --- group mode commands for Gnus
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
30 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
34 (defvar tool-bar-mode)
50 (let ((features (cons 'gnus-group features)))
52 (unless (boundp 'gnus-cache-active-hashtb)
53 (defvar gnus-cache-active-hashtb nil)))
55 (autoload 'gnus-agent-total-fetched-for "gnus-agent")
56 (autoload 'gnus-cache-total-fetched-for "gnus-cache")
58 (defcustom gnus-group-archive-directory
59 "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
60 "*The address of the (ding) archives."
61 :group 'gnus-group-foreign
64 (defcustom gnus-group-recent-archive-directory
65 "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
66 "*The address of the most recent (ding) articles."
67 :group 'gnus-group-foreign
70 (defcustom gnus-no-groups-message "No Gnus is good news"
71 "*Message displayed by Gnus when no groups are available."
75 (defcustom gnus-keep-same-level nil
76 "*Non-nil means that the next newsgroup after the current will be on the same level.
77 When you type, for instance, `n' after reading the last article in the
78 current newsgroup, you will go to the next newsgroup. If this variable
79 is nil, the next newsgroup will be the next from the group
81 If this variable is non-nil, Gnus will either put you in the
82 next newsgroup with the same level, or, if no such newsgroup is
83 available, the next newsgroup with the lowest possible level higher
84 than the current level.
85 If this variable is `best', Gnus will make the next newsgroup the one
87 :group 'gnus-group-levels
88 :type '(choice (const nil)
90 (sexp :tag "other" t)))
92 (defcustom gnus-group-goto-unread t
93 "*If non-nil, movement commands will go to the next unread and subscribed group."
94 :link '(custom-manual "(gnus)Group Maneuvering")
95 :group 'gnus-group-various
98 (defcustom gnus-goto-next-group-when-activating t
99 "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group."
100 :link '(custom-manual "(gnus)Scanning New Messages")
101 :group 'gnus-group-various
104 (defcustom gnus-permanently-visible-groups nil
105 "*Regexp to match groups that should always be listed in the group buffer.
106 This means that they will still be listed even when there are no
107 unread articles in the groups.
109 If nil, no groups are permanently visible."
110 :group 'gnus-group-listing
111 :type '(choice regexp (const nil)))
113 (defcustom gnus-safe-html-newsgroups "\\`nnrss[+:]"
114 "Groups in which links in html articles are considered all safe.
115 The value may be a regexp matching those groups, a list of group names,
116 or nil. This overrides `mm-w3m-safe-url-regexp' (which see). This is
117 effective only when emacs-w3m renders html articles, i.e., in the case
118 `mm-text-html-renderer' is set to `w3m'."
120 :group 'gnus-group-various
121 :type '(choice regexp
122 (repeat :tag "List of group names" (string :tag "Group"))
125 (defcustom gnus-list-groups-with-ticked-articles t
126 "*If non-nil, list groups that have only ticked articles.
127 If nil, only list groups that have unread articles."
128 :group 'gnus-group-listing
131 (defcustom gnus-group-default-list-level gnus-level-subscribed
132 "*Default listing level.
133 Ignored if `gnus-group-use-permanent-levels' is non-nil."
134 :group 'gnus-group-listing
137 (defcustom gnus-group-list-inactive-groups t
138 "*If non-nil, inactive groups will be listed."
139 :group 'gnus-group-listing
140 :group 'gnus-group-levels
143 (defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet
144 "*Function used for sorting the group buffer.
145 This function will be called with group info entries as the arguments
146 for the groups to be sorted. Pre-made functions include
147 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
148 `gnus-group-sort-by-unread', `gnus-group-sort-by-level',
149 `gnus-group-sort-by-score', `gnus-group-sort-by-method',
150 `gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
152 This variable can also be a list of sorting functions. In that case,
153 the most significant sort function should be the last function in the
155 :group 'gnus-group-listing
156 :link '(custom-manual "(gnus)Sorting Groups")
157 :type '(repeat :value-to-internal (lambda (widget value)
158 (if (listp value) value (list value)))
159 :match (lambda (widget value)
161 (widget-editable-list-match widget value)))
162 (choice (function-item gnus-group-sort-by-alphabet)
163 (function-item gnus-group-sort-by-real-name)
164 (function-item gnus-group-sort-by-unread)
165 (function-item gnus-group-sort-by-level)
166 (function-item gnus-group-sort-by-score)
167 (function-item gnus-group-sort-by-method)
168 (function-item gnus-group-sort-by-server)
169 (function-item gnus-group-sort-by-rank)
170 (function :tag "other" nil))))
172 (defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%O\n"
173 "*Format of group lines.
174 It works along the same lines as a normal formatting string,
175 with some simple extensions.
177 %M Only marked articles (character, \"*\" or \" \")
178 %S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
179 %L Level of subscribedness (integer)
180 %N Number of unread articles (integer)
181 %I Number of dormant articles (integer)
182 %i Number of ticked and dormant (integer)
183 %T Number of ticked articles (integer)
184 %R Number of read articles (integer)
185 %U Number of unseen articles (integer)
186 %t Estimated total number of articles (integer)
187 %y Number of unread, unticked articles (integer)
188 %G Group name (string)
189 %g Qualified group name (string)
190 %c Short (collapsed) group name. See `gnus-group-uncollapsed-levels'.
191 %C Group comment (string)
192 %D Group description (string)
193 %s Select method (string)
194 %o Moderated group (char, \"m\")
195 %p Process mark (char)
196 %B Whether a summary buffer for the group is open (char, \"*\")
197 %O Moderated group (string, \"(m)\" or \"\")
198 %P Topic indentation (string)
199 %m Whether there is new(ish) mail in the group (char, \"%\")
200 %n Select from where (string)
201 %z A string that look like `<%s:%n>' if a foreign select method is used
202 %d The date the group was last entered.
203 %E Icon as defined by `gnus-group-icon-list'.
204 %F The disk space used by the articles fetched by both the cache and agent.
205 %u User defined specifier. The next character in the format string should
206 be a letter. Gnus will call the function gnus-user-format-function-X,
207 where X is the letter following %u. The function will be passed a
208 single dummy parameter as argument. The function should return a
209 string, which will be inserted into the buffer just like information
210 from any other group specifier.
212 Note that this format specification is not always respected. For
213 reasons of efficiency, when listing killed groups, this specification
214 is ignored altogether. If the spec is changed considerably, your
215 output may end up looking strange when listing both alive and killed
218 If you use %o or %O, reading the active file will be slower and quite
219 a bit of extra memory will be used. %D and %F will also worsen
220 performance. Also note that if you change the format specification to
221 include any of these specs, you must probably re-start Gnus to see
224 General format specifiers can also be used.
225 See Info node `(gnus)Formatting Variables'."
226 :link '(custom-manual "(gnus)Formatting Variables")
227 :group 'gnus-group-visual
230 (defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
231 "*The format specification for the group mode line.
232 It works along the same lines as a normal formatting string,
233 with some simple extensions:
235 %S The native news server.
236 %M The native select method.
237 %: \":\" if %S isn't \"\"."
238 :group 'gnus-group-visual
241 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
242 (when (featurep 'xemacs)
243 (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
244 (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
246 (defcustom gnus-group-menu-hook nil
247 "Hook run after the creation of the group mode menu."
248 :group 'gnus-group-various
251 (defcustom gnus-group-catchup-group-hook nil
252 "Hook run when catching up a group from the group buffer."
253 :group 'gnus-group-various
254 :link '(custom-manual "(gnus)Group Data")
257 (defcustom gnus-group-update-group-hook nil
258 "Hook called when updating group lines."
259 :group 'gnus-group-visual
262 (defcustom gnus-group-prepare-function 'gnus-group-prepare-flat
263 "*A function that is called to generate the group buffer.
264 The function is called with three arguments: The first is a number;
265 all group with a level less or equal to that number should be listed,
266 if the second is non-nil, empty groups should also be displayed. If
267 the third is non-nil, it is a number. No groups with a level lower
268 than this number should be displayed.
270 The only current function implemented is `gnus-group-prepare-flat'."
271 :group 'gnus-group-listing
274 (defcustom gnus-group-prepare-hook nil
275 "Hook called after the group buffer has been generated.
276 If you want to modify the group buffer, you can use this hook."
277 :group 'gnus-group-listing
280 (defcustom gnus-suspend-gnus-hook nil
281 "Hook called when suspending (not exiting) Gnus."
285 (defcustom gnus-exit-gnus-hook nil
286 "Hook called when exiting Gnus."
290 (defcustom gnus-after-exiting-gnus-hook nil
291 "Hook called after exiting Gnus."
295 (defcustom gnus-group-update-hook '(gnus-group-highlight-line)
296 "Hook called when a group line is changed.
297 The hook will not be called if `gnus-visual' is nil.
299 The default function `gnus-group-highlight-line' will
300 highlight the line according to the `gnus-group-highlight'
302 :group 'gnus-group-visual
305 (defcustom gnus-useful-groups
306 '(("(ding) mailing list mirrored at gmane.org"
307 "gmane.emacs.gnus.general"
309 (nntp-address "news.gmane.org")))
312 (nntp "news.gnus.org"
313 (nntp-address "news.gnus.org")))
314 ("Local Gnus help group"
317 (nndoc-article-type mbox)
318 (eval `(nndoc-address
319 ,(let ((file (nnheader-find-etc-directory
322 (error "Couldn't find doc group"))
324 "*Alist of useful group-server pairs."
325 :group 'gnus-group-listing
326 :type '(repeat (list (string :tag "Description")
328 (sexp :tag "Method"))))
330 (defcustom gnus-group-highlight
332 ((and mailp (= unread 0) (eq level 1)) .
333 gnus-group-mail-1-empty)
334 ((and mailp (eq level 1)) .
336 ((and mailp (= unread 0) (eq level 2)) .
337 gnus-group-mail-2-empty)
338 ((and mailp (eq level 2)) .
340 ((and mailp (= unread 0) (eq level 3)) .
341 gnus-group-mail-3-empty)
342 ((and mailp (eq level 3)) .
344 ((and mailp (= unread 0)) .
345 gnus-group-mail-low-empty)
349 ((and (= unread 0) (eq level 1)) .
350 gnus-group-news-1-empty)
351 ((and (eq level 1)) .
353 ((and (= unread 0) (eq level 2)) .
354 gnus-group-news-2-empty)
355 ((and (eq level 2)) .
357 ((and (= unread 0) (eq level 3)) .
358 gnus-group-news-3-empty)
359 ((and (eq level 3)) .
361 ((and (= unread 0) (eq level 4)) .
362 gnus-group-news-4-empty)
363 ((and (eq level 4)) .
365 ((and (= unread 0) (eq level 5)) .
366 gnus-group-news-5-empty)
367 ((and (eq level 5)) .
369 ((and (= unread 0) (eq level 6)) .
370 gnus-group-news-6-empty)
371 ((and (eq level 6)) .
373 ((and (= unread 0)) .
374 gnus-group-news-low-empty)
376 gnus-group-news-low))
377 "*Controls the highlighting of group buffer lines.
379 Below is a list of `Form'/`Face' pairs. When deciding how a a
380 particular group line should be displayed, each form is
381 evaluated. The content of the face field after the first true form is
382 used. You can change how those group lines are displayed by
383 editing the face field.
385 It is also possible to change and add form fields, but currently that
386 requires an understanding of Lisp expressions. Hopefully this will
387 change in a future release. For now, you can use the following
388 variables in the Lisp expression:
390 group: The name of the group.
391 unread: The number of unread articles in the group.
392 method: The select method used.
393 mailp: Whether it's a mail group or not.
394 level: The level of the group.
395 score: The score of the group.
396 ticked: The number of ticked articles."
397 :group 'gnus-group-visual
398 :type '(repeat (cons (sexp :tag "Form") face)))
399 (put 'gnus-group-highlight 'risky-local-variable t)
401 (defcustom gnus-new-mail-mark ?%
402 "Mark used for groups with new mail."
403 :group 'gnus-group-visual
406 (defgroup gnus-group-icons nil
407 "Add Icons to your group buffer."
408 :group 'gnus-group-visual)
410 (defcustom gnus-group-icon-list
412 "*Controls the insertion of icons into group buffer lines.
414 Below is a list of `Form'/`File' pairs. When deciding how a
415 particular group line should be displayed, each form is evaluated.
416 The icon from the file field after the first true form is used. You
417 can change how those group lines are displayed by editing the file
418 field. The File will either be found in the
419 `gnus-group-glyph-directory' or by designating absolute name of the
422 It is also possible to change and add form fields, but currently that
423 requires an understanding of Lisp expressions. Hopefully this will
424 change in a future release. For now, you can use the following
425 variables in the Lisp expression:
427 group: The name of the group.
428 unread: The number of unread articles in the group.
429 method: The select method used.
430 mailp: Whether it's a mail group or not.
431 newsp: Whether it's a news group or not
432 level: The level of the group.
433 score: The score of the group.
434 ticked: The number of ticked articles."
435 :group 'gnus-group-icons
436 :type '(repeat (cons (sexp :tag "Form") file)))
437 (put 'gnus-group-icon-list 'risky-local-variable t)
439 (defcustom gnus-group-name-charset-method-alist nil
440 "Alist of method and the charset for group names.
443 (((nntp \"news.com.cn\") . cn-gb-2312))"
446 :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
448 (defcustom gnus-group-name-charset-group-alist
449 (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
450 (mm-coding-system-p 'utf-8))
453 "Alist of group regexp and the charset for group names.
456 ((\"\\.com\\.cn:\" . cn-gb-2312))"
458 :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
460 (defcustom gnus-group-jump-to-group-prompt nil
461 "Default prompt for `gnus-group-jump-to-group'.
463 If non-nil, the value should be a string or an alist. If it is a string,
464 e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group:
465 nnml:\" in the minibuffer prompt.
467 If it is an alist, it must consist of \(NUMBER . PROMPT\) pairs, for example:
468 \((1 . \"\") (2 . \"nnfolder+archive:\")). The element with number 0 is
469 used when no prefix argument is given to `gnus-group-jump-to-group'."
471 :group 'gnus-group-various
472 :type '(choice (string :tag "Prompt string")
473 (const :tag "Empty" nil)
474 (repeat (cons (integer :tag "Argument")
475 (string :tag "Prompt string")))))
477 (defvar gnus-group-listing-limit 1000
478 "*A limit of the number of groups when listing.
479 If the number of groups is larger than the limit, list them in a
482 ;;; Internal variables
484 (defvar gnus-group-is-exiting-p nil)
485 (defvar gnus-group-is-exiting-without-update-p nil)
486 (defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
487 "Function for sorting the group buffer.")
489 (defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
490 "Function for sorting the selected groups in the group buffer.")
492 (defvar gnus-group-indentation-function nil)
493 (defvar gnus-goto-missing-group-function nil)
494 (defvar gnus-group-update-group-function nil)
495 (defvar gnus-group-goto-next-group-function nil
496 "Function to override finding the next group after listing groups.")
498 (defvar gnus-group-edit-buffer nil)
500 (defvar gnus-group-line-format-alist
501 `((?M gnus-tmp-marked-mark ?c)
502 (?S gnus-tmp-subscribed ?c)
503 (?L gnus-tmp-level ?d)
504 (?N (cond ((eq number t) "*" )
508 (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
509 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
511 (?R gnus-tmp-number-of-read ?s)
512 (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
513 (?t gnus-tmp-number-total ?d)
514 (?y gnus-tmp-number-of-unread ?s)
515 (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
516 (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
517 (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
518 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
519 (?g (if (boundp 'gnus-tmp-decoded-group)
520 gnus-tmp-decoded-group
523 (?G gnus-tmp-qualified-group ?s)
524 (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
525 gnus-tmp-decoded-group
528 (?C gnus-tmp-comment ?s)
529 (?D gnus-tmp-newsgroup-description ?s)
530 (?o gnus-tmp-moderated ?c)
531 (?O gnus-tmp-moderated-string ?s)
532 (?p gnus-tmp-process-marked ?c)
533 (?s gnus-tmp-news-server ?s)
534 (?n ,(if (featurep 'xemacs)
535 '(symbol-name gnus-tmp-news-method)
536 'gnus-tmp-news-method)
538 (?P gnus-group-indentation ?s)
539 (?E gnus-tmp-group-icon ?s)
540 (?B gnus-tmp-summary-live ?c)
541 (?z gnus-tmp-news-method-string ?s)
542 (?m (gnus-group-new-mail gnus-tmp-group) ?c)
543 (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
544 (?u gnus-tmp-user-defined ?s)
545 (?F (gnus-total-fetched-for gnus-tmp-group) ?s)
548 (defvar gnus-group-mode-line-format-alist
549 `((?S gnus-tmp-news-server ?s)
550 (?M gnus-tmp-news-method ?s)
551 (?u gnus-tmp-user-defined ?s)
552 (?: gnus-tmp-colon ?s)))
554 (defvar gnus-topic-topology nil
555 "The complete topic hierarchy.")
557 (defvar gnus-topic-alist nil
558 "The complete topic-group alist.")
560 (defvar gnus-group-marked nil)
562 (defvar gnus-group-list-mode nil)
565 (defvar gnus-group-icon-cache nil)
567 (defvar gnus-group-listed-groups nil)
568 (defvar gnus-group-list-option nil)
574 (put 'gnus-group-mode 'mode-class 'special)
576 (gnus-define-keys gnus-group-mode-map
577 " " gnus-group-read-group
578 "=" gnus-group-select-group
579 "\r" gnus-group-select-group
580 "\M-\r" gnus-group-quick-select-group
581 "\M- " gnus-group-visible-select-group
582 [(meta control return)] gnus-group-select-group-ephemerally
583 "j" gnus-group-jump-to-group
584 "n" gnus-group-next-unread-group
585 "p" gnus-group-prev-unread-group
586 "\177" gnus-group-prev-unread-group
587 [delete] gnus-group-prev-unread-group
588 [backspace] gnus-group-prev-unread-group
589 "N" gnus-group-next-group
590 "P" gnus-group-prev-group
591 "\M-n" gnus-group-next-unread-group-same-level
592 "\M-p" gnus-group-prev-unread-group-same-level
593 "," gnus-group-best-unread-group
594 "." gnus-group-first-unread-group
595 "u" gnus-group-unsubscribe-current-group
596 "U" gnus-group-unsubscribe-group
597 "c" gnus-group-catchup-current
598 "C" gnus-group-catchup-current-all
599 "\M-c" gnus-group-clear-data
600 "l" gnus-group-list-groups
601 "L" gnus-group-list-all-groups
604 "g" gnus-group-get-new-news
605 "\M-g" gnus-group-get-new-news-this-group
606 "R" gnus-group-restart
607 "r" gnus-group-read-init-file
608 "B" gnus-group-browse-foreign-server
609 "b" gnus-group-check-bogus-groups
610 "F" gnus-group-find-new-groups
611 "\C-c\C-d" gnus-group-describe-group
612 "\M-d" gnus-group-describe-all-groups
613 "\C-c\C-a" gnus-group-apropos
614 "\C-c\M-\C-a" gnus-group-description-apropos
615 "a" gnus-group-post-news
616 "\ek" gnus-group-edit-local-kill
617 "\eK" gnus-group-edit-global-kill
618 "\C-k" gnus-group-kill-group
619 "\C-y" gnus-group-yank-group
620 "\C-w" gnus-group-kill-region
621 "\C-x\C-t" gnus-group-transpose-groups
622 "\C-c\C-l" gnus-group-list-killed
623 "\C-c\C-x" gnus-group-expire-articles
624 "\C-c\M-\C-x" gnus-group-expire-all-groups
626 "s" gnus-group-save-newsrc
627 "z" gnus-group-suspend
630 "?" gnus-group-describe-briefly
631 "\C-c\C-i" gnus-info-find-node
632 "\M-e" gnus-group-edit-group-method
633 "^" gnus-group-enter-server-mode
634 gnus-mouse-2 gnus-mouse-pick-group
635 [follow-link] mouse-face
636 "<" beginning-of-buffer
639 "\C-c\C-s" gnus-group-sort-groups
641 "\C-c\M-g" gnus-activate-all-groups
642 "\M-&" gnus-group-universal-argument
643 "#" gnus-group-mark-group
644 "\M-#" gnus-group-unmark-group)
646 (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
647 "m" gnus-group-mark-group
648 "u" gnus-group-unmark-group
649 "w" gnus-group-mark-region
650 "b" gnus-group-mark-buffer
651 "r" gnus-group-mark-regexp
652 "U" gnus-group-unmark-all-groups)
654 (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
655 "u" gnus-sieve-update
656 "g" gnus-sieve-generate)
658 (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
659 "d" gnus-group-make-directory-group
660 "h" gnus-group-make-help-group
661 "u" gnus-group-make-useful-group
662 "a" gnus-group-make-archive-group
663 "k" gnus-group-make-kiboze-group
664 "l" gnus-group-nnimap-edit-acl
665 "m" gnus-group-make-group
666 "E" gnus-group-edit-group
667 "e" gnus-group-edit-group-method
668 "p" gnus-group-edit-group-parameters
669 "v" gnus-group-add-to-virtual
670 "V" gnus-group-make-empty-virtual
671 "D" gnus-group-enter-directory
672 "f" gnus-group-make-doc-group
673 "w" gnus-group-make-web-group
674 "M" gnus-group-read-ephemeral-group
675 "r" gnus-group-rename-group
676 "R" gnus-group-make-rss-group
677 "c" gnus-group-customize
678 "z" gnus-group-compact-group
679 "x" gnus-group-nnimap-expunge
680 "\177" gnus-group-delete-group
681 [delete] gnus-group-delete-group)
683 (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
684 "b" gnus-group-brew-soup
685 "w" gnus-soup-save-areas
686 "s" gnus-soup-send-replies
687 "p" gnus-soup-pack-packet
688 "r" nnsoup-pack-replies)
690 (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
691 "s" gnus-group-sort-groups
692 "a" gnus-group-sort-groups-by-alphabet
693 "u" gnus-group-sort-groups-by-unread
694 "l" gnus-group-sort-groups-by-level
695 "v" gnus-group-sort-groups-by-score
696 "r" gnus-group-sort-groups-by-rank
697 "m" gnus-group-sort-groups-by-method
698 "n" gnus-group-sort-groups-by-real-name)
700 (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
701 "s" gnus-group-sort-selected-groups
702 "a" gnus-group-sort-selected-groups-by-alphabet
703 "u" gnus-group-sort-selected-groups-by-unread
704 "l" gnus-group-sort-selected-groups-by-level
705 "v" gnus-group-sort-selected-groups-by-score
706 "r" gnus-group-sort-selected-groups-by-rank
707 "m" gnus-group-sort-selected-groups-by-method
708 "n" gnus-group-sort-selected-groups-by-real-name)
710 (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
711 "k" gnus-group-list-killed
712 "z" gnus-group-list-zombies
713 "s" gnus-group-list-groups
714 "u" gnus-group-list-all-groups
715 "A" gnus-group-list-active
716 "a" gnus-group-apropos
717 "d" gnus-group-description-apropos
718 "m" gnus-group-list-matching
719 "M" gnus-group-list-all-matching
720 "l" gnus-group-list-level
721 "c" gnus-group-list-cached
722 "?" gnus-group-list-dormant)
724 (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
725 "k" gnus-group-list-limit
726 "z" gnus-group-list-limit
727 "s" gnus-group-list-limit
728 "u" gnus-group-list-limit
729 "A" gnus-group-list-limit
730 "m" gnus-group-list-limit
731 "M" gnus-group-list-limit
732 "l" gnus-group-list-limit
733 "c" gnus-group-list-limit
734 "?" gnus-group-list-limit)
736 (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
737 "k" gnus-group-list-flush
738 "z" gnus-group-list-flush
739 "s" gnus-group-list-flush
740 "u" gnus-group-list-flush
741 "A" gnus-group-list-flush
742 "m" gnus-group-list-flush
743 "M" gnus-group-list-flush
744 "l" gnus-group-list-flush
745 "c" gnus-group-list-flush
746 "?" gnus-group-list-flush)
748 (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
749 "k" gnus-group-list-plus
750 "z" gnus-group-list-plus
751 "s" gnus-group-list-plus
752 "u" gnus-group-list-plus
753 "A" gnus-group-list-plus
754 "m" gnus-group-list-plus
755 "M" gnus-group-list-plus
756 "l" gnus-group-list-plus
757 "c" gnus-group-list-plus
758 "?" gnus-group-list-plus)
760 (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
761 "f" gnus-score-flush-cache
762 "e" gnus-score-edit-all-score)
764 (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
765 "c" gnus-group-fetch-charter
766 "C" gnus-group-fetch-control
767 "d" gnus-group-describe-group
768 "f" gnus-group-fetch-faq
771 (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
772 "l" gnus-group-set-current-level
773 "t" gnus-group-unsubscribe-current-group
774 "s" gnus-group-unsubscribe-group
775 "k" gnus-group-kill-group
776 "y" gnus-group-yank-group
777 "w" gnus-group-kill-region
778 "\C-k" gnus-group-kill-level
779 "z" gnus-group-kill-all-zombies)
781 (defun gnus-topic-mode-p ()
782 "Return non-nil in `gnus-topic-mode'."
783 (and (boundp 'gnus-topic-mode)
784 (symbol-value 'gnus-topic-mode)))
786 (defun gnus-group-make-menu-bar ()
787 (gnus-turn-off-edit-menu 'group)
788 (unless (boundp 'gnus-group-reading-menu)
791 gnus-group-reading-menu gnus-group-mode-map ""
793 ["Read" gnus-group-read-group
794 :included (not (gnus-topic-mode-p))
795 :active (gnus-group-group-name)]
796 ["Read " gnus-topic-read-group
797 :included (gnus-topic-mode-p)]
798 ["Select" gnus-group-select-group
799 :included (not (gnus-topic-mode-p))
800 :active (gnus-group-group-name)]
801 ["Select " gnus-topic-select-group
802 :included (gnus-topic-mode-p)]
803 ["See old articles" (gnus-group-select-group 'all)
804 :keys "C-u SPC" :active (gnus-group-group-name)]
805 ["Catch up" gnus-group-catchup-current
806 :included (not (gnus-topic-mode-p))
807 :active (gnus-group-group-name)
808 ,@(if (featurep 'xemacs) nil
809 '(:help "Mark unread articles in the current group as read"))]
810 ["Catch up " gnus-topic-catchup-articles
811 :included (gnus-topic-mode-p)
812 ,@(if (featurep 'xemacs) nil
813 '(:help "Mark unread articles in the current group or topic as read"))]
814 ["Catch up all articles" gnus-group-catchup-current-all
815 (gnus-group-group-name)]
816 ["Check for new articles" gnus-group-get-new-news-this-group
817 :included (not (gnus-topic-mode-p))
818 :active (gnus-group-group-name)
819 ,@(if (featurep 'xemacs) nil
820 '(:help "Check for new messages in current group"))]
821 ["Check for new articles " gnus-topic-get-new-news-this-topic
822 :included (gnus-topic-mode-p)
823 ,@(if (featurep 'xemacs) nil
824 '(:help "Check for new messages in current group or topic"))]
825 ["Toggle subscription" gnus-group-unsubscribe-current-group
826 (gnus-group-group-name)]
827 ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
828 ,@(if (featurep 'xemacs) nil
829 '(:help "Kill (remove) current group"))]
830 ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
831 ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
832 ,@(if (featurep 'xemacs) nil
833 '(:help "Display description of the current group"))]
834 ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
835 ["Fetch charter" gnus-group-fetch-charter
836 :active (gnus-group-group-name)
837 ,@(if (featurep 'xemacs) nil
838 '(:help "Display the charter of the current group"))]
839 ["Fetch control message" gnus-group-fetch-control
840 :active (gnus-group-group-name)
841 ,@(if (featurep 'xemacs) nil
842 '(:help "Display the archived control message for the current group"))]
843 ;; Actually one should check, if any of the marked groups gives t for
844 ;; (gnus-check-backend-function 'request-expire-articles ...)
845 ["Expire articles" gnus-group-expire-articles
846 :included (not (gnus-topic-mode-p))
847 :active (or (and (gnus-group-group-name)
848 (gnus-check-backend-function
849 'request-expire-articles
850 (gnus-group-group-name))) gnus-group-marked)]
851 ["Expire articles " gnus-topic-expire-articles
852 :included (gnus-topic-mode-p)]
853 ["Set group level..." gnus-group-set-current-level
854 (gnus-group-group-name)]
855 ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
856 ["Customize" gnus-group-customize (gnus-group-group-name)]
857 ["Compact" gnus-group-compact-group
858 :active (gnus-group-group-name)]
860 ["Parameters" gnus-group-edit-group-parameters
861 :included (not (gnus-topic-mode-p))
862 :active (gnus-group-group-name)]
863 ["Parameters " gnus-topic-edit-parameters
864 :included (gnus-topic-mode-p)]
865 ["Select method" gnus-group-edit-group-method
866 (gnus-group-group-name)]
867 ["Info" gnus-group-edit-group (gnus-group-group-name)]
868 ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
869 ["Global kill file" gnus-group-edit-global-kill t])))
872 gnus-group-group-menu gnus-group-mode-map ""
875 ["List unread subscribed groups" gnus-group-list-groups t]
876 ["List (un)subscribed groups" gnus-group-list-all-groups t]
877 ["List killed groups" gnus-group-list-killed gnus-killed-list]
878 ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
879 ["List level..." gnus-group-list-level t]
880 ["Describe all groups" gnus-group-describe-all-groups t]
881 ["Group apropos..." gnus-group-apropos t]
882 ["Group and description apropos..." gnus-group-description-apropos t]
883 ["List groups matching..." gnus-group-list-matching t]
884 ["List all groups matching..." gnus-group-list-all-matching t]
885 ["List active file" gnus-group-list-active t]
886 ["List groups with cached" gnus-group-list-cached t]
887 ["List groups with dormant" gnus-group-list-dormant t])
889 ["Default sort" gnus-group-sort-groups t]
890 ["Sort by method" gnus-group-sort-groups-by-method t]
891 ["Sort by rank" gnus-group-sort-groups-by-rank t]
892 ["Sort by score" gnus-group-sort-groups-by-score t]
893 ["Sort by level" gnus-group-sort-groups-by-level t]
894 ["Sort by unread" gnus-group-sort-groups-by-unread t]
895 ["Sort by name" gnus-group-sort-groups-by-alphabet t]
896 ["Sort by real name" gnus-group-sort-groups-by-real-name t])
897 ("Sort process/prefixed"
898 ["Default sort" gnus-group-sort-selected-groups
899 (not (gnus-topic-mode-p))]
900 ["Sort by method" gnus-group-sort-selected-groups-by-method
901 (not (gnus-topic-mode-p))]
902 ["Sort by rank" gnus-group-sort-selected-groups-by-rank
903 (not (gnus-topic-mode-p))]
904 ["Sort by score" gnus-group-sort-selected-groups-by-score
905 (not (gnus-topic-mode-p))]
906 ["Sort by level" gnus-group-sort-selected-groups-by-level
907 (not (gnus-topic-mode-p))]
908 ["Sort by unread" gnus-group-sort-selected-groups-by-unread
909 (not (gnus-topic-mode-p))]
910 ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
911 (not (gnus-topic-mode-p))]
912 ["Sort by real name" gnus-group-sort-selected-groups-by-real-name
913 (not (gnus-topic-mode-p))])
915 ["Mark group" gnus-group-mark-group
916 (and (gnus-group-group-name)
917 (not (memq (gnus-group-group-name) gnus-group-marked)))]
918 ["Unmark group" gnus-group-unmark-group
919 (and (gnus-group-group-name)
920 (memq (gnus-group-group-name) gnus-group-marked))]
921 ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
922 ["Mark regexp..." gnus-group-mark-regexp t]
923 ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
924 ["Mark buffer" gnus-group-mark-buffer t]
925 ["Execute command" gnus-group-universal-argument
926 (or gnus-group-marked (gnus-group-group-name))])
928 ["Subscribe to a group..." gnus-group-unsubscribe-group t]
929 ["Kill all newsgroups in region" gnus-group-kill-region
930 :active (gnus-mark-active-p)]
931 ["Kill all zombie groups" gnus-group-kill-all-zombies
933 ["Kill all groups on level..." gnus-group-kill-level t])
935 ["Make a foreign group..." gnus-group-make-group t]
936 ["Add a directory group..." gnus-group-make-directory-group t]
937 ["Add the help group" gnus-group-make-help-group t]
938 ["Add the archive group" gnus-group-make-archive-group t]
939 ["Make a doc group..." gnus-group-make-doc-group t]
940 ["Make a web group..." gnus-group-make-web-group t]
941 ["Make a kiboze group..." gnus-group-make-kiboze-group t]
942 ["Make a virtual group..." gnus-group-make-empty-virtual t]
943 ["Add a group to a virtual..." gnus-group-add-to-virtual t]
944 ["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
945 ["Make an RSS group..." gnus-group-make-rss-group t]
946 ["Rename group..." gnus-group-rename-group
947 (gnus-check-backend-function
948 'request-rename-group (gnus-group-group-name))]
949 ["Delete group" gnus-group-delete-group
950 (gnus-check-backend-function
951 'request-delete-group (gnus-group-group-name))])
953 ["Next" gnus-group-next-group t]
954 ["Previous" gnus-group-prev-group t]
955 ["Next unread" gnus-group-next-unread-group t]
956 ["Previous unread" gnus-group-prev-unread-group t]
957 ["Next unread same level" gnus-group-next-unread-group-same-level t]
958 ["Previous unread same level"
959 gnus-group-prev-unread-group-same-level t]
960 ["Jump to group..." gnus-group-jump-to-group t]
961 ["First unread group" gnus-group-first-unread-group t]
962 ["Best unread group" gnus-group-best-unread-group t])
964 ["Generate" gnus-sieve-generate t]
965 ["Generate and update" gnus-sieve-update t])
966 ["Delete bogus groups" gnus-group-check-bogus-groups t]
967 ["Find new newsgroups" gnus-group-find-new-groups t]
968 ["Transpose" gnus-group-transpose-groups
969 (gnus-group-group-name)]
970 ["Read a directory as a group..." gnus-group-enter-directory t]))
973 gnus-group-misc-menu gnus-group-mode-map ""
976 ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
977 ["Send replies" gnus-soup-send-replies
978 (fboundp 'gnus-soup-pack-packet)]
979 ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
980 ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
981 ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
982 ["Send a mail" gnus-group-mail t]
983 ["Send a message (mail or news)" gnus-group-post-news t]
984 ["Create a local message" gnus-group-news t]
985 ["Check for new news" gnus-group-get-new-news
986 ,@(if (featurep 'xemacs) '(t)
987 '(:help "Get newly arrived articles"))
989 ["Send queued messages" gnus-delay-send-queue
990 ,@(if (featurep 'xemacs) '(t)
991 '(:help "Send all messages that are scheduled to be sent now"))
993 ["Activate all groups" gnus-activate-all-groups t]
994 ["Restart Gnus" gnus-group-restart t]
995 ["Read init file" gnus-group-read-init-file t]
996 ["Browse foreign server..." gnus-group-browse-foreign-server t]
997 ["Enter server buffer" gnus-group-enter-server-mode t]
998 ["Expire all expirable articles" gnus-group-expire-all-groups t]
999 ["Generate any kiboze groups" nnkiboze-generate-groups t]
1000 ["Gnus version" gnus-version t]
1001 ["Save .newsrc files" gnus-group-save-newsrc t]
1002 ["Suspend Gnus" gnus-group-suspend t]
1003 ["Clear dribble buffer" gnus-group-clear-dribble t]
1004 ["Read manual" gnus-info-find-node t]
1005 ["Flush score cache" gnus-score-flush-cache t]
1006 ["Toggle topics" gnus-topic-mode t]
1007 ["Send a bug report" gnus-bug t]
1008 ["Exit from Gnus" gnus-group-exit
1009 ,@(if (featurep 'xemacs) '(t)
1010 '(:help "Quit reading news"))]
1011 ["Exit without saving" gnus-group-quit t]))
1013 (gnus-run-hooks 'gnus-group-menu-hook)))
1016 (defvar gnus-group-tool-bar-map nil)
1018 (defun gnus-group-tool-bar-update (&optional symbol value)
1019 "Update group buffer toolbar.
1020 Setter function for custom variables."
1022 (set-default symbol value))
1023 ;; (setq-default gnus-group-tool-bar-map nil)
1024 ;; (use-local-map gnus-group-mode-map)
1025 (when (gnus-alive-p)
1026 (with-current-buffer gnus-group-buffer
1027 (gnus-group-make-tool-bar t))))
1029 (defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
1030 'gnus-group-tool-bar-gnome
1031 'gnus-group-tool-bar-retro)
1032 "Specifies the Gnus group tool bar.
1034 It can be either a list or a symbol refering to a list. See
1035 `gmm-tool-bar-from-list' for the format of the list. The
1036 default key map is `gnus-group-mode-map'.
1038 Pre-defined symbols include `gnus-group-tool-bar-gnome' and
1039 `gnus-group-tool-bar-retro'."
1040 :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
1041 (const :tag "Retro look" gnus-group-tool-bar-retro)
1042 (repeat :tag "User defined list" gmm-tool-bar-item)
1044 :version "23.1" ;; No Gnus
1045 :initialize 'custom-initialize-default
1046 :set 'gnus-group-tool-bar-update
1049 (defcustom gnus-group-tool-bar-gnome
1050 '((gnus-group-post-news "mail/compose")
1051 ;; Some useful agent icons? I don't use the agent so agent users should
1052 ;; suggest useful commands:
1053 (gnus-agent-toggle-plugged "disconnect" t
1054 :help "Gnus is currently unplugged. Click to work online."
1055 :visible (and gnus-agent (not gnus-plugged)))
1056 (gnus-agent-toggle-plugged "connect" t
1057 :help "Gnus is currently plugged. Click to work offline."
1058 :visible (and gnus-agent gnus-plugged))
1059 ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
1060 ;; should have a better help text.
1061 (gnus-group-send-queue "mail/outbox" t
1062 :visible (and gnus-agent gnus-plugged)
1063 :help "Send articles from the queue group")
1064 (gnus-group-get-new-news "mail/inbox" nil
1065 :visible (or (not gnus-agent)
1067 ;; FIXME: gnus-*-read-group should have a better help text.
1068 (gnus-topic-read-group "open" nil
1069 :visible (and (boundp 'gnus-topic-mode)
1071 (gnus-group-read-group "open" nil
1072 :visible (not (and (boundp 'gnus-topic-mode)
1074 ;; (gnus-group-find-new-groups "???" nil)
1075 (gnus-group-save-newsrc "save")
1076 (gnus-group-describe-group "describe")
1077 (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
1078 (gnus-group-prev-unread-group "left-arrow")
1079 (gnus-group-next-unread-group "right-arrow")
1080 (gnus-group-exit "exit")
1081 (gmm-customize-mode "preferences" t :help "Edit mode preferences")
1082 (gnus-info-find-node "help"))
1083 "List of functions for the group tool bar (GNOME style).
1085 See `gmm-tool-bar-from-list' for the format of the list."
1086 :type '(repeat gmm-tool-bar-item)
1087 :version "23.1" ;; No Gnus
1088 :initialize 'custom-initialize-default
1089 :set 'gnus-group-tool-bar-update
1092 (defcustom gnus-group-tool-bar-retro
1093 '((gnus-group-get-new-news "gnus/get-news")
1094 (gnus-group-get-new-news-this-group "gnus/gnntg")
1095 (gnus-group-catchup-current "gnus/catchup")
1096 (gnus-group-describe-group "gnus/describe-group")
1097 (gnus-group-subscribe "gnus/subscribe" t
1098 :help "Subscribe to the current group")
1099 (gnus-group-unsubscribe "gnus/unsubscribe" t
1100 :help "Unsubscribe from the current group")
1101 (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
1102 "List of functions for the group tool bar (retro look).
1104 See `gmm-tool-bar-from-list' for the format of the list."
1105 :type '(repeat gmm-tool-bar-item)
1106 :version "23.1" ;; No Gnus
1107 :initialize 'custom-initialize-default
1108 :set 'gnus-group-tool-bar-update
1111 (defcustom gnus-group-tool-bar-zap-list t
1112 "List of icon items from the global tool bar.
1113 These items are not displayed in the Gnus group mode tool bar.
1115 See `gmm-tool-bar-from-list' for the format of the list."
1116 :type 'gmm-tool-bar-zap-list
1117 :version "23.1" ;; No Gnus
1118 :initialize 'custom-initialize-default
1119 :set 'gnus-group-tool-bar-update
1122 (defvar image-load-path)
1123 (defvar tool-bar-map)
1125 (defun gnus-group-make-tool-bar (&optional force)
1126 "Make a group mode tool bar from `gnus-group-tool-bar'.
1127 When FORCE, rebuild the tool bar."
1128 (when (and (not (featurep 'xemacs))
1129 (boundp 'tool-bar-mode)
1131 ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode).
1133 (or (not gnus-group-tool-bar-map) force))
1135 (gmm-image-load-path-for-library "gnus"
1136 "gnus/toggle-subscription.xpm"
1138 (image-load-path (cons (car load-path)
1139 (when (boundp 'image-load-path)
1141 (map (gmm-tool-bar-from-list gnus-group-tool-bar
1142 gnus-group-tool-bar-zap-list
1143 'gnus-group-mode-map)))
1145 (set (make-local-variable 'tool-bar-map) map))))
1146 gnus-group-tool-bar-map)
1148 (defun gnus-group-mode ()
1149 "Major mode for reading news.
1151 All normal editing commands are switched off.
1152 \\<gnus-group-mode-map>
1153 The group buffer lists (some of) the groups available. For instance,
1154 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
1155 lists all zombie groups.
1157 Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe
1158 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
1160 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
1162 The following commands are available:
1164 \\{gnus-group-mode-map}"
1166 (kill-all-local-variables)
1167 (when (gnus-visual-p 'group-menu 'menu)
1168 (gnus-group-make-menu-bar)
1169 (gnus-group-make-tool-bar))
1170 (gnus-simplify-mode-line)
1171 (setq major-mode 'gnus-group-mode)
1172 (setq mode-name "Group")
1173 (gnus-group-set-mode-line)
1174 (setq mode-line-process nil)
1175 (use-local-map gnus-group-mode-map)
1176 (buffer-disable-undo)
1177 (setq truncate-lines t)
1178 (setq buffer-read-only t
1179 show-trailing-whitespace nil)
1180 (gnus-set-default-directory)
1181 (gnus-update-format-specifications nil 'group 'group-mode)
1182 (gnus-update-group-mark-positions)
1187 (gnus-run-mode-hooks 'gnus-group-mode-hook))
1189 (defun gnus-update-group-mark-positions ()
1191 (let ((gnus-process-mark ?\200)
1192 (gnus-group-update-hook nil)
1193 (gnus-group-marked '("dummy.group"))
1194 (gnus-active-hashtb (make-vector 10 0))
1196 (gnus-set-active "dummy.group" '(0 . 0))
1197 (gnus-set-work-buffer)
1198 (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
1199 (goto-char (point-min))
1200 (setq gnus-group-mark-positions
1201 (list (cons 'process (and (search-forward
1202 (mm-string-to-multibyte "\200") nil t)
1203 (- (point) (point-min) 1))))))))
1205 (defun gnus-mouse-pick-group (e)
1206 "Enter the group under the mouse pointer."
1209 (gnus-group-read-group nil))
1211 ;; Look at LEVEL and find out what the level is really supposed to be.
1212 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
1213 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
1214 (defun gnus-group-default-level (&optional level number-or-nil)
1216 (gnus-group-use-permanent-levels
1217 (or (setq gnus-group-use-permanent-levels
1218 (or level (if (numberp gnus-group-use-permanent-levels)
1219 gnus-group-use-permanent-levels
1220 (or gnus-group-default-list-level
1221 gnus-level-subscribed))))
1222 gnus-group-default-list-level gnus-level-subscribed))
1226 (or level gnus-group-default-list-level gnus-level-subscribed))))
1228 (defun gnus-group-setup-buffer ()
1229 (set-buffer (gnus-get-buffer-create gnus-group-buffer))
1230 (unless (eq major-mode 'gnus-group-mode)
1233 (gnus-carpal-setup-buffer 'group))))
1235 (defun gnus-group-name-charset (method group)
1237 (setq method (gnus-find-method-for-group group)))
1238 (let ((item (or (assoc method gnus-group-name-charset-method-alist)
1240 (assoc (list (car method) (cadr method))
1241 gnus-group-name-charset-method-alist))))
1242 (alist gnus-group-name-charset-group-alist)
1246 (while (setq item (pop alist))
1247 (if (string-match (car item) group)
1249 result (cdr item))))
1252 (defun gnus-group-name-decode (string charset)
1253 ;; Fixme: Don't decode in unibyte mode.
1254 (if (and string charset (featurep 'mule))
1255 (mm-decode-coding-string string charset)
1258 (defun gnus-group-decoded-name (string)
1259 (let ((charset (gnus-group-name-charset nil string)))
1260 (gnus-group-name-decode string charset)))
1262 (defun gnus-group-list-groups (&optional level unread lowest)
1263 "List newsgroups with level LEVEL or lower that have unread articles.
1264 Default is all subscribed groups.
1265 If argument UNREAD is non-nil, groups with no unread articles are also
1268 Also see the `gnus-group-use-permanent-levels' variable."
1270 (list (if current-prefix-arg
1271 (prefix-numeric-value current-prefix-arg)
1273 (gnus-group-default-level nil t)
1274 gnus-group-default-list-level
1275 gnus-level-subscribed))))
1277 (setq level (car gnus-group-list-mode)
1278 unread (cdr gnus-group-list-mode)))
1279 (setq level (gnus-group-default-level level))
1280 (gnus-group-setup-buffer)
1281 (gnus-update-format-specifications nil 'group 'group-mode)
1282 (let ((case-fold-search nil)
1283 (props (text-properties-at (point-at-bol)))
1284 (empty (= (point-min) (point-max)))
1285 (group (gnus-group-group-name))
1287 (set-buffer gnus-group-buffer)
1288 (setq number (funcall gnus-group-prepare-function level unread lowest))
1289 (when (or (and (numberp number)
1291 (zerop (buffer-size)))
1292 ;; No groups in the buffer.
1293 (gnus-message 5 gnus-no-groups-message))
1294 ;; We have some groups displayed.
1295 (goto-char (point-max))
1296 (when (or (not gnus-group-goto-next-group-function)
1297 (not (funcall gnus-group-goto-next-group-function
1301 (goto-char (point-min)))
1303 ;; Go to the first group with unread articles.
1304 (gnus-group-search-forward t))
1306 ;; Find the right group to put point on. If the current group
1307 ;; has disappeared in the new listing, try to find the next
1308 ;; one. If no next one can be found, just leave point at the
1309 ;; first newsgroup in the buffer.
1310 (when (not (gnus-goto-char
1312 (point-min) (point-max)
1313 'gnus-group (gnus-intern-safe
1314 group gnus-active-hashtb))))
1315 (let ((newsrc (cdddr (gnus-group-entry group))))
1317 (not (gnus-goto-char
1319 (point-min) (point-max) 'gnus-group
1321 (caar newsrc) gnus-active-hashtb)))))
1322 (setq newsrc (cdr newsrc)))
1324 (goto-char (point-max))
1325 (forward-line -1)))))))
1326 ;; Adjust cursor point.
1327 (gnus-group-position-point)))
1329 (defun gnus-group-list-level (level &optional all)
1330 "List groups on LEVEL.
1331 If ALL (the prefix), also list groups that have no unread articles."
1332 (interactive "nList groups on level: \nP")
1333 (gnus-group-list-groups level all level))
1335 (defun gnus-group-prepare-logic (group test)
1336 (or (and gnus-group-listed-groups
1337 (null gnus-group-list-option)
1338 (member group gnus-group-listed-groups))
1340 ((null gnus-group-listed-groups) test)
1341 ((null gnus-group-list-option) test)
1342 (t (and (member group gnus-group-listed-groups)
1343 (if (eq gnus-group-list-option 'flush)
1347 (defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
1348 "List all newsgroups with unread articles of level LEVEL or lower.
1349 If PREDICATE is a function, list groups that the function returns non-nil;
1350 if it is t, list groups that have no unread articles.
1351 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
1352 If REGEXP is a function, list dead groups that the function returns non-nil;
1353 if it is a string, only list groups matching REGEXP."
1354 (set-buffer gnus-group-buffer)
1355 (let ((buffer-read-only nil)
1356 (newsrc (cdr gnus-newsrc-alist))
1357 (lowest (or lowest 1))
1358 (not-in-list (and gnus-group-listed-groups
1359 (copy-sequence gnus-group-listed-groups)))
1360 info clevel unread group params)
1362 (when (or (< lowest gnus-level-zombie)
1363 gnus-group-listed-groups)
1364 ;; List living groups.
1366 (setq info (car newsrc)
1367 group (gnus-info-group info)
1368 params (gnus-info-params info)
1370 unread (gnus-group-unread group))
1372 (setq not-in-list (delete group not-in-list)))
1373 (when (gnus-group-prepare-logic
1375 (and (or unread ; This group might be unchecked
1376 predicate) ; Check if this group should be listed
1377 (or (not (stringp regexp))
1378 (string-match regexp group))
1379 (<= (setq clevel (gnus-info-level info)) level)
1382 ((functionp predicate)
1383 (funcall predicate info))
1384 (predicate t) ; We list all groups?
1387 (if (eq unread t) ; Unactivated?
1388 gnus-group-list-inactive-groups
1389 ; We list unactivated
1390 (and (numberp unread) (> unread 0)))
1391 ; We list groups with unread articles
1392 (and gnus-list-groups-with-ticked-articles
1393 (cdr (assq 'tick (gnus-info-marks info))))
1394 ; And groups with tickeds
1395 ;; Check for permanent visibility.
1396 (and gnus-permanently-visible-groups
1397 (string-match gnus-permanently-visible-groups
1399 (memq 'visible params)
1400 (cdr (assq 'visible params)))))))
1401 (gnus-group-insert-group-line
1402 group (gnus-info-level info)
1403 (gnus-info-marks info) unread (gnus-info-method info)))))
1405 ;; List dead groups.
1406 (when (or gnus-group-listed-groups
1407 (and (>= level gnus-level-zombie)
1408 (<= lowest gnus-level-zombie)))
1409 (gnus-group-prepare-flat-list-dead
1410 (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
1411 gnus-level-zombie ?Z
1414 (dolist (group gnus-zombie-list)
1415 (setq not-in-list (delete group not-in-list))))
1416 (when (or gnus-group-listed-groups
1417 (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
1418 (gnus-group-prepare-flat-list-dead
1421 (setq gnus-killed-list (sort gnus-killed-list 'string<)))
1422 gnus-level-killed ?K regexp))
1424 (gnus-group-set-mode-line)
1425 (setq gnus-group-list-mode (cons level predicate))
1426 (gnus-run-hooks 'gnus-group-prepare-hook)
1429 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
1430 ;; List zombies and killed lists somewhat faster, which was
1431 ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
1432 ;; this by ignoring the group format specification altogether.
1434 (if (> (length groups) gnus-group-listing-limit)
1436 (setq group (pop groups))
1437 (when (gnus-group-prepare-logic
1440 (and (stringp regexp) (string-match regexp group))
1441 (and (functionp regexp) (funcall regexp group))))
1442 (gnus-add-text-properties
1443 (point) (prog1 (1+ (point))
1444 (insert " " mark " *: "
1445 (gnus-group-decoded-name group)
1447 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
1449 'gnus-level level))))
1451 (setq group (pop groups))
1452 (when (gnus-group-prepare-logic
1455 (and (stringp regexp) (string-match regexp group))
1456 (and (functionp regexp) (funcall regexp group))))
1457 (gnus-group-insert-group-line
1459 (let ((active (gnus-active group)))
1461 (if (zerop (cdr active))
1463 (- (1+ (cdr active)) (car active)))
1465 (gnus-method-simplify (gnus-find-method-for-group group))))))))
1467 (defun gnus-group-update-group-line ()
1468 "Update the current line in the group buffer."
1469 (let* ((buffer-read-only nil)
1470 (group (gnus-group-group-name))
1471 (entry (and group (gnus-group-entry group)))
1472 gnus-group-indentation)
1475 (not (gnus-ephemeral-group-p group))
1477 (concat "(gnus-group-set-info '"
1478 (gnus-prin1-to-string (nth 2 entry))
1480 (setq gnus-group-indentation (gnus-group-group-indentation))
1482 (gnus-group-insert-group-line-info group)
1484 (gnus-group-position-point))))
1486 (defun gnus-group-insert-group-line-info (group)
1487 "Insert GROUP on the current line."
1488 (let ((entry (gnus-group-entry group))
1489 (gnus-group-indentation (gnus-group-group-indentation))
1493 ;; (Un)subscribed group.
1494 (setq info (nth 2 entry))
1495 (gnus-group-insert-group-line
1496 group (gnus-info-level info) (gnus-info-marks info)
1497 (or (car entry) t) (gnus-info-method info)))
1498 ;; This group is dead.
1499 (gnus-group-insert-group-line
1501 (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
1503 (if (setq active (gnus-active group))
1504 (if (zerop (cdr active))
1506 (- (1+ (cdr active)) (car active)))
1508 (gnus-method-simplify (gnus-find-method-for-group group))))))
1510 (defun gnus-number-of-unseen-articles-in-group (group)
1511 (let* ((info (nth 2 (gnus-group-entry group)))
1512 (marked (gnus-info-marks info))
1513 (seen (cdr (assq 'seen marked)))
1514 (active (gnus-active group)))
1517 (length (gnus-uncompress-range
1518 (gnus-range-difference
1519 (gnus-range-difference (list active) (gnus-info-read info))
1522 ;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
1523 ;; update the state (enabled/disabled) of the icon `gnus-group-describe-group'
1524 ;; automatically. After `C-l' the state is correct. See the following report
1526 ;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>:
1527 ;; From: Reiner Steib
1528 ;; Subject: tool bar icons not updated according to :active condition
1529 ;; Newsgroups: gmane.emacs.devel
1530 ;; Date: Mon, 23 Jan 2006 19:59:13 +0100
1531 ;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de>
1533 (defcustom gnus-group-update-tool-bar
1534 (and (not (featurep 'xemacs))
1535 (boundp 'tool-bar-mode)
1537 ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs 21 might
1538 ;; be confusing, so maybe we shouldn't call it by default.
1539 (fboundp 'force-window-update))
1540 "Force updating the group buffer tool bar."
1543 :initialize 'custom-initialize-default
1544 :set (lambda (symbol value)
1545 (set-default symbol value)
1546 (when (gnus-alive-p)
1547 (with-current-buffer gnus-group-buffer
1548 ;; FIXME: Is there a better way to redraw the group buffer?
1549 (gnus-group-get-new-news 0))))
1552 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
1553 gnus-tmp-marked number
1555 "Insert a group line in the group buffer."
1556 (let* ((gnus-tmp-method
1557 (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
1558 (group-name-charset (gnus-group-name-charset gnus-tmp-method
1560 (gnus-tmp-active (gnus-active gnus-tmp-group))
1561 (gnus-tmp-number-total
1563 (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
1565 (gnus-tmp-number-of-unread
1566 (if (numberp number) (int-to-string (max 0 number))
1568 (gnus-tmp-number-of-read
1569 (if (numberp number)
1570 (int-to-string (max 0 (- gnus-tmp-number-total number)))
1572 (gnus-tmp-subscribed
1573 (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
1574 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
1575 ((= gnus-tmp-level gnus-level-zombie) ?Z)
1577 (gnus-tmp-qualified-group
1578 (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
1579 group-name-charset))
1581 (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
1583 (gnus-tmp-newsgroup-description
1584 (if gnus-description-hashtb
1585 (or (gnus-group-name-decode
1586 (gnus-gethash gnus-tmp-group gnus-description-hashtb)
1587 group-name-charset) "")
1590 (if (and gnus-moderated-hashtb
1591 (gnus-gethash gnus-tmp-group gnus-moderated-hashtb))
1593 (gnus-tmp-moderated-string
1594 (if (eq gnus-tmp-moderated ?m) "(m)" ""))
1595 (gnus-tmp-group-icon "==&&==")
1596 (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
1597 (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
1598 (gnus-tmp-news-method-string
1600 (format "(%s:%s)" (car gnus-tmp-method)
1601 (cadr gnus-tmp-method)) ""))
1602 (gnus-tmp-marked-mark
1603 (if (and (numberp number)
1605 (cdr (assq 'tick gnus-tmp-marked)))
1607 (gnus-tmp-summary-live
1608 (if (and (not gnus-group-is-exiting-p)
1609 (gnus-buffer-live-p (gnus-summary-buffer-name
1612 (gnus-tmp-process-marked
1613 (if (member gnus-tmp-group gnus-group-marked)
1614 gnus-process-mark ? ))
1615 (buffer-read-only nil)
1617 header gnus-tmp-header) ; passed as parameter to user-funcs.
1620 (gnus-add-text-properties
1624 (let ((gnus-tmp-decoded-group (gnus-group-name-decode
1625 gnus-tmp-group group-name-charset)))
1626 (eval gnus-group-line-format-spec)))
1627 `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
1628 gnus-unread ,(if (numberp number)
1629 (string-to-number gnus-tmp-number-of-unread)
1631 gnus-marked ,gnus-tmp-marked-mark
1632 gnus-indentation ,gnus-group-indentation
1633 gnus-level ,gnus-tmp-level))
1635 (when gnus-group-update-tool-bar
1636 (gnus-put-text-property beg end 'point-entered
1637 'gnus-tool-bar-update)
1638 (gnus-put-text-property beg end 'point-left
1639 'gnus-tool-bar-update))
1641 (when (inline (gnus-visual-p 'group-highlight 'highlight))
1642 (gnus-run-hooks 'gnus-group-update-hook))
1644 ;; Allow XEmacs to remove front-sticky text properties.
1645 (gnus-group-remove-excess-properties)))
1647 (defun gnus-group-highlight-line ()
1648 "Highlight the current line according to `gnus-group-highlight'."
1649 (let* ((list gnus-group-highlight)
1651 (end (point-at-eol))
1652 ;; now find out where the line starts and leave point there.
1653 (beg (progn (beginning-of-line) (point)))
1654 (group (gnus-group-group-name))
1655 (entry (gnus-group-entry group))
1656 (unread (if (numberp (car entry)) (car entry) 0))
1657 (active (gnus-active group))
1658 (total (if active (1+ (- (cdr active) (car active))) 0))
1659 (info (nth 2 entry))
1660 (method (inline (gnus-server-get-method group (gnus-info-method info))))
1661 (marked (gnus-info-marks info))
1662 (mailp (apply 'append
1665 (memq x (assoc (symbol-name
1666 (car (or method gnus-select-method)))
1667 gnus-valid-select-methods)))
1668 '(mail post-mail))))
1669 (level (or (gnus-info-level info) gnus-level-killed))
1670 (score (or (gnus-info-score info) 0))
1671 (ticked (gnus-range-length (cdr (assq 'tick marked))))
1672 (group-age (gnus-group-timestamp-delta group))
1673 (inhibit-read-only t))
1674 ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
1675 ;; ======================================================================
1676 ;; From: Richard Stallman
1677 ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
1678 ;; Cc: ding@gnus.org
1679 ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
1680 ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
1683 ;; The kludge is that the alist elements contain expressions that refer
1684 ;; to local variables with short names. Perhaps write your own tiny
1685 ;; evaluator that handles just `and', `or', and numeric comparisons
1686 ;; and just a few specific variables.
1687 ;; ======================================================================
1689 ;; Similar for other evaluated variables. Grep for risky-local-variable
1690 ;; to find them! -- rsteib
1692 ;; Eval the cars of the lists until we find a match.
1694 (not (eval (caar list))))
1695 (setq list (cdr list)))
1696 (let ((face (cdar list)))
1697 (unless (eq face (get-text-property beg 'face))
1698 (gnus-put-text-property-excluding-characters-with-faces
1700 (setq face (if (boundp face) (symbol-value face) face)))
1701 (gnus-extent-start-open beg)))
1704 (defun gnus-group-update-group (group &optional visible-only)
1705 "Update all lines where GROUP appear.
1706 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
1708 ;; Can't use `save-excursion' here, so we do it manually.
1709 (let ((buf (current-buffer))
1711 (set-buffer gnus-group-buffer)
1712 (setq mark (point-marker))
1713 ;; The buffer may be narrowed.
1716 (let ((ident (gnus-intern-safe group gnus-active-hashtb))
1718 found buffer-read-only)
1719 ;; Enter the current status into the dribble buffer.
1720 (let ((entry (gnus-group-entry group)))
1722 (not (gnus-ephemeral-group-p group)))
1724 (concat "(gnus-group-set-info '"
1725 (gnus-prin1-to-string (nth 2 entry))
1727 ;; Find all group instances. If topics are in use, each group
1728 ;; may be listed in more than once.
1729 (while (setq loc (text-property-any
1730 loc (point-max) 'gnus-group ident))
1733 (let ((gnus-group-indentation (gnus-group-group-indentation)))
1735 (gnus-group-insert-group-line-info group)
1738 (gnus-run-hooks 'gnus-group-update-group-hook)))
1739 (setq loc (1+ loc)))
1740 (unless (or found visible-only)
1741 ;; No such line in the buffer, find out where it's supposed to
1742 ;; go, and insert it there (or at the end of the buffer).
1743 (if gnus-goto-missing-group-function
1744 (funcall gnus-goto-missing-group-function group)
1745 (let ((entry (cddr (gnus-group-entry group))))
1746 (while (and entry (car entry)
1750 (point-min) (point-max)
1751 'gnus-group (gnus-intern-safe
1752 (caar entry) gnus-active-hashtb)))))
1753 (setq entry (cdr entry)))
1754 (or entry (goto-char (point-max)))))
1755 ;; Finally insert the line.
1756 (let ((gnus-group-indentation (gnus-group-group-indentation)))
1757 (gnus-group-insert-group-line-info group)
1760 (gnus-run-hooks 'gnus-group-update-group-hook))))
1761 (when gnus-group-update-group-function
1762 (funcall gnus-group-update-group-function group))
1763 (gnus-group-set-mode-line)))
1765 (set-marker mark nil)
1768 (defun gnus-group-set-mode-line ()
1769 "Update the mode line in the group buffer."
1770 (when (memq 'group gnus-updated-mode-lines)
1771 ;; Yes, we want to keep this mode line updated.
1773 (set-buffer gnus-group-buffer)
1774 (let* ((gformat (or gnus-group-mode-line-format-spec
1775 (gnus-set-format 'group-mode)))
1776 (gnus-tmp-news-server (cadr gnus-select-method))
1777 (gnus-tmp-news-method (car gnus-select-method))
1778 (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
1780 gnus-tmp-header ;Dummy binding for user-defined formats
1781 ;; Get the resulting string.
1783 (and gnus-dribble-buffer
1784 (buffer-name gnus-dribble-buffer)
1785 (buffer-modified-p gnus-dribble-buffer)
1787 (set-buffer gnus-dribble-buffer)
1788 (not (zerop (buffer-size))))))
1789 (mode-string (eval gformat)))
1790 ;; Say whether the dribble buffer has been modified.
1791 (setq mode-line-modified
1792 (if modified (car gnus-mode-line-modified)
1793 (cdr gnus-mode-line-modified)))
1794 ;; If the line is too long, we chop it off.
1795 (when (> (length mode-string) max-len)
1796 (setq mode-string (substring mode-string 0 (- max-len 4))))
1798 (setq mode-line-buffer-identification
1799 (gnus-mode-line-buffer-identification
1800 (list mode-string)))
1801 (set-buffer-modified-p modified))))))
1803 (defun gnus-group-group-name ()
1804 "Get the name of the newsgroup on the current line."
1805 (let ((group (get-text-property (point-at-bol) 'gnus-group)))
1807 (symbol-name group))))
1809 (defun gnus-group-group-level ()
1810 "Get the level of the newsgroup on the current line."
1811 (get-text-property (point-at-bol) 'gnus-level))
1813 (defun gnus-group-group-indentation ()
1814 "Get the indentation of the newsgroup on the current line."
1815 (or (get-text-property (point-at-bol) 'gnus-indentation)
1816 (and gnus-group-indentation-function
1817 (funcall gnus-group-indentation-function))
1820 (defun gnus-group-group-unread ()
1821 "Get the number of unread articles of the newsgroup on the current line."
1822 (get-text-property (point-at-bol) 'gnus-unread))
1824 (defun gnus-group-new-mail (group)
1825 (if (nnmail-new-mail-p (gnus-group-real-name group))
1829 (defun gnus-group-level (group)
1830 "Return the estimated level of GROUP."
1831 (or (gnus-info-level (gnus-get-info group))
1832 (and (member group gnus-zombie-list) gnus-level-zombie)
1835 (defun gnus-group-search-forward (&optional backward all level first-too)
1836 "Find the next newsgroup with unread articles.
1837 If BACKWARD is non-nil, find the previous newsgroup instead.
1838 If ALL is non-nil, just find any newsgroup.
1839 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
1841 If FIRST-TOO, the current line is also eligible as a target."
1842 (let ((way (if backward -1 1))
1843 (low gnus-level-killed)
1846 (if (and backward (progn (beginning-of-line)) (bobp))
1855 (get-text-property (point) 'gnus-group)
1859 (get-text-property (point) 'gnus-unread)))
1860 (and (numberp unread) (> unread 0)))
1861 (setq lev (get-text-property (point)
1863 (<= lev gnus-level-subscribed)))
1865 (and (setq lev (get-text-property (point)
1874 (zerop (forward-line way)))))
1876 (progn (gnus-group-position-point) t)
1877 (goto-char (or pos beg))
1880 (defun gnus-total-fetched-for (group)
1881 (let* ((size-in-cache (or (gnus-cache-total-fetched-for group) 0))
1882 (size-in-agent (or (gnus-agent-total-fetched-for group) 0))
1883 (size (+ size-in-cache size-in-agent))
1884 (suffix '("B" "K" "M" "G"))
1887 (while (> size cutoff)
1888 (setq size (/ size scale)
1889 suffix (cdr suffix)))
1890 (format "%5.1f%s" size (car suffix))))
1892 ;;; Gnus group mode commands
1896 (defun gnus-group-mark-line-p ()
1899 (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
1900 (eq (char-after) gnus-process-mark)))
1902 (defun gnus-group-mark-group (n &optional unmark no-advance)
1903 "Mark the current group."
1905 (let ((buffer-read-only nil)
1909 (when (setq group (gnus-group-group-name))
1910 ;; Go to the mark position.
1912 (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
1916 (setq gnus-group-marked (delete group gnus-group-marked))
1917 (insert-char ? 1 t))
1918 (setq gnus-group-marked
1919 (cons group (delete group gnus-group-marked)))
1920 (insert-char gnus-process-mark 1 t)))
1922 (gnus-group-next-group 1))
1924 (gnus-summary-position-point)
1927 (defun gnus-group-unmark-group (n)
1928 "Remove the mark from the current group."
1930 (gnus-group-mark-group n 'unmark)
1931 (gnus-group-position-point))
1933 (defun gnus-group-unmark-all-groups ()
1934 "Unmark all groups."
1937 (mapc 'gnus-group-remove-mark gnus-group-marked))
1938 (gnus-group-position-point))
1940 (defun gnus-group-mark-region (unmark beg end)
1941 "Mark all groups between point and mark.
1942 If UNMARK, remove the mark instead."
1943 (interactive "P\nr")
1944 (let ((num (count-lines beg end)))
1947 (- num (gnus-group-mark-group num unmark)))))
1949 (defun gnus-group-mark-buffer (&optional unmark)
1950 "Mark all groups in the buffer.
1951 If UNMARK, remove the mark instead."
1953 (gnus-group-mark-region unmark (point-min) (point-max)))
1955 (defun gnus-group-mark-regexp (regexp)
1956 "Mark all groups that match some regexp."
1957 (interactive "sMark (regexp): ")
1958 (let ((alist (cdr gnus-newsrc-alist))
1962 (when (string-match regexp (setq group (gnus-info-group (pop alist))))
1963 (gnus-group-jump-to-group group)
1964 (gnus-group-set-mark group)))))
1965 (gnus-group-position-point))
1967 (defun gnus-group-remove-mark (group &optional test-marked)
1968 "Remove the process mark from GROUP and move point there.
1969 Return nil if the group isn't displayed."
1970 (if (gnus-group-goto-group group nil test-marked)
1972 (gnus-group-mark-group 1 'unmark t)
1974 (setq gnus-group-marked
1975 (delete group gnus-group-marked))
1978 (defun gnus-group-set-mark (group)
1979 "Set the process mark on GROUP."
1980 (if (gnus-group-goto-group group)
1982 (gnus-group-mark-group 1 nil t))
1983 (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
1985 (defun gnus-group-universal-argument (arg &optional groups func)
1986 "Perform any command on all groups according to the process/prefix convention."
1988 (if (eq (setq func (or func
1991 (substitute-command-keys
1992 "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
1994 (gnus-error 1 "Undefined key")
1995 (gnus-group-iterate arg
1997 (command-execute func))))
1998 (gnus-group-position-point))
2000 (defun gnus-group-process-prefix (n)
2001 "Return a list of groups to work on.
2002 Take into consideration N (the prefix) and the list of marked groups."
2005 (setq n (prefix-numeric-value n))
2006 ;; There is a prefix, so we return a list of the N next
2008 (let ((way (if (< n 0) -1 1))
2013 (if (setq group (gnus-group-group-name))
2014 (push group groups))
2016 (gnus-group-next-group way)))
2018 ((and (gnus-region-active-p) (mark))
2019 ;; Work on the region between point and mark.
2020 (let ((max (max (point) (mark)))
2023 (goto-char (min (point) (mark)))
2026 (push (gnus-group-group-name) groups)
2027 (zerop (gnus-group-next-group 1))
2029 (nreverse groups))))
2031 ;; No prefix, but a list of marked articles.
2032 (reverse gnus-group-marked))
2034 ;; Neither marked articles or a prefix, so we return the
2036 (let ((group (gnus-group-group-name)))
2037 (and group (list group))))))
2039 ;;; !!!Surely gnus-group-iterate should be a macro instead? I can't
2040 ;;; imagine why I went through these contortions...
2042 (let ((function (make-symbol "gnus-group-iterate-function"))
2043 (window (make-symbol "gnus-group-iterate-window"))
2044 (groups (make-symbol "gnus-group-iterate-groups"))
2045 (group (make-symbol "gnus-group-iterate-group")))
2047 `(defun gnus-group-iterate (arg ,function)
2048 "Iterate FUNCTION over all process/prefixed groups.
2049 FUNCTION will be called with the group name as the parameter
2050 and with point over the group in question."
2051 (let ((,groups (gnus-group-process-prefix arg))
2052 (,window (selected-window))
2055 (setq ,group (car ,groups)
2056 ,groups (cdr ,groups))
2057 (select-window ,window)
2058 (gnus-group-remove-mark ,group)
2059 (save-selected-window
2061 (funcall ,function ,group)))))))))
2063 (put 'gnus-group-iterate 'lisp-indent-function 1)
2065 ;; Selecting groups.
2067 (defun gnus-group-read-group (&optional all no-article group select-articles)
2068 "Read news in this newsgroup.
2069 If the prefix argument ALL is non-nil, already read articles become
2072 If ALL is a positive number, fetch this number of the latest
2073 articles in the group. If ALL is a negative number, fetch this
2074 number of the earliest articles in the group.
2076 If the optional argument NO-ARTICLE is non-nil, no article will
2077 be auto-selected upon group entry. If GROUP is non-nil, fetch
2080 (let ((no-display (eq all 0))
2081 (group (or group (gnus-group-group-name)))
2082 number active marked entry)
2086 (error "No group on current line"))
2087 (setq marked (gnus-info-marks
2088 (nth 2 (setq entry (gnus-group-entry group)))))
2089 ;; This group might be a dead group. In that case we have to get
2090 ;; the number of unread articles from `gnus-active-hashtb'.
2092 (cond ((numberp all) all)
2094 ((setq active (gnus-active group))
2095 (- (1+ (cdr active)) (car active)))))
2096 (gnus-summary-read-group
2097 group (or all (and (numberp number)
2098 (zerop (+ number (gnus-range-length
2099 (cdr (assq 'tick marked)))
2101 (cdr (assq 'dormant marked)))))))
2102 no-article nil no-display nil select-articles)))
2104 (defun gnus-group-select-group (&optional all)
2105 "Select this newsgroup.
2106 No article is selected automatically.
2107 If the group is opened, just switch the summary buffer.
2108 If ALL is non-nil, already read articles become readable.
2109 If ALL is a positive number, fetch this number of the latest
2110 articles in the group.
2111 If ALL is a negative number, fetch this number of the earliest
2112 articles in the group."
2114 (when (and (eobp) (not (gnus-group-group-name)))
2116 (gnus-group-read-group all t))
2118 (defun gnus-group-quick-select-group (&optional all group)
2119 "Select the GROUP \"quickly\".
2120 This means that no highlighting or scoring will be performed. If
2121 ALL (the prefix argument) is 0, don't even generate the summary
2122 buffer. If GROUP is nil, use current group.
2124 This might be useful if you want to toggle threading
2125 before entering the group."
2127 (require 'gnus-score)
2129 gnus-score-find-score-files-function
2130 gnus-home-score-file
2131 gnus-apply-kill-hook
2132 gnus-summary-expunge-below)
2133 (gnus-group-read-group all t group)))
2135 (defun gnus-group-visible-select-group (&optional all)
2136 "Select the current group without hiding any articles."
2138 (let ((gnus-inhibit-limiting t))
2139 (gnus-group-read-group all t)))
2141 (defun gnus-group-select-group-ephemerally ()
2142 "Select the current group without doing any processing whatsoever.
2143 You will actually be entered into a group that's a copy of
2144 the current group; no changes you make while in this group will
2147 (require 'gnus-score)
2149 gnus-score-find-score-files-function gnus-apply-kill-hook
2150 gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates
2151 gnus-summary-mode-hook gnus-select-group-hook
2152 (group (gnus-group-group-name))
2153 (method (gnus-find-method-for-group group)))
2154 (gnus-group-read-ephemeral-group
2155 (gnus-group-prefixed-name group method) method)))
2157 (defun gnus-group-name-at-point ()
2158 "Return a group name from around point if it exists, or nil."
2159 (if (eq major-mode 'gnus-group-mode)
2160 (let ((group (gnus-group-group-name)))
2162 (gnus-group-decoded-name group)))
2163 (let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\
2164 \\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\
2165 \[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\
2166 \\|[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)+\\)")
2168 (case-fold-search nil))
2170 (if (or (and (not (or (eobp)
2171 (looking-at "[][\C-@-*,/;-@\\^`{-\C-?]")))
2173 (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2175 (and (looking-at "[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*$")
2177 (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?")
2178 (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2180 (string-match "\\`[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*\\'"
2181 (buffer-substring (point-at-bol) (point))))
2182 (when (looking-at regexp)
2184 (let (group distance)
2185 (when (looking-at regexp)
2186 (setq group (match-string 1)
2187 distance (- (match-beginning 1) (match-beginning 0))))
2188 (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?")
2189 (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
2191 (if (looking-at regexp)
2192 (if (and group (<= distance (- start (match-end 0))))
2196 (goto-char start)))))
2198 (defun gnus-group-completing-read (prompt &optional collection predicate
2199 require-match initial-input hist def
2201 "Read a group name with completion. Non-ASCII group names are allowed.
2202 The arguments are the same as `completing-read' except that COLLECTION
2203 and HIST default to `gnus-active-hashtb' and `gnus-group-history'
2204 respectively if they are omitted."
2205 (let ((completion-styles (and (boundp 'completion-styles)
2208 (push 'substring completion-styles)
2209 (mapatoms (lambda (symbol)
2210 (setq group (symbol-name symbol))
2211 (set (intern (if (string-match "[^\000-\177]" group)
2212 (gnus-group-decoded-name group)
2218 (setq collection (or gnus-active-hashtb [0])))
2219 (setq collection (gnus-make-hashtable (length collection)))))
2220 (setq group (apply 'completing-read prompt collection predicate
2221 require-match initial-input
2222 (or hist 'gnus-group-history)
2225 (symbol-value (intern-soft group collection))
2226 (setq collection nil))
2227 (mm-encode-coding-string group (gnus-group-name-charset nil group)))))
2230 (defun gnus-fetch-group (group &optional articles)
2231 "Start Gnus if necessary and enter GROUP.
2232 If ARTICLES, display those articles.
2233 Returns whether the fetching was successful or not."
2234 (interactive (list (gnus-group-completing-read "Group name: "
2236 (gnus-group-name-at-point))))
2237 (unless (gnus-alive-p)
2239 (gnus-group-read-group (if articles nil t) nil group articles))
2242 (defun gnus-fetch-group-other-frame (group)
2243 "Pop up a frame and enter GROUP."
2245 (let ((window (get-buffer-window gnus-group-buffer)))
2247 (select-frame (window-frame window)))
2248 ((= (length (frame-list)) 1)
2249 (select-frame (make-frame)))
2252 (gnus-fetch-group group))
2254 (defvar gnus-ephemeral-group-server 0)
2256 (defcustom gnus-large-ephemeral-newsgroup 200
2257 "The number of articles which indicates a large ephemeral newsgroup.
2258 Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups.
2260 If the number of articles in a newsgroup is greater than this value,
2261 confirmation is required for selecting the newsgroup. If it is nil, no
2262 confirmation is required."
2264 :group 'gnus-group-select
2265 :type '(choice (const :tag "No limit" nil)
2268 (defcustom gnus-fetch-old-ephemeral-headers nil
2269 "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups."
2272 :type '(choice (const :tag "off" nil)
2275 (sexp :menu-tag "other" t)))
2277 ;; Enter a group that is not in the group buffer. Non-nil is returned
2278 ;; if selection was successful.
2279 (defun gnus-group-read-ephemeral-group (group method &optional activate
2280 quit-config request-only
2284 "Read GROUP from METHOD as an ephemeral group.
2285 If ACTIVATE, request the group first.
2286 If QUIT-CONFIG, use that window configuration when exiting from the
2288 If REQUEST-ONLY, don't actually read the group; just request it.
2289 If SELECT-ARTICLES, only select those articles.
2290 If PARAMETERS, use those as the group parameters.
2291 If NUMBER, fetch this number of articles.
2293 Return the name of the group if selection was successful."
2296 ;; (gnus-read-group "Group name: ")
2297 (gnus-group-completing-read "Group: ")
2298 (gnus-read-method "From method: ")))
2299 ;; Transform the select method into a unique server.
2300 (when (stringp method)
2301 (setq method (gnus-server-to-method method)))
2303 `(,(car method) ,(concat (cadr method) "-ephemeral")
2304 (,(intern (format "%s-address" (car method))) ,(cadr method))
2306 (let ((group (if (gnus-group-foreign-p group) group
2307 (gnus-group-prefixed-name (gnus-group-real-name group)
2312 ,gnus-level-default-subscribed nil nil ,method
2315 (cons 'quit-config quit-config)
2317 (cons gnus-summary-buffer
2318 gnus-current-window-configuration)))
2321 (push method gnus-ephemeral-servers)
2322 (set-buffer gnus-group-buffer)
2323 (unless (gnus-check-server method)
2324 (error "Unable to contact server: %s" (gnus-status-message method)))
2326 (gnus-activate-group group 'scan)
2327 (unless (gnus-request-group group)
2328 (error "Couldn't request group: %s"
2329 (nnheader-get-report (car method)))))
2333 (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup)
2334 (gnus-fetch-old-headers
2335 gnus-fetch-old-ephemeral-headers))
2336 (gnus-group-read-group (or number t) t group select-articles))
2340 (message "Quit reading the ephemeral group")
2343 (defcustom gnus-gmane-group-download-format
2344 "http://download.gmane.org/%s/%s/%s"
2345 "URL for downloading mbox files.
2346 It must contain three \"%s\". They correspond to the group, the
2347 minimal and maximal article numbers, respectively."
2348 :group 'gnus-group-foreign
2349 :version "23.1" ;; No Gnus
2352 (autoload 'url-insert-file-contents "url-handlers")
2354 ;; - Add documentation, menu, key bindings, ...
2356 (defun gnus-read-ephemeral-gmane-group (group start &optional range)
2357 "Read articles from Gmane group GROUP as an ephemeral group.
2358 START is the first article. RANGE specifies how many articles
2359 are fetched. The articles are downloaded via HTTP using the URL
2360 specified by `gnus-gmane-group-download-format'."
2361 ;; See <http://gmane.org/export.php> for more information.
2364 (gnus-group-completing-read "Gmane group: ")
2365 (read-number "Start article number: ")
2366 (read-number "How many articles: ")))
2367 (unless range (setq range 500))
2369 (error "Invalid range: %s" range))
2370 (let ((tmpfile (mm-make-temp-file
2371 (format "%s.start-%s.range-%s." group start range)))
2372 (gnus-thread-sort-functions '(gnus-thread-sort-by-number)))
2373 (with-temp-file tmpfile
2374 (url-insert-file-contents
2375 (format gnus-gmane-group-download-format
2376 group start (+ start range)))
2377 (write-region (point-min) (point-max) tmpfile)
2378 (gnus-group-read-ephemeral-group
2379 (format "%s.start-%s.range-%s" group start range)
2381 (nndoc-article-type mbox))))
2382 (delete-file tmpfile)))
2384 (defun gnus-read-ephemeral-gmane-group-url (url)
2385 "Create an ephemeral Gmane group from URL.
2387 Valid input formats include:
2388 \"http://thread.gmane.org/gmane.foo.bar/12300/focus=12399\",
2389 \"http://thread.gmane.org/gmane.foo.bar/12345/\",
2390 \"http://article.gmane.org/gmane.foo.bar/12345/\",
2391 \"http://news.gmane.org/group/gmane.foo.bar/thread=12345\""
2392 ;; - Feel free to add other useful Gmane URLs here! Maybe the URLs should
2394 ;; - The URLs should be added to `gnus-button-alist'. Probably we should
2395 ;; prompt the user to decide: "View via `browse-url' or in Gnus? "
2396 ;; (`gnus-read-ephemeral-gmane-group-url')
2398 (list (gnus-group-completing-read "Gmane URL: ")))
2399 (let (group start range)
2401 ;; URLs providing `group', `start' and `range':
2403 ;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525
2404 "^http://thread\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$"
2406 (setq group (match-string 1 url)
2407 start (string-to-number (match-string 2 url))
2408 ;; Ensure that `range' is large enough to ensure focus article is
2410 range (- (string-to-number (match-string 3 url))
2412 ;; URLs providing `group' and `start':
2414 ;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584
2415 "^http://\\(?:thread\\|article\\|permalink\\)\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
2418 ;; Don't advertise these in the doc string yet:
2419 "^\\(?:nntp\\|news\\)://news\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
2422 ;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t
2423 "^http://news\.gmane\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)"
2425 (setq group (match-string 1 url)
2426 start (string-to-number (match-string 2 url))))
2428 (error "Can't parse URL %s" url)))
2429 (gnus-read-ephemeral-gmane-group group start range)))
2431 (defcustom gnus-bug-group-download-format-alist
2432 '((emacs . "http://debbugs.gnu.org/%s;mbox=yes")
2434 . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes"))
2435 "Alist of symbols for bug trackers and the corresponding URL format string.
2436 The URL format string must contain a single \"%s\", specifying
2437 the bug number, and browsing the URL must return mbox output."
2438 :group 'gnus-group-foreign
2439 :version "23.2" ;; No Gnus
2440 :type '(repeat (cons (symbol) (string :tag "URL format string"))))
2442 (defun gnus-read-ephemeral-bug-group (number mbox-url)
2443 "Browse bug NUMBER as ephemeral group."
2444 (interactive (list (read-string "Enter bug number: "
2445 (thing-at-point 'word) nil)
2446 ;; FIXME: Add completing-read from
2447 ;; `gnus-emacs-bug-group-download-format' ...
2448 (cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
2449 (when (stringp number)
2450 (setq number (string-to-number number)))
2451 (let ((tmpfile (mm-make-temp-file "gnus-temp-group-")))
2452 (with-temp-file tmpfile
2453 (url-insert-file-contents (format mbox-url number))
2454 (write-region (point-min) (point-max) tmpfile)
2455 (gnus-group-read-ephemeral-group
2456 "gnus-read-ephemeral-bug"
2458 (nndoc-article-type mbox))))
2459 (delete-file tmpfile)))
2461 (defun gnus-read-ephemeral-debian-bug-group (number)
2462 "Browse Debian bug NUMBER as ephemeral group."
2463 (interactive (list (read-string "Enter bug number: "
2464 (thing-at-point 'word) nil)))
2465 (gnus-read-ephemeral-bug-group
2467 (cdr (assoc 'debian gnus-bug-group-download-format-alist))))
2469 (defun gnus-read-ephemeral-emacs-bug-group (number)
2470 "Browse Emacs bug NUMBER as ephemeral group."
2471 (interactive (list (read-string "Enter bug number: "
2472 (thing-at-point 'word) nil)))
2473 (gnus-read-ephemeral-bug-group
2475 (cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
2477 (defun gnus-group-jump-to-group (group &optional prompt)
2478 "Jump to newsgroup GROUP.
2480 If PROMPT (the prefix) is a number, use the prompt specified in
2481 `gnus-group-jump-to-group-prompt'."
2483 (list (gnus-group-completing-read
2484 "Group: " nil nil (gnus-read-active-file-p)
2485 (if current-prefix-arg
2486 (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
2487 (or (and (stringp gnus-group-jump-to-group-prompt)
2488 gnus-group-jump-to-group-prompt)
2489 (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
2490 (and (stringp p) p)))))))
2492 (when (equal group "")
2493 (error "Empty group name"))
2495 (unless (gnus-ephemeral-group-p group)
2496 ;; Either go to the line in the group buffer...
2497 (unless (gnus-group-goto-group group)
2498 ;; ... or insert the line.
2499 (gnus-group-update-group group)
2500 (gnus-group-goto-group group)))
2501 ;; Adjust cursor point.
2502 (gnus-group-position-point))
2504 (defun gnus-group-goto-group (group &optional far test-marked)
2505 "Goto to newsgroup GROUP.
2506 If FAR, it is likely that the group is not on the current line.
2507 If TEST-MARKED, the line must be marked."
2511 ;; It's quite likely that we are on the right line, so
2512 ;; we check the current line first.
2514 (eq (get-text-property (point) 'gnus-group)
2515 (gnus-intern-safe group gnus-active-hashtb))
2516 (or (not test-marked) (gnus-group-mark-line-p)))
2518 ;; Previous and next line are also likely, so we check them as well.
2522 (and (eq (get-text-property (point) 'gnus-group)
2523 (gnus-intern-safe group gnus-active-hashtb))
2524 (or (not test-marked) (gnus-group-mark-line-p)))))
2530 (and (eq (get-text-property (point) 'gnus-group)
2531 (gnus-intern-safe group gnus-active-hashtb))
2532 (or (not test-marked) (gnus-group-mark-line-p)))))
2536 (goto-char (point-min))
2538 (while (and (not found)
2543 (gnus-intern-safe group gnus-active-hashtb))))
2544 (if (gnus-group-mark-line-p)
2549 ;; Search through the entire buffer.
2552 (point-min) (point-max)
2553 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))
2555 (defun gnus-group-next-group (n &optional silent)
2556 "Go to next N'th newsgroup.
2557 If N is negative, search backward instead.
2558 Returns the difference between N and the number of skips actually
2561 (gnus-group-next-unread-group n t nil silent))
2563 (defun gnus-group-next-unread-group (n &optional all level silent)
2564 "Go to next N'th unread newsgroup.
2565 If N is negative, search backward instead.
2566 If ALL is non-nil, choose any newsgroup, unread or not.
2567 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
2568 such group can be found, the next group with a level higher than
2570 Returns the difference between N and the number of skips actually
2573 (let ((backward (< n 0))
2576 (gnus-group-search-forward
2577 backward (or (not gnus-group-goto-unread) all) level))
2581 (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
2582 (if level " on this level or higher" "")))
2585 (defun gnus-group-prev-group (n)
2586 "Go to previous N'th newsgroup.
2587 Returns the difference between N and the number of skips actually
2590 (gnus-group-next-unread-group (- n) t))
2592 (defun gnus-group-prev-unread-group (n)
2593 "Go to previous N'th unread newsgroup.
2594 Returns the difference between N and the number of skips actually
2597 (gnus-group-next-unread-group (- n)))
2599 (defun gnus-group-next-unread-group-same-level (n)
2600 "Go to next N'th unread newsgroup on the same level.
2601 If N is negative, search backward instead.
2602 Returns the difference between N and the number of skips actually
2605 (gnus-group-next-unread-group n t (gnus-group-group-level))
2606 (gnus-group-position-point))
2608 (defun gnus-group-prev-unread-group-same-level (n)
2609 "Go to next N'th unread newsgroup on the same level.
2610 Returns the difference between N and the number of skips actually
2613 (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
2614 (gnus-group-position-point))
2616 (defun gnus-group-best-unread-group (&optional exclude-group)
2617 "Go to the group with the highest level.
2618 If EXCLUDE-GROUP, do not go to that group."
2620 (goto-char (point-min))
2624 (setq unread (get-text-property (point) 'gnus-unread))
2625 (when (and (numberp unread) (> unread 0))
2626 (when (and (get-text-property (point) 'gnus-level)
2627 (< (get-text-property (point) 'gnus-level) best)
2628 (or (not exclude-group)
2629 (not (equal exclude-group (gnus-group-group-name)))))
2630 (setq best (get-text-property (point) 'gnus-level))
2631 (setq best-point (point))))
2634 (goto-char best-point))
2635 (gnus-group-position-point)
2636 (and best-point (gnus-group-group-name))))
2638 ;; Is there something like an after-point-motion-hook?
2639 ;; (inhibit-point-motion-hooks?). Is there a tool-bar-update function?
2641 ;; (defun gnus-group-menu-bar-update ()
2642 ;; (let* ((buf (list (with-current-buffer gnus-group-buffer
2643 ;; (current-buffer))))
2644 ;; (name (buffer-name (car buf))))
2646 ;; (if (> (length name) 27)
2647 ;; (concat (substring name 0 12)
2649 ;; (substring name -12))
2651 ;; (menu-bar-update-buffers-1 buf)))
2653 ;; (defun gnus-group-position-point ()
2654 ;; (gnus-goto-colon)
2655 ;; (gnus-group-menu-bar-update))
2657 (defun gnus-group-first-unread-group ()
2658 "Go to the first group with unread articles."
2661 (let ((opoint (point))
2663 (goto-char (point-min))
2664 (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
2665 (and (numberp unread) ; Not a topic.
2666 (not (zerop unread))) ; Has unread articles.
2667 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
2670 nil)) ; Not success.
2671 (gnus-group-position-point)))
2673 (defun gnus-group-enter-server-mode ()
2674 "Jump to the server buffer."
2676 (gnus-enter-server-buffer))
2678 (defun gnus-group-make-group-simple (&optional group)
2679 "Add a new newsgroup.
2680 The user will be prompted for GROUP."
2681 (interactive (list (gnus-group-completing-read "Group: ")))
2682 (gnus-group-make-group (gnus-group-real-name group)
2683 (gnus-group-server group)
2686 (defun gnus-group-make-group (name &optional method address args encoded)
2687 "Add a new newsgroup.
2688 The user will be prompted for a NAME, for a select METHOD, and an
2689 ADDRESS. NAME should be a human-readable string (i.e., not be encoded
2690 even if it contains non-ASCII characters) unless ENCODED is non-nil."
2693 (gnus-read-group "Group name: ")
2694 (gnus-read-method "From method: ")))
2696 (when (stringp method)
2697 (setq method (or (gnus-server-to-method method) method)))
2699 (setq name (mm-encode-coding-string
2701 (gnus-group-name-charset method name))))
2702 (let* ((meth (gnus-method-simplify
2704 (not (gnus-server-equal method gnus-select-method)))
2705 (if address (list (intern method) address)
2707 (nname (if method (gnus-group-prefixed-name name meth) name))
2709 (when (gnus-group-entry nname)
2710 (error "Group %s already exists" (gnus-group-decoded-name nname)))
2711 ;; Subscribe to the new group.
2712 (gnus-group-change-level
2713 (setq info (list t nname gnus-level-default-subscribed nil nil meth))
2714 gnus-level-default-subscribed gnus-level-killed
2715 (and (gnus-group-group-name)
2716 (gnus-group-entry (gnus-group-group-name)))
2719 (gnus-set-active nname (cons 1 0))
2720 (unless (gnus-ephemeral-group-p name)
2722 (concat "(gnus-group-set-info '"
2723 (gnus-prin1-to-string (cdr info)) ")")))
2725 (gnus-group-insert-group-line-info nname)
2727 (gnus-group-position-point)
2729 ;; Load the back end and try to make the back end create
2730 ;; the group as well.
2731 (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
2733 gnus-valid-select-methods)
2735 (gnus-check-server meth)
2736 (when (gnus-check-backend-function 'request-create-group nname)
2737 (unless (gnus-request-create-group nname nil args)
2738 (error "Could not create group on server: %s"
2739 (nnheader-get-report backend))))
2742 (defun gnus-group-delete-groups (&optional arg)
2743 "Delete the current group. Only meaningful with editable groups."
2745 (let ((n (length (gnus-group-process-prefix arg))))
2746 (when (gnus-yes-or-no-p
2748 "Delete this 1 group? "
2749 (format "Delete these %d groups? " n)))
2750 (gnus-group-iterate arg
2752 (gnus-group-delete-group group nil t))))))
2754 (defun gnus-group-delete-group (group &optional force no-prompt)
2755 "Delete the current group. Only meaningful with editable groups.
2756 If FORCE (the prefix) is non-nil, all the articles in the group will
2757 be deleted. This is \"deleted\" as in \"removed forever from the face
2758 of the Earth\". There is no undo. The user will be prompted before
2760 Note that you also have to specify FORCE if you want the group to
2761 be removed from the server, even when it's empty."
2763 (list (gnus-group-group-name)
2764 current-prefix-arg))
2766 (error "No group to delete"))
2767 (unless (gnus-check-backend-function 'request-delete-group group)
2768 (error "This back end does not support group deletion"))
2770 (let ((group-decoded (gnus-group-decoded-name group)))
2771 (if (and (not no-prompt)
2772 (not (gnus-yes-or-no-p
2774 "Do you really want to delete %s%s? "
2775 group-decoded (if force " and all its contents" "")))))
2777 (gnus-message 6 "Deleting group %s..." group-decoded)
2778 (if (not (gnus-request-delete-group group force))
2779 (gnus-error 3 "Couldn't delete group %s" group-decoded)
2780 (gnus-message 6 "Deleting group %s...done" group-decoded)
2781 (gnus-group-goto-group group)
2782 (gnus-group-kill-group 1 t)
2783 (gnus-set-active group nil)
2785 (gnus-group-position-point)))
2787 (defun gnus-group-rename-group (group new-name)
2788 "Rename group from GROUP to NEW-NAME.
2789 When used interactively, GROUP is the group under point
2790 and NEW-NAME will be prompted for."
2792 (let ((group (gnus-group-group-name))
2794 (unless (gnus-check-backend-function 'request-rename-group group)
2795 (error "This back end does not support renaming groups"))
2796 (setq new-name (gnus-read-group
2798 (gnus-group-real-name (gnus-group-decoded-name group)))
2799 method (gnus-info-method (gnus-get-info group)))
2800 (list group (mm-encode-coding-string
2802 (gnus-group-name-charset
2804 (gnus-group-prefixed-name new-name method))))))
2806 (unless (gnus-check-backend-function 'request-rename-group group)
2807 (error "This back end does not support renaming groups"))
2809 (error "No group to rename"))
2810 (when (equal (gnus-group-real-name group) new-name)
2811 (error "Can't rename to the same name"))
2813 ;; We find the proper prefixed name.
2815 (if (gnus-group-native-p group)
2819 (gnus-group-prefixed-name
2820 (gnus-group-real-name new-name)
2821 (gnus-info-method (gnus-get-info group)))))
2823 (let ((decoded-group (gnus-group-decoded-name group))
2824 (decoded-new-name (gnus-group-decoded-name new-name)))
2825 (when (gnus-active new-name)
2826 (error "The group %s already exists" decoded-new-name))
2828 (gnus-message 6 "Renaming group %s to %s..."
2829 decoded-group decoded-new-name)
2832 (gnus-group-goto-group group)
2833 (not (when (< (gnus-group-group-level) gnus-level-zombie)
2834 (gnus-request-rename-group group new-name))))
2835 (gnus-error 3 "Couldn't rename group %s to %s"
2836 decoded-group decoded-new-name)
2837 ;; We rename the group internally by killing it...
2838 (gnus-group-kill-group)
2839 ;; ... changing its name ...
2840 (setcar (cdar gnus-list-of-killed-groups) new-name)
2841 ;; ... and then yanking it. Magic!
2842 (gnus-group-yank-group)
2843 (gnus-set-active new-name (gnus-active group))
2844 (gnus-message 6 "Renaming group %s to %s...done"
2845 decoded-group decoded-new-name)
2847 (setq gnus-killed-list (delete group gnus-killed-list))
2848 (gnus-set-active group nil)
2849 (gnus-dribble-touch)
2850 (gnus-group-position-point))))
2852 (defun gnus-group-edit-group (group &optional part)
2853 "Edit the group on the current line."
2854 (interactive (list (gnus-group-group-name)))
2855 (let ((part (or part 'info))
2858 (error "No group on current line"))
2859 (unless (setq info (gnus-get-info group))
2860 (error "Killed group; can't be edited"))
2862 (gnus-close-group group))
2864 ;; Find the proper form to edit.
2865 (cond ((eq part 'method)
2866 (or (gnus-info-method info) "native"))
2868 (gnus-info-params info))
2870 ;; The proper documentation.
2872 "Editing the %s for `%s'."
2874 ((eq part 'method) "select method")
2875 ((eq part 'params) "group parameters")
2877 (gnus-group-decoded-name group))
2879 (gnus-group-edit-group-done ',part ,group form)))
2882 (gnus-create-info-command
2885 "(gnus)Select Methods")
2887 "(gnus)Group Parameters")
2889 "(gnus)Group Info"))))))
2891 (defun gnus-group-edit-group-method (group)
2892 "Edit the select method of GROUP."
2893 (interactive (list (gnus-group-group-name)))
2894 (gnus-group-edit-group group 'method))
2896 (defun gnus-group-edit-group-parameters (group)
2897 "Edit the group parameters of GROUP."
2898 (interactive (list (gnus-group-group-name)))
2899 (gnus-group-edit-group group 'params))
2901 (defun gnus-group-edit-group-done (part group form)
2903 (let* ((method (cond ((eq part 'info) (nth 4 form))
2904 ((eq part 'method) form)
2906 (info (cond ((eq part 'info) form)
2907 ((eq part 'method) (gnus-get-info group))
2910 (if (or (not method)
2912 gnus-select-method method))
2913 (gnus-group-real-name (car info))
2914 (gnus-group-prefixed-name
2915 (gnus-group-real-name (car info)) method))
2917 (when (and new-group
2918 (not (equal new-group group)))
2919 (when (gnus-group-goto-group group)
2920 (gnus-group-kill-group 1))
2921 (gnus-activate-group new-group))
2923 (if (not (and info new-group))
2924 (gnus-group-set-info form (or new-group group) part)
2925 (setq info (gnus-copy-sequence info))
2926 (setcar info new-group)
2927 (unless (gnus-server-equal method "native")
2928 (unless (nthcdr 3 info)
2929 (nconc info (list nil nil)))
2930 (unless (nthcdr 4 info)
2931 (nconc info (list nil)))
2932 (gnus-info-set-method info method))
2933 (gnus-group-set-info info))
2934 (gnus-group-update-group (or new-group group))
2935 (gnus-group-position-point)))
2937 (defun gnus-group-make-useful-group (group method)
2938 "Create one of the groups described in `gnus-useful-groups'."
2940 (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
2942 gnus-useful-groups)))
2944 ;; Don't use `caddr' here since macros within the `interactive'
2945 ;; form won't be expanded.
2946 (car (cddr entry)))))
2947 (setq method (gnus-copy-sequence method))
2949 (while (setq entry (memq (assq 'eval method) method))
2950 (setcar entry (eval (cadar entry)))))
2951 (gnus-group-make-group group method))
2953 (defun gnus-group-make-help-group (&optional noerror)
2954 "Create the Gnus documentation group.
2955 Optional argument NOERROR modifies the behavior of this function when the
2956 group already exists:
2957 - if not given, and error is signaled,
2958 - if t, stay silent,
2959 - if anything else, just print a message."
2961 (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
2962 (file (nnheader-find-etc-directory "gnus-tut.txt" t)))
2963 (if (gnus-group-entry name)
2964 (cond ((eq noerror nil)
2965 (error "Documentation group already exists"))
2970 (gnus-message 1 "Documentation group already exists")))
2973 (gnus-message 1 "Couldn't find doc group")
2974 (gnus-group-make-group
2975 (gnus-group-real-name name)
2976 (list 'nndoc "gnus-help"
2977 (list 'nndoc-address file)
2978 (list 'nndoc-article-type 'mbox))))
2980 (gnus-group-position-point))
2982 (defun gnus-group-make-doc-group (file type)
2983 "Create a group that uses a single file as the source.
2985 If called with a prefix argument, ask for the file type."
2987 (list (read-file-name "File name: ")
2988 (and current-prefix-arg 'ask)))
2989 (when (eq type 'ask)
2994 "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: "
2996 (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
2997 ((= char ?b) 'babyl)
2998 ((= char ?d) 'digest)
2999 ((= char ?f) 'forward)
3001 ((= char ?g) 'guess)
3002 (t (setq err (format "%c unknown. " char))
3005 (setq file (expand-file-name file))
3006 (let* ((name (gnus-generate-new-group-name
3007 (gnus-group-prefixed-name
3008 (file-name-nondirectory file) '(nndoc ""))))
3009 (method (list 'nndoc file
3010 (list 'nndoc-address file)
3011 (list 'nndoc-article-type (or type 'guess))))
3012 (coding (gnus-group-name-charset method name)))
3013 (setcar (cdr method) (mm-encode-coding-string file coding))
3014 (gnus-group-make-group
3015 (mm-encode-coding-string (gnus-group-real-name name) coding)
3018 (defvar nnweb-type-definition)
3019 (defvar gnus-group-web-type-history nil)
3020 (defvar gnus-group-web-search-history nil)
3021 (defun gnus-group-make-web-group (&optional solid)
3022 "Create an ephemeral nnweb group.
3023 If SOLID (the prefix), create a solid group."
3027 (if solid (gnus-read-group "Group name: ")
3028 (message-unique-id)))
3029 (default-type (or (car gnus-group-web-type-history)
3030 (symbol-name (caar nnweb-type-definition))))
3034 (format "Search engine type (default %s): " default-type)
3035 (mapcar (lambda (elem) (list (symbol-name (car elem))))
3036 nnweb-type-definition)
3037 nil t nil 'gnus-group-web-type-history)
3042 (cons (or (car gnus-group-web-search-history) "") 0)
3043 'gnus-group-web-search-history))
3045 `(nnweb ,group (nnweb-search ,search)
3046 (nnweb-type ,(intern type))
3047 (nnweb-ephemeral-p t))))
3050 (gnus-pull 'nnweb-ephemeral-p method)
3051 (gnus-group-make-group group method))
3052 (gnus-group-read-ephemeral-group
3054 (cons (current-buffer)
3055 (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
3057 (defvar nnrss-group-alist)
3059 (defun nnrss-discover-feed (arg))
3060 (defun nnrss-save-server-data (arg)))
3061 (defun gnus-group-make-rss-group (&optional url)
3062 "Given a URL, discover if there is an RSS feed.
3063 If there is, use Gnus to create an nnrss group"
3067 (setq url (read-from-minibuffer "URL to Search for RSS: ")))
3068 (let ((feedinfo (nnrss-discover-feed url)))
3070 (let* ((title (gnus-newsgroup-savable-name
3071 (read-from-minibuffer "Title: "
3072 (gnus-newsgroup-savable-name
3076 (or (cdr (assoc 'title
3080 (desc (read-from-minibuffer "Description: "
3084 (or (cdr (assoc 'description
3088 (href (cdr (assoc 'href feedinfo)))
3089 (coding (gnus-group-name-charset '(nnrss "") title)))
3091 ;; Unify non-ASCII text.
3092 (setq title (mm-decode-coding-string
3093 (mm-encode-coding-string title coding)
3095 (gnus-group-make-group title '(nnrss ""))
3096 (push (list title href desc) nnrss-group-alist)
3097 (nnrss-save-server-data nil))
3098 (error "No feeds found for %s" url))))
3100 (defvar nnwarchive-type-definition)
3101 (defvar gnus-group-warchive-type-history nil)
3102 (defvar gnus-group-warchive-login-history nil)
3103 (defvar gnus-group-warchive-address-history nil)
3105 (defun gnus-group-make-warchive-group ()
3106 "Create a nnwarchive group."
3108 (require 'nnwarchive)
3109 (let* ((group (gnus-read-group "Group name: "))
3110 (default-type (or (car gnus-group-warchive-type-history)
3111 (symbol-name (caar nnwarchive-type-definition))))
3115 (format "Warchive type (default %s): " default-type)
3116 (mapcar (lambda (elem) (list (symbol-name (car elem))))
3117 nnwarchive-type-definition)
3118 nil t nil 'gnus-group-warchive-type-history)
3120 (address (read-string "Warchive address: "
3121 nil 'gnus-group-warchive-address-history))
3122 (default-login (or (car gnus-group-warchive-login-history)
3127 (format "Warchive login (default %s): " user-mail-address)
3128 default-login 'gnus-group-warchive-login-history)