;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
(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-inhibit-posting-styles nil
+ "Inhibit the use of posting styles.")
+
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
(defvar gnus-last-posting-server nil)
"\M-c" gnus-summary-mail-crosspost-complaint
"om" gnus-summary-mail-forward
"op" gnus-summary-post-forward
- "Om" gnus-uu-digest-mail-forward
- "Op" gnus-uu-digest-post-forward)
+ "Om" gnus-summary-mail-digest
+ "Op" gnus-summary-post-digest)
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
(,article (and gnus-article-reply (gnus-summary-article-number)))
(,group gnus-newsgroup-name)
(message-header-setup-hook
- (copy-sequence message-header-setup-hook)))
+ (copy-sequence message-header-setup-hook))
+ (message-mode-hook (copy-sequence message-mode-hook))
+ (message-startup-parameter-alist
+ '((reply-buffer . gnus-copy-article-buffer)
+ (original-buffer . gnus-original-article-buffer)
+ (user-agent . Gnus))))
(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))))
;; 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)
+ end beg)
(if (not (and (get-buffer article-buffer)
(gnus-buffer-exists-p article-buffer)))
(error "Can't find any 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."
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)
method-alist))))
;; Override normal method.
((and (eq gnus-post-method 'current)
+ (not (eq (car group-method) 'nndraft))
(not arg))
group-method)
- (gnus-post-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."
+ "Stringified gnus version."
(interactive)
gnus-version)
(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)))))
(if full-headers "" message-included-forward-headers)))
(message-forward post))))
+(defun gnus-summary-post-forward (&optional full-headers)
+ "Forward the current article to a newsgroup.
+If FULL-HEADERS (the prefix), include full headers when forwarding."
+ (interactive "P")
+ (gnus-summary-mail-forward full-headers t))
+
+;;; XXX: generate Subject and ``Topics''?
+(defun gnus-summary-mail-digest (&optional n post)
+ "Digests and forwards all articles in this series."
+ (interactive "P")
+ (let ((subject "Digested Articles")
+ (articles (gnus-summary-work-articles n))
+ article)
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (if post (message-news nil subject) (message-mail nil subject))
+ (message-goto-body)
+ (while (setq article (pop articles))
+ (save-window-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-select-article nil nil nil article)
+ (gnus-summary-remove-process-mark article))
+ (insert (mime-make-tag "message" "rfc822") "\n")
+ (insert-buffer-substring gnus-original-article-buffer))
+ (push-mark)
+ (message-goto-body)
+ (mime-edit-enclose-digest-region (point)(mark t)))))
+
+(defun gnus-summary-post-digest (&optional n)
+ "Digest and forwards all articles in this series to a newsgroup."
+ (interactive "P")
+ (gnus-summary-mail-digest n t))
+
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(interactive "sResend message(s) to: \nP")
(set-buffer gnus-original-article-buffer)
(message-resend address)))))
-(defun gnus-summary-post-forward (&optional full-headers)
- "Forward the current article to a newsgroup.
-If FULL-HEADERS (the prefix), include full headers when forwarding."
- (interactive "P")
- (gnus-summary-mail-forward full-headers t))
-
(defvar gnus-nastygram-message
"The following article was inappropriately posted to %s.\n\n"
"Format string to insert in nastygrams.
(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.
+
+(defvar gnus-message-style-insertions nil)
+
+(defun gnus-configure-posting-styles ()
+ "Configure posting styles according to `gnus-posting-styles'."
+ (unless gnus-inhibit-posting-styles
+ (let ((styles gnus-posting-styles)
+ (gnus-newsgroup-name (or gnus-newsgroup-name ""))
+ style match variable attribute value value-value)
+ (make-local-variable 'gnus-message-style-insertions)
+ ;; 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
+ '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)
+ (save-excursion
+ (message-goto-eoh)
+ (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)))))
+
;;; Allow redefinition of functions.
(gnus-ems-redefine)
projects / elisp / gnus.git- / blobdiff