-;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;;; gnus-msg.el --- mail and post interface for Semi-gnus
+;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
(require 'message)
(require 'gnus-art)
-;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
-(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.
(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.")
-
-(defvar gnus-sent-message-ids-length 1000
- "The number of sent Message-IDs to save.")
-
(defvar gnus-crosspost-complaint
"Hi,
(defmacro gnus-setup-message (config &rest forms)
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
(buffer (make-symbol "gnus-setup-message-buffer"))
- (article (make-symbol "gnus-setup-message-article")))
+ (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)
(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))
+ (cons ,group ,article))
(make-local-variable 'gnus-newsgroup-name)
- (run-hooks 'gnus-message-setup-hook))
+ (gnus-run-hooks 'gnus-message-setup-hook))
(gnus-configure-windows ,config t)
(set-buffer-modified-p nil))))
(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))
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)
(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
(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)
- (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))
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 ()
- (when (buffer-name (get-buffer ,gnus-summary-buffer))
+ (when (gnus-buffer-exists-p ,gnus-summary-buffer)
(save-excursion
- (set-buffer (get-buffer ,gnus-summary-buffer))
+ (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))))
(let ((article-buffer (or article-buffer gnus-article-buffer))
end beg contents)
(if (not (and (get-buffer article-buffer)
- (buffer-name (get-buffer article-buffer))))
+ (gnus-buffer-exists-p article-buffer)))
(error "Can't find any article buffer")
(save-excursion
(set-buffer article-buffer)
;; 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)))
(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))))
-;;;
-;;; 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 (message-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)))))
-
\f
;; Dummy to avoid byte-compile warning.
;;; 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"
(interactive)
- (concat
- gnus-version
- "/"
- (cond
- ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
- (concat "Emacs " (substring emacs-version
- (match-beginning 1)
- (match-end 1))))
- ((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)
- (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
- (goto-char (point-min))
- (if (and (search-forward (concat "\n" mail-header-separator "\n")
- nil t)
- (not (search-backward "\n\n" nil t)))
- mail-header-separator
- ""))))
- (or (mail-position-on-field "Mime-Version")
- (insert "1.0")
- (cond ((save-restriction
- (widen)
- (goto-char (point-min))
- (re-search-forward "[\200-\377]" nil t))
- (or (mail-position-on-field "Content-Type")
- (insert "text/plain; charset=ISO-8859-1"))
- (or (mail-position-on-field "Content-Transfer-Encoding")
- (insert "8bit")))
- (t (or (mail-position-on-field "Content-Type")
- (insert "text/plain; charset=US-ASCII"))
- (or (mail-position-on-field "Content-Transfer-Encoding")
- (insert "7bit")))))))
+ gnus-version)
\f
;;;
(list (and current-prefix-arg
(gnus-summary-work-articles 1))))
;; Stripping headers should be specified with mail-yank-ignored-headers.
- (gnus-set-global-variables)
(when yank
(gnus-summary-goto-subject (car yank)))
(let ((gnus-article-reply t))
"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)
+ (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-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)
(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.
(save-restriction
(message-narrow-to-headers)
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
- (cur (current-buffer))
+ (coding-system-for-write 'raw-text)
groups group method)
(when gcc
(message-remove-header "gcc")
(gnus-request-create-group group method))
(save-excursion
(nnheader-set-temp-buffer " *acc*")
- (insert-buffer-substring cur)
+ (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) "$")
"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
((null gnus-message-archive-method)
(setq var (cdr var)))
result)))
name)
- (when groups
+ (when (or groups gcc-self-val)
(when (stringp groups)
(setq groups (list groups)))
(save-excursion
(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)))
+ (if gcc-self-val
+ ;; Use the `gcc-self' param value instead.
(progn
(insert
(if (stringp 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
(insert " ")))
(insert "\n")))))))
-(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 / elisp / gnus.git- / blobdiff