CompForm.pas 181 KB

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