;;; 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.
;;
;; * Fix `message-header-format-alist' parsing of the 'References' header.
;;
;; * 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
  '(git-email--set-message-header-format)
  "A list of functions called before running `git-email--compose-message'."
  :type 'hook
  :group 'git-email)

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

(defcustom git-email-headers
  '("subject" "from" "in-reply-to" "message-id")
  "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 '(string))

(defun git-email--set-message-header-format ()
  "Set `message-header-format-alist' to parse the 'references' header correctly.
This will be run as a `git-email-pro-compose-email-hook' hook."
  (setq message-header-format-alist
	'((From)
	  (Newsgroups)
	  (To)
	  (Cc)
	  (Subject)
	  (In-Reply-To)
	  (Fcc)
	  (Bcc)
	  (Date)
	  (Organization)
	  (Distribution)
	  (Lines)
	  (Expires)
	  (Message-ID)
	  (References)
	  (User-Agent))))

(defun git-email--reset-message-header-format ()
  "Reset `message-header-format-alist' to the its default value."
  (setq message-header-format-alist
	'((From)
	  (Newsgroups)
	  (To)
	  (Cc)
	  (Subject)
	  (In-Reply-To)
	  (Fcc)
	  (Bcc)
	  (Date)
	  (Organization)
	  (Distribution)
	  (Lines)
	  (Expires)
	  (Message-ID)
	  (References . message-shorten-references)
	  (User-Agent))))

(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)
  (run-hooks 'git-email-pre-compose-email-hook)
  (let ((files (git-email--get-filenames)))
    (prog1
	(dolist (file files)
	  (git-email--compose-email file))
      (run-hooks 'git-email-post-compose-email-hook))))
  
(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))
	 (used-headers (seq-filter
			(lambda (header)
			  (not (string-equal (car (cdr header)) "")))
			headers))
	 (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))
	     used-headers)
    (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 diff)))
    (when (re-search-backward "\\*\\*\\* SUBJECT HERE \\*\\*\\*" nil t)
      (kill-line))))


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