fpcompil.pas 49 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649
  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 FPCompil;
  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. {$mode objfpc}
  21. uses
  22. Objects,
  23. {$ifdef COMPILER_1_0}
  24. Files,
  25. {$else COMPILER_1_0}
  26. FInput,
  27. {$endif COMPILER_1_0}
  28. Drivers,Views,Dialogs,
  29. WUtils,WViews,WCEdit,
  30. FPSymbol,
  31. FPViews;
  32. type
  33. TCompileMode = (cBuild,cMake,cCompile,cRun);
  34. type
  35. PCompilerMessage = ^TCompilerMessage;
  36. TCompilerMessage = object(TMessageItem)
  37. function GetText(MaxLen: Sw_Integer): String; virtual;
  38. end;
  39. PCompilerMessageListBox = ^TCompilerMessageListBox;
  40. TCompilerMessageListBox = object(TMessageListBox)
  41. function GetPalette: PPalette; virtual;
  42. procedure SelectFirstError;
  43. end;
  44. PCompilerMessageWindow = ^TCompilerMessageWindow;
  45. TCompilerMessageWindow = object(TFPWindow)
  46. constructor Init;
  47. procedure HandleEvent(var Event: TEvent); virtual;
  48. function GetPalette: PPalette; virtual;
  49. procedure Close;virtual;
  50. destructor Done; virtual;
  51. procedure SizeLimits(var Min, Max: TPoint); virtual;
  52. procedure AddMessage(AClass: longint;const Msg, Module: string; Line, Column: longint);
  53. procedure ClearMessages;
  54. constructor Load(var S: TStream);
  55. procedure Store(var S: TStream);
  56. procedure SetState(AState: Word; Enable: Boolean); virtual;
  57. procedure UpdateCommands; virtual;
  58. private
  59. {CompileShowed : boolean;}
  60. {Mode : TCompileMode;}
  61. MsgLB : PCompilerMessageListBox;
  62. {CurrST,
  63. InfoST : PColorStaticText;}
  64. end;
  65. PCompilerStatusDialog = ^TCompilerStatusDialog;
  66. TCompilerStatusDialog = object(TCenterDialog)
  67. ST : PAdvancedStaticText;
  68. KeyST : PColorStaticText;
  69. constructor Init;
  70. destructor Done;virtual;
  71. procedure Update;
  72. end;
  73. {$ifdef COMPILER_1_0}
  74. PFPInputFile = ^TFPInputFile;
  75. TFPInputFile = object(tinputfile)
  76. constructor Init(AEditor: PFileEditor);
  77. {$ifdef FPC}protected{$else}public{$endif}
  78. function fileopen(const filename: string): boolean; virtual;
  79. function fileseek(pos: longint): boolean; virtual;
  80. function fileread(var databuf; maxsize: longint): longint; virtual;
  81. function fileeof: boolean; virtual;
  82. function fileclose: boolean; virtual;
  83. private
  84. Editor: PFileEditor;
  85. S: PStream;
  86. end;
  87. {$else COMPILER_1_0}
  88. TFPInputFile = class(tinputfile)
  89. constructor Create(AEditor: PFileEditor);
  90. {$ifdef FPC}protected{$else}public{$endif}
  91. function fileopen(const filename: string): boolean; override;
  92. function fileseek(pos: longint): boolean; override;
  93. function fileread(var databuf; maxsize: longint): longint; override;
  94. function fileeof: boolean; override;
  95. function fileclose: boolean; override;
  96. private
  97. Editor: PFileEditor;
  98. S: PStream;
  99. end;
  100. {$endif COMPILER_1_0}
  101. const
  102. CompilerMessageWindow : PCompilerMessageWindow = nil;
  103. CompilerStatusDialog : PCompilerStatusDialog = nil;
  104. CompileStamp : longint = 0;
  105. procedure DoCompile(Mode: TCompileMode);
  106. function NeedRecompile(Mode :TCompileMode; verbose : boolean): boolean;
  107. procedure ParseUserScreen;
  108. procedure RegisterFPCompile;
  109. {$ifndef GABOR}
  110. var
  111. StopJmp : Jmp_Buf;
  112. const
  113. StopJmpValid : boolean = false;
  114. {$endif}
  115. implementation
  116. uses
  117. {$ifdef Unix}
  118. {$ifdef VER1_0}
  119. Linux,
  120. {$else}
  121. Unix,
  122. {$endif}
  123. {$endif}
  124. {$ifdef go32v2}
  125. dpmiexcp,
  126. {$endif}
  127. {$ifdef win32}
  128. signals,
  129. {$endif}
  130. Dos,Video,
  131. StdDlg,App,tokens,
  132. {$ifdef FVISION}
  133. FVConsts,
  134. {$else}
  135. Commands,
  136. {$endif}
  137. CompHook, Compiler, systems, browcol,
  138. WEditor,
  139. FPString,FPRedir,FPDesk,
  140. FPUsrScr,FPHelp,
  141. {$ifndef NODEBUG}FPDebug,{$endif}
  142. FPConst,FPVars,FPUtils,FPIntf,FPSwitch;
  143. {$ifndef NOOBJREG}
  144. const
  145. RCompilerMessageListBox: TStreamRec = (
  146. ObjType: 1211;
  147. VmtLink: Ofs(TypeOf(TCompilerMessageListBox)^);
  148. Load: @TCompilerMessageListBox.Load;
  149. Store: @TCompilerMessageListBox.Store
  150. );
  151. RCompilerMessageWindow: TStreamRec = (
  152. ObjType: 1212;
  153. VmtLink: Ofs(TypeOf(TCompilerMessageWindow)^);
  154. Load: @TCompilerMessageWindow.Load;
  155. Store: @TCompilerMessageWindow.Store
  156. );
  157. {$endif}
  158. procedure ParseUserScreen;
  159. var
  160. y : longint;
  161. Text,Attr : String;
  162. DisplayCompilerWindow : boolean;
  163. cc: integer;
  164. procedure SearchBackTrace;
  165. var AText,ModuleName,st : String;
  166. row : longint;
  167. begin
  168. if pos(' 0x',Text)=1 then
  169. begin
  170. AText:=Text;
  171. Delete(Text,1,10);
  172. While pos(' ',Text)=1 do
  173. Delete(Text,1,1);
  174. if pos('of ',Text)>0 then
  175. begin
  176. ModuleName:=Copy(Text,pos('of ',Text)+3,255);
  177. While ModuleName[Length(ModuleName)]=' ' do
  178. Delete(ModuleName,Length(ModuleName),1);
  179. end
  180. else
  181. ModuleName:='';
  182. if pos('line ',Text)>0 then
  183. begin
  184. Text:=Copy(Text,Pos('line ',Text)+5,255);
  185. st:=Copy(Text,1,Pos(' ',Text)-1);
  186. Val(st,row,cc);
  187. end
  188. else
  189. row:=0;
  190. CompilerMessageWindow^.AddMessage(V_Fatal,AText
  191. ,ModuleName,row,1);
  192. DisplayCompilerWindow:=true;
  193. end;
  194. end;
  195. procedure InsertInMessages(Const TypeStr : String;_Type : longint;EnableDisplay : boolean);
  196. var p,p2,col,row : longint;
  197. St,ModuleName : string;
  198. begin
  199. p:=pos(TypeStr,Text);
  200. p2:=Pos('(',Text);
  201. if (p>0) and (p2>0) and (p2<p) then
  202. begin
  203. ModuleName:=Copy(Text,1,p2-1);
  204. st:=Copy(Text,p2+1,255);
  205. Val(Copy(st,1,pos(',',st)-1),row,cc);
  206. st:=Copy(st,Pos(',',st)+1,255);
  207. Val(Copy(st,1,pos(')',st)-1),col,cc);
  208. CompilerMessageWindow^.AddMessage(_type,Copy(Text,pos(':',Text)+1,255)
  209. ,ModuleName,row,col);
  210. If EnableDisplay then
  211. DisplayCompilerWindow:=true;
  212. end;
  213. end;
  214. begin
  215. if not assigned(UserScreen) then
  216. exit;
  217. DisplayCompilerWindow:=false;
  218. PushStatus('Parsing User Screen');
  219. for Y:=0 to UserScreen^.GetHeight do
  220. begin
  221. UserScreen^.GetLine(Y,Text,Attr);
  222. SearchBackTrace;
  223. InsertInMessages(' Fatal:',v_Fatal,true);
  224. InsertInMessages(' Error:',v_Error,true);
  225. InsertInMessages(' Warning:',v_Warning,false);
  226. InsertInMessages(' Note:',v_Note,false);
  227. InsertInMessages(' Info:',v_Info,false);
  228. InsertInMessages(' Hint:',v_Hint,false);
  229. end;
  230. if DisplayCompilerWindow then
  231. begin
  232. if not CompilerMessageWindow^.GetState(sfVisible) then
  233. CompilerMessageWindow^.Show;
  234. CompilerMessageWindow^.MakeFirst;
  235. CompilerMessageWindow^.MsgLB^.SelectFirstError;
  236. end;
  237. PopStatus;
  238. end;
  239. {*****************************************************************************
  240. TCompilerMessage
  241. *****************************************************************************}
  242. function TCompilerMessage.GetText(MaxLen: Sw_Integer): String;
  243. var
  244. ClassS: string[20];
  245. S: string;
  246. begin
  247. if TClass=
  248. V_Fatal then ClassS:=msg_class_Fatal else if TClass =
  249. V_Error then ClassS:=msg_class_Error else if TClass =
  250. V_Normal then ClassS:=msg_class_Normal else if TClass =
  251. V_Warning then ClassS:=msg_class_Warning else if TClass =
  252. V_Note then ClassS:=msg_class_Note else if TClass =
  253. V_Hint then ClassS:=msg_class_Hint
  254. {$ifdef VERBOSETXT}
  255. else if TClass =
  256. V_Macro then ClassS:=msg_class_macro else if TClass =
  257. V_Procedure then ClassS:=msg_class_procedure else if TClass =
  258. V_Conditional then ClassS:=msg_class_conditional else if TClass =
  259. V_Info then ClassS:=msg_class_info else if TClass =
  260. V_Status then ClassS:=msg_class_status else if TClass =
  261. V_Used then ClassS:=msg_class_used else if TClass =
  262. V_Tried then ClassS:=msg_class_tried else if TClass =
  263. V_Debug then ClassS:=msg_class_debug
  264. else
  265. ClassS:='???';
  266. {$else}
  267. else
  268. ClassS:='';
  269. {$endif}
  270. if ClassS<>'' then
  271. ClassS:=RExpand(ClassS,0)+': ';
  272. if assigned(Module) and
  273. (TClass<=V_ShowFile)
  274. {and (status.currentsource<>'') and (status.currentline>0)} then
  275. begin
  276. if Row>0 then
  277. begin
  278. if Col>0 then
  279. S:=NameAndExtOf(Module^)+'('+IntToStr(Row)+','+IntToStr(Col)+') '+ClassS
  280. else
  281. S:=NameAndExtOf(Module^)+'('+IntToStr(Row)+') '+ClassS;
  282. end
  283. else
  284. S:=NameAndExtOf(Module^)+'('+IntToStr(Row)+') '+ClassS
  285. end
  286. else
  287. S:=ClassS;
  288. if assigned(Text) then
  289. S:=S+Text^;
  290. if length(S)>MaxLen then
  291. S:=copy(S,1,MaxLen-2)+'..';
  292. GetText:=S;
  293. end;
  294. {*****************************************************************************
  295. TCompilerMessageListBox
  296. *****************************************************************************}
  297. function TCompilerMessageListBox.GetPalette: PPalette;
  298. const
  299. P: string[length(CBrowserListBox)] = CBrowserListBox;
  300. begin
  301. GetPalette:=@P;
  302. end;
  303. procedure TCompilerMessageListBox.SelectFirstError;
  304. function IsError(P : PCompilerMessage) : boolean;
  305. begin
  306. IsError:=(P^.TClass and (V_Fatal or V_Error))<>0;
  307. end;
  308. var
  309. P : PCompilerMessage;
  310. begin
  311. P:=List^.FirstThat(@IsError);
  312. If Assigned(P) then
  313. Begin
  314. FocusItem(List^.IndexOf(P));
  315. DrawView;
  316. End;
  317. end;
  318. {*****************************************************************************
  319. TCompilerMessageWindow
  320. *****************************************************************************}
  321. constructor TCompilerMessageWindow.Init;
  322. var R: TRect;
  323. HSB,VSB: PScrollBar;
  324. begin
  325. Desktop^.GetExtent(R);
  326. R.A.Y:=R.B.Y-7;
  327. inherited Init(R,dialog_compilermessages,{SearchFreeWindowNo}wnNoNumber);
  328. HelpCtx:=hcCompilerMessagesWindow;
  329. AutoNumber:=true;
  330. HSB:=StandardScrollBar(sbHorizontal+sbHandleKeyboard);
  331. HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY;
  332. Insert(HSB);
  333. VSB:=StandardScrollBar(sbVertical+sbHandleKeyboard);
  334. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY;
  335. Insert(VSB);
  336. GetExtent(R);
  337. R.Grow(-1,-1);
  338. New(MsgLB, Init(R, HSB, VSB));
  339. MsgLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  340. Insert(MsgLB);
  341. CompilerMessageWindow:=@self;
  342. end;
  343. procedure TCompilerMessageWindow.AddMessage(AClass: longint;const Msg, Module: string; Line, Column: longint);
  344. begin
  345. if AClass>=V_Info then
  346. Line:=0;
  347. MsgLB^.AddItem(New(PCompilerMessage,Init(AClass, Msg, MsgLB^.AddModuleName(Module), Line, Column)));
  348. if (@Self=CompilerMessageWindow) and ((AClass = V_fatal) or (AClass = V_Error)) then
  349. begin
  350. if not GetState(sfVisible) then
  351. Show;
  352. if Desktop^.First<>PView(CompilerMessageWindow) then
  353. MakeFirst;
  354. end;
  355. end;
  356. procedure TCompilerMessageWindow.ClearMessages;
  357. begin
  358. MsgLB^.Clear;
  359. ReDraw;
  360. end;
  361. {procedure TCompilerMessageWindow.Updateinfo;
  362. begin
  363. if CompileShowed then
  364. begin
  365. InfoST^.SetText(
  366. RExpand(' Main file : '#1#$7f+Copy(SmartPath(MainFile),1,39),40)+#2+
  367. 'Total lines : '#1#$7e+IntToStr(Status.CompiledLines)+#2#13+
  368. RExpand(' Target : '#1#$7f+KillTilde(TargetSwitches^.ItemName(TargetSwitches^.GetCurrSel)),40)+#2+
  369. 'Total errors : '#1#$7e+IntToStr(Status.ErrorCount)
  370. );
  371. if status.currentline>0 then
  372. CurrST^.SetText(' Status: '#1#$7e+status.currentsource+'('+IntToStr(status.currentline)+')'#2)
  373. else
  374. CurrST^.SetText(' Status: '#1#$7e+status.currentsource+#2);
  375. end;
  376. ReDraw;
  377. end;}
  378. procedure TCompilerMessageWindow.HandleEvent(var Event: TEvent);
  379. begin
  380. case Event.What of
  381. evBroadcast :
  382. case Event.Command of
  383. cmListFocusChanged :
  384. if Event.InfoPtr=MsgLB then
  385. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  386. end;
  387. end;
  388. inherited HandleEvent(Event);
  389. end;
  390. procedure TCompilerMessageWindow.SizeLimits(var Min, Max: TPoint);
  391. begin
  392. inherited SizeLimits(Min,Max);
  393. Min.X:=20;
  394. Min.Y:=4;
  395. end;
  396. procedure TCompilerMessageWindow.Close;
  397. begin
  398. Hide;
  399. end;
  400. function TCompilerMessageWindow.GetPalette: PPalette;
  401. const
  402. S : string[length(CBrowserWindow)] = CBrowserWindow;
  403. begin
  404. GetPalette:=@S;
  405. end;
  406. constructor TCompilerMessageWindow.Load(var S: TStream);
  407. begin
  408. inherited Load(S);
  409. GetSubViewPtr(S,MsgLB);
  410. end;
  411. procedure TCompilerMessageWindow.Store(var S: TStream);
  412. begin
  413. if MsgLB^.List=nil then
  414. MsgLB^.NewList(New(PCollection, Init(100,100)));
  415. inherited Store(S);
  416. PutSubViewPtr(S,MsgLB);
  417. end;
  418. procedure TCompilerMessageWindow.UpdateCommands;
  419. var Active: boolean;
  420. begin
  421. Active:=GetState(sfActive);
  422. SetCmdState(CompileCmds,Active);
  423. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  424. end;
  425. procedure TCompilerMessageWindow.SetState(AState: Word; Enable: Boolean);
  426. var OldState: word;
  427. begin
  428. OldState:=State;
  429. inherited SetState(AState,Enable);
  430. if ((AState and sfActive)<>0) and (((OldState xor State) and sfActive)<>0) then
  431. UpdateCommands;
  432. end;
  433. destructor TCompilerMessageWindow.Done;
  434. begin
  435. CompilerMessageWindow:=nil;
  436. inherited Done;
  437. end;
  438. {****************************************************************************
  439. CompilerStatusDialog
  440. ****************************************************************************}
  441. constructor TCompilerStatusDialog.Init;
  442. var R: TRect;
  443. begin
  444. R.Assign(0,0,50,11);
  445. ClearFormatParams; AddFormatParamStr(KillTilde(SwitchesModeName[SwitchesMode]));
  446. inherited Init(R, FormatStrF(dialog_compilingwithmode, FormatParams));
  447. GetExtent(R); R.B.Y:=11;
  448. R.Grow(-3,-2);
  449. New(ST, Init(R, ''));
  450. Insert(ST);
  451. GetExtent(R); R.B.Y:=11;
  452. R.Grow(-1,-1); R.A.Y:=R.B.Y-1;
  453. New(KeyST, Init(R, '', Blue*16+White+longint($80+Blue*16+White)*256,true));
  454. Insert(KeyST);
  455. { Reset Status infos see bug 1585 }
  456. Fillchar(Status,SizeOf(Status),#0);
  457. end;
  458. destructor TCompilerStatusDialog.Done;
  459. begin
  460. if @Self=CompilerStatusDialog then
  461. CompilerStatusDialog:=nil;
  462. Inherited Done;
  463. end;
  464. procedure TCompilerStatusDialog.Update;
  465. var
  466. StatusS,KeyS: string;
  467. const
  468. MaxFileNameSize = 46;
  469. begin
  470. {$ifdef TEMPHEAP}
  471. switch_to_base_heap;
  472. {$endif TEMPHEAP}
  473. case CompilationPhase of
  474. cpCompiling :
  475. begin
  476. ClearFormatParams;
  477. if Status.Compiling_current then
  478. begin
  479. AddFormatParamStr(ShrinkPath(SmartPath(Status.Currentsourcepath+Status.CurrentSource),
  480. MaxFileNameSize - Length(msg_compilingfile)));
  481. StatusS:=FormatStrF(msg_compilingfile,FormatParams);
  482. end
  483. else
  484. begin
  485. if Status.CurrentSource='' then
  486. StatusS:=''
  487. else
  488. begin
  489. StatusS:=ShrinkPath(SmartPath(DirAndNameOf(Status.Currentsourcepath+Status.CurrentSource)),
  490. MaxFileNameSize-Length(msg_loadingunit));
  491. AddFormatParamStr(StatusS);
  492. StatusS:=FormatStrF(msg_loadingunit,FormatParams);
  493. end;
  494. end;
  495. KeyS:=msg_hint_pressesctocancel;
  496. end;
  497. cpLinking :
  498. begin
  499. ClearFormatParams;
  500. AddFormatParamStr(ShrinkPath(ExeFile,
  501. MaxFileNameSize-Length(msg_linkingfile)));
  502. StatusS:=FormatStrF(msg_linkingfile,FormatParams);
  503. KeyS:=msg_hint_pleasewait;
  504. end;
  505. cpDone :
  506. begin
  507. StatusS:=msg_compiledone;
  508. KeyS:=msg_hint_compilesuccessfulpressenter;
  509. end;
  510. cpFailed :
  511. begin
  512. StatusS:=msg_failedtocompile;
  513. KeyS:=msg_hint_compilefailed;
  514. end;
  515. cpAborted :
  516. begin
  517. StatusS:=msg_compilationaborted;
  518. KeyS:=msg_hint_compileaborted;
  519. end;
  520. end;
  521. ClearFormatParams;
  522. AddFormatParamStr(ShrinkPath(SmartPath(MainFile),
  523. MaxFileNameSize-Length('Main file: %s')));
  524. AddFormatParamStr(StatusS);
  525. AddFormatParamStr(KillTilde(TargetSwitches^.ItemName(TargetSwitches^.GetCurrSel)));
  526. AddFormatParamInt(Status.CurrentLine);
  527. AddFormatParamInt(MemAvail div 1024);
  528. AddFormatParamInt(Status.CompiledLines);
  529. AddFormatParamInt(Status.ErrorCount);
  530. ST^.SetText(
  531. FormatStrF(
  532. 'Main file: %s'#13+
  533. '%s'+#13#13+
  534. 'Target: %12s '+ 'Line number: %7d'+#13+
  535. 'Free memory: %6dK '+'Total lines: %7d'+#13+
  536. 'Total errors: %5d',
  537. FormatParams)
  538. );
  539. KeyST^.SetText(^C+KeyS);
  540. {$ifdef TEMPHEAP}
  541. switch_to_temp_heap;
  542. {$endif TEMPHEAP}
  543. end;
  544. {****************************************************************************
  545. Compiler Hooks
  546. ****************************************************************************}
  547. function CompilerStatus: boolean; {$ifndef FPC}far;{$endif}
  548. var
  549. event : tevent;
  550. begin
  551. GetKeyEvent(Event);
  552. if (Event.What=evKeyDown) and (Event.KeyCode=kbEsc) then
  553. begin
  554. CompilationPhase:=cpAborted;
  555. { update info messages }
  556. if assigned(CompilerStatusDialog) then
  557. begin
  558. {$ifdef redircompiler}
  559. RedirDisableAll;
  560. {$endif}
  561. CompilerStatusDialog^.Update;
  562. {$ifdef redircompiler}
  563. RedirEnableAll;
  564. {$endif}
  565. end;
  566. CompilerStatus:=true;
  567. exit;
  568. end;
  569. { only display line info every 100 lines, ofcourse all other messages
  570. will be displayed directly }
  571. if (status.currentline mod 100=0) then
  572. begin
  573. { update info messages }
  574. {$ifdef redircompiler}
  575. RedirDisableAll;
  576. {$endif}
  577. if assigned(CompilerStatusDialog) then
  578. CompilerStatusDialog^.Update;
  579. {$ifdef redircompiler}
  580. RedirEnableAll;
  581. {$endif}
  582. { update memory usage }
  583. { HeapView^.Update; }
  584. end;
  585. CompilerStatus:=false;
  586. end;
  587. procedure CompilerStop; {$ifndef FPC}far;{$endif}
  588. begin
  589. {$ifndef GABOR}
  590. if StopJmpValid then
  591. Longjmp(StopJmp,1)
  592. else
  593. Halt(1);
  594. {$endif}
  595. end;
  596. Function CompilerGetNamedFileTime(const filename : string) : Longint; {$ifndef FPC}far;{$endif}
  597. var t: longint;
  598. W: PSourceWindow;
  599. begin
  600. W:=EditorWindowFile(FExpand(filename));
  601. if Assigned(W) and (W^.Editor^.GetModified) then
  602. t:=Now
  603. else
  604. t:=def_getnamedfiletime(filename);
  605. CompilerGetNamedFileTime:=t;
  606. end;
  607. {$ifdef COMPILER_1_0}
  608. function CompilerOpenInputFile(const filename: string): pinputfile; {$ifndef FPC}far;{$endif}
  609. var f: pinputfile;
  610. W: PSourceWindow;
  611. begin
  612. W:=EditorWindowFile(FExpand(filename));
  613. if Assigned(W) and (W^.Editor^.GetModified) then
  614. f:=new(PFPInputFile, Init(W^.Editor))
  615. else
  616. f:={$ifndef GABOR}def_openinputfile(filename){$else}nil{$endif};
  617. if assigned(W) then
  618. W^.Editor^.CompileStamp:=CompileStamp;
  619. CompilerOpenInputFile:=f;
  620. end;
  621. {$else COMPILER_1_0}
  622. function CompilerOpenInputFile(const filename: string): tinputfile; {$ifndef FPC}far;{$endif}
  623. var f: tinputfile;
  624. W: PSourceWindow;
  625. begin
  626. W:=EditorWindowFile(FExpand(filename));
  627. if Assigned(W) and (W^.Editor^.GetModified) then
  628. f:=TFPInputFile.Create(W^.Editor)
  629. else
  630. f:={$ifndef GABOR}def_openinputfile(filename){$else}nil{$endif};
  631. if assigned(W) then
  632. W^.Editor^.CompileStamp:=CompileStamp;
  633. CompilerOpenInputFile:=f;
  634. end;
  635. {$endif COMPILER_1_0}
  636. function CompilerComment(Level:Longint; const s:string):boolean; {$ifndef FPC}far;{$endif}
  637. begin
  638. {$ifdef TEMPHEAP}
  639. switch_to_base_heap;
  640. {$endif TEMPHEAP}
  641. CompilerComment:=false;
  642. {$ifndef DEV}
  643. if (status.verbosity and Level)=Level then
  644. {$endif}
  645. begin
  646. {$ifdef redircompiler}
  647. RedirDisableAll;
  648. {$endif}
  649. if not CompilerMessageWindow^.GetState(sfVisible) then
  650. CompilerMessageWindow^.Show;
  651. if Desktop^.First<>PView(CompilerMessageWindow) then
  652. CompilerMessageWindow^.MakeFirst;
  653. CompilerMessageWindow^.AddMessage(Level,S,status.currentsourcepath+status.currentsource,
  654. status.currentline,status.currentcolumn);
  655. { update info messages }
  656. if assigned(CompilerStatusDialog) then
  657. CompilerStatusDialog^.Update;
  658. {$ifdef DEBUG}
  659. {$ifndef NODEBUG}
  660. // def_gdb_stop(level);
  661. {$endif}
  662. {$endif DEBUG}
  663. {$ifdef redircompiler}
  664. RedirEnableAll;
  665. {$endif}
  666. { update memory usage }
  667. { HeapView^.Update; }
  668. end;
  669. {$ifdef TEMPHEAP}
  670. switch_to_temp_heap;
  671. {$endif TEMPHEAP}
  672. end;
  673. {****************************************************************************
  674. DoCompile
  675. ****************************************************************************}
  676. { This function must return '' if
  677. "Options|Directories|Exe and PPU directory" is empty }
  678. function GetExePath: string;
  679. var Path: string;
  680. I: Sw_integer;
  681. begin
  682. Path:='';
  683. if DirectorySwitches<>nil then
  684. with DirectorySwitches^ do
  685. for I:=0 to ItemCount-1 do
  686. begin
  687. if ItemParam(I)='-FE' then
  688. begin
  689. Path:=GetStringItem(I);
  690. Break;
  691. end;
  692. end;
  693. if Path<>'' then
  694. GetExePath:=CompleteDir(FExpand(Path))
  695. else
  696. GetExePath:='';
  697. end;
  698. function GetMainFile(Mode: TCompileMode): string;
  699. var FileName: string;
  700. P : PSourceWindow;
  701. begin
  702. P:=Message(Desktop,evBroadcast,cmSearchWindow,nil);
  703. if (PrimaryFileMain='') and (P=nil) then
  704. FileName:='' { nothing to compile }
  705. else
  706. begin
  707. if (PrimaryFileMain<>'') and (Mode<>cCompile) then
  708. FileName:=PrimaryFileMain
  709. else if assigned(P) then
  710. begin
  711. FileName:=P^.Editor^.FileName;
  712. if FileName='' then
  713. P^.Editor^.SaveAsk(true);
  714. FileName:=P^.Editor^.FileName;
  715. end
  716. else
  717. FileName:='';
  718. end;
  719. If (FileName<>'') then
  720. FileName:=FixFileName(FExpand(FileName));
  721. GetMainFile:=FileName;
  722. end;
  723. procedure ResetErrorMessages;
  724. procedure ResetErrorLine(P: PView); {$ifndef FPC}far;{$endif}
  725. begin
  726. if assigned(P) and
  727. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  728. PSourceWindow(P)^.Editor^.SetErrorMessage('');
  729. end;
  730. begin
  731. Desktop^.ForEach(@ResetErrorLine);
  732. end;
  733. procedure DoCompile(Mode: TCompileMode);
  734. function IsExitEvent(E: TEvent): boolean;
  735. begin
  736. { following suggestion by Harsha Senanayake }
  737. IsExitEvent:=(E.What=evKeyDown);
  738. end;
  739. var
  740. s,FileName: string;
  741. ErrFile : Text;
  742. MustRestartDebugger : boolean;
  743. JmpRet,Error,LinkErrorCount : longint;
  744. E : TEvent;
  745. DummyView: PView;
  746. PPasFile : string[64];
  747. begin
  748. AskRecompileIfModifiedFlag:=true;
  749. { Get FileName }
  750. FileName:=GetMainFile(Mode);
  751. if FileName='' then
  752. begin
  753. ErrorBox(msg_nothingtocompile,nil);
  754. Exit;
  755. end else
  756. { THis is not longer necessary as unsaved files are loaded from a memorystream,
  757. and with the file as primaryfile set it is already incompatible with itself
  758. if FileName='*' then
  759. begin
  760. ErrorBox(msg_cantcompileunsavedfile,nil);
  761. Exit;
  762. end; }
  763. PushStatus('Beginning compilation...');
  764. { Show Compiler Messages Window }
  765. { if not CompilerMessageWindow^.GetState(sfVisible) then
  766. CompilerMessageWindow^.Show;
  767. CompilerMessageWindow^.MakeFirst;}
  768. CompilerMessageWindow^.ClearMessages;
  769. { Tell why we compile }
  770. NeedRecompile(Mode,true);
  771. MainFile:=FileName;
  772. SetStatus('Writing switches to file...');
  773. WriteSwitches(SwitchesPath);
  774. { leaving open browsers leads to crashes !! (PM) }
  775. SetStatus('Preparing symbol info...');
  776. CloseAllBrowsers;
  777. if ((DesktopFileFlags and dfSymbolInformation)<>0) then
  778. WriteSymbolsFile(BrowserName);
  779. { MainFile:=FixFileName(FExpand(FileName));}
  780. SetStatus('Preparing to compile...'+NameOf(MainFile));
  781. If GetEXEPath<>'' then
  782. EXEFile:=FixFileName(GetEXEPath+NameOf(MainFile)+ExeExt)
  783. else
  784. EXEFile:=DirOf(MainFile)+NameOf(MainFile)+ExeExt;
  785. { Reset }
  786. CtrlBreakHit:=false;
  787. { Create Compiler Status Dialog }
  788. CompilationPhase:=cpCompiling;
  789. New(CompilerStatusDialog, Init);
  790. CompilerStatusDialog^.SetState(sfModal,true);
  791. { disable window closing }
  792. CompilerStatusDialog^.Flags:=CompilerStatusDialog^.Flags and not wfclose;
  793. Application^.Insert(CompilerStatusDialog);
  794. CompilerStatusDialog^.Update;
  795. { hook compiler output }
  796. {$ifdef TP}
  797. do_status:=CompilerStatus;
  798. do_stop:=CompilerStop;
  799. do_comment:=CompilerComment;
  800. {$ifndef GABOR}do_openinputfile:=CompilerOpenInputFile;{$endif}
  801. do_getnamedfiletime:=CompilerGetNamedFileTime;
  802. {$else not TP}
  803. do_status:=@CompilerStatus;
  804. do_stop:=@CompilerStop;
  805. do_comment:=@CompilerComment;
  806. do_openinputfile:=@CompilerOpenInputFile;
  807. do_getnamedfiletime:=@CompilerGetNamedFileTime;
  808. {$endif TP}
  809. do_initsymbolinfo:={$ifdef fpc}@{$endif}InitBrowserCol;
  810. do_donesymbolinfo:={$ifdef fpc}@{$endif}DoneBrowserCol;
  811. do_extractsymbolinfo:={$ifdef fpc}@{$endif}CreateBrowserCol;
  812. { Compile ! }
  813. {$ifdef redircompiler}
  814. ChangeRedirOut(FPOutFileName,false);
  815. ChangeRedirError(FPErrFileName,false);
  816. {$endif}
  817. {$ifdef TEMPHEAP}
  818. split_heap;
  819. switch_to_temp_heap;
  820. {$endif TEMPHEAP}
  821. { insert "" around name so that spaces are allowed }
  822. { only supported in compiler after 2000/01/14 PM }
  823. if pos(' ',FileName)>0 then
  824. FileName:='"'+FileName+'"';
  825. if mode=cBuild then
  826. FileName:='-B '+FileName;
  827. { tokens are created and distroed by compiler.compile !! PM }
  828. DoneTokens;
  829. {$ifdef COMPILER_1_0}
  830. PPasFile:='ppas'+source_os.scriptext;
  831. {$else COMPILER_1_0}
  832. PPasFile:='ppas'+source_info.scriptext;
  833. {$endif COMPILER_1_0}
  834. WUtils.DeleteFile(GetExePath+PpasFile);
  835. SetStatus('Compiling...');
  836. {$ifndef GABOR}
  837. StopJmpValid:=true;
  838. JmpRet:=SetJmp(StopJmp);
  839. if JmpRet=0 then
  840. begin
  841. inc(CompileStamp);
  842. ResetErrorMessages;
  843. {$ifndef NODEBUG}
  844. MustRestartDebugger:=false;
  845. if assigned(Debugger) then
  846. if Debugger^.HasExe then
  847. begin
  848. Debugger^.Reset;
  849. MustRestartDebugger:=true;
  850. end;
  851. {$endif NODEBUG}
  852. LastCompileTime := cardinal(Now);
  853. FpIntF.Compile(FileName,SwitchesPath);
  854. SetStatus('Finished compiling...');
  855. end
  856. else
  857. begin
  858. Inc(status.errorCount);
  859. {$ifdef HasSignal}
  860. Case JmpRet of
  861. SIGINT : s := 'Interrupted by Ctrl-C';
  862. SIGILL : s := 'Illegal instruction';
  863. SIGSEGV : s := 'Signal Segmentation violation';
  864. SIGFPE : s:='Floating point signal';
  865. else
  866. s:='Undetermined signal '+inttostr(JmpRet);
  867. end;
  868. CompilerMessageWindow^.AddMessage(V_error,s+' during compilation','',0,0);
  869. {$endif HasSignal}
  870. CompilerMessageWindow^.AddMessage(V_error,'Long jumped out of compilation...','',0,0);
  871. SetStatus('Long jumped out of compilation...');
  872. end;
  873. StopJmpValid:=false;
  874. {$endif}
  875. { tokens are created and distroyed by compiler.compile !! PM }
  876. InitTokens;
  877. if LinkAfter and
  878. ExistsFile(GetExePath+PpasFile) and
  879. (CompilationPhase<>cpAborted) and
  880. (status.errorCount=0) then
  881. begin
  882. CompilationPhase:=cpLinking;
  883. CompilerStatusDialog^.Update;
  884. SetStatus('Assembling and/or linking...');
  885. {$ifndef redircompiler}
  886. { At least here we want to catch output
  887. of batch file PM }
  888. ChangeRedirOut(FPOutFileName,false);
  889. ChangeRedirError(FPErrFileName,false);
  890. {$endif}
  891. {$ifdef Unix}
  892. Shell(GetExePath+PpasFile);
  893. Error:=LinuxError;
  894. {$else}
  895. DosExecute(GetEnv('COMSPEC'),'/C '+GetExePath+PpasFile);
  896. Error:=DosError;
  897. {$endif}
  898. SetStatus('Finished linking...');
  899. RestoreRedirOut;
  900. RestoreRedirError;
  901. if Error<>0 then
  902. Inc(status.errorCount);
  903. if Status.IsExe and not Status.IsLibrary and not ExistsFile(EXEFile) then
  904. begin
  905. Inc(status.errorCount);
  906. ClearFormatParams; AddFormatParamStr(ExeFile);
  907. CompilerMessageWindow^.AddMessage(V_error,FormatStrF(msg_couldnotcreatefile,FormatParams),'',0,0);
  908. {$I-}
  909. Assign(ErrFile,FPErrFileName);
  910. Reset(ErrFile);
  911. if EatIO<>0 then
  912. ErrorBox(FormatStrStr(msg_cantopenfile,FPErrFileName),nil)
  913. else
  914. begin
  915. LinkErrorCount:=0;
  916. While not eof(ErrFile) and (LinkErrorCount<25) do
  917. begin
  918. readln(ErrFile,s);
  919. CompilerMessageWindow^.AddMessage(V_error,s,'',0,0);
  920. inc(LinkErrorCount);
  921. end;
  922. if not eof(ErrFile) then
  923. begin
  924. ClearFormatParams; AddFormatParamStr(FPErrFileName);
  925. CompilerMessageWindow^.AddMessage(V_error,
  926. FormatStrF(msg_therearemoreerrorsinfile,FormatParams),'',0,0);
  927. end;
  928. Close(ErrFile);
  929. end;
  930. EatIO;
  931. {$I+}
  932. end
  933. else if error=0 then
  934. WUtils.DeleteFile(GetExePath+PpasFile);
  935. end;
  936. {$ifdef TEMPHEAP}
  937. switch_to_base_heap;
  938. {$endif TEMPHEAP}
  939. {$ifdef redircompiler}
  940. RestoreRedirOut;
  941. RestoreRedirError;
  942. {$endif}
  943. PopStatus;
  944. { Set end status }
  945. if not (CompilationPhase in [cpAborted,cpFailed]) then
  946. if (status.errorCount=0) then
  947. CompilationPhase:=cpDone
  948. else
  949. CompilationPhase:=cpFailed;
  950. { Show end status }
  951. { reenable window closing }
  952. CompilerStatusDialog^.Flags:=CompilerStatusDialog^.Flags or wfclose;
  953. CompilerStatusDialog^.Update;
  954. CompilerStatusDialog^.ReDraw;
  955. CompilerStatusDialog^.SetState(sfModal,false);
  956. if ((CompilationPhase in[cpAborted,cpDone,cpFailed]) or (ShowStatusOnError)) and (Mode<>cRun) then
  957. repeat
  958. CompilerStatusDialog^.GetEvent(E);
  959. if IsExitEvent(E)=false then
  960. CompilerStatusDialog^.HandleEvent(E);
  961. until IsExitEvent(E) or not assigned(CompilerStatusDialog);
  962. if assigned(CompilerStatusDialog) then
  963. begin
  964. Application^.Delete(CompilerStatusDialog);
  965. Dispose(CompilerStatusDialog, Done);
  966. end;
  967. CompilerStatusDialog:=nil;
  968. { end compilation returns true if the messagewindow should be removed }
  969. if CompilationPhase=cpDone then
  970. begin
  971. CompilerMessageWindow^.Hide;
  972. { This is the last compiled main file }
  973. PrevMainFile:=MainFile;
  974. MainHasDebugInfo:=DebugInfoSwitches^.GetCurrSelParam<>'-';
  975. end;
  976. { Update the app }
  977. Message(Application,evCommand,cmUpdate,nil);
  978. {$ifdef TEMPHEAP}
  979. releasetempheap;
  980. unsplit_heap;
  981. {$endif TEMPHEAP}
  982. DummyView:=Desktop^.First;
  983. while (DummyView<>nil) and (DummyView^.GetState(sfVisible)=false) do
  984. begin
  985. DummyView:=DummyView^.NextView;
  986. end;
  987. with DummyView^ do
  988. if GetState(sfVisible) then
  989. begin
  990. SetState(sfSelected,false);
  991. SetState(sfSelected,true);
  992. end;
  993. if Assigned(CompilerMessageWindow) then
  994. with CompilerMessageWindow^ do
  995. begin
  996. if GetState(sfVisible) then
  997. begin
  998. SetState(sfSelected,false);
  999. SetState(sfSelected,true);
  1000. end;
  1001. if (status.errorCount>0) then
  1002. MsgLB^.SelectFirstError;
  1003. end;
  1004. { ^^^ we need this trick to reactivate the desktop }
  1005. EditorModified:=false;
  1006. {$ifndef NODEBUG}
  1007. if MustRestartDebugger then
  1008. InitDebugger;
  1009. {$endif NODEBUG}
  1010. { In case we have something that the compiler touched }
  1011. AskToReloadAllModifiedFiles;
  1012. { Try to read Browser info in again if compilation failure !! }
  1013. if Not Assigned(Modules) and (CompilationPhase<>cpDone) and
  1014. ((DesktopFileFlags and dfSymbolInformation)<>0) then
  1015. ReadSymbolsFile(BrowserName);
  1016. end;
  1017. function NeedRecompile(Mode :TCompileMode; verbose : boolean): boolean;
  1018. var Need: boolean;
  1019. I: sw_integer;
  1020. SF: PSourceFile;
  1021. SourceTime,PPUTime,ObjTime: longint;
  1022. W: PSourceWindow;
  1023. begin
  1024. if Assigned(SourceFiles)=false then
  1025. Need:={(EditorModified=true)}true
  1026. else
  1027. begin
  1028. Need:=(PrevMainFile<>GetMainFile(Mode)) and (PrevMainFile<>'');
  1029. if Need then
  1030. begin
  1031. if verbose then
  1032. begin
  1033. ClearFormatParams; AddFormatParamStr(GetMainFile(Mode));
  1034. CompilerMessageWindow^.AddMessage(V_info,
  1035. FormatStrF(msg_firstcompilationof,FormatParams),
  1036. '',0,0);
  1037. end;
  1038. end
  1039. else
  1040. for I:=0 to SourceFiles^.Count-1 do
  1041. begin
  1042. SF:=SourceFiles^.At(I);
  1043. SourceTime:=GetFileTime(SF^.GetSourceFileName);
  1044. PPUTime:=GetFileTime(SF^.GetPPUFileName);
  1045. ObjTime:=GetFileTime(SF^.GetObjFileName);
  1046. { writeln('S: ',SF^.GetSourceFileName,' - ',SourceTime);
  1047. writeln('P: ',SF^.GetPPUFileName,' - ',PPUTime);
  1048. writeln('O: ',SF^.GetObjFileName,' - ',ObjTime);
  1049. writeln('------');}
  1050. { some units don't generate object files }
  1051. W:=EditorWindowFile(SF^.GetSourceFileName);
  1052. if (SourceTime<>-1) then
  1053. if ((SourceTime>PPUTime) or
  1054. ((SourceTime>ObjTime) and
  1055. (ObjTime<>-1))) or
  1056. (assigned(W) and (W^.Editor^.CompileStamp<0)) then
  1057. begin
  1058. Need:=true;
  1059. if verbose then
  1060. begin
  1061. ClearFormatParams; AddFormatParamStr(SF^.GetSourceFileName);
  1062. CompilerMessageWindow^.AddMessage(V_info,
  1063. FormatStrF(msg_recompilingbecauseof,FormatParams),
  1064. SF^.GetSourceFileName,1,1);
  1065. end;
  1066. Break;
  1067. end;
  1068. end;
  1069. { writeln('Need?', Need); system.readln;}
  1070. end;
  1071. NeedRecompile:=Need;
  1072. end;
  1073. {$ifdef COMPILER_1_0}
  1074. constructor TFPInputFile.Init(AEditor: PFileEditor);
  1075. begin
  1076. if not Assigned(AEditor) then Fail;
  1077. if inherited Init(AEditor^.FileName)=false then
  1078. Fail;
  1079. Editor:=AEditor;
  1080. end;
  1081. {$else COMPILER_1_0}
  1082. constructor TFPInputFile.Create(AEditor: PFileEditor);
  1083. begin
  1084. if not Assigned(AEditor) then Fail;
  1085. if inherited Create(AEditor^.FileName)=nil then
  1086. Fail;
  1087. Editor:=AEditor;
  1088. end;
  1089. {$endif COMPILER_1_0}
  1090. function TFPInputFile.fileopen(const filename: string): boolean;
  1091. var OK: boolean;
  1092. begin
  1093. S:=New(PMemoryStream, Init(0,0));
  1094. OK:=Assigned(S) and (S^.Status=stOK);
  1095. if OK then OK:=Editor^.SaveToStream(S);
  1096. if OK then
  1097. S^.Seek(0)
  1098. else
  1099. begin
  1100. if Assigned(S) then Dispose(S, Done);
  1101. S:=nil;
  1102. end;
  1103. fileopen:=OK;
  1104. end;
  1105. function TFPInputFile.fileseek(pos: longint): boolean;
  1106. var OK: boolean;
  1107. begin
  1108. OK:=assigned(S);
  1109. if OK then
  1110. begin
  1111. S^.Reset;
  1112. S^.Seek(pos);
  1113. OK:=(S^.Status=stOK);
  1114. end;
  1115. fileseek:=OK;
  1116. end;
  1117. function TFPInputFile.fileread(var databuf; maxsize: longint): longint;
  1118. var
  1119. size: longint;
  1120. begin
  1121. if not assigned(S) then size:=0 else
  1122. begin
  1123. size:=min(maxsize,(S^.GetSize-S^.GetPos));
  1124. S^.Read(databuf,size);
  1125. if S^.Status<>stOK then size:=0;
  1126. end;
  1127. fileread:=size;
  1128. end;
  1129. function TFPInputFile.fileeof: boolean;
  1130. var EOF: boolean;
  1131. begin
  1132. EOF:=not assigned(S);
  1133. if not EOF then
  1134. EOF:=(S^.Status<>stOK) or (S^.GetPos=S^.GetSize);
  1135. fileeof:=EOF;
  1136. end;
  1137. function TFPInputFile.fileclose: boolean;
  1138. var OK: boolean;
  1139. begin
  1140. OK:=assigned(S);
  1141. if OK then
  1142. begin
  1143. S^.Reset;
  1144. Dispose(S, Done);
  1145. OK:=true;
  1146. end;
  1147. fileclose:=OK;
  1148. end;
  1149. procedure RegisterFPCompile;
  1150. begin
  1151. {$ifndef NOOBJREG}
  1152. RegisterType(RCompilerMessageListBox);
  1153. RegisterType(RCompilerMessageWindow);
  1154. {$endif}
  1155. end;
  1156. end.
  1157. {
  1158. $Log$
  1159. Revision 1.6 2001-11-13 01:58:34 carl
  1160. * Range check error fix
  1161. Revision 1.5 2001/10/03 10:21:43 pierre
  1162. fix for bug 1487
  1163. Revision 1.4 2001/09/18 11:33:26 pierre
  1164. * fix bug 1604
  1165. Revision 1.3 2001/09/12 09:25:01 pierre
  1166. * fix bug 1585
  1167. Revision 1.2 2001/08/05 02:01:47 peter
  1168. * FVISION define to compile with fvision units
  1169. Revision 1.1 2001/08/04 11:30:22 peter
  1170. * ide works now with both compiler versions
  1171. Revision 1.1.2.24 2001/06/07 16:41:12 jonas
  1172. * updated for stricter checking of @ for procvars
  1173. Revision 1.1.2.23 2001/05/09 15:42:08 pierre
  1174. Reset debugger before recompilation
  1175. Revision 1.1.2.22 2001/03/15 17:07:33 pierre
  1176. * avoid scrolling in Compiler Dialog window
  1177. Revision 1.1.2.21 2001/02/19 10:38:12 pierre
  1178. * completely stop the debugger while compiling
  1179. Revision 1.1.2.20 2001/02/13 16:04:01 pierre
  1180. * fixes for bugs 1280
  1181. Revision 1.1.2.19 2001/02/13 12:05:10 pierre
  1182. * fix for bug 1379
  1183. Revision 1.1.2.18 2000/12/30 22:52:27 peter
  1184. * check modified while in debug mode. But placed it between a
  1185. conditional again as it reports also if the file was already modified
  1186. before the first compile.
  1187. * remove unsaved file checks when compiling without primary file so it
  1188. works the same as with a primary file set.
  1189. Revision 1.1.2.17 2000/12/23 23:07:57 florian
  1190. * better message for unsaved files
  1191. Revision 1.1.2.16 2000/11/29 00:54:44 pierre
  1192. + preserve window number and save special windows
  1193. Revision 1.1.2.15 2000/11/27 11:44:05 pierre
  1194. * remove the Can't open fp__.err problem
  1195. Revision 1.1.2.14 2000/11/23 13:00:47 pierre
  1196. + better infos while compiling
  1197. Revision 1.1.2.13 2000/11/19 00:23:32 pierre
  1198. Task 23: nicer error message when trying to run unit or library
  1199. Revision 1.1.2.12 2000/11/16 23:06:30 pierre
  1200. * correct handling of Compile/Make if primary file is set
  1201. Revision 1.1.2.11 2000/11/14 17:40:02 pierre
  1202. * fix the linking problem in another directory
  1203. Revision 1.1.2.10 2000/11/14 09:23:55 marco
  1204. * Second batch
  1205. Revision 1.1.2.9 2000/11/06 16:55:48 pierre
  1206. * fix failure to recompile when file changed
  1207. Revision 1.1.2.8 2000/10/31 07:51:58 pierre
  1208. * recover gracefully if compiler generates a signal
  1209. Revision 1.1.2.7 2000/10/18 21:53:26 pierre
  1210. * several Gabor fixes
  1211. Revision 1.1.2.6 2000/10/09 16:28:24 pierre
  1212. * several linux enhancements
  1213. Revision 1.1.2.5 2000/10/03 16:15:57 pierre
  1214. * Use LongJmp in CompilerStop
  1215. Revision 1.1.2.4 2000/08/16 18:46:14 peter
  1216. [*] double clicking on a droplistbox caused GPF (due to invalid recurson)
  1217. [*] Make, Build now possible even in Compiler Messages Window
  1218. [+] when started in a new dir the IDE now ask whether to create a local
  1219. config, or to use the one located in the IDE dir
  1220. Revision 1.1.2.3 2000/08/15 03:40:53 peter
  1221. [*] no more fatal exits when the IDE can't find the error file (containing
  1222. the redirected assembler/linker output) after compilation
  1223. [*] hidden windows are now added always at the end of the Window List
  1224. [*] TINIFile parsed entries encapsulated in string delimiters incorrectly
  1225. [*] selection was incorrectly adjusted when typing in overwrite mode
  1226. [*] the line wasn't expanded when it's end was reached in overw. mode
  1227. [*] the IDE now tries to locate source files also in the user specified
  1228. unit dirs (for ex. as a response to 'Open at cursor' (Ctrl+Enter) )
  1229. [*] 'Open at cursor' is now aware of the extension (if specified)
  1230. Revision 1.1.2.2 2000/08/10 07:10:37 michael
  1231. * 'Auto save editor files' option did the opposite than expected, due
  1232. to a typo in FPIDE.PAS
  1233. + saving of source files before compilation is no longer neccessary.
  1234. When a modified editor file is involved in the compilation, then the
  1235. IDE saves it's contents to a memory stream and passes this to the
  1236. compiler (instead of the file on the disk)
  1237. Revision 1.1.2.1 2000/07/18 05:50:22 michael
  1238. + Merged Gabors fixes
  1239. Revision 1.1 2000/07/13 09:48:34 michael
  1240. + Initial import
  1241. Revision 1.60 2000/06/22 09:07:11 pierre
  1242. * Gabor changes: see fixes.txt
  1243. Revision 1.59 2000/06/16 08:50:40 pierre
  1244. + new bunch of Gabor's changes
  1245. Revision 1.58 2000/05/29 10:44:56 pierre
  1246. + New bunch of Gabor's changes: see fixes.txt
  1247. Revision 1.57 2000/05/02 08:42:27 pierre
  1248. * new set of Gabor changes: see fixes.txt
  1249. Revision 1.56 2000/04/25 08:42:32 pierre
  1250. * New Gabor changes : see fixes.txt
  1251. Revision 1.55 2000/04/18 11:42:36 pierre
  1252. lot of Gabor changes : see fixes.txt
  1253. Revision 1.54 2000/03/23 22:23:21 pierre
  1254. + Use PushStatus in ParseUserScreen
  1255. Revision 1.53 2000/03/21 23:33:18 pierre
  1256. adapted to wcedit addition by Gabor
  1257. Revision 1.52 2000/03/08 16:48:07 pierre
  1258. + Read BackTrace from UseScreen
  1259. Revision 1.51 2000/03/07 21:54:26 pierre
  1260. + ParseUserScreen
  1261. Revision 1.50 2000/02/06 23:41:42 pierre
  1262. + TCompilerMessageListBox.SelectFirstError
  1263. Revision 1.49 2000/01/25 00:26:35 pierre
  1264. + Browser info saving
  1265. Revision 1.48 2000/01/14 15:38:28 pierre
  1266. + support for long filenames with spaces for compilation
  1267. * avoid too long linker error output
  1268. Revision 1.47 2000/01/03 11:38:33 michael
  1269. Changes from Gabor
  1270. Revision 1.46 1999/12/01 17:08:19 pierre
  1271. * GetFileTime moved to wutils unit
  1272. Revision 1.45 1999/11/22 15:58:40 pierre
  1273. * fix for web bug 633
  1274. Revision 1.44 1999/11/21 01:44:34 pierre
  1275. + Use def_gdb_stop for easy GDB debugging
  1276. Revision 1.43 1999/11/18 13:49:56 pierre
  1277. + use IsExe var to know if we need to call ppas
  1278. Revision 1.42 1999/11/10 17:20:41 pierre
  1279. * Use fpredir.dosexecute
  1280. Revision 1.41 1999/10/25 16:34:19 pierre
  1281. * some units have no object files
  1282. led to wrong NeedRecompile result
  1283. Revision 1.40 1999/09/20 15:36:38 pierre
  1284. * adapted to new tokens unit
  1285. Revision 1.39 1999/09/16 14:34:57 pierre
  1286. + TBreakpoint and TWatch registering
  1287. + WatchesCollection and BreakpointsCollection stored in desk file
  1288. * Syntax highlighting was broken
  1289. Revision 1.38 1999/09/13 16:24:43 peter
  1290. + clock
  1291. * backspace unident like tp7
  1292. Revision 1.37 1999/09/09 14:19:16 pierre
  1293. * status should not be present in TCompilerMessage.GetText
  1294. Revision 1.36 1999/09/07 11:32:13 pierre
  1295. * fix for Linux ./ prepended to ppas.sh
  1296. * Build add '-B' option
  1297. * if linkAfter is set, get errors from linker
  1298. by redirecting files
  1299. Revision 1.35 1999/08/22 22:27:30 pierre
  1300. * not ppas call on compile failure
  1301. Revision 1.34 1999/08/16 18:25:13 peter
  1302. * Adjusting the selection when the editor didn't contain any line.
  1303. * Reserved word recognition redesigned, but this didn't affect the overall
  1304. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  1305. The syntax scanner loop is a bit slow but the main problem is the
  1306. recognition of special symbols. Switching off symbol processing boosts
  1307. the performance up to ca. 200%...
  1308. * The editor didn't allow copying (for ex to clipboard) of a single character
  1309. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  1310. * Compiler Messages window (actually the whole desktop) did not act on any
  1311. keypress when compilation failed and thus the window remained visible
  1312. + Message windows are now closed upon pressing Esc
  1313. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  1314. only when neccessary
  1315. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  1316. + LineSelect (Ctrl+K+L) implemented
  1317. * The IDE had problems closing help windows before saving the desktop
  1318. Revision 1.33 1999/08/03 20:22:26 peter
  1319. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  1320. + Desktop saving should work now
  1321. - History saved
  1322. - Clipboard content saved
  1323. - Desktop saved
  1324. - Symbol info saved
  1325. * syntax-highlight bug fixed, which compared special keywords case sensitive
  1326. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  1327. * with 'whole words only' set, the editor didn't found occourences of the
  1328. searched text, if the text appeared previously in the same line, but didn't
  1329. satisfied the 'whole-word' condition
  1330. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  1331. (ie. the beginning of the selection)
  1332. * when started typing in a new line, but not at the start (X=0) of it,
  1333. the editor inserted the text one character more to left as it should...
  1334. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  1335. * Shift shouldn't cause so much trouble in TCodeEditor now...
  1336. * Syntax highlight had problems recognizing a special symbol if it was
  1337. prefixed by another symbol character in the source text
  1338. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  1339. Revision 1.32 1999/07/12 13:14:13 pierre
  1340. * LineEnd bug corrected, now goes end of text even if selected
  1341. + Until Return for debugger
  1342. + Code for Quit inside GDB Window
  1343. Revision 1.31 1999/06/28 19:32:17 peter
  1344. * fixes from gabor
  1345. Revision 1.30 1999/06/28 15:59:04 pierre
  1346. * View Linking stage if external linking
  1347. Revision 1.29 1999/06/28 12:39:14 pierre
  1348. + close all browsers before compiling
  1349. Revision 1.28 1999/06/21 23:42:16 pierre
  1350. + LinkAfter and Esc to abort support added
  1351. Revision 1.27 1999/05/22 13:44:29 peter
  1352. * fixed couple of bugs
  1353. Revision 1.26 1999/05/02 14:29:35 peter
  1354. * fixed typo disableredir -> redirdisable
  1355. Revision 1.25 1999/04/29 22:58:09 pierre
  1356. + disabling of redirction in compiler dialogs
  1357. Revision 1.24 1999/04/29 09:36:11 peter
  1358. * fixed hotkeys with Compiler switches
  1359. * fixed compiler status dialog
  1360. * Run shows again the output
  1361. Revision 1.23 1999/04/07 21:55:43 peter
  1362. + object support for browser
  1363. * html help fixes
  1364. * more desktop saving things
  1365. * NODEBUG directive to exclude debugger
  1366. Revision 1.22 1999/04/01 10:27:07 pierre
  1367. + file(line) in start of message added
  1368. Revision 1.21 1999/04/01 10:15:17 pierre
  1369. * CurrSt,InfoSt and LineSt were not disposed correctly in done
  1370. * TComiplerMessage destructor first calls SetCompileShow(false)
  1371. to get proper cleaning up
  1372. Revision 1.20 1999/03/23 16:16:38 peter
  1373. * linux fixes
  1374. Revision 1.19 1999/03/19 16:04:27 peter
  1375. * new compiler dialog
  1376. Revision 1.18 1999/03/16 12:38:07 peter
  1377. * tools macro fixes
  1378. + tph writer
  1379. + first things for resource files
  1380. Revision 1.17 1999/03/12 01:13:56 peter
  1381. * flag if trytoopen should look for other extensions
  1382. + browser tab in the tools-compiler
  1383. Revision 1.16 1999/03/07 23:00:47 pierre
  1384. * Fix for path of executable
  1385. Revision 1.15 1999/03/01 15:41:50 peter
  1386. + Added dummy entries for functions not yet implemented
  1387. * MenuBar didn't update itself automatically on command-set changes
  1388. * Fixed Debugging/Profiling options dialog
  1389. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  1390. set
  1391. * efBackSpaceUnindents works correctly
  1392. + 'Messages' window implemented
  1393. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  1394. + Added TP message-filter support (for ex. you can call GREP thru
  1395. GREP2MSG and view the result in the messages window - just like in TP)
  1396. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  1397. so topic search didn't work...
  1398. * In FPHELP.PAS there were still context-variables defined as word instead
  1399. of THelpCtx
  1400. * StdStatusKeys() was missing from the statusdef for help windows
  1401. + Topic-title for index-table can be specified when adding a HTML-files
  1402. Revision 1.14 1999/02/22 12:46:56 peter
  1403. * small fixes for linux and grep
  1404. Revision 1.13 1999/02/22 11:51:33 peter
  1405. * browser updates from gabor
  1406. Revision 1.12 1999/02/22 11:29:36 pierre
  1407. + added col info in MessageItem
  1408. + grep uses HighLightExts and should work for linux
  1409. Revision 1.11 1999/02/08 09:31:00 florian
  1410. + some split heap stuff, in $ifdef TEMPHEAP
  1411. Revision 1.10 1999/02/05 13:51:39 peter
  1412. * unit name of FPSwitches -> FPSwitch which is easier to use
  1413. * some fixes for tp7 compiling
  1414. Revision 1.9 1999/02/05 13:06:28 pierre
  1415. * allow cmClose for Compilation Dialog box
  1416. Revision 1.8 1999/02/04 13:32:01 pierre
  1417. * Several things added (I cannot commit them independently !)
  1418. + added TBreakpoint and TBreakpointCollection
  1419. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  1420. + Breakpoint list in INIFile
  1421. * Select items now also depend of SwitchMode
  1422. * Reading of option '-g' was not possible !
  1423. + added search for -Fu args pathes in TryToOpen
  1424. + added code for automatic opening of FileDialog
  1425. if source not found
  1426. Revision 1.7 1999/01/21 11:54:11 peter
  1427. + tools menu
  1428. + speedsearch in symbolbrowser
  1429. * working run command
  1430. Revision 1.6 1999/01/15 16:12:43 peter
  1431. * fixed crash after compile
  1432. Revision 1.5 1999/01/14 21:42:19 peter
  1433. * source tracking from Gabor
  1434. Revision 1.4 1999/01/12 14:29:32 peter
  1435. + Implemented still missing 'switch' entries in Options menu
  1436. + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
  1437. ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
  1438. ASCII chars and inserted directly in the text.
  1439. + Added symbol browser
  1440. * splitted fp.pas to fpide.pas
  1441. Revision 1.3 1999/01/04 11:49:42 peter
  1442. * 'Use tab characters' now works correctly
  1443. + Syntax highlight now acts on File|Save As...
  1444. + Added a new class to syntax highlight: 'hex numbers'.
  1445. * There was something very wrong with the palette managment. Now fixed.
  1446. + Added output directory (-FE<xxx>) support to 'Directories' dialog...
  1447. * Fixed some possible bugs in Running/Compiling, and the compilation/run
  1448. process revised
  1449. Revision 1.2 1998/12/28 15:47:42 peter
  1450. + Added user screen support, display & window
  1451. + Implemented Editor,Mouse Options dialog
  1452. + Added location of .INI and .CFG file
  1453. + Option (INI) file managment implemented (see bottom of Options Menu)
  1454. + Switches updated
  1455. + Run program
  1456. Revision 1.3 1998/12/22 10:39:40 peter
  1457. + options are now written/read
  1458. + find and replace routines
  1459. }