<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 display the text content of MS Word files.
'    Copyright (C) 2008-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 RegKeyPath = "Plugins\CompareMSWordFiles.sct/"
Dim MsgCannotGetMacros
MsgCannotGetMacros = "${Cannot get Macros." & vbCrLf & _
	"   To allow WinMerge to compare macros, use MS Office to alter the settings in the Macro Security for the current application." & vbCrLf & _
	"   The Trust access to Visual Basic Project feature should be turned on to use this feature in WinMerge." & vbCrLf & "}"

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim wsh: Set wsh = CreateObject("WScript.Shell")
Dim mergeApp

Function isAccessibleVBAProject(doc)
	Dim count
	count = -1
	On Error Resume Next
	count = doc.VBProject.VBComponents.Count
	isAccessibleVBAProject = (count > 0)
End Function

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 writeObjectProperties(fo, items)
	On Error Resume Next
	Dim o
	For Each o In items
		fo.WriteLine o.Name & ": " & o.Value
	Next
End Function

Function writeBookmarks(fo, items)
	On Error Resume Next
	Dim o
	For Each o In items
		fo.WriteLine o.Name & ": " & o.Start
	Next
End Function

Sub ungroupShapes(doc)
    On Error Resume Next
    Dim cnt, shp
    Do
        cnt = doc.Shapes.Count
        For Each shp In doc.Shapes
            shp.ungroup
        Next
    Loop While cnt <> doc.Shapes.Count
End Sub

Function writeTextsInShapes(fo, doc)
	Dim shp
	On Error Resume Next
	For Each shp In doc.Shapes
		fo.WriteLine shp.Name & ": " & shp.TextFrame.TextRange.Text
	Next
End Function

Function getModuleExtension(cmp)
	Select Case cmp.Type
	Case 2
		getModuleExtension = ".cls"
	Case 3
		getModuleExtension = ".frm"
	Case Else
		getModuleExtension = ".bas"
	End Select
End Function

Function get_PluginEvent()
	get_PluginEvent = "FILE_FOLDER_PACK_UNPACK"
End Function

Function get_PluginDescription()
	get_PluginDescription = "Display the text content of MS Word files"
End Function

Function get_PluginFileFilters()
	get_PluginFileFilters = "\.doc(\..*)?$;\.dot(\..*)?$;\.docx(\..*)?$;\.docm(\..*)?$;\.dotx(\..*)?$;\.dotm(\..*)?$"
End Function

Function get_PluginIsAutomatic()
	get_PluginIsAutomatic = True
End Function

Function get_PluginExtendedProperties()
	get_PluginExtendedProperties = "ProcessType=Content Extraction;FileType=MS-Word;MenuCaption=MS-Word"
End Function

Sub PluginOnEvent(eventType, obj)
	Set mergeApp = obj
End Sub

Function UnpackFile(fileSrc, fileDst, pbChanged, pSubcode)
	Dim fo
	Dim wd 
	Dim doc
	Dim cmp
	Dim fileSrc2

	Set fo = fso.CreateTextFile(fileDst, True, True)

	Set wd = CreateObject("Word.Application")
	wd.DisplayAlerts = False

	fileSrc2 = fileSrc
	If fso.GetExtensionName(fileSrc2) = "lnk" Then
		fileSrc2 = wsh.CreateShortcut(fileSrc2).TargetPath
		If Not fso.FileExists(fileSrc2) Then
			Err.Raise 30001, "CompareMSWordFiles.sct", fileSrc & ": Target file '" & fileSrc2 & "' not found"
		End If 
	End If
	Set doc = wd.Documents.Open(fileSrc2)

	On Error Resume Next

	If regRead(RegKeyPath & "CompareDocumentProperties", False) Then
		fo.WriteLine "[Document Properties]"
		writeObjectProperties fo, doc.BuiltinDocumentProperties
		fo.WriteLine ""
	End If

	If regRead(RegKeyPath & "CompareBookmarks", True) Then
		fo.WriteLine "[Bookmarks]"
		writeBookmarks fo, doc.Bookmarks
		fo.WriteLine ""
	End If

	If regRead(RegKeyPath & "CompareTextContents", True) Then
		fo.WriteLine "[Text Contents]"
		fo.Write doc.Content.Text
		fo.WriteLine ""
	End If

	If regRead(RegKeyPath & "CompareTextsInShapes", True) Then
		fo.WriteLine "[Shapes]"
		ungroupShapes doc
		writeTextsInShapes fo, doc
		fo.WriteLine ""
	End If

	If regRead(RegKeyPath & "CompareVBAMacros", True) Then
		If Not isAccessibleVBAProject(doc) Then
			fo.WriteLine Translate(MsgCannotGetMacros)
		End If
		For Each cmp In doc.VBProject.VBComponents
			fo.WriteLine "[CodeModule." & cmp.Name & "]"
			If cmp.CodeModule.CountOfLines > 0 Then
				fo.WriteLine cmp.CodeModule.Lines(1, cmp.CodeModule.CountOfLines)
			End If
			fo.WriteLine ""
		Next
	End If

	doc.Saved = True
	doc.Close
	Set doc = Nothing
	wd.Quit
	Set wd = Nothing

	fo.Close
	Set fo = Nothing

	pbChanged = True
	pSubcode = 0
	UnpackFile = True

End Function

Function PackFile(fileSrc, fileDst, pbChanged, pSubcode)
	PackFile = False
End Function

Function IsFolder(file)
	IsFolder = regRead(RegKeyPath & "UnpackToFolder", False)
End Function

Function UnpackFolder(fileSrc, folderDst, pbChanged, pSubcode)
	Dim fo
	Dim wd
	Dim doc
	Dim cmp
	Dim fileSrc2

	If Not fso.FolderExists(folderDst) Then fso.CreateFolder folderDst

	Set wd = CreateObject("Word.Application")
	wd.DisplayAlerts = False

	fileSrc2 = fileSrc
	If fso.GetExtensionName(fileSrc2) = "lnk" Then
		fileSrc2 = wsh.CreateShortcut(fileSrc2).TargetPath
		If Not fso.FileExists(fileSrc2) Then
			Err.Raise 30001, "CompareMSWordFiles.sct", fileSrc & ": Target file '" & fileSrc2 & "' not found"
		End If 
	End If
	Set doc = wd.Documents.Open(fileSrc2)

	On Error Resume Next

	If regRead(RegKeyPath & "CompareDocumentProperties", False) Then
		Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, "(0)DocumentProperties.txt"), True, True)
		writeObjectProperties fo, doc.BuiltinDocumentProperties
		fo.Close
	End If

	If regRead(RegKeyPath & "CompareBookmarks", True) Then
		Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, "(0)Bookmarks.txt"), True, True)
		writeBookmarks fo, doc.Bookmarks
		fo.Close
	End If

	If regRead(RegKeyPath & "CompareTextContents", True) Then
		Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, "Document.txt"), True, True)
		fo.Write doc.Content.Text
		fo.Close
	End If

	If regRead(RegKeyPath & "CompareTextsInShapes", True) Then
		Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, "Shapes.txt"), True, True)
		ungroupShapes doc
		writeTextsInShapes fo, doc
		fo.Close
	End If

	If regRead(RegKeyPath & "CompareDocumentsAsHTML", True) Then
		doc.SaveAs fso.BuildPath(folderDst, "Document.htm"), 10 ' wdFormatFilteredHTML
	End If
	If regRead(RegKeyPath & "CompareVBAMacros", True) Then
		If Not isAccessibleVBAProject(doc) Then
			Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, "CannotGetMacros.bas"), True, True)
			fo.WriteLine Translate(MsgCannotGetMacros)
			fo.Close
		End If
		
		For Each cmp In doc.VBProject.VBComponents
			cmp.Export fso.BuildPath(folderDst, cmp.Name & getModuleExtension(cmp))
		Next
	End If

	doc.Close
	Set doc = Nothing
	wd.Quit
	Set wd = Nothing
	Set fo = Nothing

	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

</script>

<script language="JScript">

var REGKEY_PATH = "Plugins\\CompareMSWordFiles.sct/";

function exportSettingsToJSONFile(filepath)
{
	var key_defvalues = {
		"UnpackToFolder" : false,
		"CompareDocumentProperties" : false,
		"CompareBookmarks" : true,
		"CompareTextContents" : true,
		"CompareDocumentsAsHTML" : true,
		"CompareTextsInShapes" : true,
		"CompareVBAMacros" : true
	};
	var fso = new ActiveXObject("Scripting.FileSystemObject");
	var ts = fso.OpenTextFile(filepath, 2, true, -1);
	var json = "{";
	for (var key in key_defvalues) {
		var val = regRead(REGKEY_PATH + key, key_defvalues[key]);
		json += '"' + (REGKEY_PATH + key).replace(/\\/g, "\\\\") + '" : ' + ((typeof val == "string") ? ('"' + val.replace(/[\\"']/g, '\\$&') + '"') : val) + ',';
	}
	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>${CompareMSWordFiles.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\\CompareMSWordFiles.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);

        chkUnpackToFolder.checked = regRead(REGKEY_PATH + "UnpackToFolder", false);
        chkCompareDocumentProperties.checked = regRead(REGKEY_PATH + "CompareDocumentProperties", false);
        chkCompareBookmarks.checked = regRead(REGKEY_PATH + "CompareBookmarks", true);
        chkCompareTextContents.checked = regRead(REGKEY_PATH + "CompareTextContents", true);
        chkCompareDocumentsAsHTML.checked = regRead(REGKEY_PATH + "CompareDocumentsAsHTML", true);
        chkCompareTextsInShapes.checked = regRead(REGKEY_PATH + "CompareTextsInShapes", true);
        chkCompareVBAMacros.checked = regRead(REGKEY_PATH + "CompareVBAMacros", true);
        chkUnpackToFolder_onclick();
        chkCompareDocumentsAsHTML_onclick();
      }

      function chkUnpackToFolder_onclick() {
        if (!chkUnpackToFolder.checked)
          chkCompareDocumentsAsHTML.checked = false;
      }

      function chkCompareDocumentsAsHTML_onclick() {
        if (chkCompareDocumentsAsHTML.checked)
          chkUnpackToFolder.checked = true;
      }

      function btnOk_onclick() {
        regWrite(REGKEY_PATH + "UnpackToFolder", chkUnpackToFolder.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "CompareDocumentProperties", chkCompareDocumentProperties.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "CompareBookmarks", chkCompareBookmarks.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "CompareTextContents", chkCompareTextContents.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "CompareDocumentsAsHTML", chkCompareDocumentsAsHTML.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "CompareTextsInShapes", chkCompareTextsInShapes.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "CompareVBAMacros", chkCompareVBAMacros.checked, "REG_DWORD"); window.close();

        saveSettingsToJSONFile(jsonFilePath, settings);

        window.close();
      }

      function btnCancel_onclick() {
        saveSettingsToJSONFile(jsonFilePath, "{}");

        window.close();
      }

    </script>
  </head>
  <body onload="onload();">
    <div class="container">
      <ul>
        <li>
          <input id="chkUnpackToFolder" type="checkbox" onclick="chkUnpackToFolder_onclick();"/>
          <label>${Extract document data to multiple files}</label>
        </li>
        <li>
          <input id="chkCompareDocumentProperties" type="checkbox" />
          <label>${Compare document properties}</label>
        </li>
        <li>
          <input id="chkCompareBookmarks" type="checkbox" />
          <label>${Compare bookmarks}</label>
        </li>
        <li>
          <input id="chkCompareTextContents" type="checkbox" />
          <label>${Compare text contents of documents}</label>
        </li>
        <li>
          <input id="chkCompareDocumentsAsHTML" type="checkbox" onclick="chkCompareDocumentsAsHTML_onclick();"/>
          <label>${Compare documents as HTML file (very slow)}</label>
        </li>
        <li>
          <input id="chkCompareTextsInShapes" type="checkbox" />
          <label>${Compare texts in shapes}</label>
        </li>
        <li>
          <input id="chkCompareVBAMacros" type="checkbox" />
          <label>${Compare VBA macros}</label>
        </li>
      </ul>
      <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>
