;;; Code:
-(require 'cl)
+(eval-when-compile (require 'cl))
+
(require 'mailheader)
(require 'rmail)
(require 'nnheader)
"Composing Mail Messages"
:group 'message)
+(defgroup message-faces nil
+ "Faces used for message composing."
+ :group 'message
+ :group 'faces)
+
(defcustom message-directory "~/Mail/"
"*Directory from which all other mail file variables are derived."
:group 'message-various
:group 'message-buffers
:type 'function)
-;;;###autoload
(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
:type 'file
:group 'message-headers)
-(defcustom message-autosave-directory "~/"
- ; (concat (file-name-as-directory message-directory) "drafts/")
- "*Directory where message autosaves buffers.
-If nil, message won't autosave."
+(defcustom message-autosave-directory
+ (nnheader-concat message-directory "drafts/")
+ "*Directory where Message autosaves buffers.
+If nil, Message won't autosave."
:group 'message-buffers
:type 'directory)
(t '(nnspool "")))
"Method used to post news."
:group 'message-news
- :group 'mesage-sending
+ :group 'message-sending
;; This should be the `gnus-select-method' widget, but that might
;; create a dependence to `gnus.el'.
:type 'sexp)
:group 'message-sending
:type 'sexp)
-(ignore-errors
- (define-mail-user-agent 'message-user-agent
- 'message-mail 'message-send-and-exit
- 'message-kill-buffer 'message-send-hook))
+;; Ignore errors in case this is used in Emacs 19.
+;; Don't use ignore-errors because this is copied into loaddefs.el.
+;;;###autoload
+(condition-case nil
+ (define-mail-user-agent 'message-user-agent
+ 'message-mail 'message-send-and-exit
+ 'message-kill-buffer 'message-send-hook)
+ (error nil))
(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
"If non-nil, delete the deletable headers before feeding to mh.")
+(defvar message-send-method-alist
+ '((news message-news-p message-send-via-news)
+ (mail message-mail-p message-send-via-mail))
+ "Alist of ways to send outgoing messages.
+Each element has the form
+
+ \(TYPE PREDICATE FUNCTION)
+
+where TYPE is a symbol that names the method; PREDICATE is a function
+called without any parameters to determine whether the message is
+a message of type TYPE; and FUNCTION is a function to be called if
+PREDICATE returns non-nil. FUNCTION is called with one parameter --
+the prefix.")
+
+(defvar message-mail-alias-type 'abbrev
+ "*What alias expansion type to use in Message buffers.
+The default is `abbrev', which uses mailabbrev. nil switches
+mail aliases off.")
+
;;; Internal variables.
;;; Well, not really internal.
(t
(:bold t :italic t)))
"Face used for displaying From headers."
- :group 'message-headers)
+ :group 'message-faces)
(defface message-header-cc-face
'((((class color)
(t
(:bold t)))
"Face used for displaying Cc headers."
- :group 'message-headers)
+ :group 'message-faces)
(defface message-header-subject-face
'((((class color)
(t
(:bold t)))
"Face used for displaying subject headers."
- :group 'message-headers)
+ :group 'message-faces)
(defface message-header-newsgroups-face
'((((class color)
(t
(:bold t :italic t)))
"Face used for displaying newsgroups headers."
- :group 'message-headers)
+ :group 'message-faces)
(defface message-header-other-face
'((((class color)
(t
(:bold t :italic t)))
"Face used for displaying newsgroups headers."
- :group 'message-headers)
+ :group 'message-faces)
(defface message-header-name-face
'((((class color)
(t
(:bold t)))
"Face used for displaying header names."
- :group 'message-headers)
+ :group 'message-faces)
(defface message-header-xheader-face
'((((class color)
(t
(:bold t)))
"Face used for displaying X-Header headers."
- :group 'message-headers)
+ :group 'message-faces)
(defface message-separator-face
'((((class color)
(t
(:bold t)))
"Face used for displaying the separator."
- :group 'message-headers)
+ :group 'message-faces)
(defface message-cited-text-face
'((((class color)
(t
(:bold t)))
"Face used for displaying cited text names."
- :group 'message-headers)
+ :group 'message-faces)
(defvar message-font-lock-keywords
(let* ((cite-prefix "A-Za-z")
(cite-suffix (concat cite-prefix "0-9_.@-"))
(content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
- `((,(concat "^\\(To:\\)" content)
+ `((,(concat "^\\([Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-to-face nil t))
- (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^Reply-To:\\)" content)
+ (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-cc-face nil t))
- (,(concat "^\\(Subject:\\)" content)
+ (,(concat "^\\([Ss]ubject:\\)" content)
(1 'message-header-name-face)
(2 'message-header-subject-face nil t))
- (,(concat "^\\(Newsgroups:\\|Followup-to:\\)" content)
+ (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
(1 'message-header-name-face)
(2 'message-header-newsgroups-face nil t))
- (,(concat "^\\([^: \n\t]+:\\)" content)
+ (,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
(1 'message-header-name-face)
(2 'message-header-other-face nil t))
(,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content)
(defvar message-buffer-list nil)
(defvar message-this-is-news nil)
(defvar message-this-is-mail nil)
+(defvar message-draft-article nil)
;; Byte-compiler warning
(defvar gnus-active-hashtb)
(defvar gnus-read-active-file)
;;; Regexp matching the delimiter of messages in UNIX mail format
-;;; (UNIX From lines), minus the initial ^.
+;;; (UNIX From lines), minus the initial ^. It should be a copy
+;;; of rmail.el's rmail-unix-mail-delimiter.
(defvar message-unix-mail-delimiter
(let ((time-zone-regexp
(concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
(concat
"From "
- ;; Username, perhaps with a quoted section that can contain spaces.
- "\\("
- "[^ \n]*"
- "\\(\\|\".*\"[^ \n]*\\)"
- "\\|<[^<>\n]+>"
- "\\) ?"
+ ;; Many things can happen to an RFC 822 mailbox before it is put into
+ ;; a `From' line. The leading phrase can be stripped, e.g.
+ ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g.
+ ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF
+ ;; can be removed, e.g.
+ ;; From: joe@y.z (Joe K
+ ;; User)
+ ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and
+ ;; From: Joe User
+ ;; <joe@y.z>
+ ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
+ ;; The mailbox can be removed or be replaced by white space, e.g.
+ ;; From: "Joe User"{space}{tab}
+ ;; <joe@y.z>
+ ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996',
+ ;; where {space} and {tab} represent the Ascii space and tab characters.
+ ;; We want to match the results of any of these manglings.
+ ;; The following regexp rejects names whose first characters are
+ ;; obviously bogus, but after that anything goes.
+ "\\([^\0-\b\n-\r\^?].*\\)? "
;; The time the message was sent.
- "\\([^ \n]*\\) *" ; day of the week
- "\\([^ ]*\\) *" ; month
- "\\([0-9]*\\) *" ; day of month
- "\\([0-9:]*\\) *" ; time of day
+ "\\([^\0-\r \^?]+\\) +" ; day of the week
+ "\\([^\0-\r \^?]+\\) +" ; month
+ "\\([0-3]?[0-9]\\) +" ; day of month
+ "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
;; Perhaps a time zone, specified by an abbreviation, or by a
;; numeric offset.
time-zone-regexp
;; The year.
- " [0-9][0-9]\\([0-9]*\\) *"
+ " \\([0-9][0-9]+\\) *"
;; On some systems the time zone can appear after the year, too.
time-zone-regexp
;; Old uucp cruft.
"\\(remote from .*\\)?"
- "\n")))
+ "\n"))
+ "Regexp matching the delimiter of messages in UNIX mail format.")
(defvar message-unsent-separator
(concat "^ *---+ +Unsent message follows +---+ *$\\|"
(when value
(nnheader-replace-chars-in-string value ?\n ? ))))
+(defun message-add-header (&rest headers)
+ "Add the HEADERS to the message header, skipping those already present."
+ (while headers
+ (let (hclean)
+ (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers))
+ (error "Invalid header `%s'" (car headers)))
+ (setq hclean (match-string 1 (car headers)))
+ (save-restriction
+ (message-narrow-to-headers)
+ (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
+ (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
(defun message-functionp (form)
"Return non-nil if FORM is funcallable."
(or (and (symbolp form) (fboundp form))
- (and (listp form) (eq (car form) 'lambda))))
+ (and (listp form) (eq (car form) 'lambda))
+ (compiled-function-p form)))
(defun message-strip-subject-re (subject)
"Remove \"Re:\" from subject lines."
(define-key message-mode-map "\C-c\C-d" 'message-dont-send)
(define-key message-mode-map "\C-c\C-e" 'message-elide-region)
+ (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
(define-key message-mode-map "\t" 'message-tab))
["Caesar (rot13) Message" message-caesar-buffer-body t]
["Caesar (rot13) Region" message-caesar-region (mark t)]
["Elide Region" message-elide-region (mark t)]
+ ["Delete Outside Region" message-delete-not-region (mark t)]
["Rename buffer" message-rename-buffer t]
["Spellcheck" ispell-message t]
"----"
(kill-all-local-variables)
(make-local-variable 'message-reply-buffer)
(setq message-reply-buffer nil)
- (set (make-local-variable 'message-send-actions) nil)
- (set (make-local-variable 'message-exit-actions) nil)
- (set (make-local-variable 'message-kill-actions) nil)
- (set (make-local-variable 'message-postpone-actions) nil)
+ (make-local-variable 'message-send-actions)
+ (make-local-variable 'message-exit-actions)
+ (make-local-variable 'message-kill-actions)
+ (make-local-variable 'message-postpone-actions)
+ (make-local-variable 'message-draft-article)
+ (make-local-hook 'kill-buffer-hook)
+ (add-hook 'kill-buffer-hook 'message-disassociate-draft)
(set-syntax-table message-mode-syntax-table)
(use-local-map message-mode-map)
(setq local-abbrev-table message-mode-abbrev-table)
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
;; Allow mail alias things.
- (if (fboundp 'mail-abbrevs-setup)
- (mail-abbrevs-setup)
- (funcall (intern "mail-aliases-setup")))
+ (when (eq message-mail-alias-type 'abbrev)
+ (if (fboundp 'mail-abbrevs-setup)
+ (mail-abbrevs-setup)
+ (funcall (intern "mail-aliases-setup"))))
+ (message-set-auto-save-file-name)
(run-hooks 'text-mode-hook 'message-mode-hook))
\f
\f
-(defun message-insert-to ()
- "Insert a To header that points to the author of the article being replied to."
- (interactive)
- (let ((co (message-fetch-field "courtesy-copies-to")))
- (when (and co
+(defun message-insert-to (&optional force)
+ "Insert a To header that points to the author of the article being replied to.
+If the original author requested not to be sent mail, the function signals
+an error.
+With the prefix argument FORCE, insert the header anyway."
+ (interactive "P")
+ (let ((co (message-fetch-reply-field "mail-copies-to")))
+ (when (and (null force)
+ co
(equal (downcase co) "never"))
(error "The user has requested not to have copies sent via mail")))
(when (and (message-position-on-field "To")
;;; Various commands
+(defun message-delete-not-region (beg end)
+ "Delete everything in the body of the current message that is outside of the region."
+ (interactive "r")
+ (save-excursion
+ (goto-char end)
+ (delete-region (point) (progn (message-goto-signature)
+ (forward-line -2)
+ (point)))
+ (insert "\n")
+ (goto-char beg)
+ (delete-region beg (progn (message-goto-body)
+ (forward-line 2)
+ (point))))
+ (message-goto-signature)
+ (forward-line -2))
+
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for the `message-signature' variable."
(interactive (list 0))
(let ((start (point)))
;; Remove unwanted headers.
(when message-ignored-cited-headers
- (save-restriction
- (narrow-to-region
- (goto-char start)
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point)))
- (message-remove-header message-ignored-cited-headers t)
- (goto-char (point-max))))
+ (let (all-removed)
+ (save-restriction
+ (narrow-to-region
+ (goto-char start)
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ (point)))
+ (message-remove-header message-ignored-cited-headers t)
+ (when (= (point-min) (point-max))
+ (setq all-removed t))
+ (goto-char (point-max)))
+ (if all-removed
+ (goto-char start)
+ (forward-line 1))))
;; Delete blank lines at the start of the buffer.
(while (and (point-min)
(eolp)
(defun message-kill-buffer ()
"Kill the current buffer."
(interactive)
- (when (yes-or-no-p "Kill the buffer? ")
+ (when (or (not (buffer-modified-p))
+ (yes-or-no-p "Message modified; kill anyway? "))
(let ((actions message-kill-actions))
+ (setq buffer-file-name nil)
(kill-buffer (current-buffer))
(message-do-actions actions))))
Otherwise any failure is reported in a message back to
the user from the mailer."
(interactive "P")
- (when (if buffer-file-name
+ ;; Disabled test.
+ (when (if (and nil buffer-file-name)
(y-or-n-p (format "Send buffer contents as %s message? "
(if (message-mail-p)
(if (message-news-p) "mail and news" "mail")
(message-fix-before-sending)
(run-hooks 'message-send-hook)
(message "Sending...")
- (when (and (or (not (message-news-p))
- (and (or (not (memq 'news message-sent-message-via))
- (y-or-n-p
- "Already sent message via news; resend? "))
- (funcall message-send-news-function arg)))
- (or (not (message-mail-p))
- (and (or (not (memq 'mail message-sent-message-via))
- (y-or-n-p
- "Already sent message via mail; resend? "))
- (message-send-mail arg))))
- (message-do-fcc)
- ;;(when (fboundp 'mail-hist-put-headers-into-history)
- ;; (mail-hist-put-headers-into-history))
- (run-hooks 'message-sent-hook)
- (message "Sending...done")
- ;; If buffer has no file, mark it as unmodified and delete autosave.
- (unless buffer-file-name
+ (let ((alist message-send-method-alist)
+ (success t)
+ 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)))))
+ (setq sent t)))
+ (when (and success sent)
+ (message-do-fcc)
+ ;;(when (fboundp 'mail-hist-put-headers-into-history)
+ ;; (mail-hist-put-headers-into-history))
+ (run-hooks 'message-sent-hook)
+ (message "Sending...done")
+ ;; Mark the buffer as unmodified and delete autosave.
(set-buffer-modified-p nil)
- (delete-auto-save-file-if-necessary t))
- ;; Delete other mail buffers and stuff.
- (message-do-send-housekeeping)
- (message-do-actions message-send-actions)
- ;; Return success.
- t)))
+ (delete-auto-save-file-if-necessary t)
+ (message-disassociate-draft)
+ ;; Delete other mail buffers and stuff.
+ (message-do-send-housekeeping)
+ (message-do-actions message-send-actions)
+ ;; Return success.
+ t))))
+
+(defun message-send-via-mail (arg)
+ "Send the current message via mail."
+ (message-send-mail arg))
+
+(defun message-send-via-news (arg)
+ "Send the current message via news."
+ (funcall message-send-news-function arg))
(defun message-fix-before-sending ()
"Do various things to make the message nice before sending it."
;; qmail-inject doesn't say anything on it's stdout/stderr,
;; we have to look at the retval instead
(0 nil)
- (1 (error "qmail-inject reported permanent failure."))
- (111 (error "qmail-inject reported transient failure."))
+ (1 (error "qmail-inject reported permanent failure"))
+ (111 (error "qmail-inject reported transient failure"))
;; should never happen
- (t (error "qmail-inject reported unknown failure."))))
+ (t (error "qmail-inject reported unknown failure"))))
(defun message-send-mail-with-mh ()
"Send the prepared message buffer with mh."
(replace-match "\n")
(backward-char 1))
(run-hooks 'message-send-news-hook)
- (require (car method))
- (funcall (intern (format "%s-open-server" (car method)))
- (cadr method) (cddr method))
- (setq result
- (funcall (intern (format "%s-request-post" (car method))))))
+ ;;(require (car method))
+ ;;(funcall (intern (format "%s-open-server" (car method)))
+ ;;(cadr method) (cddr method))
+ ;;(setq result
+ ;; (funcall (intern (format "%s-request-post" (car method)))
+ ;; (cadr method)))
+ (gnus-open-server method)
+ (setq result (gnus-request-post method)))
(kill-buffer tembuf))
(set-buffer messbuf)
(if result
(defun message-check-news-header-syntax ()
(and
+ ;; Check the Subject header.
+ (message-check 'subject
+ (let* ((case-fold-search t)
+ (subject (message-fetch-field "subject")))
+ (or
+ (and subject
+ (not (string-match "\\`[ \t]*\\'" subject)))
+ (ignore
+ (message
+ "The subject field is empty or missing. Posting is denied.")))))
;; Check for commands in Subject.
(message-check 'subject-cmsg
(if (string-match "^cmsg " (message-fetch-field "subject"))
(y-or-n-p
(format "The Message-ID looks strange: \"%s\". Really post? "
message-id)))))
- ;; Check the Subject header.
- (message-check 'subject
- (let* ((case-fold-search t)
- (subject (message-fetch-field "subject")))
- (or
- (and subject
- (not (string-match "\\`[ \t]*\\'" subject)))
- (ignore
- (message
- "The subject field is empty or missing. Posting is denied.")))))
;; Check the Newsgroups & Followup-To headers.
(message-check 'existing-newsgroups
(let* ((case-fold-search t)
(y-or-n-p
(format "The %s header looks odd: \"%s\". Really post? "
(car headers) header)))))
+ (message-check 'repeated-newsgroups
+ (let ((case-fold-search t)
+ (headers '("Newsgroups" "Followup-To"))
+ header error groups group)
+ (while (and headers
+ (not error))
+ (when (setq header (mail-fetch-field (pop headers)))
+ (setq groups (message-tokenize-header header ","))
+ (while (setq group (pop groups))
+ (when (member group groups)
+ (setq error group
+ groups nil)))))
+ (if (not error)
+ t
+ (y-or-n-p
+ (format "Group %s is repeated in headers. Really post? " error)))))
;; Check the From header.
(message-check 'from
(let* ((case-fold-search t)
(concat "^" (regexp-quote mail-header-separator) "$"))
(while (not (eobp))
(when (not (looking-at "[ \t\n]"))
- (setq sum (logxor (ash sum 1) (following-char))))
+ (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1)
+ (following-char))))
(forward-char 1)))
sum))
;; Remove empty lines in the header.
(save-restriction
(message-narrow-to-headers)
+ ;; Remove blank lines.
(while (re-search-forward "^[ \t]*\n" nil t)
- (replace-match "" t t)))
+ (replace-match "" t t))
- ;; Correct Newsgroups and Followup-To headers: change sequence of
- ;; spaces to comma and eliminate spaces around commas. Eliminate
- ;; embedded line breaks.
- (goto-char (point-min))
- (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
- (save-restriction
- (narrow-to-region
- (point)
- (if (re-search-forward "^[^ \t]" nil t)
- (match-beginning 0)
- (forward-line 1)
- (point)))
- (goto-char (point-min))
- (while (re-search-forward "\n[ \t]+" nil t)
- (replace-match " " t t)) ;No line breaks (too confusing)
- (goto-char (point-min))
- (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
- (replace-match "," t t))
- (goto-char (point-min))
- ;; Remove trailing commas.
- (when (re-search-forward ",+$" nil t)
- (replace-match "" t t)))))
+ ;; Correct Newsgroups and Followup-To headers: Change sequence of
+ ;; spaces to comma and eliminate spaces around commas. Eliminate
+ ;; embedded line breaks.
+ (goto-char (point-min))
+ (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0)
+ (forward-line 1)
+ (point)))
+ (goto-char (point-min))
+ (while (re-search-forward "\n[ \t]+" nil t)
+ (replace-match " " t t)) ;No line breaks (too confusing)
+ (goto-char (point-min))
+ (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
+ (replace-match "," t t))
+ (goto-char (point-min))
+ ;; Remove trailing commas.
+ (when (re-search-forward ",+$" nil t)
+ (replace-match "" t t))))))
(defun message-make-date ()
"Make a valid data header."
(defun message-make-message-id ()
"Make a unique Message-ID."
(concat "<" (message-unique-id)
- (let ((psubject (save-excursion (message-fetch-field "subject"))))
- (if (and message-reply-headers
- (mail-header-references message-reply-headers)
- (mail-header-subject message-reply-headers)
- psubject
- (mail-header-subject message-reply-headers)
- (not (string=
- (message-strip-subject-re
- (mail-header-subject message-reply-headers))
- (message-strip-subject-re psubject))))
+ (let ((psubject (save-excursion (message-fetch-field "subject")))
+ (psupersedes
+ (save-excursion (message-fetch-field "supersedes"))))
+ (if (or
+ (and message-reply-headers
+ (mail-header-references message-reply-headers)
+ (mail-header-subject message-reply-headers)
+ psubject
+ (mail-header-subject message-reply-headers)
+ (not (string=
+ (message-strip-subject-re
+ (mail-header-subject message-reply-headers))
+ (message-strip-subject-re psubject))))
+ (and psupersedes
+ (string-match "_-_@" psupersedes)))
"_-_" ""))
"@" (message-make-fqdn) ">"))
(let ((stop-pos
(string-match " *at \\| *@ \\| *(\\| *<" from)))
(concat (if stop-pos (substring from 0 stop-pos) from)
- "'s message of "
+ "'s message of \""
(if (or (not date) (string= date ""))
- "(unknown date)" date)))))))
+ "(unknown date)" date)
+ "\""))))))
(defun message-make-distribution ()
"Make a Distribution header."
(defun message-make-from ()
"Make a From header."
- (let* ((login (message-make-address))
+ (let* ((style message-from-style)
+ (login (message-make-address))
(fullname
(or (and (boundp 'user-full-name)
user-full-name)
(save-excursion
(message-set-work-buffer)
(cond
- ((or (null message-from-style)
+ ((or (null style)
(equal fullname ""))
(insert login))
- ((or (eq message-from-style 'angles)
- (and (not (eq message-from-style 'parens))
+ ((or (eq style 'angles)
+ (and (not (eq style 'parens))
;; Use angles if no quoting is needed, or if parens would
;; need quoting too.
(or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname))
header value elem)
;; First we remove any old generated headers.
(let ((headers message-deletable-headers))
+ (unless (buffer-modified-p)
+ (setq headers (delq 'Message-ID (copy-sequence headers))))
(while headers
(goto-char (point-min))
(and (re-search-forward
(beginning-of-line)
(insert "Original-")
(beginning-of-line))
- (insert "Sender: " secure-sender "\n"))))))
+ (when (or (message-news-p)
+ (string-match "^[^@]@.+\\..+" secure-sender))
+ (insert "Sender: " secure-sender "\n")))))))
(defun message-insert-courtesy-copy ()
"Insert a courtesy message in mail copies of combined messages."
(copy-sequence message-required-mail-headers))))))
(run-hooks 'message-signature-setup-hook)
(message-insert-signature)
- (message-set-auto-save-file-name)
(save-restriction
(message-narrow-to-headers)
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
+ (setq buffer-undo-list nil)
(run-hooks 'message-setup-hook)
(message-position-point)
(undo-boundary))
(defun message-set-auto-save-file-name ()
"Associate the message buffer with a file in the drafts directory."
(when message-autosave-directory
- (unless (file-exists-p message-autosave-directory)
- (make-directory message-autosave-directory t))
- (let ((name (make-temp-name
- (concat (file-name-as-directory message-autosave-directory)
- "msg."))))
- (setq buffer-auto-save-file-name
- (save-excursion
- (prog1
- (progn
- (set-buffer (get-buffer-create " *draft tmp*"))
- (setq buffer-file-name name)
- (make-auto-save-file-name))
- (kill-buffer (current-buffer)))))
- (clear-visited-file-modtime))))
+ (setq message-draft-article (nndraft-request-associate-buffer "drafts"))
+ (clear-visited-file-modtime)))
+
+(defun message-disassociate-draft ()
+ "Disassociate the message buffer from the drafts directory."
+ (when message-draft-article
+ (nndraft-request-expire-articles
+ (list message-draft-article) "drafts" nil t)))
\f
(message-set-work-buffer)
(unless never-mct
(insert (or reply-to from "")))
- (insert (if (bolp) "" ", ") (or to ""))
+ (insert (if to (concat (if (bolp) "" ", ") to "") ""))
(insert (if mct (concat (if (bolp) "" ", ") mct) ""))
(insert (if cc (concat (if (bolp) "" ", ") cc) ""))
+ (goto-char (point-min))
+ (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)))
cur)))
;;;###autoload
-(defun message-wide-reply (&optional to-address)
+(defun message-wide-reply (&optional to-address ignore-reply-to)
"Make a \"wide\" reply to the message in the current buffer."
(interactive)
- (message-reply to-address t))
+ (message-reply to-address t ignore-reply-to))
;;;###autoload
(defun message-followup (&optional to-newsgroups)
mail-header-separator "\n"
message-cancel-message)
(message "Canceling your article...")
- (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
- (funcall message-send-news-function))
- (message "Canceling your article...done")
+ (if (let ((message-syntax-checks
+ 'dont-check-for-anything-just-trust-me))
+ (funcall message-send-news-function))
+ (message "Canceling your article...done"))
(kill-buffer buf)))))
;;;###autoload
(forward-line 2))
(and (re-search-forward message-unsent-separator nil t)
(forward-line 1))
- (and (search-forward "\n\n" nil t)
- (re-search-forward "^Return-Path:.*\n" nil t)))
+ (re-search-forward "^Return-Path:.*\n" nil t))
;; We remove everything before the bounced mail.
(delete-region
(point-min)
(insert string)
(if (not comp)
(message "No matching groups")
- (pop-to-buffer "*Completions*")
- (buffer-disable-undo (current-buffer))
- (let ((buffer-read-only nil))
- (erase-buffer)
- (let ((standard-output (current-buffer)))
- (display-completion-list (sort completions 'string<)))
- (goto-char (point-min))
- (pop-to-buffer cur)))))))
+ (save-selected-window
+ (pop-to-buffer "*Completions*")
+ (buffer-disable-undo (current-buffer))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (let ((standard-output (current-buffer)))
+ (display-completion-list (sort completions 'string<)))
+ (goto-char (point-min))
+ (delete-region (point) (progn (forward-line 3) (point))))))))))
;;; Help stuff.
(defun message-talkative-question (ask question show &rest text)
- "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW.
+ "Call FUNCTION with argument QUESTION; optionally display TEXT... args.
+If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer.
The following arguments may contain lists of values."
(if (and show
(setq text (message-flatten-list text)))
Then clone the local variables and values from the old buffer to the
new one, cloning only the locals having a substring matching the
regexp varstr."
- (let ((oldlocals (buffer-local-variables)))
+ (let ((oldbuf (current-buffer)))
(save-excursion
(set-buffer (generate-new-buffer name))
- (mapcar (lambda (dude)
- (when (and (car dude)
- (or (not varstr)
- (string-match varstr (symbol-name (car dude)))))
- (ignore-errors
- (set (make-local-variable (car dude))
- (cdr dude)))))
- oldlocals)
+ (message-clone-locals oldbuf)
(current-buffer))))
+(defun message-clone-locals (buffer)
+ "Clone the local variables from BUFFER to the current buffer."
+ (let ((locals (save-excursion
+ (set-buffer buffer)
+ (buffer-local-variables)))
+ (regexp "^gnus\\|^nn\\|^message"))
+ (mapcar
+ (lambda (local)
+ (when (and (consp local)
+ (car local)
+ (string-match regexp (symbol-name (car local))))
+ (ignore-errors
+ (set (make-local-variable (car local))
+ (cdr local)))))
+ locals)))
+
(run-hooks 'message-load-hook)
(provide 'message)
projects / gnus / blobdiff