Merge changes made in Gnus trunk.
[bpt/emacs.git] / lisp / gnus / gnus-topic.el
index ecaa786..efa543f 100644 (file)
@@ -1,7 +1,7 @@
 ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
 
 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
 ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
 
 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Ilja Weis <kult@uni-paderborn.de>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; Author: Ilja Weis <kult@uni-paderborn.de>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -9,10 +9,10 @@
 
 ;; This file is part of GNU Emacs.
 
 
 ;; 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
 ;; 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
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -20,9 +20,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; 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:
 
 
 ;;; Commentary:
 
@@ -150,8 +148,7 @@ See Info node `(gnus)Formatting Variables'."
 
 (defun gnus-group-parent-topic (group)
   "Return the topic GROUP is member of by looking at the group buffer."
 
 (defun gnus-group-parent-topic (group)
   "Return the topic GROUP is member of by looking at the group buffer."
-  (save-excursion
-    (set-buffer gnus-group-buffer)
+  (with-current-buffer gnus-group-buffer
     (if (gnus-group-goto-group group)
        (gnus-current-topic)
       (gnus-group-topic group))))
     (if (gnus-group-goto-group group)
        (gnus-current-topic)
       (gnus-group-topic group))))
@@ -164,9 +161,7 @@ See Info node `(gnus)Formatting Variables'."
 (defun gnus-topic-jump-to-topic (topic)
   "Go to TOPIC."
   (interactive
 (defun gnus-topic-jump-to-topic (topic)
   "Go to TOPIC."
   (interactive
-   (list (completing-read "Go to topic: "
-                         (mapcar 'list (gnus-topic-list))
-                         nil t)))
+   (list (gnus-completing-read "Go to topic" (gnus-topic-list) t)))
   (let ((buffer-read-only nil))
     (dolist (topic (gnus-current-topics topic))
       (unless (gnus-topic-goto-topic topic)
   (let ((buffer-read-only nil))
     (dolist (topic (gnus-current-topics topic))
       (unless (gnus-topic-goto-topic topic)
@@ -914,8 +909,7 @@ articles in the topic and its subtopics."
 
 (defun gnus-topic-change-level (group level oldlevel &optional previous)
   "Run when changing levels to enter/remove groups from topics."
 
 (defun gnus-topic-change-level (group level oldlevel &optional previous)
   "Run when changing levels to enter/remove groups from topics."
-  (save-excursion
-    (set-buffer gnus-group-buffer)
+  (with-current-buffer gnus-group-buffer
     (let ((buffer-read-only nil))
       (unless gnus-topic-inhibit-change-level
        (gnus-group-goto-group (or (car (nth 2 previous)) group))
     (let ((buffer-read-only nil))
       (unless gnus-topic-inhibit-change-level
        (gnus-group-goto-group (or (car (nth 2 previous)) group))
@@ -1142,6 +1136,7 @@ articles in the topic and its subtopics."
 
 (defun gnus-topic-mode (&optional arg redisplay)
   "Minor mode for topicsifying Gnus group buffers."
 
 (defun gnus-topic-mode (&optional arg redisplay)
   "Minor mode for topicsifying Gnus group buffers."
+  ;; FIXME: Use define-minor-mode.
   (interactive (list current-prefix-arg t))
   (when (eq major-mode 'gnus-group-mode)
     (make-local-variable 'gnus-topic-mode)
   (interactive (list current-prefix-arg t))
   (when (eq major-mode 'gnus-group-mode)
     (make-local-variable 'gnus-topic-mode)
@@ -1306,8 +1301,8 @@ When used interactively, PARENT will be the topic under point."
 If COPYP, copy the groups instead."
   (interactive
    (list current-prefix-arg
 If COPYP, copy the groups instead."
   (interactive
    (list current-prefix-arg
-        (gnus-completing-read "Move to topic" gnus-topic-alist nil t
-                              'gnus-topic-history)))
+        (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t
+                              nil 'gnus-topic-history)))
   (let ((use-marked (and (not n) (not (gnus-region-active-p))
                         gnus-group-marked t))
        (groups (gnus-group-process-prefix n))
   (let ((use-marked (and (not n) (not (gnus-region-active-p))
                         gnus-group-marked t))
        (groups (gnus-group-process-prefix n))
@@ -1353,7 +1348,8 @@ If COPYP, copy the groups instead."
   "Copy the current group to a topic."
   (interactive
    (list current-prefix-arg
   "Copy the current group to a topic."
   (interactive
    (list current-prefix-arg
-        (completing-read "Copy to topic: " gnus-topic-alist nil t)))
+        (gnus-completing-read
+         "Copy to topic" (mapcar 'car gnus-topic-alist) t)))
   (gnus-topic-move-group n topic t))
 
 (defun gnus-topic-kill-group (&optional n discard)
   (gnus-topic-move-group n topic t))
 
 (defun gnus-topic-kill-group (&optional n discard)
@@ -1446,7 +1442,8 @@ If PERMANENT, make it stay shown in subsequent sessions as well."
        (gnus-topic-remove-topic t nil)
       (let ((topic
             (gnus-topic-find-topology
        (gnus-topic-remove-topic t nil)
       (let ((topic
             (gnus-topic-find-topology
-             (completing-read "Show topic: " gnus-topic-alist nil t))))
+             (gnus-completing-read "Show topic"
+                                    (mapcar 'car gnus-topic-alist) t))))
        (setcar (cddr (cadr topic)) nil)
        (setcar (cdr (cadr topic)) 'visible)
        (gnus-group-list-groups)))))
        (setcar (cddr (cadr topic)) nil)
        (setcar (cdr (cadr topic)) 'visible)
        (gnus-group-list-groups)))))
@@ -1494,7 +1491,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
    (let (topic)
      (nreverse
       (list
    (let (topic)
      (nreverse
       (list
-       (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t))
+       (setq topic (gnus-completing-read "Move to topic"
+                                         (mapcar 'car gnus-topic-alist) t))
        (read-string (format "Move to %s (regexp): " topic))))))
   (gnus-group-mark-regexp regexp)
   (gnus-topic-move-group nil topic copyp))
        (read-string (format "Move to %s (regexp): " topic))))))
   (gnus-group-mark-regexp regexp)
   (gnus-topic-move-group nil topic copyp))
@@ -1505,7 +1503,8 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
    (let (topic)
      (nreverse
       (list
    (let (topic)
      (nreverse
       (list
-       (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t))
+       (setq topic (gnus-completing-read "Copy to topic"
+                                         (mapcar 'car gnus-topic-alist) t))
        (read-string (format "Copy to %s (regexp): " topic))))))
   (gnus-topic-move-matching regexp topic t))
 
        (read-string (format "Copy to %s (regexp): " topic))))))
   (gnus-topic-move-matching regexp topic t))
 
@@ -1726,8 +1725,9 @@ If REVERSE, sort in reverse order."
   "Sort topics in TOPIC alphabetically by topic name.
 If REVERSE, reverse the sorting order."
   (interactive
   "Sort topics in TOPIC alphabetically by topic name.
 If REVERSE, reverse the sorting order."
   (interactive
-   (list (completing-read "Sort topics in : " gnus-topic-alist nil t
-                         (gnus-current-topic))
+   (list (gnus-completing-read "Sort topics in"
+                               (mapcar 'car gnus-topic-alist) t
+                               (gnus-current-topic))
         current-prefix-arg))
   (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic)))
                            gnus-topic-topology)))
         current-prefix-arg))
   (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic)))
                            gnus-topic-topology)))
@@ -1741,7 +1741,7 @@ If REVERSE, reverse the sorting order."
   (interactive
    (list
     (gnus-group-topic-name)
   (interactive
    (list
     (gnus-group-topic-name)
-    (completing-read "Move to topic: " gnus-topic-alist nil t)))
+    (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t)))
   (unless (and current to)
     (error "Can't find topic"))
   (let ((current-top (cdr (gnus-topic-find-topology current)))
   (unless (and current to)
     (error "Can't find topic"))
   (let ((current-top (cdr (gnus-topic-find-topology current)))
@@ -1780,5 +1780,4 @@ If REVERSE, reverse the sorting order."
 
 (provide 'gnus-topic)
 
 
 (provide 'gnus-topic)
 
-;; arch-tag: bf176856-f30c-40f0-ae77-e41529a1134c
 ;;; gnus-topic.el ends here
 ;;; gnus-topic.el ends here