(defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
(require 'mailheader)
(require 'nnheader)
+;; This is apparently necessary even though things are autoloaded:
+(if (featurep 'xemacs)
+ (require 'mail-abbrevs))
(require 'mail-parse)
(require 'mml)
Don't touch this variable unless you really know what you're doing.
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
-newsgroups."
+long-lines control-chars size new-text quoting-style
+redirected-followup signature approved sender empty empty-headers
+message-id from subject shorten-followup-to existing-newsgroups
+buffer-file-name unchanged newsgroups."
:group 'message-news
:type '(repeat sexp))
:group 'message-sending
:type 'sexp)
-;; Ignore errors in case this is used in Emacs 19.
-;; Don't use ignore-errors because this is copied into loaddefs.el.
;;;###autoload
-(ignore-errors
- (define-mail-user-agent 'message-user-agent
- 'message-mail 'message-send-and-exit
- 'message-kill-buffer 'message-send-hook))
+(define-mail-user-agent 'message-user-agent
+ 'message-mail 'message-send-and-exit
+ 'message-kill-buffer 'message-send-hook)
(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
"If non-nil, delete the deletable headers before feeding to mh.")
:type '(choice (const :tag "unique" unique)
(const :tag "unsent" unsent)))
-(defcustom message-default-charset nil
- "Default charset used in non-MULE XEmacsen."
+(defcustom message-default-charset
+ (and (not (mm-multibyte-p)) 'iso-8859-1)
+ "Default charset used in non-MULE Emacsen.
+If nil, you might be asked to input the charset."
:group 'message
:type 'symbol)
-(defcustom message-dont-reply-to-names rmail-dont-reply-to-names
+(defcustom message-dont-reply-to-names
+ (and (boundp 'rmail-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 "unlimited" nil)
(integer 1000000)))
+(defcustom message-alternative-emails nil
+ "A regexp to match the alternative email addresses.
+The first matched address (not primary one) is used in the From field."
+ :group 'message-headers
+ :type '(choice (const :tag "Always use primary" nil)
+ regexp))
+
;;; Internal variables.
+(defvar message-sending-message "Sending...")
(defvar message-buffer-list nil)
(defvar message-this-is-news nil)
(defvar message-this-is-mail nil)
(progn (forward-line ,(or n 1)) (point))))
(defun message-unquote-tokens (elems)
- "Remove leading and trailing double quotes (\") from quoted strings
-in list."
+ "Remove double quotes (\") from strings in list."
(mapcar (lambda (item)
- (if (string-match "^\"\\(.*\\)\"$" item)
- (match-string 1 item)
- item))
+ (while (string-match "^\\(.*\\)\"\\(.*\\)$" item)
+ (setq item (concat (match-string 1 item)
+ (match-string 2 item))))
+ item)
elems))
(defun message-tokenize-header (header &optional separator)
(define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
- (define-key message-mode-map "\t" 'message-tab)
-
- ;; Emacs 21 toolbar
- (when (and (fboundp 'find-image) (boundp 'auto-raise-tool-bar-buttons))
- (let ((message-help
- (find-image '((:type xpm :file "message-help-up.xpm")
- (:type xbm :file "message-help-up.xbm"))))
- (message-spell
- (find-image '((:type xpm :file "message-spell-up.xpm")
- (:type xbm :file "message-spell-up.xbm")))))
- (if message-help
- (define-key message-mode-map [tool-bar message-help]
- `(menu-item "Message mode documentation"
- ,(lambda () (info "(message)Top"))
- :image ,message-help)))
- (if message-spell
- (define-key message-mode-map [tool-bar message-spell]
- `(menu-item "Spell-check message" ispell-message
- :image ,message-spell))))))
+ (define-key message-mode-map "\t" 'message-tab))
(easy-menu-define
message-mode-menu message-mode-map "Message Menu."
(error "Face %s not configured for %s mode" face mode-name)))
"")
facemenu-remove-face-function t)
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
- ;; `-- ' precedes the signature. `-----' appears at the start of the
- ;; lines that delimit forwarded messages.
- ;; Lines containing just >= 3 dashes, perhaps after whitespace,
- ;; are also sometimes used and should be separators.
- (setq paragraph-start
- (concat (regexp-quote mail-header-separator)
- "$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
- "-- $\\|---+$\\|"
- page-delimiter
- ;;!!! Uhm... shurely this can't be right?
- "[> " (regexp-quote message-yank-prefix) "]+$"))
- (setq paragraph-separate paragraph-start)
(make-local-variable 'message-reply-headers)
(setq message-reply-headers nil)
(make-local-variable 'message-newsreader)
(set (make-local-variable 'message-sent-message-via) nil)
(set (make-local-variable 'message-checksum) nil)
(set (make-local-variable 'message-mime-part) 0)
+ (message-setup-fill-variables)
;;(when (fboundp 'mail-hist-define-keys)
;; (mail-hist-define-keys))
(if (featurep 'xemacs)
(mail-abbrevs-setup)
(mail-aliases-setup)))
(message-set-auto-save-file-name)
- (make-local-variable 'adaptive-fill-regexp)
- (setq 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]*\\)+[ \t]*\\|"
- adaptive-fill-first-line-regexp))
- (make-local-variable 'auto-fill-inhibit-regexp)
- (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")
(mm-enable-multibyte)
(make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
(setq indent-tabs-mode nil)
(mml-mode)
(run-hooks 'text-mode-hook 'message-mode-hook))
+(defun message-setup-fill-variables ()
+ "Setup message fill variables."
+ (make-local-variable 'paragraph-separate)
+ (make-local-variable 'paragraph-start)
+ (make-local-variable '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)
+ (make-local-variable 'auto-fill-inhibit-regexp)
+ (let ((quote-prefix-regexp
+ (concat
+ "[ \t]*" ; possible initial space
+ "\\(\\(" (regexp-quote message-yank-prefix) "\\|" ; user's prefix
+ "\\w+>\\|" ; supercite-style prefix
+ "[|:>]" ; standard prefix
+ "\\)[ \t]*\\)+"))) ; possible space after each prefix
+ (setq paragraph-start
+ (concat
+ (regexp-quote mail-header-separator) "$\\|"
+ "[ \t]*$\\|" ; blank lines
+ "-- $\\|" ; signature delimiter
+ "---+$\\|" ; delimiters for forwarded messages
+ page-delimiter "$\\|" ; spoiler warnings
+ ".*wrote:$\\|" ; attribution lines
+ quote-prefix-regexp "$")) ; empty lines in quoted text
+ (setq paragraph-separate paragraph-start)
+ (setq adaptive-fill-regexp
+ (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
+ (setq adaptive-fill-first-line-regexp
+ (concat quote-prefix-regexp "\\|"
+ adaptive-fill-first-line-regexp))
+ (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")))
+
\f
;;;
(put-text-property (point-min) (point-max) 'read-only nil))
(message-fix-before-sending)
(run-hooks 'message-send-hook)
- (message "Sending...")
+ (message message-sending-message)
(let ((alist message-send-method-alist)
(success t)
elem sent)
(while (and success
(setq elem (pop alist)))
- (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)))
+ (when (funcall (cadr elem))
+ (when (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)
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(insert ?\n))
- (when (and news
+ (when
+ (save-restriction
+ (message-narrow-to-headers)
+ (and news
(or (message-fetch-field "cc")
- (message-fetch-field "to")))
+ (message-fetch-field "to"))
+ (string= "text/plain"
+ (car
+ (mail-header-parse-content-type
+ (message-fetch-field "content-type"))))))
(message-insert-courtesy-copy))
(if (or (not message-send-mail-partially-limit)
(< (point-max) message-send-mail-partially-limit)
(format
"Your .sig is %d lines; it should be max 4. Really post? "
(1- (count-lines (point) (point-max)))))
- t))))
+ t))
+ ;; Ensure that text follows last quoted portion.
+ (message-check 'quoting-style
+ (goto-char (point-max))
+ (let ((no-problem t))
+ (when (search-backward-regexp "^>[^\n]*\n>" nil t)
+ (setq no-problem nil)
+ (while (not (eobp))
+ (when (and (not (eolp)) (looking-at "[^> \t]"))
+ (setq no-problem t))
+ (forward-line)))
+ (if no-problem
+ t
+ (y-or-n-p "Your text should follow quoted text. Really post? "))))))
(defun message-checksum ()
"Return a \"checksum\" for the current buffer."
(while (setq file (message-fetch-field "fcc"))
(push file list)
(message-remove-header "fcc" nil t)))
+ (message-encode-message-body)
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((mail-parse-charset message-default-charset)
+ (rfc2047-header-encoding-alist
+ (cons '("Newsgroups" . default)
+ rfc2047-header-encoding-alist)))
+ (mail-encode-encoded-word-buffer)))
(goto-char (point-min))
- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
- (replace-match "" t t)
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (replace-match "" t t ))
;; Process FCC operations.
(while list
(setq file (pop list))
(rmail-output file 1 nil t)
(let ((mail-use-rfc822 t))
(rmail-output file 1 t t))))))
-
(kill-buffer (current-buffer)))))
(defun message-output (filename)
(defun message-make-in-reply-to ()
"Return the In-Reply-To header for this message."
(when message-reply-headers
- (let ((from (mail-header-from message-reply-headers))
- (date (mail-header-date message-reply-headers)))
- (when from
- (let ((stop-pos
- (string-match " *at \\| *@ \\| *(\\| *<" from)))
- (concat (if (and stop-pos
- (not (zerop stop-pos)))
- (substring from 0 stop-pos) from)
- "'s message of \""
- (if (or (not date) (string= date ""))
- "(unknown date)" date)
- "\""))))))
+ (mail-header-message-id message-reply-headers)))
(defun message-make-distribution ()
"Make a Distribution header."
(message-insert-signature)
(save-restriction
(message-narrow-to-headers)
+ (if message-alternative-emails
+ (message-use-alternative-email-as-from))
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(setq buf (set-buffer (get-buffer-create " *message cancel*"))))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
- "From: " (message-make-from) "\n"
+ "From: " from "\n"
"Subject: cmsg cancel " message-id "\n"
"Control: cancel " message-id "\n"
(if distribution
(mml-insert-buffer cur))
(if message-forward-show-mml
(insert-buffer-substring cur)
- (mm-with-unibyte-current-buffer
- (mml-insert-buffer cur))))
+ (mml-insert-buffer cur)))
(setq e (point))
(if message-forward-as-mime
(if digest
(if (re-search-forward "^[^ \n\t]+:" nil t)
(match-beginning 0)
(point))))
+ (mm-enable-multibyte)
+ (mime-to-mml)
(save-restriction
(message-narrow-to-head)
(message-remove-header message-ignored-bounced-headers t)
(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
+;; Support for toolbar
+(when (featurep 'xemacs)
+ (require 'messagexmas))
+
;;; Group name completion.
(defvar message-newgroups-header-regexp
(let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
(read-string prompt))))
+(defun message-use-alternative-email-as-from ()
+ (require 'mail-utils)
+ (let* ((fields '("To" "Cc"))
+ (emails
+ (split-string
+ (mail-strip-quoted-names
+ (mapconcat 'message-fetch-reply-field fields ","))
+ "[ \f\t\n\r\v,]+"))
+ email)
+ (while emails
+ (if (string-match message-alternative-emails (car emails))
+ (setq email (car emails)
+ emails nil))
+ (pop emails))
+ (unless (or (not email) (equal email user-mail-address))
+ (goto-char (point-max))
+ (insert "From: " email "\n"))))
+
(provide 'message)
(run-hooks 'message-load-hook)