;;; org-maint.el --- Helpers for porting Emacs commits to Org  -*- lexical-binding: t; -*-

;; Copyright (C) 2020-2022 Kyle Meyer

;; Author: Kyle Meyer <kyle@kyleam.com>

;; 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/>.

;;; Code:

(require 'org)

(defvar org-maint-emacs-dir "~/src/savannah/emacs/")
(defvar org-maint-org-dir "~/src/savannah/org-mode--ports/")

(defun org-maint-apply-emacs-commit (commit &optional apply)
  "Apply COMMIT from `org-maint-emacs-dir' to `org-maint-org-dir'.
If APPLY is non-nil, use 'git apply' instead of 'git am'."
  (interactive (list (or (and (use-region-p)
                              (buffer-substring-no-properties
                               (region-beginning) (region-end)))
                         (and (fboundp 'magit-commit-at-point)
                              (magit-commit-at-point))
                         (read-string "Emacs commit: "))
                     current-prefix-arg))
  (unless (and org-maint-org-dir org-maint-emacs-dir)
    (user-error "Need to set org-maint-org-dir and org-maint-emacs-dir"))
  (with-temp-buffer
    (let ((default-directory org-maint-emacs-dir))
      (call-process "git" nil t nil
                    "format-patch" "--stdout"
                    (format "%s^..%s" commit commit)
                    "--" "lisp/org"))
    (let ((default-directory org-maint-org-dir))
      (call-process-region (point-min) (point-max)
                           "git" nil t nil
                           (if apply "apply" "am")
                           "-p3" "--directory=lisp/"))))

(defun org-maint-insert-emacs-commit-info (commit)
  "Insert information about COMMIT from `org-maint-emacs-dir'."
  (interactive "sCommit: ")
  (let ((default-directory org-maint-emacs-dir))
    (call-process "git" nil t nil
                  "show" "-s" "--format=%b%n%s%n%H%n%an%n%cd"
                  commit)))

(defun org-maint-rev-from-next-item ()
  (save-excursion
    (or (and (re-search-forward (rx "- [" (or " " "X") "] "
                                    (group (= 40 hex-digit))))
             (match-string-no-properties 1))
        (user-error "Next revision item not found"))))

(defun org-maint-check-for-new ()
  "Check for new commits in the Emacs repository to port.

Determine \"new\" commits by looking for commits that 1) touch
Org files, 2) are contained in the Emacs reference specified by
the Org \"ref\" property, and 3) are _not_ included in the
revision returned by `org-maint-rev-from-next-item'.

If a reference is specified by the Org property \"exclude-ref\",
don't consider commits contained in this reference new."
  (interactive)
  (let ((revs (nconc
               (list (or (org-entry-get (point) "ref")
                         (user-error "No reference found"))
                     (concat "^" (org-maint-rev-from-next-item)))
               (and-let* ((ex-ref (org-entry-get (point) "exclude-ref")))
                 (list (concat "^" ex-ref)))))
        (default-directory org-maint-emacs-dir))
    (with-current-buffer (get-buffer-create "*org-maint-new-entries*")
      (goto-char (point-min))
      (erase-buffer)
      (insert (format ";; revisions: %S\n\n" revs))
      (apply #'call-process "git" nil t nil
             "log" "--oneline" "--format=- [ ] %H%n%n  %s%n  %an%n  %cd%n"
             (nconc revs
                    (list "--"
                          "doc/misc/org.org"
                          "doc/misc/org-setup.org"
                          "etc/ORG-NEWS"
                          "etc/org"
                          "etc/refcards/orgcard.tex"
                          "etc/schema/"
                          "lisp/org")))
      (display-buffer (current-buffer)))))

(provide 'org-maint)
;;; org-maint.el ends here