fptools.pas 42 KB

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