method to use when posting."
:group 'gnus-group-foreign
:type `(choice (const nil)
- (const current)
+ (const current)
(const native)
(sexp :tag "Methods" ,gnus-select-method)))
(defvar gnus-last-posting-server nil)
(defvar gnus-message-group-art nil)
+(defvar gnus-msg-force-broken-reply-to nil)
+
(defconst gnus-bug-message
(format "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
+ "V" 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
- "Op" gnus-uu-digest-post-forward)
+ "Om" gnus-summary-digest-mail-forward
+ "Op" gnus-summary-digest-post-forward)
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
(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)
(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)
(gnus-summary-followup (gnus-summary-work-articles arg) t))
(defun gnus-inews-yank-articles (articles)
- (let* ((more-than-one (cdr articles))
- (frame (when (and message-use-multi-frames more-than-one)
- (window-frame (get-buffer-window (current-buffer)))))
- refs beg article)
+ (let ((more-than-one (cdr articles))
+ (cur (current-buffer))
+ refs beg article window)
(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))
- (when frame
- (select-frame frame))
;; Gathering references.
(when more-than-one
(setq refs (message-list-references
refs
(mail-header-references gnus-current-headers)
- (mail-header-message-id gnus-current-headers))))
+ (mail-header-message-id gnus-current-headers)))
+ (when message-use-multi-frames
+ (when (setq window (get-buffer-window cur t))
+ (select-frame (window-frame window)))))
(gnus-copy-article-buffer)
(let ((message-reply-buffer gnus-article-copy)
(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)
(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)))
(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-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 full-headers post)
"Forward the current message to another user.
If FULL-HEADERS (the prefix), include full headers when forwarding."
(if full-headers "" message-included-forward-headers)))
(message-forward post))))
-;;;;; 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 frame)
-;; (gnus-setup-message 'forward
-;; (gnus-summary-select-article)
-;; (if post (message-news nil subject) (message-mail nil subject))
-;; (when (and message-use-multi-frames (cdr articles))
-;; (setq frame (window-frame (get-buffer-window (current-buffer)))))
-;; (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))
-;; (when frame
-;; (select-frame frame))
-;; (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-digest-mail-forward (&optional n post)
+ "Digests and forwards all articles in this series.
+If N is a positive number, forward the N next articles.
+If N is a negative number, forward the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+forward those articles instead.
+Optional POST will use news to forward instead of mail."
+ (interactive "P")
+ (let ((articles (gnus-summary-work-articles n))
+ (topics "Topics:\n")
+ subject article frame)
+ (when (car articles)
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (if (cdr articles)
+ (setq articles (sort articles '<)
+ subject "Digested Articles")
+ (with-current-buffer gnus-original-article-buffer
+ (setq subject (message-make-forward-subject))))
+ (if post
+ (message-news nil subject)
+ (message-mail nil subject))
+ (when (and message-use-multi-frames (cdr articles))
+ (setq frame (window-frame (get-buffer-window (current-buffer)))))
+ (message-goto-body)
+ (while (setq article (pop articles))
+ (save-window-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-select-article nil nil nil article)
+ (setq topics (concat topics " "
+ (mail-header-subject gnus-current-headers)
+ "\n"))
+ (gnus-summary-remove-process-mark article))
+ (when frame
+ (select-frame frame))
+ (insert (mime-make-tag "message" "rfc822") "\n")
+ (narrow-to-region (point) (point))
+ (insert-buffer-substring gnus-original-article-buffer)
+ (save-restriction
+ (article-narrow-to-head)
+ (message-remove-header message-included-forward-headers t nil t))
+ (goto-char (point-max))
+ (widen))
+ (push-mark)
+ (message-goto-body)
+ (insert topics)
+ (message-goto-body)
+ (mime-edit-enclose-digest-region (point)(mark t))))))
+
+(defun gnus-summary-digest-post-forward (&optional n)
+ "Digest and forwards all articles in this series to a newsgroup.
+If N is a positive number, forward the N next articles.
+If N is a negative number, forward the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+forward those articles instead."
+ (interactive "P")
+ (gnus-summary-digest-mail-forward n t))
(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 full-headers)
"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.
;; 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)))
- (coding-system-for-write 'raw-text)
- (output-coding-system 'raw-text)
- 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 message-encoding-buffer)
- (gnus-run-hooks 'gnus-before-do-gcc-hook)
- (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))))))))))
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
+ (coding-system-for-write 'raw-text)
+ (output-coding-system 'raw-text)
+ 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 message-encoding-buffer)
+ (gnus-run-hooks 'gnus-before-do-gcc-hook)
+ (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'."
(when (or name address)
(add-hook 'message-setup-hook
`(lambda ()
- (set (make-local-variable 'user-mail-address)
- ,(or (cdr address) user-mail-address))
+ (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)))
(defun gnus-maybe-setup-default-charset ()
(let ((charset
(and (boundp 'gnus-summary-buffer)
- (buffer-live-p gnus-summary-buffer)
+ (buffer-live-p gnus-summary-buffer)
(save-excursion
(set-buffer gnus-summary-buffer)
default-mime-charset))))
projects / elisp / gnus.git- / blobdiff