Function: majutsu-interactive--write-applypatch-script

majutsu-interactive--write-applypatch-script is a natively compiled function defined in majutsu-interactive.el.

Signature

(majutsu-interactive--write-applypatch-script PLAN DIRECTORY)

Documentation

Write PLAN's applypatch helper script and return its path.

PLAN describes the editor right tree with :base (left or right),
:payload-root (left or right), a forward text patch, and explicit
whole-file operations. Paths needed by FILE-OPS are snapshotted from the payload root before the right tree is rebuilt. Write the script in DIRECTORY.

Source Code

;; Defined in /nix/store/jagqw3nms546pad0gxi5f3wsckk6pji7-emacs-packages-deps/share/emacs/site-lisp/majutsu-interactive.el
(defun majutsu-interactive--write-applypatch-script (plan directory)
  "Write PLAN's applypatch helper script and return its path.
PLAN describes the editor right tree with :base (`left' or `right'),
:payload-root (`left' or `right'), a forward text patch, and explicit
whole-file operations.  Paths needed by FILE-OPS are snapshotted from the
payload root before the right tree is rebuilt.  Write the script in DIRECTORY."
  (let* ((base (plist-get plan :base))
         (payload-root (plist-get plan :payload-root))
         (file-ops (plist-get plan :file-ops))
         (script (expand-file-name "applypatch.sh" directory)))
    (unless (memq base '(left right))
      (error "Unknown replay plan base: %S" base))
    (unless (memq payload-root '(left right))
      (error "Unknown replay plan payload root: %S" payload-root))
    (with-temp-file script
      (insert "#!/bin/sh\n")
      (insert "# Majutsu applypatch helper\n")
      (insert "# Args: $1=left $2=right $3=patchfile\n")
      (insert "LEFT=\"$1\"\n")
      (insert "RIGHT=\"$2\"\n")
      (insert "PATCH=\"$3\"\n")
      (insert (format "PAYLOAD=\"$%s\"\n" (upcase (symbol-name payload-root))))
      (insert "majutsu_apply_patch() {\n")
      (insert "  [ -s \"$PATCH\" ] || return 0\n")
      (insert "  git apply --recount --unidiff-zero -v \"$PATCH\" 2>&1 && return 0\n")
      (insert "  git init -q || return $?\n")
      (insert "  git add -A || return $?\n")
      (insert "  git -c user.name=Majutsu -c user.email=majutsu.invalid commit -q -m base --allow-empty || return $?\n")
      (insert "  git apply --3way --recount -v \"$PATCH\" 2>&1\n")
      (insert "  STATUS=$?\n")
      (insert "  rm -rf -- .git || return $?\n")
      (insert "  return $STATUS\n")
      (insert "}\n")
      (when file-ops
        (insert "majutsu_remove() { rm -rf -- \"$1\"; }\n")
        (insert "majutsu_copy() {\n")
        (insert "  mkdir -p -- \"$(dirname -- \"$2\")\" || return $?\n")
        (insert "  cp -a -- \"$1\" \"$2\"\n")
        (insert "}\n")
        (insert "PRESERVED=$(mktemp -d \"${TMPDIR:-/tmp}/majutsu-interactive-right.XXXXXX\") || exit $?\n")
        (insert "majutsu_cleanup() { rm -rf -- \"$PRESERVED\"; }\n")
        (insert "trap majutsu_cleanup 0 1 2 3 15\n")
        (dolist (op file-ops)
          (when (memq (plist-get op :action) '(add modify rename copy))
            (let ((path (plist-get op :path)))
              (insert
               (format "majutsu_copy %s %s || exit $?\n"
                       (majutsu-interactive--script-path "PAYLOAD" path)
                       (majutsu-interactive--script-path "PRESERVED" path)))))))
      (when (eq base 'left)
        (insert "# Rebuild right from left state\n")
        (insert "find \"$RIGHT\" -mindepth 1 -maxdepth 1 -exec rm -rf -- {} + || exit $?\n")
        (insert "cp -a -- \"$LEFT\"/. \"$RIGHT\"/ || exit $?\n"))
      (insert "cd \"$RIGHT\" || exit $?\n")
      (insert "majutsu_apply_patch || exit $?\n")
      (dolist (op file-ops)
        (let* ((action (plist-get op :action))
               (path (plist-get op :path))
               (destination (majutsu-interactive--script-path "RIGHT" path))
               (preserved (majutsu-interactive--script-path "PRESERVED" path)))
          (pcase action
            ((or 'add 'modify)
             (insert (format "majutsu_remove %s || exit $?\n" destination))
             (insert (format "majutsu_copy %s %s || exit $?\n"
                             preserved destination)))
            ('delete
             (insert (format "majutsu_remove %s || exit $?\n" destination)))
            ('rename
             (insert
              (format "majutsu_remove %s || exit $?\n"
                      (majutsu-interactive--script-path
                       "RIGHT" (plist-get op :source))))
             (insert (format "majutsu_remove %s || exit $?\n" destination))
             (insert (format "majutsu_copy %s %s || exit $?\n"
                             preserved destination)))
            ('copy
             (insert (format "majutsu_remove %s || exit $?\n" destination))
             (insert (format "majutsu_copy %s %s || exit $?\n"
                             preserved destination)))
            (_ (error "Unknown whole-file operation: %S" action)))))
      (insert "exit 0\n"))
    (set-file-modes script #o755)
    script))