keyboard.pp 48 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615
  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. begin
  418. fpFD_ZERO(fdsin);
  419. fpFD_SET(StdInputHandle,fdsin);
  420. { Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);}
  421. MouseEvent.action:=0;
  422. if inhead=intail then
  423. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  424. ch:=ttyRecvChar;
  425. { Other bits are used for Shift, Meta and Ctrl modifiers PM }
  426. case (ord(ch)-ord(' ')) and 3 of
  427. 0 : {left button press}
  428. MouseEvent.buttons:=1;
  429. 1 : {middle button pressed }
  430. MouseEvent.buttons:=2;
  431. 2 : { right button pressed }
  432. MouseEvent.buttons:=4;
  433. 3 : { no button pressed };
  434. end;
  435. if inhead=intail then
  436. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  437. ch:=ttyRecvChar;
  438. MouseEvent.x:=Ord(ch)-ord(' ')-1;
  439. if inhead=intail then
  440. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  441. ch:=ttyRecvChar;
  442. MouseEvent.y:=Ord(ch)-ord(' ')-1;
  443. if (MouseEvent.buttons<>0) then
  444. MouseEvent.action:=MouseActionDown
  445. else
  446. begin
  447. if (LastMouseEvent.Buttons<>0) and
  448. ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
  449. begin
  450. MouseEvent.Action:=MouseActionMove;
  451. MouseEvent.Buttons:=LastMouseEvent.Buttons;
  452. {$ifdef DebugMouse}
  453. Writeln(system.stderr,' Mouse Move (',MouseEvent.X,',',MouseEvent.Y,')');
  454. {$endif DebugMouse}
  455. PutMouseEvent(MouseEvent);
  456. MouseEvent.Buttons:=0;
  457. end;
  458. MouseEvent.Action:=MouseActionUp;
  459. end;
  460. PutMouseEvent(MouseEvent);
  461. {$ifdef DebugMouse}
  462. if MouseEvent.Action=MouseActionDown then
  463. Write(system.stderr,'Button down : ')
  464. else
  465. Write(system.stderr,'Button up : ');
  466. Writeln(system.stderr,'buttons = ',MouseEvent.Buttons,' (',MouseEvent.X,',',MouseEvent.Y,')');
  467. {$endif DebugMouse}
  468. LastMouseEvent:=MouseEvent;
  469. end;
  470. type
  471. Tprocedure = procedure;
  472. PTreeElement = ^TTreeElement;
  473. TTreeElement = record
  474. Next,Parent,Child : PTreeElement;
  475. CanBeTerminal : boolean;
  476. char : byte;
  477. ScanValue : byte;
  478. CharValue : byte;
  479. SpecialHandler : Tprocedure;
  480. end;
  481. var roottree:array[char] of PTreeElement;
  482. procedure FreeElement (PT:PTreeElement);
  483. var next : PTreeElement;
  484. begin
  485. while PT <> nil do
  486. begin
  487. FreeElement(PT^.Child);
  488. next := PT^.Next;
  489. dispose(PT);
  490. PT := next;
  491. end;
  492. end;
  493. procedure FreeTree;
  494. var i:char;
  495. begin
  496. for i:=low(roottree) to high(roottree) do
  497. begin
  498. FreeElement(RootTree[i]);
  499. roottree[i]:=nil;
  500. end;
  501. end;
  502. function NewPTree(ch : byte;Pa : PTreeElement) : PTreeElement;
  503. begin
  504. newPtree:=allocmem(sizeof(Ttreeelement));
  505. newPtree^.char:=ch;
  506. newPtree^.Parent:=Pa;
  507. if Assigned(Pa) and (Pa^.Child=nil) then
  508. Pa^.Child:=newPtree;
  509. end;
  510. function DoAddSequence(const St : String; AChar,AScan :byte) : PTreeElement;
  511. var
  512. CurPTree,NPT : PTreeElement;
  513. c : byte;
  514. i : longint;
  515. begin
  516. if St='' then
  517. begin
  518. DoAddSequence:=nil;
  519. exit;
  520. end;
  521. CurPTree:=RootTree[st[1]];
  522. if CurPTree=nil then
  523. begin
  524. CurPTree:=NewPTree(ord(st[1]),nil);
  525. RootTree[st[1]]:=CurPTree;
  526. end;
  527. for i:=2 to Length(St) do
  528. begin
  529. NPT:=CurPTree^.Child;
  530. c:=ord(St[i]);
  531. if NPT=nil then
  532. NPT:=NewPTree(c,CurPTree);
  533. CurPTree:=nil;
  534. while assigned(NPT) and (NPT^.char<c) do
  535. begin
  536. CurPTree:=NPT;
  537. NPT:=NPT^.Next;
  538. end;
  539. if assigned(NPT) and (NPT^.char=c) then
  540. CurPTree:=NPT
  541. else
  542. begin
  543. if CurPTree=nil then
  544. begin
  545. NPT^.Parent^.child:=NewPTree(c,NPT^.Parent);
  546. CurPTree:=NPT^.Parent^.Child;
  547. CurPTree^.Next:=NPT;
  548. end
  549. else
  550. begin
  551. CurPTree^.Next:=NewPTree(c,CurPTree^.Parent);
  552. CurPTree:=CurPTree^.Next;
  553. CurPTree^.Next:=NPT;
  554. end;
  555. end;
  556. end;
  557. if CurPTree^.CanBeTerminal then
  558. begin
  559. { here we have a conflict !! }
  560. { maybe we should claim }
  561. with CurPTree^ do
  562. begin
  563. {$ifdef DEBUG}
  564. if (ScanValue<>AScan) or (CharValue<>AChar) then
  565. Writeln(system.stderr,'key "',st,'" changed value');
  566. if (ScanValue<>AScan) then
  567. Writeln(system.stderr,'Scan was ',ScanValue,' now ',AScan);
  568. if (CharValue<>AChar) then
  569. Writeln(system.stderr,'Char was ',chr(CharValue),' now ',chr(AChar));
  570. {$endif DEBUG}
  571. ScanValue:=AScan;
  572. CharValue:=AChar;
  573. end;
  574. end
  575. else with CurPTree^ do
  576. begin
  577. CanBeTerminal:=True;
  578. ScanValue:=AScan;
  579. CharValue:=AChar;
  580. end;
  581. DoAddSequence:=CurPTree;
  582. end;
  583. procedure AddSequence(const St : String; AChar,AScan :byte);inline;
  584. begin
  585. DoAddSequence(St,AChar,AScan);
  586. end;
  587. { Returns the Child that as c as char if it exists }
  588. function FindChild(c : byte;Root : PTreeElement) : PTreeElement;
  589. var
  590. NPT : PTreeElement;
  591. begin
  592. NPT:=Root^.Child;
  593. while assigned(NPT) and (NPT^.char<c) do
  594. NPT:=NPT^.Next;
  595. if assigned(NPT) and (NPT^.char=c) then
  596. FindChild:=NPT
  597. else
  598. FindChild:=nil;
  599. end;
  600. function AddSpecialSequence(const St : string;Proc : Tprocedure) : PTreeElement;
  601. var
  602. NPT : PTreeElement;
  603. begin
  604. NPT:=DoAddSequence(St,0,0);
  605. NPT^.SpecialHandler:=Proc;
  606. AddSpecialSequence:=NPT;
  607. end;
  608. function FindSequence(const St : String;var AChar,AScan :byte) : boolean;
  609. var
  610. NPT : PTreeElement;
  611. i,p : byte;
  612. begin
  613. FindSequence:=false;
  614. AChar:=0;
  615. AScan:=0;
  616. if St='' then
  617. exit;
  618. p:=1;
  619. {This is a distusting hack for certain even more disgusting xterms: Some of
  620. them send two escapes for an alt-key. If we wouldn't do this, we would need
  621. to put a lot of entries twice in the table.}
  622. if double_esc_hack_enabled and (st[1]=#27) and (st[2]='#27') and
  623. (st[3] in ['a'..'z','A'..'Z','0'..'9','-','+','_','=']) then
  624. inc(p);
  625. NPT:=RootTree[St[p]];
  626. if npt<>nil then
  627. begin
  628. for i:=p+1 to Length(St) do
  629. begin
  630. NPT:=FindChild(ord(St[i]),NPT);
  631. if NPT=nil then
  632. exit;
  633. end;
  634. if NPT^.CanBeTerminal then
  635. begin
  636. FindSequence:=true;
  637. AScan:=NPT^.ScanValue;
  638. AChar:=NPT^.CharValue;
  639. end;
  640. end;
  641. end;
  642. type key_sequence=packed record
  643. char,scan:byte;
  644. st:string[7];
  645. end;
  646. const key_sequences:array[0..278] of key_sequence=(
  647. (char:0;scan:kbAltA;st:#27'A'),
  648. (char:0;scan:kbAltA;st:#27'a'),
  649. (char:0;scan:kbAltB;st:#27'B'),
  650. (char:0;scan:kbAltB;st:#27'b'),
  651. (char:0;scan:kbAltC;st:#27'C'),
  652. (char:0;scan:kbAltC;st:#27'c'),
  653. (char:0;scan:kbAltD;st:#27'D'),
  654. (char:0;scan:kbAltD;st:#27'd'),
  655. (char:0;scan:kbAltE;st:#27'E'),
  656. (char:0;scan:kbAltE;st:#27'e'),
  657. (char:0;scan:kbAltF;st:#27'F'),
  658. (char:0;scan:kbAltF;st:#27'f'),
  659. (char:0;scan:kbAltG;st:#27'G'),
  660. (char:0;scan:kbAltG;st:#27'g'),
  661. (char:0;scan:kbAltH;st:#27'H'),
  662. (char:0;scan:kbAltH;st:#27'h'),
  663. (char:0;scan:kbAltI;st:#27'I'),
  664. (char:0;scan:kbAltI;st:#27'i'),
  665. (char:0;scan:kbAltJ;st:#27'J'),
  666. (char:0;scan:kbAltJ;st:#27'j'),
  667. (char:0;scan:kbAltK;st:#27'K'),
  668. (char:0;scan:kbAltK;st:#27'k'),
  669. (char:0;scan:kbAltL;st:#27'L'),
  670. (char:0;scan:kbAltL;st:#27'l'),
  671. (char:0;scan:kbAltM;st:#27'M'),
  672. (char:0;scan:kbAltM;st:#27'm'),
  673. (char:0;scan:kbAltN;st:#27'N'),
  674. (char:0;scan:kbAltN;st:#27'n'),
  675. (char:0;scan:kbAltO;st:#27'O'),
  676. (char:0;scan:kbAltO;st:#27'o'),
  677. (char:0;scan:kbAltP;st:#27'P'),
  678. (char:0;scan:kbAltP;st:#27'p'),
  679. (char:0;scan:kbAltQ;st:#27'Q'),
  680. (char:0;scan:kbAltQ;st:#27'q'),
  681. (char:0;scan:kbAltR;st:#27'R'),
  682. (char:0;scan:kbAltR;st:#27'r'),
  683. (char:0;scan:kbAltS;st:#27'S'),
  684. (char:0;scan:kbAltS;st:#27's'),
  685. (char:0;scan:kbAltT;st:#27'T'),
  686. (char:0;scan:kbAltT;st:#27't'),
  687. (char:0;scan:kbAltU;st:#27'U'),
  688. (char:0;scan:kbAltU;st:#27'u'),
  689. (char:0;scan:kbAltV;st:#27'V'),
  690. (char:0;scan:kbAltV;st:#27'v'),
  691. (char:0;scan:kbAltW;st:#27'W'),
  692. (char:0;scan:kbAltW;st:#27'w'),
  693. (char:0;scan:kbAltX;st:#27'X'),
  694. (char:0;scan:kbAltX;st:#27'x'),
  695. (char:0;scan:kbAltY;st:#27'Y'),
  696. (char:0;scan:kbAltY;st:#27'y'),
  697. (char:0;scan:kbAltZ;st:#27'Z'),
  698. (char:0;scan:kbAltZ;st:#27'z'),
  699. (char:0;scan:kbAltMinus;st:#27'-'),
  700. (char:0;scan:kbAltEqual;st:#27'='),
  701. (char:0;scan:kbAlt0;st:#27'0'),
  702. (char:0;scan:kbAlt1;st:#27'1'),
  703. (char:0;scan:kbAlt2;st:#27'2'),
  704. (char:0;scan:kbAlt3;st:#27'3'),
  705. (char:0;scan:kbAlt4;st:#27'4'),
  706. (char:0;scan:kbAlt5;st:#27'5'),
  707. (char:0;scan:kbAlt6;st:#27'6'),
  708. (char:0;scan:kbAlt7;st:#27'7'),
  709. (char:0;scan:kbAlt8;st:#27'8'),
  710. (char:0;scan:kbAlt9;st:#27'9'),
  711. (char:0;scan:kbF1;st:#27'[[A'), {linux,konsole,xterm}
  712. (char:0;scan:kbF2;st:#27'[[B'), {linux,konsole,xterm}
  713. (char:0;scan:kbF3;st:#27'[[C'), {linux,konsole,xterm}
  714. (char:0;scan:kbF4;st:#27'[[D'), {linux,konsole,xterm}
  715. (char:0;scan:kbF5;st:#27'[[E'), {linux,konsole}
  716. (char:0;scan:kbF1;st:#27'[11~'), {Eterm,rxvt}
  717. (char:0;scan:kbF2;st:#27'[12~'), {Eterm,rxvt}
  718. (char:0;scan:kbF3;st:#27'[13~'), {Eterm,rxvt}
  719. (char:0;scan:kbF4;st:#27'[14~'), {Eterm,rxvt}
  720. (char:0;scan:kbF5;st:#27'[15~'), {xterm,Eterm,gnome,rxvt}
  721. (char:0;scan:kbF6;st:#27'[17~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
  722. (char:0;scan:kbF7;st:#27'[18~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
  723. (char:0;scan:kbF8;st:#27'[19~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
  724. (char:0;scan:kbF9;st:#27'[20~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
  725. (char:0;scan:kbF10;st:#27'[21~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
  726. (char:0;scan:kbF11;st:#27'[23~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
  727. (char:0;scan:kbF12;st:#27'[24~'), {linux,xterm,Eterm,konsole,gnome,rxvt}
  728. (char:0;scan:kbF1;st:#27'[M'), {FreeBSD}
  729. (char:0;scan:kbF2;st:#27'[N'), {FreeBSD}
  730. (char:0;scan:kbF3;st:#27'[O'), {FreeBSD}
  731. (char:0;scan:kbF4;st:#27'[P'), {FreeBSD}
  732. (char:0;scan:kbF5;st:#27'[Q'), {FreeBSD}
  733. (char:0;scan:kbF6;st:#27'[R'), {FreeBSD}
  734. (char:0;scan:kbF7;st:#27'[S'), {FreeBSD}
  735. (char:0;scan:kbF8;st:#27'[T'), {FreeBSD}
  736. (char:0;scan:kbF9;st:#27'[U'), {FreeBSD}
  737. (char:0;scan:kbF10;st:#27'[V'), {FreeBSD}
  738. (char:0;scan:kbF11;st:#27'[W'), {FreeBSD}
  739. (char:0;scan:kbF12;st:#27'[X'), {FreeBSD}
  740. (char:0;scan:kbF1;st:#27'OP'), {vt100,gnome,konsole}
  741. (char:0;scan:kbF2;st:#27'OQ'), {vt100,gnome,konsole}
  742. (char:0;scan:kbF3;st:#27'OR'), {vt100,gnome,konsole}
  743. (char:0;scan:kbF4;st:#27'OS'), {vt100,gnome,konsole}
  744. (char:0;scan:kbF5;st:#27'Ot'), {vt100}
  745. (char:0;scan:kbF6;st:#27'Ou'), {vt100}
  746. (char:0;scan:kbF7;st:#27'Ov'), {vt100}
  747. (char:0;scan:kbF8;st:#27'Ol'), {vt100}
  748. (char:0;scan:kbF9;st:#27'Ow'), {vt100}
  749. (char:0;scan:kbF10;st:#27'Ox'), {vt100}
  750. (char:0;scan:kbF11;st:#27'Oy'), {vt100}
  751. (char:0;scan:kbF12;st:#27'Oz'), {vt100}
  752. (char:0;scan:kbEsc;st:#27'[0~'), {if linux keyboard patched, escape
  753. returns this}
  754. (char:0;scan:kbIns;st:#27'[2~'), {linux,Eterm,rxvt}
  755. (char:0;scan:kbDel;st:#27'[3~'), {linux,Eterm,rxvt}
  756. (char:0;scan:kbHome;st:#27'[1~'), {linux}
  757. (char:0;scan:kbHome;st:#27'[7~'), {Eterm,rxvt}
  758. (char:0;scan:kbHome;st:#27'[H'), {FreeBSD}
  759. (char:0;scan:kbHome;st:#27'OH'), {some xterm configurations}
  760. (char:0;scan:kbEnd;st:#27'[4~'), {linux,Eterm}
  761. (char:0;scan:kbEnd;st:#27'[8~'), {rxvt}
  762. (char:0;scan:kbEnd;st:#27'[F'), {FreeBSD}
  763. (char:0;scan:kbEnd;st:#27'OF'), {some xterm configurations}
  764. (char:0;scan:kbPgUp;st:#27'[5~'), {linux,Eterm,rxvt}
  765. (char:0;scan:kbPgUp;st:#27'[I'), {FreeBSD}
  766. (char:0;scan:kbPgDn;st:#27'[6~'), {linux,Eterm,rxvt}
  767. (char:0;scan:kbPgDn;st:#27'[G'), {FreeBSD}
  768. (char:0;scan:kbUp;st:#27'[A'), {linux,FreeBSD,rxvt}
  769. (char:0;scan:kbDown;st:#27'[B'), {linux,FreeBSD,rxvt}
  770. (char:0;scan:kbRight;st:#27'[C'), {linux,FreeBSD,rxvt}
  771. (char:0;scan:kbLeft;st:#27'[D'), {linux,FreeBSD,rxvt}
  772. (char:0;scan:kbUp;st:#27'OA'), {xterm}
  773. (char:0;scan:kbDown;st:#27'OB'), {xterm}
  774. (char:0;scan:kbRight;st:#27'OC'), {xterm}
  775. (char:0;scan:kbLeft;st:#27'OD'), {xterm}
  776. (char:0;scan:kbShiftF1;st:#27'[23~'), {rxvt}
  777. (char:0;scan:kbShiftF2;st:#27'[24~'), {rxvt}
  778. (char:0;scan:kbShiftF3;st:#27'[25~'), {linux,rxvt}
  779. (char:0;scan:kbShiftF4;st:#27'[26~'), {linux,rxvt}
  780. (char:0;scan:kbShiftF5;st:#27'[28~'), {linux,rxvt}
  781. (char:0;scan:kbShiftF6;st:#27'[29~'), {linux,rxvt}
  782. (char:0;scan:kbShiftF7;st:#27'[31~'), {linux,rxvt}
  783. (char:0;scan:kbShiftF8;st:#27'[32~'), {linux,rxvt}
  784. (char:0;scan:kbShiftF9;st:#27'[33~'), {linux,rxvt}
  785. (char:0;scan:kbShiftF10;st:#27'[34~'), {linux,rxvt}
  786. (char:0;scan:kbShiftF11;st:#27'[23$'), {rxvt}
  787. (char:0;scan:kbShiftF12;st:#27'[24$'), {rxvt}
  788. (char:0;scan:kbShiftF1;st:#27'[11;2~'), {konsole in vt420pc mode}
  789. (char:0;scan:kbShiftF2;st:#27'[12;2~'), {konsole in vt420pc mode}
  790. (char:0;scan:kbShiftF3;st:#27'[13;2~'), {konsole in vt420pc mode}
  791. (char:0;scan:kbShiftF4;st:#27'[14;2~'), {konsole in vt420pc mode}
  792. (char:0;scan:kbShiftF5;st:#27'[15;2~'), {xterm}
  793. (char:0;scan:kbShiftF6;st:#27'[17;2~'), {xterm}
  794. (char:0;scan:kbShiftF7;st:#27'[18;2~'), {xterm}
  795. (char:0;scan:kbShiftF8;st:#27'[19;2~'), {xterm}
  796. (char:0;scan:kbShiftF9;st:#27'[20;2~'), {xterm}
  797. (char:0;scan:kbShiftF10;st:#27'[21;2~'), {xterm}
  798. (char:0;scan:kbShiftF11;st:#27'[23;2~'), {xterm}
  799. (char:0;scan:kbShiftF12;st:#27'[24;2~'), {xterm}
  800. (char:0;scan:kbShiftF1;st:#27'O5P'), {xterm}
  801. (char:0;scan:kbShiftF2;st:#27'O5Q'), {xterm}
  802. (char:0;scan:kbShiftF3;st:#27'O5R'), {xterm}
  803. (char:0;scan:kbShiftF4;st:#27'O5S'), {xterm}
  804. (char:0;scan:kbShiftF1;st:#27'O2P'), {konsole,xterm}
  805. (char:0;scan:kbShiftF2;st:#27'O2Q'), {konsole,xterm}
  806. (char:0;scan:kbShiftF3;st:#27'O2R'), {konsole,xterm}
  807. (char:0;scan:kbShiftF4;st:#27'O2S'), {konsole,xterm}
  808. (char:0;scan:kbCtrlF1;st:#27'[11;5~'), {none, but expected}
  809. (char:0;scan:kbCtrlF2;st:#27'[12;5~'), {none, but expected}
  810. (char:0;scan:kbCtrlF3;st:#27'[13;5~'), {none, but expected}
  811. (char:0;scan:kbCtrlF4;st:#27'[14;5~'), {none, but expected}
  812. (char:0;scan:kbCtrlF5;st:#27'[15;5~'), {xterm}
  813. (char:0;scan:kbCtrlF6;st:#27'[17;5~'), {xterm}
  814. (char:0;scan:kbCtrlF7;st:#27'[18;5~'), {xterm}
  815. (char:0;scan:kbCtrlF8;st:#27'[19;5~'), {xterm}
  816. (char:0;scan:kbCtrlF9;st:#27'[20;5~'), {xterm}
  817. (char:0;scan:kbCtrlF10;st:#27'[21;5~'), {xterm}
  818. (char:0;scan:kbCtrlF11;st:#27'[23;5~'), {xterm}
  819. (char:0;scan:kbCtrlF12;st:#27'[24;5~'), {xterm}
  820. (char:0;scan:kbCtrlF1;st:#27'[11^'), {rxvt}
  821. (char:0;scan:kbCtrlF2;st:#27'[12^'), {rxvt}
  822. (char:0;scan:kbCtrlF3;st:#27'[13^'), {rxvt}
  823. (char:0;scan:kbCtrlF4;st:#27'[14^'), {rxvt}
  824. (char:0;scan:kbCtrlF5;st:#27'[15^'), {rxvt}
  825. (char:0;scan:kbCtrlF6;st:#27'[17^'), {rxvt}
  826. (char:0;scan:kbCtrlF7;st:#27'[18^'), {rxvt}
  827. (char:0;scan:kbCtrlF8;st:#27'[19^'), {rxvt}
  828. (char:0;scan:kbCtrlF9;st:#27'[20^'), {rxvt}
  829. (char:0;scan:kbCtrlF10;st:#27'[21^'), {rxvt}
  830. (char:0;scan:kbCtrlF11;st:#27'[23^'), {rxvt}
  831. (char:0;scan:kbCtrlF12;st:#27'[24^'), {rxvt}
  832. (char:0;scan:kbShiftIns;st:#27'[2;2~'), {should be the code, but shift+ins
  833. is paste X clipboard in many
  834. terminal emulators :(}
  835. (char:0;scan:kbShiftDel;st:#27'[3;2~'), {xterm,konsole}
  836. (char:0;scan:kbCtrlIns;st:#27'[2;5~'), {xterm}
  837. (char:0;scan:kbCtrlDel;st:#27'[3;5~'), {xterm}
  838. (char:0;scan:kbShiftDel;st:#27'[3$'), {rxvt}
  839. (char:0;scan:kbCtrlIns;st:#27'[2^'), {rxvt}
  840. (char:0;scan:kbCtrlDel;st:#27'[3^'), {rxvt}
  841. (char:0;scan:kbAltF1;st:#27#27'[[A'),
  842. (char:0;scan:kbAltF2;st:#27#27'[[B'),
  843. (char:0;scan:kbAltF3;st:#27#27'[[C'),
  844. (char:0;scan:kbAltF4;st:#27#27'[[D'),
  845. (char:0;scan:kbAltF5;st:#27#27'[[E'),
  846. (char:0;scan:kbAltF1;st:#27#27'[11~'), {rxvt}
  847. (char:0;scan:kbAltF2;st:#27#27'[12~'), {rxvt}
  848. (char:0;scan:kbAltF3;st:#27#27'[13~'), {rxvt}
  849. (char:0;scan:kbAltF4;st:#27#27'[14~'), {rxvt}
  850. (char:0;scan:kbAltF5;st:#27#27'[15~'), {rxvt}
  851. (char:0;scan:kbAltF6;st:#27#27'[17~'), {rxvt}
  852. (char:0;scan:kbAltF7;st:#27#27'[18~'), {rxvt}
  853. (char:0;scan:kbAltF8;st:#27#27'[19~'), {rxvt}
  854. (char:0;scan:kbAltF9;st:#27#27'[20~'), {rxvt}
  855. (char:0;scan:kbAltF10;st:#27#27'[21~'), {rxvt}
  856. (char:0;scan:kbAltF11;st:#27#27'[23~'), {rxvt}
  857. (char:0;scan:kbAltF12;st:#27#27'[24~'), {rxvt}
  858. (char:0;scan:kbAltF1;st:#27#27'OP'), {xterm}
  859. (char:0;scan:kbAltF2;st:#27#27'OQ'), {xterm}
  860. (char:0;scan:kbAltF3;st:#27#27'OR'), {xterm}
  861. (char:0;scan:kbAltF4;st:#27#27'OS'), {xterm}
  862. (char:0;scan:kbAltF5;st:#27#27'Ot'), {xterm}
  863. (char:0;scan:kbAltF6;st:#27#27'Ou'), {xterm}
  864. (char:0;scan:kbAltF7;st:#27#27'Ov'), {xterm}
  865. (char:0;scan:kbAltF8;st:#27#27'Ol'), {xterm}
  866. (char:0;scan:kbAltF9;st:#27#27'Ow'), {xterm}
  867. (char:0;scan:kbAltF10;st:#27#27'Ox'), {xterm}
  868. (char:0;scan:kbAltF11;st:#27#27'Oy'), {xterm}
  869. (char:0;scan:kbAltF12;st:#27#27'Oz'), {xterm}
  870. (char:0;scan:kbAltF1;st:#27'O3P'), {xterm on FreeBSD}
  871. (char:0;scan:kbAltF2;st:#27'O3Q'), {xterm on FreeBSD}
  872. (char:0;scan:kbAltF3;st:#27'O3R'), {xterm on FreeBSD}
  873. (char:0;scan:kbAltF4;st:#27'O3S'), {xterm on FreeBSD}
  874. (char:0;scan:kbAltF5;st:#27'[15;3~'), {xterm on FreeBSD}
  875. (char:0;scan:kbAltF6;st:#27'[17;3~'), {xterm on FreeBSD}
  876. (char:0;scan:kbAltF7;st:#27'[18;3~'), {xterm on FreeBSD}
  877. (char:0;scan:kbAltF8;st:#27'[19;3~'), {xterm on FreeBSD}
  878. (char:0;scan:kbAltF9;st:#27'[20;3~'), {xterm on FreeBSD}
  879. (char:0;scan:kbAltF10;st:#27'[21;3~'), {xterm on FreeBSD}
  880. (char:0;scan:kbAltF11;st:#27'[23;3~'), {xterm on FreeBSD}
  881. (char:0;scan:kbAltF12;st:#27'[24;3~'), {xterm on FreeBSD}
  882. (char:0;scan:kbShiftTab;st:#27'[Z'),
  883. (char:0;scan:kbShiftUp;st:#27'[1;2A'), {xterm}
  884. (char:0;scan:kbShiftDown;st:#27'[1;2B'), {xterm}
  885. (char:0;scan:kbShiftRight;st:#27'[1;2C'), {xterm}
  886. (char:0;scan:kbShiftLeft;st:#27'[1;2D'), {xterm}
  887. (char:0;scan:kbShiftUp;st:#27'[a'), {rxvt}
  888. (char:0;scan:kbShiftDown;st:#27'[b'), {rxvt}
  889. (char:0;scan:kbShiftRight;st:#27'[c'), {rxvt}
  890. (char:0;scan:kbShiftLeft;st:#27'[d'), {rxvt}
  891. (char:0;scan:kbShiftEnd;st:#27'[1;2F'), {xterm}
  892. (char:0;scan:kbShiftEnd;st:#27'[8$'), {rxvt}
  893. (char:0;scan:kbShiftHome;st:#27'[1;2H'), {xterm}
  894. (char:0;scan:kbShiftHome;st:#27'[7$'), {rxvt}
  895. (char:0;scan:kbCtrlUp;st:#27'[1;5A'), {xterm}
  896. (char:0;scan:kbCtrlDown;st:#27'[1;5B'), {xterm}
  897. (char:0;scan:kbCtrlRight;st:#27'[1;5C'), {xterm}
  898. (char:0;scan:kbCtrlLeft;st:#27'[1;5D'), {xterm}
  899. (char:0;scan:kbCtrlUp;st:#27'[Oa'), {rxvt}
  900. (char:0;scan:kbCtrlDown;st:#27'[Ob'), {rxvt}
  901. (char:0;scan:kbCtrlRight;st:#27'[Oc'), {rxvt}
  902. (char:0;scan:kbCtrlLeft;st:#27'[Od'), {rxvt}
  903. (char:0;scan:kbCtrlEnd;st:#27'[1;5F'), {xterm}
  904. (char:0;scan:kbCtrlEnd;st:#27'[8^'), {rxvt}
  905. (char:0;scan:kbCtrlHome;st:#27'[1;5H'), {xterm}
  906. (char:0;scan:kbCtrlHome;st:#27'[7^'), {rxvt}
  907. (char:0;scan:kbAltUp;st:#27#27'[A'), {rxvt}
  908. (char:0;scan:kbAltDown;st:#27#27'[B'), {rxvt}
  909. (char:0;scan:kbAltLeft;st:#27#27'[D'), {rxvt}
  910. (char:0;scan:kbAltRight;st:#27#27'[C'), {rxvt}
  911. (char:0;scan:kbAltUp;st:#27'OA'),
  912. (char:0;scan:kbAltDown;st:#27'OB'),
  913. (char:0;scan:kbAltRight;st:#27'OC'),
  914. (char:0;scan:kbAltLeft;st:#27#27'OD'),
  915. (char:0;scan:kbAltPgUp;st:#27#27'[5~'), {rxvt}
  916. (char:0;scan:kbAltPgDn;st:#27#27'[6~'), {rxvt}
  917. (char:0;scan:kbAltEnd;st:#27#27'[4~'),
  918. (char:0;scan:kbAltEnd;st:#27#27'[8~'), {rxvt}
  919. (char:0;scan:kbAltHome;st:#27#27'[1~'),
  920. (char:0;scan:kbAltHome;st:#27#27'[7~'), {rxvt}
  921. (char:0;scan:kbAltIns;st:#27#27'[2~'), {rxvt}
  922. (char:0;scan:kbAltDel;st:#27#27'[3~'), {rxvt}
  923. { xterm default values }
  924. { xterm alternate default values }
  925. { ignored sequences }
  926. (char:0;scan:0;st:#27'[?1;0c'),
  927. (char:0;scan:0;st:#27'[?1l'),
  928. (char:0;scan:0;st:#27'[?1h'),
  929. (char:0;scan:0;st:#27'[?1;2c'),
  930. (char:0;scan:0;st:#27'[?7l'),
  931. (char:0;scan:0;st:#27'[?7h')
  932. );
  933. procedure LoadDefaultSequences;
  934. var i:cardinal;
  935. begin
  936. AddSpecialSequence(#27'[M',@GenMouseEvent);
  937. {Unix backspace/delete hell... Is #127 a backspace or delete?}
  938. if copy(fpgetenv('TERM'),1,4)='cons' then
  939. begin
  940. {FreeBSD is until now only terminal that uses it for delete.}
  941. DoAddSequence(#127,0,kbDel); {Delete}
  942. DoAddSequence(#27#127,0,kbAltDel); {Alt+delete}
  943. end
  944. else
  945. begin
  946. DoAddSequence(#127,8,0); {Backspace}
  947. DoAddSequence(#27#127,0,kbAltBack); {Alt+backspace}
  948. end;
  949. { all Esc letter }
  950. for i:=low(key_sequences) to high(key_sequences) do
  951. with key_sequences[i] do
  952. DoAddSequence(st,char,scan);
  953. end;
  954. function RawReadKey:char;
  955. var
  956. fdsin : tfdSet;
  957. begin
  958. {Check Buffer first}
  959. if KeySend<>KeyPut then
  960. begin
  961. RawReadKey:=PopKey;
  962. exit;
  963. end;
  964. {Wait for Key}
  965. if not sysKeyPressed then
  966. begin
  967. fpFD_ZERO (fdsin);
  968. fpFD_SET (StdInputHandle,fdsin);
  969. fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
  970. end;
  971. RawReadKey:=ttyRecvChar;
  972. end;
  973. function RawReadString : String;
  974. var
  975. ch : char;
  976. fdsin : tfdSet;
  977. St : String;
  978. begin
  979. St:=RawReadKey;
  980. fpFD_ZERO (fdsin);
  981. fpFD_SET (StdInputHandle,fdsin);
  982. Repeat
  983. if inhead=intail then
  984. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  985. if SysKeyPressed then
  986. ch:=ttyRecvChar
  987. else
  988. ch:=#0;
  989. if ch<>#0 then
  990. St:=St+ch;
  991. Until ch=#0;
  992. RawReadString:=St;
  993. end;
  994. function ReadKey(var IsAlt : boolean):char;
  995. var
  996. ch : char;
  997. fdsin : tfdSet;
  998. store : array [0..8] of char;
  999. arrayind : byte;
  1000. NPT,NNPT : PTreeElement;
  1001. procedure GenMouseEvent;
  1002. var MouseEvent: TMouseEvent;
  1003. begin
  1004. Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
  1005. case ch of
  1006. #32 : {left button pressed }
  1007. MouseEvent.buttons:=1;
  1008. #33 : {middle button pressed }
  1009. MouseEvent.buttons:=2;
  1010. #34 : { right button pressed }
  1011. MouseEvent.buttons:=4;
  1012. #35 : { no button pressed };
  1013. end;
  1014. if inhead=intail then
  1015. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  1016. ch:=ttyRecvChar;
  1017. MouseEvent.x:=Ord(ch)-ord(' ')-1;
  1018. if inhead=intail then
  1019. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  1020. ch:=ttyRecvChar;
  1021. MouseEvent.y:=Ord(ch)-ord(' ')-1;
  1022. if (MouseEvent.buttons<>0) then
  1023. MouseEvent.action:=MouseActionDown
  1024. else
  1025. begin
  1026. if (LastMouseEvent.Buttons<>0) and
  1027. ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
  1028. begin
  1029. MouseEvent.Action:=MouseActionMove;
  1030. MouseEvent.Buttons:=LastMouseEvent.Buttons;
  1031. PutMouseEvent(MouseEvent);
  1032. MouseEvent.Buttons:=0;
  1033. end;
  1034. MouseEvent.Action:=MouseActionUp;
  1035. end;
  1036. PutMouseEvent(MouseEvent);
  1037. LastMouseEvent:=MouseEvent;
  1038. end;
  1039. procedure RestoreArray;
  1040. var
  1041. i : byte;
  1042. begin
  1043. for i:=0 to arrayind-1 do
  1044. PushKey(store[i]);
  1045. end;
  1046. begin
  1047. IsAlt:=false;
  1048. {Check Buffer first}
  1049. if KeySend<>KeyPut then
  1050. begin
  1051. ReadKey:=PopKey;
  1052. exit;
  1053. end;
  1054. {Wait for Key}
  1055. if not sysKeyPressed then
  1056. begin
  1057. fpFD_ZERO (fdsin);
  1058. fpFD_SET (StdInputHandle,fdsin);
  1059. fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
  1060. end;
  1061. ch:=ttyRecvChar;
  1062. NPT:=RootTree[ch];
  1063. if not assigned(NPT) then
  1064. PushKey(ch)
  1065. else
  1066. begin
  1067. fpFD_ZERO(fdsin);
  1068. fpFD_SET(StdInputHandle,fdsin);
  1069. store[0]:=ch;
  1070. arrayind:=1;
  1071. while assigned(NPT) and syskeypressed do
  1072. begin
  1073. if inhead=intail then
  1074. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  1075. ch:=ttyRecvChar;
  1076. if (ch=#27) and double_esc_hack_enabled then
  1077. begin
  1078. {This is the same hack as in findsequence; see findsequence for
  1079. explanation.}
  1080. ch:=ttyrecvchar;
  1081. {Alt+O cannot be used in this situation, it can be a function key.}
  1082. if not(ch in ['a'..'z','A'..'N','P'..'Z','0'..'9','-','+','_','=']) then
  1083. begin
  1084. if intail=0 then
  1085. intail:=insize
  1086. else
  1087. dec(intail);
  1088. inbuf[intail]:=ch;
  1089. ch:=#27;
  1090. end
  1091. else
  1092. begin
  1093. write(#27'[?1036l');
  1094. double_esc_hack_enabled:=false;
  1095. end;
  1096. end;
  1097. NNPT:=FindChild(ord(ch),NPT);
  1098. if assigned(NNPT) then
  1099. begin
  1100. NPT:=NNPT;
  1101. if NPT^.CanBeTerminal and
  1102. assigned(NPT^.SpecialHandler) then
  1103. break;
  1104. End;
  1105. if ch<>#0 then
  1106. begin
  1107. store[arrayind]:=ch;
  1108. inc(arrayind);
  1109. end;
  1110. if not assigned(NNPT) then
  1111. begin
  1112. if ch<>#0 then
  1113. begin
  1114. { Put that unused char back into InBuf }
  1115. If InTail=0 then
  1116. InTail:=InSize-1
  1117. else
  1118. Dec(InTail);
  1119. InBuf[InTail]:=ch;
  1120. end;
  1121. break;
  1122. end;
  1123. end;
  1124. if assigned(NPT) and NPT^.CanBeTerminal then
  1125. begin
  1126. if assigned(NPT^.SpecialHandler) then
  1127. begin
  1128. NPT^.SpecialHandler;
  1129. PushExt(0);
  1130. end
  1131. else if NPT^.CharValue<>0 then
  1132. PushKey(chr(NPT^.CharValue))
  1133. else if NPT^.ScanValue<>0 then
  1134. PushExt(NPT^.ScanValue);
  1135. end
  1136. else
  1137. RestoreArray;
  1138. end
  1139. {$ifdef logging}
  1140. writeln(f);
  1141. {$endif logging}
  1142. ;
  1143. ReadKey:=PopKey;
  1144. End;
  1145. {$ifdef linux}
  1146. function ShiftState:byte;
  1147. var arg:longint;
  1148. begin
  1149. shiftstate:=0;
  1150. arg:=6;
  1151. if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then
  1152. begin
  1153. if (arg and 8)<>0 then
  1154. shiftstate:=kbAlt;
  1155. if (arg and 4)<>0 then
  1156. inc(shiftstate,kbCtrl);
  1157. { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM }
  1158. if (arg and 2)<>0 then
  1159. shiftstate:=shiftstate or (kbAlt or kbCtrl);
  1160. if (arg and 1)<>0 then
  1161. inc(shiftstate,kbShift);
  1162. end;
  1163. end;
  1164. procedure force_linuxtty;
  1165. var s:string[15];
  1166. handle:sizeint;
  1167. thistty:string;
  1168. begin
  1169. is_console:=false;
  1170. if vcs_device<>-1 then
  1171. begin
  1172. { running on a tty, find out whether locally or remotely }
  1173. thistty:=ttyname(stdinputhandle);
  1174. if (copy(thistty,1,8)<>'/dev/tty') or not (thistty[9] in ['0'..'9']) then
  1175. begin
  1176. {Running from Midnight Commander or something... Bypass it.}
  1177. str(vcs_device,s);
  1178. handle:=fpopen('/dev/tty'+s,O_RDWR);
  1179. fpioctl(stdinputhandle,TIOCNOTTY,nil);
  1180. {This will currently only work when the user is root :(}
  1181. fpioctl(handle,TIOCSCTTY,nil);
  1182. if errno<>0 then
  1183. exit;
  1184. fpclose(stdinputhandle);
  1185. fpclose(stdoutputhandle);
  1186. fpclose(stderrorhandle);
  1187. fpdup2(handle,stdinputhandle);
  1188. fpdup2(handle,stdoutputhandle);
  1189. fpdup2(handle,stderrorhandle);
  1190. fpclose(handle);
  1191. end;
  1192. is_console:=true;
  1193. end;
  1194. end;
  1195. {$endif linux}
  1196. { Exported functions }
  1197. procedure SysInitKeyboard;
  1198. begin
  1199. SetRawMode(true);
  1200. {$ifdef logging}
  1201. assign(f,'keyboard.log');
  1202. rewrite(f);
  1203. {$endif logging}
  1204. {$ifdef linux}
  1205. force_linuxtty;
  1206. prepare_patching;
  1207. patchkeyboard;
  1208. if is_console then
  1209. install_vt_handler
  1210. else
  1211. begin
  1212. {$endif}
  1213. { default for Shift prefix is ^ A}
  1214. if ShiftPrefix = 0 then
  1215. ShiftPrefix:=1;
  1216. {default for Alt prefix is ^Z }
  1217. if AltPrefix=0 then
  1218. AltPrefix:=26;
  1219. { default for Ctrl Prefix is ^W }
  1220. if CtrlPrefix=0 then
  1221. CtrlPrefix:=23;
  1222. if copy(fpgetenv('TERM'),1,5)='xterm' then
  1223. {The alt key should generate an escape prefix. Save the old setting
  1224. make make it send that escape prefix.}
  1225. begin
  1226. write(#27'[?1036s'#27'[?1036h');
  1227. double_esc_hack_enabled:=true;
  1228. end;
  1229. {$ifdef linux}
  1230. end;
  1231. {$endif}
  1232. LoadDefaultSequences;
  1233. { LoadTerminfoSequences;}
  1234. end;
  1235. procedure SysDoneKeyboard;
  1236. begin
  1237. {$ifdef linux}
  1238. if is_console then
  1239. unpatchkeyboard;
  1240. {$endif linux}
  1241. if copy(fpgetenv('TERM'),1,5)='xterm' then
  1242. {Restore the old alt key behaviour.}
  1243. write(#27'[?1036r');
  1244. SetRawMode(false);
  1245. FreeTree;
  1246. {$ifdef logging}
  1247. close(f);
  1248. {$endif logging}
  1249. end;
  1250. function SysGetKeyEvent: TKeyEvent;
  1251. function EvalScan(b:byte):byte;
  1252. const
  1253. DScan:array[0..31] of byte = (
  1254. $39, $02, $28, $04, $05, $06, $08, $28,
  1255. $0A, $0B, $09, $0D, $33, $0C, $34, $35,
  1256. $0B, $02, $03, $04, $05, $06, $07, $08,
  1257. $09, $0A, $27, $27, $33, $0D, $34, $35);
  1258. LScan:array[0..31] of byte = (
  1259. $29, $1E, $30, $2E, $20, $12, $21, $22,
  1260. $23, $17, $24, $25, $26, $32, $31, $18,
  1261. $19, $10, $13, $1F, $14, $16, $2F, $11,
  1262. $2D, $15, $2C, $1A, $2B, $1B, $29, $0C);
  1263. begin
  1264. if (b and $E0)=$20 { digits / leters } then
  1265. EvalScan:=DScan[b and $1F]
  1266. else
  1267. case b of
  1268. $08:EvalScan:=$0E; { backspace }
  1269. $09:EvalScan:=$0F; { TAB }
  1270. $0D:EvalScan:=$1C; { CR }
  1271. $1B:EvalScan:=$01; { esc }
  1272. $40:EvalScan:=$03; { @ }
  1273. $5E:EvalScan:=$07; { ^ }
  1274. $60:EvalScan:=$29; { ` }
  1275. else
  1276. EvalScan:=LScan[b and $1F];
  1277. end;
  1278. end;
  1279. function EvalScanZ(b:byte):byte;
  1280. begin
  1281. EvalScanZ:=b;
  1282. if b in [$3B..$44] { F1..F10 -> Alt-F1..Alt-F10} then
  1283. EvalScanZ:=b+$2D;
  1284. end;
  1285. const
  1286. {kbHome, kbUp, kbPgUp,Missing, kbLeft,
  1287. kbCenter, kbRight, kbAltGrayPlus, kbend,
  1288. kbDown, kbPgDn, kbIns, kbDel }
  1289. CtrlArrow : array [kbHome..kbDel] of byte =
  1290. {($77,$8d,$84,$8e,$73,$8f,$74,$90,$75,$91,$76);}
  1291. (kbCtrlHome,kbCtrlUp,kbCtrlPgUp,kbNoKey,kbCtrlLeft,
  1292. kbCtrlCenter,kbCtrlRight,kbAltGrayPlus,kbCtrlEnd,
  1293. kbCtrlDown,kbCtrlPgDn,kbCtrlIns,kbCtrlDel);
  1294. AltArrow : array [kbHome..kbDel] of byte =
  1295. (kbAltHome,kbAltUp,kbAltPgUp,kbNoKey,kbAltLeft,
  1296. kbCenter,kbAltRight,kbAltGrayPlus,kbAltEnd,
  1297. kbAltDown,kbAltPgDn,kbAltIns,kbAltDel);
  1298. ShiftArrow : array [kbShiftUp..kbShiftEnd] of byte =
  1299. (kbUp,kbLeft,kbRight,kbDown,kbHome,kbEnd);
  1300. var
  1301. MyScan:byte;
  1302. MyChar : char;
  1303. EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,IsAlt,Again : boolean;
  1304. SState:byte;
  1305. begin {main}
  1306. MyChar:=Readkey(IsAlt);
  1307. MyScan:=ord(MyChar);
  1308. {$ifdef linux}
  1309. if is_console then
  1310. SState:=ShiftState
  1311. else
  1312. {$endif}
  1313. Sstate:=0;
  1314. CtrlPrefixUsed:=false;
  1315. AltPrefixUsed:=false;
  1316. ShiftPrefixUsed:=false;
  1317. EscUsed:=false;
  1318. if IsAlt then
  1319. SState:=SState or kbAlt;
  1320. repeat
  1321. again:=false;
  1322. if Mychar=#0 then
  1323. begin
  1324. MyScan:=ord(ReadKey(IsAlt));
  1325. if myscan=$01 then
  1326. mychar:=#27;
  1327. { Handle Ctrl-<x>, but not AltGr-<x> }
  1328. if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then
  1329. case MyScan of
  1330. kbHome..kbDel : { cArrow }
  1331. MyScan:=CtrlArrow[MyScan];
  1332. kbF1..KbF10 : { cF1-cF10 }
  1333. MyScan:=MyScan+kbCtrlF1-kbF1;
  1334. kbF11..KbF12 : { cF11-cF12 }
  1335. MyScan:=MyScan+kbCtrlF11-kbF11;
  1336. end
  1337. { Handle Alt-<x>, but not AltGr }
  1338. else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
  1339. case MyScan of
  1340. kbHome..kbDel : { AltArrow }
  1341. MyScan:=AltArrow[MyScan];
  1342. kbF1..KbF10 : { aF1-aF10 }
  1343. MyScan:=MyScan+kbAltF1-kbF1;
  1344. kbF11..KbF12 : { aF11-aF12 }
  1345. MyScan:=MyScan+kbAltF11-kbF11;
  1346. end
  1347. else if (SState and kbShift)<>0 then
  1348. case MyScan of
  1349. kbIns: MyScan:=kbShiftIns;
  1350. kbDel: MyScan:=kbShiftDel;
  1351. kbF1..KbF10 : { sF1-sF10 }
  1352. MyScan:=MyScan+kbShiftF1-kbF1;
  1353. kbF11..KbF12 : { sF11-sF12 }
  1354. MyScan:=MyScan+kbShiftF11-kbF11;
  1355. end;
  1356. if myscan in [kbShiftUp..kbShiftEnd] then
  1357. begin
  1358. myscan:=ShiftArrow[myscan];
  1359. sstate:=sstate or kbshift;
  1360. end;
  1361. if myscan=kbAltBack then
  1362. sstate:=sstate or kbalt;
  1363. if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
  1364. SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
  1365. else
  1366. SysGetKeyEvent:=0;
  1367. exit;
  1368. end
  1369. else if MyChar=#27 then
  1370. begin
  1371. if EscUsed then
  1372. SState:=SState and not kbAlt
  1373. else
  1374. begin
  1375. SState:=SState or kbAlt;
  1376. Again:=true;
  1377. EscUsed:=true;
  1378. end;
  1379. end
  1380. else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then
  1381. begin { ^Z - replace Alt for Linux OS }
  1382. if AltPrefixUsed then
  1383. begin
  1384. SState:=SState and not kbAlt;
  1385. end
  1386. else
  1387. begin
  1388. AltPrefixUsed:=true;
  1389. SState:=SState or kbAlt;
  1390. Again:=true;
  1391. end;
  1392. end
  1393. else if (CtrlPrefix<>0) and (MyChar=chr(CtrlPrefix)) then
  1394. begin
  1395. if CtrlPrefixUsed then
  1396. SState:=SState and not kbCtrl
  1397. else
  1398. begin
  1399. CtrlPrefixUsed:=true;
  1400. SState:=SState or kbCtrl;
  1401. Again:=true;
  1402. end;
  1403. end
  1404. else if (ShiftPrefix<>0) and (MyChar=chr(ShiftPrefix)) then
  1405. begin
  1406. if ShiftPrefixUsed then
  1407. SState:=SState and not kbShift
  1408. else
  1409. begin
  1410. ShiftPrefixUsed:=true;
  1411. SState:=SState or kbShift;
  1412. Again:=true;
  1413. end;
  1414. end;
  1415. if not again then
  1416. begin
  1417. MyScan:=EvalScan(ord(MyChar));
  1418. if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
  1419. begin
  1420. if MyScan in [$02..$0D] then
  1421. inc(MyScan,$76);
  1422. MyChar:=chr(0);
  1423. end
  1424. else if (SState and kbShift)<>0 then
  1425. if MyChar=#9 then
  1426. begin
  1427. MyChar:=#0;
  1428. MyScan:=kbShiftTab;
  1429. end;
  1430. end
  1431. else
  1432. begin
  1433. MyChar:=Readkey(IsAlt);
  1434. MyScan:=ord(MyChar);
  1435. if IsAlt then
  1436. SState:=SState or kbAlt;
  1437. end;
  1438. until not Again;
  1439. if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
  1440. SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
  1441. else
  1442. SysGetKeyEvent:=0;
  1443. end;
  1444. function SysPollKeyEvent: TKeyEvent;
  1445. var
  1446. KeyEvent : TKeyEvent;
  1447. begin
  1448. if keypressed then
  1449. begin
  1450. KeyEvent:=SysGetKeyEvent;
  1451. PutKeyEvent(KeyEvent);
  1452. SysPollKeyEvent:=KeyEvent
  1453. end
  1454. else
  1455. SysPollKeyEvent:=0;
  1456. end;
  1457. function SysGetShiftState : Byte;
  1458. begin
  1459. {$ifdef linux}
  1460. if is_console then
  1461. SysGetShiftState:=ShiftState
  1462. else
  1463. {$else}
  1464. SysGetShiftState:=0;
  1465. {$endif}
  1466. end;
  1467. procedure RestoreStartMode;
  1468. begin
  1469. TCSetAttr(1,TCSANOW,StartTio);
  1470. end;
  1471. const
  1472. SysKeyboardDriver : TKeyboardDriver = (
  1473. InitDriver : @SysInitKeyBoard;
  1474. DoneDriver : @SysDoneKeyBoard;
  1475. GetKeyevent : @SysGetKeyEvent;
  1476. PollKeyEvent : @SysPollKeyEvent;
  1477. GetShiftState : @SysGetShiftState;
  1478. TranslateKeyEvent : Nil;
  1479. TranslateKeyEventUnicode : Nil;
  1480. );
  1481. begin
  1482. SetKeyBoardDriver(SysKeyBoardDriver);
  1483. TCGetAttr(1,StartTio);
  1484. end.