X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-draft.el;h=e397a701da84be49f1ad12b5ab1d55b2b828d896;hp=bf613f9ff0050ef4ffe5aee8574b3441fc1789d6;hb=97d82b45ea314d211c74dbc4121a4610df881fe6;hpb=20bc985a3232ebba106d335afcfd6b596bb8efba diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index bf613f9ff..e397a701d 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, 2009, 2010 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -33,23 +32,21 @@ (require 'nndraft) (require 'gnus-agent) (eval-when-compile (require 'cl)) +(eval-when-compile + (when (featurep 'xemacs) + (require 'easy-mmode))) ; for `define-minor-mode' ;;; Draft minor mode -(defvar gnus-draft-mode nil - "Minor mode for providing a draft summary buffers.") - -(defvar gnus-draft-mode-map nil) - -(unless gnus-draft-mode-map - (setq gnus-draft-mode-map (make-sparse-keymap)) - - (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)) +(defvar gnus-draft-mode-map + (let ((map (make-sparse-keymap))) + (gnus-define-keys 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) + map)) (defun gnus-draft-make-menu-bar () (unless (boundp 'gnus-draft-menu) @@ -62,21 +59,17 @@ ["Send all messages" gnus-draft-send-all-messages t] ["Delete draft" gnus-summary-delete-article t])))) -(defun gnus-draft-mode (&optional arg) +(define-minor-mode gnus-draft-mode "Minor mode for providing a draft summary buffers. \\{gnus-draft-mode-map}" - (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))) - ;; Set up the menu. - (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)))) + :lighter " Draft" :keymap gnus-draft-mode-map + (cond + ((not (derived-mode-p 'gnus-summary-mode)) (setq gnus-draft-mode nil)) + (gnus-draft-mode + ;; Set up the menu. + (when (gnus-visual-p 'draft-menu 'menu) + (gnus-draft-make-menu-bar))))) ;;; Commands @@ -97,6 +90,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 +98,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 +112,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 +141,10 @@ message-send-hook)) (message-setup-hook (and (not is-queue) message-setup-hook)) + (gnus-message-setup-hook (and (not is-queue) + gnus-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 +153,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 +213,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 +237,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 +266,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,13 +290,41 @@ (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 + (equal (file-remote-p file) + (file-remote-p 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