diff --git a/windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas b/windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas index 5ec46eff14..b91bc535e5 100644 --- a/windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas +++ b/windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas @@ -33,7 +33,11 @@ type class function GetFirstLanguage(Keyboard: IKeymanKeyboardFile): string; overload; /// Get the BCP47 tag for the user's default language - class function GetUserDefaultLanguage: string; static; + class function GetUserDefaultLanguage: string; overload; static; + class procedure GetUserDefaultLanguage(var BCP47: string; var LangID: Integer); overload; static; + + /// Get the -default-lang parameter string for kmshell + 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\, 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; diff --git a/windows/src/desktop/kmshell/install/Keyman.Configuration.UI.InstallFile.pas b/windows/src/desktop/kmshell/install/Keyman.Configuration.UI.InstallFile.pas index 5b0a52dc5f..5c7a8ee1fb 100644 --- a/windows/src/desktop/kmshell/install/Keyman.Configuration.UI.InstallFile.pas +++ b/windows/src/desktop/kmshell/install/Keyman.Configuration.UI.InstallFile.pas @@ -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); diff --git a/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas b/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas index 6250db1030..34421ca37e 100644 --- a/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas +++ b/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas @@ -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 diff --git a/windows/src/desktop/kmshell/main/initprog.pas b/windows/src/desktop/kmshell/main/initprog.pas index c3f8f1c990..19397c09ce 100644 --- a/windows/src/desktop/kmshell/main/initprog.pas +++ b/windows/src/desktop/kmshell/main/initprog.pas @@ -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); diff --git a/windows/src/engine/kmcomapi/com/keyman_implementation.pas b/windows/src/engine/kmcomapi/com/keyman_implementation.pas index 74766bad76..fe0c117fa5 100644 --- a/windows/src/engine/kmcomapi/com/keyman_implementation.pas +++ b/windows/src/engine/kmcomapi/com/keyman_implementation.pas @@ -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); diff --git a/windows/src/engine/kmcomapi/keymanapi_TLB.pas b/windows/src/engine/kmcomapi/keymanapi_TLB.pas index 56ec2f90e7..3ceb5b15cd 100644 --- a/windows/src/engine/kmcomapi/keymanapi_TLB.pas +++ b/windows/src/engine/kmcomapi/keymanapi_TLB.pas @@ -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 diff --git a/windows/src/engine/kmcomapi/keymancontext.pas b/windows/src/engine/kmcomapi/keymancontext.pas index 085810eb2d..fdd3e76567 100644 --- a/windows/src/engine/kmcomapi/keymancontext.pas +++ b/windows/src/engine/kmcomapi/keymancontext.pas @@ -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 diff --git a/windows/src/engine/kmcomapi/kmcomapi.dproj b/windows/src/engine/kmcomapi/kmcomapi.dproj index b11ff10ddc..f35aff8706 100644 --- a/windows/src/engine/kmcomapi/kmcomapi.dproj +++ b/windows/src/engine/kmcomapi/kmcomapi.dproj @@ -124,7 +124,7 @@ false false - ..\..\desktop\kmshell\kmshell.exe + ..\..\desktop\kmshell\bin\win32\debug\kmshell.exe CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) -c false diff --git a/windows/src/engine/kmcomapi/kmcomapi.ridl b/windows/src/engine/kmcomapi/kmcomapi.ridl index bdee680f06..ac20310a87 100644 --- a/windows/src/engine/kmcomapi/kmcomapi.ridl +++ b/windows/src/engine/kmcomapi/kmcomapi.ridl @@ -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) diff --git a/windows/src/engine/kmcomapi/processes/keyboard/kpinstallkeyboard.pas b/windows/src/engine/kmcomapi/processes/keyboard/kpinstallkeyboard.pas index e91cab0eeb..147bb9aef6 100644 --- a/windows/src/engine/kmcomapi/processes/keyboard/kpinstallkeyboard.pas +++ b/windows/src/engine/kmcomapi/processes/keyboard/kpinstallkeyboard.pas @@ -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]); diff --git a/windows/src/global/delphi/general/Keyman.System.CanonicalLanguageCodeUtils.pas b/windows/src/global/delphi/general/Keyman.System.CanonicalLanguageCodeUtils.pas index 3d13b07a8a..4da9557054 100644 --- a/windows/src/global/delphi/general/Keyman.System.CanonicalLanguageCodeUtils.pas +++ b/windows/src/global/delphi/general/Keyman.System.CanonicalLanguageCodeUtils.pas @@ -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(''); diff --git a/windows/src/global/delphi/general/klog.pas b/windows/src/global/delphi/general/klog.pas index 0915696743..2787f8b347 100644 --- a/windows/src/global/delphi/general/klog.pas +++ b/windows/src/global/delphi/general/klog.pas @@ -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 ' else s := s + 'object '+vr.VObject.ClassName+' [$'+IntToHex(Integer(Pointer(vr.VObject)), 8)+']'; - vtClass: if vr.VClass = nil then s := s + 'class ' 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 + ''; 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 ' else Result := 'object '+vr.VObject.ClassName+' [$'+IntToHex(Integer(Pointer(vr.VObject)), 8)+']'; + vtClass: if vr.VClass = nil then Result := 'class ' 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 := ''; 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} diff --git a/windows/src/unit-tests/standards-data/GetOsVersion.pas b/windows/src/unit-tests/standards-data/GetOsVersion.pas new file mode 100644 index 0000000000..a3068b51cd --- /dev/null +++ b/windows/src/unit-tests/standards-data/GetOsVersion.pas @@ -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. diff --git a/windows/src/unit-tests/standards-data/standardsdata.dpr b/windows/src/unit-tests/standards-data/standardsdata.dpr index 5b5d0da7b9..913eaff544 100644 --- a/windows/src/unit-tests/standards-data/standardsdata.dpr +++ b/windows/src/unit-tests/standards-data/standardsdata.dpr @@ -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; diff --git a/windows/src/unit-tests/standards-data/standardsdata.dproj b/windows/src/unit-tests/standards-data/standardsdata.dproj index fd12709617..6787b3dab3 100644 --- a/windows/src/unit-tests/standards-data/standardsdata.dproj +++ b/windows/src/unit-tests/standards-data/standardsdata.dproj @@ -96,6 +96,7 @@ + Cfg_2 Base @@ -133,7 +134,7 @@ true - + standardsdata.exe true