SourceFileUnit.pas 70 KB

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