(eval-when-compile
(require 'cl))
(require 'mail-header)
+(require 'nnheader)
+(require 'timezone)
+;;;###autoload
(defvar message-fcc-handler-function 'rmail-output
"*A function called to save outgoing articles.
-This function will be called with the same of the file to store the
+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
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"
"*This is inserted at the start of a mailed copy of a posted message.
If this variable is nil, no such courtesy message will be added.")
-(defvar message-ignored-bounced-headers "^\\(Received\\):"
+;;;###autoload
+(defvar message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):"
"*Regexp that matches headers to be removed in resent bounced mail.")
-(defvar message-from-style 'angles
+;;;###autoload
+(defvar message-from-style 'default
"*Specifies how \"From\" headers look.
If `nil', they contain just the return address like:
If `parens', they look like:
king@grassland.com (Elvis Parsley)
If `angles', they look like:
- Elvis Parsley <king@grassland.com>")
+ Elvis Parsley <king@grassland.com>
+
+Otherwise, most addresses look like `angles', but they look like
+`parens' if `angles' would need quoting and `parens' would not.")
+
+;;;###autoload
+(defvar message-syntax-checks nil
+ "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.
+
+Don't touch this variable unless you really know what you're doing.
-(defvar message-syntax-checks
- '(subject-cmsg multiple-headers sendsys message-id from
- long-lines control-chars size new-text
- redirected-followup signature approved sender
- empty empty-headers)
- "In non-nil, message will attempt to run some checks on outgoing posts.
-If this variable is t, message will check everything it can. If it is
-a list, then those elements in that list will be checked.")
+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.")
+;;;###autoload
(defvar message-required-news-headers
- '(From Date Newsgroups Subject Message-ID Organization Lines
+ '(From Newsgroups Subject Date Message-ID
+ (optional . Organization) Lines
(optional . X-Newsreader))
"*Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
X-Newsreader are optional. If don't you want message to insert some
header, remove it from this list.")
+;;;###autoload
(defvar message-required-mail-headers
- '(From Date To Subject (optional . In-Reply-To) Message-ID Lines
+ '(From Subject Date (optional . In-Reply-To) Message-ID Lines
(optional . X-Mailer))
"*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.")
+;;;###autoload
(defvar message-deletable-headers '(Message-ID Date)
- "*Headers to be deleted if they already exists and were generated by message previously.")
+ "*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:"
+ "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:"
"*Regexp of headers to be removed unconditionally before posting.")
+;;;###autoload
+(defvar message-ignored-mail-headers "^Gcc:\\|^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:"
"*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-signature-separator "^-- *$"
- "Regexp matching signature separator.")
+ "Regexp matching the signature separator.")
+;;;###autoload
(defvar message-interactive nil
"Non-nil means when sending a message wait for and display errors.
nil means let mailer mail back a message to report errors.")
+;;;###autoload
+(defvar message-generate-new-buffers nil
+ "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.")
+
+;;;###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
- (if (boundp 'gnus-local-organization)
- gnus-local-organization t)
+ (or (and (boundp 'gnus-local-organization)
+ gnus-local-organization)
+ (getenv "ORGANIZATION")
+ t)
"*String to be used as an Organization header.
If t, use `message-user-organization-file'.")
+;;;###autoload
(defvar message-user-organization-file "/usr/lib/news/organization"
"*Local news organization file.")
+;;;###autoload
(defvar message-autosave-directory "~/Mail/drafts/"
"*Directory where message autosaves buffers.
If nil, message won't autosave.")
"------- End of forwarded message -------\n"
"*Delimiter inserted after forwarded messages.")
+;;;###autoload
(defvar message-signature-before-forwarded-message t
"*If non-nil, put the signature before any included forwarded message.")
+;;;###autoload
(defvar message-included-forward-headers
"^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:"
"*Regexp matching headers to be included in forwarded messages.")
+;;;###autoload
(defvar message-ignored-resent-headers "^Return-receipt"
"*All headers that match this regexp will be deleted when resending a message.")
;;;###autoload
-(defvar message-ignored-cited-headers ":"
+(defvar message-ignored-cited-headers "."
"Delete these headers from the messages you yank.")
;; Useful to set in site-init.el
(defvar message-send-mail-function 'message-send-mail
"Function to call to send the current buffer as mail.
The headers should be delimited by a line whose contents match the
-variable `message-header-separator'.")
+variable `mail-header-separator'.")
+;;;###autoload
(defvar message-send-news-function 'message-send-news
"Function to call to send the current buffer as news.
The headers should be delimited by a line whose contents match the
variable `message-header-separator'.")
+;;;###autoload
(defvar message-reply-to-function nil
- "Function that should return a list of headers.")
+ "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
+;;;###autoload
(defvar message-wide-reply-to-function nil
- "Function that should return a list of headers.")
+ "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
+;;;###autoload
(defvar message-followup-to-function nil
- "Function that should return a list of headers.")
+ "Function that should return a list of headers.
+This function should pick out addresses from the To, Cc, and From headers
+and respond with new To and Cc headers.")
+;;;###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 ignore
-\"poster\". 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.")
+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.")
+(defvar gnus-post-method)
+(defvar gnus-select-method)
+;;;###autoload
(defvar message-post-method
- (cond ((boundp 'gnus-post-method)
+ (cond ((and (boundp 'gnus-post-method)
+ gnus-post-method)
gnus-post-method)
((boundp 'gnus-select-method)
gnus-select-method)
(t '(nnspool "")))
"Method used to post news.")
+;;;###autoload
(defvar message-generate-headers-first nil
"*If non-nil, generate all possible headers before composing.")
(defvar message-header-separator "--text follows this line--"
"*Line used to separate headers from text in messages being composed.")
-;;;###autoload
-(defvar message-alias-file nil
- "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'.
-This file defines aliases to be expanded by the mailer; this is a different
-feature from that of defining aliases in `.mailrc' to be expanded in Emacs.
-This variable has no effect unless your system uses sendmail as its mailer.")
-
-;;;###autoload
-(defvar message-personal-alias-file "~/.mailrc"
- "*If non-nil, the name of the user's personal mail alias file.
-This file typically should be in same format as the `.mailrc' file used by
-the `Mail' or `mailx' program.
-This file need not actually exist.")
-
(defvar message-setup-hook nil
"Normal hook, run each time a new outgoing message is initialized.
The function `message-setup' runs this hook.")
(defvar message-header-setup-hook nil
"Hook called narrowed to the headers when setting up a message buffer.")
+;;;###autoload
(defvar message-citation-line-function 'message-insert-citation-line
"*Function called to insert the \"Whomever writes:\" line.")
-(defvar message-aliases t
- "Alist of mail address aliases.
-If t, initialized from your mail aliases file.
-\(The file's name is normally `~/.mailrc', but your MAILRC environment
-variable can override that name.)
-The alias definitions in the file have this form:
- alias ALIAS MEANING")
-
-(defvar message-alias-modtime nil
- "The modification time of your mail alias file when it was last examined.")
-
+;;;###autoload
(defvar message-yank-prefix "> "
"*Prefix inserted on the lines of yanked messages.
nil means use indentation.")
"*Number of spaces to insert at the beginning of each cited line.
Used by `message-yank-original' via `message-yank-cite'.")
+;;;###autoload
+(defvar message-cite-function 'message-cite-original
+ "*Function for citing an original message.")
+
+;;;###autoload
(defvar message-indent-citation-function 'message-indent-citation
"*Function for modifying a citation just inserted in the mail buffer.
This can also be a list of functions. Each function can find the
(defvar message-abbrevs-loaded nil)
-(autoload 'build-mail-aliases "mailalias"
- "Read mail aliases from user's personal aliases file and set `mail-aliases'."
- nil)
-
-(autoload 'expand-mail-aliases "mailalias"
- "Expand all mail aliases in suitable header fields found between BEG and END.
-Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants.
-Optional second arg EXCLUDE may be a regular expression defining text to be
-removed from alias expansions."
- nil)
-
+;;;###autoload
(defvar message-signature t
- "*String to be inserted at the and the the message buffer.
+ "*String to be inserted at the end of the message buffer.
If t, the `message-signature-file' file will be inserted instead.
If a function, the result from the function will be used instead.
If a form, the result from the form will be used instead.")
+;;;###autoload
(defvar message-signature-file "~/.signature"
- "*File containing the text inserted at end of mail buffer.")
+ "*File containing the text inserted at end of message. buffer.")
(defvar message-distribution-function nil
"*Function called to return a Distribution header.")
"If nil, use the NNTP server name in the Path header.
If stringp, use this; if non-nil, use no host name (user name only).")
-(defvar message-generic-domain nil
- "If nil, the full host name will be the system name prepended to the domain name.
-If this is a string, the full host name will be this string.
-If this is non-nil, non-string, the domain name will be used as the
-full host name.")
-
(defvar message-reply-buffer nil)
(defvar message-reply-headers nil)
(defvar message-newsreader nil)
(defvar message-mailer nil)
(defvar message-sent-message-via nil)
+(defvar message-checksum nil)
(defvar message-send-actions nil
"A list of actions to be performed upon successful sending of a message.")
+;;;###autoload
(defvar message-default-headers nil
"*A string containing header lines to be inserted in outgoing messages.
It is inserted before you edit the message, so you can edit or delete
these lines.")
+;;;###autoload
(defvar message-default-mail-headers nil
"*A string of header lines to be inserted in outgoing mails.")
+;;;###autoload
(defvar message-default-news-headers nil
"*A string of header lines to be inserted in outgoing news articles.")
(let ((table (copy-syntax-table text-mode-syntax-table)))
(modify-syntax-entry ?% ". " table)
table)
- "Syntax table used while in message mode.")
+ "Syntax table used while in Message mode.")
(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)
- '("^B?CC:\\|^Reply-To:" . font-lock-keyword-face)
+ '("^[GBF]?[Cc][Cc]:\\|^Reply-To:" . font-lock-keyword-face)
'("^\\(Subject:\\)[ \t]*\\(.+\\)?"
(1 font-lock-comment-face) (2 font-lock-type-face nil t))
- (list (concat "^\\(" (regexp-quote message-header-separator) "\\)$")
+ (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
1 'font-lock-comment-face)
(cons (concat "^[ \t]*"
"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
'font-lock-reference-face)
'("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*"
. font-lock-string-face)))
- "Additional expressions to highlight in Mail mode.")
+ "Additional expressions to highlight in Message mode.")
+
+(defvar message-face-alist
+ '((bold . bold-region)
+ (underline . underline-region)
+ (default . (lambda (b e)
+ (unbold-region b e)
+ (ununderline-region b e))))
+ "Alist of mail and news faces for facemenu.
+The cdr of ech entry is a function for applying the face to a region.")
(defvar message-send-hook nil
"Hook run before sending messages.")
(defvar message-sent-hook nil
"Hook run after sending messages.")
+(if (string-match "XEmacs\\|Lucid" emacs-version)
+ (defvar message-mode-menu
+ '("Send Message"
+ "Go to Field:"
+ "----"
+ ["To:" message-goto-to t]
+ ["Subject:" message-goto-subject t]
+ ["Summary:" message-goto-summary t]
+ ["Keywords:" message-goto-keywords t]
+ ["Newsgroups:" message-goto-newsgroups t]
+ ["Followup-To:" message-goto-followup-to t]
+ ["Distribution:" message-goto-distribution t]
+ ["Body" message-goto-body t]
+ ["Signature" message-goto-signature t]
+ "----"
+ "Miscellaneous Commands:"
+ "----"
+ ["Sort Headers" message-sort-headers t]
+ ["Yank Original" message-yank-original t]
+ ["Fill Yanked Message" message-fill-yanked-message t]
+;; ["Insert Signature" news-reply-signature t]
+ ["Caesar (rot13) Message" message-caesar-buffer-body t]
+ "----"
+ ["Post Message" message-send-and-exit t]
+ ["Abort Message" message-dont-send t]
+ )
+ "Buffer Menu for XEmacs."))
+
+;;; Internal variables.
+
+;;; Regexp matching the delimiter of messages in UNIX mail format
+;;; (UNIX From lines), minus the initial ^.
+(defvar message-unix-mail-delimiter
+ (let ((time-zone-regexp
+ (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
+ "\\|[-+]?[0-9][0-9][0-9][0-9]"
+ "\\|"
+ "\\) *")))
+ (concat
+ "From "
+
+ ;; Username, perhaps with a quoted section that can contain spaces.
+ "\\("
+ "[^ \n]*"
+ "\\(\\|\".*\"[^ \n]*\\)"
+ "\\|<[^<>\n]+>"
+ "\\) ?"
+
+ ;; The time the message was sent.
+ "\\([^ \n]*\\) *" ; day of the week
+ "\\([^ ]*\\) *" ; month
+ "\\([0-9]*\\) *" ; day of month
+ "\\([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]*\\) *"
+
+ ;; On some systems the time zone can appear after the year, too.
+ time-zone-regexp
+
+ ;; Old uucp cruft.
+ "\\(remote from .*\\)?"
+
+ "\n")))
+
+(defvar message-unsent-separator
+ (concat "^ *---+ +Unsent message follows +---+ *$\\|"
+ "^ *---+ +Returned message +---+ *$\\|"
+ "^Start of returned message$\\|"
+ "^ *---+ +Original message +---+ *$\\|"
+ "^ *--+ +begin message +--+ *$\\|"
+ "^ *---+ +Original message follows +---+ *$\\|"
+ "^|? *---+ +Message text follows: +---+ *|?$")
+ "A regexp that matches the separator before the text of a failed message.")
+
(defvar message-header-format-alist
`((Newsgroups)
(To . message-fill-header)
(X-Newsreader))
"Alist used for formatting headers.")
+(eval-and-compile
+ (autoload 'message-setup-toolbar "message-xmas"))
+
\f
;;;
(substring subject (match-end 0))
subject))
-(defun message-remove-header (header &optional is-regexp first)
+(defun message-remove-header (header &optional is-regexp first reverse)
"Remove HEADER in the narrowed buffer.
If REGEXP, HEADER is a regular expression.
If FIRST, only remove the first instance of the header.
(number 0)
(case-fold-search t)
last)
- (while (and (re-search-forward regexp nil t)
+ (while (and (not (eobp))
(not last))
- (incf number)
- (when first
- (setq last t))
- (delete-region
- (message-point-at-bol)
- ;; There might be a continuation header, so we have to search
- ;; until we find a new non-continuation line.
- (if (re-search-forward "^[^ \t]" nil t)
- (goto-char (match-beginning 0))
- (point-max))))
+ (if (if reverse
+ (not (looking-at regexp))
+ (looking-at regexp))
+ (progn
+ (incf number)
+ (when first
+ (setq last t))
+ (delete-region
+ (point)
+ ;; There might be a continuation header, so we have to search
+ ;; until we find a new non-continuation line.
+ (progn
+ (forward-line 1)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (goto-char (match-beginning 0))
+ (point-max)))))
+ (forward-line 1)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (goto-char (match-beginning 0))
+ (point-max))))
number))
(defun message-narrow-to-headers ()
(narrow-to-region
(goto-char (point-min))
(if (re-search-forward
- (concat "^" (regexp-quote message-header-separator) "\n") nil t)
+ (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
(match-beginning 0)
(point-max)))
(goto-char (point-min)))
(defun message-news-p ()
"Say whether the current buffer contains a news message."
- (mail-fetch-field "newsgroups"))
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (mail-fetch-field "newsgroups"))))
(defun message-mail-p ()
"Say whether the current buffer contains a mail message."
- (or (mail-fetch-field "to")
- (mail-fetch-field "cc")
- (mail-fetch-field "bcc")))
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (or (mail-fetch-field "to")
+ (mail-fetch-field "cc")
+ (mail-fetch-field "bcc")))))
+
+(defun message-next-header ()
+ "Go to the beginning of the next header."
+ (beginning-of-line)
+ (or (eobp) (forward-char 1))
+ (not (if (re-search-forward "^[^ \t]" nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))))
+
+(defun message-sort-headers-1 ()
+ "Sort the buffer as headers using `message-rank' text props."
+ (goto-char (point-min))
+ (sort-subr
+ nil 'message-next-header
+ (lambda ()
+ (message-next-header)
+ (unless (bobp)
+ (forward-char -1)))
+ (lambda ()
+ (or (get-text-property (point) 'message-rank)
+ 0))))
+
+(defun message-sort-headers ()
+ "Sort the headers of the current message according to `message-header-format-alist'."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ (let ((max (1+ (length message-header-format-alist)))
+ rank)
+ (message-narrow-to-headers)
+ (while (re-search-forward "^[^ ]+:" nil t)
+ (put-text-property
+ (match-beginning 0) (1+ (match-beginning 0))
+ 'message-rank
+ (if (setq rank (length (memq (assq (intern (buffer-substring
+ (match-beginning 0)
+ (1- (match-end 0))))
+ message-header-format-alist)
+ message-header-format-alist)))
+ (- max rank)
+ (1+ max)))))
+ (message-sort-headers-1))))
\f
(defvar message-mode-map nil)
(unless message-mode-map
- (setq message-mode-map (nconc (make-sparse-keymap) text-mode-map))
+ (setq message-mode-map (copy-keymap text-mode-map))
(define-key message-mode-map "\C-c?" 'describe-mode)
(define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
(define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
- (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-fcc)
+ (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
(define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
(define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
(define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
(define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
(define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
- (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-followup-to)
+ (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
(define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
(define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
(define-key message-mode-map "\C-c\C-b" 'message-goto-body)
- (define-key message-mode-map "\C-c\C-s" 'message-goto-signature)
+ (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
(define-key message-mode-map "\C-c\C-t" 'message-insert-to)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
(define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
(define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
+ (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
(define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
- (define-key message-mode-map "\C-c\C-s" 'message-send))
-
-(easy-menu-define
- message-menu message-mode-map ""
- '("Mail"
- ["Fill Citation" message-fill-yanked-message t]))
+ (define-key message-mode-map "\C-c\C-s" 'message-send)
+ (define-key message-mode-map "\C-c\C-k" 'message-dont-send)
+ (if (string-match "XEmacs\\|Lucid" emacs-version)
+ (define-key message-mode-map 'button3 'message-mode-menu)))
+
+(defun message-make-menu-bar ()
+ (unless (boundp 'message-menu)
+ (easy-menu-define
+ message-menu message-mode-map ""
+ '("Message"
+ ["Fill Citation" message-fill-yanked-message t]))))
;;;###autoload
(defun message-mode ()
- "Major mode for editing mail to be sent.
+ "Major mode for editing mail and news to be sent.
Like Text Mode but with these additional commands:
C-c C-s message-send (send the message) C-c C-c message-send-and-exit
C-c C-f move to a header field (and create it if there isn't):
- C-c C-f C-t move to To: C-c C-f C-s move to Subject:
- C-c C-f C-c move to CC: C-c C-f C-b move to BCC:
- C-c C-f C-f move to FCC:
-C-c C-t message-text (move to beginning of message text).
-C-c C-w message-signature (insert `message-signature-file' file).
-C-c C-y message-yank-original (insert current message, in Rmail).
+ C-c C-f C-t move to To C-c C-f C-s move to Subject
+ C-c C-f C-c move to Cc C-c C-f C-b move to Bcc
+ C-c C-f C-f move to Fcc C-c C-f C-r move to Reply-To
+ C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups
+ C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution
+ C-c C-f C-o move to Followup-To
+C-c C-t message-insert-to (add a To header to a news followup)
+C-c C-n message-insert-newsgroups (add a Newsgroup header to a news reply)
+C-c C-b message-goto-body (move to beginning of message text).
+C-c C-i message-goto-signature (move to the beginning of the signature).
+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-v message-sent-via (add a Sent-via field for each To or CC)."
+C-c C-r message-ceasar-buffer-body (rot13 the message body)."
(interactive)
(kill-all-local-variables)
(make-local-variable 'message-reply-buffer)
(setq buffer-offer-save t)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(message-font-lock-keywords t))
+ (make-local-variable 'facemenu-add-face-function)
+ (make-local-variable 'facemenu-remove-face-function)
+ (setq facemenu-add-face-function
+ (lambda (face end)
+ (let ((face-fun (cdr (assq face message-face-alist))))
+ (if face-fun
+ (funcall face-fun (point) end)
+ (error "Face %s not configured for %s mode" face mode-name)))
+ "")
+ facemenu-remove-face-function t)
(make-local-variable 'paragraph-separate)
(make-local-variable 'paragraph-start)
- (setq paragraph-start (concat (regexp-quote message-header-separator)
+ (setq paragraph-start (concat (regexp-quote mail-header-separator)
"$\\|[ \t]*[-_][-_][-_]+$\\|"
paragraph-start))
- (setq paragraph-separate (concat (regexp-quote message-header-separator)
+ (setq paragraph-separate (concat (regexp-quote mail-header-separator)
"$\\|[ \t]*[-_][-_][-_]+$\\|"
paragraph-separate))
(make-local-variable 'message-reply-headers)
+ (setq message-reply-headers nil)
(make-local-variable 'message-newsreader)
(make-local-variable 'message-mailer)
(make-local-variable 'message-post-method)
(make-local-variable 'message-sent-message-via)
+ (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 (string-match "XEmacs\\|Lucid" emacs-version)
+ (message-setup-toolbar))
(run-hooks 'text-mode-hook 'message-mode-hook))
\f
(message-position-on-field "Bcc" "Cc" "To"))
(defun message-goto-fcc ()
- "Move point to the Followup-To header."
+ "Move point to the Fcc header."
(interactive)
(message-position-on-field "Fcc" "To" "Newsgroups"))
"Move point to the beginning of the message body."
(interactive)
(goto-char (point-min))
- (search-forward (concat "\n" message-header-separator "\n") nil t))
+ (search-forward (concat "\n" mail-header-separator "\n") nil t))
+
+(defun message-goto-signature ()
+ "Move point to the beginning of the message signature."
+ (interactive)
+ (goto-char (point-min))
+ (or (re-search-forward message-signature-separator nil t)
+ (goto-char (point-max))))
\f
(defun message-insert-to ()
- "Insert a To header that points to the author of the message being replied to."
+ "Insert a To header that points to the author of the article being replied to."
(interactive)
- (message-position-on-field "To")
+ (when (message-position-on-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)
- (message-position-on-field "newsgroups")
+ (when (message-position-on-field "Newsgroups")
+ (insert ","))
(insert (or (message-fetch-reply-field "newsgroups") "")))
\f
;;; Various commands
-(defun message-insert-signature ()
- "Insert a signature."
- (interactive)
+(defun message-insert-signature (&optional force)
+ "Insert a signature. See documentation for the `message-signature' variable."
+ (interactive (list t))
(let* ((signature
- (cond ((message-functionp message-signature)
+ (cond ((and (null message-signature)
+ force)
+ t)
+ ((message-functionp message-signature)
(funcall message-signature))
((listp message-signature)
(eval message-signature))
(interactive "P")
(save-excursion
(goto-char (point-min))
- (search-forward (concat "\n" message-header-separator "\n") nil t)
- (fill-individual-paragraphs (point)
- (point-max)
- justifyp
- t)))
+ (search-forward (concat "\n" mail-header-separator "\n") nil t)
+ (let ((fill-prefix message-yank-prefix))
+ (fill-individual-paragraphs (point) (point-max) justifyp t))))
(defun message-indent-citation ()
"Modify text just inserted from a message to be cited.
(goto-char start))))
(defun message-yank-original (&optional arg)
- "Insert the message being replied to, if any (in rmail).
+ "Insert the message being replied to, if any.
Puts point before the text and mark after.
Normally indents each nonblank line ARG spaces (default 3). However,
if `message-yank-prefix' is non-nil, insert that prefix on each line.
Just \\[universal-argument] as argument means don't indent, insert no
prefix, and don't delete any headers."
(interactive "P")
- (when message-reply-buffer
- (let ((start (point))
- (functions
- (when message-indent-citation-function
- (if (listp message-indent-citation-function)
- message-indent-citation-function
- (list message-indent-citation-function)))))
- ;; If the original message is in another window in the same frame,
- ;; delete that window to save screen space.
- ;; t means don't alter other frames.
+ (let ((modified (buffer-modified-p)))
+ (when (and message-reply-buffer
+ message-cite-function)
(delete-windows-on message-reply-buffer t)
(insert-buffer message-reply-buffer)
- (unless (consp arg)
- (goto-char start)
- (let ((message-indentation-spaces
- (if arg (prefix-numeric-value arg)
- message-indentation-spaces)))
- (while functions
- (funcall (pop functions)))))
- (when message-citation-line-function
- (unless (bolp)
- (insert "\n"))
- (funcall message-citation-line-function))
- ;; This is like exchange-point-and-mark, but doesn't activate the mark.
- ;; It is cleaner to avoid activation, even though the command
- ;; loop would deactivate the mark because we inserted text.
- (goto-char (prog1 (mark t)
- (set-marker (mark-marker) (point) (current-buffer))))
+ (funcall message-cite-function)
+ (exchange-point-and-mark)
+ (unless (bolp)
+ (insert ?\n))
+ (unless modified
+ (setq message-checksum (message-checksum))))))
+
+(defun message-cite-original ()
+ (let ((start (point))
+ (functions
+ (when message-indent-citation-function
+ (if (listp message-indent-citation-function)
+ message-indent-citation-function
+ (list message-indent-citation-function)))))
+ (goto-char start)
+ (while functions
+ (funcall (pop functions)))
+ (when message-citation-line-function
(unless (bolp)
- (insert ?\n)))))
+ (insert "\n"))
+ (funcall message-citation-line-function))))
(defun message-insert-citation-line ()
"Function that inserts a simple citation line."
(goto-char (point-min))
(progn
(re-search-forward
- (concat "^" (regexp-quote message-header-separator) "$"))
+ (concat "^" (regexp-quote mail-header-separator) "$"))
(match-beginning 0)))
(goto-char (point-min))
(if (re-search-forward (concat "^" (regexp-quote header) ":") nil t)
(defun message-remove-signature ()
"Remove the signature from the text between point and mark.
-The text will also be indented the normal way.
-This function can be used in `message-citation-hook', for instance."
+The text will also be indented the normal way."
(save-excursion
(let ((start (point))
mark)
;;;
(defun message-send-and-exit (&optional arg)
- "Send message like `message-send', then, if no errors, exit from mail buffer.
-Prefix arg means don't delete this window."
+ "Send message like `message-send', then, if no errors, exit from mail buffer."
(interactive "P")
- (message-send)
- ;(message-bury arg)
- )
-
-(defun message-dont-send (&optional arg)
- "Don't send the message you have been editing.
-Prefix arg means don't delete this window."
- (interactive "P")
- (message-bury arg))
+ (let ((buf (current-buffer)))
+ (when (and (message-send arg)
+ (buffer-name buf))
+ (if message-kill-buffer-on-exit
+ (kill-buffer buf)
+ (bury-buffer buf)
+ (when (eq buf (current-buffer))
+ (message-bury buf))))))
+
+(defun message-dont-send ()
+ "Don't send the message you have been editing."
+ (interactive)
+ (message-bury (current-buffer)))
-(defun message-bury (arg)
+(defun message-bury (buffer)
"Bury this mail buffer."
- (let ((newbuf (other-buffer (current-buffer))))
- (bury-buffer (current-buffer))
+ (let ((newbuf (other-buffer buffer)))
+ (bury-buffer buffer)
(if (and (fboundp 'frame-parameters)
(cdr (assq 'dedicated (frame-parameters)))
(not (null (delq (selected-frame) (visible-frame-list)))))
(when (if buffer-file-name
(y-or-n-p (format "Send buffer contents as %s message? "
(if (message-mail-p)
- (if (message-news-p) "main and news" "news")
+ (if (message-news-p) "mail and news" "mail")
"news")))
(or (buffer-modified-p)
- (y-or-n-p "Message already sent; resend? ")))
+ (y-or-n-p "No changes in the buffer; really send? ")))
;; Make it possible to undo the coming changes.
(undo-boundary)
(run-hooks 'message-send-hook)
"Already sent message via mail; resend? "))
(funcall message-send-mail-function 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.
(condition-case nil
(apply (caar actions) (cdar actions))
(error))
- (pop actions))))))
+ (pop actions)))
+ ;; Return success.
+ t)))
(defun message-send-mail (&optional arg)
(require 'mail-utils)
(tembuf (generate-new-buffer " message temp"))
(case-fold-search nil)
(news (message-news-p))
- (resend-to-addresses (mail-fetch-field "resent-to"))
- delimline
+ resend-to-addresses delimline
(mailbuf (current-buffer)))
(save-restriction
(message-narrow-to-headers)
- ;; Remove some headers.
- (message-remove-header message-ignored-news-headers t)
+ (setq resend-to-addresses (mail-fetch-field "resent-to"))
;; Insert some headers.
(message-generate-headers message-required-mail-headers)
;; Let the user do all of the above.
(set-buffer tembuf)
(erase-buffer)
(insert-buffer-substring mailbuf)
+ ;; Remove some headers.
+ (save-restriction
+ (message-narrow-to-headers)
+ ;; Remove some headers.
+ (message-remove-header message-ignored-mail-headers t))
(goto-char (point-max))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
;; Change header-delimiter to be what sendmail expects.
(goto-char (point-min))
(re-search-forward
- (concat "^" (regexp-quote message-header-separator) "\n"))
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
(replace-match "\n")
(backward-char 1)
(setq delimline (point-marker))
- (sendmail-synch-aliases)
- (when message-aliases
- (expand-mail-aliases (point-min) delimline))
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
;; Always specify who from,
;; since some systems have broken sendmails.
(list "-f" (user-login-name))
- (and message-alias-file
- (list (concat "-oA" message-alias-file)))
;; These mean "report errors by mail"
;; and "deliver in background".
(if (null message-interactive) '("-oem" "-odb"))
;; We must not do that for a resend
;; because we would find the original addresses.
;; For a resend, include the specific addresses.
- (or resend-to-addresses
- '("-t")))))
+ (if resend-to-addresses
+ (list resend-to-addresses)
+ '("-t")))))
(when message-interactive
(save-excursion
(set-buffer errbuf)
(kill-buffer tembuf)
(when (bufferp errbuf)
(kill-buffer errbuf)))
+ (set-buffer mailbuf)
(push 'mail message-sent-message-via)))
(defun message-send-news (&optional arg)
(messbuf (current-buffer)))
(save-restriction
(message-narrow-to-headers)
- ;; Remove some headers.
- (message-remove-header message-ignored-news-headers t)
;; Insert some headers.
(message-generate-headers message-required-news-headers)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
- ;; Insert the proper mail headers.
- (unwind-protect
- (save-excursion
- (set-buffer tembuf)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (insert-buffer-substring messbuf)
- (goto-char (point-max))
- ;; require one newline at the end.
- (or (= (preceding-char) ?\n)
- (insert ?\n))
- (let ((case-fold-search t))
- ;; Remove the delimeter.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote message-header-separator) "\n"))
- (replace-match "\n")
- (backward-char 1))
- (require (car method))
- (funcall (intern (format "%s-open-server" (car method)))
- (cadr method) (cddr method))
- (funcall (intern (format "%s-request-post"
- (car method)))))
- (kill-buffer tembuf))
- (push 'news message-sent-message-via)))
+ (when (message-check-news-syntax)
+ (unwind-protect
+ (save-excursion
+ (set-buffer tembuf)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-buffer-substring messbuf)
+ ;; Remove some headers.
+ (save-restriction
+ (message-narrow-to-headers)
+ ;; Remove some headers.
+ (message-remove-header message-ignored-news-headers t))
+ (goto-char (point-max))
+ ;; require one newline at the end.
+ (or (= (preceding-char) ?\n)
+ (insert ?\n))
+ (let ((case-fold-search t))
+ ;; Remove the delimeter.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (backward-char 1))
+ (require (car method))
+ (funcall (intern (format "%s-open-server" (car method)))
+ (cadr method) (cddr method))
+ (funcall (intern (format "%s-request-post"
+ (car method)))))
+ (kill-buffer tembuf))
+ (set-buffer messbuf)
+ (push 'news message-sent-message-via))))
;;;
;;; Header generation & syntax checking.
(defun message-check-news-syntax ()
"Check the syntax of the message."
- (or
- (not message-syntax-checks)
- (and
- ;; We narrow to the headers and check them first.
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (and
- ;; Check for commands in Subject.
- (or
- (message-check-element 'subject-cmsg)
- (save-excursion
- (if (string-match "^cmsg " (mail-fetch-field "subject"))
- (y-or-n-p
- "The control code \"cmsg \" is in the subject. Really post? ")
- t)))
- ;; Check for multiple identical headers.
- (or (message-check-element 'multiple-headers)
- (save-excursion
- (let (found)
- (while (and (not found)
- (re-search-forward "^[^ \t:]+: " nil t))
- (save-excursion
- (or (re-search-forward
- (concat "^" (setq found
- (buffer-substring
- (match-beginning 0)
- (- (match-end 0) 2))))
- nil t)
- (setq found nil))))
- (if found
- (y-or-n-p
- (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? "
- (buffer-substring (match-beginning 0)
- (1- (match-end 0)))))
- t)))
- ;; See whether we can shorten Followup-To.
- (or (message-check-element 'shorten-followup-to)
- (let ((newsgroups (mail-fetch-field "newsgroups"))
- (followup-to (mail-fetch-field "followup-to"))
- to)
- (when (and newsgroups (string-match "," newsgroups)
- (not followup-to)
- (not
- (zerop
- (length
- (setq to (completing-read
- "Followups to: (default all groups) "
- (mapcar (lambda (g) (list g))
- (cons "poster"
- (message-tokenize-header
- newsgroups)))))))))
- (goto-char (point-min))
- (insert "Followup-To: " to "\n"))))
-
- ;; 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? ")
- t))))))
- ;; Check for long lines.
- (or (message-check-element 'long-lines)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (while (and
- (progn
- (end-of-line)
- (< (current-column) 80))
- (zerop (forward-line 1))))
- (or (bolp)
- (eobp)
- (y-or-n-p
- "You have lines longer than 79 characters. Really post? "))))
- ;; Check whether the article is empty.
- (or (message-check-element 'empty)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (or (re-search-forward "[^ \n\t]" nil t)
- (y-or-n-p "Empty article. Really post?"))))
- ;; Check for control characters.
- (or (message-check-element 'control-chars)
- (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? ")
- 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? "
- (buffer-size)))
- t))
- ;; Check the length of the signature.
- (or (message-check-element 'signature)
- (progn
- (goto-char (point-max))
- (if (not (re-search-backward "^-- $" 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))))
- t)))))))
-
-;; Returns non-nil if this type is not to be checked.
+ (and
+ ;; We narrow to the headers and check them first.
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (and
+ ;; Check for commands in Subject.
+ (or
+ (message-check-element 'subject-cmsg)
+ (save-excursion
+ (if (string-match "^cmsg " (mail-fetch-field "subject"))
+ (y-or-n-p
+ "The control code \"cmsg \" is in the subject. Really post? ")
+ t)))
+ ;; Check for multiple identical headers.
+ (or (message-check-element 'multiple-headers)
+ (save-excursion
+ (let (found)
+ (while (and (not found)
+ (re-search-forward "^[^ \t:]+: " nil t))
+ (save-excursion
+ (or (re-search-forward
+ (concat "^" (setq found
+ (buffer-substring
+ (match-beginning 0)
+ (- (match-end 0) 2))))
+ nil t)
+ (setq found nil))))
+ (if found
+ (y-or-n-p
+ (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? "
+ (buffer-substring (match-beginning 0)
+ (1- (match-end 0)))))
+ t)))
+ ;; See whether we can shorten Followup-To.
+ (or (message-check-element 'shorten-followup-to)
+ (let ((newsgroups (mail-fetch-field "newsgroups"))
+ (followup-to (mail-fetch-field "followup-to"))
+ to)
+ (when (and newsgroups (string-match "," newsgroups)
+ (not followup-to)
+ (not
+ (zerop
+ (length
+ (setq to (completing-read
+ "Followups to: (default all groups) "
+ (mapcar (lambda (g) (list g))
+ (cons "poster"
+ (message-tokenize-header
+ newsgroups)))))))))
+ (goto-char (point-min))
+ (insert "Followup-To: " to "\n"))
+ 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? ")
+ t)))
+ ;; Check the Message-Id header.
+ (or (message-check-element 'message-id)
+ (save-excursion
+ (let* ((case-fold-search t)
+ (message-id (mail-fetch-field "message-id")))
+ (or (not message-id)
+ (and (string-match "@" message-id)
+ (string-match "@[^\\.]*\\." message-id))
+ (y-or-n-p
+ (format
+ "The Message-ID looks strange: \"%s\". Really post? "
+ message-id))))))
+ ;; Check the Subject header.
+ (or
+ (message-check-element 'subject)
+ (save-excursion
+ (let* ((case-fold-search t)
+ (subject (mail-fetch-field "subject")))
+ (or
+ (and subject
+ (not (string-match "\\`[ \t]*\\'" subject)))
+ (progn
+ (message
+ "The subject field is empty or missing. Posting is denied.")
+ nil)))))
+ ;; Check the From header.
+ (or (message-check-element 'from)
+ (save-excursion
+ (let* ((case-fold-search t)
+ (from (mail-fetch-field "from")))
+ (cond
+ ((not from)
+ (message "There is no From line. Posting is denied.")
+ nil)
+ ((not (string-match "@[^\\.]*\\." from))
+ (message
+ "Denied posting -- the From looks strange: \"%s\"." from)
+ nil)
+ ((string-match "@[^@]*@" from)
+ (message
+ "Denied posting -- two \"@\"'s in the From header: %s."
+ from)
+ nil)
+ ((string-match "(.*).*(.*)" from)
+ (message
+ "Denied posting -- the From header looks strange: \"%s\"."
+ from)
+ nil)
+ (t t))))))))
+ ;; Check for long lines.
+ (or (message-check-element 'long-lines)
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (while (and
+ (progn
+ (end-of-line)
+ (< (current-column) 80))
+ (zerop (forward-line 1))))
+ (or (bolp)
+ (eobp)
+ (y-or-n-p
+ "You have lines longer than 79 characters. Really post? "))))
+ ;; Check whether the article is empty.
+ (or (message-check-element 'empty)
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (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)))
+ (beginning-of-line)
+ (or (re-search-backward "[^ \n\t]" b t)
+ (y-or-n-p "Empty article. Really post? ")))))
+ ;; Check for control characters.
+ (or (message-check-element 'control-chars)
+ (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? ")
+ 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? "
+ (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))
+ (y-or-n-p
+ "It looks like no new text has been added. Really post? "))
+ ;; Check the length of the signature.
+ (or (message-check-element 'signature)
+ (progn
+ (goto-char (point-max))
+ (if (not (re-search-backward "^-- $" 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))))
+ t))))))
+
(defun message-check-element (type)
- (not
- (or (not message-syntax-checks)
- (if (listp message-syntax-checks)
- (memq type message-syntax-checks)
- t))))
+ "Returns non-nil if this type is not to be checked."
+ (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
+ nil
+ (let ((able (assq type message-syntax-checks)))
+ (and (consp able)
+ (eq (cdr able) 'disabled)))))
+
+(defun message-checksum ()
+ "Return a \"checksum\" for the current buffer."
+ (let ((sum 0))
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$"))
+ (while (not (eobp))
+ (setq sum (logxor sum (following-char)))
+ (forward-char 1)))
+ sum))
(defun message-do-fcc ()
"Process Fcc headers in the current buffer."
(let ((case-fold-search t)
+ (buf (current-buffer))
list file)
(save-excursion
+ (set-buffer (get-buffer-create " *message temp*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-buffer-substring buf)
(save-restriction
- (nnheader-narrow-to-headers)
+ (message-narrow-to-headers)
(while (setq file (mail-fetch-field "fcc"))
(push file list)
- (message-remove-header "fcc" nil t))
- ;; Process FCC operations.
- (widen)
- (while list
- (setq file (pop list))
- (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))
- ;; Save the article.
- (setq file (expand-file-name file))
- (unless (file-exists-p (file-name-directory file))
- (make-directory (file-name-directory file) t))
- (if (and message-fcc-handler-function
- (not (eq message-fcc-handler-function 'rmail-output)))
- (funcall message-fcc-handler-function file)
- (if (and (file-readable-p file) (mail-file-babyl-p file))
- (rmail-output file 1)
- (let ((mail-use-rfc822 t))
- (rmail-output file 1 t t))))))))))
+ (message-remove-header "fcc" nil t)))
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
+ (replace-match "" t t)
+ ;; Process FCC operations.
+ (while list
+ (setq file (pop list))
+ (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))
+ ;; Save the article.
+ (setq file (expand-file-name file))
+ (unless (file-exists-p (file-name-directory file))
+ (make-directory (file-name-directory file) t))
+ (if (and message-fcc-handler-function
+ (not (eq message-fcc-handler-function 'rmail-output)))
+ (funcall message-fcc-handler-function file)
+ (if (and (file-readable-p file) (mail-file-babyl-p file))
+ (rmail-output file 1)
+ (let ((mail-use-rfc822 t))
+ (rmail-output file 1 t t))))))
+ (kill-buffer (current-buffer)))))
(defun message-cleanup-headers ()
"Do various automatic cleanups of the headers."
;; Correct Newsgroups and Followup-To headers: change sequence of
;; spaces to comma and eliminate spaces around commas. Eliminate
- ;; imbedded line breaks.
+ ;; embedded line breaks.
(goto-char (point-min))
(while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
(save-restriction
(defun message-make-message-id ()
"Make a unique Message-ID."
- (concat "<" (message-unique-id) "@" (message-make-fqdm) ">"))
+ (concat "<" (message-unique-id)
+ (let ((psubject (save-excursion (mail-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))))
+ "_-_" ""))
+ "@" (message-make-fqdm) ">"))
(defvar message-unique-id-char nil)
message-user-organization)))))
(save-excursion
(message-set-work-buffer)
- (cond ((stringp message-user-organization)
- (insert message-user-organization))
- ((and (eq t message-user-organization)
+ (cond ((stringp organization)
+ (insert organization))
+ ((and (eq t organization)
message-user-organization-file
(file-exists-p message-user-organization-file))
(insert-file-contents message-user-organization-file)))
(goto-char (point-min))
- (when (re-search-forward "[ \t\n]*" nil t)
+ (while (re-search-forward "[\t\n]+" nil t)
(replace-match "" t t))
(unless (zerop (buffer-size))
(buffer-string)))))
(widen)
(goto-char (point-min))
(re-search-forward
- (concat "^" (regexp-quote message-header-separator) "$"))
+ (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
(int-to-string (count-lines (point) (point-max))))))
(save-excursion
(message-set-work-buffer)
(cond
- ((eq message-from-style 'angles)
+ ((or (null message-from-style)
+ (equal fullname ""))
+ (insert login))
+ ((or (eq message-from-style 'angles)
+ (and (not (eq message-from-style 'parens))
+ ;; Use angles if no quoting is needed, or if parens would
+ ;; need quoting too.
+ (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname))
+ (let ((tmp (concat fullname nil)))
+ (while (string-match "([^()]*)" tmp)
+ (aset tmp (match-beginning 0) ?-)
+ (aset tmp (1- (match-end 0)) ?-))
+ (string-match "[\\()]" tmp)))))
(insert fullname)
(goto-char (point-min))
;; Look for a character that cannot appear unquoted
(replace-match "\\\\\\&" t))
(insert "\""))
(insert " <" login ">"))
- ((eq message-from-style 'parens)
+ (t ; 'parens or default
(insert login " (")
(let ((fullname-start (point)))
(insert fullname)
nil 1)
(replace-match "\\1(\\3)" t)
(goto-char fullname-start)))
- (insert ")"))
- ((null message-from-style)
- (insert login "\n")))
+ (insert ")")))
(buffer-string))))
(defun message-make-sender ()
(defun message-make-address ()
"Make the address of the user."
- (concat (user-login-name) "@" (message-make-domain)))
+ (or (message-user-mail-address)
+ (concat (user-login-name) "@" (message-make-domain))))
+
+(defun message-user-mail-address ()
+ "Return the pertinent part of `user-mail-address'."
+ (when user-mail-address
+ (nth 1 (mail-extract-address-components user-mail-address))))
(defun message-make-fqdm ()
"Return user's fully qualified domain name."
(let ((system-name (system-name)))
- (if (string-match "[^.]\\.[^.]" system-name)
- ;; `system-name' returned the right result.
- system-name
- ;; We try `user-mail-address' as a backup.
- (if (string-match "@\\([^ ]+\\)\\($\\| \\)" user-mail-address)
- (match-string 1 user-mail-address)
- (concat system-name ".i-have-a-misconfigured-system-so-shoot-me")))))
+ (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)
+ mail-host-address)
+ ;; 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."
(defun message-make-domain ()
"Return the domain name."
- (let ((fqdm (message-make-fqdm)))
- (if message-generic-domain
- (progn
- (string-match "^[^.]+\\." fqdm)
- (substring fqdm (match-end 0)))
- fqdm)))
+ (or mail-host-address
+ (message-make-fqdm)))
(defun message-generate-headers (headers)
"Prepare article HEADERS.
(Distribution (message-make-distribution))
(Lines (message-make-lines))
(X-Newsreader message-newsreader)
- (X-Mailer message-mailer)
+ (X-Mailer (and (not (mail-fetch-field "X-Newsreader"))
+ message-mailer))
(Expires (message-make-expires))
(case-fold-search t)
header value elem)
(get-text-property (1+ (match-beginning 0)) 'message-deletable)
(message-delete-line))
(pop headers)))
- ;; If there are References, and the subject has changed, then
- ;; we have to change the Message-ID. See Son-of-1036.
- (when (and message-reply-headers
- (mail-fetch-field "references"))
- (let ((psubject (mail-fetch-field "subject")))
- (and psubject (mail-header-subject message-reply-headers)
- (string= (message-strip-subject-re
- (mail-header-subject message-reply-headers))
- (message-strip-subject-re
- psubject))
- (progn
- (string-match "@" Message-ID)
- (setq Message-ID
- (concat (substring Message-ID 0 (match-beginning 0))
- "_-_"
- (substring Message-ID (match-beginning 0))))))))
;; Go through all the required headers and see if they are in the
;; articles already. If they are not, or are empty, they are
;; inserted automatically - except for Subject, Newsgroups and
(goto-char (point-min))
(setq elem (pop headers))
(if (consp elem)
- (setq header (car elem))
+ (if (eq (car elem) 'optional)
+ (setq header (cdr elem))
+ (setq header (car elem)))
(setq header elem))
(when (or (not (re-search-forward
- (concat "^" (downcase (symbol-name header)) ":") nil t))
+ (concat "^" (downcase (symbol-name header)) ":")
+ nil t))
(progn
;; The header was found. We insert a space after the
;; colon, if there is none.
(when (and from
(not (message-check-element 'sender))
(not (string=
- (downcase (cadr (mail-extract-address-components from)))
+ (downcase
+ (cadr (mail-extract-address-components from)))
(downcase secure-sender)))
(or (null sender)
(not
(save-restriction
(message-narrow-to-headers)
(let ((newsgroups (mail-fetch-field "newsgroups")))
- (goto-char (point-max))
- (insert "Posted-To: " newsgroups "\n")))
+ (when newsgroups
+ (goto-char (point-max))
+ (insert "Posted-To: " newsgroups "\n"))))
(forward-line 1)
(insert message-courtesy-message)))
": "
(if (consp value) (car value) value)
"\n")
- (fill-region-as-paragraph begin (1- (point)))))
-
-(defun sendmail-synch-aliases ()
- (let ((modtime (nth 5 (file-attributes message-personal-alias-file))))
- (or (equal message-alias-modtime modtime)
- (setq message-alias-modtime modtime
- message-aliases t))))
+ (save-restriction
+ (narrow-to-region begin (point))
+ (fill-region-as-paragraph begin (point))
+ ;; Tapdance around looong Message-IDs.
+ (forward-line -1)
+ (when (looking-at "[ \t]*$")
+ (message-delete-line))
+ (goto-char begin)
+ (re-search-forward ":" nil t)
+ (when (looking-at "\n[ \t]+")
+ (replace-match " " t t))
+ (goto-char (point-max)))))
(defun message-position-point ()
"Move point to where the user probably wants to find it."
(defun message-pop-to-buffer (name)
"Pop to buffer NAME, and warn if it already exists and is modified."
- (let ((buffer (get-buffer name)))
- (if (and buffer
- (buffer-name buffer))
- (progn
- (set-buffer (pop-to-buffer buffer))
- (when (and (buffer-modified-p)
- (not (y-or-n-p
- "Message already being composed; erase? ")))
- (error "Message being composed")))
- (set-buffer (pop-to-buffer name)))
- (erase-buffer)
- (message-mode)))
+ (if message-generate-new-buffers
+ (set-buffer (pop-to-buffer (generate-new-buffer name)))
+ (let ((buffer (get-buffer name)))
+ (if (and buffer
+ (buffer-name buffer))
+ (progn
+ (set-buffer (pop-to-buffer buffer))
+ (when (and (buffer-modified-p)
+ (not (y-or-n-p
+ "Message already being composed; erase? ")))
+ (error "Message being composed")))
+ (set-buffer (pop-to-buffer name)))))
+ (erase-buffer)
+ (message-mode))
(defun message-setup (headers &optional replybuffer actions)
- (sendmail-synch-aliases)
- (when (eq message-aliases t)
- (setq message-aliases nil)
- (when (file-exists-p message-personal-alias-file)
- (build-mail-aliases)))
(setq message-send-actions actions)
(setq message-reply-buffer replybuffer)
(goto-char (point-min))
(pop h))
alist)
headers)
+ (forward-line -1)
(when message-default-headers
(insert message-default-headers))
- (when (and (message-news-p)
- message-default-news-headers)
+ (insert mail-header-separator "\n")
+ (forward-line -1)
+ (when (message-news-p)
+ (when message-default-news-headers
+ (insert message-default-news-headers))
(when message-generate-headers-first
- (message-generate-headers message-required-news-headers))
- (insert message-default-news-headers))
- (when (and (message-mail-p)
- message-default-mail-headers)
+ (message-generate-headers
+ (delq 'Lines
+ (delq 'Subject
+ (copy-sequence message-required-news-headers))))))
+ (when (message-mail-p)
+ (when message-default-mail-headers
+ (insert message-default-mail-headers))
(when message-generate-headers-first
- (message-generate-headers message-required-mail-headers))
- (insert message-default-mail-headers))
- (forward-line -1)
- (insert message-header-separator "\n")
+ (message-generate-headers
+ (delq 'Lines
+ (delq 'Subject
+ (copy-sequence message-required-mail-headers))))))
(message-insert-signature)
(message-set-auto-save-file-name)
(save-restriction
(message-narrow-to-headers)
(run-hooks 'message-header-setup-hook))
+ ;; Allow mail alias things.
+ (if (fboundp 'mail-abbrevs-setup)
+ (mail-abbrevs-setup)
+ (funcall (intern "mail-aliases-setup")))
(set-buffer-modified-p nil)
(run-hooks 'message-setup-hook)
- (message-position-point))
+ (message-position-point)
+ (undo-boundary))
(defun message-set-auto-save-file-name ()
"Associate the message buffer with a file in the drafts directory."
(Subject . ,(or subject "")))))
;;;###autoload
-(defun message-reply (&optional to-address wide)
+(defun message-reply (&optional to-address wide ignore-reply-to)
"Start editing a reply to the article in the current buffer."
(interactive)
(let ((cur (current-buffer))
- from subject date reply-to message-of to cc
- references message-id sender follow-to sendto elt new-cc new-to
+ from subject date reply-to to cc
+ references message-id follow-to
mct never-mct gnus-warning)
(save-restriction
(narrow-to-region
(if (message-functionp message-reply-to-function)
(setq follow-to (funcall message-reply-to-function)))
;; This is a followup.
- (if (gnus-functionp message-wide-reply-to-function)
+ (if (message-functionp message-wide-reply-to-function)
(save-excursion
(setq follow-to
(funcall message-wide-reply-to-function)))))
;; Find all relevant headers we need.
(setq from (mail-fetch-field "from")
date (mail-fetch-field "date")
- sender (mail-fetch-field "sender")
subject (or (mail-fetch-field "subject") "none")
to (mail-fetch-field "to")
cc (mail-fetch-field "cc")
mct (mail-fetch-field "mail-copies-to")
- reply-to (mail-fetch-field "reply-to")
+ reply-to (unless ignore-reply-to (mail-fetch-field "reply-to"))
references (mail-fetch-field "references")
message-id (mail-fetch-field "message-id"))
;; Remove any (buggy) Re:'s that are present and make a
(message-setup
`((Subject . ,subject)
,@follow-to
- (References . ,(concat (or references "") (and references " ")
- (or message-id ""))))
+ ,@(if (or references message-id)
+ `((References . ,(concat (or references "") (and references " ")
+ (or message-id ""))))
+ nil))
cur)))
;;;###autoload
(defun message-followup ()
(interactive)
(let ((cur (current-buffer))
- from subject date message-of reply-to mct
- references message-id follow-to sendto elt
+ from subject date reply-to mct
+ references message-id follow-to
followup-to distribution newsgroups gnus-warning)
(save-restriction
(narrow-to-region
(t
(if (or (equal followup-to newsgroups)
(not (eq message-use-followup-to 'ask))
- (y-or-n-p (format "Use Followup-To %s? " followup-to)))
+ (y-or-n-p
+ (format "Use Followup-To %s? " followup-to)))
(cons 'Newsgroups followup-to)
(cons 'Newsgroups newsgroups))))))
(t
(list (cons 'Cc (if (equal (downcase mct) "always")
(or reply-to from "")
mct)))))
- cur)))
+
+ cur)
+
+ (setq message-reply-headers
+ (vector 0 subject from date message-id references 0 0 ""))))
+
;;;###autoload
(defun message-cancel-news ()
(if distribution
(concat "Distribution: " distribution "\n")
"")
- message-header-separator "\n"
+ mail-header-separator "\n"
"This is a cancel message from " from ".\n")
(message "Canceling your article...")
- (funcall message-send-news-function)
+ (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
+ (funcall message-send-news-function))
(message "Canceling your article...done")
(kill-buffer buf))))
(error "No Message-ID in this article")
(replace-match "Supersedes: " t t))
(goto-char (point-max))
- (insert message-header-separator)
+ (insert mail-header-separator)
(widen)
(forward-line 1)))
;;;###autoload
(defun message-forward (&optional news)
+ "Forward the current message via mail.
+Optional NEWS will use news to forward instead of mail."
(interactive "P")
(let ((cur (current-buffer))
(subject (message-make-forward-subject)))
(1- (point))
(point)))
(goto-char (point-min))
- (message-remove-header message-included-forward-headers t)
+ (message-remove-header message-included-forward-headers t nil t)
(widen)
(message-position-point)))
(let ((cur (current-buffer))
beg)
;; We first set up a normal mail buffer.
- (message-set-work-buffer)
+ (set-buffer (get-buffer-create " *message resend*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
(message-setup `((To . ,address)))
;; Insert our usual headers.
- (message-narrow-to-headers)
(message-generate-headers '(From Date To))
- (goto-char (point-min))
+ (message-narrow-to-headers)
;; Rename them all to "Resent-*".
(while (re-search-forward "^[A-Za-z]" nil t)
(forward-char -1)
(beginning-of-line)
(insert "Also-"))
;; Send it.
- (funcall message-send-mail-function))))
+ (funcall message-send-mail-function)
+ (kill-buffer (current-buffer)))))
;;;###autoload
(defun message-bounce ()
This only makes sense if the current message is a bounce message than
contains some mail you have written which has been bounced back to
you."
- (interactive "P")
- (let ((cur (current-buffer)))
+ (interactive)
+ (let ((cur (current-buffer))
+ boundary)
(message-pop-to-buffer "*mail message*")
(insert-buffer-substring cur)
+ (undo-boundary)
+ (message-narrow-to-head)
+ (if (and (mail-fetch-field "Mime-Version")
+ (setq boundary (mail-fetch-field "Content-Type")))
+ (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary)
+ (setq boundary (concat (match-string 1 boundary) " *\n"
+ "Content-Type: message/rfc822"))
+ (setq boundary nil)))
+ (widen)
(goto-char (point-min))
- (or (and (re-search-forward mail-unsent-separator nil t)
+ (search-forward "\n\n" nil t)
+ (or (and boundary
+ (re-search-forward boundary nil t)
+ (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)))
(insert mail-header-separator))
(message-position-point)))
+;;;
+;;; Interactive entry points for new message buffers.
+;;;
+
+;;;###autoload
+(defun message-mail-other-window (&optional to subject)
+ "Like `message-mail' command, but display mail buffer in another window."
+ (interactive)
+ (let ((pop-up-windows t)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (same-window-regexps nil))
+ (message-pop-to-buffer "*mail message*"))
+ (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-mail-other-frame (&optional to subject)
+ "Like `message-mail' command, but display mail buffer in another frame."
+ (interactive)
+ (let ((pop-up-frames t)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (same-window-regexps nil))
+ (message-pop-to-buffer "*mail message*"))
+ (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-news-other-window (&optional newsgroups subject)
+ "Start editing a news article to be sent."
+ (interactive)
+ (let ((pop-up-windows t)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (same-window-regexps nil))
+ (message-pop-to-buffer "*news message*"))
+ (message-setup `((Newsgroups . ,(or newsgroups ""))
+ (Subject . ,(or subject "")))))
+
+;;;###autoload
+(defun message-news-other-frame (&optional newsgroups subject)
+ "Start editing a news article to be sent."
+ (interactive)
+ (let ((pop-up-frames t)
+ (special-display-buffer-names nil)
+ (special-display-regexps nil)
+ (same-window-buffer-names nil)
+ (same-window-regexps nil))
+ (message-pop-to-buffer "*news message*"))
+ (message-setup `((Newsgroups . ,(or newsgroups ""))
+ (Subject . ,(or subject "")))))
+
+;;; underline.el
+
+;; This code should be moved to underline.el (from which it is stolen).
+
+;;;###autoload
+(defun bold-region (start end)
+ "Bold all nonblank characters in the region.
+Works by overstriking characters.
+Called from program, takes two arguments START and 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 (< (point) end1)
+ (or (looking-at "[_\^@- ]")
+ (insert (following-char) "\b"))
+ (forward-char 1)))))
+
+;;;###autoload
+(defun unbold-region (start end)
+ "Remove all boldness (overstruck characters) in the region.
+Called from program, takes two arguments START and 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))))))
+
+;; Support for Mouse menus
+(when (string-match "XEmacs\\|Lucid" emacs-version)
+ (require 'message-xmas))
+
(provide 'message)
;;; message.el ends here
projects / gnus / blobdiff