<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 PowerPoint files.
'    Copyright (C) 2016-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\CompareMSPowerPointFiles.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(prs)
	Dim count
	count = -1
	On Error Resume Next
	count = prs.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 writeShape(fo, shp)
	Dim shp2, shpType, r, c
	On Error Resume Next
	shpType = -1
	shpType = shp.Type
	fo.Write shp.Name & ": "
	If shp.HasTable Then
		For r = 1 To shp.Table.Rows.Count
			For c = 1 To shp.Table.Columns.Count
				fo.Write "(" & r & ", " & c & "): "
				writeShape fo, shp.Table.Cell(r, c).Shape
			Next
		Next
	ElseIf shpType = 6 Then 'msoGroup = 6
		For Each shp2 In shp.GroupItems
		    writeShape fo, shp2
		Next
	ElseIf shp.HasTextFrame Then
		fo.WriteLine shp.TextFrame.TextRange.Characters.Text
	Else
		fo.WriteLine ""
	End If
End Function

Function writeTextsInShapes(fo, shps)
	Dim shp
	On Error Resume Next
	For Each shp In shps
		writeShape fo, shp
	Next
	On Error GoTo 0
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 saveSlideAsImage(sld, filename)
        sld.Export filename, "PNG"
End Function

Function get_PluginEvent()
	get_PluginEvent = "FILE_FOLDER_PACK_UNPACK"
End Function

Function get_PluginDescription()
	get_PluginDescription = "Display the text content of MS PowerPoint files"
End Function

Function get_PluginFileFilters()
	get_PluginFileFilters = "\.ppt(\..*)?$;\.pptx(\..*)?$;\.pptm(\..*)?$;\.ppa(\..*)?$;\.ppam(\..*)?$;\.potx(\..*)?$;\.potm(\..*)?$"
End Function

Function get_PluginIsAutomatic()
	get_PluginIsAutomatic = True
End Function

Function get_PluginExtendedProperties()
	get_PluginExtendedProperties = "ProcessType=Content Extraction;FileType=MS-PowerPoint;MenuCaption=MS-PowerPoint"
End Function

Sub PluginOnEvent(eventType, obj)
	Set mergeApp = obj
End Sub

Function UnpackFile(fileSrc, fileDst, pbChanged, pSubcode)
	Dim fo
	Dim pp
	Dim prs
	Dim sld
	Dim cmp
	Dim fileSrc2

	Set fo = fso.CreateTextFile(fileDst, True, True)

	Set pp = CreateObject("PowerPoint.Application")
	pp.Visible = True
	pp.DisplayAlerts = False

	fileSrc2 = fileSrc
	If fso.GetExtensionName(fileSrc2) = "lnk" Then
		fileSrc2 = wsh.CreateShortcut(fileSrc2).TargetPath
		If Not fso.FileExists(fileSrc2) Then
			Err.Raise 30001, "CompareMSPowerPointFiles.sct", fileSrc & ": Target file '" & fileSrc2 & "' not found"
		End If 
	End If
	Set prs = pp.Presentations.Open(fileSrc2)

	On Error Resume Next

	If regRead(RegKeyPath & "CompareDocumentProperties", False) Then
		fo.WriteLine "[Document Properties]"
		writeObjectProperties fo, prs.BuiltinDocumentProperties
		fo.WriteLine ""
	End If

	For Each sld In prs.Slides
		If regRead(RegKeyPath & "CompareTextsInShapes", True) Then
			fo.WriteLine "[" & sld.Name & "]"
			writeTextsInShapes fo, sld.Shapes
			fo.WriteLine ""
		End If
		If regRead(RegKeyPath & "CompareTextsInNotesPage", True) Then
			fo.WriteLine "[" & sld.Name & ".NotesPage]"
			writeTextsInShapes fo, sld.NotesPage.Shapes
			fo.WriteLine ""
		End If
	Next

	If regRead(RegKeyPath & "CompareVBAMacros", True) Then
		If Not isAccessibleVBAProject(prs) Then
			fo.WriteLine Translate(MsgCannotGetMacros)
		End If
		For Each cmp In prs.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

	Set sld = Nothing
	prs.Close
	Set prs = Nothing
	pp.Quit
	Set pp = 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 pp
	Dim prs
	Dim sld
	Dim cmp
	Dim fileSrc2

	If Not fso.FolderExists(folderDst) Then fso.CreateFolder folderDst

	Set pp = CreateObject("PowerPoint.Application")
	pp.Visible = True
	pp.DisplayAlerts = False

	fileSrc2 = fileSrc
	If fso.GetExtensionName(fileSrc2) = "lnk" Then
		fileSrc2 = wsh.CreateShortcut(fileSrc2).TargetPath
		If Not fso.FileExists(fileSrc2) Then
			Err.Raise 30001, "CompareMSPowerPointFiles.sct", fileSrc & ": Target file '" & fileSrc2 & "' not found"
		End If 
	End If
	Set prs = pp.Presentations.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, prs.BuiltinDocumentProperties
		fo.Close
	End If

	For Each sld In prs.Slides
		If regRead(RegKeyPath & "CompareTextsInShapes", True) Then
			Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, sld.Name & ".txt"), True, True)
			writeTextsInShapes fo, sld.Shapes
			fo.Close
		End If

		If regRead(RegKeyPath & "CompareTextsInNotesPage", True) Then
			Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, sld.Name & "_NotesPage.txt"), True, True)
			writeTextsInShapes fo, sld.NotesPage.Shapes
			fo.Close
		End If

		If regRead(RegKeyPath & "CompareSlideAsImage", True) Then
			saveSlideAsImage sld, fso.BuildPath(folderDst, sld.Name & ".png")
		End If
	Next
	If regRead(RegKeyPath & "CompareVBAMacros", True) Then
		If Not isAccessibleVBAProject(prs) Then
			Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, "CannotGetMacros.bas"), True, True)
			fo.WriteLine Translate(MsgCannotGetMacros)
			fo.Close
		End If
		
		For Each cmp In prs.VBProject.VBComponents
			cmp.Export fso.BuildPath(folderDst, cmp.Name & getModuleExtension(cmp))
		Next
	End If

	Set sld = Nothing
	prs.Close
	Set prs = Nothing
	pp.Quit
	Set pp = 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\\CompareMSPowerPointFiles.sct/";

function exportSettingsToJSONFile(filepath)
{
	var key_defvalues = {
		"UnpackToFolder" : false,
		"CompareDocumentProperties" : false,
		"CompareSlideAsImage" : true,
		"CompareTextsInShapes" : true,
		"CompareTextsInNotesPage" : 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>${CompareMSPowerPointFiles.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\\CompareMSPowerPointFiles.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);
        chkCompareSlideAsImage.checked = regRead(REGKEY_PATH + "CompareSlideAsImage", true);
        chkCompareTextsInShapes.checked = regRead(REGKEY_PATH + "CompareTextsInShapes", true);
        chkCompareTextsInNotesPage.checked = regRead(REGKEY_PATH + "CompareTextsInNotesPage", true);
        chkCompareVBAMacros.checked = regRead(REGKEY_PATH + "CompareVBAMacros", true);
        chkUnpackToFolder_onclick();
        chkCompareSlideAsImage_onclick();
      }

      function chkUnpackToFolder_onclick() {
        if (!chkUnpackToFolder.checked)
          chkCompareSlideAsImage.checked = false;
      }

      function chkCompareSlideAsImage_onclick() {
        if (chkCompareSlideAsImage.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 + "CompareSlideAsImage", chkCompareSlideAsImage.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "CompareTextsInShapes", chkCompareTextsInShapes.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "CompareTextsInNotesPage", chkCompareTextsInNotesPage.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 slide data to multiple files}</label>
        </li>
        <li>
          <input id="chkCompareDocumentProperties" type="checkbox" />
          <label>${Compare document properties}</label>
        </li>
        <li>
          <input id="chkCompareSlideAsImage" type="checkbox" onclick="chkCompareSlideAsImage_onclick();"/>
          <label>${Compare slides as image (very slow)}</label>
        </li>
        <li>
          <input id="chkCompareTextsInShapes" type="checkbox" />
          <label>${Compare texts in shapes}</label>
        </li>
        <li>
          <input id="chkCompareTextsInNotesPage" type="checkbox" />
          <label>${Compare texts in notes page}</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>
