;;; gnus-group.el --- group mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
`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.
(with-current-buffer gnus-group-buffer
(gnus-group-make-tool-bar t))))
-;; The default will be changed when the new icons have been checked in:
-(defcustom gnus-group-tool-bar 'gnus-group-tool-bar-retro
+(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
(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))
- ;; 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-*-read-group should have a better help text.
- (gnus-topic-read-group "open" nil :visible gnus-topic-mode)
- (gnus-group-read-group "open" nil :visible (not gnus-topic-mode))
+ (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 "prev-node") ;; Emacs 22
- (gnus-group-next-unread-group "next-node") ;; Emacs 22
+ (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).
: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.
: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."
;; Why? --rsteib
(or (not gnus-group-tool-bar-map) force))
(let* ((load-path
- (gmm-image-load-path "gnus" "gnus/toggle-subscription.xpm"
- 'load-path))
- (image-load-path
- (gmm-image-load-path "gnus" "gnus/toggle-subscription.xpm"
- 'image-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)))
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-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))
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))
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 group-name-at-point ()
+ (let ((regexp "[^-a-zA-Z+.:_]"))
+ (save-excursion
+ (buffer-substring
+ (progn
+ (re-search-backward regexp nil t)
+ (forward-char 1)
+ (point))
+ (progn
+ (re-search-forward regexp nil t)
+ (forward-char -1)
+ (point))))))
+
;;;###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)))
+ (interactive (list (completing-read "Group name: " gnus-active-hashtb
+ nil nil nil nil
+ (group-name-at-point))))
(unless (get-buffer gnus-group-buffer)
(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)
(t (setq err (format "%c unknown. " char))
nil))))
(setq type found)))
- (let* ((file (expand-file-name file))
- (name (gnus-generate-new-group-name
- (gnus-group-prefixed-name
- (file-name-nondirectory file) '(nndoc "")))))
+ (setq file (expand-file-name file))
+ (let ((name (gnus-generate-new-group-name
+ (gnus-group-prefixed-name
+ (file-name-nondirectory file) '(nndoc ""))))
+ (encodable (mm-coding-system-p 'utf-8)))
(gnus-group-make-group
- (gnus-group-real-name name)
- (list 'nndoc file
+ (if encodable
+ (mm-encode-coding-string (gnus-group-real-name name) 'utf-8)
+ (gnus-group-real-name name))
+ (list 'nndoc (if encodable
+ (mm-encode-coding-string file 'utf-8)
+ file)
(list 'nndoc-address file)
(list 'nndoc-article-type (or type 'guess))))))
(defun gnus-group-make-directory-group (dir)
"Create an nndir group.
The user will be prompted for a directory. The contents of this
-directory will be used as a newsgroup. The directory should contain
+directory will be used as a newsgroup. The directory should contain
mail messages or news articles in files that have numeric names."
(interactive
(list (read-file-name "Create group from directory: ")))
(defun gnus-group-sort-by-unread (info1 info2)
"Sort by number of unread articles."
(let ((n1 (gnus-group-unread (gnus-info-group info1)))
- (n2 (gnus-group-unread (gnus-info-group info1))))
+ (n2 (gnus-group-unread (gnus-info-group info2))))
(< (or (and (numberp n1) n1) 0)
(or (and (numberp n2) n2) 0))))
(when (eq 'nnvirtual (car method))
(nnvirtual-catchup-group
(gnus-group-real-name group) (nth 1 method) all)))
- (if (>= (gnus-group-level group) gnus-level-zombie)
- (gnus-message 2 "Dead groups can't be caught up")
- (if (prog1
- (gnus-group-goto-group group)
- (gnus-group-catchup group all))
- (gnus-group-update-group-line)
- (setq ret (1+ ret)))))
+ (cond
+ ((>= (gnus-group-level group) gnus-level-zombie)
+ (gnus-message 2 "Dead groups can't be caught up"))
+ ((prog1
+ (gnus-group-goto-group group)
+ (gnus-group-catchup group all))
+ (gnus-group-update-group-line))
+ (t
+ (setq ret (1+ ret)))))
(gnus-group-next-unread-group 1)
ret)))
(gnus-add-marked-articles group 'dormant nil nil 'force))
;; Do auto-expirable marks if that's required.
(when (gnus-group-auto-expirable-p group)
- (gnus-range-map (lambda (article)
- (gnus-add-marked-articles group 'expire (list article))
- (gnus-request-set-mark group (list (list (list article) 'add '(expire)))))
- unread))
+ (gnus-range-map
+ (lambda (article)
+ (gnus-add-marked-articles group 'expire (list article))
+ (gnus-request-set-mark group (list (list (list article)
+ 'add '(expire)))))
+ unread))
(let ((gnus-newsgroup-name group))
(gnus-run-hooks 'gnus-group-catchup-group-hook))
num)))
(defun gnus-group-transpose-groups (n)
"Move the current newsgroup up N places.
-If given a negative prefix, move down instead. The difference between
+If given a negative prefix, move down instead. The difference between
N and the number of steps taken is returned."
(interactive "p")
(unless (gnus-group-group-name)
;; We might read in new NoCeM messages here.
(when (and gnus-use-nocem
- (null arg))
+ (or (and (numberp gnus-use-nocem)
+ (numberp arg)
+ (>= arg gnus-use-nocem))
+ (not arg)))
(gnus-nocem-scan-groups))
;; If ARG is not a number, then we read the active file.
(when (and arg (not (numberp arg)))
(unless entry
(error "Trying to change non-existent group %s" method-only-group))
;; We have received parts of the actual group info - either the
- ;; select method or the group parameters. We first check
+ ;; select method or the group parameters. We first check
;; whether we have to extend the info, and if so, do that.
(let ((len (length info))
(total (if (eq part 'method) 5 6)))
projects / gnus / blobdiff