]> code.delx.au - gnu-emacs/blobdiff - lisp/gnus/gnus-group.el
merge trunk
[gnu-emacs] / lisp / gnus / gnus-group.el
index 4c474b0aa23f34b533be84a1c9c06c3e4720fbb6..5ae29053b6f61419a0c26a5f576e0fd6566a7809 100644 (file)
@@ -1008,10 +1008,10 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and
   '((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
+    (gnus-agent-toggle-plugged "unplugged" t
                               :help "Gnus is currently unplugged.  Click to work online."
                               :visible (and gnus-agent (not gnus-plugged)))
-    (gnus-agent-toggle-plugged "connect" t
+    (gnus-agent-toggle-plugged "plugged" 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)
@@ -1437,7 +1437,8 @@ if it is a string, only list groups matching REGEXP."
           (gnus-dribble-enter
            (concat "(gnus-group-set-info '"
                    (gnus-prin1-to-string (nth 2 entry))
-                   ")")))
+                   ")")
+           (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\"")))
       (setq gnus-group-indentation (gnus-group-group-indentation))
       (gnus-delete-line)
       (gnus-group-insert-group-line-info group)
@@ -1685,10 +1686,11 @@ and ends at END."
                                     (gnus-active group))
   (gnus-group-update-group group))
 
-(defun gnus-group-update-group (group &optional visible-only)
+(defun gnus-group-update-group (group &optional visible-only
+                                     info-unchanged)
   "Update all lines where GROUP appear.
 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
-already."
+already.  If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
   (with-current-buffer gnus-group-buffer
     (save-excursion
       ;; The buffer may be narrowed.
@@ -1697,14 +1699,17 @@ already."
         (let ((ident (gnus-intern-safe group gnus-active-hashtb))
               (loc (point-min))
               found buffer-read-only)
-          ;; Enter the current status into the dribble buffer.
-          (let ((entry (gnus-group-entry group)))
-            (when (and entry
-                       (not (gnus-ephemeral-group-p group)))
-              (gnus-dribble-enter
-               (concat "(gnus-group-set-info '"
-                       (gnus-prin1-to-string (nth 2 entry))
-                       ")"))))
+         (unless info-unchanged
+           ;; Enter the current status into the dribble buffer.
+           (let ((entry (gnus-group-entry group)))
+             (when (and entry
+                        (not (gnus-ephemeral-group-p group)))
+               (gnus-dribble-enter
+                (concat "(gnus-group-set-info '"
+                        (gnus-prin1-to-string (nth 2 entry))
+                        ")")
+                (concat "^(gnus-group-set-info '(\""
+                        (regexp-quote group) "\"")))))
           ;; Find all group instances.  If topics are in use, each group
           ;; may be listed in more than once.
           (while (setq loc (text-property-any
@@ -2277,6 +2282,8 @@ Return the name of the group if selection was successful."
     (gnus-group-completing-read)
     (gnus-read-method "From method")))
   ;; Transform the select method into a unique server.
+  (unless (gnus-alive-p)
+    (gnus-no-server))
   (when (stringp method)
     (setq method (gnus-server-to-method method)))
   (setq method
@@ -2291,11 +2298,14 @@ Return the name of the group if selection was successful."
      `(-1 nil (,group
               ,gnus-level-default-subscribed nil nil ,method
               ,(cons
-                (if quit-config
-                    (cons 'quit-config quit-config)
+                (cond
+                 (quit-config
+                  (cons 'quit-config quit-config))
+                 ((assq gnus-current-window-configuration
+                        gnus-buffer-configuration)
                   (cons 'quit-config
                         (cons gnus-summary-buffer
-                              gnus-current-window-configuration)))
+                              gnus-current-window-configuration))))
                 parameters)))
      gnus-newsrc-hashtb)
     (push method gnus-ephemeral-servers)
@@ -2410,7 +2420,7 @@ Valid input formats include:
     (gnus-read-ephemeral-gmane-group group start range)))
 
 (defcustom gnus-bug-group-download-format-alist
-  '((emacs . "http://debbugs.gnu.org/%s;mbox=yes;mboxmaint=yes")
+  '((emacs . "http://debbugs.gnu.org/%s;mboxstat=yes")
     (debian
      . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes;mboxmaint=yes"))
   "Alist of symbols for bug trackers and the corresponding URL format string.
@@ -2423,23 +2433,28 @@ the bug number, and browsing the URL must return mbox output."
   :version "24.1"
   :type '(repeat (cons (symbol) (string :tag "URL format string"))))
 
-(defun gnus-read-ephemeral-bug-group (number mbox-url)
+(defun gnus-read-ephemeral-bug-group (ids mbox-url &optional window-conf)
   "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 (mm-make-temp-file "gnus-temp-group-")))
+  (when (stringp ids)
+    (setq ids (string-to-number ids)))
+  (unless (listp ids)
+    (setq ids (list ids)))
+  (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))
+       (coding-system-for-write 'binary)
+       (coding-system-for-read 'binary))
     (with-temp-file tmpfile
-      (url-insert-file-contents (format mbox-url number))
+      (dolist (id ids)
+       (url-insert-file-contents (format mbox-url id)))
       (goto-char (point-min))
       ;; Add the debbugs address so that we can respond to reports easily.
       (while (re-search-forward "^To: " nil t)
        (end-of-line)
-       (insert (format ", %s@%s" number
+       (insert (format ", %s@%s" (car ids)
                        (gnus-replace-in-string
                         (gnus-replace-in-string mbox-url "^http://" "")
                         "/.*$" ""))))
@@ -2447,7 +2462,8 @@ the bug number, and browsing the URL must return mbox output."
       (gnus-group-read-ephemeral-group
        "gnus-read-ephemeral-bug"
        `(nndoc ,tmpfile
-              (nndoc-article-type mbox))))
+              (nndoc-article-type mbox))
+       nil window-conf))
     (delete-file tmpfile)))
 
 (defun gnus-read-ephemeral-debian-bug-group (number)
@@ -2458,13 +2474,23 @@ the bug number, and browsing the URL must return mbox output."
    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)))
+(defvar debbugs-gnu-bug-number)                ; debbugs-gnu
+
+(defun gnus-read-ephemeral-emacs-bug-group (ids &optional window-conf)
+  "Browse Emacs bugs IDS as an ephemeral group."
+  (interactive (list (string-to-number
+                     (read-string "Enter bug number: "
+                                  (thing-at-point 'word) nil))))
+  (unless (listp ids)
+    (setq ids (list ids)))
   (gnus-read-ephemeral-bug-group
-   number
-   (cdr (assoc 'emacs gnus-bug-group-download-format-alist))))
+   ids
+   (cdr (assoc 'emacs gnus-bug-group-download-format-alist))
+   window-conf)
+  (when (fboundp 'debbugs-gnu-summary-mode)
+    (with-current-buffer (window-buffer (selected-window))
+      (debbugs-gnu-summary-mode 1)
+      (set (make-local-variable 'debbugs-gnu-bug-number) (car ids)))))
 
 (defun gnus-group-jump-to-group (group &optional prompt)
   "Jump to newsgroup GROUP.
@@ -2715,7 +2741,8 @@ server."
     (unless (gnus-ephemeral-group-p name)
       (gnus-dribble-enter
        (concat "(gnus-group-set-info '"
-              (gnus-prin1-to-string (cdr info)) ")")))
+              (gnus-prin1-to-string (cdr info)) ")")
+       (concat "^(gnus-group-set-info '(\"" (regexp-quote name) "\"")))
     ;; Insert the line.
     (gnus-group-insert-group-line-info nname)
     (forward-line -1)
@@ -3444,13 +3471,14 @@ sort in reverse order."
   "Clear all marks and read ranges from the current group.
 Obeys the process/prefix convention."
   (interactive "P")
-  (gnus-group-iterate arg
-    (lambda (group)
-      (let (info)
-       (gnus-info-clear-data (setq info (gnus-get-info group)))
-       (gnus-get-unread-articles-in-group info (gnus-active group) t)
-       (when (gnus-group-goto-group group)
-         (gnus-group-update-group-line))))))
+  (when (gnus-y-or-n-p "Really clear data? ")
+    (gnus-group-iterate arg
+      (lambda (group)
+       (let (info)
+         (gnus-info-clear-data (setq info (gnus-get-info group)))
+         (gnus-get-unread-articles-in-group info (gnus-active group) t)
+         (when (gnus-group-goto-group group)
+           (gnus-group-update-group-line)))))))
 
 (defun gnus-group-clear-data-on-native-groups ()
   "Clear all marks and read ranges from all native groups."
@@ -4032,7 +4060,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
            (when gnus-agent
              (gnus-agent-save-group-info
               method (gnus-group-real-name group) active))
-           (gnus-group-update-group group))
+           (gnus-group-update-group group nil t))
        (if (eq (gnus-server-status (gnus-find-method-for-group group))
                'denied)
            (gnus-error 3 "Server denied access")