paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-28 21:20:46 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: gtk2: fixed freeing TLCLHandledKeyEvent while processing keys

Browse Source 
git-svn-id: trunk@64889 -
This commit is contained in:
mattias 2021-03-29 12:14:55 +00:00
parent 176d2080c3
commit be1d17f306
2 changed files with 239 additions and 218 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

440
lcl/interfaces/gtk2/gtk2proc.inc
View File

@ -121,7 +121,7 @@ begin
Result:=TLCLHandledKeyEvent.Create(Event); Result:=TLCLHandledKeyEvent.Create(Event);
EventList.Add(Result); EventList.Add(Result);
while EventList.Count>10 do begin while EventList.Count>10 do begin
TLCLHandledKeyEvent(EventList[0]).Free; TLCLHandledKeyEvent(EventList[0]).Release;
EventList.Delete(0); EventList.Delete(0);
end; end;
end; end;
@ -2278,261 +2278,265 @@ begin
// remember this event // remember this event
EventHandledByLCL := RememberKeyEventWasHandledByLCL(AEvent, ABeforeEvent); EventHandledByLCL := RememberKeyEventWasHandledByLCL(AEvent, ABeforeEvent);
EventHandledByLCL.AddRef;
try
if TargetWidget = nil then Exit;
if TargetWidget = nil then Exit; //DebugLn(['HandleGTKKeyUpDown TargetWidget=',GetWidgetDebugReport(TargetWidget)]);
//DebugLn(['HandleGTKKeyUpDown TargetWidget=',GetWidgetDebugReport(TargetWidget)]); //DebugLn(['HandleGTKKeyUpDown TargetWidget=',GetWidgetDebugReport(TargetWidget),' ',DbgStr(EventString),' state=',AEvent^.state,' keyval=',AEvent^.keyval]);
FillChar(Msg, SizeOf(Msg), 0);
//DebugLn(['HandleGTKKeyUpDown TargetWidget=',GetWidgetDebugReport(TargetWidget),' ',DbgStr(EventString),' state=',AEvent^.state,' keyval=',AEvent^.keyval]);
FillChar(Msg, SizeOf(Msg), 0);
gdk_event_key_get_string(AEvent, EventString{%H-});
{$IFDEF VerboseKeyboard}
DebugLn(['HandleGTKKeyUpDown EVENTSTRING "',DbgStr(EventString),'" TargetWidget=',GetWidgetDebugReport(TargetWidget),' state=',AEvent^.state,' keyval=',AEvent^.keyval]);
{$ENDIF}
{$IfDef Gtk2LatinAccents}
gtk_im_context_filter_keypress (im_context, AEvent);
{$Else}
CheckDeadKey;
{$EndIf}
Flags := 0;
SysKey := False;
ShiftState := GTKEventStateToShiftState(AEvent^.state);
KeyCode := AEvent^.hardware_keycode;
if (KeyCode = 0)
or (KeyCode > High(MKeyCodeInfo))
or (MKeyCodeInfo[KeyCode].VKey1 = 0)
then begin
// no VKey defined, maybe composed char ?
CommonKeyData := 0;
end
else begin
KCInfo := MKeyCodeInfo[KeyCode];
gdk_event_key_get_string(AEvent, EventString{%H-});
{$IFDEF VerboseKeyboard} {$IFDEF VerboseKeyboard}
debugln(['HandleGTKKeyUpDown AEvent^.hardware_keycode=',AEvent^.hardware_keycode,',keyval=',AEvent^.keyval,',group=',AEvent^.group,' KeyCode=',KeyCode,' ',dbgs(ShiftState),' KCInfo.VKey1=',KCInfo.VKey1,',VKey2=',KCInfo.VKey2]); DebugLn(['HandleGTKKeyUpDown EVENTSTRING "',DbgStr(EventString),'" TargetWidget=',GetWidgetDebugReport(TargetWidget),' state=',AEvent^.state,' keyval=',AEvent^.keyval]);
{$ENDIF} {$ENDIF}
if (KCInfo.Flags and KCINFO_FLAG_SHIFT_XOR_NUM <> 0)
and ((ssShift in ShiftState) xor (ssNum in ShiftState))
then VKey := KCInfo.VKey2
else VKey := KCInfo.VKey1;
if (KCInfo.Flags and KCINFO_FLAG_EXT) <> 0 {$IfDef Gtk2LatinAccents}
then Flags := KF_EXTENDED; gtk_im_context_filter_keypress (im_context, AEvent);
{$Else}
CheckDeadKey;
{$EndIf}
Flags := 0;
SysKey := False;
ShiftState := GTKEventStateToShiftState(AEvent^.state);
KeyCode := AEvent^.hardware_keycode;
// ssAlt + a key pressed is always a syskey if (KeyCode = 0)
// ssAltGr + a key is only a syskey when the key pressed has no levelshift or when ssShift is pressed too or (KeyCode > High(MKeyCodeInfo))
if ssAltGr in ShiftState then or (MKeyCodeInfo[KeyCode].VKey1 = 0)
SysKey := ssAlt in ShiftState then begin
else // no VKey defined, maybe composed char ?
SysKey := [ssAlt,ssCtrl]*ShiftState=[ssAlt]; // Alt+Ctrl = AltGr, on Windows and on Linux via VNC, see bug 30544 CommonKeyData := 0;
if not SysKey then
begin
// Check ssAltGr
if (KCInfo.Flags and KCINFO_FLAG_ALTGR) = 0 then
// VKey has no levelshift char so AltGr is syskey
SysKey := ssAltGr in ShiftState
else
begin
// VKey has levelshift char so AltGr + Shift is syskey.
SysKey := (ShiftState * [ssShift, ssAltGr] = [ssShift, ssAltGr]);
// This is not true for TCustomControl, issues 22703,25874.
if LCLObject is TCustomControl then
SysKey := False;
end;
end;
if SysKey or (ssAlt in ShiftState) then
Flags := Flags or KF_ALTDOWN;
CommonKeyData := KeyCode shl 16; // Not really scancode, but will do
if AHandleDown then
begin
{$IFDEF VerboseKeyboard}
DebugLn(['[HandleGTKKeyUpDown] GDK_KEY_PRESS VKey=',dbgs(VKey),' SysKey=',dbgs(SysKey),' ShiftState=',dbgs(ShiftState),' KCInfo=Key1=',KCInfo.VKey1,',Key2=',KCInfo.VKey2,',Flags=',hexstr(KCInfo.Flags,2)]);
{$ENDIF}
Msg.CharCode := VKey;
Msg.Msg := KEYDOWN_MAP[SysKey, ABeforeEvent];
// todo repeat
// Flags := Flags or KF_REPEAT;
Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001 {TODO: repeatcount};
if not KeyAlreadyHandledByGtk
then begin
// send the (Sys)KeyDown message directly to the LCL
NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
if DeliverKeyMessage(TargetObj, Msg)
and (Msg.CharCode <> Vkey) then
StopKeyEvent;
end;
if (not EventStopped) and ABeforeEvent
then begin
if KeyActivatedAccelerator then exit;
end;
end end
else begin else begin
KCInfo := MKeyCodeInfo[KeyCode];
{$IFDEF VerboseKeyboard} {$IFDEF VerboseKeyboard}
DebugLn('[HandleGTKKeyUpDown] GDK_KEY_RELEASE VKey=',dbgs(VKey)); debugln(['HandleGTKKeyUpDown AEvent^.hardware_keycode=',AEvent^.hardware_keycode,',keyval=',AEvent^.keyval,',group=',AEvent^.group,' KeyCode=',KeyCode,' ',dbgs(ShiftState),' KCInfo.VKey1=',KCInfo.VKey1,',VKey2=',KCInfo.VKey2]);
{$ENDIF} {$ENDIF}
if (KCInfo.Flags and KCINFO_FLAG_SHIFT_XOR_NUM <> 0)
and ((ssShift in ShiftState) xor (ssNum in ShiftState))
then VKey := KCInfo.VKey2
else VKey := KCInfo.VKey1;
Msg.CharCode := VKey; if (KCInfo.Flags and KCINFO_FLAG_EXT) <> 0
Msg.Msg := KEYUP_MAP[SysKey, ABeforeEvent]; then Flags := KF_EXTENDED;
Flags := Flags or KF_UP or KF_REPEAT;
Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001 {always};
// send the message directly to the LCL
Msg.Result:=0;
NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
if DeliverKeyMessage(TargetObj, Msg) // ssAlt + a key pressed is always a syskey
and (Msg.CharCode <> VKey) // ssAltGr + a key is only a syskey when the key pressed has no levelshift or when ssShift is pressed too
then begin if ssAltGr in ShiftState then
// key was handled by LCL SysKey := ssAlt in ShiftState
StopKeyEvent; else
SysKey := [ssAlt,ssCtrl]*ShiftState=[ssAlt]; // Alt+Ctrl = AltGr, on Windows and on Linux via VNC, see bug 30544
if not SysKey then
begin
// Check ssAltGr
if (KCInfo.Flags and KCINFO_FLAG_ALTGR) = 0 then
// VKey has no levelshift char so AltGr is syskey
SysKey := ssAltGr in ShiftState
else
begin
// VKey has levelshift char so AltGr + Shift is syskey.
SysKey := (ShiftState * [ssShift, ssAltGr] = [ssShift, ssAltGr]);
// This is not true for TCustomControl, issues 22703,25874.
if LCLObject is TCustomControl then
SysKey := False;
end;
end;
if SysKey or (ssAlt in ShiftState) then
Flags := Flags or KF_ALTDOWN;
CommonKeyData := KeyCode shl 16; // Not really scancode, but will do
if AHandleDown then
begin
{$IFDEF VerboseKeyboard}
DebugLn(['[HandleGTKKeyUpDown] GDK_KEY_PRESS VKey=',dbgs(VKey),' SysKey=',dbgs(SysKey),' ShiftState=',dbgs(ShiftState),' KCInfo=Key1=',KCInfo.VKey1,',Key2=',KCInfo.VKey2,',Flags=',hexstr(KCInfo.Flags,2)]);
{$ENDIF}
Msg.CharCode := VKey;
Msg.Msg := KEYDOWN_MAP[SysKey, ABeforeEvent];
// todo repeat
// Flags := Flags or KF_REPEAT;
Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001 {TODO: repeatcount};
if not KeyAlreadyHandledByGtk
then begin
// send the (Sys)KeyDown message directly to the LCL
NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
if DeliverKeyMessage(TargetObj, Msg)
and (Msg.CharCode <> Vkey) then
StopKeyEvent;
end;
if (not EventStopped) and ABeforeEvent
then begin
if KeyActivatedAccelerator then exit;
end;
end
else begin
{$IFDEF VerboseKeyboard}
DebugLn('[HandleGTKKeyUpDown] GDK_KEY_RELEASE VKey=',dbgs(VKey));
{$ENDIF}
Msg.CharCode := VKey;
Msg.Msg := KEYUP_MAP[SysKey, ABeforeEvent];
Flags := Flags or KF_UP or KF_REPEAT;
Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001 {always};
// send the message directly to the LCL
Msg.Result:=0;
NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
if DeliverKeyMessage(TargetObj, Msg)
and (Msg.CharCode <> VKey)
then begin
// key was handled by LCL
StopKeyEvent;
end;
end; end;
end; end;
end;
// send keypresses // send keypresses
if not EventStopped and AHandleDown then if not EventStopped and AHandleDown then
begin
// send the UTF8 keypress
PassUTF8AsKeyPress := False;
if ABeforeEvent then
begin begin
// try to get the UTF8 representation of the key // send the UTF8 keypress
if im_context_string <> '' then PassUTF8AsKeyPress := False;
if ABeforeEvent then
begin begin
Character := UTF8Copy(im_context_string,1,1); // try to get the UTF8 representation of the key
im_context_string:='';// clear, to avoid sending again if im_context_string <> '' then
end
else
begin
KeyPressesChar := GetSpecialChar;
if KeyPressesChar <> #0 then
Character := KeyPressesChar
else
Character := '';
end;
{$IFDEF VerboseKeyboard}
debugln('[HandleGTKKeyUpDown] GDK_KEY_PRESS UTF8="',DbgStr(Character),'"',
' EventStopped ',dbgs(EventStopped),' CanSendChar ',dbgs(CanSendChar));
{$ENDIF}
// we must pass KeyPress if UTF8KeyPress returned false result. issue #21489
if Character <> '' then
begin
LCLObject := GetNearestLCLObject(TargetWidget);
if LCLObject is TWinControl then
begin begin
OldCharacter := Character; Character := UTF8Copy(im_context_string,1,1);
// send the key after navigation keys were handled im_context_string:='';// clear, to avoid sending again
Result := TWinControl(LCLObject).IntfUTF8KeyPress(Character, 1, SysKey); end
if Result or (Character = '') then else
// dont' stop key event here, just clear it since we need a keyUp event begin
ClearKey KeyPressesChar := GetSpecialChar;
if KeyPressesChar <> #0 then
Character := KeyPressesChar
else else
if (Character <> OldCharacter) then Character := '';
end;
{$IFDEF VerboseKeyboard}
debugln('[HandleGTKKeyUpDown] GDK_KEY_PRESS UTF8="',DbgStr(Character),'"',
' EventStopped ',dbgs(EventStopped),' CanSendChar ',dbgs(CanSendChar));
{$ENDIF}
// we must pass KeyPress if UTF8KeyPress returned false result. issue #21489
if Character <> '' then
begin
LCLObject := GetNearestLCLObject(TargetWidget);
if LCLObject is TWinControl then
begin begin
WS := UTF8ToUTF16(Character); OldCharacter := Character;
if Length(WS) > 0 then // send the key after navigation keys were handled
Result := TWinControl(LCLObject).IntfUTF8KeyPress(Character, 1, SysKey);
if Result or (Character = '') then
// dont' stop key event here, just clear it since we need a keyUp event
ClearKey
else
if (Character <> OldCharacter) then
begin begin
AEvent^.keyval := gdk_unicode_to_keyval(Word(WS[1])); WS := UTF8ToUTF16(Character);
if (AEvent^.keyval and $1000000) = $1000000 then if Length(WS) > 0 then
begin begin
CharToKeyVal(Char(Word(WS[1]) and $FF), AEvent^.keyval, AEvent^.length); AEvent^.keyval := gdk_unicode_to_keyval(Word(WS[1]));
if AEvent^.length = 1 then if (AEvent^.keyval and $1000000) = $1000000 then
begin begin
EventString^ := Char(Word(WS[1]) and $FF); CharToKeyVal(Char(Word(WS[1]) and $FF), AEvent^.keyval, AEvent^.length);
EventString[1] := #0; if AEvent^.length = 1 then
begin
EventString^ := Char(Word(WS[1]) and $FF);
EventString[1] := #0;
end
else
EventString^ := #0;
gdk_event_key_set_string(AEvent, EventString);
end end
else else
EventString^ := #0; AEvent^.length := 1;
gdk_event_key_set_string(AEvent, EventString); exit;
end end
else else
AEvent^.length := 1; begin
exit; ClearKey;
end Result := True;
else end;
end;
end;
PassUTF8AsKeyPress := not Result;
end;
end;
// send a normal KeyPress Event for Delphi compatibility
if (CanSendChar or PassUTF8AsKeyPress) then
begin
{$IFDEF EventTrace}
EventTrace('char', data);
{$ENDIF}
KeyPressesChar := #0;
if AEvent^.Length = 1 then
begin
// ASCII key was pressed
KeyPressesChar := EventString^;
end else
begin
KeyPressesChar := GetSpecialChar;
//NonAscii key was pressed, and UTF8KeyPress didn't handle it.issue #21489
if PassUTF8AsKeyPress and (KeyPressesChar = #0) then
KeyPressesChar := Char($3F);
end;
if KeyPressesChar <> #0 then
begin
FillChar(Msg, SizeOf(Msg), 0);
Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001;
Msg.Msg := CHAR_MAP[SysKey, ABeforeEvent];
// send the (Sys)Char message directly (not queued) to the LCL
Msg.Result:=0;
Msg.CharCode := Ord(KeyPressesChar);
if DeliverKeyMessage(TargetObj, Msg) and
(Ord(KeyPressesChar) <> Msg.CharCode) then
begin
// key was changed by lcl
if (Msg.CharCode=0) or (Msg.CharCode>=128) then
begin begin
// key set to invalid => just clear the key
ClearKey; ClearKey;
Result := True; end else
begin
// try to change the key
CharToKeyVal(chr(Msg.CharCode), AEvent^.KeyVal, AEvent^.length);
if AEvent^.length = 1 then
begin
EventString^ := Character[1];
EventString[1] := #0;
end else
EventString^ := #0;
gdk_event_key_set_string(AEvent, EventString);
end; end;
end; end;
end; end;
PassUTF8AsKeyPress := not Result;
end; end;
end; end;
// send a normal KeyPress Event for Delphi compatibility EmulateEatenKeys;
if (CanSendChar or PassUTF8AsKeyPress) then finally
begin EventHandledByLCL.Release
{$IFDEF EventTrace}
EventTrace('char', data);
{$ENDIF}
KeyPressesChar := #0;
if AEvent^.Length = 1 then
begin
// ASCII key was pressed
KeyPressesChar := EventString^;
end else
begin
KeyPressesChar := GetSpecialChar;
//NonAscii key was pressed, and UTF8KeyPress didn't handle it.issue #21489
if PassUTF8AsKeyPress and (KeyPressesChar = #0) then
KeyPressesChar := Char($3F);
end;
if KeyPressesChar <> #0 then
begin
FillChar(Msg, SizeOf(Msg), 0);
Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001;
Msg.Msg := CHAR_MAP[SysKey, ABeforeEvent];
// send the (Sys)Char message directly (not queued) to the LCL
Msg.Result:=0;
Msg.CharCode := Ord(KeyPressesChar);
if DeliverKeyMessage(TargetObj, Msg) and
(Ord(KeyPressesChar) <> Msg.CharCode) then
begin
// key was changed by lcl
if (Msg.CharCode=0) or (Msg.CharCode>=128) then
begin
// key set to invalid => just clear the key
ClearKey;
end else
begin
// try to change the key
CharToKeyVal(chr(Msg.CharCode), AEvent^.KeyVal, AEvent^.length);
if AEvent^.length = 1 then
begin
EventString^ := Character[1];
EventString[1] := #0;
end else
EventString^ := #0;
gdk_event_key_set_string(AEvent, EventString);
end;
end;
end;
end;
end; end;
EmulateEatenKeys;
Result:=EventStopped; Result:=EventStopped;
end; end;
@ -3481,13 +3485,13 @@ begin
DisconnectGdkKeymapChangedSignal; DisconnectGdkKeymapChangedSignal;
if LCLHandledKeyEvents<>nil then begin if LCLHandledKeyEvents<>nil then begin
for i:=0 to LCLHandledKeyEvents.Count-1 do for i:=0 to LCLHandledKeyEvents.Count-1 do
TObject(LCLHandledKeyEvents[i]).Free; TLCLHandledKeyEvent(LCLHandledKeyEvents[i]).Release;
LCLHandledKeyEvents.Free; LCLHandledKeyEvents.Free;
LCLHandledKeyEvents:=nil; LCLHandledKeyEvents:=nil;
end; end;
if LCLHandledKeyAfterEvents<>nil then begin if LCLHandledKeyAfterEvents<>nil then begin
for i:=0 to LCLHandledKeyAfterEvents.Count-1 do for i:=0 to LCLHandledKeyAfterEvents.Count-1 do
TObject(LCLHandledKeyAfterEvents[i]).Free; TLCLHandledKeyEvent(LCLHandledKeyAfterEvents[i]).Release;
LCLHandledKeyAfterEvents.Free; LCLHandledKeyAfterEvents.Free;
LCLHandledKeyAfterEvents:=nil; LCLHandledKeyAfterEvents:=nil;
end; end;

17
lcl/interfaces/gtk2/gtk2proc.pp
View File

@ -852,6 +852,8 @@ type
// TLCLHandledKeyEvent is used to remember, if an gdk key event was already // TLCLHandledKeyEvent is used to remember, if an gdk key event was already
// handled. // handled.
TLCLHandledKeyEvent = class TLCLHandledKeyEvent = class
private
fRefCount: integer;
public public
thetype: TGdkEventType; thetype: TGdkEventType;
window: PGdkWindow; window: PGdkWindow;
@ -862,6 +864,8 @@ type
hardware_keycode : guint16; hardware_keycode : guint16;
constructor Create(Event: PGdkEventKey); constructor Create(Event: PGdkEventKey);
function IsEqual(Event: PGdkEventKey): boolean; function IsEqual(Event: PGdkEventKey): boolean;
procedure AddRef;
procedure Release;
end; end;
TWinControlAccess = class(TWinControl) TWinControlAccess = class(TWinControl)
@ -871,6 +875,7 @@ type
constructor TLCLHandledKeyEvent.Create(Event: PGdkEventKey); constructor TLCLHandledKeyEvent.Create(Event: PGdkEventKey);
begin begin
fRefCount:=1;
thetype:=gdk_event_get_type(Event); thetype:=gdk_event_get_type(Event);
window:=Event^.window; window:=Event^.window;
send_event:=Event^.send_event; send_event:=Event^.send_event;
@ -892,6 +897,18 @@ begin
; ;
end; end;
procedure TLCLHandledKeyEvent.AddRef;
begin
inc(fRefCount);
end;
procedure TLCLHandledKeyEvent.Release;
begin
dec(fRefCount);
if fRefCount=0 then
Free;
end;
var var
// LCLHandledKeyEvents stores the last handled key event (handled by the LCL) // LCLHandledKeyEvents stores the last handled key event (handled by the LCL)
// Reason: The gtk sends the same key event to several widgets. The gtk intf // Reason: The gtk sends the same key event to several widgets. The gtk intf