;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(eval-when-compile
- (require 'cl)
- (defvar tool-bar-map))
+ (require 'cl))
+(defvar tool-bar-mode)
(require 'gnus)
(require 'gnus-start)
(require 'gnus-range)
(require 'gnus-win)
(require 'gnus-undo)
+(require 'gmm-utils)
(require 'time-date)
(require 'gnus-ems)
-(eval-when-compile
+(eval-when-compile
(require 'mm-url)
(let ((features (cons 'gnus-group features)))
(require 'gnus-sum))
`gnus-group-sort-by-score', `gnus-group-sort-by-method',
`gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
-This variable can also be a list of sorting functions. In that case,
+This variable can also be a list of sorting functions. In that case,
the most significant sort function should be the last function in the
list."
:group 'gnus-group-listing
Note that this format specification is not always respected. For
reasons of efficiency, when listing killed groups, this specification
-is ignored altogether. If the spec is changed considerably, your
+is ignored altogether. If the spec is changed considerably, your
output may end up looking strange when listing both alive and killed
groups.
:type 'hook)
(defcustom gnus-useful-groups
- '(("(ding) mailing list mirrored at sunsite.auc.dk"
- "emacs.ding"
- (nntp "sunsite.auc.dk"
- (nntp-address "sunsite.auc.dk")))
- ("gnus-bug archive"
- "gnus-bug"
- (nndir "/ftp@ftp.ifi.uio.no:/pub/emacs/gnus/gnus-bug/"))
- ("Gnus help group"
+ '(("(ding) mailing list mirrored at gmane.org"
+ "gmane.emacs.gnus.general"
+ (nntp "Gmane"
+ (nntp-address "news.gmane.org")))
+ ("Gnus bug archive"
+ "gnus.gnus-bug"
+ (nntp "news.gnus.org"
+ (nntp-address "news.gnus.org")))
+ ("Local Gnus help group"
"gnus-help"
(nndoc "gnus-help"
(nndoc-article-type mbox)
(defcustom gnus-group-highlight
'(;; Mail.
((and mailp (= unread 0) (eq level 1)) .
- gnus-group-mail-1-empty-face)
+ gnus-group-mail-1-empty)
((and mailp (eq level 1)) .
- gnus-group-mail-1-face)
+ gnus-group-mail-1)
((and mailp (= unread 0) (eq level 2)) .
- gnus-group-mail-2-empty-face)
+ gnus-group-mail-2-empty)
((and mailp (eq level 2)) .
- gnus-group-mail-2-face)
+ gnus-group-mail-2)
((and mailp (= unread 0) (eq level 3)) .
- gnus-group-mail-3-empty-face)
+ gnus-group-mail-3-empty)
((and mailp (eq level 3)) .
- gnus-group-mail-3-face)
+ gnus-group-mail-3)
((and mailp (= unread 0)) .
- gnus-group-mail-low-empty-face)
+ gnus-group-mail-low-empty)
((and mailp) .
- gnus-group-mail-low-face)
+ gnus-group-mail-low)
;; News.
((and (= unread 0) (eq level 1)) .
- gnus-group-news-1-empty-face)
+ gnus-group-news-1-empty)
((and (eq level 1)) .
- gnus-group-news-1-face)
+ gnus-group-news-1)
((and (= unread 0) (eq level 2)) .
- gnus-group-news-2-empty-face)
+ gnus-group-news-2-empty)
((and (eq level 2)) .
- gnus-group-news-2-face)
+ gnus-group-news-2)
((and (= unread 0) (eq level 3)) .
- gnus-group-news-3-empty-face)
+ gnus-group-news-3-empty)
((and (eq level 3)) .
- gnus-group-news-3-face)
+ gnus-group-news-3)
((and (= unread 0) (eq level 4)) .
- gnus-group-news-4-empty-face)
+ gnus-group-news-4-empty)
((and (eq level 4)) .
- gnus-group-news-4-face)
+ gnus-group-news-4)
((and (= unread 0) (eq level 5)) .
- gnus-group-news-5-empty-face)
+ gnus-group-news-5-empty)
((and (eq level 5)) .
- gnus-group-news-5-face)
+ gnus-group-news-5)
((and (= unread 0) (eq level 6)) .
- gnus-group-news-6-empty-face)
+ gnus-group-news-6-empty)
((and (eq level 6)) .
- gnus-group-news-6-face)
+ gnus-group-news-6)
((and (= unread 0)) .
- gnus-group-news-low-empty-face)
+ gnus-group-news-low-empty)
(t .
- gnus-group-news-low-face))
+ gnus-group-news-low))
"*Controls the highlighting of group buffer lines.
Below is a list of `Form'/`Face' pairs. When deciding how a a
ticked: The number of ticked articles."
:group 'gnus-group-visual
:type '(repeat (cons (sexp :tag "Form") face)))
+(put 'gnus-group-highlight 'risky-local-variable t)
(defcustom gnus-new-mail-mark ?%
"Mark used for groups with new mail."
:type 'character)
(defgroup gnus-group-icons nil
- "Add Icons to your group buffer. "
+ "Add Icons to your group buffer."
:group 'gnus-group-visual)
(defcustom gnus-group-icon-list
ticked: The number of ticked articles."
:group 'gnus-group-icons
:type '(repeat (cons (sexp :tag "Form") file)))
+(put 'gnus-group-icon-list 'risky-local-variable t)
(defcustom gnus-group-name-charset-method-alist nil
"Alist of method and the charset for group names.
If it is an alist, it must consist of \(NUMBER . PROMPT\) pairs, for example:
\((1 . \"\") (2 . \"nnfolder+archive:\")). The element with number 0 is
used when no prefix argument is given to `gnus-group-jump-to-group'."
- :version "21.4"
+ :version "22.1"
:group 'gnus-group-various
:type '(choice (string :tag "Prompt string")
(const :tag "Empty" nil)
(?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
(?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
- (?g gnus-tmp-group ?s)
+ (?g (if (boundp 'gnus-tmp-decoded-group)
+ gnus-tmp-decoded-group
+ gnus-tmp-group)
+ ?s)
(?G gnus-tmp-qualified-group ?s)
- (?c (gnus-short-group-name gnus-tmp-group) ?s)
+ (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
+ gnus-tmp-decoded-group
+ gnus-tmp-group))
+ ?s)
(?C gnus-tmp-comment ?s)
(?D gnus-tmp-newsgroup-description ?s)
(?o gnus-tmp-moderated ?c)
"\M-e" gnus-group-edit-group-method
"^" gnus-group-enter-server-mode
gnus-mouse-2 gnus-mouse-pick-group
+ [follow-link] mouse-face
"<" beginning-of-buffer
">" end-of-buffer
"\C-c\C-b" gnus-bug
"r" gnus-group-rename-group
"R" gnus-group-make-rss-group
"c" gnus-group-customize
+ "z" gnus-group-compact-group
"x" gnus-group-nnimap-expunge
"\177" gnus-group-delete-group
[delete] gnus-group-delete-group)
(gnus-group-group-name)]
["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
["Customize" gnus-group-customize (gnus-group-group-name)]
+ ["Compact" gnus-group-compact-group
+ :active (gnus-group-group-name)]
("Edit"
["Parameters" gnus-group-edit-group-parameters
:included (not (gnus-topic-mode-p))
(gnus-run-hooks 'gnus-group-menu-hook)))
-(defvar gnus-group-toolbar-map nil)
-
-;; Emacs 21 tool bar. Should be no-op otherwise.
-(defun gnus-group-make-tool-bar ()
- (if (and
- (condition-case nil (require 'tool-bar) (error nil))
- (fboundp 'tool-bar-add-item-from-menu)
- (default-value 'tool-bar-mode)
- (not gnus-group-toolbar-map))
- (setq gnus-group-toolbar-map
- (let ((tool-bar-map (make-sparse-keymap))
- (load-path (mm-image-load-path)))
- (tool-bar-add-item-from-menu
- 'gnus-group-get-new-news "get-news" gnus-group-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-group-catchup-current "catchup" gnus-group-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-group-describe-group "describe-group" gnus-group-mode-map)
- (tool-bar-add-item "subscribe" 'gnus-group-subscribe 'subscribe
- :help "Subscribe to the current group")
- (tool-bar-add-item "unsubscribe" 'gnus-group-unsubscribe
- 'unsubscribe
- :help "Unsubscribe from the current group")
- (tool-bar-add-item-from-menu
- 'gnus-group-exit "exit-gnus" gnus-group-mode-map)
- tool-bar-map)))
- (if gnus-group-toolbar-map
- (set (make-local-variable 'tool-bar-map) gnus-group-toolbar-map)))
+
+(defvar gnus-group-tool-bar-map nil)
+
+(defun gnus-group-tool-bar-update (&optional symbol value)
+ "Update group buffer toolbar.
+Setter function for custom variables."
+ (when symbol
+ (set-default symbol value))
+ ;; (setq-default gnus-group-tool-bar-map nil)
+ ;; (use-local-map gnus-group-mode-map)
+ (when (gnus-alive-p)
+ (with-current-buffer gnus-group-buffer
+ (gnus-group-make-tool-bar t))))
+
+(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
+ 'gnus-group-tool-bar-gnome
+ 'gnus-group-tool-bar-retro)
+ "Specifies the Gnus group tool bar.
+
+It can be either a list or a symbol refering to a list. See
+`gmm-tool-bar-from-list' for the format of the list. The
+default key map is `gnus-group-mode-map'.
+
+Pre-defined symbols include `gnus-group-tool-bar-gnome' and
+`gnus-group-tool-bar-retro'."
+ :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
+ (const :tag "Retro look" gnus-group-tool-bar-retro)
+ (repeat :tag "User defined list" gmm-tool-bar-item)
+ (symbol))
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-group-tool-bar-update
+ :group 'gnus-group)
+
+(defcustom gnus-group-tool-bar-gnome
+ '((gnus-group-post-news "mail/compose")
+ ;; Some useful agent icons? I don't use the agent so agent users should
+ ;; suggest useful commands:
+ (gnus-agent-toggle-plugged "disconnect" t
+ :help "Gnus is currently unplugged. Click to work online."
+ :visible (and gnus-agent (not gnus-plugged)))
+ (gnus-agent-toggle-plugged "connect" t
+ :help "Gnus is currently plugged. Click to work offline."
+ :visible (and gnus-agent gnus-plugged))
+ ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
+ ;; should have a better help text.
+ (gnus-group-send-queue "mail/outbox" t
+ :visible (and gnus-agent gnus-plugged)
+ :help "Send articles from the queue group")
+ (gnus-group-get-new-news "mail/inbox" nil
+ :visible (or (not gnus-agent)
+ gnus-plugged))
+ ;; FIXME: gnus-*-read-group should have a better help text.
+ (gnus-topic-read-group "open" nil
+ :visible (and (boundp 'gnus-topic-mode)
+ gnus-topic-mode))
+ (gnus-group-read-group "open" nil
+ :visible (not (and (boundp 'gnus-topic-mode)
+ gnus-topic-mode)))
+ ;; (gnus-group-find-new-groups "???" nil)
+ (gnus-group-save-newsrc "save")
+ (gnus-group-describe-group "describe")
+ (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
+ (gnus-group-prev-unread-group "left-arrow")
+ (gnus-group-next-unread-group "right-arrow")
+ (gnus-group-exit "exit")
+ (gmm-customize-mode "preferences" t :help "Edit mode preferences")
+ (gnus-info-find-node "help"))
+ "List of functions for the group tool bar (GNOME style).
+
+See `gmm-tool-bar-from-list' for the format of the list."
+ :type '(repeat gmm-tool-bar-item)
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-group-tool-bar-update
+ :group 'gnus-group)
+
+(defcustom gnus-group-tool-bar-retro
+ '((gnus-group-get-new-news "gnus/get-news")
+ (gnus-group-get-new-news-this-group "gnus/gnntg")
+ (gnus-group-catchup-current "gnus/catchup")
+ (gnus-group-describe-group "gnus/describe-group")
+ (gnus-group-subscribe "gnus/subscribe" t
+ :help "Subscribe to the current group")
+ (gnus-group-unsubscribe "gnus/unsubscribe" t
+ :help "Unsubscribe from the current group")
+ (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
+ "List of functions for the group tool bar (retro look).
+
+See `gmm-tool-bar-from-list' for the format of the list."
+ :type '(repeat gmm-tool-bar-item)
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-group-tool-bar-update
+ :group 'gnus-group)
+
+(defcustom gnus-group-tool-bar-zap-list t
+ "List of icon items from the global tool bar.
+These items are not displayed in the Gnus group mode tool bar.
+
+See `gmm-tool-bar-from-list' for the format of the list."
+ :type 'gmm-tool-bar-zap-list
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-group-tool-bar-update
+ :group 'gnus-group)
+
+(defvar image-load-path)
+
+(defun gnus-group-make-tool-bar (&optional force)
+ "Make a group mode tool bar from `gnus-group-tool-bar'.
+When FORCE, rebuild the tool bar."
+ (when (and (not (featurep 'xemacs))
+ (boundp 'tool-bar-mode)
+ tool-bar-mode
+ ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode).
+ ;; Why? --rsteib
+ (or (not gnus-group-tool-bar-map) force))
+ (let* ((load-path
+ (gmm-image-load-path-for-library "gnus"
+ "gnus/toggle-subscription.xpm"
+ nil t))
+ (image-load-path (cons (car load-path)
+ (when (boundp 'image-load-path)
+ image-load-path)))
+ (map (gmm-tool-bar-from-list gnus-group-tool-bar
+ gnus-group-tool-bar-zap-list
+ 'gnus-group-mode-map)))
+ (if map
+ (set (make-local-variable 'tool-bar-map) map))))
+ gnus-group-tool-bar-map)
(defun gnus-group-mode ()
"Major mode for reading news.
All normal editing commands are switched off.
\\<gnus-group-mode-map>
-The group buffer lists (some of) the groups available. For instance,
+The group buffer lists (some of) the groups available. For instance,
`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
lists all zombie groups.
(gnus-undo-mode 1))
(when gnus-slave
(gnus-slave-mode))
- (gnus-run-hooks 'gnus-group-mode-hook))
+ (gnus-run-mode-hooks 'gnus-group-mode-hook))
(defun gnus-update-group-mark-positions ()
(save-excursion
(gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
(goto-char (point-min))
(setq gnus-group-mark-positions
- (list (cons 'process (and (search-forward "\200" nil t)
+ (list (cons 'process (and (search-forward
+ (mm-string-as-multibyte "\200") nil t)
(- (point) 2))))))))
(defun gnus-mouse-pick-group (e)
(defun gnus-group-name-charset (method group)
(if (null method)
(setq method (gnus-find-method-for-group group)))
- (let ((item (assoc method gnus-group-name-charset-method-alist))
+ (let ((item (or (assoc method gnus-group-name-charset-method-alist)
+ (and (consp method)
+ (assoc (list (car method) (cadr method))
+ gnus-group-name-charset-method-alist))))
(alist gnus-group-name-charset-group-alist)
result)
(if item
(gnus-range-difference (list active) (gnus-info-read info))
seen))))))
+;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
+;; update the state (enabled/disabled) of the icon `gnus-group-describe-group'
+;; automatically. After `C-l' the state is correct. See the following report
+;; on emacs-devel
+;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>:
+;; From: Reiner Steib
+;; Subject: tool bar icons not updated according to :active condition
+;; Newsgroups: gmane.emacs.devel
+;; Date: Mon, 23 Jan 2006 19:59:13 +0100
+;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de>
+
+(defcustom gnus-group-update-tool-bar
+ (and (not (featurep 'xemacs))
+ (boundp 'tool-bar-mode)
+ tool-bar-mode
+ ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs 21 might
+ ;; be confusing, so maybe we shouldn't call it by default.
+ (fboundp 'force-window-update))
+ "Force updating the group buffer tool bar."
+ :group 'gnus-group
+ :version "22.1"
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (when (gnus-alive-p)
+ (with-current-buffer gnus-group-buffer
+ ;; FIXME: Is there a better way to redraw the group buffer?
+ (gnus-group-get-new-news 0))))
+ :type 'boolean)
+
(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
gnus-tmp-marked number
gnus-tmp-method)
(if (member gnus-tmp-group gnus-group-marked)
gnus-process-mark ? ))
(buffer-read-only nil)
+ beg end
header gnus-tmp-header) ; passed as parameter to user-funcs.
(beginning-of-line)
+ (setq beg (point))
(gnus-add-text-properties
(point)
(prog1 (1+ (point))
;; Insert the text.
- (let ((gnus-tmp-group (gnus-group-name-decode
- gnus-tmp-group group-name-charset)))
+ (let ((gnus-tmp-decoded-group (gnus-group-name-decode
+ gnus-tmp-group group-name-charset)))
(eval gnus-group-line-format-spec)))
`(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
gnus-unread ,(if (numberp number)
- (string-to-int gnus-tmp-number-of-unread)
+ (string-to-number gnus-tmp-number-of-unread)
t)
gnus-marked ,gnus-tmp-marked-mark
gnus-indentation ,gnus-group-indentation
gnus-level ,gnus-tmp-level))
+ (setq end (point))
+ (when gnus-group-update-tool-bar
+ (gnus-put-text-property beg end 'point-entered
+ 'gnus-tool-bar-update)
+ (gnus-put-text-property beg end 'point-left
+ 'gnus-tool-bar-update))
(forward-line -1)
(when (inline (gnus-visual-p 'group-highlight 'highlight))
(gnus-run-hooks 'gnus-group-update-hook))
(ticked (gnus-range-length (cdr (assq 'tick marked))))
(group-age (gnus-group-timestamp-delta group))
(inhibit-read-only t))
+ ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
+ ;; ======================================================================
+ ;; From: Richard Stallman
+ ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
+ ;; Cc: ding@gnus.org
+ ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
+ ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
+ ;;
+ ;; [...]
+ ;; The kludge is that the alist elements contain expressions that refer
+ ;; to local variables with short names. Perhaps write your own tiny
+ ;; evaluator that handles just `and', `or', and numeric comparisons
+ ;; and just a few specific variables.
+ ;; ======================================================================
+ ;;
+ ;; Similar for other evaluated variables. Grep for risky-local-variable
+ ;; to find them! -- rsteib
+ ;;
;; Eval the cars of the lists until we find a match.
(while (and list
(not (eval (caar list))))
(size (+ size-in-cache size-in-agent))
(suffix '("B" "K" "M" "G"))
(scale 1024.0)
- (cutoff (* 10 scale)))
+ (cutoff scale))
(while (> size cutoff)
(setq size (/ size scale)
suffix (cdr suffix)))
(defun gnus-group-unmark-all-groups ()
"Unmark all groups."
(interactive)
- (let ((groups gnus-group-marked))
- (save-excursion
- (while groups
- (gnus-group-remove-mark (pop groups)))))
+ (save-excursion
+ (mapc 'gnus-group-remove-mark gnus-group-marked))
(gnus-group-position-point))
(defun gnus-group-mark-region (unmark beg end)
If the prefix argument ALL is non-nil, already read articles become
readable. IF ALL is a number, fetch this number of articles. If the
optional argument NO-ARTICLE is non-nil, no article will be
-auto-selected upon group entry. If GROUP is non-nil, fetch that
+auto-selected upon group entry. If GROUP is non-nil, fetch that
group."
(interactive "P")
(let ((no-display (eq all 0))
(forward-line -1))
(gnus-group-read-group all t))
-(defun gnus-group-quick-select-group (&optional all)
- "Select the current group \"quickly\".
-This means that no highlighting or scoring will be performed.
-If ALL (the prefix argument) is 0, don't even generate the summary
-buffer.
+(defun gnus-group-quick-select-group (&optional all group)
+ "Select the GROUP \"quickly\".
+This means that no highlighting or scoring will be performed. If
+ALL (the prefix argument) is 0, don't even generate the summary
+buffer. If GROUP is nil, use current group.
This might be useful if you want to toggle threading
before entering the group."
gnus-home-score-file
gnus-apply-kill-hook
gnus-summary-expunge-below)
- (gnus-group-read-group all t)))
+ (gnus-group-read-group all t group)))
(defun gnus-group-visible-select-group (&optional all)
"Select the current group without hiding any articles."
(gnus-group-read-ephemeral-group
(gnus-group-prefixed-name group method) method)))
+(defun gnus-group-name-at-point ()
+ "Return a group name from around point if it exists, or nil."
+ (if (eq major-mode 'gnus-group-mode)
+ (let ((group (gnus-group-group-name)))
+ (when group
+ (gnus-group-decoded-name group)))
+ (let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\
+\\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\
+\[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\
+\\|[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)+\\)")
+ (start (point))
+ (case-fold-search nil))
+ (prog1
+ (if (or (and (not (or (eobp)
+ (looking-at "[][\C-@-*,/;-@\\^`{-\C-?]")))
+ (prog1 t
+ (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
+ (point-at-bol))))
+ (and (looking-at "[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*$")
+ (prog1 t
+ (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?")
+ (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
+ (point-at-bol))))
+ (string-match "\\`[][\C-@-\t\v-*,/;-@\\^`{-\C-?]*\\'"
+ (buffer-substring (point-at-bol) (point))))
+ (when (looking-at regexp)
+ (match-string 1))
+ (let (group distance)
+ (when (looking-at regexp)
+ (setq group (match-string 1)
+ distance (- (match-beginning 1) (match-beginning 0))))
+ (skip-chars-backward "][\C-@-\t\v-*,/;-@\\^`{-\C-?")
+ (skip-chars-backward "^][\C-@-\t\v-*,/;-@\\^`{-\C-?"
+ (point-at-bol))
+ (if (looking-at regexp)
+ (if (and group (<= distance (- start (match-end 0))))
+ group
+ (match-string 1))
+ group)))
+ (goto-char start)))))
+
+(defun gnus-group-completing-read (prompt &optional collection predicate
+ require-match initial-input hist def
+ &rest args)
+ "Read a group name with completion. Non-ASCII group names are allowed.
+The arguments are the same as `completing-read' except that COLLECTION
+and HIST default to `gnus-active-hashtb' and `gnus-group-history'
+respectively if they are omitted."
+ (let (group)
+ (mapatoms (lambda (symbol)
+ (setq group (symbol-name symbol))
+ (set (intern (if (string-match "[^\000-\177]" group)
+ (gnus-group-decoded-name group)
+ group)
+ collection)
+ group))
+ (prog1
+ (or collection
+ (setq collection (or gnus-active-hashtb [0])))
+ (setq collection (gnus-make-hashtable (length collection)))))
+ (setq group (apply 'completing-read prompt collection predicate
+ require-match initial-input
+ (or hist 'gnus-group-history)
+ def args))
+ (or (prog1
+ (symbol-value (intern-soft group collection))
+ (setq collection nil))
+ (mm-encode-coding-string group (gnus-group-name-charset nil group)))))
+
;;;###autoload
(defun gnus-fetch-group (group &optional articles)
"Start Gnus if necessary and enter GROUP.
+If ARTICLES, display those articles.
Returns whether the fetching was successful or not."
- (interactive (list (completing-read "Group name: " gnus-active-hashtb)))
- (unless (get-buffer gnus-group-buffer)
+ (interactive (list (gnus-group-completing-read "Group name: "
+ nil nil nil
+ (gnus-group-name-at-point))))
+ (unless (gnus-alive-p)
(gnus-no-server))
- (gnus-group-read-group articles nil group))
+ (gnus-group-read-group (if articles nil t) nil group articles))
;;;###autoload
(defun gnus-fetch-group-other-frame (group)
If the number of articles in a newsgroup is greater than this value,
confirmation is required for selecting the newsgroup. If it is nil, no
confirmation is required."
- :version "21.4"
+ :version "22.1"
:group 'gnus-group-select
:type '(choice (const :tag "No limit" nil)
integer))
(defcustom gnus-fetch-old-ephemeral-headers nil
"Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups."
- :version "21.4"
+ :version "22.1"
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
(const some)
(defun gnus-group-read-ephemeral-group (group method &optional activate
quit-config request-only
select-articles
- parameters)
+ parameters
+ number)
"Read GROUP from METHOD as an ephemeral group.
If ACTIVATE, request the group first.
If QUIT-CONFIG, use that window configuration when exiting from the
If REQUEST-ONLY, don't actually read the group; just request it.
If SELECT-ARTICLES, only select those articles.
If PARAMETERS, use those as the group parameters.
+If NUMBER, fetch this number of articles.
Return the name of the group if selection was successful."
(interactive
(list
;; (gnus-read-group "Group name: ")
- (completing-read
- "Group: " gnus-active-hashtb
- nil nil nil
- 'gnus-group-history)
+ (gnus-group-completing-read "Group: ")
(gnus-read-method "From method: ")))
;; Transform the select method into a unique server.
(when (stringp method)