fptools.pas 48 KB

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