diff lisp/gnus/gnus-group.el @ 111573:e89dd9c3633b

merge trunk
author Kenichi Handa <handa@m17n.org>
date Mon, 08 Nov 2010 14:19:54 +0900
parents b527d5f89f7f
children faa4a1c986c6
line wrap: on
line diff
--- a/lisp/gnus/gnus-group.el	Mon Nov 08 14:19:24 2010 +0900
+++ b/lisp/gnus/gnus-group.el	Mon Nov 08 14:19:54 2010 +0900
@@ -55,6 +55,8 @@
 (autoload 'gnus-agent-total-fetched-for "gnus-agent")
 (autoload 'gnus-cache-total-fetched-for "gnus-cache")
 
+(autoload 'gnus-group-make-nnir-group "nnir")
+
 (defcustom gnus-no-groups-message "No Gnus is good news"
   "*Message displayed by Gnus when no groups are available."
   :group 'gnus-start
@@ -117,10 +119,11 @@
   :type 'boolean)
 
 (defcustom gnus-group-default-list-level gnus-level-subscribed
-  "*Default listing level.
+  "Default listing level.
 Ignored if `gnus-group-use-permanent-levels' is non-nil."
   :group 'gnus-group-listing
-  :type 'integer)
+  :type '(choice (integer :tag "Level")
+                 (function :tag "Function returning level")))
 
 (defcustom gnus-group-list-inactive-groups t
   "*If non-nil, inactive groups will be listed."
@@ -653,6 +656,7 @@
   "D" gnus-group-enter-directory
   "f" gnus-group-make-doc-group
   "w" gnus-group-make-web-group
+  "G" gnus-group-make-nnir-group
   "M" gnus-group-read-ephemeral-group
   "r" gnus-group-rename-group
   "R" gnus-group-make-rss-group
@@ -737,7 +741,6 @@
   "e" gnus-score-edit-all-score)
 
 (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
-  "C" gnus-group-fetch-control
   "d" gnus-group-describe-group
   "v" gnus-version)
 
@@ -757,7 +760,6 @@
        (symbol-value 'gnus-topic-mode)))
 
 (defun gnus-group-make-menu-bar ()
-  (gnus-turn-off-edit-menu 'group)
   (unless (boundp 'gnus-group-reading-menu)
 
     (easy-menu-define
@@ -804,10 +806,6 @@
        ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
 	,@(if (featurep 'xemacs) nil
 	    '(:help "Display description of the current group"))]
-       ["Fetch control message" gnus-group-fetch-control
-	:active (gnus-group-group-name)
-	,@(if (featurep 'xemacs) nil
-	    '(:help "Display the archived control message for the current group"))]
        ;; Actually one should check, if any of the marked groups gives t for
        ;; (gnus-check-backend-function 'request-expire-articles ...)
        ["Expire articles" gnus-group-expire-articles
@@ -905,6 +903,7 @@
 	["Add the help group" gnus-group-make-help-group t]
 	["Make a doc group..." gnus-group-make-doc-group t]
 	["Make a web group..." gnus-group-make-web-group t]
+	["Make a search group..." gnus-group-make-nnir-group t]
 	["Make a virtual group..." gnus-group-make-empty-virtual t]
 	["Add a group to a virtual..." gnus-group-add-to-virtual t]
 	["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
@@ -1086,8 +1085,7 @@
   (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
+             (display-graphic-p)
 	     (or (not gnus-group-tool-bar-map) force))
     (let* ((load-path
 	    (gmm-image-load-path-for-library "gnus"
@@ -1166,6 +1164,12 @@
   (mouse-set-point e)
   (gnus-group-read-group nil))
 
+(defun gnus-group-default-list-level ()
+  "Return the real value for `gnus-group-default-list-level'."
+  (if (functionp gnus-group-default-list-level)
+      (funcall gnus-group-default-list-level)
+    gnus-group-default-list-level))
+
 ;; Look at LEVEL and find out what the level is really supposed to be.
 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
@@ -1175,13 +1179,13 @@
     (or (setq gnus-group-use-permanent-levels
 	      (or level (if (numberp gnus-group-use-permanent-levels)
 			    gnus-group-use-permanent-levels
-			  (or gnus-group-default-list-level
+			  (or (gnus-group-default-list-level)
 			      gnus-level-subscribed))))
-	gnus-group-default-list-level gnus-level-subscribed))
+	(gnus-group-default-list-level) gnus-level-subscribed))
    (number-or-nil
     level)
    (t
-    (or level gnus-group-default-list-level gnus-level-subscribed))))
+    (or level (gnus-group-default-list-level) gnus-level-subscribed))))
 
 (defun gnus-group-setup-buffer ()
   (set-buffer (gnus-get-buffer-create gnus-group-buffer))
@@ -1227,7 +1231,7 @@
 	     (prefix-numeric-value current-prefix-arg)
 	   (or
 	    (gnus-group-default-level nil t)
-	    gnus-group-default-list-level
+	    (gnus-group-default-list-level)
 	    gnus-level-subscribed))))
   (unless level
     (setq level (car gnus-group-list-mode)
@@ -1548,7 +1552,7 @@
 	      ?m ? ))
 	 (gnus-tmp-moderated-string
 	  (if (eq gnus-tmp-moderated ?m) "(m)" ""))
-         (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-qualified-group))
+         (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-group))
 	 (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
 	 (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
 	 (gnus-tmp-news-method-string
@@ -1597,9 +1601,7 @@
     (when (inline (gnus-visual-p 'group-highlight 'highlight))
       (gnus-group-highlight-line gnus-tmp-group beg end))
     (gnus-run-hooks 'gnus-group-update-hook)
-    (forward-line)
-    ;; Allow XEmacs to remove front-sticky text properties.
-    (gnus-group-remove-excess-properties)))
+    (forward-line)))
 
 (defun gnus-group-update-eval-form (group list)
   "Eval `car' of each element of LIST, and return the first that return t.
@@ -1888,7 +1890,7 @@
       (unless no-advance
 	(gnus-group-next-group 1))
       (decf n))
-    (gnus-summary-position-point)
+    (gnus-group-position-point)
     n))
 
 (defun gnus-group-unmark-group (n)
@@ -2190,11 +2192,13 @@
 				      require-match initial-input
 				      (or hist 'gnus-group-history)
 				      def))
-    (if (if (listp collection)
-	    (member group (mapcar 'symbol-name collection))
-	  (symbol-value (intern-soft group collection)))
-	group
-      (mm-encode-coding-string group (gnus-group-name-charset nil group)))))
+    (unless (if (listp collection)
+		(member group (mapcar 'symbol-name collection))
+	      (symbol-value (intern-soft group collection)))
+      (setq group
+	    (mm-encode-coding-string
+	     group (gnus-group-name-charset nil group))))
+    (gnus-replace-in-string group "\n" "")))
 
 ;;;###autoload
 (defun gnus-fetch-group (group &optional articles)
@@ -2263,7 +2267,7 @@
    (list
     ;; (gnus-read-group "Group name: ")
     (gnus-group-completing-read)
-    (gnus-read-method "From method: ")))
+    (gnus-read-method "From method")))
   ;; Transform the select method into a unique server.
   (when (stringp method)
     (setq method (gnus-server-to-method method)))
@@ -2424,9 +2428,9 @@
       (while (re-search-forward "^To: " nil t)
 	(end-of-line)
 	(insert (format ", %s@%s" number
-			(replace-regexp-in-string
-			 "/.*$" ""
-			 (replace-regexp-in-string "^http://" "" mbox-url)))))
+			(gnus-replace-in-string
+			 (gnus-replace-in-string mbox-url "^http://" "")
+			 "/.*$" ""))))
       (write-region (point-min) (point-max) tmpfile)
       (gnus-group-read-ephemeral-group
        "gnus-read-ephemeral-bug"
@@ -2670,7 +2674,7 @@
   (interactive
    (list
     (gnus-read-group "Group name: ")
-    (gnus-read-method "From method: ")))
+    (gnus-read-method "From method")))
 
   (when (stringp method)
     (setq method (or (gnus-server-to-method method) method)))
@@ -3677,7 +3681,7 @@
 Killed newsgroups are subscribed.  If SILENT, don't try to update the
 group line."
   (interactive (list (gnus-group-completing-read
-		      nil (gnus-read-active-file-p))))
+		      nil nil (gnus-read-active-file-p))))
   (let ((newsrc (gnus-group-entry group)))
     (cond
      ((string-match "^[ \t]*$" group)
@@ -3979,7 +3983,7 @@
   (let* ((groups (gnus-group-process-prefix n))
 	 (ret (if (numberp n) (- n (length groups)) 0))
 	 (beg (unless n
-		(point)))
+		(point-marker)))
 	 group method
 	 (gnus-inhibit-demon t)
 	 ;; Binding this variable will inhibit multiple fetchings
@@ -4010,35 +4014,9 @@
       (goto-char beg))
     (when gnus-goto-next-group-when-activating
       (gnus-group-next-unread-group 1 t))
-    (gnus-summary-position-point)
+    (gnus-group-position-point)
     ret))
 
-(defun gnus-group-fetch-control (group)
-  "Fetch the archived control messages for the current group.
-If given a prefix argument, prompt for a group."
-  (interactive
-   (list (or (when current-prefix-arg
-	       (gnus-group-completing-read))
-	     (gnus-group-group-name)
-	     gnus-newsgroup-name)))
-  (unless group
-    (error "No group name given"))
-  (let ((name (gnus-group-real-name group))
-	hierarchy)
-    (when (string-match "\\(^[^\\.]+\\)\\..*" name)
-      (setq hierarchy (match-string 1 name))
-      (if gnus-group-fetch-control-use-browse-url
-	  (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
-			      hierarchy "/" name ".gz"))
-	(let ((enable-local-variables nil))
-	  (gnus-group-read-ephemeral-group
-	   group
-	   `(nndoc ,group (nndoc-address
-			   ,(find-file-noselect
-			     (concat "/ftp@ftp.isc.org:/usenet/control/"
-				     hierarchy "/" name ".gz")))
-		   (nndoc-article-type mbox)) t nil nil))))))
-
 (defun gnus-group-describe-group (force &optional group)
   "Display a description of the current newsgroup."
   (interactive (list current-prefix-arg (gnus-group-group-name)))
@@ -4208,8 +4186,14 @@
 With 2 C-u's, use most complete method possible to query the server
 for new groups, and subscribe the new groups as zombies."
   (interactive "p")
-  (gnus-find-new-newsgroups (or arg 1))
-  (gnus-group-list-groups))
+  (let ((new-groups (gnus-find-new-newsgroups (or arg 1)))
+	current-group)
+    (gnus-group-list-groups)
+    (setq current-group (gnus-group-group-name))
+    (dolist (group new-groups)
+      (gnus-group-jump-to-group group))
+    (when current-group
+      (gnus-group-jump-to-group current-group))))
 
 (defun gnus-group-edit-global-kill (&optional article group)
   "Edit the global kill file.