* gnus-cloud.el: New file to provide the Emacs Cloud.
[gnus] / lisp / gnus-group.el
index f75ef37..fcd6817 100644 (file)
@@ -1,6 +1,6 @@
 ;;; gnus-group.el --- group mode commands for Gnus
 
-;; Copyright (C) 1996-201 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2014 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 
 ;;; Code:
 
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
 (eval-when-compile
   (require 'cl))
 (defvar tool-bar-mode)
@@ -571,7 +567,6 @@ simple manner.")
   "p" gnus-group-prev-unread-group
   "\177" gnus-group-prev-unread-group
   [delete] gnus-group-prev-unread-group
-  [backspace] gnus-group-prev-unread-group
   "N" gnus-group-next-group
   "P" gnus-group-prev-group
   "\M-n" gnus-group-next-unread-group-same-level
@@ -1105,7 +1100,7 @@ When FORCE, rebuild the tool bar."
          (set (make-local-variable 'tool-bar-map) map))))
   gnus-group-tool-bar-map)
 
-(defun gnus-group-mode ()
+(define-derived-mode gnus-group-mode fundamental-mode "Group"
   "Major mode for reading news.
 
 All normal editing commands are switched off.
@@ -1122,17 +1117,12 @@ For more in-depth information on this mode, read the manual (`\\[gnus-info-find-
 The following commands are available:
 
 \\{gnus-group-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
   (when (gnus-visual-p 'group-menu 'menu)
     (gnus-group-make-menu-bar)
     (gnus-group-make-tool-bar))
   (gnus-simplify-mode-line)
-  (setq major-mode 'gnus-group-mode)
-  (setq mode-name "Group")
   (gnus-group-set-mode-line)
   (setq mode-line-process nil)
-  (use-local-map gnus-group-mode-map)
   (buffer-disable-undo)
   (setq truncate-lines t)
   (setq buffer-read-only t
@@ -1143,8 +1133,7 @@ The following commands are available:
   (when gnus-use-undo
     (gnus-undo-mode 1))
   (when gnus-slave
-    (gnus-slave-mode))
-  (gnus-run-mode-hooks 'gnus-group-mode-hook))
+    (gnus-slave-mode)))
 
 (defun gnus-update-group-mark-positions ()
   (save-excursion
@@ -1193,7 +1182,7 @@ The following commands are available:
 
 (defun gnus-group-setup-buffer ()
   (set-buffer (gnus-get-buffer-create gnus-group-buffer))
-  (unless (eq major-mode 'gnus-group-mode)
+  (unless (derived-mode-p 'gnus-group-mode)
     (gnus-group-mode)))
 
 (defun gnus-group-name-charset (method group)
@@ -1667,7 +1656,7 @@ and ends at END."
   (let ((face (cdar (gnus-group-update-eval-form
                       group
                       gnus-group-highlight))))
-    (unless (eq face (get-text-property beg 'face))
+    (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face))
       (let ((inhibit-read-only t))
         (gnus-put-text-property-excluding-characters-with-faces
          beg end 'face
@@ -2147,7 +2136,7 @@ be permanent."
 
 (defun gnus-group-name-at-point ()
   "Return a group name from around point if it exists, or nil."
-  (if (eq major-mode 'gnus-group-mode)
+  (if (derived-mode-p 'gnus-group-mode)
       (let ((group (gnus-group-group-name)))
        (when group
          (gnus-group-decoded-name group)))
@@ -2290,9 +2279,12 @@ Return the name of the group if selection was successful."
     ;; (gnus-read-group "Group name: ")
     (gnus-group-completing-read)
     (gnus-read-method "From method")))
-  ;; Transform the select method into a unique server.
   (unless (gnus-alive-p)
-    (gnus-no-server))
+    (nnheader-init-server-buffer)
+    ;; Necessary because of funky inlining.
+    (require 'gnus-cache)
+    (setq gnus-newsrc-hashtb (gnus-make-hashtable)))
+  ;; Transform the select method into a unique server.
   (when (stringp method)
     (setq method (gnus-server-to-method method)))
   (let ((address-slot
@@ -2307,23 +2299,28 @@ Return the name of the group if selection was successful."
   (let ((group (if (gnus-group-foreign-p group) group
                 (gnus-group-prefixed-name (gnus-group-real-name group)
                                           method))))
+    (gnus-set-active group nil)
     (gnus-sethash
      group
      `(-1 nil (,group
               ,gnus-level-default-subscribed nil nil ,method
               ,(cons
-                (cond
-                 (quit-config
-                  (cons 'quit-config quit-config))
-                 ((assq gnus-current-window-configuration
-                        gnus-buffer-configuration)
-                  (cons 'quit-config
+                (cons 'quit-config
+                      (cond
+                       (quit-config
+                        quit-config)
+                       ((assq gnus-current-window-configuration
+                              gnus-buffer-configuration)
                         (cons gnus-summary-buffer
-                              gnus-current-window-configuration))))
+                              gnus-current-window-configuration))
+                       (t
+                        (cons (current-buffer)
+                              (current-window-configuration)))))
                 parameters)))
      gnus-newsrc-hashtb)
     (push method gnus-ephemeral-servers)
-    (set-buffer gnus-group-buffer)
+    (when (gnus-buffer-live-p gnus-group-buffer)
+      (set-buffer gnus-group-buffer))
     (unless (gnus-check-server method)
       (error "Unable to contact server: %s" (gnus-status-message method)))
     (when activate
@@ -2381,7 +2378,7 @@ specified by `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)
+       (format "nndoc+ephemeral:%s.start-%s.range-%s" group start range)
        `(nndoc ,tmpfile
               (nndoc-article-type mbox))))
     (delete-file tmpfile)))
@@ -2434,7 +2431,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;mboxmaint=yes;mboxstat=yes")
+  '((emacs . "http://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s;mboxmaint=yes;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.
@@ -2474,7 +2471,8 @@ the bug number, and browsing the URL must return mbox output."
                         "/.*$" ""))))
       (write-region (point-min) (point-max) tmpfile)
       (gnus-group-read-ephemeral-group
-       "gnus-read-ephemeral-bug"
+       (format "nndoc+ephemeral:bug#%s"
+              (mapconcat 'number-to-string ids ","))
        `(nndoc ,tmpfile
               (nndoc-article-type mbox))
        nil window-conf))
@@ -2787,14 +2785,21 @@ server."
        (lambda (group)
          (gnus-group-delete-group group nil t))))))
 
-(defun gnus-group-delete-articles (group)
-  "Delete all articles in the current group."
-  (interactive (list (gnus-group-group-name)))
+(defun gnus-group-delete-articles (group &optional oldp)
+  "Delete all articles in the current group.
+If OLDP (the prefix), only delete articles that are \"old\",
+according to the expiry settings.  Note that this will delete old
+not-expirable articles, too."
+  (interactive (list (gnus-group-group-name)
+                    current-prefix-arg))
   (let ((articles (gnus-uncompress-range (gnus-active group))))
     (when (gnus-yes-or-no-p
           (format "Do you really want to delete these %d articles forever? "
                   (length articles)))
-      (gnus-request-expire-articles articles group 'force))))
+      (gnus-request-expire-articles articles group
+                                   (if current-prefix-arg
+                                       nil
+                                     'force)))))
 
 (defun gnus-group-delete-group (group &optional force no-prompt)
   "Delete the current group.  Only meaningful with editable groups.
@@ -3098,7 +3103,7 @@ If SOLID (the prefix), create a solid group."
       (gnus-group-read-ephemeral-group
        group method t
        (cons (current-buffer)
-            (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
+            (if (derived-mode-p 'gnus-summary-mode) 'summary 'group))))))</