fptools.pas 42 KB

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