SourceFileUnit.pas 71 KB

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