;;; 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.1.0
;; Package-Requires: ((emacs "25.1") (project "0.5.0"))
;; Keywords: git email
;; 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' and `git-email-apply-patch'.
;;
;; `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-apply-patch' will apply the patch that you are currently viewing
;; and it will ask to for the project that the patch belongs to.

;;; TODO:

;; * Add proper syntax highlighting to diffs in the message buffer.
;;
;; * Add wrapper for 'git format-patch' that automatically marks the
;;   the newly generated patch files.

;;; Code:

(require 'project)
(require 'message)

(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-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))

(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-no-properties
     (- (re-search-forward "\n\n") 1)
     (point-max))))

(defun git-email--dired ()
  "Return list of filenames for marked files in `dired'.
If no marks are found, return the filename at point."
  (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 ()
  "Return list of filenames for marked files in `vc-dir'.
If no marks are found, return the filename at point."
  (let* ((marked-files (nreverse (vc-dir-marked-files)))
	 (files (if marked-files
		    marked-files
		  (list (vc-dir-current-file)))))
    files))

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

(defun git-email--get-filenames ()
  "Return list of filenames for marked files in `vc-dir'.
If no marks are found, return the filename at point."
  (cond ((eq major-mode 'dired-mode)
	 (git-email--dired))
	((eq major-mode 'vc-dir-mode)
	 (git-email--vc-dir))
	((eq major-mode 'ibuffer-mode)
	 (git-email--ibuffer))
	(t
	 (message "Not a supported major mode"))))

;;;###autoload
(defun git-email-send-email ()
  "Send patch(es) to someone."
  (interactive)
  (let ((files (git-email--get-filenames)))
	(dolist (file files)
	  (run-hooks 'git-email-pre-compose-email-hook)
	  (git-email--compose-email file)
	  (run-hooks 'git-email-post-compose-email-hook))))

(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"
	       (substring sendemail-to 13 -1))) ; Remove newline
	 (diff (git-email--extract-diff patch-file)))
    (funcall git-email-compose-email-function to (cadr (assoc 'subject used-headers))
	     ;; Remove 'subject' header, otherwise two subject headers will be
	     ;; inserted.
	     (seq-filter 'git-email--remove-subject used-headers))
    (goto-char (point-min))
    ;; Insert diff at the beginning of the body
    (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 diff)))
    ;; Jump to subject if it is a cover letter
    (when (re-search-backward "\\*\\*\\* SUBJECT HERE \\*\\*\\*" nil t)
      (kill-line))))


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