fpcompil.pas 48 KB

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