;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'message)
(require 'gnus-art)
-(defcustom gnus-post-method nil
+(defcustom gnus-post-method 'current
"*Preferred method for posting USENET news.
-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.
+If this variable is `current' (which is the default), Gnus will use
+the \"current\" select method when posting. If it is nil, Gnus will
+use the native select method when posting.
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
+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)
(defvar gnus-posting-styles nil
"*Alist of styles to use when posting.")
+(defvar gnus-inews-mark-gcc-as-read nil
+ "If non-nil, automatically mark Gcc articles as read.")
+
(defcustom gnus-group-posting-charset-alist
- '(("^no\\." iso-8859-1)
- (message-this-is-mail nil)
- ("^de\\." nil)
- (".*" iso-8859-1)
- (message-this-is-news iso-8859-1))
- "Alist of regexps (to match group names) and default charsets to be unencoded when posting."
- :type '(repeat (list (regexp :tag "Group")
- (symbol :tag "Charset")))
+ '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
+ ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
+ (message-this-is-mail nil nil)
+ (message-this-is-news nil t))
+ "Alist of regexps and permitted unencoded charsets for posting.
+Each element of the alist has the form (TEST HEADER BODY-LIST), where
+TEST is either a regular expression matching the newsgroup header or a
+variable to query,
+HEADER is the charset which may be left unencoded in the header (nil
+means encode all charsets),
+BODY-LIST is a list of charsets which may be encoded using 8bit
+content-transfer encoding in the body, or one of the special values
+nil (always encode using quoted-printable) or t (always use 8bit).
+
+Note that any value other than nil for HEADER infringes some RFCs, so
+use this option with care."
+ :type '(repeat (list :tag "Permitted unencoded charsets"
+ (choice :tag "Where"
+ (regexp :tag "Group")
+ (const :tag "Mail message" :value message-this-is-mail)
+ (const :tag "News article" :value message-this-is-news))
+ (choice :tag "Header"
+ (const :tag "None" nil)
+ (symbol :tag "Charset"))
+ (choice :tag "Body"
+ (const :tag "Any" :value t)
+ (const :tag "None" :value nil)
+ (repeat :tag "Charsets"
+ (symbol :tag "Charset")))))
:group 'gnus-charset)
;;; Internal variables.
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
+(defvar gnus-check-before-posting nil)
(defvar gnus-last-posting-server nil)
(defvar gnus-message-group-art nil)
+(defvar gnus-msg-force-broken-reply-to nil)
+
(defconst gnus-bug-message
"Sending a bug report to the Gnus Towers.
========================================
"c" gnus-summary-cancel-article
"s" gnus-summary-supersede-article
"r" gnus-summary-reply
+ "y" gnus-summary-yank-message
"R" gnus-summary-reply-with-original
"w" gnus-summary-wide-reply
"W" gnus-summary-wide-reply-with-original
+ "v" gnus-summary-very-wide-reply
+ "W" gnus-summary-very-wide-reply-with-original
"n" gnus-summary-followup-to-mail
"N" gnus-summary-followup-to-mail-with-original
"m" gnus-summary-mail-other-window
"u" gnus-uu-post-news
"\M-c" gnus-summary-mail-crosspost-complaint
+ "Br" gnus-summary-reply-broken-reply-to
+ "BR" gnus-summary-reply-broken-reply-to-with-original
"om" gnus-summary-mail-forward
"op" gnus-summary-post-forward
"Om" gnus-uu-digest-mail-forward
(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)))
+ (,article gnus-article-reply)
(,group gnus-newsgroup-name)
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
+ (mbl mml-buffer-list)
(message-mode-hook (copy-sequence message-mode-hook)))
+ (setq mml-buffer-list nil)
(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)
+ (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config)
+ (gnus-inews-insert-draft-meta-information ,group ,article)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(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-run-hooks 'gnus-message-setup-hook)
+ (if (eq major-mode 'message-mode)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl) ;; Global value
+ (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
+ (mml-destroy-buffers)
+ (setq mml-buffer-list mbl)))
(gnus-add-buffer)
(gnus-configure-windows ,config t)
(set-buffer-modified-p nil))))
+(defun gnus-inews-insert-draft-meta-information (group article)
+ (save-excursion
+ (when (and group
+ (not (string= group ""))
+ (not (message-fetch-field gnus-draft-meta-information-header)))
+ (goto-char (point-min))
+ (insert gnus-draft-meta-information-header ": (\"" group "\" "
+ (if article (number-to-string
+ (if (listp article)
+ (car article)
+ article)) "\"\"")
+ ")\n"))))
+
+;;;###autoload
+(defun gnus-msg-mail (&optional to subject other-headers continue
+ switch-action yank-action send-actions)
+ "Start editing a mail message to be sent.
+Like `message-mail', but with Gnus paraphernalia, particularly the
+Gcc: header for archiving purposes."
+ (interactive)
+ (let ((buf (current-buffer))
+ mail-buf)
+ (gnus-setup-message 'message
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions))
+ (when switch-action
+ (setq mail-buf (current-buffer))
+ (switch-to-buffer buf)
+ (apply switch-action mail-buf nil)))
+ ;; COMPOSEFUNC should return t if succeed. Undocumented ???
+ t)
+
+;;;###autoload
+(defun gnus-button-mailto (address)
+ "Mail to ADDRESS."
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-setup-message 'message
+ (message-reply address)))
+
+;;;###autoload
+(defun gnus-button-reply (&optional to-address wide)
+ "Like `message-reply'."
+ (interactive)
+ (gnus-setup-message 'message
+ (message-reply to-address wide)))
+
+;;;###autoload
+(define-mail-user-agent 'gnus-user-agent
+ 'gnus-msg-mail 'message-send-and-exit
+ 'message-kill-buffer 'message-send-hook)
+
(defun gnus-setup-posting-charset (group)
(let ((alist gnus-group-posting-charset-alist)
(group (or group ""))
(funcall (car elem) group))
(and (symbolp (car elem))
(symbol-value (car elem))))
- (throw 'found (cadr elem))))))))
+ (throw 'found (cons (cadr elem) (caddr elem)))))))))
-(defun gnus-inews-add-send-actions (winconf buffer article)
+(defun gnus-inews-add-send-actions (winconf buffer article &optional config)
(make-local-hook 'message-sent-hook)
- (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
+ (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
+ 'gnus-inews-do-gcc) nil t)
+ (when gnus-agent
+ (make-local-hook 'message-header-hook)
+ (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
(save-excursion
(set-buffer ,buffer)
,(when article
- `(gnus-summary-mark-article-as-replied ,article))))
+ (if (eq config 'forward)
+ `(gnus-summary-mark-article-as-forwarded ',article)
+ `(gnus-summary-mark-article-as-replied ',article)))))
'send))
(put 'gnus-setup-message 'lisp-indent-function 1)
(gnus-summary-remove-process-mark article))
(gnus-copy-article-buffer)
(let ((message-reply-buffer gnus-article-copy)
- (message-reply-headers gnus-current-headers))
+ (message-reply-headers
+ (with-current-buffer gnus-article-copy
+ ;; The headers are decoded.
+ (nnheader-parse-head t))))
(message-yank-original)
(setq beg (or beg (mark t))))
(when articles
(error "Can't find any article buffer")
(save-excursion
(set-buffer article-buffer)
- (save-restriction
- ;; Copy over the (displayed) article buffer, delete
- ;; hidden text and remove text properties.
- (widen)
- (copy-to-buffer gnus-article-copy (point-min) (point-max))
- (set-buffer gnus-article-copy)
- (gnus-article-delete-text-of-type 'annotation)
- (gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next)
- (insert
- (prog1
- (format "%s" (buffer-string))
- (erase-buffer)))
- ;; Find the original headers.
- (set-buffer gnus-original-article-buffer)
- (goto-char (point-min))
- (while (looking-at message-unix-mail-delimiter)
- (forward-line 1))
- (setq beg (point))
- (setq end (or (search-forward "\n\n" nil t) (point)))
- ;; 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-max)))
- ;; Insert the original article headers.
- (insert-buffer-substring gnus-original-article-buffer beg end)
- (article-decode-encoded-words)))
+ (let ((gnus-newsgroup-charset (or gnus-article-charset
+ gnus-newsgroup-charset))
+ (gnus-newsgroup-ignored-charsets
+ (or gnus-article-ignored-charsets
+ gnus-newsgroup-ignored-charsets)))
+ (save-restriction
+ ;; Copy over the (displayed) article buffer, delete
+ ;; hidden text and remove text properties.
+ (widen)
+ (copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (set-buffer gnus-article-copy)
+ (gnus-article-delete-text-of-type 'annotation)
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)
+ (insert
+ (prog1
+ (buffer-substring-no-properties (point-min) (point-max))
+ (erase-buffer)))
+ ;; Find the original headers.
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (while (looking-at message-unix-mail-delimiter)
+ (forward-line 1))
+ (setq beg (point))
+ (setq end (or (message-goto-body) beg))
+ ;; Delete the headers from the displayed articles.
+ (set-buffer gnus-article-copy)
+ (delete-region (goto-char (point-min))
+ (or (message-goto-body) (point-max)))
+ ;; Insert the original article headers.
+ (insert-buffer-substring gnus-original-article-buffer beg end)
+ (article-decode-encoded-words))))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
force-news)
(when article-buffer
(gnus-copy-article-buffer))
- (let ((gnus-article-reply article-buffer)
+ (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
(add-to-list gnus-add-to-list))
(gnus-setup-message (cond (yank 'reply-yank)
(article-buffer 'reply)
(t 'message))
(let* ((group (or group gnus-newsgroup-name))
+ (charset (gnus-group-name-charset nil group))
(pgroup group)
to-address to-group mailing-list to-list
newsgroup-p)
(when group
- (setq to-address (gnus-group-find-parameter group 'to-address)
+ (setq to-address (gnus-parameter-to-address group)
to-group (gnus-group-find-parameter group 'to-group)
- to-list (gnus-group-find-parameter group 'to-list)
+ to-list (gnus-parameter-to-list group)
newsgroup-p (gnus-group-find-parameter group 'newsgroup)
mailing-list (when gnus-mailing-list-groups
(string-match gnus-mailing-list-groups group))
- group (gnus-group-real-name group)))
+ group (gnus-group-name-decode (gnus-group-real-name group)
+ charset)))
(if (or (and to-group
(gnus-news-group-p to-group))
newsgroup-p
(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)))
+ (message-followup (if (or newsgroup-p force-news)
+ (if (save-restriction
+ (article-narrow-to-head)
+ (message-fetch-field "newsgroups"))
+ nil
+ "")
+ to-group)))
;; The is mail.
(if post
(progn
(when yank
(gnus-inews-yank-articles yank))))))
-(defun gnus-msg-treat-broken-reply-to ()
+(defun gnus-msg-treat-broken-reply-to (&optional force)
"Remove the Reply-to header iff broken-reply-to."
- (when (gnus-group-find-parameter
- gnus-newsgroup-name 'broken-reply-to)
+ (when (or force
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'broken-reply-to))
(save-restriction
(message-narrow-to-head)
(message-remove-header "reply-to"))))
;; the default method.
((null group-method)
(or (and (null (eq gnus-post-method 'active)) gnus-post-method)
- gnus-select-method message-post-method))
+ gnus-select-method message-post-method))
;; We want the inverse of the default
((and arg (not (eq arg 0)))
(if (eq gnus-post-method 'active)
(setq method-alist
(mapcar
(lambda (m)
- (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
+ (if (equal (cadr m) "")
+ (list (symbol-name (car m)) m)
+ (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)))
post-methods))
;; Query the user.
(cadr
;; Override normal method.
((and (eq gnus-post-method 'current)
(not (eq (car group-method) 'nndraft))
+ (gnus-get-function group-method 'request-post t)
(not arg))
group-method)
((and gnus-post-method
\f
;; Dummies to avoid byte-compile warning.
-(defvar nnspool-rejected-article-hook)
-(defvar xemacs-codename)
+(eval-when-compile
+ (defvar nnspool-rejected-article-hook)
+ (defvar xemacs-codename))
(defun gnus-extended-version ()
"Stringified Gnus version and Emacs version."
;;; Mail reply commands of Gnus summary mode
-(defun gnus-summary-reply (&optional yank wide)
- "Start composing a reply mail to the current message.
+(defun gnus-summary-reply (&optional yank wide very-wide)
+ "Start composing a mail reply to the current message.
If prefix argument YANK is non-nil, the original article is yanked
-automatically."
+automatically.
+If WIDE, make a wide reply.
+If VERY-WIDE, make a very wide reply."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
;; Stripping headers should be specified with mail-yank-ignored-headers.
(when yank
(gnus-summary-goto-subject (car yank)))
- (let ((gnus-article-reply t))
+ (let ((gnus-article-reply (or yank (gnus-summary-article-number)))
+ (headers ""))
(gnus-setup-message (if yank 'reply-yank 'reply)
- (gnus-summary-select-article)
+ (if (not very-wide)
+ (gnus-summary-select-article)
+ (dolist (article very-wide)
+ (gnus-summary-select-article nil nil nil article)
+ (save-excursion
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-msg-treat-broken-reply-to)
+ (save-restriction
+ (message-narrow-to-head)
+ (setq headers (concat headers (buffer-string)))))))
(set-buffer (gnus-copy-article-buffer))
- (gnus-msg-treat-broken-reply-to)
+ (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
+ (save-restriction
+ (message-narrow-to-head)
+ (when very-wide
+ (erase-buffer)
+ (insert headers))
+ (goto-char (point-max)))
+ (mml-quote-region (point) (point-max))
(message-reply nil wide)
(when yank
(gnus-inews-yank-articles yank)))))
(interactive "P")
(gnus-summary-reply (gnus-summary-work-articles n) wide))
+(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
+ "Like `gnus-summary-reply' except removing reply-to field.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically.
+If WIDE, make a wide reply.
+If VERY-WIDE, make a very wide reply."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (let ((gnus-msg-force-broken-reply-to t))
+ (gnus-summary-reply yank wide very-wide)))
+
+(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
+ "Like `gnus-summary-reply-with-original' except removing reply-to field.
+The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
+
(defun gnus-summary-wide-reply (&optional yank)
"Start composing a wide reply mail to the current message.
If prefix argument YANK is non-nil, the original article is yanked
(interactive "P")
(gnus-summary-reply-with-original n t))
-(defun gnus-summary-mail-forward (&optional not-used post)
+(defun gnus-summary-very-wide-reply (&optional yank)
+ "Start composing a very wide reply mail to the current message.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnus-summary-reply yank t (gnus-summary-work-articles yank)))
+
+(defun gnus-summary-very-wide-reply-with-original (n)
+ "Start composing a very wide reply mail to the current message.
+The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply
+ (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
+
+(defun gnus-summary-mail-forward (&optional arg post)
"Forward the current message to another user.
+If ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
+if ARG is 1, decode the message and forward directly inline;
+if ARG is 2, forward message as an rfc822 MIME section;
+if ARG is 3, decode message and forward as an rfc822 MIME section;
+if ARG is 4, forward message directly inline;
+otherwise, use flipped `message-forward-as-mime'.
If POST, post instead of mail."
(interactive "P")
- (gnus-setup-message 'forward
- (gnus-summary-select-article)
- (let (text)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (setq text (buffer-string)))
- (set-buffer (gnus-get-buffer-create
- (generate-new-buffer-name " *Gnus forward*")))
- (erase-buffer)
- (insert text)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: ") )
- (run-hooks 'gnus-article-decode-hook)
- (message-forward post))))
+ (let ((message-forward-as-mime message-forward-as-mime)
+ (message-forward-show-mml message-forward-show-mml))
+ (cond
+ ((null arg))
+ ((eq arg 1)
+ (setq message-forward-as-mime nil
+ message-forward-show-mml t))
+ ((eq arg 2)
+ (setq message-forward-as-mime t
+ message-forward-show-mml nil))
+ ((eq arg 3)
+ (setq message-forward-as-mime t
+ message-forward-show-mml t))
+ ((eq arg 4)
+ (setq message-forward-as-mime nil
+ message-forward-show-mml nil))
+ (t
+ (setq message-forward-as-mime (not message-forward-as-mime))))
+ (let ((gnus-article-reply (gnus-summary-article-number)))
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
+ (set-buffer gnus-original-article-buffer)
+ (message-forward post))))))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
- (interactive "sResend message(s) to: \nP")
+ (interactive
+ (list (message-read-from-minibuffer "Resend message(s) to: ")
+ current-prefix-arg))
(let ((articles (gnus-summary-work-articles n))
article)
(while (setq article (pop articles))
(gnus-summary-select-article nil nil nil article)
(save-excursion
(set-buffer gnus-original-article-buffer)
- (message-resend address)))))
+ (message-resend address))
+ (gnus-summary-mark-article-as-forwarded article))))
-(defun gnus-summary-post-forward (&optional full-headers)
+(defun gnus-summary-post-forward (&optional arg)
"Forward the current article to a newsgroup.
-If FULL-HEADERS (the prefix), include full headers when forwarding."
+See `gnus-summary-mail-forward' for ARG."
(interactive "P")
- (gnus-summary-mail-forward full-headers t))
+ (gnus-summary-mail-forward arg t))
(defvar gnus-nastygram-message
"The following article was inappropriately posted to %s.\n\n"
(let ((reply gnus-article-reply)
(winconf gnus-prev-winconf)
(group gnus-newsgroup-name))
+ (unless (and group
+ (not (gnus-group-read-only-p group)))
+ (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
- (or (and group (not (gnus-group-read-only-p group)))
- (setq group (read-string "Put in group: " nil
- (gnus-writable-groups))))
(when (gnus-gethash group gnus-newsrc-hashtb)
(error "No such group: %s" group))
-
(save-excursion
(save-restriction
(widen)
(message-narrow-to-headers)
- (let (gnus-deletable-headers)
- (if (message-news-p)
- (message-generate-headers message-required-news-headers)
- (message-generate-headers message-required-mail-headers)))
+ (let ((gnus-deletable-headers nil))
+ (message-generate-headers
+ (if (message-news-p)
+ message-required-news-headers
+ message-required-mail-headers)))
(goto-char (point-max))
(insert "Gcc: " group "\n")
(widen)))
-
(gnus-inews-do-gcc)
-
- (when (get-buffer gnus-group-buffer)
- (when (gnus-buffer-exists-p (car-safe reply))
- (set-buffer (car reply))
- (and (cdr reply)
- (gnus-summary-mark-article-as-replied
- (cdr reply))))
- (when winconf
- (set-window-configuration winconf)))))
+ (when (and (get-buffer gnus-group-buffer)
+ (gnus-buffer-exists-p (car-safe reply))
+ (cdr reply))
+ (set-buffer (car reply))
+ (gnus-summary-mark-article-as-replied (cdr reply)))
+ (when winconf
+ (set-window-configuration winconf))))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
(interactive)
(unless (gnus-alive-p)
(error "Gnus has been shut down"))
- (gnus-setup-message 'bug
- (delete-other-windows)
- (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 . "")))
+ (gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
+ (unless (message-mail-user-agent)
+ (delete-other-windows)
+ (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*"))
+ (let ((message-this-is-mail t))
+ (message-setup `((To . ,gnus-maintainer) (Subject . ""))))
(when gnus-bug-create-help-buffer
(push `(gnus-bug-kill-buffer) message-send-actions))
(goto-char (point-min))
(stringp nntp-server-type))
(insert nntp-server-type))
(insert "\n\n\n\n\n")
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *gnus environment info*"))
- (gnus-debug))
- (insert "<#part type=application/x-emacs-lisp buffer=\" *gnus environment info*\" disposition=inline description=\"User settings\"><#/part>")
+ (let (text)
+ (save-excursion
+ (set-buffer (gnus-get-buffer-create " *gnus environment info*"))
+ (erase-buffer)
+ (gnus-debug)
+ (setq text (buffer-string)))
+ (insert "<#part type=application/x-emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
(when (get-buffer "*Gnus Help Bug*")
(kill-buffer "*Gnus Help Bug*")))
+(defun gnus-summary-yank-message (buffer n)
+ "Yank the current article into a composed message."
+ (interactive
+ (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
+ current-prefix-arg))
+ (gnus-summary-iterate n
+ (let ((gnus-display-mime-function nil)
+ (gnus-inhibit-treatment t))
+ (gnus-summary-select-article))
+ (save-excursion
+ (set-buffer buffer)
+ (message-yank-buffer gnus-article-buffer))))
+
(defun gnus-debug ()
"Attempts to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
;;; Gcc handling.
+(defun gnus-inews-group-method (group)
+ (cond ((and (null (gnus-get-info group))
+ (eq (car gnus-message-archive-method)
+ (car
+ (gnus-server-to-method
+ (gnus-group-method group)))))
+ ;; If the group doesn't exist, we assume
+ ;; it's an archive group...
+ gnus-message-archive-method)
+ ;; Use the method.
+ ((gnus-info-method (gnus-get-info group))
+ (gnus-info-method (gnus-get-info group)))
+ ;; Find the method.
+ (t (gnus-group-method group))))
+
;; Do Gcc handling, which copied the message over to some group.
(defun gnus-inews-do-gcc (&optional gcc)
(interactive)
- (when (gnus-alive-p)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
- (cur (current-buffer))
- groups group method)
- (when gcc
- (message-remove-header "gcc")
- (widen)
- (setq groups (message-tokenize-header gcc " ,"))
- ;; Copy the article over to some group(s).
- (while (setq group (pop groups))
- (gnus-check-server
- (setq method
- (cond ((and (null (gnus-get-info group))
- (eq (car gnus-message-archive-method)
- (car
- (gnus-server-to-method
- (gnus-group-method group)))))
- ;; If the group doesn't exist, we assume
- ;; it's an archive group...
- gnus-message-archive-method)
- ;; Use the method.
- ((gnus-info-method (gnus-get-info group))
- (gnus-info-method (gnus-get-info group)))
- ;; Find the method.
- (t (gnus-group-method group)))))
- (gnus-check-server method)
- (unless (gnus-request-group group t method)
- (gnus-request-create-group group method))
- (save-excursion
- (nnheader-set-temp-buffer " *acc*")
- (insert-buffer-substring cur)
- (message-encode-message-body)
- (save-restriction
- (message-narrow-to-headers)
- (mail-encode-encoded-word-buffer))
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (replace-match "" t t ))
- (unless (gnus-request-accept-article group method t t)
- (gnus-message 1 "Couldn't store article in group %s: %s"
- group (gnus-status-message method))
- (sit-for 2))
- (kill-buffer (current-buffer))))))))))
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
+ (cur (current-buffer))
+ groups group method group-art)
+ (when gcc
+ (message-remove-header "gcc")
+ (widen)
+ (setq groups (message-unquote-tokens
+ (message-tokenize-header gcc " ,")))
+ ;; Copy the article over to some group(s).
+ (while (setq group (pop groups))
+ (gnus-check-server
+ (setq method (gnus-inews-group-method group)))
+ (unless (gnus-request-group group nil method)
+ (gnus-request-create-group group method))
+ (save-excursion
+ (nnheader-set-temp-buffer " *acc*")
+ (insert-buffer-substring cur)
+ (message-encode-message-body)
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((mail-parse-charset message-default-charset)
+ (rfc2047-header-encoding-alist
+ (cons '("Newsgroups" . default)
+ rfc2047-header-encoding-alist)))
+ (mail-encode-encoded-word-buffer)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (replace-match "" t t ))
+ (unless (setq group-art
+ (gnus-request-accept-article group method t t))
+ (gnus-message 1 "Couldn't store article in group %s: %s"
+ group (gnus-status-message method))
+ (sit-for 2))
+ (when (and group-art gnus-inews-mark-gcc-as-read)
+ (gnus-group-mark-article-read group (cdr group-art)))
+ (kill-buffer (current-buffer)))))))))
(defun gnus-inews-insert-gcc ()
"Insert Gcc headers based on `gnus-outgoing-message-group'."
(group (or group gnus-newsgroup-name ""))
(gcc-self-val
(and gnus-newsgroup-name
+ (not (equal gnus-newsgroup-name ""))
(gnus-group-find-parameter
gnus-newsgroup-name 'gcc-self)))
result
;; Go through all styles and look for matches.
(dolist (style styles)
(setq match (pop style))
+ (goto-char (point-min))
(when (cond
((stringp match)
;; Regexp string match on the group name.
(string-match match group))
+ ((eq match 'header)
+ (and (gnus-buffer-live-p gnus-article-copy)
+ (with-current-buffer gnus-article-copy
+ (let ((header (message-fetch-field (pop style))))
+ (and header
+ (string-match (pop style) header))))))
((or (symbolp match)
(gnus-functionp match))
(cond
(setq element 'signature
filep t))
;; Get the contents of file elems.
- (when filep
+ (when (and filep v)
(setq v (with-temp-buffer
(insert-file-contents v)
(buffer-string))))
(setq results (delq name (delq address results)))
(make-local-variable 'message-setup-hook)
(dolist (result results)
- (when (cdr result)
- (add-hook 'message-setup-hook
- (cond
- ((eq 'eval (car result))
- 'ignore)
- ((eq 'body (car result))
+ (add-hook 'message-setup-hook
+ (cond
+ ((eq 'eval (car result))
+ 'ignore)
+ ((eq 'body (car result))
+ `(lambda ()
+ (save-excursion
+ (message-goto-body)
+ (insert ,(cdr result)))))
+ ((eq 'signature (car result))
+ (set (make-local-variable 'message-signature) nil)
+ (set (make-local-variable 'message-signature-file) nil)
+ (if (not (cdr result))
+ 'ignore
`(lambda ()
(save-excursion
- (message-goto-body)
- (insert ,(cdr result)))))
- ((eq 'signature (car result))
- (set (make-local-variable 'message-signature) nil)
- (set (make-local-variable 'message-signature-file) nil)
+ (let ((message-signature ,(cdr result)))
+ (when message-signature
+ (message-insert-signature)))))))
+ (t
+ (let ((header
+ (if (symbolp (car result))
+ (capitalize (symbol-name (car result)))
+ (car result))))
`(lambda ()
(save-excursion
- (let ((message-signature ,(cdr result)))
- (message-insert-signature)))))
- (t
- (let ((header
- (if (symbolp (car result))
- (capitalize (symbol-name (car result)))
- (car result))))
- `(lambda ()
- (save-excursion
- (message-remove-header ,header)
- (message-goto-eoh)
- (insert ,header ": " ,(cdr result) "\n")))))))))
+ (message-remove-header ,header)
+ (let ((value ,(cdr result)))
+ (when value
+ (message-goto-eoh)
+ (insert ,header ": " value "\n"))))))))))
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
- (let ((user-full-name ,(or (cdr name) user-full-name))
+ (set (make-local-variable 'user-mail-address)
+ ,(or (cdr address) user-mail-address))
+ (let ((user-full-name ,(or (cdr name) (user-full-name)))
(user-mail-address
,(or (cdr address) user-mail-address)))
(save-excursion
projects / gnus / blobdiff