;;; 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>
"*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-sent-message-ids-file
(nnheader-concat gnus-directory "Sent-Message-IDs")
"File where Gnus saves a cache of sent message ids.")
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*")
"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
(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)
+ (unwind-protect
+ ,@forms
+ (gnus-inews-add-send-actions ,winconf ,buffer ,article)
+ (setq gnus-message-buffer (current-buffer))
+ (make-local-variable 'gnus-newsgroup-name)
+ (run-hooks 'gnus-message-setup-hook))
(gnus-configure-windows ,config t))))
-
+
(defun gnus-inews-add-send-actions (winconf buffer article)
- (gnus-make-local-hook 'message-sent-hook)
+ (make-local-hook 'message-sent-hook)
(gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
(setq message-post-method
`(lambda (arg)
(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-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)
(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))
(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
(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
(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)
(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))
(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))
+ (push (list 'gnus-inews-add-to-address pgroup)
+ message-send-actions)))
(set-buffer gnus-article-copy)
(message-wide-reply to-address)))
(when 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
(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
(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))
+ "")))
(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-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 "" 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.
(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\".")
"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)
(setq beg (point))
(skip-chars-forward "^,")
(while (zerop
- (save-excursion
+ (save-excursion
(save-restriction
(let ((i 0))
(narrow-to-region beg (point))
(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))))
(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)
(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)))))
"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)
(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))
(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))
result
gcc-self-val
(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 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
+ (progn
(insert
(if (stringp gcc-self-val)
gcc-self-val
(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 " ")))
(interactive)
(gnus-set-global-variables)
(let (buf)
- (if (not (setq buf (gnus-request-restore-buffer
+ (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)
(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)
projects / gnus / blobdiff