;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
(require 'message)
(require 'gnus-art)
-;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
-(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.
(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,
(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?")
+
+(defvar gnus-posting-styles nil
+ "*Alist of styles to use when posting.")
+
+(defvar gnus-posting-style-alist
+ '((organization . message-user-organization)
+ (signature . message-signature)
+ (signature-file . message-signature-file)
+ (address . user-mail-address)
+ (name . user-full-name))
+ "*Mapping from style parameters to variables.")
+
;;; Internal variables.
(defvar gnus-message-buffer "*Mail Gnus*")
(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)
(add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
+ (add-hook 'message-mode-hook 'gnus-configure-posting-styles)
(unwind-protect
(progn
,@forms)
(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))))
(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))
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))
(defun gnus-summary-post-news ()
"Start composing a news message."
(interactive)
- (gnus-set-global-variables)
(gnus-post-news 'post gnus-newsgroup-name))
(defun gnus-summary-followup (yank &optional force-news)
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
- (gnus-set-global-variables)
(when yank
(gnus-summary-goto-subject (car yank)))
(save-window-excursion
(push-mark)
(goto-char beg)))
-(defun gnus-summary-cancel-article (n)
- "Cancel an article you posted."
- (interactive "P")
- (gnus-set-global-variables)
+(defun gnus-summary-cancel-article (&optional n symp)
+ "Cancel an article you posted.
+Uses the process-prefix convention. If given the symbolic
+prefix `a', cancel using the standard posting method; if not
+post using the current select method."
+ (interactive (gnus-interactive "P\ny"))
(let ((articles (gnus-summary-work-articles n))
(message-post-method
`(lambda (arg)
- (gnus-post-method nil ,gnus-newsgroup-name)))
+ (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name)))
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID."
(interactive)
- (gnus-set-global-variables)
(let ((article (gnus-summary-article-number)))
(gnus-setup-message 'reply-yank
(gnus-summary-select-article t)
(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))))
(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)
(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
(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."
;; 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)
(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)))))
-
\f
;; Dummy to avoid byte-compile warning.
;;; 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 and Emacs version."
(interactive)
(concat
gnus-version
;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
(defun gnus-inews-insert-mime-headers ()
+ "Insert MIME headers.
+Assumes ISO-Latin-1 is used iff 8-bit characters are present."
(goto-char (point-min))
(let ((mail-header-separator
(progn
(cond ((save-restriction
(widen)
(goto-char (point-min))
- (re-search-forward "[\200-\377]" nil t))
+ (re-search-forward "[^\000-\177]" nil t))
(or (mail-position-on-field "Content-Type")
(insert "text/plain; charset=ISO-8859-1"))
(or (mail-position-on-field "Content-Transfer-Encoding")
(or (mail-position-on-field "Content-Transfer-Encoding")
(insert "7bit")))))))
+(custom-add-option 'message-header-hook 'gnus-inews-insert-mime-headers)
+
\f
;;;
;;; Gnus Mail Functions
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
;; Stripping headers should be specified with mail-yank-ignored-headers.
- (gnus-set-global-variables)
(when yank
(gnus-summary-goto-subject (car yank)))
(let ((gnus-article-reply t))
(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)))))
"Forward the current message to another user.
If FULL-HEADERS (the prefix), include full headers when forwarding."
(interactive "P")
- (gnus-set-global-variables)
(gnus-setup-message 'forward
(gnus-summary-select-article)
(set-buffer gnus-original-article-buffer)
(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))
"gnus-art.el" "gnus-start.el" "gnus-async.el"
"gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
"nnmail.el" "message.el"))
+ (point (point))
file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
(sit-for 0)
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
(insert "\n\n")
- ;; Remove any null chars - they seem to cause trouble for some
+ ;; Remove any control chars - they seem to cause trouble for some
;; mailers. (Byte-compiled output from the stuff above.)
- (goto-char (point-min))
- (while (re-search-forward "[\000\200]" nil t)
- (replace-match "" t t))))
+ (goto-char point)
+ (while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t)
+ (replace-match (format "\\%03o" (string-to-char (match-string 0)))
+ t t))))
;;; Treatment of rejected articles.
;;; Bounced mail.
"Insert the Gcc to say where the article is to be archived."
(let* ((var gnus-message-archive-group)
(group (or group gnus-newsgroup-name ""))
- result
- gcc-self-val
+ (gcc-self-val
+ (and gnus-newsgroup-name
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'gcc-self)))
+ result
(groups
(cond
((null gnus-message-archive-method)
(setq var (cdr var)))
result)))
name)
- (when groups
+ (when (or groups gcc-self-val)
(when (stringp groups)
(setq groups (list groups)))
(save-excursion
(message-narrow-to-headers)
(goto-char (point-max))
(insert "Gcc: ")
- (if (and gnus-newsgroup-name
- (setq gcc-self-val
- (gnus-group-find-parameter
- gnus-newsgroup-name 'gcc-self)))
+ (if gcc-self-val
+ ;; Use the `gcc-self' param value instead.
(progn
(insert
(if (stringp gcc-self-val)
(progn
(beginning-of-line)
(kill-line))))
+ ;; Use the list of groups.
(while (setq name (pop groups))
(insert (if (string-match ":" name)
name
(insert " ")))
(insert "\n")))))))
-(gnus-add-shutdown 'gnus-inews-close 'gnus)
-
-(defun gnus-inews-close ()
- (setq gnus-inews-sent-ids nil))
+;;; Posting styles.
+
+(defun gnus-configure-posting-styles ()
+ "Configure posting styles according to `gnus-posting-styles'."
+ (let ((styles gnus-posting-styles)
+ (gnus-newsgroup-name (or gnus-newsgroup-name ""))
+ style match variable attribute value value-value)
+ ;; 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)))
+ ;; We have a match, so we set the variables.
+ (while style
+ (setq attribute (pop style)
+ value (cadr attribute)
+ variable nil)
+ ;; We find the variable that is to be modified.
+ (if (and (not (stringp (car attribute)))
+ (not (setq variable (cdr (assq (car attribute)
+ gnus-posting-style-alist)))))
+ (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))))
+ (if variable
+ (progn
+ ;; This is an ordinary variable.
+ (make-local-variable variable)
+ (set variable value-value))
+ ;; This is a header to be added to the headers when
+ ;; posting.
+ (when value-value
+ (make-local-variable 'message-required-mail-headers)
+ (make-local-variable 'message-required-news-headers)
+ (push (cons (car attribute) value-value)
+ message-required-mail-headers)
+ (push (cons (car attribute) value-value)
+ message-required-news-headers)))))))))
;;; Allow redefinition of functions.
projects / gnus / blobdiff