1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602 |
- {
- TIGCC IDE
- Copyright (C) 2000-2004 Sebastian Reichelt
- Copyright (C) 2005 Fréderic Bour
- Copyright (C) 2005-2007 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,
- ComObj, ActiveX, TiEmuOLELib_TLB;
- 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: TVTICalcType;
- CurTIEmuType: TTIEmuCalcType;
- 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;
- function GetTiEmuInterface: ITiEmuOLE;
- 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, TIEmuStartUnit,
- 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 := ttTIEmu;
- 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)
- else if FileExists (WithBackslash (TIGCCFolder) + GASIncludeLocation + ExtractFileName (SourceF)) then
- SourceFile := AddSourceFile (WithBackslash (TIGCCFolder) + GASIncludeLocation + 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
- if not Compiling then begin
- MakeFileWrapped;
- DisplayFolderMessage;
- end;
- 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;
- ttTIEmu:
- TIEmuBox.Checked := True;
- ttCalc:
- RealCalcBox.Checked := True;
- else
- NoneBox.Checked := True;
- end;
- VTIPathEdit.Text := VTIPath;
- TIEmuPathEdit.Text := TIEmuPath;
- 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 TIEmuBox.Checked then
- TransferTarget := ttTIEmu
- else if RealCalcBox.Checked then
- TransferTarget := ttCalc
- else
- TransferTarget := ttNone;
- VTIPath := VTIPathEdit.Text;
- TIEmuPath := TIEmuPathEdit.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 ('TiEmu Path') then
- TIEmuPath := ReadString ('TiEmu 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);
- WriteString ('TiEmu Path', TIEmuPath);
- 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 := cvVTINone;
- 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 := cvVTITI92;
- end else
- CurVTIType := cvVTITI92Plus;
- end else
- CurVTIType := cvVTITI89;
- 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;
- function TMainForm.GetTiEmuInterface: ITiEmuOLE;
- var
- Unknown: IUnknown;
- OLEResult: HResult;
- begin
- OLEResult := GetActiveObject(CLASS_TiEmuOLE, nil, Unknown);
- if OLEResult = S_OK then begin
- OleCheck(Unknown.QueryInterface(ITiEmuOLE, Result));
- end else begin
- { If no TiEmu path is set, try looking it up from the registry. }
- if Length (TIEmuPath) = 0 then begin
- with TRegistry.Create do try
- RootKey := HKey_Classes_Root;
- if OpenKeyReadOnly ('\CLSID\{B2A17B13-9D6F-4DD4-A2A9-6FE06ADC1D33}\LocalServer32') then try
- if ValueExists ('') then
- TIEmuPath := ReadString ('');
- except end;
- finally
- Free;
- end;
- end;
- if Length (TIEmuPath) > 0 then begin
- with TTIEmuStartForm.Create (Self) do try
- if ShowModal = mrOK then begin
- Result := TiEmuInterface;
- end else
- Abort;
- finally
- Free;
- end;
- end else begin
- ShowDefaultMessageBox ('TiEmu 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
- EditWin,
- ButtonWin: HWnd;
- StartTime: Cardinal;
- FileString: string;
- Name: array [0..32] of Char;
- I: Integer;
- FirstI: Integer;
- TiEmuInterface: ITiEmuOLE;
- TiEmuCalcType: TTIEmuCalcType;
- Ready: Boolean;
- Connection: TLinkConnection;
- Size: Word;
- Total: Cardinal;
- Progress: DWord;
- ProgressForm: TSendProgressForm;
- begin
- OperationSuccessful := False;
- OperationCancelled := False;
- if Length (FNList) > 0 then begin
- if TransferTarget = ttTIEmu then begin
- TiEmuInterface := GetTiEmuInterface;
- Enabled := False;
- try
- { Wait for TiEmu to get ready. }
- repeat
- Sleep(100);
- Application.ProcessMessages;
- try
- Ready := TiEmuInterface.ready_for_transfers;
- except
- ShowDefaultMessageBox ('OLE function call failed.', 'Error', mtProgramError);
- Abort;
- end;
- until Ready;
- { Now obtain the model from TiEmu. }
- try
- TiEmuCalcType := TTIEmuCalcType(TiEmuInterface.emulated_calc_type);
- if TiEmuCalcType = cvTIEmuNone then Abort;
- except
- ShowDefaultMessageBox ('OLE function call failed.', 'Error', mtProgramError);
- Abort;
- end;
- { Select the correct files for the model. }
- if (TiEmuCalcType <> cvTIEmuTI92) and (ProjectTarget = ptFargo) then begin
- ShowDefaultMessageBox ('Can''t send Fargo program to a TI-89/89Ti/92+/V200.', 'Error', mtProgramError);
- Abort;
- end;
- if (TiEmuCalcType = cvTIEmuTI92) and (ProjectTarget <> ptFargo) then begin
- ShowDefaultMessageBox ('Can''t send AMS program to a TI-92.', 'Error', mtProgramError);
- Abort;
- end;
- for I := Low (FNList) to High (FNList) do begin
- case TiEmuCalcType of
- cvTIEmuTI92Plus:
- FNList [I] := StringReplace (FNList [I], '.89', '.9x', []);
- cvTIEmuV200:
- FNList [I] := StringReplace (FNList [I], '.89', '.v2', []);
- cvTIEmuTI92:
- 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;
- end;
- { Now send the files. }
- FirstI := Low (FNList);
- if DebugInfo and not Pack and FileExists (ChangeFileExt (ProjectFile, '.dbg')) then begin
- try
- if not TiEmuInterface.debug_file(FNList [FirstI]) then Abort;
- except
- ShowDefaultMessageBox ('OLE function call failed.', 'Error', mtProgramError);
- Abort;
- end;
- Inc (FirstI);
- end;
- for I := FirstI to High (FNList) do begin
- try
- if not TiEmuInterface.send_file(FNList [I]) then Abort;
- except
- ShowDefaultMessageBox ('OLE function call failed.', 'Error', mtProgramError);
- Abort;
- end;
- end;
- finally
- Enabled := True;
- end;
- end else if TransferTarget = ttVTI then begin
- Win := GetVTIWindow;
- GetWindowThreadProcessID (Win, @ProcID);
- SendKey (VK_SCROLL);
- SendKey (VK_ESCAPE);
- if CurVTIType = cvVTITI89 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 = cvVTITI92Plus 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;
- TiEmuInterface: ITiEmuOLE;
- Connection: TLinkConnection;
- begin
- if TransferTarget = ttTIEmu then begin
- TiEmuInterface := GetTiEmuInterface;
- try
- if not TiEmuInterface.execute_command(Line) then Abort;
- except
- ShowDefaultMessageBox ('OLE function call failed.', 'Error', mtProgramError);
- Abort;
- end;
- end else if TransferTarget = ttVTI then begin
- Win := GetVTIWindow;
- SendKey (VK_SCROLL);
- SendKey (VK_ESCAPE);
- SendKey (VK_ESCAPE);
- if CurVTIType = cvVTITI89 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;
- TiEmuInterface: ITiEmuOLE;
- procedure SendKey(Key: Byte);
- begin
- PostMessage (Win, WM_KEYDOWN, Key, 0);
- PostMessage (Win, WM_KEYUP, Key, 0);
- end;
- begin
- if TransferTarget = ttTIEmu then begin
- TiEmuInterface := GetTiEmuInterface;
- try
- TiEmuInterface.enter_debugger;
- except
- ShowDefaultMessageBox ('OLE function call failed.', 'Error', mtProgramError);
- end
- end else if TransferTarget = ttVTI then begin
- Win := GetVTIWindow;
- SendKey (VK_F11);
- ShowWindow (Win, SW_SHOWNORMAL);
- SetForegroundWindow (Win);
- end;
- end;
- procedure TMainForm.DebugReset(Sender: TObject);
- var
- Win: HWnd;
- TiEmuInterface: ITiEmuOLE;
- procedure SendKey(Key: Byte);
- begin
- PostMessage (Win, WM_KEYDOWN, Key, 0);
- PostMessage (Win, WM_KEYUP, Key, 0);
- end;
- begin
- if TransferTarget = ttTIEmu then begin
- TiEmuInterface := GetTiEmuInterface;
- try
- TiEmuInterface.reset_calc(False);
- except
- ShowDefaultMessageBox ('OLE function call failed.', 'Error', mtProgramError);
- end
- end else if TransferTarget = ttVTI then begin
- Win := GetVTIWindow;
- SendKey (VK_APPS);
- SendKey (Byte ('T'));
- ShowWindow (Win, SW_SHOWNORMAL);
- SetForegroundWindow (Win);
- end;
- 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) or (TransferTarget = ttTIEmu));
- ActionDebugReset.Enabled := (not Compiling) and ((TransferTarget = ttVTI) or (TransferTarget = ttTIEmu));
- 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_F8) and (Shift = []) then begin
- ProjectMake (Sender);
- end else if (Key = vk_F8) and (Shift = [ssAlt]) then begin
- ProjectCompile (Sender);
- end else if (Key = vk_F9) and (Shift = [ssShift, ssCtrl, ssAlt]) then begin
- if TransferTarget = ttVTI then
- TransferTarget := ttTIEmu
- else if TransferTarget = ttTiEmu then
- TransferTarget := ttCalc
- else
- TransferTarget := ttVTI;
- SavePreferences;
- UpdateDebugSettings;
- end else if ((Key = vk_Tab) or (Key = Ord('G'))) 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 := 'F&ind Symbol Declaration';
- Category := 'Extension';
- OnExecute := ActionFindSymbolExecute;
- end;
- InsertsAction(Self, [OpenFileAtCursor1, OpenFileatCursor2], ActionFindSymbol);
- end;
- procedure TMainForm.ActionFindSymbolExecute(Sender: TObject);
- begin
- CompForm.FindSymbolDecl;
- end;
- {$ENDIF}
- end.
|