keyboard.pp 40 KB

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