;; 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-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*")
(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)
(cons ,group ,article))
(make-local-variable 'gnus-newsgroup-name)
(gnus-run-hooks 'gnus-message-setup-hook))
+ (gnus-add-buffer)
(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))
(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))))
;; this copy is in the buffer gnus-article-copy.
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
;; this buffer should be passed to all mail/news reply/post routines.
- (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
+ (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
(buffer-disable-undo gnus-article-copy)
- (or (memq gnus-article-copy gnus-buffer-list)
- (push gnus-article-copy gnus-buffer-list))
(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.
- (gnus-post-method
+ ((and (eq gnus-post-method 'current)
+ (not (eq (car group-method) 'nndraft))
+ (not arg))
+ group-method)
+ ((and gnus-post-method
+ (not (eq gnus-post-method 'current)))
gnus-post-method)
;; Use the normal select method.
(t gnus-select-method))))
;;; 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.
+ "Insert MIME headers.
Assumes ISO-Latin-1 is used iff 8-bit characters are present."
(goto-char (point-min))
(let ((mail-header-separator
(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)))))
(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))
(sit-for 0)
;; Go through all the files looking for non-default values for variables.
(save-excursion
- (set-buffer (get-buffer-create " *gnus bug info*"))
+ (set-buffer (gnus-get-buffer-create " *gnus bug info*"))
(buffer-disable-undo (current-buffer))
(while files
(erase-buffer)
(insert " ")))
(insert "\n")))))))
+;;; 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 (eq 'body (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
+ ;; 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))))
+ (add-hook
+ 'message-setup-hook
+ `(lambda ()
+ (save-excursion
+ (message-goto-eoh)
+ (insert ,(if (stringp attr) attr (symbol-name attr))
+ ": " ,value-value "\n"))))))))))))))
+
;;; Allow redefinition of functions.
(gnus-ems-redefine)
projects / elisp / gnus.git- / blobdiff