;;; 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 "28"))
;; 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 three main functions
;; - `git-email-send-email', `git-email-format-patch' 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-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'.
;; 
;; `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.

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

(defface git-email-revision-face '((t :inherit font-lock-comment-face))
  "Face used for the revision when selecting from the minibuffer.")

(defcustom git-email-apply-patch-function
  'git-email--shell-command-on-body
  "Function that executes a shell command on the body of the message.
This function should take one argument, it should be the shell command to
execute.  By default it is determined by the `git-email-apply-patch-command'
variable."
  :type 'symbol
  :group 'git-email)

(defcustom git-email-apply-patch-command "git am"
  "Command to run to apply the patch."
  :type 'string
  :group 'git-email)

;; Compile 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")

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

(defun git-email--shell-command-on-body (command)
  "Get the body of the message in the current buffer and run COMMAND on it."
  (shell-command-on-region (point-min) (point-max) command))

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

(defun git-email--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 (butlast (split-string
			 (shell-command-to-string
			  (concat
			   "git log --no-color --date=short "
			   "--pretty='format:%h %d %s'"
			   " --abbrev-commit -n "
			   (int-to-string git-email-revision-limit)))
			 "\n")))
	 ;; Colorize
	 (colored-revs
	  (mapcar (lambda (rev)
		    (concat
		     (propertize
		      (replace-regexp-in-string "\\([a-f0-9]+\\) .*$"
						"\\1" rev)
		      'face 'git-email-revision-face)
		     (propertize
		      (replace-regexp-in-string "[a-f0-9]+ \\(.*$\\)"
						"\\1" rev)
		      'face 'default)))
		  revs))
	 ;; 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 colored-revs string pred)))))
    (substring (completing-read "Revision: " sorted-revs) 0 7)))

;;;###autoload
(defun git-email-apply-patch (project)
  "Apply the patch in the current buffer using 'git am' in PROJECT."
  (interactive (list (project-prompt-project-dir)))
  (let ((default-directory project))
    (push (list project) project--list)
    (funcall git-email-apply-patch-function
	     git-email-apply-patch-command)))

;;;###autoload
(defun git-email-send-email ()
  "Send patch(es) to someone."
  (interactive)
  (let ((files (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))))

;;;###autoload
(defun git-email-format-patch (&optional args)
  "Format and send patch(es) using 'git format-patch'.
With optional ARGS (\\[universal-argument]) you can specify extra
arguments to give to 'git format-patch'.  By default, the
arguments in `git-email-format-patch-default-args' will be used."
  (interactive "P")
  (let* ((rev (git-email--get-revision))
	 ;; Extra arguments.
	 (args (if args
		   (apply
		    #'concat (mapcar
			      (lambda (a) (concat a " "))
			      (list (completing-read-multiple
				     "Args: "
				     git-email-format-patch-extra-args))))
		 git-email-format-patch-default-args))
	 ;; List of patches generated, the last element is an empty string
	 ;; so remove it.  Reverse the list so we edit the cover letter first.
	 (files (nreverse (butlast (split-string (shell-command-to-string
						  (concat "git format-patch " args " " rev))
						 "\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))))

(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