Silence byte compiler.

[gnus] / lisp / gnus.el

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 33ae74e..e87ff37 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -1,7 +1,7 @@
 ;;; gnus.el --- a newsreader for GNU Emacs
 
 ;;; gnus.el --- a newsreader for GNU Emacs
 

-;; Copyright (C) 1987-1990, 1993-1998, 2000-2012
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2013 Free Software
+;; Foundation, Inc.

 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>


@@ -36,6 +36,7 @@
 (require 'wid-edit)
 (require 'mm-util)
 (require 'nnheader)
 (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)
 
 ;; These are defined afterwards with gnus-define-group-parameter
 (defvar gnus-ham-process-destinations)


@@ -293,7 +294,7 @@ is restarted, and sometimes reloaded."
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 
   :link '(custom-manual "(gnus)Exiting Gnus")
   :group 'gnus)
 

-(defconst gnus-version-number "0.2"
+(defconst gnus-version-number "0.6"

   "Version number for this version of Gnus.")
 
 (defconst gnus-version (format "Ma Gnus v%s" gnus-version-number)
   "Version number for this version of Gnus.")
 
 (defconst gnus-version (format "Ma Gnus v%s" gnus-version-number)


@@ -1271,15 +1272,18 @@ Set this variable in `.emacs' instead."
   :type '(choice (const :tag "current" nil)
                 directory))
 
   :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."
 
 (defcustom gnus-nntpserver-file "/etc/nntpserver"
   "A file with only the name of the nntp server in it."


@@ -1326,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."
 
 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
   :group 'gnus-server
   :group 'gnus-start
   :initialize 'custom-initialize-default


@@ -1626,7 +1632,7 @@ slower."
     ("nnagent" post-mail)
     ("nnimap" post-mail address prompt-address physical-address respool
      server-marks)
     ("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
     ("nnnil" none))
   "*An alist of valid select methods.
 The first element of each list lists should be a string with the name


@@ -1641,12 +1647,13 @@ this variable.  I think."
                                             (const :format "%v " mail)
                                             (const :format "%v " none)
                                             (const post-mail))
                                             (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 " 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 ()
   :version "24.1")
 
 (defun gnus-redefine-select-method-widget ()


@@ -2488,7 +2495,16 @@ Disabling the agent may result in noticeable loss of performance."
   :type 'boolean)
 
 (defcustom gnus-other-frame-function 'gnus
   :type 'boolean)
 
 (defcustom gnus-other-frame-function 'gnus

-  "Function called by the command `gnus-other-frame'."
+  "Function called by the command `gnus-other-frame' when starting Gnus."
+  :group 'gnus-start
+  :type '(choice (function-item gnus)
+                (function-item gnus-no-server)
+                (function-item gnus-slave)
+                (function-item gnus-slave-no-server)))
+
+(defcustom gnus-other-frame-resume-function 'gnus-group-get-new-news
+  "Function called by the command `gnus-other-frame' when resuming Gnus."
+  :version "24.4"

   :group 'gnus-start
   :type '(choice (function-item gnus)
                 (function-item gnus-no-server)
   :group 'gnus-start
   :type '(choice (function-item gnus)
                 (function-item gnus-no-server)


@@ -2619,10 +2635,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)
     (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)
 
 (defconst gnus-article-special-mark-lists
   '((seen range)

+    (unexist range)

     (killed range)
     (bookmark tuple)
     (uid tuple)
     (killed range)
     (bookmark tuple)
     (uid tuple)


@@ -2637,7 +2654,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
 ;; `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
   "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


@@ -2798,6 +2815,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-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
      ("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


@@ -3404,15 +3423,6 @@ that that variable is buffer-local to the summary buffers."
        (t                              ;Has positive number
         (eq (gnus-request-type group article) 'news)))) ;use it.
 
        (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...
 ;; Check whether to use long file names.
 (defun gnus-use-long-file-name (symbol)
   ;; The variable has to be set...


@@ -3581,13 +3591,6 @@ that that variable is buffer-local to the summary buffers."
                                            gnus-valid-select-methods)))
                 (equal (nth 1 m1) (nth 1 m2)))))))
 
                                            gnus-valid-select-methods)))
                 (equal (nth 1 m1) (nth 1 m2)))))))
 

-(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))
-

 (defsubst gnus-sloppily-equal-method-parameters (m1 m2)
   ;; Check parameters for sloppy equality.
   (let ((p1 (copy-sequence (cddr m1)))
 (defsubst gnus-sloppily-equal-method-parameters (m1 m2)
   ;; Check parameters for sloppy equality.
   (let ((p1 (copy-sequence (cddr m1)))


@@ -3616,6 +3619,13 @@ that that variable is buffer-local to the summary buffers."
       ;; If p2 now is empty, they were equal.
       (null p2))))
 
       ;; 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
 (defun gnus-methods-sloppily-equal (m1 m2)
   ;; Same method.
   (or


@@ -3688,21 +3698,10 @@ server is native)."
       group
     (concat (gnus-method-to-server-name method) ":" group)))
 
       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-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)
 (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)


@@ -3835,12 +3834,28 @@ You should probably use `gnus-find-method-for-group' instead."
   "Go through PARAMETERS and expand them according to the match data."
   (let (new)
     (dolist (elem parameters)
   "Go through PARAMETERS and expand them according to the match data."
   (let (new)
     (dolist (elem parameters)

-      (if (and (stringp (cdr elem))
-              (string-match "\\\\[0-9&]" (cdr elem)))
-         (push (cons (car elem)
-                     (gnus-expand-group-parameter match (cdr elem) group))
-               new)
-       (push elem new)))
+      (cond
+       ((and (stringp (cdr elem))
+             (string-match "\\\\[0-9&]" (cdr elem)))
+        (push (cons (car elem)
+                    (gnus-expand-group-parameter match (cdr elem) group))
+              new))
+       ;; For `sieve' group parameters, perform substitutions for every
+       ;; string within the match rule.  This allows for parameters such
+       ;; as:
+       ;;  ("list\\.\\(.*\\)"
+       ;;   (sieve header :is "list-id" "<\\1.domain.org>"))
+       ((eq 'sieve (car elem))
+        (push (mapcar (lambda (sieve-elem)
+                        (if (and (stringp sieve-elem)
+                                 (string-match "\\\\[0-9&]" sieve-elem))
+                            (gnus-expand-group-parameter match sieve-elem
+                                                         group)
+                          sieve-elem))
+                      (cdr elem))
+              new))
+       (t
+       (push elem new))))

     new))
 
 (defun gnus-group-fast-parameter (group symbol &optional allow-list)
     new))
 
 (defun gnus-group-fast-parameter (group symbol &optional allow-list)


@@ -3872,9 +3887,20 @@ The function `gnus-group-find-parameter' will do that for you."
              (when this-result
                (setq result (car this-result))
                ;; Expand if necessary.
              (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)))))))
+               (cond
+                 ((and (stringp result) (string-match "\\\\[0-9&]" result))
+                  (setq result (gnus-expand-group-parameter
+                                (car head) result group)))
+                 ;; For `sieve' group parameters, perform substitutions
+                 ;; for every string within the match rule (see above).
+                 ((eq symbol 'sieve)
+                  (setq result
+                        (mapcar (lambda (elem)
+                                  (if (stringp elem)
+                                      (gnus-expand-group-parameter (car head)
+                                                                   elem group)
+                                    elem))
+                                result))))))))

        ;; Done.
        result))))
 
        ;; Done.
        result))))
 


@@ -4123,12 +4149,17 @@ parameters."
   (if (or (not (inline (gnus-similar-server-opened method)))
          (not (cddr method)))
       method
   (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."
 
 (defun gnus-server-status (method)
   "Return the status of METHOD."


@@ -4327,13 +4358,22 @@ server."
   (interactive "P")
   (gnus arg nil 'slave))
 
   (interactive "P")
   (gnus arg nil 'slave))
 

+(defun gnus-delete-gnus-frame ()
+  "Delete gnus frame unless it is the only one.
+Used for `gnus-exit-gnus-hook' in `gnus-other-frame'."
+  (when (and (frame-live-p gnus-other-frame-object)
+             (cdr (frame-list)))
+    (delete-frame gnus-other-frame-object))
+  (setq gnus-other-frame-object nil))
+

 ;;;###autoload
 (defun gnus-other-frame (&optional arg display)
   "Pop up a frame to read news.
 This will call one of the Gnus commands which is specified by the user
 option `gnus-other-frame-function' (default `gnus') with the argument
 ;;;###autoload
 (defun gnus-other-frame (&optional arg display)
   "Pop up a frame to read news.
 This will call one of the Gnus commands which is specified by the user
 option `gnus-other-frame-function' (default `gnus') with the argument

-ARG if Gnus is not running, otherwise just pop up a Gnus frame.  The
-optional second argument DISPLAY should be a standard display string
+ARG if Gnus is not running, otherwise pop up a Gnus frame and run the
+command specified by `gnus-other-frame-resume-function'.
+The optional second argument DISPLAY should be a standard display string

 such as \"unix:0\" to specify where to pop up a frame.  If DISPLAY is
 omitted or the function `make-frame-on-display' is not available, the
 current display is used."
 such as \"unix:0\" to specify where to pop up a frame.  If DISPLAY is
 omitted or the function `make-frame-on-display' is not available, the
 current display is used."


@@ -4365,14 +4405,16 @@ current display is used."
                 (make-frame-on-display display gnus-other-frame-parameters)
               (make-frame gnus-other-frame-parameters))))
       (if alive
                 (make-frame-on-display display gnus-other-frame-parameters)
               (make-frame gnus-other-frame-parameters))))
       (if alive

-         (switch-to-buffer gnus-group-buffer)
+         (progn (switch-to-buffer gnus-group-buffer)
+                (funcall gnus-other-frame-resume-function arg))

        (funcall gnus-other-frame-function arg)
        (funcall gnus-other-frame-function arg)

-       (add-hook 'gnus-exit-gnus-hook
-                 (lambda nil
-                    (when (and (frame-live-p gnus-other-frame-object)
-                               (cdr (frame-list)))
-                      (delete-frame gnus-other-frame-object))
-                    (setq gnus-other-frame-object nil)))))))
+       (add-hook 'gnus-exit-gnus-hook 'gnus-delete-gnus-frame)
+  ;; One might argue that `gnus-delete-gnus-frame' should not be called
+  ;; from `gnus-suspend-gnus-hook', but, on the other hand, one might
+  ;; argue that it should.  No matter what you think, for the sake of
+  ;; those who want it to be called from it, please keep (defun
+  ;; gnus-delete-gnus-frame) even if you remove the next `add-hook'.
+  (add-hook 'gnus-suspend-gnus-hook 'gnus-delete-gnus-frame)))))

 
 ;;;###autoload
 (defun gnus (&optional arg dont-connect slave)
 
 ;;;###autoload
 (defun gnus (&optional arg dont-connect slave)


@@ -4392,7 +4434,9 @@ prompt the user for the name of an NNTP server to use."
     (gnus-1 arg dont-connect slave)
     (gnus-final-warning)))
 
     (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)
 (defun gnus-list-debbugs ()
   "List all open Gnus bug reports."
   (interactive)