* lisp/xgit-dvc.el: Add DVC glue for xgit-gnus-send-commit-notification.
* lisp/xgit-gnus.el (xgit-gnus-apply-patch): Stop at first match, show
error if no match found.
(xgit-mail-notification-destination): New option that implements a
mapping of working directories to email destination info.
(xgit-mail-notification-sign-off-p): New option that indicates whether
to sign off on commits or not.
(xgit-gnus-send-commit-notification): New function that implements
sending of email commit notifications. In this case, the notification
is basically a git patch, since that's how the git mailing list does
it.
---
Committed revision cb64c299da9ee14e8dbf8080bac9f02eb24be6dc
to <git://git.hcoop.net/git/mwolson/emacs/dvc.git>.
lisp/xgit-dvc.el | 2 +
lisp/xgit-gnus.el | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++--
2 files changed, 94 insertions(+), 3 deletions(-)
diff --git a/lisp/xgit-dvc.el b/lisp/xgit-dvc.el
index 08cf47e..8baecff 100644
--- a/lisp/xgit-dvc.el
+++ b/lisp/xgit-dvc.el
@@ -123,5 +123,7 @@ ARG is passed as prefix argument"
(defalias 'xgit-dvc-clone 'xgit-clone)
+(defalias 'xgit-dvc-send-commit-notification
'xgit-gnus-send-commit-notification)
+
(provide 'xgit-dvc)
;;; xgit-dvc.el ends here
diff --git a/lisp/xgit-gnus.el b/lisp/xgit-gnus.el
index 510a849..d8a4b17 100644
--- a/lisp/xgit-gnus.el
+++ b/lisp/xgit-gnus.el
@@ -40,6 +40,8 @@
;; bindings are set up by dvc-insinuate-gnus
)
+;;; Applying patches from email messages
+
(defcustom xgit-apply-patch-mapping nil
"*Working directories in which patches should be applied.
@@ -85,9 +87,13 @@ patches from the entire message."
(gnus-write-buffer patch-file-name))
(goto-char (point-min))
(re-search-forward "^To: " nil t)
- (dolist (m xgit-apply-patch-mapping)
- (when (looking-at (car m))
- (setq working-dir (dvc-uniquify-file-name (cadr m))))))
+ (catch 'found
+ (dolist (m xgit-apply-patch-mapping)
+ (when (looking-at (car m))
+ (setq working-dir (dvc-uniquify-file-name (cadr m)))
+ (throw 'found t)))
+ (error (concat "Unable to find an matching entry in"
+ " `xgit-apply-patch-mapping'"))))
(gnus-summary-show-article)
(delete-other-windows)
(dvc-buffer-push-previous-window-config)
@@ -155,5 +161,88 @@ patch begins."
(re-search-forward "^---$" nil t)
(forward-line 1))
+;;; Sending commit notifications
+
+(defcustom xgit-mail-notification-destination nil
+ "An alist of rules which map working directories to both target
+email addresses and the prefix string for the subject line.
+
+This is used by the `xgit-send-commit-notification' function."
+ :type '(repeat (list :tag "Rule"
+ (string :tag "Working directory")
+ (string :tag "Email subject prefix")
+ (string :tag "Email address")
+ (string :tag "Repo location (optional)")))
+ :group 'dvc-xgit)
+
+(defcustom xgit-mail-notification-sign-off-p nil
+ "If non-nil, add a Signed-Off-By header to any mail commit notifications."
+ :type 'boolean
+ :group 'dvc-xgit)
+
+(defun xgit-gnus-send-commit-notification ()
+ "Send a commit notification email for the changelog entry at point.
+
+The option `xgit-mail-notification-destination' can be used to
+specify a prefix for the subject line. The rest of the subject
+line contains the summary line of the commit. Additionally, the
+destination email address can be specified."
+ (interactive)
+ (let (dest-specs)
+ (catch 'found
+ (dolist (m xgit-mail-notification-destination)
+ (when (string= default-directory (file-name-as-directory (car m)))
+ (setq dest-specs (cdr m))
+ (throw 'found t)))
+ (error (concat "Unable to find an matching entry in"
+ " `xgit-mail-notification-destination'")))
+ (let* ((rev (dvc-revlist-get-revision-at-point))
+ (repo-location (nth 2 dest-specs)))
+ (destructuring-bind (from subject body)
+ (dvc-run-dvc-sync
+ 'xgit (delq nil (list "format-patch" "--stdout" "-k" "-1"
+ (when xgit-mail-notification-sign-off-p "-s")
+ rev))
+ :finished
+ (lambda (output error status args)
+ (with-current-buffer output
+ (let (from subject body)
+ (goto-char (point-min))
+ (when (re-search-forward "^From: *\\(.+\\)$" nil t)
+ (setq from (match-string 1)))
+ (goto-char (point-min))
+ (when (re-search-forward "^Subject: *\\(.+\\)$" nil t)
+ (setq subject (match-string 1)))
+ (goto-char (point-min))
+ (when (re-search-forward "^$" nil t)
+ (forward-line 1)
+ (setq body (buffer-substring (point) (point-max))))
+ (list from subject body)))))
+ (message "Preparing commit email for revision %s" rev)
+ (let ((gnus-newsgroup-name nil))
+ (compose-mail (if dest-specs (cadr dest-specs) "")
+ (concat (if dest-specs (car dest-specs) "")
+ subject)))
+ (when from
+ (message-replace-header "From" from))
+ (message-goto-body)
+ ;; do not PGP sign the message as per git convention
+ (when (looking-at "<#part[^>]*>")
+ (let ((beg (point)))
+ (forward-line 1)
+ (delete-region beg (point))))
+ (save-excursion
+ (when body
+ (insert body))
+ (when repo-location
+ (message-goto-body)
+ (when (re-search-forward "^---$" nil t)
+ (insert "\nCommitted revision " rev "\n"
+ "to <" repo-location ">.\n")))
+ (goto-char (point-max))
+ (unless (and (bolp) (looking-at "^$"))
+ (insert "\n"))
+ (message-goto-body))))))
+
(provide 'xgit-gnus)
;;; xgit-gnus.el ends here
--
1.5.4.3
--
| Michael Olson | FSF Associate Member #652 |
| http://mwolson.org/ | Hobbies: Lisp, HCoop |
| Projects: Emacs, Muse, ERC, EMMS, ErBot, DVC, Planner |
`-------------------------------------------------------'
_______________________________________________
Dvc-dev mailing list
[email protected]
https://mail.gna.org/listinfo/dvc-dev
