Checks include subject-cmsg multiple-headers sendsys message-id from
long-lines control-chars size new-text redirected-followup signature
approved sender empty empty-headers message-id from subject
-shorten-followup-to existing-newsgroups buffer-file-name unchanged."
+shorten-followup-to existing-newsgroups buffer-file-name unchanged
+newsgroups."
:group 'message-news)
(defcustom message-required-news-headers
:type 'regexp
:group 'message-various)
-(defcustom message-elide-elipsis "\n[...]\n\n"
+(defcustom message-elide-ellipsis "\n[...]\n\n"
"*The string which is inserted for elided text."
:type 'string
:group 'message-various)
:type '(radio (function-item message-forward-subject-author-subject)
(function-item message-forward-subject-fwd)))
+(defcustom message-forward-as-mime t
+ "*If non-nil, forward messages as an inline/rfc822 MIME section. Otherwise, directly inline the old message in the forwarded message."
+ :group 'message-forwarding
+ :type 'boolean)
+
(defcustom message-wash-forwarded-subjects nil
"*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
:group 'message-forwarding
:group 'message-interface
:type 'regexp)
+(defcustom message-forward-ignored-headers nil
+ "*All headers that match this regexp will be deleted when forwarding a message."
+ :group 'message-forwarding
+ :type '(choice (const :tag "None" nil)
+ regexp))
+
(defcustom message-ignored-cited-headers "."
"*Delete these headers from the messages you yank."
:group 'message-insertion
:group 'message
:type 'symbol)
+(defcustom message-dont-reply-to-names rmail-dont-reply-to-names
+ "*A regexp specifying names to prune when doing wide replies.
+A value of nil means exclude your own name only."
+ :group 'message
+ :type '(choice (const :tag "Yourself" nil)
+ regexp))
+
;;; Internal variables.
;;; Well, not really internal.
"Coding system to encode outgoing mail.")
(defvar message-draft-coding-system
- (cond
- ((not (fboundp 'coding-system-p)) nil)
- ((coding-system-p 'emacs-mule)
- (if (string-match "nt\\|windows" system-configuration)
- 'emacs-mule-dos 'emacs-mule))
- ((memq 'escape-quoted (mm-get-coding-system-list)) 'escape-quoted)
- ((coding-system-p 'no-conversion) 'no-conversion)
- (t nil))
+ mm-auto-save-coding-system
"Coding system to compose mail.")
;;; Internal variables.
"^ *---+ +Original message +---+ *$\\|"
"^ *--+ +begin message +--+ *$\\|"
"^ *---+ +Original message follows +---+ *$\\|"
+ "^ *---+ +Undelivered message follows +---+ *$\\|"
"^|? *---+ +Message text follows: +---+ *|?$")
"A regexp that matches the separator before the text of a failed message.")
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
- ;; We remove all text props.delete-region
+ ;; We remove all text props.
(format "%s" value))))
(defun message-narrow-to-field ()
(insert (car headers) ?\n))))
(setq headers (cdr headers))))
+
(defun message-fetch-reply-field (header)
"Fetch FIELD from the message we're replying to."
(when (and message-reply-buffer
'(message-font-lock-keywords t)))
(make-local-variable 'adaptive-fill-regexp)
(setq adaptive-fill-regexp
- (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-regexp))
+ (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" adaptive-fill-regexp))
(unless (boundp 'adaptive-fill-first-line-regexp)
(setq adaptive-fill-first-line-regexp nil))
(make-local-variable 'adaptive-fill-first-line-regexp)
(setq adaptive-fill-first-line-regexp
- (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|"
+ (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
adaptive-fill-first-line-regexp))
(mm-enable-multibyte)
(make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
"Move point to the end of the headers."
(interactive)
(message-goto-body)
- (forward-line -2))
+ (forward-line -1))
(defun message-goto-signature ()
"Move point to the beginning of the message signature.
(defun message-newline-and-reformat ()
"Insert four newlines, and then reformat if inside quoted text."
(interactive)
- (let ((point (point))
- quoted)
- (save-excursion
- (beginning-of-line)
- (setq quoted (looking-at (regexp-quote message-yank-prefix))))
- (insert "\n\n\n\n")
+ (let ((prefix "[]>ยป|:}+ \t]*")
+ (supercite-thing "[-._a-zA-Z0-9]*[>]+[ \t]*")
+ quoted point)
+ (unless (bolp)
+ (save-excursion
+ (beginning-of-line)
+ (when (looking-at (concat prefix
+ supercite-thing))
+ (setq quoted (match-string 0))))
+ (insert "\n"))
+ (setq point (point))
+ (insert "\n\n\n")
+ (delete-region (point) (re-search-forward "[ \t]*"))
(when quoted
- (insert message-yank-prefix))
+ (insert quoted))
(fill-paragraph nil)
(goto-char point)
- (forward-line 2)))
+ (forward-line 1)))
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for the `message-signature' variable."
(defun message-elide-region (b e)
"Elide the text between point and mark.
-An ellipsis (from `message-elide-elipsis') will be inserted where the
+An ellipsis (from `message-elide-ellipsis') will be inserted where the
text was killed."
(interactive "r")
(kill-region b e)
- (unless (bolp)
- (insert "\n"))
- (insert message-elide-elipsis))
+ (insert message-elide-ellipsis))
(defvar message-caesar-translation-table nil)
(unless (equal 0 (call-process-region
(point-min) (point-max) program t t))
(insert body)
- (message "%s failed." program))))))
+ (message "%s failed" program))))))
(defun message-rename-buffer (&optional enter-string)
"Rename the *message* buffer to \"*message* RECIPIENT\".
(goto-char (point-min))
(search-forward (concat "\n" mail-header-separator "\n") nil t)
(let ((fill-prefix message-yank-prefix))
- (fill-individual-paragraphs (point) (point-max) justifyp t))))
+ (fill-individual-paragraphs (point) (point-max) justifyp))))
(defun message-indent-citation ()
"Modify text just inserted from a message to be cited.
elem sent)
(while (and success
(setq elem (pop alist)))
- (when (and (or (not (funcall (cadr elem)))
- (and (or (not (memq (car elem)
- message-sent-message-via))
- (y-or-n-p
- (format
- "Already sent message via %s; resend? "
- (car elem))))
- (setq success (funcall (caddr elem) arg)))))
+ (when (or (not (funcall (cadr elem)))
+ (and (or (not (memq (car elem)
+ message-sent-message-via))
+ (y-or-n-p
+ (format
+ "Already sent message via %s; resend? "
+ (car elem))))
+ (setq success (funcall (caddr elem) arg))))
(setq sent t)))
+ (unless (or sent (not success))
+ (error "No methods specified to send by"))
(when (and success sent)
(message-do-fcc)
- ;;(when (fboundp 'mail-hist-put-headers-into-history)
- ;; (mail-hist-put-headers-into-history))
(save-excursion
(run-hooks 'message-sent-hook))
(message "Sending...done")
(defun message-check-news-header-syntax ()
(and
+ ;; Check Newsgroups header.
+ (message-check 'newsgroyps
+ (let ((group (message-fetch-field "newsgroups")))
+ (or
+ (and group
+ (not (string-match "\\`[ \t]*\\'" group)))
+ (ignore
+ (message
+ "The newsgroups field is empty or missing. Posting is denied.")))))
;; Check the Subject header.
(message-check 'subject
(let* ((case-fold-search t)
(message-check 'from
(let* ((case-fold-search t)
(from (message-fetch-field "from"))
- (ad (nth 1 (mail-extract-address-components from))))
+ ad)
(cond
((not from)
(message "There is no From line. Posting is denied.")
nil)
- ((or (not (string-match "@[^\\.]*\\." ad)) ;larsi@ifi
+ ((or (not (string-match
+ "@[^\\.]*\\."
+ (setq ad (nth 1 (mail-extract-address-components
+ from))))) ;larsi@ifi
(string-match "\\.\\." ad) ;larsi@ifi..uio
(string-match "@\\." ad) ;larsi@.ifi.uio
(string-match "\\.$" ad) ;larsi@ifi.uio.
parse-time-months))))
(format-time-string "%Y %H:%M:%S " now)
;; We do all of this because XEmacs doesn't have the %z spec.
- (format "%s%02d%02d" sign (/ zone 3600) (% zone 3600)))))
+ (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
(defun message-make-message-id ()
"Make a unique Message-ID."
from subject date reply-to to cc
references message-id follow-to
(inhibit-point-motion-hooks t)
+ (message-this-is-mail t)
mct never-mct gnus-warning)
(save-restriction
(message-narrow-to-head)
(while (re-search-forward "[ \t]+" nil t)
(replace-match " " t t))
;; Remove addresses that match `rmail-dont-reply-to-names'.
- (insert (prog1 (rmail-dont-reply-to (buffer-string))
- (erase-buffer)))
+ (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
+ (insert (prog1 (rmail-dont-reply-to (buffer-string))
+ (erase-buffer))))
(goto-char (point-min))
;; Perhaps Mail-Copies-To: never removed the only address?
(when (eobp)
;; Put point where we want it before inserting the forwarded
;; message.
(message-goto-body)
- (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
- (mml-insert-buffer cur)
- (insert "<#/part>\n")
+ (if message-forward-as-mime
+ (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
+ (insert "\n\n"))
+ (let ((b (point))
+ e)
+ (mml-insert-buffer cur)
+ (setq e (point))
+ (and message-forward-as-mime
+ (insert "<#/part>\n"))
+ (when (and (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
(defun message-resend (address)
"Resend the current article to ADDRESS."
- (interactive "sResend message to: ")
+ (interactive
+ (list (message-read-from-minibuffer "Resend message to: ")))
(message "Resending message to %s..." address)
(save-excursion
(let ((cur (current-buffer))
contains some mail you have written which has been bounced back to
you."
(interactive)
- (let ((cur (current-buffer))
+ (let ((handles (mm-dissect-buffer t))
boundary)
(message-pop-to-buffer (message-buffer-name "bounce"))
- (insert-buffer-substring cur)
- (undo-boundary)
- (message-narrow-to-head)
- (if (and (message-fetch-field "Mime-Version")
- (setq boundary (message-fetch-field "Content-Type")))
- (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary)
- (setq boundary (concat (match-string 1 boundary) " *\n"
- "Content-Type: message/rfc822"))
- (setq boundary nil)))
- (widen)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (or (and boundary
- (re-search-forward boundary nil t)
- (forward-line 2))
- (and (re-search-forward message-unsent-separator nil t)
- (forward-line 1))
- (re-search-forward "^Return-Path:.*\n" nil t))
- ;; We remove everything before the bounced mail.
- (delete-region
- (point-min)
- (if (re-search-forward "^[^ \n\t]+:" nil t)
- (match-beginning 0)
- (point)))
+ (if (stringp (car handles))
+ ;; This is a MIME bounce.
+ (mm-insert-part (car (last handles)))
+ ;; This is a non-MIME bounce, so we try to remove things
+ ;; manually.
+ (mm-insert-part handles)
+ (undo-boundary)
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (or (and (re-search-forward message-unsent-separator nil t)
+ (forward-line 1))
+ (re-search-forward "^Return-Path:.*\n" nil t))
+ ;; We remove everything before the bounced mail.
+ (delete-region
+ (point-min)
+ (if (re-search-forward "^[^ \n\t]+:" nil t)
+ (match-beginning 0)
+ (point))))
(save-restriction
(message-narrow-to-head)
(message-remove-header message-ignored-bounced-headers t)
(forward-line 1)
(insert "Content-Type: text/plain; charset=us-ascii\n")))))
+(defun message-read-from-minibuffer (prompt)
+ "Read from the minibuffer while providing abbrev expansion."
+ (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)))
+
(provide 'message)
(run-hooks 'message-load-hook)