(require 'mail-parse)
(require 'mml)
(require 'rfc822)
+(require 'format-spec)
(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
:group 'message-buffers
:type '(choice function (const nil)))
-(defcustom message-cite-style nil
- "The overall style to be used when yanking cited text.
-Values are either `traditional' (cited text first),
-`top-post' (cited text at the bottom), or nil (don't override the
-individual message variables)."
- :version "24.1"
- :group 'message-various
- :type '(choice (const :tag "None" :value nil)
- (const :tag "Traditional" :value traditional)
- (const :tag "Top-post" :value top-post)))
-
(defcustom message-fcc-handler-function 'message-output
"*A function called to save outgoing articles.
This function will be called with the name of the file to store the
:group 'message-various)
(defcustom message-elide-ellipsis "\n[...]\n\n"
- "*The string which is inserted for elided text."
+ "*The string which is inserted for elided text.
+This is a format-spec string, and you can use %l to say how many
+lines were removed, and %c to say how many characters were
+removed."
:type 'string
:link '(custom-manual "(message)Various Commands")
:group 'message-various)
(defcustom message-send-mail-function
(cond ((eq send-mail-function 'smtpmail-send-it) 'message-smtpmail-send-it)
((eq send-mail-function 'feedmail-send-it) 'feedmail-send-it)
+ ((eq send-mail-function 'sendmail-query-once) 'sendmail-query-once)
((eq send-mail-function 'mailclient-send-it)
'message-send-mail-with-mailclient)
(t (message-send-mail-function)))
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
+(defcustom message-cite-reply-position 'traditional
+ "*Where the reply should be positioned.
+If `traditional', reply inline.
+If `above', reply above quoted text.
+If `below', reply below quoted text.
+
+Note: Many newsgroups frown upon nontraditional reply styles. You
+probably want to set this variable only for specific groups,
+e.g. using `gnus-posting-styles':
+
+ (eval (set (make-local-variable 'message-cite-reply-position) 'above))"
+ :type '(choice (const :tag "Reply inline" 'traditional)
+ (const :tag "Reply above" 'above)
+ (const :tag "Reply below" 'below))
+ :group 'message-insertion)
+
+(defcustom message-cite-style nil
+ "*The overall style to be used when yanking cited text.
+Value is either `nil' (no variable overrides) or a let-style list
+of pairs (VARIABLE VALUE) that will be bound in
+`message-yank-original' to do the quoting.
+
+Presets to impersonate popular mail agents are found in the
+message-cite-style-* variables. This variable is intended for
+use in `gnus-posting-styles', such as:
+
+ ((posting-from-work-p) (eval (set (make-local-variable 'message-cite-style) message-cite-style-outlook)))"
+ :version "24.1"
+ :group 'message-insertion
+ :type '(choice (const :tag "Do not override variables" :value nil)
+ (const :tag "MS Outlook" :value message-cite-style-outlook)
+ (const :tag "Mozilla Thunderbird" :value message-cite-style-thunderbird)
+ (const :tag "Gmail" :value message-cite-style-gmail)
+ (variable :tag "User-specified")))
+
+(defconst message-cite-style-outlook
+ '((message-cite-function 'message-cite-original)
+ (message-citation-line-function 'message-insert-formatted-citation-line)
+ (message-cite-reply-position 'above)
+ (message-yank-prefix "")
+ (message-yank-cited-prefix "")
+ (message-yank-empty-prefix "")
+ (message-citation-line-format "\n\n-----------------------\nOn %a, %b %d %Y, %N wrote:\n"))
+ "Message citation style used by MS Outlook. Use with message-cite-style.")
+
+(defconst message-cite-style-thunderbird
+ '((message-cite-function 'message-cite-original)
+ (message-citation-line-function 'message-insert-formatted-citation-line)
+ (message-cite-reply-position 'above)
+ (message-yank-prefix "> ")
+ (message-yank-cited-prefix ">")
+ (message-yank-empty-prefix ">")
+ (message-citation-line-format "On %D %R %p, %N wrote:"))
+ "Message citation style used by Mozilla Thunderbird. Use with message-cite-style.")
+
+(defconst message-cite-style-gmail
+ '((message-cite-function 'message-cite-original)
+ (message-citation-line-function 'message-insert-formatted-citation-line)
+ (message-cite-reply-position 'above)
+ (message-yank-prefix " ")
+ (message-yank-cited-prefix " ")
+ (message-yank-empty-prefix " ")
+ (message-citation-line-format "On %e %B %Y %R, %f wrote:\n"))
+ "Message citation style used by Gmail. Use with message-cite-style.")
+
(defcustom message-distribution-function nil
"*Function called to return a Distribution header."
:group 'message-news
(defvar message-send-actions nil
"A list of actions to be performed upon successful sending of a message.")
(defvar message-return-action nil
- "Action to return to the caller after sending or postphoning a message.")
+ "Action to return to the caller after sending or postponing a message.")
(defvar message-exit-actions nil
"A list of actions to be performed upon exiting after sending a message.")
(defvar message-kill-actions nil
(defvar message-options nil
"Some saved answers when sending message.")
-(make-variable-buffer-local 'message-options)
+;; FIXME: On XEmacs this causes problems since let-binding like:
+;; (let ((message-options message-options)) ...)
+;; as in `message-send' and `mml-preview' loses to buffer-local
+;; variable initialization.
+(unless (featurep 'xemacs)
+ (make-variable-buffer-local 'message-options))
(defvar message-send-mail-real-function nil
"Internal send mail function.")
-(defvar message-bogus-system-names "^localhost\\.\\|\\.local$"
+(defvar message-bogus-system-names "\\`localhost\\.\\|\\.local\\'"
"The regexp of bogus system names.")
(defcustom message-valid-fqdn-regexp
(defun message-point-in-header-p ()
"Return t if point is in the header."
(save-excursion
- (not (re-search-backward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
+ (and
+ (not
+ (re-search-backward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
(defun message-do-auto-fill ()
"Like `do-auto-fill', but don't fill in message header."
An ellipsis (from `message-elide-ellipsis') will be inserted where the
text was killed."
(interactive "r")
- (kill-region b e)
- (insert message-elide-ellipsis))
+ (let ((lines (count-lines b e))
+ (chars (- e b)))
+ (kill-region b e)
+ (insert (format-spec message-elide-ellipsis
+ `((?l . ,lines)
+ (?c . ,chars))))))
(defvar message-caesar-translation-table nil)
(while (re-search-forward citexp nil t)
(replace-match (if remove "" "\n"))))))
-(defvar message-cite-reply-above nil
- "If non-nil, start own text above the quote.
-
-Note: Top posting is bad netiquette. Don't use it unless you
-really must. You probably want to set variable only for specific
-groups, e.g. using `gnus-posting-styles':
-
- (eval (set (make-local-variable 'message-cite-reply-above) t))
-
-This variable has no effect in news postings.")
+(defun message--yank-original-internal (arg)
+ (let ((modified (buffer-modified-p))
+ body-text)
+ (when (and message-reply-buffer
+ message-cite-function)
+ (when (equal message-cite-reply-position 'above)
+ (save-excursion
+ (setq body-text
+ (buffer-substring (message-goto-body)
+ (point-max)))
+ (delete-region (message-goto-body) (point-max))))
+ (if (bufferp message-reply-buffer)
+ (delete-windows-on message-reply-buffer t))
+ (push-mark (save-excursion
+ (cond
+ ((bufferp message-reply-buffer)
+ (insert-buffer-substring message-reply-buffer))
+ ((and (consp message-reply-buffer)
+ (functionp (car message-reply-buffer)))
+ (apply (car message-reply-buffer)
+ (cdr message-reply-buffer))))
+ (unless (bolp)
+ (insert ?\n))
+ (point)))
+ (unless arg
+ (funcall message-cite-function)
+ (unless (eq (char-before (mark t)) ?\n)
+ (let ((pt (point)))
+ (goto-char (mark t))
+ (insert-before-markers ?\n)
+ (goto-char pt))))
+ (case message-cite-reply-position
+ (above
+ (message-goto-body)
+ (insert body-text)
+ (insert (if (bolp) "\n" "\n\n"))
+ (message-goto-body))
+ (below
+ (message-goto-signature)))
+ ;; Add a `message-setup-very-last-hook' here?
+ ;; Add `gnus-article-highlight-citation' here?
+ (unless modified
+ (setq message-checksum (message-checksum))))))
(defun message-yank-original (&optional arg)
"Insert the message being replied to, if any.
Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers."
(interactive "P")
- (let ((modified (buffer-modified-p))
- body-text)
- (when (and message-reply-buffer
- message-cite-function)
- (when message-cite-reply-above
- (if (and (not (message-news-p))
- (or (eq message-cite-reply-above 'is-evil)
- (y-or-n-p "\
-Top posting is bad netiquette. Please don't top post unless you really must.
-Really top post? ")))
- (save-excursion
- (setq body-text
- (buffer-substring (message-goto-body)
- (point-max)))
- (delete-region (message-goto-body) (point-max)))
- (set (make-local-variable 'message-cite-reply-above) nil)))
- (if (bufferp message-reply-buffer)
- (delete-windows-on message-reply-buffer t))
- (push-mark (save-excursion
- (cond
- ((bufferp message-reply-buffer)
- (insert-buffer-substring message-reply-buffer))
- ((and (consp message-reply-buffer)
- (functionp (car message-reply-buffer)))
- (apply (car message-reply-buffer)
- (cdr message-reply-buffer))))
- (unless (bolp)
- (insert ?\n))
- (point)))
- (unless arg
- (funcall message-cite-function)
- (unless (eq (char-before (mark t)) ?\n)
- (let ((pt (point)))
- (goto-char (mark t))
- (insert-before-markers ?\n)
- (goto-char pt))))
- (when message-cite-reply-above
- (message-goto-body)
- (insert body-text)
- (insert (if (bolp) "\n" "\n\n"))
- (message-goto-body))
- ;; Add a `message-setup-very-last-hook' here?
- ;; Add `gnus-article-highlight-citation' here?
- (unless modified
- (setq message-checksum (message-checksum))))))
+ ;; eval the let forms contained in message-cite-style
+ (eval
+ `(let ,message-cite-style
+ (message--yank-original-internal ',arg))))
(defun message-yank-buffer (buffer)
"Insert BUFFER into the current buffer and quote it."
(set-buffer mailbuf)
(push 'mail message-sent-message-via)))
+(defvar sendmail-program)
+
(defun message-send-mail-with-sendmail ()
"Send off the prepared buffer with sendmail."
(require 'sendmail)
(cpr (apply
'call-process-region
(append
- (list (point-min) (point-max)
- (cond ((boundp 'sendmail-program)
- sendmail-program)
- ((file-exists-p "/usr/sbin/sendmail")
- "/usr/sbin/sendmail")
- ((file-exists-p "/usr/lib/sendmail")
- "/usr/lib/sendmail")
- ((file-exists-p "/usr/ucblib/sendmail")
- "/usr/ucblib/sendmail")
- (t "fakemail"))
+ (list (point-min) (point-max) sendmail-program
nil errbuf nil "-oi")
message-sendmail-extra-arguments
;; Always specify who from,
addr))
(cons (downcase (mail-strip-quoted-names addr)) addr)))
(message-tokenize-header recipients)))
- ;; Remove first duplicates. (Why not all duplicates? Is this a bug?)
+ ;; Remove all duplicates.
(let ((s recipients))
(while s
- (setq recipients (delq (assoc (car (pop s)) s) recipients))))
+ (let ((address (car (pop s))))
+ (while (assoc address s)
+ (setq recipients (delq (assoc address s) recipients)
+ s (delq (assoc address s) s))))))
;; Remove hierarchical lists that are contained within each other,
;; if message-hierarchical-addresses is defined.