<scriptlet>
<implements type="Automation" id="dispatcher">
	<property name="PluginEvent">
		<get/>
	</property>
	<property name="PluginDescription">
		<get/>
	</property>
	<property name="PluginFileFilters">
		<get/>
	</property>
	<property name="PluginIsAutomatic">
		<get/>
	</property>
	<property name="PluginExtendedProperties">
		<get/>
	</property>
	<method name="PluginOnEvent"/>
	<method name="UnpackFile"/>
	<method name="PackFile"/>
	<method name="IsFolder"/>
	<method name="UnpackFolder"/>
	<method name="PackFolder"/>
	<method name="ShowSettingsDialog"/>
</implements>

<script language="VBS">

'/////////////////////////////////////////////////////////////////////////////
'    This is a plugin for WinMerge.
'    It will apply selected patch to specified file or folder using GnuWin32 Patch For Windows.
'    Copyright (C) 2015-2023 Takashi Sawanaka
'
'    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 2 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, write to the Free Software
'    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
'

Option Explicit

Const REGKEY_PATH = "HKEY_CURRENT_USER\Software\Thingamahoochie\WinMerge"
Const PLUGIN_NAME = "ApplyPatch.sct WinMerge Plugin"

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim wsh: Set wsh = CreateObject("WScript.Shell")
Dim PrevFileName: PrevFileName = ""
Dim mergeApp

Function regRead(Key, DefaultValue)
	regRead = DefaultValue
	On Error Resume Next
	If IsEmpty(mergeApp) Then
		regRead = wsh.RegRead("HKCU\Software\Thingamahoochie\WinMerge\" & Replace(Key, "/", "\"))
	Else
		regRead = mergeApp.GetOption(Key, DefaultValue)
	End If
End Function

Sub regWrite(Key, Value, TypeNm)
	On Error Resume Next
	If IsEmpty(mergeApp) Then
		wsh.RegWrite "HKCU\Software\Thingamahoochie\WinMerge\" &  Replace(Key, "/", "\"), Value, TypeNm
	Else
		mergeApp.SaveOption Key, Value
	End If
End Sub

Function Fmt(formatString, args)
    Dim i
    For i = 0 To UBound(args)
        formatString = Replace(formatString, "%" & (i + 1), args(i))
    Next
    Fmt = formatString
End Function

Function get_PluginEvent()
    get_PluginEvent = "FILE_FOLDER_PACK_UNPACK"
End Function

Function get_PluginDescription()
    get_PluginDescription = "Apply patch using GnuWin32 Patch for Windows"
End Function

Function get_PluginFileFilters()
    get_PluginFileFilters = "\.diff$;\.patch$"
End Function

Function get_PluginIsAutomatic()
    get_PluginIsAutomatic = False
End Function

Function get_PluginExtendedProperties()
    get_PluginExtendedProperties = "MenuCaption=Apply Patch..."
End Function

Sub PluginOnEvent(eventType, obj)
    Set mergeApp = obj
End Sub

Function UnpackFile(fileSrc, fileDst, pbChanged, pSubcode)
    Dim filePatched, cmdLine, msg

    UnpackFile = False

    If Not IsPatchFile(fileSrc) Then
        ' FIXME:
        PrevFileName = fileSrc
        fso.CopyFile fileSrc, fileDst
        pbChanged = True
        pSubcode = 1
        UnpackFile = True
        Exit Function
    End If

    If PrevFileName <> "" Then
        filePatched = PrevFileName
    Else
        filePatched = regRead("Files\Left/Item_0", "")
    End If
    If IsPatchFile(filePatched) Then
        filePatched = regRead("Files\Right/Item_0", "")
    End If

    msg = Fmt(Translate("${Enter the name of the file to which the patch '%1' will be applied}"), Array(fso.GetFileName(fileSrc)))
    Do While True
        filePatched = InputBox(msg, PLUGIN_NAME, filePatched)
        If filePatched = "" Then
            Exit Function
        End If
        If fso.FileExists(filePatched) Then Exit Do
        MsgBox Fmt(Translate("${File '%1' does not exist}"), Array(filePatched)), vbExclamation
    Loop

    cmdLine = "type """ & fileSrc & """ | patch " & IIf(IsWindowsTextFormat(fileSrc), "", "--binary ") & "$FILE"
    msg = Translate("${Enter the command line arguments for patch command}")
    cmdLine = InputBox(msg, PLUGIN_NAME, cmdLine)
    If cmdLine = "" Then Exit Function
    cmdLine = Replace(cmdLine, "$FILE", fileDst)
        
    fso.CopyFile filePatched, fileDst

    Run wsh, "cmd.exe /s /c ""set PATH=" & GetPatchExeFolder() & ";%PATH% & " & cmdLine & " & pause"""

    pbChanged = True
    pSubcode = 0
    UnpackFile = True
End Function

Function PackFile(fileSrc, fileDst, pbChanged, pSubcode)
    If pSubcode <> 0 Then
        ' FIXME:
        fso.CopyFile fileSrc, fileDst
        pbChanged = True
        PackFile = True
        Exit Function
    End If
    PackFile = False
End Function

Function IsFolder(file)
    IsFolder = IsPatchFile(file)
End Function

Function UnpackFolder(fileSrc, folderDst, pbChanged, pSubcode)
    Dim dirPatched, cmdLine, msg, files, stripCount

    UnpackFolder = False

    If Not fso.FolderExists(folderDst) Then fso.CreateFolder folderDst

    dirPatched = regRead("Files\Left/Item_0", "")
    If Not fso.FolderExists(dirPatched) Then
        dirPatched = regRead("Files\Right/Item_0", "")
    End If

    msg = Fmt(Translate("${Enter the name of the folder to which the patch '%1' will be applied}"), Array(fso.GetFileName(fileSrc)))
    Do While True
        dirPatched = InputBox(msg, PLUGIN_NAME, dirPatched)
        If dirPatched = "" Then
            fso.CopyFile fileSrc, fso.BuildPath(folderDst, fso.GetFileName(fileSrc)) & ".txt"
            Exit Function
        End If
        If fso.FolderExists(dirPatched) Then Exit Do
        MsgBox Fmt(Translate("${Folder '%1' does not exist}"), dirPatched), vbExclamation
    Loop

    files = GetFileNamesInPatch(fileSrc)
    stripCount = GuessStripCount(files, dirPatched)

    cmdLine = "type """ & fileSrc & """ | patch " & IIf(IsWindowsTextFormat(fileSrc), "", "--binary") & " -p" & stripCount
    msg = Translate("${Enter the command line arguments for patch command}")
    cmdLine = InputBox(msg, PLUGIN_NAME, cmdLine)
    If cmdLine = "" Then
        fso.CopyFile fileSrc, fso.BuildPath(folderDst, fso.GetFileName(fileSrc)) & ".txt"
        Exit Function
    End If
        
    stripCount = GetStripCountFromCmdLine(cmdLine)
    If stripCount = 0 Then
        If HasAbsolutePathInList(files) Then
            msg = Translate("${Should not specify the '-p0' command line option for the patch file which includes absolute paths}")
            MsgBox msg, vbExclamation
            Exit Function
        End If
    End If

    CopyOriginalFiles dirPatched, folderDst, files, stripCount

    Run wsh, "cmd.exe /s /c ""set PATH=" & GetPatchExeFolder() & ";%PATH% & cd /d " & folderDst & " & " & cmdLine & " & pause"""

    pbChanged = True
    pSubcode = 0
    UnpackFolder = True
End Function

Function PackFolder(fileSrc, folderDst, pbChanged, pSubcode)
    PackFolder = False
End Function

Function Translate(text)
	Dim re: Set re = CreateObject("VBScript.RegExp")
	re.Pattern = "\${([^}]+)}"
	re.Global = True
	Translate = text
	Dim match
	Dim matches:Set matches = re.Execute(text)
	if IsEmpty(mergeApp) Then
		For Each match in matches
			Translate = Replace(Translate, match.Value, match.Submatches(0))
		Next
	Else
		For Each match in matches
			Translate = Replace(Translate, match.Value, mergeApp.Translate(match.Submatches(0)))
		Next
	End If
End Function

Function ShowSettingsDialog()
    Dim tname: tname = fso.BuildPath(fso.GetSpecialFolder(2), fso.GetTempName() & ".hta")
    Dim jsonfile: jsonfile = fso.BuildPath(fso.GetSpecialFolder(2), fso.GetTempName() & ".json")
    Dim tfile: Set tfile = fso.CreateTextFile(tname, True, True)
    Dim mshta
    tfile.Write Translate(getResource("dialog1"))
    tfile.Close
    exportSettingsToJSONFile jsonfile
    mshta = wsh.ExpandEnvironmentStrings("%SystemRoot%\System32\mshta.exe")
    If Not fso.FileExists(mshta) Then
        mshta = wsh.ExpandEnvironmentStrings("%SystemRoot%\SysWOW64\mshta.exe")
    End If
    Run wsh, """" & mshta & """ """ & tname & """  """ & jsonfile  & """"
    importSettingsFromJSONFile jsonfile
    fso.DeleteFile tname
    fso.DeleteFile jsonfile
End Function

Sub Run(sh, cmd)
    sh.Run cmd, 1, True
End Sub

Function GetPatchExeFolder()
    Dim winMergeExePath
    On Error Resume Next
    winMergeExePath = "C:\Program Files\WinMerge\WinMergeU.exe"
    winMergeExePath = wsh.RegRead(REGKEY_PATH & "\Executable")
    GetPatchExeFolder = fso.BuildPath(fso.GetParentFolderName(winMergeExePath), "Commands\GnuWin32\bin")
End Function

Function SafeUBound(ary)
    On Error Resume Next
    SafeUBound = -1
    SafeUBound = UBound(ary)
End Function

Function IIf(cond, t, f)
    If cond Then IIf = t Else IIf = f
End Function

Function IsPatchFile(path)
    Dim patterns, pattern, re
    patterns = Split(get_PluginFileFilters(), ";")
    For Each pattern In patterns
        Set re = CreateObject("VBScript.RegExp")
        re.Pattern = pattern
        re.IgnoreCase = True
        If re.Test(path) Then
            IsPatchFile = True
            Exit Function
        End If
    Next
    IsPatchFile = False
End Function

Function IsWindowsTextFormat(path)
    IsWindowsTextFormat = (InStr(ReadAllText(path), vbCrLf) > 0)
End Function

Function IsAbsolutePath(path)
    IsAbsolutePath = (Mid(path, 2, 1) = ":" Or Left(path, 1) = "/" Or Left(path, 1) = "\")
End Function

Function HasAbsolutePathInList(files)
    Dim i
    For i = 0 To SafeUBound(files)
        If IsAbsolutePath(files(i)(0)) Then
            HasAbsolutePathInList = True
            Exit Function
        End If
    Next
    HasAbsolutePathInList = False
End Function

Function IsNullDevice(path)
    IsNullDevice = (path = "/dev/null" Or UCase(path) = "NUL")
End Function

Function StripDir(fileName, stripCount)
    Dim i, pos, posNext1, posNext2
    If stripCount = -1 Then
        StripDir = fso.GetFileName(fileName)
        Exit Function
    ElseIf stripCount = 0 Then
        StripDir = fileName
        Exit Function
    End If
    pos = 1
    For i = 0 To stripCount - 1
        posNext1 = InStr(pos, fileName, "/")
        posNext2 = InStr(pos, fileName, "\")
        If posNext1 > 0 And (posNext1 < posNext2 Or posNext2 = 0) Then
            pos = posNext1 + 1
        ElseIf posNext2 > 0 And (posNext2 < posNext1 Or posNext1 = 0) Then
            pos = posNext2 + 1
        Else
            pos = 0
            Exit For
        End If
    Next
    If pos = 0 Then
        StripDir = ""
    Else
        StripDir = Mid(fileName, pos)
    End If
End Function

Function MakePatchedFileName(destDir, fileName, stripCount)
    Dim strippedFileName
    If Not IsNullDevice(fileName) Then
        strippedFileName = StripDir(fileName, stripCount)
        If strippedFileName = "" Then
            MakePatchedFileName = ""
        Else
            If Not IsAbsolutePath(strippedFileName) Then
                MakePatchedFileName = fso.BuildPath(destDir, strippedFileName)
            Else
                MakePatchedFileName = strippedFileName
            End If
        End If
    Else
        MakePatchedFileName = fileName
    End If
End Function

Function GuessStripCount(fileNamesInPatch, destDir)
    Dim i, j, fileName, stripCount
    Dim matchCount, maxMatchCount
    GuessStripCount = 0
    stripCount = 0
    maxMatchCount = 0
    If SafeUBound(fileNamesInPatch) < 0 Then Exit Function
    Do While True
        matchCount = 0
        For i = 0 To SafeUBound(fileNamesInPatch)
            For j = 0 To 1
                If Not IsNullDevice(fileNamesInPatch(i)(j)) Then
                    fileName = MakePatchedFileName(destDir, fileNamesInPatch(i)(j), stripCount)
                    If fso.FileExists(fileName) Then
                        matchCount = matchCount + 1
                    End If
                End If
            Next
        Next
        If matchCount > maxMatchCount Then
            GuessStripCount = stripCount
        End If
        stripCount = stripCount + 1
        If stripCount > 64 Then Exit Do
    Loop
End Function

Sub CreateFolderEx(ByVal dirName)
    Dim parent
    parent = fso.GetParentFolderName(dirName)
    If fso.FolderExists(parent) Then
        If Not fso.FolderExists(dirName) Then
            fso.CreateFolder dirName
        End If
    Else
        CreateFolderEx parent
        fso.CreateFolder dirName
    End If
End Sub

Sub CopyOriginalFiles(srcDir, destDir, fileNamesInPatch, stripCount)
    Dim i
    Dim fileNameSrc, fileNameDest
    For i = 0 To SafeUBound(fileNamesInPatch)
        If Not IsNullDevice(fileNamesInPatch(i)(0)) Then
            fileNameSrc = MakePatchedFileName(srcDir, fileNamesInPatch(i)(0), stripCount)
            fileNameDest = MakePatchedFileName(destDir, fileNamesInPatch(i)(0), stripCount)
            If fso.FileExists(fileNameSrc) Then
                If Not fso.FolderExists(fso.GetParentFolderName(fileNameDest)) Then
                    CreateFolderEx fso.GetParentFolderName(fileNameDest)
                End If
                fso.CopyFile fileNameSrc, fileNameDest
            End If
        End If
    Next
End Sub

Function ReadAllText(fileName)
    Dim stream
    Set stream = CreateObject("ADODB.Stream")
    stream.Open
    stream.Charset = "_autodetect_all"
    stream.LoadFromFile fileName
    ReadAllText = stream.ReadText
    stream.Close
End Function

Function GetFileNamesInPatch(fileName)
    Dim i, n, count, line, lines, text
    Dim re, ml, mr
    Dim ary()

    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "^(---|\+\+\+|\*\*\*) ([^\t\r\n]+)"

    text = ReadAllText(fileName)

    lines = Split(text, vbLf)
    Do While i <= UBound(lines)
        line = lines(i)
        Set ml = re.Execute(line)
        If ml.count > 0 Then
            i = i + 1
            If i <= UBound(lines) Then
                line = lines(i)
                Set mr = re.Execute(line)
                If mr.count > 0 Then
                    ReDim Preserve ary(n)
                    ary(n) = Array(ml(0).SubMatches(1), mr(0).SubMatches(1))
                    n = n + 1
                End If
            End If
        End If
        i = i + 1
    Loop
    GetFileNamesInPatch = ary
End Function

Function GetStripCountFromCmdLine(cmdLine)
    Dim re, m
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "( -p(\d+)| --strip=(\d+))"
    Set m = re.Execute(cmdLine)
    If m.count > 0 Then
        If Not IsEmpty(m(0).SubMatches(1)) Then
            GetStripCountFromCmdLine = CLng(m(0).SubMatches(1))
        Else
            GetStripCountFromCmdLine = CLng(m(0).SubMatches(2))
        End If
    Else
        GetStripCountFromCmdLine = -1
    End If
End Function

</script>

<script language="JScript">

var REGKEY_PATH = "Plugins\\ApplyPatch.sct/";

function exportSettingsToJSONFile(filepath)
{
	var key_defvalues = {
		"Dummy" : true
	};
	var fso = new ActiveXObject("Scripting.FileSystemObject");
	var ts = fso.OpenTextFile(filepath, 2, true, -1);
	var json = "{";
	for (var key in key_defvalues) {
		json += '"' + (REGKEY_PATH + key).replace(/\\/g, "\\\\") + '" : ' + regRead(REGKEY_PATH + key, key_defvalues[key]) + ',';
	}
	json = json.substr(0, json.length - 1) + "}";
	ts.WriteLine(json);
	ts.Close();
}

function importSettingsFromJSONFile(filepath)
{
	var fso = new ActiveXObject("Scripting.FileSystemObject");
	var ts = fso.OpenTextFile(filepath, 1, true, -1);
	var json = ts.ReadAll();
	var settings = eval("(" + json + ")");
	ts.Close();
	for (var key in settings) {
		regWrite(key, settings[key], (typeof settings[key] === "string") ? "REG_SZ" : "REG_DWORD");
	}
}

</script>

<resource id="dialog1">
<![CDATA[
<!DOCTYPE html>
<html>
  <head>
    <HTA:APPLICATION ID="objHTA">
    <title>${ApplyPatch.sct WinMerge Plugin Options}</title>
    <meta content="text/html" charset="UTF-16">
    <style>
    body { background-color: #f2f2f2; font-family: Arial, sans-serif; }
    .container { margin: 2em; }
    ul { list-style-type: none; margin: 0; padding: 0; }
    li ul li { padding-left: 2em }
    .btn-container { margin-top: 1.5em; text-align: right; }
    input[type="button"] { border: none; padding: 0.6em 2em; height: 2.5em; text-align: center; }
    .btn-ok { color: #fff; background-color: #05c; }
    .btn-ok:hover { background-color: #04b; }
    .btn-cancel { color: #333; background-color: #ddd; }
    .btn-cancel:hover { background-color: #ccc; }
    </style>
    <script type="text/javascript">
      var REGKEY_PATH = "Plugins\\ApplyPatch.sct/";
      var jsonFilePath;
      var settings;

      function jsonStringify(obj) {
        if (obj === null) {
          return "null";
        }
        if (typeof obj === "undefined") {
          return undefined;
        }
        if (typeof obj === "number" || typeof obj === "boolean") {
          return obj.toString();
        }
        if (typeof obj === "string") {
          return '"' + escapeString(obj) + '"';
        }
        if (typeof obj === "object") {
          var pairs = [];
          for (var key in obj) {
            if (obj.hasOwnProperty(key)) {
              pairs.push('"' + escapeString(key) + '":' + jsonStringify(obj[key]));
            }
          }
          return "{" + pairs.join(",") + "}";
        }
      }

      function escapeString(str) {
        return str.replace(/[\\"']/g, '\\$&');
      }

      function regRead(key, defaultValue) {
        return settings.hasOwnProperty(key) ? settings[key] : defaultValue;
      }

      function regWrite(key, value, type) {
        settings[key] = (type === "REG_DWORD") ? Number(value) : String(value);
      }

      function loadSettingsFromJSONFile(filepath) {
        var fso = new ActiveXObject("Scripting.FileSystemObject");
        var ts = fso.OpenTextFile(jsonFilePath, 1, true, -1);
        var json = ts.ReadAll();
        var settings = eval("(" + json + ")");
        ts.Close();
        return settings;
      }

      function saveSettingsToJSONFile(filepath, settings) {
        var fso = new ActiveXObject("Scripting.FileSystemObject");
        var ts = fso.OpenTextFile(filepath, 2, true, -1);
        ts.WriteLine(jsonStringify(settings));
        ts.Close();
      }

      function onload() {
        jsonFilePath = objHTA.commandLine.split('"')[3];
        settings = loadSettingsFromJSONFile(jsonFilePath);

        var dpi = window.screen.deviceXDPI;
        var w = 600 * dpi / 96, h = 400 * dpi / 96;
        window.resizeTo(w, h);
        window.moveTo((screen.width - w) / 2, (screen.height - h) / 2);
      }

      function btnOk_onclick() {
        saveSettingsToJSONFile(jsonFilePath, settings);

        window.close();
      }

      function btnCancel_onclick() {
        saveSettingsToJSONFile(jsonFilePath, "{}");

        window.close();
      }

    </script>
  </head>
  <body onload="onload();">
    <div class="container">
      <div class="btn-container">
        <input type="button" class="btn-ok" onclick="btnOk_onclick();" value="${OK}" />
        <input type="button" class="btn-cancel" onclick="btnCancel_onclick();" value="${Cancel}" />
      </div>
    </div>
  </body>
</html>
]]>
</resource>

</scriptlet>
