X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=0c830cb7d74b131ab7562af6d758e936b0ef9b4a;hb=3fc9d5f194e101969129b567bb75d7cd700d06d3;hp=02726955cef580a5839816f5d1d2994135eadba4;hpb=09569b5018c49d69aa821a035aff2d3a2259f764;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 0272695..0c830cb 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,9 +1,10 @@ -;;; gnus-msg.el --- mail and post interface for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. +;;; gnus-msg.el --- mail and post interface for Semi-gnus +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news +;; Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -33,18 +34,25 @@ (require 'message) (require 'gnus-art) -;; Added by Sudish Joseph . -(defvar gnus-post-method nil +(defcustom gnus-post-method nil "*Preferred method for posting USENET news. -If this variable is nil, Gnus will use the current method to decide -which method to use when posting. If it is non-nil, it will override -the current method. This method will not be used in mail groups and -the like, only in \"real\" newsgroups. -The value must be a valid method as discussed in the documentation of -`gnus-select-method'. It can also be a list of methods. If that is -the case, the user will be queried for what select method to use when -posting.") +If this variable is `current', Gnus will use the \"current\" select +method when posting. If it is nil (which is the default), Gnus will +use the native posting method of the server. + +This method will not be used in mail groups and the like, only in +\"real\" newsgroups. + +If not nil nor `native', the value must be a valid method as discussed +in the documentation of `gnus-select-method'. It can also be a list of +methods. If that is the case, the user will be queried for what select +method to use when posting." + :group 'gnus-group-foreign + :type `(choice (const nil) + (const current) + (const native) + (sexp :tag "Methods" ,gnus-select-method))) (defvar gnus-outgoing-message-group nil "*All outgoing messages will be put in this group. @@ -66,13 +74,6 @@ the group.") (defvar gnus-add-to-list nil "*If non-nil, add a `to-list' parameter automatically.") -(defvar gnus-sent-message-ids-file - (nnheader-concat gnus-directory "Sent-Message-IDs") - "File where Gnus saves a cache of sent message ids.") - -(defvar gnus-sent-message-ids-length 1000 - "The number of sent Message-IDs to save.") - (defvar gnus-crosspost-complaint "Hi, @@ -94,6 +95,9 @@ the second with the current group name.") (defvar gnus-message-setup-hook nil "Hook run after setting up a message buffer.") +(defvar gnus-bug-create-help-buffer t + "*Should we create the *Gnus Help Bug* buffer?") + ;;; Internal variables. (defvar gnus-message-buffer "*Mail Gnus*") @@ -164,10 +168,12 @@ Thank you for your help in stamping out bugs. (defmacro gnus-setup-message (config &rest forms) (let ((winconf (make-symbol "gnus-setup-message-winconf")) (buffer (make-symbol "gnus-setup-message-buffer")) - (article (make-symbol "gnus-setup-message-article"))) + (article (make-symbol "gnus-setup-message-article")) + (group (make-symbol "gnus-setup-message-group"))) `(let ((,winconf (current-window-configuration)) (,buffer (buffer-name (current-buffer))) (,article (and gnus-article-reply (gnus-summary-article-number))) + (,group gnus-newsgroup-name) (message-header-setup-hook (copy-sequence message-header-setup-hook))) (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) @@ -178,9 +184,9 @@ Thank you for your help in stamping out bugs. (gnus-inews-add-send-actions ,winconf ,buffer ,article) (setq gnus-message-buffer (current-buffer)) (set (make-local-variable 'gnus-message-group-art) - (cons ,gnus-newsgroup-name ,article)) + (cons ,group ,article)) (make-local-variable 'gnus-newsgroup-name) - (run-hooks 'gnus-message-setup-hook)) + (gnus-run-hooks 'gnus-message-setup-hook)) (gnus-configure-windows ,config t) (set-buffer-modified-p nil)))) @@ -194,9 +200,9 @@ Thank you for your help in stamping out bugs. (message-add-action `(set-window-configuration ,winconf) 'exit 'postpone 'kill) (message-add-action - `(when (buffer-name (get-buffer ,buffer)) + `(when (gnus-buffer-exists-p ,buffer) (save-excursion - (set-buffer (get-buffer ,buffer)) + (set-buffer ,buffer) ,(when article `(gnus-summary-mark-article-as-replied ,article)))) 'send)) @@ -217,8 +223,7 @@ Thank you for your help in stamping out bugs. If ARG, post to the group under point. If ARG is 1, prompt for a group name." (interactive "P") - ;; Bind this variable here to make message mode hooks - ;; work ok. + ;; Bind this variable here to make message mode hooks work ok. (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) @@ -298,8 +303,10 @@ post using the current select method." article) (while (setq article (pop articles)) (when (gnus-summary-select-article t nil nil article) - (when (gnus-eval-in-buffer-window gnus-original-article-buffer - (message-cancel-news)) + (when (gnus-eval-in-buffer-window gnus-article-buffer + (save-excursion + (set-buffer gnus-original-article-buffer) + (message-cancel-news))) (gnus-summary-mark-as-read article gnus-canceled-mark) (gnus-cache-remove-article 1)) (gnus-article-hide-headers-if-wanted)) @@ -317,9 +324,9 @@ header line with the old Message-ID." (message-supersede) (push `((lambda () - (when (buffer-name (get-buffer ,gnus-summary-buffer)) + (when (gnus-buffer-exists-p ,gnus-summary-buffer) (save-excursion - (set-buffer (get-buffer ,gnus-summary-buffer)) + (set-buffer ,gnus-summary-buffer) (gnus-cache-possibly-remove-article ,article nil nil nil t) (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) message-send-actions)))) @@ -338,7 +345,7 @@ header line with the old Message-ID." (let ((article-buffer (or article-buffer gnus-article-buffer)) end beg contents) (if (not (and (get-buffer article-buffer) - (buffer-name (get-buffer article-buffer)))) + (gnus-buffer-exists-p article-buffer))) (error "Can't find any article buffer") (save-excursion (set-buffer article-buffer) @@ -407,6 +414,7 @@ header line with the old Message-ID." (if post (message-news (or to-group group)) (set-buffer gnus-article-copy) + (gnus-msg-treat-broken-reply-to) (message-followup (if (or newsgroup-p force-news) nil to-group))) ;; The is mail. (if post @@ -420,12 +428,19 @@ header line with the old Message-ID." (push (list 'gnus-inews-add-to-address pgroup) message-send-actions))) (set-buffer gnus-article-copy) - (message-wide-reply to-address - (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to)))) + (gnus-msg-treat-broken-reply-to) + (message-wide-reply to-address))) (when yank (gnus-inews-yank-articles yank)))))) +(defun gnus-msg-treat-broken-reply-to () + "Remove the Reply-to header iff broken-reply-to." + (when (gnus-group-find-parameter + gnus-newsgroup-name 'broken-reply-to) + (save-restriction + (message-narrow-to-head) + (message-remove-header "reply-to")))) + (defun gnus-post-method (arg group &optional silent) "Return the posting method based on GROUP and ARG. If SILENT, don't prompt the user." @@ -434,22 +449,28 @@ If SILENT, don't prompt the user." ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ((null group-method) - (or gnus-post-method gnus-select-method message-post-method)) - ;; We want this group's method. + (or (and (null (eq gnus-post-method 'active)) gnus-post-method) + gnus-select-method message-post-method)) + ;; We want the inverse of the default ((and arg (not (eq arg 0))) - group-method) + (if (eq gnus-post-method 'active) + gnus-select-method + group-method)) ;; We query the user for a post method. ((or arg (and gnus-post-method + (not (eq gnus-post-method 'current)) (listp (car gnus-post-method)))) (let* ((methods ;; Collect all methods we know about. (append - (when gnus-post-method + (when (and gnus-post-method + (not (eq gnus-post-method 'current))) (if (listp (car gnus-post-method)) gnus-post-method (list gnus-post-method))) gnus-secondary-select-methods + (mapcar 'cdr gnus-server-alist) (list gnus-select-method) (list group-method))) method-alist post-methods method) @@ -478,41 +499,14 @@ If SILENT, don't prompt the user." (cons (or gnus-last-posting-server "") 0)))) method-alist)))) ;; Override normal method. + ((and (eq gnus-post-method 'current) + (not arg)) + group-method) (gnus-post-method gnus-post-method) ;; Use the normal select method. (t gnus-select-method)))) -;;; -;;; Check whether the message has been sent already. -;;; - -(defvar gnus-inews-sent-ids nil) - -(defun gnus-inews-reject-message () - "Check whether this message has already been sent." - (when gnus-sent-message-ids-file - (let ((message-id (save-restriction (message-narrow-to-headers) - (mail-fetch-field "message-id"))) - end) - (when message-id - (unless gnus-inews-sent-ids - (ignore-errors - (load t t t))) - (if (member message-id gnus-inews-sent-ids) - ;; Reject this message. - (not (gnus-yes-or-no-p - (format "Message %s already sent. Send anyway? " - message-id))) - (push message-id gnus-inews-sent-ids) - ;; Chop off the last Message-IDs. - (when (setq end (nthcdr gnus-sent-message-ids-length - gnus-inews-sent-ids)) - (setcdr end nil)) - (nnheader-temp-write gnus-sent-message-ids-file - (gnus-prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids))) - nil))))) - ;; Dummy to avoid byte-compile warning. @@ -523,56 +517,9 @@ If SILENT, don't prompt the user." ;;; as well include the Emacs version as well. ;;; The following function works with later GNU Emacs, and XEmacs. (defun gnus-extended-version () - "Stringified Gnus version and Emacs version" + "Stringified gnus version." (interactive) - (concat - gnus-version - "/" - (cond - ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) - (concat "Emacs " (substring emacs-version - (match-beginning 1) - (match-end 1)))) - ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" - emacs-version) - (concat (substring emacs-version - (match-beginning 1) - (match-end 1)) - (format " %d.%d" emacs-major-version emacs-minor-version) - (if (match-beginning 3) - (substring emacs-version - (match-beginning 3) - (match-end 3)) - "") - (if (boundp 'xemacs-codename) - (concat " - \"" xemacs-codename "\"")))) - (t emacs-version)))) - -;; Written by "Mr. Per Persson" . -(defun gnus-inews-insert-mime-headers () - (goto-char (point-min)) - (let ((mail-header-separator - (progn - (goto-char (point-min)) - (if (and (search-forward (concat "\n" mail-header-separator "\n") - nil t) - (not (search-backward "\n\n" nil t))) - mail-header-separator - "")))) - (or (mail-position-on-field "Mime-Version") - (insert "1.0") - (cond ((save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward "[\200-\377]" nil t)) - (or (mail-position-on-field "Content-Type") - (insert "text/plain; charset=ISO-8859-1")) - (or (mail-position-on-field "Content-Transfer-Encoding") - (insert "8bit"))) - (t (or (mail-position-on-field "Content-Type") - (insert "text/plain; charset=US-ASCII")) - (or (mail-position-on-field "Content-Transfer-Encoding") - (insert "7bit"))))))) + gnus-version) ;;; @@ -595,8 +542,8 @@ automatically." (gnus-setup-message (if yank 'reply-yank 'reply) (gnus-summary-select-article) (set-buffer (gnus-copy-article-buffer)) - (message-reply nil wide (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to)) + (gnus-msg-treat-broken-reply-to) + (message-reply nil wide) (when yank (gnus-inews-yank-articles yank))))) @@ -627,7 +574,11 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (interactive "P") (gnus-setup-message 'forward (gnus-summary-select-article) - (set-buffer gnus-original-article-buffer) + (let ((charset default-mime-charset)) + (set-buffer gnus-original-article-buffer) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + ) (let ((message-included-forward-headers (if full-headers "" message-included-forward-headers))) (message-forward post)))) @@ -801,18 +752,20 @@ If YANK is non-nil, include the original article." (error "Gnus has been shut down")) (gnus-setup-message 'bug (delete-other-windows) - (switch-to-buffer (get-buffer-create "*Gnus Help Bug*")) - (erase-buffer) - (insert gnus-bug-message) - (goto-char (point-min)) + (when gnus-bug-create-help-buffer + (switch-to-buffer "*Gnus Help Bug*") + (erase-buffer) + (insert gnus-bug-message) + (goto-char (point-min))) (message-pop-to-buffer "*Gnus Bug*") (message-setup `((To . ,gnus-maintainer) (Subject . ""))) - (push `(gnus-bug-kill-buffer) message-send-actions) + (when gnus-bug-create-help-buffer + (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) - (insert (gnus-version) "\n") - (insert (emacs-version) "\n") + (insert (gnus-version) "\n" + (emacs-version) "\n") (when (and (boundp 'nntp-server-type) (stringp nntp-server-type)) (insert nntp-server-type)) @@ -919,7 +872,6 @@ this is a reply." (save-restriction (message-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) - (cur (current-buffer)) (coding-system-for-write 'raw-text) groups group method) (when gcc @@ -948,8 +900,8 @@ this is a reply." (gnus-request-create-group group method)) (save-excursion (nnheader-set-temp-buffer " *acc*") - (insert-buffer-substring cur) - (run-hooks 'gnus-before-do-gcc-hook) + (insert-buffer-substring message-encoding-buffer) + (gnus-run-hooks 'gnus-before-do-gcc-hook) (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") @@ -1052,11 +1004,6 @@ this is a reply." (insert " "))) (insert "\n"))))))) -(gnus-add-shutdown 'gnus-inews-close 'gnus) - -(defun gnus-inews-close () - (setq gnus-inews-sent-ids nil)) - ;;; Allow redefinition of functions. (gnus-ems-redefine)