From e86704b702ccb5d537f0cf9795768ca4ebcb7d2e Mon Sep 17 00:00:00 2001
From: Marc Durdin <marc@durdin.net>
Date: Mon, 19 Apr 2021 10:39:49 +1000
Subject: [PATCH] fix(windows): crash when installing TIP in some rare
 situations

May fix #4889.

In some situations, Keyman is unable to precisely match the user's
default language with its own keyboard settings. In this situation,
Keyman may crash when attempting to install the TIP, or may give a
spurious error such as "Too many transient languages" or similar.

I have been unable to reproduce the crash described in #4889 on my
machines so this is an attempted fix.

This does fix a bug with default languages in any case so is a good fix
to include: if the user's default language is not found in Keyman's LCID
table, then Keyman would fail to install the TIP when the keyboard is
installed and would return an error message (but not crash).
---
 ...an.Configuration.System.TIPMaintenance.pas | 57 ++++++++++++++++++-
 .../global/delphi/general/RegistryKeys.pas    |  1 +
 2 files changed, 56 insertions(+), 2 deletions(-)

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 66afe0608c..c307f24faf 100644
--- a/windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas
+++ b/windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas
@@ -43,6 +43,7 @@ implementation
 
 uses
   System.SysUtils,
+  System.Win.Registry,
   Winapi.Windows,
 
   Keyman.System.LanguageCodeUtils,
@@ -50,8 +51,10 @@ uses
   BCP47Tag,
   glossary,
   kmint,
+  RegistryKeys,
   utilkmshell,
-  utilexecute;
+  utilexecute,
+  utilsystem;
 
 { TTIPMaintenance }
 
@@ -199,8 +202,58 @@ begin
 end;
 
 class function TTIPMaintenance.GetUserDefaultLanguage: string;
+var
+  r: TRegistry;
+  tags: TStringList;
+  v: string;
+  keys: TStringList;
+  key: string;
 begin
-  Result := TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47(HKLToLanguageID(GetDefaultHKL))
+  // Fallback result
+  Result := TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47(HKLToLanguageID(GetDefaultHKL));
+
+  // 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
+          if r.OpenKeyReadOnly('\' + SRegKey_ControlPanelInternationalUserProfile + '\' + key) and
+            r.ValueExists(v) then
+          begin
+            Result := key;
+            Break;
+          end;
+        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;
+      finally
+        tags.Free;
+      end;
+    end;
+  finally
+    r.Free;
+  end;
 end;
 
 class function TTIPMaintenance.GetFirstLanguage(Keyboard: IKeymanKeyboardFile): string;
diff --git a/windows/src/global/delphi/general/RegistryKeys.pas b/windows/src/global/delphi/general/RegistryKeys.pas
index 2c6f5d49d2..06d4dedbe0 100644
--- a/windows/src/global/delphi/general/RegistryKeys.pas
+++ b/windows/src/global/delphi/general/RegistryKeys.pas
@@ -270,6 +270,7 @@ const
   SRegValue_CPIUP_Languages = 'Languages';
   SRegValue_CPIUP_TransientLangId = 'TransientLangId';
   SRegValue_CPIUP_CachedLanguageName = 'CachedLanguageName';
+  SRegValue_CPIUP_InputMethodOverride = 'InputMethodOverride';
 
   { User profile keys }