(require 'mail-abbrevs))
(require 'mail-parse)
(require 'mml)
+(require 'rfc822)
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
'(From Subject Date (optional . In-Reply-To) Message-ID Lines
(optional . User-Agent))
"*Headers to be generated or prompted for when mailing a message.
-RFC822 required that From, Date, To, Subject and Message-ID be
+It is recommended that From, Date, To, Subject and Message-ID be
included. Organization, Lines and User-Agent are optional."
:group 'message-mail
:group 'message-headers
:group 'message-insertion)
(defcustom message-yank-cited-prefix ">"
- "*Prefix inserted on cited lines of yanked messages.
+ "*Prefix inserted on cited or empty lines of yanked messages.
Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
See also `message-yank-prefix'."
:type 'string
(defvar message-send-mail-real-function nil
"Internal send mail function.")
+(defvar message-bogus-system-names "^localhost\\."
+ "The regexp of bogus system names.")
+
(eval-and-compile
(autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-new-draft-name "mh-comp")
["Spellcheck" ispell-message
,@(if (featurep 'xemacs) '(t)
'(:help "Spellcheck this message"))]
- ["Attach file as MIME" mml-attach-file
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Attach a file at point"))]
"----"
["Send Message" message-send-and-exit
,@(if (featurep 'xemacs) '(t)
'(:help "Send this message"))]
- ["Abort Message" message-dont-send
+ ["Postpone Message" message-dont-send
,@(if (featurep 'xemacs) '(t)
'(:help "File this draft message and exit"))]
["Kill Message" message-kill-buffer
(defun message-fill-paragraph (&optional arg)
"Like `fill-paragraph'."
(interactive (list (if current-prefix-arg 'full)))
- (message-newline-and-reformat arg t)
- t)
+ (if (and (boundp 'filladapt-mode) filladapt-mode)
+ nil
+ (message-newline-and-reformat arg t)
+ t))
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for variable `message-signature'."
(indent-rigidly start (mark t) message-indentation-spaces)
(save-excursion
(goto-char start)
- (while (< (point) (mark t))
- (if (looking-at message-cite-prefix-regexp)
+ (let (last-line)
+ ;; `last-line' describes the contents of the last line
+ ;; encountered in the loop below. nil means "empty line",
+ ;; spaces "line consisting entirely of whitespace",
+ ;; right-angle "line starts with >", quoted "quote character
+ ;; at the beginning of the line", text "the remaining cases".
+ (while (< (point) (mark t))
+ (cond
+ ((eolp)
(insert message-yank-cited-prefix)
- (insert message-yank-prefix))
- (forward-line 1))))
+ (setq last-line nil))
+ ((looking-at ">")
+ (if (memq last-line '(nil spaces right-angle quoted))
+ (progn
+ (insert message-yank-cited-prefix)
+ (setq last-line 'quoted))
+ (insert message-yank-prefix)
+ (setq last-line 'right-angle)))
+ ((looking-at "\\s-+$")
+ (insert message-yank-prefix)
+ (setq last-line 'spaces))
+ (t
+ (insert message-yank-prefix)
+ (setq last-line 'text)))
+ (forward-line 1)))))
(goto-char start)))
(defun message-yank-original (&optional arg)
(cons '(valid-newsgroups . disabled)
message-syntax-checks)))
(message-cleanup-headers)
- (if (not (message-check-news-syntax))
+ (if (not (let ((message-post-method method))
+ (message-check-news-syntax)))
nil
(unwind-protect
(save-excursion
(known-groups
(mapcar (lambda (n) (gnus-group-real-name n))
(gnus-groups-from-server
- (cond ((equal gnus-post-method 'current)
- gnus-current-select-method)
- (gnus-post-method gnus-post-method)
- (t gnus-select-method)))))
+ (if (message-functionp message-post-method)
+ (funcall message-post-method)
+ message-post-method))))
errors)
(while groups
(unless (or (equal (car groups) "poster")
(message
"Denied posting -- the From looks strange: \"%s\"." from)
nil)
+ ((let ((addresses (rfc822-addresses from)))
+ (while (and addresses
+ (not (eq (string-to-char (car addresses)) ?\()))
+ (setq addresses (cdr addresses)))
+ addresses)
+ (message
+ "Denied posting -- bad From address: \"%s\"." from)
+ nil)
(t t))))
;; Check the Reply-To header.
(message-check 'reply-to
(let ((system-name (system-name))
(user-mail (message-user-mail-address)))
(cond
- ((string-match "[^.]\\.[^.]" system-name)
+ ((and (string-match "[^.]\\.[^.]" system-name)
+ (not (string-match message-bogus-system-names system-name)))
;; `system-name' returned the right result.
system-name)
;; Try `mail-host-address'.
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
(setq buffer-file-name (expand-file-name
- (if (eq system-type 'windows-nt)
+ (if (memq system-type
+ '(ms-dos ms-windows windows-nt
+ cygwin32 win32 w32
+ mswindows))
"message"
"*message*")
message-auto-save-directory))
;; Allow the user to be asked whether or not to reply to all
;; recipients in a wide reply.
(if (and ccalist wide message-wide-reply-confirm-recipients
- (not (y-or-n-p "Reply to all recipients?")))
+ (not (y-or-n-p "Reply to all recipients? ")))
(setq follow-to (delq (assoc 'Cc follow-to) follow-to)))))
follow-to))
"Alist of (RE . FUN). Use FUN for completion on header lines matching RE.")
(defun message-tab ()
- "Expand group names in Newsgroups and Followup-To headers.
-Do a `tab-to-tab-stop' if not in those headers."
+ "Complete names according to `message-completion-alist'.
+Do an `indent-relative' if not in those headers."
(interactive)
(let ((alist message-completion-alist))
(while (and alist
(let ((mail-abbrev-mode-regexp (caar alist)))
(not (mail-abbrev-in-expansion-header-p))))
(setq alist (cdr alist)))
- (funcall (or (cdar alist) (default-value 'indent-line-function)))))
+ (funcall (or (cdar alist) 'indent-relative))))
(defun message-expand-group ()
"Expand the group name under point."
projects / gnus / blobdiff