Merge from emacs--devo--0
[gnus] / lisp / gnus-group.el
index 73d6325..fbf0cf0 100644 (file)
@@ -1,27 +1,25 @@
 ;;; 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, 2009 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:
 
@@ -1031,7 +1029,7 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
                 (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)
@@ -1074,7 +1072,7 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
 
 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)
@@ -1093,7 +1091,7 @@ See `gmm-tool-bar-from-list' for the format of the list."
 
 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)
@@ -1104,12 +1102,13 @@ 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
+  :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'.
@@ -1188,8 +1187,8 @@ The following commands are available:
       (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."
@@ -2055,10 +2054,15 @@ and with point over the group in question."
 (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)))
@@ -2320,6 +2324,141 @@ Return the name of the group if selection was successful."
         (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.
 
@@ -2786,7 +2925,10 @@ and NEW-NAME will be prompted for."
    (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))
@@ -3092,10 +3234,9 @@ score file entries for articles to include in the group."
                       '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."
@@ -4651,5 +4792,5 @@ Compacting group %s... (this may take a long time)"
 
 (provide 'gnus-group)
 
-;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6
+;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6
 ;;; gnus-group.el ends here