X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-draft.el;h=47b093910663e59bee18c9f22c2f769a4f00ee76;hb=6ddf4efe9c1528cc39fb33ffd455351316cc3d1f;hp=6c40d9fc8b55379f666df2b6b4e86cc9c563d599;hpb=42e28f7726b7a79a3cb0fff60c92eea2675570e5;p=gnus diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 6c40d9fc8..47b093910 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -1,7 +1,8 @@ ;;; gnus-draft.el --- draft message support for Gnus -;; Copyright (C) 1997 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -30,6 +31,7 @@ (require 'message) (require 'gnus-msg) (require 'nndraft) +(require 'gnus-agent) (eval-when-compile (require 'cl)) ;;; Draft minor mode @@ -53,7 +55,11 @@ (easy-menu-define gnus-draft-menu gnus-draft-mode-map "" '("Drafts" - ["Toggle whether to send" gnus-draft-toggle-sending t])))) + ["Toggle whether to send" gnus-draft-toggle-sending t] + ["Edit" gnus-draft-edit-message t] + ["Send selected message(s)" gnus-draft-send-message t] + ["Send all messages" gnus-draft-send-all-messages t] + ["Delete draft" gnus-summary-delete-article t])))) (defun gnus-draft-mode (&optional arg) "Minor mode for providing a draft summary buffers. @@ -62,13 +68,14 @@ (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)) (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map) - (run-hooks 'gnus-draft-mode-hook)))) + (mml-mode) + (gnus-run-hooks 'gnus-draft-mode-hook)))) ;;; Commands @@ -87,35 +94,76 @@ (defun gnus-draft-edit-message () "Enter a mail/post buffer to edit and send the draft." (interactive) - (gnus-set-global-variables) (let ((article (gnus-summary-article-number))) - (gnus-draft-setup article gnus-newsgroup-name) + (gnus-summary-mark-as-read article gnus-canceled-mark) + (gnus-draft-setup article gnus-newsgroup-name t) + (set-buffer-modified-p t) + (save-buffer) + (let ((gnus-verbose-backends nil)) + (gnus-request-expire-articles (list article) gnus-newsgroup-name t)) (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)) - (gnus-cache-possibly-remove-article ,article nil nil nil t) - (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) + (set-buffer ,gnus-summary-buffer) + (gnus-cache-possibly-remove-article ,article nil nil nil t))))) message-send-actions))) (defun gnus-draft-send-message (&optional n) "Send the current draft." (interactive "P") - (gnus-set-global-variables) - (let ((articles (gnus-summary-work-articles n)) - article) + (let* ((articles (gnus-summary-work-articles n)) + (total (length articles)) + article) (while (setq article (pop articles)) (gnus-summary-remove-process-mark article) (unless (memq article gnus-newsgroup-unsendable) - (gnus-draft-send article) + (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) +(defun gnus-draft-send (article &optional group interactive) "Send message ARTICLE." - (gnus-draft-setup article "nndraft:queue") - (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)) - (message-send-and-exit))) + (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 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-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))) + ;; Let Agent restore any GCC lines and have message.el perform them. + (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 (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)) + (message-send-and-exit)) + (message-send-and-exit))) + (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." @@ -126,32 +174,71 @@ (defun gnus-group-send-drafts () "Send all sendable articles from the queue group." (interactive) - (gnus-request-group "nndraft:queue") + (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")))))) + (total (length articles)) + article) (while (setq article (pop articles)) (unless (memq article unsendable) - (gnus-draft-send article)))))) + (let ((message-sending-message + (format "Sending message %d of %d..." + (- 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 -(defun gnus-draft-setup (narticle group) - (gnus-setup-message 'forward - (message-mail) - (erase-buffer) - (if (not (gnus-request-restore-buffer narticle group)) - (error "Couldn't restore the article") - ;; Insert the separator. - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - (forward-line 1)))) +;;;!!!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 &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")) + (mime-to-mml)) + ;; 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)))) + (when (and ga + (ignore-errors (setq ga (car (read-from-string ga))))) + (setq message-post-method + `(lambda (arg) + (gnus-post-method arg ,(car ga)))) + (message-add-action + `(gnus-add-mark ,(car ga) 'replied ,(cadr ga)) + 'send))))) (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable."