erabo/spiegel-keyman
1
0
Fork 0
mirror of https://github.com/keymanapp/keyman.git synced 2026-08-11 11:25:34 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 26

Merge branch 'master' into fix/windows/3756-keep-in-touch-link-crash

Browse source
This commit is contained in:
Marc Durdin 2020-10-27 13:08:58 +11:00 • committed by GitHub
commit 2a50bb107e
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
25 changed files with 176 additions and 405 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
windows/src/desktop/kmshell/help/UfrmHelp.pas
View file

@ -131,7 +131,7 @@ begin
then FQuery := Format('?keyboard=%s', [UrlEncode(FActiveKeyboard.Name)])
else FQuery := '';
Content_Render(False, FQuery);
Content_Render(FQuery);
inherited;
end;

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

@ -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;

44
windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas
View file

@ -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;
@ -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;
@ -194,7 +195,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;
@ -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
@ -487,9 +473,6 @@ begin
end;
end;
end;
if (FParams.Result = oucSuccess) and kmcom.SystemInfo.RebootRequired then
FParams.Result := oucSuccessReboot;
end;
procedure TOnlineUpdateCheck.ShutDown;
@ -559,11 +542,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 +558,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 +581,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 +599,7 @@ begin
FParams.Keyman.NewVersion := ucr.NewVersion;
FParams.Keyman.DownloadURL := ucr.InstallURL;
FParams.Keyman.DownloadSize := ucr.InstallSize;
FParams.Keyman.FileName := ucr.FileName;
end;
end;

5
windows/src/desktop/kmshell/main/UfrmKeepInTouch.pas
View file

@ -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

264
windows/src/desktop/kmshell/main/UfrmMain.pas
View file

@ -93,13 +93,7 @@ type
FKeyboardXMLRenderer: TKeyboardListXMLRenderer;
FXMLRenderers: TXMLRenderers;
DebuggingChecked: Boolean; // I3630
dlgOpenAddin: TOpenDialog;
dlgOpenVisualKeyboard: TOpenDialog;
procedure dlgOpenVisualKeyboardCanClose(Sender: TObject; var CanClose: Boolean);
wm_keyman_refresh: Integer;
procedure cefBeforeBrowse(Sender: TObject; const Url: string;
isPopup, wasHandled: Boolean);
@ -109,54 +103,45 @@ type
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 InitNonVisualComponents;
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 Keyboard_InstallVisualKeyboard(params: TStringList);
procedure Keyboard_UninstallVisualKeyboard(params: TStringList);
procedure Options_Init;
procedure Options_ClickCheck(params: TStringList);
function GetOptionFromParams(params: TStringList; out option: IKeymanOption): Boolean;
procedure Options_ResetHints;
procedure Options_BaseKeyboard; // I4169
procedure Options_SettingsManager;
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 MustReboot: 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;
@ -232,10 +217,6 @@ begin
cef.OnBeforeBrowse := cefBeforeBrowse;
cef.OnBeforeBrowseSync := cefBeforeBrowseSync;
kmcom.AutoApply := False;
InitNonVisualComponents;
Icon.ReleaseHandle;
Icon.Handle := DuplicateIcon(hInstance, Application.Icon.Handle);
@ -259,12 +240,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;
@ -318,7 +293,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);
@ -329,8 +304,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
@ -355,58 +328,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;
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 -
------------------------------------------------------------------------------}
@ -514,8 +442,6 @@ end;
procedure TfrmMain.Keyboard_Install;
begin
if MustReboot then Exit; // I2789
if TInstallFile.BrowseAndInstallKeyboardFromFile(Self) then
begin
RefreshKeymanConfiguration;
@ -527,8 +453,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 }
@ -546,8 +470,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?
@ -562,8 +484,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 }
@ -584,8 +504,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 }
@ -598,19 +516,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;
@ -627,37 +532,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');
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;
kmcom.Keyboards.Apply;
end;
end;
procedure TfrmMain.Keyboard_Options(Params: TStringList);
@ -679,31 +562,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.cefBeforeBrowse(Sender: TObject; const Url: string;
isPopup, wasHandled: Boolean);
begin
@ -718,35 +576,6 @@ begin
Handled := isPopup;
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 -
------------------------------------------------------------------------------}
@ -779,6 +608,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);
@ -786,7 +623,6 @@ end;
procedure TfrmMain.Options_Init;
begin
DebuggingChecked := kmcom.Options['koDebugging'].Value; // I3630
end;
procedure TfrmMain.Options_ResetHints;
@ -795,21 +631,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 -
------------------------------------------------------------------------------}
@ -821,20 +642,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);
@ -845,19 +669,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;
{-------------------------------------------------------------------------------
@ -909,7 +731,7 @@ begin
on E:Exception do KL.Log(E.Message);
end;
end;
oucSuccess, oucSuccessReboot:
oucSuccess:
RefreshKeymanConfiguration;
end
finally

2
windows/src/desktop/kmshell/main/UfrmOnlineUpdateNewVersion.pas
View file

@ -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.

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

@ -557,9 +557,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;

4
windows/src/desktop/kmshell/startup/UfrmSplash.pas
View file

@ -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

3
windows/src/desktop/kmshell/util/UfrmDownloadProgress.dfm
View file

@ -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

57
windows/src/desktop/kmshell/util/utilkmshell.pas
View file

@ -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;

6
windows/src/desktop/kmshell/xml/config.css
View file

@ -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;

24
windows/src/desktop/kmshell/xml/keyman_footer.xsl
View file

@ -9,28 +9,18 @@
<xsl:template name="footerframe">
<div id='footer-top'></div>
<div style="float:right; padding: 2px 12px">
<div class='footer_instant'><xsl:value-of select="$locale/string[@name='S_Footer_ChangesImmediate']"/></div>
</div>
<div id="keyboards_control" style="float:left">
<xsl:call-template name="button">
<xsl:with-param name="caption"><xsl:value-of select="$locale/string[@name='S_Button_OK']"/></xsl:with-param>
<xsl:with-param name="default">1</xsl:with-param>
<xsl:with-param name="command">keyman:footer_ok</xsl:with-param>
<xsl:with-param name="width">70px</xsl:with-param>
<xsl:with-param name="caption"><xsl:value-of select="$locale/string[@name='S_Button_InstallKeyboard']"/></xsl:with-param>
<xsl:with-param name="command">keyman:keyboard_install</xsl:with-param>
</xsl:call-template>
<xsl:call-template name="button">
<xsl:with-param name="caption"><xsl:value-of select="$locale/string[@name='S_Button_Cancel']"/></xsl:with-param>
<xsl:with-param name="command">keyman:footer_cancel</xsl:with-param>
<xsl:with-param name="width">70px</xsl:with-param>
<xsl:with-param name="caption"><xsl:value-of select="$locale/string[@name='S_Button_DownloadKeyboard']"/></xsl:with-param>
<xsl:with-param name="command">keyman:keyboard_download</xsl:with-param>
</xsl:call-template>
</div>
<div id="keyboards_control" style="float:left">
<xsl:call-template name="button">
<xsl:with-param name="caption"><xsl:value-of select="$locale/string[@name='S_Button_InstallKeyboard']"/></xsl:with-param>
<xsl:with-param name="command">keyman:keyboard_install</xsl:with-param>
</xsl:call-template>
<xsl:call-template name="button">
<xsl:with-param name="caption"><xsl:value-of select="$locale/string[@name='S_Button_DownloadKeyboard']"/></xsl:with-param>
<xsl:with-param name="command">keyman:keyboard_download</xsl:with-param>
</xsl:call-template>
</div>
</xsl:template>
</xsl:stylesheet>

10
windows/src/desktop/kmshell/xml/strings.xml
View file

@ -268,14 +268,17 @@
<!-- Introduced: 7.0.230.0 -->
<string name="S_Caption_Copyright" comment="Keyboard download window, etc. - term for copyright">Copyright:</string>
<!-- Context: Configuration Dialog - Footer -->
<!-- String Type: PlainText -->
<!-- Introduced: 14.0 -->
<string name="S_Footer_ChangesImmediate" comment="Short-term (14.0) message explaining why Ok and Cancel buttons are no longer present">Changes are applied immediately</string>
<!-- Context: Configuration Dialog - Keyboard Layouts tab -->
<!-- Context: Configuration Dialog - Footer -->
<!-- String Type: PlainText -->
<!-- Introduced: 7.0.230.0 -->
<string name="S_Button_InstallKeyboard" comment="Keyboard Layouts - install keyboard button">Install keyboard...</string>
<!-- Context: Configuration Dialog - Keyboard Layouts tab -->
<!-- Context: Configuration Dialog - Footer -->
<!-- String Type: PlainText -->
<!-- Introduced: 7.0.230.0 -->
<string name="S_Button_DownloadKeyboard" comment="Keyboard Layouts - download keyboard button">Download keyboard...</string>
@ -573,7 +576,6 @@
<string name="S_Menu_Diagnostics_Diagnostics" comment="Support button submenu - performs a diagnostic report">Diagnostics</string>
<!-- Context: Download Keyboard Dialog -->
<!-- String Type: PlainText -->

39
windows/src/engine/keyman32/Keyman32.cpp
View file

@ -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);

2
windows/src/engine/keyman32/globals.h
View file

@ -92,7 +92,9 @@ public:
static DWORD *ShiftState();
#ifndef _WIN64
static LONG *RefreshTag();
#endif
static HHOOK get_hhookGetMessage();
static HHOOK get_hhookCallWndProc();

9
windows/src/engine/keyman32/k32_globals.cpp
View file

@ -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();

39
windows/src/engine/kmcomapi/com/system/keymancontrol.pas
View file

@ -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');

6
windows/src/engine/kmcomapi/com/system/keymansysteminfo.pas
View file

@ -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.

6
windows/src/engine/kmcomapi/processes/kpbase.pas
View file

@ -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);

2
windows/src/engine/kmcomapi/util/internalinterfaces.pas
View file

@ -89,8 +89,6 @@ type
IIntKeymanPackagesInstalled = IIntKeymanCollection;
IIntKeymanSystemInfo = interface(IIntKeymanInterface)
['{90E3F800-E232-4C12-B7B0-7EFE43B71585}']
procedure SetReboot; safecall;
end;
IIntKeymanOptions = IIntKeymanCollection;

2
windows/src/global/delphi/general/Keyman.System.UpdateCheckResponse.pas
View file

@ -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;

9
windows/src/global/delphi/general/Upload_Settings.pas
View file

@ -32,12 +32,11 @@ 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';
API_Path_SubmitDiag = '/desktop/'+SKeymanVersion+'/submitdiag';
API_Path_IsOnline = '/desktop/'+SKeymanVersion+'/isonline';
// TODO: use /windows/ instead of /desktop/
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';

9
windows/src/global/delphi/general/httpuploader.pas
View file

@ -560,6 +560,8 @@ end;
procedure THTTPUploader.ReadResponseBody(hRequest: HINTERNET);
var
ShortURL: string;
SplitURL: TArray<string>;
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;

2
windows/src/global/delphi/hints/UfrmHint.pas
View file

@ -104,7 +104,7 @@ begin
]);
FRenderPage := 'hint';
Content_Render(False, query);
Content_Render(query);
inherited;
end;

30
windows/src/global/delphi/ui/UfrmWebContainer.pas
View file

@ -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;
@ -81,8 +83,10 @@ 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
procedure DoOpenHelp;
public
constructor Create(AOwner: TComponent); override;
procedure SetFocus; override; // I2720
@ -123,8 +127,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 +150,7 @@ end;
procedure TfrmWebContainer.Do_Content_Render(FRefreshKeyman: Boolean);
begin
Content_Render(FRefreshKeyman); // I4088
Content_Render; // I4088
end;
constructor TfrmWebContainer.Create(AOwner: TComponent);
@ -170,6 +173,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 +223,7 @@ end;
procedure TfrmWebContainer.cefHelpTopic(Sender: TObject);
begin
Application.HelpJump('context_'+lowercase(FDialogName));
DoOpenHelp;
end;
procedure TfrmWebContainer.cefKeyEvent(Sender: TObject; e: TCEFHostKeyEventData;
@ -226,7 +234,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 +289,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);