(require 'gnus)
(require 'sendmail)
+(require 'gnus-ems)
+(require 'rmail)
(defvar gnus-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
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
If the function returns nil, the `gnus-signature-file' variable will
be used instead.")
-(defvar gnus-signature-separator "^-- *$"
- "Regexp matching signature separator.")
-
(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.
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 Date)
+ "*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
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
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
;;; Internal variables.
(defvar gnus-post-news-buffer "*post-news*")
+(defvar gnus-mail-buffer "*mail*")
(defvar gnus-summary-send-map nil)
(defvar gnus-article-copy nil)
+(defvar gnus-reply-subject nil)
\f
;;;
;;; 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))
+
(defun gnus-group-post-news ()
"Post an article."
(interactive)
(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-get-header-by-number (gnus-summary-article-number)))
(gnus-newsgroup-name gnus-newsgroup-name))
;; Check Followup-To: poster.
(set-buffer gnus-article-buffer)
(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.
+ ;; Mail to the poster.
(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))
+ (or yank-articles (not (not yank)))))))
(defun gnus-summary-followup-with-original (n)
"Compose a followup to an article and include the original article."
(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)))
(let ((articles (gnus-summary-work-articles n)))
(while articles
(gnus-summary-select-article t nil nil (car articles))
+ (and (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))
+ (gnus-summary-mark-as-read (car articles) gnus-canceled-mark))
(gnus-summary-remove-process-mark (car articles))
- (gnus-summary-mark-as-read (car articles) gnus-canceled-mark)
- (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news))
(gnus-article-hide-headers-if-wanted)
(setq articles (cdr articles)))))
header line with the old Message-ID."
(interactive)
(gnus-set-global-variables)
+ (gnus-summary-select-article t)
(if (not
(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."))
- (gnus-summary-select-article t)
(save-excursion
(set-buffer gnus-article-buffer)
(let ((buffer-read-only nil))
(replace-match "Supersedes: " t t))
(search-forward "\n\n")
(forward-line -1)
- (insert mail-header-separator))))
+ (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))))
\f
;;;###autoload
-(fset 'sendnews 'gnus-post-news)
+(defalias 'sendnews 'gnus-post-news)
;;;###autoload
-(fset 'postnews 'gnus-post-news)
+(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
(buffer-name (get-buffer article-buffer)))
(save-excursion
(set-buffer article-buffer)
+ (widen)
(copy-to-buffer gnus-article-copy (point-min) (point-max))
(set-text-properties (point-min) (point-max)
nil gnus-article-copy)))))
(cons (current-buffer) gnus-current-article))))
(from (and header (header-from header)))
(winconf (current-window-configuration))
- follow-to real-group)
+ real-group)
(and gnus-interactive-post
(not gnus-expert-user)
post (not group)
(setq subject (read-string "Subject: ")))))
(setq mail-reply-buffer gnus-article-copy)
- (let ((gnus-newsgroup-name (or group gnus-newsgroup-name "")))
+ (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
(nth 2 (and group (gnus-gethash group gnus-newsrc-hashtb)))
(or (cdr (assq 'to-group
(nth 5 (nth 2 (gnus-gethash
- gnus-newsgroup-name
+ 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)))))
+ (save-excursion
+ (set-buffer gnus-article-copy)
+ (funcall gnus-followup-to-function group))))
gnus-use-followup-to))
(if post
- (gnus-configure-windows 'post)
+ (gnus-configure-windows 'post 'force)
(if yank
- (gnus-configure-windows 'followup-yank)
- (gnus-configure-windows 'followup)))
+ (gnus-configure-windows 'followup-yank 'force)
+ (gnus-configure-windows 'followup 'force)))
(gnus-overload-functions)
(make-local-variable 'gnus-article-reply)
(make-local-variable 'gnus-article-check-size)
+ (make-local-variable 'gnus-reply-subject)
+ (setq gnus-reply-subject (and header (header-subject header)))
(setq gnus-article-reply sumart)
;; Handle `gnus-auto-mail-to-author'.
;; Suggested by Daniel Quinlan <quinlan@best.com>.
- (let ((to (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))))
+ (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")
(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)))
+ (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)))
(interactive "P")
(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.
(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...")
(replace-match "" t t))
(funcall gnus-mail-send-method))
- (gnus-message 5 "Sending via mail... done")
+ (gnus-message 5 "Sending via mail...done")
(goto-char (point-min))
(narrow-to-region
(goto-char (point-max))
(insert fcc-line))))))))
- ;; Send to NNTP server.
+ ;; Send to server.
(gnus-message 5 "Posting to USENET...")
- (if (gnus-inews-article 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))
+ (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-select-method)))))
;; If NNTP server is opened by gnus-inews-news, close it by myself.
(or server-running
(gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name)))
- (bury-buffer)
- ;; Restore last window configuration.
- (and gnus-prev-winconf (set-window-configuration gnus-prev-winconf))))
+ (let ((conf gnus-prev-winconf))
+ (if (not error)
+ (progn
+ (bury-buffer)
+ ;; Restore last window configuration.
+ (and conf (set-window-configuration conf)))))))
(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
(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-yes-or-no-p "There is no From line. Really post? "))
+ ((not (string-match "@[^\\.]*\\." from))
+ (gnus-yes-or-no-p
+ (format
+ "The address looks strange: \"%s\". Really post? " from)))
+ ((string-match "(.*).*(.*)" from)
+ (gnus-yes-or-no-p
+ (format
+ "The From header looks strange: \"%s\". Really post? "
+ from)))
+ (t t)))))
+ )))
;; Check for long lines.
(or (gnus-check-before-posting 'long-lines)
(save-excursion
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-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
;; 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."
(message-id nil)
(distribution nil))
(or (gnus-member-of-valid 'post gnus-newsgroup-name)
- (error "This backend does not support cancelling"))
+ (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))
(insert "Newsgroups: " newsgroups "\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 (gnus-inews-article)
- (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
(defun gnus-inews-article (&optional use-group-method)
"Post an article in current buffer using NNTP protocol."
- ;; 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.
- (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))
+ (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!
+ 'illegal
+ ;; Looks ok, so we do the nasty.
(save-excursion
(set-buffer tmpbuf)
(buffer-disable-undo (current-buffer))
(headers gnus-required-headers)
(case-fold-search t)
header value elem)
- ;; First we remove any old Message-IDs. This might be slightly
- ;; fascist, but if the user really wants to generate Message-IDs
- ;; by herself, she should remove it from the `gnus-required-list'.
- (goto-char (point-min))
- (and (memq 'Message-ID headers)
- (re-search-forward "^Message-ID:" nil t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
- ;; 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"))))
+ ;; 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-beginning 0)) 'gnus-deletable)
+ (gnus-delete-line))
+ (setq headers (cdr headers))))
;; 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")))
- subject)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (gnus-narrow-to-headers)
- (if (setq subject (mail-fetch-field "subject"))
- (progn
- (and gnus-summary-gather-subject-limit
- (numberp gnus-summary-gather-subject-limit)
- (> (length subject) gnus-summary-gather-subject-limit)
- (setq subject
- (substring subject 0
- gnus-summary-gather-subject-limit)))
- (setq subject (gnus-simplify-subject-re subject))))))
- (or (and psubject subject (string= subject psubject))
+ (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
;; so we just ask the user.
(read-from-minibuffer
(format "Empty header for %s; enter value: " header))))
- (if (bolp)
- (save-excursion
- (goto-char (point-max))
- (insert (symbol-name header) ": " value "\n"))
- (replace-match value t t))))
- (setq headers (cdr headers)))))
+ ;; Finally insert the header.
+ (save-excursion
+ (if (bolp)
+ (progn
+ (goto-char (point-max))
+ (insert (symbol-name header) ": " value "\n")
+ (forward-line -1))
+ (replace-match value t t))
+ ;; 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))))))
+ (setq headers (cdr headers)))
+ ;; Insert new Sender if the From is strange.
+ (let ((from (mail-fetch-field "from")))
+ (if (and from (not (string=
+ (downcase (car (gnus-extract-address-components
+ from)))
+ (downcase (gnus-inews-real-user-address)))))
+ (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: " (gnus-inews-real-user-address) "\n"))))))
+
(defun gnus-inews-insert-signature ()
"Insert a signature file.
(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)
"^/[^/]+/" (expand-file-name signature)))))
(progn
(goto-char (point-max))
- ;; Delete any previous signatures.
(if (and mail-signature (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")))))))
+ ()
+ ;; Delete any previous signatures.
+ (if (search-backward "\n-- \n" nil t)
+ (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 ()
+ (let ((mail-header-separator ""))
+ (or (mail-position-on-field "Mime-Version")
+ (insert "1.0")
+ (cond ((save-excursion
+ (beginning-of-buffer)
+ (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.
(t
;; Suggested by hyoko@flab.fujitsu.junet.
;; Save article in Unix mail format by default.
- (gnus-make-directory fcc-file)
+ (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)
(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)))
"~/.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)
;; 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)
+ (gnus-summary-select-article)
(let ((gnus-newsgroup-name gnus-newsgroup-name))
(bury-buffer gnus-article-buffer)
- (funcall gnus-mail-reply-method (or yank-articles (not (not yank)))))
- (gnus-article-hide-headers-if-wanted))
+ (funcall gnus-mail-reply-method (or yank-articles (not (not yank))))))
(defun gnus-summary-reply-with-original (n)
"Reply mail to news author with original article.
"Forward the current message to another user.
Customize the variable gnus-mail-forward-method to use another mailer."
(interactive "P")
- (gnus-summary-select-article t)
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
(gnus-copy-article-buffer)
(let ((gnus-newsgroup-name gnus-newsgroup-name))
(if post
(gnus-forward-using-post gnus-article-copy)
- (funcall gnus-mail-forward-method gnus-article-copy)))
- (gnus-article-hide-headers-if-wanted))
+ (funcall gnus-mail-forward-method gnus-article-copy))))
(defun gnus-summary-post-forward ()
"Forward the current article to a newsgroup."
(interactive)
(gnus-summary-mail-forward t))
+(defvar gnus-nastygram-message
+ "The following article was inappropriately posted to %s.\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 gnus-mail-buffer)
+ (insert (format gnus-nastygram-message group))
+ (gnus-mail-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))
+ (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
+ references message-id sender follow-to sendto elt)
+ (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
(erase-buffer)
(save-excursion
(gnus-copy-article-buffer)
- (set-buffer gnus-article-copy)
- (if (and (boundp 'gnus-reply-to-function)
- gnus-reply-to-function)
- (save-excursion
- (save-restriction
- (gnus-narrow-to-headers)
- (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")))
- (setq news-reply-yank-from (or from "(nobody)"))
+ (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 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)"))
(or follow-to reply-to from sender "")))
subject message-of nil gnus-article-copy nil)
+ (use-local-map (copy-keymap mail-mode-map))
+ (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit)
+
(if (and follow-to (listp follow-to))
(progn
(goto-char (point-min))
(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
(save-excursion
(mail-yank-original nil))
- (run-hooks 'news-reply-header-hook))
+ (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)))
- (run-hooks 'news-reply-header-hook)
+ (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))
+ (gnus-configure-windows 'reply-yank 'force))
(run-hooks 'gnus-mail-hook)))))
(defun gnus-mail-yank-original ()
(interactive)
(save-excursion
(mail-yank-original nil))
- (run-hooks 'news-reply-header-hook))
+ (or mail-yank-hooks mail-citation-hook
+ (run-hooks 'news-reply-header-hook)))
(defun gnus-mail-send-and-exit ()
(interactive)
(gnus-forward-insert-buffer forward-buffer)
(goto-char (point-min))
(re-search-forward "^To: " nil t)
- (gnus-configure-windows 'mail-forward)
+ (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)
(let* ((forward-buffer (or buffer (current-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)))
+ (setq gnus-prev-winconf winconf)
+ (run-hooks 'gnus-mail-hook)
+ (gnus-configure-windows 'summary-mail 'force)))
(defun gnus-article-mail (yank)
"Send a reply to the address near point.
(interactive)
(gnus-article-mail 'yank))
+(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)
+ (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-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)))
+ (let ((b (point)))
+ (gnus-debug)
+ (goto-char (- b 3)))
+ (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-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)
+ (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el"))
+ file dirs expr olist)
+ (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")
+ (while olist
+ (if (boundp (car olist))
+ (insert "(setq " (symbol-name (car olist)) " '"
+ (prin1-to-string (symbol-value (car olist))) ")\n")
+ (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
+ (setq olist (cdr olist)))
+ (insert "\n\n")))
+
+(gnus-ems-redefine)
+
(provide 'gnus-msg)
;;; gnus-msg.el ends here
projects / gnus / blobdiff