Assign and Cascade Caste.fh_lua

--[[
@Title: 		Assign and Cascade Caste
@Type: 			Standard
@Author: 		Mark Draper
@Version:		1.0
@LastUpdated:	23 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: 	Assigns Caste to selected individual and cascades to descendants through the male line.
]]

--[[
This Caste assignment plugin was developed as a new author training and demonstration example in
response to a FHUG request for a plugin that cascades defined Caste according to rules defined in the thread
at https://www.fhug.org.uk/forum-1/viewtopic.php?t=23952

It should be used alongside the existing guide available within Family Historian. Unfortunately, there is
only limited material available online on Lua coding compared with much more popular script languages such as 
Python and Microsoft VBA, but it is a relatively simple language with a limited number of rules.

Lua was developed originally for Unix-derived systems (it predates Microsoft and DOS/Windows), but most of
its concepts also apply within Windows. It does however retain case-sensitivity in its core structure,
although this is less strictly enforced in the more advanced building of user interfaces using IUP.
]]

require('iuplua')
iup.SetGlobal('CUSTOMQUITMESSAGE', 'YES')

-- declare and assign initial values to 'global' variables, accessible throughout the plugin
-- prefixing variable name is not required, but is recommended to remind the author that it is a global variable

gbl_changes = 0							-- counter for updated records
gbl_tblX = {}							-- refuse bin for deleted caste values

-- define plugin functions (functions must be defined before they can be called)

function main()
	
	-- Lua does not require a 'main' function as the initial and controlling function, but this convention is
	-- commonly used by authors who learned their programming using C/C++, as it is a mandatory requirement
	-- in these languages.

	-- identify currently selected Individual ('local' restricts the variable scope to this function,
	-- so it is independent of similarly named variables in other functions)

	local tblT = fhGetCurrentRecordSel('INDI')

	-- stop if not an individual highlighted

	if not tblT or #tblT == 0 then
		fhMessageBox('Selected Record is not an Individual', 'MB_OK', 'MB_ICONSTOP')
		return
	end

	-- extract individual from one-member table

	local pI = fhNewItemPtr()			-- create a 'pointer' to point to the stored field
	pI = tblT[1]						-- assign the pointer

	-- get that individual's caste (note that there is nothing in FH preventing storing multiple
	-- values for Caste, but for simplicity here it is assumed that there is only one)

	local existing_caste = fhGetItemText(pI, '~.CAST')

	local msg											-- store dialog message
	if existing_caste ~= '' then						-- give sex-appropriate warning message
		if fhGetItemText(pI, '~.SEX') == 'Male' then
			msg = fhGetItemText(pI, '~.NAME') .. ' is already assigned to caste ' .. existing_caste .. 
					'.\n\nOverwrite this value with new selection and cascade to ' ..
					'descendants with no further confirmation?'
		else
			msg = fhGetItemText(pI, '~.NAME') .. ' is already assigned to caste ' .. existing_caste .. 
					'.\n\nOverwrite this value with new selection?'
		end
		if fhMessageBox(msg, 'MB_OKCANCEL', 'MB_ICONEXCLAMATION') ~= 'OK' then
			return														-- cancel execution
		end
	end

	local new_caste = select_caste(pI)									-- select caste from user menu

	-- end execution if no caste selected

	if not new_caste then return end									-- simple condition on one line

	-- set and cascade caste

	set_caste(pI, new_caste)
	if fhGetItemText(pI, '~.SEX') == 'Male' then
		cascade_caste(pI, new_caste)
	end

	-- delete any cleared caste fields

	if #gbl_tblX > 0 then
		for _, p in ipairs(gbl_tblX) do
			fhDeleteItem(p)
		end
	end

	-- display the number of Individuals updated

	if gbl_changes == 1 then							-- ensure message is grammatically correct
		msg = '1 Individual record has been updated.'
	else
		msg = tostring(gbl_changes) .. ' Individual records have been updated.'
	end
	fhMessageBox(msg, 'MB_OK', 'MB_ICONINFORMATION')
end

function select_caste(pI)

	-- get list of all existing caste values by populating table

	local new_caste
	local tblC = {}
	local p = fhNewItemPtr()
	p:MoveToFirstRecord('INDI')
	while p:IsNotNull() do
		local caste = fhGetItemText(p, '~.CAST')
		if caste ~= '' then
			tblC[caste] = true
		end
		p:MoveNext()
	end

	-- define simple addition menu using IUP

	local label = iup.label{title = fhGetItemText(pI, '~.NAME')}
	local list = iup.list{dropdown = 'YES', editbox = 'YES', size = 120, sort = 'YES'}

	local btnOK = iup.button{title = 'OK', 
			action = function(self)
				print(list.value)					-- 'prints' the Caste in the debugger
				new_caste = list.value				--	(useful during development)
				return iup.CLOSE
				end
				}

	local btnCancel = iup.button{title = 'Cancel', padding = '10x3',
			action = function(self) return iup.CLOSE end}

	local hbox = iup.hbox{btnOK, btnCancel; gap = 10, normalizesize = 'BOTH'}
	local vbox = iup.vbox{label, list, hbox; gap = 10, margin = '10x10', alignment = 'ACENTER'}

	local dialog = iup.dialog{vbox; minbox='NO', maxbox='NO', title = 'Select and enter Caste'}
			
	if fhGetAppVersion() > 6 then							-- multiple monitor compatibility
		iup.SetAttribute(dialog, 'NATIVEPARENT', fhGetContextInfo('CI_PARENT_HWND'))
	end
	
	dialog:map()						-- determine form layout prior to populating drop-down list

	-- append existing caste values to menu

	for caste, _ in pairs(tblC) do
		list.AppendItem = caste
	end
	
	dialog:popup()						-- display the selection menu and wait for a user response

	if new_caste == '' then
		local msg = 'Selecting a blank Caste will delete any existing Caste value.\n\n' ..
			'Are you sure that you want to do this?'
		if fhMessageBox(msg, 'MB_OKCANCEL', 'MB_ICONEXCLAMATION') == 'Cancel' then return end
	end
	return	new_caste
	end

function set_caste(pI, caste)

	-- assign caste to selected individual, overwriting any existing value

	local pC = fhGetItemPtr(pI, '~.CAST')		-- pointer to any existing caste
	local old_caste = fhGetItemText(pI, '~.CAST')
	if pC:IsNull() then							-- no Caste recorded
		pC = fhCreateItem('CAST', pI)			-- create blank CAST field
	end
	if caste == old_caste then
		return									-- no change in value
	elseif caste ~= '' then
		fhSetValueAsText(pC, caste)				-- set caste, irrespective of sex
	else
		table.insert(gbl_tblX, pC:Clone())		-- add a copy of the caste pointer to the refuse bin
	end
	print(fhGetItemText(pI, '~.NAME'))			-- 'prints' the name in the debugger
												--	(useful during development)
	gbl_changes = gbl_changes + 1				-- increment the change counter
end

function cascade_caste(pI, caste)

	-- cascade caste to all children of the passed individual

	-- to identify their children, we need to find the family first, as the child is part of the 
	-- family record, not the individual. An individual can have multiple spouses over their lifetime,
	-- so we loop through all recorded spouses.

	-- my convention here is to use L in the name of any pointer that is a 'link' to a record, rather
	-- than pointing to the record itself

	local pFL = fhGetItemPtr(pI, '~.FAMS')
	while pFL:IsNotNull() do
		local pF = fhGetValueAsLink(pFL)
		local pCL = fhGetItemPtr(pF, '~.CHIL')		-- 'local' restricts this variable to the while loop
		while pCL:IsNotNull() do 
			local pC = fhGetValueAsLink(pCL)
			local status = fhGetItemText(pC, '~.FAMC.PEDI')
			if status == '' or status == 'Birth' then
				set_caste(pC, caste)					-- set caste of that child
				if fhGetItemText(pC, '~.SEX') == 'Male' then
					cascade_caste(pC, caste)			-- recursively assign caste via male line
				end
			end
			pCL:MoveNext('SAME_TAG')		-- move to next recorded child of that family
		end
		pFL:MoveNext('SAME_TAG')			-- move to next recorded family
	end
end

-- call main() function that controls plugin execution

main()

Source:Assign-and-Cascade-Caste.fh_lua