(require 'gnus)
(require 'sendmail)
+(require 'gnus-ems)
+(eval-when-compile (require 'cl))
(defvar gnus-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
+(defvar gnus-prepare-article-hook nil
+ "*A hook called after preparing body, but before preparing header headers.")
+
(defvar gnus-post-prepare-function nil
"*Function that is run after a post buffer has been prepared.
It is called with the name of the newsgroup that is posted to. It
If you want to insert the signature, you might put
`gnus-inews-insert-signature' in this hook.")
-(defvar gnus-use-followup-to 'use
+(defvar gnus-use-followup-to t
"*Specifies what to do with Followup-To header.
If nil, ignore the header. If it is t, use its value, but ignore
-`poster'. If it is neither nil nor t, which is the default, always use
-the value.")
+`poster'. If it is the symbol `ask', query the user before posting.
+If it is the symbol `use', always use the value.")
(defvar gnus-followup-to-function nil
"*A variable that contains a function that returns a followup address.
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-mailing-list-groups nil
+ "*Regexp matching groups that are really mailing lists.
+This is useful when you're reading a mailing list that has been
+gatewayed to a newsgroup, and you want to followup to an article in
+the group.")
+
+(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-posting-styles nil
+ "*Alist of styles to use when posting.")
+
+(defvar gnus-posting-style-alist
+ '((organization . gnus-organization-file)
+ (signature . gnus-signature-file)
+ (from . gnus-user-from-line)))
+
(defvar gnus-user-login-name nil
"*The login name of the user.
Got from the function `user-login-name' if undefined.")
If the function returns nil, the `gnus-signature-file' variable will
be used instead.")
+(defvar gnus-forward-start-separator
+ "------- Start of forwarded message -------\n"
+ "*Delimiter inserted before forwarded messages.")
+
+(defvar gnus-forward-end-separator
+ "------- End of forwarded message -------\n"
+ "*Delimiter inserted after forwarded messages.")
+
+(defvar gnus-signature-before-forwarded-message t
+ "*If non-nil, put the signature before any included forwarded message.")
+
(defvar gnus-required-headers
'(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, Expires, 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 (optional . 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-removable-headers '(NNTP-Posting-Host Bcc Xref)
+ "*Headers to be removed unconditionally before posting.")
+
+(defvar gnus-article-expires 14
+ "*Number of days before your article expires.
+This variable isn't used unless you have the `Expires' element in
+`gnus-required-headers'.")
+
+(defvar gnus-distribution-function nil
+ "*Function that should return the Distribution header for outgoing articles.
+It will be called from the buffer where the outgoing article
+is being prepared with the group name as the only parameter.
+It should return a valid distribution.
-(defvar gnus-deletable-headers '(Message-ID)
- "*Headers to be deleted if they already exists.")
+The function will only be called if you have the `Distribution' header in
+`gnus-required-headers'.")
(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:"
+(defvar gnus-delete-supersedes-headers
+ "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:\\|^Xref:\\|^Lines:"
"*Header lines matching this regexp will be deleted before posting.
-It's best to delete old Path and Date headers before psoting to avoid
+It's best to delete old Path and Date headers before posting to avoid
any confusion.")
(defvar gnus-auto-mail-to-author nil
"*If non-nil, mail the authors of articles a copy of your follow-ups.
If this variable is `ask', the user will be prompted for whether to
mail a copy. The string given by `gnus-mail-courtesy-message' will be
-inserted at the beginning of the mail copy.
-
-Mail is sent using the function specified by the
-`gnus-mail-send-method' variable.")
+inserted at the beginning of the mail copy.")
;; Added by Ethan Bradford <ethanb@ptolemy.astro.washington.edu>.
(defvar gnus-mail-courtesy-message
(sendmail); `gnus-mail-other-window-using-mhe' (MH-E); and
`gnus-mail-other-window-using-vm'.")
-(defvar gnus-mail-send-method send-mail-function
- "*Function to mail a message which is also being posted as an article.
-The message must have To or Cc header. The default is copied from
-the variable `send-mail-function'.")
-
(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-mail-buffer "*mail*")
(defvar gnus-summary-send-map nil)
+(defvar gnus-send-bounce-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 'news-setup "rnewspost")
+ (autoload 'news-reply-mode "rnewspost")
+ (autoload 'rmail-output "rmailout"))
\f
;;;
(define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward)
(define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward)
+(define-prefix-command 'gnus-send-bounce-map)
+(define-key gnus-summary-send-map "D" 'gnus-send-bounce-map)
+(define-key gnus-send-bounce-map "b" 'gnus-summary-resend-bounced-mail)
+(define-key gnus-send-bounce-map "c" 'gnus-summary-send-draft)
+(define-key gnus-send-bounce-map "r" 'gnus-summary-resend-message)
+
;;; Internal functions.
(defun gnus-number-base36 (num len)
(defun gnus-group-mail ()
"Start composing a mail."
(interactive)
- (funcall gnus-mail-other-window-method)
- (gnus-configure-windows 'group-mail)
- (run-hooks 'gnus-mail-hook))
-
-(defun gnus-group-post-news ()
- "Post an article."
- (interactive)
- (let ((gnus-newsgroup-name nil))
- (gnus-post-news 'post nil nil gnus-article-buffer)))
+ (gnus-new-mail
+ ;; We might want to prompt here.
+ (when (and gnus-interactive-post
+ (not gnus-expert-user))
+ (read-string "To: "))))
+
+(defun gnus-group-post-news (&optional arg)
+ "Post an article.
+The newsgroup under the cursor is used as the group to post to.
+
+If you wish to get an empty post buffer, use a prefix ARG. You can
+also do this by calling this function from the bottom of the Group
+buffer."
+ (interactive "P")
+ (let ((gnus-newsgroup-name nil)
+ (group (unless arg (gnus-group-group-name)))
+ subject)
+ ;; We might want to prompt here.
+ (when (and gnus-interactive-post
+ (not gnus-expert-user))
+ (setq gnus-newsgroup-name
+ (setq group
+ (completing-read "Group: " gnus-active-hashtb nil nil
+ (cons (or group "") 0)))))
+ (gnus-post-news 'post group nil gnus-article-buffer)))
(defun gnus-summary-post-news ()
"Post an article."
(gnus-set-global-variables)
(if yank-articles (gnus-summary-goto-subject (car yank-articles)))
(save-window-excursion
- (gnus-summary-select-article t))
- (let ((headers gnus-current-headers)
+ (gnus-summary-select-article))
+ (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)
(if (and gnus-use-followup-to
(string-equal "poster" (gnus-fetch-field "followup-to"))
- (or (not (eq gnus-use-followup-to t))
+ (or (not (memq gnus-use-followup-to '(t ask)))
(not (gnus-y-or-n-p
"Do you want to ignore `Followup-To: poster'? "))))
- ;; Mail to the poster. Gnus is now RFC1036 compliant.
+ ;; Mail to the poster.
(gnus-summary-reply yank)
+ ;; Send a followup.
(gnus-post-news nil gnus-newsgroup-name
headers gnus-article-buffer
- (or yank-articles (not (not yank))))))
- (gnus-article-hide-headers-if-wanted))
+ (or yank-articles (not (not yank)))))))
(defun gnus-summary-followup-with-original (n)
"Compose a followup to an article and include the original article."
"Compose a followup and do an auto mail to author."
(interactive "P")
(gnus-set-global-variables)
- (let ((gnus-auto-mail-to-author t))
+ (let ((gnus-auto-mail-to-author 'force))
(gnus-summary-followup yank yank-articles)))
(defun gnus-summary-followup-and-reply-with-original (n)
"Cancel an article you posted."
(interactive "P")
(gnus-set-global-variables)
- (let ((articles (gnus-summary-work-articles n)))
- (while articles
- (gnus-summary-select-article t nil nil (car articles))
- (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))
- (gnus-summary-remove-process-mark (car articles))
- (gnus-summary-mark-as-read (car articles) gnus-canceled-mark)
- (gnus-article-hide-headers-if-wanted)
- (setq articles (cdr articles)))))
+ (let ((articles (gnus-summary-work-articles n))
+ article)
+ (while (setq article (pop articles))
+ (when (gnus-summary-select-article t nil nil article)
+ (when (gnus-eval-in-buffer-window
+ gnus-original-article-buffer (gnus-cancel-news))
+ (gnus-summary-mark-as-read article gnus-canceled-mark))
+ (gnus-article-hide-headers-if-wanted))
+ (gnus-summary-remove-process-mark article))))
(defun gnus-summary-supersede-article ()
"Compose an article that will supersede a previous article.
(interactive)
(gnus-set-global-variables)
(gnus-summary-select-article t)
- (if (or
- (string-equal
- (downcase (mail-strip-quoted-names
- (header-from gnus-current-headers)))
- (downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
- (error "This article is not yours."))
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (if (not (re-search-backward "^Message-ID: " nil t))
- (error "No Message-ID in this article"))))
- (if (gnus-post-news 'post gnus-newsgroup-name)
- (progn
- (erase-buffer)
- (insert-buffer gnus-article-buffer)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (if (not (re-search-backward "^Message-ID: " nil t))
- (error "No Message-ID in this article")
- (replace-match "Supersedes: " t t))
- (search-forward "\n\n")
- (forward-line -1)
- (insert mail-header-separator)
-
- (forward-line -1)
- (narrow-to-region (point-min) (point))
- (goto-char (point-min))
- (and gnus-delete-supersedes-headers
- (delete-matching-lines gnus-delete-supersedes-headers))
- (widen))))
+ ;; Check whether the user owns the article that is to be superseded.
+ (unless (string-equal
+ (downcase (mail-strip-quoted-names
+ (mail-header-from gnus-current-headers)))
+ (downcase (mail-strip-quoted-names (gnus-inews-user-name))))
+ (error "This article is not yours."))
+ ;; Get a normal *post-news* buffer.
+ (gnus-new-news gnus-newsgroup-name t)
+ (erase-buffer)
+ (insert-buffer-substring gnus-original-article-buffer)
+ (gnus-narrow-to-headers)
+ ;; Remove unwanted headers.
+ (when gnus-delete-supersedes-headers
+ (nnheader-remove-header gnus-delete-supersedes-headers t))
+ (goto-char (point-min))
+ (if (not (re-search-forward "^Message-ID: " nil t))
+ (error "No Message-ID in this article")
+ (replace-match "Supersedes: " t t))
+ (goto-char (point-max))
+ (insert mail-header-separator)
+ (widen)
+ (forward-line 1))
\f
;;;###autoload
"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 (header-from header)))
- (winconf (current-window-configuration))
- follow-to real-group)
- (and gnus-interactive-post
- (not gnus-expert-user)
- post (not group)
- (progn
- (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)
- (setq follow-to
- (save-excursion
- (set-buffer gnus-article-copy)
- (funcall gnus-followup-to-function group)))))
- gnus-use-followup-to))
- (if post
- (gnus-configure-windows 'post)
- (if yank
- (gnus-configure-windows 'followup-yank)
- (gnus-configure-windows 'followup)))
- (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 (header-subject header)))
- (setq gnus-article-reply sumart)
- ;; Handle `gnus-auto-mail-to-author'.
- ;; Suggested by Daniel Quinlan <quinlan@best.com>.
- (let ((to (and (not post)
- (if (eq gnus-auto-mail-to-author 'ask)
- (and (y-or-n-p "Also send mail to author? ") from)
- (and gnus-auto-mail-to-author from)))))
- (if to
- (progn
- (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)
- (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)))
- (let ((mail-reply-buffer gnus-article-copy))
- (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))
+ (pgroup group)
+ to-address to-group mailing-list to-list)
+ (when group
+ (setq to-address (gnus-group-get-parameter group 'to-address)
+ to-group (gnus-group-get-parameter group 'to-group)
+ to-list (gnus-group-get-parameter group 'to-list)
+ mailing-list (when gnus-mailing-list-groups
+ (string-match gnus-mailing-list-groups group))
+ group (gnus-group-real-name group)))
+ (if (or to-group
+ (and (gnus-news-group-p
+ (or pgroup gnus-newsgroup-name)
+ (if header (mail-header-number header) gnus-current-article))
+ (not mailing-list)
+ (not to-list)
+ (not to-address)))
+ ;; This is news.
+ (if post
+ (gnus-new-news (or to-group group))
+ (gnus-news-followup yank (or to-group group)))
+ ;; The is mail.
+ (if post
+ (progn
+ (gnus-new-mail (or to-address to-list))
+ ;; Arrange for mail groups that have no `to-address' to
+ ;; get that when the user sends off the mail.
+ (unless to-address
+ (make-local-variable 'gnus-add-to-address)
+ (setq gnus-add-to-address group)))
+ (gnus-mail-reply yank to-address 'followup)))))
+
+(defun gnus-news-group-p (group &optional article)
+ "Return non-nil if GROUP (and ARTICLE) come from a news server."
+ (or (gnus-member-of-valid 'post group) ; Ordinary news group.
+ (and (gnus-member-of-valid 'post-mail group) ; Combined group.
+ (eq (gnus-request-type group article) 'news))))
+
(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-select-method))
- (reply gnus-article-reply))
+ (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 (search-forward-regexp "^Newsgroups: +" 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]+" ",")))
-
- ;; 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 (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")
- (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...")
- (if (funcall gnus-inews-article-function use-group-method)
- (progn
- (gnus-message 5 "Posting to USENET...done")
- (if (gnus-buffer-exists-p (car-safe reply))
- (progn
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-mark-article-as-replied
- (cdr reply))))))
- ;; We cannot signal an error.
- (ding) (gnus-message 1 "Article rejected: %s"
- (gnus-status-message gnus-select-method)))
- (set-buffer-modified-p nil))
- ;; 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)))
+ (setq post-result (funcall gnus-inews-article-function use-group-method))
+ (cond ((eq post-result 'illegal)
+ (setq error t)
+ (ding))
+ (post-result
+ (gnus-message 5 "Posting to USENET...done")
+ (if (gnus-buffer-exists-p (car-safe reply))
+ (progn
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-mark-article-as-replied
+ (cdr reply)))))
+ (set-buffer-modified-p nil))
+ (t
+ ;; We cannot signal an error.
+ (setq error t)
+ (ding)
+ (gnus-message
+ 1 "Article rejected: %s"
+ (gnus-status-message
+ (gnus-post-method gnus-newsgroup-name use-group-method))))))
+
(let ((conf gnus-prev-winconf))
- (bury-buffer)
- ;; Restore last window configuration.
- (and conf (set-window-configuration conf)))))
+ (unless error
+ (bury-buffer)
+ ;; 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-substring buffer)
+ ;; We remove Fcc, because we don't want the mailer to see
+ ;; that header.
+ (gnus-inews-narrow-to-headers)
+ (nnheader-remove-header "fcc")
+
+ ;; Insert the X-Courtesy-Message header.
+ (and (or (member "to" types)
+ (member "cc" types))
+ (progn
+ (goto-char (point-max))
+ (insert "Posted-To: "
+ (mail-fetch-field "newsgroups") "\n")))
+
+ (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
+ (let ((case-fold-search t))
+ (gnus-inews-narrow-to-headers)
+ ;; Remove Bcc completely.
+ (nnheader-remove-header "bcc")
+ ;; We transform 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.
+ (while (re-search-forward "^\\(to\\|[bcf]cc\\|cc\\):" nil t)
+ (beginning-of-line)
+ (insert "X-"))
+ (widen)))))
+
+(defun gnus-inews-dex-headers ()
+ "Remove \"X-\" prefixes from To and Cc headers."
+ (save-excursion
+ (save-restriction
+ (let ((case-fold-search t))
+ (gnus-narrow-to-headers)
+ (while (re-search-forward "^X-\\(to\\|[bcf]cc\\|cc\\):" nil t)
+ (beginning-of-line)
+ (delete-char 2))
+ (widen)))))
+
+(defun gnus-inews-remove-empty-headers ()
+ "Remove empty headers from news and mail.
+The buffer should be narrowed to the headers before this function is
+called."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^[^ \t:]+:\\([ \t]*\n\\)+[^ \t]" nil t)
+ (delete-region (match-beginning 0) (1- (match-end 0)))
+ (beginning-of-line))))
(defun gnus-inews-check-post ()
"Check whether the post looks ok."
(goto-char (point-min))
(narrow-to-region
(point)
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")))
+ (progn
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (match-beginning 0)))
(goto-char (point-min))
(and
;; Check for commands in Subject.
- (or (gnus-check-before-posting 'subject-cmsg)
- (save-excursion
- (if (string-match "^cmsg " (mail-fetch-field "subject"))
- (gnus-y-or-n-p
- "The control code \"cmsg \" is in the subject. Really post? ")
- t)))
+ (or
+ (gnus-check-before-posting 'subject-cmsg)
+ (save-excursion
+ (if (string-match "^cmsg " (mail-fetch-field "subject"))
+ (gnus-y-or-n-p
+ "The control code \"cmsg \" is in the subject. Really post? ")
+ t)))
;; Check for multiple identical headers.
(or (gnus-check-before-posting 'multiple-headers)
(save-excursion
(let (found)
- (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t))
+ (while (and (not found) (re-search-forward "^[^ \t:]+: "
+ nil t))
(save-excursion
(or (re-search-forward
(concat "^" (setq found
(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)
- (gnus-yes-or-no-p
+ (gnus-y-or-n-p
(format "The article contains a %s command. Really post? "
(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)
(or (not message-id)
(and (string-match "@" message-id)
(string-match "@[^\\.]*\\." message-id))
- (gnus-yes-or-no-p
+ (gnus-y-or-n-p
(format
"The Message-ID looks strange: \"%s\". Really post? "
message-id))))))
(save-excursion
(let* ((case-fold-search t)
(from (mail-fetch-field "from")))
- (or (not from)
- (and (string-match "@" from)
- (string-match "@[^\\.]*\\." from))
- (gnus-yes-or-no-p
- (format "The From looks strange: \"%s\". Really post? "
- from)))))))))
+ (cond
+ ((not from)
+ (gnus-y-or-n-p "There is no From line. Really post? "))
+ ((not (string-match "@[^\\.]*\\." from))
+ (gnus-y-or-n-p
+ (format
+ "The address looks strange: \"%s\". Really post? " from)))
+ ((string-match "(.*).*(.*)" from)
+ (gnus-y-or-n-p
+ (format
+ "The From header looks strange: \"%s\". Really post? "
+ from)))
+ ((string-match "<[^>]+> *$" from)
+ (let ((name (substring from 0 (match-beginning 0))))
+ (or
+ (string-match "^ *\"[^\"]*\" *$" name)
+ (not (string-match "[][.!()<>@,;:\\]" name))
+ (gnus-y-or-n-p
+ (format
+ "The From header name has bogus characters. Really post? "
+ from)))))
+ (t t)))))
+ )))
;; Check for long lines.
(or (gnus-check-before-posting 'long-lines)
(save-excursion
(zerop (forward-line 1))))
(or (bolp)
(eobp)
- (gnus-yes-or-no-p
+ (gnus-y-or-n-p
(format
"You have lines longer than 79 characters. Really post? ")))))
;; Check for control characters.
t))
;; Use the (size . checksum) variable to see whether the
;; article is empty or has only quoted text.
- (or (gnus-check-before-posting 'new-text)
- (if (and (= (buffer-size) (car gnus-article-check-size))
- (= (gnus-article-checksum) (cdr gnus-article-check-size)))
- (gnus-yes-or-no-p
- "It looks like there's no new text in your article. Really post? ")
- t))
+ (or
+ (gnus-check-before-posting 'new-text)
+ (if (and (= (buffer-size) (car gnus-article-check-size))
+ (= (gnus-article-checksum) (cdr gnus-article-check-size)))
+ (gnus-y-or-n-p
+ "It looks like there's no new text in your article. Really post? ")
+ t))
;; Check the length of the signature.
(or (gnus-check-before-posting 'signature)
(progn
(goto-char (point-max))
(if (not (re-search-backward gnus-signature-separator nil t))
t
- (if (> (count-lines (point) (point-max)) 4)
+ (if (> (count-lines (point) (point-max)) 5)
(gnus-y-or-n-p
(format
- "Your .sig is %d lines; it should be max 4. Really post? "))
+ "Your .sig is %d lines; it should be max 4. Really post? "
+ (count-lines (point) (point-max))))
t)))))))
(defun gnus-article-checksum ()
;; Returns non-nil if this type is not to be checked.
(defun gnus-check-before-posting (type)
- (or (not gnus-check-before-posting)
- (if (listp gnus-check-before-posting)
- (memq type gnus-check-before-posting)
- t)))
+ (not
+ (or (not gnus-check-before-posting)
+ (if (listp gnus-check-before-posting)
+ (memq type gnus-check-before-posting)
+ t))))
(defun gnus-cancel-news ()
"Cancel an article you posted."
(newsgroups nil)
(message-id nil)
(distribution nil))
- (or (gnus-member-of-valid 'post gnus-newsgroup-name)
- (error "This backend does not support cancelling"))
+ (or (gnus-news-group-p gnus-newsgroup-name)
+ (error "This backend does not support canceling"))
(save-excursion
;; Get header info. from original article.
(save-restriction
(downcase (mail-strip-quoted-names from))
(downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
(progn
- (ding) (gnus-message 3 "This article is not yours."))
+ (ding) (gnus-message 3 "This article is not yours.")
+ nil)
;; Make control article.
(set-buffer (get-buffer-create " *Gnus-canceling*"))
(buffer-disable-undo (current-buffer))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
+ "From: " (gnus-inews-user-name) "\n"
"Subject: cancel " message-id "\n"
"Control: cancel " message-id "\n"
+ (if distribution
+ (concat "Distribution: " distribution "\n")
+ "")
mail-header-separator "\n"
"This is a cancel message from " from ".\n")
;; Send the control article to NNTP server.
(gnus-message 5 "Canceling your article...")
- (if (funcall gnus-inews-article-function)
- (gnus-message 5 "Canceling your article...done")
- (ding)
- (gnus-message 1 "Cancel failed; %s"
- (gnus-status-message gnus-newsgroup-name)))
- ;; Kill the article buffer.
- (kill-buffer (current-buffer)))))))
+ (prog1
+ (if (funcall gnus-inews-article-function)
+ (gnus-message 5 "Canceling your article...done")
+ (progn
+ (ding)
+ (gnus-message 1 "Cancel failed; %s"
+ (gnus-status-message gnus-newsgroup-name))
+ nil)
+ t)
+ ;; Kill the article buffer.
+ (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)
- (run-hooks gnus-inews-article-header-hook)
+ ;; 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)
+ ;; 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)
- ;; This hook may insert a signature.
- (run-hooks 'gnus-prepare-article-hook)
+ ;; Remove X- prefixes to headers.
+ (gnus-inews-dex-headers)
;; 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.
+ (let ((method (gnus-post-method gnus-newsgroup-name use-group-method)))
+ (setq result (gnus-request-post method)))
+ (kill-buffer (current-buffer)))
+ (run-hooks 'gnus-message-sent-hook)
+ ;; 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))
- ;; Remove NNTP-posting-host.
- (goto-char (point-min))
- (and (re-search-forward "^nntp-posting-host:" nil t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
- ;; Remove Bcc.
- (goto-char (point-min))
- (and (re-search-forward "^bcc:" nil t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))))
-
-(defun gnus-inews-insert-headers ()
+ (let ((case-fold-search t)
+ (headers gnus-removable-headers))
+ ;; Remove toxic headers.
+ (while headers
+ (goto-char (point-min))
+ (and (re-search-forward
+ (concat "^" (downcase (format "%s" (car headers))))
+ nil t)
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
+ (setq headers (cdr headers)))))
+
+;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might
+;;; as well include the Emacs version as well.
+;;; The following function works with later GNU Emacs, and XEmacs.
+(defun gnus-extended-version ()
+ "Stringified Gnus version and Emacs version"
+ (interactive)
+ (concat
+ gnus-version
+ "/"
+ (cond
+ ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
+ (concat "Emacs " (substring emacs-version
+ (match-beginning 1)
+ (match-end 1))))
+ ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)" emacs-version)
+ (concat (substring emacs-version
+ (match-beginning 1)
+ (match-end 1))
+ (format " %d.%d" emacs-major-version emacs-minor-version)))
+ (t emacs-version))))
+
+(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."
- (let ((Date (gnus-inews-date))
- (Message-ID (gnus-inews-message-id))
- (Organization (gnus-inews-organization))
- (From (gnus-inews-user-name))
- (Path (gnus-inews-path))
- (Subject nil)
- (Newsgroups nil)
- (Distribution nil)
- (Lines (gnus-inews-lines))
- (X-Newsreader gnus-version)
- (headers gnus-required-headers)
- (case-fold-search t)
- header value elem)
+ (let* ((Date (gnus-inews-date))
+ (Message-ID (gnus-inews-message-id))
+ (Organization (gnus-inews-organization))
+ (From (gnus-inews-user-name))
+ (Path (gnus-inews-path))
+ (Subject nil)
+ (Newsgroups nil)
+ (In-Reply-To (gnus-inews-in-reply-to))
+ (To nil)
+ (Distribution (gnus-inews-distribution))
+ (Lines (gnus-inews-lines))
+ (X-Newsreader (gnus-extended-version))
+ (X-Mailer X-Newsreader)
+ (Expires (gnus-inews-expires))
+ (headers (or headers gnus-required-headers))
+ (case-fold-search t)
+ header value elem)
;; First we remove any old generated headers.
(let ((headers gnus-deletable-headers))
(while headers
(goto-char (point-min))
(and (re-search-forward
(concat "^" (symbol-name (car headers)) ": *") nil t)
- (get-text-property (1+ (match-end 0)) 'gnus-deletable)
+ (get-text-property (1+ (match-beginning 0)) 'gnus-deletable)
(gnus-delete-line))
(setq headers (cdr headers))))
- ;; Insert new Sender if the From is strange.
- (let ((from (mail-fetch-field "from")))
- (if (and from (not (string= (downcase from) (downcase From))))
- (progn
- (goto-char (point-min))
- (and (re-search-forward "^Sender:" nil t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
- (insert "Sender: " From "\n"))))
;; If there are References, and no "Re: ", then the thread has
;; changed name. See Son-of-1036.
(if (and (mail-fetch-field "references")
;; Distribution.
(while headers
(goto-char (point-min))
- (setq elem (car headers))
+ (setq elem (pop headers))
(if (consp elem)
(setq header (car elem))
(setq header elem))
- (if (or (not (re-search-forward
- (concat "^" (downcase (symbol-name header)) ":") nil t))
- (progn
- (if (= (following-char) ? ) (forward-char 1) (insert " "))
- (looking-at "[ \t]*$")))
- (progn
- (setq value
- (or (if (consp elem)
- ;; The element is a cons. Either the cdr is
- ;; a string to be inserted verbatim, or it
- ;; is a function, and we insert the value
- ;; returned from this function.
- (or (and (stringp (cdr elem)) (cdr elem))
- (and (fboundp (cdr elem)) (funcall (cdr elem))))
- ;; The element is a symbol. We insert the
- ;; value of this symbol, if any.
- (and (boundp header) (symbol-value header)))
- ;; We couldn't generate a value for this header,
- ;; so we just ask the user.
- (read-from-minibuffer
- (format "Empty header for %s; enter value: " header))))
- ;; Add the deletable property to the headers that require it.
- (and (memq header gnus-deletable-headers)
- (add-text-properties
- 0 (length value) '(gnus-deletable t) value))
- ;; Finally insert the header.
+ (when (or (not (re-search-forward
+ (concat "^" (downcase (symbol-name header)) ":") nil t))
+ (progn
+ ;; The header was found. We insert a space after the
+ ;; colon, if there is none.
+ (if (/= (following-char) ? ) (insert " "))
+ ;; Find out whether the header is empty...
+ (looking-at "[ \t]*$")))
+ ;; So we find out what value we should insert.
+ (setq value
+ (cond
+ ((and (consp elem) (eq (car elem) 'optional))
+ ;; This is an optional header. If the cdr of this
+ ;; is something that is nil, then we do not insert
+ ;; this header.
+ (setq header (cdr elem))
+ (or (and (fboundp (cdr elem)) (funcall (cdr elem)))
+ (and (boundp (cdr elem)) (symbol-value (cdr elem)))))
+ ((consp elem)
+ ;; The element is a cons. Either the cdr is a
+ ;; string to be inserted verbatim, or it is a
+ ;; function, and we insert the value returned from
+ ;; this function.
+ (or (and (stringp (cdr elem)) (cdr elem))
+ (and (fboundp (cdr elem)) (funcall (cdr elem)))))
+ ((and (boundp header) (symbol-value header))
+ ;; The element is a symbol. We insert the value
+ ;; of this symbol, if any.
+ (symbol-value header))
+ (t
+ ;; We couldn't generate a value for this header,
+ ;; so we just ask the user.
+ (read-from-minibuffer
+ (format "Empty header for %s; enter value: " header)))))
+ ;; Finally insert the header.
+ (when (and value
+ (not (equal value "")))
+ (save-excursion
(if (bolp)
- (save-excursion
+ (progn
+ ;; This header didn't exist, so we insert it.
(goto-char (point-max))
- (insert (symbol-name header) ": " value "\n"))
- (replace-match value t t))))
- (setq headers (cdr headers)))))
+ (insert (symbol-name header) ": " value "\n")
+ (forward-line -1))
+ ;; The value of this header was empty, so we clear
+ ;; totally and insert the new value.
+ (delete-region (point) (gnus-point-at-eol))
+ (insert value))
+ ;; Add the deletable property to the headers that require it.
+ (and (memq header gnus-deletable-headers)
+ (progn (beginning-of-line) (looking-at "[^:]+: "))
+ (add-text-properties
+ (point) (match-end 0)
+ '(gnus-deletable t face italic) (current-buffer)))))))
+ ;; Insert new Sender if the From is strange.
+ (let ((from (mail-fetch-field "from"))
+ (sender (mail-fetch-field "sender"))
+ (secure-sender (gnus-inews-real-user-address)))
+ (when (and from
+ (not (gnus-check-before-posting 'sender))
+ (not (string=
+ (downcase (car (cdr (gnus-extract-address-components
+ from))))
+ (downcase (gnus-inews-real-user-address))))
+ (or (null sender)
+ (not
+ (string=
+ (downcase (car (cdr (gnus-extract-address-components
+ sender))))
+ (downcase secure-sender)))))
+ (goto-char (point-min))
+ ;; Rename any old Sender headers to Original-Sender.
+ (when (re-search-forward "^Sender:" nil t)
+ (beginning-of-line)
+ (insert "Original-")
+ (beginning-of-line))
+ (insert "Sender: " secure-sender "\n")))))
(defun gnus-inews-insert-signature ()
"Insert a signature file.
In either case, if the string is a file name, this file is
inserted. If the string is not a file name, the string itself is
inserted.
-If you never want any signature inserted, set both those variables to
+
+If you never want any signature inserted, set both of these variables to
nil."
(save-excursion
(let ((signature
(or (and gnus-signature-function
- (fboundp gnus-signature-function)
(funcall gnus-signature-function gnus-newsgroup-name))
- gnus-signature-file))
- b)
+ gnus-signature-file)))
(if (and signature
(or (file-exists-p signature)
(string-match " " signature)
()
;; Delete any previous signatures.
(if (search-backward "\n-- \n" nil t)
- (delete-region (1+ (point)) (point-max)))
- (insert "\n-- \n")
+ (delete-region (point) (point-max)))
+ (or (eolp) (insert "\n"))
+ (insert "-- \n")
(if (file-exists-p signature)
(insert-file-contents signature)
(insert signature))
(goto-char (point-max))
(or (bolp) (insert "\n"))))))))
+;; Written by "Mr. Per Persson" <pp@solace.mh.se>.
+(defun gnus-inews-insert-mime-headers ()
+ (goto-char (point-min))
+ (let ((mail-header-separator
+ (progn
+ (goto-char (point-min))
+ (if (and (search-forward (concat "\n" mail-header-separator "\n")
+ nil t)
+ (not (search-backward "\n\n" nil t)))
+ mail-header-separator
+ ""))))
+ (or (mail-position-on-field "Mime-Version")
+ (insert "1.0")
+ (cond ((progn
+ (goto-char (point-min))
+ (re-search-forward "[\200-\377]" nil t))
+ (or (mail-position-on-field "Content-Type")
+ (insert "text/plain; charset=ISO-8859-1"))
+ (or (mail-position-on-field "Content-Transfer-Encoding")
+ (insert "8bit")))
+ (t (or (mail-position-on-field "Content-Type")
+ (insert "text/plain; charset=US-ASCII"))
+ (or (mail-position-on-field "Content-Transfer-Encoding")
+ (insert "7bit")))))))
+
(defun gnus-inews-do-fcc ()
- "Process FCC: fields in current article buffer.
+ "Process Fcc headers in the current buffer.
Unless the first character of the field is `|', the article is saved
to the specified file using the function specified by the variable
gnus-author-copy-saver. The default function rmail-output saves in
Unix mailbox format.
-If the first character is `|', the contents of the article is send to
+
+If the first character is `|', the contents of the article is sent to
a program specified by the rest of the value."
- (let ((fcc-list nil)
- (fcc-file nil)
- (case-fold-search t)) ;Should ignore case.
+ (let ((case-fold-search t) ;Should ignore case.
+ list file)
(save-excursion
(save-restriction
- (goto-char (point-min))
- (search-forward "\n\n")
- (narrow-to-region (point-min) (point))
- (goto-char (point-min))
- (while (re-search-forward "^FCC:[ \t]*" nil t)
- (setq fcc-list
- (cons (buffer-substring
- (point)
- (progn
- (end-of-line)
- (skip-chars-backward " \t")
- (point)))
- fcc-list))
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point))))
+ (gnus-narrow-to-headers)
+ (while (setq file (mail-fetch-field "fcc"))
+ (push file list)
+ (nnheader-remove-header "fcc" nil t))
;; Process FCC operations.
(widen)
- (while fcc-list
- (setq fcc-file (car fcc-list))
- (setq fcc-list (cdr fcc-list))
- (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
- (let ((program (substring fcc-file
- (match-beginning 1) (match-end 1))))
- ;; Suggested by yuki@flab.fujitsu.junet.
- ;; Send article to named program.
- (call-process-region (point-min) (point-max) shell-file-name
- nil nil nil "-c" program)))
- (t
- ;; Suggested by hyoko@flab.fujitsu.junet.
- ;; Save article in Unix mail format by default.
- (gnus-make-directory (file-name-directory fcc-file))
- (if (and gnus-author-copy-saver
- (not (eq gnus-author-copy-saver 'rmail-output)))
- (funcall gnus-author-copy-saver fcc-file)
- (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file))
- (gnus-output-to-rmail fcc-file)
- (rmail-output fcc-file 1 t t))))))))))
+ (while list
+ (setq file (pop list))
+ (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
+ ;; Pipe the article to the program in question.
+ (call-process-region (point-min) (point-max) shell-file-name
+ nil nil nil "-c" (match-string 1 file))
+ ;; Save the article.
+ (setq file (expand-file-name file))
+ (gnus-make-directory (file-name-directory file))
+ (if (and gnus-author-copy-saver
+ (not (eq gnus-author-copy-saver 'rmail-output)))
+ (funcall gnus-author-copy-saver file)
+ (if (and (file-readable-p file) (mail-file-babyl-p file))
+ (gnus-output-to-rmail file)
+ (let ((mail-use-rfc822 t))
+ (rmail-output file 1 t t))))))))))
(defun gnus-inews-path ()
"Return uucp path."
(defun gnus-inews-user-name ()
"Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"."
- (let ((full-name (gnus-inews-full-name)))
+ (let ((full-name (gnus-inews-full-name))
+ (address (if (or gnus-user-login-name gnus-use-generic-from
+ gnus-local-domain (getenv "DOMAINNAME"))
+ (concat (gnus-inews-login-name) "@"
+ (gnus-inews-domain-name gnus-use-generic-from))
+ user-mail-address)))
(or gnus-user-from-line
- (concat (if (or gnus-user-login-name gnus-use-generic-from
- gnus-local-domain (getenv "DOMAINNAME"))
- (concat (gnus-inews-login-name) "@"
- (gnus-inews-domain-name gnus-use-generic-from))
- user-mail-address)
+ (concat address
;; User's full name.
- (cond ((string-equal full-name "") "")
- ((string-equal full-name "&") ;Unix hack.
+ (cond ((string-equal full-name "&") ;Unix hack.
(concat " (" (user-login-name) ")"))
+ ((string-match "[^ ]+@[^ ]+ +(.*)" address)
+ "")
(t
(concat " (" full-name ")")))))))
+(defun gnus-inews-real-user-address ()
+ "Return the \"real\" user address.
+This function tries to ignore all user modifications, and
+give as trustworthy answer as possible."
+ (concat (user-login-name) "@" (gnus-inews-full-address)))
+
(defun gnus-inews-login-name ()
"Return login name."
(or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
gnus-local-domain
;; Function `system-name' may return full internet name.
;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
- (if (string-match "\\." system-name)
- (substring system-name (match-end 0)))
+ (if (string-match "\\.." system-name)
+ ;; Some machines return "name.", and that's not
+ ;; very nice.
+ (substring system-name (1- (match-end 0))))
(read-string "Domain name (no host): ")))
(host (or (if (string-match "\\." system-name)
(substring system-name 0 (match-beginning 0)))
(t domain)))
(if (string-match "\\." (system-name))
(system-name)
- (substring user-mail-address
- (1+ (string-match "@" user-mail-address))))))
+ (if (string-match "@\\([^ ]+\\)\\($\\| \\)" user-mail-address)
+ (substring user-mail-address
+ (match-beginning 1) (match-end 1))
+ "bogus-domain"))))
(defun gnus-inews-full-address ()
(let ((domain (gnus-inews-domain-name))
(if (string-match (concat "^" (regexp-quote system)) domain) domain
(concat system "." domain)))))
+(defun gnus-inews-expires ()
+ "Return an Expires header based on `gnus-article-expires'."
+ (let ((current (current-time))
+ (future (* 1.0 gnus-article-expires 60 60 24)))
+ ;; Add the future to current.
+ (setcar current (+ (car current) (round (/ future (expt 2 16)))))
+ (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
+ ;; Return the date in the future in UT.
+ (timezone-make-date-arpa-standard
+ (current-time-string current) (current-time-zone) '(0 "UT"))))
+
+(defun gnus-inews-distribution ()
+ "Return the current Distribution header, if any."
+ (when (and gnus-distribution-function
+ (fboundp gnus-distribution-function))
+ (funcall gnus-distribution-function (or gnus-newsgroup-name ""))))
+
(defun gnus-inews-message-id ()
"Generate unique Message-ID for user."
;; Message-ID should not contain a slash and should be terminated by
(let* ((organization
(or (getenv "ORGANIZATION")
(if gnus-local-organization
- (if (and (symbolp gnus-local-organization)
- (fboundp gnus-local-organization))
+ (if (gnus-functionp gnus-local-organization)
(funcall gnus-local-organization gnus-newsgroup-name)
gnus-local-organization))
gnus-organization-file
(> (length organization) 0)
(or (file-exists-p organization)
(string-match " " organization)
- (not (string-match "^/usr/lib/" organization)))
+ (not (string-match "^/usr/lib/\\|^~/" organization)))
(save-excursion
(gnus-set-work-buffer)
(if (file-exists-p organization)
(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
;; Stripping headers should be specified with mail-yank-ignored-headers.
(gnus-set-global-variables)
(if yank-articles (gnus-summary-goto-subject (car yank-articles)))
- (gnus-summary-select-article t)
- (let ((gnus-newsgroup-name gnus-newsgroup-name))
- (bury-buffer gnus-article-buffer)
- (funcall gnus-mail-reply-method (or yank-articles (not (not yank)))))
- (gnus-article-hide-headers-if-wanted))
+ (gnus-summary-select-article)
+ (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.
Customize the variable gnus-mail-forward-method to use another mailer."
(interactive "P")
(gnus-set-global-variables)
- (gnus-summary-select-article t)
+ (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)))
- (gnus-article-hide-headers-if-wanted))
+ (if post
+ (gnus-forward-using-post gnus-article-copy)
+ (gnus-mail-forward gnus-article-copy)))
+
+(defun gnus-summary-resend-message (address)
+ "Resend the current article to ADDRESS."
+ (interactive "sResend message to: ")
+ (gnus-summary-select-article)
+ (save-excursion
+ (let (resent beg)
+ ;; We first set up a normal mail buffer.
+ (nnheader-set-temp-buffer " *Gnus resend*")
+ ;; This code from sendmail.el
+ (insert "To: ")
+ (let ((fill-prefix "\t")
+ (address-start (point)))
+ (insert address "\n")
+ (fill-region-as-paragraph address-start (point-max)))
+ (insert mail-header-separator "\n")
+ ;; Insert our usual headers.
+ (gnus-inews-narrow-to-headers)
+ (gnus-inews-insert-headers '(From Date To))
+ (goto-char (point-min))
+ ;; Rename them all to "Resent-*".
+ (while (re-search-forward "^[A-Za-z]" nil t)
+ (forward-char -1)
+ (insert "Resent-"))
+ (widen)
+ (forward-line)
+ (delete-region (point) (point-max))
+ (setq beg (point))
+ ;; Insert the message to be resent.
+ (insert-buffer-substring gnus-original-article-buffer)
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ ;; Rename all old ("Also-")Resent headers.
+ (while (re-search-backward "^\\(Also-\\)?Resent-" beg t)
+ (beginning-of-line)
+ (insert "Also-"))
+ ;; Send it.
+ (mail-send)
+ (kill-buffer (current-buffer)))))
(defun gnus-summary-post-forward ()
"Forward the current article to a newsgroup."
"Really send a nastygram to the author of the current article? "))
(let ((group gnus-newsgroup-name))
(gnus-summary-reply-with-original n)
- (set-buffer "*mail*")
+ (set-buffer gnus-mail-buffer)
(insert (format gnus-nastygram-message group))
(gnus-mail-send-and-exit))))
mailer."
(interactive)
(gnus-set-global-variables)
- (let ((gnus-newsgroup-name gnus-newsgroup-name))
- (funcall gnus-mail-other-window-method)))
+ (gnus-new-mail
+ ;; We might want to prompt here.
+ (when (and gnus-interactive-post
+ (not gnus-expert-user))
+ (read-string "To: ")))
+ (gnus-configure-windows 'summary-mail 'force))
+
+(defun gnus-new-mail (&optional to)
+ (let (subject)
+ (when (and gnus-interactive-post
+ (not gnus-expert-user))
+ (setq subject (read-string "Subject: ")))
+ (pop-to-buffer gnus-mail-buffer)
+ (erase-buffer)
+ (gnus-mail-setup 'new to subject)
+ (gnus-inews-insert-gcc)
+ (run-hooks 'gnus-mail-hook)))
-(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 ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb)))
- (group (gnus-group-real-name gnus-newsgroup-name))
+ (let ((group (gnus-group-real-name gnus-newsgroup-name))
(cur (cons (current-buffer) (cdr gnus-article-current)))
(winconf (current-window-configuration))
- from subject date to reply-to message-of
- references message-id sender follow-to cc sendto elt)
- (set-buffer (get-buffer-create "*mail*"))
+ from subject date reply-to message-of to cc
+ references message-id sender follow-to sendto elt new-cc new-to
+ mct mctdo)
+ (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)
- (use-local-map (copy-keymap mail-mode-map))
- (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
(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 (gnus-functionp gnus-reply-to-function)
+ (setq follow-to (funcall gnus-reply-to-function group)))
+ ;; This is a followup.
+ (if (gnus-functionp 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")
- (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))))
+ (mail-header-date gnus-current-headers)))
+ (setq message-of (gnus-message-of from 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 cc (mail-fetch-field "cc"))
+ (setq mct (mail-fetch-field "mail-copies-to"))
(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)")))
+
+ (setq mctdo (not (equal mct "never")))
+
+ (if (not (and followup (not to-address)))
+ (setq new-to (or reply-to from))
+ (let (ccalist)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (unless (equal mct "never")
+ (insert (or reply-to from "")))
+ (insert (if (bolp) "" ", ")
+ (or to "")
+ (if (or (not mct) (not mctdo)) ""
+ (concat (if (bolp) "" ", ") mct))
+ (if cc (concat (if (bolp) "" ", ") cc) ""))
+ (goto-char (point-min))
+ (setq ccalist
+ (mapcar
+ (lambda (addr)
+ (cons (mail-strip-quoted-names addr) addr))
+ (nreverse (mail-parse-comma-list))))
+ (let ((s ccalist))
+ (while s
+ (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
+ (setq new-to (cdr (pop ccalist)))
+ (setq new-cc
+ (mapconcat
+ (lambda (addr) (cdr addr))
+ ccalist ", "))))
+ (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
+ (if followup 'followup 'reply)
+ (or to-address
+ (if (and follow-to (not (stringp follow-to))) sendto
+ (or follow-to new-to sender "")))
+ subject message-of
+ (if (zerop (length new-cc)) nil new-cc)
+ 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 subject)
+ (make-local-variable 'gnus-in-reply-to)
+ (setq gnus-in-reply-to message-of)
+
+ (auto-save-mode auto-save-default)
+ (gnus-inews-insert-gcc)
(if (and follow-to (listp follow-to))
(progn
(while follow-to
(insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n")
(setq follow-to (cdr follow-to)))))
- ;; Fold long references line to follow RFC1036.
- (mail-position-on-field "References")
- (let ((begin (- (point) (length "References: ")))
- (fill-column 78)
- (fill-prefix "\t"))
- (if references (insert references))
- (if (and references message-id) (insert " "))
- (if message-id (insert message-id))
- ;; The region must end with a newline to fill the region
- ;; without inserting extra newline.
- (fill-region-as-paragraph begin (1+ (point))))
+ (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) "$"))
(forward-line 1)
(if (not yank)
- (gnus-configure-windows 'reply)
+ (gnus-configure-windows 'reply 'force)
(let ((last (point))
end)
(if (not (listp yank))
(progn
+ ;; Just a single article being yanked.
(save-excursion
(mail-yank-original nil))
(or mail-yank-hooks mail-citation-hook
(gnus-summary-select-article nil nil nil (car yank))
(gnus-summary-remove-process-mark (car yank)))
(save-excursion
+ (setq end (point))
(gnus-copy-article-buffer)
(mail-yank-original nil)
- (setq end (point)))
- (or mail-yank-hooks mail-citation-hook
- (run-hooks 'news-reply-header-hook))
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (goto-char (mark t))
+ (let ((news-reply-yank-from
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (or (mail-fetch-field "from") "(nobody)")))
+ (news-reply-yank-message-id
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (or (mail-fetch-field "message-id")
+ "(unknown Message-ID)"))))
+ (or mail-yank-hooks mail-citation-hook
+ (run-hooks 'news-reply-header-hook))
+ (setq end (point-max)))))
(goto-char end)
(setq yank (cdr yank))))
(goto-char last))
- (gnus-configure-windows 'reply-yank))
- (run-hooks 'gnus-mail-hook)))))
+ (forward-line 2)
+ (gnus-configure-windows 'reply-yank 'force))
+ (run-hooks 'gnus-mail-hook)
+ ;; Mark this buffer as unchanged.
+ (set-buffer-modified-p nil)))))
+
+(defun gnus-new-news (&optional group inhibit-prompt)
+ "Set up a *post-news* buffer that points to GROUP.
+If INHIBIT-PROMPT, never prompt for a Subject."
+ (let ((winconf (current-window-configuration))
+ subject)
+ (when (and gnus-interactive-post
+ (not inhibit-prompt)
+ (not gnus-expert-user))
+ (setq subject (read-string "Subject: ")))
+ (pop-to-buffer gnus-post-news-buffer)
+ (erase-buffer)
+ (news-reply-mode)
+ ;; Let posting styles be configured.
+ (gnus-configure-posting-styles)
+ (news-setup nil subject nil (and group (gnus-group-real-name group)) nil)
+ ;; Associate this buffer with the draft group.
+ (gnus-associate-buffer-with-draft)
+ (goto-char (point-min))
+
+ (unless (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
+ (goto-char (point-max)))
+ (insert "\n\n")
+
+ (gnus-inews-insert-bfcc)
+ (gnus-inews-insert-gcc)
+ (gnus-inews-insert-signature)
+ (and gnus-post-prepare-function
+ (gnus-functionp gnus-post-prepare-function)
+ (funcall gnus-post-prepare-function group))
+ (goto-char (point-min))
+ (if group
+ (re-search-forward "^Subject: " nil t)
+ (re-search-forward "^Newsgroups: " nil t))
+ (run-hooks 'gnus-post-prepare-hook)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq gnus-prev-winconf winconf)
+ (gnus-inews-modify-mail-mode-map)
+ (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 newsgroups)
+ (set-buffer (get-buffer-create gnus-post-news-buffer))
+ (news-reply-mode)
+ ;; Associate this buffer with the draft group.
+ (gnus-associate-buffer-with-draft)
+ (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 (gnus-functionp 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)))
+ (setq message-of (gnus-message-of from 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 newsgroups (mail-fetch-field "newsgroups"))
+ (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))))
+
+ ;; Let posting styles be configured.
+ (gnus-configure-posting-styles)
+
+ (news-setup nil subject nil
+ (or sendto
+ (and followup-to
+ gnus-use-followup-to
+ (or (not (eq gnus-use-followup-to 'ask))
+ (gnus-y-or-n-p
+ (format
+ "Use Followup-To %s? " followup-to)))
+ followup-to)
+ newsgroups 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)
+
+ (gnus-inews-insert-signature)
+
+ (and gnus-post-prepare-function
+ (gnus-functionp gnus-post-prepare-function)
+ (funcall gnus-post-prepare-function group))
+ (run-hooks 'gnus-post-prepare-hook)
+
+ (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)))
+ (x-mail (save-excursion
+ (set-buffer gnus-article-copy)
+ (gnus-fetch-field "x-mail-copy-to"))))
+ ;; Deny sending copy if there's a negative X-Mail-Copy-To
+ ;; header.
+ (if x-mail
+ (if (and (string= x-mail "never")
+ (not (eq gnus-auto-mail-to-author 'force)))
+ (setq to nil)
+ (setq to x-mail)))
+ ;; Insert a To or Cc header.
+ (if to
+ (if (mail-fetch-field "To")
+ (progn
+ (beginning-of-line)
+ (insert "Cc: " to "\n"))
+ (mail-position-on-field "To")
+ (insert to))))
+
+ (gnus-inews-insert-bfcc)
+ (gnus-inews-insert-gcc)
+
+ ;; 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)
+ (progn
+ (gnus-configure-windows 'followup 'force)
+ (insert "\n\n")
+ (forward-line -2))
+ (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 'followup-yank 'force))
+
+ (make-local-variable 'gnus-article-check-size)
+ (setq gnus-article-check-size
+ (cons (buffer-size) (gnus-article-checksum))))))))
+
+(defun gnus-message-of (from date)
+ "Take a FROM and a DATE and create an IN-REPLY-TO."
+ (cond
+ ((not from)
+ nil)
+ (t
+ (let ((stop-pos
+ (string-match " *at \\| *@ \\| *(\\| *<" from)))
+ (concat (if stop-pos (substring from 0 stop-pos) from)
+ "'s message of "
+ (if (or (not date) (string= date ""))
+ "(unknown date)" date))))))
(defun gnus-mail-yank-original ()
(interactive)
(save-excursion
- (mail-yank-original nil))
+ (mail-yank-original nil))
(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)
+ (let ((buffer-file-name 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))
gnus-newsgroup-name)))
gnus-valid-select-methods))
(gnus-fetch-field "From")
- gnus-newsgroup-name)
+ gnus-newsgroup-name)
"] " (or (gnus-fetch-field "Subject") ""))))
(defun gnus-forward-insert-buffer (buffer)
- (let ((beg (goto-char (point-max))))
- (insert "------- Start of forwarded message -------\n")
- (insert-buffer buffer)
- (goto-char (point-max))
- (insert "------- End of forwarded message -------\n")
- ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (goto-char beg)
- (while (setq beg (next-single-property-change (point) 'invisible))
- (goto-char beg)
- (delete-region beg (or (next-single-property-change
- (point) 'invisible)
- (point-max))))))
-
-(defun gnus-mail-forward-using-mail (&optional buffer)
+ (save-excursion
+ (save-restriction
+ (if gnus-signature-before-forwarded-message
+ (goto-char (point-max))
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1))
+ ;; Narrow to the area we are to insert.
+ (narrow-to-region (point) (point))
+ ;; Insert the separators and the forwarded buffer.
+ (insert gnus-forward-start-separator)
+ (insert-buffer-substring buffer)
+ (goto-char (point-max))
+ (insert gnus-forward-end-separator)
+ ;; Delete any invisible text.
+ (goto-char (point-min))
+ (let (beg)
+ (while (setq beg (next-single-property-change (point) 'invisible))
+ (goto-char beg)
+ (delete-region beg (or (next-single-property-change
+ (point) 'invisible)
+ (point-max))))))))
+
+(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)
- (mail nil nil subject)
- (use-local-map (copy-keymap (current-local-map)))
- (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf)
- (gnus-forward-insert-buffer forward-buffer)
- (goto-char (point-min))
- (re-search-forward "^To: " nil t)
- (gnus-configure-windows 'mail-forward)
- ;; You have a chance to arrange the message.
- (run-hooks 'gnus-mail-forward-hook)
- (run-hooks 'gnus-mail-hook)))
-
-(defun gnus-forward-using-post (&optional buffer)
- (let* ((forward-buffer (or buffer (current-buffer)))
- (subject (gnus-forward-make-subject forward-buffer)))
- (gnus-post-news 'post nil nil nil nil subject)
- (save-excursion
+ (set-buffer (get-buffer-create gnus-mail-buffer))
+ (if (and (buffer-modified-p)
+ (> (buffer-size) 0)
+ (not (gnus-y-or-n-p
+ "Unsent message being composed; erase it? ")))
+ ()
+ (erase-buffer)
+ (gnus-mail-setup 'forward nil subject)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq gnus-prev-winconf winconf)
(gnus-forward-insert-buffer forward-buffer)
+ (goto-char (point-min))
+ (re-search-forward "^To: ?" nil t)
+ (gnus-configure-windows 'mail-forward 'force)
;; You have a chance to arrange the message.
- (run-hooks 'gnus-mail-forward-hook))))
+ (run-hooks 'gnus-mail-forward-hook)
+ (run-hooks 'gnus-mail-hook))))
+
+(defun gnus-forward-using-post (&optional buffer)
+ (save-excursion
+ (let* ((forward-buffer (or buffer (current-buffer)))
+ (subject (gnus-forward-make-subject forward-buffer))
+ (gnus-newsgroup-name nil))
+ (gnus-post-news 'post nil nil nil nil subject)
+ (save-excursion
+ (gnus-forward-insert-buffer forward-buffer)
+ ;; You have a chance to arrange the message.
+ (run-hooks 'gnus-mail-forward-hook)))))
(defun gnus-mail-other-window-using-mail ()
"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)))
+ (run-hooks 'gnus-mail-hook)
+ (gnus-configure-windows 'summary-mail 'force)))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
(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."
+ (interactive)
+ (let ((winconf (current-window-configuration)))
+ (delete-other-windows)
+ (switch-to-buffer "*Gnus Help Bug*")
+ (erase-buffer)
+ (insert gnus-bug-message)
+ (goto-char (point-min))
+ (pop-to-buffer "*Gnus Bug*")
+ (erase-buffer)
+ (mail-mode)
+ (mail-setup gnus-maintainer nil nil nil nil nil)
+ (auto-save-mode auto-save-default)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq gnus-prev-winconf winconf)
+ (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) "$"))
+ (forward-line 1)
+ (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version)))
+ (gnus-debug)
+ (goto-char (point-min))
+ (search-forward "Subject: " nil t)
+ (message "")))
+
+(defun gnus-bug-mail-send-and-exit ()
+ "Send the bug message and exit."
+ (interactive)
+ (and (get-buffer "*Gnus Help Bug*")
+ (kill-buffer "*Gnus Help Bug*"))
+ (gnus-mail-send-and-exit))
-(defun gnus-article-mail-with-original ()
- "Send a reply to the address near point and include the original article."
+(defun gnus-debug ()
+ "Attemps 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."
(interactive)
- (gnus-article-mail 'yank))
+ (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el"))
+ file dirs expr olist sym)
+ (message "Please wait while we snoop your variables...")
+ (sit-for 0)
+ (save-excursion
+ (set-buffer (get-buffer-create " *gnus bug info*"))
+ (buffer-disable-undo (current-buffer))
+ (while files
+ (erase-buffer)
+ (setq dirs load-path)
+ (while dirs
+ (if (or (not (car dirs))
+ (not (stringp (car dirs)))
+ (not (file-exists-p
+ (setq file (concat (file-name-as-directory
+ (car dirs)) (car files))))))
+ (setq dirs (cdr dirs))
+ (setq dirs nil)
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (or (re-search-forward "^;;* *Internal variables" nil t)
+ (error "Malformed sources in file %s" file))
+ (narrow-to-region (point-min) (point))
+ (goto-char (point-min))
+ (while (setq expr (condition-case ()
+ (read (current-buffer)) (error nil)))
+ (condition-case ()
+ (and (eq (car expr) 'defvar)
+ (stringp (nth 3 expr))
+ (or (not (boundp (nth 1 expr)))
+ (not (equal (eval (nth 2 expr))
+ (symbol-value (nth 1 expr)))))
+ (setq olist (cons (nth 1 expr) olist)))
+ (error nil)))))
+ (setq files (cdr files)))
+ (kill-buffer (current-buffer)))
+ (insert "------------------- Environment follows -------------------\n\n")
+ (setq olist (nreverse olist))
+ (while olist
+ (if (boundp (car olist))
+ (insert "(setq " (symbol-name (car olist))
+ (if (or (consp (setq sym (symbol-value (car olist))))
+ (and (symbolp sym)
+ (not (or (eq sym nil)
+ (eq sym t)))))
+ " '" " ")
+ (prin1-to-string (symbol-value (car olist))) ")\n")
+ (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
+ (setq olist (cdr olist)))
+ (insert "\n\n")
+ ;; Remove any null chars - they seem to cause trouble for some
+ ;; mailers. (Byte-compiled output from the stuff above.)
+ (goto-char (point-min))
+ (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-substring 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)
+ (gnus-inews-remove-empty-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-put-draft-group))
+
+(defun gnus-mail-setup (type &optional to subject in-reply-to cc
+ replybuffer actions)
+ ;; Let posting styles be configured.
+ (gnus-configure-posting-styles)
+ (funcall
+ (cond
+ ((or
+ (and (or (eq type 'reply) (eq type 'followup))
+ (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 (or (eq type 'reply) (eq type 'followup))
+ (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)
+ ;; Associate this mail buffer with the draft group.
+ (gnus-associate-buffer-with-draft))
+
+(defun gnus-sendmail-mail-setup (to subject in-reply-to cc replybuffer actions)
+ (mail-mode)
+ (mail-setup to subject nil cc replybuffer actions)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$") nil t)
+ (forward-line 1)
+ (goto-char (point-max)))
+ (gnus-inews-modify-mail-mode-map))
+
+;;; 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-bfcc ()
+ "Insert Bcc and Fcc headers."
+ (save-excursion
+ ;; Handle author copy using BCC field.
+ (when (and gnus-mail-self-blind
+ (not (mail-fetch-field "bcc")))
+ (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.
+ (when gnus-author-copy
+ (mail-position-on-field "Fcc")
+ (insert gnus-author-copy))))
+
+(defun gnus-inews-insert-gcc ()
+ (save-excursion
+ (save-restriction
+ (gnus-inews-narrow-to-headers)
+ (let* ((group gnus-outgoing-message-group)
+ (gcc (cond
+ ((gnus-functionp group)
+ (funcall group))
+ ((or (stringp group) (list group))
+ group))))
+ (when 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 'nndraft gnus-draft-group-directory)))
+
+(defun gnus-make-draft-group ()
+ "Make the draft group or die trying."
+ (let* ((method (` (nndraft "private"
+ (nndraft-directory
+ (, gnus-draft-group-directory)))))
+ (group (gnus-draft-group)))
+ (or (gnus-gethash group gnus-newsrc-hashtb)
+ (gnus-group-make-group (gnus-group-real-name group) method)
+ (error "Can't create the draft group"))
+ (gnus-check-server method)
+ group))
+
+(defun gnus-put-in-draft-group (&optional generate silent)
+ "Enter the current buffer into the draft group."
+ (interactive)
+ (when (gnus-request-accept-article (gnus-make-draft-group) t)
+ (unless silent
+ ;; This function does the proper marking of articles.
+ (gnus-mail-send-and-exit 'dont-send))
+ (set-buffer-modified-p nil)))
+
+(defun gnus-associate-buffer-with-draft ()
+ (save-excursion
+ ;; Make sure the draft group exists.
+ (gnus-make-draft-group)
+ ;; Associate the buffer with the draft group.
+ (let ((article (gnus-request-associate-buffer (gnus-draft-group))))
+ ;; Arrange for deletion of the draft after successful sending.
+ (make-local-variable 'gnus-message-sent-hook)
+ (setq gnus-message-sent-hook
+ (list
+ `(lambda ()
+ (let ((gnus-verbose-backends nil))
+ (gnus-request-expire-articles
+ (quote ,(list article))
+ ,(gnus-draft-group) t))))))))
+
+(defun gnus-summary-send-draft ()
+ "Enter a mail/post buffer to edit and send the draft."
+ (interactive)
+ (gnus-set-global-variables)
+ (unless (equal gnus-newsgroup-name (gnus-draft-group))
+ (error "This function can only be used in the draft buffer"))
+ (let (buf point)
+ (if (not (setq buf (gnus-request-restore-buffer
+ (gnus-summary-article-number) gnus-newsgroup-name)))
+ (error "Couldn't restore the article")
+ (setq point (point))
+ (switch-to-buffer buf)
+ (gnus-inews-modify-mail-mode-map)
+ (when (eq major-mode 'news-reply-mode)
+ (local-set-key "\C-c\C-c" 'gnus-inews-news))
+ (gnus-associate-buffer-with-draft)
+ ;; Insert the separator.
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (forward-char -1)
+ (insert mail-header-separator)
+ ;; Configure windows.
+ (let ((gnus-draft-buffer (current-buffer)))
+ (gnus-configure-windows 'draft)
+ (goto-char (point))))))
+
+(defun gnus-configure-posting-styles ()
+ "Configure posting styles according to `gnus-posting-styles'."
+ (let ((styles gnus-posting-styles)
+ (gnus-newsgroup-name (or gnus-newsgroup-name ""))
+ style match variable attribute value value-value)
+ ;; Go through all styles and look for matches.
+ (while styles
+ (setq style (pop styles)
+ match (pop style))
+ (when (cond ((stringp match)
+ ;; Regexp string match on the group name.
+ (string-match match gnus-newsgroup-name))
+ ((or (symbolp match)
+ (gnus-functionp match))
+ (cond ((gnus-functionp match)
+ ;; Function to be called.
+ (funcall match))
+ ((boundp match)
+ ;; Variable to be checked.
+ (symbol-value match))))
+ ((listp match)
+ ;; This is a form to be evaled.
+ (eval match)))
+ ;; We have a match, so we set the variables.
+ (while style
+ (setq attribute (pop style)
+ value (cdr attribute))
+ ;; We find the variable that is to be modified.
+ (if (and (not (stringp (car attribute)))
+ (not (setq variable (cdr (assq (car attribute)
+ gnus-posting-style-alist)))))
+ (message "Couldn't find attribute %s" (car attribute))
+ ;; We set the variable.
+ (setq value-value
+ (cond ((stringp value)
+ value)
+ ((or (symbolp value)
+ (gnus-functionp value))
+ (cond ((gnus-functionp value)
+ (funcall value))
+ ((boundp value)
+ (symbol-value value))))
+ ((listp value)
+ (eval value))))
+ (if variable
+ (progn
+ ;; This is an ordinary variable.
+ (make-local-variable variable)
+ (set variable value-value))
+ ;; This is a header to be added to the headers when
+ ;; posting.
+ (when value-value
+ (make-local-variable gnus-required-headers)
+ (make-local-variable gnus-required-mail-headers)
+ (push (cons (car attribute) value-value)
+ gnus-required-headers)
+ (push (cons (car attribute) value-value)
+ gnus-required-mail-headers)))))))))
+
+;;; Allow redefinition of functions.
+
+(gnus-ems-redefine)
(provide 'gnus-msg)
projects / gnus / blobdiff