Show Project Statistics.fh_lua--[[
@Title: Show Project Statistics
@Type: Standard
@Author: Mike Tate
@Contributors:
@Version: 2.9
@Keywords:
@LastUpdated: 15 Mar 2023
@Licence: This plugin is copyright (c) 2023 Mike Tate & contributors and is licensed under the MIT License which is hereby incorporated by reference (see https://pluginstore.family-historian.co.uk/fh-plugin-licence)
@Description: Show project statistics and exceptions as requested by Wish List Ref 191 File Summary Display.
@V2.9: Library V3.3; Check Sort Dates; Report duplicated BMD events;
@V2.8: Library V3.2 after various updates; Added DetectOldModules(); Fix for Standalone GEDCOM and Snapshots;
@V2.7: Library V3.2 with FSO and Unicode filepaths; Fix CSV export for Data grid; Fix for missing File Link in Format v Type check (LMO Sort Date);
@V2.6: Add garbage memory management needed for large Projects; Library v3.1 with monthly version check;
@V2.5: Protect action(ptrRef:Clone(),...) against change by such as UpdateMedia(ptrRef,...) so Living Flag handled correctly;
@V2.4: Adjusted displays for HiRes monitors; Added Exceptions Reported count; Cater for Sex Unknown instead of blank = Undefined;
@V2.3: Include FH V7 GEDCOM 5.5.1 Media File _AREA check;
@V2.2: Updated library to Functions Prototypes v3.0; FH V7 Lua 3.5 IUP 3.28;
@V2.1: Update to library V2.9; iup_gui.Balloon = "NO" for Crossover/PlayOnLinux/Mac; Check Snapshot files;
@V2.0: Ensure Project folder exists via updated Library modules, revised Parent/Family counts, add Names & Ordinations, "All" Facts, omit Age At Birth, check Birth Age > 0, UDF, Date Points with no Day Number, new counts/checks for Media & Sources/Citations, new counts of Work with Data categories Places, Addresses, Occupations, Keywords, etc.
@V1.9: Both ANSI FH V5 & UTF-8 FH V6 IUP 3.11.2, iup.SetGlobal("UTF8MODE","YES"), HelpDialogue conditional ExpandChildren="YES/NO", RefreshDialoge uses NaturalSize, new LastUpdated() function, reduce minimum Area threshold to 9.
@V1.8: Updates to iup_gui module with Help window X Close crash fix and extra fonts & colours, resizable window & matrix columns, despaced grid titles, F1 help_cb, add BalloonToggle()
@V1.8: Report media FORMat v FILE type mismatch, and AREA v file height & width or type mismatch, MakeHelpDialogue() new Help & Advice pages, see comments marked with 'V1.8'.
@V1.7: Improve some Item names & 'buddy' pointers, report Dates too far in past, add Exception Report Options tab, see comments marked with 'V1.7'.
@V1.6: Improve some "buddy" pointers to refer to data field, fix invalid date warning text, and fix ResetGridCells error, see comments marked with 'V1.6'.
@V1.5: Check date warnings using GetDataWarning(...) in UpdateDate(...) function, count Max.Spouses & report if any Spouse link is duplicated, and add "buddy" column to Result Set.
@V1.4: Preserve the Result Set with Grid, report Permanent/Automatic Record Idents and Citation Entry Dates in future, allow Flag name "All", bug fix AgeAt -ve age by -1, plus new string library.
Add Cremation events to Facts tab, and change 'Close & Show Report' button label to 'Close & Report' plus other adjustments to get height < 600 pixel, add Version History help, and GUI Library.
@V1.3: Correct "Ave.Children" count, add "Idents" count, refine several other counts, add Result Set Exceptions Report, show highest & lowest 2 Pools & 5 Flags with rest in middle.
@V1.2: Correct "Both Sex", "Same Sex", "One Parent", "No Parents" Couples counts, and sort Flags by popularity.
@V1.1: Correct the Age statistics, add Age At and Pool and Flag plus a few other statistics.
@V1.0: Initial version with Tabs, Export CSV files, etc.
]]
if fhGetAppVersion() > 5 then fhSetStringEncoding("UTF-8") end
if fhGetAppVersion() > 6 then loadstring = load end
--[[
@Title: aa Library Functions Preamble
@Author: Mike Tate
@Version: 3.3
@LastUpdated: 03 May 2022
@Description: All the library functions prototype closures for Plugins.
]]
--[[
@Module: +fh+stringx_v3
@Author: Mike Tate
@Version: 3.0
@LastUpdated: 19 Sep 2020
@Description: Extended string functions to supplement LUA string library.
@V3.0: Function Prototype Closure version with Lua 5.1 & 5.3 comaptibility; Added inert(strTxt) function;
@V2.5: Support FH V6 Encoding = UTF-8;
@V2.4: Tolerant of integer & nil parameters just link match & gsub;
@V1.0: Initial version.
]]
local function stringx_v3()
local fh = {} -- Local environment table
-- Supply current file encoding format --
function fh.encoding()
if fhGetAppVersion() > 5 then return fhGetStringEncoding() end
return "ANSI"
end -- function encoding
-- Split a string using "," or chosen separator --
function fh.split(strTxt,strSep)
local tblFields = {}
local strPattern = string.format("([^%s]+)", strSep or ",")
strTxt = tostring(strTxt or "")
strTxt:gsub(strPattern, function(strField) tblFields[#tblFields+1] = strField end)
return tblFields
end -- function split
-- Split a string into numbers using " " or "," or "x" separators -- Any non-number remains as a string
function fh.splitnumbers(strTxt)
local tblNum = {}
strTxt = tostring(strTxt or "")
strTxt:gsub("([^ ,x]+)", function(strNum) tblNum[#tblNum+1] = tonumber(strNum) or strNum end)
return tblNum
end -- function splitnumbers
local strMagic = "([%^%$%(%)%%%.%[%]%*%+%-%?])" -- UTF-8 replacement for "(%W)"
-- Hide magic pattern symbols ^ $ ( ) % . [ ] * + - ?
function fh.plain(strTxt)
-- Prefix every magic pattern character with a % escape character,
-- where %% is the % escape, and %1 is the original character capture.
strTxt = tostring(strTxt or ""):gsub(strMagic,"%%%1")
return strTxt
end -- function plain
-- matches is plain text version of string.match()
function fh.matches(strTxt,strFind,intInit)
strFind = tostring(strFind or ""):gsub(strMagic,"%%%1") -- Hide magic pattern symbols
return tostring(strTxt or ""):match(strFind,tonumber(intInit))
end -- function matches
-- replace is plain text version of string.gsub()
function fh.replace(strTxt,strOld,strNew,intNum)
strOld = tostring(strOld or ""):gsub(strMagic,"%%%1") -- Hide magic pattern symbols
return tostring(strTxt or ""):gsub(strOld,function() return strNew end,tonumber(intNum)) -- Hide % capture symbols
end -- function replace
-- Hide % escape/capture symbols in replacement so they are inert
function fh.inert(strTxt)
strTxt = tostring(strTxt or ""):gsub("%%","%%%%") -- Hide all % symbols
return strTxt
end -- function inert
-- convert is pattern without captures version of string.gsub()
function fh.convert(strTxt,strOld,strNew,intNum)
return tostring(strTxt or ""):gsub(tostring(strOld or ""),function() return strNew end,tonumber(intNum)) -- Hide % capture symbols
end -- function convert
local dicUpper = { }
local dicLower = { }
local dicCaseX = { }
-- ASCII unaccented letter translations for Upper, Lower, and Case Insensitive
for intUpper = string.byte("A"), string.byte("Z") do
local strUpper = string.char(intUpper)
local strLower = string.char(intUpper - string.byte("A") + string.byte("a"))
dicUpper[strLower] = strUpper
dicLower[strUpper] = strLower
local strCaseX = "["..strUpper..strLower.."]"
dicCaseX[strLower] = strCaseX
dicCaseX[strUpper] = strCaseX
end
-- Supply character length of ANSI text --
function fh.length(strTxt)
return string.len(strTxt or "")
end -- function length
-- Supply character substring of ANSI text --
function fh.substring(strTxt,i,j)
return string.sub(strTxt or "",i,j)
end -- function substring
-- Translate upper/lower case ANSI letters to pattern that matches both --
function fh.caseless(strTxt)
strTxt = tostring(strTxt or ""):gsub("[A-Za-z]",dicCaseX)
return strTxt
end -- function caseless
if fh.encoding() == "UTF-8" then
-- Supply character length of UTF-8 text --
function fh.length(strTxt)
isFlag = fhIsConversionLossFlagSet()
strTxt = fhConvertUTF8toANSI(strTxt or "")
fhSetConversionLossFlag(isFlag)
return string.len(strTxt)
end -- function length
local strUTF8 = "([%z\1-\127\194-\244][\128-\191]*)" -- Cater for Lua 5.1 %z or Lua 5.3 \0
if fhGetAppVersion() > 6 then
strUTF8 = "([\0-\127\194-\244][\128-\191]*)"
end
-- Supply character substring of UTF-8 text --
function fh.substring(strTxt,i,j)
local strSub = ""
j = j or -1
if j < 0 then j = j + length(strTxt) + 1 end
if i < 0 then i = i + length(strTxt) + 1 end
for strChr in string.gmatch(strTxt or "",strUTF8) do
if j <= 0 then break end
j = j - 1
i = i - 1
if i <= 0 then strSub = strSub..strChr end
end
return strSub
end -- function substring
-- Translate lower case to upper case UTF-8 letters --
function fh.upper(strTxt)
strTxt = tostring(strTxt or ""):gsub("([a-z\194-\244][\128-\191]*)",dicUpper)
return strTxt
end -- function upper
-- Translate upper case to lower case UTF-8 letters --
function fh.lower(strTxt)
strTxt = tostring(strTxt or ""):gsub("([A-Z\194-\244][\128-\191]*)",dicLower)
return strTxt
end -- function lower
-- Translate upper/lower case UTF-8 letters to pattern that matches both --
function fh.caseless(strTxt)
strTxt = tostring(strTxt or ""):gsub("([A-Za-z\194-\244][\128-\191]*)",dicCaseX)
return strTxt
end -- function caseless
-- Following tables use ASCII numeric coding to be immune from ANSI/UTF-8 encoding --
local arrPairs = -- Upper & Lower case groups of UTF-8 letters with same prefix --
{-- { Prefix; Beg ; End ; Inc; Offset Upper > Lower }; -- These include all ANSI letters and many more
{ "\195"; 0x80; 0x96; 1 ; 32 }; -- 195=0xC3 À U+00C0 to Ö U+00D6 and à U+00E0 to ö U+00F6
{ "\195"; 0x98; 0x9E; 1 ; 32 }; -- 195=0xC3 Ø U+00D8 to Þ U+00DE and ø U+00F8 to þ U+00FE
{ "\196"; 0x80; 0xB6; 2 ; 1 }; -- 196=0xC4 A U+0100 to k U+0137 in pairs
{ "\196"; 0xB9; 0xBD; 2 ; 1 }; -- 196=0xC4 L U+0139 to l U+013E in pairs
{ "\197"; 0x81; 0x87; 2 ; 1 }; -- 197=0xC5 L U+0141 to n U+0148 in pairs
{ "\197"; 0x8A; 0xB6; 2 ; 1 }; -- 197=0xC5 ? U+014A to y U+0177 in pairs
{ "\197"; 0xB9; 0xBD; 2 ; 1 }; -- 197=0xC5 Z U+0179 to ž U+017E in pairs
{ "\198"; 0x82; 0x84; 2 ; 1 }; -- 198=0xC6 ? U+0182 to ? U+0185 in pairs
-- Add more Unicode groups here as usage increases --
}
local dicPairs = -- Upper v Lower case UTF-8 letters that don't fit groups above --
{ [string.char(0xC4,0xBF)] = string.char(0xC5,0x80); -- ? U+013F and ? U+0140
[string.char(0xC5,0xB8)] = string.char(0xC3,0xBF); -- Ÿ U+0178 and ÿ U+00FF
}
local intBeg1 = string.byte(string.sub("À",1))
local intBeg2 = string.byte(string.sub("À",2))
local intEnd1 = string.byte(string.sub("Z",1))
local intEnd2 = string.byte(string.sub("Z",2))
-- print(string.format("%#x %#x %#x %#x",intBeg1,intBeg2,intEnd1,intEnd2)) -- Useful to work out numeric coding
-- Populate the UTF-8 letter translation dictionaries --
for intGroup, tblGroup in ipairs ( arrPairs ) do -- UTF-8 accented letter groups
local strPrefix = tblGroup[1]
for intUpper = tblGroup[2], tblGroup[3], tblGroup[4] do
local strUpper = string.char(intUpper)
local strLower = string.char(intUpper + tblGroup[5])
local strCaseX = strPrefix.."["..strUpper..strLower.."]"
strUpper = strPrefix..strUpper
strLower = strPrefix..strLower
dicUpper[strLower] = strUpper
dicLower[strUpper] = strLower
dicCaseX[strLower] = strCaseX
dicCaseX[strUpper] = strCaseX
end
end
for strUpper, strLower in pairs ( dicPairs ) do -- UTF-8 accented letters where upper & lower have different prefix
dicUpper[strLower] = strUpper
dicLower[strUpper] = strLower
local strCaseX = ""
for intByte = 1, #strUpper do -- Matches more than just the two letters, but can't do any better
strCaseX = strCaseX.."["..strUpper:sub(intByte,intByte)..strLower:sub(intByte,intByte).."]"
end
dicCaseX[strLower] = strCaseX
dicCaseX[strUpper] = strCaseX
end
end
-- overload fh functions into string table
for strIndex, anyValue in pairs(fh) do
if type(anyValue) == "function" then
string[strIndex] = anyValue
end
end
return fh
end -- local function stringx_v3
local stringx = stringx_v3() -- To access FH string extension module
--[[
@Module: +fh+iterate_v3
@Author: Mike Tate
@Version: 3.0
@LastUpdated: 25 Aug 2020
@Description: An iterater functions module to supplement LUA functions.
@V3.0: Function Prototype Closure version.
@V1.2: RecordTypes() includes HEAD tag.
@V1.1: ?
@V1.0: Initial version.
]]
local function iterate_v3()
local fh = {} -- Local environment table
-- Iterator for all records of one chosen type --
function fh.Records(strType)
local ptrAll = fhNewItemPtr() -- Pointer to all records in turn
local ptrRec = fhNewItemPtr() -- Pointer to record returned to user
ptrAll:MoveToFirstRecord(strType)
return function ()
ptrRec:MoveTo(ptrAll)
ptrAll:MoveNext()
if ptrRec:IsNotNull() then return ptrRec end
end
end -- function Records
-- Iterator for all the record types --
function fh.RecordTypes()
local intNext = -1 -- Next record type number
local intLast = fhGetRecordTypeCount() -- Last record type number
return function()
intNext = intNext + 1
if intNext == 0 then -- Includes HEAD tag -- V1.2
return "HEAD"
elseif intNext <= intLast then
return fhGetRecordTypeTag(intNext) -- Return record type tag
end
end
end -- function RecordTypes
-- Iterator for all items in all records of chosen types --
function fh.Items(...)
local arg = {...}
local intType = 1 -- Integer record type number
local tblType = {} -- Table of record type tags
local ptrNext = fhNewItemPtr() -- Pointer to next item in turn
local ptrItem = fhNewItemPtr() -- Pointer to item returned to user
if #arg == 0 then
for intType = 1, fhGetRecordTypeCount() do -- No parameters so use all record types
tblType[intType] = fhGetRecordTypeTag(intType)
end
else
tblType = arg -- Got parameters so use them instead
end
-- print(tblType[intType],intType)
ptrNext:MoveToFirstRecord(tblType[intType]) -- Get first record of first type
return function()
repeat
while ptrNext:IsNotNull() do -- Loop through all items
ptrItem:MoveTo(ptrNext)
ptrNext:MoveNextSpecial()
if ptrItem:IsNotNull() then return ptrItem end
end
intType = intType + 1 -- Loop through each record type
if intType <= #tblType then
ptrNext:MoveToFirstRecord(tblType[intType])
end
until intType > #tblType
end
end -- function Items
-- Iterator for all facts of an individual --
function fh.Facts(ptrIndi)
local ptrItem = fhNewItemPtr() -- Pointer to each item at level 1
local ptrFact = fhNewItemPtr() -- Pointer to each fact returned to user
ptrItem:MoveToFirstChildItem(ptrIndi)
return function ()
while ptrItem:IsNotNull() do
ptrFact:MoveTo(ptrItem)
ptrItem:MoveNext()
if fhIsFact(ptrFact) then return ptrFact end
end
end
end -- function Facts
return fh
end -- local function iterate_v3
local iterate = iterate_v3() -- To access FH iterate items module
--[[
@Module: +fh+general_v3
@Author: Mike Tate
@Version: 3.2
@LastUpdated: 10 Mar 2022
@Description: A general functions module to supplement LUA functions, where filenames use UTF-8 but for a few exceptions.
@V3.2: Added function DetectOldModules(); Updated functions RenameFile(), RenameFolder() & GetFolderContents();
@V3.1: Functions derived from FH V7 fhFileUtils library using File System Objects, plus additional features;
@V3.0: Function Prototype Closure version; GetDayNumber() error message reasons;
@V1.5: Revised SplitFilename(strFilename) for missing extension.
@V1.4: Revised EstimatedBirthDates() & EstimatedDeathDates() to fix null Dates.
@V1.3: Add GetDayNumber(), EstimatedBirthDates(), EstimatedDeathDates().
@V1.2: SplitFilename() updated for directory only paths, and MakeFolder() added.
@V1.1: pl.path experiment revoked. New DirTree with omit branch option. Avoid using stringx_v2.
@V1.0: Initial version.
]]
local function general_v3()
local fh = {} -- Local environment table
require("luacom") -- To create File System Object
fh.FSO = luacom.CreateObject("Scripting.FileSystemObject")
-- Report error message --
local function doError(strMessage,errFunction)
-- strMessage ~ error message text
-- errFunction ~ optional error reporting function
if type(errFunction) == "function" then
errFunction(strMessage)
else
error(strMessage)
end
end -- local function doError
-- Convert filename to ANSI alternative and indicate success --
function fh.FileNameToANSI(strFileName,strAnsiName)
-- strFileName ~ full file path
-- strAnsiFile ~ ANSI file name & type
-- return values ~ ANSI file path, true if original path was ANSI compatible
if stringx.encoding() == "ANSI" then return strFileName, true end
local isFlag = fhIsConversionLossFlagSet()
fhSetConversionLossFlag(false)
local strAnsi = fhConvertUTF8toANSI(strFileName)
local wasAnsi = true
if fhIsConversionLossFlagSet() then
strAnsiName = strAnsiName or "ANSI.ANSI"
strAnsi = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Plugin Data\\"..strAnsiName
wasAnsi = false
end
fhSetConversionLossFlag(isFlag)
return strAnsi, wasAnsi
end -- local function FileNameToANSI
-- Get parent folder --
function fh.GetParentFolder(strFileName)
-- strFileName ~ full file path
-- return value ~ parent folder path
local strParent = fh.FSO:GetParentFolderName(strFileName) --! Faulty in FH v6 with Unicode chars in path
if fhGetAppVersion() == 6 then
local _, wasAnsi = fh.FileNameToANSI(strFileName)
if not wasAnsi then
strParent = strFileName:match("^(.+)[\\/][^\\/]+[\\/]?$")
end
end
return strParent
end -- function GetParentFolder
-- Check if file exists --
function fh.FlgFileExists(strFileName)
-- strFileName ~ full file path
-- return value ~ true if it exists
return fh.FSO:FileExists(strFileName)
end -- function FlgFileExists
-- Check if folder exists --
function fh.FlgFolderExists(strFolderName)
-- strFolderName ~ full file path
-- return value ~ true if it exists
return fh.FSO:FolderExists(strFolderName)
end -- function FlgFolderExists
-- Delete a file if it exists --
function fh.DeleteFile(strFileName,errFunction)
-- strFileName ~ full file path
-- errFunction ~ optional error reporting function
-- return value ~ true if file does not exist or is deleted else false
if fh.FSO:FileExists(strFileName) then
fh.FSO:DeleteFile(strFileName,true)
if fh.FSO:FileExists(strFileName) then
doError("File Not Deleted:\n"..strFileName.."\n",errFunction)
return false
end
end
return true
end -- function DeleteFile
-- Delete a folder if it exists including contents --
function fh.DeleteFolder(strFolderName,errFunction)
-- strFolderName ~ full folder path
-- errFunction ~ optional error reporting function
-- return value ~ true if folder does not exist or is deleted else false
if fh.FSO:FolderExists(strFolderName) then
fh.FSO:DeleteFolder(strFolderName,true)
if fh.FSO:FolderExists(strFolderName) then
doError("Folder Not Deleted:\n"..strFolderName.."\n",errFunction)
return false
end
end
return true
end -- function DeleteFolder
-- Rename a file if it exists --
function fh.RenameFile(strFileName,strNewName)
-- strFileName ~ full file path
-- strNewName ~ new file name & type
-- return value ~ true if file exists but new name does not and rename is OK else false
local strNewFile = fh.GetParentFolder(strFileName).."\\"..strNewName
if fh.FSO:FileExists(strFileName) and not fh.FSO:FileExists(strNewFile) then
local fileObject = fh.FSO:GetFile(strFileName)
fileObject.Name = strNewName
if fh.FSO:FileExists(strNewFile) then
return true
end
end
return false
end -- function RenameFile
-- Rename a folder if it exists --
function fh.RenameFolder(strFolderName,strNewName)
-- strFolderName ~ full folder path
-- strNewName ~ new folder name
-- return value ~ true if folder exists but new name does not and rename is OK else false
local strNewFolder = fh.GetParentFolder(strFolderName).."\\"..strNewName
if fh.FSO:FolderExists(strFolderName) and not fh.FSO:FolderExists(strNewFolder) then
local folderObject = fh.FSO:GetFolder(strFolderName)
folderObject.Name = strNewName
if fh.FSO:FolderExists(strNewFolder) then
return true
end
end
return false
end -- function RenameFolder
-- Copy a file if it exists and destination is not a folder --
function fh.CopyFile(strFileName,strDestination)
-- strFileName ~ full source file path
-- strDestination ~ full target file path
-- return value ~ true if file exists and is copied else false
if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FileExists(strFileName) and not fh.FSO:FolderExists(strDestination) then
fh.FSO:CopyFile(strFileName,strDestination)
if fh.FSO:FileExists(strDestination) then
return true
end
end
return false
end -- function CopyFile
-- Copy a folder if it exists and destination is not a file --
function fh.CopyFolder(strFolderName,strDestination)
-- strFolderName ~ full source folder path
-- strDestination ~ full target folder path
-- return value ~ true if folder exists and is copied else false
if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FolderExists(strFolderName) and not fh.FSO:FileExists(strDestination) then
fh.FSO:CopyFolder(strFolderName,strDestination)
if fh.FSO:FolderExists(strDestination) then
return true
end
end
return false
end -- function CopyFolder
-- Move a file if it exists and destination is not a folder --
function fh.MoveFile(strFileName,strDestination)
-- strFileName ~ full source file path
-- strDestination ~ full target file path
-- return value ~ true if file exists and is moved else false
if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FileExists(strFileName) and not fh.FSO:FolderExists(strDestination) then
if fh.DeleteFile(strDestination) then
fh.FSO:MoveFile(strFileName,strDestination)
if fh.FSO:FileExists(strDestination) then
return true
end
end
end
return false
end -- function MoveFile
-- Move a folder if it exists and destination is not a file --
function fh.MoveFolder(strFolderName,strDestination)
-- strFolderName ~ full source folder path
-- strDestination ~ full target folder path
-- return value ~ true if folder exists and is moved else false
if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FolderExists(strFolderName) and not fh.FSO:FileExists(strDestination) then
if fh.DeleteFolder(strDestination) then
fh.FSO:MoveFolder(strFolderName,strDestination)
if fh.FSO:FolderExists(strDestination) then
return true
end
end
end
return false
end -- function MoveFolder
-- Make subfolder recursively if does not exist --
function fh.MakeFolder(strFolderName,errFunction)
-- strFolderName ~ full source folder path
-- errFunction ~ optional error reporting function
-- return value ~ true if folder exists or created else false
if not fh.FSO:FolderExists(strFolderName) then
if not fh.MakeFolder(fh.GetParentFolder(strFolderName),errFunction) then
return false
end
fh.FSO:CreateFolder(strFolderName)
if not fh.FSO:FolderExists(strFolderName) then
doError("Cannot Make Folder:\n"..strFolderName.."\n",errFunction)
return false
end
end
return true
end -- function MakeFolder
-- Check if folder writable --
function fh.FlgFolderWrite(strFolderName)
-- strFolderName ~ full source folder path
-- return value ~ true if folder writable else false
if fh.FlgFolderExists(strFolderName) then
if fh.MakeFolder(strFolderName.."\\vwxyz") then
fh.FSO:DeleteFolder(strFolderName.."\\vwxyz",true)
return true
end
end
return false
end -- function FlgFolderWrite
-- Open File with ANSI path and return Handle --
function fh.OpenFile(strFileName,strMode)
-- strFileName ~ full file path
-- strMode ~ "r", "w", "a" optionally suffixed with "+" &/or "b"
-- return value ~ file handle
local fileHandle, strError = io.open(strFileName,strMode)
if fileHandle == nil then
error("\n Unable to open file in \""..strMode.."\" mode. \n "..strFileName.." \n "..strError.." \n")
end
return fileHandle
end -- function OpenFile
-- Save string to file --
function fh.SaveStringToFile(strContents,strFileName,strFormat)
-- strContents ~ text string
-- strFileName ~ full file path
-- strFormat ~ optional "UTF-8" or "UTF-16LE"
-- return value ~ true if successful else false
strFormat = strFormat or "UTF-8"
if fhGetAppVersion() > 6 then
return fhSaveTextFile(strFileName,strContents,strFormat)
end
local strAnsi, wasAnsi = fh.FileNameToANSI(strFileName)
local fileHandle = fh.OpenFile(strAnsi,"w")
fileHandle:write(strContents)
assert(fileHandle:close())
if not wasAnsi then
fh.MoveFile(strAnsi,strFileName)
end
return true
end -- function SaveStringToFile
-- Load string from file --
function fh.StrLoadFromFile(strFileName,strFormat)
-- strFileName ~ full file path
-- strFormat ~ optional "UTF-8" or "UTF-16LE"
-- return value ~ file contents
strFormat = strFormat or "UTF-8"
if fhGetAppVersion() > 6 then
return fhLoadTextFile(strFileName,strFormat)
end
local strAnsi, wasAnsi = fh.FileNameToANSI(strFileName)
if not wasAnsi then
fh.CopyFile(strFileName,strAnsi)
end
local fileHandle = fh.OpenFile(strAnsi,"r")
local strContents = fileHandle:read("*all")
assert(fileHandle:close())
return strContents
end -- function StrLoadFromFile
-- Returns the Path, Filename, and Extension as 3 values --
function fh.SplitFilename(strFileName)
-- strFileName ~ full file path
-- return values ~ path, name.type, type
if fh.FSO:FolderExists(strFileName) then
local strPath = strFileName:gsub("[\\/]$","")
return strPath.."\\","",""
end
strFileName = strFileName.."."
return strFileName:match("^(.-)([^\\/]-%.([^\\/%.]-))%.?$")
end -- function SplitFilename
-- Convert dd/mm/yyyy hh:mm:ss format to integer seconds -- (DateTime format is used in attributes returned by GetFolderContents and DirTree below)
function fh.IntTime(strDateTime)
-- strDateTime ~ date time string
-- return value ~ integer seconds since 01/01/1970 00:00:00
local strDay,strMonth,strYear,strHour,strMin,strSec = strDateTime:match("^(%d%d)/(%d%d)/(%d+) (%d%d):(%d%d):(%d%d)")
if tonumber(strYear) < 1970 then return 0 end
local isDST = false
if tonumber(strMonth) > 4 and tonumber(strMonth) < 11 then isDST = true end -- Approximation is sometimes wrong
local intTime = os.time( { year=strYear; month=strMonth; day=strDay; hour=strHour; min=strMin; sec=strSec; isdst=isDST; } )
local tblDat = os.date("*t",intTime)
if tblDat.isdst then
intTime = intTime + 3600
isDST = true
end
return intTime
end -- function IntTime
-- Return table of attributes --
local function attributes(tblAttr,strMode)
-- tblAttr ~ file attributes table
-- strMode ~ "file" or "directory"
-- return value ~ attributes table like LFS except datetimes
local tblAttr = { name=tblAttr.name; created=tblAttr.DateCreated; type=tblAttr.Type; path=tblAttr.path; shortname=tblAttr.ShortName; shortpath=tblAttr.ShortPath; size=tblAttr.Size; modified=tblAttr.DateLastModified; attributes=tblAttr.Attributes; }
tblAttr.mode = strMode
return tblAttr
end -- local function attributes
-- Return attributes table of all files and folders in a specified folder --
function fh.GetFolderContents(strFolder,doRecurse)
-- strFolder ~ full folder path
-- doRecurse ~ true for recursion
-- return value ~ attributes table
local arrList = {}
if fh.FSO:FolderExists(strFolder) then
local function getFileList(strFolder)
local tblList = fh.FSO:GetFolder(strFolder)
local tblEnum = luacom.GetEnumerator(tblList.SubFolders)
local tblAttr = tblEnum:Next()
while tblAttr do
table.insert(arrList,attributes(tblAttr,"directory"))
if doRecurse then getFileList(tblAttr.path) end
tblAttr = tblEnum:Next()
end
local tblEnum = luacom.GetEnumerator(tblList.Files)
local tblAttr = tblEnum:Next()
while tblAttr do
table.insert(arrList,attributes(tblAttr,"file"))
tblAttr = tblEnum:Next()
end
end
getFileList(strFolder)
end
return arrList
end -- function GetFolderContents
-- Return a Directory Tree entry & attributes on each iteration --
function fh.DirTree(strDir,...)
-- strDir ~ full folder path
-- ... ~ list of folders to omit
-- return value ~ full path, attributes table
local arg = {...}
assert( fh.FSO:FolderExists(strDir), "directory parameter is missing or empty" )
local function yieldtree(strDir)
local tblList = fh.FSO:GetFolder(strDir)
local tblEnum = luacom.GetEnumerator(tblList.SubFolders)
local tblAttr = tblEnum:Next()
while tblAttr do -- for _,tblAttr in luacom.pairs(tblList.SubFolders) do -- pairs not working in FH v6 so use tblEnum code
coroutine.yield(tblAttr.path,attributes(tblAttr,"directory"))
local isOK = true
for _,strOmit in ipairs (arg) do
if tblAttr.path:match(strOmit) then -- Omit tree branch
isOK = false
break
end
end
if isOK then yieldtree(tblAttr.path) end
tblAttr = tblEnum:Next()
end
local tblEnum = luacom.GetEnumerator(tblList.Files)
local tblAttr = tblEnum:Next()
while tblAttr do -- for _,tblAttr in luacom.pairs(tblList.Files) do -- pairs not working in FH v6 so use tblEnum code
coroutine.yield(tblAttr.path,attributes(tblAttr,"file"))
tblAttr = tblEnum:Next()
end
end
return coroutine.wrap(function() yieldtree(strDir) end)
end -- function DirTree
-- Detect FH V5/6 old library modules and advise removal --
function fh.DetectOldModules()
if fhGetAppVersion() > 6 then
local strPath = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Plugins\\"
local arrFile = { "compat53.lua"; "ltn12.lua"; "luasql\\sqlite3.dll"; "md5.lua"; "pl\\init.lua"; "socket.lua"; "utf8.lua"; "zip.dll"; }
for _, strFile in ipairs (arrFile) do
if fh.FSO:FileExists(strPath..strFile) then
fhMessageBox("\n Detected some old FH V6 library modules. \n\nPlease remove them by running the plugin: \n\n 'Delete old FH6 Plugin Module Files' \n","MB_OK","MB_ICONEXCLAMATION")
break
end
end
end
end -- function DetectOldModules
if fhGetAppVersion() > 6 then unpack = table.unpack end
-- Invoke FH Shell Execute API --
function fh.DoExecute(strExecutable,...)
-- strExecutable ~ full path of executable
-- ... ~ parameter list and optional error reporting function
-- return value ~ true if successful else false
local arg = {...}
local errFunction = fhMessageBox
if type(arg[#arg]) == 'function' then
errFunction = arg[#arg]
table.remove(arg)
end
local isOK, intErrorCode, strErrorText = fhShellExecute(strExecutable,unpack(arg))
if not isOK then
errFunction(tostring(strErrorText).." ("..tostring(intErrorCode)..")")
end
return isOK
end -- function DoExecute
-- Obtain the Day Number for any Date Point -- -- Fix problems with invalid dates in DayNumber function
function fh.GetDayNumber(datDate)
-- datDate ~ date point
-- return value ~ day number
if datDate:IsNull() then return 0 end
local intDay = fhCallBuiltInFunction("DayNumber",datDate) -- Only works for Gregorian dates that were not skipped nor BC dates
if not intDay then
local strError = "because " -- Error message reason -- V3.0
local calendar = datDate:GetCalendar()
local oldMonth = datDate:GetMonth()
local oldDayNo = datDate:GetDay()
local intMonth = math.min( oldMonth, 12 ) -- Limit month to 12, and day to last of each month
local intDayNo = math.min( oldDayNo, ({0;31;28;31;30;31;30;31;31;30;31;30;31;})[intMonth+1] )
local intYear = datDate:GetYear()
if oldDayNo > intDayNo then strError = strError.."day "..oldDayNo.." too big " end
if oldMonth > intMonth then strError = strError.."month "..oldMonth.." too big " end
if calendar == "Hebrew" and intYear > 3761 then
intYear = intYear - 3761
strError = strError.."Hebrew year > 3761 "
elseif calendar ~= "Gregorian" then
strError = strError..calendar.." disallowed "
end
if intYear == 1752 and intMonth == 9 and intDayNo <= 13 then -- Use 2 Sep 1752 for 3 - 13 Sep 1752 dates skipped
intDayNo = 2
strError = strError.."3 - 13 Sep 1752 skipped "
elseif intYear == 1582 and intMonth == 10 and intDayNo <= 14 then -- Use 4 Oct 1582 for 5 - 14 Oct 1582 dates skipped
intDayNo = 4
strError = strError.."5 - 14 Oct 1582 skipped "
end
local setDate = fhNewDatePt(intYear,intMonth,intDayNo,datDate:GetYearDD())
intDay = fhCallBuiltInFunction("DayNumber",setDate) -- Remove BC and Julian, Hebrew, French calendars
if not intDay then intDay = 0 end
local oldDate = fhNewDate() oldDate:SetSimpleDate(datDate) -- Report problem to user
local newDate = fhNewDate() newDate:SetSimpleDate(setDate)
local strIsBC = ""
if datDate:GetBC() then
strError = strError.." B.C. disallowed "
intDay = -intDay
strIsBC = "and Day Number negated"
end
fhMessageBox("\n Get Day Number issue for date \n "..oldDate:GetDisplayText().." \n "..strError.." \n So replaced it with date \n "..newDate:GetDisplayText().." \n "..strIsBC,"MB_OK","MB_ICONEXCLAMATION")
end
return intDay
end -- function GetDayNumber
local dtpYearMin = fhNewDatePt(1000) -- Minimum year to use when earliest estimate is null
local dtpYearMax = fhNewDatePt(2000) -- Maximum year to use when latest estimate is null
function fh.GetYearToday() -- Get the Year for Today
-- return value ~ integer year today
local intYearToday = fhCallBuiltInFunction("Year",fhCallBuiltInFunction("Today"))
dtpYearMax = fhNewDatePt(intYearToday) -- Set maximum year date point
return intYearToday
end -- function GetYearToday()
local function getDeathFacts(ptrIndi) -- Iterate Death, Burial, Cremation facts
-- ptrIndi ~ pointer to individual
-- return value ~ pointer to fact
local arrFact = { "~.DEAT"; "~.BURI"; "~.CREM"; }
local intFact = 0
local ptrFact = fhNewItemPtr() -- Pointer to each fact returned to user
return function ()
while intFact < #arrFact do
intFact = intFact + 1
ptrFact = fhGetItemPtr(ptrIndi,arrFact[intFact])
if ptrFact:IsNotNull() then return ptrFact end
end
end
end -- local function getDeathFacts
-- Ensure Estimated Date EARLIEST <= LATEST <= Fact Date -- -- Fix errors in EstimatedBirth/DeathDate function
local function estimatedDates(strFunc,ptrIndi,intGens,getFact,intYrs)
-- strFunc ~ "EstimatedBirthDate" or "EstimatedDeathDate"
-- ptrIndi ~ Individual of interest
-- intGens ~ Number of generations (may be nil)
-- getFact ~ Iterator function for facts
-- intYrs ~ Years to add to After dates
-- return values ~ EARLIEST, MID, LATEST dates
intGens = intGens or 2
local dtpMin = fhCallBuiltInFunction(strFunc,ptrIndi,"EARLIEST",intGens)
local dtpMax = fhCallBuiltInFunction(strFunc,ptrIndi,"LATEST",intGens)
local dtpMid = fhNewDatePt()
if not ( dtpMin:IsNull() and dtpMax:IsNull() ) then -- Skip if both null
if dtpMax:IsNull() then dtpMax = dtpYearMax elseif dtpMin:IsNull() then dtpMin = dtpYearMin end
for ptrFact in getFact(ptrIndi) do
local datFact = fhGetValueAsDate(fhGetItemPtr(ptrFact,"~.DATE"))
if not datFact:IsNull() then -- Find 1st Fact Date
local dtpLast = datFact:GetDatePt1() -- Last date = DatePt1 for Simple, Range, and Before
local strType = datFact:GetSubtype() -- Between = DatePt2 and After = DatePt1 + intYrs
if strType == "Between" then dtpLast = datFact:GetDatePt2()
elseif strType == "After" then dtpLast = fhNewDatePt(dtpLast:GetYear()+intYrs,dtpLast:GetMonth(),dtpLast:GetDay()) end -- Compare only uses Year, Month, Day so omitted ,dtpLast:GetYearDD(),dtpLast:GetBC(),dtpLast:GetCalendar()
if dtpMax:Compare(dtpLast) > 0 then dtpMax = dtpLast end
if dtpMin:Compare(dtpMax) > 0 then dtpMin = dtpMax end
if strType ~= "After" then break end -- Now EARLIEST <= LATEST <= Last date
end
end
local intDays = ( fh.GetDayNumber(dtpMax) - fh.GetDayNumber(dtpMin) ) / 2
local intYear,remYear = math.modf( intDays / 365.2422 ) -- Offset year @ 365.2422 days per year, and remainder fraction
local intMnth = math.floor( ( remYear * 12 ) + 0.1 ) -- Offset month is remainder fraction of year * 12
dtpMid = fhCallBuiltInFunction("CalcDate",dtpMin,intYear,intMnth) -- Need approximate MID year & month
end
return { Min=dtpMin; Mid=dtpMid; Max=dtpMax; } -- Return EARLIEST, MID, LATEST dates
end -- local function estimatedDates
-- Make EstimatedBirthDate EARLIEST <= LATEST <= 1st Fact Date -- -- Fix errors in EstimatedBirthDate function
function fh.EstimatedBirthDates(ptrIndi,intGens)
-- ptrInd ~ pointer to individual
-- intGens ~ generations to include
-- return values ~ EARLIEST, MID, LATEST dates
return estimatedDates("EstimatedBirthDate",ptrIndi,intGens,iterate.Facts,10)
end -- function EstimatedBirthDates
-- Make EstimatedDeathDate EARLIEST <= LATEST <= DEAT/BURI/CREM Date -- -- Fix errors in EstimatedDeathDate function
function fh.EstimatedDeathDates(ptrIndi,intGens)
-- ptrInd ~ pointer to individual
-- intGens ~ generations to include
-- return values ~ EARLIEST, MID, LATEST dates
return estimatedDates("EstimatedDeathDate",ptrIndi,intGens,getDeathFacts,100)
end -- function EstimatedDeathDates
--[[
@function: BuildDataRef
@description: Get Full Data Reference for Pointer
@parameters: Item Pointer
@returns: Data Reference String, Record Id Integer, Record Type Tag String
@requires: None
]]
function fh.BuildDataRef(ptrRef)
local strDataRef = "" -- Data Reference with instance indices e.g. INDI.RESI[2].ADDR
local intRecId = 0 -- Record Id for associated Record
local strRecTag = "" -- Record Tag of associated Record type i.e. INDI, FAM, NOTE, SOUR, etc
-- getDataRef() is called recursively per level of the Data Ref
-- ptrRef points to the upper Data Ref levels yet to be analysed
-- strRef compiles the lower Data Ref levels including instances
local function getDataRef(ptrRef,strRef)
local ptrTag = ptrRef:Clone()
local strTag = fhGetTag(ptrTag) -- Current level Tag
ptrTag:MoveToParentItem(ptrTag)
if ptrTag:IsNotNull() then -- Parent level exists
local intSib = 1
local ptrSib = ptrRef:Clone() -- Pointer to siblings with same Tag
ptrSib:MovePrev("SAME_TAG")
while ptrSib:IsNotNull() do -- Count previous siblings with same Tag
intSib = intSib + 1
ptrSib:MovePrev("SAME_TAG")
end
if intSib > 1 then strTag = strTag.."["..intSib.."]" end
getDataRef(ptrTag,"."..strTag..strRef) -- Now analyse the parent level
else
strDataRef = strTag..strRef -- Record level reached, so set return values
intRecId = fhGetRecordId(ptrRef)
strRecTag = strTag
if not fhIsValidDataRef(strDataRef) then print("BuildDataRef: "..strDataRef.." is Invalid") end
end
end -- local function getDataRef
if type(ptrRef) == "userdata" then getDataRef(ptrRef,"") end
return strDataRef, intRecId, strRecTag
end -- function BuildDataRef
--[[
@function: GetDataRefPtr
@description: Get Pointer for Full Data Reference
@parameters: Data Reference String, Record Id Integer, Record Type Tag String (optional)
@returns: Item Pointer which IsNull() if any parameters are invalid
@requires: None
]]
function fh.GetDataRefPtr(strDataRef,intRecId,strRecTag)
strDataRef = strDataRef or ""
if not strRecTag then
strRecTag = strDataRef:gsub("^(%u+).*$","%1") -- Extract Record Tag from Data Ref
end
local ptrRef = fhNewItemPtr()
ptrRef:MoveToRecordById(strRecTag,intRecId or 0) -- Lookup the Record by Id
ptrRef:MoveTo(ptrRef,strDataRef) -- Move to the Data Ref
return ptrRef
end -- function GetDataRefPtr
function fh.TblDataRef(ptrRef)
local tblRef = {}
tblRef.DataRef, tblRef.RecId, tblRef.RecTag = BuildDataRef(ptrRef)
return tblRef
end -- function TblDataRef
function fh.PtrDataRef(tblRef)
local tblRef = tblRef or {} -- Ensure table and its fields exist
return GetDataRefPtr(tblRef.DataRef or "",tblRef.RecId or 0,tblRef.RecTag or "")
end -- function PtrDataRef
return fh
end -- local function general_v3
local general = general_v3() -- To access FH general tools module
--[[
@Module: +fh+tablex_v3
@Author: Mike Tate
@Version: 3.1
@LastUpdated: 08 Jan 2022
@Description: A Table Load Save Module.
@V3.1: Cater for full UTF-8 filenames.
@V3.0: Function Prototype Closure version.
@V1.2: Added local definitions of _ to ensure nil gets returned on error.
@V1.1: ?
@V1.0: Initial version 0.94 is Lua 5.1 compatible.
]]
local function tablex_v3()
local fh = {} -- Local environment table
------------------------------------------------------ Start Table Load Save
-- require "_tableloadsave"
--[[
Save Table to File/Stringtable
Load Table from File/Stringtable
v 0.94
Lua 5.1 compatible
Userdata and indices of these are not saved
Functions are saved via string.dump, so make sure it has no upvalues
References are saved
----------------------------------------------------
table.save( table [, filename] )
Saves a table so it can be called via the table.load function again
table must a object of type 'table'
filename is optional, and may be a string representing a filename or true/1
table.save( table )
on success: returns a string representing the table (stringtable)
(uses a string as buffer, ideal for smaller tables)
table.save( table, true or 1 )
on success: returns a string representing the table (stringtable)
(uses io.tmpfile() as buffer, ideal for bigger tables)
table.save( table, "filename" )
on success: returns 1
(saves the table to file "filename")
on failure: returns as second argument an error msg
----------------------------------------------------
table.load( filename or stringtable )
Loads a table that has been saved via the table.save function
on success: returns a previously saved table
on failure: returns as second argument an error msg
----------------------------------------------------
chillcode, http://lua-users.org/wiki/SaveTableToFile
Licensed under the same terms as Lua itself.
]]--
-- declare local variables
--// exportstring( string )
--// returns a "Lua" portable version of the string
local function exportstring( s )
s = string.format( "%q",s )
-- to replace
s = string.gsub( s,"\\\n","\\n" )
s = string.gsub( s,"\r","\\r" )
s = string.gsub( s,string.char(26),"\"..string.char(26)..\"" )
return s
end
--// The Save Function
function fh.save( tbl,filename )
local charS,charE = " ","\n"
local file,err,_,stransi,wasansi -- V1.2 -- V3.1 -- Added _,stransi,wasansi --!
-- create a pseudo file that writes to a string and return the string
if not filename then
file = { write = function( self,newstr ) self.str = self.str..newstr end, str = "" }
charS,charE = "",""
-- write table to tmpfile
elseif filename == true or filename == 1 then
charS,charE,file = "","",io.tmpfile()
-- write table to file
-- use io.open here rather than io.output, since in windows when clicking on a file opened with io.output will create an error
else
stransi,wasansi = general.FileNameToANSI(filename) -- V3.1 -- Cater for non-ANSI filename --!
file,err = io.open( stransi, "w" )
if err then return _,err end
end
-- initiate variables for save procedure
local tables,lookup = { tbl },{ [tbl] = 1 }
file:write( "return {"..charE )
for idx,t in ipairs( tables ) do
if filename and filename ~= true and filename ~= 1 then
file:write( "-- Table: {"..idx.."}"..charE )
end
file:write( "{"..charE )
local thandled = {}
for i,v in ipairs( t ) do
thandled[i] = true
-- escape functions and userdata
if type( v ) ~= "userdata" then
-- only handle value
if type( v ) == "table" then
if not lookup[v] then
table.insert( tables, v )
lookup[v] = #tables
end
file:write( charS.."{"..lookup[v].."},"..charE )
elseif type( v ) == "function" then
file:write( charS.."loadstring("..exportstring(string.dump( v )).."),"..charE )
else
local value = ( type( v ) == "string" and exportstring( v ) ) or tostring( v )
file:write( charS..value..","..charE )
end
end
end
for i,v in pairs( t ) do
-- escape functions and userdata
if (not thandled[i]) and type( v ) ~= "userdata" then
-- handle index
if type( i ) == "table" then
if not lookup[i] then
table.insert( tables,i )
lookup[i] = #tables
end
file:write( charS.."[{"..lookup[i].."}]=" )
else
local index = ( type( i ) == "string" and "["..exportstring( i ).."]" ) or string.format( "[%d]",i )
file:write( charS..index.."=" )
end
-- handle value
if type( v ) == "table" then
if not lookup[v] then
table.insert( tables,v )
lookup[v] = #tables
end
file:write( "{"..lookup[v].."},"..charE )
elseif type( v ) == "function" then
file:write( "loadstring("..exportstring(string.dump( v )).."),"..charE )
else
local value = ( type( v ) == "string" and exportstring( v ) ) or tostring( v )
file:write( value..","..charE )
end
end
end
file:write( "},"..charE )
end
file:write( "}" )
-- Return Values
-- return stringtable from string
if not filename then
-- set marker for stringtable
return file.str.."--|"
-- return stringttable from file
elseif filename == true or filename == 1 then
file:seek ( "set" )
-- no need to close file, it gets closed and removed automatically
-- set marker for stringtable
return file:read( "*a" ).."--|"
-- close file and return 1
else
file:close()
if not ( wasansi ) then -- V3.1 -- Cater for non-ANSI filename --!
general.MoveFile(stransi,filename)
end
return 1
end
end
--// The Load Function
function fh.load( sfile )
local tables,err,_ -- V1.2 -- Added _
-- catch marker for stringtable
if string.sub( sfile,-3,-1 ) == "--|" then
tables,err = loadstring( sfile )
else
local stransi,wasansi = general.FileNameToANSI(sfile) -- V3.1 -- Cater for non-ANSI filename --!
if not ( wasansi ) then
general.CopyFile(sfile,stransi)
end
tables,err = loadfile( stransi )
if not ( wasansi ) then
general.DeleteFile(stransi) -- V3.1 -- Cater for non-ANSI filename --!
end
end
if err then return _,err
end
tables = tables()
for idx = 1,#tables do
local tolinkv,tolinki = {},{}
for i,v in pairs( tables[idx] ) do
if type( v ) == "table" and tables[v[1]] then
table.insert( tolinkv,{ i,tables[v[1]] } )
end
if type( i ) == "table" and tables[i[1]] then
table.insert( tolinki,{ i,tables[i[1]] } )
end
end
-- link values, first due to possible changes of indices
for _,v in ipairs( tolinkv ) do
tables[idx][v[1]] = v[2]
end
-- link indices
for _,v in ipairs( tolinki ) do
tables[idx][v[2]],tables[idx][v[1]] = tables[idx][v[1]],nil
end
end
return tables[1]
end
------------------------------------------------------ End Table Load Save
-- overload fh functions into table
for strIndex, anyValue in pairs(fh) do
if type(anyValue) == "function" then
table[strIndex] = anyValue
end
end
return fh
end -- local function tablex_v3
local tablex = tablex_v3 () -- To access FH table extension module
--[[
@Module: +fh+encoder_v3
@Author: Mike Tate
@Version: 3.5
@LastUpdated: 25 Aug 2020
@Description: Text encoder module for HTML XHTML XML URI UTF8 UTF16 ISO CP1252/ANSI character codings.
@V3.5: Function Prototype Closure version with Lua 5.1 & 5.3 comaptibility.
@V3.4: Ensure expressions involving gsub return just text parameter.
@V3.3: Adds UNICODE U+10000 to U+10FFFF UTF-16 Supplementary Planes.
@V3.2: Update for ANSI & Unicode to ASCII for sorting, Soundex, etc.
@V3.1: Update for Unicode UTF-16 & UTF-8 and fhConvertANSItoUTF8 & fhConvertUTF8toANSI, name change UTF to UTF8 & CP to ANSI.
@V2.0: StrUTF8_Encode() replaced by StrUTF_CP1252() for entire UTF-8 range, plus new StrCP1252_ISO().
@V1.0: Initial version.
]]
local function encoder_v3()
local fh = {} -- Local environment table
local fhVersion = fhGetAppVersion()
local br_Tag = "
" -- Markup language break tag default
local br_Lua = "
" -- Lua pattern for break tag recognition
local tblCodePage = {} -- Code Page to XML/XHTML/HTML/URI/UTF8 encodings: http://en.wikipedia.org/wiki/Windows-1252 & 1250 & etc
-- Control characters "\000" to "\031" for URI & Markup "[%c]" encodings are disallowed except for "\t" to "\r"
tblCodePage["\000"] = "" -- NUL
tblCodePage["\001"] = "" -- SOH
tblCodePage["\002"] = "" -- STX
tblCodePage["\003"] = "" -- ETX
tblCodePage["\004"] = "" -- EOT
tblCodePage["\005"] = "" -- ENQ
tblCodePage["\006"] = "" -- ACK
tblCodePage["\a"] = "" -- BEL
tblCodePage["\b"] = "" -- BS
tblCodePage["\t"] = "+" -- HT space in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["\n"] = "%0A" -- LF br_Tag in Markup
tblCodePage["\v"] = "%0A" -- VT br_Tag in Markup
tblCodePage["\f"] = "%0A" -- FF br_Tag in Markup
tblCodePage["\r"] = "%0D" -- CR br_Tag in Markup
tblCodePage["\014"] = "" -- SO
tblCodePage["\015"] = "" -- SI
tblCodePage["\016"] = "" -- DLE
tblCodePage["\017"] = "" -- DC1
tblCodePage["\018"] = "" -- DC2
tblCodePage["\019"] = "" -- DC3
tblCodePage["\020"] = "" -- DC4
tblCodePage["\021"] = "" -- NAK
tblCodePage["\022"] = "" -- SYN
tblCodePage["\023"] = "" -- ETB
tblCodePage["\024"] = "" -- CAN
tblCodePage["\025"] = "" -- EM
tblCodePage["\026"] = "" -- SUB
tblCodePage["\027"] = "" -- ESC
tblCodePage["\028"] = "" -- FS
tblCodePage["\029"] = "" -- GS
tblCodePage["\030"] = "" -- RS
tblCodePage["\031"] = "" -- US
-- ASCII characters "\032" to "\127" for URI "[%s%p]" encodings: http://en.wikipedia.org/wiki/URL and http://en.wikipedia.org/wiki/Percent-encoding
tblCodePage[" "] = "+" -- or "%20" Space
tblCodePage["!"] = "%21" -- Reserved character
tblCodePage['"'] = "%22" -- """ in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["#"] = "%23" -- Reserved character
tblCodePage["$"] = "%24" -- Reserved character
tblCodePage["%"] = "%25" -- Must be encoded
tblCodePage["&"] = "%26" -- Reserved character -- "&" in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["'"] = "%27" -- Reserved character -- "'" in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["("] = "%28" -- Reserved character
tblCodePage[")"] = "%29" -- Reserved character
tblCodePage["*"] = "%2A" -- Reserved character
tblCodePage["+"] = "%2B" -- Reserved character
tblCodePage[","] = "%2C" -- Reserved character
-- tblCodePage["-"] = "%2D" -- Unreserved character not encoded
-- tblCodePage["."] = "%2E" -- Unreserved character not encoded
tblCodePage["/"] = "%2F" -- Reserved character
-- Digits 0 to 9 -- Unreserved characters not encoded
tblCodePage[":"] = "%3A" -- Reserved character
tblCodePage[";"] = "%3B" -- Reserved character
tblCodePage["<"] = "%3C" -- "<" in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["="] = "%3D" -- Reserved character
tblCodePage[">"] = "%3E" -- ">" in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["?"] = "%3F" -- Reserved character
tblCodePage["@"] = "%40" -- Reserved character
-- Letters A to Z -- Unreserved characters not encoded
tblCodePage["["] = "%5B" -- Reserved character
tblCodePage["\\"]= "%5C"
tblCodePage["]"] = "%5D" -- Reserved character
tblCodePage["^"] = "%5E"
-- tblCodePage["_"] = "%5F" -- Unreserved character not encoded
tblCodePage["`"] = "%60"
-- Letters a to z -- Unreserved characters not encoded
tblCodePage["{"] = "%7B"
tblCodePage["|"] = "%7C"
tblCodePage["}"] = "%7D"
-- tblCodePage["~"] = "%7E" -- Unreserved character not encoded
tblCodePage["\127"] = "" -- DEL
-- Code Page 1252 Unicode characters "\128" to "\255" for UTF-8 scheme "[€-ÿ]" encodings: http://en.wikipedia.org/wiki/UTF-8
tblCodePage["€"] = string.char(0xE2,0x82,0xAC) -- "€"
tblCodePage["\129"] = "" -- Undefined
tblCodePage["‚"] = string.char(0xE2,0x80,0x9A)
tblCodePage["ƒ"] = string.char(0xC6,0x92)
tblCodePage["„"] = string.char(0xE2,0x80,0x9E)
tblCodePage["…"] = string.char(0xE2,0x80,0xA6)
tblCodePage["†"] = string.char(0xE2,0x80,0xA0)
tblCodePage["‡"] = string.char(0xE2,0x80,0xA1)
tblCodePage["ˆ"] = string.char(0xCB,0x86)
tblCodePage["‰"] = string.char(0xE2,0x80,0xB0)
tblCodePage["Š"] = string.char(0xC5,0xA0)
tblCodePage["‹"] = string.char(0xE2,0x80,0xB9)
tblCodePage["Œ"] = string.char(0xC5,0x92)
tblCodePage["\141"] = "" -- Undefined
tblCodePage["Ž"] = string.char(0xC5,0xBD)
tblCodePage["\143"] = "" -- Undefined
tblCodePage["\144"] = "" -- Undefined
tblCodePage["‘"] = string.char(0xE2,0x80,0x98)
tblCodePage["’"] = string.char(0xE2,0x80,0x99)
tblCodePage["“"] = string.char(0xE2,0x80,0x9C)
tblCodePage["”"] = string.char(0xE2,0x80,0x9D)
tblCodePage["•"] = string.char(0xE2,0x80,0xA2)
tblCodePage["–"] = string.char(0xE2,0x80,0x93)
tblCodePage["—"] = string.char(0xE2,0x80,0x94)
tblCodePage["\152"] = string.char(0xCB,0x9C) -- Small Tilde
tblCodePage["™"] = string.char(0xE2,0x84,0xA2)
tblCodePage["š"] = string.char(0xC5,0xA1)
tblCodePage["›"] = string.char(0xE2,0x80,0xBA)
tblCodePage["œ"] = string.char(0xC5,0x93)
tblCodePage["\157"] = "" -- Undefined
tblCodePage["ž"] = string.char(0xC5,0xBE)
tblCodePage["Ÿ"] = string.char(0xC5,0xB8)
tblCodePage["\160"] = string.char(0xC2,0xA0) -- " " No Break Space
tblCodePage["¡"] = string.char(0xC2,0xA1) -- "¡"
tblCodePage["¢"] = string.char(0xC2,0xA2) -- "¢"
tblCodePage["£"] = string.char(0xC2,0xA3) -- "£"
tblCodePage["¤"] = string.char(0xC2,0xA4) -- "¤"
tblCodePage["¥"] = string.char(0xC2,0xA5) -- "¥"
tblCodePage["¦"] = string.char(0xC2,0xA6)
tblCodePage["§"] = string.char(0xC2,0xA7)
tblCodePage["¨"] = string.char(0xC2,0xA8)
tblCodePage["©"] = string.char(0xC2,0xA9)
tblCodePage["ª"] = string.char(0xC2,0xAA)
tblCodePage["«"] = string.char(0xC2,0xAB)
tblCodePage["¬"] = string.char(0xC2,0xAC)
tblCodePage[""] = string.char(0xC2,0xAD) -- "" Soft Hyphen
tblCodePage["®"] = string.char(0xC2,0xAE)
tblCodePage["¯"] = string.char(0xC2,0xAF)
tblCodePage["°"] = string.char(0xC2,0xB0)
tblCodePage["±"] = string.char(0xC2,0xB1)
tblCodePage["²"] = string.char(0xC2,0xB2)
tblCodePage["³"] = string.char(0xC2,0xB3)
tblCodePage["´"] = string.char(0xC2,0xB4)
tblCodePage["µ"] = string.char(0xC2,0xB5)
tblCodePage["¶"] = string.char(0xC2,0xB6)
tblCodePage["·"] = string.char(0xC2,0xB7)
tblCodePage["¸"] = string.char(0xC2,0xB8)
tblCodePage["¹"] = string.char(0xC2,0xB9)
tblCodePage["º"] = string.char(0xC2,0xBA)
tblCodePage["»"] = string.char(0xC2,0xBB)
tblCodePage["¼"] = string.char(0xC2,0xBC)
tblCodePage["½"] = string.char(0xC2,0xBD)
tblCodePage["¾"] = string.char(0xC2,0xBE)
tblCodePage["¿"] = string.char(0xC2,0xBF)
tblCodePage["À"] = string.char(0xC3,0x80)
tblCodePage["Á"] = string.char(0xC3,0x81)
tblCodePage["Â"] = string.char(0xC3,0x82)
tblCodePage["Ã"] = string.char(0xC3,0x83)
tblCodePage["Ä"] = string.char(0xC3,0x84)
tblCodePage["Å"] = string.char(0xC3,0x85)
tblCodePage["Æ"] = string.char(0xC3,0x86)
tblCodePage["Ç"] = string.char(0xC3,0x87)
tblCodePage["È"] = string.char(0xC3,0x88)
tblCodePage["É"] = string.char(0xC3,0x89)
tblCodePage["Ê"] = string.char(0xC3,0x8A)
tblCodePage["Ë"] = string.char(0xC3,0x8B)
tblCodePage["Ì"] = string.char(0xC3,0x8C)
tblCodePage["Í"] = string.char(0xC3,0x8D)
tblCodePage["Î"] = string.char(0xC3,0x8E)
tblCodePage["Ï"] = string.char(0xC3,0x8F)
tblCodePage["Ð"] = string.char(0xC3,0x90)
tblCodePage["Ñ"] = string.char(0xC3,0x91)
tblCodePage["Ò"] = string.char(0xC3,0x92)
tblCodePage["Ó"] = string.char(0xC3,0x93)
tblCodePage["Ô"] = string.char(0xC3,0x94)
tblCodePage["Õ"] = string.char(0xC3,0x95)
tblCodePage["Ö"] = string.char(0xC3,0x96)
tblCodePage["×"] = string.char(0xC3,0x97)
tblCodePage["Ø"] = string.char(0xC3,0x98)
tblCodePage["Ù"] = string.char(0xC3,0x99)
tblCodePage["Ú"] = string.char(0xC3,0x9A)
tblCodePage["Û"] = string.char(0xC3,0x9B)
tblCodePage["Ü"] = string.char(0xC3,0x9C)
tblCodePage["Ý"] = string.char(0xC3,0x9D)
tblCodePage["Þ"] = string.char(0xC3,0x9E)
tblCodePage["ß"] = string.char(0xC3,0x9F)
tblCodePage["à"] = string.char(0xC3,0xA0)
tblCodePage["á"] = string.char(0xC3,0xA1)
tblCodePage["â"] = string.char(0xC3,0xA2)
tblCodePage["ã"] = string.char(0xC3,0xA3)
tblCodePage["ä"] = string.char(0xC3,0xA4)
tblCodePage["å"] = string.char(0xC3,0xA5)
tblCodePage["æ"] = string.char(0xC3,0xA6)
tblCodePage["ç"] = string.char(0xC3,0xA7)
tblCodePage["è"] = string.char(0xC3,0xA8)
tblCodePage["é"] = string.char(0xC3,0xA9)
tblCodePage["ê"] = string.char(0xC3,0xAA)
tblCodePage["ë"] = string.char(0xC3,0xAB)
tblCodePage["ì"] = string.char(0xC3,0xAC)
tblCodePage["í"] = string.char(0xC3,0xAD)
tblCodePage["î"] = string.char(0xC3,0xAE)
tblCodePage["ï"] = string.char(0xC3,0xAF)
tblCodePage["ð"] = string.char(0xC3,0xB0)
tblCodePage["ñ"] = string.char(0xC3,0xB1)
tblCodePage["ò"] = string.char(0xC3,0xB2)
tblCodePage["ó"] = string.char(0xC3,0xB3)
tblCodePage["ô"] = string.char(0xC3,0xB4)
tblCodePage["õ"] = string.char(0xC3,0xB5)
tblCodePage["ö"] = string.char(0xC3,0xB6)
tblCodePage["÷"] = string.char(0xC3,0xB7)
tblCodePage["ø"] = string.char(0xC3,0xB8)
tblCodePage["ù"] = string.char(0xC3,0xB9)
tblCodePage["ú"] = string.char(0xC3,0xBA)
tblCodePage["û"] = string.char(0xC3,0xBB)
tblCodePage["ü"] = string.char(0xC3,0xBC)
tblCodePage["ý"] = string.char(0xC3,0xBD)
tblCodePage["þ"] = string.char(0xC3,0xBE)
tblCodePage["ÿ"] = string.char(0xC3,0xBF)
-- Set XML/XHTML/HTML "[%c\"&'<>]" Markup encodings: http://en.wikipedia.org/wiki/XML and http://en.wikipedia.org/wiki/HTML
local function setMarkupEncodings()
tblCodePage["\t"] = " " -- HT "\t" to "\r" are treated as white space in Markup Languages by default
tblCodePage["\n"] = br_Tag -- LF
tblCodePage["\v"] = br_Tag -- VT line break tag "
" or "
" or "
" or "
" is better
tblCodePage["\f"] = br_Tag -- FF
tblCodePage["\r"] = br_Tag -- CR
tblCodePage['"'] = """
tblCodePage["&"] = "&"
tblCodePage["'"] = "'"
tblCodePage["<"] = "<"
tblCodePage[">"] = ">"
end -- local function setMarkupEncodings
-- Set URI/URL/URN "[%s%p]" encodings: http://en.wikipedia.org/wiki/URL and http://en.wikipedia.org/wiki/Percent-encoding
local function setURIEncodings()
tblCodePage["\t"] = "+" -- HT space
tblCodePage["\n"] = "%0A" -- LF newline
tblCodePage["\v"] = "%0A" -- VT newline
tblCodePage["\f"] = "%0A" -- FF newline
tblCodePage["\r"] = "%0D" -- CR return
tblCodePage['"'] = "%22"
tblCodePage["&"] = "%26"
tblCodePage["'"] = "%27"
tblCodePage["<"] = "%3C"
tblCodePage[">"] = "%3E"
end -- local function setURIEncodings
-- Encode characters according to gsub pattern & lookup table --
local function strEncode(strText,strPattern,tblPattern)
return ( (strText or ""):gsub(strPattern,tblPattern) ) -- V3.4
end -- local function strEncode
-- Encode CP1252/ANSI characters into UTF-8 codes --
function fh.StrANSI_UTF8(strText)
if fhVersion > 5 then
strText = fhConvertANSItoUTF8(strText)
else
strText = strEncode(strText,"[\127-ÿ]",tblCodePage)
end
return strText
end -- function StrANSI_UTF8
function fh.StrCP_UTF(strText) -- Legacy
return fh.StrANSI_UTF8(strText)
end -- function StrCP1252_UTF8
function fh.StrCP1252_UTF(strText) -- Legacy
return fh.StrANSI_UTF8(strText)
end -- function StrCP1252_UTF
-- Encode CP1252/ANSI or UTF-8 characters into UTF-8 --
function fh.StrEncode_UTF8(strText)
if stringx.encoding() == "ANSI" then
return fh.StrANSI_UTF8(strText)
else
return strText
end
end -- function StrEncode_UTF8
-- Encode CP1252/ANSI characters into XML/XHTML/HTML/UTF8 codes --
local strANSI_XML = "[%z\001-\031\"&'<>\127-ÿ]"
if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0
strANSI_XML = "[\000-\031\"&'<>\127-ÿ]"
end
function fh.StrANSI_XML(strText)
setMarkupEncodings()
strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes br_Tag
strText = strEncode(strText,strANSI_XML,tblCodePage)
return strText
end -- function StrANSI_XML
function StrCP_XML(strText) -- Legacy
return fh.StrANSI_XML(strText)
end -- function StrCP_XML
function StrCP1252_XML(strText) -- Legacy
return fh.StrANSI_XML(strText)
end -- function StrCP1252_XML
-- Encode UTF-8 ASCII characters into XML/XHTML/HTML codes --
local strUTF8_XML = "[%z\001-\031\"&'<>\127]"
if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0
strUTF8_XML = "[\000-\031\"&'<>\127]"
end
function fh.StrUTF8_XML(strText)
setMarkupEncodings()
strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes br_Tag
strText = strEncode(strText,strUTF8_XML,tblCodePage)
return strText
end -- function StrUTF8_XML
-- Encode CP1252/ANSI or UTF-8 ASCII characters into XML/XHTML/HTML codes --
function fh.StrEncode_XML(strText)
if stringx.encoding() == "ANSI" then
return fh.StrANSI_XML(strText)
else
return fh.StrUTF8_XML(strText)
end
end -- function StrEncode_XML
-- Encode Item Text characters into XML/HTML/UTF-8 codes --
function fh.StrGetItem_XML(ptrItem,strTags)
return fh.StrEncode_XML(fhGetItemText(ptrItem,strTags))
end -- function StrGetItem_XML
-- Encode CP1252/ANSI characters into URI codes --
function fh.StrANSI_URI(strText)
setURIEncodings()
strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes %0A
strText = strEncode(strText,"[^0-9A-Za-z]",tblCodePage)
return strText
end -- function StrANSI_URI
function fh.StrCP_URI(strText)
return fh.StrANSI_URI(strText)
end -- function StrCP_URI
function fh.StrCP1252_URI(strText)
return fh.StrANSI_URI(strText)
end -- function StrCP1252_URI
-- Encode UTF-8 ASCII characters into URI codes --
local strUTF8_URI = "[%z\001-\127]"
if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0
strUTF8_URI = "[\000-\127]"
end
function fh.StrUTF8_URI(strText)
setURIEncodings()
strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes br_Tag
strText = strEncode(strText,strUTF8_URI,tblCodePage)
return strText
end -- function StrUTF8_URI
-- Encode CP1252/ANSI or UTF-8 ASCII characters into URI codes --
function fh.StrEncode_URI(strText)
if stringx.encoding() == "ANSI" then
return fh.StrANSI_URI(strText)
else
return fh.StrUTF8_URI(strText)
end
end -- function StrEncode_URI
function fh.StrUTF8_Encode(strText) -- Legacy from V1.0
return fh.StrUTF8_ANSI(strText)
end -- function StrUTF8_Encode
-- Encode UTF-8 bytes into single CP1252/ANSI character V2.0 upvalues --
local strByteRange = "["..string.char(0xC0).."-"..string.char(0xFF).."]"
local tblBytePoint = {0xC0;0xE0;0xF0;0xF8;0xFC;} -- Byte codes for 2-byte, 3-byte, 4-byte, 5-byte, 6-byte UTF-8
local tblUTF8 = {}
for strByte = string.byte("€"), string.byte("ÿ") do
local strChar = string.char(strByte) -- Use CodePage to UTF-8 table to populate UTF-8 to CodePage table
local strCode = tblCodePage[strChar]
tblUTF8[strCode] = strChar
end
-- Encode UTF-8 bytes into single CP1252/ANSI character --
function fh.StrUTF8_ANSI(strText)
strText = strText or ""
if fhVersion > 5 then return fhConvertUTF8toANSI(strText) end
if strText:match(strByteRange) then -- If text contains characters that need translating then
local intChar = 0 -- Input character index
local strChar = "" -- Current character
local strCode = "" -- UTF-8 multi-byte code
local tblLine = {} -- Translated output line
repeat
intChar = intChar + 1 -- Step through each character in text
strChar = strText:sub(intChar,intChar)
if strChar:match(strByteRange) then -- Convert UTF-8 bytes into CP character
strCode = strChar -- First UTF-8 byte code, whose top bits say how many bytes to append
for intByte, strByte in ipairs(tblBytePoint) do
if string.byte(strChar) >= strByte then
intChar = intChar + 1 -- Append next UTF-8 byte code character
strCode = strCode..strText:sub(intChar,intChar)
else
break
end
end
strChar = tblUTF8[strCode] or "¿" -- Translate UTF-8 code into CP character
end
table.insert(tblLine,strChar) -- Accumulate output char by char
until intChar >= #strText
strText = table.concat(tblLine)
end
return strText
end -- function StrUTF8_ANSI
function fh.StrUTF_CP(strText) -- Legacy
return fh.StrUTF8_ANSI(strText)
end -- function StrUTF_CP
function fh.StrUTF_CP1252(strText) -- Legacy
return fh.StrUTF8_ANSI(strText)
end -- function StrUTF_CP1252
-- Encode CP1252/ANSI or UTF-8 characters into ANSI --
function fh.StrEncode_ANSI(strText)
if stringx.encoding() == "ANSI" then
return strText or ""
else
return fh.StrUTF8_ANSI(strText)
end
end -- function StrEncode_ANSI
-- Set ISO-8859-1 "[\127-Ÿ]" encodings: http://en.wikipedia.org/wiki/ISO/IEC_8859-1
local tblISO8859 = { }
tblISO8859["\127"]="" -- DEL
tblISO8859["€"] = "EUR"
tblISO8859["\129"]="" -- Undefined
tblISO8859["‚"] = "¸"
tblISO8859["ƒ"] = "f"
tblISO8859["„"] = "¸¸"
tblISO8859["…"] = "..."
tblISO8859["†"] = "+"
tblISO8859["‡"] = "±"
tblISO8859["ˆ"] = "^"
tblISO8859["‰"] = "%"
tblISO8859["Š"] = "S"
tblISO8859["‹"] = "<"
tblISO8859["Œ"] = "OE"
tblISO8859["\141"]="" -- Undefined
tblISO8859["Ž"] = "Z"
tblISO8859["\143"]="" -- Undefined
tblISO8859["\144"]="" -- Undefined
tblISO8859["‘"] = "'"
tblISO8859["’"] = "'"
tblISO8859["“"] = '"'
tblISO8859["”"] = '"'
tblISO8859["•"] = "º"
tblISO8859["–"] = "-"
tblISO8859["—"] = "-"
tblISO8859["\152"]="~" -- Small Tilde
tblISO8859["™"] = "TM"
tblISO8859["š"] = "s"
tblISO8859["›"] = ">"
tblISO8859["œ"] = "oe"
tblISO8859["\157"]="" -- Undefined
tblISO8859["ž"] = "z"
tblISO8859["Ÿ"] = "Y"
-- Encode CP1252/ANSI characters into ISO-8859-1 codes --
function fh.StrANSI_ISO(strText)
return strEncode(strText,"[\127-Ÿ]",tblISO8859)
end -- function StrANSI_ISO
function fh.StrCP_ISO(strText) -- Legacy
return fh.StrANSI_ISO(strText)
end -- function StrCP_ISO
function fh.StrCP1252_ISO(strText) -- Legacy
return fh.StrANSI_ISO(strText)
end -- function StrCP1252_ISO
function fh.StrUTF8_ISO(strText)
return fh.StrANSI_ISO(fh.StrUTF8_ANSI(strText))
end -- function StrUTF8_ISO
-- Encode CP1252/ANSI or UTF-8 ASCII characters into ISO-8859-1 codes --
function fh.StrEncode_ISO(strText)
if stringx.encoding() == "ANSI" then
return fh.StrANSI_ISO(strText)
else
return fh.StrUTF8_ISO(strText)
end
end -- function StrEncode_ISO
-- Convert UTF-8 bytes to a UTF-16 word or pair --
local tblByte = {}
local tblLead = { 0x80; 0xC0; 0xE0; 0xF0; 0xF8; 0xFC; }
function fh.StrUtf8toUtf16(strChar)
-- Convert any UTF-8 multibytes to UTF-16 --
local function strUtf8()
if #tblByte > 0 then
local intUtf16 = 0
for intIndex, intByte in ipairs (tblByte) do -- Convert UTF-8 bytes to UNICODE U+0080 to U+10FFFF
if intIndex == 1 then
intUtf16 = intByte - tblLead[#tblByte]
else
intUtf16 = intUtf16 * 0x40 + intByte - 0x80
end
end
if intUtf16 > 0xFFFF then -- U+10000 to U+10FFFF Supplementary Planes -- V2.6
tblByte = {}
intUtf16 = intUtf16 - 0x10000
local intLow10 = 0xDC00 + ( intUtf16 % 0x400 ) -- Low 16-bit Surrogate
local intTop10 = 0xD800 + math.floor( intUtf16 / 0x400 ) -- High 16-bit Surrogate
local intChar1 = intTop10 % 0x100
local intChar2 = math.floor( intTop10 / 0x100 )
local intChar3 = intLow10 % 0x100
local intChar4 = math.floor( intLow10 / 0x100 )
return string.char(intChar1,intChar2,intChar3,intChar4) -- Surrogate 16-bit Pair
end
if intUtf16 < 0xD800 -- U+0080 to U+FFFF (except U+D800 to U+DFFF) -- V2.6
or intUtf16 > 0xDFFF then -- Basic Multilingual Plane
tblByte = {}
local intChar1 = intUtf16 % 0x100
local intChar2 = math.floor( intUtf16 / 0x100 )
return string.char(intChar1,intChar2) -- BPL 16-bit
end
local strUtf8 = "" -- U+D800 to U+DFFF Reserved Code Points -- V2.6
for intIndex, intByte in ipairs (tblByte) do
strUtf8 = strUtf8..string.format("%.2X ",intByte)
end
local strUtf16 = string.format("%.4X ",intUtf16)
fhMessageBox("\n UTF-16 Reserved Code Point U+D800 to U+DFFF \n UTF-16 = "..strUtf16.." UTF-8 = "..strUtf8.."\n Character will be replaced by a question mark. \n","MB_OK","MB_ICONEXCLAMATION")
tblByte = {}
return "?\0"
end
return ""
end -- local function strUtf8
local intUtf8 = string.byte(strChar)
if intUtf8 < 0x80 then -- U+0000 to U+007F (ASCII)
return strUtf8()..strChar.."\0" -- Previous UTF-8 multibytes + current ASCII char
end
if intUtf8 >= 0xC0 then -- Next UTF-8 multibyte start
local strUtf16 = strUtf8()
table.insert(tblByte,intUtf8)
return strUtf16 -- Previous UTF-8 multibytes
end
table.insert(tblByte,intUtf8)
return ""
end -- function StrUtf8toUtf16
-- Encode UTF-8 bytes into UTF-16 words --
function fh.StrUTF8_UTF16(strText)
tblByte = {} -- (0xFF) flushes last UTF-8 character
return ( ((strText or "")..string.char(0xFF)):gsub("(.)",fh.StrUtf8toUtf16) ) -- V3.4
end -- function StrUTF8_UTF16
-- Encode CP1252/ANSI or UTF-8 characters into UTF-16 words --
function fh.StrEncode_UTF16(strText)
if stringx.encoding() == "ANSI" then
strText = fh.StrANSI_UTF8(strText)
end
return fh.StrUTF8_UTF16(strText)
end -- function StrEncode_UTF16
local intTop10 = 0
-- Convert a UTF-16 word or pair to UTF-8 bytes --
function fh.StrUtf16toUtf8(strChar1,strChar2)
local intUtf16 = string.byte(strChar2) * 0x100 + string.byte(strChar1)
if intUtf16 < 0x80 then -- U+0000 to U+007F (ASCII)
return string.char(intUtf16)
end
if intUtf16 < 0x800 then -- U+0080 to U+07FF
local intByte1 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte2 = intUtf16
return string.char( intByte2 + 0xC0, intByte1 + 0x80 )
end
if intUtf16 < 0xD800 -- U+0800 to U+FFFF
or intUtf16 > 0xDFFF then
local intByte1 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte2 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte3 = intUtf16
return string.char( intByte3 + 0xE0, intByte2 + 0x80, intByte1 + 0x80 )
end
if intUtf16 < 0xDC00 then -- U+10000 to U+10FFFF High 16-bit Surrogate Supplementary Planes -- V2.6
intTop10 = ( intUtf16 - 0xD800 ) * 0x400 + 0x10000
return ""
end
intUtf16 = intUtf16 - 0xDC00 + intTop10 -- U+10000 to U+10FFFF Low 16-bit Surrogate Supplementary Planes -- V2.6
local intByte1 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte2 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte3 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte4 = intUtf16
return string.char( intByte4 + 0xF0, intByte3 + 0x80, intByte2 + 0x80, intByte1 + 0x80 )
end -- function StrUtf16toUtf8
-- Encode UTF-16 words into UTF-8 bytes --
function fh.StrUTF16_UTF8(strText)
return ( (strText or ""):gsub("(.)(.)",fh.StrUtf16toUtf8) ) -- V3.4
end -- function StrUTF16_UTF8
-- Encode UTF-16 words into ANSI characters --
function fh.StrUTF16_ANSI(strText)
return fh.StrUTF8_ANSI(fh.StrUTF16_UTF8(strText))
end -- function StrUTF16_ANSI
-- Read UTF-16/UTF-8/ANSI file converted to chosen encoding via line iterator --
local strUtf16 = "^.%z"
if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0
strUtf16 = "^.\0"
end
function fh.FileLines(strFileName,strEncoding) -- Derived from http://lua-users.org/wiki/EnhancedFileLines
local bomUtf16= "^"..string.char(0xFF,0xFE) -- "ÿþ"
local bomUtf8 = "^"..string.char(0xEF,0xBB,0xBF) -- ""
local fncConv = tostring -- Function to convert input to current encoding
local intHead = 1 -- Index to start of current text line
local intLump = 1024
local fHandle = general.OpenFile(strFileName,"rb")
local strText = fHandle:read(1024) -- Read first lump from file
local intBOM = 0
strEncoding = strEncoding or string.encoding()
if strText:match(bomUtf16)
or strText:match(strUtf16) then
strText,intBOM = strText:gsub(bomUtf16,"") -- Strip UTF-16 BOM
if strEncoding == "ANSI" then -- Define UTF-16 conversion to current encoding
fncConv = fh.StrUTF16_ANSI
else
fncConv = fh.StrUTF16_UTF8
end
elseif strText:match(bomUtf8) then
strText,intBOM = strText:gsub(bomUtf8,"") -- Strip UTF-8 BOM
if strEncoding == "ANSI" then -- Define UTF-8 conversion to current encoding
fncConv = fh.StrUTF8_ANSI
end
else
if strEncoding == "UTF-8" then -- Define ANSI conversion to current encoding
fncConv = fh.StrANSI_UTF8
end
end
strText = fncConv(strText) -- Convert first lump of text
return function() -- Iterator function
local intTail,strTail -- Index to end of current text line, and terminating characters
while true do
intTail, strTail = strText:match("()([\r\n].)",intHead)
if intTail or not fHandle then
if intHead > 1 then intLump = 0 end
break -- End of line or end of file
elseif fHandle then
local strLump = fHandle:read(1024) -- Read next lump from file
if strLump then -- Strip old text and add converted lump
strText = strText:sub(intHead)..fncConv(strLump)
intHead = 1
intLump = 1024
else
assert(fHandle:close()) -- End of file
fHandle = nil
end
end
end
if not intTail then
intTail = #strText -- Last fragment of file
elseif strTail == "\r\n" then
intTail = intTail + 1 -- Adjust tail for both \r & \n
end
local strLine = strText:sub(intHead,intTail) -- Extract line from text
intHead = intTail + 1
if #strLine > 0 then -- Return pruned line, tail chars, lump bytes read
local strBody, strTail = strLine:match("^(.-)([\r\n]+)$")
return strBody, strTail, intLump
end
end
end -- function FileLines
-- Set "[€-ÿ]" ASCII encodings same as Unidecode below
local tblASCII = { }
tblASCII["€"] = "=E"
tblASCII["\129"]="" -- Undefined
tblASCII["‚"] = ","
tblASCII["ƒ"] = "f"
tblASCII["„"] = ",,"
tblASCII["…"] = "..."
tblASCII["†"] = "|+"
tblASCII["‡"] = "|++"
tblASCII["ˆ"] = "^"
tblASCII["‰"] = "%0"
tblASCII["Š"] = "S"
tblASCII["‹"] = "<"
tblASCII["Œ"] = "OE"
tblASCII["\141"]="" -- Undefined
tblASCII["Ž"] = "Z"
tblASCII["\143"]="" -- Undefined
tblASCII["\144"]="" -- Undefined
tblASCII["‘"] = "'"
tblASCII["’"] = "'"
tblASCII["“"] = "\""
tblASCII["”"] = "\""
tblASCII["•"] = "*"
tblASCII["–"] = "-"
tblASCII["—"] = "--"
tblASCII["\152"]="~" -- Small Tilde
tblASCII["™"] = "TM"
tblASCII["š"] = "s"
tblASCII["›"] = ">"
tblASCII["œ"] = "oe"
tblASCII["\157"]="" -- Undefined
tblASCII["ž"] = "z"
tblASCII["Ÿ"] = "Y"
tblASCII["\160"]=" " -- " " No Break Space
tblASCII["¡"] = "!" -- "¡"
tblASCII["¢"] = "=c" -- "¢"
tblASCII["£"] = "=L" -- "£"
tblASCII["¤"] = "=$" -- "¤"
tblASCII["¥"] = "=Y" -- "¥"
tblASCII["¦"] = "|"
tblASCII["§"] = "=SS"
tblASCII["¨"] = "\""
tblASCII["©"] = "(C)"
tblASCII["ª"] = "a"
tblASCII["«"] = "<<"
tblASCII["¬"] = "-"
tblASCII[""] = "-" -- "" Soft Hyphen
tblASCII["®"] = "(R)"
tblASCII["¯"] = "-"
tblASCII["°"] = "=o"
tblASCII["±"] = "+-"
tblASCII["²"] = "2"
tblASCII["³"] = "3"
tblASCII["´"] = "'"
tblASCII["µ"] = "=u"
tblASCII["¶"] = "=p"
tblASCII["·"] = "*"
tblASCII["¸"] = ","
tblASCII["¹"] = "1"
tblASCII["º"] = "o"
tblASCII["»"] = ">>"
tblASCII["¼"] = "1/4"
tblASCII["½"] = "1/2"
tblASCII["¾"] = "3/4"
tblASCII["¿"] = "?"
tblASCII["À"] = "A"
tblASCII["Á"] = "A"
tblASCII["Â"] = "A"
tblASCII["Ã"] = "A"
tblASCII["Ä"] = "A"
tblASCII["Å"] = "A"
tblASCII["Æ"] = "AE"
tblASCII["Ç"] = "C"
tblASCII["È"] = "E"
tblASCII["É"] = "E"
tblASCII["Ê"] = "E"
tblASCII["Ë"] = "E"
tblASCII["Ì"] = "I"
tblASCII["Í"] = "I"
tblASCII["Î"] = "I"
tblASCII["Ï"] = "I"
tblASCII["Ð"] = "D"
tblASCII["Ñ"] = "N"
tblASCII["Ò"] = "O"
tblASCII["Ó"] = "O"
tblASCII["Ô"] = "O"
tblASCII["Õ"] = "O"
tblASCII["Ö"] = "O"
tblASCII["×"] = "*"
tblASCII["Ø"] = "O"
tblASCII["Ù"] = "U"
tblASCII["Ú"] = "U"
tblASCII["Û"] = "U"
tblASCII["Ü"] = "U"
tblASCII["Ý"] = "Y"
tblASCII["Þ"] = "TH"
tblASCII["ß"] = "ss"
tblASCII["à"] = "a"
tblASCII["á"] = "a"
tblASCII["â"] = "a"
tblASCII["ã"] = "a"
tblASCII["ä"] = "a"
tblASCII["å"] = "a"
tblASCII["æ"] = "ae"
tblASCII["ç"] = "c"
tblASCII["è"] = "e"
tblASCII["é"] = "e"
tblASCII["ê"] = "e"
tblASCII["ë"] = "e"
tblASCII["ì"] = "i"
tblASCII["í"] = "i"
tblASCII["î"] = "i"
tblASCII["ï"] = "i"
tblASCII["ð"] = "d"
tblASCII["ñ"] = "n"
tblASCII["ò"] = "o"
tblASCII["ó"] = "o"
tblASCII["ô"] = "o"
tblASCII["õ"] = "o"
tblASCII["ö"] = "o"
tblASCII["÷"] = "/"
tblASCII["ø"] = "o"
tblASCII["ù"] = "u"
tblASCII["ú"] = "u"
tblASCII["û"] = "u"
tblASCII["ü"] = "u"
tblASCII["ý"] = "y"
tblASCII["þ"] = "th"
tblASCII["ÿ"] = "y"
-- Encode CP1252/ANSI characters into ASCII codes [\000-\127] --
function fh.StrANSI_ASCII(strText)
return strEncode(strText,"[€-ÿ]",tblASCII)
end -- function StrANSI_ASCII
--[=[
Unidecode converts each codepoint into a few ASCII characters.
Lookup table indexed by codepoint [0x0000]-[0xFFFF] gives an ASCII string.
i.e. strASCII = Unidecode[intByte2][intByte1] or "=?" allowing for partially populated table.
See http://search.cpan.org/dist/Text-Unidecode/ and follow Browse to:
See http://cpansearch.perl.org/src/SBURKE/Text-Unidecode-1.22/lib/Text/Unidecode/
where each x??.pm gives 256 ASCII conversions.
Start with the first few European accented characters, and add the others later.
--]=]
local Unidecode = { }
function fh.StrUnidecode(strChar1,strChar2) -- Decode UTF-16 byte pair into ASCII characters
return Unidecode[string.byte(strChar2)][string.byte(strChar1)] or "=?"
end -- function StrUnidecode
-- Encode UTF-8 characters into ASCII codes [\000-\126] --
function fh.StrUTF8_ASCII(strText)
strText = fh.StrUTF8_UTF16(strText) -- Convert to UTF-16 Unicode and then to ASCII
return ( strText:gsub("(.)(.)",fh.StrUnidecode) )
end -- function StrUTF8_ASCII
-- Encode CP1252/ANSI or UTF-8 into ASCII codes [\000-\126] --
function fh.StrEncode_ASCII(strText)
if stringx.encoding() == "ANSI" then
return fh.StrANSI_ASCII(strText)
else
return fh.StrUTF8_ASCII(strText)
end
end -- function StrEncode_ASCII
-- Set markup language break tag --
function fh.SetBreakTag(br_New)
if not (br_New or ""):match(br_Lua) then -- Ensure new break tag is "
" or "
" or "
" or "
"
br_New = "
"
end
br_Tag = br_New
end -- function SetBreakTag
for intByte = 0x00, 0xFF do Unidecode[intByte] = { } end
Unidecode[0x00] =
{[0]="\00";"\01";"\02";"\03";"\04";"\05";"\06";"\a";"\b";"\t";"\n";"\v";"\f";"\r";"\14";"\15";"\16";"\17";"\18";"\19";"\20";"\21";"\22";"\23";"\24";"\25";"\26";"\27";"\28";"\29";"\30";"\31";
" ";"!";'"';"#";"$";"%";"&";"'";"(";")";"*";"+";",";"-";".";"/";"0";"1";"2";"3";"4";"5";"6";"7";"8";"9";":";";";"<";"=";">";"?"; -- 0x20 to 0x3F
"@";"A";"B";"C";"D";"E";"F";"G";"H";"I";"J";"K";"L";"M";"N";"O";"P";"Q";"R";"S";"T";"U";"V";"W";"X";"Y";"Z";"[";"\\";"]";"^";"_"; -- 0x40 to 0x5F
"`";"a";"b";"c";"d";"e";"f";"g";"h";"i";"j";"k";"l";"m";"n";"o";"p";"q";"r";"s";"t";"u";"v";"w";"x";"y";"z";"{";"|";"}";"~";"\127"; -- 0x60 to 0x7F
""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; -- 0x80 to 0x9F
" ";"!";"=c";"=L";"=$";"=Y";"|";"=SS";'"';"(C)";"a";"<<";"-";"-";"(R)";"-";"=o";"+-";"2";"3";"'";"=u";"=P";"*";",";"1";"o";">>";"1/4";"1/2";"3/4";"?"; -- 0xA0 to 0xBF
"A";"A";"A";"A";"A";"A";"AE";"C";"E";"E";"E";"E";"I";"I";"I";"I";"D";"N";"O";"O";"O";"O";"O";"*";"O";"U";"U";"U";"U";"Y";"TH";"ss"; -- 0xC0 to 0xDF
"a";"a";"a";"a";"a";"a";"ae";"c";"e";"e";"e";"e";"i";"i";"i";"i";"d";"n";"o";"o";"o";"o";"o";"/";"o";"u";"u";"u";"u";"y";"th";"y"; -- 0xE0 to 0xFF
}
Unidecode[0x01] =
{[0]="A";"a";"A";"a";"A";"a";"C";"c";"C";"c";"C";"c";"C";"c";"D";"d";"D";"d";"E";"e";"E";"e";"E";"e";"E";"e";"E";"e";"G";"g";"G";"g"; -- 0x00 to 0x1F
"G";"g";"G";"g";"H";"h";"H";"h";"I";"i";"I";"i";"I";"i";"I";"i";"I";"i";"IJ";"ij";"J";"j";"K";"k";"k";"L";"l";"L";"l";"L";"l";"L"; -- 0x20 to 0x3F
"l";"L";"l";"N";"n";"N";"n";"N";"n";"'n";"ng";"NG";"O";"o";"O";"o";"O";"o";"OE";"oe";"R";"r";"R";"r";"R";"r";"S";"s";"S";"s";"S";"s"; -- 0x40 to 0x5F
"S";"s";"T";"t";"T";"t";"T";"t";"U";"u";"U";"u";"U";"u";"U";"u";"U";"u";"U";"u";"W";"w";"Y";"y";"Y";"Z";"z";"Z";"z";"Z";"z";"s"; -- 0x60 to 0x7F
"b";"B";"B";"b";"6";"6";"O";"C";"c";"D";"D";"D";"d";"d";"3";"@";"E";"F";"f";"G";"G";"hv";"I";"I";"K";"k";"l";"l";"W";"N";"n";"O"; -- 0x80 to 0x9F
"O";"o";"OI";"oi";"P";"p";"YR";"2";"2";"SH";"sh";"t";"T";"t";"T";"U";"u";"Y";"V";"Y";"y";"Z";"z";"ZH";"ZH";"zh";"zh";"2";"5";"5";"ts";"w"; -- 0xA0 to 0xBF
"|";"||";"|=";"!";"DZ";"Dz";"dz";"LJ";"Lj";"lj";"NJ";"Nj";"nj";"A";"a";"I";"i";"O";"o";"U";"u";"U";"u";"U";"u";"U";"u";"U";"u";"@";"A";"a"; -- 0xC0 to 0xDF
"A";"a";"AE";"ae";"G";"g";"G";"g";"K";"k";"O";"o";"O";"o";"ZH";"zh";"j";"DZ";"Dz";"dz";"G";"g";"HV";"W";"N";"n";"A";"a";"AE";"ae";"O";"o"; -- 0xE0 to 0xFF
}
Unidecode[0x02] =
{[0]="A";"a";"A";"a";"E";"e";"E";"e";"I";"i";"I";"i";"O";"o";"O";"o";"R";"r";"R";"r";"U";"u";"U";"u";"S";"s";"T";"t";"Y";"y";"H";"h"; -- 0x00 to 0x1F
"N";"d";"OU";"ou";"Z";"z";"A";"a";"E";"e";"O";"o";"O";"o";"O";"o";"O";"o";"Y";"y";"l";"n";"t";"j";"db";"qp";"A";"C";"c";"L";"T";"s"; -- 0x20 to 0x3F
"z";"[?]";"[?]";"B";"U";"^";"E";"e";"J";"j";"q";"q";"R";"r";"Y";"y";"a";"a";"a";"b";"o";"c";"d";"d";"e";"@";"@";"e";"e";"e";"e";"j"; -- 0x40 to 0x5F
"g";"g";"g";"g";"u";"Y";"h";"h";"i";"i";"I";"l";"l";"l";"lZ";"W";"W";"m";"n";"n";"n";"o";"OE";"O";"F";"r";"r";"r";"r";"r";"r";"r"; -- 0x60 to 0x7F
"R";"R";"s";"S";"j";"S";"S";"t";"t";"u";"U";"v";"^";"w";"y";"Y";"z";"z";"Z";"Z";"?";"?";"?";"C";"@";"B";"E";"G";"H";"j";"k";"L"; -- 0x80 to 0x9F
"q";"?";"?";"dz";"dZ";"dz";"ts";"tS";"tC";"fN";"ls";"lz";"WW";"]]";"h";"h";"h";"h";"j";"r";"r";"r";"r";"w";"y";"'";'"';"`";"'";"`";"`";"'"; -- 0xA0 to 0xBF
"?";"?";"<";">";"^";"V";"^";"V";"'";"-";"/";"\\";",";"_";"\\";"/";":";".";"`";"'";"^";"V";"+";"-";"V";".";"@";",";"~";'"';"R";"X"; -- 0xC0 to 0xDF
"G";"l";"s";"x";"?";"";"";"";"";"";"";"";"V";"=";'"';"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0xE0 to 0xFF
}
Unidecode[0x03] =
{
}
Unidecode[0x04] =
{
}
Unidecode[0x20] =
{[0]=" ";" ";" ";" ";" ";" ";" ";" ";" ";" ";" ";" ";"";"";"";"";"-";"-";"-";"-";"--";"--";"||";"_";"'";"'";",";"'";'"';'"';",,";'"'; -- 0x00 to 0x1F
"|+";"|++";"*";"*>";".";"..";"...";".";"\n";"\n\n";"";"";"";"";"";" ";"%0";"%00";"'";"''";"'''";"`";"``";"```";"^";"<";">";"*";"!!";"!?";"-";"_"; -- 0x20 to 0x3F
"-";"^";"***";"--";"/";"-[";"]-";"[?]";"?!";"!?";"7";"PP";"(]";"[)";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0x40 to 0x5F
"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"";"";"";"";"";"";"0";"";"";"";"4";"5";"6";"7";"8";"9";"+";"-";"=";"(";")";"n"; -- 0x60 to 0x7F
"0";"1";"2";"3";"4";"5";"6";"7";"8";"9";"+";"-";"=";"(";")";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0x80 to 0x9F
"ECU";"CL";"Cr";"FF";"L";"mil";"N";"Pts";"Rs";"W";"NS";"D";"=E";"K";"T";"Dr";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0xA0 to 0xBF
"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"";"";"";"";"";"";"";"";"";"";"";"";"";"";"";""; -- 0xC0 to 0xDF
"";"";"";"";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0xE0 to 0xFF
}
Unidecode[0x21] =
{[34]="TM";
}
return fh
end -- local function encoder_v3
local encoder = encoder_v3() -- To access FH encoder chars module
--[[
@Module: +fh+progbar_v3
@Author: Mike Tate
@Version: 3.0
@LastUpdated: 27 Aug 2020
@Description: Progress Bar library module.
@V3.0: Function Prototype Closure version.
@V1.0: Initial version.
]]
local function progbar_v3()
local fh = {} -- Local environment table
require "iuplua" -- To access GUI window builder
iup.SetGlobal("CUSTOMQUITMESSAGE","YES") -- Needed for IUP 3.28
local tblBars = {} -- Table for optional external attributes
local strBack = "255 255 255" -- Background colour default is white
local strBody = "0 0 0" -- Body text colour default is black
local strFont = nil -- Font dialogue default is current font
local strStop = "255 0 0" -- Stop button colour default is red
local intPosX = iup.CENTER -- Show window default position is central
local intPosY = iup.CENTER
local intMax, intVal, intPercent, intStart, intDelta, intScale, strClock, isBarStop
local lblText, barGauge, lblDelta, btnStop, dlgGauge
local function doFocus() -- Bring the Progress Bar window into Focus
dlgGauge.BringFront="YES" -- If used too often, inhibits other windows scroll bars, etc
end -- local function doFocus
local function doUpdate() -- Update the Progress Gauge and the Delta % with clock
barGauge.Value = intVal
lblDelta.Title = string.format("%4d %% %s ",math.floor(intPercent),strClock)
end -- local function doUpdate
local function doReset() -- Reset all dialogue variables and Update display
intVal = 0 -- Current value of Progress Bar
intPercent= 0.01 -- Percentage of progress
intStart = os.time() -- Start time of progress
intDelta = 0 -- Delta time of progress
intScale = math.ceil( intMax / 1000 ) -- Scale of percentage per second of progress (initial guess is corrected in Step function)
strClock = "00 : 00 : 00" -- Clock delta time display
isBarStop = false -- Stop button pressed signal
doUpdate()
doFocus()
end -- local function doReset
function fh.Start(strTitle,intMaximum) -- Create & start Progress Bar window
if not dlgGauge then
strTitle = strTitle or "" -- Dialogue and button title
intMax = intMaximum or 100 -- Maximun range of Progress Bar, default is 100
local strSize = tostring( math.max( 100, string.len(" Stop "..strTitle) * 8 ) ).."x30" -- Adjust Stop button size to Title
lblText = iup.label { Title=" "; Expand="YES"; Alignment="ACENTER"; Tip="Progress Message"; }
barGauge = iup.progressbar { RasterSize="400x30"; Value=0; Max=intMax; Tip="Progress Bar"; }
lblDelta = iup.label { Title=" "; Expand="YES"; Alignment="ACENTER"; Tip="Percentage and Elapsed Time"; }
btnStop = iup.button { Title=" Stop "..strTitle; RasterSize=strSize; FgColor=strStop; Tip="Stop Progress Button"; action=function() isBarStop = true end; } -- Signal Stop button pressed return iup.CLOSE -- Often caused main GUI to close !!!
dlgGauge = iup.dialog { Title=strTitle.." Progress "; Font=strFont; FgColor=strBody; Background=strBack; DialogFrame="YES"; -- Remove Windows minimize/maximize menu
iup.vbox{ Alignment="ACENTER"; Gap="10"; Margin="10x10";
lblText;
barGauge;
lblDelta;
btnStop;
};
move_cb = function(self,x,y) tblBars.X = x tblBars.Y = y end;
close_cb = btnStop.action; -- Windows Close button = Stop button
}
if type(tblBars.GUI) == "table"
and type(tblBars.GUI.ShowDialogue) == "function" then
dlgGauge.move_cb = nil -- Use GUI library to show & move window
tblBars.GUI.ShowDialogue("Bars",dlgGauge,btnStop,"showxy")
else
dlgGauge:showxy(intPosX,intPosY) -- Show the Progress Bar window
end
doReset() -- Reset the Progress Bar display
end
end -- function Start
function fh.Message(strText) -- Show the Progress Bar message
if dlgGauge then lblText.Title = strText end
end -- function Message
function fh.Step(intStep) -- Step the Progress Bar forward
if dlgGauge then
intVal = intVal + ( intStep or 1 ) -- Default step is 1
local intNew = math.ceil( intVal / intMax * 100 * intScale ) / intScale
if intPercent ~= intNew then -- Update progress once per percent or per second, whichever is smaller
intPercent = math.max( 0.1, intNew ) -- Ensure percentage is greater than zero
if intVal > intMax then intVal = intMax intPercent = 100 end -- Ensure values do not exceed maximum
intNew = os.difftime(os.time(),intStart)
if intDelta < intNew then -- Update clock of elapsed time
intDelta = intNew
intScale = math.ceil( intDelta / intPercent ) -- Scale of seconds per percentage step
local intHour = math.floor( intDelta / 3600 )
local intMins = math.floor( intDelta / 60 - intHour * 60 )
local intSecs = intDelta - intMins * 60 - intHour * 3600
strClock = string.format("%02d : %02d : %02d",intHour,intMins,intSecs)
end
doUpdate() -- Update the Progress Bar display
end
iup.LoopStep()
end
end -- function Step
function fh.Focus() -- Bring the Progress Bar window to front
if dlgGauge then doFocus() end
end -- function Focus
function fh.Reset() -- Reset the Progress Bar display
if dlgGauge then doReset() end
end -- function Reset
function fh.Stop() -- Check if Stop button pressed
iup.LoopStep()
return isBarStop
end -- function Stop
function fh.Close() -- Close the Progress Bar window
isBarStop = false
if dlgGauge then dlgGauge:destroy() dlgGauge = nil end
end -- function Close
function fh.Setup(tblSetup) -- Setup optional table of external attributes
if tblSetup then
tblBars = tblSetup
strBack = tblBars.Back or strBack -- Background colour
strBody = tblBars.Body or strBody -- Body text colour
strFont = tblBars.Font or strFont -- Font dialogue
strStop = tblBars.Stop or strStop -- Stop button colour
intPosX = tblBars.X or intPosX -- Window position
intPosY = tblBars.Y or intPosY
end
end -- function Setup
return fh
end -- local function progbar_v3
local progbar = progbar_v3() -- To access FH progress bars module
--[[
@Module: +fh+iup_gui_v3
@Author: Mike Tate
@Version: 4.1
@LastUpdated: 03 May 2022
@Description: Graphical User Interface Library Module
@V4.1: CheckVersionInStore() save & retrieve latest version in file; Remove old wiki Help features;
@V4.0: Cater for full UTF-8 filenames;
@V3.9: ShowDialogue() popup closure fhSleep() added; CheckVersionInStore() at monthly intervals;
@V3.8: Function Prototype Closure version.
@V3.7: AssignAttributes(tblControls) now allows any string attribute to invoke a function.
@V3.6: anyMemoDialogue() sets TopMost attribute.
@V3.5: Replace IsNormalWindow(iupDialog) with SetWindowCoord(tblName) and update CheckWindowPosition(tblName) to prevent negative values freezing main dialog.
@V3.4: Use general.MakeFolder() to ensure key folders exist, add Get/PutRegKey(), check Registry IE Shell Version in HelpDialogue(), better error handling in LoadSettings().
@V3.3: LoadFolder() and SaveFolder() use global folder as default for local folder to improve synch across PC.
@V3.2: Load & Save settings now use a single clipboard so Local PC settings are preserved across synchronised PC.
@V3.1: IUP 3.11.2 iup.GetGlobal("VERSION") to top, HelpDialogue conditional ExpandChildren="YES/NO", RefreshDialogue uses NaturalSize, SetUtf8Mode(), Load/SaveFolder(), etc
@V3.0: ShowDialogue "dialog" mode for Memo, new DestroyDialogue, NewHelpDialogue tblAttr for Font, AssignAttributes intSkip, CustomDialogue iup.CENTERPARENT+, IUP Workaround, BalloonToggle, Initialise test Plugin file exists.
@V2.0: Support for Plugin Data scope, new FontDialogue, RefreshDialogue, AssignAttributes, httpRequest handler, keep "dialog" mode.
@V1.0: Initial version.
]]
local function iup_gui_v3()
local fh = {} -- Local environment table
require "iuplua" -- To access GUI window builder
require "iupluacontrols" -- To access GUI window controls
require "lfs" -- To access LUA filing system
require "iupluaole" -- To access OLE subsystem
require "luacom" -- To access COM subsystem
iup.SetGlobal("CUSTOMQUITMESSAGE","YES") -- Needed for IUP 3.28
local iupVersion = iup.GetGlobal("VERSION") -- Obtain IUP module version
-- "iuplua" Omitted Constants Workaround --
iup.TOP = iup.LEFT
iup.BOTTOM = iup.RIGHT
iup.RED = iup.RGB(1,0,0)
iup.GREEN = iup.RGB(0,1,0)
iup.BLUE = iup.RGB(0,0,1)
iup.BLACK = iup.RGB(0,0,0)
iup.WHITE = iup.RGB(1,1,1)
iup.YELLOW = iup.RGB(1,1,0)
-- Shared Interface Attributes & Functions --
fh.Version = " " -- Plugin Version
fh.History = fh.Version -- Version History
fh.Red = "255 0 0" -- Color attributes (must exclude leading zeros & spaces to allow value comparisons)
fh.Maroon = "128 0 0"
fh.Amber = "250 160 0"
fh.Orange = "255 165 0"
fh.Yellow = "255 255 0"
fh.Olive = "128 128 0"
fh.Lime = "0 255 0"
fh.Green = "0 128 0"
fh.Cyan = "0 255 255"
fh.Teal = "0 128 128"
fh.Blue = "0 0 255"
fh.Navy = "0 0 128"
fh.Magenta = "255 0 255"
fh.Purple = "128 0 128"
fh.Black = "0 0 0"
fh.Gray = "128 128 128"
fh.Silver = "192 192 192"
fh.Smoke = "240 240 240"
fh.White = "255 255 255"
fh.Risk = fh.Red -- Risk colour for hazardous controls such as Close/Delete buttons
fh.Warn = fh.Magenta -- Warn colour for caution controls and warnings
fh.Safe = fh.Green -- Safe colour for active controls such as most buttons
fh.Info = fh.Black -- Info colour for text controls such as labels/tabs
fh.Head = fh.Black -- Head colour for headings
fh.Body = fh.Black -- Body colour for body text
fh.Back = fh.White -- Background colour for all windows
fh.Gap = "8" -- Layout attributes Gap was "10"
fh.Border = "8x8" -- was BigMargin="10x10"
fh.Margin = "1x1" -- was MinMargin
fh.Balloon = "NO" -- Tooltip balloon mode
fh.FontSet = 0 -- Legacy GUI font set assigned by FontAssignment but used globally
fh.FontHead = ""
fh.FontBody = ""
local GUI = { } -- Sub-table for GUI Dialogue attributes to allow any "Name"
--[[
GUI.Name table of dialogue attributes, where Name is Font, Help, Main, Memo, Bars, etc
GUI.Name.CoordX x co-ordinate ( Loaded & Saved by default )
GUI.Name.CoordY y co-ordinate ( Loaded & Saved by default )
GUI.Name.Dialog dialogue handle
GUI.Name.Focus focus button handle
GUI.Name.Frame dialogframe mode, "normal" = dialogframe="NO" else "YES", "showxy" = showxy(), "popup" or "keep" = popup(), default is "normal & showxy"
GUI.Name.Height height
GUI.Name.Raster rastersize ( Loaded & Saved by default )
GUI.Name.Width width
GUI.Name.Back ProgressBar background colour
GUI.Name.Body ProgressBar body text colour
GUI.Name.Font ProgressBar font style
GUI.Name.Stop ProgressBar Stop button colour
GUI.Name.GUI Module table usable by other modules e.g. progbar.Setup
--]]
-- tblScrn[1] = origin x, tblScrn[2] = origin y, tblScrn[3] = width, tblScrn[4] = height
local tblScrn = stringx.splitnumbers(iup.GetGlobal("VIRTUALSCREEN")) -- Used by CustomDialogue() and CheckWindowPosition() and ShowDialogue() below
local intMaxW = tblScrn[3]
local intMaxH = tblScrn[4]
function fh.BalloonToggle() -- Toggle tooltips Balloon mode
local tblToggle = { YES="NO"; NO="YES"; }
fh.Balloon = tblToggle[fh.Balloon]
fh.SaveSettings()
end -- function BalloonToggle
iup.SetGlobal("UTF8MODE","NO")
iup.SetGlobal("UTF8MODE_FILE","NO") -- V4.0
function fh.SetUtf8Mode() -- Set IUP into UTF-8 mode
if iupVersion == "3.5" or stringx.encoding() == "ANSI" then return false end
iup.SetGlobal("UTF8MODE","YES")
iup.SetGlobal("UTF8MODE_FILE","YES") -- V4.0
return true
end -- function SetUtf8Mode
local function tblOfNames(...) -- Get table of dialogue Names including "Font","Help","Main" by default
local arg = {...}
local tblNames = {"Font";"Help";"Main";}
for intName, strName in ipairs(arg) do
if type(strName) == "string"
and strName ~= "Font"
and strName ~= "Help"
and strName ~= "Main" then
table.insert(tblNames,strName)
end
end
return tblNames
end -- local function tblOfNames
local function tblNameFor(strName) -- Get table of parameters for chosen dialogue Name
strName = tostring(strName)
if not GUI[strName] then -- Need new table with default minimum & raster size, and X & Y co-ordinates
GUI[strName] = { }
local tblName = GUI[strName]
tblName.Raster = "x"
tblName.CoordX = iup.CENTER
tblName.CoordY = iup.CENTER
end
return GUI[strName]
end -- local function tblNameFor
local function intDimension(intMin,intVal,intMax) -- Return a number bounded by intMin and intMax
if not intVal then return 0 end -- Except if no value then return 0
intVal = tonumber(intVal) or (intMin+intMax)/2
return math.max(intMin,math.min(intVal,intMax))
end -- local function intDimension
function fh.CustomDialogue(strName,strRas,intX,intY) -- GUI custom window raster size, and X & Y co-ordinates
-- strRas nil = old size, "x" or "0x0" = min size, "999x999" = new size
-- intX/Y nil = central, "99" = co-ordinate position
local tblName = tblNameFor(strName)
local tblSize = {}
local intWide = 0
local intHigh = 0
strRas = strRas or tblName.Raster
if strRas then -- Ensure raster size is between minimum and screen size
tblSize = stringx.splitnumbers(strRas)
intWide = intDimension(intWide,tblSize[1],intMaxW)
intHigh = intDimension(intHigh,tblSize[2],intMaxH)
strRas = tostring(intWide.."x"..intHigh)
end
if intX and intX < iup.CENTERPARENT then
intX = intDimension(0,intX,intMaxW-intWide) -- Ensure X co-ordinate positions window on screen
end
if intY and intY < iup.CENTERPARENT then
intY = intDimension(0,intY,intMaxH-intHigh) -- Ensure Y co-ordinate positions window on screen
end
tblName.Raster = strRas or "x"
tblName.CoordX = tonumber(intX) or iup.CENTER
tblName.CoordY = tonumber(intY) or iup.CENTER
end -- function CustomDialogue
function fh.DefaultDialogue(...) -- GUI default window minimum & raster size, and X & Y co-ordinates
for intName, strName in ipairs(tblOfNames(...)) do
fh.CustomDialogue(strName)
end
end -- function DefaultDialogue
function fh.DialogueAttributes(strName) -- Provide named Dialogue Attributes
local tblName = tblNameFor(strName) -- tblName.Dialog = dialog handle, so any other attributes could be retrieved
local tblSize = stringx.splitnumbers(tblName.Raster or "x") -- Split Raster Size into width=tblSize[1] and height=tblSize[2]
tblName.Width = tblSize[1]
tblName.Height= tblSize[2]
tblName.Back = fh.Back -- Following only needed for NewProgressBar
tblName.Body = fh.Body
tblName.Font = fh.FontBody
tblName.Stop = fh.Risk
tblName.GUI = fh -- Module table
return tblName
end -- function DialogueAttributes
local strDefaultScope = "Project" -- Default scope for Load/Save data is per Project/User/Machine as set by PluginDataScope()
local tblClipProj = { }
local tblClipUser = { } -- Clipboards of sticky data for each Plugin Data scope -- V3.2
local tblClipMach = { }
local function doLoadData(strParam,strDefault,strScope) -- Load sticky data for Plugin Data scope
strScope = tostring(strScope or strDefaultScope):lower()
local tblClipData = tblClipProj
if strScope:match("user") then tblClipData = tblClipUser
elseif strScope:match("mach") then tblClipData = tblClipMach
end
return tblClipData[strParam] or strDefault
end -- local function doLoadData
function fh.LoadGlobal(strParam,strDefault,strScope) -- Load Global Parameter for all PC
return doLoadData(strParam,strDefault,strScope)
end -- function LoadGlobal
function fh.LoadLocal(strParam,strDefault,strScope) -- Load Local Parameter for this PC
return doLoadData(fh.ComputerName.."-"..strParam,strDefault,strScope)
end -- function LoadLocal
local function doLoadFolder(strFolder) -- Use relative paths to let Paths change -- V3.3
strFolder = strFolder:gsub("^FhDataPath",function() return fh.FhDataPath end) -- Full path to .fh_data folder
strFolder = strFolder:gsub("^PublicPath",function() return fh.PublicPath end) -- Full path to Public folder
strFolder = strFolder:gsub("^FhProjPath",function() return fh.FhProjPath end) -- Full path to project folder
return strFolder
end -- local function doLoadFolder
function fh.LoadFolder(strParam,strDefault,strScope) -- Load Folder Parameter for this PC -- V3.3
local strFolder = doLoadFolder(fh.LoadLocal(strParam,"",strScope))
if not general.FlgFolderExists(strFolder) then -- If no local folder try global folder
strFolder = doLoadFolder(fh.LoadGlobal(strParam,strDefault,strScope))
end
return strFolder
end -- function LoadFolder
function fh.LoadDialogue(...) -- Load Dialogue Parameters for "Font","Help","Main" by default
for intName, strName in ipairs(tblOfNames(...)) do
local tblName = tblNameFor(strName)
--# tblName.Raster = tostring(fh.LoadLocal(strName.."S",tblName.Raster)) -- Legacy of "S" becomes "R"
tblName.Raster = tostring(fh.LoadLocal(strName.."R",tblName.Raster))
tblName.CoordX = tonumber(fh.LoadLocal(strName.."X",tblName.CoordX))
tblName.CoordY = tonumber(fh.LoadLocal(strName.."Y",tblName.CoordY))
fh.CheckWindowPosition(tblName)
end
end -- function LoadDialogue
function fh.LoadSettings(...) -- Load Sticky Settings from File
for strFileName, tblClipData in pairs ({ ProjectFile=tblClipProj; PerUserFile=tblClipUser; MachineFile=tblClipMach; }) do
strFileName = fh[strFileName]
if general.FlgFileExists(strFileName) then -- Load Settings File in table lines with key & val fields
local tblField = {}
local strClip = general.StrLoadFromFile(strFileName) --! -- V4.0
for strLine in strClip:gmatch("[^\r\n]+") do --! -- V4.0
--! for strLine in io.lines(strFileName) do
if #tblField == 0
and strLine:match("^return {") -- Unless entire Sticky Data table was saved --!
and type(table.load) == "function" then
local tblClip, strErr = table.load(strFileName) -- Load Settings File table
if strErr then error(strErr.."\n\nMay need to Delete the following Plugin Data .dat file:\n\n"..strFileName.."\n\nError detected.") end
for i,j in pairs (tblClip) do
tblClipData[i] = tblClip[i]
end
break
end
tblField = stringx.split(strLine,"=")
if tblField[1] then tblClipData[tblField[1]] = tblField[2] end
end
else
for i,j in pairs (tblClipData) do
tblClipData[i] = nil --! Restore defaults and clear any junk -- V4.0
end
end
end
fh.Safe = tostring(fh.LoadGlobal("SafeColor",fh.Safe))
fh.Warn = tostring(fh.LoadGlobal("WarnColor",fh.Warn))
fh.Risk = tostring(fh.LoadGlobal("RiskColor",fh.Risk))
fh.Head = tostring(fh.LoadGlobal("HeadColor",fh.Head))
fh.Body = tostring(fh.LoadGlobal("BodyColor",fh.Body))
fh.FontHead= tostring(fh.LoadGlobal("FontHead" ,fh.FontHead))
fh.FontBody= tostring(fh.LoadGlobal("FontBody" ,fh.FontBody))
fh.FontSet = tonumber(fh.LoadGlobal("Fonts" ,fh.FontSet)) -- Legacy only
fh.FontSet = tonumber(fh.LoadGlobal("FontSet" ,fh.FontSet)) -- Legacy only
fh.History = tostring(fh.LoadGlobal("History" ,fh.History))
fh.Balloon = tostring(fh.LoadGlobal("Balloon" ,fh.Balloon, "Machine"))
fh.LoadDialogue(...)
if fh.FontSet > 0 then fh.FontAssignment(fh.FontSet) end -- Legacy only
end -- function LoadSettings
local function doSaveData(strParam,anyValue,strScope) -- Save sticky data for Plugin Data scope
strScope = tostring(strScope or strDefaultScope):lower()
local tblClipData = tblClipProj
if strScope:match("user") then tblClipData = tblClipUser
elseif strScope:match("mach") then tblClipData = tblClipMach
end
tblClipData[strParam] = anyValue
end -- local function doSaveData
function fh.SaveGlobal(strParam,anyValue,strScope) -- Save Global Parameter for all PC
doSaveData(strParam,anyValue,strScope)
end -- function SaveGlobal
function fh.SaveLocal(strParam,anyValue,strScope) -- Save Local Parameter for this PC
doSaveData(fh.ComputerName.."-"..strParam,anyValue,strScope)
end -- function SaveLocal
function fh.SaveFolder(strParam,strFolder,strScope) -- Save Folder Parameter for this PC
strFolder = stringx.replace(strFolder,fh.FhDataPath,"FhDataPath") -- Full path to .fh_data folder
strFolder = stringx.replace(strFolder,fh.PublicPath,"PublicPath") -- Full path to Public folder
strFolder = stringx.replace(strFolder,fh.FhProjPath,"FhProjPath") -- Full path to project folder
--# doSaveData(fh.ComputerName.."-"..strParam,strFolder,strScope) -- Uses relative paths to let Paths change
fh.SaveGlobal(strParam,strFolder,strScope) -- V3.3
fh.SaveLocal(strParam,strFolder,strScope) -- Uses relative paths to let Paths change
end -- function SaveFolder
function fh.SaveDialogue(...) -- Save Dialogue Parameters for "Font","Help","Main" by default
for intName, strName in ipairs(tblOfNames(...)) do
local tblName = tblNameFor(strName)
fh.SaveLocal(strName.."R",tblName.Raster)
fh.SaveLocal(strName.."X",tblName.CoordX)
fh.SaveLocal(strName.."Y",tblName.CoordY)
end
end -- function SaveDialogue
function fh.SaveSettings(...) -- Save Sticky Settings to File
fh.SaveDialogue(...)
fh.SaveGlobal("SafeColor",fh.Safe)
fh.SaveGlobal("WarnColor",fh.Warn)
fh.SaveGlobal("RiskColor",fh.Risk)
fh.SaveGlobal("HeadColor",fh.Head)
fh.SaveGlobal("BodyColor",fh.Body)
fh.SaveGlobal("FontHead" ,fh.FontHead)
fh.SaveGlobal("FontBody" ,fh.FontBody)
fh.SaveGlobal("History" ,fh.History)
fh.SaveGlobal("Balloon" ,fh.Balloon, "Machine")
for strFileName, tblClipData in pairs ({ ProjectFile=tblClipProj; PerUserFile=tblClipUser; MachineFile=tblClipMach; }) do
for i,j in pairs (tblClipData) do -- Check if table has any entries
strFileName = fh[strFileName]
if type(table.save) == "function" then -- Save entire Settings File table per Project/User/Machine
table.save(tblClipData,strFileName)
else
local tblClip = {}
for strKey,strVal in pairs(tblClipData) do -- Else save Settings File lines with key & val fields -- V4.0
table.insert(tblClip,strKey.."="..strVal.."\n") --! -- V4.0
end
local strClip = table.concat(tblClip,"\n") --! -- V4.0
if not general.SaveStringToFile(strClip,strFileName) then --! -- V4.0
error("\nSettings file not saved successfully.\n\nMay need to Delete the following Plugin Data .dat file:\n\n"..strFileName.."\n\nError detected.")
end
end
break
end
end
end -- function SaveSettings
function fh.CheckWindowPosition(tblName) -- Ensure dialogue window coordinates are on Screen
if tonumber(tblName.CoordX) == nil
or tonumber(tblName.CoordX) < 0 -- V3.5
or tonumber(tblName.CoordX) > intMaxW then
tblName.CoordX = iup.CENTER
end
if tonumber(tblName.CoordY) == nil
or tonumber(tblName.CoordY) < 0 -- V3.5
or tonumber(tblName.CoordY) > intMaxH then
tblName.CoordY = iup.CENTER
end
end -- function CheckWindowPosition
function fh.IsNormalWindow(iupDialog) -- Check dialogue window is not Maximised or Minimised (now redundant)
-- tblPosn[1] = origin x, tblPosn[2] = origin y, tblPosn[3] = width, tblPosn[4] = height
local tblPosn = stringx.splitnumbers(iupDialog.ScreenPosition)
local intPosX = tblPosn[1]
local intPosY = tblPosn[2]
if intPosX < 0 and intPosY < 0 then -- If origin is negative (-8, -8 = Maximised, -3200, -3200 = Minimised)
return false -- then is Maximised or Minimised
end
return true
end -- function IsNormalWindow
function fh.SetWindowCoord(tblName) -- Set the Window coordinates if not Maximised or Minimised -- V3.5
-- tblPosn[1] = origin x, tblPosn[2] = origin y, tblPosn[3] = width, tblPosn[4] = height
local tblPosn = stringx.splitnumbers(tblName.Dialog.ScreenPosition)
local intPosX = tblPosn[1]
local intPosY = tblPosn[2]
if intPosX < 0 and intPosY < 0 then -- If origin is negative (-8, -8 = Maximised, -3200, -3200 = Minimised)
return false -- then is Maximised or Minimised
end
tblName.CoordX = intPosX -- Otherwise set the Window coordinates
tblName.CoordY = intPosY
return true
end -- function SetWindowCoord
function fh.ShowDialogue(strName,iupDialog,btnFocus,strFrame) -- Set standard frame attributes and display dialogue window
local tblName = tblNameFor(strName)
iupDialog = iupDialog or tblName.Dialog -- Retrieve previous parameters if needed
btnFocus = btnFocus or tblName.Focus
strFrame = strFrame or tblName.Frame
strFrame = strFrame or "show norm" -- Default frame mode is dialog:showxy(X,Y) with DialogFrame="NO" ("normal" to vary size, otherwise fixed size)
strFrame = strFrame:lower() -- Other modes are "show", "popup" & "keep" with DialogFrame="YES", or with "normal" for DialogFrame="NO" ("show" for active windows, "popup"/"keep" for modal windows)
if strFrame:gsub("%s-%a-map%a*[%s%p]*","") == "" then -- May be prefixed with "map" mode to just map dialogue initially, also may be suffixed with "dialog" to inhibit iup.MainLoop() to allow progress messages
strFrame = "map show norm" -- If only "map" mode then default to "map show norm"
end
if type(iupDialog) == "userdata" then
tblName.Dialog = iupDialog
tblName.Focus = btnFocus -- Preserve parameters
tblName.Frame = strFrame
iupDialog.Background = fh.Back -- Background colour
iupDialog.Shrink = "YES" -- Sometimes needed to shrink controls to raster size
if type(btnFocus) == "userdata" then -- Set button as focus for Esc and Enter keys
iupDialog.StartFocus = iupDialog.StartFocus or btnFocus
iupDialog.DefaultEsc = iupDialog.DefaultEsc or btnFocus
iupDialog.DefaultEnter = iupDialog.DefaultEnter or btnFocus
end
iupDialog.MaxSize = intMaxW.."x"..intMaxH -- Maximum size is screen size
iupDialog.MinSize = "x" -- Minimum size (default "x" becomes nil)
iupDialog.RasterSize = tblName.Raster or "x" -- Raster size (default "x" becomes nil)
if strFrame:match("norm") then -- DialogFrame mode is "NO" by default for variable size window
if strFrame:match("pop") or strFrame:match("keep") then
iupDialog.MinBox = "NO" -- For "popup" and "keep" hide Minimize and Maximize icons
iupDialog.MaxBox = "NO"
else
strFrame = strFrame.." show" -- If not "popup" nor "keep" then use "showxy" mode
end
else
iupDialog.DialogFrame = "YES" -- Define DialogFrame mode for fixed size window
end
iupDialog.close_cb = iupDialog.close_cb or function() return iup.CLOSE end -- Define default window X close, move, and resize actions
iupDialog.move_cb = iupDialog.move_cb or function(self) fh.SetWindowCoord(tblName) end -- V3.5
iupDialog.resize_cb = iupDialog.resize_cb or function(self) if fh.SetWindowCoord(tblName) then tblName.Raster=self.RasterSize end end -- V3.5
if strFrame:match("map") then -- Only dialogue mapping is required
iupDialog:map()
tblName.Frame = strFrame:gsub("%s-%a-map%a*[%s%p]*","") -- Remove "map" from frame mode ready for subsequent call
return
end
fh.RefreshDialogue(strName) -- Refresh to set Natural Size as Minimum Size
if iup.MainLoopLevel() == 0 -- Called from outside Main GUI, so must use showxy() and not popup()
or strFrame:match("dialog")
or strFrame:match("sho") then -- Use showxy() to dispay dialogue window for "showxy" or "dialog" mode
iupDialog:showxy(tblName.CoordX,tblName.CoordY)
if not strFrame:match("dialog") -- Inhibit MainLoop if "dialog" mode -- V4.1
and iup.MainLoopLevel() == 0 then iup.MainLoop() end
else
iupDialog:popup(tblName.CoordX,tblName.CoordY) -- Use popup() to display dialogue window for "popup" or "keep" modes
fhSleep(200,150) -- Sometimes needed to prevent MainLoop() closure! -- V3.9
end
if not strFrame:match("dialog") and strFrame:match("pop") then
tblName.Dialog = nil -- When popup closed, clear key parameters, but not for "keep" mode
tblName.Raster = nil
tblName.CoordX = nil -- iup.CENTER
tblName.CoordY = nil -- iup.CENTER
else
fh.SetWindowCoord(tblName) -- Set Window coordinate pixel values -- V3.5
end
end
end -- function ShowDialogue
function fh.DestroyDialogue(strName) -- Destroy existing dialogue
local tblName = tblNameFor(strName)
if tblName then
local iupDialog = tblName.Dialog
if type(iupDialog) == "userdata" then
iupDialog:destroy()
tblName.Dialog = nil -- Prevent future misuse of handle -- 22 Jul 2014
end
end
end -- function DestroyDialogue
local function strDialogueArgs(strArgA,strArgB,comp) -- Compare two argument pairs and return matching pair
local tblArgA = stringx.splitnumbers(strArgA)
local tblArgB = stringx.splitnumbers(strArgB)
local strArgX = tostring(comp(tblArgA[1] or 100,tblArgB[1] or 100))
local strArgY = tostring(comp(tblArgA[2] or 100,tblArgB[2] or 100))
return strArgX.."x"..strArgY
end -- local function strDialogueArgs
function fh.RefreshDialogue(strName) -- Refresh dialogue window size after Font change, etc
local tblName = tblNameFor(strName)
local iupDialog = tblName.Dialog -- Retrieve the dialogue handle
if type(iupDialog) == "userdata" then
iupDialog.Size = iup.NULL
iupDialog.MinSize = iup.NULL -- V3.1
iup.Refresh(iupDialog) -- Refresh window to Natural Size and set as Minimum Size
if not iupDialog.RasterSize then
iupDialog:map()
iup.Refresh(iupDialog)
end
local strSize = iupDialog.NaturalSize or iupDialog.RasterSize -- IUP 3.5 NaturalSize = nil, IUP 3.11 needs NaturalSize -- V3.1
iupDialog.MinSize = strDialogueArgs(iupDialog.MaxSize,strSize,math.min) -- Set Minimum Size to smaller of Maximm Size or Natural/Raster Size -- V3.1
iupDialog.RasterSize = strDialogueArgs(tblName.Raster,strSize,math.max) -- Set Current Size to larger of Current Size or Natural/Raster Size -- V3.1
iup.Refresh(iupDialog)
tblName.Raster = iupDialog.RasterSize
if iupDialog.Visible == "YES" then -- Ensure visible dialogue origin is on screen
tblName.CoordX = math.max(tblName.CoordX,10)
tblName.CoordY = math.max(tblName.CoordY,10) -- Set both coordinates to larger of current value or 10 pixels
if iupDialog.Modal then -- V3.8
if iupDialog.Modal == "NO" then
iupDialog.ZOrder = "BOTTOM" -- Ensure dialogue is subservient to any popup
iupDialog:showxy(tblName.CoordX,tblName.CoordY) -- Use showxy() to reposition main window
else
iupDialog:popup(tblName.CoordX,tblName.CoordY) -- Use popup() to reposition modal window
end
end
else
iupDialog.BringFront="YES"
end
end
end -- function RefreshDialogue
function fh.AssignAttributes(tblControls) -- Assign the attributes of all controls supplied
local anyFunction = nil
for iupName, tblAttr in pairs ( tblControls or {} ) do
if type(iupName) == "userdata" and type(tblAttr) == "table" then-- Loop through each iup control
local intSkip = 0 -- Skip counter for attributes same for all controls
for intAttr, anyName in ipairs ( tblControls[1] or {} ) do -- Loop through each iup attribute
local strName = nil
local strAttr = nil
local strType = type(anyName)
if strType == "string" then -- Attribute is different for each control in tblControls
strName = anyName
strAttr = tblAttr[intAttr-intSkip]
elseif strType == "table" then -- Attribute is same for all controls as per tblControls[1]
intSkip = intSkip + 1
strName = anyName[1]
strAttr = anyName[2]
elseif strType == "function" then
intSkip = intSkip + 1
anyFunction = anyName
break
end
if type(strName) == "string" and ( type(strAttr) == "string" or type(strAttr) == "function" ) then
local anyRawGet = rawget(fh,strAttr) -- Use rawget() to stop require("pl.strict") complaining
if type(anyRawGet) == "string" then
strAttr = anyRawGet -- Use internal module attribute such as Head or FontBody
elseif type(iupName[strName]) == "string"
and type(strAttr) == "function" then -- Allow string attributes to invoke a function -- V3.7
strAttr = strAttr()
end
iupName[strName] = strAttr -- Assign attribute to control
end
end
end
end
if anyFunction then anyFunction() end -- Perform any control assignment function
end -- function AssignAttributes
-- Font Dialogue Attributes and Functions --
fh.FontBody = iup.GetGlobal("DEFAULTFONT") -- Set default font for Body and Head text
fh.FontHead = fh.FontBody:gsub(", B?o?l?d?",", Bold ")
---[=[
local intFontPlain = 1 -- Font Face & Style values for legacy FontSet setting
local intFontBold = 2
local intArialPlain = 3
local intArialBold = 4
local intTahomaPlain= 5
local intTahomaBold = 6
local strFontFace = fh.FontBody:gsub(",.*","")
local tblFontSet = {} -- Lookup table for FontHead and FontBody
tblFontSet[intFontPlain] = { Head=strFontFace.."; Bold -16"; Body=strFontFace.."; -15"; }
tblFontSet[intFontBold] = { Head=strFontFace.."; Bold -16"; Body=strFontFace.."; Bold -15"; }
tblFontSet[intArialPlain] = { Head="Arial; Bold -16"; Body="Arial; -16"; }
tblFontSet[intArialBold] = { Head="Arial; Bold -16"; Body="Arial; Bold -15"; }
tblFontSet[intTahomaPlain] = { Head="Tahoma; Bold -15"; Body="Tahoma; -16"; }
tblFontSet[intTahomaBold] = { Head="Tahoma; Bold -15"; Body="Tahoma; Bold -14"; }
function fh.FontAssignment(intFontSet) -- Assign Font Face & Style GUI values for legacy FontSet setting
if intFontSet then
intFontSet = math.max(intFontSet,1)
intFontSet = math.min(intFontSet,#tblFontSet)
fh.FontHead = tblFontSet[intFontSet]["Head"] -- Legacy Font for all GUI dialog header text
fh.FontBody = tblFontSet[intFontSet]["Body"] -- Legacy Font for all GUI dialog body text
end
end -- function FontAssignment
--]=]
function fh.FontDialogue(tblAttr,strName) -- GUI Font Face & Style Dialogue
tblAttr = tblAttr or {}
strName = strName or "Main"
local isFontChosen = false
local btnFontHead = iup.button { Title="Choose Headings Font and default Colour"; }
local btnFontBody = iup.button { Title="Choose Body text Font and default Colour"; }
local btnCol_Safe = iup.button { Title=" Safe Colour "; }
local btnCol_Warn = iup.button { Title=" Warning Colour "; }
local btnCol_Risk = iup.button { Title=" Risky Colour "; }
local btnDefault = iup.button { Title=" Default Fonts "; }
local btnMinimum = iup.button { Title=" Minimum Size "; }
local btnDestroy = iup.button { Title=" Close Dialogue "; }
local frmSetFonts = iup.frame { Title=" Set Window Fonts & Colours ";
iup.vbox { Alignment="ACENTER"; Margin=fh.Margin; Homogeneous="YES";
btnFontHead;
btnFontBody;
iup.hbox { btnCol_Safe; btnCol_Warn; btnCol_Risk; Homogeneous="YES"; };
iup.hbox { btnDefault ; btnMinimum ; btnDestroy ; Homogeneous="YES"; };
} -- iup.vbox end
} -- iup.frame end
-- Create dialogue and turn off resize, maximize, minimize, and menubox except Close button
local dialogFont = iup.dialog { Title=" Set Window Fonts & Colours "; Gap=fh.Gap; Margin=fh.Border; frmSetFonts; }
local tblButtons = { }
local function setDialogues() -- Refresh the Main and Help dialogues
local tblHelp = tblNameFor("Help")
if type(tblHelp.Dialog) == "userdata" then -- Help dialogue exists
fh.AssignAttributes(tblHelp.TblAttr) -- Assign the Help dialogue attributes
fh.RefreshDialogue("Help") -- Refresh the Help window size & position
end
fh.AssignAttributes(tblAttr) -- Assign parent dialogue attributes
fh.RefreshDialogue(strName) -- Refresh parent window size & position and bring infront of Help window
fh.RefreshDialogue("Font") -- Refresh Font window size & position and bring infront of parent window
end -- local function setDialogues
local function getFont(strColor) -- Set font button function
local strTitle = " Choose font style & default colour for "..strColor:gsub("Head","Heading").." text "
local strValue = "Font"..strColor -- The font codes below are not recognised by iupFontDlg and result in empty font face!
local strFont = rawget(fh,strValue):gsub(" Black,",","):gsub(" Light, Bold",","):gsub(" Extra Bold,",","):gsub(" Semibold,",",")
local iupFontDlg = iup.fontdlg { Title=strTitle; Color=rawget(fh,strColor); Value=strFont; }
iupFontDlg:popup() -- Popup predefined font dialogue
if iupFontDlg.Status == "1" then
if iupFontDlg.Value:match("^,") then -- Font face missing so revert to original font
iupFontDlg.Value = rawget(fh,strValue)
end
fh[strColor] = iupFontDlg.Color -- Set Head or Body color attribute
fh[strValue] = iupFontDlg.Value -- Set FontHead or FontBody font style
fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes
setDialogues()
isFontChosen = true
end
end -- local function getFont
local function getColor(strColor) -- Set colour button function
local strTitle = " Choose colour for "..strColor:gsub("Warn","Warning"):gsub("Risk","Risky").." button & message text "
local iupColorDlg = iup.colordlg { Title=strTitle; Value=rawget(fh,strColor); ShowColorTable="YES"; }
iupColorDlg.DialogFrame="YES"
iupColorDlg:popup() -- Popup predefined color dialogue fixed size window
if iupColorDlg.Status == "1" then
fh[strColor] = iupColorDlg.Value -- Set Safe or Warn or Risk color attribute
fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes
setDialogues()
isFontChosen = true
end
end -- local function getColor
local function setDefault() -- Action for Default Fonts button
fh.Safe = fh.Green
fh.Warn = fh.Magenta
fh.Risk = fh.Red -- Set default colours
fh.Body = fh.Black
fh.Head = fh.Black
fh.FontBody = iup.GetGlobal("DEFAULTFONT") -- Set default fonts for Body and Head text
fh.FontHead = fh.FontBody:gsub(", B?o?l?d?",", Bold")
fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes
setDialogues()
isFontChosen = true
end -- local function setDefault
local function setMinimum() -- Action for Minimum Size button
local tblName = tblNameFor(strName)
local iupDialog = tblName.Dialog -- Retrieve the parent dialogue handle
if type(iupDialog) == "userdata" then
tblName.Raster = "10x10" -- Refresh parent window to Minimum Size & adjust position
fh.RefreshDialogue(strName)
end
local tblFont = tblNameFor("Font")
tblFont.Raster = "10x10" -- Refresh Font window to Minimum Size & adjust position
fh.RefreshDialogue("Font")
end -- local function setMinimum
tblButtons = { { "Font" ; "FgColor" ; "Tip" ; "action" ; {"TipBalloon";"Balloon";} ; {"Expand";"YES";} ; };
[btnFontHead] = { "FontHead"; "Head"; "Choose the Heading text Font Face, Style, Size, Effects, and default Colour"; function() getFont("Head") end; };
[btnFontBody] = { "FontBody"; "Body"; "Choose the Body text Font Face, Style, Size, Effects, and default Colour" ; function() getFont("Body") end; };
[btnCol_Safe] = { "FontBody"; "Safe"; "Choose the colour for Safe operations" ; function() getColor("Safe") end; };
[btnCol_Warn] = { "FontBody"; "Warn"; "Choose the colour for Warning operations"; function() getColor("Warn") end; };
[btnCol_Risk] = { "FontBody"; "Risk"; "Choose the colour for Risky operations" ; function() getColor("Risk") end; };
[btnDefault ] = { "FontBody"; "Safe"; "Restore default Fonts and Colours"; function() setDefault() end; };
[btnMinimum ] = { "FontBody"; "Safe"; "Reduce window to its minimum size"; function() setMinimum() end; };
[btnDestroy ] = { "FontBody"; "Risk"; "Close this dialogue "; function() return iup.CLOSE end; };
[frmSetFonts] = { "FontHead"; "Head"; };
}
fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes
fh.ShowDialogue("Font",dialogFont,btnDestroy,"keep normal") -- Popup the Set Window Fonts dialogue: "keep normal" : vary size & posn, and remember size & posn
-- fh.ShowDialogue("Font",dialogFont,btnDestroy,"popup normal") -- Popup the Set Window Fonts dialogue: "popup normal" : vary size & posn, but redisplayed centred
-- fh.ShowDialogue("Font",dialogFont,btnDestroy,"keep") -- Popup the Set Window Fonts dialogue: "keep" : fixed size, vary posn, and only remember posn
-- fh.ShowDialogue("Font",dialogFont,btnDestroy,"popup") -- Popup the Set Window Fonts dialogue: "popup": fixed size, vary posn, but redisplayed centred
dialogFont:destroy()
return isFontChosen
end -- function FontDialogue
local function anyMemoControl(anyName,fgColor) -- Compose any control Title and FgColor
local strName = tostring(anyName) -- anyName may be a string, and fgColor is default FgColor
local tipText = nil
if type(anyName) == "table" then -- anyName may be a table = { Title string ; FgColor string ; ToolTip string (optional); }
strName = anyName[1]
fgColor = anyName[2]:match("%d* %d* %d*") or fgColor
tipText = anyName[3]
end
return strName, fgColor, tipText
end -- local function anyMemoControl
local function anyMemoDialogue(strHead,anyHead,strMemo,anyMemo,...) -- Display framed memo dialogue with buttons
local arg = {...} -- Fix for Lua 5.2+
local intButt = 0 -- Returned value if "X Close" button is used
local tblButt = { [0]="X Close"; } -- Button names lookup table
local strHead, fgcHead, tipHead = anyMemoControl(anyHead or "",strHead)
local strMemo, fgcMemo, tipMemo = anyMemoControl(anyMemo or "",strMemo)
-- Create the GUI labels and buttons
local lblMemo = iup.label { Title=strMemo; FgColor=fgcMemo; Tip=tipMemo; TipBalloon=fh.Balloon; Alignment="ACENTER"; Padding=fh.Margin; Expand="YES"; WordWrap="YES"; }
local lblLine = iup.label { Separator="HORIZONTAL"; }
local iupHbox = iup.hbox { Homogeneous="YES"; }
local btnButt = iup.button { }
local strTop = "YES" -- Make dialogue TopMost -- V3.6
local strMode = "popup"
if arg[1] == "Keep Dialogue" then -- Keep dialogue open for a progress message
strMode = "keep dialogue"
lblLine = iup.label { }
if not arg[2] then strTop = "NO" end -- User chooses TopMost -- V3.6
else
if #arg == 0 then arg[1] = "OK" end -- If no buttons listed then default to an "OK" button
for intArg, anyButt in ipairs(arg) do
local strButt, fgcButt, tipButt = anyMemoControl(anyButt,fh.Safe)
tblButt[intArg] = strButt
btnButt = iup.button { Title=strButt; FgColor=fgcButt; Tip=tipButt; TipBalloon=fh.Balloon; Expand="NO"; MinSize="80"; Padding=fh.Margin; action=function() intButt=intArg return iup.CLOSE end; }
iup.Append( iupHbox, btnButt )
end
end
-- Create dialogue and turn off resize, maximize, minimize, and menubox except Close button
local iupMemo = iup.dialog { Title=fh.Plugin..fh.Version..strHead; TopMost=strTop; -- TopMost added -- V3.6
iup.vbox { Alignment="ACENTER"; Gap=fh.Gap; Margin=fh.Margin;
iup.frame { Title=strHead; FgColor=fgcHead; Font=fh.FontHead;
iup.vbox { Alignment="ACENTER"; Font=fh.FontBody; lblMemo; lblLine; iupHbox; };
};
};
}
fh.ShowDialogue("Memo",iupMemo,btnButt,strMode) -- Show popup Memo dialogue window with righthand button in focus (if any)
if strMode == "keep dialogue" then return lblMemo end -- Return label control so message can be changed
iupMemo:destroy()
return intButt, tblButt[intButt] -- Return button number & title that was pressed
end -- local function anyMemoDialogue
function fh.MemoDialogue(anyMemo,...) -- Multi-Button GUI like iup.Alarm and fhMessageBox, with "Memo" in frame
return anyMemoDialogue(fh.Head,"Memo",fh.Body,anyMemo,...)
end -- function MemoDialogue
function fh.WarnDialogue(anyHead,anyMemo,...) -- Multi-Button GUI like iup.Alarm and fhMessageBox, with heading in frame
return anyMemoDialogue(fh.Warn,anyHead,fh.Warn,anyMemo,...)
end -- function WarnDialogue
function fh.GetRegKey(strKey) -- Read Windows Registry Key Value
local luaShell = luacom.CreateObject("WScript.Shell")
local anyValue = nil
if pcall( function() anyValue = luaShell:RegRead(strKey) end ) then
return anyValue -- Return Key Value if found
end
return nil
end -- function GetRegKey
function fh.PutRegKey(strKey,anyValue,strType) -- Write Windows Registry Key Value
local luaShell = luacom.CreateObject("WScript.Shell")
local strAns = nil
if pcall( function() strAns = luaShell:RegWrite(strKey,anyValue,strType) end ) then
return true
end
return nil
end -- function PutRegKey
local function httpRequest(strRequest) -- Luacom http request protected by pcall() below
local http = luacom.CreateObject("winhttp.winhttprequest.5.1")
http:Open("GET",strRequest,false)
http:Send()
return http.Responsebody
end -- local function httpRequest
function fh.VersionInStore(strPlugin) -- Obtain the Version in Plugin Store by Name only -- V3.9
local strVersion = "0"
if strPlugin then
local strFile = fh.MachinePath.."\\VersionInStore "..strPlugin..".dat"
local intTime = os.time() - 2600000 -- Time in seconds a month ago -- V3.9
local tblAttr, strError = lfs.attributes(strFile) -- Obtain file attributes
if not tblAttr or tblAttr.modification < intTime then -- File does not exist or was modified long ago -- V3.9
local strErrFile = fh.MachinePath.."\\VersionInStoreInternetError.dat"
local strRequest ="http://www.family-historian.co.uk/lnk/checkpluginversion.php?name="..strPlugin
local isOK, strReturn = pcall(httpRequest,strRequest)
if not isOK then -- Problem with Internet access
local intTime = os.time() - 36000 -- Time in seconds 10 hours ago
local tblAttr, strError = lfs.attributes(strErrFile) -- Obtain file attributes
if not tblAttr or tblAttr.modification < intTime then -- File does not exist or was modified long ago
fhMessageBox(strReturn.."\n The Internet appears to be inaccessible. ","MB_OK","MB_ICONEXCLAMATION")
end
general.SaveStringToFile(strErrFile,strErrFile) -- Update file modified time
else
general.DeleteFile(strErrFile) -- Delete file if Internet is OK
if strReturn ~= nil then
strVersion = strReturn:match("([%d%.]*),%d*") -- Version digits & dots then comma and Id digits
general.SaveStringToFile(strVersion,strFile) -- Update file modified time and save version -- V4.1
end
end
else
strVersion = general.StrLoadFromFile(strFile) -- Retrieve saved latest version -- V4.1
if #strVersion > 9 then general.DeleteFile(strFile) end
end
end
return strVersion or "0"
end -- function VersionInStore
local function intVersion(strVersion) -- Convert version string to comparable integer
local intVersion = 0
local arrNumbers = {}
strVersion:gsub("(%d+)", function(strDigits) table.insert(arrNumbers,strDigits) end) -- V4.1
for i=1,5 do
intVersion = intVersion * 100 + tonumber(arrNumbers[i] or 0)
end
return intVersion
end -- local function intVersion
function fh.CheckVersionInStore() -- Check if later Version available in Plugin Store
local strNewVer = fh.VersionInStore(fh.Plugin:gsub(" %- .*",""))
local strOldVer = fh.Version
if intVersion(strNewVer) > intVersion(strOldVer:match("%D*([%d%.]*)")) then
fh.MemoDialogue("Later Version "..strNewVer.." of this Plugin is available from the Family Historian 'Plugin Store'.")
end
end -- function CheckVersionInStore
function fh.PluginDataScope(strScope) -- Set default Plugin Data scope to per-Project, or per-User, or per-Machine
strScope = tostring(strScope):lower()
if strScope:match("mach") then -- Per-Machine
strDefaultScope = "Machine"
elseif strScope:match("user") then -- Per-User
strDefaultScope = "User"
end -- Per-Project is default
end -- function PluginDataScope
--[=[ --! -- V4.0
local function strToANSI(strFileName)
if stringx.encoding() == "ANSI" then return strFileName end
return fhConvertUTF8toANSI(strFileName)
end -- local function strToANSI
--]=]
local function getPluginDataFileName(strScope) -- Get plugin data filename for chosen scope
local isOK, strDataFile = pcall(fhGetPluginDataFileName,strScope)
if not isOK then strDataFile = fhGetPluginDataFileName() end -- Before V5.0.8 parameter is disallowed and default = CURRENT_PROJECT
--! return strToANSI(strDataFile) -- V4.0
return strDataFile
end -- local function getPluginDataFileName
local function getDataFiles(strScope) -- Compose the Plugin Data file & path & root names
--! local strPluginName = strToANSI(fh.Plugin) -- V4.0
local strPluginName = fh.Plugin
local strPluginPlain = stringx.plain(strPluginName)
local strDataFile = getPluginDataFileName(strScope) -- Allow plugins with variant filenames to use same plugin data files
strDataFile = strDataFile:gsub("\\"..strPluginPlain:gsub(" ","_"):lower(),"\\"..strPluginName)
strDataFile = strDataFile:gsub("\\"..strPluginPlain..".+%.[D,d][A,a][T,t]$","\\"..strPluginName..".dat")
if strDataFile == "" and strScope == "CURRENT_PROJECT" then -- Use standalone GEDCOM path & filename..".fh_data\Plugin Data\" as the folder + the Plugin Filename..".dat"
--! strDataFile = strToANSI(fhGetContextInfo("CI_GEDCOM_FILE")) -- V4.0
strDataFile = fhGetContextInfo("CI_GEDCOM_FILE")
strDataFile = strDataFile:gsub("%.[G,g][E,e][D,d]",".fh_data")
general.MakeFolder(strDataFile) -- V3.4
strDataFile = strDataFile.."\\Plugin Data"
general.MakeFolder(strDataFile) -- V3.4
strDataFile = strDataFile.."\\"..strPluginName..".dat"
end
local strDataPath = strDataFile:gsub("\\"..strPluginPlain.."%.[D,d][A,a][T,t]$","") -- Plugin data folder path name
local strDataRoot = strDataPath.."\\"..strPluginName -- Plugin data file root name
general.MakeFolder(strDataPath) -- V3.4
return strDataFile, strDataPath, strDataRoot
end -- local function getDataFiles
function fh.Initialise(strVersion,strPlugin) -- Initialise the GUI module with optional Version & Plugin name
--! local strAppData = strToANSI(fhGetContextInfo("CI_APP_DATA_FOLDER")) -- V4.0
local strAppData = fhGetContextInfo("CI_APP_DATA_FOLDER")
fh.Plugin = fhGetContextInfo("CI_PLUGIN_NAME") -- Plugin Name from file
fh.Version = strVersion or " " -- Plugin Version
if fh.Version == " " then
local strTitle = "\n@Title is missing"
local strAuthor = "\n@Author is missing"
local strVersion = "\n@Version is missing"
local strPlugin = strAppData.."\\Plugins\\"..fh.Plugin..".fh_lua"
if general.FlgFileExists(strPlugin) then
for strLine in io.lines(strPlugin) do -- Read each line from the Plugin file
strPlugin = strLine:match("^@Title:[\t-\r ]*(.*)")
if strPlugin then
strPlugin = strPlugin:gsub("&&","&")
--? if fh.Plugin:match("^"..strPlugin:gsub("(%W)","%%%1")) then
if fh.Plugin:match("^"..stringx.plain(strPlugin)) then
fh.Plugin = strPlugin -- Prefer Title to Filename if it matches
strTitle = nil
else
strTitle = "\n@Title differs from Filename" -- Report abnormality
end
end
if strLine:match("^@Author:%s*(.*)") then -- Check @Author exists
strAuthor = nil
end
fh.Version = strLine:gsub("^@Version:%D*([%d%.]*)%D*"," %1 ")
if fh.Version ~= strLine then -- Obtain the @Version from Plugin file
strVersion = nil
break
end
end
if strTitle or strAuthor or strVersion then -- Report any header abnormalities
fhMessageBox("\nScript Header: "..fh.Plugin..(strTitle or "")..(strAuthor or "")..(strVersion or ""),"MB_OK","MB_ICONEXCLAMATION")
end
else
fhMessageBox("\nPlugin has not been saved!","MB_OK","MB_ICONEXCLAMATION")
end
end
fh.History = fh.Version -- Version History
fh.Plugin = strPlugin or fh.Plugin -- Plugin Name from argument or default from file
fh.CustomDialogue("Help","1020x730") -- Custom "Help" dialogue sizes
fh.DefaultDialogue() -- Default "Font","Help","Main" dialogues
fh.MachineFile,fh.MachinePath,fh.MachineRoot = getDataFiles("LOCAL_MACHINE") -- Plugin data names per machine
fh.PerUserFile,fh.PerUserPath,fh.PerUserRoot = getDataFiles("CURRENT_USER") -- Plugin data names per user
fh.ProjectFile,fh.ProjectPath,fh.ProjectRoot = getDataFiles("CURRENT_PROJECT") -- Plugin data names per project
--! fh.FhDataPath = strToANSI(fhGetContextInfo("CI_PROJECT_DATA_FOLDER")) -- Paths used by Load/SaveFolder for relative folders -- V4.0
--! fh.PublicPath = strToANSI(fhGetContextInfo("CI_PROJECT_PUBLIC_FOLDER")) -- Public data folder path name -- V4.0
fh.FhDataPath = fhGetContextInfo("CI_PROJECT_DATA_FOLDER") -- Paths used by Load/SaveFolder for relative folders -- V4.0
fh.PublicPath = fhGetContextInfo("CI_PROJECT_PUBLIC_FOLDER") -- Public data folder path name -- V4.0
if fh.FhDataPath == "" then
fh.FhDataPath = fh.ProjectPath:gsub("\\Plugin Data$","")
end
if fh.PublicPath == "" then
fh.PublicPath = fh.ProjectPath
fh.FhProjPath = fh.PublicPath:gsub("^(.+)\\.-\\Plugin Data$","%1")
else
general.MakeFolder(fh.PublicPath) -- V3.4
fh.FhProjPath = fh.PublicPath:gsub("^(.+)\\.-\\Public$","%1")
end
fh.CalicoPie = strAppData:gsub("\\Calico Pie\\.*","\\Calico Pie") -- Program Data Calico Pie path name
fh.ComputerName = os.getenv("COMPUTERNAME") -- Local PC Computer Name
end -- function Initialise
fh.Initialise() -- Initialise module with default values
return fh
end -- local function iup_gui_v3
local iup_gui = iup_gui_v3() -- To access FH IUP GUI build module
require "imlua" -- To access digital imaging library to check Media image frame areas
local ArrKB = {}
-- Preset Global Data Definitions --
function PresetGlobalData()
iup_gui.Gap = "2"
iup_gui.SetUtf8Mode()
general.DetectOldModules() -- V2.8
IntRowHeight = 8 -- Matrix height of data rows in setControls() via iup_gui.AssignAttributes
TblOption = {} -- Table of GUI toggle exception options
TblAttrib = {} -- Table of GUI toggle attributes
TblGrid = {} -- Table grid of statistics and related data
StrGridFile = iup_gui.ProjectRoot..".grid" -- Full path of plugin grid file
StrProjPath = iup_gui.FhDataPath -- Full path of Project GEDCOM file
local datToday = fhNewDate(2000)
datToday:SetSimpleDate(fhCallBuiltInFunction("Today")) -- Date today for future date checks
DptToday = datToday:GetDatePt1() -- V2.0
end -- function PresetGlobalData
-- Reset Sticky Settings to Default Values --
function ResetDefaultSettings()
iup_gui.CustomDialogue("Main") -- Centralise "Main"
iup_gui.DefaultDialogue("Bars","Memo") -- GUI window rastersize and X & Y co-ordinates for "Main","Font","Bar","Memo" dialogues
for strName, anyValue in pairs ( TblOption ) do
if #strName > 12 then -- Names > 12 chars do not conflict with 11 char settings below
TblOption[strName] = "ON" -- Enable all Options tab TblAttrib toggles -- V1.7
end
end
IntTabPosn = 0 -- Default to tab undefined
TblOption.TabPosition = IntTabPosn -- V 1.8
TblOption.DateWarning = "ON" -- Reset other Options tab settings
TblOption.MaximumAges = 120
TblOption.MinimumYear = 1000
end -- function ResetDefaultSettings
-- Load Sticky Settings from File --
function LoadSettings()
iup_gui.LoadSettings() -- Includes "Main","Font" dialogues and "FontSet" & "History"
iup_gui.Balloon = "NO" -- V2.1 for PlayOnLinux/Mac
IntTabPosn = tonumber(iup_gui.LoadGlobal("TabPosn",IntTabPosn)) -- Legacy V1.8
TblOption = iup_gui.LoadGlobal("Option",TblOption) -- V1.7
TblOption.TabPosition = TblOption.TabPosition or IntTabPosn -- V1.8
TblOption.DateWarning = TblOption.DateWarning or "ON"
TblOption.MaximumAges = TblOption.MaximumAges or 120
TblOption.MinimumYear = TblOption.MinimumYear or 1000
DptMinimum = fhNewDatePt(TblOption.MinimumYear) -- Date Point earliest year check -- V2.0
if general.FlgFileExists(StrGridFile) then
TblGrid, StrErr = table.load(StrGridFile) -- Load Grid table --!
if TblGrid.RepText then -- Load Result Set Exception Report data
for intItem = 1, #TblGrid.RepText do -- Recreate Report Item pointer from Data Ref & Record Id
TblGrid.RepItem[intItem] = general.GetDataRefPtr(TblGrid.DataRef[intItem],TblGrid.RecIdNo[intItem])
end
end
end
SaveSettings() -- Save sticky data settings
end -- function LoadSettings
-- Save Sticky Settings to File --
function SaveSettings()
--# iup_gui.SaveGlobal("TabPosn",IntTabPosn) -- V1.8
iup_gui.SaveGlobal("Option" ,TblOption ) -- V1.7
iup_gui.SaveSettings() -- Includes "Main","Font" dialogues and "FontSet" & "History"
table.save(TblGrid,StrGridFile) -- Save Grid table --!
end -- function SaveSettings
-- Graphical User Interface --
function GUI_MainDialogue()
local strVer = TblGrid.Version or iup_gui.Version -- Check the grid version against GUI version
if strVer ~= iup_gui.Version
or not TblGrid.Base or #TblGrid[TblGrid.Base.Records] < 2 -- V2.0
or not ( TblGrid.MaxRows or TblGrid.Indi.Top or TblGrid.Flag.Top ) then -- Create the data grid of Row & Col headings, etc
local strPlaceRecord, strResearchNote, strSourceTemplate -- V2.2
if fhGetAppVersion() > 5 then strPlaceRecord = "Place" end
if fhGetAppVersion() > 6 then strResearchNote = "Research Note" strSourceTemplate = "Source Template" end
TblGrid = { } -- V2.0 -- New Base field, Couples => Families grid, new Data grid
TblGrid.Base = { Records="Rec"; Individuals="Ind"; Families="Fam"; Flags="Flg"; Facts="Fct"; Data="Dat"; }
TblGrid.Rec = { }
TblGrid.Rec.Col = { "Count "; "Media "; "Cites "; "Links "; "Idents"; "Oldest Update"; "Latest Update"; }
TblGrid.Rec.Row = { "All"; "Individual"; "Family"; "Note"; "Source"; "Repository"; "Multimedia"; strPlaceRecord; strResearchNote; strSourceTemplate; } -- V2.2
table.insert(TblGrid.Rec.Row,"Submitter") table.insert(TblGrid.Rec.Row,"Submission") table.insert(TblGrid.Rec.Row,"Header") -- V2.2
TblGrid.Ind = { }
TblGrid.Ind.Col = { "Count"; }
TblGrid.Ind.Row = { "All"; "Male"; "Female"; "Unknown"; "Parentless"; "Many Parents"; "No Birth"; "No Death"; "Pool 1"; "Pool 2"; } -- Always include two Pool names -- v2.0
TblGrid.Fam = { }
TblGrid.Fam.Col = { "Count"; }
TblGrid.Fam.Row = { "All"; "Both Sex Pairs"; "Same Sex Pairs"; "One Parent"; "No Parents"; "Max. Spouses"; "No Marriage"; "Childless"; "Total Children"; "Ave. Children"; "Max. Children"; } -- V2.0
TblGrid.Flg = { }
TblGrid.Flg.Col = { "Count"; }
TblGrid.Flg.Row = { "All"; "Living"; "Private"; } -- Always include two Flag names
TblGrid.Fct = { }
TblGrid.Fct.Col = { "Count "; "Media "; "Cites "; "Place "; "Addr "; "Age "; "Min. "; "Ave. "; "Max. "; "Age@ "; "Min@ "; "Ave@ "; "Max@ "; "Date "; "Earliest Fact Date "; "Latest Fact Date "; }
TblGrid.Fct.Row = { "All"; "Names"; "Birth"; "Baptism"; "Christening"; "Marriage"; "Divorce"; "Census"; "Occupation"; "Residence"; "Death"; "Burial"; "Cremation"; "All Other"; } -- V2.0
TblGrid.Dat = { }
TblGrid.Dat.Col = { " Fact\nTypes "; "Media\nKeywords"; " Places "; "Addresses"; "Occu-\npations"; "Religions"; "Groups\nCastes"; "National\nOrigins"; "Education\nContexts"; "Physical\nDesc."; "Posse-\nssions "; " Titles "; "National\nId. Nos."; "US Soc.\nSec. Nos."; "Source\nTypes"; } -- V2.0
TblGrid.Dat.Row = { " Totals"; } -- V2.0
TblGrid.Dat.WwD = { } -- Work with Data dictionary -- V2.0
TblGrid.Ind.Top = #TblGrid.Ind.Row - 1 -- Set row sizes for RevealList()
TblGrid.Flg.Top = #TblGrid.Flg.Row - 1
TblGrid.MaxRows = #TblGrid.Fct.Row + #TblGrid.Dat.Row + 1 -- Set max rows for RevealList() based on Facts tab rows -- V2.0
TblGrid.Updated = "Never"
TblGrid.RepName = { } -- Result Set Exception Report data
TblGrid.RepItem = { }
TblGrid.RepText = { }
TblGrid.DataRef = { }
TblGrid.RecIdNo = { }
end
TblObjArea = { } -- Clear FH V7 Object Area array -- V2.3
TblRecords = TblGrid[TblGrid.Base.Records]
TblIndivid = TblGrid[TblGrid.Base.Individuals]
TblFamily = TblGrid[TblGrid.Base.Families]
TblFlags = TblGrid[TblGrid.Base.Flags]
TblFacts = TblGrid[TblGrid.Base.Facts]
TblData = TblGrid[TblGrid.Base.Data]
TblGrid.Version = iup_gui.Version -- Reset grid if version changes
if strVer ~= iup_gui.Version then
iup_gui.MemoDialogue("\n Table Grid"..strVer.."mismatches"..iup_gui.Version.."so a reset is required. \n")
ResetGridCells(TblGrid)
end
for strGrid, strBase in pairs (TblGrid.Base) do -- Create the matrix controls -- V2.0
local tblGrd = TblGrid[strBase] -- V2.0 made local
local tblRow = tblGrd.Row
local tblCol = tblGrd.Col
local intRow = #tblRow
local intCol = #tblCol
local iupMat = iup.matrix {
NumCol=intCol; NumCol_Visible=intCol; NumLin=intRow; NumLin_Visible=intRow; UseTitleSize="YES";
ReadOnly="YES"; Alignment="ARIGHT"; BgColor=iup_gui.Smoke; FrameColor=iup_gui.Smoke; ScrollBar="NO";
HideFocus="YES"; ResizeMatrix="YES"; TipBalloon=iup_gui.Balloon; Tip=strGrid.." related statistics."; }
iupMat:setcell(0,0,strGrid) -- Grid heading text
for intRow = 1, intRow do iupMat:setcell(intRow,0,tblRow[intRow]) end -- Row headings text
for intCol = 1, intCol do iupMat:setcell(0,intCol,tblCol[intCol]) end -- Col headings text
tblGrd.Mat = iupMat -- Save matrix control handle
end
local tblToggle = { } -- GUI Option tab toggle controls -- V1.7
TblAttrib = { -- Toggle Names > 12 chars long do not conflict with other settings
-- 1~Toggle Name ; 2~Title and Tip ; 3~Exception Report Detailed Explanation
{ "CiteDateFormat" ; "Citation Entry Date : format is not valid" ; "Citation Entry Date : " };
{ "CiteDateFuture" ; "Citation Entry Date found in the future" ; "Citation Entry Date found in the future : " };
{ "CiteDateTooOld" ; "Citation Entry Date found too far in past < Earliest Date Year" ; "Citation Entry Date found too far in past : " };
{ "DateNoDayNumber" ; "Date does not provide a Day Number nor Day Of Week" ; "Date does not provide a Day Number nor Day Of Week." }; -- V2.0
{ "DuplicatedBMD" ; "Duplicated BMD event" ; "Duplicated BMD event : " }; -- V2.9
{ "EventLinkFamily" ; "Event has Link to Parents Family via All tab" ; "Event has Link to Parents Family via All tab." };
{ "FactAgeNegative" ; "Fact Age is negative" ; "Fact Age is negative : " };
{ "FactAgeTooLarge" ; "Fact Age is too large > Maximum Age Years" ; "Fact Age is too large : " };
{ "FactDateFormat" ; "Fact Date : format is not valid" ; "Fact Date : " };
{ "FactDateFuture" ; "Fact Date found in the future" ; "Fact Date found in the future : " };
{ "FactDateTooOld" ; "Fact Date found too far in past < Earliest Date Year" ; "Fact Date found too far in past : " };
{ "FactDateSimple" ; "Fact Date is closer/earlier/later/more than ..." ; "^Fact Date is [%a ]+ than .+" }; -- V2.0
{ "FactDatePeriod" ; "Fact Date period extends earlier/later/more than ..." ; "^Fact Date period extends [%a ]+ than .+" }; -- V2.0
{ "FactDateRanges" ; "Fact Date range extends earlier/later/more than ..." ; "^Fact Date range extends [%a ]+ than .+" }; -- V2.0
{ "GenderIndividual" ; "Gender of Individual is undefined" ; "Gender of Individual is undefined." };
{ "IdentAutoRecId" ; "Ident Automatic Record Id" ; "Ident Automatic Record Id : " };
{ "IdentPermRecNo" ; "Ident Permanent Record No" ; "Ident Permanent Record No : " };
{ "LivingFlagDeath" ; "Living Flag despite Death &&/or Burial &&/or Cremation Event" ; "Living Flag despite Death &/or Burial &/or Cremation Event." };
{ "NoBirthBaptism" ; "No Birth, Baptism, or Christening Event" ; "No Birth, Baptism, or Christening Event." };
{ "NoDeathBuryFlag" ; "No Death, Burial, or Cremation Event nor Living Flag" ; "No Death, Burial, or Cremation Event nor Living Flag." };
{ "NoMarriageEvent" ; "No Marriage Event nor Never Married/Unmarried Couple Status" ; "No Marriage Event nor unmarried Status." };
{ "NoParentButChild" ; "No Parents Family but with Children" ; "No Parents Family but with Children." };
{ "NoParentNorChild" ; "No Parents Family without Children" ; "No Parents Family without Children." };
{ "OneParentNoChild" ; "One Parent Family without Children" ; "One Parent Family without Children." };
{ "SpouseDuplicate" ; "Spouse link is duplicated" ; "Spouse link is duplicated." };
{ "UncatDataField" ; "Uncategorised Data Field or UDF" ; "Uncategorised Data Field or UDF." }; -- V2.0
{ "UnusedFlagEntry" ; "Unused Listed Flag : for named flag" ; "Unused Listed Flag : " };
{ "UnusualFormatType" ; "Unusual Multimedia Format versus File Type" ; "Unusual Multimedia Format : " };
{ "UnusualFrameArea" ; "Unusual Multimedia Frame Area for Media File" ; "Unusual Multimedia Frame : " };
{ "UnusualSnapshots" ; "Unusual number of Snapshot files" ; "Unusual number of Snapshot files : " };
}
local function strExceptionReports() -- Title for lblReports control -- V2.0
local intReport = 0
for intText, strText in ipairs ( TblGrid.RepText ) do -- Search through each Exception Report
for intPos, tblAttr in ipairs ( TblAttrib ) do
if strText:match(tblAttr[3]) then -- Only include Report in count -- V2.4
if TblOption[tblAttr[1]] == "ON" then -- if its tick box Option is "ON"
intReport = intReport + 1
end
break
end
end
end
return "Exceptions Detected : "..tostring(#TblGrid.RepText).." Reported : "..tostring(intReport)
end -- local function strExceptionReports
local function strLastUpdated(strUpdate)
TblGrid.Updated = strUpdate or TblGrid.Updated or "Never" -- Set Grid last updated value
return "Statistics Last Updated : "..TblGrid.Updated -- Title for lblUpdated control
end -- local function strLastUpdated
-- Create the controls with title/value and tooltip
local lblProject = iup.label { Title=fhGetContextInfo("CI_PROJECT_NAME"); }
local lblReports = iup.label { Title=strExceptionReports(); } -- V2.0
local lblUpdated = iup.label { Title=strLastUpdated(); }
local lblTickAny = iup.label { Title="Choose which of the Exception Reports to include by ticking or clearing the check boxes below"; }
local btnTickAll = iup.button { Title="Tick every box to Report ALL Exceptions"; }
local btnTickNon = iup.button { Title="Clear every box to Report NO Exceptions"; }
local lblMinYear = iup.label { Title="Earliest Date Year : "; Alignment="ARIGHT"; }
local txtMinYear = iup.text { Spin="YES"; SpinMin=0; SpinMax=2000; SpinAlign="RIGHT"; Alignment="ARIGHT"; }
local lblMaxAges = iup.label { Title="Maximum Age Years : " ; Alignment="ARIGHT"; }
local txtMaxAges = iup.text { Spin="YES"; SpinMin=50; SpinMax=150; SpinAlign="RIGHT"; Alignment="ARIGHT"; }
local tglWarning = iup.toggle { Title=" Detect all the Date Warning Exceptions "; }
local lblWarning = iup.label { Title="Untick to reduce Update Statistics run time for large Projects"; }
local lblDetects = iup.label { Title=strExceptionReports(); Alignment="ACENTER"; } -- V2.4
local btnUpdate = iup.button { Title="Update Statistics"; }
local btnExport = iup.button { Title="Export CSV Files" ; }
local btnDefault = iup.button { Title="Restore Defaults" ; }
local btnSetFont = iup.button { Title="Set Window Fonts" ; }
local btnGetHelp = iup.button { Title=" Help && Advice" ; }
local btnDestroy = iup.button { Title=" Close && Report"; }
-- Create the Records tab layout
local boxRecords = iup.hbox { Gap=iup_gui.Gap; iup.vbox { TblRecords.Mat; lblProject; lblReports; lblUpdated; }; TblIndivid.Mat; TblFamily.Mat; TblFlags.Mat; } -- V2.0
-- Create the Facts tab layout
local boxFacts = iup.hbox { Gap=iup_gui.Gap; iup.vbox { TblFacts.Mat; TblData.Mat; }; } -- V2.0
-- Create the Options tab layout -- V1.8
local boxTickAny = iup.hbox { Homogeneous="YES"; btnTickAll; btnTickNon; Margin="45x10"; Gap="90"; }
local boxToggleL = iup.vbox { Margin="0x0"; }
local boxToggleR = iup.vbox { Margin="0x0"; }
local boxToggles = iup.hbox { Homogeneous="YES"; boxToggleL; boxToggleR; Margin="0x0"; Gap=iup_gui.Gap; } -- V2.4 -- Gap=iup_gui.Gap was "0"
local boxSetSpin = iup.hbox { Homogeneous="YES"; iup.hbox { Homogeneous="YES"; lblMinYear; txtMinYear }; iup.hbox { Homogeneous="YES"; lblMaxAges; txtMaxAges; }; }
-- local boxWarning = iup.hbox { tglWarning; lblWarning; }
local boxOptions = iup.vbox { Gap=iup_gui.Gap; Margin="4x4"; Alignment="ACENTER"; lblTickAny; boxTickAny; boxToggles; boxSetSpin; tglWarning; lblWarning; lblDetects; }
for intPos, tblAttr in ipairs ( TblAttrib ) do -- Add all the Report toggle Option attributes -- V1.7
TblAttrib[tblAttr[1]] = intPos -- Index to Attrib used mainly in MarkCell() but also in parameters to ExceptionReport()
TblOption[tblAttr[1]] = TblOption[tblAttr[1]] or "ON"
tblToggle[tblAttr[1]] = iup.toggle { Title=" "..tblAttr[2]; Tip=tblAttr[2]:gsub("&&","and"); TipBalloon=iup_gui.Balloon; Expand="YES"; } -- V1.8
tblToggle[tblAttr[1]].action = function(self,intState) -- Toggle action -- V2.4
for strName, iupName in pairs ( tblToggle ) do
TblOption[strName] = iupName.Value -- Save all Option toggles -- V1.8
end
lblDetects.Title = strExceptionReports()
return intState
end
if intPos <= #TblAttrib / 2 then
iup.Append( boxToggleL, tblToggle[tblAttr[1]] ) -- Add 1st half of toggles to lefthand column -- V1.8
else
iup.Append( boxToggleR, tblToggle[tblAttr[1]] ) -- Add 2nd half of toggles to righthand column -- V1.8
end
end
-- Create the Tab controls layout
local tabControl = iup.tabs { Font=iup_gui.FontHead; -- Padding="8x4" moved to Controls() -- V2.2
boxRecords; TabTitle0=" Records ";
boxFacts ; TabTitle1=" Facts ";
boxOptions; TabTitle2=" Options ";
}
-- Create the Button controls
local boxButtons = iup.hbox { Homogeneous="YES"; Gap="4"; Margin="4x4"; btnUpdate; btnExport; btnDefault; btnSetFont; btnGetHelp; btnDestroy; }
-- Combine all the above controls
local allControl = iup.vbox { Margin="0x0";
tabControl;
boxButtons;
}
-- Create dialogue with Close button that quits Plugin without Saving Settings nor Exception Report Result Set
local dialogMain = iup.dialog { Title=iup_gui.Plugin..iup_gui.Version; BringFront="YES"; allControl; }
local function setControls() -- Reset GUI control values -- V1.8 renamed & modified
-- # IntRowHeight = iup_gui.FontBody:match("([0-9]+)$") * 2 -- Row pixel height is twice font size (except col header row that is automatic) -- V1.8
IntRowHeight = iup_gui.FontBody:match("([0-9]+)$") -- Row size height is font size (except col header row that is automatic) -- V2.4
for strGrid, strBase in pairs (TblGrid.Base) do -- Loop through all grid cells -- V2.0
local tblGrd = TblGrid[strBase] -- V1.8 made local
local iupMat = tblGrd.Mat -- Get matrix handle
for intRow = 1, #tblGrd.Row do
-- # iupMat["RasterHeight"..intRow] = IntRowHeight -- Pixel height of data rows -- V1.8
iupMat["Height"..intRow] = IntRowHeight -- Size height of data rows -- V2.4
end
for intCol = 1, #tblGrd.Col do
iupMat["Font*:"..intCol] = iup_gui.FontBody -- Row & Col data body font
end
iupMat["Font0:0"] = iup_gui.FontHead -- Grid title head font & colour
iupMat["FgColor0:0"] = iup_gui.Head
iupMat["Font0:*"] = iup_gui.FontBody -- Col header body font & colour
iupMat["FgColor0:*"] = iup_gui.Body
iupMat["Font*:0"] = iup_gui.FontBody -- Row header body font & colour
iupMat["FgColor*:0"] = iup_gui.Body
iupMat.redraw = "ALL"
end
for strName, iupName in pairs ( tblToggle ) do
tblToggle[strName].Value = TblOption[strName] or "ON" -- Load all Option toggles -- V1.7 -- V2.7
end
if fhGetAppVersion() > 6 then -- FH V7 IUP 3.28 -- V2.2
tabControl.TabPadding = "8x4"
else -- FH V6 IUP 3.11 -- V2.2
tabControl.Padding = "8x4"
end
IntTabPosn = TblOption.TabPosition -- V1.8
tabControl.ValuePos = math.max(0,IntTabPosn - 1) -- Adjust tab selection -- 3 Aug 2013
txtMinYear.SpinValue = TblOption.MinimumYear -- Minimum Year for too early Date check
txtMaxAges.SpinValue = TblOption.MaximumAges -- Maximum Age for too large Age check
tglWarning.Value = TblOption.DateWarning -- Enable the Date Warning checks -- V1.8
end -- local function setControls
-- GUI control other attributes
local tblControls = { {"Font";"FgColor";"Expand";"Padding";"Tip"; {"TipBalloon";"Balloon";}; {"help_cb";function() iup_gui.HelpDialogue(IntTabPosn) end;}; setControls; };
[dialogMain] = { "FontBody"; "Info"; "YES"; };
[tabControl] = { "FontHead"; "Head"; "YES"; false; "Show 'Records' or 'Facts' statistics, or review 'Options'"; };
[lblProject] = { "FontHead"; "Head"; "YES"; "9x0"; "Name of the currently open Project"; };
[lblReports] = { "FontHead"; "Head"; "YES"; "9x0"; "Number of Exceptions Detected and number Reported in Result Set"; };
[lblUpdated] = { "FontHead"; "Head"; "YES"; "9x0"; "Latest statistics update date and time"; };
[boxOptions] = { "FontBody"; "Info"; "NO" ; };
[lblTickAny] = { "FontBody"; "Body"; "NO" ; "0x0"; "Choose which of the Exception Reports to include"; };
[btnTickAll] = { "FontBody"; "Safe"; "YES"; "0x0"; "Include all the Exception Reports"; };
[btnTickNon] = { "FontBody"; "Risk"; "YES"; "0x0"; "Exclude all the Exception Reports"; };
[lblMinYear] = { "FontBody"; "Body"; "NO" ; "4x0"; "Set earliest year for any Dates"; }; -- was YES -- V2.4
[txtMinYear] = { "FontBody"; "Safe"; "NO" ; "4x0"; "Set earliest year for any Dates"; };
[lblMaxAges] = { "FontBody"; "Body"; "NO" ; "4x0"; "Set maximum years for any Ages"; }; -- was YES -- V2.4
[txtMaxAges] = { "FontBody"; "Safe"; "NO" ; "4x0"; "Set maximum years for any Ages"; };
[tglWarning] = { "FontBody"; "Body"; "NO" ; "0x0"; "Detect all the Date Warning Exceptions, but those that are\n'found in the future' or 'found too far in past' are unconditional\n(Untick to reduce Update Statistics run time for large Projects)"; };
[lblWarning] = { "FontBody"; "Body"; "NO" ; "0x0"; "Detect all the Date Warning Exceptions, but those that are\n'found in the future' or 'found too far in past' are unconditional\n(Untick to reduce Update Statistics run time for large Projects)"; };
[lblDetects] = { "FontHead"; "Head"; "YES"; "9x4"; "Number of Exceptions Detected and number Reported in Result Set"; };
[btnUpdate] = { "FontBody"; "Safe"; "YES"; "4x0"; "Update all the project statistics and\nthe Result Set Exception Report"; };
[btnExport] = { "FontBody"; "Safe"; "YES"; "4x0"; "Export the statistics to CSV files"; };
[btnDefault] = { "FontBody"; "Safe"; "YES"; "4x0"; "Clear the statistics, reset the options, and centralise windows"; };
[btnSetFont] = { "FontBody"; "Safe"; "YES"; "4x0"; "Alter the window interface font styles and colours"; };
[btnGetHelp] = { "FontBody"; "Safe"; "YES"; "4x0"; "Access the online Help and Advice pages"; };
[btnDestroy] = { "FontBody"; "Risk"; "YES"; "4x0"; "Close the Plugin and show the\n Result Set Exception Report"; };
}
local function saveOptions() -- V1.7 Save all GUI settings
for strName, iupName in pairs ( tblToggle ) do
TblOption[strName] = iupName.Value -- Save all Option toggles -- V1.8
end
TblOption.TabPosition = IntTabPosn -- V1.8
TblOption.DateWarning = tostring(tglWarning.Value) -- Enable/Disable Date Warning checks
TblOption.MaximumAges = tonumber(txtMaxAges.SpinValue) -- Maximum Age for too large Age check
TblOption.MinimumYear = tonumber(txtMinYear.SpinValue) -- Minimum Year for too early Date check
DptMinimum = fhNewDatePt(TblOption.MinimumYear)
SaveSettings() -- Save sticky data settings
end -- local function saveOptions
function btnTickAll:action() -- Action for Tick every box to Report ALL Exceptions button
for strName, iupName in pairs ( tblToggle ) do
iupName.Value = "ON" -- V1.8
TblOption[strName] = "ON"
end
lblDetects.Title = strExceptionReports() -- V2.4
end -- function btnTickAll:action
function btnTickNon:action() -- Action for Clear every box to Report NO Exceptions button
for strName, iupName in pairs ( tblToggle ) do
iupName.Value = "OFF" -- V1.8
TblOption[strName] = "OFF"
end
lblDetects.Title = strExceptionReports() -- V2.4
end -- function btnTickNon:action
function btnUpdate:action() -- Action for Update Statistics button
boxButtons.Active = "NO"
dialogMain.Active = "NO"
saveOptions()
if UpdateStatistics(TblGrid) then
ShowStatistics(TblGrid)
lblUpdated.Title = strLastUpdated(os.date()) -- Update OK so record date & time
else
ResetGridCells(TblGrid) -- Update stopped so reset statistics grid
lblUpdated.Title = strLastUpdated("Never")
end
lblReports.Title = strExceptionReports() -- Update number of Exceptions Detected -- V2.0
lblDetects.Title = strExceptionReports() -- V2.4
SaveSettings() -- Save sticky data settings
dialogMain.Active = "YES"
dialogMain.BringFront = "YES"
boxButtons.Active = "YES"
end -- function btnUpdate:action
function btnExport:action() -- Action for Export Statistics button
boxButtons.Active = "NO"
ExportStatistics(TblGrid)
boxButtons.Active = "YES"
end -- function btnExport:action
function btnDefault:action() -- Action for Restore Defaults button
general.DeleteFile(iup_gui.ProjectRoot..".dat") -- V2.7
iup_gui.LoadSettings() -- V2.7
TblOption = {} -- V2.7
ResetDefaultSettings()
ResetGridCells(TblGrid) -- Reset statistics grid
lblReports.Title = strExceptionReports()
lblDetects.Title = strExceptionReports() -- V2.4
lblUpdated.Title = strLastUpdated("Never")
setControls() -- Reset controls & redisplay Main dialogue
iup_gui.ShowDialogue("Main")
SaveSettings() -- Save sticky data settings
end -- function btnDefault:action
function btnSetFont:action() -- Action for Set Interface Font button
btnSetFont.Active = "NO"
iup_gui.FontDialogue(tblControls,"Main")
SaveSettings() -- Save sticky data settings
btnSetFont.Active = "YES"
end -- function btnSetFont:action
function btnSetFont:button_cb(intButton,intPress) -- Action for mouse right-click on Set Window Fonts button
if intButton == iup.BUTTON3 and intPress == 0 then
iup_gui.BalloonToggle() -- Toggle tooltips Balloon mode
end
end -- function btnSetFont:button_cb
local function doExecute(strExecutable, strParameter) -- Invoke FH Shell Execute API -- V2.2
local function ReportError(strMessage)
iup_gui.WarnDialogue( "Shell Execute Error",
"ERROR: "..strMessage.." :\n"..strExecutable.."\n"..strParameter.."\n\n",
"OK" )
end -- local function ReportError
return general.DoExecute(strExecutable, strParameter, ReportError)
end -- local function doExecute
local strHelp = "https://pluginstore.family-historian.co.uk/page/help/show-project-statistics"
local arrHelp = { "-records-tab"; "-facts-tab"; "-options-tab"; }
function btnGetHelp:action() -- Action for Help & Advice button according to current tab -- V2.2
local strPage = arrHelp[IntTabPosn] or ""
doExecute( strHelp..strPage )
fhSleep(3000,500)
dialogMain.BringFront="YES"
end -- function btnGetHelp:action
function btnDestroy:action() -- Action for Close Plugin button
saveOptions() -- V1.7 Save options
local tblRepName = {}
local tblRepItem = {}
local tblRepText = {}
for intText, strText in ipairs ( TblGrid.RepText ) do -- Search through each Exception Report
for intPos, tblAttr in ipairs ( TblAttrib ) do
if strText:match(tblAttr[3]) then -- Only include Report in Result Set
if TblOption[tblAttr[1]] == "ON" then -- if its tick box Option is "ON"
table.insert(tblRepName,TblGrid.RepName[intText])
table.insert(tblRepItem,TblGrid.RepItem[intText])
table.insert(tblRepText,TblGrid.RepText[intText])
end
break
end
end
end
if tblRepText and #tblRepText > 0 then -- Output Exception Report Result Set data
fhOutputResultSetTitles(iup_gui.Plugin..iup_gui.Version.."Exceptions Report")
fhOutputResultSetColumn("Individual / Family / Fact / Media Item" ,"text",tblRepName,#tblRepText,200,"align_left",0)
fhOutputResultSetColumn("Individual / Family / Fact / Media Buddy" ,"item",tblRepItem,#tblRepText,200,"align_left",0,true,"default","buddy") -- V1.5 addition
fhOutputResultSetColumn("Exception Report Detailed Explanation" ,"text",tblRepText,#tblRepText,380,"align_left",1)
end
return iup.CLOSE
end -- function btnDestroy:action
function tabControl:tabchangepos_cb(intNew,intOld) -- Call back when Main tab position is changed
IntTabPosn = intNew + 1 -- 3 Aug 2013
saveOptions() -- V1.7 Save options
if intOld == 2 then
ShowStatistics(TblGrid) -- V1.7 Update display in case Options changed
lblReports.Title = strExceptionReports() -- V2.4
end
end -- function tabControl:tabchangepos_cb
iup_gui.ShowDialogue("Main",dialogMain,btnDestroy,"map") -- Map needed to honour setting tabControl.ValuePos within iup_gui.AssignAttributes
iup_gui.AssignAttributes(tblControls) -- Assign GUI control attributes
ShowStatistics(TblGrid) -- Display the statistics grids, and show fixed size dialogue, and optionally Version History Help
iup_gui.ShowDialogue("Main")
TblData.WwD = {} -- Clear Work with Data dictionary of names used -- V2.0
end -- function GUI_MainDialogue
function ExceptionReport(ptrName,ptrItem,strText) -- Update Result Set Exception Report data
table.insert(TblGrid.RepName,fhGetDisplayText(ptrName)) -- Individual/Family Couple/Fact Item display name for V1.7
table.insert(TblGrid.RepItem,ptrItem:Clone()) -- Individual/Family Couple/Fact Item buddy pointer for V1.5
table.insert(TblGrid.RepText,strText) -- Exception Report Text
local strRef = ""
local intRec = 0 -- Avoid debug mode printing "is Invalid" for Unused Flags with null ptrItem
if ptrItem:IsNotNull() then strRef, intRec = general.BuildDataRef(ptrItem) end -- Convert the Item pointer to Data Ref & Record Id
table.insert(TblGrid.DataRef,strRef) -- because userdata pointers cannot be saved to file
table.insert(TblGrid.RecIdNo,intRec)
end -- function ExceptionReport
function TidyTitle(strTitle) -- Tidy title -- V2.0
strTitle = strTitle:gsub("^ *(.-) *$","%1") -- Remove leading & trailing spaces
strTitle = strTitle:replace("-\n","") -- Remove hyphen newline
strTitle = strTitle:replace("\n"," ") -- Replace newline with space
return strTitle
end -- function TidyTitle
function ResetGridCells(tblGrid) -- Reset each Grid and empty the cells
for strGrid, strBase in pairs (tblGrid.Base) do -- Loop through all grid cells -- V2.0
local tblGrd = tblGrid[strBase] -- V1.8 made local
for intRow, strRow in ipairs (tblGrd.Row) do
strRow = TidyTitle(strRow)
tblGrd.Row[strRow] = intRow -- Row lookup dictionary using tidied title -- V1.8 -- V2.0
tblGrd[intRow] = {}
for intCol, strCol in ipairs (tblGrd.Col) do
if intRow == 1 then
strCol = TidyTitle(strCol)
tblGrd.Col[strCol] = intCol -- Col lookup dictionary using tidied title -- V1.8 -- V2.0
if tblGrd.WwD then tblGrd.WwD[strCol] = {} end -- Empty Work with Data dictionary of names used -- V2.0
end
tblGrd[intRow][intCol] = nil -- Empty all grid cells
end
end
tblGrd.Err = nil -- Clear all error colours
end
TblIndivid.Flag = {} -- Clear internal Flag statistics -- V2.0
TblIndivid.Pool = {} -- Clear internal Pool statistics -- V2.0
TblFlags.Living = nil -- Clear Living Flag exception signal -- V2.0
tblGrid.RepName = {} -- Added V1.6 correction for 'buddy' pointers
tblGrid.RepItem = {}
tblGrid.RepText = {} -- Clear the Result Set Exception Report data
tblGrid.DataRef = {}
tblGrid.RecIdNo = {}
ShowStatistics(tblGrid)
end -- function ResetGridCells
function ShowStatistics(tblGrid) -- Display each Grid in each GUI Matrix
for strGrid, strBase in pairs (tblGrid.Base) do -- Loop through all grid cells -- V2.0
local tblGrd = tblGrid[strBase]
if tblGrd.Mat then
for intRow, strRow in ipairs (tblGrd.Row) do
for intCol, strCol in ipairs (tblGrd.Col) do
local strBak = iup_gui.Smoke -- Empty cell background colour
local strErr = nil -- Empty cell foreground colour
local strVal = nil -- Empty cell nil value
if tblGrd[intRow] and tblGrd[intRow][intCol] then
strBak = iup_gui.White -- Data cell background colour
strVal = tblGrd[intRow][intCol] -- Data cell statistic value
if tblGrd.Err and tblGrd.Err[intRow] and tblGrd.Err[intRow][intCol] then
local intMark = tblGrd.Err[intRow][intCol]["Mark"] or 0 -- Quantity of all exception reports -- V1.7
for strName, intName in pairs ( tblGrd.Err[intRow][intCol] ) do
if TblOption[strName] == "OFF" then
intMark = intMark - intName -- Subtract quantity for disabled reports -- V1.7
end
end
if intMark > 0 then strErr = iup_gui.Risk end -- Data cell foreground error colour
end
end
tblGrd.Mat["bgcolor"..intRow..":"..intCol] = strBak
tblGrd.Mat["fgcolor"..intRow..":"..intCol] = strErr
tblGrd.Mat:setcell(intRow,intCol,strVal)
end
end
tblGrd.Mat.redraw = "ALL"
end
end
iup_gui.RefreshDialogue("Main") -- V1.8 -- V2.0 -- Resizes window for large Flag names
end -- function ShowStatistics
function MarkCell(tblGrd,anyRow,anyCol,strOpt) -- Mark the single Cell to signal exception
local intRow = anyRow
local strRow = anyRow
local intCol = anyCol
local strCol = anyCol
if not tonumber(anyRow) then intRow = tblGrd.Row[strRow] end -- If Row not numeric then assume Row Name
if not tonumber(anyCol) then intCol = tblGrd.Col[strCol] end -- If Col not numeric then assume Col Name
for _, intRow in ipairs ({ intRow; tblGrd.Row["All"]; }) do -- Repeat for chosen cell and "All" row cell -- V2.0
if not tblGrd.Err then tblGrd.Err = {} end
if not tblGrd.Err[intRow] then tblGrd.Err[intRow] = {} end
if not tblGrd.Err[intRow][intCol] then tblGrd.Err[intRow][intCol] = {} end
local tblError = tblGrd.Err[intRow][intCol]
tblError["Mark"] = ( tblError["Mark"] or 0 ) + 1 -- Quantity of marked exception reports -- V1.7
tblError[strOpt] = ( tblError[strOpt] or 0 ) + 1 -- Quantity to hide if Option is chosen -- V1.7
end
return TblAttrib[TblAttrib[strOpt]][3] -- Return the Exception Report Detailed Explanation text
end -- function MarkCell
function GetCell(tblGrd,strRow,strCol) -- Get the value of a single Cell
return tblGrd[tblGrd.Row[strRow]][tblGrd.Col[strCol]] or 0
end -- function GetCell
function SetCell(tblGrd,strRow,strCol,strVal) -- Set the value of a single Cell
tblGrd[tblGrd.Row[strRow]][tblGrd.Col[strCol]] = strVal
end -- function SetCell
function UpdateCount(tblGrd,strRow,strCol,intAdd,isAll) -- Update the Count of a single Cell and often the "All" cell above
local intRow = tblGrd.Row[strRow] or 0 -- !
local intCol = tblGrd.Col[strCol] or 0 -- !
tblGrd[intRow][intCol] = ( tblGrd[intRow][intCol] or 0 ) + ( intAdd or 1 ) -- Update single cell -- V2.0
intRow = tblGrd.Row["All"]
if intRow and ( #tblGrd.Col > 1 or isAll ) then -- Row "All" exists, and more than one column or "All" is forced
tblGrd[intRow][intCol] = ( tblGrd[intRow][intCol] or 0 ) + ( intAdd or 1 ) -- Update "All" cell -- V2.0
end
end -- function UpdateCount
function CheckDayNumber(ptrRef,ptrDat,datDat,tblGrd,intRow) -- Check Day Number -- V2.0
local dptDat1 = datDat:GetDatePt1()
local intDay1 = fhCallBuiltInFunction("DayNumber",dptDat1) -- Check 1st Date Point
local dptDat2 = datDat:GetDatePt2()
local intDay2 = 0
if not dptDat2:IsNull() then
intDay2 = fhCallBuiltInFunction("DayNumber",dptDat2) -- Check 2nd Date Point if any
end
if not (intDay1 and intDay2) then -- Report a Date without a Day Number -- V2.0
local strWarn = "DateNoDayNumber"
if ptrRef:IsSame(ptrDat) then
strWarn = TblAttrib[TblAttrib[strWarn]][3] -- Media Date or Source Data Event Date only needs a warning
else
strWarn = MarkCell(tblGrd,intRow,tblGrd.Col["Date"],strWarn) -- Fact/Citation Date needs cell marked too
end
ExceptionReport(ptrRef,ptrDat,strWarn)
end
end -- function CheckDayNumber
function UpdateDate(tblGrd,datDat,strRow,strMin,strMax,ptrRef,strOpt,ptrDat) -- Update the Oldest/Latest Update & Earliest/Latest Date cells & check for Date warnings
if not datDat:IsNull() then
local dptDat = datDat:GetDatePt1() -- Use Date Point Compare -- V2.0
local strDat = datDat:GetDisplayText("ABBREV") -- V2.0
local intRow = tblGrd.Row[strRow]
local intMin = tblGrd.Col[strMin]
local intMax = tblGrd.Col[strMax]
if intMin ~= intMax then -- Oldest/Earliest & Latest Date cells
local datMin = fhNewDate(9999) -- Minimum Date
local datMax = fhNewDate(0001) -- Maximum date
for _, intRow in ipairs ({ intRow; tblGrd.Row["All"]; }) do -- Repeat for chosen cell and "All" row cell -- V2.0
datMin:SetValueAsText(tblGrd[intRow][intMin] or "9999",true)
if dptDat:Compare(datMin:GetDatePt1()) < 0 then -- Use Date Point Compare -- V2.0
tblGrd[intRow][intMin] = strDat -- Set minimum Date so far
end
datMax:SetValueAsText(tblGrd[intRow][intMax] or "0001",true)
if dptDat:Compare(datMax:GetDatePt1()) > 0 then -- Use Date Point Compare -- V2.0
tblGrd[intRow][intMax] = strDat -- Set maximum Date so far
end
end
end
if ptrRef and dptDat:Compare(DptMinimum) < 0 then -- Report a Fact Date/Citation Entry Date found before earliest year
ExceptionReport(ptrRef,ptrDat, -- V1.7 & V1.6 ptrDat was ptrRef
MarkCell(tblGrd,intRow,intMin,strOpt.."DateTooOld")..strDat)
end
if ptrRef and dptDat:Compare(DptToday) > 0 then -- Report a Fact Date/Citation Entry Date found in the future
ExceptionReport(ptrRef,ptrDat, -- V1.7 & V1.6 ptrDat was ptrRef
MarkCell(tblGrd,intRow,intMax,strOpt.."DateFuture")..strDat)
end
if ptrDat and TblOption.DateWarning == "ON" then -- Check for Date warnings -- V1.7 tglWarnings
local strWarn = fhCallBuiltInFunction("GetDataWarning",ptrDat,1)
if strWarn ~= "" then
local intCol = intMin
if intMin ~= intMax then intCol = tblGrd.Col["Date"] end -- V2.0
if strWarn:match("^Date range ") then
MarkCell(tblGrd,intRow,intCol,"FactDateRanges") -- Report a Fact Date Range warning
strWarn = "Fact "..strWarn
elseif strWarn:match("^Period ") then
MarkCell(tblGrd,intRow,intCol,"FactDatePeriod") -- Report a Fact Date Period warning
strWarn = strWarn:gsub("^Period ","Fact Date period ")
elseif strWarn:match("^Date is ") then
MarkCell(tblGrd,intRow,intCol,"FactDateSimple") -- Report a Fact simple Date warning
strWarn = "Fact "..strWarn
else
MarkCell(tblGrd,intRow,intCol,strOpt.."DateFormat") -- Report a Fact Date/Citation Entry Date not valid
if strOpt == "Cite" then strOpt = "Citation Entry" end
strWarn = strOpt.." Date : "..strWarn
end
ExceptionReport(ptrRef,ptrDat,strWarn) -- V1.7 & V1.6 ptrDat was ptrRef
end
if not strWarn:match("is not a valid day number") then -- Avoid duplicated reports for invalid Date
CheckDayNumber(ptrRef,ptrDat,datDat,tblGrd,intRow) -- Check Day Number -- V2.0
end
end
end
end -- function UpdateDate
function ReportAge(tblGrd,intAge,intRow,intVal,strOpt,ptrRef,ptrVal) -- Report Age Exception -- V2.0
local strAge = tostring(intAge).." yrs"
if not ptrRef:IsSame(ptrVal) then
strAge = fhGetValueAsText(ptrVal) -- Use actual Age text
end
ExceptionReport(ptrRef,ptrVal,
MarkCell(tblGrd,intRow,intVal,strOpt)..strAge) -- V1.7
end -- function ReportAge
function UpdateAge(tblGrd,intAge,strRow,strNum,strMin,strAve,strMax,ptrRef,ptrVal) -- Update the Age cells statistics V1.7 added ptrVal
if intAge then
local intRow = tblGrd.Row[strRow]
local intNum = tblGrd.Col[strNum]
local intAve = tblGrd.Col[strAve]
local intMin = tblGrd.Col[strMin]
local intMax = tblGrd.Col[strMax]
if intAge < 0 then -- Report negative Fact Age
intAge = intAge - 1 -- Bug fix for AgeAt getting -ve Ages wrong !!!!!!!!!!!!!!!!!!???????
ReportAge(tblGrd,intAge,intRow,intMin,"FactAgeNegative",ptrRef,ptrVal) -- V2.0
elseif intAge > TblOption.MaximumAges then -- Report too large Fact Age
ReportAge(tblGrd,intAge,intRow,intMax,"FactAgeTooLarge",ptrRef,ptrVal) -- V2.0
elseif intAge > 0 and strRow == "Birth" then -- Report too large Birth Age -- V2.0
ReportAge(tblGrd,intAge,intRow,intNum,"FactAgeTooLarge",ptrRef,ptrVal) -- V2.0
end
tblGrd[intRow][intAve] = ( tblGrd[intRow][intAve] or 0 ) + intAge -- Accumulate value of Ages for averaging later
intAge = math.floor(intAge + 0.5) -- V2.0 -- Absolute integer value
for _, intRow in ipairs ({ intRow; tblGrd.Row["All"]; }) do -- Repeat for chosen cell and "All" row cell -- V2.0
tblGrd[intRow][intNum] = ( tblGrd[intRow][intNum] or 0 ) + 1 -- Increment count of Ages detected, and set min & max
tblGrd[intRow][intMin] = math.min( ( tblGrd[intRow][intMin] or 999 ), intAge )
tblGrd[intRow][intMax] = math.max( ( tblGrd[intRow][intMax] or 000 ), intAge )
end
end
end -- function UpdateAge
function UpdateWorkWithData(strCol,anyDat) -- Count each new Work with Data value, etc -- V2.0
local tblGrd = TblData
local strDat = anyDat
if type(anyDat) == "userdata" then -- Data string, or Data pointer (userdata)
strDat = fhGetValueAsText(anyDat)
end
if #strDat > 0 and not tblGrd.WwD[strCol][strDat] then -- Has this value already been found?
tblGrd.WwD[strCol][strDat] = true
UpdateCount(tblGrd,"Totals",strCol) -- No, it is a new value to be counted -- V2.0
end
end -- function UpdateWorkWithData
function UpdateList(tblList,anyLeaf) -- Update a Pool/Flag list leaf
local intLeaf = anyLeaf
local strLeaf = anyLeaf
if tonumber(anyLeaf) then -- Numeric leaf is Pool number in leaf order
strLeaf = "Pool "..intLeaf
tblList[intLeaf] = strLeaf
else -- Otherwise create new Flag leaf name to be sorted later
strLeaf = strLeaf:gsub("^All$"," All") -- Ensure the Flag "All" is distinct from row "All" -- V2.0
if not tblList[strLeaf] then
table.insert(tblList,strLeaf)
end
end
tblList[strLeaf] = ( tblList[strLeaf] or 0 ) + 1 -- Increment leaf count
end -- function UpdateList
function SetGridLastRow(tblGrd) -- Set a Grid new last Row
local intRow = #tblGrd.Row -- Row number
local strRow = tblGrd.Row[intRow] -- Row heading
if not tblGrd[intRow] then tblGrd[intRow] = {} end -- Row of cells
tblGrd.Row[strRow] = intRow -- Row lookup dictionary entry
if tblGrd.Mat then
tblGrd.Mat.numlin = intRow -- Matrix control adjustments
tblGrd.Mat.numlin_visible = intRow
-- # tblGrd.Mat["RasterHeight"..intRow] = IntRowHeight
tblGrd.Mat["Height"..intRow] = IntRowHeight -- V2.4
tblGrd.Mat:setcell( intRow, 0, strRow )
end
end -- function SetGridLastRow
function RevealList(tblGrid,tblGrd,tblList,strFlag) -- Display list of Pools/Flags
local intTopRow = tblGrd.Top -- Top row number in Grid for Pools/Flags list
local intMaxRow = tblGrid.MaxRows -- Max row number in Grid
for intRow = intTopRow, intMaxRow do
local strRow = tblGrd.Row[intRow] -- Clear the Pool/Flag grid cells
if tblGrd.Row[strRow] then
tblGrd.Row[strRow] = nil
tblGrd.Row[intRow] = nil
end
end
SetGridLastRow(tblGrd)
intTopRow = intTopRow - 1 -- Row number in Grid above Pools/Flags list
if #tblList > 0 then
local intMiddle = intMaxRow + 1
local intSpaces = intMaxRow - intTopRow -- Spaces provided for Pools/Flags
local intExcess = #tblList - intSpaces -- Excess quantity of Pools/Flags
if intExcess > 0 then
intMiddle = math.ceil( ( intSpaces + 1 ) / 2 ) + intTopRow -- Middle row to accumulate excess Pools/Flags
end
local intOthers = intMaxRow - intMiddle -- Others value to identify excess Pools/Flags
local strMiddle
local isPool = tblList[1]:match("Pool") -- V2.0
if isPool then
strMiddle = "Pool "..intMiddle-intTopRow.." - "..#tblList-intOthers -- Middle Pool row name is "Pool 3 - 99"
else
strMiddle = tostring(intExcess + 1).." other Flags" -- Middle Flag row name is "99 other Flags"
end
for intLeaf = 1, #tblList do
local strName = tblList[intLeaf] -- Pool/Flag name
local intName = tblList[strName] -- Pool/Flag count
local intRow = intTopRow + intLeaf -- Row number
if intRow >= intMiddle then
intRow = intRow - intExcess -- Reduce row by Excess once past Middle row
if #tblList - intLeaf >= intOthers then
intRow = intMiddle -- Middle row accumulates all other Pools/Flags
strName = strMiddle
end
end
if tblGrd.Row[intRow] ~= strName then
tblGrd.Row[intRow] = strName -- Make new Pool/Flag name row
tblGrd.Row[intRow+1] = nil
SetGridLastRow(tblGrd)
end
UpdateCount(tblGrd,strName,"Count",intName,(not isPool)) -- Increment Pool/Flag statistics -- V2.0
if strName == strFlag then
MarkCell(tblGrd,strName,"Count","LivingFlagDeath") -- Mark exception for Flag name (Living Flag despite Death/Burial/Cremation Event)
end
end
end
end -- function RevealList
function UpdateAddress(ptrRef) -- Count each Work with Data Address value (ADDR) -- V2.0
UpdateWorkWithData("Addresses",ptrRef)
end -- function UpdateAddress
function UpdateMedia(ptrRef,tblGrd,strRow) -- Count the Media links (OBJE) -- V2.0
local ptrObj = fhGetValueAsLink(ptrRef)
local intRid = fhGetRecordId(ptrObj)
UpdateCount(tblGrd,strRow,"Media")
ptrRef:MoveToFirstChildItem(ptrRef)
while ptrRef:IsNotNull() do
if fhGetTag(ptrRef) == "_AREA" then -- Save _AREA dimensions for later CheckMedia(...) function -- V2.3
if not TblObjArea[intRid] then
TblObjArea[intRid] = {}
end
table.insert(TblObjArea[intRid],{ Link=ptrRef:Clone(); Area=fhGetValueAsText(ptrRef); })
end
ptrRef:MoveNext()
end
end -- function UpdateMedia
function UpdateLMO(ptrRef,tblGrd,strRow) -- Handle the Local Media (OBJE2) -- V2.0
UpdateCount(tblGrd,strRow,"Media")
CheckMedia(ptrRef,tblGrd,strRow,"Media") -- Check media Format versus File type, etc -- V1.8
end -- function UpdateLMO
function UpdateCustomId(ptrRef,tblGrd,strRow) -- Count the Custom Idents (REFN)
UpdateCount(tblGrd,strRow,"Idents")
end -- function UpdateCustomId
function UpdatePermRecNo(ptrRef,tblGrd,strRow,ptrRec) -- Handle Permanent Rec Nos (RFN)
UpdateCount(tblGrd,strRow,"Idents")
ExceptionReport(ptrRec,ptrRef,
MarkCell(tblGrd,strRow,"Idents","IdentPermRecNo")..fhGetValueAsText(ptrRef))
end -- function UpdatePermRecNo
function UpdateAutoRecId(ptrRef,tblGrd,strRow,ptrRec) -- Handle Automatic Rec Ids (RIN)
UpdateCount(tblGrd,strRow,"Idents")
ExceptionReport(ptrRec,ptrRef,
MarkCell(tblGrd,strRow,"Idents","IdentAutoRecId")..fhGetValueAsText(ptrRef))
end -- function UpdateAutoRecId
function FindCitations(ptrOld,tblGrd,strRow) -- Find Source Citations on Notes, etc
local ptrRef = fhNewItemPtr() -- Loop through each tag
ptrRef:MoveToFirstChildItem(ptrOld)
while ptrRef:IsNotNull() do
local strTag = fhGetTag(ptrRef)
if strTag == "SOUR" then -- Found a Source Citation (SOUR)
FoundCitation(ptrRef,tblGrd,strRow)
elseif strTag == "SOUR2" then -- Found a Source Note (SOUR2)
FindAnyNotes(ptrRef,tblGrd,strRow)
end
ptrRef:MoveNext()
end
end -- function FindCitations
function FindAnyNotes(ptrOld,tblGrd,strRow) -- Find any local Note or Note record link
local ptrRef = fhNewItemPtr() -- Loop through each tag
ptrRef:MoveToFirstChildItem(ptrOld)
while ptrRef:IsNotNull() do
if fhGetTag(ptrRef):match("^NOTE") then -- Found a Note (NOTE,NOTE2)
FindCitations(ptrRef,tblGrd,strRow)
end
ptrRef:MoveNext()
end
end -- function FindAnyNotes
function DuplicatedBMD(ptrRef,tblGrd,strRow,dicBMD) -- Report duplicated BMD events -- V2.9
local strTag = fhGetTag(ptrRef)
dicBMD[strTag] = (dicBMD[strTag] or 0) + 1
if dicBMD[strTag] > 1 then
ExceptionReport(ptrRef,ptrRef,
MarkCell(tblGrd,strRow,"Count","DuplicatedBMD")..strRow)
end
end -- function DuplicatedBMD
function FoundCitationPrototype() -- Process any Citation (SOUR)
local function doDataDate(ptrRef,tblGrd,strRow) -- Process Entry Date (DATA.DATE)
local ptrDat = fhGetItemPtr(ptrRef,"~.DATE")
if ptrDat:IsNotNull() then
local datDat = fhGetValueAsDate(ptrDat)
UpdateDate(tblGrd,datDat,strRow,"Cites","Cites",ptrDat,"Cite",ptrDat) -- Check any Citation Entry Date
end
end -- local function doDataDate
local dicWhat = -- Tag actions invoked by FoundCitation()
{
DATA = doDataDate ;
NOTE = FindCitations ;
NOTE2 = FindCitations ;
OBJE = UpdateMedia ;
OBJE2 = UpdateLMO ;
}
local function FoundCitation(ptrOld,tblGrd,strRow) -- Process any Citation (SOUR)
local ptrRef = fhNewItemPtr() -- Loop through each tag
ptrRef:MoveToFirstChildItem(ptrOld)
while ptrRef:IsNotNull() do
local action = dicWhat[fhGetTag(ptrRef)] or CheckIsUDF -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow) -- Protect ptrRef against change by action -- V2.5
ptrRef:MoveNext()
end
UpdateCount(tblGrd,strRow,"Cites") -- Count each Citation
end -- local function FoundCitation
return FoundCitation
end -- function FoundCitationPrototype
function CheckIsUDF(ptrRef,tblGrd,strRow) -- Check if tag is a UDF
if fhIsUDF(ptrRef) then
ExceptionReport(ptrRef,ptrRef,
MarkCell(tblGrd,strRow,"Count","UncatDataField"))
end
end -- function CheckIsUDF
function CheckIsFact(ptrRef,tblGrd,strRow,...) -- Check if tag is a Fact
if fhIsFact(ptrRef) then
UpdateFact(ptrRef,TblFacts,"All Other",...)
else
CheckIsUDF(ptrRef,tblGrd,strRow)
end
end -- function CheckIsFact
function UpdateFactPrototype() -- Analyse Fact (Event & Attribute) Prototype
local datDat = fhNewDate() -- Fact Date value
local function doDate(ptrRef,tblGrd,strRow,ptrOld) -- Process each Fact Date (DATE)
datDat = fhGetValueAsDate(ptrRef) -- datDat is also used by Age At Date below
UpdateDate(tblGrd,datDat,strRow,"Earliest Fact Date","Latest Fact Date",ptrOld,"Fact",ptrRef)
UpdateCount(tblGrd,strRow,"Date") -- Count each Date
end -- local function doDate
local function doSortDate(ptrRef,tblGrd,strRow,ptrOld) -- Process each Fact Sort Date (_SDATE) -- V2.9
local datDat = fhGetValueAsDate(ptrRef)
UpdateDate(tblGrd,datDat,strRow,"Earliest Fact Date","Latest Fact Date",ptrOld,"Fact",ptrRef)
end -- local function doSortDate
local function doAge(ptrRef,tblGrd,strRow,ptrOld) -- Process each Fact Age (AGE)
local strAge = fhGetValueAsText(ptrRef) -- Obtain the Age in days, months, years -- V2.0
local intDay = (tonumber(strAge:match("([0-9]*) dy")) or 0) / 365
local intMon = (tonumber(strAge:match("([0-9]*) mn")) or 0) / 12
local intAge = (tonumber(strAge:match("([0-9]*) yr")) or 0) -- V2.0
intAge = intAge + intMon + intDay -- Age in years with months & days as fractions -- V2.0
UpdateAge(tblGrd,intAge,strRow,"Age","Min.","Ave.","Max.",ptrOld,ptrRef)
end -- local function doAge
local function doSpouse(ptrRef,tblGrd,strRow,ptrOld) -- Process each Fact Spouse (HUSB,WIFE) -- V2.0
local ptrAge = fhGetItemPtr(ptrRef,"~.AGE")
if ptrAge:IsNotNull() then
doAge(ptrAge,tblGrd,strRow,ptrOld)
end
end -- local function doSpouse
local function doPlace(ptrRef,tblGrd,strRow) -- Process each Fact Place (PLAC,_PLAC) -- V2.0
UpdateCount(tblGrd,strRow,"Place") -- Count any Place fields
UpdateWorkWithData("Places",ptrRef) -- Count each Work with Data Place value -- V2.0
FindAnyNotes(ptrRef,tblGrd,strRow)
FindCitations(ptrRef,tblGrd,strRow)
end -- local function doPlace
local function doAddress(ptrRef,tblGrd,strRow) -- Process each Fact Address (ADDR) -- V2.0
UpdateCount(tblGrd,strRow,"Addr") -- Count any Address fields
UpdateWorkWithData("Addresses",ptrRef) -- Count each Work with Data Address value -- V2.0
end -- local function doAddress
local function doFamily(ptrRef) -- Report Event Link to Parents Family Record (FAMC) -- V2.0
ExceptionReport(ptrRef,ptrRef,
TblAttrib[TblAttrib["EventLinkFamily"]][3])
end -- local function doFamily
local dicWhat = -- Tag actions invoked by UpdateFact() statistics
{
DATE = doDate ;
_SDATE= doSortDate ; -- Sort Date -- V2.9
AGE = doAge ;
HUSB = doSpouse ;
WIFE = doSpouse ;
PLAC = doPlace ;
_PLAC = doPlace ;
ADDR = doAddress ;
FAMC = doFamily ;
_SHAN = FindCitations ;
_SHAR = FindCitations ;
NOTE = FindCitations ;
NOTE2 = FindCitations ;
OBJE = UpdateMedia ;
OBJE2 = UpdateLMO ;
SOUR = FoundCitation ;
SOUR2 = FindAnyNotes ;
}
local function UpdateFact(ptrOld,tblGrd,strRow,ptrRec,...)
local arg = {...}
datDat = fhNewDate()
local ptrRef = fhNewItemPtr() -- Reference pointer
ptrRef:MoveToFirstChildItem(ptrOld) -- Loop through each tag
while ptrRef:IsNotNull() do
local action = dicWhat[fhGetTag(ptrRef)] or CheckIsUDF -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow,ptrOld) -- Protect ptrRef against change by action -- V2.5
ptrRef:MoveNext()
end
UpdateCount(tblGrd,strRow,"Count") -- Count each Fact, Name & Ordinance, and "All"
UpdateWorkWithData("Fact Types",fhGetTag(ptrOld)) -- Count each Fact Type, NAME & Ordinance -- V2.0
if not datDat:IsNull() and strRow ~= "Birth" then -- Omit Age At Birth as always 0 -- V2.0
for _, ptrInd in ipairs (arg) do -- Either Individual or Family Husband & Wife
if ptrInd:IsNotNull() then -- Obtain Age At Fact Date
local intAge = fhCallBuiltInFunction("AgeAt",ptrInd,datDat:GetDatePt1())
UpdateAge(tblGrd,intAge,strRow,"Age@","Min@","Ave@","Max@",ptrOld,ptrOld)
end
end
end
end -- local function UpdateFact
return UpdateFact
end -- function UpdateFactPrototype
function IndividRecordPrototype() -- Analyse Individual Record Prototype (INDI) -- V2.0
local ptrLiving = false -- Pointer to Living Flag -- V2.0
local intParents = 0 -- Parental checks -- V2.0
local function doRecordFlags(ptrRef,tblGrd) -- Loop through each Record Flag (_FLGS)
ptrRef:MoveToFirstChildItem(ptrRef)
while ptrRef:IsNotNull() do
local strFlag = fhGetDisplayText(ptrRef,"~","STD"):gsub(": Y","")
if strFlag == "Living" then ptrLiving = ptrRef:Clone() end -- Point to Living Flag -- V2.0
UpdateList(tblGrd.Flag,strFlag) -- Update list of Flags -- V2.0
ptrRef:MoveNext("ANY")
end
end -- local function doRecordFlags
local function doAssocPerson(...) -- Check Associated Person (ASSO)
FindAnyNotes(...)
FindCitations(...)
end -- local function doAssocPerson
local arrParent = { "~.HUSB[1]>"; "~.WIFE[1]>"; "~.HUSB[2]>"; "~.WIFE[2]>"; } -- Used by Parent Family statistics
local function doParentFamily(ptrRef,tblGrd,strRow) -- Check Parent Family link (FAMC)
FindAnyNotes(ptrRef,tblGrd,strRow) -- Check any Notes for Source Citations -- V2.0
local ptrFam = fhGetValueAsLink(ptrRef)
for _, strRef in ipairs (arrParent) do -- Loop through the Parents
if fhGetItemPtr(ptrFam,strRef):IsNotNull() then
intParents = intParents + 1 -- Parent found
break
end
end
end -- local function doParentFamily
local dicWhat = -- Tag actions invoked by IndividRecord() statistics
{ -- Tag Action function Grid Table Row Title BMD / WwD ifBorn/ifDied
NAME = { Act=UpdateFact ; Grd=TblFacts ; Row="Names" ; };
BIRT = { Act=UpdateFact ; Grd=TblFacts ; Row="Birth" ; BMD=true ; Born=true ; };
BAPM = { Act=UpdateFact ; Grd=TblFacts ; Row="Baptism" ; BMD=true ; Born=true ; };
CHR = { Act=UpdateFact ; Grd=TblFacts ; Row="Christening" ; BMD=true ; Born=true ; };
CHRA = { Act=UpdateFact ; Grd=TblFacts ; Row="Christening" ; };
ADOP = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; };
CENS = { Act=UpdateFact ; Grd=TblFacts ; Row="Census" ; };
OCCU = { Act=UpdateFact ; Grd=TblFacts ; Row="Occupation" ; WwD="Occupations" ; }; -- Used by Count the Work with Data Attributes
RESI = { Act=UpdateFact ; Grd=TblFacts ; Row="Residence" ; };
DEAT = { Act=UpdateFact ; Grd=TblFacts ; Row="Death" ; BMD=true ; Died=true ; };
BURI = { Act=UpdateFact ; Grd=TblFacts ; Row="Burial" ; BMD=true ; Died=true ; };
CREM = { Act=UpdateFact ; Grd=TblFacts ; Row="Cremation" ; BMD=true ; Died=true ; };
BAPL = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; };
CONL = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; };
ENDL = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; };
SLGC = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; };
RELI = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Religions" ; }; -- Used by Count the Work with Data Attributes
CAST = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Groups Castes" ; };
NATI = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="National Origins" ; };
EDUC = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Education Contexts"; };
DSCR = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Physical Desc." ; };
PROP = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Possessions" ; };
TITL = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Titles" ; };
IDNO = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="National Id. Nos." ; };
SSN = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="US Soc. Sec. Nos." ; };
_FLGS = { Act=doRecordFlags ; Grd=TblIndivid ; };
ASSO = { Act=doAssocPerson ; };
FAMC = { Act=doParentFamily ; };
FAMS = { Act=FindAnyNotes ; };
NOTE = { Act=FindCitations ; };
NOTE2 = { Act=FindCitations ; };
OBJE = { Act=UpdateMedia ; };
OBJE2 = { Act=UpdateLMO ; };
SOUR = { Act=FoundCitation ; };
SOUR2 = { Act=FindAnyNotes ; };
REFN = { Act=UpdateCustomId ; };
RFN = { Act=UpdatePermRecNo; };
RIN = { Act=UpdateAutoRecId; };
CHAN = { Act=FindAnyNotes ; };
}
local function IndividRecord(ptrRec,tblGrd,strRow,tblGrid) -- Analyse Individual Record (INDI) -- V2.0
ptrLiving = false
intParents = 0 -- Parental checks -- V2.0
local dicBMD = {} -- Counts of BMD events -- V2.9
local ifBorn = false
local ifDied = false
local ptrRef = fhNewItemPtr() -- Reference pointer
ptrRef:MoveToFirstChildItem(ptrRec) -- Loop through each tag
while ptrRef:IsNotNull() do
local dicWhat = dicWhat[fhGetTag(ptrRef)] or { }
local strRow = dicWhat.Row or strRow
local tblGrd = dicWhat.Grd or tblGrd
local action = dicWhat.Act or CheckIsFact -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow,ptrRec,ptrRec) -- Protect ptrRef against change by action -- V2.5
local strWwD = dicWhat.WwD
if strWwD then UpdateWorkWithData(strWwD,ptrRef) end -- Count each Work with Data Attribute value -- V2.0
if dicWhat.BMD then DuplicatedBMD(ptrRef,tblGrd,strRow,dicBMD) end -- Report duplicated BMD events -- V2.9
ifBorn = ifBorn or dicWhat.Born -- Person born? -- V2.0
ifDied = ifDied or dicWhat.Died -- Person died? -- V2.0
ptrRef:MoveNext()
end
tblGrd = TblIndivid -- V2.0
local strSex = fhGetDisplayText(ptrRec,"~.SEX","MIN") -- Count number of each Gender
if strSex == "" then
strSex = "Unknown"
ExceptionReport(ptrRec,ptrRec,
MarkCell(tblGrd,"Unknown","Count","GenderIndividual")) -- Report undefined or Unknown Gender
end
UpdateCount(tblGrd,strSex,"Count") -- Count each Gender
if not ifBorn then -- V2.0
UpdateCount(tblGrd,"No Birth","Count") -- Update the No Birth/Baptism/Christening count
ExceptionReport(ptrRec,ptrRec,
MarkCell(tblGrd,"No Birth","Count","NoBirthBaptism"))
end
if ptrLiving and ifDied then -- V2.0
TblFlags.Living = "Living" -- Report a Living Flag despite Death/Burial/Cremation Event -- V2.0
ExceptionReport(ptrRec,ptrLiving,
TblAttrib[TblAttrib["LivingFlagDeath"]][3])
elseif not ( ptrLiving or ifDied ) then -- V2.0
UpdateCount(tblGrd,"No Death","Count") -- Update the No Death/Burial/Cremation count, unless Living Flag
ExceptionReport(ptrRec,ptrRec,
MarkCell(tblGrd,"No Death","Count","NoDeathBuryFlag"))
end
if intParents == 0 then
UpdateCount(tblGrd,"Parentless","Count") -- Update the Parentless count -- V2.0
elseif intParents > 1 then
UpdateCount(tblGrd,"Many Parents","Count") -- Update the Many Parents count -- V2.0
end
local intPool = fhCallBuiltInFunction("RelationPool",ptrRec) -- Count number in each Relation Pool
if intPool and intPool > 0 then
UpdateList(tblGrd.Pool,intPool) -- Update list of Pools -- V2.0
end
tblGrd = TblFamily -- Count and check Spouses -- V2.0
local intMax = tblGrd.Row["Max. Spouses"]
local intCol = tblGrd.Col["Count"]
local intSpouse = 0
local tblSpouse = { }
repeat intSpouse = intSpouse + 1
ptrRef = fhGetItemPtr(ptrRec,"~.~SPOU["..intSpouse.."]>") -- Count the Spouse[*]> instances
tblSpouse[intSpouse] = ptrRef
for intSpou = 1, intSpouse-1 do
if ptrRef:IsSame(tblSpouse[intSpou]) then -- Same spouse record is duplicated
ExceptionReport(ptrRec,ptrRec,
MarkCell(tblGrd,intMax,intCol,"SpouseDuplicate"))
end
end
until ptrRef:IsNull()
intSpouse = intSpouse - 1
tblGrd[intMax][intCol] = math.max( ( tblGrd[intMax][intCol] or 0 ), intSpouse )
end -- local function IndividRecord
return IndividRecord
end -- function IndividRecordPrototype
function FamilyRecordPrototype() -- Analyse Family Record Prototype (FAM) -- V2.0
local intParent = 0
local ptrParent = fhNewItemPtr()
local intChild = 0
local ptrChild = fhNewItemPtr()
local Unmarried = false
local ptrStatus = fhNewItemPtr()
local function doHusb(ptrRef) -- Count Husbands (HUSB)
intParent = intParent + 11 -- Add 10 for Parent + 1 for Husband
ptrParent = ptrRef:Clone()
end -- local function doHusb
local function doWife(ptrRef) -- Count Wives (WIFE)
intParent = intParent + 10 -- Add 10 for Parent
ptrParent = ptrRef:Clone()
end -- local function doWife
local function doChil(ptrRef) -- Count Children (CHIL)
intChild = intChild + 1
ptrChild = ptrRef:Clone()
end -- local function doChil
local function doStat(ptrRef) -- Check Status (_STAT)
ptrStatus = ptrRef:Clone()
local strStatus = fhGetValueAsText(ptrRef)
if strStatus == "Never Married"
or strStatus == "Unmarried Couple" then
Unmarried=true
end
end -- local function doStat
-- Husband adds 1, so may be 0, or 1, or 2
-- Parent adds 10, so may be 00, or 10, or 20
-- So "No Parents" = 00, "One Parent" = 10 or 11, "Both Sex Pairs" = 21, "Same Sex Pairs" = 20 or 22
local dicCouple = { [00]="No Parents"; [10]="One Parent"; [11]="One Parent"; [20]="Same Sex Pairs"; [21]="Both Sex Pairs"; [22]="Same Sex Pairs"; } -- V2.0
local dicWhat = -- Tag actions invoked by FamilyRecord() statistics
{ -- Tag Action function Grid Table Row Title BMD
MARR = { Act=UpdateFact ; Grd=TblFacts ; Row="Marriage" ; BMD=true; };
DIV = { Act=UpdateFact ; Grd=TblFacts ; Row="Divorce" ; BMD=true; };
CENS = { Act=UpdateFact ; Grd=TblFacts ; Row="Census" ; };
SLGS = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other"; };
HUSB = { Act=doHusb ; };
WIFE = { Act=doWife ; };
CHIL = { Act=doChil ; };
_STAT = { Act=doStat ; };
NOTE = { Act=FindCitations ; };
NOTE2 = { Act=FindCitations ; };
OBJE = { Act=UpdateMedia ; };
OBJE2 = { Act=UpdateLMO ; };
SOUR = { Act=FoundCitation ; };
SOUR2 = { Act=FindAnyNotes ; };
REFN = { Act=UpdateCustomId ; };
RIN = { Act=UpdateAutoRecId; };
CHAN = { Act=FindAnyNotes ; };
}
local function FamilyRecord(ptrRec,tblGrd,strRow,tblGrid) -- Analyse Family Record (FAM) -- V2.0
intParent = 0
ptrParent = fhNewItemPtr()
intChild = 0
ptrChild = fhNewItemPtr()
Unmarried = false
ptrStatus = ptrRec:Clone()
local dicBMD = {} -- Counts of BMD events -- V2.9
local ptrRef = fhNewItemPtr() -- Reference pointer
local ptrHusb = fhGetItemPtr(ptrRec,"~.HUSB>") -- Husband & Wife pointers for Age@ in UpdateFact()
local ptrWife = fhGetItemPtr(ptrRec,"~.WIFE>")
ptrRef:MoveToFirstChildItem(ptrRec) -- Loop through each tag
while ptrRef:IsNotNull() do
local dicWhat = dicWhat[fhGetTag(ptrRef)] or { }
local strRow = dicWhat.Row or strRow
local tblGrd = dicWhat.Grd or tblGrd
local action = dicWhat.Act or CheckIsFact -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow,ptrRec,ptrHusb,ptrWife) -- Protect ptrRef against change by action -- V2.5
if dicWhat.BMD then DuplicatedBMD(ptrRef,tblGrd,strRow,dicBMD) end -- Report duplicated BMD events -- V2.9
ptrRef:MoveNext()
end
tblGrd = TblFamily -- V2.0
UpdateCount(tblGrd,dicCouple[intParent],"Count") -- Update "Both Sex Pair"(21), "Same Sex Pair"(20 & 22), "No Parents"(00), "One Parent"(10 & 11) counts
if intChild == 0 then
UpdateCount(tblGrd,"Childless","Count") -- Count the Childless Families
else
UpdateCount(tblGrd,"Total Children","Count",intChild) -- Count the total Children and set Max Children per Couple
local intMax = tblGrd.Row["Max. Children"]
local intCol = tblGrd.Col["Count"]
tblGrd[intMax][intCol] = math.max( ( tblGrd[intMax][intCol] or 0 ), intChild )
end
if intParent == 00 then -- No Parents Family exceptions
if intChild == 0 then
ExceptionReport(ptrRec,ptrRec,
MarkCell(tblGrd,"No Parents","Count","NoParentNorChild"))
else
ExceptionReport(ptrRec,ptrChild, -- V1.7
MarkCell(tblGrd,"No Parents","Count","NoParentButChild"))
end
elseif intParent <= 11 and intChild == 0 then -- One Parent Family exceptions
ExceptionReport(ptrRec,ptrParent,
MarkCell(tblGrd,"One Parent","Count","OneParentNoChild"))
elseif intParent >= 20 and fhGetItemPtr(ptrRec,"~.MARR[1]"):IsNull() then
if not Unmarried then
UpdateCount(tblGrd,"No Marriage","Count") -- Update the No Marriage count, for two parent Family, unless umarried Status
ExceptionReport(ptrRec,ptrStatus,
MarkCell(tblGrd,"No Marriage","Count","NoMarriageEvent"))
end
end
end -- local function FamilyRecord
return FamilyRecord
end -- function FamilyRecordPrototype
function CheckMediaPrototype() -- Check media Format v File type, Frame Area v Image Size, Date & Keywords, and for any Note check for Citations (OBJE,OBJE2) -- V1.8 -- V2.0
local strFile = ""
local strType = ""
local strForm = ""
local ptrForm = fhNewItemPtr()
local _
local function doForm(ptrRef) -- Process each Media Format (FORM) -- V2.0
strForm = fhGetValueAsText(ptrRef)
ptrForm = ptrRef:Clone()
end -- local function doForm
local function doFile(ptrRef) -- Process each Media File (FILE,_FILE) -- V2.0
strFile = fhGetValueAsText(ptrRef) -- Fix accent character report -- V2.2 -- V2.7 --!
if #strFile > 0 then -- Skip any missing file link -- V2.7
_, _, strType = general.SplitFilename(strFile)
strFile = strFile:gsub("^Media\\",StrProjPath.."\\Media\\") -- If relative Media source path then make absolute
end
ptrForm = ptrRef:Clone()
end -- local function doFile
local function doDate(ptrRef) -- Process each Media Date (_DATE) -- V2.0
local datDat = fhGetValueAsDate(ptrRef)
if not datDat:IsNull() and TblOption.DateWarning == "ON" then -- Check for Date warnings -- V1.7 tglWarnings
CheckDayNumber(ptrRef,ptrRef,datDat) -- Check Day Number -- V2.0
end
end -- local function doDate
local function doKeys(ptrRef) -- Process each Media Keyword (_KEYS) -- V2.0
for _, strKey in ipairs (fhGetValueAsText(ptrRef):split()) do
UpdateWorkWithData("Media Keywords",strKey) -- Update Work with Data value -- V2.0
end
end -- local function doKeys
local function getImageError(intErr) -- V1.8 Obtain Image Error message
--? return im.ErrorStr(intErr) -- Should work but fails in v3.4.2 but OK in v3.8.2
local dicError = { } -- So use lookup dictionary
dicError[im.ERR_OPEN] = "Error while opening the file."
dicError[im.ERR_ACCESS] = "Error while accessing the file."
dicError[im.ERR_FORMAT] = "Invalid or unrecognized file format."
dicError[im.ERR_DATA] = "Invalid or unsupported data."
dicError[im.ERR_COMPRESS] = "Invalid or unsupported compression."
dicError[im.ERR_MEM] = "Insufficient memory."
return dicError[intErr]
end -- local function getImageError
local function doArea(ptrRef,tblGrd,strRow,strCol,ptrObj,strArea) -- Found frame _AREA so check image file height & width -- V2.3
if #strFile > 0 and #strArea > 5 then
local strErr = ""
local intH, intW = 0, 0
local strAnsi, wasAnsi = general.FileNameToANSI(strFile)
if not(wasAnsi) then -- Copy image file to ANSI compatible temporary file --!
strAnsi = strAnsi:gsub("ANSI$",strType) -- Necessary ????
general.CopyFile(strFile,strAnsi)
end
local ifile, intErr = im.FileOpen(strAnsi) -- Open image file and save errors such as missing or non-image file -- V1.9
if intErr and intErr ~= im.ERR_NONE then
strErr = getImageError(intErr) -- Get error message
else
local intErr, intWidth, intHeight = ifile:ReadImageInfo() -- Read image width & height info and save any errors
if intErr and intErr ~= im.ERR_NONE then
strErr = getImageError(intErr) -- Get error message
else
intH, intW = intHeight, intWidth -- Set image Height & Width
end
im.FileClose(ifile)
end
if not(wasAnsi) then -- Delete ANSI compatible temporary file --!
general.DeleteFile(strAnsi)
end
local tblArea = strArea:match("{(.*)}"):splitnumbers()
local intT, intL = tblArea[1], tblArea[2] -- Get frame _AREA co-ordinates {Top,Left,Bottom,Right}
local intB, intR = tblArea[3], tblArea[4]
if intT < 0 or intT > intH -- Top or Bottom outside image Height, or define very slim frame?
or intB < 0 or intB > intH
or ( intB - intT ) <= 9 -- was 20 in V1.8
or intL < 0 or intL > intW -- Left or Right outside image Width, or define very slim frame?
or intR < 0 or intR > intW
or ( intR - intL ) <= 9 -- was 20 in V1.8
then -- Report unusual Frame Area co-ordinates
local strArea = string.format("T=% 05d B=% 05d L=% 05d R=% 05d ",intT,intB,intL,intR)
local strFile = strErr
if strFile == "" then -- Either report file Error or image Height & Width
strFile = string.format("H=% 05d W=% 05d",intH,intW)
end
ExceptionReport(ptrObj,ptrRef,
MarkCell(tblGrd,strRow,strCol,"UnusualFrameArea").."Area : "..strArea.."File : "..strFile) -- V2.0
end
end
end -- local function doArea
local function doNote2(ptrRef,tblGrd,strRow,strCol,ptrObj) -- Check each Media Link/Note for Frame v File errors (NOTE2)
FindCitations(ptrRef,tblGrd,strRow)
local ptrVal = fhGetItemPtr(ptrRef,"~._AREA")
if ptrVal:IsNotNull() then
doArea(ptrRef,tblGrd,strRow,strCol,ptrObj,fhGetValueAsText(ptrVal)) -- V2.3
end
end -- local function doNote2
local dicWhat = -- Tag actions invoked by CheckMedia() function
{
FORM = doForm ;
FILE = doFile ;
_FILE = doFile ;
_DATE = doDate ;
_KEYS = doKeys ;
NOTE = FindCitations ;
NOTE2 = doNote2 ;
REFN = UpdateCustomId ;
CHAN = FindAnyNotes ;
}
local function CheckMedia(ptrObj,tblGrd,strRow,strCol) -- Check media Format v File type, Frame Area v Image Size, Date & Keywords, and for any Note check for Citations -- V1.8 -- V2.0
strFile = ""
strType = ""
strForm = ""
ptrForm = fhNewItemPtr()
local ptrRef = fhNewItemPtr() -- Loop through each tag
ptrRef:MoveToFirstChildItem(ptrObj)
while ptrRef:IsNotNull() do
local action = dicWhat[fhGetTag(ptrRef)] or CheckIsUDF -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow,strCol,ptrObj) -- Protect ptrRef against change by action -- V2.5
local ptrFile = fhNewItemPtr()
ptrFile:MoveToFirstChildItem(ptrRef) -- FH V7 GEDCOM 5.5.1 FILE sub-tags FORM & TITL -- V2.2
while ptrFile:IsNotNull() do
local action = dicWhat[fhGetTag(ptrFile)] or CheckIsUDF -- Invoke function for each tag
action(ptrFile:Clone(),tblGrd,strRow,strCol,ptrObj) -- Protect ptrFile against change by action -- V2.5
ptrFile:MoveNext()
end
ptrRef:MoveNext()
end
local intRid = fhGetRecordId(ptrObj)
for _, dicArea in ipairs ( TblObjArea[intRid] or {} ) do -- Check _AREA dimensions found earlier by UpdateMedia(...) function -- V2.3
doArea(dicArea.Link,tblGrd,strRow,strCol,ptrObj,dicArea.Area)
end
-- Tolerate lower/upper-case, spaces, and jpeg/jpg & tiff/tif variants
local lowForm = strForm:lower():gsub("[\t-\r ]*",""):gsub("jpeg","jpg"):gsub("tiff","tif")
local lowType = strType:lower():gsub("[\t-\r ]*",""):gsub("jpeg","jpg"):gsub("tiff","tif")
if lowForm ~= "ole" and lowForm ~= lowType then -- Report mismatching file types
ExceptionReport(ptrObj,ptrForm,
MarkCell(tblGrd,strRow,strCol,"UnusualFormatType")..strForm.." File type : "..strType) -- V2.0
end
end -- local function CheckMedia
return CheckMedia
end -- function CheckMediaPrototype
function MediaRecord(ptrRec,tblGrd,strRow,tblGrid) -- Analyse Media Record (OBJE) -- V1.8 -- V2.0
CheckMedia(ptrRec,tblGrd,strRow,"Count") -- Check media Format v File type -- V1.8 -- V2.0
end -- function MediaRecord
function AnyRecord(ptrRec,tblGrd,strRow,tblGrid,dicWhat) -- Analyse Any Record (NOTE,REPO,_PLAC,SUBM,SUBN,HEAD) -- V2.0
local ptrRef = fhNewItemPtr() -- Reference pointer
ptrRef:MoveToFirstChildItem(ptrRec) -- Loop through each tag
while ptrRef:IsNotNull() do
local action = dicWhat[fhGetTag(ptrRef)] or CheckIsUDF -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow,ptrRec) -- Protect ptrRef against change by action -- V2.5
ptrRef:MoveNext()
end
end -- function AnyRecord
function UpdateStatistics(tblGrid) -- Update each Grid of statistics
FoundCitation = FoundCitationPrototype() -- Create tag action function prototypes with TblIndivid, TblFamily, TblFacts, etc, defined
UpdateFact = UpdateFactPrototype()
IndividRecord = IndividRecordPrototype()
FamilyRecord = FamilyRecordPrototype()
CheckMedia = CheckMediaPrototype()
local function doType(ptrRef) -- Count each Work with Data Source Type value (_TYPE) -- V2.0
UpdateWorkWithData("Source Types",ptrRef)
end -- local function doType
local function doData(ptrRef) -- Check Source Data Event Date & Place (DATA.EVEN.DATE & PLAC) -- V2.0
local ptrDate = fhGetItemPtr(ptrRef,"~.EVEN.DATE")
local datDate = fhGetValueAsDate(ptrDate)
if not datDate:IsNull() and TblOption.DateWarning == "ON" then -- Check for Date warnings -- V1.7 tglWarnings
CheckDayNumber(ptrDate,ptrDate,datDate) -- Check Day Number -- V2.0
end
local ptrPlac = fhGetItemPtr(ptrRef,"~.EVEN.PLAC")
if ptrPlac:IsNotNull() then
UpdateWorkWithData("Places",ptrPlac) -- Update Work with Data Places
end
end -- local function doData
local dicNOTE = -- Tag actions invoked by Note Record statistics
{
SOUR = FoundCitation ;
SOUR2 = FindAnyNotes ;
REFN = UpdateCustomId ;
CHAN = FindAnyNotes ;
}
local dicSOUR = -- Tag actions invoked by Source Record statistics
{
_TYPE = doType ;
DATA = doData ;
REPO = FindAnyNotes ;
NOTE = FindCitations ;
NOTE2 = FindCitations ;
OBJE = UpdateMedia ;
OBJE2 = UpdateLMO ;
REFN = UpdateCustomId ;
CHAN = FindAnyNotes ;
}
local dicREPO = -- Tag actions invoked by Repository Record statistics
{
ADDR = UpdateAddress ;
NOTE = FindCitations ;
NOTE2 = FindCitations ;
REFN = UpdateCustomId ;
CHAN = FindAnyNotes ;
}
local dicPLAC = -- Tag actions invoked by Place Record statistics
{
NOTE = FindCitations ;
NOTE2 = FindCitations ;
OBJE = UpdateMedia ;
OBJE2 = UpdateLMO ;
CHAN = FindAnyNotes ;
}
local dicSUBM = -- Tag actions invoked by Submitter Record statistics
{
ADDR = UpdateAddress ;
OBJE = UpdateMedia ;
OBJE2 = UpdateLMO ;
RFN = UpdatePermRecNo;
CHAN = FindAnyNotes ;
}
local dicRec = -- Tag actions invoked by Compose the Record statistics
{ -- Tag Record Action Row Title Child Actions
INDI = { Act=IndividRecord ; Row="Individual" ; };
FAM = { Act=FamilyRecord ; Row="Family" ; };
NOTE = { Act=AnyRecord ; Row="Note" ; What=dicNOTE; };
SOUR = { Act=AnyRecord ; Row="Source" ; What=dicSOUR; };
REPO = { Act=AnyRecord ; Row="Repository" ; What=dicREPO; };
OBJE = { Act=MediaRecord ; Row="Multimedia" ; };
_PLAC = { Act=AnyRecord ; Row="Place" ; What=dicPLAC; };
_RNOT = { Act=AnyRecord ; Row="Research Note" ; };
_SRCT = { Act=AnyRecord ; Row="Source Template"; };
SUBM = { Act=AnyRecord ; Row="Submitter" ; What=dicSUBM; };
SUBN = { Act=AnyRecord ; Row="Submission" ; };
HEAD = { Act=AnyRecord ; Row="Header" ; };
}
local intRecs = 0
for strRec in iterate.RecordTypes() do
for ptrRec in iterate.Records(strRec) do -- Count number of Records -- V2.0
intRecs = intRecs + 1
end
end
ResetGridCells(tblGrid) -- Reset all Cells
progbar.Setup(iup_gui.DialogueAttributes("Bars")) -- Pass parameters into new Progress Bar prototype
if intRecs > 1000 then
progbar.Start("Statistical Analysis",intRecs) -- Start the Progress Bar with number of Records -- V2.0
intRecs = 0
end
local isGood = true -- Status of Progress Bar
local tblGrd = TblRecords
for strRec in iterate.RecordTypes() do -- Compose the Record statistics -- V2.0
local datDat = fhNewDate()
local dicRec = dicRec[strRec]
local dicWhat= dicRec.What or {}
local strRow = dicRec.Row or ""
local action = dicRec.Act or CheckIsUDF
for ptrRec in iterate.Records(strRec) do
action(ptrRec:Clone(),tblGrd,strRow,tblGrid,dicWhat) -- Action each Record for Records/Individuals/Families/Flags/Facts/Data grids -- V2.0
UpdateCount(tblGrd,strRow,"Count")
local intLinks = fhCallBuiltInFunction("LinksTo",ptrRec) -- Count the Links To each Record
if intLinks > 0 then UpdateCount(tblGrd,strRow,"Links",intLinks) end
datDat:SetSimpleDate( (fhCallBuiltInFunction("LastUpdated",ptrRec)) ) -- Process Last Updated Dates
UpdateDate(tblGrd,datDat,strRow,"Oldest Update","Latest Update")
intRecs = intRecs + 1
if intRecs == 31 then
progbar.Message(strRow.." Record Id "..fhGetRecordId(ptrRec)) -- Update the Progress Bar
progbar.Step(intRecs)
intRecs = 0
end
if progbar.Stop() then isGood = false break end -- Break out of inner loop
-- collectgarbage("step",0) -- May improve run time! -- V2.6
end
end
if GetCell(tblGrd,"Family","Links") > GetCell(tblGrd,"Individual","Links") then
MarkCell(tblGrd,"Family","Links","EventLinkFamily") -- Report that Links To Family Records > Links To Individual Records
end
local intInd = GetCell(tblGrd,"Individual","Count") -- Load the required record counts -- V2.0
local intFam = GetCell(tblGrd,"Family","Count")
SetCell(TblIndivid,"All","Count",intInd)
SetCell(TblFamily ,"All","Count",intFam)
tblGrd = TblIndivid -- Display List of Individual Pools -- V2.0
RevealList(tblGrid,tblGrd,tblGrd.Pool)
tblGrd = TblFamily -- Calculate the Average Children for Families -- V2.0
local intCol = tblGrd.Col["Count"]
local intAll = tblGrd[tblGrd.Row["Total Children"]][intCol]
if intAll and intFam then
tblGrd[tblGrd.Row["Ave. Children"]][intCol] = math.floor( intAll / intFam * 10 + 0.5 ) / 10
end
tblGrd = TblFlags -- Display sorted List of Flags -- V2.0
local tblFlag = TblIndivid.Flag
table.sort(tblFlag, function(tblA,tblB) if tblFlag[tblA] == tblFlag[tblB] then return tblA < tblB else return tblFlag[tblA] > tblFlag[tblB] end end )
RevealList(tblGrid,tblGrd,tblFlag,tblGrd.Living)
local strFlagsFile = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Flags\\Flags.fha"
for strLine in encoder.FileLines(strFlagsFile) do -- Search Flags.fha file
local strFlag = strLine:match("^Name=(.+)$")
if strFlag and not tblFlag[strFlag:gsub("^All$"," All")] then -- Found unused Flag exception (cater for "All" Flag distinct from "All" row) -- V2.0
ExceptionReport(fhNewItemPtr(),fhNewItemPtr(),
MarkCell(tblGrd,"All","Count","UnusedFlagEntry")..strFlag) -- Mark the All Flags Count -- V2.0
end
end
tblGrd = TblFacts -- Calculate the Average Age & Age@ per Fact -- V2.0
for intRow, strRow in ipairs (tblGrd.Row) do
local intNum = tblGrd[intRow][tblGrd.Col["Age"]]
local intAve = tblGrd[intRow][tblGrd.Col["Ave."]]
if intNum and intAve then
tblGrd[intRow][tblGrd.Col["Ave."]] = math.floor( intAve / intNum + 0.5 )
end
local intNum = tblGrd[intRow][tblGrd.Col["Age@"]]
local intAve = tblGrd[intRow][tblGrd.Col["Ave@"]]
if intNum and intAve then
tblGrd[intRow][tblGrd.Col["Ave@"]] = math.floor( intAve / intNum + 0.5 )
end
end
local arrSnapshots = general.GetFolderContents(StrProjPath.."\\Snapshots") -- Count number of Snapshot .fhss files -- V2.1 -- V2.7 --!
local intSnapshots = #arrSnapshots
if intSnapshots > 9 then -- Report excessive number of files
ExceptionReport(fhNewItemPtr(),fhNewItemPtr(),
TblAttrib[TblAttrib["UnusualSnapshots"]][3]..intSnapshots)
end
progbar.Close() -- Close the Progress Bar
ProgressBar = nil
return isGood
end -- function UpdateStatistics
function ExportStatistics(tblGrid) -- Export each Grid of statistics
local strFile = iup_gui.PublicPath.."\\"..iup_gui.Plugin.." ~ .csv" -- Filename template
local strLine = ""
for strGrid, strBase in pairs (tblGrid.Base) do -- Loop through all grid cells -- V2.0
local tblGrd = tblGrid[strBase]
local tblRow = tblGrd.Row
local tblCol = tblGrd.Col
local intDat = 99 -- Fact Date column number -- V2.0
strLine = strGrid -- CSV cell A1 is Grid name
for intCol = 1, #tblCol do
local strCol = TidyTitle(tblCol[intCol]) -- V2.7
if strCol:match("Earliest Fact Date") then intDat = intCol end -- Set 1st Fact Date column -- V2.0
strLine = strLine..","..strCol -- CSV row 1 is Grid column headings
end
for intRow = 1, #tblRow do
strLine = strLine.."\n"..tblRow[intRow] -- CSV col A is Grid row heading
for intCol = 1, #tblCol do
local strBeg = ","
local strEnd = ""
if intCol >= intDat then -- Protect any Earliest & Latest Fact Date so Excel/Calc treats as strings -- V2.0
strBeg = ",=\""
strEnd = "\""
end
strLine = strLine..strBeg..(tblGrd[intRow][intCol] or "")..strEnd -- CSV col B... are cell values
end
local strPath = strFile:gsub("",strGrid)
general.SaveStringToFile(strLine.."\n",strPath) -- Fix accent character report -- V2.2 -- V2.7 --!
end
end
iup_gui.MemoDialogue("\n Export completed to CSV files : \n\n "..strFile:gsub("","*").." \n")
end -- function ExportStatistics
-- Main Code Section Starts Here --
local intPause = collectgarbage("setpause",50) -- Default = 200 Aggressive = 50 -- Sets pause of collector and returns prev value of pause -- V2.6
local intStep = collectgarbage("setstepmul",300) -- Default = 200 Aggressive = 300 -- Sets step mult of collector & returns prev value of step -- V2.6
fhInitialise(5,0,8,"save_recommended")
PresetGlobalData() -- Preset global data definitions
ResetDefaultSettings() -- Preset default sticky settings
LoadSettings() -- Load sticky data settings
iup_gui.CheckVersionInStore() -- Notify if later Version
GUI_MainDialogue() -- Invoke graphical user interface
SaveSettings() -- Save sticky data settings
--[[
@Title: Show Project Statistics
@Type: Standard
@Author: Mike Tate
@Contributors:
@Version: 2.9
@Keywords:
@LastUpdated: 15 Mar 2023
@Licence: This plugin is copyright (c) 2023 Mike Tate & contributors and is licensed under the MIT License which is hereby incorporated by reference (see https://pluginstore.family-historian.co.uk/fh-plugin-licence)
@Description: Show project statistics and exceptions as requested by Wish List Ref 191 File Summary Display.
@V2.9: Library V3.3; Check Sort Dates; Report duplicated BMD events;
@V2.8: Library V3.2 after various updates; Added DetectOldModules(); Fix for Standalone GEDCOM and Snapshots;
@V2.7: Library V3.2 with FSO and Unicode filepaths; Fix CSV export for Data grid; Fix for missing File Link in Format v Type check (LMO Sort Date);
@V2.6: Add garbage memory management needed for large Projects; Library v3.1 with monthly version check;
@V2.5: Protect action(ptrRef:Clone(),...) against change by such as UpdateMedia(ptrRef,...) so Living Flag handled correctly;
@V2.4: Adjusted displays for HiRes monitors; Added Exceptions Reported count; Cater for Sex Unknown instead of blank = Undefined;
@V2.3: Include FH V7 GEDCOM 5.5.1 Media File _AREA check;
@V2.2: Updated library to Functions Prototypes v3.0; FH V7 Lua 3.5 IUP 3.28;
@V2.1: Update to library V2.9; iup_gui.Balloon = "NO" for Crossover/PlayOnLinux/Mac; Check Snapshot files;
@V2.0: Ensure Project folder exists via updated Library modules, revised Parent/Family counts, add Names & Ordinations, "All" Facts, omit Age At Birth, check Birth Age > 0, UDF, Date Points with no Day Number, new counts/checks for Media & Sources/Citations, new counts of Work with Data categories Places, Addresses, Occupations, Keywords, etc.
@V1.9: Both ANSI FH V5 & UTF-8 FH V6 IUP 3.11.2, iup.SetGlobal("UTF8MODE","YES"), HelpDialogue conditional ExpandChildren="YES/NO", RefreshDialoge uses NaturalSize, new LastUpdated() function, reduce minimum Area threshold to 9.
@V1.8: Updates to iup_gui module with Help window X Close crash fix and extra fonts & colours, resizable window & matrix columns, despaced grid titles, F1 help_cb, add BalloonToggle()
@V1.8: Report media FORMat v FILE type mismatch, and AREA v file height & width or type mismatch, MakeHelpDialogue() new Help & Advice pages, see comments marked with 'V1.8'.
@V1.7: Improve some Item names & 'buddy' pointers, report Dates too far in past, add Exception Report Options tab, see comments marked with 'V1.7'.
@V1.6: Improve some "buddy" pointers to refer to data field, fix invalid date warning text, and fix ResetGridCells error, see comments marked with 'V1.6'.
@V1.5: Check date warnings using GetDataWarning(...) in UpdateDate(...) function, count Max.Spouses & report if any Spouse link is duplicated, and add "buddy" column to Result Set.
@V1.4: Preserve the Result Set with Grid, report Permanent/Automatic Record Idents and Citation Entry Dates in future, allow Flag name "All", bug fix AgeAt -ve age by -1, plus new string library.
Add Cremation events to Facts tab, and change 'Close & Show Report' button label to 'Close & Report' plus other adjustments to get height < 600 pixel, add Version History help, and GUI Library.
@V1.3: Correct "Ave.Children" count, add "Idents" count, refine several other counts, add Result Set Exceptions Report, show highest & lowest 2 Pools & 5 Flags with rest in middle.
@V1.2: Correct "Both Sex", "Same Sex", "One Parent", "No Parents" Couples counts, and sort Flags by popularity.
@V1.1: Correct the Age statistics, add Age At and Pool and Flag plus a few other statistics.
@V1.0: Initial version with Tabs, Export CSV files, etc.
]]
if fhGetAppVersion() > 5 then fhSetStringEncoding("UTF-8") end
if fhGetAppVersion() > 6 then loadstring = load end
--[[
@Title: aa Library Functions Preamble
@Author: Mike Tate
@Version: 3.3
@LastUpdated: 03 May 2022
@Description: All the library functions prototype closures for Plugins.
]]
--[[
@Module: +fh+stringx_v3
@Author: Mike Tate
@Version: 3.0
@LastUpdated: 19 Sep 2020
@Description: Extended string functions to supplement LUA string library.
@V3.0: Function Prototype Closure version with Lua 5.1 & 5.3 comaptibility; Added inert(strTxt) function;
@V2.5: Support FH V6 Encoding = UTF-8;
@V2.4: Tolerant of integer & nil parameters just link match & gsub;
@V1.0: Initial version.
]]
local function stringx_v3()
local fh = {} -- Local environment table
-- Supply current file encoding format --
function fh.encoding()
if fhGetAppVersion() > 5 then return fhGetStringEncoding() end
return "ANSI"
end -- function encoding
-- Split a string using "," or chosen separator --
function fh.split(strTxt,strSep)
local tblFields = {}
local strPattern = string.format("([^%s]+)", strSep or ",")
strTxt = tostring(strTxt or "")
strTxt:gsub(strPattern, function(strField) tblFields[#tblFields+1] = strField end)
return tblFields
end -- function split
-- Split a string into numbers using " " or "," or "x" separators -- Any non-number remains as a string
function fh.splitnumbers(strTxt)
local tblNum = {}
strTxt = tostring(strTxt or "")
strTxt:gsub("([^ ,x]+)", function(strNum) tblNum[#tblNum+1] = tonumber(strNum) or strNum end)
return tblNum
end -- function splitnumbers
local strMagic = "([%^%$%(%)%%%.%[%]%*%+%-%?])" -- UTF-8 replacement for "(%W)"
-- Hide magic pattern symbols ^ $ ( ) % . [ ] * + - ?
function fh.plain(strTxt)
-- Prefix every magic pattern character with a % escape character,
-- where %% is the % escape, and %1 is the original character capture.
strTxt = tostring(strTxt or ""):gsub(strMagic,"%%%1")
return strTxt
end -- function plain
-- matches is plain text version of string.match()
function fh.matches(strTxt,strFind,intInit)
strFind = tostring(strFind or ""):gsub(strMagic,"%%%1") -- Hide magic pattern symbols
return tostring(strTxt or ""):match(strFind,tonumber(intInit))
end -- function matches
-- replace is plain text version of string.gsub()
function fh.replace(strTxt,strOld,strNew,intNum)
strOld = tostring(strOld or ""):gsub(strMagic,"%%%1") -- Hide magic pattern symbols
return tostring(strTxt or ""):gsub(strOld,function() return strNew end,tonumber(intNum)) -- Hide % capture symbols
end -- function replace
-- Hide % escape/capture symbols in replacement so they are inert
function fh.inert(strTxt)
strTxt = tostring(strTxt or ""):gsub("%%","%%%%") -- Hide all % symbols
return strTxt
end -- function inert
-- convert is pattern without captures version of string.gsub()
function fh.convert(strTxt,strOld,strNew,intNum)
return tostring(strTxt or ""):gsub(tostring(strOld or ""),function() return strNew end,tonumber(intNum)) -- Hide % capture symbols
end -- function convert
local dicUpper = { }
local dicLower = { }
local dicCaseX = { }
-- ASCII unaccented letter translations for Upper, Lower, and Case Insensitive
for intUpper = string.byte("A"), string.byte("Z") do
local strUpper = string.char(intUpper)
local strLower = string.char(intUpper - string.byte("A") + string.byte("a"))
dicUpper[strLower] = strUpper
dicLower[strUpper] = strLower
local strCaseX = "["..strUpper..strLower.."]"
dicCaseX[strLower] = strCaseX
dicCaseX[strUpper] = strCaseX
end
-- Supply character length of ANSI text --
function fh.length(strTxt)
return string.len(strTxt or "")
end -- function length
-- Supply character substring of ANSI text --
function fh.substring(strTxt,i,j)
return string.sub(strTxt or "",i,j)
end -- function substring
-- Translate upper/lower case ANSI letters to pattern that matches both --
function fh.caseless(strTxt)
strTxt = tostring(strTxt or ""):gsub("[A-Za-z]",dicCaseX)
return strTxt
end -- function caseless
if fh.encoding() == "UTF-8" then
-- Supply character length of UTF-8 text --
function fh.length(strTxt)
isFlag = fhIsConversionLossFlagSet()
strTxt = fhConvertUTF8toANSI(strTxt or "")
fhSetConversionLossFlag(isFlag)
return string.len(strTxt)
end -- function length
local strUTF8 = "([%z\1-\127\194-\244][\128-\191]*)" -- Cater for Lua 5.1 %z or Lua 5.3 \0
if fhGetAppVersion() > 6 then
strUTF8 = "([\0-\127\194-\244][\128-\191]*)"
end
-- Supply character substring of UTF-8 text --
function fh.substring(strTxt,i,j)
local strSub = ""
j = j or -1
if j < 0 then j = j + length(strTxt) + 1 end
if i < 0 then i = i + length(strTxt) + 1 end
for strChr in string.gmatch(strTxt or "",strUTF8) do
if j <= 0 then break end
j = j - 1
i = i - 1
if i <= 0 then strSub = strSub..strChr end
end
return strSub
end -- function substring
-- Translate lower case to upper case UTF-8 letters --
function fh.upper(strTxt)
strTxt = tostring(strTxt or ""):gsub("([a-z\194-\244][\128-\191]*)",dicUpper)
return strTxt
end -- function upper
-- Translate upper case to lower case UTF-8 letters --
function fh.lower(strTxt)
strTxt = tostring(strTxt or ""):gsub("([A-Z\194-\244][\128-\191]*)",dicLower)
return strTxt
end -- function lower
-- Translate upper/lower case UTF-8 letters to pattern that matches both --
function fh.caseless(strTxt)
strTxt = tostring(strTxt or ""):gsub("([A-Za-z\194-\244][\128-\191]*)",dicCaseX)
return strTxt
end -- function caseless
-- Following tables use ASCII numeric coding to be immune from ANSI/UTF-8 encoding --
local arrPairs = -- Upper & Lower case groups of UTF-8 letters with same prefix --
{-- { Prefix; Beg ; End ; Inc; Offset Upper > Lower }; -- These include all ANSI letters and many more
{ "\195"; 0x80; 0x96; 1 ; 32 }; -- 195=0xC3 À U+00C0 to Ö U+00D6 and à U+00E0 to ö U+00F6
{ "\195"; 0x98; 0x9E; 1 ; 32 }; -- 195=0xC3 Ø U+00D8 to Þ U+00DE and ø U+00F8 to þ U+00FE
{ "\196"; 0x80; 0xB6; 2 ; 1 }; -- 196=0xC4 A U+0100 to k U+0137 in pairs
{ "\196"; 0xB9; 0xBD; 2 ; 1 }; -- 196=0xC4 L U+0139 to l U+013E in pairs
{ "\197"; 0x81; 0x87; 2 ; 1 }; -- 197=0xC5 L U+0141 to n U+0148 in pairs
{ "\197"; 0x8A; 0xB6; 2 ; 1 }; -- 197=0xC5 ? U+014A to y U+0177 in pairs
{ "\197"; 0xB9; 0xBD; 2 ; 1 }; -- 197=0xC5 Z U+0179 to ž U+017E in pairs
{ "\198"; 0x82; 0x84; 2 ; 1 }; -- 198=0xC6 ? U+0182 to ? U+0185 in pairs
-- Add more Unicode groups here as usage increases --
}
local dicPairs = -- Upper v Lower case UTF-8 letters that don't fit groups above --
{ [string.char(0xC4,0xBF)] = string.char(0xC5,0x80); -- ? U+013F and ? U+0140
[string.char(0xC5,0xB8)] = string.char(0xC3,0xBF); -- Ÿ U+0178 and ÿ U+00FF
}
local intBeg1 = string.byte(string.sub("À",1))
local intBeg2 = string.byte(string.sub("À",2))
local intEnd1 = string.byte(string.sub("Z",1))
local intEnd2 = string.byte(string.sub("Z",2))
-- print(string.format("%#x %#x %#x %#x",intBeg1,intBeg2,intEnd1,intEnd2)) -- Useful to work out numeric coding
-- Populate the UTF-8 letter translation dictionaries --
for intGroup, tblGroup in ipairs ( arrPairs ) do -- UTF-8 accented letter groups
local strPrefix = tblGroup[1]
for intUpper = tblGroup[2], tblGroup[3], tblGroup[4] do
local strUpper = string.char(intUpper)
local strLower = string.char(intUpper + tblGroup[5])
local strCaseX = strPrefix.."["..strUpper..strLower.."]"
strUpper = strPrefix..strUpper
strLower = strPrefix..strLower
dicUpper[strLower] = strUpper
dicLower[strUpper] = strLower
dicCaseX[strLower] = strCaseX
dicCaseX[strUpper] = strCaseX
end
end
for strUpper, strLower in pairs ( dicPairs ) do -- UTF-8 accented letters where upper & lower have different prefix
dicUpper[strLower] = strUpper
dicLower[strUpper] = strLower
local strCaseX = ""
for intByte = 1, #strUpper do -- Matches more than just the two letters, but can't do any better
strCaseX = strCaseX.."["..strUpper:sub(intByte,intByte)..strLower:sub(intByte,intByte).."]"
end
dicCaseX[strLower] = strCaseX
dicCaseX[strUpper] = strCaseX
end
end
-- overload fh functions into string table
for strIndex, anyValue in pairs(fh) do
if type(anyValue) == "function" then
string[strIndex] = anyValue
end
end
return fh
end -- local function stringx_v3
local stringx = stringx_v3() -- To access FH string extension module
--[[
@Module: +fh+iterate_v3
@Author: Mike Tate
@Version: 3.0
@LastUpdated: 25 Aug 2020
@Description: An iterater functions module to supplement LUA functions.
@V3.0: Function Prototype Closure version.
@V1.2: RecordTypes() includes HEAD tag.
@V1.1: ?
@V1.0: Initial version.
]]
local function iterate_v3()
local fh = {} -- Local environment table
-- Iterator for all records of one chosen type --
function fh.Records(strType)
local ptrAll = fhNewItemPtr() -- Pointer to all records in turn
local ptrRec = fhNewItemPtr() -- Pointer to record returned to user
ptrAll:MoveToFirstRecord(strType)
return function ()
ptrRec:MoveTo(ptrAll)
ptrAll:MoveNext()
if ptrRec:IsNotNull() then return ptrRec end
end
end -- function Records
-- Iterator for all the record types --
function fh.RecordTypes()
local intNext = -1 -- Next record type number
local intLast = fhGetRecordTypeCount() -- Last record type number
return function()
intNext = intNext + 1
if intNext == 0 then -- Includes HEAD tag -- V1.2
return "HEAD"
elseif intNext <= intLast then
return fhGetRecordTypeTag(intNext) -- Return record type tag
end
end
end -- function RecordTypes
-- Iterator for all items in all records of chosen types --
function fh.Items(...)
local arg = {...}
local intType = 1 -- Integer record type number
local tblType = {} -- Table of record type tags
local ptrNext = fhNewItemPtr() -- Pointer to next item in turn
local ptrItem = fhNewItemPtr() -- Pointer to item returned to user
if #arg == 0 then
for intType = 1, fhGetRecordTypeCount() do -- No parameters so use all record types
tblType[intType] = fhGetRecordTypeTag(intType)
end
else
tblType = arg -- Got parameters so use them instead
end
-- print(tblType[intType],intType)
ptrNext:MoveToFirstRecord(tblType[intType]) -- Get first record of first type
return function()
repeat
while ptrNext:IsNotNull() do -- Loop through all items
ptrItem:MoveTo(ptrNext)
ptrNext:MoveNextSpecial()
if ptrItem:IsNotNull() then return ptrItem end
end
intType = intType + 1 -- Loop through each record type
if intType <= #tblType then
ptrNext:MoveToFirstRecord(tblType[intType])
end
until intType > #tblType
end
end -- function Items
-- Iterator for all facts of an individual --
function fh.Facts(ptrIndi)
local ptrItem = fhNewItemPtr() -- Pointer to each item at level 1
local ptrFact = fhNewItemPtr() -- Pointer to each fact returned to user
ptrItem:MoveToFirstChildItem(ptrIndi)
return function ()
while ptrItem:IsNotNull() do
ptrFact:MoveTo(ptrItem)
ptrItem:MoveNext()
if fhIsFact(ptrFact) then return ptrFact end
end
end
end -- function Facts
return fh
end -- local function iterate_v3
local iterate = iterate_v3() -- To access FH iterate items module
--[[
@Module: +fh+general_v3
@Author: Mike Tate
@Version: 3.2
@LastUpdated: 10 Mar 2022
@Description: A general functions module to supplement LUA functions, where filenames use UTF-8 but for a few exceptions.
@V3.2: Added function DetectOldModules(); Updated functions RenameFile(), RenameFolder() & GetFolderContents();
@V3.1: Functions derived from FH V7 fhFileUtils library using File System Objects, plus additional features;
@V3.0: Function Prototype Closure version; GetDayNumber() error message reasons;
@V1.5: Revised SplitFilename(strFilename) for missing extension.
@V1.4: Revised EstimatedBirthDates() & EstimatedDeathDates() to fix null Dates.
@V1.3: Add GetDayNumber(), EstimatedBirthDates(), EstimatedDeathDates().
@V1.2: SplitFilename() updated for directory only paths, and MakeFolder() added.
@V1.1: pl.path experiment revoked. New DirTree with omit branch option. Avoid using stringx_v2.
@V1.0: Initial version.
]]
local function general_v3()
local fh = {} -- Local environment table
require("luacom") -- To create File System Object
fh.FSO = luacom.CreateObject("Scripting.FileSystemObject")
-- Report error message --
local function doError(strMessage,errFunction)
-- strMessage ~ error message text
-- errFunction ~ optional error reporting function
if type(errFunction) == "function" then
errFunction(strMessage)
else
error(strMessage)
end
end -- local function doError
-- Convert filename to ANSI alternative and indicate success --
function fh.FileNameToANSI(strFileName,strAnsiName)
-- strFileName ~ full file path
-- strAnsiFile ~ ANSI file name & type
-- return values ~ ANSI file path, true if original path was ANSI compatible
if stringx.encoding() == "ANSI" then return strFileName, true end
local isFlag = fhIsConversionLossFlagSet()
fhSetConversionLossFlag(false)
local strAnsi = fhConvertUTF8toANSI(strFileName)
local wasAnsi = true
if fhIsConversionLossFlagSet() then
strAnsiName = strAnsiName or "ANSI.ANSI"
strAnsi = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Plugin Data\\"..strAnsiName
wasAnsi = false
end
fhSetConversionLossFlag(isFlag)
return strAnsi, wasAnsi
end -- local function FileNameToANSI
-- Get parent folder --
function fh.GetParentFolder(strFileName)
-- strFileName ~ full file path
-- return value ~ parent folder path
local strParent = fh.FSO:GetParentFolderName(strFileName) --! Faulty in FH v6 with Unicode chars in path
if fhGetAppVersion() == 6 then
local _, wasAnsi = fh.FileNameToANSI(strFileName)
if not wasAnsi then
strParent = strFileName:match("^(.+)[\\/][^\\/]+[\\/]?$")
end
end
return strParent
end -- function GetParentFolder
-- Check if file exists --
function fh.FlgFileExists(strFileName)
-- strFileName ~ full file path
-- return value ~ true if it exists
return fh.FSO:FileExists(strFileName)
end -- function FlgFileExists
-- Check if folder exists --
function fh.FlgFolderExists(strFolderName)
-- strFolderName ~ full file path
-- return value ~ true if it exists
return fh.FSO:FolderExists(strFolderName)
end -- function FlgFolderExists
-- Delete a file if it exists --
function fh.DeleteFile(strFileName,errFunction)
-- strFileName ~ full file path
-- errFunction ~ optional error reporting function
-- return value ~ true if file does not exist or is deleted else false
if fh.FSO:FileExists(strFileName) then
fh.FSO:DeleteFile(strFileName,true)
if fh.FSO:FileExists(strFileName) then
doError("File Not Deleted:\n"..strFileName.."\n",errFunction)
return false
end
end
return true
end -- function DeleteFile
-- Delete a folder if it exists including contents --
function fh.DeleteFolder(strFolderName,errFunction)
-- strFolderName ~ full folder path
-- errFunction ~ optional error reporting function
-- return value ~ true if folder does not exist or is deleted else false
if fh.FSO:FolderExists(strFolderName) then
fh.FSO:DeleteFolder(strFolderName,true)
if fh.FSO:FolderExists(strFolderName) then
doError("Folder Not Deleted:\n"..strFolderName.."\n",errFunction)
return false
end
end
return true
end -- function DeleteFolder
-- Rename a file if it exists --
function fh.RenameFile(strFileName,strNewName)
-- strFileName ~ full file path
-- strNewName ~ new file name & type
-- return value ~ true if file exists but new name does not and rename is OK else false
local strNewFile = fh.GetParentFolder(strFileName).."\\"..strNewName
if fh.FSO:FileExists(strFileName) and not fh.FSO:FileExists(strNewFile) then
local fileObject = fh.FSO:GetFile(strFileName)
fileObject.Name = strNewName
if fh.FSO:FileExists(strNewFile) then
return true
end
end
return false
end -- function RenameFile
-- Rename a folder if it exists --
function fh.RenameFolder(strFolderName,strNewName)
-- strFolderName ~ full folder path
-- strNewName ~ new folder name
-- return value ~ true if folder exists but new name does not and rename is OK else false
local strNewFolder = fh.GetParentFolder(strFolderName).."\\"..strNewName
if fh.FSO:FolderExists(strFolderName) and not fh.FSO:FolderExists(strNewFolder) then
local folderObject = fh.FSO:GetFolder(strFolderName)
folderObject.Name = strNewName
if fh.FSO:FolderExists(strNewFolder) then
return true
end
end
return false
end -- function RenameFolder
-- Copy a file if it exists and destination is not a folder --
function fh.CopyFile(strFileName,strDestination)
-- strFileName ~ full source file path
-- strDestination ~ full target file path
-- return value ~ true if file exists and is copied else false
if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FileExists(strFileName) and not fh.FSO:FolderExists(strDestination) then
fh.FSO:CopyFile(strFileName,strDestination)
if fh.FSO:FileExists(strDestination) then
return true
end
end
return false
end -- function CopyFile
-- Copy a folder if it exists and destination is not a file --
function fh.CopyFolder(strFolderName,strDestination)
-- strFolderName ~ full source folder path
-- strDestination ~ full target folder path
-- return value ~ true if folder exists and is copied else false
if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FolderExists(strFolderName) and not fh.FSO:FileExists(strDestination) then
fh.FSO:CopyFolder(strFolderName,strDestination)
if fh.FSO:FolderExists(strDestination) then
return true
end
end
return false
end -- function CopyFolder
-- Move a file if it exists and destination is not a folder --
function fh.MoveFile(strFileName,strDestination)
-- strFileName ~ full source file path
-- strDestination ~ full target file path
-- return value ~ true if file exists and is moved else false
if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FileExists(strFileName) and not fh.FSO:FolderExists(strDestination) then
if fh.DeleteFile(strDestination) then
fh.FSO:MoveFile(strFileName,strDestination)
if fh.FSO:FileExists(strDestination) then
return true
end
end
end
return false
end -- function MoveFile
-- Move a folder if it exists and destination is not a file --
function fh.MoveFolder(strFolderName,strDestination)
-- strFolderName ~ full source folder path
-- strDestination ~ full target folder path
-- return value ~ true if folder exists and is moved else false
if fh.MakeFolder(fh.GetParentFolder(strDestination)) and fh.FSO:FolderExists(strFolderName) and not fh.FSO:FileExists(strDestination) then
if fh.DeleteFolder(strDestination) then
fh.FSO:MoveFolder(strFolderName,strDestination)
if fh.FSO:FolderExists(strDestination) then
return true
end
end
end
return false
end -- function MoveFolder
-- Make subfolder recursively if does not exist --
function fh.MakeFolder(strFolderName,errFunction)
-- strFolderName ~ full source folder path
-- errFunction ~ optional error reporting function
-- return value ~ true if folder exists or created else false
if not fh.FSO:FolderExists(strFolderName) then
if not fh.MakeFolder(fh.GetParentFolder(strFolderName),errFunction) then
return false
end
fh.FSO:CreateFolder(strFolderName)
if not fh.FSO:FolderExists(strFolderName) then
doError("Cannot Make Folder:\n"..strFolderName.."\n",errFunction)
return false
end
end
return true
end -- function MakeFolder
-- Check if folder writable --
function fh.FlgFolderWrite(strFolderName)
-- strFolderName ~ full source folder path
-- return value ~ true if folder writable else false
if fh.FlgFolderExists(strFolderName) then
if fh.MakeFolder(strFolderName.."\\vwxyz") then
fh.FSO:DeleteFolder(strFolderName.."\\vwxyz",true)
return true
end
end
return false
end -- function FlgFolderWrite
-- Open File with ANSI path and return Handle --
function fh.OpenFile(strFileName,strMode)
-- strFileName ~ full file path
-- strMode ~ "r", "w", "a" optionally suffixed with "+" &/or "b"
-- return value ~ file handle
local fileHandle, strError = io.open(strFileName,strMode)
if fileHandle == nil then
error("\n Unable to open file in \""..strMode.."\" mode. \n "..strFileName.." \n "..strError.." \n")
end
return fileHandle
end -- function OpenFile
-- Save string to file --
function fh.SaveStringToFile(strContents,strFileName,strFormat)
-- strContents ~ text string
-- strFileName ~ full file path
-- strFormat ~ optional "UTF-8" or "UTF-16LE"
-- return value ~ true if successful else false
strFormat = strFormat or "UTF-8"
if fhGetAppVersion() > 6 then
return fhSaveTextFile(strFileName,strContents,strFormat)
end
local strAnsi, wasAnsi = fh.FileNameToANSI(strFileName)
local fileHandle = fh.OpenFile(strAnsi,"w")
fileHandle:write(strContents)
assert(fileHandle:close())
if not wasAnsi then
fh.MoveFile(strAnsi,strFileName)
end
return true
end -- function SaveStringToFile
-- Load string from file --
function fh.StrLoadFromFile(strFileName,strFormat)
-- strFileName ~ full file path
-- strFormat ~ optional "UTF-8" or "UTF-16LE"
-- return value ~ file contents
strFormat = strFormat or "UTF-8"
if fhGetAppVersion() > 6 then
return fhLoadTextFile(strFileName,strFormat)
end
local strAnsi, wasAnsi = fh.FileNameToANSI(strFileName)
if not wasAnsi then
fh.CopyFile(strFileName,strAnsi)
end
local fileHandle = fh.OpenFile(strAnsi,"r")
local strContents = fileHandle:read("*all")
assert(fileHandle:close())
return strContents
end -- function StrLoadFromFile
-- Returns the Path, Filename, and Extension as 3 values --
function fh.SplitFilename(strFileName)
-- strFileName ~ full file path
-- return values ~ path, name.type, type
if fh.FSO:FolderExists(strFileName) then
local strPath = strFileName:gsub("[\\/]$","")
return strPath.."\\","",""
end
strFileName = strFileName.."."
return strFileName:match("^(.-)([^\\/]-%.([^\\/%.]-))%.?$")
end -- function SplitFilename
-- Convert dd/mm/yyyy hh:mm:ss format to integer seconds -- (DateTime format is used in attributes returned by GetFolderContents and DirTree below)
function fh.IntTime(strDateTime)
-- strDateTime ~ date time string
-- return value ~ integer seconds since 01/01/1970 00:00:00
local strDay,strMonth,strYear,strHour,strMin,strSec = strDateTime:match("^(%d%d)/(%d%d)/(%d+) (%d%d):(%d%d):(%d%d)")
if tonumber(strYear) < 1970 then return 0 end
local isDST = false
if tonumber(strMonth) > 4 and tonumber(strMonth) < 11 then isDST = true end -- Approximation is sometimes wrong
local intTime = os.time( { year=strYear; month=strMonth; day=strDay; hour=strHour; min=strMin; sec=strSec; isdst=isDST; } )
local tblDat = os.date("*t",intTime)
if tblDat.isdst then
intTime = intTime + 3600
isDST = true
end
return intTime
end -- function IntTime
-- Return table of attributes --
local function attributes(tblAttr,strMode)
-- tblAttr ~ file attributes table
-- strMode ~ "file" or "directory"
-- return value ~ attributes table like LFS except datetimes
local tblAttr = { name=tblAttr.name; created=tblAttr.DateCreated; type=tblAttr.Type; path=tblAttr.path; shortname=tblAttr.ShortName; shortpath=tblAttr.ShortPath; size=tblAttr.Size; modified=tblAttr.DateLastModified; attributes=tblAttr.Attributes; }
tblAttr.mode = strMode
return tblAttr
end -- local function attributes
-- Return attributes table of all files and folders in a specified folder --
function fh.GetFolderContents(strFolder,doRecurse)
-- strFolder ~ full folder path
-- doRecurse ~ true for recursion
-- return value ~ attributes table
local arrList = {}
if fh.FSO:FolderExists(strFolder) then
local function getFileList(strFolder)
local tblList = fh.FSO:GetFolder(strFolder)
local tblEnum = luacom.GetEnumerator(tblList.SubFolders)
local tblAttr = tblEnum:Next()
while tblAttr do
table.insert(arrList,attributes(tblAttr,"directory"))
if doRecurse then getFileList(tblAttr.path) end
tblAttr = tblEnum:Next()
end
local tblEnum = luacom.GetEnumerator(tblList.Files)
local tblAttr = tblEnum:Next()
while tblAttr do
table.insert(arrList,attributes(tblAttr,"file"))
tblAttr = tblEnum:Next()
end
end
getFileList(strFolder)
end
return arrList
end -- function GetFolderContents
-- Return a Directory Tree entry & attributes on each iteration --
function fh.DirTree(strDir,...)
-- strDir ~ full folder path
-- ... ~ list of folders to omit
-- return value ~ full path, attributes table
local arg = {...}
assert( fh.FSO:FolderExists(strDir), "directory parameter is missing or empty" )
local function yieldtree(strDir)
local tblList = fh.FSO:GetFolder(strDir)
local tblEnum = luacom.GetEnumerator(tblList.SubFolders)
local tblAttr = tblEnum:Next()
while tblAttr do -- for _,tblAttr in luacom.pairs(tblList.SubFolders) do -- pairs not working in FH v6 so use tblEnum code
coroutine.yield(tblAttr.path,attributes(tblAttr,"directory"))
local isOK = true
for _,strOmit in ipairs (arg) do
if tblAttr.path:match(strOmit) then -- Omit tree branch
isOK = false
break
end
end
if isOK then yieldtree(tblAttr.path) end
tblAttr = tblEnum:Next()
end
local tblEnum = luacom.GetEnumerator(tblList.Files)
local tblAttr = tblEnum:Next()
while tblAttr do -- for _,tblAttr in luacom.pairs(tblList.Files) do -- pairs not working in FH v6 so use tblEnum code
coroutine.yield(tblAttr.path,attributes(tblAttr,"file"))
tblAttr = tblEnum:Next()
end
end
return coroutine.wrap(function() yieldtree(strDir) end)
end -- function DirTree
-- Detect FH V5/6 old library modules and advise removal --
function fh.DetectOldModules()
if fhGetAppVersion() > 6 then
local strPath = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Plugins\\"
local arrFile = { "compat53.lua"; "ltn12.lua"; "luasql\\sqlite3.dll"; "md5.lua"; "pl\\init.lua"; "socket.lua"; "utf8.lua"; "zip.dll"; }
for _, strFile in ipairs (arrFile) do
if fh.FSO:FileExists(strPath..strFile) then
fhMessageBox("\n Detected some old FH V6 library modules. \n\nPlease remove them by running the plugin: \n\n 'Delete old FH6 Plugin Module Files' \n","MB_OK","MB_ICONEXCLAMATION")
break
end
end
end
end -- function DetectOldModules
if fhGetAppVersion() > 6 then unpack = table.unpack end
-- Invoke FH Shell Execute API --
function fh.DoExecute(strExecutable,...)
-- strExecutable ~ full path of executable
-- ... ~ parameter list and optional error reporting function
-- return value ~ true if successful else false
local arg = {...}
local errFunction = fhMessageBox
if type(arg[#arg]) == 'function' then
errFunction = arg[#arg]
table.remove(arg)
end
local isOK, intErrorCode, strErrorText = fhShellExecute(strExecutable,unpack(arg))
if not isOK then
errFunction(tostring(strErrorText).." ("..tostring(intErrorCode)..")")
end
return isOK
end -- function DoExecute
-- Obtain the Day Number for any Date Point -- -- Fix problems with invalid dates in DayNumber function
function fh.GetDayNumber(datDate)
-- datDate ~ date point
-- return value ~ day number
if datDate:IsNull() then return 0 end
local intDay = fhCallBuiltInFunction("DayNumber",datDate) -- Only works for Gregorian dates that were not skipped nor BC dates
if not intDay then
local strError = "because " -- Error message reason -- V3.0
local calendar = datDate:GetCalendar()
local oldMonth = datDate:GetMonth()
local oldDayNo = datDate:GetDay()
local intMonth = math.min( oldMonth, 12 ) -- Limit month to 12, and day to last of each month
local intDayNo = math.min( oldDayNo, ({0;31;28;31;30;31;30;31;31;30;31;30;31;})[intMonth+1] )
local intYear = datDate:GetYear()
if oldDayNo > intDayNo then strError = strError.."day "..oldDayNo.." too big " end
if oldMonth > intMonth then strError = strError.."month "..oldMonth.." too big " end
if calendar == "Hebrew" and intYear > 3761 then
intYear = intYear - 3761
strError = strError.."Hebrew year > 3761 "
elseif calendar ~= "Gregorian" then
strError = strError..calendar.." disallowed "
end
if intYear == 1752 and intMonth == 9 and intDayNo <= 13 then -- Use 2 Sep 1752 for 3 - 13 Sep 1752 dates skipped
intDayNo = 2
strError = strError.."3 - 13 Sep 1752 skipped "
elseif intYear == 1582 and intMonth == 10 and intDayNo <= 14 then -- Use 4 Oct 1582 for 5 - 14 Oct 1582 dates skipped
intDayNo = 4
strError = strError.."5 - 14 Oct 1582 skipped "
end
local setDate = fhNewDatePt(intYear,intMonth,intDayNo,datDate:GetYearDD())
intDay = fhCallBuiltInFunction("DayNumber",setDate) -- Remove BC and Julian, Hebrew, French calendars
if not intDay then intDay = 0 end
local oldDate = fhNewDate() oldDate:SetSimpleDate(datDate) -- Report problem to user
local newDate = fhNewDate() newDate:SetSimpleDate(setDate)
local strIsBC = ""
if datDate:GetBC() then
strError = strError.." B.C. disallowed "
intDay = -intDay
strIsBC = "and Day Number negated"
end
fhMessageBox("\n Get Day Number issue for date \n "..oldDate:GetDisplayText().." \n "..strError.." \n So replaced it with date \n "..newDate:GetDisplayText().." \n "..strIsBC,"MB_OK","MB_ICONEXCLAMATION")
end
return intDay
end -- function GetDayNumber
local dtpYearMin = fhNewDatePt(1000) -- Minimum year to use when earliest estimate is null
local dtpYearMax = fhNewDatePt(2000) -- Maximum year to use when latest estimate is null
function fh.GetYearToday() -- Get the Year for Today
-- return value ~ integer year today
local intYearToday = fhCallBuiltInFunction("Year",fhCallBuiltInFunction("Today"))
dtpYearMax = fhNewDatePt(intYearToday) -- Set maximum year date point
return intYearToday
end -- function GetYearToday()
local function getDeathFacts(ptrIndi) -- Iterate Death, Burial, Cremation facts
-- ptrIndi ~ pointer to individual
-- return value ~ pointer to fact
local arrFact = { "~.DEAT"; "~.BURI"; "~.CREM"; }
local intFact = 0
local ptrFact = fhNewItemPtr() -- Pointer to each fact returned to user
return function ()
while intFact < #arrFact do
intFact = intFact + 1
ptrFact = fhGetItemPtr(ptrIndi,arrFact[intFact])
if ptrFact:IsNotNull() then return ptrFact end
end
end
end -- local function getDeathFacts
-- Ensure Estimated Date EARLIEST <= LATEST <= Fact Date -- -- Fix errors in EstimatedBirth/DeathDate function
local function estimatedDates(strFunc,ptrIndi,intGens,getFact,intYrs)
-- strFunc ~ "EstimatedBirthDate" or "EstimatedDeathDate"
-- ptrIndi ~ Individual of interest
-- intGens ~ Number of generations (may be nil)
-- getFact ~ Iterator function for facts
-- intYrs ~ Years to add to After dates
-- return values ~ EARLIEST, MID, LATEST dates
intGens = intGens or 2
local dtpMin = fhCallBuiltInFunction(strFunc,ptrIndi,"EARLIEST",intGens)
local dtpMax = fhCallBuiltInFunction(strFunc,ptrIndi,"LATEST",intGens)
local dtpMid = fhNewDatePt()
if not ( dtpMin:IsNull() and dtpMax:IsNull() ) then -- Skip if both null
if dtpMax:IsNull() then dtpMax = dtpYearMax elseif dtpMin:IsNull() then dtpMin = dtpYearMin end
for ptrFact in getFact(ptrIndi) do
local datFact = fhGetValueAsDate(fhGetItemPtr(ptrFact,"~.DATE"))
if not datFact:IsNull() then -- Find 1st Fact Date
local dtpLast = datFact:GetDatePt1() -- Last date = DatePt1 for Simple, Range, and Before
local strType = datFact:GetSubtype() -- Between = DatePt2 and After = DatePt1 + intYrs
if strType == "Between" then dtpLast = datFact:GetDatePt2()
elseif strType == "After" then dtpLast = fhNewDatePt(dtpLast:GetYear()+intYrs,dtpLast:GetMonth(),dtpLast:GetDay()) end -- Compare only uses Year, Month, Day so omitted ,dtpLast:GetYearDD(),dtpLast:GetBC(),dtpLast:GetCalendar()
if dtpMax:Compare(dtpLast) > 0 then dtpMax = dtpLast end
if dtpMin:Compare(dtpMax) > 0 then dtpMin = dtpMax end
if strType ~= "After" then break end -- Now EARLIEST <= LATEST <= Last date
end
end
local intDays = ( fh.GetDayNumber(dtpMax) - fh.GetDayNumber(dtpMin) ) / 2
local intYear,remYear = math.modf( intDays / 365.2422 ) -- Offset year @ 365.2422 days per year, and remainder fraction
local intMnth = math.floor( ( remYear * 12 ) + 0.1 ) -- Offset month is remainder fraction of year * 12
dtpMid = fhCallBuiltInFunction("CalcDate",dtpMin,intYear,intMnth) -- Need approximate MID year & month
end
return { Min=dtpMin; Mid=dtpMid; Max=dtpMax; } -- Return EARLIEST, MID, LATEST dates
end -- local function estimatedDates
-- Make EstimatedBirthDate EARLIEST <= LATEST <= 1st Fact Date -- -- Fix errors in EstimatedBirthDate function
function fh.EstimatedBirthDates(ptrIndi,intGens)
-- ptrInd ~ pointer to individual
-- intGens ~ generations to include
-- return values ~ EARLIEST, MID, LATEST dates
return estimatedDates("EstimatedBirthDate",ptrIndi,intGens,iterate.Facts,10)
end -- function EstimatedBirthDates
-- Make EstimatedDeathDate EARLIEST <= LATEST <= DEAT/BURI/CREM Date -- -- Fix errors in EstimatedDeathDate function
function fh.EstimatedDeathDates(ptrIndi,intGens)
-- ptrInd ~ pointer to individual
-- intGens ~ generations to include
-- return values ~ EARLIEST, MID, LATEST dates
return estimatedDates("EstimatedDeathDate",ptrIndi,intGens,getDeathFacts,100)
end -- function EstimatedDeathDates
--[[
@function: BuildDataRef
@description: Get Full Data Reference for Pointer
@parameters: Item Pointer
@returns: Data Reference String, Record Id Integer, Record Type Tag String
@requires: None
]]
function fh.BuildDataRef(ptrRef)
local strDataRef = "" -- Data Reference with instance indices e.g. INDI.RESI[2].ADDR
local intRecId = 0 -- Record Id for associated Record
local strRecTag = "" -- Record Tag of associated Record type i.e. INDI, FAM, NOTE, SOUR, etc
-- getDataRef() is called recursively per level of the Data Ref
-- ptrRef points to the upper Data Ref levels yet to be analysed
-- strRef compiles the lower Data Ref levels including instances
local function getDataRef(ptrRef,strRef)
local ptrTag = ptrRef:Clone()
local strTag = fhGetTag(ptrTag) -- Current level Tag
ptrTag:MoveToParentItem(ptrTag)
if ptrTag:IsNotNull() then -- Parent level exists
local intSib = 1
local ptrSib = ptrRef:Clone() -- Pointer to siblings with same Tag
ptrSib:MovePrev("SAME_TAG")
while ptrSib:IsNotNull() do -- Count previous siblings with same Tag
intSib = intSib + 1
ptrSib:MovePrev("SAME_TAG")
end
if intSib > 1 then strTag = strTag.."["..intSib.."]" end
getDataRef(ptrTag,"."..strTag..strRef) -- Now analyse the parent level
else
strDataRef = strTag..strRef -- Record level reached, so set return values
intRecId = fhGetRecordId(ptrRef)
strRecTag = strTag
if not fhIsValidDataRef(strDataRef) then print("BuildDataRef: "..strDataRef.." is Invalid") end
end
end -- local function getDataRef
if type(ptrRef) == "userdata" then getDataRef(ptrRef,"") end
return strDataRef, intRecId, strRecTag
end -- function BuildDataRef
--[[
@function: GetDataRefPtr
@description: Get Pointer for Full Data Reference
@parameters: Data Reference String, Record Id Integer, Record Type Tag String (optional)
@returns: Item Pointer which IsNull() if any parameters are invalid
@requires: None
]]
function fh.GetDataRefPtr(strDataRef,intRecId,strRecTag)
strDataRef = strDataRef or ""
if not strRecTag then
strRecTag = strDataRef:gsub("^(%u+).*$","%1") -- Extract Record Tag from Data Ref
end
local ptrRef = fhNewItemPtr()
ptrRef:MoveToRecordById(strRecTag,intRecId or 0) -- Lookup the Record by Id
ptrRef:MoveTo(ptrRef,strDataRef) -- Move to the Data Ref
return ptrRef
end -- function GetDataRefPtr
function fh.TblDataRef(ptrRef)
local tblRef = {}
tblRef.DataRef, tblRef.RecId, tblRef.RecTag = BuildDataRef(ptrRef)
return tblRef
end -- function TblDataRef
function fh.PtrDataRef(tblRef)
local tblRef = tblRef or {} -- Ensure table and its fields exist
return GetDataRefPtr(tblRef.DataRef or "",tblRef.RecId or 0,tblRef.RecTag or "")
end -- function PtrDataRef
return fh
end -- local function general_v3
local general = general_v3() -- To access FH general tools module
--[[
@Module: +fh+tablex_v3
@Author: Mike Tate
@Version: 3.1
@LastUpdated: 08 Jan 2022
@Description: A Table Load Save Module.
@V3.1: Cater for full UTF-8 filenames.
@V3.0: Function Prototype Closure version.
@V1.2: Added local definitions of _ to ensure nil gets returned on error.
@V1.1: ?
@V1.0: Initial version 0.94 is Lua 5.1 compatible.
]]
local function tablex_v3()
local fh = {} -- Local environment table
------------------------------------------------------ Start Table Load Save
-- require "_tableloadsave"
--[[
Save Table to File/Stringtable
Load Table from File/Stringtable
v 0.94
Lua 5.1 compatible
Userdata and indices of these are not saved
Functions are saved via string.dump, so make sure it has no upvalues
References are saved
----------------------------------------------------
table.save( table [, filename] )
Saves a table so it can be called via the table.load function again
table must a object of type 'table'
filename is optional, and may be a string representing a filename or true/1
table.save( table )
on success: returns a string representing the table (stringtable)
(uses a string as buffer, ideal for smaller tables)
table.save( table, true or 1 )
on success: returns a string representing the table (stringtable)
(uses io.tmpfile() as buffer, ideal for bigger tables)
table.save( table, "filename" )
on success: returns 1
(saves the table to file "filename")
on failure: returns as second argument an error msg
----------------------------------------------------
table.load( filename or stringtable )
Loads a table that has been saved via the table.save function
on success: returns a previously saved table
on failure: returns as second argument an error msg
----------------------------------------------------
chillcode, http://lua-users.org/wiki/SaveTableToFile
Licensed under the same terms as Lua itself.
]]--
-- declare local variables
--// exportstring( string )
--// returns a "Lua" portable version of the string
local function exportstring( s )
s = string.format( "%q",s )
-- to replace
s = string.gsub( s,"\\\n","\\n" )
s = string.gsub( s,"\r","\\r" )
s = string.gsub( s,string.char(26),"\"..string.char(26)..\"" )
return s
end
--// The Save Function
function fh.save( tbl,filename )
local charS,charE = " ","\n"
local file,err,_,stransi,wasansi -- V1.2 -- V3.1 -- Added _,stransi,wasansi --!
-- create a pseudo file that writes to a string and return the string
if not filename then
file = { write = function( self,newstr ) self.str = self.str..newstr end, str = "" }
charS,charE = "",""
-- write table to tmpfile
elseif filename == true or filename == 1 then
charS,charE,file = "","",io.tmpfile()
-- write table to file
-- use io.open here rather than io.output, since in windows when clicking on a file opened with io.output will create an error
else
stransi,wasansi = general.FileNameToANSI(filename) -- V3.1 -- Cater for non-ANSI filename --!
file,err = io.open( stransi, "w" )
if err then return _,err end
end
-- initiate variables for save procedure
local tables,lookup = { tbl },{ [tbl] = 1 }
file:write( "return {"..charE )
for idx,t in ipairs( tables ) do
if filename and filename ~= true and filename ~= 1 then
file:write( "-- Table: {"..idx.."}"..charE )
end
file:write( "{"..charE )
local thandled = {}
for i,v in ipairs( t ) do
thandled[i] = true
-- escape functions and userdata
if type( v ) ~= "userdata" then
-- only handle value
if type( v ) == "table" then
if not lookup[v] then
table.insert( tables, v )
lookup[v] = #tables
end
file:write( charS.."{"..lookup[v].."},"..charE )
elseif type( v ) == "function" then
file:write( charS.."loadstring("..exportstring(string.dump( v )).."),"..charE )
else
local value = ( type( v ) == "string" and exportstring( v ) ) or tostring( v )
file:write( charS..value..","..charE )
end
end
end
for i,v in pairs( t ) do
-- escape functions and userdata
if (not thandled[i]) and type( v ) ~= "userdata" then
-- handle index
if type( i ) == "table" then
if not lookup[i] then
table.insert( tables,i )
lookup[i] = #tables
end
file:write( charS.."[{"..lookup[i].."}]=" )
else
local index = ( type( i ) == "string" and "["..exportstring( i ).."]" ) or string.format( "[%d]",i )
file:write( charS..index.."=" )
end
-- handle value
if type( v ) == "table" then
if not lookup[v] then
table.insert( tables,v )
lookup[v] = #tables
end
file:write( "{"..lookup[v].."},"..charE )
elseif type( v ) == "function" then
file:write( "loadstring("..exportstring(string.dump( v )).."),"..charE )
else
local value = ( type( v ) == "string" and exportstring( v ) ) or tostring( v )
file:write( value..","..charE )
end
end
end
file:write( "},"..charE )
end
file:write( "}" )
-- Return Values
-- return stringtable from string
if not filename then
-- set marker for stringtable
return file.str.."--|"
-- return stringttable from file
elseif filename == true or filename == 1 then
file:seek ( "set" )
-- no need to close file, it gets closed and removed automatically
-- set marker for stringtable
return file:read( "*a" ).."--|"
-- close file and return 1
else
file:close()
if not ( wasansi ) then -- V3.1 -- Cater for non-ANSI filename --!
general.MoveFile(stransi,filename)
end
return 1
end
end
--// The Load Function
function fh.load( sfile )
local tables,err,_ -- V1.2 -- Added _
-- catch marker for stringtable
if string.sub( sfile,-3,-1 ) == "--|" then
tables,err = loadstring( sfile )
else
local stransi,wasansi = general.FileNameToANSI(sfile) -- V3.1 -- Cater for non-ANSI filename --!
if not ( wasansi ) then
general.CopyFile(sfile,stransi)
end
tables,err = loadfile( stransi )
if not ( wasansi ) then
general.DeleteFile(stransi) -- V3.1 -- Cater for non-ANSI filename --!
end
end
if err then return _,err
end
tables = tables()
for idx = 1,#tables do
local tolinkv,tolinki = {},{}
for i,v in pairs( tables[idx] ) do
if type( v ) == "table" and tables[v[1]] then
table.insert( tolinkv,{ i,tables[v[1]] } )
end
if type( i ) == "table" and tables[i[1]] then
table.insert( tolinki,{ i,tables[i[1]] } )
end
end
-- link values, first due to possible changes of indices
for _,v in ipairs( tolinkv ) do
tables[idx][v[1]] = v[2]
end
-- link indices
for _,v in ipairs( tolinki ) do
tables[idx][v[2]],tables[idx][v[1]] = tables[idx][v[1]],nil
end
end
return tables[1]
end
------------------------------------------------------ End Table Load Save
-- overload fh functions into table
for strIndex, anyValue in pairs(fh) do
if type(anyValue) == "function" then
table[strIndex] = anyValue
end
end
return fh
end -- local function tablex_v3
local tablex = tablex_v3 () -- To access FH table extension module
--[[
@Module: +fh+encoder_v3
@Author: Mike Tate
@Version: 3.5
@LastUpdated: 25 Aug 2020
@Description: Text encoder module for HTML XHTML XML URI UTF8 UTF16 ISO CP1252/ANSI character codings.
@V3.5: Function Prototype Closure version with Lua 5.1 & 5.3 comaptibility.
@V3.4: Ensure expressions involving gsub return just text parameter.
@V3.3: Adds UNICODE U+10000 to U+10FFFF UTF-16 Supplementary Planes.
@V3.2: Update for ANSI & Unicode to ASCII for sorting, Soundex, etc.
@V3.1: Update for Unicode UTF-16 & UTF-8 and fhConvertANSItoUTF8 & fhConvertUTF8toANSI, name change UTF to UTF8 & CP to ANSI.
@V2.0: StrUTF8_Encode() replaced by StrUTF_CP1252() for entire UTF-8 range, plus new StrCP1252_ISO().
@V1.0: Initial version.
]]
local function encoder_v3()
local fh = {} -- Local environment table
local fhVersion = fhGetAppVersion()
local br_Tag = "
" -- Markup language break tag default
local br_Lua = "
" -- Lua pattern for break tag recognition
local tblCodePage = {} -- Code Page to XML/XHTML/HTML/URI/UTF8 encodings: http://en.wikipedia.org/wiki/Windows-1252 & 1250 & etc
-- Control characters "\000" to "\031" for URI & Markup "[%c]" encodings are disallowed except for "\t" to "\r"
tblCodePage["\000"] = "" -- NUL
tblCodePage["\001"] = "" -- SOH
tblCodePage["\002"] = "" -- STX
tblCodePage["\003"] = "" -- ETX
tblCodePage["\004"] = "" -- EOT
tblCodePage["\005"] = "" -- ENQ
tblCodePage["\006"] = "" -- ACK
tblCodePage["\a"] = "" -- BEL
tblCodePage["\b"] = "" -- BS
tblCodePage["\t"] = "+" -- HT space in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["\n"] = "%0A" -- LF br_Tag in Markup
tblCodePage["\v"] = "%0A" -- VT br_Tag in Markup
tblCodePage["\f"] = "%0A" -- FF br_Tag in Markup
tblCodePage["\r"] = "%0D" -- CR br_Tag in Markup
tblCodePage["\014"] = "" -- SO
tblCodePage["\015"] = "" -- SI
tblCodePage["\016"] = "" -- DLE
tblCodePage["\017"] = "" -- DC1
tblCodePage["\018"] = "" -- DC2
tblCodePage["\019"] = "" -- DC3
tblCodePage["\020"] = "" -- DC4
tblCodePage["\021"] = "" -- NAK
tblCodePage["\022"] = "" -- SYN
tblCodePage["\023"] = "" -- ETB
tblCodePage["\024"] = "" -- CAN
tblCodePage["\025"] = "" -- EM
tblCodePage["\026"] = "" -- SUB
tblCodePage["\027"] = "" -- ESC
tblCodePage["\028"] = "" -- FS
tblCodePage["\029"] = "" -- GS
tblCodePage["\030"] = "" -- RS
tblCodePage["\031"] = "" -- US
-- ASCII characters "\032" to "\127" for URI "[%s%p]" encodings: http://en.wikipedia.org/wiki/URL and http://en.wikipedia.org/wiki/Percent-encoding
tblCodePage[" "] = "+" -- or "%20" Space
tblCodePage["!"] = "%21" -- Reserved character
tblCodePage['"'] = "%22" -- """ in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["#"] = "%23" -- Reserved character
tblCodePage["$"] = "%24" -- Reserved character
tblCodePage["%"] = "%25" -- Must be encoded
tblCodePage["&"] = "%26" -- Reserved character -- "&" in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["'"] = "%27" -- Reserved character -- "'" in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["("] = "%28" -- Reserved character
tblCodePage[")"] = "%29" -- Reserved character
tblCodePage["*"] = "%2A" -- Reserved character
tblCodePage["+"] = "%2B" -- Reserved character
tblCodePage[","] = "%2C" -- Reserved character
-- tblCodePage["-"] = "%2D" -- Unreserved character not encoded
-- tblCodePage["."] = "%2E" -- Unreserved character not encoded
tblCodePage["/"] = "%2F" -- Reserved character
-- Digits 0 to 9 -- Unreserved characters not encoded
tblCodePage[":"] = "%3A" -- Reserved character
tblCodePage[";"] = "%3B" -- Reserved character
tblCodePage["<"] = "%3C" -- "<" in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["="] = "%3D" -- Reserved character
tblCodePage[">"] = "%3E" -- ">" in Markup see setURIEncodings() and setMarkupEncodings() below
tblCodePage["?"] = "%3F" -- Reserved character
tblCodePage["@"] = "%40" -- Reserved character
-- Letters A to Z -- Unreserved characters not encoded
tblCodePage["["] = "%5B" -- Reserved character
tblCodePage["\\"]= "%5C"
tblCodePage["]"] = "%5D" -- Reserved character
tblCodePage["^"] = "%5E"
-- tblCodePage["_"] = "%5F" -- Unreserved character not encoded
tblCodePage["`"] = "%60"
-- Letters a to z -- Unreserved characters not encoded
tblCodePage["{"] = "%7B"
tblCodePage["|"] = "%7C"
tblCodePage["}"] = "%7D"
-- tblCodePage["~"] = "%7E" -- Unreserved character not encoded
tblCodePage["\127"] = "" -- DEL
-- Code Page 1252 Unicode characters "\128" to "\255" for UTF-8 scheme "[€-ÿ]" encodings: http://en.wikipedia.org/wiki/UTF-8
tblCodePage["€"] = string.char(0xE2,0x82,0xAC) -- "€"
tblCodePage["\129"] = "" -- Undefined
tblCodePage["‚"] = string.char(0xE2,0x80,0x9A)
tblCodePage["ƒ"] = string.char(0xC6,0x92)
tblCodePage["„"] = string.char(0xE2,0x80,0x9E)
tblCodePage["…"] = string.char(0xE2,0x80,0xA6)
tblCodePage["†"] = string.char(0xE2,0x80,0xA0)
tblCodePage["‡"] = string.char(0xE2,0x80,0xA1)
tblCodePage["ˆ"] = string.char(0xCB,0x86)
tblCodePage["‰"] = string.char(0xE2,0x80,0xB0)
tblCodePage["Š"] = string.char(0xC5,0xA0)
tblCodePage["‹"] = string.char(0xE2,0x80,0xB9)
tblCodePage["Œ"] = string.char(0xC5,0x92)
tblCodePage["\141"] = "" -- Undefined
tblCodePage["Ž"] = string.char(0xC5,0xBD)
tblCodePage["\143"] = "" -- Undefined
tblCodePage["\144"] = "" -- Undefined
tblCodePage["‘"] = string.char(0xE2,0x80,0x98)
tblCodePage["’"] = string.char(0xE2,0x80,0x99)
tblCodePage["“"] = string.char(0xE2,0x80,0x9C)
tblCodePage["”"] = string.char(0xE2,0x80,0x9D)
tblCodePage["•"] = string.char(0xE2,0x80,0xA2)
tblCodePage["–"] = string.char(0xE2,0x80,0x93)
tblCodePage["—"] = string.char(0xE2,0x80,0x94)
tblCodePage["\152"] = string.char(0xCB,0x9C) -- Small Tilde
tblCodePage["™"] = string.char(0xE2,0x84,0xA2)
tblCodePage["š"] = string.char(0xC5,0xA1)
tblCodePage["›"] = string.char(0xE2,0x80,0xBA)
tblCodePage["œ"] = string.char(0xC5,0x93)
tblCodePage["\157"] = "" -- Undefined
tblCodePage["ž"] = string.char(0xC5,0xBE)
tblCodePage["Ÿ"] = string.char(0xC5,0xB8)
tblCodePage["\160"] = string.char(0xC2,0xA0) -- " " No Break Space
tblCodePage["¡"] = string.char(0xC2,0xA1) -- "¡"
tblCodePage["¢"] = string.char(0xC2,0xA2) -- "¢"
tblCodePage["£"] = string.char(0xC2,0xA3) -- "£"
tblCodePage["¤"] = string.char(0xC2,0xA4) -- "¤"
tblCodePage["¥"] = string.char(0xC2,0xA5) -- "¥"
tblCodePage["¦"] = string.char(0xC2,0xA6)
tblCodePage["§"] = string.char(0xC2,0xA7)
tblCodePage["¨"] = string.char(0xC2,0xA8)
tblCodePage["©"] = string.char(0xC2,0xA9)
tblCodePage["ª"] = string.char(0xC2,0xAA)
tblCodePage["«"] = string.char(0xC2,0xAB)
tblCodePage["¬"] = string.char(0xC2,0xAC)
tblCodePage[""] = string.char(0xC2,0xAD) -- "" Soft Hyphen
tblCodePage["®"] = string.char(0xC2,0xAE)
tblCodePage["¯"] = string.char(0xC2,0xAF)
tblCodePage["°"] = string.char(0xC2,0xB0)
tblCodePage["±"] = string.char(0xC2,0xB1)
tblCodePage["²"] = string.char(0xC2,0xB2)
tblCodePage["³"] = string.char(0xC2,0xB3)
tblCodePage["´"] = string.char(0xC2,0xB4)
tblCodePage["µ"] = string.char(0xC2,0xB5)
tblCodePage["¶"] = string.char(0xC2,0xB6)
tblCodePage["·"] = string.char(0xC2,0xB7)
tblCodePage["¸"] = string.char(0xC2,0xB8)
tblCodePage["¹"] = string.char(0xC2,0xB9)
tblCodePage["º"] = string.char(0xC2,0xBA)
tblCodePage["»"] = string.char(0xC2,0xBB)
tblCodePage["¼"] = string.char(0xC2,0xBC)
tblCodePage["½"] = string.char(0xC2,0xBD)
tblCodePage["¾"] = string.char(0xC2,0xBE)
tblCodePage["¿"] = string.char(0xC2,0xBF)
tblCodePage["À"] = string.char(0xC3,0x80)
tblCodePage["Á"] = string.char(0xC3,0x81)
tblCodePage["Â"] = string.char(0xC3,0x82)
tblCodePage["Ã"] = string.char(0xC3,0x83)
tblCodePage["Ä"] = string.char(0xC3,0x84)
tblCodePage["Å"] = string.char(0xC3,0x85)
tblCodePage["Æ"] = string.char(0xC3,0x86)
tblCodePage["Ç"] = string.char(0xC3,0x87)
tblCodePage["È"] = string.char(0xC3,0x88)
tblCodePage["É"] = string.char(0xC3,0x89)
tblCodePage["Ê"] = string.char(0xC3,0x8A)
tblCodePage["Ë"] = string.char(0xC3,0x8B)
tblCodePage["Ì"] = string.char(0xC3,0x8C)
tblCodePage["Í"] = string.char(0xC3,0x8D)
tblCodePage["Î"] = string.char(0xC3,0x8E)
tblCodePage["Ï"] = string.char(0xC3,0x8F)
tblCodePage["Ð"] = string.char(0xC3,0x90)
tblCodePage["Ñ"] = string.char(0xC3,0x91)
tblCodePage["Ò"] = string.char(0xC3,0x92)
tblCodePage["Ó"] = string.char(0xC3,0x93)
tblCodePage["Ô"] = string.char(0xC3,0x94)
tblCodePage["Õ"] = string.char(0xC3,0x95)
tblCodePage["Ö"] = string.char(0xC3,0x96)
tblCodePage["×"] = string.char(0xC3,0x97)
tblCodePage["Ø"] = string.char(0xC3,0x98)
tblCodePage["Ù"] = string.char(0xC3,0x99)
tblCodePage["Ú"] = string.char(0xC3,0x9A)
tblCodePage["Û"] = string.char(0xC3,0x9B)
tblCodePage["Ü"] = string.char(0xC3,0x9C)
tblCodePage["Ý"] = string.char(0xC3,0x9D)
tblCodePage["Þ"] = string.char(0xC3,0x9E)
tblCodePage["ß"] = string.char(0xC3,0x9F)
tblCodePage["à"] = string.char(0xC3,0xA0)
tblCodePage["á"] = string.char(0xC3,0xA1)
tblCodePage["â"] = string.char(0xC3,0xA2)
tblCodePage["ã"] = string.char(0xC3,0xA3)
tblCodePage["ä"] = string.char(0xC3,0xA4)
tblCodePage["å"] = string.char(0xC3,0xA5)
tblCodePage["æ"] = string.char(0xC3,0xA6)
tblCodePage["ç"] = string.char(0xC3,0xA7)
tblCodePage["è"] = string.char(0xC3,0xA8)
tblCodePage["é"] = string.char(0xC3,0xA9)
tblCodePage["ê"] = string.char(0xC3,0xAA)
tblCodePage["ë"] = string.char(0xC3,0xAB)
tblCodePage["ì"] = string.char(0xC3,0xAC)
tblCodePage["í"] = string.char(0xC3,0xAD)
tblCodePage["î"] = string.char(0xC3,0xAE)
tblCodePage["ï"] = string.char(0xC3,0xAF)
tblCodePage["ð"] = string.char(0xC3,0xB0)
tblCodePage["ñ"] = string.char(0xC3,0xB1)
tblCodePage["ò"] = string.char(0xC3,0xB2)
tblCodePage["ó"] = string.char(0xC3,0xB3)
tblCodePage["ô"] = string.char(0xC3,0xB4)
tblCodePage["õ"] = string.char(0xC3,0xB5)
tblCodePage["ö"] = string.char(0xC3,0xB6)
tblCodePage["÷"] = string.char(0xC3,0xB7)
tblCodePage["ø"] = string.char(0xC3,0xB8)
tblCodePage["ù"] = string.char(0xC3,0xB9)
tblCodePage["ú"] = string.char(0xC3,0xBA)
tblCodePage["û"] = string.char(0xC3,0xBB)
tblCodePage["ü"] = string.char(0xC3,0xBC)
tblCodePage["ý"] = string.char(0xC3,0xBD)
tblCodePage["þ"] = string.char(0xC3,0xBE)
tblCodePage["ÿ"] = string.char(0xC3,0xBF)
-- Set XML/XHTML/HTML "[%c\"&'<>]" Markup encodings: http://en.wikipedia.org/wiki/XML and http://en.wikipedia.org/wiki/HTML
local function setMarkupEncodings()
tblCodePage["\t"] = " " -- HT "\t" to "\r" are treated as white space in Markup Languages by default
tblCodePage["\n"] = br_Tag -- LF
tblCodePage["\v"] = br_Tag -- VT line break tag "
" or "
" or "
" or "
" is better
tblCodePage["\f"] = br_Tag -- FF
tblCodePage["\r"] = br_Tag -- CR
tblCodePage['"'] = """
tblCodePage["&"] = "&"
tblCodePage["'"] = "'"
tblCodePage["<"] = "<"
tblCodePage[">"] = ">"
end -- local function setMarkupEncodings
-- Set URI/URL/URN "[%s%p]" encodings: http://en.wikipedia.org/wiki/URL and http://en.wikipedia.org/wiki/Percent-encoding
local function setURIEncodings()
tblCodePage["\t"] = "+" -- HT space
tblCodePage["\n"] = "%0A" -- LF newline
tblCodePage["\v"] = "%0A" -- VT newline
tblCodePage["\f"] = "%0A" -- FF newline
tblCodePage["\r"] = "%0D" -- CR return
tblCodePage['"'] = "%22"
tblCodePage["&"] = "%26"
tblCodePage["'"] = "%27"
tblCodePage["<"] = "%3C"
tblCodePage[">"] = "%3E"
end -- local function setURIEncodings
-- Encode characters according to gsub pattern & lookup table --
local function strEncode(strText,strPattern,tblPattern)
return ( (strText or ""):gsub(strPattern,tblPattern) ) -- V3.4
end -- local function strEncode
-- Encode CP1252/ANSI characters into UTF-8 codes --
function fh.StrANSI_UTF8(strText)
if fhVersion > 5 then
strText = fhConvertANSItoUTF8(strText)
else
strText = strEncode(strText,"[\127-ÿ]",tblCodePage)
end
return strText
end -- function StrANSI_UTF8
function fh.StrCP_UTF(strText) -- Legacy
return fh.StrANSI_UTF8(strText)
end -- function StrCP1252_UTF8
function fh.StrCP1252_UTF(strText) -- Legacy
return fh.StrANSI_UTF8(strText)
end -- function StrCP1252_UTF
-- Encode CP1252/ANSI or UTF-8 characters into UTF-8 --
function fh.StrEncode_UTF8(strText)
if stringx.encoding() == "ANSI" then
return fh.StrANSI_UTF8(strText)
else
return strText
end
end -- function StrEncode_UTF8
-- Encode CP1252/ANSI characters into XML/XHTML/HTML/UTF8 codes --
local strANSI_XML = "[%z\001-\031\"&'<>\127-ÿ]"
if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0
strANSI_XML = "[\000-\031\"&'<>\127-ÿ]"
end
function fh.StrANSI_XML(strText)
setMarkupEncodings()
strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes br_Tag
strText = strEncode(strText,strANSI_XML,tblCodePage)
return strText
end -- function StrANSI_XML
function StrCP_XML(strText) -- Legacy
return fh.StrANSI_XML(strText)
end -- function StrCP_XML
function StrCP1252_XML(strText) -- Legacy
return fh.StrANSI_XML(strText)
end -- function StrCP1252_XML
-- Encode UTF-8 ASCII characters into XML/XHTML/HTML codes --
local strUTF8_XML = "[%z\001-\031\"&'<>\127]"
if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0
strUTF8_XML = "[\000-\031\"&'<>\127]"
end
function fh.StrUTF8_XML(strText)
setMarkupEncodings()
strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes br_Tag
strText = strEncode(strText,strUTF8_XML,tblCodePage)
return strText
end -- function StrUTF8_XML
-- Encode CP1252/ANSI or UTF-8 ASCII characters into XML/XHTML/HTML codes --
function fh.StrEncode_XML(strText)
if stringx.encoding() == "ANSI" then
return fh.StrANSI_XML(strText)
else
return fh.StrUTF8_XML(strText)
end
end -- function StrEncode_XML
-- Encode Item Text characters into XML/HTML/UTF-8 codes --
function fh.StrGetItem_XML(ptrItem,strTags)
return fh.StrEncode_XML(fhGetItemText(ptrItem,strTags))
end -- function StrGetItem_XML
-- Encode CP1252/ANSI characters into URI codes --
function fh.StrANSI_URI(strText)
setURIEncodings()
strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes %0A
strText = strEncode(strText,"[^0-9A-Za-z]",tblCodePage)
return strText
end -- function StrANSI_URI
function fh.StrCP_URI(strText)
return fh.StrANSI_URI(strText)
end -- function StrCP_URI
function fh.StrCP1252_URI(strText)
return fh.StrANSI_URI(strText)
end -- function StrCP1252_URI
-- Encode UTF-8 ASCII characters into URI codes --
local strUTF8_URI = "[%z\001-\127]"
if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0
strUTF8_URI = "[\000-\127]"
end
function fh.StrUTF8_URI(strText)
setURIEncodings()
strText = (strText or ""):gsub(br_Lua,"\n") -- Convert
&
&
&
to \n that becomes br_Tag
strText = strEncode(strText,strUTF8_URI,tblCodePage)
return strText
end -- function StrUTF8_URI
-- Encode CP1252/ANSI or UTF-8 ASCII characters into URI codes --
function fh.StrEncode_URI(strText)
if stringx.encoding() == "ANSI" then
return fh.StrANSI_URI(strText)
else
return fh.StrUTF8_URI(strText)
end
end -- function StrEncode_URI
function fh.StrUTF8_Encode(strText) -- Legacy from V1.0
return fh.StrUTF8_ANSI(strText)
end -- function StrUTF8_Encode
-- Encode UTF-8 bytes into single CP1252/ANSI character V2.0 upvalues --
local strByteRange = "["..string.char(0xC0).."-"..string.char(0xFF).."]"
local tblBytePoint = {0xC0;0xE0;0xF0;0xF8;0xFC;} -- Byte codes for 2-byte, 3-byte, 4-byte, 5-byte, 6-byte UTF-8
local tblUTF8 = {}
for strByte = string.byte("€"), string.byte("ÿ") do
local strChar = string.char(strByte) -- Use CodePage to UTF-8 table to populate UTF-8 to CodePage table
local strCode = tblCodePage[strChar]
tblUTF8[strCode] = strChar
end
-- Encode UTF-8 bytes into single CP1252/ANSI character --
function fh.StrUTF8_ANSI(strText)
strText = strText or ""
if fhVersion > 5 then return fhConvertUTF8toANSI(strText) end
if strText:match(strByteRange) then -- If text contains characters that need translating then
local intChar = 0 -- Input character index
local strChar = "" -- Current character
local strCode = "" -- UTF-8 multi-byte code
local tblLine = {} -- Translated output line
repeat
intChar = intChar + 1 -- Step through each character in text
strChar = strText:sub(intChar,intChar)
if strChar:match(strByteRange) then -- Convert UTF-8 bytes into CP character
strCode = strChar -- First UTF-8 byte code, whose top bits say how many bytes to append
for intByte, strByte in ipairs(tblBytePoint) do
if string.byte(strChar) >= strByte then
intChar = intChar + 1 -- Append next UTF-8 byte code character
strCode = strCode..strText:sub(intChar,intChar)
else
break
end
end
strChar = tblUTF8[strCode] or "¿" -- Translate UTF-8 code into CP character
end
table.insert(tblLine,strChar) -- Accumulate output char by char
until intChar >= #strText
strText = table.concat(tblLine)
end
return strText
end -- function StrUTF8_ANSI
function fh.StrUTF_CP(strText) -- Legacy
return fh.StrUTF8_ANSI(strText)
end -- function StrUTF_CP
function fh.StrUTF_CP1252(strText) -- Legacy
return fh.StrUTF8_ANSI(strText)
end -- function StrUTF_CP1252
-- Encode CP1252/ANSI or UTF-8 characters into ANSI --
function fh.StrEncode_ANSI(strText)
if stringx.encoding() == "ANSI" then
return strText or ""
else
return fh.StrUTF8_ANSI(strText)
end
end -- function StrEncode_ANSI
-- Set ISO-8859-1 "[\127-Ÿ]" encodings: http://en.wikipedia.org/wiki/ISO/IEC_8859-1
local tblISO8859 = { }
tblISO8859["\127"]="" -- DEL
tblISO8859["€"] = "EUR"
tblISO8859["\129"]="" -- Undefined
tblISO8859["‚"] = "¸"
tblISO8859["ƒ"] = "f"
tblISO8859["„"] = "¸¸"
tblISO8859["…"] = "..."
tblISO8859["†"] = "+"
tblISO8859["‡"] = "±"
tblISO8859["ˆ"] = "^"
tblISO8859["‰"] = "%"
tblISO8859["Š"] = "S"
tblISO8859["‹"] = "<"
tblISO8859["Œ"] = "OE"
tblISO8859["\141"]="" -- Undefined
tblISO8859["Ž"] = "Z"
tblISO8859["\143"]="" -- Undefined
tblISO8859["\144"]="" -- Undefined
tblISO8859["‘"] = "'"
tblISO8859["’"] = "'"
tblISO8859["“"] = '"'
tblISO8859["”"] = '"'
tblISO8859["•"] = "º"
tblISO8859["–"] = "-"
tblISO8859["—"] = "-"
tblISO8859["\152"]="~" -- Small Tilde
tblISO8859["™"] = "TM"
tblISO8859["š"] = "s"
tblISO8859["›"] = ">"
tblISO8859["œ"] = "oe"
tblISO8859["\157"]="" -- Undefined
tblISO8859["ž"] = "z"
tblISO8859["Ÿ"] = "Y"
-- Encode CP1252/ANSI characters into ISO-8859-1 codes --
function fh.StrANSI_ISO(strText)
return strEncode(strText,"[\127-Ÿ]",tblISO8859)
end -- function StrANSI_ISO
function fh.StrCP_ISO(strText) -- Legacy
return fh.StrANSI_ISO(strText)
end -- function StrCP_ISO
function fh.StrCP1252_ISO(strText) -- Legacy
return fh.StrANSI_ISO(strText)
end -- function StrCP1252_ISO
function fh.StrUTF8_ISO(strText)
return fh.StrANSI_ISO(fh.StrUTF8_ANSI(strText))
end -- function StrUTF8_ISO
-- Encode CP1252/ANSI or UTF-8 ASCII characters into ISO-8859-1 codes --
function fh.StrEncode_ISO(strText)
if stringx.encoding() == "ANSI" then
return fh.StrANSI_ISO(strText)
else
return fh.StrUTF8_ISO(strText)
end
end -- function StrEncode_ISO
-- Convert UTF-8 bytes to a UTF-16 word or pair --
local tblByte = {}
local tblLead = { 0x80; 0xC0; 0xE0; 0xF0; 0xF8; 0xFC; }
function fh.StrUtf8toUtf16(strChar)
-- Convert any UTF-8 multibytes to UTF-16 --
local function strUtf8()
if #tblByte > 0 then
local intUtf16 = 0
for intIndex, intByte in ipairs (tblByte) do -- Convert UTF-8 bytes to UNICODE U+0080 to U+10FFFF
if intIndex == 1 then
intUtf16 = intByte - tblLead[#tblByte]
else
intUtf16 = intUtf16 * 0x40 + intByte - 0x80
end
end
if intUtf16 > 0xFFFF then -- U+10000 to U+10FFFF Supplementary Planes -- V2.6
tblByte = {}
intUtf16 = intUtf16 - 0x10000
local intLow10 = 0xDC00 + ( intUtf16 % 0x400 ) -- Low 16-bit Surrogate
local intTop10 = 0xD800 + math.floor( intUtf16 / 0x400 ) -- High 16-bit Surrogate
local intChar1 = intTop10 % 0x100
local intChar2 = math.floor( intTop10 / 0x100 )
local intChar3 = intLow10 % 0x100
local intChar4 = math.floor( intLow10 / 0x100 )
return string.char(intChar1,intChar2,intChar3,intChar4) -- Surrogate 16-bit Pair
end
if intUtf16 < 0xD800 -- U+0080 to U+FFFF (except U+D800 to U+DFFF) -- V2.6
or intUtf16 > 0xDFFF then -- Basic Multilingual Plane
tblByte = {}
local intChar1 = intUtf16 % 0x100
local intChar2 = math.floor( intUtf16 / 0x100 )
return string.char(intChar1,intChar2) -- BPL 16-bit
end
local strUtf8 = "" -- U+D800 to U+DFFF Reserved Code Points -- V2.6
for intIndex, intByte in ipairs (tblByte) do
strUtf8 = strUtf8..string.format("%.2X ",intByte)
end
local strUtf16 = string.format("%.4X ",intUtf16)
fhMessageBox("\n UTF-16 Reserved Code Point U+D800 to U+DFFF \n UTF-16 = "..strUtf16.." UTF-8 = "..strUtf8.."\n Character will be replaced by a question mark. \n","MB_OK","MB_ICONEXCLAMATION")
tblByte = {}
return "?\0"
end
return ""
end -- local function strUtf8
local intUtf8 = string.byte(strChar)
if intUtf8 < 0x80 then -- U+0000 to U+007F (ASCII)
return strUtf8()..strChar.."\0" -- Previous UTF-8 multibytes + current ASCII char
end
if intUtf8 >= 0xC0 then -- Next UTF-8 multibyte start
local strUtf16 = strUtf8()
table.insert(tblByte,intUtf8)
return strUtf16 -- Previous UTF-8 multibytes
end
table.insert(tblByte,intUtf8)
return ""
end -- function StrUtf8toUtf16
-- Encode UTF-8 bytes into UTF-16 words --
function fh.StrUTF8_UTF16(strText)
tblByte = {} -- (0xFF) flushes last UTF-8 character
return ( ((strText or "")..string.char(0xFF)):gsub("(.)",fh.StrUtf8toUtf16) ) -- V3.4
end -- function StrUTF8_UTF16
-- Encode CP1252/ANSI or UTF-8 characters into UTF-16 words --
function fh.StrEncode_UTF16(strText)
if stringx.encoding() == "ANSI" then
strText = fh.StrANSI_UTF8(strText)
end
return fh.StrUTF8_UTF16(strText)
end -- function StrEncode_UTF16
local intTop10 = 0
-- Convert a UTF-16 word or pair to UTF-8 bytes --
function fh.StrUtf16toUtf8(strChar1,strChar2)
local intUtf16 = string.byte(strChar2) * 0x100 + string.byte(strChar1)
if intUtf16 < 0x80 then -- U+0000 to U+007F (ASCII)
return string.char(intUtf16)
end
if intUtf16 < 0x800 then -- U+0080 to U+07FF
local intByte1 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte2 = intUtf16
return string.char( intByte2 + 0xC0, intByte1 + 0x80 )
end
if intUtf16 < 0xD800 -- U+0800 to U+FFFF
or intUtf16 > 0xDFFF then
local intByte1 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte2 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte3 = intUtf16
return string.char( intByte3 + 0xE0, intByte2 + 0x80, intByte1 + 0x80 )
end
if intUtf16 < 0xDC00 then -- U+10000 to U+10FFFF High 16-bit Surrogate Supplementary Planes -- V2.6
intTop10 = ( intUtf16 - 0xD800 ) * 0x400 + 0x10000
return ""
end
intUtf16 = intUtf16 - 0xDC00 + intTop10 -- U+10000 to U+10FFFF Low 16-bit Surrogate Supplementary Planes -- V2.6
local intByte1 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte2 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte3 = intUtf16 % 0x40
intUtf16 = math.floor( intUtf16 / 0x40 )
local intByte4 = intUtf16
return string.char( intByte4 + 0xF0, intByte3 + 0x80, intByte2 + 0x80, intByte1 + 0x80 )
end -- function StrUtf16toUtf8
-- Encode UTF-16 words into UTF-8 bytes --
function fh.StrUTF16_UTF8(strText)
return ( (strText or ""):gsub("(.)(.)",fh.StrUtf16toUtf8) ) -- V3.4
end -- function StrUTF16_UTF8
-- Encode UTF-16 words into ANSI characters --
function fh.StrUTF16_ANSI(strText)
return fh.StrUTF8_ANSI(fh.StrUTF16_UTF8(strText))
end -- function StrUTF16_ANSI
-- Read UTF-16/UTF-8/ANSI file converted to chosen encoding via line iterator --
local strUtf16 = "^.%z"
if fhVersion > 6 then -- Cater for Lua 5.1 %z or Lua 5.3 \0
strUtf16 = "^.\0"
end
function fh.FileLines(strFileName,strEncoding) -- Derived from http://lua-users.org/wiki/EnhancedFileLines
local bomUtf16= "^"..string.char(0xFF,0xFE) -- "ÿþ"
local bomUtf8 = "^"..string.char(0xEF,0xBB,0xBF) -- ""
local fncConv = tostring -- Function to convert input to current encoding
local intHead = 1 -- Index to start of current text line
local intLump = 1024
local fHandle = general.OpenFile(strFileName,"rb")
local strText = fHandle:read(1024) -- Read first lump from file
local intBOM = 0
strEncoding = strEncoding or string.encoding()
if strText:match(bomUtf16)
or strText:match(strUtf16) then
strText,intBOM = strText:gsub(bomUtf16,"") -- Strip UTF-16 BOM
if strEncoding == "ANSI" then -- Define UTF-16 conversion to current encoding
fncConv = fh.StrUTF16_ANSI
else
fncConv = fh.StrUTF16_UTF8
end
elseif strText:match(bomUtf8) then
strText,intBOM = strText:gsub(bomUtf8,"") -- Strip UTF-8 BOM
if strEncoding == "ANSI" then -- Define UTF-8 conversion to current encoding
fncConv = fh.StrUTF8_ANSI
end
else
if strEncoding == "UTF-8" then -- Define ANSI conversion to current encoding
fncConv = fh.StrANSI_UTF8
end
end
strText = fncConv(strText) -- Convert first lump of text
return function() -- Iterator function
local intTail,strTail -- Index to end of current text line, and terminating characters
while true do
intTail, strTail = strText:match("()([\r\n].)",intHead)
if intTail or not fHandle then
if intHead > 1 then intLump = 0 end
break -- End of line or end of file
elseif fHandle then
local strLump = fHandle:read(1024) -- Read next lump from file
if strLump then -- Strip old text and add converted lump
strText = strText:sub(intHead)..fncConv(strLump)
intHead = 1
intLump = 1024
else
assert(fHandle:close()) -- End of file
fHandle = nil
end
end
end
if not intTail then
intTail = #strText -- Last fragment of file
elseif strTail == "\r\n" then
intTail = intTail + 1 -- Adjust tail for both \r & \n
end
local strLine = strText:sub(intHead,intTail) -- Extract line from text
intHead = intTail + 1
if #strLine > 0 then -- Return pruned line, tail chars, lump bytes read
local strBody, strTail = strLine:match("^(.-)([\r\n]+)$")
return strBody, strTail, intLump
end
end
end -- function FileLines
-- Set "[€-ÿ]" ASCII encodings same as Unidecode below
local tblASCII = { }
tblASCII["€"] = "=E"
tblASCII["\129"]="" -- Undefined
tblASCII["‚"] = ","
tblASCII["ƒ"] = "f"
tblASCII["„"] = ",,"
tblASCII["…"] = "..."
tblASCII["†"] = "|+"
tblASCII["‡"] = "|++"
tblASCII["ˆ"] = "^"
tblASCII["‰"] = "%0"
tblASCII["Š"] = "S"
tblASCII["‹"] = "<"
tblASCII["Œ"] = "OE"
tblASCII["\141"]="" -- Undefined
tblASCII["Ž"] = "Z"
tblASCII["\143"]="" -- Undefined
tblASCII["\144"]="" -- Undefined
tblASCII["‘"] = "'"
tblASCII["’"] = "'"
tblASCII["“"] = "\""
tblASCII["”"] = "\""
tblASCII["•"] = "*"
tblASCII["–"] = "-"
tblASCII["—"] = "--"
tblASCII["\152"]="~" -- Small Tilde
tblASCII["™"] = "TM"
tblASCII["š"] = "s"
tblASCII["›"] = ">"
tblASCII["œ"] = "oe"
tblASCII["\157"]="" -- Undefined
tblASCII["ž"] = "z"
tblASCII["Ÿ"] = "Y"
tblASCII["\160"]=" " -- " " No Break Space
tblASCII["¡"] = "!" -- "¡"
tblASCII["¢"] = "=c" -- "¢"
tblASCII["£"] = "=L" -- "£"
tblASCII["¤"] = "=$" -- "¤"
tblASCII["¥"] = "=Y" -- "¥"
tblASCII["¦"] = "|"
tblASCII["§"] = "=SS"
tblASCII["¨"] = "\""
tblASCII["©"] = "(C)"
tblASCII["ª"] = "a"
tblASCII["«"] = "<<"
tblASCII["¬"] = "-"
tblASCII[""] = "-" -- "" Soft Hyphen
tblASCII["®"] = "(R)"
tblASCII["¯"] = "-"
tblASCII["°"] = "=o"
tblASCII["±"] = "+-"
tblASCII["²"] = "2"
tblASCII["³"] = "3"
tblASCII["´"] = "'"
tblASCII["µ"] = "=u"
tblASCII["¶"] = "=p"
tblASCII["·"] = "*"
tblASCII["¸"] = ","
tblASCII["¹"] = "1"
tblASCII["º"] = "o"
tblASCII["»"] = ">>"
tblASCII["¼"] = "1/4"
tblASCII["½"] = "1/2"
tblASCII["¾"] = "3/4"
tblASCII["¿"] = "?"
tblASCII["À"] = "A"
tblASCII["Á"] = "A"
tblASCII["Â"] = "A"
tblASCII["Ã"] = "A"
tblASCII["Ä"] = "A"
tblASCII["Å"] = "A"
tblASCII["Æ"] = "AE"
tblASCII["Ç"] = "C"
tblASCII["È"] = "E"
tblASCII["É"] = "E"
tblASCII["Ê"] = "E"
tblASCII["Ë"] = "E"
tblASCII["Ì"] = "I"
tblASCII["Í"] = "I"
tblASCII["Î"] = "I"
tblASCII["Ï"] = "I"
tblASCII["Ð"] = "D"
tblASCII["Ñ"] = "N"
tblASCII["Ò"] = "O"
tblASCII["Ó"] = "O"
tblASCII["Ô"] = "O"
tblASCII["Õ"] = "O"
tblASCII["Ö"] = "O"
tblASCII["×"] = "*"
tblASCII["Ø"] = "O"
tblASCII["Ù"] = "U"
tblASCII["Ú"] = "U"
tblASCII["Û"] = "U"
tblASCII["Ü"] = "U"
tblASCII["Ý"] = "Y"
tblASCII["Þ"] = "TH"
tblASCII["ß"] = "ss"
tblASCII["à"] = "a"
tblASCII["á"] = "a"
tblASCII["â"] = "a"
tblASCII["ã"] = "a"
tblASCII["ä"] = "a"
tblASCII["å"] = "a"
tblASCII["æ"] = "ae"
tblASCII["ç"] = "c"
tblASCII["è"] = "e"
tblASCII["é"] = "e"
tblASCII["ê"] = "e"
tblASCII["ë"] = "e"
tblASCII["ì"] = "i"
tblASCII["í"] = "i"
tblASCII["î"] = "i"
tblASCII["ï"] = "i"
tblASCII["ð"] = "d"
tblASCII["ñ"] = "n"
tblASCII["ò"] = "o"
tblASCII["ó"] = "o"
tblASCII["ô"] = "o"
tblASCII["õ"] = "o"
tblASCII["ö"] = "o"
tblASCII["÷"] = "/"
tblASCII["ø"] = "o"
tblASCII["ù"] = "u"
tblASCII["ú"] = "u"
tblASCII["û"] = "u"
tblASCII["ü"] = "u"
tblASCII["ý"] = "y"
tblASCII["þ"] = "th"
tblASCII["ÿ"] = "y"
-- Encode CP1252/ANSI characters into ASCII codes [\000-\127] --
function fh.StrANSI_ASCII(strText)
return strEncode(strText,"[€-ÿ]",tblASCII)
end -- function StrANSI_ASCII
--[=[
Unidecode converts each codepoint into a few ASCII characters.
Lookup table indexed by codepoint [0x0000]-[0xFFFF] gives an ASCII string.
i.e. strASCII = Unidecode[intByte2][intByte1] or "=?" allowing for partially populated table.
See http://search.cpan.org/dist/Text-Unidecode/ and follow Browse to:
See http://cpansearch.perl.org/src/SBURKE/Text-Unidecode-1.22/lib/Text/Unidecode/
where each x??.pm gives 256 ASCII conversions.
Start with the first few European accented characters, and add the others later.
--]=]
local Unidecode = { }
function fh.StrUnidecode(strChar1,strChar2) -- Decode UTF-16 byte pair into ASCII characters
return Unidecode[string.byte(strChar2)][string.byte(strChar1)] or "=?"
end -- function StrUnidecode
-- Encode UTF-8 characters into ASCII codes [\000-\126] --
function fh.StrUTF8_ASCII(strText)
strText = fh.StrUTF8_UTF16(strText) -- Convert to UTF-16 Unicode and then to ASCII
return ( strText:gsub("(.)(.)",fh.StrUnidecode) )
end -- function StrUTF8_ASCII
-- Encode CP1252/ANSI or UTF-8 into ASCII codes [\000-\126] --
function fh.StrEncode_ASCII(strText)
if stringx.encoding() == "ANSI" then
return fh.StrANSI_ASCII(strText)
else
return fh.StrUTF8_ASCII(strText)
end
end -- function StrEncode_ASCII
-- Set markup language break tag --
function fh.SetBreakTag(br_New)
if not (br_New or ""):match(br_Lua) then -- Ensure new break tag is "
" or "
" or "
" or "
"
br_New = "
"
end
br_Tag = br_New
end -- function SetBreakTag
for intByte = 0x00, 0xFF do Unidecode[intByte] = { } end
Unidecode[0x00] =
{[0]="\00";"\01";"\02";"\03";"\04";"\05";"\06";"\a";"\b";"\t";"\n";"\v";"\f";"\r";"\14";"\15";"\16";"\17";"\18";"\19";"\20";"\21";"\22";"\23";"\24";"\25";"\26";"\27";"\28";"\29";"\30";"\31";
" ";"!";'"';"#";"$";"%";"&";"'";"(";")";"*";"+";",";"-";".";"/";"0";"1";"2";"3";"4";"5";"6";"7";"8";"9";":";";";"<";"=";">";"?"; -- 0x20 to 0x3F
"@";"A";"B";"C";"D";"E";"F";"G";"H";"I";"J";"K";"L";"M";"N";"O";"P";"Q";"R";"S";"T";"U";"V";"W";"X";"Y";"Z";"[";"\\";"]";"^";"_"; -- 0x40 to 0x5F
"`";"a";"b";"c";"d";"e";"f";"g";"h";"i";"j";"k";"l";"m";"n";"o";"p";"q";"r";"s";"t";"u";"v";"w";"x";"y";"z";"{";"|";"}";"~";"\127"; -- 0x60 to 0x7F
""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; ""; -- 0x80 to 0x9F
" ";"!";"=c";"=L";"=$";"=Y";"|";"=SS";'"';"(C)";"a";"<<";"-";"-";"(R)";"-";"=o";"+-";"2";"3";"'";"=u";"=P";"*";",";"1";"o";">>";"1/4";"1/2";"3/4";"?"; -- 0xA0 to 0xBF
"A";"A";"A";"A";"A";"A";"AE";"C";"E";"E";"E";"E";"I";"I";"I";"I";"D";"N";"O";"O";"O";"O";"O";"*";"O";"U";"U";"U";"U";"Y";"TH";"ss"; -- 0xC0 to 0xDF
"a";"a";"a";"a";"a";"a";"ae";"c";"e";"e";"e";"e";"i";"i";"i";"i";"d";"n";"o";"o";"o";"o";"o";"/";"o";"u";"u";"u";"u";"y";"th";"y"; -- 0xE0 to 0xFF
}
Unidecode[0x01] =
{[0]="A";"a";"A";"a";"A";"a";"C";"c";"C";"c";"C";"c";"C";"c";"D";"d";"D";"d";"E";"e";"E";"e";"E";"e";"E";"e";"E";"e";"G";"g";"G";"g"; -- 0x00 to 0x1F
"G";"g";"G";"g";"H";"h";"H";"h";"I";"i";"I";"i";"I";"i";"I";"i";"I";"i";"IJ";"ij";"J";"j";"K";"k";"k";"L";"l";"L";"l";"L";"l";"L"; -- 0x20 to 0x3F
"l";"L";"l";"N";"n";"N";"n";"N";"n";"'n";"ng";"NG";"O";"o";"O";"o";"O";"o";"OE";"oe";"R";"r";"R";"r";"R";"r";"S";"s";"S";"s";"S";"s"; -- 0x40 to 0x5F
"S";"s";"T";"t";"T";"t";"T";"t";"U";"u";"U";"u";"U";"u";"U";"u";"U";"u";"U";"u";"W";"w";"Y";"y";"Y";"Z";"z";"Z";"z";"Z";"z";"s"; -- 0x60 to 0x7F
"b";"B";"B";"b";"6";"6";"O";"C";"c";"D";"D";"D";"d";"d";"3";"@";"E";"F";"f";"G";"G";"hv";"I";"I";"K";"k";"l";"l";"W";"N";"n";"O"; -- 0x80 to 0x9F
"O";"o";"OI";"oi";"P";"p";"YR";"2";"2";"SH";"sh";"t";"T";"t";"T";"U";"u";"Y";"V";"Y";"y";"Z";"z";"ZH";"ZH";"zh";"zh";"2";"5";"5";"ts";"w"; -- 0xA0 to 0xBF
"|";"||";"|=";"!";"DZ";"Dz";"dz";"LJ";"Lj";"lj";"NJ";"Nj";"nj";"A";"a";"I";"i";"O";"o";"U";"u";"U";"u";"U";"u";"U";"u";"U";"u";"@";"A";"a"; -- 0xC0 to 0xDF
"A";"a";"AE";"ae";"G";"g";"G";"g";"K";"k";"O";"o";"O";"o";"ZH";"zh";"j";"DZ";"Dz";"dz";"G";"g";"HV";"W";"N";"n";"A";"a";"AE";"ae";"O";"o"; -- 0xE0 to 0xFF
}
Unidecode[0x02] =
{[0]="A";"a";"A";"a";"E";"e";"E";"e";"I";"i";"I";"i";"O";"o";"O";"o";"R";"r";"R";"r";"U";"u";"U";"u";"S";"s";"T";"t";"Y";"y";"H";"h"; -- 0x00 to 0x1F
"N";"d";"OU";"ou";"Z";"z";"A";"a";"E";"e";"O";"o";"O";"o";"O";"o";"O";"o";"Y";"y";"l";"n";"t";"j";"db";"qp";"A";"C";"c";"L";"T";"s"; -- 0x20 to 0x3F
"z";"[?]";"[?]";"B";"U";"^";"E";"e";"J";"j";"q";"q";"R";"r";"Y";"y";"a";"a";"a";"b";"o";"c";"d";"d";"e";"@";"@";"e";"e";"e";"e";"j"; -- 0x40 to 0x5F
"g";"g";"g";"g";"u";"Y";"h";"h";"i";"i";"I";"l";"l";"l";"lZ";"W";"W";"m";"n";"n";"n";"o";"OE";"O";"F";"r";"r";"r";"r";"r";"r";"r"; -- 0x60 to 0x7F
"R";"R";"s";"S";"j";"S";"S";"t";"t";"u";"U";"v";"^";"w";"y";"Y";"z";"z";"Z";"Z";"?";"?";"?";"C";"@";"B";"E";"G";"H";"j";"k";"L"; -- 0x80 to 0x9F
"q";"?";"?";"dz";"dZ";"dz";"ts";"tS";"tC";"fN";"ls";"lz";"WW";"]]";"h";"h";"h";"h";"j";"r";"r";"r";"r";"w";"y";"'";'"';"`";"'";"`";"`";"'"; -- 0xA0 to 0xBF
"?";"?";"<";">";"^";"V";"^";"V";"'";"-";"/";"\\";",";"_";"\\";"/";":";".";"`";"'";"^";"V";"+";"-";"V";".";"@";",";"~";'"';"R";"X"; -- 0xC0 to 0xDF
"G";"l";"s";"x";"?";"";"";"";"";"";"";"";"V";"=";'"';"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0xE0 to 0xFF
}
Unidecode[0x03] =
{
}
Unidecode[0x04] =
{
}
Unidecode[0x20] =
{[0]=" ";" ";" ";" ";" ";" ";" ";" ";" ";" ";" ";" ";"";"";"";"";"-";"-";"-";"-";"--";"--";"||";"_";"'";"'";",";"'";'"';'"';",,";'"'; -- 0x00 to 0x1F
"|+";"|++";"*";"*>";".";"..";"...";".";"\n";"\n\n";"";"";"";"";"";" ";"%0";"%00";"'";"''";"'''";"`";"``";"```";"^";"<";">";"*";"!!";"!?";"-";"_"; -- 0x20 to 0x3F
"-";"^";"***";"--";"/";"-[";"]-";"[?]";"?!";"!?";"7";"PP";"(]";"[)";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0x40 to 0x5F
"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"";"";"";"";"";"";"0";"";"";"";"4";"5";"6";"7";"8";"9";"+";"-";"=";"(";")";"n"; -- 0x60 to 0x7F
"0";"1";"2";"3";"4";"5";"6";"7";"8";"9";"+";"-";"=";"(";")";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0x80 to 0x9F
"ECU";"CL";"Cr";"FF";"L";"mil";"N";"Pts";"Rs";"W";"NS";"D";"=E";"K";"T";"Dr";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0xA0 to 0xBF
"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"";"";"";"";"";"";"";"";"";"";"";"";"";"";"";""; -- 0xC0 to 0xDF
"";"";"";"";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]";"[?]"; -- 0xE0 to 0xFF
}
Unidecode[0x21] =
{[34]="TM";
}
return fh
end -- local function encoder_v3
local encoder = encoder_v3() -- To access FH encoder chars module
--[[
@Module: +fh+progbar_v3
@Author: Mike Tate
@Version: 3.0
@LastUpdated: 27 Aug 2020
@Description: Progress Bar library module.
@V3.0: Function Prototype Closure version.
@V1.0: Initial version.
]]
local function progbar_v3()
local fh = {} -- Local environment table
require "iuplua" -- To access GUI window builder
iup.SetGlobal("CUSTOMQUITMESSAGE","YES") -- Needed for IUP 3.28
local tblBars = {} -- Table for optional external attributes
local strBack = "255 255 255" -- Background colour default is white
local strBody = "0 0 0" -- Body text colour default is black
local strFont = nil -- Font dialogue default is current font
local strStop = "255 0 0" -- Stop button colour default is red
local intPosX = iup.CENTER -- Show window default position is central
local intPosY = iup.CENTER
local intMax, intVal, intPercent, intStart, intDelta, intScale, strClock, isBarStop
local lblText, barGauge, lblDelta, btnStop, dlgGauge
local function doFocus() -- Bring the Progress Bar window into Focus
dlgGauge.BringFront="YES" -- If used too often, inhibits other windows scroll bars, etc
end -- local function doFocus
local function doUpdate() -- Update the Progress Gauge and the Delta % with clock
barGauge.Value = intVal
lblDelta.Title = string.format("%4d %% %s ",math.floor(intPercent),strClock)
end -- local function doUpdate
local function doReset() -- Reset all dialogue variables and Update display
intVal = 0 -- Current value of Progress Bar
intPercent= 0.01 -- Percentage of progress
intStart = os.time() -- Start time of progress
intDelta = 0 -- Delta time of progress
intScale = math.ceil( intMax / 1000 ) -- Scale of percentage per second of progress (initial guess is corrected in Step function)
strClock = "00 : 00 : 00" -- Clock delta time display
isBarStop = false -- Stop button pressed signal
doUpdate()
doFocus()
end -- local function doReset
function fh.Start(strTitle,intMaximum) -- Create & start Progress Bar window
if not dlgGauge then
strTitle = strTitle or "" -- Dialogue and button title
intMax = intMaximum or 100 -- Maximun range of Progress Bar, default is 100
local strSize = tostring( math.max( 100, string.len(" Stop "..strTitle) * 8 ) ).."x30" -- Adjust Stop button size to Title
lblText = iup.label { Title=" "; Expand="YES"; Alignment="ACENTER"; Tip="Progress Message"; }
barGauge = iup.progressbar { RasterSize="400x30"; Value=0; Max=intMax; Tip="Progress Bar"; }
lblDelta = iup.label { Title=" "; Expand="YES"; Alignment="ACENTER"; Tip="Percentage and Elapsed Time"; }
btnStop = iup.button { Title=" Stop "..strTitle; RasterSize=strSize; FgColor=strStop; Tip="Stop Progress Button"; action=function() isBarStop = true end; } -- Signal Stop button pressed return iup.CLOSE -- Often caused main GUI to close !!!
dlgGauge = iup.dialog { Title=strTitle.." Progress "; Font=strFont; FgColor=strBody; Background=strBack; DialogFrame="YES"; -- Remove Windows minimize/maximize menu
iup.vbox{ Alignment="ACENTER"; Gap="10"; Margin="10x10";
lblText;
barGauge;
lblDelta;
btnStop;
};
move_cb = function(self,x,y) tblBars.X = x tblBars.Y = y end;
close_cb = btnStop.action; -- Windows Close button = Stop button
}
if type(tblBars.GUI) == "table"
and type(tblBars.GUI.ShowDialogue) == "function" then
dlgGauge.move_cb = nil -- Use GUI library to show & move window
tblBars.GUI.ShowDialogue("Bars",dlgGauge,btnStop,"showxy")
else
dlgGauge:showxy(intPosX,intPosY) -- Show the Progress Bar window
end
doReset() -- Reset the Progress Bar display
end
end -- function Start
function fh.Message(strText) -- Show the Progress Bar message
if dlgGauge then lblText.Title = strText end
end -- function Message
function fh.Step(intStep) -- Step the Progress Bar forward
if dlgGauge then
intVal = intVal + ( intStep or 1 ) -- Default step is 1
local intNew = math.ceil( intVal / intMax * 100 * intScale ) / intScale
if intPercent ~= intNew then -- Update progress once per percent or per second, whichever is smaller
intPercent = math.max( 0.1, intNew ) -- Ensure percentage is greater than zero
if intVal > intMax then intVal = intMax intPercent = 100 end -- Ensure values do not exceed maximum
intNew = os.difftime(os.time(),intStart)
if intDelta < intNew then -- Update clock of elapsed time
intDelta = intNew
intScale = math.ceil( intDelta / intPercent ) -- Scale of seconds per percentage step
local intHour = math.floor( intDelta / 3600 )
local intMins = math.floor( intDelta / 60 - intHour * 60 )
local intSecs = intDelta - intMins * 60 - intHour * 3600
strClock = string.format("%02d : %02d : %02d",intHour,intMins,intSecs)
end
doUpdate() -- Update the Progress Bar display
end
iup.LoopStep()
end
end -- function Step
function fh.Focus() -- Bring the Progress Bar window to front
if dlgGauge then doFocus() end
end -- function Focus
function fh.Reset() -- Reset the Progress Bar display
if dlgGauge then doReset() end
end -- function Reset
function fh.Stop() -- Check if Stop button pressed
iup.LoopStep()
return isBarStop
end -- function Stop
function fh.Close() -- Close the Progress Bar window
isBarStop = false
if dlgGauge then dlgGauge:destroy() dlgGauge = nil end
end -- function Close
function fh.Setup(tblSetup) -- Setup optional table of external attributes
if tblSetup then
tblBars = tblSetup
strBack = tblBars.Back or strBack -- Background colour
strBody = tblBars.Body or strBody -- Body text colour
strFont = tblBars.Font or strFont -- Font dialogue
strStop = tblBars.Stop or strStop -- Stop button colour
intPosX = tblBars.X or intPosX -- Window position
intPosY = tblBars.Y or intPosY
end
end -- function Setup
return fh
end -- local function progbar_v3
local progbar = progbar_v3() -- To access FH progress bars module
--[[
@Module: +fh+iup_gui_v3
@Author: Mike Tate
@Version: 4.1
@LastUpdated: 03 May 2022
@Description: Graphical User Interface Library Module
@V4.1: CheckVersionInStore() save & retrieve latest version in file; Remove old wiki Help features;
@V4.0: Cater for full UTF-8 filenames;
@V3.9: ShowDialogue() popup closure fhSleep() added; CheckVersionInStore() at monthly intervals;
@V3.8: Function Prototype Closure version.
@V3.7: AssignAttributes(tblControls) now allows any string attribute to invoke a function.
@V3.6: anyMemoDialogue() sets TopMost attribute.
@V3.5: Replace IsNormalWindow(iupDialog) with SetWindowCoord(tblName) and update CheckWindowPosition(tblName) to prevent negative values freezing main dialog.
@V3.4: Use general.MakeFolder() to ensure key folders exist, add Get/PutRegKey(), check Registry IE Shell Version in HelpDialogue(), better error handling in LoadSettings().
@V3.3: LoadFolder() and SaveFolder() use global folder as default for local folder to improve synch across PC.
@V3.2: Load & Save settings now use a single clipboard so Local PC settings are preserved across synchronised PC.
@V3.1: IUP 3.11.2 iup.GetGlobal("VERSION") to top, HelpDialogue conditional ExpandChildren="YES/NO", RefreshDialogue uses NaturalSize, SetUtf8Mode(), Load/SaveFolder(), etc
@V3.0: ShowDialogue "dialog" mode for Memo, new DestroyDialogue, NewHelpDialogue tblAttr for Font, AssignAttributes intSkip, CustomDialogue iup.CENTERPARENT+, IUP Workaround, BalloonToggle, Initialise test Plugin file exists.
@V2.0: Support for Plugin Data scope, new FontDialogue, RefreshDialogue, AssignAttributes, httpRequest handler, keep "dialog" mode.
@V1.0: Initial version.
]]
local function iup_gui_v3()
local fh = {} -- Local environment table
require "iuplua" -- To access GUI window builder
require "iupluacontrols" -- To access GUI window controls
require "lfs" -- To access LUA filing system
require "iupluaole" -- To access OLE subsystem
require "luacom" -- To access COM subsystem
iup.SetGlobal("CUSTOMQUITMESSAGE","YES") -- Needed for IUP 3.28
local iupVersion = iup.GetGlobal("VERSION") -- Obtain IUP module version
-- "iuplua" Omitted Constants Workaround --
iup.TOP = iup.LEFT
iup.BOTTOM = iup.RIGHT
iup.RED = iup.RGB(1,0,0)
iup.GREEN = iup.RGB(0,1,0)
iup.BLUE = iup.RGB(0,0,1)
iup.BLACK = iup.RGB(0,0,0)
iup.WHITE = iup.RGB(1,1,1)
iup.YELLOW = iup.RGB(1,1,0)
-- Shared Interface Attributes & Functions --
fh.Version = " " -- Plugin Version
fh.History = fh.Version -- Version History
fh.Red = "255 0 0" -- Color attributes (must exclude leading zeros & spaces to allow value comparisons)
fh.Maroon = "128 0 0"
fh.Amber = "250 160 0"
fh.Orange = "255 165 0"
fh.Yellow = "255 255 0"
fh.Olive = "128 128 0"
fh.Lime = "0 255 0"
fh.Green = "0 128 0"
fh.Cyan = "0 255 255"
fh.Teal = "0 128 128"
fh.Blue = "0 0 255"
fh.Navy = "0 0 128"
fh.Magenta = "255 0 255"
fh.Purple = "128 0 128"
fh.Black = "0 0 0"
fh.Gray = "128 128 128"
fh.Silver = "192 192 192"
fh.Smoke = "240 240 240"
fh.White = "255 255 255"
fh.Risk = fh.Red -- Risk colour for hazardous controls such as Close/Delete buttons
fh.Warn = fh.Magenta -- Warn colour for caution controls and warnings
fh.Safe = fh.Green -- Safe colour for active controls such as most buttons
fh.Info = fh.Black -- Info colour for text controls such as labels/tabs
fh.Head = fh.Black -- Head colour for headings
fh.Body = fh.Black -- Body colour for body text
fh.Back = fh.White -- Background colour for all windows
fh.Gap = "8" -- Layout attributes Gap was "10"
fh.Border = "8x8" -- was BigMargin="10x10"
fh.Margin = "1x1" -- was MinMargin
fh.Balloon = "NO" -- Tooltip balloon mode
fh.FontSet = 0 -- Legacy GUI font set assigned by FontAssignment but used globally
fh.FontHead = ""
fh.FontBody = ""
local GUI = { } -- Sub-table for GUI Dialogue attributes to allow any "Name"
--[[
GUI.Name table of dialogue attributes, where Name is Font, Help, Main, Memo, Bars, etc
GUI.Name.CoordX x co-ordinate ( Loaded & Saved by default )
GUI.Name.CoordY y co-ordinate ( Loaded & Saved by default )
GUI.Name.Dialog dialogue handle
GUI.Name.Focus focus button handle
GUI.Name.Frame dialogframe mode, "normal" = dialogframe="NO" else "YES", "showxy" = showxy(), "popup" or "keep" = popup(), default is "normal & showxy"
GUI.Name.Height height
GUI.Name.Raster rastersize ( Loaded & Saved by default )
GUI.Name.Width width
GUI.Name.Back ProgressBar background colour
GUI.Name.Body ProgressBar body text colour
GUI.Name.Font ProgressBar font style
GUI.Name.Stop ProgressBar Stop button colour
GUI.Name.GUI Module table usable by other modules e.g. progbar.Setup
--]]
-- tblScrn[1] = origin x, tblScrn[2] = origin y, tblScrn[3] = width, tblScrn[4] = height
local tblScrn = stringx.splitnumbers(iup.GetGlobal("VIRTUALSCREEN")) -- Used by CustomDialogue() and CheckWindowPosition() and ShowDialogue() below
local intMaxW = tblScrn[3]
local intMaxH = tblScrn[4]
function fh.BalloonToggle() -- Toggle tooltips Balloon mode
local tblToggle = { YES="NO"; NO="YES"; }
fh.Balloon = tblToggle[fh.Balloon]
fh.SaveSettings()
end -- function BalloonToggle
iup.SetGlobal("UTF8MODE","NO")
iup.SetGlobal("UTF8MODE_FILE","NO") -- V4.0
function fh.SetUtf8Mode() -- Set IUP into UTF-8 mode
if iupVersion == "3.5" or stringx.encoding() == "ANSI" then return false end
iup.SetGlobal("UTF8MODE","YES")
iup.SetGlobal("UTF8MODE_FILE","YES") -- V4.0
return true
end -- function SetUtf8Mode
local function tblOfNames(...) -- Get table of dialogue Names including "Font","Help","Main" by default
local arg = {...}
local tblNames = {"Font";"Help";"Main";}
for intName, strName in ipairs(arg) do
if type(strName) == "string"
and strName ~= "Font"
and strName ~= "Help"
and strName ~= "Main" then
table.insert(tblNames,strName)
end
end
return tblNames
end -- local function tblOfNames
local function tblNameFor(strName) -- Get table of parameters for chosen dialogue Name
strName = tostring(strName)
if not GUI[strName] then -- Need new table with default minimum & raster size, and X & Y co-ordinates
GUI[strName] = { }
local tblName = GUI[strName]
tblName.Raster = "x"
tblName.CoordX = iup.CENTER
tblName.CoordY = iup.CENTER
end
return GUI[strName]
end -- local function tblNameFor
local function intDimension(intMin,intVal,intMax) -- Return a number bounded by intMin and intMax
if not intVal then return 0 end -- Except if no value then return 0
intVal = tonumber(intVal) or (intMin+intMax)/2
return math.max(intMin,math.min(intVal,intMax))
end -- local function intDimension
function fh.CustomDialogue(strName,strRas,intX,intY) -- GUI custom window raster size, and X & Y co-ordinates
-- strRas nil = old size, "x" or "0x0" = min size, "999x999" = new size
-- intX/Y nil = central, "99" = co-ordinate position
local tblName = tblNameFor(strName)
local tblSize = {}
local intWide = 0
local intHigh = 0
strRas = strRas or tblName.Raster
if strRas then -- Ensure raster size is between minimum and screen size
tblSize = stringx.splitnumbers(strRas)
intWide = intDimension(intWide,tblSize[1],intMaxW)
intHigh = intDimension(intHigh,tblSize[2],intMaxH)
strRas = tostring(intWide.."x"..intHigh)
end
if intX and intX < iup.CENTERPARENT then
intX = intDimension(0,intX,intMaxW-intWide) -- Ensure X co-ordinate positions window on screen
end
if intY and intY < iup.CENTERPARENT then
intY = intDimension(0,intY,intMaxH-intHigh) -- Ensure Y co-ordinate positions window on screen
end
tblName.Raster = strRas or "x"
tblName.CoordX = tonumber(intX) or iup.CENTER
tblName.CoordY = tonumber(intY) or iup.CENTER
end -- function CustomDialogue
function fh.DefaultDialogue(...) -- GUI default window minimum & raster size, and X & Y co-ordinates
for intName, strName in ipairs(tblOfNames(...)) do
fh.CustomDialogue(strName)
end
end -- function DefaultDialogue
function fh.DialogueAttributes(strName) -- Provide named Dialogue Attributes
local tblName = tblNameFor(strName) -- tblName.Dialog = dialog handle, so any other attributes could be retrieved
local tblSize = stringx.splitnumbers(tblName.Raster or "x") -- Split Raster Size into width=tblSize[1] and height=tblSize[2]
tblName.Width = tblSize[1]
tblName.Height= tblSize[2]
tblName.Back = fh.Back -- Following only needed for NewProgressBar
tblName.Body = fh.Body
tblName.Font = fh.FontBody
tblName.Stop = fh.Risk
tblName.GUI = fh -- Module table
return tblName
end -- function DialogueAttributes
local strDefaultScope = "Project" -- Default scope for Load/Save data is per Project/User/Machine as set by PluginDataScope()
local tblClipProj = { }
local tblClipUser = { } -- Clipboards of sticky data for each Plugin Data scope -- V3.2
local tblClipMach = { }
local function doLoadData(strParam,strDefault,strScope) -- Load sticky data for Plugin Data scope
strScope = tostring(strScope or strDefaultScope):lower()
local tblClipData = tblClipProj
if strScope:match("user") then tblClipData = tblClipUser
elseif strScope:match("mach") then tblClipData = tblClipMach
end
return tblClipData[strParam] or strDefault
end -- local function doLoadData
function fh.LoadGlobal(strParam,strDefault,strScope) -- Load Global Parameter for all PC
return doLoadData(strParam,strDefault,strScope)
end -- function LoadGlobal
function fh.LoadLocal(strParam,strDefault,strScope) -- Load Local Parameter for this PC
return doLoadData(fh.ComputerName.."-"..strParam,strDefault,strScope)
end -- function LoadLocal
local function doLoadFolder(strFolder) -- Use relative paths to let Paths change -- V3.3
strFolder = strFolder:gsub("^FhDataPath",function() return fh.FhDataPath end) -- Full path to .fh_data folder
strFolder = strFolder:gsub("^PublicPath",function() return fh.PublicPath end) -- Full path to Public folder
strFolder = strFolder:gsub("^FhProjPath",function() return fh.FhProjPath end) -- Full path to project folder
return strFolder
end -- local function doLoadFolder
function fh.LoadFolder(strParam,strDefault,strScope) -- Load Folder Parameter for this PC -- V3.3
local strFolder = doLoadFolder(fh.LoadLocal(strParam,"",strScope))
if not general.FlgFolderExists(strFolder) then -- If no local folder try global folder
strFolder = doLoadFolder(fh.LoadGlobal(strParam,strDefault,strScope))
end
return strFolder
end -- function LoadFolder
function fh.LoadDialogue(...) -- Load Dialogue Parameters for "Font","Help","Main" by default
for intName, strName in ipairs(tblOfNames(...)) do
local tblName = tblNameFor(strName)
--# tblName.Raster = tostring(fh.LoadLocal(strName.."S",tblName.Raster)) -- Legacy of "S" becomes "R"
tblName.Raster = tostring(fh.LoadLocal(strName.."R",tblName.Raster))
tblName.CoordX = tonumber(fh.LoadLocal(strName.."X",tblName.CoordX))
tblName.CoordY = tonumber(fh.LoadLocal(strName.."Y",tblName.CoordY))
fh.CheckWindowPosition(tblName)
end
end -- function LoadDialogue
function fh.LoadSettings(...) -- Load Sticky Settings from File
for strFileName, tblClipData in pairs ({ ProjectFile=tblClipProj; PerUserFile=tblClipUser; MachineFile=tblClipMach; }) do
strFileName = fh[strFileName]
if general.FlgFileExists(strFileName) then -- Load Settings File in table lines with key & val fields
local tblField = {}
local strClip = general.StrLoadFromFile(strFileName) --! -- V4.0
for strLine in strClip:gmatch("[^\r\n]+") do --! -- V4.0
--! for strLine in io.lines(strFileName) do
if #tblField == 0
and strLine:match("^return {") -- Unless entire Sticky Data table was saved --!
and type(table.load) == "function" then
local tblClip, strErr = table.load(strFileName) -- Load Settings File table
if strErr then error(strErr.."\n\nMay need to Delete the following Plugin Data .dat file:\n\n"..strFileName.."\n\nError detected.") end
for i,j in pairs (tblClip) do
tblClipData[i] = tblClip[i]
end
break
end
tblField = stringx.split(strLine,"=")
if tblField[1] then tblClipData[tblField[1]] = tblField[2] end
end
else
for i,j in pairs (tblClipData) do
tblClipData[i] = nil --! Restore defaults and clear any junk -- V4.0
end
end
end
fh.Safe = tostring(fh.LoadGlobal("SafeColor",fh.Safe))
fh.Warn = tostring(fh.LoadGlobal("WarnColor",fh.Warn))
fh.Risk = tostring(fh.LoadGlobal("RiskColor",fh.Risk))
fh.Head = tostring(fh.LoadGlobal("HeadColor",fh.Head))
fh.Body = tostring(fh.LoadGlobal("BodyColor",fh.Body))
fh.FontHead= tostring(fh.LoadGlobal("FontHead" ,fh.FontHead))
fh.FontBody= tostring(fh.LoadGlobal("FontBody" ,fh.FontBody))
fh.FontSet = tonumber(fh.LoadGlobal("Fonts" ,fh.FontSet)) -- Legacy only
fh.FontSet = tonumber(fh.LoadGlobal("FontSet" ,fh.FontSet)) -- Legacy only
fh.History = tostring(fh.LoadGlobal("History" ,fh.History))
fh.Balloon = tostring(fh.LoadGlobal("Balloon" ,fh.Balloon, "Machine"))
fh.LoadDialogue(...)
if fh.FontSet > 0 then fh.FontAssignment(fh.FontSet) end -- Legacy only
end -- function LoadSettings
local function doSaveData(strParam,anyValue,strScope) -- Save sticky data for Plugin Data scope
strScope = tostring(strScope or strDefaultScope):lower()
local tblClipData = tblClipProj
if strScope:match("user") then tblClipData = tblClipUser
elseif strScope:match("mach") then tblClipData = tblClipMach
end
tblClipData[strParam] = anyValue
end -- local function doSaveData
function fh.SaveGlobal(strParam,anyValue,strScope) -- Save Global Parameter for all PC
doSaveData(strParam,anyValue,strScope)
end -- function SaveGlobal
function fh.SaveLocal(strParam,anyValue,strScope) -- Save Local Parameter for this PC
doSaveData(fh.ComputerName.."-"..strParam,anyValue,strScope)
end -- function SaveLocal
function fh.SaveFolder(strParam,strFolder,strScope) -- Save Folder Parameter for this PC
strFolder = stringx.replace(strFolder,fh.FhDataPath,"FhDataPath") -- Full path to .fh_data folder
strFolder = stringx.replace(strFolder,fh.PublicPath,"PublicPath") -- Full path to Public folder
strFolder = stringx.replace(strFolder,fh.FhProjPath,"FhProjPath") -- Full path to project folder
--# doSaveData(fh.ComputerName.."-"..strParam,strFolder,strScope) -- Uses relative paths to let Paths change
fh.SaveGlobal(strParam,strFolder,strScope) -- V3.3
fh.SaveLocal(strParam,strFolder,strScope) -- Uses relative paths to let Paths change
end -- function SaveFolder
function fh.SaveDialogue(...) -- Save Dialogue Parameters for "Font","Help","Main" by default
for intName, strName in ipairs(tblOfNames(...)) do
local tblName = tblNameFor(strName)
fh.SaveLocal(strName.."R",tblName.Raster)
fh.SaveLocal(strName.."X",tblName.CoordX)
fh.SaveLocal(strName.."Y",tblName.CoordY)
end
end -- function SaveDialogue
function fh.SaveSettings(...) -- Save Sticky Settings to File
fh.SaveDialogue(...)
fh.SaveGlobal("SafeColor",fh.Safe)
fh.SaveGlobal("WarnColor",fh.Warn)
fh.SaveGlobal("RiskColor",fh.Risk)
fh.SaveGlobal("HeadColor",fh.Head)
fh.SaveGlobal("BodyColor",fh.Body)
fh.SaveGlobal("FontHead" ,fh.FontHead)
fh.SaveGlobal("FontBody" ,fh.FontBody)
fh.SaveGlobal("History" ,fh.History)
fh.SaveGlobal("Balloon" ,fh.Balloon, "Machine")
for strFileName, tblClipData in pairs ({ ProjectFile=tblClipProj; PerUserFile=tblClipUser; MachineFile=tblClipMach; }) do
for i,j in pairs (tblClipData) do -- Check if table has any entries
strFileName = fh[strFileName]
if type(table.save) == "function" then -- Save entire Settings File table per Project/User/Machine
table.save(tblClipData,strFileName)
else
local tblClip = {}
for strKey,strVal in pairs(tblClipData) do -- Else save Settings File lines with key & val fields -- V4.0
table.insert(tblClip,strKey.."="..strVal.."\n") --! -- V4.0
end
local strClip = table.concat(tblClip,"\n") --! -- V4.0
if not general.SaveStringToFile(strClip,strFileName) then --! -- V4.0
error("\nSettings file not saved successfully.\n\nMay need to Delete the following Plugin Data .dat file:\n\n"..strFileName.."\n\nError detected.")
end
end
break
end
end
end -- function SaveSettings
function fh.CheckWindowPosition(tblName) -- Ensure dialogue window coordinates are on Screen
if tonumber(tblName.CoordX) == nil
or tonumber(tblName.CoordX) < 0 -- V3.5
or tonumber(tblName.CoordX) > intMaxW then
tblName.CoordX = iup.CENTER
end
if tonumber(tblName.CoordY) == nil
or tonumber(tblName.CoordY) < 0 -- V3.5
or tonumber(tblName.CoordY) > intMaxH then
tblName.CoordY = iup.CENTER
end
end -- function CheckWindowPosition
function fh.IsNormalWindow(iupDialog) -- Check dialogue window is not Maximised or Minimised (now redundant)
-- tblPosn[1] = origin x, tblPosn[2] = origin y, tblPosn[3] = width, tblPosn[4] = height
local tblPosn = stringx.splitnumbers(iupDialog.ScreenPosition)
local intPosX = tblPosn[1]
local intPosY = tblPosn[2]
if intPosX < 0 and intPosY < 0 then -- If origin is negative (-8, -8 = Maximised, -3200, -3200 = Minimised)
return false -- then is Maximised or Minimised
end
return true
end -- function IsNormalWindow
function fh.SetWindowCoord(tblName) -- Set the Window coordinates if not Maximised or Minimised -- V3.5
-- tblPosn[1] = origin x, tblPosn[2] = origin y, tblPosn[3] = width, tblPosn[4] = height
local tblPosn = stringx.splitnumbers(tblName.Dialog.ScreenPosition)
local intPosX = tblPosn[1]
local intPosY = tblPosn[2]
if intPosX < 0 and intPosY < 0 then -- If origin is negative (-8, -8 = Maximised, -3200, -3200 = Minimised)
return false -- then is Maximised or Minimised
end
tblName.CoordX = intPosX -- Otherwise set the Window coordinates
tblName.CoordY = intPosY
return true
end -- function SetWindowCoord
function fh.ShowDialogue(strName,iupDialog,btnFocus,strFrame) -- Set standard frame attributes and display dialogue window
local tblName = tblNameFor(strName)
iupDialog = iupDialog or tblName.Dialog -- Retrieve previous parameters if needed
btnFocus = btnFocus or tblName.Focus
strFrame = strFrame or tblName.Frame
strFrame = strFrame or "show norm" -- Default frame mode is dialog:showxy(X,Y) with DialogFrame="NO" ("normal" to vary size, otherwise fixed size)
strFrame = strFrame:lower() -- Other modes are "show", "popup" & "keep" with DialogFrame="YES", or with "normal" for DialogFrame="NO" ("show" for active windows, "popup"/"keep" for modal windows)
if strFrame:gsub("%s-%a-map%a*[%s%p]*","") == "" then -- May be prefixed with "map" mode to just map dialogue initially, also may be suffixed with "dialog" to inhibit iup.MainLoop() to allow progress messages
strFrame = "map show norm" -- If only "map" mode then default to "map show norm"
end
if type(iupDialog) == "userdata" then
tblName.Dialog = iupDialog
tblName.Focus = btnFocus -- Preserve parameters
tblName.Frame = strFrame
iupDialog.Background = fh.Back -- Background colour
iupDialog.Shrink = "YES" -- Sometimes needed to shrink controls to raster size
if type(btnFocus) == "userdata" then -- Set button as focus for Esc and Enter keys
iupDialog.StartFocus = iupDialog.StartFocus or btnFocus
iupDialog.DefaultEsc = iupDialog.DefaultEsc or btnFocus
iupDialog.DefaultEnter = iupDialog.DefaultEnter or btnFocus
end
iupDialog.MaxSize = intMaxW.."x"..intMaxH -- Maximum size is screen size
iupDialog.MinSize = "x" -- Minimum size (default "x" becomes nil)
iupDialog.RasterSize = tblName.Raster or "x" -- Raster size (default "x" becomes nil)
if strFrame:match("norm") then -- DialogFrame mode is "NO" by default for variable size window
if strFrame:match("pop") or strFrame:match("keep") then
iupDialog.MinBox = "NO" -- For "popup" and "keep" hide Minimize and Maximize icons
iupDialog.MaxBox = "NO"
else
strFrame = strFrame.." show" -- If not "popup" nor "keep" then use "showxy" mode
end
else
iupDialog.DialogFrame = "YES" -- Define DialogFrame mode for fixed size window
end
iupDialog.close_cb = iupDialog.close_cb or function() return iup.CLOSE end -- Define default window X close, move, and resize actions
iupDialog.move_cb = iupDialog.move_cb or function(self) fh.SetWindowCoord(tblName) end -- V3.5
iupDialog.resize_cb = iupDialog.resize_cb or function(self) if fh.SetWindowCoord(tblName) then tblName.Raster=self.RasterSize end end -- V3.5
if strFrame:match("map") then -- Only dialogue mapping is required
iupDialog:map()
tblName.Frame = strFrame:gsub("%s-%a-map%a*[%s%p]*","") -- Remove "map" from frame mode ready for subsequent call
return
end
fh.RefreshDialogue(strName) -- Refresh to set Natural Size as Minimum Size
if iup.MainLoopLevel() == 0 -- Called from outside Main GUI, so must use showxy() and not popup()
or strFrame:match("dialog")
or strFrame:match("sho") then -- Use showxy() to dispay dialogue window for "showxy" or "dialog" mode
iupDialog:showxy(tblName.CoordX,tblName.CoordY)
if not strFrame:match("dialog") -- Inhibit MainLoop if "dialog" mode -- V4.1
and iup.MainLoopLevel() == 0 then iup.MainLoop() end
else
iupDialog:popup(tblName.CoordX,tblName.CoordY) -- Use popup() to display dialogue window for "popup" or "keep" modes
fhSleep(200,150) -- Sometimes needed to prevent MainLoop() closure! -- V3.9
end
if not strFrame:match("dialog") and strFrame:match("pop") then
tblName.Dialog = nil -- When popup closed, clear key parameters, but not for "keep" mode
tblName.Raster = nil
tblName.CoordX = nil -- iup.CENTER
tblName.CoordY = nil -- iup.CENTER
else
fh.SetWindowCoord(tblName) -- Set Window coordinate pixel values -- V3.5
end
end
end -- function ShowDialogue
function fh.DestroyDialogue(strName) -- Destroy existing dialogue
local tblName = tblNameFor(strName)
if tblName then
local iupDialog = tblName.Dialog
if type(iupDialog) == "userdata" then
iupDialog:destroy()
tblName.Dialog = nil -- Prevent future misuse of handle -- 22 Jul 2014
end
end
end -- function DestroyDialogue
local function strDialogueArgs(strArgA,strArgB,comp) -- Compare two argument pairs and return matching pair
local tblArgA = stringx.splitnumbers(strArgA)
local tblArgB = stringx.splitnumbers(strArgB)
local strArgX = tostring(comp(tblArgA[1] or 100,tblArgB[1] or 100))
local strArgY = tostring(comp(tblArgA[2] or 100,tblArgB[2] or 100))
return strArgX.."x"..strArgY
end -- local function strDialogueArgs
function fh.RefreshDialogue(strName) -- Refresh dialogue window size after Font change, etc
local tblName = tblNameFor(strName)
local iupDialog = tblName.Dialog -- Retrieve the dialogue handle
if type(iupDialog) == "userdata" then
iupDialog.Size = iup.NULL
iupDialog.MinSize = iup.NULL -- V3.1
iup.Refresh(iupDialog) -- Refresh window to Natural Size and set as Minimum Size
if not iupDialog.RasterSize then
iupDialog:map()
iup.Refresh(iupDialog)
end
local strSize = iupDialog.NaturalSize or iupDialog.RasterSize -- IUP 3.5 NaturalSize = nil, IUP 3.11 needs NaturalSize -- V3.1
iupDialog.MinSize = strDialogueArgs(iupDialog.MaxSize,strSize,math.min) -- Set Minimum Size to smaller of Maximm Size or Natural/Raster Size -- V3.1
iupDialog.RasterSize = strDialogueArgs(tblName.Raster,strSize,math.max) -- Set Current Size to larger of Current Size or Natural/Raster Size -- V3.1
iup.Refresh(iupDialog)
tblName.Raster = iupDialog.RasterSize
if iupDialog.Visible == "YES" then -- Ensure visible dialogue origin is on screen
tblName.CoordX = math.max(tblName.CoordX,10)
tblName.CoordY = math.max(tblName.CoordY,10) -- Set both coordinates to larger of current value or 10 pixels
if iupDialog.Modal then -- V3.8
if iupDialog.Modal == "NO" then
iupDialog.ZOrder = "BOTTOM" -- Ensure dialogue is subservient to any popup
iupDialog:showxy(tblName.CoordX,tblName.CoordY) -- Use showxy() to reposition main window
else
iupDialog:popup(tblName.CoordX,tblName.CoordY) -- Use popup() to reposition modal window
end
end
else
iupDialog.BringFront="YES"
end
end
end -- function RefreshDialogue
function fh.AssignAttributes(tblControls) -- Assign the attributes of all controls supplied
local anyFunction = nil
for iupName, tblAttr in pairs ( tblControls or {} ) do
if type(iupName) == "userdata" and type(tblAttr) == "table" then-- Loop through each iup control
local intSkip = 0 -- Skip counter for attributes same for all controls
for intAttr, anyName in ipairs ( tblControls[1] or {} ) do -- Loop through each iup attribute
local strName = nil
local strAttr = nil
local strType = type(anyName)
if strType == "string" then -- Attribute is different for each control in tblControls
strName = anyName
strAttr = tblAttr[intAttr-intSkip]
elseif strType == "table" then -- Attribute is same for all controls as per tblControls[1]
intSkip = intSkip + 1
strName = anyName[1]
strAttr = anyName[2]
elseif strType == "function" then
intSkip = intSkip + 1
anyFunction = anyName
break
end
if type(strName) == "string" and ( type(strAttr) == "string" or type(strAttr) == "function" ) then
local anyRawGet = rawget(fh,strAttr) -- Use rawget() to stop require("pl.strict") complaining
if type(anyRawGet) == "string" then
strAttr = anyRawGet -- Use internal module attribute such as Head or FontBody
elseif type(iupName[strName]) == "string"
and type(strAttr) == "function" then -- Allow string attributes to invoke a function -- V3.7
strAttr = strAttr()
end
iupName[strName] = strAttr -- Assign attribute to control
end
end
end
end
if anyFunction then anyFunction() end -- Perform any control assignment function
end -- function AssignAttributes
-- Font Dialogue Attributes and Functions --
fh.FontBody = iup.GetGlobal("DEFAULTFONT") -- Set default font for Body and Head text
fh.FontHead = fh.FontBody:gsub(", B?o?l?d?",", Bold ")
---[=[
local intFontPlain = 1 -- Font Face & Style values for legacy FontSet setting
local intFontBold = 2
local intArialPlain = 3
local intArialBold = 4
local intTahomaPlain= 5
local intTahomaBold = 6
local strFontFace = fh.FontBody:gsub(",.*","")
local tblFontSet = {} -- Lookup table for FontHead and FontBody
tblFontSet[intFontPlain] = { Head=strFontFace.."; Bold -16"; Body=strFontFace.."; -15"; }
tblFontSet[intFontBold] = { Head=strFontFace.."; Bold -16"; Body=strFontFace.."; Bold -15"; }
tblFontSet[intArialPlain] = { Head="Arial; Bold -16"; Body="Arial; -16"; }
tblFontSet[intArialBold] = { Head="Arial; Bold -16"; Body="Arial; Bold -15"; }
tblFontSet[intTahomaPlain] = { Head="Tahoma; Bold -15"; Body="Tahoma; -16"; }
tblFontSet[intTahomaBold] = { Head="Tahoma; Bold -15"; Body="Tahoma; Bold -14"; }
function fh.FontAssignment(intFontSet) -- Assign Font Face & Style GUI values for legacy FontSet setting
if intFontSet then
intFontSet = math.max(intFontSet,1)
intFontSet = math.min(intFontSet,#tblFontSet)
fh.FontHead = tblFontSet[intFontSet]["Head"] -- Legacy Font for all GUI dialog header text
fh.FontBody = tblFontSet[intFontSet]["Body"] -- Legacy Font for all GUI dialog body text
end
end -- function FontAssignment
--]=]
function fh.FontDialogue(tblAttr,strName) -- GUI Font Face & Style Dialogue
tblAttr = tblAttr or {}
strName = strName or "Main"
local isFontChosen = false
local btnFontHead = iup.button { Title="Choose Headings Font and default Colour"; }
local btnFontBody = iup.button { Title="Choose Body text Font and default Colour"; }
local btnCol_Safe = iup.button { Title=" Safe Colour "; }
local btnCol_Warn = iup.button { Title=" Warning Colour "; }
local btnCol_Risk = iup.button { Title=" Risky Colour "; }
local btnDefault = iup.button { Title=" Default Fonts "; }
local btnMinimum = iup.button { Title=" Minimum Size "; }
local btnDestroy = iup.button { Title=" Close Dialogue "; }
local frmSetFonts = iup.frame { Title=" Set Window Fonts & Colours ";
iup.vbox { Alignment="ACENTER"; Margin=fh.Margin; Homogeneous="YES";
btnFontHead;
btnFontBody;
iup.hbox { btnCol_Safe; btnCol_Warn; btnCol_Risk; Homogeneous="YES"; };
iup.hbox { btnDefault ; btnMinimum ; btnDestroy ; Homogeneous="YES"; };
} -- iup.vbox end
} -- iup.frame end
-- Create dialogue and turn off resize, maximize, minimize, and menubox except Close button
local dialogFont = iup.dialog { Title=" Set Window Fonts & Colours "; Gap=fh.Gap; Margin=fh.Border; frmSetFonts; }
local tblButtons = { }
local function setDialogues() -- Refresh the Main and Help dialogues
local tblHelp = tblNameFor("Help")
if type(tblHelp.Dialog) == "userdata" then -- Help dialogue exists
fh.AssignAttributes(tblHelp.TblAttr) -- Assign the Help dialogue attributes
fh.RefreshDialogue("Help") -- Refresh the Help window size & position
end
fh.AssignAttributes(tblAttr) -- Assign parent dialogue attributes
fh.RefreshDialogue(strName) -- Refresh parent window size & position and bring infront of Help window
fh.RefreshDialogue("Font") -- Refresh Font window size & position and bring infront of parent window
end -- local function setDialogues
local function getFont(strColor) -- Set font button function
local strTitle = " Choose font style & default colour for "..strColor:gsub("Head","Heading").." text "
local strValue = "Font"..strColor -- The font codes below are not recognised by iupFontDlg and result in empty font face!
local strFont = rawget(fh,strValue):gsub(" Black,",","):gsub(" Light, Bold",","):gsub(" Extra Bold,",","):gsub(" Semibold,",",")
local iupFontDlg = iup.fontdlg { Title=strTitle; Color=rawget(fh,strColor); Value=strFont; }
iupFontDlg:popup() -- Popup predefined font dialogue
if iupFontDlg.Status == "1" then
if iupFontDlg.Value:match("^,") then -- Font face missing so revert to original font
iupFontDlg.Value = rawget(fh,strValue)
end
fh[strColor] = iupFontDlg.Color -- Set Head or Body color attribute
fh[strValue] = iupFontDlg.Value -- Set FontHead or FontBody font style
fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes
setDialogues()
isFontChosen = true
end
end -- local function getFont
local function getColor(strColor) -- Set colour button function
local strTitle = " Choose colour for "..strColor:gsub("Warn","Warning"):gsub("Risk","Risky").." button & message text "
local iupColorDlg = iup.colordlg { Title=strTitle; Value=rawget(fh,strColor); ShowColorTable="YES"; }
iupColorDlg.DialogFrame="YES"
iupColorDlg:popup() -- Popup predefined color dialogue fixed size window
if iupColorDlg.Status == "1" then
fh[strColor] = iupColorDlg.Value -- Set Safe or Warn or Risk color attribute
fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes
setDialogues()
isFontChosen = true
end
end -- local function getColor
local function setDefault() -- Action for Default Fonts button
fh.Safe = fh.Green
fh.Warn = fh.Magenta
fh.Risk = fh.Red -- Set default colours
fh.Body = fh.Black
fh.Head = fh.Black
fh.FontBody = iup.GetGlobal("DEFAULTFONT") -- Set default fonts for Body and Head text
fh.FontHead = fh.FontBody:gsub(", B?o?l?d?",", Bold")
fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes
setDialogues()
isFontChosen = true
end -- local function setDefault
local function setMinimum() -- Action for Minimum Size button
local tblName = tblNameFor(strName)
local iupDialog = tblName.Dialog -- Retrieve the parent dialogue handle
if type(iupDialog) == "userdata" then
tblName.Raster = "10x10" -- Refresh parent window to Minimum Size & adjust position
fh.RefreshDialogue(strName)
end
local tblFont = tblNameFor("Font")
tblFont.Raster = "10x10" -- Refresh Font window to Minimum Size & adjust position
fh.RefreshDialogue("Font")
end -- local function setMinimum
tblButtons = { { "Font" ; "FgColor" ; "Tip" ; "action" ; {"TipBalloon";"Balloon";} ; {"Expand";"YES";} ; };
[btnFontHead] = { "FontHead"; "Head"; "Choose the Heading text Font Face, Style, Size, Effects, and default Colour"; function() getFont("Head") end; };
[btnFontBody] = { "FontBody"; "Body"; "Choose the Body text Font Face, Style, Size, Effects, and default Colour" ; function() getFont("Body") end; };
[btnCol_Safe] = { "FontBody"; "Safe"; "Choose the colour for Safe operations" ; function() getColor("Safe") end; };
[btnCol_Warn] = { "FontBody"; "Warn"; "Choose the colour for Warning operations"; function() getColor("Warn") end; };
[btnCol_Risk] = { "FontBody"; "Risk"; "Choose the colour for Risky operations" ; function() getColor("Risk") end; };
[btnDefault ] = { "FontBody"; "Safe"; "Restore default Fonts and Colours"; function() setDefault() end; };
[btnMinimum ] = { "FontBody"; "Safe"; "Reduce window to its minimum size"; function() setMinimum() end; };
[btnDestroy ] = { "FontBody"; "Risk"; "Close this dialogue "; function() return iup.CLOSE end; };
[frmSetFonts] = { "FontHead"; "Head"; };
}
fh.AssignAttributes(tblButtons) -- Assign the button & frame attributes
fh.ShowDialogue("Font",dialogFont,btnDestroy,"keep normal") -- Popup the Set Window Fonts dialogue: "keep normal" : vary size & posn, and remember size & posn
-- fh.ShowDialogue("Font",dialogFont,btnDestroy,"popup normal") -- Popup the Set Window Fonts dialogue: "popup normal" : vary size & posn, but redisplayed centred
-- fh.ShowDialogue("Font",dialogFont,btnDestroy,"keep") -- Popup the Set Window Fonts dialogue: "keep" : fixed size, vary posn, and only remember posn
-- fh.ShowDialogue("Font",dialogFont,btnDestroy,"popup") -- Popup the Set Window Fonts dialogue: "popup": fixed size, vary posn, but redisplayed centred
dialogFont:destroy()
return isFontChosen
end -- function FontDialogue
local function anyMemoControl(anyName,fgColor) -- Compose any control Title and FgColor
local strName = tostring(anyName) -- anyName may be a string, and fgColor is default FgColor
local tipText = nil
if type(anyName) == "table" then -- anyName may be a table = { Title string ; FgColor string ; ToolTip string (optional); }
strName = anyName[1]
fgColor = anyName[2]:match("%d* %d* %d*") or fgColor
tipText = anyName[3]
end
return strName, fgColor, tipText
end -- local function anyMemoControl
local function anyMemoDialogue(strHead,anyHead,strMemo,anyMemo,...) -- Display framed memo dialogue with buttons
local arg = {...} -- Fix for Lua 5.2+
local intButt = 0 -- Returned value if "X Close" button is used
local tblButt = { [0]="X Close"; } -- Button names lookup table
local strHead, fgcHead, tipHead = anyMemoControl(anyHead or "",strHead)
local strMemo, fgcMemo, tipMemo = anyMemoControl(anyMemo or "",strMemo)
-- Create the GUI labels and buttons
local lblMemo = iup.label { Title=strMemo; FgColor=fgcMemo; Tip=tipMemo; TipBalloon=fh.Balloon; Alignment="ACENTER"; Padding=fh.Margin; Expand="YES"; WordWrap="YES"; }
local lblLine = iup.label { Separator="HORIZONTAL"; }
local iupHbox = iup.hbox { Homogeneous="YES"; }
local btnButt = iup.button { }
local strTop = "YES" -- Make dialogue TopMost -- V3.6
local strMode = "popup"
if arg[1] == "Keep Dialogue" then -- Keep dialogue open for a progress message
strMode = "keep dialogue"
lblLine = iup.label { }
if not arg[2] then strTop = "NO" end -- User chooses TopMost -- V3.6
else
if #arg == 0 then arg[1] = "OK" end -- If no buttons listed then default to an "OK" button
for intArg, anyButt in ipairs(arg) do
local strButt, fgcButt, tipButt = anyMemoControl(anyButt,fh.Safe)
tblButt[intArg] = strButt
btnButt = iup.button { Title=strButt; FgColor=fgcButt; Tip=tipButt; TipBalloon=fh.Balloon; Expand="NO"; MinSize="80"; Padding=fh.Margin; action=function() intButt=intArg return iup.CLOSE end; }
iup.Append( iupHbox, btnButt )
end
end
-- Create dialogue and turn off resize, maximize, minimize, and menubox except Close button
local iupMemo = iup.dialog { Title=fh.Plugin..fh.Version..strHead; TopMost=strTop; -- TopMost added -- V3.6
iup.vbox { Alignment="ACENTER"; Gap=fh.Gap; Margin=fh.Margin;
iup.frame { Title=strHead; FgColor=fgcHead; Font=fh.FontHead;
iup.vbox { Alignment="ACENTER"; Font=fh.FontBody; lblMemo; lblLine; iupHbox; };
};
};
}
fh.ShowDialogue("Memo",iupMemo,btnButt,strMode) -- Show popup Memo dialogue window with righthand button in focus (if any)
if strMode == "keep dialogue" then return lblMemo end -- Return label control so message can be changed
iupMemo:destroy()
return intButt, tblButt[intButt] -- Return button number & title that was pressed
end -- local function anyMemoDialogue
function fh.MemoDialogue(anyMemo,...) -- Multi-Button GUI like iup.Alarm and fhMessageBox, with "Memo" in frame
return anyMemoDialogue(fh.Head,"Memo",fh.Body,anyMemo,...)
end -- function MemoDialogue
function fh.WarnDialogue(anyHead,anyMemo,...) -- Multi-Button GUI like iup.Alarm and fhMessageBox, with heading in frame
return anyMemoDialogue(fh.Warn,anyHead,fh.Warn,anyMemo,...)
end -- function WarnDialogue
function fh.GetRegKey(strKey) -- Read Windows Registry Key Value
local luaShell = luacom.CreateObject("WScript.Shell")
local anyValue = nil
if pcall( function() anyValue = luaShell:RegRead(strKey) end ) then
return anyValue -- Return Key Value if found
end
return nil
end -- function GetRegKey
function fh.PutRegKey(strKey,anyValue,strType) -- Write Windows Registry Key Value
local luaShell = luacom.CreateObject("WScript.Shell")
local strAns = nil
if pcall( function() strAns = luaShell:RegWrite(strKey,anyValue,strType) end ) then
return true
end
return nil
end -- function PutRegKey
local function httpRequest(strRequest) -- Luacom http request protected by pcall() below
local http = luacom.CreateObject("winhttp.winhttprequest.5.1")
http:Open("GET",strRequest,false)
http:Send()
return http.Responsebody
end -- local function httpRequest
function fh.VersionInStore(strPlugin) -- Obtain the Version in Plugin Store by Name only -- V3.9
local strVersion = "0"
if strPlugin then
local strFile = fh.MachinePath.."\\VersionInStore "..strPlugin..".dat"
local intTime = os.time() - 2600000 -- Time in seconds a month ago -- V3.9
local tblAttr, strError = lfs.attributes(strFile) -- Obtain file attributes
if not tblAttr or tblAttr.modification < intTime then -- File does not exist or was modified long ago -- V3.9
local strErrFile = fh.MachinePath.."\\VersionInStoreInternetError.dat"
local strRequest ="http://www.family-historian.co.uk/lnk/checkpluginversion.php?name="..strPlugin
local isOK, strReturn = pcall(httpRequest,strRequest)
if not isOK then -- Problem with Internet access
local intTime = os.time() - 36000 -- Time in seconds 10 hours ago
local tblAttr, strError = lfs.attributes(strErrFile) -- Obtain file attributes
if not tblAttr or tblAttr.modification < intTime then -- File does not exist or was modified long ago
fhMessageBox(strReturn.."\n The Internet appears to be inaccessible. ","MB_OK","MB_ICONEXCLAMATION")
end
general.SaveStringToFile(strErrFile,strErrFile) -- Update file modified time
else
general.DeleteFile(strErrFile) -- Delete file if Internet is OK
if strReturn ~= nil then
strVersion = strReturn:match("([%d%.]*),%d*") -- Version digits & dots then comma and Id digits
general.SaveStringToFile(strVersion,strFile) -- Update file modified time and save version -- V4.1
end
end
else
strVersion = general.StrLoadFromFile(strFile) -- Retrieve saved latest version -- V4.1
if #strVersion > 9 then general.DeleteFile(strFile) end
end
end
return strVersion or "0"
end -- function VersionInStore
local function intVersion(strVersion) -- Convert version string to comparable integer
local intVersion = 0
local arrNumbers = {}
strVersion:gsub("(%d+)", function(strDigits) table.insert(arrNumbers,strDigits) end) -- V4.1
for i=1,5 do
intVersion = intVersion * 100 + tonumber(arrNumbers[i] or 0)
end
return intVersion
end -- local function intVersion
function fh.CheckVersionInStore() -- Check if later Version available in Plugin Store
local strNewVer = fh.VersionInStore(fh.Plugin:gsub(" %- .*",""))
local strOldVer = fh.Version
if intVersion(strNewVer) > intVersion(strOldVer:match("%D*([%d%.]*)")) then
fh.MemoDialogue("Later Version "..strNewVer.." of this Plugin is available from the Family Historian 'Plugin Store'.")
end
end -- function CheckVersionInStore
function fh.PluginDataScope(strScope) -- Set default Plugin Data scope to per-Project, or per-User, or per-Machine
strScope = tostring(strScope):lower()
if strScope:match("mach") then -- Per-Machine
strDefaultScope = "Machine"
elseif strScope:match("user") then -- Per-User
strDefaultScope = "User"
end -- Per-Project is default
end -- function PluginDataScope
--[=[ --! -- V4.0
local function strToANSI(strFileName)
if stringx.encoding() == "ANSI" then return strFileName end
return fhConvertUTF8toANSI(strFileName)
end -- local function strToANSI
--]=]
local function getPluginDataFileName(strScope) -- Get plugin data filename for chosen scope
local isOK, strDataFile = pcall(fhGetPluginDataFileName,strScope)
if not isOK then strDataFile = fhGetPluginDataFileName() end -- Before V5.0.8 parameter is disallowed and default = CURRENT_PROJECT
--! return strToANSI(strDataFile) -- V4.0
return strDataFile
end -- local function getPluginDataFileName
local function getDataFiles(strScope) -- Compose the Plugin Data file & path & root names
--! local strPluginName = strToANSI(fh.Plugin) -- V4.0
local strPluginName = fh.Plugin
local strPluginPlain = stringx.plain(strPluginName)
local strDataFile = getPluginDataFileName(strScope) -- Allow plugins with variant filenames to use same plugin data files
strDataFile = strDataFile:gsub("\\"..strPluginPlain:gsub(" ","_"):lower(),"\\"..strPluginName)
strDataFile = strDataFile:gsub("\\"..strPluginPlain..".+%.[D,d][A,a][T,t]$","\\"..strPluginName..".dat")
if strDataFile == "" and strScope == "CURRENT_PROJECT" then -- Use standalone GEDCOM path & filename..".fh_data\Plugin Data\" as the folder + the Plugin Filename..".dat"
--! strDataFile = strToANSI(fhGetContextInfo("CI_GEDCOM_FILE")) -- V4.0
strDataFile = fhGetContextInfo("CI_GEDCOM_FILE")
strDataFile = strDataFile:gsub("%.[G,g][E,e][D,d]",".fh_data")
general.MakeFolder(strDataFile) -- V3.4
strDataFile = strDataFile.."\\Plugin Data"
general.MakeFolder(strDataFile) -- V3.4
strDataFile = strDataFile.."\\"..strPluginName..".dat"
end
local strDataPath = strDataFile:gsub("\\"..strPluginPlain.."%.[D,d][A,a][T,t]$","") -- Plugin data folder path name
local strDataRoot = strDataPath.."\\"..strPluginName -- Plugin data file root name
general.MakeFolder(strDataPath) -- V3.4
return strDataFile, strDataPath, strDataRoot
end -- local function getDataFiles
function fh.Initialise(strVersion,strPlugin) -- Initialise the GUI module with optional Version & Plugin name
--! local strAppData = strToANSI(fhGetContextInfo("CI_APP_DATA_FOLDER")) -- V4.0
local strAppData = fhGetContextInfo("CI_APP_DATA_FOLDER")
fh.Plugin = fhGetContextInfo("CI_PLUGIN_NAME") -- Plugin Name from file
fh.Version = strVersion or " " -- Plugin Version
if fh.Version == " " then
local strTitle = "\n@Title is missing"
local strAuthor = "\n@Author is missing"
local strVersion = "\n@Version is missing"
local strPlugin = strAppData.."\\Plugins\\"..fh.Plugin..".fh_lua"
if general.FlgFileExists(strPlugin) then
for strLine in io.lines(strPlugin) do -- Read each line from the Plugin file
strPlugin = strLine:match("^@Title:[\t-\r ]*(.*)")
if strPlugin then
strPlugin = strPlugin:gsub("&&","&")
--? if fh.Plugin:match("^"..strPlugin:gsub("(%W)","%%%1")) then
if fh.Plugin:match("^"..stringx.plain(strPlugin)) then
fh.Plugin = strPlugin -- Prefer Title to Filename if it matches
strTitle = nil
else
strTitle = "\n@Title differs from Filename" -- Report abnormality
end
end
if strLine:match("^@Author:%s*(.*)") then -- Check @Author exists
strAuthor = nil
end
fh.Version = strLine:gsub("^@Version:%D*([%d%.]*)%D*"," %1 ")
if fh.Version ~= strLine then -- Obtain the @Version from Plugin file
strVersion = nil
break
end
end
if strTitle or strAuthor or strVersion then -- Report any header abnormalities
fhMessageBox("\nScript Header: "..fh.Plugin..(strTitle or "")..(strAuthor or "")..(strVersion or ""),"MB_OK","MB_ICONEXCLAMATION")
end
else
fhMessageBox("\nPlugin has not been saved!","MB_OK","MB_ICONEXCLAMATION")
end
end
fh.History = fh.Version -- Version History
fh.Plugin = strPlugin or fh.Plugin -- Plugin Name from argument or default from file
fh.CustomDialogue("Help","1020x730") -- Custom "Help" dialogue sizes
fh.DefaultDialogue() -- Default "Font","Help","Main" dialogues
fh.MachineFile,fh.MachinePath,fh.MachineRoot = getDataFiles("LOCAL_MACHINE") -- Plugin data names per machine
fh.PerUserFile,fh.PerUserPath,fh.PerUserRoot = getDataFiles("CURRENT_USER") -- Plugin data names per user
fh.ProjectFile,fh.ProjectPath,fh.ProjectRoot = getDataFiles("CURRENT_PROJECT") -- Plugin data names per project
--! fh.FhDataPath = strToANSI(fhGetContextInfo("CI_PROJECT_DATA_FOLDER")) -- Paths used by Load/SaveFolder for relative folders -- V4.0
--! fh.PublicPath = strToANSI(fhGetContextInfo("CI_PROJECT_PUBLIC_FOLDER")) -- Public data folder path name -- V4.0
fh.FhDataPath = fhGetContextInfo("CI_PROJECT_DATA_FOLDER") -- Paths used by Load/SaveFolder for relative folders -- V4.0
fh.PublicPath = fhGetContextInfo("CI_PROJECT_PUBLIC_FOLDER") -- Public data folder path name -- V4.0
if fh.FhDataPath == "" then
fh.FhDataPath = fh.ProjectPath:gsub("\\Plugin Data$","")
end
if fh.PublicPath == "" then
fh.PublicPath = fh.ProjectPath
fh.FhProjPath = fh.PublicPath:gsub("^(.+)\\.-\\Plugin Data$","%1")
else
general.MakeFolder(fh.PublicPath) -- V3.4
fh.FhProjPath = fh.PublicPath:gsub("^(.+)\\.-\\Public$","%1")
end
fh.CalicoPie = strAppData:gsub("\\Calico Pie\\.*","\\Calico Pie") -- Program Data Calico Pie path name
fh.ComputerName = os.getenv("COMPUTERNAME") -- Local PC Computer Name
end -- function Initialise
fh.Initialise() -- Initialise module with default values
return fh
end -- local function iup_gui_v3
local iup_gui = iup_gui_v3() -- To access FH IUP GUI build module
require "imlua" -- To access digital imaging library to check Media image frame areas
local ArrKB = {}
-- Preset Global Data Definitions --
function PresetGlobalData()
iup_gui.Gap = "2"
iup_gui.SetUtf8Mode()
general.DetectOldModules() -- V2.8
IntRowHeight = 8 -- Matrix height of data rows in setControls() via iup_gui.AssignAttributes
TblOption = {} -- Table of GUI toggle exception options
TblAttrib = {} -- Table of GUI toggle attributes
TblGrid = {} -- Table grid of statistics and related data
StrGridFile = iup_gui.ProjectRoot..".grid" -- Full path of plugin grid file
StrProjPath = iup_gui.FhDataPath -- Full path of Project GEDCOM file
local datToday = fhNewDate(2000)
datToday:SetSimpleDate(fhCallBuiltInFunction("Today")) -- Date today for future date checks
DptToday = datToday:GetDatePt1() -- V2.0
end -- function PresetGlobalData
-- Reset Sticky Settings to Default Values --
function ResetDefaultSettings()
iup_gui.CustomDialogue("Main") -- Centralise "Main"
iup_gui.DefaultDialogue("Bars","Memo") -- GUI window rastersize and X & Y co-ordinates for "Main","Font","Bar","Memo" dialogues
for strName, anyValue in pairs ( TblOption ) do
if #strName > 12 then -- Names > 12 chars do not conflict with 11 char settings below
TblOption[strName] = "ON" -- Enable all Options tab TblAttrib toggles -- V1.7
end
end
IntTabPosn = 0 -- Default to tab undefined
TblOption.TabPosition = IntTabPosn -- V 1.8
TblOption.DateWarning = "ON" -- Reset other Options tab settings
TblOption.MaximumAges = 120
TblOption.MinimumYear = 1000
end -- function ResetDefaultSettings
-- Load Sticky Settings from File --
function LoadSettings()
iup_gui.LoadSettings() -- Includes "Main","Font" dialogues and "FontSet" & "History"
iup_gui.Balloon = "NO" -- V2.1 for PlayOnLinux/Mac
IntTabPosn = tonumber(iup_gui.LoadGlobal("TabPosn",IntTabPosn)) -- Legacy V1.8
TblOption = iup_gui.LoadGlobal("Option",TblOption) -- V1.7
TblOption.TabPosition = TblOption.TabPosition or IntTabPosn -- V1.8
TblOption.DateWarning = TblOption.DateWarning or "ON"
TblOption.MaximumAges = TblOption.MaximumAges or 120
TblOption.MinimumYear = TblOption.MinimumYear or 1000
DptMinimum = fhNewDatePt(TblOption.MinimumYear) -- Date Point earliest year check -- V2.0
if general.FlgFileExists(StrGridFile) then
TblGrid, StrErr = table.load(StrGridFile) -- Load Grid table --!
if TblGrid.RepText then -- Load Result Set Exception Report data
for intItem = 1, #TblGrid.RepText do -- Recreate Report Item pointer from Data Ref & Record Id
TblGrid.RepItem[intItem] = general.GetDataRefPtr(TblGrid.DataRef[intItem],TblGrid.RecIdNo[intItem])
end
end
end
SaveSettings() -- Save sticky data settings
end -- function LoadSettings
-- Save Sticky Settings to File --
function SaveSettings()
--# iup_gui.SaveGlobal("TabPosn",IntTabPosn) -- V1.8
iup_gui.SaveGlobal("Option" ,TblOption ) -- V1.7
iup_gui.SaveSettings() -- Includes "Main","Font" dialogues and "FontSet" & "History"
table.save(TblGrid,StrGridFile) -- Save Grid table --!
end -- function SaveSettings
-- Graphical User Interface --
function GUI_MainDialogue()
local strVer = TblGrid.Version or iup_gui.Version -- Check the grid version against GUI version
if strVer ~= iup_gui.Version
or not TblGrid.Base or #TblGrid[TblGrid.Base.Records] < 2 -- V2.0
or not ( TblGrid.MaxRows or TblGrid.Indi.Top or TblGrid.Flag.Top ) then -- Create the data grid of Row & Col headings, etc
local strPlaceRecord, strResearchNote, strSourceTemplate -- V2.2
if fhGetAppVersion() > 5 then strPlaceRecord = "Place" end
if fhGetAppVersion() > 6 then strResearchNote = "Research Note" strSourceTemplate = "Source Template" end
TblGrid = { } -- V2.0 -- New Base field, Couples => Families grid, new Data grid
TblGrid.Base = { Records="Rec"; Individuals="Ind"; Families="Fam"; Flags="Flg"; Facts="Fct"; Data="Dat"; }
TblGrid.Rec = { }
TblGrid.Rec.Col = { "Count "; "Media "; "Cites "; "Links "; "Idents"; "Oldest Update"; "Latest Update"; }
TblGrid.Rec.Row = { "All"; "Individual"; "Family"; "Note"; "Source"; "Repository"; "Multimedia"; strPlaceRecord; strResearchNote; strSourceTemplate; } -- V2.2
table.insert(TblGrid.Rec.Row,"Submitter") table.insert(TblGrid.Rec.Row,"Submission") table.insert(TblGrid.Rec.Row,"Header") -- V2.2
TblGrid.Ind = { }
TblGrid.Ind.Col = { "Count"; }
TblGrid.Ind.Row = { "All"; "Male"; "Female"; "Unknown"; "Parentless"; "Many Parents"; "No Birth"; "No Death"; "Pool 1"; "Pool 2"; } -- Always include two Pool names -- v2.0
TblGrid.Fam = { }
TblGrid.Fam.Col = { "Count"; }
TblGrid.Fam.Row = { "All"; "Both Sex Pairs"; "Same Sex Pairs"; "One Parent"; "No Parents"; "Max. Spouses"; "No Marriage"; "Childless"; "Total Children"; "Ave. Children"; "Max. Children"; } -- V2.0
TblGrid.Flg = { }
TblGrid.Flg.Col = { "Count"; }
TblGrid.Flg.Row = { "All"; "Living"; "Private"; } -- Always include two Flag names
TblGrid.Fct = { }
TblGrid.Fct.Col = { "Count "; "Media "; "Cites "; "Place "; "Addr "; "Age "; "Min. "; "Ave. "; "Max. "; "Age@ "; "Min@ "; "Ave@ "; "Max@ "; "Date "; "Earliest Fact Date "; "Latest Fact Date "; }
TblGrid.Fct.Row = { "All"; "Names"; "Birth"; "Baptism"; "Christening"; "Marriage"; "Divorce"; "Census"; "Occupation"; "Residence"; "Death"; "Burial"; "Cremation"; "All Other"; } -- V2.0
TblGrid.Dat = { }
TblGrid.Dat.Col = { " Fact\nTypes "; "Media\nKeywords"; " Places "; "Addresses"; "Occu-\npations"; "Religions"; "Groups\nCastes"; "National\nOrigins"; "Education\nContexts"; "Physical\nDesc."; "Posse-\nssions "; " Titles "; "National\nId. Nos."; "US Soc.\nSec. Nos."; "Source\nTypes"; } -- V2.0
TblGrid.Dat.Row = { " Totals"; } -- V2.0
TblGrid.Dat.WwD = { } -- Work with Data dictionary -- V2.0
TblGrid.Ind.Top = #TblGrid.Ind.Row - 1 -- Set row sizes for RevealList()
TblGrid.Flg.Top = #TblGrid.Flg.Row - 1
TblGrid.MaxRows = #TblGrid.Fct.Row + #TblGrid.Dat.Row + 1 -- Set max rows for RevealList() based on Facts tab rows -- V2.0
TblGrid.Updated = "Never"
TblGrid.RepName = { } -- Result Set Exception Report data
TblGrid.RepItem = { }
TblGrid.RepText = { }
TblGrid.DataRef = { }
TblGrid.RecIdNo = { }
end
TblObjArea = { } -- Clear FH V7 Object Area array -- V2.3
TblRecords = TblGrid[TblGrid.Base.Records]
TblIndivid = TblGrid[TblGrid.Base.Individuals]
TblFamily = TblGrid[TblGrid.Base.Families]
TblFlags = TblGrid[TblGrid.Base.Flags]
TblFacts = TblGrid[TblGrid.Base.Facts]
TblData = TblGrid[TblGrid.Base.Data]
TblGrid.Version = iup_gui.Version -- Reset grid if version changes
if strVer ~= iup_gui.Version then
iup_gui.MemoDialogue("\n Table Grid"..strVer.."mismatches"..iup_gui.Version.."so a reset is required. \n")
ResetGridCells(TblGrid)
end
for strGrid, strBase in pairs (TblGrid.Base) do -- Create the matrix controls -- V2.0
local tblGrd = TblGrid[strBase] -- V2.0 made local
local tblRow = tblGrd.Row
local tblCol = tblGrd.Col
local intRow = #tblRow
local intCol = #tblCol
local iupMat = iup.matrix {
NumCol=intCol; NumCol_Visible=intCol; NumLin=intRow; NumLin_Visible=intRow; UseTitleSize="YES";
ReadOnly="YES"; Alignment="ARIGHT"; BgColor=iup_gui.Smoke; FrameColor=iup_gui.Smoke; ScrollBar="NO";
HideFocus="YES"; ResizeMatrix="YES"; TipBalloon=iup_gui.Balloon; Tip=strGrid.." related statistics."; }
iupMat:setcell(0,0,strGrid) -- Grid heading text
for intRow = 1, intRow do iupMat:setcell(intRow,0,tblRow[intRow]) end -- Row headings text
for intCol = 1, intCol do iupMat:setcell(0,intCol,tblCol[intCol]) end -- Col headings text
tblGrd.Mat = iupMat -- Save matrix control handle
end
local tblToggle = { } -- GUI Option tab toggle controls -- V1.7
TblAttrib = { -- Toggle Names > 12 chars long do not conflict with other settings
-- 1~Toggle Name ; 2~Title and Tip ; 3~Exception Report Detailed Explanation
{ "CiteDateFormat" ; "Citation Entry Date : format is not valid" ; "Citation Entry Date : " };
{ "CiteDateFuture" ; "Citation Entry Date found in the future" ; "Citation Entry Date found in the future : " };
{ "CiteDateTooOld" ; "Citation Entry Date found too far in past < Earliest Date Year" ; "Citation Entry Date found too far in past : " };
{ "DateNoDayNumber" ; "Date does not provide a Day Number nor Day Of Week" ; "Date does not provide a Day Number nor Day Of Week." }; -- V2.0
{ "DuplicatedBMD" ; "Duplicated BMD event" ; "Duplicated BMD event : " }; -- V2.9
{ "EventLinkFamily" ; "Event has Link to Parents Family via All tab" ; "Event has Link to Parents Family via All tab." };
{ "FactAgeNegative" ; "Fact Age is negative" ; "Fact Age is negative : " };
{ "FactAgeTooLarge" ; "Fact Age is too large > Maximum Age Years" ; "Fact Age is too large : " };
{ "FactDateFormat" ; "Fact Date : format is not valid" ; "Fact Date : " };
{ "FactDateFuture" ; "Fact Date found in the future" ; "Fact Date found in the future : " };
{ "FactDateTooOld" ; "Fact Date found too far in past < Earliest Date Year" ; "Fact Date found too far in past : " };
{ "FactDateSimple" ; "Fact Date is closer/earlier/later/more than ..." ; "^Fact Date is [%a ]+ than .+" }; -- V2.0
{ "FactDatePeriod" ; "Fact Date period extends earlier/later/more than ..." ; "^Fact Date period extends [%a ]+ than .+" }; -- V2.0
{ "FactDateRanges" ; "Fact Date range extends earlier/later/more than ..." ; "^Fact Date range extends [%a ]+ than .+" }; -- V2.0
{ "GenderIndividual" ; "Gender of Individual is undefined" ; "Gender of Individual is undefined." };
{ "IdentAutoRecId" ; "Ident Automatic Record Id" ; "Ident Automatic Record Id : " };
{ "IdentPermRecNo" ; "Ident Permanent Record No" ; "Ident Permanent Record No : " };
{ "LivingFlagDeath" ; "Living Flag despite Death &&/or Burial &&/or Cremation Event" ; "Living Flag despite Death &/or Burial &/or Cremation Event." };
{ "NoBirthBaptism" ; "No Birth, Baptism, or Christening Event" ; "No Birth, Baptism, or Christening Event." };
{ "NoDeathBuryFlag" ; "No Death, Burial, or Cremation Event nor Living Flag" ; "No Death, Burial, or Cremation Event nor Living Flag." };
{ "NoMarriageEvent" ; "No Marriage Event nor Never Married/Unmarried Couple Status" ; "No Marriage Event nor unmarried Status." };
{ "NoParentButChild" ; "No Parents Family but with Children" ; "No Parents Family but with Children." };
{ "NoParentNorChild" ; "No Parents Family without Children" ; "No Parents Family without Children." };
{ "OneParentNoChild" ; "One Parent Family without Children" ; "One Parent Family without Children." };
{ "SpouseDuplicate" ; "Spouse link is duplicated" ; "Spouse link is duplicated." };
{ "UncatDataField" ; "Uncategorised Data Field or UDF" ; "Uncategorised Data Field or UDF." }; -- V2.0
{ "UnusedFlagEntry" ; "Unused Listed Flag : for named flag" ; "Unused Listed Flag : " };
{ "UnusualFormatType" ; "Unusual Multimedia Format versus File Type" ; "Unusual Multimedia Format : " };
{ "UnusualFrameArea" ; "Unusual Multimedia Frame Area for Media File" ; "Unusual Multimedia Frame : " };
{ "UnusualSnapshots" ; "Unusual number of Snapshot files" ; "Unusual number of Snapshot files : " };
}
local function strExceptionReports() -- Title for lblReports control -- V2.0
local intReport = 0
for intText, strText in ipairs ( TblGrid.RepText ) do -- Search through each Exception Report
for intPos, tblAttr in ipairs ( TblAttrib ) do
if strText:match(tblAttr[3]) then -- Only include Report in count -- V2.4
if TblOption[tblAttr[1]] == "ON" then -- if its tick box Option is "ON"
intReport = intReport + 1
end
break
end
end
end
return "Exceptions Detected : "..tostring(#TblGrid.RepText).." Reported : "..tostring(intReport)
end -- local function strExceptionReports
local function strLastUpdated(strUpdate)
TblGrid.Updated = strUpdate or TblGrid.Updated or "Never" -- Set Grid last updated value
return "Statistics Last Updated : "..TblGrid.Updated -- Title for lblUpdated control
end -- local function strLastUpdated
-- Create the controls with title/value and tooltip
local lblProject = iup.label { Title=fhGetContextInfo("CI_PROJECT_NAME"); }
local lblReports = iup.label { Title=strExceptionReports(); } -- V2.0
local lblUpdated = iup.label { Title=strLastUpdated(); }
local lblTickAny = iup.label { Title="Choose which of the Exception Reports to include by ticking or clearing the check boxes below"; }
local btnTickAll = iup.button { Title="Tick every box to Report ALL Exceptions"; }
local btnTickNon = iup.button { Title="Clear every box to Report NO Exceptions"; }
local lblMinYear = iup.label { Title="Earliest Date Year : "; Alignment="ARIGHT"; }
local txtMinYear = iup.text { Spin="YES"; SpinMin=0; SpinMax=2000; SpinAlign="RIGHT"; Alignment="ARIGHT"; }
local lblMaxAges = iup.label { Title="Maximum Age Years : " ; Alignment="ARIGHT"; }
local txtMaxAges = iup.text { Spin="YES"; SpinMin=50; SpinMax=150; SpinAlign="RIGHT"; Alignment="ARIGHT"; }
local tglWarning = iup.toggle { Title=" Detect all the Date Warning Exceptions "; }
local lblWarning = iup.label { Title="Untick to reduce Update Statistics run time for large Projects"; }
local lblDetects = iup.label { Title=strExceptionReports(); Alignment="ACENTER"; } -- V2.4
local btnUpdate = iup.button { Title="Update Statistics"; }
local btnExport = iup.button { Title="Export CSV Files" ; }
local btnDefault = iup.button { Title="Restore Defaults" ; }
local btnSetFont = iup.button { Title="Set Window Fonts" ; }
local btnGetHelp = iup.button { Title=" Help && Advice" ; }
local btnDestroy = iup.button { Title=" Close && Report"; }
-- Create the Records tab layout
local boxRecords = iup.hbox { Gap=iup_gui.Gap; iup.vbox { TblRecords.Mat; lblProject; lblReports; lblUpdated; }; TblIndivid.Mat; TblFamily.Mat; TblFlags.Mat; } -- V2.0
-- Create the Facts tab layout
local boxFacts = iup.hbox { Gap=iup_gui.Gap; iup.vbox { TblFacts.Mat; TblData.Mat; }; } -- V2.0
-- Create the Options tab layout -- V1.8
local boxTickAny = iup.hbox { Homogeneous="YES"; btnTickAll; btnTickNon; Margin="45x10"; Gap="90"; }
local boxToggleL = iup.vbox { Margin="0x0"; }
local boxToggleR = iup.vbox { Margin="0x0"; }
local boxToggles = iup.hbox { Homogeneous="YES"; boxToggleL; boxToggleR; Margin="0x0"; Gap=iup_gui.Gap; } -- V2.4 -- Gap=iup_gui.Gap was "0"
local boxSetSpin = iup.hbox { Homogeneous="YES"; iup.hbox { Homogeneous="YES"; lblMinYear; txtMinYear }; iup.hbox { Homogeneous="YES"; lblMaxAges; txtMaxAges; }; }
-- local boxWarning = iup.hbox { tglWarning; lblWarning; }
local boxOptions = iup.vbox { Gap=iup_gui.Gap; Margin="4x4"; Alignment="ACENTER"; lblTickAny; boxTickAny; boxToggles; boxSetSpin; tglWarning; lblWarning; lblDetects; }
for intPos, tblAttr in ipairs ( TblAttrib ) do -- Add all the Report toggle Option attributes -- V1.7
TblAttrib[tblAttr[1]] = intPos -- Index to Attrib used mainly in MarkCell() but also in parameters to ExceptionReport()
TblOption[tblAttr[1]] = TblOption[tblAttr[1]] or "ON"
tblToggle[tblAttr[1]] = iup.toggle { Title=" "..tblAttr[2]; Tip=tblAttr[2]:gsub("&&","and"); TipBalloon=iup_gui.Balloon; Expand="YES"; } -- V1.8
tblToggle[tblAttr[1]].action = function(self,intState) -- Toggle action -- V2.4
for strName, iupName in pairs ( tblToggle ) do
TblOption[strName] = iupName.Value -- Save all Option toggles -- V1.8
end
lblDetects.Title = strExceptionReports()
return intState
end
if intPos <= #TblAttrib / 2 then
iup.Append( boxToggleL, tblToggle[tblAttr[1]] ) -- Add 1st half of toggles to lefthand column -- V1.8
else
iup.Append( boxToggleR, tblToggle[tblAttr[1]] ) -- Add 2nd half of toggles to righthand column -- V1.8
end
end
-- Create the Tab controls layout
local tabControl = iup.tabs { Font=iup_gui.FontHead; -- Padding="8x4" moved to Controls() -- V2.2
boxRecords; TabTitle0=" Records ";
boxFacts ; TabTitle1=" Facts ";
boxOptions; TabTitle2=" Options ";
}
-- Create the Button controls
local boxButtons = iup.hbox { Homogeneous="YES"; Gap="4"; Margin="4x4"; btnUpdate; btnExport; btnDefault; btnSetFont; btnGetHelp; btnDestroy; }
-- Combine all the above controls
local allControl = iup.vbox { Margin="0x0";
tabControl;
boxButtons;
}
-- Create dialogue with Close button that quits Plugin without Saving Settings nor Exception Report Result Set
local dialogMain = iup.dialog { Title=iup_gui.Plugin..iup_gui.Version; BringFront="YES"; allControl; }
local function setControls() -- Reset GUI control values -- V1.8 renamed & modified
-- # IntRowHeight = iup_gui.FontBody:match("([0-9]+)$") * 2 -- Row pixel height is twice font size (except col header row that is automatic) -- V1.8
IntRowHeight = iup_gui.FontBody:match("([0-9]+)$") -- Row size height is font size (except col header row that is automatic) -- V2.4
for strGrid, strBase in pairs (TblGrid.Base) do -- Loop through all grid cells -- V2.0
local tblGrd = TblGrid[strBase] -- V1.8 made local
local iupMat = tblGrd.Mat -- Get matrix handle
for intRow = 1, #tblGrd.Row do
-- # iupMat["RasterHeight"..intRow] = IntRowHeight -- Pixel height of data rows -- V1.8
iupMat["Height"..intRow] = IntRowHeight -- Size height of data rows -- V2.4
end
for intCol = 1, #tblGrd.Col do
iupMat["Font*:"..intCol] = iup_gui.FontBody -- Row & Col data body font
end
iupMat["Font0:0"] = iup_gui.FontHead -- Grid title head font & colour
iupMat["FgColor0:0"] = iup_gui.Head
iupMat["Font0:*"] = iup_gui.FontBody -- Col header body font & colour
iupMat["FgColor0:*"] = iup_gui.Body
iupMat["Font*:0"] = iup_gui.FontBody -- Row header body font & colour
iupMat["FgColor*:0"] = iup_gui.Body
iupMat.redraw = "ALL"
end
for strName, iupName in pairs ( tblToggle ) do
tblToggle[strName].Value = TblOption[strName] or "ON" -- Load all Option toggles -- V1.7 -- V2.7
end
if fhGetAppVersion() > 6 then -- FH V7 IUP 3.28 -- V2.2
tabControl.TabPadding = "8x4"
else -- FH V6 IUP 3.11 -- V2.2
tabControl.Padding = "8x4"
end
IntTabPosn = TblOption.TabPosition -- V1.8
tabControl.ValuePos = math.max(0,IntTabPosn - 1) -- Adjust tab selection -- 3 Aug 2013
txtMinYear.SpinValue = TblOption.MinimumYear -- Minimum Year for too early Date check
txtMaxAges.SpinValue = TblOption.MaximumAges -- Maximum Age for too large Age check
tglWarning.Value = TblOption.DateWarning -- Enable the Date Warning checks -- V1.8
end -- local function setControls
-- GUI control other attributes
local tblControls = { {"Font";"FgColor";"Expand";"Padding";"Tip"; {"TipBalloon";"Balloon";}; {"help_cb";function() iup_gui.HelpDialogue(IntTabPosn) end;}; setControls; };
[dialogMain] = { "FontBody"; "Info"; "YES"; };
[tabControl] = { "FontHead"; "Head"; "YES"; false; "Show 'Records' or 'Facts' statistics, or review 'Options'"; };
[lblProject] = { "FontHead"; "Head"; "YES"; "9x0"; "Name of the currently open Project"; };
[lblReports] = { "FontHead"; "Head"; "YES"; "9x0"; "Number of Exceptions Detected and number Reported in Result Set"; };
[lblUpdated] = { "FontHead"; "Head"; "YES"; "9x0"; "Latest statistics update date and time"; };
[boxOptions] = { "FontBody"; "Info"; "NO" ; };
[lblTickAny] = { "FontBody"; "Body"; "NO" ; "0x0"; "Choose which of the Exception Reports to include"; };
[btnTickAll] = { "FontBody"; "Safe"; "YES"; "0x0"; "Include all the Exception Reports"; };
[btnTickNon] = { "FontBody"; "Risk"; "YES"; "0x0"; "Exclude all the Exception Reports"; };
[lblMinYear] = { "FontBody"; "Body"; "NO" ; "4x0"; "Set earliest year for any Dates"; }; -- was YES -- V2.4
[txtMinYear] = { "FontBody"; "Safe"; "NO" ; "4x0"; "Set earliest year for any Dates"; };
[lblMaxAges] = { "FontBody"; "Body"; "NO" ; "4x0"; "Set maximum years for any Ages"; }; -- was YES -- V2.4
[txtMaxAges] = { "FontBody"; "Safe"; "NO" ; "4x0"; "Set maximum years for any Ages"; };
[tglWarning] = { "FontBody"; "Body"; "NO" ; "0x0"; "Detect all the Date Warning Exceptions, but those that are\n'found in the future' or 'found too far in past' are unconditional\n(Untick to reduce Update Statistics run time for large Projects)"; };
[lblWarning] = { "FontBody"; "Body"; "NO" ; "0x0"; "Detect all the Date Warning Exceptions, but those that are\n'found in the future' or 'found too far in past' are unconditional\n(Untick to reduce Update Statistics run time for large Projects)"; };
[lblDetects] = { "FontHead"; "Head"; "YES"; "9x4"; "Number of Exceptions Detected and number Reported in Result Set"; };
[btnUpdate] = { "FontBody"; "Safe"; "YES"; "4x0"; "Update all the project statistics and\nthe Result Set Exception Report"; };
[btnExport] = { "FontBody"; "Safe"; "YES"; "4x0"; "Export the statistics to CSV files"; };
[btnDefault] = { "FontBody"; "Safe"; "YES"; "4x0"; "Clear the statistics, reset the options, and centralise windows"; };
[btnSetFont] = { "FontBody"; "Safe"; "YES"; "4x0"; "Alter the window interface font styles and colours"; };
[btnGetHelp] = { "FontBody"; "Safe"; "YES"; "4x0"; "Access the online Help and Advice pages"; };
[btnDestroy] = { "FontBody"; "Risk"; "YES"; "4x0"; "Close the Plugin and show the\n Result Set Exception Report"; };
}
local function saveOptions() -- V1.7 Save all GUI settings
for strName, iupName in pairs ( tblToggle ) do
TblOption[strName] = iupName.Value -- Save all Option toggles -- V1.8
end
TblOption.TabPosition = IntTabPosn -- V1.8
TblOption.DateWarning = tostring(tglWarning.Value) -- Enable/Disable Date Warning checks
TblOption.MaximumAges = tonumber(txtMaxAges.SpinValue) -- Maximum Age for too large Age check
TblOption.MinimumYear = tonumber(txtMinYear.SpinValue) -- Minimum Year for too early Date check
DptMinimum = fhNewDatePt(TblOption.MinimumYear)
SaveSettings() -- Save sticky data settings
end -- local function saveOptions
function btnTickAll:action() -- Action for Tick every box to Report ALL Exceptions button
for strName, iupName in pairs ( tblToggle ) do
iupName.Value = "ON" -- V1.8
TblOption[strName] = "ON"
end
lblDetects.Title = strExceptionReports() -- V2.4
end -- function btnTickAll:action
function btnTickNon:action() -- Action for Clear every box to Report NO Exceptions button
for strName, iupName in pairs ( tblToggle ) do
iupName.Value = "OFF" -- V1.8
TblOption[strName] = "OFF"
end
lblDetects.Title = strExceptionReports() -- V2.4
end -- function btnTickNon:action
function btnUpdate:action() -- Action for Update Statistics button
boxButtons.Active = "NO"
dialogMain.Active = "NO"
saveOptions()
if UpdateStatistics(TblGrid) then
ShowStatistics(TblGrid)
lblUpdated.Title = strLastUpdated(os.date()) -- Update OK so record date & time
else
ResetGridCells(TblGrid) -- Update stopped so reset statistics grid
lblUpdated.Title = strLastUpdated("Never")
end
lblReports.Title = strExceptionReports() -- Update number of Exceptions Detected -- V2.0
lblDetects.Title = strExceptionReports() -- V2.4
SaveSettings() -- Save sticky data settings
dialogMain.Active = "YES"
dialogMain.BringFront = "YES"
boxButtons.Active = "YES"
end -- function btnUpdate:action
function btnExport:action() -- Action for Export Statistics button
boxButtons.Active = "NO"
ExportStatistics(TblGrid)
boxButtons.Active = "YES"
end -- function btnExport:action
function btnDefault:action() -- Action for Restore Defaults button
general.DeleteFile(iup_gui.ProjectRoot..".dat") -- V2.7
iup_gui.LoadSettings() -- V2.7
TblOption = {} -- V2.7
ResetDefaultSettings()
ResetGridCells(TblGrid) -- Reset statistics grid
lblReports.Title = strExceptionReports()
lblDetects.Title = strExceptionReports() -- V2.4
lblUpdated.Title = strLastUpdated("Never")
setControls() -- Reset controls & redisplay Main dialogue
iup_gui.ShowDialogue("Main")
SaveSettings() -- Save sticky data settings
end -- function btnDefault:action
function btnSetFont:action() -- Action for Set Interface Font button
btnSetFont.Active = "NO"
iup_gui.FontDialogue(tblControls,"Main")
SaveSettings() -- Save sticky data settings
btnSetFont.Active = "YES"
end -- function btnSetFont:action
function btnSetFont:button_cb(intButton,intPress) -- Action for mouse right-click on Set Window Fonts button
if intButton == iup.BUTTON3 and intPress == 0 then
iup_gui.BalloonToggle() -- Toggle tooltips Balloon mode
end
end -- function btnSetFont:button_cb
local function doExecute(strExecutable, strParameter) -- Invoke FH Shell Execute API -- V2.2
local function ReportError(strMessage)
iup_gui.WarnDialogue( "Shell Execute Error",
"ERROR: "..strMessage.." :\n"..strExecutable.."\n"..strParameter.."\n\n",
"OK" )
end -- local function ReportError
return general.DoExecute(strExecutable, strParameter, ReportError)
end -- local function doExecute
local strHelp = "https://pluginstore.family-historian.co.uk/page/help/show-project-statistics"
local arrHelp = { "-records-tab"; "-facts-tab"; "-options-tab"; }
function btnGetHelp:action() -- Action for Help & Advice button according to current tab -- V2.2
local strPage = arrHelp[IntTabPosn] or ""
doExecute( strHelp..strPage )
fhSleep(3000,500)
dialogMain.BringFront="YES"
end -- function btnGetHelp:action
function btnDestroy:action() -- Action for Close Plugin button
saveOptions() -- V1.7 Save options
local tblRepName = {}
local tblRepItem = {}
local tblRepText = {}
for intText, strText in ipairs ( TblGrid.RepText ) do -- Search through each Exception Report
for intPos, tblAttr in ipairs ( TblAttrib ) do
if strText:match(tblAttr[3]) then -- Only include Report in Result Set
if TblOption[tblAttr[1]] == "ON" then -- if its tick box Option is "ON"
table.insert(tblRepName,TblGrid.RepName[intText])
table.insert(tblRepItem,TblGrid.RepItem[intText])
table.insert(tblRepText,TblGrid.RepText[intText])
end
break
end
end
end
if tblRepText and #tblRepText > 0 then -- Output Exception Report Result Set data
fhOutputResultSetTitles(iup_gui.Plugin..iup_gui.Version.."Exceptions Report")
fhOutputResultSetColumn("Individual / Family / Fact / Media Item" ,"text",tblRepName,#tblRepText,200,"align_left",0)
fhOutputResultSetColumn("Individual / Family / Fact / Media Buddy" ,"item",tblRepItem,#tblRepText,200,"align_left",0,true,"default","buddy") -- V1.5 addition
fhOutputResultSetColumn("Exception Report Detailed Explanation" ,"text",tblRepText,#tblRepText,380,"align_left",1)
end
return iup.CLOSE
end -- function btnDestroy:action
function tabControl:tabchangepos_cb(intNew,intOld) -- Call back when Main tab position is changed
IntTabPosn = intNew + 1 -- 3 Aug 2013
saveOptions() -- V1.7 Save options
if intOld == 2 then
ShowStatistics(TblGrid) -- V1.7 Update display in case Options changed
lblReports.Title = strExceptionReports() -- V2.4
end
end -- function tabControl:tabchangepos_cb
iup_gui.ShowDialogue("Main",dialogMain,btnDestroy,"map") -- Map needed to honour setting tabControl.ValuePos within iup_gui.AssignAttributes
iup_gui.AssignAttributes(tblControls) -- Assign GUI control attributes
ShowStatistics(TblGrid) -- Display the statistics grids, and show fixed size dialogue, and optionally Version History Help
iup_gui.ShowDialogue("Main")
TblData.WwD = {} -- Clear Work with Data dictionary of names used -- V2.0
end -- function GUI_MainDialogue
function ExceptionReport(ptrName,ptrItem,strText) -- Update Result Set Exception Report data
table.insert(TblGrid.RepName,fhGetDisplayText(ptrName)) -- Individual/Family Couple/Fact Item display name for V1.7
table.insert(TblGrid.RepItem,ptrItem:Clone()) -- Individual/Family Couple/Fact Item buddy pointer for V1.5
table.insert(TblGrid.RepText,strText) -- Exception Report Text
local strRef = ""
local intRec = 0 -- Avoid debug mode printing "is Invalid" for Unused Flags with null ptrItem
if ptrItem:IsNotNull() then strRef, intRec = general.BuildDataRef(ptrItem) end -- Convert the Item pointer to Data Ref & Record Id
table.insert(TblGrid.DataRef,strRef) -- because userdata pointers cannot be saved to file
table.insert(TblGrid.RecIdNo,intRec)
end -- function ExceptionReport
function TidyTitle(strTitle) -- Tidy title -- V2.0
strTitle = strTitle:gsub("^ *(.-) *$","%1") -- Remove leading & trailing spaces
strTitle = strTitle:replace("-\n","") -- Remove hyphen newline
strTitle = strTitle:replace("\n"," ") -- Replace newline with space
return strTitle
end -- function TidyTitle
function ResetGridCells(tblGrid) -- Reset each Grid and empty the cells
for strGrid, strBase in pairs (tblGrid.Base) do -- Loop through all grid cells -- V2.0
local tblGrd = tblGrid[strBase] -- V1.8 made local
for intRow, strRow in ipairs (tblGrd.Row) do
strRow = TidyTitle(strRow)
tblGrd.Row[strRow] = intRow -- Row lookup dictionary using tidied title -- V1.8 -- V2.0
tblGrd[intRow] = {}
for intCol, strCol in ipairs (tblGrd.Col) do
if intRow == 1 then
strCol = TidyTitle(strCol)
tblGrd.Col[strCol] = intCol -- Col lookup dictionary using tidied title -- V1.8 -- V2.0
if tblGrd.WwD then tblGrd.WwD[strCol] = {} end -- Empty Work with Data dictionary of names used -- V2.0
end
tblGrd[intRow][intCol] = nil -- Empty all grid cells
end
end
tblGrd.Err = nil -- Clear all error colours
end
TblIndivid.Flag = {} -- Clear internal Flag statistics -- V2.0
TblIndivid.Pool = {} -- Clear internal Pool statistics -- V2.0
TblFlags.Living = nil -- Clear Living Flag exception signal -- V2.0
tblGrid.RepName = {} -- Added V1.6 correction for 'buddy' pointers
tblGrid.RepItem = {}
tblGrid.RepText = {} -- Clear the Result Set Exception Report data
tblGrid.DataRef = {}
tblGrid.RecIdNo = {}
ShowStatistics(tblGrid)
end -- function ResetGridCells
function ShowStatistics(tblGrid) -- Display each Grid in each GUI Matrix
for strGrid, strBase in pairs (tblGrid.Base) do -- Loop through all grid cells -- V2.0
local tblGrd = tblGrid[strBase]
if tblGrd.Mat then
for intRow, strRow in ipairs (tblGrd.Row) do
for intCol, strCol in ipairs (tblGrd.Col) do
local strBak = iup_gui.Smoke -- Empty cell background colour
local strErr = nil -- Empty cell foreground colour
local strVal = nil -- Empty cell nil value
if tblGrd[intRow] and tblGrd[intRow][intCol] then
strBak = iup_gui.White -- Data cell background colour
strVal = tblGrd[intRow][intCol] -- Data cell statistic value
if tblGrd.Err and tblGrd.Err[intRow] and tblGrd.Err[intRow][intCol] then
local intMark = tblGrd.Err[intRow][intCol]["Mark"] or 0 -- Quantity of all exception reports -- V1.7
for strName, intName in pairs ( tblGrd.Err[intRow][intCol] ) do
if TblOption[strName] == "OFF" then
intMark = intMark - intName -- Subtract quantity for disabled reports -- V1.7
end
end
if intMark > 0 then strErr = iup_gui.Risk end -- Data cell foreground error colour
end
end
tblGrd.Mat["bgcolor"..intRow..":"..intCol] = strBak
tblGrd.Mat["fgcolor"..intRow..":"..intCol] = strErr
tblGrd.Mat:setcell(intRow,intCol,strVal)
end
end
tblGrd.Mat.redraw = "ALL"
end
end
iup_gui.RefreshDialogue("Main") -- V1.8 -- V2.0 -- Resizes window for large Flag names
end -- function ShowStatistics
function MarkCell(tblGrd,anyRow,anyCol,strOpt) -- Mark the single Cell to signal exception
local intRow = anyRow
local strRow = anyRow
local intCol = anyCol
local strCol = anyCol
if not tonumber(anyRow) then intRow = tblGrd.Row[strRow] end -- If Row not numeric then assume Row Name
if not tonumber(anyCol) then intCol = tblGrd.Col[strCol] end -- If Col not numeric then assume Col Name
for _, intRow in ipairs ({ intRow; tblGrd.Row["All"]; }) do -- Repeat for chosen cell and "All" row cell -- V2.0
if not tblGrd.Err then tblGrd.Err = {} end
if not tblGrd.Err[intRow] then tblGrd.Err[intRow] = {} end
if not tblGrd.Err[intRow][intCol] then tblGrd.Err[intRow][intCol] = {} end
local tblError = tblGrd.Err[intRow][intCol]
tblError["Mark"] = ( tblError["Mark"] or 0 ) + 1 -- Quantity of marked exception reports -- V1.7
tblError[strOpt] = ( tblError[strOpt] or 0 ) + 1 -- Quantity to hide if Option is chosen -- V1.7
end
return TblAttrib[TblAttrib[strOpt]][3] -- Return the Exception Report Detailed Explanation text
end -- function MarkCell
function GetCell(tblGrd,strRow,strCol) -- Get the value of a single Cell
return tblGrd[tblGrd.Row[strRow]][tblGrd.Col[strCol]] or 0
end -- function GetCell
function SetCell(tblGrd,strRow,strCol,strVal) -- Set the value of a single Cell
tblGrd[tblGrd.Row[strRow]][tblGrd.Col[strCol]] = strVal
end -- function SetCell
function UpdateCount(tblGrd,strRow,strCol,intAdd,isAll) -- Update the Count of a single Cell and often the "All" cell above
local intRow = tblGrd.Row[strRow] or 0 -- !
local intCol = tblGrd.Col[strCol] or 0 -- !
tblGrd[intRow][intCol] = ( tblGrd[intRow][intCol] or 0 ) + ( intAdd or 1 ) -- Update single cell -- V2.0
intRow = tblGrd.Row["All"]
if intRow and ( #tblGrd.Col > 1 or isAll ) then -- Row "All" exists, and more than one column or "All" is forced
tblGrd[intRow][intCol] = ( tblGrd[intRow][intCol] or 0 ) + ( intAdd or 1 ) -- Update "All" cell -- V2.0
end
end -- function UpdateCount
function CheckDayNumber(ptrRef,ptrDat,datDat,tblGrd,intRow) -- Check Day Number -- V2.0
local dptDat1 = datDat:GetDatePt1()
local intDay1 = fhCallBuiltInFunction("DayNumber",dptDat1) -- Check 1st Date Point
local dptDat2 = datDat:GetDatePt2()
local intDay2 = 0
if not dptDat2:IsNull() then
intDay2 = fhCallBuiltInFunction("DayNumber",dptDat2) -- Check 2nd Date Point if any
end
if not (intDay1 and intDay2) then -- Report a Date without a Day Number -- V2.0
local strWarn = "DateNoDayNumber"
if ptrRef:IsSame(ptrDat) then
strWarn = TblAttrib[TblAttrib[strWarn]][3] -- Media Date or Source Data Event Date only needs a warning
else
strWarn = MarkCell(tblGrd,intRow,tblGrd.Col["Date"],strWarn) -- Fact/Citation Date needs cell marked too
end
ExceptionReport(ptrRef,ptrDat,strWarn)
end
end -- function CheckDayNumber
function UpdateDate(tblGrd,datDat,strRow,strMin,strMax,ptrRef,strOpt,ptrDat) -- Update the Oldest/Latest Update & Earliest/Latest Date cells & check for Date warnings
if not datDat:IsNull() then
local dptDat = datDat:GetDatePt1() -- Use Date Point Compare -- V2.0
local strDat = datDat:GetDisplayText("ABBREV") -- V2.0
local intRow = tblGrd.Row[strRow]
local intMin = tblGrd.Col[strMin]
local intMax = tblGrd.Col[strMax]
if intMin ~= intMax then -- Oldest/Earliest & Latest Date cells
local datMin = fhNewDate(9999) -- Minimum Date
local datMax = fhNewDate(0001) -- Maximum date
for _, intRow in ipairs ({ intRow; tblGrd.Row["All"]; }) do -- Repeat for chosen cell and "All" row cell -- V2.0
datMin:SetValueAsText(tblGrd[intRow][intMin] or "9999",true)
if dptDat:Compare(datMin:GetDatePt1()) < 0 then -- Use Date Point Compare -- V2.0
tblGrd[intRow][intMin] = strDat -- Set minimum Date so far
end
datMax:SetValueAsText(tblGrd[intRow][intMax] or "0001",true)
if dptDat:Compare(datMax:GetDatePt1()) > 0 then -- Use Date Point Compare -- V2.0
tblGrd[intRow][intMax] = strDat -- Set maximum Date so far
end
end
end
if ptrRef and dptDat:Compare(DptMinimum) < 0 then -- Report a Fact Date/Citation Entry Date found before earliest year
ExceptionReport(ptrRef,ptrDat, -- V1.7 & V1.6 ptrDat was ptrRef
MarkCell(tblGrd,intRow,intMin,strOpt.."DateTooOld")..strDat)
end
if ptrRef and dptDat:Compare(DptToday) > 0 then -- Report a Fact Date/Citation Entry Date found in the future
ExceptionReport(ptrRef,ptrDat, -- V1.7 & V1.6 ptrDat was ptrRef
MarkCell(tblGrd,intRow,intMax,strOpt.."DateFuture")..strDat)
end
if ptrDat and TblOption.DateWarning == "ON" then -- Check for Date warnings -- V1.7 tglWarnings
local strWarn = fhCallBuiltInFunction("GetDataWarning",ptrDat,1)
if strWarn ~= "" then
local intCol = intMin
if intMin ~= intMax then intCol = tblGrd.Col["Date"] end -- V2.0
if strWarn:match("^Date range ") then
MarkCell(tblGrd,intRow,intCol,"FactDateRanges") -- Report a Fact Date Range warning
strWarn = "Fact "..strWarn
elseif strWarn:match("^Period ") then
MarkCell(tblGrd,intRow,intCol,"FactDatePeriod") -- Report a Fact Date Period warning
strWarn = strWarn:gsub("^Period ","Fact Date period ")
elseif strWarn:match("^Date is ") then
MarkCell(tblGrd,intRow,intCol,"FactDateSimple") -- Report a Fact simple Date warning
strWarn = "Fact "..strWarn
else
MarkCell(tblGrd,intRow,intCol,strOpt.."DateFormat") -- Report a Fact Date/Citation Entry Date not valid
if strOpt == "Cite" then strOpt = "Citation Entry" end
strWarn = strOpt.." Date : "..strWarn
end
ExceptionReport(ptrRef,ptrDat,strWarn) -- V1.7 & V1.6 ptrDat was ptrRef
end
if not strWarn:match("is not a valid day number") then -- Avoid duplicated reports for invalid Date
CheckDayNumber(ptrRef,ptrDat,datDat,tblGrd,intRow) -- Check Day Number -- V2.0
end
end
end
end -- function UpdateDate
function ReportAge(tblGrd,intAge,intRow,intVal,strOpt,ptrRef,ptrVal) -- Report Age Exception -- V2.0
local strAge = tostring(intAge).." yrs"
if not ptrRef:IsSame(ptrVal) then
strAge = fhGetValueAsText(ptrVal) -- Use actual Age text
end
ExceptionReport(ptrRef,ptrVal,
MarkCell(tblGrd,intRow,intVal,strOpt)..strAge) -- V1.7
end -- function ReportAge
function UpdateAge(tblGrd,intAge,strRow,strNum,strMin,strAve,strMax,ptrRef,ptrVal) -- Update the Age cells statistics V1.7 added ptrVal
if intAge then
local intRow = tblGrd.Row[strRow]
local intNum = tblGrd.Col[strNum]
local intAve = tblGrd.Col[strAve]
local intMin = tblGrd.Col[strMin]
local intMax = tblGrd.Col[strMax]
if intAge < 0 then -- Report negative Fact Age
intAge = intAge - 1 -- Bug fix for AgeAt getting -ve Ages wrong !!!!!!!!!!!!!!!!!!???????
ReportAge(tblGrd,intAge,intRow,intMin,"FactAgeNegative",ptrRef,ptrVal) -- V2.0
elseif intAge > TblOption.MaximumAges then -- Report too large Fact Age
ReportAge(tblGrd,intAge,intRow,intMax,"FactAgeTooLarge",ptrRef,ptrVal) -- V2.0
elseif intAge > 0 and strRow == "Birth" then -- Report too large Birth Age -- V2.0
ReportAge(tblGrd,intAge,intRow,intNum,"FactAgeTooLarge",ptrRef,ptrVal) -- V2.0
end
tblGrd[intRow][intAve] = ( tblGrd[intRow][intAve] or 0 ) + intAge -- Accumulate value of Ages for averaging later
intAge = math.floor(intAge + 0.5) -- V2.0 -- Absolute integer value
for _, intRow in ipairs ({ intRow; tblGrd.Row["All"]; }) do -- Repeat for chosen cell and "All" row cell -- V2.0
tblGrd[intRow][intNum] = ( tblGrd[intRow][intNum] or 0 ) + 1 -- Increment count of Ages detected, and set min & max
tblGrd[intRow][intMin] = math.min( ( tblGrd[intRow][intMin] or 999 ), intAge )
tblGrd[intRow][intMax] = math.max( ( tblGrd[intRow][intMax] or 000 ), intAge )
end
end
end -- function UpdateAge
function UpdateWorkWithData(strCol,anyDat) -- Count each new Work with Data value, etc -- V2.0
local tblGrd = TblData
local strDat = anyDat
if type(anyDat) == "userdata" then -- Data string, or Data pointer (userdata)
strDat = fhGetValueAsText(anyDat)
end
if #strDat > 0 and not tblGrd.WwD[strCol][strDat] then -- Has this value already been found?
tblGrd.WwD[strCol][strDat] = true
UpdateCount(tblGrd,"Totals",strCol) -- No, it is a new value to be counted -- V2.0
end
end -- function UpdateWorkWithData
function UpdateList(tblList,anyLeaf) -- Update a Pool/Flag list leaf
local intLeaf = anyLeaf
local strLeaf = anyLeaf
if tonumber(anyLeaf) then -- Numeric leaf is Pool number in leaf order
strLeaf = "Pool "..intLeaf
tblList[intLeaf] = strLeaf
else -- Otherwise create new Flag leaf name to be sorted later
strLeaf = strLeaf:gsub("^All$"," All") -- Ensure the Flag "All" is distinct from row "All" -- V2.0
if not tblList[strLeaf] then
table.insert(tblList,strLeaf)
end
end
tblList[strLeaf] = ( tblList[strLeaf] or 0 ) + 1 -- Increment leaf count
end -- function UpdateList
function SetGridLastRow(tblGrd) -- Set a Grid new last Row
local intRow = #tblGrd.Row -- Row number
local strRow = tblGrd.Row[intRow] -- Row heading
if not tblGrd[intRow] then tblGrd[intRow] = {} end -- Row of cells
tblGrd.Row[strRow] = intRow -- Row lookup dictionary entry
if tblGrd.Mat then
tblGrd.Mat.numlin = intRow -- Matrix control adjustments
tblGrd.Mat.numlin_visible = intRow
-- # tblGrd.Mat["RasterHeight"..intRow] = IntRowHeight
tblGrd.Mat["Height"..intRow] = IntRowHeight -- V2.4
tblGrd.Mat:setcell( intRow, 0, strRow )
end
end -- function SetGridLastRow
function RevealList(tblGrid,tblGrd,tblList,strFlag) -- Display list of Pools/Flags
local intTopRow = tblGrd.Top -- Top row number in Grid for Pools/Flags list
local intMaxRow = tblGrid.MaxRows -- Max row number in Grid
for intRow = intTopRow, intMaxRow do
local strRow = tblGrd.Row[intRow] -- Clear the Pool/Flag grid cells
if tblGrd.Row[strRow] then
tblGrd.Row[strRow] = nil
tblGrd.Row[intRow] = nil
end
end
SetGridLastRow(tblGrd)
intTopRow = intTopRow - 1 -- Row number in Grid above Pools/Flags list
if #tblList > 0 then
local intMiddle = intMaxRow + 1
local intSpaces = intMaxRow - intTopRow -- Spaces provided for Pools/Flags
local intExcess = #tblList - intSpaces -- Excess quantity of Pools/Flags
if intExcess > 0 then
intMiddle = math.ceil( ( intSpaces + 1 ) / 2 ) + intTopRow -- Middle row to accumulate excess Pools/Flags
end
local intOthers = intMaxRow - intMiddle -- Others value to identify excess Pools/Flags
local strMiddle
local isPool = tblList[1]:match("Pool") -- V2.0
if isPool then
strMiddle = "Pool "..intMiddle-intTopRow.." - "..#tblList-intOthers -- Middle Pool row name is "Pool 3 - 99"
else
strMiddle = tostring(intExcess + 1).." other Flags" -- Middle Flag row name is "99 other Flags"
end
for intLeaf = 1, #tblList do
local strName = tblList[intLeaf] -- Pool/Flag name
local intName = tblList[strName] -- Pool/Flag count
local intRow = intTopRow + intLeaf -- Row number
if intRow >= intMiddle then
intRow = intRow - intExcess -- Reduce row by Excess once past Middle row
if #tblList - intLeaf >= intOthers then
intRow = intMiddle -- Middle row accumulates all other Pools/Flags
strName = strMiddle
end
end
if tblGrd.Row[intRow] ~= strName then
tblGrd.Row[intRow] = strName -- Make new Pool/Flag name row
tblGrd.Row[intRow+1] = nil
SetGridLastRow(tblGrd)
end
UpdateCount(tblGrd,strName,"Count",intName,(not isPool)) -- Increment Pool/Flag statistics -- V2.0
if strName == strFlag then
MarkCell(tblGrd,strName,"Count","LivingFlagDeath") -- Mark exception for Flag name (Living Flag despite Death/Burial/Cremation Event)
end
end
end
end -- function RevealList
function UpdateAddress(ptrRef) -- Count each Work with Data Address value (ADDR) -- V2.0
UpdateWorkWithData("Addresses",ptrRef)
end -- function UpdateAddress
function UpdateMedia(ptrRef,tblGrd,strRow) -- Count the Media links (OBJE) -- V2.0
local ptrObj = fhGetValueAsLink(ptrRef)
local intRid = fhGetRecordId(ptrObj)
UpdateCount(tblGrd,strRow,"Media")
ptrRef:MoveToFirstChildItem(ptrRef)
while ptrRef:IsNotNull() do
if fhGetTag(ptrRef) == "_AREA" then -- Save _AREA dimensions for later CheckMedia(...) function -- V2.3
if not TblObjArea[intRid] then
TblObjArea[intRid] = {}
end
table.insert(TblObjArea[intRid],{ Link=ptrRef:Clone(); Area=fhGetValueAsText(ptrRef); })
end
ptrRef:MoveNext()
end
end -- function UpdateMedia
function UpdateLMO(ptrRef,tblGrd,strRow) -- Handle the Local Media (OBJE2) -- V2.0
UpdateCount(tblGrd,strRow,"Media")
CheckMedia(ptrRef,tblGrd,strRow,"Media") -- Check media Format versus File type, etc -- V1.8
end -- function UpdateLMO
function UpdateCustomId(ptrRef,tblGrd,strRow) -- Count the Custom Idents (REFN)
UpdateCount(tblGrd,strRow,"Idents")
end -- function UpdateCustomId
function UpdatePermRecNo(ptrRef,tblGrd,strRow,ptrRec) -- Handle Permanent Rec Nos (RFN)
UpdateCount(tblGrd,strRow,"Idents")
ExceptionReport(ptrRec,ptrRef,
MarkCell(tblGrd,strRow,"Idents","IdentPermRecNo")..fhGetValueAsText(ptrRef))
end -- function UpdatePermRecNo
function UpdateAutoRecId(ptrRef,tblGrd,strRow,ptrRec) -- Handle Automatic Rec Ids (RIN)
UpdateCount(tblGrd,strRow,"Idents")
ExceptionReport(ptrRec,ptrRef,
MarkCell(tblGrd,strRow,"Idents","IdentAutoRecId")..fhGetValueAsText(ptrRef))
end -- function UpdateAutoRecId
function FindCitations(ptrOld,tblGrd,strRow) -- Find Source Citations on Notes, etc
local ptrRef = fhNewItemPtr() -- Loop through each tag
ptrRef:MoveToFirstChildItem(ptrOld)
while ptrRef:IsNotNull() do
local strTag = fhGetTag(ptrRef)
if strTag == "SOUR" then -- Found a Source Citation (SOUR)
FoundCitation(ptrRef,tblGrd,strRow)
elseif strTag == "SOUR2" then -- Found a Source Note (SOUR2)
FindAnyNotes(ptrRef,tblGrd,strRow)
end
ptrRef:MoveNext()
end
end -- function FindCitations
function FindAnyNotes(ptrOld,tblGrd,strRow) -- Find any local Note or Note record link
local ptrRef = fhNewItemPtr() -- Loop through each tag
ptrRef:MoveToFirstChildItem(ptrOld)
while ptrRef:IsNotNull() do
if fhGetTag(ptrRef):match("^NOTE") then -- Found a Note (NOTE,NOTE2)
FindCitations(ptrRef,tblGrd,strRow)
end
ptrRef:MoveNext()
end
end -- function FindAnyNotes
function DuplicatedBMD(ptrRef,tblGrd,strRow,dicBMD) -- Report duplicated BMD events -- V2.9
local strTag = fhGetTag(ptrRef)
dicBMD[strTag] = (dicBMD[strTag] or 0) + 1
if dicBMD[strTag] > 1 then
ExceptionReport(ptrRef,ptrRef,
MarkCell(tblGrd,strRow,"Count","DuplicatedBMD")..strRow)
end
end -- function DuplicatedBMD
function FoundCitationPrototype() -- Process any Citation (SOUR)
local function doDataDate(ptrRef,tblGrd,strRow) -- Process Entry Date (DATA.DATE)
local ptrDat = fhGetItemPtr(ptrRef,"~.DATE")
if ptrDat:IsNotNull() then
local datDat = fhGetValueAsDate(ptrDat)
UpdateDate(tblGrd,datDat,strRow,"Cites","Cites",ptrDat,"Cite",ptrDat) -- Check any Citation Entry Date
end
end -- local function doDataDate
local dicWhat = -- Tag actions invoked by FoundCitation()
{
DATA = doDataDate ;
NOTE = FindCitations ;
NOTE2 = FindCitations ;
OBJE = UpdateMedia ;
OBJE2 = UpdateLMO ;
}
local function FoundCitation(ptrOld,tblGrd,strRow) -- Process any Citation (SOUR)
local ptrRef = fhNewItemPtr() -- Loop through each tag
ptrRef:MoveToFirstChildItem(ptrOld)
while ptrRef:IsNotNull() do
local action = dicWhat[fhGetTag(ptrRef)] or CheckIsUDF -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow) -- Protect ptrRef against change by action -- V2.5
ptrRef:MoveNext()
end
UpdateCount(tblGrd,strRow,"Cites") -- Count each Citation
end -- local function FoundCitation
return FoundCitation
end -- function FoundCitationPrototype
function CheckIsUDF(ptrRef,tblGrd,strRow) -- Check if tag is a UDF
if fhIsUDF(ptrRef) then
ExceptionReport(ptrRef,ptrRef,
MarkCell(tblGrd,strRow,"Count","UncatDataField"))
end
end -- function CheckIsUDF
function CheckIsFact(ptrRef,tblGrd,strRow,...) -- Check if tag is a Fact
if fhIsFact(ptrRef) then
UpdateFact(ptrRef,TblFacts,"All Other",...)
else
CheckIsUDF(ptrRef,tblGrd,strRow)
end
end -- function CheckIsFact
function UpdateFactPrototype() -- Analyse Fact (Event & Attribute) Prototype
local datDat = fhNewDate() -- Fact Date value
local function doDate(ptrRef,tblGrd,strRow,ptrOld) -- Process each Fact Date (DATE)
datDat = fhGetValueAsDate(ptrRef) -- datDat is also used by Age At Date below
UpdateDate(tblGrd,datDat,strRow,"Earliest Fact Date","Latest Fact Date",ptrOld,"Fact",ptrRef)
UpdateCount(tblGrd,strRow,"Date") -- Count each Date
end -- local function doDate
local function doSortDate(ptrRef,tblGrd,strRow,ptrOld) -- Process each Fact Sort Date (_SDATE) -- V2.9
local datDat = fhGetValueAsDate(ptrRef)
UpdateDate(tblGrd,datDat,strRow,"Earliest Fact Date","Latest Fact Date",ptrOld,"Fact",ptrRef)
end -- local function doSortDate
local function doAge(ptrRef,tblGrd,strRow,ptrOld) -- Process each Fact Age (AGE)
local strAge = fhGetValueAsText(ptrRef) -- Obtain the Age in days, months, years -- V2.0
local intDay = (tonumber(strAge:match("([0-9]*) dy")) or 0) / 365
local intMon = (tonumber(strAge:match("([0-9]*) mn")) or 0) / 12
local intAge = (tonumber(strAge:match("([0-9]*) yr")) or 0) -- V2.0
intAge = intAge + intMon + intDay -- Age in years with months & days as fractions -- V2.0
UpdateAge(tblGrd,intAge,strRow,"Age","Min.","Ave.","Max.",ptrOld,ptrRef)
end -- local function doAge
local function doSpouse(ptrRef,tblGrd,strRow,ptrOld) -- Process each Fact Spouse (HUSB,WIFE) -- V2.0
local ptrAge = fhGetItemPtr(ptrRef,"~.AGE")
if ptrAge:IsNotNull() then
doAge(ptrAge,tblGrd,strRow,ptrOld)
end
end -- local function doSpouse
local function doPlace(ptrRef,tblGrd,strRow) -- Process each Fact Place (PLAC,_PLAC) -- V2.0
UpdateCount(tblGrd,strRow,"Place") -- Count any Place fields
UpdateWorkWithData("Places",ptrRef) -- Count each Work with Data Place value -- V2.0
FindAnyNotes(ptrRef,tblGrd,strRow)
FindCitations(ptrRef,tblGrd,strRow)
end -- local function doPlace
local function doAddress(ptrRef,tblGrd,strRow) -- Process each Fact Address (ADDR) -- V2.0
UpdateCount(tblGrd,strRow,"Addr") -- Count any Address fields
UpdateWorkWithData("Addresses",ptrRef) -- Count each Work with Data Address value -- V2.0
end -- local function doAddress
local function doFamily(ptrRef) -- Report Event Link to Parents Family Record (FAMC) -- V2.0
ExceptionReport(ptrRef,ptrRef,
TblAttrib[TblAttrib["EventLinkFamily"]][3])
end -- local function doFamily
local dicWhat = -- Tag actions invoked by UpdateFact() statistics
{
DATE = doDate ;
_SDATE= doSortDate ; -- Sort Date -- V2.9
AGE = doAge ;
HUSB = doSpouse ;
WIFE = doSpouse ;
PLAC = doPlace ;
_PLAC = doPlace ;
ADDR = doAddress ;
FAMC = doFamily ;
_SHAN = FindCitations ;
_SHAR = FindCitations ;
NOTE = FindCitations ;
NOTE2 = FindCitations ;
OBJE = UpdateMedia ;
OBJE2 = UpdateLMO ;
SOUR = FoundCitation ;
SOUR2 = FindAnyNotes ;
}
local function UpdateFact(ptrOld,tblGrd,strRow,ptrRec,...)
local arg = {...}
datDat = fhNewDate()
local ptrRef = fhNewItemPtr() -- Reference pointer
ptrRef:MoveToFirstChildItem(ptrOld) -- Loop through each tag
while ptrRef:IsNotNull() do
local action = dicWhat[fhGetTag(ptrRef)] or CheckIsUDF -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow,ptrOld) -- Protect ptrRef against change by action -- V2.5
ptrRef:MoveNext()
end
UpdateCount(tblGrd,strRow,"Count") -- Count each Fact, Name & Ordinance, and "All"
UpdateWorkWithData("Fact Types",fhGetTag(ptrOld)) -- Count each Fact Type, NAME & Ordinance -- V2.0
if not datDat:IsNull() and strRow ~= "Birth" then -- Omit Age At Birth as always 0 -- V2.0
for _, ptrInd in ipairs (arg) do -- Either Individual or Family Husband & Wife
if ptrInd:IsNotNull() then -- Obtain Age At Fact Date
local intAge = fhCallBuiltInFunction("AgeAt",ptrInd,datDat:GetDatePt1())
UpdateAge(tblGrd,intAge,strRow,"Age@","Min@","Ave@","Max@",ptrOld,ptrOld)
end
end
end
end -- local function UpdateFact
return UpdateFact
end -- function UpdateFactPrototype
function IndividRecordPrototype() -- Analyse Individual Record Prototype (INDI) -- V2.0
local ptrLiving = false -- Pointer to Living Flag -- V2.0
local intParents = 0 -- Parental checks -- V2.0
local function doRecordFlags(ptrRef,tblGrd) -- Loop through each Record Flag (_FLGS)
ptrRef:MoveToFirstChildItem(ptrRef)
while ptrRef:IsNotNull() do
local strFlag = fhGetDisplayText(ptrRef,"~","STD"):gsub(": Y","")
if strFlag == "Living" then ptrLiving = ptrRef:Clone() end -- Point to Living Flag -- V2.0
UpdateList(tblGrd.Flag,strFlag) -- Update list of Flags -- V2.0
ptrRef:MoveNext("ANY")
end
end -- local function doRecordFlags
local function doAssocPerson(...) -- Check Associated Person (ASSO)
FindAnyNotes(...)
FindCitations(...)
end -- local function doAssocPerson
local arrParent = { "~.HUSB[1]>"; "~.WIFE[1]>"; "~.HUSB[2]>"; "~.WIFE[2]>"; } -- Used by Parent Family statistics
local function doParentFamily(ptrRef,tblGrd,strRow) -- Check Parent Family link (FAMC)
FindAnyNotes(ptrRef,tblGrd,strRow) -- Check any Notes for Source Citations -- V2.0
local ptrFam = fhGetValueAsLink(ptrRef)
for _, strRef in ipairs (arrParent) do -- Loop through the Parents
if fhGetItemPtr(ptrFam,strRef):IsNotNull() then
intParents = intParents + 1 -- Parent found
break
end
end
end -- local function doParentFamily
local dicWhat = -- Tag actions invoked by IndividRecord() statistics
{ -- Tag Action function Grid Table Row Title BMD / WwD ifBorn/ifDied
NAME = { Act=UpdateFact ; Grd=TblFacts ; Row="Names" ; };
BIRT = { Act=UpdateFact ; Grd=TblFacts ; Row="Birth" ; BMD=true ; Born=true ; };
BAPM = { Act=UpdateFact ; Grd=TblFacts ; Row="Baptism" ; BMD=true ; Born=true ; };
CHR = { Act=UpdateFact ; Grd=TblFacts ; Row="Christening" ; BMD=true ; Born=true ; };
CHRA = { Act=UpdateFact ; Grd=TblFacts ; Row="Christening" ; };
ADOP = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; };
CENS = { Act=UpdateFact ; Grd=TblFacts ; Row="Census" ; };
OCCU = { Act=UpdateFact ; Grd=TblFacts ; Row="Occupation" ; WwD="Occupations" ; }; -- Used by Count the Work with Data Attributes
RESI = { Act=UpdateFact ; Grd=TblFacts ; Row="Residence" ; };
DEAT = { Act=UpdateFact ; Grd=TblFacts ; Row="Death" ; BMD=true ; Died=true ; };
BURI = { Act=UpdateFact ; Grd=TblFacts ; Row="Burial" ; BMD=true ; Died=true ; };
CREM = { Act=UpdateFact ; Grd=TblFacts ; Row="Cremation" ; BMD=true ; Died=true ; };
BAPL = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; };
CONL = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; };
ENDL = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; };
SLGC = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; };
RELI = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Religions" ; }; -- Used by Count the Work with Data Attributes
CAST = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Groups Castes" ; };
NATI = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="National Origins" ; };
EDUC = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Education Contexts"; };
DSCR = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Physical Desc." ; };
PROP = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Possessions" ; };
TITL = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="Titles" ; };
IDNO = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="National Id. Nos." ; };
SSN = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other" ; WwD="US Soc. Sec. Nos." ; };
_FLGS = { Act=doRecordFlags ; Grd=TblIndivid ; };
ASSO = { Act=doAssocPerson ; };
FAMC = { Act=doParentFamily ; };
FAMS = { Act=FindAnyNotes ; };
NOTE = { Act=FindCitations ; };
NOTE2 = { Act=FindCitations ; };
OBJE = { Act=UpdateMedia ; };
OBJE2 = { Act=UpdateLMO ; };
SOUR = { Act=FoundCitation ; };
SOUR2 = { Act=FindAnyNotes ; };
REFN = { Act=UpdateCustomId ; };
RFN = { Act=UpdatePermRecNo; };
RIN = { Act=UpdateAutoRecId; };
CHAN = { Act=FindAnyNotes ; };
}
local function IndividRecord(ptrRec,tblGrd,strRow,tblGrid) -- Analyse Individual Record (INDI) -- V2.0
ptrLiving = false
intParents = 0 -- Parental checks -- V2.0
local dicBMD = {} -- Counts of BMD events -- V2.9
local ifBorn = false
local ifDied = false
local ptrRef = fhNewItemPtr() -- Reference pointer
ptrRef:MoveToFirstChildItem(ptrRec) -- Loop through each tag
while ptrRef:IsNotNull() do
local dicWhat = dicWhat[fhGetTag(ptrRef)] or { }
local strRow = dicWhat.Row or strRow
local tblGrd = dicWhat.Grd or tblGrd
local action = dicWhat.Act or CheckIsFact -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow,ptrRec,ptrRec) -- Protect ptrRef against change by action -- V2.5
local strWwD = dicWhat.WwD
if strWwD then UpdateWorkWithData(strWwD,ptrRef) end -- Count each Work with Data Attribute value -- V2.0
if dicWhat.BMD then DuplicatedBMD(ptrRef,tblGrd,strRow,dicBMD) end -- Report duplicated BMD events -- V2.9
ifBorn = ifBorn or dicWhat.Born -- Person born? -- V2.0
ifDied = ifDied or dicWhat.Died -- Person died? -- V2.0
ptrRef:MoveNext()
end
tblGrd = TblIndivid -- V2.0
local strSex = fhGetDisplayText(ptrRec,"~.SEX","MIN") -- Count number of each Gender
if strSex == "" then
strSex = "Unknown"
ExceptionReport(ptrRec,ptrRec,
MarkCell(tblGrd,"Unknown","Count","GenderIndividual")) -- Report undefined or Unknown Gender
end
UpdateCount(tblGrd,strSex,"Count") -- Count each Gender
if not ifBorn then -- V2.0
UpdateCount(tblGrd,"No Birth","Count") -- Update the No Birth/Baptism/Christening count
ExceptionReport(ptrRec,ptrRec,
MarkCell(tblGrd,"No Birth","Count","NoBirthBaptism"))
end
if ptrLiving and ifDied then -- V2.0
TblFlags.Living = "Living" -- Report a Living Flag despite Death/Burial/Cremation Event -- V2.0
ExceptionReport(ptrRec,ptrLiving,
TblAttrib[TblAttrib["LivingFlagDeath"]][3])
elseif not ( ptrLiving or ifDied ) then -- V2.0
UpdateCount(tblGrd,"No Death","Count") -- Update the No Death/Burial/Cremation count, unless Living Flag
ExceptionReport(ptrRec,ptrRec,
MarkCell(tblGrd,"No Death","Count","NoDeathBuryFlag"))
end
if intParents == 0 then
UpdateCount(tblGrd,"Parentless","Count") -- Update the Parentless count -- V2.0
elseif intParents > 1 then
UpdateCount(tblGrd,"Many Parents","Count") -- Update the Many Parents count -- V2.0
end
local intPool = fhCallBuiltInFunction("RelationPool",ptrRec) -- Count number in each Relation Pool
if intPool and intPool > 0 then
UpdateList(tblGrd.Pool,intPool) -- Update list of Pools -- V2.0
end
tblGrd = TblFamily -- Count and check Spouses -- V2.0
local intMax = tblGrd.Row["Max. Spouses"]
local intCol = tblGrd.Col["Count"]
local intSpouse = 0
local tblSpouse = { }
repeat intSpouse = intSpouse + 1
ptrRef = fhGetItemPtr(ptrRec,"~.~SPOU["..intSpouse.."]>") -- Count the Spouse[*]> instances
tblSpouse[intSpouse] = ptrRef
for intSpou = 1, intSpouse-1 do
if ptrRef:IsSame(tblSpouse[intSpou]) then -- Same spouse record is duplicated
ExceptionReport(ptrRec,ptrRec,
MarkCell(tblGrd,intMax,intCol,"SpouseDuplicate"))
end
end
until ptrRef:IsNull()
intSpouse = intSpouse - 1
tblGrd[intMax][intCol] = math.max( ( tblGrd[intMax][intCol] or 0 ), intSpouse )
end -- local function IndividRecord
return IndividRecord
end -- function IndividRecordPrototype
function FamilyRecordPrototype() -- Analyse Family Record Prototype (FAM) -- V2.0
local intParent = 0
local ptrParent = fhNewItemPtr()
local intChild = 0
local ptrChild = fhNewItemPtr()
local Unmarried = false
local ptrStatus = fhNewItemPtr()
local function doHusb(ptrRef) -- Count Husbands (HUSB)
intParent = intParent + 11 -- Add 10 for Parent + 1 for Husband
ptrParent = ptrRef:Clone()
end -- local function doHusb
local function doWife(ptrRef) -- Count Wives (WIFE)
intParent = intParent + 10 -- Add 10 for Parent
ptrParent = ptrRef:Clone()
end -- local function doWife
local function doChil(ptrRef) -- Count Children (CHIL)
intChild = intChild + 1
ptrChild = ptrRef:Clone()
end -- local function doChil
local function doStat(ptrRef) -- Check Status (_STAT)
ptrStatus = ptrRef:Clone()
local strStatus = fhGetValueAsText(ptrRef)
if strStatus == "Never Married"
or strStatus == "Unmarried Couple" then
Unmarried=true
end
end -- local function doStat
-- Husband adds 1, so may be 0, or 1, or 2
-- Parent adds 10, so may be 00, or 10, or 20
-- So "No Parents" = 00, "One Parent" = 10 or 11, "Both Sex Pairs" = 21, "Same Sex Pairs" = 20 or 22
local dicCouple = { [00]="No Parents"; [10]="One Parent"; [11]="One Parent"; [20]="Same Sex Pairs"; [21]="Both Sex Pairs"; [22]="Same Sex Pairs"; } -- V2.0
local dicWhat = -- Tag actions invoked by FamilyRecord() statistics
{ -- Tag Action function Grid Table Row Title BMD
MARR = { Act=UpdateFact ; Grd=TblFacts ; Row="Marriage" ; BMD=true; };
DIV = { Act=UpdateFact ; Grd=TblFacts ; Row="Divorce" ; BMD=true; };
CENS = { Act=UpdateFact ; Grd=TblFacts ; Row="Census" ; };
SLGS = { Act=UpdateFact ; Grd=TblFacts ; Row="All Other"; };
HUSB = { Act=doHusb ; };
WIFE = { Act=doWife ; };
CHIL = { Act=doChil ; };
_STAT = { Act=doStat ; };
NOTE = { Act=FindCitations ; };
NOTE2 = { Act=FindCitations ; };
OBJE = { Act=UpdateMedia ; };
OBJE2 = { Act=UpdateLMO ; };
SOUR = { Act=FoundCitation ; };
SOUR2 = { Act=FindAnyNotes ; };
REFN = { Act=UpdateCustomId ; };
RIN = { Act=UpdateAutoRecId; };
CHAN = { Act=FindAnyNotes ; };
}
local function FamilyRecord(ptrRec,tblGrd,strRow,tblGrid) -- Analyse Family Record (FAM) -- V2.0
intParent = 0
ptrParent = fhNewItemPtr()
intChild = 0
ptrChild = fhNewItemPtr()
Unmarried = false
ptrStatus = ptrRec:Clone()
local dicBMD = {} -- Counts of BMD events -- V2.9
local ptrRef = fhNewItemPtr() -- Reference pointer
local ptrHusb = fhGetItemPtr(ptrRec,"~.HUSB>") -- Husband & Wife pointers for Age@ in UpdateFact()
local ptrWife = fhGetItemPtr(ptrRec,"~.WIFE>")
ptrRef:MoveToFirstChildItem(ptrRec) -- Loop through each tag
while ptrRef:IsNotNull() do
local dicWhat = dicWhat[fhGetTag(ptrRef)] or { }
local strRow = dicWhat.Row or strRow
local tblGrd = dicWhat.Grd or tblGrd
local action = dicWhat.Act or CheckIsFact -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow,ptrRec,ptrHusb,ptrWife) -- Protect ptrRef against change by action -- V2.5
if dicWhat.BMD then DuplicatedBMD(ptrRef,tblGrd,strRow,dicBMD) end -- Report duplicated BMD events -- V2.9
ptrRef:MoveNext()
end
tblGrd = TblFamily -- V2.0
UpdateCount(tblGrd,dicCouple[intParent],"Count") -- Update "Both Sex Pair"(21), "Same Sex Pair"(20 & 22), "No Parents"(00), "One Parent"(10 & 11) counts
if intChild == 0 then
UpdateCount(tblGrd,"Childless","Count") -- Count the Childless Families
else
UpdateCount(tblGrd,"Total Children","Count",intChild) -- Count the total Children and set Max Children per Couple
local intMax = tblGrd.Row["Max. Children"]
local intCol = tblGrd.Col["Count"]
tblGrd[intMax][intCol] = math.max( ( tblGrd[intMax][intCol] or 0 ), intChild )
end
if intParent == 00 then -- No Parents Family exceptions
if intChild == 0 then
ExceptionReport(ptrRec,ptrRec,
MarkCell(tblGrd,"No Parents","Count","NoParentNorChild"))
else
ExceptionReport(ptrRec,ptrChild, -- V1.7
MarkCell(tblGrd,"No Parents","Count","NoParentButChild"))
end
elseif intParent <= 11 and intChild == 0 then -- One Parent Family exceptions
ExceptionReport(ptrRec,ptrParent,
MarkCell(tblGrd,"One Parent","Count","OneParentNoChild"))
elseif intParent >= 20 and fhGetItemPtr(ptrRec,"~.MARR[1]"):IsNull() then
if not Unmarried then
UpdateCount(tblGrd,"No Marriage","Count") -- Update the No Marriage count, for two parent Family, unless umarried Status
ExceptionReport(ptrRec,ptrStatus,
MarkCell(tblGrd,"No Marriage","Count","NoMarriageEvent"))
end
end
end -- local function FamilyRecord
return FamilyRecord
end -- function FamilyRecordPrototype
function CheckMediaPrototype() -- Check media Format v File type, Frame Area v Image Size, Date & Keywords, and for any Note check for Citations (OBJE,OBJE2) -- V1.8 -- V2.0
local strFile = ""
local strType = ""
local strForm = ""
local ptrForm = fhNewItemPtr()
local _
local function doForm(ptrRef) -- Process each Media Format (FORM) -- V2.0
strForm = fhGetValueAsText(ptrRef)
ptrForm = ptrRef:Clone()
end -- local function doForm
local function doFile(ptrRef) -- Process each Media File (FILE,_FILE) -- V2.0
strFile = fhGetValueAsText(ptrRef) -- Fix accent character report -- V2.2 -- V2.7 --!
if #strFile > 0 then -- Skip any missing file link -- V2.7
_, _, strType = general.SplitFilename(strFile)
strFile = strFile:gsub("^Media\\",StrProjPath.."\\Media\\") -- If relative Media source path then make absolute
end
ptrForm = ptrRef:Clone()
end -- local function doFile
local function doDate(ptrRef) -- Process each Media Date (_DATE) -- V2.0
local datDat = fhGetValueAsDate(ptrRef)
if not datDat:IsNull() and TblOption.DateWarning == "ON" then -- Check for Date warnings -- V1.7 tglWarnings
CheckDayNumber(ptrRef,ptrRef,datDat) -- Check Day Number -- V2.0
end
end -- local function doDate
local function doKeys(ptrRef) -- Process each Media Keyword (_KEYS) -- V2.0
for _, strKey in ipairs (fhGetValueAsText(ptrRef):split()) do
UpdateWorkWithData("Media Keywords",strKey) -- Update Work with Data value -- V2.0
end
end -- local function doKeys
local function getImageError(intErr) -- V1.8 Obtain Image Error message
--? return im.ErrorStr(intErr) -- Should work but fails in v3.4.2 but OK in v3.8.2
local dicError = { } -- So use lookup dictionary
dicError[im.ERR_OPEN] = "Error while opening the file."
dicError[im.ERR_ACCESS] = "Error while accessing the file."
dicError[im.ERR_FORMAT] = "Invalid or unrecognized file format."
dicError[im.ERR_DATA] = "Invalid or unsupported data."
dicError[im.ERR_COMPRESS] = "Invalid or unsupported compression."
dicError[im.ERR_MEM] = "Insufficient memory."
return dicError[intErr]
end -- local function getImageError
local function doArea(ptrRef,tblGrd,strRow,strCol,ptrObj,strArea) -- Found frame _AREA so check image file height & width -- V2.3
if #strFile > 0 and #strArea > 5 then
local strErr = ""
local intH, intW = 0, 0
local strAnsi, wasAnsi = general.FileNameToANSI(strFile)
if not(wasAnsi) then -- Copy image file to ANSI compatible temporary file --!
strAnsi = strAnsi:gsub("ANSI$",strType) -- Necessary ????
general.CopyFile(strFile,strAnsi)
end
local ifile, intErr = im.FileOpen(strAnsi) -- Open image file and save errors such as missing or non-image file -- V1.9
if intErr and intErr ~= im.ERR_NONE then
strErr = getImageError(intErr) -- Get error message
else
local intErr, intWidth, intHeight = ifile:ReadImageInfo() -- Read image width & height info and save any errors
if intErr and intErr ~= im.ERR_NONE then
strErr = getImageError(intErr) -- Get error message
else
intH, intW = intHeight, intWidth -- Set image Height & Width
end
im.FileClose(ifile)
end
if not(wasAnsi) then -- Delete ANSI compatible temporary file --!
general.DeleteFile(strAnsi)
end
local tblArea = strArea:match("{(.*)}"):splitnumbers()
local intT, intL = tblArea[1], tblArea[2] -- Get frame _AREA co-ordinates {Top,Left,Bottom,Right}
local intB, intR = tblArea[3], tblArea[4]
if intT < 0 or intT > intH -- Top or Bottom outside image Height, or define very slim frame?
or intB < 0 or intB > intH
or ( intB - intT ) <= 9 -- was 20 in V1.8
or intL < 0 or intL > intW -- Left or Right outside image Width, or define very slim frame?
or intR < 0 or intR > intW
or ( intR - intL ) <= 9 -- was 20 in V1.8
then -- Report unusual Frame Area co-ordinates
local strArea = string.format("T=% 05d B=% 05d L=% 05d R=% 05d ",intT,intB,intL,intR)
local strFile = strErr
if strFile == "" then -- Either report file Error or image Height & Width
strFile = string.format("H=% 05d W=% 05d",intH,intW)
end
ExceptionReport(ptrObj,ptrRef,
MarkCell(tblGrd,strRow,strCol,"UnusualFrameArea").."Area : "..strArea.."File : "..strFile) -- V2.0
end
end
end -- local function doArea
local function doNote2(ptrRef,tblGrd,strRow,strCol,ptrObj) -- Check each Media Link/Note for Frame v File errors (NOTE2)
FindCitations(ptrRef,tblGrd,strRow)
local ptrVal = fhGetItemPtr(ptrRef,"~._AREA")
if ptrVal:IsNotNull() then
doArea(ptrRef,tblGrd,strRow,strCol,ptrObj,fhGetValueAsText(ptrVal)) -- V2.3
end
end -- local function doNote2
local dicWhat = -- Tag actions invoked by CheckMedia() function
{
FORM = doForm ;
FILE = doFile ;
_FILE = doFile ;
_DATE = doDate ;
_KEYS = doKeys ;
NOTE = FindCitations ;
NOTE2 = doNote2 ;
REFN = UpdateCustomId ;
CHAN = FindAnyNotes ;
}
local function CheckMedia(ptrObj,tblGrd,strRow,strCol) -- Check media Format v File type, Frame Area v Image Size, Date & Keywords, and for any Note check for Citations -- V1.8 -- V2.0
strFile = ""
strType = ""
strForm = ""
ptrForm = fhNewItemPtr()
local ptrRef = fhNewItemPtr() -- Loop through each tag
ptrRef:MoveToFirstChildItem(ptrObj)
while ptrRef:IsNotNull() do
local action = dicWhat[fhGetTag(ptrRef)] or CheckIsUDF -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow,strCol,ptrObj) -- Protect ptrRef against change by action -- V2.5
local ptrFile = fhNewItemPtr()
ptrFile:MoveToFirstChildItem(ptrRef) -- FH V7 GEDCOM 5.5.1 FILE sub-tags FORM & TITL -- V2.2
while ptrFile:IsNotNull() do
local action = dicWhat[fhGetTag(ptrFile)] or CheckIsUDF -- Invoke function for each tag
action(ptrFile:Clone(),tblGrd,strRow,strCol,ptrObj) -- Protect ptrFile against change by action -- V2.5
ptrFile:MoveNext()
end
ptrRef:MoveNext()
end
local intRid = fhGetRecordId(ptrObj)
for _, dicArea in ipairs ( TblObjArea[intRid] or {} ) do -- Check _AREA dimensions found earlier by UpdateMedia(...) function -- V2.3
doArea(dicArea.Link,tblGrd,strRow,strCol,ptrObj,dicArea.Area)
end
-- Tolerate lower/upper-case, spaces, and jpeg/jpg & tiff/tif variants
local lowForm = strForm:lower():gsub("[\t-\r ]*",""):gsub("jpeg","jpg"):gsub("tiff","tif")
local lowType = strType:lower():gsub("[\t-\r ]*",""):gsub("jpeg","jpg"):gsub("tiff","tif")
if lowForm ~= "ole" and lowForm ~= lowType then -- Report mismatching file types
ExceptionReport(ptrObj,ptrForm,
MarkCell(tblGrd,strRow,strCol,"UnusualFormatType")..strForm.." File type : "..strType) -- V2.0
end
end -- local function CheckMedia
return CheckMedia
end -- function CheckMediaPrototype
function MediaRecord(ptrRec,tblGrd,strRow,tblGrid) -- Analyse Media Record (OBJE) -- V1.8 -- V2.0
CheckMedia(ptrRec,tblGrd,strRow,"Count") -- Check media Format v File type -- V1.8 -- V2.0
end -- function MediaRecord
function AnyRecord(ptrRec,tblGrd,strRow,tblGrid,dicWhat) -- Analyse Any Record (NOTE,REPO,_PLAC,SUBM,SUBN,HEAD) -- V2.0
local ptrRef = fhNewItemPtr() -- Reference pointer
ptrRef:MoveToFirstChildItem(ptrRec) -- Loop through each tag
while ptrRef:IsNotNull() do
local action = dicWhat[fhGetTag(ptrRef)] or CheckIsUDF -- Invoke function for each tag
action(ptrRef:Clone(),tblGrd,strRow,ptrRec) -- Protect ptrRef against change by action -- V2.5
ptrRef:MoveNext()
end
end -- function AnyRecord
function UpdateStatistics(tblGrid) -- Update each Grid of statistics
FoundCitation = FoundCitationPrototype() -- Create tag action function prototypes with TblIndivid, TblFamily, TblFacts, etc, defined
UpdateFact = UpdateFactPrototype()
IndividRecord = IndividRecordPrototype()
FamilyRecord = FamilyRecordPrototype()
CheckMedia = CheckMediaPrototype()
local function doType(ptrRef) -- Count each Work with Data Source Type value (_TYPE) -- V2.0
UpdateWorkWithData("Source Types",ptrRef)
end -- local function doType
local function doData(ptrRef) -- Check Source Data Event Date & Place (DATA.EVEN.DATE & PLAC) -- V2.0
local ptrDate = fhGetItemPtr(ptrRef,"~.EVEN.DATE")
local datDate = fhGetValueAsDate(ptrDate)
if not datDate:IsNull() and TblOption.DateWarning == "ON" then -- Check for Date warnings -- V1.7 tglWarnings
CheckDayNumber(ptrDate,ptrDate,datDate) -- Check Day Number -- V2.0
end
local ptrPlac = fhGetItemPtr(ptrRef,"~.EVEN.PLAC")
if ptrPlac:IsNotNull() then
UpdateWorkWithData("Places",ptrPlac) -- Update Work with Data Places
end
end -- local function doData
local dicNOTE = -- Tag actions invoked by Note Record statistics
{
SOUR = FoundCitation ;
SOUR2 = FindAnyNotes ;
REFN = UpdateCustomId ;
CHAN = FindAnyNotes ;
}
local dicSOUR = -- Tag actions invoked by Source Record statistics
{
_TYPE = doType ;
DATA = doData ;
REPO = FindAnyNotes ;
NOTE = FindCitations ;
NOTE2 = FindCitations ;
OBJE = UpdateMedia ;
OBJE2 = UpdateLMO ;
REFN = UpdateCustomId ;
CHAN = FindAnyNotes ;
}
local dicREPO = -- Tag actions invoked by Repository Record statistics
{
ADDR = UpdateAddress ;
NOTE = FindCitations ;
NOTE2 = FindCitations ;
REFN = UpdateCustomId ;
CHAN = FindAnyNotes ;
}
local dicPLAC = -- Tag actions invoked by Place Record statistics
{
NOTE = FindCitations ;
NOTE2 = FindCitations ;
OBJE = UpdateMedia ;
OBJE2 = UpdateLMO ;
CHAN = FindAnyNotes ;
}
local dicSUBM = -- Tag actions invoked by Submitter Record statistics
{
ADDR = UpdateAddress ;
OBJE = UpdateMedia ;
OBJE2 = UpdateLMO ;
RFN = UpdatePermRecNo;
CHAN = FindAnyNotes ;
}
local dicRec = -- Tag actions invoked by Compose the Record statistics
{ -- Tag Record Action Row Title Child Actions
INDI = { Act=IndividRecord ; Row="Individual" ; };
FAM = { Act=FamilyRecord ; Row="Family" ; };
NOTE = { Act=AnyRecord ; Row="Note" ; What=dicNOTE; };
SOUR = { Act=AnyRecord ; Row="Source" ; What=dicSOUR; };
REPO = { Act=AnyRecord ; Row="Repository" ; What=dicREPO; };
OBJE = { Act=MediaRecord ; Row="Multimedia" ; };
_PLAC = { Act=AnyRecord ; Row="Place" ; What=dicPLAC; };
_RNOT = { Act=AnyRecord ; Row="Research Note" ; };
_SRCT = { Act=AnyRecord ; Row="Source Template"; };
SUBM = { Act=AnyRecord ; Row="Submitter" ; What=dicSUBM; };
SUBN = { Act=AnyRecord ; Row="Submission" ; };
HEAD = { Act=AnyRecord ; Row="Header" ; };
}
local intRecs = 0
for strRec in iterate.RecordTypes() do
for ptrRec in iterate.Records(strRec) do -- Count number of Records -- V2.0
intRecs = intRecs + 1
end
end
ResetGridCells(tblGrid) -- Reset all Cells
progbar.Setup(iup_gui.DialogueAttributes("Bars")) -- Pass parameters into new Progress Bar prototype
if intRecs > 1000 then
progbar.Start("Statistical Analysis",intRecs) -- Start the Progress Bar with number of Records -- V2.0
intRecs = 0
end
local isGood = true -- Status of Progress Bar
local tblGrd = TblRecords
for strRec in iterate.RecordTypes() do -- Compose the Record statistics -- V2.0
local datDat = fhNewDate()
local dicRec = dicRec[strRec]
local dicWhat= dicRec.What or {}
local strRow = dicRec.Row or ""
local action = dicRec.Act or CheckIsUDF
for ptrRec in iterate.Records(strRec) do
action(ptrRec:Clone(),tblGrd,strRow,tblGrid,dicWhat) -- Action each Record for Records/Individuals/Families/Flags/Facts/Data grids -- V2.0
UpdateCount(tblGrd,strRow,"Count")
local intLinks = fhCallBuiltInFunction("LinksTo",ptrRec) -- Count the Links To each Record
if intLinks > 0 then UpdateCount(tblGrd,strRow,"Links",intLinks) end
datDat:SetSimpleDate( (fhCallBuiltInFunction("LastUpdated",ptrRec)) ) -- Process Last Updated Dates
UpdateDate(tblGrd,datDat,strRow,"Oldest Update","Latest Update")
intRecs = intRecs + 1
if intRecs == 31 then
progbar.Message(strRow.." Record Id "..fhGetRecordId(ptrRec)) -- Update the Progress Bar
progbar.Step(intRecs)
intRecs = 0
end
if progbar.Stop() then isGood = false break end -- Break out of inner loop
-- collectgarbage("step",0) -- May improve run time! -- V2.6
end
end
if GetCell(tblGrd,"Family","Links") > GetCell(tblGrd,"Individual","Links") then
MarkCell(tblGrd,"Family","Links","EventLinkFamily") -- Report that Links To Family Records > Links To Individual Records
end
local intInd = GetCell(tblGrd,"Individual","Count") -- Load the required record counts -- V2.0
local intFam = GetCell(tblGrd,"Family","Count")
SetCell(TblIndivid,"All","Count",intInd)
SetCell(TblFamily ,"All","Count",intFam)
tblGrd = TblIndivid -- Display List of Individual Pools -- V2.0
RevealList(tblGrid,tblGrd,tblGrd.Pool)
tblGrd = TblFamily -- Calculate the Average Children for Families -- V2.0
local intCol = tblGrd.Col["Count"]
local intAll = tblGrd[tblGrd.Row["Total Children"]][intCol]
if intAll and intFam then
tblGrd[tblGrd.Row["Ave. Children"]][intCol] = math.floor( intAll / intFam * 10 + 0.5 ) / 10
end
tblGrd = TblFlags -- Display sorted List of Flags -- V2.0
local tblFlag = TblIndivid.Flag
table.sort(tblFlag, function(tblA,tblB) if tblFlag[tblA] == tblFlag[tblB] then return tblA < tblB else return tblFlag[tblA] > tblFlag[tblB] end end )
RevealList(tblGrid,tblGrd,tblFlag,tblGrd.Living)
local strFlagsFile = fhGetContextInfo("CI_APP_DATA_FOLDER").."\\Flags\\Flags.fha"
for strLine in encoder.FileLines(strFlagsFile) do -- Search Flags.fha file
local strFlag = strLine:match("^Name=(.+)$")
if strFlag and not tblFlag[strFlag:gsub("^All$"," All")] then -- Found unused Flag exception (cater for "All" Flag distinct from "All" row) -- V2.0
ExceptionReport(fhNewItemPtr(),fhNewItemPtr(),
MarkCell(tblGrd,"All","Count","UnusedFlagEntry")..strFlag) -- Mark the All Flags Count -- V2.0
end
end
tblGrd = TblFacts -- Calculate the Average Age & Age@ per Fact -- V2.0
for intRow, strRow in ipairs (tblGrd.Row) do
local intNum = tblGrd[intRow][tblGrd.Col["Age"]]
local intAve = tblGrd[intRow][tblGrd.Col["Ave."]]
if intNum and intAve then
tblGrd[intRow][tblGrd.Col["Ave."]] = math.floor( intAve / intNum + 0.5 )
end
local intNum = tblGrd[intRow][tblGrd.Col["Age@"]]
local intAve = tblGrd[intRow][tblGrd.Col["Ave@"]]
if intNum and intAve then
tblGrd[intRow][tblGrd.Col["Ave@"]] = math.floor( intAve / intNum + 0.5 )
end
end
local arrSnapshots = general.GetFolderContents(StrProjPath.."\\Snapshots") -- Count number of Snapshot .fhss files -- V2.1 -- V2.7 --!
local intSnapshots = #arrSnapshots
if intSnapshots > 9 then -- Report excessive number of files
ExceptionReport(fhNewItemPtr(),fhNewItemPtr(),
TblAttrib[TblAttrib["UnusualSnapshots"]][3]..intSnapshots)
end
progbar.Close() -- Close the Progress Bar
ProgressBar = nil
return isGood
end -- function UpdateStatistics
function ExportStatistics(tblGrid) -- Export each Grid of statistics
local strFile = iup_gui.PublicPath.."\\"..iup_gui.Plugin.." ~ .csv" -- Filename template
local strLine = ""
for strGrid, strBase in pairs (tblGrid.Base) do -- Loop through all grid cells -- V2.0
local tblGrd = tblGrid[strBase]
local tblRow = tblGrd.Row
local tblCol = tblGrd.Col
local intDat = 99 -- Fact Date column number -- V2.0
strLine = strGrid -- CSV cell A1 is Grid name
for intCol = 1, #tblCol do
local strCol = TidyTitle(tblCol[intCol]) -- V2.7
if strCol:match("Earliest Fact Date") then intDat = intCol end -- Set 1st Fact Date column -- V2.0
strLine = strLine..","..strCol -- CSV row 1 is Grid column headings
end
for intRow = 1, #tblRow do
strLine = strLine.."\n"..tblRow[intRow] -- CSV col A is Grid row heading
for intCol = 1, #tblCol do
local strBeg = ","
local strEnd = ""
if intCol >= intDat then -- Protect any Earliest & Latest Fact Date so Excel/Calc treats as strings -- V2.0
strBeg = ",=\""
strEnd = "\""
end
strLine = strLine..strBeg..(tblGrd[intRow][intCol] or "")..strEnd -- CSV col B... are cell values
end
local strPath = strFile:gsub("",strGrid)
general.SaveStringToFile(strLine.."\n",strPath) -- Fix accent character report -- V2.2 -- V2.7 --!
end
end
iup_gui.MemoDialogue("\n Export completed to CSV files : \n\n "..strFile:gsub("","*").." \n")
end -- function ExportStatistics
-- Main Code Section Starts Here --
local intPause = collectgarbage("setpause",50) -- Default = 200 Aggressive = 50 -- Sets pause of collector and returns prev value of pause -- V2.6
local intStep = collectgarbage("setstepmul",300) -- Default = 200 Aggressive = 300 -- Sets step mult of collector & returns prev value of step -- V2.6
fhInitialise(5,0,8,"save_recommended")
PresetGlobalData() -- Preset global data definitions
ResetDefaultSettings() -- Preset default sticky settings
LoadSettings() -- Load sticky data settings
iup_gui.CheckVersionInStore() -- Notify if later Version
GUI_MainDialogue() -- Invoke graphical user interface
SaveSettings() -- Save sticky data settings Source:Show-Project-Statistics-8.fh_lua