;;; 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 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; 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:
(eval-when-compile
(require 'cl)
- (defvar tool-bar-map))
+ (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 (require 'mm-url))
+(eval-when-compile
+ (require 'mm-url)
+ (let ((features (cons 'gnus-group features)))
+ (require 'gnus-sum))
+ (unless (boundp 'gnus-cache-active-hashtb)
+ (defvar gnus-cache-active-hashtb nil)))
+
+(autoload 'gnus-agent-total-fetched-for "gnus-agent")
+(autoload 'gnus-cache-total-fetched-for "gnus-cache")
(defcustom gnus-group-archive-directory
"/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
%z A string that look like `<%s:%n>' if a foreign select method is used
%d The date the group was last entered.
%E Icon as defined by `gnus-group-icon-list'.
+%F The disk space used by the articles fetched by both the cache and agent.
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
where X is the letter following %u. The function will be passed a
groups.
If you use %o or %O, reading the active file will be slower and quite
-a bit of extra memory will be used. %D will also worsen performance.
-Also note that if you change the format specification to include any
-of these specs, you must probably re-start Gnus to see them go into
-effect.
+a bit of extra memory will be used. %D and %F will also worsen
+performance. Also note that if you change the format specification to
+include any of these specs, you must probably re-start Gnus to see
+them go into effect.
General format specifiers can also be used.
See Info node `(gnus)Formatting Variables'."
: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
: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
(defcustom gnus-group-jump-to-group-prompt nil
"Default prompt for `gnus-group-jump-to-group'.
-If non-nil, the value should be a string, e.g. \"nnml:\",
-in which case `gnus-group-jump-to-group' offers \"Group: nnml:\"
-in the minibuffer prompt."
+
+If non-nil, the value should be a string or an alist. If it is a string,
+e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group:
+nnml:\" in the minibuffer prompt.
+
+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 "22.1"
:group 'gnus-group-various
:type '(choice (string :tag "Prompt string")
- (const :tag "Empty" nil)))
+ (const :tag "Empty" nil)
+ (repeat (cons (integer :tag "Argument")
+ (string :tag "Prompt string")))))
(defvar gnus-group-listing-limit 1000
"*A limit of the number of groups when listing.
(?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)
(?O gnus-tmp-moderated-string ?s)
(?p gnus-tmp-process-marked ?c)
(?s gnus-tmp-news-server ?s)
- (?n gnus-tmp-news-method ?s)
+ (?n ,(if (featurep 'xemacs)
+ '(symbol-name gnus-tmp-news-method)
+ 'gnus-tmp-news-method)
+ ?s)
(?P gnus-group-indentation ?s)
(?E gnus-tmp-group-icon ?s)
(?B gnus-tmp-summary-live ?c)
(?z gnus-tmp-news-method-string ?s)
(?m (gnus-group-new-mail gnus-tmp-group) ?c)
(?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
- (?u gnus-tmp-user-defined ?s)))
+ (?u gnus-tmp-user-defined ?s)
+ (?F (gnus-total-fetched-for gnus-tmp-group) ?s)
+ ))
(defvar gnus-group-mode-line-format-alist
`((?S gnus-tmp-news-server ?s)
"\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 "connect" t
+ :visible (and gnus-agent (not gnus-plugged)))
+ (gnus-agent-toggle-plugged "disconnect" t
+ :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)
+
+;; FIXME: 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'. 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-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)
+
+(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
+ (gmm-image-load-path-for-library "gnus"
+ "gnus/toggle-subscription.xpm"
+ 'image-load-path t))
+ (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.
(use-local-map gnus-group-mode-map)
(buffer-disable-undo)
(setq truncate-lines t)
- (setq buffer-read-only t)
+ (setq buffer-read-only t
+ show-trailing-whitespace nil)
(gnus-set-default-directory)
(gnus-update-format-specifications nil 'group 'group-mode)
(gnus-update-group-mark-positions)
(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)
(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
(goto-char (or pos beg))
(and pos t))))
+(defun gnus-total-fetched-for (group)
+ (let* ((size-in-cache (or (gnus-cache-total-fetched-for group) 0))
+ (size-in-agent (or (gnus-agent-total-fetched-for group) 0))
+ (size (+ size-in-cache size-in-agent))
+ (suffix '("B" "K" "M" "G"))
+ (scale 1024.0)
+ (cutoff scale))
+ (while (> size cutoff)
+ (setq size (/ size scale)
+ suffix (cdr suffix)))
+ (format "%5.1f%s" size (car suffix))))
+
;;; Gnus group mode commands
;; Group marking.
(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)
No article is selected automatically.
If the group is opened, just switch the summary buffer.
If ALL is non-nil, already read articles become readable.
-If ALL is a number, fetch this number of articles."
+If ALL is a positive number, fetch this number of the latest
+articles in the group.
+If ALL is a negative number, fetch this number of the earliest
+articles in the group."
(interactive "P")
(when (and (eobp) (not (gnus-group-group-name)))
(forward-line -1))
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 "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 "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
(when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup)
(gnus-fetch-old-headers
gnus-fetch-old-ephemeral-headers))
- (gnus-group-read-group t t group select-articles))
+ (gnus-group-read-group (or number t) t group select-articles))
group)
;;(error nil)
(quit
(message "Quit reading the ephemeral group")
nil)))))
-(defun gnus-group-jump-to-group (group)
- "Jump to newsgroup GROUP."
+(defun gnus-group-jump-to-group (group &optional prompt)
+ "Jump to newsgroup GROUP.
+
+If PROMPT (the prefix) is a number, use the prompt specified in
+`gnus-group-jump-to-group-prompt'."
(interactive
(list (mm-string-make-unibyte
(completing-read
"Group: " gnus-active-hashtb nil
(gnus-read-active-file-p)
- gnus-group-jump-to-group-prompt
+ (if current-prefix-arg
+ (cdr (assq current-prefix-arg gnus-group-jump-to-group-prompt))
+ (or (and (stringp gnus-group-jump-to-group-prompt)
+ gnus-group-jump-to-group-prompt)
+ (let ((p (cdr (assq 0 gnus-group-jump-to-group-prompt))))
+ (and (stringp p) p))))
'gnus-group-history))))
(when (equal group "")
(gnus-group-position-point)
(and best-point (gnus-group-group-name))))
+;; Is there something like an after-point-motion-hook?
+;; (inhibit-point-motion-hooks?). Is there a tool-bar-update function?
+
+;; (defun gnus-group-menu-bar-update ()
+;; (let* ((buf (list (with-current-buffer gnus-group-buffer
+;; (current-buffer))))
+;; (name (buffer-name (car buf))))
+;; (setcdr buf
+;; (if (> (length name) 27)
+;; (concat (substring name 0 12)
+;; "..."
+;; (substring name -12))
+;; name))
+;; (menu-bar-update-buffers-1 buf)))
+
+;; (defun gnus-group-position-point ()
+;; (gnus-goto-colon)
+;; (gnus-group-menu-bar-update))
+
(defun gnus-group-first-unread-group ()
"Go to the first group with unread articles."
(interactive)
(interactive)
(gnus-enter-server-buffer))
+(defun gnus-group-make-group-simple (&optional group)
+ "Add a new newsgroup.
+The user will be prompted for GROUP."
+ (interactive
+ (list (completing-read "Group: " gnus-active-hashtb
+ nil nil nil 'gnus-group-history)))
+ (gnus-group-make-group
+ (gnus-group-real-name group)
+ (gnus-group-server group)))
+
(defun gnus-group-make-group (name &optional method address args)
"Add a new newsgroup.
The user will be prompted for a NAME, for a select METHOD, and an
(nname (if method (gnus-group-prefixed-name name meth) name))
backend info)
(when (gnus-group-entry nname)
- (error "Group %s already exists" nname))
+ (error "Group %s already exists" (gnus-group-decoded-name nname)))
;; Subscribe to the new group.
(gnus-group-change-level
(setq info (list t nname gnus-level-default-subscribed nil nil meth))
(lambda (group)
(gnus-group-delete-group group nil t))))))
-(defvar gnus-cache-active-altered)
-
(defun gnus-group-delete-group (group &optional force no-prompt)
"Delete the current group. Only meaningful with editable groups.
If FORCE (the prefix) is non-nil, all the articles in the group will
be deleted. This is \"deleted\" as in \"removed forever from the face
-of the Earth\". There is no undo. The user will be prompted before
+of the Earth\". There is no undo. The user will be prompted before
doing the deletion.
Note that you also have to specify FORCE if you want the group to
be removed from the server, even when it's empty."
(unless (gnus-check-backend-function 'request-delete-group group)
(error "This back end does not support group deletion"))
(prog1
- (if (and (not no-prompt)
- (not (gnus-yes-or-no-p
- (format
- "Do you really want to delete %s%s? "
- group (if force " and all its contents" "")))))
- () ; Whew!
- (gnus-message 6 "Deleting group %s..." group)
- (if (not (gnus-request-delete-group group force))
- (gnus-error 3 "Couldn't delete group %s" group)
- (gnus-message 6 "Deleting group %s...done" group)
- (gnus-group-goto-group group)
- (gnus-group-kill-group 1 t)
- (gnus-set-active group nil)
- (if (boundp 'gnus-cache-active-hashtb)
- (when gnus-cache-active-hashtb
- (gnus-sethash group nil gnus-cache-active-hashtb)
- (setq gnus-cache-active-altered t)))
- t))
+ (let ((group-decoded (gnus-group-decoded-name group)))
+ (if (and (not no-prompt)
+ (not (gnus-yes-or-no-p
+ (format
+ "Do you really want to delete %s%s? "
+ group-decoded (if force " and all its contents" "")))))
+ () ; Whew!
+ (gnus-message 6 "Deleting group %s..." group-decoded)
+ (if (not (gnus-request-delete-group group force))
+ (gnus-error 3 "Couldn't delete group %s" group-decoded)
+ (gnus-message 6 "Deleting group %s...done" group-decoded)
+ (gnus-group-goto-group group)
+ (gnus-group-kill-group 1 t)
+ (gnus-set-active group nil)
+ t)))
(gnus-group-position-point)))
(defun gnus-group-rename-group (group new-name)
(gnus-group-position-point))
(defun gnus-group-make-doc-group (file type)
- "Create a group that uses a single file as the source."
+ "Create a group that uses a single file as the source.
+
+If called with a prefix argument, ask for the file type."
(interactive
(list (read-file-name "File name: ")
(and current-prefix-arg 'ask)))
char found)
(while (not found)
(message
- "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: "
+ "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: "
err)
(setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
((= char ?b) 'babyl)
(setq url (read-from-minibuffer "URL to Search for RSS: ")))
(let ((feedinfo (nnrss-discover-feed url)))
(if feedinfo
- (let ((title (read-from-minibuffer "Title: "
- (cdr (assoc 'title
- feedinfo))))
+ (let ((title (gnus-newsgroup-savable-name
+ (read-from-minibuffer "Title: "
+ (gnus-newsgroup-savable-name
+ (or (cdr (assoc 'title
+ feedinfo))
+ "")))))
(desc (read-from-minibuffer "Description: "
(cdr (assoc 'description
feedinfo))))
- (href (cdr (assoc 'href feedinfo))))
- (push (list title href desc)
- nnrss-group-alist)
- (gnus-group-unsubscribe-group
- (concat "nnrss:" title))
+ &nb
projects / gnus / blobdiff