X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-draft.el;h=7dba2504d52c20aa9aad1448e0805c59452d9f9c;hb=8a8cda10c8426092f3f1bf113a06169dbca0a634;hp=ef7d868fedc90ee7f47ba71ea1887101b45aec06;hpb=566642e2a68c060d1b2e66409f16d972373bc007;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index ef7d868..7dba250 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -1,8 +1,10 @@ ;;; gnus-draft.el --- draft message support for Semi-gnus -;; Copyright (C) 1997,98 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko +;; Tatsuya Ichikawa ;; Keywords: mail, news, MIME, offline ;; This file is part of GNU Emacs. @@ -68,8 +70,8 @@ (interactive "P") (when (eq major-mode 'gnus-summary-mode) (when (set (make-local-variable 'gnus-draft-mode) - (if (null arg) (not gnus-draft-mode) - (> (prefix-numeric-value arg) 0))) + (if (null arg) (not gnus-draft-mode) + (> (prefix-numeric-value arg) 0))) ;; Set up the menu. (when (gnus-visual-p 'draft-menu 'menu) (gnus-draft-make-menu-bar)) @@ -95,7 +97,8 @@ (interactive) (let ((article (gnus-summary-article-number))) (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-draft-setup article gnus-newsgroup-name) + (gnus-draft-setup-for-editing article gnus-newsgroup-name) + (message-save-drafts) (let ((gnus-verbose-backends nil)) (gnus-request-expire-articles (list article) gnus-newsgroup-name t)) (push @@ -114,44 +117,22 @@ (while (setq article (pop articles)) (gnus-summary-remove-process-mark article) (unless (memq article gnus-newsgroup-unsendable) - (gnus-draft-send article gnus-newsgroup-name) + (gnus-draft-send article gnus-newsgroup-name t) (gnus-summary-mark-article article gnus-canceled-mark))))) -;;(defun gnus-draft-send (article &optional group) -;; "Send message ARTICLE." -;; (gnus-draft-setup article (or group "nndraft:queue")) -;; (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me) -;; message-send-hook type method) -;; ;; We read the meta-information that says how and where -;; ;; this message is to be sent. -;; (save-restriction -;; (message-narrow-to-head) -;; (when (re-search-forward -;; (concat "^" (regexp-quote gnus-agent-meta-information-header) ":") -;; nil t) -;; (setq type (ignore-errors (read (current-buffer))) -;; method (ignore-errors (read (current-buffer)))) -;; (message-remove-header gnus-agent-meta-information-header))) -;; ;; Then we send it. If we have no meta-information, we just send -;; ;; it and let Message figure out how. -;; (when (if type -;; (let ((message-this-is-news (eq type 'news)) -;; (message-this-is-mail (eq type 'mail)) -;; (gnus-post-method method) -;; (message-post-method method)) -;; (message-send-and-exit)) -;; (message-send-and-exit)) -;; (let ((gnus-verbose-backends nil)) -;; (gnus-request-expire-articles -;; (list article) (or group "nndraft:queue") t))))) - -;; For draft TEST -(defvar gnus-draft-send-draft-buffer " *send draft*") -(defun gnus-draft-send (article &optional group) +(defun gnus-draft-send (article &optional group interactive) "Send message ARTICLE." - (gnus-draft-setup article (or group "nndraft:queue")) - (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me) - message-send-hook type method) + (let ((message-syntax-checks (if interactive nil + 'dont-check-for-anything-just-trust-me)) + (message-inhibit-body-encoding (or (not group) + (equal group "nndraft:queue") + message-inhibit-body-encoding)) + (message-send-hook (and group (not (equal group "nndraft:queue")) + message-send-hook)) + (message-setup-hook (and group (not (equal group "nndraft:queue")) + message-setup-hook)) + type method) + (gnus-draft-setup-for-sending article (or group "nndraft:queue")) ;; We read the meta-information that says how and where ;; this message is to be sent. (save-restriction @@ -164,31 +145,28 @@ (message-remove-header gnus-agent-meta-information-header))) ;; Then we send it. If we have no meta-information, we just send ;; it and let Message figure out how. - (if type - (gnus-draft-send-draft type method)))) -;; -(defun gnus-draft-send-draft (type method) - (if (eq type 'mail) - (progn - ;; Send draft via SMTP. - (require 'smtp) - (let ((recipients (smtp-deduce-address-list - (current-buffer) - (goto-char (point-min)) (search-forward "\n\n")))) - (if (not (null recipients)) - (if (not (smtp-via-smtp user-mail-address recipients (current-buffer))) - (error "Sending failed: SMTP protocol error") - (let ((gnus-verbose-backends nil)) - (gnus-request-expire-articles - (list article) (or group "nndraft:queue") t)) - (if (get-buffer gnus-draft-send-draft-buffer) - (kill-buffer gnus-draft-send-draft-buffer)))))) - ;; Send draft via NNTP. - (gnus-open-server method) - (gnus-request-post method) - (if (get-buffer gnus-draft-send-draft-buffer) - (kill-buffer gnus-draft-send-draft-buffer)))) -;; For draft TEST + (when (let ((mail-header-separator "")) + (cond ((eq type 'news) + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (funcall message-send-news-function method) + ))) + (funcall message-send-news-function method) + ) + ((eq type 'mail) + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (funcall message-send-mail-function) + ))) + (funcall message-send-mail-function) + t))) + (let ((gnus-verbose-backends nil)) + (gnus-request-expire-articles + (list article) (or group "nndraft:queue") t))))) (defun gnus-draft-send-all-messages () "Send all the sendable drafts." @@ -201,53 +179,51 @@ (interactive) (gnus-activate-group "nndraft:queue") (save-excursion - (let ((articles (nndraft-articles)) - (unsendable (gnus-uncompress-range - (cdr (assq 'unsend - (gnus-info-marks - (gnus-get-info "nndraft:queue")))))) - article) + (let* ((articles (nndraft-articles)) + (unsendable (gnus-uncompress-range + (cdr (assq 'unsend + (gnus-info-marks + (gnus-get-info "nndraft:queue")))))) + (n (length articles)) + article i) (while (setq article (pop articles)) - (unless (memq article unsendable) + (setq i (- n (length articles))) + (message "Sending message %d of %d." i n) + (if (memq article unsendable) + (message "Message %d of %d is unsendable." i n) (gnus-draft-send article)))))) ;;; Utility functions -;;(defcustom gnus-draft-decoding-function -;; (function -;; (lambda () -;; (mime-edit-decode-buffer nil) -;; (eword-decode-header) -;; )) -;; "*Function called to decode the message from network representation." -;; :group 'gnus-agent -;; :type 'function) +(defcustom gnus-draft-decoding-function + #'mime-edit-decode-message-in-buffer + "*Function called to decode the message from network representation." + :group 'gnus-agent + :type 'function) ;;;!!!If this is byte-compiled, it fails miserably. ;;;!!!This is because `gnus-setup-message' uses uninterned symbols. ;;;!!!This has been fixed in recent versions of Emacs and XEmacs, ;;;!!!but for the time being, we'll just run this tiny function uncompiled. -;;(progn -;;(defun gnus-draft-setup (narticle group) -;; (gnus-setup-message 'forward -;; (let ((article narticle)) -;; (message-mail) -;; (erase-buffer) -;; (if (not (gnus-request-restore-buffer article group)) -;; (error "Couldn't restore the article") -;; ;; Insert the separator. -;; (funcall gnus-draft-decoding-function) -;; (goto-char (point-min)) -;; (search-forward "\n\n") -;; (forward-char -1) -;; (insert mail-header-separator) -;; (forward-line 1) -;; (message-set-auto-save-file-name)))))) -;; -;; For draft TEST -(progn -(defun gnus-draft-setup (narticle group) +(defun gnus-draft-setup-for-editing (narticle group) + (gnus-setup-message 'forward + (let ((article narticle)) + (message-mail) + (erase-buffer) + (if (not (gnus-request-restore-buffer article group)) + (error "Couldn't restore the article") + (funcall gnus-draft-decoding-function) + ;; Insert the separator. + (goto-char (point-min)) + (search-forward "\n\n") + (forward-char -1) + (insert mail-header-separator) + (forward-line 1) + (message-set-auto-save-file-name))))) + +(defvar gnus-draft-send-draft-buffer " *send draft*") +(defun gnus-draft-setup-for-sending (narticle group) (let ((article narticle)) (if (not (get-buffer gnus-draft-send-draft-buffer)) (get-buffer-create gnus-draft-send-draft-buffer)) @@ -255,8 +231,7 @@ (erase-buffer) (if (not (gnus-request-restore-buffer article group)) (error "Couldn't restore the article") - )))) -;; For draft TEST + ))) (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable."