fpcompil.pas 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Compiler call routines for the IDE
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$i globdir.inc}
  13. unit FPCompile;
  14. interface
  15. { don't redir under linux, because all stdout (also from the ide!) will
  16. then be redired (PFV) }
  17. { this should work now correctly because
  18. RedirDisableAll and RedirEnableAll function are added in fpredir (PM) }
  19. { $define VERBOSETXT}
  20. uses
  21. Objects,
  22. Drivers,Views,Dialogs,
  23. WViews,
  24. FPSymbol,
  25. FPViews;
  26. type
  27. TCompileMode = (cBuild,cMake,cCompile,cRun);
  28. type
  29. PCompilerMessage = ^TCompilerMessage;
  30. TCompilerMessage = object(TMessageItem)
  31. function GetText(MaxLen: Sw_Integer): String; virtual;
  32. end;
  33. PCompilerMessageListBox = ^TCompilerMessageListBox;
  34. TCompilerMessageListBox = object(TMessageListBox)
  35. function GetPalette: PPalette; virtual;
  36. procedure SelectFirstError;
  37. end;
  38. PCompilerMessageWindow = ^TCompilerMessageWindow;
  39. TCompilerMessageWindow = object(TFPWindow)
  40. constructor Init;
  41. procedure HandleEvent(var Event: TEvent); virtual;
  42. function GetPalette: PPalette; virtual;
  43. procedure Close;virtual;
  44. destructor Done; virtual;
  45. procedure SizeLimits(var Min, Max: TPoint); virtual;
  46. procedure AddMessage(AClass: longint;const Msg, Module: string; Line, Column: longint);
  47. procedure ClearMessages;
  48. constructor Load(var S: TStream);
  49. procedure Store(var S: TStream);
  50. private
  51. {CompileShowed : boolean;}
  52. Mode : TCompileMode;
  53. MsgLB : PCompilerMessageListBox;
  54. {CurrST,
  55. InfoST : PColorStaticText;}
  56. end;
  57. PCompilerStatusDialog = ^TCompilerStatusDialog;
  58. TCompilerStatusDialog = object(TCenterDialog)
  59. ST : PAdvancedStaticText;
  60. KeyST : PColorStaticText;
  61. constructor Init;
  62. procedure Update;
  63. end;
  64. const
  65. CompilerMessageWindow : PCompilerMessageWindow = nil;
  66. CompilerStatusDialog : PCompilerStatusDialog = nil;
  67. procedure DoCompile(Mode: TCompileMode);
  68. function NeedRecompile(verbose : boolean): boolean;
  69. procedure ParseUserScreen;
  70. procedure RegisterFPCompile;
  71. implementation
  72. uses
  73. {$ifdef linux}
  74. Linux,
  75. {$endif}
  76. Dos,Video,
  77. App,Commands,tokens,
  78. CompHook, Compiler, systems, browcol,
  79. WUtils,WEditor,
  80. FPRedir,FPDesk,FPUsrScr,FPHelp,
  81. FPIde,FPConst,FPVars,FPUtils,FPIntf,FPSwitch;
  82. {$ifndef NOOBJREG}
  83. const
  84. RCompilerMessageListBox: TStreamRec = (
  85. ObjType: 1211;
  86. VmtLink: Ofs(TypeOf(TCompilerMessageListBox)^);
  87. Load: @TCompilerMessageListBox.Load;
  88. Store: @TCompilerMessageListBox.Store
  89. );
  90. RCompilerMessageWindow: TStreamRec = (
  91. ObjType: 1212;
  92. VmtLink: Ofs(TypeOf(TCompilerMessageWindow)^);
  93. Load: @TCompilerMessageWindow.Load;
  94. Store: @TCompilerMessageWindow.Store
  95. );
  96. {$endif}
  97. procedure ParseUserScreen;
  98. var
  99. y : longint;
  100. Text,Attr : String;
  101. DisplayCompilerWindow : boolean;
  102. cc: integer;
  103. procedure SearchBackTrace;
  104. var AText,ModuleName,st : String;
  105. row : longint;
  106. begin
  107. if pos(' 0x',Text)=1 then
  108. begin
  109. AText:=Text;
  110. Delete(Text,1,10);
  111. While pos(' ',Text)=1 do
  112. Delete(Text,1,1);
  113. if pos('of ',Text)>0 then
  114. begin
  115. ModuleName:=Copy(Text,pos('of ',Text)+3,255);
  116. While ModuleName[Length(ModuleName)]=' ' do
  117. Delete(ModuleName,Length(ModuleName),1);
  118. end
  119. else
  120. ModuleName:='';
  121. if pos('line ',Text)>0 then
  122. begin
  123. Text:=Copy(Text,Pos('line ',Text)+5,255);
  124. st:=Copy(Text,1,Pos(' ',Text)-1);
  125. Val(st,row,cc);
  126. end
  127. else
  128. row:=0;
  129. CompilerMessageWindow^.AddMessage(V_Fatal,AText
  130. ,ModuleName,row,1);
  131. DisplayCompilerWindow:=true;
  132. end;
  133. end;
  134. procedure InsertInMessages(Const TypeStr : String;_Type : longint;EnableDisplay : boolean);
  135. var p,p2,col,row : longint;
  136. St,ModuleName : string;
  137. begin
  138. p:=pos(TypeStr,Text);
  139. p2:=Pos('(',Text);
  140. if (p>0) and (p2>0) and (p2<p) then
  141. begin
  142. ModuleName:=Copy(Text,1,p2-1);
  143. st:=Copy(Text,p2+1,255);
  144. Val(Copy(st,1,pos(',',st)-1),row,cc);
  145. st:=Copy(st,Pos(',',st)+1,255);
  146. Val(Copy(st,1,pos(')',st)-1),col,cc);
  147. CompilerMessageWindow^.AddMessage(_type,Copy(Text,pos(':',Text)+1,255)
  148. ,ModuleName,row,col);
  149. If EnableDisplay then
  150. DisplayCompilerWindow:=true;
  151. end;
  152. end;
  153. begin
  154. if not assigned(UserScreen) then
  155. exit;
  156. DisplayCompilerWindow:=false;
  157. PushStatus('Parsing User Screen');
  158. for Y:=0 to UserScreen^.GetHeight do
  159. begin
  160. UserScreen^.GetLine(Y,Text,Attr);
  161. SearchBackTrace;
  162. InsertInMessages(' Fatal:',v_Fatal,true);
  163. InsertInMessages(' Error:',v_Error,true);
  164. InsertInMessages(' Warning:',v_Warning,false);
  165. InsertInMessages(' Note:',v_Note,false);
  166. InsertInMessages(' Info:',v_Info,false);
  167. InsertInMessages(' Hint:',v_Hint,false);
  168. end;
  169. if DisplayCompilerWindow then
  170. begin
  171. if not CompilerMessageWindow^.GetState(sfVisible) then
  172. CompilerMessageWindow^.Show;
  173. CompilerMessageWindow^.MakeFirst;
  174. CompilerMessageWindow^.MsgLB^.SelectFirstError;
  175. end;
  176. PopStatus;
  177. end;
  178. {*****************************************************************************
  179. TCompilerMessage
  180. *****************************************************************************}
  181. function TCompilerMessage.GetText(MaxLen: Sw_Integer): String;
  182. var
  183. ClassS: string[20];
  184. S: string;
  185. begin
  186. if TClass=
  187. V_Fatal then ClassS:='Fatal' else if TClass =
  188. V_Error then ClassS:='Error' else if TClass =
  189. V_Normal then ClassS:='' else if TClass =
  190. V_Warning then ClassS:='Warning' else if TClass =
  191. V_Note then ClassS:='Note' else if TClass =
  192. V_Hint then ClassS:='Hint'
  193. {$ifdef VERBOSETXT}
  194. else if TClass =
  195. V_Macro then ClassS:='Macro' else if TClass =
  196. V_Procedure then ClassS:='Procedure' else if TClass =
  197. V_Conditional then ClassS:='Conditional' else if TClass =
  198. V_Info then ClassS:='Info' else if TClass =
  199. V_Status then ClassS:='Status' else if TClass =
  200. V_Used then ClassS:='Used' else if TClass =
  201. V_Tried then ClassS:='Tried' else if TClass =
  202. V_Debug then ClassS:='Debug'
  203. else
  204. ClassS:='???';
  205. {$else}
  206. else
  207. ClassS:='';
  208. {$endif}
  209. if ClassS<>'' then
  210. ClassS:=RExpand(ClassS,0)+': ';
  211. if assigned(Module) and
  212. (TClass<=V_ShowFile)
  213. {and (status.currentsource<>'') and (status.currentline>0)} then
  214. begin
  215. if Row>0 then
  216. begin
  217. if Col>0 then
  218. S:=NameAndExtOf(Module^)+'('+IntToStr(Row)+','+IntToStr(Col)+') '+ClassS
  219. else
  220. S:=NameAndExtOf(Module^)+'('+IntToStr(Row)+') '+ClassS;
  221. end
  222. else
  223. S:=NameAndExtOf(Module^)+'('+IntToStr(Row)+') '+ClassS
  224. end
  225. else
  226. S:=ClassS;
  227. if assigned(Text) then
  228. S:=S+Text^;
  229. if length(S)>MaxLen then
  230. S:=copy(S,1,MaxLen-2)+'..';
  231. GetText:=S;
  232. end;
  233. {*****************************************************************************
  234. TCompilerMessageListBox
  235. *****************************************************************************}
  236. function TCompilerMessageListBox.GetPalette: PPalette;
  237. const
  238. P: string[length(CBrowserListBox)] = CBrowserListBox;
  239. begin
  240. GetPalette:=@P;
  241. end;
  242. procedure TCompilerMessageListBox.SelectFirstError;
  243. function IsError(P : PCompilerMessage) : boolean;
  244. begin
  245. IsError:=(P^.TClass and (V_Fatal or V_Error))<>0;
  246. end;
  247. var
  248. P : PCompilerMessage;
  249. begin
  250. P:=List^.FirstThat(@IsError);
  251. If Assigned(P) then
  252. Begin
  253. FocusItem(List^.IndexOf(P));
  254. DrawView;
  255. End;
  256. end;
  257. {*****************************************************************************
  258. TCompilerMessageWindow
  259. *****************************************************************************}
  260. constructor TCompilerMessageWindow.Init;
  261. var R: TRect;
  262. HSB,VSB: PScrollBar;
  263. begin
  264. Desktop^.GetExtent(R);
  265. R.A.Y:=R.B.Y-7;
  266. inherited Init(R,'Compiler Messages',{SearchFreeWindowNo}wnNoNumber);
  267. HelpCtx:=hcMessagesWindow;
  268. AutoNumber:=true;
  269. HSB:=StandardScrollBar(sbHorizontal+sbHandleKeyboard);
  270. HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
  271. Insert(HSB);
  272. VSB:=StandardScrollBar(sbVertical+sbHandleKeyboard);
  273. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  274. Insert(VSB);
  275. GetExtent(R);
  276. R.Grow(-1,-1);
  277. New(MsgLB, Init(R, HSB, VSB));
  278. MsgLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  279. Insert(MsgLB);
  280. CompilerMessageWindow:=@self;
  281. end;
  282. procedure TCompilerMessageWindow.AddMessage(AClass: longint;const Msg, Module: string; Line, Column: longint);
  283. begin
  284. if AClass>=V_Info then
  285. Line:=0;
  286. MsgLB^.AddItem(New(PCompilerMessage,Init(AClass, Msg, MsgLB^.AddModuleName(Module), Line, Column)));
  287. end;
  288. procedure TCompilerMessageWindow.ClearMessages;
  289. begin
  290. MsgLB^.Clear;
  291. ReDraw;
  292. end;
  293. {procedure TCompilerMessageWindow.Updateinfo;
  294. begin
  295. if CompileShowed then
  296. begin
  297. InfoST^.SetText(
  298. RExpand(' Main file : '#1#$7f+Copy(SmartPath(MainFile),1,39),40)+#2+
  299. 'Total lines : '#1#$7e+IntToStr(Status.CompiledLines)+#2#13+
  300. RExpand(' Target : '#1#$7f+KillTilde(TargetSwitches^.ItemName(TargetSwitches^.GetCurrSel)),40)+#2+
  301. 'Total errors : '#1#$7e+IntToStr(Status.ErrorCount)
  302. );
  303. if status.currentline>0 then
  304. CurrST^.SetText(' Status: '#1#$7e+status.currentsource+'('+IntToStr(status.currentline)+')'#2)
  305. else
  306. CurrST^.SetText(' Status: '#1#$7e+status.currentsource+#2);
  307. end;
  308. ReDraw;
  309. end;}
  310. procedure TCompilerMessageWindow.HandleEvent(var Event: TEvent);
  311. begin
  312. case Event.What of
  313. evBroadcast :
  314. case Event.Command of
  315. cmListFocusChanged :
  316. if Event.InfoPtr=MsgLB then
  317. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  318. end;
  319. end;
  320. inherited HandleEvent(Event);
  321. end;
  322. procedure TCompilerMessageWindow.SizeLimits(var Min, Max: TPoint);
  323. begin
  324. inherited SizeLimits(Min,Max);
  325. Min.X:=20;
  326. Min.Y:=4;
  327. end;
  328. procedure TCompilerMessageWindow.Close;
  329. begin
  330. Hide;
  331. end;
  332. function TCompilerMessageWindow.GetPalette: PPalette;
  333. const
  334. S : string[length(CBrowserWindow)] = CBrowserWindow;
  335. begin
  336. GetPalette:=@S;
  337. end;
  338. constructor TCompilerMessageWindow.Load(var S: TStream);
  339. begin
  340. inherited Load(S);
  341. GetSubViewPtr(S,MsgLB);
  342. end;
  343. procedure TCompilerMessageWindow.Store(var S: TStream);
  344. begin
  345. if MsgLB^.List=nil then
  346. MsgLB^.NewList(New(PCollection, Init(100,100)));
  347. inherited Store(S);
  348. PutSubViewPtr(S,MsgLB);
  349. end;
  350. destructor TCompilerMessageWindow.Done;
  351. begin
  352. CompilerMessageWindow:=nil;
  353. inherited Done;
  354. end;
  355. {****************************************************************************
  356. CompilerStatusDialog
  357. ****************************************************************************}
  358. constructor TCompilerStatusDialog.Init;
  359. var R: TRect;
  360. begin
  361. R.Assign(0,0,50,11);
  362. inherited Init(R, 'Compiling ('+KillTilde(SwitchesModeName[SwitchesMode])+' mode)');
  363. GetExtent(R); R.B.Y:=11;
  364. R.Grow(-3,-2);
  365. New(ST, Init(R, ''));
  366. Insert(ST);
  367. GetExtent(R); R.B.Y:=11;
  368. R.Grow(-1,-1); R.A.Y:=R.B.Y-1;
  369. New(KeyST, Init(R, '', Blue*16+White+longint($80+Blue*16+White)*256));
  370. Insert(KeyST);
  371. end;
  372. procedure TCompilerStatusDialog.Update;
  373. const
  374. CtrlBS = 'Press ESC to cancel';
  375. SuccessS = 'Compile successful: ~Press Enter~';
  376. FailS = 'Compile failed';
  377. AbortS = 'Compile aborted';
  378. var
  379. StatusS,KeyS: string;
  380. begin
  381. {$ifdef TEMPHEAP}
  382. switch_to_base_heap;
  383. {$endif TEMPHEAP}
  384. case CompilationPhase of
  385. cpCompiling :
  386. begin
  387. StatusS:='Compiling '+SmartPath(Status.CurrentSource);
  388. KeyS:=CtrlBS;
  389. end;
  390. cpLinking :
  391. begin
  392. StatusS:='Linking '+ExeFile;
  393. KeyS:=CtrlBS;
  394. end;
  395. cpDone :
  396. begin
  397. StatusS:='Done.';
  398. KeyS:=SuccessS;
  399. end;
  400. cpFailed :
  401. begin
  402. StatusS:='Failed to compile...';
  403. KeyS:=FailS;
  404. end;
  405. cpAborted :
  406. begin
  407. StatusS:='Compilation aborted...';
  408. KeyS:=AbortS;
  409. end;
  410. end;
  411. ST^.SetText(
  412. 'Main file: '+SmartPath(MainFile)+#13+
  413. StatusS+#13#13+
  414. 'Target: '+LExpand(KillTilde(TargetSwitches^.ItemName(TargetSwitches^.GetCurrSel)),12)+' '+
  415. 'Line number: '+IntToStrL(Status.CurrentLine,7)+#13+
  416. 'Free memory: '+IntToStrL(MemAvail div 1024,6)+'K'+ ' '+
  417. 'Total lines: '+IntToStrL(Status.CompiledLines,7)+#13+
  418. 'Total errors: '+IntToStrL(Status.ErrorCount,5)
  419. );
  420. KeyST^.SetText(^C+KeyS);
  421. {$ifdef TEMPHEAP}
  422. switch_to_temp_heap;
  423. {$endif TEMPHEAP}
  424. end;
  425. {****************************************************************************
  426. Compiler Hooks
  427. ****************************************************************************}
  428. function CompilerStatus: boolean; {$ifndef FPC}far;{$endif}
  429. var
  430. event : tevent;
  431. begin
  432. GetKeyEvent(Event);
  433. if (Event.What=evKeyDown) and (Event.KeyCode=kbEsc) then
  434. begin
  435. CompilationPhase:=cpAborted;
  436. { update info messages }
  437. if assigned(CompilerStatusDialog) then
  438. begin
  439. {$ifdef redircompiler}
  440. RedirDisableAll;
  441. {$endif}
  442. CompilerStatusDialog^.Update;
  443. {$ifdef redircompiler}
  444. RedirEnableAll;
  445. {$endif}
  446. end;
  447. CompilerStatus:=true;
  448. exit;
  449. end;
  450. { only display line info every 100 lines, ofcourse all other messages
  451. will be displayed directly }
  452. if (status.currentline mod 100=0) then
  453. begin
  454. { update info messages }
  455. {$ifdef redircompiler}
  456. RedirDisableAll;
  457. {$endif}
  458. if assigned(CompilerStatusDialog) then
  459. CompilerStatusDialog^.Update;
  460. {$ifdef redircompiler}
  461. RedirEnableAll;
  462. {$endif}
  463. { update memory usage }
  464. { HeapView^.Update; }
  465. end;
  466. CompilerStatus:=false;
  467. end;
  468. procedure CompilerStop; {$ifndef FPC}far;{$endif}
  469. begin
  470. end;
  471. function CompilerComment(Level:Longint; const s:string):boolean; {$ifndef FPC}far;{$endif}
  472. begin
  473. {$ifdef TEMPHEAP}
  474. switch_to_base_heap;
  475. {$endif TEMPHEAP}
  476. CompilerComment:=false;
  477. {$ifndef DEV}
  478. if (status.verbosity and Level)=Level then
  479. {$endif}
  480. begin
  481. {$ifdef redircompiler}
  482. RedirDisableAll;
  483. {$endif}
  484. CompilerMessageWindow^.AddMessage(Level,S,status.currentsourcepath+status.currentsource,
  485. status.currentline,status.currentcolumn);
  486. { update info messages }
  487. if assigned(CompilerStatusDialog) then
  488. CompilerStatusDialog^.Update;
  489. {$ifdef DEBUG}
  490. {$ifndef NODEBUG}
  491. def_gdb_stop(level);
  492. {$endif}
  493. {$endif DEBUG}
  494. {$ifdef redircompiler}
  495. RedirEnableAll;
  496. {$endif}
  497. { update memory usage }
  498. { HeapView^.Update; }
  499. end;
  500. {$ifdef TEMPHEAP}
  501. switch_to_temp_heap;
  502. {$endif TEMPHEAP}
  503. end;
  504. {****************************************************************************
  505. DoCompile
  506. ****************************************************************************}
  507. function GetExePath: string;
  508. var Path: string;
  509. I: Sw_integer;
  510. begin
  511. Path:='.'+DirSep;
  512. if DirectorySwitches<>nil then
  513. with DirectorySwitches^ do
  514. for I:=0 to ItemCount-1 do
  515. begin
  516. if Pos('EXE',KillTilde(ItemName(I)))>0 then
  517. begin Path:=GetStringItem(I); Break; end;
  518. end;
  519. GetExePath:=CompleteDir(FExpand(Path));
  520. end;
  521. function GetMainFile: string;
  522. var FileName: string;
  523. P : PSourceWindow;
  524. begin
  525. P:=Message(Desktop,evBroadcast,cmSearchWindow,nil);
  526. if (PrimaryFileMain='') and (P=nil) then
  527. FileName:='' { nothing to compile }
  528. else
  529. begin
  530. if PrimaryFileMain<>'' then
  531. FileName:=PrimaryFileMain
  532. else
  533. begin
  534. if P^.Editor^.GetModified and (not P^.Editor^.Save) then
  535. FileName:='*' { file not saved }
  536. else
  537. FileName:=P^.Editor^.FileName;
  538. end;
  539. end;
  540. FileName:=FixFileName(FExpand(FileName));
  541. GetMainFile:=FileName;
  542. end;
  543. procedure DoCompile(Mode: TCompileMode);
  544. function IsExitEvent(E: TEvent): boolean;
  545. begin
  546. IsExitEvent:=(E.What=evKeyDown) and
  547. ((E.KeyCode=kbEnter) or (E.KeyCode=kbEsc)) or
  548. ((E.What=evCommand) and (E.command=cmClose));
  549. end;
  550. var
  551. s,FileName: string;
  552. ErrFile : Text;
  553. Error,LinkErrorCount : longint;
  554. E : TEvent;
  555. const
  556. PpasFile = 'ppas';
  557. begin
  558. { Get FileName }
  559. FileName:=GetMainFile;
  560. if FileName='' then
  561. begin
  562. ErrorBox('Oooops, nothing to compile.',nil);
  563. Exit;
  564. end else
  565. if FileName='*' then
  566. begin
  567. ErrorBox('Can''t compile unsaved file.',nil);
  568. Exit;
  569. end;
  570. { Show Compiler Messages Window }
  571. if not CompilerMessageWindow^.GetState(sfVisible) then
  572. CompilerMessageWindow^.Show;
  573. CompilerMessageWindow^.MakeFirst;
  574. CompilerMessageWindow^.ClearMessages;
  575. { Tell why we compile }
  576. NeedRecompile(true);
  577. MainFile:=FileName;
  578. WriteSwitches(SwitchesPath);
  579. { leaving open browsers leads to crashes !! (PM) }
  580. CloseAllBrowsers;
  581. if ((DesktopFileFlags and dfSymbolInformation)<>0) then
  582. WriteSymbolsFile(BrowserName);
  583. { MainFile:=FixFileName(FExpand(FileName));}
  584. If GetEXEPath<>'' then
  585. EXEFile:=FixFileName(GetEXEPath+NameOf(MainFile)+ExeExt)
  586. else
  587. EXEFile:=DirOf(MainFile)+NameOf(MainFile)+ExeExt;
  588. { Reset }
  589. CtrlBreakHit:=false;
  590. { Create Compiler Status Dialog }
  591. CompilationPhase:=cpCompiling;
  592. New(CompilerStatusDialog, Init);
  593. CompilerStatusDialog^.SetState(sfModal,true);
  594. Application^.Insert(CompilerStatusDialog);
  595. CompilerStatusDialog^.Update;
  596. { hook compiler output }
  597. {$ifdef TP}
  598. do_status:=CompilerStatus;
  599. do_stop:=CompilerStop;
  600. do_comment:=CompilerComment;
  601. {$else not TP}
  602. do_status:=@CompilerStatus;
  603. do_stop:=@CompilerStop;
  604. do_comment:=@CompilerComment;
  605. {$endif TP}
  606. { Compile ! }
  607. {$ifdef redircompiler}
  608. ChangeRedirOut(FPOutFileName,false);
  609. ChangeRedirError(FPErrFileName,false);
  610. {$endif}
  611. {$ifdef TEMPHEAP}
  612. split_heap;
  613. switch_to_temp_heap;
  614. {$endif TEMPHEAP}
  615. { insert "" around name so that spaces are allowed }
  616. { only supported in compiler after 2000/01/14 PM }
  617. if pos(' ',FileName)>0 then
  618. FileName:='"'+FileName+'"';
  619. if mode=cBuild then
  620. FileName:='-B '+FileName;
  621. { tokens are created and distroed by compiler.compile !! PM }
  622. DoneTokens;
  623. FpIntF.Compile(FileName);
  624. { tokens are created and distroed by compiler.compile !! PM }
  625. InitTokens;
  626. if LinkAfter and IsExe and
  627. (CompilationPhase<>cpAborted) and
  628. (status.errorCount=0) then
  629. begin
  630. CompilationPhase:=cpLinking;
  631. CompilerStatusDialog^.Update;
  632. {$ifndef redircompiler}
  633. { At least here we want to catch output
  634. of batch file PM }
  635. ChangeRedirOut(FPOutFileName,false);
  636. ChangeRedirError(FPErrFileName,false);
  637. {$endif}
  638. {$ifdef linux}
  639. Shell(GetExePath+PpasFile+source_os.scriptext);
  640. Error:=LinuxError;
  641. {$else}
  642. DosExecute(GetEnv('COMSPEC'),'/C '+GetExePath+PpasFile+source_os.scriptext);
  643. Error:=DosError;
  644. {$endif}
  645. {$ifndef redircompiler}
  646. RestoreRedirOut;
  647. RestoreRedirError;
  648. {$endif}
  649. if Error<>0 then
  650. Inc(status.errorCount);
  651. if not ExistsFile(EXEFile) then
  652. begin
  653. Inc(status.errorCount);
  654. CompilerMessageWindow^.AddMessage(V_error,'could not create '+ExeFile,'',0,0);
  655. Assign(ErrFile,FPErrFileName);
  656. Reset(ErrFile);
  657. LinkErrorCount:=0;
  658. While not eof(ErrFile) and (LinkErrorCount<25) do
  659. begin
  660. readln(ErrFile,s);
  661. CompilerMessageWindow^.AddMessage(V_error,s,'',0,0);
  662. inc(LinkErrorCount);
  663. end;
  664. if not eof(ErrFile) then
  665. CompilerMessageWindow^.AddMessage(V_error,
  666. 'There are more errors in file '+FPErrFileName,'',0,0);
  667. Close(ErrFile);
  668. end;
  669. end;
  670. {$ifdef TEMPHEAP}
  671. switch_to_base_heap;
  672. {$endif TEMPHEAP}
  673. {$ifdef redircompiler}
  674. RestoreRedirOut;
  675. RestoreRedirError;
  676. {$endif}
  677. { Set end status }
  678. if CompilationPhase<>cpAborted then
  679. if (status.errorCount=0) then
  680. CompilationPhase:=cpDone
  681. else
  682. CompilationPhase:=cpFailed;
  683. { Show end status }
  684. CompilerStatusDialog^.Update;
  685. CompilerStatusDialog^.SetState(sfModal,false);
  686. if ((CompilationPhase in[cpAborted,cpDone,cpFailed]) or (ShowStatusOnError)) and (Mode<>cRun) then
  687. repeat
  688. CompilerStatusDialog^.GetEvent(E);
  689. if IsExitEvent(E)=false then
  690. CompilerStatusDialog^.HandleEvent(E);
  691. until IsExitEvent(E);
  692. Application^.Delete(CompilerStatusDialog);
  693. Dispose(CompilerStatusDialog, Done);
  694. CompilerStatusDialog:=nil;
  695. { end compilation returns true if the messagewindow should be removed }
  696. if CompilationPhase=cpDone then
  697. begin
  698. CompilerMessageWindow^.Hide;
  699. { This is the last compiled main file }
  700. PrevMainFile:=MainFile;
  701. MainHasDebugInfo:=DebugInfoSwitches^.GetCurrSelParam<>'-';
  702. end;
  703. { Update the app }
  704. Message(Application,evCommand,cmUpdate,nil);
  705. {$ifdef TEMPHEAP}
  706. releasetempheap;
  707. unsplit_heap;
  708. {$endif TEMPHEAP}
  709. if Assigned(CompilerMessageWindow) then
  710. with CompilerMessageWindow^ do
  711. begin
  712. if GetState(sfVisible) then
  713. begin
  714. SetState(sfSelected,false);
  715. SetState(sfSelected,true);
  716. end;
  717. if (status.errorCount>0) then
  718. MsgLB^.SelectFirstError;
  719. end;
  720. { ^^^ we need this trick to reactivate the desktop }
  721. EditorModified:=false;
  722. { Try to read Browser info in again if compilation failure !! }
  723. if Not Assigned(Modules) and (CompilationPhase<>cpDone) and
  724. ((DesktopFileFlags and dfSymbolInformation)<>0) then
  725. ReadSymbolsFile(BrowserName);
  726. end;
  727. function NeedRecompile(verbose : boolean): boolean;
  728. var Need: boolean;
  729. I: sw_integer;
  730. SF: PSourceFile;
  731. SourceTime,PPUTime,ObjTime: longint;
  732. begin
  733. if Assigned(SourceFiles)=false then
  734. Need:={(EditorModified=true)}true
  735. else
  736. begin
  737. Need:=(PrevMainFile<>GetMainFile) and (PrevMainFile<>'');
  738. if Need then
  739. begin
  740. if verbose then
  741. CompilerMessageWindow^.AddMessage(V_info,
  742. 'First compilation of '+GetMainFile,
  743. '',0,0);
  744. end
  745. else
  746. for I:=0 to SourceFiles^.Count-1 do
  747. begin
  748. SF:=SourceFiles^.At(I);
  749. SourceTime:=GetFileTime(SF^.GetSourceFileName);
  750. PPUTime:=GetFileTime(SF^.GetPPUFileName);
  751. ObjTime:=GetFileTime(SF^.GetObjFileName);
  752. { writeln('S: ',SF^.GetSourceFileName,' - ',SourceTime);
  753. writeln('P: ',SF^.GetPPUFileName,' - ',PPUTime);
  754. writeln('O: ',SF^.GetObjFileName,' - ',ObjTime);
  755. writeln('------');}
  756. { some units don't generate object files }
  757. if (SourceTime<>-1) then
  758. if (SourceTime>PPUTime) or
  759. ((SourceTime>ObjTime) and
  760. (ObjTime<>-1)) then
  761. begin
  762. Need:=true;
  763. if verbose then
  764. CompilerMessageWindow^.AddMessage(V_info,
  765. 'Recompiling because of '+SF^.GetSourceFileName,
  766. SF^.GetSourceFileName,1,1);
  767. Break;
  768. end;
  769. end;
  770. { writeln('Need?', Need); system.readln;}
  771. end;
  772. NeedRecompile:=Need;
  773. end;
  774. procedure RegisterFPCompile;
  775. begin
  776. {$ifndef NOOBJREG}
  777. RegisterType(RCompilerMessageListBox);
  778. RegisterType(RCompilerMessageWindow);
  779. {$endif}
  780. end;
  781. end.
  782. {
  783. $Log$
  784. Revision 1.54 2000-03-23 22:23:21 pierre
  785. + Use PushStatus in ParseUserScreen
  786. Revision 1.53 2000/03/21 23:33:18 pierre
  787. adapted to wcedit addition by Gabor
  788. Revision 1.52 2000/03/08 16:48:07 pierre
  789. + Read BackTrace from UseScreen
  790. Revision 1.51 2000/03/07 21:54:26 pierre
  791. + ParseUserScreen
  792. Revision 1.50 2000/02/06 23:41:42 pierre
  793. + TCompilerMessageListBox.SelectFirstError
  794. Revision 1.49 2000/01/25 00:26:35 pierre
  795. + Browser info saving
  796. Revision 1.48 2000/01/14 15:38:28 pierre
  797. + support for long filenames with spaces for compilation
  798. * avoid too long linker error output
  799. Revision 1.47 2000/01/03 11:38:33 michael
  800. Changes from Gabor
  801. Revision 1.46 1999/12/01 17:08:19 pierre
  802. * GetFileTime moved to wutils unit
  803. Revision 1.45 1999/11/22 15:58:40 pierre
  804. * fix for web bug 633
  805. Revision 1.44 1999/11/21 01:44:34 pierre
  806. + Use def_gdb_stop for easy GDB debugging
  807. Revision 1.43 1999/11/18 13:49:56 pierre
  808. + use IsExe var to know if we need to call ppas
  809. Revision 1.42 1999/11/10 17:20:41 pierre
  810. * Use fpredir.dosexecute
  811. Revision 1.41 1999/10/25 16:34:19 pierre
  812. * some units have no object files
  813. led to wrong NeedRecompile result
  814. Revision 1.40 1999/09/20 15:36:38 pierre
  815. * adapted to new tokens unit
  816. Revision 1.39 1999/09/16 14:34:57 pierre
  817. + TBreakpoint and TWatch registering
  818. + WatchesCollection and BreakpointsCollection stored in desk file
  819. * Syntax highlighting was broken
  820. Revision 1.38 1999/09/13 16:24:43 peter
  821. + clock
  822. * backspace unident like tp7
  823. Revision 1.37 1999/09/09 14:19:16 pierre
  824. * status should not be present in TCompilerMessage.GetText
  825. Revision 1.36 1999/09/07 11:32:13 pierre
  826. * fix for Linux ./ prepended to ppas.sh
  827. * Build add '-B' option
  828. * if linkAfter is set, get errors from linker
  829. by redirecting files
  830. Revision 1.35 1999/08/22 22:27:30 pierre
  831. * not ppas call on compile failure
  832. Revision 1.34 1999/08/16 18:25:13 peter
  833. * Adjusting the selection when the editor didn't contain any line.
  834. * Reserved word recognition redesigned, but this didn't affect the overall
  835. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  836. The syntax scanner loop is a bit slow but the main problem is the
  837. recognition of special symbols. Switching off symbol processing boosts
  838. the performance up to ca. 200%...
  839. * The editor didn't allow copying (for ex to clipboard) of a single character
  840. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  841. * Compiler Messages window (actually the whole desktop) did not act on any
  842. keypress when compilation failed and thus the window remained visible
  843. + Message windows are now closed upon pressing Esc
  844. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  845. only when neccessary
  846. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  847. + LineSelect (Ctrl+K+L) implemented
  848. * The IDE had problems closing help windows before saving the desktop
  849. Revision 1.33 1999/08/03 20:22:26 peter
  850. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  851. + Desktop saving should work now
  852. - History saved
  853. - Clipboard content saved
  854. - Desktop saved
  855. - Symbol info saved
  856. * syntax-highlight bug fixed, which compared special keywords case sensitive
  857. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  858. * with 'whole words only' set, the editor didn't found occourences of the
  859. searched text, if the text appeared previously in the same line, but didn't
  860. satisfied the 'whole-word' condition
  861. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  862. (ie. the beginning of the selection)
  863. * when started typing in a new line, but not at the start (X=0) of it,
  864. the editor inserted the text one character more to left as it should...
  865. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  866. * Shift shouldn't cause so much trouble in TCodeEditor now...
  867. * Syntax highlight had problems recognizing a special symbol if it was
  868. prefixed by another symbol character in the source text
  869. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  870. Revision 1.32 1999/07/12 13:14:13 pierre
  871. * LineEnd bug corrected, now goes end of text even if selected
  872. + Until Return for debugger
  873. + Code for Quit inside GDB Window
  874. Revision 1.31 1999/06/28 19:32:17 peter
  875. * fixes from gabor
  876. Revision 1.30 1999/06/28 15:59:04 pierre
  877. * View Linking stage if external linking
  878. Revision 1.29 1999/06/28 12:39:14 pierre
  879. + close all browsers before compiling
  880. Revision 1.28 1999/06/21 23:42:16 pierre
  881. + LinkAfter and Esc to abort support added
  882. Revision 1.27 1999/05/22 13:44:29 peter
  883. * fixed couple of bugs
  884. Revision 1.26 1999/05/02 14:29:35 peter
  885. * fixed typo disableredir -> redirdisable
  886. Revision 1.25 1999/04/29 22:58:09 pierre
  887. + disabling of redirction in compiler dialogs
  888. Revision 1.24 1999/04/29 09:36:11 peter
  889. * fixed hotkeys with Compiler switches
  890. * fixed compiler status dialog
  891. * Run shows again the output
  892. Revision 1.23 1999/04/07 21:55:43 peter
  893. + object support for browser
  894. * html help fixes
  895. * more desktop saving things
  896. * NODEBUG directive to exclude debugger
  897. Revision 1.22 1999/04/01 10:27:07 pierre
  898. + file(line) in start of message added
  899. Revision 1.21 1999/04/01 10:15:17 pierre
  900. * CurrSt,InfoSt and LineSt were not disposed correctly in done
  901. * TComiplerMessage destructor first calls SetCompileShow(false)
  902. to get proper cleaning up
  903. Revision 1.20 1999/03/23 16:16:38 peter
  904. * linux fixes
  905. Revision 1.19 1999/03/19 16:04:27 peter
  906. * new compiler dialog
  907. Revision 1.18 1999/03/16 12:38:07 peter
  908. * tools macro fixes
  909. + tph writer
  910. + first things for resource files
  911. Revision 1.17 1999/03/12 01:13:56 peter
  912. * flag if trytoopen should look for other extensions
  913. + browser tab in the tools-compiler
  914. Revision 1.16 1999/03/07 23:00:47 pierre
  915. * Fix for path of executable
  916. Revision 1.15 1999/03/01 15:41:50 peter
  917. + Added dummy entries for functions not yet implemented
  918. * MenuBar didn't update itself automatically on command-set changes
  919. * Fixed Debugging/Profiling options dialog
  920. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  921. set
  922. * efBackSpaceUnindents works correctly
  923. + 'Messages' window implemented
  924. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  925. + Added TP message-filter support (for ex. you can call GREP thru
  926. GREP2MSG and view the result in the messages window - just like in TP)
  927. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  928. so topic search didn't work...
  929. * In FPHELP.PAS there were still context-variables defined as word instead
  930. of THelpCtx
  931. * StdStatusKeys() was missing from the statusdef for help windows
  932. + Topic-title for index-table can be specified when adding a HTML-files
  933. Revision 1.14 1999/02/22 12:46:56 peter
  934. * small fixes for linux and grep
  935. Revision 1.13 1999/02/22 11:51:33 peter
  936. * browser updates from gabor
  937. Revision 1.12 1999/02/22 11:29:36 pierre
  938. + added col info in MessageItem
  939. + grep uses HighLightExts and should work for linux
  940. Revision 1.11 1999/02/08 09:31:00 florian
  941. + some split heap stuff, in $ifdef TEMPHEAP
  942. Revision 1.10 1999/02/05 13:51:39 peter
  943. * unit name of FPSwitches -> FPSwitch which is easier to use
  944. * some fixes for tp7 compiling
  945. Revision 1.9 1999/02/05 13:06:28 pierre
  946. * allow cmClose for Compilation Dialog box
  947. Revision 1.8 1999/02/04 13:32:01 pierre
  948. * Several things added (I cannot commit them independently !)
  949. + added TBreakpoint and TBreakpointCollection
  950. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  951. + Breakpoint list in INIFile
  952. * Select items now also depend of SwitchMode
  953. * Reading of option '-g' was not possible !
  954. + added search for -Fu args pathes in TryToOpen
  955. + added code for automatic opening of FileDialog
  956. if source not found
  957. Revision 1.7 1999/01/21 11:54:11 peter
  958. + tools menu
  959. + speedsearch in symbolbrowser
  960. * working run command
  961. Revision 1.6 1999/01/15 16:12:43 peter
  962. * fixed crash after compile
  963. Revision 1.5 1999/01/14 21:42:19 peter
  964. * source tracking from Gabor
  965. Revision 1.4 1999/01/12 14:29:32 peter
  966. + Implemented still missing 'switch' entries in Options menu
  967. + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
  968. ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
  969. ASCII chars and inserted directly in the text.
  970. + Added symbol browser
  971. * splitted fp.pas to fpide.pas
  972. Revision 1.3 1999/01/04 11:49:42 peter
  973. * 'Use tab characters' now works correctly
  974. + Syntax highlight now acts on File|Save As...
  975. + Added a new class to syntax highlight: 'hex numbers'.
  976. * There was something very wrong with the palette managment. Now fixed.
  977. + Added output directory (-FE<xxx>) support to 'Directories' dialog...
  978. * Fixed some possible bugs in Running/Compiling, and the compilation/run
  979. process revised
  980. Revision 1.2 1998/12/28 15:47:42 peter
  981. + Added user screen support, display & window
  982. + Implemented Editor,Mouse Options dialog
  983. + Added location of .INI and .CFG file
  984. + Option (INI) file managment implemented (see bottom of Options Menu)
  985. + Switches updated
  986. + Run program
  987. Revision 1.3 1998/12/22 10:39:40 peter
  988. + options are now written/read
  989. + find and replace routines
  990. }