keyboard.pp 44 KB

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