Import No Gnus v0.4.

[elisp/gnus.git-] / lisp / gnus-draft.el

diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el
index 2eca0ff..2c53aa7 100644 (file)
--- a/lisp/gnus-draft.el
+++ b/lisp/gnus-draft.el
@@ -1,6 +1,7 @@
 ;;; gnus-draft.el --- draft message support for Gnus
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -19,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -97,6 +98,7 @@
   (interactive)
   (let ((article (gnus-summary-article-number))
        (group gnus-newsgroup-name))
+    (gnus-draft-check-draft-articles (list article))
     (gnus-summary-mark-as-read article gnus-canceled-mark)
     (gnus-draft-setup article group t)
     (set-buffer-modified-p t)
@@ -121,6 +123,7 @@
   (let* ((articles (gnus-summary-work-articles n))
         (total (length articles))
         article)
+    (gnus-draft-check-draft-articles articles)
     (while (setq article (pop articles))
       (gnus-summary-remove-process-mark article)
       (unless (memq article gnus-newsgroup-unsendable)
@@ -143,6 +146,8 @@
                                  message-send-hook))
          (message-setup-hook (and (not is-queue)
                                   message-setup-hook))
+        (message-signature (and (not is-queue)
+                                message-signature))
          (gnus-agent-queue-mail (and (not is-queue)
                                      gnus-agent-queue-mail))
         (rfc2047-encode-encoded-words nil)
@@ -151,7 +156,7 @@
     ;; We read the meta-information that says how and where
     ;; this message is to be sent.
     (save-restriction
-      (message-narrow-to-head)
+      (message-narrow-to-headers)
       (when (re-search-forward
             (concat "^" (regexp-quote gnus-agent-target-move-group-header)
                     ":") nil t)
@@ -257,9 +262,12 @@
            (goto-char (point-min))
            (search-forward "\n\n")
            (forward-char -1)
+           (save-restriction
+             (narrow-to-region (point-min) (point))
+             (setq ga
+                   (message-fetch-field gnus-draft-meta-information-header)))
            (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
@@ -284,6 +292,32 @@
   "Say whether ARTICLE is sendable."
   (not (memq article gnus-newsgroup-unsendable)))
 
+(defun gnus-draft-check-draft-articles (articles)
+  "Check whether the draft articles ARTICLES are under edit."
+  (when (equal gnus-newsgroup-name "nndraft:drafts")
+    (let ((buffers (buffer-list))
+         file buffs buff)
+      (save-current-buffer
+       (while (and articles
+                   (not buff))
+         (setq file (nndraft-article-filename (pop articles))
+               buffs buffers)
+         (while buffs
+           (set-buffer (setq buff (pop buffs)))
+           (if (and buffer-file-name
+                    (string-equal (file-truename buffer-file-name)
+                                  (file-truename file))
+                    (buffer-modified-p))
+               (setq buffs nil)
+             (setq buff nil)))))
+      (when buff
+       (let* ((window (get-buffer-window buff t))
+              (frame (and window (window-frame window))))
+         (if frame
+             (gnus-select-frame-set-input-focus frame)
+           (pop-to-buffer buff t)))
+       (error "The draft %s is under edit" file)))))
+
 (provide 'gnus-draft)
 
 ;;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022