(require 'gnus)
(require 'sendmail)
(require 'gnus-ems)
+(require 'rmail)
(defvar gnus-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
article in. The default function is `rmail-output' which saves in Unix
mailbox format.")
+(defvar gnus-outgoing-message-group nil
+ "*All outgoing messages will be put in this group.
+If you want to store all your outgoing mail and articles in the group
+\"nnml:archive\", you set this variable to that value. This variable
+can also be a list of group names.
+
+If you want to have greater control over what group to put each
+message in, you can set this variable to a function that checks the
+current newsgroup name and then returns a suitable group name (or list
+of names).")
+
+(defvar gnus-draft-group-directory
+ (expand-file-name
+ (concat (file-name-as-directory gnus-article-save-directory)
+ "drafts"))
+ "*The directory where draft messages will be stored.")
+
(defvar gnus-user-login-name nil
"*The login name of the user.
Got from the function `user-login-name' if undefined.")
'(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader)
"*Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
-Message-ID. Organization, Lines and X-Newsreader are optional. If
-you want Gnus not to insert some header, remove it from this list.")
+Message-ID. Organization, Lines, In-Reply-To and X-Newsreader are
+optional. If you want Gnus not to insert some header, remove it from
+this list.")
+
+(defvar gnus-required-mail-headers
+ '(From Date To Subject In-Reply-To Message-ID Organization Lines)
+ "*Headers to be generated or prompted for when mailing a message.
+RFC822 required that From, Date, To, Subject and Message-ID be
+included. Organization, Lines and X-Mailer are optional.")
(defvar gnus-deletable-headers '(Message-ID Date)
"*Headers to be deleted if they already exists and were generated by Gnus previously.")
(defvar gnus-check-before-posting
'(subject-cmsg multiple-headers sendsys message-id from
long-lines control-chars size new-text
- signature)
+ signature approved sender)
"In non-nil, Gnus will attempt to run some checks on outgoing posts.
If this variable is t, Gnus will check everything it can. If it is a
list, then those elements in that list will be checked.")
(defvar gnus-delete-supersedes-headers
"^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:"
"*Header lines matching this regexp will be deleted before posting.
-It's best to delete old Path and Date headers before posting to avoid
+It's best to delete old Path and Date headers before psoting to avoid
any confusion.")
(defvar gnus-auto-mail-to-author nil
(defvar gnus-inews-article-function 'gnus-inews-article
"*Function to post an article.")
+(defvar gnus-bounced-headers-junk "^\\(Received\\):"
+ "*Regexp that matches headers to be removed in resent bounced mail.")
+
(defvar gnus-inews-article-hook (list 'gnus-inews-do-fcc)
"*A hook called before finally posting an article.
The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves
(defvar gnus-mail-hook nil
"*A hook called as the last thing after setting up a mail buffer.")
+(defvar gnus-message-sent-hook nil
+ "*A hook run after an article has been sent (or attempted sent).")
+
;;; Internal variables.
(defvar gnus-post-news-buffer "*post-news*")
(defvar gnus-summary-send-map nil)
(defvar gnus-article-copy nil)
(defvar gnus-reply-subject nil)
+(defvar gnus-add-to-address nil)
+(defvar gnus-in-reply-to nil)
(eval-and-compile
(autoload 'gnus-uu-post-news "gnus-uu" nil t)
- (autoload 'rmail-output "rmailout"))
+ (autoload 'news-setup "rnewspost")
+ (autoload 'news-reply-mode "rnewspost"))
\f
;;;
(define-key gnus-summary-send-map "r" 'gnus-summary-reply)
(define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original)
(define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window)
+(define-key gnus-summary-send-map "Db" 'gnus-summary-resend-bounced-mail)
+(define-key gnus-summary-send-map "Dc" 'gnus-summary-send-draft)
(define-key gnus-summary-send-map "u" 'gnus-uu-post-news)
(define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward)
(define-key gnus-summary-send-map "op" 'gnus-summary-post-forward)
(defun gnus-group-mail ()
"Start composing a mail."
(interactive)
- (funcall gnus-mail-other-window-method))
+ (gnus-new-mail))
(defun gnus-group-post-news ()
"Post an article."
(if yank-articles (gnus-summary-goto-subject (car yank-articles)))
(save-window-excursion
(gnus-summary-select-article))
- (let ((headers (gnus-get-header-by-number (gnus-summary-article-number)))
+ (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
(gnus-newsgroup-name gnus-newsgroup-name))
;; Check Followup-To: poster.
(set-buffer gnus-article-buffer)
"Begin editing a new USENET news article to be posted.
Type \\[describe-mode] in the buffer to get a list of commands."
(interactive (list t))
- (gnus-copy-article-buffer article-buffer)
- (if (or (not gnus-novice-user)
- gnus-expert-user
- (not (eq 'post
- (nth 1 (assoc
- (format "%s" (car (gnus-find-method-for-group
- gnus-newsgroup-name)))
- gnus-valid-select-methods))))
- (and group
- (assq 'to-address
- (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))))
- (gnus-y-or-n-p "Are you sure you want to post to all of USENET? "))
- (let ((sumart (if (not post)
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (cons (current-buffer) gnus-current-article))))
- (from (and header (mail-header-from header)))
- (winconf (current-window-configuration))
- real-group)
- (and gnus-interactive-post
- (not gnus-expert-user)
- post (not group)
- (progn
- (setq gnus-newsgroup-name
- (setq group
- (completing-read "Group: " gnus-active-hashtb)))
- (or subject
- (setq subject (read-string "Subject: ")))))
- (setq mail-reply-buffer gnus-article-copy)
-
- (let ((newsgroup-name (or group gnus-newsgroup-name "")))
- (setq real-group (and group (gnus-group-real-name group)))
- (setq gnus-post-news-buffer
- (gnus-request-post-buffer
- post real-group subject header gnus-article-copy
- (nth 2 (and group (gnus-gethash group gnus-newsrc-hashtb)))
- (or (cdr (assq 'to-group
- (nth 5 (nth 2 (gnus-gethash
- newsgroup-name
- gnus-newsrc-hashtb)))))
- (if (and (boundp 'gnus-followup-to-function)
- gnus-followup-to-function
- gnus-article-copy)
- (save-excursion
- (set-buffer gnus-article-copy)
- (funcall gnus-followup-to-function group))))
- gnus-use-followup-to))
- (if post
- (gnus-configure-windows 'post 'force)
- (if yank
- (gnus-configure-windows 'followup-yank 'force)
- (gnus-configure-windows 'followup 'force)))
- (gnus-overload-functions)
- (make-local-variable 'gnus-article-reply)
- (make-local-variable 'gnus-article-check-size)
- (make-local-variable 'gnus-reply-subject)
- (setq gnus-reply-subject (and header (mail-header-subject header)))
- (setq gnus-article-reply sumart)
- ;; Handle `gnus-auto-mail-to-author'.
- ;; Suggested by Daniel Quinlan <quinlan@best.com>.
- ;; Revised to respect Reply-To by Ulrik Dickow <dickow@nbi.dk>.
- (let ((to (and (not post)
- (if (if (eq gnus-auto-mail-to-author 'ask)
- (y-or-n-p "Also send mail to author? ")
- gnus-auto-mail-to-author)
- (or (save-excursion
- (set-buffer gnus-article-copy)
- (gnus-fetch-field "reply-to"))
- from)))))
- (if to
- (if (mail-fetch-field "To")
- (progn
- (beginning-of-line)
- (insert "Cc: " to "\n"))
- (mail-position-on-field "To")
- (insert to))))
- ;; Handle author copy using BCC field.
- (if (and gnus-mail-self-blind
- (not (mail-fetch-field "bcc")))
- (progn
- (mail-position-on-field "Bcc")
- (insert (if (stringp gnus-mail-self-blind)
- gnus-mail-self-blind
- (user-login-name)))))
- ;; Handle author copy using FCC field.
- (if gnus-author-copy
- (progn
- (mail-position-on-field "Fcc")
- (insert gnus-author-copy)))
- (goto-char (point-min))
- (if post
- (cond ((not group)
- (re-search-forward "^Newsgroup:" nil t)
- (end-of-line))
- ((not subject)
- (re-search-forward "^Subject:" nil t)
- (end-of-line))
- (t
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (if (not yank)
- ()
- (save-excursion
- (if (not (listp yank))
- (news-reply-yank-original nil)
- (setq yank (reverse yank))
- (while yank
- (save-excursion
- (save-window-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-select-article nil nil nil (car yank))
- (gnus-summary-remove-process-mark (car yank)))
- (let ((mail-reply-buffer gnus-article-copy))
- (gnus-copy-article-buffer)
- (let ((news-reply-yank-message-id
- (save-excursion
- (set-buffer gnus-article-copy)
- (mail-fetch-field "message-id")))
- (news-reply-yank-from
- (save-excursion
- (set-buffer gnus-article-copy)
- (mail-fetch-field "from"))))
- (news-reply-yank-original nil))
- (setq yank (cdr yank)))))))))
- (if gnus-post-prepare-function
- (funcall gnus-post-prepare-function group))
- (run-hooks 'gnus-post-prepare-hook)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf))))
- (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum)))
- (message "")
- t)
+ (let* ((group (or group gnus-newsgroup-name))
+ (to-address
+ (assq 'to-address
+ (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))))
+ (if (and (gnus-member-of-valid 'post (or group gnus-newsgroup-name))
+ (not to-address))
+ (if post
+ (gnus-new-news group)
+ (gnus-news-followup yank group))
+ (if post
+ (progn
+ (gnus-new-mail)
+ ;; Arrange for mail groups that have no `to-address' to
+ ;; get that when the user sends off the mail.
+ (or to-address
+ (progn
+ (make-local-variable 'gnus-add-to-address)
+ (setq gnus-add-to-address group))))
+ (gnus-mail-reply yank (and to-address (cdr to-address)) 'followup)))))
(defun gnus-inews-news (&optional use-group-method)
"Send a news message.
If given a prefix, and the group is a foreign group, this function
will attempt to use the foreign server to post the article."
(interactive "P")
- (or gnus-current-select-method
- (setq gnus-current-select-method gnus-select-method))
(let* ((case-fold-search nil)
(server-running (gnus-server-opened gnus-current-select-method))
(reply gnus-article-reply)
error post-result)
(save-excursion
- ;; Connect to default NNTP server if necessary.
- ;; Suggested by yuki@flab.fujitsu.junet.
(gnus-start-news-server) ;Use default server.
- ;; NNTP server must be opened before current buffer is modified.
(widen)
(goto-char (point-min))
(run-hooks 'news-inews-hook)
- (save-restriction
- (narrow-to-region
- (point-min)
- (progn
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (match-beginning 0)))
-
- ;; Correct newsgroups field: change sequence of spaces to comma and
- ;; eliminate spaces around commas. Eliminate imbedded line breaks.
- (goto-char (point-min))
- (if (re-search-forward "^Newsgroups: +" nil t)
- (save-restriction
- (narrow-to-region
- (point)
- (if (re-search-forward "^[^ \t]" nil t)
- (match-beginning 0)
- (forward-line 1)
- (point)))
- (goto-char (point-min))
- (while (re-search-forward "\n[ \t]+" nil t)
- (replace-match " " t t)) ;No line breaks (too confusing)
- (goto-char (point-min))
- (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
- (replace-match "," t t))
- (goto-char (point-min))
- ;; Remove a trailing comma.
- (if (re-search-forward ",$" nil t)
- (replace-match "" t t))))
-
- ;; Added by Per Abrahamsen <abraham@iesd.auc.dk>.
- ;; Help save the the world!
- (or
- gnus-expert-user
- (let ((newsgroups (mail-fetch-field "newsgroups"))
- (followup-to (mail-fetch-field "followup-to"))
- groups to)
- (if (and newsgroups
- (string-match "," newsgroups) (not followup-to))
- (progn
- (while (string-match "," newsgroups)
- (setq groups
- (cons (list (substring newsgroups
- 0 (match-beginning 0)))
- groups))
- (setq newsgroups (substring newsgroups (match-end 0))))
- (setq groups (nreverse (cons (list newsgroups) groups)))
-
- (setq to
- (completing-read "Followups to: (default all groups) "
- groups))
- (if (> (length to) 0)
- (progn
- (goto-char (point-min))
- (insert "Followup-To: " to "\n")))))))
-
- ;; Cleanup Followup-To.
- (goto-char (point-min))
- (if (search-forward-regexp "^Followup-To: +" nil t)
- (save-restriction
- (narrow-to-region
- (point)
- (if (re-search-forward "^[^ \t]" nil 'end)
- (match-beginning 0)
- (point-max)))
- (goto-char (point-min))
- (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
- (goto-char (point-min))
- (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")))
-
- ;; Mail the message too if To:, Bcc:. or Cc: exists.
- (let* ((types '("to" "bcc" "cc"))
- (ty types)
- fcc-line)
- (while ty
- (or (mail-fetch-field (car ty) nil t)
- (setq types (delete (car ty) types)))
- (setq ty (cdr ty)))
-
- (if (not types)
- ;; We do not want to send mail.
- ()
- (if (not gnus-mail-send-method)
- (progn
- (ding)
- (gnus-message
- 1 "No mailer defined. To: and/or Cc: fields ignored.")
- (sit-for 1))
- (save-excursion
- ;; We want to remove Fcc, because we want to handle
- ;; that one ourselves...
-
- (goto-char (point-min))
- (if (re-search-forward "^Fcc: " nil t)
- (progn
- (setq fcc-line
- (buffer-substring
- (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
- (forward-line -1)
- (gnus-delete-line)))
-
- ;; We generate a Message-ID so that the mail and the
- ;; news copy of the message both get the same ID.
- (or (mail-fetch-field "message-id")
- (not (memq 'Message-ID gnus-required-headers))
- (progn
- (goto-char (point-max))
- (insert "Message-ID: " (gnus-inews-message-id) "\n")))
-
- (save-restriction
- (widen)
- (gnus-message 5 "Sending via mail...")
-
- (if (and gnus-mail-courtesy-message
- (or (member "to" types)
- (member "cc" types)))
- ;; We only want to insert the courtesy mail
- ;; message if we use to or cc; bcc should not
- ;; have one. Well, if both bcc and to are
- ;; present, it will get one anyway.
- (progn
- ;; Insert "courtesy" mail message.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote
- mail-header-separator) "$"))
- (forward-line 1)
- (insert gnus-mail-courtesy-message)
- (funcall gnus-mail-send-method)
- (goto-char (point-min))
- (search-forward gnus-mail-courtesy-message)
- (replace-match "" t t))
- (funcall gnus-mail-send-method))
-
- (gnus-message 5 "Sending via mail...done")
-
- (goto-char (point-min))
- (narrow-to-region
- (point)
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")))
- (goto-char (point-min))
- (delete-matching-lines "^BCC:"))
- (if fcc-line
- (progn
- (goto-char (point-max))
- (insert fcc-line))))))))
;; Send to server.
(gnus-message 5 "Posting to USENET...")
(ding)
(gnus-message 1 "Article rejected: %s"
(gnus-status-message gnus-select-method)))))
- ;; If NNTP server is opened by gnus-inews-news, close it by myself.
- (or server-running
- (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name)))
+
(let ((conf gnus-prev-winconf))
(if (not error)
(progn
;; Restore last window configuration.
(and conf (set-window-configuration conf)))))))
+(defun gnus-inews-narrow-to-headers ()
+ (widen)
+ (narrow-to-region
+ (goto-char (point-min))
+ (or (and (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
+ (match-beginning 0))
+ (point-max))))
+
+(defun gnus-inews-send-mail-copy ()
+ ;; Mail the message if To, Bcc or Cc exists.
+ (let* ((types '("to" "bcc" "cc"))
+ (ty types)
+ (buffer (current-buffer))
+ fcc)
+ (save-restriction
+ (widen)
+ (gnus-inews-narrow-to-headers)
+
+ (while ty
+ (or (mail-fetch-field (car ty) nil t)
+ (setq types (delete (car ty) types)))
+ (setq ty (cdr ty)))
+
+ (if (not types)
+ ;; We do not want to send mail.
+ ()
+ (gnus-message 5 "Sending via mail...")
+ (widen)
+ (save-excursion
+ ;; We copy the article over to a temp buffer since we are
+ ;; going to modify it a little.
+ (nnheader-set-temp-buffer " *Gnus-mailing*")
+ (insert-buffer buffer)
+ ;; We remove Fcc, because we don't want the mailer to see
+ ;; that header.
+ (gnus-inews-narrow-to-headers)
+ (nnheader-remove-header "fcc")
+
+ (widen)
+
+ (if (and gnus-mail-courtesy-message
+ (or (member "to" types)
+ (member "cc" types)))
+ ;; We only want to insert the courtesy mail message if
+ ;; we use To or Cc; Bcc should not have one. Well, if
+ ;; both Bcc and To are present, it will get one
+ ;; anyway.
+ (progn
+ ;; Insert "courtesy" mail message.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
+ (insert gnus-mail-courtesy-message)))
+
+ (gnus-mail-send)
+ (kill-buffer (current-buffer))
+ (gnus-message 5 "Sending via mail...done"))))))
+
+(defun gnus-inews-remove-headers-after-mail ()
+ (save-excursion
+ (save-restriction
+ (gnus-inews-narrow-to-headers)
+ (nnheader-remove-header "bcc"))))
+
(defun gnus-inews-check-post ()
"Check whether the post looks ok."
(or
(gnus-y-or-n-p
(format "Multiple %s headers. Really post? " found))
t))))
- ;; Check for version and sendsys.
+ ;; Check for Version and Sendsys.
(or (gnus-check-before-posting 'sendsys)
(save-excursion
(if (re-search-forward "^Sendsys:\\|^Version:" nil t)
(buffer-substring (match-beginning 0)
(1- (match-end 0)))))
t)))
- ;; Check the Message-Id header.
+ ;; Check for Approved.
+ (or (gnus-check-before-posting 'approved)
+ (save-excursion
+ (if (re-search-forward "^Approved:" nil t)
+ (gnus-y-or-n-p
+ "The article contains an Approved header. Really post? ")
+ t)))
+ ;; Check the Message-ID header.
(or (gnus-check-before-posting 'message-id)
(save-excursion
(let* ((case-fold-search t)
(buffer-disable-undo (current-buffer))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
+ "From: " (gnus-inews-real-user-address) "\n"
"Subject: cancel " message-id "\n"
"Control: cancel " message-id "\n"
(if distribution
(kill-buffer (current-buffer))))))))
\f
-;;; Lowlevel inews interface
+;;; Lowlevel inews interface.
+
+;; Dummy to avoid byte-compile warning.
+(defvar nnspool-rejected-article-hook)
(defun gnus-inews-article (&optional use-group-method)
"Post an article in current buffer using NNTP protocol."
(let ((artbuf (current-buffer))
- (tmpbuf (get-buffer-create " *Gnus-posting*")))
+ gcc result)
(widen)
(goto-char (point-max))
- ;; require a newline at the end for inews to append .signature to
+ ;; Require a newline at the end of the buffer since inews may
+ ;; append a .signature.
(or (= (preceding-char) ?\n)
(insert ?\n))
;; Prepare article headers. All message body such as signature
;; must be inserted before Lines: field is prepared.
(save-restriction
- (goto-char (point-min))
- (narrow-to-region
- (point-min)
- (save-excursion
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (match-beginning 0)))
+ (gnus-inews-narrow-to-headers)
+ ;; Fix some headers.
+ (gnus-inews-cleanup-headers)
+ ;; Remove some headers.
(gnus-inews-remove-headers)
+ ;; Insert some headers.
(gnus-inews-insert-headers)
+ ;; Let the user do all of the above.
(run-hooks 'gnus-inews-article-header-hook)
+ ;; Copy the Gcc header, if any.
+ (setq gcc (mail-fetch-field "gcc"))
(widen))
;; Check whether the article is a good Net Citizen.
(if (and gnus-article-check-size
(not (gnus-inews-check-post)))
;; Aber nein!
'illegal
+ ;; We fudge a hook for nnspool.
+ (setq nnspool-rejected-article-hook
+ (`
+ (list
+ (lambda ()
+ (condition-case ()
+ (save-excursion
+ (set-buffer (, (buffer-name)))
+ (gnus-put-in-draft-group nil 'silent))
+ (error
+ (ding)
+ (gnus-message
+ 1 "Couldn't enter rejected article into draft group")))))))
+
;; Looks ok, so we do the nasty.
(save-excursion
- (set-buffer tmpbuf)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (insert-buffer-substring artbuf)
- ;; Remove the header separator.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (replace-match "" t t)
;; This hook may insert a signature.
(save-excursion
(goto-char (point-min))
(let ((gnus-newsgroup-name (or (mail-fetch-field "newsgroups")
gnus-newsgroup-name)))
(run-hooks 'gnus-prepare-article-hook)))
+ ;; Send off copies using mail, if that is wanted.
+ (gnus-inews-send-mail-copy)
+ ;; Remove more headers.
+ (gnus-inews-remove-headers-after-mail)
+ ;; Copy the article over to a temp buffer.
+ (nnheader-set-temp-buffer " *Gnus-posting*")
+ (insert-buffer-substring artbuf)
+ ;; Remove the header separator.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (replace-match "" t t)
;; Run final inews hooks. This hook may do FCC.
;; The article must be saved before being posted because
;; `gnus-request-post' modifies the buffer.
(run-hooks 'gnus-inews-article-hook)
- ;; Post an article to NNTP server.
- ;; Return NIL if post failed.
- (prog1
- (gnus-request-post
- (if use-group-method
- (gnus-find-method-for-group gnus-newsgroup-name)
- gnus-select-method) use-group-method)
- (kill-buffer (current-buffer)))))))
+ ;; Copy the article over to some group, possibly.
+ (and gcc (gnus-inews-do-gcc gcc))
+ ;; Post the article.
+ (setq result
+ (gnus-request-post
+ (if use-group-method
+ (gnus-find-method-for-group gnus-newsgroup-name)
+ gnus-select-method) use-group-method))
+ (kill-buffer (current-buffer)))
+ (run-hooks 'gnus-message-sent-hook)
+ ;; We remove To and Cc headers to avoid re-mailing if the user
+ ;; accidentally (or purposefully) leans on the `C-c C-c' keys
+ ;; and the news server rejects the posting.
+ (gnus-inews-narrow-to-headers)
+ (nnheader-remove-header "^\\(to\\|[bcf]cc\\|cc\\):" t)
+ (widen)
+ ;; If the posting was unsuccessful (that it, it was rejected) we
+ ;; put it into the draft group.
+ (or result (gnus-put-in-draft-group))
+ result)))
+
+(defun gnus-inews-cleanup-headers ()
+ ;; Correct newsgroups field: change sequence of spaces to comma and
+ ;; eliminate spaces around commas. Eliminate imbedded line breaks.
+ (goto-char (point-min))
+ (if (re-search-forward "^Newsgroups: +" nil t)
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0)
+ (forward-line 1)
+ (point)))
+ (goto-char (point-min))
+ (while (re-search-forward "\n[ \t]+" nil t)
+ (replace-match " " t t)) ;No line breaks (too confusing)
+ (goto-char (point-min))
+ (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
+ (replace-match "," t t))
+ (goto-char (point-min))
+ ;; Remove a trailing comma.
+ (if (re-search-forward ",$" nil t)
+ (replace-match "" t t))))
+
+ ;; Added by Per Abrahamsen <abraham@iesd.auc.dk>.
+ ;; Help save the the world!
+ (or
+ gnus-expert-user
+ (let ((newsgroups (mail-fetch-field "newsgroups"))
+ (followup-to (mail-fetch-field "followup-to"))
+ groups to)
+ (if (and newsgroups
+ (string-match "," newsgroups) (not followup-to))
+ (progn
+ (while (string-match "," newsgroups)
+ (setq groups
+ (cons (list (substring newsgroups 0 (match-beginning 0)))
+ groups))
+ (setq newsgroups (substring newsgroups (match-end 0))))
+ (setq groups (nreverse (cons (list newsgroups) groups)))
+
+ (setq to (completing-read
+ "Followups to: (default all groups) " groups))
+ (if (> (length to) 0)
+ (progn
+ (goto-char (point-min))
+ (insert "Followup-To: " to "\n")))))))
+
+ ;; Cleanup Followup-To.
+ (goto-char (point-min))
+ (if (search-forward-regexp "^Followup-To: +" nil t)
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (if (re-search-forward "^[^ \t]" nil 'end)
+ (match-beginning 0)
+ (point-max)))
+ (goto-char (point-min))
+ (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
+ (goto-char (point-min))
+ (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))))
+
(defun gnus-inews-remove-headers ()
(let ((case-fold-search t)
(progn (forward-line 1) (point))))
(setq headers (cdr headers)))))
-(defun gnus-inews-insert-headers ()
+(defun gnus-inews-insert-headers (&optional headers)
"Prepare article headers.
Headers already prepared in the buffer are not modified.
Headers in `gnus-required-headers' will be generated."
(Path (gnus-inews-path))
(Subject nil)
(Newsgroups nil)
+ (In-Reply-To (gnus-inews-in-reply-yo))
+ (To nil)
(Distribution nil)
(Lines (gnus-inews-lines))
(X-Newsreader gnus-version)
- (headers gnus-required-headers)
+ (X-Mailer gnus-version)
+ (headers (or headers gnus-required-headers))
(case-fold-search t)
header value elem)
;; First we remove any old generated headers.
(let ((from (mail-fetch-field "from"))
(sender (mail-fetch-field "sender")))
(if (and from
+ (not (gnus-check-before-posting 'sender))
(not (string=
(downcase (car (gnus-extract-address-components from)))
(downcase (gnus-inews-real-user-address))))
(forward-line 1)
(int-to-string (count-lines (point) (point-max))))))
+(defun gnus-inews-in-reply-to ()
+ "Return the In-Reply-To header for this message."
+ gnus-in-reply-to)
+
\f
;;;
;;; Gnus Mail Functions
(gnus-set-global-variables)
(if yank-articles (gnus-summary-goto-subject (car yank-articles)))
(gnus-summary-select-article)
- (let ((gnus-newsgroup-name gnus-newsgroup-name))
- (bury-buffer gnus-article-buffer)
- (funcall gnus-mail-reply-method (or yank-articles (not (not yank))))))
+ (bury-buffer gnus-article-buffer)
+ (gnus-mail-reply (or yank-articles (not (not yank)))))
(defun gnus-summary-reply-with-original (n)
"Reply mail to news author with original article.
(gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-copy-article-buffer)
- (let ((gnus-newsgroup-name gnus-newsgroup-name))
- (if post
- (gnus-forward-using-post gnus-article-copy)
- (funcall gnus-mail-forward-method gnus-article-copy))))
+ (if post
+ (gnus-forward-using-post gnus-article-copy)
+ (gnus-mail-forward gnus-article-copy)))
(defun gnus-summary-post-forward ()
"Forward the current article to a newsgroup."
mailer."
(interactive)
(gnus-set-global-variables)
- (let ((gnus-newsgroup-name gnus-newsgroup-name))
- (funcall gnus-mail-other-window-method)))
+ (gnus-new-mail))
+
+(defun gnus-new-mail (&optional to)
+ (pop-to-buffer gnus-mail-buffer)
+ (erase-buffer)
+ (gnus-mail-setup to nil nil nil nil nil))
-(defun gnus-mail-reply-using-mail (&optional yank to-address)
+(defun gnus-mail-reply (&optional yank to-address followup)
(save-excursion
(set-buffer gnus-summary-buffer)
(let ((group (gnus-group-real-name gnus-newsgroup-name))
(cur (cons (current-buffer) (cdr gnus-article-current)))
(winconf (current-window-configuration))
- from subject date reply-to message-of
- references message-id sender follow-to sendto elt)
+ from subject date reply-to message-of to cc
+ references message-id sender follow-to sendto elt new-cc)
(set-buffer (get-buffer-create gnus-mail-buffer))
(mail-mode)
- (make-local-variable 'gnus-article-reply)
- (setq gnus-article-reply cur)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf)
(if (and (buffer-modified-p)
(> (buffer-size) 0)
(not (gnus-y-or-n-p
- "Unsent article being composed; erase it? ")))
+ "Unsent message being composed; erase it? ")))
()
(erase-buffer)
(save-excursion
(save-restriction
(set-buffer gnus-article-copy)
(gnus-narrow-to-headers)
- (if (and (boundp 'gnus-reply-to-function)
- gnus-reply-to-function)
- (setq follow-to (funcall gnus-reply-to-function group)))
+ (if (not followup)
+ ;; This is a regular reply.
+ (if (and (symbolp gnus-reply-to-function)
+ (fboundp gnus-reply-to-function))
+ (setq follow-to (funcall gnus-reply-to-function group)))
+ ;; This is a followup.
+ (if (and (symbolp gnus-followup-to-function)
+ (fboundp gnus-followup-to-function))
+ (save-excursion
+ (setq follow-to
+ (funcall gnus-followup-to-function group)))))
(setq from (mail-fetch-field "from"))
(setq date (or (mail-fetch-field "date")
(mail-header-date gnus-current-headers)))
(concat (if stop-pos (substring from 0 stop-pos) from)
"'s message of " date))))
(setq sender (mail-fetch-field "sender"))
- (setq subject (or (mail-fetch-field "subject")
- "Re: none"))
- (or (string-match "^[Rr][Ee]:" subject)
- (setq subject (concat "Re: " subject)))
+ (setq subject (or (mail-fetch-field "subject") "none"))
+ ;; Remove any (buggy) Re:'s that are present and make a
+ ;; proper one.
+ (and (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject)
+ (setq subject (substring subject (match-end 0))))
+ (setq subject (concat "Re: " subject))
+ (setq to (mail-fetch-field "to"))
+ (setq to (mail-fetch-field "cc"))
(setq reply-to (mail-fetch-field "reply-to"))
(setq references (mail-fetch-field "references"))
(setq message-id (mail-fetch-field "message-id"))
- (widen))
- (setq news-reply-yank-from (or from "(nobody)")))
+
+ (if (not followup)
+ ()
+ ;; When we followup, we want all the headers, I would think.
+ (setq new-cc (rmail-dont-reply-to
+ (concat (or to "")
+ (if cc (concat (if to ", " "") cc) ""))))
+ (let ((rmail-dont-reply-to-names
+ (regexp-quote (mail-strip-quoted-names
+ (or to-address reply-to from "")))))
+ (setq new-cc (rmail-dont-reply-to new-cc))))
+
+ (widen)))
+
+ (setq news-reply-yank-from (or from "(nobody)"))
(setq news-reply-yank-message-id
(or message-id "(unknown Message-ID)"))
(setq sendto (concat sendto (and sendto ", ") (cdr elt)))
(setq follow-to (delq elt follow-to))))
- (mail-setup (or to-address
- (if (and follow-to (not (stringp follow-to))) sendto
- (or follow-to reply-to from sender "")))
- subject message-of nil gnus-article-copy nil)
+ (gnus-mail-setup
+ (or to-address
+ (if (and follow-to (not (stringp follow-to))) sendto
+ (or follow-to reply-to from sender "")))
+ subject nil
+ (if (zerop (length new-cc)) nil new-cc)
+ gnus-article-copy nil)
+
+ (make-local-variable 'gnus-article-reply)
+ (setq gnus-article-reply cur)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq gnus-prev-winconf winconf)
+ (make-local-variable 'gnus-reply-subject)
+ (setq gnus-reply-subject subject)
+ (make-local-variable 'gnus-in-reply-to)
+ (setq gnus-in-reply-to message-of)
(auto-save-mode auto-save-default)
- (use-local-map (copy-keymap mail-mode-map))
- (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
+ (gnus-inews-modify-mail-mode-map)
(if (and follow-to (listp follow-to))
(progn
(insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n")
(setq follow-to (cdr follow-to)))))
(nnheader-insert-references references message-id)
+
+ ;; Now the headers should be ok, so we do the yanking.
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
(gnus-configure-windows 'reply-yank 'force))
(run-hooks 'gnus-mail-hook)))))
+(defun gnus-new-news (&optional group)
+ (let (subject)
+ (and gnus-interactive-post
+ (not gnus-expert-user)
+ (not group)
+ (progn
+ (setq gnus-newsgroup-name
+ (setq group
+ (completing-read "Group: " gnus-active-hashtb)))
+ (setq subject (read-string "Subject: "))))
+ (pop-to-buffer "*post-news*")
+ (erase-buffer)
+ (news-reply-mode)
+ (news-setup nil subject nil group nil)
+ (local-set-key "\C-c\C-c" 'gnus-inews-news)))
+
+(defun gnus-news-followup (&optional yank group)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (if (not (or (not gnus-novice-user)
+ gnus-expert-user
+ (gnus-y-or-n-p
+ "Are you sure you want to post to all of USENET? ")))
+ ()
+ (let ((group (gnus-group-real-name (or group gnus-newsgroup-name)))
+ (cur (cons (current-buffer) (cdr gnus-article-current)))
+ (winconf (current-window-configuration))
+ from subject date reply-to message-of
+ references message-id sender follow-to sendto elt
+ followup-to distribution)
+ (set-buffer (get-buffer-create gnus-mail-buffer))
+ (news-reply-mode)
+ (if (and (buffer-modified-p)
+ (> (buffer-size) 0)
+ (not (gnus-y-or-n-p
+ "Unsent message being composed; erase it? ")))
+ ()
+ (erase-buffer)
+ (save-excursion
+ (gnus-copy-article-buffer)
+ (save-restriction
+ (set-buffer gnus-article-copy)
+ (gnus-narrow-to-headers)
+ (if (and (symbolp gnus-followup-to-function)
+ (fboundp gnus-followup-to-function))
+ (save-excursion
+ (setq follow-to
+ (funcall gnus-followup-to-function group))))
+ (setq from (mail-fetch-field "from"))
+ (setq date (or (mail-fetch-field "date")
+ (mail-header-date gnus-current-headers)))
+ (and from
+ (let ((stop-pos
+ (string-match " *at \\| *@ \\| *(\\| *<" from)))
+ (setq message-of
+ (concat
+ (if stop-pos (substring from 0 stop-pos) from)
+ "'s message of " date))))
+ (setq subject (or (mail-fetch-field "subject") "none"))
+ ;; Remove any (buggy) Re:'s that are present and make a
+ ;; proper one.
+ (and (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject)
+ (setq subject (substring subject (match-end 0))))
+ (setq subject (concat "Re: " subject))
+ (setq references (mail-fetch-field "references"))
+ (setq message-id (mail-fetch-field "message-id"))
+ (setq followup-to (mail-fetch-field "followup-to"))
+ (setq distribution (mail-fetch-field "distribution"))
+ ;; Remove bogus distribution.
+ (and (stringp distribution)
+ (string-match "world" distribution)
+ (setq distribution nil))
+ (widen)))
+
+ (setq news-reply-yank-from (or from "(nobody)"))
+ (setq news-reply-yank-message-id
+ (or message-id "(unknown Message-ID)"))
+
+ ;; Gather the "to" addresses out of the follow-to list and remove
+ ;; them as we go.
+ (if (and follow-to (listp follow-to))
+ (while (setq elt (assoc "Newsgroups" follow-to))
+ (setq sendto (concat sendto (and sendto ", ") (cdr elt)))
+ (setq follow-to (delq elt follow-to))))
+
+ (news-setup nil subject nil
+ (or group sendto
+ (and follow-to
+ gnus-use-followup-to
+ (or (not (eq gnus-use-followup-to 'ask))
+ (gnus-y-or-n-p
+ (format
+ "Use Followup-To %s? " follow-to))))
+ group "")
+ gnus-article-copy)
+
+ (make-local-variable 'gnus-article-reply)
+ (setq gnus-article-reply cur)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq gnus-prev-winconf winconf)
+ (make-local-variable 'gnus-reply-subject)
+ (setq gnus-reply-subject (mail-header-subject gnus-current-headers))
+ (make-local-variable 'gnus-in-reply-to)
+ (setq gnus-in-reply-to message-of)
+
+
+ (auto-save-mode auto-save-default)
+ (gnus-inews-modify-mail-mode-map)
+ (local-set-key "\C-c\C-c" 'gnus-inews-news)
+
+ (if (and follow-to (listp follow-to))
+ (progn
+ (goto-char (point-min))
+ (and (re-search-forward "^Newsgroups:" nil t)
+ (forward-line 1))
+ (while follow-to
+ (insert (car (car follow-to)) ": "
+ (cdr (car follow-to)) "\n")
+ (setq follow-to (cdr follow-to)))))
+
+ ;; If a distribution existed, we use it.
+ (if distribution
+ (progn
+ (mail-position-on-field "Distribution")
+ (insert distribution)))
+
+ (nnheader-insert-references references message-id)
+
+ ;; Handle `gnus-auto-mail-to-author'.
+ ;; Suggested by Daniel Quinlan <quinlan@best.com>.
+ ;; Revised to respect Reply-To by Ulrik Dickow <dickow@nbi.dk>.
+ (let ((to (if (if (eq gnus-auto-mail-to-author 'ask)
+ (y-or-n-p "Also send mail to author? ")
+ gnus-auto-mail-to-author)
+ (or (save-excursion
+ (set-buffer gnus-article-copy)
+ (gnus-fetch-field "reply-to"))
+ from))))
+ (if to
+ (if (mail-fetch-field "To")
+ (progn
+ (beginning-of-line)
+ (insert "Cc: " to "\n"))
+ (mail-position-on-field "To")
+ (insert to))))
+
+ ;; Handle author copy using BCC field.
+ (if (and gnus-mail-self-blind
+ (not (mail-fetch-field "bcc")))
+ (progn
+ (mail-position-on-field "Bcc")
+ (insert (if (stringp gnus-mail-self-blind)
+ gnus-mail-self-blind
+ (user-login-name)))))
+ ;; Handle author copy using FCC field.
+ (if gnus-author-copy
+ (progn
+ (mail-position-on-field "Fcc")
+ (insert gnus-author-copy)))
+
+ ;; Now the headers should be ok, so we do the yanking.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
+ (if (not yank)
+ (gnus-configure-windows 'reply 'force)
+ (let ((last (point))
+ end)
+ (if (not (listp yank))
+ (progn
+ (save-excursion
+ (mail-yank-original nil))
+ (or mail-yank-hooks mail-citation-hook
+ (run-hooks 'news-reply-header-hook)))
+ (while yank
+ (save-window-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-select-article nil nil nil (car yank))
+ (gnus-summary-remove-process-mark (car yank)))
+ (save-excursion
+ (gnus-copy-article-buffer)
+ (mail-yank-original nil)
+ (setq end (point)))
+ (or mail-yank-hooks mail-citation-hook
+ (run-hooks 'news-reply-header-hook))
+ (goto-char end)
+ (setq yank (cdr yank))))
+ (goto-char last))
+ (gnus-configure-windows 'reply-yank 'force))
+
+ (make-local-variable 'gnus-article-check-size)
+ (setq gnus-article-check-size
+ (cons (buffer-size) (gnus-article-checksum))))))))
+
(defun gnus-mail-yank-original ()
(interactive)
(save-excursion
(or mail-yank-hooks mail-citation-hook
(run-hooks 'news-reply-header-hook)))
-(defun gnus-mail-send-and-exit ()
+(defun gnus-mail-send-and-exit (&optional dont-send)
+ "Send the current mail and return to Gnus."
+ (interactive)
+ (let* ((reply gnus-article-reply)
+ (winconf gnus-prev-winconf)
+ (address-group gnus-add-to-address)
+ (to-address (and address-group
+ (mail-fetch-field "to"))))
+ (setq gnus-add-to-address nil)
+ (or dont-send (gnus-mail-send))
+ (bury-buffer)
+ ;; This mail group doesn't have a `to-address', so we add one
+ ;; here. Magic!
+ (and to-address
+ (gnus-group-add-parameter
+ address-group (cons 'to-address to-address)))
+ (if (get-buffer gnus-group-buffer)
+ (progn
+ (if (gnus-buffer-exists-p (car-safe reply))
+ (progn
+ (set-buffer (car reply))
+ (and (cdr reply)
+ (gnus-summary-mark-article-as-replied
+ (cdr reply)))))
+ (and winconf (set-window-configuration winconf))))))
+
+(defun gnus-put-message ()
+ "Put the current message in some group and return to Gnus."
(interactive)
(let ((reply gnus-article-reply)
- (winconf gnus-prev-winconf))
- (mail-send-and-exit nil)
+ (winconf gnus-prev-winconf)
+ (group gnus-newsgroup-name)
+ buf)
+
+ (or (and group (not (gnus-group-read-only-p group)))
+ (setq group (read-string "Put in group: " nil
+ (gnus-writable-groups))))
+ (and (gnus-gethash group gnus-newsrc-hashtb)
+ (error "No such group: %s" group))
+
+ (save-excursion
+ (save-restriction
+ (widen)
+ (gnus-inews-narrow-to-headers)
+ (let (gnus-deletable-headers)
+ (if (eq major-mode 'mail-mode)
+ (gnus-inews-insert-headers gnus-required-mail-headers)
+ (gnus-inews-insert-headers)))
+ (goto-char (point-max))
+ (insert "Gcc: " group "\n")
+ (widen)))
+
+ (gnus-inews-do-gcc)
+
(if (get-buffer gnus-group-buffer)
(progn
(if (gnus-buffer-exists-p (car-safe reply))
(cdr reply)))))
(and winconf (set-window-configuration winconf))))))
+
(defun gnus-forward-make-subject (buffer)
(save-excursion
(set-buffer buffer)
(point) 'invisible)
(point-max))))))
-(defun gnus-mail-forward-using-mail (&optional buffer)
+(defun gnus-mail-forward (&optional buffer)
"Forward the current message to another user using mail."
;; This is almost a carbon copy of rmail-forward in rmail.el.
(let* ((forward-buffer (or buffer (current-buffer)))
(winconf (current-window-configuration))
(subject (gnus-forward-make-subject forward-buffer)))
(set-buffer forward-buffer)
+ (gnus-mail-setup nil subject nil nil nil nil 'forward)
(mail nil nil subject)
- (use-local-map (copy-keymap (current-local-map)))
- (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
+ (gnus-inews-modify-mail-mode-map)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
(gnus-forward-insert-buffer forward-buffer)
"Compose mail other window using mail."
(let ((winconf (current-window-configuration)))
(mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer))
- (use-local-map (copy-keymap (current-local-map)))
- (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
+ (gnus-inews-modify-mail-mode-map)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
(run-hooks 'gnus-mail-hook)
(and address
(progn
(switch-to-buffer gnus-summary-buffer)
- (funcall gnus-mail-reply-method yank address)))))
+ (gnus-mail-reply yank address)))))
(defun gnus-bug ()
"Send a bug report to the Gnus maintainers."
(auto-save-mode auto-save-default)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
- (use-local-map (copy-keymap mail-mode-map))
+ (gnus-inews-modify-mail-mode-map)
(local-set-key "\C-c\C-c" 'gnus-bug-mail-send-and-exit)
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(while (re-search-forward "[\000\200]" nil t)
(replace-match "" t t))))
+
+;;; Treatment of rejected articles.
+
+
+;;; Bounced mail.
+
+(defun gnus-summary-resend-bounced-mail (fetch)
+ "Re-mail the current message.
+This only makes sense if the current message is a bounce message than
+contains some mail you have written which has been bounced back to
+you.
+If FETCH, try to fetch the article that this is a reply to, if indeed
+this is a reply."
+ (interactive "P")
+ (gnus-summary-select-article t)
+ ;; Create a mail buffer.
+ (gnus-new-mail)
+ (erase-buffer)
+ (insert-buffer gnus-article-buffer)
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ ;; We remove everything before the bounced mail.
+ (delete-region
+ (point-min)
+ (if (re-search-forward "[^ \t]*:" nil t)
+ (match-beginning 0)
+ (point)))
+ (let (references)
+ (save-excursion
+ (save-restriction
+ (gnus-narrow-to-headers)
+ (nnheader-remove-header gnus-bounced-headers-junk t)
+ (setq references (mail-fetch-field "references"))
+ (goto-char (point-max))
+ (insert mail-header-separator)))
+ ;; If there are references, we fetch the article we answered to.
+ (and fetch
+ references
+ (string-match "\\(<[^]+>\\)[ \t]*$" references)
+ (gnus-summary-refer-article
+ (substring references (match-beginning 1) (match-end 1)))
+ (progn
+ (gnus-summary-show-all-headers)
+ (gnus-configure-windows 'compose-bounce))))
+ (goto-char (point-min)))
+
+;;; Sending mail.
+
+(defun gnus-mail-send ()
+ "Send the current buffer as mail.
+Headers will be generated before sending."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (gnus-inews-narrow-to-headers)
+ (gnus-inews-insert-headers gnus-required-mail-headers)))
+ (widen)
+ ;; Remove the header separator.
+ (goto-char (point-min))
+ (and (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
+ (replace-match "" t t))
+ ;; Run final inews hooks. This hook may do FCC.
+ (run-hooks 'gnus-inews-article-hook)
+ (gnus-inews-do-gcc)
+ (gnus-narrow-to-headers)
+ (nnheader-remove-header "^[gf]cc:" t)
+ (widen)
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ (mail-send)
+ (run-hooks 'gnus-message-sent-hook))
+
+(defun gnus-inews-modify-mail-mode-map ()
+ (use-local-map (copy-keymap (current-local-map)))
+ (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
+ (local-set-key "\C-c\C-p" 'gnus-put-message)
+ (local-set-key "\C-c\C-d" 'gnus-enter-into-draft-group))
+
+(defun gnus-mail-setup (to subject in-reply-to cc replybuffer actions
+ &optional type)
+ (funcall
+ (cond
+ ((or
+ (and (eq type 'reply)
+ (eq gnus-mail-reply-method 'gnus-mail-reply-using-mhe))
+ (and (eq type 'forward)
+ (eq gnus-mail-forward-method 'gnus-mail-forward-using-mhe))
+ (and (eq type 'new)
+ (eq gnus-mail-other-window-method
+ 'gnus-mail-other-window-using-mhe)))
+ 'gnus-mh-mail-setup)
+ ((or
+ (and (eq type 'reply)
+ (eq gnus-mail-reply-method 'gnus-mail-reply-using-vm))
+ (and (eq type 'forward)
+ (eq gnus-mail-forward-method 'gnus-mail-forward-using-vm))
+ (and (eq type 'new)
+ (eq gnus-mail-other-window-method
+ 'gnus-mail-other-window-using-vm)))
+ 'gnus-vm-mail-setup)
+ (t 'gnus-sendmail-mail-setup))
+ to subject in-reply-to cc replybuffer actions))
+
+(defun gnus-sendmail-mail-setup (to subject in-reply-to cc replybuffer actions)
+ (mail-mode)
+ (mail-setup to subject in-reply-to cc replybuffer actions))
+
+;;; Gcc handling.
+
+;; Do Gcc handling, which copied the message over to some group.
+(defun gnus-inews-do-gcc (&optional gcc)
+ (save-excursion
+ (save-restriction
+ (gnus-narrow-to-headers)
+ (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
+ end)
+ (if (not gcc)
+ () ; Nothing to be done.
+ (nnheader-remove-header "gcc")
+ ;; Copy the article over to some group(s).
+ (while (string-match
+ "^[ \t]*\\([^ \t]+\\)\\([ \t]+\\|$\\)" gcc)
+ (setq end (match-end 0))
+ (condition-case ()
+ (gnus-request-accept-article
+ (substring gcc (match-beginning 1) (match-end 1)) t)
+ (error nil))
+ (setq gcc (substring gcc end))))))))
+
+(defun gnus-inews-insert-gcc ()
+ (let* ((group gnus-outgoing-message-group)
+ (gcc (cond
+ ((and (symbolp group) (fboundp group))
+ (funcall group))
+ ((or (stringp group) (list group))
+ group))))
+ (if (not gcc)
+ () ; Insert no Gcc.
+ (insert "Gcc: "
+ (if (stringp group) group
+ (mapconcat 'identity group " "))
+ "\n"))))
+
+;;; Handling rejected (and postponed) news.
+
+(defun gnus-draft-group ()
+ "Return the name of the draft group."
+ (gnus-group-prefixed-name
+ (file-name-nondirectory gnus-draft-group-directory)
+ (list 'nndir gnus-draft-group-directory)))
+
+(defun gnus-make-draft-group ()
+ "Make the draft group or die trying."
+ (let* ((method (` (nndir "private"
+ (nndir-directory (, gnus-draft-group-directory)))))
+ (group (gnus-group-prefixed-name
+ (file-name-nondirectory gnus-draft-group-directory)
+ method)))
+ (or (gnus-gethash group gnus-newsrc-hashtb)
+ (gnus-group-make-group (gnus-group-real-name group) method)
+ (error "Can't create the draft group"))
+ group))
+
+(defun gnus-enter-into-draft-group ()
+ "Enter the current buffer into the draft group."
+ (interactive)
+ (gnus-put-in-draft-group t))
+
+(defun gnus-put-in-draft-group (&optional generate silent)
+ "Does the actual putting."
+ (let ((group (gnus-make-draft-group))
+ (type (list major-mode (buffer-name) gnus-newsgroup-name
+ (point)))
+ (mode major-mode)
+ (buf (current-buffer)))
+ (widen)
+ (save-excursion
+ (nnheader-set-temp-buffer " *enter-draft*")
+ (insert-buffer buf)
+ (save-restriction
+ (widen)
+ (gnus-inews-narrow-to-headers)
+ (let (gnus-deletable-headers)
+ (if (eq mode 'mail-mode)
+ (gnus-inews-insert-headers gnus-required-mail-headers)
+ (gnus-inews-insert-headers)))
+ (widen))
+
+ (goto-char (point-min))
+ ;; We have to store whether we are in a mail group or news group.
+ (insert (format "X-Gnus-Draft-Type: %S\n" type))
+ (and (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
+ (replace-match "" t t))
+ (if (prog1
+ (gnus-request-accept-article group t)
+ (kill-buffer (current-buffer)))
+ (or silent
+ (gnus-mail-send-and-exit 'dont-send))))
+ (set-buffer-modified-p nil)))
+
+(defun gnus-summary-send-draft ()
+ "Enter a mail/post buffer to edit and send the draft."
+ (interactive)
+ (gnus-set-global-variables)
+ (gnus-summary-select-article t)
+ ;; First we find the draft type.
+ (let (type)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (widen)
+ (gnus-narrow-to-headers)
+ (setq type (condition-case ()
+ (read (mail-fetch-field "x-gnus-draft-type"))
+ (error nil)))
+ (widen))
+ (or type
+ (error "Unknown draft type"))
+ ;; Get to the proper buffer.
+ (set-buffer (get-buffer-create (nth 1 type)))
+ ;; It might be modified.
+ (and (buffer-modified-p)
+ (or (gnus-yes-or-no-p "Unsent message being composed; discard it? ")
+ (error "Break")))
+ (setq buffer-read-only nil)
+ (buffer-enable-undo (current-buffer))
+ (erase-buffer)
+ ;; Set proper mode.
+ (funcall (car type))
+ (and (eq major-mode 'mail-mode)
+ (gnus-inews-modify-mail-mode-map))
+ ;; Arrange for deletion of the draft after successful sending.
+ (make-local-variable 'gnus-message-sent-hook)
+ (setq gnus-message-sent-hook
+ (list
+ (`
+ (lambda ()
+ (gnus-request-expire-articles
+ (, (list (cdr gnus-article-current)))
+ (, gnus-newsgroup-name) t)))))
+ ;; Insert the draft.
+ (insert-buffer gnus-article-buffer)
+ ;; Insert the separator.
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ ;; Remove the draft header.
+ (gnus-inews-narrow-to-headers)
+ (nnheader-remove-header "x-gnus-draft-type")
+ (widen)
+ ;; Configure windows.
+ (let ((gnus-draft-buffer (current-buffer)))
+ (gnus-configure-windows 'draft))
+ ;; Put point where you left it.
+ (goto-char (nth 3 type))))
+
+
+;;; Allow redefinition of functions.
+
(gnus-ems-redefine)
(provide 'gnus-msg)
projects / gnus / blobdiff