fpcompil.pas 33 KB

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