fptools.pas 44 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Tool support for the IDE
  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. {$I globdir.inc}
  13. unit FPTools;
  14. interface
  15. uses Objects,Drivers,Views,Dialogs,Validate,
  16. BrowCol,
  17. WViews,
  18. FPViews;
  19. const
  20. MsgFilterSign = 'BI#PIP#OK'#0;
  21. type
  22. TCaptureTarget = (capNone,capMessageWindow,capEditWindow);
  23. PTool = ^TTool;
  24. TTool = object(TObject)
  25. constructor Init(const ATitle, AProgramPath, ACommandLine: string; AHotKey: word);
  26. function GetTitle: string; virtual;
  27. procedure GetParams(var ATitle, AProgramPath, ACommandLine: string; var AHotKey: word); virtual;
  28. procedure SetParams(const ATitle, AProgramPath, ACommandLine: string; const AHotKey: word); virtual;
  29. destructor Done; virtual;
  30. private
  31. Title : PString;
  32. ProgramPath : PString;
  33. CommandLine : PString;
  34. HotKey : word;
  35. end;
  36. PToolCollection = ^TToolCollection;
  37. TToolCollection = object(TCollection)
  38. function At(Index: sw_Integer): PTool;
  39. end;
  40. PToolListBox = ^TToolListBox;
  41. TToolListBox = object(TAdvancedListBox)
  42. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  43. end;
  44. PToolParamValidator = ^TToolParamValidator;
  45. TToolParamValidator = object(TValidator)
  46. function IsValid(const S: string): Boolean; virtual;
  47. procedure Error; virtual;
  48. private
  49. ErrorPos: integer;
  50. end;
  51. PToolItemDialog = ^TToolItemDialog;
  52. TToolItemDialog = object(TCenterDialog)
  53. constructor Init(ATool: PTool);
  54. function Execute: Word; virtual;
  55. private
  56. Tool : PTool;
  57. TitleIL : PInputLine;
  58. ProgramIL: PInputLine;
  59. ParamIL : PInputLine;
  60. HotKeyRB : PRadioButtons;
  61. end;
  62. PToolsDialog = ^TToolsDialog;
  63. TToolsDialog = object(TCenterDialog)
  64. constructor Init;
  65. function Execute: Word; virtual;
  66. procedure HandleEvent(var Event: TEvent); virtual;
  67. private
  68. ToolsLB : PToolListBox;
  69. procedure Add;
  70. procedure Edit;
  71. procedure Delete;
  72. end;
  73. PToolMessage = ^TToolMessage;
  74. TToolMessage = object(TMessageItem)
  75. constructor Init(AModule: PString; ALine: string; ARow, ACol: sw_integer);
  76. function GetText(MaxLen: Sw_integer): string; virtual;
  77. end;
  78. PToolMessageListBox = ^TToolMessageListBox;
  79. TToolMessageListBox = object(TMessageListBox)
  80. procedure NewList(AList: PCollection); virtual;
  81. procedure Clear; virtual;
  82. procedure Update; virtual;
  83. function GetPalette: PPalette; virtual;
  84. constructor Load(var S: TStream);
  85. procedure Store(var S: TStream);
  86. destructor Done; virtual;
  87. end;
  88. PMessagesWindow = ^TMessagesWindow;
  89. TMessagesWindow = object(TFPWindow)
  90. constructor Init;
  91. procedure Update; {virtual;}
  92. procedure HandleEvent(var Event: TEvent); virtual;
  93. function GetPalette: PPalette; virtual;
  94. constructor Load(var S: TStream);
  95. procedure Store(var S: TStream);
  96. destructor Done; virtual;
  97. procedure FocusItem(i : sw_integer);
  98. procedure SizeLimits(var Min, Max: TPoint); virtual;
  99. private
  100. MsgLB : PToolMessageListBox;
  101. end;
  102. procedure InitTools;
  103. function GetToolCount: sw_integer;
  104. function GetToolName(Idx: sw_integer): string;
  105. function AddTool(Title, ProgramPath, Params: string; HotKey: word): sw_integer;
  106. procedure GetToolParams(Idx: sw_integer; var Title, ProgramPath, Params: string; var HotKey: word);
  107. procedure SetToolParams(Idx: sw_integer; Title, ProgramPath, Params: string; HotKey: word);
  108. procedure DoneTools;
  109. function GetHotKeyName(Key: word): string;
  110. function ParseToolParams(var Params: string; CheckOnly: boolean): integer;
  111. function ProcessMessageFile(const MsgFileName: string): boolean;
  112. procedure AddToolCommand(Command: string);
  113. procedure AddToolMessage(ModuleName, Text: string; Row, Col: longint);
  114. procedure ClearToolMessages;
  115. procedure UpdateToolMessages;
  116. const
  117. ToolFilter : string[{$ifndef GABOR}128{$else}40{$endif}] = '';
  118. CaptureToolTo : TCaptureTarget = capNone;
  119. ToolMessages : PCollection = nil;
  120. ToolModuleNames: PStoreCollection = nil;
  121. MessagesWindow : PMessagesWindow = nil;
  122. LastToolMessageFocused : PToolMessage = nil;
  123. procedure RegisterFPTools;
  124. implementation
  125. uses Dos,
  126. Commands,App,MsgBox,
  127. WUtils,WINI,WEditor,
  128. FPConst,FPString,FPVars,FPUtils,FPCodCmp,FPCodTmp;
  129. {$ifndef NOOBJREG}
  130. const
  131. RToolMessageListBox: TStreamRec = (
  132. ObjType: 1600;
  133. VmtLink: Ofs(TypeOf(TToolMessageListBox)^);
  134. Load: @TToolMessageListBox.Load;
  135. Store: @TToolMessageListBox.Store
  136. );
  137. RMessagesWindow: TStreamRec = (
  138. ObjType: 1601;
  139. VmtLink: Ofs(TypeOf(TMessagesWindow)^);
  140. Load: @TMessagesWindow.Load;
  141. Store: @TMessagesWindow.Store
  142. );
  143. {$endif}
  144. type
  145. THotKeyDef = record
  146. Name : string[12];
  147. KeyCode : word;
  148. end;
  149. const
  150. HotKeys : array[0..9] of THotKeyDef =
  151. ( (Name : '~U~nassigned' ; KeyCode : kbNoKey ),
  152. (Name : 'Shift+F~2~' ; KeyCode : kbShiftF2 ),
  153. (Name : 'Shift+F~3~' ; KeyCode : kbShiftF3 ),
  154. (Name : 'Shift+F~4~' ; KeyCode : kbShiftF4 ),
  155. (Name : 'Shift+F~5~' ; KeyCode : kbShiftF5 ),
  156. (Name : 'Shift+F~6~' ; KeyCode : kbShiftF6 ),
  157. (Name : 'Shift+F~7~' ; KeyCode : kbShiftF7 ),
  158. (Name : 'Shift+F~8~' ; KeyCode : kbShiftF8 ),
  159. (Name : 'Shift+F~9~' ; KeyCode : kbShiftF9 ),
  160. (Name : 'Shift+F~1~0' ; KeyCode : kbShiftF10));
  161. Tools : PToolCollection = nil;
  162. AbortTool : boolean = false;
  163. function GetHotKeyCount: integer;
  164. begin
  165. GetHotKeyCount:=ord(High(HotKeys))-ord(Low(HotKeys))+1;
  166. end;
  167. function GetHotKeyNameByIdx(Idx: integer): string;
  168. begin
  169. GetHotKeyNameByIdx:=HotKeys[Idx].Name;
  170. end;
  171. function HotKeyToIdx(Key: word): integer;
  172. var Count,I: integer;
  173. Found: boolean;
  174. begin
  175. Count:=GetHotKeyCount; Found:=false;
  176. I:=0;
  177. while (I<Count) and (Found=false) do
  178. begin
  179. Found:=HotKeys[I].KeyCode=Key;
  180. if Found=false then
  181. Inc(I);
  182. end;
  183. if Found=false then I:=-1;
  184. HotKeyToIdx:=I;
  185. end;
  186. function IdxToHotKey(Idx: integer): word;
  187. var Count: integer;
  188. Key: word;
  189. begin
  190. Count:=GetHotKeyCount;
  191. if (0<=Idx) and (Idx<Count) then
  192. Key:=HotKeys[Idx].KeyCode
  193. else
  194. Key:=kbNoKey;
  195. IdxToHotKey:=Key;
  196. end;
  197. function GetHotKeyName(Key: word): string;
  198. var Idx: integer;
  199. S: string;
  200. begin
  201. Idx:=HotKeyToIdx(Key);
  202. if Idx=0 then S:='' else
  203. if Idx=-1 then S:='???' else
  204. S:=GetHotKeyNameByIdx(Idx);
  205. GetHotKeyName:=S;
  206. end;
  207. function WriteToolMessagesToFile(FileName: string): boolean;
  208. var OK: boolean;
  209. f: text;
  210. M: PToolMessage;
  211. I: sw_integer;
  212. begin
  213. I:=0;
  214. Assign(f,FileName);
  215. {$I-}
  216. Rewrite(f);
  217. OK:=EatIO=0;
  218. if Assigned(ToolMessages) then
  219. while OK and (I<ToolMessages^.Count) do
  220. begin
  221. M:=ToolMessages^.At(I);
  222. writeln(f,GetStr(M^.Module)+#0+GetStr(M^.Text)+#0+IntToStr(M^.Row)+#0+IntToStr(M^.Col));
  223. Inc(I);
  224. OK:=EatIO=0;
  225. end;
  226. Close(f);
  227. EatIO;
  228. {$I+}
  229. WriteToolMessagesToFile:=OK;
  230. end;
  231. constructor TTool.Init(const ATitle, AProgramPath, ACommandLine: string; AHotKey: word);
  232. begin
  233. inherited Init;
  234. SetParams(ATitle,AProgramPath,ACommandLine,AHotKey);
  235. end;
  236. function TTool.GetTitle: string;
  237. begin
  238. GetTitle:=KillTilde(GetStr(Title));
  239. end;
  240. procedure TTool.GetParams(var ATitle, AProgramPath, ACommandLine: string; var AHotKey: word);
  241. begin
  242. ATitle:=GetStr(Title); AProgramPath:=GetStr(ProgramPath);
  243. ACommandLine:=GetStr(CommandLine);
  244. AHotKey:=HotKey;
  245. end;
  246. procedure TTool.SetParams(const ATitle, AProgramPath, ACommandLine: string; const AHotKey: word);
  247. begin
  248. if Title<>nil then DisposeStr(Title); Title:=nil;
  249. if ProgramPath<>nil then DisposeStr(ProgramPath); ProgramPath:=nil;
  250. if CommandLine<>nil then DisposeStr(CommandLine); CommandLine:=nil;
  251. Title:=NewStr(ATitle); ProgramPath:=NewStr(AProgramPath);
  252. CommandLine:=NewStr(ACommandLine);
  253. HotKey:=AHotKey;
  254. end;
  255. destructor TTool.Done;
  256. begin
  257. inherited Done;
  258. if Title<>nil then DisposeStr(Title);
  259. if ProgramPath<>nil then DisposeStr(ProgramPath);
  260. if CommandLine<>nil then DisposeStr(CommandLine);
  261. end;
  262. function TToolCollection.At(Index: sw_Integer): PTool;
  263. begin
  264. At:=inherited At(Index);
  265. end;
  266. function TToolListBox.GetText(Item,MaxLen: sw_integer): String;
  267. var S: string;
  268. P: PTool;
  269. begin
  270. P:=List^.At(Item);
  271. S:=P^.GetTitle;
  272. GetText:=copy(S,1,MaxLen);
  273. end;
  274. procedure InitTools;
  275. begin
  276. if Tools<>nil then DoneTools;
  277. New(Tools, Init(10,20));
  278. end;
  279. function GetToolCount: sw_integer;
  280. var Count: integer;
  281. begin
  282. if Tools=nil then Count:=0 else
  283. Count:=Tools^.Count;
  284. GetToolCount:=Count;
  285. end;
  286. function GetToolName(Idx: sw_integer): string;
  287. var S1,S2: string;
  288. W: word;
  289. begin
  290. GetToolParams(Idx,S1,S2,S2,W);
  291. GetToolName:=KillTilde(S1);
  292. end;
  293. function AddTool(Title, ProgramPath, Params: string; HotKey: word): sw_integer;
  294. var P: PTool;
  295. begin
  296. if Tools=nil then InitTools;
  297. New(P, Init(Title,ProgramPath,Params,HotKey));
  298. Tools^.Insert(P);
  299. AddTool:=Tools^.IndexOf(P);
  300. end;
  301. procedure GetToolParams(Idx: sw_integer; var Title, ProgramPath, Params: string; var HotKey: word);
  302. var P: PTool;
  303. begin
  304. P:=Tools^.At(Idx);
  305. P^.GetParams(Title,ProgramPath,Params,HotKey);
  306. end;
  307. procedure SetToolParams(Idx: sw_integer; Title, ProgramPath, Params: string; HotKey: word);
  308. var P: PTool;
  309. begin
  310. P:=Tools^.At(Idx);
  311. P^.GetParams(Title,ProgramPath,Params,HotKey);
  312. end;
  313. procedure DoneTools;
  314. begin
  315. if Tools<>nil then Dispose(Tools, Done); Tools:=nil;
  316. end;
  317. procedure TToolParamValidator.Error;
  318. begin
  319. MsgParms[1].Long:=ErrorPos;
  320. ErrorBox(^C'Error parsing parameters line at line position %d.',@MsgParms);
  321. end;
  322. function TToolParamValidator.IsValid(const S: string): Boolean;
  323. var P: string;
  324. begin
  325. P:=S;
  326. ErrorPos:=ParseToolParams(P,true);
  327. IsValid:=ErrorPos=0;
  328. end;
  329. constructor TToolItemDialog.Init(ATool: PTool);
  330. var R,R2,R3: TRect;
  331. Items: PSItem;
  332. I,KeyCount: sw_integer;
  333. begin
  334. KeyCount:=GetHotKeyCount;
  335. R.Assign(0,0,60,Max(3+KeyCount,12));
  336. inherited Init(R,'Modify/New Tool');
  337. Tool:=ATool;
  338. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  339. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  340. New(TitleIL, Init(R, 128)); Insert(TitleIL);
  341. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, '~T~itle', TitleIL)));
  342. R.Move(0,3);
  343. New(ProgramIL, Init(R, 128)); Insert(ProgramIL);
  344. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, 'Program ~p~ath', ProgramIL)));
  345. R.Move(0,3);
  346. New(ParamIL, Init(R, 128)); Insert(ParamIL);
  347. ParamIL^.SetValidator(New(PToolParamValidator, Init));
  348. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, 'Command ~l~ine', ParamIL)));
  349. R.Copy(R3); Inc(R.A.X,38); R.B.Y:=R.A.Y+KeyCount;
  350. Items:=nil;
  351. for I:=KeyCount-1 downto 0 do
  352. Items:=NewSItem(GetHotKeyNameByIdx(I), Items);
  353. New(HotKeyRB, Init(R, Items));
  354. Insert(HotKeyRB);
  355. InsertButtons(@Self);
  356. TitleIL^.Select;
  357. end;
  358. function TToolItemDialog.Execute: Word;
  359. var R: word;
  360. S1,S2,S3: string;
  361. W: word;
  362. L: longint;
  363. begin
  364. Tool^.GetParams(S1,S2,S3,W);
  365. TitleIL^.SetData(S1); ProgramIL^.SetData(S2); ParamIL^.SetData(S3);
  366. L:=HotKeyToIdx(W); if L=-1 then L:=255;
  367. HotKeyRB^.SetData(L);
  368. R:=inherited Execute;
  369. if R=cmOK then
  370. begin
  371. TitleIL^.GetData(S1); ProgramIL^.GetData(S2); ParamIL^.GetData(S3);
  372. HotKeyRB^.GetData(L); W:=IdxToHotKey(L);
  373. Tool^.SetParams(S1,S2,S3,W);
  374. end;
  375. Execute:=R;
  376. end;
  377. constructor TToolsDialog.Init;
  378. var R,R2,R3: TRect;
  379. SB: PScrollBar;
  380. begin
  381. R.Assign(0,0,46,16);
  382. inherited Init(R,'Tools');
  383. GetExtent(R); R.Grow(-3,-2); Inc(R.A.Y); R3.Copy(R); Dec(R.B.X,12);
  384. R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
  385. New(SB, Init(R2)); Insert(SB);
  386. New(ToolsLB, Init(R,1,SB));
  387. Insert(ToolsLB);
  388. R2.Copy(R); R2.Move(0,-1); R2.B.Y:=R2.A.Y+1; Dec(R2.A.X);
  389. Insert(New(PLabel, Init(R2, '~P~rogram titles', ToolsLB)));
  390. R.Copy(R3); R.A.X:=R.B.X-10; R.B.Y:=R.A.Y+2;
  391. Insert(New(PButton, Init(R, 'O~K~', cmOK, bfNormal)));
  392. R.Move(0,2);
  393. Insert(New(PButton, Init(R, '~E~dit', cmEditItem, bfDefault)));
  394. R.Move(0,2);
  395. Insert(New(PButton, Init(R, '~N~ew', cmAddItem, bfNormal)));
  396. R.Move(0,2);
  397. Insert(New(PButton, Init(R, '~D~elete', cmDeleteItem, bfNormal)));
  398. R.Move(0,2);
  399. Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  400. SelectNext(false);
  401. end;
  402. procedure TToolsDialog.HandleEvent(var Event: TEvent);
  403. var DontClear: boolean;
  404. begin
  405. case Event.What of
  406. evKeyDown :
  407. begin
  408. DontClear:=false;
  409. case Event.KeyCode of
  410. kbIns :
  411. Message(@Self,evCommand,cmAddItem,nil);
  412. kbDel :
  413. Message(@Self,evCommand,cmDeleteItem,nil);
  414. else DontClear:=true;
  415. end;
  416. if DontClear=false then ClearEvent(Event);
  417. end;
  418. evBroadcast :
  419. case Event.Command of
  420. cmListItemSelected :
  421. if Event.InfoPtr=pointer(ToolsLB) then
  422. Message(@Self,evCommand,cmEditItem,nil);
  423. end;
  424. evCommand :
  425. begin
  426. DontClear:=false;
  427. case Event.Command of
  428. cmAddItem : Add;
  429. cmDeleteItem : Delete;
  430. cmEditItem : Edit;
  431. else DontClear:=true;
  432. end;
  433. if DontClear=false then ClearEvent(Event);
  434. end;
  435. end;
  436. inherited HandleEvent(Event);
  437. end;
  438. function TToolsDialog.Execute: Word;
  439. var R: word;
  440. C: PToolCollection;
  441. I: integer;
  442. S1,S2,S3: string;
  443. W: word;
  444. begin
  445. New(C, Init(10,20));
  446. if Tools<>nil then
  447. for I:=0 to Tools^.Count-1 do
  448. begin
  449. Tools^.At(I)^.GetParams(S1,S2,S3,W);
  450. C^.Insert(New(PTool, Init(S1,S2,S3,W)));
  451. end;
  452. ToolsLB^.NewList(C);
  453. R:=inherited Execute;
  454. if R=cmOK then
  455. begin
  456. if Tools<>nil then Dispose(Tools, Done);
  457. Tools:=C;
  458. Message(Application,evBroadcast,cmUpdateTools,nil);
  459. end
  460. else
  461. Dispose(C, Done);
  462. Execute:=R;
  463. end;
  464. procedure TToolsDialog.Add;
  465. var P: PTool;
  466. IC: boolean;
  467. S1,S2,S3: string;
  468. W: word;
  469. begin
  470. if ToolsLB^.Range>=MaxToolCount then
  471. begin InformationBox(^C'Can''t install more tools...',nil); Exit; end;
  472. IC:=ToolsLB^.Range=0;
  473. if IC=false then
  474. begin
  475. P:=ToolsLB^.List^.At(ToolsLB^.Focused);
  476. P^.GetParams(S1,S2,S3,W);
  477. end
  478. else
  479. begin
  480. S1:=''; S2:=''; S3:=''; W:=0;
  481. end;
  482. New(P, Init(S1,S2,S3,W));
  483. if Application^.ExecuteDialog(New(PToolItemDialog, Init(P)), nil)=cmOK then
  484. begin
  485. ToolsLB^.List^.Insert(P);
  486. ToolsLB^.SetRange(ToolsLB^.List^.Count);
  487. ReDraw;
  488. end
  489. else
  490. Dispose(P, Done);
  491. end;
  492. procedure TToolsDialog.Edit;
  493. var P: PTool;
  494. begin
  495. if ToolsLB^.Range=0 then Exit;
  496. P:=ToolsLB^.List^.At(ToolsLB^.Focused);
  497. Application^.ExecuteDialog(New(PToolItemDialog, Init(P)), nil);
  498. ReDraw;
  499. end;
  500. procedure TToolsDialog.Delete;
  501. begin
  502. if ToolsLB^.Range=0 then Exit;
  503. ToolsLB^.List^.AtFree(ToolsLB^.Focused);
  504. ToolsLB^.SetRange(ToolsLB^.List^.Count);
  505. ReDraw;
  506. end;
  507. procedure ReplaceStr(var S: string; const What,NewS: string);
  508. var I : integer;
  509. begin
  510. repeat
  511. I:=Pos(What,S);
  512. if I>0 then
  513. begin
  514. Delete(S,I,length(What));
  515. Insert(NewS,S,I);
  516. end;
  517. until I=0;
  518. end;
  519. procedure ReplaceStrI(var S: string; What: string; const NewS: string);
  520. var I : integer;
  521. UpcaseS: string;
  522. begin
  523. UpcaseS:=UpcaseStr(S); What:=UpcaseStr(What);
  524. repeat
  525. I:=Pos(What,UpcaseS);
  526. if I>0 then
  527. begin
  528. Delete(S,I,length(What));
  529. Insert(NewS,S,I);
  530. end;
  531. until I=0;
  532. end;
  533. function GetCoordEntry(F: PINIFile; Section, Entry: string; var P: TPoint): boolean;
  534. var OK: boolean;
  535. S: string;
  536. Px: integer;
  537. begin
  538. S:=F^.GetEntry(Section,Entry,'');
  539. S:=Trim(S);
  540. OK:=(S<>'') and (S[1]='(') and (S[length(S)]=')');
  541. if OK then S:=copy(S,2,length(S)-2);
  542. Px:=Pos(',',S);
  543. OK:=OK and (Px>0);
  544. if OK then P.X:=StrToInt(copy(S,1,Px-1));
  545. OK:=OK and (LastStrToIntResult=0);
  546. if OK then P.Y:=StrToInt(copy(S,Px+1,255));
  547. OK:=OK and (LastStrToIntResult=0);
  548. GetCoordEntry:=OK;
  549. end;
  550. function ExecutePromptDialog(const FileName: string; var Params: string): boolean;
  551. const
  552. MaxViews = 20;
  553. MaxViewNameLen = 40;
  554. MaxValueLen = 80;
  555. secMain = 'MAIN';
  556. { Main section entries }
  557. tmeTitle = 'TITLE';
  558. tmeCommandLine = 'COMMANDLINE';
  559. tmeSize = 'SIZE';
  560. tmeDefaultView = 'DEFAULT';
  561. { View section entries }
  562. tieType = 'TYPE';
  563. tieOrigin = 'ORIGIN';
  564. tieSize = 'SIZE';
  565. {*} tieDefault = 'DEFAULT';
  566. tieValue = 'VALUE';
  567. { Additional CheckBox view section entries }
  568. tieName = 'NAME';
  569. tieOnParm = 'ON';
  570. tieOffParm = 'OFF';
  571. { Additional CheckBox view section entries }
  572. tieItem = 'ITEM';
  573. tieParam = 'PARAM';
  574. { Additional InputLine view section entries }
  575. tieMaxLen = 'MAXLEN';
  576. { Additional Label view section entries }
  577. tieLink = 'LINK';
  578. tieText = 'TEXT';
  579. { View types }
  580. vtCheckBox = 1;
  581. vtRadioButton = 2;
  582. vtInputLine = 3;
  583. vtLabel = 127;
  584. vtsCheckBox = 'CHECKBOX';
  585. vtsRadioButton = 'RADIOBUTTON';
  586. vtsInputLine = 'INPUTLINE';
  587. vtsLabel = 'LABEL';
  588. var Title : string;
  589. DSize : TPoint;
  590. CmdLine : string;
  591. ViewCount : Sw_integer;
  592. ViewNames : array[0..MaxViews-1] of string[MaxViewNameLen];
  593. ViewTypes : array[0..MaxViews-1] of byte;
  594. ViewBounds : array[0..MaxViews-1] of TRect;
  595. ViewPtrs : array[0..MaxViews-1] of PView;
  596. ViewValues : array[0..MaxViews-1] of string[MaxValueLen];
  597. ViewItemCount: array[0..MaxViews-1] of sw_integer;
  598. function BuildPromptDialogInfo(F: PINIFile): boolean;
  599. var
  600. OK: boolean;
  601. _IS: PINISection;
  602. procedure ProcessSection(Sec: PINISection);{$ifndef FPC}far;{$endif}
  603. var P1,P2: TPoint;
  604. Typ: string;
  605. Count: sw_integer;
  606. begin
  607. if (OK=false) or
  608. ( (UpcaseStr(Sec^.GetName)=secMain) or
  609. (UpcaseStr(Sec^.GetName)=UpcaseStr(MainSectionName)) ) then
  610. Exit;
  611. ViewItemCount[ViewCount]:=0;
  612. OK:=(Sec^.SearchEntry(tieType)<>nil) and
  613. (Sec^.SearchEntry(tieOrigin)<>nil) and
  614. (Sec^.SearchEntry(tieSize)<>nil);
  615. if OK=false then
  616. begin ErrorBox('Required property missing in ['+Sec^.GetName+']',nil); Exit; end;
  617. Typ:=UpcaseStr(Trim(F^.GetEntry(Sec^.GetName,tieType,'')));
  618. if Typ=vtsCheckBox then ViewTypes[ViewCount]:=vtCheckBox else
  619. if Typ=vtsRadioButton then ViewTypes[ViewCount]:=vtRadioButton else
  620. if Typ=vtsInputLine then ViewTypes[ViewCount]:=vtInputLine else
  621. if Typ=vtsLabel then ViewTypes[ViewCount]:=vtLabel else
  622. begin OK:=false; ErrorBox('Unknown type in ['+Sec^.GetName+']',nil); Exit; end;
  623. ViewNames[ViewCount]:=Sec^.GetName;
  624. GetCoordEntry(F,Sec^.GetName,tieOrigin,P1);
  625. GetCoordEntry(F,Sec^.GetName,tieSize,P2);
  626. ViewBounds[ViewCount].Assign(P1.X,P1.Y,P1.X+P2.X,P1.Y+P2.Y);
  627. ViewValues[ViewCount]:=F^.GetEntry(Sec^.GetName,tieValue,'');
  628. case ViewTypes[ViewCount] of
  629. vtLabel :
  630. begin
  631. OK:=OK and (Sec^.SearchEntry(tieLink)<>nil) and
  632. (Sec^.SearchEntry(tieText)<>nil);
  633. if OK=false then
  634. begin ErrorBox('Required property missing in ['+Sec^.GetName+']',nil); Exit; end;
  635. end;
  636. vtInputLine : ;
  637. vtCheckBox :
  638. begin
  639. OK:=OK and (Sec^.SearchEntry(tieName)<>nil);
  640. if OK=false then
  641. begin ErrorBox(tieName+' property missing in ['+Sec^.GetName+']',nil); Exit; end;
  642. end;
  643. vtRadioButton:
  644. begin
  645. Count:=0;
  646. while Sec^.SearchEntry(tieItem+IntToStr(Count+1))<>nil do
  647. Inc(Count);
  648. ViewItemCount[ViewCount]:=Count;
  649. OK:=Count>0;
  650. if OK=false then
  651. begin ErrorBox('Invalid number of items in ['+Sec^.GetName+']',nil); Exit; end;
  652. end;
  653. end;
  654. if OK then Inc(ViewCount);
  655. end;
  656. begin
  657. BuildPromptDialogInfo:=false;
  658. _IS:=F^.SearchSection(secMain);
  659. OK:=_IS<>nil;
  660. if OK then OK:=(_IS^.SearchEntry(tmeTitle)<>nil) and
  661. (_IS^.SearchEntry(tmeSize)<>nil) and
  662. (_IS^.SearchEntry(tmeCommandLine)<>nil);
  663. if OK then
  664. begin
  665. Title:=F^.GetEntry(secMain,tmeTitle,'');
  666. OK:=OK and GetCoordEntry(F,secMain,tmeSize,DSize);
  667. CmdLine:=F^.GetEntry(secMain,tmeCommandLine,'');
  668. OK:=OK and (CmdLine<>'');
  669. end;
  670. if OK=false then
  671. begin ErrorBox('Required property missing in ['+_IS^.GetName+']',nil); Exit; end;
  672. if OK then
  673. begin
  674. ViewCount:=0;
  675. F^.ForEachSection(@ProcessSection);
  676. end;
  677. BuildPromptDialogInfo:=OK;
  678. end;
  679. function SearchViewByName(Name: string): integer;
  680. var I,Idx: Sw_integer;
  681. begin
  682. Idx:=-1; Name:=UpcaseStr(Name);
  683. for I:=0 to ViewCount-1 do
  684. if UpcaseStr(ViewNames[I])=Name then
  685. begin
  686. Idx:=I;
  687. Break;
  688. end;
  689. SearchViewByName:=Idx;
  690. end;
  691. function GetParamValueStr(F: PINIFile; Idx: integer): string;
  692. var S: string;
  693. Entry: string[20];
  694. begin
  695. S:='???';
  696. case ViewTypes[Idx] of
  697. vtLabel :
  698. S:='';
  699. vtInputLine :
  700. S:=PInputLine(ViewPtrs[Idx])^.Data^;
  701. vtCheckBox :
  702. with PCheckBoxes(ViewPtrs[Idx])^ do
  703. begin
  704. if Mark(0) then Entry:=tieOnParm else Entry:=tieOffParm;
  705. S:=F^.GetEntry(ViewNames[Idx],Entry,'');
  706. end;
  707. vtRadioButton :
  708. with PRadioButtons(ViewPtrs[Idx])^ do
  709. begin
  710. Entry:=tieParam+IntToStr(Value+1);
  711. S:=F^.GetEntry(ViewNames[Idx],Entry,'');
  712. end;
  713. end;
  714. GetParamValueStr:=S;
  715. end;
  716. function ExtractPromptDialogParams(F: PINIFile; var Params: string): boolean;
  717. function ReplacePart(StartP,EndP: integer; const S: string): integer;
  718. begin
  719. Params:=copy(Params,1,StartP-1)+S+copy(Params,EndP+1,255);
  720. ReplacePart:=length(S)-(EndP-StartP+1);
  721. end;
  722. var OptName: string;
  723. OK: boolean;
  724. C: char;
  725. OptStart: integer;
  726. InOpt: boolean;
  727. I,Idx: integer;
  728. S: string;
  729. begin
  730. Params:=CmdLine;
  731. I:=1; InOpt:=false; OK:=true;
  732. while OK and (I<=length(Params)) do
  733. begin
  734. C:=Params[I];
  735. if C='%' then
  736. begin
  737. InOpt:=not InOpt;
  738. if InOpt then
  739. begin
  740. OptName:='';
  741. OptStart:=I;
  742. end
  743. else
  744. begin
  745. OptName:=UpcaseStr(OptName);
  746. Idx:=SearchViewByName(OptName);
  747. OK:=Idx<>-1;
  748. if OK then
  749. begin
  750. S:=GetParamValueStr(F,Idx);
  751. if (S='') and (Params[I+1]=' ') then Inc(I);
  752. I:=I+ReplacePart(OptStart,I,S);
  753. end;
  754. end;
  755. end
  756. else
  757. if InOpt then
  758. OptName:=OptName+C;
  759. Inc(I);
  760. end;
  761. ExtractPromptDialogParams:=OK;
  762. end;
  763. function ExecPromptDialog(F: PINIFile): boolean;
  764. var R: TRect;
  765. PromptDialog: PCenterDialog;
  766. Re: integer;
  767. OK: boolean;
  768. I,J,MaxLen: integer;
  769. IL: PInputLine;
  770. CB: PCheckBoxes;
  771. RB: PRadioButtons;
  772. LV: PLabel;
  773. SI: PSItem;
  774. S: string;
  775. P: PView;
  776. begin
  777. R.Assign(0,0,DSize.X,DSize.Y);
  778. New(PromptDialog, Init(R, Title));
  779. with PromptDialog^ do
  780. begin
  781. for I:=0 to ViewCount-1 do
  782. begin
  783. case ViewTypes[I] of
  784. vtLabel :
  785. begin
  786. S:=F^.GetEntry(ViewNames[I],tieLink,'');
  787. J:=SearchViewByName(S);
  788. if J=-1 then P:=nil else
  789. P:=ViewPtrs[J];
  790. S:=F^.GetEntry(ViewNames[I],tieText,'');
  791. New(LV, Init(ViewBounds[I], S, P));
  792. ViewPtrs[I]:=LV;
  793. end;
  794. vtInputLine :
  795. begin
  796. MaxLen:=F^.GetIntEntry(ViewNames[I],tieMaxLen,80);
  797. New(IL, Init(ViewBounds[I], MaxLen));
  798. IL^.Data^:=ViewValues[I];
  799. ViewPtrs[I]:=IL;
  800. end;
  801. vtCheckBox :
  802. begin
  803. New(CB, Init(ViewBounds[I],
  804. NewSItem(
  805. F^.GetEntry(ViewNames[I],tieName,''),
  806. nil)));
  807. if StrToInt(ViewValues[I])=1 then
  808. CB^.Press(0);
  809. ViewPtrs[I]:=CB;
  810. end;
  811. vtRadioButton :
  812. begin
  813. SI:=nil;
  814. for J:=ViewItemCount[I] downto 1 do
  815. SI:=NewSItem(F^.GetEntry(ViewNames[I],tieItem+IntToStr(J),''),SI);
  816. New(RB, Init(ViewBounds[I], SI));
  817. RB^.Press(StrToInt(ViewValues[I]));
  818. ViewPtrs[I]:=RB;
  819. end;
  820. end;
  821. Insert(ViewPtrs[I]);
  822. end;
  823. end;
  824. InsertButtons(PromptDialog);
  825. S:=F^.GetEntry(secMain,tmeDefaultView,'');
  826. if S<>'' then
  827. begin
  828. S:=UpcaseStr(S);
  829. I:=0;
  830. while (I<ViewCount) and (UpcaseStr(ViewNames[I])<>S) do
  831. Inc(I);
  832. if UpcaseStr(ViewNames[I])=S then
  833. ViewPtrs[I]^.Select;
  834. end;
  835. Re:=Desktop^.ExecView(PromptDialog);
  836. OK:=OK and (Re=cmOK);
  837. AbortTool:=(Re<>cmOK);
  838. if OK then OK:=ExtractPromptDialogParams(F,Params);
  839. if PromptDialog<>nil then Dispose(PromptDialog, Done);
  840. ExecPromptDialog:=OK;
  841. end;
  842. var OK: boolean;
  843. F: PINIFile;
  844. Fn : string;
  845. begin
  846. Fn:=LocateFile(FileName);
  847. if Fn='' then
  848. Fn:=FileName;
  849. if not ExistsFile(Fn) then
  850. ErrorBox('Can''t read '+Fn,nil)
  851. else
  852. begin
  853. New(F, Init(Fn));
  854. OK:=F<>nil;
  855. if OK then
  856. begin
  857. OK:=BuildPromptDialogInfo(F);
  858. if OK then
  859. OK:=ExecPromptDialog(F);
  860. end;
  861. if F<>nil then Dispose(F, Done);
  862. end;
  863. ExecutePromptDialog:=OK;
  864. end;
  865. function ParseToolParams(var Params: string; CheckOnly: boolean): integer;
  866. var Err: integer;
  867. W: PSourceWindow;
  868. procedure ParseParams(Pass: sw_integer);
  869. var I: sw_integer;
  870. function IsAlpha(Ch: char): boolean;
  871. begin
  872. IsAlpha:=(Upcase(Ch) in['A'..'Z','_','$']);
  873. end;
  874. function ReplacePart(StartP,EndP: integer; const S: string): integer;
  875. begin
  876. Params:=copy(Params,1,StartP-1)+S+copy(Params,EndP+1,255);
  877. ReplacePart:=length(S)-(EndP-StartP+1);
  878. end;
  879. function Consume(Ch: char): boolean;
  880. var OK: boolean;
  881. begin
  882. OK:=Params[I]=Ch;
  883. if OK then Inc(I);
  884. Consume:=OK;
  885. end;
  886. function ReadTill(var S: string; C: char): boolean;
  887. var Found: boolean;
  888. begin
  889. Found:=false; S:='';
  890. while (I<=length(Params)) and (Found=false) do
  891. begin
  892. Found:=Params[I]=C;
  893. if Found=false then
  894. begin
  895. S:=S+Params[I];
  896. Inc(I);
  897. end;
  898. end;
  899. ReadTill:=Found;
  900. end;
  901. var C,PrevC: char;
  902. WordS: string;
  903. LastWordStart: sw_integer;
  904. L: longint;
  905. S: string;
  906. D: DirStr; N: NameStr; E: ExtStr;
  907. begin
  908. I:=1; WordS:=''; LastWordStart:=I; PrevC:=' ';
  909. while (I<=length(Params)+1) and (Err=0) do
  910. begin
  911. if I<=length(Params) then C:=Params[I];
  912. if (I<=length(Params)) and IsAlpha(C) then
  913. begin
  914. if (I=1) or (IsAlpha(PrevC)=false) then
  915. begin WordS:=''; LastWordStart:=I; end;
  916. { if IsAlpha(C) then ForceConcat:=false;}
  917. WordS:=WordS+C;
  918. end
  919. else
  920. begin
  921. WordS:=UpcaseStr(Trim(WordS));
  922. if WordS<>'' then
  923. if (WordS='$CAP') then
  924. begin
  925. if (Pass=0) then
  926. if (Params[I]=' ') and (I<=255) then Params[I]:='_';
  927. end else
  928. if (WordS='$CAP_MSG') then
  929. begin
  930. if (Pass=2) then
  931. if Consume('(')=false then Err:=I else
  932. if ReadTill(S,')')=false then Err:=I else
  933. begin
  934. Consume(')');
  935. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  936. ToolFilter:=S;
  937. CaptureToolTo:=capMessageWindow;
  938. end;
  939. end else
  940. if (WordS='$CAP_EDIT') then
  941. begin
  942. if (Pass=2) then
  943. begin
  944. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  945. CaptureToolTo:=capEditWindow;
  946. end;
  947. end else
  948. if (WordS='$COL') then
  949. begin
  950. if (Pass=1) then
  951. begin
  952. if W=nil then L:=0 else
  953. L:=W^.Editor^.CurPos.X+1;
  954. I:=I+ReplacePart(LastWordStart,I-1,IntToStr(L))-1;
  955. end;
  956. end else
  957. if (WordS='$CONFIG') then
  958. begin
  959. if (Pass=1) then
  960. I:=I+ReplacePart(LastWordStart,I-1,INIPath)-1;
  961. end else
  962. if (WordS='$DIR') then
  963. begin
  964. if (Pass=2) then
  965. if Consume('(')=false then Err:=I else
  966. if ReadTill(S,')')=false then Err:=I else
  967. begin
  968. Consume(')');
  969. FSplit(S,D,N,E);
  970. L:=Pos(':',D);if L>0 then Delete(D,1,L);
  971. I:=I+ReplacePart(LastWordStart,I-1,D)-1;
  972. end;
  973. end else
  974. if (WordS='$DRIVE') then
  975. begin
  976. if (Pass=2) then
  977. if Consume('(')=false then Err:=I else
  978. if ReadTill(S,')')=false then Err:=I else
  979. begin
  980. Consume(')');
  981. FSplit(S,D,N,E);
  982. L:=Pos(':',D);
  983. D:=copy(D,1,L);
  984. I:=I+ReplacePart(LastWordStart,I-1,D)-1;
  985. end;
  986. end else
  987. if (WordS='$EDNAME') then
  988. begin
  989. if (Pass=1) then
  990. begin
  991. if W=nil then S:='' else
  992. S:=W^.Editor^.FileName;
  993. I:=I+ReplacePart(LastWordStart,I-1,S)-1;
  994. end;
  995. end else
  996. if (WordS='$EXENAME') then
  997. begin
  998. if (Pass=1) then
  999. I:=I+ReplacePart(LastWordStart,I-1,EXEFile)-1;
  1000. end else
  1001. if (WordS='$EXT') then
  1002. begin
  1003. if (Pass=2) then
  1004. if Consume('(')=false then Err:=I else
  1005. if ReadTill(S,')')=false then Err:=I else
  1006. begin
  1007. Consume(')');
  1008. FSplit(S,D,N,E); E:=copy(E,2,255);
  1009. I:=I+ReplacePart(LastWordStart,I-1,E)-1;
  1010. end;
  1011. end else
  1012. if (WordS='$LINE') then
  1013. begin
  1014. if (Pass=1) then
  1015. begin
  1016. if W=nil then L:=0 else
  1017. L:=W^.Editor^.CurPos.Y+1;
  1018. I:=I+ReplacePart(LastWordStart,I-1,IntToStr(L))-1;
  1019. end;
  1020. end else
  1021. if (WordS='$NAME') then
  1022. begin
  1023. if (Pass=2) then
  1024. if Consume('(')=false then Err:=I else
  1025. if ReadTill(S,')')=false then Err:=I else
  1026. begin
  1027. Consume(')');
  1028. FSplit(S,D,N,E);
  1029. I:=I+ReplacePart(LastWordStart,I-1,N)-1;
  1030. end;
  1031. end else
  1032. if (WordS='$NAMEEXT') then
  1033. begin
  1034. if (Pass=2) then
  1035. if Consume('(')=false then Err:=I else
  1036. if ReadTill(S,')')=false then Err:=I else
  1037. begin
  1038. Consume(')');
  1039. FSplit(S,D,N,E);
  1040. I:=I+ReplacePart(LastWordStart,I-1,N+E)-1;
  1041. end;
  1042. end else
  1043. if (WordS='$NOSWAP') then
  1044. begin
  1045. if (Pass=1) then
  1046. begin
  1047. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1048. end;
  1049. end else
  1050. if (WordS='$DRIVE') then
  1051. begin
  1052. if (Pass=2) then
  1053. if Consume('(')=false then Err:=I else
  1054. if ReadTill(S,')')=false then Err:=I else
  1055. begin
  1056. Consume(')');
  1057. FSplit(S,D,N,E);
  1058. L:=Pos(':',D); if L=0 then L:=-1;
  1059. D:=copy(D,1,L+1);
  1060. I:=I+ReplacePart(LastWordStart,I-1,D)-1;
  1061. end;
  1062. end else
  1063. if (WordS='$PROMPT') then
  1064. begin
  1065. if (Pass=3) then
  1066. if Params[I]='(' then
  1067. begin
  1068. if Consume('(')=false then Err:=I else
  1069. if ReadTill(S,')')=false then Err:=I else
  1070. begin
  1071. Consume(')');
  1072. if S='' then Err:=I-1 else
  1073. if CheckOnly=false then
  1074. if ExecutePromptDialog(S,S)=false then
  1075. Err:=I
  1076. else
  1077. I:=I+ReplacePart(LastWordStart,I-1,S)-1;
  1078. end;
  1079. end
  1080. else { just prompt for parms }
  1081. begin
  1082. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1083. if CheckOnly=false then
  1084. begin
  1085. S:=copy(Params,I+1,255);
  1086. if InputBox('Program Arguments', '~E~nter program argument',
  1087. S,255-I+1)=cmOK then
  1088. begin
  1089. ReplacePart(LastWordStart,255,S);
  1090. I:=255;
  1091. end
  1092. else
  1093. Err:=-1;
  1094. end;
  1095. end;
  1096. end else
  1097. if (WordS='$SAVE') then
  1098. begin
  1099. if (Pass=0) then
  1100. if (Params[I]=' ') and (I<=255) then Params[I]:='_';
  1101. end else
  1102. if (WordS='$SAVE_ALL') then
  1103. begin
  1104. if (Pass=2) then
  1105. begin
  1106. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1107. Message(Application,evCommand,cmSaveAll,nil);
  1108. end;
  1109. end else
  1110. if (WordS='$SAVE_CUR') then
  1111. begin
  1112. if (Pass=2) then
  1113. begin
  1114. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1115. Message(W,evCommand,cmSave,nil);
  1116. end;
  1117. end else
  1118. if (WordS='$SAVE_PROMPT') then
  1119. begin
  1120. if (Pass=2) then
  1121. begin
  1122. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1123. if W<>nil then
  1124. if W^.Editor^.SaveAsk=false then
  1125. Err:=-1;
  1126. end;
  1127. end else
  1128. if (WordS='$WRITEMSG') then
  1129. begin
  1130. if (Pass=2) then
  1131. if Consume('(')=false then Err:=I else
  1132. if ReadTill(S,')')=false then Err:=I else
  1133. begin
  1134. Consume(')');
  1135. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1136. if CheckOnly=false then
  1137. WriteToolMessagesToFile(S);
  1138. end;
  1139. end else
  1140. if copy(WordS,1,1)='$' then
  1141. Err:=LastWordStart;
  1142. WordS:='';
  1143. end;
  1144. PrevC:=C;
  1145. Inc(I);
  1146. end;
  1147. end;
  1148. var Pass: sw_integer;
  1149. begin
  1150. AbortTool:=false;
  1151. CaptureToolTo:=capNone;
  1152. ToolFilter:='';
  1153. W:=FirstEditorWindow;
  1154. Err:=0;
  1155. for Pass:=0 to 3 do
  1156. begin
  1157. ParseParams(Pass);
  1158. if Err<>0 then Break;
  1159. end;
  1160. if AbortTool then Err:=-1;
  1161. ParseToolParams:=Err;
  1162. end;
  1163. function ProcessMessageFile(const MsgFileName: string): boolean;
  1164. var OK,Done: boolean;
  1165. S: PBufStream;
  1166. C: char;
  1167. Sign: array[1..10] of char;
  1168. InFileName,InReference: boolean;
  1169. AddChar: boolean;
  1170. FileName,Line: string;
  1171. Row,Col: longint;
  1172. procedure AddLine;
  1173. begin
  1174. Row:=ord(Line[1])+ord(Line[2]) shl 8;
  1175. Col:=ord(Line[3])+ord(Line[4]) shl 8;
  1176. AddToolMessage(FileName,copy(Line,5,255),Row,Col);
  1177. end;
  1178. begin
  1179. New(S, Init(MsgFileName, stOpenRead, 4096));
  1180. OK:=(S<>nil) and (S^.Status=stOK);
  1181. if OK then S^.Read(Sign,SizeOf(Sign));
  1182. OK:=OK and (Sign=MsgFilterSign);
  1183. Done:=false; InFileName:=false; InReference:=false;
  1184. while OK and (Done=false) do
  1185. begin
  1186. S^.Read(C,SizeOf(C));
  1187. OK:=(S^.Status=stOK);
  1188. AddChar:=false;
  1189. if OK then
  1190. case C of
  1191. #0 : if InFileName then
  1192. begin InFileName:=false end else
  1193. if InReference then
  1194. begin
  1195. if (length(Line)>4) then
  1196. begin
  1197. AddLine;
  1198. InReference:=false;
  1199. end
  1200. else
  1201. AddChar:=true;
  1202. end else
  1203. begin InFileName:=true; FileName:=''; end;
  1204. #1 : if InReference then AddChar:=true else
  1205. begin InReference:=true; Line:=''; end;
  1206. #127 : if InReference then AddChar:=true else
  1207. Done:=true;
  1208. else AddChar:=true;
  1209. end;
  1210. if AddChar then
  1211. if InFileName then
  1212. FileName:=FileName+C else
  1213. if InReference then
  1214. Line:=Line+C;
  1215. end;
  1216. if S<>nil then Dispose(S, Done);
  1217. ProcessMessageFile:=OK;
  1218. end;
  1219. constructor TToolMessage.Init(AModule: PString; ALine: string; ARow, ACol: sw_integer);
  1220. begin
  1221. inherited Init(0,ALine,AModule,ARow,ACol);
  1222. end;
  1223. function TToolMessage.GetText(MaxLen: Sw_integer): string;
  1224. var S: string;
  1225. begin
  1226. if Module=nil then
  1227. S:=GetStr(Text)
  1228. else
  1229. S:=NameAndExtOf(GetModuleName)+
  1230. '('+IntToStr(Row)+'): '+GetStr(Text);
  1231. GetText:=copy(S,1,MaxLen);
  1232. end;
  1233. procedure AddToolCommand(Command: string);
  1234. begin
  1235. AddToolMessage('',Command,0,0);
  1236. LastToolMessageFocused:=ToolMessages^.At(ToolMessages^.Count-1);
  1237. end;
  1238. procedure AddToolMessage(ModuleName, Text: string; Row, Col: longint);
  1239. var MN: PString;
  1240. begin
  1241. if ToolMessages=nil then
  1242. New(ToolMessages, Init(500,1000));
  1243. if ToolModuleNames=nil then
  1244. New(ToolModuleNames, Init(50,100));
  1245. MN:=ToolModuleNames^.Add(ModuleName);
  1246. ToolMessages^.Insert(New(PToolMessage, Init(MN,Text,Row,Col)));
  1247. end;
  1248. procedure ClearToolMessages;
  1249. begin
  1250. If assigned(ToolMessages) then
  1251. ToolMessages^.FreeAll;
  1252. If assigned(ToolModuleNames) then
  1253. ToolModuleNames^.FreeAll;
  1254. LastToolMessageFocused:=nil;
  1255. end;
  1256. procedure UpdateToolMessages;
  1257. begin
  1258. if Assigned(MessagesWindow) then
  1259. MessagesWindow^.Update;
  1260. end;
  1261. procedure TToolMessageListBox.Update;
  1262. var P: PMessageItem;
  1263. Idx: integer;
  1264. begin
  1265. P:=LastToolMessageFocused;
  1266. NewList(ToolMessages);
  1267. if (Range>0) and (P<>nil) then
  1268. begin
  1269. Idx:=List^.IndexOf(P);
  1270. if Idx>=0 then
  1271. begin
  1272. FocusItem(Idx);
  1273. DrawView;
  1274. end;
  1275. end;
  1276. DrawView;
  1277. end;
  1278. procedure TToolMessageListBox.NewList(AList: PCollection);
  1279. begin
  1280. if (List=ToolMessages) or (ToolMessages=nil) then
  1281. begin List:=nil; SetRange(0); end;
  1282. inherited NewList(AList);
  1283. end;
  1284. procedure TToolMessageListBox.Clear;
  1285. begin
  1286. ClearToolMessages;
  1287. Update;
  1288. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1289. end;
  1290. function TToolMessageListBox.GetPalette: PPalette;
  1291. const
  1292. P: string[length(CBrowserListBox)] = CBrowserListBox;
  1293. begin
  1294. GetPalette:=@P;
  1295. end;
  1296. constructor TToolMessageListBox.Load(var S: TStream);
  1297. begin
  1298. inherited Load(S);
  1299. end;
  1300. procedure TToolMessageListBox.Store(var S: TStream);
  1301. var OL: PCollection;
  1302. begin
  1303. OL:=List;
  1304. New(List, Init(1,1));
  1305. inherited Store(S);
  1306. Dispose(List, Done);
  1307. List:=OL;
  1308. end;
  1309. destructor TToolMessageListBox.Done;
  1310. begin
  1311. HScrollBar:=nil; VScrollBar:=nil;
  1312. if List=ToolMessages then begin List:=nil; SetRange(0); end;
  1313. inherited Done;
  1314. end;
  1315. constructor TMessagesWindow.Init;
  1316. var R: TRect;
  1317. HSB,VSB: PScrollBar;
  1318. begin
  1319. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-7;
  1320. inherited Init(R,'Messages',SearchFreeWindowNo);
  1321. HelpCtx:=hcMessagesWindow;
  1322. HSB:=StandardScrollBar(sbHorizontal+sbHandleKeyboard); Insert(HSB);
  1323. VSB:=StandardScrollBar(sbVertical+sbHandleKeyboard); Insert(VSB);
  1324. GetExtent(R); R.Grow(-1,-1);
  1325. New(MsgLB, Init(R, HSB, VSB));
  1326. Insert(MsgLB);
  1327. Update;
  1328. MessagesWindow:=@Self;
  1329. end;
  1330. procedure TMessagesWindow.Update;
  1331. begin
  1332. MsgLB^.Update;
  1333. end;
  1334. procedure TMessagesWindow.FocusItem(i : sw_integer);
  1335. begin
  1336. MsgLB^.FocusItem(i);
  1337. end;
  1338. procedure TMessagesWindow.HandleEvent(var Event: TEvent);
  1339. begin
  1340. case Event.What of
  1341. evBroadcast :
  1342. case Event.Command of
  1343. cmListFocusChanged :
  1344. if Event.InfoPtr=MsgLB then
  1345. begin
  1346. LastToolMessageFocused:=MsgLB^.List^.At(MsgLB^.Focused);
  1347. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1348. end;
  1349. end;
  1350. end;
  1351. inherited HandleEvent(Event);
  1352. end;
  1353. procedure TMessagesWindow.SizeLimits(var Min, Max: TPoint);
  1354. begin
  1355. inherited SizeLimits(Min,Max);
  1356. Min.X:=20;
  1357. Min.Y:=4;
  1358. end;
  1359. function TMessagesWindow.GetPalette: PPalette;
  1360. const S: string[length(CBrowserWindow)] = CBrowserWindow;
  1361. begin
  1362. GetPalette:=@S;
  1363. end;
  1364. constructor TMessagesWindow.Load(var S: TStream);
  1365. begin
  1366. inherited Load(S);
  1367. GetSubViewPtr(S,MsgLB);
  1368. Update;
  1369. MessagesWindow:=@Self;
  1370. end;
  1371. procedure TMessagesWindow.Store(var S: TStream);
  1372. begin
  1373. inherited Store(S);
  1374. PutSubViewPtr(S,MsgLB);
  1375. end;
  1376. destructor TMessagesWindow.Done;
  1377. begin
  1378. MessagesWindow:=nil;
  1379. inherited Done;
  1380. end;
  1381. procedure RegisterFPTools;
  1382. begin
  1383. {$ifndef NOOBJREG}
  1384. RegisterType(RToolMessageListBox);
  1385. RegisterType(RMessagesWindow);
  1386. {$endif}
  1387. end;
  1388. END.
  1389. {
  1390. $Log$
  1391. Revision 1.15 2000-02-07 12:00:41 pierre
  1392. Gabor's changes
  1393. Revision 1.14 1999/10/27 10:43:06 pierre
  1394. * avoid dispose problems for ToolMessages
  1395. Revision 1.13 1999/08/03 20:22:37 peter
  1396. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  1397. + Desktop saving should work now
  1398. - History saved
  1399. - Clipboard content saved
  1400. - Desktop saved
  1401. - Symbol info saved
  1402. * syntax-highlight bug fixed, which compared special keywords case sensitive
  1403. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  1404. * with 'whole words only' set, the editor didn't found occourences of the
  1405. searched text, if the text appeared previously in the same line, but didn't
  1406. satisfied the 'whole-word' condition
  1407. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  1408. (ie. the beginning of the selection)
  1409. * when started typing in a new line, but not at the start (X=0) of it,
  1410. the editor inserted the text one character more to left as it should...
  1411. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  1412. * Shift shouldn't cause so much trouble in TCodeEditor now...
  1413. * Syntax highlight had problems recognizing a special symbol if it was
  1414. prefixed by another symbol character in the source text
  1415. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  1416. Revision 1.12 1999/07/28 23:11:24 peter
  1417. * fixes from gabor
  1418. Revision 1.11 1999/07/12 13:14:21 pierre
  1419. * LineEnd bug corrected, now goes end of text even if selected
  1420. + Until Return for debugger
  1421. + Code for Quit inside GDB Window
  1422. Revision 1.10 1999/06/28 19:32:24 peter
  1423. * fixes from gabor
  1424. Revision 1.9 1999/05/22 13:44:32 peter
  1425. * fixed couple of bugs
  1426. Revision 1.8 1999/04/07 21:55:54 peter
  1427. + object support for browser
  1428. * html help fixes
  1429. * more desktop saving things
  1430. * NODEBUG directive to exclude debugger
  1431. Revision 1.7 1999/03/23 15:11:35 peter
  1432. * desktop saving things
  1433. * vesa mode
  1434. * preferences dialog
  1435. Revision 1.6 1999/03/16 12:38:14 peter
  1436. * tools macro fixes
  1437. + tph writer
  1438. + first things for resource files
  1439. Revision 1.5 1999/03/08 14:58:12 peter
  1440. + prompt with dialogs for tools
  1441. Revision 1.4 1999/03/01 15:42:04 peter
  1442. + Added dummy entries for functions not yet implemented
  1443. * MenuBar didn't update itself automatically on command-set changes
  1444. * Fixed Debugging/Profiling options dialog
  1445. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is set
  1446. * efBackSpaceUnindents works correctly
  1447. + 'Messages' window implemented
  1448. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  1449. + Added TP message-filter support (for ex. you can call GREP thru
  1450. GREP2MSG and view the result in the messages window - just like in TP)
  1451. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  1452. so topic search didn't work...
  1453. * In FPHELP.PAS there were still context-variables defined as word instead
  1454. of THelpCtx
  1455. * StdStatusKeys() was missing from the statusdef for help windows
  1456. + Topic-title for index-table can be specified when adding a HTML-files
  1457. Revision 1.3 1999/02/22 02:15:19 peter
  1458. + default extension for save in the editor
  1459. + Separate Text to Find for the grep dialog
  1460. * fixed redir crash with tp7
  1461. Revision 1.2 1999/02/19 15:43:21 peter
  1462. * compatibility fixes for FV
  1463. Revision 1.1 1999/01/21 11:54:25 peter
  1464. + tools menu
  1465. + speedsearch in symbolbrowser
  1466. * working run command
  1467. Revision 1.0 1999/01/16 10:43:31 gabor
  1468. Original implementation
  1469. }