X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=4995820649af8903b55fb262db467c8051ccdefd;hb=0563df167689ba46e219f7915c6f5b321da614ce;hp=07818b6d0f6792d76d221bffc7eef977b2906dc8;hpb=32b017d0bf1e0b149a47f851a6305e46d0718e9f;p=elisp%2Fgnus.git- diff --git a/lisp/gnus.el b/lisp/gnus.el index 07818b6..4995820 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1,6 +1,6 @@ ;;; gnus.el --- a newsreader for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, -;; 1997, 1998, 2000 Free Software Foundation, Inc. +;; 1997, 1998, 2000, 2001 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -877,17 +877,31 @@ be set in `.emacs' instead." (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) -(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. @@ -916,7 +930,7 @@ REST is a plist of following: `(quote (repeat (list (regexp :tag "Group") ,parameter-type))))) (variable-default (plist-get rest :variable-default))) - (list + (list 'progn `(defcustom ,variable ,variable-default ,variable-document @@ -931,21 +945,30 @@ REST is a plist of following: ,parameter-type ,parameter-document)) (if (eq type 'bool) - `(defun ,function (group) + `(defun ,function (name) ,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)) + ((stringp ,variable) + (string-match ,variable name)) (,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 - (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)) @@ -1365,11 +1388,11 @@ commands will still require prompting." :type 'boolean) (defcustom gnus-extract-address-components 'gnus-extract-address-components - "*Function for extracting address components from a From header. -Two pre-defined function exist: `gnus-extract-address-components', -which is the default, quite fast, and too simplistic solution, and + "Function for extracting address components from a From header. +Three pre-defined functions exist: `gnus-extract-address-components', +which is the default, quite fast, and too simplistic solution, `mail-extract-address-components', which works much better, but is -slower." +slower, and `std11-extract-address-components'." :group 'gnus-summary-format :type '(radio (function-item gnus-extract-address-components) (function-item mail-extract-address-components) @@ -1405,6 +1428,7 @@ slower." ("nnweb" none) ("nnslashdot" post) ("nnultimate" none) + ("nnrss" none) ("nnwfm" none) ("nnwarchive" none) ("nnlistserv" none) @@ -1474,7 +1498,50 @@ to be desirable; see the manual for further details." :type '(choice (const nil) integer)) -(gnus-define-group-parameter +(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 @@ -1489,17 +1556,17 @@ which to perform auto-expiry. This only makes sense for mail groups." :variable-group nnmail-expire :variable-type '(choice (const nil) regexp) - :parameter-type '(const :tag "Automatic Expire" t) - :parameter-document + :parameter-type '(const :tag "Automatic Expire" t) + :parameter-document "All articles that are read will be marked as expirable.") -(gnus-define-group-parameter +(gnus-define-group-parameter total-expire :type bool :function gnus-group-total-expirable-p :function-document "Check whether GROUP is total-expirable or not." - :variable gnus-total-expirable-newsgroups + :variable gnus-total-expirable-newsgroups :variable-default nil :variable-document "*Groups in which to perform expiry of all read articles. @@ -1510,13 +1577,41 @@ course.)" :variable-group nnmail-expire :variable-type '(choice (const nil) regexp) - :parameter-type '(const :tag "Total Expire" t) - :parameter-document + :parameter-type '(const :tag "Total Expire" t) + :parameter-document "All read articles will be put through the expiry process 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\\>\\|\\" cn-big5) + ("\\(^\\|:\\)cn\\>\\|\\" 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 @@ -1636,15 +1731,6 @@ covered by that variable." :type 'symbol :group 'gnus-charset) -(defcustom gnus-default-posting-charset nil - "Default charset assumed to be used when posting non-ASCII characters. -This variable is overridden on a group-to-group basis by the -gnus-group-posting-charset-alist variable and is only used on groups not -covered by that variable. -If nil, no default charset is assumed when posting." - :type 'symbol - :group 'gnus-charset) - ;;; Internal variables @@ -1709,7 +1795,7 @@ If nil, no default charset is assumed when posting." (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) @@ -1736,10 +1822,10 @@ This variable can be nil, gnus or gnus-ja." (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.") @@ -1819,11 +1905,6 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") (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.") @@ -1944,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-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) @@ -2039,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")))) +(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 @@ -2098,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. -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." @@ -2295,7 +2382,9 @@ STRINGS will be evaluated in normal `or' order." (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))) @@ -2396,8 +2485,8 @@ g -- Group name." 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))) @@ -2711,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))) +(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) - (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)))) @@ -2951,6 +3056,15 @@ If NEWSGROUP is nil, return the global kill file name instead." (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 @@ -2994,7 +3108,7 @@ Disallow invalid group names." (let ((prefix "") group) (while (not group) - (when (string-match + (when (string-match gnus-invalid-group-regexp (setq group (read-string (concat prefix prompt) (cons (or default "") 0) @@ -3006,11 +3120,19 @@ Disallow invalid group names." (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 @@ -3025,13 +3147,7 @@ Allow completion over sensible values." (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)