;;; gnus-draft.el --- draft message support for Gnus
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(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)
["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)
- (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))
+ (add-hook 'gnus-summary-prepare-exit-hook 'gnus-draft-clear-marks t t))))
;;; Commands
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)
(let ((message-sending-message
(format "Sending message %d of %d..."
(- total (length articles)) total)))
- (gnus-draft-send article))))))))
+ (gnus-draft-send article))))))
+ (gnus-group-refresh-group "nndraft:queue")))
;;;###autoload
(defun gnus-draft-reminder ()
:version "23.1" ;; No Gnus
:type 'hook)
-;;; Utility functions
-
-;;;!!!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)
- (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)
- (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) "")
- (dolist (article (cdr ga))
- (message-add-action
- `(progn
- (gnus-add-mark ,(car ga) 'replied ,article)
- (gnus-request-set-mark ,(car ga) (list (list (list ,article)
- 'add '(reply)))))
- 'send))))
- (run-hooks 'gnus-draft-setup-hook))))
+(defun gnus-draft-setup (narticle group &optional restore)
+ (let (ga)
+ (gnus-setup-message 'forward
+ (let ((article narticle))
+ (message-mail)
+ (let ((inhibit-read-only t))
+ (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)
+ (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)
+ (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) "")
+ (dolist (article (cdr ga))
+ (message-add-action
+ `(progn
+ (gnus-add-mark ,(car ga) 'replied ,article)
+ (gnus-request-set-mark ,(car ga) (list (list (list ,article)
+ 'add '(reply)))))
+ 'send))))
+ (run-hooks 'gnus-draft-setup-hook)))
(defun gnus-draft-article-sendable-p (article)
"Say whether ARTICLE is sendable."
(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))
(pop-to-buffer buff t)))
(error "The draft %s is under edit" file)))))
+(defun gnus-draft-clear-marks ()
+ (setq gnus-newsgroup-reads nil
+ gnus-newsgroup-marked nil
+ gnus-newsgroup-unreads
+ (gnus-uncompress-range (gnus-active gnus-newsgroup-name))))
+
(provide 'gnus-draft)
-;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022
;;; gnus-draft.el ends here
projects / gnus / blobdiff