keyboard.pp 49 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628
  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..278] 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. (char:0;scan:kbShiftF1;st:#27'[23~'), {rxvt}
  789. (char:0;scan:kbShiftF2;st:#27'[24~'), {rxvt}
  790. (char:0;scan:kbShiftF3;st:#27'[25~'), {linux,rxvt}
  791. (char:0;scan:kbShiftF4;st:#27'[26~'), {linux,rxvt}
  792. (char:0;scan:kbShiftF5;st:#27'[28~'), {linux,rxvt}
  793. (char:0;scan:kbShiftF6;st:#27'[29~'), {linux,rxvt}
  794. (char:0;scan:kbShiftF7;st:#27'[31~'), {linux,rxvt}
  795. (char:0;scan:kbShiftF8;st:#27'[32~'), {linux,rxvt}
  796. (char:0;scan:kbShiftF9;st:#27'[33~'), {linux,rxvt}
  797. (char:0;scan:kbShiftF10;st:#27'[34~'), {linux,rxvt}
  798. (char:0;scan:kbShiftF11;st:#27'[23$'), {rxvt}
  799. (char:0;scan:kbShiftF12;st:#27'[24$'), {rxvt}
  800. (char:0;scan:kbShiftF1;st:#27'[11;2~'), {konsole in vt420pc mode}
  801. (char:0;scan:kbShiftF2;st:#27'[12;2~'), {konsole in vt420pc mode}
  802. (char:0;scan:kbShiftF3;st:#27'[13;2~'), {konsole in vt420pc mode}
  803. (char:0;scan:kbShiftF4;st:#27'[14;2~'), {konsole in vt420pc mode}
  804. (char:0;scan:kbShiftF5;st:#27'[15;2~'), {xterm}
  805. (char:0;scan:kbShiftF6;st:#27'[17;2~'), {xterm}
  806. (char:0;scan:kbShiftF7;st:#27'[18;2~'), {xterm}
  807. (char:0;scan:kbShiftF8;st:#27'[19;2~'), {xterm}
  808. (char:0;scan:kbShiftF9;st:#27'[20;2~'), {xterm}
  809. (char:0;scan:kbShiftF10;st:#27'[21;2~'), {xterm}
  810. (char:0;scan:kbShiftF11;st:#27'[23;2~'), {xterm}
  811. (char:0;scan:kbShiftF12;st:#27'[24;2~'), {xterm}
  812. (char:0;scan:kbShiftF1;st:#27'O5P'), {xterm}
  813. (char:0;scan:kbShiftF2;st:#27'O5Q'), {xterm}
  814. (char:0;scan:kbShiftF3;st:#27'O5R'), {xterm}
  815. (char:0;scan:kbShiftF4;st:#27'O5S'), {xterm}
  816. (char:0;scan:kbShiftF1;st:#27'O2P'), {konsole,xterm}
  817. (char:0;scan:kbShiftF2;st:#27'O2Q'), {konsole,xterm}
  818. (char:0;scan:kbShiftF3;st:#27'O2R'), {konsole,xterm}
  819. (char:0;scan:kbShiftF4;st:#27'O2S'), {konsole,xterm}
  820. (char:0;scan:kbCtrlF1;st:#27'[11;5~'), {none, but expected}
  821. (char:0;scan:kbCtrlF2;st:#27'[12;5~'), {none, but expected}
  822. (char:0;scan:kbCtrlF3;st:#27'[13;5~'), {none, but expected}
  823. (char:0;scan:kbCtrlF4;st:#27'[14;5~'), {none, but expected}
  824. (char:0;scan:kbCtrlF5;st:#27'[15;5~'), {xterm}
  825. (char:0;scan:kbCtrlF6;st:#27'[17;5~'), {xterm}
  826. (char:0;scan:kbCtrlF7;st:#27'[18;5~'), {xterm}
  827. (char:0;scan:kbCtrlF8;st:#27'[19;5~'), {xterm}
  828. (char:0;scan:kbCtrlF9;st:#27'[20;5~'), {xterm}
  829. (char:0;scan:kbCtrlF10;st:#27'[21;5~'), {xterm}
  830. (char:0;scan:kbCtrlF11;st:#27'[23;5~'), {xterm}
  831. (char:0;scan:kbCtrlF12;st:#27'[24;5~'), {xterm}
  832. (char:0;scan:kbCtrlF1;st:#27'[11^'), {rxvt}
  833. (char:0;scan:kbCtrlF2;st:#27'[12^'), {rxvt}
  834. (char:0;scan:kbCtrlF3;st:#27'[13^'), {rxvt}
  835. (char:0;scan:kbCtrlF4;st:#27'[14^'), {rxvt}
  836. (char:0;scan:kbCtrlF5;st:#27'[15^'), {rxvt}
  837. (char:0;scan:kbCtrlF6;st:#27'[17^'), {rxvt}
  838. (char:0;scan:kbCtrlF7;st:#27'[18^'), {rxvt}
  839. (char:0;scan:kbCtrlF8;st:#27'[19^'), {rxvt}
  840. (char:0;scan:kbCtrlF9;st:#27'[20^'), {rxvt}
  841. (char:0;scan:kbCtrlF10;st:#27'[21^'), {rxvt}
  842. (char:0;scan:kbCtrlF11;st:#27'[23^'), {rxvt}
  843. (char:0;scan:kbCtrlF12;st:#27'[24^'), {rxvt}
  844. (char:0;scan:kbShiftIns;st:#27'[2;2~'), {should be the code, but shift+ins
  845. is paste X clipboard in many
  846. terminal emulators :(}
  847. (char:0;scan:kbShiftDel;st:#27'[3;2~'), {xterm,konsole}
  848. (char:0;scan:kbCtrlIns;st:#27'[2;5~'), {xterm}
  849. (char:0;scan:kbCtrlDel;st:#27'[3;5~'), {xterm}
  850. (char:0;scan:kbShiftDel;st:#27'[3$'), {rxvt}
  851. (char:0;scan:kbCtrlIns;st:#27'[2^'), {rxvt}
  852. (char:0;scan:kbCtrlDel;st:#27'[3^'), {rxvt}
  853. (char:0;scan:kbAltF1;st:#27#27'[[A'),
  854. (char:0;scan:kbAltF2;st:#27#27'[[B'),
  855. (char:0;scan:kbAltF3;st:#27#27'[[C'),
  856. (char:0;scan:kbAltF4;st:#27#27'[[D'),
  857. (char:0;scan:kbAltF5;st:#27#27'[[E'),
  858. (char:0;scan:kbAltF1;st:#27#27'[11~'), {rxvt}
  859. (char:0;scan:kbAltF2;st:#27#27'[12~'), {rxvt}
  860. (char:0;scan:kbAltF3;st:#27#27'[13~'), {rxvt}
  861. (char:0;scan:kbAltF4;st:#27#27'[14~'), {rxvt}
  862. (char:0;scan:kbAltF5;st:#27#27'[15~'), {rxvt}
  863. (char:0;scan:kbAltF6;st:#27#27'[17~'), {rxvt}
  864. (char:0;scan:kbAltF7;st:#27#27'[18~'), {rxvt}
  865. (char:0;scan:kbAltF8;st:#27#27'[19~'), {rxvt}
  866. (char:0;scan:kbAltF9;st:#27#27'[20~'), {rxvt}
  867. (char:0;scan:kbAltF10;st:#27#27'[21~'), {rxvt}
  868. (char:0;scan:kbAltF11;st:#27#27'[23~'), {rxvt}
  869. (char:0;scan:kbAltF12;st:#27#27'[24~'), {rxvt}
  870. (char:0;scan:kbAltF1;st:#27#27'OP'), {xterm}
  871. (char:0;scan:kbAltF2;st:#27#27'OQ'), {xterm}
  872. (char:0;scan:kbAltF3;st:#27#27'OR'), {xterm}
  873. (char:0;scan:kbAltF4;st:#27#27'OS'), {xterm}
  874. (char:0;scan:kbAltF5;st:#27#27'Ot'), {xterm}
  875. (char:0;scan:kbAltF6;st:#27#27'Ou'), {xterm}
  876. (char:0;scan:kbAltF7;st:#27#27'Ov'), {xterm}
  877. (char:0;scan:kbAltF8;st:#27#27'Ol'), {xterm}
  878. (char:0;scan:kbAltF9;st:#27#27'Ow'), {xterm}
  879. (char:0;scan:kbAltF10;st:#27#27'Ox'), {xterm}
  880. (char:0;scan:kbAltF11;st:#27#27'Oy'), {xterm}
  881. (char:0;scan:kbAltF12;st:#27#27'Oz'), {xterm}
  882. (char:0;scan:kbAltF1;st:#27'O3P'), {xterm on FreeBSD}
  883. (char:0;scan:kbAltF2;st:#27'O3Q'), {xterm on FreeBSD}
  884. (char:0;scan:kbAltF3;st:#27'O3R'), {xterm on FreeBSD}
  885. (char:0;scan:kbAltF4;st:#27'O3S'), {xterm on FreeBSD}
  886. (char:0;scan:kbAltF5;st:#27'[15;3~'), {xterm on FreeBSD}
  887. (char:0;scan:kbAltF6;st:#27'[17;3~'), {xterm on FreeBSD}
  888. (char:0;scan:kbAltF7;st:#27'[18;3~'), {xterm on FreeBSD}
  889. (char:0;scan:kbAltF8;st:#27'[19;3~'), {xterm on FreeBSD}
  890. (char:0;scan:kbAltF9;st:#27'[20;3~'), {xterm on FreeBSD}
  891. (char:0;scan:kbAltF10;st:#27'[21;3~'), {xterm on FreeBSD}
  892. (char:0;scan:kbAltF11;st:#27'[23;3~'), {xterm on FreeBSD}
  893. (char:0;scan:kbAltF12;st:#27'[24;3~'), {xterm on FreeBSD}
  894. (char:0;scan:kbShiftTab;st:#27'[Z'),
  895. (char:0;scan:kbShiftUp;st:#27'[1;2A'), {xterm}
  896. (char:0;scan:kbShiftDown;st:#27'[1;2B'), {xterm}
  897. (char:0;scan:kbShiftRight;st:#27'[1;2C'), {xterm}
  898. (char:0;scan:kbShiftLeft;st:#27'[1;2D'), {xterm}
  899. (char:0;scan:kbShiftUp;st:#27'[a'), {rxvt}
  900. (char:0;scan:kbShiftDown;st:#27'[b'), {rxvt}
  901. (char:0;scan:kbShiftRight;st:#27'[c'), {rxvt}
  902. (char:0;scan:kbShiftLeft;st:#27'[d'), {rxvt}
  903. (char:0;scan:kbShiftEnd;st:#27'[1;2F'), {xterm}
  904. (char:0;scan:kbShiftEnd;st:#27'[8$'), {rxvt}
  905. (char:0;scan:kbShiftHome;st:#27'[1;2H'), {xterm}
  906. (char:0;scan:kbShiftHome;st:#27'[7$'), {rxvt}
  907. (char:0;scan:kbCtrlUp;st:#27'[1;5A'), {xterm}
  908. (char:0;scan:kbCtrlDown;st:#27'[1;5B'), {xterm}
  909. (char:0;scan:kbCtrlRight;st:#27'[1;5C'), {xterm}
  910. (char:0;scan:kbCtrlLeft;st:#27'[1;5D'), {xterm}
  911. (char:0;scan:kbCtrlUp;st:#27'[Oa'), {rxvt}
  912. (char:0;scan:kbCtrlDown;st:#27'[Ob'), {rxvt}
  913. (char:0;scan:kbCtrlRight;st:#27'[Oc'), {rxvt}
  914. (char:0;scan:kbCtrlLeft;st:#27'[Od'), {rxvt}
  915. (char:0;scan:kbCtrlEnd;st:#27'[1;5F'), {xterm}
  916. (char:0;scan:kbCtrlEnd;st:#27'[8^'), {rxvt}
  917. (char:0;scan:kbCtrlHome;st:#27'[1;5H'), {xterm}
  918. (char:0;scan:kbCtrlHome;st:#27'[7^'), {rxvt}
  919. (char:0;scan:kbAltUp;st:#27#27'[A'), {rxvt}
  920. (char:0;scan:kbAltDown;st:#27#27'[B'), {rxvt}
  921. (char:0;scan:kbAltLeft;st:#27#27'[D'), {rxvt}
  922. (char:0;scan:kbAltRight;st:#27#27'[C'), {rxvt}
  923. (char:0;scan:kbAltUp;st:#27'OA'),
  924. (char:0;scan:kbAltDown;st:#27'OB'),
  925. (char:0;scan:kbAltRight;st:#27'OC'),
  926. (char:0;scan:kbAltLeft;st:#27#27'OD'),
  927. (char:0;scan:kbAltPgUp;st:#27#27'[5~'), {rxvt}
  928. (char:0;scan:kbAltPgDn;st:#27#27'[6~'), {rxvt}
  929. (char:0;scan:kbAltEnd;st:#27#27'[4~'),
  930. (char:0;scan:kbAltEnd;st:#27#27'[8~'), {rxvt}
  931. (char:0;scan:kbAltHome;st:#27#27'[1~'),
  932. (char:0;scan:kbAltHome;st:#27#27'[7~'), {rxvt}
  933. (char:0;scan:kbAltIns;st:#27#27'[2~'), {rxvt}
  934. (char:0;scan:kbAltDel;st:#27#27'[3~'), {rxvt}
  935. { xterm default values }
  936. { xterm alternate default values }
  937. { ignored sequences }
  938. (char:0;scan:0;st:#27'[?1;0c'),
  939. (char:0;scan:0;st:#27'[?1l'),
  940. (char:0;scan:0;st:#27'[?1h'),
  941. (char:0;scan:0;st:#27'[?1;2c'),
  942. (char:0;scan:0;st:#27'[?7l'),
  943. (char:0;scan:0;st:#27'[?7h')
  944. );
  945. procedure LoadDefaultSequences;
  946. var i:cardinal;
  947. begin
  948. AddSpecialSequence(#27'[M',@GenMouseEvent);
  949. {Unix backspace/delete hell... Is #127 a backspace or delete?}
  950. if copy(fpgetenv('TERM'),1,4)='cons' then
  951. begin
  952. {FreeBSD is until now only terminal that uses it for delete.}
  953. DoAddSequence(#127,0,kbDel); {Delete}
  954. DoAddSequence(#27#127,0,kbAltDel); {Alt+delete}
  955. end
  956. else
  957. begin
  958. DoAddSequence(#127,8,0); {Backspace}
  959. DoAddSequence(#27#127,0,kbAltBack); {Alt+backspace}
  960. end;
  961. { all Esc letter }
  962. for i:=low(key_sequences) to high(key_sequences) do
  963. with key_sequences[i] do
  964. DoAddSequence(st,char,scan);
  965. end;
  966. function RawReadKey:char;
  967. var
  968. fdsin : tfdSet;
  969. begin
  970. {Check Buffer first}
  971. if KeySend<>KeyPut then
  972. begin
  973. RawReadKey:=PopKey;
  974. exit;
  975. end;
  976. {Wait for Key}
  977. if not sysKeyPressed then
  978. begin
  979. fpFD_ZERO (fdsin);
  980. fpFD_SET (StdInputHandle,fdsin);
  981. fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
  982. end;
  983. RawReadKey:=ttyRecvChar;
  984. end;
  985. function RawReadString : String;
  986. var
  987. ch : char;
  988. fdsin : tfdSet;
  989. St : String;
  990. begin
  991. St:=RawReadKey;
  992. fpFD_ZERO (fdsin);
  993. fpFD_SET (StdInputHandle,fdsin);
  994. Repeat
  995. if inhead=intail then
  996. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  997. if SysKeyPressed then
  998. ch:=ttyRecvChar
  999. else
  1000. ch:=#0;
  1001. if ch<>#0 then
  1002. St:=St+ch;
  1003. Until ch=#0;
  1004. RawReadString:=St;
  1005. end;
  1006. function ReadKey(var IsAlt : boolean):char;
  1007. var
  1008. ch : char;
  1009. fdsin : tfdSet;
  1010. store : array [0..8] of char;
  1011. arrayind : byte;
  1012. NPT,NNPT : PTreeElement;
  1013. procedure GenMouseEvent;
  1014. var MouseEvent: TMouseEvent;
  1015. begin
  1016. Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
  1017. case ch of
  1018. #32 : {left button pressed }
  1019. MouseEvent.buttons:=1;
  1020. #33 : {middle button pressed }
  1021. MouseEvent.buttons:=2;
  1022. #34 : { right button pressed }
  1023. MouseEvent.buttons:=4;
  1024. #35 : { no button pressed };
  1025. end;
  1026. if inhead=intail then
  1027. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  1028. ch:=ttyRecvChar;
  1029. MouseEvent.x:=Ord(ch)-ord(' ')-1;
  1030. if inhead=intail then
  1031. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  1032. ch:=ttyRecvChar;
  1033. MouseEvent.y:=Ord(ch)-ord(' ')-1;
  1034. if (MouseEvent.buttons<>0) then
  1035. MouseEvent.action:=MouseActionDown
  1036. else
  1037. begin
  1038. if (LastMouseEvent.Buttons<>0) and
  1039. ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
  1040. begin
  1041. MouseEvent.Action:=MouseActionMove;
  1042. MouseEvent.Buttons:=LastMouseEvent.Buttons;
  1043. PutMouseEvent(MouseEvent);
  1044. MouseEvent.Buttons:=0;
  1045. end;
  1046. MouseEvent.Action:=MouseActionUp;
  1047. end;
  1048. PutMouseEvent(MouseEvent);
  1049. LastMouseEvent:=MouseEvent;
  1050. end;
  1051. procedure RestoreArray;
  1052. var
  1053. i : byte;
  1054. begin
  1055. for i:=0 to arrayind-1 do
  1056. PushKey(store[i]);
  1057. end;
  1058. begin
  1059. IsAlt:=false;
  1060. {Check Buffer first}
  1061. if KeySend<>KeyPut then
  1062. begin
  1063. ReadKey:=PopKey;
  1064. exit;
  1065. end;
  1066. {Wait for Key}
  1067. if not sysKeyPressed then
  1068. begin
  1069. fpFD_ZERO (fdsin);
  1070. fpFD_SET (StdInputHandle,fdsin);
  1071. fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
  1072. end;
  1073. ch:=ttyRecvChar;
  1074. NPT:=RootTree[ch];
  1075. if not assigned(NPT) then
  1076. PushKey(ch)
  1077. else
  1078. begin
  1079. fpFD_ZERO(fdsin);
  1080. fpFD_SET(StdInputHandle,fdsin);
  1081. store[0]:=ch;
  1082. arrayind:=1;
  1083. while assigned(NPT) and syskeypressed do
  1084. begin
  1085. if inhead=intail then
  1086. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  1087. ch:=ttyRecvChar;
  1088. if (ch=#27) and double_esc_hack_enabled then
  1089. begin
  1090. {This is the same hack as in findsequence; see findsequence for
  1091. explanation.}
  1092. ch:=ttyrecvchar;
  1093. {Alt+O cannot be used in this situation, it can be a function key.}
  1094. if not(ch in ['a'..'z','A'..'N','P'..'Z','0'..'9','-','+','_','=']) then
  1095. begin
  1096. if intail=0 then
  1097. intail:=insize
  1098. else
  1099. dec(intail);
  1100. inbuf[intail]:=ch;
  1101. ch:=#27;
  1102. end
  1103. else
  1104. begin
  1105. write(#27'[?1036l');
  1106. double_esc_hack_enabled:=false;
  1107. end;
  1108. end;
  1109. NNPT:=FindChild(ord(ch),NPT);
  1110. if assigned(NNPT) then
  1111. begin
  1112. NPT:=NNPT;
  1113. if NPT^.CanBeTerminal and
  1114. assigned(NPT^.SpecialHandler) then
  1115. break;
  1116. End;
  1117. if ch<>#0 then
  1118. begin
  1119. store[arrayind]:=ch;
  1120. inc(arrayind);
  1121. end;
  1122. if not assigned(NNPT) then
  1123. begin
  1124. if ch<>#0 then
  1125. begin
  1126. { Put that unused char back into InBuf }
  1127. If InTail=0 then
  1128. InTail:=InSize-1
  1129. else
  1130. Dec(InTail);
  1131. InBuf[InTail]:=ch;
  1132. end;
  1133. break;
  1134. end;
  1135. end;
  1136. if assigned(NPT) and NPT^.CanBeTerminal then
  1137. begin
  1138. if assigned(NPT^.SpecialHandler) then
  1139. begin
  1140. NPT^.SpecialHandler;
  1141. PushExt(0);
  1142. end
  1143. else if NPT^.CharValue<>0 then
  1144. PushKey(chr(NPT^.CharValue))
  1145. else if NPT^.ScanValue<>0 then
  1146. PushExt(NPT^.ScanValue);
  1147. end
  1148. else
  1149. RestoreArray;
  1150. end
  1151. {$ifdef logging}
  1152. writeln(f);
  1153. {$endif logging}
  1154. ;
  1155. ReadKey:=PopKey;
  1156. End;
  1157. {$ifdef linux}
  1158. function ShiftState:byte;
  1159. var arg:longint;
  1160. begin
  1161. shiftstate:=0;
  1162. arg:=6;
  1163. if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then
  1164. begin
  1165. if (arg and 8)<>0 then
  1166. shiftstate:=kbAlt;
  1167. if (arg and 4)<>0 then
  1168. inc(shiftstate,kbCtrl);
  1169. { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM }
  1170. if (arg and 2)<>0 then
  1171. shiftstate:=shiftstate or (kbAlt or kbCtrl);
  1172. if (arg and 1)<>0 then
  1173. inc(shiftstate,kbShift);
  1174. end;
  1175. end;
  1176. procedure force_linuxtty;
  1177. var s:string[15];
  1178. handle:sizeint;
  1179. thistty:string;
  1180. begin
  1181. is_console:=false;
  1182. if vcs_device<>-1 then
  1183. begin
  1184. { running on a tty, find out whether locally or remotely }
  1185. thistty:=ttyname(stdinputhandle);
  1186. if (copy(thistty,1,8)<>'/dev/tty') or not (thistty[9] in ['0'..'9']) then
  1187. begin
  1188. {Running from Midnight Commander or something... Bypass it.}
  1189. str(vcs_device,s);
  1190. handle:=fpopen('/dev/tty'+s,O_RDWR);
  1191. fpioctl(stdinputhandle,TIOCNOTTY,nil);
  1192. {This will currently only work when the user is root :(}
  1193. fpioctl(handle,TIOCSCTTY,nil);
  1194. if errno<>0 then
  1195. exit;
  1196. fpclose(stdinputhandle);
  1197. fpclose(stdoutputhandle);
  1198. fpclose(stderrorhandle);
  1199. fpdup2(handle,stdinputhandle);
  1200. fpdup2(handle,stdoutputhandle);
  1201. fpdup2(handle,stderrorhandle);
  1202. fpclose(handle);
  1203. end;
  1204. is_console:=true;
  1205. end;
  1206. end;
  1207. {$endif linux}
  1208. { Exported functions }
  1209. procedure SysInitKeyboard;
  1210. begin
  1211. SetRawMode(true);
  1212. {$ifdef logging}
  1213. assign(f,'keyboard.log');
  1214. rewrite(f);
  1215. {$endif logging}
  1216. {$ifdef linux}
  1217. force_linuxtty;
  1218. prepare_patching;
  1219. patchkeyboard;
  1220. if is_console then
  1221. install_vt_handler
  1222. else
  1223. begin
  1224. {$endif}
  1225. { default for Shift prefix is ^ A}
  1226. if ShiftPrefix = 0 then
  1227. ShiftPrefix:=1;
  1228. {default for Alt prefix is ^Z }
  1229. if AltPrefix=0 then
  1230. AltPrefix:=26;
  1231. { default for Ctrl Prefix is ^W }
  1232. if CtrlPrefix=0 then
  1233. CtrlPrefix:=23;
  1234. if copy(fpgetenv('TERM'),1,5)='xterm' then
  1235. {The alt key should generate an escape prefix. Save the old setting
  1236. make make it send that escape prefix.}
  1237. begin
  1238. write(#27'[?1036s'#27'[?1036h');
  1239. double_esc_hack_enabled:=true;
  1240. end;
  1241. {$ifdef linux}
  1242. end;
  1243. {$endif}
  1244. LoadDefaultSequences;
  1245. { LoadTerminfoSequences;}
  1246. end;
  1247. procedure SysDoneKeyboard;
  1248. begin
  1249. {$ifdef linux}
  1250. if is_console then
  1251. unpatchkeyboard;
  1252. {$endif linux}
  1253. if copy(fpgetenv('TERM'),1,5)='xterm' then
  1254. {Restore the old alt key behaviour.}
  1255. write(#27'[?1036r');
  1256. SetRawMode(false);
  1257. FreeTree;
  1258. {$ifdef logging}
  1259. close(f);
  1260. {$endif logging}
  1261. end;
  1262. function SysGetKeyEvent: TKeyEvent;
  1263. function EvalScan(b:byte):byte;
  1264. const
  1265. DScan:array[0..31] of byte = (
  1266. $39, $02, $28, $04, $05, $06, $08, $28,
  1267. $0A, $0B, $09, $0D, $33, $0C, $34, $35,
  1268. $0B, $02, $03, $04, $05, $06, $07, $08,
  1269. $09, $0A, $27, $27, $33, $0D, $34, $35);
  1270. LScan:array[0..31] of byte = (
  1271. $29, $1E, $30, $2E, $20, $12, $21, $22,
  1272. $23, $17, $24, $25, $26, $32, $31, $18,
  1273. $19, $10, $13, $1F, $14, $16, $2F, $11,
  1274. $2D, $15, $2C, $1A, $2B, $1B, $29, $0C);
  1275. begin
  1276. if (b and $E0)=$20 { digits / leters } then
  1277. EvalScan:=DScan[b and $1F]
  1278. else
  1279. case b of
  1280. $08:EvalScan:=$0E; { backspace }
  1281. $09:EvalScan:=$0F; { TAB }
  1282. $0D:EvalScan:=$1C; { CR }
  1283. $1B:EvalScan:=$01; { esc }
  1284. $40:EvalScan:=$03; { @ }
  1285. $5E:EvalScan:=$07; { ^ }
  1286. $60:EvalScan:=$29; { ` }
  1287. else
  1288. EvalScan:=LScan[b and $1F];
  1289. end;
  1290. end;
  1291. function EvalScanZ(b:byte):byte;
  1292. begin
  1293. EvalScanZ:=b;
  1294. if b in [$3B..$44] { F1..F10 -> Alt-F1..Alt-F10} then
  1295. EvalScanZ:=b+$2D;
  1296. end;
  1297. const
  1298. {kbHome, kbUp, kbPgUp,Missing, kbLeft,
  1299. kbCenter, kbRight, kbAltGrayPlus, kbend,
  1300. kbDown, kbPgDn, kbIns, kbDel }
  1301. CtrlArrow : array [kbHome..kbDel] of byte =
  1302. {($77,$8d,$84,$8e,$73,$8f,$74,$90,$75,$91,$76);}
  1303. (kbCtrlHome,kbCtrlUp,kbCtrlPgUp,kbNoKey,kbCtrlLeft,
  1304. kbCtrlCenter,kbCtrlRight,kbAltGrayPlus,kbCtrlEnd,
  1305. kbCtrlDown,kbCtrlPgDn,kbCtrlIns,kbCtrlDel);
  1306. AltArrow : array [kbHome..kbDel] of byte =
  1307. (kbAltHome,kbAltUp,kbAltPgUp,kbNoKey,kbAltLeft,
  1308. kbCenter,kbAltRight,kbAltGrayPlus,kbAltEnd,
  1309. kbAltDown,kbAltPgDn,kbAltIns,kbAltDel);
  1310. ShiftArrow : array [kbShiftUp..kbShiftEnd] of byte =
  1311. (kbUp,kbLeft,kbRight,kbDown,kbHome,kbEnd);
  1312. var
  1313. MyScan:byte;
  1314. MyChar : char;
  1315. EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,IsAlt,Again : boolean;
  1316. SState:byte;
  1317. begin {main}
  1318. MyChar:=Readkey(IsAlt);
  1319. MyScan:=ord(MyChar);
  1320. {$ifdef linux}
  1321. if is_console then
  1322. SState:=ShiftState
  1323. else
  1324. {$endif}
  1325. Sstate:=0;
  1326. CtrlPrefixUsed:=false;
  1327. AltPrefixUsed:=false;
  1328. ShiftPrefixUsed:=false;
  1329. EscUsed:=false;
  1330. if IsAlt then
  1331. SState:=SState or kbAlt;
  1332. repeat
  1333. again:=false;
  1334. if Mychar=#0 then
  1335. begin
  1336. MyScan:=ord(ReadKey(IsAlt));
  1337. if myscan=$01 then
  1338. mychar:=#27;
  1339. { Handle Ctrl-<x>, but not AltGr-<x> }
  1340. if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then
  1341. case MyScan of
  1342. kbHome..kbDel : { cArrow }
  1343. MyScan:=CtrlArrow[MyScan];
  1344. kbF1..KbF10 : { cF1-cF10 }
  1345. MyScan:=MyScan+kbCtrlF1-kbF1;
  1346. kbF11..KbF12 : { cF11-cF12 }
  1347. MyScan:=MyScan+kbCtrlF11-kbF11;
  1348. end
  1349. { Handle Alt-<x>, but not AltGr }
  1350. else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
  1351. case MyScan of
  1352. kbHome..kbDel : { AltArrow }
  1353. MyScan:=AltArrow[MyScan];
  1354. kbF1..KbF10 : { aF1-aF10 }
  1355. MyScan:=MyScan+kbAltF1-kbF1;
  1356. kbF11..KbF12 : { aF11-aF12 }
  1357. MyScan:=MyScan+kbAltF11-kbF11;
  1358. end
  1359. else if (SState and kbShift)<>0 then
  1360. case MyScan of
  1361. kbIns: MyScan:=kbShiftIns;
  1362. kbDel: MyScan:=kbShiftDel;
  1363. kbF1..KbF10 : { sF1-sF10 }
  1364. MyScan:=MyScan+kbShiftF1-kbF1;
  1365. kbF11..KbF12 : { sF11-sF12 }
  1366. MyScan:=MyScan+kbShiftF11-kbF11;
  1367. end;
  1368. if myscan in [kbShiftUp..kbShiftEnd] then
  1369. begin
  1370. myscan:=ShiftArrow[myscan];
  1371. sstate:=sstate or kbshift;
  1372. end;
  1373. if myscan=kbAltBack then
  1374. sstate:=sstate or kbalt;
  1375. if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
  1376. SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
  1377. else
  1378. SysGetKeyEvent:=0;
  1379. exit;
  1380. end
  1381. else if MyChar=#27 then
  1382. begin
  1383. if EscUsed then
  1384. SState:=SState and not kbAlt
  1385. else
  1386. begin
  1387. SState:=SState or kbAlt;
  1388. Again:=true;
  1389. EscUsed:=true;
  1390. end;
  1391. end
  1392. else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then
  1393. begin { ^Z - replace Alt for Linux OS }
  1394. if AltPrefixUsed then
  1395. begin
  1396. SState:=SState and not kbAlt;
  1397. end
  1398. else
  1399. begin
  1400. AltPrefixUsed:=true;
  1401. SState:=SState or kbAlt;
  1402. Again:=true;
  1403. end;
  1404. end
  1405. else if (CtrlPrefix<>0) and (MyChar=chr(CtrlPrefix)) then
  1406. begin
  1407. if CtrlPrefixUsed then
  1408. SState:=SState and not kbCtrl
  1409. else
  1410. begin
  1411. CtrlPrefixUsed:=true;
  1412. SState:=SState or kbCtrl;
  1413. Again:=true;
  1414. end;
  1415. end
  1416. else if (ShiftPrefix<>0) and (MyChar=chr(ShiftPrefix)) then
  1417. begin
  1418. if ShiftPrefixUsed then
  1419. SState:=SState and not kbShift
  1420. else
  1421. begin
  1422. ShiftPrefixUsed:=true;
  1423. SState:=SState or kbShift;
  1424. Again:=true;
  1425. end;
  1426. end;
  1427. if not again then
  1428. begin
  1429. MyScan:=EvalScan(ord(MyChar));
  1430. if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
  1431. begin
  1432. if MyScan in [$02..$0D] then
  1433. inc(MyScan,$76);
  1434. MyChar:=chr(0);
  1435. end
  1436. else if (SState and kbShift)<>0 then
  1437. if MyChar=#9 then
  1438. begin
  1439. MyChar:=#0;
  1440. MyScan:=kbShiftTab;
  1441. end;
  1442. end
  1443. else
  1444. begin
  1445. MyChar:=Readkey(IsAlt);
  1446. MyScan:=ord(MyChar);
  1447. if IsAlt then
  1448. SState:=SState or kbAlt;
  1449. end;
  1450. until not Again;
  1451. if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
  1452. SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
  1453. else
  1454. SysGetKeyEvent:=0;
  1455. end;
  1456. function SysPollKeyEvent: TKeyEvent;
  1457. var
  1458. KeyEvent : TKeyEvent;
  1459. begin
  1460. if keypressed then
  1461. begin
  1462. KeyEvent:=SysGetKeyEvent;
  1463. PutKeyEvent(KeyEvent);
  1464. SysPollKeyEvent:=KeyEvent
  1465. end
  1466. else
  1467. SysPollKeyEvent:=0;
  1468. end;
  1469. function SysGetShiftState : Byte;
  1470. begin
  1471. {$ifdef linux}
  1472. if is_console then
  1473. SysGetShiftState:=ShiftState
  1474. else
  1475. {$else}
  1476. SysGetShiftState:=0;
  1477. {$endif}
  1478. end;
  1479. procedure RestoreStartMode;
  1480. begin
  1481. TCSetAttr(1,TCSANOW,StartTio);
  1482. end;
  1483. const
  1484. SysKeyboardDriver : TKeyboardDriver = (
  1485. InitDriver : @SysInitKeyBoard;
  1486. DoneDriver : @SysDoneKeyBoard;
  1487. GetKeyevent : @SysGetKeyEvent;
  1488. PollKeyEvent : @SysPollKeyEvent;
  1489. GetShiftState : @SysGetShiftState;
  1490. TranslateKeyEvent : Nil;
  1491. TranslateKeyEventUnicode : Nil;
  1492. );
  1493. begin
  1494. SetKeyBoardDriver(SysKeyBoardDriver);
  1495. TCGetAttr(1,StartTio);
  1496. end.