• Home
  • History
  • Annotate
  • Raw
  • Download
  • only in /macosx-10.10.1/emacs-93/emacs/lisp/gnus/

Lines Matching +defs:mail +defs:header +defs:message +defs:id

0 ;;; message.el --- composing mail and news messages
7 ;; Keywords: mail, news
28 ;; This mode provides mail-sending facilities from within Emacs. It
36 (defvar gnus-message-group-art)
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)
58 "Mail and news message composing."
59 :link '(custom-manual "(message)Top")
60 :group 'mail
63 (put 'user-mail-address 'custom-type 'string)
66 (defgroup message-various nil
68 :link '(custom-manual "(message)Various Message Variables")
69 :group 'message)
71 (defgroup message-buffers nil
73 :link '(custom-manual "(message)Message Buffers")
74 :group 'message)
76 (defgroup message-sending nil
78 :link '(custom-manual "(message)Sending Variables")
79 :group 'message)
81 (defgroup message-interface nil
83 :link '(custom-manual "(message)Interface")
84 :group 'message)
86 (defgroup message-forwarding nil
88 :link '(custom-manual "(message)Forwarding")
89 :group 'message-interface)
91 (defgroup message-insertion nil
93 :link '(custom-manual "(message)Insertion")
94 :group 'message)
96 (defgroup message-headers nil
98 :link '(custom-manual "(message)Message Headers")
99 :group 'message)
101 (defgroup message-news nil
103 :group 'message)
105 (defgroup message-mail nil
107 :group 'message)
109 (defgroup message-faces nil
110 "Faces used for message composing."
111 :group 'message
114 (defcustom message-directory "~/Mail/"
115 "*Directory from which all other mail file variables are derived."
116 :group 'message-various
119 (defcustom message-max-buffers 10
121 :group 'message-buffers
124 (defcustom message-send-rename-function nil
126 :group 'message-buffers
129 (defcustom message-fcc-handler-function 'message-output
132 article in. The default function is `message-output' which saves in Unix
134 :type '(radio (function-item message-output)
136 :group 'message-sending)
138 (defcustom message-fcc-externalize-attachments nil
142 :group 'message-sending)
144 (defcustom message-courtesy-message
145 "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
146 "*This is inserted at the start of a mailed copy of a posted message.
149 If this variable is nil, no such courtesy message will be added."
150 :group 'message-sending
153 (defcustom message-ignored-bounced-headers
155 "*Regexp that matches headers to be removed in resent bounced mail."
156 :group 'message-interface
160 (defcustom message-from-style 'default
176 :group 'message-headers)
178 (defcustom message-insert-canlock t
179 "Whether to insert a Cancel-Lock header in news postings."
181 :group 'message-headers
184 (defcustom message-syntax-checks
185 (if message-insert-canlock '((sender . disabled)) nil)
195 `invisible-text', `long-header-lines', `long-lines', `message-id',
200 :group 'message-news
203 (defcustom message-required-headers '((optional . References)
205 "*Headers to be generated or prompted for when sending a message.
206 Also see `message-required-news-headers' and
207 `message-required-mail-headers'."
209 :group 'message-news
210 :group 'message-headers
211 :link '(custom-manual "(message)Message Headers")
214 (defcustom message-draft-headers '(References From)
215 "*Headers to be generated when saving a draft message."
217 :group 'message-news
218 :group 'message-headers
219 :link '(custom-manual "(message)Message Headers")
222 (defcustom message-required-news-headers
229 User-Agent are optional. If you don't want message to insert some
230 header, remove it from this list."
231 :group 'message-news
232 :group 'message-headers
233 :link '(custom-manual "(message)Message Headers")
236 (defcustom message-required-mail-headers
239 "*Headers to be generated or prompted for when mailing a message.
242 :group 'message-mail
243 :group 'message-headers
244 :link '(custom-manual "(message)Message Headers")
247 (defcustom message-deletable-headers '(Message-ID Date Lines)
248 "Headers to be deleted if they already exist and were generated by message previously."
249 :group 'message-headers
250 :link '(custom-manual "(message)Message Headers")
253 (defcustom message-ignored-news-headers
256 :group 'message-news
257 :group 'message-headers
258 :link '(custom-manual "(message)Message Headers")
266 (defcustom message-ignored-mail-headers
269 :group 'message-mail
270 :group 'message-headers
271 :link '(custom-manual "(message)Mail Headers")
274 (defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:"
278 :group 'message-interface
279 :link '(custom-manual "(message)Superseding")
287 (defcustom message-subject-re-regexp
290 :group 'message-various
291 :link '(custom-manual "(message)Message Headers")
294 ;;; Start of variables adopted from `message-utils.el'.
296 (defcustom message-subject-trailing-was-query 'ask
300 `message-subject-trailing-was-ask-regexp'. If
301 `message-subject-trailing-was-query' is t, always strip the trailing
302 old subject. In this case, `message-subject-trailing-was-regexp' is
308 :link '(custom-manual "(message)Message Headers")
309 :group 'message-various)
311 (defcustom message-subject-trailing-was-ask-regexp
315 The function `message-strip-subject-trailing-was' uses this regexp if
316 `message-subject-trailing-was-query' is set to the symbol `ask'. If
318 `message-subject-trailing-was-regexp' instead.
322 :group 'message-various
323 :link '(custom-manual "(message)Message Headers")
326 (defcustom message-subject-trailing-was-regexp
330 If `message-subject-trailing-was-query' is set to t, the subject is
331 matched against `message-subject-trailing-was-regexp' in
332 `message-strip-subject-trailing-was'. You should use a regexp creating very
335 :group 'message-various
336 :link '(custom-manual "(message)Message Headers")
341 (defcustom message-mark-insert-begin
346 :link '(custom-manual "(message)Insertion Variables")
347 :group 'message-various)
349 (defcustom message-mark-insert-end
354 :link '(custom-manual "(message)Insertion Variables")
355 :group 'message-various)
357 (defcustom message-archive-header "X-No-Archive: Yes\n"
359 Archives \(such as groups.google.com\) respect this header."
362 :link '(custom-manual "(message)Header Commands")
363 :group 'message-various)
365 (defcustom message-archive-note
371 :link '(custom-manual "(message)Header Commands")
372 :group 'message-various)
378 (defvar message-cross-post-old-target nil
380 (make-variable-buffer-local 'message-cross-post-old-target)
382 (defcustom message-cross-post-default t
383 "When non-nil `message-cross-post-followup-to' will perform a crosspost.
384 If nil, `message-cross-post-followup-to' will only do a followup. Note that
386 `message-cross-post-followup-to' with a prefix."
389 :group 'message-various)
391 (defcustom message-cross-post-note "Crosspost & Followup-To: "
395 :group 'message-various)
397 (defcustom message-followup-to-note "Followup-To: "
401 :group 'message-various)
403 (defcustom message-cross-post-note-function 'message-cross-post-insert-note
407 for `message-cross-post-insert-note'."
410 :group 'message-various)
412 ;;; End of variables adopted from `message-utils.el'.
415 (defcustom message-signature-separator "^-- *$"
418 :link '(custom-manual "(message)Various Message Variables")
419 :group 'message-various)
421 (defcustom message-elide-ellipsis "\n[...]\n\n"
424 :link '(custom-manual "(message)Various Commands")
425 :group 'message-various)
427 (defcustom message-interactive t
428 "Non-nil means when sending a message wait for and display errors.
429 nil means let mailer mail back a message to report errors."
430 :group 'message-sending
431 :group 'message-mail
432 :link '(custom-manual "(message)Sending Variables")
435 (defcustom message-generate-new-buffers 'unique
436 "*Say whether to create a new message buffer to compose a message.
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*.
458 :group 'message-buffers
459 :link '(custom-manual "(message)Message Buffers")
467 (defcustom message-kill-buffer-on-exit nil
468 "*Non-nil means that the message buffer will be killed after sending a message."
469 :group 'message-buffers
470 :link '(custom-manual "(message)Message Buffers")
475 (defcustom message-user-organization
481 "*String to be used as an Organization header.
482 If t, use `message-user-organization-file'."
483 :group 'message-headers
488 (defcustom message-user-organization-file "/usr/lib/news/organization"
491 :link '(custom-manual "(message)News Headers")
492 :group 'message-headers)
494 (defcustom message-make-forward-subject-function
495 #'message-forward-subject-name-subject
502 * `message-forward-subject-author-subject' Source of article (author or
504 * `message-forward-subject-name-subject' Source of article (name of author
506 * `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended
508 :group 'message-forwarding
509 :link '(custom-manual "(message)Forwarding")
510 :type '(radio (function-item message-forward-subject-author-subject)
511 (function-item message-forward-subject-fwd)
512 (function-item message-forward-subject-name-subject)
515 (defcustom message-forward-as-mime t
517 Otherwise, directly inline the old message in the forwarded message."
519 :group 'message-forwarding
520 :link '(custom-manual "(message)Forwarding")
523 (defcustom message-forward-show-mml 'best
529 message, because converting MIME to MML would invalidate the
532 :group 'message-forwarding
537 (defcustom message-forward-before-signature t
538 "*Non-nil means put forwarded message before signature, else after."
539 :group 'message-forwarding
542 (defcustom message-wash-forwarded-subjects nil
545 :group 'message-forwarding
546 :link '(custom-manual "(message)Forwarding")
549 (defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From "
550 "*All headers that match this regexp will be deleted when resending a message."
551 :group 'message-interface
552 :link '(custom-manual "(message)Resending")
560 (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
561 "*All headers that match this regexp will be deleted when forwarding a message."
563 :group 'message-forwarding
571 (defcustom message-ignored-cited-headers "."
573 :group 'message-insertion
574 :link '(custom-manual "(message)Insertion Variables")
577 (defcustom message-cite-prefix-regexp
597 :group 'message-insertion
598 :link '(custom-manual "(message)Insertion Variables")
601 (defcustom message-cancel-message "I am canceling my own article.\n"
602 "Message to be inserted in the cancel message."
603 :group 'message-interface
604 :link '(custom-manual "(message)Canceling News")
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',
616 `message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
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)
622 (function-item message-smtpmail-send-it)
626 :group 'message-sending
627 :link '(custom-manual "(message)Mail Variables")
628 :group 'message-mail)
630 (defcustom message-send-news-function 'message-send-news
633 variable `mail-header-separator'."
634 :group 'message-sending
635 :group 'message-news
636 :link '(custom-manual "(message)News Variables")
639 (defcustom message-reply-to-function nil
643 :group 'message-interface
644 :link '(custom-manual "(message)Reply")
647 (defcustom message-wide-reply-to-function nil
651 :group 'message-interface
652 :link '(custom-manual "(message)Wide Reply")
655 (defcustom message-followup-to-function nil
659 :group 'message-interface
660 :link '(custom-manual "(message)Followup")
663 (defcustom message-use-followup-to 'ask
664 "*Specifies what to do with Followup-To header.
665 If nil, always ignore the header. If it is t, use its value, but
669 :group 'message-interface
670 :link '(custom-manual "(message)Followup")
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
682 :group 'message-interface
683 :link '(custom-manual "(message)Mailing Lists")
688 (defcustom message-subscribed-address-functions nil
693 conjunction with `message-subscribed-regexps' and
694 `message-subscribed-addresses'."
696 :group 'message-interface
697 :link '(custom-manual "(message)Mailing Lists")
700 (defcustom message-subscribed-address-file nil
705 :group 'message-interface
706 :link '(custom-manual "(message)Mailing Lists")
709 (defcustom message-subscribed-addresses nil
713 `message-subscribed-address-functions' and `message-subscribed-regexps'."
715 :group 'message-interface
716 :link '(custom-manual "(message)Mailing Lists")
719 (defcustom message-subscribed-regexps nil
723 `message-subscribed-address-functions' and `message-subscribed-addresses'."
725 :group 'message-interface
726 :link '(custom-manual "(message)Mailing Lists")
729 (defcustom message-allow-no-recipients 'ask
735 :group 'message-interface
736 :link '(custom-manual "(message)Message Headers")
741 (defcustom message-sendmail-f-is-evil nil
744 :group 'message-sending
745 :link '(custom-manual "(message)Mail Variables")
748 (defcustom message-sendmail-envelope-from nil
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))
756 :link '(custom-manual "(message)Mail Variables")
757 :group 'message-sending)
760 (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
762 :group 'message-sending
763 :link '(custom-manual "(message)Mail Variables")
766 (defcustom message-qmail-inject-args nil
774 :group 'message-sending
775 :link '(custom-manual "(message)Mail Variables")
779 (defvar message-cater-to-broken-inn t
780 "Non-nil means Gnus should not fold the `References' header.
787 (defcustom message-post-method
798 :group 'message-news
799 :group 'message-sending
806 ;; will *not* have a `References:' header if `message-generate-headers-first'
808 (defcustom message-generate-headers-first '(references)
809 "Which headers should be generated before starting to compose a message.
811 generate. The variables `message-required-news-headers' and
812 `message-required-mail-headers' specify which headers to generate.
814 Note that the variable `message-deletable-headers' specifies headers which
817 :group 'message-headers
818 :link '(custom-manual "(message)Message Headers")
824 (defcustom message-setup-hook nil
825 "Normal hook, run each time a new outgoing message is initialized.
826 The function `message-setup' runs this hook."
827 :group 'message-various
828 :link '(custom-manual "(message)Various Message Variables")
831 (defcustom message-cancel-hook nil
833 :group 'message-various
834 :link '(custom-manual "(message)Various Message Variables")
837 (defcustom message-signature-setup-hook nil
838 "Normal hook, run each time a new outgoing message is initialized.
841 :group 'message-various
842 :link '(custom-manual "(message)Various Message Variables")
845 (defcustom message-mode-hook nil
846 "Hook run in message mode buffers."
847 :group 'message-various
850 (defcustom message-header-hook nil
851 "Hook run in a message mode buffer narrowed to the headers."
852 :group 'message-various
855 (defcustom message-header-setup-hook nil
856 "Hook called narrowed to the headers when setting up a message buffer."
857 :group 'message-various
858 :link '(custom-manual "(message)Various Message Variables")
861 (defcustom message-minibuffer-local-map
862 (let ((map (make-sparse-keymap 'message-minibuffer-local-map)))
865 "Keymap for `message-read-from-minibuffer'."
867 :group 'message-various)
870 (defcustom message-citation-line-function 'message-insert-citation-line
875 people who read your message will have to change their Gnus
878 :link '(custom-manual "(message)Insertion Variables")
879 :group 'message-insertion)
882 (defcustom message-yank-prefix "> "
884 Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
885 See also `message-yank-cited-prefix'."
887 :link '(custom-manual "(message)Insertion Variables")
888 :group 'message-insertion)
890 (defcustom message-yank-cited-prefix ">"
892 Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
893 See also `message-yank-prefix'."
896 :link '(custom-manual "(message)Insertion Variables")
897 :group 'message-insertion)
899 (defcustom message-indentation-spaces 3
901 Used by `message-yank-original' via `message-yank-cite'."
902 :group 'message-insertion
903 :link '(custom-manual "(message)Insertion Variables")
907 (defcustom message-cite-function 'message-cite-original
908 "*Function for citing an original message.
909 Predefined functions include `message-cite-original' and
910 `message-cite-original-without-signature'.
911 Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
912 :type '(radio (function-item message-cite-original)
913 (function-item message-cite-original-without-signature)
916 :link '(custom-manual "(message)Insertion Variables")
917 :group 'message-insertion)
920 (defcustom message-indent-citation-function 'message-indent-citation
921 "*Function for modifying a citation just inserted in the mail buffer.
926 :link '(custom-manual "(message)Insertion Variables")
927 :group 'message-insertion)
930 (defcustom message-signature t
931 "*String to be inserted at the end of the message buffer.
932 If t, the `message-signature-file' file will be inserted instead.
936 :link '(custom-manual "(message)Insertion Variables")
937 :group 'message-insertion)
940 (defcustom message-signature-file "~/.signature"
941 "*Name of file containing the text inserted at end of message buffer.
945 :link '(custom-manual "(message)Insertion Variables")
946 :group 'message-insertion)
949 (defcustom message-signature-insert-empty-line t
953 :link '(custom-manual "(message)Insertion Variables")
954 :group 'message-insertion)
956 (defcustom message-distribution-function nil
957 "*Function called to return a Distribution header."
958 :group 'message-news
959 :group 'message-headers
960 :link '(custom-manual "(message)News Headers")
963 (defcustom message-expires 14
965 :group 'message-news
966 :group 'message-headers
967 :link '(custom-manual "(message)News Headers")
970 (defcustom message-user-path nil
971 "If nil, use the NNTP server name in the Path header.
973 :group 'message-news
974 :group 'message-headers
975 :link '(custom-manual "(message)News Headers")
980 (defvar message-reply-buffer nil)
981 (defvar message-reply-headers nil
984 \[number subject from date id references chars lines xref extra].")
985 (defvar message-newsreader nil)
986 (defvar message-mailer nil)
987 (defvar message-sent-message-via nil)
988 (defvar message-checksum nil)
989 (defvar message-send-actions nil
990 "A list of actions to be performed upon successful sending of a message.")
991 (defvar message-exit-actions nil
992 "A list of actions to be performed upon exiting after sending a message.")
993 (defvar message-kill-actions nil
994 "A list of actions to be performed before killing a message buffer.")
995 (defvar message-postpone-actions nil
996 "A list of actions to be performed after postponing a message.")
998 (define-widget 'message-header-lines 'text
999 "All header lines must be LFD terminated."
1002 :error "All header lines must be newline terminated")
1004 (defcustom message-default-headers ""
1005 "*A string containing header lines to be inserted in outgoing messages.
1006 It is inserted before you edit the message, so you can edit or delete
1008 :group 'message-headers
1009 :link '(custom-manual "(message)Message Headers")
1010 :type 'message-header-lines)
1012 (defcustom message-default-mail-headers ""
1013 "*A string of header lines to be inserted in outgoing mails."
1014 :group 'message-headers
1015 :group 'message-mail
1016 :link '(custom-manual "(message)Mail Headers")
1017 :type 'message-header-lines)
1019 (defcustom message-default-news-headers ""
1020 "*A string of header lines to be inserted in outgoing news articles."
1021 :group 'message-headers
1022 :group 'message-news
1023 :link '(custom-manual "(message)News Headers")
1024 :type 'message-header-lines)
1026 ;; Note: could use /usr/ucb/mail instead of sendmail;
1028 (defcustom message-mailer-swallows-blank-line
1046 "*Set this non-nil if the system's mailer runs the header and body together.
1050 :group 'message-sending
1051 :link '(custom-manual "(message)Mail Variables")
1055 (define-mail-user-agent 'message-user-agent
1056 'message-mail 'message-send-and-exit
1057 'message-kill-buffer 'message-send-hook)
1059 (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
1062 (defvar message-send-method-alist
1063 '((news message-news-p message-send-via-news)
1064 (mail message-mail-p message-send-via-mail))
1071 called without any parameters to determine whether the message is
1072 a message of type TYPE; and FUNCTION is a function to be called if
1076 (defcustom message-mail-alias-type 'abbrev
1079 mail aliases off."
1080 :group 'message
1081 :link '(custom-manual "(message)Mail Aliases")
1085 (defcustom message-auto-save-directory
1086 (file-name-as-directory (nnheader-concat message-directory "drafts"))
1089 :group 'message-buffers
1090 :link '(custom-manual "(message)Various Message Variables")
1093 (defcustom message-default-charset
1098 :group 'message
1099 :link '(custom-manual "(message)Various Message Variables")
1102 (defcustom message-dont-reply-to-names
1107 :group 'message
1108 :link '(custom-manual "(message)Wide Reply")
1112 (defvar message-shoot-gnksa-feet nil
1124 (defsubst message-gnksa-enable-p (feature)
1125 (or (not (listp message-shoot-gnksa-feet))
1126 (memq feature message-shoot-gnksa-feet)))
1128 (defcustom message-hidden-headers nil
1133 :group 'message
1134 :link '(custom-manual "(message)Message Headers")
1140 (defvar message-mode-syntax-table
1148 (defface message-header-to
1158 :group 'message-faces)
1160 (put 'message-header-to-face 'face-alias 'message-header-to)
1162 (defface message-header-cc
1172 :group 'message-faces)
1174 (put 'message-header-cc-face 'face-alias 'message-header-cc)
1176 (defface message-header-subject
1186 :group 'message-faces)
1188 (put 'message-header-subject-face 'face-alias 'message-header-subject)
1190 (defface message-header-newsgroups
1200 :group 'message-faces)
1202 (put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups)
1204 (defface message-header-other
1214 :group 'message-faces)
1216 (put 'message-header-other-face 'face-alias 'message-header-other)
1218 (defface message-header-name
1227 "Face used for displaying header names."
1228 :group 'message-faces)
1230 (put 'message-header-name-face 'face-alias 'message-header-name)
1232 (defface message-header-xheader
1242 :group 'message-faces)
1244 (put 'message-header-xheader-face 'face-alias 'message-header-xheader)
1246 (defface message-separator
1256 :group 'message-faces)
1258 (put 'message-separator-face 'face-alias 'message-separator)
1260 (defface message-cited-text
1270 :group 'message-faces)
1272 (put 'message-cited-text-face 'face-alias 'message-cited-text)
1274 (defface message-mml
1284 :group 'message-faces)
1286 (put 'message-mml-face 'face-alias 'message-mml)
1288 (defun message-font-lock-make-header-matcher (regexp)
1296 (concat "^" (regexp-quote mail-header-separator) "$")
1306 (defvar message-font-lock-keywords
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) "\\)$")
1335 1 'message-separator))
1339 message-cite-prefix-regexp
1342 (0 'message-cited-text))
1344 (0 'message-mml))))
1350 (put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
1352 (defvar message-face-alist
1358 "Alist of mail and news faces for facemenu.
1361 (defcustom message-send-hook nil
1364 :group 'message-various
1365 :options '(ispell-message)
1366 :link '(custom-manual "(message)Various Message Variables")
1369 (defcustom message-send-mail-hook nil
1370 "Hook run before sending mail messages.
1371 This hook is run very late -- just before the message is sent as
1372 mail."
1373 :group 'message-various
1374 :link '(custom-manual "(message)Various Message Variables")
1377 (defcustom message-send-news-hook nil
1379 This hook is run very late -- just before the message is sent as
1381 :group 'message-various
1382 :link '(custom-manual "(message)Various Message Variables")
1385 (defcustom message-sent-hook nil
1387 :group 'message-various
1390 (defvar message-send-coding-system 'binary
1391 "Coding system to encode outgoing mail.")
1393 (defvar message-draft-coding-system
1395 "*Coding system to compose mail.
1400 (defcustom message-send-mail-partially-limit 1000000
1401 "The limitation of messages sent as message/partial.
1402 The lower bound of message size in characters, beyond which the message
1405 :group 'message-buffers
1406 :link '(custom-manual "(message)Mail Variables")
1410 (defcustom message-alternative-emails nil
1417 off `message-setup-hook'."
1418 :group 'message-headers
1419 :link '(custom-manual "(message)Message Headers")
1423 (defcustom message-hierarchical-addresses nil
1424 "A list of hierarchical mail address definitions.
1428 mail sent to the first address will automatically be delivered to the
1430 for a message, the subaddresses will be removed (if present) before
1431 the mail is sent. All addresses in this structure should be
1434 :group 'message-headers
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"
1456 :group 'message)
1458 (defcustom message-wide-reply-confirm-recipients nil
1466 :group 'message-headers
1467 :link '(custom-manual "(message)Wide Reply")
1470 (defcustom message-user-fqdn nil
1473 :group 'message-headers
1474 :link '(custom-manual "(message)News Headers")
1478 (defcustom message-use-idna (and (condition-case nil (require 'idna)
1490 :group 'message-headers
1491 :link '(custom-manual "(message)IDNA")
1498 (defvar message-sending-message "Sending...")
1499 (defvar message-buffer-list nil)
1500 (defvar message-this-is-news nil)
1501 (defvar message-this-is-mail nil)
1502 (defvar message-draft-article nil)
1503 (defvar message-mime-part nil)
1504 (defvar message-posting-charset nil)
1505 (defvar message-inserted-headers 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
1545 ;; The time the message was sent.
1565 "Regexp matching the delimiter of messages in UNIX mail format.")
1567 (defvar message-unsent-separator
1568 (concat "^ *---+ +Unsent message follows +---+ *$\\|"
1569 "^ *---+ +Returned message +---+ *$\\|"
1570 "^Start of returned message$\\|"
1571 "^ *---+ +Original message +---+ *$\\|"
1572 "^ *--+ +begin message +--+ *$\\|"
1573 "^ *---+ +Original message follows +---+ *$\\|"
1574 "^ *---+ +Undelivered message follows +---+ *$\\|"
1576 "A regexp that matches the separator before the text of a failed message.")
1578 (defvar message-header-format-alist
1580 (To . message-fill-address)
1581 (Cc . message-fill-address)
1592 (References . message-shorten-references)
1596 (defvar message-options nil
1597 "Some saved answers when sending message.")
1599 (defvar message-send-mail-real-function nil
1600 "Internal send mail function.")
1602 (defvar message-bogus-system-names "^localhost\\.\\|\\.local$"
1605 (defcustom message-valid-fqdn-regexp
1621 :group 'message-headers
1626 (autoload 'message-setup-toolbar "messagexmas")
1632 (autoload 'gnus-output-to-mail "gnus-util")
1655 (defmacro message-y-or-n-p (question show &rest text)
1657 `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
1659 (defmacro message-delete-line (&optional n)
1664 (defun message-mark-active-p ()
1668 (defun message-unquote-tokens (elems)
1677 (defun message-tokenize-header (header &optional separator)
1678 "Split HEADER into a list of header elements.
1681 (if (not header)
1689 (insert header)
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;
1725 see `message-narrow-to-headers-or-head'."
1728 (value (mail-fetch-field header nil (not not-all))))
1735 (defun message-field-value (header &optional not-all)
1736 "The same as `message-fetch-field', only narrow to the headers first."
1739 (message-narrow-to-headers-or-head)
1740 (message-fetch-field header not-all))))
1742 (defun message-narrow-to-field ()
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)))
1764 (message-narrow-to-headers)
1772 (defmacro message-with-reply-buffer (&rest forms)
1774 `(when (and message-reply-buffer
1775 (buffer-name message-reply-buffer))
1777 (set-buffer message-reply-buffer)
1780 (put 'message-with-reply-buffer 'lisp-indent-function 0)
1781 (put 'message-with-reply-buffer 'edebug-form-spec '(body))
1783 (defun message-fetch-reply-field (header)
1784 "Fetch field HEADER from the message we're replying to."
1785 (message-with-reply-buffer
1787 (mail-narrow-to-head)
1788 (message-fetch-field header))))
1790 (defun message-strip-list-identifiers (subject)
1805 (defun message-strip-subject-re (subject)
1807 (if (string-match message-subject-re-regexp subject)
1811 (defcustom message-replacement-char "."
1813 :group 'message-various
1819 ;; FIXME: We also should call `message-strip-subject-encoded-words'
1820 ;; when forwarding. Probably in `message-make-forward-subject' and
1821 ;; `message-forward-make-body'.
1823 (defun message-strip-subject-encoded-words (subject)
1828 message-replacement-char
1829 message-replacement-char
1830 message-replacement-char))
1874 subject cs-string message-replacement-char)))
1886 (message "Replacing non-decodable characters with \"%s\"."
1887 message-replacement-char)
1890 (replace-match message-replacement-char)))
1892 (message "Replacing non-decodable characters with \"%s\"."
1901 ;;; Start of functions adopted from `message-utils.el'.
1903 (defun message-strip-subject-trailing-was (subject)
1906 `message-strip-subject-re' for this."
1907 (let* ((query message-subject-trailing-was-query)
1912 message-subject-trailing-was-ask-regexp
1913 message-subject-trailing-was-regexp)
1920 (if (message-y-or-n-p
1929 "See the variable `message-subject-trailing-was-query' "
1937 (defun message-change-subject (new-subject)
1938 "Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
1949 (message-narrow-to-headers)
1950 (message-fetch-field "Subject"))))
1960 (message-strip-subject-re old-subject))
1961 (message-goto-subject)
1962 (message-delete-line)
1968 (defun message-mark-inserted-region (beg end)
1970 See `message-mark-insert-begin' and `message-mark-insert-end'."
1975 (insert message-mark-insert-end)
1977 (insert message-mark-insert-begin)))
1979 (defun message-mark-insert-file (file)
1981 See `message-mark-insert-begin' and `message-mark-insert-end'."
1985 (insert message-mark-insert-end)
1989 (insert message-mark-insert-begin)))
1991 (defun message-add-archive-header ()
1992 "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
1993 The note can be customized using `message-archive-note'. When called with a
1995 body, set `message-archive-note' to nil."
1998 (setq message-archive-note
2000 (cons message-archive-note 0))))
2002 (if (message-goto-signature)
2003 (re-search-backward message-signature-separator))
2004 (when message-archive-note
2005 (insert message-archive-note)
2007 (message-add-header message-archive-header)
2008 (message-sort-headers)))
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)
2022 (message-goto-newsgroups)
2025 (if (and message-cross-post-old-target
2027 (regexp-quote (concat "," message-cross-post-old-target))
2035 (and message-cross-post-default (not current-prefix-arg))
2037 (and (not message-cross-post-default) current-prefix-arg))
2040 (message-fetch-field "Newsgroups"))))
2049 (message-fetch-field "Newsgroups")))
2051 (setq message-cross-post-old-target target-group))
2053 (defun message-cross-post-insert-note (target-group cross-post in-old
2055 "Insert a in message body note about a set Followup or Crosspost.
2062 (message-goto-signature)
2064 (concat "^" mail-header-separator)
2066 (message-goto-signature)
2068 (concat "^" (regexp-quote message-cross-post-note) ".*")
2070 (message-delete-line))
2071 (message-goto-signature)
2073 (concat "^" (regexp-quote message-followup-to-note) ".*")
2075 (message-delete-line))
2077 (if (message-goto-signature)
2078 (re-search-backward message-signature-separator))
2082 (insert (concat message-followup-to-note target-group "\n"))
2083 (insert (concat message-cross-post-note target-group "\n")))))
2085 (defun message-cross-post-followup-to (target-group)
2086 "Crossposts message and set Followup-To to TARGET-GROUP.
2100 (let* ((old-groups (message-fetch-field "Newsgroups"))
2114 (message-cross-post-followup-to-header target-group)
2116 (funcall message-cross-post-note-function
2118 (if (or (and message-cross-post-default
2120 (and (not message-cross-post-default)
2124 ;;; Reduce To: to Cc: or Bcc: header
2126 (defun message-reduce-to-to-cc ()
2127 "Replace contents of To: header with contents of Cc: or Bcc: header."
2130 (save-restriction (message-narrow-to-headers)
2131 (message-fetch-field "cc")))
2136 (message-narrow-to-headers)
2137 (message-fetch-field "bcc"))))
2141 (message-goto-to)
2142 (message-delete-line)
2145 (message-narrow-to-headers)
2146 (message-remove-header (if bcc
2150 ;;; End of functions adopted from `message-utils.el'.
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)
2198 (defun message-narrow-to-headers ()
2199 "Narrow the buffer to the head of the message."
2204 (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
2209 (defun message-narrow-to-head-1 ()
2210 "Like `message-narrow-to-head'. Don't widen."
2218 (defun message-narrow-to-head ()
2219 "Narrow the buffer to the head of the message.
2222 (message-narrow-to-head-1))
2224 (defun message-narrow-to-headers-or-head ()
2225 "Narrow the buffer to the head of the message."
2230 (regexp-quote mail-header-separator)
2237 (defun message-news-p ()
2238 "Say whether the current buffer contains a news message."
2239 (and (not message-this-is-mail)
2240 (or message-this-is-news
2243 (message-narrow-to-headers)
2244 (and (message-fetch-field "newsgroups")
2245 (not (message-fetch-field "posted-to"))))))))
2247 (defun message-mail-p ()
2248 "Say whether the current buffer contains a mail message."
2249 (and (not message-this-is-news)
2250 (or message-this-is-mail
2253 (message-narrow-to-headers)
2254 (or (message-fetch-field "to")
2255 (message-fetch-field "cc")
2256 (message-fetch-field "bcc")))))))
2258 (defun message-subscribed-p ()
2259 "Say whether we need to insert a MFT header."
2260 (or message-subscribed-regexps
2261 message-subscribed-addresses
2262 message-subscribed-address-file
2263 message-subscribed-address-functions))
2265 (defun message-next-header ()
2266 "Go to the beginning of the next header."
2273 (defun message-sort-headers-1 ()
2274 "Sort the buffer as headers using `message-rank' text props."
2278 nil 'message-next-header
2280 (message-next-header)
2284 (or (get-text-property (point) 'message-rank)
2287 (defun message-sort-headers ()
2288 "Sort the headers of the current message according to `message-header-format-alist'."
2292 (let ((max (1+ (length message-header-format-alist)))
2294 (message-narrow-to-headers)
2298 'message-rank
2302 message-header-format-alist)
2303 message-header-format-alist)))
2306 (message-sort-headers-1))))
2308 (defun message-info (&optional arg)
2316 (t (Info-goto-node "(message)Top"))))
2327 (defvar message-mode-map nil)
2329 (unless message-mode-map
2330 (setq message-mode-map (make-keymap))
2331 (set-keymap-parent message-mode-map text-mode-map)
2332 (define-key message-mode-map "\C-c?" 'describe-mode)
2334 (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
2335 (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from)
2336 (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
2337 (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
2338 (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
2339 (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
2340 (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
2341 (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
2342 (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
2343 (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
2344 (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to)
2345 (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
2346 (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
2347 (define-key message-mode-map "\C-c\C-f\C-i"
2348 'message-insert-or-toggle-importance)
2349 (define-key message-mode-map "\C-c\C-f\C-a"
2350 'message-generate-unsubscribed-mail-followup-to)
2353 (define-key message-mode-map "\C-c\C-fs" 'message-change-subject)
2355 (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to)
2356 ;; prefix+message-cross-post-followup-to = same w/o cross-post
2357 (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc)
2358 (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header)
2360 (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
2361 (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
2363 (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
2364 (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
2366 (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
2367 (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
2368 (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
2369 (define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
2371 (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
2372 (define-key message-mode-map "\C-c\M-n"
2373 'message-insert-disposition-notification-to)
2375 (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
2376 (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
2377 (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
2378 (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
2379 (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
2380 (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
2381 (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
2382 (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
2384 (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
2385 (define-key message-mode-map "\C-c\C-s" 'message-send)
2386 (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
2387 (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
2388 (define-key message-mode-map "\C-c\n" 'gnus-delay-article)
2390 (define-key message-mode-map "\C-c\C-e" 'message-elide-region)
2391 (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
2392 (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
2393 (define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
2394 ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
2395 (define-key message-mode-map [remap split-line] 'message-split-line)
2397 (define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
2399 (define-key message-mode-map "\C-a" 'message-beginning-of-line)
2400 (define-key message-mode-map "\t" 'message-tab)
2401 (define-key message-mode-map "\M-;" 'comment-region))
2404 message-mode-menu message-mode-map "Message Menu."
2406 ["Yank Original" message-yank-original message-reply-buffer]
2407 ["Fill Yanked Message" message-fill-yanked-message t]
2408 ["Insert Signature" message-insert-signature t]
2409 ["Caesar (rot13) Message" message-caesar-buffer-body t]
2410 ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)]
2411 ["Elide Region" message-elide-region
2412 :active (message-mark-active-p)
2415 ["Delete Outside Region" message-delete-not-region
2416 :active (message-mark-active-p)
2419 ["Kill To Signature" message-kill-to-signature t]
2420 ["Newline and Reformat" message-newline-and-reformat t]
2421 ["Rename buffer" message-rename-buffer t]
2422 ["Spellcheck" ispell-message
2424 '(:help "Spellcheck this message"))]
2426 ["Insert Region Marked" message-mark-inserted-region
2427 :active (message-mark-active-p)
2430 ["Insert File Marked..." message-mark-insert-file
2434 ["Send Message" message-send-and-exit
2436 '(:help "Send this message"))]
2437 ["Postpone Message" message-dont-send
2439 '(:help "File this draft message and exit"))]
2442 '(:help "Ask, then arrange to send message at that time"))]
2443 ["Kill Message" message-kill-buffer
2445 '(:help "Delete this message without sending"))]
2447 ["Message manual" message-info
2452 message-mode-field-menu message-mode-map ""
2454 ["To" message-goto-to t]
2455 ["From" message-goto-from t]
2456 ["Subject" message-goto-subject t]
2457 ["Change subject..." message-change-subject t]
2458 ["Cc" message-goto-cc t]
2459 ["Bcc" message-goto-bcc t]
2460 ["Fcc" message-goto-fcc t]
2461 ["Reply-To" message-goto-reply-to t]
2462 ["Flag As Important" message-insert-importance-high
2464 '(:help "Mark this message as important"))]
2465 ["Flag As Unimportant" message-insert-importance-low
2467 '(:help "Mark this message as unimportant"))]
2469 message-insert-disposition-notification-to
2474 ["Summary" message-goto-summary t]
2475 ["Keywords" message-goto-keywords t]
2476 ["Newsgroups" message-goto-newsgroups t]
2477 ["Fetch Newsgroups" message-insert-newsgroups t]
2478 ["Followup-To" message-goto-followup-to t]
2479 ;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
2480 ["Crosspost / Followup-To..." message-cross-post-followup-to t]
2481 ["Distribution" message-goto-distribution t]
2482 ["X-No-Archive:" message-add-archive-header t ]
2485 ["Fetch To" message-insert-to
2487 '(:help "Insert a To header that points to the author."))]
2488 ["Fetch To and Cc" message-insert-wide-reply
2493 ["Send to list only" message-to-list-only t]
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."))]
2498 ["Reduce To: to Cc:" message-reduce-to-to-cc t]
2500 ["Sort Headers" message-sort-headers t]
2501 ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
2502 ["Goto Body" message-goto-body t]
2503 ["Goto Signature" message-goto-signature t]))
2505 (defvar message-tool-bar-map nil)
2514 ;; that interfer with the normal function of message mode out of the
2517 (defcustom message-strip-special-text-properties t
2518 "Strip special properties from the message buffer.
2520 Emacs has a number of special text properties which can break message
2521 composing in various ways. If this option is set, message will strip
2522 these properties from the message composition buffer. However, some
2525 message composition doesn't break too bad."
2527 :group 'message-various
2528 :link '(custom-manual "(message)Various Message Variables")
2531 (defconst message-forbidden-properties
2543 "Property list of with properties forbidden in message buffers.
2546 (defun message-tamago-not-in-use-p (pos)
2560 (defun message-strip-forbidden-properties (begin end &optional old-length)
2563 See also `message-forbidden-properties'."
2564 (when (and message-strip-special-text-properties
2565 (message-tamago-not-in-use-p begin))
2569 (when (not (get-text-property begin 'message-hidden))
2571 message-forbidden-properties))
2575 (define-derived-mode message-mode text-mode "Message"
2576 "Major mode for editing mail and news to be sent.
2577 Like Text Mode but with these additional commands:\\<message-mode-map>
2578 C-c C-s `message-send' (send the message) C-c C-c `message-send-and-exit'
2579 C-c C-d Postpone sending the message C-c C-k Kill the message
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)
2595 C-c C-l `message-to-list-only' (removes all but list address in to/cc)
2596 C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply)
2597 C-c C-b `message-goto-body' (move to beginning of message text).
2598 C-c C-i `message-goto-signature' (move to the beginning of the signature).
2599 C-c C-w `message-insert-signature' (insert `message-signature-file' file).
2600 C-c C-y `message-yank-original' (insert current message, if any).
2601 C-c C-q `message-fill-yanked-message' (fill what was yanked).
2602 C-c C-e `message-elide-region' (elide the text between point and mark).
2603 C-c C-v `message-delete-not-region' (remove the text outside the region).
2604 C-c C-z `message-kill-to-signature' (kill the text up to the signature).
2605 C-c C-r `message-caesar-buffer-body' (rot13 the message body).
2607 C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance).
2608 C-c M-n `message-insert-disposition-notification-to' (request receipt).
2609 C-c M-m `message-mark-inserted-region' (mark region with enclosing tags).
2610 C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags).
2611 M-RET `message-newline-and-reformat' (break the line and reformat)."
2613 (set (make-local-variable 'message-reply-buffer) nil)
2614 (set (make-local-variable 'message-inserted-headers) nil)
2615 (set (make-local-variable 'message-send-actions) nil)
2616 (set (make-local-variable 'message-exit-actions) nil)
2617 (set (make-local-variable 'message-kill-actions) nil)
2618 (set (make-local-variable 'message-postpone-actions) nil)
2619 (set (make-local-variable 'message-draft-article) nil)
2623 (let ((face-fun (cdr (assq face message-face-alist))))
2629 (set (make-local-variable 'message-reply-headers) nil)
2630 (make-local-variable 'message-newsreader)
2631 (make-local-variable 'message-mailer)
2632 (make-local-variable 'message-post-method)
2633 (set (make-local-variable 'message-sent-message-via) nil)
2634 (set (make-local-variable 'message-checksum) nil)
2635 (set (make-local-variable 'message-mime-part) 0)
2636 (message-setup-fill-variables)
2638 ;; (set (make-local-variable 'comment-start) message-yank-prefix)
2639 (when message-yank-prefix
2640 (set (make-local-variable 'comment-start) message-yank-prefix)
2642 (concat "^" (regexp-quote message-yank-prefix) "[ \t]*")))
2644 (message-setup-toolbar)
2646 '(message-font-lock-keywords t))
2648 (set (make-local-variable 'tool-bar-map) (message-make-tool-bar))))
2649 (easy-menu-add message-mode-menu message-mode-map)
2650 (easy-menu-add message-mode-field-menu message-mode-map)
2653 (add-hook 'after-change-functions 'message-strip-forbidden-properties
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))))
2662 (message-set-auto-save-file-name))
2670 (defun message-setup-fill-variables ()
2671 "Setup message fill variables."
2673 'message-fill-paragraph)
2681 ;; User should change message-cite-prefix-regexp if
2682 ;; message-yank-prefix is set to an abnormal value.
2683 (concat "\\(" message-cite-prefix-regexp "\\)[ \t]*")))
2686 (regexp-quote mail-header-separator) "$\\|"
2705 (setq normal-auto-fill-function 'message-do-auto-fill)
2723 (defun message-goto-to ()
2724 "Move point to the To header."
2726 (message-position-on-field "To"))
2728 (defun message-goto-from ()
2729 "Move point to the From header."
2731 (message-position-on-field "From"))
2733 (defun message-goto-subject ()
2734 "Move point to the Subject header."
2736 (message-position-on-field "Subject"))
2738 (defun message-goto-cc ()
2739 "Move point to the Cc header."
2741 (message-position-on-field "Cc" "To"))
2743 (defun message-goto-bcc ()
2744 "Move point to the Bcc header."
2746 (message-position-on-field "Bcc" "Cc" "To"))
2748 (defun message-goto-fcc ()
2749 "Move point to the Fcc header."
2751 (message-position-on-field "Fcc" "To" "Newsgroups"))
2753 (defun message-goto-reply-to ()
2754 "Move point to the Reply-To header."
2756 (message-position-on-field "Reply-To" "Subject"))
2758 (defun message-goto-newsgroups ()
2759 "Move point to the Newsgroups header."
2761 (message-position-on-field "Newsgroups"))
2763 (defun message-goto-distribution ()
2764 "Move point to the Distribution header."
2766 (message-position-on-field "Distribution"))
2768 (defun message-goto-followup-to ()
2769 "Move point to the Followup-To header."
2771 (message-position-on-field "Followup-To" "Newsgroups"))
2773 (defun message-goto-mail-followup-to ()
2774 "Move point to the Mail-Followup-To header."
2776 (message-position-on-field "Mail-Followup-To" "To"))
2778 (defun message-goto-keywords ()
2779 "Move point to the Keywords header."
2781 (message-position-on-field "Keywords" "Subject"))
2783 (defun message-goto-summary ()
2784 "Move point to the Summary header."
2786 (message-position-on-field "Summary" "Subject"))
2788 (defun message-goto-body (&optional interactivep)
2789 "Move point to the beginning of the message body."
2795 (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
2798 (defun message-in-body-p ()
2799 "Return t if point is in the message body."
2800 (let ((body (save-excursion (message-goto-body) (point))))
2803 (defun message-goto-eoh ()
2806 (message-goto-body)
2809 (defun message-goto-signature ()
2810 "Move point to the beginning of the message signature.
2815 (if (re-search-forward message-signature-separator nil t)
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."
2834 (message-narrow-to-headers)
2835 (message-remove-header "Mail-Followup-To")
2836 (setq cc (and include-cc (message-fetch-field "Cc")))
2838 (concat (message-fetch-field "To") "," cc)
2839 (message-fetch-field "To"))))
2840 (message-goto-mail-followup-to)
2841 (insert (concat tos ", " user-mail-address))))
2846 (defun message-insert-to (&optional force)
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")
2855 (message-fetch-reply-field "reply-to")
2856 (message-fetch-reply-field "from"))))
2858 (message
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"))
2865 (message-carefully-insert-headers (list (cons 'To to))))))
2867 (defun message-insert-wide-reply ()
2870 (let ((headers (message-with-reply-buffer
2871 (message-get-reply-headers t))))
2872 (message-carefully-insert-headers headers)))
2874 (defcustom message-header-synonyms
2877 "List of lists of header synonyms.
2879 then `message-carefully-insert-headers' will not insert a `To' header
2880 when the message is already `Cc'ed to the recipient."
2882 :group 'message-headers
2883 :link '(custom-manual "(message)Message Headers")
2886 (defun message-carefully-insert-headers (headers)
2887 "Insert the HEADERS, an alist, into the message buffer.
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)))))
2912 (defun message-widen-reply ()
2916 (and message-reply-buffer
2917 (buffer-name message-reply-buffer)
2919 (set-buffer message-reply-buffer)
2920 (message-get-reply-headers t)))))
2923 (message-narrow-to-headers)
2925 (message-remove-header (symbol-name (car elem)))
2930 (defun message-insert-newsgroups ()
2931 "Insert the Newsgroups header from the article being replied to."
2933 (when (and (message-position-on-field "Newsgroups")
2934 (mail-fetch-field "newsgroups")
2935 (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
2937 (insert (or (message-fetch-reply-field "newsgroups") "")))
2944 (defun message-delete-not-region (beg end)
2945 "Delete everything in the body of the current message outside of the region."
2952 (when (looking-at message-cite-prefix-regexp)
2955 (delete-region (point) (if (not (message-goto-signature))
2961 (delete-region beg (progn (message-goto-body)
2966 (when (message-goto-signature)
2969 (defun message-kill-to-signature ()
2973 (message-goto-signature)
2980 (defun message-newline-and-reformat (&optional arg not-break)
2992 (not (looking-at message-cite-prefix-regexp))
2996 (when (looking-at message-cite-prefix-regexp)
3013 (looking-at message-cite-prefix-regexp)
3024 (looking-at message-cite-prefix-regexp)
3033 (not (looking-at message-cite-prefix-regexp)))
3039 (not (looking-at message-cite-prefix-regexp)))
3068 (defun message-fill-paragraph (&optional arg)
3073 (message-newline-and-reformat arg t)
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")
3086 (defun message-do-auto-fill ()
3087 "Like `do-auto-fill', but don't fill in message header."
3088 (unless (message-point-in-header-p)
3091 (defun message-insert-signature (&optional force)
3092 "Insert a signature. See documentation for variable `message-signature'."
3096 ((and (null message-signature)
3100 (not (re-search-backward message-signature-separator nil t))))
3101 ((and (null message-signature)
3104 ((functionp message-signature)
3105 (funcall message-signature))
3106 ((listp message-signature)
3107 (eval message-signature))
3108 (t message-signature)))
3113 message-signature-file
3114 (file-exists-p message-signature-file))
3121 (when message-signature-insert-empty-line
3125 (insert-file-contents message-signature-file)
3130 (defun message-insert-importance-high ()
3131 "Insert header to mark message as important."
3135 (message-narrow-to-headers)
3136 (message-remove-header "Importance"))
3137 (message-goto-eoh)
3140 (defun message-insert-importance-low ()
3141 "Insert header to mark message as unimportant."
3145 (message-narrow-to-headers)
3146 (message-remove-header "Importance"))
3147 (message-goto-eoh)
3150 (defun message-insert-or-toggle-importance ()
3151 "Insert a \"Importance: high\" header, or cycle through the header values.
3160 (message-narrow-to-headers)
3161 (when (setq cur (message-fetch-field "Importance"))
3162 (message-remove-header "Importance")
3169 (message-goto-eoh)
3172 (defun message-insert-disposition-notification-to ()
3173 "Request a disposition notification (return receipt) to this message.
3178 (message-narrow-to-headers)
3179 (message-remove-header "Disposition-Notification-To"))
3180 (message-goto-eoh)
3182 (or (message-field-value "Reply-to")
3183 (message-field-value "From")
3184 (message-make-from))))))
3186 (defun message-elide-region (b e)
3188 An ellipsis (from `message-elide-ellipsis') will be inserted where the
3192 (insert message-elide-ellipsis))
3194 (defvar message-caesar-translation-table nil)
3196 (defun message-caesar-region (b e &optional n)
3209 (when (or (not message-caesar-translation-table)
3210 (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
3211 (setq message-caesar-translation-table
3212 (message-make-caesar-translation-table n)))
3213 (translate-region b e message-caesar-translation-table)))
3215 (defun message-make-caesar-translation-table (n)
3230 (defun message-caesar-buffer-body (&optional rotnum)
3240 (when (message-goto-body)
3242 (message-caesar-region (point-min) (point-max) rotnum))))
3244 (defun message-pipe-buffer-body (program)
3245 "Pipe the message body in the current buffer through PROGRAM."
3248 (when (message-goto-body)
3253 (defun message-rename-buffer (&optional enter-string)
3254 "Rename the *message* buffer to \"*message* RECIPIENT\".
3262 (search-forward mail-header-separator nil 'end))
3263 (let* ((mail-to (or
3264 (if (message-news-p) (message-fetch-field "Newsgroups")
3265 (message-fetch-field "To"))
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))
3277 (defun message-fill-yanked-message (&optional justifyp)
3278 "Fill the paragraphs of a message yanked into this one.
3283 (search-forward (concat "\n" mail-header-separator "\n") nil t)
3284 (let ((fill-prefix message-yank-prefix))
3287 (defun message-indent-citation ()
3288 "Modify text just inserted from a message to be cited.
3292 Normally, indent each nonblank line `message-indentation-spaces' spaces.
3293 However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
3296 (when message-ignored-cited-headers
3304 (message-remove-header message-ignored-cited-headers t)
3315 (message-delete-line))
3322 (message-delete-line))
3324 (if (null message-yank-prefix)
3325 (indent-rigidly start (mark t) message-indentation-spaces)
3330 (insert message-yank-cited-prefix)
3331 (insert message-yank-prefix))
3335 (defun message-yank-original (&optional arg)
3336 "Insert the message being replied to, if any.
3339 if `message-yank-prefix' is non-nil, insert that prefix on each line.
3341 This function uses `message-cite-function' to do the actual citing.
3347 (when (and message-reply-buffer
3348 message-cite-function)
3349 (delete-windows-on message-reply-buffer t)
3351 (insert-buffer-substring message-reply-buffer)
3356 (funcall message-cite-function)
3363 (setq message-checksum (message-checksum))))))
3365 (defun message-yank-buffer (buffer)
3368 (let ((message-reply-buffer (get-buffer buffer)))
3370 (message-yank-original))))
3372 (defun message-buffers ()
3373 "Return a list of active message buffers."
3378 (when (and (eq major-mode 'message-mode)
3379 (null message-sent-message-via))
3383 (defun message-cite-original-without-signature ()
3388 (when message-indent-citation-function
3389 (if (listp message-indent-citation-function)
3390 message-indent-citation-function
3391 (list message-indent-citation-function))))
3392 ;; This function may be called by `gnus-summary-yank-message' and
3394 ;; modify the value of `message-reply-headers' with that article.
3395 (message-reply-headers
3398 (message-narrow-to-head-1)
3400 (or (message-fetch-field "subject") "none")
3401 (or (message-fetch-field "from") "nobody")
3402 (message-fetch-field "date")
3403 (message-fetch-field "message-id" t)
3404 (message-fetch-field "references")
3410 (when (re-search-backward message-signature-separator start t)
3423 (when message-citation-line-function
3426 (funcall message-citation-line-function))))
3428 (eval-when-compile (defvar mail-citation-hook)) ;Compiler directive
3429 (defun message-cite-original ()
3431 (if (and (boundp 'mail-citation-hook)
3432 mail-citation-hook)
3433 (run-hooks 'mail-citation-hook)
3437 (when message-indent-citation-function
3438 (if (listp message-indent-citation-function)
3439 message-indent-citation-function
3440 (list message-indent-citation-function))))
3441 ;; This function may be called by `gnus-summary-yank-message' and
3443 ;; modify the value of `message-reply-headers' with that article.
3444 (message-reply-headers
3447 (message-narrow-to-head-1)
3449 (or (message-fetch-field "subject") "none")
3450 (or (message-fetch-field "from") "nobody")
3451 (message-fetch-field "date")
3452 (message-fetch-field "message-id" t)
3453 (message-fetch-field "references")
3459 (when message-citation-line-function
3462 (funcall message-citation-line-function)))))
3464 (defun message-insert-citation-line ()
3466 (when message-reply-headers
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")
3499 (defun message-remove-signature ()
3505 (if (not (re-search-forward message-signature-separator (mark t) t))
3507 (message-indent-citation)
3515 (message-indent-citation)
3528 (defun message-send-and-exit (&optional arg)
3529 "Send message like `message-send', then, if no errors, exit from mail buffer."
3532 (actions message-exit-actions))
3533 (when (and (message-send arg)
3535 (if message-kill-buffer-on-exit
3539 (message-bury buf)))
3540 (message-do-actions actions)
3543 (defun message-dont-send ()
3544 "Don't send the message you have been editing.
3549 (let ((actions message-postpone-actions))
3550 (message-bury (current-buffer))
3551 (message-do-actions actions)))
3553 (defun message-kill-buffer ()
3558 (let ((actions message-kill-actions)
3559 (draft-article message-draft-article)
3570 ;; If the message buffer has lived in a dedicated window,
3580 (let ((message-draft-article draft-article))
3581 (message-disassociate-draft)))
3582 (message-do-actions actions))))
3584 (defun message-bury (buffer)
3585 "Bury this mail BUFFER."
3593 (defun message-send (&optional arg)
3594 "Send the message in the current buffer.
3595 If `message-interactive' is non-nil, wait for success indication or
3597 Otherwise any failure is reported in a message back to the user from
3606 (message-fix-before-sending)
3607 (run-hooks 'message-send-hook)
3608 (message message-sending-message)
3609 (let ((alist message-send-method-alist)
3612 (message-options message-options))
3613 (message-options-set-recipient)
3618 message-sent-message-via))
3619 (message-fetch-field "supersedes")
3620 (if (or (message-gnksa-enable-p 'multiple-copies)
3624 "Already sent message via %s; resend? "
3631 (let ((fcc (message-fetch-field "Fcc"))
3632 (gcc (message-fetch-field "Gcc")))
3634 (or (eq message-allow-no-recipients 'always)
3635 (and (not (eq message-allow-no-recipients 'never))
3645 (message-do-fcc)
3647 (run-hooks 'message-sent-hook))
3648 (message "Sending...done")
3652 (message-disassociate-draft)
3653 ;; Delete other mail buffers and stuff.
3654 (message-do-send-housekeeping)
3655 (message-do-actions message-send-actions)
3659 (defun message-send-via-mail (arg)
3660 "Send the current message via mail."
3661 (message-send-mail arg))
3663 (defun message-send-via-news (arg)
3664 "Send the current message via news."
3665 (funcall message-send-news-function arg))
3667 (defmacro message-check (type &rest forms)
3669 `(or (message-check-element ,type)
3673 (put 'message-check 'lisp-indent-function 1)
3674 (put 'message-check 'edebug-form-spec '(form body))
3676 (defun message-text-with-property (prop)
3687 (defun message-fix-before-sending ()
3688 "Do various things to make the message nice before sending it."
3689 ;; Make sure there's a newline at the end of the message.
3694 (let ((points (message-text-with-property 'message-hidden)))
3703 (message-check 'invisible-text
3704 (let ((points (message-text-with-property 'invisible)))
3709 (message-overlay-put (message-make-overlay point (1+ point))
3714 (message-check 'illegible-text
3716 (message-goto-body)
3727 (message-overlay-put (message-make-overlay (point) (1+ (point)))
3739 message-replacement-char))
3744 (message-goto-body)
3759 (message-kill-all-overlays)
3762 (insert message-replacement-char))))
3766 (defun message-add-action (action &rest types)
3769 (add-to-list (intern (format "message-%s-actions" (pop types)))
3772 (defun message-delete-action (action &rest types)
3776 (set (setq var (intern (format "message-%s-actions" (pop types))))
3779 (defun message-do-actions (actions)
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)
3802 (tembuf (message-generate-new-buffer-clone-locals " message temp"))
3804 (id (message-make-message-id)) (n 1)
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))
3811 (if (<= (point) p) (forward-line 1))) ;; In case of bad message.
3825 (if header
3829 (insert header))
3830 (message-goto-eoh)
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)))
3844 (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n"
3845 id n total))
3847 (let ((mail-header-separator ""))
3848 (when (memq 'Message-ID message-required-mail-headers)
3849 (insert "Message-ID: " (message-make-message-id) "\n"))
3850 (when (memq 'Lines message-required-mail-headers)
3851 (insert "Lines: " (message-make-lines) "\n"))
3852 (message-goto-subject)
3857 (funcall (or message-send-mail-real-function
3858 message-send-mail-function))))
3864 (defun message-send-mail (&optional arg)
3865 (require 'mail-utils)
3866 (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
3868 (news (message-news-p))
3870 (message-this-is-mail t)
3871 (message-posting-charset
3874 message-posting-charset))
3875 (headers message-required-mail-headers))
3877 (message-narrow-to-headers)
3878 ;; Generate the Mail-Followup-To header if the header is not there...
3879 (if (and (message-subscribed-p)
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:")))
3889 (let ((message-deletable-headers
3890 (if news nil message-deletable-headers)))
3891 (message-generate-headers headers))
3893 (message-check 'continuation-headers
3901 (error "Failed to send the message")))))
3903 (run-hooks 'message-header-hook))
3913 (message-encode-message-body)
3915 (message-narrow-to-headers)
3916 ;; We (re)generate the Lines header.
3917 (when (memq 'Lines message-required-mail-headers)
3918 (message-generate-headers '(Lines)))
3920 (message-remove-header message-ignored-mail-headers t)
3921 (let ((mail-parse-charset message-default-charset))
3922 (mail-encode-encoded-word-buffer)))
3927 (message-cleanup-headers)
3933 (message-narrow-to-headers)
3935 (or (message-fetch-field "cc")
3936 (message-fetch-field "bcc")
3937 (message-fetch-field "to"))
3938 (let ((content-type (message-fetch-field
3945 (mail-header-parse-content-type
3949 (message-fetch-field
3951 (message-insert-courtesy-copy))
3952 (if (or (not message-send-mail-partially-limit)
3953 (< (buffer-size) message-send-mail-partially-limit)
3954 (not (message-y-or-n-p
3955 "The message size is too large, split? "
3958 The message size, "
3961 Some mail gateways (MTA's) bounce large messages. To avoid the
3962 problem, answer `y', and the message will be split into several
3964 (/ message-send-mail-partially-limit 1000)
3968 However, some mail readers (MUA's) can't read split messages, i.e.,
3969 mails in message/partially format. Answer `n', and the message will be
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 ()
3987 (let ((errbuf (if message-interactive
3988 (message-generate-new-buffer-clone-locals
3996 (message-narrow-to-headers)
3997 (setq resend-to-addresses (message-fetch-field "resent-to")))
3998 ;; Change header-delimiter to be what sendmail expects.
4001 (concat "^" (regexp-quote mail-header-separator) "\n"))
4005 (run-hooks 'message-send-mail-hook)
4009 (when (eval message-mailer-swallows-blank-line)
4011 (when message-interactive
4016 (coding-system-for-write message-send-coding-system)
4035 (if (null message-sendmail-f-is-evil)
4036 (list "-f" (message-sendmail-envelope-from)))
4037 ;; These mean "report errors by mail"
4039 (if (null message-interactive) '("-oem" "-odb"))
4040 ;; Get the addresses from the message
4050 (when message-interactive
4062 (defun message-send-mail-with-qmail ()
4063 "Pass the prepared message buffer to qmail-inject.
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)
4072 ;; send the message
4074 (let ((coding-system-for-write message-send-coding-system))
4077 message-qmail-inject-program nil nil nil
4083 ;; reading a formatted (i. e., at least a To: or Resent-To header)
4084 ;; message from stdin.
4088 ;; compare this with message-send-mail-with-sendmail and weep
4095 (if (functionp message-qmail-inject-args)
4096 (funcall message-qmail-inject-args)
4097 message-qmail-inject-args)))
4106 (defun message-send-mail-with-mh ()
4107 "Send the prepared message buffer with mh."
4112 (when message-mh-deletable-headers
4113 (let ((headers message-mh-deletable-headers))
4118 (message-delete-line))
4120 (run-hooks 'message-send-mail-hook)
4124 (defun message-smtpmail-send-it ()
4125 "Send the prepared message buffer with `smtpmail-send-it'.
4127 `message-send-mail-hook' just before sending a message. It is useful
4130 (run-hooks 'message-send-mail-hook)
4133 (defun message-canlock-generate ()
4138 (sha1 (concat (message-unique-id)
4143 (defun message-canlock-password ()
4144 "The password used by message for cancel locks.
4148 (customize-save-variable 'canlock-password (message-canlock-generate))
4152 (defun message-insert-canlock ()
4153 (when message-insert-canlock
4154 (message-canlock-password)
4155 (canlock-insert-header)))
4157 (defun message-send-news (&optional arg)
4158 (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
4160 (method (if (functionp message-post-method)
4161 (funcall message-post-method arg)
4162 message-post-method))
4164 (message-narrow-to-headers-or-head)
4165 (message-fetch-field "Newsgroups")))
4167 (message-narrow-to-headers-or-head)
4168 (message-fetch-field "Followup-To")))
4177 (rfc2047-header-encoding-alist
4182 rfc2047-header-encoding-alist))
4184 (message-syntax-checks
4186 (listp message-syntax-checks))
4188 message-syntax-checks)
4189 message-syntax-checks))
4190 (message-this-is-news t)
4191 (message-posting-charset
4194 (if (not (message-check-news-body-syntax))
4197 (message-narrow-to-headers)
4199 (message-generate-headers message-required-news-headers)
4200 (message-insert-canlock)
4202 (run-hooks 'message-header-hook))
4206 (listp message-syntax-checks))
4207 (setq message-syntax-checks
4209 message-syntax-checks)))
4210 (message-cleanup-headers)
4211 (if (not (let ((message-post-method method))
4212 (message-check-news-syntax)))
4224 (message-encode-message-body)
4227 (message-narrow-to-headers)
4228 ;; We (re)generate the Lines header.
4229 (when (memq 'Lines message-required-mail-headers)
4230 (message-generate-headers '(Lines)))
4232 (message-remove-header message-ignored-news-headers t)
4233 (let ((mail-parse-charset message-default-charset))
4234 (mail-encode-encoded-word-buffer)))
4243 (concat "^" (regexp-quote mail-header-separator) "\n"))
4246 (run-hooks 'message-send-news-hook)
4248 (message "Sending news via %s..." (gnus-server-string method))
4249 (setq result (let ((mail-header-separator ""))
4254 (push 'news message-sent-message-via)
4255 (message "Couldn't send message via news: %s"
4263 (defun message-check-element (type)
4265 (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
4267 (let ((able (assq type message-syntax-checks)))
4271 (defun message-check-news-syntax ()
4272 "Check the syntax of the message."
4279 (message-narrow-to-headers)
4280 (message-check-news-header-syntax))))))
4282 (defun message-check-news-header-syntax ()
4284 ;; Check Newsgroups header.
4285 (message-check 'newsgroups
4286 (let ((group (message-fetch-field "newsgroups")))
4291 (message
4293 ;; Check the Subject header.
4294 (message-check 'subject
4296 (subject (message-fetch-field "subject")))
4301 (message
4304 (message-check 'subject-cmsg
4305 (if (string-match "^cmsg " (message-fetch-field "subject"))
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))
4328 (message-check 'multiple-headers
4346 (message-check 'sendsys
4354 (message-check 'shorten-followup-to
4355 (let ((newsgroups (message-fetch-field "newsgroups"))
4356 (followup-to (message-fetch-field "followup-to"))
4365 "Followups to (default no Followup-To header): "
4368 (message-tokenize-header
4374 (message-check 'shoot
4376 "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t)
4380 (message-check 'approved
4382 (y-or-n-p "The article contains an Approved header. Really post? ")
4384 ;; Check the Message-ID header.
4385 (message-check 'message-id
4387 (message-id (message-fetch-field "message-id" t)))
4388 (or (not message-id)
4390 (and (string-match "@" message-id)
4392 (string-match "@[^.]*\\." message-id)
4394 (not (string-match "\\.>" message-id)))
4397 message-id)))))
4399 (message-check 'existing-newsgroups
4401 (newsgroups (message-fetch-field "newsgroups"))
4402 (followup-to (message-fetch-field "followup-to"))
4403 (groups (message-tokenize-header
4407 (post-method (if (functionp message-post-method)
4408 (funcall message-post-method)
4409 message-post-method))
4415 gnus-message-group-art)
4417 (car gnus-message-group-art)
4418 (cdr gnus-message-group-art)))))
4462 (message-check 'continuation-headers
4474 (message-check 'valid-newsgroups
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)))))
4498 (message-check 'repeated-newsgroups
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.
4515 (message-check 'from
4517 (from (message-fetch-field "from"))
4521 (message "There is no From line. Posting is denied.")
4525 (setq ad (nth 1 (mail-extract-address-components
4532 (message
4540 (message
4544 ;; Check the Reply-To header.
4545 (message-check 'reply-to
4547 (reply-to (message-fetch-field "reply-to"))
4558 (setq ad (nth 1 (mail-extract-address-components
4571 (defun message-check-news-body-syntax ()
4574 (message-check 'long-lines
4577 (concat "^" (regexp-quote mail-header-separator) "$"))
4591 (message-check 'empty
4594 (concat "^" (regexp-quote mail-header-separator) "$"))
4598 (re-search-backward message-signature-separator nil t)
4601 (if (message-gnksa-enable-p 'empty-article)
4603 (message "Denied posting -- Empty article.")
4606 (message-check 'control-chars
4614 (message-check 'size
4621 (message-check 'new-text
4623 (not message-checksum)
4624 (not (eq (message-checksum) message-checksum))
4625 (if (message-gnksa-enable-p 'quoted-text-only)
4628 (message "Denied posting -- no new text has been added.")
4631 (message-check 'signature
4640 (message-check 'quoting-style
4647 (if (message-gnksa-enable-p 'quoted-text-only)
4652 (concat "^" (regexp-quote mail-header-separator) "$"))
4655 (message "Denied posting -- only quoted text.")
4658 (defun message-checksum ()
4664 (concat "^" (regexp-quote mail-header-separator) "$"))
4672 (defun message-do-fcc ()
4677 (mml-externalize-attachments message-fcc-externalize-attachments))
4680 (message-narrow-to-headers)
4681 (setq file (message-fetch-field "fcc" t)))
4683 (set-buffer (get-buffer-create " *message temp*"))
4686 (message-encode-message-body)
4688 (message-narrow-to-headers)
4689 (while (setq file (message-fetch-field "fcc" t))
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) "$")
4714 (if (and message-fcc-handler-function
4715 (not (eq message-fcc-handler-function 'rmail-output)))
4716 (funcall message-fcc-handler-function file)
4717 (if (and (file-readable-p file) (mail-file-babyl-p file))
4719 (let ((mail-use-rfc822 t))
4723 (defun message-output (filename)
4724 "Append this article to Unix/babyl mail file FILENAME."
4726 (mail-file-babyl-p filename))
4728 (gnus-output-to-mail filename t)))
4730 (defun message-cleanup-headers ()
4732 ;; Remove empty lines in the header.
4734 (message-narrow-to-headers)
4763 (defun message-make-date (&optional now)
4764 "Make a valid data header.
4786 (defun message-make-message-id ()
4788 (concat "<" (message-unique-id)
4789 (let ((psubject (save-excursion (message-fetch-field "subject")))
4791 (save-excursion (message-fetch-field "supersedes"))))
4793 (and message-reply-headers
4794 (mail-header-references message-reply-headers)
4795 (mail-header-subject message-reply-headers)
4798 (message-strip-subject-re
4799 (mail-header-subject message-reply-headers))
4800 (message-strip-subject-re psubject))))
4804 "@" (message-make-fqdn) ">"))
4806 (defvar message-unique-id-char nil)
4812 (defun message-unique-id ()
4815 (setq message-unique-id-char
4816 (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20)))))
4823 ;; message-number-base36 doesn't handle bigints.
4829 (message-number-base36 (user-uid) -1))
4830 (message-number-base36 (+ (car tm)
4831 (lsh (% message-unique-id-char 25) 16)) 4)
4832 (message-number-base36 (+ (nth 1 tm)
4833 (lsh (/ message-unique-id-char 25) 16)) 4)
4839 (defun message-number-base36 (num len)
4844 (concat (message-number-base36 (/ num 36) (1- len))
4848 (defun message-make-organization ()
4849 "Make an Organization header."
4851 (when message-user-organization
4852 (if (functionp message-user-organization)
4853 (funcall message-user-organization)
4854 message-user-organization))))
4860 message-user-organization-file
4861 (file-exists-p message-user-organization-file))
4862 (insert-file-contents message-user-organization-file)))
4869 (defun message-make-lines ()
4874 (message-goto-body)
4877 (defun message-make-references ()
4878 "Return the References header for this message."
4879 (when message-reply-headers
4880 (let ((message-id (mail-header-message-id message-reply-headers))
4881 (references (mail-header-references message-reply-headers))
4883 (if (or references message-id)
4885 (or message-id ""))
4888 (defun message-make-in-reply-to ()
4889 "Return the In-Reply-To header for this message."
4890 (when message-reply-headers
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)))
4897 msg-id (if msg-id " (")
4918 "'s message of \""
4921 "\"" (if msg-id ")")))))))
4923 (defun message-make-distribution ()
4924 "Make a Distribution header."
4925 (let ((orig-distribution (message-fetch-reply-field "distribution")))
4926 (cond ((functionp message-distribution-function)
4927 (funcall message-distribution-function))
4930 (defun message-make-expires ()
4931 "Return an Expires header based on `message-expires'."
4933 (future (* 1.0 message-expires 60 60 24)))
4937 (message-make-date current)))
4939 (defun message-make-path ()
4942 (cond ((null message-user-path)
4944 ((stringp message-user-path)
4946 (concat message-user-path "!" login-name))
4949 (defun message-make-from ()
4950 "Make a From header."
4951 (let* ((style message-from-style)
4952 (login (message-make-address))
5008 (defun message-make-sender ()
5014 (defun message-make-address ()
5016 (or (message-user-mail-address)
5017 (concat (user-login-name) "@" (message-make-domain))))
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)))
5027 (defun message-sendmail-envelope-from ()
5029 (cond ((eq message-sendmail-envelope-from 'header)
5030 (nth 1 (mail-extract-address-components
5031 (message-fetch-field "from"))))
5032 ((stringp message-sendmail-envelope-from)
5033 message-sendmail-envelope-from)
5035 (message-make-address))))
5037 (defun message-make-fqdn ()
5040 (user-mail (message-user-mail-address))
5042 (if (and user-mail
5043 (string-match "@\\(.*\\)\\'" user-mail))
5044 (match-string 1 user-mail)))
5047 ((and message-user-fqdn
5048 (stringp message-user-fqdn)
5049 (string-match message-valid-fqdn-regexp message-user-fqdn)
5050 (not (string-match message-bogus-system-names message-user-fqdn)))
5051 ;; `message-user-fqdn' seems to be valid
5052 message-user-fqdn)
5053 ((and (string-match message-valid-fqdn-regexp system-name)
5054 (not (string-match message-bogus-system-names system-name)))
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.
5066 (string-match message-valid-fqdn-regexp user-domain)
5067 (not (string-match message-bogus-system-names user-domain)))
5072 ".i-did-not-set--mail-host-address--so-tickle-me")))))
5074 (defun message-make-host-name ()
5076 (let ((fqdn (message-make-fqdn)))
5080 (defun message-make-domain ()
5082 (or mail-host-address
5083 (message-make-fqdn)))
5085 (defun message-to-list-only ()
5086 "Send a message to the list only.
5089 (let ((listaddr (message-make-mail-followup-to t)))
5092 (message-remove-header "to")
5093 (message-remove-header "cc")
5094 (message-position-on-field "To" "X-Draft-From")
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)."
5102 (to (message-fetch-field "To"))
5103 (cc (message-fetch-field "cc"))
5106 (mapcar 'mail-strip-quoted-names
5107 (message-tokenize-header msg-recipients)))
5109 (if message-subscribed-address-file
5113 (insert-file-contents message-subscribed-address-file)
5123 (mft-regexps (apply 'append message-subscribed-regexps
5125 message-subscribed-addresses)
5128 message-subscribed-address-functions))))
5141 (defun message-idna-to-ascii-rhs-1 (header)
5143 (let ((field (message-fetch-field header))
5151 'car (mail-header-parse-addresses field))))))
5154 (or (not (eq message-use-idna 'ask))
5156 rhs ace header))))
5158 (while (re-search-forward (concat "^" header ":") nil t)
5159 (message-narrow-to-field)
5165 (defun message-idna-to-ascii-rhs ()
5167 See `message-idna-encode'."
5169 (when message-use-idna
5172 (message-narrow-to-head)
5173 (message-idna-to-ascii-rhs-1 "From")
5174 (message-idna-to-ascii-rhs-1 "To")
5175 (message-idna-to-ascii-rhs-1 "Reply-To")
5176 (message-idna-to-ascii-rhs-1 "Mail-Reply-To")
5177 (message-idna-to-ascii-rhs-1 "Mail-Followup-To")
5178 (message-idna-to-ascii-rhs-1 "Cc")))))
5180 (defun message-generate-headers (headers)
5183 (setq headers (append headers message-required-headers))
5185 (message-narrow-to-headers)
5186 (let* ((Date (message-make-date))
5187 (Message-ID (message-make-message-id))
5188 (Organization (message-make-organization))
5189 (From (message-make-from))
5190 (Path (message-make-path))
5193 (In-Reply-To (message-make-in-reply-to))
5194 (References (message-make-references))
5196 (Distribution (message-make-distribution))
5197 (Lines (message-make-lines))
5198 (User-Agent message-newsreader)
5199 (Expires (message-make-expires))
5202 header value elem header-string)
5204 (let ((headers message-deletable-headers))
5211 (get-text-property (1+ (match-beginning 0)) 'message-deletable)
5212 (message-delete-line))
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))
5269 ((not (message-check-element
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)
5306 '(message-deletable t face italic) (current-buffer)))))))
5308 (let ((from (message-fetch-field "from"))
5309 (sender (message-fetch-field "sender"))
5310 (secure-sender (message-make-sender)))
5312 (not (message-check-element 'sender))
5315 (cadr (mail-extract-address-components from)))
5321 (cadr (mail-extract-address-components sender)))
5329 (when (or (message-news-p)
5333 (message-idna-to-ascii-rhs))))
5335 (defun message-insert-courtesy-copy ()
5336 "Insert a courtesy message in mail copies of combined messages."
5340 (message-narrow-to-headers)
5341 (when (setq newsgroups (message-fetch-field "newsgroups"))
5345 (when message-courtesy-message
5347 ((string-match "%s" message-courtesy-message)
5348 (insert (format message-courtesy-message newsgroups)))
5350 (insert message-courtesy-message)))))))
5353 ;;; Setting up a message buffer
5356 (defun message-fill-address (header value)
5359 (insert (capitalize (symbol-name header))
5386 (defun message-split-line ()
5388 If the current line has `message-yank-prefix', insert it on the new line."
5391 (split-line message-yank-prefix) ;; Emacs 22.1+ supports arg.
5395 (defun message-fill-header (header value)
5399 (insert (capitalize (symbol-name header))
5409 (message-delete-line))
5416 (defun message-shorten-1 (list cut surplus)
5421 (defun message-shorten-references (header references)
5443 (message-shorten-1 refs cut surplus)
5450 ;; have not been generated, thus we use message-this-is-news directly.
5451 (when (and message-this-is-news message-cater-to-broken-inn)
5464 (message-shorten-1 refs cut surplus))))
5469 (if (and message-this-is-news message-cater-to-broken-inn)
5470 (insert (capitalize (symbol-name header)) ": "
5472 (message-fill-header header refstring)))))
5474 (defun message-position-point ()
5476 (message-narrow-to-headers)
5493 (defcustom message-beginning-of-line t
5494 "Whether \\<message-mode-map>\\[message-beginning-of-line]\
5495 goes to beginning of header values."
5497 :group 'message-buffers
5498 :link '(custom-manual "(message)Movement")
5501 (defun message-beginning-of-line (&optional n)
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
5518 (if (and message-beginning-of-line
5519 (message-point-in-header-p))
5529 (defun message-buffer-name (type &optional to group)
5533 ((memq message-generate-new-buffers '(unique t))
5538 (or (car (mail-extract-address-components to))
5543 ;; Check whether `message-generate-new-buffers' is a function,
5545 ((functionp message-generate-new-buffers)
5546 (funcall message-generate-new-buffers type to group))
5547 ((eq message-generate-new-buffers 'unsent)
5552 (or (car (mail-extract-address-components to))
5557 ;; Search for the existing message buffer with the specified name.
5559 (let* ((new (if (eq message-generate-new-buffers 'standard)
5560 (generate-new-buffer-name (concat "*" type " message*"))
5561 (let ((message-generate-new-buffers 'unique))
5562 (message-buffer-name type to group))))
5578 'message-mode))
5585 (defun message-pop-to-buffer (name &optional switch-function)
5592 ;; Raise the frame already displaying the message buffer.
5602 (message nil))))
5607 (message-mode)))
5609 (defun message-do-send-housekeeping ()
5610 "Kill old message buffers."
5613 (setq message-buffer-list (delq (current-buffer) message-buffer-list))
5614 (while (and message-max-buffers
5615 message-buffer-list
5616 (>= (length message-buffer-list) message-max-buffers))
5618 (let ((buffer (pop message-buffer-list)))
5623 (if message-send-rename-function
5624 (funcall message-send-rename-function)
5625 ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus.
5627 "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to "
5632 (string-equal name "mail")
5635 (message-narrow-to-headers)
5636 (setq to (message-fetch-field "to"))
5637 (setq group (message-fetch-field "newsgroups"))
5641 (to (concat "*sent mail to "
5642 (or (car (mail-extract-address-components to))
5646 (t "*sent mail*"))))
5650 (when message-max-buffers
5651 (setq message-buffer-list
5652 (nconc message-buffer-list (list (current-buffer))))))
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))))
5659 (if (memq mua '(message-user-agent gnus-user-agent))
5663 (defun message-setup (headers &optional replybuffer actions
5665 (let ((mua (message-mail-user-agent))
5667 (if (not (and message-this-is-mail mua))
5668 (message-setup-1 headers replybuffer actions)
5680 (let ((mail-user-agent mua))
5681 (compose-mail to subject
5689 (defun message-headers-to-generate (headers included-headers excluded-headers)
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)))
5714 (defun message-setup-1 (headers &optional replybuffer actions)
5717 (add-to-list 'message-send-actions
5719 (setq message-reply-buffer replybuffer)
5722 (mail-header-format
5724 (alist message-header-format-alist))
5726 (unless (assq (caar h) message-header-format-alist)
5732 (when message-default-headers
5733 (insert message-default-headers)
5738 (insert mail-header-separator "\n")
5742 (when (message-news-p)
5743 (when message-default-news-headers
5744 (insert message-default-news-headers)
5746 (when message-generate-headers-first
5747 (message-generate-headers
5748 (message-headers-to-generate
5749 (append message-required-news-headers
5750 message-required-headers)
5751 message-generate-headers-first
5753 (when (message-mail-p)
5754 (when message-default-mail-headers
5755 (insert message-default-mail-headers)
5757 (when message-generate-headers-first
5758 (message-generate-headers
5759 (message-headers-to-generate
5760 (append message-required-mail-headers
5761 message-required-headers)
5762 message-generate-headers-first
5764 (run-hooks 'message-signature-setup-hook)
5765 (message-insert-signature)
5767 (message-narrow-to-headers)
5768 (run-hooks 'message-header-setup-hook))
5771 (run-hooks 'message-setup-hook)
5773 (when (message-mail-p)
5775 (message-narrow-to-headers)
5776 (if message-alternative-emails
5777 (message-use-alternative-email-as-from))))
5778 (message-position-point)
5781 (defun message-set-auto-save-file-name ()
5782 "Associate the message buffer with a file in the drafts directory."
5783 (when message-auto-save-directory
5785 (directory-file-name message-auto-save-directory))
5786 (make-directory message-auto-save-directory t))
5788 (setq message-draft-article
5795 "message"
5796 "*message*")
5797 message-auto-save-directory))
5800 (setq buffer-file-coding-system message-draft-coding-system)))
5802 (defun message-disassociate-draft ()
5803 "Disassociate the message buffer from the drafts directory."
5804 (when message-draft-article
5806 (list message-draft-article) "drafts" nil t)))
5808 (defun message-insert-headers ()
5813 (message-narrow-to-headers)
5814 (when (message-news-p)
5815 (message-generate-headers
5818 (copy-sequence message-required-news-headers)))))
5819 (when (message-mail-p)
5820 (message-generate-headers
5823 (copy-sequence message-required-mail-headers))))))))
5829 ;;; Commands for interfacing with message
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
5838 to continue editing a message already being composed. SWITCH-FUNCTION
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)
5843 (message-pop-to-buffer
5844 ;; Search for the existing message buffer if `continue' is non-nil.
5845 (let ((message-generate-new-buffers
5847 (eq message-generate-new-buffers 'standard)
5848 (functionp message-generate-new-buffers))
5849 message-generate-new-buffers)))
5850 (message-buffer-name "mail" to))
5852 ;; FIXME: message-mail should do something if YANK-ACTION is not
5856 (message-setup
5865 (defun message-news (&optional newsgroups subject)
5868 (let ((message-this-is-news t))
5869 (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))
5870 (message-setup `((Newsgroups . ,(or newsgroups ""))
5873 (defun message-get-reply-headers (wide &optional to-address address-headers)
5877 (message-narrow-to-headers-or-head)
5879 ;; message-header-synonyms.
5880 (setq to (or (message-fetch-field "to")
5881 (and (loop for synonym in message-header-synonyms
5884 (message-fetch-field "original-to")))
5885 cc (message-fetch-field "cc")
5886 mct (message-fetch-field "mail-copies-to")
5887 author (or (message-fetch-field "mail-reply-to")
5888 (message-fetch-field "reply-to")
5889 (message-fetch-field "from")
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))
5917 (message-y-or-n-p "Obey Mail-Followup-To? " t "\
5918 You should normally obey the Mail-Followup-To: header. In this
5931 If a message is posted to several mailing lists, Mail-Followup-To may
5939 You may customize the variable `message-use-mail-followup-to', if you
5958 (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
5967 (cons (downcase (mail-strip-quoted-names addr)) addr))
5968 (message-tokenize-header recipients)))
5975 ;; if message-hierarchical-addresses is defined.
5976 (when message-hierarchical-addresses
5981 message-hierarchical-addresses)
5991 ;; Build the header alist. Allow the user to be asked whether
5995 (or (not message-wide-reply-confirm-recipients)
6004 (defcustom message-simplify-subject-functions
6005 '(message-strip-list-identifiers
6006 message-strip-subject-re
6007 message-strip-subject-trailing-was
6008 message-strip-subject-encoded-words)
6010 The functions are applied when replying to a message.
6013 `message-strip-list-identifiers', `message-strip-subject-re',
6014 `message-strip-subject-trailing-was', and
6015 `message-strip-subject-encoded-words'."
6017 :group 'message-various
6020 (defun message-simplify-subject (subject &optional functions)
6024 (setq functions message-simplify-subject-functions))
6025 (when (and (memq 'message-strip-list-identifiers functions)
6027 (setq subject (message-strip-list-identifiers subject)))
6028 (when (memq 'message-strip-subject-re functions)
6029 (setq subject (concat "Re: " (message-strip-subject-re subject))))
6030 (when (and (memq 'message-strip-subject-trailing-was functions)
6031 message-subject-trailing-was-query)
6032 (setq subject (message-strip-subject-trailing-was subject)))
6033 (when (memq 'message-strip-subject-encoded-words functions)
6034 (setq subject (message-strip-subject-encoded-words subject)))
6038 (defun message-reply (&optional to-address wide)
6044 references message-id follow-to
6046 (message-this-is-mail t)
6049 (message-narrow-to-head-1)
6053 (when (functionp message-reply-to-function)
6055 (setq follow-to (funcall message-reply-to-function))))
6057 (when (functionp message-wide-reply-to-function)
6060 (funcall message-wide-reply-to-function)))))
6061 (setq message-id (message-fetch-field "message-id" t)
6062 references (message-fetch-field "references")
6063 date (message-fetch-field "date")
6064 from (or (message-fetch-field "from") "nobody")
6065 subject (or (message-fetch-field "subject") "none"))
6068 (setq subject (message-simplify-subject subject))
6070 (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
6072 (setq message-id (match-string 0 gnus-warning)))
6075 (setq follow-to (message-get-reply-headers wide to-address))))
6077 (unless (message-mail-user-agent)
6078 (message-pop-to-buffer
6079 (message-buffer-name
6083 (setq message-reply-headers
6084 (vector 0 subject from date message-id references 0 0 ""))
6086 (message-setup
6092 (defun message-wide-reply (&optional to-address)
6093 "Make a \"wide\" reply to the message in the current buffer."
6095 (message-reply to-address t))
6098 (defun message-followup (&optional to-newsgroups)
6099 "Follow up to the message in the current buffer.
6105 references message-id follow-to
6107 (message-this-is-news t)
6115 (when (functionp message-followup-to-function)
6117 (funcall message-followup-to-function)))
6118 (setq from (message-fetch-field "from")
6119 date (message-fetch-field "date")
6120 subject (or (message-fetch-field "subject") "none")
6121 references (message-fetch-field "references")
6122 message-id (message-fetch-field "message-id" t)
6123 followup-to (message-fetch-field "followup-to")
6124 newsgroups (message-fetch-field "newsgroups")
6125 posted-to (message-fetch-field "posted-to")
6126 reply-to (message-fetch-field "reply-to")
6127 mrt (message-fetch-field "mail-reply-to")
6128 distribution (message-fetch-field "distribution")
6129 mct (message-fetch-field "mail-copies-to"))
6130 (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
6132 (setq message-id (match-string 0 gnus-warning)))
6139 (setq subject (message-simplify-subject subject))
6142 (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
6144 (setq message-reply-headers
6145 (vector 0 subject from date message-id references 0 0 ""))
6147 (message-setup
6153 ((and followup-to message-use-followup-to)
6157 (if (or (eq message-use-followup-to 'use)
6158 (message-y-or-n-p "Obey Followup-To: poster? " t "\
6159 You should normally obey the Followup-To: header.
6161 `Followup-To: poster' sends your response via e-mail instead of news.
6166 You may customize the variable `message-use-followup-to', if you
6169 (setq message-this-is-news nil)
6174 (not (eq message-use-followup-to 'ask))
6175 (message-y-or-n-p
6177 You should normally obey the Followup-To: header.
6184 If a message is posted to several newsgroups, Followup-To is often
6192 You may customize the variable `message-use-followup-to', if you
6211 (defun message-is-yours-p ()
6213 If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles
6214 are yours except those that have Cancel-Lock header not belonging to you.
6215 Instead of shooting GNKSA feet, you should modify `message-alternative-emails'
6229 (message-narrow-to-head-1)
6230 (if (message-fetch-field "Cancel-Lock")
6236 (message-gnksa-enable-p 'cancel-messages)
6237 (and (setq sender (message-fetch-field "sender"))
6239 (downcase (message-make-sender))))
6241 (and (setq from (message-fetch-field "from"))
6243 (downcase (cadr (mail-extract-address-components from)))
6244 (downcase (cadr (mail-extract-address-components
6245 (message-make-from))))))
6247 ;; 'message-alternative-emails' regexp
6249 message-alternative-emails
6251 message-alternative-emails
6252 (cadr (mail-extract-address-components from))))))))))
6255 (defun message-cancel-news (&optional arg)
6257 If ARG, allow editing of the cancellation message."
6259 (unless (message-news-p)
6261 (let (from newsgroups message-id distribution buf)
6263 ;; Get header info from original article.
6265 (message-narrow-to-head-1)
6266 (setq from (message-fetch-field "from")
6267 newsgroups (message-fetch-field "newsgroups")
6268 message-id (message-fetch-field "message-id" t)
6269 distribution (message-fetch-field "distribution")))
6271 (unless (message-is-yours-p)
6274 ;; Make control message.
6276 (message-news)
6277 (setq buf (set-buffer (get-buffer-create " *message cancel*"))))
6281 "Subject: cmsg cancel " message-id "\n"
6282 "Control: cancel " message-id "\n"
6286 mail-header-separator "\n"
6287 message-cancel-message)
6288 (run-hooks 'message-cancel-hook)
6290 (message "Canceling your article...")
6291 (if (let ((message-syntax-checks
6293 (funcall message-send-news-function))
6294 (message "Canceling your article...done"))
6298 (defun message-supersede ()
6299 "Start composing a message to supersede the current message.
6301 header line with the old Message-ID."
6305 (unless (message-is-yours-p)
6307 ;; Get a normal message buffer.
6308 (message-pop-to-buffer (message-buffer-name "supersede"))
6311 (message-narrow-to-head-1)
6313 (when message-ignored-supersedes-headers
6314 (message-remove-header message-ignored-supersedes-headers t))
6320 (insert mail-header-separator)
6325 (defun message-recover ()
6342 (t (error "message-recover cancelled")))))
6346 (defun message-wash-subject (subject)
6379 (defvar message-forward-decoded-p nil
6380 "Non-nil means the original message is decoded.")
6382 (defun message-forward-subject-name-subject (subject)
6383 "Generate a SUBJECT for a forwarded message.
6384 The form is: [Source] Subject, where if the original message was mail,
6385 Source is the name of the sender, and if the original message was
6387 (let* ((group (message-fetch-field "newsgroups"))
6388 (from (message-fetch-field "from"))
6395 (if message-forward-decoded-p
6397 (mail-decode-encoded-word-string prefix))
6400 (defun message-forward-subject-author-subject (subject)
6401 "Generate a SUBJECT for a forwarded message.
6402 The form is: [Source] Subject, where if the original message was mail,
6403 Source is the sender, and if the original message was news, Source is
6405 (let* ((group (message-fetch-field "newsgroups"))
6409 (or (message-fetch-field "from")
6412 (if message-forward-decoded-p
6414 (mail-decode-encoded-word-string prefix))
6417 (defun message-forward-subject-fwd (subject)
6418 "Generate a SUBJECT for a forwarded message.
6420 the message."
6425 (defun message-make-forward-subject ()
6426 "Return a Subject header suitable for the message in the current buffer."
6429 (message-narrow-to-head-1)
6430 (let ((funcs message-make-forward-subject-function)
6431 (subject (message-fetch-field "Subject")))
6434 (if message-forward-decoded-p
6436 (mail-decode-encoded-word-string subject))
6438 (if message-wash-forwarded-subjects
6439 (setq subject (message-wash-subject subject)))
6457 (defun message-forward (&optional news digest)
6458 "Forward the current message via mail.
6459 Optional NEWS will use news to forward instead of mail.
6463 (message-forward-decoded-p
6466 message-forward-decoded-p))
6467 (subject (message-make-forward-subject)))
6469 (message-news nil subject)
6470 (message-mail nil subject))
6471 (message-forward-make-body cur digest)))
6473 (defun message-forward-make-body-plain (forward-buffer)
6475 "\n-------------------- Start of forwarded message --------------------\n")
6491 "\n-------------------- End of forwarded message --------------------\n")
6492 (when message-forward-ignored-headers
6498 (message-remove-header message-forward-ignored-headers t)))))
6500 (defun message-forward-make-body-mime (forward-buffer)
6501 (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
6513 (defun message-forward-make-body-mml (forward-buffer)
6514 (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
6516 (if (not message-forward-decoded-p)
6538 (when (and (not message-forward-decoded-p)
6539 message-forward-ignored-headers)
6545 (message-remove-header message-forward-ignored-headers t)))))
6547 (defun message-forward-make-body-digest-plain (forward-buffer)
6549 "\n-------------------- Start of forwarded message --------------------\n")
6554 "\n-------------------- End of forwarded message --------------------\n")))
6556 (defun message-forward-make-body-digest-mime (forward-buffer)
6569 (defun message-forward-make-body-digest (forward-buffer)
6570 (if message-forward-as-mime
6571 (message-forward-make-body-digest-mime forward-buffer)
6572 (message-forward-make-body-digest-plain forward-buffer)))
6575 (defun message-forward-make-body (forward-buffer &optional digest)
6577 ;; message.
6578 (if message-forward-before-signature
6579 (message-goto-body)
6582 (message-forward-make-body-digest forward-buffer)
6583 (if message-forward-as-mime
6584 (if (and message-forward-show-mml
6585 (not (and (eq message-forward-show-mml 'best)
6591 (message-forward-make-body-mml forward-buffer)
6592 (message-forward-make-body-mime forward-buffer))
6593 (message-forward-make-body-plain forward-buffer)))
6594 (message-position-point))
6597 (defun message-forward-rmail-make-body (forward-buffer)
6600 ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs
6603 (rmail-msg-restore-non-pruned-header)))
6604 (message-forward-make-body forward-buffer))
6610 (defun message-insinuate-rmail ()
6611 "Let RMAIL use message to forward."
6614 (setq rmail-insert-mime-forwarded-message-function
6615 'message-forward-rmail-make-body))
6618 (defun message-resend (address)
6621 (list (message-read-from-minibuffer "Resend message to: ")))
6622 (message "Resending message to %s..." address)
6626 ;; We first set up a normal mail buffer.
6627 (unless (message-mail-user-agent)
6628 (set-buffer (get-buffer-create " *message resend*"))
6630 (let ((message-this-is-mail t)
6631 message-setup-hook)
6632 (message-setup `((To . ,address))))
6634 (message-generate-headers '(From Date To Message-ID))
6635 (message-narrow-to-headers)
6636 ;; Remove X-Draft-From header etc.
6637 (message-remove-header message-ignored-mail-headers t)
6647 ;; Insert the message to be resent.
6654 (message-remove-header message-ignored-resent-headers t)
6656 (insert mail-header-separator)
6666 (let ((message-inhibit-body-encoding t)
6667 message-required-mail-headers
6669 (message-send-mail))
6671 (message "Resending message to %s...done" address)))
6674 (defun message-bounce ()
6675 "Re-mail the current message.
6676 This only makes sense if the current message is a bounce message that
6677 contains some mail you have written which has been bounced back to
6682 (message-pop-to-buffer (message-buffer-name "bounce"))
6693 ;; We remove everything before the bounced mail.
6694 (if (or (re-search-forward message-unsent-separator nil t)
6709 (message-narrow-to-head-1)
6710 (message-remove-header message-ignored-bounced-headers t)
6712 (insert mail-header-separator))
6713 (message-position-point)))
6716 ;;; Interactive entry points for new message buffers.
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))
6731 (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
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))
6746 (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
6750 (defun message-news-other-window (&optional newsgroups subject)
6758 (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
6759 (let ((message-this-is-news t))
6760 (message-setup `((Newsgroups . ,(or newsgroups ""))
6764 (defun message-news-other-frame (&optional newsgroups subject)
6772 (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
6773 (let ((message-this-is-news t))
6774 (message-setup `((Newsgroups . ,(or newsgroups ""))
6811 (defun message-exchange-point-and-mark ()
6814 (message-mark-active-p)
6818 (defalias 'message-make-overlay 'make-overlay)
6819 (defalias 'message-delete-overlay 'delete-overlay)
6820 (defalias 'message-overlay-put 'overlay-put)
6821 (defun message-kill-all-overlays ()
6830 ;; Note: The :set function in the `message-tool-bar*' variables will only
6831 ;; affect _new_ message buffers. We might add a function that walks thru all
6832 ;; message-mode buffers and force the update.
6833 (defun message-tool-bar-update (&optional symbol value)
6834 "Update message mode toolbar.
6836 (setq-default message-tool-bar-map nil)
6841 (defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome)
6842 'message-tool-bar-gnome
6843 'message-tool-bar-retro)
6844 "Specifies the message mode tool bar.
6848 default key map is `message-mode-map'.
6850 Pre-defined symbols include `message-tool-bar-gnome' and
6851 `message-tool-bar-retro'."
6853 :type '(choice (const :tag "GNOME style" message-tool-bar-gnome)
6854 (const :tag "Retro look" message-tool-bar-retro)
6859 :set 'message-tool-bar-update
6860 :group 'message)
6862 (defcustom message-tool-bar-gnome
6863 '((ispell-message "spell" nil
6871 (message-send-and-exit "mail/send")
6872 (message-dont-send "mail/save-draft")
6873 (message-kill-buffer "close") ;; stock_cancel
6875 (mml-preview "mail/preview" mml-mode-map)
6876 ;; (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
6877 (message-insert-importance-high "important" nil :visible nil)
6878 (message-insert-importance-low "unimportant" nil :visible nil)
6879 (message-insert-disposition-notification-to "receipt" nil :visible nil)
6881 (message-info "help" t :help "Message manual"))
6882 "List of items for the message tool bar (GNOME style).
6888 :set 'message-tool-bar-update
6889 :group 'message)
6891 (defcustom message-tool-bar-retro
6893 (message-send-and-exit "gnus/mail_send")
6894 (message-kill-buffer "close")
6895 (message-dont-send "cancel")
6897 (ispell-message "spell")
6899 (message-insert-importance-high "gnus/important")
6900 (message-insert-importance-low "gnus/unimportant")
6901 (message-insert-disposition-notification-to "gnus/receipt"))
6902 "List of items for the message tool bar (retro style).
6908 :set 'message-tool-bar-update
6909 :group 'message)
6911 (defcustom message-tool-bar-zap-list
6915 These items are not displayed on the message mode tool bar.
6921 :set 'message-tool-bar-update
6922 :group 'message)
6926 (defun message-make-tool-bar (&optional force)
6927 "Make a message mode tool bar from `message-tool-bar-list'.
6932 (or (not message-tool-bar-map) force))
6933 (setq message-tool-bar-map
6935 (gmm-image-load-path-for-library "message"
6936 "mail/save-draft.xpm"
6941 (gmm-tool-bar-from-list message-tool-bar
6942 message-tool-bar-zap-list
6943 'message-mode-map))))
6944 message-tool-bar-map)
6948 (defcustom message-newgroups-header-regexp
6951 :group 'message
6954 (defcustom message-completion-alist
6955 (list (cons message-newgroups-header-regexp 'message-expand-group)
6956 '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name)
6958 . message-expand-name)
6960 . message-expand-name))
6961 "Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
6963 :group 'message
6966 (defcustom message-tab-body-function nil
6967 "*Function to execute when `message-tab' (TAB) is executed in the body.
6970 :group 'message
6971 :link '(custom-manual "(message)Various Commands")
6975 (defun message-tab ()
6976 "Complete names according to `message-completion-alist'.
6977 Execute function specified by `message-tab-body-function' when not in
6980 (let ((alist message-completion-alist))
6982 (let ((mail-abbrev-mode-regexp (caar alist)))
6983 (not (mail-abbrev-in-expansion-header-p))))
6985 (funcall (or (cdar alist) message-tab-body-function
6995 (defalias 'message-display-completion-list 'display-completion-list))
6997 (defun message-display-completion-list (completions &optional ignore)
7001 (defun message-expand-group ()
7024 (message "Only matching group"))
7032 (message "No matching groups")
7039 (message-display-completion-list (sort completions 'string<)
7045 (defun message-expand-name ()
7052 (defun message-talkative-question (ask question show &rest text)
7057 (setq text (message-flatten-list text)))
7060 (with-output-to-temp-buffer " *MESSAGE information message*"
7061 (set-buffer " *MESSAGE information message*")
7068 (defun message-flatten-list (list)
7071 \(message-flatten-list '(1 (2 3 (4 5 (6))) 7))
7074 (apply 'append (mapcar 'message-flatten-list list)))
7078 (defun message-generate-new-buffer-clone-locals (name &optional varstr)
7086 (message-clone-locals oldbuf varstr)
7089 (defun message-clone-locals (buffer &optional varstr)
7094 (regexp "^gnus\\|^nn\\|^message\\|^sendmail\\|^smtp\\|^user-mail-address"))
7111 (defvar message-inhibit-body-encoding nil)
7113 (defun message-encode-message-body ()
7114 (unless message-inhibit-body-encoding
7115 (let ((mail-parse-charset (or mail-parse-charset
7116 message-default-charset))
7119 (message-goto-body)
7133 (message-narrow-to-headers-or-head)
7134 (message-remove-header "Mime-Version")
7143 (message-narrow-to-headers-or-head)
7144 (message-remove-first-header "Content-Type")
7145 (message-remove-first-header "Content-Transfer-Encoding"))
7146 ;; We always make sure that the message has a Content-Type
7147 ;; header. This is because some broken MTAs and MUAs get
7148 ;; awfully confused when confronted with a message with a
7149 ;; MIME-Version header and without a Content-Type header. For
7150 ;; instance, Solaris' /usr/bin/mail.
7158 (defun message-read-from-minibuffer (prompt &optional initial-contents)
7160 (if (fboundp 'mail-abbrevs-setup)
7161 (let ((mail-abbrev-mode-regexp "")
7162 (minibuffer-setup-hook 'mail-abbrevs-setup)
7163 (minibuffer-local-map message-minibuffer-local-map))
7165 (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
7166 (minibuffer-local-map message-minibuffer-local-map))
7169 (defun message-use-alternative-email-as-from ()
7170 "Set From field of the outgoing message to the first matching
7171 address in `message-alternative-emails', looking at To, Cc and
7173 (require 'mail-utils)
7177 (mail-strip-quoted-names
7178 (mapconcat 'message-fetch-reply-field fields ","))
7182 (if (string-match message-alternative-emails (car emails))
7186 (unless (or (not email) (equal email user-mail-address))
7187 (message-remove-header "From")
7191 (defun message-options-get (symbol)
7192 (cdr (assq symbol message-options)))
7194 (defun message-options-set (symbol value)
7195 (let ((the-cons (assq symbol message-options)))
7199 (setq message-options (delq the-cons message-options)))
7201 (push (cons symbol value) message-options))))
7204 (defun message-options-set-recipient ()
7206 (message-narrow-to-headers-or-head)
7207 (message-options-set 'message-sender
7208 (mail-strip-quoted-names
7209 (message-fetch-field "from")))
7210 (message-options-set 'message-recipients
7211 (mail-strip-quoted-names
7212 (let ((to (message-fetch-field "to"))
7213 (cc (message-fetch-field "cc"))
7214 (bcc (message-fetch-field "bcc")))
7222 (defun message-hide-headers ()
7223 "Hide headers based on the `message-hidden-headers' variable."
7224 (let ((regexps (if (stringp message-hidden-headers)
7225 (list message-hidden-headers)
7226 message-hidden-headers))
7232 (message-narrow-to-headers)
7235 (if (not (message-hide-header-p regexps))
7236 (message-next-header)
7238 (message-next-header)
7241 '(invisible t message-hidden t))))))))))
7243 (defun message-hide-header-p (regexps)
7257 (message-xmas-redefine))
7259 (provide 'message)
7261 (run-hooks 'message-load-hook)
7268 ;;; message.el ends here