X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=7bce9b812505e7e6e444fc729a0e804f06f2ec00;hb=41fb7027bd9100cf7a76b88761ed42317e11cfa8;hp=06e76afcdda2cf5bdadf181332e067aede109614;hpb=870822142dbdbf720ada0e93c8f0649bbac1bd16;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 06e76af..7bce9b8 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,5 +1,5 @@ ;;; gnus-msg.el --- mail and post interface for Semi-gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -111,6 +111,16 @@ the second with the current group name.") (name . user-full-name)) "*Mapping from style parameters to variables.") +(defcustom gnus-group-posting-charset-alist + '(("^no\\." iso-8859-1) + (".*" iso-8859-1) + (message-this-is-mail nil) + ) + "Alist of regexps (to match group names) and default charsets to be unencoded when posting." + :type '(repeat (list (regexp :tag "Group") + (symbol :tag "Charset"))) + :group 'gnus-charset) + ;;; Internal variables. (defvar gnus-inhibit-posting-styles nil @@ -217,12 +227,27 @@ Thank you for your help in stamping out bugs. (setq gnus-message-buffer (current-buffer)) (set (make-local-variable 'gnus-message-group-art) (cons ,group ,article)) - (make-local-variable 'gnus-newsgroup-name) + (set (make-local-variable 'gnus-newsgroup-name) ,group) + (set (make-local-variable 'message-posting-charset) + (gnus-setup-posting-charset ,group)) (gnus-run-hooks 'gnus-message-setup-hook)) (gnus-add-buffer) (gnus-configure-windows ,config t) (set-buffer-modified-p nil)))) +(defun gnus-setup-posting-charset (group) + (let ((alist gnus-group-posting-charset-alist) + elem) + (catch 'found + (while (setq elem (pop alist)) + (when (or (and (stringp (car alist)) + (string-match (car alist) group)) + (and (gnus-functionp (car alist)) + (funcall (car alist) group)) + (and (symbolp (car alist)) + (symbol-value (car alist)))) + (throw 'found (cadr alist))))))) + (defun gnus-inews-add-send-actions (winconf buffer article) (make-local-hook 'message-sent-hook) (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) @@ -230,8 +255,9 @@ Thank you for your help in stamping out bugs. `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) (setq message-user-agent (gnus-extended-version)) - (message-add-action - `(set-window-configuration ,winconf) 'exit 'postpone 'kill) + (when (not message-use-multi-frames) + (message-add-action + `(set-window-configuration ,winconf) 'exit 'postpone 'kill)) (message-add-action `(when (gnus-buffer-exists-p ,buffer) (save-excursion @@ -250,15 +276,24 @@ Thank you for your help in stamping out bugs. If ARG, use the group under the point to find a posting style. If ARG is 1, prompt for a group name to find the posting style." (interactive "P") - (let ((gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (completing-read "Use posting style of group: " - gnus-active-hashtb nil - (gnus-read-active-file-p)) - (gnus-group-group-name)) - ""))) - (gnus-setup-message 'message (message-mail)))) + ;; We can't `let' gnus-newsgroup-name here, since that leads + ;; to local variables leaking. + (let ((group gnus-newsgroup-name) + (buffer (current-buffer))) + (unwind-protect + (progn + (setq gnus-newsgroup-name + (if arg + (if (= 1 (prefix-numeric-value arg)) + (completing-read "Use posting style of group: " + gnus-active-hashtb nil + (gnus-read-active-file-p)) + (gnus-group-group-name)) + "")) + (gnus-setup-message 'message (message-mail))) + (save-excursion + (set-buffer buffer) + (setq gnus-newsgroup-name group))))) (defun gnus-group-post-news (&optional arg) "Start composing a news message. @@ -359,7 +394,8 @@ post using the current select method." This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." (interactive) - (let ((article (gnus-summary-article-number))) + (let ((article (gnus-summary-article-number)) + (gnus-message-setup-hook '(gnus-maybe-setup-default-charset))) (gnus-setup-message 'reply-yank (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) @@ -411,7 +447,7 @@ header line with the old Message-ID." ;; Delete the headers from the displayed articles. (set-buffer gnus-article-copy) (delete-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point))) + (or (search-forward "\n\n" nil t) (point-max))) ;; Insert the original article headers. (insert-buffer-substring gnus-original-article-buffer beg end) (article-decode-encoded-words))) @@ -555,7 +591,7 @@ If SILENT, don't prompt the user." (defun gnus-extended-version () "Stringified gnus version." (concat gnus-product-name "/" gnus-version-number " (based on " - gnus-original-product-name " " gnus-original-version-number ")")) + gnus-original-product-name " v" gnus-original-version-number ")")) (defun gnus-message-make-user-agent (&optional include-mime-info max-column) "Return user-agent info. @@ -958,14 +994,15 @@ this is a reply." (interactive "P") (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) - (gnus-setup-message 'compose-bounce - (let* ((references (mail-fetch-field "references")) - (parent (and references (gnus-parent-id references)))) - (message-bounce) - ;; If there are references, we fetch the article we answered to. - (and fetch parent - (gnus-summary-refer-article parent) - (gnus-summary-show-all-headers))))) + (let ((gnus-message-setup-hook '(gnus-maybe-setup-default-charset))) + (gnus-setup-message 'compose-bounce + (let* ((references (mail-fetch-field "references")) + (parent (and references (gnus-parent-id references)))) + (message-bounce) + ;; If there are references, we fetch the article we answered to. + (and fetch parent + (gnus-summary-refer-article parent) + (gnus-summary-show-all-headers)))))) ;;; Gcc handling. @@ -1120,24 +1157,34 @@ this is a reply." (gnus-newsgroup-name (or gnus-newsgroup-name "")) style match variable attribute value value-value) (make-local-variable 'gnus-message-style-insertions) + ;; If the group has a posting-style parameter, add it at the end with a + ;; regexp matching everything, to be sure it takes precedence over all + ;; the others. + (unless (zerop (length gnus-newsgroup-name)) + (let ((tmp-style (gnus-group-find-parameter + gnus-newsgroup-name 'posting-style t))) + (when tmp-style + (setq styles (append styles (list (cons ".*" tmp-style))))))) ;; Go through all styles and look for matches. (while styles (setq style (pop styles) match (pop style)) - (when (cond ((stringp match) - ;; Regexp string match on the group name. - (string-match match gnus-newsgroup-name)) - ((or (symbolp match) - (gnus-functionp match)) - (cond ((gnus-functionp match) - ;; Function to be called. - (funcall match)) - ((boundp match) - ;; Variable to be checked. - (symbol-value match)))) - ((listp match) - ;; This is a form to be evaled. - (eval match))) + (when (cond + ((stringp match) + ;; Regexp string match on the group name. + (string-match match gnus-newsgroup-name)) + ((or (symbolp match) + (gnus-functionp match)) + (cond + ((gnus-functionp match) + ;; Function to be called. + (funcall match)) + ((boundp match) + ;; Variable to be checked. + (symbol-value match)))) + ((listp match) + ;; This is a form to be evaled. + (eval match))) ;; We have a match, so we set the variables. (while style (setq attribute (pop style) @@ -1152,36 +1199,36 @@ this is a reply." (message "Couldn't find attribute %s" (car attribute)) ;; We get the value. (setq value-value - (cond ((stringp value) - value) - ((or (symbolp value) - (gnus-functionp value)) - (cond ((gnus-functionp value) - (funcall value)) - ((boundp value) - (symbol-value value)))) - ((listp value) - (eval value)))) + (cond + ((stringp value) + value) + ((or (symbolp value) + (gnus-functionp value)) + (cond ((gnus-functionp value) + (funcall value)) + ((boundp value) + (symbol-value value)))) + ((listp value) + (eval value)))) (if variable ;; This is an ordinary variable. (set (make-local-variable variable) value-value) ;; This is either a body or a header to be inserted in the ;; message. - (when value-value - (let ((attr (car attribute))) - (make-local-variable 'message-setup-hook) - (if (eq 'body attr) - (add-hook 'message-setup-hook - `(lambda () - (save-excursion - (message-goto-body) - (insert ,value-value)))) + (let ((attr (car attribute))) + (make-local-variable 'message-setup-hook) + (if (eq 'body attr) (add-hook 'message-setup-hook - 'gnus-message-insert-stylings) - (push (cons (if (stringp attr) attr - (symbol-name attr)) - value-value) - gnus-message-style-insertions)))))))))))) + `(lambda () + (save-excursion + (message-goto-body) + (insert ,value-value)))) + (add-hook 'message-setup-hook + 'gnus-message-insert-stylings) + (push (cons (if (stringp attr) attr + (symbol-name attr)) + value-value) + gnus-message-style-insertions))))))))))) (defun gnus-message-insert-stylings () (let (val) @@ -1190,7 +1237,7 @@ this is a reply." (while (setq val (pop gnus-message-style-insertions)) (when (cdr val) (insert (car val) ": " (cdr val) "\n")) - (gnus-pull (car val) gnus-message-style-insertions))))) + (gnus-pull (car val) gnus-message-style-insertions t))))) ;;; @ for MIME Edit mode