;;; gnus-group.el --- group mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(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)
`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)
(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-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)
(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)
(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