;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;;; Code:
-(require 'gnus-load)
+(eval-when-compile (require 'cl))
+
+(require 'gnus)
(require 'gnus-ems)
(require 'message)
(require 'gnus-art)
-(require 'gnus)
;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
(defvar gnus-post-method 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
gatewayed to a newsgroup, and you want to followup to an article in
the group.")
-(defvar gnus-sent-message-ids-file
+(defvar gnus-add-to-list nil
+ "*If non-nil, add a `to-list' parameter automatically.")
+
+(defvar gnus-sent-message-ids-file
(nnheader-concat gnus-directory "Sent-Message-IDs")
"File where Gnus saves a cache of sent message ids.")
group before posting in the future.
Thank you.
+
"
"Format string to be inserted when complaining about crossposts.
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.")
+
;;; 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.
"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
"u" gnus-uu-post-news
"\M-c" gnus-summary-mail-crosspost-complaint
(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")))
`(let ((,winconf (current-window-configuration))
- (,buffer (current-buffer))
+ (,buffer (buffer-name (current-buffer)))
(,article (and gnus-article-reply (gnus-summary-article-number)))
(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))))
-
+ (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 ,gnus-newsgroup-name ,article))
+ (make-local-variable 'gnus-newsgroup-name)
+ (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)))
(message-add-action
`(set-window-configuration ,winconf) 'exit 'postpone 'kill)
(message-add-action
- `(when (buffer-name ,buffer)
+ `(when (buffer-name (get-buffer ,buffer))
(save-excursion
- (set-buffer ,buffer)
+ (set-buffer (get-buffer ,buffer))
,(when article
`(gnus-summary-mark-article-as-replied ,article))))
'send))
(put 'gnus-setup-message 'lisp-indent-function 1)
-(put 'gnus-setup-message 'lisp-indent-hook 1)
(put 'gnus-setup-message 'edebug-form-spec '(form body))
;;; Post news commands of Gnus group mode and summary mode
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))
(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
(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)
(interactive "P")
(gnus-summary-followup (gnus-summary-work-articles n) force-news))
+(defun gnus-summary-followup-to-mail (&optional arg)
+ "Followup to the current mail message via news."
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnus-summary-followup arg t))
+
+(defun gnus-summary-followup-to-mail-with-original (&optional arg)
+ "Followup to the current mail message via news."
+ (interactive "P")
+ (gnus-summary-followup (gnus-summary-work-articles arg) t))
+
(defun gnus-inews-yank-articles (articles)
(let (beg article)
+ (message-goto-body)
(while (setq article (pop articles))
(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)
- (message-goto-body)
(let ((message-reply-buffer gnus-article-copy)
(message-reply-headers gnus-current-headers))
(message-yank-original)
(setq beg (or beg (mark t))))
- (when articles (insert "\n")))
+ (when articles
+ (insert "\n")))
(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)
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)
(message-supersede)
(push
`((lambda ()
- (gnus-cache-possibly-remove-article ,article nil nil nil t)))
+ (when (buffer-name (get-buffer ,gnus-summary-buffer))
+ (save-excursion
+ (set-buffer (get-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))))
\f
(setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
(buffer-disable-undo gnus-article-copy)
(or (memq gnus-article-copy gnus-buffer-list)
- (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
+ (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)
+ (buffer-name (get-buffer article-buffer))))
+ (error "Can't find any article buffer")
(save-excursion
(set-buffer article-buffer)
(save-restriction
(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
(prog1
(format "%s" (buffer-string))
(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)
to-group (gnus-group-find-parameter group 'to-group)
to-list (gnus-group-find-parameter group 'to-list)
+ newsgroup-p (gnus-group-find-parameter group 'newsgroup)
mailing-list (when gnus-mailing-list-groups
(string-match gnus-mailing-list-groups group))
group (gnus-group-real-name group)))
(if (or (and to-group
(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))
(if post
(message-news (or to-group group))
(set-buffer gnus-article-copy)
- (message-followup to-group))
+ (message-followup (if (or newsgroup-p force-news) nil to-group)))
;; The is mail.
(if post
(progn
(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)
- (message-wide-reply to-address)))
+ (message-wide-reply to-address
+ (gnus-group-find-parameter
+ gnus-newsgroup-name 'broken-reply-to))))
(when yank
(gnus-inews-yank-articles yank))))))
"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))
(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))
;; 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.
;;;
(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)
+ (let ((message-id (save-restriction (message-narrow-to-headers)
(mail-fetch-field "message-id")))
end)
(when message-id
(unless gnus-inews-sent-ids
- (condition-case ()
- (load t t t)
- (error nil)))
+ (ignore-errors
+ (load t t t)))
(if (member message-id gnus-inews-sent-ids)
;; Reject this message.
- (not (gnus-yes-or-no-p
+ (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
+ (when (setq end (nthcdr gnus-sent-message-ids-length
gnus-inews-sent-ids))
(setcdr end nil))
(nnheader-temp-write gnus-sent-message-ids-file
;; 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.
(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" <pp@gnu.ai.mit.edu>.
(defun gnus-inews-insert-mime-headers ()
(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)
\f
;;;
-;;; 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))
+ (message-reply nil wide (gnus-group-find-parameter
+ gnus-newsgroup-name 'broken-reply-to))
(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-mail-forward (&optional post)
- "Forward the current message to another user."
+(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)
- (message-forward post)))
+ (let ((message-included-forward-headers
+ (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 ()
- "Forward the current article to a newsgroup."
- (interactive)
- (gnus-summary-mail-forward t))
+(defun gnus-summary-post-forward (&optional full-headers)
+ "Forward the current article to a newsgroup.
+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\".")
(defun gnus-summary-mail-nastygram (n)
"Send a nastygram to the author of the current article."
(interactive "P")
- (if (or gnus-expert-user
- (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)
- (set-buffer gnus-message-buffer)
- (message-goto-body)
- (insert (format gnus-nastygram-message group))
- (message-send-and-exit))))
+ (when (or gnus-expert-user
+ (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)
+ (set-buffer gnus-message-buffer)
+ (message-goto-body)
+ (insert (format gnus-nastygram-message group))
+ (message-send-and-exit))))
(defun gnus-summary-mail-crosspost-complaint (n)
"Send a complaint about crossposting to the current article(s)."
(set-buffer gnus-summary-buffer)
(gnus-summary-reply-with-original 1)
(set-buffer gnus-message-buffer)
+ (message-goto-body)
(insert (format gnus-crosspost-complaint newsgroups group))
+ (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)))))))
(setq beg (point))
(skip-chars-forward "^,")
(while (zerop
- (save-excursion
+ (save-excursion
(save-restriction
(let ((i 0))
(narrow-to-region beg (point))
(logand (progn
(while (search-forward "\"" nil t)
(incf i))
- (if (zerop i) 2 i)) 2)))))
+ (if (zerop i) 2 i))
+ 2)))))
(skip-chars-forward ",")
(skip-chars-forward "^,"))
(skip-chars-backward " ")
- (setq accumulated
- (cons (buffer-substring beg (point))
- accumulated))
+ (push (buffer-substring beg (point))
+ accumulated)
(skip-chars-forward "^,")
(skip-chars-forward ", "))
accumulated))
-(defun gnus-mail-yank-original ()
- (interactive)
- (save-excursion
- (mail-yank-original nil))
- (or mail-yank-hooks mail-citation-hook
- (run-hooks 'news-reply-header-hook)))
-
(defun gnus-inews-add-to-address (group)
(let ((to-address (mail-fetch-field "to")))
(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."
(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))))
- (and (gnus-gethash group gnus-newsrc-hashtb)
- (error "No such group: %s" group))
+ (when (gnus-gethash group gnus-newsrc-hashtb)
+ (error "No such group: %s" group))
(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)
(gnus-inews-do-gcc)
- (if (get-buffer gnus-group-buffer)
- (progn
- (if (gnus-buffer-exists-p (car-safe reply))
- (progn
- (set-buffer (car reply))
- (and (cdr reply)
- (gnus-summary-mark-article-as-replied
- (cdr reply)))))
- (and winconf (set-window-configuration winconf))))))
+ (when (get-buffer gnus-group-buffer)
+ (when (gnus-buffer-exists-p (car-safe reply))
+ (set-buffer (car reply))
+ (and (cdr reply)
+ (gnus-summary-mark-article-as-replied
+ (cdr reply))))
+ (when winconf
+ (set-window-configuration winconf)))))
(defun gnus-article-mail (yank)
"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))))))
(when yank
(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
+(defvar nntp-server-type)
(defun gnus-bug ()
"Send a bug report to the Gnus maintainers."
(interactive)
(error "Gnus has been shut down"))
(gnus-setup-message 'bug
(delete-other-windows)
- (switch-to-buffer "*Gnus Help Bug*")
+ (switch-to-buffer (get-buffer-create "*Gnus Help Bug*"))
(erase-buffer)
(insert gnus-bug-message)
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
(insert (gnus-version) "\n")
- (insert (emacs-version))
+ (insert (emacs-version) "\n")
+ (when (and (boundp 'nntp-server-type)
+ (stringp nntp-server-type))
+ (insert nntp-server-type))
(insert "\n\n\n\n\n")
(gnus-debug)
(goto-char (point-min))
(message "")))
(defun gnus-bug-kill-buffer ()
- (and (get-buffer "*Gnus Help Bug*")
- (kill-buffer "*Gnus Help Bug*")))
+ (when (get-buffer "*Gnus Help Bug*")
+ (kill-buffer "*Gnus Help Bug*")))
(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-load.el" "gnus-sum.el" "gnus-group.el"
- "gnus-art.el" "gnus-start.el"
- "gnus-msg.el" "gnus-score.el" "gnus-win.el"
+ (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"))
+ (point (point))
file expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
(sit-for 0)
(buffer-disable-undo (current-buffer))
(while files
(erase-buffer)
- (when (file-exists-p (setq file (locate-library (pop files))))
+ (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 (condition-case ()
- (read (current-buffer)) (error nil)))
- (condition-case ()
- (and (eq (car expr) 'defvar)
- (stringp (nth 3 expr))
- (or (not (boundp (nth 1 expr)))
- (not (equal (eval (nth 2 expr))
- (symbol-value (nth 1 expr)))))
- (push (nth 1 expr) olist))
- (error nil))))))
+ (while (setq expr (ignore-errors (read (current-buffer))))
+ (ignore-errors
+ (and (or (eq (car expr) 'defvar)
+ (eq (car expr) 'defcustom))
+ (stringp (nth 3 expr))
+ (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 ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
(setq olist (cdr olist)))
(insert "\n\n")
- ;; Remove any null 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))))
+ ;; 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))))
;;; Treatment of rejected articles.
;;; Bounced mail.
(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
(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
(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))))))))))
"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))
"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)
(while (and var
(not
(setq result
- (cond
+ (cond
((stringp (caar var))
;; Regexp.
(when (string-match (caar var) group)
(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
(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)))
- (if groups (insert " ")))
+ (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))
-
+
;;; Allow redefinition of functions.
(gnus-ems-redefine)