X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-msg.el;h=a80230e0ecd910a7eb443a9b6d7b486d772ebdfa;hb=9954729d205c97242f0787c79dc23e7b051a6201;hp=04fd0585b7d68ac65ae68fb81942e04d43e79dbf;hpb=27e50870dcbd1442e8fe2d14ddfb89cd7c706495;p=gnus diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 04fd0585b..a80230e0e 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -1,8 +1,8 @@ ;;; gnus-msg.el --- mail and post interface for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen +;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -26,29 +26,38 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-ems) (require 'message) (require 'gnus-art) -;; Added by Sudish Joseph . -(defvar gnus-post-method nil +(defcustom gnus-post-method nil "*Preferred method for posting USENET news. -If this variable is nil, Gnus will use the current method to decide -which method to use when posting. If it is non-nil, it will override -the current method. This method will not be used in mail groups and -the like, only in \"real\" newsgroups. -The value must be a valid method as discussed in the documentation of -`gnus-select-method'. It can also be a list of methods. If that is -the case, the user will be queried for what select method to use when -posting.") +If this variable is `current', Gnus will use the \"current\" select +method when posting. If it is nil (which is the default), Gnus will +use the native posting method of the server. + +This method will not be used in mail groups and the like, only in +\"real\" newsgroups. + +If not nil nor `native', the value must be a valid method as discussed +in the documentation of `gnus-select-method'. It can also be a list of +methods. If that is the case, the user will be queried for what select +method to use when posting." + :group 'gnus-group-foreign + :type `(choice (const nil) + (const current) + (const native) + (sexp :tag "Methods" ,gnus-select-method))) (defvar gnus-outgoing-message-group nil "*All outgoing messages will be put in this group. If you want to store all your outgoing mail and articles in the group \"nnml:archive\", you set this variable to that value. This variable -can also be a list of group names. +can also be a list of group names. If you want to have greater control over what group to put each message in, you can set this variable to a function that checks the @@ -61,12 +70,8 @@ This is useful when you're reading a mailing list that has been gatewayed to a newsgroup, and you want to followup to an article in the group.") -(defvar gnus-sent-message-ids-file - (nnheader-concat gnus-directory "Sent-Message-IDs") - "File where Gnus saves a cache of sent message ids.") - -(defvar gnus-sent-message-ids-length 1000 - "The number of sent Message-IDs to save.") +(defvar gnus-add-to-list nil + "*If non-nil, add a `to-list' parameter automatically.") (defvar gnus-crosspost-complaint "Hi, @@ -86,11 +91,29 @@ Thank you. The first %s will be replaced by the Newsgroups header; the second with the current group name.") +(defvar gnus-message-setup-hook nil + "Hook run after setting up a message buffer.") + +(defvar gnus-bug-create-help-buffer t + "*Should we create the *Gnus Help Bug* buffer?") + +(defvar gnus-posting-styles nil + "*Alist of styles to use when posting.") + +(defvar gnus-posting-style-alist + '((organization . message-user-organization) + (signature . message-signature) + (signature-file . message-signature-file) + (address . user-mail-address) + (name . user-full-name)) + "*Mapping from style parameters to variables.") + ;;; Internal variables. (defvar gnus-message-buffer "*Mail Gnus*") (defvar gnus-article-copy nil) (defvar gnus-last-posting-server nil) +(defvar gnus-message-group-art nil) (defconst gnus-bug-message "Sending a bug report to the Gnus Towers. @@ -132,6 +155,8 @@ Thank you for your help in stamping out bugs. "s" gnus-summary-supersede-article "r" gnus-summary-reply "R" gnus-summary-reply-with-original + "w" gnus-summary-wide-reply + "W" gnus-summary-wide-reply-with-original "n" gnus-summary-followup-to-mail "N" gnus-summary-followup-to-mail-with-original "m" gnus-summary-mail-other-window @@ -151,25 +176,34 @@ 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 "winconf")) - (buffer (make-symbol "buffer")) - (article (make-symbol "article"))) + (let ((winconf (make-symbol "gnus-setup-message-winconf")) + (buffer (make-symbol "gnus-setup-message-buffer")) + (article (make-symbol "gnus-setup-message-article")) + (group (make-symbol "gnus-setup-message-group"))) `(let ((,winconf (current-window-configuration)) (,buffer (buffer-name (current-buffer))) (,article (and gnus-article-reply (gnus-summary-article-number))) + (,group gnus-newsgroup-name) (message-header-setup-hook (copy-sequence message-header-setup-hook))) (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) - ,@forms - (gnus-inews-add-send-actions ,winconf ,buffer ,article) - (setq gnus-message-buffer (current-buffer)) - (make-local-variable 'gnus-newsgroup-name) - (gnus-configure-windows ,config t)))) - + (add-hook 'message-mode-hook 'gnus-configure-posting-styles) + (unwind-protect + (progn + ,@forms) + (gnus-inews-add-send-actions ,winconf ,buffer ,article) + (setq gnus-message-buffer (current-buffer)) + (set (make-local-variable 'gnus-message-group-art) + (cons ,group ,article)) + (make-local-variable 'gnus-newsgroup-name) + (gnus-run-hooks 'gnus-message-setup-hook)) + (gnus-configure-windows ,config t) + (set-buffer-modified-p nil)))) + (defun gnus-inews-add-send-actions (winconf buffer article) - (gnus-make-local-hook 'message-sent-hook) - (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) + (make-local-hook 'message-sent-hook) + (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) (setq message-post-method `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) @@ -177,9 +211,9 @@ Thank you for your help in stamping out bugs. (message-add-action `(set-window-configuration ,winconf) 'exit 'postpone 'kill) (message-add-action - `(when (buffer-name (get-buffer ,buffer)) + `(when (gnus-buffer-exists-p ,buffer) (save-excursion - (set-buffer (get-buffer ,buffer)) + (set-buffer ,buffer) ,(when article `(gnus-summary-mark-article-as-replied ,article)))) 'send)) @@ -200,8 +234,7 @@ Thank you for your help in stamping out bugs. If ARG, post to the group under point. If ARG is 1, prompt for a group name." (interactive "P") - ;; Bind this variable here to make message mode hooks - ;; work ok. + ;; Bind this variable here to make message mode hooks work ok. (let ((gnus-newsgroup-name (if arg (if (= 1 (prefix-numeric-value arg)) @@ -214,16 +247,14 @@ If ARG is 1, prompt for a group name." (defun gnus-summary-post-news () "Start composing a news message." (interactive) - (gnus-set-global-variables) (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." - (interactive - (list (and current-prefix-arg + (interactive + (list (and current-prefix-arg (gnus-summary-work-articles 1)))) - (gnus-set-global-variables) (when yank (gnus-summary-goto-subject (car yank))) (save-window-excursion @@ -232,7 +263,7 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (gnus-newsgroup-name gnus-newsgroup-name)) ;; Send a followup. (gnus-post-news nil gnus-newsgroup-name - headers gnus-article-buffer + headers gnus-article-buffer yank nil force-news))) (defun gnus-summary-followup-with-original (n &optional force-news) @@ -242,8 +273,8 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (defun gnus-summary-followup-to-mail (&optional arg) "Followup to the current mail message via news." - (interactive - (list (and current-prefix-arg + (interactive + (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-summary-followup arg t)) @@ -270,14 +301,16 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (push-mark) (goto-char beg))) -(defun gnus-summary-cancel-article (n) - "Cancel an article you posted." - (interactive "P") - (gnus-set-global-variables) +(defun gnus-summary-cancel-article (&optional n symp) + "Cancel an article you posted. +Uses the process-prefix convention. If given the symbolic +prefix `a', cancel using the standard posting method; if not +post using the current select method." + (interactive (gnus-interactive "P\ny")) (let ((articles (gnus-summary-work-articles n)) (message-post-method `(lambda (arg) - (gnus-post-method nil ,gnus-newsgroup-name))) + (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name))) article) (while (setq article (pop articles)) (when (gnus-summary-select-article t nil nil article) @@ -293,7 +326,6 @@ If prefix argument YANK is non-nil, original article is yanked automatically." This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." (interactive) - (gnus-set-global-variables) (let ((article (gnus-summary-article-number))) (gnus-setup-message 'reply-yank (gnus-summary-select-article t) @@ -301,7 +333,11 @@ header line with the old Message-ID." (message-supersede) (push `((lambda () - (gnus-cache-possibly-remove-article ,article nil nil nil t))) + (when (gnus-buffer-exists-p ,gnus-summary-buffer) + (save-excursion + (set-buffer ,gnus-summary-buffer) + (gnus-cache-possibly-remove-article ,article nil nil nil t) + (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) message-send-actions)))) @@ -317,8 +353,9 @@ header line with the old Message-ID." (push gnus-article-copy gnus-buffer-list)) (let ((article-buffer (or article-buffer gnus-article-buffer)) end beg contents) - (when (and (get-buffer article-buffer) - (buffer-name (get-buffer article-buffer))) + (if (not (and (get-buffer article-buffer) + (gnus-buffer-exists-p article-buffer))) + (error "Can't find any article buffer") (save-excursion (set-buffer article-buffer) (save-restriction @@ -327,7 +364,7 @@ header line with the old Message-ID." (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) (set-buffer gnus-article-copy) - (article-delete-text-of-type 'annotation) + (gnus-article-delete-text-of-type 'annotation) (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next) (insert @@ -347,20 +384,21 @@ header line with the old Message-ID." (or (search-forward "\n\n" nil t) (point))) ;; Insert the original article headers. (insert-buffer-substring gnus-original-article-buffer beg end) - (article-decode-rfc1522))) + (gnus-article-decode-rfc1522))) gnus-article-copy))) (defun gnus-post-news (post &optional group header article-buffer yank subject force-news) (when article-buffer (gnus-copy-article-buffer)) - (let ((gnus-article-reply article-buffer)) + (let ((gnus-article-reply article-buffer) + (add-to-list gnus-add-to-list)) (gnus-setup-message (cond (yank 'reply-yank) (article-buffer 'reply) (t 'message)) (let* ((group (or group gnus-newsgroup-name)) (pgroup group) - to-address to-group mailing-list to-list + to-address to-group mailing-list to-list newsgroup-p) (when group (setq to-address (gnus-group-find-parameter group 'to-address) @@ -374,7 +412,7 @@ header line with the old Message-ID." (gnus-news-group-p to-group)) newsgroup-p force-news - (and (gnus-news-group-p + (and (gnus-news-group-p (or pgroup gnus-newsgroup-name) (if header (mail-header-number header) gnus-current-article)) @@ -385,6 +423,7 @@ header line with the old Message-ID." (if post (message-news (or to-group group)) (set-buffer gnus-article-copy) + (gnus-msg-treat-broken-reply-to) (message-followup (if (or newsgroup-p force-news) nil to-group))) ;; The is mail. (if post @@ -392,37 +431,55 @@ header line with the old Message-ID." (message-mail (or to-address to-list)) ;; Arrange for mail groups that have no `to-address' to ;; get that when the user sends off the mail. - (push (list 'gnus-inews-add-to-address group) - message-send-actions)) + (when (and (not to-list) + (not to-address) + add-to-list) + (push (list 'gnus-inews-add-to-address pgroup) + message-send-actions))) (set-buffer gnus-article-copy) + (gnus-msg-treat-broken-reply-to) (message-wide-reply to-address))) (when yank (gnus-inews-yank-articles yank)))))) +(defun gnus-msg-treat-broken-reply-to () + "Remove the Reply-to header iff broken-reply-to." + (when (gnus-group-find-parameter + gnus-newsgroup-name 'broken-reply-to) + (save-restriction + (message-narrow-to-head) + (message-remove-header "reply-to")))) + (defun gnus-post-method (arg group &optional silent) "Return the posting method based on GROUP and ARG. If SILENT, don't prompt the user." (let ((group-method (gnus-find-method-for-group group))) - (cond - ;; If the group-method is nil (which shouldn't happen) we use + (cond + ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ((null group-method) - (or gnus-post-method gnus-select-method message-post-method)) - ;; We want this group's method. + (or (and (null (eq gnus-post-method 'active)) gnus-post-method) + gnus-select-method message-post-method)) + ;; We want the inverse of the default ((and arg (not (eq arg 0))) - group-method) + (if (eq gnus-post-method 'active) + gnus-select-method + group-method)) ;; We query the user for a post method. ((or arg (and gnus-post-method + (not (eq gnus-post-method 'current)) (listp (car gnus-post-method)))) (let* ((methods ;; Collect all methods we know about. (append - (when gnus-post-method + (when (and gnus-post-method + (not (eq gnus-post-method 'current))) (if (listp (car gnus-post-method)) gnus-post-method (list gnus-post-method))) gnus-secondary-select-methods + (mapcar 'cdr gnus-server-alist) (list gnus-select-method) (list group-method))) method-alist post-methods method) @@ -434,7 +491,7 @@ If SILENT, don't prompt the user." (push method post-methods))) ;; Create a name-method alist. (setq method-alist - (mapcar + (mapcar (lambda (m) (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) post-methods)) @@ -451,61 +508,25 @@ If SILENT, don't prompt the user." (cons (or gnus-last-posting-server "") 0)))) method-alist)))) ;; Override normal method. + ((and (eq gnus-post-method 'current) + (not arg)) + group-method) (gnus-post-method gnus-post-method) ;; Use the normal select method. (t gnus-select-method)))) -(defun gnus-inews-narrow-to-headers () - (widen) - (narrow-to-region - (goto-char (point-min)) - (or (and (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (match-beginning 0)) - (point-max))) - (goto-char (point-min))) - -;;; -;;; Check whether the message has been sent already. -;;; - -(defvar gnus-inews-sent-ids nil) - -(defun gnus-inews-reject-message () - "Check whether this message has already been sent." - (when gnus-sent-message-ids-file - (let ((message-id (save-restriction (gnus-inews-narrow-to-headers) - (mail-fetch-field "message-id"))) - end) - (when message-id - (unless gnus-inews-sent-ids - (ignore-errors - (load t t t))) - (if (member message-id gnus-inews-sent-ids) - ;; Reject this message. - (not (gnus-yes-or-no-p - (format "Message %s already sent. Send anyway? " - message-id))) - (push message-id gnus-inews-sent-ids) - ;; Chop off the last Message-IDs. - (when (setq end (nthcdr gnus-sent-message-ids-length - gnus-inews-sent-ids)) - (setcdr end nil)) - (nnheader-temp-write gnus-sent-message-ids-file - (gnus-prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids))) - nil))))) - ;; Dummy to avoid byte-compile warning. (defvar nnspool-rejected-article-hook) +(defvar xemacs-codename) ;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might ;;; as well include the Emacs version as well. ;;; The following function works with later GNU Emacs, and XEmacs. (defun gnus-extended-version () - "Stringified Gnus version and Emacs version" + "Stringified Gnus version and Emacs version." (interactive) (concat gnus-version @@ -515,18 +536,28 @@ If SILENT, don't prompt the user." (concat "Emacs " (substring emacs-version (match-beginning 1) (match-end 1)))) - ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)" emacs-version) + ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" + emacs-version) (concat (substring emacs-version (match-beginning 1) (match-end 1)) - (format " %d.%d" emacs-major-version emacs-minor-version))) + (format " %d.%d" emacs-major-version emacs-minor-version) + (if (match-beginning 3) + (substring emacs-version + (match-beginning 3) + (match-end 3)) + "") + (if (boundp 'xemacs-codename) + (concat " - \"" xemacs-codename "\"")))) (t emacs-version)))) ;; Written by "Mr. Per Persson" . (defun gnus-inews-insert-mime-headers () + "Insert MIME headers. +Assumes ISO-Latin-1 is used iff 8-bit characters are present." (goto-char (point-min)) - (let ((mail-header-separator - (progn + (let ((mail-header-separator + (progn (goto-char (point-min)) (if (and (search-forward (concat "\n" mail-header-separator "\n") nil t) @@ -538,7 +569,7 @@ If SILENT, don't prompt the user." (cond ((save-restriction (widen) (goto-char (point-min)) - (re-search-forward "[\200-\377]" nil t)) + (re-search-forward "[^\000-\177]" nil t)) (or (mail-position-on-field "Content-Type") (insert "text/plain; charset=ISO-8859-1")) (or (mail-position-on-field "Content-Transfer-Encoding") @@ -548,43 +579,59 @@ If SILENT, don't prompt the user." (or (mail-position-on-field "Content-Transfer-Encoding") (insert "7bit"))))))) +(custom-add-option 'message-header-hook 'gnus-inews-insert-mime-headers) + ;;; -;;; Gnus Mail Functions +;;; Gnus Mail Functions ;;; ;;; Mail reply commands of Gnus summary mode -(defun gnus-summary-reply (&optional yank) - "Reply mail to news author. -If prefix argument YANK is non-nil, original article is yanked automatically." - (interactive - (list (and current-prefix-arg +(defun gnus-summary-reply (&optional yank wide) + "Start composing a reply mail to the current message. +If prefix argument YANK is non-nil, the original article is yanked +automatically." + (interactive + (list (and current-prefix-arg (gnus-summary-work-articles 1)))) - ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) ;; Stripping headers should be specified with mail-yank-ignored-headers. - (gnus-set-global-variables) - (when yank + (when yank (gnus-summary-goto-subject (car yank))) (let ((gnus-article-reply t)) (gnus-setup-message (if yank 'reply-yank 'reply) (gnus-summary-select-article) (set-buffer (gnus-copy-article-buffer)) - (message-reply nil nil (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to)) + (gnus-msg-treat-broken-reply-to) + (message-reply nil wide) (when yank (gnus-inews-yank-articles yank))))) -(defun gnus-summary-reply-with-original (n) - "Reply mail to news author with original article." +(defun gnus-summary-reply-with-original (n &optional wide) + "Start composing a reply mail to the current message. +The original article will be yanked." (interactive "P") - (gnus-summary-reply (gnus-summary-work-articles n))) + (gnus-summary-reply (gnus-summary-work-articles n) wide)) + +(defun gnus-summary-wide-reply (&optional yank) + "Start composing a wide reply mail to the current message. +If prefix argument YANK is non-nil, the original article is yanked +automatically." + (interactive + (list (and current-prefix-arg + (gnus-summary-work-articles 1)))) + (gnus-summary-reply yank t)) + +(defun gnus-summary-wide-reply-with-original (n) + "Start composing a wide reply mail to the current message. +The original article will be yanked." + (interactive "P") + (gnus-summary-reply-with-original n t)) (defun gnus-summary-mail-forward (&optional full-headers post) "Forward the current message to another user. If FULL-HEADERS (the prefix), include full headers when forwarding." (interactive "P") - (gnus-set-global-variables) (gnus-setup-message 'forward (gnus-summary-select-article) (set-buffer gnus-original-article-buffer) @@ -592,13 +639,16 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (if full-headers "" message-included-forward-headers))) (message-forward post)))) -(defun gnus-summary-resend-message (address) +(defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." - (interactive "sResend message to: ") - (gnus-summary-select-article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (message-resend address))) + (interactive "sResend message(s) to: \nP") + (let ((articles (gnus-summary-work-articles n)) + article) + (while (setq article (pop articles)) + (gnus-summary-select-article nil nil nil article) + (save-excursion + (set-buffer gnus-original-article-buffer) + (message-resend address))))) (defun gnus-summary-post-forward (&optional full-headers) "Forward the current article to a newsgroup. @@ -606,7 +656,7 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (interactive "P") (gnus-summary-mail-forward full-headers t)) -(defvar gnus-nastygram-message +(defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" "Format string to insert in nastygrams. The current group name will be inserted at \"%s\".") @@ -615,7 +665,7 @@ The current group name will be inserted at \"%s\".") "Send a nastygram to the author of the current article." (interactive "P") (when (or gnus-expert-user - (gnus-y-or-n-p + (gnus-y-or-n-p "Really send a nastygram to the author of the current article? ")) (let ((group gnus-newsgroup-name)) (gnus-summary-reply-with-original n) @@ -654,6 +704,7 @@ The current group name will be inserted at \"%s\".") (message-goto-subject) (re-search-forward " *$") (replace-match " (crosspost notification)" t t) + (gnus-deactivate-mark) (when (gnus-y-or-n-p "Send this complaint? ") (message-send-and-exit))))))) @@ -671,7 +722,7 @@ The current group name will be inserted at \"%s\".") (setq beg (point)) (skip-chars-forward "^,") (while (zerop - (save-excursion + (save-excursion (save-restriction (let ((i 0)) (narrow-to-region beg (point)) @@ -695,8 +746,10 @@ The current group name will be inserted at \"%s\".") (when (and to-address (gnus-alive-p)) ;; This mail group doesn't have a `to-list', so we add one - ;; here. Magic! - (gnus-group-add-parameter group (cons 'to-list to-address))))) + ;; here. Magic! + (when (gnus-y-or-n-p + (format "Do you want to add this as `to-list': %s " to-address)) + (gnus-group-add-parameter group (cons 'to-list to-address)))))) (defun gnus-put-message () "Put the current message in some group and return to Gnus." @@ -704,7 +757,7 @@ The current group name will be inserted at \"%s\".") (let ((reply gnus-article-reply) (winconf gnus-prev-winconf) (group gnus-newsgroup-name)) - + (or (and group (not (gnus-group-read-only-p group))) (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) @@ -714,7 +767,7 @@ The current group name will be inserted at \"%s\".") (save-excursion (save-restriction (widen) - (gnus-inews-narrow-to-headers) + (message-narrow-to-headers) (let (gnus-deletable-headers) (if (message-news-p) (message-generate-headers message-required-news-headers) @@ -729,7 +782,7 @@ The current group name will be inserted at \"%s\".") (when (gnus-buffer-exists-p (car-safe reply)) (set-buffer (car reply)) (and (cdr reply) - (gnus-summary-mark-article-as-replied + (gnus-summary-mark-article-as-replied (cdr reply)))) (when winconf (set-window-configuration winconf))))) @@ -738,7 +791,7 @@ The current group name will be inserted at \"%s\".") "Send a reply to the address near point. If YANK is non-nil, include the original article." (interactive "P") - (let ((address + (let ((address (buffer-substring (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) @@ -755,18 +808,20 @@ If YANK is non-nil, include the original article." (error "Gnus has been shut down")) (gnus-setup-message 'bug (delete-other-windows) - (switch-to-buffer "*Gnus Help Bug*") - (erase-buffer) - (insert gnus-bug-message) - (goto-char (point-min)) + (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*") (message-setup `((To . ,gnus-maintainer) (Subject . ""))) - (push `(gnus-bug-kill-buffer) message-send-actions) + (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) - (insert (gnus-version) "\n") - (insert (emacs-version) "\n") + (insert (gnus-version) "\n" + (emacs-version) "\n") (when (and (boundp 'nntp-server-type) (stringp nntp-server-type)) (insert nntp-server-type)) @@ -786,8 +841,9 @@ 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-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el" "nnmail.el" "message.el")) + (point (point)) file expr olist sym) (gnus-message 4 "Please wait while we snoop your variables...") (sit-for 0) @@ -833,11 +889,12 @@ The source file has to be in the Emacs load path." (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) (setq olist (cdr olist))) (insert "\n\n") - ;; Remove any null chars - they seem to cause trouble for some + ;; Remove any control chars - they seem to cause trouble for some ;; mailers. (Byte-compiled output from the stuff above.) - (goto-char (point-min)) - (while (re-search-forward "[\000\200]" nil t) - (replace-match "" t t)))) + (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)))) ;;; Treatment of rejected articles. ;;; Bounced mail. @@ -856,15 +913,16 @@ this is a reply." (let* ((references (mail-fetch-field "references")) (parent (and references (gnus-parent-id references)))) (message-bounce) - ;; If there are references, we fetch the article we answered to. + ;; If there are references, we fetch the article we answered to. (and fetch parent (gnus-summary-refer-article parent) (gnus-summary-show-all-headers))))) ;;; Gcc handling. -;; Do Gcc handling, which copied the message over to some group. +;; Do Gcc handling, which copied the message over to some group. (defun gnus-inews-do-gcc (&optional gcc) + (interactive) (when (gnus-alive-p) (save-excursion (save-restriction @@ -878,11 +936,11 @@ this is a reply." (setq groups (message-tokenize-header gcc " ,")) ;; Copy the article over to some group(s). (while (setq group (pop groups)) - (gnus-check-server + (gnus-check-server (setq method (cond ((and (null (gnus-get-info group)) (eq (car gnus-message-archive-method) - (car + (car (gnus-server-to-method (gnus-group-method group))))) ;; If the group doesn't exist, we assume @@ -900,12 +958,12 @@ this is a reply." (nnheader-set-temp-buffer " *acc*") (insert-buffer-substring cur) (goto-char (point-min)) - (when (re-search-forward + (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) (unless (gnus-request-accept-article group method t) - (gnus-message 1 "Couldn't store article in group %s: %s" + (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) (kill-buffer (current-buffer)))))))))) @@ -914,9 +972,9 @@ this is a reply." "Insert Gcc headers based on `gnus-outgoing-message-group'." (save-excursion (save-restriction - (gnus-inews-narrow-to-headers) + (message-narrow-to-headers) (let* ((group gnus-outgoing-message-group) - (gcc (cond + (gcc (cond ((gnus-functionp group) (funcall group)) ((or (stringp group) (list group)) @@ -931,10 +989,13 @@ this is a reply." "Insert the Gcc to say where the article is to be archived." (let* ((var gnus-message-archive-group) (group (or group gnus-newsgroup-name "")) - result - gcc-self-val + (gcc-self-val + (and gnus-newsgroup-name + (gnus-group-find-parameter + gnus-newsgroup-name 'gcc-self))) + result (groups - (cond + (cond ((null gnus-message-archive-method) ;; Ignore. nil) @@ -955,7 +1016,7 @@ this is a reply." (while (and var (not (setq result - (cond + (cond ((stringp (caar var)) ;; Regexp. (when (string-match (caar var) group) @@ -968,19 +1029,17 @@ this is a reply." (setq var (cdr var))) result))) name) - (when groups + (when (or groups gcc-self-val) (when (stringp groups) (setq groups (list groups))) (save-excursion (save-restriction - (gnus-inews-narrow-to-headers) + (message-narrow-to-headers) (goto-char (point-max)) (insert "Gcc: ") - (if (and gnus-newsgroup-name - (setq gcc-self-val - (gnus-group-find-parameter - gnus-newsgroup-name 'gcc-self))) - (progn + (if gcc-self-val + ;; Use the `gcc-self' param value instead. + (progn (insert (if (stringp gcc-self-val) gcc-self-val @@ -990,41 +1049,78 @@ this is a reply." (progn (beginning-of-line) (kill-line)))) + ;; Use the list of groups. (while (setq name (pop groups)) (insert (if (string-match ":" name) name - (gnus-group-prefixed-name + (gnus-group-prefixed-name name gnus-message-archive-method))) (when groups (insert " "))) (insert "\n"))))))) -(defun gnus-summary-send-draft () - "Enter a mail/post buffer to edit and send the draft." - (interactive) - (gnus-set-global-variables) - (let (buf) - (if (not (setq buf (gnus-request-restore-buffer - (gnus-summary-article-number) gnus-newsgroup-name))) - (error "Couldn't restore the article") - (switch-to-buffer buf) - (when (eq major-mode 'news-reply-mode) - (local-set-key "\C-c\C-c" 'gnus-inews-news)) - ;; Insert the separator. - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - ;; Configure windows. - (let ((gnus-draft-buffer (current-buffer))) - (gnus-configure-windows 'draft t) - (goto-char (point)))))) - -(gnus-add-shutdown 'gnus-inews-close 'gnus) - -(defun gnus-inews-close () - (setq gnus-inews-sent-ids nil)) - +;;; Posting styles. + +(defun gnus-configure-posting-styles () + "Configure posting styles according to `gnus-posting-styles'." + (let ((styles gnus-posting-styles) + (gnus-newsgroup-name (or gnus-newsgroup-name "")) + style match variable attribute value value-value) + ;; Go through all styles and look for matches. + (while styles + (setq style (pop styles) + match (pop style)) + (when (cond ((stringp match) + ;; Regexp string match on the group name. + (string-match match gnus-newsgroup-name)) + ((or (symbolp match) + (gnus-functionp match)) + (cond ((gnus-functionp match) + ;; Function to be called. + (funcall match)) + ((boundp match) + ;; Variable to be checked. + (symbol-value match)))) + ((listp match) + ;; This is a form to be evaled. + (eval match))) + ;; We have a match, so we set the variables. + (while style + (setq attribute (pop style) + value (cadr attribute) + variable nil) + ;; We find the variable that is to be modified. + (if (and (not (stringp (car attribute))) + (not (setq variable (cdr (assq (car attribute) + gnus-posting-style-alist))))) + (message "Couldn't find attribute %s" (car attribute)) + ;; We get the value. + (setq value-value + (cond ((stringp value) + value) + ((or (symbolp value) + (gnus-functionp value)) + (cond ((gnus-functionp value) + (funcall value)) + ((boundp value) + (symbol-value value)))) + ((listp value) + (eval value)))) + (if variable + (progn + ;; This is an ordinary variable. + (make-local-variable variable) + (set variable value-value)) + ;; This is a header to be added to the headers when + ;; posting. + (when value-value + (make-local-variable 'message-required-mail-headers) + (make-local-variable 'message-required-news-headers) + (push (cons (car attribute) value-value) + message-required-mail-headers) + (push (cons (car attribute) value-value) + message-required-news-headers))))))))) + ;;; Allow redefinition of functions. (gnus-ems-redefine)