fptools.pas 45 KB

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