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

Lines Matching +defs:gnus +defs:summary +defs:followup +defs:to +defs:mail

0 ;;; gnus-msg.el --- mail and post interface for Gnus
7 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
33 (require 'gnus)
34 (require 'gnus-ems)
36 (require 'gnus-art)
37 (require 'gnus-util)
39 (defcustom gnus-post-method 'current
46 This method will not be used in mail groups and the like, only in
50 in the documentation of `gnus-select-method'. It can also be a list of
52 method to use when posting."
53 :group 'gnus-group-foreign
54 :link '(custom-manual "(gnus)Posting Server")
57 (sexp :tag "Methods" ,gnus-select-method)))
59 (defcustom gnus-outgoing-message-group nil
61 If you want to store all your outgoing mail and articles in the group
62 \"nnml:archive\", you set this variable to that value. This variable
65 If you want to have greater control over what group to put each
66 message in, you can set this variable to a function that checks the
69 :group 'gnus-message
75 (defcustom gnus-mailing-list-groups nil
78 gatewayed to a newsgroup, and you want to followup to an article in
80 :group 'gnus-message
84 (defcustom gnus-add-to-list nil
85 "*If non-nil, add a `to-list' parameter automatically."
86 :group 'gnus-message
89 (defcustom gnus-crosspost-complaint
97 of this message. Please trim your Newsgroups header to exclude this
103 "Format string to be inserted when complaining about crossposts.
106 :group 'gnus-message
109 (defcustom gnus-message-setup-hook nil
111 :group 'gnus-message
114 (defcustom gnus-bug-create-help-buffer t
116 :group 'gnus-message
119 (defcustom gnus-posting-styles nil
120 "*Alist of styles to use when posting.
121 See Info node `(gnus)Posting Styles'."
122 :group 'gnus-message
123 :link '(custom-manual "(gnus)Posting Styles")
146 (defcustom gnus-gcc-mark-as-read nil
149 :group 'gnus-message
152 (make-obsolete-variable 'gnus-inews-mark-gcc-as-read
153 'gnus-gcc-mark-as-read)
155 (defcustom gnus-gcc-externalize-attachments nil
161 :group 'gnus-message
166 (gnus-define-group-parameter
171 :variable gnus-group-posting-charset-alist
175 (message-this-is-mail nil nil)
181 variable to query,
190 :variable-group gnus-charset
195 (const :tag "Mail message" :value message-this-is-mail)
209 List of charsets that are permitted to be unencoded.")
211 (defcustom gnus-debug-files
212 '("gnus.el" "gnus-sum.el" "gnus-group.el"
213 "gnus-art.el" "gnus-start.el" "gnus-async.el"
214 "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
215 "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
217 "Files whose variables will be reported in `gnus-bug'."
219 :group 'gnus-message
222 (defcustom gnus-debug-exclude-variables
225 "Variables that should not be reported in `gnus-bug'."
227 :group 'gnus-message
230 (defcustom gnus-discouraged-post-methods
233 This variable is used only when `gnus-post-method' is `current'."
235 :group 'gnus-group-foreign
238 (defcustom gnus-message-replysign
240 "Automatically sign replies to signed messages.
242 :group 'gnus-message
245 (defcustom gnus-message-replyencrypt
247 "Automatically encrypt replies to encrypted messages.
249 :group 'gnus-message
252 (defcustom gnus-message-replysignencrypted
254 "Setting this causes automatically encrypted messages to also be signed."
255 :group 'gnus-message
258 (defcustom gnus-confirm-mail-reply-to-news nil
259 "If non-nil, Gnus requests confirmation when replying to news.
267 :group 'gnus-message
271 (function :tag "Iff function evaluates to non-nil")))
273 (defcustom gnus-confirm-treat-mail-like-news
275 "If non-nil, Gnus will treat mail like news with regard to confirmation
276 when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable
278 If nil, Gnus will never ask for confirmation if replying to mail."
280 :group 'gnus-message
283 (defcustom gnus-summary-resend-default-address t
284 "If non-nil, Gnus tries to suggest a default address to resend to.
286 `gnus-summary-resend-message'."
288 :group 'gnus-message
293 (defvar gnus-inhibit-posting-styles nil
296 (defvar gnus-article-yanked-articles nil)
297 (defvar gnus-message-buffer "*Mail Gnus*")
298 (defvar gnus-article-copy nil)
299 (defvar gnus-check-before-posting nil)
300 (defvar gnus-last-posting-server nil)
301 (defvar gnus-message-group-art nil)
303 (defvar gnus-msg-force-broken-reply-to nil)
305 (defconst gnus-bug-message
306 "Sending a bug report to the Gnus Towers.
309 The buffer below is a mail buffer. When you press `C-c C-c', it will
310 be sent to the Gnus Bug Exterminators.
313 settings will be included in the mail. Please do not delete that.
315 will be easier to locate the bugs.
318 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
327 (autoload 'gnus-uu-post-news "gnus-uu" nil t)
330 (autoload 'rmail-dont-reply-to "mail-utils")
339 (gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
340 "p" gnus-summary-post-news
341 "i" gnus-summary-news-other-window
342 "f" gnus-summary-followup
343 "F" gnus-summary-followup-with-original
344 "c" gnus-summary-cancel-article
345 "s" gnus-summary-supersede-article
346 "r" gnus-summary-reply
347 "y" gnus-summary-yank-message
348 "R" gnus-summary-reply-with-original
349 "w" gnus-summary-wide-reply
350 "W" gnus-summary-wide-reply-with-original
351 "v" gnus-summary-very-wide-reply
352 "V" gnus-summary-very-wide-reply-with-original
353 "n" gnus-summary-followup-to-mail
354 "N" gnus-summary-followup-to-mail-with-original
355 "m" gnus-summary-mail-other-window
356 "u" gnus-uu-post-news
357 "\M-c" gnus-summary-mail-crosspost-complaint
358 "Br" gnus-summary-reply-broken-reply-to
359 "BR" gnus-summary-reply-broken-reply-to-with-original
360 "om" gnus-summary-mail-forward
361 "op" gnus-summary-post-forward
362 "Om" gnus-uu-digest-mail-forward
363 "Op" gnus-uu-digest-post-forward)
365 (gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
366 "b" gnus-summary-resend-bounced-mail
367 ;; "c" gnus-summary-send-draft
368 "r" gnus-summary-resend-message
369 "e" gnus-summary-resend-message-edit)
373 (defun gnus-inews-make-draft ()
375 (gnus-inews-make-draft-meta-information
376 ,gnus-newsgroup-name ',gnus-article-reply)))
378 (defvar gnus-article-reply nil)
379 (defmacro gnus-setup-message (config &rest forms)
380 (let ((winconf (make-symbol "gnus-setup-message-winconf"))
381 (buffer (make-symbol "gnus-setup-message-buffer"))
382 (article (make-symbol "gnus-setup-message-article"))
383 (yanked (make-symbol "gnus-setup-yanked-articles"))
384 (group (make-symbol "gnus-setup-message-group")))
387 (,article gnus-article-reply)
388 (,yanked gnus-article-yanked-articles)
389 (,group gnus-newsgroup-name)
395 (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
396 (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
398 ;; gnus-inews-add-send-actions, but this is too late when
403 (setq message-mailer (gnus-extended-version)))))
404 ;; #### FIXME: for a reason that I did not manage to identify yet,
405 ;; the variable `gnus-newsgroup-name' does not honor a dynamically
406 ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'.
408 ;; to override, and the posting styles are used. For that reason, I've
409 ;; added an optional argument to `gnus-configure-posting-styles' to
414 (gnus-configure-posting-styles ,group))
416 ;; There may be an old " *gnus article copy*" buffer.
417 (let (gnus-article-copy)
418 (gnus-configure-posting-styles ,group)))))
419 (gnus-pull ',(intern gnus-draft-meta-information-header)
424 (intern gnus-draft-meta-information-header)
425 (gnus-inews-make-draft))
430 (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
432 (setq gnus-message-buffer (current-buffer))
433 (set (make-local-variable 'gnus-message-group-art)
435 (set (make-local-variable 'gnus-newsgroup-name) ,group)
436 (gnus-run-hooks 'gnus-message-setup-hook)
441 (gnus-make-local-hook 'kill-buffer-hook)
442 (gnus-make-local-hook 'change-major-mode-hook)
448 (gnus-add-buffer)
449 (gnus-configure-windows ,config t)
453 (defun gnus-inews-make-draft-meta-information (group article)
455 (if article (number-to-string
462 (defun gnus-msg-mail (&optional to subject other-headers continue
464 "Start editing a mail message to be sent.
465 Like `message-mail', but with Gnus paraphernalia, particularly the
469 mail-buf)
470 (gnus-setup-message 'message
471 (message-mail to subject other-headers continue
474 (setq mail-buf (current-buffer))
475 (switch-to-buffer buf)
476 (apply switch-action mail-buf nil)))
481 (defun gnus-button-mailto (address)
482 "Mail to ADDRESS."
483 (set-buffer (gnus-copy-article-buffer))
484 (gnus-setup-message 'message
488 (defun gnus-button-reply (&optional to-address wide)
491 (gnus-setup-message 'message
492 (message-reply to-address wide)))
495 (define-mail-user-agent 'gnus-user-agent
496 'gnus-msg-mail 'message-send-and-exit
499 (defun gnus-setup-posting-charset (group)
500 (let ((alist gnus-group-posting-charset-alist)
514 (defun gnus-inews-add-send-actions (winconf buffer article
516 (gnus-make-local-hook 'message-sent-hook)
517 (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
518 'gnus-inews-do-gcc) nil t)
519 (when gnus-agent
520 (gnus-make-local-hook 'message-header-hook)
521 (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
524 (gnus-post-method arg ,gnus-newsgroup-name)))
526 `(when (gnus-buffer-exists-p ,buffer)
529 (let ((to-be-marked (cond
536 `(when (gnus-buffer-exists-p ,buffer)
539 ,(when to-be-marked
541 `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
542 `(gnus-summary-mark-article-as-replied ',to-be-marked)))))
545 (put 'gnus-setup-message 'lisp-indent-function 1)
546 (put 'gnus-setup-message 'edebug-form-spec '(form body))
548 ;;; Post news commands of Gnus group mode and summary mode
550 (defun gnus-group-mail (&optional arg)
551 "Start composing a mail.
552 If ARG, use the group under the point to find a posting style.
553 If ARG is 1, prompt for a group name to find the posting style."
555 ;; We can't `let' gnus-newsgroup-name here, since that leads
556 ;; to local variables leaking.
557 (let ((group gnus-newsgroup-name)
559 (gnus-article-copy)
563 (setq gnus-newsgroup-name
567 gnus-active-hashtb nil
568 (gnus-read-active-file-p))
569 (gnus-group-group-name))
571 ;; #### see comment in gnus-setup-message -- drv
572 (gnus-setup-message 'message (message-mail)))
575 (setq gnus-newsgroup-name group)))))
577 (defun gnus-group-news (&optional arg)
579 If ARG, post to group under point.
580 If ARG is 1, prompt for group name to post to.
582 This function prepares a news even when using mail groups. This is useful
583 for posting messages to mail groups without actually sending them over the
586 ;; We can't `let' gnus-newsgroup-name here, since that leads
587 ;; to local variables leaking.
588 (let ((group gnus-newsgroup-name)
590 (gnus-article-copy)
594 (setq gnus-newsgroup-name
598 gnus-active-hashtb nil
599 (gnus-read-active-file-p))
600 (gnus-group-group-name))
602 ;; #### see comment in gnus-setup-message -- drv
603 (gnus-setup-message 'message
604 (message-news (gnus-group-real-name gnus-newsgroup-name))))
607 (setq gnus-newsgroup-name group)))))
609 (defun gnus-group-post-news (&optional arg)
611 If ARG, post to group under point. If ARG is 1, prompt for group name.
612 Depending on the selected group, the message might be either a mail or
615 ;; Bind this variable here to make message mode hooks work ok.
616 (let ((gnus-newsgroup-name
619 (completing-read "Newsgroup: " gnus-active-hashtb nil
620 (gnus-read-active-file-p))
621 (gnus-group-group-name))
624 (gnus-article-copy))
625 (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil
626 (string= gnus-newsgroup-name ""))))
628 (defun gnus-summary-mail-other-window (&optional arg)
629 "Start composing a mail in another window.
631 If ARG, don't do that. If ARG is 1, prompt for group name to find the
634 ;; We can't `let' gnus-newsgroup-name here, since that leads
635 ;; to local variables leaking.
636 (let ((group gnus-newsgroup-name)
638 (gnus-article-copy)
642 (setq gnus-newsgroup-name
646 gnus-active-hashtb nil
647 (gnus-read-active-file-p))
649 gnus-newsgroup-name))
650 ;; #### see comment in gnus-setup-message -- drv
651 (gnus-setup-message 'message (message-mail)))
654 (setq gnus-newsgroup-name group)))))
656 (defun gnus-summary-news-other-window (&optional arg)
658 Post to the current group by default.
659 If ARG, don't do that. If ARG is 1, prompt for group name to post to.
661 This function prepares a news even when using mail groups. This is useful
662 for posting messages to mail groups without actually sending them over the
665 ;; We can't `let' gnus-newsgroup-name here, since that leads
666 ;; to local variables leaking.
667 (let ((group gnus-newsgroup-name)
669 (gnus-article-copy)
673 (setq gnus-newsgroup-name
677 gnus-active-hashtb nil
678 (gnus-read-active-file-p))
680 gnus-newsgroup-name))
681 ;; #### see comment in gnus-setup-message -- drv
682 (gnus-setup-message 'message
684 (message-news (gnus-group-real-name gnus-newsgroup-name))
685 (set (make-local-variable 'gnus-discouraged-post-methods)
687 (car (gnus-find-method-for-group gnus-newsgroup-name))
688 (copy-sequence gnus-discouraged-post-methods))))))
691 (setq gnus-newsgroup-name group)))))
693 (defun gnus-summary-post-news (&optional arg)
694 "Start composing a message. Post to the current group by default.
695 If ARG, don't do that. If ARG is 1, prompt for a group name to post to.
696 Depending on the selected group, the message might be either a mail or
699 ;; Bind this variable here to make message mode hooks work ok.
700 (let ((gnus-newsgroup-name
703 (completing-read "Newsgroup: " gnus-active-hashtb nil
704 (gnus-read-active-file-p))
706 gnus-newsgroup-name))
708 (gnus-article-copy))
709 (gnus-post-news 'post gnus-newsgroup-name)))
712 (defun gnus-summary-followup (yank &optional force-news)
713 "Compose a followup to an article.
717 article number, and the cdr is the string to be yanked."
720 (gnus-summary-work-articles 1))))
722 (gnus-summary-goto-subject
727 (gnus-summary-select-article))
728 (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
729 (gnus-newsgroup-name gnus-newsgroup-name))
730 ;; Send a followup.
731 (gnus-post-news nil gnus-newsgroup-name
732 headers gnus-article-buffer
734 (gnus-summary-handle-replysign)))
736 (defun gnus-summary-followup-with-original (n &optional force-news)
737 "Compose a followup to an article and include the original article.
741 (gnus-summary-followup (gnus-summary-work-articles n) force-news))
743 (defun gnus-summary-followup-to-mail (&optional arg)
744 "Followup to the current mail message via news."
747 (gnus-summary-work-articles 1))))
748 (gnus-summary-followup arg t))
750 (defun gnus-summary-followup-to-mail-with-original (&optional arg)
751 "Followup to the current mail message via news."
753 (gnus-summary-followup (gnus-summary-work-articles arg) t))
755 (defun gnus-inews-yank-articles (articles)
763 (set-buffer gnus-summary-buffer)
764 (gnus-summary-select-article nil nil nil article)
765 (gnus-summary-remove-process-mark article))
766 (gnus-copy-article-buffer nil yank-string)
767 (let ((message-reply-buffer gnus-article-copy)
770 (with-current-buffer gnus-article-copy
772 (nnheader-narrow-to-headers)
782 (defun gnus-summary-cancel-article (&optional n symp)
787 (interactive (gnus-interactive "P\ny"))
788 (let ((articles (gnus-summary-work-articles n))
791 (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
794 (when (gnus-summary-select-article t nil nil article)
795 (when (gnus-eval-in-buffer-window gnus-original-article-buffer
797 (gnus-summary-mark-as-read article gnus-canceled-mark)
798 (gnus-cache-remove-article 1))
799 (gnus-article-hide-headers-if-wanted))
800 (gnus-summary-remove-process-mark article))))
802 (defun gnus-summary-supersede-article ()
807 (let ((article (gnus-summary-article-number)))
808 (gnus-setup-message 'reply-yank
809 (gnus-summary-select-article t)
810 (set-buffer gnus-original-article-buffer)
814 (when (gnus-buffer-exists-p ,gnus-summary-buffer)
816 (set-buffer ,gnus-summary-buffer)
817 (gnus-cache-possibly-remove-article ,article nil nil nil t)
818 (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
824 (defun gnus-copy-article-buffer (&optional article-buffer yank-string)
826 ;; this copy is in the buffer gnus-article-copy.
827 ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
828 ;; this buffer should be passed to all mail/news reply/post routines.
829 (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
831 (set-buffer gnus-article-copy)
833 (let ((article-buffer (or article-buffer gnus-article-buffer))
836 (gnus-buffer-exists-p article-buffer)))
840 (let ((gnus-newsgroup-charset (or gnus-article-charset
841 gnus-newsgroup-charset))
842 (gnus-newsgroup-ignored-charsets
843 (or gnus-article-ignored-charsets
844 gnus-newsgroup-ignored-charsets)))
849 (copy-to-buffer gnus-article-copy (point-min) (point-max))
850 (set-buffer gnus-article-copy)
855 (gnus-article-delete-text-of-type 'annotation)
856 (gnus-article-delete-text-of-type 'multipart)
857 (gnus-remove-text-with-property 'gnus-prev)
858 (gnus-remove-text-with-property 'gnus-next)
859 (gnus-remove-text-with-property 'gnus-decoration)
865 (set-buffer gnus-original-article-buffer)
867 (while (looking-at message-unix-mail-delimiter)
869 (let ((mail-header-separator ""))
875 (set-buffer gnus-article-copy)
876 (let ((mail-header-separator ""))
880 (insert-buffer-substring gnus-original-article-buffer beg end)
882 (let ((gnus-article-decode-hook
884 (copy-sequence gnus-article-decode-hook)))
886 (run-hooks 'gnus-article-decode-hook)))))
887 gnus-article-copy)))
889 (defun gnus-post-news (post &optional group header article-buffer yank subject
892 (gnus-copy-article-buffer))
893 (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
894 (gnus-article-yanked-articles yank)
895 (add-to-list gnus-add-to-list))
896 (gnus-setup-message (cond (yank 'reply-yank)
899 (let* ((group (or group gnus-newsgroup-name))
900 (charset (gnus-group-name-charset nil group))
902 to-address to-group mailing-list to-list
905 (setq to-address (gnus-parameter-to-address group)
906 to-group (gnus-group-find-parameter group 'to-group)
907 to-list (gnus-parameter-to-list group)
908 newsgroup-p (gnus-group-find-parameter group 'newsgroup)
909 mailing-list (when gnus-mailing-list-groups
910 (string-match gnus-mailing-list-groups group))
911 group (gnus-group-name-decode (gnus-group-real-name group)
913 (if (or (and to-group
914 (gnus-news-group-p to-group))
917 (and (gnus-news-group-p
918 (or pgroup gnus-newsgroup-name)
919 (or header gnus-current-article))
921 (not to-list)
922 (not to-address)))
926 (or to-group
927 (and (not (gnus-virtual-group-p pgroup)) group)))
928 (set-buffer gnus-article-copy)
929 (gnus-msg-treat-broken-reply-to)
930 (message-followup (if (or newsgroup-p force-news)
932 (article-narrow-to-head)
936 to-group)))
937 ;; The is mail.
940 (message-mail (or to-address to-list))
941 ;; Arrange for mail groups that have no `to-address' to
942 ;; get that when the user sends off the mail.
943 (when (and (not to-list)
944 (not to-address)
945 add-to-list)
946 (push (list 'gnus-inews-add-to-address pgroup)
948 (set-buffer gnus-article-copy)
949 (gnus-msg-treat-broken-reply-to)
950 (message-wide-reply to-address)))
952 (gnus-inews-yank-articles yank))))))
954 (defun gnus-msg-treat-broken-reply-to (&optional force)
955 "Remove the Reply-to header if broken-reply-to."
957 (gnus-group-find-parameter
958 gnus-newsgroup-name 'broken-reply-to))
960 (message-narrow-to-head)
961 (message-remove-header "reply-to"))))
963 (defun gnus-post-method (arg group &optional silent)
966 (let ((gnus-post-method (or (gnus-parameter-post-method group)
967 gnus-post-method))
968 (group-method (gnus-find-method-for-group group)))
973 (or (and (listp gnus-post-method) ;If not current/native/nil
974 (not (listp (car gnus-post-method))) ; and not a list of methods
975 gnus-post-method) ;then use it.
976 gnus-select-method
980 (if (eq gnus-post-method 'current)
981 gnus-select-method
985 (and (listp gnus-post-method)
986 (listp (car gnus-post-method))))
990 (when (listp gnus-post-method)
991 (if (listp (car gnus-post-method))
992 gnus-post-method
993 (list gnus-post-method)))
994 gnus-secondary-select-methods
995 (mapcar 'cdr gnus-server-alist)
996 (mapcar 'car gnus-opened-servers)
997 (list gnus-select-method)
1000 ;; Weed out all mail methods.
1002 (setq method (gnus-server-get-method "" (pop methods)))
1003 (when (and (or (gnus-method-option-p method 'post)
1004 (gnus-method-option-p method 'post-mail))
1018 (setq gnus-last-posting-server
1020 gnus-last-posting-server)
1022 gnus-last-posting-server
1025 (cons (or gnus-last-posting-server "") 0))))
1028 ((and (eq gnus-post-method 'current)
1029 (not (memq (car group-method) gnus-discouraged-post-methods))
1030 (gnus-get-function group-method 'request-post t))
1033 ;; Use gnus-post-method.
1034 ((listp gnus-post-method) ;A method...
1035 (assert (not (listp (car gnus-post-method)))) ;... not a list of methods.
1036 gnus-post-method)
1038 (t gnus-select-method))))
1043 (defun gnus-extended-version ()
1045 See the variable `gnus-user-agent'."
1047 (if (stringp gnus-user-agent)
1048 gnus-user-agent
1049 ;; `gnus-user-agent' is a list:
1051 (gnus-v
1052 (when (memq 'gnus gnus-user-agent)
1054 (prin1-to-string (gnus-continuum-version gnus-version) t)
1055 " (" gnus-version ")")))
1056 (emacs-v (gnus-emacs-version)))
1057 (concat gnus-v (when (and gnus-v emacs-v) " ")
1066 ;;; Mail reply commands of Gnus summary mode
1068 (defun gnus-summary-reply (&optional yank wide very-wide)
1069 "Start composing a mail reply to the current message.
1076 (gnus-summary-work-articles 1))))
1077 ;; Allow user to require confirmation before replying by mail to the
1078 ;; author of a news article (or mail message).
1080 (not (or (gnus-news-group-p gnus-newsgroup-name)
1081 gnus-confirm-treat-mail-like-news))
1082 (not (cond ((stringp gnus-confirm-mail-reply-to-news)
1083 (string-match gnus-confirm-mail-reply-to-news
1084 gnus-newsgroup-name))
1085 ((functionp gnus-confirm-mail-reply-to-news)
1086 (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
1087 (t gnus-confirm-mail-reply-to-news)))
1088 (y-or-n-p "Really reply by mail to article author? "))
1093 (gnus-article-reply (or article (gnus-summary-article-number)))
1094 (gnus-article-yanked-articles yank)
1096 ;; Stripping headers should be specified with mail-yank-ignored-headers.
1098 (gnus-summary-goto-subject article))
1099 (gnus-setup-message (if yank 'reply-yank 'reply)
1101 (gnus-summary-select-article)
1103 (gnus-summary-select-article nil nil nil article)
1105 (set-buffer (gnus-copy-article-buffer))
1106 (gnus-msg-treat-broken-reply-to)
1108 (message-narrow-to-head)
1110 (set-buffer (gnus-copy-article-buffer))
1111 (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
1113 (message-narrow-to-head)
1121 (gnus-inews-yank-articles yank))
1122 (gnus-summary-handle-replysign)))))
1124 (defun gnus-summary-handle-replysign ()
1126 (when (or gnus-message-replysign gnus-message-replyencrypt)
1129 (set-buffer gnus-article-buffer)
1130 (setq signed (memq 'signed gnus-article-wash-types))
1131 (setq encrypted (memq 'encrypted gnus-article-wash-types)))
1132 (cond ((and gnus-message-replyencrypt encrypted)
1134 (if gnus-message-replysignencrypted
1137 ((and gnus-message-replysign signed)
1140 (defun gnus-summary-reply-with-original (n &optional wide)
1141 "Start composing a reply mail to the current message.
1144 (gnus-summary-reply (gnus-summary-work-articles n) wide))
1146 (defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
1147 "Like `gnus-summary-reply' except removing reply-to field.
1154 (gnus-summary-work-articles 1))))
1155 (let ((gnus-msg-force-broken-reply-to t))
1156 (gnus-summary-reply yank wide very-wide)))
1158 (defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
1159 "Like `gnus-summary-reply-with-original' except removing reply-to field.
1162 (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
1164 (defun gnus-summary-wide-reply (&optional yank)
1165 "Start composing a wide reply mail to the current message.
1170 (gnus-summary-work-articles 1))))
1171 (gnus-summary-reply yank t))
1173 (defun gnus-summary-wide-reply-with-original (n)
1174 "Start composing a wide reply mail to the current message.
1178 (gnus-summary-reply-with-original n t))
1180 (defun gnus-summary-very-wide-reply (&optional yank)
1181 "Start composing a very wide reply mail to the current message.
1186 (gnus-summary-work-articles 1))))
1187 (gnus-summary-reply yank t (gnus-summary-work-articles yank)))
1189 (defun gnus-summary-very-wide-reply-with-original (n)
1190 "Start composing a very wide reply mail to the current message.
1193 (gnus-summary-reply
1194 (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
1196 (defun gnus-summary-mail-forward (&optional arg post)
1197 "Forward the current message(s) to another user.
1205 If POST, post instead of mail.
1209 (if (cdr (gnus-summary-work-articles nil))
1211 (gnus-uu-digest-mail-forward arg post)
1231 (let* ((gnus-article-reply (gnus-summary-article-number))
1232 (gnus-article-yanked-articles (list gnus-article-reply)))
1233 (gnus-setup-message 'forward
1234 (gnus-summary-select-article)
1235 (let ((mail-parse-charset
1236 (or (and (gnus-buffer-live-p gnus-article-buffer)
1237 (with-current-buffer gnus-article-buffer
1238 gnus-article-charset))
1239 gnus-newsgroup-charset))
1240 (mail-parse-ignored-charsets
1241 gnus-newsgroup-ignored-charsets))
1242 (set-buffer gnus-original-article-buffer)
1245 (defun gnus-summary-resend-message (address n)
1246 "Resend the current article to ADDRESS."
1249 "Resend message(s) to: "
1250 (when (and gnus-summary-resend-default-address
1251 (gnus-buffer-live-p gnus-original-article-buffer))
1255 (with-current-buffer gnus-original-article-buffer
1256 (nnmail-fetch-field "to"))))
1258 (let ((articles (gnus-summary-work-articles n))
1261 (gnus-summary-select-article nil nil nil article)
1263 (set-buffer gnus-original-article-buffer)
1265 (gnus-summary-mark-article-as-forwarded article))))
1268 (defun gnus-summary-resend-message-edit ()
1270 A new buffer will be created to allow the user to modify body and
1274 (let ((article (gnus-summary-article-number)))
1275 (gnus-setup-message 'reply-yank
1276 (gnus-summary-select-article t)
1277 (set-buffer gnus-original-article-buffer)
1279 (to (message-fetch-field "to")))
1281 (message-pop-to-buffer (message-buffer-name "Resend" to))
1283 (mime-to-mml)
1284 (message-narrow-to-head-1)
1290 (insert mail-header-separator)
1296 (defun gnus-summary-post-forward (&optional arg)
1297 "Forward the current article to a newsgroup.
1298 See `gnus-summary-mail-forward' for ARG."
1300 (gnus-summary-mail-forward arg t))
1302 (defvar gnus-nastygram-message
1303 "The following article was inappropriately posted to %s.\n\n"
1304 "Format string to insert in nastygrams.
1307 (defun gnus-summary-mail-nastygram (n)
1308 "Send a nastygram to the author of the current article."
1310 (when (or gnus-expert-user
1311 (gnus-y-or-n-p
1312 "Really send a nastygram to the author of the current article? "))
1313 (let ((group gnus-newsgroup-name))
1314 (gnus-summary-reply-with-original n)
1315 (set-buffer gnus-message-buffer)
1317 (insert (format gnus-nastygram-message group))
1320 (defun gnus-summary-mail-crosspost-complaint (n)
1321 "Send a complaint about crossposting to the current article(s)."
1323 (let ((articles (gnus-summary-work-articles n))
1326 (set-buffer gnus-summary-buffer)
1327 (gnus-summary-goto-subject article)
1328 (let ((group (gnus-group-real-name gnus-newsgroup-name))
1329 newsgroups followup-to)
1330 (gnus-summary-select-article)
1331 (set-buffer gnus-original-article-buffer)
1334 (mail-fetch-field "newsgroups"))
1337 (or (not (setq followup-to (mail-fetch-field "followup-to")))
1339 followup-to ", ")))))
1340 (if followup-to
1341 (gnus-message 1 "Followup-to restricted")
1342 (gnus-message 1 "Not a crossposted article"))
1343 (set-buffer gnus-summary-buffer)
1344 (gnus-summary-reply-with-original 1)
1345 (set-buffer gnus-message-buffer)
1347 (insert (format gnus-crosspost-complaint newsgroups group))
1351 (gnus-deactivate-mark)
1352 (when (gnus-y-or-n-p "Send this complaint? ")
1355 (defun gnus-mail-parse-comma-list ()
1366 (narrow-to-region beg (point))
1382 (defun gnus-inews-add-to-address (group)
1383 (let ((to-address (mail-fetch-field "to")))
1384 (when (and to-address
1385 (gnus-alive-p))
1386 ;; This mail group doesn't have a `to-list', so we add one
1388 (when (gnus-y-or-n-p
1389 (format "Do you want to add this as `to-list': %s? " to-address))
1390 (gnus-group-add-parameter group (cons 'to-list to-address))))))
1392 (defun gnus-put-message ()
1393 "Put the current message in some group and return to Gnus."
1395 (let ((reply gnus-article-reply)
1396 (winconf gnus-prev-winconf)
1397 (group gnus-newsgroup-name))
1399 (not (gnus-group-read-only-p group)))
1400 (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
1402 (when (gnus-gethash group gnus-newsrc-hashtb)
1407 (message-narrow-to-headers)
1408 (let ((gnus-deletable-headers nil))
1412 message-required-mail-headers)))
1418 (gnus-inews-do-gcc)
1419 (when (and (get-buffer gnus-group-buffer)
1420 (gnus-buffer-exists-p (car-safe reply))
1423 (gnus-summary-mark-article-as-replied (cdr reply)))
1427 (defun gnus-article-mail (yank)
1428 "Send a reply to the address near point.
1436 (gnus-msg-mail address)
1438 (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
1441 (defun gnus-bug ()
1442 "Send a bug report to the Gnus maintainers."
1444 (unless (gnus-alive-p)
1446 (gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
1447 (unless (message-mail-user-agent)
1449 (when gnus-bug-create-help-buffer
1450 (switch-to-buffer "*Gnus Help Bug*")
1452 (insert gnus-bug-message)
1454 (message-pop-to-buffer "*Gnus Bug*"))
1455 (let ((message-this-is-mail t))
1456 (message-setup `((To . ,gnus-maintainer) (Subject . ""))))
1457 (when gnus-bug-create-help-buffer
1458 (push `(gnus-bug-kill-buffer) message-send-actions))
1460 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
1462 (insert (gnus-version) "\n"
1470 (set-buffer (gnus-get-buffer-create " *gnus environment info*"))
1472 (gnus-debug)
1479 (defun gnus-bug-kill-buffer ()
1483 (defun gnus-summary-yank-message (buffer n)
1488 (gnus-summary-iterate n
1489 (let ((gnus-inhibit-treatment t))
1490 (gnus-summary-select-article))
1493 (message-yank-buffer gnus-article-buffer))))
1495 (defun gnus-debug ()
1496 "Attempts to go through the Gnus source file and report what variables have been changed.
1497 The source file has to be in the Emacs load path."
1499 (let ((files gnus-debug-files)
1502 (gnus-message 4 "Please wait while we snoop your variables...")
1506 (set-buffer (gnus-get-buffer-create " *gnus bug info*"))
1514 (gnus-message 4 "Malformed sources in file %s" file)
1515 (narrow-to-region (point-min) (point))
1522 (not (memq (nth 1 expr) gnus-debug-exclude-variables))
1533 (gnus-pp
1544 ;; Remove any control chars - they seem to cause trouble for some
1549 (replace-match (format "\\%03o" (string-to-char (match-string 0)))
1553 ;;; Bounced mail.
1555 (defun gnus-summary-resend-bounced-mail (&optional fetch)
1556 "Re-mail the current message.
1558 contains some mail you have written which has been bounced back to
1560 If FETCH, try to fetch the article that this is a reply to, if indeed
1563 (gnus-summary-select-article t)
1564 (set-buffer gnus-original-article-buffer)
1565 (gnus-setup-message 'compose-bounce
1566 (let* ((references (mail-fetch-field "references"))
1567 (parent (and references (gnus-parent-id references))))
1569 ;; If there are references, we fetch the article we answered to.
1571 (gnus-summary-refer-article parent)
1572 (gnus-summary-show-all-headers)))))
1576 (defun gnus-inews-group-method (group)
1580 ((and (null (gnus-get-info group))
1581 (eq (car (gnus-server-to-method gnus-message-archive-method))
1582 (car (gnus-server-to-method (gnus-group-method group)))))
1583 gnus-message-archive-method)
1585 ((gnus-info-method (gnus-get-info group))
1586 (gnus-info-method (gnus-get-info group)))
1588 (t (gnus-server-to-method (gnus-group-method group)))))
1590 ;; Do Gcc handling, which copied the message over to some group.
1591 (defun gnus-inews-do-gcc (&optional gcc)
1595 (message-narrow-to-headers)
1596 (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
1605 ;; Copy the article over to some group(s).
1607 (unless (gnus-check-server
1608 (setq method (gnus-inews-group-method group)))
1611 (unless (gnus-request-group group nil method)
1612 (gnus-request-create-group group method))
1614 (if (stringp gnus-gcc-externalize-attachments)
1615 (string-match gnus-gcc-externalize-attachments group)
1616 gnus-gcc-externalize-attachments))
1622 (message-narrow-to-headers)
1623 (let* ((mail-parse-charset message-default-charset)
1625 (message-narrow-to-headers-or-head)
1627 (followup-field (save-restriction
1628 (message-narrow-to-headers-or-head)
1630 ;; BUG: We really need to get the charset for
1632 ;; lines to allow crossposting between group
1636 (gnus-group-name-charset
1638 (followup-field-charset
1639 (gnus-group-name-charset
1640 method (or followup-field "")))
1645 (when followup-field-charset
1646 (list (cons "Followup-To" followup-field-charset)))
1648 (mail-encode-encoded-word-buffer)))
1651 (concat "^" (regexp-quote mail-header-separator) "$")
1655 (gnus-request-accept-article group method t t))
1656 (gnus-message 1 "Couldn't store article in group %s: %s"
1657 group (gnus-status-message method))
1662 (gnus-alive-p)
1663 (or gnus-gcc-mark-as-read
1665 (boundp 'gnus-inews-mark-gcc-as-read)
1666 (symbol-value 'gnus-inews-mark-gcc-as-read))))
1667 (gnus-group-mark-article-read group (cdr group-art)))
1670 (defun gnus-inews-insert-gcc ()
1671 "Insert Gcc headers based on `gnus-outgoing-message-group'."
1674 (message-narrow-to-headers)
1675 (let* ((group gnus-outgoing-message-group)
1694 (defun gnus-inews-insert-archive-gcc (&optional group)
1695 "Insert the Gcc to say where the article is to be archived."
1696 (let* ((var gnus-message-archive-group)
1697 (group (or group gnus-newsgroup-name ""))
1699 (and gnus-newsgroup-name
1700 (not (equal gnus-newsgroup-name ""))
1701 (gnus-group-find-parameter
1702 gnus-newsgroup-name 'gcc-self)))
1706 ((null gnus-message-archive-method)
1744 (message-narrow-to-headers)
1757 (let ((group (or (gnus-group-find-parameter
1758 gnus-newsgroup-name 'parent-group)
1765 (gnus-delete-line)))
1770 (gnus-group-prefixed-name
1771 name gnus-message-archive-method))))
1779 (defun gnus-mailing-list-followup-to ()
1781 (let ((x-been-there (gnus-fetch-original-field "x-beenthere"))
1782 (list-post (gnus-fetch-original-field "list-post")))
1791 (defun gnus-configure-posting-styles (&optional group-name)
1792 "Configure posting styles according to `gnus-posting-styles'."
1793 (unless gnus-inhibit-posting-styles
1794 (let ((group (or group-name gnus-newsgroup-name ""))
1795 (styles gnus-posting-styles)
1799 ;; regexp matching everything, to be sure it takes precedence over all
1801 (when gnus-newsgroup-name
1802 (let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
1815 (and (gnus-buffer-live-p gnus-article-copy)
1816 (with-current-buffer gnus-article-copy
1818 (nnheader-narrow-to-headers)
1826 ;; Function to be called.
1829 ;; Variable to be checked.
1835 (and (gnus-buffer-live-p gnus-article-copy)
1836 (with-current-buffer gnus-article-copy
1838 (nnheader-narrow-to-headers)
1843 ;; This is a form to be evaled.
1896 (gnus-make-local-hook 'message-setup-hook)
1937 (set (make-local-variable 'user-mail-address)
1938 ,(or (cdr address) user-mail-address))
1940 (user-mail-address
1941 ,(or (cdr address) user-mail-address)))
1950 (gnus-ems-redefine)
1952 (provide 'gnus-msg)
1955 ;;; gnus-msg.el ends here