SourceFileUnit.pas 71 KB

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