T-gnus 6.15.24 revision 00.
[elisp/gnus.git-] / lisp / gnus-draft.el
index ebbf39d..4bad775 100644 (file)
@@ -1,8 +1,11 @@
-;;; gnus-draft.el --- draft message support for Gnus
-;; Copyright (C) 1997,98,99 Free Software Foundation, Inc.
+;;; gnus-draft.el --- draft message support for Semi-gnus
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news
+;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;     Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+;; Keywords: mail, news, MIME, offline
 
 ;; This file is part of GNU Emacs.
 
@@ -73,7 +76,6 @@
       (when (gnus-visual-p 'draft-menu 'menu)
        (gnus-draft-make-menu-bar))
       (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map)
-      (mml-mode)
       (gnus-run-hooks 'gnus-draft-mode-hook))))
 
 ;;; Commands
 (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 article gnus-newsgroup-name)
+    (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)
 (defun gnus-draft-send-message (&optional n)
   "Send the current draft."
   (interactive "P")
-  (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 gnus-newsgroup-name t)
+       (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."
-  (gnus-draft-setup article (or group "nndraft:queue"))
-  (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))
-       type method)
+       (message-setup-hook (and group (not (equal group "nndraft:queue"))
+                                message-setup-hook))
+       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)))
              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)
                         (message-this-is-mail (eq type 'mail))
                         (gnus-post-method method)
                         (message-post-method method))
-                    (message-send-and-exit))
-                (message-send-and-exit)))
+                    (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)))))
   (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")
   (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"))))))
+          (gnus-posting-styles nil)
+          (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
 
+(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)
+(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)
-         (message-set-auto-save-file-name))))))
+         (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."