;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
:group 'message-headers)
(defcustom message-syntax-checks nil
- ;; Guess this one shouldn't be easy to customize...
- "Controls what syntax checks should not be performed on outgoing posts.
+ ; Guess this one shouldn't be easy to customize...
+ "*Controls what syntax checks should not be performed on outgoing posts.
To disable checking of long signatures, for instance, add
`(signature . disabled)' to this list.
'(From Newsgroups Subject Date Message-ID
(optional . Organization) Lines
(optional . X-Newsreader))
- "Headers to be generated or prompted for when posting an article.
+ "*Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
Message-ID. Organization, Lines, In-Reply-To, Expires, and
X-Newsreader are optional. If don't you want message to insert some
(defcustom message-required-mail-headers
'(From Subject Date (optional . In-Reply-To) Message-ID Lines
(optional . X-Mailer))
- "Headers to be generated or prompted for when mailing a message.
+ "*Headers to be generated or prompted for when mailing a message.
RFC822 required that From, Date, To, Subject and Message-ID be
included. Organization, Lines and X-Mailer are optional."
:group 'message-mail
:group 'message-headers
:type 'regexp)
-(defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:"
+(defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:"
"*Regexp of headers to be removed unconditionally before mailing."
:group 'message-mail
:group 'message-headers
:type 'regexp)
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|X-Trace:\\|X-Complaints-To:\\|Return-Path:\\|^Supersedes:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
:group 'message-various)
(defcustom message-elide-elipsis "\n[...]\n\n"
- "*The string which is inserted for elided text.")
+ "*The string which is inserted for elided text."
+ :type 'string
+ :group 'message-various)
(defcustom message-interactive nil
"Non-nil means when sending a message wait for and display errors.
variable `mail-header-separator'.
Legal values include `message-send-mail-with-sendmail' (the default),
-`message-send-mail-with-mh' and `message-send-mail-with-qmail'."
+`message-send-mail-with-mh', `message-send-mail-with-qmail' and
+`message-send-mail-with-smtp'."
:type '(radio (function-item message-send-mail-with-sendmail)
(function-item message-send-mail-with-mh)
(function-item message-send-mail-with-qmail)
((boundp 'gnus-select-method)
gnus-select-method)
(t '(nnspool "")))
- "Method used to post news."
+ "*Method used to post news."
:group 'message-news
:group 'message-sending
;; This should be the `gnus-select-method' widget, but that might
:type 'hook)
(defcustom message-header-setup-hook nil
- "Hook called narrowed to the headers when setting up a message
-buffer."
+ "Hook called narrowed to the headers when setting up a message buffer."
:group 'message-various
:type 'hook)
mail-citation-hook)
mail-citation-hook
'message-cite-original)
- "*Function for citing an original message."
+ "*Function for citing an original message.
+Pre-defined functions include `message-cite-original' and
+`message-cite-original-without-signature'."
:type '(radio (function-item message-cite-original)
+ (function-item message-cite-original-without-signature)
(function-item sc-cite-original)
(function :tag "Other"))
:group 'message-insertion)
(define-widget 'message-header-lines 'text
"All header lines must be LFD terminated."
+ :format "%t:%n%v"
:valid-regexp "^\\'"
:error "All header lines must be newline terminated")
;; 33 and 126, except colon)", i. e., any chars except ctl chars,
;; space, or colon.
'(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
- "Set this non-nil if the system's mailer runs the header and body together.
+ "*Set this non-nil if the system's mailer runs the header and body together.
\(This problem exists on Sunos 4 when sendmail is run in remote mode.)
The value should be an expression to test whether the problem will
actually occur."
1 'message-separator-face)
(,(concat "^[ \t]*"
"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
- "[>|}].*")
+ "[:>|}].*")
(0 'message-cited-text-face))))
"Additional expressions to highlight in Message mode.")
(Lines)
(Expires)
(Message-ID)
- (References)
+ (References . message-fill-references)
(X-Mailer)
(X-Newsreader))
"Alist used for formatting headers.")
(autoload 'gnus-output-to-rmail "gnus-util")
(autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
(autoload 'nndraft-request-associate-buffer "nndraft")
- (autoload 'nndraft-request-expire-articles "nndraft"))
+ (autoload 'nndraft-request-expire-articles "nndraft")
+ (autoload 'gnus-open-server "gnus-int")
+ (autoload 'gnus-request-post "gnus-int")
+ (autoload 'rmail-output "rmail"))
\f
C-c C-y message-yank-original (insert current message, if any).
C-c C-q message-fill-yanked-message (fill what was yanked).
C-c C-e message-elide-region (elide the text between point and mark).
+C-c C-z message-kill-to-signature (kill the text up to the signature).
C-c C-r message-caesar-buffer-body (rot13 the message body)."
(interactive)
(kill-all-local-variables)
(mail-abbrevs-setup)
(funcall (intern "mail-aliases-setup"))))
(message-set-auto-save-file-name)
- (run-hooks 'text-mode-hook 'message-mode-hook)
(unless (string-match "XEmacs" emacs-version)
(set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t))))
+ '(message-font-lock-keywords t)))
+ (run-hooks 'text-mode-hook 'message-mode-hook))
\f
(interactive)
(let ((point (point)))
(message-goto-signature)
- (kill-region point (point))))
+ (unless (eobp)
+ (forward-line -2))
+ (kill-region point (point))
+ (unless (bolp)
+ (insert "\n"))))
(defun message-newline-and-reformat ()
"Insert four newlines, and then reformat if inside quoted text."
(or (bolp) (insert "\n")))))
(defun message-elide-region (b e)
- "Elide the text between point and mark. An ellipsis (from
-message-elide-elipsis) will be inserted where the text was killed."
+ "Elide the text between point and mark.
+An ellipsis (from `message-elide-elipsis') will be inserted where the
+text was killed."
(interactive "r")
(kill-region b e)
(unless (bolp)
(unless modified
(setq message-checksum (cons (message-checksum) (buffer-size)))))))
+(defun message-cite-original-without-signature ()
+ "Cite function in the standard Message manner."
+ (let ((start (point))
+ (end (mark t))
+ (functions
+ (when message-indent-citation-function
+ (if (listp message-indent-citation-function)
+ message-indent-citation-function
+ (list message-indent-citation-function)))))
+ (goto-char end)
+ (when (re-search-backward "^-- $" start t)
+ (delete-region (point) end))
+ (goto-char start)
+ (while functions
+ (funcall (pop functions)))
+ (when message-citation-line-function
+ (unless (bolp)
+ (insert "\n"))
+ (funcall message-citation-line-function))))
+
(defun message-cite-original ()
"Cite function in the standard Message manner."
(let ((start (point))
(defun message-dont-send ()
"Don't send the message you have been editing."
(interactive)
+ (set-buffer-modified-p t)
+ (save-buffer)
(let ((actions message-postpone-actions))
(message-bury (current-buffer))
(message-do-actions actions)))
the user from the mailer."
(interactive "P")
;; Disabled test.
- (when (if (and buffer-file-name
- nil)
- (y-or-n-p (format "Send buffer contents as %s message? "
- (if (message-mail-p)
- (if (message-news-p) "mail and news" "mail")
- "news")))
- (or (buffer-modified-p)
- (message-check-element 'unchanged)
- (y-or-n-p "No changes in the buffer; really send? ")))
+ (when (or (buffer-modified-p)
+ (message-check-element 'unchanged)
+ (y-or-n-p "No changes in the buffer; really send? "))
;; Make it possible to undo the coming changes.
(undo-boundary)
(let ((inhibit-read-only t))
(let* ((case-fold-search t)
(message-id (message-fetch-field "message-id" t)))
(or (not message-id)
+ ;; Is there an @ in the ID?
(and (string-match "@" message-id)
- (string-match "@[^\\.]*\\." message-id))
+ ;; Is there a dot in the ID?
+ (string-match "@[^.]*\\." message-id)
+ ;; Does the ID end with a dot?
+ (not (string-match "\\.>" message-id)))
(y-or-n-p
(format "The Message-ID looks strange: \"%s\". Really post? "
message-id)))))
(while (setq file (message-fetch-field "fcc"))
(push file list)
(message-remove-header "fcc" nil t)))
- (run-hooks 'message-header-hook)
- (run-hooks 'message-before-do-fcc-hook)
+ (run-hooks 'message-header-hook 'message-before-do-fcc-hook)
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(replace-match "" t t)
(insert "Original-")
(beginning-of-line))
(when (or (message-news-p)
- (string-match "^[^@]@.+\\..+" secure-sender))
+ (string-match "^[^@]+@.+\\..+" secure-sender))
(insert "Sender: " secure-sender "\n")))))))
(defun message-insert-courtesy-copy ()
(widen)
(forward-line 1)))
+(defun message-fill-references (header value)
+ (insert (capitalize (symbol-name header))
+ ": "
+ (std11-fill-msg-id-list-string
+ (if (consp value) (car value) value))
+ "\n"))
+
(defun message-fill-header (header value)
(let ((begin (point))
- (fill-column 78)
+ (fill-column 990)
(fill-prefix "\t"))
(insert (capitalize (symbol-name header))
": "
`((Subject . ,subject)
,@follow-to
,@(if (or references message-id)
- `((References . ,(std11-fill-msg-id-list-string
- (concat references message-id)))))
- )
+ `((References . ,(concat (or references "") (and references " ")
+ (or message-id ""))))
+ nil))
cur)))
;;;###autoload
`((Newsgroups . ,newsgroups))))
,@(and distribution (list (cons 'Distribution distribution)))
,@(if (or references message-id)
- `((References . ,(std11-fill-msg-id-list-string
- (concat references message-id)))))
+ `((References . ,(concat (or references "") (and references " ")
+ (or message-id "")))))
,@(when (and mct
(not (equal (downcase mct) "never")))
(list (cons 'Cc (if (equal (downcase mct) "always")
(unless (message-news-p)
(error "This is not a news article; canceling is impossible"))
(when (yes-or-no-p "Do you really want to cancel this article? ")
- (let (from newsgroups message-id distribution buf)
+ (let (from newsgroups message-id distribution buf sender)
(save-excursion
;; Get header info. from original article.
(save-restriction
(message-narrow-to-head)
(setq from (message-fetch-field "from")
+ sender (message-fetch-field "sender")
newsgroups (message-fetch-field "newsgroups")
message-id (message-fetch-field "message-id" t)
distribution (message-fetch-field "distribution")))
;; Make sure that this article was written by the user.
(unless (string-equal
- (downcase (cadr (std11-extract-address-components from)))
+ (downcase
+ (or sender (cadr (std11-extract-address-components from))))
(downcase (message-make-address)))
(error "This article is not yours"))
;; Make control message.
(goto-char (point-max)))
(insert mail-header-separator)
;; Rename all old ("Also-")Resent headers.
- (while (re-search-backward "^\\(Also-\\)?Resent-" beg t)
+ (while (re-search-backward "^\\(Also-\\)*Resent-" beg t)
(beginning-of-line)
(insert "Also-"))
;; Quote any "From " lines at the beginning.
(defvar gnus-active-hashtb)
(defun message-expand-group ()
+ "Expand the group name under point."
(let* ((b (save-excursion
(save-restriction
(narrow-to-region