2
0

fptools.pas 44 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634
  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. WEditor,WViews,
  18. FPViews;
  19. const
  20. MsgFilterSign = 'BI#PIP#OK'#0;
  21. type
  22. TCaptureTarget = (capNone,capMessageWindow,capEditWindow,capNoSwap);
  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 : PEditorInputLine;
  58. ProgramIL: PEditorInputLine;
  59. ParamIL : PEditorInputLine;
  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. procedure InitToolProcessing;
  112. function ProcessMessageFile(const MsgFileName: string): boolean;
  113. procedure AddToolCommand(Command: string);
  114. procedure AddToolMessage(ModuleName, Text: string; Row, Col: longint);
  115. procedure ClearToolMessages;
  116. procedure DoneToolMessages;
  117. procedure UpdateToolMessages;
  118. procedure InitToolTempFiles;
  119. procedure DoneToolTempFiles;
  120. const
  121. ToolFilter : string[{$ifndef GABOR}128{$else}40{$endif}] = '';
  122. ToolOutput : string[{$ifndef GABOR}128{$else}40{$endif}] = '';
  123. CaptureToolTo : TCaptureTarget = capNone;
  124. ToolMessages : PCollection = nil;
  125. ToolModuleNames: PStoreCollection = nil;
  126. MessagesWindow : PMessagesWindow = nil;
  127. LastToolMessageFocused : PToolMessage = nil;
  128. LongestTool : sw_integer = 0;
  129. procedure RegisterFPTools;
  130. implementation
  131. uses Dos,
  132. {$ifdef FVISION}
  133. FVConsts,
  134. {$else}
  135. Commands,
  136. {$endif}
  137. App,MsgBox,
  138. WConsts,WUtils,WINI,
  139. FPConst,FPString,FPVars,FPUtils;
  140. {$ifndef NOOBJREG}
  141. const
  142. RToolMessageListBox: TStreamRec = (
  143. ObjType: 1600;
  144. VmtLink: Ofs(TypeOf(TToolMessageListBox)^);
  145. Load: @TToolMessageListBox.Load;
  146. Store: @TToolMessageListBox.Store
  147. );
  148. RMessagesWindow: TStreamRec = (
  149. ObjType: 1601;
  150. VmtLink: Ofs(TypeOf(TMessagesWindow)^);
  151. Load: @TMessagesWindow.Load;
  152. Store: @TMessagesWindow.Store
  153. );
  154. {$endif}
  155. type
  156. THotKeyDef = record
  157. Name : string[12];
  158. KeyCode : word;
  159. end;
  160. const
  161. HotKeys : array[0..9] of THotKeyDef =
  162. ( (Name : '~U~nassigned' ; KeyCode : kbNoKey ),
  163. (Name : 'Shift+F~2~' ; KeyCode : kbShiftF2 ),
  164. (Name : 'Shift+F~3~' ; KeyCode : kbShiftF3 ),
  165. (Name : 'Shift+F~4~' ; KeyCode : kbShiftF4 ),
  166. (Name : 'Shift+F~5~' ; KeyCode : kbShiftF5 ),
  167. (Name : 'Shift+F~6~' ; KeyCode : kbShiftF6 ),
  168. (Name : 'Shift+F~7~' ; KeyCode : kbShiftF7 ),
  169. (Name : 'Shift+F~8~' ; KeyCode : kbShiftF8 ),
  170. (Name : 'Shift+F~9~' ; KeyCode : kbShiftF9 ),
  171. (Name : 'Shift+F~1~0' ; KeyCode : kbShiftF10));
  172. Tools : PToolCollection = nil;
  173. AbortTool : boolean = false;
  174. ToolTempFiles: PUnsortedStringCollection = nil;
  175. function GetHotKeyCount: integer;
  176. begin
  177. GetHotKeyCount:=ord(High(HotKeys))-ord(Low(HotKeys))+1;
  178. end;
  179. function GetHotKeyNameByIdx(Idx: integer): string;
  180. begin
  181. GetHotKeyNameByIdx:=HotKeys[Idx].Name;
  182. end;
  183. function HotKeyToIdx(Key: word): integer;
  184. var Count,I: integer;
  185. Found: boolean;
  186. begin
  187. Count:=GetHotKeyCount; Found:=false;
  188. I:=0;
  189. while (I<Count) and (Found=false) do
  190. begin
  191. Found:=HotKeys[I].KeyCode=Key;
  192. if Found=false then
  193. Inc(I);
  194. end;
  195. if Found=false then I:=-1;
  196. HotKeyToIdx:=I;
  197. end;
  198. function IdxToHotKey(Idx: integer): word;
  199. var Count: integer;
  200. Key: word;
  201. begin
  202. Count:=GetHotKeyCount;
  203. if (0<=Idx) and (Idx<Count) then
  204. Key:=HotKeys[Idx].KeyCode
  205. else
  206. Key:=kbNoKey;
  207. IdxToHotKey:=Key;
  208. end;
  209. function GetHotKeyName(Key: word): string;
  210. var Idx: integer;
  211. S: string;
  212. begin
  213. Idx:=HotKeyToIdx(Key);
  214. if Idx=0 then S:='' else
  215. if Idx=-1 then S:='???' else
  216. S:=GetHotKeyNameByIdx(Idx);
  217. GetHotKeyName:=S;
  218. end;
  219. function WriteToolMessagesToFile(FileName: string): boolean;
  220. var OK: boolean;
  221. f: text;
  222. M: PToolMessage;
  223. I: sw_integer;
  224. begin
  225. I:=0;
  226. Assign(f,FileName);
  227. {$I-}
  228. Rewrite(f);
  229. OK:=EatIO=0;
  230. if Assigned(ToolMessages) then
  231. while OK and (I<ToolMessages^.Count) do
  232. begin
  233. M:=ToolMessages^.At(I);
  234. writeln(f,GetStr(M^.Module)+#0+GetStr(M^.Text)+#0+IntToStr(M^.Row)+#0+IntToStr(M^.Col));
  235. Inc(I);
  236. OK:=EatIO=0;
  237. end;
  238. Close(f);
  239. EatIO;
  240. {$I+}
  241. WriteToolMessagesToFile:=OK;
  242. end;
  243. constructor TTool.Init(const ATitle, AProgramPath, ACommandLine: string; AHotKey: word);
  244. begin
  245. inherited Init;
  246. SetParams(ATitle,AProgramPath,ACommandLine,AHotKey);
  247. end;
  248. function TTool.GetTitle: string;
  249. begin
  250. GetTitle:=KillTilde(GetStr(Title));
  251. end;
  252. procedure TTool.GetParams(var ATitle, AProgramPath, ACommandLine: string; var AHotKey: word);
  253. begin
  254. ATitle:=GetStr(Title); AProgramPath:=GetStr(ProgramPath);
  255. ACommandLine:=GetStr(CommandLine);
  256. AHotKey:=HotKey;
  257. end;
  258. procedure TTool.SetParams(const ATitle, AProgramPath, ACommandLine: string; const AHotKey: word);
  259. begin
  260. if Title<>nil then DisposeStr(Title); Title:=nil;
  261. if ProgramPath<>nil then DisposeStr(ProgramPath); ProgramPath:=nil;
  262. if CommandLine<>nil then DisposeStr(CommandLine); CommandLine:=nil;
  263. Title:=NewStr(ATitle); ProgramPath:=NewStr(AProgramPath);
  264. CommandLine:=NewStr(ACommandLine);
  265. HotKey:=AHotKey;
  266. end;
  267. destructor TTool.Done;
  268. begin
  269. inherited Done;
  270. if Title<>nil then DisposeStr(Title);
  271. if ProgramPath<>nil then DisposeStr(ProgramPath);
  272. if CommandLine<>nil then DisposeStr(CommandLine);
  273. end;
  274. function TToolCollection.At(Index: sw_Integer): PTool;
  275. begin
  276. At:=inherited At(Index);
  277. end;
  278. function TToolListBox.GetText(Item,MaxLen: sw_integer): String;
  279. var S: string;
  280. P: PTool;
  281. begin
  282. P:=List^.At(Item);
  283. S:=P^.GetTitle;
  284. GetText:=copy(S,1,MaxLen);
  285. end;
  286. procedure InitTools;
  287. begin
  288. if Tools<>nil then DoneTools;
  289. New(Tools, Init(10,20));
  290. end;
  291. function GetToolCount: sw_integer;
  292. var Count: integer;
  293. begin
  294. if Tools=nil then Count:=0 else
  295. Count:=Tools^.Count;
  296. GetToolCount:=Count;
  297. end;
  298. function GetToolName(Idx: sw_integer): string;
  299. var S1,S2: string;
  300. W: word;
  301. begin
  302. GetToolParams(Idx,S1,S2,S2,W);
  303. GetToolName:=KillTilde(S1);
  304. end;
  305. function AddTool(Title, ProgramPath, Params: string; HotKey: word): sw_integer;
  306. var P: PTool;
  307. begin
  308. if Tools=nil then InitTools;
  309. New(P, Init(Title,ProgramPath,Params,HotKey));
  310. Tools^.Insert(P);
  311. AddTool:=Tools^.IndexOf(P);
  312. end;
  313. procedure GetToolParams(Idx: sw_integer; var Title, ProgramPath, Params: string; var HotKey: word);
  314. var P: PTool;
  315. begin
  316. P:=Tools^.At(Idx);
  317. P^.GetParams(Title,ProgramPath,Params,HotKey);
  318. end;
  319. procedure SetToolParams(Idx: sw_integer; Title, ProgramPath, Params: string; HotKey: word);
  320. var P: PTool;
  321. begin
  322. P:=Tools^.At(Idx);
  323. P^.GetParams(Title,ProgramPath,Params,HotKey);
  324. end;
  325. procedure DoneTools;
  326. begin
  327. if Tools<>nil then Dispose(Tools, Done); Tools:=nil;
  328. end;
  329. procedure TToolParamValidator.Error;
  330. begin
  331. MsgParms[1].Long:=ErrorPos;
  332. ErrorBox(msg_errorparsingparametersatpos,@MsgParms);
  333. end;
  334. function TToolParamValidator.IsValid(const S: string): Boolean;
  335. var P: string;
  336. begin
  337. P:=S;
  338. ErrorPos:=ParseToolParams(P,true);
  339. IsValid:=ErrorPos=0;
  340. end;
  341. constructor TToolItemDialog.Init(ATool: PTool);
  342. var R,R2,R3: TRect;
  343. Items: PSItem;
  344. I,KeyCount: sw_integer;
  345. begin
  346. KeyCount:=GetHotKeyCount;
  347. R.Assign(0,0,60,Max(3+KeyCount,12));
  348. inherited Init(R,dialog_modifynewtool);
  349. Tool:=ATool;
  350. GetExtent(R); R.Grow(-3,-2); R3.Copy(R);
  351. Inc(R.A.Y); R.B.Y:=R.A.Y+1; R.B.X:=R.A.X+36;
  352. New(TitleIL, Init(R, 128)); Insert(TitleIL);
  353. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_toolprop_title, TitleIL)));
  354. R.Move(0,3);
  355. New(ProgramIL, Init(R, 128)); Insert(ProgramIL);
  356. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_toolprop_programpath, ProgramIL)));
  357. R.Move(0,3);
  358. New(ParamIL, Init(R, 128)); Insert(ParamIL);
  359. ParamIL^.SetValidator(New(PToolParamValidator, Init));
  360. R2.Copy(R); R2.Move(-1,-1); Insert(New(PLabel, Init(R2, label_toolprop_commandline, ParamIL)));
  361. R.Copy(R3); Inc(R.A.X,38); R.B.Y:=R.A.Y+KeyCount;
  362. Items:=nil;
  363. for I:=KeyCount-1 downto 0 do
  364. Items:=NewSItem(GetHotKeyNameByIdx(I), Items);
  365. New(HotKeyRB, Init(R, Items));
  366. Insert(HotKeyRB);
  367. InsertButtons(@Self);
  368. TitleIL^.Select;
  369. end;
  370. function TToolItemDialog.Execute: Word;
  371. var R: word;
  372. S1,S2,S3: string;
  373. W: word;
  374. L: longint;
  375. begin
  376. Tool^.GetParams(S1,S2,S3,W);
  377. TitleIL^.SetData(S1); ProgramIL^.SetData(S2); ParamIL^.SetData(S3);
  378. L:=HotKeyToIdx(W); if L=-1 then L:=255;
  379. HotKeyRB^.SetData(L);
  380. R:=inherited Execute;
  381. if R=cmOK then
  382. begin
  383. TitleIL^.GetData(S1); ProgramIL^.GetData(S2); ParamIL^.GetData(S3);
  384. HotKeyRB^.GetData(L); W:=IdxToHotKey(L);
  385. Tool^.SetParams(S1,S2,S3,W);
  386. end;
  387. Execute:=R;
  388. end;
  389. constructor TToolsDialog.Init;
  390. var R,R2,R3: TRect;
  391. SB: PScrollBar;
  392. begin
  393. R.Assign(0,0,46,16);
  394. inherited Init(R,dialog_tools);
  395. HelpCtx:=hcTools;
  396. GetExtent(R); R.Grow(-3,-2); Inc(R.A.Y); R3.Copy(R); Dec(R.B.X,12);
  397. R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
  398. New(SB, Init(R2)); Insert(SB);
  399. New(ToolsLB, Init(R,1,SB));
  400. Insert(ToolsLB);
  401. R2.Copy(R); R2.Move(0,-1); R2.B.Y:=R2.A.Y+1; Dec(R2.A.X);
  402. Insert(New(PLabel, Init(R2, label_tools_programtitles, ToolsLB)));
  403. R.Copy(R3); R.A.X:=R.B.X-10; R.B.Y:=R.A.Y+2;
  404. Insert(New(PButton, Init(R, button_OK, cmOK, bfNormal)));
  405. R.Move(0,2);
  406. Insert(New(PButton, Init(R, button_Edit, cmEditItem, bfDefault)));
  407. R.Move(0,2);
  408. Insert(New(PButton, Init(R, button_New, cmAddItem, bfNormal)));
  409. R.Move(0,2);
  410. Insert(New(PButton, Init(R, button_Delete, cmDeleteItem, bfNormal)));
  411. R.Move(0,2);
  412. Insert(New(PButton, Init(R, button_Cancel, cmCancel, bfNormal)));
  413. SelectNext(false);
  414. end;
  415. procedure TToolsDialog.HandleEvent(var Event: TEvent);
  416. var DontClear: boolean;
  417. begin
  418. case Event.What of
  419. evKeyDown :
  420. begin
  421. DontClear:=false;
  422. case Event.KeyCode of
  423. kbIns :
  424. Message(@Self,evCommand,cmAddItem,nil);
  425. kbDel :
  426. Message(@Self,evCommand,cmDeleteItem,nil);
  427. else DontClear:=true;
  428. end;
  429. if DontClear=false then ClearEvent(Event);
  430. end;
  431. evBroadcast :
  432. case Event.Command of
  433. cmListItemSelected :
  434. if Event.InfoPtr=pointer(ToolsLB) then
  435. Message(@Self,evCommand,cmEditItem,nil);
  436. end;
  437. evCommand :
  438. begin
  439. DontClear:=false;
  440. case Event.Command of
  441. cmAddItem : Add;
  442. cmDeleteItem : Delete;
  443. cmEditItem : Edit;
  444. else DontClear:=true;
  445. end;
  446. if DontClear=false then ClearEvent(Event);
  447. end;
  448. end;
  449. inherited HandleEvent(Event);
  450. end;
  451. function TToolsDialog.Execute: Word;
  452. var R: word;
  453. C: PToolCollection;
  454. I: integer;
  455. S1,S2,S3: string;
  456. W: word;
  457. begin
  458. New(C, Init(10,20));
  459. if Tools<>nil then
  460. for I:=0 to Tools^.Count-1 do
  461. begin
  462. Tools^.At(I)^.GetParams(S1,S2,S3,W);
  463. C^.Insert(New(PTool, Init(S1,S2,S3,W)));
  464. end;
  465. ToolsLB^.NewList(C);
  466. R:=inherited Execute;
  467. if R=cmOK then
  468. begin
  469. if Tools<>nil then Dispose(Tools, Done);
  470. Tools:=C;
  471. Message(Application,evBroadcast,cmUpdateTools,nil);
  472. end
  473. else
  474. Dispose(C, Done);
  475. Execute:=R;
  476. end;
  477. procedure TToolsDialog.Add;
  478. var P: PTool;
  479. IC: boolean;
  480. S1,S2,S3: string;
  481. W: word;
  482. begin
  483. if ToolsLB^.Range>=MaxToolCount then
  484. begin InformationBox(msg_cantinstallmoretools,nil); Exit; end;
  485. IC:=ToolsLB^.Range=0;
  486. if IC=false then
  487. begin
  488. P:=ToolsLB^.List^.At(ToolsLB^.Focused);
  489. P^.GetParams(S1,S2,S3,W);
  490. end
  491. else
  492. begin
  493. S1:=''; S2:=''; S3:=''; W:=0;
  494. end;
  495. New(P, Init(S1,S2,S3,W));
  496. if Application^.ExecuteDialog(New(PToolItemDialog, Init(P)), nil)=cmOK then
  497. begin
  498. ToolsLB^.List^.Insert(P);
  499. ToolsLB^.SetRange(ToolsLB^.List^.Count);
  500. ReDraw;
  501. end
  502. else
  503. Dispose(P, Done);
  504. end;
  505. procedure TToolsDialog.Edit;
  506. var P: PTool;
  507. begin
  508. if ToolsLB^.Range=0 then Exit;
  509. P:=ToolsLB^.List^.At(ToolsLB^.Focused);
  510. Application^.ExecuteDialog(New(PToolItemDialog, Init(P)), nil);
  511. ReDraw;
  512. end;
  513. procedure TToolsDialog.Delete;
  514. begin
  515. if ToolsLB^.Range=0 then Exit;
  516. ToolsLB^.List^.AtFree(ToolsLB^.Focused);
  517. ToolsLB^.SetRange(ToolsLB^.List^.Count);
  518. ReDraw;
  519. end;
  520. (*procedure ReplaceStr(var S: string; const What,NewS: string);
  521. var I : integer;
  522. begin
  523. repeat
  524. I:=Pos(What,S);
  525. if I>0 then
  526. begin
  527. Delete(S,I,length(What));
  528. Insert(NewS,S,I);
  529. end;
  530. until I=0;
  531. end;
  532. procedure ReplaceStrI(var S: string; What: string; const NewS: string);
  533. var I : integer;
  534. UpcaseS: string;
  535. begin
  536. UpcaseS:=UpcaseStr(S); What:=UpcaseStr(What);
  537. repeat
  538. I:=Pos(What,UpcaseS);
  539. if I>0 then
  540. begin
  541. Delete(S,I,length(What));
  542. Insert(NewS,S,I);
  543. end;
  544. until I=0;
  545. end;*)
  546. function GetCoordEntry(F: PINIFile; Section, Entry: string; var P: TPoint): boolean;
  547. var OK: boolean;
  548. S: string;
  549. Px: integer;
  550. begin
  551. S:=F^.GetEntry(Section,Entry,'');
  552. S:=Trim(S);
  553. OK:=(S<>'') and (S[1]='(') and (S[length(S)]=')');
  554. if OK then S:=copy(S,2,length(S)-2);
  555. Px:=Pos(',',S);
  556. OK:=OK and (Px>0);
  557. if OK then P.X:=StrToInt(copy(S,1,Px-1));
  558. OK:=OK and (LastStrToIntResult=0);
  559. if OK then P.Y:=StrToInt(copy(S,Px+1,High(S)));
  560. OK:=OK and (LastStrToIntResult=0);
  561. GetCoordEntry:=OK;
  562. end;
  563. function ExecutePromptDialog(const FileName: string; var Params: string): boolean;
  564. const
  565. MaxViews = 20;
  566. MaxViewNameLen = 40;
  567. MaxValueLen = 80;
  568. secMain = 'MAIN';
  569. { Main section entries }
  570. tmeTitle = 'TITLE';
  571. tmeCommandLine = 'COMMANDLINE';
  572. tmeSize = 'SIZE';
  573. tmeDefaultView = 'DEFAULT';
  574. { View section entries }
  575. tieType = 'TYPE';
  576. tieOrigin = 'ORIGIN';
  577. tieSize = 'SIZE';
  578. {*} tieDefault = 'DEFAULT';
  579. tieValue = 'VALUE';
  580. { Additional CheckBox view section entries }
  581. tieName = 'NAME';
  582. tieOnParm = 'ON';
  583. tieOffParm = 'OFF';
  584. { Additional CheckBox view section entries }
  585. tieItem = 'ITEM';
  586. tieParam = 'PARAM';
  587. { Additional InputLine view section entries }
  588. tieMaxLen = 'MAXLEN';
  589. { Additional Label view section entries }
  590. tieLink = 'LINK';
  591. tieText = 'TEXT';
  592. { Additional Memo view section entries }
  593. tieFileName = 'FILENAME';
  594. { View types }
  595. vtCheckBox = 1;
  596. vtRadioButton = 2;
  597. vtInputLine = 3;
  598. vtMemo = 4;
  599. vtLabel = 127;
  600. vtsCheckBox = 'CHECKBOX';
  601. vtsRadioButton = 'RADIOBUTTON';
  602. vtsInputLine = 'INPUTLINE';
  603. vtsLabel = 'LABEL';
  604. vtsMemo = 'MEMO';
  605. var Title : string;
  606. DSize : TPoint;
  607. CmdLine : string;
  608. ViewCount : Sw_integer;
  609. ViewNames : array[0..MaxViews-1] of string[MaxViewNameLen];
  610. ViewTypes : array[0..MaxViews-1] of byte;
  611. ViewBounds : array[0..MaxViews-1] of TRect;
  612. ViewPtrs : array[0..MaxViews-1] of PView;
  613. ViewValues : array[0..MaxViews-1] of string[MaxValueLen];
  614. ViewItemCount: array[0..MaxViews-1] of sw_integer;
  615. function BuildPromptDialogInfo(F: PINIFile): boolean;
  616. var
  617. OK: boolean;
  618. _IS: PINISection;
  619. procedure ProcessSection(Sec: PINISection);{$ifndef FPC}far;{$endif}
  620. var P1,P2: TPoint;
  621. Typ: string;
  622. Count: sw_integer;
  623. begin
  624. if (OK=false) or
  625. ( (UpcaseStr(Sec^.GetName)=secMain) or
  626. (UpcaseStr(Sec^.GetName)=UpcaseStr(MainSectionName)) ) then
  627. Exit;
  628. ViewItemCount[ViewCount]:=0;
  629. OK:=(Sec^.SearchEntry(tieType)<>nil) and
  630. (Sec^.SearchEntry(tieOrigin)<>nil) and
  631. (Sec^.SearchEntry(tieSize)<>nil);
  632. if OK=false then
  633. begin ErrorBox(FormatStrStr(msg_requiredparametermissingin,Sec^.GetName),nil); Exit; end;
  634. Typ:=UpcaseStr(Trim(F^.GetEntry(Sec^.GetName,tieType,'')));
  635. if Typ=vtsCheckBox then ViewTypes[ViewCount]:=vtCheckBox else
  636. if Typ=vtsRadioButton then ViewTypes[ViewCount]:=vtRadioButton else
  637. if Typ=vtsInputLine then ViewTypes[ViewCount]:=vtInputLine else
  638. if Typ=vtsLabel then ViewTypes[ViewCount]:=vtLabel else
  639. if Typ=vtsMemo then ViewTypes[ViewCount]:=vtMemo else
  640. begin OK:=false; ErrorBox(FormatStrStr(msg_unknowntypein,Sec^.GetName),nil); Exit; end;
  641. ViewNames[ViewCount]:=Sec^.GetName;
  642. GetCoordEntry(F,Sec^.GetName,tieOrigin,P1);
  643. GetCoordEntry(F,Sec^.GetName,tieSize,P2);
  644. ViewBounds[ViewCount].Assign(P1.X,P1.Y,P1.X+P2.X,P1.Y+P2.Y);
  645. { allow conversion of $EDNAME for instance in
  646. default values PM }
  647. Typ:=F^.GetEntry(Sec^.GetName,tieValue,'');
  648. ParseToolParams(Typ,true);
  649. ViewValues[ViewCount]:=Typ;
  650. case ViewTypes[ViewCount] of
  651. vtLabel :
  652. begin
  653. OK:=OK and (Sec^.SearchEntry(tieLink)<>nil) and
  654. (Sec^.SearchEntry(tieText)<>nil);
  655. if OK=false then
  656. begin ErrorBox(FormatStrStr(msg_requiredpropertymissingin,Sec^.GetName),nil); Exit; end;
  657. end;
  658. vtInputLine : ;
  659. vtMemo : ;
  660. vtCheckBox :
  661. begin
  662. OK:=OK and (Sec^.SearchEntry(tieName)<>nil);
  663. if Typ='' then
  664. Typ:=tieOffParm;
  665. if F^.GetEntry(Sec^.GetName,tieDefault,'')<>'' then
  666. begin
  667. Typ:=F^.GetEntry(Sec^.GetName,tieDefault,'');
  668. end;
  669. Typ:=UpcaseStr(Trim(Typ));
  670. if Typ=tieOnParm then
  671. Typ:='1'
  672. else if Typ=tieOffParm then
  673. Typ:='0'
  674. else if (Typ<>'0') and (Typ<>'1') then
  675. Ok:=false;
  676. ViewValues[ViewCount]:=Typ;
  677. if OK=false then
  678. begin ErrorBox(FormatStrStr2(msg_propertymissingin,tieName,Sec^.GetName),nil); Exit; end;
  679. end;
  680. vtRadioButton:
  681. begin
  682. Count:=0;
  683. while Sec^.SearchEntry(tieItem+IntToStr(Count+1))<>nil do
  684. Inc(Count);
  685. ViewItemCount[ViewCount]:=Count;
  686. OK:=Count>0;
  687. if OK=false then
  688. begin ErrorBox(FormatStrStr(msg_invaliditemsin,Sec^.GetName),nil); Exit; end;
  689. end;
  690. end;
  691. if OK then Inc(ViewCount);
  692. end;
  693. begin
  694. BuildPromptDialogInfo:=false;
  695. _IS:=F^.SearchSection(secMain);
  696. OK:=_IS<>nil;
  697. if OK then OK:=(_IS^.SearchEntry(tmeTitle)<>nil) and
  698. (_IS^.SearchEntry(tmeSize)<>nil) and
  699. (_IS^.SearchEntry(tmeCommandLine)<>nil);
  700. if OK then
  701. begin
  702. Title:=F^.GetEntry(secMain,tmeTitle,'');
  703. OK:=OK and GetCoordEntry(F,secMain,tmeSize,DSize);
  704. CmdLine:=F^.GetEntry(secMain,tmeCommandLine,'');
  705. OK:=OK and (CmdLine<>'');
  706. end;
  707. if OK=false then
  708. begin ErrorBox(FormatStrStr(msg_requiredpropertymissingin,_IS^.GetName),nil); Exit; end;
  709. if OK then
  710. begin
  711. ViewCount:=0;
  712. F^.ForEachSection(@ProcessSection);
  713. end;
  714. BuildPromptDialogInfo:=OK;
  715. end;
  716. function SearchViewByName(Name: string): integer;
  717. var I,Idx: Sw_integer;
  718. begin
  719. Idx:=-1; Name:=UpcaseStr(Name);
  720. for I:=0 to ViewCount-1 do
  721. if UpcaseStr(ViewNames[I])=Name then
  722. begin
  723. Idx:=I;
  724. Break;
  725. end;
  726. SearchViewByName:=Idx;
  727. end;
  728. function GetParamValueStr(F: PINIFile; Idx: integer): string;
  729. var S: string;
  730. Entry: string[20];
  731. begin
  732. S:='???';
  733. case ViewTypes[Idx] of
  734. vtLabel :
  735. S:='';
  736. vtMemo :
  737. begin
  738. S:=F^.GetEntry(ViewNames[Idx],tieFileName,'');
  739. if S='' then S:=GenTempFileName;
  740. ToolTempFiles^.InsertStr(S);
  741. if PFPMemo(ViewPtrs[Idx])^.SaveToFile(S)=false then
  742. ErrorBox(FormatStrStr(msg_errorsavingfile,S),nil);
  743. end;
  744. vtInputLine :
  745. S:=PInputLine(ViewPtrs[Idx])^.Data^;
  746. vtCheckBox :
  747. with PCheckBoxes(ViewPtrs[Idx])^ do
  748. begin
  749. if Mark(0) then Entry:=tieOnParm else Entry:=tieOffParm;
  750. S:=F^.GetEntry(ViewNames[Idx],Entry,'');
  751. end;
  752. vtRadioButton :
  753. with PRadioButtons(ViewPtrs[Idx])^ do
  754. begin
  755. Entry:=tieParam+IntToStr(Value+1);
  756. S:=F^.GetEntry(ViewNames[Idx],Entry,'');
  757. end;
  758. end;
  759. GetParamValueStr:=S;
  760. end;
  761. function ExtractPromptDialogParams(F: PINIFile; var Params: string): boolean;
  762. function ReplacePart(StartP,EndP: integer; const S: string): integer;
  763. begin
  764. Params:=copy(Params,1,StartP-1)+S+copy(Params,EndP+1,255);
  765. ReplacePart:=length(S)-(EndP-StartP+1);
  766. end;
  767. var OptName: string;
  768. OK: boolean;
  769. C: char;
  770. OptStart: integer;
  771. InOpt: boolean;
  772. I,Idx: integer;
  773. S: string;
  774. begin
  775. Params:=CmdLine;
  776. I:=1; InOpt:=false; OK:=true;
  777. while OK and (I<=length(Params)) do
  778. begin
  779. C:=Params[I];
  780. if C='%' then
  781. begin
  782. InOpt:=not InOpt;
  783. if InOpt then
  784. begin
  785. OptName:='';
  786. OptStart:=I;
  787. end
  788. else
  789. begin
  790. OptName:=UpcaseStr(OptName);
  791. Idx:=SearchViewByName(OptName);
  792. OK:=Idx<>-1;
  793. if OK then
  794. begin
  795. S:=GetParamValueStr(F,Idx);
  796. if (S='') and (Params[I+1]=' ') then Inc(I);
  797. I:=I+ReplacePart(OptStart,I,S);
  798. end;
  799. end;
  800. end
  801. else
  802. if InOpt then
  803. OptName:=OptName+C;
  804. Inc(I);
  805. end;
  806. ExtractPromptDialogParams:=OK;
  807. end;
  808. function ExecPromptDialog(F: PINIFile): boolean;
  809. var R: TRect;
  810. PromptDialog: PCenterDialog;
  811. Re: integer;
  812. OK: boolean;
  813. I,J,MaxLen: integer;
  814. Memo: PFPMemo;
  815. IL: PEditorInputLine;
  816. CB: PCheckBoxes;
  817. RB: PRadioButtons;
  818. LV: PLabel;
  819. SI: PSItem;
  820. S: string;
  821. P: PView;
  822. begin
  823. OK:=true;
  824. R.Assign(0,0,DSize.X,DSize.Y);
  825. New(PromptDialog, Init(R, Title));
  826. with PromptDialog^ do
  827. begin
  828. for I:=0 to ViewCount-1 do
  829. begin
  830. case ViewTypes[I] of
  831. vtLabel :
  832. begin
  833. S:=F^.GetEntry(ViewNames[I],tieLink,'');
  834. J:=SearchViewByName(S);
  835. if J=-1 then P:=nil else
  836. P:=ViewPtrs[J];
  837. S:=F^.GetEntry(ViewNames[I],tieText,'');
  838. New(LV, Init(ViewBounds[I], S, P));
  839. ViewPtrs[I]:=LV;
  840. end;
  841. vtInputLine :
  842. begin
  843. MaxLen:=F^.GetIntEntry(ViewNames[I],tieMaxLen,80);
  844. New(IL, Init(ViewBounds[I], MaxLen));
  845. IL^.Data^:=ViewValues[I];
  846. ViewPtrs[I]:=IL;
  847. end;
  848. vtMemo :
  849. begin
  850. { MaxLen:=F^.GetIntEntry(ViewNames[I],tieMaxLen,80);}
  851. New(Memo, Init(ViewBounds[I],nil,nil,nil));
  852. if ViewValues[I]<>'' then
  853. begin
  854. Memo^.AddLine(ViewValues[I]);
  855. Memo^.TextEnd;
  856. end;
  857. ViewPtrs[I]:=Memo;
  858. end;
  859. vtCheckBox :
  860. begin
  861. New(CB, Init(ViewBounds[I],
  862. NewSItem(
  863. F^.GetEntry(ViewNames[I],tieName,''),
  864. nil)));
  865. if StrToInt(ViewValues[I])=1 then
  866. CB^.Press(0);
  867. ViewPtrs[I]:=CB;
  868. end;
  869. vtRadioButton :
  870. begin
  871. SI:=nil;
  872. for J:=ViewItemCount[I] downto 1 do
  873. SI:=NewSItem(F^.GetEntry(ViewNames[I],tieItem+IntToStr(J),''),SI);
  874. New(RB, Init(ViewBounds[I], SI));
  875. RB^.Press(StrToInt(ViewValues[I]));
  876. ViewPtrs[I]:=RB;
  877. end;
  878. end;
  879. Insert(ViewPtrs[I]);
  880. end;
  881. end;
  882. InsertButtons(PromptDialog);
  883. S:=F^.GetEntry(secMain,tmeDefaultView,'');
  884. if S<>'' then
  885. begin
  886. S:=UpcaseStr(S);
  887. I:=0;
  888. while (I<ViewCount) and (UpcaseStr(ViewNames[I])<>S) do
  889. Inc(I);
  890. if UpcaseStr(ViewNames[I])=S then
  891. ViewPtrs[I]^.Select;
  892. end;
  893. Re:=Desktop^.ExecView(PromptDialog);
  894. OK:=OK and (Re=cmOK);
  895. AbortTool:=(Re<>cmOK);
  896. if OK then OK:=ExtractPromptDialogParams(F,Params);
  897. if PromptDialog<>nil then Dispose(PromptDialog, Done);
  898. ExecPromptDialog:=OK;
  899. end;
  900. var OK: boolean;
  901. F: PINIFile;
  902. Fn : string;
  903. begin
  904. Fn:=LocateFile(FileName);
  905. if Fn='' then
  906. Fn:=FileName;
  907. if not ExistsFile(Fn) then
  908. ErrorBox('Can''t read '+Fn,nil)
  909. else
  910. begin
  911. New(F, Init(Fn));
  912. OK:=F<>nil;
  913. if OK then
  914. begin
  915. OK:=BuildPromptDialogInfo(F);
  916. if OK then
  917. OK:=ExecPromptDialog(F);
  918. end;
  919. if F<>nil then Dispose(F, Done);
  920. end;
  921. ExecutePromptDialog:=OK;
  922. end;
  923. function ParseToolParams(var Params: string; CheckOnly: boolean): integer;
  924. var Err: integer;
  925. W: PSourceWindow;
  926. procedure ParseParams(Pass: sw_integer);
  927. var I: sw_integer;
  928. function IsAlpha(Ch: char): boolean;
  929. begin
  930. IsAlpha:=(Upcase(Ch) in['A'..'Z','_','$']);
  931. end;
  932. function ReplacePart(StartP,EndP: integer; const S: string): integer;
  933. begin
  934. Params:=copy(Params,1,StartP-1)+S+copy(Params,EndP+1,255);
  935. ReplacePart:=length(S)-(EndP-StartP+1);
  936. end;
  937. function Consume(Ch: char): boolean;
  938. var OK: boolean;
  939. begin
  940. OK:=Params[I]=Ch;
  941. if OK then Inc(I);
  942. Consume:=OK;
  943. end;
  944. function ReadTill(var S: string; C: char): boolean;
  945. var Found: boolean;
  946. begin
  947. Found:=false; S:='';
  948. while (I<=length(Params)) and (Found=false) do
  949. begin
  950. Found:=Params[I]=C;
  951. if Found=false then
  952. begin
  953. S:=S+Params[I];
  954. Inc(I);
  955. end;
  956. end;
  957. ReadTill:=Found;
  958. end;
  959. var C,PrevC: char;
  960. WordS: string;
  961. LastWordStart: sw_integer;
  962. L: longint;
  963. S: string;
  964. D: DirStr; N: NameStr; E: ExtStr;
  965. begin
  966. I:=1; WordS:=''; LastWordStart:=I; PrevC:=' ';
  967. while (I<=length(Params)+1) and (Err=0) do
  968. begin
  969. if I<=length(Params) then C:=Params[I];
  970. if (I<=length(Params)) and IsAlpha(C) then
  971. begin
  972. if (I=1) or (IsAlpha(PrevC)=false) then
  973. begin WordS:=''; LastWordStart:=I; end;
  974. { if IsAlpha(C) then ForceConcat:=false;}
  975. WordS:=WordS+C;
  976. end
  977. else
  978. begin
  979. WordS:=UpcaseStr(Trim(WordS));
  980. if WordS<>'' then
  981. if (WordS='$CAP') then
  982. begin
  983. if (Pass=0) then
  984. if (Params[I]=' ') and (I<=High(Params)) then Params[I]:='_';
  985. end else
  986. if (WordS='$CAP_MSG') then
  987. begin
  988. if (Pass=2) then
  989. if Consume('(')=false then Err:=I else
  990. if ReadTill(S,')')=false then Err:=I else
  991. begin
  992. Consume(')');
  993. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  994. ToolFilter:=S;
  995. CaptureToolTo:=capMessageWindow;
  996. end;
  997. end else
  998. if (WordS='$CAP_EDIT') then
  999. begin
  1000. if (Pass=3) then
  1001. begin
  1002. if Consume('(')=false then
  1003. I:=I+ReplacePart(LastWordStart,I-1,'')-1
  1004. else if ReadTill(S,')')=false then Err:=I else
  1005. begin
  1006. Consume(')');
  1007. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1008. ToolOutput:=S;
  1009. end;
  1010. CaptureToolTo:=capEditWindow;
  1011. end;
  1012. end else
  1013. if (WordS='$COL') then
  1014. begin
  1015. if (Pass=1) then
  1016. begin
  1017. if W=nil then L:=0 else
  1018. L:=W^.Editor^.CurPos.X+1;
  1019. I:=I+ReplacePart(LastWordStart,I-1,IntToStr(L))-1;
  1020. end;
  1021. end else
  1022. if (WordS='$CONFIG') then
  1023. begin
  1024. if (Pass=1) then
  1025. I:=I+ReplacePart(LastWordStart,I-1,IniFileName)-1;
  1026. end else
  1027. if (WordS='$DIR') then
  1028. begin
  1029. if (Pass=2) then
  1030. if Consume('(')=false then Err:=I else
  1031. if ReadTill(S,')')=false then Err:=I else
  1032. begin
  1033. Consume(')');
  1034. FSplit(S,D,N,E);
  1035. L:=Pos(':',D);if L>0 then Delete(D,1,L);
  1036. I:=I+ReplacePart(LastWordStart,I-1,D)-1;
  1037. end;
  1038. end else
  1039. if (WordS='$DRIVE') then
  1040. begin
  1041. if (Pass=2) then
  1042. if Consume('(')=false then Err:=I else
  1043. if ReadTill(S,')')=false then Err:=I else
  1044. begin
  1045. Consume(')');
  1046. FSplit(S,D,N,E);
  1047. L:=Pos(':',D);
  1048. D:=copy(D,1,L);
  1049. I:=I+ReplacePart(LastWordStart,I-1,D)-1;
  1050. end;
  1051. end else
  1052. if (WordS='$EDNAME') then
  1053. begin
  1054. if (Pass=1) then
  1055. begin
  1056. if W=nil then S:='' else
  1057. S:=W^.Editor^.FileName;
  1058. I:=I+ReplacePart(LastWordStart,I-1,S)-1;
  1059. end;
  1060. end else
  1061. if (WordS='$EXENAME') then
  1062. begin
  1063. if (Pass=1) then
  1064. I:=I+ReplacePart(LastWordStart,I-1,EXEFile)-1;
  1065. end else
  1066. if (WordS='$EXT') then
  1067. begin
  1068. if (Pass=2) then
  1069. if Consume('(')=false then Err:=I else
  1070. if ReadTill(S,')')=false then Err:=I else
  1071. begin
  1072. Consume(')');
  1073. FSplit(S,D,N,E); E:=copy(E,2,High(E));
  1074. I:=I+ReplacePart(LastWordStart,I-1,E)-1;
  1075. end;
  1076. end else
  1077. if (WordS='$LINE') then
  1078. begin
  1079. if (Pass=1) then
  1080. begin
  1081. if W=nil then L:=0 else
  1082. L:=W^.Editor^.CurPos.Y+1;
  1083. I:=I+ReplacePart(LastWordStart,I-1,IntToStr(L))-1;
  1084. end;
  1085. end else
  1086. if (WordS='$NAME') then
  1087. begin
  1088. if (Pass=2) then
  1089. if Consume('(')=false then Err:=I else
  1090. if ReadTill(S,')')=false then Err:=I else
  1091. begin
  1092. Consume(')');
  1093. FSplit(S,D,N,E);
  1094. I:=I+ReplacePart(LastWordStart,I-1,N)-1;
  1095. end;
  1096. end else
  1097. if (WordS='$NAMEEXT') then
  1098. begin
  1099. if (Pass=2) then
  1100. if Consume('(')=false then Err:=I else
  1101. if ReadTill(S,')')=false then Err:=I else
  1102. begin
  1103. Consume(')');
  1104. FSplit(S,D,N,E);
  1105. I:=I+ReplacePart(LastWordStart,I-1,N+E)-1;
  1106. end;
  1107. end else
  1108. if (WordS='$NOSWAP') then
  1109. begin
  1110. if (Pass=1) then
  1111. begin
  1112. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1113. CaptureToolTo:=capNoSwap;
  1114. end;
  1115. end else
  1116. if (WordS='$DRIVE') then
  1117. begin
  1118. if (Pass=2) then
  1119. if Consume('(')=false then Err:=I else
  1120. if ReadTill(S,')')=false then Err:=I else
  1121. begin
  1122. Consume(')');
  1123. FSplit(S,D,N,E);
  1124. L:=Pos(':',D); if L=0 then L:=-1;
  1125. D:=copy(D,1,L+1);
  1126. I:=I+ReplacePart(LastWordStart,I-1,D)-1;
  1127. end;
  1128. end else
  1129. if (WordS='$PROMPT') then
  1130. begin
  1131. if (Pass=3) then
  1132. if Params[I]='(' then
  1133. begin
  1134. if Consume('(')=false then Err:=I else
  1135. if ReadTill(S,')')=false then Err:=I else
  1136. begin
  1137. Consume(')');
  1138. if S='' then Err:=I-1 else
  1139. if CheckOnly=false then
  1140. if ExecutePromptDialog(S,S)=false then
  1141. Err:=I
  1142. else
  1143. I:=I+ReplacePart(LastWordStart,I-1,S)-1;
  1144. end;
  1145. end
  1146. else { just prompt for parms }
  1147. begin
  1148. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1149. if CheckOnly=false then
  1150. begin
  1151. S:=copy(Params,I+1,High(Params));
  1152. if InputBox(dialog_programarguments, label_enterprogramargument,
  1153. S,High(Params)-I+1)=cmOK then
  1154. begin
  1155. ReplacePart(LastWordStart,255,S);
  1156. I:=255;
  1157. end
  1158. else
  1159. Err:=-1;
  1160. end;
  1161. end;
  1162. end else
  1163. if (WordS='$SAVE') then
  1164. begin
  1165. if (Pass=0) then
  1166. if (Params[I]=' ') and (I<=High(Params)) then Params[I]:='_';
  1167. end else
  1168. if (WordS='$SAVE_ALL') then
  1169. begin
  1170. if (Pass=2) then
  1171. begin
  1172. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1173. Message(Application,evCommand,cmSaveAll,nil);
  1174. end;
  1175. end else
  1176. if (WordS='$SAVE_CUR') then
  1177. begin
  1178. if (Pass=2) then
  1179. begin
  1180. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1181. Message(W,evCommand,cmSave,nil);
  1182. end;
  1183. end else
  1184. if (WordS='$SAVE_PROMPT') then
  1185. begin
  1186. if (Pass=2) then
  1187. begin
  1188. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1189. if W<>nil then
  1190. if W^.Editor^.SaveAsk(true)=false then
  1191. Err:=-1;
  1192. end;
  1193. end else
  1194. if (WordS='$WRITEMSG') then
  1195. begin
  1196. if (Pass=2) then
  1197. if Consume('(')=false then Err:=I else
  1198. if ReadTill(S,')')=false then Err:=I else
  1199. begin
  1200. Consume(')');
  1201. I:=I+ReplacePart(LastWordStart,I-1,'')-1;
  1202. if CheckOnly=false then
  1203. WriteToolMessagesToFile(S);
  1204. end;
  1205. end else
  1206. if copy(WordS,1,1)='$' then
  1207. Err:=LastWordStart;
  1208. WordS:='';
  1209. end;
  1210. PrevC:=C;
  1211. Inc(I);
  1212. end;
  1213. end;
  1214. var Pass: sw_integer;
  1215. begin
  1216. W:=FirstEditorWindow;
  1217. Err:=0;
  1218. for Pass:=0 to 3 do
  1219. begin
  1220. ParseParams(Pass);
  1221. if Err<>0 then Break;
  1222. end;
  1223. if AbortTool then Err:=-1;
  1224. ParseToolParams:=Err;
  1225. end;
  1226. procedure InitToolProcessing;
  1227. begin
  1228. AbortTool:=false;
  1229. CaptureToolTo:=capNone;
  1230. ToolFilter:='';
  1231. ToolOutput:='';
  1232. end;
  1233. function ProcessMessageFile(const MsgFileName: string): boolean;
  1234. var OK,Done: boolean;
  1235. S: PBufStream;
  1236. C: char;
  1237. Sign: array[1..10] of char;
  1238. InFileName,InReference: boolean;
  1239. AddChar: boolean;
  1240. FileName,Line: string;
  1241. Row,Col: longint;
  1242. procedure AddLine;
  1243. begin
  1244. Row:=ord(Line[1])+ord(Line[2]) shl 8;
  1245. Col:=ord(Line[3])+ord(Line[4]) shl 8;
  1246. AddToolMessage(FileName,copy(Line,5,High(Line)),Row,Col);
  1247. end;
  1248. begin
  1249. New(S, Init(MsgFileName, stOpenRead, 4096));
  1250. OK:=(S<>nil) and (S^.Status=stOK);
  1251. if OK then S^.Read(Sign,SizeOf(Sign));
  1252. OK:=OK and (Sign=MsgFilterSign);
  1253. Done:=false; InFileName:=false; InReference:=false;
  1254. while OK and (Done=false) do
  1255. begin
  1256. S^.Read(C,SizeOf(C));
  1257. OK:=(S^.Status=stOK);
  1258. AddChar:=false;
  1259. if OK then
  1260. case C of
  1261. #0 : if InFileName then
  1262. begin InFileName:=false end else
  1263. if InReference then
  1264. begin
  1265. if (length(Line)>4) then
  1266. begin
  1267. AddLine;
  1268. InReference:=false;
  1269. end
  1270. else
  1271. AddChar:=true;
  1272. end else
  1273. begin InFileName:=true; FileName:=''; end;
  1274. #1 : if InReference then AddChar:=true else
  1275. begin InReference:=true; Line:=''; end;
  1276. #127 : if InReference then AddChar:=true else
  1277. Done:=true;
  1278. else AddChar:=true;
  1279. end;
  1280. if AddChar then
  1281. if InFileName then
  1282. FileName:=FileName+C else
  1283. if InReference then
  1284. Line:=Line+C;
  1285. end;
  1286. if S<>nil then Dispose(S, Done);
  1287. ProcessMessageFile:=OK;
  1288. end;
  1289. procedure InitToolTempFiles;
  1290. begin
  1291. if not Assigned(ToolTempFiles) then
  1292. New(ToolTempFiles, Init(10,10));
  1293. end;
  1294. procedure DoneToolTempFiles;
  1295. procedure DeleteIt(P: PString); {$ifndef FPC}far;{$endif}
  1296. begin
  1297. DeleteFile(GetStr(P));
  1298. end;
  1299. begin
  1300. if not Assigned(ToolTempFiles) then Exit;
  1301. {$ifndef DEBUG}
  1302. ToolTempFiles^.ForEach(@DeleteIt);
  1303. {$endif ndef DEBUG}
  1304. Dispose(ToolTempFiles, Done);
  1305. ToolTempFiles:=nil;
  1306. end;
  1307. constructor TToolMessage.Init(AModule: PString; ALine: string; ARow, ACol: sw_integer);
  1308. begin
  1309. inherited Init(0,ALine,AModule,ARow,ACol);
  1310. if LongestTool<Length(Aline)+Length(GetStr(AModule))+4 then
  1311. LongestTool:=Length(Aline)+Length(GetStr(AModule))+4;
  1312. end;
  1313. function TToolMessage.GetText(MaxLen: Sw_integer): string;
  1314. var S: string;
  1315. begin
  1316. if Module=nil then
  1317. S:=GetStr(Text)
  1318. else
  1319. S:=NameAndExtOf(GetModuleName)+
  1320. '('+IntToStr(Row)+'): '+GetStr(Text);
  1321. GetText:=copy(S,1,MaxLen);
  1322. end;
  1323. procedure AddToolCommand(Command: string);
  1324. begin
  1325. AddToolMessage('',Command,0,0);
  1326. LastToolMessageFocused:=ToolMessages^.At(ToolMessages^.Count-1);
  1327. end;
  1328. procedure AddToolMessage(ModuleName, Text: string; Row, Col: longint);
  1329. var MN: PString;
  1330. begin
  1331. if ToolMessages=nil then
  1332. New(ToolMessages, Init(500,1000));
  1333. if ToolModuleNames=nil then
  1334. New(ToolModuleNames, Init(50,100));
  1335. MN:=ToolModuleNames^.Add(ModuleName);
  1336. ToolMessages^.Insert(New(PToolMessage, Init(MN,Text,Row,Col)));
  1337. end;
  1338. procedure ClearToolMessages;
  1339. begin
  1340. If assigned(ToolMessages) then
  1341. ToolMessages^.FreeAll;
  1342. If assigned(ToolModuleNames) then
  1343. ToolModuleNames^.FreeAll;
  1344. LastToolMessageFocused:=nil;
  1345. LongestTool:=0;
  1346. end;
  1347. procedure DoneToolMessages;
  1348. begin
  1349. If assigned(ToolMessages) then
  1350. begin
  1351. Dispose(ToolMessages,Done);
  1352. ToolMessages:=nil;
  1353. end;
  1354. If assigned(ToolModuleNames) then
  1355. begin
  1356. Dispose(ToolModuleNames,Done);
  1357. ToolModuleNames:=nil;
  1358. end;
  1359. LastToolMessageFocused:=nil;
  1360. LongestTool:=0;
  1361. end;
  1362. procedure UpdateToolMessages;
  1363. begin
  1364. if Assigned(MessagesWindow) then
  1365. MessagesWindow^.Update;
  1366. end;
  1367. procedure TToolMessageListBox.Update;
  1368. var P: PMessageItem;
  1369. Idx: integer;
  1370. begin
  1371. P:=LastToolMessageFocused;
  1372. NewList(ToolMessages);
  1373. if assigned(HScrollBar) then
  1374. HScrollbar^.SetRange(0,LongestTool);
  1375. if (Range>0) and (P<>nil) then
  1376. begin
  1377. Idx:=List^.IndexOf(P);
  1378. if Idx>=0 then
  1379. begin
  1380. FocusItem(Idx);
  1381. DrawView;
  1382. end;
  1383. end;
  1384. DrawView;
  1385. end;
  1386. procedure TToolMessageListBox.NewList(AList: PCollection);
  1387. begin
  1388. if (List=ToolMessages) or (ToolMessages=nil) then
  1389. begin List:=nil; SetRange(0); end;
  1390. inherited NewList(AList);
  1391. end;
  1392. procedure TToolMessageListBox.Clear;
  1393. begin
  1394. ClearToolMessages;
  1395. Update;
  1396. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1397. end;
  1398. function TToolMessageListBox.GetPalette: PPalette;
  1399. const
  1400. P: string[length(CBrowserListBox)] = CBrowserListBox;
  1401. begin
  1402. GetPalette:=@P;
  1403. end;
  1404. constructor TToolMessageListBox.Load(var S: TStream);
  1405. begin
  1406. inherited Load(S);
  1407. end;
  1408. procedure TToolMessageListBox.Store(var S: TStream);
  1409. var OL: PCollection;
  1410. begin
  1411. OL:=List;
  1412. New(List, Init(1,1));
  1413. inherited Store(S);
  1414. Dispose(List, Done);
  1415. List:=OL;
  1416. end;
  1417. destructor TToolMessageListBox.Done;
  1418. begin
  1419. HScrollBar:=nil; VScrollBar:=nil;
  1420. if List=ToolMessages then begin List:=nil; SetRange(0); end;
  1421. inherited Done;
  1422. end;
  1423. constructor TMessagesWindow.Init;
  1424. var R: TRect;
  1425. HSB,VSB: PScrollBar;
  1426. begin
  1427. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-7;
  1428. inherited Init(R,dialog_messages,SearchFreeWindowNo);
  1429. HelpCtx:=hcMessagesWindow;
  1430. HSB:=StandardScrollBar(sbHorizontal+sbHandleKeyboard); Insert(HSB);
  1431. VSB:=StandardScrollBar(sbVertical+sbHandleKeyboard); Insert(VSB);
  1432. VSB^.SetStep(R.B.Y-R.A.Y-2,1);
  1433. HSB^.SetStep(R.B.X-R.A.X-2,1);
  1434. GetExtent(R); R.Grow(-1,-1);
  1435. New(MsgLB, Init(R, HSB, VSB));
  1436. Insert(MsgLB);
  1437. Update;
  1438. MessagesWindow:=@Self;
  1439. end;
  1440. procedure TMessagesWindow.Update;
  1441. begin
  1442. MsgLB^.Update;
  1443. end;
  1444. procedure TMessagesWindow.FocusItem(i : sw_integer);
  1445. begin
  1446. MsgLB^.FocusItem(i);
  1447. end;
  1448. procedure TMessagesWindow.HandleEvent(var Event: TEvent);
  1449. begin
  1450. case Event.What of
  1451. evBroadcast :
  1452. case Event.Command of
  1453. cmListFocusChanged :
  1454. if Event.InfoPtr=MsgLB then
  1455. begin
  1456. LastToolMessageFocused:=MsgLB^.List^.At(MsgLB^.Focused);
  1457. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1458. end;
  1459. end;
  1460. end;
  1461. inherited HandleEvent(Event);
  1462. end;
  1463. procedure TMessagesWindow.SizeLimits(var Min, Max: TPoint);
  1464. begin
  1465. inherited SizeLimits(Min,Max);
  1466. Min.X:=20;
  1467. Min.Y:=4;
  1468. end;
  1469. function TMessagesWindow.GetPalette: PPalette;
  1470. const S: string[length(CBrowserWindow)] = CBrowserWindow;
  1471. begin
  1472. GetPalette:=@S;
  1473. end;
  1474. constructor TMessagesWindow.Load(var S: TStream);
  1475. begin
  1476. inherited Load(S);
  1477. GetSubViewPtr(S,MsgLB);
  1478. Update;
  1479. MessagesWindow:=@Self;
  1480. end;
  1481. procedure TMessagesWindow.Store(var S: TStream);
  1482. begin
  1483. inherited Store(S);
  1484. PutSubViewPtr(S,MsgLB);
  1485. end;
  1486. destructor TMessagesWindow.Done;
  1487. begin
  1488. MessagesWindow:=nil;
  1489. inherited Done;
  1490. end;
  1491. procedure RegisterFPTools;
  1492. begin
  1493. {$ifndef NOOBJREG}
  1494. RegisterType(RToolMessageListBox);
  1495. RegisterType(RMessagesWindow);
  1496. {$endif}
  1497. end;
  1498. END.
  1499. {
  1500. $Log$
  1501. Revision 1.5 2002-12-18 01:21:16 pierre
  1502. + Use TEditorInputLine instead of TInputLine
  1503. Revision 1.4 2002/09/07 15:40:46 peter
  1504. * old logs removed and tabs fixed
  1505. Revision 1.3 2002/08/29 10:05:01 pierre
  1506. + InitToolProcessing new procedure to set default values only once.
  1507. * handle 'on' 'off' '0' or '1' in value or default lines for checkboxes
  1508. }