-;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;;; gnus-msg.el --- mail and post interface for Semi-gnus
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
+;; Kiyokazu SUTO <suto@merry.xmath.ous.ac.jp>
+;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
;;; Code:
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
(require 'gnus)
(require 'gnus-ems)
of names)."
:group 'gnus-message
:type '(choice (string :tag "Group")
- (function)))
+ (function)))
(defcustom gnus-mailing-list-groups nil
"*Regexp matching groups that are really mailing lists.
See Info node `(gnus)Posting Styles'."
:group 'gnus-message
:type '(repeat (cons (choice (regexp)
- (function)
(variable)
+ (list (const header)
+ (string :tag "Header")
+ (regexp :tag "Regexp"))
+ (function)
(sexp))
(repeat (list
(choice (const signature)
(const signature-file)
(const organization)
(const address)
+ (const x-face-file)
(const name)
(const body)
+ (symbol)
(string :tag "Header"))
(choice (string)
(function)
(variable)
(sexp)))))))
-(defcustom gnus-inews-mark-gcc-as-read nil
+(defcustom gnus-gcc-mark-as-read nil
"If non-nil, automatically mark Gcc articles as read."
+ :version "21.1"
:group 'gnus-message
:type 'boolean)
+(defvar gnus-inews-mark-gcc-as-read nil
+ "Obsolete variable. Use `gnus-gcc-mark-as-read' instead.")
+
+(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
+ 'gnus-gcc-mark-as-read)
+
+(defcustom gnus-gcc-externalize-attachments nil
+ "Should local-file attachments be included as external parts in Gcc copies?
+If it is `all', attach files as external parts;
+if a regexp and matches the Gcc group name, attach files as external parts;
+If nil, attach files as normal parts."
+ :version "21.1"
+ :group 'gnus-message
+ :type '(choice (const nil :tag "None")
+ (const all :tag "Any")
+ (string :tag "Regexp")))
+
(defcustom gnus-group-posting-charset-alist
'(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
Note that any value other than nil for HEADER infringes some RFCs, so
use this option with care."
:type '(repeat (list :tag "Permitted unencoded charsets"
- (choice :tag "Where"
- (regexp :tag "Group")
- (const :tag "Mail message" :value message-this-is-mail)
- (const :tag "News article" :value message-this-is-news))
- (choice :tag "Header"
- (const :tag "None" nil)
- (symbol :tag "Charset"))
- (choice :tag "Body"
- (const :tag "Any" :value t)
- (const :tag "None" :value nil)
- (repeat :tag "Charsets"
- (symbol :tag "Charset")))))
+ (choice :tag "Where"
+ (regexp :tag "Group")
+ (const :tag "Mail message"
+ :value message-this-is-mail)
+ (const :tag "News article"
+ :value message-this-is-news))
+ (choice :tag "Header"
+ (const :tag "None" nil)
+ (symbol :tag "Charset"))
+ (choice :tag "Body"
+ (const :tag "Any" :value t)
+ (const :tag "None" :value nil)
+ (repeat :tag "Charsets"
+ (symbol :tag "Charset")))))
:group 'gnus-charset)
+(defcustom gnus-debug-files
+ '("gnus.el" "gnus-sum.el" "gnus-group.el"
+ "gnus-art.el" "gnus-start.el" "gnus-async.el"
+ "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
+ "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
+ "mm-util.el" "mm-decode.el" "nnmail.el" "nntp.el" "message.el")
+ "Files whose variables will be reported in `gnus-bug'."
+ :version "21.1"
+ :group 'gnus-message
+ :type '(repeat (string :tag "File")))
+
+(defcustom gnus-debug-exclude-variables
+ '(mm-mime-mule-charset-alist
+ nnmail-split-fancy message-minibuffer-local-map)
+ "Variables that should not be reported in `gnus-bug'."
+ :version "21.1"
+ :group 'gnus-message
+ :type '(repeat (symbol :tag "Variable")))
+
+(defcustom gnus-discouraged-post-methods
+ '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
+ "A list of back ends that are not used in \"real\" newsgroups.
+This variable is used only when `gnus-post-method' is `current'."
+ :version "21.3"
+ :group 'gnus-group-foreign
+ :type '(repeat (symbol :tag "Back end")))
+
+(defcustom gnus-message-replysign
+ nil
+ "Automatically sign replys to signed messages.
+See also the `mml-default-sign-method' variable."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-replyencrypt
+ nil
+ "Automatically encrypt replys to encrypted messages.
+See also the `mml-default-encrypt-method' variable."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-message-replysignencrypted
+ t
+ "Setting this causes automatically encryped messages to also be signed."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-confirm-mail-reply-to-news nil
+ "If non-nil, Gnus requests confirmation when replying to news.
+This is done because new users often reply by mistake when reading
+news."
+ :group 'gnus-message
+ :type 'boolean)
+
+(defcustom gnus-summary-resend-default-address t
+ "If non-nil, Gnus tries to suggest a default address to resend to.
+If nil, the address field will always be empty after invoking
+`gnus-summary-resend-message'."
+ :group 'gnus-message
+ :type 'boolean)
+
;;; Internal variables.
(defvar gnus-inhibit-posting-styles nil
(defvar gnus-msg-force-broken-reply-to nil)
(defconst gnus-bug-message
- "Sending a bug report to the Gnus Towers.
+ (format "Sending a bug report to the Gnus Towers.
+========================================
+
+This gnus is the %s%s.
+If you think the bug is a Semi-gnus bug, send a bug report to Semi-gnus
+Developers. (the addresses below are mailing list addresses)
+
========================================
The buffer below is a mail buffer. When you press `C-c C-c', it will
Please describe the bug in annoying, painstaking detail.
Thank you for your help in stamping out bugs.
-")
+"
+ gnus-product-name
+ (if (string= gnus-product-name "Semi-gnus")
+ ""
+ ", a modified version of Semi-gnus")))
(eval-and-compile
(autoload 'gnus-uu-post-news "gnus-uu" nil t)
"w" gnus-summary-wide-reply
"W" gnus-summary-wide-reply-with-original
"v" gnus-summary-very-wide-reply
- "W" gnus-summary-very-wide-reply-with-original
+ "V" gnus-summary-very-wide-reply-with-original
"n" gnus-summary-followup-to-mail
"N" gnus-summary-followup-to-mail-with-original
"m" gnus-summary-mail-other-window
"BR" gnus-summary-reply-broken-reply-to-with-original
"om" gnus-summary-mail-forward
"op" gnus-summary-post-forward
- "Om" gnus-uu-digest-mail-forward
- "Op" gnus-uu-digest-post-forward)
+ "Om" gnus-summary-digest-mail-forward
+ "Op" gnus-summary-digest-post-forward)
(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
;; "c" gnus-summary-send-draft
- "r" gnus-summary-resend-message)
+ "r" gnus-summary-resend-message
+ "e" gnus-summary-resend-message-edit)
;;; Internal functions.
(,group gnus-newsgroup-name)
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
- (mbl mml-buffer-list)
- (message-mode-hook (copy-sequence message-mode-hook)))
- (setq mml-buffer-list nil)
+ (message-mode-hook (copy-sequence message-mode-hook))
+ (message-startup-parameter-alist
+ '((reply-buffer . gnus-copy-article-buffer)
+ (original-buffer . gnus-original-article-buffer)
+ (user-agent . Gnus))))
(add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
(add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
;; #### FIXME: for a reason that I did not manage to identify yet,
(set (make-local-variable 'gnus-message-group-art)
(cons ,group ,article))
(set (make-local-variable 'gnus-newsgroup-name) ,group)
- (gnus-run-hooks 'gnus-message-setup-hook)
- (if (eq major-mode 'message-mode)
- (let ((mbl1 mml-buffer-list))
- (setq mml-buffer-list mbl) ;; Global value
- (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
- ;; LOCAL argument of add-hook differs between GNU Emacs
- ;; and XEmacs. make-local-hook makes sure they are local.
- (make-local-hook 'kill-buffer-hook)
- (make-local-hook 'change-major-mode-hook)
- (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
- (mml-destroy-buffers)
- (setq mml-buffer-list mbl)))
+ (gnus-maybe-setup-default-charset)
+ (gnus-run-hooks 'gnus-message-setup-hook))
(gnus-add-buffer)
(gnus-configure-windows ,config t)
(run-hooks 'post-command-hook)
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
- (setq message-newsreader (setq message-mailer (gnus-extended-version)))
- (message-add-action
- `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
+ (setq message-user-agent (gnus-extended-version))
+ (when (not message-use-multi-frames)
+ (message-add-action
+ `(set-window-configuration ,winconf) 'exit 'postpone 'kill))
(message-add-action
`(when (gnus-buffer-exists-p ,buffer)
(save-excursion
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
(let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
(buffer (current-buffer)))
(unwind-protect
(progn
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
(let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
(buffer (current-buffer)))
(unwind-protect
(progn
(completing-read "Newsgroup: " gnus-active-hashtb nil
(gnus-read-active-file-p))
(gnus-group-group-name))
- "")))
+ ""))
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy))
(gnus-post-news 'post gnus-newsgroup-name)))
(defun gnus-summary-mail-other-window (&optional arg)
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
(let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
(buffer (current-buffer)))
(unwind-protect
(progn
;; We can't `let' gnus-newsgroup-name here, since that leads
;; to local variables leaking.
(let ((group gnus-newsgroup-name)
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy)
(buffer (current-buffer)))
(unwind-protect
(progn
(completing-read "Newsgroup: " gnus-active-hashtb nil
(gnus-read-active-file-p))
"")
- gnus-newsgroup-name)))
+ gnus-newsgroup-name))
+ ;; make sure last viewed article doesn't affect posting styles:
+ (gnus-article-copy))
(gnus-post-news 'post gnus-newsgroup-name)))
(defun gnus-summary-followup (yank &optional force-news)
"Compose a followup to an article.
-If prefix argument YANK is non-nil, original article is yanked automatically."
+If prefix argument YANK is non-nil, the original article is yanked
+automatically.
+YANK is a list of elements, where the car of each element is the
+article number, and the two following numbers is the region to be
+yanked."
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
(when yank
- (gnus-summary-goto-subject (car yank)))
+ (gnus-summary-goto-subject
+ (if (listp (car yank))
+ (caar yank)
+ (car yank))))
(save-window-excursion
(gnus-summary-select-article))
(let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
;; Send a followup.
(gnus-post-news nil gnus-newsgroup-name
headers gnus-article-buffer
- yank nil force-news)))
+ yank nil force-news)
+ (gnus-summary-handle-replysign)))
(defun gnus-summary-followup-with-original (n &optional force-news)
"Compose a followup to an article and include the original article."
(gnus-summary-followup (gnus-summary-work-articles arg) t))
(defun gnus-inews-yank-articles (articles)
- (let (beg article)
+ (let (beg article yank-string
+ (more-than-one (cdr articles))
+ (cur (current-buffer))
+ refs window)
(message-goto-body)
(while (setq article (pop articles))
+ (when (listp article)
+ (setq yank-string (nth 1 article)
+ article (nth 0 article)))
(save-window-excursion
(set-buffer gnus-summary-buffer)
(gnus-summary-select-article nil nil nil article)
(gnus-summary-remove-process-mark article))
- (gnus-copy-article-buffer)
+
+ ;; Gathering references.
+ (when more-than-one
+ (setq refs (message-list-references
+ refs
+ (mail-header-references gnus-current-headers)
+ (mail-header-message-id gnus-current-headers)))
+ (when message-use-multi-frames
+ (when (setq window (get-buffer-window cur t))
+ (select-frame (window-frame window)))))
+
+ (gnus-copy-article-buffer nil yank-string)
(let ((message-reply-buffer gnus-article-copy)
(message-reply-headers
+ ;; The headers are decoded.
(with-current-buffer gnus-article-copy
- ;; The headers are decoded.
- (nnheader-parse-head t))))
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (ietf-drums-unfold-fws)
+ (nnheader-parse-head t)))))
(message-yank-original)
(setq beg (or beg (mark t))))
(when articles
(insert "\n")))
(push-mark)
+
+ ;; Replace with the gathered references.
+ (when refs
+ (push-mark beg)
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((case-fold-search t))
+ (if (re-search-forward "^References:\\([\t ]+.+\n\\)+" nil t)
+ (replace-match "")
+ (goto-char (point-max))))
+ (mail-header-format
+ (list (or (assq 'References message-header-format-alist)
+ '(References . message-shorten-references)))
+ (list (cons 'References
+ (mapconcat 'identity (nreverse refs) " "))))
+ (backward-delete-char 1))
+ (setq beg (mark t))
+ (pop-mark))
+
(goto-char beg)))
(defun gnus-summary-cancel-article (&optional n symp)
(let ((articles (gnus-summary-work-articles n))
(message-post-method
`(lambda (arg)
- (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name)))
+ (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
article)
(while (setq article (pop articles))
(when (gnus-summary-select-article t nil nil article)
- (when (gnus-eval-in-buffer-window gnus-original-article-buffer
- (message-cancel-news))
+ (when (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (message-cancel-news)))
(gnus-summary-mark-as-read article gnus-canceled-mark)
(gnus-cache-remove-article 1))
(gnus-article-hide-headers-if-wanted))
\f
-(defun gnus-copy-article-buffer (&optional article-buffer)
+(defun gnus-copy-article-buffer (&optional article-buffer yank-string)
;; make a copy of the article buffer with all text properties removed
;; this copy is in the buffer gnus-article-copy.
;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
;; this buffer should be passed to all mail/news reply/post routines.
(setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
- (save-excursion
- (set-buffer gnus-article-copy)
- (mm-enable-multibyte))
(let ((article-buffer (or article-buffer gnus-article-buffer))
end beg)
(if (not (and (get-buffer article-buffer)
;; Copy over the (displayed) article buffer, delete
;; hidden text and remove text properties.
(widen)
- (copy-to-buffer gnus-article-copy (point-min) (point-max))
- (set-buffer gnus-article-copy)
- (gnus-article-delete-text-of-type 'annotation)
- (gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next)
- (insert
- (prog1
- (buffer-substring-no-properties (point-min) (point-max))
- (erase-buffer)))
+ (let ((inhibit-read-only t))
+ (copy-to-buffer gnus-article-copy (point-min) (point-max))
+ (set-buffer gnus-article-copy)
+ (when yank-string
+ (message-goto-body)
+ (delete-region (point) (point-max))
+ (insert yank-string))
+ ;; Encode bitmap smileys to ordinary text.
+ ;; Possibly, the original text might be restored.
+ (static-unless (featurep 'xemacs)
+ (when (featurep 'smiley-mule)
+ (smiley-encode-buffer)))
+ (gnus-article-delete-text-of-type 'annotation)
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)
+ (gnus-remove-text-with-property 'gnus-decoration)
+ (gnus-remove-text-with-property 'x-face-mule-bitmap-image)
+ (insert
+ (prog1
+ (static-if (featurep 'xemacs)
+ ;; Revome smiley extents for (possibly) XEmacs 21.1.
+ (format "%s"
+ (buffer-substring-no-properties (point-min)
+ (point-max)))
+ (buffer-substring-no-properties (point-min) (point-max)))
+ (erase-buffer))))
;; Find the original headers.
(set-buffer gnus-original-article-buffer)
(goto-char (point-min))
(while (looking-at message-unix-mail-delimiter)
(forward-line 1))
- (setq beg (point))
- (setq end (or (message-goto-body) beg))
+ (setq beg (point)
+ end (or (message-goto-body) beg))
;; Delete the headers from the displayed articles.
(set-buffer gnus-article-copy)
(delete-region (goto-char (point-min))
(let ((gnus-article-decode-hook
(delq 'article-decode-charset
(copy-sequence gnus-article-decode-hook))))
+ ;; Needed for T-gnus.
+ (add-hook 'gnus-article-decode-hook
+ 'article-decode-encoded-words)
(run-hooks 'gnus-article-decode-hook)))))
gnus-article-copy)))
method-alist))))
;; Override normal method.
((and (eq gnus-post-method 'current)
- (not (eq (car group-method) 'nndraft))
+ (not (memq (car group-method) gnus-discouraged-post-methods))
(gnus-get-function group-method 'request-post t))
(assert (not arg))
group-method)
(t gnus-select-method))))
\f
-
-;; Dummies to avoid byte-compile warning.
-(eval-when-compile
- (defvar nnspool-rejected-article-hook)
- (defvar xemacs-codename))
-
-(defun gnus-extended-version ()
- "Stringified Gnus version and Emacs version."
- (interactive)
- (concat
- "Gnus/" (prin1-to-string (gnus-continuum-version gnus-version) t)
- " (" gnus-version ")"
- " "
- (cond
- ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
- (concat "Emacs/" (match-string 1 emacs-version)
- " (" system-configuration ")"))
- ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?"
- emacs-version)
- (concat (match-string 1 emacs-version)
- (format "/%d.%d" emacs-major-version emacs-minor-version)
- (if (match-beginning 3)
- (match-string 3 emacs-version)
- "")
- (if (boundp 'xemacs-codename)
- (concat " (" xemacs-codename ", " system-configuration ")")
- "")))
- (t emacs-version))))
+(defun gnus-message-make-user-agent (&optional include-mime-info max-column
+ newline-product)
+ "Return a user-agent info. If INCLUDE-MIME-INFO is non-nil and the
+variable `mime-edit-user-agent-value' is bound, the value will be
+included in the return value. If MAX-COLUMN is specified, the return
+value will be folded up as it were filled. NEWLINE-PRODUCT specifies
+whether a newline should be inserted in front of each product-token.
+If the value is t or `hard', it works strictly. Otherwise, if it is
+non-nil (e.g. `soft'), it works semi-strictly.
+
+Here is an example of how to use this function:
+
+\(add-hook 'gnus-message-setup-hook
+ (lambda nil
+ (setq message-user-agent nil)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (goto-char (point-max))
+ (insert \"User-Agent: \"
+ (gnus-message-make-user-agent t 76 'soft)
+ \"\\n\")))))
+"
+ (let ((user-agent (if (and include-mime-info
+ (boundp 'mime-edit-user-agent-value))
+ (concat (gnus-extended-version)
+ " "
+ mime-edit-user-agent-value)
+ (gnus-extended-version))))
+ (when max-column
+ (unless (natnump max-column)
+ (setq max-column 76))
+ (with-temp-buffer
+ (set-buffer-multibyte t)
+ (insert (mapconcat 'identity (split-string user-agent) " "))
+ (goto-char (point-min))
+ (let ((bol t)
+ start agent agents width element swidth)
+ (while (re-search-forward "\\([^ ]+\\) ?" nil t)
+ (setq start (match-beginning 0))
+ (if (eq (char-after start) ?\()
+ (progn
+ (goto-char start)
+ (forward-list)
+ (push (buffer-substring start (point)) agent))
+ (when agent
+ (push (nreverse agent) agents))
+ (setq agent (list (match-string 1)))))
+ (when agent
+ (push (nreverse agent) agents))
+ (setq agents (nreverse agents))
+ (if (> (+ 12 (string-width (caar agents))) max-column)
+ (setq user-agent "\n"
+ width 0)
+ (setq user-agent ""
+ width 11))
+ (while agents
+ (setq agent (car agents)
+ agents (cdr agents))
+ (when (and (not bol)
+ (or (memq newline-product '(t hard))
+ (and newline-product
+ (> (+ width 1
+ (string-width (mapconcat 'identity
+ agent " ")))
+ max-column))))
+ (setq user-agent (concat user-agent "\n")
+ width 0
+ bol t))
+ (while agent
+ (setq element (car agent)
+ swidth (string-width element)
+ agent (cdr agent))
+ (if bol
+ (setq user-agent (if (member user-agent '("" "\n"))
+ (concat user-agent element)
+ (concat user-agent " " element))
+ width (+ width 1 swidth)
+ bol nil)
+ (if (> (+ width 1 swidth) max-column)
+ (setq user-agent (concat user-agent "\n " element)
+ width (1+ swidth))
+ (setq user-agent (concat user-agent " " element)
+ width (+ width 1 swidth)))))))))
+ user-agent))
\f
;;;
(interactive
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
- ;; Stripping headers should be specified with mail-yank-ignored-headers.
- (when yank
- (gnus-summary-goto-subject (car yank)))
- (let ((gnus-article-reply (or yank (gnus-summary-article-number)))
- (headers ""))
- (gnus-setup-message (if yank 'reply-yank 'reply)
- (if (not very-wide)
- (gnus-summary-select-article)
- (dolist (article very-wide)
- (gnus-summary-select-article nil nil nil article)
- (save-excursion
- (set-buffer (gnus-copy-article-buffer))
- (gnus-msg-treat-broken-reply-to)
- (save-restriction
- (message-narrow-to-head)
- (setq headers (concat headers (buffer-string)))))))
- (set-buffer (gnus-copy-article-buffer))
- (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
- (save-restriction
- (message-narrow-to-head)
- (when very-wide
- (erase-buffer)
- (insert headers))
- (goto-char (point-max)))
- (mml-quote-region (point) (point-max))
- (message-reply nil wide)
+ ;; Allow user to require confirmation before replying by mail to the
+ ;; author of a news article.
+ (when (or (not (gnus-news-group-p gnus-newsgroup-name))
+ (not gnus-confirm-mail-reply-to-news)
+ (y-or-n-p "Really reply by mail to article author? "))
+ (let* ((article
+ (if (listp (car yank))
+ (caar yank)
+ (car yank)))
+ (gnus-article-reply (or article (gnus-summary-article-number)))
+ (headers ""))
+ ;; Stripping headers should be specified with mail-yank-ignored-headers.
(when yank
- (gnus-inews-yank-articles yank)))))
+ (gnus-summary-goto-subject article))
+ (gnus-setup-message (if yank 'reply-yank 'reply)
+ (if (not very-wide)
+ (gnus-summary-select-article)
+ (dolist (article very-wide)
+ (gnus-summary-select-article nil nil nil article)
+ (save-excursion
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-msg-treat-broken-reply-to)
+ (save-restriction
+ (message-narrow-to-head)
+ (setq headers (concat headers (buffer-string)))))))
+ (set-buffer (gnus-copy-article-buffer))
+ (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
+ (save-restriction
+ (message-narrow-to-head)
+ (when very-wide
+ (erase-buffer)
+ (insert headers))
+ (goto-char (point-max)))
+ (message-reply nil wide)
+ (when yank
+ (gnus-inews-yank-articles yank))
+ (gnus-summary-handle-replysign)))))
+
+(defun gnus-summary-handle-replysign ()
+ "Check the various replysign variables and take action accordingly."
+ (when nil;;(or gnus-message-replysign gnus-message-replyencrypt)
+ (let (signed encrypted)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (setq signed (memq 'signed gnus-article-wash-types))
+ (setq encrypted (memq 'encrypted gnus-article-wash-types)))
+ (cond ((and gnus-message-replysign signed)
+ (mml-secure-message mml-default-sign-method 'sign))
+ ((and gnus-message-replyencrypt encrypted)
+ (mml-secure-message mml-default-encrypt-method
+ (if gnus-message-replysignencrypted
+ 'signencrypt
+ 'encrypt)))))))
(defun gnus-summary-reply-with-original (n &optional wide)
"Start composing a reply mail to the current message.
(gnus-summary-reply
(gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
-(defun gnus-summary-mail-forward (&optional arg post)
+(defun gnus-summary-mail-forward (&optional full-headers post)
"Forward the current message(s) to another user.
If process marks exist, forward all marked messages;
-if ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
-if ARG is 1, decode the message and forward directly inline;
-if ARG is 2, forward message as an rfc822 MIME section;
-if ARG is 3, decode message and forward as an rfc822 MIME section;
-if ARG is 4, forward message directly inline;
-otherwise, use flipped `message-forward-as-mime'.
-If POST, post instead of mail.
-For the `inline' alternatives, also see the variable
-`message-forward-ignored-headers'."
+If FULL-HEADERS (the prefix), include full headers when forwarding.
+
+Note that this function definition for T-gnus is totally different
+from the original Gnus."
(interactive "P")
(if (null (cdr (gnus-summary-work-articles nil)))
- (let ((message-forward-as-mime message-forward-as-mime)
- (message-forward-show-mml message-forward-show-mml))
- (cond
- ((null arg))
- ((eq arg 1)
- (setq message-forward-as-mime nil
- message-forward-show-mml t))
- ((eq arg 2)
- (setq message-forward-as-mime t
- message-forward-show-mml nil))
- ((eq arg 3)
- (setq message-forward-as-mime t
- message-forward-show-mml t))
- ((eq arg 4)
- (setq message-forward-as-mime nil
- message-forward-show-mml nil))
- (t
- (setq message-forward-as-mime (not message-forward-as-mime))))
- (let ((gnus-article-reply (gnus-summary-article-number)))
- (gnus-setup-message 'forward
- (gnus-summary-select-article)
- (let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
- (set-buffer gnus-original-article-buffer)
- (message-forward post)))))
- (gnus-uu-digest-mail-forward arg post)))
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (let ((charset default-mime-charset))
+ (set-buffer gnus-original-article-buffer)
+ (make-local-variable 'default-mime-charset)
+ (setq default-mime-charset charset))
+ (let ((message-included-forward-headers
+ (if full-headers "" message-included-forward-headers)))
+ (message-forward post)))
+ (gnus-summary-digest-mail-forward nil post)))
+
+(defun gnus-summary-digest-mail-forward (&optional n post)
+ "Digests and forwards all articles in this series.
+If N is a positive number, forward the N next articles.
+If N is a negative number, forward the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+forward those articles instead.
+Optional POST will use news to forward instead of mail."
+ (interactive "P")
+ (let ((articles (gnus-summary-work-articles n))
+ (topics "Topics:\n")
+ subject article frame)
+ (when (car articles)
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (if (cdr articles)
+ (setq articles (sort articles '<)
+ subject "Digested Articles")
+ (with-current-buffer gnus-original-article-buffer
+ (setq subject (message-make-forward-subject))))
+ (if post
+ (message-news nil subject)
+ (message-mail nil subject))
+ (when (and message-use-multi-frames (cdr articles))
+ (setq frame (window-frame (get-buffer-window (current-buffer)))))
+ (message-goto-body)
+ (while (setq article (pop articles))
+ (save-window-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-select-article nil nil nil article)
+ (setq topics (concat topics " "
+ (mail-header-subject gnus-current-headers)
+ "\n"))
+ (gnus-summary-remove-process-mark article))
+ (when frame
+ (select-frame frame))
+ (insert (mime-make-tag "message" "rfc822") "\n")
+ (narrow-to-region (point) (point))
+ (insert-buffer-substring gnus-original-article-buffer)
+ (save-restriction
+ (article-narrow-to-head)
+ (message-remove-header message-included-forward-headers t nil t))
+ (goto-char (point-max))
+ (widen))
+ (push-mark)
+ (message-goto-body)
+ (insert topics)
+ (message-goto-body)
+ (mime-edit-enclose-digest-region (point)(mark t))))))
+
+(defun gnus-summary-digest-post-forward (&optional n)
+ "Digest and forwards all articles in this series to a newsgroup.
+If N is a positive number, forward the N next articles.
+If N is a negative number, forward the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+forward those articles instead."
+ (interactive "P")
+ (gnus-summary-digest-mail-forward n t))
(defun gnus-summary-resend-message (address n)
"Resend the current article to ADDRESS."
(interactive
- (list (message-read-from-minibuffer "Resend message(s) to: ")
+ (list (message-read-from-minibuffer
+ "Resend message(s) to: "
+ (when (and gnus-summary-resend-default-address
+ (gnus-buffer-live-p gnus-original-article-buffer))
+ ;; If some other article is currently selected, the
+ ;; initial-contents is wrong. Whatever, it is just the
+ ;; initial-contents.
+ (with-current-buffer gnus-original-article-buffer
+ (nnmail-fetch-field "to"))))
current-prefix-arg))
(let ((articles (gnus-summary-work-articles n))
article)
(message-resend address))
(gnus-summary-mark-article-as-forwarded article))))
-(defun gnus-summary-post-forward (&optional arg)
+;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
+(defun gnus-summary-resend-message-edit ()
+ "Resend an article that has already been sent.
+A new buffer will be created to allow the user to modify body and
+contents of the message, and then, everything will happen as when
+composing a new message."
+ (interactive)
+ (let ((article (gnus-summary-article-number)))
+ (gnus-setup-message 'reply-yank
+ (gnus-summary-select-article t)
+ (set-buffer gnus-original-article-buffer)
+ (let ((cur (current-buffer))
+ (to (message-fetch-field "to")))
+ ;; Get a normal message buffer.
+ (message-pop-to-buffer (message-buffer-name "Resend" to))
+ (insert-buffer-substring cur)
+
+ ;; T-gnus change: Use MIME-Edit to recompose a message.
+ ;;(mime-to-mml)
+ (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer)))
+ (fset 'mime-edit-decode-single-part-in-buffer
+ (lambda (&rest args)
+ (if (let ((content-type (car args)))
+ (and (eq 'message (mime-content-type-primary-type
+ content-type))
+ (eq 'rfc822 (mime-content-type-subtype
+ content-type))))
+ (setcar (cdr args) 'not-decode-text))
+ (apply ofn args)))
+ (unwind-protect
+ (mime-edit-again nil t)
+ (fset 'mime-edit-decode-single-part-in-buffer ofn)))
+ (message-narrow-to-head-1)
+ (insert "From: " (message-make-from) "\n")
+ (while (re-search-forward "^From:" nil t)
+ (beginning-of-line)
+ (insert "Original-"))
+ (message-remove-header "^>From[\t ]" t)
+
+ ;; Gnus will generate a new one when sending.
+ (message-remove-header "Message-ID")
+ (message-remove-header message-ignored-resent-headers t)
+ ;; Remove unwanted headers.
+ (goto-char (point-max))
+ (insert mail-header-separator)
+ (goto-char (point-min))
+ (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
+ (forward-char 1)
+ (widen)))))
+
+(defun gnus-summary-post-forward (&optional full-headers)
"Forward the current article to a newsgroup.
-See `gnus-summary-mail-forward' for ARG."
+If FULL-HEADERS (the prefix), include full headers when forwarding."
(interactive "P")
- (gnus-summary-mail-forward arg t))
+ (gnus-summary-mail-forward full-headers t))
(defvar gnus-nastygram-message
"The following article was inappropriately posted to %s.\n\n"
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
(when address
- (message-reply address)
+ (gnus-msg-mail address)
(when yank
(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
(error "Gnus has been shut down"))
(gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
(unless (message-mail-user-agent)
+ (message-pop-to-buffer "*Gnus Bug*")
(delete-other-windows)
(when gnus-bug-create-help-buffer
(switch-to-buffer "*Gnus Help Bug*")
(erase-buffer)
(insert gnus-bug-message)
- (goto-char (point-min)))
- (message-pop-to-buffer "*Gnus Bug*"))
+ (goto-char (point-min))
+ (sit-for 0)
+ (set-buffer "*Gnus Bug*")))
(let ((message-this-is-mail t))
(message-setup `((To . ,gnus-maintainer) (Subject . ""))))
(when gnus-bug-create-help-buffer
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
- (insert (gnus-version) "\n"
+ (insert gnus-product-name " " gnus-version-number
+ " (r" gnus-revision-number ") "
+ "based on " gnus-original-product-name " v"
+ gnus-original-version-number "\n"
(emacs-version) "\n")
(when (and (boundp 'nntp-server-type)
(stringp nntp-server-type))
(insert nntp-server-type))
(insert "\n\n\n\n\n")
- (let (text)
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *gnus environment info*"))
- (erase-buffer)
- (gnus-debug)
- (setq text (buffer-string)))
- (insert "<#part type=application/x-emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
+ (let (mime-content-types)
+ (mime-edit-insert-tag
+ "application" "emacs-lisp"
+ "\nContent-Disposition: inline\nContent-Description: User settings"))
+ (insert (with-temp-buffer
+ (gnus-debug)
+ (buffer-string)))
+ (let (mime-content-types)
+ (mime-edit-insert-tag "text" "plain"))
(goto-char (point-min))
(search-forward "Subject: " nil t)
(message "")))
(interactive
(list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
current-prefix-arg))
- (gnus-summary-iterate n
- (let ((gnus-display-mime-function nil)
- (gnus-inhibit-treatment t))
- (gnus-summary-select-article))
- (save-excursion
- (set-buffer buffer)
- (message-yank-buffer gnus-article-buffer))))
+ (when (gnus-buffer-live-p buffer)
+ (let ((summary-frame (selected-frame))
+ (message-frame (when (static-if (featurep 'xemacs)
+ (device-on-window-system-p)
+ window-system)
+ (let ((window (get-buffer-window buffer t)))
+ (when window
+ (window-frame window)))))
+ (separator (concat "^" (regexp-quote mail-header-separator)
+ "\n")))
+ (gnus-summary-iterate n
+ (gnus-summary-select-article)
+ (gnus-copy-article-buffer)
+ (when (frame-live-p message-frame)
+ (raise-frame message-frame)
+ (select-frame message-frame))
+ (with-current-buffer buffer
+ (when (save-excursion
+ (beginning-of-line)
+ (let (case-fold-search)
+ (and (not (re-search-backward separator nil t))
+ (re-search-forward separator nil t))))
+ (goto-char (match-end 0)))
+ (message-yank-buffer gnus-article-copy))
+ (select-frame summary-frame))
+ (when (frame-live-p message-frame)
+ (select-frame message-frame)))))
(defun gnus-debug ()
"Attempts to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
(interactive)
- (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el"
- "gnus-art.el" "gnus-start.el" "gnus-async.el"
- "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
- "nnmail.el" "message.el"))
+ (let ((files gnus-debug-files)
(point (point))
file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
- (sit-for 0)
;; Go through all the files looking for non-default values for variables.
(save-excursion
+ (sit-for 0)
(set-buffer (gnus-get-buffer-create " *gnus bug info*"))
(while files
(erase-buffer)
(goto-char (point-min))
(while (setq expr (ignore-errors (read (current-buffer))))
(ignore-errors
- (and (or (eq (car expr) 'defvar)
- (eq (car expr) 'defcustom))
+ (and (memq (car expr) '(defvar defcustom defvoo))
(stringp (nth 3 expr))
+ (not (memq (nth 1 expr) gnus-debug-exclude-variables))
(or (not (boundp (nth 1 expr)))
(not (equal (eval (nth 2 expr))
(symbol-value (nth 1 expr)))))
(push (nth 1 expr) olist)))))))
(kill-buffer (current-buffer)))
(when (setq olist (nreverse olist))
- (insert "------------------ Environment follows ------------------\n\n"))
+ (insert ";----------------- Environment follows ------------------\n\n"))
(while olist
(if (boundp (car olist))
(condition-case ()
(format "(setq %s 'whatever)\n" (car olist))))
(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
- (insert "\n\n")
;; Remove any control chars - they seem to cause trouble for some
;; mailers. (Byte-compiled output from the stuff above.)
(goto-char point)
(while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t)
(replace-match (format "\\%03o" (string-to-char (match-string 0)))
- t t))))
+ t t))
+ ;; Break MIME tags purposely.
+ (goto-char point)
+ (while (re-search-forward mime-edit-tag-regexp nil t)
+ (goto-char (1+ (match-beginning 0)))
+ (insert "X"))))
;;; Treatment of rejected articles.
;;; Bounced mail.
(save-restriction
(message-narrow-to-headers)
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
- (cur (current-buffer))
- groups group method group-art)
+ (coding-system-for-write 'raw-text)
+ (output-coding-system 'raw-text)
+ groups group method group-art
+ mml-externalize-attachments)
(when gcc
(message-remove-header "gcc")
(widen)
(car method))))
(unless (gnus-request-group group nil method)
(gnus-request-create-group group method))
+ (setq mml-externalize-attachments
+ (if (stringp gnus-gcc-externalize-attachments)
+ (string-match gnus-gcc-externalize-attachments group)
+ gnus-gcc-externalize-attachments))
(save-excursion
(nnheader-set-temp-buffer " *acc*")
- (insert-buffer-substring cur)
- (message-encode-message-body)
- (save-restriction
- (message-narrow-to-headers)
- (let* ((mail-parse-charset message-default-charset)
- (newsgroups-field (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field "Newsgroups")))
- (followup-field (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field "Followup-To")))
- ;; BUG: We really need to get the charset for
- ;; each name in the Newsgroups and Followup-To
- ;; lines to allow crossposting between group
- ;; namess with incompatible character sets.
- ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
- (group-field-charset
- (gnus-group-name-charset
- method (or newsgroups-field "")))
- (followup-field-charset
- (gnus-group-name-charset
- method (or followup-field "")))
- (rfc2047-header-encoding-alist
- (append
- (when group-field-charset
- (list (cons "Newsgroups" group-field-charset)))
- (when followup-field-charset
- (list (cons "Followup-To" followup-field-charset)))
- rfc2047-header-encoding-alist)))
- (mail-encode-encoded-word-buffer)))
+ (insert-buffer-substring message-encoding-buffer)
+ (gnus-run-hooks 'gnus-before-do-gcc-hook)
(goto-char (point-min))
(when (re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$")
(gnus-message 1 "Couldn't store article in group %s: %s"
group (gnus-status-message method))
(sit-for 2))
- (when (and group-art gnus-inews-mark-gcc-as-read)
+ (when (and group-art
+ (or gnus-gcc-mark-as-read
+ gnus-inews-mark-gcc-as-read))
(gnus-group-mark-article-read group (cdr group-art)))
(kill-buffer (current-buffer)))))))))
;; Regexp string match on the group name.
(string-match match group))
((eq match 'header)
+ ;; Obsolete format of header match.
(and (gnus-buffer-live-p gnus-article-copy)
(with-current-buffer gnus-article-copy
(let ((header (message-fetch-field (pop style))))
;; Variable to be checked.
(symbol-value match))))
((listp match)
- ;; This is a form to be evaled.
- (eval match)))
+ (cond
+ ((eq (car match) 'header)
+ ;; New format of header match.
+ (and (gnus-buffer-live-p gnus-article-copy)
+ (with-current-buffer gnus-article-copy
+ (let ((header (message-fetch-field (nth 1 match))))
+ (and header
+ (string-match (nth 2 match) header))))))
+ (t
+ ;; This is a form to be evaled.
+ (eval match)))))
;; We have a match, so we set the variables.
(dolist (attribute style)
(setq element (pop attribute)
filep nil)
(setq value
(cond
- ((eq (car attribute) :file)
+ ((eq (car attribute) ':file)
(setq filep t)
(cadr attribute))
((eq (car attribute) :value)
((listp value)
(eval value))))
;; Translate obsolescent value.
- (when (eq element 'signature-file)
+ (cond
+ ((eq element 'signature-file)
(setq element 'signature
filep t))
+ ((eq element 'x-face-file)
+ (setq element 'x-face
+ filep t)))
;; Get the contents of file elems.
(when (and filep v)
(setq v (with-temp-buffer
(insert-file-contents v)
+ (goto-char (point-max))
+ (while (bolp)
+ (delete-char -1))
(buffer-string))))
(setq results (delq (assoc element results) results))
(push (cons element v) results))))
(insert "From: " (message-make-from) "\n"))))
nil 'local)))))
+
+;;; @ for MIME Edit mode
+;;;
+
+(defun gnus-maybe-setup-default-charset ()
+ (let ((charset
+ (and (boundp 'gnus-summary-buffer)
+ (buffer-live-p gnus-summary-buffer)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ default-mime-charset))))
+ (if charset
+ (progn
+ (make-local-variable 'default-mime-charset)
+ (setq default-mime-charset charset)
+ ))))
+
+
+;;; @ for MIME view mode
+;;;
+
+(defun gnus-following-method (buf)
+ (gnus-setup-message 'reply-yank
+ (set-buffer buf)
+ (if (message-news-p)
+ (message-followup)
+ (message-reply nil 'wide))
+ (let ((message-reply-buffer buf))
+ (message-yank-original))
+ (message-goto-body))
+ (kill-buffer buf))
+
+
;;; Allow redefinition of functions.
(gnus-ems-redefine)
projects / elisp / gnus.git- / blobdiff