From d86a3d23059b9be76478b9725c4a50e4b76ace73 Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Mon, 26 Oct 2020 08:44:24 +1100 Subject: [PATCH 1/8] fix(windows): remove FRefreshKeyman parameter from Content_Render FRefreshKeyman parameter was no longer used; clean it up. --- windows/src/desktop/kmshell/help/UfrmHelp.pas | 2 +- .../src/desktop/kmshell/install/UfrmInstallKeyboard.pas | 2 +- windows/src/desktop/kmshell/main/UfrmKeepInTouch.pas | 5 ++--- windows/src/desktop/kmshell/main/UfrmMain.pas | 2 +- .../desktop/kmshell/main/UfrmOnlineUpdateNewVersion.pas | 2 +- windows/src/global/delphi/hints/UfrmHint.pas | 2 +- windows/src/global/delphi/ui/UfrmWebContainer.pas | 7 +++---- 7 files changed, 10 insertions(+), 12 deletions(-) diff --git a/windows/src/desktop/kmshell/help/UfrmHelp.pas b/windows/src/desktop/kmshell/help/UfrmHelp.pas index 9d421bd628..fb71624ab8 100644 --- a/windows/src/desktop/kmshell/help/UfrmHelp.pas +++ b/windows/src/desktop/kmshell/help/UfrmHelp.pas @@ -131,7 +131,7 @@ begin then FQuery := Format('?keyboard=%s', [UrlEncode(FActiveKeyboard.Name)]) else FQuery := ''; - Content_Render(False, FQuery); + Content_Render(FQuery); inherited; end; diff --git a/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas b/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas index 44e27778ff..64969ebf1f 100644 --- a/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas +++ b/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas @@ -205,7 +205,7 @@ begin Data := TInstallKeyboardSharedData.Create(FXML, FTempPath, FPackagePath, FFiles); PageTag := modWebHttpServer.SharedData.Add(Data); FRenderPage := 'installkeyboard'; - Content_Render(False, 'tag='+IntToStr(PageTag)); + Content_Render('tag='+IntToStr(PageTag)); finally Screen.Cursor := crDefault; end; diff --git a/windows/src/desktop/kmshell/main/UfrmKeepInTouch.pas b/windows/src/desktop/kmshell/main/UfrmKeepInTouch.pas index 68dccd14dd..a4f72cdcef 100644 --- a/windows/src/desktop/kmshell/main/UfrmKeepInTouch.pas +++ b/windows/src/desktop/kmshell/main/UfrmKeepInTouch.pas @@ -31,7 +31,7 @@ type private { Private declarations } protected - procedure Content_Render(FRefreshKeyman: Boolean = False; const Query: string = ''); override; + procedure Content_Render(const Query: string = ''); override; procedure FireCommand(const command: WideString; params: TStringList); override; public { Public declarations } @@ -86,8 +86,7 @@ begin end; end; -procedure TfrmKeepInTouch.Content_Render(FRefreshKeyman: Boolean; - const Query: string); +procedure TfrmKeepInTouch.Content_Render(const Query: string); var FPath: string; begin diff --git a/windows/src/desktop/kmshell/main/UfrmMain.pas b/windows/src/desktop/kmshell/main/UfrmMain.pas index 5d9e0617c3..d98d3e6899 100644 --- a/windows/src/desktop/kmshell/main/UfrmMain.pas +++ b/windows/src/desktop/kmshell/main/UfrmMain.pas @@ -309,7 +309,7 @@ begin FKeyboardXMLRenderer.FileReferences.ToStringArray ); - Content_Render(FRefreshKeyman, 'tag='+IntToStr(FPageTag)); + Content_Render('tag='+IntToStr(FPageTag)); end; procedure TfrmMain.FireCommand(const command: WideString; params: TStringList); diff --git a/windows/src/desktop/kmshell/main/UfrmOnlineUpdateNewVersion.pas b/windows/src/desktop/kmshell/main/UfrmOnlineUpdateNewVersion.pas index 9c3e02159a..44ec54e453 100644 --- a/windows/src/desktop/kmshell/main/UfrmOnlineUpdateNewVersion.pas +++ b/windows/src/desktop/kmshell/main/UfrmOnlineUpdateNewVersion.pas @@ -107,7 +107,7 @@ begin PageTag := modWebHttpServer.SharedData.Add(Data); FRenderPage := 'onlineupdate'; - Content_Render(False, 'tag='+IntToStr(PageTag)); + Content_Render('tag='+IntToStr(PageTag)); end; end. diff --git a/windows/src/global/delphi/hints/UfrmHint.pas b/windows/src/global/delphi/hints/UfrmHint.pas index ceb06d502f..7b6e307925 100644 --- a/windows/src/global/delphi/hints/UfrmHint.pas +++ b/windows/src/global/delphi/hints/UfrmHint.pas @@ -104,7 +104,7 @@ begin ]); FRenderPage := 'hint'; - Content_Render(False, query); + Content_Render(query); inherited; end; diff --git a/windows/src/global/delphi/ui/UfrmWebContainer.pas b/windows/src/global/delphi/ui/UfrmWebContainer.pas index 76de98bda6..2efbaec8bc 100644 --- a/windows/src/global/delphi/ui/UfrmWebContainer.pas +++ b/windows/src/global/delphi/ui/UfrmWebContainer.pas @@ -81,7 +81,7 @@ type function IsLocalUrl(const url: string): Boolean; - procedure Content_Render(FRefreshKeyman: Boolean = False; const Query: string = ''); virtual; + procedure Content_Render(const Query: string = ''); virtual; procedure WndProc(var Message: TMessage); override; // I2720 public constructor Create(AOwner: TComponent); override; @@ -123,8 +123,7 @@ begin Application.CreateForm(InstanceClass, Reference); end; -procedure TfrmWebContainer.Content_Render(FRefreshKeyman: Boolean; - const Query: string); +procedure TfrmWebContainer.Content_Render(const Query: string); var FWidth, FHeight: Integer; begin @@ -147,7 +146,7 @@ end; procedure TfrmWebContainer.Do_Content_Render(FRefreshKeyman: Boolean); begin - Content_Render(FRefreshKeyman); // I4088 + Content_Render; // I4088 end; constructor TfrmWebContainer.Create(AOwner: TComponent); From 36d6f8d24208e9f915b2ff348e65f343ef19180a Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Mon, 26 Oct 2020 08:48:12 +1100 Subject: [PATCH 2/8] fix(windows): remove obsolete install/uninstall functions The Addins install command and Visual Keyboard install command are no longer used and thus removed. --- windows/src/desktop/kmshell/main/UfrmMain.pas | 101 ------------------ 1 file changed, 101 deletions(-) diff --git a/windows/src/desktop/kmshell/main/UfrmMain.pas b/windows/src/desktop/kmshell/main/UfrmMain.pas index d98d3e6899..b44173f9ac 100644 --- a/windows/src/desktop/kmshell/main/UfrmMain.pas +++ b/windows/src/desktop/kmshell/main/UfrmMain.pas @@ -96,11 +96,6 @@ type DebuggingChecked: Boolean; // I3630 - dlgOpenAddin: TOpenDialog; - dlgOpenVisualKeyboard: TOpenDialog; - - procedure dlgOpenVisualKeyboardCanClose(Sender: TObject; var CanClose: Boolean); - procedure Keyboard_Install; procedure Keyboard_Uninstall(Params: TStringList); procedure Keyboard_Options(Params: TStringList); @@ -109,7 +104,6 @@ type function Keyboards_Save: Boolean; function Options_Save: Boolean; procedure Options_Init; - procedure InitNonVisualComponents; procedure Keyboard_ClickCheck(params: TStringList); function GetKeyboardFromParams(params: TStringList; out kbd: IKeymanKeyboardInstalled): Boolean; function GetPackageFromParams(params: TStringList; out pkg: IKeymanPackageInstalled): Boolean; @@ -118,9 +112,6 @@ type procedure Footer_Ok; procedure Footer_Cancel; - procedure Keyboard_InstallVisualKeyboard(params: TStringList); - procedure Keyboard_UninstallVisualKeyboard(params: TStringList); - procedure Options_ClickCheck(params: TStringList); function GetOptionFromParams(params: TStringList; out option: IKeymanOption): Boolean; procedure Options_ResetHints; @@ -225,8 +216,6 @@ begin kmcom.AutoApply := False; - InitNonVisualComponents; - Icon.ReleaseHandle; Icon.Handle := DuplicateIcon(hInstance, Application.Icon.Handle); @@ -320,8 +309,6 @@ begin else if command = 'keyboard_uninstall' then Keyboard_Uninstall(params) else if command = 'keyboard_options' then Keyboard_Options(params) else if command = 'keyboard_clickcheck' then Keyboard_ClickCheck(params) - else if command = 'keyboard_installvisualkeyboard' then Keyboard_InstallVisualKeyboard(params) - else if command = 'keyboard_uninstallvisualkeyboard' then Keyboard_UninstallVisualKeyboard(params) else if command = 'keyboardlanguage_install' then KeyboardLanguage_Install(params) // I3624 else if command = 'keyboardlanguage_uninstall' then KeyboardLanguage_Uninstall(params) // I3624 @@ -381,21 +368,6 @@ begin kmcom.Apply; // I1338 - eliminate unneccesary re-render end; -procedure TfrmMain.InitNonVisualComponents; -begin - dlgOpenAddin := TOpenDialog.Create(Self); - dlgOpenAddin.Filter := - 'Keyman add-ins (*.kma, *.kmp)|*.kma;*.kmp|Keyman add-in files (*' + - '.kma)|*.kma|Keyman packaged add-ins (*.kmp)|*.kmp|All files (*.*' + - ')|*.*'; - dlgOpenAddin.Title := 'Install Add-in'; - - dlgOpenVisualKeyboard := TOpenDialog.Create(Self); - dlgOpenVisualKeyboard.Filter := 'On screen keyboard files (*.kvk)|*.kvk|All files (*.*)|*.*'; - dlgOpenVisualKeyboard.Title := 'Install Keyman Keyboard'; - dlgOpenVisualKeyboard.OnCanClose := dlgOpenVisualKeyboardCanClose; -end; - {------------------------------------------------------------------------------- - Parsing parameters from url callback in web page - ------------------------------------------------------------------------------} @@ -630,25 +602,6 @@ begin kbd.Loaded := StrToBool(params.Values['value']); //, 'true'); end; -procedure TfrmMain.Keyboard_InstallVisualKeyboard(params: TStringList); -var - kbd: IKeymanKeyboardInstalled; -begin - if GetKeyboardFromParams(params, kbd) and not Assigned(kbd.VisualKeyboard) then - if dlgOpenVisualKeyboard.Execute then - begin - try - kbd.InstallVisualKeyboard(dlgOpenVisualKeyboard.FileName); - except - on E:EOleException do // I1084, I1005 - Installing an invalid KVK file - ShowMessage(E.Message); - end; - kbd := nil; // I773 - mcd - because Do_Content_Render reloads the keyman objects when Refresh-Keyman=true - Do_Content_Render(True); - end; - kbd := nil; -end; - procedure TfrmMain.Keyboard_Options(Params: TStringList); var kbd: IKeymanKeyboardInstalled; @@ -668,60 +621,6 @@ begin end; end; -procedure TfrmMain.Keyboard_UninstallVisualKeyboard(params: TStringList); -var - kbd: IKeymanKeyboardInstalled; - vk: IKeymanVisualKeyboard; -begin - if GetKeyboardFromParams(params, kbd) then - begin - vk := kbd.VisualKeyboard; - if Assigned(vk) and (MessageDlg(MsgFromIdFormat(SKUninstallOnScreenKeyboard, [kbd.Name]), - mtConfirmation, mbOkCancel, 0) = mrOk) then - begin - try - vk.Uninstall; - vk := nil; - except - on E:EOleException do // I1084, I1005 - Installing an invalid KVK file - ShowMessage(E.Message); - end; - kbd := nil; // I773 - mcd - because Do_Content_Render reloads the keyman objects when Refresh-Keyman=true - Do_Content_Render(True); - end; - kbd := nil; - end; -end; - -procedure TfrmMain.dlgOpenVisualKeyboardCanClose(Sender: TObject; var CanClose: Boolean); -begin -{ CanClose := False; - if FileExists(dlgOpenVisualKeyboard.FileName) then - begin - try - with TVisualKeyboard.Create do - try - LoadFromFile(dlgOpenVisualKeyboard.FileName); - if LowerCase(Header.AssociatedKeyboard) = - LowerCase(SelectedRegKeyboard.Name) then - CanClose := True - else if MessageDlg('This visual keyboard is not designed for the keyboard you have selected. Use it anyway?', - mtConfirmation, mbOkCancel, 0) = mrOk then - CanClose := True; - finally - Free; - end; - except - on E:Exception do - begin - WideShowMessage(E.Message); - CanClose := False; - end; - end; - //if IsVisualKeyboardAssociatedWithCorrectFile then CanClose := True; - end;} -end; - {------------------------------------------------------------------------------- - Options tab - ------------------------------------------------------------------------------} From 82e15bead02e5bf4f7c604810e3f794b6d3cf30e Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Mon, 26 Oct 2020 09:10:02 +1100 Subject: [PATCH 3/8] fix(windows): remove obsolete Reboot flag The Reboot flag was never set by any Keyman code any longer. Thus, removing to simplify code pathways for applying config changes. --- .../kmshell/main/OnlineUpdateCheck.pas | 7 +-- windows/src/desktop/kmshell/main/UfrmMain.pas | 32 +---------- windows/src/desktop/kmshell/main/initprog.pas | 3 - .../desktop/kmshell/startup/UfrmSplash.pas | 4 -- .../src/desktop/kmshell/util/utilkmshell.pas | 57 ------------------- .../kmcomapi/com/system/keymansysteminfo.pas | 6 +- .../src/engine/kmcomapi/processes/kpbase.pas | 6 -- .../kmcomapi/util/internalinterfaces.pas | 2 - 8 files changed, 6 insertions(+), 111 deletions(-) diff --git a/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas b/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas index 58424a665d..09a4950c8f 100644 --- a/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas +++ b/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas @@ -47,7 +47,7 @@ uses type EOnlineUpdateCheck = class(Exception); - TOnlineUpdateCheckResult = (oucUnknown, oucShutDown, oucSuccess, oucNoUpdates, oucFailure, oucSuccessReboot, oucOffline); + TOnlineUpdateCheckResult = (oucUnknown, oucShutDown, oucSuccess, oucNoUpdates, oucFailure, oucOffline); TOnlineUpdateCheckParamsPackage = record ID: string; @@ -194,7 +194,7 @@ function TOnlineUpdateCheck.Run: TOnlineUpdateCheckResult; begin Result := DoRun; - if Result in [oucShutDown, oucSuccess, oucSuccessReboot] then + if Result in [oucShutDown, oucSuccess] then begin kmcom.Keyboards.Refresh; kmcom.Keyboards.Apply; @@ -487,9 +487,6 @@ begin end; end; end; - - if (FParams.Result = oucSuccess) and kmcom.SystemInfo.RebootRequired then - FParams.Result := oucSuccessReboot; end; procedure TOnlineUpdateCheck.ShutDown; diff --git a/windows/src/desktop/kmshell/main/UfrmMain.pas b/windows/src/desktop/kmshell/main/UfrmMain.pas index b44173f9ac..016499245d 100644 --- a/windows/src/desktop/kmshell/main/UfrmMain.pas +++ b/windows/src/desktop/kmshell/main/UfrmMain.pas @@ -131,7 +131,6 @@ type procedure RefreshKeymanConfiguration; procedure Keyboard_Download; function GetHotkeyLanguageFromParams(params: TStringList; out lang: IKeymanLanguage): Boolean; - function MustReboot: Boolean; function SaveAll: Boolean; procedure KeyboardLanguage_Install(Params: TStringList); // I3624 procedure KeyboardLanguage_Uninstall(Params: TStringList); // I3624 @@ -239,12 +238,6 @@ procedure TfrmMain.TntFormClose(Sender: TObject; var Action: TCloseAction); begin inherited; FClosing := True; - - KL.Log('Testing kmcom.errors.rebootrequired: %s', [booltostr(kmcom.SystemInfo.RebootRequired)]); - if kmcom.SystemInfo.RebootRequired then - RunReboot('Windows must be restarted for changes to complete. Restart now?', - 'Windows did not initiate the restart successfully. You will need to restart manually.'); - Action := caFree; end; @@ -475,8 +468,6 @@ end; procedure TfrmMain.Keyboard_Install; begin - if MustReboot then Exit; // I2789 - if TInstallFile.BrowseAndInstallKeyboardFromFile(Self) then begin RefreshKeymanConfiguration; @@ -488,8 +479,6 @@ var kbd: IKeymanKeyboardInstalled; kbdID: WideString; begin - if MustReboot then Exit; // I2789 - if GetKeyboardFromParams(params, kbd) then begin { I1201 - Fix crash uninstalling admin-installed keyboards and packages } @@ -507,8 +496,6 @@ procedure TfrmMain.KeyboardLanguage_Uninstall(Params: TStringList); // I3624 var kbdlang: IKeymanKeyboardLanguageInstalled; begin - if MustReboot then Exit; // I2789 - if GetKeyboardLanguageFromParams(params, kbdlang) then begin // TODO: refactor this away? @@ -523,8 +510,6 @@ procedure TfrmMain.KeyboardLanguage_Install(Params: TStringList); // I3624 var kbd: IKeymanKeyboardInstalled; begin - if MustReboot then Exit; // I2789 - if GetKeyboardFromParams(params, kbd) then begin { I1201 - Fix crash uninstalling admin-installed keyboards and packages } @@ -545,8 +530,6 @@ var pkg: IKeymanPackageInstalled; pkgID: WideString; begin - if MustReboot then Exit; // I2789 - if GetPackageFromParams(params, pkg) then begin { I1201 - Fix crash uninstalling admin-installed keyboards and packages } @@ -559,19 +542,6 @@ begin end; end; -function TfrmMain.MustReboot: Boolean; -begin - KL.Log('Testing kmcom.errors.rebootrequired before install/uninstall of keyboards: %s', [booltostr(kmcom.SystemInfo.RebootRequired)]); - if kmcom.SystemInfo.RebootRequired then - begin - Result := True; - RunReboot('Windows must be restarted for changes to complete before you can install or uninstall any more keyboards. Restart now?', - 'Windows did not initiate the restart successfully. You will need to restart manually.'); - end - else - Result := False; -end; - procedure TfrmMain.Package_Welcome(Params: TStringList); var pkg: IKeymanPackageInstalled; @@ -769,7 +739,7 @@ begin on E:Exception do KL.Log(E.Message); end; end; - oucSuccess, oucSuccessReboot: + oucSuccess: RefreshKeymanConfiguration; end finally diff --git a/windows/src/desktop/kmshell/main/initprog.pas b/windows/src/desktop/kmshell/main/initprog.pas index b7e1b115ba..79c60c048b 100644 --- a/windows/src/desktop/kmshell/main/initprog.pas +++ b/windows/src/desktop/kmshell/main/initprog.pas @@ -549,9 +549,6 @@ begin if FMode <> fmMain then begin - if kmcom.SystemInfo.RebootRequired then - RunReboot('Windows must be restarted for changes to complete. Restart now?', - 'Windows did not initiate the restart successfully. You will need to restart manually.'); ApplicationRunning := True; Application.Run; ApplicationRunning := False; diff --git a/windows/src/desktop/kmshell/startup/UfrmSplash.pas b/windows/src/desktop/kmshell/startup/UfrmSplash.pas index 7964086d90..b22fd9848a 100644 --- a/windows/src/desktop/kmshell/startup/UfrmSplash.pas +++ b/windows/src/desktop/kmshell/startup/UfrmSplash.pas @@ -278,10 +278,6 @@ begin until False; - if kmcom.SystemInfo.RebootRequired then - RunReboot('Windows must be restarted for changes to complete. Restart now?', - 'Windows did not initiate the restart successfully. You will need to restart manually.'); - if kmcom.Options[KeymanOptionName(TUtilKeymanOption.koCheckForUpdates)].Value then begin if not kmcom.Control.IsOnlineUpdateCheckOpen then diff --git a/windows/src/desktop/kmshell/util/utilkmshell.pas b/windows/src/desktop/kmshell/util/utilkmshell.pas index 728bbf16b2..66aaf11b67 100644 --- a/windows/src/desktop/kmshell/util/utilkmshell.pas +++ b/windows/src/desktop/kmshell/util/utilkmshell.pas @@ -97,8 +97,6 @@ function ValidDirectory(const dir: string): string; function GetLongFile(APath:String):String; -function RunReboot(const msg, failuremsg: WideString): Boolean; - function TSFInstalled: Boolean; function GetLongFileName(const fname: string): string; @@ -508,61 +506,6 @@ begin while (s <> '') and CharInSet(s[1], [' ', #9, #13, #10]) do Delete(s,1,1); // I3310 end; -function RunReboot(const msg, failuremsg: WideString): Boolean; -var - hToken: THandle; - tkp: TTokenPrivileges; - len: DWord; -begin - Result := False; - KL.Log('RunReboot - enter'); - if (msg <> '') and (MessageDlg(msg, mtWarning, mbOkCancel, 0) = mrCancel) then - begin - KL.Log('RunReboot - cancelled'); - Exit; - end; - - // Get a token for this process. - if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then - begin - KL.Log('RunReboot - failed to OpenProcessToken'); - ShowMessage(failuremsg); - Exit; - end; - - // Get the LUID for the shutdown privilege. - - LookupPrivilegeValue(nil, PCHAR('SeShutdownPrivilege') {SE_SHUTDOWN_NAME}, tkp.Privileges[0].Luid); - - tkp.PrivilegeCount := 1; // one privilege to set - tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; - - // Get the shutdown privilege for this process. - - AdjustTokenPrivileges(hToken, False, tkp, 0, nil, len); - - // Cannot test the return value of AdjustTokenPrivileges. - - if GetLastError() <> ERROR_SUCCESS then - begin - KL.Log('RunReboot - failed to AdjustTokenPrivileges'); - ShowMessage(failuremsg); - Exit; - end; - - // Shut down the system - if not ExitWindowsEx(EWX_REBOOT, 0) then - begin - KL.Log('RunReboot - failed to ExitWindowsEx'); - ShowMessage(failuremsg); - Exit; - end; - - KL.Log('RunReboot - restarting now'); - - Result := True; -end; - function GetLongFile(APath:String):String; var i : Integer; diff --git a/windows/src/engine/kmcomapi/com/system/keymansysteminfo.pas b/windows/src/engine/kmcomapi/com/system/keymansysteminfo.pas index 29486460da..c987bbe2d5 100644 --- a/windows/src/engine/kmcomapi/com/system/keymansysteminfo.pas +++ b/windows/src/engine/kmcomapi/com/system/keymansysteminfo.pas @@ -99,13 +99,13 @@ end; procedure TKeymanSystemInfo.SetReboot; begin - FWantReboot := True; - KL.Log('TKeymanErrors.SetReboot.'); + KL.Log('TKeymanErrors.SetReboot is no longer supported.'); end; function TKeymanSystemInfo.Get_RebootRequired: WordBool; begin - Result := FWantReboot; + KL.Log('TKeymanErrors.RebootRequired always returns False.'); + Result := False; end; end. diff --git a/windows/src/engine/kmcomapi/processes/kpbase.pas b/windows/src/engine/kmcomapi/processes/kpbase.pas index 49734402af..3bfcf5ea25 100644 --- a/windows/src/engine/kmcomapi/processes/kpbase.pas +++ b/windows/src/engine/kmcomapi/processes/kpbase.pas @@ -30,7 +30,6 @@ type procedure ErrorFmt(ErrorCode: Cardinal; Args: OleVariant); procedure Warn(WarnCode: Cardinal); procedure WarnFmt(WarnCode: Cardinal; Args: OleVariant); - procedure SetReboot; deprecated; public constructor Create(AContext: TKeymanContext); destructor Destroy; override; @@ -66,11 +65,6 @@ begin (FContext as TKeymanContext).Errors.AddFmt(ErrorCode, Args, kesError); end; -procedure TKPBase.SetReboot; -begin - (FContext as TKeymanContext).SystemInfo.SetReboot; -end; - procedure TKPBase.Warn(WarnCode: Cardinal); begin (FContext as TKeymanContext).Errors.Add(WarnCode, kesWarning); diff --git a/windows/src/engine/kmcomapi/util/internalinterfaces.pas b/windows/src/engine/kmcomapi/util/internalinterfaces.pas index 25371125c8..6bbfa20d1b 100644 --- a/windows/src/engine/kmcomapi/util/internalinterfaces.pas +++ b/windows/src/engine/kmcomapi/util/internalinterfaces.pas @@ -89,8 +89,6 @@ type IIntKeymanPackagesInstalled = IIntKeymanCollection; IIntKeymanSystemInfo = interface(IIntKeymanInterface) - ['{90E3F800-E232-4C12-B7B0-7EFE43B71585}'] - procedure SetReboot; safecall; end; IIntKeymanOptions = IIntKeymanCollection; From 11a2cf53c5b5b48800925e6c6e9a5bdffba756db Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Mon, 26 Oct 2020 15:18:04 +1100 Subject: [PATCH 4/8] fix(windows): Keyman Configuration changes apply instantly Fixes #3518. Changes in Keyman Configuration will now apply immediately. This removes the OK and Cancel buttons from the dialog and means that all actions are consistent in when they are applied, unlike previously. This also matches the Windows 10 Settings metaphor and metaphors for most modern apps and devices. For now, I have placed a message where the OK and Buttons were previously, to help existing users understand the change. In time, I expect us to be able to remove that message entirely. --- windows/src/desktop/kmshell/main/UfrmMain.pas | 129 ++++++------------ windows/src/desktop/kmshell/xml/config.css | 6 + .../src/desktop/kmshell/xml/keyman_footer.xsl | 24 +--- windows/src/desktop/kmshell/xml/strings.xml | 10 +- .../kmcomapi/com/system/keymancontrol.pas | 39 +++--- 5 files changed, 78 insertions(+), 130 deletions(-) diff --git a/windows/src/desktop/kmshell/main/UfrmMain.pas b/windows/src/desktop/kmshell/main/UfrmMain.pas index 016499245d..57990faee0 100644 --- a/windows/src/desktop/kmshell/main/UfrmMain.pas +++ b/windows/src/desktop/kmshell/main/UfrmMain.pas @@ -93,54 +93,49 @@ type FKeyboardXMLRenderer: TKeyboardListXMLRenderer; FXMLRenderers: TXMLRenderers; - - DebuggingChecked: Boolean; // I3630 + wm_keyman_refresh: Integer; procedure Keyboard_Install; procedure Keyboard_Uninstall(Params: TStringList); procedure Keyboard_Options(Params: TStringList); - procedure Keyboards_Init; - function Keyboards_Save: Boolean; - function Options_Save: Boolean; - procedure Options_Init; + procedure Keyboard_Download; + procedure KeyboardLanguage_Install(Params: TStringList); // I3624 + procedure KeyboardLanguage_Uninstall(Params: TStringList); // I3624 + function GetKeyboardLanguageFromParams(params: TStringList; + out kbdlang: IKeymanKeyboardLanguageInstalled): Boolean; // I3624 procedure Keyboard_ClickCheck(params: TStringList); function GetKeyboardFromParams(params: TStringList; out kbd: IKeymanKeyboardInstalled): Boolean; + function GetPackageFromParams(params: TStringList; out pkg: IKeymanPackageInstalled): Boolean; procedure Package_Uninstall(Params: TStringList); procedure Package_Welcome(Params: TStringList); - procedure Footer_Ok; - procedure Footer_Cancel; + procedure Options_Init; procedure Options_ClickCheck(params: TStringList); function GetOptionFromParams(params: TStringList; out option: IKeymanOption): Boolean; procedure Options_ResetHints; procedure Options_BaseKeyboard; // I4169 - function GetHotkeyFromParams(params: TStringList; - out hotkey: IKeymanHotkey): Boolean; procedure Hotkey_Set(params: TStringList); procedure Hotkey_Clear(params: TStringList); - function Hotkeys_Save: Boolean; + function GetHotkeyFromParams(params: TStringList; + out hotkey: IKeymanHotkey): Boolean; + function GetHotkeyLanguageFromParams(params: TStringList; out lang: IKeymanLanguage): Boolean; + procedure Support_Diagnostics; procedure Support_Online; procedure Support_UpdateCheck; procedure Support_ProxyConfig; procedure Support_ContactSupport(params: TStringList); // I4390 + procedure OpenSite(params: TStringList); procedure RefreshKeymanConfiguration; - procedure Keyboard_Download; - function GetHotkeyLanguageFromParams(params: TStringList; out lang: IKeymanLanguage): Boolean; - function SaveAll: Boolean; - procedure KeyboardLanguage_Install(Params: TStringList); // I3624 - procedure KeyboardLanguage_Uninstall(Params: TStringList); // I3624 - function GetKeyboardLanguageFromParams(params: TStringList; - out kbdlang: IKeymanKeyboardLanguageInstalled): Boolean; // I3624 protected procedure FireCommand(const command: WideString; params: TStringList); override; class function ShouldRegisterWindow: Boolean; override; // I2720 - function ShouldSetAppTitle: Boolean; override; // I2786 + function ShouldSetAppTitle: Boolean; override; // I2786 public procedure Do_Content_Render(FRefreshKeyman: Boolean); override; end; @@ -213,8 +208,6 @@ begin // Prevents keep-in-touch opening in browser cef.ShouldOpenRemoteUrlsInBrowser := False; - kmcom.AutoApply := False; - Icon.ReleaseHandle; Icon.Handle := DuplicateIcon(hInstance, Application.Icon.Handle); @@ -324,43 +317,13 @@ begin else if command = 'contact_support' then Support_ContactSupport(params) // I4390 - else if command = 'opensite' then OpenSite(params) - else if command = 'footer_ok' then Footer_OK - else if command = 'footer_cancel' then Footer_Cancel - else if command = 'help' then Application.HelpJump('context_'+lowercase(DialogName)) else inherited; end; -procedure TfrmMain.Footer_Cancel; -begin - Close; - // Instantiate a new IKeyman, and Apply to force all changes to be consistent - CoKeyman.Create.Apply; -end; - -function TfrmMain.SaveAll: Boolean; // I2789 -begin - Result := - Keyboards_Save and - Options_Save and - Hotkeys_Save; -end; - -procedure TfrmMain.Footer_Ok; -begin - kmcom.AutoApply := False; - - if not SaveAll then Exit; // I2789 - - Close; - - kmcom.Apply; // I1338 - eliminate unneccesary re-render -end; - {------------------------------------------------------------------------------- - Parsing parameters from url callback in web page - ------------------------------------------------------------------------------} @@ -558,18 +521,15 @@ procedure TfrmMain.Keyboards_Init; begin end; -function TfrmMain.Keyboards_Save: Boolean; -begin - kmcom.Keyboards.Apply; - Result := True; -end; - procedure TfrmMain.Keyboard_ClickCheck(params: TStringList); var kbd: IKeymanKeyboardInstalled; begin if GetKeyboardFromParams(params, kbd) then + begin kbd.Loaded := StrToBool(params.Values['value']); //, 'true'); + kmcom.Keyboards.Apply; + end; end; procedure TfrmMain.Keyboard_Options(Params: TStringList); @@ -609,6 +569,14 @@ begin if GetOptionFromParams(params, option) and option.Enabled then begin option.Value := not option.Value; + + if (option.ID = 'koDebugging') and option.Value then + ShowMessage(MsgFromId(SKDebuggingWarning)); + + kmcom.Errors.Clear; + kmcom.Options.Apply; + if kmcom.Errors.Count > 0 then + ShowMessage(kmcom.Errors[0].Description); end else ShowMessage(params.Text); @@ -616,7 +584,6 @@ end; procedure TfrmMain.Options_Init; begin - DebuggingChecked := kmcom.Options['koDebugging'].Value; // I3630 end; procedure TfrmMain.Options_ResetHints; @@ -625,21 +592,6 @@ begin ShowMessage(MsgFromId(SKHintsReset)); end; -function TfrmMain.Options_Save: Boolean; -begin - if (kmcom.Options['koDebugging'].Value <> DebuggingChecked) and kmcom.Options['koDebugging'].Value then - ShowMessage(MsgFromId(SKDebuggingWarning)); - - kmcom.Errors.Clear; - kmcom.Options.Apply; - if kmcom.Errors.Count > 0 then - ShowMessage(kmcom.Errors[0].Description); - - DebuggingChecked := kmcom.Options['koDebugging'].Value; - - Result := True; -end; - {------------------------------------------------------------------------------- - Hotkeys tab - ------------------------------------------------------------------------------} @@ -651,20 +603,23 @@ var begin if GetHotkeyLanguageFromParams(params, lang2) then begin - if ChangeHotkey(Self, MsgFromIdFormat(SKSetHotkey_Language, [lang2.LocaleName + ' ('+lang2.LayoutName+')']), lang2.Hotkey) then - begin - Do_Content_Render(False); - end; + if not ChangeHotkey(Self, MsgFromIdFormat(SKSetHotkey_Language, [lang2.LocaleName + ' ('+lang2.LayoutName+')']), lang2.Hotkey) then + Exit; + kmcom.Languages.Apply; end else if GetHotkeyFromParams(params, hotkey) then begin - if ChangeHotkey(Self, MsgFromId(SKSetHotkey_Interface), hotkey) then - begin - Do_Content_Render(False); - end; + if not ChangeHotkey(Self, MsgFromId(SKSetHotkey_Interface), hotkey) then + Exit; + kmcom.Hotkeys.Apply; end else + begin ShowMessage(params.Text); + Exit; + end; + + Do_Content_Render(False); end; procedure TfrmMain.Hotkey_Clear(params: TStringList); @@ -675,19 +630,17 @@ begin if GetHotkeyLanguageFromParams(params, lang2) then begin lang2.Hotkey.Clear; - Do_Content_Render(False); + kmcom.Languages.Apply; end else if GetHotkeyFromParams(params, hotkey) then begin hotkey.Clear; - Do_Content_Render(False); + kmcom.Hotkeys.Apply; end -end; + else + Exit; -function TfrmMain.Hotkeys_Save: Boolean; -begin - kmcom.Hotkeys.Apply; - Result := True; + Do_Content_Render(False); end; {------------------------------------------------------------------------------- diff --git a/windows/src/desktop/kmshell/xml/config.css b/windows/src/desktop/kmshell/xml/config.css index bea36a3896..7dd454fd03 100644 --- a/windows/src/desktop/kmshell/xml/config.css +++ b/windows/src/desktop/kmshell/xml/config.css @@ -128,6 +128,12 @@ border-right: 1px solid #6D6C6F; } +.footer_instant { + font-size: 12px; + padding-top: 3px; + padding-right: 3px; +} + input[type='submit'], input[type='button'], button { background: #F68924; diff --git a/windows/src/desktop/kmshell/xml/keyman_footer.xsl b/windows/src/desktop/kmshell/xml/keyman_footer.xsl index 4d88a22bd8..79101672a9 100644 --- a/windows/src/desktop/kmshell/xml/keyman_footer.xsl +++ b/windows/src/desktop/kmshell/xml/keyman_footer.xsl @@ -9,28 +9,18 @@
+
+
+
- - 1 - keyman:footer_ok - 70px + + keyman:keyboard_install - - keyman:footer_cancel - 70px + + keyman:keyboard_download
-
- - - keyman:keyboard_install - - - - keyman:keyboard_download - -
\ No newline at end of file diff --git a/windows/src/desktop/kmshell/xml/strings.xml b/windows/src/desktop/kmshell/xml/strings.xml index 1748fb2ce2..f191075a2e 100644 --- a/windows/src/desktop/kmshell/xml/strings.xml +++ b/windows/src/desktop/kmshell/xml/strings.xml @@ -268,14 +268,17 @@ Copyright: + + + + Changes are applied immediately - - + Install keyboard... - + Download keyboard... @@ -568,7 +571,6 @@ Diagnostics - diff --git a/windows/src/engine/kmcomapi/com/system/keymancontrol.pas b/windows/src/engine/kmcomapi/com/system/keymancontrol.pas index 90e35e98f9..69d36fc814 100644 --- a/windows/src/engine/kmcomapi/com/system/keymancontrol.pas +++ b/windows/src/engine/kmcomapi/com/system/keymancontrol.pas @@ -107,7 +107,6 @@ type FAutoApply: Boolean; FKeymanCustomisation: IKeymanCustomisation; - procedure RefreshWndProc(var Message: TMessage); function RunKeymanConfiguration(const filename: string): Boolean; procedure ApplyToRunningKeymanEngine; function FindMasterControllerWindow: THandle; @@ -182,7 +181,6 @@ uses keymanerrorcodes, psapi, Variants, KLog; var - wm_keyman_refresh: Integer = 0; wm_keyman: Integer = 0; {$IFNDEF WIN64} @@ -354,20 +352,25 @@ begin end; procedure TKeymanControl.ApplyToRunningKeymanEngine; -const - KR_REQUEST_REFRESH = 0; -var - msg: TMsg; begin - // This convoluted way of refreshing keyman ensures that km is init for the thread. Other methods would work but this is easiest - // Note that this creates a message queue on the thread which means it should be avoided for console apps, etc. - if wm_keyman_refresh = 0 then - wm_keyman_refresh := RegisterWindowMessage('WM_KEYMANREFRESH'); - RefreshHandle := AllocateHWnd(RefreshWndProc); - PostMessage(RefreshHandle, wm_keyman_refresh, KR_REQUEST_REFRESH, 0); - GetMessage(msg, RefreshHandle, wm_keyman_refresh, wm_keyman_refresh); - DispatchMessage(msg); - DeallocateHWnd(RefreshHandle); + // This convoluted way of refreshing keyman ensures that km is init for the thread. + // Other methods would work but this is easiest + TThread.CreateAnonymousThread( + procedure + const + KR_REQUEST_REFRESH = 0; + var + msg: TMsg; + wm_keyman_refresh: UINT; + begin + wm_keyman_refresh := RegisterWindowMessage('WM_KEYMANREFRESH'); + RefreshHandle := AllocateHWnd(nil); + PostMessage(RefreshHandle, wm_keyman_refresh, KR_REQUEST_REFRESH, 0); + GetMessage(msg, RefreshHandle, wm_keyman_refresh, wm_keyman_refresh); + DispatchMessage(msg); + DeallocateHWnd(RefreshHandle); + end + ).Start; end; constructor TKeymanControl.Create(AContext: TKeymanContext); @@ -438,12 +441,6 @@ begin FKeymanCustomisation.Refresh; end; -procedure TKeymanControl.RefreshWndProc(var Message: TMessage); -begin - with Message do - Result := DefWindowProc(RefreshHandle, Msg, WParam, LParam); -end; - procedure TKeymanControl.DiagnosticTestException; begin raise Exception.Create('Testing safecall wrappering of exception for Sentry'); From 4269a4dbc422c0bec093306c925ec5fa0da051a7 Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Mon, 26 Oct 2020 15:26:08 +1100 Subject: [PATCH 5/8] fix(windows): Remove double refresh Both the win32 and the win64 keyman engine libraries would receive a refresh notification, and then they'd both broadcast the change. This change limits the broadcast responsibility to the 32-bit engine. --- windows/src/engine/keyman32/Keyman32.cpp | 39 ++++++++++++++------- windows/src/engine/keyman32/globals.h | 2 ++ windows/src/engine/keyman32/k32_globals.cpp | 9 +++-- 3 files changed, 34 insertions(+), 16 deletions(-) diff --git a/windows/src/engine/keyman32/Keyman32.cpp b/windows/src/engine/keyman32/Keyman32.cpp index 75c1afa68e..49156e4c31 100644 --- a/windows/src/engine/keyman32/Keyman32.cpp +++ b/windows/src/engine/keyman32/Keyman32.cpp @@ -724,6 +724,8 @@ extern "C" DWORD _declspec(dllexport) WINAPI GetActiveKeymanID() // //--------------------------------------------------------------------------------------------------------- +// This function prevents a refresh event from being processed more than once +// by a thread, for instance if a thread has multiple top-level windows BOOL UpdateRefreshTag(LONG tag) // I1835 - Reduce chatter { PKEYMAN64THREADDATA _td = ThreadGlobals(); @@ -734,35 +736,46 @@ BOOL UpdateRefreshTag(LONG tag) // I1835 - Reduce chatter return TRUE; } return FALSE; - /*LONG lOriginal, lResult; - do { - lOriginal = _td->RefreshTag_Process; - lResult = max(lOriginal, tag); - } while(InterlockedCompareExchange(&_td->RefreshTag_Process, lResult, lOriginal) != lOriginal); - - return lResult > lOriginal;*/ } void HandleRefresh(int code, LONG tag) { switch(code) { - case KR_REQUEST_REFRESH: + case KR_REQUEST_REFRESH: + // This is sent by Keyman COM API, ApplyToRunningKeymanEngine SendDebugMessageFormat(0,sdmGlobal,0,"#### Refresh Requested ####"); - //PostMessage(GetDesktopWindow(), wm_keyman_refresh, KR_PRE_REFRESH, 0); + + // We ask any controller window to tell all instances of keyman32/keyman64 + // that a refresh is coming through Globals::PostControllers(wm_keyman_refresh, KR_PRE_REFRESH, 0); + + // We need to tell the controller windows to refresh themselves also Globals::PostControllers(wm_keyman_control, KMC_REFRESH, 0); break; case KR_PRE_REFRESH: +#ifndef _WIN64 + // We only need to broadcast the message from Win32; this avoids + // a double-broadcast which could happen if both keyman32 and keyman64 + // receive the message, as they have independently managed RefreshTags + + // All controllers will receive this message; only one need act on it tag = InterlockedIncrement(Globals::RefreshTag()); - if(UpdateRefreshTag(tag)) - RefreshKeyboards(FALSE); // The Keyman window gets the update first - PostMessage(HWND_BROADCAST, wm_keyman_refresh, KR_REFRESH, tag); - break; + if (UpdateRefreshTag(tag)) { + // The Keyman process gets the update first + RefreshKeyboards(FALSE); + PostMessage(HWND_BROADCAST, wm_keyman_refresh, KR_REFRESH, tag); + } +#endif + + break; case KR_REFRESH: + // All threads need to have their keyboard list + // refreshed after an update, but only once per + // refresh request if(UpdateRefreshTag(tag)) RefreshKeyboards(FALSE); diff --git a/windows/src/engine/keyman32/globals.h b/windows/src/engine/keyman32/globals.h index dcf1bd3afc..a75cb85055 100644 --- a/windows/src/engine/keyman32/globals.h +++ b/windows/src/engine/keyman32/globals.h @@ -92,7 +92,9 @@ public: static DWORD *ShiftState(); +#ifndef _WIN64 static LONG *RefreshTag(); +#endif static HHOOK get_hhookGetMessage(); static HHOOK get_hhookCallWndProc(); diff --git a/windows/src/engine/keyman32/k32_globals.cpp b/windows/src/engine/keyman32/k32_globals.cpp index 2a08e6c293..451e9d8c87 100644 --- a/windows/src/engine/keyman32/k32_globals.cpp +++ b/windows/src/engine/keyman32/k32_globals.cpp @@ -69,9 +69,6 @@ /* */ /***************************************************************************/ -//__declspec(align(4)) LONG RefreshTag_Process = 0; -//__declspec(align(4)) LONG FInRefreshKeyboards = 0; - UINT //TODO: consolidate these messages -- they are probably not all required now wm_keyman = 0, // user message - ignore msg // I3594 @@ -280,8 +277,10 @@ static wchar_t __declspec(align(8)) static UINT f_vk_prefix = 0; +#ifndef _WIN64 __declspec(align(8)) static LONG f_RefreshTag = 0; +#endif static BOOL f_debug_KeymanLog = FALSE, @@ -321,7 +320,9 @@ DWORD *Globals::InitialisingThread() { return &f_InitialisingThread; } // I43 DWORD *Globals::ShiftState() { return &f_ShiftState; } +#ifndef _WIN64 LONG *Globals::RefreshTag() { return &f_RefreshTag; } +#endif HHOOK Globals::get_hhookCallWndProc() { return f_hhookCallWndProc; } HHOOK Globals::get_hhookGetMessage() { return f_hhookGetMessage; } @@ -440,7 +441,9 @@ BOOL Globals::ResetControllers() // I3092 f_FSingleThread = FALSE; f_hwndIM = 0; f_hwndIMAlways = 0; +#ifndef _WIN64 f_RefreshTag = 0; +#endif Globals::Unlock(); From 6b626010275a13dd80cccc693bc24ea97466a6ad Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Mon, 26 Oct 2020 20:00:32 +1100 Subject: [PATCH 6/8] fix(windows): Make help button work Fixes #3755. Help button in title bar of web apps will now do the same thing as F1. --- .../src/global/delphi/ui/UfrmWebContainer.pas | 23 +++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/windows/src/global/delphi/ui/UfrmWebContainer.pas b/windows/src/global/delphi/ui/UfrmWebContainer.pas index 76de98bda6..08dc558bc3 100644 --- a/windows/src/global/delphi/ui/UfrmWebContainer.pas +++ b/windows/src/global/delphi/ui/UfrmWebContainer.pas @@ -58,6 +58,8 @@ type FDialogName: WideString; procedure WMUser_FormShown(var Message: TMessage); message WM_USER_FormShown; procedure WMUser_ContentRender(var Message: TMessage); message WM_USER_ContentRender; + procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; + procedure ContributeUILanguages; protected cef: TframeCEFHost; @@ -83,6 +85,8 @@ type procedure Content_Render(FRefreshKeyman: Boolean = False; const Query: string = ''); virtual; procedure WndProc(var Message: TMessage); override; // I2720 + + procedure DoOpenHelp; public constructor Create(AOwner: TComponent); override; procedure SetFocus; override; // I2720 @@ -170,6 +174,11 @@ begin Result := url.StartsWith(modWebHttpServer.Host, True); end; +procedure TfrmWebContainer.DoOpenHelp; +begin + Application.HelpJump('context_'+lowercase(FDialogName)); +end; + procedure TfrmWebContainer.OpenLink(params: TStringList); begin if not TUtilExecute.URL(params.Values['url']) then // I3349 @@ -215,7 +224,7 @@ end; procedure TfrmWebContainer.cefHelpTopic(Sender: TObject); begin - Application.HelpJump('context_'+lowercase(FDialogName)); + DoOpenHelp; end; procedure TfrmWebContainer.cefKeyEvent(Sender: TObject; e: TCEFHostKeyEventData; @@ -226,7 +235,7 @@ begin if (e.event.windows_key_code = VK_F5) and ((e.event.modifiers and EVENTFLAG_CONTROL_DOWN) = EVENTFLAG_CONTROL_DOWN) then PostMessage(Handle, WM_USER_ContentRender, 0, 0) else if e.event.windows_key_code = VK_F1 then - Application.HelpJump('context_'+lowercase(FDialogName)); + DoOpenHelp; end; end; @@ -281,6 +290,16 @@ begin Result := (Copy(URL, 1, 5) = 'file:') or (Copy(URL, 1, 1) = '/'); end; +procedure TfrmWebContainer.WMSysCommand(var Message: TWMSysCommand); +begin + with Message do + begin + if (CmdType and $FFF0 = SC_CONTEXTHELP) + then DoOpenHelp + else inherited; + end; +end; + procedure TfrmWebContainer.WMUser_ContentRender(var Message: TMessage); begin Do_Content_Render(True); From 4e503131cd53ba0c5ac068bb96ab9629dc459cbe Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Mon, 26 Oct 2020 20:44:36 +1100 Subject: [PATCH 7/8] fix(windows): use new windows url for online update check Fixes #3393. --- .../kmshell/main/OnlineUpdateCheck.pas | 37 +++++++------------ .../kmshell/util/UfrmDownloadProgress.dfm | 3 +- .../Keyman.System.UpdateCheckResponse.pas | 2 +- .../global/delphi/general/Upload_Settings.pas | 5 +-- .../global/delphi/general/httpuploader.pas | 9 ++++- 5 files changed, 25 insertions(+), 31 deletions(-) diff --git a/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas b/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas index 58424a665d..baecd6ff2e 100644 --- a/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas +++ b/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas @@ -56,6 +56,7 @@ type OldVersion, NewVersion: string; DownloadURL: string; SavePath: string; + FileName: string; DownloadSize: Integer; Install: Boolean; end; @@ -64,6 +65,7 @@ type OldVersion, NewVersion: string; DownloadURL: string; SavePath: string; + FileName: string; DownloadSize: Integer; Install: Boolean; end; @@ -85,7 +87,6 @@ type private FSilent: Boolean; FForce: Boolean; - FCurrentVersion: string; FParams: TOnlineUpdateCheckParams; FErrorMessage: string; @@ -111,7 +112,6 @@ type constructor Create(AForce, ASilent: Boolean); destructor Destroy; override; function Run: TOnlineUpdateCheckResult; - property CurrentVersion: string read FCurrentVersion write FCurrentVersion; property ShowErrors: Boolean read FShowErrors write FShowErrors; end; @@ -135,9 +135,11 @@ implementation uses Vcl.Dialogs, Vcl.Forms, + GlobalProxySettings, KLog, keymanapi_TLB, + KeymanVersion, kmint, OnlineConstants, ErrorControlledRegistry, @@ -167,7 +169,6 @@ begin inherited Create; FShowErrors := True; - FCurrentVersion := GetVersionString; FParams.Result := oucUnknown; FSilent := ASilent; @@ -213,20 +214,6 @@ procedure TOnlineUpdateCheck.DoDownloadUpdates(AOwner: TfrmDownloadProgress; var var i: Integer; - function GetSavePath(const url: string): string; - var - n: Integer; - begin - n := LastDelimiter('/', url); - if n = 0 then - begin - Result := ''; - ShowMessage('Unable to download file - not a recognised URL: '+url); - Exit; - end; - Result := DownloadTempPath + Copy(url,n+1,Length(url)); - end; - function DownloadFile(const url, savepath: string): TModalResult; begin Result := mrCancel; @@ -278,14 +265,14 @@ begin Inc(FDownload.TotalDownloads); Inc(FDownload.TotalSize, FParams.Packages[i].DownloadSize); - FParams.Packages[i].SavePath := GetSavePath(FParams.Packages[i].DownloadURL); + FParams.Packages[i].SavePath := DownloadTempPath + FParams.Packages[i].FileName; end; if FParams.Keyman.Install then begin Inc(FDownload.TotalDownloads); Inc(FDownload.TotalSize, FParams.Keyman.DownloadSize); - FParams.Keyman.SavePath := GetSavePath(FParams.Keyman.DownloadURL); + FParams.Keyman.SavePath := DownloadTempPath + FParams.Keyman.FileName; end; FDownload.StartPosition := 0; @@ -422,7 +409,6 @@ begin { We have an update available } with OnlineUpdateNewVersion(nil) do try - CurrentVersion := GetVersionString; Params := Self.FParams; if ShowModal <> mrYes then begin @@ -559,11 +545,12 @@ begin with THTTPUploader.Create(nil) do try ShowUI := not FSilent; - Fields.Add('Version', ansistring(FCurrentVersion)); + Fields.Add('version', ansistring(CKeymanVersionInfo.Version)); + Fields.Add('tier', ansistring(CKeymanVersionInfo.Tier)); for i := 0 to kmcom.Packages.Count - 1 do begin pkg := kmcom.Packages[i]; - Fields.Add(ansistring('Package_'+pkg.ID), ansistring(pkg.Version)); + Fields.Add(ansistring('package_'+pkg.ID), ansistring(pkg.Version)); pkg := nil; end; @@ -574,12 +561,12 @@ begin Request.HostName := API_Server; Request.Protocol := API_Protocol; - Request.UrlPath := API_Path_UpdateCheck_Desktop; + Request.UrlPath := API_Path_UpdateCheck_Windows; //OnStatus := Upload; if Response.StatusCode = 200 then begin - if ucr.Parse(Response.MessageBodyAsString, 'windows', FCurrentVersion) then + if ucr.Parse(Response.MessageBodyAsString, 'bundle', CKeymanVersionInfo.Version) then begin SetLength(FParams.Packages,0); for i := Low(ucr.Packages) to High(ucr.Packages) do @@ -597,6 +584,7 @@ begin FParams.Packages[j].NewVersion := ucr.Packages[i].NewVersion; FParams.Packages[j].DownloadSize := ucr.Packages[i].DownloadSize; FParams.Packages[j].DownloadURL := ucr.Packages[i].DownloadURL; + FParams.Packages[j].FileName := ucr.Packages[i].FileName; pkg := nil; end else @@ -614,6 +602,7 @@ begin FParams.Keyman.NewVersion := ucr.NewVersion; FParams.Keyman.DownloadURL := ucr.InstallURL; FParams.Keyman.DownloadSize := ucr.InstallSize; + FParams.Keyman.FileName := ucr.FileName; end; end; diff --git a/windows/src/desktop/kmshell/util/UfrmDownloadProgress.dfm b/windows/src/desktop/kmshell/util/UfrmDownloadProgress.dfm index 4af3fab844..36354d10fd 100644 --- a/windows/src/desktop/kmshell/util/UfrmDownloadProgress.dfm +++ b/windows/src/desktop/kmshell/util/UfrmDownloadProgress.dfm @@ -9,7 +9,7 @@ inherited frmDownloadProgress: TfrmDownloadProgress Font.Name = 'Tahoma' Position = poScreenCenter ExplicitWidth = 311 - ExplicitHeight = 180 + ExplicitHeight = 177 PixelsPerInch = 96 TextHeight = 13 object lblStatus: TLabel @@ -19,6 +19,7 @@ inherited frmDownloadProgress: TfrmDownloadProgress Height = 33 Alignment = taCenter AutoSize = False + EllipsisPosition = epWordEllipsis WordWrap = True end object progress: TProgressBar diff --git a/windows/src/global/delphi/general/Keyman.System.UpdateCheckResponse.pas b/windows/src/global/delphi/general/Keyman.System.UpdateCheckResponse.pas index ffa876b04b..605eaeab88 100644 --- a/windows/src/global/delphi/general/Keyman.System.UpdateCheckResponse.pas +++ b/windows/src/global/delphi/general/Keyman.System.UpdateCheckResponse.pas @@ -84,7 +84,7 @@ begin if doc.Values[app] is TJSONObject then begin node := doc.Values[app] as TJSONObject; - if CompareVersions(node.Values['version'].Value, FCurrentVersion) > 0 then + if CompareVersions(node.Values['version'].Value, FCurrentVersion) < 0 then begin FNewVersion := node.Values['version'].Value; FFileName := node.Values['file'].Value; diff --git a/windows/src/global/delphi/general/Upload_Settings.pas b/windows/src/global/delphi/general/Upload_Settings.pas index ed152e88b9..3fef8fbf8d 100644 --- a/windows/src/global/delphi/general/Upload_Settings.pas +++ b/windows/src/global/delphi/general/Upload_Settings.pas @@ -32,10 +32,9 @@ uses const // https://api.keyman.com/ - programmatic endpoints API_Path_UpdateCheck_Windows = '/windows/14.0/update'; // version will only update when the api changes - - // TODO: use /windows/ instead of /desktop/ - API_Path_UpdateCheck_Desktop = '/desktop/'+SKeymanVersion+'/update'; // TODO: use updatecheck_windows API_Path_UpdateCheck_Developer = '/developer/'+SKeymanVersion+'/update'; + + // TODO: use /windows/ instead of /desktop/ API_Path_SubmitDiag = '/desktop/'+SKeymanVersion+'/submitdiag'; API_Path_IsOnline = '/desktop/'+SKeymanVersion+'/isonline'; diff --git a/windows/src/global/delphi/general/httpuploader.pas b/windows/src/global/delphi/general/httpuploader.pas index 16bd6a9117..2bfab5298a 100644 --- a/windows/src/global/delphi/general/httpuploader.pas +++ b/windows/src/global/delphi/general/httpuploader.pas @@ -560,6 +560,8 @@ end; procedure THTTPUploader.ReadResponseBody(hRequest: HINTERNET); var + ShortURL: string; + SplitURL: TArray; dwBufferLength, dwReserved, dwBytesRead, dwTotalBytes, dwBytesAvailable: DWORD; pMessageBody, p: PAnsiChar; begin @@ -573,7 +575,10 @@ begin if not HttpQueryInfoA(hRequest, HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER, @dwTotalBytes, dwBufferLength, dwReserved) then // I4989 dwTotalBytes := 0; - DoStatus('Downloading', 0, dwTotalBytes); + SplitURL := Request.URL.Split(['?'], MaxInt); + SplitURL := SplitURL[0].Split(['/'], MaxInt); + ShortURL := SplitURL[High(SplitURL)]; + DoStatus('Downloading '+ShortURL, 0, dwTotalBytes); dwBytesAvailable := 65536; dwBytesRead := 1; @@ -601,7 +606,7 @@ begin Inc(p, FResponse.MessageBodyLength); CopyMemory(p, pMessageBody, dwBytesRead); FResponse.MessageBodyLength := FResponse.MessageBodyLength + Integer(dwBytesRead); - DoStatus('Downloading', FResponse.MessageBodyLength, dwTotalBytes); + DoStatus('Downloading '+ShortURL, FResponse.MessageBodyLength, dwTotalBytes); DoProcessMessages; end; From 80fe97213f573878826e64677efc20eff7c19a49 Mon Sep 17 00:00:00 2001 From: Marc Durdin Date: Mon, 26 Oct 2020 20:45:43 +1100 Subject: [PATCH 8/8] fix(windows): use 13.0 endpoints for unchanged APIs --- windows/src/global/delphi/general/Upload_Settings.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/windows/src/global/delphi/general/Upload_Settings.pas b/windows/src/global/delphi/general/Upload_Settings.pas index 3fef8fbf8d..ec375ced38 100644 --- a/windows/src/global/delphi/general/Upload_Settings.pas +++ b/windows/src/global/delphi/general/Upload_Settings.pas @@ -35,8 +35,8 @@ const API_Path_UpdateCheck_Developer = '/developer/'+SKeymanVersion+'/update'; // TODO: use /windows/ instead of /desktop/ - API_Path_SubmitDiag = '/desktop/'+SKeymanVersion+'/submitdiag'; - API_Path_IsOnline = '/desktop/'+SKeymanVersion+'/isonline'; + API_Path_SubmitDiag = '/desktop/13.0/submitdiag'; // version will only update when the api changes + API_Path_IsOnline = '/desktop/13.0/isonline'; // version will only update when the api changes // https://www.keyman.com/ - web pages URLPath_CreateTranslation = '/go/windows/'+SKeymanVersion+'/create-locale';