Lines Matching +defs:mh +defs:mail +defs:header +defs:end
1 ;;; message.el --- composing mail and news messages
7 ;; Keywords: mail, news
28 ;; This mode provides mail-sending facilities from within Emacs. It
43 ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
46 (require 'mail-abbrevs)
48 (require 'mail-parse)
56 (defgroup message '((user-mail-address custom-variable)
60 :group 'mail
63 (put 'user-mail-address 'custom-type 'string)
105 (defgroup message-mail nil
115 "*Directory from which all other mail file variables are derived."
155 "*Regexp that matches headers to be removed in resent bounced mail."
179 "Whether to insert a Cancel-Lock header in news postings."
195 `invisible-text', `long-header-lines', `long-lines', `message-id',
207 `message-required-mail-headers'."
230 header, remove it from this list."
236 (defcustom message-required-mail-headers
242 :group 'message-mail
266 (defcustom message-ignored-mail-headers
269 :group 'message-mail
349 (defcustom message-mark-insert-end
350 "--8<---------------cut here---------------end--------------->8---\n"
351 "How to mark the end of some inserted text."
357 (defcustom message-archive-header "X-No-Archive: Yes\n"
359 Archives \(such as groups.google.com\) respect this header."
429 nil means let mailer mail back a message to report errors."
431 :group 'message-mail
440 Generate the buffer name in the Message way (e.g., *mail*, *news*,
441 *mail to whom*, *news on group*, etc.) and continue editing in the
452 Similar to nil but the buffer name is simpler like *mail message*.
481 "*String to be used as an Organization header.
609 (defcustom message-send-mail-function 'message-send-mail-with-sendmail
610 "Function to call to send the current buffer as mail.
612 variable `mail-header-separator'.
614 Valid values include `message-send-mail-with-sendmail' (the default),
615 `message-send-mail-with-mh', `message-send-mail-with-qmail',
618 See also `send-mail-function'."
619 :type '(radio (function-item message-send-mail-with-sendmail)
620 (function-item message-send-mail-with-mh)
621 (function-item message-send-mail-with-qmail)
628 :group 'message-mail)
633 variable `mail-header-separator'."
664 "*Specifies what to do with Followup-To header.
665 If nil, always ignore the header. If it is t, use its value, but
676 (defcustom message-use-mail-followup-to 'use
677 "*Specifies what to do with Mail-Followup-To header.
678 If nil, always ignore the header. If it is the symbol `ask', always
749 "*Envelope-from when sending mail with sendmail.
750 If this is nil, use `user-mail-address'. If it is the symbol
751 `header', use the From: header of the message."
754 (const :tag "Use From: header from message" header)
755 (const :tag "Use `user-mail-address'" nil))
780 "Non-nil means Gnus should not fold the `References' header.
806 ;; will *not* have a `References:' header if `message-generate-headers-first'
812 `message-required-mail-headers' specify which headers to generate.
850 (defcustom message-header-hook nil
855 (defcustom message-header-setup-hook nil
911 Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
921 "*Function for modifying a citation just inserted in the mail buffer.
931 "*String to be inserted at the end of the message buffer.
941 "*Name of file containing the text inserted at end of message buffer.
957 "*Function called to return a Distribution header."
971 "If nil, use the NNTP server name in the Path header.
998 (define-widget 'message-header-lines 'text
999 "All header lines must be LFD terminated."
1002 :error "All header lines must be newline terminated")
1005 "*A string containing header lines to be inserted in outgoing messages.
1010 :type 'message-header-lines)
1012 (defcustom message-default-mail-headers ""
1013 "*A string of header lines to be inserted in outgoing mails."
1015 :group 'message-mail
1017 :type 'message-header-lines)
1020 "*A string of header lines to be inserted in outgoing news articles."
1024 :type 'message-header-lines)
1026 ;; Note: could use /usr/ucb/mail instead of sendmail;
1046 "*Set this non-nil if the system's mailer runs the header and body together.
1055 (define-mail-user-agent 'message-user-agent
1056 'message-mail 'message-send-and-exit
1059 (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
1060 "If non-nil, delete the deletable headers before feeding to mh.")
1064 (mail message-mail-p message-send-via-mail))
1076 (defcustom message-mail-alias-type 'abbrev
1079 mail aliases off."
1148 (defface message-header-to
1160 (put 'message-header-to-face 'face-alias 'message-header-to)
1162 (defface message-header-cc
1174 (put 'message-header-cc-face 'face-alias 'message-header-cc)
1176 (defface message-header-subject
1188 (put 'message-header-subject-face 'face-alias 'message-header-subject)
1190 (defface message-header-newsgroups
1202 (put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups)
1204 (defface message-header-other
1216 (put 'message-header-other-face 'face-alias 'message-header-other)
1218 (defface message-header-name
1227 "Face used for displaying header names."
1230 (put 'message-header-name-face 'face-alias 'message-header-name)
1232 (defface message-header-xheader
1244 (put 'message-header-xheader-face 'face-alias 'message-header-xheader)
1288 (defun message-font-lock-make-header-matcher (regexp)
1296 (concat "^" (regexp-quote mail-header-separator) "$")
1308 `((,(message-font-lock-make-header-matcher
1310 (1 'message-header-name)
1311 (2 'message-header-to nil t))
1312 (,(message-font-lock-make-header-matcher
1314 (1 'message-header-name)
1315 (2 'message-header-cc nil t))
1316 (,(message-font-lock-make-header-matcher
1318 (1 'message-header-name)
1319 (2 'message-header-subject nil t))
1320 (,(message-font-lock-make-header-matcher
1322 (1 'message-header-name)
1323 (2 'message-header-newsgroups nil t))
1324 (,(message-font-lock-make-header-matcher
1326 (1 'message-header-name)
1327 (2 'message-header-other nil t))
1328 (,(message-font-lock-make-header-matcher
1330 (1 'message-header-name)
1331 (2 'message-header-name))
1332 ,@(if (and mail-header-separator
1333 (not (equal mail-header-separator "")))
1334 `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
1358 "Alist of mail and news faces for facemenu.
1369 (defcustom message-send-mail-hook nil
1370 "Hook run before sending mail messages.
1372 mail."
1391 "Coding system to encode outgoing mail.")
1395 "*Coding system to compose mail.
1400 (defcustom message-send-mail-partially-limit 1000000
1424 "A list of hierarchical mail address definitions.
1428 mail sent to the first address will automatically be delivered to the
1431 the mail is sent. All addresses in this structure should be
1437 (defcustom message-mail-user-agent nil
1438 "Like `mail-user-agent'.
1440 `mail-user-agent'."
1445 (const :tag "`mail-user-agent'"
1448 (function-item :tag "Default Emacs mail"
1453 mh-e-user-agent)
1501 (defvar message-this-is-mail nil)
1512 ;;; Regexp matching the delimiter of messages in UNIX mail format
1514 ;;; of rmail.el's rmail-unix-mail-delimiter.
1515 (defvar message-unix-mail-delimiter
1565 "Regexp matching the delimiter of messages in UNIX mail format.")
1578 (defvar message-header-format-alist
1599 (defvar message-send-mail-real-function nil
1600 "Internal send mail function.")
1627 (autoload 'mh-new-draft-name "mh-comp")
1628 (autoload 'mh-send-letter "mh-comp")
1632 (autoload 'gnus-output-to-mail "gnus-util")
1677 (defun message-tokenize-header (header &optional separator)
1678 "Split HEADER into a list of header elements.
1681 (if (not header)
1689 (insert header)
1701 (setq beg (match-end 0)))
1712 (defun message-mail-file-mbox-p (file)
1720 (looking-at message-unix-mail-delimiter))))
1722 (defun message-fetch-field (header &optional not-all)
1723 "The same as `mail-fetch-field', only remove all newlines.
1724 The buffer is expected to be narrowed to just the header of the message;
1728 (value (mail-fetch-field header nil (not not-all))))
1735 (defun message-field-value (header &optional not-all)
1740 (message-fetch-field header not-all))))
1743 "Narrow the buffer to the header on the current line."
1756 (defun message-add-header (&rest headers)
1757 "Add the HEADERS to the message header, skipping those already present."
1761 (error "Invalid header `%s'" (car headers)))
1783 (defun message-fetch-reply-field (header)
1787 (mail-narrow-to-head)
1788 (message-fetch-field header))))
1802 (match-end 1)))
1808 (substring subject (match-end 0))
1839 cs-coding q-or-b word-beg word-end)
1860 word-end (match-end 0))
1880 (re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end t)
1889 word-end t)
1894 (re-search-forward "[^?]+" word-end t)
1938 "Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
1968 (defun message-mark-inserted-region (beg end)
1970 See `message-mark-insert-begin' and `message-mark-insert-end'."
1973 ;; add to the end of the region first, otherwise end would be invalid
1974 (goto-char end)
1975 (insert message-mark-insert-end)
1981 See `message-mark-insert-begin' and `message-mark-insert-end'."
1985 (insert message-mark-insert-end)
1991 (defun message-add-archive-header ()
1992 "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
2007 (message-add-header message-archive-header)
2010 (defun message-cross-post-followup-to-header (target-group)
2011 "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
2021 (message-remove-header "Follow[Uu]p-[Tt]o" t)
2041 (end-of-line)
2043 (end-of-line) ; ensure Followup: comes after Newsgroups:
2064 (concat "^" mail-header-separator)
2114 (message-cross-post-followup-to-header target-group)
2124 ;;; Reduce To: to Cc: or Bcc: header
2127 "Replace contents of To: header with contents of Cc: or Bcc: header."
2146 (message-remove-header (if bcc
2152 (defun message-remove-header (header &optional is-regexp first reverse)
2155 If FIRST, only remove the first instance of the header.
2158 (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":")))
2173 ;; There might be a continuation header, so we have to search
2186 (defun message-remove-first-header (header)
2189 (regexp (concat "^" (regexp-quote header) ":")))
2195 (message-remove-header header nil t)
2204 (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
2230 (regexp-quote mail-header-separator)
2233 (or (match-end 1) (match-beginning 2))
2239 (and (not message-this-is-mail)
2247 (defun message-mail-p ()
2248 "Say whether the current buffer contains a mail message."
2250 (or message-this-is-mail
2259 "Say whether we need to insert a MFT header."
2265 (defun message-next-header ()
2266 "Go to the beginning of the next header."
2278 nil 'message-next-header
2280 (message-next-header)
2288 "Sort the headers of the current message according to `message-header-format-alist'."
2292 (let ((max (1+ (length message-header-format-alist)))
2301 (1- (match-end 0))))
2302 message-header-format-alist)
2303 message-header-format-alist)))
2344 (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to)
2350 'message-generate-unsubscribed-mail-followup-to)
2358 (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header)
2482 ["X-No-Archive:" message-add-archive-header t ]
2487 '(:help "Insert a To header that points to the author."))]
2494 ["Mail-Followup-To" message-goto-mail-followup-to t]
2495 ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to
2497 '(:help "Insert a reasonable `Mail-Followup-To:' header."))]
2556 (get-text-property pos 'egg-end)
2560 (defun message-strip-forbidden-properties (begin end &optional old-length)
2568 (while (not (= begin end))
2576 "Major mode for editing mail and news to be sent.
2580 C-c C-f move to a header field (and create it if there isn't):
2591 C-c C-f x crossposting with FollowUp-To header and note in body
2592 C-c C-f t replace To: header with contents of Cc: or Bcc:
2593 C-c C-f a Insert X-No-Archive: header and a note in the body
2594 C-c C-t `message-insert-to' (add a To header to a news followup)
2596 C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply)
2622 (lambda (face end)
2625 (funcall face-fun (point) end)
2655 ;; Allow mail alias things.
2656 (when (eq message-mail-alias-type 'abbrev)
2657 (if (fboundp 'mail-abbrevs-setup)
2658 (mail-abbrevs-setup)
2659 (if (fboundp 'mail-aliases-setup) ; warning avoidance
2660 (mail-aliases-setup))))
2686 (regexp-quote mail-header-separator) "$\\|"
2709 ;; `text-mode-hook' ourself at the end of the mode.
2724 "Move point to the To header."
2729 "Move point to the From header."
2734 "Move point to the Subject header."
2739 "Move point to the Cc header."
2744 "Move point to the Bcc header."
2749 "Move point to the Fcc header."
2754 "Move point to the Reply-To header."
2759 "Move point to the Newsgroups header."
2764 "Move point to the Distribution header."
2769 "Move point to the Followup-To header."
2773 (defun message-goto-mail-followup-to ()
2774 "Move point to the Mail-Followup-To header."
2779 "Move point to the Keywords header."
2784 "Move point to the Summary header."
2795 (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
2804 "Move point to the end of the headers."
2811 If there is no signature in the article, go to the end and
2820 (defun message-generate-unsubscribed-mail-followup-to (&optional include-cc)
2821 "Insert a reasonable MFT header in a post to an unsubscribed list.
2823 you have to type in a MFT header by hand. The contents, usually, are
2825 such a header automatically. It fetches the contents of the To: header
2826 in the current mail buffer, and appends the current `user-mail-address'.
2829 Cc: header are also put into the MFT."
2835 (message-remove-header "Mail-Followup-To")
2840 (message-goto-mail-followup-to)
2841 (insert (concat tos ", " user-mail-address))))
2847 "Insert a To header that points to the author of the article being replied to.
2848 If the original author requested not to be sent mail, don't insert unless the
2851 (let* ((mct (message-fetch-reply-field "mail-copies-to"))
2854 (to (or (message-fetch-reply-field "mail-reply-to")
2860 "Ignoring the user request not to have copies sent via mail"
2861 "Complying with the user request not to have copies sent via mail")))
2863 (error "No mail address in the article"))
2874 (defcustom message-header-synonyms
2877 "List of lists of header synonyms.
2879 then `message-carefully-insert-headers' will not insert a `To' header
2889 or in the synonym headers, defined by `message-header-synonyms'."
2893 ;; (mail-strip-quoted-names "Foo Bar <foo@bar>, bla@fasel (Bla Fasel)")
2894 (dolist (header headers)
2895 (let* ((header-name (symbol-name (car header)))
2896 (new-header (cdr header))
2897 (synonyms (loop for synonym in message-header-synonyms
2898 when (memq (car header) synonym) return synonym))
2899 (old-header
2901 for old-header = (mail-fetch-field (symbol-name synonym))
2902 when (and old-header (string-match new-header old-header))
2904 (if old-header
2905 (message "already have `%s' in `%s'" new-header old-header)
2906 (when (and (message-position-on-field header-name)
2907 (setq old-header (mail-fetch-field header-name))
2908 (not (string-match "\\` *\\'" old-header)))
2910 (insert new-header)))))
2925 (message-remove-header (symbol-name (car elem)))
2931 "Insert the Newsgroups header from the article being replied to."
2934 (mail-fetch-field "newsgroups")
2935 (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
2944 (defun message-delete-not-region (beg end)
2954 (goto-char end)
2975 (end-of-line -1))
2984 (let (quoted point beg end leading-space bolp)
2998 (goto-char (match-end 0))
3007 end nil))
3015 (goto-char (match-end 0))
3020 (setq end (point))
3027 (goto-char (match-end 0))
3035 (setq end (point))
3043 (narrow-to-region beg end)
3076 ;; Is it better to use `mail-header-end'?
3077 (defun message-point-in-header-p ()
3078 "Return t if point is in the header."
3083 (concat "^" (regexp-quote mail-header-separator) "\n")
3087 "Like `do-auto-fill', but don't fill in message header."
3088 (unless (message-point-in-header-p)
3131 "Insert header to mark message as important."
3136 (message-remove-header "Importance"))
3141 "Insert header to mark message as unimportant."
3146 (message-remove-header "Importance"))
3151 "Insert a \"Importance: high\" header, or cycle through the header values.
3162 (message-remove-header "Importance")
3179 (message-remove-header "Disposition-Notification-To"))
3262 (search-forward mail-header-separator nil 'end))
3263 (let* ((mail-to (or
3267 (mail-trimmed-to
3268 (if (string-match "," mail-to)
3269 (concat (substring mail-to 0 (match-beginning 0)) ", ...")
3270 mail-to))
3271 (name-default (concat "*message* " mail-trimmed-to))
3283 (search-forward (concat "\n" mail-header-separator "\n") nil t)
3304 (message-remove-header message-ignored-cited-headers t)
3316 ;; Delete blank lines at the end of the buffer.
3386 (end (mark t))
3397 (narrow-to-region start end)
3406 (mml-quote-region start end)
3409 (goto-char end)
3416 (delete-region (point) end)
3428 (eval-when-compile (defvar mail-citation-hook)) ;Compiler directive
3431 (if (and (boundp 'mail-citation-hook)
3432 mail-citation-hook)
3433 (run-hooks 'mail-citation-hook)
3435 (end (mark t))
3446 (narrow-to-region start end)
3455 (mml-quote-region start end)
3467 (insert (mail-header-from message-reply-headers) " writes:")
3471 (defun message-position-on-field (header &rest afters)
3478 (concat "^" (regexp-quote mail-header-separator) "$"))
3481 (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t)
3495 (insert header ": \n")
3529 "Send message like `message-send', then, if no errors, exit from mail buffer."
3585 "Bury this mail BUFFER."
3653 ;; Delete other mail buffers and stuff.
3659 (defun message-send-via-mail (arg)
3660 "Send the current message via mail."
3661 (message-send-mail arg))
3689 ;; Make sure there's a newline at the end of the message.
3793 (defun message-send-mail-partially ()
3794 "Send mail as message/partial."
3795 ;; replace the header delimiter with a blank line
3798 (concat "^" (regexp-quote mail-header-separator) "\n"))
3800 (run-hooks 'message-send-mail-hook)
3805 plist total header required-mail-headers)
3807 (if (< (point-max) (+ p message-send-mail-partially-limit))
3809 (goto-char (+ p message-send-mail-partially-limit))
3825 (if header
3829 (insert header))
3831 (setq header (buffer-substring (point-min) (point)))
3834 (insert header)
3835 (message-remove-header "Mime-Version")
3836 (message-remove-header "Content-Type")
3837 (message-remove-header "Content-Transfer-Encoding")
3838 (message-remove-header "Message-ID")
3839 (message-remove-header "Lines")
3842 (setq header (buffer-string)))
3847 (let ((mail-header-separator ""))
3848 (when (memq 'Message-ID message-required-mail-headers)
3850 (when (memq 'Lines message-required-mail-headers)
3853 (end-of-line)
3857 (funcall (or message-send-mail-real-function
3858 message-send-mail-function))))
3864 (defun message-send-mail (&optional arg)
3865 (require 'mail-utils)
3870 (message-this-is-mail t)
3875 (headers message-required-mail-headers))
3878 ;; Generate the Mail-Followup-To header if the header is not there...
3880 (not (mail-fetch-field "mail-followup-to")))
3883 (cons "Mail-Followup-To" (message-make-mail-followup-to))
3884 message-required-mail-headers))
3885 ;; otherwise, delete the MFT header if the field is empty
3886 (when (equal "" (mail-fetch-field "mail-followup-to"))
3887 (message-remove-header "^Mail-Followup-To:")))
3903 (run-hooks 'message-header-hook))
3916 ;; We (re)generate the Lines header.
3917 (when (memq 'Lines message-required-mail-headers)
3920 (message-remove-header message-ignored-mail-headers t)
3921 (let ((mail-parse-charset message-default-charset))
3922 (mail-encode-encoded-word-buffer)))
3924 ;; require one newline at the end.
3945 (mail-header-parse-content-type
3952 (if (or (not message-send-mail-partially-limit)
3953 (< (buffer-size) message-send-mail-partially-limit)
3961 Some mail gateways (MTA's) bounce large messages. To avoid the
3964 (/ message-send-mail-partially-limit 1000)
3968 However, some mail readers (MUA's) can't read split messages, i.e.,
3972 The size limit is controlled by `message-send-mail-partially-limit'.
3974 `message-send-mail-partially-limit' to nil.
3977 (message "Sending via mail...")
3978 (funcall (or message-send-mail-real-function
3979 message-send-mail-function)))
3980 (message-send-mail-partially)))
3983 (push 'mail message-sent-message-via)))
3985 (defun message-send-mail-with-sendmail ()
3998 ;; Change header-delimiter to be what sendmail expects.
4001 (concat "^" (regexp-quote mail-header-separator) "\n"))
4005 (run-hooks 'message-send-mail-hook)
4037 ;; These mean "report errors by mail"
4062 (defun message-send-mail-with-qmail ()
4064 Refer to the documentation for the variable `message-send-mail-function'
4066 ;; replace the header delimiter with a blank line
4069 (concat "^" (regexp-quote mail-header-separator) "\n"))
4071 (run-hooks 'message-send-mail-hook)
4083 ;; reading a formatted (i. e., at least a To: or Resent-To header)
4088 ;; compare this with message-send-mail-with-sendmail and weep
4106 (defun message-send-mail-with-mh ()
4107 "Send the prepared message buffer with mh."
4108 (let ((mh-previous-window-config nil)
4109 (name (mh-new-draft-name)))
4112 (when message-mh-deletable-headers
4113 (let ((headers message-mh-deletable-headers))
4120 (run-hooks 'message-send-mail-hook)
4121 ;; Pass it on to mh.
4122 (mh-send-letter)))
4127 `message-send-mail-hook' just before sending a message. It is useful
4130 (run-hooks 'message-send-mail-hook)
4155 (canlock-insert-header)))
4177 (rfc2047-header-encoding-alist
4182 rfc2047-header-encoding-alist))
4202 (run-hooks 'message-header-hook))
4228 ;; We (re)generate the Lines header.
4229 (when (memq 'Lines message-required-mail-headers)
4232 (message-remove-header message-ignored-news-headers t)
4233 (let ((mail-parse-charset message-default-charset))
4234 (mail-encode-encoded-word-buffer)))
4236 ;; require one newline at the end.
4243 (concat "^" (regexp-quote mail-header-separator) "\n"))
4249 (setq result (let ((mail-header-separator ""))
4280 (message-check-news-header-syntax))))))
4282 (defun message-check-news-header-syntax ()
4284 ;; Check Newsgroups header.
4293 ;; Check the Subject header.
4309 ;; Check long header lines.
4310 (message-check 'long-header-lines
4312 (header nil)
4320 (setq header (match-string-no-properties 1)))
4324 (y-or-n-p (format "Your %s header is too long (%d). Really post? "
4325 header length))
4338 (match-beginning 0) (- (match-end 0) 2))))
4351 (1- (match-end 0)))))
4365 "Followups to (default no Followup-To header): "
4368 (message-tokenize-header
4376 "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t)
4382 (y-or-n-p "The article contains an Approved header. Really post? ")
4384 ;; Check the Message-ID header.
4393 ;; Does the ID end with a dot?
4403 (groups (message-tokenize-header
4477 header error)
4479 (when (setq header (mail-fetch-field (car headers)))
4484 header))
4489 (message-tokenize-header header ","))))
4496 (format "The %s header looks odd: \"%s\". Really post? "
4497 (car headers) header)))))
4501 header error groups group)
4504 (when (setq header (mail-fetch-field (pop headers)))
4505 (setq groups (message-tokenize-header header ","))
4514 ;; Check the From header.
4525 (setq ad (nth 1 (mail-extract-address-components
4544 ;; Check the Reply-To header.
4558 (setq ad (nth 1 (mail-extract-address-components
4577 (concat "^" (regexp-quote mail-header-separator) "$"))
4583 (end-of-line)
4594 (concat "^" (regexp-quote mail-header-separator) "$"))
4652 (concat "^" (regexp-quote mail-header-separator) "$"))
4664 (concat "^" (regexp-quote mail-header-separator) "$"))
4691 (message-remove-header "fcc" nil t))
4692 (let ((mail-parse-charset message-default-charset)
4693 (rfc2047-header-encoding-alist
4695 rfc2047-header-encoding-alist)))
4696 (mail-encode-encoded-word-buffer)))
4699 (concat "^" (regexp-quote mail-header-separator) "$")
4717 (if (and (file-readable-p file) (mail-file-babyl-p file))
4719 (let ((mail-use-rfc822 t))
4724 "Append this article to Unix/babyl mail file FILENAME."
4726 (mail-file-babyl-p filename))
4728 (gnus-output-to-mail filename t)))
4732 ;; Remove empty lines in the header.
4764 "Make a valid data header.
4794 (mail-header-references message-reply-headers)
4795 (mail-header-subject message-reply-headers)
4799 (mail-header-subject message-reply-headers))
4849 "Make an Organization header."
4878 "Return the References header for this message."
4880 (let ((message-id (mail-header-message-id message-reply-headers))
4881 (references (mail-header-references message-reply-headers))
4889 "Return the In-Reply-To header for this message."
4891 (let ((from (mail-header-from message-reply-headers))
4892 (date (mail-header-date message-reply-headers))
4893 (msg-id (mail-header-message-id message-reply-headers)))
4895 (let ((name (mail-extract-address-components from)))
4924 "Make a Distribution header."
4931 "Return an Expires header based on `message-expires'."
4950 "Make a From header."
4973 (aset tmp (1- (match-end 0)) ?-))
5016 (or (message-user-mail-address)
5019 (defun message-user-mail-address ()
5020 "Return the pertinent part of `user-mail-address'."
5021 (when (and user-mail-address
5022 (string-match "@.*\\." user-mail-address))
5023 (if (string-match " " user-mail-address)
5024 (nth 1 (mail-extract-address-components user-mail-address))
5025 user-mail-address)))
5029 (cond ((eq message-sendmail-envelope-from 'header)
5030 (nth 1 (mail-extract-address-components
5040 (user-mail (message-user-mail-address))
5042 (if (and user-mail
5043 (string-match "@\\(.*\\)\\'" user-mail))
5044 (match-string 1 user-mail)))
5057 ;; Try `mail-host-address'.
5058 ((and (boundp 'mail-host-address)
5059 (stringp mail-host-address)
5060 (string-match message-valid-fqdn-regexp mail-host-address)
5061 (not (string-match message-bogus-system-names mail-host-address)))
5062 mail-host-address)
5063 ;; We try `user-mail-address' as a backup.
5072 ".i-did-not-set--mail-host-address--so-tickle-me")))))
5078 (substring fqdn 0 (1- (match-end 0)))))
5082 (or mail-host-address
5089 (let ((listaddr (message-make-mail-followup-to t)))
5092 (message-remove-header "to")
5093 (message-remove-header "cc")
5097 (defun message-make-mail-followup-to (&optional only-show-subscribed)
5098 "Return the Mail-Followup-To header.
5100 subscribed address (and not the additional To and Cc header contents)."
5106 (mapcar 'mail-strip-quoted-names
5107 (message-tokenize-header msg-recipients)))
5110 (let (begin end item re)
5117 (setq end (point))
5118 (if (bolp) (setq end (1- end)))
5119 (setq item (regexp-quote (buffer-substring begin end)))
5141 (defun message-idna-to-ascii-rhs-1 (header)
5143 (let ((field (message-fetch-field header))
5151 'car (mail-header-parse-addresses field))))))
5156 rhs ace header))))
5158 (while (re-search-forward (concat "^" header ":") nil t)
5202 header value elem header-string)
5223 (setq header (cdr elem)
5225 (setq header (car elem)))
5226 (setq header elem))
5227 (setq header-string (if (stringp header)
5228 header
5229 (symbol-name header)))
5232 (regexp-quote (downcase header-string))
5236 ;; The header was found. We insert a space after the
5239 ;; Find out whether the header is empty.
5246 (not (member header-string message-inserted-headers)))
5247 ;; This is an optional header. If the cdr of this
5249 ;; this header.
5250 (setq header (cdr elem))
5264 ((and (boundp header)
5265 (symbol-value header))
5268 (symbol-value header))
5270 (intern (downcase (symbol-name header)))))
5271 ;; We couldn't generate a value for this header,
5274 (format "Empty header for %s; enter value: " header)))))
5275 ;; Finally insert the header.
5281 ;; This header didn't exist, so we insert it.
5284 (cdr (assq header message-header-format-alist))))
5286 (funcall formatter header value)
5287 (insert header-string ": " value))
5293 ;; The value of this header was empty, so we clear
5296 ;; If the header is optional, and the header was
5299 (push header-string message-inserted-headers)
5302 (and (memq header message-deletable-headers)
5305 (point) (match-end 0)
5315 (cadr (mail-extract-address-components from)))
5321 (cadr (mail-extract-address-components sender)))
5336 "Insert a courtesy message in mail copies of combined messages."
5356 (defun message-fill-address (header value)
5359 (insert (capitalize (symbol-name header))
5395 (defun message-fill-header (header value)
5399 (insert (capitalize (symbol-name header))
5421 (defun message-shorten-references (header references)
5470 (insert (capitalize (symbol-name header)) ": "
5472 (message-fill-header header refstring)))))
5495 goes to beginning of header values."
5502 "Move point to beginning of header value or to beginning of line.
5506 outside the message header or if the option `message-beginning-of-line'
5509 If point is in the message header and on a (non-continued) header
5510 line, move point to the beginning of the header value or the beginning of line,
5512 beginning of header value. Therefore, repeated calls will toggle point
5519 (message-point-in-header-p))
5538 (or (car (mail-extract-address-components to))
5552 (or (car (mail-extract-address-components to))
5625 ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus.
5627 "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to "
5632 (string-equal name "mail")
5641 (to (concat "*sent mail to "
5642 (or (car (mail-extract-address-components to))
5646 (t "*sent mail*"))))
5654 (defun message-mail-user-agent ()
5656 ((not message-mail-user-agent) nil)
5657 ((eq message-mail-user-agent t) mail-user-agent)
5658 (t message-mail-user-agent))))
5665 (let ((mua (message-mail-user-agent))
5667 (if (not (and message-this-is-mail mua))
5680 (let ((mail-user-agent mua))
5681 (compose-mail to subject
5695 header-name)
5696 (dolist (header headers)
5697 (setq header-name (cond
5698 ((and (consp header)
5699 (eq (car header) 'optional))
5701 (cdr header))
5702 ((consp header)
5704 (car header))
5707 header)))
5708 (when (and (not (memq header-name excluded-headers))
5710 (memq header-name included-headers)))
5711 (push header result)))
5722 (mail-header-format
5724 (alist message-header-format-alist))
5726 (unless (assq (caar h) message-header-format-alist)
5738 (insert mail-header-separator "\n")
5753 (when (message-mail-p)
5754 (when message-default-mail-headers
5755 (insert message-default-mail-headers)
5760 (append message-required-mail-headers
5768 (run-hooks 'message-header-setup-hook))
5773 (when (message-mail-p)
5819 (when (message-mail-p)
5823 (copy-sequence message-required-mail-headers))))))))
5833 (defun message-mail (&optional to subject
5836 "Start editing a mail message to be sent.
5837 OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
5839 is a function used to switch to and display the mail buffer."
5841 (let ((message-this-is-mail t) replybuffer)
5842 (unless (message-mail-user-agent)
5850 (message-buffer-name "mail" to))
5852 ;; FIXME: message-mail should do something if YANK-ACTION is not
5879 ;; message-header-synonyms.
5881 (and (loop for synonym in message-header-synonyms
5886 mct (message-fetch-field "mail-copies-to")
5887 author (or (message-fetch-field "mail-reply-to")
5891 mft (and message-use-mail-followup-to
5892 (message-fetch-field "mail-followup-to"))))
5910 (dolist (header address-headers)
5911 (let ((value (message-fetch-field header)))
5916 (or (not (eq message-use-mail-followup-to 'ask))
5918 You should normally obey the Mail-Followup-To: header. In this
5939 You may customize the variable `message-use-mail-followup-to', if you
5967 (cons (downcase (mail-strip-quoted-names addr)) addr))
5968 (message-tokenize-header recipients)))
5991 ;; Build the header alist. Allow the user to be asked whether
6000 (setq recipients (substring recipients (match-end 0))))
6046 (message-this-is-mail t)
6077 (unless (message-mail-user-agent)
6127 mrt (message-fetch-field "mail-reply-to")
6129 mct (message-fetch-field "mail-copies-to"))
6159 You should normally obey the Followup-To: header.
6161 `Followup-To: poster' sends your response via e-mail instead of news.
6177 You should normally obey the Followup-To: header.
6214 are yours except those that have Cancel-Lock header not belonging to you.
6243 (downcase (cadr (mail-extract-address-components from)))
6244 (downcase (cadr (mail-extract-address-components
6252 (cadr (mail-extract-address-components from))))))))))
6263 ;; Get header info from original article.
6286 mail-header-separator "\n"
6301 header line with the old Message-ID."
6314 (message-remove-header message-ignored-supersedes-headers t))
6320 (insert mail-header-separator)
6362 ;; and off the end
6384 The form is: [Source] Subject, where if the original message was mail,
6397 (mail-decode-encoded-word-string prefix))
6402 The form is: [Source] Subject, where if the original message was mail,
6414 (mail-decode-encoded-word-string prefix))
6426 "Return a Subject header suitable for the message in the current buffer."
6436 (mail-decode-encoded-word-string subject))
6458 "Forward the current message via mail.
6459 Optional NEWS will use news to forward instead of mail.
6470 (message-mail nil subject))
6498 (message-remove-header message-forward-ignored-headers t)))))
6545 (message-remove-header message-forward-ignored-headers t)))))
6600 ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs
6603 (rmail-msg-restore-non-pruned-header)))
6626 ;; We first set up a normal mail buffer.
6627 (unless (message-mail-user-agent)
6630 (let ((message-this-is-mail t)
6636 ;; Remove X-Draft-From header etc.
6637 (message-remove-header message-ignored-mail-headers t)
6654 (message-remove-header message-ignored-resent-headers t)
6656 (insert mail-header-separator)
6667 message-required-mail-headers
6669 (message-send-mail))
6675 "Re-mail the current message.
6677 contains some mail you have written which has been bounced back to
6693 ;; We remove everything before the bounced mail.
6706 (delete-region (match-beginning 0) (match-end 0)))))
6710 (message-remove-header message-ignored-bounced-headers t)
6712 (insert mail-header-separator))
6720 (defun message-mail-other-window (&optional to subject)
6721 "Like `message-mail' command, but display mail buffer in another window."
6723 (unless (message-mail-user-agent)
6729 (message-pop-to-buffer (message-buffer-name "mail" to))))
6730 (let ((message-this-is-mail t))
6735 (defun message-mail-other-frame (&optional to subject)
6736 "Like `message-mail' command, but display mail buffer in another frame."
6738 (unless (message-mail-user-agent)
6744 (message-pop-to-buffer (message-buffer-name "mail" to))))
6745 (let ((message-this-is-mail t))
6782 (defun bold-region (start end)
6790 (move-marker end1 (max start end))
6791 (goto-char (min start end))
6798 (defun unbold-region (start end)
6805 (move-marker end1 (max start end))
6806 (goto-char (min start end))
6871 (message-send-and-exit "mail/send")
6872 (message-dont-send "mail/save-draft")
6875 (mml-preview "mail/preview" mml-mode-map)
6936 "mail/save-draft.xpm"
6948 (defcustom message-newgroups-header-regexp
6955 (list (cons message-newgroups-header-regexp 'message-expand-group)
6961 "Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
6982 (let ((mail-abbrev-mode-regexp (caar alist)))
6983 (not (mail-abbrev-in-expansion-header-p))))
7094 (regexp "^gnus\\|^nn\\|^message\\|^sendmail\\|^smtp\\|^user-mail-address"))
7115 (let ((mail-parse-charset (or mail-parse-charset
7134 (message-remove-header "Mime-Version")
7144 (message-remove-first-header "Content-Type")
7145 (message-remove-first-header "Content-Transfer-Encoding"))
7147 ;; header. This is because some broken MTAs and MUAs get
7149 ;; MIME-Version header and without a Content-Type header. For
7150 ;; instance, Solaris' /usr/bin/mail.
7160 (if (fboundp 'mail-abbrevs-setup)
7161 (let ((mail-abbrev-mode-regexp "")
7162 (minibuffer-setup-hook 'mail-abbrevs-setup)
7165 (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
7173 (require 'mail-utils)
7177 (mail-strip-quoted-names
7186 (unless (or (not email) (equal email user-mail-address))
7187 (message-remove-header "From")
7208 (mail-strip-quoted-names
7211 (mail-strip-quoted-names
7235 (if (not (message-hide-header-p regexps))
7236 (message-next-header)
7238 (message-next-header)
7243 (defun message-hide-header-p (regexps)