mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-09-24 17:19:06 +02:00
* Add translation tool
This commit is contained in:
Michaël Van Canneyt
parent
64c9e3c5b3
commit
c326037808
464
packages/rtl/Rtl.HTMLTranslate.pas
Normal file
464
packages/rtl/Rtl.HTMLTranslate.pas
Normal file
@ -0,0 +1,464 @@
|
||||
{
|
||||
This file is part of the Pas2JS run time library.
|
||||
Copyright (c) 2019 by Michael Van Canneyt
|
||||
|
||||
RTL HTML tag translator class
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
unit Rtl.HTMLTranslate;
|
||||
|
||||
interface
|
||||
|
||||
Uses SysUtils, JS, Web, Classes, Rtl.HTMLUtils;
|
||||
|
||||
(* Language data is a JSON object structure.
|
||||
|
||||
2 file-based formats are supported (see LanguageSource):
|
||||
|
||||
lsSingle: Single Language file in the following form
|
||||
{
|
||||
"name" : "value"
|
||||
}
|
||||
or
|
||||
{
|
||||
scope1 : {
|
||||
"name' : "value"
|
||||
},
|
||||
scope1 : {
|
||||
"name' : "value"
|
||||
}
|
||||
}
|
||||
lsMulti: Multiple languages are in the file in the following form.
|
||||
Languages are lowercase !
|
||||
(
|
||||
"lang1" : {
|
||||
"name" : "value"
|
||||
},
|
||||
"lang2" : {
|
||||
scope1 : {
|
||||
"name' : "value"
|
||||
},
|
||||
scope1 : {
|
||||
"name' : "value"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
there is an Javascript-only mode as well:
|
||||
|
||||
for language mode lsScoped: a JS global variable is assumed to exist
|
||||
with a JS object using the same format as the lsMultiple format.
|
||||
|
||||
*)
|
||||
|
||||
Const
|
||||
DefaultDataTagName = 'translate';
|
||||
|
||||
Type
|
||||
TLanguageLoadedEvent = reference to Procedure (Sender : TObject; aLanguage : String);
|
||||
TLanguageLoadErrorEvent = reference to Procedure (Sender : TObject; aLanguague,aErrorMessage : String);
|
||||
|
||||
// Are all languages in a single file or in multiple files or in global JS scope.
|
||||
|
||||
TLanguageSource = (lsSingle, lsMulti, lsScoped);
|
||||
|
||||
EHTMLTagTranslator = Class(Exception);
|
||||
|
||||
{ THTMLTagTranslator }
|
||||
|
||||
THTMLTagTranslator = class(TComponent)
|
||||
private
|
||||
FDataTagName: String;
|
||||
FLanguage: String;
|
||||
FOnLanguageLoaded: TLanguageLoadedEvent;
|
||||
FCurrLanguageStrings: TJSObject;
|
||||
FDefaultScopeObj : TJSObject;
|
||||
FLanguages: TJSObject;
|
||||
FLanguageFileURL: String;
|
||||
FLanguageVarName: String;
|
||||
FFileMode: TLanguageSource;
|
||||
FOnLanguageLoadError: TLanguageLoadErrorEvent;
|
||||
FDefaultScopeName: String;
|
||||
FLoadingLanguage: String;
|
||||
FContinueKey: String;
|
||||
FTextMode: TTextMode;
|
||||
procedure LoadLanguageFile(aLanguage: String);
|
||||
Protected
|
||||
procedure DoSetLanguageData(aData : TJSObject; aLanguage : String);
|
||||
function GetDataTagName : String;
|
||||
function GetSeeAlsoScope(aScope: TJSObject): TJSObject;
|
||||
procedure SetLanguage(const Value: String); virtual;
|
||||
Procedure DoLanguageLoaded; virtual;
|
||||
Property LoadingLanguage : String Read FloadingLanguage;
|
||||
Procedure TranslateHTMLTag(aEl : TJSHTMLElement; aScope,aSeealsoScope : TJSObject); overload;
|
||||
Procedure TranslateBelowHTMLTag(aEl : TJSHTMLElement; aScope,aSeealsoScope : TJSObject); overload;
|
||||
Public
|
||||
// Directly set the language data instead of using an URL. This can be used with lsSingle or lsMulti
|
||||
procedure SetLanguageData(aData : TJSObject);
|
||||
// Translate a single HTML tag, using indicated scope.
|
||||
Procedure TranslateHTMLTag(aEl : TJSHTMLElement; aScope : String = ''); overload;
|
||||
// Translate everything below the indicated HTML tag, using indicated scope.
|
||||
Procedure TranslateBelowHTMLTag(aEl : TJSHTMLElement; aScope : String = ''); overload;
|
||||
// Search message name in current root, scope
|
||||
function GetMessageByName(const aScope, aName: string): String; overload;
|
||||
// Search scope in provided root, use to search message in found scope
|
||||
Function GetMessageByName(aRoot : TJSObject; const aScope,aName: string): String; overload;
|
||||
// Search in aScope for message aName
|
||||
Function GetMessageByName(aScope : TJSObject; aName : string) : String; overload;
|
||||
// Find in aScope and aSeeAlsoScope message named aName
|
||||
Function GetMessageByName(aScope,aSeealsoScope : TJSObject; aName : string) : String; overload;
|
||||
// Check if language is available
|
||||
Function HasLanguage(aLanguage : String) : Boolean;
|
||||
// Find a scope in the current languages
|
||||
Function GetScope(const aScope : String) : TJSObject; overload;
|
||||
Function GetScope(aRoot : TJSObject; const aScope : String) : TJSObject; overload;
|
||||
Property CurrLanguageStrings : TJSObject Read FCurrLanguageStrings;
|
||||
Published
|
||||
// Data Tag name. Default is 'translate'
|
||||
Property DataTagName : String Read GetDataTagName Write FDataTagName;
|
||||
// Default scope to use when looking for translations. First the local scope is checked, then default scope, then ContinueKey
|
||||
Property DefaultScope : String Read FDefaultScopeName Write FDefaultScopeName;
|
||||
// Continue key name;
|
||||
// When set, indicates the name of a scope in which to continue searching for a translation term.
|
||||
// This can be used for form inheritance;
|
||||
// ContinueKey can be set to continue searching in the inherited scope.
|
||||
Property ContinueKey : String Read FContinueKey Write FContinueKey;
|
||||
// Language name (will be lowercased)
|
||||
Property Language : String Read FLanguage Write SetLanguage;
|
||||
// Language source: single file, multiple files or in Javascript Scope
|
||||
Property LanguageSource : TLanguageSource Read FFileMode Write FFileMode;
|
||||
// File to load language strings from.
|
||||
// If LanguageSource=lsMulti, a format with the language code is done (use %s)
|
||||
// Example: /js/languages/lang-%s.json
|
||||
Property LanguageFileURL : String Read FLanguageFileURL Write FLanguageFileURL;
|
||||
// if LanguageSource=lsScoped then LanguageVarName is the name of the global Window property that contains the translations.
|
||||
property LanguageVarName: String read FLanguageVarName write FLanguageVarName;
|
||||
// Textmode determines whether we use InnerText or InnerHTML to set the text.
|
||||
Property TextMode : TTextMode Read FTextMode Write FTextMode;
|
||||
// Called when the language file is succesfully loaded.
|
||||
Property OnLanguageLoaded : TLanguageLoadedEvent Read FOnLanguageLoaded Write FOnLanguageLoaded;
|
||||
// Called when an error occurs during loading of a language file.
|
||||
Property OnLanguageLoadError : TLanguageLoadErrorEvent Read FOnLanguageLoadError Write FOnLanguageLoadError;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses Types;
|
||||
|
||||
Resourcestring
|
||||
SErrNoSuchLanguage = 'No such language available: %s.';
|
||||
SErrFailedToLoadURL = 'Failed to load language file from URL: "%s".';
|
||||
SErrUnknownError = 'Unknown error loading language from URL "%s": %s.';
|
||||
SErrNoLanguageSelected = 'Cannot TranslateHTML, no language selected.';
|
||||
|
||||
|
||||
procedure THTMLTagTranslator.DoLanguageLoaded;
|
||||
begin
|
||||
FloadingLanguage:='';
|
||||
if Assigned(FOnLanguageLoaded) then
|
||||
FOnLanguageLoaded(Self,FLanguage);
|
||||
end;
|
||||
|
||||
function THTMLTagTranslator.GetDataTagName : String;
|
||||
|
||||
begin
|
||||
Result:=FDataTagName;
|
||||
if Result='' then
|
||||
Result:=DefaultDataTagName;
|
||||
end;
|
||||
|
||||
|
||||
function THTMLTagTranslator.GetScope(const aScope: String): TJSObject;
|
||||
|
||||
begin
|
||||
Result:=GetScope(FCurrLanguageStrings,aScope);
|
||||
end;
|
||||
|
||||
function THTMLTagTranslator.GetScope(aRoot: TJSObject; const aScope: String
|
||||
): TJSObject;
|
||||
|
||||
begin
|
||||
if (aScope='') then
|
||||
Result:=aRoot
|
||||
else if Assigned(aRoot) and isObject(aRoot[aScope]) and Assigned(TJSObject(aRoot[aScope])) then
|
||||
Result:=TJSObject(aRoot[aScope])
|
||||
else
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
function THTMLTagTranslator.GetMessageByName(const aScope,aName: string): String;
|
||||
|
||||
begin
|
||||
Result:=GetMessageByName(FCurrLanguageStrings,aScope,aName);
|
||||
end;
|
||||
|
||||
function THTMLTagTranslator.GetMessageByName(aRoot : TJSObject; const aScope,aName: string): String;
|
||||
|
||||
begin
|
||||
Result:=GetMessageByname(GetScope(aRoot,aScope),aName)
|
||||
end;
|
||||
|
||||
function THTMLTagTranslator.GetSeeAlsoScope(aScope : TJSObject) : TJSObject;
|
||||
|
||||
begin
|
||||
if Assigned(aScope) and (ContinueKey<>'') and IsString(aScope[ContinueKey]) then
|
||||
Result:=GetScope(FCurrLanguageStrings,String(aScope[ContinueKey]))
|
||||
else
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
function THTMLTagTranslator.GetMessageByName(aScope : TJSObject; aName: string): String;
|
||||
|
||||
Var
|
||||
aScope2 : TJSObject;
|
||||
|
||||
begin
|
||||
aScope2:=GetSeeAlsoScope(aScope);
|
||||
Result:=GetMessageByName(aScope,aScope2,aName);
|
||||
end;
|
||||
|
||||
function THTMLTagTranslator.GetMessageByName(aScope, aSeealsoScope: TJSObject; aName: string): String;
|
||||
|
||||
Var
|
||||
DoDefault : Boolean;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
DoDefault:=Not Assigned(aScope);
|
||||
if Assigned(aScope) then
|
||||
begin
|
||||
if IsString(aScope[aName]) then
|
||||
Result:=String(aScope[aName])
|
||||
else if Assigned(aSeeAlsoScope) then
|
||||
begin
|
||||
if IsString(aSeeAlsoScope[aName]) then
|
||||
Result:=String(aSeeAlsoScope[aName])
|
||||
else
|
||||
DoDefault:=True;
|
||||
end
|
||||
else
|
||||
DoDefault:=True;
|
||||
end;
|
||||
if DoDefault and Assigned(FDefaultScopeObj) and IsString(FDefaultScopeObj[aName]) then
|
||||
Result:=String(FDefaultScopeObj[aName]);
|
||||
end;
|
||||
|
||||
function THTMLTagTranslator.HasLanguage(aLanguage: String): Boolean;
|
||||
begin
|
||||
aLanguage:=LowerCase(aLanguage);
|
||||
Result:=False;
|
||||
if FLanguages=Nil then exit;
|
||||
if (LanguageSource=lsMulti) or (LanguageSource=lsScoped) then
|
||||
Result:=isObject(FLanguages[aLanguage])
|
||||
else
|
||||
Result:=(sameText(aLanguage,FLanguage))
|
||||
end;
|
||||
|
||||
procedure THTMLTagTranslator.LoadLanguageFile(aLanguage: String);
|
||||
|
||||
var
|
||||
URL : String;
|
||||
|
||||
Procedure DoLoadError(aMsg : String);
|
||||
|
||||
begin
|
||||
If Assigned(FOnLanguageLoadError) then
|
||||
FOnLanguageLoadError(Self,aLanguage,aMsg);
|
||||
end;
|
||||
|
||||
function LoadLanguageJson(value : JSValue) : JSValue;
|
||||
begin
|
||||
Result:=True;
|
||||
try
|
||||
DoSetLanguageData(TJSJSON.parseObject(String(Value)),aLanguage);
|
||||
except
|
||||
on er : TJSError do
|
||||
DoLoadError(Format(SErrUnknownError,[URL,er.message]));
|
||||
on e : TJSObject do
|
||||
DoLoadError(Format(SErrUnknownError,[URL,TJSJSON.stringify(E)]));
|
||||
end;
|
||||
DoLanguageLoaded;
|
||||
end;
|
||||
|
||||
function doOK(response : JSValue) : JSValue;
|
||||
|
||||
var
|
||||
Res : TJSResponse absolute response;
|
||||
|
||||
begin
|
||||
Result:=Null;
|
||||
If (Res.status<>200) then
|
||||
begin
|
||||
DoLoadError(Format(SErrUnknownError,[URL,res.StatusText]));
|
||||
end
|
||||
else
|
||||
Res.text._then( @LoadLanguageJson );
|
||||
end;
|
||||
|
||||
function doFail(response{%H-} : JSValue) : JSValue;
|
||||
|
||||
begin
|
||||
Result:=Null;
|
||||
DoLoadError(Format(SErrFailedToLoadURL,[URL]));
|
||||
end;
|
||||
|
||||
begin
|
||||
if LanguageSource = lsScoped then
|
||||
DoSetLanguageData(TJSObject(window[LanguageVarName]),aLanguage)
|
||||
else
|
||||
begin
|
||||
FloadingLanguage:=aLanguage;
|
||||
if LanguageSource=lsMulti then
|
||||
URL:=LanguageFileURL
|
||||
else
|
||||
URL:=Format(LanguageFileURL,[aLanguage]);
|
||||
Window.Fetch(URl)._then(@DoOK).catch(@DoFail);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLTagTranslator.DoSetLanguageData(aData: TJSObject;
|
||||
aLanguage: String);
|
||||
|
||||
Procedure DoLoadError(aMsg : String);
|
||||
|
||||
begin
|
||||
If Assigned(FOnLanguageLoadError) then
|
||||
FOnLanguageLoadError(Self,aLanguage,aMsg);
|
||||
end;
|
||||
|
||||
var
|
||||
aVal: JSValue;
|
||||
|
||||
begin
|
||||
FLanguages:=aData;
|
||||
if FLanguages=Nil then
|
||||
exit;
|
||||
if (LanguageSource=lsMulti) or (LanguageSource=lsScoped) then
|
||||
FCurrLanguageStrings:=TJSObject(FLanguages[aLanguage])
|
||||
else
|
||||
FCurrLanguageStrings:=TJSObject(FLanguages);
|
||||
if Not Assigned(FCurrLanguageStrings) then
|
||||
DoLoadError(Format(SErrNoSuchLanguage,[aLanguage]));
|
||||
FDefaultScopeObj:=Nil;
|
||||
if DefaultScope<>'' then
|
||||
begin
|
||||
aVal:=FCurrLanguageStrings[DefaultScope];
|
||||
if IsObject(aVal) then
|
||||
FDefaultScopeObj:=TJSObject(aVal)
|
||||
end;
|
||||
FLanguage:=aLanguage;
|
||||
end;
|
||||
|
||||
procedure THTMLTagTranslator.SetLanguage(const Value: String);
|
||||
|
||||
Var
|
||||
NewLanguage : String;
|
||||
|
||||
begin
|
||||
NewLanguage:=LowerCase(Value);
|
||||
if NewLanguage=FLanguage then Exit;
|
||||
if ((LanguageSource=lsSingle) or (LanguageSource=lsScoped)) and Assigned(FLanguages) then
|
||||
begin
|
||||
if Not Assigned(TJSObject(FLanguages[NewLanguage])) then
|
||||
Raise EHTMLTagTranslator.CreateFmt(SErrNoSuchLanguage,[Value]);
|
||||
FCurrLanguageStrings:=TJSObject(FLanguages[NewLanguage]);
|
||||
FLanguage := NewLanguage;
|
||||
end
|
||||
else
|
||||
LoadLanguageFile(NewLanguage);
|
||||
end;
|
||||
|
||||
procedure THTMLTagTranslator.TranslateHTMLTag(aEl: TJSHTMLElement;
|
||||
aScope: String);
|
||||
|
||||
Var
|
||||
aScope1,aScope2 : TJSObject;
|
||||
|
||||
begin
|
||||
aScope1:=GetScope(aScope);
|
||||
aScope2:=GetSeeAlsoScope(aScope1);
|
||||
TranslateHTMLTag(aEl,aScope1,aScope2);
|
||||
end;
|
||||
|
||||
procedure THTMLTagTranslator.TranslateHTMLTag(aEl: TJSHTMLElement; aScope,
|
||||
aSeealsoScope: TJSObject);
|
||||
|
||||
Var
|
||||
Terms : TStringDynArray;
|
||||
T,S,aAttr,aValue : String;
|
||||
P : Integer;
|
||||
|
||||
begin
|
||||
T:=String(aEl.Dataset.Properties[DataTagName]);
|
||||
If T='' then
|
||||
exit;
|
||||
Terms:=T.Split(';');
|
||||
For S in Terms do
|
||||
begin
|
||||
P:=Pos('-',S);
|
||||
if P=0 then
|
||||
P:=Length(S)+1;
|
||||
aAttr:=Copy(S,P+1,Length(S)-P);
|
||||
aValue:=GetMessageByName(aScope,aSeeAlsoScope,S);
|
||||
if (aValue<>'') then
|
||||
if aAttr='' then
|
||||
begin
|
||||
if TextMode=tmText then
|
||||
aEl.InnerText:=aValue
|
||||
else
|
||||
aEl.InnerHTML:=aValue
|
||||
end
|
||||
else
|
||||
aEl[aAttr]:=aValue;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLTagTranslator.TranslateBelowHTMLTag(aEl: TJSHTMLElement;
|
||||
aScope: String);
|
||||
|
||||
Var
|
||||
aScope1,aScope2 : TJSObject;
|
||||
|
||||
begin
|
||||
aScope1:=GetScope(aScope);
|
||||
aScope2:=GetSeeAlsoScope(aScope1);
|
||||
TranslateBelowHTMLTag(aEl,aScope1,aScope2);
|
||||
end;
|
||||
|
||||
procedure THTMLTagTranslator.TranslateBelowHTMLTag(aEl: TJSHTMLElement; aScope,
|
||||
aSeealsoScope: TJSObject);
|
||||
|
||||
Var
|
||||
NL : TJSNodeList;
|
||||
TN : String;
|
||||
E: TJSHTMLElement;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
TN:=DataTagName;
|
||||
if Not assigned(FCurrLanguageStrings) then
|
||||
Raise EHTMLTagTranslator.Create(SErrNoLanguageSelected);
|
||||
nl:=aEl.querySelectorAll('[data-'+TN+']');
|
||||
for I:=0 to nl.length-1 do
|
||||
begin
|
||||
E:=TJSHTMLElement(nl.Nodes[i]);
|
||||
TranslateHTMLTag(E,aScope,aSeealsoScope);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLTagTranslator.SetLanguageData(aData: TJSObject);
|
||||
|
||||
begin
|
||||
DoSetLanguageData(aData,Language);
|
||||
DoLanguageLoaded;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
@ -1,3 +1,17 @@
|
||||
{
|
||||
This file is part of the Pas2JS run time library.
|
||||
Copyright (c) 2019 by Michael Van Canneyt
|
||||
|
||||
RTL HTML utility routines
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
unit Rtl.HTMLUtils;
|
||||
|
||||
interface
|
||||
@ -10,7 +24,7 @@ Type
|
||||
Procedure HTMLRendered;
|
||||
end;
|
||||
|
||||
|
||||
TTextMode = (tmText,tmHTML);
|
||||
{ ----------------------------------------------------------------------
|
||||
HTML tag manipulation
|
||||
----------------------------------------------------------------------}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user