Hello all,

Some time ago we discussed how to mail patches using Gnus. I have
implemented (last night) the feature for Gnus. If it is of use, we can
consider sending it to emacs upstream.

It works from dired and allows you to

1. import all patches into the DRAFTS group (ie nndraft:drafts) where
   you can use commands already available to edit or send patches. See
   the menu entry when you are in the DRAFTS group.

2. send directly from a dired buffer i.e. you can mark all patches and
   then type C-c C-m C-s.

To use this, apply the attached patch to gnus-dired.el and eval

  (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode)

Comments and improvements are welcome.

Cheers,
Leo


Date: Mon, 12 Jul 2010 00:20:55 +0100
Subject: [PATCH] New functions to send emails in mbox files from dired

New functions gnus-dired-map-over-mbox,
gnus-dired-import-mbox-as-draft and gnus-dired-send-mbox.
---
 lisp/gnus/gnus-dired.el |   77 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 76 insertions(+), 1 deletions(-)

diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index 595a9fe..1e78cdf 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -40,6 +40,7 @@
 ;;; Code:
 
 (require 'dired)
+(eval-when-compile (require 'cl))
 (autoload 'mml-attach-file "mml")
 (autoload 'mm-default-file-encoding "mm-decode");; Shift this to `mailcap.el'?
 (autoload 'mailcap-extension-to-mime "mailcap")
@@ -64,8 +65,10 @@
   (setq gnus-dired-mode-map (make-sparse-keymap))
 
   (define-key gnus-dired-mode-map "\C-c\C-m\C-a" 'gnus-dired-attach)
+  (define-key gnus-dired-mode-map "\C-c\C-m\C-i" 
'gnus-dired-import-mbox-as-draft)
   (define-key gnus-dired-mode-map "\C-c\C-m\C-l" 'gnus-dired-find-file-mailcap)
-  (define-key gnus-dired-mode-map "\C-c\C-m\C-p" 'gnus-dired-print))
+  (define-key gnus-dired-mode-map "\C-c\C-m\C-p" 'gnus-dired-print)
+  (define-key gnus-dired-mode-map "\C-c\C-m\C-s" 'gnus-dired-send-mbox))
 
 ;; FIXME: Make it customizable, change the default to `mail-user-agent' when
 ;; this file is renamed (e.g. to `dired-mime.el').
@@ -185,6 +188,78 @@ filenames."
        (setq files-to-attach (cdr files-to-attach)))
       (message "Attached file(s) %s" files-str))))
 
+(defvar message-unix-mail-delimiter)   ; quiet compiler
+(declare-function nndraft-request-associate-buffer "nndraft")
+(declare-function gnus-agent-queue-setup "gnus-agent")
+(autoload 'gnus-alive-p "gnus-util")
+(autoload 'message-fetch-field "message")
+(autoload 'message-add-header "message")
+(autoload 'message-send "message")
+(autoload 'message-narrow-to-headers-or-head "message")
+(autoload 'message-remove-header "message")
+(autoload 'message-make-message-id "message")
+
+(defun gnus-dired-map-over-mbox (function mbox-files)
+  "Call FUNCTION for each email in MBOX-FILES."
+  (let (beg end email)
+    (dolist (m mbox-files)
+      (with-temp-buffer
+       (insert-file-contents m)
+       (while (re-search-forward message-unix-mail-delimiter nil t)
+         (replace-match "")
+         (setq beg (point))
+         (if (re-search-forward message-unix-mail-delimiter nil t)
+             (setq end (goto-char (match-beginning 0)))
+           (setq end (point-max)))
+         (setq email (buffer-substring beg end))
+         (delete-region beg end)
+         (with-temp-buffer
+           (insert email)
+           (goto-char (point-min))
+           (re-search-forward "^$")
+           (insert mail-header-separator)
+           (funcall function)))))))
+
+(defun gnus-dired-import-mbox-as-draft (&rest mbox-files)
+  "Import emails in MBOX-FILES into the draft group."
+  (interactive (dired-get-marked-files))
+  (assert (gnus-alive-p) nil "Gnus is not running")
+  (gnus-agent-queue-setup "drafts")
+  (let (mid)
+    (gnus-dired-map-over-mbox
+     (lambda ()
+       (nndraft-request-associate-buffer "drafts")
+       (message-narrow-to-headers-or-head)
+       (if mid
+          (let ((refs (message-fetch-field "references")))
+            (and refs (message-remove-header "References"))
+            (message-add-header (format "References: %s %s" (or refs "") mid)))
+        (setq mid (message-make-message-id))
+        (message-add-header (format "Message-Id: %s" mid)))
+       (save-buffer 0))
+     mbox-files)))
+
+(defun gnus-dired-send-mbox (&rest mbox-files)
+  "Send all emails in MBOX-FILES."
+  (interactive (dired-get-marked-files))
+  (let (mid to-address)
+    (gnus-dired-map-over-mbox
+     (lambda ()
+       (message-mode)
+       (message-narrow-to-headers-or-head)
+       (if mid
+          (let ((refs (message-fetch-field "references")))
+            (and refs (message-remove-header "References"))
+            (message-add-header (format "References: %s %s" (or refs "") mid)))
+        (setq mid (message-make-message-id))
+        (message-add-header (format "Message-Id: %s" mid)))
+       (unless (message-fetch-field "to")
+        (unless to-address
+          (setq to-address (read-string "To address: ")))
+        (message-add-header (format "To: %s" to-address)))
+       (message-send))
+     mbox-files)))
+
 (autoload 'mailcap-parse-mailcaps "mailcap" "" t)
 
 (defun gnus-dired-find-file-mailcap (&optional file-name arg)
-- 
1.7.1.1


Reply via email to