1{ 2 This file is part of the Free Pascal run time library. 3 Copyright (c) 1999-2000 by Florian Klaempfl 4 member of the Free Pascal development team 5 6 Keyboard unit for linux 7 8 See the file COPYING.FPC, included in this distribution, 9 for details about the copyright. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 15 **********************************************************************} 16unit keyboard; 17 18{$inline on} 19 20{*****************************************************************************} 21 interface 22{*****************************************************************************} 23 24{$i keybrdh.inc} 25 26const 27 AltPrefix : byte = 0; 28 ShiftPrefix : byte = 0; 29 CtrlPrefix : byte = 0; 30 31type 32 Tprocedure = procedure; 33 34 PTreeElement = ^TTreeElement; 35 TTreeElement = record 36 Next,Parent,Child : PTreeElement; 37 CanBeTerminal : boolean; 38 char : byte; 39 ScanValue : byte; 40 CharValue : byte; 41 SpecialHandler : Tprocedure; 42 end; 43 44function RawReadKey:char; 45function RawReadString : String; 46function KeyPressed : Boolean; 47procedure AddSequence(const St : String; AChar,AScan :byte);inline; 48function FindSequence(const St : String;var AChar, Ascan : byte) : boolean; 49procedure RestoreStartMode; 50 51function AddSpecialSequence(const St : string;Proc : Tprocedure) : PTreeElement; platform; 52 53 54{*****************************************************************************} 55 implementation 56{*****************************************************************************} 57 58uses 59 Mouse, Strings, 60 termio,baseUnix 61 {$ifdef linux},linuxvcs{$endif}; 62 63{$i keyboard.inc} 64 65var OldIO,StartTio : TermIos; 66{$ifdef linux} 67 is_console:boolean; 68 vt_switched_away:boolean; 69{$endif} 70{$ifdef logging} 71 f : text; 72{$endif logging} 73 74const 75 KeyBufferSize = 20; 76var 77 KeyBuffer : Array[0..KeyBufferSize-1] of Char; 78 KeyPut, 79 KeySend : longint; 80 81{ Buffered Input routines } 82const 83 InSize=256; 84var 85 InBuf : array [0..InSize-1] of char; 86{ InCnt,} 87 InHead, 88 InTail : longint; 89 90{$i keyscan.inc} 91 92{Some internal only scancodes} 93const KbShiftUp = $f0; 94 KbShiftLeft = $f1; 95 KbShiftRight = $f2; 96 KbShiftDown = $f3; 97 KbShiftHome = $f4; 98 KbShiftEnd = $f5; 99 KbCtrlShiftUp = $f6; 100 KbCtrlShiftDown = $f7; 101 KbCtrlShiftRight = $f8; 102 KbCtrlShiftLeft = $f9; 103 KbCtrlShiftHome = $fa; 104 KbCtrlShiftEnd = $fb; 105 106 double_esc_hack_enabled : boolean = false; 107 108{$ifdef Unused} 109type 110 TKeyState = Record 111 Normal, Shift, Ctrl, Alt : word; 112 end; 113 114const 115 KeyStates : Array[0..255] of TKeyState 116 ( 117 118 ); 119 120{$endif Unused} 121 122procedure SetRawMode(b:boolean); 123 124var Tio:Termios; 125 126begin 127 TCGetAttr(0,Tio); 128 if b then 129 begin 130 {Standard output now needs #13#10.} 131 settextlineending(output,#13#10); 132 OldIO:=Tio; 133 CFMakeRaw(Tio); 134 end 135 else 136 begin 137 Tio := OldIO; 138 {Standard output normally needs just a linefeed.} 139 settextlineending(output,#10); 140 end; 141 TCsetattr(0,TCSANOW,Tio); 142end; 143 144{$ifdef linux} 145 146{The Linux console can do nice things: we can get the state of the shift keys, 147 and reprogram the keys. That's nice since it allows excellent circumvention 148 of VT100 limitations, we can make the keyboard work 100%... 149 150 A 100% working keyboard seems to be a pretty basic requirement, but we're 151 one of the few guys providing such an outrageous luxury (DM).} 152 153type 154 chgentry=packed record 155 tab, 156 idx, 157 oldtab, 158 oldidx : byte; 159 oldval, 160 newval : word; 161 end; 162 kbentry=packed record 163 kb_table, 164 kb_index : byte; 165 kb_value : word; 166 end; 167 kbsentry=packed record 168 kb_func:byte; 169 kb_string:array[0..511] of char; 170 end; 171 vt_mode=packed record 172 mode, {vt mode} 173 waitv:byte; {if set, hang on writes if not active} 174 relsig, {signal to raise on release req} 175 acqsig, {signal to raise on acquisition} 176 frsig:word; {unused (set to 0)} 177 end; 178 179const 180 kbdchange:array[0..23] of chgentry=( 181 {This prevents the alt+function keys from switching consoles. 182 We code the F1..F12 sequences into ALT+F1..ALT+12, we check 183 the shiftstates separetely anyway.} 184 (tab:8; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0), 185 (tab:8; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0), 186 (tab:8; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0), 187 (tab:8; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0), 188 (tab:8; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0), 189 (tab:8; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0), 190 (tab:8; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0), 191 (tab:8; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0), 192 (tab:8; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0), 193 (tab:8; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0), 194 (tab:8; idx:$45; oldtab:0; oldidx:$45; oldval:0; newval:0), 195 (tab:8; idx:$46; oldtab:0; oldidx:$46; oldval:0; newval:0), 196 {This prevents the shift+function keys outputting strings, so 197 the kernel will the codes for the non-shifted function 198 keys. This is desired because normally shift+f1/f2 will output the 199 same string as f11/12. We will get the shift state separately.} 200 (tab:1; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0), 201 (tab:1; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0), 202 (tab:1; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0), 203 (tab:1; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0), 204 (tab:1; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0), 205 (tab:1; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0), 206 (tab:1; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0), 207 (tab:1; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0), 208 (tab:1; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0), 209 (tab:1; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0), 210 (tab:1; idx:$45; oldtab:0; oldidx:$45; oldval:0; newval:0), 211 (tab:1; idx:$46; oldtab:0; oldidx:$46; oldval:0; newval:0) 212 ); 213 214 KDGKBENT=$4B46; 215 KDSKBENT=$4B47; 216 KDGKBSENT=$4B48; 217 KDSKBSENT=$4B49; 218 KDGKBMETA=$4B62; 219 KDSKBMETA=$4B63; 220 K_ESCPREFIX=$4; 221 K_METABIT=$3; 222 VT_GETMODE=$5601; 223 VT_SETMODE=$5602; 224 VT_RELDISP=$5605; 225 VT_PROCESS=1; 226 227const 228 oldmeta : longint = 0; 229 meta : longint = 0; 230 231var oldesc0,oldesc1,oldesc2,oldesc4,oldesc8:word; 232 233procedure prepare_patching; 234 235var entry : kbentry; 236 i:longint; 237 238begin 239 for i:=low(kbdchange) to high(kbdchange) do 240 with kbdchange[i] do 241 begin 242 entry.kb_table:=tab; 243 entry.kb_index:=idx; 244 fpIoctl(stdinputhandle,KDGKBENT,@entry); 245 oldval:=entry.kb_value; 246 entry.kb_table:=oldtab; 247 entry.kb_index:=oldidx; 248 fpioctl(stdinputhandle,KDGKBENT,@entry); 249 newval:=entry.kb_value; 250 end; 251 {Save old escape code.} 252 entry.kb_index:=1; 253 entry.kb_table:=0; 254 fpioctl(stdinputhandle,KDGKBENT,@entry); 255 oldesc0:=entry.kb_value; 256 entry.kb_table:=1; 257 fpioctl(stdinputhandle,KDGKBENT,@entry); 258 oldesc1:=entry.kb_value; 259 entry.kb_table:=2; 260 fpioctl(stdinputhandle,KDGKBENT,@entry); 261 oldesc2:=entry.kb_value; 262 entry.kb_table:=4; 263 fpioctl(stdinputhandle,KDGKBENT,@entry); 264 oldesc4:=entry.kb_value; 265 entry.kb_table:=8; 266 fpioctl(stdinputhandle,KDGKBENT,@entry); 267 oldesc8:=entry.kb_value; 268end; 269 270procedure PatchKeyboard; 271var 272 entry : kbentry; 273 sentry : kbsentry; 274 i:longint; 275begin 276 fpIoctl(stdinputhandle,KDGKBMETA,@oldmeta); 277 meta:=K_ESCPREFIX; 278 fpIoctl(stdinputhandle,KDSKBMETA,@meta); 279 for i:=low(kbdchange) to high(kbdchange) do 280 with kbdchange[i] do 281 begin 282 entry.kb_table:=tab; 283 entry.kb_index:=idx; 284 entry.kb_value:=newval; 285 fpioctl(stdinputhandle,KDSKBENT,@entry); 286 end; 287 288 {Map kernel escape key code to symbol F32.} 289 entry.kb_index:=1; 290 entry.kb_value:=$011f; 291 entry.kb_table:=0; 292 fpioctl(stdinputhandle,KDSKBENT,@entry); 293 entry.kb_table:=1; 294 fpioctl(stdinputhandle,KDSKBENT,@entry); 295 entry.kb_table:=2; 296 fpioctl(stdinputhandle,KDSKBENT,@entry); 297 entry.kb_table:=4; 298 fpioctl(stdinputhandle,KDSKBENT,@entry); 299 entry.kb_table:=8; 300 fpioctl(stdinputhandle,KDSKBENT,@entry); 301 302 {F32 (the escape key) will generate ^[[0~ .} 303 sentry.kb_func:=31; 304 sentry.kb_string:=#27'[0~'; 305 fpioctl(stdinputhandle,KDSKBSENT,@sentry); 306end; 307 308 309procedure UnpatchKeyboard; 310var 311 entry : kbentry; 312 i : longint; 313begin 314 if oldmeta in [K_ESCPREFIX,K_METABIT] then 315 fpioctl(stdinputhandle,KDSKBMETA,@oldmeta); 316 for i:=low(kbdchange) to high(kbdchange) do 317 with kbdchange[i] do 318 begin 319 entry.kb_table:=tab; 320 entry.kb_index:=idx; 321 entry.kb_value:=oldval; 322 fpioctl(stdinputhandle,KDSKBENT,@entry); 323 end; 324 325 entry.kb_index:=1; 326 entry.kb_table:=0; 327 entry.kb_value:=oldesc0; 328 fpioctl(stdinputhandle,KDSKBENT,@entry); 329 entry.kb_table:=1; 330 entry.kb_value:=oldesc1; 331 fpioctl(stdinputhandle,KDSKBENT,@entry); 332 entry.kb_table:=2; 333 entry.kb_value:=oldesc2; 334 fpioctl(stdinputhandle,KDSKBENT,@entry); 335 entry.kb_table:=4; 336 entry.kb_value:=oldesc4; 337 fpioctl(stdinputhandle,KDSKBENT,@entry); 338 entry.kb_table:=8; 339 entry.kb_value:=oldesc8; 340 fpioctl(stdinputhandle,KDSKBENT,@entry); 341end; 342 343{A problem of patching the keyboard is that it no longer works as expected 344 when working on another console. So we unpatch it when the user switches 345 away.} 346 347procedure vt_handler(sig:longint);cdecl; 348 349begin 350 if vt_switched_away then 351 begin 352 {Confirm the switch.} 353 fpioctl(stdoutputhandle,VT_RELDISP,pointer(2)); 354 {Switching to program, patch keyboard.} 355 patchkeyboard; 356 end 357 else 358 begin 359 {Switching away from program, unpatch the keyboard.} 360 unpatchkeyboard; 361 fpioctl(stdoutputhandle,VT_RELDISP,pointer(1)); 362 end; 363 vt_switched_away:=not vt_switched_away; 364 {Clear buffer.} 365 intail:=inhead; 366end; 367 368procedure install_vt_handler; 369 370var mode:vt_mode; 371 372begin 373{ ioctl(vt_fd,KDSETMODE,KD_GRAPHICS);} 374 fpioctl(stdoutputhandle,VT_GETMODE,@mode); 375 mode.mode:=VT_PROCESS; 376 mode.relsig:=SIGUSR1; 377 mode.acqsig:=SIGUSR1; 378 vt_switched_away:=false; 379 fpsignal(SIGUSR1,@vt_handler); 380 fpioctl(stdoutputhandle,VT_SETMODE,@mode); 381end; 382{$endif} 383 384function ttyRecvChar:char; 385 386var Readed,i : longint; 387 388begin 389 {Buffer empty? Yes, input from stdin} 390 if (InHead=InTail) then 391 begin 392 {Calc Amount of Chars to Read} 393 i:=InSize-InHead; 394 if InTail>InHead then 395 i:=InTail-InHead; 396 {Read} 397 repeat 398 Readed:=fpRead(StdInputHandle,InBuf[InHead],i); 399 until readed<>-1; 400 {Increase Counters} 401 inc(InHead,Readed); 402 {Wrap if End has Reached} 403 if InHead>=InSize then 404 InHead:=0; 405 end; 406 {Check Buffer} 407 ttyRecvChar:=InBuf[InTail]; 408 inc(InTail); 409 if InTail>=InSize then 410 InTail:=0; 411end; 412 413procedure PushKey(Ch:char); 414var 415 Tmp : Longint; 416begin 417 Tmp:=KeyPut; 418 Inc(KeyPut); 419 If KeyPut>=KeyBufferSize Then 420 KeyPut:=0; 421 If KeyPut<>KeySend Then 422 KeyBuffer[Tmp]:=Ch 423 Else 424 KeyPut:=Tmp; 425End; 426 427 428function PopKey:char; 429begin 430 If KeyPut<>KeySend Then 431 begin 432 PopKey:=KeyBuffer[KeySend]; 433 Inc(KeySend); 434 If KeySend>=KeyBufferSize Then 435 KeySend:=0; 436 End 437 Else 438 PopKey:=#0; 439End; 440 441 442procedure PushExt(b:byte); 443begin 444 PushKey(#0); 445 PushKey(chr(b)); 446end; 447 448 449const 450 AltKeyStr : string[38]='qwertyuiopasdfghjklzxcvbnm1234567890-='; 451 AltCodeStr : string[38]=#016#017#018#019#020#021#022#023#024#025#030#031#032#033#034#035#036#037#038+ 452 #044#045#046#047#048#049#050#120#121#122#123#124#125#126#127#128#129#130#131; 453function FAltKey(ch:char):byte; 454var 455 Idx : longint; 456begin 457 Idx:=Pos(ch,AltKeyStr); 458 if Idx>0 then 459 FAltKey:=byte(AltCodeStr[Idx]) 460 else 461 FAltKey:=0; 462End; 463 464 465{ This one doesn't care about keypresses already processed by readkey } 466{ and waiting in the KeyBuffer, only about waiting keypresses at the } 467{ TTYLevel (including ones that are waiting in the TTYRecvChar buffer) } 468function sysKeyPressed: boolean; 469var 470 fdsin : tfdSet; 471begin 472 if (inhead<>intail) then 473 sysKeyPressed:=true 474 else 475 begin 476 fpFD_ZERO(fdsin); 477 fpFD_SET(StdInputHandle,fdsin); 478 sysKeypressed:=(fpSelect(StdInputHandle+1,@fdsin,nil,nil,0)>0); 479 end; 480end; 481 482function KeyPressed:Boolean; 483begin 484 Keypressed := (KeySend<>KeyPut) or sysKeyPressed; 485End; 486 487 488const 489 LastMouseEvent : TMouseEvent = 490 ( 491 Buttons : 0; 492 X : 0; 493 Y : 0; 494 Action : 0; 495 ); 496 497 procedure GenFakeReleaseEvent(MouseEvent : TMouseEvent); 498 begin 499 MouseEvent.action := MouseActionUp; 500 MouseEvent.buttons := 0; 501 PutMouseEvent(MouseEvent); 502 end; 503 504 procedure GenMouseEvent; 505 var MouseEvent: TMouseEvent; 506 ch : char; 507 fdsin : tfdSet; 508 buttonval:byte; 509 begin 510 fpFD_ZERO(fdsin); 511 fpFD_SET(StdInputHandle,fdsin); 512{ Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);} 513 MouseEvent.action:=0; 514 if inhead=intail then 515 fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); 516 ch:=ttyRecvChar; 517 { Other bits are used for Shift, Meta and Ctrl modifiers PM } 518 buttonval:=byte(ch)-byte(' '); 519 {bits 0..1: button status 520 bit 5 : mouse movement while button down. 521 bit 6 : interpret button 1 as button 4 522 interpret button 2 as button 5} 523 case buttonval and 67 of 524 0 : {left button press} 525 MouseEvent.buttons:=1; 526 1 : {middle button pressed } 527 MouseEvent.buttons:=2; 528 2 : { right button pressed } 529 MouseEvent.buttons:=4; 530 3 : { no button pressed } 531 MouseEvent.buttons:=0; 532 64: { button 4 pressed } 533 MouseEvent.buttons:=8; 534 65: { button 5 pressed } 535 MouseEvent.buttons:=16; 536 end; 537 if inhead=intail then 538 fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); 539 ch:=ttyRecvChar; 540 MouseEvent.x:=Ord(ch)-ord(' ')-1; 541 if inhead=intail then 542 fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); 543 ch:=ttyRecvChar; 544 MouseEvent.y:=Ord(ch)-ord(' ')-1; 545 mouseevent.action:=MouseActionMove; 546 if (lastmouseevent.buttons=0) and (mouseevent.buttons<>0) then 547 MouseEvent.action:=MouseActionDown; 548 if (lastmouseevent.buttons<>0) and (mouseevent.buttons=0) then 549 MouseEvent.action:=MouseActionUp; 550(* 551 else 552 553 begin 554 if (LastMouseEvent.Buttons<>0) and 555 ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then 556 begin 557 MouseEvent.Action:=MouseActionMove; 558 MouseEvent.Buttons:=LastMouseEvent.Buttons; 559{$ifdef DebugMouse} 560 Writeln(system.stderr,' Mouse Move (',MouseEvent.X,',',MouseEvent.Y,')'); 561{$endif DebugMouse} 562 PutMouseEvent(MouseEvent); 563 MouseEvent.Buttons:=0; 564 end; 565 MouseEvent.Action:=MouseActionUp; 566 end; 567*) 568 PutMouseEvent(MouseEvent); 569 if (MouseEvent.buttons and (8+16)) <> 0 then // 'M' escape sequence cannot map button 4&5 release, so fake one. 570 GenFakeReleaseEvent(MouseEvent); 571{$ifdef DebugMouse} 572 if MouseEvent.Action=MouseActionDown then 573 Write(system.stderr,'Button down : ') 574 else 575 Write(system.stderr,'Button up : '); 576 Writeln(system.stderr,'buttons = ',MouseEvent.Buttons,' (',MouseEvent.X,',',MouseEvent.Y,')'); 577{$endif DebugMouse} 578 LastMouseEvent:=MouseEvent; 579 end; 580 581 582 { The Extended/SGR 1006 mouse protocol, supported by xterm 277 and newer. 583 Message format: Esc [<0;123;456M - mouse button press 584 or: Esc [<0;123;456m - mouse button release 585 Advantages: 586 - can report X and Y coordinates larger than 223 587 - mouse release event informs us of *which* mouse button was released, so 588 we can track buttons more accurately 589 - messages use a different prefix (Esc [< instead of Esc [M) than the 590 regular mouse event messages, so there's no need to detect if the 591 terminal supports it - we can always try to enable it and then be 592 prepared to handle both types of messages } 593 procedure GenMouseEvent_ExtendedSGR1006; 594 var MouseEvent: TMouseEvent; 595 ch : char; 596 fdsin : tfdSet; 597 buttonval: LongInt; 598 tempstr: string; 599 code: LongInt; 600 X, Y: LongInt; 601 ButtonMask: Word; 602 begin 603 fpFD_ZERO(fdsin); 604 fpFD_SET(StdInputHandle,fdsin); 605 606 { read buttonval } 607 tempstr:=''; 608 repeat 609 if inhead=intail then 610 fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); 611 ch:=ttyRecvChar; 612 if (ch>='0') and (ch<='9') then 613 tempstr:=tempstr+ch 614 else if ch<>';' then 615 exit; 616 until ch=';'; 617 Val(tempstr,buttonval,code); 618 619 { read X } 620 tempstr:=''; 621 repeat 622 if inhead=intail then 623 fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); 624 ch:=ttyRecvChar; 625 if (ch>='0') and (ch<='9') then 626 tempstr:=tempstr+ch 627 else if ch<>';' then 628 exit; 629 until ch=';'; 630 Val(tempstr,X,code); 631 632 { read Y } 633 tempstr:=''; 634 repeat 635 if inhead=intail then 636 fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); 637 ch:=ttyRecvChar; 638 if (ch>='0') and (ch<='9') then 639 tempstr:=tempstr+ch 640 else if (ch<>'M') and (ch<>'m') then 641 exit; 642 until (ch='M') or (ch='m'); 643 Val(tempstr,Y,code); 644 645{$ifdef DebugMouse} 646 Writeln(System.StdErr, 'SGR1006:', buttonval:3, X:5, Y:5, ' ', ch); 647{$endif DebugMouse} 648 649 { let's range check X and Y just in case } 650 if (X<(Low(MouseEvent.X)+1)) or (X>(High(MouseEvent.X)+1)) then 651 exit; 652 if (Y<(Low(MouseEvent.Y)+1)) or (Y>(High(MouseEvent.Y)+1)) then 653 exit; 654 MouseEvent.X:=X-1; 655 MouseEvent.Y:=Y-1; 656 if (buttonval and 32)<>0 then 657 begin 658 MouseEvent.Action:=MouseActionMove; 659 MouseEvent.Buttons:=LastMouseEvent.Buttons; 660 end 661 else 662 begin 663 case buttonval and 67 of 664 0 : {left button press} 665 ButtonMask:=1; 666 1 : {middle button pressed } 667 ButtonMask:=2; 668 2 : { right button pressed } 669 ButtonMask:=4; 670 3 : { no button pressed } 671 ButtonMask:=0; 672 64: { button 4 pressed } 673 ButtonMask:=8; 674 65: { button 5 pressed } 675 ButtonMask:=16; 676 end; 677 if ch='M' then 678 begin 679 MouseEvent.Action:=MouseActionDown; 680 MouseEvent.Buttons:=LastMouseEvent.Buttons or ButtonMask; 681 end 682 else 683 begin 684 MouseEvent.Action:=MouseActionUp; 685 MouseEvent.Buttons:=LastMouseEvent.Buttons and not ButtonMask; 686 end; 687 end; 688 PutMouseEvent(MouseEvent); 689 if (ButtonMask and (8+16)) <> 0 then // 'M' escape sequence cannot map button 4&5 release, so fake one. 690 begin 691 MouseEvent.Action:=MouseActionUp; 692 MouseEvent.Buttons:=LastMouseEvent.Buttons and not ButtonMask; 693 PutMouseEvent(MouseEvent); 694 end; 695 LastMouseEvent:=MouseEvent; 696 end; 697 698var roottree:array[char] of PTreeElement; 699 700procedure FreeElement (PT:PTreeElement); 701var next : PTreeElement; 702begin 703 while PT <> nil do 704 begin 705 FreeElement(PT^.Child); 706 next := PT^.Next; 707 dispose(PT); 708 PT := next; 709 end; 710end; 711 712procedure FreeTree; 713 714var i:char; 715 716begin 717 for i:=low(roottree) to high(roottree) do 718 begin 719 FreeElement(RootTree[i]); 720 roottree[i]:=nil; 721 end; 722end; 723 724function NewPTree(ch : byte;Pa : PTreeElement) : PTreeElement; 725begin 726 newPtree:=allocmem(sizeof(Ttreeelement)); 727 newPtree^.char:=ch; 728 newPtree^.Parent:=Pa; 729 if Assigned(Pa) and (Pa^.Child=nil) then 730 Pa^.Child:=newPtree; 731end; 732 733function DoAddSequence(const St : String; AChar,AScan :byte) : PTreeElement; 734var 735 CurPTree,NPT : PTreeElement; 736 c : byte; 737 i : longint; 738begin 739 if St='' then 740 begin 741 DoAddSequence:=nil; 742 exit; 743 end; 744 CurPTree:=RootTree[st[1]]; 745 if CurPTree=nil then 746 begin 747 CurPTree:=NewPTree(ord(st[1]),nil); 748 RootTree[st[1]]:=CurPTree; 749 end; 750 for i:=2 to Length(St) do 751 begin 752 NPT:=CurPTree^.Child; 753 c:=ord(St[i]); 754 if NPT=nil then 755 NPT:=NewPTree(c,CurPTree); 756 CurPTree:=nil; 757 while assigned(NPT) and (NPT^.char<c) do 758 begin 759 CurPTree:=NPT; 760 NPT:=NPT^.Next; 761 end; 762 763 if assigned(NPT) and (NPT^.char=c) then 764 CurPTree:=NPT 765 else 766 begin 767 if CurPTree=nil then 768 begin 769 NPT^.Parent^.child:=NewPTree(c,NPT^.Parent); 770 CurPTree:=NPT^.Parent^.Child; 771 CurPTree^.Next:=NPT; 772 end 773 else 774 begin 775 CurPTree^.Next:=NewPTree(c,CurPTree^.Parent); 776 CurPTree:=CurPTree^.Next; 777 CurPTree^.Next:=NPT; 778 end; 779 end; 780 end; 781 if CurPTree^.CanBeTerminal then 782 begin 783 { here we have a conflict !! } 784 { maybe we should claim } 785 with CurPTree^ do 786 begin 787{$ifdef DEBUG} 788 if (ScanValue<>AScan) or (CharValue<>AChar) then 789 Writeln(system.stderr,'key "',st,'" changed value'); 790 if (ScanValue<>AScan) then 791 Writeln(system.stderr,'Scan was ',ScanValue,' now ',AScan); 792 if (CharValue<>AChar) then 793 Writeln(system.stderr,'Char was ',chr(CharValue),' now ',chr(AChar)); 794{$endif DEBUG} 795 ScanValue:=AScan; 796 CharValue:=AChar; 797 end; 798 end 799 else with CurPTree^ do 800 begin 801 CanBeTerminal:=True; 802 ScanValue:=AScan; 803 CharValue:=AChar; 804 end; 805 DoAddSequence:=CurPTree; 806end; 807 808 809procedure AddSequence(const St : String; AChar,AScan :byte);inline; 810begin 811 DoAddSequence(St,AChar,AScan); 812end; 813 814{ Returns the Child that as c as char if it exists } 815function FindChild(c : byte;Root : PTreeElement) : PTreeElement; 816var 817 NPT : PTreeElement; 818begin 819 NPT:=Root^.Child; 820 while assigned(NPT) and (NPT^.char<c) do 821 NPT:=NPT^.Next; 822 if assigned(NPT) and (NPT^.char=c) then 823 FindChild:=NPT 824 else 825 FindChild:=nil; 826end; 827 828function AddSpecialSequence(const St : string;Proc : Tprocedure) : PTreeElement; 829var 830 NPT : PTreeElement; 831begin 832 NPT:=DoAddSequence(St,0,0); 833 NPT^.SpecialHandler:=Proc; 834 AddSpecialSequence:=NPT; 835end; 836 837function FindSequence(const St : String;var AChar,AScan :byte) : boolean; 838var 839 NPT : PTreeElement; 840 i,p : byte; 841begin 842 FindSequence:=false; 843 AChar:=0; 844 AScan:=0; 845 if St='' then 846 exit; 847 p:=1; 848 {This is a distusting hack for certain even more disgusting xterms: Some of 849 them send two escapes for an alt-key. If we wouldn't do this, we would need 850 to put a lot of entries twice in the table.} 851 if double_esc_hack_enabled and (st[1]=#27) and (st[2]='#27') and 852 (st[3] in ['a'..'z','A'..'Z','0'..'9','-','+','_','=']) then 853 inc(p); 854 NPT:=RootTree[St[p]]; 855 856 if npt<>nil then 857 begin 858 for i:=p+1 to Length(St) do 859 begin 860 NPT:=FindChild(ord(St[i]),NPT); 861 if NPT=nil then 862 exit; 863 end; 864 if NPT^.CanBeTerminal then 865 begin 866 FindSequence:=true; 867 AScan:=NPT^.ScanValue; 868 AChar:=NPT^.CharValue; 869 end; 870 end; 871end; 872 873type key_sequence=packed record 874 char,scan:byte; 875 st:string[7]; 876 end; 877 878const key_sequences:array[0..297] of key_sequence=( 879 (char:0;scan:kbAltA;st:#27'A'), 880 (char:0;scan:kbAltA;st:#27'a'), 881 (char:0;scan:kbAltB;st:#27'B'), 882 (char:0;scan:kbAltB;st:#27'b'), 883 (char:0;scan:kbAltC;st:#27'C'), 884 (char:0;scan:kbAltC;st:#27'c'), 885 (char:0;scan:kbAltD;st:#27'D'), 886 (char:0;scan:kbAltD;st:#27'd'), 887 (char:0;scan:kbAltE;st:#27'E'), 888 (char:0;scan:kbAltE;st:#27'e'), 889 (char:0;scan:kbAltF;st:#27'F'), 890 (char:0;scan:kbAltF;st:#27'f'), 891 (char:0;scan:kbAltG;st:#27'G'), 892 (char:0;scan:kbAltG;st:#27'g'), 893 (char:0;scan:kbAltH;st:#27'H'), 894 (char:0;scan:kbAltH;st:#27'h'), 895 (char:0;scan:kbAltI;st:#27'I'), 896 (char:0;scan:kbAltI;st:#27'i'), 897 (char:0;scan:kbAltJ;st:#27'J'), 898 (char:0;scan:kbAltJ;st:#27'j'), 899 (char:0;scan:kbAltK;st:#27'K'), 900 (char:0;scan:kbAltK;st:#27'k'), 901 (char:0;scan:kbAltL;st:#27'L'), 902 (char:0;scan:kbAltL;st:#27'l'), 903 (char:0;scan:kbAltM;st:#27'M'), 904 (char:0;scan:kbAltM;st:#27'm'), 905 (char:0;scan:kbAltN;st:#27'N'), 906 (char:0;scan:kbAltN;st:#27'n'), 907 (char:0;scan:kbAltO;st:#27'O'), 908 (char:0;scan:kbAltO;st:#27'o'), 909 (char:0;scan:kbAltP;st:#27'P'), 910 (char:0;scan:kbAltP;st:#27'p'), 911 (char:0;scan:kbAltQ;st:#27'Q'), 912 (char:0;scan:kbAltQ;st:#27'q'), 913 (char:0;scan:kbAltR;st:#27'R'), 914 (char:0;scan:kbAltR;st:#27'r'), 915 (char:0;scan:kbAltS;st:#27'S'), 916 (char:0;scan:kbAltS;st:#27's'), 917 (char:0;scan:kbAltT;st:#27'T'), 918 (char:0;scan:kbAltT;st:#27't'), 919 (char:0;scan:kbAltU;st:#27'U'), 920 (char:0;scan:kbAltU;st:#27'u'), 921 (char:0;scan:kbAltV;st:#27'V'), 922 (char:0;scan:kbAltV;st:#27'v'), 923 (char:0;scan:kbAltW;st:#27'W'), 924 (char:0;scan:kbAltW;st:#27'w'), 925 (char:0;scan:kbAltX;st:#27'X'), 926 (char:0;scan:kbAltX;st:#27'x'), 927 (char:0;scan:kbAltY;st:#27'Y'), 928 (char:0;scan:kbAltY;st:#27'y'), 929 (char:0;scan:kbAltZ;st:#27'Z'), 930 (char:0;scan:kbAltZ;st:#27'z'), 931 (char:0;scan:kbAltMinus;st:#27'-'), 932 (char:0;scan:kbAltEqual;st:#27'='), 933 (char:0;scan:kbAlt0;st:#27'0'), 934 (char:0;scan:kbAlt1;st:#27'1'), 935 (char:0;scan:kbAlt2;st:#27'2'), 936 (char:0;scan:kbAlt3;st:#27'3'), 937 (char:0;scan:kbAlt4;st:#27'4'), 938 (char:0;scan:kbAlt5;st:#27'5'), 939 (char:0;scan:kbAlt6;st:#27'6'), 940 (char:0;scan:kbAlt7;st:#27'7'), 941 (char:0;scan:kbAlt8;st:#27'8'), 942 (char:0;scan:kbAlt9;st:#27'9'), 943 944 (char:0;scan:kbF1;st:#27'[[A'), {linux,konsole,xterm} 945 (char:0;scan:kbF2;st:#27'[[B'), {linux,konsole,xterm} 946 (char:0;scan:kbF3;st:#27'[[C'), {linux,konsole,xterm} 947 (char:0;scan:kbF4;st:#27'[[D'), {linux,konsole,xterm} 948 (char:0;scan:kbF5;st:#27'[[E'), {linux,konsole} 949 (char:0;scan:kbF1;st:#27'[11~'), {Eterm,rxvt} 950 (char:0;scan:kbF2;st:#27'[12~'), {Eterm,rxvt} 951 (char:0;scan:kbF3;st:#27'[13~'), {Eterm,rxvt} 952 (char:0;scan:kbF4;st:#27'[14~'), {Eterm,rxvt} 953 (char:0;scan:kbF5;st:#27'[15~'), {xterm,Eterm,gnome,rxvt} 954 (char:0;scan:kbF6;st:#27'[17~'), {linux,xterm,Eterm,konsole,gnome,rxvt} 955 (char:0;scan:kbF7;st:#27'[18~'), {linux,xterm,Eterm,konsole,gnome,rxvt} 956 (char:0;scan:kbF8;st:#27'[19~'), {linux,xterm,Eterm,konsole,gnome,rxvt} 957 (char:0;scan:kbF9;st:#27'[20~'), {linux,xterm,Eterm,konsole,gnome,rxvt} 958 (char:0;scan:kbF10;st:#27'[21~'), {linux,xterm,Eterm,konsole,gnome,rxvt} 959 (char:0;scan:kbF11;st:#27'[23~'), {linux,xterm,Eterm,konsole,gnome,rxvt} 960 (char:0;scan:kbF12;st:#27'[24~'), {linux,xterm,Eterm,konsole,gnome,rxvt} 961 (char:0;scan:kbF1;st:#27'[M'), {FreeBSD} 962 (char:0;scan:kbF2;st:#27'[N'), {FreeBSD} 963 (char:0;scan:kbF3;st:#27'[O'), {FreeBSD} 964 (char:0;scan:kbF4;st:#27'[P'), {FreeBSD} 965 (char:0;scan:kbF5;st:#27'[Q'), {FreeBSD} 966 (char:0;scan:kbF6;st:#27'[R'), {FreeBSD} 967 (char:0;scan:kbF7;st:#27'[S'), {FreeBSD} 968 (char:0;scan:kbF8;st:#27'[T'), {FreeBSD} 969 (char:0;scan:kbF9;st:#27'[U'), {FreeBSD} 970 (char:0;scan:kbF10;st:#27'[V'), {FreeBSD} 971 (char:0;scan:kbF11;st:#27'[W'), {FreeBSD} 972 (char:0;scan:kbF12;st:#27'[X'), {FreeBSD} 973 (char:0;scan:kbF1;st:#27'OP'), {vt100,gnome,konsole} 974 (char:0;scan:kbF2;st:#27'OQ'), {vt100,gnome,konsole} 975 (char:0;scan:kbF3;st:#27'OR'), {vt100,gnome,konsole} 976 (char:0;scan:kbF4;st:#27'OS'), {vt100,gnome,konsole} 977 (char:0;scan:kbF5;st:#27'Ot'), {vt100} 978 (char:0;scan:kbF6;st:#27'Ou'), {vt100} 979 (char:0;scan:kbF7;st:#27'Ov'), {vt100} 980 (char:0;scan:kbF8;st:#27'Ol'), {vt100} 981 (char:0;scan:kbF9;st:#27'Ow'), {vt100} 982 (char:0;scan:kbF10;st:#27'Ox'), {vt100} 983 (char:0;scan:kbF11;st:#27'Oy'), {vt100} 984 (char:0;scan:kbF12;st:#27'Oz'), {vt100} 985 (char:0;scan:kbEsc;st:#27'[0~'), {if linux keyboard patched, escape 986 returns this} 987 (char:0;scan:kbIns;st:#27'[2~'), {linux,Eterm,rxvt} 988 (char:0;scan:kbDel;st:#27'[3~'), {linux,Eterm,rxvt} 989 (char:0;scan:kbHome;st:#27'[1~'), {linux} 990 (char:0;scan:kbHome;st:#27'[7~'), {Eterm,rxvt} 991 (char:0;scan:kbHome;st:#27'[H'), {FreeBSD} 992 (char:0;scan:kbHome;st:#27'OH'), {some xterm configurations} 993 (char:0;scan:kbEnd;st:#27'[4~'), {linux,Eterm} 994 (char:0;scan:kbEnd;st:#27'[8~'), {rxvt} 995 (char:0;scan:kbEnd;st:#27'[F'), {FreeBSD} 996 (char:0;scan:kbEnd;st:#27'OF'), {some xterm configurations} 997 (char:0;scan:kbPgUp;st:#27'[5~'), {linux,Eterm,rxvt} 998 (char:0;scan:kbPgUp;st:#27'[I'), {FreeBSD} 999 (char:0;scan:kbPgDn;st:#27'[6~'), {linux,Eterm,rxvt} 1000 (char:0;scan:kbPgDn;st:#27'[G'), {FreeBSD} 1001 (char:0;scan:kbUp;st:#27'[A'), {linux,FreeBSD,rxvt} 1002 (char:0;scan:kbDown;st:#27'[B'), {linux,FreeBSD,rxvt} 1003 (char:0;scan:kbRight;st:#27'[C'), {linux,FreeBSD,rxvt} 1004 (char:0;scan:kbLeft;st:#27'[D'), {linux,FreeBSD,rxvt} 1005 (char:0;scan:kbUp;st:#27'OA'), {xterm} 1006 (char:0;scan:kbDown;st:#27'OB'), {xterm} 1007 (char:0;scan:kbRight;st:#27'OC'), {xterm} 1008 (char:0;scan:kbLeft;st:#27'OD'), {xterm} 1009(* Already recognized above as F11! 1010 (char:0;scan:kbShiftF1;st:#27'[23~'), {rxvt} 1011 (char:0;scan:kbShiftF2;st:#27'[24~'), {rxvt} 1012*) 1013 (char:0;scan:kbShiftF3;st:#27'[25~'), {linux,rxvt} 1014 (char:0;scan:kbShiftF4;st:#27'[26~'), {linux,rxvt} 1015 (char:0;scan:kbShiftF5;st:#27'[28~'), {linux,rxvt} 1016 (char:0;scan:kbShiftF6;st:#27'[29~'), {linux,rxvt} 1017 (char:0;scan:kbShiftF7;st:#27'[31~'), {linux,rxvt} 1018 (char:0;scan:kbShiftF8;st:#27'[32~'), {linux,rxvt} 1019 (char:0;scan:kbShiftF9;st:#27'[33~'), {linux,rxvt} 1020 (char:0;scan:kbShiftF10;st:#27'[34~'), {linux,rxvt} 1021 (char:0;scan:kbShiftF11;st:#27'[23$'), {rxvt} 1022 (char:0;scan:kbShiftF12;st:#27'[24$'), {rxvt} 1023 (char:0;scan:kbShiftF1;st:#27'[11;2~'), {konsole in vt420pc mode} 1024 (char:0;scan:kbShiftF2;st:#27'[12;2~'), {konsole in vt420pc mode} 1025 (char:0;scan:kbShiftF3;st:#27'[13;2~'), {konsole in vt420pc mode} 1026 (char:0;scan:kbShiftF4;st:#27'[14;2~'), {konsole in vt420pc mode} 1027 (char:0;scan:kbShiftF5;st:#27'[15;2~'), {xterm} 1028 (char:0;scan:kbShiftF6;st:#27'[17;2~'), {xterm} 1029 (char:0;scan:kbShiftF7;st:#27'[18;2~'), {xterm} 1030 (char:0;scan:kbShiftF8;st:#27'[19;2~'), {xterm} 1031 (char:0;scan:kbShiftF9;st:#27'[20;2~'), {xterm} 1032 (char:0;scan:kbShiftF10;st:#27'[21;2~'), {xterm} 1033 (char:0;scan:kbShiftF11;st:#27'[23;2~'), {xterm} 1034 (char:0;scan:kbShiftF12;st:#27'[24;2~'), {xterm} 1035 (char:0;scan:kbShiftF1;st:#27'O2P'), {konsole,xterm} 1036 (char:0;scan:kbShiftF2;st:#27'O2Q'), {konsole,xterm} 1037 (char:0;scan:kbShiftF3;st:#27'O2R'), {konsole,xterm} 1038 (char:0;scan:kbShiftF4;st:#27'O2S'), {konsole,xterm} 1039 (char:0;scan:kbShiftF1;st:#27'[1;2P'), {xterm,gnome3} 1040 (char:0;scan:kbShiftF2;st:#27'[1;2Q'), {xterm,gnome3} 1041 (char:0;scan:kbShiftF3;st:#27'[1;2R'), {xterm,gnome3} 1042 (char:0;scan:kbShiftF4;st:#27'[1;2S'), {xterm,gnome3} 1043 (char:0;scan:kbCtrlF1;st:#27'O5P'), {konsole,xterm} 1044 (char:0;scan:kbCtrlF2;st:#27'O5Q'), {konsole,xterm} 1045 (char:0;scan:kbCtrlF3;st:#27'O5R'), {konsole,xterm} 1046 (char:0;scan:kbCtrlF4;st:#27'O5S'), {konsole,xterm} 1047 (char:0;scan:kbCtrlF1;st:#27'[1;5P'), {xterm,gnome3} 1048 (char:0;scan:kbCtrlF2;st:#27'[1;5Q'), {xterm,gnome3} 1049 (char:0;scan:kbCtrlF3;st:#27'[1;5R'), {xterm,gnome3} 1050 (char:0;scan:kbCtrlF4;st:#27'[1;5S'), {xterm,gnome3} 1051 (char:0;scan:kbCtrlF1;st:#27'[11;5~'), {none, but expected} 1052 (char:0;scan:kbCtrlF2;st:#27'[12;5~'), {none, but expected} 1053 (char:0;scan:kbCtrlF3;st:#27'[13;5~'), {none, but expected} 1054 (char:0;scan:kbCtrlF4;st:#27'[14;5~'), {none, but expected} 1055 (char:0;scan:kbCtrlF5;st:#27'[15;5~'), {xterm} 1056 (char:0;scan:kbCtrlF6;st:#27'[17;5~'), {xterm} 1057 (char:0;scan:kbCtrlF7;st:#27'[18;5~'), {xterm} 1058 (char:0;scan:kbCtrlF8;st:#27'[19;5~'), {xterm} 1059 (char:0;scan:kbCtrlF9;st:#27'[20;5~'), {xterm} 1060 (char:0;scan:kbCtrlF10;st:#27'[21;5~'), {xterm} 1061 (char:0;scan:kbCtrlF11;st:#27'[23;5~'), {xterm} 1062 (char:0;scan:kbCtrlF12;st:#27'[24;5~'), {xterm} 1063 (char:0;scan:kbCtrlF1;st:#27'[11^'), {rxvt} 1064 (char:0;scan:kbCtrlF2;st:#27'[12^'), {rxvt} 1065 (char:0;scan:kbCtrlF3;st:#27'[13^'), {rxvt} 1066 (char:0;scan:kbCtrlF4;st:#27'[14^'), {rxvt} 1067 (char:0;scan:kbCtrlF5;st:#27'[15^'), {rxvt} 1068 (char:0;scan:kbCtrlF6;st:#27'[17^'), {rxvt} 1069 (char:0;scan:kbCtrlF7;st:#27'[18^'), {rxvt} 1070 (char:0;scan:kbCtrlF8;st:#27'[19^'), {rxvt} 1071 (char:0;scan:kbCtrlF9;st:#27'[20^'), {rxvt} 1072 (char:0;scan:kbCtrlF10;st:#27'[21^'), {rxvt} 1073 (char:0;scan:kbCtrlF11;st:#27'[23^'), {rxvt} 1074 (char:0;scan:kbCtrlF12;st:#27'[24^'), {rxvt} 1075 (char:0;scan:kbShiftIns;st:#27'[2;2~'), {should be the code, but shift+ins 1076 is paste X clipboard in many 1077 terminal emulators :(} 1078 (char:0;scan:kbShiftDel;st:#27'[3;2~'), {xterm,konsole} 1079 (char:0;scan:kbCtrlIns;st:#27'[2;5~'), {xterm} 1080 (char:0;scan:kbCtrlDel;st:#27'[3;5~'), {xterm} 1081 (char:0;scan:kbShiftDel;st:#27'[3$'), {rxvt} 1082 (char:0;scan:kbCtrlIns;st:#27'[2^'), {rxvt} 1083 (char:0;scan:kbCtrlDel;st:#27'[3^'), {rxvt} 1084 (char:0;scan:kbAltF1;st:#27#27'[[A'), 1085 (char:0;scan:kbAltF2;st:#27#27'[[B'), 1086 (char:0;scan:kbAltF3;st:#27#27'[[C'), 1087 (char:0;scan:kbAltF4;st:#27#27'[[D'), 1088 (char:0;scan:kbAltF5;st:#27#27'[[E'), 1089 (char:0;scan:kbAltF1;st:#27#27'[11~'), {rxvt} 1090 (char:0;scan:kbAltF2;st:#27#27'[12~'), {rxvt} 1091 (char:0;scan:kbAltF3;st:#27#27'[13~'), {rxvt} 1092 (char:0;scan:kbAltF4;st:#27#27'[14~'), {rxvt} 1093 (char:0;scan:kbAltF5;st:#27#27'[15~'), {rxvt} 1094 (char:0;scan:kbAltF6;st:#27#27'[17~'), {rxvt} 1095 (char:0;scan:kbAltF7;st:#27#27'[18~'), {rxvt} 1096 (char:0;scan:kbAltF8;st:#27#27'[19~'), {rxvt} 1097 (char:0;scan:kbAltF9;st:#27#27'[20~'), {rxvt} 1098 (char:0;scan:kbAltF10;st:#27#27'[21~'), {rxvt} 1099 (char:0;scan:kbAltF11;st:#27#27'[23~'), {rxvt} 1100 (char:0;scan:kbAltF12;st:#27#27'[24~'), {rxvt} 1101 (char:0;scan:kbAltF1;st:#27#27'OP'), {xterm} 1102 (char:0;scan:kbAltF2;st:#27#27'OQ'), {xterm} 1103 (char:0;scan:kbAltF3;st:#27#27'OR'), {xterm} 1104 (char:0;scan:kbAltF4;st:#27#27'OS'), {xterm} 1105 (char:0;scan:kbAltF5;st:#27#27'Ot'), {xterm} 1106 (char:0;scan:kbAltF6;st:#27#27'Ou'), {xterm} 1107 (char:0;scan:kbAltF7;st:#27#27'Ov'), {xterm} 1108 (char:0;scan:kbAltF8;st:#27#27'Ol'), {xterm} 1109 (char:0;scan:kbAltF9;st:#27#27'Ow'), {xterm} 1110 (char:0;scan:kbAltF10;st:#27#27'Ox'), {xterm} 1111 (char:0;scan:kbAltF11;st:#27#27'Oy'), {xterm} 1112 (char:0;scan:kbAltF12;st:#27#27'Oz'), {xterm} 1113 (char:0;scan:kbAltF1;st:#27'[1;3P'), {xterm,gnome3} 1114 (char:0;scan:kbAltF2;st:#27'[1;3Q'), {xterm,gnome3} 1115 (char:0;scan:kbAltF3;st:#27'[1;3R'), {xterm,gnome3} 1116 (char:0;scan:kbAltF4;st:#27'[1;3S'), {xterm,gnome3} 1117 (char:0;scan:kbAltF1;st:#27'O3P'), {xterm on FreeBSD} 1118 (char:0;scan:kbAltF2;st:#27'O3Q'), {xterm on FreeBSD} 1119 (char:0;scan:kbAltF3;st:#27'O3R'), {xterm on FreeBSD} 1120 (char:0;scan:kbAltF4;st:#27'O3S'), {xterm on FreeBSD} 1121 (char:0;scan:kbAltF5;st:#27'[15;3~'), {xterm on FreeBSD} 1122 (char:0;scan:kbAltF6;st:#27'[17;3~'), {xterm on FreeBSD} 1123 (char:0;scan:kbAltF7;st:#27'[18;3~'), {xterm on FreeBSD} 1124 (char:0;scan:kbAltF8;st:#27'[19;3~'), {xterm on FreeBSD} 1125 (char:0;scan:kbAltF9;st:#27'[20;3~'), {xterm on FreeBSD} 1126 (char:0;scan:kbAltF10;st:#27'[21;3~'), {xterm on FreeBSD} 1127 (char:0;scan:kbAltF11;st:#27'[23;3~'), {xterm on FreeBSD} 1128 (char:0;scan:kbAltF12;st:#27'[24;3~'), {xterm on FreeBSD} 1129 1130 (char:0;scan:kbShiftTab;st:#27#9), {linux - 'Meta_Tab'} 1131 (char:0;scan:kbShiftTab;st:#27'[Z'), 1132 (char:0;scan:kbShiftUp;st:#27'[1;2A'), {xterm} 1133 (char:0;scan:kbShiftDown;st:#27'[1;2B'), {xterm} 1134 (char:0;scan:kbShiftRight;st:#27'[1;2C'), {xterm} 1135 (char:0;scan:kbShiftLeft;st:#27'[1;2D'), {xterm} 1136 (char:0;scan:kbShiftUp;st:#27'[a'), {rxvt} 1137 (char:0;scan:kbShiftDown;st:#27'[b'), {rxvt} 1138 (char:0;scan:kbShiftRight;st:#27'[c'), {rxvt} 1139 (char:0;scan:kbShiftLeft;st:#27'[d'), {rxvt} 1140 (char:0;scan:kbShiftEnd;st:#27'[1;2F'), {xterm} 1141 (char:0;scan:kbShiftEnd;st:#27'[8$'), {rxvt} 1142 (char:0;scan:kbShiftHome;st:#27'[1;2H'), {xterm} 1143 (char:0;scan:kbShiftHome;st:#27'[7$'), {rxvt} 1144 1145 (char:0;scan:KbCtrlShiftUp;st:#27'[1;6A'), {xterm} 1146 (char:0;scan:KbCtrlShiftDown;st:#27'[1;6B'), {xterm} 1147 (char:0;scan:KbCtrlShiftRight;st:#27'[1;6C'), {xterm, xfce4} 1148 (char:0;scan:KbCtrlShiftLeft;st:#27'[1;6D'), {xterm, xfce4} 1149 (char:0;scan:KbCtrlShiftHome;st:#27'[1;6H'), {xterm} 1150 (char:0;scan:KbCtrlShiftEnd;st:#27'[1;6F'), {xterm} 1151 1152 (char:0;scan:kbCtrlPgDn;st:#27'[6;5~'), {xterm} 1153 (char:0;scan:kbCtrlPgUp;st:#27'[5;5~'), {xterm} 1154 (char:0;scan:kbCtrlUp;st:#27'[1;5A'), {xterm} 1155 (char:0;scan:kbCtrlDown;st:#27'[1;5B'), {xterm} 1156 (char:0;scan:kbCtrlRight;st:#27'[1;5C'), {xterm} 1157 (char:0;scan:kbCtrlLeft;st:#27'[1;5D'), {xterm} 1158 (char:0;scan:kbCtrlUp;st:#27'[Oa'), {rxvt} 1159 (char:0;scan:kbCtrlDown;st:#27'[Ob'), {rxvt} 1160 (char:0;scan:kbCtrlRight;st:#27'[Oc'), {rxvt} 1161 (char:0;scan:kbCtrlLeft;st:#27'[Od'), {rxvt} 1162 (char:0;scan:kbCtrlEnd;st:#27'[1;5F'), {xterm} 1163 (char:0;scan:kbCtrlEnd;st:#27'[8^'), {rxvt} 1164 (char:0;scan:kbCtrlHome;st:#27'[1;5H'), {xterm} 1165 (char:0;scan:kbCtrlHome;st:#27'[7^'), {rxvt} 1166 1167 (char:0;scan:kbAltUp;st:#27#27'[A'), {rxvt} 1168 (char:0;scan:kbAltDown;st:#27#27'[B'), {rxvt} 1169 (char:0;scan:kbAltLeft;st:#27#27'[D'), {rxvt} 1170 (char:0;scan:kbAltRight;st:#27#27'[C'), {rxvt} 1171{$ifdef HAIKU} 1172 (char:0;scan:kbAltUp;st:#27#27'OA'), 1173 (char:0;scan:kbAltDown;st:#27#27'OB'), 1174 (char:0;scan:kbAltRight;st:#27#27'OC'), 1175{$else} 1176 (char:0;scan:kbAltUp;st:#27'OA'), 1177 (char:0;scan:kbAltDown;st:#27'OB'), 1178 (char:0;scan:kbAltRight;st:#27'OC'), 1179{$endif} 1180 (char:0;scan:kbAltLeft;st:#27#27'OD'), 1181 (char:0;scan:kbAltPgUp;st:#27#27'[5~'), {rxvt} 1182 (char:0;scan:kbAltPgDn;st:#27#27'[6~'), {rxvt} 1183 (char:0;scan:kbAltEnd;st:#27#27'[4~'), 1184 (char:0;scan:kbAltEnd;st:#27#27'[8~'), {rxvt} 1185 (char:0;scan:kbAltHome;st:#27#27'[1~'), 1186 (char:0;scan:kbAltHome;st:#27#27'[7~'), {rxvt} 1187 (char:0;scan:kbAltIns;st:#27#27'[2~'), {rxvt} 1188 (char:0;scan:kbAltDel;st:#27#27'[3~'), {rxvt} 1189 1190 { xterm default values } 1191 { xterm alternate default values } 1192 { ignored sequences } 1193 (char:0;scan:0;st:#27'[?1;0c'), 1194 (char:0;scan:0;st:#27'[?1l'), 1195 (char:0;scan:0;st:#27'[?1h'), 1196 (char:0;scan:0;st:#27'[?1;2c'), 1197 (char:0;scan:0;st:#27'[?7l'), 1198 (char:0;scan:0;st:#27'[?7h') 1199 ); 1200 1201procedure LoadDefaultSequences; 1202 1203var i:cardinal; 1204 1205begin 1206 AddSpecialSequence(#27'[M',@GenMouseEvent); 1207 AddSpecialSequence(#27'[<',@GenMouseEvent_ExtendedSGR1006); 1208 {Unix backspace/delete hell... Is #127 a backspace or delete?} 1209 if copy(fpgetenv('TERM'),1,4)='cons' then 1210 begin 1211 {FreeBSD is until now only terminal that uses it for delete.} 1212 DoAddSequence(#127,0,kbDel); {Delete} 1213 DoAddSequence(#27#127,0,kbAltDel); {Alt+delete} 1214 end 1215 else 1216 begin 1217 DoAddSequence(#127,8,0); {Backspace} 1218 DoAddSequence(#27#127,0,kbAltBack); {Alt+backspace} 1219 end; 1220 { all Esc letter } 1221 for i:=low(key_sequences) to high(key_sequences) do 1222 with key_sequences[i] do 1223 DoAddSequence(st,char,scan); 1224end; 1225 1226function RawReadKey:char; 1227var 1228 fdsin : tfdSet; 1229begin 1230 {Check Buffer first} 1231 if KeySend<>KeyPut then 1232 begin 1233 RawReadKey:=PopKey; 1234 exit; 1235 end; 1236 {Wait for Key} 1237 if not sysKeyPressed then 1238 begin 1239 fpFD_ZERO (fdsin); 1240 fpFD_SET (StdInputHandle,fdsin); 1241 fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil); 1242 end; 1243 RawReadKey:=ttyRecvChar; 1244end; 1245 1246 1247function RawReadString : String; 1248var 1249 ch : char; 1250 fdsin : tfdSet; 1251 St : String; 1252begin 1253 St:=RawReadKey; 1254 fpFD_ZERO (fdsin); 1255 fpFD_SET (StdInputHandle,fdsin); 1256 Repeat 1257 if inhead=intail then 1258 fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); 1259 if SysKeyPressed then 1260 ch:=ttyRecvChar 1261 else 1262 ch:=#0; 1263 if ch<>#0 then 1264 St:=St+ch; 1265 Until ch=#0; 1266 RawReadString:=St; 1267end; 1268 1269 1270function ReadKey(var IsAlt : boolean):char; 1271var 1272 ch : char; 1273 fdsin : tfdSet; 1274 store : array [0..8] of char; 1275 arrayind : byte; 1276 NPT,NNPT : PTreeElement; 1277 1278 1279 procedure RestoreArray; 1280 var 1281 i : byte; 1282 begin 1283 for i:=0 to arrayind-1 do 1284 PushKey(store[i]); 1285 end; 1286 1287begin 1288 IsAlt:=false; 1289{Check Buffer first} 1290 if KeySend<>KeyPut then 1291 begin 1292 ReadKey:=PopKey; 1293 exit; 1294 end; 1295{Wait for Key} 1296 if not sysKeyPressed then 1297 begin 1298 fpFD_ZERO (fdsin); 1299 fpFD_SET (StdInputHandle,fdsin); 1300 fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil); 1301 end; 1302 ch:=ttyRecvChar; 1303 NPT:=RootTree[ch]; 1304 if not assigned(NPT) then 1305 PushKey(ch) 1306 else 1307 begin 1308 fpFD_ZERO(fdsin); 1309 fpFD_SET(StdInputHandle,fdsin); 1310 store[0]:=ch; 1311 arrayind:=1; 1312 while assigned(NPT) and syskeypressed do 1313 begin 1314 if inhead=intail then 1315 fpSelect(StdInputHandle+1,@fdsin,nil,nil,10); 1316 ch:=ttyRecvChar; 1317 if (ch=#27) and double_esc_hack_enabled then 1318 begin 1319 {This is the same hack as in findsequence; see findsequence for 1320 explanation.} 1321 ch:=ttyrecvchar; 1322 {Alt+O cannot be used in this situation, it can be a function key.} 1323 if not(ch in ['a'..'z','A'..'N','P'..'Z','0'..'9','-','+','_','=']) then 1324 begin 1325 if intail=0 then 1326 intail:=insize 1327 else 1328 dec(intail); 1329 inbuf[intail]:=ch; 1330 ch:=#27; 1331 end 1332 else 1333 begin 1334 write(#27'[?1036l'); 1335 double_esc_hack_enabled:=false; 1336 end; 1337 end; 1338 NNPT:=FindChild(ord(ch),NPT); 1339 if assigned(NNPT) then 1340 begin 1341 NPT:=NNPT; 1342 if NPT^.CanBeTerminal and 1343 assigned(NPT^.SpecialHandler) then 1344 break; 1345 End; 1346 if ch<>#0 then 1347 begin 1348 store[arrayind]:=ch; 1349 inc(arrayind); 1350 end; 1351 if not assigned(NNPT) then 1352 begin 1353 if ch<>#0 then 1354 begin 1355 { Put that unused char back into InBuf } 1356 If InTail=0 then 1357 InTail:=InSize-1 1358 else 1359 Dec(InTail); 1360 InBuf[InTail]:=ch; 1361 end; 1362 break; 1363 end; 1364 end; 1365 if assigned(NPT) and NPT^.CanBeTerminal then 1366 begin 1367 if assigned(NPT^.SpecialHandler) then 1368 begin 1369 NPT^.SpecialHandler; 1370 PushExt(0); 1371 end 1372 else if NPT^.CharValue<>0 then 1373 PushKey(chr(NPT^.CharValue)) 1374 else if NPT^.ScanValue<>0 then 1375 PushExt(NPT^.ScanValue); 1376 end 1377 else 1378 RestoreArray; 1379 end; 1380{$ifdef logging} 1381 writeln(f); 1382{$endif logging} 1383 1384 ReadKey:=PopKey; 1385End; 1386 1387{$ifdef linux} 1388function ShiftState:byte; 1389 1390var arg:longint; 1391 1392begin 1393 shiftstate:=0; 1394 arg:=6; 1395 if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then 1396 begin 1397 if (arg and 8)<>0 then 1398 shiftstate:=kbAlt; 1399 if (arg and 4)<>0 then 1400 inc(shiftstate,kbCtrl); 1401 { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM } 1402 if (arg and 2)<>0 then 1403 shiftstate:=shiftstate or (kbAlt or kbCtrl); 1404 if (arg and 1)<>0 then 1405 inc(shiftstate,kbShift); 1406 end; 1407end; 1408 1409procedure force_linuxtty; 1410 1411var s:string[15]; 1412 handle:sizeint; 1413 thistty:string; 1414 1415begin 1416 is_console:=false; 1417 if vcs_device<>-1 then 1418 begin 1419 { running on a tty, find out whether locally or remotely } 1420 thistty:=ttyname(stdinputhandle); 1421 if (copy(thistty,1,8)<>'/dev/tty') or not (thistty[9] in ['0'..'9']) then 1422 begin 1423 {Running from Midnight Commander or something... Bypass it.} 1424 str(vcs_device,s); 1425 handle:=fpopen('/dev/tty'+s,O_RDWR); 1426 fpioctl(stdinputhandle,TIOCNOTTY,nil); 1427 {This will currently only work when the user is root :(} 1428 fpioctl(handle,TIOCSCTTY,nil); 1429 if errno<>0 then 1430 exit; 1431 fpclose(stdinputhandle); 1432 fpclose(stdoutputhandle); 1433 fpclose(stderrorhandle); 1434 fpdup2(handle,stdinputhandle); 1435 fpdup2(handle,stdoutputhandle); 1436 fpdup2(handle,stderrorhandle); 1437 fpclose(handle); 1438 end; 1439 is_console:=true; 1440 end; 1441end; 1442{$endif linux} 1443 1444{ Exported functions } 1445 1446procedure SysInitKeyboard; 1447begin 1448 SetRawMode(true); 1449{$ifdef logging} 1450 assign(f,'keyboard.log'); 1451 rewrite(f); 1452{$endif logging} 1453{$ifdef linux} 1454 force_linuxtty; 1455 prepare_patching; 1456 patchkeyboard; 1457 if is_console then 1458 install_vt_handler 1459 else 1460 begin 1461{$endif} 1462 { default for Shift prefix is ^ A} 1463 if ShiftPrefix = 0 then 1464 ShiftPrefix:=1; 1465 {default for Alt prefix is ^Z } 1466 if AltPrefix=0 then 1467 AltPrefix:=26; 1468 { default for Ctrl Prefix is ^W } 1469 if CtrlPrefix=0 then 1470 CtrlPrefix:=23; 1471 if copy(fpgetenv('TERM'),1,5)='xterm' then 1472 {The alt key should generate an escape prefix. Save the old setting 1473 make make it send that escape prefix.} 1474 begin 1475 write(#27'[?1036s'#27'[?1036h'); 1476 double_esc_hack_enabled:=true; 1477 end; 1478{$ifdef linux} 1479 end; 1480{$endif} 1481 LoadDefaultSequences; 1482{ LoadTerminfoSequences;} 1483end; 1484 1485 1486procedure SysDoneKeyboard; 1487begin 1488{$ifdef linux} 1489 if is_console then 1490 unpatchkeyboard; 1491{$endif linux} 1492 1493 if copy(fpgetenv('TERM'),1,5)='xterm' then 1494 {Restore the old alt key behaviour.} 1495 write(#27'[?1036r'); 1496 1497 SetRawMode(false); 1498 1499 FreeTree; 1500{$ifdef logging} 1501 close(f); 1502{$endif logging} 1503end; 1504 1505 1506function SysGetKeyEvent: TKeyEvent; 1507 1508 function EvalScan(b:byte):byte; 1509 const 1510 DScan:array[0..31] of byte = ( 1511 $39, $02, $28, $04, $05, $06, $08, $28, 1512 $0A, $0B, $09, $0D, $33, $0C, $34, $35, 1513 $0B, $02, $03, $04, $05, $06, $07, $08, 1514 $09, $0A, $27, $27, $33, $0D, $34, $35); 1515 LScan:array[0..31] of byte = ( 1516 $29, $1E, $30, $2E, $20, $12, $21, $22, 1517 $23, $17, $24, $25, $26, $32, $31, $18, 1518 $19, $10, $13, $1F, $14, $16, $2F, $11, 1519 $2D, $15, $2C, $1A, $2B, $1B, $29, $0C); 1520 begin 1521 if (b and $E0)=$20 { digits / leters } then 1522 EvalScan:=DScan[b and $1F] 1523 else 1524 case b of 1525 $08:EvalScan:=$0E; { backspace } 1526 $09:EvalScan:=$0F; { TAB } 1527 $0D:EvalScan:=$1C; { CR } 1528 $1B:EvalScan:=$01; { esc } 1529 $40:EvalScan:=$03; { @ } 1530 $5E:EvalScan:=$07; { ^ } 1531 $60:EvalScan:=$29; { ` } 1532 else 1533 EvalScan:=LScan[b and $1F]; 1534 end; 1535 end; 1536 1537 function EvalScanZ(b:byte):byte; 1538 begin 1539 EvalScanZ:=b; 1540 if b in [$3B..$44] { F1..F10 -> Alt-F1..Alt-F10} then 1541 EvalScanZ:=b+$2D; 1542 end; 1543 1544const 1545 {kbHome, kbUp, kbPgUp,Missing, kbLeft, 1546 kbCenter, kbRight, kbAltGrayPlus, kbend, 1547 kbDown, kbPgDn, kbIns, kbDel } 1548 CtrlArrow : array [kbHome..kbDel] of byte = 1549 {($77,$8d,$84,$8e,$73,$8f,$74,$90,$75,$91,$76);} 1550 (kbCtrlHome,kbCtrlUp,kbCtrlPgUp,kbNoKey,kbCtrlLeft, 1551 kbCtrlCenter,kbCtrlRight,kbAltGrayPlus,kbCtrlEnd, 1552 kbCtrlDown,kbCtrlPgDn,kbCtrlIns,kbCtrlDel); 1553 AltArrow : array [kbHome..kbDel] of byte = 1554 (kbAltHome,kbAltUp,kbAltPgUp,kbNoKey,kbAltLeft, 1555 kbCenter,kbAltRight,kbAltGrayPlus,kbAltEnd, 1556 kbAltDown,kbAltPgDn,kbAltIns,kbAltDel); 1557 ShiftArrow : array [kbShiftUp..kbShiftEnd] of byte = 1558 (kbUp,kbLeft,kbRight,kbDown,kbHome,kbEnd); 1559 CtrlShiftArrow : array [kbCtrlShiftUp..kbCtrlShiftEnd] of byte = 1560 (kbCtrlUp,kbCtrlDown,kbCtrlRight,kbCtrlLeft,kbCtrlHome,kbCtrlEnd); 1561 1562var 1563 MyScan:byte; 1564 MyChar : char; 1565 EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,IsAlt,Again : boolean; 1566 SState:byte; 1567 1568begin {main} 1569 MyChar:=Readkey(IsAlt); 1570 MyScan:=ord(MyChar); 1571{$ifdef linux} 1572 if is_console then 1573 SState:=ShiftState 1574 else 1575{$endif} 1576 Sstate:=0; 1577 CtrlPrefixUsed:=false; 1578 AltPrefixUsed:=false; 1579 ShiftPrefixUsed:=false; 1580 EscUsed:=false; 1581 if IsAlt then 1582 SState:=SState or kbAlt; 1583 repeat 1584 again:=false; 1585 if Mychar=#0 then 1586 begin 1587 MyScan:=ord(ReadKey(IsAlt)); 1588 if myscan=$01 then 1589 mychar:=#27; 1590 { Handle Ctrl-<x>, but not AltGr-<x> } 1591 if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then 1592 case MyScan of 1593 kbShiftTab: MyScan := kbCtrlTab; 1594 kbHome..kbDel : { cArrow } 1595 MyScan:=CtrlArrow[MyScan]; 1596 kbF1..KbF10 : { cF1-cF10 } 1597 MyScan:=MyScan+kbCtrlF1-kbF1; 1598 kbF11..KbF12 : { cF11-cF12 } 1599 MyScan:=MyScan+kbCtrlF11-kbF11; 1600 end 1601 { Handle Alt-<x>, but not AltGr } 1602 else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then 1603 case MyScan of 1604 kbShiftTab: MyScan := kbAltTab; 1605 kbHome..kbDel : { AltArrow } 1606 MyScan:=AltArrow[MyScan]; 1607 kbF1..KbF10 : { aF1-aF10 } 1608 MyScan:=MyScan+kbAltF1-kbF1; 1609 kbF11..KbF12 : { aF11-aF12 } 1610 MyScan:=MyScan+kbAltF11-kbF11; 1611 end 1612 else if (SState and kbShift)<>0 then 1613 case MyScan of 1614 kbIns: MyScan:=kbShiftIns; 1615 kbDel: MyScan:=kbShiftDel; 1616 kbF1..KbF10 : { sF1-sF10 } 1617 MyScan:=MyScan+kbShiftF1-kbF1; 1618 kbF11..KbF12 : { sF11-sF12 } 1619 MyScan:=MyScan+kbShiftF11-kbF11; 1620 end; 1621 if myscan in [kbShiftUp..kbCtrlShiftEnd] then 1622 begin 1623 if myscan <= kbShiftEnd then 1624 begin 1625 myscan:=ShiftArrow[myscan]; 1626 sstate:=sstate or kbshift; 1627 end else 1628 begin 1629 myscan:=CtrlShiftArrow[myscan]; 1630 sstate:=sstate or kbshift or kbCtrl; 1631 end; 1632 end; 1633 if myscan=kbAltBack then 1634 sstate:=sstate or kbalt; 1635 if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then 1636 SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16) 1637 else 1638 SysGetKeyEvent:=0; 1639 exit; 1640 end 1641 else if MyChar=#27 then 1642 begin 1643 if EscUsed then 1644 SState:=SState and not kbAlt 1645 else 1646 begin 1647 SState:=SState or kbAlt; 1648 Again:=true; 1649 EscUsed:=true; 1650 end; 1651 end 1652 else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then 1653 begin { ^Z - replace Alt for Linux OS } 1654 if AltPrefixUsed then 1655 begin 1656 SState:=SState and not kbAlt; 1657 end 1658 else 1659 begin 1660 AltPrefixUsed:=true; 1661 SState:=SState or kbAlt; 1662 Again:=true; 1663 end; 1664 end 1665 else if (CtrlPrefix<>0) and (MyChar=chr(CtrlPrefix)) then 1666 begin 1667 if CtrlPrefixUsed then 1668 SState:=SState and not kbCtrl 1669 else 1670 begin 1671 CtrlPrefixUsed:=true; 1672 SState:=SState or kbCtrl; 1673 Again:=true; 1674 end; 1675 end 1676 else if (ShiftPrefix<>0) and (MyChar=chr(ShiftPrefix)) then 1677 begin 1678 if ShiftPrefixUsed then 1679 SState:=SState and not kbShift 1680 else 1681 begin 1682 ShiftPrefixUsed:=true; 1683 SState:=SState or kbShift; 1684 Again:=true; 1685 end; 1686 end; 1687 if not again then 1688 begin 1689 MyScan:=EvalScan(ord(MyChar)); 1690 if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then 1691 begin 1692 if MyChar=#9 then 1693 begin 1694 MyChar:=#0; 1695 MyScan:=kbCtrlTab; 1696 end; 1697 end 1698 else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then 1699 begin 1700 if MyChar=#9 then 1701 begin 1702 MyChar:=#0; 1703 MyScan:=kbAltTab; 1704 end 1705 else 1706 begin 1707 if MyScan in [$02..$0D] then 1708 inc(MyScan,$76); 1709 MyChar:=chr(0); 1710 end; 1711 end 1712 else if (SState and kbShift)<>0 then 1713 if MyChar=#9 then 1714 begin 1715 MyChar:=#0; 1716 MyScan:=kbShiftTab; 1717 end; 1718 end 1719 else 1720 begin 1721 MyChar:=Readkey(IsAlt); 1722 MyScan:=ord(MyChar); 1723 if IsAlt then 1724 SState:=SState or kbAlt; 1725 end; 1726 until not Again; 1727 if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then 1728 SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16) 1729 else 1730 SysGetKeyEvent:=0; 1731end; 1732 1733 1734function SysPollKeyEvent: TKeyEvent; 1735var 1736 KeyEvent : TKeyEvent; 1737begin 1738 if keypressed then 1739 begin 1740 KeyEvent:=SysGetKeyEvent; 1741 PutKeyEvent(KeyEvent); 1742 SysPollKeyEvent:=KeyEvent 1743 end 1744 else 1745 SysPollKeyEvent:=0; 1746end; 1747 1748 1749function SysGetShiftState : Byte; 1750begin 1751{$ifdef linux} 1752 if is_console then 1753 SysGetShiftState:=ShiftState 1754 else 1755{$endif} 1756 SysGetShiftState:=0; 1757end; 1758 1759 1760procedure RestoreStartMode; 1761begin 1762 TCSetAttr(1,TCSANOW,StartTio); 1763end; 1764 1765 1766const 1767 SysKeyboardDriver : TKeyboardDriver = ( 1768 InitDriver : @SysInitKeyBoard; 1769 DoneDriver : @SysDoneKeyBoard; 1770 GetKeyevent : @SysGetKeyEvent; 1771 PollKeyEvent : @SysPollKeyEvent; 1772 GetShiftState : @SysGetShiftState; 1773 TranslateKeyEvent : Nil; 1774 TranslateKeyEventUnicode : Nil; 1775 ); 1776 1777begin 1778 SetKeyBoardDriver(SysKeyBoardDriver); 1779 TCGetAttr(1,StartTio); 1780end. 1781