fptools.pas 46 KB

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