fpcompil.pas 49 KB

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