123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442 |
- {
- TIGCC IDE
- Copyright (C) 2000-2004 Sebastian Reichelt
- Copyright (C) 2005 Fréderic Bour
- Copyright (C) 2005 Kevin Kofler
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- }
- unit MainUnit;
- interface
- uses
- MasterUnit, SourceFileUnit, FolderUnit, ToolsListUnit, LinkDLLUnit,
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- Menus, StdCtrls, ExtCtrls, ImgList, ComCtrls, Buttons, ActnList, ToolWin,
- Printers, SourceEditUnit, HTMLHelpUnit, MemoComponentUnit, ScktComp;
- type
- TPanel = class(ExtCtrls.TPanel)
- protected
- procedure Paint; override;
- end;
- TMainForm = class(TForm)
- ProjectTree: TTreeView;
- LittleIcons: TImageList;
- TreeEditorSplitter: TSplitter;
- MainMenu: TMainMenu;
- MainMenuFile: TMenuItem;
- MenuFileNew: TMenuItem;
- Project1: TMenuItem;
- AssemblerSource1: TMenuItem;
- Open1: TMenuItem;
- Save1: TMenuItem;
- SaveAs1: TMenuItem;
- N1: TMenuItem;
- Exit1: TMenuItem;
- CSourceFile1: TMenuItem;
- MainMenuEdit: TMenuItem;
- Undo1: TMenuItem;
- N2: TMenuItem;
- Delete1: TMenuItem;
- Cut1: TMenuItem;
- Copy1: TMenuItem;
- Paste1: TMenuItem;
- AddFiles1: TMenuItem;
- MenuCompileLine: TMenuItem;
- MainMenuProject: TMenuItem;
- Compile1: TMenuItem;
- Link1: TMenuItem;
- N4: TMenuItem;
- Options1: TMenuItem;
- AddFileDlg: TOpenDialog;
- N5: TMenuItem;
- Preferences1: TMenuItem;
- N6: TMenuItem;
- HeaderFile1: TMenuItem;
- SourceFilePopup: TPopupMenu;
- Compile2: TMenuItem;
- N7: TMenuItem;
- Remove1: TMenuItem;
- Delete2: TMenuItem;
- Splitter2: TSplitter;
- ErrWinPanel: TPanel;
- ErrorList: TListView;
- Save2: TMenuItem;
- SaveAs2: TMenuItem;
- N8: TMenuItem;
- MainMenuHelp: TMenuItem;
- Build1: TMenuItem;
- N9: TMenuItem;
- SelectAll1: TMenuItem;
- OpenProjectDlg: TOpenDialog;
- SaveProjectDlg: TSaveDialog;
- N10: TMenuItem;
- About1: TMenuItem;
- StatusBar: TStatusBar;
- ToolBarImages: TImageList;
- FileNewPopup: TPopupMenu;
- HeaderFile2: TMenuItem;
- Actions: TActionList;
- ActionFileNewProject: TAction;
- ActionFileNewCHeaderFile: TAction;
- ActionFileNewGNUAsmHeaderFile: TAction;
- ActionFileNewA68kAsmHeaderFile: TAction;
- ActionFileNewCFile: TAction;
- ActionFileNewGNUAsmFile: TAction;
- ActionFileNewA68kAsmFile: TAction;
- ActionFileOpen: TAction;
- ActionFileSave: TAction;
- ActionFileSaveAs: TAction;
- ActionFilePreferences: TAction;
- ActionFileExit: TAction;
- ActionEditUndo: TAction;
- ActionEditDelete: TAction;
- ActionEditCut: TAction;
- ActionEditCopy: TAction;
- ActionEditPaste: TAction;
- ActionEditSelectAll: TAction;
- ActionProjectAddFiles: TAction;
- ActionProjectCompile: TAction;
- ActionProjectMake: TAction;
- ActionProjectBuild: TAction;
- ActionProjectOptions: TAction;
- ActionHelpDocumentation: TAction;
- ActionHelpAbout: TAction;
- ActionTreeItemSave: TAction;
- ActionTreeItemSaveAs: TAction;
- ActionTreeItemCompile: TAction;
- ActionTreeItemRemove: TAction;
- ActionTreeItemDelete: TAction;
- CSourceFile2: TMenuItem;
- AssemblerSourceFile1: TMenuItem;
- Project3: TMenuItem;
- N11: TMenuItem;
- ActionProjectShowErrors: TAction;
- ErrorsandWarnings1: TMenuItem;
- N12: TMenuItem;
- MainMenuFind: TMenuItem;
- ActionFindFind: TAction;
- ActionFindReplace: TAction;
- ActionFindOpenFile: TAction;
- Find2: TMenuItem;
- Replace1: TMenuItem;
- OpenFileAtCursor1: TMenuItem;
- N13: TMenuItem;
- FindDlg: TFindDialog;
- ReplaceDlg: TReplaceDialog;
- ToolBarImagesDisabled: TImageList;
- PrintDlg: TPrintDialog;
- ActionFilePrint: TAction;
- Print1: TMenuItem;
- N14: TMenuItem;
- ActionFilePrintQuickly: TAction;
- ErrorListIcons: TImageList;
- DocFile: THTMLHelp;
- ActionHelpContents: TAction;
- ActionHelpIndex: TAction;
- ActionHelpSearch: TAction;
- ActionTreeItemRename: TAction;
- N19: TMenuItem;
- Rename1: TMenuItem;
- Contents1: TMenuItem;
- Index1: TMenuItem;
- Search1: TMenuItem;
- EditorPopup: TPopupMenu;
- Undo2: TMenuItem;
- N16: TMenuItem;
- Clear1: TMenuItem;
- Cut2: TMenuItem;
- Copy2: TMenuItem;
- Paste2: TMenuItem;
- N17: TMenuItem;
- SelectAll2: TMenuItem;
- MainToolBar: TToolBar;
- ToolBarNewButton: TToolButton;
- ToolButton2: TToolButton;
- ToolButton3: TToolButton;
- ToolButton4: TToolButton;
- ToolButton23: TToolButton;
- ToolButton24: TToolButton;
- ToolButton6: TToolButton;
- ToolButton7: TToolButton;
- ToolButton8: TToolButton;
- ToolButton9: TToolButton;
- ToolButton10: TToolButton;
- ToolButton5: TToolButton;
- ToolButton11: TToolButton;
- ToolButton20: TToolButton;
- ToolButton21: TToolButton;
- ToolBarCompileLine1: TToolButton;
- ToolBarCompileButton: TToolButton;
- ToolButton15: TToolButton;
- ToolBarCompileLine2: TToolButton;
- ToolButton18: TToolButton;
- ToolButton19: TToolButton;
- ActionEditRedo: TAction;
- Redo1: TMenuItem;
- Redo2: TMenuItem;
- EditorPanel: TPanel;
- NoEditor: TPanel;
- FunctionPopup: TPopupMenu;
- ActionFindFunctions: TAction;
- N15: TMenuItem;
- Functions1: TMenuItem;
- ToolButton25: TToolButton;
- NoFunctionsItem: TMenuItem;
- ActionFileNewTextFile: TAction;
- TextFile1: TMenuItem;
- TextFile2: TMenuItem;
- ActionEditIncreaseIndent: TAction;
- ActionEditDecreaseIndent: TAction;
- N18: TMenuItem;
- IncreaseIndent1: TMenuItem;
- DecreaseIndent1: TMenuItem;
- N20: TMenuItem;
- IncreaseIndent2: TMenuItem;
- DecreaseIndent2: TMenuItem;
- N21: TMenuItem;
- OpenFileatCursor2: TMenuItem;
- GNUAssemblySourceFile1: TMenuItem;
- GNUAssemblySourceFile2: TMenuItem;
- ActionFileNewQuillFile: TAction;
- QuillSourceFile1: TMenuItem;
- QuillSourceFile2: TMenuItem;
- ActionProjectStopCompilation: TAction;
- ActionProjectForceQuitCompiler: TAction;
- ToolButton16: TToolButton;
- ToolButton17: TToolButton;
- StopCompilation1: TMenuItem;
- ForceQuitCompiler1: TMenuItem;
- ActionHelpNews: TAction;
- N3: TMenuItem;
- News1: TMenuItem;
- ActionDebugRun: TAction;
- ActionDebugPause: TAction;
- ActionDebugReset: TAction;
- MainMenuDebug: TMenuItem;
- Run1: TMenuItem;
- N22: TMenuItem;
- Pause1: TMenuItem;
- Reset1: TMenuItem;
- ToolBarRunButton: TToolButton;
- ToolBarDebugLine: TToolButton;
- ToolBarPauseButton: TToolButton;
- ToolButton12: TToolButton;
- ToolButton13: TToolButton;
- ChangeNotificationTimer: TTimer;
- ToolBarBevel: TBevel;
- ToolBarEndLine: TToolButton;
- RecentFilesLine: TMenuItem;
- RecentFilesPopup: TPopupMenu;
- NoFilesItem: TMenuItem;
- ActionToolsConfigure: TAction;
- MainMenuTools: TMenuItem;
- Configure1: TMenuItem;
- ToolsLine: TMenuItem;
- ActionProjectShowProgramOutput: TAction;
- ProgramOutput1: TMenuItem;
- ActionFileNewFolder: TAction;
- N23: TMenuItem;
- Folder1: TMenuItem;
- N24: TMenuItem;
- Folder2: TMenuItem;
- FolderPopup: TPopupMenu;
- MenuItem6: TMenuItem;
- MenuItem9: TMenuItem;
- CategoryPopup: TPopupMenu;
- ActionFileNewFile: TAction;
- File1: TMenuItem;
- Folder3: TMenuItem;
- N25: TMenuItem;
- Folder4: TMenuItem;
- File2: TMenuItem;
- ActionTreeItemNewFolder: TAction;
- ActionTreeItemNewFile: TAction;
- GNUAssemblyHeaderFile1: TMenuItem;
- GNUAssemblyHeaderFile2: TMenuItem;
- A68kAssemblyHeaderFile1: TMenuItem;
- A68kAssemblyHeaderFile2: TMenuItem;
- ErrorPanel: TPanel;
- CloseErrorsButton: TSpeedButton;
- Label1: TLabel;
- Label2: TLabel;
- ErrorsLabel: TLabel;
- WarningsLabel: TLabel;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure AppException(Sender: TObject; E: Exception);
- procedure ProjectTreeEditing(Sender: TObject; Node: TTreeNode;
- var AllowEdit: Boolean);
- procedure ProjectAddFiles(Sender: TObject);
- procedure ProjectTreeChange(Sender: TObject; Node: TTreeNode);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure ProjectTreeDeletion(Sender: TObject; Node: TTreeNode);
- procedure FileExit(Sender: TObject);
- procedure FileNewProject(Sender: TObject);
- procedure TreeItemRemove(Sender: TObject);
- procedure TreeItemDelete(Sender: TObject);
- procedure TreeItemCompile(Sender: TObject);
- procedure CloseErrorsButtonClick(Sender: TObject);
- procedure ErrorListDeletion(Sender: TObject; Item: TListItem);
- procedure TreeItemSave(Sender: TObject);
- procedure HelpDocumentation(Sender: TObject);
- procedure EditorEnter(Sender: TObject);
- procedure EditorExit(Sender: TObject);
- procedure EditUndo(Sender: TObject);
- procedure EditRedo(Sender: TObject);
- procedure EditClear(Sender: TObject);
- procedure EditCut(Sender: TObject);
- procedure EditCopy(Sender: TObject);
- procedure EditPaste(Sender: TObject);
- procedure EditSelectAll(Sender: TObject);
- procedure ProjectCompile(Sender: TObject);
- procedure ProjectMake(Sender: TObject);
- procedure FileOpenProject(Sender: TObject);
- procedure FileSaveAll(Sender: TObject);
- procedure FileSaveProjectAs(Sender: TObject);
- procedure EditorKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure ProjectBuild(Sender: TObject);
- procedure ProjectTreeKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure ProjectTreeMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure ProjectTreeEdited(Sender: TObject; Node: TTreeNode;
- var S: String);
- procedure ProjectOptions(Sender: TObject);
- procedure FilePreferences(Sender: TObject);
- procedure FileNewHeaderFile(Sender: TObject);
- procedure FileNewCSourceFile(Sender: TObject);
- procedure FileNewGNUAssemblerSourceFile(Sender: TObject);
- procedure FileNewAssemblerSourceFile(Sender: TObject);
- procedure FileNewQuillSourceFile(Sender: TObject);
- procedure FileNewTextFile(Sender: TObject);
- procedure TreeItemSaveAs(Sender: TObject);
- procedure HelpAbout(Sender: TObject);
- procedure DisplayHint(Sender: TObject);
- procedure ShowHideErrors(Sender: TObject);
- procedure FindString(Sender: TObject; AllFiles: Boolean);
- procedure ReplaceDlgReplace(Sender: TObject);
- procedure FindText(Sender: TObject);
- procedure ReplaceText(Sender: TObject);
- procedure FindOpenFile(Sender: TObject);
- procedure FindDlgFind(Sender: TObject);
- procedure ActionsExecute(Action: TBasicAction; var Handled: Boolean);
- procedure ProjectTreeEnter(Sender: TObject);
- procedure ProjectTreeExit(Sender: TObject);
- procedure ProjectTreeChanging(Sender: TObject; Node: TTreeNode;
- var AllowChange: Boolean);
- procedure EditorChange(Sender: TObject);
- procedure FilePrint(Sender: TObject);
- procedure FilePrintQuickly(Sender: TObject);
- procedure TreeItemRename(Sender: TObject);
- procedure HelpContents(Sender: TObject);
- procedure HelpIndex(Sender: TObject);
- procedure HelpSearch(Sender: TObject);
- procedure SplitterMoved(Sender: TObject);
- procedure ProjectTreeMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure ToolBarManagerBandMove(Sender: TObject; Control: TControl;
- var ARect: TRect);
- procedure ProjectTreeDragOver(Sender, Source: TObject; X, Y: Integer;
- State: TDragState; var Accept: Boolean);
- procedure ProjectTreeDragDrop(Sender, Source: TObject; X, Y: Integer);
- procedure ErrorListClick(Sender: TObject);
- procedure DeleteError(Sender: TObject);
- procedure FunctionPopupPopup(Sender: TObject);
- procedure FindFunctions(Sender: TObject);
- procedure FindFunctionFromPopup(Sender: TObject);
- procedure IncreaseIndent(Sender: TObject);
- procedure DecreaseIndent(Sender: TObject);
- procedure ProjectStopCompilation(Sender: TObject);
- procedure ProjectForceQuitCompiler(Sender: TObject);
- procedure HelpNews(Sender: TObject);
- procedure DebugRun(Sender: TObject);
- procedure DebugPause(Sender: TObject);
- procedure DebugReset(Sender: TObject);
- procedure FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure ChangeNotificationTick(Sender: TObject);
- procedure RecentFileClick(Sender: TObject);
- procedure ToolsConfigure(Sender: TObject);
- procedure ToolClick(Sender: TObject);
- procedure ProjectTreeStartDrag(Sender: TObject;
- var DragObject: TDragObject);
- procedure ShowProgramOutput(Sender: TObject);
- procedure FileNewFolder(Sender: TObject);
- procedure FileNewFile(Sender: TObject);
- procedure ErrorListKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- private
- EditorToHide: TWinControl;
- TempLockHandle: THandle;
- FModified: Boolean;
- FInvalidated: Boolean;
- FProjectFile: string;
- InChangeNotification: Boolean;
- procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;
- procedure SetProjectFile(const Value: string);
- procedure SetModified(const Value: Boolean);
- function GetCurrentEditor: TMemoComponent;
- function GetInvalidated: Boolean;
- public
- TopNode: TTreeNode;
- OriginalCaption: string;
- LinkLibHandle: HModule;
- LinkLibGetInterfaceVersion: TLinkLibGetInterfaceVersion;
- LinkLibLinkFiles: TLinkLibLinkFiles;
- LinkLibCreateArchive: TLinkLibCreateArchive;
- SourceFiles: TSourceFiles;
- JumpToError,
- OpenFolderMessage,
- AutoSave,
- DeleteErrors,
- StartingAppNow,
- OpeningProjectNow,
- NoHideEditor: Boolean;
- PreviousNode: TTreeNode;
- SyntaxCBackup: TSyntaxColoring;
- SyntaxAsmGNUBackup: TSyntaxColoring;
- SyntaxAsmBackup: TSyntaxColoring;
- SyntaxQuillBackup: TSyntaxColoring;
- Closing: Boolean;
- ProgSize: Integer;
- OptimizeInfo: TLinkLibOptimizeInfo;
- Funcs: TSourceFileFunctions;
- CurrentStrings: TMemoryStream;
- CurVTIType: TCurVTIType;
- RecentFiles: TStringList;
- ToolsList: TToolsList;
- property ProjectFile: string read FProjectFile write SetProjectFile;
- property Modified: Boolean read FModified write SetModified;
- property Invalidated: Boolean read GetInvalidated write FInvalidated;
- property CurrentEditor: TMemoComponent read GetCurrentEditor;
- procedure Modify;
- procedure WarnIfModified;
- procedure FileNew;
- procedure FileClear;
- procedure FileLoad;
- procedure FileOpen(const FN: string);
- procedure FileSave;
- procedure FileSaveAs(const FN: string);
- procedure ResetProjectSettings;
- procedure AppCompStartFile;
- procedure AppCompStop;
- procedure AppCompSetMessage(const Msg: string);
- procedure AppCompUpdate;
- procedure UpdateProgramOutput;
- procedure CopyHeaders;
- procedure DeleteHeaders;
- procedure ClearErrors;
- procedure HideErrors;
- procedure ShowErrors;
- procedure UpdateErrorWindow;
- procedure AddError(const Line: string; BugTp: TBugType; SourceF: string; ErrFunc: string; ErrMessage: string; SourceLn: Integer; Offset: Integer);
- procedure CompileProject;
- procedure MakeFileWrapped;
- procedure MakeFile;
- function AddSourceFile(const FN: string; OpenOnly: Boolean = False; SourceFileClass: TSourceFileClass = nil; Folder: TFolder = nil): TSourceFile;
- function GetNewFileName(const FolderPath, Ext: string): string;
- procedure LoadPreferences;
- procedure SavePreferences;
- procedure BeginCompilation;
- procedure EndCompilation;
- procedure RecompileFiles;
- procedure UpdateEditButtons;
- procedure UpdateStatusBar;
- procedure UpdateFuncs;
- procedure UpdateDebugSettings;
- procedure SortFiles;
- procedure DisplayFolderMessage;
- procedure ClearDebugInfo;
- function GetVTIWindow: HWnd;
- procedure SendFiles(FNList: array of string);
- procedure ExecuteCommandLine(const Line: string);
- procedure SelectNode(Node: TTreeNode);
- procedure AddToRecent(const FileName: string);
- procedure UpdateRecent;
- procedure AddTool(const Title, CommandLine, WorkingDir: string; WindowState: TWindowState);
- function GetSourceTypeFolder(Node: TTreeNode): TTreeNode;
- function FindFileInsertionPoint(ParentNode: TTreeNode): TTreeNode;
- function CreateFileNode(ParentNode: TTreeNode; SourceFile: TSourceFile): TTreeNode;
- function GetSelectedFolder(SourceClass: TSourceFileClass): TFolder;
- {$IFDEF CODINGEXT}
- procedure InitCodingExt;
- procedure ActionFindSymbolExecute(Sender: TObject);
- {$ENDIF}
- end;
- var
- MainForm: TMainForm;
- type
- TRecentFileMenuItem = class(TObject)
- FileMenuItem: TMenuItem;
- PopupMenuItem: TMenuItem;
- public
- destructor Destroy; override;
- end;
- const
- MaxRecentFiles = 4;
- type
- TNoImageDragObject = class(TDragControlObject)
- public
- function GetDragImages: TDragImageList; override;
- procedure HideDragImage; override;
- procedure ShowDragImage; override;
- end;
- procedure LinkLibError(FileName, Text: PChar; MessageType: LongInt); cdecl;
- function LinkLibGetOutputFile(var DestFile: TLinkLibDestFile; FileSize, DestCalc, FileRole, FileFormat, FileType: LongInt; Extension: PChar; Executable: WordBool; var EffectiveSize: LongInt): WordBool; cdecl;
- implementation
- {$R *.DFM}
- {$R WindowsXP.res}
- uses
- CalcUnit, ParsingUnit, ProcessUnit,
- StartupScreenUnit, PreferencesUnit, ProjectOptionsUnit,
- AboutUnit, SourceFileWinUnit, FunctionsWinUnit,
- OpenFileStatusUnit, NewsUnit, SendProgressUnit, ToolsUnit,
- ProgramOutputUnit, VTIStartUnit,
- LinkUnit,
- UtilsDos, UtilsWin, HandleWaitThreadUnit, FileReadToBufferThreadUnit,
- ShellAPI, ShlObj, IniFiles, Registry, WinSpool, ClipBrd{$IFDEF CODINGEXT}, CompletionForm{$ENDIF},
- ProgramOptionsUnit;
- const
- RegKey = '\Software\SeReSoft\TI-GCC IDE';
- type
- TFileRole = (frMain, frData);
- TLinkOutputFile = record
- Data: TMemoryStream;
- Tag: Byte;
- VarExt: string;
- ExeFile,
- OSUpgrade: Boolean;
- end;
- var
- ProcID: Cardinal;
- SendWin: HWnd;
- LinkOutputFiles: array [TCalcDest, TFileRole] of TLinkOutputFile;
- LinkDebugFile: TLinkOutputFile;
- function EnumWindowsFunc(Win: HWnd; Param: Integer): Bool; stdcall;
- var
- Name: array [0..32] of Char;
- NewProcID: DWord;
- begin
- Result := True;
- GetWindowThreadProcessID (Win, @NewProcID);
- if NewProcID = ProcID then begin
- GetClassName (Win, Name, 32);
- if Name = '#32770' then begin
- Result := False;
- SendWin := Win;
- end;
- end;
- end;
- procedure ErrorMessage(const Msg: string);
- begin
- if UpperCase (Copy (Msg, 1, Length ('ERROR:'))) = 'ERROR:' then
- MainForm.AddError (Msg, btError, '', '', Trim (Copy (Msg, Length ('ERROR:') + 1, Length (Msg))), 0, 0)
- else if UpperCase (Copy (Msg, 1, Length ('WARNING:'))) = 'WARNING:' then
- MainForm.AddError (Msg, btWarning, '', '', Trim (Copy (Msg, Length ('WARNING:') + 1, Length (Msg))), 0, 0);
- end;
- procedure LinkLibError(FileName, Text: PChar; MessageType: LongInt); cdecl;
- var
- BugTp: TBugType;
- ErrorLine: string;
- begin
- if MessageType = llmtError then
- BugTp := btError
- else
- BugTp := btWarning;
- ErrorLine := StringReplace (StrPas (Text), '`', '''', [rfReplaceAll]);
- MainForm.AddError (ErrorLine, BugTp, FileName, '', ErrorLine, 0, 0);
- end;
- function LinkLibGetOutputFile(var DestFile: TLinkLibDestFile; FileSize, DestCalc, FileRole, FileFormat, FileType: LongInt; Extension: PChar; Executable: WordBool; var EffectiveSize: LongInt): WordBool; cdecl;
- var
- CalcDest: TCalcDest;
- CalcFileRole: TFileRole;
- begin
- Result := False;
- case FileFormat of
- llffTIOS:
- EffectiveSize := 2 + FileSize + 1;
- llffTIOSUpgrade:
- EffectiveSize := FileSize + SizeOf (TCalcOSFooter);
- llffGDBCOFF:
- begin
- EffectiveSize := FileSize;
- with LinkDebugFile do begin
- if not Assigned (Data) then
- Data := TMemoryStream.Create;
- Data.Size := FileSize;
- DestFile.Data := Data.Memory;
- end;
- Result := True;
- Exit;
- end;
- else
- Exit;
- end;
- case DestCalc of
- llcdTI89: CalcDest := cdTI89;
- llcdTI89 or llcdFlagTitanium: CalcDest := cdTI89Titanium;
- llcdTI92Plus: CalcDest := cdTI92Plus;
- llcdV200: CalcDest := cdV200;
- llcdTI92: CalcDest := cdTI92;
- else
- Exit;
- end;
- case FileRole of
- llfrMain: CalcFileRole := frMain;
- llfrData: CalcFileRole := frData;
- else
- Exit;
- end;
- with LinkOutputFiles [CalcDest, CalcFileRole] do begin
- if not Assigned (Data) then
- Data := TMemoryStream.Create;
- Data.Size := FileSize;
- DestFile.Data := Data.Memory;
- Tag := FileType;
- if Assigned (Extension) then begin
- VarExt := Extension;
- Inc (EffectiveSize, Length (VarExt) + 2);
- end else
- VarExt := '';
- ExeFile := Executable;
- OSUpgrade := (FileFormat = llffTIOSUpgrade);
- end;
- Result := True;
- end;
- { Fix for TPanel & XP Theme }
- procedure TPanel.Paint;
- begin
- Canvas.Pen.Style := psClear;
- Canvas.Brush.Color := Color;
- Canvas.FillRect(GetClientRect);
- inherited;
- end;
- { TRecentFileMenuItem }
- destructor TRecentFileMenuItem.Destroy;
- begin
- FileMenuItem.Free;
- PopupMenuItem.Free;
- inherited;
- end;
- { TNoImageDragObject }
- function TNoImageDragObject.GetDragImages: TDragImageList;
- begin
- Result := nil;
- end;
- procedure TNoImageDragObject.HideDragImage;
- begin
- end;
- procedure TNoImageDragObject.ShowDragImage;
- begin
- end;
- { TMainForm }
- procedure TMainForm.Modify;
- begin
- Modified := True;
- end;
- procedure TMainForm.FormCreate(Sender: TObject);
- var
- TempDir: array [0..255] of Char;
- S: string;
- TempLockData: TWin32FindData;
- begin
- StartingAppNow := True;
- try
- if Assigned (StartupScreenForm) then
- StartupScreenForm.DisplayText := 'Setting Up Environment...';
- Application.OnException := AppException;
- WindowState := wsMaximized;
- RecentFiles := TStringList.Create;
- ToolsList := TToolsList.Create (Self, TToolsListItem);
- TIGCCFolder := ExtractFilePath (ParamStr (0));
- Delete (TIGCCFolder, Pos (UpperCase (IDELocation), UpperCase (TIGCCFolder)), Length (TIGCCFolder));
- with TRegistry.Create do try
- RootKey := HKey_Local_Machine;
- if OpenKeyReadOnly ('\Software\TIGCC Team\TIGCC') then try
- if ValueExists ('Program Folder') then
- TIGCCFolder := ReadString ('Program Folder');
- except end;
- finally
- Free;
- end;
- try
- if FileExists (WithBackslash (TIGCCFolder) + A68kLocation + 'A68k.exe') then
- Include (SpecialSupport, ssA68k);
- except end;
- try
- if FileExists (WithBackslash (TIGCCFolder) + QuillIncludeLocation + 'Quill.drv')
- or FileExists (WithBackslash (TIGCCFolder) + CIncludeLocation + 'Quill.drv')
- or FileExists (WithBackslash (TIGCCFolder) + GCCLocation + 'Quill.drv') then
- Include (SpecialSupport, ssQuill);
- except end;
- try
- if FileExists (WithBackslash (TIGCCFolder) + PackLocation + 'Pack.exe') then
- Include (SpecialSupport, ssPack);
- except end;
- try
- if FileExists (WithBackslash (TIGCCFolder) + StdLibLocation + 'flashos.a') then
- Include (SpecialSupport, ssFlashOS);
- except end;
- try
- if FileExists (WithBackslash (TIGCCFolder) + StdLibLocation + 'fargo.a') then
- Include (SpecialSupport, ssFargo);
- except end;
- CompStartFile := AppCompStartFile;
- CompStop := AppCompStop;
- CompSetMessage := AppCompSetMessage;
- CompUpdate := AppCompUpdate;
- CompUpdateProgramOutput := UpdateProgramOutput;
- LinkLibHandle := LoadLibrary (PChar (WithBackslash (TIGCCFolder) + LinkLibLocation + 'Link.dll'));
- if LinkLibHandle <> 0 then begin
- LinkLibGetInterfaceVersion := GetProcAddress (LinkLibHandle, 'GetInterfaceVersion');
- if Assigned (LinkLibGetInterfaceVersion) and (LinkLibGetInterfaceVersion = LinkLibCurInterfaceVersion) then begin
- LinkLibLinkFiles := GetProcAddress (LinkLibHandle, 'LinkFiles');
- LinkLibCreateArchive := GetProcAddress (LinkLibHandle, 'CreateArchive');
- end;
- end;
- SourceFiles := TSourceFiles.Create;
- SyntaxCBackup := TSyntaxColoring.Create (nil);
- SyntaxCBackup.Assign (SyntaxC);
- SyntaxAsmGNUBackup := TSyntaxColoring.Create (nil);
- SyntaxAsmGNUBackup.Assign (SyntaxAsmGNU);
- SyntaxAsmBackup := TSyntaxColoring.Create (nil);
- if ssA68k in SpecialSupport then
- SyntaxAsmBackup.Assign (SyntaxAsm);
- SyntaxQuillBackup := TSyntaxColoring.Create (nil);
- if ssQuill in SpecialSupport then
- SyntaxQuillBackup.Assign (SyntaxQuill);
- TopNode := ProjectTree.Items.Item [0];
- SourceFileUnit.AppNode := TopNode;
- SourceFileUnit.NoEditor := NoEditor;
- OriginalCaption := Caption;
- Application.OnHint := DisplayHint;
- if ssA68k in SpecialSupport then begin
- ActionFileNewA68kAsmHeaderFile.Visible := True;
- ActionFileNewA68kAsmFile.Visible := True;
- with ProjectTree.Items.Insert (TopNode.Item [TAsmSourceFile.GetClassTreeIndex], 'A68k Assembly Files') do begin
- ImageIndex := TopNode.Item[0].ImageIndex;
- SelectedIndex := TopNode.Item[0].SelectedIndex;
- end;
- end;
- if ssQuill in SpecialSupport then begin
- ActionFileNewQuillFile.Visible := True;
- S := OpenProjectDlg.Filter;
- Insert (TQuillSourceFile.GetClassFilter + '|', S, Pos (TNormalTextSourceFile.GetClassFilter, S));
- while Pos ('*.asm;*.txt', S) > 0 do
- Insert (';*.qll', S, Pos ('*.asm;*.txt', S) + Length ('*.asm'));
- OpenProjectDlg.Filter := S;
- OpenProjectDlg.FilterIndex := OpenProjectDlg.FilterIndex + 1;
- S := AddFileDlg.Filter;
- Insert (TQuillSourceFile.GetClassFilter + '|', S, Pos (TObjectSourceFile.GetClassFilter, S));
- while Pos ('*.asm;*.o', S) > 0 do
- Insert (';*.qll', S, Pos ('*.asm;*.o', S) + Length ('*.asm'));
- AddFileDlg.Filter := S;
- AddFileDlg.FilterIndex := AddFileDlg.FilterIndex + 1;
- with ProjectTree.Items.Insert (TopNode.Item [TQuillSourceFile.GetClassTreeIndex], 'Quill Files') do begin
- ImageIndex := TopNode.Item[0].ImageIndex;
- SelectedIndex := TopNode.Item[0].SelectedIndex;
- end;
- end;
- ProjectTree.FullExpand;
- ResetProjectSettings;
- AssumeUndefined := False;
- AutoSave := True;
- AutoNews := False;
- LastNewsDate := 0;
- GetTempPath (SizeOf (TempDir), TempDir);
- Temp := AnsiString (TempDir);
- if (Length (Temp) <= 0) or (not DirExists (Temp)) then begin
- GetEnvironmentVariable ('TMP', TempDir, SizeOf (TempDir));
- Temp := AnsiString (TempDir);
- end;
- if (Length (Temp) <= 0) or (not DirExists (Temp)) then begin
- GetEnvironmentVariable ('TEMP', TempDir, SizeOf (TempDir));
- Temp := AnsiString (TempDir);
- end;
- if (Length (Temp) <= 0) or (Length (Temp) > 30) or (Pos (' ', Temp) > 0) or (Pos ('TEMP', UpperCase (Temp)) <= 0) then begin
- GetWindowsDirectory (TempDir, SizeOf (TempDir));
- Temp := WithBackslash (AnsiString (TempDir)) + 'TEMP\';
- if not DirExists (Temp) then try
- MkDir (Temp);
- except end;
- end;
- if (Length (Temp) <= 0) or (Length (Temp) > 30) or (Pos (' ', Temp) > 0) then begin
- Temp := 'C:\TEMP\';
- if not DirExists (Temp) then try
- MkDir (Temp);
- except end;
- end;
- Temp := WithBackslash (Temp) + IntToHex (GetCurrentProcessID, 8) + '\';
- if not DirExists (Temp) then try
- MkDir (Temp);
- except end;
- TempLockHandle := Windows.FindFirstFile (PChar (Temp + '*.*'), TempLockData);
- StopOnErrors := False;
- JumpToError := True;
- OpenFolderMessage := True;
- DeleteAssemblyFiles := True;
- DeleteObjectFiles := False;
- {$IFDEF CanSplit}
- SplitFiles := True;
- {$ENDIF}
- DeleteErrors := True;
- TransferTarget := ttVTI;
- LinkPort.PortType := lpCOM;
- LinkPort.PortNumber := 1;
- LinkCable := lcBlack;
- TabSizeAsm := 8;
- TabSizeC := 2;
- AutoBlocks := True;
- EditorOnFly := True;
- EditorDragDrop := True;
- if Assigned (StartupScreenForm) then
- StartupScreenForm.DisplayText := 'Loading Preferences...';
- try
- LoadPreferences;
- except
- ShowDefaultMessageBox ('An error occured while loading the preferences. Some parts of the program may not be configured correctly.', 'Error', mtProgramError);
- end;
- DocFile.FileName := WithBackslash (TIGCCFolder) + DocLocation + 'TIGCC.chm';
- if DirExists (WithBackslash (TIGCCFolder) + ProjectsLocation) then
- OpenProjectDlg.InitialDir := WithBackslash (TIGCCFolder) + ProjectsLocation
- else
- OpenProjectDlg.InitialDir := TIGCCFolder;
- SaveProjectDlg.InitialDir := OpenProjectDlg.InitialDir;
- AddFileDlg.InitialDir := OpenProjectDlg.InitialDir;
- DragAcceptFiles (Handle, True);
- ParsingUnit.ErrorMessageProc := ErrorMessage;
- S := '';
- if ParamCount > 0 then begin
- if LowerCase (ExtractFileExt (ParamStr (1))) = LowerCase (ProjectFileExt) then
- ProjectFile := ExpandFileName (ParamStr (1))
- else
- S := ExpandFileName (ParamStr (1));
- end;
- if Length (ProjectFile) > 0 then begin
- if Assigned (StartupScreenForm) then
- StartupScreenForm.DisplayText := 'Opening Project...';
- FileLoad;
- end;
- if Length (S) > 0 then
- AddSourceFile (S, True);
- if AutoNews then begin
- if Assigned (StartupScreenForm) then
- StartupScreenForm.DisplayText := 'Downloading Headlines...';
- with TNewsForm.Create (Self) do begin
- SilentConnect := True;
- Connect;
- end;
- end;
- except
- ShowDefaultMessageBox ('An error occured while setting up the application. Some parts of the program may not be configured correctly.', 'Error', mtProgramError);
- end;
- StartingAppNow := False;
- {$IFDEF CODINGEXT}
- InitCodingExt;
- {$ENDIF}
- end;
- procedure TMainForm.FormDestroy(Sender: TObject);
- var
- I: Integer;
- begin
- Closing := True;
- ClearDebugInfo;
- ErrorList.Items.Clear;
- SourceFiles.Free;
- SyntaxQuillBackup.Free;
- SyntaxAsmBackup.Free;
- SyntaxAsmGNUBackup.Free;
- SyntaxCBackup.Free;
- if LinkLibHandle <> 0 then
- FreeLibrary (LinkLibHandle);
- if TempLockHandle <> INVALID_HANDLE_VALUE then
- Windows.FindClose (TempLockHandle);
- try
- RmDir (Temp);
- except end;
- ToolsList.Free;
- with RecentFiles do begin
- for I := Count - 1 downto 0 do
- Objects[I].Free;
- Free;
- end;
- end;
- procedure TMainForm.AppException(Sender: TObject; E: Exception);
- begin
- if not (E is ESocketError) then
- ShowDefaultMessageBox ('Internal Error: Exception ' + E.ClassName + ', Message "' + E.Message + '"'#13#10#13#10'Please fill out a bug report form at http://tigcc.ticalc.org/.', 'Internal Error', mtProgramError);
- end;
- procedure TMainForm.ProjectTreeEditing(Sender: TObject; Node: TTreeNode;
- var AllowEdit: Boolean);
- begin
- AllowEdit := Assigned (Node.Data) or not Assigned (Node.Parent);
- end;
- procedure TMainForm.ProjectAddFiles(Sender: TObject);
- var
- I: Integer;
- F: TSourceFile;
- begin
- if AddFileDlg.Execute then begin
- for I := AddFileDlg.Files.Count - 1 downto 0 do begin
- F := AddSourceFile(ExpandFileName(AddFileDlg.Files[I]));
- if (I = 0) and Assigned (F) and Assigned (F.TreeItem) then
- SelectNode (F.TreeItem);
- end;
- Modify;
- end else
- Abort;
- end;
- procedure TMainForm.ProjectTreeChange(Sender: TObject; Node: TTreeNode);
- var
- NewSelection: TTreeNode;
- NewEditor: TWinControl;
- IsMemo,
- DataItem,
- BinaryType: Boolean;
- begin
- NewSelection := ProjectTree.Selected;
- PreviousNode := NewSelection;
- if not Closing then begin
- if Assigned (NewSelection) and Assigned (NewSelection.Data) and (TObject (NewSelection.Data) is TSourceFile) then
- NewEditor := TSourceFile(NewSelection.Data).Editor
- else
- NewEditor := NoEditor;
- if Assigned (EditorToHide) and (EditorToHide <> NewEditor) then
- EditorToHide.Align := alNone;
- if NewEditor.Parent <> EditorPanel then
- NewEditor.Parent := EditorPanel;
- if NewEditor.Align <> alClient then
- NewEditor.Align := alClient;
- IsMemo := NewEditor is TMemoComponent;
- if IsMemo then begin
- with TMemoComponent (NewEditor) do begin
- DrawingSuspended := True;
- OnEnter := EditorEnter;
- OnExit := EditorExit;
- OnKeyDown := EditorKeyDown;
- OnChange := EditorChange;
- OnSelectionChange := EditorChange;
- PopupMenu := EditorPopup;
- end;
- end;
- NewEditor.Show;
- Update;
- if IsMemo then
- with TMemoComponent (NewEditor) do begin
- DrawingSuspended := False;
- Repaint;
- end;
- if Assigned (EditorToHide) and (EditorToHide <> NewEditor) then
- EditorToHide.Hide;
- EditorToHide := nil;
- DataItem := Assigned (NewSelection) and Assigned (NewSelection.Data);
- Node := GetSourceTypeFolder (NewSelection);
- BinaryType := Assigned (Node) and ((Node.Index = TObjectSourceFile.GetClassTreeIndex) or (Node.Index = TArchiveSourceFile.GetClassTreeIndex) or (Node.Index = TOtherSourceFile.GetClassTreeIndex));
- ActionFileNewFolder.Enabled := Assigned (NewSelection) and Assigned (NewSelection.Parent);
- ActionTreeItemNewFolder.Enabled := ActionFileNewFolder.Enabled;
- ActionFileNewFile.Enabled := ActionFileNewFolder.Enabled and (not BinaryType);
- ActionTreeItemNewFile.Enabled := ActionFileNewFile.Enabled;
- if ActiveControl = ProjectTree then
- ActionEditDelete.Enabled := DataItem;
- ActionFilePrint.Enabled := DataItem and (TObject (NewSelection.Data) is TSourceFile) and TSourceFile(NewSelection.Data).Printable and (Printer.Printers.Count > 0);
- ActionFilePrintQuickly.Enabled := ActionFilePrint.Enabled;
- ActionFindFunctions.Enabled := DataItem and (TObject (NewSelection.Data) is TSourceTextSourceFile);
- UpdateStatusBar;
- end;
- end;
- procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- begin
- if Compiling then
- CanClose := False
- else
- try
- WarnIfModified;
- SavePreferences;
- except
- CanClose := False;
- end;
- end;
- procedure TMainForm.WarnIfModified;
- var
- I: Integer;
- begin
- if Modified then
- case ShowDefaultMessageBox
- ('The current project has been modified. Do you want to save the changes?',
- 'Project Modified', mtQuestion, True) of
- idYes: FileSave;
- idCancel: Abort;
- end;
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- WarnIfModified;
- end;
- procedure TMainForm.FileLoad;
- function StringToRelocFormat(const S: string): TRelocFormat;
- begin
- if S = 'None' then
- Result := rfNone
- else if S = 'Direct' then
- Result := rfDirect
- else if S = 'AMS' then
- Result := rfAMS
- else if S = 'Kernel' then
- Result := rfKernel
- else if S = 'Compressed' then
- Result := rfCompressed
- else if S = 'MLink' then
- Result := rfMLink
- else if S = 'F-Line' then
- Result := rfFLine
- else
- Result := rfUnknown;
- end;
- var
- F: TOpenFileStatusForm;
- I,
- J,
- Ps: Integer;
- S,
- P: string;
- SL: TStringList;
- Folder: TFolder;
- Node,
- SubNode: TTreeNode;
- CurrentFile: TSourceFile;
- begin
- if not Compiling then begin
- WarnIfModified;
- Modified := False;
- OpeningProjectNow := True;
- Update;
- F := nil;
- ProjectTree.Items.BeginUpdate;
- S := ProjectFile;
- try
- FileClear;
- if (Length (S) > 0) and FileExists (S) then begin
- if not StartingAppNow then begin
- try
- F := TOpenFileStatusForm.Create (Self);
- except
- F := nil;
- end;
- if Assigned (F) then begin
- P := ExtractFileName (S);
- F.FileNameLabel.Caption := 'Opening Project ''' + Copy (P, 1, LastPos ('.', P) - 1) + '''...';
- F.Show;
- F.Update;
- end;
- end;
- SHAddToRecentDocs(SHARD_PATH, PChar (S));
- with TIniFile.Create (S) do try
- TopNode.Text := ReadString ('Settings', 'Project Name', 'Project1');
- ProjectFile := S;
- if ReadBool ('Settings', 'Archive', False) then
- ProjectTarget := ptArchive
- else if ReadBool ('Settings', 'Flash OS', False) then
- ProjectTarget := ptFlashOS
- else if ReadBool ('Settings', 'Fargo', False) then
- ProjectTarget := ptFargo;
- UseDataVar := ReadBool ('Settings', 'Use Data Variable', False);
- DataVar := ReadString ('Settings', 'Data Variable', '');
- DataVarCopy := ReadBool ('Settings', 'Copy Data Variable', True);
- DataVarCopyIfArchived := ReadBool ('Settings', 'Copy Data Variable if Archived', True);
- Pack := ReadBool ('Settings', 'Pack', False);
- PackVar := ReadString ('Settings', 'Packed Variable', '');
- GCCSwitches := ReadString ('Settings', 'GCC Switches', '');
- AsSwitches := ReadString ('Settings', 'GNU Assembler Switches', '');
- AsmSwitches := ReadString ('Settings', 'Assembler Switches', '');
- DebugInfo := ReadBool ('Settings', 'Debug Info', False);
- StdLib := ReadBool ('Settings', 'Standard Library', True);
- InitBSS := ReadBool ('Settings', 'Initialize BSS', True);
- OptimizeNOPs := ReadBool ('Settings', 'Optimize NOPs', True);
- OptimizeReturns := ReadBool ('Settings', 'Optimize Returns', True);
- OptimizeBranches := ReadBool ('Settings', 'Optimize Branches', True);
- OptimizeMoves := ReadBool ('Settings', 'Optimize Moves', True);
- OptimizeTests := ReadBool ('Settings', 'Optimize Tests', True);
- OptimizeCalculations := ReadBool ('Settings', 'Optimize Calculations', True);
- RemoveUnusedSections := ReadBool ('Settings', 'Remove Unused Sections', True);
- CutUnusedRanges := ReadBool ('Settings', 'Cut Unused Ranges', True);
- ReorderSections := ReadBool ('Settings', 'Reorder Sections', True);
- MergeConstants := ReadBool ('Settings', 'Merge Constants', True);
- OutputBin := ReadBool ('Settings', 'Binary Output', False);
- CommandLine := ReadString ('Settings', 'Command Line', '');
- PostBuildProcessFile := ReadString ('Settings', 'Post-Build Process', '');
- while Pos ('`', PostBuildProcessFile) > 0 do
- PostBuildProcessFile [Pos ('`', PostBuildProcessFile)] := '"';
- if Assigned (PredefinedLibOptions) then
- with PredefinedLibOptions do begin
- CalcDests := [];
- if ReadBool ('Library Options', 'Use TI-89', False) then
- Include (CalcDests, cdTI89);
- if ReadBool ('Library Options', 'Use TI-92 Plus', False) then
- Include (CalcDests, cdTI92Plus);
- if ReadBool ('Library Options', 'Use V200', False) then
- Include (CalcDests, cdV200);
- OptimizeCalcConsts := ReadBool ('Library Options', 'Optimize Calc Consts', False);
- if ReadBool ('Library Options', 'Use PreOS', False) then
- KernelFormat := kfCompressedTables
- else if ReadBool ('Library Options', 'Use Kernel', False) then
- KernelFormat := kfStandard
- else
- KernelFormat := kfNone;
- UseMinAMS := ReadBool ('Library Options', 'Minimum AMS Version Defined', False);
- MinAMS := ReadString ('Library Options', 'Minimum AMS Version', '1.00');
- UnofficialOSSupport := ReadBool ('Library Options', 'Unofficial OS Support', False);
- RelocFormat := StringToRelocFormat (ReadString ('Library Options', 'Reloc Format', ''));
- ROMCallFormat := StringToRelocFormat (ReadString ('Library Options', 'ROM Call Format', ''));
- BSSRefFormat := StringToRelocFormat (ReadString ('Library Options', 'BSS Ref Format', ''));
- DataRefFormat := StringToRelocFormat (ReadString ('Library Options', 'Data Ref Format', ''));
- UseFLineJumps := ReadBool ('Library Options', 'Use F-Line Jumps', False);
- Use4ByteFLineJumps := ReadBool ('Library Options', 'Use 4-Byte F-Line Jumps', False);
- OptimizeROMCalls := ReadBool ('Library Options', 'Optimize ROM Calls', False);
- UseInternalFLineEmulator := ReadBool ('Library Options', 'Use Internal F-Line Emulator', False);
- UseReturnValue := ReadBool ('Library Options', 'Use Return Value', False);
- EnableErrorReturn := ReadBool ('Library Options', 'Enable Error Return', False);
- SaveScreen := ReadBool ('Library Options', 'Save Screen', False);
- end;
- SL := TStringList.Create;
- try
- ReadSection ('Included Files', SL);
- for I := 0 to SL.Count - 1 do begin
- P := SL.Strings [I];
- S := ReadString ('Included Files', P, '');
- if Length (S) > 0 then begin
- if Copy (P, Length (P) - Length (' Folder') + 1, Length (P)) = ' Folder' then begin
- Delete (P, Length (P) - Length (' Folder') + 1, Length (P));
- J := SL.IndexOf (P);
- if J >= 0 then begin
- Node := TopNode.Item [TSourceFile.GetAppropriateClassFromName (Copy (P, 1, LastPos (' ', P) - 1)).GetClassTreeIndex];
- repeat
- Ps := Pos ('\', S);
- if Ps > 0 then
- P := Copy (S, 1, Ps - 1)
- else
- P := S;
- SubNode := Node.GetFirstChild;
- while Assigned (SubNode) and ((not Assigned (SubNode.Data)) or (not (TObject (SubNode.Data) is TFolder)) or (SubNode.Text <> P)) do
- SubNode := SubNode.GetNextSibling;
- if Assigned (SubNode) then
- Node := SubNode
- else begin
- Folder := TFolder.Create;
- Node := ProjectTree.Items.AddChildObject (Node, P, Folder);
- Folder.TreeItem := Node;
- with Node do begin
- ImageIndex := 0;
- SelectedIndex := 1;
- end;
- end;
- Delete (S, 1, Length (P) + 1);
- until Length (S) <= 0;
- SL.Objects [J] := Node.Data;
- end;
- end;
- end;
- end;
- for I := 0 to SL.Count - 1 do begin
- P := SL.Strings [I];
- S := ReadString ('Included Files', P, '');
- if Length (S) > 0 then begin
- if Copy (P, Length (P) - Length (' Folder') + 1, Length (P)) <> ' Folder' then begin
- if Pos (':', S) <= 0 then
- S := ExtractFilePath (ProjectFile) + S;
- if FileExists (S) then
- AddSourceFile (S, False, TSourceFile.GetAppropriateClassFromName (Copy (P, 1, LastPos (' ', P) - 1)), TFolder (SL.Objects [I]))
- else
- ShowDefaultMessageBox ('File not found:'#13#10#13#10 + S, 'Error', mtProgramError);
- end;
- end;
- end;
- finally
- SL.Free;
- end;
- S := ReadString ('File Editing', 'Open File', '');
- if Length (S) > 0 then begin
- CurrentFile := SourceFiles.FindFile (S);
- if Assigned (CurrentFile) then
- CurrentFile.Edit;
- end;
- finally
- Free;
- end;
- ProjectTree.FullExpand;
- NoEditor.Show;
- UpdateDebugSettings;
- AddToRecent (ProjectFile);
- end;
- SortFiles;
- finally
- ProjectTree.Items.EndUpdate;
- OpeningProjectNow := False;
- if Assigned (F) then
- F.Free;
- end;
- Modified := False;
- end;
- end;
- procedure TMainForm.FileNew;
- begin
- if not Compiling then begin
- WarnIfModified;
- Modified := False;
- ProjectFile := '';
- FileClear;
- end;
- end;
- procedure TMainForm.FileClear;
- procedure TryDeleteNode(Node: TTreeNode);
- var
- I: Integer;
- begin
- with Node do begin
- for I := Count - 1 downto 0 do
- TryDeleteNode (Item [I]);
- if Assigned (Data) then
- Delete;
- end;
- end;
- begin
- if not Compiling then begin
- WarnIfModified;
- Modified := False;
- Invalidated := True;
- ActiveControl := ProjectTree;
- ErrorList.Items.BeginUpdate;
- ErrorList.Items.Clear;
- ErrorList.Items.EndUpdate;
- ProjectTree.Items.BeginUpdate;
- ClearDebugInfo;
- TopNode.Text := 'Project1';
- SelectNode (TopNode);
- TryDeleteNode (TopNode);
- ProjectTree.FullExpand;
- ProjectTree.Items.EndUpdate;
- ResetProjectSettings;
- NoEditor.Show;
- UpdateDebugSettings;
- Update;
- Modified := False;
- end;
- end;
- procedure TMainForm.FileOpen(const FN: string);
- begin
- if not Compiling then begin
- WarnIfModified;
- Modified := False;
- ProjectTree.Items.BeginUpdate;
- ProjectFile := FN;
- FileLoad;
- ProjectTree.Items.EndUpdate;
- end;
- end;
- procedure TMainForm.FileSave;
- function RelocFormatToString(RelocFormat: TRelocFormat): string;
- begin
- case RelocFormat of
- rfNone: Result := 'None';
- rfDirect: Result := 'Direct';
- rfAMS: Result := 'AMS';
- rfKernel: Result := 'Kernel';
- rfCompressed: Result := 'Compressed';
- rfMLink: Result := 'MLink';
- rfFLine: Result := 'F-Line';
- else Result := 'Unknown';
- end;
- end;
- var
- I,
- ClassCount: Integer;
- S: string;
- SL: TStringList;
- begin
- if ProjectFile = '' then
- FileSaveProjectAs (Self)
- else begin
- try
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do begin
- if UpperCase (ExtractFilePath (FileName)) = 'C:\' then
- FileName := ExtractFilePath (ProjectFile) + LogicalFileName;
- if Modified or not FileExists (FileName) then
- Save;
- end;
- with TIniFile.Create (ProjectFile) do try
- WriteBool ('Settings', 'Archive', ProjectTarget = ptArchive);
- WriteBool ('Settings', 'Flash OS', ProjectTarget = ptFlashOS);
- WriteBool ('Settings', 'Fargo', ProjectTarget = ptFargo);
- WriteBool ('Settings', 'Use Data Variable', UseDataVar);
- WriteString ('Settings', 'Data Variable', DataVar);
- WriteBool ('Settings', 'Copy Data Variable', DataVarCopy);
- WriteBool ('Settings', 'Copy Data Variable if Archived', DataVarCopyIfArchived);
- WriteBool ('Settings', 'Pack', Pack);
- WriteString ('Settings', 'Packed Variable', PackVar);
- WriteString ('Settings', 'Project Name', TopNode.Text);
- WriteString ('Settings', 'GCC Switches', GCCSwitches);
- WriteString ('Settings', 'GNU Assembler Switches', AsSwitches);
- WriteString ('Settings', 'Assembler Switches', AsmSwitches);
- WriteBool ('Settings', 'Debug Info', DebugInfo);
- WriteBool ('Settings', 'Standard Library', StdLib);
- WriteBool ('Settings', 'Initialize BSS', InitBSS);
- WriteBool ('Settings', 'Optimize NOPs', OptimizeNOPs);
- WriteBool ('Settings', 'Optimize Returns', OptimizeReturns);
- WriteBool ('Settings', 'Optimize Branches', OptimizeBranches);
- WriteBool ('Settings', 'Optimize Moves', OptimizeMoves);
- WriteBool ('Settings', 'Optimize Tests', OptimizeTests);
- WriteBool ('Settings', 'Optimize Calculations', OptimizeCalculations);
- WriteBool ('Settings', 'Remove Unused Sections', RemoveUnusedSections);
- WriteBool ('Settings', 'Cut Unused Ranges', CutUnusedRanges);
- WriteBool ('Settings', 'Reorder Sections', ReorderSections);
- WriteBool ('Settings', 'Merge Constants', MergeConstants);
- WriteBool ('Settings', 'Binary Output', OutputBin);
- WriteString ('Settings', 'Command Line', CommandLine);
- S := PostBuildProcessFile;
- while Pos ('"', S) > 0 do
- S [Pos ('"', S)] := '`';
- WriteString ('Settings', 'Post-Build Process', S);
- if Assigned (PredefinedLibOptions) then
- with PredefinedLibOptions do begin
- WriteBool ('Library Options', 'Use TI-89', cdTI89 in CalcDests);
- WriteBool ('Library Options', 'Use TI-92 Plus', cdTI92Plus in CalcDests);
- WriteBool ('Library Options', 'Use V200', cdV200 in CalcDests);
- WriteBool ('Library Options', 'Optimize Calc Consts', OptimizeCalcConsts);
- WriteBool ('Library Options', 'Use Kernel', KernelFormat <> kfNone);
- WriteBool ('Library Options', 'Use PreOS', KernelFormat = kfCompressedTables);
- WriteBool ('Library Options', 'Minimum AMS Version Defined', UseMinAMS);
- WriteString ('Library Options', 'Minimum AMS Version', MinAMS);
- WriteBool ('Library Options', 'Unofficial OS Support', UnofficialOSSupport);
- WriteString ('Library Options', 'Reloc Format', RelocFormatToString (RelocFormat));
- WriteString ('Library Options', 'ROM Call Format', RelocFormatToString (ROMCallFormat));
- WriteString ('Library Options', 'BSS Ref Format', RelocFormatToString (BSSRefFormat));
- WriteString ('Library Options', 'Data Ref Format', RelocFormatToString (DataRefFormat));
- WriteBool ('Library Options', 'Use F-Line Jumps', UseFLineJumps);
- WriteBool ('Library Options', 'Use 4-Byte F-Line Jumps', Use4ByteFLineJumps);
- WriteBool ('Library Options', 'Optimize ROM Calls', OptimizeROMCalls);
- WriteBool ('Library Options', 'Use Internal F-Line Emulator', UseInternalFLineEmulator);
- WriteBool ('Library Options', 'Use Return Value', UseReturnValue);
- WriteBool ('Library Options', 'Enable Error Return', EnableErrorReturn);
- WriteBool ('Library Options', 'Save Screen', SaveScreen);
- end;
- EraseSection ('Included Files');
- SL := TStringList.Create;
- try
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- if InProject then begin
- S := SL.Values [ClassItemName];
- if Length (S) > 0 then
- ClassCount := StrToInt (S) + 1
- else
- ClassCount := 1;
- SL.Values [ClassItemName] := IntToStr (ClassCount);
- WriteString ('Included Files', ClassItemName + ' ' + IntToStr (ClassCount), DynamicName);
- S := FolderPath;
- if Length (S) > 0 then
- WriteString ('Included Files', ClassItemName + ' ' + IntToStr (ClassCount) + ' Folder', S);
- end;
- finally
- SL.Free;
- end;
- S := '';
- if Assigned (ProjectTree.Selected) and Assigned (ProjectTree.Selected.Data) and (TObject (ProjectTree.Selected.Data) is TSourceFile) then
- S := TSourceFile(ProjectTree.Selected.Data).FileName;
- WriteString ('File Editing', 'Open File', S);
- UpdateFile;
- finally
- Free;
- end;
- Modified := False;
- except
- ShowDefaultMessageBox ('Error saving project file.', 'Error', mtProgramError);
- end;
- AddToRecent (ProjectFile);
- end;
- end;
- procedure TMainForm.FileSaveAs(const FN: string);
- var
- I: Integer;
- begin
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- if Pos ('\', DynamicName) <= 0 then
- WriteToFile (ExtractFilePath (FN) + DynamicName, True);
- ProjectFile := FN;
- FileSave;
- end;
- procedure TMainForm.ProjectTreeDeletion(Sender: TObject; Node: TTreeNode);
- begin
- PreviousNode := nil;
- EditorToHide := nil;
- if Assigned (Node.Data) then
- if TObject (Node.Data) is TSourceFile then begin
- with TSourceFile (Node.Data) do begin
- TreeItem := nil;
- Free;
- end;
- end else
- with TObject (Node.Data) do
- Free;
- ProjectTree.Invalidate;
- end;
- procedure TMainForm.FileExit(Sender: TObject);
- begin
- Close;
- end;
- procedure TMainForm.FileNewProject(Sender: TObject);
- begin
- WarnIfModified;
- Modified := False;
- FileNew;
- end;
- procedure TMainForm.TreeItemRemove(Sender: TObject);
- var
- Node,
- CurNode: TTreeNode;
- begin
- Node := ProjectTree.Selected;
- if (not Compiling) and Assigned (Node) and Assigned (Node.Data) then begin
- CurNode := Node;
- while Assigned (CurNode) and (CurNode <> Node.GetNextSibling) do begin
- if Assigned (CurNode.Data) and (TObject (CurNode.Data) is TSourceFile) then
- TSourceFile(CurNode.Data).WarnIfModified;
- CurNode := CurNode.GetNext;
- if Node.GetNextSibling = nil then
- break;
- end;
- Node.Delete;
- Modify;
- end;
- end;
- procedure TMainForm.TreeItemDelete(Sender: TObject);
- var
- Node: TTreeNode;
- begin
- Node := ProjectTree.Selected;
- if (not Compiling) and Assigned (Node) and Assigned (Node.Data) and (TObject (Node.Data) is TSourceFile) then begin
- if ShowDefaultMessageBox
- ('Are you sure you want to delete this source file? You cannot undo this operation.',
- 'Confirm Deletion', mtQuestion) = idYes then begin
- with TSourceFile (Node.Data) do
- if (FileName <> '') and FileExists (FileName) then
- DeleteFile (FileName);
- Node.Delete;
- Modify;
- end;
- end;
- end;
- procedure TMainForm.CopyHeaders;
- var
- I,
- J: Integer;
- HasA68kFiles: Boolean;
- begin
- HasA68kFiles := False;
- with SourceFiles do begin
- for I := 0 to Count - 1 do
- if Items [I] is TAsmSourceFile then begin
- HasA68kFiles := True;
- Break;
- end;
- if HasA68kFiles then
- with TFileReferences.Create do try
- SearchForFiles (WithBackslash (TIGCCFolder) + ASMIncludeLocation + '*.*', atAll);
- for J := 0 to Count - 1 do
- CopyFile (PChar (Items[J].FullName), PChar (Temp + ExtractFileName (Items[J].FullName)), False);
- finally
- Free;
- end;
- for I := 0 to Count - 1 do begin
- if Items [I] is THeaderSourceFile then begin
- with Items [I] as THeaderSourceFile do begin
- if Invalidated then
- RecompileFiles;
- if InProject then
- SplitAndWriteToFile (Temp + LogicalFileName);
- end;
- end else if Items [I] is TOtherSourceFile then
- with Items [I] as TSourceFile do
- if InProject then
- WriteToFile (Temp + LogicalFileName);
- end;
- end;
- end;
- procedure TMainForm.DeleteHeaders;
- var
- I: Integer;
- FN: string;
- begin
- with TFileReferences.Create do try
- SearchForFiles (Temp + '*.h', atAll);
- for I := 0 to Count - 1 do try
- DeleteFile (Items[I].FullName);
- except end;
- finally
- Free;
- end;
- with SourceFiles do
- for I := 0 to Count - 1 do
- if (Items [I] is THeaderSourceFile) or (Items [I] is TOtherSourceFile) then
- with Items [I] as TSourceFile do begin
- FN := Temp + LogicalFileName;
- if FileExists (FN) then try
- DeleteFile (FN);
- except end;
- RemovePathFor (FN, Temp);
- end;
- end;
- procedure TMainForm.TreeItemCompile(Sender: TObject);
- var
- Node: TTreeNode;
- begin
- Node := ProjectTree.Selected;
- if (not Compiling) and Assigned (Node) and Assigned (Node.Data) and (TObject (Node.Data) is TSourceFile) and (TSourceFile(Node.Data).Compilable) then begin
- BeginCompilation;
- CopyHeaders;
- TSourceFile(Node.Data).Compile;
- DeleteHeaders;
- EndCompilation;
- end;
- end;
- procedure TMainForm.CloseErrorsButtonClick(Sender: TObject);
- begin
- HideErrors;
- end;
- procedure TMainForm.AddError(const Line: string; BugTp: TBugType; SourceF: string; ErrFunc: string; ErrMessage: string; SourceLn: Integer; Offset: Integer);
- var
- I,
- J: Integer;
- O: TFoundError;
- Ignore: Boolean;
- Token: string;
- begin
- ErrMessage := Trim (ErrMessage);
- if ErrMessage <> '' then begin
- Ignore := False;
- if BugTp in [btWarning, btInfo] then begin
- if ((ErrFunc = '') and (UpperCase (ErrMessage) = '''STATIC'' IS NOT AT BEGINNING OF DECLARATION'))
- or (Pos ('__DUMMY__', UpperCase (ErrMessage)) > 0)
- or (Pos ('''__R''', UpperCase (ErrMessage)) > 0)
- or (Pos ('MULTI-LINE STRING LITERALS ARE DEPRECATED', UpperCase (ErrMessage)) > 0) then
- Ignore := True;
- end else begin
- if (Pos ('(EACH UNDECLARED IDENTIFIER IS REPORTED ONLY ONCE', UpperCase (ErrMessage)) > 0)
- or (Pos ('FOR EACH FUNCTION IT APPEARS IN.)', UpperCase (ErrMessage)) > 0) then
- Ignore := True;
- end;
- if not Ignore then begin
- if ErrFunc = '__main' then
- ErrFunc := '_main';
- if ErrFunc = '__exit' then
- ErrFunc := '_exit';
- ErrorList.Items.BeginUpdate;
- try
- ErrMessage [1] := UpCase (ErrMessage [1]);
- O := TFoundError.Create;
- with O do begin
- SourceFile := nil;
- if (Length (SourceF) > 0) and (LowerCase (ExtractFileExt (SourceF)) <> '.exe') and (LowerCase (ExtractFileExt (SourceF)) <> '.a') then try
- if Pos ('\', SourceF) > 0 then begin
- SourceFile := SourceFiles.FindFile (SourceF);
- if (not Assigned (SourceFile)) and (LowerCase (ExtractFileExt (SourceF)) = '.o') then begin
- SourceFile := SourceFiles.FindFile (ChangeFileExt (SourceF, '.c'));
- if not Assigned (SourceFile) then
- SourceFile := SourceFiles.FindFile (ChangeFileExt (SourceF, '.s'));
- if not Assigned (SourceFile) then
- SourceFile := SourceFiles.FindFile (ChangeFileExt (SourceF, '.asm'));
- end;
- end else begin
- SourceFile := SourceFiles.FindFileNameOnly (SourceF);
- if (not Assigned (SourceFile)) and (LowerCase (ExtractFileExt (SourceF)) = '.o') then begin
- SourceFile := SourceFiles.FindFileNameOnly (ChangeFileExt (SourceF, '.c'));
- if not Assigned (SourceFile) then
- SourceFile := SourceFiles.FindFileNameOnly (ChangeFileExt (SourceF, '.s'));
- if not Assigned (SourceFile) then
- SourceFile := SourceFiles.FindFileNameOnly (ChangeFileExt (SourceF, '.asm'));
- end;
- end;
- if not Assigned (SourceFile) then begin
- if (Pos ('\', SourceF) > 0) and FileExists (SourceF) then
- SourceFile := AddSourceFile (SourceF, True)
- else if FileExists (WithBackslash (TIGCCFolder) + CIncludeLocation + ExtractFileName (SourceF)) then
- SourceFile := AddSourceFile (WithBackslash (TIGCCFolder) + CIncludeLocation + ExtractFileName (SourceF), True)
- else if FileExists (WithBackslash (TIGCCFolder) + AsmIncludeLocation + ExtractFileName (SourceF)) then
- SourceFile := AddSourceFile (WithBackslash (TIGCCFolder) + AsmIncludeLocation + ExtractFileName (SourceF), True);
- end;
- except end;
- BugType := BugTp;
- WholeLine := Line;
- ErrorMessage := ErrMessage;
- ErrFunction := ErrFunc;
- if Assigned (SourceFile) and (SourceFile is TTextSourceFile) then
- with SourceFile as TTextSourceFile do
- if Assigned (TextEditor) then begin
- I := GetCompiledLineStart (SourceLn) + Offset;
- if I > 0 then begin
- if Pos ('''', ErrorMessage) > 0 then begin
- Token := Copy (ErrorMessage, Pos ('''', ErrorMessage) + 1, Length (ErrorMessage));
- Delete (Token, Pos ('''', Token), Length (Token));
- if Length (Token) > 0 then begin
- J := I;
- while (J <= TextEditor.TextLength) and (TextEditor.Text [J] in [#9, #10, #13, #32]) and (Copy (TextEditor.Text, J, Length (Token)) <> Token) do
- Inc (J);
- if Copy (TextEditor.Text, J, Length (Token)) = Token then
- I := J;
- end;
- end;
- O.Range := TMCRange.Create (TextEditor.TrackedRanges);
- O.Range.RStart := I;
- O.Range.OnOverwrite := DeleteError;
- end else
- O.Range := nil;
- end;
- end;
- with ErrorList.Items.Add do begin
- Data := Pointer (O);
- ImageIndex := Integer (BugTp);
- Caption := ErrMessage;
- if Assigned (O.SourceFile) then
- SubItems.Add (O.SourceFile.SourceName)
- else
- SubItems.Add ('');
- SubItems.Add (ErrFunc);
- ShowErrors;
- if JumpToError and (BugTp = btError) and (not Assigned (ErrorList.Selected)) then begin
- Selected := True;
- ErrorListClick (Self);
- end;
- end;
- except end;
- ErrorList.Items.EndUpdate;
- end;
- end;
- UpdateErrorWindow;
- end;
- procedure TMainForm.ClearErrors;
- begin
- HideErrors;
- with ErrorList.Items do begin
- BeginUpdate;
- Clear;
- EndUpdate;
- end;
- ActionProjectShowErrors.Enabled := False;
- end;
- procedure TMainForm.HideErrors;
- begin
- Splitter2.Hide;
- ErrWinPanel.Hide;
- ActionProjectShowErrors.Checked := False;
- end;
- procedure TMainForm.ShowErrors;
- begin
- if ErrorList.Items.Count > 0 then begin
- ErrWinPanel.Show;
- Splitter2.Show;
- Splitter2.Top := ErrWinPanel.Top - Splitter2.Height;
- ActionProjectShowErrors.Checked := True;
- ErrorList.Refresh;
- end;
- end;
- procedure TMainForm.ErrorListDeletion(Sender: TObject; Item: TListItem);
- var
- O: TObject;
- begin
- if Assigned (Item.Data) then begin
- O := TObject(Item.Data);
- Item.Data := nil;
- O.Free;
- end;
- end;
- procedure TMainForm.UpdateErrorWindow;
- var
- I: Integer;
- EC,
- WC: Integer;
- begin
- with ErrorList, Items do begin
- EC := 0;
- WC := 0;
- for I := 0 to Count - 1 do
- with TFoundError (Item[I].Data) do
- case BugType of
- btWarning:
- Inc (WC);
- btError:
- Inc (EC);
- end;
- ErrorsLabel.Caption := IntToStr (EC);
- WarningsLabel.Caption := IntToStr (WC);
- if Count <= 0 then
- HideErrors;
- end;
- ActionProjectShowErrors.Enabled := ErrorList.Items.Count > 0;
- if not ActionProjectShowErrors.Enabled then
- ActionProjectShowErrors.Checked := False;
- end;
- procedure TMainForm.TreeItemSave(Sender: TObject);
- var
- Node: TTreeNode;
- begin
- Node := ProjectTree.Selected;
- if Assigned (Node) and Assigned (Node.Data) and (TObject (Node.Data) is TSourceFile) then
- TSourceFile(Node.Data).Save;
- end;
- procedure TMainForm.HelpDocumentation(Sender: TObject);
- begin
- try
- DocFile.Display;
- except
- ShowDefaultMessageBox ('Error opening documentation.', 'Error', mtProgramError);
- end;
- end;
- procedure TMainForm.EditorEnter(Sender: TObject);
- begin
- ActionEditPaste.Enabled := True;
- ActionEditSelectAll.Enabled := True;
- ActionEditIncreaseIndent.Enabled := True;
- ActionEditDecreaseIndent.Enabled := True;
- ActionFindOpenFile.Enabled := True;
- UpdateEditButtons;
- end;
- procedure TMainForm.EditorExit(Sender: TObject);
- begin
- ActionEditDelete.Enabled := False;
- ActionEditCut.Enabled := False;
- ActionEditCopy.Enabled := False;
- ActionEditPaste.Enabled := False;
- ActionEditSelectAll.Enabled := False;
- ActionEditIncreaseIndent.Enabled := False;
- ActionEditDecreaseIndent.Enabled := False;
- ActionFindOpenFile.Enabled := False;
- ActionEditUndo.Enabled := False;
- ActionEditRedo.Enabled := False;
- end;
- procedure TMainForm.EditUndo(Sender: TObject);
- begin
- if Assigned (CurrentEditor) then
- CurrentEditor.Undo;
- end;
- procedure TMainForm.EditRedo(Sender: TObject);
- begin
- if Assigned (CurrentEditor) then
- CurrentEditor.Redo;
- end;
- procedure TMainForm.EditClear(Sender: TObject);
- var
- Editor: TMemoComponent;
- begin
- Editor := CurrentEditor;
- if Assigned (Editor) and (ActiveControl = Editor) then
- Editor.ClearSelection
- else if ActiveControl = ProjectTree then
- TreeItemRemove (Sender);
- end;
- procedure TMainForm.EditCut(Sender: TObject);
- var
- Editor: TMemoComponent;
- begin
- Editor := CurrentEditor;
- if Assigned (Editor) and (ActiveControl = Editor) then
- Editor.CutToClipboard;
- end;
- procedure TMainForm.EditCopy(Sender: TObject);
- var
- Editor: TMemoComponent;
- begin
- Editor := CurrentEditor;
- if Assigned (Editor) and (ActiveControl = Editor) then
- Editor.CopyToClipboard;
- end;
- procedure TMainForm.EditPaste(Sender: TObject);
- var
- Editor: TMemoComponent;
- begin
- Editor := CurrentEditor;
- if Assigned (Editor) and (ActiveControl = Editor) then
- Editor.PasteFromClipboard;
- end;
- procedure TMainForm.EditSelectAll(Sender: TObject);
- var
- Editor: TMemoComponent;
- begin
- Editor := CurrentEditor;
- if Assigned (Editor) and (ActiveControl = Editor) then
- Editor.SelectAll;
- end;
- procedure TMainForm.ProjectCompile(Sender: TObject);
- var
- I: Integer;
- begin
- if not Compiling then begin
- if AutoSave then
- FileSave
- else
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- if not InProject then
- Save;
- BeginCompilation;
- CompileProject;
- EndCompilation;
- end;
- end;
- procedure TMainForm.ProjectMake(Sender: TObject);
- begin
- MakeFileWrapped;
- DisplayFolderMessage;
- end;
- procedure TMainForm.MakeFileWrapped;
- var
- I: Integer;
- begin
- if not Compiling then begin
- if AutoSave then
- FileSave
- else
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- if not InProject then
- Save;
- OperationSuccessful := False;
- if ProjectFile = '' then
- ShowDefaultMessageBox ('You need to save your project before you can create executable files.', 'Project not Saved', mtProgramError)
- else begin
- BeginCompilation;
- CompileProject;
- Application.ProcessMessages;
- if OperationSuccessful and not OperationCancelled then
- MakeFile;
- EndCompilation;
- end;
- end;
- end;
- procedure TMainForm.MakeFile;
- procedure FileNotCompiled(const FileName: string);
- begin
- ShowDefaultMessageBox
- ('The file ''' + FileName + ''' has not been compiled. You have to compile it first before you can link it to your project.',
- 'No Object File', mtProgramError);
- end;
- var MainFiles: array [TCalcDest] of string;
- procedure HandleContents(const ProjectFile, FolderName, VarName, DataFolderName, DataVarName: string; Pack: Boolean; const PackVar: string; CalcDest: TCalcDest);
- var
- InputStream,
- OutputStream: TMemoryStream;
- OutputSize: LongWord;
- FileSize: Integer;
- F: file;
- B: Byte;
- begin
- CompUpdate;
- OperationSuccessful := False;
- with LinkOutputFiles [CalcDest, frMain] do
- if Assigned (Data) then begin
- OutputStream := TMemoryStream.Create;
- try
- if OSUpgrade then begin
- OutputSize := GetOSUpgradeFileSize (Data.Size, OutputBin);
- OutputStream.Size := OutputSize;
- ProduceOSUpgradeFile (OutputStream.Memory, Data.Memory, Data.Size, OutputBin);
- MainFiles [CalcDest] := ChangeFileExt (ProjectFile, GetOSUpgradeFileExt (CalcDest, OutputBin));
- OutputStream.SaveToFile (MainFiles [CalcDest]);
- if LongWord (ProgSize) < OutputSize then
- ProgSize := OutputSize;
- OperationSuccessful := True;
- end else begin
- FileSize := 2 + Data.Size + 1;
- if Pack then begin
- AssignFile (F, Temp + 'tempprog.bin');
- Rewrite (F, 1);
- B := (FileSize - 2) shr 8;
- BlockWrite (F, B, 1);
- B := (FileSize - 2);
- BlockWrite (F, B, 1);
- BlockWrite (F, Data.Memory^, Data.Size);
- B := Tag;
- BlockWrite (F, B, 1);
- CloseFile (F);
- MainConsole.Title := 'Compressor';
- CompUpdate;
- try
- MainConsole.StartProcess (WithBackslash (TIGCCFolder) + PackLocation + 'Pack.exe', 'tempprog.bin tempprog.pck', WithoutBackslash (Temp));
- WaitForMainConsole ('Compression');
- except
- ShowDefaultMessageBox ('Could not start compressor.', 'Error', mtProgramError);
- end;
- CompUpdate;
- if not OperationCancelled then begin
- if FileExists (Temp + 'tempprog.pck') then begin
- InputStream := TMemoryStream.Create;
- with InputStream do try
- LoadFromFile (Temp + 'tempprog.pck');
- OutputSize := GetTransferFileSize (Size, 'ppg', OutputBin);
- if OutputSize > 0 then begin
- OutputStream.Size := OutputSize;
- ProduceTransferFile (OutputStream.Memory, Memory, Size, CalcDest, FolderName, PackVar, $F8, 'ppg', OutputBin);
- MainFiles [CalcDest] := ChangeFileExt (ProjectFile, GetTransferFileExt (CalcDest, $F8, OutputBin));
- OutputStream.SaveToFile (MainFiles [CalcDest]);
- if LongWord (ProgSize) < OutputSize then
- ProgSize := OutputSize;
- OperationSuccessful := True;
- end else
- ShowDefaultMessageBox ('Compressed size of ' + IntToStr (Size) + ' bytes is too large, unexpectedly.', 'Error', mtProgramError);
- finally
- Free;
- end;
- end else
- ShowDefaultMessageBox ('Compression failed. Please check the program size.', 'Error', mtProgramError);
- end;
- if FileExists (Temp + 'tempprog.bin') then
- DeleteFile (Temp + 'tempprog.bin');
- if FileExists (Temp + 'tempprog.pck') then
- DeleteFile (Temp + 'tempprog.pck');
- end else begin
- OutputSize := GetTransferFileSize (Data.Size, VarExt, OutputBin);
- if OutputSize > 0 then begin
- OutputStream.Size := OutputSize;
- ProduceTransferFile (OutputStream.Memory, Data.Memory, Data.Size, CalcDest, FolderName, VarName, Tag, VarExt, OutputBin);
- MainFiles [CalcDest] := ChangeFileExt (ProjectFile, GetTransferFileExt (CalcDest, Tag, OutputBin));
- OutputStream.SaveToFile (MainFiles [CalcDest]);
- if LongWord (ProgSize) < OutputSize then
- ProgSize := OutputSize;
- OperationSuccessful := True;
- end else
- ShowDefaultMessageBox ('Variable size of ' + IntToStr (FileSize) + ' bytes is too large, unexpectedly.', 'Error', mtProgramError);
- end;
- end;
- finally
- OutputStream.Free;
- end;
- CompUpdate;
- end else
- ShowDefaultMessageBox ('Unexpected destination calculator mismatch.', 'Error', mtProgramError);
- with LinkOutputFiles [CalcDest, frData] do
- if Assigned (Data) and (not OSUpgrade) then begin
- FileSize := 2 + Data.Size + 1;
- OutputStream := TMemoryStream.Create;
- try
- OutputSize := GetTransferFileSize (Data.Size, VarExt, OutputBin);
- if OutputSize > 0 then begin
- OutputStream.Size := OutputSize;
- ProduceTransferFile (OutputStream.Memory, Data.Memory, Data.Size, CalcDest, DataFolderName, DataVarName, Tag, VarExt, OutputBin);
- OutputStream.SaveToFile (ChangeFileExt (ChangeFileExt (ProjectFile, '') + '-data', GetTransferFileExt (CalcDest, Tag, OutputBin)));
- OperationSuccessful := True;
- end else
- ShowDefaultMessageBox ('Data variable size of ' + IntToStr (FileSize) + ' bytes is too large, unexpectedly.', 'Error', mtProgramError);
- finally
- OutputStream.Free;
- end;
- CompUpdate;
- end;
- end;
- procedure HandleDebugContents(const ProjectFile: string);
- begin
- with LinkDebugFile do
- if Assigned (Data) then
- Data.SaveToFile (ChangeFileExt (ProjectFile, '.dbg'));
- end;
- procedure CreatePackStarter(const ProjectFile, StarterFileName, FolderName, VarName, PackVar: string; CalcDests: TCalcDests);
- var
- CurCalcDest: TCalcDest;
- CustomStarterObject: string;
- ObjectFileNames: array [0..1] of PChar;
- DataVarInfo: TLinkLibDataVarInfo;
- OptimizeInfo: TLinkLibOptimizeInfo;
- begin
- CompUpdate;
- OperationSuccessful := False;
- for CurCalcDest := FirstCalcDest to LastCalcDest do begin
- LinkOutputFiles[CurCalcDest,frMain].Data := nil;
- LinkOutputFiles[CurCalcDest,frData].Data := nil;
- end;
- try
- CustomStarterObject := Temp + StarterFileName;
- if FileExists (WithBackslash (TIGCCFolder) + PStarterLocation + StarterFileName) then try
- ParsePStarter (WithBackslash (TIGCCFolder) + PStarterLocation + StarterFileName, CustomStarterObject, PackVar);
- except
- ShowDefaultMessageBox ('Error processing starter object file.', 'Error', mtProgramError);
- Exit;
- end else begin
- ShowDefaultMessageBox ('Cannot find starter object file.', 'Error', mtProgramError);
- Exit;
- end;
- if not OperationCancelled then begin
- ObjectFileNames [0] := PChar (CustomStarterObject);
- ObjectFileNames [1] := nil;
- FillChar (DataVarInfo, SizeOf (DataVarInfo), 0);
- FillChar (OptimizeInfo, SizeOf (OptimizeInfo), 0);
- if Assigned (LinkLibLinkFiles) then
- OperationSuccessful := LinkLibLinkFiles (@ObjectFileNames, nil, LinkLibError, LinkLibGetOutputFile, nil, False, False, False, DataVarInfo, OptimizeInfo, False) = 0
- else
- ShowDefaultMessageBox ('Linker not loaded.', 'Error', mtProgramError);
- end;
- for CurCalcDest := cdTI89 to cdV200 do
- if OperationSuccessful and (not OperationCancelled) and (CurCalcDest in CalcDests) then
- HandleContents (ProjectFile, FolderName, VarName, '', '', False, '', CurCalcDest);
- finally
- for CurCalcDest := FirstCalcDest to LastCalcDest do begin
- if Assigned (LinkOutputFiles[CurCalcDest,frMain].Data) then
- LinkOutputFiles[CurCalcDest,frMain].Data.Free;
- if Assigned (LinkOutputFiles[CurCalcDest,frData].Data) then
- LinkOutputFiles[CurCalcDest,frData].Data.Free;
- LinkOutputFiles[CurCalcDest,frMain].Data := nil;
- LinkOutputFiles[CurCalcDest,frData].Data := nil;
- end;
- if FileExists (CustomStarterObject) then
- DeleteFile (CustomStarterObject);
- end;
- end;
- var
- FolderName,
- VarName,
- DataFolderName,
- DataVarName: array [0..MaxNameLength] of Char;
- I,
- P: Integer;
- S1,
- DestFile: string;
- Node: TTreeNode;
- SourceFile: TSourceFile;
- FileNameList: TStringList;
- ObjectFileNames,
- ArchiveFileNames: PPChar;
- ObjectFileCount,
- ArchiveFileCount: Integer;
- DataVarInfo: TLinkLibDataVarInfo;
- CalcDests: TCalcDests;
- CurCalcDest: TCalcDest;
- SR: TSearchRec;
- begin
- UpdateErrorWindow;
- OperationCancelled := False;
- OperationSuccessful := False;
- ProgSize := 0;
- CalcDests := [];
- OperationSuccessful := True;
- with TopNode do begin
- I := Pos ('\', Text);
- if I > 0 then begin
- StrPLCopy (VarName, LowerCase (Copy (Text, I + 1, MaxNameLength)), MaxNameLength);
- StrPLCopy (FolderName, LowerCase (Copy (Text, 1, I - 1)), MaxNameLength);
- CharLower (FolderName);
- end else begin
- StrPLCopy (VarName, LowerCase (Text), MaxNameLength);
- FolderName := 'main';
- end;
- CharLower (VarName);
- end;
- with SourceFiles do
- for I := 0 to Count - 1 do
- with TSourceFile (Items [I]) do
- if InProject and Compilable and (not FileExists (ChangeFileExt (FileName, '.o'))) then begin
- OperationSuccessful := False;
- FileNotCompiled (SourceName);
- end;
- I := Pos ('\', DataVar);
- if I > 0 then begin
- StrPLCopy (DataVarName, LowerCase (Copy (DataVar, I + 1, MaxNameLength)), MaxNameLength);
- StrPLCopy (DataFolderName, LowerCase (Copy (DataVar, 1, I - 1)), MaxNameLength);
- CharLower (DataFolderName);
- end else begin
- StrPLCopy (DataVarName, LowerCase (DataVar), MaxNameLength);
- DataFolderName := FolderName;
- end;
- CharLower (DataVarName);
- if OperationSuccessful then begin
- OperationSuccessful := False;
- if Assigned (LinkLibLinkFiles) and Assigned (LinkLibCreateArchive) then begin
- CompStartFile;
- CompSetMessage ('Linking Project ''' + WithoutExt (ExtractFileName (ProjectFile)) + '''');
- if FileExists (ChangeFileExt (ProjectFile, '-titanium.89z')) then
- DeleteFile (ChangeFileExt (ProjectFile, '-titanium.89z'));
- ObjectFileCount := 0;
- ObjectFileNames := nil;
- ArchiveFileCount := 0;
- ArchiveFileNames := nil;
- FileNameList := TStringList.Create;
- try
- Node := TopNode;
- while Assigned (Node) do begin
- if Assigned (Node.Data) and (TObject (Node.Data) is TSourceFile) then begin
- SourceFile := Node.Data;
- if Assigned (SourceFile) then
- with SourceFile do
- if InProject then begin
- if SourceFile is TArchiveSourceFile then begin
- Inc (ArchiveFileCount);
- ReallocMem (ArchiveFileNames, SizeOf (PChar) * (ArchiveFileCount + 1));
- ArchiveFileNames [ArchiveFileCount - 1] := PChar (FileNameList.Strings [FileNameList.Add (FileName)]);
- ArchiveFileNames [ArchiveFileCount - 0] := nil;
- end else if Compilable or (SourceFile is TObjectSourceFile) then begin
- Inc (ObjectFileCount);
- ReallocMem (ObjectFileNames, SizeOf (PChar) * (ObjectFileCount + 1));
- ObjectFileNames [ObjectFileCount - 1] := PChar (FileNameList.Strings [FileNameList.Add (ChangeFileExt (FileName, '.o'))]);
- ObjectFileNames [ObjectFileCount] := nil;
- end;
- end;
- end;
- Node := Node.GetNext;
- end;
- if StdLib then begin
- if ProjectTarget = ptFlashOS then
- S1 := WithBackslash (TIGCCFolder) + StdLibLocation + 'flashos.a'
- else if ProjectTarget = ptFargo then
- S1 := WithBackslash (TIGCCFolder) + StdLibLocation + 'fargo.a'
- else
- S1 := WithBackslash (TIGCCFolder) + StdLibLocation + 'tigcc.a';
- if FileExists (S1) then begin
- Inc (ArchiveFileCount);
- ReallocMem (ArchiveFileNames, SizeOf (PChar) * (ArchiveFileCount + 1));
- ArchiveFileNames [ArchiveFileCount - 1] := PChar (FileNameList.Strings [FileNameList.Add (S1)]);
- ArchiveFileNames [ArchiveFileCount] := nil;
- end;
- end;
- if ProjectTarget = ptArchive then begin
- DestFile := ChangeFileExt (ProjectFile, '.a');
- OperationSuccessful := LinkLibCreateArchive (PChar (DestFile), ObjectFileNames, LinkLibError, True) = 0;
- if OperationSuccessful then begin
- if FindFirst (DestFile, faAnyFile, SR) = 0 then
- ProgSize := SR.Size;
- FindClose (SR);
- end;
- end else begin
- for CurCalcDest := FirstCalcDest to LastCalcDest do begin
- LinkOutputFiles[CurCalcDest,frMain].Data := nil;
- LinkOutputFiles[CurCalcDest,frData].Data := nil;
- end;
- LinkDebugFile.Data := nil;
- try
- FillChar (DataVarInfo, SizeOf (DataVarInfo), 0);
- FillChar (OptimizeInfo, SizeOf (OptimizeInfo), 0);
- if UseDataVar then
- with DataVarInfo do begin
- VarName := PChar (LowerCase (MasterUnit.DataVar));
- CreateCopy := MasterUnit.DataVarCopy;
- CopyOnlyIfArchived := MasterUnit.DataVarCopyIfArchived;
- end;
- with OptimizeInfo do begin
- RemoveUnused := MasterUnit.RemoveUnusedSections;
- OptimizeNOPs := MasterUnit.OptimizeNOPs;
- OptimizeReturns := MasterUnit.OptimizeReturns;
- OptimizeBranches := MasterUnit.OptimizeBranches;
- OptimizeMoves := MasterUnit.OptimizeMoves;
- OptimizeTests := MasterUnit.OptimizeTests;
- OptimizeCalcs := MasterUnit.OptimizeCalculations;
- CutRanges := MasterUnit.CutUnusedRanges;
- ReorderSections := MasterUnit.ReorderSections;
- MergeConstants := MasterUnit.MergeConstants;
- end;
- OperationSuccessful := LinkLibLinkFiles (ObjectFileNames, ArchiveFileNames, LinkLibError, LinkLibGetOutputFile, nil, False, ProjectTarget = ptFlashOS, ProjectTarget = ptFargo, DataVarInfo, OptimizeInfo, not InitBSS) = 0;
- if OperationSuccessful and (not OperationCancelled) then begin
- if Pack and (ssPack in SpecialSupport) then begin
- CompStartFile;
- CompSetMessage ('Compressing');
- end;
- for CurCalcDest := FirstCalcDest to LastCalcDest do
- if Assigned (LinkOutputFiles[CurCalcDest,frMain].Data) then
- if OperationSuccessful and (not OperationCancelled) then begin
- Include (CalcDests, CurCalcDest);
- HandleContents (ProjectFile, FolderName, VarName, DataFolderName, DataVarName, Pack and (ssPack in SpecialSupport) and (CurCalcDest <> cdTI92), PackVar, CurCalcDest);
- end;
- if Assigned (LinkDebugFile.Data) then begin
- if OperationSuccessful and (not OperationCancelled) then begin
- HandleDebugContents (ProjectFile);
- end;
- end;
- end;
- finally
- for CurCalcDest := FirstCalcDest to LastCalcDest do begin
- if Assigned (LinkOutputFiles[CurCalcDest,frMain].Data) then
- LinkOutputFiles[CurCalcDest,frMain].Data.Free;
- if Assigned (LinkOutputFiles[CurCalcDest,frData].Data) then
- LinkOutputFiles[CurCalcDest,frData].Data.Free;
- LinkOutputFiles[CurCalcDest,frMain].Data := nil;
- LinkOutputFiles[CurCalcDest,frData].Data := nil;
- if Assigned (LinkDebugFile.Data) then
- LinkDebugFile.Data.Free;
- LinkDebugFile.Data := nil;
- end;
- end;
- end;
- except
- if Assigned (ArchiveFileNames) then
- FreeMem (ArchiveFileNames);
- if Assigned (ObjectFileNames) then
- FreeMem (ObjectFileNames);
- FileNameList.Free;
- end;
- if OperationSuccessful and (not OperationCancelled) and Pack and (ssPack in SpecialSupport) then
- CreatePackStarter (ProjectFile, 'PStarter.o', FolderName, VarName, PackVar, CalcDests - [cdTI92]);
- if OperationSuccessful and (not OperationCancelled) and (Length (PostBuildProcessFile) > 0) then begin
- CompStartFile;
- CompSetMessage ('Calling User-Defined Program');
- MainConsole.Title := 'User-Defined Program';
- S1 := PostBuildProcessFile;
- P := Pos ('($TI89FILE)', UpperCase (S1));
- if P > 0 then begin
- Delete (S1, P, Length ('($TI89FILE)'));
- if cdTI89 in CalcDests then
- Insert (MainFiles [cdTI89], S1, P);
- end;
- P := Pos ('($TI92PLUSFILE)', UpperCase (S1));
- if P > 0 then begin
- Delete (S1, P, Length ('($TI92PLUSFILE)'));
- if cdTI92Plus in CalcDests then
- Insert (MainFiles [cdTI92Plus], S1, P);
- end;
- P := Pos ('($V200FILE)', UpperCase (S1));
- if P > 0 then begin
- Delete (S1, P, Length ('($V200FILE)'));
- if cdV200 in CalcDests then
- Insert (MainFiles [cdV200], S1, P);
- end;
- P := Pos ('($TI92FILE)', UpperCase (S1));
- if P > 0 then begin
- Delete (S1, P, Length ('($TI92FILE)'));
- if cdTI92 in CalcDests then
- Insert (MainFiles [cdTI92], S1, P);
- end;
- try
- MainConsole.StartProcess ('', S1, '');
- WaitForMainConsole ('User-Defined');
- except
- ShowDefaultMessageBox ('Could not start the user-defined program.', 'Error', mtProgramError);
- OperationSuccessful := False;
- end;
- UpdateProgramOutput;
- end;
- if not OperationSuccessful then
- ProgSize := 0;
- CompUpdate;
- try
- if FileExists (Temp + 'TEMPPROG.PCK') then
- DeleteFile (Temp + 'TEMPPROG.PCK');
- if OperationSuccessful and (not OperationCancelled) and DeleteAssemblyFiles then
- with SourceFiles do
- for I := 0 to Count - 1 do
- with TSourceFile (Items [I]) do
- if InProject and (Items [I] is TCSourceFile) then
- if FileExists (ChangeFileExt (FileName, '.s')) then
- DeleteFile (ChangeFileExt (FileName, '.s'));
- if OperationSuccessful and (not OperationCancelled) and DeleteObjectFiles then
- with SourceFiles do
- for I := 0 to Count - 1 do
- with TSourceFile (Items [I]) do
- if InProject and Compilable then begin
- Invalidate;
- if FileExists (ChangeFileExt (FileName, '.o')) then
- DeleteFile (ChangeFileExt (FileName, '.o'));
- end;
- except end;
- UpdateErrorWindow;
- ShowErrors;
- CompUpdate;
- if OperationSuccessful and (not OperationCancelled) then begin
- Invalidated := False;
- CompUpdate;
- end;
- end else
- ShowDefaultMessageBox ('Linker not loaded.', 'Error', mtProgramError);
- end;
- end;
- procedure TMainForm.FileOpenProject(Sender: TObject);
- begin
- if OpenProjectDlg.Execute then begin
- if LowerCase (ExtractFileExt (OpenProjectDlg.FileName)) = LowerCase (ProjectFileExt) then
- FileOpen (ExpandFileName (OpenProjectDlg.FileName))
- else
- AddSourceFile (OpenProjectDlg.FileName, True);
- end else
- Abort;
- end;
- procedure TMainForm.FileSaveAll(Sender: TObject);
- begin
- FileSave;
- end;
- procedure TMainForm.FileSaveProjectAs(Sender: TObject);
- begin
- SaveProjectDlg.FileName := ProjectFile;
- if SaveProjectDlg.Execute then
- FileSaveAs (ExpandFileName (SaveProjectDlg.FileName))
- else
- Abort;
- end;
- procedure TMainForm.EditorKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- var
- I: Integer;
- S: string;
- begin
- if Key = vk_F1 then
- if Sender is TMemoComponent then
- with Sender as TMemoComponent do begin
- S := '';
- for I := Selection.RStart - 1 downto 1 do begin
- if Text [I] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$', '#'] then
- S := Text [I] + S
- else
- Break;
- end;
- for I := Selection.RStart to TextLength do begin
- if Text [I] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$', '#'] then
- S := S + Text [I]
- else
- Break;
- end;
- if S <> '' then begin
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- if Assigned (ParentForm) then
- ParentForm.WindowState := wsMinimized;
- Application.ProcessMessages;
- DocFile.KeywordLookup (S);
- end;
- end;
- end;
- procedure TMainForm.ProjectBuild(Sender: TObject);
- var
- I: Integer;
- begin
- if not Compiling then begin
- if AutoSave then
- FileSave
- else
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- if not InProject then
- Save;
- OperationSuccessful := False;
- if ProjectFile = '' then
- ShowDefaultMessageBox ('You need to save your project before you can create executable files.', 'Project not Saved', mtProgramError)
- else begin
- BeginCompilation;
- RecompileFiles;
- CompileProject;
- Application.ProcessMessages;
- if OperationSuccessful and not OperationCancelled then
- MakeFile;
- EndCompilation;
- DisplayFolderMessage;
- end;
- end;
- end;
- procedure TMainForm.ProjectTreeKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- begin
- if (Key = vk_Delete) and not ProjectTree.IsEditing then
- TreeItemRemove (Sender);
- end;
- procedure TMainForm.ProjectTreeMouseUp(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- if Button = mbRight then
- with ProjectTree do
- if Assigned (Selected) then begin
- if Assigned (Selected.Data) then begin
- if TObject (Selected.Data) is TSourceFile then begin
- with TSourceFile (Selected.Data) do begin
- ActionTreeItemSave.Enabled := TSourceFile (Selected.Data) is TTextSourceFile;
- ActionTreeItemSaveAs.Enabled := True;
- ActionTreeItemCompile.Enabled := Compilable;
- end;
- with Mouse.CursorPos do
- SourceFilePopup.Popup (X, Y);
- end else if TObject (Selected.Data) is TFolder then begin
- with Mouse.CursorPos do
- FolderPopup.Popup (X, Y);
- end;
- end else if Assigned (Selected.Parent) then begin
- with Mouse.CursorPos do
- CategoryPopup.Popup (X, Y);
- end;
- end;
- end;
- procedure TMainForm.ProjectTreeEdited(Sender: TObject; Node: TTreeNode;
- var S: String);
- var
- I: Integer;
- HasFolder,
- NameConflict: Boolean;
- begin
- if Node = TopNode then begin
- if Length (S) <= 0 then
- S := 'Project1'
- else begin
- HasFolder := False;
- for I := Length (S) downto 1 do begin
- if S [I] = '\' then begin
- if HasFolder then
- Delete (S, I, 1)
- else
- HasFolder := True;
- end else if (not (IsCharAlphaNumeric (S [I]) or (S [I] in ['A'..'Z', 'a'..'z', '0'..'9']))) then
- Delete (S, I, 1);
- end;
- if Length (S) <= 0 then
- S := 'Project1'
- else if not (IsCharAlpha (S [1]) or (S [1] in ['A'..'Z', 'a'..'z', '\'])) then
- S := 'X' + S;
- I := Pos ('\', S);
- if I > 0 then begin
- while I - 1 > MaxNameLength do begin
- Delete (S, I - 1, 1);
- Dec (I);
- end;
- while Length (S) - I > MaxNameLength do
- Delete (S, Length (S), 1);
- if I + 1 > Length (S) then
- S := S + 'Project1'
- else if I = 1 then
- Delete (S, 1, 1)
- else if not (IsCharAlpha (S [I + 1]) or (S [I + 1] in ['A'..'Z', 'a'..'z'])) then
- Insert ('X', S, I + 1);
- end else
- S := Copy (S, 1, MaxNameLength);
- end;
- Modify;
- end else begin
- if Assigned (Node.Data) then begin
- if (TObject (Node.Data) is TSourceFile) then begin
- if S = '' then
- S := 'File1';
- NameConflict := False;
- if TSourceFile(Node.Data).Compilable then
- with SourceFiles do
- for I := 0 to Count - 1 do
- if Items [I] <> Node.Data then
- with Items [I] as TSourceFile do
- if Compilable and (LowerCase (SourceName) = LowerCase (S)) and (WithoutBackslash (FolderPath) = WithoutBackslash (TSourceFile(Node.Data).FolderPath)) then begin
- NameConflict := True;
- Break;
- end;
- if not NameConflict then try
- if Assigned (Node.Data) then
- TSourceFile(Node.Data).SourceName := S;
- Modify;
- Exit;
- except end;
- S := Node.Text;
- ShowDefaultMessageBox ('The name you chose conflicts with that of another file.', 'Error', mtProgramError)
- end else begin
- S := StringReplace (S, ' ', '', [rfReplaceAll]);
- if Length (S) <= 0 then
- S := Node.Text;
- RecompileFiles;
- end;
- end;
- end;
- end;
- procedure TMainForm.SetProjectFile(const Value: string);
- var
- S: string;
- B: Boolean;
- begin
- FProjectFile := Value;
- MasterUnit.ProjectFileName := Value;
- if Value = '' then
- Caption := OriginalCaption
- else
- Caption := OriginalCaption + ' - ' + WithoutExt (ExtractFileName (Value));
- Application.Title := Caption;
- if TopNode.Text = 'Project1' then begin
- B := Modified;
- S := WithoutExt (ExtractFileName (Value));
- ProjectTreeEdited (ProjectTree, TopNode, S);
- TopNode.Text := S;
- Modified := B;
- end;
- S := ExtractFilePath (Value);
- OpenProjectDlg.InitialDir := WithoutBackslash (S);
- OpenProjectDlg.FileName := Value;
- SaveProjectDlg.InitialDir := WithoutBackslash (S);
- SaveProjectDlg.FileName := Value;
- AddFileDlg.InitialDir := S;
- end;
- function TMainForm.AddSourceFile(const FN: string; OpenOnly: Boolean = False; SourceFileClass: TSourceFileClass = nil; Folder: TFolder = nil): TSourceFile;
- var
- F: TForm;
- S: string;
- O: TOpenFileStatusForm;
- begin
- if Compiling and (not OpenOnly) then
- Result := nil
- else begin
- Result := SourceFiles.FindFile (FN);
- if Assigned (Result) and Result.InProject then begin
- Result := nil;
- ShowDefaultMessageBox ('The file ''' + ExtractFileName (FN) + ''' is already included in the project.', 'File Already Included', mtProgramError);
- end else if OpenOnly and Assigned (Result) then begin
- Result := nil;
- ShowDefaultMessageBox ('The file ''' + ExtractFileName (FN) + ''' has already been opened.', 'File Already Opened', mtProgramError);
- end else if (not OpenOnly) and (LowerCase (ExtractFileExt (FN)) = '.qll') and (Assigned (SourceFiles.FindFileOfTypeInProject (TQuillSourceFile))) then begin
- Result := nil;
- ShowDefaultMessageBox ('There may be only one Quill source file in each project.', 'Quill Error', mtProgramError);
- end else begin
- if not Assigned (Result) then begin
- O := nil;
- try
- if not OpeningProjectNow then begin
- O := TOpenFileStatusForm.Create (Self);
- S := ExtractFileName (FN);
- O.FileNameLabel.Caption := 'Opening File ''' + Copy (S, 1, LastPos ('.', S) - 1) + '''...';
- O.Show;
- O.Update;
- end;
- if not Assigned (SourceFileClass) then
- SourceFileClass := TSourceFile.GetAppropriateClassFromExt (ExtractFileExt (FN));
- Result := SourceFileClass.Create (SourceFiles);
- Result.Folder := Folder;
- Result.LoadFromFile (FN, True);
- Result.OnError := AddError;
- finally
- if Assigned (O) then
- O.Free;
- end;
- if OpenOnly and (not Assigned (Result.Editor)) then begin
- Result.Free;
- Result := nil;
- ShowDefaultMessageBox ('The file ''' + ExtractFileName (FN) + ''' is not a valid file for opening.', 'Invalid File', mtProgramError);
- end;
- end;
- if Assigned (Result) then
- with Result do begin
- ErrorList := Self.ErrorList;
- if OpenOnly then begin
- if not Assigned (ParentForm) then begin
- ParentForm := TSourceFileForm.Create (nil);
- with ParentForm as TSourceFileForm do begin
- Enabled := False;
- SourceFile := Result;
- Show;
- end;
- if Assigned (Editor) then
- with Editor do begin
- Parent := ParentForm;
- Align := alClient;
- Show;
- if Enabled then
- SetFocus;
- end;
- end;
- end else begin
- if Assigned (ParentForm) then begin
- F := ParentForm;
- ParentForm := nil;
- F.Free;
- end;
- TreeItem := CreateFileNode (TopNode.Item [ClassTreeIndex], Result);
- with TreeItem do begin
- ImageIndex := ClassImageIndex;
- SelectedIndex := ImageIndex;
- end;
- end;
- end;
- end;
- if not OpeningProjectNow then
- SortFiles;
- end;
- end;
- procedure TMainForm.ProjectOptions(Sender: TObject);
- begin
- with TProjectOptionsForm.Create (Self) do try
- FlashOSRadioButton.Visible := ssFlashOS in SpecialSupport;
- FargoRadioButton.Visible := ssFargo in SpecialSupport;
- if ProjectTarget = ptArchive then
- ArchiveRadioButton.Checked := True
- else if (ProjectTarget = ptFlashOS) and (FlashOSRadioButton.Visible) then
- FlashOSRadioButton.Checked := True
- else if (ProjectTarget = ptFargo) and (FargoRadioButton.Visible) then
- FargoRadioButton.Checked := True
- else
- ExecutableRadioButton.Checked := True;
- DataVarCheckBox.Checked := UseDataVar;
- DataVarEdit.Text := DataVar;
- if DataVarCopy then begin
- if DataVarCopyIfArchived then
- DataVarCopyIfArchivedRadioButton.Checked := True
- else
- DataVarCopyAlwaysRadioButton.Checked := True;
- end else
- DataVarCopyNeverRadioButton.Checked := True;
- PackCheckBox.Checked := Pack and (ssPack in SpecialSupport);
- PackVarEdit.Text := PackVar;
- GCCSwitchesEdit.Text := GCCSwitches;
- AsSwitchesEdit.Text := AsSwitches;
- AsmSwitchesEdit.Text := AsmSwitches;
- DebugInfoCheckBox.Checked := DebugInfo;
- OptimizeNOPsCheckBox.Checked := OptimizeNOPs;
- OptimizeReturnsCheckBox.Checked := OptimizeReturns;
- OptimizeBranchesCheckBox.Checked := OptimizeBranches;
- OptimizeMovesCheckBox.Checked := OptimizeMoves;
- OptimizeTestsCheckBox.Checked := OptimizeTests;
- OptimizeCalculationsCheckBox.Checked := OptimizeCalculations;
- RemoveUnusedSectionsCheckBox.Checked := RemoveUnusedSections;
- CutUnusedRangesCheckBox.Checked := CutUnusedRanges;
- ReorderSectionsCheckBox.Checked := ReorderSections;
- MergeConstantsCheckBox.Checked := MergeConstants;
- StdLibCheckBox.Checked := StdLib;
- InitBSSCheckBox.Checked := InitBSS;
- OutputBinCheckBox.Checked := OutputBin;
- CommandLineEdit.Text := CommandLine;
- ProcessFileEdit.Text := PostBuildProcessFile;
- InitialLibOptions := PredefinedLibOptions;
- if ShowModal = mrOK then begin
- if ArchiveRadioButton.Checked then
- ProjectTarget := ptArchive
- else if FlashOSRadioButton.Checked then
- ProjectTarget := ptFlashOS
- else if FargoRadioButton.Checked then
- ProjectTarget := ptFargo
- else
- ProjectTarget := ptRegular;
- Pack := PackCheckBox.Checked;
- PackVar := PackVarEdit.Text;
- UseDataVar := DataVarCheckBox.Checked;
- DataVar := DataVarEdit.Text;
- DataVarCopy := False;
- DataVarCopyIfArchived := False;
- if DataVarCopyAlwaysRadioButton.Checked then
- DataVarCopy := True
- else if DataVarCopyIfArchivedRadioButton.Checked then begin
- DataVarCopy := True;
- DataVarCopyIfArchived := True;
- end;
- GCCSwitches := GCCSwitchesEdit.Text;
- AsSwitches := AsSwitchesEdit.Text;
- AsmSwitches := AsmSwitchesEdit.Text;
- DebugInfo := DebugInfoCheckBox.Checked;
- OptimizeNOPs := OptimizeNOPsCheckBox.Checked;
- OptimizeReturns := OptimizeReturnsCheckBox.Checked;
- OptimizeBranches := OptimizeBranchesCheckBox.Checked;
- OptimizeMoves := OptimizeMovesCheckBox.Checked;
- OptimizeTests := OptimizeTestsCheckBox.Checked;
- OptimizeCalculations := OptimizeCalculationsCheckBox.Checked;
- RemoveUnusedSections := RemoveUnusedSectionsCheckBox.Checked;
- CutUnusedRanges := CutUnusedRangesCheckBox.Checked;
- ReorderSections := ReorderSectionsCheckBox.Checked;
- MergeConstants := MergeConstantsCheckBox.Checked;
- StdLib := StdLibCheckBox.Checked;
- InitBSS := InitBSSCheckBox.Checked;
- OutputBin := OutputBinCheckBox.Checked;
- CommandLine := CommandLineEdit.Text;
- PostBuildProcessFile := ProcessFileEdit.Text;
- if Assigned (ProgramOptionsForm) and Assigned (PredefinedLibOptions) then
- with ProgramOptionsForm, PredefinedLibOptions do begin
- CalcDests := [];
- if TI89CheckBox.Checked then
- Include (CalcDests, cdTI89);
- if TI92PlusCheckBox.Checked then
- Include (CalcDests, cdTI92Plus);
- if V200CheckBox.Checked then
- Include (CalcDests, cdV200);
- OptimizeCalcConsts := OptimizeCalcConstsCheckBox.Checked;
- if PreOsRadioButton.Checked then
- KernelFormat := kfCompressedTables
- else if DoorsRadioButton.Checked then
- KernelFormat := kfStandard
- else
- KernelFormat := kfNone;
- UseMinAMS := MinAMSCheckBox.Checked;
- if Length (MinAMSEdit.Text) > 0 then
- MinAMS := MinAMSEdit.Text;
- UnofficialOSSupport := UnofficialOSSupportCheckBox.Checked;
- if RelocKernelRadioButton.Checked then
- RelocFormat := rfKernel
- else if RelocCompressedRadioButton.Checked then
- RelocFormat := rfCompressed
- else if RelocMlinkRadioButton.Checked then
- RelocFormat := rfMlink
- else
- RelocFormat := rfAMS;
- if ROMCallKernelRadioButton.Checked then
- ROMCallFormat := rfKernel
- else if ROMCallCompressedRadioButton.Checked then
- ROMCallFormat := rfCompressed
- else if ROMCallMlinkRadioButton.Checked then
- ROMCallFormat := rfMlink
- else if ROMCallFLineRadioButton.Checked then
- ROMCallFormat := rfFLine
- else
- ROMCallFormat := rfDirect;
- if BSSKernelRadioButton.Checked then
- BSSRefFormat := rfKernel
- else if BSSCompressedRadioButton.Checked then
- BSSRefFormat := rfCompressed
- else if BSSMlinkRadioButton.Checked then
- BSSRefFormat := rfMlink
- else
- BSSRefFormat := rfNone;
- if DataVarKernelRadioButton.Checked then
- DataRefFormat := rfKernel
- else if DataVarCompressedRadioButton.Checked then
- DataRefFormat := rfCompressed
- else if DataVarMlinkRadioButton.Checked then
- DataRefFormat := rfMlink
- else
- DataRefFormat := rfNone;
- UseFLineJumps := RelocFLineJumpsCheckBox.Checked;
- Use4ByteFLineJumps := RelocFLineJumps4ByteCheckBox.Checked;
- OptimizeROMCalls := ROMCallOptimizedCheckBox.Checked;
- UseInternalFLineEmulator := InternalFLineEmulatorCheckBox.Checked;
- UseReturnValue := ReturnValueRadioButton.Checked;
- EnableErrorReturn := EnableErrorReturnCheckBox.Checked;
- SaveScreen := LCDSaveCheckBox.Checked;
- end;
- RecompileFiles;
- if not DebugInfo then
- ClearDebugInfo;
- UpdateDebugSettings;
- Modify;
- end;
- finally
- Free;
- end;
- end;
- procedure TMainForm.FilePreferences(Sender: TObject);
- var
- I: Integer;
- begin
- with TPreferencesForm.Create (Self) do try
- StopCompilationBox.Checked := StopOnErrors;
- JumpToErrorBox.Checked := JumpToError;
- OpenFolderBox.Checked := OpenFolderMessage;
- DeleteAssemblyFilesBox.Checked := DeleteAssemblyFiles;
- DeleteObjectFilesBox.Checked := DeleteObjectFiles;
- {$IFDEF CanSplit}
- SplitFilesCheckBox.Checked := SplitFiles;
- {$ENDIF}
- AutoSaveCheckBox.Checked := AutoSave;
- AutoNewsCheckBox.Checked := AutoNews;
- DeleteErrorsCheckBox.Checked := DeleteErrors;
- AllowImplicitCheckBox.Checked := not AssumeUndefined;
- FlatButtonsCheckBox.Checked := MainToolbar.Flat;
- MenuBitmapsCheckBox.Checked := Assigned (MainMenu.Images);
- case TransferTarget of
- ttVTI:
- VTIBox.Checked := True;
- ttCalc:
- RealCalcBox.Checked := True;
- else
- NoneBox.Checked := True;
- end;
- VTIPathEdit.Text := VTIPath;
- case LinkPort.PortType of
- lpCOM: begin
- case LinkPort.PortNumber of
- 1: PortCOM1Box.Checked := True;
- 2: PortCOM2Box.Checked := True;
- 3: PortCOM3Box.Checked := True;
- 4: PortCOM4Box.Checked := True;
- end;
- end;
- end;
- case LinkCable of
- lcBlack: CableBlackBox.Checked := True;
- lcGray: CableGrayBox.Checked := True;
- end;
- AsmTabSizeEdit.Text := IntToStr (TabSizeAsm);
- CTabSizeEdit.Text := IntToStr (TabSizeC);
- BackColor := EditorColor;
- ColorCheckBox.Checked := BackColor <> clWindow;
- EditorFont.Assign (MasterUnit.EditorFont);
- OnFlyCheckBox.Checked := EditorOnFly;
- DragDropEditCheckBox.Checked := EditorDragDrop;
- RemoveTrailingSpcCheckBox.Checked := EditorRemoveTrSp;
- AutoBlockCheckBox.Checked := AutoBlocks;
- SyntaxC.Assign (MasterUnit.SyntaxC);
- SyntaxAsmGNU.Assign (MasterUnit.SyntaxAsmGNU);
- if ssA68k in SpecialSupport then
- SyntaxAsm.Assign (MasterUnit.SyntaxAsm);
- if ssQuill in SpecialSupport then
- SyntaxQuill.Assign (MasterUnit.SyntaxQuill);
- if ShowModal = mrOK then begin
- Screen.Cursor := crHourGlass;
- StopOnErrors := StopCompilationBox.Checked;
- JumpToError := JumpToErrorBox.Checked;
- OpenFolderMessage := OpenFolderBox.Checked;
- DeleteAssemblyFiles := DeleteAssemblyFilesBox.Checked;
- DeleteObjectFiles := DeleteObjectFilesBox.Checked;
- {$IFDEF CanSplit}
- SplitFiles := SplitFilesCheckBox.Checked;
- {$ENDIF}
- AutoSave := AutoSaveCheckBox.Checked;
- AutoNews := AutoNewsCheckBox.Checked;
- DeleteErrors := DeleteErrorsCheckBox.Checked;
- AssumeUndefined := not AllowImplicitCheckBox.Checked;
- MainToolbar.Flat := FlatButtonsCheckBox.Checked;
- if MainToolbar.Flat then
- MainToolbar.Height := MainToolbar.ButtonHeight + 1
- else
- MainToolbar.Height := MainToolbar.ButtonHeight + 3;
- if MenuBitmapsCheckBox.Checked then
- MainMenu.Images := ToolbarImages
- else
- MainMenu.Images := nil;
- if VTIBox.Checked then
- TransferTarget := ttVTI
- else if RealCalcBox.Checked then
- TransferTarget := ttCalc
- else
- TransferTarget := ttNone;
- VTIPath := VTIPathEdit.Text;
- LinkPort.PortType := lpCOM;
- if PortCOM1Box.Checked then
- LinkPort.PortNumber := 1
- else if PortCOM2Box.Checked then
- LinkPort.PortNumber := 2
- else if PortCOM3Box.Checked then
- LinkPort.PortNumber := 3
- else if PortCOM4Box.Checked then
- LinkPort.PortNumber := 4;
- if CableBlackBox.Checked then
- LinkCable := lcBlack
- else if CableGrayBox.Checked then
- LinkCable := lcGray;
- try
- TabSizeC := StrToInt (CTabSizeEdit.Text);
- except
- TabSizeC := 2;
- end;
- try
- TabSizeAsm := StrToInt (AsmTabSizeEdit.Text);
- except
- TabSizeAsm := 2;
- end;
- if ColorCheckBox.Checked then
- EditorColor := BackColor
- else
- EditorColor := clWindow;
- MasterUnit.EditorFont.Assign (EditorFont);
- EditorOnFly := OnFlyCheckBox.Checked;
- EditorDragDrop := DragDropEditCheckBox.Checked;
- EditorRemoveTrSp := RemoveTrailingSpcCheckBox.Checked;
- AutoBlocks := AutoBlockCheckBox.Checked;
- with SourceFiles do
- for I := 0 to Count - 1 do
- if Items [I] is TTextSourceFile then
- (Items [I] as TTextSourceFile).UpdateEditor;
- if SyntaxTabClicked then begin
- MasterUnit.SyntaxC.Assign (SyntaxC);
- MasterUnit.SyntaxAsmGNU.Assign (SyntaxAsmGNU);
- MasterUnit.SyntaxAsm.Assign (SyntaxAsm);
- MasterUnit.SyntaxQuill.Assign (SyntaxQuill);
- with SourceFiles do
- for I := 0 to Count - 1 do
- if Items [I] is TSourceTextSourceFile then
- (Items [I] as TSourceTextSourceFile).UpdateSyntax;
- end;
- SavePreferences;
- UpdateDebugSettings;
- Screen.Cursor := crDefault;
- end;
- finally
- Free;
- end;
- end;
- procedure TMainForm.LoadPreferences;
- function LookBackForComponent(Stream: TMemoryStream): Integer;
- var
- I: Integer;
- P: PChar;
- begin
- Result := 0;
- with Stream do begin
- P := Memory;
- for I := Size - 3 downto 1 do
- if (P [I] = 'T') and (P [I + 1] = 'P') and (P [I + 2] = 'F') then begin
- Result := I;
- Break;
- end;
- end;
- end;
- var
- I,
- Tmp: Integer;
- L: TStringList;
- Strm: TMemoryStream;
- SyntaxCopy: TSyntaxColoringCopy;
- begin
- with TRegistry.Create do try
- if OpenKeyReadOnly (RegKey) then try
- if ValueExists ('Open File') then
- ProjectFile := ReadString ('Open File');
- if ValueExists ('Recent Files') then begin
- L := TStringList.Create;
- try
- L.CommaText := ReadString ('Recent Files');
- for I := L.Count - 1 downto 0 do
- AddToRecent (L.Strings [I]);
- finally
- L.Free;
- end;
- end;
- if ValueExists ('Stop on Errors') then
- StopOnErrors := ReadBool ('Stop on Errors');
- if ValueExists ('Jump To First Error') then
- JumpToError := ReadBool ('Jump To First Error');
- if ValueExists ('Open Folder Message') then
- OpenFolderMessage := ReadBool ('Open Folder Message');
- if ValueExists ('Delete Assembly Files') then
- DeleteAssemblyFiles := ReadBool ('Delete Assembly Files');
- if ValueExists ('Delete Object Files') then
- DeleteObjectFiles := ReadBool ('Delete Object Files');
- {$IFDEF CanSplit}
- if ValueExists ('Split Files') then
- SplitFiles := ReadBool ('Split Files');
- {$ENDIF}
- if ValueExists ('AutoSave') then
- AutoSave := ReadBool ('AutoSave');
- if ValueExists ('AutoNews') then
- AutoNews := ReadBool ('AutoNews');
- if ValueExists ('Delete Errors') then
- DeleteErrors := ReadBool ('Delete Errors');
- if ValueExists ('Assume Undefined References') then
- AssumeUndefined := ReadBool ('Assume Undefined References');
- if ValueExists ('Flat Buttons') then
- MainToolbar.Flat := ReadBool ('Flat Buttons');
- if MainToolbar.Flat then
- MainToolbar.Height := MainToolbar.ButtonHeight + 1
- else
- MainToolbar.Height := MainToolbar.ButtonHeight + 3;
- if ValueExists ('Menu Bitmaps') then begin
- if ReadBool ('Menu Bitmaps') then
- MainMenu.Images := ToolbarImages
- else
- MainMenu.Images := nil;
- end;
- if ValueExists ('Transfer Target') then
- TransferTarget := TTransferTarget (ReadInteger ('Transfer Target') + 1);
- if ValueExists ('VTI Path') then
- VTIPath := ReadString ('VTI Path');
- if ValueExists ('Link Port') then
- LinkPort.PortNumber := ReadInteger ('Link Port') and $FF;
- if ValueExists ('Link Cable') then begin
- if ReadInteger ('Link Cable') = 2 then
- LinkCable := lcGray
- else
- LinkCable := lcBlack;
- end;
- if ValueExists ('ASM Tab Size') then
- TabSizeAsm := ReadInteger ('ASM Tab Size');
- if ValueExists ('C Tab Size') then
- TabSizeC := ReadInteger ('C Tab Size');
- if ValueExists ('Editor Background Color') then
- EditorColor := ReadInteger ('Editor Background Color');
- if ValueExists ('Editor Font') then
- EditorFont.Name := ReadString ('Editor Font');
- if ValueExists ('Editor Font Style Bold') then begin
- EditorFont.Style := [];
- if ReadBool ('Editor Font Style Bold') then
- EditorFont.Style := EditorFont.Style + [fsBold];
- if ReadBool ('Editor Font Style Italic') then
- EditorFont.Style := EditorFont.Style + [fsItalic];
- if ReadBool ('Editor Font Style Underline') then
- EditorFont.Style := EditorFont.Style + [fsUnderline];
- if ReadBool ('Editor Font Style StrikeOut') then
- EditorFont.Style := EditorFont.Style + [fsStrikeOut];
- end;
- if ValueExists ('Editor Font Size') then
- EditorFont.Size := ReadInteger ('Editor Font Size');
- if ValueExists ('Editor Font Color') then
- EditorFont.Color := ReadInteger ('Editor Font Color');
- if ValueExists ('Editor Font Pitch') then
- EditorFont.Pitch := TFontPitch (ReadInteger ('Editor Font Pitch'));
- if ValueExists ('Editor Split On Fly') then
- EditorOnFly := ReadBool ('Editor Split On Fly');
- if ValueExists ('Editor Drag and Drop') then
- EditorDragDrop := ReadBool ('Editor Drag and Drop');
- if ValueExists ('Editor Remove Trailing Spaces') then
- EditorRemoveTrSp := ReadBool ('Editor Remove Trailing Spaces');
- if ValueExists ('AutoBlocks') then
- AutoBlocks := ReadBool ('AutoBlocks');
- if ValueExists ('Tree Width') then
- ProjectTree.Width := ReadInteger ('Tree Width');
- if ValueExists ('Error Window Height') then
- ErrWinPanel.Height := ReadInteger ('Error Window Height');
- if ValueExists ('Error List Message') then
- ErrorList.Columns[0].Width := ReadInteger ('Error List Message');
- if ValueExists ('Error List File') then
- ErrorList.Columns[1].Width := ReadInteger ('Error List File');
- if ValueExists ('Error List Function') then
- ErrorList.Columns[2].Width := ReadInteger ('Error List Function');
- if ValueExists ('Last News Update') then
- LastNewsDate := ReadInteger ('Last News Update');
- if ValueExists ('Proxy Name') then
- ProxyName := ReadString ('Proxy Name');
- if ValueExists ('Proxy Port') then
- ProxyPort := ReadInteger ('Proxy Port');
- Strm := TMemoryStream.Create;
- if ValueExists ('Editor C Syntax Coloring') then try
- SyntaxCopy := TSyntaxColoringCopy.Create (nil);
- try
- SyntaxCopy.Assign (SyntaxC);
- Strm.SetSize (GetDataSize ('Editor C Syntax Coloring'));
- if Strm.Size > 0 then begin
- ReadBinaryData ('Editor C Syntax Coloring', Strm.Memory^, Strm.Size);
- Strm.Position := LookBackForComponent (Strm);
- Strm.ReadComponent (SyntaxCopy);
- SyntaxC.Assign (SyntaxCopy);
- end;
- finally
- SyntaxCopy.Free;
- end;
- except end;
- if ValueExists ('Editor GNU ASM Syntax Coloring') then try
- SyntaxCopy := TSyntaxColoringCopy.Create (nil);
- try
- SyntaxCopy.Assign (SyntaxAsmGNU);
- Strm.SetSize (GetDataSize ('Editor GNU ASM Syntax Coloring'));
- if Strm.Size > 0 then begin
- ReadBinaryData ('Editor GNU ASM Syntax Coloring', Strm.Memory^, Strm.Size);
- Strm.Position := LookBackForComponent (Strm);
- Strm.ReadComponent (SyntaxCopy);
- SyntaxAsmGNU.Assign (SyntaxCopy);
- end;
- finally
- SyntaxCopy.Free;
- end;
- except end;
- if (ssA68k in SpecialSupport) and ValueExists ('Editor ASM Syntax Coloring') then try
- SyntaxCopy := TSyntaxColoringCopy.Create (nil);
- try
- SyntaxCopy.Assign (SyntaxAsm);
- Strm.SetSize (GetDataSize ('Editor ASM Syntax Coloring'));
- if Strm.Size > 0 then begin
- ReadBinaryData ('Editor ASM Syntax Coloring', Strm.Memory^, Strm.Size);
- Strm.Position := LookBackForComponent (Strm);
- Strm.ReadComponent (SyntaxCopy);
- SyntaxAsm.Assign (SyntaxCopy);
- end;
- finally
- SyntaxCopy.Free;
- end;
- except end;
- if (ssQuill in SpecialSupport) and ValueExists ('Editor Quill Syntax Coloring') then try
- SyntaxCopy := TSyntaxColoringCopy.Create (nil);
- try
- SyntaxCopy.Assign (SyntaxQuill);
- Strm.SetSize (GetDataSize ('Editor Quill Syntax Coloring'));
- if Strm.Size > 0 then begin
- ReadBinaryData ('Editor Quill Syntax Coloring', Strm.Memory^, Strm.Size);
- Strm.Position := LookBackForComponent (Strm);
- Strm.ReadComponent (SyntaxCopy);
- SyntaxQuill.Assign (SyntaxCopy);
- end;
- finally
- SyntaxCopy.Free;
- end;
- except end;
- Strm.Free;
- if ValueExists ('Tools Count') then begin
- Tmp := ReadInteger ('Tools Count');
- ToolsList.Clear;
- for I := 1 to Tmp do
- if OpenKeyReadOnly (RegKey + '\Tool ' + IntToStr (I)) then try
- ToolsLine.Visible := True;
- AddTool (ReadString ('Title'), ReadString ('Command Line'), ReadString ('Working Directory'), TWindowState (ReadInteger ('Window State')));
- except end;
- end;
- except end;
- finally
- Free;
- SplitterMoved (Self);
- end;
- with SourceFiles do
- for I := 0 to Count - 1 do begin
- if Items [I] is TTextSourceFile then
- (Items [I] as TTextSourceFile).UpdateEditor;
- if Items [I] is TSourceTextSourceFile then
- (Items [I] as TSourceTextSourceFile).UpdateSyntax;
- end;
- UpdateDebugSettings;
- end;
- procedure TMainForm.SavePreferences;
- var
- I: Integer;
- Strm: TMemoryStream;
- SyntaxCopy: TSyntaxColoringCopy;
- begin
- with TRegistry.Create do try
- if OpenKey (RegKey, True) then try
- WriteString ('Open File', ProjectFile);
- WriteString ('Recent Files', RecentFiles.CommaText);
- WriteBool ('Stop on Errors', StopOnErrors);
- WriteBool ('Jump To First Error', JumpToError);
- WriteBool ('Open Folder Message', OpenFolderMessage);
- WriteBool ('Delete Assembly Files', DeleteAssemblyFiles);
- WriteBool ('Delete Object Files', DeleteObjectFiles);
- {$IFDEF CanSplit}
- WriteBool ('Split Files', SplitFiles);
- {$ENDIF}
- WriteBool ('AutoSave', AutoSave);
- WriteBool ('AutoNews', AutoNews);
- WriteBool ('Delete Errors', DeleteErrors);
- WriteBool ('Assume Undefined References', AssumeUndefined);
- WriteBool ('Flat Buttons', MainToolbar.Flat);
- WriteBool ('Menu Bitmaps', Assigned (MainMenu.Images));
- WriteInteger ('Transfer Target', Integer (TransferTarget) - 1);
- WriteString ('VTI Path', VTIPath);
- WriteInteger ('Link Port', LinkPort.PortNumber);
- case LinkCable of
- lcBlack: WriteInteger ('Link Cable', 1);
- lcGray: WriteInteger ('Link Cable', 2);
- end;
- WriteInteger ('ASM Tab Size', TabSizeAsm);
- WriteInteger ('C Tab Size', TabSizeC);
- WriteInteger ('Editor Background Color', EditorColor);
- WriteString ('Editor Font', EditorFont.Name);
- WriteBool ('Editor Font Style Bold', fsBold in EditorFont.Style);
- WriteBool ('Editor Font Style Italic', fsItalic in EditorFont.Style);
- WriteBool ('Editor Font Style Underline', fsUnderline in EditorFont.Style);
- WriteBool ('Editor Font Style StrikeOut', fsStrikeOut in EditorFont.Style);
- WriteInteger ('Editor Font Size', EditorFont.Size);
- WriteInteger ('Editor Font Color', EditorFont.Color);
- WriteInteger ('Editor Font Pitch', Integer (EditorFont.Pitch));
- WriteBool ('Editor Split On Fly', EditorOnFly);
- WriteBool ('Editor Drag and Drop', EditorDragDrop);
- WriteBool ('Editor Remove Trailing Spaces', EditorRemoveTrSp);
- WriteBool ('AutoBlocks', AutoBlocks);
- WriteInteger ('Tree Width', ProjectTree.Width);
- WriteInteger ('Error Window Height', ErrWinPanel.Height);
- WriteInteger ('Error List Message', ErrorList.Columns[0].Width);
- WriteInteger ('Error List File', ErrorList.Columns[1].Width);
- WriteInteger ('Error List Function', ErrorList.Columns[2].Width);
- WriteInteger ('Last News Update', LastNewsDate);
- WriteString ('Proxy Name', ProxyName);
- WriteInteger ('Proxy Port', ProxyPort);
- Strm := TMemoryStream.Create;
- try
- SyntaxCopy := TSyntaxColoringCopy.Create (nil);
- try
- SyntaxCopy.Assign (SyntaxC);
- Strm.WriteComponent (SyntaxCopy);
- WriteBinaryData ('Editor C Syntax Coloring', Strm.Memory^, Strm.Size);
- finally
- SyntaxCopy.Free;
- end;
- Strm.Clear;
- SyntaxCopy := TSyntaxColoringCopy.Create (nil);
- try
- SyntaxCopy.Assign (SyntaxAsmGNU);
- Strm.WriteComponent (SyntaxCopy);
- WriteBinaryData ('Editor GNU ASM Syntax Coloring', Strm.Memory^, Strm.Size);
- finally
- SyntaxCopy.Free;
- end;
- if ssA68k in SpecialSupport then begin
- Strm.Clear;
- SyntaxCopy := TSyntaxColoringCopy.Create (nil);
- try
- SyntaxCopy.Assign (SyntaxAsm);
- Strm.WriteComponent (SyntaxCopy);
- WriteBinaryData ('Editor ASM Syntax Coloring', Strm.Memory^, Strm.Size);
- finally
- SyntaxCopy.Free;
- end;
- end;
- if ssQuill in SpecialSupport then begin
- Strm.Clear;
- SyntaxCopy := TSyntaxColoringCopy.Create (nil);
- try
- SyntaxCopy.Assign (SyntaxQuill);
- Strm.WriteComponent (SyntaxCopy);
- WriteBinaryData ('Editor Quill Syntax Coloring', Strm.Memory^, Strm.Size);
- finally
- SyntaxCopy.Free;
- end;
- end;
- finally
- Strm.Free;
- end;
- WriteInteger ('Tools Count', ToolsList.Count);
- with ToolsList do
- for I := 0 to Count - 1 do
- with TToolsListItem (Items [I]) do
- if OpenKey (RegKey + '\Tool ' + IntToStr (I + 1), True) then try
- WriteString ('Title', Title);
- WriteString ('Command Line', CommandLine);
- WriteString ('Working Directory', WorkingDir);
- WriteInteger ('Window State', Integer (WindowState));
- except end;
- except end;
- finally
- Free;
- end;
- end;
- procedure TMainForm.CompileProject;
- var
- I: Integer;
- StopIt: Boolean;
- begin
- OperationSuccessful := False;
- OperationCancelled := False;
- StopIt := True;
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- if Compilable or (Items [I] is TObjectSourceFile) then begin
- StopIt := False;
- Break;
- end;
- if not StopIt then begin
- OperationSuccessful := True;
- CopyHeaders;
- with SourceFiles do
- for I := 0 to Count - 1 do
- if (OperationSuccessful or not StopOnErrors) and not OperationCancelled then
- with Items [I] as TSourceFile do
- if Compilable and Invalidated then begin
- Compile;
- if not OperationSuccessful then
- StopIt := True;
- Application.ProcessMessages;
- end;
- DeleteHeaders;
- if StopIt then
- OperationSuccessful := False;
- end else
- ShowDefaultMessageBox ('There are no files to compile in the current project.', 'Error', mtProgramError);
- end;
- function TMainForm.GetNewFileName(const FolderPath, Ext: string): string;
- var
- I: Integer;
- begin
- if ProjectFile = '' then
- Result := 'C:\New File'
- else
- Result := WithBackslash (ExtractFilePath (ProjectFile) + FolderPath) + 'New File';
- if FileExists (Result + Ext) or Assigned (SourceFiles.FindFileWithoutExt (Result)) then begin
- I := 2;
- while FileExists (Result + ' ' + IntToStr (I) + Ext) or Assigned (SourceFiles.FindFileWithoutExt (Result + ' ' + IntToStr (I))) do
- Inc (I);
- Result := Result + ' ' + IntToStr (I);
- end;
- Result := Result + Ext;
- end;
- procedure TMainForm.FileNewHeaderFile(Sender: TObject);
- var
- O: THeaderSourceFile;
- begin
- if not Compiling then begin
- O := THeaderSourceFile.Create (SourceFiles);
- with O do begin
- Folder := GetSelectedFolder (THeaderSourceFile);
- FileName := GetNewFileName (FolderPath, '.h');
- OnError := AddError;
- TreeItem := CreateFileNode (TopNode.Item [ClassTreeIndex], O);
- with TreeItem do begin
- ImageIndex := ClassImageIndex;
- SelectedIndex := ImageIndex;
- end;
- ErrorList := Self.ErrorList;
- if Assigned (TextEditor) then
- with TextEditor do begin
- Hide;
- Parent := EditorPanel;
- Align := alClient;
- OnEnter := EditorEnter;
- OnExit := EditorExit;
- OnKeyDown := EditorKeyDown;
- OnChange := EditorChange;
- OnSelectionChange := EditorChange;
- PopupMenu := EditorPopup;
- end;
- if (Sender = ActionFileNewGNUAsmHeaderFile) or ((Sender is TMenuItem) and (TMenuItem(Sender).Action = ActionFileNewGNUAsmHeaderFile)) then
- Content := '| Header File'#13#10'| Created ' + DateToStr (Now) + '; ' + TimeToStr (Now) + #13#10
- else if (Sender = ActionFileNewA68kAsmHeaderFile) or ((Sender is TMenuItem) and (TMenuItem(Sender).Action = ActionFileNewA68kAsmHeaderFile)) then
- Content := '; Header File'#13#10'; Created ' + DateToStr (Now) + '; ' + TimeToStr (Now) + #13#10
- else
- Content := '// Header File'#13#10'// Created ' + DateToStr (Now) + '; ' + TimeToStr (Now) + #13#10;
- UpdateSyntax;
- if Assigned (TextEditor) then
- TextEditor.ClearUndo;
- Modified := False;
- Invalidate;
- SelectNode (TreeItem);
- TreeItem.EditText;
- end;
- end;
- end;
- procedure TMainForm.FileNewCSourceFile(Sender: TObject);
- const
- CodeStr = '// Place your code here.';
- var
- O: TCSourceFile;
- I,
- P: Integer;
- NewContent: string;
- FirstFile: Boolean;
- begin
- if not Compiling then begin
- FirstFile := not Assigned (SourceFiles.FindFileOfTypeInProject (TCSourceFile));
- O := TCSourceFile.Create (SourceFiles);
- with O do begin
- Folder := GetSelectedFolder (TCSourceFile);
- FileName := GetNewFileName (FolderPath, '.c');
- OnError := AddError;
- TreeItem := CreateFileNode (TopNode.Item [ClassTreeIndex], O);
- with TreeItem do begin
- ImageIndex := ClassImageIndex;
- SelectedIndex := ImageIndex;
- end;
- ErrorList := Self.ErrorList;
- if Assigned (TextEditor) then
- with TextEditor do begin
- Hide;
- Parent := EditorPanel;
- Align := alClient;
- OnEnter := EditorEnter;
- OnExit := EditorExit;
- OnKeyDown := EditorKeyDown;
- OnChange := EditorChange;
- OnSelectionChange := EditorChange;
- PopupMenu := EditorPopup;
- end;
- NewContent := '// C Source File'#13#10'// Created ' + DateToStr (Now) + '; ' + TimeToStr (Now) + #13#10;
- case ProjectTarget of
- ptRegular: begin
- if FirstFile then begin
- NewContent := NewContent + #13#10
- + '// Delete or comment out the items you do not need.'#13#10
- + '#define COMMENT_STRING "Place your comment here."'#13#10
- + '#define COMMENT_PROGRAM_NAME "Place your program name here."'#13#10
- + '#define COMMENT_VERSION_STRING "Place your version string here."'#13#10
- + '#define COMMENT_VERSION_NUMBER 0,0,0,0 /* major, minor, revision, subrevision */'#13#10
- + '#define COMMENT_AUTHORS "Place your author name(s) here."'#13#10
- + '#define COMMENT_BW_ICON \'#13#10
- + #9'{0b0000000000000000, \'#13#10;
- for I := 1 to 14 do
- NewContent := NewContent
- + #9' 0b0000000000000000, \'#13#10;
- NewContent := NewContent
- + #9' 0b0000000000000000}'#13#10
- + '#define COMMENT_GRAY_ICON \'#13#10
- + #9'{0b0000000000000000, \'#13#10;
- for I := 1 to 14 do
- NewContent := NewContent
- + #9' 0b0000000000000000, \'#13#10;
- NewContent := NewContent
- + #9' 0b0000000000000000}, \'#13#10
- + #9'{0b0000000000000000, \'#13#10;
- for I := 1 to 14 do
- NewContent := NewContent
- + #9' 0b0000000000000000, \'#13#10;
- NewContent := NewContent
- + #9' 0b0000000000000000}'#13#10;
- end;
- NewContent := NewContent + #13#10'#include <tigcclib.h>'#13#10;
- end;
- ptArchive:
- NewContent := NewContent + #13#10'#define _GENERIC_ARCHIVE'#13#10'#include <tigcclib.h>'#13#10;
- end;
- if FirstFile and (not (ProjectTarget in [ptFlashOS, ptArchive])) then
- NewContent := NewContent + #13#10'// Main Function'#13#10'void _main(void)'#13#10
- + '{'#13#10
- + #9 + CodeStr + #13#10
- + '}'#13#10;
- if Assigned (TextEditor) then
- TextEditor.AllowUndo := False;
- Content := NewContent;
- if Assigned (TextEditor) then begin
- TextEditor.AllowUndo := True;
- P := Pos (CodeStr, TextEditor.Text);
- if P > 0 then
- with TextEditor.Selection do begin
- RStart := P;
- RLength := Length (CodeStr);
- end;
- end;
- Modified := False;
- Invalidate;
- SelectNode (TreeItem);
- TreeItem.EditText;
- end;
- end;
- end;
- procedure TMainForm.FileNewGNUAssemblerSourceFile(Sender: TObject);
- var
- O: TGNUAsmSourceFile;
- begin
- if not Compiling then begin
- O := TGNUAsmSourceFile.Create (SourceFiles);
- with O do begin
- Folder := GetSelectedFolder (TGNUAsmSourceFile);
- FileName := GetNewFileName (FolderPath, '.s');
- OnError := AddError;
- TreeItem := CreateFileNode (TopNode.Item [ClassTreeIndex], O);
- with TreeItem do begin
- ImageIndex := ClassImageIndex;
- SelectedIndex := ImageIndex;
- end;
- ErrorList := Self.ErrorList;
- if Assigned (TextEditor) then
- with TextEditor do begin
- Hide;
- Parent := EditorPanel;
- Align := alClient;
- OnEnter := EditorEnter;
- OnExit := EditorExit;
- OnKeyDown := EditorKeyDown;
- OnChange := EditorChange;
- OnSelectionChange := EditorChange;
- PopupMenu := EditorPopup;
- end;
- Content := '| Assembly Source File'#13#10'| Created ' + DateToStr (Now) + '; ' + TimeToStr (Now) + #13#10;
- if Assigned (TextEditor) then
- TextEditor.ClearUndo;
- Modified := False;
- Invalidate;
- SelectNode (TreeItem);
- TreeItem.EditText;
- end;
- end;
- end;
- procedure TMainForm.FileNewAssemblerSourceFile(Sender: TObject);
- var
- O: TAsmSourceFile;
- begin
- if not Compiling then begin
- O := TAsmSourceFile.Create (SourceFiles);
- with O do begin
- Folder := GetSelectedFolder (TAsmSourceFile);
- FileName := GetNewFileName (FolderPath, '.asm');
- OnError := AddError;
- TreeItem := CreateFileNode (TopNode.Item [ClassTreeIndex], O);
- with TreeItem do begin
- ImageIndex := ClassImageIndex;
- SelectedIndex := ImageIndex;
- end;
- ErrorList := Self.ErrorList;
- if Assigned (TextEditor) then
- with TextEditor do begin
- Hide;
- Parent := EditorPanel;
- Align := alClient;
- OnEnter := EditorEnter;
- OnExit := EditorExit;
- OnKeyDown := EditorKeyDown;
- OnChange := EditorChange;
- OnSelectionChange := EditorChange;
- PopupMenu := EditorPopup;
- end;
- Content := '; Assembly Source File'#13#10'; Created ' + DateToStr (Now) + ', ' + TimeToStr (Now) + #13#10;
- if Assigned (TextEditor) then
- TextEditor.ClearUndo;
- Modified := False;
- Invalidate;
- SelectNode (TreeItem);
- TreeItem.EditText;
- end;
- end;
- end;
- procedure TMainForm.FileNewQuillSourceFile(Sender: TObject);
- var
- O: TQuillSourceFile;
- begin
- if not Compiling then begin
- if Assigned (SourceFiles.FindFileOfTypeInProject (TQuillSourceFile)) then
- ShowDefaultMessageBox ('There may be only one Quill source file in each project.', 'Quill Error', mtProgramError)
- else begin
- O := TQuillSourceFile.Create (SourceFiles);
- with O do begin
- Folder := GetSelectedFolder (TQuillSourceFile);
- FileName := GetNewFileName (FolderPath, '.qll');
- OnError := AddError;
- TreeItem := CreateFileNode (TopNode.Item [ClassTreeIndex], O);
- with TreeItem do begin
- ImageIndex := ClassImageIndex;
- SelectedIndex := ImageIndex;
- end;
- ErrorList := Self.ErrorList;
- if Assigned (TextEditor) then
- with TextEditor do begin
- Hide;
- Parent := EditorPanel;
- Align := alClient;
- OnEnter := EditorEnter;
- OnExit := EditorExit;
- OnKeyDown := EditorKeyDown;
- OnChange := EditorChange;
- OnSelectionChange := EditorChange;
- PopupMenu := EditorPopup;
- end;
- if FileExists (WithBackslash (TIGCCFolder) + QuillIncludeLocation + 'Template.qll') then
- LoadFromFile (WithBackslash (TIGCCFolder) + QuillIncludeLocation + 'Template.qll')
- else if FileExists (WithBackslash (TIGCCFolder) + CIncludeLocation + 'Template.qll') then
- LoadFromFile (WithBackslash (TIGCCFolder) + CIncludeLocation + 'Template.qll')
- else if FileExists (WithBackslash (TIGCCFolder) + GCCLocation + 'Template.qll') then
- LoadFromFile (WithBackslash (TIGCCFolder) + GCCLocation + 'Template.qll');
- Content := '// Quill Source File'#13#10'// Created ' + DateToStr (Now) + '; ' + TimeToStr (Now) + #13#10#13#10 + Content;
- if Assigned (TextEditor) then
- TextEditor.ClearUndo;
- Modified := False;
- Invalidate;
- SelectNode (TreeItem);
- TreeItem.EditText;
- end;
- end;
- end;
- end;
- procedure TMainForm.FileNewTextFile(Sender: TObject);
- var
- O: TNormalTextSourceFile;
- begin
- O := TNormalTextSourceFile.Create (SourceFiles);
- with O do begin
- Folder := GetSelectedFolder (TTextSourceFile);
- FileName := GetNewFileName (FolderPath, '.txt');
- OnError := AddError;
- TreeItem := CreateFileNode (TopNode.Item [ClassTreeIndex], O);
- with TreeItem do begin
- ImageIndex := ClassImageIndex;
- SelectedIndex := ImageIndex;
- end;
- ErrorList := Self.ErrorList;
- if Assigned (TextEditor) then
- with TextEditor do begin
- Hide;
- Parent := EditorPanel;
- Align := alClient;
- OnEnter := EditorEnter;
- OnExit := EditorExit;
- OnKeyDown := EditorKeyDown;
- OnChange := EditorChange;
- OnSelectionChange := EditorChange;
- PopupMenu := EditorPopup;
- end;
- if Assigned (TextEditor) then
- TextEditor.ClearUndo;
- Modified := False;
- SelectNode (TreeItem);
- TreeItem.EditText;
- end;
- end;
- procedure TMainForm.TreeItemSaveAs(Sender: TObject);
- var
- Node: TTreeNode;
- begin
- Node := ProjectTree.Selected;
- if Assigned (Node) and Assigned (Node.Data) and (TObject (Node.Data) is TSourceFile) then begin
- TSourceFile(Node.Data).SaveAs;
- Modify;
- UpdateStatusBar;
- end;
- end;
- procedure TMainForm.BeginCompilation;
- var
- I: Integer;
- begin
- ClearErrors;
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- if not InProject then begin
- RecompileFiles;
- Break;
- end;
- OperationCancelled := False;
- OperationSuccessful := False;
- end;
- procedure TMainForm.EndCompilation;
- begin
- CompStop;
- Application.Restore;
- UpdateErrorWindow;
- ShowErrors;
- end;
- procedure TMainForm.HelpAbout(Sender: TObject);
- begin
- with TAboutForm.Create (Self) do try
- ShowModal;
- finally
- Free;
- end;
- end;
- procedure TMainForm.DisplayHint(Sender: TObject);
- begin
- with StatusBar.Panels do begin
- BeginUpdate;
- with Items [0] do begin
- if Application.Hint = '' then
- Width := 0
- else
- Width := 1000000;
- Text := Application.Hint;
- end;
- EndUpdate;
- end;
- end;
- procedure TMainForm.ShowHideErrors(Sender: TObject);
- begin
- with ActionProjectShowErrors do begin
- if Checked then
- HideErrors
- else
- ShowErrors;
- end;
- end;
- procedure TMainForm.UpdateEditButtons;
- var
- TextSel: Boolean;
- Editor: TMemoComponent;
- begin
- Editor := CurrentEditor;
- if Assigned (Editor) then begin
- TextSel := (Editor.SelLength > 0) and (ActiveControl = Editor);
- ActionEditDelete.Enabled := TextSel;
- ActionEditCut.Enabled := TextSel;
- ActionEditCopy.Enabled := TextSel;
- ActionEditUndo.Enabled := (ActiveControl = Editor) and Editor.CanUndo;
- ActionEditRedo.Enabled := (ActiveControl = Editor) and Editor.CanRedo;
- end;
- end;
- procedure TMainForm.RecompileFiles;
- var
- I: Integer;
- begin
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- if Items [I] is THeaderSourceFile then
- Invalidated := False
- else if Compilable then
- Invalidate;
- end;
- procedure TMainForm.FindString(Sender: TObject; AllFiles: Boolean);
- var
- P: Integer;
- S,
- T: string;
- Valid: Boolean;
- FPos: Integer;
- Editor: TMemoComponent;
- NewSelection: TTreeNode;
- FirstFile: Boolean;
- begin
- NewSelection := ProjectTree.Selected;
- if not Assigned (NewSelection) then
- NewSelection := TopNode;
- Valid := False;
- FirstFile := True;
- repeat
- if Assigned (NewSelection.Data) and (TObject (NewSelection.Data) is TSourceFile) then
- if TSourceFile (NewSelection.Data) is TTextSourceFile then begin
- Editor := TTextSourceFile(NewSelection.Data).TextEditor;
- if Assigned (Editor) then begin
- with Sender as TFindDialog do begin
- if (frFindNext in Options) and FirstFile then
- P := Editor.Selection.REnd
- else
- if frDown in Options then
- P := 0
- else
- P := Length (Editor.Text);
- repeat
- if frDown in Options then
- T := Copy (Editor.Text, P + 1, Length (Editor.Text))
- else
- T := Copy (Editor.Text, 1, P - 1);
- if frMatchCase in Options then
- S := FindText
- else begin
- S := UpperCase (FindText);
- T := UpperCase (T);
- end;
- if frDown in Options then
- FPos := Pos (S, T)
- else
- FPos := LastPos (S, T);
- if FPos > 0 then begin
- Valid := True;
- if frWholeWord in Options then begin
- if ((FPos > 1) and (T <> '') and (T [FPos - 1] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$'])) then
- Valid := False;
- if ((FPos + Length (S) < Length (T)) and (T <> '') and (T [FPos + Length (S)] in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$'])) then
- Valid := False;
- end;
- if not (frDown in Options) then
- P := 0;
- if not Valid then
- Inc (P, FPos);
- end;
- until Valid or (FPos <= 0);
- if Valid then begin
- SelectNode (NewSelection);
- with Editor do begin
- with Selection do begin
- DoChanging;
- RStart := P + FPos;
- RLength := Length (S);
- DoChange;
- ScrollInView (2);
- end;
- end;
- end;
- end;
- end;
- end;
- if AllFiles and (not Valid) then begin
- if frDown in (Sender as TFindDialog).Options then begin
- NewSelection := NewSelection.GetNext;
- if not Assigned (NewSelection) then
- NewSelection := TopNode;
- end else begin
- NewSelection := NewSelection.GetPrev;
- if not Assigned (NewSelection) then begin
- NewSelection := TopNode;
- while NewSelection.Count > 0 do
- NewSelection := NewSelection.Item [NewSelection.Count - 1];
- end;
- end;
- FirstFile := False;
- end;
- until (not AllFiles) or Valid or (NewSelection = ProjectTree.Selected);
- if not Valid then
- Abort;
- end;
- procedure TMainForm.ReplaceDlgReplace(Sender: TObject);
- var
- Editor: TMemoComponent;
- begin
- Editor := CurrentEditor;
- if Assigned (Editor) then
- with Sender as TReplaceDialog do
- if (frReplace in Options) or (frReplaceAll in Options) then
- repeat
- if UpperCase (Editor.Selection.Text) = UpperCase (FindText) then
- Editor.Selection.Text := ReplaceText;
- Options := Options + [frFindNext];
- FindString (Sender, False);
- until not (frReplaceAll in Options);
- end;
- procedure TMainForm.FindText(Sender: TObject);
- begin
- try
- if Assigned (CurrentEditor) then
- if CurrentEditor.Selection.RLength > 0 then
- FindDlg.FindText := CurrentEditor.Selection.Text;
- FindDlg.Execute;
- except end;
- end;
- procedure TMainForm.ReplaceText(Sender: TObject);
- begin
- try
- if Assigned (CurrentEditor) then
- if CurrentEditor.Selection.RLength > 0 then begin
- ReplaceDlg.FindText := CurrentEditor.Selection.Text;
- ReplaceDlg.ReplaceText := ReplaceDlg.FindText;
- end;
- ReplaceDlg.Execute;
- except end;
- end;
- procedure TMainForm.FindOpenFile(Sender: TObject);
- var
- I: Integer;
- S: string;
- QuotesInLine: Boolean;
- SelectedNode: TTreeNode;
- SourceFile: TSourceFile;
- Editor: TMemoComponent;
- begin
- Editor := CurrentEditor;
- if Assigned (Editor) then begin
- QuotesInLine := Pos ('"', Editor.Lines [Editor.Selection.StartRowCol.Row - 1]) > 0;
- S := '';
- for I := Editor.Selection.RStart - 1 downto 1 do begin
- if (not QuotesInLine) and (Editor.Text [I] = ' ') then
- Break;
- if Editor.Text [I] in [' ', 'A'..'Z', 'a'..'z', '0'..'9', '_', '-', '.', '\', ':'] then
- S := Editor.Text [I] + S
- else
- Break;
- end;
- for I := Editor.Selection.RStart to Length (Editor.Text) do begin
- if (not QuotesInLine) and (Editor.Text [I] = ' ') then
- Break;
- if Editor.Text [I] in [' ', 'A'..'Z', 'a'..'z', '0'..'9', '_', '-', '.', '\', ':'] then
- S := S + Editor.Text [I]
- else
- Break;
- end;
- S := Trim (S);
- if Length (S) > 0 then begin
- SourceFile := SourceFiles.FindFileNameOnly (S);
- if Assigned (SourceFile) then
- SourceFile.Edit
- else begin
- SelectedNode := ProjectTree.Selected;
- if Assigned (SelectedNode) and (TObject (SelectedNode.Data) is TSourceFile) then
- SourceFile := TSourceFile (SelectedNode.Data);
- if FileExists (ExpandFileName (S)) then
- AddSourceFile (ExpandFileName (S), True)
- else if Assigned (SourceFile) and (SourceFile is TGNUAsmSourceFile) and FileExists (WithBackslash (TIGCCFolder) + GASIncludeLocation + S) then
- AddSourceFile (WithBackslash (TIGCCFolder) + GASIncludeLocation + S, True)
- else if Assigned (SourceFile) and (SourceFile is TAsmSourceFile) and FileExists (WithBackslash (TIGCCFolder) + ASMIncludeLocation + S) then
- AddSourceFile (WithBackslash (TIGCCFolder) + ASMIncludeLocation + S, True)
- else if FileExists (WithBackslash (TIGCCFolder) + CIncludeLocation + S) then
- AddSourceFile (WithBackslash (TIGCCFolder) + CIncludeLocation + S, True)
- else
- ShowDefaultMessageBox ('File ''' + S + ''' not found.', 'Search Failed', mtProgramError);
- end;
- end;
- end;
- end;
- procedure TMainForm.FindDlgFind(Sender: TObject);
- begin
- try
- FindString (Sender, True);
- except
- ShowDefaultMessageBox ('Text ''' + (Sender as TFindDialog).FindText + ''' not found.', 'Search Failed', mtProgramError);
- end;
- end;
- procedure TMainForm.ActionsExecute(Action: TBasicAction;
- var Handled: Boolean);
- begin
- Application.ProcessMessages;
- Handled := False;
- end;
- procedure TMainForm.ProjectTreeEnter(Sender: TObject);
- begin
- ActionEditDelete.Enabled := Assigned (ProjectTree.Selected) and Assigned (ProjectTree.Selected.Data);
- end;
- procedure TMainForm.ProjectTreeExit(Sender: TObject);
- begin
- ActionEditDelete.Enabled := False;
- end;
- procedure TMainForm.ProjectTreeChanging(Sender: TObject; Node: TTreeNode;
- var AllowChange: Boolean);
- begin
- if not NoHideEditor then begin
- if Assigned (EditorToHide) then
- EditorToHide.Hide;
- if (not Closing) and Assigned (PreviousNode) and Assigned (PreviousNode.Data) and (TObject (PreviousNode.Data) is TSourceFile) then
- EditorToHide := TSourceFile(PreviousNode.Data).Editor
- else
- EditorToHide := NoEditor;
- end;
- end;
- procedure TMainForm.EditorChange(Sender: TObject);
- begin
- if ActiveControl = Sender then
- UpdateEditButtons;
- UpdateStatusBar;
- end;
- procedure TMainForm.FilePrint(Sender: TObject);
- var
- Node: TTreeNode;
- Cp: Integer;
- begin
- Node := ProjectTree.Selected;
- if Assigned (Node) and Assigned (Node.Data) and (TObject (Node.Data) is TSourceFile) and (Printer.Printers.Count > 0) then try
- PrintDlg.PrintRange := prAllPages;
- PrintDlg.MaxPage := TSourceFile(Node.Data).CountPages;
- PrintDlg.ToPage := PrintDlg.MaxPage;
- if Assigned (CurrentEditor) then begin
- if CurrentEditor.Selection.RLength > 0 then
- PrintDlg.Options := PrintDlg.Options + [poSelection]
- else
- PrintDlg.Options := PrintDlg.Options - [poSelection];
- end;
- if Assigned (Sender) then begin
- if not PrintDlg.Execute then
- Abort;
- Cp := PrintDlg.Copies;
- if Cp < 1 then
- Cp := 1;
- end else
- Cp := 1;
- TSourceFile(Node.Data).Print (Cp, PrintDlg.PrintRange, PrintDlg.FromPage, PrintDlg.ToPage);
- except
- Abort;
- end;
- end;
- procedure TMainForm.FilePrintQuickly(Sender: TObject);
- begin
- FilePrint (nil);
- end;
- procedure TMainForm.TreeItemRename(Sender: TObject);
- begin
- if Assigned (ProjectTree.Selected) then
- ProjectTree.Selected.EditText;
- end;
- procedure TMainForm.HelpContents(Sender: TObject);
- begin
- try
- DocFile.DisplayContentsTab;
- except
- ShowDefaultMessageBox ('Error opening documentation.', 'Error', mtProgramError);
- end;
- end;
- procedure TMainForm.HelpIndex(Sender: TObject);
- begin
- try
- DocFile.DisplayIndexTab;
- except
- ShowDefaultMessageBox ('Error opening documentation.', 'Error', mtProgramError);
- end;
- end;
- procedure TMainForm.HelpSearch(Sender: TObject);
- begin
- try
- DocFile.DisplaySearchTab;
- except
- ShowDefaultMessageBox ('Error opening documentation.', 'Error', mtProgramError);
- end;
- end;
- procedure TMainForm.SplitterMoved(Sender: TObject);
- begin
- StatusBar.Panels[1].Width := ProjectTree.Width;
- Update;
- end;
- procedure TMainForm.UpdateStatusBar;
- var
- S: string;
- I: Integer;
- Total: Integer;
- Cell: TTextCell;
- Node,
- ClassNode: TTreeNode;
- begin
- with StatusBar.Panels do begin
- Total := 0;
- Node := TopNode;
- while Assigned (Node) do begin
- if Assigned (Node.Data) and (TObject (Node.Data) is TSourceFile) then
- Inc (Total);
- Node := Node.GetNext;
- end;
- S := IntToStr (Total) + ' File';
- if Total <> 1 then
- S := S + 's';
- S := S + ' Total';
- if Assigned (ProjectTree.Selected) then begin
- ClassNode := GetSourceTypeFolder (ProjectTree.Selected);
- if Assigned (ClassNode) then begin
- Total := 0;
- Node := ClassNode;
- while Assigned (Node) and (Node <> ClassNode.GetNextSibling) do begin
- if Assigned (Node.Data) and (TObject (Node.Data) is TSourceFile) then
- Inc (Total);
- Node := Node.GetNext;
- end;
- S := S + ', ' + IntToStr (Total) + ' in Category';
- end;
- end;
- if Items[1].Text <> S then
- Items[1].Text := S;
- if Assigned (CurrentEditor) then begin
- with CurrentEditor do begin
- if Enabled then begin
- if Selection.RLength > 0 then begin
- I := Selection.RLength + Selection.StartRowCol.Row - Selection.EndRowCol.Row;
- if Selection.EndRowCol.Col > LineLength [Selection.EndRowCol.Row] then
- Dec (I);
- S := IntToStr (I);
- if Items[3].Text <> S then
- Items[3].Text := S;
- if Items[4].Text <> '' then
- Items[4].Text := '';
- if Items[3].Width <> 60 then
- Items[3].Width := 60;
- if Items[4].Width <> 0 then
- Items[4].Width := 0;
- end else begin
- Cell := Selection.StartRowCol;
- S := IntToStr (Cell.Row);
- if Items[3].Text <> S then
- Items[3].Text := S;
- S := IntToStr (Cell.Col);
- if Items[4].Text <> S then
- Items[4].Text := S;
- if Items[3].Width <> 30 then
- Items[3].Width := 30;
- if Items[4].Width <> 30 then
- Items[4].Width := 30;
- end;
- I := TextLength - LineCount + 1;
- S := IntToStr (I) + ' Character';
- if I <> 1 then
- S := S + 's';
- if Items[11].Text <> S then
- Items[11].Text := S;
- if Items[10].Width <> 1 then
- Items[10].Width := 1;
- if Items[11].Width <> 93 then
- Items[11].Width := 93;
- if Items[12].Width <> 1 then
- Items[12].Width := 1;
- end;
- end;
- end else begin
- if Items[3].Text <> '' then
- Items[3].Text := '';
- if Items[4].Text <> '' then
- Items[4].Text := '';
- if Items[11].Text <> '' then
- Items[11].Text := '';
- if Items[3].Width <> 0 then
- Items[3].Width := 0;
- if Items[4].Width <> 0 then
- Items[4].Width := 0;
- if Items[10].Width <> 0 then
- Items[10].Width := 0;
- if Items[11].Width <> 0 then
- Items[11].Width := 0;
- if Items[12].Width <> 0 then
- Items[12].Width := 0;
- end;
- Node := ProjectTree.Selected;
- S := '';
- if Assigned (Node) then begin
- if Assigned (Node.Data) and (TObject (Node.Data) is TSourceFile) then begin
- with TSourceFile (Node.Data) do
- if (ProjectFile = '') and (ExtractFilePath (FileName) = 'C:\') then
- S := LogicalFileName
- else
- S := FileName;
- end else
- if Node = TopNode then
- S := ProjectFile;
- end;
- if Items[13].Text <> S then
- Items[13].Text := S;
- end;
- Update;
- end;
- procedure TMainForm.ProjectTreeMouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- if Button = mbRight then
- SelectNode (ProjectTree.GetNodeAt (X, Y));
- end;
- procedure TMainForm.SetModified(const Value: Boolean);
- begin
- FModified := Value;
- UpdateStatusBar;
- if Value then
- Invalidated := True;
- end;
- procedure TMainForm.ToolBarManagerBandMove(Sender: TObject;
- Control: TControl; var ARect: TRect);
- begin
- Update;
- end;
- procedure TMainForm.ProjectTreeDragOver(Sender, Source: TObject; X,
- Y: Integer; State: TDragState; var Accept: Boolean);
- var
- S,
- D: TTreeNode;
- SameType,
- FolderDest: Boolean;
- begin
- Accept := False;
- with ProjectTree do begin
- S := Selected;
- if Assigned (S) and Assigned (S.Data) then begin
- D := GetNodeAt (X, Y);
- if Assigned (D) and (D <> TopNode) and (D <> S) and (D <> S.Parent) then begin
- SameType := (GetSourceTypeFolder (S) = GetSourceTypeFolder (D));
- FolderDest := (not Assigned (D.Data)) or (TObject (D.Data) is TFolder);
- if TObject (S.Data) is TSourceFile then
- Accept := SameType or FolderDest
- else
- Accept := SameType and FolderDest;
- end;
- end;
- end;
- end;
- procedure TMainForm.ProjectTreeDragDrop(Sender, Source: TObject; X,
- Y: Integer);
- var
- S,
- D: TTreeNode;
- FN: string;
- F: TSourceFile;
- Folder: TFolder;
- begin
- with ProjectTree do begin
- S := Selected;
- if Assigned (S) and Assigned (S.Data) then begin
- D := GetNodeAt (X, Y);
- if Assigned (D) and (D <> TopNode) then begin
- // Handle moving within one type.
- if GetSourceTypeFolder (S) = GetSourceTypeFolder (D) then begin
- // Handle moving to a different folder.
- if (not Assigned (D.Data)) or (TObject (D.Data) is TFolder) then begin
- S.MoveTo (D, naAddChild);
- if TObject (S.Data) is TSourceFile then
- with TSourceFile (S.Data) do begin
- Folder := D.Data;
- Invalidate;
- end;
- // Handle moving within one folder.
- end else begin
- if (S <> D) and (S.Parent = D.Parent) then begin
- if D.Index > S.Index then begin
- if D.GetNextSibling <> nil then
- S.MoveTo (D.GetNextSibling, naInsert)
- else
- S.MoveTo (D, naAdd);
- end else
- S.MoveTo (D, naInsert);
- end;
- end;
- Modify;
- // Handle moving to a different type.
- end else begin
- if S.Parent <> D then begin
- if TObject (S.Data) is TSourceFile then begin
- with TSourceFile (S.Data) do begin
- if FileExists (FileName) then
- WarnIfModified
- else
- Save;
- FN := FileName;
- end;
- S.Delete;
- Folder := nil;
- if Assigned (D.Data) and (TObject (D.Data) is TFolder) then
- Folder := D.Data;
- D := GetSourceTypeFolder (D);
- if Assigned (D) then begin
- F := AddSourceFile (FN, False, TSourceFile.GetAppropriateClassFromTreeIndex (D.Index), Folder);
- if Assigned (F) and Assigned (F.TreeItem) then
- SelectNode (F.TreeItem);
- end;
- RecompileFiles;
- Modify;
- end;
- end;
- end;
- end;
- if Assigned (CurrentEditor) then
- CurrentEditor.Refresh;
- SortFiles;
- end;
- end;
- end;
- procedure TMainForm.ErrorListClick(Sender: TObject);
- begin
- if Enabled and Assigned (ErrorList.Selected) and (ErrorList.SelCount = 1) then
- TFoundError(ErrorList.Selected.Data).GoToPosition;
- end;
- function TMainForm.GetCurrentEditor: TMemoComponent;
- var
- Node: TTreeNode;
- begin
- Node := ProjectTree.Selected;
- if Assigned (Node) and Assigned (Node.Data) and (TObject (Node.Data) is TTextSourceFile) then
- Result := TTextSourceFile(Node.Data).TextEditor
- else
- Result := nil;
- end;
- procedure TMainForm.DeleteError(Sender: TObject);
- var
- I: Integer;
- begin
- if DeleteErrors then begin
- with ErrorList.Items do
- for I := Count - 1 downto 0 do
- if Assigned (Item[I].Data) then
- with TFoundError (Item[I].Data) do
- if Range = Sender then
- Item[I].Delete;
- UpdateErrorWindow;
- end;
- end;
- procedure TMainForm.UpdateFuncs;
- var
- Node: TTreeNode;
- begin
- Node := ProjectTree.Selected;
- if Assigned (Node) and Assigned (Node.Data) and (TObject (Node.Data) is TSourceTextSourceFile) then
- with TSourceTextSourceFile (Node.Data) do
- Funcs := GetFunctions
- else
- SetLength (Funcs, 0);
- end;
- procedure TMainForm.FunctionPopupPopup(Sender: TObject);
- var
- I,
- P: Integer;
- M: TMenuItem;
- begin
- with (Sender as TPopupMenu).Items do begin
- for I := Count - 1 downto 0 do
- Remove (Items [I]);
- UpdateFuncs;
- for I := Low (Funcs) to High (Funcs) do begin
- M := TMenuItem.Create (Self);
- with M do begin
- Tag := I;
- Caption := Funcs[I].Name;
- OnClick := FindFunctionFromPopup;
- end;
- P := Pos ('main', Funcs[I].Name);
- if (P <> 0) and (P = Length (Funcs[I].Name) - Length ('main') + 1) then
- Insert (0, M)
- else
- Add (M);
- end;
- if Count <= 0 then
- Add (NoFunctionsItem);
- end;
- end;
- procedure TMainForm.FindFunctions(Sender: TObject);
- var
- I: Integer;
- Editor: TMemoComponent;
- begin
- UpdateFuncs;
- with TFunctionsForm.Create (Self) do try
- Funcs := @Self.Funcs;
- with FuncList.Items do begin
- BeginUpdate;
- Clear;
- for I := Low (Self.Funcs) to High (Self.Funcs) do
- AddObject (Self.Funcs[I].Name, TObject (I));
- EndUpdate;
- end;
- FuncListClick (FuncList);
- case ShowModal of
- mrYes: begin
- Editor := CurrentEditor;
- if Assigned (Editor) then begin
- Editor.Selection.NoSelAtPos (Editor.CellToCharIdx (TextCell (Self.Funcs[Integer(FuncList.Items.Objects[FuncList.ItemIndex])].PrototypeLine, 1)));
- Editor.Selection.ScrollInView (5);
- end;
- end;
- mrNo: begin
- Editor := CurrentEditor;
- if Assigned (Editor) then begin
- Editor.Selection.NoSelAtPos (Editor.CellToCharIdx (TextCell (Self.Funcs[Integer(FuncList.Items.Objects[FuncList.ItemIndex])].ImplementationLine, 1)));
- Editor.Selection.ScrollInView (5);
- end;
- end;
- end;
- with FuncList.Items do begin
- BeginUpdate;
- for I := Count - 1 downto 0 do begin
- Objects [I] := nil;
- Delete (I);
- end;
- EndUpdate;
- end;
- finally
- Free;
- end;
- end;
- procedure TMainForm.FindFunctionFromPopup(Sender: TObject);
- var
- L: Integer;
- Editor: TMemoComponent;
- begin
- if Sender is TMenuItem then
- with Sender as TMenuItem do begin
- if Funcs[Tag].ImplementationLine > 0 then
- L := Funcs[Tag].ImplementationLine
- else
- L := Funcs[Tag].PrototypeLine;
- if L > 0 then begin
- Editor := CurrentEditor;
- if Assigned (Editor) then begin
- Editor.Selection.NoSelAtPos (Editor.CellToCharIdx (TextCell (L, 1)));
- Editor.Selection.ScrollInView (5);
- if Editor.Visible and Editor.Enabled then
- ActiveControl := Editor;
- end;
- end;
- end;
- end;
- procedure TMainForm.IncreaseIndent(Sender: TObject);
- var
- Editor: TMemoComponent;
- begin
- Editor := CurrentEditor;
- if Assigned (Editor) then
- Editor.ChangeIndent (1);
- end;
- procedure TMainForm.DecreaseIndent(Sender: TObject);
- var
- Editor: TMemoComponent;
- begin
- Editor := CurrentEditor;
- if Assigned (Editor) then
- Editor.ChangeIndent (-1);
- end;
- procedure TMainForm.SortFiles;
- var
- CurFileIndex: Integer;
- procedure DoSortFiles(Node: TTreeNode);
- var
- I: Integer;
- begin
- with Node do begin
- if Assigned (Data) and (TObject (Data) is TSourceFile) then begin
- with TSourceFile (Data) do
- if Index > CurFileIndex then
- Index := CurFileIndex;
- Inc (CurFileIndex);
- end;
- for I := 0 to Count - 1 do
- DoSortFiles (Item [I]);
- end;
- end;
- var
- I: Integer;
- begin
- CurFileIndex := 0;
- { This is supposed to be: DoSortFiles (TopNode);
- However, header files are dependent on the other
- files and therefore have to be put after all the
- others. }
- with TopNode do begin
- for I := 0 to Count - 1 do
- if I <> THeaderSourceFile.GetClassTreeIndex then
- DoSortFiles (Item [I]);
- if Count > THeaderSourceFile.GetClassTreeIndex then
- DoSortFiles (Item [THeaderSourceFile.GetClassTreeIndex]);
- end;
- end;
- procedure TMainForm.AppCompSetMessage(const Msg: string);
- begin
- with StatusBar do
- Panels.Items[6].Text := Msg + '...';
- if not Compiling then begin
- Compiling := True;
- CompUpdate;
- UpdateDebugSettings;
- with StatusBar.Panels do begin
- Items[5].Width := 5;
- Items[6].Width := 180;
- Items[7].Width := 100;
- Items[8].Width := 100;
- Items[9].Width := 1000000;
- end;
- end;
- end;
- procedure TMainForm.AppCompStartFile;
- var
- I: Integer;
- begin
- Application.Hint := '';
- CompFinishAndStop := False;
- CompStopNow := False;
- CompFileStartTime := Now;
- CompLastTime := 0;
- if not Compiling then begin
- CompStartTime := CompFileStartTime;
- ToolBarNewButton.Enabled := False;
- MenuFileNew.Enabled := False;
- ActionFileOpen.Enabled := False;
- ActionFileExit.Enabled := False;
- ActionProjectAddFiles.Enabled := False;
- ActionProjectCompile.Visible := False;
- ActionProjectMake.Visible := False;
- ActionProjectBuild.Visible := False;
- ActionProjectStopCompilation.Enabled := True;
- ActionProjectForceQuitCompiler.Enabled := True;
- ActionProjectStopCompilation.Visible := True;
- ActionProjectForceQuitCompiler.Visible := True;
- with RecentFiles do
- for I := 0 to Count - 1 do
- with TRecentFileMenuItem (Objects [I]) do begin
- FileMenuItem.Enabled := False;
- PopupMenuItem.Enabled := False;
- end;
- end;
- end;
- procedure TMainForm.AppCompStop;
- var
- I: Integer;
- begin
- if Compiling then begin
- Compiling := False;
- ActionProjectStopCompilation.Visible := False;
- ActionProjectForceQuitCompiler.Visible := False;
- ToolBarNewButton.Enabled := True;
- MenuFileNew.Enabled := True;
- ActionFileOpen.Enabled := True;
- ActionFileExit.Enabled := True;
- ActionProjectAddFiles.Enabled := True;
- ActionProjectCompile.Visible := True;
- ActionProjectMake.Visible := True;
- ActionProjectBuild.Visible := True;
- with RecentFiles do
- for I := 0 to Count - 1 do
- with TRecentFileMenuItem (Objects [I]) do begin
- FileMenuItem.Enabled := True;
- PopupMenuItem.Enabled := True;
- end;
- UpdateDebugSettings;
- with StatusBar.Panels do begin
- Items[5].Width := 0;
- Items[6].Width := 0;
- Items[7].Width := 0;
- Items[8].Width := 0;
- Items[9].Width := 0;
- end;
- end;
- end;
- procedure TMainForm.AppCompUpdate;
- const
- SecondsPerDay = 24 * 60 * 60;
- function CustomTimeToStr(ConvTime: TDateTime): string;
- var
- Seconds: Integer;
- MinStr,
- SecStr: string;
- begin
- Seconds := Trunc (ConvTime * SecondsPerDay);
- MinStr := IntToStr (Seconds div 60);
- SecStr := IntToStr (Seconds mod 60);
- while Length (SecStr) < 2 do
- SecStr := '0' + SecStr;
- Result := MinStr + ':' + SecStr;
- end;
- var
- CurTime: TDateTime;
- begin
- CurTime := Now;
- if Trunc (CompLastTime * SecondsPerDay) <> Trunc (CurTime * SecondsPerDay) then begin
- CompLastTime := CurTime;
- with StatusBar, Panels do begin
- Items[7].Text := 'File Time: ' + CustomTimeToStr (CurTime - CompFileStartTime);
- Items[8].Text := 'Total Time: ' + CustomTimeToStr (CurTime - CompStartTime);
- Update;
- end;
- end;
- end;
- procedure TMainForm.DisplayFolderMessage;
- var
- S: string;
- begin
- if OperationSuccessful and (not OperationCancelled) and OpenFolderMessage then begin
- if ProjectTarget = ptArchive then
- S := 'The project has been compiled successfully.'#13#10#13#10'Archive Size: ' + IntToStr (ProgSize) + ' Bytes'#13#10#13#10'Do you want to open the project folder?'
- else
- with OptimizeInfo do begin
- S := 'The project has been compiled successfully.'#13#10#13#10'Program Variable Size: ' + IntToStr (ProgramSize) + ' Bytes'#13#10;
- if DataSize > 0 then
- S := S + 'Data Variable Size: ' + IntToStr (DataSize) + ' Bytes'#13#10;
- if BSSSize > 0 then
- S := S + 'BSS Size: ' + IntToStr (BSSSize) + ' Bytes'#13#10;
- S := S + 'Absolute Relocs: ' + IntToStr (RelocCount) + #13#10'Natively Emitted Relocs: ' + IntToStr (NativeRelocCount) + #13#10;
- if OptimizeBranchesResult > 0 then begin
- if OptimizeBranches then
- S := S + 'Relocs Saved'
- else
- S := S + 'Relocs Savable';
- S := S + ' by Branch Optimization: ' + IntToStr (OptimizeBranchesResult) + #13#10;
- end;
- if OptimizeMovesResult > 0 then begin
- if OptimizeMoves then
- S := S + 'Relocs Saved'
- else
- S := S + 'Relocs Savable';
- S := S + ' by Move Optimization: ' + IntToStr (OptimizeMovesResult) + #13#10;
- end;
- if OptimizeTestsResult > 0 then begin
- if OptimizeTests then
- S := S + 'Relocs Saved'
- else
- S := S + 'Relocs Savable';
- S := S + ' by Test Optimization: ' + IntToStr (OptimizeTestsResult) + #13#10;
- end;
- if OptimizeCalcsResult > 0 then begin
- if OptimizeCalcs then
- S := S + 'Relocs Saved'
- else
- S := S + 'Relocs Savable';
- S := S + ' by Calculation Optimization: ' + IntToStr (OptimizeCalcsResult) + #13#10;
- end;
- if UseFLineJumpsResult > 0 then begin
- if UseFLineJumps or Use4ByteFLineJumps then
- S := S + 'Relocs Saved'
- else
- S := S + 'Relocs Savable';
- S := S + ' by F-Line Jumps: ' + IntToStr (UseFLineJumpsResult) + #13#10;
- end;
- if CutRangesResult > 0 then begin
- if CutRanges then
- S := S + 'Space Saved'
- else
- S := S + 'Space Savable';
- S := S + ' by Range-Cutting: ' + IntToStr (CutRangesResult) + ' Bytes'#13#10;
- end;
- if NearAssemblyResult > 0 then
- S := S + 'Space Savable by Using GNU Assembler ''-l'' Switch: ' + IntToStr (NearAssemblyResult) + ' Bytes'#13#10;
- S := S + #13#10'Do you want to open the project folder?';
- end;
- if ShowDefaultMessageBox (S, 'Compilation Successful', mtQuestion) = idYes then
- ShellExecute (0, nil, PChar (ExtractFilePath (ProjectFile)), nil, nil, sw_ShowNormal);
- end;
- end;
- procedure TMainForm.ProjectStopCompilation(Sender: TObject);
- begin
- CompFinishAndStop := True;
- ActionProjectStopCompilation.Enabled := False;
- end;
- procedure TMainForm.ProjectForceQuitCompiler(Sender: TObject);
- begin
- CompStopNow := True;
- end;
- procedure TMainForm.WMDropFiles(var Msg: TMessage);
- var
- DropHandle: THandle;
- I,
- FileCount: Integer;
- CurFile: array [0..512] of Char;
- begin
- DropHandle := Msg.WParam;
- FileCount := DragQueryFile (DropHandle, High (Cardinal), nil, 0);
- for I := 0 to FileCount - 1 do begin
- DragQueryFile (DropHandle, I, CurFile, SizeOf (CurFile) - 1);
- if LowerCase (ExtractFileExt (AnsiString (CurFile))) = LowerCase (ProjectFileExt) then
- FileOpen (AnsiString (CurFile))
- else
- AddSourceFile (AnsiString (CurFile), True);
- end;
- DragFinish (DropHandle);
- end;
- procedure TMainForm.HelpNews(Sender: TObject);
- begin
- with TNewsForm.Create (Self) do try
- Execute;
- finally
- Free;
- end;
- end;
- function TMainForm.GetVTIWindow: HWnd;
- begin
- CurVTIType := cvNone;
- Result := FindWindow ('TEmuWnd', 'Virtual TI-89');
- if Result = 0 then begin
- Result := FindWindow ('TEmuWnd', 'Virtual TI-92+');
- if Result = 0 then begin
- Result := FindWindow ('TEmuWnd', 'Virtual TI-92');
- if Result <> 0 then
- CurVTIType := cvTI92;
- end else
- CurVTIType := cvTI92Plus;
- end else
- CurVTIType := cvTI89;
- if Result = 0 then begin
- if Length (VTIPath) > 0 then begin
- with TVTIStartForm.Create (Self) do try
- if ShowModal = mrOK then begin
- Result := VTIWindow;
- CurVTIType := VTIType;
- end else
- Abort;
- finally
- Free;
- end;
- end else begin
- ShowDefaultMessageBox ('Virtual TI is not running.', 'Error', mtProgramError);
- Abort;
- end;
- end;
- end;
- procedure TMainForm.SendFiles(FNList: array of string);
- var
- Win: HWnd;
- procedure SendKey(Key: Byte);
- begin
- PostMessage (Win, WM_KEYDOWN, Key, 0);
- PostMessage (Win, WM_KEYUP, Key, 0);
- end;
- var
- I: Integer;
- EditWin,
- ButtonWin: HWnd;
- StartTime: Cardinal;
- FileString: string;
- Name: array [0..32] of Char;
- Connection: TLinkConnection;
- Size: Word;
- Total: Cardinal;
- Progress: DWord;
- ProgressForm: TSendProgressForm;
- begin
- OperationSuccessful := False;
- OperationCancelled := False;
- if Length (FNList) > 0 then begin
- if TransferTarget = ttVTI then begin
- Win := GetVTIWindow;
- GetWindowThreadProcessID (Win, @ProcID);
- SendKey (VK_SCROLL);
- SendKey (VK_ESCAPE);
- if CurVTIType = cvTI89 then
- SendKey (VK_HOME);
- SendKey (VK_F10);
- StartTime := GetTickCount;
- SendWin := 0;
- repeat
- EnumWindows (@EnumWindowsFunc, 0);
- until (SendWin <> 0) or (GetTickCount - StartTime >= 10000);
- if SendWin = 0 then begin
- ShowDefaultMessageBox ('Error displaying send dialog.', 'Error', mtProgramError);
- Abort;
- end else begin
- SetForegroundWindow (SendWin);
- repeat
- EditWin := GetWindow (SendWin, GW_CHILD);
- GetClassName (EditWin, Name, 32);
- while (EditWin <> 0) and (UpperCase (AnsiString (Name)) <> 'EDIT') do begin
- EditWin := GetWindow (EditWin, GW_HWNDNEXT);
- if EditWin <> 0 then
- GetClassName (EditWin, Name, 32);
- end;
- if EditWin <> 0 then begin
- StartTime := GetTickCount;
- while (SendMessage (EditWin, WM_GETTEXTLENGTH, 0, 0) <= 0) and (GetTickCount - StartTime < 5000) do;
- FileString := '';
- for I := Low (FNList) to High (FNList) do begin
- if CurVTIType = cvTI92Plus then
- FNList [I] := StringReplace (FNList [I], '.89', '.9x', []);
- if not FileExists (FNList [I]) then begin
- ShowDefaultMessageBox ('The file "' + FNList [I] + '" could not be found.', 'Error', mtProgramError);
- Abort;
- end;
- Insert ('"' + FNList [I] + '" ', FileString, Length (FileString) + 1);
- end;
- Delete (FileString, Length (FileString), 1);
- SendMessage (EditWin, WM_SETTEXT, 0, Integer (PChar (FileString)));
- end;
- ButtonWin := GetWindow (SendWin, GW_CHILD);
- GetClassName (ButtonWin, Name, 32);
- while (ButtonWin <> 0) and ((UpperCase (AnsiString (Name)) <> 'BUTTON') or ((GetWindowLong (ButtonWin, GWL_STYLE) and BS_DEFPUSHBUTTON) = 0) or ((GetWindowLong (ButtonWin, GWL_STYLE) and BS_CHECKBOX) <> 0)) do begin
- ButtonWin := GetWindow (ButtonWin, GW_HWNDNEXT);
- if ButtonWin <> 0 then
- GetClassName (ButtonWin, Name, 32);
- end;
- until SendMessage (EditWin, WM_GETTEXTLENGTH, 0, 0) >= Length (FNList [Low (FNList)]);
- if ButtonWin <> 0 then begin
- SendMessage (ButtonWin, WM_LBUTTONDOWN, 0, 0);
- SendMessage (ButtonWin, WM_LBUTTONUP, 0, 0);
- end;
- end;
- ShowWindow (Win, SW_SHOWNORMAL);
- SetForegroundWindow (Win);
- end else if TransferTarget = ttCalc then begin
- FillChar (Connection, SizeOf (Connection), 0);
- Connection.Port := LinkPort;
- Connection.CableType := LinkCable;
- if CreateConnection (Connection) then try
- if OpenConnection (Connection) and GetCalcType (Connection) then begin
- Total := 0;
- for I := Low (FNList) to High (FNList) do begin
- case Connection.CalcType of
- cdTI92Plus:
- FNList [I] := StringReplace (FNList [I], '.89', '.9x', []);
- cdV200:
- FNList [I] := StringReplace (FNList [I], '.89', '.v2', []);
- cdTI92:
- FNList [I] := StringReplace (FNList [I], '.89', '.92', []);
- end;
- if not FileExists (FNList [I]) then begin
- ShowDefaultMessageBox ('The file "' + FNList [I] + '" could not be found.', 'Error', mtProgramError);
- Abort;
- end;
- if not CheckFileFormat (Connection, PChar (FNList [I]), nil, nil, @Size) then begin
- ShowDefaultMessageBox ('Error sending file.', 'Error', mtProgramError);
- Abort;
- end;
- Inc (Total, Size);
- end;
- Enabled := False;
- try
- ProgressForm := TSendProgressForm.Create (Self);
- with ProgressForm do try
- ProgressBar.Max := Total;
- Show;
- Update;
- Progress := 0;
- for I := Low (FNList) to High (FNList) do begin
- FileNameLabel.Caption := ExtractFileName (FNList [I]);
- if not SendFile (Connection, nil, nil, PChar (FNList [I]), @Progress, ProgressProg, ProgressForm) then begin
- if Cancelled then
- OperationCancelled := True
- else
- ShowDefaultMessageBox ('Error sending file. Please check whether your calculator is on the home screen.', 'Error', mtProgramError);
- Abort;
- end;
- end;
- finally
- CloseNow := True;
- Free;
- end;
- finally
- Enabled := True;
- end;
- end else begin
- ShowDefaultMessageBox ('Error linking to calculator.', 'Error', mtProgramError);
- Abort;
- end;
- finally
- CloseConnection (Connection);
- end else begin
- ShowDefaultMessageBox ('Error opening link port.', 'Error', mtProgramError);
- Abort;
- end;
- end;
- OperationSuccessful := True;
- end;
- end;
- procedure TMainForm.ExecuteCommandLine(const Line: string);
- var
- Win: HWnd;
- procedure SendKey(Key: Byte);
- begin
- SendMessage (Win, WM_KEYDOWN, Key, 0);
- SendMessage (Win, WM_KEYUP, Key, 0);
- Sleep (20);
- end;
- var
- I: Integer;
- Connection: TLinkConnection;
- begin
- if TransferTarget = ttVTI then begin
- Win := GetVTIWindow;
- SendKey (VK_SCROLL);
- SendKey (VK_ESCAPE);
- SendKey (VK_ESCAPE);
- if CurVTIType = cvTI89 then
- SendKey (VK_HOME);
- SendKey (VK_DELETE);
- SendKey (VK_DELETE);
- for I := 1 to Length (Line) do
- if Line [I] in ['A'..'Z', 'a'..'z', '0'..'9'] then
- SendKey (Byte (UpCase (Line [I])))
- else if Line [I] = '(' then
- SendKey ($DB)
- else if Line [I] = ')' then
- SendKey ($DD)
- else if Line [I] = ',' then
- SendKey ($BC)
- else if Line [I] = '.' then
- SendKey (VK_DECIMAL)
- else if Line [I] = '+' then
- SendKey (VK_ADD)
- else if Line [I] = '-' then
- SendKey (VK_SUBTRACT)
- else if Line [I] = '*' then
- SendKey (VK_MULTIPLY)
- else if Line [I] = '/' then
- SendKey (VK_DIVIDE)
- else if Line [I] = '\' then begin
- SendKey (VK_MENU);
- SendKey (Byte ('2'));
- end;
- SendKey (VK_RETURN);
- end else if TransferTarget = ttCalc then begin
- FillChar (Connection, SizeOf (Connection), 0);
- Connection.Port := LinkPort;
- Connection.CableType := LinkCable;
- if CreateConnection (Connection) then try
- if OpenConnection (Connection) then
- ExecuteHomeLine (Connection, Line)
- else begin
- ShowDefaultMessageBox ('Error linking to calculator.', 'Error', mtProgramError);
- Abort;
- end;
- finally
- CloseConnection (Connection);
- end else begin
- ShowDefaultMessageBox ('Error opening link port.', 'Error', mtProgramError);
- Abort;
- end;
- end;
- end;
- procedure TMainForm.DebugRun(Sender: TObject);
- var
- Files: array of string;
- begin
- OperationSuccessful := True;
- OperationCancelled := False;
- if Invalidated then
- MakeFileWrapped;
- if OperationSuccessful and (not OperationCancelled) and (FileExists (ChangeFileExt (ProjectFile, '.89z')) or FileExists (ChangeFileExt (ProjectFile, '.9xz')) or FileExists (ChangeFileExt (ProjectFile, '.v2z')) or FileExists (ChangeFileExt (ProjectFile, '.92p'))) then begin
- if Runnable then begin
- SetLength (Files, 0);
- case ProjectTarget of
- ptRegular: begin
- SetLength (Files, 1);
- Files [High (Files)] := ChangeFileExt (ProjectFile, '.89z');
- if Pack and (ssPack in SpecialSupport) then begin
- SetLength (Files, Length (Files) + 1);
- Files [High (Files)] := ChangeFileExt (ProjectFile, '.89y');
- end;
- if UseDataVar then begin
- SetLength (Files, Length (Files) + 1);
- Files [High (Files)] := ChangeFileExt (ProjectFile, '-data.89y');
- end;
- end;
- ptFargo: begin
- SetLength (Files, 1);
- Files [High (Files)] := ChangeFileExt (ProjectFile, '.92p');
- end;
- end;
- if Length (Files) > 0 then begin
- SendFiles (Files);
- if OperationSuccessful then
- ExecuteCommandLine (TopNode.Text + '(' + CommandLine + ')');
- end;
- end else
- DisplayFolderMessage;
- end;
- end;
- procedure TMainForm.DebugPause(Sender: TObject);
- var
- Win: HWnd;
- procedure SendKey(Key: Byte);
- begin
- PostMessage (Win, WM_KEYDOWN, Key, 0);
- PostMessage (Win, WM_KEYUP, Key, 0);
- end;
- begin
- Win := GetVTIWindow;
- SendKey (VK_F11);
- ShowWindow (Win, SW_SHOWNORMAL);
- SetForegroundWindow (Win);
- end;
- procedure TMainForm.DebugReset(Sender: TObject);
- var
- Win: HWnd;
- procedure SendKey(Key: Byte);
- begin
- PostMessage (Win, WM_KEYDOWN, Key, 0);
- PostMessage (Win, WM_KEYUP, Key, 0);
- end;
- begin
- Win := GetVTIWindow;
- SendKey (VK_APPS);
- SendKey (Byte ('T'));
- ShowWindow (Win, SW_SHOWNORMAL);
- SetForegroundWindow (Win);
- end;
- function TMainForm.GetInvalidated: Boolean;
- var
- I: Integer;
- begin
- Result := FInvalidated;
- if not Result then
- with SourceFiles do
- for I := 0 to Count - 1 do
- with Items [I] as TSourceFile do
- if (Compilable or (Items [I] is THeaderSourceFile)) and Invalidated then begin
- Result := True;
- Break;
- end;
- end;
- procedure TMainForm.UpdateDebugSettings;
- var
- CanRun: Boolean;
- begin
- CanRun := Runnable;
- ActionDebugRun.Enabled := not Compiling;
- ActionDebugPause.Enabled := (not Compiling) and (TransferTarget = ttVTI);
- ActionDebugReset.Enabled := (not Compiling) and (TransferTarget = ttVTI);
- MainMenuDebug.Visible := CanRun;
- if not CanRun then
- ToolBarDebugLine.Parent := nil;
- ToolBarRunButton.Visible := CanRun;
- ToolBarPauseButton.Visible := CanRun;
- ToolBarDebugLine.Visible := CanRun;
- if CanRun then begin
- ToolBarDebugLine.Parent := MainToolBar;
- ToolBarDebugLine.Left := ToolBarPauseButton.Left + ToolBarPauseButton.Width;
- end;
- end;
- procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- var
- NewSelection: TTreeNode;
- begin
- if (Key = vk_F9) and (Shift = [ssShift, ssCtrl, ssAlt]) then begin
- if TransferTarget = ttVTI then
- TransferTarget := ttCalc
- else
- TransferTarget := ttVTI;
- SavePreferences;
- UpdateDebugSettings;
- end else if (Key = vk_Tab) and (Shift = [ssCtrl]) then begin
- NewSelection := ProjectTree.Selected;
- if Assigned (NewSelection) then begin
- repeat
- NewSelection := NewSelection.GetNext;
- if not Assigned (NewSelection) then
- NewSelection := TopNode;
- until (NewSelection.IsVisible and Assigned (NewSelection.Data)) or (NewSelection = ProjectTree.Selected);
- if Assigned (NewSelection.Data) then
- SelectNode (NewSelection);
- if Assigned (CurrentEditor) and CurrentEditor.Enabled then try
- CurrentEditor.SetFocus;
- except end;
- end;
- end;
- end;
- procedure TMainForm.SelectNode(Node: TTreeNode);
- var
- Allow: Boolean;
- begin
- if PreviousNode <> Node then begin
- Allow := True;
- ProjectTreeChanging (ProjectTree, Node, Allow);
- if Allow then begin
- NoHideEditor := True;
- ProjectTree.Selected := Node;
- NoHideEditor := False;
- end;
- end;
- end;
- procedure TMainForm.ChangeNotificationTick(Sender: TObject);
- var
- I: Integer;
- begin
- if not InChangeNotification then begin
- InChangeNotification := True;
- with SourceFiles do
- for I := 0 to Count - 1 do
- with TSourceFile (Items [I]) do
- TestChange;
- InChangeNotification := False;
- end;
- end;
- procedure TMainForm.ResetProjectSettings;
- begin
- ProjectTarget := ptRegular;
- UseDataVar := False;
- DataVar := '';
- DataVarCopy := True;
- DataVarCopyIfArchived := True;
- Pack := False;
- PackVar := '';
- GCCSwitches := '-Os -Wall -W -Wwrite-strings -ffunction-sections -fdata-sections';
- AsSwitches := '';
- AsmSwitches := '-g -t';
- DebugInfo := False;
- StdLib := True;
- InitBSS := True;
- OptimizeNOPs := True;
- OptimizeReturns := True;
- OptimizeBranches := True;
- OptimizeMoves := True;
- OptimizeTests := True;
- OptimizeCalculations := True;
- RemoveUnusedSections := True;
- CutUnusedRanges := True;
- ReorderSections := True;
- MergeConstants := True;
- OutputBin := False;
- CommandLine := '';
- PostBuildProcessFile := '';
- if Assigned (PredefinedLibOptions) then
- with PredefinedLibOptions do begin
- CalcDests := [cdTI89, cdTI92Plus, cdV200];
- OptimizeCalcConsts := False;
- KernelFormat := kfNone;
- UseMinAMS := True;
- MinAMS := '1.00';
- RelocFormat := rfAMS;
- ROMCallFormat := rfDirect;
- BSSRefFormat := rfKernel;
- DataRefFormat := rfKernel;
- UseFLineJumps := False;
- UseInternalFLineEmulator := False;
- UseReturnValue := False;
- EnableErrorReturn := False;
- SaveScreen := True;
- end;
- end;
- procedure TMainForm.AddToRecent(const FileName: string);
- var
- I: Integer;
- O: TRecentFileMenuItem;
- begin
- with RecentFiles do begin
- for I := 0 to Count - 1 do
- if (I >= MaxRecentFiles - 1) or (UpperCase (Strings [I]) = UpperCase (FileName)) then begin
- if I = 0 then
- Exit
- else begin
- Objects[I].Free;
- Delete (I);
- Break;
- end;
- end;
- RecentFilesLine.Visible := True;
- O := TRecentFileMenuItem.Create;
- with O do begin
- FileMenuItem := TMenuItem.Create (Self);
- with FileMenuItem do begin
- Caption := WithoutExt (ExtractFileName (FileName));
- Hint := FileName;
- OnClick := RecentFileClick;
- end;
- MainMenuFile.Insert (RecentFilesLine.MenuIndex + 1, FileMenuItem);
- PopupMenuItem := TMenuItem.Create (Self);
- with PopupMenuItem do begin
- Caption := FileName;
- Hint := FileName;
- OnClick := RecentFileClick;
- end;
- RecentFilesPopup.Items.Insert (0, PopupMenuItem);
- end;
- InsertObject (0, FileName, O);
- end;
- UpdateRecent;
- end;
- procedure TMainForm.UpdateRecent;
- begin
- RecentFilesLine.Visible := RecentFiles.Count > 0;
- NoFilesItem.Visible := RecentFiles.Count <= 0;
- end;
- procedure TMainForm.RecentFileClick(Sender: TObject);
- var
- I: Integer;
- FileName: string;
- begin
- FileName := (Sender as TMenuItem).Hint;
- if FileExists (FileName) then
- FileOpen (FileName)
- else begin
- with RecentFiles do
- for I := 0 to Count - 1 do
- if UpperCase (Strings [I]) = UpperCase (FileName) then begin
- Objects[I].Free;
- Delete (I);
- Break;
- end;
- UpdateRecent;
- ShowDefaultMessageBox ('File ''' + WithoutExt (ExtractFileName (FileName)) + ''' not found.', 'Error', mtProgramError);
- end;
- end;
- procedure TMainForm.ToolsConfigure(Sender: TObject);
- var
- I: Integer;
- begin
- with TToolsForm.Create (Self) do try
- with Self.ToolsList do
- for I := 0 to Count - 1 do
- with ToolsList.Items.Add, TToolsListItem (Items [I]) do begin
- Caption := Title;
- SubItems.Add (CommandLine);
- SubItems.Add (WorkingDir);
- SubItems.Add (WindowStateToString (WindowState));
- end;
- if ShowModal = mrOK then begin
- Self.ToolsList.Clear;
- with ToolsList.Items do begin
- ToolsLine.Visible := Count > 0;
- for I := 0 to Count - 1 do
- with Item [I] do
- AddTool (Caption, SubItems [0], SubItems [1], StringToWindowState (SubItems [2]));
- end;
- SavePreferences;
- end;
- finally
- Free;
- end;
- end;
- procedure TMainForm.ToolClick(Sender: TObject);
- var
- WorkDir: PChar;
- StartupInfo: TStartupInfo;
- ProcessInfo: TProcessInformation;
- begin
- with TToolsListItem ((Sender as TMenuItem).Tag) do begin
- FillChar (StartupInfo, SizeOf (StartupInfo), 0);
- StartupInfo.cb := SizeOf (StartupInfo);
- if Length (WorkingDir) > 0 then
- WorkDir := PChar (WorkingDir)
- else
- WorkDir := nil;
- StartupInfo.dwFlags := StartF_UseShowWindow;
- case WindowState of
- wsMaximized:
- StartupInfo.wShowWindow := SW_SHOWMAXIMIZED;
- wsMinimized:
- StartupInfo.wShowWindow := SW_SHOWMINIMIZED;
- else
- StartupInfo.dwFlags := 0;
- end;
- if CreateProcess (nil, PChar (CommandLine), nil, nil, False, CREATE_NEW_PROCESS_GROUP or DETACHED_PROCESS, nil, WorkDir, StartupInfo, ProcessInfo) then begin
- CloseHandle (ProcessInfo.hProcess);
- CloseHandle (ProcessInfo.hThread);
- end else
- ShowDefaultMessageBox ('An error occurred while trying to start the application.', 'Error', mtProgramError);
- end;
- end;
- procedure TMainForm.AddTool(const Title, CommandLine, WorkingDir: string; WindowState: TWindowState);
- var
- O: TToolsListItem;
- begin
- O := TToolsListItem (Self.ToolsList.Add);
- O.Title := Title;
- O.CommandLine := CommandLine;
- O.WorkingDir := WorkingDir;
- O.WindowState := WindowState;
- O.MenuItem := TMenuItem.Create (Self);
- with O.MenuItem do begin
- Tag := Integer (O);
- Caption := Title;
- Hint := CommandLine;
- OnClick := ToolClick;
- end;
- MainMenuTools.Insert (MainMenuTools.Count, O.MenuItem);
- end;
- procedure TMainForm.ProjectTreeStartDrag(Sender: TObject;
- var DragObject: TDragObject);
- begin
- DragObject := TNoImageDragObject.Create (Sender as TControl);
- end;
- procedure TMainForm.UpdateProgramOutput;
- begin
- ActionProjectShowProgramOutput.Enabled := (MainConsole.LastOutSize > 2) or (MainConsole.LastErrSize > 2);
- end;
- procedure TMainForm.ShowProgramOutput(Sender: TObject);
- begin
- with TProgramOutputForm.Create (Self) do try
- OutputMemo.Text := MainConsole.LastOutText;
- ErrorMemo.Text := MainConsole.LastErrText;
- ShowModal;
- finally
- Free;
- end;
- end;
- procedure TMainForm.ClearDebugInfo;
- begin
- end;
- procedure TMainForm.FileNewFolder(Sender: TObject);
- var
- ParentNode,
- Node: TTreeNode;
- Folder: TFolder;
- begin
- ParentNode := ProjectTree.Selected;
- while Assigned (ParentNode) and Assigned (ParentNode.Data) and (not (TObject (ParentNode.Data) is TFolder)) do
- ParentNode := ParentNode.Parent;
- if Assigned (ParentNode) and Assigned (ParentNode.Parent) then begin
- Folder := TFolder.Create;
- Node := ProjectTree.Items.AddChildObject (ParentNode, 'New Folder', Folder);
- Folder.TreeItem := Node;
- with Node do begin
- ImageIndex := 0;
- SelectedIndex := 1;
- Selected := True;
- EditText;
- end;
- end;
- end;
- function TMainForm.GetSourceTypeFolder(Node: TTreeNode): TTreeNode;
- begin
- if Assigned (Node) and Assigned (Node.Parent) then begin
- Result := Node;
- while Assigned (Result) and Assigned (Result.Data) do
- Result := Result.Parent;
- end else
- Result := nil;
- end;
- function TMainForm.FindFileInsertionPoint(ParentNode: TTreeNode): TTreeNode;
- begin
- if Assigned (ParentNode) then begin
- Result := ParentNode.GetFirstChild;
- while Assigned (Result) and Assigned (Result.Data) and (TObject (Result.Data) is TSourceFile) do
- Result := Result.GetNextSibling;
- end else
- Result := nil;
- end;
- function TMainForm.CreateFileNode(ParentNode: TTreeNode; SourceFile: TSourceFile): TTreeNode;
- begin
- if Assigned (SourceFile.Folder) then
- ParentNode := SourceFile.Folder.TreeItem;
- if Assigned (ParentNode) then begin
- Result := FindFileInsertionPoint (ParentNode);
- if Assigned (Result) then
- Result := ProjectTree.Items.InsertObject (Result, SourceFile.SourceName, SourceFile)
- else
- Result := ProjectTree.Items.AddChildObject (ParentNode, SourceFile.SourceName, SourceFile);
- end else
- Result := nil;
- end;
- procedure TMainForm.FileNewFile(Sender: TObject);
- var
- Node: TTreeNode;
- begin
- if Assigned (ProjectTree.Selected) then begin
- Node := GetSourceTypeFolder (ProjectTree.Selected);
- if Assigned (Node) then
- if Node.Index = THeaderSourceFile.GetClassTreeIndex then
- FileNewHeaderFile (Sender)
- else if Node.Index = TCSourceFile.GetClassTreeIndex then
- FileNewCSourceFile (Sender)
- else if Node.Index = TGNUAsmSourceFile.GetClassTreeIndex then
- FileNewGNUAssemblerSourceFile (Sender)
- else if (ssA68k in SpecialSupport) and (Node.Index = TAsmSourceFile.GetClassTreeIndex) then
- FileNewAssemblerSourceFile (Sender)
- else if (ssQuill in SpecialSupport) and (Node.Index = TQuillSourceFile.GetClassTreeIndex) then
- FileNewQuillSourceFile (Sender)
- else if Node.Index = TNormalTextSourceFile.GetClassTreeIndex then
- FileNewTextFile (Sender);
- end;
- end;
- function TMainForm.GetSelectedFolder(SourceClass: TSourceFileClass): TFolder;
- var
- Node: TTreeNode;
- begin
- Result := nil;
- Node := ProjectTree.Selected;
- while Assigned (Node) and (Node <> TopNode.Item [SourceClass.GetClassTreeIndex]) do begin
- if (not Assigned (Result)) and Assigned (Node.Data) and (TObject (Node.Data) is TFolder) then
- Result := Node.Data;
- Node := Node.Parent;
- end;
- if not Assigned (Node) then
- Result := nil;
- end;
- procedure TMainForm.ErrorListKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- var
- S: string;
- Item: TListItem;
- begin
- if ((Key = VK_INSERT) or (Key = Ord('C'))) and (Shift = [ssCtrl]) then
- with ErrorList do begin
- S := '';
- Item := Selected;
- while Assigned (Item) do begin
- S := S + Item.Caption + #13#10;
- Item := GetNextItem (Item, sdAll, [isSelected]);
- end;
- Clipboard.AsText := S;
- end;
- end;
- {$IFDEF CODINGEXT}
- procedure TMainForm.InitCodingExt;
- var
- ActionFindSymbol: TAction;
- begin
- // Find Symbol declaration tool
- ActionFindSymbol := TAction.Create(Self);
- with ActionFindSymbol do
- begin
- ActionList := Actions;
- Caption := 'Find Symbol Declaration';
- Category := 'Extension';
- OnExecute := ActionFindSymbolExecute;
- end;
- InsertsAction(Self, [OpenFileAtCursor1, OpenFileatCursor2], ActionFindSymbol);
- end;
- procedure TMainForm.ActionFindSymbolExecute(Sender: TObject);
- begin
- CompForm.FindSymbolDecl;
- end;
- {$ENDIF}
- end.
|