* nnshimbun.el (nnshimbun-request-expire-articles): Prefer the group parameter

[elisp/gnus.git-] / lisp / gnus.el

diff --git a/lisp/gnus.el b/lisp/gnus.el
index 23c869b..4995820 100644 (file)
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -877,17 +877,31 @@ be set in `.emacs' instead."
 (require 'gnus-util)
 (require 'nnheader)
 
 (require 'gnus-util)
 (require 'nnheader)
 

+(defvar gnus-parameters nil
+  "Alist of group parameters.
+
+For example:
+   ((\"mail\\\\..*\"  (gnus-show-threads nil)
+                  (gnus-use-scoring nil)
+                  (gnus-summary-line-format
+                        \"%U%R%z%I%(%[%d:%ub%-20,20f%]%) %s\\n\")
+                  (gcc-self . t)
+                  (display . all))
+     (\"mail\\\\.me\" (gnus-use-scoring  t))
+     (\"list\\\\..*\" (total-expire . t)
+                  (broken-reply-to . t)))")
+

 (defvar gnus-group-parameters-more nil)
 
 (defvar gnus-group-parameters-more nil)
 

-(condition-case nil
-    :symbol-for-testing-whether-colon-keyword-is-available-or-not
-  (void-variable
-   ;; Bind keywords.
-   (dolist (keyword '(:parameter-type
-                     :parameter-document :function :function-document
-                     :variable :variable-document :variable-group
-                     :variable-type :variable-default))
-     (set keyword keyword))))
+(defvar gnus-colon-keywords
+  (eval-when-compile
+    (when (boundp 'dgnushack-colon-keywords)
+      (symbol-value 'dgnushack-colon-keywords)))
+  "List of the colon keywords should be bound at run-time.  This variable
+defaults to a proper value only if this file is byte-compiled by make.")
+
+(dolist (keyword gnus-colon-keywords)
+  (set keyword keyword))

 
 (defmacro gnus-define-group-parameter (param &rest rest)
   "Define a group parameter PARAM.
 
 (defmacro gnus-define-group-parameter (param &rest rest)
   "Define a group parameter PARAM.

@@ -931,21 +945,30 @@ REST is a plist of following:
                         ,parameter-type
                         ,parameter-document))
      (if (eq type 'bool)
                         ,parameter-type
                         ,parameter-document))
      (if (eq type 'bool)

-        `(defun ,function (group)
+        `(defun ,function (name)

            ,function-document
            ,function-document

-           (let ((params (gnus-group-find-parameter group))
+           (let ((params (gnus-group-find-parameter name))

                  val)
              (cond
               ((memq ',param params)
                t)
               ((setq val (assq ',param params))
                (cdr val))
                  val)
              (cond
               ((memq ',param params)
                t)
               ((setq val (assq ',param params))
                (cdr val))

+              ((stringp ,variable)
+               (string-match ,variable name))

               (,variable
               (,variable

-               (string-match ,variable group)))))
+               (let ((alist ,variable)
+                     elem value)
+                 (while (setq elem (pop alist))
+                   (when (and name
+                              (string-match (car elem) name))
+                     (setq alist nil
+                           value (cdr elem))))
+                 (if (consp value) (car value) value))))))

        `(defun ,function (name)
          ,function-document
          (and name
        `(defun ,function (name)
          ,function-document
          (and name

-              (or (gnus-group-find-parameter name ',param)
+              (or (gnus-group-find-parameter name ',param ,(and type t))

                   (let ((alist ,variable)
                         elem value)
                     (while (setq elem (pop alist))
                   (let ((alist ,variable)
                         elem value)
                     (while (setq elem (pop alist))

@@ -1405,6 +1428,7 @@ slower, and `std11-extract-address-components'."
     ("nnweb" none)
     ("nnslashdot" post)
     ("nnultimate" none)
     ("nnweb" none)
     ("nnslashdot" post)
     ("nnultimate" none)

+    ("nnrss" none)

     ("nnwfm" none)
     ("nnwarchive" none)
     ("nnlistserv" none)
     ("nnwfm" none)
     ("nnwarchive" none)
     ("nnlistserv" none)

@@ -1475,6 +1499,49 @@ to be desirable; see the manual for further details."
                 integer))
 
 (gnus-define-group-parameter
                 integer))
 
 (gnus-define-group-parameter

+ to-address
+ :function-document
+ "Return GROUP's to-address."
+ :variable-document
+  "*Alist of group regexps and correspondent to-addresses."
+  :parameter-type '(gnus-email-address :tag "To Address")
+  :parameter-document "\
+This will be used when doing followups and posts.
+
+This is primarily useful in mail groups that represent closed
+mailing lists--mailing lists where it's expected that everybody that
+writes to the mailing list is subscribed to it.  Since using this
+parameter ensures that the mail only goes to the mailing list itself,
+it means that members won't receive two copies of your followups.
+
+Using `to-address' will actually work whether the group is foreign or
+not.  Let's say there's a group on the server that is called
+`fa.4ad-l'.  This is a real newsgroup, but the server has gotten the
+articles from a mail-to-news gateway.  Posting directly to this group
+is therefore impossible--you have to send mail to the mailing list
+address instead.
+
+The gnus-group-split mail splitting mechanism will behave as if this
+address was listed in gnus-group-split Addresses (see below).")
+
+(gnus-define-group-parameter
+ to-list
+ :function-document
+ "Return GROUP's to-list."
+ :variable-document
+ "*Alist of group regexps and correspondent to-lists."
+ :parameter-type '(gnus-email-address :tag "To List")
+ :parameter-document "\
+This address will be used when doing a `a' in the group.
+
+It is totally ignored when doing a followup--except that if it is
+present in a news group, you'll get mail group semantics when doing
+`f'.
+
+The gnus-group-split mail splitting mechanism will behave as if this
+address was listed in gnus-group-split Addresses (see below).")
+
+(gnus-define-group-parameter

  auto-expire
  :type bool
  :function gnus-group-auto-expirable-p
  auto-expire
  :type bool
  :function gnus-group-auto-expirable-p

@@ -1517,6 +1584,34 @@ course.)"
 This happens even if they are not marked as expirable.
 Use with caution.")
 
 This happens even if they are not marked as expirable.
 Use with caution.")
 

+(gnus-define-group-parameter
+ charset
+ :function-document
+ "Return the default charset of GROUP."
+ :variable gnus-group-charset-alist
+ :variable-default 
+ '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5)
+   ("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312)
+   ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2)
+   ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit)
+   ("\\(^\\|:\\)relcom\\>" koi8-r)
+   ("\\(^\\|:\\)fido7\\>" koi8-r)
+   ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
+   ("\\(^\\|:\\)israel\\>" iso-8859-1)
+   ("\\(^\\|:\\)han\\>" euc-kr)
+   ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5)
+   ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr)
+   ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
+   (".*" iso-8859-1))
+ :variable-document
+  "Alist of regexps (to match group names) and default charsets to be used when reading."
+  :variable-group gnus-charset
+  :variable-type '(repeat (list (regexp :tag "Group")
+                               (symbol :tag "Charset")))
+  :parameter-type '(symbol :tag "Charset")
+  :parameter-document "\
+The default charset to use in the group.")
+

 (defcustom gnus-group-uncollapsed-levels 1
   "Number of group name elements to leave alone when making a short group name."
   :group 'gnus-group-visual
 (defcustom gnus-group-uncollapsed-levels 1
   "Number of group name elements to leave alone when making a short group name."
   :group 'gnus-group-visual

@@ -1700,7 +1795,7 @@ covered by that variable."
     (bookmarks . bookmark) (dormant . dormant)
     (scored . score) (saved . save)
     (cached . cache) (downloadable . download)
     (bookmarks . bookmark) (dormant . dormant)
     (scored . score) (saved . save)
     (cached . cache) (downloadable . download)

-    (unsendable . unsend)))
+    (unsendable . unsend) (forwarded . forward)))

 
 (defvar gnus-headers-retrieved-by nil)
 (defvar gnus-article-reply nil)
 
 (defvar gnus-headers-retrieved-by nil)
 (defvar gnus-article-reply nil)

@@ -1727,10 +1822,10 @@ This variable can be nil, gnus or gnus-ja."
                 (const :tag "Japanese" gnus-ja)))
 
 (defvar gnus-info-nodes
                 (const :tag "Japanese" gnus-ja)))
 
 (defvar gnus-info-nodes

-  '((gnus-group-mode "The Group Buffer")
-    (gnus-summary-mode "The Summary Buffer")
-    (gnus-article-mode "The Article Buffer")
-    (gnus-server-mode "The Server Buffer")
+  '((gnus-group-mode "Group Buffer")
+    (gnus-summary-mode "Summary Buffer")
+    (gnus-article-mode "Article Buffer")
+    (gnus-server-mode "Server Buffer")

     (gnus-browse-mode "Browse Foreign Server")
     (gnus-tree-mode "Tree Display"))
   "Alist of major modes and related Info nodes.")
     (gnus-browse-mode "Browse Foreign Server")
     (gnus-tree-mode "Tree Display"))
   "Alist of major modes and related Info nodes.")

@@ -1810,11 +1905,6 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
 
 (defvar gnus-dead-summary nil)
 
 
 (defvar gnus-dead-summary nil)
 

-(defvar gnus-article-display-hook nil
-  "Controls how the article buffer will look.  This is an obsolete variable;
-use the article treating faculties instead.  Is is described in Info node
-`Customizing Articles'.")
-

 (defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
   "Regexp matching invalid groups.")
 
 (defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
   "Regexp matching invalid groups.")
 

@@ -1935,9 +2025,8 @@ use the article treating faculties instead.  Is is described in Info node
       gnus-summary-resend-message gnus-summary-resend-bounced-mail
       gnus-summary-wide-reply gnus-summary-followup-to-mail
       gnus-summary-followup-to-mail-with-original gnus-bug
       gnus-summary-resend-message gnus-summary-resend-bounced-mail
       gnus-summary-wide-reply gnus-summary-followup-to-mail
       gnus-summary-followup-to-mail-with-original gnus-bug

-      gnus-summary-wide-reply-with-original
-      gnus-summary-post-forward gnus-summary-wide-reply-with-original
-      gnus-summary-post-forward)
+      gnus-summary-wide-reply-with-original gnus-summary-post-forward
+      gnus-summary-digest-mail-forward gnus-summary-digest-post-forward)

      ("gnus-picon" :interactive t gnus-article-display-picons
       gnus-group-display-picons)
      ("gnus-picon" gnus-picons-buffer-name)
      ("gnus-picon" :interactive t gnus-article-display-picons
       gnus-group-display-picons)
      ("gnus-picon" gnus-picons-buffer-name)

@@ -2030,6 +2119,13 @@ use the article treating faculties instead.  Is is described in Info node
       (autoload 'smiley-toggle-buffer "gnus-bitmap")
       (autoload 'x-face-mule-gnus-article-display-x-face "x-face-mule"))))
 
       (autoload 'smiley-toggle-buffer "gnus-bitmap")
       (autoload 'x-face-mule-gnus-article-display-x-face "x-face-mule"))))
 

+(unless (and (fboundp 'base64-encode-string)
+            (subrp (symbol-function 'base64-encode-string)))
+  (require 'base64))
+
+;; A tool for the developers.
+(autoload 'find-cl-run-time-functions "gnus-clfns" nil t)
+

 ;;; gnus-sum.el thingies
 
 
 ;;; gnus-sum.el thingies
 
 

@@ -2089,7 +2185,7 @@ it is invalid to have these specs after a variable-length spec.    Well,
 you might not be arrested, but your summary buffer will look strange,
 which is bad enough.
 
 you might not be arrested, but your summary buffer will look strange,
 which is bad enough.
 

-The smart choice is to have these specs as for to the left as
+The smart choice is to have these specs as far to the left as

 possible.
 
 This restriction may disappear in later versions of Gnus."
 possible.
 
 This restriction may disappear in later versions of Gnus."

@@ -2286,7 +2382,9 @@ STRINGS will be evaluated in normal `or' order."
             (or gnus-info-filename
                 (get-language-info current-language-environment 'gnus-info)
                 "gnus")
             (or gnus-info-filename
                 (get-language-info current-language-environment 'gnus-info)
                 "gnus")

-            (cadr (assq major-mode gnus-info-nodes))))
+            (or (cadr (assq major-mode gnus-info-nodes))
+                (and (eq (current-buffer) (get-buffer gnus-article-buffer))
+                     (cadr (assq 'gnus-article-mode gnus-info-nodes))))))

     (setq gnus-info-buffer (current-buffer))
     (gnus-configure-windows 'info)))
 
     (setq gnus-info-buffer (current-buffer))
     (gnus-configure-windows 'info)))
 

@@ -2387,8 +2485,8 @@ g -- Group name."
        out)
       (cond
        ((= c ?r)
        out)
       (cond
        ((= c ?r)

-       (push (if (< (point) (mark) (point) (mark))) out)
-       (push (if (> (point) (mark) (point) (mark))) out))))
+       (push (if (< (point) (mark)) (point) (mark)) out)
+       (push (if (> (point) (mark)) (point) (mark)) out))))

     (setq out (delq 'gnus-prefix-nil out))
     (nreverse out)))
 
     (setq out (delq 'gnus-prefix-nil out))
     (nreverse out)))
 

@@ -2702,12 +2800,28 @@ You should probably use `gnus-find-method-for-group' instead."
   "Say whether the group is secondary or not."
   (gnus-secondary-method-p (gnus-find-method-for-group group)))
 
   "Say whether the group is secondary or not."
   (gnus-secondary-method-p (gnus-find-method-for-group group)))
 

+(defun gnus-parameters-get-parameter (group)
+  "Return the group parameters for GROUP from `gnus-parameters'."
+  (let ((alist gnus-parameters)
+       params-list)
+    (while alist
+      (when (string-match (caar alist) group)
+       (setq params-list 
+             (nconc (copy-sequence (cdar alist))
+                    params-list)))
+      (pop alist))
+    params-list))
+

 (defun gnus-group-find-parameter (group &optional symbol allow-list)
   "Return the group parameters for GROUP.
 If SYMBOL, return the value of that symbol in the group parameters."
   (save-excursion
     (set-buffer gnus-group-buffer)
 (defun gnus-group-find-parameter (group &optional symbol allow-list)
   "Return the group parameters for GROUP.
 If SYMBOL, return the value of that symbol in the group parameters."
   (save-excursion
     (set-buffer gnus-group-buffer)

-    (let ((parameters (funcall gnus-group-get-parameter-function group)))
+    (let ((parameters 
+          (nconc
+           (copy-sequence
+            (funcall gnus-group-get-parameter-function group))
+           (gnus-parameters-get-parameter group))))

       (if symbol
          (gnus-group-parameter-value parameters symbol allow-list)
        parameters))))
       (if symbol
          (gnus-group-parameter-value parameters symbol allow-list)
        parameters))))

@@ -2942,6 +3056,15 @@ If NEWSGROUP is nil, return the global kill file name instead."
          (list (intern server) "")))
     gnus-select-method))
 
          (list (intern server) "")))
     gnus-select-method))
 

+(defun gnus-server-string (server)
+  "Return a readable string that describes SERVER."
+  (let* ((server (gnus-server-to-method server))
+        (address (nth 1 server)))
+    (if (and address
+            (not (zerop (length address))))
+       (format "%s via %s" address (car server))
+      (format "%s" (car server)))))
+

 (defun gnus-find-method-for-group (group &optional info)
   "Find the select method that GROUP uses."
   (or gnus-override-method
 (defun gnus-find-method-for-group (group &optional info)
   "Find the select method that GROUP uses."
   (or gnus-override-method

@@ -2997,11 +3120,19 @@ Disallow invalid group names."
 (defun gnus-read-method (prompt)
   "Prompt the user for a method.
 Allow completion over sensible values."
 (defun gnus-read-method (prompt)
   "Prompt the user for a method.
 Allow completion over sensible values."

-  (let* ((servers
-         (append gnus-valid-select-methods
-                 (mapcar (lambda (i) (list (format "%s:%s" (caar i)
-                                                   (cadar i))))
-                         gnus-opened-servers)
+  (let* ((open-servers 
+         (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i))
+                 gnus-opened-servers))
+        (valid-methods
+         (let (methods)
+           (dolist (method gnus-valid-select-methods)
+             (if (or (memq 'prompt-address method)
+                     (not (assoc (format "%s:" (car method)) open-servers)))
+                 (push method methods)))
+           methods))
+        (servers
+         (append valid-methods
+                 open-servers

                  gnus-predefined-server-alist
                  gnus-server-alist))
         (method
                  gnus-predefined-server-alist
                  gnus-server-alist))
         (method

@@ -3016,13 +3147,7 @@ Allow completion over sensible values."
                               (assoc method gnus-valid-select-methods))
                         (read-string "Address: ")
                       "")))
                               (assoc method gnus-valid-select-methods))
                         (read-string "Address: ")
                       "")))

-       (or (let ((opened gnus-opened-servers))
-             (while (and opened
-                         (not (equal (format "%s:%s" method address)
-                                     (format "%s:%s" (caaar opened)
-                                             (cadaar opened)))))
-               (pop opened))
-             (caar opened))
+       (or (cadr (assoc (format "%s:%s" method address) open-servers))

            (list (intern method) address))))
      ((assoc method servers)
       method)
            (list (intern method) address))))
      ((assoc method servers)
       method)