(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
+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
(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.
========================================
"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))
(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)
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl) ;; Global value
(set (make-local-variable 'mml-buffer-list) mbl1);; Local value
+ (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
(mml-destroy-buffers)
(setq mml-buffer-list mbl)))
(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 article) "\"\"") ")\n"))))
+ (if article (number-to-string
+ (if (listp article)
+ (car article)
+ article)) "\"\"")
+ ")\n"))))
;;;###autoload
(defun gnus-msg-mail (&optional to subject other-headers continue
(symbol-value (car 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 (if gnus-agent 'gnus-agent-possibly-do-gcc
'gnus-inews-do-gcc) nil t)
(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)
(while (looking-at message-unix-mail-delimiter)
(forward-line 1))
(setq beg (point))
- (setq end (or (search-forward "\n\n" nil t) (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 (search-forward "\n\n" nil t) (point-max)))
+ (or (message-goto-body) (point-max)))
;; Insert the original article headers.
(insert-buffer-substring gnus-original-article-buffer beg end)
(article-decode-encoded-words))))
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)
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))
(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"))))
;;; 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)
(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-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';
(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))))
- (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)))))
+ ((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."
(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 arg)
"Forward the current article to a newsgroup.
(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.
(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>"))
;; 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 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 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)
- (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)
- (let ((active (gnus-active group)))
- (if active
- (if (< (cdr active) (cdr group-art))
- (gnus-set-active group (cons (car active)
- (cdr group-art))))
- (gnus-activate-group group)))
- (let ((buffer (gnus-summary-buffer-name group))
- (mark gnus-read-mark)
- (article (cdr group-art)))
- (unless
- (and
- (get-buffer buffer)
- (with-current-buffer buffer
- (when gnus-newsgroup-prepared
- (when (and gnus-newsgroup-auto-expire
- (memq mark gnus-auto-expirable-marks))
- (setq mark gnus-expirable-mark))
- (setq mark (gnus-request-update-mark
- group article mark))
- (gnus-mark-article-as-read article mark)
- (setq gnus-newsgroup-active (gnus-active group))
- t)))
- (gnus-group-make-articles-read group
- (list article))
- (when (gnus-group-auto-expirable-p group)
- (gnus-add-marked-articles
- group 'expire (list article))))))
- (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'."
;; Regexp string match on the group name.
(string-match match group))
((eq match 'header)
- (let ((header (message-fetch-field (pop style))))
- (and header
- (string-match (pop style) 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
projects / gnus / blobdiff