;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(require 'gnus)
-(require 'sendmail)
-
-(defvar gnus-organization-file "/usr/lib/news/organization"
- "*Local news organization file.")
-
-(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
-might be used, for instance, for inserting signatures based on the
-newsgroup name. (In that case, `gnus-signature-file' and
-`mail-signature' should both be set to nil).")
-
-(defvar gnus-post-prepare-hook nil
- "*Hook that is run after a post buffer has been prepared.
-If you want to insert the signature, you might put
-`gnus-inews-insert-signature' in this hook.")
-
-(defvar gnus-use-followup-to 'use
- "*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.")
-
-(defvar gnus-followup-to-function nil
- "*A variable that contains a function that returns a followup address.
-The function will be called in the buffer of the article that is being
-followed up. The buffer will be narrowed to the headers of the
-article. To pick header headers, one might use `mail-fetch-field'. The
-function will be called with the name of the current newsgroup as the
-argument.
-
-Here's an example `gnus-followup-to-function':
-
-(setq gnus-followup-to-function
- (lambda (group)
- (cond ((string= group \"mail.list\")
- (or (mail-fetch-field \"sender\")
- (mail-fetch-field \"from\")))
- (t
- (or (mail-fetch-field \"reply-to\")
- (mail-fetch-field \"from\"))))))")
-
-(defvar gnus-reply-to-function nil
- "*A variable that contains a function that returns a reply address.
-See the `gnus-followup-to-function' variable for an explanation of how
-this variable is used.
-
-This function should return a string that will be used to fill in the
-header. This function may also return a list. In that case, every
-list element should be a cons where the first car should be a string
-with the header name, and the cdr should be a string with the header
-value.")
-
-(defvar gnus-author-copy (getenv "AUTHORCOPY")
- "*Save outgoing articles in this file.
-Initialized from the AUTHORCOPY environment variable.
-
-If this variable begins with the character \"|\", outgoing articles
-will be piped to the named program. It is possible to save an article
-in an MH folder as follows:
-
-\(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")
-
-If the first character is not a pipe, articles are saved using the
-function specified by the `gnus-author-copy-saver' variable.")
-
-(defvar gnus-mail-self-blind nil
- "*Non-nil means insert a BCC header in all outgoing articles.
-This will result in having a copy of the article mailed to yourself.
-The BCC header is inserted when the post buffer is initialized, so you
-can remove or alter the BCC header to override the default.")
-
-(defvar gnus-author-copy-saver (function rmail-output)
- "*A function called to save outgoing articles.
-This function will be called with the same of the file to store the
-article in. The default function is `rmail-output' which saves in Unix
-mailbox format.")
-
-(defvar gnus-user-login-name nil
- "*The login name of the user.
-Got from the function `user-login-name' if undefined.")
-
-(defvar gnus-user-full-name nil
- "*The full name of the user.
-Got from the NAME environment variable if undefined.")
-
-(defvar gnus-user-from-line nil
- "*Your full, complete e-mail address.
-Overrides the other Gnus variables if it is non-nil.
-
-Here are two example values of this variable:
-
- \"Lars Magne Ingebrigtsen <larsi@ifi.uio.no>\"
-
-and
-
- \"larsi@ifi.uio.no (Lars Magne Ingebrigtsen)\"
-
-The first version is recommended, but the name has to be quoted if it
-contains non-alphanumerical characters.")
-
-(defvar gnus-signature-file "~/.signature"
- "*Your signature file.
-If the variable is a string that doesn't correspond to a file, the
-string itself is inserted.")
-
-(defvar gnus-signature-function nil
- "*A function that should return a signature file name.
-The function will be called with the name of the newsgroup being
-posted to.
-If the function returns a string that doesn't correspond to a file, the
-string itself is inserted.
-If the function returns nil, the `gnus-signature-file' variable will
-be used instead.")
-
-(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.")
-
-(defvar gnus-deletable-headers '(Message-ID)
- "*Headers to be deleted if they already exists.")
-
-(defvar gnus-check-before-posting
- '(subject-cmsg multiple-headers sendsys message-id from
- long-lines control-chars size new-text
- signature)
- "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:"
- "*Header lines matching this regexp will be deleted before posting.
-It's best to delete old Path and Date headers before psoting 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.")
-
-;; Added by Ethan Bradford <ethanb@ptolemy.astro.washington.edu>.
-(defvar gnus-mail-courtesy-message
- "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n"
- "*This is inserted at the start of a mailed copy of a posted message.
-If this variable is nil, no such courtesy message will be added.")
-
-(defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail)
- "*Function to compose a reply.
-Three pre-made functions are `gnus-mail-reply-using-mail' (sendmail);
-`gnus-mail-reply-using-mhe' (MH-E); and `gnus-mail-reply-using-vm'.")
-
-(defvar gnus-mail-forward-method (function gnus-mail-forward-using-mail)
- "*Function to forward the current message to another user.
-Three pre-made functions are `gnus-mail-forward-using-mail' (sendmail);
-`gnus-mail-forward-using-mhe' (MH-E); and `gnus-mail-forward-using-vm'.")
-
-(defvar gnus-mail-other-window-method 'gnus-mail-other-window-using-mail
- "*Function to compose mail in the other window.
-Three pre-made functions are `gnus-mail-other-window-using-mail'
-(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-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
-the article to a file).")
-
-(defvar gnus-inews-article-header-hook nil
- "*A hook called after inserting the headers in an article to be posted.
-The hook is called from the *post-news* buffer, narrowed to the
-headers.")
-
-(defvar gnus-mail-hook nil
- "*A hook called as the last thing after setting up a mail buffer.")
+(require 'gnus-ems)
+(require 'message)
+(require 'gnus-art)
+
+;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
+(defvar gnus-post-method nil
+ "*Preferred method for posting USENET news.
+If this variable is nil, Gnus will use the current method to decide
+which method to use when posting. If it is non-nil, it will override
+the current method. This method will not be used in mail groups and
+the like, only in \"real\" newsgroups.
+
+The value must be a valid method as discussed in the documentation of
+`gnus-select-method'. It can also be a list of methods. If that is
+the case, the user will be queried for what select method to use when
+posting.")
+
+(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-sent-message-ids-file
+ (nnheader-concat gnus-directory "Sent-Message-IDs")
+ "File where Gnus saves a cache of sent message ids.")
+
+(defvar gnus-sent-message-ids-length 1000
+ "The number of sent Message-IDs to save.")
+
+(defvar gnus-crosspost-complaint
+ "Hi,
+
+You posted the article below with the following Newsgroups header:
+
+Newsgroups: %s
+
+The %s group, at least, was an inappropriate recipient
+of this message. Please trim your Newsgroups header to exclude this
+group before posting in the future.
+
+Thank you.
+
+"
+ "Format string to be inserted when complaining about crossposts.
+The first %s will be replaced by the Newsgroups header;
+the second with the current group name.")
+
+(defvar gnus-message-setup-hook nil
+ "Hook run after setting up a message buffer.")
;;; Internal variables.
-(defvar gnus-post-news-buffer "*post-news*")
-(defvar gnus-summary-send-map nil)
+(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
-(defvar gnus-reply-subject nil)
+(defvar gnus-last-posting-server nil)
+
+(defconst gnus-bug-message
+ "Sending a bug report to the Gnus Towers.
+========================================
+
+The buffer below is a mail buffer. When you press `C-c C-c', it will
+be sent to the Gnus Bug Exterminators.
+
+At the bottom of the buffer you'll see lots of variable settings.
+Please do not delete those. They will tell the Bug People what your
+environment is, so that it will be easier to locate the bugs.
+
+If you have found a bug that makes Emacs go \"beep\", set
+debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
+and include the backtrace in your bug report.
+
+Please describe the bug in annoying, painstaking detail.
+
+Thank you for your help in stamping out bugs.
+")
+
+(eval-and-compile
+ (autoload 'gnus-uu-post-news "gnus-uu" nil t)
+ (autoload 'news-setup "rnewspost")
+ (autoload 'news-reply-mode "rnewspost")
+ (autoload 'rmail-dont-reply-to "mail-utils")
+ (autoload 'rmail-output "rmailout"))
\f
;;;
;;; Gnus Posting Functions
;;;
-(define-prefix-command 'gnus-summary-send-map)
-(define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
-(define-key gnus-summary-send-map "p" 'gnus-summary-post-news)
-(define-key gnus-summary-send-map "f" 'gnus-summary-followup)
-(define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original)
-(define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply)
-(define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original)
-(define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article)
-(define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article)
-(define-key gnus-summary-send-map "r" 'gnus-summary-reply)
-(define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original)
-(define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window)
-(define-key gnus-summary-send-map "u" 'gnus-uu-post-news)
-(define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward)
-(define-key gnus-summary-send-map "op" 'gnus-summary-post-forward)
-(define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward)
-(define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward)
+(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
+ "p" gnus-summary-post-news
+ "f" gnus-summary-followup
+ "F" gnus-summary-followup-with-original
+ "c" gnus-summary-cancel-article
+ "s" gnus-summary-supersede-article
+ "r" gnus-summary-reply
+ "R" gnus-summary-reply-with-original
+ "w" gnus-summary-wide-reply
+ "W" gnus-summary-wide-reply-with-original
+ "n" gnus-summary-followup-to-mail
+ "N" gnus-summary-followup-to-mail-with-original
+ "m" gnus-summary-mail-other-window
+ "u" gnus-uu-post-news
+ "\M-c" gnus-summary-mail-crosspost-complaint
+ "om" gnus-summary-mail-forward
+ "op" gnus-summary-post-forward
+ "Om" gnus-uu-digest-mail-forward
+ "Op" gnus-uu-digest-post-forward)
+
+(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
+ "b" gnus-summary-resend-bounced-mail
+ ;; "c" gnus-summary-send-draft
+ "r" gnus-summary-resend-message)
;;; Internal functions.
-(defun gnus-number-base36 (num len)
- (if (if (< len 0) (<= num 0) (= len 0))
- ""
- (concat (gnus-number-base36 (/ num 36) (1- len))
- (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
- (% num 36))))))
+(defvar gnus-article-reply nil)
+(defmacro gnus-setup-message (config &rest forms)
+ (let ((winconf (make-symbol "winconf"))
+ (buffer (make-symbol "buffer"))
+ (article (make-symbol "article")))
+ `(let ((,winconf (current-window-configuration))
+ (,buffer (buffer-name (current-buffer)))
+ (,article (and gnus-article-reply (gnus-summary-article-number)))
+ (message-header-setup-hook
+ (copy-sequence message-header-setup-hook)))
+ (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
+ (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
+ (unwind-protect
+ ,@forms
+ (gnus-inews-add-send-actions ,winconf ,buffer ,article)
+ (setq gnus-message-buffer (current-buffer))
+ (make-local-variable 'gnus-newsgroup-name)
+ (run-hooks 'gnus-message-setup-hook))
+ (gnus-configure-windows ,config t))))
+
+(defun gnus-inews-add-send-actions (winconf buffer article)
+ (make-local-hook 'message-sent-hook)
+ (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
+ (setq message-post-method
+ `(lambda (arg)
+ (gnus-post-method arg ,gnus-newsgroup-name)))
+ (setq message-newsreader (setq message-mailer (gnus-extended-version)))
+ (message-add-action
+ `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
+ (message-add-action
+ `(when (buffer-name (get-buffer ,buffer))
+ (save-excursion
+ (set-buffer (get-buffer ,buffer))
+ ,(when article
+ `(gnus-summary-mark-article-as-replied ,article))))
+ 'send))
+
+(put 'gnus-setup-message 'lisp-indent-function 1)
+(put 'gnus-setup-message 'edebug-form-spec '(form body))
;;; Post news commands of Gnus group mode and summary mode
(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))
+ (gnus-setup-message 'message
+ (message-mail)))
-(defun gnus-group-post-news ()
- "Post an article."
- (interactive)
- (let ((gnus-newsgroup-name nil))
- (gnus-post-news 'post nil nil gnus-article-buffer)))
+(defun gnus-group-post-news (&optional arg)
+ "Start composing a news message.
+If ARG, post to the group under point.
+If ARG is 1, prompt for a group name."
+ (interactive "P")
+ ;; Bind this variable here to make message mode hooks
+ ;; work ok.
+ (let ((gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Newsgroup: " gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ "")))
+ (gnus-post-news 'post gnus-newsgroup-name)))
(defun gnus-summary-post-news ()
- "Post an article."
+ "Start composing a news message."
(interactive)
(gnus-set-global-variables)
(gnus-post-news 'post gnus-newsgroup-name))
-(defun gnus-summary-followup (yank &optional yank-articles)
+(defun gnus-summary-followup (yank &optional force-news)
"Compose a followup to an article.
If prefix argument YANK is non-nil, original article is yanked automatically."
- (interactive "P")
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
(gnus-set-global-variables)
- (if yank-articles (gnus-summary-goto-subject (car yank-articles)))
+ (when yank
+ (gnus-summary-goto-subject (car yank)))
(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))
- (not (gnus-y-or-n-p
- "Do you want to ignore `Followup-To: poster'? "))))
- ;; Mail to the poster. Gnus is now RFC1036 compliant.
- (gnus-summary-reply yank)
- (gnus-post-news nil gnus-newsgroup-name
- headers gnus-article-buffer
- (or yank-articles (not (not yank))))))
- (gnus-article-hide-headers-if-wanted))
-
-(defun gnus-summary-followup-with-original (n)
+ ;; Send a followup.
+ (gnus-post-news nil gnus-newsgroup-name
+ headers gnus-article-buffer
+ yank nil force-news)))
+
+(defun gnus-summary-followup-with-original (n &optional force-news)
"Compose a followup to an article and include the original article."
(interactive "P")
- (gnus-summary-followup t (gnus-summary-work-articles n)))
+ (gnus-summary-followup (gnus-summary-work-articles n) force-news))
-;; Suggested by Daniel Quinlan <quinlan@best.com>.
-(defun gnus-summary-followup-and-reply (yank &optional yank-articles)
- "Compose a followup and do an auto mail to author."
- (interactive "P")
- (gnus-set-global-variables)
- (let ((gnus-auto-mail-to-author t))
- (gnus-summary-followup yank yank-articles)))
+(defun gnus-summary-followup-to-mail (&optional arg)
+ "Followup to the current mail message via news."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnus-summary-followup arg t))
-(defun gnus-summary-followup-and-reply-with-original (n)
- "Compose a followup, include the original, and do an auto mail to author."
+(defun gnus-summary-followup-to-mail-with-original (&optional arg)
+ "Followup to the current mail message via news."
(interactive "P")
- (gnus-summary-followup-and-reply t (gnus-summary-work-articles n)))
+ (gnus-summary-followup (gnus-summary-work-articles arg) t))
+
+(defun gnus-inews-yank-articles (articles)
+ (let (beg article)
+ (message-goto-body)
+ (while (setq article (pop articles))
+ (save-window-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-select-article nil nil nil article)
+ (gnus-summary-remove-process-mark article))
+ (gnus-copy-article-buffer)
+ (let ((message-reply-buffer gnus-article-copy)
+ (message-reply-headers gnus-current-headers))
+ (message-yank-original)
+ (setq beg (or beg (mark t))))
+ (when articles
+ (insert "\n")))
+ (push-mark)
+ (goto-char beg)))
(defun gnus-summary-cancel-article (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))
+ (message-post-method
+ `(lambda (arg)
+ (gnus-post-method nil ,gnus-newsgroup-name)))
+ 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
+ (message-cancel-news))
+ (gnus-summary-mark-as-read article gnus-canceled-mark)
+ (gnus-cache-remove-article 1))
+ (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.
header line with the old Message-ID."
(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))))
+ (let ((article (gnus-summary-article-number)))
+ (gnus-setup-message 'reply-yank
+ (gnus-summary-select-article t)
+ (set-buffer gnus-original-article-buffer)
+ (message-supersede)
+ (push
+ `((lambda ()
+ (when (buffer-name (get-buffer ,gnus-summary-buffer))
+ (save-excursion
+ (set-buffer (get-buffer ,gnus-summary-buffer))
+ (gnus-cache-possibly-remove-article ,article nil nil nil t)
+ (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
+ message-send-actions))))
\f
-;;;###autoload
-(defalias 'sendnews 'gnus-post-news)
-
-;;;###autoload
-(defalias 'postnews 'gnus-post-news)
(defun gnus-copy-article-buffer (&optional article-buffer)
;; make a copy of the article buffer with all text properties removed
(setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
(buffer-disable-undo gnus-article-copy)
(or (memq gnus-article-copy gnus-buffer-list)
- (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
- (let ((article-buffer (or article-buffer gnus-article-buffer)))
- (if (and (get-buffer article-buffer)
- (buffer-name (get-buffer article-buffer)))
- (save-excursion
- (set-buffer article-buffer)
+ (push gnus-article-copy gnus-buffer-list))
+ (let ((article-buffer (or article-buffer gnus-article-buffer))
+ end beg contents)
+ (if (not (and (get-buffer article-buffer)
+ (buffer-name (get-buffer article-buffer))))
+ (error "Can't find any article buffer")
+ (save-excursion
+ (set-buffer article-buffer)
+ (save-restriction
+ ;; Copy over the (displayed) article buffer, delete
+ ;; hidden text and remove text properties.
(widen)
(copy-to-buffer gnus-article-copy (point-min) (point-max))
- (set-text-properties (point-min) (point-max)
- nil gnus-article-copy)))))
-
-(defun gnus-post-news (post &optional group header article-buffer yank subject)
- "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))
+ (set-buffer gnus-article-copy)
+ (gnus-article-delete-text-of-type 'annotation)
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)
+ (insert
+ (prog1
+ (format "%s" (buffer-string))
+ (erase-buffer)))
+ ;; Find the original headers.
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (while (looking-at message-unix-mail-delimiter)
+ (forward-line 1))
+ (setq beg (point))
+ (setq end (or (search-forward "\n\n" nil t) (point)))
+ ;; Delete the headers from the displayed articles.
+ (set-buffer gnus-article-copy)
+ (delete-region (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point)))
+ ;; Insert the original article headers.
+ (insert-buffer-substring gnus-original-article-buffer beg end)
+ (gnus-article-decode-rfc1522)))
+ gnus-article-copy)))
+
+(defun gnus-post-news (post &optional group header article-buffer yank subject
+ force-news)
+ (when article-buffer
+ (gnus-copy-article-buffer))
+ (let ((gnus-article-reply article-buffer))
+ (gnus-setup-message (cond (yank 'reply-yank)
+ (article-buffer 'reply)
+ (t 'message))
+ (let* ((group (or group gnus-newsgroup-name))
+ (pgroup group)
+ to-address to-group mailing-list to-list
+ newsgroup-p)
+ (when group
+ (setq to-address (gnus-group-find-parameter group 'to-address)
+ to-group (gnus-group-find-parameter group 'to-group)
+ to-list (gnus-group-find-parameter group 'to-list)
+ newsgroup-p (gnus-group-find-parameter group 'newsgroup)
+ mailing-list (when gnus-mailing-list-groups
+ (string-match gnus-mailing-list-groups group))
+ group (gnus-group-real-name group)))
+ (if (or (and to-group
+ (gnus-news-group-p to-group))
+ newsgroup-p
+ force-news
+ (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
+ (message-news (or to-group group))
+ (set-buffer gnus-article-copy)
+ (message-followup (if (or newsgroup-p force-news) nil to-group)))
+ ;; The is mail.
(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)
-
-(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")
- (let* ((case-fold-search nil)
- (server-running (gnus-server-opened gnus-select-method))
- (reply gnus-article-reply))
- (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")))
+ (message-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.
+ (when (and (not to-list)
+ (not to-address))
+ (push (list 'gnus-inews-add-to-address pgroup)
+ message-send-actions)))
+ (set-buffer gnus-article-copy)
+ (message-wide-reply to-address)))
+ (when yank
+ (gnus-inews-yank-articles yank))))))
+
+(defun gnus-post-method (arg group &optional silent)
+ "Return the posting method based on GROUP and ARG.
+If SILENT, don't prompt the user."
+ (let ((group-method (gnus-find-method-for-group group)))
+ (cond
+ ;; If the group-method is nil (which shouldn't happen) we use
+ ;; the default method.
+ ((null group-method)
+ (or gnus-post-method gnus-select-method message-post-method))
+ ;; We want this group's method.
+ ((and arg (not (eq arg 0)))
+ group-method)
+ ;; We query the user for a post method.
+ ((or arg
+ (and gnus-post-method
+ (listp (car gnus-post-method))))
+ (let* ((methods
+ ;; Collect all methods we know about.
+ (append
+ (when gnus-post-method
+ (if (listp (car gnus-post-method))
+ gnus-post-method
+ (list gnus-post-method)))
+ gnus-secondary-select-methods
+ (list gnus-select-method)
+ (list group-method)))
+ method-alist post-methods method)
+ ;; Weed out all mail methods.
+ (while methods
+ (setq method (gnus-server-get-method "" (pop methods)))
+ (when (or (gnus-method-option-p method 'post)
+ (gnus-method-option-p method 'post-mail))
+ (push method post-methods)))
+ ;; Create a name-method alist.
+ (setq method-alist
+ (mapcar
+ (lambda (m)
+ (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
+ post-methods))
+ ;; Query the user.
+ (cadr
+ (assoc
+ (setq gnus-last-posting-server
+ (if (and silent
+ gnus-last-posting-server)
+ ;; Just use the last value.
+ gnus-last-posting-server
+ (completing-read
+ "Posting method: " method-alist nil t
+ (cons (or gnus-last-posting-server "") 0))))
+ method-alist))))
+ ;; Override normal method.
+ (gnus-post-method
+ gnus-post-method)
+ ;; Use the normal select method.
+ (t gnus-select-method))))
- (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)))
- (let ((conf gnus-prev-winconf))
- (bury-buffer)
- ;; Restore last window configuration.
- (and conf (set-window-configuration conf)))))
-
-(defun gnus-inews-check-post ()
- "Check whether the post looks ok."
- (or
- (not gnus-check-before-posting)
- (and
- ;; We narrow to the headers and check them first.
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (narrow-to-region
- (point)
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")))
- (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)))
- ;; 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))
- (save-excursion
- (or (re-search-forward
- (concat "^" (setq found
- (buffer-substring
- (match-beginning 0)
- (- (match-end 0) 2))))
- nil t)
- (setq found nil))))
- (if found
- (gnus-y-or-n-p
- (format "Multiple %s headers. Really post? " found))
- t))))
- ;; 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
- (format "The article contains a %s command. Really post? "
- (buffer-substring (match-beginning 0)
- (1- (match-end 0)))))
- t)))
- ;; Check the Message-Id header.
- (or (gnus-check-before-posting 'message-id)
- (save-excursion
- (let* ((case-fold-search t)
- (message-id (mail-fetch-field "message-id")))
- (or (not message-id)
- (and (string-match "@" message-id)
- (string-match "@[^\\.]*\\." message-id))
- (gnus-yes-or-no-p
- (format
- "The Message-ID looks strange: \"%s\". Really post? "
- message-id))))))
- ;; Check the From header.
- (or (gnus-check-before-posting 'from)
- (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)))))))))
- ;; Check for long lines.
- (or (gnus-check-before-posting 'long-lines)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (while (and
- (progn
- (end-of-line)
- (< (current-column) 80))
- (zerop (forward-line 1))))
- (or (bolp)
- (eobp)
- (gnus-yes-or-no-p
- (format
- "You have lines longer than 79 characters. Really post? ")))))
- ;; Check for control characters.
- (or (gnus-check-before-posting 'control-chars)
- (save-excursion
- (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
- (gnus-y-or-n-p
- "The article contains control characters. Really post? ")
- t)))
- ;; Check excessive size.
- (or (gnus-check-before-posting 'size)
- (if (> (buffer-size) 60000)
- (gnus-y-or-n-p
- (format "The article is %d octets long. Really post? "
- (buffer-size)))
- 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))
- ;; 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)
- (gnus-y-or-n-p
- (format
- "Your .sig is %d lines; it should be max 4. Really post? "))
- t)))))))
-
-(defun gnus-article-checksum ()
- (let ((sum 0))
- (save-excursion
- (while (not (eobp))
- (setq sum (logxor sum (following-char)))
- (forward-char 1)))
- sum))
-
-;; 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)))
-
-(defun gnus-cancel-news ()
- "Cancel an article you posted."
- (interactive)
- (if (or gnus-expert-user
- (gnus-yes-or-no-p "Do you really want to cancel this article? "))
- (let ((from nil)
- (newsgroups nil)
- (message-id nil)
- (distribution nil))
- (or (gnus-member-of-valid 'post gnus-newsgroup-name)
- (error "This backend does not support cancelling"))
- (save-excursion
- ;; Get header info. from original article.
- (save-restriction
- (gnus-article-show-all-headers)
- (goto-char (point-min))
- (search-forward "\n\n" nil 'move)
- (narrow-to-region (point-min) (point))
- (setq from (mail-fetch-field "from"))
- (setq newsgroups (mail-fetch-field "newsgroups"))
- (setq message-id (mail-fetch-field "message-id"))
- (setq distribution (mail-fetch-field "distribution")))
- ;; Verify if the article is absolutely user's by comparing
- ;; user id with value of its From: field.
- (if (not
- (string-equal
- (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."))
- ;; Make control article.
- (set-buffer (get-buffer-create " *Gnus-canceling*"))
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (insert "Newsgroups: " newsgroups "\n"
- "Subject: cancel " message-id "\n"
- "Control: cancel " message-id "\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)))))))
+;;;
+;;; Check whether the message has been sent already.
+;;;
+
+(defvar gnus-inews-sent-ids nil)
+
+(defun gnus-inews-reject-message ()
+ "Check whether this message has already been sent."
+ (when gnus-sent-message-ids-file
+ (let ((message-id (save-restriction (message-narrow-to-headers)
+ (mail-fetch-field "message-id")))
+ end)
+ (when message-id
+ (unless gnus-inews-sent-ids
+ (ignore-errors
+ (load t t t)))
+ (if (member message-id gnus-inews-sent-ids)
+ ;; Reject this message.
+ (not (gnus-yes-or-no-p
+ (format "Message %s already sent. Send anyway? "
+ message-id)))
+ (push message-id gnus-inews-sent-ids)
+ ;; Chop off the last Message-IDs.
+ (when (setq end (nthcdr gnus-sent-message-ids-length
+ gnus-inews-sent-ids))
+ (setcdr end nil))
+ (nnheader-temp-write gnus-sent-message-ids-file
+ (gnus-prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids)))
+ nil)))))
\f
-;;; Lowlevel inews interface
-
-(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*")))
- (widen)
- (goto-char (point-max))
- ;; require a newline at the end for inews to append .signature to
- (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-remove-headers)
- (gnus-inews-insert-headers)
- (run-hooks gnus-inews-article-header-hook)
- (widen))
- ;; Check whether the article is a good Net Citizen.
- (if (and gnus-article-check-size
- (not (gnus-inews-check-post)))
- ;; Aber nein!
- ()
- ;; Looks ok, so we do the nasty.
- (save-excursion
- (set-buffer tmpbuf)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (insert-buffer-substring artbuf)
- ;; Remove the header separator.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (replace-match "" t t)
- ;; This hook may insert a signature.
- (run-hooks 'gnus-prepare-article-hook)
- ;; 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)))))))
-
-(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 ()
- "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)
- ;; 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)
- (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")
- (get-buffer gnus-article-buffer))
- (let ((psubject (gnus-simplify-subject-re
- (mail-fetch-field "subject"))))
- (or (and psubject gnus-reply-subject
- (string= (gnus-simplify-subject-re gnus-reply-subject)
- psubject))
- (progn
- (string-match "@" Message-ID)
- (setq Message-ID
- (concat (substring Message-ID 0 (match-beginning 0))
- "_-_"
- (substring Message-ID (match-beginning 0))))))))
- ;; Go through all the required headers and see if they are in the
- ;; articles already. If they are not, or are empty, they are
- ;; inserted automatically - except for Subject, Newsgroups and
- ;; Distribution.
- (while headers
- (goto-char (point-min))
- (setq elem (car 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.
- (if (bolp)
- (save-excursion
- (goto-char (point-max))
- (insert (symbol-name header) ": " value "\n"))
- (replace-match value t t))))
- (setq headers (cdr headers)))))
-
-(defun gnus-inews-insert-signature ()
- "Insert a signature file.
-If `gnus-signature-function' is bound and returns a string, this
-string is used instead of the variable `gnus-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
-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)
- (if (and signature
- (or (file-exists-p signature)
- (string-match " " signature)
- (not (string-match
- "^/[^/]+/" (expand-file-name signature)))))
- (progn
- (goto-char (point-max))
- (if (and mail-signature (search-backward "\n-- \n" nil t))
- ()
- ;; Delete any previous signatures.
- (if (search-backward "\n-- \n" nil t)
- (delete-region (1+ (point)) (point-max)))
- (insert "\n-- \n")
- (if (file-exists-p signature)
- (insert-file-contents signature)
- (insert signature))
- (goto-char (point-max))
- (or (bolp) (insert "\n"))))))))
-
-(defun gnus-inews-do-fcc ()
- "Process FCC: fields in current article 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
-a program specified by the rest of the value."
- (let ((fcc-list nil)
- (fcc-file nil)
- (case-fold-search t)) ;Should ignore case.
- (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))))
- ;; 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))))))))))
-
-(defun gnus-inews-path ()
- "Return uucp path."
- (let ((login-name (gnus-inews-login-name)))
- (cond ((null gnus-use-generic-path)
- (concat (nth 1 gnus-select-method) "!" login-name))
- ((stringp gnus-use-generic-path)
- ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com.
- (concat gnus-use-generic-path "!" login-name))
- (t login-name))))
-
-(defun gnus-inews-user-name ()
- "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"."
- (let ((full-name (gnus-inews-full-name)))
- (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)
- ;; User's full name.
- (cond ((string-equal full-name "") "")
- ((string-equal full-name "&") ;Unix hack.
- (concat " (" (user-login-name) ")"))
- (t
- (concat " (" full-name ")")))))))
-
-(defun gnus-inews-login-name ()
- "Return login name."
- (or gnus-user-login-name (getenv "LOGNAME") (user-login-name)))
-
-(defun gnus-inews-full-name ()
- "Return full user name."
- (or gnus-user-full-name (getenv "NAME") (user-full-name)))
-
-(defun gnus-inews-domain-name (&optional genericfrom)
- "Return user's domain name.
-If optional argument GENERICFROM is a string, use it as the domain
-name; if it is non-nil, strip off local host name from the domain name.
-If the function `system-name' returns full internet name and the
-domain is undefined, the domain name is got from it."
- (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
- (let* ((system-name (system-name))
- (domain
- (or (if (stringp genericfrom) genericfrom)
- (getenv "DOMAINNAME")
- 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)))
- (read-string "Domain name (no host): ")))
- (host (or (if (string-match "\\." system-name)
- (substring system-name 0 (match-beginning 0)))
- system-name)))
- (if (string-equal "." (substring domain 0 1))
- (setq domain (substring domain 1)))
- ;; Support GENERICFROM as same as standard Bnews system.
- ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
- (cond ((null genericfrom)
- (concat host "." domain))
- ;;((stringp genericfrom) genericfrom)
- (t domain)))
- (if (string-match "\\." (system-name))
- (system-name)
- (substring user-mail-address
- (1+ (string-match "@" user-mail-address))))))
-
-(defun gnus-inews-full-address ()
- (let ((domain (gnus-inews-domain-name))
- (system (system-name))
- (case-fold-search t))
- (if (string-match "\\." system) system
- (if (string-match (concat "^" (regexp-quote system)) domain) domain
- (concat system "." domain)))))
-
-(defun gnus-inews-message-id ()
- "Generate unique Message-ID for user."
- ;; Message-ID should not contain a slash and should be terminated by
- ;; a number. I don't know the reason why it is so.
- (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">"))
-
-(defvar gnus-unique-id-char nil)
-
-;; If you ever change this function, make sure the new version
-;; cannot generate IDs that the old version could.
-;; You might for example insert a "." somewhere (not next to another dot
-;; or string boundary), or modify the newsreader name to "Ding".
-(defun gnus-inews-unique-id ()
- ;; Dont use microseconds from (current-time), they may be unsupported.
- ;; Instead we use this randomly inited counter.
- (setq gnus-unique-id-char
- (% (1+ (or gnus-unique-id-char (logand (random t) (1- (lsh 1 20)))))
- ;; (current-time) returns 16-bit ints,
- ;; and 2^16*25 just fits into 4 digits i base 36.
- (* 25 25)))
- (let ((tm (if (fboundp 'current-time)
- (current-time) '(12191 46742 287898))))
- (concat
- (if (memq system-type '(ms-dos emx vax-vms))
- (let ((user (downcase (gnus-inews-login-name))))
- (while (string-match "[^a-z0-9_]" user)
- (aset user (match-beginning 0) ?_))
- user)
- (gnus-number-base36 (user-uid) -1))
- (gnus-number-base36 (+ (car tm) (lsh (% gnus-unique-id-char 25) 16)) 4)
- (gnus-number-base36 (+ (nth 1 tm) (lsh (/ gnus-unique-id-char 25) 16)) 4)
- ;; Append the newsreader name, because while the generated
- ;; ID is unique to this newsreader, other newsreaders might
- ;; otherwise generate the same ID via another algorithm.
- ".fsf")))
-
-
-(defun gnus-inews-date ()
- "Current time string."
- (timezone-make-date-arpa-standard
- (current-time-string) (current-time-zone)))
-
-(defun gnus-inews-organization ()
- "Return user's organization.
-The ORGANIZATION environment variable is used if defined.
-If not, the variable `gnus-local-organization' is used instead.
-If it is a function, the function will be called with the current
-newsgroup name as the argument.
-If this is a file name, the contents of this file will be used as the
-organization."
- (let* ((organization
- (or (getenv "ORGANIZATION")
- (if gnus-local-organization
- (if (and (symbolp gnus-local-organization)
- (fboundp gnus-local-organization))
- (funcall gnus-local-organization gnus-newsgroup-name)
- gnus-local-organization))
- gnus-organization-file
- "~/.organization")))
- (and (stringp organization)
- (> (length organization) 0)
- (or (file-exists-p organization)
- (string-match " " organization)
- (not (string-match "^/usr/lib/" organization)))
- (save-excursion
- (gnus-set-work-buffer)
- (if (file-exists-p organization)
- (insert-file-contents organization)
- (insert organization))
- (goto-char (point-min))
- (while (re-search-forward " *\n *" nil t)
- (replace-match " " t t))
- (buffer-substring (point-min) (point-max))))))
-(defun gnus-inews-lines ()
- "Count the number of lines and return numeric string."
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (int-to-string (count-lines (point) (point-max))))))
+;; Dummy to avoid byte-compile warning.
+(defvar nnspool-rejected-article-hook)
+
+;;; 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]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
+ emacs-version)
+ (concat (substring emacs-version
+ (match-beginning 1)
+ (match-end 1))
+ (format " %d.%d" emacs-major-version emacs-minor-version)
+ (if (match-beginning 3)
+ (substring emacs-version
+ (match-beginning 3)
+ (match-end 3))
+ "")))
+ (t emacs-version))))
+
+;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>.
+(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 ((save-restriction
+ (widen)
+ (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")))))))
\f
;;;
-;;; Gnus Mail Functions
+;;; Gnus Mail Functions
;;;
;;; Mail reply commands of Gnus summary mode
-(defun gnus-summary-reply (yank &optional yank-articles)
- "Reply mail to news author.
-If prefix argument YANK is non-nil, original article is yanked automatically.
-Customize the variable gnus-mail-reply-method to use another mailer."
- (interactive "P")
- ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
+(defun gnus-summary-reply (&optional yank wide)
+ "Start composing a reply mail to the current message.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
;; 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))
-
-(defun gnus-summary-reply-with-original (n)
- "Reply mail to news author with original article.
-Customize the variable gnus-mail-reply-method to use another mailer."
+ (when yank
+ (gnus-summary-goto-subject (car yank)))
+ (let ((gnus-article-reply t))
+ (gnus-setup-message (if yank 'reply-yank 'reply)
+ (gnus-summary-select-article)
+ (set-buffer (gnus-copy-article-buffer))
+ (message-reply nil wide (gnus-group-find-parameter
+ gnus-newsgroup-name 'broken-reply-to))
+ (when yank
+ (gnus-inews-yank-articles yank)))))
+
+(defun gnus-summary-reply-with-original (n &optional wide)
+ "Start composing a reply mail to the current message.
+The original article will be yanked."
+ (interactive "P")
+ (gnus-summary-reply (gnus-summary-work-articles n) wide))
+
+(defun gnus-summary-wide-reply (&optional yank)
+ "Start composing a wide reply mail to the current message.
+If prefix argument YANK is non-nil, the original article is yanked
+automatically."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnus-summary-reply yank t))
+
+(defun gnus-summary-wide-reply-with-original (n)
+ "Start composing a wide reply mail to the current message.
+The original article will be yanked."
(interactive "P")
- (gnus-summary-reply t (gnus-summary-work-articles n)))
+ (gnus-summary-reply-with-original n t))
-(defun gnus-summary-mail-forward (post)
+(defun gnus-summary-mail-forward (&optional full-headers post)
"Forward the current message to another user.
-Customize the variable gnus-mail-forward-method to use another mailer."
+If FULL-HEADERS (the prefix), include full headers when forwarding."
(interactive "P")
(gnus-set-global-variables)
- (gnus-summary-select-article t)
- (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))
-
-(defun gnus-summary-post-forward ()
- "Forward the current article to a newsgroup."
- (interactive)
- (gnus-summary-mail-forward t))
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (set-buffer gnus-original-article-buffer)
+ (let ((message-included-forward-headers
+ (if full-headers "" message-included-forward-headers)))
+ (message-forward post))))
+
+(defun gnus-summary-resend-message (address n)
+ "Resend the current article to ADDRESS."
+ (interactive "sResend message(s) to: \nP")
+ (let ((articles (gnus-summary-work-articles n))
+ article)
+ (while (setq article (pop articles))
+ (gnus-summary-select-article nil nil nil article)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (message-resend address)))))
+
+(defun gnus-summary-post-forward (&optional full-headers)
+ "Forward the current article to a newsgroup.
+If FULL-HEADERS (the prefix), include full headers when forwarding."
+ (interactive "P")
+ (gnus-summary-mail-forward full-headers t))
-(defvar gnus-nastygram-message
- "The following article was inappropriately posted to %s.\n"
+(defvar gnus-nastygram-message
+ "The following article was inappropriately posted to %s.\n\n"
"Format string to insert in nastygrams.
The current group name will be inserted at \"%s\".")
(defun gnus-summary-mail-nastygram (n)
"Send a nastygram to the author of the current article."
(interactive "P")
- (if (or gnus-expert-user
- (gnus-y-or-n-p
- "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*")
- (insert (format gnus-nastygram-message group))
- (gnus-mail-send-and-exit))))
+ (when (or gnus-expert-user
+ (gnus-y-or-n-p
+ "Really send a nastygram to the author of the current article? "))
+ (let ((group gnus-newsgroup-name))
+ (gnus-summary-reply-with-original n)
+ (set-buffer gnus-message-buffer)
+ (message-goto-body)
+ (insert (format gnus-nastygram-message group))
+ (message-send-and-exit))))
+
+(defun gnus-summary-mail-crosspost-complaint (n)
+ "Send a complaint about crossposting to the current article(s)."
+ (interactive "P")
+ (let ((articles (gnus-summary-work-articles n))
+ article)
+ (while (setq article (pop articles))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-goto-subject article)
+ (let ((group (gnus-group-real-name gnus-newsgroup-name))
+ newsgroups followup-to)
+ (gnus-summary-select-article)
+ (set-buffer gnus-original-article-buffer)
+ (if (and (<= (length (message-tokenize-header
+ (setq newsgroups (mail-fetch-field "newsgroups"))
+ ", "))
+ 1)
+ (or (not (setq followup-to (mail-fetch-field "followup-to")))
+ (not (member group (message-tokenize-header
+ followup-to ", ")))))
+ (if followup-to
+ (gnus-message 1 "Followup-to restricted")
+ (gnus-message 1 "Not a crossposted article"))
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-reply-with-original 1)
+ (set-buffer gnus-message-buffer)
+ (message-goto-body)
+ (insert (format gnus-crosspost-complaint newsgroups group))
+ (message-goto-subject)
+ (re-search-forward " *$")
+ (replace-match " (crosspost notification)" t t)
+ (when (gnus-y-or-n-p "Send this complaint? ")
+ (message-send-and-exit)))))))
(defun gnus-summary-mail-other-window ()
- "Compose mail in other window.
-Customize the variable `gnus-mail-other-window-method' to use another
-mailer."
- (interactive)
- (gnus-set-global-variables)
- (let ((gnus-newsgroup-name gnus-newsgroup-name))
- (funcall gnus-mail-other-window-method)))
-
-(defun gnus-mail-reply-using-mail (&optional yank to-address)
- (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))
- (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*"))
- (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? ")))
- ()
- (erase-buffer)
- (save-excursion
- (gnus-copy-article-buffer)
- (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)))
- (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))))
- (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 cc (mail-fetch-field "cc"))
- (setq reply-to (mail-fetch-field "reply-to"))
- (setq references (mail-fetch-field "references"))
- (setq message-id (mail-fetch-field "message-id"))
- (widen))
- (setq news-reply-yank-from (or from "(nobody)")))
- (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 "To" follow-to))
- (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)
-
- (if (and follow-to (listp follow-to))
- (progn
- (goto-char (point-min))
- (re-search-forward "^To:" nil t)
- (beginning-of-line)
- (forward-line 1)
- (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))))
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (if (not yank)
- (gnus-configure-windows 'reply)
- (let ((last (point))
- end)
- (if (not (listp yank))
- (progn
- (save-excursion
- (mail-yank-original nil))
- (or mail-yank-hooks mail-citation-hook
- (run-hooks 'news-reply-header-hook)))
- (while yank
- (save-window-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-select-article nil nil nil (car yank))
- (gnus-summary-remove-process-mark (car yank)))
- (save-excursion
- (gnus-copy-article-buffer)
- (mail-yank-original nil)
- (setq end (point)))
- (or mail-yank-hooks mail-citation-hook
- (run-hooks 'news-reply-header-hook))
- (goto-char end)
- (setq yank (cdr yank))))
- (goto-char last))
- (gnus-configure-windows 'reply-yank))
- (run-hooks 'gnus-mail-hook)))))
-
-(defun gnus-mail-yank-original ()
+ "Compose mail in other window."
(interactive)
- (save-excursion
- (mail-yank-original nil))
- (or mail-yank-hooks mail-citation-hook
- (run-hooks 'news-reply-header-hook)))
-
-(defun gnus-mail-send-and-exit ()
+ (gnus-setup-message 'message
+ (message-mail)))
+
+(defun gnus-mail-parse-comma-list ()
+ (let (accumulated
+ beg)
+ (skip-chars-forward " ")
+ (while (not (eobp))
+ (setq beg (point))
+ (skip-chars-forward "^,")
+ (while (zerop
+ (save-excursion
+ (save-restriction
+ (let ((i 0))
+ (narrow-to-region beg (point))
+ (goto-char beg)
+ (logand (progn
+ (while (search-forward "\"" nil t)
+ (incf i))
+ (if (zerop i) 2 i))
+ 2)))))
+ (skip-chars-forward ",")
+ (skip-chars-forward "^,"))
+ (skip-chars-backward " ")
+ (push (buffer-substring beg (point))
+ accumulated)
+ (skip-chars-forward "^,")
+ (skip-chars-forward ", "))
+ accumulated))
+
+(defun gnus-inews-add-to-address (group)
+ (let ((to-address (mail-fetch-field "to")))
+ (when (and to-address
+ (gnus-alive-p))
+ ;; This mail group doesn't have a `to-list', so we add one
+ ;; here. Magic!
+ (when (gnus-y-or-n-p
+ (format "Do you want to add this as `to-list': %s " to-address))
+ (gnus-group-add-parameter group (cons 'to-list to-address))))))
+
+(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)
- (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))))))
+ (winconf gnus-prev-winconf)
+ (group gnus-newsgroup-name))
+
+ (or (and group (not (gnus-group-read-only-p group)))
+ (setq group (read-string "Put in group: " nil
+ (gnus-writable-groups))))
+ (when (gnus-gethash group gnus-newsrc-hashtb)
+ (error "No such group: %s" group))
-(defun gnus-forward-make-subject (buffer)
- (save-excursion
- (set-buffer buffer)
- (concat "[" (if (memq 'mail (assoc (symbol-name
- (car (gnus-find-method-for-group
- gnus-newsgroup-name)))
- gnus-valid-select-methods))
- (gnus-fetch-field "From")
- 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)
- "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
- (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)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf)
- (run-hooks 'gnus-mail-hook)))
+ (save-restriction
+ (widen)
+ (message-narrow-to-headers)
+ (let (gnus-deletable-headers)
+ (if (message-news-p)
+ (message-generate-headers message-required-news-headers)
+ (message-generate-headers message-required-mail-headers)))
+ (goto-char (point-max))
+ (insert "Gcc: " group "\n")
+ (widen)))
+
+ (gnus-inews-do-gcc)
+
+ (when (get-buffer gnus-group-buffer)
+ (when (gnus-buffer-exists-p (car-safe reply))
+ (set-buffer (car reply))
+ (and (cdr reply)
+ (gnus-summary-mark-article-as-replied
+ (cdr reply))))
+ (when winconf
+ (set-window-configuration winconf)))))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
If YANK is non-nil, include the original article."
(interactive "P")
- (let ((address
+ (let ((address
(buffer-substring
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
- (and address
- (progn
- (switch-to-buffer gnus-summary-buffer)
- (funcall gnus-mail-reply-method yank address)))))
+ (when address
+ (message-reply address)
+ (when yank
+ (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
+
+(defvar nntp-server-type)
+(defun gnus-bug ()
+ "Send a bug report to the Gnus maintainers."
+ (interactive)
+ (unless (gnus-alive-p)
+ (error "Gnus has been shut down"))
+ (gnus-setup-message 'bug
+ (delete-other-windows)
+ (switch-to-buffer "*Gnus Help Bug*")
+ (erase-buffer)
+ (insert gnus-bug-message)
+ (goto-char (point-min))
+ (message-pop-to-buffer "*Gnus Bug*")
+ (message-setup `((To . ,gnus-maintainer) (Subject . "")))
+ (push `(gnus-bug-kill-buffer) message-send-actions)
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+ (forward-line 1)
+ (insert (gnus-version) "\n")
+ (insert (emacs-version) "\n")
+ (when (and (boundp 'nntp-server-type)
+ (stringp nntp-server-type))
+ (insert nntp-server-type))
+ (insert "\n\n\n\n\n")
+ (gnus-debug)
+ (goto-char (point-min))
+ (search-forward "Subject: " nil t)
+ (message "")))
-(defun gnus-article-mail-with-original ()
- "Send a reply to the address near point and include the original article."
+(defun gnus-bug-kill-buffer ()
+ (when (get-buffer "*Gnus Help Bug*")
+ (kill-buffer "*Gnus Help Bug*")))
+
+(defun gnus-debug ()
+ "Attempts to go through the Gnus source file and report what variables have been changed.
+The source file has to be in the Emacs load path."
(interactive)
- (gnus-article-mail 'yank))
+ (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el"
+ "gnus-art.el" "gnus-start.el" "gnus-async.el"
+ "gnus-msg.el" "gnus-score.el" "gnus-win.el"
+ "nnmail.el" "message.el"))
+ file expr olist sym)
+ (gnus-message 4 "Please wait while we snoop your variables...")
+ (sit-for 0)
+ ;; Go through all the files looking for non-default values for variables.
+ (save-excursion
+ (set-buffer (get-buffer-create " *gnus bug info*"))
+ (buffer-disable-undo (current-buffer))
+ (while files
+ (erase-buffer)
+ (when (and (setq file (locate-library (pop files)))
+ (file-exists-p file))
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (if (not (re-search-forward "^;;* *Internal variables" nil t))
+ (gnus-message 4 "Malformed sources in file %s" file)
+ (narrow-to-region (point-min) (point))
+ (goto-char (point-min))
+ (while (setq expr (ignore-errors (read (current-buffer))))
+ (ignore-errors
+ (and (or (eq (car expr) 'defvar)
+ (eq (car expr) 'defcustom))
+ (stringp (nth 3 expr))
+ (or (not (boundp (nth 1 expr)))
+ (not (equal (eval (nth 2 expr))
+ (symbol-value (nth 1 expr)))))
+ (push (nth 1 expr) olist)))))))
+ (kill-buffer (current-buffer)))
+ (when (setq olist (nreverse olist))
+ (insert "------------------ Environment follows ------------------\n\n"))
+ (while olist
+ (if (boundp (car olist))
+ (condition-case ()
+ (pp `(setq ,(car olist)
+ ,(if (or (consp (setq sym (symbol-value (car olist))))
+ (and (symbolp sym)
+ (not (or (eq sym nil)
+ (eq sym t)))))
+ (list 'quote (symbol-value (car olist)))
+ (symbol-value (car olist))))
+ (current-buffer))
+ (error
+ (format "(setq %s 'whatever)\n" (car olist))))
+ (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 (&optional 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)
+ (set-buffer gnus-original-article-buffer)
+ (gnus-setup-message 'compose-bounce
+ (let* ((references (mail-fetch-field "references"))
+ (parent (and references (gnus-parent-id references))))
+ (message-bounce)
+ ;; If there are references, we fetch the article we answered to.
+ (and fetch parent
+ (gnus-summary-refer-article parent)
+ (gnus-summary-show-all-headers)))))
+
+;;; Gcc handling.
+
+;; Do Gcc handling, which copied the message over to some group.
+(defun gnus-inews-do-gcc (&optional gcc)
+ (interactive)
+ (when (gnus-alive-p)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
+ (cur (current-buffer))
+ groups group method)
+ (when gcc
+ (message-remove-header "gcc")
+ (widen)
+ (setq groups (message-tokenize-header gcc " ,"))
+ ;; Copy the article over to some group(s).
+ (while (setq group (pop groups))
+ (gnus-check-server
+ (setq method
+ (cond ((and (null (gnus-get-info group))
+ (eq (car gnus-message-archive-method)
+ (car
+ (gnus-server-to-method
+ (gnus-group-method group)))))
+ ;; If the group doesn't exist, we assume
+ ;; it's an archive group...
+ gnus-message-archive-method)
+ ;; Use the method.
+ ((gnus-info-method (gnus-get-info group))
+ (gnus-info-method (gnus-get-info group)))
+ ;; Find the method.
+ (t (gnus-group-method group)))))
+ (gnus-check-server method)
+ (unless (gnus-request-group group t method)
+ (gnus-request-create-group group method))
+ (save-excursion
+ (nnheader-set-temp-buffer " *acc*")
+ (insert-buffer-substring cur)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (replace-match "" t t ))
+ (unless (gnus-request-accept-article group method t)
+ (gnus-message 1 "Couldn't store article in group %s: %s"
+ group (gnus-status-message method))
+ (sit-for 2))
+ (kill-buffer (current-buffer))))))))))
+
+(defun gnus-inews-insert-gcc ()
+ "Insert Gcc headers based on `gnus-outgoing-message-group'."
+ (save-excursion
+ (save-restriction
+ (message-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 gcc) gcc
+ (mapconcat 'identity gcc " "))
+ "\n"))))))
+
+(defun gnus-inews-insert-archive-gcc (&optional group)
+ "Insert the Gcc to say where the article is to be archived."
+ (let* ((var gnus-message-archive-group)
+ (group (or group gnus-newsgroup-name ""))
+ result
+ gcc-self-val
+ (groups
+ (cond
+ ((null gnus-message-archive-method)
+ ;; Ignore.
+ nil)
+ ((stringp var)
+ ;; Just a single group.
+ (list var))
+ ((null var)
+ ;; We don't want this.
+ nil)
+ ((and (listp var) (stringp (car var)))
+ ;; A list of groups.
+ var)
+ ((gnus-functionp var)
+ ;; A function.
+ (funcall var group))
+ (t
+ ;; An alist of regexps/functions/forms.
+ (while (and var
+ (not
+ (setq result
+ (cond
+ ((stringp (caar var))
+ ;; Regexp.
+ (when (string-match (caar var) group)
+ (cdar var)))
+ ((gnus-functionp (car var))
+ ;; Function.
+ (funcall (car var) group))
+ (t
+ (eval (car var)))))))
+ (setq var (cdr var)))
+ result)))
+ name)
+ (when groups
+ (when (stringp groups)
+ (setq groups (list groups)))
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (goto-char (point-max))
+ (insert "Gcc: ")
+ (if (and gnus-newsgroup-name
+ (setq gcc-self-val
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'gcc-self)))
+ (progn
+ (insert
+ (if (stringp gcc-self-val)
+ gcc-self-val
+ group))
+ (if (not (eq gcc-self-val 'none))
+ (insert "\n")
+ (progn
+ (beginning-of-line)
+ (kill-line))))
+ (while (setq name (pop groups))
+ (insert (if (string-match ":" name)
+ name
+ (gnus-group-prefixed-name
+ name gnus-message-archive-method)))
+ (when groups
+ (insert " ")))
+ (insert "\n")))))))
+
+(defun gnus-summary-send-draft ()
+ "Enter a mail/post buffer to edit and send the draft."
+ (interactive)
+ (gnus-set-global-variables)
+ (let (buf)
+ (if (not (setq buf (gnus-request-restore-buffer
+ (gnus-summary-article-number) gnus-newsgroup-name)))
+ (error "Couldn't restore the article")
+ (switch-to-buffer buf)
+ (when (eq major-mode 'news-reply-mode)
+ (local-set-key "\C-c\C-c" 'gnus-inews-news))
+ ;; 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 t)
+ (goto-char (point))))))
+
+(gnus-add-shutdown 'gnus-inews-close 'gnus)
+
+(defun gnus-inews-close ()
+ (setq gnus-inews-sent-ids nil))
+
+;;; Allow redefinition of functions.
+
+(gnus-ems-redefine)
(provide 'gnus-msg)
projects / gnus / blobdiff