REM ======================================================================================================================= REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === REM === Full documentation is available on https://help.libreoffice.org/ === REM ======================================================================================================================= Option Compatible Option ClassModule 'Option Private Module Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' L10N (aka SF_L10N) ''' ==== ''' Implementation of a Basic class for providing a number of services ''' related to the translation of user interfaces into a huge number of languages ''' with a minimal impact on the program code itself ''' ''' The design choices of this module are based on so-called PO-files ''' PO-files (portable object files) have long been promoted in the free software industry ''' as a mean of providing multilingual UIs. This is accomplished through the use of human-readable ''' text files with a well defined structure that specifies, for any given language, ''' the source language string and the localized string ''' ''' To read more about the PO format and its ecosystem of associated toolsets: ''' https://www.gnu.org/software/gettext/manual/html_node/PO-Files.html#PO-Files ''' and, IMHO, a very good tutorial: ''' http://pology.nedohodnik.net/doc/user/en_US/ch-about.html ''' ''' The main advantage of the PO format is the complete dissociation between the two ''' very different profiles, i.e. the programmer and the translator(s). ''' Being independent text files, one per language to support, the programmer may give away ''' pristine PO template files (known as POT-files) for a translator to process. ''' ''' This class implements mainly 4 mechanisms: ''' 1. AddText: for the programmer to build a set of words or sentences ''' meant for being translated later ''' 2. AddTextsFromDialog: to automatically execute AddText() on each fixed text of a dialog ''' 3. ExportToPOTFile: All the above texts are exported into a pristine POT-file ''' 4. GetText: At runtime get the text in the user language ''' Note that the first two are optional: POT and PO-files may be built with a simple text editor ''' ''' Several instances of the L10N class may coexist ' The constraint however is that each instance should find its PO-files ''' in a separate directory ''' PO-files must be named with the targeted locale: f.i. "en-US.po" or "fr-BE.po" ''' ''' Service invocation syntax ''' CreateScriptService("L10N"[, FolderName[, Locale]]) ''' FolderName: the folder containing the PO-files (in SF_FileSystem.FileNaming notation) ''' Locale: in the form la-CO (language-COUNTRY) ''' Encoding: The character set that should be used (default = UTF-8) ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml ''' Locale2: fallback Locale to select if Locale po file does not exist (typically "en-US") ''' Encoding2: Encoding of the 2nd Locale file ''' Service invocation examples: ''' Dim myPO As Variant ''' myPO = CreateScriptService("L10N") ' AddText, AddTextsFromDialog and ExportToPOTFile are allowed ''' myPO = CreateScriptService("L10N", "C:\myPOFiles\", "fr-BE") ''' 'All functionalities are available ''' ''' Detailed user documentation: ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_l10n.html?DbPAR=BASIC ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM =============================================================== PRIVATE TYPES ''' The recognized elements of an entry in a PO file are (other elements are ignored) : ''' #. Extracted comments (given by the programmer to the translator) ''' #, flag (the kde-format flag when the string contains tokens) ''' msgctxt Context (to store an acronym associated with the message, this is a distortion of the norm) ''' msgid untranslated-string ''' msgstr translated-string ''' NB: plural forms are not supported Type POEntry Comment As String Flag As String Context As String MsgId As String MsgStr As String End Type REM ================================================================== EXCEPTIONS Const DUPLICATEKEYERROR = "DUPLICATEKEYERROR" REM ============================================================= PRIVATE MEMBERS Private [Me] As Object Private [_Parent] As Object Private ObjectType As String ' Must be "L10N" Private ServiceName As String Private _POFolder As String ' PO files container Private _Locale As String ' la-CO Private _POFile As String ' PO file in URL format Private _Encoding As String ' Used to open the PO file, default = UTF-8 Private _Dictionary As Object ' SF_Dictionary REM ===================================================== CONSTRUCTOR/DESTRUCTOR REM ----------------------------------------------------------------------------- Private Sub Class_Initialize() Set [Me] = Nothing Set [_Parent] = Nothing ObjectType = "L10N" ServiceName = "ScriptForge.L10N" _POFolder = "" _Locale = "" _POFile = "" Set _Dictionary = Nothing End Sub ' ScriptForge.SF_L10N Constructor REM ----------------------------------------------------------------------------- Private Sub Class_Terminate() If Not IsNull(_Dictionary) Then Set _Dictionary = _Dictionary.Dispose() Call Class_Initialize() End Sub ' ScriptForge.SF_L10N Destructor REM ----------------------------------------------------------------------------- Public Function Dispose() As Variant Call Class_Terminate() Set Dispose = Nothing End Function ' ScriptForge.SF_L10N Explicit Destructor REM ================================================================== PROPERTIES REM ----------------------------------------------------------------------------- Property Get Folder() As String ''' Returns the FolderName containing the PO-files expressed as given by the current FileNaming ''' property of the SF_FileSystem service. Default = URL format ''' May be empty ''' Example: ''' myPO.Folder Folder = _PropertyGet("Folder") End Property ' ScriptForge.SF_L10N.Folder REM ----------------------------------------------------------------------------- Property Get Languages() As Variant ''' Returns a zero-based array listing all the BaseNames of the PO-files found in Folder, ''' Example: ''' myPO.Languages Languages = _PropertyGet("Languages") End Property ' ScriptForge.SF_L10N.Languages REM ----------------------------------------------------------------------------- Property Get Locale() As String ''' Returns the currently active language-COUNTRY combination. May be empty ''' Example: ''' myPO.Locale Locale = _PropertyGet("Locale") End Property ' ScriptForge.SF_L10N.Locale REM ===================================================================== METHODS REM ----------------------------------------------------------------------------- Public Function AddText(Optional ByVal Context As Variant _ , Optional ByVal MsgId As Variant _ , Optional ByVal Comment As Variant _ , Optional ByVal MsgStr As Variant _ ) As Boolean ''' Add a new entry in the list of localizable text strings ''' Args: ''' Context: when not empty, the key to retrieve the translated string via GetText. Default = "" ''' MsgId: the untranslated string, i.e. the text appearing in the program code. Must not be empty ''' The key to retrieve the translated string via GetText when Context is empty ''' May contain placeholders (%1 ... %9) for dynamic arguments to be inserted in the text at run-time ''' If the string spans multiple lines, insert escape sequences (\n) where relevant ''' Comment: the so-called "extracted-comments" intended to inform/help translators ''' If the string spans multiple lines, insert escape sequences (\n) where relevant ''' MsgStr: (internal use only) the translated string ''' If the string spans multiple lines, insert escape sequences (\n) where relevant ''' Returns: ''' True if successful ''' Exceptions: ''' DUPLICATEKEYERROR: such a key exists already ''' Examples: ''' myPO.AddText(, "This is a text to be included in a POT file") Dim bAdd As Boolean ' Output buffer Dim sKey As String ' The key part of the new entry in the dictionary Dim vItem As POEntry ' The item part of the new entry in the dictionary Const cstPipe = "|" ' Pipe forbidden in MsgId's Const cstThisSub = "L10N.AddText" Const cstSubArgs = "[Context=""""], MsgId, [Comment=""""]" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bAdd = False Check: If IsMissing(Context) Or IsMissing(Context) Then Context = "" If IsMissing(Comment) Or IsMissing(Comment) Then Comment = "" If IsMissing(MsgStr) Or IsMissing(MsgStr) Then MsgStr = "" If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(Context, "Context", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(MsgId, "MsgId", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(Comment, "Comment", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(MsgStr, "MsgStr", V_STRING) Then GoTo Finally End If If Len(MsgId) = 0 Then GoTo Finally Try: If Len(Context) > 0 Then sKey = Context Else sKey = MsgId If _Dictionary.Exists(sKey) Then GoTo CatchDuplicate With vItem .Comment = Comment If InStr(MsgId, "%") > 0 Then .Flag = "kde-format" Else .Flag = "" .Context = Replace(Context, cstPipe, " ") .MsgId = Replace(MsgId, cstPipe, " ") .MsgStr = MsgStr End With _Dictionary.Add(sKey, vItem) bAdd = True Finally: AddText = bAdd SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchDuplicate: SF_Exception.RaiseFatal(DUPLICATEKEYERROR, Iif(Len(Context) > 0, "Context", "MsgId"), sKey) GoTo Finally End Function ' ScriptForge.SF_L10N.AddText REM ----------------------------------------------------------------------------- Public Function AddTextsFromDialog(Optional ByRef Dialog As Variant) As Boolean ''' Add all fixed text strings of a dialog to the list of localizable text strings ''' Added texts are: ''' - the title of the dialog ''' - the caption associated with next control types: Button, CheckBox, FixedLine, FixedText, GroupBox and RadioButton ''' - the content of list- and comboboxes ''' - the tip- or helptext displayed when the mouse is hovering the control ''' The current method has method SFDialogs.SF_Dialog.GetTextsFromL10N as counterpart ''' The targeted dialog must not be open when the current method is run ''' Args: ''' Dialog: a SFDialogs.Dialog service instance ''' Returns: ''' True when successful ''' Examples: ''' Dim myDialog As Object ''' Set myDialog = CreateScriptService("SFDialogs.Dialog", "GlobalScope", "XrayTool", "DlgXray") ''' myPO.AddTextsFromDialog(myDialog) Dim bAdd As Boolean ' Return value Dim vControls As Variant ' Array of control names Dim sControl As String ' A single control name Dim oControl As Object ' SFDialogs.DialogControl Dim sText As String ' The text to insert in the dictionary Dim sDialogComment As String ' The prefix in the comment to insert in the dictionary for the dialog Dim sControlComment As String ' The prefix in the comment to insert in the dictionary for a control Dim vSource As Variant ' RowSource property of dialog control as an array Dim i As Long Const cstThisSub = "L10N.AddTextsFromDialog" Const cstSubArgs = "Dialog" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bAdd = False Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(Dialog, "Dialog", V_OBJECT, , , "DIALOG") Then GoTo Finally End If Try: With Dialog ' Store the title of the dialog sDialogComment = "Dialog => " & ._Container & " : " & ._Library & " : " & ._Name & " : " stext = .Caption If Len(sText) > 0 Then If Not _ReplaceText("", sText, sDialogComment & "Caption") Then GoTo Catch End If ' Scan all controls vControls = .Controls() For Each sControl In vControls Set oControl = .Controls(sControl) sControlComment = sDialogComment & sControl & "." With oControl ' Extract fixed texts sText = .Caption If Len(sText) > 0 Then If Not _ReplaceText("", sText, sControlComment & "Caption") Then GoTo Catch End If vSource = .RowSource ' List and comboboxes only If IsArray(vSource) Then For i = 0 To UBound(vSource) If Len(vSource(i)) > 0 Then If Not _ReplaceText("", vSource(i), sControlComment & "RowSource[" & i & "]") Then GoTo Catch End If Next i End If sText = .TipText If Len(sText) > 0 Then If Not _ReplaceText("", sText, sControlComment & "TipText") Then GoTo Catch End If End With Next sControl End With bAdd = True Finally: AddTextsFromDialog = bAdd SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_L10N.AddTextsFromDialog REM ----------------------------------------------------------------------------- Public Function ExportToPOTFile(Optional ByVal FileName As Variant _ , Optional ByVal Header As Variant _ , Optional ByVal Encoding As Variant _ ) As Boolean ''' Export a set of untranslated strings as a POT file ''' The set of strings has been built either by a succession of AddText() methods ''' or by a successful invocation of the L10N service with the FolderName argument ''' The generated file should pass successfully the "msgfmt --check 'the pofile'" GNU command ''' Args: ''' FileName: the complete file name to export to. If it exists, is overwritten without warning ''' Header: Comments that will appear on top of the generated file. Do not include any leading "#" ''' If the string spans multiple lines, insert escape sequences (\n) where relevant ''' A standard header will be added anyway ''' Encoding: The character set that should be used ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml ''' Note that LibreOffice probably does not implement all existing sets ''' Default = UTF-8 ''' Returns: ''' True if successful ''' Examples: ''' myPO.ExportToPOTFile("myFile.pot", Header := "Top comment\nSecond line of top comment") Dim bExport As Boolean ' Return value Dim oFile As Object ' Generated file handler Dim vLines As Variant ' Wrapped lines Dim sLine As String ' A single line Dim vItems As Variant ' Array of dictionary items Dim vItem As Variant ' POEntry type Const cstSharp = "# ", cstSharpDot = "#. ", cstFlag = "#, kde-format" Const cstTabSize = 4 Const cstWrap = 70 Const cstThisSub = "L10N.ExportToPOTFile" Const cstSubArgs = "FileName, [Header=""""], [Encoding=""UTF-8""" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bExport = False Check: If IsMissing(Header) Or IsEmpty(Header) Then Header = "" If IsMissing(Encoding) Or IsEmpty(Encoding) Then Encoding = "UTF-8" If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally If Not SF_Utils._Validate(Header, "Header", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(Encoding, "Encoding", V_STRING) Then GoTo Finally End If Try: Set oFile = SF_FileSystem.CreateTextFile(FileName, Overwrite := True, Encoding := Encoding) If Not IsNull(oFile) Then With oFile ' Standard header .WriteLine(cstSharp) .WriteLine(cstSharp & "This pristine POT file has been generated by LibreOffice/ScriptForge") .WriteLine(cstSharp & "Full documentation is available on https://help.libreoffice.org/") ' User header If Len(Header) > 0 Then .WriteLine(cstSharp) vLines = SF_String.Wrap(Header, cstWrap, cstTabSize) For Each sLine In vLines .WriteLine(cstSharp & Replace(sLine, SF_String.sfLF, "")) Next sLine End If ' Standard header .WriteLine(cstSharp) .WriteLine("msgid """"") .WriteLine("msgstr """"") .WriteLine(SF_String.Quote("Project-Id-Version: PACKAGE VERSION\n")) .WriteLine(SF_String.Quote("Report-Msgid-Bugs-To: " _ & "https://bugs.libreoffice.org/enter_bug.cgi?product=LibreOffice&bug_status=UNCONFIRMED&component=UI\n")) .WriteLine(SF_String.Quote("POT-Creation-Date: " & SF_STring.Represent(Now()) & "\n")) .WriteLine(SF_String.Quote("PO-Revision-Date: YYYY-MM-DD HH:MM:SS\n")) .WriteLine(SF_String.Quote("Last-Translator: FULL NAME <EMAIL@ADDRESS>\n")) .WriteLine(SF_String.Quote("Language-Team: LANGUAGE <EMAIL@ADDRESS>\n")) .WriteLine(SF_String.Quote("Language: en_US\n")) .WriteLine(SF_String.Quote("MIME-Version: 1.0\n")) .WriteLine(SF_String.Quote("Content-Type: text/plain; charset=" & Encoding & "\n")) .WriteLine(SF_String.Quote("Content-Transfer-Encoding: 8bit\n")) .WriteLine(SF_String.Quote("Plural-Forms: nplurals=2; plural=n > 1;\n")) .WriteLine(SF_String.Quote("X-Generator: LibreOffice - ScriptForge\n")) .WriteLine(SF_String.Quote("X-Accelerator-Marker: ~\n")) ' Individual translatable strings vItems = _Dictionary.Items() For Each vItem in vItems .WriteBlankLines(1) ' Comments vLines = Split(vItem.Comment, "\n") For Each sLine In vLines .WriteLine(cstSharpDot & SF_String.ExpandTabs(SF_String.Unescape(sLine), cstTabSize)) Next sLine ' Flag If InStr(vItem.MsgId, "%") > 0 Then .WriteLine(cstFlag) ' Context If Len(vItem.Context) > 0 Then .WriteLine("msgctxt " & SF_String.Quote(vItem.Context)) End If ' MsgId vLines = SF_String.Wrap(vItem.MsgId, cstWrap, cstTabSize) If UBound(vLines) = 0 Then .WriteLine("msgid " & SF_String.Quote(SF_String.Escape(vLines(0)))) Else .WriteLine("msgid """"") For Each sLine in vLines .WriteLine(SF_String.Quote(SF_String.Escape(sLine))) Next sLine End If ' MsgStr .WriteLine("msgstr """"") Next vItem .CloseFile() End With End If bExport = True Finally: If Not IsNull(oFile) Then Set oFile = oFile.Dispose() ExportToPOTFile = bExport SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_L10N.ExportToPOTFile REM ----------------------------------------------------------------------------- Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant ''' Return the actual value of the given property ''' Args: ''' PropertyName: the name of the property as a string ''' Returns: ''' The actual value of the property ''' If the property does not exist, returns Null ''' Exceptions: ''' ARGUMENTERROR The property does not exist ''' Examples: ''' myL10N.GetProperty("MyProperty") Const cstThisSub = "L10N.GetProperty" Const cstSubArgs = "" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch GetProperty = Null Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch End If Try: GetProperty = _PropertyGet(PropertyName) Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_L10N.GetProperty REM ----------------------------------------------------------------------------- Public Function GetText(Optional ByVal MsgId As Variant _ , ParamArray pvArgs As Variant _ ) As String ''' Get the translated string corresponding with the given argument ''' Args: ''' MsgId: the identifier of the string or the untranslated string ''' Either - the untranslated text (MsgId) ''' - the reference to the untranslated text (Context) ''' - both (Context|MsgId) : the pipe character is essential ''' pvArgs(): a list of arguments present as %1, %2, ... in the (un)translated string) ''' to be substituted in the returned string ''' Any type is admitted but only strings, numbers or dates are relevant ''' Returns: ''' The translated string ''' If not found the MsgId string or the Context string ''' Anyway the substitution is done ''' Examples: ''' myPO.GetText("This is a text to be included in a POT file") ''' ' Ceci est un text à inclure dans un fichier POT Dim sText As String ' Output buffer Dim sContext As String ' Context part of argument Dim sMsgId As String ' MsgId part of argument Dim vItem As POEntry ' Entry in the dictionary Dim vMsgId As Variant ' MsgId split on pipe Dim sKey As String ' Key of dictionary Dim sPercent As String ' %1, %2, ... placeholders Dim i As Long Const cstPipe = "|" Const cstThisSub = "L10N.GetText" Const cstSubArgs = "MsgId, [Arg0, Arg1, ...]" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch sText = "" Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(MsgId, "MsgId", V_STRING) Then GoTo Finally End If If Len(Trim(MsgId)) = 0 Then GoTo Finally sText = MsgId Try: ' Find and load entry from dictionary If Left(MsgId, 1) = cstPipe then MsgId = Mid(MsgId, 2) vMsgId = Split(MsgId, cstPipe) sKey = vMsgId(0) If Not _Dictionary.Exists(sKey) Then ' Not found If UBound(vMsgId) = 0 Then sText = vMsgId(0) Else sText = Mid(MsgId, InStr(MsgId, cstPipe) + 1) Else vItem = _Dictionary.Item(sKey) If Len(vItem.MsgStr) > 0 Then sText = vItem.MsgStr Else sText = vItem.MsgId End If ' Substitute %i placeholders For i = UBound(pvArgs) To 0 Step -1 ' Go downwards to not have a limit in number of args sPercent = "%" & (i + 1) sText = Replace(sText, sPercent, SF_String.Represent(pvArgs(i))) Next i Finally: GetText = sText SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_L10N.GetText REM - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Public Function _(Optional ByVal MsgId As Variant _ , ParamArray pvArgs As Variant _ ) As String ''' Get the translated string corresponding with the given argument ''' Alias of GetText() - See above ''' Examples: ''' myPO._("This is a text to be included in a POT file") ''' ' Ceci est un text à inclure dans un fichier POT Dim sText As String ' Output buffer Dim sPercent As String ' %1, %2, ... placeholders Dim i As Long Const cstPipe = "|" Const cstThisSub = "L10N._" Const cstSubArgs = "MsgId, [Arg0, Arg1, ...]" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch sText = "" Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(MsgId, "MsgId", V_STRING) Then GoTo Finally End If If Len(Trim(MsgId)) = 0 Then GoTo Finally Try: ' Find and load entry from dictionary sText = GetText(MsgId) ' Substitute %i placeholders - done here, not in GetText(), because # of arguments is undefined For i = 0 To UBound(pvArgs) sPercent = "%" & (i + 1) sText = Replace(sText, sPercent, SF_String.Represent(pvArgs(i))) Next i Finally: _ = sText SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_L10N._ REM ----------------------------------------------------------------------------- Public Function Methods() As Variant ''' Return the list of public methods of the L10N service as an array Methods = Array( _ "AddText" _ , "ExportToPOTFile" _ , "GetText" _ , "AddTextsFromDialog" _ , "_" _ ) End Function ' ScriptForge.SF_L10N.Methods REM ----------------------------------------------------------------------------- Public Function Properties() As Variant ''' Return the list or properties of the Timer class as an array Properties = Array( _ "Folder" _ , "Languages" _ , "Locale" _ ) End Function ' ScriptForge.SF_L10N.Properties REM ----------------------------------------------------------------------------- Public Function SetProperty(Optional ByVal PropertyName As Variant _ , Optional ByRef Value As Variant _ ) As Boolean ''' Set a new value to the given property ''' Args: ''' PropertyName: the name of the property as a string ''' Value: its new value ''' Exceptions ''' ARGUMENTERROR The property does not exist Const cstThisSub = "L10N.SetProperty" Const cstSubArgs = "PropertyName, Value" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch SetProperty = False Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch End If Try: Select Case UCase(PropertyName) Case Else End Select Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_L10N.SetProperty REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Public Sub _Initialize(ByVal psPOFile As String _ , ByVal Encoding As String _ ) ''' Completes initialization of the current instance requested from CreateScriptService() ''' Load the POFile in the dictionary, otherwise leave the dictionary empty ''' Args: ''' psPOFile: the file to load the translated strings from ''' Encoding: The character set that should be used. Default = UTF-8 Dim oFile As Object ' PO file handler Dim sContext As String ' Collected context string Dim sMsgId As String ' Collected untranslated string Dim sComment As String ' Collected comment string Dim sMsgStr As String ' Collected translated string Dim sLine As String ' Last line read Dim iContinue As Integer ' 0 = None, 1 = MsgId, 2 = MsgStr Const cstMsgId = 1, cstMsgStr = 2 Try: ' Initialize dictionary anyway Set _Dictionary = SF_Services.CreateScriptService("Dictionary") Set _Dictionary.[_Parent] = [Me] ' Load PO file If Len(psPOFile) > 0 Then With SF_FileSystem _POFolder = ._ConvertToUrl(.GetParentFolderName(psPOFile)) _Locale = .GetBaseName(psPOFile) _POFile = ._ConvertToUrl(psPOFile) End With ' Load PO file Set oFile = SF_FileSystem.OpenTextFile(psPOFile, IOMode := SF_FileSystem.ForReading, Encoding := Encoding) If Not IsNull(oFile) Then With oFile ' The PO file is presumed valid => syntax check is not very strict sContext = "" : sMsgId = "" : sComment = "" : sMsgStr = "" Do While Not .AtEndOfStream sLine = Trim(.ReadLine()) ' Trivial examination of line header Select Case True Case sLine = "" If Len(sMsgId) > 0 Then AddText(sContext, sMsgId, sComment, sMsgStr) sContext = "" : sMsgId = "" : sComment = "" : sMsgStr = "" iContinue = 0 Case Left(sLine, 3) = "#. " sComment = sComment & Iif(Len(sComment) > 0, "\n", "") & Trim(Mid(sLine, 4)) iContinue = 0 Case Left(sLine, 8) = "msgctxt " sContext = SF_String.Unquote(Trim(Mid(sLine, 9))) iContinue = 0 Case Left(sLine, 6) = "msgid " sMsgId = SF_String.Unquote(Trim(Mid(sLine, 7))) iContinue = cstMsgId Case Left(sLine, 7) = "msgstr " sMsgStr = sMsgStr & SF_String.Unquote(Trim(Mid(sLine, 8))) iContinue = cstMsgStr Case Left(sLine, 1) = """" If iContinue = cstMsgId Then sMsgId = sMsgId & SF_String.Unquote(sLine) ElseIf iContinue = cstMsgStr Then sMsgStr = sMsgStr & SF_String.Unquote(sLine) Else iContinue = 0 End If Case Else ' Skip line iContinue = 0 End Select Loop ' Be sure to store the last entry If Len(sMsgId) > 0 Then AddText(sContext, sMsgId, sComment, sMsgStr) .CloseFile() Set oFile = .Dispose() End With End If Else _POFolder = "" _Locale = "" _POFile = "" End If Finally: Exit Sub End Sub ' ScriptForge.SF_L10N._Initialize REM ----------------------------------------------------------------------------- Private Function _PropertyGet(Optional ByVal psProperty As String) ''' Return the value of the named property ''' Args: ''' psProperty: the name of the property Dim vFiles As Variant ' Array of PO-files Dim i As Long Dim cstThisSub As String Dim cstSubArgs As String cstThisSub = "SF_L10N.get" & psProperty cstSubArgs = "" SF_Utils._EnterFunction(cstThisSub, cstSubArgs) With SF_FileSystem Select Case psProperty Case "Folder" If Len(_POFolder) > 0 Then _PropertyGet = ._ConvertFromUrl(_POFolder) Else _PropertyGet = "" Case "Languages" If Len(_POFolder) > 0 Then vFiles = .Files(._ConvertFromUrl(_POFolder), "*.po") For i = 0 To UBound(vFiles) vFiles(i) = SF_FileSystem.GetBaseName(vFiles(i)) Next i Else vFiles = Array() End If _PropertyGet = vFiles Case "Locale" _PropertyGet = _Locale Case Else _PropertyGet = Null End Select End With Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function End Function ' ScriptForge.SF_L10N._PropertyGet REM ----------------------------------------------------------------------------- Private Function _ReplaceText(ByVal psContext As String _ , ByVal psMsgId As String _ , ByVal psComment As String _ ) As Boolean ''' When the entry in the dictionary does not yet exist, equivalent to AddText ''' When it exists already, extend the existing comment with the psComment argument ''' Used from AddTextsFromDialog to manage identical strings without raising errors, ''' e.g. when multiple dialogs have the same "Close" button Dim bAdd As Boolean ' Return value Dim sKey As String ' The key part of an entry in the dictionary Dim vItem As POEntry ' The item part of the new entry in the dictionary Try: bAdd = False If Len(psContext) > 0 Then sKey = psContext Else sKey = psMsgId If _Dictionary.Exists(sKey) Then ' Load the entry, adapt comment and rewrite vItem = _Dictionary.Item(sKey) If Len(vItem.Comment) = 0 Then vItem.Comment = psComment Else vItem.Comment = vItem.Comment & "\n" & psComment bAdd = _Dictionary.ReplaceItem(sKey, vItem) Else ' Add a new entry as usual bAdd = AddText(psContext, psMsgId, psComment) End If Finally: _ReplaceText = bAdd Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_L10N._ReplaceText REM ----------------------------------------------------------------------------- Private Function _Repr() As String ''' Convert the L10N instance to a readable string, typically for debugging purposes (DebugPrint ...) ''' Args: ''' Return: ''' "[L10N]: PO file" _Repr = "[L10N]: " & _POFile End Function ' ScriptForge.SF_L10N._Repr REM ============================================ END OF SCRIPTFORGE.SF_L10N