;; notmuch-dev.el --- help for notmuch developers ;; ;; Copyright © David Edmondson ;; ;; This file is part of Notmuch. ;; ;; Notmuch 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 3 of the License, or ;; (at your option) any later version. ;; ;; Notmuch 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 GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with Notmuch. If not, see . ;; ;; Authors: David Edmondson (require 'notmuch-lib) (require 'notmuch-show) (require 'magit) (defgroup notmuch-dev nil "Helpers for notmuch developers." :group 'notmuch) (defcustom notmuch-dev-master-repository "git://notmuchmail.org/git/notmuch" "The URI of the master notmuch repository." :group 'notmuch-dev :type 'string) (defcustom notmuch-dev-temporary-directory temporary-file-directory "A directory in which to place temporary repositories." :group 'notmuch-dev :type 'string) ;; (defvar notmuch-dev-temporary-repository-name (concat "notmuch-dev-" (user-login-name)) "The name of the temporary repository.") (defvar notmuch-dev-temporary-repository-path (file-name-as-directory (file-truename (concat notmuch-dev-temporary-directory "/" notmuch-dev-temporary-repository-name))) "The path of the temporary repository.") (defun notmuch-dev-make-temporary-repository () (unless (file-directory-p notmuch-dev-temporary-repository-path) (message "Cloning %s into %s..." notmuch-dev-master-repository notmuch-dev-temporary-repository-path) (magit-run* (list magit-git-executable "clone" notmuch-dev-master-repository notmuch-dev-temporary-repository-path)) (message "Cloning %s into %s...done." notmuch-dev-master-repository notmuch-dev-temporary-repository-path) (unless (file-directory-p notmuch-dev-temporary-repository-path) (error "git clone failed.")))) (defun notmuch-dev-checkout-master () (magit-checkout "master") (when current-prefix-arg (message "Updating master...") ;; Don't use `magit-pull' because it runs asynchronously. (magit-run-git "pull" "-v") (message "Updating master...done."))) (defun notmuch-dev-delete-branch (name) ;; `magit-delete-branch' uses "-d", which is not sufficiently ;; aggressive for us. (magit-run-git "branch" "-D" name)) (defun notmuch-dev-create-branch (name) ;; Switches to the new branch automatically. (magit-create-branch name "master")) (defun notmuch-dev-flatten-title (title) (let* ((s (downcase title)) (s (replace-regexp-in-string "[ \t/]+" "-" s)) (s (replace-regexp-in-string "[\]\[\"{}:,]" "" s)) (s (replace-regexp-in-string "\\.$" "" s)) ) s)) (defun notmuch-dev-title-to-branch (title) (concat "review/" (notmuch-dev-flatten-title title))) (defun notmuch-dev-title-to-mbox (title) (concat notmuch-dev-temporary-directory "/" (notmuch-dev-flatten-title title) ".mbox")) ;; (defun notmuch-dev-show-review-patch () "Call this from `notmuch-show-mode'." (interactive) (notmuch-dev-review-patch (notmuch-show-get-subject) (mapconcat 'identity (notmuch-show-get-message-ids-for-open-messages) " OR "))) (defun notmuch-dev-review-patch (title search-terms) (let ((patch-name (notmuch-dev-title-to-branch title)) (mbox-path (notmuch-dev-title-to-mbox title))) (notmuch-dev-make-temporary-repository) ;; Switch to the repository directory. (let ((default-directory notmuch-dev-temporary-repository-path)) (notmuch-dev-checkout-master) ;; Delete the branch if it exists. (condition-case nil (notmuch-dev-delete-branch patch-name) (error nil)) (notmuch-dev-create-branch patch-name) ;; Have notmuch generate mailbox format output for the search ;; terms... (with-temp-file mbox-path (erase-buffer) (call-process notmuch-command nil t nil "show" "--format=mbox" search-terms)) ;; ...and feed that to git-am. (magit-run* (list magit-git-executable "am" mbox-path)) (magit-status notmuch-dev-temporary-repository-path)))) ;; (provide 'notmuch-dev)