path: root/git-email.el

;;; git-email.el --- Work with git and email -*- lexical-binding: t; -*-

;; Copyright (C) 2021 yoctocell

;; Author: yoctocell <public@yoctocell.xyz>
;; URL: https://git.sr.ht/~yoctocell/git-email
;; Version: 0.2.0
;; Package-Requires: ((emacs "27") (project "0.5.0"))
;; Keywords: git mail
;; License: GNU General Public License >= 3

;; This program 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.

;; This program 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 this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This package integrates with git and email and offers two main functions
;;
;; * `git-email-send-email' sends an email based on a patch file generated by
;; 'git format-patch'.  It inserts the relevant headers and the diff into the
;; message buffer.
;;
;; * `git-email-format-patch' is a wrapper for 'git format-patch' and it
;; automatically composes an email for each generated patch, in the same way
;; as `git-email-send-email'.

;;; Code:

(require 'project)
(require 'message)

;;;; Customization options
(defgroup git-email nil
  "Work with git and email."
  :group 'convenience)

(defcustom git-email-compose-email-function #'message-mail
  "The function used to compose patch mail."
  :group 'git-email
  :type 'symbol)

(defcustom git-email-send-email-function #'message-send-and-exit
  "The function used to send mail."
  :type 'symbol
  :group 'git-email)

(defcustom git-email-pre-compose-email-hook nil
  "A list of functions called before running `git-email--compose-email'."
  :type '(hook)
  :group 'git-email)

(defcustom git-email-post-compose-email-hook nil
  "A list of functions called after running `git-email--compose-email'."
  :type '(hook)
  :group 'git-email)

(defcustom git-email-headers
  '(subject from in-reply-to message-id references)
  "List of headers that should get inserted into the message buffer.

The 'to' address will always be inserted based on the
'sendemail.to' variable in you git config.  If the variable is
not set, the 'to' address will be empty."
  :group 'git-email
  :type '(symbol))

(defcustom git-email-get-files-functions
  '(git-email--dired-files
    git-email--ibuffer-files
    git-email--vc-dir-files)
  "An list of functions to for getting a list of patches to send."
  :type '(list symbol)
  :group 'git-email)

(defcustom git-email-format-patch-default-args ""
  "Default arguments to give to 'git format-patch'."
  :type 'string
  :group 'git-email)

(defcustom git-email-format-patch-extra-args
  '("--cover-letter" "--thread" "--output-directory" "--signoff" "--to")
  "List of arguments to display in `git-email-format-patch'."
  :type '(string)
  :group 'git-email)

(defcustom git-email-revision-limit 100
  "How many revisions to show when in `git-email-format-patch'."
  :type 'int
  :group 'git-email)

(defcustom git-email-revision-command
  "git log --no-color --pretty='format:%h %d %s' --abbrev-commit -n "
  "Command to run to get a list of revisions."
  :type 'string
  :group 'git-email)

(defcustom git-email-get-revision-functions '(git-email--log-get-revision)
  "List of functions to get the base commit for 'git format-patch'.
If none of the functions return non-nil value,
`git-email--minibuffer-get-revision' will be used as a fallback."
  :type '(symbol)
  :group 'git-email)

;;;; Remove Compiler warnings
(declare-function dired-get-filename "dired.el")
(declare-function dired-map-over-marks "dired.el")
(declare-function ibuffer-get-marked-buffers "ibuffer.el")
(declare-function vc-dir-marked-files "vc-dir.el")
(declare-function vc-dir-current-file "vc-dir.el")
(declare-function log-view-current-entry "log-view.el")

;;;; Get files to send
(defun git-email--check-file (file)
  "Check if FILE is a patch."
  (if (and (file-readable-p file)
	   (or (string-match-p "\\.patch$" file)
	       (string-match-p "\\.diff$" file)))
      file
    (error "Not a valid patch!")))

(defun git-email--dired-files ()
  "Return list of filenames for marked files in `dired'.
If no marks are found, return the filename at point."
  (when (eq major-mode 'dired-mode)
    (delq nil
	  (mapcar
	   (lambda (f) (if (file-directory-p f) nil f))
	   (dired-map-over-marks (dired-get-filename) nil)))))

(defun git-email--vc-dir-files ()
  "Return list of filenames for marked files in `vc-dir'.
If no marks are found, return the filename at point."
  (when (eq major-mode 'vc-dir)
    (let* ((marked-files (nreverse (vc-dir-marked-files)))
	   (files (if marked-files
		      marked-files
		    (list (vc-dir-current-file)))))
      files)))

(defun git-email--ibuffer-files ()
  "Return list of filenames for marked files in `ibuffer'."
  (when (eq major-mode 'ibuffer-mode)
    (let ((marked-files (nreverse
			 (mapcar (lambda (b) (buffer-file-name b))
				 (ibuffer-get-marked-buffers)))))
      marked-files)))

(defun git-email--minibuffer-file ()
  "Prompt for a file to send as a patch."
  (list (car (find-file-read-args "Find patch: "
				  (confirm-nonexistent-file-or-buffer)))))

(defun git-email--get-files ()
  "Return list of filenames for marked files in `vc-dir'.
If no marks are found, return the filename at point."
  (let ((files (or (seq-some (lambda (fn)
			       (funcall fn))
			     git-email-get-files-functions)
		   (git-email--minibuffer-file))))
    (when (mapcar #'git-email--check-file files)
      files)))

;;;; Get contents from patch
(defun git-email--extract-header (header)
  "Extract HEADER from current buffer."
  (goto-char (point-min))
  (buffer-substring-no-properties
   (if (re-search-forward (format " *%s: +" header) nil t)
       (point)
     (point-at-eol))
   (point-at-eol)))

(defun git-email--extract-headers (patch-file)
  "Extract headers from PATCH-FILE.
If the header is not found, return an empty string."
  (with-temp-buffer
    (insert-file-contents patch-file)
    (mapcar (lambda (header)
	      `(,header ,(git-email--extract-header header)))
	    git-email-headers)))

(defun git-email--extract-diff (patch-file)
  "Extract the diff from PATCH-FILE."
  (with-temp-buffer
    (insert-file-contents patch-file)
    (goto-char (point-min))
    (buffer-substring
     (- (re-search-forward "\n\n") 1)
     (point-max))))

;; See https://emacs.stackexchange.com/a/5408
(defun git-email--fontify-diff (text)
  "Fontify TEXT as diffs in `message-mode'."
  (with-temp-buffer
    (erase-buffer)
    (insert text)
    (delay-mode-hooks (diff-mode))
    (font-lock-default-function #'diff-mode)
    (font-lock-default-fontify-region (point-min)
				      (point-max)
				      nil)
    (buffer-string)))

(defun git-email--fontify-using-faces (text)
  (let ((pos 0))
    (while (setq next (next-single-property-change pos 'face text))
      (put-text-property pos next 'font-lock-face
			 (get-text-property pos 'face text) text)
      (setq pos next))
    (add-text-properties 0  (length text) '(fontified t) text)
    text))

(defun git-email--remove-subject (header)
  "Remove HEADER if it is the subject."
  (not (string-equal (symbol-name (car header)) "subject")))

(defun git-email--compose-email (patch-file)
  "Given a PATCH-FILE, compose an email.
Extracts the relevant headers and the diff from the PATCH-FILE and inserts
them into the message buffer."
  (let* ((default-directory (cdr (project-current)))
	 (headers (git-email--extract-headers patch-file))
	 ;; Remove empty headers.
	 (used-headers (seq-filter
			(lambda (header)
			  (not (string-equal (car (cdr header)) "")))
			headers))
	 ;; Get 'to' address from git.
	 (sendemail-to
	  (shell-command-to-string "git config --list | grep sendemail.to"))
	 (to (if (string-equal sendemail-to "")
		 "*** TO ADDRESS HERE ***"
	       (substring sendemail-to 13 -1))) ; Remove newline
	 (diff (git-email--extract-diff patch-file)))
    (funcall git-email-compose-email-function to
	     ;; Remove 'subject' header, otherwise two subject headers will be
	     ;; inserted.
	     (cadr (assoc 'subject used-headers))
	     (seq-filter #'git-email--remove-subject used-headers))
    ;; Insert diff at the beginning of the body
    (goto-char (point-min))
    (let ((body (or (re-search-forward
		     "<#part \\(encrypt\\|sign\\)=.*mime>"
		     nil t)
		    (re-search-forward "--text follows this line--" nil t))))
      (goto-char (+ body 1))
      (save-excursion
	(insert (git-email--fontify-using-faces
		 (git-email--fontify-diff diff)))))
    ;; Jump to subject or 'to' address if they are emtpy
    (when (or (re-search-backward "\\*\\*\\* TO ADDRESS HERE \\*\\*\\*" nil t)
	      (re-search-backward "\\*\\*\\* SUBJECT HERE \\*\\*\\*" nil t))
      (kill-line))))

;;;; Format patches
(defun git-email--minibuffer-get-revision ()
  "Let the user choose a git revision from the minibuffer."
  (interactive)
  (let* ((default-directory (cdr (project-current)))
	 ;; Last element is an empty string
	 (revs (split-string
		(shell-command-to-string
		 (concat
		  git-email-revision-command
		  (int-to-string git-email-revision-limit)))
		"\n"))
	 ;; Sort the candidates correctly.
	 ;; See https://emacs.stackexchange.com/a/41808.
	 (sorted-revs
	  (lambda (string pred action)
	    (if (eq action 'metadata)
		'(metadata (display-sort-function . identity)
			   (cycle-sort-function . identity))
	      (complete-with-action
	       action revs string pred)))))
    (substring (completing-read "Revision: " sorted-revs) 0 7)))

(defun git-email--log-get-revision ()
  "Get the revision at point in `log-view-mode'."
  (when (eq major-mode 'vc-git-log-view-mode)
    (cadr (log-view-current-entry (point) t))))

;;;###autoload
(defun git-email-format-patch (args range keep)
  "Format and send patch(es) using 'git format-patch'.

ARGS are additional arguments to give to 'git format-patch'.  By
default, the arguments in `git-email-format-patch-default-args'
will be used.

Patches for the commits in RANGE will be created.

With prefix argument KEEP, keep the generated patches.  The
default behavior is to delete them after sending the message."
  (interactive
   (list (apply #'concat (mapcar
			  (lambda (a) (concat a ""))
			  (completing-read-multiple
			   "Args: " git-email-format-patch-extra-args
			   nil nil git-email-format-patch-default-args)))
	 (or (seq-some (lambda (fn)
			 (funcall fn))
		       git-email-get-revision-functions)
	     (git-email--minibuffer-get-revision))
	 current-prefix-arg))
  ;; List of patches generated, the last element is an empty string
  ;; so remove it.  Reverse the list so we edit the cover letter first.
  (let ((files (nreverse (butlast
			  (split-string
			   (shell-command-to-string
			    (format "git format-patch %s %s"
				    args range))
			   "\n")))))
    (dolist (file files)
      (run-hooks 'git-email-pre-compose-email-hook)
      (git-email--compose-email file)
      (run-hooks 'git-email-post-compose-email-hook))
    (unless keep
      (mapc #'delete-file files))))

;;;; Operate on emails
(defun git-email-send-all ()
  "Send all unsent emails."
  (interactive)
  (let ((buffers (message-buffers)))
    (mapc (lambda (b) (switch-to-buffer b)
	    (funcall git-email-send-email-function))
	  buffers)))

;;;###autoload
(defun git-email-send-email (files)
  "Send FILES as patch(es) to someone using your MUA."
  (interactive (list (git-email--get-files)))
  (dolist (file files)
    (run-hooks 'git-email-pre-compose-email-hook)
    (git-email--compose-email file)
    (run-hooks 'git-email-post-compose-email-hook)))

(provide 'git-email)
;;; git-email.el ends here