Change Specific Fact Tag.fh_lua--[[
@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()
--[[
@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()
Source:Change-Specific-Fact-Tag-5.fh_lua