Plugin Store

Export Public GEDCOM File.fh_lua

--[[
@Title:       Export Public GEDCOM File
@Type:        Standard
@Author:      Mark Draper
@Version:     1.0.1
@LastUpdated: 29 Sep 2025
@Licence:     This plugin is copyright (c) 2025 Mark Draper and is licensed under the MIT License which
              is hereby incorporated by reference (see
              https://pluginstore.family-historian.co.uk/fh-plugin-licence)
@Description: Produces a 'one-click' GEDCOM export where all individuals marked as either Living or
              Private are excluded, along with their associated family records. The focus is on the export of 
              tree facts to current applications, enabling the plugin to dispense with the complex and often
              highly technical configuration options required in alternative export routes that attempt to 
              capture as much tree information as possible with support for legacy destinations.
]]

require 'luacom'
require('iuplua')
require('iupluaimglib')
require 'imlua'
require 'imlua_process'

fhInitialise(7, 0, 0, 'save_recommended')
fh = require('fhUtils')
fh.setIupDefaults()
iup.SetGlobal('UTF8MODE_FILE','YES')

FSO = luacom.CreateObject('Scripting.FileSystemObject')

-- *********************************************************************

function main()

	-- check for project

	if fhGetContextInfo('CI_APP_MODE') ~= 'Project Mode' then
		MessageBox('This plugin cannot be run from a stand-alone GEDCOM file.', 'OK', 'ERROR')
		return
	end

	-- define options table

	local tblMenuOptions = {
		BMD = 'Birth, Marriage and Death Facts only',
		STD = 'Standard GEDCOM Facts only',
		ALL = 'All Facts in Fact Sets',
		ADDR = 'Combine Address with Place',
		GPS = 'Export Place Geo-tagging data',
		RESI = 'Export Census as Residence (Ancestry)',
		SOUR0 = 'None',
		SOUR1 = 'Titles only',
		SOUR2 = 'Include Outline Citations and Text from Source',
		NOTE = 'Include Local Notes',
		SUBM = 'Include Submitter Record',
		MEDIA0 = 'None',
		MEDIA1 = 'Create new "Frame Link" files in export folder',
		MEDIA2 = 'Copy all Project Media to export folder',
		MEDIAF = 'First Media item only',
		MEDIAS = 'Include Source images',
		MEDIARM = 'Optimise Media export for RootsMagic'}

	-- add form option controls

	for option, FormTitle in pairs(tblMenuOptions) do
		tblMenuOptions[option] = iup.toggle{title = ' ' .. FormTitle, expand = 'HORIZONTAL'}
	end

	-- complete menu generation

	GetOptions(tblMenuOptions)
	Menu(tblMenuOptions)
	SaveOptions(tblMenuOptions)
end

-- *********************************************************************

function Menu(tblT)

	local function update_media()
		for _, option in ipairs({'MEDIAS', 'MEDIAF', 'MEDIARM'}) do
			if tblT.MEDIA0.value == 'ON' then
				tblT[option].value = 'OFF'
				tblT[option].active = 'NO'
			else
				tblT[option].active = 'YES'
			end
		end
		if tblT.SOUR0.value == 'ON' then
			tblT.MEDIAS.value = 'OFF'
			tblT.MEDIAS.active = 'NO'
		else
			if tblT.MEDIA0.value == 'OFF' then tblT.MEDIAS.active = 'YES' end
		end
	end

	-- add rest of form layout

	local FactOptions = iup.vbox{tblT.BMD, tblT.STD, tblT.ALL; gap = 5, margin = '5x5'}
	local FactRadio = iup.radio{FactOptions}
	local FactFrame = iup.frame{FactRadio, title = 'Fact Options'}

	local SourceRadio = iup.radio{iup.vbox{tblT.SOUR0, tblT.SOUR1, tblT.SOUR2; gap = 5, margin = '5x5'}}
	local SourceSeparator = iup.flatseparator{orientation = 'HORIZONTAL', style = 'LINE', barsize = 1,
			color = '220 220 220'}
	local SourceTick = iup.vbox{tblT.MEDIAS; margin = '5x5'}
	local SourceOptions = iup.vbox{SourceRadio, SourceSeparator, SourceTick; gap = 5, margin = '5x5'}
	local SourceFrame = iup.frame{SourceOptions, title = 'Source Options'}

	local MediaRadio = iup.radio{iup.vbox{tblT.MEDIA0, tblT.MEDIA1, tblT.MEDIA2; gap = 5, margin = '5x5'}}
	local MediaSeparator = iup.flatseparator{orientation = 'HORIZONTAL', style = 'LINE', barsize = 1,
			color = '220 220 220'}
	local MediaTick = iup.vbox{tblT.MEDIAF; margin = '5x5'}
	local MediaOptions = iup.vbox{MediaRadio, MediaSeparator, MediaTick; gap = 5, margin = '5x5'}
	local MediaFrame = iup.frame{MediaOptions, title = 'Media Options'}
	update_media()

	local RecordOptions = iup.vbox{tblT.ADDR, tblT.GPS, tblT.RESI, tblT.MEDIARM, tblT.NOTE, tblT.SUBM;
			gap = 5, margin = '10x10'}
	local btnPrivate = iup.button{title = 'Private Records'; padding = '10x3',
			action = function(self)
					if TabulateExcludedRecords() then return iup.CLOSE end end}
	local btnExport = iup.button{title = 'Export';
			action = function(self)
				if ExportGEDCOM(tblT) == -1 then				-- user cancelled
					if gblProgress then
						gblProgress.dialog:destroy()
						gblProgress = nil
					end
					MessageBox('Export aborted', 'OK', 'WARNING')
				end
			end}
	local btnHelp = iup.button{title = 'Help', active = 'YES',
			action = function(self)
			fhShellExecute('https://pluginstore.family-historian.co.uk/page/help/export-public-gedcom-file') end}
	local btnClose = iup.button{title = 'Close', action = function(self) return iup.CLOSE end}
	local buttons = iup.hbox{btnExport, btnPrivate, btnHelp, btnClose;
			normalizesize = 'BOTH'; gap = 50, margin = '20x20'}
	local tblB = {btnPrivate, btnExport, btnHelp, btnClose}
		for _, control in ipairs(tblB) do
			control.TipBalloon = 'YES'
			control.TipBalloonTitleIcon = 1
		end
	btnPrivate.TipBalloonTitle = 'Private'
	btnPrivate.Tip = 'Tabulate Private/Living Individuals and their families who will be ' ..
			'excluded from the export.'
	btnExport.TipBalloonTitle = 'Export'
	btnExport.Tip = 'Export public GEDCOM file (omitting all Living or Private Individuals and Families)'
	btnHelp.TipBalloonTitle = 'Help'
	btnHelp.Tip = 'Display Plugin Help file'
	btnClose.TipBalloonTitle = 'Close'
	btnClose.Tip = 'Close Plugin'

	local col1 = iup.vbox{FactFrame, MediaFrame; alignment = 'ALEFT', gap = 20}
	local col2 = iup.vbox{SourceFrame, RecordOptions; alignment = 'ALEFT', gap = 20}
	local hbox = iup.hbox{col1, col2; gap = 5}
	local vbox = iup.vbox{hbox, buttons; alignment = 'ACENTER', gap = 5, margin = '10x10'}

	function tblT.BMD:valuechanged_cb()
		if tblT.BMD.value == 'ON' then
			tblT.RESI.value = 'OFF'
			tblT.RESI.active = 'NO'
		else
			tblT.RESI.active = 'YES'
		end
	end

	function tblT.SOUR0:valuechanged_cb()
		update_media()
	end

	function tblT.MEDIA0:valuechanged_cb()
		update_media()
	end

	local p = fhNewItemPtr()
	p:MoveToFirstRecord('SUBM')
	if p:IsNull() then
		tblT.SUBM.value = 'OFF'
		tblT.SUBM.active = 'NO'
	end

	menudialog = iup.dialog{vbox; resize = 'No', minbox = 'No', maxbox = 'No',
			title = 'Export Public GEDCOM File (1.0.1)'}
	iup.SetAttribute(menudialog, 'NATIVEPARENT', fhGetContextInfo('CI_PARENT_HWND'))
	menudialog:popup()
end

-- *********************************************************************

function GetOptions(tblMenuOptions)

	-- get plugin options from options file

	local OptionsFile = fhGetPluginDataFileName('CURRENT_PROJECT'):sub(1,-4) .. 'ini'
	if not FSO:FileExists(OptionsFile) then
		tblMenuOptions.ALL.value = 'ON'
		tblMenuOptions.MEDIA0.value = 'ON'
		tblMenuOptions.MEDIAS.active = 'NO'
		tblMenuOptions.MEDIARM.active = 'NO'
		return
	end
	for option, control in pairs(tblMenuOptions) do
		if option ~= 'FILE' and fhGetIniFileValue(OptionsFile, 'Options', option, 'bool') then
			control.value = 'ON' else control.value = 'OFF'
		end
	end
	tblMenuOptions.FILE = fhGetIniFileValue(OptionsFile, 'File', 'File', 'text')
	if tblMenuOptions.FILE == '' then tblMenuOptions.FILE = nil end
end

-- *********************************************************************

function SaveOptions(tblMenuOptions)

	-- create ini file as UTF-16LE

	local OptionsFile = fhGetPluginDataFileName('CURRENT_PROJECT'):sub(1,-4) .. 'ini'
	fhSaveTextFile(OptionsFile, '[Options]', 'UTF-16LE')
	for option, control in pairs(tblMenuOptions) do
		if option ~= 'FILE' then
			fhSetIniFileValue(OptionsFile, 'Options', option, 'bool', control.value == 'ON')
		else
			fhSetIniFileValue(OptionsFile, 'File', 'FILE', 'text', tblMenuOptions.FILE)
		end
	end
end

-- *********************************************************************

function ExportGEDCOM(tblMenuOptions)

	-- create local options table (syntactic sugar...)

	local tblOptions = {}
	for option, control in pairs(tblMenuOptions) do
		if option ~= 'FILE' and control.value == 'ON' then tblOptions[option] = true end
	end

	local tblFacts = GetFacts()
	local tblGPS = GetGPS()

	-- get temporary ANSI files for use if required

	local ANSIsource = os.getenv('TEMP') .. '\\' .. os.tmpname():match('\\([^\\]+)$')
	local ANSIdest = os.getenv('TEMP') .. '\\' .. os.tmpname():match('\\([^\\]+)$')

	if not FSO:FolderExists('Z:\\bin') and not FSO:FolderExists('Z:\\etc') then		-- not WINE
		local _ = fhConvertUTF8toANSI(ANSIsource)
		if fhIsConversionLossFlagSet() then											-- Unicode user name
			FSO:CopyFile(fhGetContextInfo('CI_GEDCOM_FILE'), ANSIsource)
			ANSIsource = FSO:GetFile(ANSIsource).ShortPath
			FSO:CopyFile(fhGetContextInfo('CI_GEDCOM_FILE'), ANSIdestination)
			ANSIdestination = FSO:GetFile(ANSIdestination).ShortPath
		end
	end

	-- Identify included records and store in table.

	local tblRecords = DefineRecordsTable()
	for _, type in ipairs({'INDI', 'FAM'}) do
		local p = fhNewItemPtr()
		p:MoveToFirstRecord(type)
		while p:IsNotNull() do
			tblRecords[type].total = tblRecords[type].total + 1
			if IsIncluded(p, type == 'FAM') then
				tblRecords[type][fhGetRecordId(p)] = IsIncluded(p, type == 'FAM')
				tblRecords[type].included = tblRecords[type].included + 1
			end
		p:MoveNext()
		end
	end
	if tblRecords.INDI.included + tblRecords.FAM.included == 0 then
		MessageBox('Nothing to save.', 'OK', 'ERROR')
		return
	end

	-- get export file name

	local filedlg = iup.filedlg{dialogtype = 'SAVE', title = 'Export Public GEDCOM File',
			extfilter = 'GEDCOM files (*.ged)|*.ged|All Files (*.*)|*.*|',
			file = fhGetContextInfo('CI_PROJECT_NAME') .. ' Export.ged',
			extdefault = 'ged'}
	filedlg:popup()
	if filedlg.Status == '-1' then return end
	local FileName = filedlg.value
	tblOptions.FILE = FileName
	local tblTimer = {A = os.time()}

	-- check for Submitter Record

	local pU = fhNewItemPtr()
	pU:MoveToFirstRecord('SUBM')

	-- write GEDCOM header

	local tblOutput = {}
	table.insert(tblOutput, '0 HEAD')
	table.insert(tblOutput, '1 SOUR Family_Historian')
	table.insert(tblOutput, '2 NAME Export Public GEDCOM File Plugin')
	local i, j, k = fhGetAppVersion()
	table.insert(tblOutput, '2 VERS ' .. i .. '.' .. j .. '.' .. k .. ' (Plugin version 1.0)')
	table.insert(tblOutput, '2 CORP Calico Pie Limited')
	table.insert(tblOutput, '1 FILE ' .. FileName)
	table.insert(tblOutput, '1 GEDC')
	table.insert(tblOutput, '2 VERS 5.5.1')
	table.insert(tblOutput, '2 FORM LINEAGE-LINKED')
	table.insert(tblOutput, '1 CHAR UTF-8')
	if tblOptions.SUBM and pU:IsNotNull() then
		table.insert(tblOutput, '1 SUBM @U' .. fhGetRecordId(pU) .. '@') end

	-- create progress bar

	ProgressBarReset('Processing Individuals', tblRecords.INDI.included)
	iup.SetAttribute(gblProgress.icon, 'START', 'YES')

	-- process in-scope individuals

	local pI = fhNewItemPtr()
	pI:MoveToFirstRecord('INDI')
	while pI:IsNotNull() do
		if tblRecords.INDI[fhGetRecordId(pI)] then
			ExportIND(pI, tblRecords, tblFacts.INDI, tblGPS, tblOptions, tblOutput)
			if ProgressUpdate() then return -1 end
		end
		pI:MoveNext()
	end

	-- Process in-scope families

	ProgressBarReset('Processing Families', tblRecords.FAM.included)
	local pF = fhNewItemPtr()
	pF:MoveToFirstRecord('FAM')
	while pF:IsNotNull() do
		if tblRecords.FAM[fhGetRecordId(pF)] then
			ExportFAM(pF, tblRecords, tblFacts.FAM, tblGPS, tblOptions, tblOutput)
			if ProgressUpdate() then return -1 end
		end
		pF:MoveNext()
	end

	-- export referenced sources if specified

	if not tblOptions.SOUR0 then
		if ExportSOUR(tblRecords, tblOptions, tblOutput) == -1 then return -1 end	-- user aborted
	end

	-- export referenced media if specified

	if not tblOptions.MEDIA0 and not tblOptions.MEDIARM then
		if ExportOBJE(tblRecords, tblOutput) == -1 then return -1 end	-- user aborted
	end

	-- export first Submitter Record

	if tblOptions.SUBM and pU:IsNotNull() then
		table.insert(tblOutput, '0 @U' .. fhGetRecordId(pU) .. '@ SUBM')
		local p = fhNewItemPtr()
		p:MoveToFirstChildItem(pU)
		while p:IsNotNull() do
			if fhGetValueAsText(p) ~= '' then
				table.insert(tblOutput, '1 ' .. fhGetTag(p) .. ' ' .. fhGetValueAsText(p))
			end
			p:MoveNext()
		end
	end
	table.insert(tblOutput, '0 TRLR\n')
	gblProgress.dialog:destroy()
	gblProgress = nil

	-- save GEDCOM file to disk and clear table memory

	if not fnSaveTextFile(FileName, table.concat(tblOutput, '\n'), ANSIdest) then
		MessageBox('Failed to write output file to ' .. FileName, 'OK', 'ERROR')
		return
	end
	tblOutput = nil
	collectgarbage('collect')
	tblTimer.B = os.time()
	if not tblOptions.MEDIA0 then
		tblTimer.C = CopyMediaFiles(tblRecords, tblOptions, ANSIsource, ANSIdest) end
	if tblTimer.C == -1 then return -1 end											-- user aborted

	-- delete ANSI files if used

	for _, F in ipairs({ANSIsource, ANSIdest}) do
		if FSO:FileExists(F) then
			local b, err = os.remove(F)
			if not b then
				MessageBox('Failed to remove temporary file ' .. F .. '\n' .. err, 'OK', 'ERROR') end
		end
	end

	-- provide confirmation message

	local n = 0
	for _, _ in pairs(tblRecords.OBJE) do n = n + 1 end
	local msg = 'File exported completed.' ..
			'\n\nINDI: \t\t' .. tblRecords.INDI.included .. ' of ' .. tblRecords.INDI.total ..
			'\nFAM: \t\t' .. tblRecords.FAM.included .. ' of ' .. tblRecords.FAM.total ..
			'\nSOUR: \t\t' .. tblRecords.SOUR.included ..
			'\nOBJE: \t\t' .. n ..
			'\n\nGenerate File: \t' .. tblTimer.B - tblTimer.A .. ' s'
	if tblTimer.C then msg = msg .. '\nCopy Media: \t' .. tblTimer.C .. ' s' end
	MessageBox(msg, 'OK', 'INFORMATION', 'Export Confirmation')
end

-- *********************************************************************

function ExportIND(pI, tblRecords, tblFactsI, tblGPS, tblOptions, tblOutput)

	local p = fhNewItemPtr()
	table.insert(tblOutput, '0 @I' .. fhGetRecordId(pI) .. '@ INDI')
	p:MoveTo(pI,'~.NAME')
	while p:IsNotNull() do
		table.insert(tblOutput, '1 NAME ' .. fhGetValueAsText(p))
		if fhGetItemText(p, '~:SURNAME') ~= '' then
			table.insert(tblOutput, '2 SURN ' .. fhGetItemText(p, '~:SURNAME'))
		end
		if fhGetItemText(p, '~:GIVEN_ALL') ~= '' then
			table.insert(tblOutput, '2 GIVN ' .. fhGetItemText(p, '~:GIVEN_ALL'))
		end
		for _, field in ipairs({'NPFX', 'NSFX', 'NICK'}) do
			if fhGetItemPtr(p, '~.' .. field):IsNotNull() then
				table.insert(tblOutput, '2 ' .. field .. ' ' .. fhGetItemText(p, '~.' .. field))
			end
		end
		if tblOptions.NOTE then ExportNoteFields(p, 2, tblRecords, tblOptions, tblOutput) end
		if not tblOptions.SOUR0 then ExportSourceFields(p, 2, tblRecords, tblOptions, tblOutput) end
		p:MoveNext('SAME_TAG')
	end
	if fhGetItemPtr(pI,'~.SEX'):IsNotNull() then
		table.insert(tblOutput, '1 SEX ' .. fhGetItemText(pI, '~.SEX'):sub(1, 1))
	end
	if fhGetItemPtr(pI,'~.REFN'):IsNotNull() then
		table.insert(tblOutput, '1 REFN ' .. fhGetItemText(pI, '~.REFN'))
	end
	if fhGetItemPtr(pI,'~._UID'):IsNotNull() then
		table.insert(tblOutput, '1 _UID ' .. fhGetItemText(pI, '~._UID'))
	end
	ExportFactFields(pI, tblRecords, tblFactsI, tblGPS, tblOptions, tblOutput)
	if not tblOptions.SOUR0 then ExportSourceFields(pI, 1, tblRecords, tblOptions, tblOutput) end
	if not tblOptions.MEDIA0 then ExportMediaFields(pI, 1, tblRecords, tblOptions, tblOutput) end
	if tblOptions.NOTE then ExportNoteFields(pI, 1, tblRecords, tblOptions, tblOutput) end

	-- export family links

	local pL = fhNewItemPtr()
	pL:MoveTo(pI,'~.FAMC')
	while pL:IsNotNull() do
		p = fhGetValueAsLink(pL)
		if tblRecords.FAM[fhGetRecordId(p)] then						-- exclude private families
			table.insert(tblOutput, '1 FAMC @F' .. fhGetRecordId(p) .. '@')
		end
		pL:MoveNext('SAME_TAG')
	end
	pL:MoveTo(pI,'~.FAMS')
	while pL:IsNotNull() do
		p = fhGetValueAsLink(pL)
		if tblRecords.FAM[fhGetRecordId(p)] then						-- exclude private families
			table.insert(tblOutput, '1 FAMS @F' .. fhGetRecordId(p) .. '@')
		end
		pL:MoveNext('SAME_TAG')
	end
end

-- *********************************************************************

function ExportFAM(pF, tblRecords, tblFactsF, tblGPS, tblOptions, tblOutput)

	local p = fhNewItemPtr()
	table.insert(tblOutput, '0 @F' .. fhGetRecordId(pF) .. '@ FAM')

	if tblRecords.FAM[fhGetRecordId(pF)] ~= -1 then			-- suppress details when private spouse
		ExportFactFields(pF, tblRecords, tblFactsF, tblGPS, tblOptions, tblOutput)
		if not tblOptions.SOUR0 then ExportSourceFields(pF, 1, tblRecords, tblOptions, tblOutput) end
		if not tblOptions.MEDIA0 then ExportMediaFields(pF, 1, tblRecords, tblOptions, tblOutput) end
		if tblOptions.NOTE then ExportNoteFields(pF, 1, tblRecords, tblOptions, tblOutput) end
	end

	local pL1, pL2 = GetFamilySpouses(pF)
	if pL1:IsNotNull() and IsIncluded(pL1) then
		table.insert(tblOutput, '1 HUSB @I' .. fhGetRecordId(pL1) .. '@')
	end
	if pL2:IsNotNull() and IsIncluded(pL2) then
		table.insert(tblOutput, '1 WIFE @I' .. fhGetRecordId(pL2) .. '@')
	end
	pL1:MoveTo(pF,'~.CHIL')
	while pL1:IsNotNull() do
		p = fhGetValueAsLink(pL1)
		if IsIncluded(p) then										-- exclude private individuals
			table.insert(tblOutput, '1 CHIL @I' .. fhGetRecordId(p) .. '@')
		end
		pL1:MoveNext('SAME_TAG')
	end
end

-- *********************************************************************

function ExportSOUR(tblRecords, tblOptions, tblOutput)

	local n = 0
	for item, _ in pairs(tblRecords.SOUR) do
		if item then n = n + 1 end
	end
	tblRecords.SOUR.included = n

	if not tblOptions.SOUR0 and tblRecords.SOUR.included > 0 then
		ProgressBarReset('Processing Sources', tblRecords.SOUR.included)
		local pS = fhNewItemPtr()
		pS:MoveToFirstRecord('SOUR')
		while pS:IsNotNull() do
			local ID = fhGetRecordId(pS)
			if tblRecords.SOUR[ID] then
				table.insert(tblOutput, '0 @S' .. ID .. '@ SOUR')
				if fhGetItemPtr(pS, '~.TITL'):IsNotNull() then
					table.insert(tblOutput, '1 TITL ' .. fhGetItemText(pS, '~.TITL'))
				end
				if fhGetItemPtr(pS, '~.PUBL'):IsNotNull() then
					table.insert(tblOutput, '1 PUBL ' .. fhGetItemText(pS, '~.PUBL'))
				end
				if fhGetItemPtr(pS, '~.TEXT'):IsNotNull() and tblOptions.SOUR2 then
					GetNoteText(fhGetItemPtr(pS, '~.TEXT'), 'TEXT', 1, tblOutput)
				end
				if tblOptions.MEDIAS then ExportMediaFields(pS, 1, tblRecords, tblOptions, tblOutput) end
				if tblOptions.NOTE then ExportNoteFields(pS, 1, tblRecords, tblOptions, tblOutput) end
				if ProgressUpdate() then return -1 end
			end
			pS:MoveNext()
		end
	end
end

-- *********************************************************************

function ExportOBJE(tblRecords, tblOutput)

	local pM = fhNewItemPtr()
	for i = 1, tblRecords.MaxOBJE do
		if tblRecords.OBJE[i] then
			table.insert(tblOutput, '0 @O' .. i .. '@ OBJE')
			table.insert(tblOutput, '1 FILE ' .. tblRecords.OBJE[i].PATH)
			pM:MoveToRecordById('OBJE', tblRecords.OBJE[i].SOURCERIN)
			if fhGetItemText(pM, '~.FILE.FORM') ~= '' then
				table.insert(tblOutput, '2 FORM ' .. fhGetItemText(pM, '~.FILE.FORM'))
			end
			if fhGetItemText(pM, '~.FILE.TITL') ~= '' then
				if tblRecords.OBJE[i].AREA == '' then
					table.insert(tblOutput, '2 TITL ' .. fhGetItemText(pM, '~.FILE.TITL'))
				else
					table.insert(tblOutput, '2 TITL ' .. fhGetItemText(pM, '~.FILE.TITL') .. ' (Cut-out)')
				end
			end
		end
	end
end

-- *********************************************************************

function ExportFactFields(pR, tblRecords, tblFactsR, tblGPS, tblOptions, tblOutput)

	-- export fact details for individual or family record

	local p = fhNewItemPtr()
	p:MoveToFirstChildItem(pR)
	while p:IsNotNull() do
		local tag = fhGetTag(p)
		if tblFactsR[tag] and fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and
				fhGetItemText(p, '~._FLGS.__REJECTED') ~= 'Y' and not
				(tblOptions.BMD and tag ~= 'BIRT' and tag ~= 'MARR' and tag ~= 'DEAT') then
			if tblFactsR[tag] == -1 then										-- standard fact
				if tag == 'CENS' and tblOptions.RESI then			-- Ancestry compatibility
					table.insert(tblOutput, '1 RESI' .. FactValue(p))
				else
					table.insert(tblOutput, '1 ' .. tag .. FactValue(p))
				end
			else									-- custom fact
				table.insert(tblOutput, '1 EVEN' .. FactValue(p))
				table.insert(tblOutput, '2 TYPE ' .. tblFactsR[tag])
			end
			local pD = fhGetItemPtr(p,'~.DATE')
			if pD:IsNotNull() then
				table.insert(tblOutput, '2 DATE ' .. GetGEDCOMDate(pD))
			end
			local place = fhGetItemText(p, '~.PLAC')
			if tblOptions.ADDR then
				local address = fhGetItemText(p, '~.ADDR')
				if address ~= '' and place ~= '' then
					table.insert(tblOutput, '2 PLAC ' .. address .. ', ' .. place)
				elseif address ~= '' or place ~= '' then
					table.insert(tblOutput, '2 PLAC ' .. address .. place)
				end
			else
				if fhGetItemPtr(p, '~.PLAC'):IsNotNull() then
					table.insert(tblOutput, '2 PLAC ' .. place)
				end
			end
			if tblOptions.GPS and tblGPS[place] then
				table.insert(tblOutput, '3 MAP')
				table.insert(tblOutput, '4 LATI ' .. tblGPS[place].LATI)
				table.insert(tblOutput, '4 LONG ' .. tblGPS[place].LONG)
			end
			if not tblOptions.ADDR and fhGetItemText(p, '~.ADDR') ~= '' then
				table.insert(tblOutput, '2 ADDR ' .. fhGetItemText(p, '~.ADDR'))
			end
			if fhGetItemPtr(p, '~.AGE'):IsNotNull() then
				table.insert(tblOutput, '2 AGE ' .. fhGetItemText(p, '~.AGE'))
			end
			if not tblOptions.SOUR0 then ExportSourceFields(p, 2, tblRecords, tblOptions, tblOutput) end
			if not tblOptions.MEDIA0 then ExportMediaFields(p, 2, tblRecords, tblOptions, tblOutput) end
			if tblOptions.NOTE then ExportNoteFields(p, 2, tblRecords, tblOptions, tblOutput) end
		end
		p:MoveNext()
	end
end

-- *********************************************************************

function ExportSourceFields(p, level, tblRecords, tblOptions, tblOutput)

	local pS = fhGetItemPtr(p, '~.SOUR')
	while pS:IsNotNull() do
		local pL = fhGetValueAsLink(pS)
		local ID = fhGetRecordId(pL)
		tblRecords.SOUR[ID] = true							-- mark source for export
		table.insert(tblOutput, level .. ' SOUR @S' .. ID .. '@')
		if fhGetItemPtr(pS, '~.PAGE'):IsNotNull() then
			table.insert(tblOutput, level+1 .. ' PAGE ' .. fhGetItemText(pS, '~.PAGE'))
		end
		if fhGetItemPtr(pS, '~.DATA.TEXT'):IsNotNull() and tblOptions.SOUR2 then
			GetNoteText(fhGetItemPtr(pS, '~.DATA.TEXT'), 'DATATEXT', level+1, tblOutput)
		end
		if fhGetItemPtr(pS, '~.OBJE'):IsNotNull() and tblOptions.MEDIAS then
			ExportMediaFields(pS, level+1, tblRecords, tblOptions, tblOutput)
		end
		pS:MoveNext('SAME_TAG')
	end
end

-- *********************************************************************

function ExportMediaFields(p, level, tblRecords, tblOptions, tblOutput)

	local i = tblOptions.FILE:find('\\[^\\]+$')
	local export_folder = tblOptions.FILE:sub(1, i-1)
	local data_folder = fhGetContextInfo('CI_PROJECT_DATA_FOLDER')
	local first = true
	local pM = fhGetItemPtr(p, '~.OBJE')
	while pM:IsNotNull() do
		local tblM = {}
		local pL = fhGetValueAsLink(pM)

		-- does this media have unique ID and AREA?

		local ID = fhGetRecordId(pL)
		local area = fhGetItemText(pM, '~._AREA')
		local status = 0
		for RIN, M in pairs(tblRecords.OBJE) do
			if RIN == ID and M.AREA == area then
				status = 1							-- reuse existing record
				break
			elseif RIN == ID and M.AREA ~= area then
				status = -1							-- need new record
				break
			end
		end

		if status == -1 then
			tblRecords.MaxOBJE = tblRecords.MaxOBJE + 1
			ID = tblRecords.MaxOBJE
		end

		-- get new path of media record file

		local old_path = fhGetItemText(pL, '~.FILE')
		if old_path:sub(1,6):lower() == 'media\\' or old_path:sub(1,6):lower() == 'media/' then
			old_path = data_folder .. '\\' .. old_path
		end
		tblM.OLDPATH = old_path
		local j = old_path:find('[\\/][^\\/]+$') or 0
		local file = old_path:sub(j+1)
		local ext = file:match('([^%.]+)$')
		local base = file:sub(1,-1 * (ext:len() + 2))
		if area and area ~= '' then base = base .. '_' .. area end
		if tblOptions.MEDIA1 and area == '' then						-- keep all absolute paths
			new_path = old_path
		else
			new_path = export_folder .. '\\' .. base .. '.' .. ext		-- copy to export folder
		end

		-- is this new path unique to this media record?

		-- get table of allocated paths

		local tblPaths = {}
		for RIN, Record in pairs(tblRecords.OBJE) do
			if RIN ~= ID then
				tblPaths[Record.PATH] = true
			end
		end

		-- increment suffix until unique path

		i = nil
		while tblPaths[new_path] do
			if i then i = i + 1 else i = 1 end
			new_path = export_folder .. '\\' .. base .. '_' .. i .. '.' .. ext
		end

		-- update Records table

		tblM.SOURCERIN = fhGetRecordId(pL)
		tblM.PATH = new_path
		tblM.AREA = area
		tblRecords.OBJE[ID] = tblM

		if tblOptions.MEDIARM then
			table.insert(tblOutput, level .. ' OBJE')
			table.insert(tblOutput, level+1 .. ' FILE ' .. new_path)
			if fhGetItemText(pL, '~.FILE.FORM') ~= '' then
				table.insert(tblOutput, level+1 .. ' FORM ' .. fhGetItemText(pL, '~.FILE.FORM'))
			end
			if fhGetItemText(pL, '~.FILE.TITL') ~= '' then
				table.insert(tblOutput, level+1 .. ' TITL ' .. fhGetItemText(pL, '~.FILE.TITL'))
			end
			if first then
				table.insert(tblOutput, level+1 .. ' _PRIM Y')				-- subject image
				first = false
			end
		else
			table.insert(tblOutput, level .. ' OBJE @O' .. ID .. '@')
		end
		if tblOptions.MEDIAF then break end			-- only export first Media link
		pM:MoveNext('SAME_TAG')
	end
end

-- *********************************************************************

function ExportNoteFields(p, level, tblRecords, tblOptions, tblOutput)

	local pN = fhGetItemPtr(p, '~.NOTE2')
	while pN:IsNotNull() do
		GetNoteText(pN, 'NOTE', level, tblOutput)
		if not tblOptions.SOUR0 then ExportSourceFields(pN, level, tblRecords, tblOptions, tblOutput) end
		pN:MoveNext('SAME_TAG')
	end
end

-- *********************************************************************

function TabulateExcludedRecords()

	local tblR, tblSort, tblLiv, tblPvt, tblFam = {}, {}, {}, {}, {}

	for _, type in ipairs({'INDI', 'FAM'}) do
		local p = fhNewItemPtr()
		p:MoveToFirstRecord(type)
		while p:IsNotNull() do
			local i = IsIncluded(p, type == 'FAM')
			if i ~= true then
				table.insert(tblR, p:Clone())
				if type == 'INDI' then
					table.insert(tblSort, fhGetItemText(p, '~.NAME:SURNAME') ..
							fhGetItemText(p, '~.NAME:GIVEN_ALL'))
				else
					table.insert(tblSort, 'zzz' .. fhGetItemText(p, '~.HUSB>NAME:SURNAME') ..
							fhGetItemText(p, '~.HUSB>NAME:GIVEN_ALL') ..
							fhGetItemText(p, '~.WIFE>NAME:SURNAME') ..
							fhGetItemText(p, '~.WIFE>NAME:GIVEN_ALL'))
				end
				table.insert(tblLiv, fhGetItemText(p, '~._FLGS.__LIVING'))
				table.insert(tblPvt, fhGetItemText(p, '~._FLGS.__PRIVATE'))
				if not i and type == 'FAM' then
					table.insert(tblFam, 'No known public spouses or one-member family')
				elseif i == -1 then
					table.insert(tblFam, 'Family with private spouse and at least one linked child. ' ..
							'Family record is exported with no further details')
				else
					table.insert(tblFam, '')
				end
			end
			p:MoveNext()
		end
	end

	if #tblR == 0 then
		MessageBox('This Project has no Individuals marked as Living or Private.', 'OK', 'INFORMATION')
		return
	else
		local msg = #tblR .. ' Records will be excluded from the export. Click on OK to close the plugin ' ..
				'and display these records or Cancel to return to the plugin menu.'
		local i = #tblR
		if i == 1 then msg = msg:gsub('Records', 'Record') end
		if MessageBox(msg, 'OKCANCEL', 'INFORMATION') == 2 then return end
	end

	fhOutputResultSetTitles('Excluded private records')
	fhOutputResultSetColumn('Record', 'item', tblR, #tblR, 200)
	fhOutputResultSetColumn('', 'text', tblSort, #tblSort, 0, 'align_left', 1, true, 'default', 'hide')
	fhOutputResultSetColumn('Living', 'text', tblLiv, #tblLiv, 30, 'align_mid')
	fhOutputResultSetColumn('Private', 'text', tblPvt, #tblPvt, 30, 'align_mid')
	fhOutputResultSetColumn('Fam', 'text', tblFam, #tblFam, 350)
	return true
end

-- *********************************************************************

function GetFamilySpouses(pF)

	-- convert FH assymetric storage of single sex couples to symmetric

	local pH1 = fhGetItemPtr(pF, '~.HUSB[1]')
	local pH2 = fhGetItemPtr(pF, '~.HUSB[2]')
	local pW1 = fhGetItemPtr(pF, '~.WIFE[1]')
	local pW2 = fhGetItemPtr(pF, '~.WIFE[2]')

	if pH2:IsNull() and pW2:IsNull() then
		return fhGetValueAsLink(pH1), fhGetValueAsLink(pW1)
	elseif pH2:IsNotNull() then
		return fhGetValueAsLink(pH1), fhGetValueAsLink(pH2)
	elseif pW2:IsNotNull() then
		return fhGetValueAsLink(pW2), fhGetValueAsLink(pW1)
	end
end

-- *********************************************************************

function GetFacts()

	local tblFacts = {INDI = {}, FAM = {}}

	-- get standard facts (GEDCOM tags only, all names set to -1)

	local file = fhGetContextInfo('CI_APP_DATA_FOLDER') .. '\\Fact Types\\Standard\\Standard.fhf'
	local s = FSO:OpenTextFile(file, 1, false, -1):ReadAll()
	collectgarbage('collect')
	for line in s:gmatch('[^\r\n]+') do
		local i = line:match('^Item%d+%=(%u+)%-I[EA]$')
		if i then tblFacts.INDI[i] = -1 end
		local f = line:match('^Item%d+%=(%u+)%-F[EA]$')
		if f then tblFacts.FAM[f] = -1 end
	end

	-- get custom facts (excluding those eclipsing standard facts)

	local tblFactSets = {}
	local ProjectFacts = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Fact Types'
	local SystemFacts = fhGetContextInfo('CI_APP_DATA_FOLDER') .. '\\Fact Types\\Custom'
	for _, FactFolder in ipairs({ProjectFacts, SystemFacts}) do
		if FSO:FolderExists(FactFolder) then
			local Folder = FSO:GetFolder(FactFolder)
			for _, file in luacom.pairs(Folder.Files) do
				if file.Name:match('%.fhf$') then
					table.insert(tblFactSets, file.Path)
				end
			end
		end
	end
	for _, FactSet in ipairs(tblFactSets) do
		local ActiveFact, ActiveType
		local s = fhLoadTextFile(FactSet, 'UTF-16LE')
		for line in s:gmatch('[^\r\n]+') do
			local fact, type = line:match('^%[FCT%-([%w%-%_]+)%-([IF]+)[EA]%]$')
			local name = line:match('^Name%=([%g%s]+)$')
			if fact then
				ActiveFact = fact
				ActiveType = type
			elseif ActiveFact and name then
				if ActiveType == 'I' and not tblFacts.INDI[ActiveFact] then
					tblFacts.INDI[ActiveFact] = name
				elseif ActiveType == 'F' and not tblFacts.FAM[ActiveFact] then
					tblFacts.FAM[ActiveFact] = name
				end
				ActiveFact = nil
				ActiveType = nil
			end
		end
	end
	return tblFacts
end

-- *********************************************************************

function GetGPS()

	local tblGPS = {}
	local p = fhNewItemPtr()

	p:MoveToFirstRecord('_PLAC')
	while p:IsNotNull() do
		local place = fhGetItemText(p, '~.TEXT')
		local lat = fhGetItemText(p, '~.LATLONG:LAT_NUMERIC')
		local long = fhGetItemText(p, '~.LATLONG:LONG_NUMERIC')
		if place ~= '' and lat ~= '' and long ~= '' then
			tblGPS[place] = {LATI = lat, LONG = long}
		end
		p:MoveNext()
	end
	return tblGPS
end

-- *********************************************************************

function GetGEDCOMDate(pD)

	-- converts FH date to GEDCOM format

	local dtD = fhGetValueAsDate(pD)
	local s = dtD:GetDisplayText('COMPACT')

	-- strip out quotes from date phrases

	if s:match('^%"') and s:match('%"$') then
		return s:sub(2,-2)
	end

	s = s:gsub('c%.', 'ABT')
	s = s:gsub('btw', 'BET')
	s = s:gsub('frm', 'FROM')
	local i = s:find('(est)')
	if i then s = 'EST ' .. s:sub(1, i-3) end
	i = s:find('(cal)')
	if i then s = 'CAL ' .. s:sub(1, i-3) end
	i = s:find('Q1')
	if i then s = 'BET JAN ' .. s:sub(4) .. ' AND MAR ' .. s:sub(4) end
	i = s:find('Q2')
	if i then s = 'BET APR ' .. s:sub(4) .. ' AND JUN ' .. s:sub(4) end
	i = s:find('Q3')
	if i then s = 'BET JUL ' .. s:sub(4) .. ' AND SEP ' .. s:sub(4) end
	i = s:find('Q4')
	if i then s = 'BET OCT ' .. s:sub(4) .. ' AND DEC ' .. s:sub(4) end
	return s:upper()
end

-- ************************************************************************** --

function GetNoteText(p, tag, level, tblOutput)

	-- returns non-private text from supplied item

	local s = fhGetValueAsRichText(p):GetPlainText(false)
	local length = 100
	local tblT = {}

	-- split into paragraphs, then into concatenated chunks

	for line in s:gmatch('[^\r\n]+') do
		local tblL = {}
		repeat
			local i = line:find('%S%S%S%S', length)		-- suitable location to split
			if not i then
				table.insert(tblL, line)
				break
			else
				table.insert(tblL, line:sub(1, i+1))
				line = line:sub(i+2)
			end
		until false
		table.insert(tblT, tblL)
	end

	-- populate output table

	if tag == 'DATATEXT' then						-- lumped citation text
		table.insert(tblOutput, level .. ' DATA')
		level = level + 1
		tag = 'TEXT'
	end
	local prefix = level .. ' ' .. tag .. ' '
	for _, v in ipairs(tblT) do
		for _, vv in ipairs(v) do
			table.insert(tblOutput, prefix .. vv)
			prefix = level + 1 .. ' CONC '
		end
		prefix = level + 1 .. ' CONT '
	end
end

-- *********************************************************************

function IsIncluded(p, family)

	-- returns true (or -1) for in scope individual or family records, defaults to false otherwise

	if not family then
		if fhGetItemText(p, '~._FLGS.__PRIVATE') ~= 'Y' and fhGetItemText(p, '~._FLGS.__LIVING') ~= 'Y' then
			return true
		end
	else
		local pH, pW = GetFamilySpouses(p)

		-- private spouse (return -1 if visible child, false otherwise)

		if (pH:IsNotNull() and not IsIncluded(pH)) or (pW:IsNotNull() and not IsIncluded(pW)) then
			local fact, child
			local pC = fhNewItemPtr()
			pC:MoveToFirstChildItem(p)
			while pC:IsNotNull() do
				if fhIsFact(pC) then fact = true end
				if fhGetTag(pC) == 'CHIL' and IsIncluded(fhGetValueAsLink(pC)) then child = true end
				pC:MoveNext()
			end
			if fact and child then
				return -1									-- no details exported
			elseif not child then
				return false								-- one-member family, so exclude
			end
		end
		return true											-- no private spouse
	end
end

-- *********************************************************************

function DefineRecordsTable()

	local tblRecords = {INDI = {total = 0, included = 0}, FAM = {total = 0, included = 0},
			SOUR = {included = 0}, OBJE = {}, MaxOBJE = 0, N = {}}

	local p = fhNewItemPtr()
	p:MoveToFirstRecord('OBJE')
	while p:IsNotNull() do
		local ID = fhGetRecordId(p)
		if ID > tblRecords.MaxOBJE then tblRecords.MaxOBJE = ID end
		p:MoveNext()
	end

	return tblRecords
end

-- *********************************************************************

function FactValue(p)

	if fhGetValueAsText(p) == '' then
		return ''
	else
		return ' ' .. fhGetValueAsText(p)
	end
end

-- *********************************************************************

function CopyMediaFiles(tblRecords, tblOptions, ANSIsource, ANSIdest)

	local new, updated, cropped, size = 0, 0, 0, 0

	for _, Record in pairs(tblRecords.OBJE) do
		if Record.AREA ~= '' then
			cropped = cropped + 1
			Record.COPY = true
		elseif Record.OLDPATH ~= Record.PATH and not FSO:FileExists(Record.PATH) then
			new = new + 1
			Record.COPY = true
		elseif FSO:FileExists(Record.PATH) and
				FSO:GetFile(Record.OLDPATH).DateLastModified ~= FSO:GetFile(Record.PATH).DateLastModified then
			updated = updated + 1
			Record.COPY = true
		end
		if Record.COPY then
			size = size + FSO:GetFile(Record.OLDPATH).Size
			if FSO:FileExists(Record.PATH) then size = size - FSO:GetFile(Record.PATH).Size end
		end
	end

	if new + updated + cropped == 0 then return end			-- nothing to copy

	local reported_size
	if size > 2^30 then	reported_size = string.format('%.1f GB min.', size / 2^30)
	elseif size > 2^20 then	reported_size = string.format('%.0f MB min.', size / 2^20)
	elseif size > 2^10 then	reported_size = string.format('%.0f kB min.', size / 2^10)
	else reported_size = string.format('%.0f B min.', size) end

	local space = FSO:GetDrive(FSO:GetDriveName(tblOptions.FILE)).AvailableSpace
	local reported_space
	if space > 2^30 then reported_space = string.format('%.1f GB', space / 2^30)
	elseif space > 2^20 then reported_space = string.format('%.0f MB', space / 2^20)
	elseif space > 2^10 then reported_space = string.format('%.0f kB', space / 2^10)
	else reported_space = string.format('%.0f B', space) end

	local ii = FSO:GetFolder(FSO:GetParentFolderName(tblOptions.FILE)).Files.Count
	local jj = FSO:GetFolder(FSO:GetParentFolderName(tblOptions.FILE)).SubFolders.Count

	local msg = 'New files:     \t' .. new ..
			'\nUpdated files: \t' .. updated ..
			'\nCropped files: \t' .. cropped ..
			'\n\nRequired space: \t' .. reported_size ..
			'\nAvailable space: \t' .. reported_space
	if ii + jj > 0 then
		msg = msg .. string.format('\n\nExport folder already contains %.0f files and %.0f folders.', ii, jj)
		if ii == 1 then msg = msg:gsub(' files ', ' file ') end
		if jj == 1 then msg = msg:gsub(' folders ', ' folder ') end
	end
	if space > size then
		msg = msg .. '\n\nCopy Media files to ' .. tblOptions.FILE .. '?'
		if MessageBox(msg, 'OKCANCEL', 'QUESTION', 'Confirm Media File copying') ~= 1 then return -1 end
	else
		msg = msg .. '\n\nThere is insufficient space to copy the Media files.'
		MessageBox(msg, 'OK', 'ERROR')
		return -1
	end
	local start = os.time()
	ProgressBarReset('Copying Media Files', new + updated + cropped)
	iup.SetAttribute(gblProgress.icon, 'START', 'YES')
	for _, R in pairs(tblRecords.OBJE) do
		if R.COPY then
			if R.AREA == '' then
				FSO:CopyFile(R.OLDPATH, R.PATH)
			else
				CopyCroppedFile(R.OLDPATH, R.PATH, R.AREA, ANSIsource, ANSIdest)
			end
			if ProgressUpdate(5) then return -1 end
			collectgarbage('collect')
		end
	end
	gblProgress.dialog:destroy()
	gblProgress = nil
	return os.time() - start			-- copy duration
end

-- *********************************************************************

function CopyCroppedFile(source, destination, crop, ANSIsource, ANSIdest)

	-- check for Unicode file names

	fhSetConversionLossFlag(false)
	local Fsource = fhConvertUTF8toANSI(source)
	local unicode = fhIsConversionLossFlagSet()
	if unicode then
		fhSetConversionLossFlag(false)
		Fsource = ANSIsource
		FSO:CopyFile(source, ANSIsource)
	end

	-- load image file into image processor and determine format

	local imFull, Error = im.FileImageLoad(Fsource)
	if Error then return 'Image load error ' .. Error end
	local format = im.FileOpen(Fsource):GetInfo()

	-- get dimensions (remove negative crops allowed by FH and convert from top-down to bottom-up)

	local top, left, bottom, right = crop:match('^%{(%-?%d+)%,(%-?%d+)%,(%-?%d+)%,(%-?%d+)%}$')
	top, left, bottom, right = tonumber(top), tonumber(left), tonumber(bottom), tonumber(right)

	if not top or not left or not bottom or not right then
		return 'Image crop error: ' .. source
	end

	local max_height = imFull:Height() - 1			-- allow for zero-based co-ordinates
	local max_width = imFull:Width() - 1
	if top < 0 then top = 0 end
	if bottom > max_height then bottom = max_height end
	if left < 0 then left = 0 end
	if right > max_width then right = max_width end

	top = max_height - top
	bottom = max_height - bottom

	-- create cropped image and convert to OpenGL data format

	local isOK, imCropped = pcall(im.ProcessCropNew, imFull, left, right, bottom, top)
	if not isOK then return 'Cropped image error: ' .. imCropped end
	local cropped_image_width = imCropped:Width()
	local cropped_image_height = imCropped:Height()
	local glData, glForm = imCropped:GetOpenGLData()
	if not glData and glForm then return 'Image creation error: ' .. im.ERR_DATA end
	imCropped = im.ImageCreateFromOpenGLData(cropped_image_width, cropped_image_height, glForm, glData)

	-- save cropped image file to specified path

	local Fdest = fhConvertUTF8toANSI(destination)
	unicode = fhIsConversionLossFlagSet()
	if unicode then
		fhSetConversionLossFlag(false)
		Fdest = ANSIdest
	end
	Error = im.FileImageSave(Fdest, format, imCropped)
	if Error then return 'Image save error ' .. Error end
	imFull:Destroy()
	imCropped:Destroy()

	if unicode then
		FSO:CopyFile(Fdest, destination)
	end
end

-- *********************************************************************

function fnSaveTextFile(FileName, Data, ANSIdest)

	-- creates file in preferred UTF-8, no BOM (need to remove tmpname path in FH7)

	local f = io.open(ANSIdest, 'w')
	if f then
		f:write(Data)
		f:close()
		FSO:CopyFile(ANSIdest, FileName)
		return true
	end
end

-- *********************************************************************

function MessageBox(Message, Buttons, Icon, BoxTitle, Default)

	-- replaces built-in function with custom version containing more options

	local msgdlg = iup.messagedlg{value = Message, buttons = Buttons, dialogtype = Icon,
			title = BoxTitle or fhGetContextInfo('CI_PLUGIN_NAME'), buttondefault = Default,
			parentdialog = menudialog}

	-- display message box and return selection

	msgdlg:popup()
	return tonumber(msgdlg.ButtonResponse)
end

-- *********************************************************************

function ProgressBarReset(type, total)

	-- create if doesn't exist already

	if not gblProgress then
		gblProgress = {}
		gblProgress.bar = iup.progressbar{rastersize = '400x30'}
		gblProgress.icon = iup.animatedlabel{animation = 'IUP_CircleProgressAnimation'}
		gblProgress.btn = iup.button{title = 'Cancel'; padding = '10x3',
				action = function(self) gblProgress.cancel = true end}
		gblProgress.vbox = iup.vbox{gblProgress.bar, gblProgress.icon, gblProgress.btn; gap = 20,
				alignment = 'acenter', margin = '5x15'}
		gblProgress.dialog = iup.dialog{gblProgress.vbox; dialogframe = 'Yes', title = '',
				border = 'Yes', menubox = 'No'}
		iup.SetAttribute(gblProgress.dialog, 'NATIVEPARENT', fhGetContextInfo('CI_APP_HWND'))
		gblProgress.dialog:showxy(iup.CENTER, iup.CENTER)				-- Put up Progress Display
	end
	gblProgress.type = type
	gblProgress.max = total
	gblProgress.value = 0
	gblProgress.bar.max = total
end

-- *********************************************************************

function ProgressUpdate(step)

	gblProgress.value = gblProgress.value + 1
	if gblProgress.value % (step or 50) == 0 then
		gblProgress.bar.value = gblProgress.value
	end
	if gblProgress.value % 1000 == 0 then collectgarbage('collect') end
	gblProgress.dialog.title = gblProgress.type .. ' (' .. gblProgress.value .. ' of ' ..
			gblProgress.max .. ') ...'
	if gblProgress.cancel then return -1 end
	iup.LoopStep()
	return
end

-- *********************************************************************

main()

Source:Export-Public-GEDCOM-File-2.fh_lua