keyboard.pp 44 KB

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