keyboard.pp 49 KB

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