CompForm.pas 190 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493
  1. unit CompForm;
  2. {
  3. Inno Setup
  4. Copyright (C) 1997-2024 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
  11. into this program and not depend on ISCmplr.dll. Also see Compile's
  12. STATICPREPROC. }
  13. {$I VERSION.INC}
  14. {$IFDEF STATICCOMPILER}
  15. {$R 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, ScintStylerInnoSetup, NewTabSet, ModernColors, CompScintEdit,
  22. DebugStruct, CompInt, UxTheme, ImageList, ImgList, ToolWin, CompFunc,
  23. VirtualImageList, BaseImageCollection, ImageCollection;
  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: TCompScintFileEdit;
  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. TCompileForm = class(TUIStateForm)
  55. MainMenu1: TMainMenu;
  56. FMenu: TMenuItem;
  57. FNewMainFile: TMenuItem;
  58. FOpenMainFile: TMenuItem;
  59. FSave: TMenuItem;
  60. FSaveMainFileAs: TMenuItem;
  61. N1: TMenuItem;
  62. BCompile: TMenuItem;
  63. N2: TMenuItem;
  64. FExit: TMenuItem;
  65. EMenu: TMenuItem;
  66. EUndo: TMenuItem;
  67. N3: TMenuItem;
  68. ECut: TMenuItem;
  69. ECopy: TMenuItem;
  70. EPaste: TMenuItem;
  71. EDelete: TMenuItem;
  72. N4: TMenuItem;
  73. ESelectAll: TMenuItem;
  74. VMenu: TMenuItem;
  75. EFind: TMenuItem;
  76. EFindNext: TMenuItem;
  77. EReplace: TMenuItem;
  78. HMenu: TMenuItem;
  79. HDoc: TMenuItem;
  80. N6: TMenuItem;
  81. HAbout: TMenuItem;
  82. FMRUMainFilesSep: TMenuItem;
  83. VCompilerOutput: TMenuItem;
  84. FindDialog: TFindDialog;
  85. ReplaceDialog: TReplaceDialog;
  86. StatusPanel: TPanel;
  87. CompilerOutputList: TListBox;
  88. SplitPanel: TPanel;
  89. HWebsite: TMenuItem;
  90. VToolbar: TMenuItem;
  91. N7: TMenuItem;
  92. TOptions: TMenuItem;
  93. HFaq: TMenuItem;
  94. StatusBar: TStatusBar;
  95. BodyPanel: TPanel;
  96. VStatusBar: TMenuItem;
  97. ERedo: TMenuItem;
  98. RMenu: TMenuItem;
  99. RStepInto: TMenuItem;
  100. RStepOver: TMenuItem;
  101. N5: TMenuItem;
  102. RRun: TMenuItem;
  103. RRunToCursor: TMenuItem;
  104. N10: TMenuItem;
  105. REvaluate: TMenuItem;
  106. CheckIfRunningTimer: TTimer;
  107. RPause: TMenuItem;
  108. RParameters: TMenuItem;
  109. ListPopupMenu: TPopupMenu;
  110. PListCopy: TMenuItem;
  111. HISPPSep: TMenuItem;
  112. N12: TMenuItem;
  113. BStopCompile: TMenuItem;
  114. HISPPDoc: TMenuItem;
  115. N13: TMenuItem;
  116. EGoto: TMenuItem;
  117. RTerminate: TMenuItem;
  118. BMenu: TMenuItem;
  119. BLowPriority: TMenuItem;
  120. HDonate: TMenuItem;
  121. N14: TMenuItem;
  122. HPSWebsite: TMenuItem;
  123. N15: TMenuItem;
  124. RTargetSetup: TMenuItem;
  125. RTargetUninstall: TMenuItem;
  126. OutputTabSet: TNewTabSet;
  127. DebugOutputList: TListBox;
  128. VDebugOutput: TMenuItem;
  129. VHide: TMenuItem;
  130. N11: TMenuItem;
  131. TMenu: TMenuItem;
  132. TAddRemovePrograms: TMenuItem;
  133. RToggleBreakPoint: TMenuItem;
  134. HWhatsNew: TMenuItem;
  135. TGenerateGUID: TMenuItem;
  136. TSignTools: TMenuItem;
  137. N16: TMenuItem;
  138. HExamples: TMenuItem;
  139. N17: TMenuItem;
  140. BOpenOutputFolder: TMenuItem;
  141. N8: TMenuItem;
  142. VZoom: TMenuItem;
  143. VZoomIn: TMenuItem;
  144. VZoomOut: TMenuItem;
  145. N9: TMenuItem;
  146. VZoomReset: TMenuItem;
  147. N18: TMenuItem;
  148. ECompleteWord: TMenuItem;
  149. N19: TMenuItem;
  150. FSaveEncoding: TMenuItem;
  151. FSaveEncodingAuto: TMenuItem;
  152. FSaveEncodingUTF8: TMenuItem;
  153. ToolBar: TToolBar;
  154. NewMainFileButton: TToolButton;
  155. OpenMainFileButton: TToolButton;
  156. SaveButton: TToolButton;
  157. ToolButton4: TToolButton;
  158. CompileButton: TToolButton;
  159. StopCompileButton: TToolButton;
  160. ToolButton7: TToolButton;
  161. RunButton: TToolButton;
  162. PauseButton: TToolButton;
  163. ToolButton10: TToolButton;
  164. TargetSetupButton: TToolButton;
  165. TargetUninstallButton: TToolButton;
  166. ToolButton13: TToolButton;
  167. HelpButton: TToolButton;
  168. Bevel1: TBevel;
  169. BuildImageList: TImageList;
  170. TerminateButton: TToolButton;
  171. LightToolBarImageCollection: TImageCollection;
  172. DarkToolBarImageCollection: TImageCollection;
  173. ToolBarVirtualImageList: TVirtualImageList;
  174. PListSelectAll: TMenuItem;
  175. DebugCallStackList: TListBox;
  176. VDebugCallStack: TMenuItem;
  177. TMsgBoxDesigner: TMenuItem;
  178. ToolBarPanel: TPanel;
  179. HMailingList: TMenuItem;
  180. MemosTabSet: TNewTabSet; { First tab is the main memo, last tab is the preprocessor output memo }
  181. FSaveAll: TMenuItem;
  182. RStepOut: TMenuItem;
  183. VNextTab: TMenuItem;
  184. VPreviousTab: TMenuItem;
  185. N20: TMenuItem;
  186. HShortcutsDoc: TMenuItem;
  187. N21: TMenuItem;
  188. EFindPrevious: TMenuItem;
  189. FindResultsList: TListBox;
  190. VFindResults: TMenuItem;
  191. EFindInFiles: TMenuItem;
  192. FindInFilesDialog: TFindDialog;
  193. FPrint: TMenuItem;
  194. N22: TMenuItem;
  195. PrintDialog: TPrintDialog;
  196. FSaveEncodingUTF8NoPreamble: TMenuItem;
  197. TFilesDesigner: TMenuItem;
  198. VCloseTab: TMenuItem;
  199. VReopenTab: TMenuItem;
  200. VReopenTabs: TMenuItem;
  201. MemosTabSetPopupMenu: TPopupMenu;
  202. VCloseTab2: TMenuItem;
  203. VReopenTab2: TMenuItem;
  204. VReopenTabs2: TMenuItem;
  205. procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  206. procedure FExitClick(Sender: TObject);
  207. procedure FOpenMainFileClick(Sender: TObject);
  208. procedure EUndoClick(Sender: TObject);
  209. procedure EMenuClick(Sender: TObject);
  210. procedure ECutClick(Sender: TObject);
  211. procedure ECopyClick(Sender: TObject);
  212. procedure EPasteClick(Sender: TObject);
  213. procedure EDeleteClick(Sender: TObject);
  214. procedure FSaveClick(Sender: TObject);
  215. procedure ESelectAllClick(Sender: TObject);
  216. procedure FNewMainFileClick(Sender: TObject);
  217. procedure FNewMainFileUserWizardClick(Sender: TObject);
  218. procedure HDocClick(Sender: TObject);
  219. procedure BCompileClick(Sender: TObject);
  220. procedure FMenuClick(Sender: TObject);
  221. procedure FMRUClick(Sender: TObject);
  222. procedure VCompilerOutputClick(Sender: TObject);
  223. procedure HAboutClick(Sender: TObject);
  224. procedure EFindClick(Sender: TObject);
  225. procedure FindDialogFind(Sender: TObject);
  226. procedure EReplaceClick(Sender: TObject);
  227. procedure ReplaceDialogReplace(Sender: TObject);
  228. procedure EFindNextOrPreviousClick(Sender: TObject);
  229. procedure SplitPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
  230. Y: Integer);
  231. procedure VMenuClick(Sender: TObject);
  232. procedure HWebsiteClick(Sender: TObject);
  233. procedure VToolbarClick(Sender: TObject);
  234. procedure TOptionsClick(Sender: TObject);
  235. procedure HFaqClick(Sender: TObject);
  236. procedure HPSWebsiteClick(Sender: TObject);
  237. procedure HISPPDocClick(Sender: TObject);
  238. procedure VStatusBarClick(Sender: TObject);
  239. procedure ERedoClick(Sender: TObject);
  240. procedure StatusBarResize(Sender: TObject);
  241. procedure RStepIntoClick(Sender: TObject);
  242. procedure RStepOverClick(Sender: TObject);
  243. procedure RRunToCursorClick(Sender: TObject);
  244. procedure RRunClick(Sender: TObject);
  245. procedure REvaluateClick(Sender: TObject);
  246. procedure CheckIfRunningTimerTimer(Sender: TObject);
  247. procedure RPauseClick(Sender: TObject);
  248. procedure RParametersClick(Sender: TObject);
  249. procedure PListCopyClick(Sender: TObject);
  250. procedure BStopCompileClick(Sender: TObject);
  251. procedure HMenuClick(Sender: TObject);
  252. procedure EGotoClick(Sender: TObject);
  253. procedure RTerminateClick(Sender: TObject);
  254. procedure BMenuClick(Sender: TObject);
  255. procedure BLowPriorityClick(Sender: TObject);
  256. procedure StatusBarDrawPanel(StatusBar: TStatusBar;
  257. Panel: TStatusPanel; const Rect: TRect);
  258. procedure HDonateClick(Sender: TObject);
  259. procedure RTargetClick(Sender: TObject);
  260. procedure DebugOutputListDrawItem(Control: TWinControl; Index: Integer;
  261. Rect: TRect; State: TOwnerDrawState);
  262. procedure OutputTabSetClick(Sender: TObject);
  263. procedure VHideClick(Sender: TObject);
  264. procedure VDebugOutputClick(Sender: TObject);
  265. procedure FormResize(Sender: TObject);
  266. procedure TAddRemoveProgramsClick(Sender: TObject);
  267. procedure RToggleBreakPointClick(Sender: TObject);
  268. procedure HWhatsNewClick(Sender: TObject);
  269. procedure TGenerateGUIDClick(Sender: TObject);
  270. procedure TSignToolsClick(Sender: TObject);
  271. procedure HExamplesClick(Sender: TObject);
  272. procedure BOpenOutputFolderClick(Sender: TObject);
  273. procedure FormKeyDown(Sender: TObject; var Key: Word;
  274. Shift: TShiftState);
  275. procedure VZoomInClick(Sender: TObject);
  276. procedure VZoomOutClick(Sender: TObject);
  277. procedure VZoomResetClick(Sender: TObject);
  278. procedure ECompleteWordClick(Sender: TObject);
  279. procedure FSaveEncodingItemClick(Sender: TObject);
  280. procedure CompilerOutputListDrawItem(Control: TWinControl; Index: Integer;
  281. Rect: TRect; State: TOwnerDrawState);
  282. procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
  283. NewDPI: Integer);
  284. procedure PListSelectAllClick(Sender: TObject);
  285. procedure DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  286. State: TOwnerDrawState);
  287. procedure VDebugCallStackClick(Sender: TObject);
  288. procedure HMailingListClick(Sender: TObject);
  289. procedure TMsgBoxDesignerClick(Sender: TObject);
  290. procedure MemosTabSetClick(Sender: TObject);
  291. procedure FSaveAllClick(Sender: TObject);
  292. procedure RStepOutClick(Sender: TObject);
  293. procedure TMenuClick(Sender: TObject);
  294. procedure VNextTabClick(Sender: TObject);
  295. procedure VPreviousTabClick(Sender: TObject);
  296. procedure HShortcutsDocClick(Sender: TObject);
  297. procedure VFindResultsClick(Sender: TObject);
  298. procedure EFindInFilesClick(Sender: TObject);
  299. procedure FindInFilesDialogFind(Sender: TObject);
  300. procedure FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  301. State: TOwnerDrawState);
  302. procedure FindResultsListDblClick(Sender: TObject);
  303. procedure FPrintClick(Sender: TObject);
  304. procedure TFilesDesignerClick(Sender: TObject);
  305. procedure VCloseTabClick(Sender: TObject);
  306. procedure VReopenTabClick(Sender: TObject);
  307. procedure VReopenTabsClick(Sender: TObject);
  308. procedure MemosTabSetPopup(Sender: TObject);
  309. procedure MemosTabSetOnCloseButtonClick(Sender: TObject);
  310. procedure StatusBarClick(Sender: TObject);
  311. private
  312. { Private declarations }
  313. FMemos: TList<TCompScintEdit>; { FMemos[0] is the main memo and FMemos[1] the preprocessor output memo - also see MemosTabSet comment above }
  314. FMainMemo: TCompScintFileEdit; { Doesn't change }
  315. FPreprocessorOutputMemo: TCompScintEdit; { Doesn't change }
  316. FFileMemos: TList<TCompScintFileEdit>; { All memos except FPreprocessorOutputMemo, including those without a tab }
  317. FHiddenFiles: TStringList; { List of files which *do* use a memo but are hidden by the user and have no tab }
  318. FActiveMemo: TCompScintEdit; { Changes depending on user input }
  319. FErrorMemo, FStepMemo: TCompScintFileEdit; { These change depending on user input }
  320. FMemosStyler: TInnoSetupStyler; { Single styler for all memos }
  321. FCompilerVersion: PCompilerVersionInfo;
  322. FMRUMainFilesMenuItems: array[0..MRUListMaxCount-1] of TMenuItem;
  323. FMRUMainFilesList: TStringList;
  324. FMRUParametersList: TStringList;
  325. FOptions: record
  326. ShowStartupForm: Boolean;
  327. UseWizard: Boolean;
  328. Autosave: Boolean;
  329. MakeBackups: Boolean;
  330. FullPathInTitleBar: Boolean;
  331. UndoAfterSave: Boolean;
  332. PauseOnDebuggerExceptions: Boolean;
  333. RunAsDifferentUser: Boolean;
  334. AutoComplete: Boolean;
  335. UseSyntaxHighlighting: Boolean;
  336. ColorizeCompilerOutput: Boolean;
  337. UnderlineErrors: Boolean;
  338. CursorPastEOL: Boolean;
  339. TabWidth: Integer;
  340. UseTabCharacter: Boolean;
  341. WordWrap: Boolean;
  342. AutoIndent: Boolean;
  343. IndentationGuides: Boolean;
  344. LowPriorityDuringCompile: Boolean;
  345. GutterLineNumbers: Boolean;
  346. ThemeType: TThemeType;
  347. ShowPreprocessorOutput: Boolean;
  348. OpenIncludedFiles: Boolean;
  349. end;
  350. FOptionsLoaded: Boolean;
  351. FTheme: TTheme;
  352. FSignTools: TStringList;
  353. FFindResults: TFindResults;
  354. FCompiling: Boolean;
  355. FCompileWantAbort: Boolean;
  356. FBecameIdle: Boolean;
  357. FModifiedAnySinceLastCompile, FModifiedAnySinceLastCompileAndGo: Boolean;
  358. FDebugEntries: PDebugEntryArray;
  359. FDebugEntriesCount: Integer;
  360. FVariableDebugEntries: PVariableDebugEntryArray;
  361. FVariableDebugEntriesCount: Integer;
  362. FCompiledCodeText: AnsiString;
  363. FCompiledCodeDebugInfo: AnsiString;
  364. FDebugClientWnd: HWND;
  365. FProcessHandle, FDebugClientProcessHandle: THandle;
  366. FDebugTarget: TDebugTarget;
  367. FCompiledExe, FUninstExe, FTempDir: String;
  368. FPreprocessorOutput: String;
  369. FIncludedFiles: TIncludedFiles;
  370. FLoadingIncludedFiles: Boolean;
  371. FDebugging: Boolean;
  372. FStepMode: TStepMode;
  373. FPaused, FPausedAtCodeLine: Boolean;
  374. FRunToCursorPoint: TDebugEntry;
  375. FReplyString: String;
  376. FDebuggerException: String;
  377. FRunParameters: String;
  378. FLastFindOptions: TFindOptions;
  379. FLastFindText: String;
  380. FLastReplaceText: String;
  381. FLastEvaluateConstantText: String;
  382. FSavePriorityClass: DWORD;
  383. FBuildAnimationFrame: Cardinal;
  384. FLastAnimationTick: DWORD;
  385. FProgress, FProgressMax: Cardinal;
  386. FProgressThemeData: HTHEME;
  387. FProgressChunkSize, FProgressSpaceSize: Integer;
  388. FDebugLogListTimestampsWidth: Integer;
  389. FOnPendingSquiggly: Boolean;
  390. FPendingSquigglyCaretPos: Integer;
  391. FCallStackCount: Cardinal;
  392. FDevMode, FDevNames: HGLOBAL;
  393. class procedure AppOnException(Sender: TObject; E: Exception);
  394. procedure AppOnActivate(Sender: TObject);
  395. procedure AppOnIdle(Sender: TObject; var Done: Boolean);
  396. function AskToDetachDebugger: Boolean;
  397. procedure BringToForeground;
  398. procedure CheckIfTerminated;
  399. procedure CompileFile(AFilename: String; const ReadFromFile: Boolean);
  400. procedure CompileIfNecessary;
  401. function ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
  402. procedure DebuggingStopped(const WaitForTermination: Boolean);
  403. procedure DebugLogMessage(const S: String);
  404. procedure DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
  405. procedure DestroyDebugInfo;
  406. procedure DetachDebugger;
  407. function EvaluateConstant(const S: String; var Output: String): Integer;
  408. function EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
  409. var Output: String): Integer;
  410. procedure FindNext;
  411. function FromCurrentPPI(const XY: Integer): Integer;
  412. procedure Go(AStepMode: TStepMode);
  413. procedure HideError;
  414. procedure InitializeFindText(Dlg: TFindDialog);
  415. function InitializeFileMemo(const Memo: TCompScintFileEdit; const PopupMenu: TPopupMenu): TCompScintFileEdit;
  416. function InitializeMainMemo(const Memo: TCompScintFileEdit; const PopupMenu: TPopupMenu): TCompScintFileEdit;
  417. function InitializeMemoBase(const Memo: TCompScintEdit; const PopupMenu: TPopupMenu): TCompScintEdit;
  418. function InitializeNonFileMemo(const Memo: TCompScintEdit; const PopupMenu: TPopupMenu): TCompScintEdit;
  419. procedure InitiateAutoComplete(const Key: AnsiChar);
  420. procedure InvalidateStatusPanel(const Index: Integer);
  421. procedure LoadKnownIncludedAndHiddenFilesAndUpdateMemos(const AFilename: String);
  422. procedure MemoChange(Sender: TObject; const Info: TScintEditChangeInfo);
  423. procedure MemoCharAdded(Sender: TObject; Ch: AnsiChar);
  424. procedure MainMemoDropFiles(Sender: TObject; X, Y: Integer; AFiles: TStrings);
  425. procedure MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
  426. procedure MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  427. procedure MemoKeyPress(Sender: TObject; var Key: Char);
  428. procedure MemoLinesDeleted(Memo: TCompScintFileEdit; FirstLine, Count, FirstAffectedLine: Integer);
  429. procedure MemoLinesInserted(Memo: TCompScintFileEdit; FirstLine, Count: integer);
  430. procedure MemoMarginClick(Sender: TObject; MarginNumber: Integer;
  431. Line: Integer);
  432. procedure MemoModifiedChange(Sender: TObject);
  433. function MemoToTabIndex(const AMemo: TCompScintEdit): Integer;
  434. procedure MemoUpdateUI(Sender: TObject);
  435. procedure UpdateReopenTabMenu(const Menu: TMenuItem);
  436. procedure ModifyMRUMainFilesList(const AFilename: String; const AddNewItem: Boolean);
  437. procedure ModifyMRUParametersList(const AParameter: String; const AddNewItem: Boolean);
  438. procedure MoveCaretAndActivateMemo(AMemo: TCompScintFileEdit; const LineNumber: Integer; const AlwaysResetColumn: Boolean);
  439. procedure NewMainFile;
  440. procedure NewMainFileUsingWizard;
  441. procedure OpenFile(AMemo: TCompScintFileEdit; AFilename: String; const MainMemoAddToRecentDocs: Boolean);
  442. procedure OpenMRUMainFile(const AFilename: String);
  443. procedure ParseDebugInfo(DebugInfo: Pointer);
  444. procedure ReadMRUMainFilesList;
  445. procedure ReadMRUParametersList;
  446. procedure ReopenTabOrTabs(const HiddenFileIndex: Integer; const Activate: Boolean);
  447. procedure ResetAllMemosLineState;
  448. procedure StartProcess;
  449. function SaveFile(const AMemo: TCompScintFileEdit; const SaveAs: Boolean): Boolean;
  450. procedure SaveKnownIncludedAndHiddenFiles(const AFilename: String);
  451. procedure SetErrorLine(const AMemo: TCompScintFileEdit; const ALine: Integer);
  452. procedure SetStatusPanelVisible(const AVisible: Boolean);
  453. procedure SetStepLine(const AMemo: TCompScintFileEdit; ALine: Integer);
  454. procedure ShowOpenMainFileDialog(const Examples: Boolean);
  455. procedure StatusMessage(const Kind: TStatusMessageKind; const S: String);
  456. procedure StoreLastFindOptions(Sender: TObject);
  457. procedure SyncEditorOptions;
  458. procedure SyncZoom;
  459. function ToCurrentPPI(const XY: Integer): Integer;
  460. procedure ToggleBreakPoint(Line: Integer);
  461. procedure UpdateAllMemosLineMarkers;
  462. procedure UpdateBevel1Visibility;
  463. procedure UpdateCaption;
  464. procedure UpdateCaretPosPanel;
  465. procedure UpdateCompileStatusPanels(const AProgress, AProgressMax: Cardinal;
  466. const ASecondsRemaining: Integer; const ABytesCompressedPerSecond: Cardinal);
  467. procedure UpdateEditModePanel;
  468. procedure UpdateHiddenFilesPanel;
  469. procedure UpdatePreprocMemos;
  470. procedure UpdateLineMarkers(const AMemo: TCompScintFileEdit; const Line: Integer);
  471. procedure UpdateMemosTabSetVisibility;
  472. procedure UpdateModifiedPanel;
  473. procedure UpdateNewMainFileButtons;
  474. procedure UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  475. procedure UpdateRunMenu;
  476. procedure UpdateSaveMenuItemAndButton;
  477. procedure UpdateTargetMenu;
  478. procedure UpdateTheme;
  479. procedure UpdateThemeData(const Open: Boolean);
  480. procedure UpdateStatusPanelHeight(H: Integer);
  481. procedure WMCopyData(var Message: TWMCopyData); message WM_COPYDATA;
  482. procedure WMDebuggerHello(var Message: TMessage); message WM_Debugger_Hello;
  483. procedure WMDebuggerGoodbye(var Message: TMessage); message WM_Debugger_Goodbye;
  484. procedure WMDebuggerQueryVersion(var Message: TMessage); message WM_Debugger_QueryVersion;
  485. procedure GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TCompScintFileEdit;
  486. var DebugEntry: PDebugEntry);
  487. procedure DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
  488. procedure WMDebuggerStepped(var Message: TMessage); message WM_Debugger_Stepped;
  489. procedure WMDebuggerSteppedIntermediate(var Message: TMessage); message WM_Debugger_SteppedIntermediate;
  490. procedure WMDebuggerException(var Message: TMessage); message WM_Debugger_Exception;
  491. procedure WMDebuggerSetForegroundWindow(var Message: TMessage); message WM_Debugger_SetForegroundWindow;
  492. procedure WMDebuggerCallStackCount(var Message: TMessage); message WM_Debugger_CallStackCount;
  493. procedure WMStartCommandLineCompile(var Message: TMessage); message WM_StartCommandLineCompile;
  494. procedure WMStartCommandLineWizard(var Message: TMessage); message WM_StartCommandLineWizard;
  495. procedure WMStartNormally(var Message: TMessage); message WM_StartNormally;
  496. procedure WMSettingChange(var Message: TMessage); message WM_SETTINGCHANGE;
  497. procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
  498. protected
  499. procedure WndProc(var Message: TMessage); override;
  500. public
  501. { Public declarations }
  502. constructor Create(AOwner: TComponent); override;
  503. destructor Destroy; override;
  504. function IsShortCut(var Message: TWMKey): Boolean; override;
  505. end;
  506. var
  507. CompileForm: TCompileForm;
  508. CommandLineFilename, CommandLineWizardName: String;
  509. CommandLineCompile: Boolean;
  510. CommandLineWizard: Boolean;
  511. implementation
  512. uses
  513. ActiveX, Clipbrd, ShellApi, ShlObj, IniFiles, Registry, Consts, Types, UITypes, Math, WideStrUtils,
  514. PathFunc, CmnFunc, CmnFunc2, FileClass, CompMsgs, TmSchema, BrowseFunc,
  515. HtmlHelpFunc, TaskbarProgressFunc,
  516. {$IFDEF STATICCOMPILER} Compile, {$ENDIF}
  517. CompOptions, CompStartup, CompWizard, CompSignTools, CompTypes, CompInputQueryCombo, CompMsgBoxDesigner,
  518. CompFilesDesigner;
  519. {$R *.DFM}
  520. const
  521. { Memos }
  522. MaxMemos = 22; { Includes the main and preprocessor output memos }
  523. FirstIncludedFilesMemoIndex = 1; { This is an index into FFileMemos }
  524. { Status bar panel indexes }
  525. spCaretPos = 0;
  526. spModified = 1;
  527. spEditMode = 2;
  528. spHiddenFilesCount = 3;
  529. spCompileIcon = 4;
  530. spCompileProgress = 5;
  531. spExtraStatus = 6;
  532. { Output tab set indexes }
  533. tiCompilerOutput = 0;
  534. tiDebugOutput = 1;
  535. tiDebugCallStack = 2;
  536. tiFindResults = 3;
  537. LineStateGrowAmount = 4000;
  538. { TCompileFormMemoPopupMenu }
  539. type
  540. TCompileFormMemoPopupMenu = class(TPopupMenu)
  541. public
  542. procedure Popup(X, Y: Integer); override;
  543. end;
  544. procedure TCompileFormMemoPopupMenu.Popup(X, Y: Integer);
  545. var
  546. Form: TCompileForm;
  547. begin
  548. { Show the existing Edit menu }
  549. Form := Owner as TCompileForm;
  550. TrackPopupMenu(Form.EMenu.Handle, TPM_RIGHTBUTTON, X, Y, 0, Form.Handle, nil);
  551. end;
  552. { TCompileForm }
  553. function TCompileForm.InitializeMemoBase(const Memo: TCompScintEdit; const PopupMenu: TPopupMenu): TCompScintEdit;
  554. begin
  555. Memo.Align := alClient;
  556. Memo.AutoCompleteFontName := Font.Name;
  557. Memo.AutoCompleteFontSize := Font.Size;
  558. Memo.CodePage := CP_UTF8;
  559. Memo.Font.Name := 'Courier New';
  560. Memo.Font.Size := 10;
  561. Memo.ShowHint := True;
  562. Memo.Styler := FMemosStyler;
  563. Memo.PopupMenu := PopupMenu;
  564. Memo.OnChange := MemoChange;
  565. Memo.OnCharAdded := MemoCharAdded;
  566. Memo.OnHintShow := MemoHintShow;
  567. Memo.OnKeyDown := MemoKeyDown;
  568. Memo.OnKeyPress := MemoKeyPress;
  569. Memo.OnMarginClick := MemoMarginClick;
  570. Memo.OnModifiedChange := MemoModifiedChange;
  571. Memo.OnUpdateUI := MemoUpdateUI;
  572. Memo.Parent := BodyPanel;
  573. Memo.SetAutoCompleteSeparator(InnoSetupStylerWordListSeparator);
  574. Memo.SetWordChars(Memo.GetDefaultWordChars+'#{}[]');
  575. Memo.Theme := FTheme;
  576. Memo.Visible := False;
  577. Result := Memo;
  578. end;
  579. function TCompileForm.InitializeFileMemo(const Memo: TCompScintFileEdit; const PopupMenu: TPopupMenu): TCompScintFileEdit;
  580. begin
  581. InitializeMemoBase(Memo, PopupMenu);
  582. Memo.CompilerFileIndex := UnknownCompilerFileIndex;
  583. Memo.ErrorLine := -1;
  584. Memo.StepLine := -1;
  585. Result := Memo;
  586. end;
  587. function TCompileForm.InitializeMainMemo(const Memo: TCompScintFileEdit; const PopupMenu: TPopupMenu): TCompScintFileEdit;
  588. begin
  589. InitializeFileMemo(Memo, PopupMenu);
  590. Memo.AcceptDroppedFiles := True;
  591. Memo.CompilerFileIndex := -1;
  592. Memo.OnDropFiles := MainMemoDropFiles;
  593. Memo.Used := True;
  594. Result := Memo;
  595. end;
  596. function TCompileForm.InitializeNonFileMemo(const Memo: TCompScintEdit; const PopupMenu: TPopupMenu): TCompScintEdit;
  597. begin
  598. InitializeMemoBase(Memo, PopupMenu);
  599. Memo.ReadOnly := True;
  600. Result := Memo;
  601. end;
  602. constructor TCompileForm.Create(AOwner: TComponent);
  603. procedure ReadConfig;
  604. var
  605. Ini: TConfigIniFile;
  606. WindowPlacement: TWindowPlacement;
  607. I: Integer;
  608. Memo: TCompScintEdit;
  609. begin
  610. Ini := TConfigIniFile.Create;
  611. try
  612. { Menu check boxes state }
  613. Toolbar.Visible := Ini.ReadBool('Options', 'ShowToolbar', True);
  614. StatusBar.Visible := Ini.ReadBool('Options', 'ShowStatusBar', True);
  615. FOptions.LowPriorityDuringCompile := Ini.ReadBool('Options', 'LowPriorityDuringCompile', False);
  616. { Configuration options }
  617. FOptions.ShowStartupForm := Ini.ReadBool('Options', 'ShowStartupForm', True);
  618. FOptions.UseWizard := Ini.ReadBool('Options', 'UseWizard', True);
  619. FOptions.Autosave := Ini.ReadBool('Options', 'Autosave', False);
  620. FOptions.MakeBackups := Ini.ReadBool('Options', 'MakeBackups', False);
  621. FOptions.FullPathInTitleBar := Ini.ReadBool('Options', 'FullPathInTitleBar', False);
  622. FOptions.UndoAfterSave := Ini.ReadBool('Options', 'UndoAfterSave', True);
  623. FOptions.PauseOnDebuggerExceptions := Ini.ReadBool('Options', 'PauseOnDebuggerExceptions', True);
  624. FOptions.RunAsDifferentUser := Ini.ReadBool('Options', 'RunAsDifferentUser', False);
  625. FOptions.AutoComplete := Ini.ReadBool('Options', 'AutoComplete', True);
  626. FOptions.UseSyntaxHighlighting := Ini.ReadBool('Options', 'UseSynHigh', True);
  627. FOptions.ColorizeCompilerOutput := Ini.ReadBool('Options', 'ColorizeCompilerOutput', True);
  628. FOptions.UnderlineErrors := Ini.ReadBool('Options', 'UnderlineErrors', True);
  629. FOptions.CursorPastEOL := Ini.ReadBool('Options', 'EditorCursorPastEOL', True);
  630. FOptions.TabWidth := Ini.ReadInteger('Options', 'TabWidth', 2);
  631. FOptions.UseTabCharacter := Ini.ReadBool('Options', 'UseTabCharacter', False);
  632. FOptions.WordWrap := Ini.ReadBool('Options', 'WordWrap', False);
  633. FOptions.AutoIndent := Ini.ReadBool('Options', 'AutoIndent', True);
  634. FOptions.IndentationGuides := Ini.ReadBool('Options', 'IndentationGuides', True);
  635. FOptions.GutterLineNumbers := Ini.ReadBool('Options', 'GutterLineNumbers', False);
  636. FOptions.ShowPreprocessorOutput := Ini.ReadBool('Options', 'ShowPreprocessorOutput', True);
  637. FOptions.OpenIncludedFiles := Ini.ReadBool('Options', 'OpenIncludedFiles', True);
  638. I := Ini.ReadInteger('Options', 'ThemeType', Ord(GetDefaultThemeType));
  639. if (I >= 0) and (I <= Ord(High(TThemeType))) then
  640. FOptions.ThemeType := TThemeType(I);
  641. FMainMemo.Font.Name := Ini.ReadString('Options', 'EditorFontName', FMainMemo.Font.Name);
  642. FMainMemo.Font.Size := Ini.ReadInteger('Options', 'EditorFontSize', FMainMemo.Font.Size);
  643. FMainMemo.Font.Charset := Ini.ReadInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset);
  644. FMainMemo.Zoom := Ini.ReadInteger('Options', 'Zoom', 0);
  645. for Memo in FMemos do begin
  646. if Memo <> FMainMemo then begin
  647. Memo.Font := FMainMemo.Font;
  648. Memo.Zoom := FMainMemo.Zoom;
  649. end;
  650. end;
  651. SyncEditorOptions;
  652. UpdateNewMainFileButtons;
  653. UpdateTheme;
  654. { Window state }
  655. WindowPlacement.length := SizeOf(WindowPlacement);
  656. GetWindowPlacement(Handle, @WindowPlacement);
  657. WindowPlacement.showCmd := SW_HIDE; { the form isn't Visible yet }
  658. WindowPlacement.rcNormalPosition.Left := Ini.ReadInteger('State',
  659. 'WindowLeft', WindowPlacement.rcNormalPosition.Left);
  660. WindowPlacement.rcNormalPosition.Top := Ini.ReadInteger('State',
  661. 'WindowTop', WindowPlacement.rcNormalPosition.Top);
  662. WindowPlacement.rcNormalPosition.Right := Ini.ReadInteger('State',
  663. 'WindowRight', WindowPlacement.rcNormalPosition.Left + Width);
  664. WindowPlacement.rcNormalPosition.Bottom := Ini.ReadInteger('State',
  665. 'WindowBottom', WindowPlacement.rcNormalPosition.Top + Height);
  666. SetWindowPlacement(Handle, @WindowPlacement);
  667. { Note: Must set WindowState *after* calling SetWindowPlacement, since
  668. TCustomForm.WMSize resets WindowState }
  669. if Ini.ReadBool('State', 'WindowMaximized', False) then
  670. WindowState := wsMaximized;
  671. { Note: Don't call UpdateStatusPanelHeight here since it clips to the
  672. current form height, which hasn't been finalized yet }
  673. StatusPanel.Height := ToCurrentPPI(Ini.ReadInteger('State', 'StatusPanelHeight',
  674. (10 * FromCurrentPPI(DebugOutputList.ItemHeight) + 4) + FromCurrentPPI(OutputTabSet.Height)));
  675. finally
  676. Ini.Free;
  677. end;
  678. FOptionsLoaded := True;
  679. end;
  680. var
  681. I: Integer;
  682. NewItem: TMenuItem;
  683. PopupMenu: TPopupMenu;
  684. Memo: TCompScintEdit;
  685. begin
  686. inherited;
  687. {$IFNDEF STATICCOMPILER}
  688. FCompilerVersion := ISDllGetVersion;
  689. {$ELSE}
  690. FCompilerVersion := ISGetVersion;
  691. {$ENDIF}
  692. FModifiedAnySinceLastCompile := True;
  693. InitFormFont(Self);
  694. { For some reason, if AutoScroll=False is set on the form Delphi ignores the
  695. 'poDefault' Position setting }
  696. AutoScroll := False;
  697. { Append the shortcut key text to the Edit items. Don't actually set the
  698. ShortCut property because we don't want the key combinations having an
  699. effect when Memo doesn't have the focus. }
  700. SetFakeShortCut(EUndo, Ord('Z'), [ssCtrl]);
  701. SetFakeShortCut(ERedo, Ord('Y'), [ssCtrl]);
  702. SetFakeShortCut(ECut, Ord('X'), [ssCtrl]);
  703. SetFakeShortCut(ECopy, Ord('C'), [ssCtrl]);
  704. SetFakeShortCut(EPaste, Ord('V'), [ssCtrl]);
  705. SetFakeShortCut(ESelectAll, Ord('A'), [ssCtrl]);
  706. SetFakeShortCut(EDelete, VK_DELETE, []);
  707. SetFakeShortCut(ECompleteWord, VK_RIGHT, [ssAlt]);
  708. 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 }
  709. SetFakeShortCutText(VZoomOut, SmkcCtrl + 'Num -');
  710. SetFakeShortCutText(VZoomReset, SmkcCtrl + 'Num /');
  711. { Use fake Esc shortcut for Stop Compile so it doesn't conflict with the
  712. editor's autocompletion list }
  713. SetFakeShortCut(BStopCompile, VK_ESCAPE, []);
  714. PopupMenu := TCompileFormMemoPopupMenu.Create(Self);
  715. FMemosStyler := TInnoSetupStyler.Create(Self);
  716. FMemosStyler.ISPPInstalled := ISPPInstalled;
  717. FTheme := TTheme.Create;
  718. FMemos := TList<TCompScintEdit>.Create;
  719. FMainMemo := InitializeMainMemo(TCompScintFileEdit.Create(Self), PopupMenu);
  720. FMemos.Add(FMainMemo);
  721. FPreprocessorOutputMemo := InitializeNonFileMemo(TCompScintEdit.Create(Self), PopupMenu);
  722. FMemos.Add(FPreprocessorOutputMemo);
  723. for I := FMemos.Count to MaxMemos-1 do
  724. FMemos.Add(InitializeFileMemo(TCompScintFileEdit.Create(Self), PopupMenu));
  725. FFileMemos := TList<TCompScintFileEdit>.Create;
  726. for Memo in FMemos do
  727. if Memo is TCompScintFileEdit then
  728. FFileMemos.Add(TCompScintFileEdit(Memo));
  729. FHiddenFiles := TStringList.Create(dupError, True, True);
  730. FActiveMemo := FMainMemo;
  731. FActiveMemo.Visible := True;
  732. FErrorMemo := FMainMemo;
  733. FStepMemo := FMainMemo;
  734. FMemosStyler.Theme := FTheme;
  735. UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  736. Application.HintShortPause := 0;
  737. Application.OnException := AppOnException;
  738. Application.OnActivate := AppOnActivate;
  739. Application.OnIdle := AppOnIdle;
  740. FMRUMainFilesList := TStringList.Create;
  741. for I := 0 to High(FMRUMainFilesMenuItems) do begin
  742. NewItem := TMenuItem.Create(Self);
  743. NewItem.OnClick := FMRUClick;
  744. FMenu.Insert(FMenu.IndexOf(FMRUMainFilesSep), NewItem);
  745. FMRUMainFilesMenuItems[I] := NewItem;
  746. end;
  747. FMRUParametersList := TStringList.Create;
  748. FSignTools := TStringList.Create;
  749. FFindResults := TFindResults.Create;
  750. FIncludedFiles := TIncludedFiles.Create;
  751. UpdatePreprocMemos;
  752. FDebugTarget := dtSetup;
  753. UpdateTargetMenu;
  754. UpdateCaption;
  755. UpdateThemeData(True);
  756. if CommandLineCompile then begin
  757. ReadSignTools(FSignTools);
  758. PostMessage(Handle, WM_StartCommandLineCompile, 0, 0)
  759. end else if CommandLineWizard then begin
  760. { Stop Delphi from showing the compiler form }
  761. Application.ShowMainForm := False;
  762. { Show wizard form later }
  763. PostMessage(Handle, WM_StartCommandLineWizard, 0, 0);
  764. end else begin
  765. ReadConfig;
  766. ReadSignTools(FSignTools);
  767. PostMessage(Handle, WM_StartNormally, 0, 0);
  768. end;
  769. end;
  770. destructor TCompileForm.Destroy;
  771. procedure SaveConfig;
  772. var
  773. Ini: TConfigIniFile;
  774. WindowPlacement: TWindowPlacement;
  775. begin
  776. Ini := TConfigIniFile.Create;
  777. try
  778. { Theme state }
  779. Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see TOptionsClick }
  780. { Menu check boxes state }
  781. Ini.WriteBool('Options', 'ShowToolbar', Toolbar.Visible);
  782. Ini.WriteBool('Options', 'ShowStatusBar', StatusBar.Visible);
  783. Ini.WriteBool('Options', 'LowPriorityDuringCompile', FOptions.LowPriorityDuringCompile);
  784. { Window state }
  785. WindowPlacement.length := SizeOf(WindowPlacement);
  786. GetWindowPlacement(Handle, @WindowPlacement);
  787. Ini.WriteInteger('State', 'WindowLeft', WindowPlacement.rcNormalPosition.Left);
  788. Ini.WriteInteger('State', 'WindowTop', WindowPlacement.rcNormalPosition.Top);
  789. Ini.WriteInteger('State', 'WindowRight', WindowPlacement.rcNormalPosition.Right);
  790. Ini.WriteInteger('State', 'WindowBottom', WindowPlacement.rcNormalPosition.Bottom);
  791. Ini.WriteBool('State', 'WindowMaximized', WindowState = wsMaximized);
  792. Ini.WriteInteger('State', 'StatusPanelHeight', FromCurrentPPI(StatusPanel.Height));
  793. { Zoom state }
  794. Ini.WriteInteger('Options', 'Zoom', FMainMemo.Zoom); { Only saves the main memo's zoom }
  795. finally
  796. Ini.Free;
  797. end;
  798. end;
  799. begin
  800. UpdateThemeData(False);
  801. Application.OnActivate := nil;
  802. Application.OnIdle := nil;
  803. if FOptionsLoaded and not (CommandLineCompile or CommandLineWizard) then
  804. SaveConfig;
  805. if FDevMode <> 0 then
  806. GlobalFree(FDevMode);
  807. if FDevNames <> 0 then
  808. GlobalFree(FDevNames);
  809. FTheme.Free;
  810. DestroyDebugInfo;
  811. FIncludedFiles.Free;
  812. FFindResults.Free;
  813. FSignTools.Free;
  814. FMRUParametersList.Free;
  815. FMRUMainFilesList.Free;
  816. FFileMemos.Free;
  817. FHiddenFiles.Free;
  818. FMemos.Free;
  819. inherited;
  820. end;
  821. class procedure TCompileForm.AppOnException(Sender: TObject; E: Exception);
  822. begin
  823. AppMessageBox(PChar(AddPeriod(E.Message)), SCompilerFormCaption,
  824. MB_OK or MB_ICONSTOP);
  825. end;
  826. procedure TCompileForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI,
  827. NewDPI: Integer);
  828. begin
  829. UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  830. UpdateStatusPanelHeight(StatusPanel.Height);
  831. end;
  832. procedure TCompileForm.FormCloseQuery(Sender: TObject;
  833. var CanClose: Boolean);
  834. begin
  835. if IsWindowEnabled(Application.Handle) then
  836. CanClose := ConfirmCloseFile(True)
  837. else
  838. { CloseQuery is also called by the VCL when a WM_QUERYENDSESSION message
  839. is received. Don't display message box if a modal dialog is already
  840. displayed. }
  841. CanClose := False;
  842. end;
  843. procedure TCompileForm.FormKeyDown(Sender: TObject; var Key: Word;
  844. Shift: TShiftState);
  845. begin
  846. if ShortCut(Key, Shift) = VK_ESCAPE then begin
  847. if BStopCompile.Enabled then
  848. BStopCompileClick(Self);
  849. end
  850. else if (Key = VK_F6) and not(ssAlt in Shift) then begin
  851. { Toggle focus between panes }
  852. Key := 0;
  853. if ActiveControl <> FActiveMemo then
  854. ActiveControl := FActiveMemo
  855. else if StatusPanel.Visible then begin
  856. case OutputTabSet.TabIndex of
  857. tiCompilerOutput: ActiveControl := CompilerOutputList;
  858. tiDebugOutput: ActiveControl := DebugOutputList;
  859. tiDebugCallStack: ActiveControl := DebugCallStackList;
  860. tiFindResults: ActiveControl := FindResultsList;
  861. end;
  862. end;
  863. end;
  864. end;
  865. procedure TCompileForm.FormResize(Sender: TObject);
  866. begin
  867. { Make sure the status panel's height is decreased if necessary in response
  868. to the form's height decreasing }
  869. if StatusPanel.Visible then
  870. UpdateStatusPanelHeight(StatusPanel.Height);
  871. end;
  872. procedure TCompileForm.WndProc(var Message: TMessage);
  873. begin
  874. { Without this, the status bar's owner drawn panels sometimes get corrupted and show
  875. menu items instead. See:
  876. http://groups.google.com/group/borland.public.delphi.vcl.components.using/browse_thread/thread/e4cb6c3444c70714 }
  877. with Message do
  878. case Msg of
  879. WM_DRAWITEM:
  880. with PDrawItemStruct(Message.LParam)^ do
  881. if (CtlType = ODT_MENU) and not IsMenu(hwndItem) then
  882. CtlType := ODT_STATIC;
  883. end;
  884. inherited
  885. end;
  886. function TCompileForm.IsShortCut(var Message: TWMKey): Boolean;
  887. begin
  888. { Key messages are forwarded by the VCL to the main form for ShortCut
  889. processing. In Delphi 5+, however, this happens even when a TFindDialog
  890. is active, causing Ctrl+V/Esc/etc. to be intercepted by the main form.
  891. Work around this by always returning False when not Active. }
  892. if Active then
  893. Result := inherited IsShortCut(Message)
  894. else
  895. Result := False;
  896. end;
  897. procedure TCompileForm.UpdateCaption;
  898. var
  899. NewCaption: String;
  900. begin
  901. if FMainMemo.Filename = '' then
  902. NewCaption := GetFileTitle(FMainMemo.Filename)
  903. else begin
  904. if FOptions.FullPathInTitleBar then
  905. NewCaption := FMainMemo.Filename
  906. else
  907. NewCaption := GetDisplayFilename(FMainMemo.Filename);
  908. end;
  909. NewCaption := NewCaption + ' - ' + SCompilerFormCaption + ' ' +
  910. String(FCompilerVersion.Version);
  911. if FCompiling then
  912. NewCaption := NewCaption + ' [Compiling]'
  913. else if FDebugging then begin
  914. if not FPaused then
  915. NewCaption := NewCaption + ' [Running]'
  916. else
  917. NewCaption := NewCaption + ' [Paused]';
  918. end;
  919. Caption := NewCaption;
  920. if not CommandLineWizard then
  921. Application.Title := NewCaption;
  922. end;
  923. procedure TCompileForm.UpdateNewMainFileButtons;
  924. begin
  925. if FOptions.UseWizard then begin
  926. FNewMainFile.Caption := '&New...';
  927. FNewMainFile.OnClick := FNewMainFileUserWizardClick;
  928. NewMainFileButton.OnClick := FNewMainFileUserWizardClick;
  929. end else begin
  930. FNewMainFile.Caption := '&New';
  931. FNewMainFile.OnClick := FNewMainFileClick;
  932. NewMainFileButton.OnClick := FNewMainFileClick;
  933. end;
  934. end;
  935. procedure TCompileForm.NewMainFile;
  936. var
  937. Memo: TCompScintFileEdit;
  938. begin
  939. HideError;
  940. FUninstExe := '';
  941. if FDebugTarget <> dtSetup then begin
  942. FDebugTarget := dtSetup;
  943. UpdateTargetMenu;
  944. end;
  945. FHiddenFiles.Clear;
  946. UpdateHiddenFilesPanel;
  947. for Memo in FFileMemos do
  948. if Memo.Used then
  949. Memo.BreakPoints.Clear;
  950. DestroyDebugInfo;
  951. FMainMemo.Filename := '';
  952. UpdateCaption;
  953. FMainMemo.SaveEncoding := seUTF8;
  954. FMainMemo.Lines.Clear;
  955. FModifiedAnySinceLastCompile := True;
  956. FPreprocessorOutput := '';
  957. FIncludedFiles.Clear;
  958. UpdatePreprocMemos;
  959. FMainMemo.ClearUndo;
  960. end;
  961. procedure TCompileForm.LoadKnownIncludedAndHiddenFilesAndUpdateMemos(const AFilename: String);
  962. var
  963. Strings: TStringList;
  964. IncludedFile: TIncludedFile;
  965. I: Integer;
  966. begin
  967. if FIncludedFiles.Count <> 0 then
  968. raise Exception.Create('FIncludedFiles.Count <> 0'); { NewMainFile should have been called }
  969. try
  970. if AFilename <> '' then begin
  971. Strings := TStringList.Create;
  972. try
  973. LoadKnownIncludedAndHiddenFiles(AFilename, Strings, FHiddenFiles);
  974. if Strings.Count > 0 then begin
  975. try
  976. for I := 0 to Strings.Count-1 do begin
  977. IncludedFile := TIncludedFile.Create;
  978. IncludedFile.Filename := Strings[I];
  979. IncludedFile.CompilerFileIndex := UnknownCompilerFileIndex;
  980. IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename,
  981. @IncludedFile.LastWriteTime);
  982. FIncludedFiles.Add(IncludedFile);
  983. end;
  984. finally
  985. UpdatePreprocMemos;
  986. end;
  987. end;
  988. finally
  989. Strings.Free;
  990. end;
  991. end;
  992. except
  993. { Ignore any exceptions. }
  994. end;
  995. end;
  996. procedure TCompileForm.SaveKnownIncludedAndHiddenFiles(const AFilename: String);
  997. var
  998. Strings: TStringList;
  999. IncludedFile: TIncludedFile;
  1000. begin
  1001. try
  1002. if AFilename <> '' then begin
  1003. Strings := TStringList.Create;
  1004. try
  1005. for IncludedFile in FIncludedFiles do
  1006. Strings.Add(IncludedFile.Filename);
  1007. CompFunc.SaveKnownIncludedAndHiddenFiles(AFilename, Strings, FHiddenFiles);
  1008. finally
  1009. Strings.Free;
  1010. end;
  1011. end;
  1012. except
  1013. { Handle exceptions locally; failure to save the includes list should not be
  1014. a fatal error. }
  1015. Application.HandleException(Self);
  1016. end;
  1017. end;
  1018. procedure TCompileForm.NewMainFileUsingWizard;
  1019. var
  1020. WizardForm: TWizardForm;
  1021. SaveEnabled: Boolean;
  1022. begin
  1023. WizardForm := TWizardForm.Create(Application);
  1024. try
  1025. SaveEnabled := Enabled;
  1026. if CommandLineWizard then begin
  1027. WizardForm.WizardName := CommandLineWizardName;
  1028. { Must disable CompileForm even though it isn't shown, otherwise
  1029. menu keyboard shortcuts (such as Ctrl+O) still work }
  1030. Enabled := False;
  1031. end;
  1032. try
  1033. if WizardForm.ShowModal <> mrOk then
  1034. Exit;
  1035. finally
  1036. Enabled := SaveEnabled;
  1037. end;
  1038. if CommandLineWizard then begin
  1039. SaveTextToFile(CommandLineFileName, WizardForm.ResultScript, seUtf8);
  1040. end else begin
  1041. NewMainFile;
  1042. FMainMemo.Lines.Text := WizardForm.ResultScript;
  1043. FMainMemo.ClearUndo;
  1044. if WizardForm.Result = wrComplete then begin
  1045. FMainMemo.ForceModifiedState;
  1046. if MsgBox('Would you like to compile the new script now?', SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
  1047. BCompileClick(Self);
  1048. end;
  1049. end;
  1050. finally
  1051. WizardForm.Free;
  1052. end;
  1053. end;
  1054. procedure TCompileForm.OpenFile(AMemo: TCompScintFileEdit; AFilename: String;
  1055. const MainMemoAddToRecentDocs: Boolean);
  1056. function GetStreamSaveEncoding(const Stream: TStream): TSaveEncoding;
  1057. var
  1058. Buf: array[0..2] of Byte;
  1059. begin
  1060. Result := seAuto;
  1061. var StreamSize := Stream.Size;
  1062. var CappedSize: Integer;
  1063. if StreamSize > High(Integer) then
  1064. CappedSize := High(Integer)
  1065. else
  1066. CappedSize := Integer(StreamSize);
  1067. if (CappedSize >= SizeOf(Buf)) and (Stream.Read(Buf, SizeOf(Buf)) = SizeOf(Buf)) and
  1068. (Buf[0] = $EF) and (Buf[1] = $BB) and (Buf[2] = $BF) then
  1069. Result := seUTF8
  1070. else begin
  1071. Stream.Seek(0, soFromBeginning);
  1072. var S: AnsiString;
  1073. SetLength(S, CappedSize);
  1074. SetLength(S, Stream.Read(S[1], CappedSize));
  1075. if IsUTF8String(S) then
  1076. Result := seUTF8NoPreamble;
  1077. end;
  1078. end;
  1079. function GetEncoding(const SaveEncoding: TSaveEncoding): TEncoding;
  1080. begin
  1081. if SaveEncoding in [seUTF8, seUTF8NoPreamble] then
  1082. Result := TEncoding.UTF8
  1083. else
  1084. Result := nil;
  1085. end;
  1086. var
  1087. Stream: TFileStream;
  1088. begin
  1089. AFilename := PathExpand(AFilename);
  1090. Stream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
  1091. try
  1092. if AMemo = FMainMemo then
  1093. NewMainFile;
  1094. GetFileTime(Stream.Handle, nil, nil, @AMemo.FileLastWriteTime);
  1095. AMemo.SaveEncoding := GetStreamSaveEncoding(Stream);
  1096. Stream.Seek(0, soFromBeginning);
  1097. AMemo.Lines.LoadFromStream(Stream, GetEncoding(AMemo.SaveEncoding));
  1098. finally
  1099. Stream.Free;
  1100. end;
  1101. AMemo.ClearUndo;
  1102. if AMemo = FMainMemo then begin
  1103. AMemo.Filename := AFilename;
  1104. UpdateCaption;
  1105. ModifyMRUMainFilesList(AFilename, True);
  1106. if MainMemoAddToRecentDocs then
  1107. AddFileToRecentDocs(AFilename);
  1108. LoadKnownIncludedAndHiddenFilesAndUpdateMemos(AFilename);
  1109. UpdateHiddenFilesPanel;
  1110. end;
  1111. end;
  1112. procedure TCompileForm.OpenMRUMainFile(const AFilename: String);
  1113. { Same as OpenFile, but offers to remove the file from the MRU list if it
  1114. cannot be opened }
  1115. begin
  1116. try
  1117. OpenFile(FMainMemo, AFilename, True);
  1118. except
  1119. Application.HandleException(Self);
  1120. if MsgBoxFmt('There was an error opening the file. Remove it from the list?',
  1121. [AFilename], SCompilerFormCaption, mbError, MB_YESNO) = IDYES then begin
  1122. ModifyMRUMainFilesList(AFilename, False);
  1123. DeleteKnownIncludedFiles(AFilename);
  1124. end;
  1125. end;
  1126. end;
  1127. function TCompileForm.SaveFile(const AMemo: TCompScintFileEdit; const SaveAs: Boolean): Boolean;
  1128. procedure SaveMemoTo(const FN: String);
  1129. var
  1130. TempFN, BackupFN: String;
  1131. Buf: array[0..4095] of Char;
  1132. begin
  1133. { Save to a temporary file; don't overwrite existing files in place. This
  1134. way, if the system crashes or the disk runs out of space during the save,
  1135. the existing file will still be intact. }
  1136. if GetTempFileName(PChar(PathExtractDir(FN)), 'iss', 0, Buf) = 0 then
  1137. raise Exception.CreateFmt('Error creating file (code %d). Could not save file',
  1138. [GetLastError]);
  1139. TempFN := Buf;
  1140. try
  1141. SaveTextToFile(TempFN, AMemo.Lines.Text, AMemo.SaveEncoding);
  1142. { Back up existing file if needed }
  1143. if FOptions.MakeBackups and NewFileExists(FN) then begin
  1144. BackupFN := PathChangeExt(FN, '.~is');
  1145. DeleteFile(BackupFN);
  1146. if not RenameFile(FN, BackupFN) then
  1147. raise Exception.Create('Error creating backup file. Could not save file');
  1148. end;
  1149. { Delete existing file }
  1150. if not DeleteFile(FN) and (GetLastError <> ERROR_FILE_NOT_FOUND) then
  1151. raise Exception.CreateFmt('Error removing existing file (code %d). Could not save file',
  1152. [GetLastError]);
  1153. except
  1154. DeleteFile(TempFN);
  1155. raise;
  1156. end;
  1157. { Rename temporary file.
  1158. Note: This is outside the try..except because we already deleted the
  1159. existing file, and don't want the temp file also deleted in the unlikely
  1160. event that the rename fails. }
  1161. if not RenameFile(TempFN, FN) then
  1162. raise Exception.CreateFmt('Error renaming temporary file (code %d). Could not save file',
  1163. [GetLastError]);
  1164. GetLastWriteTimeOfFile(FN, @AMemo.FileLastWriteTime);
  1165. end;
  1166. var
  1167. FN: String;
  1168. begin
  1169. Result := False;
  1170. if SaveAs or (AMemo.Filename = '') then begin
  1171. if AMemo <> FMainMemo then
  1172. raise Exception.Create('Internal error: AMemo <> FMainMemo');
  1173. FN := AMemo.Filename;
  1174. if not NewGetSaveFileName('', FN, '', SCompilerOpenFilter, 'iss', Handle) then Exit;
  1175. FN := PathExpand(FN);
  1176. SaveMemoTo(FN);
  1177. AMemo.Filename := FN;
  1178. UpdateCaption;
  1179. end else
  1180. SaveMemoTo(AMemo.Filename);
  1181. AMemo.SetSavePoint;
  1182. if not FOptions.UndoAfterSave then
  1183. AMemo.ClearUndo;
  1184. Result := True;
  1185. if AMemo = FMainMemo then begin
  1186. ModifyMRUMainFilesList(AMemo.Filename, True);
  1187. SaveKnownIncludedAndHiddenFiles(AMemo.Filename);
  1188. end;
  1189. end;
  1190. function TCompileForm.ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
  1191. function PromptToSaveMemo(const AMemo: TCompScintFileEdit): Boolean;
  1192. var
  1193. FileTitle: String;
  1194. begin
  1195. Result := True;
  1196. if AMemo.Modified then begin
  1197. FileTitle := GetFileTitle(AMemo.Filename);
  1198. case MsgBox('The text in the ' + FileTitle + ' file has changed.'#13#10#13#10 +
  1199. 'Do you want to save the changes?', SCompilerFormCaption, mbError,
  1200. MB_YESNOCANCEL) of
  1201. IDYES: Result := SaveFile(AMemo, False);
  1202. IDNO: ;
  1203. else
  1204. Result := False;
  1205. end;
  1206. end;
  1207. end;
  1208. var
  1209. Memo: TCompScintFileEdit;
  1210. begin
  1211. if FCompiling then begin
  1212. MsgBox('Please stop the compile process before performing this command.',
  1213. SCompilerFormCaption, mbError, MB_OK);
  1214. Result := False;
  1215. Exit;
  1216. end;
  1217. if FDebugging and not AskToDetachDebugger then begin
  1218. Result := False;
  1219. Exit;
  1220. end;
  1221. Result := True;
  1222. if PromptToSave then begin
  1223. for Memo in FFileMemos do begin
  1224. if Memo.Used then begin
  1225. Result := PromptToSaveMemo(Memo);
  1226. if not Result then
  1227. Exit;
  1228. end;
  1229. end;
  1230. end;
  1231. end;
  1232. procedure TCompileForm.ReadMRUMainFilesList;
  1233. begin
  1234. try
  1235. ReadMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew', 'History');
  1236. except
  1237. { Ignore any exceptions. }
  1238. end;
  1239. end;
  1240. procedure TCompileForm.ModifyMRUMainFilesList(const AFilename: String;
  1241. const AddNewItem: Boolean);
  1242. begin
  1243. { Load most recent items first, just in case they've changed }
  1244. try
  1245. ReadMRUMainFilesList;
  1246. except
  1247. { Ignore any exceptions. }
  1248. end;
  1249. try
  1250. ModifyMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew', 'History', AFileName, AddNewItem, @PathCompare);
  1251. except
  1252. { Handle exceptions locally; failure to save the MRU list should not be
  1253. a fatal error. }
  1254. Application.HandleException(Self);
  1255. end;
  1256. end;
  1257. procedure TCompileForm.ReadMRUParametersList;
  1258. begin
  1259. try
  1260. ReadMRUList(FMRUParametersList, 'ParametersHistory', 'History');
  1261. except
  1262. { Ignore any exceptions. }
  1263. end;
  1264. end;
  1265. procedure TCompileForm.ModifyMRUParametersList(const AParameter: String;
  1266. const AddNewItem: Boolean);
  1267. begin
  1268. { Load most recent items first, just in case they've changed }
  1269. try
  1270. ReadMRUParametersList;
  1271. except
  1272. { Ignore any exceptions. }
  1273. end;
  1274. try
  1275. ModifyMRUList(FMRUParametersList, 'ParametersHistory', 'History', AParameter, AddNewItem, @CompareText);
  1276. except
  1277. { Handle exceptions locally; failure to save the MRU list should not be
  1278. a fatal error. }
  1279. Application.HandleException(Self);
  1280. end;
  1281. end;
  1282. procedure TCompileForm.StatusMessage(const Kind: TStatusMessageKind; const S: String);
  1283. begin
  1284. AddLines(CompilerOutputList, S, TObject(Kind), False, alpNone, 0);
  1285. CompilerOutputList.Update;
  1286. end;
  1287. procedure TCompileForm.DebugLogMessage(const S: String);
  1288. begin
  1289. AddLines(DebugOutputList, S, nil, True, alpTimestamp, FDebugLogListTimestampsWidth);
  1290. DebugOutputList.Update;
  1291. end;
  1292. procedure TCompileForm.DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal);
  1293. begin
  1294. DebugCallStackList.Clear;
  1295. AddLines(DebugCallStackList, CallStack, nil, True, alpCountdown, FCallStackCount-1);
  1296. DebugCallStackList.Items.Insert(0, '*** [Code] Call Stack');
  1297. DebugCallStackList.Update;
  1298. end;
  1299. type
  1300. PAppData = ^TAppData;
  1301. TAppData = record
  1302. Form: TCompileForm;
  1303. Filename: String;
  1304. Lines: TStringList;
  1305. CurLineNumber: Integer;
  1306. CurLine: String;
  1307. OutputExe: String;
  1308. DebugInfo: Pointer;
  1309. ErrorMsg: String;
  1310. ErrorFilename: String;
  1311. ErrorLine: Integer;
  1312. Aborted: Boolean;
  1313. end;
  1314. function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
  1315. AppData: Longint): Integer; stdcall;
  1316. procedure DecodeIncludedFilenames(P: PChar; const IncludedFiles: TIncludedFiles);
  1317. var
  1318. IncludedFile: TIncludedFile;
  1319. I: Integer;
  1320. begin
  1321. IncludedFiles.Clear;
  1322. if P = nil then
  1323. Exit;
  1324. I := 0;
  1325. while P^ <> #0 do begin
  1326. if not IsISPPBuiltins(P) then begin
  1327. IncludedFile := TIncludedFile.Create;
  1328. IncludedFile.Filename := P;
  1329. IncludedFile.CompilerFileIndex := I;
  1330. IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename,
  1331. @IncludedFile.LastWriteTime);
  1332. IncludedFiles.Add(IncludedFile);
  1333. end;
  1334. Inc(P, StrLen(P) + 1);
  1335. Inc(I);
  1336. end;
  1337. end;
  1338. procedure CleanHiddenFiles(const IncludedFiles: TIncludedFiles; const HiddenFiles: TStringList);
  1339. var
  1340. HiddenFileIncluded: array of Boolean;
  1341. begin
  1342. if HiddenFiles.Count > 0 then begin
  1343. { Clean previously hidden files which are no longer included }
  1344. if IncludedFiles.Count > 0 then begin
  1345. SetLength(HiddenFileIncluded, HiddenFiles.Count);
  1346. for var I := 0 to HiddenFiles.Count-1 do
  1347. HiddenFileIncluded[I] := False;
  1348. for var I := 0 to IncludedFiles.Count-1 do begin
  1349. var IncludedFile := IncludedFiles[I];
  1350. var HiddenFileIndex := HiddenFiles.IndexOf(IncludedFile.Filename);
  1351. if HiddenFileIndex <> -1 then
  1352. HiddenFileIncluded[HiddenFileIndex] := True;
  1353. end;
  1354. for var I := HiddenFiles.Count-1 downto 0 do
  1355. if not HiddenFileIncluded[I] then
  1356. HiddenFiles.Delete(I);
  1357. end else
  1358. HiddenFiles.Clear;
  1359. end;
  1360. end;
  1361. begin
  1362. Result := iscrSuccess;
  1363. with PAppData(AppData)^ do
  1364. case Code of
  1365. iscbReadScript:
  1366. begin
  1367. if Data.Reset then
  1368. CurLineNumber := 0;
  1369. if CurLineNumber < Lines.Count then begin
  1370. CurLine := Lines[CurLineNumber];
  1371. Data.LineRead := PChar(CurLine);
  1372. Inc(CurLineNumber);
  1373. end;
  1374. end;
  1375. iscbNotifyStatus:
  1376. if Data.Warning then
  1377. Form.StatusMessage(smkWarning, Data.StatusMsg)
  1378. else
  1379. Form.StatusMessage(smkNormal, Data.StatusMsg);
  1380. iscbNotifyIdle:
  1381. begin
  1382. Form.UpdateCompileStatusPanels(Data.CompressProgress,
  1383. Data.CompressProgressMax, Data.SecondsRemaining,
  1384. Data.BytesCompressedPerSecond);
  1385. { We have to use HandleMessage instead of ProcessMessages so that
  1386. Application.Idle is called. Otherwise, Flat TSpeedButton's don't
  1387. react to the mouse being moved over them.
  1388. Unfortunately, HandleMessage by default calls WaitMessage. To avoid
  1389. this we have an Application.OnIdle handler which sets Done to False
  1390. while compiling is in progress - see AppOnIdle.
  1391. The GetQueueStatus check below is just an optimization; calling
  1392. HandleMessage when there are no messages to process wastes CPU. }
  1393. if GetQueueStatus(QS_ALLINPUT) <> 0 then begin
  1394. Form.FBecameIdle := False;
  1395. repeat
  1396. Application.HandleMessage;
  1397. { AppOnIdle sets FBecameIdle to True when it's called, which
  1398. indicates HandleMessage didn't find any message to process }
  1399. until Form.FBecameIdle;
  1400. end;
  1401. if Form.FCompileWantAbort then
  1402. Result := iscrRequestAbort;
  1403. end;
  1404. iscbNotifyPreproc:
  1405. begin
  1406. Form.FPreprocessorOutput := TrimRight(Data.PreprocessedScript);
  1407. DecodeIncludedFilenames(Data.IncludedFilenames, Form.FIncludedFiles); { Also stores last write time }
  1408. CleanHiddenFiles(Form.FIncludedFiles, Form.FHiddenFiles);
  1409. Form.UpdateHiddenFilesPanel;
  1410. Form.SaveKnownIncludedAndHiddenFiles(Filename);
  1411. end;
  1412. iscbNotifySuccess:
  1413. begin
  1414. OutputExe := Data.OutputExeFilename;
  1415. if Form.FCompilerVersion.BinVersion >= $3000001 then begin
  1416. DebugInfo := AllocMem(Data.DebugInfoSize);
  1417. Move(Data.DebugInfo^, DebugInfo^, Data.DebugInfoSize);
  1418. end else
  1419. DebugInfo := nil;
  1420. end;
  1421. iscbNotifyError:
  1422. begin
  1423. if Assigned(Data.ErrorMsg) then
  1424. ErrorMsg := Data.ErrorMsg
  1425. else
  1426. Aborted := True;
  1427. ErrorFilename := Data.ErrorFilename;
  1428. ErrorLine := Data.ErrorLine;
  1429. end;
  1430. end;
  1431. end;
  1432. procedure TCompileForm.CompileFile(AFilename: String; const ReadFromFile: Boolean);
  1433. function GetMemoFromErrorFilename(const ErrorFilename: String): TCompScintFileEdit;
  1434. var
  1435. Memo: TCompScintFileEdit;
  1436. begin
  1437. if ErrorFilename = '' then
  1438. Result := FMainMemo
  1439. else begin
  1440. if FOptions.OpenIncludedFiles then begin
  1441. for Memo in FFileMemos do begin
  1442. if Memo.Used and (PathCompare(Memo.Filename, ErrorFilename) = 0) then begin
  1443. Result := Memo;
  1444. Exit;
  1445. end;
  1446. end;
  1447. end;
  1448. Result := nil;
  1449. end;
  1450. end;
  1451. var
  1452. SourcePath, S, Options: String;
  1453. Params: TCompileScriptParamsEx;
  1454. AppData: TAppData;
  1455. StartTime, ElapsedTime, ElapsedSeconds: DWORD;
  1456. I: Integer;
  1457. Memo: TCompScintFileEdit;
  1458. OldActiveMemo: TCompScintEdit;
  1459. begin
  1460. if FCompiling then begin
  1461. { Shouldn't get here, but just in case... }
  1462. MsgBox('A compile is already in progress.', SCompilerFormCaption, mbError, MB_OK);
  1463. Abort;
  1464. end;
  1465. if not ReadFromFile then begin
  1466. if FOptions.OpenIncludedFiles then begin
  1467. { Included files must always be saved since they're not read from the editor by the compiler }
  1468. for Memo in FFileMemos do begin
  1469. if (Memo <> FMainMemo) and Memo.Used and Memo.Modified then begin
  1470. if FOptions.Autosave then begin
  1471. if not SaveFile(Memo, False) then
  1472. Abort;
  1473. end else begin
  1474. case MsgBox('The text in the ' + Memo.Filename + ' file has changed and must be saved before compiling.'#13#10#13#10 +
  1475. 'Save the changes and continue?', SCompilerFormCaption, mbError,
  1476. MB_YESNO) of
  1477. IDYES:
  1478. if not SaveFile(Memo, False) then
  1479. Abort;
  1480. else
  1481. Abort;
  1482. end;
  1483. end;
  1484. end;
  1485. end;
  1486. end;
  1487. { Save main file if requested }
  1488. if FOptions.Autosave and FMainMemo.Modified then begin
  1489. if not SaveFile(FMainMemo, False) then
  1490. Abort;
  1491. end else if FMainMemo.Filename = '' then begin
  1492. case MsgBox('Would you like to save the script before compiling?' +
  1493. SNewLine2 + 'If you answer No, the compiled installation will be ' +
  1494. 'placed under your My Documents folder by default.',
  1495. SCompilerFormCaption, mbConfirmation, MB_YESNOCANCEL) of
  1496. IDYES:
  1497. if not SaveFile(FMainMemo, False) then
  1498. Abort;
  1499. IDNO: ;
  1500. else
  1501. Abort;
  1502. end;
  1503. end;
  1504. AFilename := FMainMemo.Filename;
  1505. end; {else: Command line compile, AFilename already set. }
  1506. DestroyDebugInfo;
  1507. OldActiveMemo := FActiveMemo;
  1508. AppData.Lines := TStringList.Create;
  1509. try
  1510. FBuildAnimationFrame := 0;
  1511. FProgress := 0;
  1512. FProgressMax := 0;
  1513. FActiveMemo.CancelAutoComplete;
  1514. FActiveMemo.Cursor := crAppStart;
  1515. FActiveMemo.SetCursorID(999); { hack to keep it from overriding Cursor }
  1516. CompilerOutputList.Cursor := crAppStart;
  1517. for Memo in FFileMemos do
  1518. Memo.ReadOnly := True;
  1519. UpdateEditModePanel;
  1520. HideError;
  1521. CompilerOutputList.Clear;
  1522. SendMessage(CompilerOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  1523. DebugOutputList.Clear;
  1524. SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  1525. DebugCallStackList.Clear;
  1526. SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  1527. OutputTabSet.TabIndex := tiCompilerOutput;
  1528. SetStatusPanelVisible(True);
  1529. SourcePath := GetSourcePath(AFilename);
  1530. FillChar(Params, SizeOf(Params), 0);
  1531. Params.Size := SizeOf(Params);
  1532. Params.CompilerPath := nil;
  1533. Params.SourcePath := PChar(SourcePath);
  1534. Params.CallbackProc := CompilerCallbackProc;
  1535. Pointer(Params.AppData) := @AppData;
  1536. Options := '';
  1537. for I := 0 to FSignTools.Count-1 do
  1538. Options := Options + AddSignToolParam(FSignTools[I]);
  1539. Params.Options := PChar(Options);
  1540. AppData.Form := Self;
  1541. AppData.CurLineNumber := 0;
  1542. AppData.Aborted := False;
  1543. I := ReadScriptLines(AppData.Lines, ReadFromFile, AFilename, FMainMemo);
  1544. if I <> -1 then begin
  1545. if not ReadFromFile then begin
  1546. MoveCaretAndActivateMemo(FMainMemo, I, False);
  1547. SetErrorLine(FMainMemo, I);
  1548. end;
  1549. raise Exception.CreateFmt(SCompilerIllegalNullChar, [I + 1]);
  1550. end;
  1551. StartTime := GetTickCount;
  1552. StatusMessage(smkStartEnd, Format(SCompilerStatusStarting, [TimeToStr(Time)]));
  1553. StatusMessage(smkStartEnd, '');
  1554. FCompiling := True;
  1555. FCompileWantAbort := False;
  1556. UpdateRunMenu;
  1557. UpdateCaption;
  1558. SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass);
  1559. AppData.Filename := AFilename;
  1560. {$IFNDEF STATICCOMPILER}
  1561. if ISDllCompileScript(Params) <> isceNoError then begin
  1562. {$ELSE}
  1563. if ISCompileScript(Params, False) <> isceNoError then begin
  1564. {$ENDIF}
  1565. StatusMessage(smkError, SCompilerStatusErrorAborted);
  1566. if not ReadFromFile and (AppData.ErrorLine > 0) then begin
  1567. Memo := GetMemoFromErrorFilename(AppData.ErrorFilename);
  1568. if Memo <> nil then begin
  1569. { Move the caret to the line number the error occurred on }
  1570. MoveCaretAndActivateMemo(Memo, AppData.ErrorLine - 1, False);
  1571. SetErrorLine(Memo, AppData.ErrorLine - 1);
  1572. end;
  1573. end;
  1574. if not AppData.Aborted then begin
  1575. S := '';
  1576. if AppData.ErrorFilename <> '' then
  1577. S := 'File: ' + AppData.ErrorFilename + SNewLine2;
  1578. if AppData.ErrorLine > 0 then
  1579. S := S + Format('Line %d:' + SNewLine, [AppData.ErrorLine]);
  1580. S := S + AppData.ErrorMsg;
  1581. SetAppTaskbarProgressState(tpsError);
  1582. MsgBox(S, 'Compiler Error', mbCriticalError, MB_OK)
  1583. end;
  1584. Abort;
  1585. end;
  1586. ElapsedTime := GetTickCount - StartTime;
  1587. ElapsedSeconds := ElapsedTime div 1000;
  1588. StatusMessage(smkStartEnd, Format(SCompilerStatusFinished, [TimeToStr(Time),
  1589. Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, FormatSettings.TimeSeparator,
  1590. ElapsedSeconds mod 60, FormatSettings.DecimalSeparator, ElapsedTime mod 1000])]));
  1591. finally
  1592. AppData.Lines.Free;
  1593. FCompiling := False;
  1594. SetLowPriority(False, FSavePriorityClass);
  1595. OldActiveMemo.Cursor := crDefault;
  1596. OldActiveMemo.SetCursorID(SC_CURSORNORMAL);
  1597. CompilerOutputList.Cursor := crDefault;
  1598. for Memo in FFileMemos do
  1599. Memo.ReadOnly := False;
  1600. UpdateEditModePanel;
  1601. UpdateRunMenu;
  1602. UpdateCaption;
  1603. UpdatePreprocMemos;
  1604. if AppData.DebugInfo <> nil then begin
  1605. ParseDebugInfo(AppData.DebugInfo); { Must be called after UpdateIncludedFilesMemos }
  1606. FreeMem(AppData.DebugInfo);
  1607. end;
  1608. InvalidateStatusPanel(spCompileIcon);
  1609. InvalidateStatusPanel(spCompileProgress);
  1610. SetAppTaskbarProgressState(tpsNoProgress);
  1611. StatusBar.Panels[spExtraStatus].Text := '';
  1612. end;
  1613. FCompiledExe := AppData.OutputExe;
  1614. FModifiedAnySinceLastCompile := False;
  1615. FModifiedAnySinceLastCompileAndGo := False;
  1616. end;
  1617. procedure TCompileForm.SyncEditorOptions;
  1618. const
  1619. SquigglyStyles: array[Boolean] of Integer = (INDIC_HIDDEN, INDIC_SQUIGGLE);
  1620. var
  1621. Memo: TCompScintEdit;
  1622. begin
  1623. for Memo in FMemos do begin
  1624. Memo.UseStyleAttributes := FOptions.UseSyntaxHighlighting;
  1625. Memo.Call(SCI_INDICSETSTYLE, inSquiggly, SquigglyStyles[FOptions.UnderlineErrors]);
  1626. if FOptions.CursorPastEOL then
  1627. Memo.VirtualSpaceOptions := [svsRectangularSelection, svsUserAccessible]
  1628. else
  1629. Memo.VirtualSpaceOptions := [];
  1630. Memo.FillSelectionToEdge := FOptions.CursorPastEOL;
  1631. Memo.TabWidth := FOptions.TabWidth;
  1632. Memo.UseTabCharacter := FOptions.UseTabCharacter;
  1633. Memo.WordWrap := FOptions.WordWrap;
  1634. if FOptions.IndentationGuides then
  1635. Memo.IndentationGuides := sigLookBoth
  1636. else
  1637. Memo.IndentationGuides := sigNone;
  1638. Memo.LineNumbers := FOptions.GutterLineNumbers;
  1639. end;
  1640. end;
  1641. procedure TCompileForm.FMenuClick(Sender: TObject);
  1642. function DoubleAmp(const S: String): String;
  1643. var
  1644. I: Integer;
  1645. begin
  1646. Result := S;
  1647. I := 1;
  1648. while I <= Length(Result) do begin
  1649. if Result[I] = '&' then begin
  1650. Inc(I);
  1651. Insert('&', Result, I);
  1652. Inc(I);
  1653. end
  1654. else
  1655. Inc(I, PathCharLength(S, I));
  1656. end;
  1657. end;
  1658. var
  1659. I: Integer;
  1660. begin
  1661. FSaveMainFileAs.Enabled := FActiveMemo = FMainMemo;
  1662. FSaveEncoding.Enabled := FSave.Enabled; { FSave.Enabled is kept up-to-date by UpdateSaveMenuItemAndButton }
  1663. FSaveEncodingAuto.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TCompScintFileEdit).SaveEncoding = seAuto);
  1664. FSaveEncodingUTF8.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TCompScintFileEdit).SaveEncoding = seUTF8);
  1665. FSaveEncodingUTF8NoPreamble.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TCompScintFileEdit).SaveEncoding = seUTF8NoPreamble);
  1666. FSaveAll.Visible := FOptions.OpenIncludedFiles;
  1667. ReadMRUMainFilesList;
  1668. FMRUMainFilesSep.Visible := FMRUMainFilesList.Count <> 0;
  1669. for I := 0 to High(FMRUMainFilesMenuItems) do
  1670. with FMRUMainFilesMenuItems[I] do begin
  1671. if I < FMRUMainFilesList.Count then begin
  1672. Visible := True;
  1673. Caption := '&' + IntToStr((I+1) mod 10) + ' ' + DoubleAmp(FMRUMainFilesList[I]);
  1674. end
  1675. else
  1676. Visible := False;
  1677. end;
  1678. end;
  1679. procedure TCompileForm.FNewMainFileClick(Sender: TObject);
  1680. begin
  1681. if ConfirmCloseFile(True) then
  1682. NewMainFile;
  1683. end;
  1684. procedure TCompileForm.FNewMainFileUserWizardClick(Sender: TObject);
  1685. begin
  1686. if ConfirmCloseFile(True) then
  1687. NewMainFileUsingWizard;
  1688. end;
  1689. procedure TCompileForm.ShowOpenMainFileDialog(const Examples: Boolean);
  1690. var
  1691. InitialDir, FileName: String;
  1692. begin
  1693. if Examples then begin
  1694. InitialDir := PathExtractPath(NewParamStr(0)) + 'Examples';
  1695. Filename := PathExtractPath(NewParamStr(0)) + 'Examples\Example1.iss';
  1696. end
  1697. else begin
  1698. InitialDir := PathExtractDir(FMainMemo.Filename);
  1699. Filename := '';
  1700. end;
  1701. if ConfirmCloseFile(True) then
  1702. if NewGetOpenFileName('', FileName, InitialDir, SCompilerOpenFilter, 'iss', Handle) then
  1703. OpenFile(FMainMemo, Filename, False);
  1704. end;
  1705. procedure TCompileForm.FOpenMainFileClick(Sender: TObject);
  1706. begin
  1707. ShowOpenMainFileDialog(False);
  1708. end;
  1709. procedure TCompileForm.FSaveClick(Sender: TObject);
  1710. begin
  1711. SaveFile((FActiveMemo as TCompScintFileEdit), Sender = FSaveMainFileAs);
  1712. end;
  1713. procedure TCompileForm.FSaveEncodingItemClick(Sender: TObject);
  1714. begin
  1715. if Sender = FSaveEncodingUTF8 then
  1716. (FActiveMemo as TCompScintFileEdit).SaveEncoding := seUTF8
  1717. else if Sender = FSaveEncodingUTF8NoPreamble then
  1718. (FActiveMemo as TCompScintFileEdit).SaveEncoding := seUTF8NoPreamble
  1719. else
  1720. (FActiveMemo as TCompScintFileEdit).SaveEncoding := seAuto;
  1721. end;
  1722. procedure TCompileForm.FSaveAllClick(Sender: TObject);
  1723. var
  1724. Memo: TCompScintFileEdit;
  1725. begin
  1726. for Memo in FFileMemos do
  1727. if Memo.Used and Memo.Modified then
  1728. SaveFile(Memo, False);
  1729. end;
  1730. procedure TCompileForm.FPrintClick(Sender: TObject);
  1731. procedure SetupNonDarkPrintStyler(var PrintStyler: TInnoSetupStyler; var PrintTheme: TTheme;
  1732. var OldStyler: TScintCustomStyler; var OldTheme: TTheme);
  1733. begin
  1734. { Not the most pretty code, would ideally make a copy of FActiveMemo and print that instead or
  1735. somehow convince Scintilla to use different print styles but don't know of a good way to do
  1736. either. Using SC_PRINT_COLOURONWHITE doesn't help, this gives white on white in dark mode. }
  1737. PrintStyler := TInnoSetupStyler.Create(nil);
  1738. PrintTheme := TTheme.Create;
  1739. PrintStyler.ISPPInstalled := ISPPInstalled;
  1740. PrintStyler.Theme := PrintTheme;
  1741. if not FTheme.Dark then
  1742. PrintTheme.Typ := FTheme.Typ
  1743. else
  1744. PrintTheme.Typ := ttModernLight;
  1745. OldStyler := FActiveMemo.Styler;
  1746. OldTheme := FActiveMemo.Theme;
  1747. FActiveMemo.Styler := PrintStyler;
  1748. FActiveMemo.Theme := PrintTheme;
  1749. FActiveMemo.UpdateThemeColorsAndStyleAttributes;
  1750. end;
  1751. procedure DeinitPrintStyler(const PrintStyler: TInnoSetupStyler; const PrintTheme: TTheme;
  1752. const OldStyler: TScintCustomStyler; const OldTheme: TTheme);
  1753. begin
  1754. if (OldStyler <> nil) or (OldTheme <> nil) then begin
  1755. if OldStyler <> nil then
  1756. FActiveMemo.Styler := OldStyler;
  1757. if OldTheme <> nil then
  1758. FActiveMemo.Theme := OldTheme;
  1759. FActiveMemo.UpdateThemeColorsAndStyleAttributes;
  1760. end;
  1761. PrintTheme.Free;
  1762. PrintStyler.Free;
  1763. end;
  1764. var
  1765. PrintStyler: TInnoSetupStyler;
  1766. OldStyler: TScintCustomStyler;
  1767. PrintTheme, OldTheme: TTheme;
  1768. PrintMemo: TCompScintEdit;
  1769. HeaderMemo: TCompScintFileEdit;
  1770. FileTitle, S: String;
  1771. pdlg: TPrintDlg;
  1772. crange: TScintRange;
  1773. startPos, endPos: Integer;
  1774. hdc: Windows.HDC;
  1775. rectMargins, rectPhysMargins, rectSetup, rcw: TRect;
  1776. ptPage, ptDpi: TPoint;
  1777. headerLineHeight, footerLineHeight: Integer;
  1778. fontHeader, fontFooter: HFONT;
  1779. tm: TTextMetric;
  1780. di: TDocInfo;
  1781. lengthDoc, lengthDocMax, lengthPrinted: Integer;
  1782. frPrint: TScintRangeToFormat;
  1783. pageNum: Integer;
  1784. printPage: Boolean;
  1785. ta: UINT;
  1786. sHeader, sFooter: String;
  1787. pen, penOld: HPEN;
  1788. begin
  1789. if FActiveMemo is TCompScintFileEdit then
  1790. HeaderMemo := TCompScintFileEdit(FActiveMemo)
  1791. else
  1792. HeaderMemo := FMainMemo;
  1793. sHeader := HeaderMemo.Filename;
  1794. FileTitle := GetFileTitle(HeaderMemo.Filename);
  1795. if HeaderMemo <> FActiveMemo then begin
  1796. S := ' - ' + MemosTabSet.Tabs[MemoToTabIndex(FActiveMemo)];
  1797. sHeader := Format('%s %s', [sHeader, S]);
  1798. FileTitle := Format('%s %s', [FileTitle, S]);
  1799. end;
  1800. sHeader := Format('%s - %s', [sHeader, DateTimeToStr(Now())]);
  1801. { Based on Scintilla 2.22's SciTEWin::Print }
  1802. ZeroMemory(@pdlg, SizeOf(pdlg));
  1803. pdlg.lStructSize := SizeOf(pdlg);
  1804. pdlg.hwndOwner := Handle;
  1805. pdlg.hInstance := hInstance;
  1806. pdlg.Flags := PD_USEDEVMODECOPIES or PD_ALLPAGES or PD_RETURNDC;
  1807. pdlg.nFromPage := 1;
  1808. pdlg.nToPage := 1;
  1809. pdlg.nMinPage := 1;
  1810. pdlg.nMaxPage := $ffff; // We do not know how many pages in the document until the printer is selected and the paper size is known.
  1811. pdlg.nCopies := 1;
  1812. pdlg.hDC := 0;
  1813. pdlg.hDevMode := FDevMode;
  1814. pdlg.hDevNames := FDevNames;
  1815. // See if a range has been selected
  1816. crange := FActiveMemo.Selection;
  1817. startPos := crange.StartPos;
  1818. endPos := crange.EndPos;
  1819. if startPos = endPos then
  1820. pdlg.Flags := pdlg.Flags or PD_NOSELECTION
  1821. else
  1822. pdlg.Flags := pdlg.Flags or PD_SELECTION;
  1823. (*
  1824. if (!showDialog) {
  1825. // Don't display dialog box, just use the default printer and options
  1826. pdlg.Flags |= PD_RETURNDEFAULT;
  1827. }
  1828. *)
  1829. if not PrintDlg(pdlg) then
  1830. Exit;
  1831. PrintStyler := nil;
  1832. PrintTheme := nil;
  1833. OldStyler := nil;
  1834. OldTheme := nil;
  1835. try
  1836. if FTheme.Dark then
  1837. SetupNonDarkPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme);
  1838. FDevMode := pdlg.hDevMode;
  1839. FDevNames := pdlg.hDevNames;
  1840. hdc := pdlg.hDC;
  1841. // Get printer resolution
  1842. ptDpi.x := GetDeviceCaps(hdc, LOGPIXELSX); // dpi in X direction
  1843. ptDpi.y := GetDeviceCaps(hdc, LOGPIXELSY); // dpi in Y direction
  1844. // Start by getting the physical page size (in device units).
  1845. ptPage.x := GetDeviceCaps(hdc, PHYSICALWIDTH); // device units
  1846. ptPage.y := GetDeviceCaps(hdc, PHYSICALHEIGHT); // device units
  1847. // Get the dimensions of the unprintable
  1848. // part of the page (in device units).
  1849. rectPhysMargins.left := GetDeviceCaps(hdc, PHYSICALOFFSETX);
  1850. rectPhysMargins.top := GetDeviceCaps(hdc, PHYSICALOFFSETY);
  1851. // To get the right and lower unprintable area,
  1852. // we take the entire width and height of the paper and
  1853. // subtract everything else.
  1854. rectPhysMargins.right := ptPage.x // total paper width
  1855. - GetDeviceCaps(hdc, HORZRES) // printable width
  1856. - rectPhysMargins.left; // left unprintable margin
  1857. rectPhysMargins.bottom := ptPage.y // total paper height
  1858. - GetDeviceCaps(hdc, VERTRES) // printable height
  1859. - rectPhysMargins.top; // right unprintable margin
  1860. // At this point, rectPhysMargins contains the widths of the
  1861. // unprintable regions on all four sides of the page in device units.
  1862. (*
  1863. // Take in account the page setup given by the user (if one value is not null)
  1864. if (pagesetupMargin.left != 0 || pagesetupMargin.right != 0 ||
  1865. pagesetupMargin.top != 0 || pagesetupMargin.bottom != 0) {
  1866. GUI::Rectangle rectSetup;
  1867. // Convert the hundredths of millimeters (HiMetric) or
  1868. // thousandths of inches (HiEnglish) margin values
  1869. // from the Page Setup dialog to device units.
  1870. // (There are 2540 hundredths of a mm in an inch.)
  1871. TCHAR localeInfo[3];
  1872. GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, localeInfo, 3);
  1873. if (localeInfo[0] == '0') { // Metric system. '1' is US System *)
  1874. rectSetup.left := MulDiv(500 {pagesetupMargin.left}, ptDpi.x, 2540);
  1875. rectSetup.top := MulDiv(500 {pagesetupMargin.top}, ptDpi.y, 2540);
  1876. rectSetup.right := MulDiv(500 {pagesetupMargin.right}, ptDpi.x, 2540);
  1877. rectSetup.bottom := MulDiv(500 {pagesetupMargin.bottom}, ptDpi.y, 2540);
  1878. (* } else {
  1879. rectSetup.left = MulDiv(pagesetupMargin.left, ptDpi.x, 1000);
  1880. rectSetup.top = MulDiv(pagesetupMargin.top, ptDpi.y, 1000);
  1881. rectSetup.right = MulDiv(pagesetupMargin.right, ptDpi.x, 1000);
  1882. rectSetup.bottom = MulDiv(pagesetupMargin.bottom, ptDpi.y, 1000);
  1883. } *)
  1884. // Don't reduce margins below the minimum printable area
  1885. rectMargins.left := Max(rectPhysMargins.left, rectSetup.left);
  1886. rectMargins.top := Max(rectPhysMargins.top, rectSetup.top);
  1887. rectMargins.right := Max(rectPhysMargins.right, rectSetup.right);
  1888. rectMargins.bottom := Max(rectPhysMargins.bottom, rectSetup.bottom);
  1889. (*
  1890. } else {
  1891. rectMargins := rectPhysMargins;
  1892. }
  1893. *)
  1894. // rectMargins now contains the values used to shrink the printable
  1895. // area of the page.
  1896. // Convert device coordinates into logical coordinates
  1897. DPtoLP(hdc, rectMargins, 2);
  1898. DPtoLP(hdc, rectPhysMargins, 2);
  1899. // Convert page size to logical units and we're done!
  1900. DPtoLP(hdc, ptPage, 1);
  1901. headerLineHeight := MulDiv(9, ptDpi.y, 72);
  1902. fontHeader := CreateFont(headerLineHeight, 0, 0, 0, FW_REGULAR, 1, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name));
  1903. SelectObject(hdc, fontHeader);
  1904. GetTextMetrics(hdc, &tm);
  1905. headerLineHeight := tm.tmHeight + tm.tmExternalLeading;
  1906. footerLineHeight := MulDiv(9, ptDpi.y, 72);
  1907. fontFooter := CreateFont(footerLineHeight, 0, 0, 0, FW_REGULAR, 0, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name));
  1908. SelectObject(hdc, fontFooter);
  1909. GetTextMetrics(hdc, &tm);
  1910. footerLineHeight := tm.tmHeight + tm.tmExternalLeading;
  1911. ZeroMemory(@di, SizeOf(di));
  1912. di.cbSize := SizeOf(di);
  1913. di.lpszDocName := PChar(FileTitle);
  1914. di.lpszOutput := nil;
  1915. di.lpszDatatype := nil;
  1916. di.fwType := 0;
  1917. if StartDoc(hdc, &di) < 0 then begin
  1918. DeleteDC(hdc);
  1919. DeleteObject(fontHeader);
  1920. DeleteObject(fontFooter);
  1921. MsgBox('Can not start printer document.', SCompilerFormCaption, mbError, MB_OK);
  1922. Exit;
  1923. end;
  1924. lengthDoc := FActiveMemo.GetRawTextLength;
  1925. lengthDocMax := lengthDoc;
  1926. lengthPrinted := 0;
  1927. // Requested to print selection
  1928. if (pdlg.Flags and PD_SELECTION) <> 0 then begin
  1929. if startPos > endPos then begin
  1930. lengthPrinted := endPos;
  1931. lengthDoc := startPos;
  1932. end else begin
  1933. lengthPrinted := startPos;
  1934. lengthDoc := endPos;
  1935. end;
  1936. if lengthPrinted < 0 then
  1937. lengthPrinted := 0;
  1938. if lengthDoc > lengthDocMax then
  1939. lengthDoc := lengthDocMax;
  1940. end;
  1941. // We must subtract the physical margins from the printable area
  1942. frPrint.hdc := hdc;
  1943. frPrint.hdcTarget := hdc;
  1944. frPrint.rc.left := rectMargins.left - rectPhysMargins.left;
  1945. frPrint.rc.top := rectMargins.top - rectPhysMargins.top;
  1946. frPrint.rc.right := ptPage.x - rectMargins.right - rectPhysMargins.left;
  1947. frPrint.rc.bottom := ptPage.y - rectMargins.bottom - rectPhysMargins.top;
  1948. frPrint.rcPage.left := 0;
  1949. frPrint.rcPage.top := 0;
  1950. frPrint.rcPage.right := ptPage.x - rectPhysMargins.left - rectPhysMargins.right - 1;
  1951. frPrint.rcPage.bottom := ptPage.y - rectPhysMargins.top - rectPhysMargins.bottom - 1;
  1952. frPrint.rc.top := frPrint.rc.top + headerLineHeight + headerLineHeight div 2;
  1953. frPrint.rc.bottom := frPrint.rc.bottom - (footerLineHeight + footerLineHeight div 2);
  1954. // Print each page
  1955. pageNum := 1;
  1956. while lengthPrinted < lengthDoc do begin
  1957. printPage := ((pdlg.Flags and PD_PAGENUMS) = 0) or
  1958. ((pageNum >= pdlg.nFromPage) and (pageNum <= pdlg.nToPage));
  1959. sFooter := Format('- %d -', [pageNum]);
  1960. if printPage then begin
  1961. StartPage(hdc);
  1962. SetTextColor(hdc, clBlack);
  1963. SetBkColor(hdc, clWhite);
  1964. SelectObject(hdc, fontHeader);
  1965. ta := SetTextAlign(hdc, TA_BOTTOM);
  1966. rcw := Rect(frPrint.rc.left, frPrint.rc.top - headerLineHeight - headerLineHeight div 2,
  1967. frPrint.rc.right, frPrint.rc.top - headerLineHeight div 2);
  1968. rcw.bottom := rcw.top + headerLineHeight;
  1969. ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.top - headerLineHeight div 2,
  1970. ETO_OPAQUE, rcw, sHeader, Length(sHeader), nil);
  1971. SetTextAlign(hdc, ta);
  1972. pen := CreatePen(0, 1, clBlack);
  1973. penOld := SelectObject(hdc, pen);
  1974. MoveToEx(hdc, frPrint.rc.left, frPrint.rc.top - headerLineHeight div 4, nil);
  1975. LineTo(hdc, frPrint.rc.right, frPrint.rc.top - headerLineHeight div 4);
  1976. SelectObject(hdc, penOld);
  1977. DeleteObject(pen);
  1978. end;
  1979. frPrint.chrg.StartPos := lengthPrinted;
  1980. frPrint.chrg.EndPos := lengthDoc;
  1981. lengthPrinted := FActiveMemo.FormatRange(printPage, @frPrint);
  1982. if printPage then begin
  1983. SetTextColor(hdc, clBlack);
  1984. SetBkColor(hdc, clWhite);
  1985. SelectObject(hdc, fontFooter);
  1986. ta := SetTextAlign(hdc, TA_TOP);
  1987. rcw := Rect(frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 2,
  1988. frPrint.rc.right, frPrint.rc.bottom + footerLineHeight + footerLineHeight div 2);
  1989. ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.bottom + footerLineHeight div 2,
  1990. ETO_OPAQUE, rcw, sFooter, Length(sFooter), nil);
  1991. SetTextAlign(hdc, ta);
  1992. pen := CreatePen(0, 1, clBlack);
  1993. penOld := SelectObject(hdc, pen);
  1994. MoveToEx(hdc, frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 4, nil);
  1995. LineTo(hdc, frPrint.rc.right, frPrint.rc.bottom + footerLineHeight div 4);
  1996. SelectObject(hdc, penOld);
  1997. DeleteObject(pen);
  1998. EndPage(hdc);
  1999. end;
  2000. Inc(pageNum);
  2001. if ((pdlg.Flags and PD_PAGENUMS) <> 0) and (pageNum > pdlg.nToPage) then
  2002. Break;
  2003. end;
  2004. FActiveMemo.FormatRange(False, nil);
  2005. EndDoc(hdc);
  2006. DeleteDC(hdc);
  2007. DeleteObject(fontHeader);
  2008. DeleteObject(fontFooter);
  2009. finally
  2010. DeinitPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme);
  2011. end;
  2012. end;
  2013. procedure TCompileForm.FMRUClick(Sender: TObject);
  2014. var
  2015. I: Integer;
  2016. begin
  2017. if ConfirmCloseFile(True) then
  2018. for I := 0 to High(FMRUMainFilesMenuItems) do
  2019. if FMRUMainFilesMenuItems[I] = Sender then begin
  2020. OpenMRUMainFile(FMRUMainFilesList[I]);
  2021. Break;
  2022. end;
  2023. end;
  2024. procedure TCompileForm.FExitClick(Sender: TObject);
  2025. begin
  2026. Close;
  2027. end;
  2028. procedure TCompileForm.EMenuClick(Sender: TObject);
  2029. var
  2030. MemoHasFocus, MemoIsReadOnly: Boolean;
  2031. begin
  2032. MemoHasFocus := FActiveMemo.Focused;
  2033. MemoIsReadOnly := FActiveMemo.ReadOnly;
  2034. EUndo.Enabled := MemoHasFocus and FActiveMemo.CanUndo;
  2035. ERedo.Enabled := MemoHasFocus and FActiveMemo.CanRedo;
  2036. ECut.Enabled := MemoHasFocus and not MemoIsReadOnly and FActiveMemo.SelAvail;
  2037. ECopy.Enabled := MemoHasFocus and FActiveMemo.SelAvail;
  2038. EPaste.Enabled := MemoHasFocus and not MemoIsReadOnly and Clipboard.HasFormat(CF_TEXT);
  2039. EDelete.Enabled := MemoHasFocus and FActiveMemo.SelAvail;
  2040. ESelectAll.Enabled := MemoHasFocus;
  2041. EFind.Enabled := MemoHasFocus;
  2042. EFindNext.Enabled := MemoHasFocus;
  2043. EFindPrevious.Enabled := MemoHasFocus;
  2044. EReplace.Enabled := MemoHasFocus and not MemoIsReadOnly;
  2045. EGoto.Enabled := MemoHasFocus;
  2046. ECompleteWord.Enabled := MemoHasFocus and not MemoIsReadOnly;
  2047. end;
  2048. procedure TCompileForm.EUndoClick(Sender: TObject);
  2049. begin
  2050. FActiveMemo.Undo;
  2051. end;
  2052. procedure TCompileForm.ERedoClick(Sender: TObject);
  2053. begin
  2054. FActiveMemo.Redo;
  2055. end;
  2056. procedure TCompileForm.ECutClick(Sender: TObject);
  2057. begin
  2058. FActiveMemo.CutToClipboard;
  2059. end;
  2060. procedure TCompileForm.ECopyClick(Sender: TObject);
  2061. begin
  2062. FActiveMemo.CopyToClipboard;
  2063. end;
  2064. procedure TCompileForm.EPasteClick(Sender: TObject);
  2065. begin
  2066. FActiveMemo.PasteFromClipboard;
  2067. end;
  2068. procedure TCompileForm.EDeleteClick(Sender: TObject);
  2069. begin
  2070. FActiveMemo.ClearSelection;
  2071. end;
  2072. procedure TCompileForm.ESelectAllClick(Sender: TObject);
  2073. begin
  2074. FActiveMemo.SelectAll;
  2075. end;
  2076. procedure TCompileForm.ECompleteWordClick(Sender: TObject);
  2077. begin
  2078. InitiateAutoComplete(#0);
  2079. end;
  2080. procedure TCompileForm.VMenuClick(Sender: TObject);
  2081. begin
  2082. VZoomIn.Enabled := (FActiveMemo.Zoom < 20);
  2083. VZoomOut.Enabled := (FActiveMemo.Zoom > -10);
  2084. VZoomReset.Enabled := (FActiveMemo.Zoom <> 0);
  2085. VToolbar.Checked := Toolbar.Visible;
  2086. VStatusBar.Checked := StatusBar.Visible;
  2087. VNextTab.Enabled := MemosTabSet.Visible and (MemosTabSet.Tabs.Count > 1);
  2088. VPreviousTab.Enabled := VNextTab.Enabled;
  2089. VCloseTab.Enabled := MemosTabSet.Visible and (FActiveMemo <> FMainMemo) and (FActiveMemo <> FPreprocessorOutputMemo);
  2090. VReopenTab.Visible := MemosTabSet.Visible and (FHiddenFiles.Count > 0);
  2091. if VReopenTab.Visible then
  2092. UpdateReopenTabMenu(VReopenTab);
  2093. VReopenTabs.Visible := VReopenTab.Visible;
  2094. VHide.Checked := not StatusPanel.Visible;
  2095. VCompilerOutput.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiCompilerOutput);
  2096. VDebugOutput.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiDebugOutput);
  2097. VDebugCallStack.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiDebugCallStack);
  2098. VFindResults.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiFindResults);
  2099. end;
  2100. procedure TCompileForm.VNextTabClick(Sender: TObject);
  2101. var
  2102. NewTabIndex: Integer;
  2103. begin
  2104. NewTabIndex := MemosTabSet.TabIndex+1;
  2105. if NewTabIndex >= MemosTabSet.Tabs.Count then
  2106. NewTabIndex := 0;
  2107. MemosTabSet.TabIndex := NewTabIndex;
  2108. end;
  2109. procedure TCompileForm.VPreviousTabClick(Sender: TObject);
  2110. var
  2111. NewTabIndex: Integer;
  2112. begin
  2113. NewTabIndex := MemosTabSet.TabIndex-1;
  2114. if NewTabIndex < 0 then
  2115. NewTabIndex := MemosTabSet.Tabs.Count-1;
  2116. MemosTabSet.TabIndex := NewTabIndex;
  2117. end;
  2118. procedure TCompileForm.VCloseTabClick(Sender: TObject);
  2119. begin
  2120. var Index := MemoToTabIndex(FActiveMemo);
  2121. MemosTabSet.Tabs.Delete(Index);
  2122. MemosTabSet.Hints.Delete(Index);
  2123. MemosTabSet.CloseButtons.Delete(Index);
  2124. FActiveMemo.Visible := False;
  2125. FHiddenFiles.Add((FActiveMemo as TCompScintFileEdit).Filename);
  2126. UpdateHiddenFilesPanel;
  2127. SaveKnownIncludedAndHiddenFiles(FMainMemo.Filename);
  2128. { Select next tab, except when we're already at the end }
  2129. VNextTabClick(Self);
  2130. VPreviousTabClick(Self);
  2131. end;
  2132. procedure TCompileForm.ReopenTabOrTabs(const HiddenFileIndex: Integer;
  2133. const Activate: Boolean);
  2134. begin
  2135. var ReopenFilename: String;
  2136. if HiddenFileIndex >= 0 then begin
  2137. ReopenFilename := FHiddenFiles[HiddenFileIndex];
  2138. FHiddenFiles.Delete(HiddenFileIndex);
  2139. end else begin
  2140. ReopenFilename := FHiddenFiles[0];
  2141. FHiddenFiles.Clear;
  2142. end;
  2143. UpdateHiddenFilesPanel;
  2144. UpdatePreprocMemos;
  2145. SaveKnownIncludedAndHiddenFiles(FMainMemo.Filename);
  2146. { Activate the memo if requested }
  2147. if Activate then begin
  2148. for var Memo in FFileMemos do begin
  2149. if Memo.Used and (PathCompare(Memo.Filename, ReopenFilename) = 0) then begin
  2150. MemosTabSet.TabIndex := MemoToTabIndex(memo);
  2151. Break;
  2152. end;
  2153. end
  2154. end;
  2155. end;
  2156. procedure TCompileForm.VReopenTabClick(Sender: TObject);
  2157. begin
  2158. ReopenTabOrTabs((Sender as TMenuItem).Tag, True);
  2159. end;
  2160. procedure TCompileForm.VReopenTabsClick(Sender: TObject);
  2161. begin
  2162. ReopenTabOrTabs(-1, True);
  2163. end;
  2164. procedure TCompileForm.SyncZoom;
  2165. var
  2166. Memo: TCompScintEdit;
  2167. begin
  2168. { The zoom shortcuts are handled by Scintilla and may cause different zoom levels per memo. This
  2169. function sets the zoom of all memo's to the zoom of the active memo to make zoom in synch again. }
  2170. for Memo in FMemos do
  2171. if Memo <> FActiveMemo then
  2172. Memo.Zoom := FActiveMemo.Zoom;
  2173. end;
  2174. procedure TCompileForm.VZoomInClick(Sender: TObject);
  2175. var
  2176. Memo: TCompScintEdit;
  2177. begin
  2178. SyncZoom;
  2179. for Memo in FMemos do
  2180. Memo.ZoomIn;
  2181. end;
  2182. procedure TCompileForm.VZoomOutClick(Sender: TObject);
  2183. var
  2184. Memo: TCompScintEdit;
  2185. begin
  2186. SyncZoom;
  2187. for Memo in FMemos do
  2188. Memo.ZoomOut;
  2189. end;
  2190. procedure TCompileForm.VZoomResetClick(Sender: TObject);
  2191. var
  2192. Memo: TCompScintEdit;
  2193. begin
  2194. for Memo in FMemos do
  2195. Memo.Zoom := 0;
  2196. end;
  2197. procedure TCompileForm.VToolbarClick(Sender: TObject);
  2198. begin
  2199. Toolbar.Visible := not Toolbar.Visible;
  2200. end;
  2201. procedure TCompileForm.VStatusBarClick(Sender: TObject);
  2202. begin
  2203. StatusBar.Visible := not StatusBar.Visible;
  2204. end;
  2205. procedure TCompileForm.SetStatusPanelVisible(const AVisible: Boolean);
  2206. var
  2207. CaretWasInView: Boolean;
  2208. begin
  2209. if StatusPanel.Visible <> AVisible then begin
  2210. CaretWasInView := FActiveMemo.IsPositionInViewVertically(FActiveMemo.CaretPosition);
  2211. if AVisible then begin
  2212. { Ensure the status panel height isn't out of range before showing }
  2213. UpdateStatusPanelHeight(StatusPanel.Height);
  2214. SplitPanel.Top := ClientHeight;
  2215. StatusPanel.Top := ClientHeight;
  2216. end
  2217. else begin
  2218. if StatusPanel.ContainsControl(ActiveControl) then
  2219. ActiveControl := FActiveMemo;
  2220. end;
  2221. SplitPanel.Visible := AVisible;
  2222. StatusPanel.Visible := AVisible;
  2223. if AVisible and CaretWasInView then begin
  2224. { If the caret was in view, make sure it still is }
  2225. FActiveMemo.ScrollCaretIntoView;
  2226. end;
  2227. end;
  2228. end;
  2229. procedure TCompileForm.VHideClick(Sender: TObject);
  2230. begin
  2231. SetStatusPanelVisible(False);
  2232. end;
  2233. procedure TCompileForm.VCompilerOutputClick(Sender: TObject);
  2234. begin
  2235. OutputTabSet.TabIndex := tiCompilerOutput;
  2236. SetStatusPanelVisible(True);
  2237. end;
  2238. procedure TCompileForm.VDebugOutputClick(Sender: TObject);
  2239. begin
  2240. OutputTabSet.TabIndex := tiDebugOutput;
  2241. SetStatusPanelVisible(True);
  2242. end;
  2243. procedure TCompileForm.VDebugCallStackClick(Sender: TObject);
  2244. begin
  2245. OutputTabSet.TabIndex := tiDebugCallStack;
  2246. SetStatusPanelVisible(True);
  2247. end;
  2248. procedure TCompileForm.VFindResultsClick(Sender: TObject);
  2249. begin
  2250. OutputTabSet.TabIndex := tiFindResults;
  2251. SetStatusPanelVisible(True);
  2252. end;
  2253. procedure TCompileForm.BMenuClick(Sender: TObject);
  2254. begin
  2255. BLowPriority.Checked := FOptions.LowPriorityDuringCompile;
  2256. BOpenOutputFolder.Enabled := (FCompiledExe <> '');
  2257. end;
  2258. procedure TCompileForm.BCompileClick(Sender: TObject);
  2259. begin
  2260. CompileFile('', False);
  2261. end;
  2262. procedure TCompileForm.BStopCompileClick(Sender: TObject);
  2263. begin
  2264. SetAppTaskbarProgressState(tpsPaused);
  2265. try
  2266. if MsgBox('Are you sure you want to abort the compile?', SCompilerFormCaption,
  2267. mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then
  2268. FCompileWantAbort := True;
  2269. finally
  2270. SetAppTaskbarProgressState(tpsNormal);
  2271. end;
  2272. end;
  2273. procedure TCompileForm.BLowPriorityClick(Sender: TObject);
  2274. begin
  2275. FOptions.LowPriorityDuringCompile := not FOptions.LowPriorityDuringCompile;
  2276. { If a compile is already in progress, change the priority now }
  2277. if FCompiling then
  2278. SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass);
  2279. end;
  2280. procedure TCompileForm.BOpenOutputFolderClick(Sender: TObject);
  2281. var
  2282. Dir: String;
  2283. begin
  2284. Dir := GetWinDir;
  2285. ShellExecute(Application.Handle, 'open', PChar(AddBackslash(Dir) + 'explorer.exe'),
  2286. PChar(Format('/select,"%s"', [FCompiledExe])), PChar(Dir), SW_SHOW);
  2287. end;
  2288. procedure TCompileForm.HMenuClick(Sender: TObject);
  2289. begin
  2290. HISPPDoc.Visible := NewFileExists(PathExtractPath(NewParamStr(0)) + 'ispp.chm');
  2291. HISPPSep.Visible := HISPPDoc.Visible;
  2292. end;
  2293. procedure TCompileForm.HShortcutsDocClick(Sender: TObject);
  2294. begin
  2295. if Assigned(HtmlHelp) then
  2296. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_compformshortcuts.htm')));
  2297. end;
  2298. procedure TCompileForm.HDocClick(Sender: TObject);
  2299. begin
  2300. if Assigned(HtmlHelp) then
  2301. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, 0);
  2302. end;
  2303. procedure TCompileForm.MemoKeyDown(Sender: TObject; var Key: Word;
  2304. Shift: TShiftState);
  2305. var
  2306. S, HelpFile: String;
  2307. KLink: THH_AKLINK;
  2308. begin
  2309. if Key = VK_F1 then begin
  2310. HelpFile := GetHelpFile;
  2311. if Assigned(HtmlHelp) then begin
  2312. HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_DISPLAY_TOPIC, 0);
  2313. S := FActiveMemo.WordAtCursor;
  2314. if S <> '' then begin
  2315. FillChar(KLink, SizeOf(KLink), 0);
  2316. KLink.cbStruct := SizeOf(KLink);
  2317. KLink.pszKeywords := PChar(S);
  2318. KLink.fIndexOnFail := True;
  2319. HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_KEYWORD_LOOKUP, DWORD(@KLink));
  2320. end;
  2321. end;
  2322. end
  2323. else if (Key = VK_RIGHT) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssAlt]) then begin
  2324. InitiateAutoComplete(#0);
  2325. Key := 0;
  2326. end;
  2327. end;
  2328. procedure TCompileForm.MemoKeyPress(Sender: TObject; var Key: Char);
  2329. begin
  2330. if (Key = ' ') and (GetKeyState(VK_CONTROL) < 0) then begin
  2331. InitiateAutoComplete(#0);
  2332. Key := #0;
  2333. end;
  2334. end;
  2335. procedure TCompileForm.HExamplesClick(Sender: TObject);
  2336. begin
  2337. ShellExecute(Application.Handle, 'open',
  2338. PChar(PathExtractPath(NewParamStr(0)) + 'Examples'), nil, nil, SW_SHOW);
  2339. end;
  2340. procedure TCompileForm.HFaqClick(Sender: TObject);
  2341. begin
  2342. ShellExecute(Application.Handle, 'open',
  2343. PChar(PathExtractPath(NewParamStr(0)) + 'isfaq.url'), nil, nil, SW_SHOW);
  2344. end;
  2345. procedure TCompileForm.HWhatsNewClick(Sender: TObject);
  2346. begin
  2347. ShellExecute(Application.Handle, 'open',
  2348. PChar(PathExtractPath(NewParamStr(0)) + 'whatsnew.htm'), nil, nil, SW_SHOW);
  2349. end;
  2350. procedure TCompileForm.HWebsiteClick(Sender: TObject);
  2351. begin
  2352. ShellExecute(Application.Handle, 'open', 'https://jrsoftware.org/isinfo.php', nil,
  2353. nil, SW_SHOW);
  2354. end;
  2355. procedure TCompileForm.HMailingListClick(Sender: TObject);
  2356. begin
  2357. OpenMailingListSite;
  2358. end;
  2359. procedure TCompileForm.HPSWebsiteClick(Sender: TObject);
  2360. begin
  2361. ShellExecute(Application.Handle, 'open', 'http://www.remobjects.com/ps', nil,
  2362. nil, SW_SHOW);
  2363. end;
  2364. procedure TCompileForm.HISPPDocClick(Sender: TObject);
  2365. begin
  2366. if Assigned(HtmlHelp) then
  2367. HtmlHelp(GetDesktopWindow, PChar(GetHelpFile + '::/hh_isppredirect.xhtm'), HH_DISPLAY_TOPIC, 0);
  2368. end;
  2369. procedure TCompileForm.HDonateClick(Sender: TObject);
  2370. begin
  2371. OpenDonateSite;
  2372. end;
  2373. procedure TCompileForm.HAboutClick(Sender: TObject);
  2374. var
  2375. S: String;
  2376. begin
  2377. { Removing the About box or modifying any existing text inside it is a
  2378. violation of the Inno Setup license agreement; see LICENSE.TXT.
  2379. However, adding additional lines to the About box is permitted, as long as
  2380. they are placed below the original copyright notice. }
  2381. S := FCompilerVersion.Title + ' Compiler version ' +
  2382. String(FCompilerVersion.Version) + SNewLine;
  2383. if FCompilerVersion.Title <> 'Inno Setup' then
  2384. S := S + (SNewLine + 'Based on Inno Setup' + SNewLine);
  2385. S := S + ('Copyright (C) 1997-2024 Jordan Russell' + SNewLine +
  2386. 'Portions Copyright (C) 2000-2024 Martijn Laan' + SNewLine +
  2387. 'All rights reserved.' + SNewLine2 +
  2388. 'Inno Setup home page:' + SNewLine +
  2389. 'https://www.innosetup.com/' + SNewLine2 +
  2390. 'RemObjects Pascal Script home page:' + SNewLine +
  2391. 'https://www.remobjects.com/ps' + SNewLine2 +
  2392. 'Refer to LICENSE.TXT for conditions of distribution and use.');
  2393. MsgBox(S, 'About ' + FCompilerVersion.Title, mbInformation, MB_OK);
  2394. end;
  2395. procedure TCompileForm.WMStartCommandLineCompile(var Message: TMessage);
  2396. var
  2397. Code: Integer;
  2398. begin
  2399. UpdateStatusPanelHeight(ClientHeight);
  2400. Code := 0;
  2401. try
  2402. try
  2403. CompileFile(CommandLineFilename, True);
  2404. except
  2405. Code := 2;
  2406. Application.HandleException(Self);
  2407. end;
  2408. finally
  2409. Halt(Code);
  2410. end;
  2411. end;
  2412. procedure TCompileForm.WMStartCommandLineWizard(var Message: TMessage);
  2413. var
  2414. Code: Integer;
  2415. begin
  2416. Code := 0;
  2417. try
  2418. try
  2419. NewMainFileUsingWizard;
  2420. except
  2421. Code := 2;
  2422. Application.HandleException(Self);
  2423. end;
  2424. finally
  2425. Halt(Code);
  2426. end;
  2427. end;
  2428. procedure TCompileForm.WMStartNormally(var Message: TMessage);
  2429. procedure ShowStartupForm;
  2430. var
  2431. StartupForm: TStartupForm;
  2432. Ini: TConfigIniFile;
  2433. begin
  2434. ReadMRUMainFilesList;
  2435. StartupForm := TStartupForm.Create(Application);
  2436. try
  2437. StartupForm.MRUFilesList := FMRUMainFilesList;
  2438. StartupForm.StartupCheck.Checked := not FOptions.ShowStartupForm;
  2439. if StartupForm.ShowModal = mrOK then begin
  2440. if FOptions.ShowStartupForm <> not StartupForm.StartupCheck.Checked then begin
  2441. FOptions.ShowStartupForm := not StartupForm.StartupCheck.Checked;
  2442. Ini := TConfigIniFile.Create;
  2443. try
  2444. Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
  2445. finally
  2446. Ini.Free;
  2447. end;
  2448. end;
  2449. case StartupForm.Result of
  2450. srEmpty:
  2451. FNewMainFileClick(Self);
  2452. srWizard:
  2453. FNewMainFileUserWizardClick(Self);
  2454. srOpenFile:
  2455. if ConfirmCloseFile(True) then
  2456. OpenMRUMainFile(StartupForm.ResultMainFileName);
  2457. srOpenDialog:
  2458. ShowOpenMainFileDialog(False);
  2459. srOpenDialogExamples:
  2460. ShowOpenMainFileDialog(True);
  2461. end;
  2462. end;
  2463. finally
  2464. StartupForm.Free;
  2465. end;
  2466. end;
  2467. begin
  2468. if CommandLineFilename = '' then begin
  2469. if FOptions.ShowStartupForm then
  2470. ShowStartupForm;
  2471. end else
  2472. OpenFile(FMainMemo, CommandLineFilename, False);
  2473. end;
  2474. procedure TCompileForm.UpdateReopenTabMenu(const Menu: TMenuItem);
  2475. begin
  2476. Menu.Clear;
  2477. for var I := 0 to FHiddenFiles.Count-1 do begin
  2478. var MenuItem := TMenuItem.Create(Menu);
  2479. MenuItem.Caption := ExtractFileName(FHiddenFiles[I]);
  2480. MenuItem.Tag := I;
  2481. MenuItem.OnClick := VReopenTabClick;
  2482. Menu.Add(MenuItem);
  2483. end;
  2484. end;
  2485. procedure TCompileForm.MemosTabSetPopup(Sender: TObject);
  2486. begin
  2487. { Main and preprocessor memos can't be hidden }
  2488. VCloseTab2.Enabled := (FActiveMemo <> FMainMemo) and (FActiveMemo <> FPreprocessorOutputMemo);
  2489. VReopenTab2.Visible := FHiddenFiles.Count > 0;
  2490. if VReopenTab2.Visible then
  2491. UpdateReopenTabMenu(VReopenTab2);
  2492. VReopenTabs2.Visible := VReopenTab2.Visible;
  2493. end;
  2494. procedure TCompileForm.MemosTabSetClick(Sender: TObject);
  2495. { Also see MemoToTabIndex }
  2496. function TabIndexToMemoIndex(const ATabIndex, AMaxTabIndex: Integer): Integer;
  2497. begin
  2498. if ATabIndex = 0 then
  2499. Result := 0 { First tab displays the main memo which is FMemos[0] }
  2500. else if FPreprocessorOutputMemo.Used and (ATabIndex = AMaxTabIndex) then
  2501. Result := 1 { Last tab displays the preprocessor output memo which is FMemos[1] }
  2502. else begin
  2503. { Only count memos not explicitly hidden by the user }
  2504. var TabIndex := 0;
  2505. for var MemoIndex := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin
  2506. if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) = -1 then begin
  2507. Inc(TabIndex);
  2508. if TabIndex = ATabIndex then begin
  2509. Result := MemoIndex + 1; { Other tabs display include files which start at second tab but at FMemos[2] }
  2510. Exit;
  2511. end;
  2512. end;
  2513. end;
  2514. raise Exception.Create('TabIndexToMemoIndex failed');
  2515. end;
  2516. end;
  2517. var
  2518. Memo: TCompScintEdit;
  2519. TabIndex, MaxTabIndex: Integer;
  2520. begin
  2521. FActiveMemo.CancelAutoComplete;
  2522. MaxTabIndex := MemosTabSet.Tabs.Count-1;
  2523. for TabIndex := 0 to MaxTabIndex do begin
  2524. Memo := FMemos[TabIndexToMemoIndex(TabIndex, MaxTabIndex)];
  2525. Memo.Visible := (TabIndex = MemosTabSet.TabIndex);
  2526. if Memo.Visible then begin
  2527. FActiveMemo := Memo;
  2528. ActiveControl := Memo;
  2529. end;
  2530. end;
  2531. UpdateSaveMenuItemAndButton;
  2532. UpdateRunMenu;
  2533. UpdateCaretPosPanel;
  2534. UpdateEditModePanel;
  2535. UpdateModifiedPanel;
  2536. end;
  2537. procedure TCompileForm.MemosTabSetOnCloseButtonClick(Sender: TObject);
  2538. begin
  2539. VCloseTabClick(Self);
  2540. end;
  2541. procedure TCompileForm.InitializeFindText(Dlg: TFindDialog);
  2542. var
  2543. S: String;
  2544. begin
  2545. S := FActiveMemo.SelText;
  2546. if (S <> '') and (Pos(#13, S) = 0) and (Pos(#10, S) = 0) then
  2547. Dlg.FindText := S
  2548. else
  2549. Dlg.FindText := FLastFindText;
  2550. end;
  2551. procedure TCompileForm.EFindClick(Sender: TObject);
  2552. begin
  2553. ReplaceDialog.CloseDialog;
  2554. if FindDialog.Handle = 0 then
  2555. InitializeFindText(FindDialog);
  2556. if (Sender = EFind) or (Sender = EFindNext) then
  2557. FindDialog.Options := FindDialog.Options + [frDown]
  2558. else
  2559. FindDialog.Options := FindDialog.Options - [frDown];
  2560. FindDialog.Execute;
  2561. end;
  2562. procedure TCompileForm.EFindInFilesClick(Sender: TObject);
  2563. begin
  2564. InitializeFindText(FindInFilesDialog);
  2565. FindInFilesDialog.Execute;
  2566. end;
  2567. procedure TCompileForm.EFindNextOrPreviousClick(Sender: TObject);
  2568. begin
  2569. if FLastFindText = '' then
  2570. EFindClick(Sender)
  2571. else begin
  2572. if Sender = EFindNext then
  2573. FLastFindOptions := FLastFindOptions + [frDown]
  2574. else
  2575. FLastFindOptions := FLastFindOptions - [frDown];
  2576. FindNext;
  2577. end;
  2578. end;
  2579. procedure TCompileForm.FindNext;
  2580. var
  2581. StartPos, EndPos: Integer;
  2582. Range: TScintRange;
  2583. begin
  2584. if frDown in FLastFindOptions then begin
  2585. StartPos := FActiveMemo.Selection.EndPos;
  2586. EndPos := FActiveMemo.RawTextLength;
  2587. end
  2588. else begin
  2589. StartPos := FActiveMemo.Selection.StartPos;
  2590. EndPos := 0;
  2591. end;
  2592. if FActiveMemo.FindText(StartPos, EndPos, FLastFindText,
  2593. FindOptionsToSearchOptions(FLastFindOptions), Range) then
  2594. FActiveMemo.Selection := Range
  2595. else
  2596. MsgBoxFmt('Cannot find "%s"', [FLastFindText], SCompilerFormCaption,
  2597. mbInformation, MB_OK);
  2598. end;
  2599. procedure TCompileForm.StoreLastFindOptions(Sender: TObject);
  2600. begin
  2601. with Sender as TFindDialog do begin
  2602. FLastFindOptions := Options;
  2603. FLastFindText := FindText;
  2604. end;
  2605. end;
  2606. procedure TCompileForm.FindDialogFind(Sender: TObject);
  2607. begin
  2608. { This event handler is shared between FindDialog & ReplaceDialog }
  2609. { Save a copy of the current text so that InitializeFindText doesn't
  2610. mess up the operation of Edit | Find Next }
  2611. StoreLastFindOptions(Sender);
  2612. FindNext;
  2613. end;
  2614. procedure TCompileForm.FindInFilesDialogFind(Sender: TObject);
  2615. var
  2616. Memo: TCompScintFileEdit;
  2617. Hits, FileHits, Files, StartPos, EndPos, Line: Integer;
  2618. Range: TScintRange;
  2619. FindResult: TFindResult;
  2620. Prefix: String;
  2621. begin
  2622. StoreLastFindOptions(Sender);
  2623. FindResultsList.Clear;
  2624. SendMessage(FindResultsList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  2625. FFindResults.Clear;
  2626. Hits := 0;
  2627. Files := 0;
  2628. for Memo in FFileMemos do begin
  2629. if Memo.Used then begin
  2630. StartPos := 0;
  2631. EndPos := Memo.RawTextLength;
  2632. FileHits := 0;
  2633. while (StartPos < EndPos) and
  2634. Memo.FindText(StartPos, EndPos, FLastFindText,
  2635. FindOptionsToSearchOptions(FLastFindOptions), Range) do begin
  2636. Line := Memo.GetLineFromPosition(Range.StartPos);
  2637. Prefix := Format(' Line %d: ', [Line+1]);
  2638. FindResult := TFindResult.Create;
  2639. FindResult.Filename := Memo.Filename;
  2640. FindResult.Line := Line;
  2641. FindResult.LineStartPos := Memo.GetPositionFromLine(Line);
  2642. FindResult.Range := Range;
  2643. FindResult.PrefixStringLength := Length(Prefix);
  2644. FFindResults.Add(FindResult);
  2645. FindResultsList.Items.AddObject(Prefix + Memo.Lines[Line], FindResult);
  2646. Inc(FileHits);
  2647. StartPos := Range.EndPos;
  2648. end;
  2649. Inc(Files);
  2650. if FileHits > 0 then begin
  2651. Inc(Hits, FileHits);
  2652. FindResultsList.Items.Insert(FindResultsList.Count-FileHits, Format('%s (%d hits):', [Memo.Filename, FileHits]));
  2653. end;
  2654. end;
  2655. end;
  2656. FindResultsList.Items.Insert(0, Format('Find "%s" (%d hits in %d files)', [FindInFilesDialog.FindText, Hits, Files]));
  2657. FindInFilesDialog.CloseDialog;
  2658. OutputTabSet.TabIndex := tiFindResults;
  2659. SetStatusPanelVisible(True);
  2660. end;
  2661. procedure TCompileForm.EReplaceClick(Sender: TObject);
  2662. begin
  2663. FindDialog.CloseDialog;
  2664. if ReplaceDialog.Handle = 0 then begin
  2665. InitializeFindText(ReplaceDialog);
  2666. ReplaceDialog.ReplaceText := FLastReplaceText;
  2667. end;
  2668. ReplaceDialog.Execute;
  2669. end;
  2670. procedure TCompileForm.ReplaceDialogReplace(Sender: TObject);
  2671. var
  2672. ReplaceCount, Pos: Integer;
  2673. Range, NewRange: TScintRange;
  2674. begin
  2675. FLastFindOptions := ReplaceDialog.Options;
  2676. FLastFindText := ReplaceDialog.FindText;
  2677. FLastReplaceText := ReplaceDialog.ReplaceText;
  2678. if frReplaceAll in FLastFindOptions then begin
  2679. ReplaceCount := 0;
  2680. FActiveMemo.BeginUndoAction;
  2681. try
  2682. Pos := 0;
  2683. while FActiveMemo.FindText(Pos, FActiveMemo.RawTextLength, FLastFindText,
  2684. FindOptionsToSearchOptions(FLastFindOptions), Range) do begin
  2685. NewRange := FActiveMemo.ReplaceTextRange(Range.StartPos, Range.EndPos, FLastReplaceText);
  2686. Pos := NewRange.EndPos;
  2687. Inc(ReplaceCount);
  2688. end;
  2689. finally
  2690. FActiveMemo.EndUndoAction;
  2691. end;
  2692. if ReplaceCount = 0 then
  2693. MsgBoxFmt('Cannot find "%s"', [FLastFindText], SCompilerFormCaption,
  2694. mbInformation, MB_OK)
  2695. else
  2696. MsgBoxFmt('%d occurrence(s) replaced.', [ReplaceCount], SCompilerFormCaption,
  2697. mbInformation, MB_OK);
  2698. end
  2699. else begin
  2700. if FActiveMemo.SelTextEquals(FLastFindText, frMatchCase in FLastFindOptions) then
  2701. FActiveMemo.SelText := FLastReplaceText;
  2702. FindNext;
  2703. end;
  2704. end;
  2705. procedure TCompileForm.UpdateStatusPanelHeight(H: Integer);
  2706. var
  2707. MinHeight, MaxHeight: Integer;
  2708. begin
  2709. MinHeight := (3 * DebugOutputList.ItemHeight + ToCurrentPPI(4)) + OutputTabSet.Height;
  2710. MaxHeight := BodyPanel.ClientHeight - ToCurrentPPI(48) - SplitPanel.Height;
  2711. if H > MaxHeight then H := MaxHeight;
  2712. if H < MinHeight then H := MinHeight;
  2713. StatusPanel.Height := H;
  2714. end;
  2715. procedure TCompileForm.UpdateOutputTabSetListsItemHeightAndDebugTimeWidth;
  2716. begin
  2717. CompilerOutputList.Canvas.Font.Assign(CompilerOutputList.Font);
  2718. CompilerOutputList.ItemHeight := CompilerOutputList.Canvas.TextHeight('0') + 1;
  2719. DebugOutputList.Canvas.Font.Assign(DebugOutputList.Font);
  2720. FDebugLogListTimestampsWidth := DebugOutputList.Canvas.TextWidth(Format('[00%s00%s00%s000] ', [FormatSettings.TimeSeparator, FormatSettings.TimeSeparator, FormatSettings.DecimalSeparator]));
  2721. DebugOutputList.ItemHeight := DebugOutputList.Canvas.TextHeight('0') + 1;
  2722. DebugCallStackList.Canvas.Font.Assign(DebugCallStackList.Font);
  2723. DebugCallStackList.ItemHeight := DebugCallStackList.Canvas.TextHeight('0') + 1;
  2724. FindResultsList.Canvas.Font.Assign(FindResultsList.Font);
  2725. FindResultsList.ItemHeight := FindResultsList.Canvas.TextHeight('0') + 1;
  2726. end;
  2727. procedure TCompileForm.SplitPanelMouseMove(Sender: TObject;
  2728. Shift: TShiftState; X, Y: Integer);
  2729. begin
  2730. if (ssLeft in Shift) and StatusPanel.Visible then begin
  2731. UpdateStatusPanelHeight(BodyPanel.ClientToScreen(Point(0, 0)).Y -
  2732. SplitPanel.ClientToScreen(Point(0, Y)).Y +
  2733. BodyPanel.ClientHeight - (SplitPanel.Height div 2));
  2734. end;
  2735. end;
  2736. procedure TCompileForm.TMenuClick(Sender: TObject);
  2737. var
  2738. MemoIsReadOnly: Boolean;
  2739. begin
  2740. MemoIsReadOnly := FActiveMemo.ReadOnly;
  2741. TGenerateGUID.Enabled := not MemoIsReadOnly;
  2742. TMsgBoxDesigner.Enabled := not MemoIsReadOnly;
  2743. TFilesDesigner.Enabled := not MemoIsReadOnly;
  2744. end;
  2745. procedure TCompileForm.TAddRemoveProgramsClick(Sender: TObject);
  2746. begin
  2747. StartAddRemovePrograms;
  2748. end;
  2749. procedure TCompileForm.TGenerateGUIDClick(Sender: TObject);
  2750. begin
  2751. if MsgBox('The generated GUID will be inserted into the editor at the cursor position. Continue?',
  2752. SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
  2753. FActiveMemo.SelText := GenerateGuid;
  2754. end;
  2755. procedure TCompileForm.TMsgBoxDesignerClick(Sender: TObject);
  2756. var
  2757. MsgBoxForm: TMsgBoxDesignerForm;
  2758. begin
  2759. if (FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scCode) and
  2760. (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?',
  2761. SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDNO) then
  2762. Exit;
  2763. MsgBoxForm := TMsgBoxDesignerForm.Create(Application);
  2764. try
  2765. if MsgBoxForm.ShowModal = mrOk then
  2766. FActiveMemo.SelText := MsgBoxForm.Text;
  2767. finally
  2768. MsgBoxForm.Free;
  2769. end;
  2770. end;
  2771. procedure TCompileForm.TFilesDesignerClick(Sender: TObject);
  2772. var
  2773. FilesDesignerForm: TFilesDesignerForm;
  2774. begin
  2775. if (FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scFiles) and
  2776. (MsgBox('The generated script will be inserted into the editor at the start of the current line, but the cursor is not in the [Files] section. Continue anyway?',
  2777. SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDNO) then
  2778. Exit;
  2779. FilesDesignerForm := TFilesDesignerForm.Create(Application);
  2780. try
  2781. if FilesDesignerForm.ShowModal = mrOk then begin
  2782. FActiveMemo.CaretColumn := 0;
  2783. FActiveMemo.SelText := FilesDesignerForm.Text;
  2784. end;
  2785. finally
  2786. FilesDesignerForm.Free;
  2787. end;
  2788. end;
  2789. procedure TCompileForm.TSignToolsClick(Sender: TObject);
  2790. var
  2791. SignToolsForm: TSignToolsForm;
  2792. Ini: TConfigIniFile;
  2793. I: Integer;
  2794. begin
  2795. SignToolsForm := TSignToolsForm.Create(Application);
  2796. try
  2797. SignToolsForm.SignTools := FSignTools;
  2798. if SignToolsForm.ShowModal <> mrOK then
  2799. Exit;
  2800. FSignTools.Assign(SignToolsForm.SignTools);
  2801. { Save new options }
  2802. Ini := TConfigIniFile.Create;
  2803. try
  2804. Ini.EraseSection('SignTools');
  2805. for I := 0 to FSignTools.Count-1 do
  2806. Ini.WriteString('SignTools', 'SignTool' + IntToStr(I), FSignTools[I]);
  2807. finally
  2808. Ini.Free;
  2809. end;
  2810. finally
  2811. SignToolsForm.Free;
  2812. end;
  2813. end;
  2814. procedure TCompileForm.TOptionsClick(Sender: TObject);
  2815. var
  2816. OptionsForm: TOptionsForm;
  2817. Ini: TConfigIniFile;
  2818. Memo: TCompScintEdit;
  2819. begin
  2820. OptionsForm := TOptionsForm.Create(Application);
  2821. try
  2822. OptionsForm.StartupCheck.Checked := FOptions.ShowStartupForm;
  2823. OptionsForm.WizardCheck.Checked := FOptions.UseWizard;
  2824. OptionsForm.AutosaveCheck.Checked := FOptions.Autosave;
  2825. OptionsForm.BackupCheck.Checked := FOptions.MakeBackups;
  2826. OptionsForm.FullPathCheck.Checked := FOptions.FullPathInTitleBar;
  2827. OptionsForm.UndoAfterSaveCheck.Checked := FOptions.UndoAfterSave;
  2828. OptionsForm.PauseOnDebuggerExceptionsCheck.Checked := FOptions.PauseOnDebuggerExceptions;
  2829. OptionsForm.RunAsDifferentUserCheck.Checked := FOptions.RunAsDifferentUser;
  2830. OptionsForm.AutoCompleteCheck.Checked := FOptions.AutoComplete;
  2831. OptionsForm.UseSynHighCheck.Checked := FOptions.UseSyntaxHighlighting;
  2832. OptionsForm.ColorizeCompilerOutputCheck.Checked := FOptions.ColorizeCompilerOutput;
  2833. OptionsForm.UnderlineErrorsCheck.Checked := FOptions.UnderlineErrors;
  2834. OptionsForm.CursorPastEOLCheck.Checked := FOptions.CursorPastEOL;
  2835. OptionsForm.TabWidthEdit.Text := IntToStr(FOptions.TabWidth);
  2836. OptionsForm.UseTabCharacterCheck.Checked := FOptions.UseTabCharacter;
  2837. OptionsForm.WordWrapCheck.Checked := FOptions.WordWrap;
  2838. OptionsForm.AutoIndentCheck.Checked := FOptions.AutoIndent;
  2839. OptionsForm.IndentationGuidesCheck.Checked := FOptions.IndentationGuides;
  2840. OptionsForm.GutterLineNumbersCheck.Checked := FOptions.GutterLineNumbers;
  2841. OptionsForm.ShowPreprocessorOutputCheck.Checked := FOptions.ShowPreprocessorOutput;
  2842. OptionsForm.OpenIncludedFilesCheck.Checked := FOptions.OpenIncludedFiles;
  2843. OptionsForm.ThemeComboBox.ItemIndex := Ord(FOptions.ThemeType);
  2844. OptionsForm.FontPanel.Font.Assign(FMainMemo.Font);
  2845. OptionsForm.FontPanel.ParentBackground := False;
  2846. OptionsForm.FontPanel.Color := FMainMemo.Color;
  2847. if OptionsForm.ShowModal <> mrOK then
  2848. Exit;
  2849. FOptions.ShowStartupForm := OptionsForm.StartupCheck.Checked;
  2850. FOptions.UseWizard := OptionsForm.WizardCheck.Checked;
  2851. FOptions.Autosave := OptionsForm.AutosaveCheck.Checked;
  2852. FOptions.MakeBackups := OptionsForm.BackupCheck.Checked;
  2853. FOptions.FullPathInTitleBar := OptionsForm.FullPathCheck.Checked;
  2854. FOptions.UndoAfterSave := OptionsForm.UndoAfterSaveCheck.Checked;
  2855. FOptions.PauseOnDebuggerExceptions := OptionsForm.PauseOnDebuggerExceptionsCheck.Checked;
  2856. FOptions.RunAsDifferentUser := OptionsForm.RunAsDifferentUserCheck.Checked;
  2857. FOptions.AutoComplete := OptionsForm.AutoCompleteCheck.Checked;
  2858. FOptions.UseSyntaxHighlighting := OptionsForm.UseSynHighCheck.Checked;
  2859. FOptions.ColorizeCompilerOutput := OptionsForm.ColorizeCompilerOutputCheck.Checked;
  2860. FOptions.UnderlineErrors := OptionsForm.UnderlineErrorsCheck.Checked;
  2861. FOptions.CursorPastEOL := OptionsForm.CursorPastEOLCheck.Checked;
  2862. FOptions.TabWidth := StrToInt(OptionsForm.TabWidthEdit.Text);
  2863. FOptions.UseTabCharacter := OptionsForm.UseTabCharacterCheck.Checked;
  2864. FOptions.WordWrap := OptionsForm.WordWrapCheck.Checked;
  2865. FOptions.AutoIndent := OptionsForm.AutoIndentCheck.Checked;
  2866. FOptions.IndentationGuides := OptionsForm.IndentationGuidesCheck.Checked;
  2867. FOptions.GutterLineNumbers := OptionsForm.GutterLineNumbersCheck.Checked;
  2868. FOptions.ShowPreprocessorOutput := OptionsForm.ShowPreprocessorOutputCheck.Checked;
  2869. FOptions.OpenIncludedFiles := OptionsForm.OpenIncludedFilesCheck.Checked;
  2870. FOptions.ThemeType := TThemeType(OptionsForm.ThemeComboBox.ItemIndex);
  2871. UpdateCaption;
  2872. UpdatePreprocMemos;
  2873. UpdateHiddenFilesPanel;
  2874. for Memo in FMemos do begin
  2875. { Move caret to start of line to ensure it doesn't end up in the middle
  2876. of a double-byte character if the code page changes from SBCS to DBCS }
  2877. Memo.CaretLine := Memo.CaretLine;
  2878. Memo.Font.Assign(OptionsForm.FontPanel.Font);
  2879. end;
  2880. SyncEditorOptions;
  2881. UpdateNewMainFileButtons;
  2882. UpdateTheme;
  2883. { Save new options }
  2884. Ini := TConfigIniFile.Create;
  2885. try
  2886. Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
  2887. Ini.WriteBool('Options', 'UseWizard', FOptions.UseWizard);
  2888. Ini.WriteBool('Options', 'Autosave', FOptions.Autosave);
  2889. Ini.WriteBool('Options', 'MakeBackups', FOptions.MakeBackups);
  2890. Ini.WriteBool('Options', 'FullPathInTitleBar', FOptions.FullPathInTitleBar);
  2891. Ini.WriteBool('Options', 'UndoAfterSave', FOptions.UndoAfterSave);
  2892. Ini.WriteBool('Options', 'PauseOnDebuggerExceptions', FOptions.PauseOnDebuggerExceptions);
  2893. Ini.WriteBool('Options', 'RunAsDifferentUser', FOptions.RunAsDifferentUser);
  2894. Ini.WriteBool('Options', 'AutoComplete', FOptions.AutoComplete);
  2895. Ini.WriteBool('Options', 'UseSynHigh', FOptions.UseSyntaxHighlighting);
  2896. Ini.WriteBool('Options', 'ColorizeCompilerOutput', FOptions.ColorizeCompilerOutput);
  2897. Ini.WriteBool('Options', 'UnderlineErrors', FOptions.UnderlineErrors);
  2898. Ini.WriteBool('Options', 'EditorCursorPastEOL', FOptions.CursorPastEOL);
  2899. Ini.WriteInteger('Options', 'TabWidth', FOptions.TabWidth);
  2900. Ini.WriteBool('Options', 'UseTabCharacter', FOptions.UseTabCharacter);
  2901. Ini.WriteBool('Options', 'WordWrap', FOptions.WordWrap);
  2902. Ini.WriteBool('Options', 'AutoIndent', FOptions.AutoIndent);
  2903. Ini.WriteBool('Options', 'IndentationGuides', FOptions.IndentationGuides);
  2904. Ini.WriteBool('Options', 'GutterLineNumbers', FOptions.GutterLineNumbers);
  2905. Ini.WriteBool('Options', 'ShowPreprocessorOutput', FOptions.ShowPreprocessorOutput);
  2906. Ini.WriteBool('Options', 'OpenIncludedFiles', FOptions.OpenIncludedFiles);
  2907. Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see Destroy }
  2908. Ini.WriteString('Options', 'EditorFontName', FMainMemo.Font.Name);
  2909. Ini.WriteInteger('Options', 'EditorFontSize', FMainMemo.Font.Size);
  2910. Ini.WriteInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset);
  2911. finally
  2912. Ini.Free;
  2913. end;
  2914. finally
  2915. OptionsForm.Free;
  2916. end;
  2917. end;
  2918. { Also see TabIndexToMemoIndex }
  2919. function TCompileForm.MemoToTabIndex(const AMemo: TCompScintEdit): Integer;
  2920. begin
  2921. if AMemo = FMainMemo then
  2922. Result := 0 { First tab displays the main memo }
  2923. else if AMemo = FPreprocessorOutputMemo then begin
  2924. if not FPreprocessorOutputMemo.Used then
  2925. raise Exception.Create('not FPreprocessorOutputMemo.Used');
  2926. Result := MemosTabSet.Tabs.Count-1 { Last tab displays the preprocessor output memo }
  2927. end else begin
  2928. Result := FFileMemos.IndexOf(AMemo as TCompScintFileEdit); { Other tabs display include files which start second tab }
  2929. { Filter memos explicitly hidden by the user }
  2930. for var MemoIndex := Result-1 downto 0 do
  2931. if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) <> -1 then
  2932. Dec(Result);
  2933. end;
  2934. end;
  2935. procedure TCompileForm.MoveCaretAndActivateMemo(AMemo: TCompScintFileEdit; const LineNumber: Integer;
  2936. const AlwaysResetColumn: Boolean);
  2937. var
  2938. Pos: Integer;
  2939. begin
  2940. { Reopen tab if needed }
  2941. var HiddenFileIndex := FHiddenFiles.IndexOf(AMemo.Filename);
  2942. if HiddenFileIndex <> -1 then begin
  2943. var SaveFileName := AMemo.Filename;
  2944. ReopenTabOrTabs(HiddenFileIndex, False);
  2945. { The above call to ReopenTabOrTabs will currently lead to a call to UpdateIncludedFilesMemos which
  2946. sets up all the memos. Currently it will keep same memo for the reopened file but in case it no
  2947. longer does at some point: look it up again }
  2948. AMemo := nil;
  2949. for var Memo in FFileMemos do begin
  2950. if Memo.Used and (PathCompare(Memo.Filename, SaveFilename) = 0) then begin
  2951. AMemo := Memo;
  2952. Break;
  2953. end;
  2954. end;
  2955. if AMemo = nil then
  2956. raise Exception.Create('AMemo MIA');
  2957. end;
  2958. { Move caret }
  2959. if AlwaysResetColumn or (AMemo.CaretLine <> LineNumber) then
  2960. Pos := AMemo.GetPositionFromLine(LineNumber)
  2961. else
  2962. Pos := AMemo.CaretPosition;
  2963. { If the line isn't in view, scroll so that it's in the center }
  2964. if not AMemo.IsPositionInViewVertically(Pos) then
  2965. AMemo.TopLine := AMemo.GetVisibleLineFromDocLine(LineNumber) -
  2966. (AMemo.LinesInWindow div 2);
  2967. AMemo.CaretPosition := Pos;
  2968. { Activate memo }
  2969. MemosTabSet.TabIndex := MemoToTabIndex(AMemo); { This causes MemosTabSetClick to show the memo }
  2970. end;
  2971. procedure TCompileForm.SetErrorLine(const AMemo: TCompScintFileEdit; const ALine: Integer);
  2972. var
  2973. OldLine: Integer;
  2974. begin
  2975. if AMemo <> FErrorMemo then begin
  2976. SetErrorLine(FErrorMemo, -1);
  2977. FErrorMemo := AMemo;
  2978. end;
  2979. if FErrorMemo.ErrorLine <> ALine then begin
  2980. OldLine := FErrorMemo.ErrorLine;
  2981. FErrorMemo.ErrorLine := ALine;
  2982. if OldLine >= 0 then
  2983. UpdateLineMarkers(FErrorMemo, OldLine);
  2984. if FErrorMemo.ErrorLine >= 0 then begin
  2985. FErrorMemo.ErrorCaretPosition := FErrorMemo.CaretPosition;
  2986. UpdateLineMarkers(FErrorMemo, FErrorMemo.ErrorLine);
  2987. end;
  2988. end;
  2989. end;
  2990. procedure TCompileForm.SetStepLine(const AMemo: TCompScintFileEdit; ALine: Integer);
  2991. var
  2992. OldLine: Integer;
  2993. begin
  2994. if AMemo <> FStepMemo then begin
  2995. SetStepLine(FStepMemo, -1);
  2996. FStepMemo := AMemo;
  2997. end;
  2998. if FStepMemo.StepLine <> ALine then begin
  2999. OldLine := FStepMemo.StepLine;
  3000. FStepMemo.StepLine := ALine;
  3001. if OldLine >= 0 then
  3002. UpdateLineMarkers(FStepMemo, OldLine);
  3003. if FStepMemo.StepLine >= 0 then
  3004. UpdateLineMarkers(FStepMemo, FStepMemo.StepLine);
  3005. end;
  3006. end;
  3007. procedure TCompileForm.HideError;
  3008. begin
  3009. SetErrorLine(FErrorMemo, -1);
  3010. if not FCompiling then
  3011. StatusBar.Panels[spExtraStatus].Text := '';
  3012. end;
  3013. procedure TCompileForm.UpdateCaretPosPanel;
  3014. begin
  3015. StatusBar.Panels[spCaretPos].Text := Format('%4d:%4d', [FActiveMemo.CaretLine + 1,
  3016. FActiveMemo.CaretColumnExpanded + 1]);
  3017. end;
  3018. procedure TCompileForm.UpdateEditModePanel;
  3019. const
  3020. InsertText: array[Boolean] of String = ('Overwrite', 'Insert');
  3021. begin
  3022. if FActiveMemo.ReadOnly then
  3023. StatusBar.Panels[spEditMode].Text := 'Read only'
  3024. else
  3025. StatusBar.Panels[spEditMode].Text := InsertText[FActiveMemo.InsertMode];
  3026. end;
  3027. procedure TCompileForm.UpdateHiddenFilesPanel;
  3028. begin
  3029. if MemosTabSet.Visible and (FHiddenFiles.Count > 0) then begin
  3030. StatusBar.Panels[spHiddenFilesCount].Text := Format('Tabs closed: %d', [FHiddenFiles.Count]);
  3031. end else
  3032. StatusBar.Panels[spHiddenFilesCount].Text := '';
  3033. end;
  3034. procedure TCompileForm.UpdateMemosTabSetVisibility;
  3035. begin
  3036. MemosTabSet.Visible := FPreprocessorOutputMemo.Used or FFileMemos[FirstIncludedFilesMemoIndex].Used;
  3037. if not MemosTabSet.Visible then
  3038. MemosTabSet.TabIndex := 0; { For next time }
  3039. end;
  3040. procedure TCompileForm.UpdateModifiedPanel;
  3041. begin
  3042. if FActiveMemo.Modified then
  3043. StatusBar.Panels[spModified].Text := 'Modified'
  3044. else
  3045. StatusBar.Panels[spModified].Text := '';
  3046. end;
  3047. procedure TCompileForm.UpdatePreprocMemos;
  3048. procedure UpdatePreprocessorOutputMemo(const NewTabs, NewHints: TStringList;
  3049. const NewCloseButtons: TBoolList);
  3050. begin
  3051. if FOptions.ShowPreprocessorOutput and (FPreprocessorOutput <> '') and
  3052. not SameStr(TrimRight(FMainMemo.Lines.Text), FPreprocessorOutput) then begin
  3053. NewTabs.Add('Preprocessor Output');
  3054. NewHints.Add('');
  3055. NewCloseButtons.Add(False);
  3056. FPreprocessorOutputMemo.ReadOnly := False;
  3057. try
  3058. FPreprocessorOutputMemo.Lines.Text := FPreprocessorOutput;
  3059. FPreprocessorOutputMemo.ClearUndo;
  3060. finally
  3061. FPreprocessorOutputMemo.ReadOnly := True;
  3062. end;
  3063. FPreprocessorOutputMemo.Used := True;
  3064. end else begin
  3065. FPreprocessorOutputMemo.Used := False;
  3066. FPreprocessorOutputMemo.Visible := False;
  3067. end;
  3068. end;
  3069. procedure UpdateIncludedFilesMemos(const NewTabs, NewHints: TStringList;
  3070. const NewCloseButtons: TBoolList);
  3071. var
  3072. IncludedFile: TIncludedFile;
  3073. I: Integer;
  3074. begin
  3075. if FOptions.OpenIncludedFiles and (FIncludedFiles.Count > 0) then begin
  3076. var NextMemoIndex := FirstIncludedFilesMemoIndex;
  3077. var NextTabIndex := 1; { First tab displays the main memo }
  3078. FLoadingIncludedFiles := True;
  3079. try
  3080. for IncludedFile in FIncludedFiles do begin
  3081. IncludedFile.Memo := FFileMemos[NextMemoIndex];
  3082. try
  3083. if not IncludedFile.Memo.Used or
  3084. ((PathCompare(IncludedFile.Memo.Filename, IncludedFile.Filename) <> 0) or
  3085. not IncludedFile.HasLastWriteTime or
  3086. (CompareFileTime(IncludedFile.Memo.FileLastWriteTime, IncludedFile.LastWriteTime) <> 0)) then begin
  3087. IncludedFile.Memo.Filename := IncludedFile.Filename;
  3088. IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex;
  3089. IncludedFile.Memo.BreakPoints.Clear;
  3090. OpenFile(IncludedFile.Memo, IncludedFile.Filename, False); { Also updates FileLastWriteTime }
  3091. IncludedFile.Memo.Used := True;
  3092. end else if IncludedFile.Memo.CompilerFileIndex = UnknownCompilerFileIndex then begin
  3093. { The file already has a memo but CompilerFileIndex is not set yet.
  3094. This happens if the initial load was from the history loaded by LoadKnownIncludedFiles and then the user does a compile. }
  3095. IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex;
  3096. end;
  3097. if FHiddenFiles.IndexOf(IncludedFile.Filename) = -1 then begin
  3098. NewTabs.Insert(NextTabIndex, PathExtractName(IncludedFile.Filename));
  3099. NewHints.Insert(NextTabIndex, GetFileTitle(IncludedFile.Filename));
  3100. NewCloseButtons.Insert(NextTabIndex, True);
  3101. Inc(NextTabIndex);
  3102. end;
  3103. Inc(NextMemoIndex);
  3104. if NextMemoIndex = FFileMemos.Count then
  3105. Break; { We're out of memos :( }
  3106. except on E: Exception do
  3107. begin
  3108. StatusMessage(smkWarning, 'Failed to open included file: ' + E.Message);
  3109. IncludedFile.Memo := nil;
  3110. end;
  3111. end;
  3112. end;
  3113. finally
  3114. FLoadingIncludedFiles := False;
  3115. end;
  3116. { Hide any remaining memos }
  3117. for I := NextMemoIndex to FFileMemos.Count-1 do begin
  3118. FFileMemos[I].BreakPoints.Clear;
  3119. FFileMemos[I].Used := False;
  3120. FFileMemos[I].Visible := False;
  3121. end;
  3122. end else begin
  3123. for I := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin
  3124. FFileMemos[I].BreakPoints.Clear;
  3125. FFileMemos[I].Used := False;
  3126. FFileMemos[I].Visible := False;
  3127. end;
  3128. for IncludedFile in FIncludedFiles do
  3129. IncludedFile.Memo := nil;
  3130. end;
  3131. end;
  3132. var
  3133. NewTabs, NewHints: TStringList;
  3134. NewCloseButtons: TBoolList;
  3135. I, SaveTabIndex: Integer;
  3136. SaveTabName: String;
  3137. begin
  3138. NewTabs := nil;
  3139. NewHints := nil;
  3140. NewCloseButtons := nil;
  3141. try
  3142. NewTabs := TStringList.Create;
  3143. NewTabs.Add(MemosTabSet.Tabs[0]); { 'Main Script' }
  3144. NewHints := TStringList.Create;
  3145. NewHints.Add(GetFileTitle(FMainMemo.Filename));
  3146. NewCloseButtons := TBoolList.Create;
  3147. NewCloseButtons.Add(False);
  3148. UpdatePreprocessorOutputMemo(NewTabs, NewHints, NewCloseButtons);
  3149. UpdateIncludedFilesMemos(NewTabs, NewHints, NewCloseButtons);
  3150. { Set new tabs, try keep same file open }
  3151. SaveTabIndex := MemosTabSet.TabIndex;
  3152. SaveTabName := MemosTabSet.Tabs[MemosTabSet.TabIndex];
  3153. MemosTabSet.Tabs := NewTabs;
  3154. MemosTabSet.Hints := NewHints;
  3155. MemosTabSet.CloseButtons := NewCloseButtons;
  3156. I := MemosTabSet.Tabs.IndexOf(SaveTabName);
  3157. if I <> -1 then
  3158. MemosTabSet.TabIndex := I;
  3159. if MemosTabSet.TabIndex = SaveTabIndex then begin
  3160. { If TabIndex stayed the same then the tabset won't perform a Click but we need this to make
  3161. sure the right memo is visible - so trigger it ourselves }
  3162. MemosTabSetClick(MemosTabSet);
  3163. end;
  3164. finally
  3165. NewCloseButtons.Free;
  3166. NewHints.Free;
  3167. NewTabs.Free;
  3168. end;
  3169. UpdateMemosTabSetVisibility;
  3170. UpdateBevel1Visibility;
  3171. end;
  3172. procedure TCompileForm.MemoUpdateUI(Sender: TObject);
  3173. procedure UpdatePendingSquiggly;
  3174. var
  3175. Pos: Integer;
  3176. Value: Boolean;
  3177. begin
  3178. { Check for the inPendingSquiggly indicator on either side of the caret }
  3179. Pos := FActiveMemo.CaretPosition;
  3180. Value := False;
  3181. if FActiveMemo.CaretVirtualSpace = 0 then begin
  3182. Value := (inPendingSquiggly in FActiveMemo.GetIndicatorsAtPosition(Pos));
  3183. if not Value and (Pos > 0) then
  3184. Value := (inPendingSquiggly in FActiveMemo.GetIndicatorsAtPosition(Pos-1));
  3185. end;
  3186. if FOnPendingSquiggly <> Value then begin
  3187. FOnPendingSquiggly := Value;
  3188. { If caret has left a pending squiggly, force restyle of the line }
  3189. if not Value then begin
  3190. { Stop reporting the caret position to the styler (until the next
  3191. Change event) so the token doesn't re-enter pending-squiggly state
  3192. if the caret comes back and something restyles the line }
  3193. FActiveMemo.ReportCaretPositionToStyler := False;
  3194. FActiveMemo.RestyleLine(FActiveMemo.GetLineFromPosition(FPendingSquigglyCaretPos));
  3195. end;
  3196. end;
  3197. FPendingSquigglyCaretPos := Pos;
  3198. end;
  3199. procedure UpdateBraceHighlighting;
  3200. var
  3201. Section: TInnoSetupStylerSection;
  3202. Pos, MatchPos: Integer;
  3203. C: AnsiChar;
  3204. begin
  3205. Section := FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]);
  3206. if (Section <> scNone) and (FActiveMemo.CaretVirtualSpace = 0) then begin
  3207. Pos := FActiveMemo.CaretPosition;
  3208. C := FActiveMemo.GetCharAtPosition(Pos);
  3209. if C in ['(', '[', '{'] then begin
  3210. MatchPos := FActiveMemo.GetPositionOfMatchingBrace(Pos);
  3211. if MatchPos >= 0 then begin
  3212. FActiveMemo.SetBraceHighlighting(Pos, MatchPos);
  3213. Exit;
  3214. end;
  3215. end;
  3216. if Pos > 0 then begin
  3217. Pos := FActiveMemo.GetPositionBefore(Pos);
  3218. C := FActiveMemo.GetCharAtPosition(Pos);
  3219. if C in [')', ']', '}'] then begin
  3220. MatchPos := FActiveMemo.GetPositionOfMatchingBrace(Pos);
  3221. if MatchPos >= 0 then begin
  3222. FActiveMemo.SetBraceHighlighting(Pos, MatchPos);
  3223. Exit;
  3224. end;
  3225. end;
  3226. end;
  3227. end;
  3228. FActiveMemo.SetBraceHighlighting(-1, -1);
  3229. end;
  3230. begin
  3231. if (Sender = FErrorMemo) and ((FErrorMemo.ErrorLine < 0) or (FErrorMemo.CaretPosition <> FErrorMemo.ErrorCaretPosition)) then
  3232. HideError;
  3233. UpdateCaretPosPanel;
  3234. UpdatePendingSquiggly;
  3235. UpdateBraceHighlighting;
  3236. if Sender = FActiveMemo then
  3237. UpdateEditModePanel;
  3238. end;
  3239. procedure TCompileForm.MemoModifiedChange(Sender: TObject);
  3240. begin
  3241. if Sender = FActiveMemo then
  3242. UpdateModifiedPanel;
  3243. end;
  3244. procedure TCompileForm.MemoChange(Sender: TObject; const Info: TScintEditChangeInfo);
  3245. procedure MemoLinesInsertedOrDeleted(Memo: TCompScintFileEdit);
  3246. var
  3247. FirstAffectedLine, Line, LinePos: Integer;
  3248. begin
  3249. Line := Memo.GetLineFromPosition(Info.StartPos);
  3250. LinePos := Memo.GetPositionFromLine(Line);
  3251. FirstAffectedLine := Line;
  3252. { If the deletion/insertion does not start on the first character of Line,
  3253. then we consider the first deleted/inserted line to be the following
  3254. line (Line+1). This way, if you press Del at the end of line 1, the dot
  3255. on line 2 is removed, while line 1's dot stays intact. }
  3256. if Info.StartPos > LinePos then
  3257. Inc(Line);
  3258. if Info.LinesDelta > 0 then
  3259. MemoLinesInserted(Memo, Line, Info.LinesDelta)
  3260. else
  3261. MemoLinesDeleted(Memo, Line, -Info.LinesDelta, FirstAffectedLine);
  3262. end;
  3263. var
  3264. Memo: TCompScintFileEdit;
  3265. begin
  3266. if not (Sender is TCompScintFileEdit) or ((Sender <> FMainMemo) and FLoadingIncludedFiles) then
  3267. Exit;
  3268. Memo := TCompScintFileEdit(Sender);
  3269. FModifiedAnySinceLastCompile := True;
  3270. if FDebugging then
  3271. FModifiedAnySinceLastCompileAndGo := True
  3272. else begin
  3273. { Modified while not debugging or loading included files; free the debug info and clear the dots }
  3274. DestroyDebugInfo;
  3275. end;
  3276. if Info.LinesDelta <> 0 then
  3277. MemoLinesInsertedOrDeleted(Memo);
  3278. if Memo = FErrorMemo then begin
  3279. { When the Delete key is pressed, the caret doesn't move, so reset
  3280. FErrorCaretPosition to ensure that OnUpdateUI calls HideError }
  3281. FErrorMemo.ErrorCaretPosition := -1;
  3282. end;
  3283. { The change should trigger restyling. Allow the styler to see the current
  3284. caret position in case it wants to set a pending squiggly indicator. }
  3285. Memo.ReportCaretPositionToStyler := True;
  3286. end;
  3287. procedure TCompileForm.InitiateAutoComplete(const Key: AnsiChar);
  3288. function CheckWhiteSpace(const Memo: TCompScintEdit; const LinePos, WordStartPos: Integer): Boolean;
  3289. var
  3290. I: Integer;
  3291. C: AnsiChar;
  3292. begin
  3293. { Only allow autocompletion if no non-whitespace characters exist before the current word on the line }
  3294. I := WordStartPos;
  3295. Result := False;
  3296. while I > LinePos do begin
  3297. I := FActiveMemo.GetPositionBefore(I);
  3298. if I < LinePos then
  3299. Exit; { shouldn't get here }
  3300. C := FActiveMemo.GetCharAtPosition(I);
  3301. if C > ' ' then
  3302. Exit;
  3303. end;
  3304. Result := True;
  3305. end;
  3306. var
  3307. CaretPos, Line, LinePos, WordStartPos, WordEndPos, CharsBefore,
  3308. PrevWordStartPos, PrevWordEndPos, I, LangNamePos: Integer;
  3309. Section: TInnoSetupStylerSection;
  3310. IsParamSection: Boolean;
  3311. WordList: AnsiString;
  3312. FoundSemicolon, FoundFlagsOrType, FoundDot: Boolean;
  3313. C: AnsiChar;
  3314. S: String;
  3315. begin
  3316. if FActiveMemo.AutoCompleteActive or FActiveMemo.ReadOnly then
  3317. Exit;
  3318. FActiveMemo.CaretPosition := FActiveMemo.CaretPosition; { clear any selection }
  3319. CaretPos := FActiveMemo.CaretPosition;
  3320. Line := FActiveMemo.GetLineFromPosition(CaretPos);
  3321. LinePos := FActiveMemo.GetPositionFromLine(Line);
  3322. WordStartPos := FActiveMemo.GetWordStartPosition(CaretPos, True);
  3323. WordEndPos := FActiveMemo.GetWordEndPosition(CaretPos, True);
  3324. CharsBefore := CaretPos - WordStartPos;
  3325. { Don't start autocompletion after a character is typed if there are any
  3326. word characters adjacent to the character }
  3327. if Key <> #0 then begin
  3328. if CharsBefore > 1 then
  3329. Exit;
  3330. if WordEndPos > CaretPos then
  3331. Exit;
  3332. end;
  3333. case FActiveMemo.GetCharAtPosition(WordStartPos) of
  3334. '#':
  3335. begin
  3336. if not CheckWhiteSpace(FActiveMemo, LinePos, WordStartPos) then
  3337. Exit;
  3338. WordList := FMemosStyler.ISPPDirectivesWordList;
  3339. FActiveMemo.SetAutoCompleteFillupChars(' ');
  3340. end;
  3341. '{':
  3342. begin
  3343. WordList := FMemosStyler.ConstantsWordList;
  3344. FActiveMemo.SetAutoCompleteFillupChars('\:');
  3345. end;
  3346. '[':
  3347. begin
  3348. if not CheckWhiteSpace(FActiveMemo, LinePos, WordStartPos) then
  3349. Exit;
  3350. WordList := FMemosStyler.SectionsWordList;
  3351. FActiveMemo.SetAutoCompleteFillupChars('');
  3352. end;
  3353. else
  3354. begin
  3355. Section := FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[Line]);
  3356. if Section = scCode then begin
  3357. { Only allow autocompletion if the previous word on the line is 'function' or 'procedure',
  3358. exactly 1 space exists between it and the current word and no non-whitespace characters
  3359. exist before it on the line }
  3360. I := FActiveMemo.GetPositionBefore(WordStartPos);
  3361. if I < LinePos then
  3362. Exit;
  3363. if FActiveMemo.GetCharAtPosition(I) > ' ' then
  3364. Exit;
  3365. PrevWordEndPos := I;
  3366. PrevWordStartPos := FActiveMemo.GetWordStartPosition(PrevWordEndPos, True);
  3367. S := FActiveMemo.GetTextRange(PrevWordStartPos, PrevWordEndPos);
  3368. if SameText(S, 'procedure') then
  3369. WordList := FMemosStyler.EventFunctionsWordList[True]
  3370. else if SameText(S, 'function') then
  3371. WordList := FMemosStyler.EventFunctionsWordList[False]
  3372. else
  3373. Exit;
  3374. if not CheckWhiteSpace(FActiveMemo, LinePos, PrevWordStartPos) then
  3375. Exit;
  3376. FActiveMemo.SetAutoCompleteFillupChars('');
  3377. end else begin
  3378. IsParamSection := FMemosStyler.IsParamSection(Section);
  3379. { Only allow autocompletion if no non-whitespace characters exist before
  3380. the current word on the line, or after the last ';' or 'Flags:' or 'Type:' in parameterized
  3381. sections }
  3382. FoundSemicolon := False;
  3383. FoundFlagsOrType := False;
  3384. FoundDot := False;
  3385. I := WordStartPos;
  3386. while I > LinePos do begin
  3387. I := FActiveMemo.GetPositionBefore(I);
  3388. if I < LinePos then
  3389. Exit; { shouldn't get here }
  3390. C := FActiveMemo.GetCharAtPosition(I);
  3391. if IsParamSection and (C in [';', ':']) and
  3392. FMemosStyler.IsSymbolStyle(FActiveMemo.GetStyleAtPosition(I)) then begin { Make sure it's an stSymbol ';' or ':' and not one inside a quoted string }
  3393. FoundSemicolon := C = ';';
  3394. if not FoundSemicolon then begin
  3395. PrevWordEndPos := I;
  3396. PrevWordStartPos := FActiveMemo.GetWordStartPosition(PrevWordEndPos, True);
  3397. S := FActiveMemo.GetTextRange(PrevWordStartPos, PrevWordEndPos);
  3398. FoundFlagsOrType := SameText(S, 'Flags') or
  3399. ((Section in [scInstallDelete, scUninstallDelete]) and SameText(S, 'Type'));
  3400. end else
  3401. FoundFlagsOrType := False;
  3402. Break;
  3403. end;
  3404. if (Section = scLangOptions) and (C = '.') and not FoundDot then begin
  3405. { Verify that a word (language name) precedes the '.', then check for
  3406. any non-whitespace characters before the word }
  3407. LangNamePos := FActiveMemo.GetWordStartPosition(I, True);
  3408. if LangNamePos >= I then
  3409. Exit;
  3410. I := LangNamePos;
  3411. FoundDot := True;
  3412. end
  3413. else begin
  3414. if C > ' ' then
  3415. Exit;
  3416. end;
  3417. end;
  3418. { Space can only initiate autocompletion after ';' or 'Flags:' or 'Type:' in parameterized sections }
  3419. if (Key = ' ') and not (FoundSemicolon or FoundFlagsOrType) then
  3420. Exit;
  3421. if FoundFlagsOrType then begin
  3422. WordList := FMemosStyler.FlagsWordList[Section];
  3423. if WordList = '' then
  3424. Exit;
  3425. if Key <> ' ' then { Space initiating autocompletion also initiates a direct fillup if its a fillup char :( }
  3426. FActiveMemo.SetAutoCompleteFillupChars(' ')
  3427. else
  3428. FActiveMemo.SetAutoCompleteFillupChars('')
  3429. end else begin
  3430. WordList := FMemosStyler.KeywordsWordList[Section];
  3431. if WordList = '' then { Messages & CustomMessages }
  3432. Exit;
  3433. if IsParamSection then
  3434. FActiveMemo.SetAutoCompleteFillupChars(':')
  3435. else
  3436. FActiveMemo.SetAutoCompleteFillupChars('=');
  3437. end;
  3438. end;
  3439. end;
  3440. end;
  3441. FActiveMemo.ShowAutoComplete(CharsBefore, WordList);
  3442. end;
  3443. procedure TCompileForm.MemoCharAdded(Sender: TObject; Ch: AnsiChar);
  3444. function LineIsBlank(const Line: Integer): Boolean;
  3445. var
  3446. S: TScintRawString;
  3447. I: Integer;
  3448. begin
  3449. S := FActiveMemo.Lines.RawLines[Line];
  3450. for I := 1 to Length(S) do
  3451. if not(S[I] in [#9, ' ']) then begin
  3452. Result := False;
  3453. Exit;
  3454. end;
  3455. Result := True;
  3456. end;
  3457. var
  3458. NewLine, PreviousLine, NewIndent, PreviousIndent: Integer;
  3459. RestartAutoComplete: Boolean;
  3460. begin
  3461. if FOptions.AutoIndent and (Ch = FActiveMemo.LineEndingString[Length(FActiveMemo.LineEndingString)]) then begin
  3462. { Add to the new line any (remaining) indentation from the previous line }
  3463. NewLine := FActiveMemo.CaretLine;
  3464. PreviousLine := NewLine-1;
  3465. if PreviousLine >= 0 then begin
  3466. NewIndent := FActiveMemo.GetLineIndentation(NewLine);
  3467. { If no indentation was moved from the previous line to the new line
  3468. (i.e., there are no spaces/tabs directly to the right of the new
  3469. caret position), and the previous line is completely empty (0 length),
  3470. then use the indentation from the last line containing non-space
  3471. characters. }
  3472. if (NewIndent = 0) and (FActiveMemo.Lines.RawLineLengths[PreviousLine] = 0) then begin
  3473. Dec(PreviousLine);
  3474. while (PreviousLine >= 0) and LineIsBlank(PreviousLine) do
  3475. Dec(PreviousLine);
  3476. end;
  3477. if PreviousLine >= 0 then begin
  3478. PreviousIndent := FActiveMemo.GetLineIndentation(PreviousLine);
  3479. { If virtual space is enabled, and tabs are not being used for
  3480. indentation (typing in virtual space doesn't create tabs), then we
  3481. don't actually have to set any indentation if the new line is
  3482. empty; we can just move the caret out into virtual space. }
  3483. if (svsUserAccessible in FActiveMemo.VirtualSpaceOptions) and
  3484. not FActiveMemo.UseTabCharacter and
  3485. (FActiveMemo.Lines.RawLineLengths[NewLine] = 0) then begin
  3486. FActiveMemo.CaretVirtualSpace := PreviousIndent;
  3487. end
  3488. else begin
  3489. FActiveMemo.SetLineIndentation(NewLine, NewIndent + PreviousIndent);
  3490. FActiveMemo.CaretPosition := FActiveMemo.GetPositionFromLineExpandedColumn(NewLine,
  3491. PreviousIndent);
  3492. end;
  3493. end;
  3494. end;
  3495. end;
  3496. case Ch of
  3497. 'A'..'Z', 'a'..'z', '_', '#', '{', '[':
  3498. if FOptions.AutoComplete then
  3499. InitiateAutoComplete(Ch);
  3500. else
  3501. RestartAutoComplete := (Ch in [' ', '.']) and
  3502. (FOptions.AutoComplete or FActiveMemo.AutoCompleteActive);
  3503. FActiveMemo.CancelAutoComplete;
  3504. if RestartAutoComplete then
  3505. InitiateAutoComplete(Ch);
  3506. end;
  3507. end;
  3508. procedure TCompileForm.MemoHintShow(Sender: TObject; var Info: TScintHintInfo);
  3509. function GetCodeVariableDebugEntryFromFileLineCol(FileIndex, Line, Col: Integer): PVariableDebugEntry;
  3510. var
  3511. I: Integer;
  3512. begin
  3513. { FVariableDebugEntries uses 1-based line and column numbers }
  3514. Inc(Line);
  3515. Inc(Col);
  3516. Result := nil;
  3517. for I := 0 to FVariableDebugEntriesCount-1 do begin
  3518. if (FVariableDebugEntries[I].FileIndex = FileIndex) and
  3519. (FVariableDebugEntries[I].LineNumber = Line) and
  3520. (FVariableDebugEntries[I].Col = Col) then begin
  3521. Result := @FVariableDebugEntries[I];
  3522. Break;
  3523. end;
  3524. end;
  3525. end;
  3526. function GetCodeColumnFromPosition(const Pos: Integer): Integer;
  3527. var
  3528. LinePos: Integer;
  3529. S: TScintRawString;
  3530. U: String;
  3531. begin
  3532. { [Code] lines get converted from the editor's UTF-8 to UTF-16 Strings when
  3533. passed to the compiler. This can lead to column number discrepancies
  3534. between Scintilla and ROPS. This code simulates the conversion to try to
  3535. find out where ROPS thinks a Pos resides. }
  3536. LinePos := FActiveMemo.GetPositionFromLine(FActiveMemo.GetLineFromPosition(Pos));
  3537. S := FActiveMemo.GetRawTextRange(LinePos, Pos);
  3538. U := FActiveMemo.ConvertRawStringToString(S);
  3539. Result := Length(U);
  3540. end;
  3541. function FindConstRange(const Pos: Integer): TScintRange;
  3542. var
  3543. BraceLevel, ConstStartPos, Line, LineEndPos, I: Integer;
  3544. C: AnsiChar;
  3545. begin
  3546. Result.StartPos := 0;
  3547. Result.EndPos := 0;
  3548. BraceLevel := 0;
  3549. ConstStartPos := -1;
  3550. Line := FActiveMemo.GetLineFromPosition(Pos);
  3551. LineEndPos := FActiveMemo.GetLineEndPosition(Line);
  3552. I := FActiveMemo.GetPositionFromLine(Line);
  3553. while I < LineEndPos do begin
  3554. if (I > Pos) and (BraceLevel = 0) then
  3555. Break;
  3556. C := FActiveMemo.GetCharAtPosition(I);
  3557. if C = '{' then begin
  3558. if FActiveMemo.GetCharAtPosition(I + 1) = '{' then
  3559. Inc(I)
  3560. else begin
  3561. if BraceLevel = 0 then
  3562. ConstStartPos := I;
  3563. Inc(BraceLevel);
  3564. end;
  3565. end
  3566. else if (C = '}') and (BraceLevel > 0) then begin
  3567. Dec(BraceLevel);
  3568. if (BraceLevel = 0) and (ConstStartPos <> -1) then begin
  3569. if (Pos >= ConstStartPos) and (Pos <= I) then begin
  3570. Result.StartPos := ConstStartPos;
  3571. Result.EndPos := I + 1;
  3572. Exit;
  3573. end;
  3574. ConstStartPos := -1;
  3575. end;
  3576. end;
  3577. I := FActiveMemo.GetPositionAfter(I);
  3578. end;
  3579. end;
  3580. var
  3581. Pos, Line, I, J: Integer;
  3582. Output: String;
  3583. DebugEntry: PVariableDebugEntry;
  3584. ConstRange: TScintRange;
  3585. begin
  3586. if FDebugClientWnd = 0 then
  3587. Exit;
  3588. Pos := FActiveMemo.GetPositionFromPoint(Info.CursorPos, True, True);
  3589. if Pos < 0 then
  3590. Exit;
  3591. Line := FActiveMemo.GetLineFromPosition(Pos);
  3592. { Check if cursor is over a [Code] variable }
  3593. if (FActiveMemo is TCompScintFileEdit) and
  3594. (FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[Line]) = scCode) then begin
  3595. { Note: The '+ 1' is needed so that when the mouse is over a '.'
  3596. between two words, it won't match the word to the left of the '.' }
  3597. FActiveMemo.SetDefaultWordChars;
  3598. I := FActiveMemo.GetWordStartPosition(Pos + 1, True);
  3599. J := FActiveMemo.GetWordEndPosition(Pos, True);
  3600. if J > I then begin
  3601. DebugEntry := GetCodeVariableDebugEntryFromFileLineCol((FActiveMemo as TCompScintFileEdit).CompilerFileIndex,
  3602. Line, GetCodeColumnFromPosition(I));
  3603. if DebugEntry <> nil then begin
  3604. case EvaluateVariableEntry(DebugEntry, Output) of
  3605. 1: Info.HintStr := Output;
  3606. 2: Info.HintStr := Output;
  3607. else
  3608. Info.HintStr := 'Unknown error';
  3609. end;
  3610. Info.CursorRect.TopLeft := FActiveMemo.GetPointFromPosition(I);
  3611. Info.CursorRect.BottomRight := FActiveMemo.GetPointFromPosition(J);
  3612. Info.CursorRect.Bottom := Info.CursorRect.Top + FActiveMemo.LineHeight;
  3613. Info.HideTimeout := High(Integer); { infinite }
  3614. Exit;
  3615. end;
  3616. end;
  3617. end;
  3618. { Check if cursor is over a constant }
  3619. ConstRange := FindConstRange(Pos);
  3620. if ConstRange.EndPos > ConstRange.StartPos then begin
  3621. Info.HintStr := FActiveMemo.GetTextRange(ConstRange.StartPos, ConstRange.EndPos);
  3622. case EvaluateConstant(Info.HintStr, Output) of
  3623. 1: Info.HintStr := Info.HintStr + ' = "' + Output + '"';
  3624. 2: Info.HintStr := Info.HintStr + ' = Exception: ' + Output;
  3625. else
  3626. Info.HintStr := Info.HintStr + ' = Unknown error';
  3627. end;
  3628. Info.CursorRect.TopLeft := FActiveMemo.GetPointFromPosition(ConstRange.StartPos);
  3629. Info.CursorRect.BottomRight := FActiveMemo.GetPointFromPosition(ConstRange.EndPos);
  3630. Info.CursorRect.Bottom := Info.CursorRect.Top + FActiveMemo.LineHeight;
  3631. Info.HideTimeout := High(Integer); { infinite }
  3632. end;
  3633. end;
  3634. procedure TCompileForm.MainMemoDropFiles(Sender: TObject; X, Y: Integer;
  3635. AFiles: TStrings);
  3636. begin
  3637. if (AFiles.Count > 0) and ConfirmCloseFile(True) then
  3638. OpenFile(FMainMemo, AFiles[0], True);
  3639. end;
  3640. procedure TCompileForm.StatusBarResize(Sender: TObject);
  3641. begin
  3642. { Without this, on Windows XP with themes, the status bar's size grip gets
  3643. corrupted as the form is resized }
  3644. if StatusBar.HandleAllocated then
  3645. InvalidateRect(StatusBar.Handle, nil, True);
  3646. end;
  3647. procedure TCompileForm.WMDebuggerQueryVersion(var Message: TMessage);
  3648. begin
  3649. Message.Result := FCompilerVersion.BinVersion;
  3650. end;
  3651. procedure TCompileForm.WMDebuggerHello(var Message: TMessage);
  3652. var
  3653. PID: DWORD;
  3654. WantCodeText: Boolean;
  3655. begin
  3656. FDebugClientWnd := HWND(Message.WParam);
  3657. { Save debug client process handle }
  3658. if FDebugClientProcessHandle <> 0 then begin
  3659. { Shouldn't get here, but just in case, don't leak a handle }
  3660. CloseHandle(FDebugClientProcessHandle);
  3661. FDebugClientProcessHandle := 0;
  3662. end;
  3663. PID := 0;
  3664. if GetWindowThreadProcessId(FDebugClientWnd, @PID) <> 0 then
  3665. FDebugClientProcessHandle := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE,
  3666. False, PID);
  3667. WantCodeText := Bool(Message.LParam);
  3668. if WantCodeText then
  3669. SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeTextA, FCompiledCodeText);
  3670. SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeDebugInfoA, FCompiledCodeDebugInfo);
  3671. UpdateRunMenu;
  3672. end;
  3673. procedure TCompileForm.WMDebuggerGoodbye(var Message: TMessage);
  3674. begin
  3675. ReplyMessage(0);
  3676. DebuggingStopped(True);
  3677. end;
  3678. procedure TCompileForm.GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TCompScintFileEdit; var DebugEntry: PDebugEntry);
  3679. function GetMemoFromDebugEntryFileIndex(const FileIndex: Integer): TCompScintFileEdit;
  3680. var
  3681. Memo: TCompScintFileEdit;
  3682. begin
  3683. Result := nil;
  3684. if FOptions.OpenIncludedFiles then begin
  3685. for Memo in FFileMemos do begin
  3686. if Memo.Used and (Memo.CompilerFileIndex = FileIndex) then begin
  3687. Result := Memo;
  3688. Exit;
  3689. end;
  3690. end;
  3691. end else if FMainMemo.CompilerFileIndex = FileIndex then
  3692. Result := FMainMemo;
  3693. end;
  3694. var
  3695. I: Integer;
  3696. begin
  3697. for I := 0 to FDebugEntriesCount-1 do begin
  3698. if (FDebugEntries[I].Kind = Kind) and (FDebugEntries[I].Index = Index) then begin
  3699. Memo := GetMemoFromDebugEntryFileIndex(FDebugEntries[I].FileIndex);
  3700. DebugEntry := @FDebugEntries[I];
  3701. Exit;
  3702. end;
  3703. end;
  3704. Memo := nil;
  3705. DebugEntry := nil;
  3706. end;
  3707. procedure TCompileForm.BringToForeground;
  3708. { Brings our top window to the foreground. Called when pausing while
  3709. debugging. }
  3710. var
  3711. TopWindow: HWND;
  3712. begin
  3713. TopWindow := GetThreadTopWindow;
  3714. if TopWindow <> 0 then begin
  3715. { First ask the debug client to call SetForegroundWindow() on our window.
  3716. If we don't do this then Windows (98/2000+) will prevent our window from
  3717. becoming activated if the debug client is currently in the foreground. }
  3718. SendMessage(FDebugClientWnd, WM_DebugClient_SetForegroundWindow,
  3719. WPARAM(TopWindow), 0);
  3720. { Now call SetForegroundWindow() ourself. Why? When a remote thread calls
  3721. SetForegroundWindow(), the request is queued; the window doesn't actually
  3722. become active until the next time the window's thread checks the message
  3723. queue. This call causes the window to become active immediately. }
  3724. SetForegroundWindow(TopWindow);
  3725. end;
  3726. end;
  3727. procedure TCompileForm.DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
  3728. var
  3729. Memo: TCompScintFileEdit;
  3730. DebugEntry: PDebugEntry;
  3731. LineNumber: Integer;
  3732. begin
  3733. GetMemoAndDebugEntryFromMessage(Message.WParam, Message.LParam, Memo, DebugEntry);
  3734. if (Memo = nil) or (DebugEntry = nil) then
  3735. Exit;
  3736. LineNumber := DebugEntry.LineNumber;
  3737. if LineNumber < 0 then { UninstExe has a DebugEntry but not a line number }
  3738. Exit;
  3739. if (LineNumber < Memo.LineStateCount) and
  3740. (Memo.LineState[LineNumber] <> lnEntryProcessed) then begin
  3741. Memo.LineState[LineNumber] := lnEntryProcessed;
  3742. UpdateLineMarkers(Memo, LineNumber);
  3743. end;
  3744. if (FStepMode = smStepOut) and DebugEntry.StepOutMarker then
  3745. FStepMode := smStepInto { Pause on next line }
  3746. else if (FStepMode = smStepInto) or
  3747. ((FStepMode = smStepOver) and not Intermediate) or
  3748. ((FStepMode = smRunToCursor) and
  3749. (FRunToCursorPoint.Kind = Integer(Message.WParam)) and
  3750. (FRunToCursorPoint.Index = Message.LParam)) or
  3751. (Memo.BreakPoints.IndexOf(LineNumber) <> -1) then begin
  3752. MoveCaretAndActivateMemo(Memo, LineNumber, True);
  3753. HideError;
  3754. SetStepLine(Memo, LineNumber);
  3755. BringToForeground;
  3756. { Tell Setup to pause }
  3757. Message.Result := 1;
  3758. FPaused := True;
  3759. FPausedAtCodeLine := DebugEntry.Kind = Ord(deCodeLine);
  3760. UpdateRunMenu;
  3761. UpdateCaption;
  3762. end;
  3763. end;
  3764. procedure TCompileForm.WMDebuggerStepped(var Message: TMessage);
  3765. begin
  3766. DebuggerStepped(Message, False);
  3767. end;
  3768. procedure TCompileForm.WMDebuggerSteppedIntermediate(var Message: TMessage);
  3769. begin
  3770. DebuggerStepped(Message, True);
  3771. end;
  3772. procedure TCompileForm.WMDebuggerException(var Message: TMessage);
  3773. var
  3774. Memo: TCompScintFileEdit;
  3775. DebugEntry: PDebugEntry;
  3776. LineNumber: Integer;
  3777. S: String;
  3778. begin
  3779. if FOptions.PauseOnDebuggerExceptions then begin
  3780. GetMemoAndDebugEntryFromMessage(Message.WParam, Message.LParam, Memo, DebugEntry);
  3781. if DebugEntry <> nil then
  3782. LineNumber := DebugEntry.LineNumber
  3783. else
  3784. LineNumber := -1;
  3785. if (Memo <> nil) and (LineNumber >= 0) then begin
  3786. MoveCaretAndActivateMemo(Memo, LineNumber, True);
  3787. SetStepLine(Memo, -1);
  3788. SetErrorLine(Memo, LineNumber);
  3789. end;
  3790. BringToForeground;
  3791. { Tell Setup to pause }
  3792. Message.Result := 1;
  3793. FPaused := True;
  3794. FPausedAtCodeLine := (DebugEntry <> nil) and (DebugEntry.Kind = Ord(deCodeLine));
  3795. UpdateRunMenu;
  3796. UpdateCaption;
  3797. ReplyMessage(Message.Result); { so that Setup enters a paused state now }
  3798. if LineNumber >= 0 then begin
  3799. S := Format('Line %d:' + SNewLine + '%s.', [LineNumber + 1, FDebuggerException]);
  3800. if (Memo <> nil) and (Memo.Filename <> '') then
  3801. S := Memo.Filename + SNewLine2 + S;
  3802. MsgBox(S, 'Runtime Error', mbCriticalError, mb_Ok)
  3803. end else
  3804. MsgBox(FDebuggerException + '.', 'Runtime Error', mbCriticalError, mb_Ok);
  3805. end;
  3806. end;
  3807. procedure TCompileForm.WMDebuggerSetForegroundWindow(var Message: TMessage);
  3808. begin
  3809. SetForegroundWindow(HWND(Message.WParam));
  3810. end;
  3811. procedure TCompileForm.WMDebuggerCallStackCount(var Message: TMessage);
  3812. begin
  3813. FCallStackCount := Message.WParam;
  3814. end;
  3815. procedure TCompileForm.WMCopyData(var Message: TWMCopyData);
  3816. var
  3817. S: String;
  3818. begin
  3819. case Message.CopyDataStruct.dwData of
  3820. CD_Debugger_ReplyW: begin
  3821. FReplyString := '';
  3822. SetString(FReplyString, PChar(Message.CopyDataStruct.lpData),
  3823. Message.CopyDataStruct.cbData div SizeOf(Char));
  3824. Message.Result := 1;
  3825. end;
  3826. CD_Debugger_ExceptionW: begin
  3827. SetString(FDebuggerException, PChar(Message.CopyDataStruct.lpData),
  3828. Message.CopyDataStruct.cbData div SizeOf(Char));
  3829. Message.Result := 1;
  3830. end;
  3831. CD_Debugger_UninstExeW: begin
  3832. SetString(FUninstExe, PChar(Message.CopyDataStruct.lpData),
  3833. Message.CopyDataStruct.cbData div sizeOf(Char));
  3834. Message.Result := 1;
  3835. end;
  3836. CD_Debugger_LogMessageW: begin
  3837. SetString(S, PChar(Message.CopyDataStruct.lpData),
  3838. Message.CopyDataStruct.cbData div SizeOf(Char));
  3839. DebugLogMessage(S);
  3840. Message.Result := 1;
  3841. end;
  3842. CD_Debugger_TempDirW: begin
  3843. { Paranoia: Store it in a local variable first. That way, if there's
  3844. a problem reading the string FTempDir will be left unmodified.
  3845. Gotta be extra careful when storing a path we'll be deleting. }
  3846. SetString(S, PChar(Message.CopyDataStruct.lpData),
  3847. Message.CopyDataStruct.cbData div SizeOf(Char));
  3848. { Extreme paranoia: If there are any embedded nulls, discard it. }
  3849. if Pos(#0, S) <> 0 then
  3850. S := '';
  3851. FTempDir := S;
  3852. Message.Result := 1;
  3853. end;
  3854. CD_Debugger_CallStackW: begin
  3855. SetString(S, PChar(Message.CopyDataStruct.lpData),
  3856. Message.CopyDataStruct.cbData div SizeOf(Char));
  3857. DebugShowCallStack(S, FCallStackCount);
  3858. end;
  3859. end;
  3860. end;
  3861. procedure TCompileForm.DestroyDebugInfo;
  3862. var
  3863. HadDebugInfo: Boolean;
  3864. Memo: TCompScintFileEdit;
  3865. begin
  3866. HadDebugInfo := False;
  3867. for Memo in FFileMemos do begin
  3868. if Assigned(Memo.LineState) then begin
  3869. Memo.LineStateCapacity := 0;
  3870. Memo.LineStateCount := 0;
  3871. FreeMem(Memo.LineState);
  3872. Memo.LineState := nil;
  3873. HadDebugInfo := True;
  3874. end;
  3875. end;
  3876. FDebugEntriesCount := 0;
  3877. FreeMem(FDebugEntries);
  3878. FDebugEntries := nil;
  3879. FVariableDebugEntriesCount := 0;
  3880. FreeMem(FVariableDebugEntries);
  3881. FVariableDebugEntries := nil;
  3882. FCompiledCodeText := '';
  3883. FCompiledCodeDebugInfo := '';
  3884. { Clear all dots and reset breakpoint icons (unless exiting; no point) }
  3885. if HadDebugInfo and not(csDestroying in ComponentState) then
  3886. UpdateAllMemosLineMarkers;
  3887. end;
  3888. var
  3889. PrevCompilerFileIndex: Integer;
  3890. PrevMemo: TCompScintFileEdit;
  3891. procedure TCompileForm.ParseDebugInfo(DebugInfo: Pointer);
  3892. function GetMemoFromCompilerFileIndex(const CompilerFileIndex: Integer): TCompScintFileEdit;
  3893. var
  3894. Memo: TCompScintFileEdit;
  3895. begin
  3896. if (PrevCompilerFileIndex <> CompilerFileIndex) then begin
  3897. PrevMemo := nil;
  3898. for Memo in FFileMemos do begin
  3899. if Memo.Used and (Memo.CompilerFileIndex = CompilerFileIndex) then begin
  3900. PrevMemo := Memo;
  3901. Break;
  3902. end;
  3903. end;
  3904. PrevCompilerFileIndex := CompilerFileIndex;
  3905. end;
  3906. Result := PrevMemo;
  3907. end;
  3908. { This creates and fills the DebugEntries and Memo LineState arrays }
  3909. var
  3910. Header: PDebugInfoHeader;
  3911. Memo: TCompScintFileEdit;
  3912. Size: Cardinal;
  3913. I: Integer;
  3914. begin
  3915. DestroyDebugInfo;
  3916. Header := DebugInfo;
  3917. if (Header.ID <> DebugInfoHeaderID) or
  3918. (Header.Version <> DebugInfoHeaderVersion) then
  3919. raise Exception.Create('Unrecognized debug info format');
  3920. try
  3921. for Memo in FFileMemos do begin
  3922. if Memo.Used then begin
  3923. I := Memo.Lines.Count;
  3924. Memo.LineState := AllocMem(SizeOf(TLineState) * (I + LineStateGrowAmount));
  3925. Memo.LineStateCapacity := I + LineStateGrowAmount;
  3926. Memo.LineStateCount := I;
  3927. end;
  3928. end;
  3929. Inc(Cardinal(DebugInfo), SizeOf(Header^));
  3930. FDebugEntriesCount := Header.DebugEntryCount;
  3931. Size := FDebugEntriesCount * SizeOf(TDebugEntry);
  3932. GetMem(FDebugEntries, Size);
  3933. Move(DebugInfo^, FDebugEntries^, Size);
  3934. for I := 0 to FDebugEntriesCount-1 do
  3935. Dec(FDebugEntries[I].LineNumber);
  3936. Inc(Cardinal(DebugInfo), Size);
  3937. FVariableDebugEntriesCount := Header.VariableDebugEntryCount;
  3938. Size := FVariableDebugEntriesCount * SizeOf(TVariableDebugEntry);
  3939. GetMem(FVariableDebugEntries, Size);
  3940. Move(DebugInfo^, FVariableDebugEntries^, Size);
  3941. Inc(Cardinal(DebugInfo), Size);
  3942. SetString(FCompiledCodeText, PAnsiChar(DebugInfo), Header.CompiledCodeTextLength);
  3943. Inc(Cardinal(DebugInfo), Header.CompiledCodeTextLength);
  3944. SetString(FCompiledCodeDebugInfo, PAnsiChar(DebugInfo), Header.CompiledCodeDebugInfoLength);
  3945. PrevCompilerFileIndex := UnknownCompilerFileIndex;
  3946. for I := 0 to FDebugEntriesCount-1 do begin
  3947. if FDebugEntries[I].LineNumber >= 0 then begin
  3948. Memo := GetMemoFromCompilerFileIndex(FDebugEntries[I].FileIndex);
  3949. if (Memo <> nil) and (FDebugEntries[I].LineNumber < Memo.LineStateCount) then begin
  3950. if Memo.LineState[FDebugEntries[I].LineNumber] = lnUnknown then
  3951. Memo.LineState[FDebugEntries[I].LineNumber] := lnHasEntry;
  3952. end;
  3953. end;
  3954. end;
  3955. UpdateAllMemosLineMarkers;
  3956. except
  3957. DestroyDebugInfo;
  3958. raise;
  3959. end;
  3960. end;
  3961. procedure TCompileForm.ResetAllMemosLineState;
  3962. { Changes green dots back to grey dots }
  3963. var
  3964. Memo: TCompScintFileEdit;
  3965. I: Integer;
  3966. begin
  3967. for Memo in FFileMemos do begin
  3968. if Memo.Used and Assigned(Memo.LineState) then begin
  3969. for I := 0 to Memo.LineStateCount-1 do begin
  3970. if Memo.LineState[I] = lnEntryProcessed then begin
  3971. Memo.LineState[I] := lnHasEntry;
  3972. UpdateLineMarkers(Memo, I);
  3973. end;
  3974. end;
  3975. end;
  3976. end;
  3977. end;
  3978. procedure TCompileForm.CheckIfTerminated;
  3979. var
  3980. H: THandle;
  3981. begin
  3982. if FDebugging then begin
  3983. { Check if the process hosting the debug client (e.g. Setup or the
  3984. uninstaller second phase) has terminated. If the debug client hasn't
  3985. connected yet, check the initial process (e.g. SetupLdr or the
  3986. uninstaller first phase) instead. }
  3987. if FDebugClientWnd <> 0 then
  3988. H := FDebugClientProcessHandle
  3989. else
  3990. H := FProcessHandle;
  3991. if WaitForSingleObject(H, 0) <> WAIT_TIMEOUT then
  3992. DebuggingStopped(True);
  3993. end;
  3994. end;
  3995. procedure TCompileForm.DebuggingStopped(const WaitForTermination: Boolean);
  3996. function GetExitCodeText: String;
  3997. var
  3998. ExitCode: DWORD;
  3999. begin
  4000. { Note: When debugging an uninstall, this will get the exit code off of
  4001. the first phase process, since that's the exit code users will see when
  4002. running the uninstaller outside the debugger. }
  4003. case WaitForSingleObject(FProcessHandle, 0) of
  4004. WAIT_OBJECT_0:
  4005. begin
  4006. if GetExitCodeProcess(FProcessHandle, ExitCode) then begin
  4007. { If the high bit is set, the process was killed uncleanly (e.g.
  4008. by a debugger). Show the exit code as hex in that case. }
  4009. if ExitCode and $80000000 <> 0 then
  4010. Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: 0x%.8x', [ExitCode])
  4011. else
  4012. Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: %u', [ExitCode]);
  4013. end
  4014. else
  4015. Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (GetExitCodeProcess failed)';
  4016. end;
  4017. WAIT_TIMEOUT:
  4018. Result := DebugTargetStrings[FDebugTarget] + ' is still running; can''t get exit code';
  4019. else
  4020. Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (WaitForSingleObject failed)';
  4021. end;
  4022. end;
  4023. var
  4024. ExitCodeText: String;
  4025. begin
  4026. if WaitForTermination then begin
  4027. { Give the initial process time to fully terminate so we can successfully
  4028. get its exit code }
  4029. WaitForSingleObject(FProcessHandle, 5000);
  4030. end;
  4031. FDebugging := False;
  4032. FDebugClientWnd := 0;
  4033. ExitCodeText := GetExitCodeText;
  4034. if FDebugClientProcessHandle <> 0 then begin
  4035. CloseHandle(FDebugClientProcessHandle);
  4036. FDebugClientProcessHandle := 0;
  4037. end;
  4038. CloseHandle(FProcessHandle);
  4039. FProcessHandle := 0;
  4040. FTempDir := '';
  4041. CheckIfRunningTimer.Enabled := False;
  4042. HideError;
  4043. SetStepLine(FStepMemo, -1);
  4044. UpdateRunMenu;
  4045. UpdateCaption;
  4046. DebugLogMessage('*** ' + ExitCodeText);
  4047. StatusBar.Panels[spExtraStatus].Text := ' ' + ExitCodeText;
  4048. end;
  4049. procedure TCompileForm.DetachDebugger;
  4050. begin
  4051. CheckIfTerminated;
  4052. if not FDebugging then Exit;
  4053. SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Detach, 0, 0);
  4054. DebuggingStopped(False);
  4055. end;
  4056. function TCompileForm.AskToDetachDebugger: Boolean;
  4057. begin
  4058. if FDebugClientWnd = 0 then begin
  4059. MsgBox('Please stop the running ' + DebugTargetStrings[FDebugTarget] + ' process before performing this command.',
  4060. SCompilerFormCaption, mbError, MB_OK);
  4061. Result := False;
  4062. end else if MsgBox('This command will detach the debugger from the running ' + DebugTargetStrings[FDebugTarget] + ' process. Continue?',
  4063. SCompilerFormCaption, mbError, MB_OKCANCEL) = IDOK then begin
  4064. DetachDebugger;
  4065. Result := True;
  4066. end else
  4067. Result := False;
  4068. end;
  4069. procedure TCompileForm.UpdateRunMenu;
  4070. begin
  4071. CheckIfTerminated;
  4072. BCompile.Enabled := not FCompiling and not FDebugging;
  4073. CompileButton.Enabled := BCompile.Enabled;
  4074. BStopCompile.Enabled := FCompiling;
  4075. StopCompileButton.Enabled := BStopCompile.Enabled;
  4076. RRun.Enabled := not FCompiling and (not FDebugging or FPaused);
  4077. RunButton.Enabled := RRun.Enabled;
  4078. RPause.Enabled := FDebugging and not FPaused;
  4079. PauseButton.Enabled := RPause.Enabled;
  4080. RRunToCursor.Enabled := RRun.Enabled and (FActiveMemo is TCompScintFileEdit);
  4081. RStepInto.Enabled := RRun.Enabled;
  4082. RStepOver.Enabled := RRun.Enabled;
  4083. RStepOut.Enabled := FPaused;
  4084. RToggleBreakPoint.Enabled := FActiveMemo is TCompScintFileEdit;
  4085. RTerminate.Enabled := FDebugging and (FDebugClientWnd <> 0);
  4086. TerminateButton.Enabled := RTerminate.Enabled;
  4087. REvaluate.Enabled := FDebugging and (FDebugClientWnd <> 0);
  4088. end;
  4089. procedure TCompileForm.UpdateSaveMenuItemAndButton;
  4090. begin
  4091. FSave.Enabled := FActiveMemo is TCompScintFileEdit;
  4092. SaveButton.Enabled := FSave.Enabled;
  4093. end;
  4094. procedure TCompileForm.UpdateTargetMenu;
  4095. begin
  4096. if FDebugTarget = dtSetup then begin
  4097. RTargetSetup.Checked := True;
  4098. TargetSetupButton.Down := True;
  4099. end else begin
  4100. RTargetUninstall.Checked := True;
  4101. TargetUninstallButton.Down := True;
  4102. end;
  4103. end;
  4104. procedure TCompileForm.UpdateTheme;
  4105. procedure SetControlTheme(const WinControl: TWinControl);
  4106. begin
  4107. if UseThemes then begin
  4108. if FTheme.Dark then
  4109. SetWindowTheme(WinControl.Handle, 'DarkMode_Explorer', nil)
  4110. else
  4111. SetWindowTheme(WinControl.Handle, nil, nil);
  4112. end;
  4113. end;
  4114. procedure SetListTheme(const List: TListBox);
  4115. begin
  4116. List.Font.Color := FTheme.Colors[tcFore];
  4117. List.Color := FTheme.Colors[tcBack];
  4118. List.Invalidate;
  4119. SetControlTheme(List);
  4120. end;
  4121. var
  4122. Memo: TCompScintEdit;
  4123. begin
  4124. FTheme.Typ := FOptions.ThemeType;
  4125. for Memo in FMemos do begin
  4126. Memo.UpdateThemeColorsAndStyleAttributes;
  4127. SetControlTheme(Memo);
  4128. end;
  4129. ToolBarPanel.ParentBackground := False;
  4130. ToolBarPanel.Color := FTheme.Colors[tcToolBack];
  4131. if FTheme.Dark then
  4132. ToolBarVirtualImageList.ImageCollection := DarkToolBarImageCollection
  4133. else
  4134. ToolBarVirtualImageList.ImageCollection := LightToolBarImageCollection;
  4135. UpdateBevel1Visibility;
  4136. SplitPanel.ParentBackground := False;
  4137. SplitPanel.Color := FTheme.Colors[tcSplitterBack];
  4138. if FTheme.Dark then begin
  4139. MemosTabSet.Theme := FTheme;
  4140. OutputTabSet.Theme := FTheme;
  4141. end else begin
  4142. MemosTabSet.Theme := nil;
  4143. OutputTabSet.Theme := nil;
  4144. end;
  4145. SetListTheme(CompilerOutputList);
  4146. SetListTheme(DebugOutputList);
  4147. SetListTheme(DebugCallStackList);
  4148. SetListTheme(FindResultsList);
  4149. end;
  4150. procedure TCompileForm.UpdateThemeData(const Open: Boolean);
  4151. begin
  4152. if FProgressThemeData <> 0 then begin
  4153. CloseThemeData(FProgressThemeData);
  4154. FProgressThemeData := 0;
  4155. end;
  4156. if Open and UseThemes then begin
  4157. FProgressThemeData := OpenThemeData(Handle, 'Progress');
  4158. if (GetThemeInt(FProgressThemeData, 0, 0, TMT_PROGRESSCHUNKSIZE, FProgressChunkSize) <> S_OK) or
  4159. (FProgressChunkSize <= 0) then
  4160. FProgressChunkSize := 6;
  4161. if (GetThemeInt(FProgressThemeData, 0, 0, TMT_PROGRESSSPACESIZE, FProgressSpaceSize) <> S_OK) or
  4162. (FProgressSpaceSize < 0) then { ...since "OpusOS" theme returns a bogus -1 value }
  4163. FProgressSpaceSize := 2;
  4164. end;
  4165. end;
  4166. procedure TCompileForm.StartProcess;
  4167. const
  4168. SEE_MASK_NOZONECHECKS = $00800000;
  4169. var
  4170. RunFilename, RunParameters, WorkingDir: String;
  4171. Info: TShellExecuteInfo;
  4172. SaveFocusWindow: HWND;
  4173. WindowList: Pointer;
  4174. ShellExecuteResult: BOOL;
  4175. ErrorCode: DWORD;
  4176. begin
  4177. if FDebugTarget = dtUninstall then begin
  4178. if FUninstExe = '' then
  4179. raise Exception.Create(SCompilerNeedUninstExe);
  4180. RunFilename := FUninstExe;
  4181. end else begin
  4182. if FCompiledExe = '' then
  4183. raise Exception.Create(SCompilerNeedCompiledExe);
  4184. RunFilename := FCompiledExe;
  4185. end;
  4186. RunParameters := Format('/DEBUGWND=$%x ', [Handle]) + FRunParameters;
  4187. ResetAllMemosLineState;
  4188. DebugOutputList.Clear;
  4189. SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  4190. DebugCallStackList.Clear;
  4191. SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  4192. if not (OutputTabSet.TabIndex in [tiDebugOutput, tiDebugCallStack]) then
  4193. OutputTabSet.TabIndex := tiDebugOutput;
  4194. SetStatusPanelVisible(True);
  4195. FillChar(Info, SizeOf(Info), 0);
  4196. Info.cbSize := SizeOf(Info);
  4197. Info.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_FLAG_DDEWAIT or
  4198. SEE_MASK_NOCLOSEPROCESS or SEE_MASK_NOZONECHECKS;
  4199. Info.Wnd := Application.Handle;
  4200. if FOptions.RunAsDifferentUser and (Win32MajorVersion >= 5) then
  4201. Info.lpVerb := 'runas'
  4202. else
  4203. Info.lpVerb := 'open';
  4204. Info.lpFile := PChar(RunFilename);
  4205. Info.lpParameters := PChar(RunParameters);
  4206. WorkingDir := PathExtractDir(RunFilename);
  4207. Info.lpDirectory := PChar(WorkingDir);
  4208. Info.nShow := SW_SHOWNORMAL;
  4209. { Disable windows so that the user can't click other things while a "Run as"
  4210. dialog is up but is not system modal (which it is currently) }
  4211. SaveFocusWindow := GetFocus;
  4212. WindowList := DisableTaskWindows(0);
  4213. try
  4214. { Also temporarily remove the focus since a disabled window's children can
  4215. still receive keystrokes. This is needed if the UAC dialog doesn't come to
  4216. the foreground for some reason (e.g. if the following SetActiveWindow call
  4217. is removed). }
  4218. Windows.SetFocus(0);
  4219. { We have to make the application window the active window, otherwise the
  4220. UAC dialog doesn't come to the foreground automatically. }
  4221. SetActiveWindow(Application.Handle);
  4222. ShellExecuteResult := ShellExecuteEx(@Info);
  4223. ErrorCode := GetLastError;
  4224. finally
  4225. EnableTaskWindows(WindowList);
  4226. Windows.SetFocus(SaveFocusWindow);
  4227. end;
  4228. if not ShellExecuteResult then begin
  4229. { Don't display error message if user clicked Cancel at UAC dialog }
  4230. if ErrorCode = ERROR_CANCELLED then
  4231. Abort;
  4232. raise Exception.CreateFmt(SCompilerExecuteSetupError2, [RunFilename,
  4233. ErrorCode, Win32ErrorString(ErrorCode)]);
  4234. end;
  4235. FDebugging := True;
  4236. FPaused := False;
  4237. FProcessHandle := Info.hProcess;
  4238. CheckIfRunningTimer.Enabled := True;
  4239. UpdateRunMenu;
  4240. UpdateCaption;
  4241. DebugLogMessage('*** ' + DebugTargetStrings[FDebugTarget] + ' started');
  4242. end;
  4243. procedure TCompileForm.CompileIfNecessary;
  4244. function UnopenedIncludedFileModifiedSinceLastCompile: Boolean;
  4245. var
  4246. IncludedFile: TIncludedFile;
  4247. NewTime: TFileTime;
  4248. begin
  4249. Result := False;
  4250. for IncludedFile in FIncludedFiles do begin
  4251. if (IncludedFile.Memo = nil) and IncludedFile.HasLastWriteTime and
  4252. GetLastWriteTimeOfFile(IncludedFile.Filename, @NewTime) and
  4253. (CompareFileTime(IncludedFile.LastWriteTime, NewTime) <> 0) then begin
  4254. Result := True;
  4255. Exit;
  4256. end;
  4257. end;
  4258. end;
  4259. begin
  4260. CheckIfTerminated;
  4261. { Display warning if the user modified the script while running - does not support unopened included files }
  4262. if FDebugging and FModifiedAnySinceLastCompileAndGo then begin
  4263. if MsgBox('The changes you made will not take effect until you ' +
  4264. 're-compile.' + SNewLine2 + 'Continue running anyway?',
  4265. SCompilerFormCaption, mbError, MB_YESNO) <> IDYES then
  4266. Abort;
  4267. FModifiedAnySinceLastCompileAndGo := False;
  4268. { The process may have terminated while the message box was up; check,
  4269. and if it has, we want to recompile below }
  4270. CheckIfTerminated;
  4271. end;
  4272. if not FDebugging and (FModifiedAnySinceLastCompile or UnopenedIncludedFileModifiedSinceLastCompile) then
  4273. CompileFile('', False);
  4274. end;
  4275. procedure TCompileForm.Go(AStepMode: TStepMode);
  4276. begin
  4277. CompileIfNecessary;
  4278. FStepMode := AStepMode;
  4279. HideError;
  4280. SetStepLine(FStepMemo, -1);
  4281. if FDebugging then begin
  4282. if FPaused then begin
  4283. FPaused := False;
  4284. UpdateRunMenu;
  4285. UpdateCaption;
  4286. if DebugCallStackList.Items.Count > 0 then begin
  4287. DebugCallStackList.Clear;
  4288. SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
  4289. DebugCallStackList.Update;
  4290. end;
  4291. { Tell it to continue }
  4292. SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Continue,
  4293. Ord(AStepMode = smStepOver), 0);
  4294. end;
  4295. end
  4296. else
  4297. StartProcess;
  4298. end;
  4299. function TCompileForm.EvaluateConstant(const S: String;
  4300. var Output: String): Integer;
  4301. begin
  4302. { This is about evaluating constants like 'app' and not [Code] variables }
  4303. FReplyString := '';
  4304. Result := SendCopyDataMessageStr(FDebugClientWnd, Handle,
  4305. CD_DebugClient_EvaluateConstantW, S);
  4306. if Result > 0 then
  4307. Output := FReplyString;
  4308. end;
  4309. function TCompileForm.EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
  4310. var Output: String): Integer;
  4311. begin
  4312. FReplyString := '';
  4313. Result := SendCopyDataMessage(FDebugClientWnd, Handle, CD_DebugClient_EvaluateVariableEntry,
  4314. DebugEntry, SizeOf(DebugEntry^));
  4315. if Result > 0 then
  4316. Output := FReplyString;
  4317. end;
  4318. procedure TCompileForm.RRunClick(Sender: TObject);
  4319. begin
  4320. Go(smRun);
  4321. end;
  4322. procedure TCompileForm.RParametersClick(Sender: TObject);
  4323. begin
  4324. ReadMRUParametersList;
  4325. InputQueryCombo('Run Parameters', 'Command line parameters for ' + DebugTargetStrings[dtSetup] +
  4326. ' and ' + DebugTargetStrings[dtUninstall] + ':', FRunParameters, FMRUParametersList);
  4327. if FRunParameters <> '' then
  4328. ModifyMRUParametersList(FRunParameters, True);
  4329. end;
  4330. procedure TCompileForm.RPauseClick(Sender: TObject);
  4331. begin
  4332. if FDebugging and not FPaused then begin
  4333. if FStepMode <> smStepInto then begin
  4334. FStepMode := smStepInto;
  4335. UpdateCaption;
  4336. end
  4337. else
  4338. MsgBox('A pause is already pending.', SCompilerFormCaption, mbError,
  4339. MB_OK);
  4340. end;
  4341. end;
  4342. procedure TCompileForm.RRunToCursorClick(Sender: TObject);
  4343. function GetDebugEntryFromMemoAndLineNumber(Memo: TCompScintFileEdit; LineNumber: Integer;
  4344. var DebugEntry: TDebugEntry): Boolean;
  4345. var
  4346. I: Integer;
  4347. begin
  4348. Result := False;
  4349. for I := 0 to FDebugEntriesCount-1 do begin
  4350. if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and
  4351. (FDebugEntries[I].LineNumber = LineNumber) then begin
  4352. DebugEntry := FDebugEntries[I];
  4353. Result := True;
  4354. Break;
  4355. end;
  4356. end;
  4357. end;
  4358. begin
  4359. CompileIfNecessary;
  4360. if not GetDebugEntryFromMemoAndLineNumber((FActiveMemo as TCompScintFileEdit), FActiveMemo.CaretLine, FRunToCursorPoint) then begin
  4361. MsgBox('No code was generated for the current line.', SCompilerFormCaption,
  4362. mbError, MB_OK);
  4363. Exit;
  4364. end;
  4365. Go(smRunToCursor);
  4366. end;
  4367. procedure TCompileForm.RStepIntoClick(Sender: TObject);
  4368. begin
  4369. Go(smStepInto);
  4370. end;
  4371. procedure TCompileForm.RStepOutClick(Sender: TObject);
  4372. begin
  4373. if FPausedAtCodeLine then
  4374. Go(smStepOut)
  4375. else
  4376. Go(smStepInto);
  4377. end;
  4378. procedure TCompileForm.RStepOverClick(Sender: TObject);
  4379. begin
  4380. Go(smStepOver);
  4381. end;
  4382. procedure TCompileForm.RTerminateClick(Sender: TObject);
  4383. var
  4384. S, Dir: String;
  4385. begin
  4386. S := 'This will unconditionally terminate the running ' +
  4387. DebugTargetStrings[FDebugTarget] + ' process. Continue?';
  4388. if FDebugTarget = dtSetup then
  4389. S := S + #13#10#13#10'Note that if ' + DebugTargetStrings[FDebugTarget] + ' ' +
  4390. 'is currently in the installation phase, any changes made to the ' +
  4391. 'system thus far will not be undone, nor will uninstall data be written.';
  4392. if MsgBox(S, 'Terminate', mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDYES then
  4393. Exit;
  4394. CheckIfTerminated;
  4395. if FDebugging then begin
  4396. DebugLogMessage('*** Terminating process');
  4397. Win32Check(TerminateProcess(FDebugClientProcessHandle, 6));
  4398. if (WaitForSingleObject(FDebugClientProcessHandle, 5000) <> WAIT_TIMEOUT) and
  4399. (FTempDir <> '') then begin
  4400. Dir := FTempDir;
  4401. FTempDir := '';
  4402. DebugLogMessage('*** Removing left-over temporary directory: ' + Dir);
  4403. { Sleep for a bit to allow files to be unlocked by Windows,
  4404. otherwise it fails intermittently (with Hyper-Threading, at least) }
  4405. Sleep(50);
  4406. if not DeleteDirTree(Dir) and DirExists(Dir) then
  4407. DebugLogMessage('*** Failed to remove temporary directory');
  4408. end;
  4409. DebuggingStopped(True);
  4410. end;
  4411. end;
  4412. procedure TCompileForm.REvaluateClick(Sender: TObject);
  4413. var
  4414. Output: String;
  4415. begin
  4416. if InputQuery('Evaluate', 'Constant to evaluate (e.g., "{app}"):',
  4417. FLastEvaluateConstantText) then begin
  4418. case EvaluateConstant(FLastEvaluateConstantText, Output) of
  4419. 1: MsgBox(Output, 'Evaluate Result', mbInformation, MB_OK);
  4420. 2: MsgBox(Output, 'Evaluate Error', mbError, MB_OK);
  4421. else
  4422. MsgBox('An unknown error occurred.', 'Evaluate Error', mbError, MB_OK);
  4423. end;
  4424. end;
  4425. end;
  4426. procedure TCompileForm.CheckIfRunningTimerTimer(Sender: TObject);
  4427. begin
  4428. { In cases of normal Setup termination, we receive a WM_Debugger_Goodbye
  4429. message. But in case we don't get that, use a timer to periodically check
  4430. if the process is no longer running. }
  4431. CheckIfTerminated;
  4432. end;
  4433. procedure TCompileForm.PListCopyClick(Sender: TObject);
  4434. var
  4435. ListBox: TListBox;
  4436. Text: String;
  4437. I: Integer;
  4438. begin
  4439. if CompilerOutputList.Visible then
  4440. ListBox := CompilerOutputList
  4441. else if DebugOutputList.Visible then
  4442. ListBox := DebugOutputList
  4443. else if DebugCallStackList.Visible then
  4444. ListBox := DebugCallStackList
  4445. else
  4446. ListBox := FindResultsList;
  4447. Text := '';
  4448. if ListBox.SelCount > 0 then begin
  4449. for I := 0 to ListBox.Items.Count-1 do begin
  4450. if ListBox.Selected[I] then begin
  4451. if Text <> '' then
  4452. Text := Text + SNewLine;
  4453. Text := Text + ListBox.Items[I];
  4454. end;
  4455. end;
  4456. end;
  4457. Clipboard.AsText := Text;
  4458. end;
  4459. procedure TCompileForm.PListSelectAllClick(Sender: TObject);
  4460. var
  4461. ListBox: TListBox;
  4462. I: Integer;
  4463. begin
  4464. if CompilerOutputList.Visible then
  4465. ListBox := CompilerOutputList
  4466. else if DebugOutputList.Visible then
  4467. ListBox := DebugOutputList
  4468. else if DebugCallStackList.Visible then
  4469. ListBox := DebugCallStackList
  4470. else
  4471. ListBox := FindResultsList;
  4472. ListBox.Items.BeginUpdate;
  4473. try
  4474. for I := 0 to ListBox.Items.Count-1 do
  4475. ListBox.Selected[I] := True;
  4476. finally
  4477. ListBox.Items.EndUpdate;
  4478. end;
  4479. end;
  4480. procedure TCompileForm.AppOnIdle(Sender: TObject; var Done: Boolean);
  4481. begin
  4482. { For an explanation of this, see the comment where HandleMessage is called }
  4483. if FCompiling then
  4484. Done := False;
  4485. FBecameIdle := True;
  4486. end;
  4487. procedure TCompileForm.EGotoClick(Sender: TObject);
  4488. var
  4489. S: String;
  4490. L: Integer;
  4491. begin
  4492. S := IntToStr(FActiveMemo.CaretLine + 1);
  4493. if InputQuery('Go to Line', 'Line number:', S) then begin
  4494. L := StrToIntDef(S, Low(L));
  4495. if L <> Low(L) then
  4496. FActiveMemo.CaretLine := L - 1;
  4497. end;
  4498. end;
  4499. procedure TCompileForm.StatusBarClick(Sender: TObject);
  4500. begin
  4501. if MemosTabSet.Visible and (FHiddenFiles.Count > 0) then begin
  4502. var Point := SmallPointToPoint(TSmallPoint(DWORD(GetMessagePos)));
  4503. var X := StatusBar.ScreenToClient(Point).X;
  4504. var W := 0;
  4505. for var I := 0 to StatusBar.Panels.Count-1 do begin
  4506. Inc(W, StatusBar.Panels[I].Width);
  4507. if X < W then begin
  4508. if I = spHiddenFilesCount then
  4509. MemosTabSetPopupMenu.Popup(Point.X, Point.Y);
  4510. Break;
  4511. end else if I = spHiddenFilesCount then
  4512. Break;
  4513. end;
  4514. end;
  4515. end;
  4516. procedure TCompileForm.StatusBarDrawPanel(StatusBar: TStatusBar;
  4517. Panel: TStatusPanel; const Rect: TRect);
  4518. var
  4519. R, BR: TRect;
  4520. W, ChunkCount: Integer;
  4521. begin
  4522. case Panel.Index of
  4523. spCompileIcon:
  4524. if FCompiling then begin
  4525. ImageList_Draw(BuildImageList.Handle, FBuildAnimationFrame, StatusBar.Canvas.Handle,
  4526. Rect.Left + ((Rect.Right - Rect.Left) - BuildImageList.Width) div 2,
  4527. Rect.Top + ((Rect.Bottom - Rect.Top) - BuildImageList.Height) div 2, ILD_NORMAL);
  4528. end;
  4529. spCompileProgress:
  4530. if FCompiling and (FProgressMax > 0) then begin
  4531. R := Rect;
  4532. InflateRect(R, -2, -2);
  4533. if FProgressThemeData = 0 then begin
  4534. R.Right := R.Left + MulDiv(FProgress, R.Right - R.Left,
  4535. FProgressMax);
  4536. StatusBar.Canvas.Brush.Color := clHighlight;
  4537. StatusBar.Canvas.FillRect(R);
  4538. end else begin
  4539. DrawThemeBackground(FProgressThemeData, StatusBar.Canvas.Handle, PP_BAR, 0, R, nil);
  4540. BR := R;
  4541. GetThemeBackgroundContentRect(FProgressThemeData, StatusBar.Canvas.Handle, PP_BAR, 0, BR, @R);
  4542. IntersectClipRect(StatusBar.Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
  4543. W := MulDiv(FProgress, R.Right - R.Left, FProgressMax);
  4544. ChunkCount := W div (FProgressChunkSize + FProgressSpaceSize);
  4545. if W mod (FProgressChunkSize + FProgressSpaceSize) > 0 then
  4546. Inc(ChunkCount);
  4547. R.Right := R.Left + FProgressChunkSize;
  4548. for W := 0 to ChunkCount - 1 do
  4549. begin
  4550. DrawThemeBackground(FProgressThemeData, StatusBar.Canvas.Handle, PP_CHUNK, 0, R, nil);
  4551. OffsetRect(R, FProgressChunkSize + FProgressSpaceSize, 0);
  4552. end;
  4553. end;
  4554. end;
  4555. end;
  4556. end;
  4557. procedure TCompileForm.InvalidateStatusPanel(const Index: Integer);
  4558. var
  4559. R: TRect;
  4560. begin
  4561. { For some reason, the VCL doesn't offer a method for this... }
  4562. if SendMessage(StatusBar.Handle, SB_GETRECT, Index, LPARAM(@R)) <> 0 then begin
  4563. InflateRect(R, -1, -1);
  4564. InvalidateRect(StatusBar.Handle, @R, True);
  4565. end;
  4566. end;
  4567. procedure TCompileForm.UpdateCompileStatusPanels(const AProgress,
  4568. AProgressMax: Cardinal; const ASecondsRemaining: Integer;
  4569. const ABytesCompressedPerSecond: Cardinal);
  4570. var
  4571. T: DWORD;
  4572. begin
  4573. { Icon panel }
  4574. T := GetTickCount;
  4575. if Cardinal(T - FLastAnimationTick) >= Cardinal(500) then begin
  4576. FLastAnimationTick := T;
  4577. InvalidateStatusPanel(spCompileIcon);
  4578. FBuildAnimationFrame := (FBuildAnimationFrame + 1) mod 4;
  4579. { Also update the status text twice a second }
  4580. if ASecondsRemaining >= 0 then
  4581. StatusBar.Panels[spExtraStatus].Text := Format(
  4582. ' Estimated time remaining: %.2d%s%.2d%s%.2d Average KB/sec: %.0n',
  4583. [(ASecondsRemaining div 60) div 60, FormatSettings.TimeSeparator,
  4584. (ASecondsRemaining div 60) mod 60, FormatSettings.TimeSeparator,
  4585. ASecondsRemaining mod 60, ABytesCompressedPerSecond / 1024])
  4586. else
  4587. StatusBar.Panels[spExtraStatus].Text := '';
  4588. end;
  4589. { Progress panel and taskbar progress bar }
  4590. if (FProgress <> AProgress) or
  4591. (FProgressMax <> AProgressMax) then begin
  4592. FProgress := AProgress;
  4593. FProgressMax := AProgressMax;
  4594. InvalidateStatusPanel(spCompileProgress);
  4595. SetAppTaskbarProgressValue(AProgress, AProgressMax);
  4596. end;
  4597. end;
  4598. procedure TCompileForm.WMSettingChange(var Message: TMessage);
  4599. begin
  4600. if (FTheme.Typ <> ttClassic) and (Win32MajorVersion >= 10) and (Message.LParam <> 0) and (StrIComp(PChar(Message.LParam), 'ImmersiveColorSet') = 0) then begin
  4601. FOptions.ThemeType := GetDefaultThemeType;
  4602. UpdateTheme;
  4603. end;
  4604. end;
  4605. procedure TCompileForm.WMThemeChanged(var Message: TMessage);
  4606. begin
  4607. { Don't Run to Cursor into this function, it will interrupt up the theme change }
  4608. UpdateThemeData(True);
  4609. inherited;
  4610. end;
  4611. procedure TCompileForm.RTargetClick(Sender: TObject);
  4612. var
  4613. NewTarget: TDebugTarget;
  4614. begin
  4615. if (Sender = RTargetSetup) or (Sender = TargetSetupButton) then
  4616. NewTarget := dtSetup
  4617. else
  4618. NewTarget := dtUninstall;
  4619. if (FDebugTarget <> NewTarget) and (not FDebugging or AskToDetachDebugger) then
  4620. FDebugTarget := NewTarget;
  4621. { Update always even if the user decided not to switch so the states are restored }
  4622. UpdateTargetMenu;
  4623. end;
  4624. procedure TCompileForm.AppOnActivate(Sender: TObject);
  4625. const
  4626. ReloadMessages: array[Boolean] of String = (
  4627. 'The %s file has been modified outside of the source editor.' + SNewLine2 +
  4628. 'Do you want to reload the file?',
  4629. 'The %s file has been modified outside of the source editor. Changes have ' +
  4630. 'also been made in the source editor.' + SNewLine2 + 'Do you want to ' +
  4631. 'reload the file and lose the changes made in the source editor?');
  4632. var
  4633. Memo: TCompScintFileEdit;
  4634. NewTime: TFileTime;
  4635. Changed: Boolean;
  4636. begin
  4637. for Memo in FFileMemos do begin
  4638. if (Memo.Filename = '') or not Memo.Used then
  4639. Continue;
  4640. { See if the file has been modified outside the editor }
  4641. Changed := False;
  4642. if GetLastWriteTimeOfFile(Memo.Filename, @NewTime) then begin
  4643. if CompareFileTime(Memo.FileLastWriteTime, NewTime) <> 0 then begin
  4644. Memo.FileLastWriteTime := NewTime;
  4645. Changed := True;
  4646. end;
  4647. end;
  4648. { If it has been, offer to reload it }
  4649. if Changed then begin
  4650. if IsWindowEnabled(Application.Handle) then begin
  4651. if MsgBox(Format(ReloadMessages[Memo.Modified], [Memo.Filename]),
  4652. SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then
  4653. if ConfirmCloseFile(False) then begin
  4654. OpenFile(Memo, Memo.Filename, False);
  4655. if Memo = FMainMemo then
  4656. Break; { Reloading the main script will also reload all include files }
  4657. end;
  4658. end
  4659. else begin
  4660. { When a modal dialog is up, don't offer to reload the file. Probably
  4661. not a good idea since the dialog might be manipulating the file. }
  4662. MsgBox('The ' + Memo.Filename + ' file has been modified outside ' +
  4663. 'of the source editor. You might want to reload it.',
  4664. SCompilerFormCaption, mbInformation, MB_OK);
  4665. end;
  4666. end;
  4667. end;
  4668. end;
  4669. procedure TCompileForm.CompilerOutputListDrawItem(Control: TWinControl;
  4670. Index: Integer; Rect: TRect; State: TOwnerDrawState);
  4671. const
  4672. ThemeColors: array [TStatusMessageKind] of TThemeColor = (tcGreen, tcFore, tcOrange, tcRed);
  4673. var
  4674. Canvas: TCanvas;
  4675. S: String;
  4676. StatusMessageKind: TStatusMessageKind;
  4677. begin
  4678. Canvas := CompilerOutputList.Canvas;
  4679. S := CompilerOutputList.Items[Index];
  4680. Canvas.FillRect(Rect);
  4681. Inc(Rect.Left, 2);
  4682. if FOptions.ColorizeCompilerOutput and not (odSelected in State) then begin
  4683. StatusMessageKind := TStatusMessageKind(CompilerOutputList.Items.Objects[Index]);
  4684. Canvas.Font.Color := FTheme.Colors[ThemeColors[StatusMessageKind]];
  4685. end;
  4686. Canvas.TextOut(Rect.Left, Rect.Top, S);
  4687. end;
  4688. procedure TCompileForm.DebugOutputListDrawItem(Control: TWinControl;
  4689. Index: Integer; Rect: TRect; State: TOwnerDrawState);
  4690. var
  4691. Canvas: TCanvas;
  4692. S: String;
  4693. begin
  4694. Canvas := DebugOutputList.Canvas;
  4695. S := DebugOutputList.Items[Index];
  4696. Canvas.FillRect(Rect);
  4697. Inc(Rect.Left, 2);
  4698. if (S <> '') and (S[1] = #9) then
  4699. Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 2, Maxint))
  4700. else begin
  4701. if (Length(S) > 20) and (S[18] = '-') and (S[19] = '-') and (S[20] = ' ') then begin
  4702. { Draw lines that begin with '-- ' (like '-- File entry --') in bold }
  4703. Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, 17));
  4704. Canvas.Font.Style := [fsBold];
  4705. Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 18, Maxint));
  4706. end else
  4707. Canvas.TextOut(Rect.Left, Rect.Top, S);
  4708. end;
  4709. end;
  4710. procedure TCompileForm.DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  4711. State: TOwnerDrawState);
  4712. var
  4713. Canvas: TCanvas;
  4714. S: String;
  4715. begin
  4716. Canvas := DebugCallStackList.Canvas;
  4717. S := DebugCallStackList.Items[Index];
  4718. Canvas.FillRect(Rect);
  4719. Inc(Rect.Left, 2);
  4720. Canvas.TextOut(Rect.Left, Rect.Top, S);
  4721. end;
  4722. procedure TCompileForm.FindResultsListDblClick(Sender: TObject);
  4723. var
  4724. FindResult: TFindResult;
  4725. Memo: TCompScintFileEdit;
  4726. I: Integer;
  4727. begin
  4728. I := FindResultsList.ItemIndex;
  4729. if I <> -1 then begin
  4730. FindResult := FindResultsList.Items.Objects[I] as TFindResult;
  4731. if FindResult <> nil then begin
  4732. for Memo in FFileMemos do begin
  4733. if Memo.Used and (PathCompare(Memo.Filename, FindResult.Filename) = 0) then begin
  4734. MoveCaretAndActivateMemo(Memo, FindResult.Line, True);
  4735. Memo.Selection := FindResult.Range;
  4736. ActiveControl := Memo;
  4737. Exit;
  4738. end;
  4739. end;
  4740. MsgBox('File not opened.', SCompilerFormCaption, mbError, MB_OK);
  4741. end;
  4742. end;
  4743. end;
  4744. procedure TCompileForm.FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
  4745. State: TOwnerDrawState);
  4746. var
  4747. Canvas: TCanvas;
  4748. S, S2: String;
  4749. FindResult: TFindResult;
  4750. StartI, EndI: Integer;
  4751. SaveColor: TColor;
  4752. begin
  4753. Canvas := FindResultsList.Canvas;
  4754. S := FindResultsList.Items[Index];
  4755. FindResult := FindResultsList.Items.Objects[Index] as TFindResult;
  4756. Canvas.FillRect(Rect);
  4757. Inc(Rect.Left, 2);
  4758. if FindResult = nil then begin
  4759. Canvas.Font.Style := [fsBold];
  4760. Canvas.TextOut(Rect.Left, Rect.Top, S);
  4761. end else if not (odSelected in State) then begin
  4762. StartI := FindResult.Range.StartPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength;
  4763. EndI := FindResult.Range.EndPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength;
  4764. if StartI > 1 then begin
  4765. Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, StartI-1));
  4766. Rect.Left := Canvas.PenPos.X;
  4767. end;
  4768. SaveColor := Canvas.Brush.Color;
  4769. if FTheme.Dark then
  4770. Canvas.Brush.Color := FTheme.Colors[tcRed]
  4771. else
  4772. Canvas.Brush.Color := FTheme.Colors[tcSelBack];
  4773. S2 := Copy(S, StartI, EndI-StartI);
  4774. Rect.Right := Rect.Left + Canvas.TextWidth(S2);
  4775. Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2); { TextRect instead of TextOut to avoid a margin around the text }
  4776. if EndI <= Length(S) then begin
  4777. Canvas.Brush.Color := SaveColor;
  4778. S2 := Copy(S, EndI, MaxInt);
  4779. Rect.Left := Rect.Right;
  4780. Rect.Right := Rect.Left + Canvas.TextWidth(S2);
  4781. Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2);
  4782. end;
  4783. end else
  4784. Canvas.TextOut(Rect.Left, Rect.Top, S)
  4785. end;
  4786. procedure TCompileForm.OutputTabSetClick(Sender: TObject);
  4787. begin
  4788. case OutputTabSet.TabIndex of
  4789. tiCompilerOutput:
  4790. begin
  4791. CompilerOutputList.BringToFront;
  4792. CompilerOutputList.Visible := True;
  4793. DebugOutputList.Visible := False;
  4794. DebugCallStackList.Visible := False;
  4795. FindResultsList.Visible := False;
  4796. end;
  4797. tiDebugOutput:
  4798. begin
  4799. DebugOutputList.BringToFront;
  4800. DebugOutputList.Visible := True;
  4801. CompilerOutputList.Visible := False;
  4802. DebugCallStackList.Visible := False;
  4803. FindResultsList.Visible := False;
  4804. end;
  4805. tiDebugCallStack:
  4806. begin
  4807. DebugCallStackList.BringToFront;
  4808. DebugCallStackList.Visible := True;
  4809. CompilerOutputList.Visible := False;
  4810. DebugOutputList.Visible := False;
  4811. FindResultsList.Visible := False;
  4812. end;
  4813. tiFindResults:
  4814. begin
  4815. FindResultsList.BringToFront;
  4816. FindResultsList.Visible := True;
  4817. CompilerOutputList.Visible := False;
  4818. DebugOutputList.Visible := False;
  4819. DebugCallStackList.Visible := False;
  4820. end;
  4821. end;
  4822. end;
  4823. procedure TCompileForm.ToggleBreakPoint(Line: Integer);
  4824. var
  4825. Memo: TCompScintFileEdit;
  4826. I: Integer;
  4827. begin
  4828. Memo := FActiveMemo as TCompScintFileEdit;
  4829. I := Memo.BreakPoints.IndexOf(Line);
  4830. if I = -1 then
  4831. Memo.BreakPoints.Add(Line)
  4832. else
  4833. Memo.BreakPoints.Delete(I);
  4834. UpdateLineMarkers(Memo, Line);
  4835. end;
  4836. procedure TCompileForm.MemoMarginClick(Sender: TObject; MarginNumber: Integer;
  4837. Line: Integer);
  4838. begin
  4839. if (MarginNumber = 1) and RToggleBreakPoint.Enabled then
  4840. ToggleBreakPoint(Line);
  4841. end;
  4842. procedure TCompileForm.RToggleBreakPointClick(Sender: TObject);
  4843. begin
  4844. ToggleBreakPoint(FActiveMemo.CaretLine);
  4845. end;
  4846. procedure TCompileForm.MemoLinesInserted(Memo: TCompScintFileEdit; FirstLine, Count: integer);
  4847. var
  4848. I, Line: Integer;
  4849. begin
  4850. for I := 0 to FDebugEntriesCount-1 do
  4851. if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and
  4852. (FDebugEntries[I].LineNumber >= FirstLine) then
  4853. Inc(FDebugEntries[I].LineNumber, Count);
  4854. if Assigned(Memo.LineState) and (FirstLine < Memo.LineStateCount) then begin
  4855. { Grow FStateLine if necessary }
  4856. I := (Memo.LineStateCount + Count) - Memo.LineStateCapacity;
  4857. if I > 0 then begin
  4858. if I < LineStateGrowAmount then
  4859. I := LineStateGrowAmount;
  4860. ReallocMem(Memo.LineState, SizeOf(TLineState) * (Memo.LineStateCapacity + I));
  4861. Inc(Memo.LineStateCapacity, I);
  4862. end;
  4863. { Shift existing line states and clear the new ones }
  4864. for I := Memo.LineStateCount-1 downto FirstLine do
  4865. Memo.LineState[I + Count] := Memo.LineState[I];
  4866. for I := FirstLine to FirstLine + Count - 1 do
  4867. Memo.LineState[I] := lnUnknown;
  4868. Inc(Memo.LineStateCount, Count);
  4869. end;
  4870. if Memo.StepLine >= FirstLine then
  4871. Inc(Memo.StepLine, Count);
  4872. if Memo.ErrorLine >= FirstLine then
  4873. Inc(Memo.ErrorLine, Count);
  4874. for I := 0 to Memo.BreakPoints.Count-1 do begin
  4875. Line := Memo.BreakPoints[I];
  4876. if Line >= FirstLine then
  4877. Memo.BreakPoints[I] := Line + Count;
  4878. end;
  4879. end;
  4880. procedure TCompileForm.MemoLinesDeleted(Memo: TCompScintFileEdit; FirstLine, Count,
  4881. FirstAffectedLine: Integer);
  4882. var
  4883. I, Line: Integer;
  4884. DebugEntry: PDebugEntry;
  4885. begin
  4886. for I := 0 to FDebugEntriesCount-1 do begin
  4887. DebugEntry := @FDebugEntries[I];
  4888. if (DebugEntry.FileIndex = Memo.CompilerFileIndex) and
  4889. (DebugEntry.LineNumber >= FirstLine) then begin
  4890. if DebugEntry.LineNumber < FirstLine + Count then
  4891. DebugEntry.LineNumber := -1
  4892. else
  4893. Dec(DebugEntry.LineNumber, Count);
  4894. end;
  4895. end;
  4896. if Assigned(Memo.LineState) then begin
  4897. { Shift existing line states }
  4898. if FirstLine < Memo.LineStateCount - Count then begin
  4899. for I := FirstLine to Memo.LineStateCount - Count - 1 do
  4900. Memo.LineState[I] := Memo.LineState[I + Count];
  4901. Dec(Memo.LineStateCount, Count);
  4902. end
  4903. else begin
  4904. { There's nothing to shift because the last line(s) were deleted, or
  4905. line(s) past FLineStateCount }
  4906. if Memo.LineStateCount > FirstLine then
  4907. Memo.LineStateCount := FirstLine;
  4908. end;
  4909. end;
  4910. if Memo.StepLine >= FirstLine then begin
  4911. if Memo.StepLine < FirstLine + Count then
  4912. Memo.StepLine := -1
  4913. else
  4914. Dec(Memo.StepLine, Count);
  4915. end;
  4916. if Memo.ErrorLine >= FirstLine then begin
  4917. if Memo.ErrorLine < FirstLine + Count then
  4918. Memo.ErrorLine := -1
  4919. else
  4920. Dec(Memo.ErrorLine, Count);
  4921. end;
  4922. for I := Memo.BreakPoints.Count-1 downto 0 do begin
  4923. Line := Memo.BreakPoints[I];
  4924. if Line >= FirstLine then begin
  4925. if Line < FirstLine + Count then begin
  4926. Memo.BreakPoints.Delete(I);
  4927. end else begin
  4928. Line := Line - Count;
  4929. Memo.BreakPoints[I] := Line;
  4930. end;
  4931. end;
  4932. end;
  4933. { When lines are deleted, Scintilla insists on moving all of the deleted
  4934. lines' markers to the line on which the deletion started
  4935. (FirstAffectedLine). This is bad for us as e.g. it can result in the line
  4936. having two conflicting markers (or two of the same marker). There's no
  4937. way to stop it from doing that, or to easily tell which markers came from
  4938. which lines, so we simply delete and re-create all markers on the line. }
  4939. UpdateLineMarkers(Memo, FirstAffectedLine);
  4940. end;
  4941. procedure TCompileForm.UpdateLineMarkers(const AMemo: TCompScintFileEdit; const Line: Integer);
  4942. var
  4943. NewMarker: Integer;
  4944. begin
  4945. if Line >= AMemo.Lines.Count then
  4946. Exit;
  4947. NewMarker := -1;
  4948. if AMemo.BreakPoints.IndexOf(Line) <> -1 then begin
  4949. if AMemo.LineState = nil then
  4950. NewMarker := mmIconBreakpoint
  4951. else if (Line < AMemo.LineStateCount) and (AMemo.LineState[Line] <> lnUnknown) then
  4952. NewMarker := mmIconBreakpointGood
  4953. else
  4954. NewMarker := mmIconBreakpointBad;
  4955. end else begin
  4956. if Line < AMemo.LineStateCount then begin
  4957. case AMemo.LineState[Line] of
  4958. lnHasEntry: NewMarker := mmIconHasEntry;
  4959. lnEntryProcessed: NewMarker := mmIconEntryProcessed;
  4960. end;
  4961. end;
  4962. end;
  4963. { Delete all markers on the line. To flush out any possible duplicates,
  4964. even the markers we'll be adding next are deleted. }
  4965. if AMemo.GetMarkers(Line) <> [] then
  4966. AMemo.DeleteAllMarkersOnLine(Line);
  4967. if NewMarker <> -1 then
  4968. AMemo.AddMarker(Line, NewMarker);
  4969. if AMemo.StepLine = Line then
  4970. AMemo.AddMarker(Line, mmLineStep)
  4971. else if AMemo.ErrorLine = Line then
  4972. AMemo.AddMarker(Line, mmLineError)
  4973. else if NewMarker in [mmIconBreakpoint, mmIconBreakpointGood] then
  4974. AMemo.AddMarker(Line, mmLineBreakpoint)
  4975. else if NewMarker = mmIconBreakpointBad then
  4976. AMemo.AddMarker(Line, mmLineBreakpointBad);
  4977. end;
  4978. procedure TCompileForm.UpdateAllMemosLineMarkers;
  4979. var
  4980. Memo: TCompScintFileEdit;
  4981. Line: Integer;
  4982. begin
  4983. for Memo in FFileMemos do
  4984. if Memo.Used then
  4985. for Line := 0 to Memo.Lines.Count-1 do
  4986. UpdateLineMarkers(Memo, Line);
  4987. end;
  4988. procedure TCompileForm.UpdateBevel1Visibility;
  4989. begin
  4990. Bevel1.Visible := (FTheme.Colors[tcMarginBack] = ToolBarPanel.Color) and not MemosTabSet.Visible;
  4991. end;
  4992. function TCompileForm.ToCurrentPPI(const XY: Integer): Integer;
  4993. begin
  4994. Result := MulDiv(XY, CurrentPPI, 96);
  4995. end;
  4996. function TCompileForm.FromCurrentPPI(const XY: Integer): Integer;
  4997. begin
  4998. Result := MulDiv(XY, 96, CurrentPPI);
  4999. end;
  5000. initialization
  5001. InitThemeLibrary;
  5002. InitHtmlHelpLibrary;
  5003. { For ClearType support, try to make the default font Microsoft Sans Serif }
  5004. if DefFontData.Name = 'MS Sans Serif' then
  5005. DefFontData.Name := AnsiString(GetPreferredUIFont);
  5006. CoInitialize(nil);
  5007. finalization
  5008. CoUninitialize();
  5009. end.