;;; Code:
(require 'gnus)
-(require 'sendmail)
(require 'gnus-ems)
(require 'message)
(eval-when-compile (require 'cl))
This can either be a string, a list of strings; or an alist
of regexps/functions/forms to be evaluated to return a string (or a list
of strings). The functions are called with the name of the current
-group (or nil) as a parameter.")
+group (or nil) as a parameter.
+
+Normally the group names returned by this variable should be
+unprefixed -- which implictly means \"store on the archive server\".
+However, you may wish to store the message on some other server. In
+that case, just return a fully prefixed name of the group --
+\"nnml+private:mail.misc\", for instance.")
(defvar gnus-mailing-list-groups nil
"*Regexp matching groups that are really mailing lists.
the group.")
(defvar gnus-sent-message-ids-file
- (concat (file-name-as-directory gnus-article-save-directory)
- "Sent-Message-IDs")
+ (nnheader-concat gnus-directory "Sent-Message-IDs")
"File where Gnus saves a cache of sent message ids.")
(defvar gnus-sent-message-ids-length 1000
(gnus-define-keys
(gnus-send-bounce-map "D" gnus-summary-send-map)
"b" gnus-summary-resend-bounced-mail
- "c" gnus-summary-send-draft
+; "c" gnus-summary-send-draft
"r" gnus-summary-resend-message)
;;; Internal functions.
`(let ((,winconf (current-window-configuration))
(,buffer (current-buffer))
(,article (and gnus-article-reply (gnus-summary-article-number)))
- message-header-setup-hook)
+ (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
(defun gnus-inews-add-send-actions (winconf buffer article)
(gnus-make-local-hook 'message-sent-hook)
- (add-hook 'message-sent-hook 'gnus-inews-do-gcc)
+ (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
(setq message-newsreader (setq message-mailer (gnus-extended-version)))
- (let ((actions
- `((set-window-configuration ,winconf)
- ((lambda ()
- (when (buffer-name ,buffer)
- (set-buffer ,buffer)
- ,(when article
- `(gnus-summary-mark-article-as-replied ,article))))))))
- (setq message-send-actions (append message-send-actions actions))))
+ (message-add-action
+ `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
+ (message-add-action
+ `(when (buffer-name ,buffer)
+ (save-excursion
+ (set-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
(message-mail)))
(defun gnus-group-post-news (&optional arg)
- "Post an article.
-The newsgroup under the cursor is used as the group to post to.
-
-If you wish to get an empty post buffer, use a prefix ARG. You can
-also do this by calling this function from the bottom of the Group
-buffer."
+ "Start composing a news message.
+If ARG, post to the group under point.
+If ARG is 1, prompt for a group name."
(interactive "P")
- (gnus-setup-message 'message
- (let ((gnus-newsgroup-name nil)
- (group (unless arg (gnus-group-group-name))))
- ;; We might want to prompt here.
- (when (and gnus-interactive-post
- (not gnus-expert-user))
- (setq gnus-newsgroup-name
- (setq group
- (completing-read "Group: " gnus-active-hashtb nil nil
- (cons (or group "") 0)))))
- (gnus-post-news 'post group))))
+ ;; Bind this variable here to make message mode hooks
+ ;; work ok.
+ (let ((gnus-newsgroup-name
+ (if arg
+ (if (= 1 (prefix-numeric-value arg))
+ (completing-read "Newsgroup: " gnus-active-hashtb nil
+ (gnus-read-active-file-p))
+ (gnus-group-group-name))
+ "")))
+ (gnus-post-news 'post gnus-newsgroup-name)))
(defun gnus-summary-post-news ()
- "Post an article."
+ "Start composing a news message."
(interactive)
(gnus-set-global-variables)
(gnus-post-news 'post gnus-newsgroup-name))
(interactive "P")
(gnus-set-global-variables)
(let ((articles (gnus-summary-work-articles n))
+ (message-post-method
+ `(lambda (arg)
+ (gnus-post-method nil ,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))
- (gnus-summary-mark-as-read article gnus-canceled-mark))
+ (gnus-summary-mark-as-read article gnus-canceled-mark)
+ (gnus-cache-remove-article 1))
(gnus-article-hide-headers-if-wanted))
(gnus-summary-remove-process-mark article))))
header line with the old Message-ID."
(interactive)
(gnus-set-global-variables)
- (gnus-setup-message 'reply-yank
- (gnus-summary-select-article t)
- (set-buffer gnus-original-article-buffer)
- (message-supersede)))
+ (let ((article (gnus-summary-article-number)))
+ (gnus-setup-message 'reply-yank
+ (gnus-summary-select-article t)
+ (set-buffer gnus-original-article-buffer)
+ (message-supersede)
+ (push
+ `((lambda ()
+ (gnus-cache-possibly-remove-article ,article nil nil nil t)))
+ message-send-actions))))
\f
(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)))
- (let ((article-buffer (or article-buffer gnus-article-buffer)))
- (if (and (get-buffer article-buffer)
- (buffer-name (get-buffer article-buffer)))
- (save-excursion
- (set-buffer article-buffer)
+ (let ((article-buffer (or article-buffer gnus-article-buffer))
+ end beg contents)
+ (when (and (get-buffer article-buffer)
+ (buffer-name (get-buffer article-buffer)))
+ (save-excursion
+ (set-buffer article-buffer)
+ (save-restriction
(widen)
- (copy-to-buffer gnus-article-copy (point-min) (point-max))
- (gnus-set-text-properties (point-min) (point-max)
- nil gnus-article-copy)))
- gnus-article-copy))
+ (setq contents (format "%s" (buffer-string)))
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (while (looking-at message-unix-mail-delimiter)
+ (forward-line 1))
+ (setq beg (point))
+ (setq end (or (search-forward "\n\n" nil t) (point)))
+ (set-buffer gnus-article-copy)
+ (erase-buffer)
+ (insert contents)
+ (delete-region (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point)))
+ (insert-buffer-substring gnus-original-article-buffer beg end)))
+ gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
force-news)
(when gnus-post-method
(if (listp (car gnus-post-method))
gnus-post-method
- (listp gnus-post-method)))
+ (list gnus-post-method)))
gnus-secondary-select-methods
(list gnus-select-method)
(list group-method)))
(gnus-setup-message (if yank 'reply-yank 'reply)
(gnus-summary-select-article)
(set-buffer (gnus-copy-article-buffer))
- (message-reply)
+ (message-reply nil nil (gnus-group-get-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.
-Customize the variable gnus-mail-reply-method to use another mailer."
+ "Reply mail to news author with original article."
(interactive "P")
(gnus-summary-reply (gnus-summary-work-articles n)))
(buffer-substring
(save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
(save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
- (and address
- (progn
- (switch-to-buffer gnus-summary-buffer)
- (gnus-mail-reply yank address)))))
+ (when address
+ (switch-to-buffer gnus-summary-buffer)
+ (message-reply address)
+ (when yank
+ (gnus-inews-yank-articles yank)))))
(defun gnus-bug ()
"Send a bug report to the Gnus maintainers."
(defun gnus-bug-kill-buffer ()
(and (get-buffer "*Gnus Help Bug*")
- (kill-buffer "*Gnus Help Bug*"))
- (kill-buffer nil))
+ (kill-buffer "*Gnus Help Bug*")))
(defun gnus-debug ()
"Attemps to go through the Gnus source file and report what variables have been changed.
(let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el"
"message.el"))
file dirs expr olist sym)
- (message "Please wait while we snoop your variables...")
+ (gnus-message 4 "Please wait while we snoop your variables...")
(sit-for 0)
(save-excursion
(set-buffer (get-buffer-create " *gnus bug info*"))
(insert-file-contents file)
(goto-char (point-min))
(if (not (re-search-forward "^;;* *Internal variables" nil t))
- (message "Malformed sources in file %s" file)
+ (gnus-message 4 "Malformed sources in file %s" file)
(narrow-to-region (point-min) (point))
(goto-char (point-min))
(while (setq expr (condition-case ()
;; Do Gcc handling, which copied the message over to some group.
(defun gnus-inews-do-gcc (&optional gcc)
- (save-excursion
- (save-restriction
- (nnheader-narrow-to-headers)
- (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
- (cur (current-buffer))
- groups group method)
- (when gcc
- (message-remove-header "gcc")
- (widen)
- (setq groups (message-tokenize-header gcc " ,"))
- ;; Copy the article over to some group(s).
- (while (setq group (pop groups))
- (gnus-check-server
- (setq method
- (cond ((and (null (gnus-get-info group))
- (eq (car gnus-message-archive-method)
- (car
- (gnus-server-to-method
- (gnus-group-method group)))))
- ;; If the group doesn't exist, we assume
- ;; it's an archive group...
- gnus-message-archive-method)
- (t (gnus-group-method group)))))
- (unless (gnus-request-group group t method)
- (gnus-request-create-group group method))
- (gnus-check-server method)
- (save-excursion
- (nnheader-set-temp-buffer " *acc*")
- (insert-buffer-substring cur)
- (goto-char (point-min))
- (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"
- group (gnus-status-message method))
- (sit-for 2))
- (kill-buffer (current-buffer)))))))))
+ (when (gnus-alive-p)
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
+ (cur (current-buffer))
+ groups group method)
+ (when gcc
+ (message-remove-header "gcc")
+ (widen)
+ (setq groups (message-tokenize-header gcc " ,"))
+ ;; Copy the article over to some group(s).
+ (while (setq group (pop groups))
+ (gnus-check-server
+ (setq method
+ (cond ((and (null (gnus-get-info group))
+ (eq (car gnus-message-archive-method)
+ (car
+ (gnus-server-to-method
+ (gnus-group-method group)))))
+ ;; If the group doesn't exist, we assume
+ ;; it's an archive group...
+ gnus-message-archive-method)
+ ;; Use the method.
+ ((gnus-info-method (gnus-get-info group))
+ (gnus-info-method (gnus-get-info group)))
+ ;; Find the method.
+ (t (gnus-group-method group)))))
+ (gnus-check-server method)
+ (unless (gnus-request-group group t method)
+ (gnus-request-create-group group method))
+ (save-excursion
+ (nnheader-set-temp-buffer " *acc*")
+ (insert-buffer-substring cur)
+ (goto-char (point-min))
+ (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"
+ group (gnus-status-message method))
+ (sit-for 2))
+ (kill-buffer (current-buffer))))))))))
(defun gnus-inews-insert-gcc ()
"Insert Gcc headers based on `gnus-outgoing-message-group'."
(t
(eval (car var)))))))
(setq var (cdr var)))
- result))))
+ result)))
+ name)
(when groups
(when (stringp groups)
(setq groups (list groups)))
(gnus-inews-narrow-to-headers)
(goto-char (point-max))
(insert "Gcc: ")
- (while groups
- (insert (gnus-group-prefixed-name
- (pop groups) gnus-message-archive-method))
- (insert " "))
+ (while (setq name (pop groups))
+ (insert (if (string-match ":" name)
+ name
+ (gnus-group-prefixed-name
+ name gnus-message-archive-method)))
+ (if groups (insert " ")))
(insert "\n"))))))
(defun gnus-summary-send-draft ()
projects / gnus / blobdiff