keyboard.pp 46 KB

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