• Home
  • History
  • Annotate
  • Raw
  • Download
  • only in /macosx-10.9.5/emacs-92/emacs/lisp/gnus/

Lines Matching +defs:message +defs:goto +defs:distribution

0 ;;; message.el --- composing mail and news messages
36 (defvar gnus-message-group-art)
56 (defgroup message '((user-mail-address custom-variable)
58 "Mail and news message composing."
59 :link '(custom-manual "(message)Top")
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/"
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
156 :group 'message-interface
160 (defcustom message-from-style 'default
176 :group 'message-headers)
178 (defcustom message-insert-canlock t
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
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"
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.
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
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
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'.
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
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
669 :group 'message-interface
670 :link '(custom-manual "(message)Followup")
676 (defcustom message-use-mail-followup-to 'use
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
751 `header', use the From: header of the message."
754 (const :tag "Use From: header from message" header)
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
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
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
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
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
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
1004 (defcustom message-default-headers ""
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 ""
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 ""
1021 :group 'message-headers
1022 :group 'message-news
1023 :link '(custom-manual "(message)News Headers")
1024 :type 'message-header-lines)
1028 (defcustom message-mailer-swallows-blank-line
1037 (goto-char (point-min))
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
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
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)
1294 (goto-char (point-min))
1299 (goto-char start))
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))
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
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
1371 This hook is run very late -- just before the message is sent as
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
1393 (defvar message-draft-coding-system
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
1430 for a message, the subaddresses will be removed (if present) before
1434 :group 'message-headers
1437 (defcustom message-mail-user-agent nil
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)
1515 (defvar message-unix-mail-delimiter
1545 ;; The time the message was sent.
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
1602 (defvar message-bogus-system-names "^localhost\\.\\|\\.local$"
1605 (defcustom message-valid-fqdn-regexp
1621 :group 'message-headers
1626 (autoload 'message-setup-toolbar "messagexmas")
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)
1690 (goto-char (point-min))
1712 (defun message-mail-file-mbox-p (file)
1719 (goto-char (point-min))
1720 (looking-at message-unix-mail-delimiter))))
1722 (defun message-fetch-field (header &optional not-all)
1724 The buffer is expected to be narrowed to just the header of the message;
1725 see `message-narrow-to-headers-or-head'."
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 ()
1754 (goto-char (point-min)))
1756 (defun message-add-header (&rest headers)
1757 "Add the HEADERS to the message header, skipping those already present."
1764 (message-narrow-to-headers)
1766 (goto-char (point-max))
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
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))
1836 (goto-char (point-min))
1855 (goto-char (point-min))
1874 subject cs-string message-replacement-char)))
1879 (goto-char word-beg)
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)
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'."
1974 (goto-char end)
1975 (insert message-mark-insert-end)
1976 (goto-char beg)
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)
1986 (goto-char p)
1988 (goto-char p)
1989 (insert message-mark-insert-begin)))
1991 (defun message-add-archive-header ()
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)
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)
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)
2126 (defun message-reduce-to-to-cc ()
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)
2157 (goto-char (point-min))
2178 (goto-char (match-beginning 0))
2182 (goto-char (match-beginning 0))
2183 (goto-char (point-max)))))
2186 (defun message-remove-first-header (header)
2191 (goto-char (point-min))
2195 (message-remove-header header nil t)
2198 (defun message-narrow-to-headers ()
2199 "Narrow the buffer to the head of the message."
2202 (goto-char (point-min))
2207 (goto-char (point-min)))
2209 (defun message-narrow-to-head-1 ()
2210 "Like `message-narrow-to-head'. Don't widen."
2212 (goto-char (point-min))
2216 (goto-char (point-min)))
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."
2228 (goto-char (point-min))
2235 (goto-char (point-min)))
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 ()
2260 (or message-subscribed-regexps
2261 message-subscribed-addresses
2262 message-subscribed-address-file
2263 message-subscribed-address-functions))
2265 (defun message-next-header ()
2271 (goto-char (point-max)))))
2273 (defun message-sort-headers-1 ()
2274 "Sort the buffer as headers using `message-rank' text props."
2275 (goto-char (point-min))
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)
2314 (cond ((eq arg 16) (Info-goto-node "(pgg)Top"))
2315 ((eq arg 4) (Info-goto-node "(emacs-mime)Top"))
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
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
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"
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
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
2656 (when (eq message-mail-alias-type 'abbrev)
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]*")))
2705 (setq normal-auto-fill-function 'message-do-auto-fill)
2723 (defun message-goto-to ()
2726 (message-position-on-field "To"))
2728 (defun message-goto-from ()
2731 (message-position-on-field "From"))
2733 (defun message-goto-subject ()
2736 (message-position-on-field "Subject"))
2738 (defun message-goto-cc ()
2741 (message-position-on-field "Cc" "To"))
2743 (defun message-goto-bcc ()
2746 (message-position-on-field "Bcc" "Cc" "To"))
2748 (defun message-goto-fcc ()
2751 (message-position-on-field "Fcc" "To" "Newsgroups"))
2753 (defun message-goto-reply-to ()
2756 (message-position-on-field "Reply-To" "Subject"))
2758 (defun message-goto-newsgroups ()
2761 (message-position-on-field "Newsgroups"))
2763 (defun message-goto-distribution ()
2766 (message-position-on-field "Distribution"))
2768 (defun message-goto-followup-to ()
2771 (message-position-on-field "Followup-To" "Newsgroups"))
2773 (defun message-goto-mail-followup-to ()
2776 (message-position-on-field "Mail-Followup-To" "To"))
2778 (defun message-goto-keywords ()
2781 (message-position-on-field "Keywords" "Subject"))
2783 (defun message-goto-summary ()
2786 (message-position-on-field "Summary" "Subject"))
2788 (defun message-goto-body (&optional interactivep)
2789 "Move point to the beginning of the message body."
2794 (goto-char (point-min))
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.
2814 (goto-char (point-min))
2815 (if (re-search-forward message-signature-separator nil t)
2817 (goto-char (point-max))
2820 (defun message-generate-unsubscribed-mail-followup-to (&optional include-cc)
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)
2846 (defun message-insert-to (&optional force)
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
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
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'."
2897 (synonyms (loop for synonym in message-header-synonyms
2905 (message "already have `%s' in `%s'" new-header old-header)
2906 (when (and (message-position-on-field header-name)
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)))
2926 (goto-char (point-min))
2930 (defun message-insert-newsgroups ()
2933 (when (and (message-position-on-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."
2949 (goto-char beg)
2952 (when (looking-at message-cite-prefix-regexp)
2954 (goto-char end)
2955 (delete-region (point) (if (not (message-goto-signature))
2960 (goto-char beg)
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)
2998 (goto-char (match-end 0))
3013 (looking-at message-cite-prefix-regexp)
3015 (goto-char (match-end 0))
3021 (goto-char beg)
3024 (looking-at message-cite-prefix-regexp)
3027 (goto-char (match-end 0))
3033 (not (looking-at message-cite-prefix-regexp)))
3036 (goto-char beg)
3039 (not (looking-at message-cite-prefix-regexp)))
3041 (goto-char point)
3066 (if point (goto-char point)))))
3068 (defun message-fill-paragraph (&optional arg)
3073 (message-newline-and-reformat arg t)
3077 (defun message-point-in-header-p ()
3081 (goto-char (point-min))
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)
3099 (goto-char (point-max))
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))
3117 (goto-char (point-max))
3121 (when message-signature-insert-empty-line
3125 (insert-file-contents message-signature-file)
3127 (goto-char (point-max))
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 ()
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\".
3260 (goto-char (point-min))
3264 (if (message-news-p) (message-fetch-field "Newsgroups")
3265 (message-fetch-field "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.
3282 (goto-char (point-min))
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
3300 (goto-char start)
3304 (message-remove-header message-ignored-cited-headers t)
3307 (goto-char (point-max)))
3309 (goto-char start)
3315 (message-delete-line))
3317 (goto-char (point-max))
3322 (message-delete-line))
3324 (if (null message-yank-prefix)
3325 (indent-rigidly start (mark t) message-indentation-spaces)
3327 (goto-char start)
3330 (insert message-yank-cited-prefix)
3331 (insert message-yank-prefix))
3333 (goto-char start)))
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)
3359 (goto-char (mark t))
3361 (goto-char pt))))
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")
3409 (goto-char end)
3410 (when (re-search-backward message-signature-separator start t)
3420 (goto-char start)
3423 (when message-citation-line-function
3426 (funcall message-citation-line-function))))
3429 (defun message-cite-original ()
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")
3456 (goto-char start)
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)
3475 (goto-char (point-min))
3480 (goto-char (point-min))
3499 (defun message-remove-signature ()
3505 (if (not (re-search-forward message-signature-separator (mark t) t))
3507 (message-indent-citation)
3514 (goto-char start)
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)
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)
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.
3690 (goto-char (point-max))
3694 (let ((points (message-text-with-property 'message-hidden)))
3696 (goto-char (car points))
3703 (message-check 'invisible-text
3704 (let ((points (message-text-with-property 'invisible)))
3706 (goto-char (car points))
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."
3796 (goto-char (point-min))
3800 (run-hooks 'message-send-mail-hook)
3801 (let ((p (goto-char (point-min)))
3802 (tembuf (message-generate-new-buffer-clone-locals " message temp"))
3804 (id (message-make-message-id)) (n 1)
3807 (if (< (point-max) (+ p message-send-mail-partially-limit))
3808 (goto-char (point-max))
3809 (goto-char (+ p message-send-mail-partially-limit))
3811 (if (<= (point) p) (forward-line 1))) ;; In case of bad message.
3824 (goto-char (point-min))
3827 (goto-char (point-min))
3830 (message-goto-eoh)
3832 (goto-char (point-min))
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")
3840 (goto-char (point-max))
3843 (goto-char (point-max))
3844 (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n"
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)
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)
3879 (if (and (message-subscribed-p)
3883 (cons "Mail-Followup-To" (message-make-mail-followup-to))
3884 message-required-mail-headers))
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
3894 (goto-char (point-min))
3896 (goto-char (match-beginning 0))
3901 (error "Failed to send the message")))))
3903 (run-hooks 'message-header-hook))
3913 (message-encode-message-body)
3915 (message-narrow-to-headers)
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))
3923 (goto-char (point-max))
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
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, "
3962 problem, answer `y', and the message will be split into several
3964 (/ message-send-mail-partially-limit 1000)
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")))
3999 (goto-char (point-min))
4005 (run-hooks 'message-send-mail-hook)
4008 (goto-char (1+ delimline))
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)))
4039 (if (null message-interactive) '("-oem" "-odb"))
4040 ;; Get the addresses from the message
4050 (when message-interactive
4053 (goto-char (point-min))
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'
4067 (goto-char (point-min))
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
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))
4115 (goto-char (point-min))
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)
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")))
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)
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))
4235 (goto-char (point-max))
4241 (goto-char (point-min))
4246 (run-hooks 'message-send-news-hook)
4248 (message "Sending news via %s..." (gnus-server-string method))
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 ()
4285 (message-check 'newsgroups
4286 (let ((group (message-fetch-field "newsgroups")))
4291 (message
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"))
4310 (message-check 'long-header-lines
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"))
4368 (message-tokenize-header
4370 (goto-char (point-min))
4374 (message-check 'shoot
4380 (message-check 'approved
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
4463 (goto-char (point-min))
4466 (goto-char (match-beginning 0))
4474 (message-check 'valid-newsgroups
4489 (message-tokenize-header header ","))))
4498 (message-check 'repeated-newsgroups
4505 (setq groups (message-tokenize-header header ","))
4515 (message-check 'from
4517 (from (message-fetch-field "from"))
4521 (message "There is no From line. Posting is denied.")
4532 (message
4540 (message
4545 (message-check 'reply-to
4547 (reply-to (message-fetch-field "reply-to"))
4571 (defun message-check-news-body-syntax ()
4574 (message-check 'long-lines
4575 (goto-char (point-min))
4591 (message-check 'empty
4592 (goto-char (point-min))
4597 (goto-char (point-max))
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
4632 (goto-char (point-max))
4640 (message-check 'quoting-style
4641 (goto-char (point-max))
4647 (if (message-gnksa-enable-p 'quoted-text-only)
4650 (goto-char (point-min))
4655 (message "Denied posting -- only quoted text.")
4658 (defun message-checksum ()
4662 (goto-char (point-min))
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)
4697 (goto-char (point-min))
4714 (if (and message-fcc-handler-function
4715 (not (eq message-fcc-handler-function 'rmail-output)))
4716 (funcall message-fcc-handler-function file)
4723 (defun message-output (filename)
4730 (defun message-cleanup-headers ()
4734 (message-narrow-to-headers)
4742 (goto-char (point-min))
4751 (goto-char (point-min))
4754 (goto-char (point-min))
4757 (goto-char (point-min))
4763 (defun message-make-date (&optional now)
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 ()
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)))
4863 (goto-char (point-min))
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)))
4906 (goto-char (point-min))
4911 (goto-char (match-beginning 0)))
4918 "'s message of \""
4923 (defun message-make-distribution ()
4925 (let ((orig-distribution (message-fetch-reply-field "distribution")))
4926 (cond ((functionp message-distribution-function)
4927 (funcall message-distribution-function))
4928 (t orig-distribution))))
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 ()
4951 (let* ((style message-from-style)
4952 (login (message-make-address))
4976 (goto-char (point-min))
4981 (goto-char (point-min))
4991 (goto-char fullname-start)
4999 (goto-char fullname-start)
5004 (goto-char fullname-start)))
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 ()
5027 (defun message-sendmail-envelope-from ()
5029 (cond ((eq message-sendmail-envelope-from 'header)
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))
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)))
5060 (string-match message-valid-fqdn-regexp mail-host-address)
5061 (not (string-match message-bogus-system-names mail-host-address)))
5066 (string-match message-valid-fqdn-regexp user-domain)
5067 (not (string-match message-bogus-system-names user-domain)))
5074 (defun message-make-host-name ()
5076 (let ((fqdn (message-make-fqdn)))
5080 (defun message-make-domain ()
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)
5102 (to (message-fetch-field "To"))
5103 (cc (message-fetch-field "cc"))
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))
5154 (or (not (eq message-use-idna 'ask))
5157 (goto-char (point-min))
5159 (message-narrow-to-field)
5162 (goto-char (point-max))
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))
5204 (let ((headers message-deletable-headers))
5208 (goto-char (point-min))
5211 (get-text-property (1+ (match-beginning 0)) 'message-deletable)
5212 (message-delete-line))
5219 (goto-char (point-min))
5246 (not (member header-string message-inserted-headers)))
5269 ((not (message-check-element
5282 (goto-char (point-max))
5284 (cdr (assq header message-header-format-alist))))
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))
5323 (goto-char (point-min))
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"))
5342 (goto-char (point-max))
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)
5365 (goto-char (point-min))
5375 (goto-char last)
5382 (goto-char (point-max))
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)
5409 (message-delete-line))
5410 (goto-char begin)
5414 (goto-char (point-max)))))
5416 (defun message-shorten-1 (list cut surplus)
5421 (defun message-shorten-references (header references)
5431 (goto-char (point-min))
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)
5472 (message-fill-header header refstring)))))
5474 (defun message-position-point ()
5476 (message-narrow-to-headers)
5486 (goto-char (point-max))
5493 (defcustom message-beginning-of-line t
5494 "Whether \\<message-mode-map>\\[message-beginning-of-line]\
5497 :group 'message-buffers
5498 :link '(custom-manual "(message)Movement")
5501 (defun message-beginning-of-line (&optional n)
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
5518 (if (and message-beginning-of-line
5519 (message-point-in-header-p))
5524 (goto-char
5529 (defun message-buffer-name (type &optional to group)
5533 ((memq message-generate-new-buffers '(unique t))
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)
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)
5635 (message-narrow-to-headers)
5636 (setq to (message-fetch-field "to"))
5637 (setq group (message-fetch-field "newsgroups"))
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)
5689 (defun message-headers-to-generate (headers included-headers excluded-headers)
5714 (defun message-setup-1 (headers &optional replybuffer actions)
5717 (add-to-list 'message-send-actions
5719 (setq message-reply-buffer replybuffer)
5720 (goto-char (point-min))
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)
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.
5838 to continue editing a message already being composed. SWITCH-FUNCTION
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"))))
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 "\
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))
5968 (message-tokenize-header recipients)))
5975 ;; if message-hierarchical-addresses is defined.
5976 (when message-hierarchical-addresses
5981 message-hierarchical-addresses)
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)
6108 followup-to distribution newsgroups gnus-warning posted-to)
6111 (goto-char (point-min))
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)))
6133 ;; Remove bogus distribution.
6134 (when (and (stringp distribution)
6136 (string-match "world" distribution)))
6137 (setq distribution nil))
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 "\
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
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
6200 ,@(and distribution (list (cons 'Distribution distribution)))
6211 (defun message-is-yours-p ()
6213 If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles
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"))
6245 (message-make-from))))))
6247 ;; 'message-alternative-emails' regexp
6249 message-alternative-emails
6251 message-alternative-emails
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)
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"
6283 (if distribution
6284 (concat "Distribution: " distribution "\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.
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))
6315 (goto-char (point-min))
6319 (goto-char (point-max))
6325 (defun message-recover ()
6342 (t (error "message-recover cancelled")))))
6346 (defun message-wash-subject (subject)
6351 (goto-char (point-min))
6358 (goto-char (point-min))
6363 (goto-char (point-max))
6368 (goto-char (point-min))
6371 (goto-char (point-max))
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
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
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
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.
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")
6485 (goto-char (point-min))
6491 "\n-------------------- End of forwarded message --------------------\n")
6492 (when message-forward-ignored-headers
6495 (goto-char b)
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")
6506 (goto-char (point-min))
6509 (goto-char (point-max)))
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)
6525 (goto-char (point-min))
6532 (goto-char (point-min))
6535 (goto-char (point-max))))
6538 (when (and (not message-forward-decoded-p)
6539 message-forward-ignored-headers)
6542 (goto-char b)
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)
6564 (goto-char b)
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)
6580 (goto-char (point-max)))
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)
6587 (goto-char (point-min))
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)
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)
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)
6637 (message-remove-header message-ignored-mail-headers t)
6639 (goto-char (point-min))
6647 ;; Insert the message to be resent.
6649 (goto-char (point-min))
6654 (message-remove-header message-ignored-resent-headers t)
6655 (goto-char (point-max)))
6662 (goto-char beg)
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
6682 (message-pop-to-buffer (message-buffer-name "bounce"))
6690 (goto-char (point-min))
6694 (if (or (re-search-forward message-unsent-separator nil t)
6704 (goto-char boundary)
6709 (message-narrow-to-head-1)
6710 (message-remove-header message-ignored-bounced-headers t)
6711 (goto-char (point-max))
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 ""))
6791 (goto-char (min start end))
6806 (goto-char (min start end))
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
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"
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))
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))
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<)
7042 (goto-char (point-min))
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*")
7064 (goto-char (point-min))))
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
7116 message-default-charset))
7119 (message-goto-body)
7126 (goto-char (point-min))
7133 (message-narrow-to-headers-or-head)
7134 (message-remove-header "Mime-Version")
7135 (goto-char (point-max))
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
7148 ;; awfully confused when confronted with a message with a
7152 (goto-char (point-min))
7158 (defun message-read-from-minibuffer (prompt &optional initial-contents)
7163 (minibuffer-local-map message-minibuffer-local-map))
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
7178 (mapconcat 'message-fetch-reply-field fields ","))
7182 (if (string-match message-alternative-emails (car emails))
7187 (message-remove-header "From")
7188 (goto-char (point-max))
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
7209 (message-fetch-field "from")))
7210 (message-options-set 'message-recipients
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)
7233 (goto-char (point-min))
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