keyboard.pp 41 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476
  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. {*****************************************************************************}
  14. interface
  15. {*****************************************************************************}
  16. {$i keybrdh.inc}
  17. const
  18. AltPrefix : byte = 0;
  19. ShiftPrefix : byte = 0;
  20. CtrlPrefix : byte = 0;
  21. function RawReadKey:char;
  22. function RawReadString : String;
  23. function KeyPressed : Boolean;
  24. procedure AddSequence(const St : String; AChar,AScan :byte);
  25. function FindSequence(const St : String;var AChar, Ascan : byte) : boolean;
  26. procedure RestoreStartMode;
  27. {*****************************************************************************}
  28. implementation
  29. {*****************************************************************************}
  30. uses
  31. Mouse, Strings,
  32. termio,baseUnix
  33. {$ifdef linux},linuxvcs{$endif};
  34. {$i keyboard.inc}
  35. var OldIO,StartTio : TermIos;
  36. {$ifdef linux}
  37. is_console:boolean;
  38. vt_switched_away:boolean;
  39. {$endif}
  40. {$ifdef logging}
  41. f : text;
  42. {$endif logging}
  43. const
  44. KeyBufferSize = 20;
  45. var
  46. KeyBuffer : Array[0..KeyBufferSize-1] of Char;
  47. KeyPut,
  48. KeySend : longint;
  49. { Buffered Input routines }
  50. const
  51. InSize=256;
  52. var
  53. InBuf : array [0..InSize-1] of char;
  54. { InCnt,}
  55. InHead,
  56. InTail : longint;
  57. {$i keyscan.inc}
  58. {Some internal only scancodes}
  59. const KbShiftUp = $f0;
  60. KbShiftLeft = $f1;
  61. KbShiftRight = $f2;
  62. KbShiftDown = $f3;
  63. KbShiftHome = $f4;
  64. KbShiftEnd = $f5;
  65. {$ifdef Unused}
  66. type
  67. TKeyState = Record
  68. Normal, Shift, Ctrl, Alt : word;
  69. end;
  70. const
  71. KeyStates : Array[0..255] of TKeyState
  72. (
  73. );
  74. {$endif Unused}
  75. procedure SetRawMode(b:boolean);
  76. var
  77. Tio : Termios;
  78. Begin
  79. TCGetAttr(1,Tio);
  80. if b then
  81. begin
  82. OldIO:=Tio;
  83. CFMakeRaw(Tio);
  84. end
  85. else
  86. Tio := OldIO;
  87. TCSetAttr(1,TCSANOW,Tio);
  88. End;
  89. {$ifdef linux}
  90. {The Linux console can do nice things: we can get the state of the shift keys,
  91. and reprogram the keys. That's nice since it allows excellent circumvention
  92. of VT100 limitations, we can make the keyboard work 100%...
  93. A 100% working keyboard seems to be a pretty basic requirement, but we're
  94. one of the few guys providing such an outrageous luxury (DM).}
  95. type
  96. chgentry=packed record
  97. tab,
  98. idx,
  99. oldtab,
  100. oldidx : byte;
  101. oldval,
  102. newval : word;
  103. end;
  104. kbentry=packed record
  105. kb_table,
  106. kb_index : byte;
  107. kb_value : word;
  108. end;
  109. kbsentry=packed record
  110. kb_func:byte;
  111. kb_string:array[0..511] of char;
  112. end;
  113. vt_mode=packed record
  114. mode, {vt mode}
  115. waitv:byte; {if set, hang on writes if not active}
  116. relsig, {signal to raise on release req}
  117. acqsig, {signal to raise on acquisition}
  118. frsig:word; {unused (set to 0)}
  119. end;
  120. const
  121. kbdchange:array[0..23] of chgentry=(
  122. {This prevents the alt+function keys from switching consoles.
  123. We code the F1..F12 sequences into ALT+F1..ALT+12, we check
  124. the shiftstates separetely anyway.}
  125. (tab:8; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0),
  126. (tab:8; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0),
  127. (tab:8; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0),
  128. (tab:8; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0),
  129. (tab:8; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0),
  130. (tab:8; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0),
  131. (tab:8; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0),
  132. (tab:8; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0),
  133. (tab:8; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0),
  134. (tab:8; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0),
  135. (tab:8; idx:$45; oldtab:0; oldidx:$45; oldval:0; newval:0),
  136. (tab:8; idx:$46; oldtab:0; oldidx:$46; oldval:0; newval:0),
  137. {This prevents the shift+function keys outputting strings, so
  138. the kernel will the codes for the non-shifted function
  139. keys. This is desired because normally shift+f1/f2 will output the
  140. same string as f11/12. We will get the shift state separately.}
  141. (tab:1; idx:$3b; oldtab:0; oldidx:$3b; oldval:0; newval:0),
  142. (tab:1; idx:$3c; oldtab:0; oldidx:$3c; oldval:0; newval:0),
  143. (tab:1; idx:$3d; oldtab:0; oldidx:$3d; oldval:0; newval:0),
  144. (tab:1; idx:$3e; oldtab:0; oldidx:$3e; oldval:0; newval:0),
  145. (tab:1; idx:$3f; oldtab:0; oldidx:$3f; oldval:0; newval:0),
  146. (tab:1; idx:$40; oldtab:0; oldidx:$40; oldval:0; newval:0),
  147. (tab:1; idx:$41; oldtab:0; oldidx:$41; oldval:0; newval:0),
  148. (tab:1; idx:$42; oldtab:0; oldidx:$42; oldval:0; newval:0),
  149. (tab:1; idx:$43; oldtab:0; oldidx:$43; oldval:0; newval:0),
  150. (tab:1; idx:$44; oldtab:0; oldidx:$44; oldval:0; newval:0),
  151. (tab:1; idx:$45; oldtab:0; oldidx:$45; oldval:0; newval:0),
  152. (tab:1; idx:$46; oldtab:0; oldidx:$46; oldval:0; newval:0)
  153. );
  154. KDGKBENT=$4B46;
  155. KDSKBENT=$4B47;
  156. KDGKBSENT=$4B48;
  157. KDSKBSENT=$4B49;
  158. KDGKBMETA=$4B62;
  159. KDSKBMETA=$4B63;
  160. K_ESCPREFIX=$4;
  161. K_METABIT=$3;
  162. VT_GETMODE=$5601;
  163. VT_SETMODE=$5602;
  164. VT_RELDISP=$5605;
  165. VT_PROCESS=1;
  166. const
  167. oldmeta : longint = 0;
  168. meta : longint = 0;
  169. var oldesc0,oldesc1,oldesc2,oldesc4,oldesc8:word;
  170. procedure prepare_patching;
  171. var e:^chgentry;
  172. entry : kbentry;
  173. i:longint;
  174. begin
  175. for i:=low(kbdchange) to high(kbdchange) do
  176. begin
  177. e:=@kbdchange[i];
  178. entry.kb_table:=e^.tab;
  179. entry.kb_index:=e^.idx;
  180. fpIoctl(stdinputhandle,KDGKBENT,@entry);
  181. e^.oldval:=entry.kb_value;
  182. entry.kb_table:=e^.oldtab;
  183. entry.kb_index:=e^.oldidx;
  184. fpioctl(stdinputhandle,KDGKBENT,@entry);
  185. e^.newval:=entry.kb_value;
  186. end;
  187. {Save old escape code.}
  188. entry.kb_index:=1;
  189. entry.kb_table:=0;
  190. fpioctl(stdinputhandle,KDGKBENT,@entry);
  191. oldesc0:=entry.kb_value;
  192. entry.kb_table:=1;
  193. fpioctl(stdinputhandle,KDGKBENT,@entry);
  194. oldesc1:=entry.kb_value;
  195. entry.kb_table:=2;
  196. fpioctl(stdinputhandle,KDGKBENT,@entry);
  197. oldesc2:=entry.kb_value;
  198. entry.kb_table:=4;
  199. fpioctl(stdinputhandle,KDGKBENT,@entry);
  200. oldesc4:=entry.kb_value;
  201. entry.kb_table:=8;
  202. fpioctl(stdinputhandle,KDGKBENT,@entry);
  203. oldesc8:=entry.kb_value;
  204. end;
  205. procedure PatchKeyboard;
  206. var
  207. e : ^chgentry;
  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. begin
  217. e:=@kbdchange[i];
  218. entry.kb_table:=e^.tab;
  219. entry.kb_index:=e^.idx;
  220. entry.kb_value:=e^.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. begin
  251. e:=@kbdchange[i];
  252. entry.kb_table:=e^.tab;
  253. entry.kb_index:=e^.idx;
  254. entry.kb_value:=e^.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. if inhead=intail then
  417. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  418. ch:=ttyRecvChar;
  419. { Other bits are used for Shift, Meta and Ctrl modifiers PM }
  420. case (ord(ch)-ord(' ')) and 3 of
  421. 0 : {left button press}
  422. MouseEvent.buttons:=1;
  423. 1 : {middle button pressed }
  424. MouseEvent.buttons:=2;
  425. 2 : { right button pressed }
  426. MouseEvent.buttons:=4;
  427. 3 : { no button pressed };
  428. end;
  429. if inhead=intail then
  430. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  431. ch:=ttyRecvChar;
  432. MouseEvent.x:=Ord(ch)-ord(' ')-1;
  433. if inhead=intail then
  434. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  435. ch:=ttyRecvChar;
  436. MouseEvent.y:=Ord(ch)-ord(' ')-1;
  437. if (MouseEvent.buttons<>0) then
  438. MouseEvent.action:=MouseActionDown
  439. else
  440. begin
  441. if (LastMouseEvent.Buttons<>0) and
  442. ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
  443. begin
  444. MouseEvent.Action:=MouseActionMove;
  445. MouseEvent.Buttons:=LastMouseEvent.Buttons;
  446. {$ifdef DebugMouse}
  447. Writeln(system.stderr,' Mouse Move (',MouseEvent.X,',',MouseEvent.Y,')');
  448. {$endif DebugMouse}
  449. PutMouseEvent(MouseEvent);
  450. MouseEvent.Buttons:=0;
  451. end;
  452. MouseEvent.Action:=MouseActionUp;
  453. end;
  454. PutMouseEvent(MouseEvent);
  455. {$ifdef DebugMouse}
  456. if MouseEvent.Action=MouseActionDown then
  457. Write(system.stderr,'Button down : ')
  458. else
  459. Write(system.stderr,'Button up : ');
  460. Writeln(system.stderr,'buttons = ',MouseEvent.Buttons,' (',MouseEvent.X,',',MouseEvent.Y,')');
  461. {$endif DebugMouse}
  462. LastMouseEvent:=MouseEvent;
  463. end;
  464. type
  465. Tprocedure = procedure;
  466. PTreeElement = ^TTreeElement;
  467. TTreeElement = record
  468. Next,Parent,Child : PTreeElement;
  469. CanBeTerminal : boolean;
  470. char : byte;
  471. ScanValue : byte;
  472. CharValue : byte;
  473. SpecialHandler : Tprocedure;
  474. end;
  475. var
  476. RootTree : Array[0..255] 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 : integer;
  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. var PT : PTreeElement;
  499. begin
  500. New(PT);
  501. FillChar(PT^,SizeOf(TTreeElement),#0);
  502. PT^.char:=ch;
  503. PT^.Parent:=Pa;
  504. if Assigned(Pa) and (Pa^.Child=nil) then
  505. Pa^.Child:=PT;
  506. NewPTree:=PT;
  507. end;
  508. function DoAddSequence(const St : String; AChar,AScan :byte) : PTreeElement;
  509. var
  510. CurPTree,NPT : PTreeElement;
  511. c : byte;
  512. i : longint;
  513. begin
  514. if St='' then
  515. begin
  516. DoAddSequence:=nil;
  517. exit;
  518. end;
  519. CurPTree:=RootTree[ord(st[1])];
  520. if CurPTree=nil then
  521. begin
  522. CurPTree:=NewPTree(ord(st[1]),nil);
  523. RootTree[ord(st[1])]:=CurPTree;
  524. end;
  525. for i:=2 to Length(St) do
  526. begin
  527. NPT:=CurPTree^.Child;
  528. c:=ord(St[i]);
  529. if NPT=nil then
  530. NPT:=NewPTree(c,CurPTree);
  531. CurPTree:=nil;
  532. while assigned(NPT) and (NPT^.char<c) do
  533. begin
  534. CurPTree:=NPT;
  535. NPT:=NPT^.Next;
  536. end;
  537. if assigned(NPT) and (NPT^.char=c) then
  538. CurPTree:=NPT
  539. else
  540. begin
  541. if CurPTree=nil then
  542. begin
  543. NPT^.Parent^.child:=NewPTree(c,NPT^.Parent);
  544. CurPTree:=NPT^.Parent^.Child;
  545. CurPTree^.Next:=NPT;
  546. end
  547. else
  548. begin
  549. CurPTree^.Next:=NewPTree(c,CurPTree^.Parent);
  550. CurPTree:=CurPTree^.Next;
  551. CurPTree^.Next:=NPT;
  552. end;
  553. end;
  554. end;
  555. if CurPTree^.CanBeTerminal then
  556. begin
  557. { here we have a conflict !! }
  558. { maybe we should claim }
  559. with CurPTree^ do
  560. begin
  561. {$ifdef DEBUG}
  562. if (ScanValue<>AScan) or (CharValue<>AChar) then
  563. Writeln(system.stderr,'key "',st,'" changed value');
  564. if (ScanValue<>AScan) then
  565. Writeln(system.stderr,'Scan was ',ScanValue,' now ',AScan);
  566. if (CharValue<>AChar) then
  567. Writeln(system.stderr,'Char was ',chr(CharValue),' now ',chr(AChar));
  568. {$endif DEBUG}
  569. ScanValue:=AScan;
  570. CharValue:=AChar;
  571. end;
  572. end
  573. else with CurPTree^ do
  574. begin
  575. CanBeTerminal:=True;
  576. ScanValue:=AScan;
  577. CharValue:=AChar;
  578. end;
  579. DoAddSequence:=CurPTree;
  580. end;
  581. procedure AddSequence(const St : String; AChar,AScan :byte);
  582. begin
  583. DoAddSequence(St,AChar,AScan);
  584. end;
  585. { Returns the Child that as c as char if it exists }
  586. function FindChild(c : byte;Root : PTreeElement) : PTreeElement;
  587. var
  588. NPT : PTreeElement;
  589. begin
  590. if not assigned(Root) then
  591. begin
  592. FindChild:=nil;
  593. exit;
  594. end;
  595. NPT:=Root^.Child;
  596. while assigned(NPT) and (NPT^.char<c) do
  597. NPT:=NPT^.Next;
  598. if assigned(NPT) and (NPT^.char=c) then
  599. FindChild:=NPT
  600. else
  601. FindChild:=nil;
  602. end;
  603. function AddSpecialSequence(const St : string;Proc : Tprocedure) : PTreeElement;
  604. var
  605. NPT : PTreeElement;
  606. begin
  607. NPT:=DoAddSequence(St,0,0);
  608. NPT^.SpecialHandler:=Proc;
  609. AddSpecialSequence:=NPT;
  610. end;
  611. function FindSequence(const St : String;var AChar,AScan :byte) : boolean;
  612. var
  613. NPT : PTreeElement;
  614. I : longint;
  615. begin
  616. FindSequence:=false;
  617. AChar:=0;
  618. AScan:=0;
  619. if St='' then
  620. exit;
  621. NPT:=RootTree[ord(St[1])];
  622. if not assigned(NPT) then
  623. exit;
  624. for i:=2 to Length(St) do
  625. begin
  626. NPT:=FindChild(ord(St[i]),NPT);
  627. if not assigned(NPT) then
  628. exit;
  629. end;
  630. if not NPT^.CanBeTerminal then
  631. exit
  632. else
  633. begin
  634. FindSequence:=true;
  635. AScan:=NPT^.ScanValue;
  636. AChar:=NPT^.CharValue;
  637. end;
  638. end;
  639. procedure LoadDefaultSequences;
  640. begin
  641. AddSpecialSequence(#27'[M',@GenMouseEvent);
  642. { linux default values, the next setting is
  643. compatible with xterms from XFree 4.x }
  644. DoAddSequence(#127,8,0);
  645. { all Esc letter }
  646. DoAddSequence(#27'A',0,kbAltA);
  647. DoAddSequence(#27'a',0,kbAltA);
  648. DoAddSequence(#27'B',0,kbAltB);
  649. DoAddSequence(#27'b',0,kbAltB);
  650. DoAddSequence(#27'C',0,kbAltC);
  651. DoAddSequence(#27'c',0,kbAltC);
  652. DoAddSequence(#27'D',0,kbAltD);
  653. DoAddSequence(#27'd',0,kbAltD);
  654. DoAddSequence(#27'E',0,kbAltE);
  655. DoAddSequence(#27'e',0,kbAltE);
  656. DoAddSequence(#27'F',0,kbAltF);
  657. DoAddSequence(#27'f',0,kbAltF);
  658. DoAddSequence(#27'G',0,kbAltG);
  659. DoAddSequence(#27'g',0,kbAltG);
  660. DoAddSequence(#27'H',0,kbAltH);
  661. DoAddSequence(#27'h',0,kbAltH);
  662. DoAddSequence(#27'I',0,kbAltI);
  663. DoAddSequence(#27'i',0,kbAltI);
  664. DoAddSequence(#27'J',0,kbAltJ);
  665. DoAddSequence(#27'j',0,kbAltJ);
  666. DoAddSequence(#27'K',0,kbAltK);
  667. DoAddSequence(#27'k',0,kbAltK);
  668. DoAddSequence(#27'L',0,kbAltL);
  669. DoAddSequence(#27'l',0,kbAltL);
  670. DoAddSequence(#27'M',0,kbAltM);
  671. DoAddSequence(#27'm',0,kbAltM);
  672. DoAddSequence(#27'N',0,kbAltN);
  673. DoAddSequence(#27'n',0,kbAltN);
  674. DoAddSequence(#27'O',0,kbAltO);
  675. DoAddSequence(#27'o',0,kbAltO);
  676. DoAddSequence(#27'P',0,kbAltP);
  677. DoAddSequence(#27'p',0,kbAltP);
  678. DoAddSequence(#27'Q',0,kbAltQ);
  679. DoAddSequence(#27'q',0,kbAltQ);
  680. DoAddSequence(#27'R',0,kbAltR);
  681. DoAddSequence(#27'r',0,kbAltR);
  682. DoAddSequence(#27'S',0,kbAltS);
  683. DoAddSequence(#27's',0,kbAltS);
  684. DoAddSequence(#27'T',0,kbAltT);
  685. DoAddSequence(#27't',0,kbAltT);
  686. DoAddSequence(#27'U',0,kbAltU);
  687. DoAddSequence(#27'u',0,kbAltU);
  688. DoAddSequence(#27'V',0,kbAltV);
  689. DoAddSequence(#27'v',0,kbAltV);
  690. DoAddSequence(#27'W',0,kbAltW);
  691. DoAddSequence(#27'w',0,kbAltW);
  692. DoAddSequence(#27'X',0,kbAltX);
  693. DoAddSequence(#27'x',0,kbAltX);
  694. DoAddSequence(#27'Y',0,kbAltY);
  695. DoAddSequence(#27'y',0,kbAltY);
  696. DoAddSequence(#27'Z',0,kbAltZ);
  697. DoAddSequence(#27'z',0,kbAltZ);
  698. DoAddSequence(#27'-',0,kbAltMinus);
  699. DoAddSequence(#27'=',0,kbAltEqual);
  700. DoAddSequence(#27'0',0,kbAlt0);
  701. DoAddSequence(#27'1',0,kbAlt1);
  702. DoAddSequence(#27'2',0,kbAlt2);
  703. DoAddSequence(#27'3',0,kbAlt3);
  704. DoAddSequence(#27'4',0,kbAlt4);
  705. DoAddSequence(#27'5',0,kbAlt5);
  706. DoAddSequence(#27'6',0,kbAlt6);
  707. DoAddSequence(#27'7',0,kbAlt7);
  708. DoAddSequence(#27'8',0,kbAlt8);
  709. DoAddSequence(#27'9',0,kbAlt9);
  710. DoAddSequence(#27'[[A',0,kbF1); {linux,konsole,xterm}
  711. DoAddSequence(#27'[[B',0,kbF2); {linux,konsole,xterm}
  712. DoAddSequence(#27'[[C',0,kbF3); {linux,konsole,xterm}
  713. DoAddSequence(#27'[[D',0,kbF4); {linux,konsole,xterm}
  714. DoAddSequence(#27'[[E',0,kbF5); {linux,konsole}
  715. DoAddSequence(#27'[0~',0,kbEsc); {if linux keyboard patched, escape
  716. returns this}
  717. DoAddSequence(#27'[1~',0,kbHome); {linux}
  718. DoAddSequence(#27'[2~',0,kbIns); {linux,Eterm}
  719. DoAddSequence(#27'[3~',0,kbDel); {linux,Eterm}
  720. DoAddSequence(#27'[4~',0,kbEnd); {linux,Eterm}
  721. DoAddSequence(#27'[5~',0,kbPgUp); {linux,Eterm}
  722. DoAddSequence(#27'[6~',0,kbPgDn); {linux,Eterm}
  723. DoAddSequence(#27'[7~',0,kbHome); {Eterm}
  724. DoAddSequence(#27'[11~',0,kbF1); {Eterm}
  725. DoAddSequence(#27'[12~',0,kbF2); {Eterm}
  726. DoAddSequence(#27'[13~',0,kbF3); {Eterm}
  727. DoAddSequence(#27'[14~',0,kbF4); {Eterm}
  728. DoAddSequence(#27'[15~',0,kbF5); {xterm,Eterm,gnome}
  729. DoAddSequence(#27'[17~',0,kbF6); {linux,xterm,Eterm,konsole,gnome}
  730. DoAddSequence(#27'[18~',0,kbF7); {linux,xterm,Eterm,konsole,gnome}
  731. DoAddSequence(#27'[19~',0,kbF8); {linux,xterm,Eterm,konsole,gnome}
  732. DoAddSequence(#27'[20~',0,kbF9); {linux,xterm,Eterm,konsole,gnome}
  733. DoAddSequence(#27'[21~',0,kbF10); {linux,xterm,Eterm,konsole,gnome}
  734. DoAddSequence(#27'[23~',0,kbF11); {linux,xterm,Eterm,konsole,gnome}
  735. DoAddSequence(#27'[24~',0,kbF12); {linux,xterm,Eterm,konsole,gnome}
  736. DoAddSequence(#27'[25~',0,kbShiftF3); {linux}
  737. DoAddSequence(#27'[26~',0,kbShiftF4); {linux}
  738. DoAddSequence(#27'[28~',0,kbShiftF5); {linux}
  739. DoAddSequence(#27'[29~',0,kbShiftF6); {linux}
  740. DoAddSequence(#27'[31~',0,kbShiftF7); {linux}
  741. DoAddSequence(#27'[32~',0,kbShiftF8); {linux}
  742. DoAddSequence(#27'[33~',0,kbShiftF9); {linux}
  743. DoAddSequence(#27'[34~',0,kbShiftF10); {linux}
  744. DoAddSequence(#27'[2;2~',0,kbShiftIns); {should be the code, but shift+ins
  745. is paste X clipboard in many
  746. terminal emulators :(}
  747. DoAddSequence(#27'[3;2~',0,kbShiftDel); {xterm,konsole}
  748. DoAddSequence(#27'[11;2~',0,kbShiftF1); {konsole in vt420pc mode}
  749. DoAddSequence(#27'[12;2~',0,kbShiftF2); {konsole in vt420pc mode}
  750. DoAddSequence(#27'[13;2~',0,kbShiftF3); {konsole in vt420pc mode}
  751. DoAddSequence(#27'[14;2~',0,kbShiftF4); {konsole in vt420pc mode}
  752. DoAddSequence(#27'[15;2~',0,kbShiftF5); {xterm}
  753. DoAddSequence(#27'[17;2~',0,kbShiftF6); {xterm}
  754. DoAddSequence(#27'[18;2~',0,kbShiftF7); {xterm}
  755. DoAddSequence(#27'[19;2~',0,kbShiftF8); {xterm}
  756. DoAddSequence(#27'[20;2~',0,kbShiftF9); {xterm}
  757. DoAddSequence(#27'[21;2~',0,kbShiftF10); {xterm}
  758. DoAddSequence(#27'[23;2~',0,kbShiftF11); {xterm}
  759. DoAddSequence(#27'[24;2~',0,kbShiftF12); {xterm}
  760. DoAddSequence(#27'[2;5~',0,kbCtrlIns); {xterm}
  761. DoAddSequence(#27'[3;5~',0,kbCtrlDel); {xterm}
  762. DoAddSequence(#27#27'[[A',0,kbAltF1);
  763. DoAddSequence(#27#27'[[B',0,kbAltF2);
  764. DoAddSequence(#27#27'[[C',0,kbAltF3);
  765. DoAddSequence(#27#27'[[D',0,kbAltF4);
  766. DoAddSequence(#27#27'[[E',0,kbAltF5);
  767. DoAddSequence(#27#27'[17~',0,kbAltF6);
  768. DoAddSequence(#27#27'[18~',0,kbAltF7);
  769. DoAddSequence(#27#27'[19~',0,kbAltF8);
  770. DoAddSequence(#27#27'[20~',0,kbAltF9);
  771. DoAddSequence(#27#27'[21~',0,kbAltF10);
  772. DoAddSequence(#27#27'[23~',0,kbAltF11);
  773. DoAddSequence(#27#27'[24~',0,kbAltF12);
  774. DoAddSequence(#27'[A',0,kbUp); {linux,FreeBSD}
  775. DoAddSequence(#27'[B',0,kbDown); {linux,FreeBSD}
  776. DoAddSequence(#27'[C',0,kbRight); {linux,FreeBSD}
  777. DoAddSequence(#27'[D',0,kbLeft); {linux,FreeBSD}
  778. DoAddSequence(#27'[F',0,kbEnd); {FreeBSD}
  779. DoAddSequence(#27'[G',0,kbPgUp); {FreeBSD}
  780. DoAddSequence(#27'[H',0,kbHome); {FreeBSD}
  781. DoAddSequence(#27'[H',0,kbPgdn); {FreeBSD}
  782. DoAddSequence(#27'[M',0,kbF1); {FreeBSD}
  783. DoAddSequence(#27'[N',0,kbF2); {FreeBSD}
  784. DoAddSequence(#27'[O',0,kbF3); {FreeBSD}
  785. DoAddSequence(#27'[P',0,kbF4); {FreeBSD}
  786. DoAddSequence(#27'[Q',0,kbF5); {FreeBSD}
  787. DoAddSequence(#27'[R',0,kbF6); {FreeBSD}
  788. DoAddSequence(#27'[S',0,kbF7); {FreeBSD}
  789. DoAddSequence(#27'[T',0,kbF8); {FreeBSD}
  790. DoAddSequence(#27'[U',0,kbF9); {FreeBSD}
  791. DoAddSequence(#27'[V',0,kbF10); {FreeBSD}
  792. DoAddSequence(#27'[W',0,kbF11); {FreeBSD}
  793. DoAddSequence(#27'[X',0,kbF12); {FreeBSD}
  794. DoAddSequence(#27'[Z',0,kbShiftTab);
  795. DoAddSequence(#27'[1;2A',0,kbShiftUp); {xterm}
  796. DoAddSequence(#27'[1;2B',0,kbShiftDown); {xterm}
  797. DoAddSequence(#27'[1;2C',0,kbShiftRight); {xterm}
  798. DoAddSequence(#27'[1;2D',0,kbShiftLeft); {xterm}
  799. DoAddSequence(#27'[1;2F',0,kbShiftEnd); {xterm}
  800. DoAddSequence(#27'[1;2H',0,kbShiftHome); {xterm}
  801. DoAddSequence(#27'[1;5A',0,kbCtrlUp); {xterm}
  802. DoAddSequence(#27'[1;5B',0,kbCtrlDown); {xterm}
  803. DoAddSequence(#27'[1;5C',0,kbCtrlRight); {xterm}
  804. DoAddSequence(#27'[1;5D',0,kbCtrlLeft); {xterm}
  805. DoAddSequence(#27'[1;5F',0,kbCtrlEnd); {xterm}
  806. DoAddSequence(#27'[1;5H',0,kbCtrlHome); {xterm}
  807. DoAddSequence(#27#27'[A',0,kbAltUp);
  808. DoAddSequence(#27#27'[B',0,kbAltDown);
  809. DoAddSequence(#27#27'[D',0,kbAltLeft);
  810. DoAddSequence(#27#27'[C',0,kbAltRight);
  811. DoAddSequence(#27#27'[5~',0,kbAltPgUp);
  812. DoAddSequence(#27#27'[6~',0,kbAltPgDn);
  813. DoAddSequence(#27#27'[4~',0,kbAltEnd);
  814. DoAddSequence(#27#27'[1~',0,kbAltHome);
  815. DoAddSequence(#27#27'[2~',0,kbAltIns);
  816. DoAddSequence(#27#27'[3~',0,kbAltDel);
  817. DoAddSequence(#27'OA',0,kbUp); {xterm}
  818. DoAddSequence(#27'OB',0,kbDown); {xterm}
  819. DoAddSequence(#27'OC',0,kbRight); {xterm}
  820. DoAddSequence(#27'OD',0,kbLeft); {xterm}
  821. DoAddSequence(#27'OF',0,kbHome); {some xterm configurations}
  822. DoAddSequence(#27'OH',0,kbEnd); {some xterm configurations}
  823. DoAddSequence(#27'OP',0,kbF1); {vt100,gnome,konsole}
  824. DoAddSequence(#27'OQ',0,kbF2); {vt100,gnome,konsole}
  825. DoAddSequence(#27'OR',0,kbF3); {vt100,gnome,konsole}
  826. DoAddSequence(#27'OS',0,kbF4); {vt100,gnome,konsole}
  827. DoAddSequence(#27'Ot',0,kbF5); {vt100}
  828. DoAddSequence(#27'Ou',0,kbF6); {vt100}
  829. DoAddSequence(#27'Ov',0,kbF7); {vt100}
  830. DoAddSequence(#27'Ol',0,kbF8); {vt100}
  831. DoAddSequence(#27'Ow',0,kbF9); {vt100}
  832. DoAddSequence(#27'Ox',0,kbF10); {vt100}
  833. DoAddSequence(#27'Oy',0,kbF11); {vt100}
  834. DoAddSequence(#27'Oz',0,kbF12); {vt100}
  835. DoAddSequence(#27'O2P',0,kbShiftF1); {konsole,xterm}
  836. DoAddSequence(#27'O2Q',0,kbShiftF2); {konsole,xterm}
  837. DoAddSequence(#27'O2R',0,kbShiftF3); {konsole,xterm}
  838. DoAddSequence(#27'O2S',0,kbShiftF4); {konsole,xterm}
  839. DoAddSequence(#27#27'OP',0,kbAltF1);
  840. DoAddSequence(#27#27'OQ',0,kbAltF2);
  841. DoAddSequence(#27#27'OR',0,kbAltF3);
  842. DoAddSequence(#27#27'OS',0,kbAltF4);
  843. DoAddSequence(#27#27'Ot',0,kbAltF5);
  844. DoAddSequence(#27#27'Ou',0,kbAltF6);
  845. DoAddSequence(#27#27'Ov',0,kbAltF7);
  846. DoAddSequence(#27#27'Ol',0,kbAltF8);
  847. DoAddSequence(#27#27'Ow',0,kbAltF9);
  848. DoAddSequence(#27#27'Ox',0,kbAltF10);
  849. DoAddSequence(#27#27'Oy',0,kbAltF11);
  850. DoAddSequence(#27#27'Oz',0,kbAltF12);
  851. DoAddSequence(#27#27'OA',0,kbAltUp);
  852. DoAddSequence(#27#27'OB',0,kbAltDown);
  853. DoAddSequence(#27#27'OC',0,kbAltRight);
  854. DoAddSequence(#27#27'OD',0,kbAltLeft);
  855. { xterm default values }
  856. { xterm alternate default values }
  857. { ignored sequences }
  858. DoAddSequence(#27'[?1;0c',0,0);
  859. DoAddSequence(#27'[?1l',0,0);
  860. DoAddSequence(#27'[?1h',0,0);
  861. DoAddSequence(#27'[?1;2c',0,0);
  862. DoAddSequence(#27'[?7l',0,0);
  863. DoAddSequence(#27'[?7h',0,0);
  864. end;
  865. function RawReadKey:char;
  866. var
  867. fdsin : tfdSet;
  868. begin
  869. {Check Buffer first}
  870. if KeySend<>KeyPut then
  871. begin
  872. RawReadKey:=PopKey;
  873. exit;
  874. end;
  875. {Wait for Key}
  876. if not sysKeyPressed then
  877. begin
  878. fpFD_ZERO (fdsin);
  879. fpFD_SET (StdInputHandle,fdsin);
  880. fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
  881. end;
  882. RawReadKey:=ttyRecvChar;
  883. end;
  884. function RawReadString : String;
  885. var
  886. ch : char;
  887. fdsin : tfdSet;
  888. St : String;
  889. begin
  890. St:=RawReadKey;
  891. fpFD_ZERO (fdsin);
  892. fpFD_SET (StdInputHandle,fdsin);
  893. Repeat
  894. if inhead=intail then
  895. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  896. if SysKeyPressed then
  897. ch:=ttyRecvChar
  898. else
  899. ch:=#0;
  900. if ch<>#0 then
  901. St:=St+ch;
  902. Until ch=#0;
  903. RawReadString:=St;
  904. end;
  905. function ReadKey(var IsAlt : boolean):char;
  906. var
  907. ch : char;
  908. is_delay : boolean;
  909. fdsin : tfdSet;
  910. store : array [0..8] of char;
  911. arrayind : byte;
  912. NPT,NNPT : PTreeElement;
  913. procedure GenMouseEvent;
  914. var MouseEvent: TMouseEvent;
  915. begin
  916. Fillchar(MouseEvent,SizeOf(TMouseEvent),#0);
  917. case ch of
  918. #32 : {left button pressed }
  919. MouseEvent.buttons:=1;
  920. #33 : {middle button pressed }
  921. MouseEvent.buttons:=2;
  922. #34 : { right button pressed }
  923. MouseEvent.buttons:=4;
  924. #35 : { no button pressed };
  925. end;
  926. if inhead=intail then
  927. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  928. ch:=ttyRecvChar;
  929. MouseEvent.x:=Ord(ch)-ord(' ')-1;
  930. if inhead=intail then
  931. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  932. ch:=ttyRecvChar;
  933. MouseEvent.y:=Ord(ch)-ord(' ')-1;
  934. if (MouseEvent.buttons<>0) then
  935. MouseEvent.action:=MouseActionDown
  936. else
  937. begin
  938. if (LastMouseEvent.Buttons<>0) and
  939. ((LastMouseEvent.X<>MouseEvent.X) or (LastMouseEvent.Y<>MouseEvent.Y)) then
  940. begin
  941. MouseEvent.Action:=MouseActionMove;
  942. MouseEvent.Buttons:=LastMouseEvent.Buttons;
  943. PutMouseEvent(MouseEvent);
  944. MouseEvent.Buttons:=0;
  945. end;
  946. MouseEvent.Action:=MouseActionUp;
  947. end;
  948. PutMouseEvent(MouseEvent);
  949. LastMouseEvent:=MouseEvent;
  950. end;
  951. procedure RestoreArray;
  952. var
  953. i : byte;
  954. begin
  955. for i:=0 to arrayind-1 do
  956. PushKey(store[i]);
  957. end;
  958. begin
  959. IsAlt:=false;
  960. {Check Buffer first}
  961. if KeySend<>KeyPut then
  962. begin
  963. ReadKey:=PopKey;
  964. exit;
  965. end;
  966. {Wait for Key}
  967. if not sysKeyPressed then
  968. begin
  969. fpFD_ZERO (fdsin);
  970. fpFD_SET (StdInputHandle,fdsin);
  971. fpSelect (StdInputHandle+1,@fdsin,nil,nil,nil);
  972. end;
  973. ch:=ttyRecvChar;
  974. NPT:=RootTree[ord(ch)];
  975. if not assigned(NPT) then
  976. PushKey(ch)
  977. else
  978. begin
  979. fpFD_ZERO(fdsin);
  980. fpFD_SET(StdInputHandle,fdsin);
  981. store[0]:=ch;
  982. arrayind:=1;
  983. while assigned(NPT) and syskeypressed do
  984. begin
  985. if inhead=intail then
  986. fpSelect(StdInputHandle+1,@fdsin,nil,nil,10);
  987. ch:=ttyRecvChar;
  988. NNPT:=FindChild(ord(ch),NPT);
  989. if assigned(NNPT) then
  990. begin
  991. NPT:=NNPT;
  992. if NPT^.CanBeTerminal and
  993. assigned(NPT^.SpecialHandler) then
  994. break;
  995. End;
  996. if ch<>#0 then
  997. begin
  998. store[arrayind]:=ch;
  999. inc(arrayind);
  1000. end;
  1001. if not assigned(NNPT) then
  1002. begin
  1003. if ch<>#0 then
  1004. begin
  1005. { Put that unused char back into InBuf }
  1006. If InTail=0 then
  1007. InTail:=InSize-1
  1008. else
  1009. Dec(InTail);
  1010. InBuf[InTail]:=ch;
  1011. end;
  1012. break;
  1013. end;
  1014. end;
  1015. if assigned(NPT) and NPT^.CanBeTerminal then
  1016. begin
  1017. if assigned(NPT^.SpecialHandler) then
  1018. begin
  1019. NPT^.SpecialHandler;
  1020. PushExt(0);
  1021. end
  1022. else if NPT^.CharValue<>0 then
  1023. PushKey(chr(NPT^.CharValue))
  1024. else if NPT^.ScanValue<>0 then
  1025. PushExt(NPT^.ScanValue);
  1026. end
  1027. else
  1028. RestoreArray;
  1029. end
  1030. {$ifdef logging}
  1031. writeln(f);
  1032. {$endif logging}
  1033. ;
  1034. ReadKey:=PopKey;
  1035. End;
  1036. {$ifdef linux}
  1037. function ShiftState:byte;
  1038. var
  1039. arg,
  1040. shift : longint;
  1041. begin
  1042. shift:=0;
  1043. arg:=6;
  1044. if fpioctl(StdInputHandle,TIOCLINUX,@arg)=0 then
  1045. begin
  1046. if (arg and 8)<>0 then
  1047. shift:=kbAlt;
  1048. if (arg and 4)<>0 then
  1049. inc(shift,kbCtrl);
  1050. { 2 corresponds to AltGr so set both kbAlt and kbCtrl PM }
  1051. if (arg and 2)<>0 then
  1052. shift:=shift or (kbAlt or kbCtrl);
  1053. if (arg and 1)<>0 then
  1054. inc(shift,kbShift);
  1055. end;
  1056. ShiftState:=shift;
  1057. end;
  1058. procedure force_linuxtty;
  1059. var s:string[15];
  1060. { st:stat;}
  1061. handle:sizeint;
  1062. thistty:string;
  1063. begin
  1064. is_console:=false;
  1065. if vcs_device<>-1 then
  1066. begin
  1067. { running on a tty, find out whether locally or remotely }
  1068. thistty:=ttyname(stdinputhandle);
  1069. if (copy(thistty,1,8)<>'/dev/tty') or not (thistty[9] in ['0'..'9']) then
  1070. begin
  1071. {Running from Midnight Commander or something... Bypass it.}
  1072. str(vcs_device,s);
  1073. handle:=fpopen('/dev/tty'+s,O_RDWR);
  1074. fpioctl(stdinputhandle,TIOCNOTTY,nil);
  1075. {This will currently only work when the user is root :(}
  1076. fpioctl(handle,TIOCSCTTY,nil);
  1077. if errno<>0 then
  1078. exit;
  1079. fpclose(stdinputhandle);
  1080. fpclose(stdoutputhandle);
  1081. fpclose(stderrorhandle);
  1082. fpdup2(handle,stdinputhandle);
  1083. fpdup2(handle,stdoutputhandle);
  1084. fpdup2(handle,stderrorhandle);
  1085. fpclose(handle);
  1086. end;
  1087. is_console:=true;
  1088. end;
  1089. end;
  1090. {$endif linux}
  1091. { Exported functions }
  1092. procedure SysInitKeyboard;
  1093. begin
  1094. SetRawMode(true);
  1095. {$ifdef logging}
  1096. assign(f,'keyboard.log');
  1097. rewrite(f);
  1098. {$endif logging}
  1099. {$ifdef linux}
  1100. force_linuxtty;
  1101. prepare_patching;
  1102. patchkeyboard;
  1103. if is_console then
  1104. install_vt_handler
  1105. else
  1106. begin
  1107. {$endif}
  1108. { default for Shift prefix is ^ A}
  1109. if ShiftPrefix = 0 then
  1110. ShiftPrefix:=1;
  1111. {default for Alt prefix is ^Z }
  1112. if AltPrefix=0 then
  1113. AltPrefix:=26;
  1114. { default for Ctrl Prefix is ^W }
  1115. if CtrlPrefix=0 then
  1116. CtrlPrefix:=23;
  1117. {$ifdef linux}
  1118. end;
  1119. {$endif}
  1120. LoadDefaultSequences;
  1121. { LoadTerminfoSequences;}
  1122. end;
  1123. procedure SysDoneKeyboard;
  1124. begin
  1125. {$ifdef linux}
  1126. unpatchkeyboard;
  1127. {$endif linux}
  1128. SetRawMode(false);
  1129. FreeTree;
  1130. {$ifdef logging}
  1131. close(f);
  1132. {$endif logging}
  1133. end;
  1134. function SysGetKeyEvent: TKeyEvent;
  1135. function EvalScan(b:byte):byte;
  1136. const
  1137. DScan:array[0..31] of byte = (
  1138. $39, $02, $28, $04, $05, $06, $08, $28,
  1139. $0A, $0B, $09, $0D, $33, $0C, $34, $35,
  1140. $0B, $02, $03, $04, $05, $06, $07, $08,
  1141. $09, $0A, $27, $27, $33, $0D, $34, $35);
  1142. LScan:array[0..31] of byte = (
  1143. $29, $1E, $30, $2E, $20, $12, $21, $22,
  1144. $23, $17, $24, $25, $26, $32, $31, $18,
  1145. $19, $10, $13, $1F, $14, $16, $2F, $11,
  1146. $2D, $15, $2C, $1A, $2B, $1B, $29, $0C);
  1147. begin
  1148. if (b and $E0)=$20 { digits / leters } then
  1149. EvalScan:=DScan[b and $1F]
  1150. else
  1151. case b of
  1152. $08:EvalScan:=$0E; { backspace }
  1153. $09:EvalScan:=$0F; { TAB }
  1154. $0D:EvalScan:=$1C; { CR }
  1155. $1B:EvalScan:=$01; { esc }
  1156. $40:EvalScan:=$03; { @ }
  1157. $5E:EvalScan:=$07; { ^ }
  1158. $60:EvalScan:=$29; { ` }
  1159. else
  1160. EvalScan:=LScan[b and $1F];
  1161. end;
  1162. end;
  1163. function EvalScanZ(b:byte):byte;
  1164. begin
  1165. EvalScanZ:=b;
  1166. if b in [$3B..$44] { F1..F10 -> Alt-F1..Alt-F10} then
  1167. EvalScanZ:=b+$2D;
  1168. end;
  1169. const
  1170. {kbHome, kbUp, kbPgUp,Missing, kbLeft,
  1171. kbCenter, kbRight, kbAltGrayPlus, kbend,
  1172. kbDown, kbPgDn, kbIns, kbDel }
  1173. CtrlArrow : array [kbHome..kbDel] of byte =
  1174. {($77,$8d,$84,$8e,$73,$8f,$74,$90,$75,$91,$76);}
  1175. (kbCtrlHome,kbCtrlUp,kbCtrlPgUp,kbNoKey,kbCtrlLeft,
  1176. kbCtrlCenter,kbCtrlRight,kbAltGrayPlus,kbCtrlEnd,
  1177. kbCtrlDown,kbCtrlPgDn,kbCtrlIns,kbCtrlDel);
  1178. AltArrow : array [kbHome..kbDel] of byte =
  1179. (kbAltHome,kbAltUp,kbAltPgUp,kbNoKey,kbAltLeft,
  1180. kbCenter,kbAltRight,kbAltGrayPlus,kbAltEnd,
  1181. kbAltDown,kbAltPgDn,kbAltIns,kbAltDel);
  1182. ShiftArrow : array [kbShiftUp..kbShiftEnd] of byte =
  1183. (kbUp,kbLeft,kbRight,kbDown,kbHome,kbEnd);
  1184. var
  1185. MyScan:byte;
  1186. MyChar : char;
  1187. EscUsed,AltPrefixUsed,CtrlPrefixUsed,ShiftPrefixUsed,IsAlt,Again : boolean;
  1188. SState:byte;
  1189. begin {main}
  1190. MyChar:=Readkey(IsAlt);
  1191. MyScan:=ord(MyChar);
  1192. {$ifdef linux}
  1193. if is_console then
  1194. SState:=ShiftState
  1195. else
  1196. {$endif}
  1197. Sstate:=0;
  1198. CtrlPrefixUsed:=false;
  1199. AltPrefixUsed:=false;
  1200. ShiftPrefixUsed:=false;
  1201. EscUsed:=false;
  1202. if IsAlt then
  1203. SState:=SState or kbAlt;
  1204. repeat
  1205. again:=false;
  1206. if Mychar=#0 then
  1207. begin
  1208. MyScan:=ord(ReadKey(IsAlt));
  1209. if myscan=$01 then
  1210. mychar:=#27;
  1211. { Handle Ctrl-<x>, but not AltGr-<x> }
  1212. if ((SState and kbCtrl)<>0) and ((SState and kbAlt) = 0) then
  1213. case MyScan of
  1214. kbHome..kbDel : { cArrow }
  1215. MyScan:=CtrlArrow[MyScan];
  1216. kbF1..KbF10 : { cF1-cF10 }
  1217. MyScan:=MyScan+kbCtrlF1-kbF1;
  1218. kbF11..KbF12 : { cF11-cF12 }
  1219. MyScan:=MyScan+kbCtrlF11-kbF11;
  1220. end
  1221. { Handle Alt-<x>, but not AltGr }
  1222. else if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
  1223. case MyScan of
  1224. kbHome..kbDel : { AltArrow }
  1225. MyScan:=AltArrow[MyScan];
  1226. kbF1..KbF10 : { aF1-aF10 }
  1227. MyScan:=MyScan+kbAltF1-kbF1;
  1228. kbF11..KbF12 : { aF11-aF12 }
  1229. MyScan:=MyScan+kbAltF11-kbF11;
  1230. end
  1231. else if (SState and kbShift)<>0 then
  1232. case MyScan of
  1233. kbIns: MyScan:=kbShiftIns;
  1234. kbDel: MyScan:=kbShiftDel;
  1235. kbF1..KbF10 : { sF1-sF10 }
  1236. MyScan:=MyScan+kbShiftF1-kbF1;
  1237. kbF11..KbF12 : { sF11-sF12 }
  1238. MyScan:=MyScan+kbShiftF11-kbF11;
  1239. end;
  1240. if myscan in [kbShiftUp..kbShiftEnd] then
  1241. begin
  1242. myscan:=ShiftArrow[myscan];
  1243. sstate:=sstate or kbshift;
  1244. end;
  1245. if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
  1246. SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
  1247. else
  1248. SysGetKeyEvent:=0;
  1249. exit;
  1250. end
  1251. else if MyChar=#27 then
  1252. begin
  1253. if EscUsed then
  1254. SState:=SState and not kbAlt
  1255. else
  1256. begin
  1257. SState:=SState or kbAlt;
  1258. Again:=true;
  1259. EscUsed:=true;
  1260. end;
  1261. end
  1262. else if (AltPrefix<>0) and (MyChar=chr(AltPrefix)) then
  1263. begin { ^Z - replace Alt for Linux OS }
  1264. if AltPrefixUsed then
  1265. begin
  1266. SState:=SState and not kbAlt;
  1267. end
  1268. else
  1269. begin
  1270. AltPrefixUsed:=true;
  1271. SState:=SState or kbAlt;
  1272. Again:=true;
  1273. end;
  1274. end
  1275. else if (CtrlPrefix<>0) and (MyChar=chr(CtrlPrefix)) then
  1276. begin
  1277. if CtrlPrefixUsed then
  1278. SState:=SState and not kbCtrl
  1279. else
  1280. begin
  1281. CtrlPrefixUsed:=true;
  1282. SState:=SState or kbCtrl;
  1283. Again:=true;
  1284. end;
  1285. end
  1286. else if (ShiftPrefix<>0) and (MyChar=chr(ShiftPrefix)) then
  1287. begin
  1288. if ShiftPrefixUsed then
  1289. SState:=SState and not kbShift
  1290. else
  1291. begin
  1292. ShiftPrefixUsed:=true;
  1293. SState:=SState or kbShift;
  1294. Again:=true;
  1295. end;
  1296. end;
  1297. if not again then
  1298. begin
  1299. MyScan:=EvalScan(ord(MyChar));
  1300. if ((SState and kbAlt)<>0) and ((SState and kbCtrl) = 0) then
  1301. begin
  1302. if MyScan in [$02..$0D] then
  1303. inc(MyScan,$76);
  1304. MyChar:=chr(0);
  1305. end
  1306. else if (SState and kbShift)<>0 then
  1307. if MyChar=#9 then
  1308. begin
  1309. MyChar:=#0;
  1310. MyScan:=kbShiftTab;
  1311. end;
  1312. end
  1313. else
  1314. begin
  1315. MyChar:=Readkey(IsAlt);
  1316. MyScan:=ord(MyChar);
  1317. if IsAlt then
  1318. SState:=SState or kbAlt;
  1319. end;
  1320. until not Again;
  1321. if (MyChar<>#0) or (MyScan<>0) or (SState<>0) then
  1322. SysGetKeyEvent:=$3000000 or ord(MyChar) or (MyScan shl 8) or (SState shl 16)
  1323. else
  1324. SysGetKeyEvent:=0;
  1325. end;
  1326. function SysPollKeyEvent: TKeyEvent;
  1327. var
  1328. KeyEvent : TKeyEvent;
  1329. begin
  1330. if keypressed then
  1331. begin
  1332. KeyEvent:=SysGetKeyEvent;
  1333. PutKeyEvent(KeyEvent);
  1334. SysPollKeyEvent:=KeyEvent
  1335. end
  1336. else
  1337. SysPollKeyEvent:=0;
  1338. end;
  1339. function SysGetShiftState : Byte;
  1340. begin
  1341. {$ifdef linux}
  1342. if is_console then
  1343. SysGetShiftState:=ShiftState
  1344. else
  1345. {$else}
  1346. SysGetShiftState:=0;
  1347. {$endif}
  1348. end;
  1349. procedure RestoreStartMode;
  1350. begin
  1351. TCSetAttr(1,TCSANOW,StartTio);
  1352. end;
  1353. const
  1354. SysKeyboardDriver : TKeyboardDriver = (
  1355. InitDriver : @SysInitKeyBoard;
  1356. DoneDriver : @SysDoneKeyBoard;
  1357. GetKeyevent : @SysGetKeyEvent;
  1358. PollKeyEvent : @SysPollKeyEvent;
  1359. GetShiftState : @SysGetShiftState;
  1360. TranslateKeyEvent : Nil;
  1361. TranslateKeyEventUnicode : Nil;
  1362. );
  1363. begin
  1364. SetKeyBoardDriver(SysKeyBoardDriver);
  1365. TCGetAttr(1,StartTio);
  1366. end.