--[[
@Title:       Change Specific Fact Tag
@Type:        Standard
@Author:      Mark Draper
@Version:     1.2.1
@LastUpdated: 14 Jun 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: Converts an Individual or Family Record fact to a new fact type.  All facts are supported,
              including local local project facts.
]]

--[[
May 2022 - 1.0
	First store version, based on FHUG prototype 0.4
Ju1 2022 - 1.0.1
	Improved robustness for inconsistent Fact Set structures (various FH bugs)
		- List of facts can be anywhere in Fact definition file, not just at beginning
		- Does not process facts with no name or label (e.g. Alternative Name in RM Import)
		- Ignores missing Fact Sets
		- Sets can be in any priority order, not in sequence
Aug 2022 - 1.0.2
	Ignores facts missing either index entry or definition to cope with flawed Military Fact Set
	Rewritten Fact Set loading for fewer passes through file
Oct 2024 - 1.1
	FH5/6 Compatiblility added
	Improved menu behaviour and message boxes
	General code tidy-up
Apr 2025 - 1.2
	Support for multiple monitors added
	Enhanced tool tips added
Jun 2025 - 1.2.1
	Fixed handling of witnessed facts
]]

fhInitialise(5,0,0, 'save_recommended')

require 'luacom'
require('iuplua')
if fhGetAppVersion() > 6 then
	fh = require('fhUtils')
	fh.setIupDefaults()
else
	iup.SetGlobal('CUSTOMQUITMESSAGE','YES')
end
FSO = luacom.CreateObject('Scripting.FileSystemObject')

function main()

	-- select Individual Record

	local pI = fhGetCurrentRecordSel('INDI')[1]
	if not pI then
		MessageBox('No individual selected.', 'OK', 'ERROR')
		return
	end

	-- determine fact set priority and read in sets in increasing priority order

	local tblFactSets = GetFactSets()
	local tblFacts = {}
	for _, fs in ipairs(tblFactSets) do
		GetFactSet(fs .. '.fhf', tblFacts)
	end
	local tblFactGroups = PopulateFactTables(tblFacts)
	if not tblFactGroups then return end			-- end if duplicate fact labels found

	-- present main menu

	Menu(pI, tblFacts, tblFactGroups)
end

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

function Menu(pI, tblFacts, tblFactGroups)

	local tblRecordFacts
	local lstOE, lstOA, lstNE, lstNA, btnOK, btnClear, btnHelp, btnClose			-- forward definitions

	local function PopulateOldFact()
		tblRecordFacts = GetRecordFacts(pI)							-- Pointers to the Individual's Facts
		local tblOldEvents, tblOldAttributes = GetOldFacts(tblFacts, tblRecordFacts)
		for k, v in ipairs(tblOldEvents) do lstOE[k+1] = v end
		for k, v in ipairs(tblOldAttributes) do lstOA[k+1] = v end
	end

	local function PopulateNewFact(parent, label)
		lstNE.RemoveItem = 'All'
		lstNA.RemoveItem = 'All'
		lstNE.AppendItem = '(none selected)'
		lstNA.AppendItem = '(none selected)'
		if parent == 'I' then
			for _, v in ipairs(tblFactGroups.IE) do
				if v ~= label then lstNE.AppendItem = v end
			end
			for _, v in ipairs(tblFactGroups.IA) do
				if v ~= label then lstNA.AppendItem = v end
			end
		else
			for _, v in ipairs(tblFactGroups.FE) do
				if v ~= label then lstNE.AppendItem = v end
			end
			for _, v in ipairs(tblFactGroups.FA) do
				if v ~= label then lstNA.AppendItem = v end
			end
		end

		for _, control in ipairs({lstNE, lstNA}) do
			control.active = 'YES'
			control.value = 1
		end
		btnOK.active = 'NO'
	end

	local function ClearFacts()
		for _, control in ipairs({lstNE, lstNA, lstOE, lstOA}) do
			control.value = 1
		end
		lstOE.active = 'YES'
		lstOA.active = 'YES'
		lstNE.active = 'NO'
		lstNA.active = 'NO'
		btnOK.active = 'NO'
	end

	local OldFactText, NewFactType, NewFactLabel
	local parent, label

	tblRecordFacts = GetRecordFacts(pI)		-- Pointers to the Individual's Facts

	-- define menu elements

	lstOE = iup.list{'(none selected)', dropdown = 'YES', size = 250, value = 1, expand = 'YES',
			VisibleItems = 10, tip = 'Select existing event'}
	local OldEvent = iup.hbox{iup.label{title = 'Event:', size = 40}, lstOE}

	lstOA = iup.list{'(none selected)', dropdown = 'YES', size = 250, value = 1, expand = 'YES',
			VisibleItems = 10, tip = 'Select existing attribute'}
	local OldAttribute = iup.hbox{iup.label{title = 'Attribute:', size = 40}, lstOA}

	lstNE = iup.list{'(none selected)', dropdown = 'YES', size = 250, value = 1, expand = 'YES',
			VisibleItems = 10, tip = 'Select new event', active = 'NO'}
	local NewEvent = iup.hbox{iup.label{title = 'Event:', size = 40}, lstNE}

	lstNA = iup.list{'(none selected)', dropdown = 'YES', size = 250, value = 1, expand = 'YES',
			VisibleItems = 10, tip = 'Select new attribute', active = 'NO'}
	local NewAttribute = iup.hbox{iup.label{title = 'Attribute:', size = 40}, lstNA}

	local OldFact = iup.vbox{OldEvent, OldAttribute; margin = '15x5', gap = 5}
	local NewFact = iup.vbox{NewEvent, NewAttribute; margin = '15x5', gap = 5}

	btnOK = iup.button{title = 'OK', active = 'NO', tip = 'Process change', action = function(self)
			ChangeFact(OldFactText, NewFactLabel, tblRecordFacts, tblFacts)
			PopulateOldFact()
			ClearFacts()
			end}
	btnClear = iup.button{title = 'Clear', tip = 'Clear form', padding = '10x3', action = function(self)
			ClearFacts()
			end}
	btnClose = iup.button{title = 'Close', tip = 'Close plugin', action = function(self) return iup.CLOSE end}
	btnHelp = iup.button{title = 'Help', tip = 'Show help', action = function(self)
			fhShellExecute('https://pluginstore.family-historian.co.uk/page/help/' ..
			'change-specific-fact-tag') end}
	local Buttons = iup.hbox{iup.fill{}, btnOK, btnClear, btnHelp, btnClose, iup.fill{};
		margin = '10x10', normalizesize = 'BOTH', padding = 10, gap = 40}

	-- define enhanced tool tips

	local enhanced = true					-- comment out this line if enhanced tool tips are not required
	if enhanced then
		local tblH = {lstOE, lstOA, lstNE, lstNA, btnOK, btnClear, btnHelp, btnClose}
		for _, control in ipairs(tblH) do
			control.TipBalloon = 'YES'
			control.TipBalloonTitleIcon = 1			-- modify individually if different
		end
		lstOE.TipBalloonTitle = 'Select Existing Event'
		lstOE.tip = 'This is the event that will be changed'
		lstOA.TipBalloonTitle = 'Select Existing Attribute'
		lstOA.tip = 'This is the attribute that will be changed'
		lstNE.TipBalloonTitle = 'Select New Event'
		lstNE.tip = 'This is the new event that will replace the existing selected attribute or event'
		lstNA.TipBalloonTitle = 'Select New Attribute'
		lstNA.tip = 'This is the new attribute that will replace the existing selected attribute or event'
		btnOK.TipBalloonTitle = 'Process Changes'
		btnOK.TipBalloonTitleIcon = '2'
		btnOK.tip = 'Implement the attribute and/or event replacement'
		btnClear.TipBalloonTitle = 'Clear Selections'
		btnClear.tip = 'Clear all form input ready for new selection'
		btnHelp.TipBalloonTitle = 'Help'
		btnHelp.tip = 'Display Plugin Store help file for this plugin'
		btnClose.TipBalloonTitle = 'Close Plugin'
		btnClose.tip = 'Close plugin and return to main application'
	end

	-- define list callbacks

	function lstOE:valuechanged_cb()
		if tonumber(lstOE.value) > 1 then
			OldFactText = lstOE[lstOE.value]
			label, parent = GetOldFactDetails(OldFactText, tblRecordFacts, tblFacts)
			PopulateNewFact(parent, label)
			lstOA.value = 1
			lstOA.active = 'NO'
		else
			lstOA.active = 'YES'
			if tonumber(lstOA.value) == 1 then		-- no old fact now selected
				ClearFacts()
			end
		end
	end
	function lstOA:valuechanged_cb()
		if tonumber(lstOA.value) > 1 then
			OldFactText = lstOA[lstOA.value]
			label, parent = GetOldFactDetails(OldFactText, tblRecordFacts, tblFacts)
			PopulateNewFact(parent, label)
			lstOE.value = 1
			lstOE.active = 'NO'
		else
			lstOE.active = 'YES'
			if tonumber(lstOE.value) == 1 then		-- no old fact now selected
				ClearFacts()
			end
		end
	end
	function lstNE:valuechanged_cb()
		if tonumber(lstNE.value) > 1 then
			NewFactLabel = lstNE[lstNE.value]
			lstNA.value = 1
			lstNA.active = 'NO'
			btnOK.active = 'YES'
		else
			lstNA.active = 'YES'
			btnOK.active = 'NO'
		end
	end
	function lstNA:valuechanged_cb()
		if tonumber(lstNA.value) > 1 then
			NewFactLabel = lstNA[lstNA.value]
			lstNE.value = 1
			lstNE.active = 'NO'
			btnOK.active = 'YES'
		else
			lstNE.active = 'YES'
			btnOK.active = 'NO'
		end
	end

	PopulateOldFact()

	-- assemble final menu

	local Container = iup.vbox{
			iup.frame{OldFact; title = 'Original Event or Attribute:'},
			iup.frame{NewFact; title = 'New Event or Attribute:'},
			Buttons; margin = '20x20', gap = 20}
	local dlg = iup.dialog{Container, title = 'Change Fact for ' .. fhGetDisplayText(pI);
			resize = 'YES', maxbox = 'NO', minbox = 'NO'}
	dlg:map()
	local DialogWidth = dlg.NaturalSize:match('^%d+')
	local DialogHeight = dlg.NaturalSize:match('%d+$')
	if fhGetAppVersion() > 6 then
		iup.SetAttribute(dlg, 'NATIVEPARENT', fhGetContextInfo('CI_PARENT_HWND'))
	end

	-- fixing height not supported in WINE, so keep fully resizable
	
	if not FSO:FolderExists('Z:\\bin') and not FSO:FolderExists('Z:\\etc') then
		dlg.minsize = DialogWidth .. 'x' .. DialogHeight
		dlg.maxsize = 'x' .. DialogHeight
	end
	dlg:popup()
end

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

function GetFactSets()

	-- read in fact set priority list and store in ordered table

	local file, folder
	local tblUnsorted = {}

	-- get Project Fact Sets

	folder  = fhGetContextInfo('CI_PROJECT_DATA_FOLDER') .. '\\Fact Types\\'
	file = folder .. 'GroupIndex.fhdata'
	local tblFile = ReadUTF16File(file) or {}
	for _, v in ipairs(tblFile) do
		local set, seq = v:match('^(.+)=(%d+)$')
		if set and seq then
			seq = math.floor(tonumber(seq))
			table.insert(tblUnsorted, string.format('%04i', 1000 - seq) .. folder .. set)
		end
	end

	-- get System Fact Sets

	folder = fhGetContextInfo('CI_APP_DATA_FOLDER') .. '\\Fact Types\\'
	file = folder .. 'Standard\\GroupIndex.fhdata'
	tblFile = ReadUTF16File(file) or {}
	for _, v in ipairs(tblFile) do
		local set, seq = v:match('^(.+)=(%d+)$')
		if set and seq then
			seq = math.floor(tonumber(seq))
			if set == 'Standard' then
				table.insert(tblUnsorted, '0000' .. folder .. 'Standard\\' .. set)
			else
				table.insert(tblUnsorted, string.format('%04i', 500 - seq) .. folder .. 'Custom\\' .. set)
			end
		end
	end

	-- sort and populate final table

	table.sort(tblUnsorted)
	local tblFactSets = {}
	for _, fs in ipairs(tblUnsorted) do
		table.insert(tblFactSets, fs:sub(5))
	end

	return tblFactSets
end

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

function GetFactSet(File, tblFacts)

	local tblFile = ReadUTF16File(File)
	if not tblFile then return end

	-- identify facts listed in index

	local tblIndexFacts = {}
	local index = false
	local tblFactDefs = {}
	local ActiveFact, WitnessFact

	for _, line in ipairs(tblFile) do
		if index then
			local FactTag = line:match('^Item%d+=(.+)$')
			if FactTag then tblIndexFacts[FactTag] = true end
			if line:sub(1,1) == '[' then				-- end of index section
				index = false
			end
		elseif line == '[.index]' then
			index = true
			ActiveFact = nil
		end

		if line:match('^%[FCT-') and line:match('-[IF][EA]]$') then		-- start of fact definition
			ActiveFact = line:sub(6, -2)
			tblFactDefs[ActiveFact] = {}
		end

		if ActiveFact then
			local term, value = line:match('^(%a+)=(.+)$')
			if term == 'Name' then tblFactDefs[ActiveFact].Name = value end
			if term == 'Label' then tblFactDefs[ActiveFact].Label = value end
			if term == 'Hidden' then tblFactDefs[ActiveFact].Hidden = value end
		end
	end

	-- second pass to identify witness roles (not always listed with main fact definition)

	local witnesses
	for _, line in ipairs(tblFile) do
		if line:match('^%[FCT-') and line:match('-ROLE]$') then		-- start of witness definition
			WitnessFact = line:sub(6, -7)
		end
		local _, Role = line:match('^Role(%d+)=(.+)$')
		if Role then
			if not tblFactDefs[WitnessFact].Witnesses then tblFactDefs[WitnessFact].Witnesses = {} end
			table.insert(tblFactDefs[WitnessFact].Witnesses, Role)
		end
	end		

	-- add valid facts to main table

	for tag, fact in pairs(tblFactDefs) do
		if not (fact.Hidden and fact.Hidden == 'Y') then
			if fact.Name and fact.Label and tblIndexFacts[tag] then
				tblFacts[tag] = {}
				tblFacts[tag].Name = fact.Name
				tblFacts[tag].Label = fact.Label
				if fact.Witnesses then
					tblFacts[tag].Witnesses = fact.Witnesses
				end
			end
		end
	end
end

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

function PopulateFactTables(tblFacts)

	-- check for duplicate fact labels

	local tblFactLabels = {}
	for _, FactDetails in pairs(tblFacts) do
		if tblFactLabels[FactDetails.Label] then
			local msg = 'There is more than one Fact labelled "' .. FactDetails.Label ..
					'".  Please check your Fact definitions'
			MessageBox(msg, 'OK', 'ERROR')
			return
		end
		tblFactLabels[FactDetails.Label] = true
	end

	-- populate tables used in interface dialogue

	local tblF = {IE = {}, IA = {}, FE = {}, FA = {}}
	for tag, FactDetails in pairs(tblFacts) do
		if tag:match('IE$') then table.insert(tblF.IE, FactDetails.Label) end
		if tag:match('IA$') then table.insert(tblF.IA, FactDetails.Label) end
		if tag:match('FE$') then table.insert(tblF.FE, FactDetails.Label) end
		if tag:match('FA$') then table.insert(tblF.FA, FactDetails.Label) end
	end
	for _, t in pairs(tblF) do
		table.sort(t)
	end
	return tblF
end

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

function GetRecordFacts(p)

	-- get Individual and Family Facts for subject individual

	local pF = fhNewItemPtr()
	local tblT = {}

	pF:MoveToFirstChildItem(p)
	while pF:IsNotNull() do
		if fhGetTag(pF) == 'FAMS' then
			local pL = fhGetValueAsLink(pF)
			local pFL = fhNewItemPtr()
			pFL:MoveToFirstChildItem(pL)
			while pFL:IsNotNull() do
				if fhIsFact(pFL) then tblT[fhGetDisplayText(pFL)] = pFL:Clone() end
				pFL:MoveNext()
			end
		elseif fhIsFact(pF) then
			tblT[fhGetDisplayText(pF)] = pF:Clone()
		end
		pF:MoveNext()
	end
	return tblT
end

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

function GetOldFacts(tblFacts, tblRecordFacts)

	-- get fact details

	local tblE = {}
	local tblA = {}

	for RecordText, pF in pairs(tblRecordFacts) do
		local FactLabel = GetOldFactDetails(RecordText, tblRecordFacts, tblFacts)
		if FactLabel == '' then FactLabel = fhGetDisplayText(pF):match('^%S+') end
		local DayNumber = fhCallBuiltInFunction('Daynumber', fhGetValueAsDate(fhGetItemPtr(pF, '~.DATE')):GetDatePt1()) or ''
		local SortTag = FactLabel .. DayNumber .. '<>'

		if fhIsEvent(pF) then table.insert(tblE, SortTag .. fhGetDisplayText(pF)) end
		if fhIsAttribute(pF) then table.insert(tblA, SortTag .. fhGetDisplayText(pF)) end
	end

	table.sort(tblE)			-- alphabetical/chronological
	table.sort(tblA)

	-- strip out sort tags prior to display

	for k, v in ipairs(tblE) do tblE[k] = v:sub(v:find('<>') + 2) end
	for k, v in ipairs(tblA) do tblA[k] = v:sub(v:find('<>') + 2) end

	return tblE, tblA
end

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

function GetOldFactDetails(OldFactText, tblRecordFacts, tblFacts)

	-- return parent (I or F) and label of specified old fact

	local pF = tblRecordFacts[OldFactText]
	local pR = fhNewItemPtr()
	pR:MoveToParentItem(pF)

	local parent = fhGetTag(pR):sub(1, 1)
	local tag = fhGetTag(pF)

	if fhIsEvent(pF) then
		tag = tag .. '-' .. parent .. 'E'
	else
		tag = tag .. '-' .. parent .. 'A'
	end

	if tblFacts[tag] then
		return tblFacts[tag].Label, parent
	else
		return '', parent		-- custom fact does not have a label
	end
end

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

function ChangeFact(OldFactText, NewFactLabel, tblRecordFacts, tblFacts)

	-- get pointer to old fact

	local pOldFact = tblRecordFacts[OldFactText]
	
	-- get name and tag of new fact

	local OldFactType, NewFactName, NewFactTag, NewFactType
	for FactTag, FactDetail in pairs(tblFacts) do
		if FactDetail.Label == NewFactLabel then
			NewFactName = FactDetail.Name
			NewFactTag = FactTag:sub(1, -4)
			NewFactType = FactTag:match('%u$')
			if fhIsEvent(pOldFact) then OldFactType = 'E' else OldFactType = 'A' end
			break
		end
	end

	-- check witness roles before confirming change and making substitution

	if not WitnessCheck(pOldFact, NewFactTag, tblFacts) then return end

	local msg = 'Change ' .. OldFactText .. ' to ' .. NewFactLabel .. '?'
	if OldFactType == 'E' and NewFactType == 'A' then
		msg = msg .. '\n\nCAUTION: You are converting an Event to an Attribute.'
	elseif OldFactType == 'A' and NewFactType == 'E' then
		msg = msg .. '\n\nCAUTION: You are converting an Attribute to an Event.' ..
			'\nAny Attribute value will be saved as a local note in the new Event fact.'
	end

	if MessageBox(msg, 'OKCANCEL', 'QUESTION', nil, 2) == 2 then return end

	-- find fact parent record

	local pR = fhNewItemPtr()
	pR:MoveToParentItem(pOldFact)

	-- add new fact and clone details from old one

	local pNewFact = fhCreateItem(NewFactTag, pR)
	if pNewFact:IsNull() then
		MessageBox('Failed to create new fact.', 'OK', 'ERROR')
		return
	end

	fhMoveItemBefore(pNewFact, pOldFact)
	fhSetValue_Copy(pNewFact, pOldFact)
	CopyChildren(pOldFact, pNewFact)	-- recursive copy as per FHUG snippet

	-- get any fact value and save as local note if lost

	local update_msg = ''
	local OldFactValue = fhGetValueAsText(pOldFact) or ''
	local NewFactValue = fhGetValueAsText(pNewFact) or ''
	if OldFactValue ~= '' and NewFactValue == '' then
		if fhGetItemPtr(pOldFact, '~.NOTE2'):IsNotNull() then
			update_msg = '\n\nTo view the saved Attribute value, ' ..
					'click on the All tab in the FH Property Box.'
		end
		local pN = fhCreateItem('NOTE2', pNewFact)
		fhSetValueAsText(pN, OldFactValue)
	end

	-- delete old fact

	fhDeleteItem(pOldFact)
	fhUpdateDisplay()

	MessageBox('Fact updated.' .. update_msg, 'OK', 'INFORMATION')
end

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

function CopyBranch(pSource, pTarget)

	local tag = fhGetTag(pSource)
	if tag == '_FMT' then return end		-- Skip rich text format code
	if tag == '_FIELD' then				-- Substitute metafield shortcut
		tag = fhGetMetafieldShortcut(pSource)
	end

	local pNew = fhCreateItem(tag, pTarget, true)
	if pNew:IsNull() then return end		-- Escape if item not created
	fhSetValue_Copy(pNew, pSource)
	CopyChildren(pSource, pNew)
end

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

function CopyChildren(pSource, pTarget)

	local pFrom = fhNewItemPtr()
	pFrom = pSource:Clone()
	pFrom:MoveToFirstChildItem(pFrom)
	while pFrom:IsNotNull() do
		CopyBranch(pFrom, pTarget)
		pFrom:MoveNext()
	end
end

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

function WitnessCheck(pOldFact, NewFactTag, tblFacts)

	local pW = fhNewItemPtr()
	local tblMissing = {}

	-- identify witnesses and check if role exists in new fact definition

	pW:MoveToFirstChildItem(pOldFact)
	while pW:IsNotNull() do
		if fhGetTag(pW) == '_SHAR' or fhGetTag(pW) == '_SHAN' then
			local pR = fhNewItemPtr()
			pR:MoveTo(pW, '~.ROLE')
			local role = fhGetValueAsText(pR)

			-- does this role exist in proposed new fact?

			local found = false
			for tag, v in pairs(tblFacts) do
				local OldTag = tag:sub(1, tag:len() - 3)
				if NewFactTag == OldTag then
					for _, WitnessRole in ipairs(v.Witnesses) do
						print(WitnessRole)
						if WitnessRole == role then found = true end
					end
				end
			end
			if not found then table.insert(tblMissing) end
		end
		pW:MoveNext()
	end
	if #tblMissing == 0 then return true end		-- no missing witness roles
	local msg = 'The following Witness Roles are present in the old Fact Record but ' ..
		'missing from the definition of the new Fact Record.  Please update the new ' ..
		'Fact definition before changing this fact name. \n\n'
	for role, _ in pairs(tblMissing) do msg = msg .. role .. '\n' end
	MessageBox(msg, 'OK', 'ERROR')
end

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

function ReadUTF16File(File)

	if not FSO:FileExists(File) then return end
	local ts = FSO:OpenTextFile(File, 1, false, -1)
	local tblFile = {}
	while not ts.AtEndOfStream do
		table.insert(tblFile, ts:ReadLine())
	end
	ts:Close()
	return tblFile
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

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

main()