erabo/spiegel-keyman
1
0
Fork 0
mirror of https://github.com/keymanapp/keyman.git synced 2026-10-16 19:07:33 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 13

Merge pull request #5775 from keymanapp/fix/windows/cherry-pick/5091-default-language

Browse source 
fix(windows): handle edge cases using default language 🍒
This commit is contained in:
Marc Durdin 2021-10-06 08:09:10 +11:00 • committed by GitHub
commit 627eb662c7
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
15 changed files with 443 additions and 192 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

340
windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas
View file

@ -33,7 +33,11 @@ type
class function GetFirstLanguage(Keyboard: IKeymanKeyboardFile): string; overload;
/// <summary>Get the BCP47 tag for the user's default language</summary>
class function GetUserDefaultLanguage: string; static;
class function GetUserDefaultLanguage: string; overload; static;
class procedure GetUserDefaultLanguage(var BCP47: string; var LangID: Integer); overload; static;
/// <summary>Get the -default-lang parameter string for kmshell</summary>
class function GetUserDefaultLangParameterString: string; static;
private
class function GetKeyboardLanguage(const KeyboardID,
BCP47Tag: string): IKeymanKeyboardLanguageInstalled; static;
@ -49,6 +53,7 @@ uses
Keyman.System.KeymanSentryClient,
Keyman.System.LanguageCodeUtils,
KLog,
BCP47Tag,
glossary,
kmint,
@ -64,9 +69,14 @@ var
i: Integer;
begin
Result := True;
for i := 0 to Packages.Count - 1 do
// We'll attempt every package but return failure if any of them have issues
Result := InstallTipForPackage(Packages.Names[i], Packages.ValueFromIndex[i]) and Result;
KL.MethodEnter(nil, 'TTIPMaintenance.InstallTipsForPackages', [Packages.Text]);
try
for i := 0 to Packages.Count - 1 do
// We'll attempt every package but return failure if any of them have issues
Result := InstallTipForPackage(Packages.Names[i], Packages.ValueFromIndex[i]) and Result;
finally
KL.MethodExit(nil, 'TTIPMaintenance.InstallTipsForPackages', [Result]);
end;
end;
class function TTIPMaintenance.InstallTipForPackage(const PackageFilename, BCP47Tag: string): Boolean;
@ -75,23 +85,29 @@ var
n: Integer;
pack: IKeymanPackageInstalled;
begin
// This function has a known limitation: if a package contains more than one keyboard,
// then the BCP47 association will be made only for the first keyboard. This is
// considered an acceptable limitation at this time
Result := False;
KL.MethodEnter(nil, 'TTIPMaintenance.InstallTipForPackage', [PackageFilename, BCP47Tag]);
try
// This function has a known limitation: if a package contains more than one keyboard,
// then the BCP47 association will be made only for the first keyboard. This is
// considered an acceptable limitation at this time
PackageID := ChangeFileExt(ExtractFileName(PackageFilename), '');
n := kmcom.Packages.IndexOf(PackageID);
if n < 0 then
Exit(False);
PackageID := ChangeFileExt(ExtractFileName(PackageFilename), '');
n := kmcom.Packages.IndexOf(PackageID);
if n < 0 then
Exit(False);
pack := kmcom.Packages[n];
pack := kmcom.Packages[n];
if pack.Keyboards.Count = 0 then
Exit(False);
if pack.Keyboards.Count = 0 then
Exit(False);
if BCP47Tag = ''
then Result := DoInstall(pack.Keyboards[0].ID, GetFirstLanguage(pack.Keyboards[0] as IKeymanKeyboardInstalled))
else Result := DoInstall(pack.Keyboards[0].ID, BCP47Tag);
if BCP47Tag = ''
then Result := DoInstall(pack.Keyboards[0].ID, GetFirstLanguage(pack.Keyboards[0] as IKeymanKeyboardInstalled))
else Result := DoInstall(pack.Keyboards[0].ID, BCP47Tag);
finally
KL.MethodExit(nil, 'TTIPMaintenance.InstallTipForPackage', [Result]);
end;
end;
procedure AddDiagnosticBreadcrumb(const KeyboardID: string);
@ -121,18 +137,19 @@ class function TTIPMaintenance.InstallTip(LangID: Integer; const KeyboardID, BCP
var
lang: IKeymanKeyboardLanguageInstalled;
begin
lang := GetKeyboardLanguage(KeyboardID, BCP47Tag);
if lang = nil then
Exit(False);
// TODO: can this fail?
Result := False;
KL.MethodEnter(nil, 'TTIPMaintenance.InstallTip', [LangID, KeyboardID, BCP47Tag, KeyboardToRemove]);
try
lang := GetKeyboardLanguage(KeyboardID, BCP47Tag);
if lang = nil then
Exit(False);
// TODO: can this fail?
(lang as IKeymanKeyboardLanguageInstalled2).InstallTip(LangID, KeyboardToRemove);
except
AddDiagnosticBreadcrumb(KeyboardID);
raise;
Result := True;
finally
KL.MethodExit(nil, 'TTIPMaintenance.InstallTip', [Result]);
end;
Result := True;
end;
class function TTIPMaintenance.RegisterTip(LangID: Integer; const KeyboardID,
@ -140,13 +157,19 @@ class function TTIPMaintenance.RegisterTip(LangID: Integer; const KeyboardID,
var
lang: IKeymanKeyboardLanguageInstalled;
begin
lang := GetKeyboardLanguage(KeyboardID, BCP47Tag);
if lang = nil then
Exit(False);
Result := False;
KL.MethodEnter(nil, 'TTIPMaintenance.RegisterTip', [KeyboardID, BCP47Tag]);
try
lang := GetKeyboardLanguage(KeyboardID, BCP47Tag);
if lang = nil then
Exit(False);
// TODO: can this fail?
// TODO: can this fail?
(lang as IKeymanKeyboardLanguageInstalled2).RegisterTip(LangID);
Result := True;
Result := True;
finally
KL.MethodExit(nil, 'TTIPMaintenance.RegisterTip', [Result]);
end;
end;
class function TTIPMaintenance.DoInstall(const KeyboardID,
@ -157,44 +180,59 @@ var
TemporaryKeyboardID: WideString;
LangID: Integer;
childExitCode: Cardinal;
CanonicalTag, Command: string;
begin
lang := GetKeyboardLanguage(KeyboardID, (kmcom as IKeymanBCP47Canonicalization).GetCanonicalTag(BCP47Tag));
if lang = nil then
// The keyboard was not found
Exit(False);
if lang.IsInstalled then
// After canonicalization, we may find the language is already installed
Exit(True);
TemporaryKeyboardID := '';
LangID := 0;
RegistrationRequired := False;
if not (lang as IKeymanKeyboardLanguageInstalled2).FindInstallationLangID(LangID, TemporaryKeyboardID, RegistrationRequired, kifInstallTransientLanguage) then
begin
// We were not able to find a TIP, perhaps all transient TIPs have been used
Exit(False);
end;
if RegistrationRequired then
begin
// This calls back into TTIPMaintenance.RegisterTip
if WaitForElevatedConfiguration(0, '-register-tip '+IntToHex(LangID,4)+' "'+KeyboardID+'" "'+lang.BCP47Code+'"') <> 0 then
Result := False;
KL.MethodEnter(nil, 'TTIPMaintenance.DoInstall', [KeyboardID, BCP47Tag]);
try
CanonicalTag := (kmcom as IKeymanBCP47Canonicalization).GetCanonicalTag(BCP47Tag);
lang := GetKeyboardLanguage(KeyboardID, CanonicalTag);
KL.Log('BCP47Tag = %s, CanonicalTag = %s, lang.BCP47Code = %s', [BCP47Tag, CanonicalTag, lang.BCP47Code]);
if lang = nil then
// The keyboard was not found
Exit(False);
end;
// This calls back into TTIPMaintenance.InstallTip
if not TUtilExecute.WaitForProcess('"'+ParamStr(0)+'" -install-tip '+IntToHex(LangID,4)+' "'+KeyboardID+'" "'+lang.BCP47Code+'" "'+TemporaryKeyboardID+'"',
GetCurrentDir, childExitCode) or
(childExitCode <> 0) then
begin
if lang.IsInstalled then
// After canonicalization, we may find the language is already installed
Exit(True);
TemporaryKeyboardID := '';
LangID := 0;
RegistrationRequired := False;
if not (lang as IKeymanKeyboardLanguageInstalled2).FindInstallationLangID(LangID, TemporaryKeyboardID, RegistrationRequired, kifInstallTransientLanguage) then
begin
KL.Log('Failed to find installation langid');
// We were not able to find a TIP, perhaps all transient TIPs have been used
Exit(False);
end;
KL.Log('LangID=%x, TemporaryKeyboardID=%s, RegistrationRequired=%s', [LangID, TemporaryKeyboardID, BoolToStr(RegistrationRequired, True)]);
if RegistrationRequired then
begin
Command := '-register-tip '+IntToHex(LangID,4)+' "'+KeyboardID+'" "'+lang.BCP47Code+'" '+GetUserDefaultLangParameterString;
KL.Log('Calling elevated kmshell %s', [Command]);
// This calls back into TTIPMaintenance.RegisterTip
if WaitForElevatedConfiguration(0, Command) <> 0 then
Exit(False);
end;
Command := '-install-tip '+IntToHex(LangID,4)+' "'+KeyboardID+'" "'+lang.BCP47Code+'" "'+TemporaryKeyboardID+'"';
KL.Log('Calling user kmshell %s', [Command]);
// This calls back into TTIPMaintenance.InstallTip
if not TUtilExecute.WaitForProcess('"'+ParamStr(0)+'" '+Command, GetCurrentDir, childExitCode) or
(childExitCode <> 0) then
begin
kmcom.Refresh;
Exit(False);
end;
kmcom.Refresh;
Exit(False);
Result := True;
finally
KL.MethodExit(nil, 'TTIPMaintenance.DoInstall', [Result]);
end;
kmcom.Refresh;
Result := True;
end;
function GetDefaultHKL: HKL;
@ -211,79 +249,149 @@ var
TemporaryKeyboardID: WideString;
RegistrationRequired: WordBool;
begin
lang := GetKeyboardLanguage(KeyboardID, (kmcom as IKeymanBCP47Canonicalization).GetCanonicalTag(BCP47Tag));
if lang = nil then
// The keyboard was not found
Exit(False);
Result := False;
KL.MethodEnter(nil, 'TTIPMaintenance.DoRegister', [KeyboardID, BCP47Tag]);
try
lang := GetKeyboardLanguage(KeyboardID, (kmcom as IKeymanBCP47Canonicalization).GetCanonicalTag(BCP47Tag));
if lang = nil then
// The keyboard was not found
Exit(False);
if lang.IsInstalled or (lang as IKeymanKeyboardLanguageInstalled2).IsRegistered then
// After canonicalization, we may find the language is already installed
Exit(True);
if lang.IsInstalled or (lang as IKeymanKeyboardLanguageInstalled2).IsRegistered then
// After canonicalization, we may find the language is already installed
Exit(True);
TemporaryKeyboardID := '';
LangID := 0;
RegistrationRequired := False;
TemporaryKeyboardID := '';
LangID := 0;
RegistrationRequired := False;
if (lang as IKeymanKeyboardLanguageInstalled2).FindInstallationLangID(LangID, TemporaryKeyboardID, RegistrationRequired, 0) then
begin
Result := not RegistrationRequired or RegisterTip(LangID, KeyboardID, lang.BCP47Code);
end
else
Result := False;
if (lang as IKeymanKeyboardLanguageInstalled2).FindInstallationLangID(LangID, TemporaryKeyboardID, RegistrationRequired, 0) then
begin
Result := not RegistrationRequired or RegisterTip(LangID, KeyboardID, lang.BCP47Code);
end
else
Result := False;
finally
KL.MethodExit(nil, 'TTIPMaintenance.DoRegister', [Result]);
end;
end;
class function TTIPMaintenance.GetUserDefaultLangParameterString: string;
var
LangID: Integer;
BCP47: string;
begin
KL.MethodEnter(nil, 'TTIPMaintenance.GetUserDefaultLangParameterString', []);
try
GetUserDefaultLanguage(BCP47, LangID);
Result := '-default-lang '+BCP47+' '+IntToHex(LangID,4);
finally
KL.MethodExit(nil, 'TTIPMaintenance.GetUserDefaultLangParameterString', [Result]);
end;
end;
class function TTIPMaintenance.GetUserDefaultLanguage: string;
var
LangID: Integer;
begin
KL.MethodEnter(nil, 'TTIPMaintenance.GetUserDefaultLanguage', []);
try
GetUserDefaultLanguage(Result, LangID);
finally
KL.MethodExit(nil, 'TTIPMaintenance.GetUserDefaultLanguage', [Result]);
end;
end;
class procedure TTIPMaintenance.GetUserDefaultLanguage(var BCP47: string; var LangID: Integer);
var
r: TRegistry;
tags: TStringList;
v: string;
keys: TStringList;
key: string;
begin
// Fallback result
Result := TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47(HKLToLanguageID(GetDefaultHKL));
// For Win10, look in CPL/International/UserProfile
r := TRegistry.Create;
function GetLangIDFromValueName: Integer;
var
values: TStringList;
v: string;
begin
// In HKCU\Control Panel\International\User Profile\<bcp47>, already opened
// by the caller, look for a value name such as '0453:00000453' or
// '0804:{81D4E9C9-1D3B-41BC-9E6C-4B40BF79E35E}{FA550B04-5AD7-411F-A5AC-CA038EC515D7}'
// and grab the LangID from there.
values := TStringList.Create;
try
r.GetValueNames(values);
for v in values do
begin
if Copy(v, 5, 1) = ':' then
begin
Result := StrToIntDef('$' + Copy(v, 1, 4), 0);
if Result > 0 then
Exit;
end;
end;
finally
values.Free;
end;
Result := 0;
end;
begin
KL.MethodEnter(nil, 'TTIPMaintenance.GetUserDefaultLanguage', []);
try
if not r.OpenKeyReadOnly(SRegKey_ControlPanelInternationalUserProfile) then
Exit;
if r.ValueExists(SRegValue_CPIUP_InputMethodOverride) then
begin
// Lookup the override input method BCP 47 tag
v := r.ReadString(SRegValue_CPIUP_InputMethodOverride);
keys := TStringList.Create;
try
r.GetKeyNames(keys);
for key in keys do
begin
if r.OpenKeyReadOnly('\' + SRegKey_ControlPanelInternationalUserProfile + '\' + key) and
r.ValueExists(v) then
// Fallback result
LangID := HKLToLanguageID(GetDefaultHKL);
BCP47 := TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47(LangID);
// For Win10, look in CPL/International/UserProfile
r := TRegistry.Create;
try
if not r.OpenKeyReadOnly(SRegKey_ControlPanelInternationalUserProfile) then
Exit;
if r.ValueExists(SRegValue_CPIUP_InputMethodOverride) then
begin
// Lookup the override input method BCP 47 tag
v := r.ReadString(SRegValue_CPIUP_InputMethodOverride);
keys := TStringList.Create;
try
r.GetKeyNames(keys);
for key in keys do
begin
Result := key;
Break;
if r.OpenKeyReadOnly('\' + SRegKey_ControlPanelInternationalUserProfile + '\' + key) and
r.ValueExists(v) then
begin
BCP47 := key;
LangID := GetLangIDFromValueName;
Break;
end;
end;
finally
keys.Free;
end;
finally
keys.Free;
end;
end
else if r.ValueExists(SRegValue_CPIUP_Languages) then
begin
// The first tag is the default language tag
tags := TStringList.Create;
try
r.ReadMultiString(SRegValue_CPIUP_Languages, tags);
if tags.Count > 0 then
begin
Result := tags[0].Trim;
end
else if r.ValueExists(SRegValue_CPIUP_Languages) then
begin
// The first tag is the default language tag
tags := TStringList.Create;
try
r.ReadMultiString(SRegValue_CPIUP_Languages, tags);
if tags.Count > 0 then
begin
BCP47 := tags[0].Trim;
if r.OpenKeyReadOnly('\' + SRegKey_ControlPanelInternationalUserProfile + '\' + BCP47) then
LangID := GetLangIDFromValueName;
end;
finally
tags.Free;
end;
finally
tags.Free;
end;
finally
r.Free;
end;
finally
r.Free;
KL.Log('TTIPMaintenance.GetUserDefaultLanguage = BCP47:%s LangID:%d', [BCP47, LangID]);
KL.MethodExit(nil, 'TTIPMaintenance.GetUserDefaultLanguage');
end;
end;

4
windows/src/desktop/kmshell/install/Keyman.Configuration.UI.InstallFile.pas
View file

@ -169,12 +169,12 @@ begin
if Length(FilenameBCP47) > 1
then RegisterKeyboardPackageLanguage(FPackage, FilenameBCP47[1])
else RegisterKeyboardPackageLanguage(FPackage, '');
// The keyboard will be installed for current user as a separate step
// The keyboard will be installed for current user as a separate step
end
else
begin
FKeyboard := (kmcom.Keyboards as IKeymanKeyboardsInstalled2).Install2(FileName, True);
if Length(FilenameBCP47) > 1
if (Length(FilenameBCP47) > 1) and (Trim(FilenameBCP47[1]) <> '')
then BCP47Tag := FilenameBCP47[1]
else BCP47Tag := TTIPMaintenance.GetFirstLanguage(FKeyboard);
TTIPMaintenance.DoRegister(FKeyboard.ID, BCP47Tag);

45
windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas
View file

@ -118,6 +118,7 @@ uses
System.Win.ComObj,
Winapi.ShellApi,
KLog,
custinterfaces,
GetOSVersion,
MessageIdentifierConsts,
@ -270,7 +271,6 @@ end;
procedure TfrmInstallKeyboard.FireCommand(const command: WideString; params: TStringList);
var
t: TTempFile;
BCP47Tag: string;
begin
BCP47Tag := '';
@ -297,27 +297,38 @@ begin
BCP47Tag := params.ValueFromIndex[0];
TfrmProgress.Execute(Self,
function(Manager: IProgressManager): Boolean
var
t: TTempFile;
ExecParams: string;
begin
Manager.Title := 'Installing Keyboard';
Manager.CanCancel := False;
Manager.UpdateProgress('Installing Keyboard', 0, 0);
t := TTempFileManager.Get('.log');
KL.MethodEnter(Self, '"keyboard_install"', [params.Text]);
try
if WaitForElevatedConfiguration(GetForegroundWindow, '-log "'+t.Name+'" -s -i "'+FInstallFile+'='+BCP47Tag+'" -nowelcome') = 0 then
begin
// install the keyboard tip
if not InstallTipForKeyboard(BCP47Tag) then
Exit(False);
Manager.Title := 'Installing Keyboard';
Manager.CanCancel := False;
Manager.UpdateProgress('Installing Keyboard', 0, 0);
t := TTempFileManager.Get('.log');
try
ExecParams := '-log "'+t.Name+'" -s -i "'+FInstallFile+'='+BCP47Tag+'"'+
' -nowelcome '+TTIPMaintenance.GetUserDefaultLangParameterString;
KL.Log('Calling elevated kmshell %s', [ExecParams]);
if WaitForElevatedConfiguration(GetForegroundWindow, ExecParams) = 0 then
begin
// install the keyboard tip
if not InstallTipForKeyboard(BCP47Tag) then
Exit(False);
CheckForMitigationWarningFor_Win10_1803(False, '');
ModalResult := mrOk;
end
else
ModalResult := mrCancel;
CheckForMitigationWarningFor_Win10_1803(False, '');
ModalResult := mrOk;
end
else
ModalResult := mrCancel;
CheckLogFileForWarnings(t.Name, False);
CheckLogFileForWarnings(t.Name, False);
finally
t.Free;
end;
finally
t.Free;
KL.MethodExit(Self, '"keyboard_install"');
end;
Result := True;
end

31
windows/src/desktop/kmshell/main/initprog.pas
View file

@ -195,7 +195,8 @@ begin
end;
function Init(var FMode: TKMShellMode; KeyboardFileNames: TStrings; var FSilent, FForce, FNoWelcome: Boolean;
var FLogFile, FQuery: string; var FDisablePackages, FDefaultUILanguage: string; var FStartWithConfiguration: Boolean; var FParentWindow: THandle): Boolean;
var FLogFile, FQuery: string; var FDisablePackages, FDefaultUILanguage: string; var FStartWithConfiguration: Boolean;
var FParentWindow: THandle; var FDefaultBCP47: string; var FDefaultLangID: Integer): Boolean;
var
s: string;
i: Integer;
@ -269,7 +270,13 @@ begin
FQuery := Trim(FQuery);
end
else if Copy(s, 1, 3) = '-ur' then UnRegCRC := StrToIntDef('$'+Copy(s, 4, 8), 0)
else if s = '-default-lang' then
begin
Inc(i);
FDefaultBCP47 := ParamStr(i);
Inc(i);
FDefaultLangID := StrToIntDef('$'+ParamStr(i), 0);
end
// Controls from Keyman Engine
else if s = '-showhint' then FMode := fmShowHint
else if s = '-parentwindow' then
@ -301,7 +308,8 @@ begin
end;
procedure RunKMCOM(FMode: TKMShellMode; KeyboardFileNames: TStrings; FSilent, FForce, FNoWelcome: Boolean;
FLogFile, FQuery: string; FDisablePackages, FDefaultUILanguage: string; FStartWithConfiguration: Boolean; FParentWindow: THandle); forward;
FLogFile, FQuery: string; FDisablePackages, FDefaultUILanguage: string; FStartWithConfiguration: Boolean; FParentWindow: THandle;
const FDefaultBCP47: string; FDefaultLangID: Integer); forward;
procedure Run;
var
@ -312,7 +320,8 @@ var
FForce: Boolean;
FParentWindow: THandle;
FLogFile: string;
FDisablePackages, FDefaultUILanguage: string;
FDefaultLangID: Integer;
FDefaultBCP47, FDisablePackages, FDefaultUILanguage: string;
FStartWithConfiguration: Boolean;
begin
RegisterControlClasses;
@ -320,7 +329,7 @@ begin
KeyboardFileNames := TStringList.Create;
try
FParentWindow := 0;
if not Init(FMode, KeyboardFileNames, FSilent, FForce, FNoWelcome, FLogFile, FQuery, FDisablePackages, FDefaultUILanguage, FStartWithConfiguration, FParentWindow) then
if not Init(FMode, KeyboardFileNames, FSilent, FForce, FNoWelcome, FLogFile, FQuery, FDisablePackages, FDefaultUILanguage, FStartWithConfiguration, FParentWindow, FDefaultBCP47, FDefaultLangID) then
begin
//TODO: TUtilExecute.Shell(PChar('hh.exe mk:@MSITStore:'+ExtractFilePath(KMShellExe)+'keyman.chm::/context/keyman_usage.html'), SW_SHOWNORMAL);
Exit;
@ -328,7 +337,7 @@ begin
if not LoadKMCOM then Exit;
try
RunKMCOM(FMode, KeyboardFileNames, FSilent, FForce, FNoWelcome, FLogFile, FQuery, FDisablePackages, FDefaultUILanguage, FStartWithConfiguration, FParentWindow);
RunKMCOM(FMode, KeyboardFileNames, FSilent, FForce, FNoWelcome, FLogFile, FQuery, FDisablePackages, FDefaultUILanguage, FStartWithConfiguration, FParentWindow, FDefaultBCP47, FDefaultLangID);
finally
kmcom := nil;
end;
@ -366,8 +375,10 @@ begin
end;
procedure RunKMCOM(FMode: TKMShellMode; KeyboardFileNames: TStrings; FSilent, FForce, FNoWelcome: Boolean;
FLogFile, FQuery: string; FDisablePackages, FDefaultUILanguage: string; FStartWithConfiguration: Boolean; FParentWindow: THandle);
FLogFile, FQuery: string; FDisablePackages, FDefaultUILanguage: string; FStartWithConfiguration: Boolean;
FParentWindow: THandle; const FDefaultBCP47: string; FDefaultLangID: Integer);
var
kdl: IKeymanDefaultLanguage;
FIcon: string;
FMutex: TKeymanMutex; // I2720
function FirstKeyboardFileName: WideString;
@ -440,6 +451,12 @@ begin
if FileExists(FIcon) then
Application.Icon.LoadFromFile(FIcon);
if (FDefaultBCP47 <> '') or (FDefaultLangID <> 0) then
begin
if Supports(kmcom, IKeymanDefaultLanguage, kdl) then
kdl.SetDefaultLanguage(FDefaultBCP47, FDefaultLangID);
end;
case FMode of
fmKeyboardWelcome: // I2569
ShowKeyboardWelcome(FirstKeyboardFileName);

10
windows/src/engine/kmcomapi/com/keyman_implementation.pas
View file

@ -48,7 +48,7 @@ uses
keymansysteminfo;
type
TKeyman = class(TAutoObject, IKeyman, IIntKeyman, IKeymanBCP47Canonicalization)
TKeyman = class(TAutoObject, IKeyman, IIntKeyman, IKeymanBCP47Canonicalization, IKeymanDefaultLanguage)
private
FInitialized: Boolean;
FContext: TKeymanContext;
@ -84,6 +84,8 @@ type
// Reimplement as a special case for this interface
function SerializeXML(Flags: TOleEnum; const ImagePath: WideString; out References: OleVariant): WideString; safecall;
{ IKeymanDefaultLanguage }
procedure SetDefaultLanguage(const BCP47: WideString; LangID: Integer); safecall;
public
procedure Initialize; override;
destructor Destroy; override;
@ -290,6 +292,12 @@ begin
end;
end;
procedure TKeyman.SetDefaultLanguage(const BCP47: WideString; LangID: Integer);
begin
FContext.DefaultBCP47 := BCP47;
FContext.DefaultLangID := LangID;
end;
procedure TKeyman.Set_AutoApply(Value: WordBool);
begin
if not FInitialized then raise Exception.Create(SErrorUninitialised);

25
windows/src/engine/kmcomapi/keymanapi_TLB.pas generated
View file

@ -12,7 +12,7 @@ unit keymanapi_TLB;
// ************************************************************************ //
// $Rev: 52393 $
// File generated on 1/02/2021 8:52:41 AM from Type Library described below.
// File generated on 16/09/2021 6:54:44 PM from Type Library described below.
// ************************************************************************ //
// Type Lib: C:\Projects\keyman\app\windows\src\engine\kmcomapi\kmcomapi (1)
@ -93,6 +93,7 @@ const
IID_IKeymanKeyboardLanguageInstalled2: TGUID = '{414C26E6-BFAC-4A70-9EA1-E525BA9BBA7E}';
IID_IKeymanKeyboardLanguagesInstalled2: TGUID = '{628FF2E6-B490-462E-8FC7-7AE53B9D392C}';
CLASS_Keyman: TGUID = '{CF46549D-4D2D-4679-A2E1-23A815F172F8}';
IID_IKeymanDefaultLanguage: TGUID = '{77BAB934-B7DF-4304-AFA6-B8F6BEC16516}';
// *********************************************************************//
// Declaration of Enumerations defined in Type Library
@ -257,6 +258,8 @@ type
IKeymanKeyboardLanguageInstalled2Disp = dispinterface;
IKeymanKeyboardLanguagesInstalled2 = interface;
IKeymanKeyboardLanguagesInstalled2Disp = dispinterface;
IKeymanDefaultLanguage = interface;
IKeymanDefaultLanguageDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
@ -1765,6 +1768,26 @@ type
out References: OleVariant): WideString; dispid 401;
end;
// *********************************************************************//
// Interface: IKeymanDefaultLanguage
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {77BAB934-B7DF-4304-AFA6-B8F6BEC16516}
// *********************************************************************//
IKeymanDefaultLanguage = interface(IDispatch)
['{77BAB934-B7DF-4304-AFA6-B8F6BEC16516}']
procedure SetDefaultLanguage(const DefaultBCP47: WideString; DefaultLangID: Integer); safecall;
end;
// *********************************************************************//
// DispIntf: IKeymanDefaultLanguageDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {77BAB934-B7DF-4304-AFA6-B8F6BEC16516}
// *********************************************************************//
IKeymanDefaultLanguageDisp = dispinterface
['{77BAB934-B7DF-4304-AFA6-B8F6BEC16516}']
procedure SetDefaultLanguage(const DefaultBCP47: WideString; DefaultLangID: Integer); dispid 201;
end;
// *********************************************************************//
// The Class CoKeyman provides a Create and CreateRemote method to
// create instances of the default interface IKeyman exposed by

5
windows/src/engine/kmcomapi/keymancontext.pas
View file

@ -32,6 +32,8 @@ type
private
FKeyman: TObject;
FController: TKeymanController;
FDefaultBCP47: string;
FDefaultLangID: Integer;
function GetErrors: IIntKeymanErrors;
function GetKeyboards: IIntKeymanKeyboardsInstalled;
function GetPackages: IIntKeymanPackagesInstalled;
@ -50,6 +52,9 @@ type
property SystemInfo: IIntKeymanSystemInfo read GetSystemInfo;
property Control: IIntKeymanControl read GetControl;
property Controller: TKeymanController read FController;
property DefaultBCP47: string read FDefaultBCP47 write FDefaultBCP47;
property DefaultLangID: Integer read FDefaultLangID write FDefaultLangID;
end;
implementation

2
windows/src/engine/kmcomapi/kmcomapi.dproj
View file

@ -124,7 +124,7 @@
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<DCC_SYMBOL_PLATFORM>false</DCC_SYMBOL_PLATFORM>
<DCC_UNIT_PLATFORM>false</DCC_UNIT_PLATFORM>
<Debugger_HostApplication>..\..\desktop\kmshell\kmshell.exe</Debugger_HostApplication>
<Debugger_HostApplication>..\..\desktop\kmshell\bin\win32\debug\kmshell.exe</Debugger_HostApplication>
<VerInfo_Keys>CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<Debugger_RunParams>-c</Debugger_RunParams>
<DCC_UseMSBuildExternally>false</DCC_UseMSBuildExternally>

14
windows/src/engine/kmcomapi/kmcomapi.ridl
View file

@ -6,7 +6,7 @@
// However, when applying changes via the Editor this file will be regenerated
// and comments or formatting changes will be lost.
// ************************************************************************ //
// File generated on 1/02/2021 8:52:42 AM (- $Rev: 12980 $, 9519671).
// File generated on 16/09/2021 6:54:45 PM (- $Rev: 12980 $, 32940875).
[
uuid(F16E2A9A-DA46-4EA3-BFF3-BA46B480C961),
@ -66,6 +66,7 @@ library keymanapi
interface IKeymanKeyboardLanguageInstalled2;
interface IKeymanKeyboardLanguagesInstalled2;
interface IKeymanBCP47Canonicalization;
interface IKeymanDefaultLanguage;
[
@ -1019,6 +1020,17 @@ library keymanapi
HRESULT _stdcall GetFullTagList([in] BSTR Tag, [out, retval] VARIANT* Result);
};
[
uuid(77BAB934-B7DF-4304-AFA6-B8F6BEC16516),
dual,
oleautomation
]
interface IKeymanDefaultLanguage: IDispatch
{
[id(0x000000C9)]
HRESULT _stdcall SetDefaultLanguage([in] BSTR DefaultBCP47, [in] long DefaultLangID);
};
[
uuid(CF46549D-4D2D-4679-A2E1-23A815F172F8),
version(10.0)

26
windows/src/engine/kmcomapi/processes/keyboard/kpinstallkeyboard.pas
View file

@ -326,6 +326,7 @@ var
kpil: TKPInstallKeyboardLanguage;
ml: TMitigateWin10_1803.TMitigatedLanguage;
KeyboardName: string;
FDefaultBCP47: string;
type
TWSLCallback = reference to procedure(r: TRegistryErrorControlled);
@ -366,7 +367,11 @@ begin
ErrorFmt(KMN_E_Install_InvalidFile, VarArrayOf([ExtractFileName(FileName), E.Message]));
end;
FDefaultHKL := GetDefaultHKL;
FDefaultHKL := Context.DefaultLangID;
if FDefaultHKL = 0 then
FDefaultHKL := GetDefaultHKL;
FDefaultBCP47 := Context.DefaultBCP47;
KeyboardID := GetShortKeyboardName(FileName);
@ -456,12 +461,6 @@ begin
begin
FLanguages := GetLanguageCodesFromKeyboard(ki);
//
// Final fallback is to install against default language for system // I4607
//
if Length(FLanguages) = 0 then
AddLanguage(HKLToLanguageID(FDefaultHKL));
for i := 0 to High(Flanguages) do
if TMitigateWin10_1803.IsMitigationRequired(FLanguages[i], ml) then
begin
@ -483,6 +482,19 @@ begin
i: Integer;
BCP47Tag: string;
begin
if Length(FLanguages) = 0 then
begin
//
// Final fallback is to install against default language for system
//
kpil := TKPInstallKeyboardLanguage.Create(Context);
try
kpil.RegisterTip(KeyboardID, FDefaultBCP47, KeyboardName, FDefaultHKL, FIconFileName, ''); //TODO: language name
finally
kpil.Free;
end;
r.WriteString(FDefaultBCP47, ''); // TODO: language name
end;
for i := 0 to High(FLanguages) do
begin
BCP47Tag := TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47(FLanguages[i]);

7
windows/src/global/delphi/general/Keyman.System.CanonicalLanguageCodeUtils.pas
View file

@ -14,6 +14,7 @@ implementation
uses
BCP47Tag,
GetOsVersion,
Keyman.System.LanguageCodeUtils,
Keyman.System.Standards.LangTagsRegistry,
System.SysUtils;
@ -34,6 +35,12 @@ var
t: TBCP47Tag;
LangTag: TLangTag;
begin
// We do not try and canonicalize language tags on Windows 7, because it does
// not follow the same patterns as for later versions of Windows. For example,
// zh-CN is not canonicalized to zh-Hans-CN
if GetOs = osWin7 then
Exit(Tag);
if Tag = '' then
Exit('');

102
windows/src/global/delphi/general/klog.pas
View file

@ -1,18 +1,18 @@
(*
Name: klog
Copyright: Copyright (C) SIL International.
Documentation:
Description:
Documentation:
Description:
Create Date: 1 Aug 2006
Modified Date: 8 Jun 2012
Authors: mcdurdin
Related Files:
Dependencies:
Related Files:
Dependencies:
Bugs:
Todo:
Notes:
Bugs:
Todo:
Notes:
History: 01 Aug 2006 - mcdurdin - Disable logging with KLOGGING define
14 Sep 2006 - mcdurdin - Add Current Tick Count to logs (for correlation with system.log)
04 May 2012 - mcdurdin - I3309 - V9.0 - Migrate to Delphi XE2, VS2010, svn 1.7
@ -23,8 +23,6 @@ unit klog; // I3309
interface
{TNT-IGNORE-UNIT}
{DEFINE KLOGGING}
{$IFDEF KLOGGING}
@ -41,6 +39,7 @@ type
FLogFile: TextFile;
FMethodStack: TStringList;
FFileOpen: Boolean;
function VarRecToString(const vr: TVarRec): string;
{$ENDIF}
public
constructor Create;
@ -50,7 +49,8 @@ type
procedure LogError(const msg: string); overload;
procedure LogError(const msg: string; const fmt: array of const); overload;
procedure MethodEnter(instance: TObject; const name: string; const parameters: array of const);
procedure MethodExit(instance: TObject; const name: string);
procedure MethodExit(instance: TObject; const name: string); overload;
procedure MethodExit(instance: TObject; const name: string; const result: array of const); overload;
end;
function KL: TKLog;
@ -60,8 +60,7 @@ implementation
{$IFDEF KLOGGING}
uses
Variants, Windows, SysUtils, ErrorControlledRegistry, ErrLogPath, VersionInfo, Unicode;
Variants, Windows, SysUtils, ErrorControlledRegistry, KeymanPaths, VersionInfo, Unicode;
{$ENDIF}
var
@ -75,6 +74,7 @@ end;
{ TKLog }
{$WARN SYMBOL_PLATFORM OFF}
constructor TKLog.Create;
{$IFDEF KLOGGING}
@ -88,21 +88,21 @@ constructor TKLog.Create;
var
buf: array[0..260] of char;
FRootPath: string;
begin
inherited Create;
FRootPath := GetErrLogPath;
FMethodStack := TStringList.Create;
GetModuleFileName(hInstance, buf, 260); FAppName := buf;
FLogFileName := FRootPath+ChangeFileExt(ExtractFileName(FAppName), '') + IntToStr(GetCurrentProcessId) + '.log';
GetModuleFileName(hInstance, buf, 260); FAppName := ChangeFileExt(ExtractFileName(buf),'');
FLogFileName := TKeymanPaths.ErrorLogPath(FAppName);
Log(StringOfChar('=', 160));
Log('Starting application '+FAppName+', version '+GetFileVersionString(FAppName));
Log('Starting application %s, version %s', [FAppName, GetFileVersionString(FAppName)]);
Log('Command line: %s', [String(CmdLine)]);
{$ELSE}
begin
inherited Create;
{$ENDIF}
end;
{$WARN SYMBOL_PLATFORM DEFAULT}
destructor TKLog.Destroy;
{$IFDEF KLOGGING}
@ -163,26 +163,7 @@ begin
begin
vr := TVarRec(parameters[i]);
if i > Low(parameters) then s := s + ', ';
case vr.VType of
vtInteger: s := s + IntToStr(vr.VInteger);
vtBoolean: if vr.VBoolean then s := s + 'True' else s := s + 'False';
vtChar: s := s + ''''+Char(vr.VChar)+''''; // I3310
vtExtended: s := s + FloatToStr(vr.VExtended^);
vtString: s := s + ''''+String_AtoU(vr.VString^)+''''; // I3310 // I3310
vtPointer: s := s + '$'+IntToHex(Integer(vr.VPointer), 8);
vtPChar: s := s + ''''+String_AtoU(vr.VPChar)+''''; // I3310
vtObject: if vr.VObject = nil then s := s + 'object <nil>' else s := s + 'object '+vr.VObject.ClassName+' [$'+IntToHex(Integer(Pointer(vr.VObject)), 8)+']';
vtClass: if vr.VClass = nil then s := s + 'class <nil>' else s := s + 'class '+vr.VClass.ClassName;
vtWideChar: s := s + ''''+vr.VWideChar+'''';
vtPWideChar: s := s + ''''+vr.VPWideChar+'''';
vtAnsiString: s := s + ''''+string(vr.VAnsiString)+'''';
vtCurrency: s := s + CurrToStr(vr.VCurrency^);
vtVariant: try s := s + VarToStr(vr.VVariant^); except s := s + '<error reading variant>'; end;
vtInterface: s := s + 'interface $'+IntToHex(Integer(vr.VInterface), 8);
vtWideString: s := s + ''''+widestring(vr.VWideString)+'''';
vtInt64: s := s + IntToStr(vr.VInt64^);
vtUnicodeString: s := s + ''''+WideString(vr.VUnicodeString)+''''; // I3309
end;
s := s + VarRecToString(vr);
end;
if Assigned(instance) then
begin
@ -199,6 +180,26 @@ begin
{$ENDIF}
end;
procedure TKLog.MethodExit(instance: TObject; const name: string; const result: array of const);
{$IFDEF KLOGGING}
var
s: string;
begin
if Assigned(instance)
then s := instance.ClassName+'.'+name
else s := name;
while (FMethodStack.Count > 0) and (FMethodStack[FMethodStack.Count-1] <> s) do
begin
Log(FMethodStack[FMethodStack.Count-1] + ' not exiting properly!');
FMethodStack.Delete(FMethodStack.Count-1);
end;
if FMethodStack.Count > 0 then FMethodStack.Delete(FMethodStack.Count-1);
Log(s+'() exit('+VarRecToString(TVarRec(result[0]))+')');
{$ELSE}
begin
{$ENDIF}
end;
procedure TKLog.MethodExit(instance: TObject; const name: string);
{$IFDEF KLOGGING}
var
@ -226,6 +227,33 @@ begin
{$ENDIF}
end;
{$IFDEF KLOGGING}
function TKLog.VarRecToString(const vr: TVarRec): string;
begin
case vr.VType of
vtInteger: Result := IntToStr(vr.VInteger);
vtBoolean: if vr.VBoolean then Result := 'True' else Result := 'False';
vtChar: Result := ''''+Char(vr.VChar)+''''; // I3310
vtExtended: Result := FloatToStr(vr.VExtended^);
vtString: Result := ''''+String_AtoU(vr.VString^)+''''; // I3310 // I3310
vtPointer: Result := '$'+IntToHex(Integer(vr.VPointer), 8);
vtPChar: Result := ''''+String_AtoU(vr.VPChar)+''''; // I3310
vtObject: if vr.VObject = nil then Result := 'object <nil>' else Result := 'object '+vr.VObject.ClassName+' [$'+IntToHex(Integer(Pointer(vr.VObject)), 8)+']';
vtClass: if vr.VClass = nil then Result := 'class <nil>' else Result := 'class '+vr.VClass.ClassName;
vtWideChar: Result := ''''+vr.VWideChar+'''';
vtPWideChar: Result := ''''+vr.VPWideChar+'''';
vtAnsiString: Result := ''''+string(vr.VAnsiString)+'''';
vtCurrency: Result := CurrToStr(vr.VCurrency^);
vtVariant: try Result := VarToStr(vr.VVariant^); except Result := '<error reading variant>'; end;
vtInterface: Result := 'interface $'+IntToHex(Integer(vr.VInterface), 8);
vtWideString: Result := ''''+widestring(vr.VWideString)+'''';
vtInt64: Result := IntToStr(vr.VInt64^);
vtUnicodeString: Result := ''''+UnicodeString(vr.VUnicodeString)+''''; // I3309
else Result := '???';
end;
end;
{$ENDIF}
function KLEnabled: Boolean;
begin
{$IFDEF KLOGGING}

18
windows/src/unit-tests/standards-data/GetOsVersion.pas Normal file
View file

@ -0,0 +1,18 @@
unit GetOsVersion;
interface
// This is a stub version of GetOsVersion for unit tests
type
TOS = (osLegacy, osVista, osWin7, osWin8, osWin10, osOther);
function GetOs: TOS;
implementation
function GetOs: TOS;
begin
Result := osWin10;
end;
end.

3
windows/src/unit-tests/standards-data/standardsdata.dpr
View file

@ -22,7 +22,8 @@ uses
Keyman.System.Standards.LangTagsRegistry in '..\..\global\delphi\standards\Keyman.System.Standards.LangTagsRegistry.pas',
Keyman.System.Standards.LCIDToBCP47Registry in '..\..\global\delphi\standards\Keyman.System.Standards.LCIDToBCP47Registry.pas',
utilstr in '..\..\global\delphi\general\utilstr.pas',
Unicode in '..\..\global\delphi\general\Unicode.pas';
Unicode in '..\..\global\delphi\general\Unicode.pas',
GetOsVersion in 'GetOsVersion.pas';
var
runner : ITestRunner;

3
windows/src/unit-tests/standards-data/standardsdata.dproj
View file

@ -96,6 +96,7 @@
<DCCReference Include="..\..\global\delphi\standards\Keyman.System.Standards.LCIDToBCP47Registry.pas"/>
<DCCReference Include="..\..\global\delphi\general\utilstr.pas"/>
<DCCReference Include="..\..\global\delphi\general\Unicode.pas"/>
<DCCReference Include="GetOsVersion.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
@ -133,7 +134,7 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\standardsdata.exe" Configuration="Debug" Class="ProjectOutput">
<DeployFile LocalName="bin\Win32\Debug\standardsdata.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>standardsdata.exe</RemoteName>
<Overwrite>true</Overwrite>