{ This file is part of the Free Pascal run time library. Copyright (c) 1999-2000 by Florian Klaempfl member of the Free Pascal development team Keyboard unit for linux See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} {$IFNDEF FPC_DOTTEDUNITS} unit keyboard; {$ENDIF FPC_DOTTEDUNITS} {$inline on} {*****************************************************************************} interface {*****************************************************************************} {$i keybrdh.inc} const AltPrefix : byte = 0; ShiftPrefix : byte = 0; CtrlPrefix : byte = 0; // Constants for win32-input-mode const RIGHT_ALT_PRESSED = $0001; LEFT_ALT_PRESSED = $0002; RIGHT_CTRL_PRESSED = $0004; LEFT_CTRL_PRESSED = $0008; SHIFT_PRESSED = $0010; NUMLOCK_ON = $0020; SCROLLLOCK_ON = $0040; CAPSLOCK_ON = $0080; ENHANCED_KEY = $0100; kbBack = $0E08; kbTab = $0F09; kbEnter = $1C0D; kbSpaceBar = $3920; type Tprocedure = procedure; PTreeElement = ^TTreeElement; TTreeElement = record Next,Parent,Child : PTreeElement; CanBeTerminal : boolean; AnsiChar : byte; ScanValue : byte; CharValue : byte; ShiftValue : TEnhancedShiftState; SpecialHandler : Tprocedure; end; function RawReadKey:AnsiChar; function RawReadString : ShortString; function KeyPressed : Boolean; procedure AddSequence(const St : ShortString; AChar,AScan :byte);inline; function FindSequence(const St : ShortString;var AChar, Ascan : byte) : boolean; procedure RestoreStartMode; function AddSpecialSequence(const St : Shortstring;Proc : Tprocedure) : PTreeElement; platform; {*****************************************************************************} implementation {*****************************************************************************} {$IFDEF FPC_DOTTEDUNITS} uses System.Console.Mouse, System.Strings,System.Console.Unixkvmbase, UnixApi.TermIO,UnixApi.Base {$ifdef Linux},LinuxApi.Vcs{$endif},video,charset; {$ELSE FPC_DOTTEDUNITS} uses Mouse, Strings,unixkvmbase, termio,baseUnix {$ifdef linux},linuxvcs{$endif},video,charset; {$ENDIF FPC_DOTTEDUNITS} {$i keyboard.inc} var OldIO,StartTio : TermIos; Utf8KeyboardInputEnabled: Boolean; {$ifdef linux} is_console:boolean; vt_switched_away:boolean; {$endif} {$ifdef logging} f : text; {$endif logging} const KeyBufferSize = 20; var KeyBuffer : Array[0..KeyBufferSize-1] of TEnhancedKeyEvent; KeyPut, KeySend : longint; PendingEnhancedKeyEvent: TEnhancedKeyEvent; { Buffered Input routines } const InSize=256; var InBuf : array [0..InSize-1] of AnsiChar; { InCnt,} InHead, InTail : longint; {$i keyscan.inc} var kitty_keys_yes : boolean; {one of two have to be true} kitty_keys_no : boolean; isKittyKeys : boolean; const kbAltCenter = kbCtrlCenter; {there is no true DOS scancode for Alt+Center (Numpad "5") reusing Ctrl+Center} double_esc_hack_enabled : boolean = false; {$ifdef Unused} type TKeyState = Record Normal, Shift, Ctrl, Alt : word; end; const KeyStates : Array[0..255] of TKeyState ( ); {$endif Unused} function UnicodeToSingleByte(CodePoint: Cardinal): AnsiChar; var UStr: UnicodeString; TempStr: RawByteString; begin if CodePoint > $FFFF then begin UnicodeToSingleByte := '?'; Exit; end; UStr := UnicodeString(WideChar(CodePoint)); TempStr := UTF8Encode(UStr); SetCodePage(TempStr, GetLegacyCodePage, True); if Length(TempStr) = 1 then begin if (TempStr[1] = '?') and (CodePoint <> ord('?')) then UnicodeToSingleByte := '?' else UnicodeToSingleByte := TempStr[1]; end else UnicodeToSingleByte := '?'; end; procedure SetRawMode(b:boolean); var Tio:Termios; begin TCGetAttr(0,Tio); if b then begin {Standard output now needs #13#10.} settextlineending(output,#13#10); OldIO:=Tio; CFMakeRaw(Tio); end else begin Tio := OldIO; {Standard output normally needs just a linefeed.} settextlineending(output,#10); end; TCsetattr(0,TCSANOW,Tio); end; {$ifdef linux} {The Linux console can do nice things: we can get the state of the shift keys, and reprogram the keys. That's nice since it allows excellent circumvention of VT100 limitations, we can make the keyboard work 100%... A 100% working keyboard seems to be a pretty basic requirement, but we're one of the few guys providing such an outrageous luxury (DM).} type chgentry=packed record tab, idx, oldtab, oldidx : byte; oldval, newval : word; end; kbentry=packed record kb_table, kb_index : byte; kb_value : word; end; kbsentry=packed record kb_func:byte; kb_string:array[0..511] of AnsiChar; end; vt_mode=packed record mode, {vt mode} waitv:byte; {if set, hang on writes if not active} relsig, {signal to raise on release req} acqsig, {signal to raise on acquisition} frsig:word; {unused (set to 0)} end; const kbdchange:array[0..35] of chgentry=( {This prevents the alt+function keys from switching consoles. We code the F1..F12 sequences into ALT+F1..ALT+F12, we check the shiftstates separetely anyway.} (tab:8; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0), (tab:8; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0), (tab:8; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0), (tab:8; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0), (tab:8; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0), (tab:8; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0), (tab:8; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0), (tab:8; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0), (tab:8; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0), (tab:8; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0), (tab:8; idx:$57; oldtab:0; oldidx:$57; oldval:0; newval:0), (tab:8; idx:$58; oldtab:0; oldidx:$58; oldval:0; newval:0), {This prevents the shift+function keys outputting strings, so the kernel will send the codes for the non-shifted function keys. This is desired because normally shift+f1/f2 will output the same string as f11/12. We will get the shift state separately.} (tab:1; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0), (tab:1; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0), (tab:1; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0), (tab:1; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0), (tab:1; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0), (tab:1; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0), (tab:1; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0), (tab:1; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0), (tab:1; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0), (tab:1; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0), (tab:1; idx:$57; oldtab:0; oldidx:$57; oldval:0; newval:0), (tab:1; idx:$58; oldtab:0; oldidx:$58; oldval:0; newval:0), {This maps ctrl+function keys outputting strings to the regular F1..F12 keys also, because they no longer produce an ASCII output at all in most modern linux keymaps. We obtain the shift state separately.} (tab:4; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0), (tab:4; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0), (tab:4; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0), (tab:4; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0), (tab:4; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0), (tab:4; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0), (tab:4; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0), (tab:4; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0), (tab:4; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0), (tab:4; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0), (tab:4; idx:$57; oldtab:0; oldidx:$57; oldval:0; newval:0), (tab:4; idx:$58; oldtab:0; oldidx:$58; oldval:0; newval:0) ); KDGKBENT=$4B46; KDSKBENT=$4B47; KDGKBSENT=$4B48; KDSKBSENT=$4B49; KDGKBMETA=$4B62; KDSKBMETA=$4B63; K_ESCPREFIX=$4; K_METABIT=$3; VT_GETMODE=$5601; VT_SETMODE=$5602; VT_RELDISP=$5605; VT_PROCESS=1; const oldmeta : longint = 0; meta : longint = 0; var oldesc0,oldesc1,oldesc2,oldesc4,oldesc8:word; procedure prepare_patching; var entry : kbentry; i:longint; begin for i:=low(kbdchange) to high(kbdchange) do with kbdchange[i] do begin entry.kb_table:=tab; entry.kb_index:=idx; fpIoctl(stdinputhandle,KDGKBENT,@entry); oldval:=entry.kb_value; entry.kb_table:=oldtab; entry.kb_index:=oldidx; fpioctl(stdinputhandle,KDGKBENT,@entry); newval:=entry.kb_value; end; {Save old escape code.} entry.kb_index:=1; entry.kb_table:=0; fpioctl(stdinputhandle,KDGKBENT,@entry); oldesc0:=entry.kb_value; entry.kb_table:=1; fpioctl(stdinputhandle,KDGKBENT,@entry); oldesc1:=entry.kb_value; entry.kb_table:=2; fpioctl(stdinputhandle,KDGKBENT,@entry); oldesc2:=entry.kb_value; entry.kb_table:=4; fpioctl(stdinputhandle,KDGKBENT,@entry); oldesc4:=entry.kb_value; entry.kb_table:=8; fpioctl(stdinputhandle,KDGKBENT,@entry); oldesc8:=entry.kb_value; end; procedure PatchKeyboard; var entry : kbentry; sentry : kbsentry; i:longint; begin fpIoctl(stdinputhandle,KDGKBMETA,@oldmeta); meta:=K_ESCPREFIX; fpIoctl(stdinputhandle,KDSKBMETA,@meta); for i:=low(kbdchange) to high(kbdchange) do with kbdchange[i] do begin entry.kb_table:=tab; entry.kb_index:=idx; entry.kb_value:=newval; fpioctl(stdinputhandle,KDSKBENT,@entry); end; {Map kernel escape key code to symbol F32.} entry.kb_index:=1; entry.kb_value:=$011f; entry.kb_table:=0; fpioctl(stdinputhandle,KDSKBENT,@entry); entry.kb_table:=1; fpioctl(stdinputhandle,KDSKBENT,@entry); entry.kb_table:=2; fpioctl(stdinputhandle,KDSKBENT,@entry); entry.kb_table:=4; fpioctl(stdinputhandle,KDSKBENT,@entry); entry.kb_table:=8; fpioctl(stdinputhandle,KDSKBENT,@entry); {F32 (the escape key) will generate ^[[0~ .} sentry.kb_func:=31; sentry.kb_string:=#27'[0~'; fpioctl(stdinputhandle,KDSKBSENT,@sentry); end; procedure UnpatchKeyboard; var entry : kbentry; i : longint; begin if oldmeta in [K_ESCPREFIX,K_METABIT] then fpioctl(stdinputhandle,KDSKBMETA,@oldmeta); for i:=low(kbdchange) to high(kbdchange) do with kbdchange[i] do begin entry.kb_table:=tab; entry.kb_index:=idx; entry.kb_value:=oldval; fpioctl(stdinputhandle,KDSKBENT,@entry); end; entry.kb_index:=1; entry.kb_table:=0; entry.kb_value:=oldesc0; fpioctl(stdinputhandle,KDSKBENT,@entry); entry.kb_table:=1; entry.kb_value:=oldesc1; fpioctl(stdinputhandle,KDSKBENT,@entry); entry.kb_table:=2; entry.kb_value:=oldesc2; fpioctl(stdinputhandle,KDSKBENT,@entry); entry.kb_table:=4; entry.kb_value:=oldesc4; fpioctl(stdinputhandle,KDSKBENT,@entry); entry.kb_table:=8; entry.kb_value:=oldesc8; fpioctl(stdinputhandle,KDSKBENT,@entry); end; {A problem of patching the keyboard is that it no longer works as expected when working on another console. So we unpatch it when the user switches away.} procedure vt_handler(sig:longint);cdecl; begin if vt_switched_away then begin {Confirm the switch.} fpioctl(stdoutputhandle,VT_RELDISP,pointer(2)); {Switching to program, patch keyboard.} patchkeyboard; end else begin {Switching away from program, unpatch the keyboard.} unpatchkeyboard; fpioctl(stdoutputhandle,VT_RELDISP,pointer(1)); end; vt_switched_away:=not vt_switched_away; {Clear buffer.} intail:=inhead; end; procedure install_vt_handler; var mode:vt_mode; begin { ioctl(vt_fd,KDSETMODE,KD_GRAPHICS);} fpioctl(stdoutputhandle,VT_GETMODE,@mode); mode.mode:=VT_PROCESS; mode.relsig:=SIGUSR1; mode.acqsig:=SIGUSR1; vt_switched_away:=false; fpsignal(SIGUSR1,@vt_handler); fpioctl(stdoutputhandle,VT_SETMODE,@mode); end; {$endif} function ttyRecvChar:AnsiChar; var Readed,i : longint; begin {Buffer empty? Yes, input from stdin} if (InHead=InTail) then begin {Calc Amount of Chars to Read} i:=InSize-InHead; if InTail>InHead then i:=InTail-InHead; {Read} repeat Readed:=fpRead(StdInputHandle,InBuf[InHead],i); until readed<>-1; {Increase Counters} inc(InHead,Readed); {Wrap if End has Reached} if InHead>=InSize then InHead:=0; end; {Check Buffer} ttyRecvChar:=InBuf[InTail]; inc(InTail); if InTail>=InSize then InTail:=0; end; { returns an already read character back into InBuf } procedure PutBackIntoInBuf(ch: AnsiChar); begin If InTail=0 then InTail:=InSize-1 else Dec(InTail); InBuf[InTail]:=ch; end; procedure PushKey(const Ch:TEnhancedKeyEvent); var Tmp : Longint; begin Tmp:=KeyPut; Inc(KeyPut); If KeyPut>=KeyBufferSize Then KeyPut:=0; If KeyPut<>KeySend Then KeyBuffer[Tmp]:=Ch Else KeyPut:=Tmp; End; function PopKey:TEnhancedKeyEvent; begin If KeyPut<>KeySend Then begin PopKey:=KeyBuffer[KeySend]; Inc(KeySend); If KeySend>=KeyBufferSize Then KeySend:=0; End Else PopKey:=NilEnhancedKeyEvent; End; { This one doesn't care about keypresses already processed by readkey } { and waiting in the KeyBuffer, only about waiting keypresses at the } { TTYLevel (including ones that are waiting in the TTYRecvChar buffer) } function sysKeyPressed: boolean; var fdsin : tfdSet; begin if (inhead<>intail) then sysKeyPressed:=true else begin fpFD_ZERO(fdsin); fpFD_SET(StdInputHandle,fdsin); sysKeypressed:=(fpSelect(StdInputHandle+1,@fdsin,nil,nil,0)>0); end; end; function KeyPressed:Boolean; begin Keypressed := (KeySend<>KeyPut) or sysKeyPressed; End; const LastMouseEvent : TMouseEvent = ( Buttons : 0; X : 0; Y : 0; Action : 0; ); procedure GenFakeReleaseEvent(var MouseEvent : TMouseEvent); begin MouseEvent.action := MouseActionUp; MouseEvent.buttons := 0; { fake event is to decive LastMouseEvent PutMouseEvent(MouseEvent); do not make real event } end; procedure GenMouseEvent; { format: CSI M char1 charX charY char1 - button nr and state charX - mouse X (if multi byte format then 1 or 2 chars) charY - mouse Y (if multi byte format then 1 or 2 chars) } var MouseEvent: TMouseEvent; ch : AnsiChar; fdsin : tfdSet; buttonval:byte; x,y,x1 : word; notMultiByte : boolean; NeedMouseRelease:boolean; addButtMove : byte; begin fpFD_ZERO(fdsin); fpFD_SET(StdInputHandle,fdsin); { Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);} MouseEvent.buttons:=0; if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; buttonval:=byte(ch); if ch in [#$c2,#$c3] then begin {xterm multibyte} addButtMove:=(byte(ch) and 1) shl 6; if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; buttonval:=byte(ch) or addButtMove; end; NeedMouseRelease:=false; { Other bits are used for Shift, Meta and Ctrl modifiers PM } buttonval:=buttonval and %11100111; {bits 0..1: button status bit 5 : mouse movement while button down. bit 6 : interpret button 1 as button 4 interpret button 2 as button 5} case buttonval of %00100000,%01000000 : {left button pressed,moved} MouseEvent.buttons:=MouseLeftButton; %00100001,%01000001 : {middle button pressed,moved } MouseEvent.buttons:=MouseMiddleButton; %00100010,%01000010 : { right button pressed,moved } MouseEvent.buttons:=MouseRightButton; %00100011,%01000011 : { no button pressed,moved } MouseEvent.buttons:=0; %01100000: { button 4 pressed } MouseEvent.buttons:=MouseButton4; %10000000: { rxvt - button 4 move } MouseEvent.buttons:=0; {rxvt does not release button keeps moving it, fake as no button press move} %01100001: { button 5 pressed } MouseEvent.buttons:=MouseButton5; %10000001: { rxvt - button 5 move } MouseEvent.buttons:=0; %10100000,%11000000 : { xterm - button 6 pressed,moved } MouseEvent.buttons:=MouseXButton1; %01100100 : { rxvt - button 6 pressed, have to add fake release } begin MouseEvent.buttons:=MouseXButton1; NeedMouseRelease:=true; end; %10000100 : { rxvt - button 6 move } MouseEvent.buttons:=0; %10100001,%11000001 : { xterm - button 7 pressed,moved } MouseEvent.buttons:=MouseXButton2; %01100101 : { rxvt - button 7 pressed, have to add fake release } begin MouseEvent.buttons:=MouseXButton2; NeedMouseRelease:=true; end; %10000101: { rxvt - button 7 move } MouseEvent.buttons:=0; end; notMultiByte:=false; {mouse X} if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; x:=byte(ch); x1:=x; {mouse Y} if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; y:=byte(ch); {decide if this is a single byte or a multi byte mouse report format} if (x in [127..193]) or (x=0) then notMultiByte:=true else if x >= 194 then begin if ch in [#$80..#$bf] then {probably multibyte} x1:=128+(byte(ch)-128)+(x-194)*($bf-$80+1) else notMultiByte:=true; end; if y < 128 then notMultiByte:=true; {probability is high for multi byte format and we have extra character in line to read} if not notMultiByte and sysKeyPressed then begin if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; if ch > ' ' then begin {we are sure, it is a multi byte mouse report format} x:=x1; {new mouse X} y:=byte(ch); {new mouse Y} if (y <> 0 ) and sysKeyPressed and (y >= 194) then begin if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; y:=128+(byte(ch)-128)+(y-194)*($bf-$80+1); {multibyte mouse Y} end; end else PutBackIntoInBuf(ch); end; if (x=0) or (y=0) then exit; {single byte format hit its limts, no mouse event} MouseEvent.x:=x-32-1; MouseEvent.y:=y-32-1; mouseevent.action:=MouseActionMove; if (lastmouseevent.buttons=0) and (mouseevent.buttons<>0) then MouseEvent.action:=MouseActionDown; if (lastmouseevent.buttons<>0) and (mouseevent.buttons=0) then MouseEvent.action:=MouseActionUp; (* else begin if (LastMouseEvent.Buttons<>0) and ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then begin MouseEvent.Action:=MouseActionMove; MouseEvent.Buttons:=LastMouseEvent.Buttons; {$ifdef DebugMouse} Writeln(system.stderr,' Mouse Move (',MouseEvent.X,',',MouseEvent.Y,')'); {$endif DebugMouse} PutMouseEvent(MouseEvent); MouseEvent.Buttons:=0; end; MouseEvent.Action:=MouseActionUp; end; *) PutMouseEvent(MouseEvent); if (MouseEvent.buttons and (MouseButton4 or MouseButton5)) <> 0 then GenFakeReleaseEvent(MouseEvent); if NeedMouseRelease then begin GenFakeReleaseEvent(MouseEvent); PutMouseEvent(MouseEvent); {rxvt bug, need real event here as workaround } end; {$ifdef DebugMouse} if MouseEvent.Action=MouseActionDown then Write(system.stderr,'Button down : ') else Write(system.stderr,'Button up : '); Writeln(system.stderr,'buttons = ',MouseEvent.Buttons,' (',MouseEvent.X,',',MouseEvent.Y,')'); {$endif DebugMouse} LastMouseEvent:=MouseEvent; end; { The Extended/SGR 1006 mouse protocol, supported by xterm 277 and newer. Message format: Esc [<0;123;456M - mouse button press or: Esc [<0;123;456m - mouse button release Advantages: - can report X and Y coordinates larger than 223 - mouse release event informs us of *which* mouse button was released, so we can track buttons more accurately - messages use a different prefix (Esc [< instead of Esc [M) than the regular mouse event messages, so there's no need to detect if the terminal supports it - we can always try to enable it and then be prepared to handle both types of messages } procedure GenMouseEvent_ExtendedSGR1006; var MouseEvent: TMouseEvent; ch : AnsiChar; fdsin : tfdSet; buttonval: LongInt; tempstr: shortstring; code: LongInt; X, Y: LongInt; ButtonMask: Word; begin fpFD_ZERO(fdsin); fpFD_SET(StdInputHandle,fdsin); { read buttonval } tempstr:=''; repeat if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; if (ch>='0') and (ch<='9') then tempstr:=tempstr+ch else if ch<>';' then exit; until ch=';'; Val(tempstr,buttonval,code); { read X } tempstr:=''; repeat if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; if (ch>='0') and (ch<='9') then tempstr:=tempstr+ch else if ch<>';' then exit; until ch=';'; Val(tempstr,X,code); { read Y } tempstr:=''; repeat if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; if (ch>='0') and (ch<='9') then tempstr:=tempstr+ch else if (ch<>'M') and (ch<>'m') then exit; until (ch='M') or (ch='m'); Val(tempstr,Y,code); {$ifdef DebugMouse} Writeln(System.StdErr, 'SGR1006:', buttonval:3, X:5, Y:5, ' ', ch); {$endif DebugMouse} { let's range check X and Y just in case } if (X<(Low(MouseEvent.X)+1)) or (X>(High(MouseEvent.X)+1)) then exit; if (Y<(Low(MouseEvent.Y)+1)) or (Y>(High(MouseEvent.Y)+1)) then exit; case buttonval and (67 or 128) of 0 : {left button press} ButtonMask:=MouseLeftButton; 1 : {middle button pressed } ButtonMask:=MouseMiddleButton; 2 : { right button pressed } ButtonMask:=MouseRightButton; 3 : { no button pressed } ButtonMask:=0; 64: { button 4 pressed } ButtonMask:=MouseButton4; 65: { button 5 pressed } ButtonMask:=MouseButton5; 128: { button browse back } ButtonMask:=MouseXButton1; 129: { button browse forward } ButtonMask:=MouseXButton2; end; MouseEvent.X:=X-1; MouseEvent.Y:=Y-1; if (buttonval and 32)<>0 then begin MouseEvent.Action:=MouseActionMove; MouseEvent.Buttons:=LastMouseEvent.Buttons; end else begin if ch='M' then begin MouseEvent.Action:=MouseActionDown; MouseEvent.Buttons:=LastMouseEvent.Buttons or ButtonMask; end else begin MouseEvent.Action:=MouseActionUp; MouseEvent.Buttons:=LastMouseEvent.Buttons and not ButtonMask; end; end; PutMouseEvent(MouseEvent); if (ButtonMask and (MouseButton4 or MouseButton5)) <> 0 then begin MouseEvent.Action:=MouseActionUp; {to trick LastMouseEvent that we have MouseActionUp event } MouseEvent.Buttons:=LastMouseEvent.Buttons and not (MouseButton4 or MouseButton5); {PutMouseEvent(MouseEvent); do not put actual event } end; LastMouseEvent:=MouseEvent; end; var roottree:array[AnsiChar] of PTreeElement; procedure FreeElement (PT:PTreeElement); var next : PTreeElement; begin while PT <> nil do begin FreeElement(PT^.Child); next := PT^.Next; dispose(PT); PT := next; end; end; procedure FreeTree; var i:AnsiChar; begin for i:=low(roottree) to high(roottree) do begin FreeElement(RootTree[i]); roottree[i]:=nil; end; end; function NewPTree(ch : byte;Pa : PTreeElement) : PTreeElement; begin newPtree:=allocmem(sizeof(Ttreeelement)); newPtree^.AnsiChar:=ch; newPtree^.Parent:=Pa; if Assigned(Pa) and (Pa^.Child=nil) then Pa^.Child:=newPtree; end; function DoAddSequence(const St : shortstring; AChar,AScan :byte; const AShift: TEnhancedShiftState) : PTreeElement; var CurPTree,NPT : PTreeElement; c : byte; i : longint; begin if St='' then begin DoAddSequence:=nil; exit; end; CurPTree:=RootTree[st[1]]; if CurPTree=nil then begin CurPTree:=NewPTree(ord(st[1]),nil); RootTree[st[1]]:=CurPTree; end; for i:=2 to Length(St) do begin NPT:=CurPTree^.Child; c:=ord(St[i]); if NPT=nil then NPT:=NewPTree(c,CurPTree); CurPTree:=nil; while assigned(NPT) and (NPT^.AnsiCharAScan) or (CharValue<>AChar) then Writeln(system.stderr,'key "',st,'" changed value'); if (ScanValue<>AScan) then Writeln(system.stderr,'Scan was ',ScanValue,' now ',AScan); if (CharValue<>AChar) then Writeln(system.stderr,'AnsiChar was ',chr(CharValue),' now ',chr(AChar)); {$endif DEBUG1} ScanValue:=AScan; CharValue:=AChar; ShiftValue:=AShift; end; end else with CurPTree^ do begin CanBeTerminal:=True; ScanValue:=AScan; CharValue:=AChar; ShiftValue:=AShift; end; DoAddSequence:=CurPTree; end; procedure AddSequence(const St : shortstring; AChar,AScan :byte);inline; begin DoAddSequence(St,AChar,AScan,[]); end; { Returns the Child that as c as AnsiChar if it exists } function FindChild(c : byte;Root : PTreeElement) : PTreeElement; var NPT : PTreeElement; begin NPT:=Root^.Child; while assigned(NPT) and (NPT^.AnsiChar encode as single WideChar } k.UnicodeChar:=WideChar(UnicodeCodePoint); if UnicodeCodePoint<=127 then k.AsciiChar:=Chr(UnicodeCodePoint) else k.AsciiChar:=ReplacementAsciiChar; PushKey(k); end else if UnicodeCodePoint<=$10FFFF then begin { Code point from the Supplementary Planes (U+010000..U+10FFFF) -> encode as a surrogate pair of WideChars (as in UTF-16) } k.UnicodeChar:=WideChar(((UnicodeCodePoint-$10000) shr 10)+$D800); k.AsciiChar:=ReplacementAsciiChar; PushKey(k); k.UnicodeChar:=WideChar(((UnicodeCodePoint-$10000) and %1111111111)+$DC00); PushKey(k); end; end; const {lookup tables: nKey, modifier -> ScanCode, KeyChar } cAltAscii : array [0..127] of AnsiChar = ( #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00); cCtrlAscii : array [0..127] of AnsiChar = ( #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$08,#$00,#$00,#$00,#$00,#$0a,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$1b,#$00,#$00,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00, #$00,#$01,#$02,#$03,#$04,#$05,#$06,#$00,#$00,#$09,#$0a,#$0b,#$0c,#$0d,#$0e,#$0f, #$10,#$11,#$12,#$13,#$14,#$15,#$16,#$17,#$18,#$19,#$1a,#$1b,#$1c,#$1d,#$1e,#$1f, #$00,#$01,#$02,#$03,#$04,#$05,#$06,#$07,#$08,#$09,#$0a,#$0b,#$0c,#$0d,#$0e,#$0f, #$10,#$11,#$12,#$13,#$14,#$15,#$16,#$17,#$18,#$19,#$1a,#$1b,#$1c,#$1d,#$1e,#$7f); cShiftAscii : array [0..127] of AnsiChar = ( #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$08,#$00,#$00,#$00,#$00,#$0d,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$00,#$1b,#$00,#$00,#$00,#$00, #$20,#$21,#$22,#$23,#$24,#$25,#$26,#$00,#$28,#$29,#$2a,#$2b,#$00,#$2d,#$2e,#$2f, #$30,#$31,#$32,#$33,#$34,#$35,#$36,#$37,#$38,#$39,#$3a,#$00,#$3c,#$00,#$3e,#$3f, #$40,#$41,#$42,#$43,#$44,#$45,#$46,#$47,#$48,#$49,#$4a,#$4b,#$4c,#$4d,#$4e,#$4f, #$50,#$51,#$52,#$53,#$54,#$55,#$56,#$57,#$58,#$59,#$5a,#$00,#$00,#$00,#$5e,#$5f, #$00,#$61,#$62,#$63,#$64,#$65,#$66,#$67,#$68,#$69,#$6a,#$6b,#$6c,#$6d,#$6e,#$6f, #$70,#$71,#$72,#$73,#$74,#$75,#$76,#$77,#$78,#$79,#$7a,#$7b,#$7c,#$7d,#$7e,#$08); cAscii : array [0..127] of AnsiChar = ( #$00,#$00,#$00,#$00,#$04,#$00,#$00,#$00,#$08,#$09,#$00,#$00,#$00,#$0d,#$00,#$00, #$00,#$00,#$00,#$00,#$00,#$15,#$00,#$00,#$00,#$00,#$00,#$1b,#$00,#$00,#$00,#$00, #$20,#$00,#$00,#$00,#$00,#$00,#$00,#$27,#$00,#$00,#$2a,#$2b,#$2c,#$2d,#$2e,#$2f, #$30,#$31,#$32,#$33,#$34,#$35,#$36,#$37,#$38,#$39,#$00,#$3b,#$3c,#$3d,#$00,#$00, #$00,#$41,#$42,#$43,#$44,#$45,#$46,#$47,#$48,#$49,#$4a,#$4b,#$4c,#$4d,#$4e,#$4f, #$50,#$51,#$52,#$53,#$54,#$55,#$56,#$57,#$58,#$59,#$5a,#$5b,#$5c,#$5d,#$00,#$00, #$60,#$61,#$62,#$63,#$64,#$65,#$66,#$67,#$68,#$69,#$6a,#$6b,#$6c,#$6d,#$6e,#$6f, #$70,#$71,#$72,#$73,#$74,#$75,#$76,#$77,#$78,#$79,#$7a,#$00,#$00,#$00,#$00,#$08); cScanValue : array [0..127] of byte = ( $fe, $00, $00, $00, $20, $00, $00, $00, $0e, $0f, $00, $00, $00, $1c, $00, $00, $00, $00, $00, $00, $00, $16, $00, $00, $00, $00, $00, $01, $00, $00, $00, $00, $39, $00, $00, $00, $00, $00, $00, $28, $00, $00, $37, $0d, $33, $0c, $34, $35, $0b, $02, $03, $04, $05, $06, $07, $08, $09, $0a, $00, $27, $33, $0d, $00, $00, $00, $1e, $30, $2e, $20, $12, $21, $22, $23, $17, $24, $25, $26, $32, $31, $18, $19, $10, $13, $1f, $14, $16, $2f, $11, $2d, $15, $2c, $1a, $2b, $1b, $00, $00, $2b, $1e, $30, $2e, $20, $12, $21, $22, $23, $17, $24, $25, $26, $32, $31, $18, $19, $10, $13, $1f, $14, $16, $2f, $11, $2d, $15, $2c, $00, $00, $00, $00, $0e); cShiftScanValue : array [0..127] of byte = ( $fe, $00, $00, $00, $00, $00, $00, $00, $0e, $0f, $00, $00, $00, $1c, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $00, $00, $00, $00, $39, $02, $28, $04, $05, $06, $08, $00, $0a, $0b, $09, $0d, $00, $0c, $53, $35, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $27, $00, $33, $00, $34, $35, $03, $1e, $30, $2e, $20, $12, $21, $22, $23, $17, $24, $25, $26, $32, $31, $18, $19, $10, $13, $1f, $14, $16, $2f, $11, $2d, $15, $2c, $00, $00, $00, $07, $0c, $00, $1e, $30, $2e, $20, $12, $21, $22, $23, $17, $24, $25, $26, $32, $31, $18, $19, $10, $13, $1f, $14, $16, $2f, $11, $2d, $15, $2c, $1a, $2b, $1b, $29, $0e); cAltScanValue : array [0..127] of byte = ( $fe, $00, $00, $00, $00, $00, $00, $00, $0e, $00, $00, $00, $00, $1c, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $00, $00, $00, $00, $39, $78, $28, $7a, $7b, $7c, $7e, $28, $80, $81, $7f, $83, $33, $82, $34, $35, $81, $78, $79, $7a, $7b, $7c, $7d, $7e, $7f, $80, $27, $27, $33, $83, $34, $35, $79, $1e, $30, $2e, $20, $12, $21, $00, $00, $17, $24, $25, $26, $32, $31, $18, $19, $10, $13, $1f, $14, $16, $2f, $11, $2d, $15, $2c, $1a, $2b, $1b, $7d, $82, $2b, $1e, $30, $2e, $20, $12, $21, $22, $23, $17, $24, $25, $26, $32, $31, $18, $19, $10, $13, $1f, $14, $16, $2f, $11, $2d, $15, $2c, $1a, $2b, $1b, $29, $0e); cCtrlScanValue : array [0..127] of byte = ( $fe, $00, $00, $00, $00, $00, $00, $00, $0e, $94, $00, $00, $00, $1c, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01, $00, $00, $00, $00, $39, $02, $28, $04, $05, $06, $08, $28, $0a, $0b, $96, $0d, $33, $0c, $34, $35, $0b, $02, $03, $04, $05, $06, $07, $08, $09, $0a, $27, $27, $33, $0d, $34, $35, $03, $1e, $30, $2e, $20, $12, $21, $00, $00, $17, $24, $25, $26, $32, $31, $18, $19, $10, $13, $1f, $14, $16, $2f, $11, $2d, $15, $2c, $1a, $2b, $1b, $07, $0c, $29, $1e, $30, $2e, $20, $12, $21, $22, $23, $17, $24, $25, $26, $32, $31, $18, $19, $10, $13, $1f, $14, $16, $2f, $11, $2d, $15, $2c, $1a, $2b, $1b, $29, $0e); procedure BuildKeyEvent(modifier:dword; nKey, nShortCutKey :dword); var k : TEnhancedKeyEvent; SState: TEnhancedShiftState; ScanValue : byte; Key : dword; begin k:=NilEnhancedKeyEvent; AltPrefix := 0; ShiftPrefix := 0; CtrlPrefix := 0; { Shift states} if modifier = 0 then modifier:=1; modifier:=modifier-1; SState:=[]; if (modifier and 1)>0 then SState:=SState+[essShift]; if (modifier and 2)>0 then SState:=SState+[essAlt]; if (modifier and 4)>0 then SState:=SState+[essCtrl]; k.ShiftState:=SState; Key:=nShortCutKey; if Key < 128 then begin if essAlt in SState then k.AsciiChar:=cAltAscii[Key] else if essCtrl in SState then k.AsciiChar:=cCtrlAscii[Key] else if essShift in SState then k.AsciiChar:=cShiftAscii[Key] else k.AsciiChar:=cAscii[Key]; if essAlt in SState then ScanValue :=cAltScanValue[Key] else if essCtrl in SState then ScanValue :=cCtrlScanValue[Key] else if essShift in SState then ScanValue :=cShiftScanValue[Key] else ScanValue :=cScanValue[Key]; if essCtrl in SState then begin // For modern protocols (kitty, modifyOtherKeys), Ctrl+ should // generate the letter itself, not a C0 control character. // Therefore, we do not overwrite nKey (which becomes UnicodeChar) // with the control character's code if a letter was pressed. if not (((Key >= $41) and (Key <= $5A)) or ((Key >= $61) and (Key <= $7A))) then nKey := Ord(k.AsciiChar); end; k.VirtualScanCode := (ScanValue shl 8) or Ord(k.AsciiChar); // This is a dirty hack. Unfortunately, our hotkey mapping code // (everywhere except for the recently fixed code for the top menu) // for some reason (this is to be debugged) cannot handle events // with nonzero _character_ codes. So until all those code paths are fixed, // we zero out the character codes here to make Alt hotkeys work properly. // However, we do this only for Latin hotkeys, so that non-Latin ones // can continue working with the new top menu code. Latin hotkeys, // on the other hand, will be recognized by their _key_ codes. if (essAlt in SState) and (nKey < 128) then nKey := 0; if nKey <= $FFFF then begin k.UnicodeChar := WideChar(nKey); PushKey(k); end else PushUnicodeKey (k,nKey,char(k.AsciiChar)); // This line caused duplicate ESC key press events in kitty mode // if byte(k.AsciiChar) = 27 then PushKey(k); end else PushUnicodeKey (k,nKey,UnicodeToSingleByte(nKey)); end; procedure xterm_ModifyOtherKeys; { format: CSI 27 ; modifier ; number ~ } var ch : AnsiChar; fdsin : tfdSet; st: string[31]; modifier : dword; nKey : dword; nr : byte; i : dword; begin fpFD_ZERO(fdsin); fpFD_SET(StdInputHandle,fdsin); nr:=0; modifier:=1; nKey:=0; st:='0'; repeat if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; if ch in [';','~'] then begin if nr = 0 then val(st,modifier,i); if nr = 1 then val(st,nKey,i); inc(nr); st:='0'; end else begin if not (ch in ['0'..'9']) then break; st:=st+ch; end; until ch='~'; {test for validity} if ch<>'~' then exit; if nr<> 2 then exit; BuildKeyEvent(modifier,nKey,nKey); end; procedure LoadDefaultSequences; var i:cardinal; begin AddSpecialSequence(#27'[M',@GenMouseEvent); AddSpecialSequence(#27'[<',@GenMouseEvent_ExtendedSGR1006); AddSpecialSequence(#27#27'[M',@GenMouseEvent); AddSpecialSequence(#27#27'[<',@GenMouseEvent_ExtendedSGR1006); if not isKittyKeys then AddSpecialSequence(#27'[27;',@xterm_ModifyOtherKeys); {Unix backspace/delete hell... Is #127 a backspace or delete?} if copy(fpgetenv('TERM'),1,4)='cons' then begin {FreeBSD is until now only terminal that uses it for delete.} DoAddSequence(#127,0,kbDel,[]); {Delete} DoAddSequence(#27#127,0,kbAltDel,[essAlt]); {Alt+delete} end else begin DoAddSequence(#127,8,0,[]); {Backspace} DoAddSequence(#27#127,0,kbAltBack,[essAlt]); {Alt+backspace} end; { all Esc letter } for i:=low(key_sequences) to high(key_sequences) do with key_sequences[i] do DoAddSequence(st,AnsiChar,scan,shift); if detect_terminal in [trRxvt] then begin {rxvt specific escape sequences} for i:=low(rxvt_key_sequences) to high(rxvt_key_sequences) do with rxvt_key_sequences[i] do DoAddSequence(st,AnsiChar,scan,shift); end; sunKeySquences; end; function RawReadKey:AnsiChar; var fdsin : tfdSet; begin {Check Buffer first} { if KeySend<>KeyPut then begin RawReadKey:=PopKey; exit; end;} {Wait for Key} if not sysKeyPressed then begin fpFD_ZERO (fdsin); fpFD_SET (StdInputHandle,fdsin); fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil); end; RawReadKey:=ttyRecvChar; end; function RawReadString : shortstring; var ch : AnsiChar; fdsin : tfdSet; St : shortstring; begin St:=RawReadKey; fpFD_ZERO (fdsin); fpFD_SET (StdInputHandle,fdsin); Repeat if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); if SysKeyPressed then ch:=ttyRecvChar else ch:=#0; if ch<>#0 then St:=St+ch; if length(st)=255 then break; Until ch=#0; RawReadString:=St; end; {$ifdef linux} function ShiftState:byte; var arg:longint; begin shiftstate:=0; arg:=6; if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then begin if (arg and 8)<>0 then shiftstate:=kbAlt; if (arg and 4)<>0 then inc(shiftstate,kbCtrl); { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM } if (arg and 2)<>0 then shiftstate:=shiftstate or (kbAlt or kbCtrl); if (arg and 1)<>0 then inc(shiftstate,kbShift); end; end; function EnhShiftState:TEnhancedShiftState; const KG_SHIFT = 0; KG_CTRL = 2; KG_ALT = 3; KG_ALTGR = 1; KG_SHIFTL = 4; KG_KANASHIFT = 4; KG_SHIFTR = 5; KG_CTRLL = 6; KG_CTRLR = 7; KG_CAPSSHIFT = 8; var arg: longint; begin EnhShiftState:=[]; arg:=6; if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then begin if (arg and (1 shl KG_ALT))<>0 then Include(EnhShiftState,essAlt); if (arg and (1 shl KG_CTRL))<>0 then Include(EnhShiftState,essCtrl); if (arg and (1 shl KG_CTRLL))<>0 then Include(EnhShiftState,essLeftCtrl); if (arg and (1 shl KG_CTRLR))<>0 then Include(EnhShiftState,essRightCtrl); if (arg and (1 shl KG_ALTGR))<>0 then Include(EnhShiftState,essAltGr); if (arg and (1 shl KG_SHIFT))<>0 then Include(EnhShiftState,essShift); if (arg and (1 shl KG_SHIFTL))<>0 then Include(EnhShiftState,essLeftShift); if (arg and (1 shl KG_SHIFTR))<>0 then Include(EnhShiftState,essRightShift); end; end; procedure force_linuxtty; var s:string[15]; handle:sizeint; thistty:shortstring; begin is_console:=false; if vcs_device<>-1 then begin { running on a tty, find out whether locally or remotely } thistty:=ttyname(stdinputhandle); if (copy(thistty,1,8)<>'/dev/tty') or not (thistty[9] in ['0'..'9']) then begin {Running from Midnight Commander or something... Bypass it.} str(vcs_device,s); handle:=fpopen('/dev/tty'+s,O_RDWR); fpioctl(stdinputhandle,TIOCNOTTY,nil); {This will currently only work when the user is root :(} fpioctl(handle,TIOCSCTTY,nil); if errno<>0 then exit; fpclose(stdinputhandle); fpclose(stdoutputhandle); fpclose(stderrorhandle); fpdup2(handle,stdinputhandle); fpdup2(handle,stdoutputhandle); fpdup2(handle,stderrorhandle); fpclose(handle); end; is_console:=true; end; end; {$endif linux} function DetectUtf8ByteSequenceStart(ch: AnsiChar): LongInt; begin if Ord(ch)<128 then DetectUtf8ByteSequenceStart:=1 else if (Ord(ch) and %11100000)=%11000000 then DetectUtf8ByteSequenceStart:=2 else if (Ord(ch) and %11110000)=%11100000 then DetectUtf8ByteSequenceStart:=3 else if (Ord(ch) and %11111000)=%11110000 then DetectUtf8ByteSequenceStart:=4 else DetectUtf8ByteSequenceStart:=0; end; function IsValidUtf8ContinuationByte(ch: AnsiChar): Boolean; begin IsValidUtf8ContinuationByte:=(Ord(ch) and %11000000)=%10000000; end; const cKeysUnicodePrivateBase = 57344; { unicode private area starts here} kCapsLock = 14; kScrollLock = 15; kNumLock = 16; kPrintScreen = 17; kPauseBreak = 18; kMenu = 19; {Numpad keys} kDecimal = 65; kDivide = 66; kMultiple = 67; kMinuss = 68; kPluss = 69; kEnter = 70; kEqual = 71; kSeperator = 72; kLeft = 73; kRight = 74; kUp = 75; kDown = 76; kPgUp = 77; kPgDown = 78; kHome = 79; kEnd = 80; kIns = 81; kDel = 82; kMiddle = 83; {modifyers} kShiftLeft = 97; kCtrlLeft = 98; kAltLeft = 99; kSuperLeft = 100; kShiftRight = 103; kCtrlRight = 104; kAltRight = 105; kSuperRight = 106; kAltGr = 109; const { lookup tables for ScanCodes of numpad keys} cKP_ScanVal : array [kDecimal..kMiddle] of byte = ( { kDecimal = 65; } $53, { kDivide = 66; } $e0, { kMultiple = 67; } $37, { kMinuss = 68; } $4a, { kPluss = 69; } $4e, { kEnter = 70; } $e0, { kEqual = 71; } $f0, {none} { kSeperator = 72; } $f1, {none} { kLeft = 73; } $4b, { kRight = 74; } $4d, { kUp = 75; } $48, { kDown = 76; } $50, { kPgUp = 77; } $49, { kPgDown = 78; } $51, { kHome = 79; } $47, { kEnd = 80; } $4f, { kIns = 81; } $52, { kDel = 82; } $53, { kMiddle = 83; } $4c); const cKP_CtrlScanVal : array [kDecimal..kMiddle] of byte = ( { kDecimal = 65; } $93, { kDivide = 66; } $95, { kMultiple = 67; } $96, { kMinuss = 68; } $8e, { kPluss = 69; } $90, { kEnter = 70; } $e0, { kEqual = 71; } $f0, {none} { kSeperator = 72; } $f1, {none} { kLeft = 73; } $73, { kRight = 74; } $74, { kUp = 75; } $8d, { kDown = 76; } $91, { kPgUp = 77; } $84, { kPgDown = 78; } $76, { kHome = 79; } $77, { kEnd = 80; } $75, { kIns = 81; } $92, { kDel = 82; } $93, { kMiddle = 83; } $8f); const cKP_AltScanVal : array [kDecimal..kMiddle] of byte = ( { kDecimal = 65; } $93, { kDivide = 66; } $a4, { kMultiple = 67; } $37, { kMinuss = 68; } $4a, { kPluss = 69; } $4e, { kEnter = 70; } $a6, { kEqual = 71; } $f0, {none} { kSeperator = 72; } $f1, {none} { kLeft = 73; } $9b, { kRight = 74; } $9d, { kUp = 75; } $98, { kDown = 76; } $a0, { kPgUp = 77; } $99, { kPgDown = 78; } $a1, { kHome = 79; } $97, { kEnd = 80; } $9f, { kIns = 81; } $92, { kDel = 82; } $93, { kMiddle = 83; } $8f); procedure BuildKeyPadEvent(modifier:dword; nKey:dword; ch : AnsiChar); var k : TEnhancedKeyEvent; SState: TEnhancedShiftState; ScanValue : byte; begin k:=NilEnhancedKeyEvent; AltPrefix := 0; ShiftPrefix := 0; CtrlPrefix := 0; { Shift states} if modifier = 0 then modifier:=1; modifier:=modifier-1; SState:=[]; if (modifier and 1)>0 then SState:=SState+[essShift]; if (modifier and 2)>0 then SState:=SState+[essAlt]; if (modifier and 4)>0 then SState:=SState+[essCtrl]; k.ShiftState:=SState; if nKey < 128 then begin if nKey = kEnter then begin if essAlt in SState then ch:=#0 else if essCtrl in SState then ch:=#$0a else if essShift in SState then ch:=#$0d else ch:=#$0d; end; if essAlt in SState then k.AsciiChar:=#0 else if essCtrl in SState then k.AsciiChar:=ch else if essShift in SState then k.AsciiChar:=ch else k.AsciiChar:=ch; if essAlt in SState then ScanValue :=cKP_AltScanVal[nKey] else if essCtrl in SState then ScanValue :=cKP_CtrlScanVal[nKey] else if essShift in SState then ScanValue :=cKP_ScanVal[nKey] else ScanValue :=cKP_ScanVal[nKey]; k.UnicodeChar := WideChar(k.AsciiChar); k.VirtualScanCode := (ScanValue shl 8) or Ord(k.AsciiChar); PushKey(k); end; end; function RemoveShiftState(AShiftState:TEnhancedShiftState; toRemoveState,aState,toTestState:TEnhancedShiftStateElement):TEnhancedShiftState; { remove state toRemoveState and } { remove state aState if AShiftState does not contain toTestState } begin AShiftState:=AShiftState-[toRemoveState]; if not (toTestState in AShiftState) then AShiftState:=AShiftState-[aState]; RemoveShiftState:=AShiftState; end; var LastShiftState, CurrentShiftState : TEnhancedShiftState; function GetLastShiftState : byte; { get fake shift state or current shift state for kitty keys } var State : byte; begin State:=0; if isKittyKeys then begin LastShiftState:=CurrentShiftState; if essLeftShift in LastShiftState then inc(state,kbLeftShift); if essRightShift in LastShiftState then inc(state,kbRightShift); if (essShift in LastShiftState) and (not ((essRightShift in LastShiftState) or (essLeftShift in LastShiftState))) then inc(state,kbShift); {this for super rare case when shift state key press was not recived (maybe that is impossible)} end else if essShift in LastShiftState then inc(state,kbShift); if essCtrl in LastShiftState then inc(state,kbCtrl); if essAlt in LastShiftState then inc(state,kbAlt); GetLastShiftState:=State; end; procedure UpdateCurrentShiftState(nKey:longint; kbDown:byte); begin {current shift state changes} if kbDown <3 then begin {state key down} case nKey of kShiftLeft : CurrentShiftState:=CurrentShiftState +[essShift,essLeftShift]; kShiftRight : CurrentShiftState:=CurrentShiftState +[essShift,essRightShift]; kCtrlLeft : CurrentShiftState:=CurrentShiftState +[essCtrl,essLeftCtrl]; kCtrlRight : CurrentShiftState:=CurrentShiftState +[essCtrl,essRightCtrl]; kAltRight : CurrentShiftState:=CurrentShiftState +[essAlt,essRightAlt]; kAltLeft : CurrentShiftState:=CurrentShiftState +[essAlt,essLeftAlt]; kAltGr : CurrentShiftState:=CurrentShiftState +[essAltGr]; end; end else begin {state key up} case nKey of kShiftLeft : CurrentShiftState:=RemoveShiftState(CurrentShiftState,essLeftShift,essShift,essRightShift); kShiftRight : CurrentShiftState:=RemoveShiftState(CurrentShiftState,essRightShift,essShift,essLeftShift); kCtrlLeft : CurrentShiftState:=RemoveShiftState(CurrentShiftState,essLeftCtrl,essCtrl,essRightCtrl); kCtrlRight : CurrentShiftState:=RemoveShiftState(CurrentShiftState,essRightCtrl,essCtrl,essLeftCtrl); kAltRight : CurrentShiftState:=RemoveShiftState(CurrentShiftState,essRightAlt,essAlt,essLeftAlt); kAltLeft : CurrentShiftState:=RemoveShiftState(CurrentShiftState,essLeftAlt,essAlt,essRightAlt); kAltGr : CurrentShiftState:=CurrentShiftState -[essAltGr]; end; end; end; procedure UpdateShiftStateWithModifier(modifier:longint); { Sanity double check. In case if there is no generated shift state key release (shortcut key intercepted by OS or terminal). } { Make sure on key press there is correct current shift state } begin { Shift states} if modifier = 0 then modifier:=1; modifier:=modifier-1; if (modifier and 1)>0 then begin if not (essShift in CurrentShiftState) then CurrentShiftState:=CurrentShiftState+[essShift]; end else if (essShift in CurrentShiftState) then CurrentShiftState:=CurrentShiftState-[essLeftShift,essShift,essRightShift]; if (modifier and 2)>0 then begin if not (essAlt in CurrentShiftState) then CurrentShiftState:=CurrentShiftState+[essAlt]; end else if (essAlt in CurrentShiftState) then CurrentShiftState:=CurrentShiftState-[essLeftAlt,essAlt,essRightAlt]; if (modifier and 4)>0 then begin if not (essCtrl in CurrentShiftState) then CurrentShiftState:=CurrentShiftState+[essCtrl]; end else if (essCtrl in CurrentShiftState) then CurrentShiftState:=CurrentShiftState-[essRightCtrl,essCtrl,essLeftCtrl]; end; function ReadKey:TEnhancedKeyEvent; var store : array [0..31] of AnsiChar; arrayind : byte; SState: TEnhancedShiftState; procedure DecodeAndPushWin32Key(const store: array of AnsiChar; arrayind: byte); function VKToScanCode(vk: Word): Byte; begin case vk of // Standard keys $41..$5A : VKToScanCode := cScanValue[vk]; // 'A'..'Z' $30..$39 : VKToScanCode := cScanValue[vk]; // '0'..'9' $08: VKToScanCode := kbBack; $09: VKToScanCode := kbTab; $0D: VKToScanCode := kbEnter; $1B: VKToScanCode := kbEsc; $20: VKToScanCode := kbSpaceBar; // Function keys $70..$79: VKToScanCode := vk - $70 + kbF1; // F1-F10 $7A..$7B: VKToScanCode := vk - $7A + kbF11; // F11-F12 // Navigation keys $2D: VKToScanCode := kbIns; $2E: VKToScanCode := kbDel; $24: VKToScanCode := kbHome; $23: VKToScanCode := kbEnd; $21: VKToScanCode := kbPgUp; $22: VKToScanCode := kbPgDn; $26: VKToScanCode := kbUp; $28: VKToScanCode := kbDown; $25: VKToScanCode := kbLeft; $27: VKToScanCode := kbRight; // Modifier keys (scancodes for L/R versions) $10: VKToScanCode := $2A; // VK_SHIFT -> Left shift $11: VKToScanCode := $1D; // VK_CONTROL -> Left control $12: VKToScanCode := $38; // VK_MENU -> Left alt // Lock keys $14: VKToScanCode := $3A; // VK_CAPITAL $90: VKToScanCode := $45; // VK_NUMLOCK $91: VKToScanCode := $46; // VK_SCROLL // OEM Keys $BA: VKToScanCode := $27; // VK_OEM_1 (;) $BB: VKToScanCode := $0D; // VK_OEM_PLUS (=) $BC: VKToScanCode := $33; // VK_OEM_COMMA (,) $BD: VKToScanCode := $0C; // VK_OEM_MINUS (-) $BE: VKToScanCode := $34; // VK_OEM_PERIOD (.) $BF: VKToScanCode := $35; // VK_OEM_2 (/) $C0: VKToScanCode := $29; // VK_OEM_3 (`) $DB: VKToScanCode := $1A; // VK_OEM_4 ([) $DC: VKToScanCode := $2B; // VK_OEM_5 (\) $DD: VKToScanCode := $1B; // VK_OEM_6 (]) $DE: VKToScanCode := $28; // VK_OEM_7 (') else VKToScanCode := 0; end; end; var params: array[0..5] of LongInt; // Vk, Sc, Uc, Kd, Cs, Rc i, p_idx, code: Integer; st: string; ch: AnsiChar; ScanCode: Byte; k: TEnhancedKeyEvent; begin // 1. Parse the parameters: Vk;Sc;Uc;Kd;Cs;Rc for i := 0 to 5 do params[i] := 0; // Clear params params[5] := 1; // Default repeat count is 1 p_idx := 0; st := ''; // Start from after the CSI: ^[[ for i := 2 to arrayind - 2 do begin ch := store[i]; if ch = ';' then begin if st <> '' then Val(st, params[p_idx], code); st := ''; Inc(p_idx); if p_idx > 5 then Break; end else if ch in ['0'..'9'] then st := st + ch; end; // Last parameter if (p_idx <= 5) and (st <> '') then Val(st, params[p_idx], code); // For non-printable command keys, we must ignore any character code provided // by the terminal (like #127 for Del) and force it to 0. This ensures the // application interprets the key event as a command (via its scancode) // rather than as a character to be printed. case params[0] of // Check Virtual Key Code (wVirtualKeyCode) // Function keys F1-F12 $70..$7B, // Arrow keys (Left, Up, Right, Down) $25..$28, // Navigation keys (PgUp, PgDn, End, Home, Ins, Del) $21..$24, $2D, $2E: params[2] := 0; // Force UnicodeChar to be 0 end; // 2. Process only key down and repeat events (param[3] must be non-zero) if params[3] = 0 then exit; // Ignore key up events completely for now. // The sequence is considered "handled". // 3. Create a new key event k := NilEnhancedKeyEvent; // 4. Map ControlKeyState (Cs) to ShiftState if (params[4] and SHIFT_PRESSED) <> 0 then Include(k.ShiftState, essShift); if (params[4] and LEFT_CTRL_PRESSED) <> 0 then Include(k.ShiftState, essLeftCtrl); if (params[4] and RIGHT_CTRL_PRESSED) <> 0 then Include(k.ShiftState, essRightCtrl); if (params[4] and (LEFT_CTRL_PRESSED or RIGHT_CTRL_PRESSED)) <> 0 then Include(k.ShiftState, essCtrl); if (params[4] and LEFT_ALT_PRESSED) <> 0 then Include(k.ShiftState, essLeftAlt); if (params[4] and RIGHT_ALT_PRESSED) <> 0 then Include(k.ShiftState, essRightAlt); if (params[4] and (LEFT_ALT_PRESSED or RIGHT_ALT_PRESSED)) <> 0 then Include(k.ShiftState, essAlt); // 5. Map Uc, Sc, and Vk k.UnicodeChar := WideChar(params[2]); if params[2] <= 127 then k.AsciiChar := AnsiChar(params[2]) else k.AsciiChar := UnicodeToSingleByte(params[2]); ScanCode := params[1]; // wVirtualScanCode if ScanCode = 0 then ScanCode := VKToScanCode(params[0]); // wVirtualKeyCode // If we have a char but no special scancode, use the char's scancode if (ScanCode = 0) and (Ord(k.AsciiChar) > 0) and (Ord(k.AsciiChar) < 128) then ScanCode := cScanValue[Ord(k.AsciiChar)]; k.VirtualScanCode := (ScanCode shl 8) or Ord(k.AsciiChar); PushKey(k); end; procedure DecodeKittyKey(var k :TEnhancedKeyEvent; var NPT : PTreeElement); var i : dword; wc: wideChar; ch: AnsiChar; st:string[15]; escStr:string[15]; asIs:string[15]; unicodeCodePoint : longint; z : longint; NNPT : PTreeElement; enh: array[0..11] of longint; iE : dword; kbDown : byte; nKey : longint; modifier: longint; shortCutKey: LongInt; begin { if arrayind>0 then for i:= 0 to arrayind-1 do begin write(hexstr(byte(store[i]),2),' '); end;} iE:=0; fillchar(enh,sizeof(enh),$ff); enh[3]:=1; enh[4]:=1; st:=''; asIs:=''; if arrayind > 2 then for i:= 2 to arrayind-1 do begin ch:=store[i]; asIs:=asIs+ch; if ch in ['0'..'9'] then st:=st+ch else begin if length(st)>0 then begin val(st,unicodeCodePoint,z); enh[iE]:=unicodeCodePoint; end; st:=''; if ch =';' then begin iE:=((iE div 3)+1)*3; end else if ch =':' then inc(iE); if not (ch in [';',':']) then break; end; end; nKey:=enh[0]; modifier:=((enh[3]-1)and 7)+1; kbDown:=enh[4]; unicodeCodePoint:=enh[6]; if unicodeCodePoint < 0 then unicodeCodePoint:=enh[0]; enh[5]:=modifier; escStr:=''; ch:=store[arrayind-1]; if (ch='E') and (enh[6]>0) then ch:='u'; {this is one exception (numlock off, Shift+Center (numpad 5))} case ch of '~': begin if kbDown<3 then begin str(nKey,st); escStr:='_['+st; if modifier>1 then begin str(modifier,st); escStr:=escStr+';'+st; end; escStr:=escStr+ch; for i:=2 to length(escStr) do begin ch:=escStr[i]; NPT:=FindChild(ord(ch),NPT); if not assigned(NPT) then begin break; end; end; end else NPT:=nil; end; 'A','B','C','D','E','F','H','P','Q','S': begin if kbDown<3 then begin escStr:='_['; if modifier>1 then begin str(modifier,st); escStr:=escStr+'1;'+st; end else begin if ch in ['P','Q','S'] then { F1, F2, F4 } escStr:='_O'; end; escStr:=escStr+ch; for i:=2 to length(escStr) do begin ch:=escStr[i]; NPT:=FindChild(ord(ch),NPT); if not assigned(NPT) then begin break; end; end; end else NPT:=nil; end; otherwise NPT:=nil; end; UpdateShiftStateWithModifier(modifier); if kbDown =3 then arrayind:=0; {release keys are ignored} if not assigned(NPT) and (ch='u') then begin if (unicodeCodePoint >=57344) and (unicodeCodePoint<=63743) then begin {function keys have been pressed} arrayind:=0; nKey:=unicodeCodePoint-cKeysUnicodePrivateBase; if (nKey >=kShiftLeft) and (nKey<=kAltGr) then UpdateCurrentShiftState(nKey,kbDown); if (nKey < 128) and (kbDown <3) then begin if nKey = 60 then nKey:= kMiddle; {KP_5 -> KP_BEGIN} if nKey in [kDecimal..kMiddle] then begin BuildKeyPadEvent(modifier,nKey,#0); exit; end else exit; end else {ignore...} exit; end; if kbDown =3 then exit; {key up... ignored} if (modifier > 2) and (enh[2]>=0) and (unicodeCodePoint>=0) then begin { ctrl, alt, shift + key combinations generate shortcut keys not tide to localized keyboard layout } if (enh[1]>=0) then nKey:=enh[1]; BuildKeyEvent(modifier,nKey,enh[2]); end else if unicodeCodePoint>-1 then begin nKey:=unicodeCodePoint; if (enh[1]>=0) then nKey:=enh[1]; shortCutKey := enh[2]; if shortCutKey < 0 then shortCutKey := nKey; BuildKeyEvent(modifier, nKey, shortCutKey); end; arrayind:=0; end; end; procedure RestoreArray; var i : byte; k : TEnhancedKeyEvent; begin if arrayind>0 then for i:=0 to arrayind-1 do begin k := NilEnhancedKeyEvent; k.AsciiChar := store[i]; k.VirtualScanCode := Ord(k.AsciiChar); k.ShiftState := SState; { todo: how to set the other fields? } PushKey(k); end; end; function ReadUtf8(ch: AnsiChar): LongInt; const ErrorCharacter = $FFFD; { U+FFFD = REPLACEMENT CHARACTER } var CodePoint: LongInt; begin ReadUtf8:=ErrorCharacter; case DetectUtf8ByteSequenceStart(ch) of 1: ReadUtf8:=Ord(ch); 2:begin CodePoint:=(Ord(ch) and %00011111) shl 6; ch:=ttyRecvChar; if not IsValidUtf8ContinuationByte(ch) then exit; CodePoint:=(Ord(ch) and %00111111) or CodePoint; if (CodePoint>=$80) and (CodePoint<=$7FF) then ReadUtf8:=CodePoint; end; 3:begin CodePoint:=(Ord(ch) and %00001111) shl 12; ch:=ttyRecvChar; if not IsValidUtf8ContinuationByte(ch) then exit; CodePoint:=((Ord(ch) and %00111111) shl 6) or CodePoint; ch:=ttyRecvChar; if not IsValidUtf8ContinuationByte(ch) then exit; CodePoint:=(Ord(ch) and %00111111) or CodePoint; if ((CodePoint>=$800) and (CodePoint<=$D7FF)) or ((CodePoint>=$E000) and (CodePoint<=$FFFF)) then ReadUtf8:=CodePoint; end; 4:begin CodePoint:=(Ord(ch) and %00000111) shl 18; ch:=ttyRecvChar; if not IsValidUtf8ContinuationByte(ch) then exit; CodePoint:=((Ord(ch) and %00111111) shl 12) or CodePoint; ch:=ttyRecvChar; if not IsValidUtf8ContinuationByte(ch) then exit; CodePoint:=((Ord(ch) and %00111111) shl 6) or CodePoint; ch:=ttyRecvChar; if not IsValidUtf8ContinuationByte(ch) then exit; CodePoint:=(Ord(ch) and %00111111) or CodePoint; if (CodePoint>=$10000) and (CodePoint<=$10FFFF) then ReadUtf8:=CodePoint; end; end; end; var ch : AnsiChar; fdsin : tfdSet; NPT,NNPT : PTreeElement; RootNPT : PTreeElement; FoundNPT : PTreeElement; k: TEnhancedKeyEvent; UnicodeCodePoint: LongInt; i : dword; // Variables for Alt+UTF8 sequence handling ch1: AnsiChar; utf8_bytes_to_read, loop_idx: Integer; full_sequence_ok: boolean; begin {Check Buffer first} if KeySend<>KeyPut then begin ReadKey:=PopKey; exit; end; {Wait for Key} if not sysKeyPressed then begin fpFD_ZERO (fdsin); fpFD_SET (StdInputHandle,fdsin); fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil); end; k:=NilEnhancedKeyEvent; {$ifdef linux} if is_console then SState:=EnhShiftState else {$endif} SState:=[]; k.ShiftState:=SState; ch:=ttyRecvChar; k.AsciiChar:=ch; NPT:=RootTree[ch]; if not assigned(NPT) then begin if Utf8KeyboardInputEnabled then begin UnicodeCodePoint:=ReadUtf8(ch); PushUnicodeKey(k,UnicodeCodePoint,UnicodeToSingleByte(UnicodeCodePoint)); end else PushKey(k); end else begin fpFD_ZERO(fdsin); fpFD_SET(StdInputHandle,fdsin); store[0]:=ch; arrayind:=1; RootNPT:=NPT; FoundNPT:=nil; if NPT^.CanBeTerminal then FoundNPT:=NPT; while {assigned(NPT) and} syskeypressed do begin if inhead=intail then fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); ch:=ttyRecvChar; if (ch=#27) and double_esc_hack_enabled then begin {This is the same hack as in findsequence; see findsequence for explanation.} ch:=ttyrecvchar; {Alt+O cannot be used in this situation, it can be a function key.} if not(ch in ['a'..'z','A'..'N','P'..'Z','0'..'9','-','+','_','=']) then begin PutBackIntoInBuf(ch); ch:=#27; end else begin write(#27'[?1036l'); double_esc_hack_enabled:=false; end; end; {save char later use } store[arrayind]:=ch; inc(arrayind); // Switch to blocking read if found win32-input-mode-encoded ESC key // This fixes that key behavior in that mode if (arrayind = 5) and (store[0]=#27) and (store[1]='[') and (store[2]='2') and (store[3]='7') and (store[4]=';') then begin // Enter blocking read loop with a safety break while (arrayind < 31) do begin // This is a blocking read, it will wait for the next character ch := ttyRecvChar; store[arrayind] := ch; inc(arrayind); // Check for known terminators for win32, kitty, xterm, and other CSI sequences. if (ch = '_') or (ch = 'u') or (ch = '~') or (ch in ['A'..'Z']) or (ch in ['a'..'z']) then break; // Exit this inner blocking loop end; break; // We have the full sequence, so exit the outer `while syskeypressed` loop end; if arrayind >= 31 then break; {check tree for maching sequence} if assigned(NPT) then NNPT:=FindChild(ord(ch),NPT); if assigned(NNPT) then begin NPT:=NNPT; if NPT^.CanBeTerminal then begin FoundNPT:=NPT; if assigned(NPT^.SpecialHandler) then break; end; End else NPT:=nil; {not found and not looking for anymore, but don't let hope fade... read sequence till the end} {check sequnce end conditions} if (arrayind>2) and (ch < #32) then begin {if two short escape sequences are back to back} PutBackIntoInBuf(ch); { rolling back } dec(arrayind); break; end; if (arrayind>3) and not (ch in [';',':','0'..'9']) and (ch <> '_') then break; {end of escape sequence} end; ch := store[arrayind-1]; if (ch = '_') and (arrayind > 2) and (store[0]=#27) and (store[1]='[') then begin DecodeAndPushWin32Key(store, arrayind); exit; end else if (arrayind>3) then if (ch = 'u' ) { for sure kitty keys or } or ( isKittyKeys and not assigned(FoundNPT) ) {probally kitty keys} then begin if not (assigned(FoundNPT) and assigned(FoundNPT^.SpecialHandler)) then begin FoundNPT:=RootNPT; DecodeKittyKey(k,FoundNPT); end; end; if not assigned(FoundNPT) then begin // This handles the case for non-kitty terminals sending ESC + UTF-8 bytes for Alt+key if (arrayind > 1) and (store[0] = #27) and not isKittyKeys then begin ch1 := store[1]; utf8_bytes_to_read := DetectUtf8ByteSequenceStart(ch1) - 1; full_sequence_ok := (arrayind - 1) = (utf8_bytes_to_read + 1); if full_sequence_ok then begin // Push continuation bytes back to be re-read by ReadUtf8 for loop_idx := arrayind - 1 downto 2 do PutBackIntoInBuf(store[loop_idx]); UnicodeCodePoint := ReadUtf8(ch1); if UnicodeCodePoint > 0 then begin k.ShiftState := [essAlt]; k.VirtualScanCode := 0; PushUnicodeKey(k, UnicodeCodePoint, UnicodeToSingleByte(UnicodeCodePoint)); ReadKey := PopKey; exit; end else begin // Failed to parse, push everything back as-is PutBackIntoInBuf(ch1); for loop_idx := 2 to arrayind - 1 do PutBackIntoInBuf(store[loop_idx]); end; end; end; // This line caused duplicate ESC key press events in legacy mode // RestoreArray; end else NPT:=FoundNPT; if assigned(NPT) and NPT^.CanBeTerminal then begin if assigned(NPT^.SpecialHandler) then begin NPT^.SpecialHandler; k.AsciiChar := #0; k.UnicodeChar := WideChar(#0); k.VirtualScanCode := 0; PushKey(k); end else if (NPT^.CharValue<>0) or (NPT^.ScanValue<>0) then begin k.AsciiChar := chr(NPT^.CharValue); k.UnicodeChar := WideChar(NPT^.CharValue); k.VirtualScanCode := (NPT^.ScanValue shl 8) or Ord(k.AsciiChar); k.ShiftState:=k.ShiftState+NPT^.ShiftValue; PushKey(k); end; end else RestoreArray; end; {$ifdef logging} writeln(f); {$endif logging} ReadKey:=PopKey; End; procedure KittyKeyAvailability; var st,zt : shortstring; i: integer; ch : AnsiChar; begin if (kitty_keys_yes=kitty_keys_no) then {make this test just once} begin write(#27'[?u'); { request response! } write(#27'[c'); { request device status (DA1) to get at least some answer. } st:=RawReadString; { read the answer } isKittyKeys:=false; if length(st)>0 then begin zt:=''; for i:=1 to length(st) do begin ch:=st[i]; if ch = #27 then begin if zt = #27'[?31u' then begin isKittyKeys:=true; {kitty keys supported and enabled} end; zt:=''; end; zt:=zt+ch; end; if zt =#27'[?31u' then begin isKittyKeys:=true; {kitty keys supported and enabled} end; kitty_keys_yes:= isKittyKeys; kitty_keys_no := not isKittyKeys; end; end; end; procedure waitAndReadAfterArtifacts; var st : shortstring; timewait,finalparsec : TimeSpec; ree : longint; begin if not kitty_keys_yes then exit; timewait.tv_sec := 0; timewait.tv_nsec := 100000000; {few nano seconds to wait} ree:=fpNanoSleep(@timewait,@finalparsec); st:=''; if syskeypressed then st:=RawReadString; {empty key buffer (key realeas might be pending)} end; { Exported functions } procedure SysInitKeyboard; var envInput: string; begin isKittyKeys:=false; CurrentShiftState:=[]; PendingEnhancedKeyEvent:=NilEnhancedKeyEvent; Utf8KeyboardInputEnabled:={$IFDEF FPC_DOTTEDUNITS}System.Console.{$ENDIF}UnixKVMBase.UTF8Enabled; SetRawMode(true); {$ifdef logging} assign(f,'keyboard.log'); rewrite(f); {$endif logging} {$ifdef linux} force_linuxtty; prepare_patching; patchkeyboard; if is_console then install_vt_handler else begin {$endif} {default for Alt prefix is ^Z } if AltPrefix=0 then AltPrefix:=26; { default for Ctrl Prefix is ^W } if CtrlPrefix=0 then CtrlPrefix:=23; if copy(fpgetenv('TERM'),1,5)='xterm' then {The alt key should generate an escape prefix. Save the old setting make make it send that escape prefix.} begin write(#27'[?1036s'#27'[?1036h'); double_esc_hack_enabled:=true; end; {kitty_keys_no:=true;} isKittyKeys:=kitty_keys_yes; envInput := LowerCase(fpgetenv('TV_INPUT')); if envInput = 'win32' then begin write(#27'[?9001h'); end else if envInput = 'kitty' then begin write(#27'[>31u'); KittyKeyAvailability; end else if envInput = 'legacy' then begin // Do nothing end else // TV_INPUT not set or incorrect, use default logic begin if kitty_keys_yes or (kitty_keys_yes=kitty_keys_no) then write(#27'[>31u'); { try to set up kitty keys } KittyKeyAvailability; if not isKittyKeys then write(#27'[>4;2m'); { xterm -> modifyOtherKeys } write(#27'[?9001h'); // Try to enable win32-input-mode end; {$ifdef linux} end; {$endif} LoadDefaultSequences; { LoadTerminfoSequences;} end; procedure SysDoneKeyboard; begin {$ifdef linux} if is_console then unpatchkeyboard; {$endif linux} write(#27'[?9001l'); // Disable win32-input-mode if not isKittyKeys then write(#27'[>4m'); { xterm -> reset to default modifyOtherKeys } if kitty_keys_yes then begin write(#27'[ Alt-F1..Alt-F10} then EvalScanZ:=b+$2D; end; const {kbHome, kbUp, kbPgUp,Missing, kbLeft, kbCenter, kbRight, kbAltGrayPlus, kbend, kbDown, kbPgDn, kbIns, kbDel } CtrlArrow : array [kbHome..kbDel] of byte = {($77,$8d,$84,$8e,$73,$8f,$74,$90,$75,$91,$76);} (kbCtrlHome,kbCtrlUp,kbCtrlPgUp,kbNoKey,kbCtrlLeft, kbCtrlCenter,kbCtrlRight,kbAltGrayPlus,kbCtrlEnd, kbCtrlDown,kbCtrlPgDn,kbCtrlIns,kbCtrlDel); AltArrow : array [kbHome..kbDel] of byte = (kbAltHome,kbAltUp,kbAltPgUp,{kbNoKey}$4a,kbAltLeft, kbAltCenter,kbAltRight,kbAltGrayPlus,kbAltEnd, kbAltDown,kbAltPgDn,kbAltIns,kbAltDel); var MyScan:byte; MyChar : AnsiChar; MyUniChar: WideChar; MyKey: TEnhancedKeyEvent; EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,Again : boolean; SState: TEnhancedShiftState; i: integer; begin {main} if PendingEnhancedKeyEvent<>NilEnhancedKeyEvent then begin SysGetEnhancedKeyEvent:=PendingEnhancedKeyEvent; LastShiftState:=SysGetEnhancedKeyEvent.ShiftState; {to fake shift state later} PendingEnhancedKeyEvent:=NilEnhancedKeyEvent; exit; end; SysGetEnhancedKeyEvent:=NilEnhancedKeyEvent; MyKey:=ReadKey; // FAST PATH for pre-constructed events from ReadKey's Alt+UTF8 logic if (MyKey.ShiftState <> []) and (Ord(MyKey.UnicodeChar) > 0) and (Ord(MyKey.UnicodeChar) <> Ord(MyKey.AsciiChar)) then begin SysGetEnhancedKeyEvent := MyKey; LastShiftState := MyKey.ShiftState; exit; end; MyChar:=MyKey.AsciiChar; MyUniChar:=MyKey.UnicodeChar; MyScan:=MyKey.VirtualScanCode shr 8; Sstate:=MyKey.ShiftState; CtrlPrefixUsed:=false; AltPrefixUsed:=false; ShiftPrefixUsed:=false; EscUsed:=false; repeat again:=false; if Mychar=#0 then begin { Handle Ctrl-, but not AltGr- } if (essCtrl in SState) and (not (essAlt in SState)) then case MyScan of kbShiftTab: MyScan := kbCtrlTab; kbHome..kbDel : { cArrow } MyScan:=CtrlArrow[MyScan]; kbF1..KbF10 : { cF1-cF10 } MyScan:=MyScan+kbCtrlF1-kbF1; kbF11..KbF12 : { cF11-cF12 } MyScan:=MyScan+kbCtrlF11-kbF11; end { Handle Alt-, but not AltGr } else if (essAlt in SState) and (not (essCtrl in SState)) then case MyScan of kbShiftTab: MyScan := kbAltTab; kbHome..kbDel : { AltArrow } MyScan:=AltArrow[MyScan]; kbF1..KbF10 : { aF1-aF10 } MyScan:=MyScan+kbAltF1-kbF1; kbF11..KbF12 : { aF11-aF12 } MyScan:=MyScan+kbAltF11-kbF11; end else if essShift in SState then case MyScan of kbIns: MyScan:=kbShiftIns; kbDel: MyScan:=kbShiftDel; kbF1..KbF10 : { sF1-sF10 } MyScan:=MyScan+kbShiftF1-kbF1; kbF11..KbF12 : { sF11-sF12 } MyScan:=MyScan+kbShiftF11-kbF11; end; if myscan=kbAltBack then Include(sstate, essAlt); if (MyChar<>#0) or (MyUniChar<>WideChar(0)) or (MyScan<>0) or (SState<>[]) then begin SysGetEnhancedKeyEvent.AsciiChar:=MyChar; SysGetEnhancedKeyEvent.UnicodeChar:=MyUniChar; SysGetEnhancedKeyEvent.ShiftState:=SState; SysGetEnhancedKeyEvent.VirtualScanCode:=(MyScan shl 8) or Ord(MyChar); end; LastShiftState:=SysGetEnhancedKeyEvent.ShiftState; {to fake shift state later} exit; end else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then begin { ^Z - replace Alt for Linux OS } if AltPrefixUsed then SState:=SState-[essAlt,essLeftAlt,essRightAlt] else begin AltPrefixUsed:=true; Include(SState,essAlt); Again:=true; end; end else if (CtrlPrefix<>0) and (MyChar=chr(CtrlPrefix)) then begin if CtrlPrefixUsed then SState:=SState-[essCtrl,essLeftCtrl,essRightCtrl] else begin CtrlPrefixUsed:=true; Include(SState,essCtrl); Again:=true; end; end else if (ShiftPrefix<>0) and (MyChar=chr(ShiftPrefix)) then begin if ShiftPrefixUsed then SState:=SState-[essShift,essLeftShift,essRightShift] else begin ShiftPrefixUsed:=true; Include(SState,essShift); Again:=true; end; end; if again then begin MyKey:=ReadKey; MyChar:=MyKey.AsciiChar; MyUniChar:=MyKey.UnicodeChar; MyScan:=MyKey.VirtualScanCode shr 8; end; until not Again; if MyScan = 0 then MyScan:=EvalScan(ord(MyChar)); // Legacy mode fix: interpret single-byte C0 control characters. This logic // applies only when a raw character was read, not a pre-parsed sequence. if (MyKey.VirtualScanCode and $FF00 = 0) and (Ord(MyChar) >= 1) and (Ord(MyChar) <= 31) and not (essCtrl in SState) then begin case Ord(MyChar) of 8, 9, 10, 13, 27: // Backspace, Tab, LF, CR, Esc are their own keys begin // Do not treat these as Ctrl+ combinations in this context. end; else // This is a Ctrl+ combination (e.g., Ctrl+A = #1). begin Include(SState, essCtrl); // The application expects the actual character ('A'), not the control // code (#1). We must find the original character based on the scan code // to mimic the behavior of the win32 input mode. // Search for the corresponding character in the scan code table. for i := Ord('A') to Ord('Z') do begin if (cScanValue[i] = MyScan) then begin MyChar := AnsiChar(i); MyUniChar := WideChar(i); break; end; end; end; end; end; if (essCtrl in SState) and (not (essAlt in SState)) then begin if (MyChar=#9) and (MyScan <> $17) then begin MyChar:=#0; MyUniChar:=WideChar(0); MyScan:=kbCtrlTab; end; end else if (essAlt in SState) and (not (essCtrl in SState)) then begin if (MyChar=#9) and (MyScan <> $17) then begin MyChar:=#0; MyUniChar:=WideChar(0); MyScan:=kbAltTab; end else if (MyScan <> $17) then begin if MyScan in [$02..$0D] then inc(MyScan,$76); MyChar:=chr(0); MyUniChar:=WideChar(0); end; end else if essShift in SState then if (MyChar=#9) and (MyScan <> $17) then begin MyChar:=#0; MyUniChar:=WideChar(0); MyScan:=kbShiftTab; end; if (MyChar<>#0) or (MyUniChar<>WideChar(0)) or (MyScan<>0) or (SState<>[]) then begin SysGetEnhancedKeyEvent.AsciiChar:=MyChar; SysGetEnhancedKeyEvent.UnicodeChar:=MyUniChar; SysGetEnhancedKeyEvent.ShiftState:=SState; // For Ctrl+, KeyCode must be 1..26 for A..Z. // This ensures backward compatibility with older code. // We check for Ctrl without Alt to avoid interfering with AltGr. if (essCtrl in SState) and not (essAlt in SState) and (UpCase(MyChar) in ['A'..'Z']) then SysGetEnhancedKeyEvent.VirtualScanCode := Ord(UpCase(MyChar)) - Ord('A') + 1 else // Default behavior for all other key combinations. SysGetEnhancedKeyEvent.VirtualScanCode := (MyScan shl 8) or Ord(MyChar); end; LastShiftState:=SysGetEnhancedKeyEvent.ShiftState; {to fake shift state later} end; function SysPollEnhancedKeyEvent: TEnhancedKeyEvent; var KeyEvent : TEnhancedKeyEvent; begin if PendingEnhancedKeyEvent<>NilEnhancedKeyEvent then SysPollEnhancedKeyEvent:=PendingEnhancedKeyEvent else if keypressed then begin KeyEvent:=SysGetEnhancedKeyEvent; PendingEnhancedKeyEvent:=KeyEvent; SysPollEnhancedKeyEvent:=KeyEvent; end else SysPollEnhancedKeyEvent:=NilEnhancedKeyEvent; LastShiftState:=SysPollEnhancedKeyEvent.ShiftState; {to fake shift state later} end; function SysGetShiftState : Byte; begin {$ifdef linux} if is_console then SysGetShiftState:=ShiftState else {$endif} SysGetShiftState:=GetLastShiftState; end; procedure RestoreStartMode; begin TCSetAttr(1,TCSANOW,StartTio); end; const SysKeyboardDriver : TKeyboardDriver = ( InitDriver : @SysInitKeyBoard; DoneDriver : @SysDoneKeyBoard; GetKeyevent : Nil; PollKeyEvent : Nil; GetShiftState : @SysGetShiftState; TranslateKeyEvent : Nil; TranslateKeyEventUnicode : Nil; GetEnhancedKeyEvent : @SysGetEnhancedKeyEvent; PollEnhancedKeyEvent : @SysPollEnhancedKeyEvent; ); begin SetKeyBoardDriver(SysKeyBoardDriver); TCGetAttr(1,StartTio); end.