2
0

IDE.MainForm.pas 294 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939
  1. unit IDE.MainForm;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2025 Jordan Russell
  5. Portions by Martijn Laan
  6. For conditions of distribution and use, see LICENSE.TXT.
  7. Compiler form
  8. }
  9. {x$DEFINE STATICCOMPILER}
  10. { For debugging purposes, remove the 'x' to have it link the compiler code into
  11. this program and not depend on ISCmplr.dll. You will also need to add the
  12. ..\Components and Src folders to the Delphi Compiler Search path in the project
  13. options. Also see ISCC's STATICCOMPILER and Compiler.Compile's STATICPREPROC. }
  14. {$IFDEF STATICCOMPILER}
  15. {$R ..\Res\ISCmplr.images.res}
  16. {$ENDIF}
  17. interface
  18. uses
  19. Windows, Messages, SysUtils, Classes, Contnrs, Graphics, Controls, Forms, Dialogs, CommDlg,
  20. Generics.Collections, UIStateForm, StdCtrls, ExtCtrls, Menus, Buttons, ComCtrls, CommCtrl,
  21. ScintInt, ScintEdit, IDE.ScintStylerInnoSetup, NewTabSet, ModernColors, IDE.IDEScintEdit,
  22. Shared.DebugStruct, Shared.CompilerInt.Struct, NewUxTheme, ImageList, ImgList, ToolWin, IDE.HelperFunc,
  23. VirtualImageList, BaseImageCollection;
  24. const
  25. WM_StartCommandLineCompile = WM_USER + $1000;
  26. WM_StartCommandLineWizard = WM_USER + $1001;
  27. WM_StartNormally = WM_USER + $1002;
  28. type
  29. PDebugEntryArray = ^TDebugEntryArray;
  30. TDebugEntryArray = array[0..0] of TDebugEntry;
  31. PVariableDebugEntryArray = ^TVariableDebugEntryArray;
  32. TVariableDebugEntryArray = array[0..0] of TVariableDebugEntry;
  33. TStepMode = (smRun, smStepInto, smStepOver, smStepOut, smRunToCursor);
  34. TDebugTarget = (dtSetup, dtUninstall);
  35. const
  36. DebugTargetStrings: array[TDebugTarget] of String = ('Setup', 'Uninstall');
  37. type
  38. TStatusMessageKind = (smkStartEnd, smkNormal, smkWarning, smkError);
  39. TIncludedFile = class
  40. Filename: String;
  41. CompilerFileIndex: Integer;
  42. LastWriteTime: TFileTime;
  43. HasLastWriteTime: Boolean;
  44. Memo: TIDEScintFileEdit;
  45. end;
  46. TIncludedFiles = TObjectList<TIncludedFile>;
  47. TFindResult = class
  48. Filename: String;
  49. Line, LineStartPos: Integer;
  50. Range: TScintRange;
  51. PrefixStringLength: Integer;
  52. end;
  53. TFindResults = TObjectList<TFindResult>;
  54. TMenuBitmaps = TDictionary<TMenuItem, HBITMAP>;
  55. TKeyMappedMenus = TDictionary<TShortCut, TToolButton>;
  56. TCallTipState = record
  57. StartCallTipWord: Integer;
  58. FunctionDefinition: AnsiString;
  59. BraceCount: Integer;
  60. LastPosCallTip: Integer;
  61. ClassOrRecordMember: Boolean;
  62. CurrentCallTipWord: String;
  63. CurrentCallTip: Integer;
  64. MaxCallTips: Integer;
  65. end;
  66. TUpdatePanelMessage = class
  67. Msg, ConfigIdent: String;
  68. ConfigValue: Integer;
  69. Color: TColor;
  70. constructor Create(const AMsg, AConfigIdent: String; const AConfigValue: Integer; const AColor: TColor);
  71. end;
  72. TUpdatePanelMessages = TObjectList<TUpdatePanelMessage>;
  73. TMainForm = class(TUIStateForm)
  74. MainMenu1: TMainMenu;
  75. FMenu: TMenuItem;
  76. FNewMainFile: TMenuItem;
  77. FOpenMainFile: TMenuItem;
  78. FSave: TMenuItem;
  79. FSaveMainFileAs: TMenuItem;
  80. N1: TMenuItem;
  81. BCompile: TMenuItem;
  82. N2: TMenuItem;
  83. FExit: TMenuItem;
  84. EMenu: TMenuItem;
  85. EUndo: TMenuItem;
  86. N3: TMenuItem;
  87. ECut: TMenuItem;
  88. ECopy: TMenuItem;
  89. EPaste: TMenuItem;
  90. EDelete: TMenuItem;
  91. N4: TMenuItem;
  92. ESelectAll: TMenuItem;
  93. VMenu: TMenuItem;
  94. EFind: TMenuItem;
  95. EFindNext: TMenuItem;
  96. EReplace: TMenuItem;
  97. HMenu: TMenuItem;
  98. HDoc: TMenuItem;
  99. HAbout: TMenuItem;
  100. FRecent: TMenuItem;
  101. FClearRecent: TMenuItem;
  102. N6: TMenuItem;
  103. VCompilerOutput: TMenuItem;
  104. FindDialog: TFindDialog;
  105. ReplaceDialog: TReplaceDialog;
  106. StatusPanel: TPanel;
  107. CompilerOutputList: TListBox;
  108. SplitPanel: TPanel;
  109. HWebsite: TMenuItem;
  110. VToolbar: TMenuItem;
  111. N7: TMenuItem;
  112. TOptions: TMenuItem;
  113. HFaq: TMenuItem;
  114. StatusBar: TStatusBar;
  115. BodyPanel: TPanel;
  116. VStatusBar: TMenuItem;
  117. ERedo: TMenuItem;
  118. RMenu: TMenuItem;
  119. RStepInto: TMenuItem;
  120. RStepOver: TMenuItem;
  121. N5: TMenuItem;
  122. RRun: TMenuItem;
  123. RRunToCursor: TMenuItem;
  124. N10: TMenuItem;
  125. REvaluate: TMenuItem;
  126. CheckIfRunningTimer: TTimer;
  127. RPause: TMenuItem;
  128. RParameters: TMenuItem;
  129. OutputListPopupMenu: TMenuItem;
  130. POutputListCopy: TMenuItem;
  131. HISPPSep: TMenuItem;
  132. N12: TMenuItem;
  133. BStopCompile: TMenuItem;
  134. HISPPDoc: TMenuItem;
  135. N13: TMenuItem;
  136. EGoto: TMenuItem;
  137. RTerminate: TMenuItem;
  138. BMenu: TMenuItem;
  139. BLowPriority: TMenuItem;
  140. HDonate: TMenuItem;
  141. N14: TMenuItem;
  142. N15: TMenuItem;
  143. RTargetSetup: TMenuItem;
  144. RTargetUninstall: TMenuItem;
  145. OutputTabSet: TNewTabSet;
  146. DebugOutputList: TListBox;
  147. VDebugOutput: TMenuItem;
  148. VHide: TMenuItem;
  149. N11: TMenuItem;
  150. TMenu: TMenuItem;
  151. TAddRemovePrograms: TMenuItem;
  152. RToggleBreakPoint: TMenuItem;
  153. RDeleteBreakPoints: TMenuItem;
  154. HWhatsNew: TMenuItem;
  155. TGenerateGUID: TMenuItem;
  156. TSignTools: TMenuItem;
  157. N16: TMenuItem;
  158. HExamples: TMenuItem;
  159. N17: TMenuItem;
  160. BOpenOutputFolder: TMenuItem;
  161. N8: TMenuItem;
  162. VZoom: TMenuItem;
  163. VZoomIn: TMenuItem;
  164. VZoomOut: TMenuItem;
  165. N9: TMenuItem;
  166. VZoomReset: TMenuItem;
  167. N18: TMenuItem;
  168. N19: TMenuItem;
  169. FSaveEncoding: TMenuItem;
  170. FSaveEncodingAuto: TMenuItem;
  171. FSaveEncodingUTF8WithBOM: TMenuItem;
  172. ToolBar: TToolBar;
  173. BackNavButton: TToolButton;
  174. ForwardNavButton: TToolButton;
  175. ToolButton1: TToolButton;
  176. NewMainFileButton: TToolButton;
  177. OpenMainFileButton: TToolButton;
  178. SaveButton: TToolButton;
  179. ToolButton2: TToolButton;
  180. CompileButton: TToolButton;
  181. StopCompileButton: TToolButton;
  182. ToolButton3: TToolButton;
  183. RunButton: TToolButton;
  184. PauseButton: TToolButton;
  185. ToolButton4: TToolButton;
  186. TargetSetupButton: TToolButton;
  187. TargetUninstallButton: TToolButton;
  188. ToolButton5: TToolButton;
  189. HelpButton: TToolButton;
  190. Bevel1: TBevel;
  191. TerminateButton: TToolButton;
  192. ThemedToolbarVirtualImageList: TVirtualImageList;
  193. LightToolbarVirtualImageList: TVirtualImageList;
  194. POutputListSelectAll: TMenuItem;
  195. DebugCallStackList: TListBox;
  196. VDebugCallStack: TMenuItem;
  197. TMsgBoxDesigner: TMenuItem;
  198. TRegistryDesigner: TMenuItem;
  199. ToolBarPanel: TPanel;
  200. HMailingList: TMenuItem;
  201. MemosTabSet: TNewTabSet; { First tab is the main memo, last tab is the preprocessor output memo }
  202. FSaveAll: TMenuItem;
  203. RStepOut: TMenuItem;
  204. VNextTab: TMenuItem;
  205. VPreviousTab: TMenuItem;
  206. N20: TMenuItem;
  207. HShortcutsDoc: TMenuItem;
  208. HRegExDoc: TMenuItem;
  209. N21: TMenuItem;
  210. EFindPrevious: TMenuItem;
  211. FindResultsList: TListBox;
  212. VFindResults: TMenuItem;
  213. EFindInFiles: TMenuItem;
  214. FindInFilesDialog: TFindDialog;
  215. FPrint: TMenuItem;
  216. N22: TMenuItem;
  217. PrintDialog: TPrintDialog;
  218. FSaveEncodingUTF8WithoutBOM: TMenuItem;
  219. TFilesDesigner: TMenuItem;
  220. VCloseCurrentTab: TMenuItem;
  221. VReopenTab: TMenuItem;
  222. VReopenTabs: TMenuItem;
  223. MemosTabSetPopupMenu: TMenuItem;
  224. VCloseCurrentTab2: TMenuItem;
  225. VReopenTab2: TMenuItem;
  226. VReopenTabs2: TMenuItem;
  227. NavPopupMenu: TMenuItem;
  228. N23: TMenuItem;
  229. ThemedMarkersAndACVirtualImageList: TVirtualImageList;
  230. ESelectNextOccurrence: TMenuItem;
  231. ESelectAllOccurrences: TMenuItem;
  232. BreakPointsPopupMenu: TMenuItem;
  233. RToggleBreakPoint2: TMenuItem;
  234. RDeleteBreakPoints2: TMenuItem;
  235. N24: TMenuItem;
  236. VWordWrap: TMenuItem;
  237. N25: TMenuItem;
  238. ESelectAllFindMatches: TMenuItem;
  239. EToggleLinesComment: TMenuItem;
  240. EBraceMatch: TMenuItem;
  241. EFoldLine: TMenuItem;
  242. EUnfoldLine: TMenuItem;
  243. EFindRegEx: TMenuItem;
  244. UpdatePanel: TPanel;
  245. UpdateLinkLabel: TLinkLabel;
  246. UpdatePanelClosePaintBox: TPaintBox;
  247. UpdatePanelDonateImage: TImage;
  248. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  249. procedure FExitClick(Sender: TObject);
  250. procedure FOpenMainFileClick(Sender: TObject);
  251. procedure EUndoClick(Sender: TObject);
  252. procedure EMenuClick(Sender: TObject);
  253. procedure ECutClick(Sender: TObject);
  254. procedure ECopyClick(Sender: TObject);
  255. procedure EPasteClick(Sender: TObject);
  256. procedure EDeleteClick(Sender: TObject);
  257. procedure FSaveClick(Sender: TObject);
  258. procedure ESelectAllClick(Sender: TObject);
  259. procedure FNewMainFileClick(Sender: TObject);
  260. procedure FNewMainFileUserWizardClick(Sender: TObject);
  261. procedure HDocClick(Sender: TObject);
  262. procedure BCompileClick(Sender: TObject);
  263. procedure FMenuClick(Sender: TObject);
  264. procedure FMRUClick(Sender: TObject);
  265. procedure VCompilerOutputClick(Sender: TObject);
  266. procedure HAboutClick(Sender: TObject);
  267. procedure EFindClick(Sender: TObject);
  268. procedure FindDialogFind(Sender: TObject);
  269. procedure EReplaceClick(Sender: TObject);
  270. procedure ReplaceDialogReplace(Sender: TObject);
  271. procedure EFindNextOrPreviousClick(Sender: TObject);
  272. procedure SplitPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
  273. Y: Integer);
  274. procedure VMenuClick(Sender: TObject);
  275. procedure HWebsiteClick(Sender: TObject);
  276. procedure VToolbarClick(Sender: TObject);
  277. procedure TOptionsClick(Sender: TObject);
  278. procedure HFaqClick(Sender: TObject);
  279. procedure HISPPDocClick(Sender: TObject);
  280. procedure VStatusBarClick(Sender: TObject);
  281. procedure ERedoClick(Sender: TObject);
  282. procedure StatusBarResize(Sender: TObject);
  283. procedure RStepIntoClick(Sender: TObject);
  284. procedure RStepOverClick(Sender: TObject);
  285. procedure RRunToCursorClick(Sender: TObject);
  286. procedure RRunClick(Sender: TObject);
  287. procedure REvaluateClick(Sender: TObject);
  288. procedure CheckIfRunningTimerTimer(Sender: TObject);
  289. procedure RPauseClick(Sender: TObject);
  290. procedure RParametersClick(Sender: TObject);
  291. procedure POutputListCopyClick(Sender: TObject);
  292. procedure BStopCompileClick(Sender: TObject);
  293. procedure EGotoClick(Sender: TObject);
  294. procedure RTerminateClick(Sender: TObject);
  295. procedure BMenuClick(Sender: TObject);
  296. procedure BLowPriorityClick(Sender: TObject);
  297. procedure StatusBarDrawPanel(StatusBar: TStatusBar;
  298. Panel: TStatusPanel; const Rect: TRect);
  299. procedure HDonateClick(Sender: TObject);
  300. procedure RTargetClick(Sender: TObject);
  301. procedure DebugOutputListDrawItem(Control: TWinControl; Index: Integer;
  302. Rect: TRect; State: TOwnerDrawState);
  303. procedure OutputTabSetClick(Sender: TObject);
  304. procedure VHideClick(Sender: TObject);
  305. procedure VDebugOutputClick(Sender: TObject);
  306. procedure FormResize(Sender: TObject);
  307. procedure TAddRemoveProgramsClick(Sender: TObject);
  308. procedure RToggleBreakPointClick(Sender: TObject);
  309. procedure RDeleteBreakPointsClick(Sender: TObject);
  310. procedure HWhatsNewClick(Sender: TObject);
  311. procedure TGenerateGUIDClick(Sender: TObject);
  312. procedure TSignToolsClick(Sender: TObject);
  313. procedure HExamplesClick(Sender: TObject);
  314. procedure BOpenOutputFolderClick(Sender: TObject);
  315. procedure FormKeyDown(Sender: TObject; var Key: Word;
  316. Shift: TShiftState);
  317. procedure VZoomInClick(Sender: TObject);
  318. procedure VZoomOutClick(Sender: TObject);
  319. procedure VZoomResetClick(Sender: TObject);
  320. procedure FSaveEncodingItemClick(Sender: TObject);
  321. procedure CompilerOutputListDrawItem(Control: TWinControl; Index: Integer;
  322. Rect: TRect; State: TOwnerDrawState);
  323. procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
  324. NewDPI: Integer);
  325. procedure POutputListSelectAllClick(Sender: TObject);
  326. procedure DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  327. State: TOwnerDrawState);
  328. procedure VDebugCallStackClick(Sender: TObject);
  329. procedure HMailingListClick(Sender: TObject);
  330. procedure TMsgBoxDesignerClick(Sender: TObject);
  331. procedure TRegistryDesignerClick(Sender: TObject);
  332. procedure MemosTabSetClick(Sender: TObject);
  333. procedure FSaveAllClick(Sender: TObject);
  334. procedure RStepOutClick(Sender: TObject);
  335. procedure TMenuClick(Sender: TObject);
  336. procedure VNextTabClick(Sender: TObject);
  337. procedure VPreviousTabClick(Sender: TObject);
  338. procedure HShortcutsDocClick(Sender: TObject);
  339. procedure HRegExDocClick(Sender: TObject);
  340. procedure VFindResultsClick(Sender: TObject);
  341. procedure EFindInFilesClick(Sender: TObject);
  342. procedure FindInFilesDialogFind(Sender: TObject);
  343. procedure FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  344. State: TOwnerDrawState);
  345. procedure FindResultsListDblClick(Sender: TObject);
  346. procedure FPrintClick(Sender: TObject);
  347. procedure TFilesDesignerClick(Sender: TObject);
  348. procedure VCloseCurrentTabClick(Sender: TObject);
  349. procedure VReopenTabsClick(Sender: TObject);
  350. procedure MemosTabSetPopupMenuClick(Sender: TObject);
  351. procedure MemosTabSetOnCloseButtonClick(Sender: TObject; Index: Integer);
  352. procedure StatusBarClick(Sender: TObject);
  353. procedure SimpleMenuClick(Sender: TObject);
  354. procedure OutputListKeyDown(Sender: TObject; var Key: Word;
  355. Shift: TShiftState);
  356. procedure RMenuClick(Sender: TObject);
  357. procedure BackNavButtonClick(Sender: TObject);
  358. procedure ForwardNavButtonClick(Sender: TObject);
  359. procedure NavPopupMenuClick(Sender: TObject);
  360. procedure ESelectNextOccurrenceClick(Sender: TObject);
  361. procedure ESelectAllOccurrencesClick(Sender: TObject);
  362. procedure BreakPointsPopupMenuClick(Sender: TObject);
  363. procedure FClearRecentClick(Sender: TObject);
  364. procedure VWordWrapClick(Sender: TObject);
  365. procedure ESelectAllFindMatchesClick(Sender: TObject);
  366. procedure EToggleLinesCommentClick(Sender: TObject);
  367. procedure EBraceMatchClick(Sender: TObject);
  368. procedure EFoldOrUnfoldLineClick(Sender: TObject);
  369. procedure EFindRegExClick(Sender: TObject);
  370. procedure UpdateLinkLabelLinkClick(Sender: TObject; const Link: string;
  371. LinkType: TSysLinkType);
  372. procedure UpdatePanelClosePaintBoxPaint(Sender: TObject);
  373. procedure UpdatePanelClosePaintBoxClick(Sender: TObject);
  374. procedure UpdatePanelDonateImageClick(Sender: TObject);
  375. private
  376. { Private declarations }
  377. FMemos: TList<TIDEScintEdit>; { FMemos[0] is the main memo and FMemos[1] the preprocessor output memo - also see MemosTabSet comment above }
  378. FMainMemo: TIDEScintFileEdit; { Doesn't change }
  379. FPreprocessorOutputMemo: TIDEScintEdit; { Doesn't change and is the only memo which isnt a TIDEScint*File*Edit}
  380. FFileMemos: TList<TIDEScintFileEdit>; { All memos except FPreprocessorOutputMemo, including those without a tab }
  381. FHiddenFiles: TStringList; { List of files which *do* use a memo but are hidden by the user and have no tab }
  382. FActiveMemo: TIDEScintEdit; { Changes depending on user input }
  383. FErrorMemo, FStepMemo: TIDEScintFileEdit; { These change depending on user input }
  384. FMemosStyler: TInnoSetupStyler; { Single styler for all memos }
  385. FCompilerVersion: PCompilerVersionInfo;
  386. FMRUMainFilesMenuItems: array[0..MRUListMaxCount-1] of TMenuItem;
  387. FMRUMainFilesList: TStringList;
  388. FMRUParametersList: TStringList;
  389. FOptions: record
  390. ShowStartupForm: Boolean;
  391. UseWizard: Boolean;
  392. Autosave: Boolean;
  393. MakeBackups: Boolean;
  394. FullPathInTitleBar: Boolean;
  395. UndoAfterSave: Boolean;
  396. PauseOnDebuggerExceptions: Boolean;
  397. RunAsDifferentUser: Boolean;
  398. AutoAutoComplete: Boolean;
  399. AutoCallTips: Boolean;
  400. UseSyntaxHighlighting: Boolean;
  401. ColorizeCompilerOutput: Boolean;
  402. UnderlineErrors: Boolean;
  403. HighlightWordAtCursorOccurrences: Boolean;
  404. HighlightSelTextOccurrences: Boolean;
  405. CursorPastEOL: Boolean;
  406. TabWidth: Integer;
  407. UseTabCharacter: Boolean;
  408. ShowWhiteSpace: Boolean;
  409. UseFolding: Boolean;
  410. FindRegEx: Boolean;
  411. WordWrap: Boolean;
  412. AutoIndent: Boolean;
  413. IndentationGuides: Boolean;
  414. LowPriorityDuringCompile: Boolean;
  415. GutterLineNumbers: Boolean;
  416. KeyMappingType: TKeyMappingType;
  417. MemoKeyMappingType: TIDEScintKeyMappingType;
  418. ThemeType: TThemeType;
  419. ShowPreprocessorOutput: Boolean;
  420. OpenIncludedFiles: Boolean;
  421. ShowCaretPosition: Boolean;
  422. end;
  423. FOptionsLoaded: Boolean;
  424. FTheme: TTheme;
  425. FSignTools: TStringList;
  426. FFindResults: TFindResults;
  427. FCompiling: Boolean;
  428. FCompileWantAbort: Boolean;
  429. FBecameIdle: Boolean;
  430. FModifiedAnySinceLastCompile, FModifiedAnySinceLastCompileAndGo: Boolean;
  431. FDebugEntries: PDebugEntryArray;
  432. FDebugEntriesCount: Integer;
  433. FVariableDebugEntries: PVariableDebugEntryArray;
  434. FVariableDebugEntriesCount: Integer;
  435. FCompiledCodeText: AnsiString;
  436. FCompiledCodeDebugInfo: AnsiString;
  437. FDebugClientWnd: HWND;
  438. FProcessHandle, FDebugClientProcessHandle: THandle;
  439. FDebugTarget: TDebugTarget;
  440. FCompiledExe, FUninstExe, FTempDir: String;
  441. FPreprocessorOutput: String;
  442. FIncludedFiles: TIncludedFiles;
  443. FDebugging: Boolean;
  444. FStepMode: TStepMode;
  445. FPaused, FPausedAtCodeLine: Boolean;
  446. FRunToCursorPoint: TDebugEntry;
  447. FReplyString: String;
  448. FDebuggerException: String;
  449. FRunParameters: String;
  450. FLastFindOptions: TFindOptions;
  451. FLastFindRegEx: Boolean;
  452. FLastFindText: String;
  453. FLastReplaceText: String;
  454. FLastEvaluateConstantText: String;
  455. FSavePriorityClass: DWORD;
  456. FBuildAnimationFrame: Cardinal;
  457. FLastAnimationTick: DWORD;
  458. FProgress, FProgressMax: Cardinal;
  459. FTaskbarProgressValue: Cardinal;
  460. FProgressThemeData: HTHEME;
  461. FMenuThemeData: HTHEME;
  462. FToolbarThemeData: HTHEME;
  463. FMenuDarkBackgroundBrush: TBrush;
  464. FMenuDarkHotOrSelectedBrush: TBrush;
  465. FDebugLogListTimestampsWidth: Integer;
  466. FOnPendingSquiggly: Boolean;
  467. FPendingSquigglyCaretPos: Integer;
  468. FCallStackCount: Cardinal;
  469. FDevMode, FDevNames: HGLOBAL;
  470. FMenuImageList: TVirtualImageList;
  471. FMenuBitmaps: TMenuBitmaps;
  472. FMenuBitmapsSize: TSize;
  473. FMenuBitmapsSourceImageCollection: TCustomImageCollection;
  474. FSynchingZoom: Boolean;
  475. FNavStacks: TIDEScintEditNavStacks;
  476. FCurrentNavItem: TIDEScintEditNavItem;
  477. FKeyMappedMenus: TKeyMappedMenus;
  478. FBackNavButtonShortCut, FForwardNavButtonShortCut: TShortCut;
  479. FBackNavButtonShortCut2, FForwardNavButtonShortCut2: TShortCut;
  480. FIgnoreTabSetClick: Boolean;
  481. FFirstTabSelectShortCut, FLastTabSelectShortCut: TShortCut;
  482. FCompileShortCut2: TShortCut;
  483. FCallTipState: TCallTipState;
  484. FUpdatePanelMessages: TUpdatePanelMessages;
  485. function AnyMemoHasBreakPoint: Boolean;
  486. class procedure AppOnException(Sender: TObject; E: Exception);
  487. procedure AppOnActivate(Sender: TObject);
  488. class procedure AppOnGetActiveFormHandle(var AHandle: HWND);
  489. procedure AppOnIdle(Sender: TObject; var Done: Boolean);
  490. function AskToDetachDebugger: Boolean;
  491. procedure BringToForeground;
  492. procedure BuildAndSaveBreakPointLines(const AMemo: TIDEScintFileEdit);
  493. procedure BuildAndSaveKnownIncludedAndHiddenFiles;
  494. procedure CheckIfTerminated;
  495. procedure ClearMRUMainFilesList;
  496. procedure CloseTab(const TabIndex: Integer);
  497. procedure CompileFile(AFilename: String; const ReadFromFile: Boolean);
  498. procedure CompileIfNecessary;
  499. function ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
  500. procedure DebuggingStopped(const WaitForTermination: Boolean);
  501. procedure DebugLogMessage(const S: String);
  502. procedure DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
  503. function DestroyLineState(const AMemo: TIDEScintFileEdit): Boolean;
  504. procedure DestroyDebugInfo;
  505. procedure DetachDebugger;
  506. function EvaluateConstant(const S: String; out Output: String): Integer;
  507. function EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
  508. out Output: String): Integer;
  509. procedure FindNext(const ReverseDirection: Boolean);
  510. function FindSetupDirectiveValue(const DirectiveName,
  511. DefaultValue: String): String; overload;
  512. function FindSetupDirectiveValue(const DirectiveName: String;
  513. DefaultValue: Boolean): Boolean; overload;
  514. function FromCurrentPPI(const XY: Integer): Integer;
  515. function GetBorderStyle: TFormBorderStyle;
  516. procedure Go(AStepMode: TStepMode);
  517. procedure HideError;
  518. procedure InitializeFindText(Dlg: TFindDialog);
  519. function InitializeFileMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
  520. function InitializeMainMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
  521. function InitializeMemoBase(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
  522. function InitializeNonFileMemo(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
  523. function InitiateAutoCompleteOrCallTipAllowedAtPos(const AMemo: TIDEScintEdit;
  524. const WordStartLinePos, PositionBeforeWordStartPos: Integer): Boolean;
  525. procedure InitiateAutoComplete(const Key: AnsiChar);
  526. procedure UpdateCallTipFunctionDefinition(const Pos: Integer = -1);
  527. procedure InitiateCallTip(const Key: AnsiChar);
  528. procedure ContinueCallTip;
  529. procedure InvalidateStatusPanel(const Index: Integer);
  530. procedure LoadBreakPointLinesAndUpdateLineMarkers(const AMemo: TIDEScintFileEdit);
  531. procedure LoadKnownIncludedAndHiddenFilesAndUpdateMemos(const AFilename: String);
  532. procedure MemoCallTipArrowClick(Sender: TObject; const Up: Boolean);
  533. procedure MemoChange(Sender: TObject; const Info: TScintEditChangeInfo);
  534. procedure MemoCharAdded(Sender: TObject; Ch: AnsiChar);
  535. procedure MainMemoDropFiles(Sender: TObject; X, Y: Integer; AFiles: TStrings);
  536. procedure MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
  537. procedure MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  538. procedure MemoKeyPress(Sender: TObject; var Key: Char);
  539. procedure MemoLinesDeleted(Memo: TIDEScintFileEdit; FirstLine, Count, FirstAffectedLine: Integer);
  540. procedure MemoLinesInserted(Memo: TIDEScintFileEdit; FirstLine, Count: integer);
  541. procedure MemoMarginClick(Sender: TObject; MarginNumber: Integer;
  542. Line: Integer);
  543. procedure MemoMarginRightClick(Sender: TObject; MarginNumber: Integer;
  544. Line: Integer);
  545. procedure MemoModifiedChange(Sender: TObject);
  546. function MemoToTabIndex(const AMemo: TIDEScintEdit): Integer;
  547. procedure MemoUpdateUI(Sender: TObject; Updated: TScintEditUpdates);
  548. procedure MemoZoom(Sender: TObject);
  549. function MultipleSelectionPasteFromClipboard(const AMemo: TIDESCintEdit): Boolean;
  550. procedure UpdateReopenTabMenu(const Menu: TMenuItem);
  551. procedure ModifyMRUMainFilesList(const AFilename: String; const AddNewItem: Boolean);
  552. procedure ModifyMRUParametersList(const AParameter: String; const AddNewItem: Boolean);
  553. procedure MoveCaretAndActivateMemo(AMemo: TIDEScintEdit; const LineNumberOrPosition: Integer;
  554. const AlwaysResetColumnEvenIfOnRequestedLineAlready: Boolean;
  555. const IsPosition: Boolean = False; const PositionVirtualSpace: Integer = 0);
  556. procedure NavItemClick(Sender: TObject);
  557. procedure NewMainFile;
  558. procedure NewMainFileUsingWizard;
  559. procedure OpenFile(AMemo: TIDEScintFileEdit; AFilename: String; const MainMemoAddToRecentDocs: Boolean);
  560. procedure OpenMRUMainFile(const AFilename: String);
  561. procedure ParseDebugInfo(DebugInfo: Pointer);
  562. procedure ReadMRUMainFilesList;
  563. procedure ReadMRUParametersList;
  564. procedure RemoveMemoFromNav(const AMemo: TIDEScintEdit);
  565. procedure RemoveMemoBadLinesFromNav(const AMemo: TIDEScintEdit);
  566. procedure ReopenTabClick(Sender: TObject);
  567. procedure ReopenTabOrTabs(const HiddenFileIndex: Integer; const Activate: Boolean);
  568. procedure ResetAllMemosLineState;
  569. procedure StartProcess;
  570. function SaveFile(const AMemo: TIDEScintFileEdit; const SaveAs: Boolean): Boolean;
  571. procedure SetBorderStyle(Value: TFormBorderStyle);
  572. procedure SetErrorLine(const AMemo: TIDEScintFileEdit; const ALine: Integer);
  573. procedure SetStatusPanelVisible(const AVisible: Boolean);
  574. procedure SetStepLine(const AMemo: TIDEScintFileEdit; ALine: Integer);
  575. procedure ShowOpenMainFileDialog(const Examples: Boolean);
  576. procedure StatusMessage(const Kind: TStatusMessageKind; const S: String);
  577. function StoreAndTestLastFindOptions(Sender: TObject): Boolean;
  578. function TestLastFindOptions: Boolean;
  579. procedure SyncEditorOptions;
  580. function TabIndexToMemo(const ATabIndex, AMaxTabIndex: Integer): TIDEScintEdit;
  581. function ToCurrentPPI(const XY: Integer): Integer;
  582. procedure ToggleBreakPoint(Line: Integer);
  583. procedure UpdateAllMemoLineMarkers(const AMemo: TIDEScintFileEdit);
  584. procedure UpdateAllMemosLineMarkers;
  585. procedure UpdateBevel1Visibility;
  586. procedure UpdateCaption;
  587. procedure UpdateCaretPosPanelAndBackNavStack;
  588. procedure UpdateCompileStatusPanels(const AProgress, AProgressMax: Cardinal;
  589. const ASecondsRemaining: Integer; const ABytesCompressedPerSecond: Cardinal);
  590. procedure UpdateEditModePanel;
  591. procedure UpdateFindRegExUI;
  592. procedure UpdatePreprocMemos;
  593. procedure UpdateLineMarkers(const AMemo: TIDEScintFileEdit; const Line: Integer);
  594. procedure UpdateImages;
  595. procedure UpdateMarginsAndAutoCompleteIcons;
  596. procedure UpdateMarginsAndSquigglyAndCaretWidths;
  597. procedure UpdateMemosTabSetVisibility;
  598. procedure UpdateMenuBitmapsIfNeeded;
  599. procedure UpdateModifiedPanel;
  600. procedure UpdateNavButtons;
  601. procedure UpdateNewMainFileButtons;
  602. procedure UpdateOccurrenceIndicators(const AMemo: TIDEScintEdit);
  603. procedure UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  604. procedure UpdateRunMenu;
  605. procedure UpdateSaveMenuItemAndButton;
  606. procedure UpdateTargetMenu;
  607. procedure UpdateUpdatePanel;
  608. procedure UpdateKeyMapping;
  609. procedure UpdateTheme;
  610. procedure UpdateThemeData(const Open: Boolean);
  611. procedure ApplyMenuBitmaps(const ParentMenuItem: TMenuItem);
  612. procedure UpdateStatusPanelHeight(H: Integer);
  613. procedure WMAppCommand(var Message: TMessage); message WM_APPCOMMAND;
  614. procedure WMCopyData(var Message: TWMCopyData); message WM_COPYDATA;
  615. procedure WMDebuggerHello(var Message: TMessage); message WM_Debugger_Hello;
  616. procedure WMDebuggerGoodbye(var Message: TMessage); message WM_Debugger_Goodbye;
  617. procedure WMDebuggerQueryVersion(var Message: TMessage); message WM_Debugger_QueryVersion;
  618. procedure GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TIDEScintFileEdit;
  619. var DebugEntry: PDebugEntry);
  620. procedure DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
  621. procedure WMDebuggerStepped(var Message: TMessage); message WM_Debugger_Stepped;
  622. procedure WMDebuggerSteppedIntermediate(var Message: TMessage); message WM_Debugger_SteppedIntermediate;
  623. procedure WMDebuggerException(var Message: TMessage); message WM_Debugger_Exception;
  624. procedure WMDebuggerSetForegroundWindow(var Message: TMessage); message WM_Debugger_SetForegroundWindow;
  625. procedure WMDebuggerCallStackCount(var Message: TMessage); message WM_Debugger_CallStackCount;
  626. procedure WMStartCommandLineCompile(var Message: TMessage); message WM_StartCommandLineCompile;
  627. procedure WMStartCommandLineWizard(var Message: TMessage); message WM_StartCommandLineWizard;
  628. procedure WMStartNormally(var Message: TMessage); message WM_StartNormally;
  629. procedure WMDPIChanged(var Message: TMessage); message WM_DPICHANGED;
  630. procedure WMSettingChange(var Message: TMessage); message WM_SETTINGCHANGE;
  631. procedure WMSysColorChange(var Message: TMessage); message WM_SYSCOLORCHANGE;
  632. procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
  633. procedure WMUAHDrawMenu(var Message: TMessage); message WM_UAHDRAWMENU;
  634. procedure WMUAHDrawMenuItem(var Message: TMessage); message WM_UAHDRAWMENUITEM;
  635. procedure UAHDrawMenuBottomLine;
  636. procedure WMNCActivate(var Message: TMessage); message WM_NCACTIVATE;
  637. procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  638. protected
  639. procedure WndProc(var Message: TMessage); override;
  640. public
  641. { Public declarations }
  642. constructor Create(AOwner: TComponent); override;
  643. destructor Destroy; override;
  644. function IsShortCut(var Message: TWMKey): Boolean; override;
  645. published
  646. property BorderStyle: TFormBorderStyle read GetBorderStyle write SetBorderStyle;
  647. end;
  648. var
  649. MainForm: TMainForm;
  650. CommandLineFilename, CommandLineWizardName: String;
  651. CommandLineCompile: Boolean;
  652. CommandLineWizard: Boolean;
  653. implementation
  654. uses
  655. ActiveX, Clipbrd, ShellApi, ShlObj, IniFiles, Registry, Consts, Types, UITypes,
  656. Math, StrUtils, WideStrUtils,
  657. PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc, Shared.FileClass, IDE.Messages, NewUxTheme.TmSchema, BrowseFunc,
  658. IDE.HtmlHelpFunc, TaskbarProgressFunc, IDE.ImagesModule,
  659. {$IFDEF STATICCOMPILER} Compiler.Compile, {$ENDIF}
  660. IDE.OptionsForm, IDE.StartupForm, IDE.Wizard.WizardForm, IDE.SignToolsForm,
  661. Shared.ConfigIniFile, Shared.SignToolsFunc, IDE.InputQueryComboForm, IDE.MsgBoxDesignerForm,
  662. IDE.FilesDesignerForm, IDE.RegistryDesignerForm, IDE.Wizard.WizardFormRegistryHelper,
  663. Shared.CompilerInt;
  664. {$R *.DFM}
  665. const
  666. { Memos }
  667. MaxMemos = 22; { Includes the main and preprocessor output memos }
  668. FirstIncludedFilesMemoIndex = 1; { This is an index into FFileMemos }
  669. { Status bar panel indexes }
  670. spCaretPos = 0;
  671. spModified = 1;
  672. spEditMode = 2;
  673. spFindRegEx = 3;
  674. spHiddenFilesCount = 4;
  675. spCompileIcon = 5;
  676. spCompileProgress = 6;
  677. spExtraStatus = 7;
  678. { Output tab set indexes }
  679. tiCompilerOutput = 0;
  680. tiDebugOutput = 1;
  681. tiDebugCallStack = 2;
  682. tiFindResults = 3;
  683. LineStateGrowAmount = 4000;
  684. { TUpdatePanelMessage }
  685. constructor TUpdatePanelMessage.Create(const AMsg, AConfigIdent: String;
  686. const AConfigValue: Integer; const AColor: TColor);
  687. begin
  688. Msg := AMsg;
  689. ConfigIdent := AConfigIdent;
  690. ConfigValue := AConfigValue;
  691. Color := AColor;
  692. end;
  693. { TMainFormPopupMenu }
  694. type
  695. TMainFormPopupMenu = class(TPopupMenu)
  696. private
  697. FParentMenuItem: TMenuItem;
  698. public
  699. constructor Create(const AOwner: TComponent; const ParentMenuItem: TMenuItem); reintroduce; virtual;
  700. procedure Popup(X, Y: Integer); override;
  701. end;
  702. constructor TMainFormPopupMenu.Create(const AOwner: TComponent; const ParentMenuItem: TMenuItem);
  703. begin
  704. inherited Create(AOwner);
  705. FParentMenuItem := ParentMenuItem;
  706. end;
  707. procedure TMainFormPopupMenu.Popup(X, Y: Integer);
  708. var
  709. Form: TMainForm;
  710. begin
  711. { Show the existing main menu's submenu }
  712. Form := Owner as TMainForm;
  713. var OldVisible := FParentMenuItem.Visible; { See ApplyMenuBitmaps }
  714. FParentMenuItem.Visible := True;
  715. try
  716. TrackPopupMenu(FParentMenuItem.Handle, TPM_RIGHTBUTTON, X, Y, 0, Form.Handle, nil);
  717. finally
  718. FParentMenuItem.Visible := OldVisible;
  719. end;
  720. end;
  721. { TMainForm }
  722. function TMainForm.InitializeMemoBase(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
  723. begin
  724. Memo.Align := alClient;
  725. Memo.Font.Name := GetPreferredMemoFont; { Default font only, see ReadConfig }
  726. Memo.Font.Size := 10;
  727. Memo.ShowHint := True;
  728. Memo.Styler := FMemosStyler;
  729. Memo.PopupMenu := PopupMenu;
  730. Memo.OnCallTipArrowClick := MemoCallTipArrowClick;
  731. Memo.OnChange := MemoChange;
  732. Memo.OnCharAdded := MemoCharAdded;
  733. Memo.OnHintShow := MemoHintShow;
  734. Memo.OnKeyDown := MemoKeyDown;
  735. Memo.OnKeyPress := MemoKeyPress;
  736. Memo.OnMarginClick := MemoMarginClick;
  737. Memo.OnMarginRightClick := MemoMarginRightClick;
  738. Memo.OnModifiedChange := MemoModifiedChange;
  739. Memo.OnUpdateUI := MemoUpdateUI;
  740. Memo.OnZoom := MemoZoom;
  741. Memo.Parent := BodyPanel;
  742. Memo.SetAutoCompleteSeparators(InnoSetupStylerWordListSeparator, InnoSetupStylerWordListTypeSeparator);
  743. Memo.SetWordChars(Memo.GetDefaultWordChars+'#{}[]');
  744. Memo.Theme := FTheme;
  745. Memo.Visible := False;
  746. Result := Memo;
  747. end;
  748. function TMainForm.InitializeFileMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
  749. begin
  750. InitializeMemoBase(Memo, PopupMenu);
  751. Memo.ChangeHistory := schMarkers;
  752. Memo.CompilerFileIndex := UnknownCompilerFileIndex;
  753. Memo.ErrorLine := -1;
  754. Memo.StepLine := -1;
  755. Result := Memo;
  756. end;
  757. function TMainForm.InitializeMainMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit;
  758. begin
  759. InitializeFileMemo(Memo, PopupMenu);
  760. Memo.AcceptDroppedFiles := True;
  761. Memo.CompilerFileIndex := -1;
  762. Memo.OnDropFiles := MainMemoDropFiles;
  763. Memo.Used := True;
  764. Result := Memo;
  765. end;
  766. function TMainForm.InitializeNonFileMemo(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit;
  767. begin
  768. InitializeMemoBase(Memo, PopupMenu);
  769. Memo.ReadOnly := True;
  770. Result := Memo;
  771. end;
  772. constructor TMainForm.Create(AOwner: TComponent);
  773. procedure CheckUpdatePanelMessage(const Ini: TConfigIniFile; const ConfigIdent: String;
  774. const ConfigValueDefault, ConfigValueMinimum: Integer; const Msg: String; const Color: TColor);
  775. begin
  776. var ConfigValue := Ini.ReadInteger('UpdatePanel', ConfigIdent, ConfigValueDefault);
  777. if ConfigValue < ConfigValueMinimum then
  778. FUpdatePanelMessages.Add(TUpdatePanelMessage.Create(Msg, ConfigIdent, ConfigValueMinimum, Color));
  779. end;
  780. procedure ReadConfig;
  781. var
  782. Ini: TConfigIniFile;
  783. WindowPlacement: TWindowPlacement;
  784. I: Integer;
  785. Memo: TIDEScintEdit;
  786. begin
  787. Ini := TConfigIniFile.Create;
  788. try
  789. { Menu check boxes state }
  790. ToolbarPanel.Visible := Ini.ReadBool('Options', 'ShowToolbar', True);
  791. StatusBar.Visible := Ini.ReadBool('Options', 'ShowStatusBar', True);
  792. FOptions.LowPriorityDuringCompile := Ini.ReadBool('Options', 'LowPriorityDuringCompile', False);
  793. { Configuration options }
  794. FOptions.ShowStartupForm := Ini.ReadBool('Options', 'ShowStartupForm', True);
  795. FOptions.UseWizard := Ini.ReadBool('Options', 'UseWizard', True);
  796. FOptions.Autosave := Ini.ReadBool('Options', 'Autosave', False);
  797. FOptions.MakeBackups := Ini.ReadBool('Options', 'MakeBackups', False);
  798. FOptions.FullPathInTitleBar := Ini.ReadBool('Options', 'FullPathInTitleBar', False);
  799. FOptions.UndoAfterSave := Ini.ReadBool('Options', 'UndoAfterSave', True);
  800. FOptions.PauseOnDebuggerExceptions := Ini.ReadBool('Options', 'PauseOnDebuggerExceptions', True);
  801. FOptions.RunAsDifferentUser := Ini.ReadBool('Options', 'RunAsDifferentUser', False);
  802. FOptions.AutoAutoComplete := Ini.ReadBool('Options', 'AutoComplete', True);
  803. FOptions.AutoCallTips := Ini.ReadBool('Options', 'AutoCallTips', True);
  804. FOptions.UseSyntaxHighlighting := Ini.ReadBool('Options', 'UseSynHigh', True);
  805. FOptions.ColorizeCompilerOutput := Ini.ReadBool('Options', 'ColorizeCompilerOutput', True);
  806. FOptions.UnderlineErrors := Ini.ReadBool('Options', 'UnderlineErrors', True);
  807. FOptions.HighlightWordAtCursorOccurrences := Ini.ReadBool('Options', 'HighlightWordAtCursorOccurrences', False);
  808. FOptions.HighlightSelTextOccurrences := Ini.ReadBool('Options', 'HighlightSelTextOccurrences', True);
  809. FOptions.CursorPastEOL := Ini.ReadBool('Options', 'EditorCursorPastEOL', False);
  810. FOptions.TabWidth := Ini.ReadInteger('Options', 'TabWidth', 2);
  811. FOptions.UseTabCharacter := Ini.ReadBool('Options', 'UseTabCharacter', False);
  812. FOptions.ShowWhiteSpace := Ini.ReadBool('Options', 'ShowWhiteSpace', False);
  813. FOptions.UseFolding := Ini.ReadBool('Options', 'UseFolding', True);
  814. FOptions.FindRegEx := Ini.ReadBool('Options', 'FindRegEx', False);
  815. FOptions.WordWrap := Ini.ReadBool('Options', 'WordWrap', False);
  816. FOptions.AutoIndent := Ini.ReadBool('Options', 'AutoIndent', True);
  817. FOptions.IndentationGuides := Ini.ReadBool('Options', 'IndentationGuides', True);
  818. FOptions.GutterLineNumbers := Ini.ReadBool('Options', 'GutterLineNumbers', False);
  819. FOptions.ShowPreprocessorOutput := Ini.ReadBool('Options', 'ShowPreprocessorOutput', True);
  820. FOptions.OpenIncludedFiles := Ini.ReadBool('Options', 'OpenIncludedFiles', True);
  821. I := Ini.ReadInteger('Options', 'KeyMappingType', Ord(GetDefaultKeyMappingType));
  822. if (I >= 0) and (I <= Ord(High(TKeyMappingType))) then
  823. FOptions.KeyMappingType := TKeyMappingType(I);
  824. I := Ini.ReadInteger('Options', 'MemoKeyMappingType', Ord(GetDefaultMemoKeyMappingType));
  825. if (I >= 0) and (I <= Ord(High(TIDEScintKeyMappingType))) then
  826. FOptions.MemoKeyMappingType := TIDEScintKeyMappingType(I);
  827. I := Ini.ReadInteger('Options', 'ThemeType', Ord(GetDefaultThemeType));
  828. if (I >= 0) and (I <= Ord(High(TThemeType))) then
  829. FOptions.ThemeType := TThemeType(I);
  830. FMainMemo.Font.Name := Ini.ReadString('Options', 'EditorFontName', FMainMemo.Font.Name);
  831. FMainMemo.Font.Size := Ini.ReadInteger('Options', 'EditorFontSize', 10);
  832. FMainMemo.Font.Charset := Ini.ReadInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset);
  833. FMainMemo.Zoom := Ini.ReadInteger('Options', 'Zoom', 0); { MemoZoom will zoom the other memos }
  834. for Memo in FMemos do
  835. if Memo <> FMainMemo then
  836. Memo.Font := FMainMemo.Font;
  837. { UpdatePanel visibility }
  838. CheckUpdatePanelMessage(Ini, 'KnownVersion', 0, Integer(FCompilerVersion.BinVersion),
  839. 'Your version of Inno Setup has been updated! <a id="hwhatsnew">See what''s new</a>.',
  840. $ABE3AB); //MGreen with HSL lightness changed from 40% to 78%
  841. CheckUpdatePanelMessage(Ini, 'VSCodeMemoKeyMap', 0, 1,
  842. 'VS Code-style editor shortcuts added! Use the <a id="toptions-vscode">Editor Keys option</a> in Options dialog.',
  843. $FFD399); //MBlue with HSL lightness changed from 42% to 80%
  844. UpdateUpdatePanel;
  845. { Debug options }
  846. FOptions.ShowCaretPosition := Ini.ReadBool('Options', 'ShowCaretPosition', False);
  847. if FOptions.ShowCaretPosition then
  848. StatusBar.Panels[spCaretPos].Width := StatusBar.Panels[spCaretPos].Width * 2;
  849. SyncEditorOptions;
  850. UpdateNewMainFileButtons;
  851. UpdateKeyMapping;
  852. UpdateTheme;
  853. UpdateFindRegExUI;
  854. { Window state }
  855. WindowPlacement.length := SizeOf(WindowPlacement);
  856. GetWindowPlacement(Handle, @WindowPlacement);
  857. WindowPlacement.showCmd := SW_HIDE; { the form isn't Visible yet }
  858. WindowPlacement.rcNormalPosition.Left := Ini.ReadInteger('State',
  859. 'WindowLeft', WindowPlacement.rcNormalPosition.Left);
  860. WindowPlacement.rcNormalPosition.Top := Ini.ReadInteger('State',
  861. 'WindowTop', WindowPlacement.rcNormalPosition.Top);
  862. WindowPlacement.rcNormalPosition.Right := Ini.ReadInteger('State',
  863. 'WindowRight', WindowPlacement.rcNormalPosition.Left + Width);
  864. WindowPlacement.rcNormalPosition.Bottom := Ini.ReadInteger('State',
  865. 'WindowBottom', WindowPlacement.rcNormalPosition.Top + Height);
  866. SetWindowPlacement(Handle, @WindowPlacement);
  867. { Note: Must set WindowState *after* calling SetWindowPlacement, since
  868. TCustomForm.WMSize resets WindowState }
  869. if Ini.ReadBool('State', 'WindowMaximized', False) then
  870. WindowState := wsMaximized;
  871. { Note: Don't call UpdateStatusPanelHeight here since it clips to the
  872. current form height, which hasn't been finalized yet }
  873. { StatusPanel height }
  874. StatusPanel.Height := ToCurrentPPI(Ini.ReadInteger('State', 'StatusPanelHeight',
  875. (10 * FromCurrentPPI(DebugOutputList.ItemHeight) + 4) + FromCurrentPPI(OutputTabSet.Height)));
  876. finally
  877. Ini.Free;
  878. end;
  879. FOptionsLoaded := True;
  880. end;
  881. var
  882. I: Integer;
  883. NewItem: TMenuItem;
  884. PopupMenu: TPopupMenu;
  885. Memo: TIDEScintEdit;
  886. begin
  887. inherited;
  888. {$IFNDEF STATICCOMPILER}
  889. FCompilerVersion := ISDllGetVersion;
  890. {$ELSE}
  891. FCompilerVersion := ISGetVersion;
  892. {$ENDIF}
  893. FModifiedAnySinceLastCompile := True;
  894. InitFormFont(Self);
  895. { For some reason, if AutoScroll=False is set on the form Delphi ignores the
  896. 'poDefault' Position setting }
  897. AutoScroll := False;
  898. { Append the shortcut key text to the Edit items. Don't actually set the
  899. ShortCut property because we don't want the key combinations having an
  900. effect when Memo doesn't have the focus. }
  901. SetFakeShortCut(EUndo, Ord('Z'), [ssCtrl]);
  902. SetFakeShortCut(ERedo, Ord('Y'), [ssCtrl]);
  903. SetFakeShortCut(ECut, Ord('X'), [ssCtrl]);
  904. SetFakeShortCut(ECopy, Ord('C'), [ssCtrl]);
  905. SetFakeShortCut(EPaste, Ord('V'), [ssCtrl]);
  906. SetFakeShortCut(ESelectAll, Ord('A'), [ssCtrl]);
  907. SetFakeShortCut(EDelete, VK_DELETE, []);
  908. SetFakeShortCutText(VZoomIn, SmkcCtrl + 'Num +'); { These zoom shortcuts are handled by Scintilla and only support the active memo, unlike the menu items which work on all memos }
  909. SetFakeShortCutText(VZoomOut, SmkcCtrl + 'Num -');
  910. SetFakeShortCutText(VZoomReset, SmkcCtrl + 'Num /');
  911. { Use fake Esc shortcut for Stop Compile so it doesn't conflict with the
  912. editor's autocompletion list }
  913. SetFakeShortCut(BStopCompile, VK_ESCAPE, []);
  914. { Use fake Ctrl+F4 shortcut for VCloseCurrentTab2 because VCloseCurrentTab
  915. already has the real one }
  916. SetFakeShortCut(VCloseCurrentTab2, VK_F4, [ssCtrl]);
  917. { Use fake Ctrl+C and Ctrl+A shortcuts for OutputListPopupMenu's items so they
  918. don't conflict with the editor which also uses fake shortcuts for these }
  919. SetFakeShortCut(POutputListCopy, Ord('C'), [ssCtrl]);
  920. SetFakeShortCut(POutputListSelectAll, Ord('A'), [ssCtrl]);
  921. { Set real shortcut on TOptions which can't be set at design time }
  922. TOptions.ShortCut := ShortCut(VK_OEM_COMMA, [ssCtrl]);
  923. PopupMenu := TMainFormPopupMenu.Create(Self, EMenu);
  924. FMemosStyler := TInnoSetupStyler.Create(Self);
  925. FMemosStyler.ISPPInstalled := ISPPInstalled;
  926. FTheme := TTheme.Create;
  927. InitFormThemeInit(FTheme);
  928. ToolBarPanel.ParentBackground := False;
  929. UpdatePanel.ParentBackground := False;
  930. UpdatePanelDonateImage.Hint := RemoveAccelChar(HDonate.Caption);
  931. UpdateImages;
  932. FMemos := TList<TIDEScintEdit>.Create;
  933. FMainMemo := InitializeMainMemo(TIDEScintFileEdit.Create(Self), PopupMenu);
  934. FMemos.Add(FMainMemo);
  935. FPreprocessorOutputMemo := InitializeNonFileMemo(TIDEScintEdit.Create(Self), PopupMenu);
  936. FMemos.Add(FPreprocessorOutputMemo);
  937. for I := FMemos.Count to MaxMemos-1 do
  938. FMemos.Add(InitializeFileMemo(TIDEScintFileEdit.Create(Self), PopupMenu));
  939. FFileMemos := TList<TIDEScintFileEdit>.Create;
  940. for Memo in FMemos do
  941. if Memo is TIDEScintFileEdit then
  942. FFileMemos.Add(TIDEScintFileEdit(Memo));
  943. FHiddenFiles := TStringList.Create(dupError, True, True);
  944. FActiveMemo := FMainMemo;
  945. FActiveMemo.Visible := True;
  946. FErrorMemo := FMainMemo;
  947. FStepMemo := FMainMemo;
  948. UpdateMarginsAndSquigglyAndCaretWidths;
  949. FMemosStyler.Theme := FTheme;
  950. MemosTabSet.PopupMenu := TMainFormPopupMenu.Create(Self, MemosTabSetPopupMenu);
  951. FFirstTabSelectShortCut := ShortCut(Ord('1'), [ssCtrl]);
  952. FLastTabSelectShortCut := ShortCut(Ord('9'), [ssCtrl]);
  953. FNavStacks := TIDEScintEditNavStacks.Create;
  954. UpdateNavButtons;
  955. FCurrentNavItem.Invalidate;
  956. BackNavButton.Style := tbsDropDown;
  957. BackNavButton.DropdownMenu := TMainFormPopupMenu.Create(Self, NavPopupMenu);
  958. PopupMenu := TMainFormPopupMenu.Create(Self, OutputListPopupMenu);
  959. CompilerOutputList.PopupMenu := PopupMenu;
  960. DebugOutputList.PopupMenu := PopupMenu;
  961. DebugCallStackList.PopupMenu := PopupMenu;
  962. FindResultsList.PopupMenu := PopupMenu;
  963. UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  964. Application.HintShortPause := 0;
  965. Application.OnException := AppOnException;
  966. Application.OnActivate := AppOnActivate;
  967. Application.OnIdle := AppOnIdle;
  968. FMRUMainFilesList := TStringList.Create;
  969. for I := 0 to High(FMRUMainFilesMenuItems) do begin
  970. NewItem := TMenuItem.Create(Self);
  971. NewItem.OnClick := FMRUClick;
  972. FRecent.Insert(I, NewItem);
  973. FMRUMainFilesMenuItems[I] := NewItem;
  974. end;
  975. FMRUParametersList := TStringList.Create;
  976. FSignTools := TStringList.Create;
  977. FFindResults := TFindResults.Create;
  978. FIncludedFiles := TIncludedFiles.Create;
  979. UpdatePreprocMemos;
  980. FDebugTarget := dtSetup;
  981. UpdateTargetMenu;
  982. UpdateCaption;
  983. FMenuDarkBackgroundBrush := TBrush.Create;
  984. FMenuDarkHotOrSelectedBrush := TBrush.Create;
  985. LightToolbarVirtualImageList.AutoFill := True;
  986. ThemedMarkersAndACVirtualImageList.AutoFill := True;
  987. UpdateThemeData(True);
  988. FMenuBitmaps := TMenuBitmaps.Create;
  989. FMenuBitmapsSize.cx := 0;
  990. FMenuBitmapsSize.cy := 0;
  991. FKeyMappedMenus := TKeyMappedMenus.Create;
  992. FCallTipState.MaxCallTips := 1; { Just like SciTE 5.50 }
  993. FUpdatePanelMessages := TUpdatePanelMessages.Create;
  994. if CommandLineCompile then begin
  995. ReadSignTools(FSignTools);
  996. PostMessage(Handle, WM_StartCommandLineCompile, 0, 0)
  997. end else if CommandLineWizard then begin
  998. { Stop Delphi from showing the compiler form }
  999. Application.ShowMainForm := False;
  1000. { Show wizard form later }
  1001. PostMessage(Handle, WM_StartCommandLineWizard, 0, 0);
  1002. end else begin
  1003. ReadConfig; { Calls UpdateTheme }
  1004. ReadSignTools(FSignTools);
  1005. PostMessage(Handle, WM_StartNormally, 0, 0);
  1006. end;
  1007. end;
  1008. destructor TMainForm.Destroy;
  1009. procedure SaveConfig;
  1010. var
  1011. Ini: TConfigIniFile;
  1012. WindowPlacement: TWindowPlacement;
  1013. begin
  1014. Ini := TConfigIniFile.Create;
  1015. try
  1016. { Theme state - can change without opening the options }
  1017. Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see TOptionsClick }
  1018. { Menu check boxes state }
  1019. Ini.WriteBool('Options', 'ShowToolbar', ToolbarPanel.Visible);
  1020. Ini.WriteBool('Options', 'ShowStatusBar', StatusBar.Visible);
  1021. Ini.WriteBool('Options', 'LowPriorityDuringCompile', FOptions.LowPriorityDuringCompile);
  1022. { Window state }
  1023. WindowPlacement.length := SizeOf(WindowPlacement);
  1024. GetWindowPlacement(Handle, @WindowPlacement);
  1025. Ini.WriteInteger('State', 'WindowLeft', WindowPlacement.rcNormalPosition.Left);
  1026. Ini.WriteInteger('State', 'WindowTop', WindowPlacement.rcNormalPosition.Top);
  1027. Ini.WriteInteger('State', 'WindowRight', WindowPlacement.rcNormalPosition.Right);
  1028. Ini.WriteInteger('State', 'WindowBottom', WindowPlacement.rcNormalPosition.Bottom);
  1029. { The GetWindowPlacement docs claim that "flags" is always zero.
  1030. Fortunately, that's wrong. WPF_RESTORETOMAXIMIZED is set when the
  1031. window is either currently maximized, or currently minimized from a
  1032. previous maximized state. }
  1033. Ini.WriteBool('State', 'WindowMaximized', WindowPlacement.flags and WPF_RESTORETOMAXIMIZED <> 0);
  1034. Ini.WriteInteger('State', 'StatusPanelHeight', FromCurrentPPI(StatusPanel.Height));
  1035. { Zoom state }
  1036. Ini.WriteInteger('Options', 'Zoom', FMainMemo.Zoom); { Only saves the main memo's zoom }
  1037. finally
  1038. Ini.Free;
  1039. end;
  1040. end;
  1041. begin
  1042. UpdateThemeData(False);
  1043. Application.OnActivate := nil;
  1044. Application.OnIdle := nil;
  1045. if FOptionsLoaded and not (CommandLineCompile or CommandLineWizard) then
  1046. SaveConfig;
  1047. if FDevMode <> 0 then
  1048. GlobalFree(FDevMode);
  1049. if FDevNames <> 0 then
  1050. GlobalFree(FDevNames);
  1051. FUpdatePanelMessages.Free;
  1052. FNavStacks.Free;
  1053. FKeyMappedMenus.Free;
  1054. FMenuBitmaps.Free;
  1055. FMenuDarkBackgroundBrush.Free;
  1056. FMenuDarkHotOrSelectedBrush.Free;
  1057. FTheme.Free;
  1058. DestroyDebugInfo;
  1059. FIncludedFiles.Free;
  1060. FFindResults.Free;
  1061. FSignTools.Free;
  1062. FMRUParametersList.Free;
  1063. FMRUMainFilesList.Free;
  1064. FFileMemos.Free;
  1065. FHiddenFiles.Free;
  1066. FMemos.Free;
  1067. inherited;
  1068. end;
  1069. function TMainForm.GetBorderStyle: TFormBorderStyle;
  1070. begin
  1071. Result := inherited BorderStyle;
  1072. end;
  1073. procedure TMainForm.SetBorderStyle(Value: TFormBorderStyle);
  1074. begin
  1075. { Hack: To stop the Delphi IDE from adding Explicit* properties to the .dfm
  1076. file every time the unit is saved, we set BorderStyle=bsNone on the form.
  1077. At run-time, ignore that setting so that BorderStyle stays at the default
  1078. value, bsSizeable.
  1079. It would be simpler to change BorderStyle from bsNone to bsSizeable in the
  1080. form's constructor, but it doesn't quite work: when a form's handle is
  1081. created while BorderStyle=bsNone, Position=poDefault behaves like
  1082. poDefaultPosOnly (see TCustomForm.CreateParams). }
  1083. if Value <> bsNone then
  1084. inherited BorderStyle := Value;
  1085. end;
  1086. class procedure TMainForm.AppOnException(Sender: TObject; E: Exception);
  1087. begin
  1088. AppMessageBox(PChar(AddPeriod(E.Message)), SCompilerFormCaption,
  1089. MB_OK or MB_ICONSTOP);
  1090. end;
  1091. class procedure TMainForm.AppOnGetActiveFormHandle(var AHandle: HWND);
  1092. begin
  1093. { As of Delphi 11.3, the default code in TApplication.GetActiveFormHandle
  1094. (which runs after this handler) calls GetActiveWindow, and if that returns
  1095. 0, it calls GetLastActivePopup(Application.Handle).
  1096. The problem is that when the application isn't in the foreground,
  1097. GetActiveWindow returns 0, and when MainFormOnTaskBar=True, the
  1098. GetLastActivePopup call normally just returns Application.Handle (since
  1099. there are no popups owned by the application window).
  1100. So if the application calls Application.MessageBox while it isn't in the
  1101. foreground, that message box will be owned by Application.Handle, not by
  1102. the last-active window as it should be. That can lead to the message box
  1103. falling behind the main form in z-order.
  1104. To rectify that, when no window is active and MainFormOnTaskBar=True, we
  1105. fall back to returning the handle of the main form's last active popup,
  1106. which is the window that would be activated if the main form's taskbar
  1107. button were clicked. (If Application.Handle is active, we treat that the
  1108. same as no active window because Application.Handle shouldn't be the owner
  1109. of any windows when MainFormOnTaskBar=True.)
  1110. If there is no assigned main form or if MainFormOnTaskBar=False, then we
  1111. fall back to the default handling. }
  1112. if Application.MainFormOnTaskBar then begin
  1113. AHandle := GetActiveWindow;
  1114. if ((AHandle = 0) or (AHandle = Application.Handle)) and
  1115. Assigned(Application.MainForm) and
  1116. Application.MainForm.HandleAllocated then
  1117. AHandle := GetLastActivePopup(Application.MainFormHandle);
  1118. end;
  1119. end;
  1120. procedure TMainForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
  1121. NewDPI: Integer);
  1122. begin
  1123. UpdateImages;
  1124. UpdateMarginsAndAutoCompleteIcons;
  1125. UpdateMarginsAndSquigglyAndCaretWidths;
  1126. UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  1127. UpdateStatusPanelHeight(StatusPanel.Height);
  1128. end;
  1129. procedure TMainForm.FormCloseQuery(Sender: TObject;
  1130. var CanClose: Boolean);
  1131. begin
  1132. if IsWindowEnabled(Handle) then
  1133. CanClose := ConfirmCloseFile(True)
  1134. else
  1135. { CloseQuery is also called by the VCL when a WM_QUERYENDSESSION message
  1136. is received. Don't display message box if a modal dialog is already
  1137. displayed. }
  1138. CanClose := False;
  1139. end;
  1140. procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  1141. Shift: TShiftState);
  1142. begin
  1143. var AShortCut := ShortCut(Key, Shift);
  1144. if (AShortCut = VK_ESCAPE) and BStopCompile.Enabled then begin
  1145. Key := 0; { Intentionally only done when BStopCompile is enabled to allow the memo to process it instead }
  1146. BStopCompileClick(Self)
  1147. end else if (AShortCut = FBackNavButtonShortCut) or
  1148. ((FBackNavButtonShortCut2 <> 0) and (AShortCut = FBackNavButtonShortCut2)) then begin
  1149. Key := 0;
  1150. if BackNavButton.Enabled then
  1151. BackNavButtonClick(Self);
  1152. end else if (AShortCut = FForwardNavButtonShortCut) or
  1153. ((FForwardNavButtonShortCut2 <> 0) and (AShortCut = FForwardNavButtonShortCut2)) then begin
  1154. Key := 0;
  1155. if ForwardNavButton.Enabled then
  1156. ForwardNavButtonClick(Self);
  1157. end else if (AShortCut >= FFirstTabSelectShortCut) and (AShortCut <= FLastTabSelectShortCut) then begin
  1158. Key := 0;
  1159. if MemosTabSet.Visible then begin
  1160. var TabIndex := AShortCut - FFirstTabSelectShortCut;
  1161. if TabIndex < 8 then begin
  1162. if TabIndex < MemosTabSet.Tabs.Count then
  1163. MemosTabSet.TabIndex := TabIndex;
  1164. end else { Ctrl+9 = Select last tab }
  1165. MemosTabSet.TabIndex := MemosTabSet.Tabs.Count-1;
  1166. end;
  1167. end else if AShortCut = FCompileShortCut2 then begin
  1168. Key := 0;
  1169. if BCompile.Enabled then
  1170. BCompileClick(Self);
  1171. end else if (Key = VK_F6) and not (ssAlt in Shift) then begin
  1172. { Toggle focus between the active memo and the active bottom pane }
  1173. Key := 0;
  1174. if ActiveControl <> FActiveMemo then
  1175. ActiveControl := FActiveMemo
  1176. else if StatusPanel.Visible then begin
  1177. case OutputTabSet.TabIndex of
  1178. tiCompilerOutput: ActiveControl := CompilerOutputList;
  1179. tiDebugOutput: ActiveControl := DebugOutputList;
  1180. tiDebugCallStack: ActiveControl := DebugCallStackList;
  1181. tiFindResults: ActiveControl := FindResultsList;
  1182. end;
  1183. end;
  1184. end;
  1185. end;
  1186. procedure TMainForm.MemoKeyDown(Sender: TObject; var Key: Word;
  1187. Shift: TShiftState);
  1188. procedure SimplifySelection(const AMemo: TIDEScintEdit);
  1189. begin
  1190. { The built in Esc (SCI_CANCEL) simply drops all additional selections
  1191. and does not empty the main selection, It doesn't matter if Esc is
  1192. pressed once or twice. Implement our own behaviour, same as VSCode.
  1193. Also see https://github.com/microsoft/vscode/issues/118835. }
  1194. if AMemo.SelectionCount > 1 then
  1195. AMemo.RemoveAdditionalSelections
  1196. else if not AMemo.SelEmpty then
  1197. AMemo.SetEmptySelection;
  1198. AMemo.ScrollCaretIntoView;
  1199. end;
  1200. procedure AddCursor(const AMemo: TIDEScintEdit; const Up: Boolean);
  1201. begin
  1202. { Does not try to keep the main selection. }
  1203. var Selections: TScintCaretAndAnchorList := nil;
  1204. var VirtualSpaces: TScintCaretAndAnchorList := nil;
  1205. try
  1206. Selections := TScintCaretAndAnchorList.Create;
  1207. VirtualSpaces := TScintCaretAndAnchorList.Create;
  1208. { Get all the virtual spaces as well before we start doing modifications }
  1209. AMemo.GetSelections(Selections, VirtualSpaces);
  1210. for var I := 0 to Selections.Count-1 do begin
  1211. var Selection := Selections[I];
  1212. var LineCaret := AMemo.GetLineFromPosition(Selection.CaretPos);
  1213. var LineAnchor := AMemo.GetLineFromPosition(Selection.AnchorPos);
  1214. if LineCaret = LineAnchor then begin
  1215. { Add selection with same caret and anchor offsets one line up or down. }
  1216. var OtherLine := LineCaret + IfThen(Up, -1, 1);;
  1217. if (OtherLine < 0) or (OtherLine >= AMemo.Lines.Count) then
  1218. Continue { Already at the top or bottom, can't add }
  1219. else begin
  1220. var LineStartPos := AMemo.GetPositionFromLine(LineCaret);
  1221. var CaretCharacterCount := AMemo.GetCharacterCount(LineStartPos, Selection.CaretPos) + VirtualSpaces[I].CaretPos;
  1222. var AnchorCharacterCount := AMemo.GetCharacterCount(LineStartPos, Selection.AnchorPos) + VirtualSpaces[I].AnchorPos;
  1223. var OtherLineStart := AMemo.GetPositionFromLine(OtherLine);
  1224. var MaxCharacterCount := AMemo.GetCharacterCount(OtherLineStart, AMemo.GetLineEndPosition(OtherLine));
  1225. var NewCaretCharacterCount := CaretCharacterCount;
  1226. var NewCaretVirtualSpace := 0;
  1227. var NewAnchorCharacterCount := AnchorCharacterCount;
  1228. var NewAnchorVirtualSpace := 0;
  1229. if NewCaretCharacterCount > MaxCharacterCount then begin
  1230. NewCaretVirtualSpace := NewCaretCharacterCount - MaxCharacterCount;
  1231. NewCaretCharacterCount := MaxCharacterCount;
  1232. end;
  1233. if NewAnchorCharacterCount > MaxCharacterCount then begin
  1234. NewAnchorVirtualSpace := NewAnchorCharacterCount - MaxCharacterCount;
  1235. NewAnchorCharacterCount := MaxCharacterCount;
  1236. end;
  1237. var NewSelection: TScintCaretAndAnchor;
  1238. NewSelection.CaretPos := AMemo.GetPositionRelative(OtherLineStart, NewCaretCharacterCount);
  1239. NewSelection.AnchorPos := AMemo.GetPositionRelative(OtherLineStart, NewAnchorCharacterCount);
  1240. { AddSelection trims selections except for the main selection so
  1241. we need to check that ourselves unfortunately. Not doing a check
  1242. gives a problem when you AddCursor two times starting with an
  1243. empty single selection. The result will be 4 cursors, with 2 of
  1244. them in the same place. The check below fixes this but not
  1245. other cases when there's only partial overlap and Scintilla still
  1246. behaves weird. The check also doesn't handle virtual space which
  1247. is why we ultimately don't set virtual space: it leads to duplicate
  1248. selections. }
  1249. var MainSelection := AMemo.Selection;
  1250. if not NewSelection.Range.Within(AMemo.Selection) then begin
  1251. AMemo.AddSelection(NewSelection.CaretPos, NewSelection.AnchorPos);
  1252. { if svsUserAccessible in FActiveMemo.VirtualSpaceOptions then begin
  1253. var MainSel := AMemo.MainSelection;
  1254. AMemo.SelectionCaretVirtualSpace[MainSel] := NewCaretVirtualSpace;
  1255. AMemo.SelectionAnchorVirtualSpace[MainSel] := NewAnchorVirtualSpace;
  1256. end; }
  1257. end;
  1258. end;
  1259. end else begin
  1260. { Extend multiline selection up or down. This is not the same as
  1261. LineExtendUp/Down because those can shrink instead of extend. }
  1262. var CaretBeforeAnchor := Selection.CaretPos < Selection.AnchorPos;
  1263. var Down := not Up;
  1264. var LineStartOrEnd, StartOrEndPos, VirtualSpace: Integer;
  1265. { Does it start (when going up) or end (when going down) at the caret or the anchor? }
  1266. if (Up and CaretBeforeAnchor) or (Down and not CaretBeforeAnchor) then begin
  1267. LineStartOrEnd := LineCaret;
  1268. StartOrEndPos := Selection.CaretPos;
  1269. VirtualSpace := VirtualSpaces[I].CaretPos;
  1270. end else begin
  1271. LineStartOrEnd := LineAnchor;
  1272. StartOrEndPos := Selection.AnchorPos;
  1273. VirtualSpace := VirtualSpaces[I].AnchorPos;
  1274. end;
  1275. var NewStartOrEndPos: Integer;
  1276. var NewVirtualSpace := 0;
  1277. { Go up or down one line or to the start or end of the document }
  1278. if (Up and (LineStartOrEnd > 0)) or (Down and (LineStartOrEnd < AMemo.Lines.Count-1)) then begin
  1279. var CharacterCount := AMemo.GetCharacterCount(AMemo.GetPositionFromLine(LineStartOrEnd), StartOrEndPos) + VirtualSpace;
  1280. var OtherLine := LineStartOrEnd + IfThen(Up, -1, 1);
  1281. var OtherLineStart := AMemo.GetPositionFromLine(OtherLine);
  1282. var MaxCharacterCount := AMemo.GetCharacterCount(OtherLineStart, AMemo.GetLineEndPosition(OtherLine));
  1283. var NewCharacterCount := CharacterCount;
  1284. if NewCharacterCount > MaxCharacterCount then begin
  1285. NewVirtualSpace := NewCharacterCount - MaxCharacterCount;
  1286. NewCharacterCount := MaxCharacterCount;
  1287. end;
  1288. NewStartOrEndPos := AMemo.GetPositionRelative(OtherLineStart, NewCharacterCount);
  1289. end else
  1290. NewStartOrEndPos := IfThen(Up, 0, AMemo.GetPositionFromLine(AMemo.Lines.Count));
  1291. { Move the caret or the anchor up or down to extend the selection }
  1292. if (Up and CaretBeforeAnchor) or (Down and not CaretBeforeAnchor) then begin
  1293. AMemo.SelectionCaretPosition[I] := NewStartOrEndPos;
  1294. if svsUserAccessible in FActiveMemo.VirtualSpaceOptions then
  1295. AMemo.SelectionCaretVirtualSpace[I] := NewVirtualSpace;
  1296. end else begin
  1297. AMemo.SelectionAnchorPosition[I] := NewStartOrEndPos;
  1298. if svsUserAccessible in FActiveMemo.VirtualSpaceOptions then
  1299. AMemo.SelectionAnchorVirtualSpace[I] := NewVirtualSpace;
  1300. end;
  1301. end;
  1302. end;
  1303. finally
  1304. VirtualSpaces.Free;
  1305. Selections.Free;
  1306. end;
  1307. end;
  1308. procedure AddCursorsToLineEnds(const AMemo: TIDEScintEdit);
  1309. begin
  1310. { Does not try to keep the main selection. Otherwise behaves the same as
  1311. observed in Visual Studio Code, see comments. }
  1312. var Selections: TScintCaretAndAnchorList := nil;
  1313. var VirtualSpaces: TScintCaretAndAnchorList := nil;
  1314. try
  1315. Selections := TScintCaretAndAnchorList.Create;
  1316. VirtualSpaces := TScintCaretAndAnchorList.Create;
  1317. AMemo.GetSelections(Selections, VirtualSpaces);
  1318. { First remove all empty selections }
  1319. for var I := Selections.Count-1 downto 0 do begin
  1320. var Selection := Selections[I];
  1321. var VirtualSpace := VirtualSpaces[I];
  1322. if (Selection.CaretPos + VirtualSpace.CaretPos) =
  1323. (Selection.AnchorPos + VirtualSpace.AnchorPos) then begin
  1324. Selections.Delete(I);
  1325. VirtualSpaces.Delete(I);
  1326. end;
  1327. end;
  1328. { If all selections were empty do nothing }
  1329. if Selections.Count = 0 then
  1330. Exit;
  1331. { Handle non empty selections }
  1332. for var I := Selections.Count-1 downto 0 do begin
  1333. var Selection := Selections[I];
  1334. var Line1 := AMemo.GetLineFromPosition(Selection.CaretPos);
  1335. var Line2 := AMemo.GetLineFromPosition(Selection.AnchorPos);
  1336. var SelSingleLine := Line1 = Line2;
  1337. if SelSingleLine then begin
  1338. { Single line selections are updated into empty selection at end of selection }
  1339. var VirtualSpace := VirtualSpaces[I];
  1340. if Selection.CaretPos + VirtualSpace.CaretPos > Selection.AnchorPos + VirtualSpace.AnchorPos then begin
  1341. Selection.AnchorPos := Selection.CaretPos;
  1342. VirtualSpace.AnchorPos := VirtualSpace.CaretPos;
  1343. end else begin
  1344. Selection.CaretPos := Selection.AnchorPos;
  1345. VirtualSpace.CaretPos := VirtualSpace.AnchorPos;
  1346. end;
  1347. Selections[I] := Selection;
  1348. VirtualSpaces[I] := VirtualSpace;
  1349. end else begin
  1350. { Multiline selections are replaced by empty selections at each end of line }
  1351. if Line1 > Line2 then begin
  1352. var TmpLine := Line1;
  1353. Line1 := Line2;
  1354. Line2 := TmpLine;
  1355. end;
  1356. { Ignore last line if the selection doesn't really select anything on that line }
  1357. if Selection.Range.EndPos = AMemo.GetPositionFromLine(Line2) then
  1358. Dec(Line2);
  1359. for var Line := Line1 to Line2 do begin
  1360. Selection.CaretPos := AMemo.GetLineEndPosition(Line);
  1361. Selection.AnchorPos := Selection.CaretPos;
  1362. Selections.Add(Selection);
  1363. VirtualSpaces.Add(TScintCaretAndAnchor.Create(0, 0));
  1364. end;
  1365. Selections.Delete(I);
  1366. VirtualSpaces.Delete(I);
  1367. end;
  1368. end;
  1369. { Send updated selections to memo }
  1370. for var I := 0 to Selections.Count-1 do begin
  1371. var Selection := Selections[I];
  1372. var VirtualSpace := VirtualSpaces[I];
  1373. if I = 0 then
  1374. AMemo.SetSingleSelection(Selection.CaretPos, Selection.AnchorPos)
  1375. else
  1376. AMemo.AddSelection(Selection.CaretPos, Selection.AnchorPos);
  1377. AMemo.SelectionCaretVirtualSpace[I] := VirtualSpaces[I].CaretPos;
  1378. AMemo.SelectionAnchorVirtualSpace[I] := VirtualSpaces[I].AnchorPos;
  1379. end;
  1380. finally
  1381. VirtualSpaces.Free;
  1382. Selections.Free;
  1383. end;
  1384. end;
  1385. begin
  1386. if (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then begin
  1387. var Memo := Sender as TIDEScintEdit;
  1388. { Make sure we don't break the special rectangular select shortcuts }
  1389. if Shift * [ssShift, ssAlt, ssCtrl] <> Memo.GetRectExtendShiftState(True) then begin
  1390. if Memo.SelectionMode in [ssmRectangular, ssmThinRectangular] then begin
  1391. { Allow left/right/etc. navigation with rectangular selection, see
  1392. https://sourceforge.net/p/scintilla/feature-requests/1275/ and
  1393. https://sourceforge.net/p/scintilla/bugs/2412/#cb37
  1394. Notepad++ calls this "Enable Column Selection to Multi-editing" which
  1395. is on by default and in VSCode and VS it's also on by default. }
  1396. Memo.SelectionMode := ssmStream;
  1397. end;
  1398. end;
  1399. { Key is not cleared to allow Scintilla to do the actual handling }
  1400. end;
  1401. if Key = VK_F1 then begin
  1402. Key := 0;
  1403. var HelpFile := GetHelpFile;
  1404. if Assigned(HtmlHelp) then begin
  1405. HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_DISPLAY_TOPIC, 0);
  1406. var S := FActiveMemo.WordAtCaret;
  1407. if S <> '' then begin
  1408. var KLink: THH_AKLINK;
  1409. FillChar(KLink, SizeOf(KLink), 0);
  1410. KLink.cbStruct := SizeOf(KLink);
  1411. KLink.pszKeywords := PChar(S);
  1412. KLink.fIndexOnFail := True;
  1413. HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_KEYWORD_LOOKUP, DWORD(@KLink));
  1414. end;
  1415. end;
  1416. end else if ((Key = Ord('V')) or (Key = VK_INSERT)) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssCtrl]) then begin
  1417. if FActiveMemo.CanPaste then
  1418. if MultipleSelectionPasteFromClipboard(FActiveMemo) then
  1419. Key := 0;
  1420. end else if (Key = VK_SPACE) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssShift, ssCtrl]) then begin
  1421. Key := 0;
  1422. { Based on SciTE 5.50's SciTEBase::MenuCommand IDM_SHOWCALLTIP }
  1423. if FActiveMemo.CallTipActive then begin
  1424. FCallTipState.CurrentCallTip := IfThen(FCallTipState.CurrentCallTip + 1 = FCallTipState.MaxCallTips, 0, FCallTipState.CurrentCallTip + 1);
  1425. UpdateCallTipFunctionDefinition;
  1426. end else begin
  1427. FCallTipState.BraceCount := 1; { Missing in SciTE, see https://sourceforge.net/p/scintilla/bugs/2446/ }
  1428. InitiateCallTip(#0);
  1429. end;
  1430. end else begin
  1431. var AShortCut := ShortCut(Key, Shift);
  1432. { Check if the memo keymap wants us to handle the shortcut but first check
  1433. the menu keymap didn't already claim the same shortcut. Other shortcuts
  1434. (which are always same and not set by the menu keymap) are assumed to
  1435. never conflict. }
  1436. if not FKeyMappedMenus.ContainsKey(AShortCut) then begin
  1437. var ComplexCommand := FActiveMemo.GetComplexCommand(AShortCut);
  1438. if ComplexCommand <> ccNone then begin
  1439. if Key <> VK_ESCAPE then { Allow Scintilla to see Esc }
  1440. Key := 0;
  1441. case ComplexCommand of
  1442. ccSelectNextOccurrence:
  1443. ESelectNextOccurrenceClick(Self);
  1444. ccSelectAllOccurrences:
  1445. ESelectAllOccurrencesClick(Self);
  1446. ccSelectAllFindMatches:
  1447. ESelectAllFindMatchesClick(Self);
  1448. ccFoldLine:
  1449. EFoldOrUnfoldLineClick(EFoldLine);
  1450. ccUnfoldLine:
  1451. EFoldOrUnfoldLineClick(EUnfoldLine);
  1452. ccSimplifySelection:
  1453. SimplifySelection(FActiveMemo);
  1454. ccToggleLinesComment:
  1455. EToggleLinesCommentClick(Self); //GetCompexCommand already checked ReadOnly for us
  1456. ccAddCursorUp, ccAddCursorDown:
  1457. AddCursor(FActiveMemo, ComplexCommand = ccAddCursorUp);
  1458. ccBraceMatch:
  1459. EBraceMatchClick(Self);
  1460. ccAddCursorsToLineEnds:
  1461. AddCursorsToLineEnds(FActiveMemo);
  1462. else
  1463. raise Exception.Create('Unknown ComplexCommand');
  1464. end;
  1465. end;
  1466. end;
  1467. end;
  1468. end;
  1469. procedure TMainForm.MemoKeyPress(Sender: TObject; var Key: Char);
  1470. begin
  1471. if ((Key = #9) or (Key = ' ')) and (GetKeyState(VK_CONTROL) < 0) then begin
  1472. { About #9, as Wikipedia explains: "The most known and common tab is a
  1473. horizontal tabulation <..> and may be referred to as Ctrl+I." Ctrl+I is
  1474. (just like in Visual Studio Code) our alternative code completion character
  1475. because Ctrl+Space is used by the Chinese IME and Alt+Right is used for the
  1476. forward button. So that's why we handle #9 here. Doesn't mean Ctrl+Tab
  1477. doesn't work: it doesnt trigger KeyPress, even if it wasn't a menu
  1478. shortcut for Next Tab (which it is). }
  1479. InitiateAutoComplete(#0);
  1480. Key := #0;
  1481. end else if (Key <= #31) or (Key = #127) then begin
  1482. { Prevent "control characters" from being entered in text. Don't need to be
  1483. concerned about #9 or #10 or #13 etc here. Based on Notepad++'s WM_CHAR
  1484. handling in ScintillaEditView.cpp.
  1485. Also don't need to be concerned about shortcuts like Ctrl+Shift+- which
  1486. equals #31. }
  1487. Key := #0
  1488. end;
  1489. end;
  1490. procedure TMainForm.FormResize(Sender: TObject);
  1491. begin
  1492. { Make sure the status panel's height is decreased if necessary in response
  1493. to the form's height decreasing }
  1494. if StatusPanel.Visible then
  1495. UpdateStatusPanelHeight(StatusPanel.Height);
  1496. end;
  1497. procedure TMainForm.WndProc(var Message: TMessage);
  1498. begin
  1499. { Without this, the status bar's owner drawn panels sometimes get corrupted and show
  1500. menu items instead. See:
  1501. http://groups.google.com/group/borland.public.delphi.vcl.components.using/browse_thread/thread/e4cb6c3444c70714 }
  1502. with Message do
  1503. case Msg of
  1504. WM_DRAWITEM:
  1505. with PDrawItemStruct(Message.LParam)^ do
  1506. if (CtlType = ODT_MENU) and not IsMenu(hwndItem) then
  1507. CtlType := ODT_STATIC;
  1508. end;
  1509. inherited
  1510. end;
  1511. function TMainForm.IsShortCut(var Message: TWMKey): Boolean;
  1512. begin
  1513. { Key messages are forwarded by the VCL to the main form for ShortCut
  1514. processing. In Delphi 5+, however, this happens even when a TFindDialog
  1515. is active, causing Ctrl+V/Esc/etc. to be intercepted by the main form.
  1516. Work around this by always returning False when not Active. }
  1517. if Active then
  1518. Result := inherited IsShortCut(Message)
  1519. else
  1520. Result := False;
  1521. end;
  1522. procedure TMainForm.UpdateCaption;
  1523. var
  1524. NewCaption: String;
  1525. begin
  1526. if FMainMemo.Filename = '' then
  1527. NewCaption := GetFileTitle(FMainMemo.Filename)
  1528. else begin
  1529. if FOptions.FullPathInTitleBar then
  1530. NewCaption := FMainMemo.Filename
  1531. else
  1532. NewCaption := GetDisplayFilename(FMainMemo.Filename);
  1533. end;
  1534. NewCaption := NewCaption + ' - ' + SCompilerFormCaption + ' ' +
  1535. String(FCompilerVersion.Version);
  1536. if FCompiling then
  1537. NewCaption := NewCaption + ' [Compiling]'
  1538. else if FDebugging then begin
  1539. if not FPaused then
  1540. NewCaption := NewCaption + ' [Running]'
  1541. else
  1542. NewCaption := NewCaption + ' [Paused]';
  1543. end;
  1544. Caption := NewCaption;
  1545. if not CommandLineWizard then
  1546. Application.Title := NewCaption;
  1547. end;
  1548. procedure TMainForm.UpdateNewMainFileButtons;
  1549. begin
  1550. if FOptions.UseWizard then begin
  1551. FNewMainFile.Caption := '&New...';
  1552. FNewMainFile.OnClick := FNewMainFileUserWizardClick;
  1553. NewMainFileButton.OnClick := FNewMainFileUserWizardClick;
  1554. end else begin
  1555. FNewMainFile.Caption := '&New';
  1556. FNewMainFile.OnClick := FNewMainFileClick;
  1557. NewMainFileButton.OnClick := FNewMainFileClick;
  1558. end;
  1559. end;
  1560. procedure TMainForm.NewMainFile;
  1561. var
  1562. Memo: TIDEScintFileEdit;
  1563. begin
  1564. HideError;
  1565. FUninstExe := '';
  1566. if FDebugTarget <> dtSetup then begin
  1567. FDebugTarget := dtSetup;
  1568. UpdateTargetMenu;
  1569. end;
  1570. FHiddenFiles.Clear;
  1571. InvalidateStatusPanel(spHiddenFilesCount);
  1572. for Memo in FFileMemos do
  1573. if Memo.Used then
  1574. Memo.BreakPoints.Clear;
  1575. DestroyDebugInfo;
  1576. FMainMemo.Filename := '';
  1577. UpdateCaption;
  1578. FMainMemo.SaveEncoding := seUTF8WithoutBOM;
  1579. FMainMemo.Lines.Clear;
  1580. FModifiedAnySinceLastCompile := True;
  1581. FPreprocessorOutput := '';
  1582. FIncludedFiles.Clear;
  1583. UpdatePreprocMemos;
  1584. FMainMemo.ClearUndo;
  1585. FNavStacks.Clear;
  1586. UpdateNavButtons;
  1587. FCurrentNavItem.Invalidate;
  1588. end;
  1589. { Breakpoints are preserved on a per-file basis }
  1590. procedure TMainForm.LoadBreakPointLinesAndUpdateLineMarkers(const AMemo: TIDEScintFileEdit);
  1591. begin
  1592. if AMemo.BreakPoints.Count <> 0 then
  1593. raise Exception.Create('AMemo.BreakPoints.Count <> 0'); { NewMainFile or OpenFile should have cleared these }
  1594. try
  1595. var HadSkippedBreakPoint := False;
  1596. var Strings := TStringList.Create;
  1597. try
  1598. LoadBreakPointLines(AMemo.FileName, Strings);
  1599. for var LineAsString in Strings do begin
  1600. var Line := LineAsString.ToInteger;
  1601. if Line < AMemo.Lines.Count then
  1602. AMemo.BreakPoints.Add(Line)
  1603. else
  1604. HadSkippedBreakPoint := True;
  1605. end;
  1606. finally
  1607. Strings.Free;
  1608. end;
  1609. for var Line in AMemo.BreakPoints do
  1610. UpdateLineMarkers(AMemo, Line);
  1611. { If there were breakpoints beyond the end of file get rid of them so they
  1612. don't magically reappear on a reload of an externally edited and grown
  1613. file }
  1614. if HadSkippedBreakPoint then
  1615. BuildAndSaveBreakPointLines(AMemo);
  1616. except
  1617. { Ignore any exceptions }
  1618. end;
  1619. end;
  1620. procedure TMainForm.BuildAndSaveBreakPointLines(const AMemo: TIDEScintFileEdit);
  1621. begin
  1622. try
  1623. if AMemo.FileName <> '' then begin
  1624. var Strings := TStringList.Create;
  1625. try
  1626. for var Line in AMemo.BreakPoints do
  1627. Strings.Add(Line.ToString);
  1628. SaveBreakPointLines(AMemo.FileName, Strings);
  1629. finally
  1630. Strings.Free;
  1631. end;
  1632. end;
  1633. except
  1634. { Handle exceptions locally; failure to save the breakpoint lines list should not be
  1635. a fatal error }
  1636. Application.HandleException(Self);
  1637. end;
  1638. end;
  1639. { Known included and hidden files are preserved on a per-main-file basis }
  1640. procedure TMainForm.LoadKnownIncludedAndHiddenFilesAndUpdateMemos;
  1641. begin
  1642. if FIncludedFiles.Count <> 0 then
  1643. raise Exception.Create('FIncludedFiles.Count <> 0'); { NewMainFile should have cleared these }
  1644. try
  1645. if AFilename <> '' then begin
  1646. var Strings := TStringList.Create;
  1647. try
  1648. LoadKnownIncludedAndHiddenFiles(FMainMemo.FileName, Strings, FHiddenFiles);
  1649. if Strings.Count > 0 then begin
  1650. try
  1651. for var Filename in Strings do begin
  1652. var IncludedFile := TIncludedFile.Create;
  1653. IncludedFile.Filename := Filename;
  1654. IncludedFile.CompilerFileIndex := UnknownCompilerFileIndex;
  1655. IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename,
  1656. @IncludedFile.LastWriteTime);
  1657. FIncludedFiles.Add(IncludedFile);
  1658. end;
  1659. finally
  1660. UpdatePreprocMemos;
  1661. end;
  1662. end;
  1663. finally
  1664. Strings.Free;
  1665. end;
  1666. end;
  1667. except
  1668. { Ignore any exceptions }
  1669. end;
  1670. end;
  1671. procedure TMainForm.BuildAndSaveKnownIncludedAndHiddenFiles;
  1672. begin
  1673. try
  1674. if FMainMemo.FileName <> '' then begin
  1675. var Strings := TStringList.Create;
  1676. try
  1677. for var IncludedFile in FIncludedFiles do
  1678. Strings.Add(IncludedFile.Filename);
  1679. SaveKnownIncludedAndHiddenFiles(FMainMemo.FileName, Strings, FHiddenFiles);
  1680. finally
  1681. Strings.Free;
  1682. end;
  1683. end;
  1684. except
  1685. { Handle exceptions locally; failure to save the includes list should not be
  1686. a fatal error }
  1687. Application.HandleException(Self);
  1688. end;
  1689. end;
  1690. procedure TMainForm.NewMainFileUsingWizard;
  1691. var
  1692. WizardForm: TWizardForm;
  1693. SaveEnabled: Boolean;
  1694. begin
  1695. WizardForm := TWizardForm.Create(Application);
  1696. try
  1697. SaveEnabled := Enabled;
  1698. if CommandLineWizard then begin
  1699. WizardForm.WizardName := CommandLineWizardName;
  1700. { Must disable MainForm even though it isn't shown, otherwise
  1701. menu keyboard shortcuts (such as Ctrl+O) still work }
  1702. Enabled := False;
  1703. end;
  1704. try
  1705. if WizardForm.ShowModal <> mrOk then
  1706. Exit;
  1707. finally
  1708. Enabled := SaveEnabled;
  1709. end;
  1710. if CommandLineWizard then begin
  1711. SaveTextToFile(CommandLineFileName, WizardForm.ResultScript, seUTF8WithoutBOM);
  1712. end else begin
  1713. NewMainFile;
  1714. FMainMemo.Lines.Text := WizardForm.ResultScript;
  1715. FMainMemo.ClearUndo;
  1716. if WizardForm.Result = wrComplete then begin
  1717. FMainMemo.ForceModifiedState;
  1718. if MsgBox('Would you like to compile the new script now?', SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
  1719. BCompileClick(Self);
  1720. end;
  1721. end;
  1722. finally
  1723. WizardForm.Free;
  1724. end;
  1725. end;
  1726. procedure TMainForm.OpenFile(AMemo: TIDEScintFileEdit; AFilename: String;
  1727. const MainMemoAddToRecentDocs: Boolean);
  1728. function GetStreamSaveEncoding(const Stream: TStream): TSaveEncoding;
  1729. var
  1730. Buf: array[0..2] of Byte;
  1731. begin
  1732. Result := seAuto;
  1733. var StreamSize := Stream.Size;
  1734. var CappedSize: Integer;
  1735. if StreamSize > High(Integer) then
  1736. CappedSize := High(Integer)
  1737. else
  1738. CappedSize := Integer(StreamSize);
  1739. if (CappedSize >= SizeOf(Buf)) and (Stream.Read(Buf, SizeOf(Buf)) = SizeOf(Buf)) and
  1740. (Buf[0] = $EF) and (Buf[1] = $BB) and (Buf[2] = $BF) then
  1741. Result := seUTF8WithBOM
  1742. else begin
  1743. Stream.Seek(0, soFromBeginning);
  1744. var S: AnsiString;
  1745. SetLength(S, CappedSize);
  1746. SetLength(S, Stream.Read(S[1], CappedSize));
  1747. if DetectUTF8Encoding(S) in [etUSASCII, etUTF8] then
  1748. Result := seUTF8WithoutBOM;
  1749. end;
  1750. end;
  1751. function GetEncoding(const SaveEncoding: TSaveEncoding): TEncoding;
  1752. begin
  1753. if SaveEncoding in [seUTF8WithBOM, seUTF8WithoutBOM] then
  1754. Result := TEncoding.UTF8
  1755. else
  1756. Result := nil;
  1757. end;
  1758. var
  1759. Stream: TFileStream;
  1760. begin
  1761. AMemo.OpeningFile := True;
  1762. try
  1763. AFilename := PathExpand(AFilename);
  1764. var NameChange := PathCompare(AMemo.Filename, AFilename) <> 0;
  1765. Stream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
  1766. try
  1767. if AMemo = FMainMemo then
  1768. NewMainFile
  1769. else begin
  1770. AMemo.BreakPoints.Clear;
  1771. if DestroyLineState(AMemo) then
  1772. UpdateAllMemoLineMarkers(AMemo);
  1773. if NameChange then { Also see below the other case which needs to be done after load }
  1774. RemoveMemoFromNav(AMemo);
  1775. end;
  1776. GetFileTime(Stream.Handle, nil, nil, @AMemo.FileLastWriteTime);
  1777. AMemo.SaveEncoding := GetStreamSaveEncoding(Stream);
  1778. Stream.Seek(0, soFromBeginning);
  1779. AMemo.Lines.LoadFromStream(Stream, GetEncoding(AMemo.SaveEncoding));
  1780. if (AMemo <> FMainMemo) and not NameChange then
  1781. RemoveMemoBadLinesFromNav(AMemo);
  1782. finally
  1783. Stream.Free;
  1784. end;
  1785. AMemo.ClearUndo;
  1786. if AMemo = FMainMemo then begin
  1787. AMemo.Filename := AFilename;
  1788. UpdateCaption;
  1789. ModifyMRUMainFilesList(AFilename, True);
  1790. if MainMemoAddToRecentDocs then
  1791. AddFileToRecentDocs(AFilename);
  1792. LoadKnownIncludedAndHiddenFilesAndUpdateMemos(AFilename);
  1793. InvalidateStatusPanel(spHiddenFilesCount);
  1794. end;
  1795. LoadBreakPointLinesAndUpdateLineMarkers(AMemo);
  1796. finally
  1797. AMemo.OpeningFile := False;
  1798. end;
  1799. end;
  1800. procedure TMainForm.OpenMRUMainFile(const AFilename: String);
  1801. { Same as OpenFile, but offers to remove the file from the MRU list if it
  1802. cannot be opened }
  1803. begin
  1804. try
  1805. OpenFile(FMainMemo, AFilename, True);
  1806. except
  1807. Application.HandleException(Self);
  1808. if MsgBoxFmt('There was an error opening the file. Remove it from the list?',
  1809. [AFilename], SCompilerFormCaption, mbError, MB_YESNO) = IDYES then begin
  1810. ModifyMRUMainFilesList(AFilename, False);
  1811. DeleteBreakPointLines(AFilename);
  1812. DeleteKnownIncludedAndHiddenFiles(AFilename);
  1813. end;
  1814. end;
  1815. end;
  1816. function TMainForm.SaveFile(const AMemo: TIDEScintFileEdit; const SaveAs: Boolean): Boolean;
  1817. procedure SaveMemoTo(const FN: String);
  1818. var
  1819. TempFN, BackupFN: String;
  1820. Buf: array[0..4095] of Char;
  1821. begin
  1822. { Save to a temporary file; don't overwrite existing files in place. This
  1823. way, if the system crashes or the disk runs out of space during the save,
  1824. the existing file will still be intact. }
  1825. if GetTempFileName(PChar(PathExtractDir(FN)), 'iss', 0, Buf) = 0 then
  1826. raise Exception.CreateFmt('Error creating file (code %d). Could not save file',
  1827. [GetLastError]);
  1828. TempFN := Buf;
  1829. try
  1830. SaveTextToFile(TempFN, AMemo.Lines.Text, AMemo.SaveEncoding);
  1831. { Back up existing file if needed }
  1832. if FOptions.MakeBackups and NewFileExists(FN) then begin
  1833. BackupFN := PathChangeExt(FN, '.~is');
  1834. DeleteFile(BackupFN);
  1835. if not RenameFile(FN, BackupFN) then
  1836. raise Exception.Create('Error creating backup file. Could not save file');
  1837. end;
  1838. { Delete existing file }
  1839. if not DeleteFile(FN) and (GetLastError <> ERROR_FILE_NOT_FOUND) then
  1840. raise Exception.CreateFmt('Error removing existing file (code %d). Could not save file',
  1841. [GetLastError]);
  1842. except
  1843. DeleteFile(TempFN);
  1844. raise;
  1845. end;
  1846. { Rename temporary file.
  1847. Note: This is outside the try..except because we already deleted the
  1848. existing file, and don't want the temp file also deleted in the unlikely
  1849. event that the rename fails. }
  1850. if not RenameFile(TempFN, FN) then
  1851. raise Exception.CreateFmt('Error renaming temporary file (code %d). Could not save file',
  1852. [GetLastError]);
  1853. GetLastWriteTimeOfFile(FN, @AMemo.FileLastWriteTime);
  1854. end;
  1855. var
  1856. FN: String;
  1857. begin
  1858. Result := False;
  1859. var OldName := AMemo.Filename;
  1860. if SaveAs or (AMemo.Filename = '') then begin
  1861. if AMemo <> FMainMemo then
  1862. raise Exception.Create('Internal error: AMemo <> FMainMemo');
  1863. FN := AMemo.Filename;
  1864. if not NewGetSaveFileName('', FN, '', SCompilerOpenFilter, 'iss', Handle) then Exit;
  1865. FN := PathExpand(FN);
  1866. SaveMemoTo(FN);
  1867. AMemo.Filename := FN;
  1868. UpdateCaption;
  1869. end else
  1870. SaveMemoTo(AMemo.Filename);
  1871. AMemo.SetSavePoint;
  1872. if not FOptions.UndoAfterSave then
  1873. AMemo.ClearUndo(False);
  1874. Result := True;
  1875. if AMemo = FMainMemo then begin
  1876. ModifyMRUMainFilesList(AMemo.Filename, True);
  1877. if PathCompare(AMemo.Filename, OldName) <> 0 then begin
  1878. if OldName <> '' then begin
  1879. DeleteBreakPointLines(OldName);
  1880. DeleteKnownIncludedAndHiddenFiles(OldName);
  1881. end;
  1882. BuildAndSaveBreakPointLines(AMemo);
  1883. BuildAndSaveKnownIncludedAndHiddenFiles;
  1884. end;
  1885. end;
  1886. end;
  1887. function TMainForm.ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
  1888. function PromptToSaveMemo(const AMemo: TIDEScintFileEdit): Boolean;
  1889. var
  1890. FileTitle: String;
  1891. begin
  1892. Result := True;
  1893. if AMemo.Modified then begin
  1894. FileTitle := GetFileTitle(AMemo.Filename);
  1895. case MsgBox('The text in the ' + FileTitle + ' file has changed.'#13#10#13#10 +
  1896. 'Do you want to save the changes?', SCompilerFormCaption, mbError,
  1897. MB_YESNOCANCEL) of
  1898. IDYES: Result := SaveFile(AMemo, False);
  1899. IDNO: ;
  1900. else
  1901. Result := False;
  1902. end;
  1903. end;
  1904. end;
  1905. var
  1906. Memo: TIDEScintFileEdit;
  1907. begin
  1908. if FCompiling then begin
  1909. MsgBox('Please stop the compile process before performing this command.',
  1910. SCompilerFormCaption, mbError, MB_OK);
  1911. Result := False;
  1912. Exit;
  1913. end;
  1914. if FDebugging and not AskToDetachDebugger then begin
  1915. Result := False;
  1916. Exit;
  1917. end;
  1918. Result := True;
  1919. if PromptToSave then begin
  1920. for Memo in FFileMemos do begin
  1921. if Memo.Used then begin
  1922. Result := PromptToSaveMemo(Memo);
  1923. if not Result then
  1924. Exit;
  1925. end;
  1926. end;
  1927. end;
  1928. end;
  1929. procedure TMainForm.ClearMRUMainFilesList;
  1930. begin
  1931. try
  1932. ClearMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew');
  1933. except
  1934. { Ignore any exceptions. }
  1935. end;
  1936. end;
  1937. procedure TMainForm.ReadMRUMainFilesList;
  1938. begin
  1939. try
  1940. ReadMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew', 'History');
  1941. except
  1942. { Ignore any exceptions. }
  1943. end;
  1944. end;
  1945. procedure TMainForm.ModifyMRUMainFilesList(const AFilename: String;
  1946. const AddNewItem: Boolean);
  1947. begin
  1948. { Load most recent items first, just in case they've changed }
  1949. try
  1950. ReadMRUMainFilesList;
  1951. except
  1952. { Ignore any exceptions. }
  1953. end;
  1954. try
  1955. ModifyMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew', 'History', AFileName, AddNewItem, @PathCompare);
  1956. except
  1957. { Handle exceptions locally; failure to save the MRU list should not be
  1958. a fatal error. }
  1959. Application.HandleException(Self);
  1960. end;
  1961. end;
  1962. procedure TMainForm.ReadMRUParametersList;
  1963. begin
  1964. try
  1965. ReadMRUList(FMRUParametersList, 'ParametersHistory', 'History');
  1966. except
  1967. { Ignore any exceptions. }
  1968. end;
  1969. end;
  1970. procedure TMainForm.ModifyMRUParametersList(const AParameter: String;
  1971. const AddNewItem: Boolean);
  1972. begin
  1973. { Load most recent items first, just in case they've changed }
  1974. try
  1975. ReadMRUParametersList;
  1976. except
  1977. { Ignore any exceptions. }
  1978. end;
  1979. try
  1980. ModifyMRUList(FMRUParametersList, 'ParametersHistory', 'History', AParameter, AddNewItem, @CompareText);
  1981. except
  1982. { Handle exceptions locally; failure to save the MRU list should not be
  1983. a fatal error. }
  1984. Application.HandleException(Self);
  1985. end;
  1986. end;
  1987. procedure TMainForm.StatusMessage(const Kind: TStatusMessageKind; const S: String);
  1988. begin
  1989. AddLines(CompilerOutputList, S, TObject(Kind), False, alpNone, 0);
  1990. CompilerOutputList.Update;
  1991. end;
  1992. procedure TMainForm.DebugLogMessage(const S: String);
  1993. begin
  1994. AddLines(DebugOutputList, S, nil, True, alpTimestamp, FDebugLogListTimestampsWidth);
  1995. DebugOutputList.Update;
  1996. end;
  1997. procedure TMainForm.DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
  1998. begin
  1999. DebugCallStackList.Clear;
  2000. AddLines(DebugCallStackList, CallStack, nil, True, alpCountdown, FCallStackCount-1);
  2001. DebugCallStackList.Items.Insert(0, '*** [Code] Call Stack');
  2002. DebugCallStackList.Update;
  2003. end;
  2004. type
  2005. PAppData = ^TAppData;
  2006. TAppData = record
  2007. Form: TMainForm;
  2008. Filename: String;
  2009. Lines: TStringList;
  2010. CurLineNumber: Integer;
  2011. CurLine: String;
  2012. OutputExe: String;
  2013. DebugInfo: Pointer;
  2014. ErrorMsg: String;
  2015. ErrorFilename: String;
  2016. ErrorLine: Integer;
  2017. Aborted: Boolean;
  2018. end;
  2019. function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
  2020. AppData: Longint): Integer; stdcall;
  2021. procedure DecodeIncludedFilenames(P: PChar; const IncludedFiles: TIncludedFiles);
  2022. var
  2023. IncludedFile: TIncludedFile;
  2024. I: Integer;
  2025. begin
  2026. IncludedFiles.Clear;
  2027. if P = nil then
  2028. Exit;
  2029. I := 0;
  2030. while P^ <> #0 do begin
  2031. if not IsISPPBuiltins(P) then begin
  2032. IncludedFile := TIncludedFile.Create;
  2033. IncludedFile.Filename := GetCleanFileNameOfFile(P);
  2034. IncludedFile.CompilerFileIndex := I;
  2035. IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename,
  2036. @IncludedFile.LastWriteTime);
  2037. IncludedFiles.Add(IncludedFile);
  2038. end;
  2039. Inc(P, StrLen(P) + 1);
  2040. Inc(I);
  2041. end;
  2042. end;
  2043. procedure CleanHiddenFiles(const IncludedFiles: TIncludedFiles; const HiddenFiles: TStringList);
  2044. var
  2045. HiddenFileIncluded: array of Boolean;
  2046. begin
  2047. if HiddenFiles.Count > 0 then begin
  2048. { Clean previously hidden files which are no longer included }
  2049. if IncludedFiles.Count > 0 then begin
  2050. SetLength(HiddenFileIncluded, HiddenFiles.Count);
  2051. for var I := 0 to HiddenFiles.Count-1 do
  2052. HiddenFileIncluded[I] := False;
  2053. for var I := 0 to IncludedFiles.Count-1 do begin
  2054. var IncludedFile := IncludedFiles[I];
  2055. var HiddenFileIndex := HiddenFiles.IndexOf(IncludedFile.Filename);
  2056. if HiddenFileIndex <> -1 then
  2057. HiddenFileIncluded[HiddenFileIndex] := True;
  2058. end;
  2059. for var I := HiddenFiles.Count-1 downto 0 do
  2060. if not HiddenFileIncluded[I] then
  2061. HiddenFiles.Delete(I);
  2062. end else
  2063. HiddenFiles.Clear;
  2064. end;
  2065. end;
  2066. begin
  2067. Result := iscrSuccess;
  2068. with PAppData(AppData)^ do
  2069. case Code of
  2070. iscbReadScript:
  2071. begin
  2072. if Data.Reset then
  2073. CurLineNumber := 0;
  2074. if CurLineNumber < Lines.Count then begin
  2075. CurLine := Lines[CurLineNumber];
  2076. Data.LineRead := PChar(CurLine);
  2077. Inc(CurLineNumber);
  2078. end;
  2079. end;
  2080. iscbNotifyStatus:
  2081. if Data.Warning then
  2082. Form.StatusMessage(smkWarning, Data.StatusMsg)
  2083. else
  2084. Form.StatusMessage(smkNormal, Data.StatusMsg);
  2085. iscbNotifyIdle:
  2086. begin
  2087. Form.UpdateCompileStatusPanels(Data.CompressProgress,
  2088. Data.CompressProgressMax, Data.SecondsRemaining,
  2089. Data.BytesCompressedPerSecond);
  2090. { We have to use HandleMessage instead of ProcessMessages so that
  2091. Application.Idle is called. Otherwise, Flat TSpeedButton's don't
  2092. react to the mouse being moved over them.
  2093. Unfortunately, HandleMessage by default calls WaitMessage. To avoid
  2094. this we have an Application.OnIdle handler which sets Done to False
  2095. while compiling is in progress - see AppOnIdle.
  2096. The GetQueueStatus check below is just an optimization; calling
  2097. HandleMessage when there are no messages to process wastes CPU. }
  2098. if GetQueueStatus(QS_ALLINPUT) <> 0 then begin
  2099. Form.FBecameIdle := False;
  2100. repeat
  2101. Application.HandleMessage;
  2102. { AppOnIdle sets FBecameIdle to True when it's called, which
  2103. indicates HandleMessage didn't find any message to process }
  2104. until Form.FBecameIdle;
  2105. end;
  2106. if Form.FCompileWantAbort then
  2107. Result := iscrRequestAbort;
  2108. end;
  2109. iscbNotifyPreproc:
  2110. begin
  2111. Form.FPreprocessorOutput := TrimRight(Data.PreprocessedScript);
  2112. DecodeIncludedFilenames(Data.IncludedFilenames, Form.FIncludedFiles); { Also stores last write time }
  2113. CleanHiddenFiles(Form.FIncludedFiles, Form.FHiddenFiles);
  2114. Form.InvalidateStatusPanel(spHiddenFilesCount);
  2115. Form.BuildAndSaveKnownIncludedAndHiddenFiles;
  2116. end;
  2117. iscbNotifySuccess:
  2118. begin
  2119. OutputExe := Data.OutputExeFilename;
  2120. if Form.FCompilerVersion.BinVersion >= $3000001 then begin
  2121. DebugInfo := AllocMem(Data.DebugInfoSize);
  2122. Move(Data.DebugInfo^, DebugInfo^, Data.DebugInfoSize);
  2123. end else
  2124. DebugInfo := nil;
  2125. end;
  2126. iscbNotifyError:
  2127. begin
  2128. if Assigned(Data.ErrorMsg) then
  2129. ErrorMsg := Data.ErrorMsg
  2130. else
  2131. Aborted := True;
  2132. ErrorFilename := Data.ErrorFilename;
  2133. ErrorLine := Data.ErrorLine;
  2134. end;
  2135. end;
  2136. end;
  2137. procedure TMainForm.CompileFile(AFilename: String; const ReadFromFile: Boolean);
  2138. function GetMemoFromErrorFilename(const ErrorFilename: String): TIDEScintFileEdit;
  2139. var
  2140. Memo: TIDEScintFileEdit;
  2141. begin
  2142. if ErrorFilename = '' then
  2143. Result := FMainMemo
  2144. else begin
  2145. if FOptions.OpenIncludedFiles then begin
  2146. for Memo in FFileMemos do begin
  2147. if Memo.Used and (PathCompare(Memo.Filename, ErrorFilename) = 0) then begin
  2148. Result := Memo;
  2149. Exit;
  2150. end;
  2151. end;
  2152. end;
  2153. Result := nil;
  2154. end;
  2155. end;
  2156. var
  2157. SourcePath, S, Options: String;
  2158. Params: TCompileScriptParamsEx;
  2159. AppData: TAppData;
  2160. StartTime, ElapsedTime, ElapsedSeconds: DWORD;
  2161. I: Integer;
  2162. Memo: TIDEScintFileEdit;
  2163. OldActiveMemo: TIDEScintEdit;
  2164. begin
  2165. if FCompiling then begin
  2166. { Shouldn't get here, but just in case... }
  2167. MsgBox('A compile is already in progress.', SCompilerFormCaption, mbError, MB_OK);
  2168. Abort;
  2169. end;
  2170. if not ReadFromFile then begin
  2171. if FOptions.OpenIncludedFiles then begin
  2172. { Included files must always be saved since they're not read from the editor by the compiler }
  2173. for Memo in FFileMemos do begin
  2174. if (Memo <> FMainMemo) and Memo.Used and Memo.Modified then begin
  2175. if FOptions.Autosave then begin
  2176. if not SaveFile(Memo, False) then
  2177. Abort;
  2178. end else begin
  2179. case MsgBox('The text in the ' + Memo.Filename + ' file has changed and must be saved before compiling.'#13#10#13#10 +
  2180. 'Save the changes and continue?', SCompilerFormCaption, mbError,
  2181. MB_YESNO) of
  2182. IDYES:
  2183. if not SaveFile(Memo, False) then
  2184. Abort;
  2185. else
  2186. Abort;
  2187. end;
  2188. end;
  2189. end;
  2190. end;
  2191. end;
  2192. { Save main file if requested }
  2193. if FOptions.Autosave and FMainMemo.Modified then begin
  2194. if not SaveFile(FMainMemo, False) then
  2195. Abort;
  2196. end else if FMainMemo.Filename = '' then begin
  2197. case MsgBox('Would you like to save the script before compiling?' +
  2198. SNewLine2 + 'If you answer No, the compiled installation will be ' +
  2199. 'placed under your My Documents folder by default.',
  2200. SCompilerFormCaption, mbConfirmation, MB_YESNOCANCEL) of
  2201. IDYES:
  2202. if not SaveFile(FMainMemo, False) then
  2203. Abort;
  2204. IDNO: ;
  2205. else
  2206. Abort;
  2207. end;
  2208. end;
  2209. AFilename := FMainMemo.Filename;
  2210. end; {else: Command line compile, AFilename already set. }
  2211. DestroyDebugInfo;
  2212. OldActiveMemo := FActiveMemo;
  2213. AppData.Lines := TStringList.Create;
  2214. try
  2215. FBuildAnimationFrame := 0;
  2216. FProgress := 0;
  2217. FProgressMax := 0;
  2218. FTaskbarProgressValue := 0;
  2219. FActiveMemo.CancelAutoCompleteAndCallTip;
  2220. FActiveMemo.Cursor := crAppStart;
  2221. FActiveMemo.SetCursorID(999); { hack to keep it from overriding Cursor }
  2222. CompilerOutputList.Cursor := crAppStart;
  2223. for Memo in FFileMemos do
  2224. Memo.ReadOnly := True;
  2225. UpdateEditModePanel;
  2226. HideError;
  2227. CompilerOutputList.Clear;
  2228. SendMessage(CompilerOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  2229. DebugOutputList.Clear;
  2230. SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  2231. DebugCallStackList.Clear;
  2232. SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  2233. OutputTabSet.TabIndex := tiCompilerOutput;
  2234. SetStatusPanelVisible(True);
  2235. SourcePath := GetSourcePath(AFilename);
  2236. FillChar(Params, SizeOf(Params), 0);
  2237. Params.Size := SizeOf(Params);
  2238. Params.CompilerPath := nil;
  2239. Params.SourcePath := PChar(SourcePath);
  2240. Params.CallbackProc := CompilerCallbackProc;
  2241. Pointer(Params.AppData) := @AppData;
  2242. Options := '';
  2243. for I := 0 to FSignTools.Count-1 do
  2244. Options := Options + AddSignToolParam(FSignTools[I]);
  2245. Params.Options := PChar(Options);
  2246. AppData.Form := Self;
  2247. AppData.CurLineNumber := 0;
  2248. AppData.Aborted := False;
  2249. I := ReadScriptLines(AppData.Lines, ReadFromFile, AFilename, FMainMemo);
  2250. if I <> -1 then begin
  2251. if not ReadFromFile then begin
  2252. MoveCaretAndActivateMemo(FMainMemo, I, False);
  2253. SetErrorLine(FMainMemo, I);
  2254. end;
  2255. raise Exception.CreateFmt(SCompilerIllegalNullChar, [I + 1]);
  2256. end;
  2257. StartTime := GetTickCount;
  2258. StatusMessage(smkStartEnd, Format(SCompilerStatusStarting, [TimeToStr(Time)]));
  2259. StatusMessage(smkStartEnd, '');
  2260. FCompiling := True;
  2261. FCompileWantAbort := False;
  2262. UpdateRunMenu;
  2263. UpdateCaption;
  2264. SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass);
  2265. AppData.Filename := AFilename;
  2266. {$IFNDEF STATICCOMPILER}
  2267. if ISDllCompileScript(Params) <> isceNoError then begin
  2268. {$ELSE}
  2269. if ISCompileScript(Params, False) <> isceNoError then begin
  2270. {$ENDIF}
  2271. StatusMessage(smkError, SCompilerStatusErrorAborted);
  2272. if not ReadFromFile and (AppData.ErrorLine > 0) then begin
  2273. Memo := GetMemoFromErrorFilename(AppData.ErrorFilename);
  2274. if Memo <> nil then begin
  2275. { Move the caret to the line number the error occurred on }
  2276. MoveCaretAndActivateMemo(Memo, AppData.ErrorLine - 1, False);
  2277. SetErrorLine(Memo, AppData.ErrorLine - 1);
  2278. end;
  2279. end;
  2280. if not AppData.Aborted then begin
  2281. S := '';
  2282. if AppData.ErrorFilename <> '' then
  2283. S := 'File: ' + AppData.ErrorFilename + SNewLine2;
  2284. if AppData.ErrorLine > 0 then
  2285. S := S + Format('Line %d:' + SNewLine, [AppData.ErrorLine]);
  2286. S := S + AppData.ErrorMsg;
  2287. SetAppTaskbarProgressState(tpsError);
  2288. MsgBox(S, 'Compiler Error', mbCriticalError, MB_OK)
  2289. end;
  2290. Abort;
  2291. end;
  2292. ElapsedTime := GetTickCount - StartTime;
  2293. ElapsedSeconds := ElapsedTime div 1000;
  2294. StatusMessage(smkStartEnd, Format(SCompilerStatusFinished, [TimeToStr(Time),
  2295. Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, FormatSettings.TimeSeparator,
  2296. ElapsedSeconds mod 60, FormatSettings.DecimalSeparator, ElapsedTime mod 1000])]));
  2297. finally
  2298. AppData.Lines.Free;
  2299. FCompiling := False;
  2300. SetLowPriority(False, FSavePriorityClass);
  2301. OldActiveMemo.Cursor := crDefault;
  2302. OldActiveMemo.SetCursorID(SC_CURSORNORMAL);
  2303. CompilerOutputList.Cursor := crDefault;
  2304. for Memo in FFileMemos do
  2305. Memo.ReadOnly := False;
  2306. UpdateEditModePanel;
  2307. UpdateRunMenu;
  2308. UpdateCaption;
  2309. UpdatePreprocMemos;
  2310. if AppData.DebugInfo <> nil then begin
  2311. ParseDebugInfo(AppData.DebugInfo); { Must be called after UpdateIncludedFilesMemos }
  2312. FreeMem(AppData.DebugInfo);
  2313. end;
  2314. InvalidateStatusPanel(spCompileIcon);
  2315. InvalidateStatusPanel(spCompileProgress);
  2316. SetAppTaskbarProgressState(tpsNoProgress);
  2317. StatusBar.Panels[spExtraStatus].Text := '';
  2318. end;
  2319. FCompiledExe := AppData.OutputExe;
  2320. FModifiedAnySinceLastCompile := False;
  2321. FModifiedAnySinceLastCompileAndGo := False;
  2322. end;
  2323. procedure TMainForm.SyncEditorOptions;
  2324. const
  2325. SquigglyStyles: array[Boolean] of Integer = (INDIC_HIDDEN, INDIC_SQUIGGLE);
  2326. WhiteSpaceStyles: array[Boolean] of Integer = (SCWS_INVISIBLE, SCWS_VISIBLEALWAYS);
  2327. var
  2328. Memo: TIDEScintEdit;
  2329. begin
  2330. for Memo in FMemos do begin
  2331. Memo.UseStyleAttributes := FOptions.UseSyntaxHighlighting;
  2332. Memo.Call(SCI_INDICSETSTYLE, minSquiggly, SquigglyStyles[FOptions.UnderlineErrors]);
  2333. Memo.Call(SCI_SETVIEWWS, WhiteSpaceStyles[FOptions.ShowWhiteSpace], 0);
  2334. if FOptions.CursorPastEOL then
  2335. Memo.VirtualSpaceOptions := [svsRectangularSelection, svsUserAccessible, svsNoWrapLineStart]
  2336. else
  2337. Memo.VirtualSpaceOptions := [];
  2338. Memo.FillSelectionToEdge := FOptions.CursorPastEOL;
  2339. Memo.TabWidth := FOptions.TabWidth;
  2340. Memo.UseTabCharacter := FOptions.UseTabCharacter;
  2341. Memo.KeyMappingType := FOptions.MemoKeyMappingType;
  2342. if Memo = FMainMemo then begin
  2343. SetFakeShortCut(ESelectNextOccurrence, FMainMemo.GetComplexCommandShortCut(ccSelectNextOccurrence));
  2344. SetFakeShortCut(ESelectAllOccurrences, FMainMemo.GetComplexCommandShortCut(ccSelectAllOccurrences));
  2345. SetFakeShortCut(ESelectAllFindMatches, FMainMemo.GetComplexCommandShortCut(ccSelectAllFindMatches));
  2346. SetFakeShortCut(EFoldLine, FMainMemo.GetComplexCommandShortCut(ccFoldLine));
  2347. SetFakeShortCut(EUnfoldLine, FMainMemo.GetComplexCommandShortCut(ccUnfoldLine));
  2348. SetFakeShortCut(EToggleLinesComment, FMainMemo.GetComplexCommandShortCut(ccToggleLinesComment));
  2349. SetFakeShortCut(EBraceMatch, FMainMemo.GetComplexCommandShortCut(ccBraceMatch));
  2350. end;
  2351. Memo.UseFolding := FOptions.UseFolding;
  2352. Memo.WordWrap := FOptions.WordWrap;
  2353. if FOptions.IndentationGuides then
  2354. Memo.IndentationGuides := sigLookBoth
  2355. else
  2356. Memo.IndentationGuides := sigNone;
  2357. Memo.LineNumbers := FOptions.GutterLineNumbers;
  2358. end;
  2359. end;
  2360. procedure TMainForm.FMenuClick(Sender: TObject);
  2361. var
  2362. I: Integer;
  2363. begin
  2364. FSaveMainFileAs.Enabled := FActiveMemo = FMainMemo;
  2365. FSaveEncoding.Enabled := FSave.Enabled; { FSave.Enabled is kept up-to-date by UpdateSaveMenuItemAndButton }
  2366. FSaveEncodingAuto.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TIDEScintFileEdit).SaveEncoding = seAuto);
  2367. FSaveEncodingUTF8WithBOM.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TIDEScintFileEdit).SaveEncoding = seUTF8WithBOM);
  2368. FSaveEncodingUTF8WithoutBOM.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TIDEScintFileEdit).SaveEncoding = seUTF8WithoutBOM);
  2369. FSaveAll.Visible := FOptions.OpenIncludedFiles;
  2370. ReadMRUMainFilesList;
  2371. FRecent.Visible := FMRUMainFilesList.Count <> 0;
  2372. for I := 0 to High(FMRUMainFilesMenuItems) do
  2373. with FMRUMainFilesMenuItems[I] do begin
  2374. if I < FMRUMainFilesList.Count then begin
  2375. Visible := True;
  2376. Caption := '&' + IntToStr((I+1) mod 10) + ' ' + DoubleAmp(FMRUMainFilesList[I]);
  2377. end
  2378. else
  2379. Visible := False;
  2380. end;
  2381. ApplyMenuBitmaps(Sender as TMenuItem);
  2382. end;
  2383. procedure TMainForm.FNewMainFileClick(Sender: TObject);
  2384. begin
  2385. if ConfirmCloseFile(True) then
  2386. NewMainFile;
  2387. end;
  2388. procedure TMainForm.FNewMainFileUserWizardClick(Sender: TObject);
  2389. begin
  2390. if ConfirmCloseFile(True) then
  2391. NewMainFileUsingWizard;
  2392. end;
  2393. procedure TMainForm.ShowOpenMainFileDialog(const Examples: Boolean);
  2394. var
  2395. InitialDir, FileName: String;
  2396. begin
  2397. if Examples then begin
  2398. InitialDir := PathExtractPath(NewParamStr(0)) + 'Examples';
  2399. Filename := PathExtractPath(NewParamStr(0)) + 'Examples\Example1.iss';
  2400. end
  2401. else begin
  2402. InitialDir := PathExtractDir(FMainMemo.Filename);
  2403. Filename := '';
  2404. end;
  2405. if ConfirmCloseFile(True) then
  2406. if NewGetOpenFileName('', FileName, InitialDir, SCompilerOpenFilter, 'iss', Handle) then
  2407. OpenFile(FMainMemo, Filename, False);
  2408. end;
  2409. procedure TMainForm.FOpenMainFileClick(Sender: TObject);
  2410. begin
  2411. ShowOpenMainFileDialog(False);
  2412. end;
  2413. procedure TMainForm.FSaveClick(Sender: TObject);
  2414. begin
  2415. SaveFile((FActiveMemo as TIDEScintFileEdit), Sender = FSaveMainFileAs);
  2416. end;
  2417. procedure TMainForm.FSaveEncodingItemClick(Sender: TObject);
  2418. begin
  2419. var Memo := (FActiveMemo as TIDEScintFileEdit);
  2420. var OldSaveEncoding := Memo.SaveEncoding;
  2421. if Sender = FSaveEncodingUTF8WithBOM then
  2422. Memo.SaveEncoding := seUTF8WithBOM
  2423. else if Sender = FSaveEncodingUTF8WithoutBOM then
  2424. Memo.SaveEncoding := seUTF8WithoutBOM
  2425. else
  2426. Memo.SaveEncoding := seAuto;
  2427. if Memo.SaveEncoding <> OldSaveEncoding then
  2428. Memo.ForceModifiedState;
  2429. end;
  2430. procedure TMainForm.FSaveAllClick(Sender: TObject);
  2431. var
  2432. Memo: TIDEScintFileEdit;
  2433. begin
  2434. for Memo in FFileMemos do
  2435. if Memo.Used and Memo.Modified then
  2436. SaveFile(Memo, False);
  2437. end;
  2438. procedure TMainForm.FPrintClick(Sender: TObject);
  2439. procedure SetupNonDarkPrintStyler(var PrintStyler: TInnoSetupStyler; var PrintTheme: TTheme;
  2440. var OldStyler: TScintCustomStyler; var OldTheme: TTheme);
  2441. begin
  2442. { Not the most pretty code, would ideally make a copy of FActiveMemo and print that instead or
  2443. somehow convince Scintilla to use different print styles but don't know of a good way to do
  2444. either. Using SC_PRINT_COLOURONWHITE doesn't help, this gives white on white in dark mode. }
  2445. PrintStyler := TInnoSetupStyler.Create(nil);
  2446. PrintTheme := TTheme.Create;
  2447. PrintStyler.ISPPInstalled := ISPPInstalled;
  2448. PrintStyler.Theme := PrintTheme;
  2449. if not FTheme.Dark then
  2450. PrintTheme.Typ := FTheme.Typ
  2451. else
  2452. PrintTheme.Typ := ttModernLight;
  2453. OldStyler := FActiveMemo.Styler;
  2454. OldTheme := FActiveMemo.Theme;
  2455. FActiveMemo.Styler := PrintStyler;
  2456. FActiveMemo.Theme := PrintTheme;
  2457. FActiveMemo.UpdateThemeColorsAndStyleAttributes;
  2458. end;
  2459. procedure DeinitPrintStyler(const PrintStyler: TInnoSetupStyler; const PrintTheme: TTheme;
  2460. const OldStyler: TScintCustomStyler; const OldTheme: TTheme);
  2461. begin
  2462. if (OldStyler <> nil) or (OldTheme <> nil) then begin
  2463. if OldStyler <> nil then
  2464. FActiveMemo.Styler := OldStyler;
  2465. if OldTheme <> nil then
  2466. FActiveMemo.Theme := OldTheme;
  2467. FActiveMemo.UpdateThemeColorsAndStyleAttributes;
  2468. end;
  2469. if PrintTheme <> FTheme then
  2470. PrintTheme.Free;
  2471. PrintStyler.Free;
  2472. end;
  2473. var
  2474. PrintStyler: TInnoSetupStyler;
  2475. OldStyler: TScintCustomStyler;
  2476. PrintTheme, OldTheme: TTheme;
  2477. PrintMemo: TIDEScintEdit;
  2478. HeaderMemo: TIDEScintFileEdit;
  2479. FileTitle, S: String;
  2480. pdlg: TPrintDlg;
  2481. hdc: Windows.HDC;
  2482. rectMargins, rectPhysMargins, rectSetup, rcw: TRect;
  2483. ptPage, ptDpi: TPoint;
  2484. headerLineHeight, footerLineHeight: Integer;
  2485. fontHeader, fontFooter: HFONT;
  2486. tm: TTextMetric;
  2487. di: TDocInfo;
  2488. lengthDoc, lengthDocMax, lengthPrinted: Integer;
  2489. frPrint: TScintRangeToFormat;
  2490. pageNum: Integer;
  2491. printPage: Boolean;
  2492. ta: UINT;
  2493. sHeader, sFooter: String;
  2494. pen, penOld: HPEN;
  2495. begin
  2496. if FActiveMemo is TIDEScintFileEdit then
  2497. HeaderMemo := TIDEScintFileEdit(FActiveMemo)
  2498. else
  2499. HeaderMemo := FMainMemo;
  2500. sHeader := HeaderMemo.Filename;
  2501. FileTitle := GetFileTitle(HeaderMemo.Filename);
  2502. if HeaderMemo <> FActiveMemo then begin
  2503. S := ' - ' + MemosTabSet.Tabs[MemoToTabIndex(FActiveMemo)];
  2504. sHeader := Format('%s %s', [sHeader, S]);
  2505. FileTitle := Format('%s %s', [FileTitle, S]);
  2506. end;
  2507. sHeader := Format('%s - %s', [sHeader, DateTimeToStr(Now())]);
  2508. { Based on SciTE 5.50's SciTEWin::Print }
  2509. ZeroMemory(@pdlg, SizeOf(pdlg));
  2510. pdlg.lStructSize := SizeOf(pdlg);
  2511. pdlg.hwndOwner := Handle;
  2512. pdlg.hInstance := hInstance;
  2513. pdlg.Flags := PD_USEDEVMODECOPIES or PD_ALLPAGES or PD_RETURNDC;
  2514. pdlg.nFromPage := 1;
  2515. pdlg.nToPage := 1;
  2516. pdlg.nMinPage := 1;
  2517. pdlg.nMaxPage := $ffff; // We do not know how many pages in the document until the printer is selected and the paper size is known.
  2518. pdlg.nCopies := 1;
  2519. pdlg.hDC := 0;
  2520. pdlg.hDevMode := FDevMode;
  2521. pdlg.hDevNames := FDevNames;
  2522. // See if a range has been selected
  2523. var rangeSelection := FActiveMemo.Selection;
  2524. if rangeSelection.StartPos = rangeSelection.EndPos then
  2525. pdlg.Flags := pdlg.Flags or PD_NOSELECTION
  2526. else
  2527. pdlg.Flags := pdlg.Flags or PD_SELECTION;
  2528. if not PrintDlg(pdlg) then
  2529. Exit;
  2530. PrintStyler := nil;
  2531. PrintTheme := nil;
  2532. OldStyler := nil;
  2533. OldTheme := nil;
  2534. try
  2535. if FTheme.Dark then
  2536. SetupNonDarkPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme)
  2537. else
  2538. PrintTheme := FTheme;
  2539. FDevMode := pdlg.hDevMode;
  2540. FDevNames := pdlg.hDevNames;
  2541. hdc := pdlg.hDC;
  2542. // Get printer resolution
  2543. ptDpi.x := GetDeviceCaps(hdc, LOGPIXELSX); // dpi in X direction
  2544. ptDpi.y := GetDeviceCaps(hdc, LOGPIXELSY); // dpi in Y direction
  2545. // Start by getting the physical page size (in device units).
  2546. ptPage.x := GetDeviceCaps(hdc, PHYSICALWIDTH); // device units
  2547. ptPage.y := GetDeviceCaps(hdc, PHYSICALHEIGHT); // device units
  2548. // Get the dimensions of the unprintable
  2549. // part of the page (in device units).
  2550. rectPhysMargins.left := GetDeviceCaps(hdc, PHYSICALOFFSETX);
  2551. rectPhysMargins.top := GetDeviceCaps(hdc, PHYSICALOFFSETY);
  2552. // To get the right and lower unprintable area,
  2553. // we take the entire width and height of the paper and
  2554. // subtract everything else.
  2555. rectPhysMargins.right := ptPage.x // total paper width
  2556. - GetDeviceCaps(hdc, HORZRES) // printable width
  2557. - rectPhysMargins.left; // left unprintable margin
  2558. rectPhysMargins.bottom := ptPage.y // total paper height
  2559. - GetDeviceCaps(hdc, VERTRES) // printable height
  2560. - rectPhysMargins.top; // right unprintable margin
  2561. // At this point, rectPhysMargins contains the widths of the
  2562. // unprintable regions on all four sides of the page in device units.
  2563. (*
  2564. // Take in account the page setup given by the user (if one value is not null)
  2565. if (pagesetupMargin.left != 0 || pagesetupMargin.right != 0 ||
  2566. pagesetupMargin.top != 0 || pagesetupMargin.bottom != 0) {
  2567. GUI::Rectangle rectSetup;
  2568. // Convert the hundredths of millimeters (HiMetric) or
  2569. // thousandths of inches (HiEnglish) margin values
  2570. // from the Page Setup dialog to device units.
  2571. // (There are 2540 hundredths of a mm in an inch.)
  2572. TCHAR localeInfo[3];
  2573. GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, localeInfo, 3);
  2574. if (localeInfo[0] == '0') { // Metric system. '1' is US System *)
  2575. rectSetup.left := MulDiv(500 {pagesetupMargin.left}, ptDpi.x, 2540);
  2576. rectSetup.top := MulDiv(500 {pagesetupMargin.top}, ptDpi.y, 2540);
  2577. rectSetup.right := MulDiv(500 {pagesetupMargin.right}, ptDpi.x, 2540);
  2578. rectSetup.bottom := MulDiv(500 {pagesetupMargin.bottom}, ptDpi.y, 2540);
  2579. (* } else {
  2580. rectSetup.left = MulDiv(pagesetupMargin.left, ptDpi.x, 1000);
  2581. rectSetup.top = MulDiv(pagesetupMargin.top, ptDpi.y, 1000);
  2582. rectSetup.right = MulDiv(pagesetupMargin.right, ptDpi.x, 1000);
  2583. rectSetup.bottom = MulDiv(pagesetupMargin.bottom, ptDpi.y, 1000);
  2584. } *)
  2585. // Don't reduce margins below the minimum printable area
  2586. rectMargins.left := Max(rectPhysMargins.left, rectSetup.left);
  2587. rectMargins.top := Max(rectPhysMargins.top, rectSetup.top);
  2588. rectMargins.right := Max(rectPhysMargins.right, rectSetup.right);
  2589. rectMargins.bottom := Max(rectPhysMargins.bottom, rectSetup.bottom);
  2590. (*
  2591. } else {
  2592. rectMargins := rectPhysMargins;
  2593. }
  2594. *)
  2595. // rectMargins now contains the values used to shrink the printable
  2596. // area of the page.
  2597. // Convert device coordinates into logical coordinates
  2598. DPtoLP(hdc, rectMargins, 2);
  2599. DPtoLP(hdc, rectPhysMargins, 2);
  2600. // Convert page size to logical units and we're done!
  2601. DPtoLP(hdc, ptPage, 1);
  2602. headerLineHeight := MulDiv(9, ptDpi.y, 72);
  2603. fontHeader := CreateFont(headerLineHeight, 0, 0, 0, FW_REGULAR, 1, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name));
  2604. SelectObject(hdc, fontHeader);
  2605. GetTextMetrics(hdc, &tm);
  2606. headerLineHeight := tm.tmHeight + tm.tmExternalLeading;
  2607. footerLineHeight := MulDiv(9, ptDpi.y, 72);
  2608. fontFooter := CreateFont(footerLineHeight, 0, 0, 0, FW_REGULAR, 0, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name));
  2609. SelectObject(hdc, fontFooter);
  2610. GetTextMetrics(hdc, &tm);
  2611. footerLineHeight := tm.tmHeight + tm.tmExternalLeading;
  2612. ZeroMemory(@di, SizeOf(di));
  2613. di.cbSize := SizeOf(di);
  2614. di.lpszDocName := PChar(FileTitle);
  2615. di.lpszOutput := nil;
  2616. di.lpszDatatype := nil;
  2617. di.fwType := 0;
  2618. if StartDoc(hdc, &di) < 0 then begin
  2619. DeleteDC(hdc);
  2620. DeleteObject(fontHeader);
  2621. DeleteObject(fontFooter);
  2622. MsgBox('Can not start printer document.', SCompilerFormCaption, mbError, MB_OK);
  2623. Exit;
  2624. end;
  2625. lengthDocMax := FActiveMemo.GetRawTextLength;
  2626. // PD_SELECTION -> requested to print selection.
  2627. lengthDoc := IfThen((pdlg.Flags and PD_SELECTION) <> 0, rangeSelection.EndPos, lengthDocMax);
  2628. lengthPrinted := IfThen((pdlg.Flags and PD_SELECTION) <> 0, rangeSelection.StartPos, 0);
  2629. // We must subtract the physical margins from the printable area
  2630. frPrint.hdc := hdc;
  2631. frPrint.hdcTarget := hdc;
  2632. frPrint.rc.left := rectMargins.left - rectPhysMargins.left;
  2633. frPrint.rc.top := rectMargins.top - rectPhysMargins.top;
  2634. frPrint.rc.right := ptPage.x - rectMargins.right - rectPhysMargins.left;
  2635. frPrint.rc.bottom := ptPage.y - rectMargins.bottom - rectPhysMargins.top;
  2636. frPrint.rcPage.left := 0;
  2637. frPrint.rcPage.top := 0;
  2638. frPrint.rcPage.right := ptPage.x - rectPhysMargins.left - rectPhysMargins.right - 1;
  2639. frPrint.rcPage.bottom := ptPage.y - rectPhysMargins.top - rectPhysMargins.bottom - 1;
  2640. frPrint.rc.top := frPrint.rc.top + headerLineHeight + headerLineHeight div 2;
  2641. frPrint.rc.bottom := frPrint.rc.bottom - (footerLineHeight + footerLineHeight div 2);
  2642. // Print each page
  2643. pageNum := 1;
  2644. while lengthPrinted < lengthDoc do begin
  2645. printPage := ((pdlg.Flags and PD_PAGENUMS) = 0) or
  2646. ((pageNum >= pdlg.nFromPage) and (pageNum <= pdlg.nToPage));
  2647. sFooter := Format('- %d -', [pageNum]);
  2648. if printPage then begin
  2649. StartPage(hdc);
  2650. SetTextColor(hdc, PrintTheme.Colors[tcFore]);
  2651. SetBkColor(hdc, PrintTheme.Colors[tcBack]);
  2652. SelectObject(hdc, fontHeader);
  2653. ta := SetTextAlign(hdc, TA_BOTTOM);
  2654. rcw := Rect(frPrint.rc.left, frPrint.rc.top - headerLineHeight - headerLineHeight div 2,
  2655. frPrint.rc.right, frPrint.rc.top - headerLineHeight div 2);
  2656. rcw.bottom := rcw.top + headerLineHeight;
  2657. ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.top - headerLineHeight div 2,
  2658. ETO_OPAQUE, rcw, sHeader, Length(sHeader), nil);
  2659. SetTextAlign(hdc, ta);
  2660. pen := CreatePen(0, 1, GetTextColor(hdc));
  2661. penOld := SelectObject(hdc, pen);
  2662. MoveToEx(hdc, frPrint.rc.left, frPrint.rc.top - headerLineHeight div 4, nil);
  2663. LineTo(hdc, frPrint.rc.right, frPrint.rc.top - headerLineHeight div 4);
  2664. SelectObject(hdc, penOld);
  2665. DeleteObject(pen);
  2666. end;
  2667. frPrint.chrg.StartPos := lengthPrinted;
  2668. frPrint.chrg.EndPos := lengthDoc;
  2669. lengthPrinted := FActiveMemo.FormatRange(printPage, @frPrint);
  2670. if printPage then begin
  2671. SetTextColor(hdc, PrintTheme.Colors[tcFore]);
  2672. SetBkColor(hdc, PrintTheme.Colors[tcBack]);
  2673. SelectObject(hdc, fontFooter);
  2674. ta := SetTextAlign(hdc, TA_TOP);
  2675. rcw := Rect(frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 2,
  2676. frPrint.rc.right, frPrint.rc.bottom + footerLineHeight + footerLineHeight div 2);
  2677. ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.bottom + footerLineHeight div 2,
  2678. ETO_OPAQUE, rcw, sFooter, Length(sFooter), nil);
  2679. SetTextAlign(hdc, ta);
  2680. pen := CreatePen(0, 1, GetTextColor(hdc));
  2681. penOld := SelectObject(hdc, pen);
  2682. MoveToEx(hdc, frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 4, nil);
  2683. LineTo(hdc, frPrint.rc.right, frPrint.rc.bottom + footerLineHeight div 4);
  2684. SelectObject(hdc, penOld);
  2685. DeleteObject(pen);
  2686. EndPage(hdc);
  2687. end;
  2688. Inc(pageNum);
  2689. if ((pdlg.Flags and PD_PAGENUMS) <> 0) and (pageNum > pdlg.nToPage) then
  2690. Break;
  2691. end;
  2692. FActiveMemo.FormatRange(False, nil);
  2693. EndDoc(hdc);
  2694. DeleteDC(hdc);
  2695. DeleteObject(fontHeader);
  2696. DeleteObject(fontFooter);
  2697. finally
  2698. DeinitPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme);
  2699. end;
  2700. end;
  2701. procedure TMainForm.FClearRecentClick(Sender: TObject);
  2702. begin
  2703. if MsgBox('Are you sure you want to clear the list of recently opened files?',
  2704. SCompilerFormCaption, mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then
  2705. ClearMRUMainFilesList;
  2706. end;
  2707. procedure TMainForm.FMRUClick(Sender: TObject);
  2708. var
  2709. I: Integer;
  2710. begin
  2711. if ConfirmCloseFile(True) then
  2712. for I := 0 to High(FMRUMainFilesMenuItems) do
  2713. if FMRUMainFilesMenuItems[I] = Sender then begin
  2714. OpenMRUMainFile(FMRUMainFilesList[I]);
  2715. Break;
  2716. end;
  2717. end;
  2718. procedure TMainForm.FExitClick(Sender: TObject);
  2719. begin
  2720. Close;
  2721. end;
  2722. procedure TMainForm.EMenuClick(Sender: TObject);
  2723. var
  2724. MemoHasFocus, MemoIsReadOnly: Boolean;
  2725. begin
  2726. MemoHasFocus := FActiveMemo.Focused;
  2727. MemoIsReadOnly := FActiveMemo.ReadOnly;
  2728. EUndo.Enabled := MemoHasFocus and FActiveMemo.CanUndo;
  2729. ERedo.Enabled := MemoHasFocus and FActiveMemo.CanRedo;
  2730. ECut.Enabled := MemoHasFocus and not MemoIsReadOnly and not FActiveMemo.SelEmpty;
  2731. ECopy.Enabled := MemoHasFocus and not FActiveMemo.SelEmpty;
  2732. EPaste.Enabled := MemoHasFocus and FActiveMemo.CanPaste;
  2733. EDelete.Enabled := MemoHasFocus and not FActiveMemo.SelEmpty;
  2734. ESelectAll.Enabled := MemoHasFocus;
  2735. ESelectNextOccurrence.Enabled := MemoHasFocus;
  2736. ESelectAllOccurrences.Enabled := MemoHasFocus;
  2737. ESelectAllFindMatches.Enabled := MemoHasFocus and (FLastFindText <> '');
  2738. EFind.Enabled := MemoHasFocus;
  2739. EFindNext.Enabled := MemoHasFocus;
  2740. EFindPrevious.Enabled := MemoHasFocus;
  2741. EReplace.Enabled := MemoHasFocus and not MemoIsReadOnly;
  2742. EFindRegEx.Checked := FOptions.FindRegEx;
  2743. EFoldLine.Visible := FOptions.UseFolding;
  2744. EFoldLine.Enabled := MemoHasFocus;
  2745. EUnfoldLine.Visible := EFoldLine.Visible;
  2746. EUnfoldLine.Enabled := EFoldLine.Enabled;
  2747. EGoto.Enabled := MemoHasFocus;
  2748. EToggleLinesComment.Enabled := not MemoIsReadOnly;
  2749. EBraceMatch.Enabled := MemoHasFocus;
  2750. ApplyMenuBitmaps(Sender as TMenuItem);
  2751. end;
  2752. procedure TMainForm.EUndoClick(Sender: TObject);
  2753. begin
  2754. FActiveMemo.Undo;
  2755. end;
  2756. procedure TMainForm.ERedoClick(Sender: TObject);
  2757. begin
  2758. FActiveMemo.Redo;
  2759. end;
  2760. procedure TMainForm.ECutClick(Sender: TObject);
  2761. begin
  2762. FActiveMemo.CutToClipboard;
  2763. end;
  2764. procedure TMainForm.ECopyClick(Sender: TObject);
  2765. begin
  2766. FActiveMemo.CopyToClipboard;
  2767. end;
  2768. function TMainForm.MultipleSelectionPasteFromClipboard(const AMemo: TIDEScintEdit): Boolean;
  2769. begin
  2770. { Scintilla doesn't yet properly support multiple selection paste. Handle it
  2771. here, just like VS and VSCode do: if there's multiple selections and the paste
  2772. text has the same amount of lines then paste 1 line per selection. Do this even
  2773. if the paste text is marked as rectangular. Otherwise (so no match between
  2774. the selection count and the line count) paste all lines into each selection.
  2775. For the latter we don't need handling here: this is Scintilla's default
  2776. behaviour if SC_MULTIPASTE_EACH is on. }
  2777. Result := False;
  2778. var SelectionCount := AMemo.SelectionCount;
  2779. if SelectionCount > 1 then begin
  2780. var PasteLines := Clipboard.AsText.Replace(#13#10, #13).Split([#13, #10]);
  2781. if SelectionCount = Length(PasteLines) then begin
  2782. AMemo.BeginUndoAction;
  2783. try
  2784. for var I := 0 to SelectionCount-1 do begin
  2785. var StartPos := AMemo.SelectionStartPosition[I]; { Can't use AMemo.GetSelections because each paste can update other selections }
  2786. var EndPos := AMemo.SelectionEndPosition[I];
  2787. AMemo.ReplaceTextRange(StartPos, EndPos, PasteLines[I], srmMinimal);
  2788. { Update the selection to an empty selection at the end of the inserted
  2789. text, just like ReplaceMainSelText }
  2790. var Pos := AMemo.Target.EndPos; { ReplaceTextRange updates the target }
  2791. AMemo.SelectionCaretPosition[I] := Pos;
  2792. AMemo.SelectionAnchorPosition[I] := Pos;
  2793. end;
  2794. { Be like SCI_PASTE }
  2795. AMemo.ChooseCaretX;
  2796. AMemo.ScrollCaretIntoView;
  2797. finally
  2798. AMemo.EndUndoAction;
  2799. end;
  2800. Result := True;
  2801. end;
  2802. end;
  2803. end;
  2804. procedure TMainForm.EPasteClick(Sender: TObject);
  2805. begin
  2806. if not MultipleSelectionPasteFromClipboard(FActiveMemo) then
  2807. FActiveMemo.PasteFromClipboard;
  2808. end;
  2809. procedure TMainForm.EDeleteClick(Sender: TObject);
  2810. begin
  2811. FActiveMemo.ClearSelection;
  2812. end;
  2813. procedure TMainForm.ESelectAllClick(Sender: TObject);
  2814. begin
  2815. FActiveMemo.SelectAll;
  2816. end;
  2817. procedure TMainForm.ESelectAllOccurrencesClick(Sender: TObject);
  2818. begin
  2819. { Might be called even if ESelectAllOccurrences.Enabled would be False in EMenuClick }
  2820. if FActiveMemo.SelEmpty then begin
  2821. { If the selection is empty then SelectAllOccurrences will actually just select
  2822. the word at caret which is not what we want, so preselect this word ourselves }
  2823. var Range := FActiveMemo.WordAtCaretRange;
  2824. if Range.StartPos <> Range.EndPos then
  2825. FActiveMemo.SetSingleSelection(Range.EndPos, Range.StartPos);
  2826. end;
  2827. FActiveMemo.SelectAllOccurrences([sfoMatchCase]);
  2828. end;
  2829. procedure TMainForm.ESelectNextOccurrenceClick(Sender: TObject);
  2830. begin
  2831. { Might be called even if ESelectNextOccurrence.Enabled would be False in EMenuClick }
  2832. FActiveMemo.SelectNextOccurrence([sfoMatchCase]);
  2833. end;
  2834. procedure TMainForm.EToggleLinesCommentClick(Sender: TObject);
  2835. begin
  2836. var AMemo := FActiveMemo;
  2837. { Based on SciTE 5.50's SciTEBase::StartBlockComment - only toggles comments
  2838. for the main selection }
  2839. var Selection := AMemo.Selection;
  2840. var CaretPosition := AMemo.CaretPosition;
  2841. // checking if caret is located in _beginning_ of selected block
  2842. var MoveCaret := CaretPosition < Selection.EndPos;
  2843. var SelStartLine := AMemo.GetLineFromPosition(Selection.StartPos);
  2844. var SelEndLine := AMemo.GetLineFromPosition(Selection.EndPos);
  2845. var Lines := SelEndLine - SelStartLine;
  2846. var FirstSelLineStart := AMemo.GetPositionFromLine(SelStartLine);
  2847. // "caret return" is part of the last selected line
  2848. if (Lines > 0) and (Selection.EndPos = AMemo.GetPositionFromLine(SelEndLine)) then
  2849. Dec(SelEndLine);
  2850. { We rely on the styler to identify [Code] section lines, but we
  2851. may be searching into areas that haven't been styled yet }
  2852. AMemo.StyleNeeded(Selection.EndPos);
  2853. AMemo.BeginUndoAction;
  2854. try
  2855. var LastLongCommentLength := 0;
  2856. for var I := SelStartLine to SelEndLine do begin
  2857. var LineIndent := AMemo.GetLineIndentPosition(I);
  2858. var LineEnd := AMemo.GetLineEndPosition(I);
  2859. var LineBuf := AMemo.GetTextRange(LineIndent, LineEnd);
  2860. // empty lines are not commented
  2861. if LineBuf = '' then
  2862. Continue;
  2863. var Comment: String;
  2864. if LineBuf.StartsWith('//') or
  2865. (FMemosStyler.GetSectionFromLineState(AMemo.Lines.State[I]) = scCode) then
  2866. Comment := '//'
  2867. else
  2868. Comment := ';';
  2869. var LongComment := Comment + ' ';
  2870. LastLongCommentLength := Length(LongComment);
  2871. if LineBuf.StartsWith(Comment) then begin
  2872. var CommentLength := Length(Comment);
  2873. if LineBuf.StartsWith(LongComment) then begin
  2874. // Removing comment with space after it.
  2875. CommentLength := Length(LongComment);
  2876. end;
  2877. AMemo.Selection := TScintRange.Create(LineIndent, LineIndent + CommentLength);
  2878. AMemo.SelText := '';
  2879. if I = SelStartLine then // is this the first selected line?
  2880. Dec(Selection.StartPos, CommentLength);
  2881. Dec(Selection.EndPos, CommentLength); // every iteration
  2882. Continue;
  2883. end;
  2884. if I = SelStartLine then // is this the first selected line?
  2885. Inc(Selection.StartPos, Length(LongComment));
  2886. Inc(Selection.EndPos, Length(LongComment)); // every iteration
  2887. AMemo.Call(SCI_INSERTTEXT, LineIndent, AMemo.ConvertStringToRawString(LongComment));
  2888. end;
  2889. // after uncommenting selection may promote itself to the lines
  2890. // before the first initially selected line;
  2891. // another problem - if only comment symbol was selected;
  2892. if Selection.StartPos < FirstSelLineStart then begin
  2893. if Selection.StartPos >= Selection.EndPos - (LastLongCommentLength - 1) then
  2894. Selection.EndPos := FirstSelLineStart;
  2895. Selection.StartPos := FirstSelLineStart;
  2896. end;
  2897. if MoveCaret then begin
  2898. // moving caret to the beginning of selected block
  2899. AMemo.CaretPosition := Selection.EndPos;
  2900. AMemo.CaretPositionWithSelectFromAnchor := Selection.StartPos;
  2901. end else
  2902. AMemo.Selection := Selection;
  2903. finally
  2904. AMemo.EndUndoAction;
  2905. end;
  2906. end;
  2907. procedure TMainForm.EBraceMatchClick(Sender: TObject);
  2908. begin
  2909. var AMemo := FActiveMemo;
  2910. var Selections: TScintCaretAndAnchorList := nil;
  2911. var VirtualSpaces: TScintCaretAndAnchorList := nil;
  2912. try
  2913. Selections := TScintCaretAndAnchorList.Create;
  2914. VirtualSpaces := TScintCaretAndAnchorList.Create;
  2915. AMemo.GetSelections(Selections, VirtualSpaces);
  2916. for var I := 0 to Selections.Count-1 do begin
  2917. if VirtualSpaces[I].CaretPos = 0 then begin
  2918. var Pos := Selections[I].CaretPos;
  2919. var MatchPos := AMemo.GetPositionOfMatchingBrace(Pos);
  2920. if MatchPos = -1 then begin
  2921. Pos := AMemo.GetPositionBefore(Pos);
  2922. MatchPos := AMemo.GetPositionOfMatchingBrace(Pos)
  2923. end;
  2924. if MatchPos <> -1 then begin
  2925. AMemo.SelectionCaretPosition[I] := MatchPos;
  2926. AMemo.SelectionAnchorPosition[I] := MatchPos;
  2927. if I = 0 then
  2928. AMemo.ScrollCaretIntoView;
  2929. end;
  2930. end;
  2931. end;
  2932. finally
  2933. VirtualSpaces.Free;
  2934. Selections.Free;
  2935. end;
  2936. end;
  2937. procedure TMainForm.ESelectAllFindMatchesClick(Sender: TObject);
  2938. begin
  2939. { Might be called even if ESelectAllFindMatches.Enabled would be False in EMenuClick }
  2940. if FLastFindText <> '' then begin
  2941. var StartPos := 0;
  2942. var EndPos := FActiveMemo.RawTextLength;
  2943. var FoundRange: TScintRange;
  2944. var ClosestSelection := -1;
  2945. var ClosestSelectionDistance := 0; { Silence compiler }
  2946. var CaretPos := FActiveMemo.CaretPosition;
  2947. while (StartPos < EndPos) and
  2948. FActiveMemo.FindText(StartPos, EndPos, FLastFindText,
  2949. FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), FoundRange) do begin
  2950. if StartPos = 0 then
  2951. FActiveMemo.SetSingleSelection(FoundRange.EndPos, FoundRange.StartPos)
  2952. else
  2953. FActiveMemo.AddSelection(FoundRange.EndPos, FoundRange.StartPos);
  2954. var Distance := Abs(CaretPos-FoundRange.EndPos);
  2955. if (ClosestSelection = -1) or (Distance < ClosestSelectionDistance) then begin
  2956. ClosestSelection := FActiveMemo.SelectionCount-1;
  2957. ClosestSelectionDistance := Distance;
  2958. end;
  2959. StartPos := FoundRange.EndPos;
  2960. end;
  2961. if ClosestSelection <> -1 then begin
  2962. FActiveMemo.MainSelection := ClosestSelection;
  2963. FActiveMemo.ScrollCaretIntoView;
  2964. end;
  2965. end;
  2966. end;
  2967. procedure TMainForm.VMenuClick(Sender: TObject);
  2968. begin
  2969. VZoomIn.Enabled := (FActiveMemo.Zoom < 20);
  2970. VZoomOut.Enabled := (FActiveMemo.Zoom > -10);
  2971. VZoomReset.Enabled := (FActiveMemo.Zoom <> 0);
  2972. VToolbar.Checked := ToolbarPanel.Visible;
  2973. VStatusBar.Checked := StatusBar.Visible;
  2974. VNextTab.Enabled := MemosTabSet.Visible and (MemosTabSet.Tabs.Count > 1);
  2975. VPreviousTab.Enabled := VNextTab.Enabled;
  2976. VCloseCurrentTab.Enabled := MemosTabSet.Visible and (FActiveMemo <> FMainMemo) and (FActiveMemo <> FPreprocessorOutputMemo);
  2977. VReopenTab.Visible := MemosTabSet.Visible and (FHiddenFiles.Count > 0);
  2978. if VReopenTab.Visible then
  2979. UpdateReopenTabMenu(VReopenTab);
  2980. VReopenTabs.Visible := VReopenTab.Visible;
  2981. VHide.Checked := not StatusPanel.Visible;
  2982. VCompilerOutput.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiCompilerOutput);
  2983. VDebugOutput.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiDebugOutput);
  2984. VDebugCallStack.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiDebugCallStack);
  2985. VFindResults.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiFindResults);
  2986. VWordWrap.Checked := FOptions.WordWrap;
  2987. ApplyMenuBitmaps(Sender as TMenuItem);
  2988. end;
  2989. procedure TMainForm.VNextTabClick(Sender: TObject);
  2990. var
  2991. NewTabIndex: Integer;
  2992. begin
  2993. NewTabIndex := MemosTabSet.TabIndex+1;
  2994. if NewTabIndex >= MemosTabSet.Tabs.Count then
  2995. NewTabIndex := 0;
  2996. MemosTabSet.TabIndex := NewTabIndex;
  2997. end;
  2998. procedure TMainForm.VPreviousTabClick(Sender: TObject);
  2999. var
  3000. NewTabIndex: Integer;
  3001. begin
  3002. NewTabIndex := MemosTabSet.TabIndex-1;
  3003. if NewTabIndex < 0 then
  3004. NewTabIndex := MemosTabSet.Tabs.Count-1;
  3005. MemosTabSet.TabIndex := NewTabIndex;
  3006. end;
  3007. procedure TMainForm.CloseTab(const TabIndex: Integer);
  3008. begin
  3009. var Memo := TabIndexToMemo(TabIndex, MemosTabSet.Tabs.Count-1);
  3010. var MemoWasActiveMemo := Memo = FActiveMemo;
  3011. MemosTabSet.Tabs.Delete(TabIndex); { This will not change MemosTabset.TabIndex }
  3012. MemosTabSet.Hints.Delete(TabIndex);
  3013. MemosTabSet.CloseButtons.Delete(TabIndex);
  3014. FHiddenFiles.Add((Memo as TIDEScintFileEdit).Filename);
  3015. InvalidateStatusPanel(spHiddenFilesCount);
  3016. BuildAndSaveKnownIncludedAndHiddenFiles;
  3017. { Because MemosTabSet.Tabs and FHiddenFiles have both been updated now,
  3018. hereafter setting TabIndex will not select the memo we're closing
  3019. even if it's not hidden yet because TabIndexToMemo as called by
  3020. MemosTabSetClick will skip it }
  3021. if MemoWasActiveMemo then begin
  3022. { Select next tab, except when we're already at the end. Avoiding flicker by
  3023. doing this before hiding old active memo. We do this in a dirty way by
  3024. clicking two tabs while making sure TabSetClick doesn't see the first
  3025. 'fake' one. }
  3026. FIgnoreTabSetClick := True;
  3027. try
  3028. VNextTabClick(Self);
  3029. finally
  3030. FIgnoreTabSetClick := False;
  3031. end;
  3032. VPreviousTabClick(Self);
  3033. Memo.CancelAutoCompleteAndCallTip;
  3034. Memo.Visible := False;
  3035. end else if TabIndex < MemosTabset.TabIndex then
  3036. MemosTabSet.TabIndex := MemosTabset.TabIndex-1; { Reselect old selected tab }
  3037. end;
  3038. procedure TMainForm.VCloseCurrentTabClick(Sender: TObject);
  3039. begin
  3040. CloseTab(MemosTabSet.TabIndex);
  3041. end;
  3042. procedure TMainForm.ReopenTabOrTabs(const HiddenFileIndex: Integer;
  3043. const Activate: Boolean);
  3044. begin
  3045. var ReopenFilename: String;
  3046. if HiddenFileIndex >= 0 then begin
  3047. ReopenFilename := FHiddenFiles[HiddenFileIndex];
  3048. FHiddenFiles.Delete(HiddenFileIndex);
  3049. end else begin
  3050. ReopenFilename := FHiddenFiles[0];
  3051. FHiddenFiles.Clear;
  3052. end;
  3053. InvalidateStatusPanel(spHiddenFilesCount);
  3054. UpdatePreprocMemos;
  3055. BuildAndSaveKnownIncludedAndHiddenFiles;
  3056. { Activate the memo if requested }
  3057. if Activate then begin
  3058. for var Memo in FFileMemos do begin
  3059. if Memo.Used and (PathCompare(Memo.Filename, ReopenFilename) = 0) then begin
  3060. MemosTabSet.TabIndex := MemoToTabIndex(memo);
  3061. Break;
  3062. end;
  3063. end
  3064. end;
  3065. end;
  3066. procedure TMainForm.ReopenTabClick(Sender: TObject);
  3067. begin
  3068. ReopenTabOrTabs((Sender as TMenuItem).Tag, True);
  3069. end;
  3070. procedure TMainForm.VReopenTabsClick(Sender: TObject);
  3071. begin
  3072. ReopenTabOrTabs(-1, True);
  3073. end;
  3074. procedure TMainForm.VZoomInClick(Sender: TObject);
  3075. begin
  3076. FActiveMemo.ZoomIn; { MemoZoom will zoom the other memos }
  3077. end;
  3078. procedure TMainForm.VZoomOutClick(Sender: TObject);
  3079. begin
  3080. FActiveMemo.ZoomOut;
  3081. end;
  3082. procedure TMainForm.VZoomResetClick(Sender: TObject);
  3083. begin
  3084. FActiveMemo.Zoom := 0;
  3085. end;
  3086. procedure TMainForm.VToolbarClick(Sender: TObject);
  3087. begin
  3088. ToolbarPanel.Visible := not ToolbarPanel.Visible;
  3089. end;
  3090. procedure TMainForm.VStatusBarClick(Sender: TObject);
  3091. begin
  3092. StatusBar.Visible := not StatusBar.Visible;
  3093. end;
  3094. procedure TMainForm.VWordWrapClick(Sender: TObject);
  3095. begin
  3096. FOptions.WordWrap := not FOptions.WordWrap;
  3097. SyncEditorOptions;
  3098. var Ini := TConfigIniFile.Create;
  3099. try
  3100. Ini.WriteBool('Options', 'WordWrap', FOptions.WordWrap);
  3101. finally
  3102. Ini.Free;
  3103. end;
  3104. end;
  3105. procedure TMainForm.SetStatusPanelVisible(const AVisible: Boolean);
  3106. var
  3107. CaretWasInView: Boolean;
  3108. begin
  3109. if StatusPanel.Visible <> AVisible then begin
  3110. CaretWasInView := FActiveMemo.IsPositionInViewVertically(FActiveMemo.CaretPosition);
  3111. if AVisible then begin
  3112. { Ensure the status panel height isn't out of range before showing }
  3113. UpdateStatusPanelHeight(StatusPanel.Height);
  3114. SplitPanel.Top := ClientHeight;
  3115. StatusPanel.Top := ClientHeight;
  3116. end
  3117. else begin
  3118. if StatusPanel.ContainsControl(ActiveControl) then
  3119. ActiveControl := FActiveMemo;
  3120. end;
  3121. SplitPanel.Visible := AVisible;
  3122. StatusPanel.Visible := AVisible;
  3123. if AVisible and CaretWasInView then begin
  3124. { If the caret was in view, make sure it still is }
  3125. FActiveMemo.ScrollCaretIntoView;
  3126. end;
  3127. end;
  3128. end;
  3129. procedure TMainForm.VHideClick(Sender: TObject);
  3130. begin
  3131. SetStatusPanelVisible(False);
  3132. end;
  3133. procedure TMainForm.VCompilerOutputClick(Sender: TObject);
  3134. begin
  3135. OutputTabSet.TabIndex := tiCompilerOutput;
  3136. SetStatusPanelVisible(True);
  3137. end;
  3138. procedure TMainForm.VDebugOutputClick(Sender: TObject);
  3139. begin
  3140. OutputTabSet.TabIndex := tiDebugOutput;
  3141. SetStatusPanelVisible(True);
  3142. end;
  3143. procedure TMainForm.VDebugCallStackClick(Sender: TObject);
  3144. begin
  3145. OutputTabSet.TabIndex := tiDebugCallStack;
  3146. SetStatusPanelVisible(True);
  3147. end;
  3148. procedure TMainForm.VFindResultsClick(Sender: TObject);
  3149. begin
  3150. OutputTabSet.TabIndex := tiFindResults;
  3151. SetStatusPanelVisible(True);
  3152. end;
  3153. procedure TMainForm.BMenuClick(Sender: TObject);
  3154. begin
  3155. BLowPriority.Checked := FOptions.LowPriorityDuringCompile;
  3156. BOpenOutputFolder.Enabled := (FCompiledExe <> '');
  3157. ApplyMenuBitmaps(Sender as TMenuItem);
  3158. end;
  3159. procedure TMainForm.BCompileClick(Sender: TObject);
  3160. begin
  3161. CompileFile('', False);
  3162. end;
  3163. procedure TMainForm.BStopCompileClick(Sender: TObject);
  3164. begin
  3165. SetAppTaskbarProgressState(tpsPaused);
  3166. try
  3167. if MsgBox('Are you sure you want to abort the compile?', SCompilerFormCaption,
  3168. mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then
  3169. FCompileWantAbort := True;
  3170. finally
  3171. SetAppTaskbarProgressState(tpsNormal);
  3172. end;
  3173. end;
  3174. procedure TMainForm.BLowPriorityClick(Sender: TObject);
  3175. begin
  3176. FOptions.LowPriorityDuringCompile := not FOptions.LowPriorityDuringCompile;
  3177. { If a compile is already in progress, change the priority now }
  3178. if FCompiling then
  3179. SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass);
  3180. end;
  3181. procedure TMainForm.BOpenOutputFolderClick(Sender: TObject);
  3182. begin
  3183. LaunchFileOrURL(AddBackslash(GetSystemWinDir) + 'explorer.exe',
  3184. Format('/select,"%s"', [FCompiledExe]));
  3185. end;
  3186. procedure TMainForm.HShortcutsDocClick(Sender: TObject);
  3187. begin
  3188. if Assigned(HtmlHelp) then
  3189. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_compformshortcuts.htm')));
  3190. end;
  3191. procedure TMainForm.HRegExDocClick(Sender: TObject);
  3192. begin
  3193. if Assigned(HtmlHelp) then
  3194. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_compformregex.htm')));
  3195. end;
  3196. procedure TMainForm.HDocClick(Sender: TObject);
  3197. begin
  3198. if Assigned(HtmlHelp) then
  3199. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, 0);
  3200. end;
  3201. procedure TMainForm.HExamplesClick(Sender: TObject);
  3202. begin
  3203. LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'Examples');
  3204. end;
  3205. procedure TMainForm.HFaqClick(Sender: TObject);
  3206. begin
  3207. LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'isfaq.url');
  3208. end;
  3209. procedure TMainForm.HWhatsNewClick(Sender: TObject);
  3210. begin
  3211. LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'whatsnew.htm');
  3212. end;
  3213. procedure TMainForm.HWebsiteClick(Sender: TObject);
  3214. begin
  3215. LaunchFileOrURL('https://jrsoftware.org/isinfo.php');
  3216. end;
  3217. procedure TMainForm.HMailingListClick(Sender: TObject);
  3218. begin
  3219. OpenMailingListSite;
  3220. end;
  3221. procedure TMainForm.HISPPDocClick(Sender: TObject);
  3222. begin
  3223. if Assigned(HtmlHelp) then
  3224. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_isppoverview.htm')));
  3225. end;
  3226. procedure TMainForm.HDonateClick(Sender: TObject);
  3227. begin
  3228. OpenDonateSite;
  3229. end;
  3230. procedure TMainForm.HAboutClick(Sender: TObject);
  3231. var
  3232. S: String;
  3233. begin
  3234. { Removing the About box or modifying any existing text inside it is a
  3235. violation of the Inno Setup license agreement; see LICENSE.TXT.
  3236. However, adding additional lines to the About box is permitted, as long as
  3237. they are placed below the original copyright notice. }
  3238. S := FCompilerVersion.Title + ' Compiler version ' +
  3239. String(FCompilerVersion.Version) + SNewLine;
  3240. if FCompilerVersion.Title <> 'Inno Setup' then
  3241. S := S + (SNewLine + 'Based on Inno Setup' + SNewLine);
  3242. S := S + ('Copyright (C) 1997-2025 Jordan Russell' + SNewLine +
  3243. 'Portions Copyright (C) 2000-2025 Martijn Laan' + SNewLine +
  3244. 'All rights reserved.' + SNewLine2 +
  3245. 'Inno Setup home page:' + SNewLine +
  3246. 'https://www.innosetup.com/' + SNewLine2 +
  3247. 'RemObjects Pascal Script home page:' + SNewLine +
  3248. 'https://www.remobjects.com/ps' + SNewLine2 +
  3249. 'Refer to LICENSE.TXT for conditions of distribution and use.');
  3250. MsgBox(S, 'About ' + FCompilerVersion.Title, mbInformation, MB_OK);
  3251. end;
  3252. procedure TMainForm.WMStartCommandLineCompile(var Message: TMessage);
  3253. var
  3254. Code: Integer;
  3255. begin
  3256. UpdateStatusPanelHeight(ClientHeight);
  3257. Code := 0;
  3258. try
  3259. try
  3260. CompileFile(CommandLineFilename, True);
  3261. except
  3262. Code := 2;
  3263. Application.HandleException(Self);
  3264. end;
  3265. finally
  3266. Halt(Code);
  3267. end;
  3268. end;
  3269. procedure TMainForm.WMStartCommandLineWizard(var Message: TMessage);
  3270. var
  3271. Code: Integer;
  3272. begin
  3273. Code := 0;
  3274. try
  3275. try
  3276. NewMainFileUsingWizard;
  3277. except
  3278. Code := 2;
  3279. Application.HandleException(Self);
  3280. end;
  3281. finally
  3282. Halt(Code);
  3283. end;
  3284. end;
  3285. procedure TMainForm.WMStartNormally(var Message: TMessage);
  3286. procedure ShowStartupForm;
  3287. var
  3288. StartupForm: TStartupForm;
  3289. Ini: TConfigIniFile;
  3290. begin
  3291. ReadMRUMainFilesList;
  3292. StartupForm := TStartupForm.Create(Application);
  3293. try
  3294. StartupForm.MRUFilesList := FMRUMainFilesList;
  3295. StartupForm.StartupCheck.Checked := not FOptions.ShowStartupForm;
  3296. if StartupForm.ShowModal = mrOK then begin
  3297. if FOptions.ShowStartupForm <> not StartupForm.StartupCheck.Checked then begin
  3298. FOptions.ShowStartupForm := not StartupForm.StartupCheck.Checked;
  3299. Ini := TConfigIniFile.Create;
  3300. try
  3301. Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
  3302. finally
  3303. Ini.Free;
  3304. end;
  3305. end;
  3306. case StartupForm.Result of
  3307. srEmpty:
  3308. FNewMainFileClick(Self);
  3309. srWizard:
  3310. FNewMainFileUserWizardClick(Self);
  3311. srOpenFile:
  3312. if ConfirmCloseFile(True) then
  3313. OpenMRUMainFile(StartupForm.ResultMainFileName);
  3314. srOpenDialog:
  3315. ShowOpenMainFileDialog(False);
  3316. srOpenDialogExamples:
  3317. ShowOpenMainFileDialog(True);
  3318. end;
  3319. end;
  3320. finally
  3321. StartupForm.Free;
  3322. end;
  3323. end;
  3324. begin
  3325. if CommandLineFilename = '' then begin
  3326. if FOptions.ShowStartupForm then
  3327. ShowStartupForm;
  3328. end else
  3329. OpenFile(FMainMemo, CommandLineFilename, False);
  3330. end;
  3331. procedure TMainForm.WMSysColorChange(var Message: TMessage);
  3332. begin
  3333. inherited;
  3334. for var Memo in FMemos do
  3335. Memo.SysColorChange(Message);
  3336. end;
  3337. procedure TMainForm.UpdateReopenTabMenu(const Menu: TMenuItem);
  3338. begin
  3339. Menu.Clear;
  3340. for var I := 0 to FHiddenFiles.Count-1 do begin
  3341. var MenuItem := TMenuItem.Create(Menu);
  3342. MenuItem.Caption := '&' + IntToStr((I+1) mod 10) + ' ' + DoubleAmp(PathExtractName(FHiddenFiles[I]));
  3343. MenuItem.Tag := I;
  3344. MenuItem.OnClick := ReopenTabClick;
  3345. Menu.Add(MenuItem);
  3346. end;
  3347. end;
  3348. procedure TMainForm.MemosTabSetPopupMenuClick(Sender: TObject);
  3349. begin
  3350. { Main and preprocessor memos can't be hidden }
  3351. VCloseCurrentTab2.Enabled := (FActiveMemo <> FMainMemo) and (FActiveMemo <> FPreprocessorOutputMemo);
  3352. VReopenTab2.Visible := FHiddenFiles.Count > 0;
  3353. if VReopenTab2.Visible then
  3354. UpdateReopenTabMenu(VReopenTab2);
  3355. VReopenTabs2.Visible := VReopenTab2.Visible;
  3356. ApplyMenuBitmaps(Sender as TMenuItem)
  3357. end;
  3358. procedure TMainForm.MemosTabSetClick(Sender: TObject);
  3359. begin
  3360. if FIgnoreTabSetClick then
  3361. Exit;
  3362. var NewActiveMemo := TabIndexToMemo(MemosTabSet.TabIndex, MemosTabSet.Tabs.Count-1);
  3363. if NewActiveMemo <> FActiveMemo then begin
  3364. { Avoiding flicker by showing new before hiding old }
  3365. NewActiveMemo.Visible := True;
  3366. var OldActiveMemo := FActiveMemo;
  3367. FActiveMemo := NewActiveMemo;
  3368. ActiveControl := NewActiveMemo;
  3369. OldActiveMemo.CancelAutoCompleteAndCallTip;
  3370. OldActiveMemo.Visible := False;
  3371. UpdateSaveMenuItemAndButton;
  3372. UpdateRunMenu;
  3373. UpdateCaretPosPanelAndBackNavStack;
  3374. UpdateEditModePanel;
  3375. UpdateModifiedPanel;
  3376. end;
  3377. end;
  3378. procedure TMainForm.MemosTabSetOnCloseButtonClick(Sender: TObject; Index: Integer);
  3379. begin
  3380. CloseTab(Index);
  3381. end;
  3382. procedure TMainForm.InitializeFindText(Dlg: TFindDialog);
  3383. var
  3384. S: String;
  3385. begin
  3386. S := FActiveMemo.MainSelText;
  3387. if (S <> '') and (Pos(#13, S) = 0) and (Pos(#10, S) = 0) then
  3388. Dlg.FindText := S
  3389. else
  3390. Dlg.FindText := FLastFindText;
  3391. end;
  3392. const
  3393. OldFindReplaceWndProcProp = 'OldFindReplaceWndProc';
  3394. function FindReplaceWndProc(Wnd: HWND; Msg: Cardinal; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
  3395. function CallDefWndProc: LRESULT;
  3396. begin
  3397. Result := CallWindowProc(Pointer(GetProp(Wnd, OldFindReplaceWndProcProp)), Wnd,
  3398. Msg, WParam, LParam);
  3399. end;
  3400. begin
  3401. case Msg of
  3402. WM_MENUCHAR:
  3403. if LoWord(wParam) = VK_RETURN then begin
  3404. var hwndCtl := GetDlgItem(Wnd, idOk);
  3405. if (hWndCtl <> 0) and IsWindowEnabled(hWndCtl) then
  3406. PostMessage(Wnd, WM_COMMAND, MakeWParam(idOk, BN_CLICKED), Windows.LPARAM(hWndCtl));
  3407. end;
  3408. WM_NCDESTROY:
  3409. begin
  3410. Result := CallDefWndProc;
  3411. RemoveProp(Wnd, OldFindReplaceWndProcProp);
  3412. Exit;
  3413. end;
  3414. end;
  3415. Result := CallDefWndProc;
  3416. end;
  3417. procedure ExecuteFindDialogAllowingAltEnter(const FindDialog: TFindDialog);
  3418. begin
  3419. var DoHook := FindDialog.Handle = 0;
  3420. FindDialog.Execute;
  3421. if DoHook then begin
  3422. SetProp(FindDialog.Handle, OldFindReplaceWndProcProp, GetWindowLong(FindDialog.Handle, GWL_WNDPROC));
  3423. SetWindowLong(FindDialog.Handle, GWL_WNDPROC, IntPtr(@FindReplaceWndProc));
  3424. end;
  3425. end;
  3426. procedure TMainForm.EFindClick(Sender: TObject);
  3427. begin
  3428. ReplaceDialog.CloseDialog;
  3429. if FindDialog.Handle = 0 then
  3430. InitializeFindText(FindDialog);
  3431. if (Sender = EFind) or (Sender = EFindNext) then
  3432. FindDialog.Options := FindDialog.Options + [frDown]
  3433. else
  3434. FindDialog.Options := FindDialog.Options - [frDown];
  3435. ExecuteFindDialogAllowingAltEnter(FindDialog);
  3436. end;
  3437. procedure TMainForm.EFindInFilesClick(Sender: TObject);
  3438. begin
  3439. InitializeFindText(FindInFilesDialog);
  3440. FindInFilesDialog.Execute;
  3441. end;
  3442. procedure TMainForm.EFindNextOrPreviousClick(Sender: TObject);
  3443. begin
  3444. if FLastFindText = '' then
  3445. EFindClick(Sender)
  3446. else begin
  3447. if Sender = EFindNext then
  3448. FLastFindOptions := FLastFindOptions + [frDown]
  3449. else
  3450. FLastFindOptions := FLastFindOptions - [frDown];
  3451. FLastFindRegEx := FOptions.FindRegEx;
  3452. if not TestLastFindOptions then
  3453. Exit;
  3454. FindNext(False);
  3455. end;
  3456. end;
  3457. procedure TMainForm.FindNext(const ReverseDirection: Boolean);
  3458. var
  3459. StartPos, EndPos: Integer;
  3460. Range: TScintRange;
  3461. begin
  3462. var Down := frDown in FLastFindOptions;
  3463. if ReverseDirection then
  3464. Down := not Down;
  3465. if Down then begin
  3466. StartPos := FActiveMemo.Selection.EndPos;
  3467. EndPos := FActiveMemo.RawTextLength;
  3468. end
  3469. else begin
  3470. StartPos := FActiveMemo.Selection.StartPos;
  3471. EndPos := 0;
  3472. end;
  3473. if FActiveMemo.FindText(StartPos, EndPos, FLastFindText,
  3474. FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), Range) then
  3475. FActiveMemo.SelectAndEnsureVisible(Range)
  3476. else
  3477. MsgBoxFmt('Cannot find "%s"', [FLastFindText], SCompilerFormCaption,
  3478. mbInformation, MB_OK);
  3479. end;
  3480. function TMainForm.StoreAndTestLastFindOptions(Sender: TObject): Boolean;
  3481. begin
  3482. { TReplaceDialog is a subclass of TFindDialog must check for TReplaceDialog first }
  3483. if Sender is TReplaceDialog then begin
  3484. with Sender as TReplaceDialog do begin
  3485. FLastFindOptions := Options;
  3486. FLastFindText := FindText;
  3487. end;
  3488. end else begin
  3489. with Sender as TFindDialog do begin
  3490. FLastFindOptions := Options;
  3491. FLastFindText := FindText;
  3492. end;
  3493. end;
  3494. FLastFindRegEx := FOptions.FindRegEx;
  3495. Result := TestLastFindOptions;
  3496. end;
  3497. function TMainForm.TestLastFindOptions;
  3498. begin
  3499. if FLastFindRegEx then begin
  3500. Result := FActiveMemo.TestRegularExpression(FLastFindText);
  3501. if not Result then
  3502. MsgBoxFmt('Invalid regular expression "%s"', [FLastFindText], SCompilerFormCaption,
  3503. mbError, MB_OK);
  3504. end else
  3505. Result := True;
  3506. end;
  3507. procedure TMainForm.FindDialogFind(Sender: TObject);
  3508. begin
  3509. { This event handler is shared between FindDialog & ReplaceDialog }
  3510. if not StoreAndTestLastFindOptions(Sender) then
  3511. Exit;
  3512. if GetKeyState(VK_MENU) < 0 then begin
  3513. { Alt+Enter was used to close the dialog }
  3514. (Sender as TFindDialog).CloseDialog;
  3515. ESelectAllFindMatchesClick(Self); { Uses the copy made above }
  3516. end else
  3517. FindNext(GetKeyState(VK_SHIFT) < 0);
  3518. end;
  3519. procedure TMainForm.FindInFilesDialogFind(Sender: TObject);
  3520. begin
  3521. if not StoreAndTestLastFindOptions(Sender) then
  3522. Exit;
  3523. FindResultsList.Clear;
  3524. SendMessage(FindResultsList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  3525. FFindResults.Clear;
  3526. var Hits := 0;
  3527. var Files := 0;
  3528. for var Memo in FFileMemos do begin
  3529. if Memo.Used then begin
  3530. var StartPos := 0;
  3531. var EndPos := Memo.RawTextLength;
  3532. var FileHits := 0;
  3533. var Range: TScintRange;
  3534. while (StartPos < EndPos) and
  3535. Memo.FindText(StartPos, EndPos, FLastFindText,
  3536. FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), Range) do begin
  3537. var Line := Memo.GetLineFromPosition(Range.StartPos);
  3538. var Prefix := Format(' Line %d: ', [Line+1]);
  3539. var FindResult := TFindResult.Create;
  3540. FindResult.Filename := Memo.Filename;
  3541. FindResult.Line := Line;
  3542. FindResult.LineStartPos := Memo.GetPositionFromLine(Line);
  3543. FindResult.Range := Range;
  3544. FindResult.PrefixStringLength := Length(Prefix);
  3545. FFindResults.Add(FindResult);
  3546. FindResultsList.Items.AddObject(Prefix + Memo.Lines[Line], FindResult);
  3547. Inc(FileHits);
  3548. StartPos := Range.EndPos;
  3549. end;
  3550. Inc(Files);
  3551. if FileHits > 0 then begin
  3552. Inc(Hits, FileHits);
  3553. FindResultsList.Items.Insert(FindResultsList.Count-FileHits, Format('%s (%d hits):', [Memo.Filename, FileHits]));
  3554. end;
  3555. end;
  3556. end;
  3557. FindResultsList.Items.Insert(0, Format('Find "%s" (%d hits in %d files)', [FindInFilesDialog.FindText, Hits, Files]));
  3558. FindInFilesDialog.CloseDialog;
  3559. OutputTabSet.TabIndex := tiFindResults;
  3560. SetStatusPanelVisible(True);
  3561. end;
  3562. function TMainForm.FindSetupDirectiveValue(const DirectiveName,
  3563. DefaultValue: String): String;
  3564. begin
  3565. Result := DefaultValue;
  3566. var Memo := FMainMemo; { This function only searches the main file }
  3567. var StartPos := 0;
  3568. var EndPos := Memo.RawTextLength;
  3569. var Range: TScintRange;
  3570. { We rely on the styler to identify [Setup] section lines, but we
  3571. may be searching into areas that haven't been styled yet }
  3572. Memo.StyleNeeded(EndPos);
  3573. while (StartPos < EndPos) and
  3574. Memo.FindText(StartPos, EndPos, DirectiveName, [sfoWholeWord], Range) do begin
  3575. var Line := Memo.GetLineFromPosition(Range.StartPos);
  3576. if FMemosStyler.GetSectionFromLineState(Memo.Lines.State[Line]) = scSetup then begin
  3577. var LineValue := Memo.Lines[Line].Trim; { LineValue can't be empty }
  3578. if LineValue[1] <> ';' then begin
  3579. var LineParts := LineValue.Split(['=']);
  3580. if (Length(LineParts) = 2) and SameText(LineParts[0].Trim, DirectiveName) then begin
  3581. Result := LineParts[1].Trim;
  3582. { If Result is surrounded in quotes, remove them, just like TSetupCompiler.SeparateDirective }
  3583. if (Length(Result) >= 2) and
  3584. (Result[1] = '"') and (Result[Length(Result)] = '"') then
  3585. Result := Copy(Result, 2, Length(Result)-2);
  3586. Exit; { Compiler doesn't allow a directive to be specified twice so we can exit now }
  3587. end;
  3588. end;
  3589. end;
  3590. StartPos := Range.EndPos;
  3591. end;
  3592. end;
  3593. function TMainForm.FindSetupDirectiveValue(const DirectiveName: String;
  3594. DefaultValue: Boolean): Boolean;
  3595. begin
  3596. var Value := FindSetupDirectiveValue(DirectiveName, IfThen(DefaultValue, '1', '0'));
  3597. if not TryStrToBoolean(Value, Result) then
  3598. Result := DefaultValue;
  3599. end;
  3600. procedure TMainForm.EReplaceClick(Sender: TObject);
  3601. begin
  3602. FindDialog.CloseDialog;
  3603. if ReplaceDialog.Handle = 0 then begin
  3604. InitializeFindText(ReplaceDialog);
  3605. ReplaceDialog.ReplaceText := FLastReplaceText;
  3606. end;
  3607. ExecuteFindDialogAllowingAltEnter(ReplaceDialog);
  3608. end;
  3609. procedure TMainForm.ReplaceDialogReplace(Sender: TObject);
  3610. begin
  3611. if not StoreAndTestLastFindOptions(Sender) then
  3612. Exit;
  3613. FLastReplaceText := ReplaceDialog.ReplaceText;
  3614. var ReplaceMode := RegExToReplaceMode(FLastFindRegEx);
  3615. if frReplaceAll in FLastFindOptions then begin
  3616. var ReplaceCount := 0;
  3617. FActiveMemo.BeginUndoAction;
  3618. try
  3619. var Pos := 0;
  3620. var Range: TScintRange;
  3621. while FActiveMemo.FindText(Pos, FActiveMemo.RawTextLength, FLastFindText,
  3622. FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), Range) do begin
  3623. var NewRange := FActiveMemo.ReplaceTextRange(Range.StartPos, Range.EndPos, FLastReplaceText, ReplaceMode);
  3624. Pos := NewRange.EndPos;
  3625. Inc(ReplaceCount);
  3626. end;
  3627. finally
  3628. FActiveMemo.EndUndoAction;
  3629. end;
  3630. if ReplaceCount = 0 then
  3631. MsgBoxFmt('Cannot find "%s"', [FLastFindText], SCompilerFormCaption,
  3632. mbInformation, MB_OK)
  3633. else
  3634. MsgBoxFmt('%d occurrence(s) replaced.', [ReplaceCount], SCompilerFormCaption,
  3635. mbInformation, MB_OK);
  3636. end
  3637. else begin
  3638. if FActiveMemo.MainSelTextEquals(FLastFindText, FindOptionsToSearchOptions(frMatchCase in FLastFindOptions, FLastFindRegEx)) then begin
  3639. { Note: the MainSelTextEquals above performs a search so the replacement
  3640. below is safe even if the user just enabled regex }
  3641. FActiveMemo.ReplaceMainSelText(FLastReplaceText, ReplaceMode);
  3642. end;
  3643. FindNext(GetKeyState(VK_SHIFT) < 0);
  3644. end;
  3645. end;
  3646. procedure TMainForm.EFindRegExClick(Sender: TObject);
  3647. begin
  3648. { If EFindRegEx uses Alt+R as the shortcut just like VSCode then also handle it like VSCode:
  3649. when the memo does not have the focus open the Run menu (also Alt+R) instead }
  3650. if not FActiveMemo.Focused and (EFindRegEx.ShortCut = ShortCut(Ord('R'), [ssAlt])) then
  3651. SendMessage(Handle, WM_SYSCOMMAND, SC_KEYMENU, Ord('r'))
  3652. else begin
  3653. FOptions.FindRegEx := not FOptions.FindRegEx;
  3654. UpdateFindRegExUI;
  3655. var Ini := TConfigIniFile.Create;
  3656. try
  3657. Ini.WriteBool('Options', 'FindRegEx', FOptions.FindRegEx);
  3658. finally
  3659. Ini.Free;
  3660. end;
  3661. end;
  3662. end;
  3663. procedure TMainForm.EFoldOrUnfoldLineClick(Sender: TObject);
  3664. begin
  3665. FActiveMemo.FoldLine(FActiveMemo.CaretLine, Sender = EFoldLine);
  3666. end;
  3667. procedure TMainForm.UpdateStatusPanelHeight(H: Integer);
  3668. var
  3669. MinHeight, MaxHeight: Integer;
  3670. begin
  3671. MinHeight := (3 * DebugOutputList.ItemHeight + ToCurrentPPI(4)) + OutputTabSet.Height;
  3672. MaxHeight := BodyPanel.ClientHeight - ToCurrentPPI(48) - SplitPanel.Height;
  3673. if H > MaxHeight then H := MaxHeight;
  3674. if H < MinHeight then H := MinHeight;
  3675. StatusPanel.Height := H;
  3676. end;
  3677. procedure TMainForm.UpdateOccurrenceIndicators(const AMemo: TIDEScintEdit);
  3678. procedure FindTextAndAddRanges(const AMemo: TIDEScintEdit;
  3679. const TextToFind: TScintRawString; const Options: TScintFindOptions;
  3680. const Selections, IndicatorRanges: TScintRangeList);
  3681. begin
  3682. if TScintEdit.RawStringIsBlank(TextToFind) then
  3683. Exit;
  3684. var StartPos := 0;
  3685. var EndPos := AMemo.RawTextLength;
  3686. var FoundRange: TScintRange;
  3687. while (StartPos < EndPos) and
  3688. AMemo.FindRawText(StartPos, EndPos, TextToFind, Options, FoundRange) do begin
  3689. StartPos := FoundRange.EndPos;
  3690. { Don't add indicators on lines which have a line marker }
  3691. var Line := AMemo.GetLineFromPosition(FoundRange.StartPos);
  3692. var Markers := AMemo.GetMarkers(Line);
  3693. if Markers * [mlmError, mlmBreakpointBad, mlmStep] <> [] then
  3694. Continue;
  3695. { Add indicator while making sure it does not overlap any regular selection
  3696. styling for either the main selection or any additional selection. Does
  3697. not account for an indicator overlapping more than 1 selection. }
  3698. var OverlappingSelection: TScintRange;
  3699. if Selections.Overlaps(FoundRange, OverlappingSelection) then begin
  3700. if FoundRange.StartPos < OverlappingSelection.StartPos then
  3701. IndicatorRanges.Add(TScintRange.Create(FoundRange.StartPos, OverlappingSelection.StartPos));
  3702. if FoundRange.EndPos > OverlappingSelection.EndPos then
  3703. IndicatorRanges.Add(TScintRange.Create(OverlappingSelection.EndPos, FoundRange.EndPos));
  3704. end else
  3705. IndicatorRanges.Add(FoundRange);
  3706. end;
  3707. end;
  3708. begin
  3709. { Add occurrence indicators for the word at cursor if there's any and the
  3710. main selection is within this word. On top of those add occurrence indicators
  3711. for the main selected text if there's any. Don't do anything if the main
  3712. selection is not single line. All of these things are just like VSCode. }
  3713. var MainSelection: TScintRange;
  3714. var MainSelNotEmpty := AMemo.SelNotEmpty(MainSelection);
  3715. var MainSelSingleLine := AMemo.GetLineFromPosition(MainSelection.StartPos) =
  3716. AMemo.GetLineFromPosition(MainSelection.EndPos);
  3717. var IndicatorRanges: TScintRangeList := nil;
  3718. var Selections: TScintRangeList := nil;
  3719. try
  3720. IndicatorRanges := TScintRangeList.Create;
  3721. Selections := TScintRangeList.Create;
  3722. if FOptions.HighlightWordAtCursorOccurrences and (AMemo.CaretVirtualSpace = 0) and MainSelSingleLine then begin
  3723. var Word := AMemo.WordAtCaretRange;
  3724. if (Word.StartPos <> Word.EndPos) and MainSelection.Within(Word) then begin
  3725. var TextToIndicate := AMemo.GetRawTextRange(Word.StartPos, Word.EndPos);
  3726. AMemo.GetSelections(Selections); { Gets any additional selections as well }
  3727. FindTextAndAddRanges(AMemo, TextToIndicate, [sfoMatchCase, sfoWholeWord], Selections, IndicatorRanges);
  3728. end;
  3729. end;
  3730. AMemo.UpdateIndicators(IndicatorRanges, minWordAtCursorOccurrence);
  3731. IndicatorRanges.Clear;
  3732. if FOptions.HighlightSelTextOccurrences and MainSelNotEmpty and MainSelSingleLine then begin
  3733. var TextToIndicate := AMemo.RawMainSelText;
  3734. if Selections.Count = 0 then { If 0 then we didn't already call GetSelections above}
  3735. AMemo.GetSelections(Selections);
  3736. FindTextAndAddRanges(AMemo, TextToIndicate, [], Selections, IndicatorRanges);
  3737. end;
  3738. AMemo.UpdateIndicators(IndicatorRanges, minSelTextOccurrence);
  3739. finally
  3740. Selections.Free;
  3741. IndicatorRanges.Free;
  3742. end;
  3743. end;
  3744. procedure TMainForm.UpdateImages;
  3745. { Should be called at startup and after DPI changes }
  3746. begin
  3747. var WH := MulDiv(16, CurrentPPI, 96);
  3748. var Images := ImagesModule.LightToolBarImageCollection;
  3749. var Image := Images.GetSourceImage(Images.GetIndexByName('heart-filled'), WH, WH);
  3750. UpdatePanelDonateImage.Picture.Graphic:= Image;
  3751. end;
  3752. procedure TMainForm.UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  3753. { Should be called at startup and after DPI changes }
  3754. begin
  3755. CompilerOutputList.Canvas.Font.Assign(CompilerOutputList.Font);
  3756. CompilerOutputList.ItemHeight := CompilerOutputList.Canvas.TextHeight('0') + 1;
  3757. DebugOutputList.Canvas.Font.Assign(DebugOutputList.Font);
  3758. FDebugLogListTimestampsWidth := DebugOutputList.Canvas.TextWidth(Format('[00%s00%s00%s000] ', [FormatSettings.TimeSeparator, FormatSettings.TimeSeparator, FormatSettings.DecimalSeparator]));
  3759. DebugOutputList.ItemHeight := DebugOutputList.Canvas.TextHeight('0') + 1;
  3760. DebugCallStackList.Canvas.Font.Assign(DebugCallStackList.Font);
  3761. DebugCallStackList.ItemHeight := DebugCallStackList.Canvas.TextHeight('0') + 1;
  3762. FindResultsList.Canvas.Font.Assign(FindResultsList.Font);
  3763. FindResultsList.ItemHeight := FindResultsList.Canvas.TextHeight('0') + 1;
  3764. end;
  3765. type
  3766. TBitmapWithBits = class
  3767. Handle: HBITMAP;
  3768. pvBits: Pointer;
  3769. destructor Destroy; override;
  3770. end;
  3771. destructor TBitmapWithBits.Destroy;
  3772. begin
  3773. if Handle <> 0 then
  3774. DeleteObject(Handle);
  3775. inherited;
  3776. end;
  3777. procedure TMainForm.UpdateMarginsAndAutoCompleteIcons;
  3778. { Should be called at startup and after theme and DPI changes }
  3779. type
  3780. TMarkerOrACBitmaps = TObjectDictionary<Integer, TBitmapWithBits>;
  3781. procedure SwapRedBlue(const pvBits: PByte; Width, Height: Integer);
  3782. begin
  3783. var pvPixel := pvBits;
  3784. var pvMax := pvBits + 4*Width*Height;
  3785. while pvPixel < pvMax do begin
  3786. var Tmp := PByte(pvPixel)^;
  3787. PByte(pvPixel)^ := PByte(pvPixel + 2)^;
  3788. PByte(pvPixel + 2)^ := Tmp;
  3789. Inc(pvPixel, 4);
  3790. end;
  3791. end;
  3792. procedure AddMarkerOrACBitmap(const MarkerOrACBitmaps: TMarkerOrACBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo;
  3793. const MarkerNumberOrACType: Integer; const BkBrush: TBrush; const ImageList: TVirtualImageList; const ImageName: String);
  3794. begin
  3795. { Prepare a bitmap and select it }
  3796. var pvBits: Pointer;
  3797. var Bitmap := CreateDIBSection(DC, BitmapInfo, DIB_RGB_COLORS, pvBits, 0, 0);
  3798. var OldBitmap := SelectObject(DC, Bitmap);
  3799. { Fill the entire bitmap to avoid any alpha so we don't have to worry about
  3800. whether will be premultiplied or not (it was in tests) when Scintilla wants
  3801. it without premultiplication }
  3802. var Width := BitmapInfo.bmiHeader.biWidth;
  3803. var Height := Abs(BitmapInfo.bmiHeader.biHeight);
  3804. var Rect := TRect.Create(0, 0, Width, Height);
  3805. FillRect(DC, Rect, BkBrush.Handle);
  3806. { Draw the image - the result will be in pvBits }
  3807. if ImageList_Draw(ImageList.Handle, ImageList.GetIndexByName(ImageName), DC, 0, 0, ILD_TRANSPARENT) then begin
  3808. SwapRedBlue(pvBits, Width, Height); { Change pvBits from BGRA to RGBA like Scintilla wants }
  3809. var Bitmap2 := TBitmapWithBits.Create;
  3810. Bitmap2.Handle := Bitmap;
  3811. Bitmap2.pvBits := pvBits;
  3812. MarkerOrACBitmaps.Add(MarkerNumberOrACType, Bitmap2);
  3813. end else begin
  3814. SelectObject(DC, OldBitmap);
  3815. DeleteObject(Bitmap);
  3816. end;
  3817. end;
  3818. type
  3819. TMarkerNumberOrACType = TPair<Integer, String>;
  3820. function NNT(const MarkerNumberOrACType: Integer; const Name: String): TMarkerNumberOrACType;
  3821. begin
  3822. Result := TMarkerNumberOrACType.Create(MarkerNumberOrACType, Name); { This is a record so no need to free }
  3823. end;
  3824. begin
  3825. var ImageList := ThemedMarkersAndACVirtualImageList;
  3826. var DC := CreateCompatibleDC(0);
  3827. if DC <> 0 then begin
  3828. try
  3829. var MarkerBitmaps: TMarkerOrACBitmaps := nil;
  3830. var MarkerBkBrush: TBrush := nil;
  3831. var AutoCompleteBitmaps: TMarkerOrACBitmaps := nil;
  3832. var AutoCompleteBkBrush: TBrush := nil;
  3833. try
  3834. var BitmapInfo := CreateBitmapInfo(ImageList.Width, -ImageList.Height, 32); { This is a record so no need to free }
  3835. MarkerBitmaps := TMarkerOrACBitmaps.Create([doOwnsValues]);
  3836. MarkerBkBrush := TBrush.Create;
  3837. MarkerBkBrush.Color := FTheme.Colors[tcMarginBack];
  3838. var NamedMarkers := [
  3839. NNT(mmiHasEntry, 'markers\debug-stop-filled'),
  3840. NNT(mmiEntryProcessed, 'markers\debug-stop-filled_2'),
  3841. NNT(mmiBreakpoint, 'markers\debug-breakpoint-filled'),
  3842. NNT(mmiBreakpointBad, 'markers\debug-breakpoint-filled-cancel-2'),
  3843. NNT(mmiBreakpointGood, 'markers\debug-breakpoint-filled-ok-2'),
  3844. NNT(mmiStep, 'markers\symbol-arrow-right'),
  3845. NNT(mmiBreakpointStep, 'markers\debug-breakpoint-filled-ok2-symbol-arrow-right'),
  3846. NNT(SC_MARKNUM_FOLDER, 'markers\symbol-add'),
  3847. NNT(SC_MARKNUM_FOLDEROPEN, 'markers\symbol-remove')];
  3848. for var NamedMarker in NamedMarkers do
  3849. AddMarkerOrAcBitmap(MarkerBitmaps, DC, BitmapInfo, NamedMarker.Key, MarkerBkBrush, ImageList, NamedMarker.Value);
  3850. AutoCompleteBitmaps := TMarkerOrACBitmaps.Create([doOwnsValues]);
  3851. AutoCompleteBkBrush := TBrush.Create;
  3852. AutoCompleteBkBrush.Color := FTheme.Colors[tcIntelliBack];
  3853. var NamedTypes := [
  3854. NNT(awtSection, 'ac\structure-filled'),
  3855. NNT(awtParameter, 'ac\xml-filled'),
  3856. NNT(awtDirective, 'ac\xml-filled'),
  3857. NNT(awtFlag, 'ac\values'),
  3858. NNT(awtPreprocessorDirective, 'ac\symbol-hashtag'),
  3859. NNT(awtConstant, 'ac\constant-filled_2'),
  3860. NNT(awtScriptFunction, 'ac\method-filled'),
  3861. NNT(awtScriptType, 'ac\types'),
  3862. NNT(awtScriptVariable, 'ac\variables'),
  3863. NNT(awtScriptConstant, 'ac\constant-filled'),
  3864. NNT(awtScriptInterface, 'ac\interface-filled'),
  3865. NNT(awtScriptProperty, 'ac\properties-filled'),
  3866. NNT(awtScriptEvent, 'ac\event-filled'),
  3867. NNT(awtScriptKeyword, 'ac\list'),
  3868. NNT(awtScriptEnumValue, 'ac\constant-filled')];
  3869. for var NamedType in NamedTypes do
  3870. AddMarkerOrAcBitmap(AutoCompleteBitmaps, DC, BitmapInfo, NamedType.Key, AutoCompleteBkBrush, ImageList, NamedType.Value);
  3871. for var Memo in FMemos do begin
  3872. Memo.Call(SCI_RGBAIMAGESETWIDTH, ImageList.Width, 0);
  3873. Memo.Call(SCI_RGBAIMAGESETHEIGHT, ImageList.Height, 0);
  3874. for var MarkerBitmap in MarkerBitmaps do
  3875. Memo.Call(SCI_MARKERDEFINERGBAIMAGE, MarkerBitmap.Key, LPARAM(MarkerBitmap.Value.pvBits));
  3876. for var AutoCompleteBitmap in AutoCompleteBitmaps do
  3877. Memo.Call(SCI_REGISTERRGBAIMAGE, AutoCompleteBitmap.Key, LPARAM(AutoCompleteBitmap.Value.pvBits));
  3878. end;
  3879. finally
  3880. AutoCompleteBkBrush.Free;
  3881. AutoCompleteBitmaps.Free;
  3882. MarkerBkBrush.Free;
  3883. MarkerBitmaps.Free;
  3884. end;
  3885. finally
  3886. DeleteDC(DC);
  3887. end;
  3888. end;
  3889. end;
  3890. procedure TMainForm.UpdateMarginsAndSquigglyAndCaretWidths;
  3891. { Update the width of our two margins. Note: the width of the line numbers
  3892. margin is fully handled by TScintEdit. Should be called at startup and after
  3893. DPI change. }
  3894. begin
  3895. var IconMarkersWidth := ToCurrentPPI(18); { 3 pixel margin on both sides of the icon }
  3896. var BaseChangeHistoryWidth := ToCurrentPPI(6); { 6 = 2 pixel bar with 2 pixel margin on both sides because: "SC_MARK_BAR ... takes ... 1/3 of the margin width" }
  3897. var FolderMarkersWidth := ToCurrentPPI(14); { 1 pixel margin on boths side of the icon }
  3898. var LeftBlankMarginWidth := ToCurrentPPI(2); { 2 pixel margin between gutter and the main text }
  3899. var SquigglyWidth := ToCurrentPPI(100); { 100 = 1 pixel }
  3900. var CaretWidth := ToCurrentPPI(2);
  3901. var WhiteSpaceSize := CaretWidth;
  3902. for var Memo in FMemos do
  3903. Memo.UpdateWidthsAndSizes(IconMarkersWidth, BaseChangeHistoryWidth, FolderMarkersWidth,
  3904. LeftBlankMarginWidth, 0, SquigglyWidth, CaretWidth, WhiteSpaceSize);
  3905. end;
  3906. procedure TMainForm.SplitPanelMouseMove(Sender: TObject;
  3907. Shift: TShiftState; X, Y: Integer);
  3908. begin
  3909. if (ssLeft in Shift) and StatusPanel.Visible then begin
  3910. UpdateStatusPanelHeight(BodyPanel.ClientToScreen(Point(0, 0)).Y -
  3911. SplitPanel.ClientToScreen(Point(0, Y)).Y +
  3912. BodyPanel.ClientHeight - (SplitPanel.Height div 2));
  3913. end;
  3914. end;
  3915. procedure TMainForm.SimpleMenuClick(Sender: TObject);
  3916. begin
  3917. ApplyMenuBitmaps(Sender as TMenuItem);
  3918. end;
  3919. procedure TMainForm.TMenuClick(Sender: TObject);
  3920. var
  3921. MemoIsReadOnly: Boolean;
  3922. begin
  3923. MemoIsReadOnly := FActiveMemo.ReadOnly;
  3924. TGenerateGUID.Enabled := not MemoIsReadOnly;
  3925. TMsgBoxDesigner.Enabled := not MemoIsReadOnly;
  3926. TFilesDesigner.Enabled := not MemoIsReadOnly;
  3927. TRegistryDesigner.Enabled := not MemoIsReadOnly;
  3928. ApplyMenuBitmaps(Sender as TMenuItem);
  3929. end;
  3930. procedure TMainForm.TAddRemoveProgramsClick(Sender: TObject);
  3931. begin
  3932. StartAddRemovePrograms;
  3933. end;
  3934. procedure TMainForm.TGenerateGUIDClick(Sender: TObject);
  3935. begin
  3936. if MsgBox('The generated GUID will be inserted into the editor at the cursor position. Continue?',
  3937. SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
  3938. FActiveMemo.MainSelText := GenerateGuid;
  3939. end;
  3940. procedure TMainForm.TMsgBoxDesignerClick(Sender: TObject);
  3941. begin
  3942. if (FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scCode) and
  3943. (MsgBox('The generated Pascal script will be inserted into the editor at the cursor position, but the cursor is not in the [Code] section. Continue anyway?',
  3944. SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDNO) then
  3945. Exit;
  3946. var MsgBoxForm := TMsgBoxDesignerForm.Create(Application);
  3947. try
  3948. if MsgBoxForm.ShowModal = mrOk then
  3949. FActiveMemo.MainSelText := MsgBoxForm.GetText(FOptions.TabWidth, FOptions.UseTabCharacter);
  3950. finally
  3951. MsgBoxForm.Free;
  3952. end;
  3953. end;
  3954. procedure TMainForm.TRegistryDesignerClick(Sender: TObject);
  3955. begin
  3956. var RegistryDesignerForm := TRegistryDesignerForm.Create(Application);
  3957. try
  3958. var PrivilegesRequired := FindSetupDirectiveValue('PrivilegesRequired', 'admin');
  3959. var PrivilegesRequiredOverridesAllowed := FindSetupDirectiveValue('PrivilegesRequiredOverridesAllowed', '');
  3960. if PrivilegesRequiredOverridesAllowed = '' then begin
  3961. if SameText(PrivilegesRequired, 'admin') then
  3962. RegistryDesignerForm.PrivilegesRequired := prAdmin
  3963. else
  3964. RegistryDesignerForm.PrivilegesRequired := prLowest
  3965. end else
  3966. RegistryDesignerForm.PrivilegesRequired := prDynamic;
  3967. if RegistryDesignerForm.ShowModal = mrOk then
  3968. begin
  3969. FActiveMemo.CaretColumn := 0;
  3970. var Text := RegistryDesignerForm.Text;
  3971. if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scRegistry then
  3972. Text := '[Registry]' + SNewLine + Text;
  3973. FActiveMemo.MainSelText := Text;
  3974. end;
  3975. finally
  3976. RegistryDesignerForm.Free;
  3977. end;
  3978. end;
  3979. procedure TMainForm.TFilesDesignerClick(Sender: TObject);
  3980. begin
  3981. var FilesDesignerForm := TFilesDesignerForm.Create(Application);
  3982. try
  3983. FilesDesignerForm.CreateAppDir := FindSetupDirectiveValue('CreateAppDir', True);
  3984. if FilesDesignerForm.ShowModal = mrOk then begin
  3985. FActiveMemo.CaretColumn := 0;
  3986. var Text := FilesDesignerForm.Text;
  3987. if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scFiles then
  3988. Text := '[Files]' + SNewLine + Text;
  3989. FActiveMemo.MainSelText := Text;
  3990. end;
  3991. finally
  3992. FilesDesignerForm.Free;
  3993. end;
  3994. end;
  3995. procedure TMainForm.TSignToolsClick(Sender: TObject);
  3996. var
  3997. SignToolsForm: TSignToolsForm;
  3998. Ini: TConfigIniFile;
  3999. I: Integer;
  4000. begin
  4001. SignToolsForm := TSignToolsForm.Create(Application);
  4002. try
  4003. SignToolsForm.SignTools := FSignTools;
  4004. if SignToolsForm.ShowModal <> mrOK then
  4005. Exit;
  4006. FSignTools.Assign(SignToolsForm.SignTools);
  4007. { Save new options }
  4008. Ini := TConfigIniFile.Create;
  4009. try
  4010. Ini.EraseSection('SignTools');
  4011. for I := 0 to FSignTools.Count-1 do
  4012. Ini.WriteString('SignTools', 'SignTool' + IntToStr(I), FSignTools[I]);
  4013. finally
  4014. Ini.Free;
  4015. end;
  4016. finally
  4017. SignToolsForm.Free;
  4018. end;
  4019. end;
  4020. procedure TMainForm.TOptionsClick(Sender: TObject);
  4021. var
  4022. OptionsForm: TOptionsForm;
  4023. Ini: TConfigIniFile;
  4024. Memo: TIDEScintEdit;
  4025. begin
  4026. OptionsForm := TOptionsForm.Create(Application);
  4027. try
  4028. OptionsForm.StartupCheck.Checked := FOptions.ShowStartupForm;
  4029. OptionsForm.WizardCheck.Checked := FOptions.UseWizard;
  4030. OptionsForm.AutosaveCheck.Checked := FOptions.Autosave;
  4031. OptionsForm.BackupCheck.Checked := FOptions.MakeBackups;
  4032. OptionsForm.FullPathCheck.Checked := FOptions.FullPathInTitleBar;
  4033. OptionsForm.UndoAfterSaveCheck.Checked := FOptions.UndoAfterSave;
  4034. OptionsForm.PauseOnDebuggerExceptionsCheck.Checked := FOptions.PauseOnDebuggerExceptions;
  4035. OptionsForm.RunAsDifferentUserCheck.Checked := FOptions.RunAsDifferentUser;
  4036. OptionsForm.AutoAutoCompleteCheck.Checked := FOptions.AutoAutoComplete;
  4037. OptionsForm.UseSynHighCheck.Checked := FOptions.UseSyntaxHighlighting;
  4038. OptionsForm.ColorizeCompilerOutputCheck.Checked := FOptions.ColorizeCompilerOutput;
  4039. OptionsForm.UnderlineErrorsCheck.Checked := FOptions.UnderlineErrors;
  4040. OptionsForm.CursorPastEOLCheck.Checked := FOptions.CursorPastEOL;
  4041. OptionsForm.TabWidthEdit.Text := IntToStr(FOptions.TabWidth);
  4042. OptionsForm.UseTabCharacterCheck.Checked := FOptions.UseTabCharacter;
  4043. OptionsForm.ShowWhiteSpaceCheck.Checked := FOptions.ShowWhiteSpace;
  4044. OptionsForm.UseFoldingCheck.Checked := FOptions.UseFolding;
  4045. OptionsForm.AutoIndentCheck.Checked := FOptions.AutoIndent;
  4046. OptionsForm.IndentationGuidesCheck.Checked := FOptions.IndentationGuides;
  4047. OptionsForm.GutterLineNumbersCheck.Checked := FOptions.GutterLineNumbers;
  4048. OptionsForm.ShowPreprocessorOutputCheck.Checked := FOptions.ShowPreprocessorOutput;
  4049. OptionsForm.OpenIncludedFilesCheck.Checked := FOptions.OpenIncludedFiles;
  4050. OptionsForm.KeyMappingComboBox.ItemIndex := Ord(FOptions.KeyMappingType);
  4051. OptionsForm.MemoKeyMappingComboBox.ItemIndex := Ord(FOptions.MemoKeyMappingType);
  4052. OptionsForm.ThemeComboBox.ItemIndex := Ord(FOptions.ThemeType);
  4053. OptionsForm.FontPanel.Font.Assign(FMainMemo.Font);
  4054. OptionsForm.FontPanel.ParentBackground := False;
  4055. OptionsForm.FontPanel.Color := FMainMemo.Color;
  4056. OptionsForm.HighlightWordAtCursorOccurrencesCheck.Checked := FOptions.HighlightWordAtCursorOccurrences;
  4057. OptionsForm.HighlightSelTextOccurrencesCheck.Checked := FOptions.HighlightSelTextOccurrences;
  4058. if OptionsForm.ShowModal <> mrOK then
  4059. Exit;
  4060. FOptions.ShowStartupForm := OptionsForm.StartupCheck.Checked;
  4061. FOptions.UseWizard := OptionsForm.WizardCheck.Checked;
  4062. FOptions.Autosave := OptionsForm.AutosaveCheck.Checked;
  4063. FOptions.MakeBackups := OptionsForm.BackupCheck.Checked;
  4064. FOptions.FullPathInTitleBar := OptionsForm.FullPathCheck.Checked;
  4065. FOptions.UndoAfterSave := OptionsForm.UndoAfterSaveCheck.Checked;
  4066. FOptions.PauseOnDebuggerExceptions := OptionsForm.PauseOnDebuggerExceptionsCheck.Checked;
  4067. FOptions.RunAsDifferentUser := OptionsForm.RunAsDifferentUserCheck.Checked;
  4068. FOptions.AutoAutoComplete := OptionsForm.AutoAutoCompleteCheck.Checked;
  4069. FOptions.UseSyntaxHighlighting := OptionsForm.UseSynHighCheck.Checked;
  4070. FOptions.ColorizeCompilerOutput := OptionsForm.ColorizeCompilerOutputCheck.Checked;
  4071. FOptions.UnderlineErrors := OptionsForm.UnderlineErrorsCheck.Checked;
  4072. FOptions.CursorPastEOL := OptionsForm.CursorPastEOLCheck.Checked;
  4073. FOptions.TabWidth := StrToInt(OptionsForm.TabWidthEdit.Text);
  4074. FOptions.UseTabCharacter := OptionsForm.UseTabCharacterCheck.Checked;
  4075. FOptions.ShowWhiteSpace := OptionsForm.ShowWhiteSpaceCheck.Checked;
  4076. FOptions.UseFolding := OptionsForm.UseFoldingCheck.Checked;
  4077. FOptions.AutoIndent := OptionsForm.AutoIndentCheck.Checked;
  4078. FOptions.IndentationGuides := OptionsForm.IndentationGuidesCheck.Checked;
  4079. FOptions.GutterLineNumbers := OptionsForm.GutterLineNumbersCheck.Checked;
  4080. FOptions.ShowPreprocessorOutput := OptionsForm.ShowPreprocessorOutputCheck.Checked;
  4081. FOptions.OpenIncludedFiles := OptionsForm.OpenIncludedFilesCheck.Checked;
  4082. FOptions.KeyMappingType := TKeyMappingType(OptionsForm.KeyMappingComboBox.ItemIndex);
  4083. FOptions.MemoKeyMappingType := TIDEScintKeyMappingType(OptionsForm.MemoKeyMappingComboBox.ItemIndex);
  4084. FOptions.ThemeType := TThemeType(OptionsForm.ThemeComboBox.ItemIndex);
  4085. FOptions.HighlightWordAtCursorOccurrences := OptionsForm.HighlightWordAtCursorOccurrencesCheck.Checked;
  4086. FOptions.HighlightSelTextOccurrences := OptionsForm.HighlightSelTextOccurrencesCheck.Checked;
  4087. UpdateCaption;
  4088. UpdatePreprocMemos;
  4089. InvalidateStatusPanel(spHiddenFilesCount);
  4090. for Memo in FMemos do begin
  4091. { Move caret to start of line to ensure it doesn't end up in the middle
  4092. of a double-byte character if the code page changes from SBCS to DBCS }
  4093. Memo.CaretLine := Memo.CaretLine;
  4094. Memo.Font.Assign(OptionsForm.FontPanel.Font);
  4095. end;
  4096. SyncEditorOptions;
  4097. UpdateMarginsAndSquigglyAndCaretWidths;
  4098. UpdateNewMainFileButtons;
  4099. UpdateOccurrenceIndicators(FActiveMemo);
  4100. UpdateKeyMapping;
  4101. UpdateTheme;
  4102. { Save new options }
  4103. Ini := TConfigIniFile.Create;
  4104. try
  4105. Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
  4106. Ini.WriteBool('Options', 'UseWizard', FOptions.UseWizard);
  4107. Ini.WriteBool('Options', 'Autosave', FOptions.Autosave);
  4108. Ini.WriteBool('Options', 'MakeBackups', FOptions.MakeBackups);
  4109. Ini.WriteBool('Options', 'FullPathInTitleBar', FOptions.FullPathInTitleBar);
  4110. Ini.WriteBool('Options', 'UndoAfterSave', FOptions.UndoAfterSave);
  4111. Ini.WriteBool('Options', 'PauseOnDebuggerExceptions', FOptions.PauseOnDebuggerExceptions);
  4112. Ini.WriteBool('Options', 'RunAsDifferentUser', FOptions.RunAsDifferentUser);
  4113. Ini.WriteBool('Options', 'AutoComplete', FOptions.AutoAutoComplete);
  4114. Ini.WriteBool('Options', 'AutoCallTips', FOptions.AutoCallTips);
  4115. Ini.WriteBool('Options', 'UseSynHigh', FOptions.UseSyntaxHighlighting);
  4116. Ini.WriteBool('Options', 'ColorizeCompilerOutput', FOptions.ColorizeCompilerOutput);
  4117. Ini.WriteBool('Options', 'UnderlineErrors', FOptions.UnderlineErrors);
  4118. Ini.WriteBool('Options', 'HighlightWordAtCursorOccurrences', FOptions.HighlightWordAtCursorOccurrences);
  4119. Ini.WriteBool('Options', 'HighlightSelTextOccurrences', FOptions.HighlightSelTextOccurrences);
  4120. Ini.WriteBool('Options', 'EditorCursorPastEOL', FOptions.CursorPastEOL);
  4121. Ini.WriteInteger('Options', 'TabWidth', FOptions.TabWidth);
  4122. Ini.WriteBool('Options', 'UseTabCharacter', FOptions.UseTabCharacter);
  4123. Ini.WriteBool('Options', 'ShowWhiteSpace', FOptions.ShowWhiteSpace);
  4124. Ini.WriteBool('Options', 'UseFolding', FOptions.UseFolding);
  4125. Ini.WriteBool('Options', 'AutoIndent', FOptions.AutoIndent);
  4126. Ini.WriteBool('Options', 'IndentationGuides', FOptions.IndentationGuides);
  4127. Ini.WriteBool('Options', 'GutterLineNumbers', FOptions.GutterLineNumbers);
  4128. Ini.WriteBool('Options', 'ShowPreprocessorOutput', FOptions.ShowPreprocessorOutput);
  4129. Ini.WriteBool('Options', 'OpenIncludedFiles', FOptions.OpenIncludedFiles);
  4130. Ini.WriteInteger('Options', 'KeyMappingType', Ord(FOptions.KeyMappingType));
  4131. Ini.WriteInteger('Options', 'MemoKeyMappingType', Ord(FOptions.MemoKeyMappingType));
  4132. Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see Destroy }
  4133. Ini.WriteString('Options', 'EditorFontName', FMainMemo.Font.Name);
  4134. Ini.WriteInteger('Options', 'EditorFontSize', FMainMemo.Font.Size);
  4135. Ini.WriteInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset);
  4136. finally
  4137. Ini.Free;
  4138. end;
  4139. finally
  4140. OptionsForm.Free;
  4141. end;
  4142. end;
  4143. { Also see TabIndexToMemoIndex }
  4144. function TMainForm.MemoToTabIndex(const AMemo: TIDEScintEdit): Integer;
  4145. begin
  4146. if AMemo = FMainMemo then
  4147. Result := 0 { First tab displays the main memo }
  4148. else if AMemo = FPreprocessorOutputMemo then begin
  4149. if not FPreprocessorOutputMemo.Used then
  4150. raise Exception.Create('not FPreprocessorOutputMemo.Used');
  4151. Result := MemosTabSet.Tabs.Count-1 { Last tab displays the preprocessor output memo }
  4152. end else begin
  4153. Result := FFileMemos.IndexOf(AMemo as TIDEScintFileEdit); { Other tabs display include files which start second tab }
  4154. { Filter memos explicitly hidden by the user }
  4155. for var MemoIndex := Result-1 downto 0 do
  4156. if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) <> -1 then
  4157. Dec(Result);
  4158. end;
  4159. end;
  4160. { Also see MemoToTabIndex }
  4161. function TMainForm.TabIndexToMemo(const ATabIndex, AMaxTabIndex: Integer): TIDEScintEdit;
  4162. begin
  4163. if ATabIndex = 0 then
  4164. Result := FMemos[0] { First tab displays the main memo which is FMemos[0] }
  4165. else if FPreprocessorOutputMemo.Used and (ATabIndex = AMaxTabIndex) then
  4166. Result := FMemos[1] { Last tab displays the preprocessor output memo which is FMemos[1] }
  4167. else begin
  4168. { Only count memos not explicitly hidden by the user }
  4169. var TabIndex := 0;
  4170. for var MemoIndex := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin
  4171. if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) = -1 then begin
  4172. Inc(TabIndex);
  4173. if TabIndex = ATabIndex then begin
  4174. Result := FMemos[MemoIndex + 1]; { Other tabs display include files which start at second tab but at FMemos[2] }
  4175. Exit;
  4176. end;
  4177. end;
  4178. end;
  4179. raise Exception.Create('TabIndexToMemo failed');
  4180. end;
  4181. end;
  4182. procedure TMainForm.MoveCaretAndActivateMemo(AMemo: TIDEScintEdit; const LineNumberOrPosition: Integer;
  4183. const AlwaysResetColumnEvenIfOnRequestedLineAlready: Boolean; const IsPosition: Boolean;
  4184. const PositionVirtualSpace: Integer);
  4185. var
  4186. Pos: Integer;
  4187. begin
  4188. { Reopen tab if needed }
  4189. if AMemo is TIDEScintFileEdit then begin
  4190. var FileName := (AMemo as TIDEScintFileEdit).Filename;
  4191. var HiddenFileIndex := FHiddenFiles.IndexOf(Filename);
  4192. if HiddenFileIndex <> -1 then begin
  4193. ReopenTabOrTabs(HiddenFileIndex, False);
  4194. { The above call to ReopenTabOrTabs will currently lead to a call to UpdateIncludedFilesMemos which
  4195. sets up all the memos. Currently it will keep same memo for the reopened file but in case it no
  4196. longer does at some point: look it up again }
  4197. AMemo := nil;
  4198. for var Memo in FFileMemos do begin
  4199. if Memo.Used and (PathCompare(Memo.Filename, Filename) = 0) then begin
  4200. AMemo := Memo;
  4201. Break;
  4202. end;
  4203. end;
  4204. if AMemo = nil then
  4205. raise Exception.Create('AMemo MIA');
  4206. end;
  4207. end;
  4208. { Move caret }
  4209. if IsPosition then
  4210. Pos := LineNumberOrPosition
  4211. else if AlwaysResetColumnEvenIfOnRequestedLineAlready or (AMemo.CaretLine <> LineNumberOrPosition) then
  4212. Pos := AMemo.GetPositionFromLine(LineNumberOrPosition)
  4213. else
  4214. Pos := AMemo.CaretPosition; { Not actually moving caret - it's already were we want it}
  4215. { If the line is in a contracted section, expand it }
  4216. AMemo.EnsureLineVisible(AMemo.GetLineFromPosition(Pos));
  4217. { If the line isn't in view, scroll so that it's in the center }
  4218. if not AMemo.IsPositionInViewVertically(Pos) then
  4219. AMemo.TopLine := AMemo.GetVisibleLineFromDocLine(AMemo.GetLineFromPosition(Pos)) -
  4220. (AMemo.LinesInWindow div 2);
  4221. AMemo.CaretPosition := Pos;
  4222. if IsPosition then
  4223. AMemo.CaretVirtualSpace := PositionVirtualSpace;
  4224. { Activate memo }
  4225. MemosTabSet.TabIndex := MemoToTabIndex(AMemo); { This causes MemosTabSetClick to show the memo }
  4226. end;
  4227. procedure TMainForm.SetErrorLine(const AMemo: TIDEScintFileEdit; const ALine: Integer);
  4228. var
  4229. OldLine: Integer;
  4230. begin
  4231. if AMemo <> FErrorMemo then begin
  4232. SetErrorLine(FErrorMemo, -1);
  4233. FErrorMemo := AMemo;
  4234. end;
  4235. if FErrorMemo.ErrorLine <> ALine then begin
  4236. OldLine := FErrorMemo.ErrorLine;
  4237. FErrorMemo.ErrorLine := ALine;
  4238. if OldLine >= 0 then
  4239. UpdateLineMarkers(FErrorMemo, OldLine);
  4240. if FErrorMemo.ErrorLine >= 0 then begin
  4241. FErrorMemo.ErrorCaretPosition := FErrorMemo.CaretPosition;
  4242. UpdateLineMarkers(FErrorMemo, FErrorMemo.ErrorLine);
  4243. end;
  4244. end;
  4245. end;
  4246. procedure TMainForm.SetStepLine(const AMemo: TIDEScintFileEdit; ALine: Integer);
  4247. var
  4248. OldLine: Integer;
  4249. begin
  4250. if AMemo <> FStepMemo then begin
  4251. SetStepLine(FStepMemo, -1);
  4252. FStepMemo := AMemo;
  4253. end;
  4254. if FStepMemo.StepLine <> ALine then begin
  4255. OldLine := FStepMemo.StepLine;
  4256. FStepMemo.StepLine := ALine;
  4257. if OldLine >= 0 then
  4258. UpdateLineMarkers(FStepMemo, OldLine);
  4259. if FStepMemo.StepLine >= 0 then
  4260. UpdateLineMarkers(FStepMemo, FStepMemo.StepLine);
  4261. end;
  4262. end;
  4263. procedure TMainForm.HideError;
  4264. begin
  4265. SetErrorLine(FErrorMemo, -1);
  4266. if not FCompiling then
  4267. StatusBar.Panels[spExtraStatus].Text := '';
  4268. end;
  4269. procedure TMainForm.RemoveMemoFromNav(const AMemo: TIDEScintEdit);
  4270. begin
  4271. if FNavStacks.RemoveMemo(AMemo) then
  4272. UpdateNavButtons;
  4273. if FCurrentNavItem.Memo = AMemo then
  4274. FCurrentNavItem.Invalidate;
  4275. end;
  4276. procedure TMainForm.RemoveMemoBadLinesFromNav(const AMemo: TIDEScintEdit);
  4277. begin
  4278. if FNavStacks.RemoveMemoBadLines(AMemo) then
  4279. UpdateNavButtons;
  4280. { We do NOT update FCurrentNav here so it might point to a line that's
  4281. deleted until next UpdateCaretPosPanelAndBackStack by UpdateMemoUI }
  4282. end;
  4283. procedure TMainForm.UpdateNavButtons;
  4284. begin
  4285. ForwardNavButton.Enabled := FNavStacks.Forward.Count > 0;
  4286. BackNavButton.Enabled := (FNavStacks.Back.Count > 0) or
  4287. ForwardNavButton.Enabled; { for the dropdown }
  4288. end;
  4289. procedure TMainForm.BackNavButtonClick(Sender: TObject);
  4290. begin
  4291. { Delphi does not support BTNS_WHOLEDROPDOWN so we can't be like VS which
  4292. can have a disabled back nav button with an enabled dropdown. To avoid
  4293. always showing two dropdowns we keep the back button enabled when we need
  4294. the dropdown. So we need to check for this. }
  4295. if FNavStacks.Back.Count = 0 then begin
  4296. Beep;
  4297. Exit;
  4298. end;
  4299. FNavStacks.Forward.Add(FCurrentNavItem);
  4300. var NewNavItem := FNavStacks.Back.ExtractAt(FNavStacks.Back.Count-1);
  4301. UpdateNavButtons;
  4302. FCurrentNavItem := NewNavItem; { Must be done *before* moving }
  4303. MoveCaretAndActivateMemo(NewNavItem.Memo,
  4304. NewNavItem.Memo.GetPositionFromLineColumn(NewNavItem.Line, NewNavItem.Column), False, True, NewNavItem.VirtualSpace);
  4305. end;
  4306. procedure TMainForm.ForwardNavButtonClick(Sender: TObject);
  4307. begin
  4308. FNavStacks.Back.Add(FCurrentNavItem);
  4309. var NewNavItem := FNavStacks.Forward.ExtractAt(FNavStacks.Forward.Count-1);
  4310. UpdateNavButtons;
  4311. FCurrentNavItem := NewNavItem; { Must be done *before* moving }
  4312. MoveCaretAndActivateMemo(NewNavItem.Memo,
  4313. NewNavItem.Memo.GetPositionFromLineColumn(NewNavItem.Line, NewNavItem.Column), False, True, NewNavItem.VirtualSpace);
  4314. end;
  4315. procedure TMainForm.WMAppCommand(var Message: TMessage);
  4316. begin
  4317. var Command := GET_APPCOMMAND_LPARAM(Message.LParam);
  4318. if Command = APPCOMMAND_BROWSER_BACKWARD then begin
  4319. if BackNavButton.Enabled then
  4320. BackNavButton.Click;
  4321. Message.Result := 1;
  4322. end else if Command = APPCOMMAND_BROWSER_FORWARD then begin
  4323. if ForwardNavButton.Enabled then
  4324. ForwardNavButton.Click;
  4325. Message.Result := 1;
  4326. end;
  4327. end;
  4328. procedure TMainForm.NavItemClick(Sender: TObject);
  4329. begin
  4330. var MenuItem := Sender as TMenuItem;
  4331. var Clicks := Abs(MenuItem.Tag);
  4332. if Clicks > 0 then begin
  4333. var ButtonToClick: TToolButton;
  4334. if MenuItem.Tag > 0 then
  4335. ButtonToClick := ForwardNavButton
  4336. else
  4337. ButtonToClick := BackNavButton;
  4338. while Clicks > 0 do begin
  4339. if not ButtonToClick.Enabled then
  4340. raise Exception.Create('not ButtonToClick.Enabled');
  4341. ButtonToClick.Click;
  4342. Dec(Clicks);
  4343. end;
  4344. end;
  4345. end;
  4346. procedure TMainForm.NavPopupMenuClick(Sender: TObject);
  4347. procedure AddNavItemToMenu(const NavItem: TIDEScintEditNavItem; const Checked: Boolean;
  4348. const ClicksNeeded: Integer; const Menu: TMenuItem);
  4349. begin
  4350. if NavItem.Line >= NavItem.Memo.Lines.Count then
  4351. raise Exception.Create('NavItem.Line >= NavItem.Memo.Lines.Count');
  4352. var LineInfo := NavItem.Memo.Lines[NavItem.Line];
  4353. if LineInfo.Trim = '' then
  4354. LineInfo := Format('Line %d', [NavItem.Line+1]);
  4355. var Caption: String;
  4356. if MemosTabSet.Visible then
  4357. Caption := Format('%s: %s', [MemosTabSet.Tabs[MemoToTabIndex(NavItem.Memo)], LineInfo])
  4358. else
  4359. Caption := LineInfo;
  4360. var MenuItem := TMenuItem.Create(Menu);
  4361. MenuItem.Caption := DoubleAmp(Caption);
  4362. MenuItem.Checked := Checked;
  4363. MenuItem.RadioItem := True;
  4364. MenuItem.Tag := ClicksNeeded;
  4365. MenuItem.OnClick := NavItemClick;
  4366. Menu.Add(MenuItem);
  4367. end;
  4368. begin
  4369. var Menu := Sender as TMenuItem;
  4370. Menu.Clear;
  4371. { Setup dropdown. The result should end up being just like Visual Studio 2022
  4372. which means from top to bottom:
  4373. - Furthest (=oldest) forward item
  4374. - ...
  4375. - Closest (=next) forward item
  4376. - Current position in the active memo, checked
  4377. - Closest (=next) back item
  4378. - ...
  4379. - Furthest (=oldest) back item
  4380. The Tag parameter should be set to the amount of clicks needed to get to
  4381. the item, positive for forward and negative for back }
  4382. for var I := 0 to FNavStacks.Forward.Count-1 do
  4383. AddNavItemToMenu(FNavStacks.Forward[I], False, FNavStacks.Forward.Count-I, Menu);
  4384. AddNavItemToMenu(FCurrentNavItem, True, 0, Menu);
  4385. for var I := FNavStacks.Back.Count-1 downto 0 do
  4386. AddNavItemToMenu(FNavStacks.Back[I], False, -(FNavStacks.Back.Count-I), Menu);
  4387. end;
  4388. procedure TMainForm.UpdateCaretPosPanelAndBackNavStack;
  4389. begin
  4390. { Update panel }
  4391. var Text := Format('%4d:%4d', [FActiveMemo.CaretLine + 1,
  4392. FActiveMemo.CaretColumnExpandedForTabs + 1]);
  4393. if FOptions.ShowCaretPosition then begin
  4394. var CaretPos := FActiveMemo.CaretPosition;
  4395. Text := Format('%d@%d+%d:%s', [FActiveMemo.GetStyleAtPosition(CaretPos), CaretPos, FActiveMemo.CaretVirtualSpace, Text]);
  4396. end;
  4397. StatusBar.Panels[spCaretPos].Text := Text;
  4398. { Update NavStacks.Back if needed and remember new position }
  4399. var NewNavItem := TIDEScintEditNavItem.Create(FActiveMemo); { This is a record so no need to free }
  4400. if FCurrentNavItem.Valid and FNavStacks.AddNewBackForJump(FCurrentNavItem, NewNavItem) then
  4401. UpdateNavButtons;
  4402. FCurrentNavItem := NewNavItem;
  4403. end;
  4404. procedure TMainForm.UpdateEditModePanel;
  4405. const
  4406. InsertText: array[Boolean] of String = ('Overwrite', 'Insert');
  4407. begin
  4408. if FActiveMemo.ReadOnly then
  4409. StatusBar.Panels[spEditMode].Text := 'Read only'
  4410. else
  4411. StatusBar.Panels[spEditMode].Text := InsertText[FActiveMemo.InsertMode];
  4412. end;
  4413. procedure TMainForm.UpdateFindRegExUI;
  4414. const
  4415. FindRegExText: array[Boolean] of String = ('', '.*');
  4416. begin
  4417. StatusBar.Panels[spFindRegEx].Text := FindRegExText[FOptions.FindRegEx];
  4418. if FOptions.FindRegEx then begin
  4419. FindDialog.Options := FindDialog.Options + [frHideWholeWord];
  4420. ReplaceDialog.Options := ReplaceDialog.Options + [frHideWholeWord];
  4421. end else begin
  4422. FindDialog.Options := FindDialog.Options - [frHideWholeWord];
  4423. ReplaceDialog.Options := ReplaceDialog.Options - [frHideWholeWord];
  4424. end;
  4425. end;
  4426. procedure TMainForm.UpdateMemosTabSetVisibility;
  4427. begin
  4428. MemosTabSet.Visible := FPreprocessorOutputMemo.Used or FFileMemos[FirstIncludedFilesMemoIndex].Used;
  4429. if not MemosTabSet.Visible then
  4430. MemosTabSet.TabIndex := 0; { For next time }
  4431. end;
  4432. procedure TMainForm.UpdateModifiedPanel;
  4433. begin
  4434. if FActiveMemo.Modified then
  4435. StatusBar.Panels[spModified].Text := 'Modified'
  4436. else
  4437. StatusBar.Panels[spModified].Text := '';
  4438. end;
  4439. procedure TMainForm.UpdatePreprocMemos;
  4440. procedure UpdatePreprocessorOutputMemo(const NewTabs, NewHints: TStringList;
  4441. const NewCloseButtons: TBoolList);
  4442. begin
  4443. if FOptions.ShowPreprocessorOutput and (FPreprocessorOutput <> '') and
  4444. not SameStr(TrimRight(FMainMemo.Lines.Text), FPreprocessorOutput) then begin
  4445. NewTabs.Add('Preprocessor Output');
  4446. NewHints.Add('');
  4447. NewCloseButtons.Add(False);
  4448. FPreprocessorOutputMemo.ReadOnly := False;
  4449. try
  4450. FPreprocessorOutputMemo.Lines.Text := FPreprocessorOutput;
  4451. FPreprocessorOutputMemo.ClearUndo;
  4452. finally
  4453. FPreprocessorOutputMemo.ReadOnly := True;
  4454. end;
  4455. FPreprocessorOutputMemo.Used := True;
  4456. end else begin
  4457. if FPreprocessorOutputMemo.Used then
  4458. RemoveMemoFromNav(FPreprocessorOutputMemo);
  4459. FPreprocessorOutputMemo.Used := False;
  4460. FPreprocessorOutputMemo.Visible := False;
  4461. end;
  4462. end;
  4463. procedure UpdateIncludedFilesMemos(const NewTabs, NewHints: TStringList;
  4464. const NewCloseButtons: TBoolList);
  4465. var
  4466. IncludedFile: TIncludedFile;
  4467. I: Integer;
  4468. begin
  4469. if FOptions.OpenIncludedFiles and (FIncludedFiles.Count > 0) then begin
  4470. var NextMemoIndex := FirstIncludedFilesMemoIndex;
  4471. var NextTabIndex := 1; { First tab displays the main memo }
  4472. for IncludedFile in FIncludedFiles do begin
  4473. IncludedFile.Memo := FFileMemos[NextMemoIndex];
  4474. try
  4475. if not IncludedFile.Memo.Used or
  4476. ((PathCompare(IncludedFile.Memo.Filename, IncludedFile.Filename) <> 0) or
  4477. not IncludedFile.HasLastWriteTime or
  4478. (CompareFileTime(IncludedFile.Memo.FileLastWriteTime, IncludedFile.LastWriteTime) <> 0)) then begin
  4479. IncludedFile.Memo.Filename := IncludedFile.Filename;
  4480. IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex;
  4481. OpenFile(IncludedFile.Memo, IncludedFile.Filename, False); { Also updates FileLastWriteTime }
  4482. IncludedFile.Memo.Used := True;
  4483. end else begin
  4484. { The memo assigned to the included file already has that file loaded
  4485. and is up-to-date so no call to OpenFile is needed. However, it could be
  4486. that CompilerFileIndex is not set yet. This happens if the initial
  4487. load was from the history loaded by LoadKnownIncludedAndHiddenFiles
  4488. and is followed by the user doing a compile. }
  4489. if IncludedFile.Memo.CompilerFileIndex = UnknownCompilerFileIndex then
  4490. IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex;
  4491. end;
  4492. if FHiddenFiles.IndexOf(IncludedFile.Filename) = -1 then begin
  4493. NewTabs.Insert(NextTabIndex, GetDisplayFilename(IncludedFile.Filename));
  4494. NewHints.Insert(NextTabIndex, GetFileTitle(IncludedFile.Filename));
  4495. NewCloseButtons.Insert(NextTabIndex, True);
  4496. Inc(NextTabIndex);
  4497. end;
  4498. Inc(NextMemoIndex);
  4499. if NextMemoIndex = FFileMemos.Count then
  4500. Break; { We're out of memos :( }
  4501. except on E: Exception do
  4502. begin
  4503. StatusMessage(smkWarning, 'Failed to open included file: ' + E.Message);
  4504. IncludedFile.Memo := nil;
  4505. end;
  4506. end;
  4507. end;
  4508. { Hide any remaining memos }
  4509. for I := NextMemoIndex to FFileMemos.Count-1 do begin
  4510. FFileMemos[I].BreakPoints.Clear;
  4511. if FFileMemos[I].Used then
  4512. RemoveMemoFromNav(FFileMemos[I]);
  4513. FFileMemos[I].Used := False;
  4514. FFileMemos[I].Visible := False;
  4515. end;
  4516. end else begin
  4517. for I := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin
  4518. FFileMemos[I].BreakPoints.Clear;
  4519. if FFileMemos[I].Used then
  4520. RemoveMemoFromNav(FFileMemos[I]);
  4521. FFileMemos[I].Used := False;
  4522. FFileMemos[I].Visible := False;
  4523. end;
  4524. for IncludedFile in FIncludedFiles do
  4525. IncludedFile.Memo := nil;
  4526. end;
  4527. end;
  4528. var
  4529. NewTabs, NewHints: TStringList;
  4530. NewCloseButtons: TBoolList;
  4531. I, SaveTabIndex: Integer;
  4532. SaveTabName: String;
  4533. begin
  4534. NewTabs := nil;
  4535. NewHints := nil;
  4536. NewCloseButtons := nil;
  4537. try
  4538. NewTabs := TStringList.Create;
  4539. NewTabs.Add(MemosTabSet.Tabs[0]); { 'Main Script' }
  4540. NewHints := TStringList.Create;
  4541. NewHints.Add(GetFileTitle(FMainMemo.Filename));
  4542. NewCloseButtons := TBoolList.Create;
  4543. NewCloseButtons.Add(False);
  4544. UpdatePreprocessorOutputMemo(NewTabs, NewHints, NewCloseButtons);
  4545. UpdateIncludedFilesMemos(NewTabs, NewHints, NewCloseButtons);
  4546. { Set new tabs, try keep same file open }
  4547. SaveTabIndex := MemosTabSet.TabIndex;
  4548. SaveTabName := MemosTabSet.Tabs[MemosTabSet.TabIndex];
  4549. MemosTabSet.Tabs := NewTabs;
  4550. MemosTabSet.Hints := NewHints;
  4551. MemosTabSet.CloseButtons := NewCloseButtons;
  4552. I := MemosTabSet.Tabs.IndexOf(SaveTabName);
  4553. if I <> -1 then
  4554. MemosTabSet.TabIndex := I;
  4555. if MemosTabSet.TabIndex = SaveTabIndex then begin
  4556. { If TabIndex stayed the same then the tabset won't perform a Click but we need this to make
  4557. sure the right memo is visible - so trigger it ourselves }
  4558. MemosTabSetClick(MemosTabSet);
  4559. end;
  4560. finally
  4561. NewCloseButtons.Free;
  4562. NewHints.Free;
  4563. NewTabs.Free;
  4564. end;
  4565. UpdateMemosTabSetVisibility;
  4566. UpdateBevel1Visibility;
  4567. end;
  4568. procedure TMainForm.MemoUpdateUI(Sender: TObject; Updated: TScintEditUpdates);
  4569. procedure UpdatePendingSquiggly(const AMemo: TIDEScintEdit);
  4570. var
  4571. Pos: Integer;
  4572. Value: Boolean;
  4573. begin
  4574. { Check for the inPendingSquiggly indicator on either side of the caret }
  4575. Pos := AMemo.CaretPosition;
  4576. Value := False;
  4577. if AMemo.CaretVirtualSpace = 0 then begin
  4578. Value := AMemo.GetIndicatorAtPosition(minPendingSquiggly, Pos);
  4579. if not Value and (Pos > 0) then
  4580. Value := AMemo.GetIndicatorAtPosition(minPendingSquiggly, Pos-1);
  4581. end;
  4582. if FOnPendingSquiggly <> Value then begin
  4583. FOnPendingSquiggly := Value;
  4584. { If caret has left a pending squiggly, force restyle of the line }
  4585. if not Value then begin
  4586. { Stop reporting the caret position to the styler (until the next
  4587. Change event) so the token doesn't re-enter pending-squiggly state
  4588. if the caret comes back and something restyles the line }
  4589. AMemo.ReportCaretPositionToStyler := False;
  4590. AMemo.RestyleLine(AMemo.GetLineFromPosition(FPendingSquigglyCaretPos));
  4591. end;
  4592. end;
  4593. FPendingSquigglyCaretPos := Pos;
  4594. end;
  4595. procedure UpdateBraceHighlighting(const AMemo: TIDEScintEdit);
  4596. const
  4597. OpeningBraces: TSysCharSet = ['(', '[', '{', '<'];
  4598. ClosingBraces: TSysCharSet = [')', ']', '}', '>'];
  4599. function HighlightPos(const AMemo: TIDEScintEdit; const CaretPos: Integer;
  4600. const Before: Boolean; const Braces: TSysCharSet): Boolean;
  4601. begin
  4602. var Pos := CaretPos;
  4603. if Before then begin
  4604. if Pos > 0 then
  4605. Pos := AMemo.GetPositionBefore(Pos)
  4606. else
  4607. Exit(False);
  4608. end;
  4609. var C := AMemo.GetByteAtPosition(Pos);
  4610. Result := C in Braces;
  4611. if Result then begin
  4612. var MatchPos := AMemo.GetPositionOfMatchingBrace(Pos);
  4613. if MatchPos >= 0 then
  4614. AMemo.SetBraceHighlighting(Pos, MatchPos)
  4615. else begin
  4616. { Found an unmatched brace: highlight it as bad unless it's an opening
  4617. brace and the caret is at the end of the line }
  4618. var CaretLineEndPos := AMemo.GetLineEndPosition(AMemo.CaretLine);
  4619. if (C in ClosingBraces) or (CaretPos <> CaretLineEndPos) then
  4620. AMemo.SetBraceBadHighlighting(Pos)
  4621. else
  4622. AMemo.SetBraceHighlighting(-1, -1);
  4623. end;
  4624. end;
  4625. end;
  4626. begin
  4627. var Highlighted := False;
  4628. var Section := FMemosStyler.GetSectionFromLineState(AMemo.Lines.State[AMemo.CaretLine]);
  4629. if (Section <> scNone) and (AMemo.CaretVirtualSpace = 0) then begin
  4630. var Pos := AMemo.CaretPosition;
  4631. Highlighted := Highlighted or HighlightPos(AMemo, Pos, False, OpeningBraces);
  4632. Highlighted := Highlighted or HighlightPos(AMemo, Pos, False, ClosingBraces);
  4633. Highlighted := Highlighted or HighlightPos(AMemo, Pos, True, ClosingBraces);
  4634. Highlighted := Highlighted or HighlightPos(AMemo, Pos, True, OpeningBraces);
  4635. end;
  4636. if not Highlighted then
  4637. AMemo.SetBraceHighlighting(-1, -1);
  4638. end;
  4639. begin
  4640. if Updated * [suContent, suSelection] = [] then
  4641. Exit;
  4642. var Memo := Sender as TIDEScintEdit;
  4643. if (Memo = FErrorMemo) and ((FErrorMemo.ErrorLine < 0) or (FErrorMemo.CaretPosition <> FErrorMemo.ErrorCaretPosition)) then
  4644. HideError;
  4645. if Memo = FActiveMemo then begin
  4646. UpdateCaretPosPanelAndBackNavStack;
  4647. UpdateEditModePanel;
  4648. end;
  4649. UpdatePendingSquiggly(Memo);
  4650. UpdateBraceHighlighting(Memo);
  4651. UpdateOccurrenceIndicators(Memo);
  4652. end;
  4653. procedure TMainForm.MemoModifiedChange(Sender: TObject);
  4654. begin
  4655. if Sender = FActiveMemo then
  4656. UpdateModifiedPanel;
  4657. end;
  4658. procedure TMainForm.MemoCallTipArrowClick(Sender: TObject;
  4659. const Up: Boolean);
  4660. begin
  4661. { Based on SciTE 5.50's SciTEBase::Notify SA::Notification::CallTipClick }
  4662. if Up and (FCallTipState.CurrentCallTip > 0) then begin
  4663. Dec(FCallTipState.CurrentCallTip);
  4664. UpdateCallTipFunctionDefinition;
  4665. end else if not Up and (FCallTipState.CurrentCallTip + 1 < FCallTipState.MaxCallTips) then begin
  4666. Inc(FCallTipState.CurrentCallTip);
  4667. UpdateCallTipFunctionDefinition;
  4668. end;
  4669. end;
  4670. procedure TMainForm.MemoChange(Sender: TObject; const Info: TScintEditChangeInfo);
  4671. procedure MemoLinesInsertedOrDeleted(Memo: TIDEScintFileEdit);
  4672. var
  4673. FirstAffectedLine, Line, LinePos: Integer;
  4674. begin
  4675. Line := Memo.GetLineFromPosition(Info.StartPos);
  4676. LinePos := Memo.GetPositionFromLine(Line);
  4677. FirstAffectedLine := Line;
  4678. { If the deletion/insertion does not start on the first character of Line,
  4679. then we consider the first deleted/inserted line to be the following
  4680. line (Line+1). This way, if you press Del at the end of line 1, the dot
  4681. on line 2 is removed, while line 1's dot stays intact. }
  4682. if Info.StartPos > LinePos then
  4683. Inc(Line);
  4684. if Info.LinesDelta > 0 then
  4685. MemoLinesInserted(Memo, Line, Info.LinesDelta)
  4686. else
  4687. MemoLinesDeleted(Memo, Line, -Info.LinesDelta, FirstAffectedLine);
  4688. end;
  4689. var
  4690. Memo: TIDEScintFileEdit;
  4691. begin
  4692. if not (Sender is TIDEScintFileEdit) then
  4693. Exit;
  4694. Memo := TIDEScintFileEdit(Sender);
  4695. if Memo.OpeningFile then
  4696. Exit;
  4697. FModifiedAnySinceLastCompile := True;
  4698. if FDebugging then
  4699. FModifiedAnySinceLastCompileAndGo := True
  4700. else begin
  4701. { Modified while not debugging or opening a file; free the debug info and clear the dots }
  4702. DestroyDebugInfo;
  4703. end;
  4704. if Info.LinesDelta <> 0 then
  4705. MemoLinesInsertedOrDeleted(Memo);
  4706. if Memo = FErrorMemo then begin
  4707. { When the Delete key is pressed, the caret doesn't move, so reset
  4708. FErrorCaretPosition to ensure that OnUpdateUI calls HideError }
  4709. FErrorMemo.ErrorCaretPosition := -1;
  4710. end;
  4711. { The change should trigger restyling. Allow the styler to see the current
  4712. caret position in case it wants to set a pending squiggly indicator. }
  4713. Memo.ReportCaretPositionToStyler := True;
  4714. end;
  4715. function TMainForm.InitiateAutoCompleteOrCallTipAllowedAtPos(const AMemo: TIDEScintEdit;
  4716. const WordStartLinePos, PositionBeforeWordStartPos: Integer): Boolean;
  4717. begin
  4718. Result := (PositionBeforeWordStartPos < WordStartLinePos) or
  4719. not FMemosStyler.IsCommentOrPascalStringStyle(AMemo.GetStyleAtPosition(PositionBeforeWordStartPos));
  4720. end;
  4721. procedure TMainForm.InitiateAutoComplete(const Key: AnsiChar);
  4722. function OnlyWhiteSpaceBeforeWord(const Memo: TIDEScintEdit; const LinePos, WordStartPos: Integer): Boolean;
  4723. var
  4724. I: Integer;
  4725. C: AnsiChar;
  4726. begin
  4727. { Only allow autocompletion if no non-whitespace characters exist before the current word on the line }
  4728. I := WordStartPos;
  4729. Result := False;
  4730. while I > LinePos do begin
  4731. I := FActiveMemo.GetPositionBefore(I);
  4732. if I < LinePos then
  4733. Exit; { shouldn't get here }
  4734. C := FActiveMemo.GetByteAtPosition(I);
  4735. if C > ' ' then
  4736. Exit;
  4737. end;
  4738. Result := True;
  4739. end;
  4740. var
  4741. CaretPos, Line, LinePos, WordStartPos, WordEndPos, CharsBefore,
  4742. LangNamePos: Integer;
  4743. Section: TInnoSetupStylerSection;
  4744. IsParamSection: Boolean;
  4745. WordList: AnsiString;
  4746. FoundSemicolon, FoundFlagsOrType, FoundDot: Boolean;
  4747. C: AnsiChar;
  4748. begin
  4749. if FActiveMemo.AutoCompleteActive or FActiveMemo.ReadOnly then
  4750. Exit;
  4751. if Key = #0 then begin
  4752. { If a character is typed then Scintilla will handle selections but
  4753. otherwise we should empty them and also make sure the caret is visible
  4754. before we start autocompletion }
  4755. FActiveMemo.SetEmptySelections;
  4756. FActiveMemo.ScrollCaretIntoView;
  4757. end;
  4758. CaretPos := FActiveMemo.CaretPosition;
  4759. Line := FActiveMemo.GetLineFromPosition(CaretPos);
  4760. LinePos := FActiveMemo.GetPositionFromLine(Line);
  4761. WordStartPos := FActiveMemo.GetWordStartPosition(CaretPos, True);
  4762. WordEndPos := FActiveMemo.GetWordEndPosition(CaretPos, True);
  4763. CharsBefore := CaretPos - WordStartPos;
  4764. { Don't auto start autocompletion after a character is typed if there are any
  4765. word characters adjacent to the character }
  4766. if Key <> #0 then begin
  4767. if CharsBefore > 1 then
  4768. Exit;
  4769. if WordEndPos > CaretPos then
  4770. Exit;
  4771. end;
  4772. case FActiveMemo.GetByteAtPosition(WordStartPos) of
  4773. '#':
  4774. begin
  4775. if not OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, WordStartPos) then
  4776. Exit;
  4777. WordList := FMemosStyler.ISPPDirectivesWordList;
  4778. FActiveMemo.SetAutoCompleteFillupChars(' ');
  4779. end;
  4780. '{':
  4781. begin
  4782. WordList := FMemosStyler.ConstantsWordList;
  4783. FActiveMemo.SetAutoCompleteFillupChars('\:');
  4784. end;
  4785. '[':
  4786. begin
  4787. if not OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, WordStartPos) then
  4788. Exit;
  4789. WordList := FMemosStyler.SectionsWordList;
  4790. FActiveMemo.SetAutoCompleteFillupChars('');
  4791. end;
  4792. else
  4793. begin
  4794. Section := FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[Line]);
  4795. if Section = scCode then begin
  4796. { Space can only initiate autocompletion after non whitespace }
  4797. if (Key = ' ') and OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, WordStartPos) then
  4798. Exit;
  4799. var PositionBeforeWordStartPos := FActiveMemo.GetPositionBefore(WordStartPos);
  4800. if Key <> #0 then begin
  4801. FActiveMemo.StyleNeeded(PositionBeforeWordStartPos); { Make sure the typed character has been styled }
  4802. if not InitiateAutoCompleteOrCallTipAllowedAtPos(FActiveMemo, LinePos, PositionBeforeWordStartPos) then
  4803. Exit;
  4804. end;
  4805. WordList := '';
  4806. { Autocomplete event functions if the current word on the line has
  4807. exactly 1 space before it which has the word 'function' or
  4808. 'procedure' before it which has only whitespace before it }
  4809. if (PositionBeforeWordStartPos >= LinePos) and (FActiveMemo.GetByteAtPosition(PositionBeforeWordStartPos) <= ' ') then begin
  4810. var FunctionWordEndPos := PositionBeforeWordStartPos;
  4811. var FunctionWordStartPos := FActiveMemo.GetWordStartPosition(FunctionWordEndPos, True);
  4812. if OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, FunctionWordStartPos) then begin
  4813. var FunctionWord := FActiveMemo.GetTextRange(FunctionWordStartPos, FunctionWordEndPos);
  4814. if SameText(FunctionWord, 'procedure') then
  4815. WordList := FMemosStyler.EventFunctionsWordList[True]
  4816. else if SameText(FunctionWord, 'function') then
  4817. WordList := FMemosStyler.EventFunctionsWordList[False];
  4818. if WordList <> '' then
  4819. FActiveMemo.SetAutoCompleteFillupChars('');
  4820. end;
  4821. end;
  4822. { If no event function was found then autocomplete script functions,
  4823. types, etc if the current word has no dot before it }
  4824. if WordList = '' then begin
  4825. var ClassOrRecordMember := (PositionBeforeWordStartPos >= LinePos) and (FActiveMemo.GetByteAtPosition(PositionBeforeWordStartPos) = '.');
  4826. WordList := FMemosStyler.ScriptWordList[ClassOrRecordMember];
  4827. FActiveMemo.SetAutoCompleteFillupChars('');
  4828. end;
  4829. if WordList = '' then
  4830. Exit;
  4831. end else begin
  4832. IsParamSection := FMemosStyler.IsParamSection(Section);
  4833. { Autocomplete if the current word on the line has only whitespace
  4834. before it, or else also: after the last ';' or after 'Flags:' or
  4835. 'Type:' in parameterized sections }
  4836. FoundSemicolon := False;
  4837. FoundFlagsOrType := False;
  4838. FoundDot := False;
  4839. var I := WordStartPos;
  4840. while I > LinePos do begin
  4841. I := FActiveMemo.GetPositionBefore(I);
  4842. if I < LinePos then
  4843. Exit; { shouldn't get here }
  4844. C := FActiveMemo.GetByteAtPosition(I);
  4845. if IsParamSection and (C in [';', ':']) and
  4846. FMemosStyler.IsSymbolStyle(FActiveMemo.GetStyleAtPosition(I)) then begin { Make sure it's an stSymbol ';' or ':' and not one inside a quoted string }
  4847. FoundSemicolon := C = ';';
  4848. if not FoundSemicolon then begin
  4849. var ParameterWordEndPos := I;
  4850. var ParameterWordStartPos := FActiveMemo.GetWordStartPosition(ParameterWordEndPos, True);
  4851. var ParameterWord := FActiveMemo.GetTextRange(ParameterWordStartPos, ParameterWordEndPos);
  4852. FoundFlagsOrType := SameText(ParameterWord, 'Flags') or
  4853. ((Section in [scInstallDelete, scUninstallDelete]) and SameText(ParameterWord, 'Type'));
  4854. end else
  4855. FoundFlagsOrType := False;
  4856. if FoundSemicolon or FoundFlagsOrType then
  4857. Break;
  4858. end;
  4859. if (Section = scLangOptions) and (C = '.') and not FoundDot then begin
  4860. { Verify that a word (language name) precedes the '.', then check for
  4861. any non-whitespace characters before the word }
  4862. LangNamePos := FActiveMemo.GetWordStartPosition(I, True);
  4863. if LangNamePos >= I then
  4864. Exit;
  4865. I := LangNamePos;
  4866. FoundDot := True;
  4867. end else if C > ' ' then begin
  4868. if IsParamSection and not (Section in [scInstallDelete, scUninstallDelete]) and
  4869. (FMemosStyler.FlagsWordList[Section] <> '') then begin
  4870. { Verify word before the current word (or before that when we get here again) is
  4871. a valid flag and if so, continue looking before it instead of stopping }
  4872. var FlagEndPos := FActiveMemo.GetWordEndPosition(I, True);
  4873. var FlagStartPos := FActiveMemo.GetWordStartPosition(I, True);
  4874. var FlagWord := FActiveMemo.GetTextRange(FlagStartPos, FlagEndPos);
  4875. if FMemosStyler.SectionHasFlag(Section, FlagWord) then
  4876. I := FlagStartPos
  4877. else
  4878. Exit;
  4879. end else
  4880. Exit;
  4881. end;
  4882. end;
  4883. { Space can only initiate autocompletion after ';' or 'Flags:' or 'Type:' in parameterized sections }
  4884. if (Key = ' ') and not (FoundSemicolon or FoundFlagsOrType) then
  4885. Exit;
  4886. if FoundFlagsOrType then begin
  4887. WordList := FMemosStyler.FlagsWordList[Section];
  4888. if WordList = '' then
  4889. Exit;
  4890. FActiveMemo.SetAutoCompleteFillupChars(' ');
  4891. end else begin
  4892. WordList := FMemosStyler.KeywordsWordList[Section];
  4893. if WordList = '' then { CustomMessages }
  4894. Exit;
  4895. if IsParamSection then
  4896. FActiveMemo.SetAutoCompleteFillupChars(':')
  4897. else
  4898. FActiveMemo.SetAutoCompleteFillupChars('=');
  4899. end;
  4900. end;
  4901. end;
  4902. end;
  4903. FActiveMemo.ShowAutoComplete(CharsBefore, WordList);
  4904. end;
  4905. procedure TMainForm.UpdateCallTipFunctionDefinition(const Pos: Integer { = -1 });
  4906. begin
  4907. { Based on SciTE 5.50's SciTEBase::FillFunctionDefinition }
  4908. if Pos > 0 then
  4909. FCallTipState.LastPosCallTip := Pos;
  4910. // Should get current api definition
  4911. var FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(FCallTipState.ClassOrRecordMember, FCallTipState.CurrentCallTipWord, FCallTipState.CurrentCallTip, FCallTipState.MaxCallTips);
  4912. if ((FCallTipState.MaxCallTips = 1) and FunctionDefinition.HasParams) or //if there's a single definition then only show if it has a parameter
  4913. (FCallTipState.MaxCallTips > 1) then begin //if there's multiple then show always just like MemoHintShow, so even the one without parameters if it exists
  4914. FCallTipState.FunctionDefinition := FunctionDefinition.ScriptFuncWithoutHeader;
  4915. if FCallTipState.MaxCallTips > 1 then
  4916. FCallTipState.FunctionDefinition := AnsiString(Format(#1'%d of %d'#2'%s', [FCallTipState.CurrentCallTip+1, FCallTipState.MaxCallTips, FCallTipState.FunctionDefinition]));
  4917. FActiveMemo.ShowCallTip(FCallTipState.LastPosCallTip - Length(FCallTipState.CurrentCallTipWord), FCallTipState.FunctionDefinition);
  4918. ContinueCallTip;
  4919. end;
  4920. end;
  4921. procedure TMainForm.InitiateCallTip(const Key: AnsiChar);
  4922. begin
  4923. var Pos := FActiveMemo.CaretPosition;
  4924. if (FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.GetLineFromPosition(Pos)]) <> scCode) or
  4925. ((Key <> #0) and not InitiateAutoCompleteOrCallTipAllowedAtPos(FActiveMemo,
  4926. FActiveMemo.GetPositionFromLine(FActiveMemo.GetLineFromPosition(Pos)),
  4927. FActiveMemo.GetPositionBefore(Pos))) then
  4928. Exit;
  4929. { Based on SciTE 5.50's SciTEBase::StartAutoComplete }
  4930. FCallTipState.CurrentCallTip := 0;
  4931. FCallTipState.CurrentCallTipWord := '';
  4932. var Line := FActiveMemo.CaretLineText;
  4933. var Current := FActiveMemo.CaretPositionInLine;
  4934. var CallTipWordCharacters := FActiveMemo.WordCharsAsSet;
  4935. {$ZEROBASEDSTRINGS ON}
  4936. repeat
  4937. var Braces := 0;
  4938. while ((Current > 0) and ((Braces <> 0) or not (Line[Current-1] = '('))) do begin
  4939. if Line[Current-1] = '(' then
  4940. Dec(Braces)
  4941. else if Line[Current-1] = ')' then
  4942. Inc(Braces);
  4943. Dec(Current);
  4944. Dec(Pos);
  4945. end;
  4946. if Current > 0 then begin
  4947. Dec(Current);
  4948. Dec(Pos);
  4949. end else
  4950. Break;
  4951. while (Current > 0) and (Line[Current-1] <= ' ') do begin
  4952. Dec(Current);
  4953. Dec(Pos);
  4954. end
  4955. until not ((Current > 0) and not CharInSet(Line[Current-1], CallTipWordCharacters));
  4956. {$ZEROBASEDSTRINGS OFF}
  4957. if Current <= 0 then
  4958. Exit;
  4959. FCallTipState.StartCallTipWord := Current - 1;
  4960. {$ZEROBASEDSTRINGS ON}
  4961. while (FCallTipState.StartCallTipWord > 0) and CharInSet(Line[FCallTipState.StartCallTipWord-1], CallTipWordCharacters) do
  4962. Dec(FCallTipState.StartCallTipWord);
  4963. FCallTipState.ClassOrRecordMember := (FCallTipState.StartCallTipWord > 0) and (Line[FCallTipState.StartCallTipWord-1] = '.');
  4964. {$ZEROBASEDSTRINGS OFF}
  4965. SetLength(Line, Current);
  4966. FCallTipState.CurrentCallTipWord := Line.Substring(FCallTipState.StartCallTipWord); { Substring is zero-based }
  4967. FCallTipState.FunctionDefinition := '';
  4968. UpdateCallTipFunctionDefinition(Pos);
  4969. end;
  4970. procedure TMainForm.ContinueCallTip;
  4971. begin
  4972. { Based on SciTE 5.50's SciTEBase::ContinueCallTip }
  4973. var Line := FActiveMemo.CaretLineText;
  4974. var Current := FActiveMemo.CaretPositionInLine;
  4975. var Braces := 0;
  4976. var Commas := 0;
  4977. for var I := FCallTipState.StartCallTipWord to Current-1 do begin
  4978. {$ZEROBASEDSTRINGS ON}
  4979. if CharInSet(Line[I], ['(', '[']) then
  4980. Inc(Braces)
  4981. else if CharInSet(Line[I], [')', ']']) and (Braces > 0) then
  4982. Dec(Braces)
  4983. else if (Braces = 1) and (Line[I] = ',') then
  4984. Inc(Commas);
  4985. {$ZEROBASEDSTRINGS OFF}
  4986. end;
  4987. {$ZEROBASEDSTRINGS ON}
  4988. var StartHighlight := 0;
  4989. var FunctionDefinition := FCallTipState.FunctionDefinition;
  4990. var FunctionDefinitionLength := Length(FunctionDefinition);
  4991. while (StartHighlight < FunctionDefinitionLength) and not (FunctionDefinition[StartHighlight] = '(') do
  4992. Inc(StartHighlight);
  4993. if (StartHighlight < FunctionDefinitionLength) and (FunctionDefinition[StartHighlight] = '(') then
  4994. Inc(StartHighlight);
  4995. while (StartHighlight < FunctionDefinitionLength) and (Commas > 0) do begin
  4996. if FunctionDefinition[StartHighlight] in [',', ';'] then
  4997. Dec(Commas);
  4998. // If it reached the end of the argument list it means that the user typed in more
  4999. // arguments than the ones listed in the calltip
  5000. if FunctionDefinition[StartHighlight] = ')' then
  5001. Commas := 0
  5002. else
  5003. Inc(StartHighlight);
  5004. end;
  5005. if (StartHighlight < FunctionDefinitionLength) and (FunctionDefinition[StartHighlight] in [',', ';']) then
  5006. Inc(StartHighlight);
  5007. var EndHighlight := StartHighlight;
  5008. while (EndHighlight < FunctionDefinitionLength) and not (FunctionDefinition[EndHighlight] in [',', ';']) and not (FunctionDefinition[EndHighlight] = ')') do
  5009. Inc(EndHighlight);
  5010. {$ZEROBASEDSTRINGS OFF}
  5011. FActiveMemo.SetCallTipHighlight(StartHighlight, EndHighlight);
  5012. end;
  5013. procedure TMainForm.MemoCharAdded(Sender: TObject; Ch: AnsiChar);
  5014. function LineIsBlank(const Line: Integer): Boolean;
  5015. begin
  5016. var S := FActiveMemo.Lines.RawLines[Line];
  5017. Result := TScintEdit.RawStringIsBlank(S);
  5018. end;
  5019. var
  5020. NewLine, PreviousLine, NewIndent, PreviousIndent: Integer;
  5021. begin
  5022. if FOptions.AutoIndent and (Ch = FActiveMemo.LineEndingString[Length(FActiveMemo.LineEndingString)]) then begin
  5023. { Add to the new line any (remaining) indentation from the previous line }
  5024. NewLine := FActiveMemo.CaretLine;
  5025. PreviousLine := NewLine-1;
  5026. if PreviousLine >= 0 then begin
  5027. NewIndent := FActiveMemo.GetLineIndentation(NewLine);
  5028. { If no indentation was moved from the previous line to the new line
  5029. (i.e., there are no spaces/tabs directly to the right of the new
  5030. caret position), and the previous line is completely empty (0 length),
  5031. then use the indentation from the last line containing non-space
  5032. characters. }
  5033. if (NewIndent = 0) and (FActiveMemo.Lines.RawLineLengths[PreviousLine] = 0) then begin
  5034. Dec(PreviousLine);
  5035. while (PreviousLine >= 0) and LineIsBlank(PreviousLine) do
  5036. Dec(PreviousLine);
  5037. end;
  5038. if PreviousLine >= 0 then begin
  5039. PreviousIndent := FActiveMemo.GetLineIndentation(PreviousLine);
  5040. FActiveMemo.SetLineIndentation(NewLine, NewIndent + PreviousIndent);
  5041. FActiveMemo.CaretPosition := FActiveMemo.GetPositionFromLineExpandedColumn(NewLine,
  5042. PreviousIndent);
  5043. end;
  5044. end;
  5045. end;
  5046. { Based on SciTE 5.50's SciTEBase::CharAdded but with an altered interaction
  5047. between calltips and autocomplete }
  5048. var DoAutoComplete := False;
  5049. if FActiveMemo.CallTipActive then begin
  5050. if Ch = ')' then begin
  5051. Dec(FCallTipState.BraceCount);
  5052. if FCallTipState.BraceCount < 1 then
  5053. FActiveMemo.CancelCallTip
  5054. else if FOptions.AutoCallTips then
  5055. InitiateCallTip(Ch);
  5056. end else if Ch = '(' then begin
  5057. Inc(FCallTipState.BraceCount);
  5058. if FOptions.AutoCallTips then
  5059. InitiateCallTip(Ch);
  5060. end else
  5061. ContinueCallTip;
  5062. end else if FActiveMemo.AutoCompleteActive then begin
  5063. if Ch = '(' then begin
  5064. Inc(FCallTipState.BraceCount);
  5065. if FOptions.AutoCallTips then begin
  5066. InitiateCallTip(Ch);
  5067. if not FActiveMemo.CallTipActive then begin
  5068. { Normally the calltip activation means any active autocompletion gets
  5069. cancelled by Scintilla but if the current word has no call tip then
  5070. we should make sure ourselves that the added brace still cancels
  5071. the currently active autocompletion }
  5072. DoAutoComplete := True;
  5073. end;
  5074. end;
  5075. end else if Ch = ')' then
  5076. Dec(FCallTipState.BraceCount)
  5077. else
  5078. DoAutoComplete := True;
  5079. end else if Ch = '(' then begin
  5080. FCallTipState.BraceCount := 1;
  5081. if FOptions.AutoCallTips then
  5082. InitiateCallTip(Ch);
  5083. end else
  5084. DoAutoComplete := True;
  5085. if DoAutoComplete then begin
  5086. case Ch of
  5087. 'A'..'Z', 'a'..'z', '_', '#', '{', '[', '<', '0'..'9':
  5088. if not FActiveMemo.AutoCompleteActive and FOptions.AutoAutoComplete and not (Ch in ['0'..'9']) then
  5089. InitiateAutoComplete(Ch);
  5090. else
  5091. var RestartAutoComplete := (Ch in [' ', '.']) and
  5092. (FOptions.AutoAutoComplete or FActiveMemo.AutoCompleteActive);
  5093. FActiveMemo.CancelAutoComplete;
  5094. if RestartAutoComplete then
  5095. InitiateAutoComplete(Ch);
  5096. end;
  5097. end;
  5098. end;
  5099. procedure TMainForm.MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
  5100. function GetCodeVariableDebugEntryFromFileLineCol(FileIndex, Line, Col: Integer; out DebugEntry: PVariableDebugEntry): Boolean;
  5101. var
  5102. I: Integer;
  5103. begin
  5104. { FVariableDebugEntries uses 1-based line and column numbers }
  5105. Inc(Line);
  5106. Inc(Col);
  5107. Result := False;
  5108. for I := 0 to FVariableDebugEntriesCount-1 do begin
  5109. if (FVariableDebugEntries[I].FileIndex = FileIndex) and
  5110. (FVariableDebugEntries[I].LineNumber = Line) and
  5111. (FVariableDebugEntries[I].Col = Col) then begin
  5112. DebugEntry := @FVariableDebugEntries[I];
  5113. Result := True;
  5114. Break;
  5115. end;
  5116. end;
  5117. end;
  5118. function GetCodeColumnFromPosition(const Pos: Integer): Integer;
  5119. var
  5120. LinePos: Integer;
  5121. S: TScintRawString;
  5122. U: String;
  5123. begin
  5124. { [Code] lines get converted from the editor's UTF-8 to UTF-16 Strings when
  5125. passed to the compiler. This can lead to column number discrepancies
  5126. between Scintilla and ROPS. This code simulates the conversion to try to
  5127. find out where ROPS thinks a Pos resides. }
  5128. LinePos := FActiveMemo.GetPositionFromLine(FActiveMemo.GetLineFromPosition(Pos));
  5129. S := FActiveMemo.GetRawTextRange(LinePos, Pos);
  5130. U := FActiveMemo.ConvertRawStringToString(S);
  5131. Result := Length(U);
  5132. end;
  5133. function FindVarOrFuncRange(const Pos: Integer): TScintRange;
  5134. begin
  5135. { Note: The GetPositionAfter is needed so that when the mouse is over a '.'
  5136. between two words, it won't match the word to the left of the '.' }
  5137. FActiveMemo.SetDefaultWordChars;
  5138. Result.StartPos := FActiveMemo.GetWordStartPosition(FActiveMemo.GetPositionAfter(Pos), True);
  5139. Result.EndPos := FActiveMemo.GetWordEndPosition(Pos, True);
  5140. end;
  5141. function FindConstRange(const Pos: Integer): TScintRange;
  5142. var
  5143. BraceLevel, ConstStartPos, Line, LineEndPos, I: Integer;
  5144. C: AnsiChar;
  5145. begin
  5146. Result.StartPos := 0;
  5147. Result.EndPos := 0;
  5148. BraceLevel := 0;
  5149. ConstStartPos := -1;
  5150. Line := FActiveMemo.GetLineFromPosition(Pos);
  5151. LineEndPos := FActiveMemo.GetLineEndPosition(Line);
  5152. I := FActiveMemo.GetPositionFromLine(Line);
  5153. while I < LineEndPos do begin
  5154. if (I > Pos) and (BraceLevel = 0) then
  5155. Break;
  5156. C := FActiveMemo.GetByteAtPosition(I);
  5157. if C = '{' then begin
  5158. if FActiveMemo.GetByteAtPosition(I + 1) = '{' then
  5159. Inc(I)
  5160. else begin
  5161. if BraceLevel = 0 then
  5162. ConstStartPos := I;
  5163. Inc(BraceLevel);
  5164. end;
  5165. end
  5166. else if (C = '}') and (BraceLevel > 0) then begin
  5167. Dec(BraceLevel);
  5168. if (BraceLevel = 0) and (ConstStartPos <> -1) then begin
  5169. if (Pos >= ConstStartPos) and (Pos <= I) then begin
  5170. Result.StartPos := ConstStartPos;
  5171. Result.EndPos := I + 1;
  5172. Exit;
  5173. end;
  5174. ConstStartPos := -1;
  5175. end;
  5176. end;
  5177. I := FActiveMemo.GetPositionAfter(I);
  5178. end;
  5179. end;
  5180. procedure UpdateInfo(var Info: TScintHintInfo; const HintStr: String; const Range: TScintRange; const Memo: TIDEScintEdit);
  5181. begin
  5182. Info.HintStr := HintStr;
  5183. Info.CursorRect.TopLeft := Memo.GetPointFromPosition(Range.StartPos);
  5184. Info.CursorRect.BottomRight := Memo.GetPointFromPosition(Range.EndPos);
  5185. Info.CursorRect.Bottom := Info.CursorRect.Top + Memo.LineHeight;
  5186. Info.HideTimeout := High(Integer); { infinite }
  5187. end;
  5188. begin
  5189. var Pos := FActiveMemo.GetPositionFromPoint(Info.CursorPos, True, True);
  5190. if Pos < 0 then
  5191. Exit;
  5192. var Line := FActiveMemo.GetLineFromPosition(Pos);
  5193. { Check if cursor is over a [Code] variable or function }
  5194. if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[Line]) = scCode then begin
  5195. var VarOrFuncRange := FindVarOrFuncRange(Pos);
  5196. if VarOrFuncRange.EndPos > VarOrFuncRange.StartPos then begin
  5197. var HintStr := '';
  5198. var DebugEntry: PVariableDebugEntry;
  5199. if (FActiveMemo is TIDEScintFileEdit) and (FDebugClientWnd <> 0) and
  5200. GetCodeVariableDebugEntryFromFileLineCol((FActiveMemo as TIDEScintFileEdit).CompilerFileIndex,
  5201. Line, GetCodeColumnFromPosition(VarOrFuncRange.StartPos), DebugEntry) then begin
  5202. var Output: String;
  5203. case EvaluateVariableEntry(DebugEntry, Output) of
  5204. 1: HintStr := Output;
  5205. 2: HintStr := Output;
  5206. else
  5207. HintStr := 'Unknown error';
  5208. end;
  5209. end else begin
  5210. var ClassMember := False;
  5211. var Name := FActiveMemo.GetTextRange(VarOrFuncRange.StartPos, VarOrFuncRange.EndPos);
  5212. var Index := 0;
  5213. var Count: Integer;
  5214. var FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index, Count);
  5215. if Count = 0 then begin
  5216. ClassMember := not ClassMember;
  5217. FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index, Count);
  5218. end;
  5219. while Index < Count do begin
  5220. if Index <> 0 then
  5221. FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index);
  5222. if HintStr <> '' then
  5223. HintStr := HintStr + #13;
  5224. if FunctionDefinition.WasFunction then
  5225. HintStr := HintStr + 'function '
  5226. else
  5227. HintStr := HintStr + 'procedure ';
  5228. HintStr := HintStr + String(FunctionDefinition.ScriptFuncWithoutHeader);
  5229. Inc(Index);
  5230. end;
  5231. end;
  5232. if HintStr <> '' then begin
  5233. UpdateInfo(Info, HintStr, VarOrFuncRange, FActiveMemo);
  5234. Exit;
  5235. end;
  5236. end;
  5237. end;
  5238. if FDebugClientWnd <> 0 then begin
  5239. { Check if cursor is over a constant }
  5240. var ConstRange := FindConstRange(Pos);
  5241. if ConstRange.EndPos > ConstRange.StartPos then begin
  5242. var HintStr := FActiveMemo.GetTextRange(ConstRange.StartPos, ConstRange.EndPos);
  5243. var Output: String;
  5244. case EvaluateConstant(Info.HintStr, Output) of
  5245. 1: HintStr := HintStr + ' = "' + Output + '"';
  5246. 2: HintStr := HintStr + ' = Exception: ' + Output;
  5247. else
  5248. HintStr := HintStr + ' = Unknown error';
  5249. end;
  5250. UpdateInfo(Info, HintStr, ConstRange, FActiveMemo);
  5251. end;
  5252. end;
  5253. end;
  5254. procedure TMainForm.MainMemoDropFiles(Sender: TObject; X, Y: Integer;
  5255. AFiles: TStrings);
  5256. begin
  5257. if (AFiles.Count > 0) and ConfirmCloseFile(True) then
  5258. OpenFile(FMainMemo, AFiles[0], True);
  5259. end;
  5260. procedure TMainForm.MemoZoom(Sender: TObject);
  5261. begin
  5262. if not FSynchingZoom then begin
  5263. FSynchingZoom := True;
  5264. try
  5265. for var Memo in FMemos do
  5266. if Memo <> Sender then
  5267. Memo.Zoom := (Sender as TScintEdit).Zoom;
  5268. finally
  5269. FSynchingZoom := False;
  5270. end;
  5271. end;
  5272. end;
  5273. procedure TMainForm.StatusBarResize(Sender: TObject);
  5274. begin
  5275. { Without this, on Windows XP with themes, the status bar's size grip gets
  5276. corrupted as the form is resized }
  5277. if StatusBar.HandleAllocated then
  5278. InvalidateRect(StatusBar.Handle, nil, True);
  5279. end;
  5280. procedure TMainForm.WMDebuggerQueryVersion(var Message: TMessage);
  5281. begin
  5282. Message.Result := FCompilerVersion.BinVersion;
  5283. end;
  5284. procedure TMainForm.WMDebuggerHello(var Message: TMessage);
  5285. var
  5286. PID: DWORD;
  5287. WantCodeText: Boolean;
  5288. begin
  5289. FDebugClientWnd := HWND(Message.WParam);
  5290. { Save debug client process handle }
  5291. if FDebugClientProcessHandle <> 0 then begin
  5292. { Shouldn't get here, but just in case, don't leak a handle }
  5293. CloseHandle(FDebugClientProcessHandle);
  5294. FDebugClientProcessHandle := 0;
  5295. end;
  5296. PID := 0;
  5297. if GetWindowThreadProcessId(FDebugClientWnd, @PID) <> 0 then
  5298. FDebugClientProcessHandle := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE,
  5299. False, PID);
  5300. WantCodeText := Bool(Message.LParam);
  5301. if WantCodeText then
  5302. SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeTextA, FCompiledCodeText);
  5303. SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeDebugInfoA, FCompiledCodeDebugInfo);
  5304. UpdateRunMenu;
  5305. end;
  5306. procedure TMainForm.WMDebuggerGoodbye(var Message: TMessage);
  5307. begin
  5308. ReplyMessage(0);
  5309. DebuggingStopped(True);
  5310. end;
  5311. procedure TMainForm.GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TIDEScintFileEdit; var DebugEntry: PDebugEntry);
  5312. function GetMemoFromDebugEntryFileIndex(const FileIndex: Integer): TIDEScintFileEdit;
  5313. var
  5314. Memo: TIDEScintFileEdit;
  5315. begin
  5316. Result := nil;
  5317. if FOptions.OpenIncludedFiles then begin
  5318. for Memo in FFileMemos do begin
  5319. if Memo.Used and (Memo.CompilerFileIndex = FileIndex) then begin
  5320. Result := Memo;
  5321. Exit;
  5322. end;
  5323. end;
  5324. end else if FMainMemo.CompilerFileIndex = FileIndex then
  5325. Result := FMainMemo;
  5326. end;
  5327. var
  5328. I: Integer;
  5329. begin
  5330. for I := 0 to FDebugEntriesCount-1 do begin
  5331. if (FDebugEntries[I].Kind = Kind) and (FDebugEntries[I].Index = Index) then begin
  5332. Memo := GetMemoFromDebugEntryFileIndex(FDebugEntries[I].FileIndex);
  5333. DebugEntry := @FDebugEntries[I];
  5334. Exit;
  5335. end;
  5336. end;
  5337. Memo := nil;
  5338. DebugEntry := nil;
  5339. end;
  5340. procedure TMainForm.BringToForeground;
  5341. { Brings our top window to the foreground. Called when pausing while
  5342. debugging. }
  5343. var
  5344. TopWindow: HWND;
  5345. begin
  5346. TopWindow := GetThreadTopWindow;
  5347. if TopWindow <> 0 then begin
  5348. { First ask the debug client to call SetForegroundWindow() on our window.
  5349. If we don't do this then Windows (98/2000+) will prevent our window from
  5350. becoming activated if the debug client is currently in the foreground. }
  5351. SendMessage(FDebugClientWnd, WM_DebugClient_SetForegroundWindow,
  5352. WPARAM(TopWindow), 0);
  5353. { Now call SetForegroundWindow() ourself. Why? When a remote thread calls
  5354. SetForegroundWindow(), the request is queued; the window doesn't actually
  5355. become active until the next time the window's thread checks the message
  5356. queue. This call causes the window to become active immediately. }
  5357. SetForegroundWindow(TopWindow);
  5358. end;
  5359. end;
  5360. procedure TMainForm.DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
  5361. var
  5362. Memo: TIDEScintFileEdit;
  5363. DebugEntry: PDebugEntry;
  5364. LineNumber: Integer;
  5365. begin
  5366. GetMemoAndDebugEntryFromMessage(Message.WParam, Message.LParam, Memo, DebugEntry);
  5367. if (Memo = nil) or (DebugEntry = nil) then
  5368. Exit;
  5369. LineNumber := DebugEntry.LineNumber;
  5370. if LineNumber < 0 then { UninstExe has a DebugEntry but not a line number }
  5371. Exit;
  5372. if (LineNumber < Memo.LineStateCount) and
  5373. (Memo.LineState[LineNumber] <> lnEntryProcessed) then begin
  5374. Memo.LineState[LineNumber] := lnEntryProcessed;
  5375. UpdateLineMarkers(Memo, LineNumber);
  5376. end;
  5377. if (FStepMode = smStepOut) and DebugEntry.StepOutMarker then
  5378. FStepMode := smStepInto { Pause on next line }
  5379. else if (FStepMode = smStepInto) or
  5380. ((FStepMode = smStepOver) and not Intermediate) or
  5381. ((FStepMode = smRunToCursor) and
  5382. (FRunToCursorPoint.Kind = Integer(Message.WParam)) and
  5383. (FRunToCursorPoint.Index = Message.LParam)) or
  5384. (Memo.BreakPoints.IndexOf(LineNumber) <> -1) then begin
  5385. MoveCaretAndActivateMemo(Memo, LineNumber, True);
  5386. HideError;
  5387. SetStepLine(Memo, LineNumber);
  5388. BringToForeground;
  5389. { Tell Setup to pause }
  5390. Message.Result := 1;
  5391. FPaused := True;
  5392. FPausedAtCodeLine := DebugEntry.Kind = Ord(deCodeLine);
  5393. UpdateRunMenu;
  5394. UpdateCaption;
  5395. end;
  5396. end;
  5397. procedure TMainForm.WMDebuggerStepped(var Message: TMessage);
  5398. begin
  5399. DebuggerStepped(Message, False);
  5400. end;
  5401. procedure TMainForm.WMDebuggerSteppedIntermediate(var Message: TMessage);
  5402. begin
  5403. DebuggerStepped(Message, True);
  5404. end;
  5405. procedure TMainForm.WMDPIChanged(var Message: TMessage);
  5406. begin
  5407. inherited;
  5408. for var Memo in FMemos do
  5409. Memo.DPIChanged(Message);
  5410. end;
  5411. procedure TMainForm.WMDebuggerException(var Message: TMessage);
  5412. var
  5413. Memo: TIDEScintFileEdit;
  5414. DebugEntry: PDebugEntry;
  5415. LineNumber: Integer;
  5416. S: String;
  5417. begin
  5418. if FOptions.PauseOnDebuggerExceptions then begin
  5419. GetMemoAndDebugEntryFromMessage(Message.WParam, Message.LParam, Memo, DebugEntry);
  5420. if DebugEntry <> nil then
  5421. LineNumber := DebugEntry.LineNumber
  5422. else
  5423. LineNumber := -1;
  5424. if (Memo <> nil) and (LineNumber >= 0) then begin
  5425. MoveCaretAndActivateMemo(Memo, LineNumber, True);
  5426. SetStepLine(Memo, -1);
  5427. SetErrorLine(Memo, LineNumber);
  5428. end;
  5429. BringToForeground;
  5430. { Tell Setup to pause }
  5431. Message.Result := 1;
  5432. FPaused := True;
  5433. FPausedAtCodeLine := (DebugEntry <> nil) and (DebugEntry.Kind = Ord(deCodeLine));
  5434. UpdateRunMenu;
  5435. UpdateCaption;
  5436. ReplyMessage(Message.Result); { so that Setup enters a paused state now }
  5437. if LineNumber >= 0 then begin
  5438. S := Format('Line %d:' + SNewLine + '%s.', [LineNumber + 1, FDebuggerException]);
  5439. if (Memo <> nil) and (Memo.Filename <> '') then
  5440. S := Memo.Filename + SNewLine2 + S;
  5441. MsgBox(S, 'Runtime Error', mbCriticalError, mb_Ok)
  5442. end else
  5443. MsgBox(FDebuggerException + '.', 'Runtime Error', mbCriticalError, mb_Ok);
  5444. end;
  5445. end;
  5446. procedure TMainForm.WMDebuggerSetForegroundWindow(var Message: TMessage);
  5447. begin
  5448. SetForegroundWindow(HWND(Message.WParam));
  5449. end;
  5450. procedure TMainForm.WMDebuggerCallStackCount(var Message: TMessage);
  5451. begin
  5452. FCallStackCount := Message.WParam;
  5453. end;
  5454. procedure TMainForm.WMCopyData(var Message: TWMCopyData);
  5455. var
  5456. S: String;
  5457. begin
  5458. case Message.CopyDataStruct.dwData of
  5459. CD_Debugger_ReplyW: begin
  5460. FReplyString := '';
  5461. SetString(FReplyString, PChar(Message.CopyDataStruct.lpData),
  5462. Message.CopyDataStruct.cbData div SizeOf(Char));
  5463. Message.Result := 1;
  5464. end;
  5465. CD_Debugger_ExceptionW: begin
  5466. SetString(FDebuggerException, PChar(Message.CopyDataStruct.lpData),
  5467. Message.CopyDataStruct.cbData div SizeOf(Char));
  5468. Message.Result := 1;
  5469. end;
  5470. CD_Debugger_UninstExeW: begin
  5471. SetString(FUninstExe, PChar(Message.CopyDataStruct.lpData),
  5472. Message.CopyDataStruct.cbData div sizeOf(Char));
  5473. Message.Result := 1;
  5474. end;
  5475. CD_Debugger_LogMessageW: begin
  5476. SetString(S, PChar(Message.CopyDataStruct.lpData),
  5477. Message.CopyDataStruct.cbData div SizeOf(Char));
  5478. DebugLogMessage(S);
  5479. Message.Result := 1;
  5480. end;
  5481. CD_Debugger_TempDirW: begin
  5482. { Paranoia: Store it in a local variable first. That way, if there's
  5483. a problem reading the string FTempDir will be left unmodified.
  5484. Gotta be extra careful when storing a path we'll be deleting. }
  5485. SetString(S, PChar(Message.CopyDataStruct.lpData),
  5486. Message.CopyDataStruct.cbData div SizeOf(Char));
  5487. { Extreme paranoia: If there are any embedded nulls, discard it. }
  5488. if Pos(#0, S) <> 0 then
  5489. S := '';
  5490. FTempDir := S;
  5491. Message.Result := 1;
  5492. end;
  5493. CD_Debugger_CallStackW: begin
  5494. SetString(S, PChar(Message.CopyDataStruct.lpData),
  5495. Message.CopyDataStruct.cbData div SizeOf(Char));
  5496. DebugShowCallStack(S, FCallStackCount);
  5497. end;
  5498. end;
  5499. end;
  5500. function TMainForm.DestroyLineState(const AMemo: TIDEScintFileEdit): Boolean;
  5501. begin
  5502. if Assigned(AMemo.LineState) then begin
  5503. AMemo.LineStateCapacity := 0;
  5504. AMemo.LineStateCount := 0;
  5505. FreeMem(AMemo.LineState);
  5506. AMemo.LineState := nil;
  5507. Result := True;
  5508. end else
  5509. Result := False;
  5510. end;
  5511. procedure TMainForm.DestroyDebugInfo;
  5512. var
  5513. HadDebugInfo: Boolean;
  5514. Memo: TIDEScintFileEdit;
  5515. begin
  5516. HadDebugInfo := False;
  5517. for Memo in FFileMemos do
  5518. if DestroyLineState(Memo) then
  5519. HadDebugInfo := True;
  5520. FDebugEntriesCount := 0;
  5521. FreeMem(FDebugEntries);
  5522. FDebugEntries := nil;
  5523. FVariableDebugEntriesCount := 0;
  5524. FreeMem(FVariableDebugEntries);
  5525. FVariableDebugEntries := nil;
  5526. FCompiledCodeText := '';
  5527. FCompiledCodeDebugInfo := '';
  5528. { Clear all dots and reset breakpoint icons (unless exiting; no point) }
  5529. if HadDebugInfo and not(csDestroying in ComponentState) then
  5530. UpdateAllMemosLineMarkers;
  5531. end;
  5532. var
  5533. PrevCompilerFileIndex: Integer;
  5534. PrevMemo: TIDEScintFileEdit;
  5535. procedure TMainForm.ParseDebugInfo(DebugInfo: Pointer);
  5536. function GetMemoFromCompilerFileIndex(const CompilerFileIndex: Integer): TIDEScintFileEdit;
  5537. var
  5538. Memo: TIDEScintFileEdit;
  5539. begin
  5540. if (PrevCompilerFileIndex <> CompilerFileIndex) then begin
  5541. PrevMemo := nil;
  5542. for Memo in FFileMemos do begin
  5543. if Memo.Used and (Memo.CompilerFileIndex = CompilerFileIndex) then begin
  5544. PrevMemo := Memo;
  5545. Break;
  5546. end;
  5547. end;
  5548. PrevCompilerFileIndex := CompilerFileIndex;
  5549. end;
  5550. Result := PrevMemo;
  5551. end;
  5552. { This creates and fills the DebugEntries and Memo LineState arrays }
  5553. var
  5554. Header: PDebugInfoHeader;
  5555. Memo: TIDEScintFileEdit;
  5556. Size: Cardinal;
  5557. I: Integer;
  5558. begin
  5559. DestroyDebugInfo;
  5560. Header := DebugInfo;
  5561. if (Header.ID <> DebugInfoHeaderID) or
  5562. (Header.Version <> DebugInfoHeaderVersion) then
  5563. raise Exception.Create('Unrecognized debug info format');
  5564. try
  5565. for Memo in FFileMemos do begin
  5566. if Memo.Used then begin
  5567. I := Memo.Lines.Count;
  5568. Memo.LineState := AllocMem(SizeOf(TLineState) * (I + LineStateGrowAmount));
  5569. Memo.LineStateCapacity := I + LineStateGrowAmount;
  5570. Memo.LineStateCount := I;
  5571. end;
  5572. end;
  5573. Inc(Cardinal(DebugInfo), SizeOf(Header^));
  5574. FDebugEntriesCount := Header.DebugEntryCount;
  5575. Size := FDebugEntriesCount * SizeOf(TDebugEntry);
  5576. GetMem(FDebugEntries, Size);
  5577. Move(DebugInfo^, FDebugEntries^, Size);
  5578. for I := 0 to FDebugEntriesCount-1 do
  5579. Dec(FDebugEntries[I].LineNumber);
  5580. Inc(Cardinal(DebugInfo), Size);
  5581. FVariableDebugEntriesCount := Header.VariableDebugEntryCount;
  5582. Size := FVariableDebugEntriesCount * SizeOf(TVariableDebugEntry);
  5583. GetMem(FVariableDebugEntries, Size);
  5584. Move(DebugInfo^, FVariableDebugEntries^, Size);
  5585. Inc(Cardinal(DebugInfo), Size);
  5586. SetString(FCompiledCodeText, PAnsiChar(DebugInfo), Header.CompiledCodeTextLength);
  5587. Inc(Cardinal(DebugInfo), Header.CompiledCodeTextLength);
  5588. SetString(FCompiledCodeDebugInfo, PAnsiChar(DebugInfo), Header.CompiledCodeDebugInfoLength);
  5589. PrevCompilerFileIndex := UnknownCompilerFileIndex;
  5590. for I := 0 to FDebugEntriesCount-1 do begin
  5591. if FDebugEntries[I].LineNumber >= 0 then begin
  5592. Memo := GetMemoFromCompilerFileIndex(FDebugEntries[I].FileIndex);
  5593. if (Memo <> nil) and (FDebugEntries[I].LineNumber < Memo.LineStateCount) then begin
  5594. if Memo.LineState[FDebugEntries[I].LineNumber] = lnUnknown then
  5595. Memo.LineState[FDebugEntries[I].LineNumber] := lnHasEntry;
  5596. end;
  5597. end;
  5598. end;
  5599. UpdateAllMemosLineMarkers;
  5600. except
  5601. DestroyDebugInfo;
  5602. raise;
  5603. end;
  5604. end;
  5605. procedure TMainForm.ResetAllMemosLineState;
  5606. { Changes green dots back to grey dots }
  5607. var
  5608. Memo: TIDEScintFileEdit;
  5609. I: Integer;
  5610. begin
  5611. for Memo in FFileMemos do begin
  5612. if Memo.Used and Assigned(Memo.LineState) then begin
  5613. for I := 0 to Memo.LineStateCount-1 do begin
  5614. if Memo.LineState[I] = lnEntryProcessed then begin
  5615. Memo.LineState[I] := lnHasEntry;
  5616. UpdateLineMarkers(Memo, I);
  5617. end;
  5618. end;
  5619. end;
  5620. end;
  5621. end;
  5622. procedure TMainForm.CheckIfTerminated;
  5623. var
  5624. H: THandle;
  5625. begin
  5626. if FDebugging then begin
  5627. { Check if the process hosting the debug client (e.g. Setup or the
  5628. uninstaller second phase) has terminated. If the debug client hasn't
  5629. connected yet, check the initial process (e.g. SetupLdr or the
  5630. uninstaller first phase) instead. }
  5631. if FDebugClientWnd <> 0 then
  5632. H := FDebugClientProcessHandle
  5633. else
  5634. H := FProcessHandle;
  5635. if WaitForSingleObject(H, 0) <> WAIT_TIMEOUT then
  5636. DebuggingStopped(True);
  5637. end;
  5638. end;
  5639. procedure TMainForm.DebuggingStopped(const WaitForTermination: Boolean);
  5640. function GetExitCodeText: String;
  5641. var
  5642. ExitCode: DWORD;
  5643. begin
  5644. { Note: When debugging an uninstall, this will get the exit code off of
  5645. the first phase process, since that's the exit code users will see when
  5646. running the uninstaller outside the debugger. }
  5647. case WaitForSingleObject(FProcessHandle, 0) of
  5648. WAIT_OBJECT_0:
  5649. begin
  5650. if GetExitCodeProcess(FProcessHandle, ExitCode) then begin
  5651. { If the high bit is set, the process was killed uncleanly (e.g.
  5652. by a debugger). Show the exit code as hex in that case. }
  5653. if ExitCode and $80000000 <> 0 then
  5654. Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: 0x%.8x', [ExitCode])
  5655. else
  5656. Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: %u', [ExitCode]);
  5657. end
  5658. else
  5659. Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (GetExitCodeProcess failed)';
  5660. end;
  5661. WAIT_TIMEOUT:
  5662. Result := DebugTargetStrings[FDebugTarget] + ' is still running; can''t get exit code';
  5663. else
  5664. Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (WaitForSingleObject failed)';
  5665. end;
  5666. end;
  5667. var
  5668. ExitCodeText: String;
  5669. begin
  5670. if WaitForTermination then begin
  5671. { Give the initial process time to fully terminate so we can successfully
  5672. get its exit code }
  5673. WaitForSingleObject(FProcessHandle, 5000);
  5674. end;
  5675. FDebugging := False;
  5676. FDebugClientWnd := 0;
  5677. ExitCodeText := GetExitCodeText;
  5678. if FDebugClientProcessHandle <> 0 then begin
  5679. CloseHandle(FDebugClientProcessHandle);
  5680. FDebugClientProcessHandle := 0;
  5681. end;
  5682. CloseHandle(FProcessHandle);
  5683. FProcessHandle := 0;
  5684. FTempDir := '';
  5685. CheckIfRunningTimer.Enabled := False;
  5686. HideError;
  5687. SetStepLine(FStepMemo, -1);
  5688. UpdateRunMenu;
  5689. UpdateCaption;
  5690. DebugLogMessage('*** ' + ExitCodeText);
  5691. StatusBar.Panels[spExtraStatus].Text := ' ' + ExitCodeText;
  5692. end;
  5693. procedure TMainForm.DetachDebugger;
  5694. begin
  5695. CheckIfTerminated;
  5696. if not FDebugging then Exit;
  5697. SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Detach, 0, 0);
  5698. DebuggingStopped(False);
  5699. end;
  5700. function TMainForm.AskToDetachDebugger: Boolean;
  5701. begin
  5702. if FDebugClientWnd = 0 then begin
  5703. MsgBox('Please stop the running ' + DebugTargetStrings[FDebugTarget] + ' process before performing this command.',
  5704. SCompilerFormCaption, mbError, MB_OK);
  5705. Result := False;
  5706. end else if MsgBox('This command will detach the debugger from the running ' + DebugTargetStrings[FDebugTarget] + ' process. Continue?',
  5707. SCompilerFormCaption, mbError, MB_OKCANCEL) = IDOK then begin
  5708. DetachDebugger;
  5709. Result := True;
  5710. end else
  5711. Result := False;
  5712. end;
  5713. function TMainForm.AnyMemoHasBreakPoint: Boolean;
  5714. begin
  5715. { Also see RDeleteBreakPointsClick }
  5716. for var Memo in FFileMemos do
  5717. if Memo.Used and (Memo.BreakPoints.Count > 0) then
  5718. Exit(True);
  5719. Result := False;
  5720. end;
  5721. procedure TMainForm.RMenuClick(Sender: TObject);
  5722. begin
  5723. RDeleteBreakPoints.Enabled := AnyMemoHasBreakPoint;
  5724. { See UpdateRunMenu for other menu items }
  5725. ApplyMenuBitmaps(RMenu);
  5726. end;
  5727. procedure TMainForm.BreakPointsPopupMenuClick(Sender: TObject);
  5728. begin
  5729. RToggleBreakPoint2.Enabled := FActiveMemo is TIDEScintFileEdit;
  5730. RDeleteBreakPoints2.Enabled := AnyMemoHasBreakPoint;
  5731. { Also see UpdateRunMenu }
  5732. ApplyMenuBitmaps(Sender as TMenuItem);
  5733. end;
  5734. { Should always be called when one of the Enabled states would change because
  5735. other code depends on the states being correct always even if the user never
  5736. clicks the Run menu. This is unlike the other menus. Note: also updates
  5737. BCompile and BStopCompile from the Build menu. }
  5738. procedure TMainForm.UpdateRunMenu;
  5739. begin
  5740. CheckIfTerminated;
  5741. BCompile.Enabled := not FCompiling and not FDebugging;
  5742. CompileButton.Enabled := BCompile.Enabled;
  5743. BStopCompile.Enabled := FCompiling;
  5744. StopCompileButton.Enabled := BStopCompile.Enabled;
  5745. RRun.Enabled := not FCompiling and (not FDebugging or FPaused);
  5746. RunButton.Enabled := RRun.Enabled;
  5747. RPause.Enabled := FDebugging and not FPaused;
  5748. PauseButton.Enabled := RPause.Enabled;
  5749. RRunToCursor.Enabled := RRun.Enabled and (FActiveMemo is TIDEScintFileEdit);
  5750. RStepInto.Enabled := RRun.Enabled;
  5751. RStepOver.Enabled := RRun.Enabled;
  5752. RStepOut.Enabled := FPaused;
  5753. RToggleBreakPoint.Enabled := FActiveMemo is TIDEScintFileEdit;
  5754. RTerminate.Enabled := FDebugging and (FDebugClientWnd <> 0);
  5755. TerminateButton.Enabled := RTerminate.Enabled;
  5756. REvaluate.Enabled := FDebugging and (FDebugClientWnd <> 0);
  5757. { See RMenuClick for other menu items and also see BreakPointsPopupMenuClick }
  5758. end;
  5759. procedure TMainForm.UpdateSaveMenuItemAndButton;
  5760. begin
  5761. FSave.Enabled := FActiveMemo is TIDEScintFileEdit;
  5762. SaveButton.Enabled := FSave.Enabled;
  5763. end;
  5764. procedure TMainForm.UpdateTargetMenu;
  5765. begin
  5766. if FDebugTarget = dtSetup then begin
  5767. RTargetSetup.Checked := True;
  5768. TargetSetupButton.Down := True;
  5769. end else begin
  5770. RTargetUninstall.Checked := True;
  5771. TargetUninstallButton.Down := True;
  5772. end;
  5773. end;
  5774. procedure TMainForm.UpdateKeyMapping;
  5775. type
  5776. TKeyMappedMenu = TPair<TMenuItem, TPair<TShortcut, TToolButton>>;
  5777. function KMM(const MenuItem: TMenuItem; const DelphiKey: Word; const DelphiShift: TShiftState;
  5778. const VisualStudioKey: Word; const VisualStudioShift: TShiftState;
  5779. const ToolButton: TToolButton = nil): TKeyMappedMenu;
  5780. begin
  5781. var AShortCut: TShortCut;
  5782. case FOptions.KeyMappingType of
  5783. kmtDelphi: AShortCut := ShortCut(DelphiKey, DelphiShift);
  5784. kmtVisualStudio: AShortCut := ShortCut(VisualStudioKey, VisualStudioShift);
  5785. else
  5786. raise Exception.Create('Unknown FOptions.KeyMappingType');
  5787. end;
  5788. Result := TKeyMappedMenu.Create(MenuItem, TPair<TShortcut, TToolButton>.Create(AShortcut, ToolButton)); { These are records so no need to free }
  5789. end;
  5790. begin
  5791. var KeyMappedMenus := [
  5792. KMM(EFindRegEx, Ord('R'), [ssCtrl, ssAlt], Ord('R'), [ssAlt]),
  5793. KMM(BCompile, VK_F9, [ssCtrl], Ord('B'), [ssCtrl], CompileButton), { Also FCompileShortCut2 below }
  5794. KMM(RRun, VK_F9, [], VK_F5, [], RunButton),
  5795. KMM(RRunToCursor, VK_F4, [], VK_F10, [ssCtrl]),
  5796. KMM(RStepInto, VK_F7, [], VK_F11, []),
  5797. KMM(RStepOver, VK_F8, [], VK_F10, []),
  5798. KMM(RStepOut, VK_F8, [ssShift], VK_F11, [ssShift]),
  5799. KMM(RToggleBreakPoint, VK_F5, [], VK_F9, []),
  5800. KMM(RDeleteBreakPoints, VK_F5, [ssShift, ssCtrl], VK_F9, [ssShift, ssCtrl]),
  5801. KMM(RTerminate, VK_F2, [ssCtrl], VK_F5, [ssShift], TerminateButton),
  5802. KMM(REvaluate, VK_F7, [ssCtrl], VK_F9, [ssShift])];
  5803. FKeyMappedMenus.Clear;
  5804. for var KeyMappedMenu in KeyMappedMenus do begin
  5805. var ShortCut := KeyMappedMenu.Value.Key;
  5806. var ToolButton := KeyMappedMenu.Value.Value;
  5807. KeyMappedMenu.Key.ShortCut := ShortCut;
  5808. if ToolButton <> nil then begin
  5809. var MenuItem := KeyMappedMenu.Key;
  5810. ToolButton.Hint := Format('%s (%s)', [RemoveAccelChar(MenuItem.Caption), NewShortCutToText(ShortCut)]);
  5811. end;
  5812. FKeyMappedMenus.Add(ShortCut, ToolButton);
  5813. end;
  5814. { Set fake shortcuts on any duplicates of the above in popup menus }
  5815. SetFakeShortCut(RToggleBreakPoint2, RToggleBreakPoint.ShortCut);
  5816. SetFakeShortCut(RDeleteBreakPoints2, RDeleteBreakPoints.ShortCut);
  5817. { Handle two special cases:
  5818. -The Nav buttons have no corresponding menu item and also no ShortCut property
  5819. so they need special handling
  5820. -Visual Studio and Delphi have separate Compile and Build shortcuts and the
  5821. Compile shortcut is displayed by the menu and is set above but we want to
  5822. allow the Build shortcuts as well for our single Build/Compile command }
  5823. FBackNavButtonShortCut := ShortCut(VK_LEFT, [ssAlt]);
  5824. FForwardNavButtonShortCut := ShortCut(VK_RIGHT, [ssAlt]);
  5825. case FOptions.KeyMappingType of
  5826. kmtDelphi:
  5827. begin
  5828. FBackNavButtonShortCut2 := 0;
  5829. FForwardNavButtonShortCut2 := 0;
  5830. FCompileShortCut2 := ShortCut(VK_F9, [ssShift]);
  5831. end;
  5832. kmtVisualStudio:
  5833. begin
  5834. FBackNavButtonShortCut2 := ShortCut(VK_OEM_MINUS, [ssCtrl]);
  5835. FForwardNavButtonShortCut2 := ShortCut(VK_OEM_MINUS, [ssCtrl, ssShift]);
  5836. FCompileShortCut2 := ShortCut(VK_F7, []);
  5837. end;
  5838. else
  5839. raise Exception.Create('Unknown FOptions.KeyMappingType');
  5840. end;
  5841. BackNavButton.Hint := Format('Back (%s)', [NewShortCutToText(FBackNavButtonShortCut)]);
  5842. FKeyMappedMenus.Add(FBackNavButtonShortCut, nil);
  5843. ForwardNavButton.Hint := Format('Forward (%s)', [NewShortCutToText(FForwardNavButtonShortCut)]);
  5844. FKeyMappedMenus.Add(FForwardNavButtonShortCut, nil);
  5845. end;
  5846. procedure TMainForm.UpdateTheme;
  5847. begin
  5848. FTheme.Typ := FOptions.ThemeType;
  5849. SetHelpFileDark(FTheme.Dark);
  5850. for var Memo in FMemos do begin
  5851. Memo.UpdateThemeColorsAndStyleAttributes;
  5852. SetControlWindowTheme(Memo, FTheme.Dark);
  5853. end;
  5854. InitFormTheme(Self);
  5855. ToolbarPanel.Color := FTheme.Colors[tcToolBack];
  5856. if FTheme.Dark then begin
  5857. ThemedToolbarVirtualImageList.ImageCollection := ImagesModule.DarkToolBarImageCollection;
  5858. ThemedMarkersAndACVirtualImageList.ImageCollection := ImagesModule.DarkMarkersAndACImageCollection;
  5859. end else begin
  5860. ThemedToolbarVirtualImageList.ImageCollection := ImagesModule.LightToolBarImageCollection;
  5861. ThemedMarkersAndACVirtualImageList.ImageCollection := ImagesModule.LightMarkersAndACImageCollection;
  5862. end;
  5863. UpdateBevel1Visibility;
  5864. UpdateMarginsAndAutoCompleteIcons;
  5865. SplitPanel.ParentBackground := False;
  5866. SplitPanel.Color := FTheme.Colors[tcSplitterBack];
  5867. if FTheme.Dark then begin
  5868. MemosTabSet.Theme := FTheme;
  5869. OutputTabSet.Theme := FTheme;
  5870. end else begin
  5871. MemosTabSet.Theme := nil;
  5872. OutputTabSet.Theme := nil;
  5873. end;
  5874. FMenuDarkBackgroundBrush.Color := FTheme.Colors[tcToolBack];
  5875. FMenuDarkHotOrSelectedBrush.Color := $2C2C2C; { Same as themed menu drawn by Windows 11, which is close to Colors[tcBack] }
  5876. DrawMenuBar(Handle);
  5877. { SetPreferredAppMode doesn't work without FlushMenuThemes here: it would have
  5878. to be called before the form is created to have an effect without
  5879. FlushMenuThemes. So don't call SetPreferredAppMode if FlushMenuThemes is
  5880. missing. }
  5881. if Assigned(SetPreferredAppMode) and Assigned(FlushMenuThemes) then begin
  5882. FMenuImageList := ThemedToolbarVirtualImageList;
  5883. if FTheme.Dark then
  5884. SetPreferredAppMode(PAM_FORCEDARK)
  5885. else
  5886. SetPreferredAppMode(PAM_FORCELIGHT);
  5887. FlushMenuThemes;
  5888. end else
  5889. FMenuImageList := LightToolbarVirtualImageList;
  5890. end;
  5891. procedure TMainForm.UpdateThemeData(const Open: Boolean);
  5892. procedure CloseThemeDataIfNeeded(var ThemeData: HTHEME);
  5893. begin
  5894. if ThemeData <> 0 then begin
  5895. CloseThemeData(ThemeData);
  5896. ThemeData := 0;
  5897. end;
  5898. end;
  5899. begin
  5900. CloseThemeDataIfNeeded(FProgressThemeData);
  5901. CloseThemeDataIfNeeded(FMenuThemeData);
  5902. CloseThemeDataIfNeeded(FToolbarThemeData);
  5903. if Open and UseThemes then begin
  5904. FProgressThemeData := OpenThemeData(Handle, 'Progress');
  5905. FMenuThemeData := OpenThemeData(Handle, 'Menu');
  5906. FToolbarThemeData := OpenThemeData(Handle, 'Toolbar');
  5907. end;
  5908. end;
  5909. procedure TMainForm.UpdateUpdatePanel;
  5910. begin
  5911. UpdatePanel.Visible := FUpdatePanelMessages.Count > 0;
  5912. if UpdatePanel.Visible then begin
  5913. var MessageToShowIndex := FUpdatePanelMessages.Count-1;
  5914. UpdateLinkLabel.Tag := MessageToShowIndex;
  5915. UpdateLinkLabel.Caption := FUpdatePanelMessages[MessageToShowIndex].Msg;
  5916. UpdatePanel.Color := FUpdatePanelMessages[MessageToShowIndex].Color;
  5917. end;
  5918. UpdateBevel1Visibility;
  5919. end;
  5920. procedure TMainForm.UpdateMenuBitmapsIfNeeded;
  5921. procedure AddMenuBitmap(const MenuBitmaps: TMenuBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo;
  5922. const MenuItem: TMenuItem; const ImageList: TVirtualImageList; const ImageIndex: Integer); overload;
  5923. begin
  5924. var pvBits: Pointer;
  5925. var Bitmap := CreateDIBSection(DC, bitmapInfo, DIB_RGB_COLORS, pvBits, 0, 0);
  5926. var OldBitmap := SelectObject(DC, Bitmap);
  5927. if ImageList_Draw(ImageList.Handle, ImageIndex, DC, 0, 0, ILD_TRANSPARENT) then
  5928. MenuBitmaps.Add(MenuItem, Bitmap)
  5929. else begin
  5930. SelectObject(DC, OldBitmap);
  5931. DeleteObject(Bitmap);
  5932. end;
  5933. end;
  5934. procedure AddMenuBitmap(const MenuBitmaps: TMenuBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo;
  5935. const MenuItem: TMenuItem; const ImageList: TVirtualImageList; const ImageName: String); overload;
  5936. begin
  5937. AddMenuBitmap(MenuBitmaps, DC, BitmapInfo, MenuItem, ImageList, ImageList.GetIndexByName(ImageName));
  5938. end;
  5939. type
  5940. TButtonedMenu = TPair<TMenuItem, TToolButton>;
  5941. TNamedMenu = TPair<TMenuItem, String>;
  5942. function BM(const MenuItem: TMenuItem; const ToolButton: TToolButton): TButtonedMenu;
  5943. begin
  5944. Result := TButtonedMenu.Create(MenuItem, ToolButton); { This is a record so no need to free }
  5945. end;
  5946. function NM(const MenuItem: TMenuItem; const Name: String): TNamedMenu;
  5947. begin
  5948. Result := TNamedMenu.Create(MenuItem, Name); { This is a record so no need to free }
  5949. end;
  5950. begin
  5951. { This will create bitmaps for the current DPI using ImageList_Draw.
  5952. These draw perfectly even on Windows 7. Other techniques don't work because
  5953. they loose transparency or only look good on Windows 8 and later. Or they do
  5954. work but cause lots more VCL code to be run than just our simple CreateDIB+Draw
  5955. combo.
  5956. ApplyBitmaps will apply them to menu items using SetMenuItemInfo. The menu item
  5957. does not copy the bitmap so they should still be alive after ApplyBitmaps is done.
  5958. Depends on FMenuImageList to pick the best size icons for the current DPI
  5959. from the collection. }
  5960. var ImageList := FMenuImageList;
  5961. var NewSize: TSize;
  5962. NewSize.cx := ImageList.Width;
  5963. NewSize.cy := ImageList.Height;
  5964. if (NewSize.cx <> FMenuBitmapsSize.cx) or (NewSize.cy <> FMenuBitmapsSize.cy) or
  5965. (ImageList.ImageCollection <> FMenuBitmapsSourceImageCollection) then begin
  5966. { Cleanup previous }
  5967. for var Bitmap in FMenuBitmaps.Values do
  5968. DeleteObject(Bitmap);
  5969. FMenuBitmaps.Clear;
  5970. { Create }
  5971. var DC := CreateCompatibleDC(0);
  5972. if DC <> 0 then begin
  5973. try
  5974. var BitmapInfo := CreateBitmapInfo(NewSize.cx, NewSize.cy, 32);
  5975. var ButtonedMenus := [
  5976. BM(FNewMainFile, NewMainFileButton),
  5977. BM(FOpenMainFile, OpenMainFileButton),
  5978. BM(FSave, SaveButton),
  5979. BM(BCompile, CompileButton),
  5980. BM(BStopCompile, StopCompileButton),
  5981. BM(RRun, RunButton),
  5982. BM(RPause, PauseButton),
  5983. BM(RTerminate, TerminateButton),
  5984. BM(HDoc, HelpButton)];
  5985. for var ButtonedMenu in ButtonedMenus do
  5986. AddMenuBitmap(FMenuBitmaps, DC, BitmapInfo, ButtonedMenu.Key, ImageList, ButtonedMenu.Value.ImageIndex);
  5987. var NamedMenus := [
  5988. NM(FClearRecent, 'eraser'),
  5989. NM(FSaveMainFileAs, 'save-as-filled'),
  5990. NM(FSaveAll, 'save-all-filled'),
  5991. NM(FPrint, 'printer'),
  5992. NM(EUndo, 'command-undo-1'),
  5993. NM(ERedo, 'command-redo-1'),
  5994. NM(ECut, 'clipboard-cut'),
  5995. NM(ECopy, 'clipboard-copy'),
  5996. NM(POutputListCopy, 'clipboard-copy'),
  5997. NM(EPaste, 'clipboard-paste'),
  5998. NM(EDelete, 'symbol-cancel'),
  5999. NM(ESelectAll, 'select-all'),
  6000. NM(POutputListSelectAll, 'select-all'),
  6001. NM(EFind, 'find'),
  6002. NM(EFindInFiles, 'folder-open-filled-find'),
  6003. //NM(EFindNext, 'unused\find-arrow-right-2'),
  6004. //NM(EFindPrevious, 'unused\find-arrow-left-2'),
  6005. NM(EReplace, 'replace'),
  6006. NM(EFoldLine, 'symbol-remove'),
  6007. NM(EUnfoldLine, 'symbol-add'),
  6008. NM(VZoomIn, 'zoom-in'),
  6009. NM(VZoomOut, 'zoom-out'),
  6010. NM(VNextTab, 'control-tab-filled-arrow-right-2'),
  6011. NM(VPreviousTab, 'control-tab-filled-arrow-left-2'),
  6012. //NM(VCloseCurrentTab, 'unused\control-tab-filled-cancel-2'),
  6013. NM(VReopenTabs, 'control-tab-filled-redo-1'),
  6014. NM(VReopenTabs2, 'control-tab-filled-redo-1'),
  6015. NM(BOpenOutputFolder, 'folder-open-filled'),
  6016. NM(RParameters, 'control-edit'),
  6017. NM(RRunToCursor, 'debug-start-filled-arrow-right-2'),
  6018. NM(RStepInto, 'debug-step-into'),
  6019. NM(RStepOver, 'debug-step-over'),
  6020. NM(RStepOut, 'debug-step-out'),
  6021. NM(RToggleBreakPoint, 'debug-breakpoint-filled'),
  6022. NM(RToggleBreakPoint2, 'debug-breakpoint-filled'),
  6023. NM(RDeleteBreakPoints, 'debug-breakpoints-filled-eraser'),
  6024. NM(RDeleteBreakPoints2, 'debug-breakpoints-filled-eraser'),
  6025. NM(REvaluate, 'variables'),
  6026. NM(TAddRemovePrograms, 'application'),
  6027. NM(TGenerateGUID, 'tag-script-filled'),
  6028. NM(TFilesDesigner, 'documents-script-filled'),
  6029. NM(TRegistryDesigner, 'control-tree-script-filled'),
  6030. NM(TMsgBoxDesigner, 'comment-text-script-filled'),
  6031. NM(TSignTools, 'key-filled'),
  6032. NM(TOptions, 'gear-filled'),
  6033. NM(HDonate, 'heart-filled'),
  6034. NM(HMailingList, 'alert-filled'),
  6035. NM(HWhatsNew, 'announcement'),
  6036. NM(HWebsite, 'home'),
  6037. NM(HAbout, 'button-info')];
  6038. for var NamedMenu in NamedMenus do
  6039. AddMenuBitmap(FMenuBitmaps, DC, BitmapInfo, NamedMenu.Key, ImageList, NamedMenu.Value);
  6040. finally
  6041. DeleteDC(DC);
  6042. end;
  6043. end;
  6044. FMenuBitmapsSize := NewSize;
  6045. FMenuBitmapsSourceImageCollection := FMenuImageList.ImageCollection;
  6046. end;
  6047. end;
  6048. procedure TMainForm.ApplyMenuBitmaps(const ParentMenuItem: TMenuItem);
  6049. begin
  6050. UpdateMenuBitmapsIfNeeded;
  6051. { Setting MainMenu1.ImageList or a menu item's .Bitmap to make a menu item
  6052. show a bitmap is not OK: it causes the entire menu to become owner drawn
  6053. which makes it looks different from native menus and additionally the trick
  6054. SetFakeShortCut uses doesn't work with owner drawn menus.
  6055. Instead UpdateMenuBitmapsIfNeeded has prepared images which can be applied
  6056. to native menu items using SetMenuItemInfo and MIIM_BITMAP - which is what we
  6057. do below.
  6058. A problem with this is that Delphi's TMenu likes to constantly recreate the
  6059. underlying native menu items, for example when updating the caption. Sometimes
  6060. it will even destroy and repopulate an entire menu because of a simple change
  6061. like setting the caption of a single item!
  6062. This means the result of our SetMenuItemInfo call (which Delphi doesn't know
  6063. about) will quickly become lost when Delphi recreates the menu item.
  6064. Fixing this in the OnChange event is not possible, this is event is more
  6065. than useless.
  6066. The solution is shown by TMenu.DispatchPopup: in reaction to WM_INITMENUPOPUP
  6067. it calls our Click events right before the menu is shown, giving us the
  6068. opportunity to call SetMenuItemInfo for the menu's items.
  6069. This works unless Delphi decides to destroy and repopulate the menu after
  6070. calling Click. Most amazingly it can do that indeed: it does this if the DPI
  6071. changed since the last popup or if a automatic hotkey change or line reduction
  6072. happens due to the menu's AutoHotkeys or AutoLineReduction properties. To make
  6073. things even worse: for the Run menu it does this each and every time it is
  6074. opened: this menu currently has a 'Step Out' item which has no shortcut but
  6075. also all its letters are taken by another item already. This confuses the
  6076. AutoHotkeys code, making it destroy and repopulate the entire menu over and
  6077. over because it erroneously thinks a hotkey changed.
  6078. To avoid this MainMenu1.AutoHotkeys was set to maManual since we have always
  6079. managed the hotkeys ourselves anyway and .AutoLineReduction was also set to
  6080. maManual and we now manage that ourselves as well.
  6081. This just leave an issue with the icons not appearing on the first popup after
  6082. a DPI change and this seems like a minor issue only.
  6083. For TPopupMenu: calling ApplyMenuBitmaps(PopupMenu.Items) does work but makes
  6084. the popup only show icons without text. This seems to be a limitiation of menus
  6085. created by CreatePopupMenu instead of CreateMenu. This is why our popups with
  6086. icons are all menu items popped using TMainFormPopupMenu. These menu items
  6087. are hidden in the main menu and temporarily shown on popup. Popping an always
  6088. hidden menu item (or a visible one as a child of a hidden parent) doesnt work. }
  6089. var mmi: TMenuItemInfo;
  6090. mmi.cbSize := SizeOf(mmi);
  6091. mmi.fMask := MIIM_BITMAP;
  6092. for var I := 0 to ParentMenuItem.Count-1 do begin
  6093. var MenuItem := ParentMenuItem.Items[I];
  6094. if MenuItem.Visible then begin
  6095. if FMenuBitmaps.TryGetValue(MenuItem, mmi.hbmpItem) then
  6096. SetMenuItemInfo(ParentMenuItem.Handle, MenuItem.Command, False, mmi);
  6097. if MenuItem.Count > 0 then
  6098. ApplyMenuBitmaps(MenuItem);
  6099. end;
  6100. end;
  6101. end;
  6102. procedure TMainForm.StartProcess;
  6103. var
  6104. RunFilename, RunParameters, WorkingDir: String;
  6105. Info: TShellExecuteInfo;
  6106. SaveFocusWindow: HWND;
  6107. WindowList: Pointer;
  6108. ShellExecuteResult: BOOL;
  6109. ErrorCode: DWORD;
  6110. begin
  6111. if FDebugTarget = dtUninstall then begin
  6112. if FUninstExe = '' then
  6113. raise Exception.Create(SCompilerNeedUninstExe);
  6114. RunFilename := FUninstExe;
  6115. end else begin
  6116. if FCompiledExe = '' then
  6117. raise Exception.Create(SCompilerNeedCompiledExe);
  6118. RunFilename := FCompiledExe;
  6119. end;
  6120. RunParameters := Format('/DEBUGWND=$%x ', [Handle]) + FRunParameters;
  6121. ResetAllMemosLineState;
  6122. DebugOutputList.Clear;
  6123. SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  6124. DebugCallStackList.Clear;
  6125. SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  6126. if not (OutputTabSet.TabIndex in [tiDebugOutput, tiDebugCallStack]) then
  6127. OutputTabSet.TabIndex := tiDebugOutput;
  6128. SetStatusPanelVisible(True);
  6129. FillChar(Info, SizeOf(Info), 0);
  6130. Info.cbSize := SizeOf(Info);
  6131. Info.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_FLAG_DDEWAIT or
  6132. SEE_MASK_NOCLOSEPROCESS or SEE_MASK_NOZONECHECKS;
  6133. Info.Wnd := Handle;
  6134. if FOptions.RunAsDifferentUser then
  6135. Info.lpVerb := 'runas'
  6136. else
  6137. Info.lpVerb := 'open';
  6138. Info.lpFile := PChar(RunFilename);
  6139. Info.lpParameters := PChar(RunParameters);
  6140. WorkingDir := PathExtractDir(RunFilename);
  6141. Info.lpDirectory := PChar(WorkingDir);
  6142. Info.nShow := SW_SHOWNORMAL;
  6143. { When the RunAsDifferentUser option is enabled, it's this process that
  6144. waits on the UAC dialog, not Setup(Ldr), so we need to disable windows to
  6145. prevent the user from clicking other things before the UAC dialog is
  6146. dismissed (which is definitely a possibility if the "Switch to the secure
  6147. desktop when prompting for elevation" setting is disabled in Group
  6148. Policy). }
  6149. SaveFocusWindow := GetFocus;
  6150. WindowList := DisableTaskWindows(Handle);
  6151. try
  6152. { Also temporarily remove the focus since a disabled window's children can
  6153. still receive keystrokes. This is needed if Windows doesn't switch to
  6154. the secure desktop immediately and instead shows a flashing taskbar
  6155. button that the user must click (which happened on Windows Vista; I'm
  6156. unable to reproduce it on Windows 11). }
  6157. Windows.SetFocus(0);
  6158. ShellExecuteResult := ShellExecuteEx(@Info);
  6159. ErrorCode := GetLastError;
  6160. finally
  6161. EnableTaskWindows(WindowList);
  6162. Windows.SetFocus(SaveFocusWindow);
  6163. end;
  6164. if not ShellExecuteResult then begin
  6165. { Don't display error message if user clicked Cancel at UAC dialog }
  6166. if ErrorCode = ERROR_CANCELLED then
  6167. Abort;
  6168. raise Exception.CreateFmt(SCompilerExecuteSetupError2, [RunFilename,
  6169. ErrorCode, Win32ErrorString(ErrorCode)]);
  6170. end;
  6171. FDebugging := True;
  6172. FPaused := False;
  6173. FProcessHandle := Info.hProcess;
  6174. CheckIfRunningTimer.Enabled := True;
  6175. UpdateRunMenu;
  6176. UpdateCaption;
  6177. DebugLogMessage('*** ' + DebugTargetStrings[FDebugTarget] + ' started');
  6178. end;
  6179. procedure TMainForm.CompileIfNecessary;
  6180. function UnopenedIncludedFileModifiedSinceLastCompile: Boolean;
  6181. var
  6182. IncludedFile: TIncludedFile;
  6183. NewTime: TFileTime;
  6184. begin
  6185. Result := False;
  6186. for IncludedFile in FIncludedFiles do begin
  6187. if (IncludedFile.Memo = nil) and IncludedFile.HasLastWriteTime and
  6188. GetLastWriteTimeOfFile(IncludedFile.Filename, @NewTime) and
  6189. (CompareFileTime(IncludedFile.LastWriteTime, NewTime) <> 0) then begin
  6190. Result := True;
  6191. Exit;
  6192. end;
  6193. end;
  6194. end;
  6195. begin
  6196. CheckIfTerminated;
  6197. { Display warning if the user modified the script while running - does not support unopened included files }
  6198. if FDebugging and FModifiedAnySinceLastCompileAndGo then begin
  6199. if MsgBox('The changes you made will not take effect until you ' +
  6200. 're-compile.' + SNewLine2 + 'Continue running anyway?',
  6201. SCompilerFormCaption, mbError, MB_YESNO) <> IDYES then
  6202. Abort;
  6203. FModifiedAnySinceLastCompileAndGo := False;
  6204. { The process may have terminated while the message box was up; check,
  6205. and if it has, we want to recompile below }
  6206. CheckIfTerminated;
  6207. end;
  6208. if not FDebugging and (FModifiedAnySinceLastCompile or UnopenedIncludedFileModifiedSinceLastCompile) then
  6209. CompileFile('', False);
  6210. end;
  6211. procedure TMainForm.Go(AStepMode: TStepMode);
  6212. begin
  6213. CompileIfNecessary;
  6214. FStepMode := AStepMode;
  6215. HideError;
  6216. SetStepLine(FStepMemo, -1);
  6217. if FDebugging then begin
  6218. if FPaused then begin
  6219. FPaused := False;
  6220. UpdateRunMenu;
  6221. UpdateCaption;
  6222. if DebugCallStackList.Items.Count > 0 then begin
  6223. DebugCallStackList.Clear;
  6224. SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  6225. DebugCallStackList.Update;
  6226. end;
  6227. { Tell it to continue }
  6228. SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Continue,
  6229. Ord(AStepMode = smStepOver), 0);
  6230. end;
  6231. end
  6232. else
  6233. StartProcess;
  6234. end;
  6235. function TMainForm.EvaluateConstant(const S: String;
  6236. out Output: String): Integer;
  6237. begin
  6238. { This is about evaluating constants like 'app' and not [Code] variables }
  6239. FReplyString := '';
  6240. Result := SendCopyDataMessageStr(FDebugClientWnd, Handle,
  6241. CD_DebugClient_EvaluateConstantW, S);
  6242. if Result > 0 then
  6243. Output := FReplyString;
  6244. end;
  6245. function TMainForm.EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
  6246. out Output: String): Integer;
  6247. begin
  6248. FReplyString := '';
  6249. Result := SendCopyDataMessage(FDebugClientWnd, Handle, CD_DebugClient_EvaluateVariableEntry,
  6250. DebugEntry, SizeOf(DebugEntry^));
  6251. if Result > 0 then
  6252. Output := FReplyString;
  6253. end;
  6254. procedure TMainForm.RRunClick(Sender: TObject);
  6255. begin
  6256. Go(smRun);
  6257. end;
  6258. procedure TMainForm.RParametersClick(Sender: TObject);
  6259. begin
  6260. ReadMRUParametersList;
  6261. InputQueryCombo('Run Parameters', 'Command line parameters for ' + DebugTargetStrings[dtSetup] +
  6262. ' and ' + DebugTargetStrings[dtUninstall] + ':', FRunParameters, FMRUParametersList);
  6263. if FRunParameters <> '' then
  6264. ModifyMRUParametersList(FRunParameters, True);
  6265. end;
  6266. procedure TMainForm.RPauseClick(Sender: TObject);
  6267. begin
  6268. if FDebugging and not FPaused then begin
  6269. if FStepMode <> smStepInto then begin
  6270. FStepMode := smStepInto;
  6271. UpdateCaption;
  6272. end
  6273. else
  6274. MsgBox('A pause is already pending.', SCompilerFormCaption, mbError,
  6275. MB_OK);
  6276. end;
  6277. end;
  6278. procedure TMainForm.RRunToCursorClick(Sender: TObject);
  6279. function GetDebugEntryFromMemoAndLineNumber(Memo: TIDEScintFileEdit; LineNumber: Integer;
  6280. var DebugEntry: TDebugEntry): Boolean;
  6281. var
  6282. I: Integer;
  6283. begin
  6284. Result := False;
  6285. for I := 0 to FDebugEntriesCount-1 do begin
  6286. if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and
  6287. (FDebugEntries[I].LineNumber = LineNumber) then begin
  6288. DebugEntry := FDebugEntries[I];
  6289. Result := True;
  6290. Break;
  6291. end;
  6292. end;
  6293. end;
  6294. begin
  6295. CompileIfNecessary;
  6296. if not GetDebugEntryFromMemoAndLineNumber((FActiveMemo as TIDEScintFileEdit), FActiveMemo.CaretLine, FRunToCursorPoint) then begin
  6297. MsgBox('No code was generated for the current line.', SCompilerFormCaption,
  6298. mbError, MB_OK);
  6299. Exit;
  6300. end;
  6301. Go(smRunToCursor);
  6302. end;
  6303. procedure TMainForm.RStepIntoClick(Sender: TObject);
  6304. begin
  6305. Go(smStepInto);
  6306. end;
  6307. procedure TMainForm.RStepOutClick(Sender: TObject);
  6308. begin
  6309. if FPausedAtCodeLine then
  6310. Go(smStepOut)
  6311. else
  6312. Go(smStepInto);
  6313. end;
  6314. procedure TMainForm.RStepOverClick(Sender: TObject);
  6315. begin
  6316. Go(smStepOver);
  6317. end;
  6318. procedure TMainForm.RTerminateClick(Sender: TObject);
  6319. var
  6320. S, Dir: String;
  6321. begin
  6322. S := 'This will unconditionally terminate the running ' +
  6323. DebugTargetStrings[FDebugTarget] + ' process. Continue?';
  6324. if FDebugTarget = dtSetup then
  6325. S := S + #13#10#13#10'Note that if ' + DebugTargetStrings[FDebugTarget] + ' ' +
  6326. 'is currently in the installation phase, any changes made to the ' +
  6327. 'system thus far will not be undone, nor will uninstall data be written.';
  6328. if MsgBox(S, 'Terminate', mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDYES then
  6329. Exit;
  6330. CheckIfTerminated;
  6331. if FDebugging then begin
  6332. DebugLogMessage('*** Terminating process');
  6333. Win32Check(TerminateProcess(FDebugClientProcessHandle, 6));
  6334. if (WaitForSingleObject(FDebugClientProcessHandle, 5000) <> WAIT_TIMEOUT) and
  6335. (FTempDir <> '') then begin
  6336. Dir := FTempDir;
  6337. FTempDir := '';
  6338. DebugLogMessage('*** Removing left-over temporary directory: ' + Dir);
  6339. { Sleep for a bit to allow files to be unlocked by Windows,
  6340. otherwise it fails intermittently (with Hyper-Threading, at least) }
  6341. Sleep(50);
  6342. if not DeleteDirTree(Dir) and DirExists(Dir) then
  6343. DebugLogMessage('*** Failed to remove temporary directory');
  6344. end;
  6345. DebuggingStopped(True);
  6346. end;
  6347. end;
  6348. procedure TMainForm.REvaluateClick(Sender: TObject);
  6349. var
  6350. Output: String;
  6351. begin
  6352. if InputQuery('Evaluate', 'Constant to evaluate (e.g., "{app}"):',
  6353. FLastEvaluateConstantText) then begin
  6354. case EvaluateConstant(FLastEvaluateConstantText, Output) of
  6355. 1: MsgBox(Output, 'Evaluate Result', mbInformation, MB_OK);
  6356. 2: MsgBox(Output, 'Evaluate Error', mbError, MB_OK);
  6357. else
  6358. MsgBox('An unknown error occurred.', 'Evaluate Error', mbError, MB_OK);
  6359. end;
  6360. end;
  6361. end;
  6362. procedure TMainForm.CheckIfRunningTimerTimer(Sender: TObject);
  6363. begin
  6364. { In cases of normal Setup termination, we receive a WM_Debugger_Goodbye
  6365. message. But in case we don't get that, use a timer to periodically check
  6366. if the process is no longer running. }
  6367. CheckIfTerminated;
  6368. end;
  6369. procedure TMainForm.POutputListCopyClick(Sender: TObject);
  6370. var
  6371. ListBox: TListBox;
  6372. Text: String;
  6373. I: Integer;
  6374. begin
  6375. if CompilerOutputList.Visible then
  6376. ListBox := CompilerOutputList
  6377. else if DebugOutputList.Visible then
  6378. ListBox := DebugOutputList
  6379. else if DebugCallStackList.Visible then
  6380. ListBox := DebugCallStackList
  6381. else
  6382. ListBox := FindResultsList;
  6383. Text := '';
  6384. if ListBox.SelCount > 0 then begin
  6385. for I := 0 to ListBox.Items.Count-1 do begin
  6386. if ListBox.Selected[I] then begin
  6387. if Text <> '' then
  6388. Text := Text + SNewLine;
  6389. Text := Text + ListBox.Items[I];
  6390. end;
  6391. end;
  6392. end;
  6393. Clipboard.AsText := Text;
  6394. end;
  6395. procedure TMainForm.POutputListSelectAllClick(Sender: TObject);
  6396. var
  6397. ListBox: TListBox;
  6398. I: Integer;
  6399. begin
  6400. if CompilerOutputList.Visible then
  6401. ListBox := CompilerOutputList
  6402. else if DebugOutputList.Visible then
  6403. ListBox := DebugOutputList
  6404. else if DebugCallStackList.Visible then
  6405. ListBox := DebugCallStackList
  6406. else
  6407. ListBox := FindResultsList;
  6408. ListBox.Items.BeginUpdate;
  6409. try
  6410. for I := 0 to ListBox.Items.Count-1 do
  6411. ListBox.Selected[I] := True;
  6412. finally
  6413. ListBox.Items.EndUpdate;
  6414. end;
  6415. end;
  6416. procedure TMainForm.OutputListKeyDown(Sender: TObject; var Key: Word;
  6417. Shift: TShiftState);
  6418. begin
  6419. if Shift = [ssCtrl] then begin
  6420. if Key = Ord('C') then
  6421. POutputListCopyClick(Sender)
  6422. else if Key = Ord('A') then
  6423. POutputListSelectAllClick(Sender);
  6424. end;
  6425. end;
  6426. procedure TMainForm.AppOnIdle(Sender: TObject; var Done: Boolean);
  6427. begin
  6428. { For an explanation of this, see the comment where HandleMessage is called }
  6429. if FCompiling then
  6430. Done := False;
  6431. FBecameIdle := True;
  6432. end;
  6433. procedure TMainForm.EGotoClick(Sender: TObject);
  6434. var
  6435. S: String;
  6436. L: Integer;
  6437. begin
  6438. S := IntToStr(FActiveMemo.CaretLine + 1);
  6439. if InputQuery('Go to Line', 'Line number:', S) then begin
  6440. L := StrToIntDef(S, Low(L));
  6441. if L <> Low(L) then
  6442. FActiveMemo.CaretLine := L - 1;
  6443. end;
  6444. end;
  6445. procedure TMainForm.StatusBarClick(Sender: TObject);
  6446. begin
  6447. if MemosTabSet.Visible and (FHiddenFiles.Count > 0) then begin
  6448. var Point := SmallPointToPoint(TSmallPoint(GetMessagePos()));
  6449. var X := StatusBar.ScreenToClient(Point).X;
  6450. var W := 0;
  6451. for var I := 0 to StatusBar.Panels.Count-1 do begin
  6452. Inc(W, StatusBar.Panels[I].Width);
  6453. if X < W then begin
  6454. if I = spHiddenFilesCount then
  6455. (MemosTabSet.PopupMenu as TMainFormPopupMenu).Popup(Point.X, Point.Y);
  6456. Break;
  6457. end else if I = spHiddenFilesCount then
  6458. Break;
  6459. end;
  6460. end;
  6461. end;
  6462. procedure TMainForm.StatusBarDrawPanel(StatusBar: TStatusBar;
  6463. Panel: TStatusPanel; const Rect: TRect);
  6464. const
  6465. TP_DROPDOWNBUTTONGLYPH = 7;
  6466. TS_NORMAL = 1;
  6467. begin
  6468. case Panel.Index of
  6469. spHiddenFilesCount:
  6470. if MemosTabSet.Visible and (FHiddenFiles.Count > 0) then begin
  6471. var RText := Rect;
  6472. if FToolbarThemeData <> 0 then begin
  6473. Dec(RText.Right, RText.Bottom - RText.Top);
  6474. var RGlyph := Rect;
  6475. RGlyph.Left := RText.Right; { RGlyph is now a square }
  6476. DrawThemeBackground(FToolbarThemeData, StatusBar.Canvas.Handle, TP_DROPDOWNBUTTONGLYPH, TS_NORMAL, RGlyph, nil);
  6477. end;
  6478. var S := Format('Tabs closed: %d', [FHiddenFiles.Count]);
  6479. StatusBar.Canvas.TextRect(RText, S, [tfCenter]);
  6480. end;
  6481. spCompileIcon:
  6482. if FCompiling then begin
  6483. var BuildImageList := ImagesModule.BuildImageList;
  6484. ImageList_Draw(BuildImageList.Handle, FBuildAnimationFrame, StatusBar.Canvas.Handle,
  6485. Rect.Left + ((Rect.Right - Rect.Left) - BuildImageList.Width) div 2,
  6486. Rect.Top + ((Rect.Bottom - Rect.Top) - BuildImageList.Height) div 2, ILD_NORMAL);
  6487. end;
  6488. spCompileProgress:
  6489. if FCompiling and (FProgressMax > 0) then begin
  6490. var R := Rect;
  6491. InflateRect(R, -2, -2);
  6492. if FProgressThemeData = 0 then begin
  6493. { Border }
  6494. StatusBar.Canvas.Pen.Color := clBtnShadow;
  6495. StatusBar.Canvas.Brush.Style := bsClear;
  6496. StatusBar.Canvas.Rectangle(R);
  6497. InflateRect(R, -1, -1);
  6498. { Filled part }
  6499. var SaveRight := R.Right;
  6500. R.Right := R.Left + MulDiv(FProgress, R.Right - R.Left,
  6501. FProgressMax);
  6502. StatusBar.Canvas.Brush.Color := clHighlight;
  6503. StatusBar.Canvas.FillRect(R);
  6504. { Unfilled part }
  6505. R.Left := R.Right;
  6506. R.Right := SaveRight;
  6507. StatusBar.Canvas.Brush.Color := clBtnFace;
  6508. StatusBar.Canvas.FillRect(R);
  6509. end else begin
  6510. DrawThemeBackground(FProgressThemeData, StatusBar.Canvas.Handle,
  6511. PP_BAR, 0, R, nil);
  6512. { PP_FILL drawing on Windows 11 (and probably 10) is bugged: when
  6513. the width of the green bar is less than ~25 pixels, the bar is
  6514. drawn over the left border. The same thing happens with
  6515. TProgressBar, so I don't think the API is being used incorrectly.
  6516. Work around the bug by passing a clipping rectangle that excludes
  6517. the left edge when running on Windows 10/11 only. (I don't know if
  6518. earlier versions need it, or if later versions will fix it.) }
  6519. var CR := R;
  6520. if (Win32MajorVersion = 10) and (Win32MinorVersion = 0) then
  6521. Inc(CR.Left); { does this need to be DPI-scaled? }
  6522. R.Right := R.Left + MulDiv(FProgress, R.Right - R.Left,
  6523. FProgressMax);
  6524. DrawThemeBackground(FProgressThemeData, StatusBar.Canvas.Handle,
  6525. PP_FILL, PBFS_NORMAL, R, @CR);
  6526. end;
  6527. end;
  6528. end;
  6529. end;
  6530. procedure TMainForm.InvalidateStatusPanel(const Index: Integer);
  6531. var
  6532. R: TRect;
  6533. begin
  6534. { For some reason, the VCL doesn't offer a method for this... }
  6535. if SendMessage(StatusBar.Handle, SB_GETRECT, Index, LPARAM(@R)) <> 0 then begin
  6536. InflateRect(R, -1, -1);
  6537. InvalidateRect(StatusBar.Handle, @R, True);
  6538. end;
  6539. end;
  6540. procedure TMainForm.UpdateCompileStatusPanels(const AProgress,
  6541. AProgressMax: Cardinal; const ASecondsRemaining: Integer;
  6542. const ABytesCompressedPerSecond: Cardinal);
  6543. begin
  6544. var CurTick := GetTickCount;
  6545. var LastTick := FLastAnimationTick;
  6546. FLastAnimationTick := CurTick;
  6547. { Icon and text panels - updated every 500ms }
  6548. if CurTick div 500 <> LastTick div 500 then begin
  6549. InvalidateStatusPanel(spCompileIcon);
  6550. FBuildAnimationFrame := (FBuildAnimationFrame + 1) mod 4;
  6551. if ASecondsRemaining >= 0 then
  6552. StatusBar.Panels[spExtraStatus].Text := Format(
  6553. ' Estimated time remaining: %.2d%s%.2d%s%.2d Average KB/sec: %.0n',
  6554. [(ASecondsRemaining div 60) div 60, FormatSettings.TimeSeparator,
  6555. (ASecondsRemaining div 60) mod 60, FormatSettings.TimeSeparator,
  6556. ASecondsRemaining mod 60, ABytesCompressedPerSecond / 1024])
  6557. else
  6558. StatusBar.Panels[spExtraStatus].Text := '';
  6559. end;
  6560. { Progress panel and taskbar progress bar - updated every 100ms }
  6561. if (CurTick div 100 <> LastTick div 100) and
  6562. ((FProgress <> AProgress) or (FProgressMax <> AProgressMax)) then begin
  6563. FProgress := AProgress;
  6564. FProgressMax := AProgressMax;
  6565. InvalidateStatusPanel(spCompileProgress);
  6566. { The taskbar progress updates are slow (on Windows 11). Limiting the
  6567. range to 64 instead of 1024 improved compression KB/sec by about 4%
  6568. (9000 to 9400) when the rate limit above is disabled. }
  6569. var NewValue: Cardinal := 1; { must be at least 1 for progress bar to show }
  6570. if AProgressMax > 0 then begin
  6571. { Not using MulDiv here to avoid rounding up }
  6572. NewValue := (AProgress * 64) div AProgressMax;
  6573. if NewValue = 0 then
  6574. NewValue := 1;
  6575. end;
  6576. { Don't call the function if the value hasn't changed, just in case there's
  6577. a performance penalty. (There doesn't appear to be on Windows 11.) }
  6578. if FTaskbarProgressValue <> NewValue then begin
  6579. FTaskbarProgressValue := NewValue;
  6580. SetAppTaskbarProgressValue(NewValue, 64);
  6581. end;
  6582. end;
  6583. end;
  6584. procedure TMainForm.WMSettingChange(var Message: TMessage);
  6585. begin
  6586. inherited;
  6587. if (FTheme.Typ <> ttClassic) and IsWindows10 and (Message.LParam <> 0) and (StrIComp(PChar(Message.LParam), 'ImmersiveColorSet') = 0) then begin
  6588. FOptions.ThemeType := GetDefaultThemeType;
  6589. UpdateTheme;
  6590. end;
  6591. for var Memo in FMemos do
  6592. Memo.SettingChange(Message);
  6593. end;
  6594. procedure TMainForm.WMThemeChanged(var Message: TMessage);
  6595. begin
  6596. { Don't Run to Cursor into this function, it will interrupt up the theme change }
  6597. UpdateThemeData(True);
  6598. inherited;
  6599. end;
  6600. procedure TMainForm.WMUAHDrawMenu(var Message: TMessage);
  6601. begin
  6602. if FTheme.Dark then begin
  6603. var MenuBarInfo: TMenuBarInfo;
  6604. MenuBarInfo.cbSize := SizeOf(MenuBarInfo);
  6605. GetMenuBarInfo(Handle, Integer(OBJID_MENU), 0, MenuBarInfo);
  6606. var WindowRect: TRect;
  6607. GetWindowRect(Handle, WindowRect);
  6608. var Rect := MenuBarInfo.rcBar;
  6609. OffsetRect(Rect, -WindowRect.Left, -WindowRect.Top);
  6610. var UAHMenu := PUAHMenu(Message.lParam);
  6611. FillRect(UAHMenu.hdc, Rect, FMenuDarkBackgroundBrush.Handle);
  6612. end else
  6613. inherited;
  6614. end;
  6615. procedure TMainForm.WMUAHDrawMenuItem(var Message: TMessage);
  6616. const
  6617. ODS_NOACCEL = $100;
  6618. DTT_TEXTCOLOR = 1;
  6619. MENU_BARITEM = 8;
  6620. MBI_NORMAL = 1;
  6621. var
  6622. Buffer: array of Char;
  6623. begin
  6624. if FTheme.Dark then begin
  6625. var UAHDrawMenuItem := PUAHDrawMenuItem(Message.lParam);
  6626. var MenuItemInfo: TMenuItemInfo;
  6627. MenuItemInfo.cbSize := SizeOf(MenuItemInfo);
  6628. MenuItemInfo.fMask := MIIM_STRING;
  6629. MenuItemInfo.dwTypeData := nil;
  6630. GetMenuItemInfo(UAHDrawMenuItem.um.hmenu, UAHDrawMenuItem.umi.iPosition, True, MenuItemInfo);
  6631. Inc(MenuItemInfo.cch);
  6632. SetLength(Buffer, MenuItemInfo.cch);
  6633. MenuItemInfo.dwTypeData := @Buffer[0];
  6634. GetMenuItemInfo(UAHDrawMenuItem.um.hmenu, UAHDrawMenuItem.umi.iPosition, True, MenuItemInfo);
  6635. var dwFlags: DWORD := DT_CENTER or DT_SINGLELINE or DT_VCENTER;
  6636. if (UAHDrawMenuItem.dis.itemState and ODS_NOACCEL) <> 0 then
  6637. dwFlags := dwFlags or DT_HIDEPREFIX;
  6638. var Inactive := (UAHDrawMenuItem.dis.itemState and ODS_INACTIVE) <> 0;
  6639. var TextColor: TThemeColor;
  6640. if Inactive then
  6641. TextColor := tcMarginFore
  6642. else
  6643. TextColor := tcFore;
  6644. var opts: TDTTOpts;
  6645. opts.dwSize := SizeOf(opts);
  6646. opts.dwFlags := DTT_TEXTCOLOR;
  6647. opts.crText := FTheme.Colors[TextColor];
  6648. var Brush: HBrush;
  6649. { ODS_HOTLIGHT can be set when the menu is inactive so we check Inactive as well. }
  6650. if not Inactive and ((UAHDrawMenuItem.dis.itemState and (ODS_HOTLIGHT or ODS_SELECTED)) <> 0) then
  6651. Brush := FMenuDarkHotOrSelectedBrush.Handle
  6652. else
  6653. Brush := FMenuDarkBackgroundBrush.Handle;
  6654. FillRect(UAHDrawMenuItem.um.hdc, UAHDrawMenuItem.dis.rcItem, Brush);
  6655. DrawThemeTextEx(FMenuThemeData, UAHDrawMenuItem.um.hdc, MENU_BARITEM, MBI_NORMAL, MenuItemInfo.dwTypeData, MenuItemInfo.cch, dwFlags, @UAHDrawMenuItem.dis.rcItem, opts);
  6656. end else
  6657. inherited;
  6658. end;
  6659. { Should be removed if the main menu ever gets removed }
  6660. procedure TMainForm.UAHDrawMenuBottomLine;
  6661. begin
  6662. if FTheme.Dark then begin
  6663. var ClientRect: TRect;
  6664. Windows.GetClientRect(Handle, ClientRect);
  6665. MapWindowPoints(Handle, 0, ClientRect, 2);
  6666. var WindowRect: TRect;
  6667. GetWindowRect(Handle, WindowRect);
  6668. var Rect := ClientRect;
  6669. OffsetRect(Rect, -WindowRect.Left, -WindowRect.Top);
  6670. Rect.Bottom := Rect.Top;
  6671. Dec(Rect.Top);
  6672. var DC := GetWindowDC(Handle);
  6673. FillRect(DC, Rect, FMenuDarkBackgroundBrush.Handle);
  6674. ReleaseDC(Handle, DC);
  6675. end;
  6676. end;
  6677. procedure TMainForm.WMNCActivate(var Message: TMessage);
  6678. begin
  6679. inherited;
  6680. UAHDrawMenuBottomLine;
  6681. end;
  6682. procedure TMainForm.WMNCPaint(var Message: TMessage);
  6683. begin
  6684. inherited;
  6685. UAHDrawMenuBottomLine;
  6686. end;
  6687. procedure TMainForm.RTargetClick(Sender: TObject);
  6688. var
  6689. NewTarget: TDebugTarget;
  6690. begin
  6691. if (Sender = RTargetSetup) or (Sender = TargetSetupButton) then
  6692. NewTarget := dtSetup
  6693. else
  6694. NewTarget := dtUninstall;
  6695. if (FDebugTarget <> NewTarget) and (not FDebugging or AskToDetachDebugger) then
  6696. FDebugTarget := NewTarget;
  6697. { Update always even if the user decided not to switch so the states are restored }
  6698. UpdateTargetMenu;
  6699. end;
  6700. procedure TMainForm.AppOnActivate(Sender: TObject);
  6701. const
  6702. ReloadMessages: array[Boolean] of String = (
  6703. 'The %s file has been modified outside of the source editor.' + SNewLine2 +
  6704. 'Do you want to reload the file?',
  6705. 'The %s file has been modified outside of the source editor. Changes have ' +
  6706. 'also been made in the source editor.' + SNewLine2 + 'Do you want to ' +
  6707. 'reload the file and lose the changes made in the source editor?');
  6708. var
  6709. Memo: TIDEScintFileEdit;
  6710. NewTime: TFileTime;
  6711. Changed: Boolean;
  6712. begin
  6713. for Memo in FFileMemos do begin
  6714. if (Memo.Filename = '') or not Memo.Used then
  6715. Continue;
  6716. { See if the file has been modified outside the editor }
  6717. Changed := False;
  6718. if GetLastWriteTimeOfFile(Memo.Filename, @NewTime) then begin
  6719. if CompareFileTime(Memo.FileLastWriteTime, NewTime) <> 0 then begin
  6720. Memo.FileLastWriteTime := NewTime;
  6721. Changed := True;
  6722. end;
  6723. end;
  6724. { If it has been, offer to reload it }
  6725. if Changed then begin
  6726. if IsWindowEnabled(Handle) then begin
  6727. if MsgBox(Format(ReloadMessages[Memo.Modified], [Memo.Filename]),
  6728. SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
  6729. if ConfirmCloseFile(False) then begin
  6730. OpenFile(Memo, Memo.Filename, False);
  6731. if Memo = FMainMemo then
  6732. Break; { Reloading the main script will also reload all include files }
  6733. end;
  6734. end
  6735. else begin
  6736. { When a modal dialog is up, don't offer to reload the file. Probably
  6737. not a good idea since the dialog might be manipulating the file. }
  6738. MsgBox('The ' + Memo.Filename + ' file has been modified outside ' +
  6739. 'of the source editor. You might want to reload it.',
  6740. SCompilerFormCaption, mbInformation, MB_OK);
  6741. end;
  6742. end;
  6743. end;
  6744. end;
  6745. procedure TMainForm.CompilerOutputListDrawItem(Control: TWinControl;
  6746. Index: Integer; Rect: TRect; State: TOwnerDrawState);
  6747. const
  6748. ThemeColors: array [TStatusMessageKind] of TThemeColor = (tcGreen, tcFore, tcOrange, tcRed);
  6749. var
  6750. Canvas: TCanvas;
  6751. S: String;
  6752. StatusMessageKind: TStatusMessageKind;
  6753. begin
  6754. Canvas := CompilerOutputList.Canvas;
  6755. S := CompilerOutputList.Items[Index];
  6756. Canvas.FillRect(Rect);
  6757. Inc(Rect.Left, 2);
  6758. if FOptions.ColorizeCompilerOutput and not (odSelected in State) then begin
  6759. StatusMessageKind := TStatusMessageKind(CompilerOutputList.Items.Objects[Index]);
  6760. Canvas.Font.Color := FTheme.Colors[ThemeColors[StatusMessageKind]];
  6761. end;
  6762. Canvas.TextOut(Rect.Left, Rect.Top, S);
  6763. end;
  6764. procedure TMainForm.DebugOutputListDrawItem(Control: TWinControl;
  6765. Index: Integer; Rect: TRect; State: TOwnerDrawState);
  6766. var
  6767. Canvas: TCanvas;
  6768. S: String;
  6769. begin
  6770. Canvas := DebugOutputList.Canvas;
  6771. S := DebugOutputList.Items[Index];
  6772. Canvas.FillRect(Rect);
  6773. Inc(Rect.Left, 2);
  6774. if (S <> '') and (S[1] = #9) then
  6775. Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 2, Maxint))
  6776. else begin
  6777. if (Length(S) > 20) and (S[18] = '-') and (S[19] = '-') and (S[20] = ' ') then begin
  6778. { Draw lines that begin with '-- ' (like '-- File entry --') in bold }
  6779. Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, 17));
  6780. Canvas.Font.Style := [fsBold];
  6781. Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 18, Maxint));
  6782. end else
  6783. Canvas.TextOut(Rect.Left, Rect.Top, S);
  6784. end;
  6785. end;
  6786. procedure TMainForm.DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  6787. State: TOwnerDrawState);
  6788. var
  6789. Canvas: TCanvas;
  6790. S: String;
  6791. begin
  6792. Canvas := DebugCallStackList.Canvas;
  6793. S := DebugCallStackList.Items[Index];
  6794. Canvas.FillRect(Rect);
  6795. Inc(Rect.Left, 2);
  6796. Canvas.TextOut(Rect.Left, Rect.Top, S);
  6797. end;
  6798. procedure TMainForm.FindResultsListDblClick(Sender: TObject);
  6799. var
  6800. FindResult: TFindResult;
  6801. Memo: TIDEScintFileEdit;
  6802. I: Integer;
  6803. begin
  6804. I := FindResultsList.ItemIndex;
  6805. if I <> -1 then begin
  6806. FindResult := FindResultsList.Items.Objects[I] as TFindResult;
  6807. if FindResult <> nil then begin
  6808. for Memo in FFileMemos do begin
  6809. if Memo.Used and (PathCompare(Memo.Filename, FindResult.Filename) = 0) then begin
  6810. MoveCaretAndActivateMemo(Memo, FindResult.Line, True);
  6811. Memo.SelectAndEnsureVisible(FindResult.Range);
  6812. ActiveControl := Memo;
  6813. Exit;
  6814. end;
  6815. end;
  6816. MsgBox('File not opened.', SCompilerFormCaption, mbError, MB_OK);
  6817. end;
  6818. end;
  6819. end;
  6820. procedure TMainForm.FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  6821. State: TOwnerDrawState);
  6822. var
  6823. Canvas: TCanvas;
  6824. S, S2: String;
  6825. FindResult: TFindResult;
  6826. StartI, EndI: Integer;
  6827. SaveColor: TColor;
  6828. begin
  6829. Canvas := FindResultsList.Canvas;
  6830. S := FindResultsList.Items[Index];
  6831. FindResult := FindResultsList.Items.Objects[Index] as TFindResult;
  6832. Canvas.FillRect(Rect);
  6833. Inc(Rect.Left, 2);
  6834. if FindResult = nil then begin
  6835. Canvas.Font.Style := [fsBold];
  6836. Canvas.TextOut(Rect.Left, Rect.Top, S);
  6837. end else if not (odSelected in State) then begin
  6838. StartI := FindResult.Range.StartPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength;
  6839. EndI := FindResult.Range.EndPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength;
  6840. if StartI > 1 then begin
  6841. Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, StartI-1));
  6842. Rect.Left := Canvas.PenPos.X;
  6843. end;
  6844. SaveColor := Canvas.Brush.Color;
  6845. if FTheme.Dark then
  6846. Canvas.Brush.Color := FTheme.Colors[tcRed]
  6847. else
  6848. Canvas.Brush.Color := FTheme.Colors[tcSelBack];
  6849. S2 := Copy(S, StartI, EndI-StartI);
  6850. Rect.Right := Rect.Left + Canvas.TextWidth(S2);
  6851. Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2); { TextRect instead of TextOut to avoid a margin around the text }
  6852. if EndI <= Length(S) then begin
  6853. Canvas.Brush.Color := SaveColor;
  6854. S2 := Copy(S, EndI, MaxInt);
  6855. Rect.Left := Rect.Right;
  6856. Rect.Right := Rect.Left + Canvas.TextWidth(S2);
  6857. Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2);
  6858. end;
  6859. end else
  6860. Canvas.TextOut(Rect.Left, Rect.Top, S)
  6861. end;
  6862. procedure TMainForm.OutputTabSetClick(Sender: TObject);
  6863. begin
  6864. case OutputTabSet.TabIndex of
  6865. tiCompilerOutput:
  6866. begin
  6867. CompilerOutputList.BringToFront;
  6868. CompilerOutputList.Visible := True;
  6869. DebugOutputList.Visible := False;
  6870. DebugCallStackList.Visible := False;
  6871. FindResultsList.Visible := False;
  6872. end;
  6873. tiDebugOutput:
  6874. begin
  6875. DebugOutputList.BringToFront;
  6876. DebugOutputList.Visible := True;
  6877. CompilerOutputList.Visible := False;
  6878. DebugCallStackList.Visible := False;
  6879. FindResultsList.Visible := False;
  6880. end;
  6881. tiDebugCallStack:
  6882. begin
  6883. DebugCallStackList.BringToFront;
  6884. DebugCallStackList.Visible := True;
  6885. CompilerOutputList.Visible := False;
  6886. DebugOutputList.Visible := False;
  6887. FindResultsList.Visible := False;
  6888. end;
  6889. tiFindResults:
  6890. begin
  6891. FindResultsList.BringToFront;
  6892. FindResultsList.Visible := True;
  6893. CompilerOutputList.Visible := False;
  6894. DebugOutputList.Visible := False;
  6895. DebugCallStackList.Visible := False;
  6896. end;
  6897. end;
  6898. end;
  6899. procedure TMainForm.ToggleBreakPoint(Line: Integer);
  6900. var
  6901. Memo: TIDEScintFileEdit;
  6902. I: Integer;
  6903. begin
  6904. Memo := FActiveMemo as TIDEScintFileEdit;
  6905. I := Memo.BreakPoints.IndexOf(Line);
  6906. if I = -1 then
  6907. Memo.BreakPoints.Add(Line)
  6908. else
  6909. Memo.BreakPoints.Delete(I);
  6910. UpdateLineMarkers(Memo, Line);
  6911. BuildAndSaveBreakPointLines(Memo);
  6912. end;
  6913. procedure TMainForm.MemoMarginClick(Sender: TObject; MarginNumber: Integer;
  6914. Line: Integer);
  6915. begin
  6916. if (MarginNumber = 1) and RToggleBreakPoint.Enabled then
  6917. ToggleBreakPoint(Line);
  6918. end;
  6919. procedure TMainForm.MemoMarginRightClick(Sender: TObject; MarginNumber: Integer;
  6920. Line: Integer);
  6921. begin
  6922. if MarginNumber = 1 then begin
  6923. var Point := SmallPointToPoint(TSmallPoint(GetMessagePos()));
  6924. var PopupMenu := TMainFormPopupMenu.Create(Self, BreakPointsPopupMenu);
  6925. try
  6926. PopupMenu.Popup(Point.X, Point.Y);
  6927. finally
  6928. PopupMenu.Free;
  6929. end;
  6930. end;
  6931. end;
  6932. procedure TMainForm.RToggleBreakPointClick(Sender: TObject);
  6933. begin
  6934. ToggleBreakPoint(FActiveMemo.CaretLine);
  6935. end;
  6936. procedure TMainForm.RDeleteBreakPointsClick(Sender: TObject);
  6937. begin
  6938. { Also see AnyMemoHasBreakPoint }
  6939. for var Memo in FFileMemos do begin
  6940. if Memo.Used and (Memo.BreakPoints.Count > 0) then begin
  6941. for var I := Memo.BreakPoints.Count-1 downto 0 do begin
  6942. var Line := Memo.BreakPoints[I];
  6943. Memo.BreakPoints.Delete(I);
  6944. UpdateLineMarkers(Memo, Line);
  6945. end;
  6946. BuildAndSaveBreakPointLines(Memo);
  6947. end;
  6948. end;
  6949. end;
  6950. procedure TMainForm.MemoLinesInserted(Memo: TIDEScintFileEdit; FirstLine, Count: integer);
  6951. var
  6952. I, Line: Integer;
  6953. begin
  6954. for I := 0 to FDebugEntriesCount-1 do
  6955. if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and
  6956. (FDebugEntries[I].LineNumber >= FirstLine) then
  6957. Inc(FDebugEntries[I].LineNumber, Count);
  6958. if Assigned(Memo.LineState) and (FirstLine < Memo.LineStateCount) then begin
  6959. { Grow FStateLine if necessary }
  6960. I := (Memo.LineStateCount + Count) - Memo.LineStateCapacity;
  6961. if I > 0 then begin
  6962. if I < LineStateGrowAmount then
  6963. I := LineStateGrowAmount;
  6964. ReallocMem(Memo.LineState, SizeOf(TLineState) * (Memo.LineStateCapacity + I));
  6965. Inc(Memo.LineStateCapacity, I);
  6966. end;
  6967. { Shift existing line states and clear the new ones }
  6968. for I := Memo.LineStateCount-1 downto FirstLine do
  6969. Memo.LineState[I + Count] := Memo.LineState[I];
  6970. for I := FirstLine to FirstLine + Count - 1 do
  6971. Memo.LineState[I] := lnUnknown;
  6972. Inc(Memo.LineStateCount, Count);
  6973. end;
  6974. if Memo.StepLine >= FirstLine then
  6975. Inc(Memo.StepLine, Count);
  6976. if Memo.ErrorLine >= FirstLine then
  6977. Inc(Memo.ErrorLine, Count);
  6978. var BreakPointsChanged := False;
  6979. for I := 0 to Memo.BreakPoints.Count-1 do begin
  6980. Line := Memo.BreakPoints[I];
  6981. if Line >= FirstLine then begin
  6982. Memo.BreakPoints[I] := Line + Count;
  6983. BreakPointsChanged := True;
  6984. end;
  6985. end;
  6986. if BreakPointsChanged then
  6987. BuildAndSaveBreakPointLines(Memo);
  6988. FNavStacks.LinesInserted(Memo, FirstLine, Count);
  6989. end;
  6990. procedure TMainForm.MemoLinesDeleted(Memo: TIDEScintFileEdit; FirstLine, Count,
  6991. FirstAffectedLine: Integer);
  6992. var
  6993. I, Line: Integer;
  6994. DebugEntry: PDebugEntry;
  6995. begin
  6996. for I := 0 to FDebugEntriesCount-1 do begin
  6997. DebugEntry := @FDebugEntries[I];
  6998. if (DebugEntry.FileIndex = Memo.CompilerFileIndex) and
  6999. (DebugEntry.LineNumber >= FirstLine) then begin
  7000. if DebugEntry.LineNumber < FirstLine + Count then
  7001. DebugEntry.LineNumber := -1
  7002. else
  7003. Dec(DebugEntry.LineNumber, Count);
  7004. end;
  7005. end;
  7006. if Assigned(Memo.LineState) then begin
  7007. { Shift existing line states }
  7008. if FirstLine < Memo.LineStateCount - Count then begin
  7009. for I := FirstLine to Memo.LineStateCount - Count - 1 do
  7010. Memo.LineState[I] := Memo.LineState[I + Count];
  7011. Dec(Memo.LineStateCount, Count);
  7012. end
  7013. else begin
  7014. { There's nothing to shift because the last line(s) were deleted, or
  7015. line(s) past FLineStateCount }
  7016. if Memo.LineStateCount > FirstLine then
  7017. Memo.LineStateCount := FirstLine;
  7018. end;
  7019. end;
  7020. if Memo.StepLine >= FirstLine then begin
  7021. if Memo.StepLine < FirstLine + Count then
  7022. Memo.StepLine := -1
  7023. else
  7024. Dec(Memo.StepLine, Count);
  7025. end;
  7026. if Memo.ErrorLine >= FirstLine then begin
  7027. if Memo.ErrorLine < FirstLine + Count then
  7028. Memo.ErrorLine := -1
  7029. else
  7030. Dec(Memo.ErrorLine, Count);
  7031. end;
  7032. var BreakPointsChanged := False;
  7033. for I := Memo.BreakPoints.Count-1 downto 0 do begin
  7034. Line := Memo.BreakPoints[I];
  7035. if Line >= FirstLine then begin
  7036. if Line < FirstLine + Count then begin
  7037. Memo.BreakPoints.Delete(I);
  7038. BreakPointsChanged := True;
  7039. end else begin
  7040. Memo.BreakPoints[I] := Line - Count;
  7041. BreakPointsChanged := True;
  7042. end;
  7043. end;
  7044. end;
  7045. if BreakPointsChanged then
  7046. BuildAndSaveBreakPointLines(Memo);
  7047. if FNavStacks.LinesDeleted(Memo, FirstLine, Count) then
  7048. UpdateNavButtons;
  7049. { We do NOT update FCurrentNavItem here so it might point to a line that's
  7050. deleted until next UpdateCaretPosPanelAndBackStack by UpdateMemoUI }
  7051. { When lines are deleted, Scintilla insists on moving all of the deleted
  7052. lines' markers to the line on which the deletion started
  7053. (FirstAffectedLine). This is bad for us as e.g. it can result in the line
  7054. having two conflicting markers (or two of the same marker). There's no
  7055. way to stop it from doing that, or to easily tell which markers came from
  7056. which lines, so we simply delete and re-create all markers on the line. }
  7057. UpdateLineMarkers(Memo, FirstAffectedLine);
  7058. end;
  7059. procedure TMainForm.UpdateLineMarkers(const AMemo: TIDEScintFileEdit; const Line: Integer);
  7060. var
  7061. NewMarker: Integer;
  7062. begin
  7063. if Line >= AMemo.Lines.Count then
  7064. Exit;
  7065. var StepLine := AMemo.StepLine = Line;
  7066. NewMarker := -1;
  7067. if AMemo.BreakPoints.IndexOf(Line) <> -1 then begin
  7068. if AMemo.LineState = nil then
  7069. NewMarker := mmiBreakpoint
  7070. else if (Line < AMemo.LineStateCount) and (AMemo.LineState[Line] <> lnUnknown) then
  7071. NewMarker := IfThen(StepLine, mmiBreakpointStep, mmiBreakpointGood)
  7072. else
  7073. NewMarker := mmiBreakpointBad;
  7074. end else if StepLine then
  7075. NewMarker := mmiStep
  7076. else begin
  7077. if Line < AMemo.LineStateCount then begin
  7078. case AMemo.LineState[Line] of
  7079. lnHasEntry: NewMarker := mmiHasEntry;
  7080. lnEntryProcessed: NewMarker := mmiEntryProcessed;
  7081. end;
  7082. end;
  7083. end;
  7084. { Delete all markers on the line. To flush out any possible duplicates,
  7085. even the markers we'll be adding next are deleted. }
  7086. if AMemo.GetMarkers(Line) <> [] then
  7087. AMemo.DeleteAllMarkersOnLine(Line);
  7088. if NewMarker <> -1 then
  7089. AMemo.AddMarker(Line, NewMarker);
  7090. if StepLine then
  7091. AMemo.AddMarker(Line, mlmStep)
  7092. else if AMemo.ErrorLine = Line then
  7093. AMemo.AddMarker(Line, mlmError)
  7094. else if NewMarker = mmiBreakpointBad then
  7095. AMemo.AddMarker(Line, mlmBreakpointBad);
  7096. end;
  7097. procedure TMainForm.UpdateLinkLabelLinkClick(Sender: TObject;
  7098. const Link: string; LinkType: TSysLinkType);
  7099. begin
  7100. var Handled := True;
  7101. if (LinkType = sltID) and (Link = 'hwhatsnew') then
  7102. HWhatsNew.Click
  7103. else if (LinkType = sltID) and (Link = 'toptions-vscode') then begin
  7104. TOptionsForm.DropDownMemoKeyMappingComboBoxOnNextShow := True;
  7105. TOptions.Click
  7106. end else
  7107. Handled := False;
  7108. if Handled then
  7109. UpdatePanelClosePaintBoxClick(Sender);
  7110. end;
  7111. procedure TMainForm.UpdatePanelClosePaintBoxClick(Sender: TObject);
  7112. begin
  7113. var MessageToHideIndex := UpdateLinkLabel.Tag;
  7114. var Ini := TConfigIniFile.Create;
  7115. try
  7116. Ini.WriteInteger('UpdatePanel', FUpdatePanelMessages[MessageToHideIndex].ConfigIdent, FUpdatePanelMessages[MessageToHideIndex].ConfigValue);
  7117. finally
  7118. Ini.Free;
  7119. end;
  7120. FUpdatePanelMessages.Delete(MessageToHideIndex);
  7121. UpdateUpdatePanel;
  7122. end;
  7123. procedure TMainForm.UpdatePanelDonateImageClick(Sender: TObject);
  7124. begin
  7125. HDonate.Click;
  7126. end;
  7127. procedure TMainForm.UpdatePanelClosePaintBoxPaint(Sender: TObject);
  7128. const
  7129. MENU_SYSTEMCLOSE = 17;
  7130. MSYSC_NORMAL = 1;
  7131. begin
  7132. var Canvas := UpdatePanelClosePaintBox.Canvas;
  7133. var R := TRect.Create(0, 0, UpdatePanelClosePaintBox.Width, UpdatePanelClosePaintBox.Height);
  7134. if FMenuThemeData <> 0 then begin
  7135. var Offset := MulDiv(1, CurrentPPI, 96);
  7136. Inc(R.Left, Offset);
  7137. DrawThemeBackground(FMenuThemeData, Canvas.Handle, MENU_SYSTEMCLOSE, MSYSC_NORMAL, R, nil);
  7138. end else begin
  7139. InflateRect(R, -MulDiv(6, CurrentPPI, 96), -MulDiv(6, CurrentPPI, 96));
  7140. Canvas.Pen.Color := Canvas.Font.Color;
  7141. Canvas.MoveTo(R.Left, R.Top);
  7142. Canvas.LineTo(R.Right, R.Bottom);
  7143. Canvas.MoveTo(R.Left, R.Bottom-1);
  7144. Canvas.LineTo(R.Right, R.Top-1);
  7145. end;
  7146. end;
  7147. procedure TMainForm.UpdateAllMemoLineMarkers(const AMemo: TIDEScintFileEdit);
  7148. begin
  7149. for var Line := 0 to AMemo.Lines.Count-1 do
  7150. UpdateLineMarkers(AMemo, Line);
  7151. end;
  7152. procedure TMainForm.UpdateAllMemosLineMarkers;
  7153. begin
  7154. for var Memo in FFileMemos do
  7155. if Memo.Used then
  7156. UpdateAllMemoLineMarkers(Memo);
  7157. end;
  7158. procedure TMainForm.UpdateBevel1Visibility;
  7159. begin
  7160. { Bevel1 is the line between the toolbar and memos when there's nothing in
  7161. between and the color of the toolbar and memo margins is the same }
  7162. Bevel1.Visible := (ToolBarPanel.Color = FTheme.Colors[tcMarginBack]) and
  7163. not UpdatePanel.Visible and not MemosTabSet.Visible;
  7164. end;
  7165. function TMainForm.ToCurrentPPI(const XY: Integer): Integer;
  7166. begin
  7167. Result := MulDiv(XY, CurrentPPI, 96);
  7168. end;
  7169. function TMainForm.FromCurrentPPI(const XY: Integer): Integer;
  7170. begin
  7171. Result := MulDiv(XY, 96, CurrentPPI);
  7172. end;
  7173. initialization
  7174. Application.OnGetActiveFormHandle := TMainForm.AppOnGetActiveFormHandle;
  7175. InitThemeLibrary;
  7176. InitHtmlHelpLibrary;
  7177. { For ClearType support, try to make the default font Microsoft Sans Serif }
  7178. if DefFontData.Name = 'MS Sans Serif' then
  7179. DefFontData.Name := AnsiString(GetPreferredUIFont);
  7180. CoInitialize(nil);
  7181. finalization
  7182. CoUninitialize();
  7183. end.