keyboard.pp 46 KB

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