;;; gnus-group.el --- group mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; 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-mode))
+ (require 'cl))
+(defvar tool-bar-mode)
(require 'gnus)
(require 'gnus-start)
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.
(const :tag "Retro look" gnus-group-tool-bar-retro)
(repeat :tag "User defined list" gmm-tool-bar-item)
(symbol))
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-group-tool-bar-update
:group 'gnus-group)
See `gmm-tool-bar-from-list' for the format of the list."
:type '(repeat gmm-tool-bar-item)
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-group-tool-bar-update
:group 'gnus-group)
See `gmm-tool-bar-from-list' for the format of the list."
:type '(repeat gmm-tool-bar-item)
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-group-tool-bar-update
:group 'gnus-group)
See `gmm-tool-bar-from-list' for the format of the list."
:type 'gmm-tool-bar-zap-list
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-group-tool-bar-update
:group 'gnus-group)
(defvar image-load-path)
+(defvar tool-bar-map)
(defun gnus-group-make-tool-bar (&optional force)
"Make a group mode tool bar from `gnus-group-tool-bar'.
(goto-char (point-min))
(setq gnus-group-mark-positions
(list (cons 'process (and (search-forward
- (mm-string-as-multibyte "\200") nil t)
- (- (point) 2))))))))
+ (mm-string-to-multibyte "\200") nil t)
+ (- (point) (point-min) 1))))))))
(defun gnus-mouse-pick-group (e)
"Enter the group under the mouse pointer."
(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))))
(defun gnus-group-read-group (&optional all no-article group select-articles)
"Read news in this newsgroup.
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
-group."
+readable.
+
+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.
+
+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 group."
(interactive "P")
(let ((no-display (eq all 0))
(group (or group (gnus-group-group-name)))
(message "Quit reading the ephemeral group")
nil)))))
+(defcustom gnus-gmane-group-download-format
+ "http://download.gmane.org/%s/%s/%s"
+ "URL for downloading mbox files.
+It must contain three \"%s\". They correspond to the group, the
+minimal and maximal article numbers, respectively."
+ :group 'gnus-group-foreign
+ :version "23.1" ;; No Gnus
+ :type 'string)
+
+(autoload 'url-insert-file-contents "url-handlers")
+;; FIXME:
+;; - Add documentation, menu, key bindings, ...
+
+(defun gnus-read-ephemeral-gmane-group (group start &optional range)
+ "Read articles from Gmane group GROUP as an ephemeral group.
+START is the first article. RANGE specifies how many articles
+are fetched. The articles are downloaded via HTTP using the URL
+specified by `gnus-gmane-group-download-format'."
+ ;; See <http://gmane.org/export.php> for more information.
+ (interactive
+ (list
+ (gnus-group-completing-read "Gmane group: ")
+ (read-number "Start article number: ")
+ (read-number "How many articles: ")))
+ (unless range (setq range 500))
+ (when (< range 1)
+ (error "Invalid range: %s" range))
+ (let ((tmpfile (make-temp-file
+ (format "%s.start-%s.range-%s." group start range)))
+ (gnus-thread-sort-functions '(gnus-thread-sort-by-number)))
+ (with-temp-file tmpfile
+ (url-insert-file-contents
+ (format gnus-gmane-group-download-format
+ group start (+ start range)))
+ (write-region (point-min) (point-max) tmpfile)
+ (gnus-group-read-ephemeral-group
+ (format "%s.start-%s.range-%s" group start range)
+ `(nndoc ,tmpfile
+ (nndoc-article-type mbox))))
+ (delete-file tmpfile)))
+
+(defun gnus-read-ephemeral-gmane-group-url (url)
+ "Create an ephemeral Gmane group from URL.
+
+Valid input formats include:
+\"http://thread.gmane.org/gmane.foo.bar/12300/focus=12399\",
+\"http://thread.gmane.org/gmane.foo.bar/12345/\",
+\"http://article.gmane.org/gmane.foo.bar/12345/\",
+\"http://news.gmane.org/group/gmane.foo.bar/thread=12345\""
+ ;; - Feel free to add other useful Gmane URLs here! Maybe the URLs should
+ ;; be customizable?
+ ;; - The URLs should be added to `gnus-button-alist'. Probably we should
+ ;; prompt the user to decide: "View via `browse-url' or in Gnus? "
+ ;; (`gnus-read-ephemeral-gmane-group-url')
+ (interactive
+ (list (gnus-group-completing-read "Gmane URL: ")))
+ (let (group start range)
+ (cond
+ ;; URLs providing `group', `start' and `range':
+ ((string-match
+ ;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525
+ "^http://thread\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$"
+ url)
+ (setq group (match-string 1 url)
+ start (string-to-number (match-string 2 url))
+ ;; Ensure that `range' is large enough to ensure focus article is
+ ;; included.
+ range (- (string-to-number (match-string 3 url))
+ start -1)))
+ ;; URLs providing `group' and `start':
+ ((or (string-match
+ ;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584
+ "^http://\\(?:thread\\|article\\|permalink\\)\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
+ url)
+ (string-match
+ ;; Don't advertise these in the doc string yet:
+ "^\\(?:nntp\\|news\\)://news\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
+ url)
+ (string-match
+ ;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t
+ "^http://news\.gmane\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)"
+ url))
+ (setq group (match-string 1 url)
+ start (string-to-number (match-string 2 url))))
+ (t
+ (error "Can't parse URL %s" url)))
+ (gnus-read-ephemeral-gmane-group group start range)))
+
+(defcustom gnus-bug-group-download-format-alist
+ '((emacs ;; Only a test bed yet:
+ . "http://emacsbugs.donarmstrong.com/cgi-bin/bugreport.cgi?mbox=yes;bug=%s")
+ (debian
+ . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes"))
+ "Alist of symbols for bug trackers and the corresponding URL format string.
+The URL format string must contain a single \"%s\", specifying
+the bug number, and browsing the URL must return mbox output."
+ :group 'gnus-group-foreign
+ :version "23.1" ;; No Gnus
+ :type '(repeat (cons (symbol) (string :tag "URL format string"))))
+
+(defun gnus-read-ephemeral-bug-group (number mbox-url)
+ "Browse bug NUMBER as ephemeral group."
+ (interactive (list (read-string "Enter bug number: "
+ (thing-at-point 'word) nil)
+ ;; FIXME: Add completing-read from
+ ;; `gnus-emacs-bug-group-download-format' ...
+ (cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
+ (when (stringp number)
+ (setq number (string-to-number number)))
+ (let ((tmpfile (make-temp-file "gnus-temp-group-")))
+ (with-temp-file tmpfile
+ (url-insert-file-contents (format mbox-url number))
+ (write-region (point-min) (point-max) tmpfile)
+ (gnus-group-read-ephemeral-group
+ "gnus-read-ephemeral-bug"
+ `(nndoc ,tmpfile
+ (nndoc-article-type mbox))))
+ (delete-file tmpfile)))
+
+(defun gnus-read-ephemeral-debian-bug-group (number)
+ "Browse Debian bug NUMBER as ephemeral group."
+ (interactive (list (read-string "Enter bug number: "
+ (thing-at-point 'word) nil)))
+ (gnus-read-ephemeral-bug-group
+ number
+ (cdr (assoc 'debian gnus-bug-group-download-format-alist))))
+
+(defun gnus-read-ephemeral-emacs-bug-group (number)
+ "Browse Emacs bug NUMBER as ephemeral group."
+ (interactive (list (read-string "Enter bug number: "
+ (thing-at-point 'word) nil)))
+ (gnus-read-ephemeral-bug-group
+ number
+ (cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
+
(defun gnus-group-jump-to-group (group &optional prompt)
"Jump to newsgroup GROUP.
When used interactively, GROUP is the group under point
and NEW-NAME will be prompted for."
(interactive
- (list
- (gnus-group-group-name)
- (progn
- (unless (gnus-check-backend-function
- 'request-rename-group (gnus-group-group-name))
- (error "This back end does not support renaming groups"))
- (gnus-read-group "Rename group to: "
- (gnus-group-real-name (gnus-group-group-name))))))
+ (let ((group (gnus-group-group-name))
+ method new-name)
+ (unless (gnus-check-backend-function 'request-rename-group group)
+ (error "This back end does not support renaming groups"))
+ (setq new-name (gnus-read-group
+ "Rename group to: "
+ (gnus-group-real-name (gnus-group-decoded-name group)))
+ method (gnus-info-method (gnus-get-info group)))
+ (list group (mm-encode-coding-string
+ new-name
+ (gnus-group-name-charset
+ method
+ (gnus-group-prefixed-name new-name method))))))
(unless (gnus-check-backend-function 'request-rename-group group)
(error "This back end does not support renaming groups"))
(gnus-group-real-name new-name)
(gnus-info-method (gnus-get-info group)))))
- (when (gnus-active new-name)
- (error "The group %s already exists" new-name))
+ (let ((decoded-group (gnus-group-decoded-name group))
+ (decoded-new-name (gnus-group-decoded-name new-name)))
+ (when (gnus-active new-name)
+ (error "The group %s already exists" decoded-new-name))
- (gnus-message 6 "Renaming group %s to %s..." group new-name)
- (prog1
- (if (progn
- (gnus-group-goto-group group)
- (not (when (< (gnus-group-group-level) gnus-level-zombie)
- (gnus-request-rename-group group new-name))))
- (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
- ;; We rename the group internally by killing it...
- (gnus-group-kill-group)
- ;; ... changing its name ...
- (setcar (cdar gnus-list-of-killed-groups) new-name)
- ;; ... and then yanking it. Magic!
- (gnus-group-yank-group)
- (gnus-set-active new-name (gnus-active group))
- (gnus-message 6 "Renaming group %s to %s...done" group new-name)
- new-name)
- (setq gnus-killed-list (delete group gnus-killed-list))
- (gnus-set-active group nil)
- (gnus-dribble-touch)
- (gnus-group-position-point)))
+ (gnus-message 6 "Renaming group %s to %s..."
+ decoded-group decoded-new-name)
+ (prog1
+ (if (progn
+ (gnus-group-goto-group group)
+ (not (when (< (gnus-group-group-level) gnus-level-zombie)
+ (gnus-request-rename-group group new-name))))
+ (gnus-error 3 "Couldn't rename group %s to %s"
+ decoded-group decoded-new-name)
+ ;; We rename the group internally by killing it...
+ (gnus-group-kill-group)
+ ;; ... changing its name ...
+ (setcar (cdar gnus-list-of-killed-groups) new-name)
+ ;; ... and then yanking it. Magic!
+ (gnus-group-yank-group)
+ (gnus-set-active new-name (gnus-active group))
+ (gnus-message 6 "Renaming group %s to %s...done"
+ decoded-group decoded-new-name)
+ new-name)
+ (setq gnus-killed-list (delete group gnus-killed-list))
+ (gnus-set-active group nil)
+ (gnus-dribble-touch)
+ (gnus-group-position-point))))
(defun gnus-group-edit-group (group &optional part)
"Edit the group on the current line."
(let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
nil t)
gnus-useful-groups)))
- (list (cadr entry) (caddr entry))))
+ (list (cadr entry)
+ ;; Don't use `caddr' here since macros within the `interactive'
+ ;; form won't be expanded.
+ (car (cddr entry)))))
(setq method (gnus-copy-sequence method))
(let (entry)
(while (setq entry (memq (assq 'eval method) method))
(cons (current-buffer)
(if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
+(defvar nnrss-group-alist)
(eval-when-compile
- (defvar nnrss-group-alist)
(defun nnrss-discover-feed (arg))
(defun nnrss-save-server-data (arg)))
(defun gnus-group-make-rss-group (&optional url)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
(defvar nnkiboze-score-file)
+(declare-function nnkiboze-score-file "nnkiboze" (group))
+
(defun gnus-group-make-kiboze-group (group address scores)
"Create an nnkiboze group.
The user will be prompted for a name, a regexp to match groups, and
'summary 'group)))
(error "Couldn't enter %s" dir))))
-(eval-and-compile
- (autoload 'nnimap-expunge "nnimap")
- (autoload 'nnimap-acl-get "nnimap")
- (autoload 'nnimap-acl-edit "nnimap"))
+(autoload 'nnimap-expunge "nnimap")
+(autoload 'nnimap-acl-get "nnimap")
+(autoload 'nnimap-acl-edit "nnimap")
(defun gnus-group-nnimap-expunge (group)
"Expunge deleted articles in current nnimap GROUP."
(provide 'gnus-group)
-;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6
+;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6
;;; gnus-group.el ends here