X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-draft.el;h=a0774ef84d757fb5f5511a129d3410343c130793;hb=04ba5250e9e47ebe40860a0902d4ef6405ca143f;hp=849dc9b2f78cea991f4bd7520df0d2c99a063e05;hpb=1f2b93a24df7b9914dbbc1a26a6e76c8da6511d1;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 849dc9b..a0774ef 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -1,5 +1,5 @@ ;;; gnus-draft.el --- draft message support for Semi-gnus -;; Copyright (C) 1997, 1998, 1999, 2000 +;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -48,6 +48,7 @@ (gnus-define-keys gnus-draft-mode-map "Dt" gnus-draft-toggle-sending + "e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article' "De" gnus-draft-edit-message "Ds" gnus-draft-send-message "DS" gnus-draft-send-all-messages)) @@ -95,12 +96,18 @@ (defun gnus-draft-edit-message () "Enter a mail/post buffer to edit and send the draft." (interactive) - (let ((article (gnus-summary-article-number))) + (let ((article (gnus-summary-article-number)) + (group gnus-newsgroup-name)) (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-draft-setup-for-editing article gnus-newsgroup-name) - (message-save-drafts) + (gnus-draft-setup article group t) + (set-buffer-modified-p t) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-remove-header "date"))) + (save-buffer) (let ((gnus-verbose-backends nil)) - (gnus-request-expire-articles (list article) gnus-newsgroup-name t)) + (gnus-request-expire-articles (list article) group t)) (push `((lambda () (when (gnus-buffer-exists-p ,gnus-summary-buffer) @@ -118,30 +125,38 @@ (while (setq article (pop articles)) (gnus-summary-remove-process-mark article) (unless (memq article gnus-newsgroup-unsendable) - (let ((message-sending-message - (format "Sending message %d of %d..." + (let ((message-sending-message + (format "Sending message %d of %d..." (- total (length articles)) total))) (gnus-draft-send article gnus-newsgroup-name t)) (gnus-summary-mark-article article gnus-canceled-mark))))) (defun gnus-draft-send (article &optional group interactive) "Send message ARTICLE." - (let ((message-syntax-checks (if interactive nil + (let ((message-syntax-checks (if interactive message-syntax-checks 'dont-check-for-anything-just-trust-me)) - (message-inhibit-body-encoding (or (not group) + (message-hidden-headers nil) + (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")) + type method move-to) + (gnus-draft-setup article (or group "nndraft:queue")) ;; 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-target-move-group-header) + ":") nil t) + (skip-syntax-forward "-") + (setq move-to (buffer-substring (point) (gnus-point-at-eol))) + (message-remove-header gnus-agent-target-move-group-header)) + (goto-char (point-min)) + (when (re-search-forward (concat "^" (regexp-quote gnus-agent-meta-information-header) ":") nil t) (setq type (ignore-errors (read (current-buffer))) @@ -151,25 +166,20 @@ (gnus-agent-restore-gcc) ;; Then we send it. If we have no meta-information, we just send ;; it and let Message figure out how. - (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))) + (when (and (or (null method) + (gnus-server-opened method) + (gnus-open-server method)) + (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)) + (if move-to + (gnus-inews-do-gcc move-to) + (message-send-and-exit))) + (if move-to + (gnus-inews-do-gcc move-to) + (message-send-and-exit)))) (let ((gnus-verbose-backends nil)) (gnus-request-expire-articles (list article) (or group "nndraft:queue") t))))) @@ -177,10 +187,14 @@ (defun gnus-draft-send-all-messages () "Send all the sendable drafts." (interactive) - (gnus-uu-mark-buffer) - (gnus-draft-send-message)) + (when (or + gnus-expert-user + (gnus-y-or-n-p + "Send all drafts? ")) + (gnus-uu-mark-buffer) + (gnus-draft-send-message))) -(defun gnus-group-send-drafts () +(defun gnus-group-send-queue () "Send all sendable articles from the queue group." (interactive) (gnus-activate-group "nndraft:queue") @@ -190,6 +204,7 @@ (cdr (assq 'unsend (gnus-info-marks (gnus-get-info "nndraft:queue")))))) + (gnus-posting-styles nil) (total (length articles)) article) (while (setq article (pop articles)) @@ -199,6 +214,20 @@ (- total (length articles)) total))) (gnus-draft-send article))))))) +;;;###autoload +(defun gnus-draft-reminder () + "Reminder user if there are unsent drafts." + (interactive) + (if (gnus-alive-p) + (let (active) + (catch 'continue + (dolist (group '("nndraft:drafts" "nndraft:queue")) + (setq active (gnus-activate-group group)) + (if (and active (>= (cdr active) (car active))) + (if (y-or-n-p "There are unsent drafts. Confirm to exit? ") + (throw 'continue t) + (error "Stop!")))))))) + ;;; Utility functions (defcustom gnus-draft-decoding-function @@ -212,32 +241,42 @@ ;;;!!!This has been fixed in recent versions of Emacs and XEmacs, ;;;!!!but for the time being, we'll just run this tiny function uncompiled. -(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)) - (set-buffer gnus-draft-send-draft-buffer) - (erase-buffer) - (if (not (gnus-request-restore-buffer article group)) - (error "Couldn't restore the article") - ))) +(defun gnus-draft-setup (narticle group &optional restore) + (let (ga) + (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") + (when (and restore + (equal group "nndraft:queue")) + (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) + (setq ga (message-fetch-field gnus-draft-meta-information-header)) + (message-set-auto-save-file-name)))) + (gnus-backlog-remove-article group narticle) + (when (and ga + (ignore-errors (setq ga (car (read-from-string ga))))) + (setq gnus-newsgroup-name + (if (equal (car ga) "") nil (car ga))) + (gnus-configure-posting-styles) + (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) + (setq message-post-method + `(lambda (arg) + (gnus-post-method arg ,(car ga)))) + (unless (equal (cadr ga) "") + (message-add-action + `(progn + (gnus-add-mark ,(car ga) 'replied ,(cadr ga)) + (gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga)) + 'add '(reply))))) + 'send))))) (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable."