X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-draft.el;h=2a5894db84325f979b3012f9e0c5c88ca0725463;hb=9fe47876d6f4cf0b3fae6c5eaa8cf7a17660f685;hp=6e60a49fb242a22a5b6372a2d35d707fd2b1b3f9;hpb=ba5b45dade739d7d6ed0988c4bfbd7a5afec9877;p=gnus diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index 6e60a49fb..2a5894db8 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -1,26 +1,25 @@ ;;; 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, 2007, 2008 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; 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. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -75,7 +74,6 @@ (when (gnus-visual-p 'draft-menu 'menu) (gnus-draft-make-menu-bar)) (add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map) - (mml-mode) (gnus-run-hooks 'gnus-draft-mode-hook)))) ;;; Commands @@ -97,6 +95,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) @@ -104,7 +103,9 @@ (save-restriction (message-narrow-to-headers) (message-remove-header "date"))) - (save-buffer) + (let ((message-draft-headers + (delq 'Date (copy-sequence message-draft-headers)))) + (save-buffer)) (let ((gnus-verbose-backends nil)) (gnus-request-expire-articles (list article) group t)) (push @@ -116,11 +117,13 @@ message-send-actions))) (defun gnus-draft-send-message (&optional n) - "Send the current draft." + "Send the current draft(s). +Obeys the standard process/prefix convention." (interactive "P") (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) @@ -211,6 +216,7 @@ (gnus-info-marks (gnus-get-info "nndraft:queue")))))) (gnus-posting-styles nil) + message-send-mail-partially-limit (total (length articles)) article) (while (setq article (pop articles)) @@ -234,6 +240,12 @@ (throw 'continue t) (error "Stop!")))))))) +(defcustom gnus-draft-setup-hook nil + "Hook run after setting up a draft buffer." + :group 'gnus-message + :version "23.1" ;; No Gnus + :type 'hook) + ;;; Utility functions ;;;!!!If this is byte-compiled, it fails miserably. @@ -257,9 +269,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 @@ -278,12 +293,40 @@ (gnus-add-mark ,(car ga) 'replied ,article) (gnus-request-set-mark ,(car ga) (list (list (list ,article) 'add '(reply))))) - 'send))))))) + 'send)))) + (run-hooks 'gnus-draft-setup-hook)))) (defun gnus-draft-article-sendable-p (article) "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 ;;; gnus-draft.el ends here