SourceFileUnit.pas 71 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666
  1. {
  2. TIGCC IDE
  3. Copyright (C) 2000-2004 Sebastian Reichelt
  4. Copyright (C) 2005-2006 Kevin Kofler
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2, or (at your option)
  8. any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software Foundation,
  15. Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  16. }
  17. unit SourceFileUnit;
  18. interface
  19. uses
  20. FolderUnit,
  21. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  22. StdCtrls, ExtCtrls, ComCtrls,
  23. MemoComponentUnit, SourceEditUnit;
  24. type
  25. TSourceFile = class;
  26. TSourceFileType = (ftCFile, ftGNUAsmFile, ftA68kAsmFile, ftQuillFile, ftOther);
  27. TBugType = (btError, btWarning, btInfo);
  28. TErrorCallback = procedure(const Line: string; BugTp: TBugType; SourceF: string; ErrFunc: string; ErrMessage: string; SourceLn: Integer; Offset: Integer) of object;
  29. TSourceFileFunction = record
  30. Name: string;
  31. PrototypeLine,
  32. ImplementationLine: Integer;
  33. end;
  34. TSourceFileFunctions = array of TSourceFileFunction;
  35. PSourceFileFunctions = ^TSourceFileFunctions;
  36. TSourceFileClass = class of TSourceFile;
  37. TSourceFiles = class(TCollection)
  38. public
  39. constructor Create;
  40. function FindFile(const FN: string): TSourceFile;
  41. function FindFileWithoutExt(const FN: string): TSourceFile;
  42. function FindFileNameOnly(const FN: string): TSourceFile;
  43. function FindFileOfType(FileType: TSourceFileClass): TSourceFile;
  44. function FindFileOfTypeInProject(FileType: TSourceFileClass): TSourceFile;
  45. end;
  46. TSourceFile = class(TCollectionItem)
  47. private
  48. FFileName: string;
  49. FParentForm: TForm;
  50. FTreeItem: TTreeNode;
  51. FInvalidated: Boolean;
  52. FOnError: TErrorCallback;
  53. FErrorList: TListView;
  54. FModified: Boolean;
  55. FFolder: TFolder;
  56. function GetSourceName: string;
  57. procedure SetSourceName(const Value: string);
  58. function GetEditing: Boolean;
  59. function GetDynamicName: string;
  60. procedure SetEditing(const Value: Boolean);
  61. procedure SetCaption(const Value: TCaption);
  62. function GetCaption: TCaption;
  63. function GetLogicalFileName: string;
  64. function GetFolderPath: string;
  65. protected
  66. Modifying: Boolean;
  67. FLastChangeTime: Integer;
  68. class function GetCompilable: Boolean; virtual;
  69. class function GetPrintable: Boolean; virtual;
  70. function GetInProject: Boolean; virtual;
  71. procedure SetFileName(const Value: string); virtual;
  72. procedure SetModified(const Value: Boolean); virtual;
  73. function GetEditor: TWinControl; virtual;
  74. procedure ProcessErrors(const ErrText: string); virtual;
  75. procedure ProcessErrorLine(Line: string); dynamic;
  76. public
  77. class function GetClassFilter: string; virtual;
  78. class function GetClassItemName: string; virtual;
  79. class function GetClassTreeIndex: Integer; virtual;
  80. class function GetClassImageIndex: Integer; virtual;
  81. destructor Destroy; override;
  82. class function GetAppropriateClassFromName(ItemNm: string): TSourceFileClass;
  83. class function GetAppropriateClassFromExt(Ext: string): TSourceFileClass;
  84. class function GetAppropriateClassFromTreeIndex(Index: Integer): TSourceFileClass;
  85. procedure WriteToFile(const FN: string = ''; SetFN: Boolean = False); virtual;
  86. procedure LoadFromFile(const FN: string = ''; SetFN: Boolean = False); virtual;
  87. procedure Save; virtual;
  88. procedure SaveAs; virtual;
  89. class function CanSave: Boolean; virtual;
  90. procedure Compile; virtual;
  91. procedure Print(Copies: Integer; PrintRange: TPrintRange; FromPage, ToPage: Integer); virtual;
  92. function CountPages: Integer; virtual;
  93. procedure Modify;
  94. procedure WarnIfModified;
  95. procedure Invalidate;
  96. procedure Edit; virtual;
  97. procedure TestChange; virtual;
  98. procedure UpdateProgramOutput; virtual;
  99. property ClassFilter: string read GetClassFilter;
  100. property ClassItemName: string read GetClassItemName;
  101. property ClassTreeIndex: Integer read GetClassTreeIndex;
  102. property ClassImageIndex: Integer read GetClassImageIndex;
  103. property Compilable: Boolean read GetCompilable;
  104. property Printable: Boolean read GetPrintable;
  105. property InProject: Boolean read GetInProject;
  106. property Editor: TWinControl read GetEditor;
  107. property SourceName: string read GetSourceName write SetSourceName;
  108. property DynamicName: string read GetDynamicName;
  109. published
  110. property FileName: string read FFileName write SetFileName;
  111. property Editing: Boolean read GetEditing write SetEditing;
  112. property Modified: Boolean read FModified write SetModified;
  113. property Invalidated: Boolean read FInvalidated write FInvalidated;
  114. property TreeItem: TTreeNode read FTreeItem write FTreeItem;
  115. property ParentForm: TForm read FParentForm write FParentForm;
  116. property ErrorList: TListView read FErrorList write FErrorList;
  117. property Caption: TCaption read GetCaption write SetCaption;
  118. property OnError: TErrorCallback read FOnError write FOnError;
  119. property Folder: TFolder read FFolder write FFolder;
  120. property FolderPath: string read GetFolderPath;
  121. property LogicalFileName: string read GetLogicalFileName;
  122. end;
  123. TTextSourceFile = class(TSourceFile)
  124. private
  125. FModifyLevel: Integer;
  126. protected
  127. LineStartList: TIntegerList;
  128. FTempContent: string;
  129. class function GetPrintable: Boolean; override;
  130. function GetEditor: TWinControl; override;
  131. function GetTextEditor: TMemoComponent; virtual; abstract;
  132. function GetInternalTextEditor: TMemoComponent; virtual; abstract;
  133. function GetContent: string; virtual;
  134. procedure SetContent(const Value: string); virtual;
  135. procedure SetModified(const Value: Boolean); override;
  136. procedure Change(Sender: TObject); virtual;
  137. procedure ReplaceText(Sender: TObject; Pos, Change: Integer); virtual;
  138. procedure SetParentForm(const Value: TForm); virtual;
  139. property InternalTextEditor: TMemoComponent read GetInternalTextEditor;
  140. public
  141. destructor Destroy; override;
  142. procedure WriteToFile(const FN: string = ''; SetFN: Boolean = False); override;
  143. procedure LoadFromFile(const FN: string = ''; SetFN: Boolean = False); override;
  144. procedure Print(Copies: Integer; PrintRange: TPrintRange; FromPage, ToPage: Integer); override;
  145. function CountPages: Integer; override;
  146. procedure TestChange; override;
  147. procedure AskForReload; virtual;
  148. procedure UpdateEditor; virtual;
  149. function GetCompiledLineStart(Line: Integer): Integer; virtual;
  150. property TextEditor: TMemoComponent read GetTextEditor;
  151. property Content: string read GetContent write SetContent;
  152. end;
  153. TBinarySourceFile = class(TSourceFile)
  154. public
  155. class function CanSave: Boolean; override;
  156. procedure WriteToFile(const FN: string = ''; SetFN: Boolean = False); override;
  157. end;
  158. TNormalTextSourceFile = class(TTextSourceFile)
  159. private
  160. FEditor: TMemoComponent;
  161. protected
  162. function GetTextEditor: TMemoComponent; override;
  163. function GetInternalTextEditor: TMemoComponent; override;
  164. public
  165. class function GetClassFilter: string; override;
  166. class function GetClassItemName: string; override;
  167. class function GetClassTreeIndex: Integer; override;
  168. class function GetClassImageIndex: Integer; override;
  169. destructor Destroy; override;
  170. end;
  171. TSourceTextSourceFile = class(TTextSourceFile)
  172. private
  173. FEditor: TSourceEdit;
  174. function GetSourceEditor: TSourceEdit;
  175. protected
  176. function GetTextEditor: TMemoComponent; override;
  177. function GetInternalTextEditor: TMemoComponent; override;
  178. function GetContentType: TSourceFileType; virtual;
  179. property InternalSourceEditor: TSourceEdit read FEditor;
  180. public
  181. destructor Destroy; override;
  182. procedure UpdateSyntax; virtual; abstract;
  183. procedure UpdateEditor; override;
  184. procedure SplitAndWriteToFile(const FN: string); virtual;
  185. function GetFunctions: TSourceFileFunctions; virtual;
  186. property SourceEditor: TSourceEdit read GetSourceEditor;
  187. property ContentType: TSourceFileType read GetContentType;
  188. end;
  189. THeaderSourceFile = class(TSourceTextSourceFile)
  190. protected
  191. procedure SetContent(const Value: string); override;
  192. procedure SetModified(const Value: Boolean); override;
  193. function GetContentType: TSourceFileType; override;
  194. public
  195. class function GetClassFilter: string; override;
  196. class function GetClassItemName: string; override;
  197. class function GetClassTreeIndex: Integer; override;
  198. class function GetClassImageIndex: Integer; override;
  199. procedure UpdateSyntax; override;
  200. procedure UpdateEditor; override;
  201. procedure UpdateContentType(CT: TSourceFileType); virtual;
  202. end;
  203. TCSourceFile = class(TSourceTextSourceFile)
  204. protected
  205. CurErrFunction: string;
  206. InAssemblingState: Boolean;
  207. SpecialSwitches: string;
  208. class function GetCompilable: Boolean; override;
  209. procedure SetModified(const Value: Boolean); override;
  210. function GetContentType: TSourceFileType; override;
  211. procedure ProcessErrorLine(Line: string); override;
  212. procedure ProcessSFile(const SourceFile, DestFile: string);
  213. public
  214. class function GetClassFilter: string; override;
  215. class function GetClassItemName: string; override;
  216. class function GetClassTreeIndex: Integer; override;
  217. class function GetClassImageIndex: Integer; override;
  218. procedure Save; override;
  219. procedure Compile; override;
  220. procedure UpdateSyntax; override;
  221. procedure UpdateEditor; override;
  222. end;
  223. TGNUAsmSourceFile = class(TSourceTextSourceFile)
  224. protected
  225. class function GetCompilable: Boolean; override;
  226. procedure SetModified(const Value: Boolean); override;
  227. function GetContentType: TSourceFileType; override;
  228. procedure ProcessErrorLine(Line: string); override;
  229. public
  230. class function GetClassFilter: string; override;
  231. class function GetClassItemName: string; override;
  232. class function GetClassTreeIndex: Integer; override;
  233. class function GetClassImageIndex: Integer; override;
  234. procedure Save; override;
  235. procedure Compile; override;
  236. procedure UpdateSyntax; override;
  237. procedure UpdateEditor; override;
  238. end;
  239. TAsmSourceFile = class(TSourceTextSourceFile)
  240. protected
  241. class function GetCompilable: Boolean; override;
  242. procedure SetModified(const Value: Boolean); override;
  243. function GetContentType: TSourceFileType; override;
  244. public
  245. class function GetClassFilter: string; override;
  246. class function GetClassItemName: string; override;
  247. class function GetClassTreeIndex: Integer; override;
  248. class function GetClassImageIndex: Integer; override;
  249. procedure Save; override;
  250. procedure Compile; override;
  251. procedure UpdateSyntax; override;
  252. procedure UpdateEditor; override;
  253. end;
  254. TQuillSourceFile = class(TCSourceFile)
  255. protected
  256. function GetContentType: TSourceFileType; override;
  257. public
  258. class function GetClassFilter: string; override;
  259. class function GetClassItemName: string; override;
  260. class function GetClassTreeIndex: Integer; override;
  261. class function GetClassImageIndex: Integer; override;
  262. procedure Compile; override;
  263. procedure UpdateSyntax; override;
  264. end;
  265. TObjectSourceFile = class(TBinarySourceFile)
  266. public
  267. class function GetClassFilter: string; override;
  268. class function GetClassItemName: string; override;
  269. class function GetClassTreeIndex: Integer; override;
  270. class function GetClassImageIndex: Integer; override;
  271. end;
  272. TArchiveSourceFile = class(TBinarySourceFile)
  273. public
  274. class function GetClassFilter: string; override;
  275. class function GetClassItemName: string; override;
  276. class function GetClassTreeIndex: Integer; override;
  277. class function GetClassImageIndex: Integer; override;
  278. end;
  279. TOtherSourceFile = class(TBinarySourceFile)
  280. public
  281. class function GetClassFilter: string; override;
  282. class function GetClassItemName: string; override;
  283. class function GetClassTreeIndex: Integer; override;
  284. class function GetClassImageIndex: Integer; override;
  285. end;
  286. TFoundError = class(TObject)
  287. public
  288. WholeLine: string;
  289. BugType: TBugType;
  290. ErrFunction: string;
  291. ErrorMessage: string;
  292. SourceFile: TSourceFile;
  293. Range: TMCRange;
  294. destructor Destroy; override;
  295. procedure GoToPosition;
  296. end;
  297. var
  298. AppNode: TTreeNode;
  299. NoEditor: TWinControl;
  300. implementation
  301. uses
  302. Printers,
  303. MasterUnit, ParsingUnit, ProcessUnit,
  304. UtilsDos, UtilsWin,
  305. HandleWaitThreadUnit, FileReadToBufferThreadUnit;
  306. const
  307. CSingleSymbols: set of Char = [',', ';', '(', ')', '[', ']', '{', '}'];
  308. AdditionalLinesPerPage = 4;
  309. { TFoundError }
  310. destructor TFoundError.Destroy;
  311. begin
  312. if Assigned (Range) then begin
  313. Range.Free;
  314. Range := nil;
  315. end;
  316. inherited;
  317. end;
  318. procedure TFoundError.GoToPosition;
  319. begin
  320. if Assigned (SourceFile) then begin
  321. with SourceFile do begin
  322. if Assigned (Editor) then begin
  323. Edit;
  324. if SourceFile is TSourceTextSourceFile then
  325. with SourceFile as TSourceTextSourceFile do
  326. with SourceEditor do begin
  327. if Assigned (Range) then begin
  328. with Selection do begin
  329. Assign (Range);
  330. ScrollInView (5);
  331. end;
  332. SetFocus;
  333. end;
  334. end;
  335. end;
  336. end;
  337. end else
  338. AppNode.Selected := True;
  339. end;
  340. { TSourceFiles }
  341. constructor TSourceFiles.Create;
  342. begin
  343. inherited Create (TSourceFile);
  344. end;
  345. function TSourceFiles.FindFile(const FN: string): TSourceFile;
  346. var
  347. I: Integer;
  348. begin
  349. Result := nil;
  350. for I := 0 to Count - 1 do
  351. with Items [I] as TSourceFile do
  352. if UpperCase (FN) = UpperCase (FileName) then begin
  353. Result := Items [I] as TSourceFile;
  354. Break;
  355. end;
  356. end;
  357. function TSourceFiles.FindFileNameOnly(const FN: string): TSourceFile;
  358. var
  359. I: Integer;
  360. begin
  361. Result := nil;
  362. for I := 0 to Count - 1 do
  363. with Items [I] as TSourceFile do
  364. if UpperCase (FN) = UpperCase (ExtractFileName (FileName)) then begin
  365. Result := Items [I] as TSourceFile;
  366. Break;
  367. end;
  368. end;
  369. function TSourceFiles.FindFileOfType(FileType: TSourceFileClass):
  370. TSourceFile;
  371. var
  372. I: Integer;
  373. begin
  374. Result := nil;
  375. for I := 0 to Count - 1 do
  376. if Items [I] is FileType then begin
  377. Result := Items [I] as TSourceFile;
  378. Break;
  379. end;
  380. end;
  381. function TSourceFiles.FindFileOfTypeInProject(FileType: TSourceFileClass):
  382. TSourceFile;
  383. var
  384. I: Integer;
  385. begin
  386. Result := nil;
  387. for I := 0 to Count - 1 do
  388. if (Items [I] is FileType) and (Items [I] as TSourceFile).InProject then begin
  389. Result := Items [I] as TSourceFile;
  390. Break;
  391. end;
  392. end;
  393. function TSourceFiles.FindFileWithoutExt(const FN: string): TSourceFile;
  394. var
  395. I: Integer;
  396. begin
  397. Result := nil;
  398. for I := 0 to Count - 1 do
  399. with Items [I] as TSourceFile do
  400. if UpperCase (FN) = UpperCase (WithoutExt (FileName)) then begin
  401. Result := Items [I] as TSourceFile;
  402. Break;
  403. end;
  404. end;
  405. { TSourceFile }
  406. class function TSourceFile.CanSave: Boolean;
  407. begin
  408. Result := True;
  409. end;
  410. procedure TSourceFile.Compile;
  411. begin
  412. end;
  413. function TSourceFile.CountPages: Integer;
  414. begin
  415. Result := 0;
  416. end;
  417. destructor TSourceFile.Destroy;
  418. var
  419. I: Integer;
  420. F: TForm;
  421. N: TTreeNode;
  422. begin
  423. if Assigned (ErrorList) then
  424. with ErrorList.Items do begin
  425. BeginUpdate;
  426. for I := Count - 1 downto 0 do
  427. if Assigned (Item[I].Data) then
  428. with TFoundError (Item[I].Data) do
  429. if SourceFile = Self then begin
  430. Range := nil;
  431. Item[I].Delete;
  432. end;
  433. EndUpdate;
  434. end;
  435. if Assigned (OnError) then
  436. OnError ('', btWarning, FileName, '', '', 0, 0);
  437. if Assigned (ParentForm) then begin
  438. F := ParentForm;
  439. ParentForm := nil;
  440. F.Free;
  441. end;
  442. if Assigned (TreeItem) then begin
  443. N := TreeItem;
  444. TreeItem := nil;
  445. N.Data := nil;
  446. N.Free;
  447. end;
  448. inherited;
  449. end;
  450. procedure TSourceFile.Edit;
  451. begin
  452. if Assigned (TreeItem) then
  453. TreeItem.Selected := True
  454. else if Assigned (ParentForm) then begin
  455. ParentForm.Show;
  456. ParentForm.SetFocus;
  457. end;
  458. end;
  459. class function TSourceFile.GetAppropriateClassFromExt(Ext: string): TSourceFileClass;
  460. begin
  461. Ext := LowerCase (Ext);
  462. if (Length (Ext) > 0) and (Ext [1] <> '.') then
  463. Ext := '.' + Ext;
  464. if Ext = '.h' then
  465. Result := THeaderSourceFile
  466. else if Ext = '.c' then
  467. Result := TCSourceFile
  468. else if Ext = '.s' then
  469. Result := TGNUAsmSourceFile
  470. else if Ext = '.asm' then begin
  471. if ssA68k in SpecialSupport then
  472. Result := TAsmSourceFile
  473. else
  474. Result := TGNUAsmSourceFile;
  475. end else if (Ext = '.qll') and (ssQuill in SpecialSupport) then
  476. Result := TQuillSourceFile
  477. else if Ext = '.o' then
  478. Result := TObjectSourceFile
  479. else if Ext = '.a' then
  480. Result := TArchiveSourceFile
  481. else if Ext = '.txt' then
  482. Result := TNormalTextSourceFile
  483. else
  484. Result := TOtherSourceFile;
  485. end;
  486. class function TSourceFile.GetAppropriateClassFromName(ItemNm: string): TSourceFileClass;
  487. procedure CheckClass(AClass: TSourceFileClass);
  488. begin
  489. if (not Assigned (Result)) and (ItemNm = UpperCase (AClass.GetClassItemName)) then
  490. Result := AClass;
  491. end;
  492. begin
  493. ItemNm := UpperCase (ItemNm);
  494. Result := nil;
  495. CheckClass (THeaderSourceFile);
  496. CheckClass (TCSourceFile);
  497. CheckClass (TGNUAsmSourceFile);
  498. CheckClass (TAsmSourceFile);
  499. CheckClass (TQuillSourceFile);
  500. CheckClass (TObjectSourceFile);
  501. CheckClass (TArchiveSourceFile);
  502. CheckClass (TNormalTextSourceFile);
  503. CheckClass (TOtherSourceFile);
  504. if (Result = TAsmSourceFile) and (not (ssA68k in SpecialSupport)) then
  505. Result := TGNUAsmSourceFile
  506. else if (Result = TQuillSourceFile) and (not (ssQuill in SpecialSupport)) then
  507. Result := TQuillSourceFile;
  508. end;
  509. class function TSourceFile.GetAppropriateClassFromTreeIndex(Index: Integer): TSourceFileClass;
  510. procedure CheckClass(AClass: TSourceFileClass);
  511. begin
  512. if (not Assigned (Result)) and (Index = AClass.GetClassTreeIndex) then
  513. Result := AClass;
  514. end;
  515. begin
  516. Result := nil;
  517. CheckClass (THeaderSourceFile);
  518. CheckClass (TCSourceFile);
  519. CheckClass (TGNUAsmSourceFile);
  520. if ssA68k in SpecialSupport then
  521. CheckClass (TAsmSourceFile);
  522. if ssQuill in SpecialSupport then
  523. CheckClass (TQuillSourceFile);
  524. CheckClass (TObjectSourceFile);
  525. CheckClass (TArchiveSourceFile);
  526. CheckClass (TNormalTextSourceFile);
  527. CheckClass (TOtherSourceFile);
  528. end;
  529. function TSourceFile.GetCaption: TCaption;
  530. begin
  531. if Assigned (TreeItem) then
  532. Result := TreeItem.Text
  533. else if Assigned (ParentForm) then
  534. Result := ParentForm.Caption
  535. else
  536. Result := '';
  537. end;
  538. class function TSourceFile.GetClassFilter: string;
  539. begin
  540. Result := 'Abstract Files (*.*)|*.*';
  541. end;
  542. class function TSourceFile.GetClassImageIndex: Integer;
  543. begin
  544. Result := -1;
  545. end;
  546. class function TSourceFile.GetClassItemName: string;
  547. begin
  548. Result := 'Abstract File';
  549. end;
  550. class function TSourceFile.GetClassTreeIndex: Integer;
  551. begin
  552. Result := -1;
  553. end;
  554. class function TSourceFile.GetCompilable: Boolean;
  555. begin
  556. Result := False;
  557. end;
  558. function TSourceFile.GetDynamicName: string;
  559. var
  560. S: string;
  561. begin
  562. S := ExtractFilePath (FileName);
  563. if StartsWith (ExtractFilePath (ProjectFileName), S) then
  564. Result := Copy (FileName, Length (ExtractFilePath (ProjectFileName)) + 1, Length (FileName))
  565. else
  566. Result := FileName;
  567. end;
  568. function TSourceFile.GetEditing: Boolean;
  569. begin
  570. if Assigned (TreeItem) then
  571. Result := TreeItem.Selected
  572. else if Assigned (ParentForm) then
  573. Result := ParentForm.Visible
  574. else
  575. Result := False;
  576. end;
  577. function TSourceFile.GetEditor: TWinControl;
  578. begin
  579. if Assigned (TreeItem) then
  580. Result := NoEditor
  581. else
  582. Result := nil;
  583. end;
  584. function TSourceFile.GetFolderPath: string;
  585. begin
  586. if Assigned (Folder) then
  587. Result := Folder.Path
  588. else
  589. Result := '';
  590. end;
  591. function TSourceFile.GetInProject: Boolean;
  592. begin
  593. Result := Assigned (TreeItem);
  594. end;
  595. function TSourceFile.GetLogicalFileName: string;
  596. var
  597. Path: string;
  598. begin
  599. Result := ExtractFileName (FileName);
  600. Path := FolderPath;
  601. if Length (Path) > 0 then
  602. Result := WithBackslash (Path) + Result;
  603. end;
  604. class function TSourceFile.GetPrintable: Boolean;
  605. begin
  606. Result := False;
  607. end;
  608. function TSourceFile.GetSourceName: string;
  609. begin
  610. Result := WithoutExt (ExtractFileName (FileName));
  611. end;
  612. procedure TSourceFile.Invalidate;
  613. begin
  614. Invalidated := True;
  615. end;
  616. procedure TSourceFile.LoadFromFile(const FN: string; SetFN: Boolean);
  617. begin
  618. if SetFN and (Length (FN) > 0) then
  619. FFileName := FN;
  620. Modified := False;
  621. end;
  622. procedure TSourceFile.Modify;
  623. begin
  624. Modified := True;
  625. Invalidate;
  626. end;
  627. procedure TSourceFile.Print(Copies: Integer; PrintRange: TPrintRange; FromPage, ToPage: Integer);
  628. begin
  629. end;
  630. procedure TSourceFile.ProcessErrorLine(Line: string);
  631. begin
  632. end;
  633. procedure TSourceFile.ProcessErrors(const ErrText: string);
  634. var
  635. I: Integer;
  636. LL: TStringList;
  637. begin
  638. UpdateProgramOutput;
  639. if not OperationCancelled then begin
  640. LL := TStringList.Create;
  641. with LL do try
  642. Text := ErrText;
  643. if Count > 0 then begin
  644. if Assigned (ErrorList) then
  645. ErrorList.Items.BeginUpdate;
  646. try
  647. for I := 0 to Count - 1 do
  648. ProcessErrorLine (Strings [I]);
  649. finally
  650. if Assigned (ErrorList) then
  651. ErrorList.Items.EndUpdate;
  652. end;
  653. end;
  654. except end;
  655. LL.Free;
  656. CompUpdate;
  657. end;
  658. end;
  659. procedure TSourceFile.Save;
  660. begin
  661. if (ProjectFileName = '') and (ExtractFilePath (FileName) = 'C:\') then
  662. SaveAs
  663. else begin
  664. FLastChangeTime := 0;
  665. WriteToFile;
  666. Modified := False;
  667. end;
  668. end;
  669. procedure TSourceFile.SaveAs;
  670. var
  671. S: string;
  672. begin
  673. with TSaveDialog.Create (Application.MainForm) do try
  674. Title := 'Save Source File';
  675. S := ClassFilter + '|All Files (*.*)|*.*';
  676. if S [1] = '|' then
  677. Delete (S, 1, 1);
  678. Filter := S;
  679. FilterIndex := 0;
  680. DefaultExt := Copy (ExtractFileExt (Self.FileName), 2, Length (Self.FileName));
  681. FileName := Self.FileName;
  682. Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist];
  683. if Execute then
  684. WriteToFile (FileName, True)
  685. else
  686. Abort;
  687. finally
  688. Free;
  689. end;
  690. end;
  691. procedure TSourceFile.SetCaption(const Value: TCaption);
  692. begin
  693. if Value <> Caption then begin
  694. if Assigned (TreeItem) then
  695. TreeItem.Text := Value;
  696. if Assigned (ParentForm) then
  697. ParentForm.Caption := Value;
  698. end;
  699. end;
  700. procedure TSourceFile.SetEditing(const Value: Boolean);
  701. begin
  702. if Value then
  703. Edit
  704. else
  705. AppNode.Selected := True;
  706. end;
  707. procedure TSourceFile.SetFileName(const Value: string);
  708. begin
  709. if FFileName <> Value then begin
  710. if FileExists (Value) then
  711. raise EWriteError.Create ('The file "' + Value + '" already exists.')
  712. else
  713. if FileExists (FFileName) then begin
  714. RenameFile (FFileName, Value);
  715. if (LowerCase (ExtractFileExt (FFileName)) <> '.o') and FileExists (ChangeFileExt (FFileName, '.o')) then
  716. RenameFile (ChangeFileExt (FFileName, '.o'), ChangeFileExt (Value, '.o'));
  717. if (LowerCase (ExtractFileExt (FFileName)) <> '.s') and FileExists (ChangeFileExt (FFileName, '.s')) then
  718. RenameFile (ChangeFileExt (FFileName, '.s'), ChangeFileExt (Value, '.s'));
  719. end;
  720. FFileName := Value;
  721. end;
  722. end;
  723. procedure TSourceFile.SetModified(const Value: Boolean);
  724. begin
  725. FModified := Value;
  726. Invalidated := False;
  727. end;
  728. procedure TSourceFile.SetSourceName(const Value: string);
  729. begin
  730. FileName := WithBackslash (ExtractFilePath (FileName)) + Value + ExtractFileExt (FileName);
  731. end;
  732. procedure TSourceFile.TestChange;
  733. begin
  734. end;
  735. procedure TSourceFile.UpdateProgramOutput;
  736. begin
  737. if Assigned (CompUpdateProgramOutput) then
  738. CompUpdateProgramOutput;
  739. end;
  740. procedure TSourceFile.WarnIfModified;
  741. begin
  742. if Modified then
  743. case ShowDefaultMessageBox
  744. ('The file ''' + SourceName + ''' has been modified. Do you want to save the changes?',
  745. 'File Modified', mtQuestion, True) of
  746. idYes: Save;
  747. idNo: Modified := False;
  748. idCancel: Abort;
  749. end;
  750. end;
  751. procedure TSourceFile.WriteToFile(const FN: string; SetFN: Boolean);
  752. begin
  753. if SetFN and (Length (FN) > 0) then
  754. FFileName := FN;
  755. if SetFN or (Length (FN) <= 0) then begin
  756. FLastChangeTime := 0;
  757. Caption := SourceName;
  758. Modified := False;
  759. end;
  760. end;
  761. { TTextSourceFile }
  762. procedure TTextSourceFile.AskForReload;
  763. begin
  764. if ShowDefaultMessageBox ('The File "' + SourceName + '" has been changed by another program. Do you want to reload it?', 'File Changed', mtQuestion) = idYes then begin
  765. try
  766. LoadFromFile;
  767. except end;
  768. Invalidate;
  769. end;
  770. end;
  771. procedure TTextSourceFile.Change(Sender: TObject);
  772. begin
  773. if (FModifyLevel <= 0) and (not Modifying) then
  774. Modify;
  775. end;
  776. function TTextSourceFile.CountPages: Integer;
  777. var
  778. FontHeight,
  779. LinesPerPage: Integer;
  780. begin
  781. if Assigned (TextEditor) then begin
  782. Printer.Canvas.Font.Assign (TextEditor.Font);
  783. FontHeight := Printer.Canvas.TextHeight ('Gg');
  784. LinesPerPage := Printer.PageHeight div FontHeight - AdditionalLinesPerPage;
  785. Result := TextEditor.LineCount div LinesPerPage + 1;
  786. end else
  787. Result := 0;
  788. end;
  789. destructor TTextSourceFile.Destroy;
  790. begin
  791. if Assigned (LineStartList) then begin
  792. LineStartList.Free;
  793. LineStartList := nil;
  794. end;
  795. inherited;
  796. end;
  797. function TTextSourceFile.GetCompiledLineStart(Line: Integer): Integer;
  798. begin
  799. if (Line > 0) and Assigned (TextEditor) then begin
  800. if Assigned (LineStartList) then
  801. with LineStartList do begin
  802. if Line >= Count then
  803. Result := TextEditor.TextLength + 1
  804. else
  805. Result := Items [Line];
  806. end
  807. else
  808. Result := TextEditor.CellToCharIdx (TextCell (Line, 1));
  809. end else
  810. Result := 0;
  811. end;
  812. function TTextSourceFile.GetContent: string;
  813. begin
  814. if Assigned (InternalTextEditor) then
  815. Result := InternalTextEditor.Text
  816. else
  817. Result := FTempContent;
  818. end;
  819. function TTextSourceFile.GetEditor: TWinControl;
  820. begin
  821. Result := TextEditor;
  822. end;
  823. class function TTextSourceFile.GetPrintable: Boolean;
  824. begin
  825. Result := True;
  826. end;
  827. procedure TTextSourceFile.LoadFromFile(const FN: string; SetFN: Boolean);
  828. begin
  829. if Assigned (InternalTextEditor) then
  830. InternalTextEditor.AllowUndo := False;
  831. Inc (FModifyLevel);
  832. try
  833. with TMemoryStream.Create do try
  834. if Length (FN) > 0 then
  835. LoadFromFile (FN)
  836. else
  837. LoadFromFile (FileName);
  838. Size := Size + 1;
  839. PChar (Memory) [Size - 1] := #0;
  840. Content := AnsiString (PChar (Memory));
  841. finally
  842. Free;
  843. end;
  844. finally
  845. Dec (FModifyLevel);
  846. if Assigned (InternalTextEditor) then
  847. InternalTextEditor.AllowUndo := True;
  848. inherited;
  849. if Compilable then begin
  850. if FileExists (ChangeFileExt (FileName, '.o')) then
  851. Invalidated := FileAge (ChangeFileExt (FileName, '.o')) < FileAge (FileName)
  852. else
  853. Invalidated := True;
  854. end else
  855. Invalidated := False;
  856. end;
  857. end;
  858. procedure TTextSourceFile.Print(Copies: Integer; PrintRange: TPrintRange; FromPage, ToPage: Integer);
  859. var
  860. CurPage,
  861. CurPageLine,
  862. CurY,
  863. FontHeight,
  864. LinesPerPage: Integer;
  865. procedure StartPage;
  866. var
  867. PrevStyle: TFontStyles;
  868. PageStr: string;
  869. begin
  870. Inc (CurPage);
  871. if CurPage in [FromPage..ToPage] then
  872. with Printer.Canvas do begin
  873. PrevStyle := Font.Style;
  874. Font.Style := PrevStyle + [fsBold];
  875. TextOut (0, FontHeight, ' ' + ExtractFileName (FileName));
  876. PageStr := 'Page ' + IntToStr (CurPage) + ' ';
  877. TextOut (Printer.PageWidth - TextWidth (PageStr), FontHeight, PageStr);
  878. Font.Style := PrevStyle;
  879. end;
  880. CurY := FontHeight * 3;
  881. CurPageLine := 1;
  882. end;
  883. var
  884. Remaining,
  885. S: string;
  886. P,
  887. Ps,
  888. NextPs: Integer;
  889. begin
  890. if Assigned (TextEditor) then begin
  891. Printer.Title := 'TIGCC IDE - ' + ExtractFileName (FileName);
  892. Printer.Copies := Copies;
  893. Printer.BeginDoc;
  894. try
  895. Printer.Canvas.Font.Assign (TextEditor.Font);
  896. FontHeight := Printer.Canvas.TextHeight ('Gg');
  897. LinesPerPage := Printer.PageHeight div FontHeight - AdditionalLinesPerPage;
  898. if PrintRange <> prPageNums then begin
  899. FromPage := 1;
  900. ToPage := High (ToPage);
  901. end;
  902. if PrintRange = prSelection then
  903. Remaining := TextEditor.Selection.Text
  904. else
  905. Remaining := Content;
  906. CurPage := 0;
  907. StartPage;
  908. while (Length (Remaining) > 0) and (CurPage <= ToPage) do begin
  909. P := Pos (#13#10, Remaining);
  910. if P <= 0 then
  911. P := Length (Remaining) + 1;
  912. S := Copy (Remaining, 1, P - 1);
  913. Delete (Remaining, 1, P + 1);
  914. Ps := 1;
  915. while Ps <= Length (S) do begin
  916. if S [Ps] = #9 then begin
  917. NextPs := ((Ps - 1) div TextEditor.TabSize + 1) * TextEditor.TabSize + 1;
  918. System.Delete (S, Ps, 1);
  919. System.Insert (StringOfChar (' ', NextPs - Ps), S, Ps);
  920. Ps := NextPs;
  921. end else
  922. Inc (Ps);
  923. end;
  924. if CurPage in [FromPage..ToPage] then
  925. Printer.Canvas.TextOut (0, CurY, ' ' + S);
  926. Inc (CurPageLine);
  927. if CurPageLine > LinesPerPage then begin
  928. if CurPage in [FromPage..(ToPage-1)] then
  929. Printer.NewPage;
  930. StartPage;
  931. end else
  932. Inc (CurY, FontHeight);
  933. end;
  934. finally
  935. Printer.EndDoc;
  936. end;
  937. end;
  938. end;
  939. procedure TTextSourceFile.ReplaceText(Sender: TObject; Pos,
  940. Change: Integer);
  941. var
  942. I,
  943. FirstChangeI,
  944. FirstChangePos: Integer;
  945. begin
  946. if Assigned (LineStartList) then
  947. with LineStartList do begin
  948. FirstChangeI := -1;
  949. FirstChangePos := -1;
  950. for I := 0 to Count - 1 do
  951. if Items [I] > Pos then begin
  952. FirstChangeI := I;
  953. FirstChangePos := Items [I];
  954. Break;
  955. end;
  956. if FirstChangeI >= 0 then begin
  957. for I := FirstChangeI to Count - 1 do
  958. Items [I] := Items [I] + Change;
  959. for I := FirstChangeI to Count - 1 do begin
  960. if Items [I] >= FirstChangePos then
  961. Break;
  962. Items [I] := FirstChangePos;
  963. end;
  964. end;
  965. end;
  966. end;
  967. procedure TTextSourceFile.SetContent(const Value: string);
  968. begin
  969. if Assigned (InternalTextEditor) then begin
  970. with InternalTextEditor do
  971. Text := Value;
  972. end else
  973. FTempContent := Value;
  974. end;
  975. procedure TTextSourceFile.SetModified(const Value: Boolean);
  976. begin
  977. if not Modifying then begin
  978. Modifying := True;
  979. FModified := Value;
  980. Invalidated := False;
  981. Modifying := False;
  982. end;
  983. end;
  984. procedure TTextSourceFile.SetParentForm(const Value: TForm);
  985. begin
  986. inherited;
  987. if Assigned (TextEditor) then
  988. with TextEditor do begin
  989. Parent := Value;
  990. if Value <> nil then
  991. Show;
  992. end;
  993. end;
  994. procedure TTextSourceFile.TestChange;
  995. var
  996. NewTime: Integer;
  997. TimeChanged: Boolean;
  998. begin
  999. if (Length (FileName) > 0) and FileExists (FileName) then begin
  1000. NewTime := FileAge (FileName);
  1001. TimeChanged := (FLastChangeTime <> 0) and (FLastChangeTime <> NewTime);
  1002. FLastChangeTime := NewTime;
  1003. if TimeChanged then
  1004. AskForReload;
  1005. end;
  1006. end;
  1007. procedure TTextSourceFile.UpdateEditor;
  1008. begin
  1009. if Assigned (TextEditor) then
  1010. with TextEditor do begin
  1011. Color := EditorColor;
  1012. Font.Assign (EditorFont);
  1013. DragDropEditing := EditorDragDrop;
  1014. RemoveTrailingSpaces := EditorRemoveTrSp;
  1015. end;
  1016. end;
  1017. procedure TTextSourceFile.WriteToFile(const FN: string; SetFN: Boolean);
  1018. var
  1019. WriteFile: string;
  1020. begin
  1021. if Assigned (TextEditor) then try
  1022. if Length (FN) > 0 then
  1023. WriteFile := FN
  1024. else
  1025. WriteFile := FileName;
  1026. CreatePathFor (WriteFile);
  1027. with TFileStream.Create (WriteFile, fmCreate or fmShareExclusive) do try
  1028. Write (PChar(TextEditor.Text)^, TextEditor.TextLength);
  1029. finally
  1030. Free;
  1031. end;
  1032. inherited;
  1033. except
  1034. ShowDefaultMessageBox ('Error saving source file.', 'Error', mtProgramError);
  1035. end;
  1036. end;
  1037. { TBinarySourceFile }
  1038. class function TBinarySourceFile.CanSave: Boolean;
  1039. begin
  1040. Result := False;
  1041. end;
  1042. procedure TBinarySourceFile.WriteToFile(const FN: string; SetFN: Boolean);
  1043. begin
  1044. if Length (FN) > 0 then
  1045. CopyFile (PChar (FileName), PChar (FN), False);
  1046. inherited;
  1047. end;
  1048. { THeaderSourceFile }
  1049. class function THeaderSourceFile.GetClassFilter: string;
  1050. begin
  1051. Result := 'Header Files (*.h)|*.h';
  1052. end;
  1053. class function THeaderSourceFile.GetClassImageIndex: Integer;
  1054. begin
  1055. Result := 3;
  1056. end;
  1057. class function THeaderSourceFile.GetClassItemName: string;
  1058. begin
  1059. Result := 'Header File';
  1060. end;
  1061. class function THeaderSourceFile.GetClassTreeIndex: Integer;
  1062. begin
  1063. Result := 0;
  1064. end;
  1065. function THeaderSourceFile.GetContentType: TSourceFileType;
  1066. begin
  1067. Result := ftOther;
  1068. if Content <> '' then begin
  1069. if Content [1] = '/' then
  1070. Result := ftCFile
  1071. else if Content [1] = '|' then
  1072. Result := ftGNUAsmFile
  1073. else if Content [1] = ';' then
  1074. Result := ftA68kAsmFile;
  1075. end;
  1076. if Result = ftOther then
  1077. if Assigned (Collection) and (Collection is TSourceFiles) then
  1078. with Collection as TSourceFiles do
  1079. if Assigned (FindFileOfType (TCSourceFile)) then
  1080. Result := ftCFile
  1081. else if Assigned (FindFileOfType (TGNUAsmSourceFile)) then
  1082. Result := ftGNUAsmFile
  1083. else if Assigned (FindFileOfType (TAsmSourceFile)) then
  1084. Result := ftA68kAsmFile
  1085. else if Assigned (FindFileOfType (TQuillSourceFile)) then
  1086. Result := ftQuillFile;
  1087. end;
  1088. procedure THeaderSourceFile.SetContent(const Value: string);
  1089. begin
  1090. if Length (Value) > 0 then begin
  1091. if Value [1] = '/' then
  1092. UpdateContentType (ftCFile)
  1093. else if Value [1] = '|' then
  1094. UpdateContentType (ftGNUAsmFile)
  1095. else if Value [1] = ';' then
  1096. UpdateContentType (ftA68kAsmFile);
  1097. end;
  1098. inherited;
  1099. end;
  1100. procedure THeaderSourceFile.SetModified(const Value: Boolean);
  1101. begin
  1102. if not Modifying then begin
  1103. Modifying := True;
  1104. FModified := Value;
  1105. if Value then
  1106. Invalidate;
  1107. Modifying := False;
  1108. end;
  1109. end;
  1110. procedure THeaderSourceFile.UpdateContentType(CT: TSourceFileType);
  1111. begin
  1112. if Assigned (InternalSourceEditor) then
  1113. with InternalSourceEditor do begin
  1114. if CT = ftGNUAsmFile then begin
  1115. SyntaxColoring.Assign (SyntaxAsmGNU);
  1116. TabSize := TabSizeAsm;
  1117. end else if CT = ftA68kAsmFile then begin
  1118. SyntaxColoring.Assign (SyntaxAsm);
  1119. TabSize := TabSizeAsm;
  1120. end else if CT = ftQuillFile then begin
  1121. SyntaxColoring.Assign (SyntaxQuill);
  1122. TabSize := TabSizeC;
  1123. end else begin
  1124. SyntaxColoring.Assign (SyntaxC);
  1125. TabSize := TabSizeC;
  1126. end;
  1127. AutoIndentIncrease := AutoBlocks and (CT = ftCFile);
  1128. end;
  1129. end;
  1130. procedure THeaderSourceFile.UpdateEditor;
  1131. begin
  1132. inherited;
  1133. if Assigned (SourceEditor) then begin
  1134. if ContentType = ftCFile then begin
  1135. SourceEditor.TabSize := TabSizeC;
  1136. SourceEditor.AutoIndentIncrease := AutoBlocks;
  1137. end else if ContentType = ftCFile then
  1138. SourceEditor.TabSize := TabSizeC
  1139. else
  1140. SourceEditor.TabSize := TabSizeAsm;
  1141. end;
  1142. end;
  1143. procedure THeaderSourceFile.UpdateSyntax;
  1144. begin
  1145. UpdateContentType (ContentType);
  1146. end;
  1147. { TSourceTextSourceFile }
  1148. destructor TSourceTextSourceFile.Destroy;
  1149. var
  1150. PrevEditor: TSourceEdit;
  1151. begin
  1152. if Assigned (FEditor) then begin
  1153. PrevEditor := FEditor;
  1154. FEditor := nil;
  1155. PrevEditor.Free;
  1156. end;
  1157. inherited;
  1158. end;
  1159. function TSourceTextSourceFile.GetContentType: TSourceFileType;
  1160. begin
  1161. Result := ftOther;
  1162. end;
  1163. function TSourceTextSourceFile.GetFunctions: TSourceFileFunctions;
  1164. var
  1165. Editor: TSourceEdit;
  1166. TextLength,
  1167. I,
  1168. J,
  1169. CurPos,
  1170. WordIndex: Integer;
  1171. Text,
  1172. LastWord,
  1173. FirstWord: string;
  1174. InFunc,
  1175. InAsm,
  1176. InCompSM,
  1177. InSpace,
  1178. LineDone: Boolean;
  1179. begin
  1180. SetLength (Result, 0);
  1181. Editor := SourceEditor;
  1182. if not Assigned (Editor) then
  1183. Exit;
  1184. Text := Content;
  1185. TextLength := Length (Text);
  1186. InFunc := False;
  1187. InAsm := False;
  1188. InCompSM := False;
  1189. case ContentType of
  1190. ftCFile:
  1191. for I := 1 to Editor.LineCount do begin
  1192. CurPos := Editor.CellToCharIdx (TextCell (I, 1));
  1193. if (CurPos <= TextLength) and (Text [CurPos] <> #13) and (Text [CurPos] <> '*') then begin
  1194. if InCompSM and (CurPos - 3 >= 1) and (Text [CurPos - 3] <> '\') then
  1195. InCompSM := False;
  1196. if not InCompSM then begin
  1197. if Text [CurPos] = '{' then
  1198. InFunc := True;
  1199. if InFunc then begin
  1200. if Text [CurPos] = '}' then
  1201. InFunc := False;
  1202. end else begin
  1203. if (Copy (Text, CurPos, 5) = 'asm("') or (Copy (Text, CurPos, 6) = 'asm ("') then
  1204. InAsm := True;
  1205. if InAsm then begin
  1206. if Pos ('")', Copy (Text, CurPos, Editor.CellToCharIdx (TextCell (I + 1, 1)) - CurPos)) > 0 then
  1207. InAsm := False;
  1208. end else begin
  1209. LineDone := False;
  1210. LastWord := '';
  1211. WordIndex := 0;
  1212. InSpace := True;
  1213. while (CurPos <= TextLength) and (not LineDone) do begin
  1214. case Text [CurPos] of
  1215. 'A'..'Z', 'a'..'z', '0'..'9', '_', '$', ':': begin
  1216. if InSpace and (Text [CurPos] = '_') and (Copy (Text, CurPos, Length ('__attribute__')) = '__attribute__') then begin
  1217. Inc (CurPos, Length ('__attribute__'));
  1218. while (CurPos <= TextLength) and (Text [CurPos] in [#32, #9]) do
  1219. Inc (CurPos);
  1220. if (CurPos <= TextLength) and (Text [CurPos] = '(') then begin
  1221. Inc (CurPos);
  1222. J := 1;
  1223. while (CurPos <= TextLength) and (J > 0) do begin
  1224. case Text [CurPos] of
  1225. '(': Inc (J);
  1226. ')': Dec (J);
  1227. end;
  1228. Inc (CurPos);
  1229. end;
  1230. end else
  1231. Dec (CurPos);
  1232. end else begin
  1233. if InSpace then begin
  1234. LastWord := '';
  1235. InSpace := False;
  1236. Inc (WordIndex);
  1237. end;
  1238. LastWord := LastWord + Text [CurPos];
  1239. if WordIndex <= 1 then
  1240. FirstWord := LastWord;
  1241. end;
  1242. end;
  1243. #32, #9, #0, '*', '&': begin
  1244. InSpace := True;
  1245. if (Pos (':', LastWord) > 0) and (Pos ('::', LastWord) <= 0) then
  1246. LineDone := True;
  1247. end;
  1248. '#': begin
  1249. InCompSM := True;
  1250. LineDone := True;
  1251. end;
  1252. else
  1253. LineDone := True;
  1254. end;
  1255. Inc (CurPos);
  1256. end;
  1257. if (WordIndex >= 2) and (WordIndex <= 4) and (CurPos - 1 <= TextLength) and (Text [CurPos - 1] = '(') and (((FirstWord <> 'struct') and (FirstWord <> 'union') and (FirstWord <> 'enum')) or (WordIndex > 2)) then begin
  1258. while (CurPos <= TextLength) and (Text [CurPos] <> ')') do
  1259. Inc (CurPos);
  1260. Inc (CurPos);
  1261. if (CurPos <= TextLength) and (Text [CurPos] <> '(') then begin
  1262. LineDone := (CurPos <= TextLength) and (Text [CurPos] = ';');
  1263. if not LineDone then begin
  1264. J := CurPos;
  1265. while (J <= TextLength) and (not (Text [J] in [';', '{', '=', #13, #10])) do
  1266. Inc (J);
  1267. if (J <= TextLength) and (Text [J] = ';') then
  1268. LineDone := True;
  1269. end;
  1270. if LineDone then
  1271. for J := Low (Result) to High (Result) do
  1272. if Result[J].Name = LastWord then begin
  1273. LineDone := False;
  1274. Break;
  1275. end;
  1276. if LineDone then begin
  1277. SetLength (Result, Length (Result) + 1);
  1278. with Result [High (Result)] do begin
  1279. Name := LastWord;
  1280. PrototypeLine := I;
  1281. ImplementationLine := 0;
  1282. end;
  1283. end else begin
  1284. for J := Low (Result) to High (Result) do
  1285. if Result[J].Name = LastWord then begin
  1286. Result[J].ImplementationLine := I;
  1287. InFunc := True;
  1288. LineDone := True;
  1289. Break;
  1290. end;
  1291. if not LineDone then begin
  1292. while (CurPos <= TextLength) and (not (Text [CurPos] in ['{', ';', '='])) do
  1293. Inc (CurPos);
  1294. if (CurPos <= TextLength) and (Text [CurPos] <> '=') then begin
  1295. SetLength (Result, Length (Result) + 1);
  1296. with Result [High (Result)] do begin
  1297. Name := LastWord;
  1298. PrototypeLine := 0;
  1299. ImplementationLine := I;
  1300. InFunc := True;
  1301. end;
  1302. end;
  1303. end;
  1304. end;
  1305. end;
  1306. end;
  1307. end;
  1308. end;
  1309. end;
  1310. end;
  1311. end;
  1312. ftGNUAsmFile, ftA68kAsmFile:
  1313. for I := 1 to Editor.LineCount do begin
  1314. CurPos := Editor.CellToCharIdx (TextCell (I, 1));
  1315. LineDone := False;
  1316. LastWord := '';
  1317. while (CurPos <= TextLength) and (not LineDone) do begin
  1318. if Text [CurPos] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$'] then
  1319. LastWord := LastWord + Text [CurPos]
  1320. else
  1321. LineDone := True;
  1322. Inc (CurPos);
  1323. end;
  1324. if (CurPos - 1 <= TextLength) and (Text [CurPos - 1] = ':') then begin
  1325. SetLength (Result, Length (Result) + 1);
  1326. with Result [High (Result)] do begin
  1327. Name := LastWord;
  1328. PrototypeLine := 0;
  1329. ImplementationLine := I;
  1330. end;
  1331. end;
  1332. end;
  1333. end;
  1334. end;
  1335. function TSourceTextSourceFile.GetInternalTextEditor: TMemoComponent;
  1336. begin
  1337. Result := FEditor;
  1338. end;
  1339. function TSourceTextSourceFile.GetSourceEditor: TSourceEdit;
  1340. begin
  1341. if not Assigned (FEditor) then begin
  1342. FEditor := TSourceEdit.Create (Application.MainForm);
  1343. with FEditor do begin
  1344. AllowUndo := False;
  1345. Text := FTempContent;
  1346. end;
  1347. UpdateEditor;
  1348. UpdateSyntax;
  1349. FTempContent := '';
  1350. with FEditor do begin
  1351. OnChangePrivate := Change;
  1352. OnReplaceText := ReplaceText;
  1353. AllowUndo := True;
  1354. end;
  1355. end;
  1356. Result := FEditor;
  1357. end;
  1358. function TSourceTextSourceFile.GetTextEditor: TMemoComponent;
  1359. begin
  1360. Result := SourceEditor;
  1361. end;
  1362. procedure TSourceTextSourceFile.SplitAndWriteToFile(const FN: string);
  1363. type
  1364. TCharMode = (cmNone, cmNormalText, cmNumber, cmMultiSymbol, cmString, cmChar, cmComment, cmUnchangeableLine, cmExtUnchangeableLine, cmExtUnchangeableLineString, cmTrigraph);
  1365. var
  1366. S: string;
  1367. C: Char;
  1368. {$IFDEF CanSplit}
  1369. CurPos: Integer;
  1370. CurMode: TCharMode;
  1371. AtLineStart: Boolean;
  1372. Stream: TStream;
  1373. procedure InsertChar(Ch: Char);
  1374. begin
  1375. Stream.Write (Ch, SizeOf (Char));
  1376. end;
  1377. procedure InsertString(const Str: string);
  1378. begin
  1379. Stream.Write (PChar(Str)^, Length (Str));
  1380. end;
  1381. procedure AddLine(Offset: Integer = 0);
  1382. begin
  1383. LineStartList.Add (CurPos + Offset);
  1384. AtLineStart := True;
  1385. end;
  1386. procedure NewLine;
  1387. begin
  1388. if (not (AtLineStart or (Copy (S, CurPos, 1) = #13))) or (Copy (S, CurPos, 1) = '#') then begin
  1389. InsertString (#13#10);
  1390. AddLine;
  1391. end;
  1392. CurMode := cmNone;
  1393. end;
  1394. procedure SetMultiCharMode(Mode: TCharMode);
  1395. begin
  1396. if CurMode <> Mode then begin
  1397. NewLine;
  1398. CurMode := Mode;
  1399. end;
  1400. end;
  1401. var
  1402. B,
  1403. NoInsert: Boolean;
  1404. {$ENDIF}
  1405. var
  1406. I: Integer;
  1407. EscapedRealFN: string;
  1408. begin
  1409. try
  1410. if DebugInfo then begin
  1411. S := Content;
  1412. CreatePathFor (FN);
  1413. EscapedRealFN := '';
  1414. for I := 1 to Length (FileName) do begin
  1415. C := FileName [I];
  1416. if (C = '\') then
  1417. EscapedRealFN := EscapedRealFN + '\\'
  1418. else
  1419. EscapedRealFN := EscapedRealFN + C;
  1420. end;
  1421. with TFileStream.Create (FN, fmCreate or fmShareExclusive) do try
  1422. case ContentType of
  1423. ftCFile:
  1424. S := '#line 1 "' + EscapedRealFN + '"' + #13#10 + S;
  1425. ftQuillFile:
  1426. S := '#line 1 "' + EscapedRealFN + '"' + #13#10 + S;
  1427. ftGNUAsmFile:
  1428. S := '.appfile "' + EscapedRealFN + '"; .appline 1' + #13#10 + S;
  1429. end;
  1430. Write (PChar(S)^, Length (S));
  1431. if ContentType = ftCFile then
  1432. Write (PChar(#13#10)^, 2);
  1433. finally
  1434. Free;
  1435. end;
  1436. end else
  1437. {$IFDEF CanSplit}
  1438. if SplitFiles then begin
  1439. case ContentType of
  1440. ftCFile: begin
  1441. if not Assigned (LineStartList) then
  1442. LineStartList := TIntegerList.Create;
  1443. LineStartList.Clear;
  1444. LineStartList.Add (1);
  1445. CurPos := 1;
  1446. AddLine;
  1447. AtLineStart := True;
  1448. S := Content;
  1449. CreatePathFor (FN);
  1450. Stream := TFileStream.Create (FN, fmCreate or fmShareExclusive);
  1451. try
  1452. for CurPos := 1 to Length (S) do begin
  1453. NoInsert := False;
  1454. C := S [CurPos];
  1455. if C = #13 then
  1456. AddLine (2);
  1457. case CurMode of
  1458. cmString:
  1459. if (C = '"') then begin
  1460. B := True;
  1461. I := CurPos - 1;
  1462. while (I >= 1) and ((S [I] = '\') or (Copy (S, I - 2, 3) = '??/')) do begin
  1463. B := not B;
  1464. if S [I] = '\' then
  1465. Dec (I)
  1466. else
  1467. Dec (I, 3);
  1468. end;
  1469. if B then begin
  1470. CurMode := cmNone;
  1471. NoInsert := True;
  1472. InsertString (C + #13#10);
  1473. AtLineStart := True;
  1474. AddLine (1);
  1475. end;
  1476. end;
  1477. cmChar:
  1478. if (C = '''') then begin
  1479. B := True;
  1480. I := CurPos - 1;
  1481. while (I >= 1) and ((S [I] = '\') or (Copy (S, I - 2, 3) = '??/')) do begin
  1482. B := not B;
  1483. if S [I] = '\' then
  1484. Dec (I)
  1485. else
  1486. Dec (I, 3);
  1487. end;
  1488. if B then
  1489. CurMode := cmNone;
  1490. end;
  1491. cmComment: begin
  1492. if (C = '/') and (S [CurPos - 1] = '*') then
  1493. CurMode := cmNone;
  1494. end;
  1495. cmUnchangeableLine:
  1496. if C = #13 then
  1497. CurMode := cmNone;
  1498. cmExtUnchangeableLine:
  1499. if (C = #13) and (S [CurPos - 1] <> '\') then
  1500. CurMode := cmNone
  1501. else if C = '"' then
  1502. CurMode := cmExtUnchangeableLineString;
  1503. cmExtUnchangeableLineString:
  1504. if (C = '"') then begin
  1505. B := True;
  1506. I := CurPos - 1;
  1507. while (I >= 1) and ((S [I] = '\') or (Copy (S, I - 2, 3) = '??/')) do begin
  1508. B := not B;
  1509. if S [I] = '\' then
  1510. Dec (I)
  1511. else
  1512. Dec (I, 3);
  1513. end;
  1514. if B then
  1515. CurMode := cmExtUnchangeableLine;
  1516. end;
  1517. cmTrigraph:
  1518. if (C <> '?') and ((CurPos + 1 > Length (S)) or (S [CurPos + 1] <> '?')) then
  1519. CurMode := cmNone;
  1520. else begin
  1521. if Copy (S, CurPos, 2) = '//' then
  1522. SetMultiCharMode (cmUnchangeableLine)
  1523. else if Copy (S, CurPos, 2) = '/*' then
  1524. SetMultiCharMode (cmComment)
  1525. else if Copy (S, CurPos, 3) = '??=' then
  1526. SetMultiCharMode (cmExtUnchangeableLine)
  1527. else if (Copy (S, CurPos, 2) = '??') and (Length (S) >= CurPos + 2) and (S [CurPos + 2] in ['(', ')', '/', '''', '<', '>', '!', '-']) then
  1528. SetMultiCharMode (cmTrigraph)
  1529. else
  1530. case C of
  1531. #32, #9:
  1532. if (CurPos > 1) and (not (S [CurPos - 1] in [#32, #9])) then
  1533. NewLine;
  1534. 'A'..'Z', 'a'..'z', '0'..'9', '_', '$':
  1535. if not (CurMode in [cmNormalText, cmNumber]) then begin
  1536. NewLine;
  1537. if C in ['0'..'9'] then
  1538. CurMode := cmNumber
  1539. else
  1540. CurMode := cmNormalText;
  1541. end;
  1542. '"':
  1543. SetMultiCharMode (cmString);
  1544. '''':
  1545. SetMultiCharMode (cmChar);
  1546. '#':
  1547. SetMultiCharMode (cmExtUnchangeableLine);
  1548. '.':
  1549. if CurMode <> cmNumber then begin
  1550. if (Length (S) >= CurPos + 1) and (S [CurPos + 1] in ['0'..'9']) then begin
  1551. NewLine;
  1552. CurMode := cmNumber;
  1553. end else
  1554. SetMultiCharMode (cmMultiSymbol);
  1555. end;
  1556. '+', '-':
  1557. if (CurMode <> cmNumber) or (CurPos - 1 <= 1) or (not (S [CurPos - 1] in ['e', 'E', 'p', 'P'])) then
  1558. SetMultiCharMode (cmMultiSymbol);
  1559. else
  1560. if C in CSingleSymbols then begin
  1561. if CurMode <> cmNone then begin
  1562. NewLine;
  1563. CurMode := cmNone;
  1564. end;
  1565. if (CurPos + 1 <= Length (S)) and (S [CurPos + 1] <> #13) then begin
  1566. NoInsert := True;
  1567. InsertString (C + #13#10);
  1568. AddLine (1);
  1569. end;
  1570. end else
  1571. SetMultiCharMode (cmMultiSymbol);
  1572. end;
  1573. end;
  1574. end;
  1575. if not NoInsert then begin
  1576. InsertChar (C);
  1577. if not (C in [#13, #10]) then
  1578. AtLineStart := False;
  1579. end;
  1580. end;
  1581. NewLine;
  1582. finally
  1583. Stream.Free;
  1584. end;
  1585. end;
  1586. else
  1587. WriteToFile (FN);
  1588. end;
  1589. end else
  1590. {$ENDIF}
  1591. begin
  1592. S := Content;
  1593. CreatePathFor (FN);
  1594. with TFileStream.Create (FN, fmCreate or fmShareExclusive) do try
  1595. Write (PChar(S)^, Length (S));
  1596. if ContentType = ftCFile then
  1597. Write (PChar(#13#10)^, 2);
  1598. finally
  1599. Free;
  1600. end;
  1601. end;
  1602. except
  1603. ShowDefaultMessageBox ('Error writing temporary source file.', 'Error', mtProgramError);
  1604. end;
  1605. end;
  1606. procedure TSourceTextSourceFile.UpdateEditor;
  1607. begin
  1608. inherited;
  1609. if Assigned (SourceEditor) then
  1610. with SourceEditor do
  1611. SplitOnFly := EditorOnFly;
  1612. end;
  1613. { TCSourceFile }
  1614. procedure TCSourceFile.Compile;
  1615. var
  1616. Folder,
  1617. Switches: string;
  1618. begin
  1619. CompStartFile;
  1620. OperationCancelled := False;
  1621. OperationSuccessful := False;
  1622. if FileExists (WithBackslash (TIGCCFolder) + GCCLocation + 'GCC.exe') then begin
  1623. CompSetMessage ('Compiling File ''' + SourceName + '''');
  1624. Folder := WithBackslash (Temp + FolderPath);
  1625. CurErrFunction := '';
  1626. InAssemblingState := False;
  1627. if FileExists (Folder + 'TEMPPROG.S') then
  1628. DeleteFile (Folder + 'TEMPPROG.S');
  1629. if FileExists (Temp + 'TEMPPROG.O') then
  1630. DeleteFile (Temp + 'TEMPPROG.O');
  1631. SplitAndWriteToFile (Folder + 'TEMPPROG.C');
  1632. MainConsole.Title := 'Compiler';
  1633. Switches := DefaultGCCSwitches + ' ' + GCCSwitches + ' ' + SpecialSwitches;
  1634. if UseDataVar then
  1635. Switches := Switches + ' -mno-merge-sections';
  1636. if AssumeUndefined then
  1637. Switches := Switches + ' -Werror-implicit-function-declaration';
  1638. if DebugInfo then
  1639. Switches := Switches + ' -gdwarf-2 -g3 -fasynchronous-unwind-tables';
  1640. if ProjectTarget = ptFargo then
  1641. Switches := Switches + ' -DFARGO'
  1642. else if ProjectTarget = ptFlashOS then
  1643. Switches := Switches + ' -DFLASH_OS'
  1644. else if Assigned (PredefinedLibOptions) and (ProjectTarget = ptRegular) then
  1645. Switches := Switches + ' ' + PredefinedLibOptions.GetSwitches;
  1646. CompUpdate;
  1647. try
  1648. MainConsole.StartProcess (WithBackslash (TIGCCFolder) + GCCLocation + 'GCC.exe', '-S -I ' + Folder + ' ' + Switches + ' "' + Folder + 'tempprog.c" -o "' + Folder + 'tempprog.s"', WithoutBackslash (WithBackslash (TIGCCFolder) + GCCLocation));
  1649. WaitForMainConsole ('Compilation');
  1650. except
  1651. ShowDefaultMessageBox ('Could not start compiler.', 'Error', mtProgramError);
  1652. end;
  1653. OperationSuccessful := True;
  1654. ProcessErrors (MainConsole.LastErrText);
  1655. if OperationSuccessful then begin
  1656. OperationSuccessful := False;
  1657. if not OperationCancelled then
  1658. if FileExists (Folder + 'TEMPPROG.S') then begin
  1659. OperationSuccessful := True;
  1660. ProcessSFile (Folder + 'TEMPPROG.S', ChangeFileExt (FileName, '.s'));
  1661. end;
  1662. end;
  1663. if OperationSuccessful then begin
  1664. OperationSuccessful := False;
  1665. CurErrFunction := '';
  1666. InAssemblingState := True;
  1667. CompUpdate;
  1668. Switches := DefaultAsSwitches + ' ' + AsSwitches;
  1669. if CutUnusedRanges or (ProjectTarget = ptArchive) then
  1670. Switches := Switches + ' --all-relocs';
  1671. if OptimizeReturns or (ProjectTarget = ptArchive) then
  1672. Switches := Switches + ' --keep-locals';
  1673. if DebugInfo then
  1674. Switches := Switches + ' --gdwarf2';
  1675. try
  1676. MainConsole.StartProcess (WithBackslash (TIGCCFolder) + AsLocation + 'As.exe', '-I ' + Folder + ' ' + Switches + ' "' + Folder + 'tempprog.s" -o ' + Temp + 'tempprog.o', WithoutBackslash (WithBackslash (TIGCCFolder) + AsLocation));
  1677. WaitForMainConsole ('Compilation');
  1678. except
  1679. ShowDefaultMessageBox ('Could not start assembler.', 'Error', mtProgramError);
  1680. end;
  1681. if FileExists (Temp + 'TEMPPROG.O') then begin
  1682. if not OperationCancelled then begin
  1683. CopyFile (PChar (Temp + 'TEMPPROG.O'), PChar (ChangeFileExt (FileName, '.o')), False);
  1684. OperationSuccessful := True;
  1685. end;
  1686. DeleteFile (Temp + 'TEMPPROG.O');
  1687. end;
  1688. ProcessErrors (MainConsole.LastErrText);
  1689. end;
  1690. CompUpdate;
  1691. try
  1692. if FileExists (Folder + 'TEMPPROG.C') then
  1693. DeleteFile (Folder + 'TEMPPROG.C');
  1694. if FileExists (Folder + 'TEMPPROG.S') then
  1695. DeleteFile (Folder + 'TEMPPROG.S');
  1696. RemovePath (Folder, Temp);
  1697. except end;
  1698. CompUpdate;
  1699. end else
  1700. ShowDefaultMessageBox ('Cannot find compiler.', 'Error', mtProgramError);
  1701. if OperationSuccessful and not OperationCancelled then
  1702. Invalidated := False;
  1703. end;
  1704. class function TCSourceFile.GetClassFilter: string;
  1705. begin
  1706. Result := 'C Files (*.c)|*.c';
  1707. end;
  1708. class function TCSourceFile.GetClassImageIndex: Integer;
  1709. begin
  1710. Result := 4;
  1711. end;
  1712. class function TCSourceFile.GetClassItemName: string;
  1713. begin
  1714. Result := 'C File';
  1715. end;
  1716. class function TCSourceFile.GetClassTreeIndex: Integer;
  1717. begin
  1718. Result := 1;
  1719. end;
  1720. class function TCSourceFile.GetCompilable: Boolean;
  1721. begin
  1722. Result := True;
  1723. end;
  1724. function TCSourceFile.GetContentType: TSourceFileType;
  1725. begin
  1726. Result := ftCFile;
  1727. end;
  1728. procedure TCSourceFile.ProcessErrorLine(Line: string);
  1729. var
  1730. Whole: string;
  1731. P,
  1732. Ofs: Integer;
  1733. S: string;
  1734. FN: string;
  1735. Tp: TBugType;
  1736. CurErrFile: string;
  1737. begin
  1738. if not Assigned (OnError) then
  1739. Exit;
  1740. P := Pos (#10, Line);
  1741. if P > 0 then begin
  1742. ProcessErrorLine (Copy (Line, 1, P - 1));
  1743. ProcessErrorLine (Copy (Line, P + 1, Length (Line)));
  1744. end else begin
  1745. repeat
  1746. P := Pos ('`', Line);
  1747. if P > 0 then
  1748. Line [P] := '''';
  1749. until P <= 0;
  1750. repeat
  1751. P := Pos ('´', Line);
  1752. if P > 0 then
  1753. Line [P] := '''';
  1754. until P <= 0;
  1755. repeat
  1756. P := Pos ('"', Line);
  1757. if P > 0 then
  1758. Line [P] := '''';
  1759. until P <= 0;
  1760. Line := Trim (Line);
  1761. if (Pos ('ASSEMBLER MESSAGES:', UpperCase (Line)) > 0) or
  1762. StartsWith ('FROM ', Line) or
  1763. (AssumeUndefined and
  1764. ((Pos ('PREVIOUS IMPLICIT DECLARATION', UpperCase (Line)) > 0) or
  1765. (Pos ('PREVIOUSLY IMPLICITLY DECLARED', UpperCase (Line)) > 0))) then
  1766. Exit;
  1767. Whole := Line;
  1768. FN := '';
  1769. CurErrFile := '';
  1770. if StartsWith ('IN FILE', Line) then
  1771. CurErrFunction := ''
  1772. else begin
  1773. P := Pos (':', Line);
  1774. while (P > 0) and (Length (Line) > P) and (Line [P + 1] in ['\', '/']) do begin
  1775. Ofs := Pos (':', Copy (Line, P + 1, Length (Line)));
  1776. if Ofs > 0 then
  1777. Inc (P, Ofs)
  1778. else begin
  1779. P := 0;
  1780. Break;
  1781. end;
  1782. end;
  1783. if P > 0 then
  1784. FN := Copy (Line, 1, P - 1);
  1785. if Length (FN) > 0 then begin
  1786. Delete (Line, 1, Length (FN) + 1);
  1787. repeat
  1788. P := Pos ('/', FN);
  1789. if P > 0 then
  1790. FN [P] := '\';
  1791. until P <= 0;
  1792. if InAssemblingState then begin
  1793. if Pos ('TEMPPROG', UpperCase (FN)) > 0 then
  1794. CurErrFile := ChangeFileExt (FileName, '.s')
  1795. else
  1796. CurErrFile := ExtractFileName (FN);
  1797. end else begin
  1798. if UpperCase (ExtractFileExt (FN)) = '.S' then begin
  1799. FN := '';
  1800. CurErrFunction := '';
  1801. end else begin
  1802. if Pos ('TEMPPROG', UpperCase (FN)) > 0 then
  1803. CurErrFile := FileName
  1804. else
  1805. CurErrFile := ExtractFileName (FN);
  1806. end;
  1807. end;
  1808. P := 0;
  1809. Ofs := 0;
  1810. if (Length (Line) > 0) and (Line [1] in ['0'..'9']) then begin
  1811. try
  1812. S := Copy (Line, 1, Pos (':', Line) - 1);
  1813. P := StrToInt (S);
  1814. Delete (Line, 1, Length (S) + 1);
  1815. if (Length (Line) > 0) and (Line [1] in ['0'..'9']) then try
  1816. S := Copy (Line, 1, Pos (':', Line) - 1);
  1817. Ofs := StrToInt (S) - 1;
  1818. Delete (Line, 1, Length (S) + 1);
  1819. except end;
  1820. except end;
  1821. Line := Trim (Line);
  1822. if StartsWith ('WARNING:', Line, False, True) then
  1823. Tp := btWarning
  1824. else begin
  1825. StartsWith ('ERROR:', Line, False, True);
  1826. Tp := btError;
  1827. OperationSuccessful := False;
  1828. end;
  1829. Line := Trim (Line);
  1830. if StartsWith ('#WARNING ', Line, False, True) then
  1831. Tp := btWarning;
  1832. StartsWith ('#ERROR ', Line, False, True);
  1833. if StartsWith ('PREVIOUS DECLARATION OF ', Line) or
  1834. StartsWith ('POSSIBLE REAL START OF ', Line) or
  1835. StartsWith ('UNUSED VARIABLE ', Line) or
  1836. StartsWith ('UNUSED PARAMETER ', Line) or
  1837. (Pos ('PREVIOUSLY DECLARED HERE', UpperCase (Line)) > 0) or
  1838. (Pos ('LOCATION OF THE PREVIOUS DEFINITION', UpperCase (Line)) > 0) then
  1839. Tp := btInfo;
  1840. if AssumeUndefined and StartsWith ('Implicit declaration of ', Line, False, True) then begin
  1841. Insert ('Undefined reference to ', Line, 1);
  1842. Tp := btError;
  1843. OperationSuccessful := False;
  1844. end;
  1845. if (Length (CurErrFile) <= 0) and (P > 0) and (Length (FN) > 0) then
  1846. Line := UpperCase (ExtractFileName (FN)) + ' Line ' + IntToStr (P) + ' - ' + Line;
  1847. Line := Trim (Line);
  1848. if (Length (Line) > 0) and (Line [Length (Line)] <> '.') then
  1849. Line := Line + '.';
  1850. OnError (Whole, Tp, CurErrFile, CurErrFunction, Line, P, Ofs);
  1851. if Tp = btError then
  1852. OperationSuccessful := False;
  1853. end else begin
  1854. if StartsWith (' IN FUNCTION ''', Line, False, True) then
  1855. CurErrFunction := Copy (Line, 1, Pos ('''', Line) - 1)
  1856. else if StartsWith (' AT TOP LEVEL', Line) then
  1857. CurErrFunction := ''
  1858. else
  1859. OnError (Whole, btError, FileName, '', Line, 0, 0);
  1860. end;
  1861. end else begin
  1862. Tp := btError;
  1863. if StartsWith ('PLEASE FILL OUT ', Line) then
  1864. Tp := btInfo;
  1865. OnError (Whole, Tp, '', '', Whole, 0, 0);
  1866. end;
  1867. end;
  1868. end;
  1869. end;
  1870. procedure TCSourceFile.ProcessSFile(const SourceFile, DestFile: string);
  1871. var
  1872. L: TStringList;
  1873. begin
  1874. L := TStringList.Create;
  1875. with L do try
  1876. LoadFromFile (SourceFile);
  1877. if (Count > 0) and (Copy (LowerCase (Strings [0]), 1, Length (#9'.file')) = #9'.file') then
  1878. Strings [0] := #9'.file'#9'"' + ExtractFileName (FileName) + '"';
  1879. try
  1880. ParseSFile (L);
  1881. except
  1882. OperationSuccessful := False;
  1883. end;
  1884. SaveToFile (SourceFile);
  1885. SaveToFile (DestFile);
  1886. finally
  1887. Free;
  1888. end;
  1889. end;
  1890. procedure TCSourceFile.Save;
  1891. var
  1892. FH: THandle;
  1893. begin
  1894. inherited;
  1895. if (not Invalidated) and FileExists (ChangeFileExt (FileName, '.o')) then begin
  1896. FH := FileOpen (ChangeFileExt (FileName, '.o'), fmOpenReadWrite + fmShareExclusive);
  1897. FileSetDate (FH, FileAge (FileName));
  1898. FileClose (FH);
  1899. end;
  1900. end;
  1901. procedure TCSourceFile.SetModified(const Value: Boolean);
  1902. begin
  1903. if not Modifying then begin
  1904. Modifying := True;
  1905. FModified := Value;
  1906. if Value then
  1907. Invalidate;
  1908. Modifying := False;
  1909. end;
  1910. end;
  1911. procedure TCSourceFile.UpdateEditor;
  1912. begin
  1913. inherited;
  1914. if Assigned (SourceEditor) then begin
  1915. SourceEditor.TabSize := TabSizeC;
  1916. SourceEditor.AutoIndentIncrease := AutoBlocks;
  1917. end;
  1918. end;
  1919. procedure TCSourceFile.UpdateSyntax;
  1920. begin
  1921. if Assigned (SourceEditor) then
  1922. with SourceEditor do
  1923. SyntaxColoring.Assign (SyntaxC);
  1924. end;
  1925. { TGNUAsmSourceFile }
  1926. procedure TGNUAsmSourceFile.Compile;
  1927. var
  1928. Folder,
  1929. Switches: string;
  1930. begin
  1931. CompStartFile;
  1932. OperationCancelled := False;
  1933. OperationSuccessful := False;
  1934. if FileExists (WithBackslash (TIGCCFolder) + AsLocation + 'As.exe') then begin
  1935. CompSetMessage ('Assembling File ''' + SourceName + '''');
  1936. Folder := WithBackslash (Temp + FolderPath);
  1937. if FileExists (Temp + 'TEMPPROG.O') then
  1938. DeleteFile (Temp + 'TEMPPROG.O');
  1939. SplitAndWriteToFile (Folder + 'TEMPPROG.S');
  1940. Switches := DefaultAsSwitches + ' ' + AsSwitches;
  1941. if CutUnusedRanges or (ProjectTarget = ptArchive) then
  1942. Switches := Switches + ' --all-relocs';
  1943. if OptimizeReturns or (ProjectTarget = ptArchive) then
  1944. Switches := Switches + ' --keep-locals';
  1945. if DebugInfo then
  1946. Switches := Switches + ' --gdwarf2';
  1947. MainConsole.Title := 'Assembler';
  1948. try
  1949. MainConsole.StartProcess (WithBackslash (TIGCCFolder) + AsLocation + 'As.exe', '-I ' + Folder + ' ' + Switches + ' "' + Folder + 'tempprog.s" -o ' + Temp + 'tempprog.o', WithoutBackslash (WithBackslash (TIGCCFolder) + AsLocation));
  1950. WaitForMainConsole ('Assembling');
  1951. except
  1952. ShowDefaultMessageBox ('Could not start assembler.', 'Error', mtProgramError);
  1953. end;
  1954. if FileExists (Temp + 'TEMPPROG.O') then begin
  1955. if not OperationCancelled then begin
  1956. CopyFile (PChar (Temp + 'TEMPPROG.O'), PChar (ChangeFileExt (FileName, '.o')), False);
  1957. OperationSuccessful := True;
  1958. end;
  1959. DeleteFile (Temp + 'TEMPPROG.O');
  1960. end;
  1961. ProcessErrors (MainConsole.LastErrText);
  1962. try
  1963. if FileExists (Folder + 'TEMPPROG.S') then
  1964. DeleteFile (Folder + 'TEMPPROG.S');
  1965. RemovePath (Folder, Temp);
  1966. except end;
  1967. CompUpdate;
  1968. end else
  1969. ShowDefaultMessageBox ('Cannot find assembler.', 'Error', mtProgramError);
  1970. if OperationSuccessful and not OperationCancelled then
  1971. Invalidated := False;
  1972. end;
  1973. class function TGNUAsmSourceFile.GetClassFilter: string;
  1974. begin
  1975. Result := 'GNU Assembly Files (*.s)|*.s';
  1976. end;
  1977. class function TGNUAsmSourceFile.GetClassImageIndex: Integer;
  1978. begin
  1979. Result := 5;
  1980. end;
  1981. class function TGNUAsmSourceFile.GetClassItemName: string;
  1982. begin
  1983. Result := 'GNU Assembler File';
  1984. end;
  1985. class function TGNUAsmSourceFile.GetClassTreeIndex: Integer;
  1986. begin
  1987. Result := 2;
  1988. end;
  1989. class function TGNUAsmSourceFile.GetCompilable: Boolean;
  1990. begin
  1991. Result := True;
  1992. end;
  1993. function TGNUAsmSourceFile.GetContentType: TSourceFileType;
  1994. begin
  1995. Result := ftGNUAsmFile;
  1996. end;
  1997. procedure TGNUAsmSourceFile.ProcessErrorLine(Line: string);
  1998. var
  1999. Whole: string;
  2000. P,
  2001. Ofs: Integer;
  2002. S: string;
  2003. FN: string;
  2004. Tp: TBugType;
  2005. CurErrFile: string;
  2006. begin
  2007. P := Pos (#10, Line);
  2008. if P > 0 then begin
  2009. ProcessErrorLine (Copy (Line, 1, P - 1));
  2010. ProcessErrorLine (Copy (Line, P + 1, Length (Line)));
  2011. end else begin
  2012. repeat
  2013. P := Pos ('`', Line);
  2014. if P > 0 then
  2015. Line [P] := '''';
  2016. until P <= 0;
  2017. repeat
  2018. P := Pos ('´', Line);
  2019. if P > 0 then
  2020. Line [P] := '''';
  2021. until P <= 0;
  2022. repeat
  2023. P := Pos ('"', Line);
  2024. if P > 0 then
  2025. Line [P] := '''';
  2026. until P <= 0;
  2027. if (Pos ('ASSEMBLER MESSAGES:', UpperCase (Line)) > 0) or
  2028. (Pos ('IN FILE', UpperCase (Line)) > 0) then
  2029. Exit;
  2030. Whole := Line;
  2031. FN := '';
  2032. CurErrFile := '';
  2033. P := Pos (':', Line);
  2034. while (Length (Line) > P) and (Line [P + 1] in ['\', '/']) do
  2035. Inc (P, Pos (':', Copy (Line, P + 1, Length (Line))));
  2036. FN := Copy (Line, 1, P - 1);
  2037. if Length (FN) > 0 then begin
  2038. Delete (Line, 1, Length (FN) + 1);
  2039. repeat
  2040. P := Pos ('/', FN);
  2041. if P > 0 then
  2042. FN [P] := '\';
  2043. until P <= 0;
  2044. if (UpperCase (ExtractFileExt (FN)) = '.C') or (Pos ('TEMPPROG', UpperCase (FN)) > 0) then
  2045. CurErrFile := FileName
  2046. else
  2047. CurErrFile := ExtractFileName (FN);
  2048. P := 0;
  2049. Ofs := 0;
  2050. if (Length (Line) > 0) and (Line [1] in ['0'..'9']) then begin
  2051. try
  2052. S := Copy (Line, 1, Pos (':', Line) - 1);
  2053. P := StrToInt (S);
  2054. Delete (Line, 1, Length (S) + 1);
  2055. if (Length (Line) > 0) and (Line [1] in ['0'..'9']) then try
  2056. S := Copy (Line, 1, Pos (':', Line) - 1);
  2057. Ofs := StrToInt (S) - 1;
  2058. Delete (Line, 1, Length (S) + 1);
  2059. except end;
  2060. except end;
  2061. Line := Trim (Line);
  2062. if StartsWith ('WARNING:', Line, False, True) then
  2063. Tp := btWarning
  2064. else begin
  2065. StartsWith ('ERROR:', Line, False, True);
  2066. Tp := btError;
  2067. OperationSuccessful := False;
  2068. end;
  2069. Line := Trim (Line);
  2070. if (Length (CurErrFile) <= 0) and (P > 0) and (Length (FN) > 0) then
  2071. Line := UpperCase (ExtractFileName (FN)) + ' Line ' + IntToStr (P) + ' - ' + Line;
  2072. if Assigned (OnError) then
  2073. OnError (Whole, Tp, CurErrFile, '', Line, P, Ofs);
  2074. end else begin
  2075. if Assigned (OnError) then
  2076. OnError (Whole, btError, FileName, '', Line, 0, 0);
  2077. end;
  2078. end else
  2079. if Assigned (OnError) then
  2080. OnError (Whole, btError, '', '', Whole, 0, 0);
  2081. end;
  2082. end;
  2083. procedure TGNUAsmSourceFile.Save;
  2084. var
  2085. FH: THandle;
  2086. begin
  2087. inherited;
  2088. if (not Invalidated) and FileExists (ChangeFileExt (FileName, '.o')) then begin
  2089. FH := FileOpen (ChangeFileExt (FileName, '.o'), fmOpenReadWrite + fmShareExclusive);
  2090. FileSetDate (FH, FileAge (FileName));
  2091. FileClose (FH);
  2092. end;
  2093. end;
  2094. procedure TGNUAsmSourceFile.SetModified(const Value: Boolean);
  2095. begin
  2096. if not Modifying then begin
  2097. Modifying := True;
  2098. FModified := Value;
  2099. if Value then
  2100. Invalidate;
  2101. Modifying := False;
  2102. end;
  2103. end;
  2104. procedure TGNUAsmSourceFile.UpdateEditor;
  2105. begin
  2106. inherited;
  2107. if Assigned (SourceEditor) then begin
  2108. SourceEditor.TabSize := TabSizeAsm;
  2109. SourceEditor.AutoIndentIncrease := False;
  2110. end;
  2111. end;
  2112. procedure TGNUAsmSourceFile.UpdateSyntax;
  2113. begin
  2114. if Assigned (SourceEditor) then
  2115. with SourceEditor do begin
  2116. SyntaxColoring.Assign (SyntaxAsmGNU);
  2117. TabSize := TabSizeAsm;
  2118. AutoIndentIncrease := False;
  2119. end;
  2120. end;
  2121. { TAsmSourceFile }
  2122. procedure TAsmSourceFile.Compile;
  2123. var
  2124. Folder,
  2125. Switches: string;
  2126. FPos: Integer;
  2127. CurErrFile,
  2128. S: string;
  2129. CurErrLine,
  2130. P: Integer;
  2131. EmptyLn: Boolean;
  2132. LL: TStringList;
  2133. begin
  2134. CompStartFile;
  2135. OperationCancelled := False;
  2136. OperationSuccessful := False;
  2137. if FileExists (WithBackslash (TIGCCFolder) + A68kLocation + 'A68k.exe') then begin
  2138. CompSetMessage ('Assembling File ''' + SourceName + '''');
  2139. Folder := WithBackslash (Temp + FolderPath);
  2140. if FileExists (WithBackslash (TIGCCFolder) + GCCLocation + 'TEMPPROG.O') then
  2141. DeleteFile (WithBackslash (TIGCCFolder) + GCCLocation + 'TEMPPROG.O');
  2142. if FileExists (Temp + 'TEMPPROG.O') then
  2143. DeleteFile (Temp + 'TEMPPROG.O');
  2144. SplitAndWriteToFile (Folder + 'TEMPPROG.ASM');
  2145. Switches := DefaultA68kSwitches + ' ' + AsmSwitches;
  2146. if CutUnusedRanges or (ProjectTarget = ptArchive) then
  2147. Switches := Switches + ' -a';
  2148. if OptimizeReturns or (ProjectTarget = ptArchive) then
  2149. Switches := Switches + ' -d';
  2150. MainConsole.Title := 'Assembler';
  2151. try
  2152. MainConsole.StartProcess (WithBackslash (TIGCCFolder) + A68kLocation + 'A68k.exe', '"' + Folder + 'tempprog.asm" ' + Switches, WithoutBackslash (Temp));
  2153. WaitForMainConsole ('Assembling');
  2154. except
  2155. ShowDefaultMessageBox ('Could not start assembler.', 'Error', mtProgramError);
  2156. end;
  2157. UpdateProgramOutput;
  2158. if not OperationCancelled then begin
  2159. if Assigned (ErrorList) then
  2160. ErrorList.Items.BeginUpdate;
  2161. try
  2162. LL := TStringList.Create;
  2163. try
  2164. LL.Text := MainConsole.LastOutText;
  2165. EmptyLn := False;
  2166. FPos := 0;
  2167. while FPos < LL.Count do begin
  2168. S := LL [FPos];
  2169. Inc (FPos);
  2170. CurErrLine := 0;
  2171. if (Length (S) <= 0) or (Pos ('ASSEMBLING', UpperCase (S)) > 0) then
  2172. EmptyLn := True
  2173. else begin
  2174. if EmptyLn then begin
  2175. EmptyLn := False;
  2176. while (FPos < LL.Count) and (Pos ('TEMPPROG.ASM LINE ', UpperCase (S)) <= 0) do begin
  2177. if (Length (S) > 0) and (Pos ('(USER MACRO)', UpperCase (S)) <= 0) then begin
  2178. if Length (CurErrFile) <= 0 then begin
  2179. while Pos ('/', S) > 0 do
  2180. S [Pos ('/', S)] := '\';
  2181. P := Pos ('LINE ', UpperCase (S));
  2182. if P > 0 then begin
  2183. CurErrFile := ExtractFileName (Copy (S, 1, P - 2));
  2184. try
  2185. CurErrLine := StrToInt (Copy (S, P + Length ('LINE '), Length (S)));
  2186. except
  2187. CurErrLine := 0;
  2188. end;
  2189. end;
  2190. end;
  2191. end;
  2192. S := LL [FPos];
  2193. Inc (FPos);
  2194. end;
  2195. if FPos < LL.Count then begin
  2196. if Length (CurErrFile) <= 0 then begin
  2197. Delete (S, 1, Pos ('TEMPPROG.ASM LINE ', UpperCase (S)) + Length ('TEMPPROG.ASM LINE ') - 1);
  2198. try
  2199. CurErrLine := StrToInt (S);
  2200. except
  2201. CurErrLine := 0;
  2202. end;
  2203. end;
  2204. Inc (FPos);
  2205. if FPos < LL.Count then begin
  2206. S := LL [FPos];
  2207. Inc (FPos);
  2208. S := Copy (S, FirstNonWhiteSpace (S), Length (S));
  2209. StartsWith ('^ ', S, True, True);
  2210. if S [Length (S)] = '.' then
  2211. Delete (S, Length (S), 1);
  2212. OperationSuccessful := False;
  2213. if Length (CurErrFile) <= 0 then
  2214. CurErrFile := FileName;
  2215. if Assigned (OnError) then
  2216. OnError (IntToStr (CurErrLine) + ': ' + S, btError, CurErrFile, '', S, CurErrLine, 0);
  2217. CurErrFile := '';
  2218. end;
  2219. end;
  2220. end;
  2221. end;
  2222. end;
  2223. except end;
  2224. LL.Free;
  2225. finally
  2226. if Assigned (ErrorList) then
  2227. ErrorList.Items.EndUpdate;
  2228. end;
  2229. end;
  2230. CompUpdate;
  2231. if FileExists (Temp + 'TEMPPROG.O') then begin
  2232. if not OperationCancelled then begin
  2233. CopyFile (PChar (Temp + 'TEMPPROG.O'), PChar (ChangeFileExt (FileName, '.o')), False);
  2234. OperationSuccessful := True;
  2235. end;
  2236. DeleteFile (Temp + 'TEMPPROG.O');
  2237. end;
  2238. try
  2239. if FileExists (Folder + 'TEMPPROG.ASM') then
  2240. DeleteFile (Folder + 'TEMPPROG.ASM');
  2241. RemovePath (Folder, Temp);
  2242. except end;
  2243. CompUpdate;
  2244. end else
  2245. ShowDefaultMessageBox ('Cannot find assembler.', 'Error', mtProgramError);
  2246. if OperationSuccessful and not OperationCancelled then
  2247. Invalidated := False;
  2248. end;
  2249. class function TAsmSourceFile.GetClassFilter: string;
  2250. begin
  2251. Result := 'A68k Assembly Files (*.asm)|*.asm';
  2252. end;
  2253. class function TAsmSourceFile.GetClassImageIndex: Integer;
  2254. begin
  2255. Result := 5;
  2256. end;
  2257. class function TAsmSourceFile.GetClassItemName: string;
  2258. begin
  2259. Result := 'Assembler File';
  2260. end;
  2261. class function TAsmSourceFile.GetClassTreeIndex: Integer;
  2262. begin
  2263. Result := 3;
  2264. end;
  2265. class function TAsmSourceFile.GetCompilable: Boolean;
  2266. begin
  2267. Result := True;
  2268. end;
  2269. function TAsmSourceFile.GetContentType: TSourceFileType;
  2270. begin
  2271. Result := ftA68kAsmFile;
  2272. end;
  2273. procedure TAsmSourceFile.Save;
  2274. var
  2275. FH: THandle;
  2276. begin
  2277. inherited;
  2278. if (not Invalidated) and FileExists (ChangeFileExt (FileName, '.o')) then begin
  2279. FH := FileOpen (ChangeFileExt (FileName, '.o'), fmOpenReadWrite + fmShareExclusive);
  2280. FileSetDate (FH, FileAge (FileName));
  2281. FileClose (FH);
  2282. end;
  2283. end;
  2284. procedure TAsmSourceFile.SetModified(const Value: Boolean);
  2285. begin
  2286. if not Modifying then begin
  2287. Modifying := True;
  2288. FModified := Value;
  2289. if Value then
  2290. Invalidate;
  2291. Modifying := False;
  2292. end;
  2293. end;
  2294. procedure TAsmSourceFile.UpdateEditor;
  2295. begin
  2296. inherited;
  2297. if Assigned (SourceEditor) then begin
  2298. SourceEditor.TabSize := TabSizeAsm;
  2299. SourceEditor.AutoIndentIncrease := False;
  2300. end;
  2301. end;
  2302. procedure TAsmSourceFile.UpdateSyntax;
  2303. begin
  2304. if Assigned (SourceEditor) then
  2305. with SourceEditor do begin
  2306. SyntaxColoring.Assign (SyntaxAsm);
  2307. TabSize := TabSizeAsm;
  2308. AutoIndentIncrease := False;
  2309. end;
  2310. end;
  2311. { TQuillSourceFile }
  2312. procedure TQuillSourceFile.Compile;
  2313. var
  2314. QuillDrv: string;
  2315. begin
  2316. QuillDrv := WithBackslash (TIGCCFolder) + QuillIncludeLocation + 'Quill.drv';
  2317. if not FileExists (QuillDrv) then begin
  2318. QuillDrv := WithBackslash (TIGCCFolder) + CIncludeLocation + 'Quill.drv';
  2319. if not FileExists (QuillDrv) then begin
  2320. QuillDrv := WithBackslash (TIGCCFolder) + GCCLocation + 'Quill.drv';
  2321. if not FileExists (QuillDrv) then
  2322. QuillDrv := 'Quill.drv';
  2323. end;
  2324. end;
  2325. SpecialSwitches := SpecialQuillGCCSwitches + ' -include "' + QuillDrv + '"';
  2326. inherited;
  2327. end;
  2328. class function TQuillSourceFile.GetClassFilter: string;
  2329. begin
  2330. Result := 'Quill Files (*.qll)|*.qll';
  2331. end;
  2332. class function TQuillSourceFile.GetClassImageIndex: Integer;
  2333. begin
  2334. Result := 4;
  2335. end;
  2336. class function TQuillSourceFile.GetClassItemName: string;
  2337. begin
  2338. Result := 'Quill File';
  2339. end;
  2340. class function TQuillSourceFile.GetClassTreeIndex: Integer;
  2341. begin
  2342. Result := 3;
  2343. if ssA68k in SpecialSupport then
  2344. Inc (Result);
  2345. end;
  2346. function TQuillSourceFile.GetContentType: TSourceFileType;
  2347. begin
  2348. Result := ftQuillFile;
  2349. end;
  2350. procedure TQuillSourceFile.UpdateSyntax;
  2351. begin
  2352. if Assigned (SourceEditor) then
  2353. with SourceEditor do
  2354. SyntaxColoring.Assign (SyntaxQuill);
  2355. end;
  2356. { TObjectSourceFile }
  2357. class function TObjectSourceFile.GetClassFilter: string;
  2358. begin
  2359. Result := 'Object Files (*.o)|*.o';
  2360. end;
  2361. class function TObjectSourceFile.GetClassImageIndex: Integer;
  2362. begin
  2363. Result := 6;
  2364. end;
  2365. class function TObjectSourceFile.GetClassItemName: string;
  2366. begin
  2367. Result := 'Object File';
  2368. end;
  2369. class function TObjectSourceFile.GetClassTreeIndex: Integer;
  2370. begin
  2371. Result := 3;
  2372. if ssA68k in SpecialSupport then
  2373. Inc (Result);
  2374. if ssQuill in SpecialSupport then
  2375. Inc (Result);
  2376. end;
  2377. { TArchiveSourceFile }
  2378. class function TArchiveSourceFile.GetClassFilter: string;
  2379. begin
  2380. Result := 'Archive Files (*.a)|*.a';
  2381. end;
  2382. class function TArchiveSourceFile.GetClassImageIndex: Integer;
  2383. begin
  2384. Result := 6;
  2385. end;
  2386. class function TArchiveSourceFile.GetClassItemName: string;
  2387. begin
  2388. Result := 'Archive File';
  2389. end;
  2390. class function TArchiveSourceFile.GetClassTreeIndex: Integer;
  2391. begin
  2392. Result := 4;
  2393. if ssA68k in SpecialSupport then
  2394. Inc (Result);
  2395. if ssQuill in SpecialSupport then
  2396. Inc (Result);
  2397. end;
  2398. { TNormalTextSourceFile }
  2399. destructor TNormalTextSourceFile.Destroy;
  2400. var
  2401. PrevEditor: TMemoComponent;
  2402. begin
  2403. if Assigned (FEditor) then begin
  2404. PrevEditor := FEditor;
  2405. FEditor := nil;
  2406. PrevEditor.Free;
  2407. end;
  2408. inherited;
  2409. end;
  2410. class function TNormalTextSourceFile.GetClassFilter: string;
  2411. begin
  2412. Result := 'Text Files (*.txt)|*.txt';
  2413. end;
  2414. class function TNormalTextSourceFile.GetClassImageIndex: Integer;
  2415. begin
  2416. Result := 7;
  2417. end;
  2418. class function TNormalTextSourceFile.GetClassItemName: string;
  2419. begin
  2420. Result := 'Text File';
  2421. end;
  2422. class function TNormalTextSourceFile.GetClassTreeIndex: Integer;
  2423. begin
  2424. Result := 5;
  2425. if ssA68k in SpecialSupport then
  2426. Inc (Result);
  2427. if ssQuill in SpecialSupport then
  2428. Inc (Result);
  2429. end;
  2430. function TNormalTextSourceFile.GetInternalTextEditor: TMemoComponent;
  2431. begin
  2432. Result := FEditor;
  2433. end;
  2434. function TNormalTextSourceFile.GetTextEditor: TMemoComponent;
  2435. begin
  2436. if not Assigned (FEditor) then begin
  2437. FEditor := TMemoComponent.Create (Application.MainForm);
  2438. with FEditor do begin
  2439. AllowUndo := False;
  2440. TabSize := 8;
  2441. Text := FTempContent;
  2442. end;
  2443. UpdateEditor;
  2444. FTempContent := '';
  2445. with FEditor do begin
  2446. OnChangePrivate := Change;
  2447. OnReplaceText := ReplaceText;
  2448. AllowUndo := True;
  2449. end;
  2450. end;
  2451. Result := FEditor;
  2452. end;
  2453. { TOtherSourceFile }
  2454. class function TOtherSourceFile.GetClassFilter: string;
  2455. begin
  2456. Result := '';
  2457. end;
  2458. class function TOtherSourceFile.GetClassImageIndex: Integer;
  2459. begin
  2460. Result := 8;
  2461. end;
  2462. class function TOtherSourceFile.GetClassItemName: string;
  2463. begin
  2464. Result := 'Other File';
  2465. end;
  2466. class function TOtherSourceFile.GetClassTreeIndex: Integer;
  2467. begin
  2468. Result := 6;
  2469. if ssA68k in SpecialSupport then
  2470. Inc (Result);
  2471. if ssQuill in SpecialSupport then
  2472. Inc (Result);
  2473. end;
  2474. end.