X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=6ff1023383b409ddf191993ffe6e1c93c3a15154;hb=89a68cfae8cefd25eab8cc881888fb954be1d784;hp=29ac43115c88161c9012ad6fd5f4f250beb54fbc;hpb=a84297ba44892db20dd7790634fffd9f30010052;p=gnus diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 29ac43115..6ff102338 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -351,6 +351,7 @@ Thank you for your help in stamping out bugs. "r" gnus-summary-reply "y" gnus-summary-yank-message "R" gnus-summary-reply-with-original + "L" gnus-summary-reply-to-list-with-original "w" gnus-summary-wide-reply "W" gnus-summary-wide-reply-with-original "v" gnus-summary-very-wide-reply @@ -383,6 +384,7 @@ Thank you for your help in stamping out bugs. (defvar gnus-article-reply nil) (defmacro gnus-setup-message (config &rest forms) (let ((winconf (make-symbol "gnus-setup-message-winconf")) + (winconf-name (make-symbol "gnus-setup-message-winconf-name")) (buffer (make-symbol "gnus-setup-message-buffer")) (article (make-symbol "gnus-setup-message-article")) (yanked (make-symbol "gnus-setup-yanked-articles")) @@ -541,7 +543,7 @@ Gcc: header for archiving purposes." (gnus-post-method arg ,gnus-newsgroup-name))) (message-add-action `(progn - (setq gnus-current-window-configuration ,winconf-name) + (setq gnus-current-window-configuration ',winconf-name) (when (gnus-buffer-exists-p ,buffer) (set-window-configuration ,winconf))) 'exit 'postpone 'kill) @@ -1153,6 +1155,16 @@ The original article will be yanked." (interactive "P") (gnus-summary-reply (gnus-summary-work-articles n) wide)) +(defun gnus-summary-reply-to-list-with-original (n &optional wide) + "Start composing a reply mail to the current message. +The reply goes only to the mailing list. +The original article will be yanked." + (interactive "P") + (let ((message-reply-to-function + (lambda nil + `((To . ,(gnus-mailing-list-followup-to)))))) + (gnus-summary-reply (gnus-summary-work-articles n) wide))) + (defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide) "Like `gnus-summary-reply' except removing reply-to field. If prefix argument YANK is non-nil, the original article is yanked @@ -1213,7 +1225,7 @@ 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 +For the \"inline\" alternatives, also see the variable `message-forward-ignored-headers'." (interactive "P") (if (cdr (gnus-summary-work-articles nil)) @@ -1443,24 +1455,22 @@ If YANK is non-nil, include the original article." (goto-char (point-min))) (message-pop-to-buffer "*Gnus Bug*")) (let ((message-this-is-mail t)) - (message-setup `((To . ,gnus-maintainer) (Subject . "")))) + (message-setup `((To . ,gnus-maintainer) + (Subject . "") + (X-Debbugs-Package + . ,(format "%s" gnus-bug-package)) + (X-Debbugs-Version + . ,(format "%s" (gnus-continuum-version)))))) (when gnus-bug-create-help-buffer (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) + (message-goto-body) + (insert "\n\n\n\n\n") (insert (gnus-version) "\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) - (with-current-buffer (gnus-get-buffer-create " *gnus environment info*") - (erase-buffer) - (gnus-debug) - (setq text (buffer-string))) - (insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>")) (goto-char (point-min)) (search-forward "Subject: " nil t) (message ""))) @@ -1480,62 +1490,6 @@ If YANK is non-nil, include the original article." (with-current-buffer buffer (message-yank-buffer gnus-article-buffer)))) -(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-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. - (with-current-buffer (gnus-get-buffer-create " *gnus bug info*") - (while files - (erase-buffer) - (when (and (setq file (locate-library (pop files))) - (file-exists-p file)) - (insert-file-contents file) - (goto-char (point-min)) - (if (not (re-search-forward "^;;* *Internal variables" nil t)) - (gnus-message 4 "Malformed sources in file %s" file) - (narrow-to-region (point-min) (point)) - (goto-char (point-min)) - (while (setq expr (ignore-errors (read (current-buffer)))) - (ignore-errors - (and (or (eq (car expr) 'defvar) - (eq (car expr) 'defcustom)) - (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")) - (while olist - (if (boundp (car olist)) - (ignore-errors - (gnus-pp - `(setq ,(car olist) - ,(if (or (consp (setq sym (symbol-value (car olist)))) - (and (symbolp sym) - (not (or (eq sym nil) - (eq sym t))))) - (list 'quote (symbol-value (car olist))) - (symbol-value (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 (mm-string-to-multibyte - "[\000-\010\013-\037\200-\237]") nil t) - (replace-match (format "\\%03o" (string-to-char (match-string 0))) - t t)))) - ;;; Treatment of rejected articles. ;;; Bounced mail. @@ -1595,7 +1549,7 @@ this is a reply." (message-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) (cur (current-buffer)) - groups group method group-art + groups group method group-art options mml-externalize-attachments) (when gcc (message-remove-header "gcc") @@ -1619,6 +1573,7 @@ this is a reply." gnus-gcc-externalize-attachments)) (save-excursion (nnheader-set-temp-buffer " *acc*") + (setq message-options (with-current-buffer cur message-options)) (insert-buffer-substring cur) (message-encode-message-body) (save-restriction @@ -1633,7 +1588,7 @@ this is a reply." ;; 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. + ;; names with incompatible character sets. ;; -- Per Abrahamsen 2001-10-08. (group-field-charset (gnus-group-name-charset @@ -1675,6 +1630,8 @@ this is a reply." (boundp 'gnus-inews-mark-gcc-as-read) (symbol-value 'gnus-inews-mark-gcc-as-read)))) (gnus-group-mark-article-read group (cdr group-art))) + (setq options message-options) + (with-current-buffer cur (setq message-options options)) (kill-buffer (current-buffer))))))))) (defun gnus-inews-insert-gcc (&optional group) @@ -1776,7 +1733,10 @@ this is a reply." "Configure posting styles according to `gnus-posting-styles'." (unless gnus-inhibit-posting-styles (let ((group (or group-name gnus-newsgroup-name "")) - (styles gnus-posting-styles) + (styles (if (gnus-buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-posting-styles) + gnus-posting-styles)) style match attribute value v results filep name address element) ;; If the group has a posting-style parameter, add it at the end with a @@ -1824,7 +1784,7 @@ this is a reply." (and header (string-match (nth 2 match) header))))))) (t - ;; This is a form to be evaled. + ;; This is a form to be evalled. (eval match))))) ;; We have a match, so we set the variables. (dolist (attribute style)