gnus-notifications: add actions support
[gnus] / lisp / gnus.el
index b5f7b72..84814b6 100644 (file)
@@ -1,6 +1,6 @@
 ;;; gnus.el --- a newsreader for GNU Emacs
 
-;; Copyright (C) 1987-1990, 1993-1998, 2000-2011
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2012
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -36,6 +36,7 @@
 (require 'wid-edit)
 (require 'mm-util)
 (require 'nnheader)
+(require 'gnus-compat)
 
 ;; These are defined afterwards with gnus-define-group-parameter
 (defvar gnus-ham-process-destinations)
@@ -293,10 +294,10 @@ is restarted, and sometimes reloaded."
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 
-(defconst gnus-version-number "0.18"
+(defconst gnus-version-number "0.6"
   "Version number for this version of Gnus.")
 
-(defconst gnus-version (format "No Gnus v%s" gnus-version-number)
+(defconst gnus-version (format "Ma Gnus v%s" gnus-version-number)
   "Version string for this version of Gnus.")
 
 (defcustom gnus-inhibit-startup-message nil
@@ -699,7 +700,7 @@ be set in `.emacs' instead."
 (defface gnus-summary-cancelled
   '((((class color))
      (:foreground "yellow" :background "black")))
-  "Face used for cancelled articles."
+  "Face used for canceled articles."
   :group 'gnus-summary)
 ;; backward-compatibility alias
 (put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled)
@@ -1008,10 +1009,11 @@ be set in `.emacs' instead."
     (purp "#9999cc" "#666699")
     (no "#ff0000" "#ffff00")
     (neutral "#b4b4b4" "#878787")
+    (ma "#2020e0" "#8080ff")
     (september "#bf9900" "#ffcc00"))
   "Color alist used for the Gnus logo.")
 
-(defcustom gnus-logo-color-style 'no
+(defcustom gnus-logo-color-style 'ma
   "*Color styles used for the Gnus logo."
   :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
                           gnus-logo-color-alist))
@@ -1270,15 +1272,18 @@ Set this variable in `.emacs' instead."
   :type '(choice (const :tag "current" nil)
                 directory))
 
-;; Site dependent variables.  These variables should be defined in
-;; paths.el.
+;; Site dependent variables.
 
-(defvar gnus-default-nntp-server nil
-  "Specify a default NNTP server.
-This variable should be defined in paths.el, and should never be set
-by the user.
-If you want to change servers, you should use `gnus-select-method'.
-See the documentation to that variable.")
+;; Should this be obsolete?
+(defcustom gnus-default-nntp-server nil
+  "The hostname of the default NNTP server.
+The empty string, or nil, means to use the local host.
+You may wish to set this on a site-wide basis.
+
+If you want to change servers, you should use `gnus-select-method'."
+  :group 'gnus-server
+  :type '(choice (const :tag "local host" nil)
+                 (string :tag "host name")))
 
 (defcustom gnus-nntpserver-file "/etc/nntpserver"
   "A file with only the name of the nntp server in it."
@@ -1325,6 +1330,8 @@ If you use this variable, you must set `gnus-nntp-server' to nil.
 
 There is a lot more to know about select methods and virtual servers -
 see the manual for details."
+  ;; Emacs has set-after since 22.1.
+  ;set-after '(gnus-default-nntp-server)
   :group 'gnus-server
   :group 'gnus-start
   :initialize 'custom-initialize-default
@@ -1394,13 +1401,6 @@ non-numeric prefix - `C-u M-x gnus', in short."
   :type '(repeat string))
 (make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1")
 
-(defcustom gnus-nntp-server nil
-  "The name of the host running the NNTP server."
-  :group 'gnus-server
-  :type '(choice (const :tag "disable" nil)
-                string))
-(make-obsolete-variable 'gnus-nntp-server 'gnus-select-method "24.1")
-
 (defcustom gnus-secondary-select-methods nil
   "A list of secondary methods that will be used for reading news.
 This is a list where each element is a complete select method (see
@@ -1594,7 +1594,8 @@ commands will still require prompting."
 If `quiet', update any active summary buffers automatically
 first before exiting."
   :group 'gnus-exit
-  :type 'boolean)
+  :type '(choice boolean
+                (const quiet)))
 
 (defcustom gnus-extract-address-components 'gnus-extract-address-components
   "*Function for extracting address components from a From header.
@@ -1631,7 +1632,7 @@ slower."
     ("nnagent" post-mail)
     ("nnimap" post-mail address prompt-address physical-address respool
      server-marks)
-    ("nnmaildir" mail respool address)
+    ("nnmaildir" mail respool address server-marks)
     ("nnnil" none))
   "*An alist of valid select methods.
 The first element of each list lists should be a string with the name
@@ -1646,12 +1647,13 @@ this variable.  I think."
                                             (const :format "%v " mail)
                                             (const :format "%v " none)
                                             (const post-mail))
-                       (checklist :inline t
+                       (checklist :inline t :greedy t
                                   (const :format "%v " address)
                                   (const :format "%v " prompt-address)
                                   (const :format "%v " physical-address)
-                                  (const :format "%v " virtual)
-                                  (const respool))))
+                                  (const virtual)
+                                  (const :format "%v " respool)
+                                  (const server-marks))))
   :version "24.1")
 
 (defun gnus-redefine-select-method-widget ()
@@ -2624,10 +2626,11 @@ a string, be sure to use a valid format, see RFC 2616."
     (scored . score) (saved . save)
     (cached . cache) (downloadable . download)
     (unsendable . unsend) (forwarded . forward)
-    (seen . seen)))
+    (seen . seen) (unexist . unexist)))
 
 (defconst gnus-article-special-mark-lists
   '((seen range)
+    (unexist range)
     (killed range)
     (bookmark tuple)
     (uid tuple)
@@ -2642,7 +2645,7 @@ a string, be sure to use a valid format, see RFC 2616."
 ;; `score' is not a proper mark
 ;; `bookmark': don't propagated it, or fix the bug in update-mark.
 (defconst gnus-article-unpropagated-mark-lists
-  '(seen cache download unsend score bookmark)
+  '(seen cache download unsend score bookmark unexist)
   "Marks that shouldn't be propagated to back ends.
 Typical marks are those that make no sense in a standalone back end,
 such as a mark that says whether an article is stored in the cache
@@ -2690,8 +2693,7 @@ such as a mark that says whether an article is stored in the cache
                        gnus-newsrc-last-checked-date
                        gnus-newsrc-alist gnus-server-alist
                        gnus-killed-list gnus-zombie-list
-                       gnus-topic-topology gnus-topic-alist
-                       gnus-format-specs)
+                       gnus-topic-topology gnus-topic-alist)
   "Gnus variables saved in the quick startup file.")
 
 (defvar gnus-newsrc-alist nil
@@ -2804,6 +2806,8 @@ gnus-registry.el will populate this if it's loaded.")
      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
       gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
+     ("gnus-registry" gnus-try-warping-via-registry
+      gnus-registry-handle-action)
      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
       gnus-cache-possibly-remove-articles gnus-cache-request-article
       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
@@ -3410,15 +3414,6 @@ that that variable is buffer-local to the summary buffers."
        (t                              ;Has positive number
         (eq (gnus-request-type group article) 'news)))) ;use it.
 
-;; Returns a list of writable groups.
-(defun gnus-writable-groups ()
-  (let ((alist gnus-newsrc-alist)
-       groups group)
-    (while (setq group (car (pop alist)))
-      (unless (gnus-group-read-only-p group)
-       (push group groups)))
-    (nreverse groups)))
-
 ;; Check whether to use long file names.
 (defun gnus-use-long-file-name (symbol)
   ;; The variable has to be set...
@@ -3588,7 +3583,7 @@ that that variable is buffer-local to the summary buffers."
                 (equal (nth 1 m1) (nth 1 m2)))))))
 
 (defsubst gnus-sloppily-equal-method-parameters (m1 m2)
-  ;; Check parameters for sloppy equalness.
+  ;; Check parameters for sloppy equality.
   (let ((p1 (copy-sequence (cddr m1)))
        (p2 (copy-sequence (cddr m2)))
        e1 e2)
@@ -3615,6 +3610,13 @@ that that variable is buffer-local to the summary buffers."
       ;; If p2 now is empty, they were equal.
       (null p2))))
 
+(defun gnus-method-ephemeral-p (method)
+  (let ((equal nil))
+    (dolist (ephemeral gnus-ephemeral-servers)
+      (when (gnus-sloppily-equal-method-parameters method ephemeral)
+       (setq equal t)))
+    equal))
+
 (defun gnus-methods-sloppily-equal (m1 m2)
   ;; Same method.
   (or
@@ -3687,21 +3689,10 @@ server is native)."
       group
     (concat (gnus-method-to-server-name method) ":" group)))
 
-(defun gnus-group-guess-prefixed-name (group)
-  "Guess the whole name from GROUP and METHOD."
-  (gnus-group-prefixed-name group (gnus-find-method-for-group
-                              group)))
-
 (defun gnus-group-full-name (group method)
   "Return the full name from GROUP and METHOD, even if the method is native."
   (gnus-group-prefixed-name group method t))
 
-(defun gnus-group-guess-full-name (group)
-  "Guess the full name from GROUP, even if the method is native."
-  (if (gnus-group-prefixed-p group)
-      group
-    (gnus-group-full-name group (gnus-find-method-for-group group))))
-
 (defun gnus-group-guess-full-name-from-command-method (group)
   "Guess the full name from GROUP, even if the method is native."
   (if (gnus-group-prefixed-p group)
@@ -3866,13 +3857,14 @@ The function `gnus-group-find-parameter' will do that for you."
          ;; The car is regexp matching for matching the group name.
          (when (string-match (car head) group)
            ;; The cdr is the parameters.
-           (setq result (gnus-group-parameter-value (cdr head)
-                                                    symbol allow-list))
-           (when result
-             ;; Expand if necessary.
-             (if (and (stringp result) (string-match "\\\\[0-9&]" result))
-                 (setq result (gnus-expand-group-parameter (car head)
-                                                           result group))))))
+           (let ((this-result
+                  (gnus-group-parameter-value (cdr head) symbol allow-list t)))
+             (when this-result
+               (setq result (car this-result))
+               ;; Expand if necessary.
+               (if (and (stringp result) (string-match "\\\\[0-9&]" result))
+                   (setq result (gnus-expand-group-parameter
+                                 (car head) result group)))))))
        ;; Done.
        result))))
 
@@ -3882,7 +3874,9 @@ If SYMBOL, return the value of that symbol in the group parameters.
 
 If you call this function inside a loop, consider using the faster
 `gnus-group-fast-parameter' instead."
-  (with-current-buffer gnus-group-buffer
+  (with-current-buffer (if (buffer-live-p (get-buffer gnus-group-buffer))
+                          gnus-group-buffer
+                        (current-buffer))
     (if symbol
        (gnus-group-fast-parameter group symbol allow-list)
       (nconc
@@ -4119,12 +4113,17 @@ parameters."
   (if (or (not (inline (gnus-similar-server-opened method)))
          (not (cddr method)))
       method
-    (setq method
-         `(,(car method) ,(concat (cadr method) "+" group)
-           (,(intern (format "%s-address" (car method))) ,(cadr method))
-           ,@(cddr method)))
-    (push method gnus-extended-servers)
-    method))
+    (let ((address-slot
+          (intern (format "%s-address" (car method)))))
+      (setq method
+           (if (assq address-slot (cddr method))
+               `(,(car method) ,(concat (cadr method) "+" group)
+                 ,@(cddr method))
+             `(,(car method) ,(concat (cadr method) "+" group)
+               (,address-slot ,(cadr method))
+               ,@(cddr method))))
+      (push method gnus-extended-servers)
+      method)))
 
 (defun gnus-server-status (method)
   "Return the status of METHOD."
@@ -4388,7 +4387,9 @@ prompt the user for the name of an NNTP server to use."
     (gnus-1 arg dont-connect slave)
     (gnus-final-warning)))
 
-(autoload 'debbugs-gnu "debbugs-gnu")
+(eval-and-compile
+  (unless (fboundp 'debbugs-gnu)
+    (autoload 'debbugs-gnu "debbugs-gnu" "List all outstanding Emacs bugs." t)))
 (defun gnus-list-debbugs ()
   "List all open Gnus bug reports."
   (interactive)