X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus.el;h=4995820649af8903b55fb262db467c8051ccdefd;hb=0563df167689ba46e219f7915c6f5b321da614ce;hp=23c869bd08145f8277d813e1c334b06401aeeaa2;hpb=5ac3dbafea073b85d7df43a0f11d4f4ba76411c2;p=elisp%2Fgnus.git- diff --git a/lisp/gnus.el b/lisp/gnus.el index 23c869b..4995820 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -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. @@ -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)) @@ -1405,6 +1428,7 @@ slower, and `std11-extract-address-components'." ("nnweb" none) ("nnslashdot" post) ("nnultimate" none) + ("nnrss" 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 + 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 @@ -1517,6 +1584,34 @@ course.)" 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 @@ -1700,7 +1795,7 @@ covered by that variable." (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) @@ -1727,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.") @@ -1810,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.") @@ -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-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) @@ -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")))) +(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 @@ -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. -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." @@ -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") - (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))) @@ -2387,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))) @@ -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))) +(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)))) @@ -2942,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 @@ -2997,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 @@ -3016,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)