(autoload 'mh-send-letter "mh-comp")
(autoload 'gnus-point-at-eol "gnus-util")
(autoload 'gnus-point-at-bol "gnus-util")
+ (autoload 'gnus-output-to-rmail "gnus-util")
(autoload 'gnus-output-to-mail "gnus-util")
(autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
(autoload 'nndraft-request-associate-buffer "nndraft")
(autoload 'gnus-open-server "gnus-int")
(autoload 'gnus-request-post "gnus-int")
(autoload 'gnus-alive-p "gnus-util")
+ (autoload 'gnus-list-identifiers "gnus-sum")
(autoload 'rmail-output "rmail"))
\f
(and (listp form) (eq (car form) 'lambda))
(byte-code-function-p form)))
+(defun message-strip-list-identifiers (subject)
+ "Remove list identifiers in `gnus-list-identifiers'."
+ (let ((regexp (if (stringp gnus-list-identifiers)
+ gnus-list-identifiers
+ (mapconcat 'identity gnus-list-identifiers " *\\|"))))
+ (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
+ " *\\)\\)+\\(Re: +\\)?\\)") subject)
+ (concat (substring subject 0 (match-beginning 1))
+ (or (match-string 3 subject)
+ (match-string 5 subject))
+ (substring subject
+ (match-end 1)))
+ subject)))
+
(defun message-strip-subject-re (subject)
"Remove \"Re:\" from subject lines."
(if (string-match message-subject-re-regexp subject)
C-c C-a mml-attach-file (attach a file as MIME).
M-RET message-newline-and-reformat (break the line and reformat)."
(interactive)
+ (if (local-variable-p 'mml-buffer-list (current-buffer))
+ (mml-destroy-buffers))
(kill-all-local-variables)
(set (make-local-variable 'message-reply-buffer) nil)
(make-local-variable 'message-send-actions)
(goto-char (point-max))
(goto-char (+ p message-send-mail-partially-limit))
(beginning-of-line)
- (if (<= (point) p) (end-of-line))) ;; In case of bad message.
+ (if (<= (point) p) (forward-line 1))) ;; In case of bad message.
(push p plist)
(setq p (point)))
(setq total (length plist))
(insert header)
(message-remove-header "Mime-Version")
(message-remove-header "Content-Type")
+ (message-remove-header "Content-Transfer-Encoding")
(message-remove-header "Message-ID")
(message-remove-header "Lines")
(goto-char (point-max))
(goto-char (point-max))
(insert "\n")
(widen)
- (funcall message-send-mail-function))
+ (mm-with-unibyte-current-buffer
+ (funcall message-send-mail-function)))
(setq n (+ n 1))
(setq p (pop plist))
(erase-buffer)))
(message-generate-headers '(Lines)))
;; Remove some headers.
(message-remove-header message-ignored-mail-headers t)
- (mail-encode-encoded-word-buffer))
+ (let ((mail-parse-charset message-default-charset))
+ (mail-encode-encoded-word-buffer)))
(goto-char (point-max))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(if (or (not message-send-mail-partially-limit)
(< (point-max) message-send-mail-partially-limit)
(not (y-or-n-p "The message size is too large, should it be sent partially?")))
- (funcall message-send-mail-function)
+ (mm-with-unibyte-current-buffer
+ (funcall message-send-mail-function))
(message-send-mail-partially)))
(kill-buffer tembuf))
(set-buffer mailbuf)
(method (if (message-functionp message-post-method)
(funcall message-post-method arg)
message-post-method))
+ (group-name-charset (gnus-group-name-charset method ""))
+ (rfc2047-header-encoding-alist
+ (if group-name-charset
+ (cons (cons "Newsgroups" group-name-charset)
+ rfc2047-header-encoding-alist)
+ rfc2047-header-encoding-alist))
(messbuf (current-buffer))
(message-syntax-checks
(if arg
message-syntax-checks))
(message-this-is-news t)
(message-posting-charset (gnus-setup-posting-charset
- (message-fetch-field "Newsgroups")))
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (message-fetch-field "Newsgroups"))))
result)
(if (not (message-check-news-body-syntax))
nil
(message-generate-headers message-required-news-headers)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
+ (if group-name-charset
+ (setq message-syntax-checks
+ (cons '(valid-newsgroups . disabled)
+ message-syntax-checks)))
(message-cleanup-headers)
(if (not (message-check-news-syntax))
nil
(message-generate-headers '(Lines)))
;; Remove some headers.
(message-remove-header message-ignored-news-headers t)
- (let ((mail-parse-charset (car message-posting-charset)))
+ (let ((mail-parse-charset message-default-charset))
(mail-encode-encoded-word-buffer)))
(goto-char (point-max))
;; require one newline at the end.
"Append this article to Unix/babyl mail file.."
(if (and (file-readable-p filename)
(mail-file-babyl-p filename))
- (rmail-output-to-rmail-file filename t)
+ (gnus-output-to-rmail filename t)
(gnus-output-to-mail filename t)))
(defun message-cleanup-headers ()
date (message-fetch-field "date")
from (message-fetch-field "from")
subject (or (message-fetch-field "subject") "none"))
- ;; Remove any (buggy) Re:'s that are present and make a
- ;; proper one.
- (when (string-match message-subject-re-regexp subject)
- (setq subject (substring subject (match-end 0))))
- (setq subject (concat "Re: " subject))
+ (if gnus-list-identifiers
+ (setq subject (message-strip-list-identifiers subject)))
+ (setq subject (concat "Re: " (message-strip-subject-re subject)))
(when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
(string-match "<[^>]+>" gnus-warning))
(let ((case-fold-search t))
(string-match "world" distribution)))
(setq distribution nil))
- ;; Remove any (buggy) Re:'s that are present and make a
- ;; proper one.
- (when (string-match message-subject-re-regexp subject)
- (setq subject (substring subject (match-end 0))))
- (setq subject (concat "Re: " subject))
+ (if gnus-list-identifiers
+ (setq subject (message-strip-list-identifiers subject)))
+ (setq subject (concat "Re: " (message-strip-subject-re subject)))
(widen))
(message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
;; Get a normal message buffer.
(message-pop-to-buffer (message-buffer-name "supersede"))
(insert-buffer-substring cur)
+ (mime-to-mml)
(message-narrow-to-head)
;; Remove unwanted headers.
(when message-ignored-supersedes-headers
subject))))
;;;###autoload
-(defun message-forward (&optional news)
+(defun message-forward (&optional news digest)
"Forward the current message via mail.
-Optional NEWS will use news to forward instead of mail."
+Optional NEWS will use news to forward instead of mail.
+Optional DIGEST will use digest to forward."
(interactive "P")
(let* ((cur (current-buffer))
(subject (if message-forward-show-mml
(message-goto-body)
(goto-char (point-max)))
(if message-forward-as-mime
- (if message-forward-show-mml
- (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
- (insert "\n\n<#part type=message/rfc822 disposition=inline"
- " buffer=\"" (buffer-name cur) "\">\n"))
+ (if digest
+ (insert "\n<#multipart type=digest>\n")
+ (if message-forward-show-mml
+ (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
+ (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
(insert "\n-------------------- Start of forwarded message --------------------\n"))
- (let ((b (point))
- e)
- (if message-forward-show-mml
- (insert-buffer-substring cur)
- (unless message-forward-as-mime
- (mml-insert-buffer cur)))
+ (let ((b (point)) e)
+ (if digest
+ (if message-forward-as-mime
+ (insert-buffer-substring cur)
+ (mml-insert-buffer cur))
+ (if message-forward-show-mml
+ (insert-buffer-substring cur)
+ (mm-with-unibyte-current-buffer
+ (mml-insert-buffer cur))))
(setq e (point))
(if message-forward-as-mime
- (if message-forward-show-mml
- (insert "<#/mml>\n")
- (insert "<#/part>\n"))
+ (if digest
+ (insert "<#/multipart>\n")
+ (if message-forward-show-mml
+ (insert "<#/mml>\n")
+ (insert "<#/part>\n")))
(insert "\n-------------------- End of forwarded message --------------------\n"))
- (when (and (or message-forward-show-mml
- (not message-forward-as-mime))
- (not current-prefix-arg)
- message-forward-ignored-headers)
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point)))
- (message-remove-header message-forward-ignored-headers t))))
+ (if (and digest message-forward-as-mime)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (delete-region (point-min) (point-max)))
+ (when (and (or message-forward-show-mml
+ (not message-forward-as-mime))
+ (not current-prefix-arg)
+ message-forward-ignored-headers)
+ (save-restriction
+ (narrow-to-region b e)
+ (goto-char b)
+ (narrow-to-region (point)
+ (or (search-forward "\n\n" nil t) (point)))
+ (message-remove-header message-forward-ignored-headers t)))))
(message-position-point)))
;;;###autoload
;;;###autoload
(defun message-bounce ()
"Re-mail the current message.
-This only makes sense if the current message is a bounce message than
+This only makes sense if the current message is a bounce message that
contains some mail you have written which has been bounced back to
you."
(interactive)
(if (fboundp 'mail-abbrevs-setup)
(let ((mail-abbrev-mode-regexp "")
(minibuffer-setup-hook 'mail-abbrevs-setup))
- (read-from-minibuffer prompt)))
- (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
- (read-string prompt)))
+ (read-from-minibuffer prompt))
+ (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
+ (read-string prompt))))
(provide 'message)
projects / gnus / blobdiff