(require 'mail-abbrevs)
(require 'mailabbrev))
-;;;###autoload
(defvar message-directory "~/Mail/"
"*Directory from which all other mail file variables are derived.")
(defvar message-max-buffers 10
"*How many buffers to keep before starting to kill them off.")
+(defvar message-send-rename-function nil
+ "Function called to rename the buffer after sending it.")
+
;;;###autoload
(defvar message-fcc-handler-function 'rmail-output
"*A function called to save outgoing articles.
This function will be called with the name of the file to store the
-article in. The default function is `rmail-output' which saves in Unix
+article in. The default function is `rmail-output' which saves in Unix
mailbox format.")
;;;###autoload
(defvar message-courtesy-message
- "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n"
+ "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
"*This is inserted at the start of a mailed copy of a posted message.
+If the string contains the format spec \"%s\", the Newsgroups
+the article has been posted to will be inserted there.
If this variable is nil, no such courtesy message will be added.")
;;;###autoload
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.")
+approved sender empty empty-headers message-id from subject
+shorten-followup-to existing-newsgroups.")
;;;###autoload
(defvar message-required-news-headers
included. Organization, Lines and X-Mailer are optional.")
;;;###autoload
-(defvar message-deletable-headers '(Message-ID Date)
+(defvar message-deletable-headers '(Message-ID Date Lines)
"*Headers to be deleted if they already exist and were generated by message previously.")
;;;###autoload
(defvar message-ignored-news-headers
- "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:"
+ "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:\\|^Resent-Fcc:"
"*Regexp of headers to be removed unconditionally before posting.")
;;;###autoload
-(defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:"
+(defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:\\|^Resent-Fcc:"
"*Regexp of headers to be removed unconditionally before mailing.")
;;;###autoload
-(defvar message-ignored-supersedes-headers
- "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:"
+(defvar message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|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.")
;;;###autoload
(defvar message-generate-new-buffers t
- "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.")
+ "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.
+If this is a function, call that function with three parameters: The type,
+the to address and the group name. (Any of these may be nil.) The function
+should return the new buffer name.")
;;;###autoload
(defvar message-kill-buffer-on-exit nil
"*Non-nil means that the message buffer will be killed after sending a message.")
(defvar gnus-local-organization)
-;;;###autoload
(defvar message-user-organization
(or (and (boundp 'gnus-local-organization)
gnus-local-organization)
(defvar message-user-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
-;;;###autoload
-(defvar message-autosave-directory
- (concat (file-name-as-directory message-directory) "drafts/")
+(defvar message-autosave-directory "~/"
+ ; (concat (file-name-as-directory message-directory) "drafts/")
"*Directory where message autosaves buffers.
If nil, message won't autosave.")
;;;###autoload
(defvar message-ignored-cited-headers "."
- "Delete these headers from the messages you yank.")
+ "*Delete these headers from the messages you yank.")
+
+(defvar message-cancel-message "I am canceling my own article."
+ "Message to be inserted in the cancel message.")
;; Useful to set in site-init.el
;;;###autoload
The headers should be delimited by a line whose contents match the
variable `mail-header-separator'.
-Legal values include `message-send-mail-with-mh' and
-`message-send-mail-with-sendmail', which is the default.")
+Legal values include `message-send-mail-with-sendmail' (the default),
+`message-send-mail-with-mh' and `message-send-mail-with-qmail'.")
;;;###autoload
(defvar message-send-news-function 'message-send-news
;;;###autoload
(defvar message-use-followup-to 'ask
"*Specifies what to do with Followup-To header.
-If nil, ignore the header. If it is t, use its value, but query before
+If nil, ignore the header. If it is t, use its value, but query before
using the \"poster\" value. If it is the symbol `ask', query the user
whether to ignore the \"poster\" value. If it is the symbol `use',
always use the value.")
+;; qmail-related stuff
+(defvar message-qmail-inject-program "/var/qmail/bin/qmail-inject"
+ "Location of the qmail-inject program.")
+
+(defvar message-qmail-inject-args nil
+ "Arguments passed to qmail-inject programs.
+This should be a list of strings, one string for each argument.
+
+For e.g., if you wish to set the envelope sender address so that bounces
+go to the right place or to deal with listserv's usage of that address, you
+might set this variable to '(\"-f\" \"you@some.where\").")
+
(defvar gnus-post-method)
(defvar gnus-select-method)
;;;###autoload
"Normal hook, run each time a new outgoing message is initialized.
The function `message-setup' runs this hook.")
+(defvar message-signature-setup-hook nil
+ "Normal hook, run each time a new outgoing message is initialized.
+It is run after the headers have been inserted and before
+the signature is inserted.")
+
(defvar message-mode-hook nil
"Hook run in message mode buffers.")
;;;###autoload
(defvar message-signature-file "~/.signature"
- "*File containing the text inserted at end of message. buffer.")
+ "*File containing the text inserted at end of message buffer.")
(defvar message-distribution-function nil
"*Function called to return a Distribution header.")
(re-search-forward "^OR\\>" nil t)))
(kill-buffer buffer))))
;; According to RFC822, "The field-name must be composed of printable
- ;; ASCII characters (i.e. characters that have decimal values between
- ;; 33 and 126, except colon)", i.e. any chars except ctl chars,
+ ;; ASCII characters (i. e., characters that have decimal values between
+ ;; 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.
The value should be an expression to test whether the problem will
actually occur.")
+;;; Internal variables.
+;;; Well, not really internal.
+
(defvar message-mode-syntax-table
(let ((table (copy-syntax-table text-mode-syntax-table)))
(modify-syntax-entry ?% ". " table)
table)
"Syntax table used while in Message mode.")
+(defvar message-mode-abbrev-table text-mode-abbrev-table
+ "Abbrev table used in Message mode buffers.
+Defaults to `text-mode-abbrev-table'.")
+
(defvar message-font-lock-keywords
(let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")))
(list '("^To:" . font-lock-function-name-face)
"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
"[>|}].*")
'font-lock-reference-face)
- '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*"
+ '("^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):.*"
. font-lock-string-face)))
"Additional expressions to highlight in Message mode.")
(defvar message-buffer-list nil)
+;; Byte-compiler warning
+(defvar gnus-active-hashtb)
+
;;; Regexp matching the delimiter of messages in UNIX mail format
;;; (UNIX From lines), minus the initial ^.
(defvar message-unix-mail-delimiter
(defvar message-header-format-alist
`((Newsgroups)
- (To . message-fill-header)
- (Cc . message-fill-header)
+ (To . message-fill-address)
+ (Cc . message-fill-address)
(Subject)
(In-Reply-To)
(Fcc)
(Lines)
(Expires)
(Message-ID)
- (References . message-fill-header)
+ (References)
(X-Mailer)
(X-Newsreader))
"Alist used for formatting headers.")
(point)
(goto-char p))))
+(defmacro message-y-or-n-p (question show &rest text)
+ "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW"
+ `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
+
;; Delete the current line (and the next N lines.);
(defmacro message-delete-line (&optional n)
`(delete-region (progn (beginning-of-line) (point))
(defun message-tokenize-header (header &optional separator)
"Split HEADER into a list of header elements.
\",\" is used as the separator."
- (let* ((beg 0)
- (separator (or separator ","))
- (regexp
- (format "[ \t]*\\([^%s]+\\)?\\([%s]+\\|\\'\\)" separator separator))
- elems)
- (while (and (string-match regexp header beg)
- (< beg (length header)))
- (when (match-beginning 1)
- (push (match-string 1 header) elems))
- (setq beg (match-end 0)))
- (nreverse elems)))
+ (let ((regexp (format "[%s]+" (or separator ",")))
+ (beg 1)
+ (first t)
+ quoted elems paren)
+ (save-excursion
+ (message-set-work-buffer)
+ (insert header)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if first
+ (setq first nil)
+ (forward-char 1))
+ (cond ((and (> (point) beg)
+ (or (eobp)
+ (and (looking-at regexp)
+ (not quoted)
+ (not paren))))
+ (push (buffer-substring beg (point)) elems)
+ (setq beg (match-end 0)))
+ ((= (following-char) ?\")
+ (setq quoted (not quoted)))
+ ((and (= (following-char) ?\()
+ (not quoted))
+ (setq paren t))
+ ((and (= (following-char) ?\))
+ (not quoted))
+ (setq paren nil))))
+ (nreverse elems))))
(defun message-fetch-field (header)
"The same as `mail-fetch-field', only remove all newlines."
(forward-char -1)))
(lambda ()
(or (get-text-property (point) 'message-rank)
- 0))))
+ 10000))))
(defun message-sort-headers ()
"Sort the headers of the current message according to `message-header-format-alist'."
["To" message-goto-to t]
["Subject" message-goto-subject t]
["Cc" message-goto-cc t]
- ["Reply-to" message-goto-reply-to t]
+ ["Reply-To" message-goto-reply-to t]
["Summary" message-goto-summary t]
["Keywords" message-goto-keywords t]
["Newsgroups" message-goto-newsgroups t]
C-c C-w message-insert-signature (insert `message-signature-file' file).
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-r message-ceasar-buffer-body (rot13 the message body)."
+C-c C-r message-caesar-buffer-body (rot13 the message body)."
(interactive)
(kill-all-local-variables)
(make-local-variable 'message-reply-buffer)
(make-local-variable 'message-postpone-actions)
(set-syntax-table message-mode-syntax-table)
(use-local-map message-mode-map)
- (setq local-abbrev-table text-mode-abbrev-table)
+ (setq local-abbrev-table message-mode-abbrev-table)
(setq major-mode 'message-mode)
(setq mode-name "Message")
(setq buffer-offer-save t)
(make-local-variable 'paragraph-start)
(setq paragraph-start (concat (regexp-quote mail-header-separator)
"$\\|[ \t]*[-_][-_][-_]+$\\|"
+ "-- $\\|"
paragraph-start))
(setq paragraph-separate (concat (regexp-quote mail-header-separator)
"$\\|[ \t]*[-_][-_][-_]+$\\|"
+ "-- $\\|"
paragraph-separate))
(make-local-variable 'message-reply-headers)
(setq message-reply-headers nil)
(setq message-sent-message-via nil)
(make-local-variable 'message-checksum)
(setq message-checksum nil)
- (when (fboundp 'mail-hist-define-keys)
- (mail-hist-define-keys))
+ ;;(when (fboundp 'mail-hist-define-keys)
+ ;; (mail-hist-define-keys))
(when (string-match "XEmacs\\|Lucid" emacs-version)
(message-setup-toolbar))
(easy-menu-add message-mode-menu message-mode-map)
(defun message-goto-body ()
"Move point to the beginning of the message body."
(interactive)
+ (if (looking-at "[ \t]*\n") (expand-abbrev))
(goto-char (point-min))
(search-forward (concat "\n" mail-header-separator "\n") nil t))
(defun message-insert-to ()
"Insert a To header that points to the author of the article being replied to."
(interactive)
- (when (message-position-on-field "To")
+ (when (and (message-position-on-field "To")
+ (mail-fetch-field "to")
+ (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
(insert ", "))
(insert (or (message-fetch-reply-field "reply-to")
(message-fetch-reply-field "from") "")))
(defun message-insert-newsgroups ()
"Insert the Newsgroups header from the article being replied to."
(interactive)
- (when (message-position-on-field "Newsgroups")
+ (when (and (message-position-on-field "Newsgroups")
+ (mail-fetch-field "newsgroups")
+ (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
(insert ","))
(insert (or (message-fetch-reply-field "newsgroups") "")))
(defun message-insert-signature (&optional force)
"Insert a signature. See documentation for the `message-signature' variable."
- (interactive (list t))
+ (interactive (list 0))
(let* ((signature
(cond ((and (null message-signature)
+ (eq force 0))
+ (save-excursion
+ (goto-char (point-max))
+ (not (re-search-backward
+ message-signature-separator nil t))))
+ ((and (null message-signature)
force)
t)
((message-functionp message-signature)
(file-exists-p message-signature-file))
signature))))
(when signature
- ;; Remove blank lines at the end of the message.
(goto-char (point-max))
- (skip-chars-backward " \t\n")
- (end-of-line)
- (delete-region (point) (point-max))
;; Insert the signature.
- (insert "\n\n-- \n")
+ (unless (bolp)
+ (insert "\n"))
+ (insert "\n-- \n")
(if (eq signature t)
(insert-file-contents message-signature-file)
(insert signature))
(name-default (concat "*message* " mail-trimmed-to))
(name (if enter-string
(read-string "New buffer name: " name-default)
- name-default)))
+ name-default))
+ (default-directory
+ (file-name-as-directory message-autosave-directory)))
(rename-buffer name t)))))
(defun message-fill-yanked-message (&optional justifyp)
(if (search-forward "\n\n" nil t)
(1- (point))
(point)))
- (message-remove-header message-ignored-cited-headers t)))
+ (message-remove-header message-ignored-cited-headers t)
+ (goto-char (point-max))))
+ ;; Delete blank lines at the start of the buffer.
+ (while (and (point-min)
+ (eolp))
+ (message-delete-line))
+ ;; Delete blank lines at the end of the buffer.
+ (goto-char (point-max))
+ (unless (eolp)
+ (insert "\n"))
+ (while (and (zerop (forward-line -1))
+ (looking-at "$"))
+ (message-delete-line))
;; Do the indentation.
(if (null message-yank-prefix)
(indent-rigidly start (mark t) message-indentation-spaces)
Normally indents each nonblank line ARG spaces (default 3). However,
if `message-yank-prefix' is non-nil, insert that prefix on each line.
+This function uses `message-cite-function' to do the actual citing.
+
Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers."
(interactive "P")
(delete-windows-on message-reply-buffer t)
(insert-buffer message-reply-buffer)
(funcall message-cite-function)
- (exchange-point-and-mark)
+ (message-exchange-point-and-mark)
(unless (bolp)
(insert ?\n))
(unless modified
- (setq message-checksum (message-checksum))))))
+ (setq message-checksum (cons (message-checksum) (buffer-size)))))))
-(defun message-cite-original ()
+(defun message-cite-original ()
+ "Cite function in the standard Message manner."
(let ((start (point))
(functions
(when message-indent-citation-function
(save-excursion
(let ((start (point))
mark)
- (if (not (re-search-forward message-signature-separator (mark t) t))
- ;; No signature here, so we just indent the cited text.
+ (if (not (re-search-forward message-signature-separator (mark t) t))
+ ;; No signature here, so we just indent the cited text.
+ (message-indent-citation)
+ ;; Find the last non-empty line.
+ (forward-line -1)
+ (while (looking-at "[ \t]*$")
+ (forward-line -1))
+ (forward-line 1)
+ (setq mark (set-marker (make-marker) (point)))
+ (goto-char start)
(message-indent-citation)
- ;; Find the last non-empty line.
- (forward-line -1)
- (while (looking-at "[ \t]*$")
- (forward-line -1))
- (forward-line 1)
- (setq mark (set-marker (make-marker) (point)))
- (goto-char start)
- (message-indent-citation)
- ;; Enable undoing the deletion.
- (undo-boundary)
- (delete-region mark (mark t))
- (set-marker mark nil)))))
+ ;; Enable undoing the deletion.
+ (undo-boundary)
+ (delete-region mark (mark t))
+ (set-marker mark nil)))))
\f
(defun message-dont-send ()
"Don't send the message you have been editing."
(interactive)
- (message-bury (current-buffer))
- (message-do-actions message-postpone-actions))
+ (let ((actions message-postpone-actions))
+ (message-bury (current-buffer))
+ (message-do-actions actions)))
(defun message-kill-buffer ()
"Kill the current buffer."
(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))
+ (put-text-property (point-min) (point-max) 'read-only nil))
(message-fix-before-sending)
(run-hooks 'message-send-hook)
(message "Sending...")
"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))
+ ;;(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.
(save-excursion
(set-buffer tembuf)
(erase-buffer)
- (insert-buffer-substring mailbuf)
+ ;; Avoid copying text props.
+ (insert (format
+ "%s" (save-excursion
+ (set-buffer mailbuf)
+ (buffer-string))))
;; Remove some headers.
(save-restriction
(message-narrow-to-headers)
(when (bufferp errbuf)
(kill-buffer errbuf)))))
+(defun message-send-mail-with-qmail ()
+ "Pass the prepared message buffer to qmail-inject.
+Refer to the documentation for the variable `message-send-mail-function'
+to find out how to use this."
+ ;; replace the header delimiter with a blank line
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ ;; send the message
+ (case
+ (apply
+ 'call-process-region 1 (point-max) message-qmail-inject-program
+ nil nil nil
+ ;; qmail-inject's default behaviour is to look for addresses on the
+ ;; command line; if there're none, it scans the headers.
+ ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
+ ;;
+ ;; in general, ALL of qmail-inject's defaults are perfect for simply
+ ;; reading a formatted (i. e., at least a To: or Resent-To header)
+ ;; message from stdin.
+ ;;
+ ;; qmail also has the advantage of not having been raped by
+ ;; various vendors, so we don't have to allow for that, either --
+ ;; compare this with message-send-mail-with-sendmail and weep
+ ;; for sendmail's lost innocence.
+ ;;
+ ;; all this is way cool coz it lets us keep the arguments entirely
+ ;; free for -inject-arguments -- a big win for the user and for us
+ ;; since we don't have to play that double-guessing game and the user
+ ;; gets full control (no gestapo'ish -f's, for instance). --sj
+ message-qmail-inject-args)
+ ;; 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."))
+ ;; should never happen
+ (t (error "qmail-inject reported unknown failure."))))
+
+
(defun message-send-mail-with-mh ()
"Send the prepared message buffer with mh."
(let ((mh-previous-window-config nil)
(concat (file-name-as-directory message-autosave-directory)
"msg."))))
(setq buffer-file-name name)
- (mh-send-letter)
- (condition-case ()
- (delete-file name)
- (error nil))))
+ ;; MH wants to generate these headers itself.
+ (let ((headers message-deletable-headers))
+ (while headers
+ (goto-char (point-min))
+ ;;(message "Deleting header %s" (car headers)) (sit-for 5)
+ (and (re-search-forward
+ (concat "^" (symbol-name (car headers)) ": *") nil t)
+ (message-delete-line))
+ (pop headers)))
+ ;; Pass it on to mh.
+ (mh-send-letter)))
(defun message-send-news (&optional arg)
(let ((tembuf (generate-new-buffer " *message temp*"))
(funcall message-post-method arg)
message-post-method))
(messbuf (current-buffer))
+ (message-syntax-checks
+ (if arg
+ (cons '(existing-newsgroups . disabled)
+ message-syntax-checks)
+ message-syntax-checks))
result)
(save-restriction
(message-narrow-to-headers)
(message-generate-headers message-required-news-headers)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
- (when (message-check-news-syntax)
+ (message-cleanup-headers)
+ (if (not (message-check-news-syntax))
+ (progn
+ (message "Posting nor performed")
+ nil)
(unwind-protect
(save-excursion
(set-buffer tembuf)
(buffer-disable-undo (current-buffer))
(erase-buffer)
- (insert-buffer-substring messbuf)
+ ;; Avoid copying text props.
+ (insert (format
+ "%s" (save-excursion
+ (set-buffer messbuf)
+ (buffer-string))))
;; Remove some headers.
(save-restriction
(message-narrow-to-headers)
(or (= (preceding-char) ?\n)
(insert ?\n))
(let ((case-fold-search t))
- ;; Remove the delimeter.
+ ;; Remove the delimiter.
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "\n"))
(save-excursion
(if (string-match "^cmsg " (message-fetch-field "subject"))
(y-or-n-p
- "The control code \"cmsg \" is in the subject. Really post? ")
+ "The control code \"cmsg \" is in the subject. Really post? ")
t)))
;; Check for multiple identical headers.
(or (message-check-element 'multiple-headers)
(setq found nil))))
(if found
(y-or-n-p
- (format "Multiple %s headers. Really post? " found))
+ (format "Multiple %s headers. Really post? " found))
t))))
;; Check for Version and Sendsys.
(or (message-check-element 'sendsys)
(save-excursion
(if (re-search-forward "^Sendsys:\\|^Version:" nil t)
(y-or-n-p
- (format "The article contains a %s command. Really post? "
+ (format "The article contains a %s command. Really post? "
(buffer-substring (match-beginning 0)
(1- (match-end 0)))))
t)))
(goto-char (point-min))
(insert "Followup-To: " to "\n"))
t))
-
+ ;; Check "Shoot me".
+ (or (message-check-element 'shoot)
+ (save-excursion
+ (if (re-search-forward
+ "Message-ID.*.i-have-a-misconfigured-system-so-shoot-me"
+ nil t)
+ (y-or-n-p
+ "You appear to have a misconfigured system. Really post? ")
+ t)))
;; Check for Approved.
(or (message-check-element 'approved)
(save-excursion
(if (re-search-forward "^Approved:" nil t)
(y-or-n-p
- "The article contains an Approved header. Really post? ")
+ "The article contains an Approved header. Really post? ")
t)))
- ;; Check the Message-Id header.
+ ;; Check the Message-ID header.
(or (message-check-element 'message-id)
(save-excursion
(let* ((case-fold-search t)
(string-match "@[^\\.]*\\." message-id))
(y-or-n-p
(format
- "The Message-ID looks strange: \"%s\". Really post? "
+ "The Message-ID looks strange: \"%s\". Really post? "
message-id))))))
;; Check the Subject header.
(or
(if (not hashtb)
t
(while groups
- (unless (boundp (intern (car groups) hashtb))
+ (when (and (not (boundp (intern (car groups) hashtb)))
+ (not (equal (car groups) "poster")))
(push (car groups) errors))
(pop groups))
(if (not errors)
(while (and headers (not error))
(when (setq header (mail-fetch-field (car headers)))
(if (or
- (not (string-match
- "\\`\\([-.a-zA-Z0-9]+\\)?\\(,[-.a-zA-Z0-9]+\\)*\\'"
- header))
+ (not
+ (string-match
+ "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
+ header))
(memq
nil (mapcar
(lambda (g)
(car headers) header)))))
;; Check the From header.
(or
- (message-check-element 'from)
(save-excursion
(let* ((case-fold-search t)
(from (message-fetch-field "from")))
(concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
(let ((b (point)))
- (or (re-search-forward message-signature-separator nil t)
- (goto-char (point-max)))
+ (goto-char (point-max))
+ (re-search-backward message-signature-separator nil t)
(beginning-of-line)
(or (re-search-backward "[^ \n\t]" b t)
(y-or-n-p "Empty article. Really post? ")))))
(save-excursion
(if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
(y-or-n-p
- "The article contains control characters. Really post? ")
+ "The article contains control characters. Really post? ")
t)))
;; Check excessive size.
(or (message-check-element 'size)
(if (> (buffer-size) 60000)
(y-or-n-p
- (format "The article is %d octets long. Really post? "
+ (format "The article is %d octets long. Really post? "
(buffer-size)))
t))
;; Check whether any new text has been added.
(or (message-check-element 'new-text)
(not message-checksum)
- (not (eq (message-checksum) message-checksum))
+ (not (and (eq (message-checksum) (car message-checksum))
+ (eq (buffer-size) (cdr message-checksum))))
(y-or-n-p
"It looks like no new text has been added. Really post? "))
;; Check the length of the signature.
(message-check-element 'signature)
(progn
(goto-char (point-max))
- (if (or (not (re-search-backward "^-- $" nil t))
+ (if (or (not (re-search-backward message-signature-separator nil t))
(search-forward message-forward-end-separator nil t))
t
(if (> (count-lines (point) (point-max)) 5)
(y-or-n-p
(format
"Your .sig is %d lines; it should be max 4. Really post? "
- (count-lines (point) (point-max))))
+ (1- (count-lines (point) (point-max)))))
t))))))
(defun message-check-element (type)
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
(while (not (eobp))
- (setq sum (logxor sum (following-char)))
+ (when (not (looking-at "[ \t\n]"))
+ (setq sum (logxor (ash sum 1) (following-char))))
(forward-char 1)))
sum))
(if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
;; Pipe the article to the program in question.
(call-process-region (point-min) (point-max) shell-file-name
- nil nil nil "-c" (match-string 1 file))
+ nil nil nil shell-command-switch
+ (match-string 1 file))
;; Save the article.
(setq file (expand-file-name file))
(unless (file-exists-p (file-name-directory file))
(mail-header-subject message-reply-headers))
(message-strip-subject-re psubject))))
"_-_" ""))
- "@" (message-make-fqdm) ">"))
+ "@" (message-make-fqdn) ">"))
(defvar message-unique-id-char nil)
(goto-char fullname-start)
(while (re-search-forward
"\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
- nil 1)
+ nil 1)
(replace-match "\\1(\\3)" t)
(goto-char fullname-start)))
(insert ")")))
(when user-mail-address
(nth 1 (mail-extract-address-components user-mail-address))))
-(defun message-make-fqdm ()
+(defun message-make-fqdn ()
"Return user's fully qualified domain name."
- (let ((system-name (system-name)))
+ (let ((system-name (system-name))
+ (user-mail (message-user-mail-address)))
(cond
((string-match "[^.]\\.[^.]" system-name)
;; `system-name' returned the right result.
system-name)
- ;; We try `user-mail-address' as a backup.
- ((string-match "@\\(.*\\)\\'" (message-user-mail-address))
- (match-string 1 user-mail-address))
;; Try `mail-host-address'.
((and (boundp 'mail-host-address)
- mail-host-address)
+ (stringp mail-host-address)
+ (string-match "\\." mail-host-address))
mail-host-address)
+ ;; We try `user-mail-address' as a backup.
+ ((and (string-match "\\." user-mail)
+ (string-match "@\\(.*\\)\\'" user-mail))
+ (match-string 1 user-mail))
;; Default to this bogus thing.
(t
(concat system-name ".i-have-a-misconfigured-system-so-shoot-me")))))
(defun message-make-host-name ()
"Return the name of the host."
- (let ((fqdm (message-make-fqdm)))
- (string-match "^[^.]+\\." fqdm)
- (substring fqdm 0 (1- (match-end 0)))))
+ (let ((fqdn (message-make-fqdn)))
+ (string-match "^[^.]+\\." fqdn)
+ (substring fqdn 0 (1- (match-end 0)))))
(defun message-make-domain ()
"Return the domain name."
(or mail-host-address
- (message-make-fqdm)))
+ (message-make-fqdn)))
(defun message-generate-headers (headers)
"Prepare article HEADERS.
(message-delete-line))
(pop headers)))
;; Go through all the required headers and see if they are in the
- ;; articles already. If they are not, or are empty, they are
+ ;; articles already. If they are not, or are empty, they are
;; inserted automatically - except for Subject, Newsgroups and
;; Distribution.
(while headers
(concat "^" (downcase (symbol-name header)) ":")
nil t))
(progn
- ;; The header was found. We insert a space after the
+ ;; The header was found. We insert a space after the
;; colon, if there is none.
(if (/= (following-char) ? ) (insert " ") (forward-char 1))
;; Find out whether the header is empty...
(defun message-insert-courtesy-copy ()
"Insert a courtesy message in mail copies of combined messages."
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (let ((newsgroups (message-fetch-field "newsgroups")))
- (when newsgroups
+ (let (newsgroups)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (when (setq newsgroups (message-fetch-field "newsgroups"))
(goto-char (point-max))
- (insert "Posted-To: " newsgroups "\n"))))
- (forward-line 1)
- (insert message-courtesy-message)))
+ (insert "Posted-To: " newsgroups "\n")))
+ (forward-line 1)
+ (when message-courtesy-message
+ (cond
+ ((string-match "%s" message-courtesy-message)
+ (insert (format message-courtesy-message newsgroups)))
+ (t
+ (insert message-courtesy-message)))))))
;;;
;;; Setting up a message buffer
;;;
+(defun message-fill-address (header value)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert (capitalize (symbol-name header))
+ ": "
+ (if (consp value) (car value) value)
+ "\n")
+ (narrow-to-region (point-min) (1- (point-max)))
+ (let (quoted last)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward "^,\"" (point-max))
+ (if (or (= (following-char) ?,)
+ (eobp))
+ (when (not quoted)
+ (if (and (> (current-column) 78)
+ last)
+ (progn
+ (save-excursion
+ (goto-char last)
+ (insert "\n\t"))
+ (setq last (1+ (point))))
+ (setq last (1+ (point)))))
+ (setq quoted (not quoted)))
+ (unless (eobp)
+ (forward-char 1))))
+ (goto-char (point-max))
+ (widen)
+ (forward-line 1)))
+
(defun message-fill-header (header value)
(let ((begin (point))
(fill-column 78)
(defun message-buffer-name (type &optional to group)
"Return a new (unique) buffer name based on TYPE and TO."
- (if message-generate-new-buffers
- (generate-new-buffer-name
- (concat "*" type
- (if to
- (concat " to "
- (or (car (mail-extract-address-components to))
- to) "")
- "")
- (if group (concat " on " group) "")
- "*"))
- (format "*%s message*" type)))
+ (cond
+ ;; Check whether `message-generate-new-buffers' is a function,
+ ;; and if so, call it.
+ ((message-functionp message-generate-new-buffers)
+ (funcall message-generate-new-buffers type to group))
+ ;; Generate a new buffer name The Message Way.
+ (message-generate-new-buffers
+ (generate-new-buffer-name
+ (concat "*" type
+ (if to
+ (concat " to "
+ (or (car (mail-extract-address-components to))
+ to) "")
+ "")
+ (if (and group (not (string= group ""))) (concat " on " group) "")
+ "*")))
+ ;; Use standard name.
+ (t
+ (format "*%s message*" type))))
(defun message-pop-to-buffer (name)
"Pop to buffer NAME, and warn if it already exists and is modified."
;; We might have sent this buffer already. Delete it from the
;; list of buffers.
(setq message-buffer-list (delq (current-buffer) message-buffer-list))
- (when (and message-max-buffers
- (>= (length message-buffer-list) message-max-buffers))
+ (while (and message-max-buffers
+ (>= (length message-buffer-list) message-max-buffers))
;; Kill the oldest buffer -- unless it has been changed.
(let ((buffer (pop message-buffer-list)))
(when (and (buffer-name buffer)
(not (buffer-modified-p buffer)))
(kill-buffer buffer))))
;; Rename the buffer.
- (when (string-match "\\`\\*" (buffer-name))
- (rename-buffer
- (concat "*sent " (substring (buffer-name) (match-end 0))) t))
+ (if message-send-rename-function
+ (funcall message-send-rename-function)
+ (when (string-match "\\`\\*" (buffer-name))
+ (rename-buffer
+ (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
;; Push the current buffer onto the list.
(when message-max-buffers
(setq message-buffer-list
(nconc message-buffer-list (list (current-buffer))))))
+(defvar mc-modes-alist)
(defun message-setup (headers &optional replybuffer actions)
+ (when (and (boundp 'mc-modes-alist)
+ (not (assq 'message-mode mc-modes-alist)))
+ (push '(message-mode (encrypt . mc-encrypt-message)
+ (sign . mc-sign-message))
+ mc-modes-alist))
(when actions
(setq message-send-actions actions))
(setq message-reply-buffer replybuffer)
(pop h))
alist)
headers)
- (forward-line -1)
+ (delete-region (point) (progn (forward-line -1) (point)))
(when message-default-headers
(insert message-default-headers))
(put-text-property
(point)
(progn
(insert mail-header-separator "\n")
- (point))
+ (1- (point)))
'read-only nil)
(forward-line -1)
(when (message-news-p)
(delq 'Lines
(delq 'Subject
(copy-sequence message-required-mail-headers))))))
+ (run-hooks 'message-signature-setup-hook)
(message-insert-signature)
(message-set-auto-save-file-name)
(save-restriction
(let ((cur (current-buffer))
from subject date reply-to to cc
references message-id follow-to
+ (inhibit-point-motion-hooks t)
mct never-mct gnus-warning)
(save-restriction
- (narrow-to-region
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max)))
+ (message-narrow-to-head)
;; Allow customizations to have their say.
(if (not wide)
;; This is a regular reply.
(message-set-work-buffer)
(unless never-mct
(insert (or reply-to from "")))
- (insert
- (if (bolp) "" ", ") (or to "")
- (if mct (concat (if (bolp) "" ", ") mct) "")
- (if cc (concat (if (bolp) "" ", ") cc) ""))
+ (insert (if (bolp) "" ", ") (or to ""))
+ (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
+ (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
;; Remove addresses that match `rmail-dont-reply-to-names'.
(insert (prog1 (rmail-dont-reply-to (buffer-string))
(erase-buffer)))
(mapcar
(lambda (addr)
(cons (mail-strip-quoted-names addr) addr))
- (nreverse (mail-parse-comma-list))))
+ (message-tokenize-header (buffer-string))))
(let ((s ccalist))
(while s
(setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
(setq follow-to (list (cons 'To (cdr (pop ccalist)))))
(when ccalist
- (push (cons 'Cc
- (mapconcat (lambda (addr) (cdr addr)) ccalist ", "))
- follow-to)))))
+ (let ((ccs (cons 'Cc (mapconcat
+ (lambda (addr) (cdr addr)) ccalist ", "))))
+ (when (string-match "^ +" (cdr ccs))
+ (setcdr ccs (substring (cdr ccs) (match-end 0))))
+ (push ccs follow-to))))))
(widen))
- (message-pop-to-buffer (message-buffer-name "reply" from))
+ (message-pop-to-buffer (message-buffer-name
+ (if wide "wide reply" "reply") from
+ (if wide to-address nil)))
(setq message-reply-headers
(vector 0 subject from date message-id references 0 0 ""))
;;;###autoload
(defun message-wide-reply (&optional to-address)
+ "Make a \"wide\" reply to the message in the current buffer."
(interactive)
(message-reply to-address t))
;;;###autoload
-(defun message-followup ()
+(defun message-followup (&optional to-newsgroups)
+ "Follow up to the message in the current buffer.
+If TO-NEWSGROUPS, use that as the new Newsgroups line."
(interactive)
(let ((cur (current-buffer))
from subject date reply-to mct
references message-id follow-to
+ (inhibit-point-motion-hooks t)
followup-to distribution newsgroups gnus-warning)
(save-restriction
(narrow-to-region
(message-setup
`((Subject . ,subject)
,@(cond
+ (to-newsgroups
+ (list (cons 'Newsgroups to-newsgroups)))
(follow-to follow-to)
((and followup-to message-use-followup-to)
(list
because discussions that are spread over several newsgroup tend to
be fragmented and very difficult to follow.
-Also, some source/announcment newsgroups are not indented for discussion;
+Also, some source/announcement newsgroups are not indented for discussion;
responses here are directed to other newsgroups."))
(cons 'Newsgroups followup-to)
(cons 'Newsgroups newsgroups))))))
(t
`((Newsgroups . ,newsgroups))))
,@(and distribution (list (cons 'Distribution distribution)))
- (References . ,(concat (or references "") (and references " ")
- (or message-id "")))
+ ,@(if (or 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")
(concat "Distribution: " distribution "\n")
"")
mail-header-separator "\n"
- "This is a cancel message from " from ".\n")
+ message-cancel-message)
(message "Canceling your article...")
(let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
(funcall message-send-news-function))
(defun message-make-forward-subject ()
"Return a Subject header suitable for the message in the current buffer."
- (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from"))
+ (concat "[" (or (message-fetch-field
+ (if (message-news-p) "newsgroups" "from"))
"(nowhere)")
"] " (or (message-fetch-field "Subject") "")))
Optional NEWS will use news to forward instead of mail."
(interactive "P")
(let ((cur (current-buffer))
- (subject (message-make-forward-subject)))
+ (subject (message-make-forward-subject))
+ art-beg)
(if news (message-news nil subject) (message-mail nil subject))
;; Put point where we want it before inserting the forwarded
;; message.
(narrow-to-region (point) (point))
;; Insert the separators and the forwarded buffer.
(insert message-forward-start-separator)
+ (setq art-beg (point))
(insert-buffer-substring cur)
(goto-char (point-max))
(insert message-forward-end-separator)
(set-text-properties (point-min) (point-max) nil)
;; Remove all unwanted headers.
- (goto-char (point-min))
- (forward-line 1)
+ (goto-char art-beg)
(narrow-to-region (point) (if (search-forward "\n\n" nil t)
(1- (point))
(point)))
(defun message-resend (address)
"Resend the current article to ADDRESS."
(interactive "sResend message to: ")
+ (message "Resending message to %s..." address)
(save-excursion
(let ((cur (current-buffer))
beg)
(insert "Also-"))
;; Send it.
(message-send-mail)
- (kill-buffer (current-buffer)))))
+ (kill-buffer (current-buffer)))
+ (message "Resending message to %s...done" address)))
;;;###autoload
(defun message-bounce ()
;; We remove everything before the bounced mail.
(delete-region
(point-min)
- (if (re-search-forward "[^ \t]*:" nil t)
+ (if (re-search-forward "^[^ \n\t]+:" nil t)
(match-beginning 0)
(point)))
(save-restriction
which specify the range to operate on."
(interactive "r")
(save-excursion
- (let ((end1 (make-marker)))
- (move-marker end1 (max start end))
- (goto-char (min start end))
- (while (< (point) end1)
- (or (looking-at "[_\^@- ]")
- (insert (following-char) "\b"))
- (forward-char 1)))))
+ (let ((end1 (make-marker)))
+ (move-marker end1 (max start end))
+ (goto-char (min start end))
+ (while (< (point) end1)
+ (or (looking-at "[_\^@- ]")
+ (insert (following-char) "\b"))
+ (forward-char 1)))))
;;;###autoload
(defun unbold-region (start end)
which specify the range to operate on."
(interactive "r")
(save-excursion
- (let ((end1 (make-marker)))
- (move-marker end1 (max start end))
- (goto-char (min start end))
- (while (re-search-forward "\b" end1 t)
- (if (eq (following-char) (char-after (- (point) 2)))
- (delete-char -2))))))
+ (let ((end1 (make-marker)))
+ (move-marker end1 (max start end))
+ (goto-char (min start end))
+ (while (re-search-forward "\b" end1 t)
+ (if (eq (following-char) (char-after (- (point) 2)))
+ (delete-char -2))))))
+
+(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
;; Support for toolbar
(when (string-match "XEmacs\\|Lucid" emacs-version)
;;; Help stuff.
-(defmacro message-y-or-n-p (question show &rest text)
- "Ask QUESTION, displaying the rest of the arguments in a temporary buffer."
- `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
-
(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.
The following arguments may contain lists of values."
(list
(list list))))
+(run-hooks 'message-load-hook)
+
(provide 'message)
;;; message.el ends here
projects / gnus / blobdiff