On 2010-08-02 19:19 +0100, Ted Zlatanov wrote: > L> Some time ago we discussed how to mail patches using Gnus. I have > L> implemented (last night) the feature for Gnus. If it is of use, we can > L> consider sending it to emacs upstream. > > I think it's useful. gnus-dired-send-mbox and gnus-dired-map-over-mbox > don't seem very Gnus-specific and people using other MUAs may like them > too, so maybe they should go into dired-aux.el (ask on emacs-devel > though, I don't know if it's OK with the Emacs maintainers). > > Also a final "you are about to send this file %s as e-mail to %s > (y/n/always)" confirmation would be nice. > > Ted
Thank you for your comment. I will get around to them hopefully soonish. Currently the patched have evolved a bit in my local tree: 1. A new meta header X-Draft-Keep-Date to prevent imported drafts from getting a different date after editing 2. Asking for both To and Cc with completion from BBDB if available. The handling of To and Cc has a bit of code duplication which I will clean up at some point.
Thanks. Leo
>From 9ff281348021d3016b78cd9760e3cc528f9dc49f Mon Sep 17 00:00:00 2001 From: Leo <[email protected]> Date: Tue, 20 Jul 2010 23:35:13 +0100 Subject: [PATCH 1/3] 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. Load message.el in gnus-dired-map-over-mbox for message-unix-mail-delimiter. --- lisp/gnus/gnus-dired.el | 63 ++++++++++++++++++++++++++++++++++++++++++++++- 1 files changed, 62 insertions(+), 1 deletions(-) diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index 595a9fe..9d8713c 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,64 @@ filenames." (setq files-to-attach (cdr files-to-attach))) (message "Attached file(s) %s" files-str)))) +(defvar message-unix-mail-delimiter) ; quiet compiler +(autoload 'gnus-alive-p "gnus-util") + +(declare-function nndraft-request-associate-buffer "nndraft") +(declare-function gnus-agent-queue-setup "gnus-agent") +(declare-function message-fetch-field "message") +(declare-function message-add-header "message") +(declare-function message-send "message") +(declare-function message-narrow-to-headers-or-head "message") + +(defun gnus-dired-map-over-mbox (function mbox-files) + "Call FUNCTION for each email in MBOX-FILES." + (require 'message) + (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") + (gnus-dired-map-over-mbox + (lambda () + (nndraft-request-associate-buffer "drafts") + (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 (to-address) + (gnus-dired-map-over-mbox + (lambda () + (message-mode) + (message-narrow-to-headers-or-head) + (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.2
>From e60d7e24fdf6980d66475290e57d184501339aba Mon Sep 17 00:00:00 2001 From: Leo <[email protected]> Date: Tue, 20 Jul 2010 08:03:21 +0100 Subject: [PATCH 2/3] Keep dates for imported drafts Add a meta header field X-Draft-Keep-Date for drafts imported from mbox using gnus-dired.el. The header field Date can contain important information for example 'git format-patch' uses it for commit date. We don't want draft editing to overwrite it. --- lisp/gnus/gnus-dired.el | 18 +++++++++++++----- lisp/gnus/gnus-draft.el | 3 ++- lisp/gnus/message.el | 2 +- 3 files changed, 16 insertions(+), 7 deletions(-) diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index 9d8713c..cf2d177 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -225,11 +225,19 @@ filenames." (interactive (dired-get-marked-files)) (assert (gnus-alive-p) nil "Gnus is not running") (gnus-agent-queue-setup "drafts") - (gnus-dired-map-over-mbox - (lambda () - (nndraft-request-associate-buffer "drafts") - (save-buffer 0)) - mbox-files)) + (let (to-address) + (gnus-dired-map-over-mbox + (lambda () + (message-mode) + (message-narrow-to-headers-or-head) + (message-add-header "X-Draft-Keep-Date: Yes") + (nndraft-request-associate-buffer "drafts") + (unless (message-fetch-field "to") + (unless to-address + (setq to-address (read-string "To address: "))) + (message-add-header (format "To: %s" to-address))) + (save-buffer 0)) + mbox-files))) (defun gnus-dired-send-mbox (&rest mbox-files) "Send all emails in MBOX-FILES." diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 1e6b7ee..d9aa2f2 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -102,7 +102,8 @@ (save-excursion (save-restriction (message-narrow-to-headers) - (message-remove-header "date"))) + (unless (message-fetch-field "x-draft-keep-date") + (message-remove-header "date")))) (let ((message-draft-headers (delq 'Date (copy-sequence message-draft-headers)))) (save-buffer)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 2fe8a4d..d2418c8 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -269,7 +269,7 @@ included. Organization and User-Agent are optional." regexp)) (defcustom message-ignored-mail-headers - "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" + "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Draft-Keep-Date:\\|^X-Gnus-Agent-Meta-Information:" "*Regexp of headers to be removed unconditionally before mailing." :group 'message-mail :group 'message-headers -- 1.7.2
>From 4ac414c618376791f56782589356b4694271512b Mon Sep 17 00:00:00 2001 From: Leo <[email protected]> Date: Fri, 30 Jul 2010 14:31:49 +0100 Subject: [PATCH 3/3] Read emall addresses with completion New function gnus-dired-read-email that uses bbdb-complete-name if available for email completion. Support adding Cc addresses. --- lisp/gnus/gnus-dired.el | 32 ++++++++++++++++++++++++++++---- 1 files changed, 28 insertions(+), 4 deletions(-) diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index cf2d177..9abb2e7 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -198,6 +198,14 @@ filenames." (declare-function message-send "message") (declare-function message-narrow-to-headers-or-head "message") +(defvar gnus-dired-read-email-map (make-sparse-keymap) + "Minibuffer keymap for `gnus-dired-read-email'.") +(set-keymap-parent gnus-dired-read-email-map minibuffer-local-map) +(when (fboundp 'bbdb-complete-name) + (define-key gnus-dired-read-email-map [tab] 'bbdb-complete-name)) +(defsubst gnus-dired-read-email (prompt) + (read-from-minibuffer prompt nil gnus-dired-read-email-map)) + (defun gnus-dired-map-over-mbox (function mbox-files) "Call FUNCTION for each email in MBOX-FILES." (require 'message) @@ -225,7 +233,7 @@ filenames." (interactive (dired-get-marked-files)) (assert (gnus-alive-p) nil "Gnus is not running") (gnus-agent-queue-setup "drafts") - (let (to-address) + (let (to-address cc-address) (gnus-dired-map-over-mbox (lambda () (message-mode) @@ -234,23 +242,39 @@ filenames." (nndraft-request-associate-buffer "drafts") (unless (message-fetch-field "to") (unless to-address - (setq to-address (read-string "To address: "))) + (setq to-address (gnus-dired-read-email "To: "))) (message-add-header (format "To: %s" to-address))) + (unless (or (message-fetch-field "cc") (eq cc-address 'no)) + (unless cc-address + (setq cc-address + (if (yes-or-no-p "Add Cc addresses? ") + (gnus-dired-read-email "Cc: ") + 'no))) + (unless (eq cc-address 'no) + (message-add-header (format "Cc: %s" cc-address)))) (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 (to-address) + (let (to-address cc-address) (gnus-dired-map-over-mbox (lambda () (message-mode) (message-narrow-to-headers-or-head) (unless (message-fetch-field "to") (unless to-address - (setq to-address (read-string "To address: "))) + (setq to-address (gnus-dired-read-email "To address: "))) (message-add-header (format "To: %s" to-address))) + (unless (or (message-fetch-field "cc") (eq cc-address 'no)) + (unless cc-address + (setq cc-address + (if (yes-or-no-p "Add Cc addresses? ") + (gnus-dired-read-email "Cc: ") + 'no))) + (unless (eq cc-address 'no) + (message-add-header (format "Cc: %s" cc-address)))) (message-send)) mbox-files))) -- 1.7.2
