Merge remote-tracking branch 'origin/no-gnus'
[gnus] / lisp / gnus-group.el
index c265538..16fe90c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; gnus-group.el --- group mode commands for Gnus
 
-;; Copyright (C) 1996-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012  Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -56,7 +56,7 @@
 
 (autoload 'gnus-group-make-nnir-group "nnir")
 
-(defcustom gnus-no-groups-message "No Gnus is good news"
+(defcustom gnus-no-groups-message "No news is good news"
   "*Message displayed by Gnus when no groups are available."
   :group 'gnus-start
   :type 'string)
@@ -362,7 +362,7 @@ If you want to modify the group buffer, you can use this hook."
      gnus-group-news-low))
   "*Controls the highlighting of group buffer lines.
 
-Below is a list of `Form'/`Face' pairs.  When deciding how a a
+Below is a list of `Form'/`Face' pairs.  When deciding how a
 particular group line should be displayed, each form is
 evaluated.  The content of the face field after the first true form is
 used.  You can change how those group lines are displayed by
@@ -710,7 +710,8 @@ simple manner.")
   "M"  gnus-group-list-limit
   "l"  gnus-group-list-limit
   "c"  gnus-group-list-limit
-  "?"  gnus-group-list-limit)
+  "?"  gnus-group-list-limit
+  "!"  gnus-group-list-limit)
 
 (gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
   "k"  gnus-group-list-flush
@@ -722,7 +723,8 @@ simple manner.")
   "M"  gnus-group-list-flush
   "l"  gnus-group-list-flush
   "c"  gnus-group-list-flush
-  "?"  gnus-group-list-flush)
+  "?"  gnus-group-list-flush
+  "!"  gnus-group-list-flush)
 
 (gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
   "k"  gnus-group-list-plus
@@ -734,7 +736,8 @@ simple manner.")
   "M"  gnus-group-list-plus
   "l"  gnus-group-list-plus
   "c"  gnus-group-list-plus
-  "?"  gnus-group-list-plus)
+  "?"  gnus-group-list-plus
+  "!"  gnus-group-list-plus)
 
 (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
   "f" gnus-score-flush-cache
@@ -989,7 +992,7 @@ Setter function for custom variables."
                                 'gnus-group-tool-bar-retro)
   "Specifies the Gnus group tool bar.
 
-It can be either a list or a symbol refering to a list.  See
+It can be either a list or a symbol referring to a list.  See
 `gmm-tool-bar-from-list' for the format of the list.  The
 default key map is `gnus-group-mode-map'.
 
@@ -1008,10 +1011,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)
@@ -1194,21 +1197,27 @@ The following commands are available:
     (gnus-group-mode)))
 
 (defun gnus-group-name-charset (method group)
-  (if (null method)
-      (setq method (gnus-find-method-for-group group)))
-  (let ((item (or (assoc method gnus-group-name-charset-method-alist)
-                 (and (consp method)
-                      (assoc (list (car method) (cadr method))
-                             gnus-group-name-charset-method-alist))))
-       (alist gnus-group-name-charset-group-alist)
-       result)
-    (if item
-       (cdr item)
-      (while (setq item (pop alist))
-       (if (string-match (car item) group)
-           (setq alist nil
-                 result (cdr item))))
-      result)))
+  (unless method
+    (setq method (gnus-find-method-for-group group)))
+  (when (stringp method)
+    (setq method (gnus-server-to-method method)))
+  (if (eq (car method) 'nnimap)
+      ;; IMAP groups should not be encoded, since they do the encoding
+      ;; in utf7 in the protocol.
+      'utf-8
+    (let ((item (or (assoc method gnus-group-name-charset-method-alist)
+                   (and (consp method)
+                        (assoc (list (car method) (cadr method))
+                               gnus-group-name-charset-method-alist))))
+         (alist gnus-group-name-charset-group-alist)
+         result)
+      (if item
+         (cdr item)
+       (while (setq item (pop alist))
+         (if (string-match (car item) group)
+             (setq alist nil
+                   result (cdr item))))
+       result))))
 
 (defun gnus-group-name-decode (string charset)
   ;; Fixme: Don't decode in unibyte mode.
@@ -1345,14 +1354,14 @@ if it is a string, only list groups matching REGEXP."
                     (predicate t)      ; We list all groups?
                     (t
                      (or
-                      (if (eq unread t) ; Unactivated?
+                      (if (eq unread t) ; Inactive?
                           gnus-group-list-inactive-groups
-                                       ; We list unactivated
+                                       ; We list inactive
                         (and (numberp unread) (> unread 0)))
                                        ; We list groups with unread articles
                       (and gnus-list-groups-with-ticked-articles
                            (cdr (assq 'tick (gnus-info-marks info))))
-                                       ; And groups with tickeds
+                                       ; And groups with ticked articles
                       ;; Check for permanent visibility.
                       (and gnus-permanently-visible-groups
                            (string-match gnus-permanently-visible-groups
@@ -1437,7 +1446,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 +1695,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 +1708,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
@@ -2263,8 +2277,8 @@ confirmation is required."
                                              number)
   "Read GROUP from METHOD as an ephemeral group.
 If ACTIVATE, request the group first.
-If QUIT-CONFIG, use that window configuration when exiting from the
-ephemeral group.
+If QUIT-CONFIG, use that Gnus window configuration name when
+exiting from the ephemeral group.
 If REQUEST-ONLY, don't actually read the group; just request it.
 If SELECT-ARTICLES, only select those articles.
 If PARAMETERS, use those as the group parameters.
@@ -2277,6 +2291,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 +2307,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,33 +2429,41 @@ 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")
+  '((emacs . "http://debbugs.gnu.org/%s;mboxmaint=yes;mboxstat=yes")
     (debian
-     . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes"))
+     . "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.
 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.2" ;; No Gnus
+  ;; Added mboxmaint=yes.  This gets the version with the messages as
+  ;; they went out, not as they came in.
+  ;; Eg bug-gnu-emacs is replaced by ###@debbugs.
+  :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://" "")
                         "/.*$" ""))))
@@ -2444,7 +2471,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)
@@ -2455,13 +2483,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.
@@ -2712,7 +2750,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)
@@ -3441,13 +3480,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."
@@ -3564,7 +3604,8 @@ or nil if no action could be taken."
        (gnus-add-marked-articles group 'tick nil nil 'force)
        (gnus-add-marked-articles group 'dormant nil nil 'force))
       ;; Do auto-expirable marks if that's required.
-      (when (gnus-group-auto-expirable-p group)
+      (when (and (gnus-group-auto-expirable-p group)
+                (not (gnus-group-read-only-p group)))
         (gnus-range-map
         (lambda (article)
           (gnus-add-marked-articles group 'expire (list article))
@@ -3968,11 +4009,13 @@ entail asking the server for the groups."
        (gnus-activate-foreign-newsgroups level))
     (gnus-group-get-new-news)))
 
-(defun gnus-group-get-new-news (&optional arg)
+(defun gnus-group-get-new-news (&optional arg one-level)
   "Get newly arrived articles.
 If ARG is a number, it specifies which levels you are interested in
 re-scanning.  If ARG is non-nil and not a number, this will force
-\"hard\" re-reading of the active files from all servers."
+\"hard\" re-reading of the active files from all servers.
+If ONE-LEVEL is not nil, then re-scan only the specified level,
+otherwise all levels below ARG will be scanned too."
   (interactive "P")
   (require 'nnmail)
   (let ((gnus-inhibit-demon t)
@@ -3986,7 +4029,7 @@ re-scanning.  If ARG is non-nil and not a number, this will force
     (unless gnus-slave
       (gnus-master-read-slave-newsrc))
 
-    (gnus-get-unread-articles arg)
+    (gnus-get-unread-articles arg nil one-level)
 
     ;; If the user wants it, we scan for new groups.
     (when (eq gnus-check-new-newsgroups 'always)
@@ -4028,11 +4071,8 @@ 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))
-       (if (eq (gnus-server-status (gnus-find-method-for-group group))
-               'denied)
-           (gnus-error 3 "Server denied access")
-         (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
+           (gnus-group-update-group group nil t))
+       (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
     (when beg
       (goto-char beg))
     (when gnus-goto-next-group-when-activating
@@ -4407,7 +4447,7 @@ and the second element is the address."
 ;; file.  Use with caution, if at all.
 (defun gnus-import-other-newsrc-file (file)
   (with-temp-buffer
-    (insert-file file)
+    (insert-file-contents file)
     (let (form)
       (while (ignore-errors
               (setq form (read (current-buffer))))
@@ -4598,7 +4638,12 @@ This command may read the active file."
     (gnus-group-list-plus args)))
 
 (defun gnus-group-list-limit (&optional args)
-  "List groups limited within the current selection."
+  "List groups limited within the current selection.
+If you've limited the groups, you can further limit the selection
+with this command.  If you've first limited to groups with
+dormant articles with `A ?', you can then further limit with
+`A / c', which will then limit to groups with cached articles, giving
+you the groups that have both dormant articles and cached articles."
   (interactive "P")
   (let ((gnus-group-list-option 'limit))
     (gnus-group-list-plus args)))
@@ -4627,10 +4672,11 @@ This command may read the active file."
                  (push n gnus-newsgroup-unselected))
                (setq n (1+ n)))
              (setq gnus-newsgroup-unselected
-                   (nreverse gnus-newsgroup-unselected)))))
+                   (sort gnus-newsgroup-unselected '<)))))
       (gnus-activate-group group)
       (gnus-group-make-articles-read group (list article))
-      (when (gnus-group-auto-expirable-p group)
+      (when (and (gnus-group-auto-expirable-p group)
+                (not (gnus-group-read-only-p group)))
        (gnus-add-marked-articles
         group 'expire (list article))))))