fpviews.pas 141 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998 by Berczi Gabor
  4. Views and view-related functions for the IDE
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit FPViews;
  12. {$i globdir.inc}
  13. interface
  14. uses
  15. Dos,Objects,Drivers,
  16. FVConsts,
  17. Views,Menus,Dialogs,StdDlg,App,Gadgets,Tabs,
  18. ASCIITAB,
  19. WEditor,WCEdit,
  20. WUtils,WHelp,WHlpView,WViews,WANSI,
  21. Comphook,
  22. {$ifndef NODEBUG}
  23. { Needed here for CORE_ADDR definition }
  24. {$ifdef GDBMI}
  25. gdbmiint,
  26. {$else GDBMI}
  27. gdbint,
  28. {$endif GDBMI}
  29. {$endif NODEBUG}
  30. FPConst,FPUsrScr;
  31. type
  32. TEditor = TCodeEditor;
  33. PEditor = PCodeEditor;
  34. PStoreCollection = ^TStoreCollection;
  35. TStoreCollection = object(TStringCollection)
  36. function Add(const S: string): PString;
  37. end;
  38. PIntegerLine = ^TIntegerLine;
  39. TIntegerLine = object(TInputLine)
  40. constructor Init(var Bounds: TRect; AMin, AMax: longint);
  41. end;
  42. PFPHeapView = ^TFPHeapView;
  43. TFPHeapView = object(THeapView)
  44. constructor Init(var Bounds: TRect);
  45. constructor InitKb(var Bounds: TRect);
  46. procedure HandleEvent(var Event: TEvent); virtual;
  47. end;
  48. PFPClockView = ^TFPClockView;
  49. TFPClockView = object(TClockView)
  50. constructor Init(var Bounds: TRect);
  51. procedure HandleEvent(var Event: TEvent); virtual;
  52. function GetPalette: PPalette; virtual;
  53. end;
  54. PFPWindow = ^TFPWindow;
  55. TFPWindow = object(TWindow)
  56. AutoNumber: boolean;
  57. procedure HandleEvent(var Event: TEvent); virtual;
  58. procedure SetState(AState: Word; Enable: Boolean); virtual;
  59. procedure UpdateCommands; virtual;
  60. constructor Load(var S: TStream);
  61. procedure Store(var S: TStream);
  62. procedure Update; virtual;
  63. procedure SelectInDebugSession;
  64. end;
  65. PFPHelpViewer = ^TFPHelpViewer;
  66. TFPHelpViewer = object(THelpViewer)
  67. function GetLocalMenu: PMenu; virtual;
  68. function GetCommandTarget: PView; virtual;
  69. end;
  70. PFPHelpWindow = ^TFPHelpWindow;
  71. TFPHelpWindow = object(THelpWindow)
  72. constructor Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
  73. destructor Done;virtual;
  74. procedure InitHelpView; virtual;
  75. procedure Show; {virtual;}
  76. procedure Hide; {virtual;}
  77. procedure HandleEvent(var Event: TEvent); virtual;
  78. function GetPalette: PPalette; virtual;
  79. constructor Load(var S: TStream);
  80. procedure Store(var S: TStream);
  81. end;
  82. PTextScroller = ^TTextScroller;
  83. TTextScroller = object(TStaticText)
  84. TopLine: integer;
  85. Speed : integer;
  86. Lines : PUnsortedStringCollection;
  87. constructor Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
  88. function GetLineCount: integer; virtual;
  89. function GetLine(I: integer): string; virtual;
  90. procedure HandleEvent(var Event: TEvent); virtual;
  91. procedure Update; virtual;
  92. procedure Reset; virtual;
  93. procedure Scroll; virtual;
  94. procedure Draw; virtual;
  95. destructor Done; virtual;
  96. private
  97. LastTT: longint;
  98. end;
  99. TAlign = (alLeft,alCenter,alRight);
  100. PFPToolTip = ^TFPToolTip;
  101. TFPToolTip = object(TView)
  102. constructor Init(var Bounds: TRect; const AText: string; AAlign: TAlign);
  103. procedure Draw; virtual;
  104. function GetText: string;
  105. procedure SetText(const AText: string);
  106. function GetAlign: TAlign;
  107. procedure SetAlign(AAlign: TAlign);
  108. function GetPalette: PPalette; virtual;
  109. destructor Done; virtual;
  110. private
  111. Text: PString;
  112. Align: TAlign;
  113. end;
  114. const cMaxNestnessChanges = 20;
  115. type
  116. TNestnessPoints = array[0..cMaxNestnessChanges-1] of record X,Y:sw_integer;NC:boolean; end;
  117. PSourceEditor = ^TSourceEditor;
  118. TSourceEditor = object(TFileEditor)
  119. CompileStamp : longint;
  120. CodeCompleteTip: PFPToolTip;
  121. {for nested comments managment}
  122. NestedComments : boolean;
  123. FixedNestedComments : TPoint;
  124. NestnessPoints:TNestnessPoints;
  125. NestPos : sw_integer;
  126. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  127. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  128. {$ifndef NODEBUG}
  129. private
  130. ShouldHandleBreakpoints : boolean;
  131. {$endif NODEBUG}
  132. public
  133. { Syntax highlight }
  134. function IsReservedWord(const S: string): boolean; virtual;
  135. function IsAsmReservedWord(const S: string): boolean; virtual;
  136. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  137. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring; virtual;
  138. function ParseSourceNestedComments(X,Y : sw_integer): boolean; virtual;
  139. function IsNestedComments(X,Y : sw_integer): boolean; virtual;
  140. function NestedCommentsChangeCheck(CurLine : sw_integer):boolean; virtual;
  141. { CodeTemplates }
  142. function TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
  143. function SelectCodeTemplate(var ShortCut: string): boolean; virtual;
  144. { CodeComplete }
  145. function CompleteCodeWord(const WordS: string; var Text: string): boolean; virtual;
  146. procedure FindMatchingDelimiter(ScanForward: boolean); virtual;
  147. procedure SetCodeCompleteWord(const S: string); virtual;
  148. procedure AlignCodeCompleteTip;
  149. procedure HandleEvent(var Event: TEvent); virtual;
  150. {$ifdef DebugUndo}
  151. procedure DumpUndo;
  152. procedure UndoAll;
  153. procedure RedoAll;
  154. {$endif DebugUndo}
  155. function Valid(Command: Word): Boolean;virtual;
  156. function GetLocalMenu: PMenu; virtual;
  157. function GetCommandTarget: PView; virtual;
  158. function CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup; virtual;
  159. procedure ModifiedChanged; virtual;
  160. procedure InsertOptions; virtual;
  161. procedure PushInfo(Const st : string);virtual;
  162. procedure PopInfo;virtual;
  163. procedure DeleteLine(I: sw_integer); virtual;
  164. procedure BackSpace; virtual;
  165. procedure DelChar; virtual;
  166. procedure DelSelect; virtual;
  167. function InsertNewLine : Sw_integer;virtual;
  168. function InsertLine(LineNo: sw_integer; const S: sw_astring): PCustomLine; virtual;
  169. procedure AddLine(const S: sw_astring); virtual;
  170. end;
  171. PSourceWindow = ^TSourceWindow;
  172. TSourceWindow = object(TFPWindow)
  173. Editor : PSourceEditor;
  174. Indicator : PIndicator;
  175. NoNameCount : longint;
  176. constructor Init(var Bounds: TRect; AFileName: string);
  177. function GetTitle(MaxSize: sw_Integer): TTitleStr; virtual;
  178. procedure SetTitle(ATitle: string); virtual;
  179. procedure UpdateTitle; virtual;
  180. procedure HandleEvent(var Event: TEvent); virtual;
  181. procedure Update; virtual;
  182. procedure UpdateCommands; virtual;
  183. function GetPalette: PPalette; virtual;
  184. constructor Load(var S: TStream);
  185. procedure Store(var S: TStream);
  186. destructor Done; virtual;
  187. end;
  188. {$ifndef NODEBUG}
  189. PGDBSourceEditor = ^TGDBSourceEditor;
  190. TGDBSourceEditor = object(TSourceEditor)
  191. function InsertNewLine : Sw_integer;virtual;
  192. function Valid(Command: Word): Boolean; virtual;
  193. procedure AddLine(const S: sw_astring); virtual;
  194. procedure AddErrorLine(const S: string); virtual;
  195. { Syntax highlight }
  196. function IsReservedWord(const S: string): boolean; virtual;
  197. private
  198. Silent,
  199. AutoRepeat,
  200. IgnoreStringAtEnd : boolean;
  201. LastCommand : String;
  202. end;
  203. PGDBWindow = ^TGDBWindow;
  204. TGDBWindow = object(TFPWindow)
  205. Editor : PGDBSourceEditor;
  206. Indicator : PIndicator;
  207. constructor Init(var Bounds: TRect);
  208. procedure HandleEvent(var Event: TEvent); virtual;
  209. procedure WriteText(Buf : PAnsiChar;IsError : boolean);
  210. procedure WriteString(Const S : string);
  211. procedure WriteErrorString(Const S : string);
  212. procedure WriteOutputText(Buf : PAnsiChar);
  213. procedure WriteErrorText(Buf : PAnsiChar);
  214. function GetPalette: PPalette;virtual;
  215. constructor Load(var S: TStream);
  216. procedure Store(var S: TStream);
  217. procedure UpdateCommands; virtual;
  218. destructor Done; virtual;
  219. end;
  220. PDisasLine = ^TDisasLine;
  221. TDisasLine = object(TLine)
  222. address : CORE_ADDR;{ should be target size of address for cross debuggers }
  223. end;
  224. PDisasLineCollection = ^TDisasLineCollection;
  225. TDisasLineCollection = object(TLineCollection)
  226. function At(Index: sw_Integer): PDisasLine;
  227. end;
  228. PDisassemblyEditor = ^TDisassemblyEditor;
  229. TDisassemblyEditor = object(TSourceEditor)
  230. CurrentSource : String;
  231. CurrentLine : longint;
  232. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  233. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  234. procedure ReleaseSource;
  235. destructor Done;virtual;
  236. procedure AddSourceLine(const AFileName: string;line : longint); virtual;
  237. procedure AddAssemblyLine(const S: string;AAddress : CORE_ADDR); virtual;
  238. function GetCurrentLine(address : CORE_ADDR) : PDisasLine;
  239. private
  240. Source : PSourceWindow;
  241. OwnsSource : Boolean;
  242. DisasLines : PDisasLineCollection;
  243. MinAddress,MaxAddress : CORE_ADDR;
  244. CurL : PDisasLine;
  245. end;
  246. PDisassemblyWindow = ^TDisassemblyWindow;
  247. TDisassemblyWindow = object(TFPWindow)
  248. Editor : PDisassemblyEditor;
  249. Indicator : PIndicator;
  250. constructor Init(var Bounds: TRect);
  251. procedure LoadFunction(Const FuncName : string);
  252. procedure LoadAddress(Addr : CORE_ADDR);
  253. function ProcessPChar(p : PAnsiChar) : boolean;
  254. procedure HandleEvent(var Event: TEvent); virtual;
  255. procedure WriteSourceString(Const S : string;line : longint);
  256. procedure WriteDisassemblyString(Const S : string;address : CORE_ADDR);
  257. procedure SetCurAddress(address : CORE_ADDR);
  258. procedure UpdateCommands; virtual;
  259. function GetPalette: PPalette;virtual;
  260. destructor Done; virtual;
  261. end;
  262. {$endif NODEBUG}
  263. PClipboardWindow = ^TClipboardWindow;
  264. TClipboardWindow = object(TSourceWindow)
  265. constructor Init;
  266. procedure Close; virtual;
  267. constructor Load(var S: TStream);
  268. procedure Store(var S: TStream);
  269. destructor Done; virtual;
  270. end;
  271. PMessageItem = ^TMessageItem;
  272. TMessageItem = object(TObject)
  273. TClass : longint;
  274. Text : PString;
  275. Module : PString;
  276. Row,Col : sw_integer;
  277. constructor Init(AClass: longint; const AText: string; AModule: PString; ARow, ACol: sw_integer);
  278. function GetText(MaxLen: Sw_integer): string; virtual;
  279. procedure Selected; virtual;
  280. function GetModuleName: string; virtual;
  281. destructor Done; virtual;
  282. end;
  283. PMessageListBox = ^TMessageListBox;
  284. TMessageListBox = object(THSListBox)
  285. Transparent : boolean;
  286. NoSelection : boolean;
  287. MaxWidth : Sw_integer;
  288. ModuleNames : PStoreCollection;
  289. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  290. procedure SetState(AState: Word; Enable: Boolean); virtual;
  291. procedure AddItem(P: PMessageItem); virtual;
  292. function AddModuleName(const Name: string): PString; virtual;
  293. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  294. procedure Clear; virtual;
  295. procedure TrackSource; virtual;
  296. procedure GotoSource; virtual;
  297. procedure Draw; virtual;
  298. procedure HandleEvent(var Event: TEvent); virtual;
  299. function GetLocalMenu: PMenu; virtual;
  300. constructor Load(var S: TStream);
  301. procedure Store(var S: TStream);
  302. destructor Done; virtual;
  303. end;
  304. PFPDlgWindow = ^TFPDlgWindow;
  305. TFPDlgWindow = object(TDlgWindow)
  306. procedure HandleEvent(var Event: TEvent); virtual;
  307. end;
  308. (*
  309. PTabItem = ^TTabItem;
  310. TTabItem = record
  311. Next : PTabItem;
  312. View : PView;
  313. Dis : boolean;
  314. end;
  315. PTabDef = ^TTabDef;
  316. TTabDef = record
  317. Next : PTabDef;
  318. Name : PString;
  319. Items : PTabItem;
  320. DefItem : PView;
  321. ShortCut : AnsiChar;
  322. end;
  323. PTab = ^TTab;
  324. TTab = object(TGroup)
  325. TabDefs : PTabDef;
  326. ActiveDef : integer;
  327. DefCount : word;
  328. constructor Init(var Bounds: TRect; ATabDef: PTabDef);
  329. function AtTab(Index: integer): PTabDef; virtual;
  330. procedure SelectTab(Index: integer); virtual;
  331. function TabCount: integer;
  332. procedure SelectNextTab(Forwards: boolean);
  333. function Valid(Command: Word): Boolean; virtual;
  334. procedure ChangeBounds(var Bounds: TRect); virtual;
  335. procedure HandleEvent(var Event: TEvent); virtual;
  336. function GetPalette: PPalette; virtual;
  337. procedure Draw; virtual;
  338. procedure SetState(AState: Word; Enable: Boolean); virtual;
  339. destructor Done; virtual;
  340. private
  341. InDraw: boolean;
  342. end;
  343. *)
  344. PScreenView = ^TScreenView;
  345. TScreenView = object(TScroller)
  346. Screen: PScreen;
  347. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  348. AScreen: PScreen);
  349. procedure Draw; virtual;
  350. procedure Update; virtual;
  351. procedure HandleEvent(var Event: TEvent); virtual;
  352. end;
  353. PScreenWindow = ^TScreenWindow;
  354. TScreenWindow = object(TFPWindow)
  355. ScreenView : PScreenView;
  356. constructor Init(AScreen: PScreen; ANumber: integer);
  357. destructor Done; virtual;
  358. end;
  359. PFPChDirDialog = ^TFPChDirDialog;
  360. TFPChDirDialog = object(TEditChDirDialog)
  361. constructor Init(AOptions: Word; HistoryId: Sw_Word);
  362. end;
  363. PFPAboutDialog = ^TFPAboutDialog;
  364. TFPAboutDialog = object(TCenterDialog)
  365. constructor Init;
  366. procedure ToggleInfo;
  367. procedure HandleEvent(var Event: TEvent); virtual;
  368. private
  369. Scroller: PTextScroller;
  370. TitleST : PStaticText;
  371. end;
  372. PFPASCIIChart = ^TFPASCIIChart;
  373. TFPASCIIChart = object(TASCIIChart)
  374. constructor Init;
  375. constructor Load(var S: TStream);
  376. procedure Store(var S: TStream);
  377. procedure HandleEvent(var Event: TEvent); virtual;
  378. destructor Done; virtual;
  379. end;
  380. PVideoModeListBox = ^TVideoModeListBox;
  381. TVideoModeListBox = object(TDropDownListBox)
  382. function GetText(Item: pointer; MaxLen: sw_integer): string; virtual;
  383. end;
  384. PFPDesktop = ^TFPDesktop;
  385. TFPDesktop = object(TDesktop)
  386. constructor Init(var Bounds: TRect);
  387. procedure InitBackground; virtual;
  388. constructor Load(var S: TStream);
  389. procedure Store(var S: TStream);
  390. end;
  391. PFPMemo = ^TFPMemo;
  392. TFPMemo = object(TCodeEditor)
  393. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  394. PScrollBar; AIndicator: PIndicator);
  395. function IsReservedWord(const S: string): boolean; virtual;
  396. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  397. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring; virtual;
  398. function GetPalette: PPalette; virtual;
  399. procedure HandleEvent(var Event: TEvent); virtual;
  400. end;
  401. PFPCodeMemo = ^TFPCodeMemo;
  402. TFPCodeMemo = object(TFPMemo)
  403. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  404. PScrollBar; AIndicator: PIndicator);
  405. function IsReservedWord(const S: string): boolean; virtual;
  406. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  407. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring; virtual;
  408. end;
  409. function SearchFreeWindowNo: integer;
  410. function IsWindow(P: PView): boolean;
  411. function IsThereAnyEditor: boolean;
  412. function IsThereAnyWindow: boolean;
  413. function IsThereAnyVisibleWindow: boolean;
  414. function IsThereAnyVisibleEditorWindow: boolean; {any visible Source Editor, including Clipboard}
  415. function IsThereAnyNumberedWindow: boolean;
  416. function FirstEditorWindow: PSourceWindow;
  417. function EditorWindowFile(const Name : String): PSourceWindow;
  418. procedure AskToReloadAllModifiedFiles;
  419. {$ifndef NODEBUG}
  420. function InDisassemblyWindow :boolean;
  421. {$endif NODEBUG}
  422. function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
  423. procedure DisposeTabItem(P: PTabItem);
  424. function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
  425. procedure DisposeTabDef(P: PTabDef);
  426. function GetEditorCurWord(Editor: PEditor; ValidSpecChars: TCharSet): string;
  427. procedure InitReservedWords;
  428. procedure DoneReservedWords;
  429. function GetReservedWordCount: integer;
  430. function GetReservedWord(Index: integer): string;
  431. function GetAsmReservedWordCount: integer;
  432. function GetAsmReservedWord(Index: integer): string;
  433. procedure TranslateMouseClick(View: PView; var Event: TEvent);
  434. function GetNextEditorBounds(var Bounds: TRect): boolean;
  435. function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
  436. function IOpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer; ShowIt: boolean): PSourceWindow;
  437. function LastSourceEditor : PSourceWindow;
  438. function SearchOnDesktop(FileName : string;tryexts:boolean) : PSourceWindow;
  439. function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts: boolean): PSourceWindow;
  440. function TryToOpenFileMulti(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts: boolean): PSourceWindow;
  441. function ITryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts, ShowIt,
  442. ForceNewWindow:boolean): PSourceWindow;
  443. function LocateSourceFile(const FileName: string; tryexts: boolean): string;
  444. function SearchWindow(const Title: string): PWindow;
  445. function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
  446. {$ifdef VESA}
  447. procedure InitVESAScreenModes;
  448. procedure DoneVESAScreenModes;
  449. {$endif}
  450. procedure NoDebugger;
  451. const
  452. SourceCmds : TCommandSet =
  453. ([cmSave,cmSaveAs,cmCompile,cmHide,cmDoReload]);
  454. EditorCmds : TCommandSet =
  455. ([cmPrint,cmFind,cmReplace,cmSearchAgain,cmJumpLine,cmHelpTopicSearch,cmSelectAll,cmUnselect]);
  456. CompileCmds : TCommandSet =
  457. ([cmMake,cmBuild,cmRun]);
  458. CalcClipboard : extended = 0;
  459. OpenFileName : string = '';
  460. OpenFileLastExt : string[12] = '*.pas';
  461. NewEditorOpened : boolean = false;
  462. var MsgParms : array[1..10] of
  463. record
  464. case byte of
  465. 0 : (Ptr : pointer);
  466. 1 : (Long: longint);
  467. end;
  468. const menu_key_common_copy_borland = 'Ctrl+Ins';
  469. menu_key_common_copy_microsoft = 'Ctrl+C';
  470. menu_key_edit_undo = 'Alt+BkSp';
  471. menu_key_edit_cut_borland = 'Shift+Del';
  472. menu_key_edit_copy_borland = menu_key_common_copy_borland;
  473. menu_key_edit_paste_borland = 'Shift+Ins';
  474. menu_key_edit_cut_microsoft = 'Ctrl+X';
  475. menu_key_edit_copy_microsoft = menu_key_common_copy_microsoft;
  476. menu_key_edit_paste_microsoft = 'Ctrl+V';
  477. menu_key_edit_all_borland = '';
  478. menu_key_edit_clear = 'Ctrl+Del';
  479. menu_key_common_helpindex = 'Shift+F1';
  480. menu_key_common_topicsearch = 'Ctrl+F1';
  481. menu_key_common_prevtopic = 'Alt+F1';
  482. menu_key_help_helpindex= menu_key_common_helpindex;
  483. menu_key_help_topicsearch = menu_key_common_topicsearch;
  484. menu_key_help_prevtopic= menu_key_common_prevtopic;
  485. menu_key_hlplocal_index = menu_key_common_helpindex;
  486. menu_key_hlplocal_topicsearch = menu_key_common_topicsearch;
  487. menu_key_hlplocal_prevtopic = menu_key_common_prevtopic;
  488. menu_key_hlplocal_copy_borland = menu_key_common_copy_borland;
  489. menu_key_hlplocal_copy_microsoft = menu_key_common_copy_microsoft;
  490. {Configurable keys.}
  491. const menu_key_edit_cut:string[63]=menu_key_edit_cut_borland;
  492. menu_key_edit_copy:string[63]=menu_key_edit_copy_borland;
  493. menu_key_edit_paste:string[63]=menu_key_edit_paste_borland;
  494. menu_key_edit_all:string[63]=menu_key_edit_all_borland;
  495. menu_key_hlplocal_copy:string[63]=menu_key_hlplocal_copy_borland;
  496. procedure RegisterFPViews;
  497. implementation
  498. uses
  499. Video,Strings,Keyboard,Validate,
  500. globtype,Tokens,Version,
  501. systems,cpubase,
  502. {$ifdef jvm}
  503. //itcpujas,
  504. {$else}
  505. itcpugas,
  506. {$endif jvm}
  507. {$if defined(I386) or defined(x64_86)}
  508. rax86,
  509. {$endif}
  510. {$ifdef m68k}
  511. ag68kgas,
  512. {$endif}
  513. {$ifdef USE_EXTERNAL_COMPILER}
  514. fpintf, { superseeds version_string of version unit }
  515. {$endif USE_EXTERNAL_COMPILER}
  516. {$ifdef VESA}Vesa,{$endif}
  517. FPSymbol,FPDebug,FPVars,FPUtils,FPCompil,FPHelp,
  518. FPTools,FPIDE,FPCodTmp,FPCodCmp,FPSwitch;
  519. const
  520. RSourceEditor: TStreamRec = (
  521. ObjType: 1500;
  522. VmtLink: Ofs(TypeOf(TSourceEditor)^);
  523. Load: @TSourceEditor.Load;
  524. Store: @TSourceEditor.Store
  525. );
  526. RSourceWindow: TStreamRec = (
  527. ObjType: 1501;
  528. VmtLink: Ofs(TypeOf(TSourceWindow)^);
  529. Load: @TSourceWindow.Load;
  530. Store: @TSourceWindow.Store
  531. );
  532. RFPHelpViewer: TStreamRec = (
  533. ObjType: 1502;
  534. VmtLink: Ofs(TypeOf(TFPHelpViewer)^);
  535. Load: @TFPHelpViewer.Load;
  536. Store: @TFPHelpViewer.Store
  537. );
  538. RFPHelpWindow: TStreamRec = (
  539. ObjType: 1503;
  540. VmtLink: Ofs(TypeOf(TFPHelpWindow)^);
  541. Load: @TFPHelpWindow.Load;
  542. Store: @TFPHelpWindow.Store
  543. );
  544. RClipboardWindow: TStreamRec = (
  545. ObjType: 1504;
  546. VmtLink: Ofs(TypeOf(TClipboardWindow)^);
  547. Load: @TClipboardWindow.Load;
  548. Store: @TClipboardWindow.Store
  549. );
  550. RMessageListBox: TStreamRec = (
  551. ObjType: 1505;
  552. VmtLink: Ofs(TypeOf(TMessageListBox)^);
  553. Load: @TMessageListBox.Load;
  554. Store: @TMessageListBox.Store
  555. );
  556. RFPDesktop: TStreamRec = (
  557. ObjType: 1506;
  558. VmtLink: Ofs(TypeOf(TFPDesktop)^);
  559. Load: @TFPDesktop.Load;
  560. Store: @TFPDesktop.Store
  561. );
  562. RFPASCIIChart: TStreamRec = (
  563. ObjType: 1509;
  564. VmtLink: Ofs(TypeOf(TFPASCIIChart)^);
  565. Load: @TFPASCIIChart.Load;
  566. Store: @TFPASCIIChart.Store
  567. );
  568. RFPDlgWindow: TStreamRec = (
  569. ObjType: 1511;
  570. VmtLink: Ofs(TypeOf(TFPDlgWindow)^);
  571. Load: @TFPDlgWindow.Load;
  572. Store: @TFPDlgWindow.Store
  573. );
  574. {$ifndef NODEBUG}
  575. RGDBWindow: TStreamRec = (
  576. ObjType: 1508;
  577. VmtLink: Ofs(TypeOf(TGDBWindow)^);
  578. Load: @TGDBWindow.Load;
  579. Store: @TGDBWindow.Store
  580. );
  581. RGDBSourceEditor: TStreamRec = (
  582. ObjType: 1507;
  583. VmtLink: Ofs(TypeOf(TGDBSourceEditor)^);
  584. Load: @TGDBSourceEditor.Load;
  585. Store: @TGDBSourceEditor.Store
  586. );
  587. RDisassemblyEditor: TStreamRec = (
  588. ObjType: 1512;
  589. VmtLink: Ofs(TypeOf(TDisassemblyEditor)^);
  590. Load: @TDisassemblyEditor.Load;
  591. Store: @TDisassemblyEditor.Store
  592. );
  593. RDisassemblyWindow: TStreamRec = (
  594. ObjType: 1513;
  595. VmtLink: Ofs(TypeOf(TDisassemblyWindow)^);
  596. Load: @TDisassemblyWindow.Load;
  597. Store: @TDisassemblyWindow.Store
  598. );
  599. {$endif NODEBUG}
  600. const
  601. GlobalNoNameCount : integer = 0;
  602. var
  603. ReservedWords : array[1..ReservedWordMaxLen] of PStringCollection;
  604. AsmReservedWords : array[1..ReservedWordMaxLen] of PStringCollection;
  605. {$ifdef useresstrings}
  606. resourcestring
  607. {$else}
  608. const
  609. {$endif}
  610. { Source editor local menu items }
  611. menu_srclocal_openfileatcursor = 'Open ~f~ile at cursor';
  612. menu_srclocal_browseatcursor = '~B~rowse symbol at cursor';
  613. menu_srclocal_topicsearch = 'Topic ~s~earch';
  614. menu_srclocal_options = '~O~ptions...';
  615. menu_srclocal_reload = '~R~eload modified file';
  616. { Help viewer local menu items }
  617. menu_hlplocal_debug = 'Debug infos';
  618. menu_hlplocal_contents = '~C~ontents';
  619. menu_hlplocal_index = '~I~ndex';
  620. menu_hlplocal_topicsearch = '~T~opic search';
  621. menu_hlplocal_prevtopic = '~P~revious topic';
  622. menu_hlplocal_copy = '~C~opy';
  623. { Messages local menu items }
  624. menu_msglocal_clear = '~C~lear';
  625. menu_msglocal_gotosource = '~G~oto source';
  626. menu_msglocal_tracksource = '~T~rack source';
  627. menu_edit_cut = 'Cu~t~';
  628. menu_edit_copy = '~C~opy';
  629. menu_edit_paste = '~P~aste';
  630. menu_edit_clear = 'C~l~ear';
  631. msg_errorreadingfile = 'Error reading file %s';
  632. msg_loadingfile = 'Loading %s';
  633. msg_storingfile = 'Storing %s';
  634. msg_closingfile = 'Closing %s';
  635. dialog_gdbwindow = 'GDB window';
  636. dialog_disaswindow = 'Disassembly window';
  637. dialog_clipboard = 'Clipboard';
  638. dialog_userscreen = 'User screen';
  639. dialog_about = 'About';
  640. label_about_compilerversion = 'Compiler Version';
  641. label_about_debugger = 'Debugger';
  642. menu_msglocal_saveas = 'Save ~a~s';
  643. msg_openingsourcefile = 'Opening source file... (%s)';
  644. msg_readingfileineditor = 'Reading %s into editor...';
  645. msg_nodebuggersupportavailable = 'No debugger support available.';
  646. {****************************************************************************
  647. TStoreCollection
  648. ****************************************************************************}
  649. function TStoreCollection.Add(const S: string): PString;
  650. var P: PString;
  651. Index: Sw_integer;
  652. begin
  653. if S='' then P:=nil else
  654. if Search(@S,Index) then P:=At(Index) else
  655. begin
  656. P:=NewStr(S);
  657. Insert(P);
  658. end;
  659. Add:=P;
  660. end;
  661. function IsThereAnyEditor: boolean;
  662. function EditorWindow(P: PView): boolean;
  663. begin
  664. EditorWindow:=(P^.HelpCtx=hcSourceWindow);
  665. end;
  666. begin
  667. IsThereAnyEditor:=Desktop^.FirstThat(@EditorWindow)<>nil;
  668. end;
  669. procedure AskToReloadAllModifiedFiles;
  670. procedure EditorWindowModifiedOnDisk(P: PView);
  671. begin
  672. if (P^.HelpCtx=hcSourceWindow) then
  673. PSourceWindow(P)^.Editor^.ReloadFile;
  674. end;
  675. begin
  676. Desktop^.ForEach(TCallbackProcParam(@EditorWindowModifiedOnDisk));
  677. end;
  678. function IsThereAnyHelpWindow: boolean;
  679. begin
  680. IsThereAnyHelpWindow:=(HelpWindow<>nil) and (HelpWindow^.GetState(sfVisible));
  681. end;
  682. function IsThereAnyNumberedWindow: boolean;
  683. var _Is: boolean;
  684. begin
  685. _Is:=Message(Desktop,evBroadcast,cmSearchWindow,nil)<>nil;
  686. _Is:=_Is or ( (ClipboardWindow<>nil) and ClipboardWindow^.GetState(sfVisible));
  687. IsThereAnyNumberedWindow:=_Is;
  688. end;
  689. function IsWindow(P: PView): boolean;
  690. var OK: boolean;
  691. begin
  692. OK:=false;
  693. if (P^.HelpCtx=hcSourceWindow) or
  694. (P^.HelpCtx=hcHelpWindow) or
  695. (P^.HelpCtx=hcClipboardWindow) or
  696. (P^.HelpCtx=hcCalcWindow) or
  697. (P^.HelpCtx=hcInfoWindow) or
  698. (P^.HelpCtx=hcBrowserWindow) or
  699. (P^.HelpCtx=hcMessagesWindow) or
  700. (P^.HelpCtx=hcCompilerMessagesWindow) or
  701. (P^.HelpCtx=hcGDBWindow) or
  702. (P^.HelpCtx=hcdisassemblyWindow) or
  703. (P^.HelpCtx=hcWatchesWindow) or
  704. (P^.HelpCtx=hcRegistersWindow) or
  705. (P^.HelpCtx=hcFPURegisters) or
  706. (P^.HelpCtx=hcVectorRegisters) or
  707. (P^.HelpCtx=hcStackWindow) or
  708. (P^.HelpCtx=hcBreakpointListWindow) or
  709. (P^.HelpCtx=hcASCIITableWindow)
  710. then
  711. OK:=true;
  712. IsWindow:=OK;
  713. end;
  714. function IsThereAnyWindow: boolean;
  715. function CheckIt(P: PView): boolean;
  716. begin
  717. CheckIt:=IsWindow(P);
  718. end;
  719. begin
  720. IsThereAnyWindow:=Desktop^.FirstThat(@CheckIt)<>nil;
  721. end;
  722. function IsThereAnyVisibleWindow: boolean;
  723. function CheckIt(P: PView): boolean;
  724. begin
  725. CheckIt:=IsWindow(P) and P^.GetState(sfVisible);
  726. end;
  727. begin
  728. IsThereAnyVisibleWindow:=Desktop^.FirstThat(@CheckIt)<>nil;
  729. end;
  730. function IsThereAnyVisibleEditorWindow: boolean;
  731. function EditorWindow(P: PView): boolean;
  732. begin
  733. EditorWindow:=((P^.HelpCtx=hcSourceWindow) or (P^.HelpCtx=hcClipboardWindow)) and P^.GetState(sfVisible);
  734. end;
  735. begin
  736. IsThereAnyVisibleEditorWindow:=Desktop^.FirstThat(@EditorWindow)<>nil;
  737. end;
  738. function FirstEditorWindow: PSourceWindow;
  739. function EditorWindow(P: PView): boolean;
  740. begin
  741. EditorWindow:=(P^.HelpCtx=hcSourceWindow);
  742. end;
  743. begin
  744. FirstEditorWindow:=pointer(Desktop^.FirstThat(@EditorWindow));
  745. end;
  746. function EditorWindowFile(const Name : String): PSourceWindow;
  747. var
  748. SName : string;
  749. function EditorWindow(P: PView): boolean;
  750. begin
  751. EditorWindow:=(TypeOf(P^)=TypeOf(TSourceWindow)) and
  752. (FixFileName(PSourceWindow(P)^.Editor^.FileName)=SName);
  753. end;
  754. begin
  755. SName:=FixFileName(FExpand(Name));
  756. EditorWindowFile:=pointer(Desktop^.FirstThat(@EditorWindow));
  757. end;
  758. {$ifndef NODEBUG}
  759. function InDisassemblyWindow :boolean;
  760. var
  761. PW : PWindow;
  762. function CheckIt(P: PView): boolean;
  763. begin
  764. CheckIt:=IsWindow(P) and P^.GetState(sfVisible) and
  765. (P^.HelpCtx <> hcWatchesWindow) and
  766. (P^.HelpCtx <> hcStackWindow) and
  767. (P^.HelpCtx <> hcRegistersWindow) and
  768. (P^.HelpCtx <> hcVectorRegisters) and
  769. (P^.HelpCtx <> hcFPURegisters);
  770. end;
  771. begin
  772. PW:=PWindow(Desktop^.FirstThat(@CheckIt));
  773. InDisassemblyWindow:=Assigned(PW) and
  774. (TypeOf(PW^)=TypeOf(TDisassemblyWindow));
  775. end;
  776. {$endif NODEBUG}
  777. function GetEditorCurWord(Editor: PEditor; ValidSpecChars: TCharSet): string;
  778. var S: string;
  779. PS,PE: byte;
  780. function Trim(S: string): string;
  781. const TrimChars : set of AnsiChar = [#0,#9,' ',#255];
  782. begin
  783. while (length(S)>0) and (S[1] in TrimChars) do Delete(S,1,1);
  784. while (length(S)>0) and (S[length(S)] in TrimChars) do Delete(S,length(S),1);
  785. Trim:=S;
  786. end;
  787. const AlphaNum : set of AnsiChar = ['A'..'Z','0'..'9','_'];
  788. begin
  789. with Editor^ do
  790. begin
  791. S:=GetDisplayText(CurPos.Y);
  792. PS:=CurPos.X; while (PS>0) and (Upcase(S[PS]) in AlphaNum) do Dec(PS);
  793. PE:=CurPos.X; while (PE<length(S)) and (Upcase(S[PE+1]) in (AlphaNum+ValidSpecChars)) do Inc(PE);
  794. S:=Trim(copy(S,PS+1,PE-PS));
  795. end;
  796. GetEditorCurWord:=S;
  797. end;
  798. {*****************************************************************************
  799. Tab
  800. *****************************************************************************}
  801. function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
  802. var P: PTabItem;
  803. begin
  804. New(P); FillChar(P^,SizeOf(P^),0);
  805. P^.Next:=ANext; P^.View:=AView;
  806. NewTabItem:=P;
  807. end;
  808. procedure DisposeTabItem(P: PTabItem);
  809. begin
  810. if P<>nil then
  811. begin
  812. if P^.View<>nil then Dispose(P^.View, Done);
  813. Dispose(P);
  814. end;
  815. end;
  816. function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
  817. var P: PTabDef;
  818. x: byte;
  819. begin
  820. New(P);
  821. P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
  822. x:=pos('~',AName);
  823. if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
  824. else P^.ShortCut:=#0;
  825. P^.DefItem:=ADefItem;
  826. NewTabDef:=P;
  827. end;
  828. procedure DisposeTabDef(P: PTabDef);
  829. var PI,X: PTabItem;
  830. begin
  831. DisposeStr(P^.Name);
  832. PI:=P^.Items;
  833. while PI<>nil do
  834. begin
  835. X:=PI^.Next;
  836. DisposeTabItem(PI);
  837. PI:=X;
  838. end;
  839. Dispose(P);
  840. end;
  841. {*****************************************************************************
  842. Reserved Words
  843. *****************************************************************************}
  844. function GetReservedWordCount: integer;
  845. var
  846. Count,I: integer;
  847. begin
  848. Count:=0;
  849. for I:=ord(Low(tToken)) to ord(High(tToken)) do
  850. with TokenInfo^[TToken(I)] do
  851. if (str<>'') and (str[1] in['A'..'Z']) and (length(str)>1) then
  852. Inc(Count);
  853. GetReservedWordCount:=Count;
  854. end;
  855. function GetReservedWord(Index: integer): string;
  856. var
  857. Count,Idx,I: integer;
  858. S: string;
  859. begin
  860. Idx:=-1;
  861. Count:=-1;
  862. I:=ord(Low(tToken));
  863. while (I<=ord(High(tToken))) and (Idx=-1) do
  864. with TokenInfo^[TToken(I)] do
  865. begin
  866. if (str<>'') and (str[1] in['A'..'Z']) and (length(str)>1) then
  867. begin
  868. Inc(Count);
  869. if Count=Index then
  870. Idx:=I;
  871. end;
  872. Inc(I);
  873. end;
  874. if Idx=-1 then
  875. S:=''
  876. else
  877. S:=TokenInfo^[TToken(Idx)].str;
  878. GetReservedWord:=S;
  879. end;
  880. {$ifdef powerpc}
  881. {$define USE_TasmCondFlag}
  882. { powerpc only has A_B prefix }
  883. const
  884. CondAsmOps = 1;
  885. CondAsmOpStr : array [0..CondAsmOps-1] of string[2] = ('b');
  886. {$define Use_gas_op2str}
  887. {$endif}
  888. {$ifdef powerpc64}
  889. {$define USE_TasmCondFlag}
  890. { powerpc64 only has A_B prefix }
  891. const
  892. CondAsmOps = 1;
  893. CondAsmOpStr : array [0..CondAsmOps-1] of string[2] = ('b');
  894. {$define Use_gas_op2str}
  895. {$endif}
  896. {$ifdef i386}
  897. {$define USE_TasmCond}
  898. {$define Use_std_op2str}
  899. {$endif}
  900. {$ifdef m68k}
  901. {$define USE_None}
  902. {$define Use_gas_op2str}
  903. {$endif}
  904. function GetAsmReservedWordCount: integer;
  905. begin
  906. GetAsmReservedWordCount:=ord(lastop) - ord(firstop)
  907. {$ifdef Use_TasmCond}
  908. + CondAsmOps*(ord(high(TasmCond))-ord(low(TasmCond)));
  909. {$endif Use_TasmCond}
  910. {$ifdef Use_TasmCondFlag}
  911. + CondAsmOps*(ord(high(TasmCondFlag))-ord(low(TasmCondFlag)));
  912. {$endif Use_TasmCondFlag}
  913. {$ifdef Use_None}
  914. ;
  915. {$endif Use_None}
  916. end;
  917. {$define NOASM}
  918. function GetAsmReservedWord(Index: integer): string;
  919. var
  920. CondNum,CondOpNum : integer;
  921. begin
  922. {$ifdef m68k}
  923. {$undef NOASM}
  924. if index <= ord(lastop) - ord(firstop) then
  925. GetAsmReservedWord:=gas_op2str[tasmop(Index+ord(firstop))]
  926. else
  927. GetAsmReservedWord:='';
  928. (*
  929. begin
  930. index:=index - (ord(lastop) - ord(firstop) );
  931. CondOpNum:= index div (ord(high(TasmCond))-ord(low(TasmCond)));
  932. CondNum:=index - (CondOpNum * (ord(high(TasmCond))-ord(low(TasmCond))));
  933. GetAsmReservedWord:=CondAsmOpStr[CondOpNum]+cond2str[TasmCond(CondNum+ord(low(TAsmCond))+1)];
  934. end;
  935. *)
  936. {$else not m68k}
  937. if index <= ord(lastop) - ord(firstop) then
  938. {$ifdef Use_gas_op2str}
  939. GetAsmReservedWord:=gas_op2str[tasmop(Index+ord(firstop))]
  940. {$endif Use_gas_op2str}
  941. {$ifdef Use_std_op2str}
  942. GetAsmReservedWord:=std_op2str[tasmop(Index+ord(firstop))]
  943. {$endif Use_std_op2str}
  944. {$ifdef Use_TASMCond}
  945. {$undef NOASM}
  946. else
  947. begin
  948. index:=index - (ord(lastop) - ord(firstop) );
  949. CondOpNum:= index div (ord(high(TasmCond))-ord(low(TasmCond)));
  950. CondNum:=index - (CondOpNum * (ord(high(TasmCond))-ord(low(TasmCond))));
  951. GetAsmReservedWord:=CondAsmOpStr[CondOpNum]+cond2str[TasmCond(CondNum+ord(low(TAsmCond))+1)];
  952. end;
  953. {$endif Use_TASMCond}
  954. {$ifdef Use_TASMCondFlag}
  955. {$undef NOASM}
  956. else
  957. begin
  958. index:=index - (ord(lastop) - ord(firstop) );
  959. CondOpNum:= index div (ord(high(TasmCondFlag))-ord(low(TasmCondFlag)));
  960. CondNum:=index - (CondOpNum * (ord(high(TasmCondFlag))-ord(low(TasmCondFlag))));
  961. GetAsmReservedWord:=CondAsmOpStr[CondOpNum]+AsmCondFlag2Str[TasmCondFlag(CondNum+ord(low(TAsmCondFlag))+1)];
  962. end;
  963. {$endif Use_TASMCond}
  964. {$endif not m68k}
  965. {$ifdef NOASM}
  966. GetAsmReservedWord:='';
  967. {$endif NOASM}
  968. end;
  969. procedure InitReservedWords;
  970. var WordS: string;
  971. Idx,I,J : sw_integer;
  972. begin
  973. InitTokens;
  974. for I:=Low(ReservedWords) to High(ReservedWords) do
  975. New(ReservedWords[I], Init(50,10));
  976. for I:=1 to GetReservedWordCount do
  977. begin
  978. WordS:=GetReservedWord(I-1); Idx:=length(WordS);
  979. if (Idx>=Low(ReservedWords)) and (Idx<=High(ReservedWords)) then
  980. ReservedWords[Idx]^.Insert(NewStr(WordS));
  981. end;
  982. for I:=Low(AsmReservedWords) to High(AsmReservedWords) do
  983. New(AsmReservedWords[I], Init(50,10));
  984. for I:=1 to GetAsmReservedWordCount do
  985. begin
  986. WordS:=UpcaseStr(GetAsmReservedWord(I-1)); Idx:=length(WordS);
  987. if (Idx>=Low(AsmReservedWords)) and (Idx<=High(AsmReservedWords)) then
  988. begin
  989. if not AsmReservedWords[Idx]^.Search(@WordS, J) then
  990. AsmReservedWords[Idx]^.Insert(NewStr(WordS));
  991. end;
  992. end;
  993. end;
  994. procedure DoneReservedWords;
  995. var I: integer;
  996. begin
  997. for I:=Low(ReservedWords) to High(ReservedWords) do
  998. if assigned(ReservedWords[I]) then
  999. begin
  1000. dispose(ReservedWords[I],done);
  1001. ReservedWords[I]:=nil;
  1002. end;
  1003. for I:=Low(AsmReservedWords) to High(AsmReservedWords) do
  1004. if assigned(AsmReservedWords[I]) then
  1005. begin
  1006. dispose(AsmReservedWords[I],done);
  1007. ReservedWords[I]:=nil;
  1008. end;
  1009. DoneTokens;
  1010. end;
  1011. function IsFPReservedWord(const S: string): boolean;
  1012. var _Is: boolean;
  1013. Idx,Item: sw_integer;
  1014. UpS: string;
  1015. begin
  1016. Idx:=length(S); _Is:=false;
  1017. if (Low(ReservedWords)<=Idx) and (Idx<=High(ReservedWords)) and
  1018. (ReservedWords[Idx]<>nil) and (ReservedWords[Idx]^.Count<>0) then
  1019. begin
  1020. UpS:=UpcaseStr(S);
  1021. _Is:=ReservedWords[Idx]^.Search(@UpS,Item);
  1022. end;
  1023. IsFPReservedWord:=_Is;
  1024. end;
  1025. function IsFPAsmReservedWord(S: string): boolean;
  1026. var _Is: boolean;
  1027. Idx,Item,Len: sw_integer;
  1028. LastC : AnsiChar;
  1029. LastTwo : String[2];
  1030. begin
  1031. Idx:=length(S); _Is:=false;
  1032. if (Low(AsmReservedWords)<=Idx) and (Idx<=High(AsmReservedWords)) and
  1033. (AsmReservedWords[Idx]<>nil) and (AsmReservedWords[Idx]^.Count<>0) then
  1034. begin
  1035. S:=UpcaseStr(S);
  1036. _Is:=AsmReservedWords[Idx]^.Search(@S,Item);
  1037. {$ifdef i386}
  1038. if not _Is and (Length(S)>1) then
  1039. begin
  1040. LastC:=S[Length(S)];
  1041. if LastC in ['B','D','L','Q','S','T','V','W'] then
  1042. begin
  1043. Delete(S,Length(S),1);
  1044. Dec(Idx);
  1045. if (AsmReservedWords[Idx]<>nil) and (AsmReservedWords[Idx]^.Count<>0) then
  1046. _Is:=AsmReservedWords[Idx]^.Search(@S,Item);
  1047. if not _Is and (Length(S)>1) then
  1048. begin
  1049. LastTwo:=S[Length(S)]+LastC;
  1050. if (LastTwo='BL') or
  1051. (LastTwo='WL') or
  1052. (LastTwo='BW') then
  1053. begin
  1054. Delete(S,Length(S),1);
  1055. Dec(Idx);
  1056. if (AsmReservedWords[Idx]<>nil) and (AsmReservedWords[Idx]^.Count<>0) then
  1057. _Is:=AsmReservedWords[Idx]^.Search(@S,Item);
  1058. end;
  1059. end;
  1060. end;
  1061. end;
  1062. {$endif i386}
  1063. end;
  1064. IsFPAsmReservedWord:=_Is;
  1065. end;
  1066. {*****************************************************************************
  1067. SearchWindow
  1068. *****************************************************************************}
  1069. function SearchWindowWithNo(No: integer): PWindow;
  1070. var P: PWindow;
  1071. begin
  1072. P:=Message(Desktop,evBroadcast,cmSearchWindow+No,nil);
  1073. if pointer(P)=pointer(Desktop) then P:=nil;
  1074. SearchWindowWithNo:=P;
  1075. end;
  1076. function SearchWindow(const Title: string): PWindow;
  1077. function Match(P: PView): boolean;
  1078. var W: PWindow;
  1079. OK: boolean;
  1080. begin
  1081. W:=nil;
  1082. { we have a crash here because of the TStatusLine
  1083. that can also have one of these values
  1084. but is not a Window object PM }
  1085. if P<>pointer(StatusLine) then
  1086. if IsWindow(P) then
  1087. W:=PWindow(P);
  1088. OK:=(W<>nil);
  1089. if OK then
  1090. begin
  1091. OK:=CompareText(W^.GetTitle(255),Title)=0;
  1092. end;
  1093. Match:=OK;
  1094. end;
  1095. var W: PView;
  1096. begin
  1097. W:=Application^.FirstThat(@Match);
  1098. { This is wrong because TStatusLine is also considered PM }
  1099. if not Assigned(W) then W:=Desktop^.FirstThat(@Match);
  1100. { But why do we need to check all ??
  1101. Probably because of the ones which were not inserted into
  1102. Desktop as the Messages view
  1103. Exactly. Some windows are inserted directly in the Application and not
  1104. in the Desktop. btw. Does TStatusLine.HelpCtx really change? Why?
  1105. Only GetHelpCtx should return different values depending on the
  1106. focused view (and it's helpctx), but TStatusLine's HelpCtx field
  1107. shouldn't change... Gabor
  1108. if Assigned(W)=false then W:=Desktop^.FirstThat(@Match);}
  1109. SearchWindow:=PWindow(W);
  1110. end;
  1111. function SearchFreeWindowNo: integer;
  1112. var No: integer;
  1113. begin
  1114. No:=1;
  1115. while (No<100) and (SearchWindowWithNo(No)<>nil) do
  1116. Inc(No);
  1117. if No=100 then No:=0;
  1118. SearchFreeWindowNo:=No;
  1119. end;
  1120. {*****************************************************************************
  1121. TIntegerLine
  1122. *****************************************************************************}
  1123. constructor TIntegerLine.Init(var Bounds: TRect; AMin, AMax: longint);
  1124. begin
  1125. if inherited Init(Bounds, Bounds.B.X-Bounds.A.X-1)=false then
  1126. Fail;
  1127. Validator:=New(PRangeValidator, Init(AMin, AMax));
  1128. end;
  1129. {*****************************************************************************
  1130. SourceEditor
  1131. *****************************************************************************}
  1132. function SearchCoreForFileName(AFileName: string): PCodeEditorCore;
  1133. var EC: PCodeEditorCore;
  1134. function Check(P: PView): boolean;
  1135. var OK: boolean;
  1136. begin
  1137. OK:=P^.HelpCtx=hcSourceWindow;
  1138. if OK then
  1139. with PSourceWindow(P)^ do
  1140. if FixFileName(Editor^.FileName)=AFileName then
  1141. begin
  1142. EC:=Editor^.Core;
  1143. OK:=true;
  1144. end
  1145. else
  1146. OK:=false;
  1147. Check:=OK;
  1148. end;
  1149. begin
  1150. EC:=nil;
  1151. AFileName:=FixFileName(AFileName);
  1152. { do not use the same core for all new files }
  1153. if AFileName<>'' then
  1154. Desktop^.FirstThat(@Check);
  1155. SearchCoreForFileName:=EC;
  1156. end;
  1157. constructor TSourceEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  1158. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  1159. var EC: PCodeEditorCore;
  1160. begin
  1161. EC:=SearchCoreForFileName(AFileName);
  1162. inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,EC,AFileName);
  1163. SetStoreUndo(true);
  1164. CompileStamp:=0;
  1165. FixedNestedComments.Y:=2000001;
  1166. NestedComments:=false;
  1167. end;
  1168. Const
  1169. FreePascalSpecSymbolCount : array [TSpecSymbolClass] of integer =
  1170. (
  1171. 3,{ssCommentPrefix}
  1172. 1,{ssCommentSingleLinePrefix}
  1173. 2,{ssCommentSuffix}
  1174. 1,{ssStringPrefix}
  1175. 1,{ssStringSuffix}
  1176. 2,{ssDirectivePrefix}
  1177. {2,}{ssDirectiveSuffix}
  1178. 1,{ssAsmPrefix}
  1179. 1 {ssAsmSuffix}
  1180. );
  1181. FreePascalEmptyString : string[1] = '';
  1182. FreePascalCommentPrefix1 : string[1] = '{';
  1183. FreePascalCommentPrefix2 : string[2] = '(*';
  1184. FreePascalCommentPrefix3 : string[2] = '//';
  1185. FreePascalCommentSingleLinePrefix : string[2] = '//';
  1186. FreePascalCommentSuffix1 : string[1] = '}';
  1187. FreePascalCommentSuffix2 : string[2] = '*)';
  1188. FreePascalStringPrefix : string[1] = '''';
  1189. FreePascalStringSuffix : string[1] = '''';
  1190. FreePascalDirectivePrefix1 : string[2] = '{$';
  1191. FreePascalDirectivePrefix2 : string[3] = '(*$';
  1192. //FreePascalDirectiveSuffix1 : string[1] = '}';
  1193. //FreePascalDirectiveSuffix2 : string[2] = '*)';
  1194. FreePascalAsmPrefix : string[3] = 'ASM';
  1195. FreePascalAsmSuffix : string[3] = 'END';
  1196. function TSourceEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  1197. begin
  1198. GetSpecSymbolCount:=FreePascalSpecSymbolCount[SpecClass];
  1199. end;
  1200. function TSourceEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring;
  1201. begin
  1202. GetSpecSymbol:=@FreePascalEmptyString;
  1203. case SpecClass of
  1204. ssCommentPrefix :
  1205. case Index of
  1206. 0 : GetSpecSymbol:=@FreePascalCommentPrefix1;
  1207. 1 : GetSpecSymbol:=@FreePascalCommentPrefix2;
  1208. 2 : GetSpecSymbol:=@FreePascalCommentPrefix3;
  1209. end;
  1210. ssCommentSingleLinePrefix :
  1211. case Index of
  1212. 0 : GetSpecSymbol:=@FreePascalCommentSingleLinePrefix;
  1213. end;
  1214. ssCommentSuffix :
  1215. case Index of
  1216. 0 : GetSpecSymbol:=@FreePascalCommentSuffix1;
  1217. 1 : GetSpecSymbol:=@FreePascalCommentSuffix2;
  1218. end;
  1219. ssStringPrefix :
  1220. GetSpecSymbol:=@FreePascalStringPrefix;
  1221. ssStringSuffix :
  1222. GetSpecSymbol:=@FreePascalStringSuffix;
  1223. { must be uppercased to avoid calling UpCaseStr in MatchesAnyAsmSymbol PM }
  1224. ssAsmPrefix :
  1225. GetSpecSymbol:=@FreePascalAsmPrefix;
  1226. ssAsmSuffix :
  1227. GetSpecSymbol:=@FreePascalAsmSuffix;
  1228. ssDirectivePrefix :
  1229. case Index of
  1230. 0 : GetSpecSymbol:=@FreePascalDirectivePrefix1;
  1231. 1 : GetSpecSymbol:=@FreePascalDirectivePrefix2;
  1232. end;
  1233. {ssDirectiveSuffix :
  1234. case Index of
  1235. 0 : GetSpecSymbol:=@FreePascalDirectiveSuffix1;
  1236. 1 : GetSpecSymbol:=@FreePascalDirectiveSuffix2;
  1237. end;}
  1238. end;
  1239. end;
  1240. function TSourceEditor.IsReservedWord(const S: string): boolean;
  1241. begin
  1242. IsReservedWord:=IsFPReservedWord(S);
  1243. end;
  1244. function TSourceEditor.IsAsmReservedWord(const S: string): boolean;
  1245. begin
  1246. IsAsmReservedWord:=IsFPAsmReservedWord(S);
  1247. end;
  1248. function TSourceEditor.ParseSourceNestedComments(X,Y : sw_integer): boolean;
  1249. const cModeNestedComments : array [TCompilerMode] of boolean =
  1250. (false,true{fpc},true{objfpc},false,false,false,false,false,false,false);
  1251. function CompilerModeToNestedComments(AMode: String; ACurrentNestedComments:boolean):boolean;
  1252. var SourceCompilerMode : TCompilerMode;
  1253. begin
  1254. SourceCompilerMode:=moNone;
  1255. case length(AMode) of
  1256. 2 : if AMode='tp' then
  1257. SourceCompilerMode:=moTp;
  1258. 3 : if AMode='fpc' then
  1259. SourceCompilerMode:=moFpc
  1260. else if AMode='iso' then
  1261. SourceCompilerMode:=moIso;
  1262. 6 : if AMode='objfpc' then
  1263. SourceCompilerMode:=moObjFpc
  1264. else if AMode='delphi' then
  1265. SourceCompilerMode:=moDelphi
  1266. else if AMode='macpas' then
  1267. SourceCompilerMode:=moMacPas;
  1268. 13: if AMode='delphiunicode' then
  1269. SourceCompilerMode:=moDelphiUnicode;
  1270. 14: if AMode='extendedpascal' then
  1271. SourceCompilerMode:=moExtendedPascal;
  1272. end;
  1273. if SourceCompilerMode=moNone then
  1274. CompilerModeToNestedComments:=ACurrentNestedComments
  1275. else
  1276. CompilerModeToNestedComments:=cModeNestedComments[SourceCompilerMode];
  1277. end;
  1278. procedure RegisterNestnessPoint( LineNr, X : sw_integer);
  1279. begin
  1280. NestnessPoints[NestPos].X:=X;
  1281. NestnessPoints[NestPos].Y:=LineNr;
  1282. NestnessPoints[NestPos].NC:=NestedComments;
  1283. inc(NestPos);
  1284. if NestPos=cMaxNestnessChanges then NestPos:=0;
  1285. end;
  1286. var CurrentCompilerMode : TCompilerMode;
  1287. CurX,CurY:sw_integer;
  1288. S : sw_astring;
  1289. crWord,prWord : sw_astring;
  1290. ch,prCh,prprCh : AnsiChar;
  1291. CommentStartX,CommentStartY:sw_integer;
  1292. WordNpk : sw_integer;
  1293. inCompilerDirective : boolean;
  1294. inLineComment : boolean;
  1295. inCurlyBracketComment : boolean;
  1296. inBracketComment : boolean;
  1297. inString : boolean;
  1298. CommentDepth: sw_integer;
  1299. CompilerDirective: sw_integer;
  1300. ResultIsSet : boolean;
  1301. begin
  1302. CurrentCompilerMode:=TCompilerMode(CompilerModeSwitches^.GetCurrSelParamID);
  1303. NestedComments:=cModeNestedComments[CurrentCompilerMode];
  1304. ParseSourceNestedComments:=NestedComments;
  1305. ResultIsSet:=false;
  1306. RegisterNestnessPoint(0,0);
  1307. if (not IsFlagSet(efSyntaxHighlight)) then
  1308. begin {not ment to be syntax highlighted }
  1309. FixedNestedComments.Y:=0;
  1310. FixedNestedComments.X:=0;
  1311. exit;
  1312. end;
  1313. FixedNestedComments.Y:=2000001;
  1314. CurX:=0;
  1315. CurY:=0;
  1316. inCompilerDirective:=false;
  1317. inLineComment:=false;
  1318. inCurlyBracketComment:=false;
  1319. inBracketComment:=false;
  1320. inString:=false;
  1321. CommentDepth:=0;
  1322. CompilerDirective:=0;
  1323. WordNpk:=0;
  1324. NestPos:=0;
  1325. while CurY<GetLineCount do
  1326. begin
  1327. S:=GetLineText(CurY)+' ';
  1328. prCh:=#0;prprCh:=#0;
  1329. CurX:=0;
  1330. while CurX < length(S) do
  1331. begin
  1332. inc(CurX);
  1333. ch := S[CurX];
  1334. {-- comment part --}
  1335. if not (inCompilerDirective or inLineComment or inCurlyBracketComment or inBracketComment or inString) then
  1336. if (ch = '{') then
  1337. begin
  1338. inCurlyBracketComment:=true;
  1339. CommentDepth:=0;
  1340. CommentStartX:=CurX;
  1341. CommentStartY:=CurY;
  1342. end else
  1343. if (ch = '*') and (prCh='(') then
  1344. begin
  1345. inBracketComment:=true;
  1346. CommentDepth:=0;
  1347. CommentStartX:=CurX;
  1348. CommentStartY:=CurY;
  1349. end;
  1350. if (ch = '{') and inCurlyBracketComment then
  1351. inc(CommentDepth);
  1352. if (ch = '*') and (prCh='(') and inBracketComment then
  1353. begin
  1354. inc(CommentDepth);
  1355. if CurX < length(S) then if S[CurX+1] = ')' then
  1356. dec(CommentDepth); {in comment (*) is not begin comment but end}
  1357. end;
  1358. if (ch = '$') and (prCh='{') and inCurlyBracketComment and (CommentDepth=1) then
  1359. begin
  1360. inCompilerDirective:=true;
  1361. CompilerDirective:=1;
  1362. WordNpk:=0;
  1363. end;
  1364. if (ch = '$') and (prCh='*') and (prprCh='(') and inBracketComment and (CommentDepth=1) then
  1365. begin
  1366. inCompilerDirective:=true;
  1367. CompilerDirective:=2;
  1368. WordNpk:=0;
  1369. end;
  1370. if not (inCompilerDirective or inLineComment or inCurlyBracketComment or inBracketComment or inString) then
  1371. if (ch = '/') and (prCh = '/') then
  1372. inLineComment:=true;
  1373. {-- string part --}
  1374. if not (inCompilerDirective or inLineComment or inCurlyBracketComment or inBracketComment or inString) then
  1375. if (ch = '''') then
  1376. inString:=true;
  1377. if (ch = '''') and inString then
  1378. inString:=false;
  1379. {-- word part --}
  1380. if ch in ['a'..'z','.','_','A'..'Z','0'..'9'] then
  1381. crWord:=crWord+ch
  1382. else begin
  1383. if length(crWord)>0 then
  1384. begin
  1385. crWord:=LowcaseStr(crWord);
  1386. if inCompilerDirective then
  1387. begin
  1388. inc(WordNpk);
  1389. if WordNpk=2 then
  1390. begin
  1391. if (prWord='mode') then
  1392. begin
  1393. NestedComments:=CompilerModeToNestedComments(crWord,NestedComments);
  1394. RegisterNestnessPoint(CurY,CurX-1);
  1395. end else
  1396. if (prWord='modeswitch') and (crWord='nestedcomments') then
  1397. begin
  1398. if ch='-' then
  1399. NestedComments:=false
  1400. else
  1401. NestedComments:=true;
  1402. RegisterNestnessPoint(CurY,CurX-1);
  1403. end;
  1404. end;
  1405. end;
  1406. if not (inCompilerDirective or inLineComment or inCurlyBracketComment or inBracketComment or inString) then
  1407. begin
  1408. if (crWord='uses')
  1409. or (crWord='type')
  1410. or (crWord='var')
  1411. or (crWord='const')
  1412. or (crWord='begin')
  1413. or (crWord='implementation')
  1414. or (crWord='function')
  1415. or (crWord='procedure')
  1416. then
  1417. begin
  1418. FixedNestedComments.Y:=CurY;
  1419. FixedNestedComments.X:=CurX-1;
  1420. if not ResultIsSet then
  1421. ParseSourceNestedComments:=NestedComments;
  1422. exit;
  1423. end;
  1424. end;
  1425. end;
  1426. prWord:=crWord;
  1427. crWord:='';
  1428. end;
  1429. { --- comment close part ---- }
  1430. if (ch = '}') and inCurlyBracketComment then
  1431. begin
  1432. dec(CommentDepth);
  1433. if not NestedComments then
  1434. CommentDepth:=0;
  1435. if CommentDepth=0 then
  1436. inCurlyBracketComment:=false;
  1437. end;
  1438. if (ch = ')') and (prCh='*') and inBracketComment then
  1439. begin
  1440. if (CommentStartY<>CurY) or ((CommentStartY=CurY) and ((CurX-CommentStartX)>3)) then
  1441. begin
  1442. dec(CommentDepth);
  1443. if not NestedComments then
  1444. CommentDepth:=0;
  1445. if CommentDepth=0 then
  1446. inBracketComment:=false;
  1447. end;
  1448. end;
  1449. if (ch = '}') and inCompilerDirective and not inCurlyBracketComment then
  1450. inCompilerDirective:=false;
  1451. if (ch = ')') and (prCh='*') and inCompilerDirective and not inBracketComment then
  1452. inCompilerDirective:=false;
  1453. { --- result --- }
  1454. if (CurY=Y) and ((CurX-1)=X) then
  1455. begin
  1456. ParseSourceNestedComments:=NestedComments;
  1457. ResultIsSet:=true;
  1458. end;
  1459. prprCh:=prCh;
  1460. prCh:=ch;
  1461. end; {end while one line}
  1462. if inLineComment then
  1463. inLineComment:=false;
  1464. inc(CurY); {next line}
  1465. if CurY=200 then break; {give up on line 200, it might not be a pascal source after all}
  1466. end; {end while all lines}
  1467. FixedNestedComments.Y:=CurY; { full(200 lines) parse was done }
  1468. FixedNestedComments.X:=CurX;
  1469. end;
  1470. function TSourceEditor.IsNestedComments(X,Y : sw_integer): boolean;
  1471. var iPos : sw_integer;
  1472. lastNC : boolean;
  1473. begin
  1474. if (FixedNestedComments.Y<Y) or ((FixedNestedComments.Y=Y) and (FixedNestedComments.X<=X)) then
  1475. begin {we are at point where comment nestness is determined }
  1476. IsNestedComments:=NestedComments;
  1477. end else
  1478. begin
  1479. lastNC:=NestedComments;
  1480. if NestPos>0 then
  1481. for iPos:=0 to NestPos-1 do
  1482. begin
  1483. if (NestnessPoints[iPos].Y>Y) or ((NestnessPoints[iPos].Y=Y) and (NestnessPoints[iPos].X>=X)) then
  1484. break;
  1485. lastNC:=NestnessPoints[iPos].NC;
  1486. end;
  1487. IsNestedComments:=lastNC;
  1488. end;
  1489. end;
  1490. function TSourceEditor.NestedCommentsChangeCheck(CurLine : sw_integer):boolean;
  1491. function CheckTantedLine(LineNr : sw_integer):boolean;
  1492. function OneInTantetList (AWord : string):boolean;
  1493. begin
  1494. OneInTantetList:=false;
  1495. if AWord='$mode' then OneInTantetList:=true else
  1496. if AWord='nestedcomments' then OneInTantetList:=true;
  1497. end;
  1498. var S : sw_astring;
  1499. CurX : sw_integer;
  1500. ch, fo : AnsiChar;
  1501. crWord : String;
  1502. el : boolean;
  1503. begin
  1504. CheckTantedLine:=false;
  1505. S:=GetLineText(LineNr);
  1506. crWord:='';
  1507. For CurX:=1 to length(S) do
  1508. begin
  1509. if length(crWord)=255 then crWord:=''; {overflow}
  1510. ch:=LowCase(S[CurX]);
  1511. el:=true;
  1512. if ch in ['$','a'..'z'] then
  1513. begin
  1514. crWord:=crWord+ch;
  1515. el:=false;
  1516. end;
  1517. if (el or (CurX=length(S))) and (crWord<>'') then
  1518. begin
  1519. if OneInTantetList(crWord) then
  1520. begin
  1521. CheckTantedLine:=true;
  1522. break;
  1523. end;
  1524. crWord:='';
  1525. end;
  1526. end;
  1527. end;
  1528. var Points : TNestnessPoints;
  1529. iPos,iFrom,oNest : sw_integer;
  1530. begin
  1531. NestedCommentsChangeCheck:=false;
  1532. if (FixedNestedComments.Y>=CurLine) then
  1533. begin
  1534. if FixedNestedComments.Y>=2000000 then
  1535. begin
  1536. ParseSourceNestedComments(0,CurLine+1);
  1537. NestedCommentsChangeCheck:=true;
  1538. end else
  1539. begin
  1540. Points:=NestnessPoints;
  1541. iFrom:=-1;oNest:=NestPos;
  1542. if NestPos>0 then
  1543. for iPos:=0 to NestPos-1 do
  1544. if Points[iPos].Y=CurLine then
  1545. if iFrom<0 then begin iFrom:=iPos;break; end;
  1546. if (iFrom>=0) or CheckTantedLine(CurLine) then
  1547. begin {we have something to checkup}
  1548. ParseSourceNestedComments(0,CurLine+1);
  1549. if oNest=NestPos then
  1550. begin
  1551. for iPos:=0 to NestPos-1 do
  1552. begin
  1553. if Points[iPos].NC<>NestnessPoints[iPos].NC then
  1554. begin
  1555. NestedCommentsChangeCheck:=true;
  1556. break;
  1557. end;
  1558. end;
  1559. end else
  1560. NestedCommentsChangeCheck:=true;
  1561. end;
  1562. end;
  1563. end;
  1564. end;
  1565. function TSourceEditor.TranslateCodeTemplate(var Shortcut: string; ALines: PUnsortedStringCollection): boolean;
  1566. begin
  1567. TranslateCodeTemplate:=FPTranslateCodeTemplate(ShortCut,ALines);
  1568. end;
  1569. function TSourceEditor.SelectCodeTemplate(var ShortCut: string): boolean;
  1570. var D: PCodeTemplatesDialog;
  1571. OK: boolean;
  1572. begin
  1573. New(D, Init(true,ShortCut));
  1574. OK:=Desktop^.ExecView(D)=cmOK;
  1575. if OK then ShortCut:=D^.GetSelectedShortCut;
  1576. Dispose(D, Done);
  1577. SelectCodeTemplate:=OK;
  1578. end;
  1579. function TSourceEditor.CompleteCodeWord(const WordS: string; var Text: string): boolean;
  1580. begin
  1581. CompleteCodeWord:=FPCompleteCodeWord(WordS,Text);
  1582. end;
  1583. procedure TSourceEditor.FindMatchingDelimiter(ScanForward: boolean);
  1584. var
  1585. St,nextResWord : String;
  1586. LineText,LineAttr: sw_astring;
  1587. Res,found,addit : boolean;
  1588. JumpPos: TPoint;
  1589. X,Y,lexchange,curlevel,linecount : sw_integer;
  1590. function GetLexChange(const S : string) : sw_integer;
  1591. begin
  1592. if (S='END') or (S='THEN') or (S='UNTIL') then
  1593. GetLexChange:=-1
  1594. else if (S='ASM') or (S='BEGIN') or (S='CASE') or (S='CLASS') or
  1595. (S='IF') or (S='OBJECT') or (S='RECORD') or (S='REPEAT') then
  1596. GetLexChange:=+1
  1597. else
  1598. GetLexChange:=0;
  1599. end;
  1600. begin
  1601. st:=UpcaseStr(GetCurrentWord);
  1602. if st<>'' then
  1603. Res:=IsReservedWord(St)
  1604. else
  1605. Res:=false;
  1606. LexChange:=GetLexChange(St);
  1607. if not res or (LexChange=0) or not
  1608. IsFlagSet(efSyntaxHighlight) then
  1609. Inherited FindMatchingDelimiter(ScanForward)
  1610. else
  1611. begin
  1612. JumpPos.X:=-1; JumpPos.Y:=-1;
  1613. Y:=CurPos.Y; X:=CurPos.X;
  1614. found:=false;
  1615. LineCount:=0;
  1616. curlevel:=lexchange;
  1617. if LexChange>0 then
  1618. begin
  1619. repeat
  1620. Inc(LineCount);
  1621. NextResWord:='';
  1622. GetDisplayTextFormat(Y,LineText,LineAttr);
  1623. if LineCount<>1 then X:=-1
  1624. else if ord(LineAttr[X+1])<>coReservedWordColor then
  1625. exit;
  1626. repeat
  1627. Inc(X);
  1628. if X<length(LineText) then
  1629. begin
  1630. AddIt:=ord(LineAttr[X+1])=coReservedWordColor;
  1631. if AddIt then
  1632. NextResWord:=NextResWord+UpCase(LineText[X+1]);
  1633. end;
  1634. if ((X=length(LineText)) or (Not AddIt)) and
  1635. (NextResWord<>'') and
  1636. IsReservedWord(NextResWord) then
  1637. begin
  1638. LexChange:=GetLexChange(NextResWord);
  1639. CurLevel:=CurLevel+LexChange;
  1640. if CurLevel=0 then
  1641. begin
  1642. JumpPos.X:=X-Length(NextResWord);
  1643. JumpPos.Y:=Y;
  1644. end;
  1645. NextResWord:='';
  1646. end;
  1647. until (X>=length(LineText)) or (JumpPos.X<>-1);
  1648. Inc(Y);
  1649. until (Y>=GetLineCount) or (JumpPos.X<>-1);
  1650. if (Y=GetLineCount) and (JumpPos.X=-1) then
  1651. begin
  1652. ErrorBox('No match',nil);
  1653. exit;
  1654. end;
  1655. end
  1656. else if (LexChange<0) then
  1657. begin
  1658. repeat
  1659. Inc(LineCount);
  1660. NextResWord:='';
  1661. GetDisplayTextFormat(Y,LineText,LineAttr);
  1662. if LineCount<>1 then
  1663. X:=Length(LineText)
  1664. else if ord(LineAttr[X+1])<>coReservedWordColor then
  1665. exit;
  1666. repeat
  1667. Dec(X);
  1668. if X>=0 then
  1669. begin
  1670. AddIt:=ord(LineAttr[X+1])=coReservedWordColor;
  1671. if AddIt then
  1672. NextResWord:=UpCase(LineText[X+1])+NextResWord;
  1673. end;
  1674. if ((X=0) or (Not AddIt)) and
  1675. (NextResWord<>'') and
  1676. IsReservedWord(NextResWord) then
  1677. begin
  1678. LexChange:=GetLexChange(NextResWord);
  1679. CurLevel:=CurLevel+LexChange;
  1680. if CurLevel=0 then
  1681. begin
  1682. if AddIt then
  1683. JumpPos.X:=X
  1684. else
  1685. JumpPos.X:=X+1;
  1686. JumpPos.Y:=Y;
  1687. end;
  1688. NextResWord:='';
  1689. end;
  1690. until (X<=0) or (JumpPos.X<>-1);
  1691. Dec(Y);
  1692. until (Y<0) or (JumpPos.X<>-1);
  1693. if (Y<0) and (JumpPos.X=-1) then
  1694. begin
  1695. ErrorBox('No match',nil);
  1696. exit;
  1697. end;
  1698. end;
  1699. if JumpPos.X<>-1 then
  1700. begin
  1701. SetCurPtr(JumpPos.X,JumpPos.Y);
  1702. TrackCursor(do_centre);
  1703. end;
  1704. end;
  1705. end;
  1706. procedure TSourceEditor.SetCodeCompleteWord(const S: string);
  1707. var R: TRect;
  1708. begin
  1709. inherited SetCodeCompleteWord(S);
  1710. if S='' then
  1711. begin
  1712. if Assigned(CodeCompleteTip) then Dispose(CodeCompleteTip, Done);
  1713. CodeCompleteTip:=nil;
  1714. end
  1715. else
  1716. begin
  1717. R.Assign(0,0,20,1);
  1718. if Assigned(CodeCompleteTip)=false then
  1719. begin
  1720. New(CodeCompleteTip, Init(R, S, alCenter));
  1721. CodeCompleteTip^.Hide;
  1722. Application^.Insert(CodeCompleteTip);
  1723. end
  1724. else
  1725. CodeCompleteTip^.SetText(S);
  1726. AlignCodeCompleteTip;
  1727. end;
  1728. end;
  1729. procedure TSourceEditor.AlignCodeCompleteTip;
  1730. var P: TPoint;
  1731. S: string;
  1732. R: TRect;
  1733. begin
  1734. if Assigned(CodeCompleteTip)=false then Exit;
  1735. S:=CodeCompleteTip^.GetText;
  1736. P.Y:=CurPos.Y;
  1737. { determine the center of current word fragment }
  1738. P.X:=CurPos.X-(length(GetCodeCompleteFrag) div 2);
  1739. { calculate position for centering the complete word over/below the current }
  1740. P.X:=P.X-(length(S) div 2);
  1741. P.X:=P.X-Delta.X;
  1742. P.Y:=P.Y-Delta.Y;
  1743. MakeGlobal(P,P);
  1744. if Assigned(CodeCompleteTip^.Owner) then
  1745. CodeCompleteTip^.Owner^.MakeLocal(P,P);
  1746. { ensure that the tooltip stays in screen }
  1747. P.X:=Min(Max(0,P.X),ScreenWidth-length(S)-2-1);
  1748. { align it vertically }
  1749. if P.Y>round(ScreenHeight*3/4) then
  1750. Dec(P.Y)
  1751. else
  1752. Inc(P.Y);
  1753. R.Assign(P.X,P.Y,P.X+1+length(S)+1,P.Y+1);
  1754. CodeCompleteTip^.Locate(R);
  1755. if CodeCompleteTip^.GetState(sfVisible)=false then
  1756. CodeCompleteTip^.Show;
  1757. end;
  1758. procedure TSourceEditor.ModifiedChanged;
  1759. begin
  1760. inherited ModifiedChanged;
  1761. if (@Self<>Clipboard) and GetModified then
  1762. begin
  1763. { global flags }
  1764. EditorModified:=true;
  1765. { reset compile flags as the file is
  1766. not the same as at the compilation anymore }
  1767. CompileStamp:=-1;
  1768. end;
  1769. end;
  1770. procedure TSourceEditor.InsertOptions;
  1771. var C: PUnsortedStringCollection;
  1772. Y: sw_integer;
  1773. S: string;
  1774. begin
  1775. Lock;
  1776. New(C, Init(10,10));
  1777. GetCompilerOptionLines(C);
  1778. if C^.Count>0 then
  1779. begin
  1780. for Y:=0 to C^.Count-1 do
  1781. begin
  1782. S:=C^.At(Y)^;
  1783. InsertLine(Y,S);
  1784. end;
  1785. AdjustSelectionPos(0,0,0,C^.Count);
  1786. UpdateAttrs(0,attrAll);
  1787. DrawLines(0);
  1788. SetModified(true);
  1789. end;
  1790. Dispose(C, Done);
  1791. UnLock;
  1792. end;
  1793. procedure TSourceEditor.PushInfo(Const st : string);
  1794. begin
  1795. PushStatus(st);
  1796. end;
  1797. procedure TSourceEditor.PopInfo;
  1798. begin
  1799. PopStatus;
  1800. end;
  1801. procedure TSourceEditor.DeleteLine(I: sw_integer);
  1802. begin
  1803. inherited DeleteLine(I);
  1804. {$ifndef NODEBUG}
  1805. If ShouldHandleBreakpoints then
  1806. BreakpointsCollection^.AdaptBreakpoints(@Self,I,-1);
  1807. {$endif NODEBUG}
  1808. end;
  1809. procedure TSourceEditor.BackSpace;
  1810. {$ifndef NODEBUG}
  1811. var
  1812. MoveBreakpointToPreviousLine,WasEnabled : boolean;
  1813. PBStart,PBEnd : PBreakpoint;
  1814. I : longint;
  1815. {$endif NODEBUG}
  1816. begin
  1817. {$ifdef NODEBUG}
  1818. inherited Backspace;
  1819. {$else}
  1820. MoveBreakpointToPreviousLine:=(CurPos.X=0) and (CurPos.Y>0);
  1821. If MoveBreakpointToPreviousLine then
  1822. begin
  1823. ShouldHandleBreakpoints:=false;
  1824. I:=CurPos.Y+1;
  1825. PBEnd:=BreakpointsCollection^.FindBreakpointAt(@Self,I);
  1826. PBStart:=BreakpointsCollection^.FindBreakpointAt(@Self,I-1);
  1827. end;
  1828. inherited Backspace;
  1829. if MoveBreakpointToPreviousLine then
  1830. begin
  1831. ShouldHandleBreakpoints:=true;
  1832. if assigned(PBEnd) then
  1833. begin
  1834. if assigned(PBStart) then
  1835. begin
  1836. if PBEnd^.state=bs_enabled then
  1837. PBStart^.state:=bs_enabled;
  1838. BreakpointsCollection^.Free(PBEnd);
  1839. end
  1840. else
  1841. begin
  1842. WasEnabled:=PBEnd^.state=bs_enabled;
  1843. if WasEnabled then
  1844. begin
  1845. PBEnd^.state:=bs_disabled;
  1846. PBEnd^.UpdateSource;
  1847. end;
  1848. PBEnd^.line:=I-1;
  1849. if WasEnabled then
  1850. begin
  1851. PBEnd^.state:=bs_enabled;
  1852. PBEnd^.UpdateSource;
  1853. end;
  1854. end;
  1855. end;
  1856. BreakpointsCollection^.AdaptBreakpoints(@Self,I,-1);
  1857. end;
  1858. {$endif NODEBUG}
  1859. end;
  1860. function TSourceEditor.InsertNewLine : Sw_integer;
  1861. {$ifndef NODEBUG}
  1862. var
  1863. MoveBreakpointToNextLine : boolean;
  1864. I : longint;
  1865. {$endif NODEBUG}
  1866. begin
  1867. {$ifdef NODEBUG}
  1868. InsertNewLine:=inherited InsertNewLine;
  1869. {$else}
  1870. ShouldHandleBreakpoints:=false;
  1871. MoveBreakpointToNextLine:=Cursor.x<Length(RTrim(GetDisplayText(CurPos.Y)));
  1872. I:=CurPos.Y+1;
  1873. InsertNewLine:=inherited InsertNewLine;
  1874. if MoveBreakpointToNextLine then
  1875. BreakpointsCollection^.AdaptBreakpoints(@Self,I-1,1)
  1876. else
  1877. BreakpointsCollection^.AdaptBreakpoints(@Self,I,1);
  1878. ShouldHandleBreakpoints:=true;
  1879. {$endif NODEBUG}
  1880. end;
  1881. procedure TSourceEditor.DelChar;
  1882. var
  1883. S: sw_astring;
  1884. I,CI : sw_integer;
  1885. {$ifndef NODEBUG}
  1886. PBStart,PBEnd : PBreakpoint;
  1887. MoveBreakpointOneLineUp,WasEnabled : boolean;
  1888. {$endif NODEBUG}
  1889. begin
  1890. if IsReadOnly then Exit;
  1891. S:=GetLineText(CurPos.Y);
  1892. I:=CurPos.Y+1;
  1893. CI:=LinePosToCharIdx(CurPos.Y,CurPos.X);
  1894. {$ifndef NODEBUG}
  1895. if ((CI>length(S)) or (S='')) and (CurPos.Y<GetLineCount-1) then
  1896. begin
  1897. MoveBreakpointOneLineUp:=true;
  1898. ShouldHandleBreakpoints:=false;
  1899. PBEnd:=BreakpointsCollection^.FindBreakpointAt(@Self,I+1);
  1900. PBStart:=BreakpointsCollection^.FindBreakpointAt(@Self,I);
  1901. end
  1902. else
  1903. MoveBreakpointOneLineUp:=false;
  1904. {$endif NODEBUG}
  1905. Inherited DelChar;
  1906. {$ifndef NODEBUG}
  1907. if MoveBreakpointOneLineUp then
  1908. begin
  1909. ShouldHandleBreakpoints:=true;
  1910. if assigned(PBEnd) then
  1911. begin
  1912. if assigned(PBStart) then
  1913. begin
  1914. if PBEnd^.state=bs_enabled then
  1915. PBStart^.state:=bs_enabled;
  1916. BreakpointsCollection^.Free(PBEnd);
  1917. end
  1918. else
  1919. begin
  1920. WasEnabled:=PBEnd^.state=bs_enabled;
  1921. if WasEnabled then
  1922. begin
  1923. PBEnd^.state:=bs_disabled;
  1924. PBEnd^.UpdateSource;
  1925. end;
  1926. PBEnd^.line:=I;
  1927. if WasEnabled then
  1928. begin
  1929. PBEnd^.state:=bs_enabled;
  1930. PBEnd^.UpdateSource;
  1931. end;
  1932. end;
  1933. end;
  1934. BreakpointsCollection^.AdaptBreakpoints(@Self,I,-1);
  1935. end;
  1936. {$endif NODEBUG}
  1937. end;
  1938. procedure TSourceEditor.DelSelect;
  1939. {$ifndef NODEBUG}
  1940. var
  1941. MoveBreakpointToFirstLine,WasEnabled : boolean;
  1942. PBStart,PBEnd : PBreakpoint;
  1943. I,J : longint;
  1944. {$endif NODEBUG}
  1945. begin
  1946. {$ifdef NODEBUG}
  1947. inherited DelSelect;
  1948. {$else}
  1949. ShouldHandleBreakpoints:=false;
  1950. J:=SelEnd.Y-SelStart.Y;
  1951. MoveBreakpointToFirstLine:=J>0;
  1952. PBEnd:=BreakpointsCollection^.FindBreakpointAt(@Self,SelEnd.Y);
  1953. PBStart:=BreakpointsCollection^.FindBreakpointAt(@Self,SelEnd.Y);
  1954. I:=SelStart.Y;
  1955. inherited DelSelect;
  1956. if MoveBreakpointToFirstLine and assigned(PBEnd) then
  1957. begin
  1958. If assigned(PBStart) then
  1959. begin
  1960. if PBEnd^.state=bs_enabled then
  1961. PBStart^.state:=bs_enabled;
  1962. BreakpointsCollection^.Free(PBEnd);
  1963. end
  1964. else
  1965. begin
  1966. WasEnabled:=PBEnd^.state=bs_enabled;
  1967. if WasEnabled then
  1968. begin
  1969. PBEnd^.state:=bs_disabled;
  1970. PBEnd^.UpdateSource;
  1971. end;
  1972. PBEnd^.line:=I;
  1973. if WasEnabled then
  1974. begin
  1975. PBEnd^.state:=bs_enabled;
  1976. PBEnd^.UpdateSource;
  1977. end;
  1978. end;
  1979. end;
  1980. BreakpointsCollection^.AdaptBreakpoints(@Self,I,-J);
  1981. ShouldHandleBreakpoints:=true;
  1982. {$endif NODEBUG}
  1983. end;
  1984. function TSourceEditor.InsertLine(LineNo: sw_integer; const S: sw_astring): PCustomLine;
  1985. begin
  1986. InsertLine := inherited InsertLine(LineNo,S);
  1987. {$ifndef NODEBUG}
  1988. If ShouldHandleBreakpoints then
  1989. BreakpointsCollection^.AdaptBreakpoints(@Self,LineNo,1);
  1990. {$endif NODEBUG}
  1991. end;
  1992. procedure TSourceEditor.AddLine(const S: sw_astring);
  1993. begin
  1994. inherited AddLine(S);
  1995. {$ifndef NODEBUG}
  1996. BreakpointsCollection^.AdaptBreakpoints(@Self,GetLineCount,1);
  1997. {$endif NODEBUG}
  1998. end;
  1999. function TSourceEditor.GetLocalMenu: PMenu;
  2000. var M: PMenu;
  2001. MI: PMenuItem;
  2002. begin
  2003. MI:=
  2004. NewItem(menu_edit_cut,menu_key_edit_cut,cut_key,cmCut,hcCut,
  2005. NewItem(menu_edit_copy,menu_key_edit_copy,copy_key,cmCopy,hcCopy,
  2006. NewItem(menu_edit_paste,menu_key_edit_paste,paste_key,cmPaste,hcPaste,
  2007. NewItem(menu_edit_clear,menu_key_edit_clear,kbCtrlDel,cmClear,hcClear,
  2008. NewLine(
  2009. NewItem(menu_srclocal_openfileatcursor,'',kbNoKey,cmOpenAtCursor,hcOpenAtCursor,
  2010. NewItem(menu_srclocal_browseatcursor,'',kbNoKey,cmBrowseAtCursor,hcBrowseAtCursor,
  2011. NewItem(menu_srclocal_topicsearch,menu_key_help_topicsearch,kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
  2012. NewLine(
  2013. NewItem(menu_srclocal_options,'',kbNoKey,cmEditorOptions,hcEditorOptions,
  2014. nil))))))))));
  2015. if IsChangedOnDisk then
  2016. MI:=NewItem(menu_srclocal_reload,'',kbNoKey,cmDoReload,hcDoReload,
  2017. MI);
  2018. M:=NewMenu(MI);
  2019. GetLocalMenu:=M;
  2020. end;
  2021. function TSourceEditor.GetCommandTarget: PView;
  2022. begin
  2023. GetCommandTarget:=@Self;
  2024. end;
  2025. function TSourceEditor.CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup;
  2026. var MV: PAdvancedMenuPopup;
  2027. begin
  2028. New(MV, Init(Bounds,M));
  2029. CreateLocalMenuView:=MV;
  2030. end;
  2031. {$ifdef DebugUndo}
  2032. procedure TSourceEditor.DumpUndo;
  2033. var
  2034. i : sw_integer;
  2035. begin
  2036. ClearToolMessages;
  2037. AddToolCommand('UndoList Dump');
  2038. for i:=0 to Core^.UndoList^.count-1 do
  2039. with Core^.UndoList^.At(i)^ do
  2040. begin
  2041. if is_grouped_action then
  2042. AddToolMessage('','Group '+ActionString[action]+' '+IntToStr(ActionCount)+' elementary actions',0,0)
  2043. else
  2044. AddToolMessage('',ActionString[action]+' '+IntToStr(StartPos.Y+1)+':'+IntToStr(StartPos.X+1)+
  2045. ' '+IntToStr(EndPos.Y+1)+':'+IntToStr(EndPos.X+1)+' "'+GetText()+'"',0,0);
  2046. end;
  2047. if Core^.RedoList^.count>0 then
  2048. AddToolCommand('RedoList Dump');
  2049. for i:=0 to Core^.RedoList^.count-1 do
  2050. with Core^.RedoList^.At(i)^ do
  2051. begin
  2052. if is_grouped_action then
  2053. AddToolMessage('','Group '+ActionString[action]+' '+IntToStr(ActionCount)+' elementary actions',0,0)
  2054. else
  2055. AddToolMessage('',ActionString[action]+' '+IntToStr(StartPos.Y+1)+':'+IntToStr(StartPos.X+1)+
  2056. ' '+IntToStr(EndPos.Y+1)+':'+IntToStr(EndPos.X+1)+' "'+GetText()+'"',0,0);
  2057. end;
  2058. UpdateToolMessages;
  2059. if Assigned(MessagesWindow) then
  2060. MessagesWindow^.Focus;
  2061. end;
  2062. procedure TSourceEditor.UndoAll;
  2063. begin
  2064. While Core^.UndoList^.count>0 do
  2065. Undo;
  2066. end;
  2067. procedure TSourceEditor.RedoAll;
  2068. begin
  2069. While Core^.RedoList^.count>0 do
  2070. Redo;
  2071. end;
  2072. {$endif DebugUndo}
  2073. function TSourceEditor.Valid(Command: Word): Boolean;
  2074. var OK: boolean;
  2075. begin
  2076. OK:=inherited Valid(Command);
  2077. if OK and ({(Command=cmClose) or already handled in TFileEditor.Valid PM }
  2078. (Command=cmAskSaveAll)) then
  2079. if IsClipboard=false then
  2080. OK:=SaveAsk(Command,false);
  2081. Valid:=OK;
  2082. end;
  2083. procedure TSourceEditor.HandleEvent(var Event: TEvent);
  2084. var DontClear: boolean;
  2085. S: string;
  2086. begin
  2087. TranslateMouseClick(@Self,Event);
  2088. case Event.What of
  2089. evKeyDown :
  2090. begin
  2091. DontClear:=false;
  2092. case Event.KeyCode of
  2093. kbCtrlEnter :
  2094. Message(@Self,evCommand,cmOpenAtCursor,nil);
  2095. else DontClear:=true;
  2096. end;
  2097. if not DontClear then ClearEvent(Event);
  2098. end;
  2099. end;
  2100. inherited HandleEvent(Event);
  2101. case Event.What of
  2102. evBroadcast :
  2103. case Event.Command of
  2104. cmCalculatorPaste :
  2105. begin
  2106. InsertText(FloatToStr(CalcClipboard,0));
  2107. ClearEvent(Event);
  2108. end;
  2109. end;
  2110. evCommand :
  2111. begin
  2112. DontClear:=false;
  2113. case Event.Command of
  2114. {$ifdef DebugUndo}
  2115. cmDumpUndo : DumpUndo;
  2116. cmUndoAll : UndoAll;
  2117. cmRedoAll : RedoAll;
  2118. {$endif DebugUndo}
  2119. cmDoReload : ReloadFile;
  2120. cmBrowseAtCursor:
  2121. begin
  2122. S:=LowerCaseStr(GetEditorCurWord(@Self,[]));
  2123. OpenOneSymbolBrowser(S);
  2124. end;
  2125. cmOpenAtCursor :
  2126. begin
  2127. S:=LowerCaseStr(GetEditorCurWord(@Self,['.']));
  2128. if Pos('.',S)<>0 then
  2129. OpenFileName:=S else
  2130. OpenFileName:=S+'.pp'+ListSeparator+
  2131. S+'.pas'+ListSeparator+
  2132. S+'.inc';
  2133. Message(Application,evCommand,cmOpen,nil);
  2134. end;
  2135. cmEditorOptions :
  2136. Message(Application,evCommand,cmEditorOptions,@Self);
  2137. cmHelp :
  2138. Message(@Self,evCommand,cmHelpTopicSearch,@Self);
  2139. cmHelpTopicSearch :
  2140. HelpTopicSearch(@Self);
  2141. else DontClear:=true;
  2142. end;
  2143. if not DontClear then ClearEvent(Event);
  2144. end;
  2145. end;
  2146. end;
  2147. constructor TFPHeapView.Init(var Bounds: TRect);
  2148. begin
  2149. if inherited Init(Bounds)=false then Fail;
  2150. Options:=Options or gfGrowHiX or gfGrowHiY;
  2151. EventMask:=EventMask or evIdle;
  2152. GrowMode:=gfGrowAll;
  2153. end;
  2154. constructor TFPHeapView.InitKb(var Bounds: TRect);
  2155. begin
  2156. if inherited InitKb(Bounds)=false then Fail;
  2157. Options:=Options or gfGrowHiX or gfGrowHiY;
  2158. EventMask:=EventMask or evIdle;
  2159. GrowMode:=gfGrowAll;
  2160. end;
  2161. procedure TFPHeapView.HandleEvent(var Event: TEvent);
  2162. begin
  2163. case Event.What of
  2164. evIdle :
  2165. Update;
  2166. end;
  2167. inherited HandleEvent(Event);
  2168. end;
  2169. constructor TFPClockView.Init(var Bounds: TRect);
  2170. begin
  2171. inherited Init(Bounds);
  2172. EventMask:=EventMask or evIdle;
  2173. end;
  2174. procedure TFPClockView.HandleEvent(var Event: TEvent);
  2175. begin
  2176. case Event.What of
  2177. evIdle :
  2178. Update;
  2179. end;
  2180. inherited HandleEvent(Event);
  2181. end;
  2182. function TFPClockView.GetPalette: PPalette;
  2183. const P: string[length(CFPClockView)] = CFPClockView;
  2184. begin
  2185. GetPalette:=@P;
  2186. end;
  2187. procedure TFPWindow.SetState(AState: Word; Enable: Boolean);
  2188. var OldState: word;
  2189. begin
  2190. OldState:=State;
  2191. inherited SetState(AState,Enable);
  2192. if AutoNumber then
  2193. if (AState and (sfVisible+sfExposed))<>0 then
  2194. if GetState(sfVisible+sfExposed) then
  2195. begin
  2196. if Number=0 then
  2197. Number:=SearchFreeWindowNo;
  2198. ReDraw;
  2199. end
  2200. else
  2201. Number:=0;
  2202. if ((AState and sfActive)<>0) and (((OldState xor State) and sfActive)<>0) then
  2203. UpdateCommands;
  2204. end;
  2205. procedure TFPWindow.UpdateCommands;
  2206. begin
  2207. end;
  2208. procedure TFPWindow.Update;
  2209. begin
  2210. ReDraw;
  2211. end;
  2212. procedure TFPWindow.SelectInDebugSession;
  2213. var
  2214. F,PrevCurrent : PView;
  2215. begin
  2216. DeskTop^.Lock;
  2217. PrevCurrent:=Desktop^.Current;
  2218. F:=PrevCurrent;
  2219. While assigned(F) and
  2220. ((F^.HelpCtx = hcGDBWindow) or
  2221. (F^.HelpCtx = hcdisassemblyWindow) or
  2222. (F^.HelpCtx = hcWatchesWindow) or
  2223. (F^.HelpCtx = hcStackWindow) or
  2224. (F^.HelpCtx = hcRegistersWindow) or
  2225. (F^.HelpCtx = hcVectorRegisters) or
  2226. (F^.HelpCtx = hcFPURegisters)) do
  2227. F:=F^.NextView;
  2228. if F<>@Self then
  2229. Select;
  2230. if PrevCurrent<>F then
  2231. Begin
  2232. Desktop^.InsertBefore(@self,F);
  2233. PrevCurrent^.Select;
  2234. End;
  2235. DeskTop^.Unlock;
  2236. end;
  2237. procedure TFPWindow.HandleEvent(var Event: TEvent);
  2238. begin
  2239. case Event.What of
  2240. evBroadcast :
  2241. case Event.Command of
  2242. cmUpdate :
  2243. Update;
  2244. cmSearchWindow+1..cmSearchWindow+99 :
  2245. if (Event.Command-cmSearchWindow=Number) then
  2246. ClearEvent(Event);
  2247. end;
  2248. end;
  2249. inherited HandleEvent(Event);
  2250. end;
  2251. constructor TFPWindow.Load(var S: TStream);
  2252. begin
  2253. inherited Load(S);
  2254. S.Read(AutoNumber,SizeOf(AutoNumber));
  2255. end;
  2256. procedure TFPWindow.Store(var S: TStream);
  2257. begin
  2258. inherited Store(S);
  2259. S.Write(AutoNumber,SizeOf(AutoNumber));
  2260. end;
  2261. function TFPHelpViewer.GetLocalMenu: PMenu;
  2262. var M: PMenu;
  2263. begin
  2264. M:=NewMenu(
  2265. {$ifdef DEBUG}
  2266. NewItem(menu_hlplocal_debug,'',kbNoKey,cmHelpDebug,hcHelpDebug,
  2267. {$endif DEBUG}
  2268. NewItem(menu_hlplocal_contents,'',kbNoKey,cmHelpContents,hcHelpContents,
  2269. NewItem(menu_hlplocal_index,menu_key_hlplocal_index,kbShiftF1,cmHelpIndex,hcHelpIndex,
  2270. NewItem(menu_hlplocal_topicsearch,menu_key_hlplocal_topicsearch,kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
  2271. NewItem(menu_hlplocal_prevtopic,menu_key_hlplocal_prevtopic,kbAltF1,cmHelpPrevTopic,hcHelpPrevTopic,
  2272. NewLine(
  2273. NewItem(menu_hlplocal_copy,menu_key_hlplocal_copy,copy_key,cmCopy,hcCopy,
  2274. nil)))))))
  2275. {$ifdef DEBUG}
  2276. )
  2277. {$endif DEBUG}
  2278. ;
  2279. GetLocalMenu:=M;
  2280. end;
  2281. function TFPHelpViewer.GetCommandTarget: PView;
  2282. begin
  2283. GetCommandTarget:=Application;
  2284. end;
  2285. constructor TFPHelpWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word;
  2286. AContext: THelpCtx; ANumber: Integer);
  2287. begin
  2288. inherited Init(Bounds,ATitle,ASourceFileID,AContext,ANumber);
  2289. HelpCtx:=hcHelpWindow;
  2290. HideOnClose:=true;
  2291. end;
  2292. destructor TFPHelpWindow.Done;
  2293. begin
  2294. if HelpWindow=@Self then
  2295. HelpWindow:=nil;
  2296. Inherited Done;
  2297. end;
  2298. procedure TFPHelpWindow.InitHelpView;
  2299. var R: TRect;
  2300. begin
  2301. GetExtent(R); R.Grow(-1,-1);
  2302. HelpView:=New(PFPHelpViewer, Init(R, HSB, VSB));
  2303. HelpView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2304. end;
  2305. procedure TFPHelpWindow.Show;
  2306. begin
  2307. inherited Show;
  2308. if GetState(sfVisible) and (Number=0) then
  2309. begin
  2310. Number:=SearchFreeWindowNo;
  2311. ReDraw;
  2312. end;
  2313. end;
  2314. procedure TFPHelpWindow.Hide;
  2315. begin
  2316. inherited Hide;
  2317. if GetState(sfVisible)=false then
  2318. Number:=0;
  2319. end;
  2320. procedure TFPHelpWindow.HandleEvent(var Event: TEvent);
  2321. begin
  2322. case Event.What of
  2323. evBroadcast :
  2324. case Event.Command of
  2325. cmUpdate :
  2326. ReDraw;
  2327. cmSearchWindow+1..cmSearchWindow+99 :
  2328. if (Event.Command-cmSearchWindow=Number) then
  2329. ClearEvent(Event);
  2330. end;
  2331. end;
  2332. inherited HandleEvent(Event);
  2333. end;
  2334. function TFPHelpWindow.GetPalette: PPalette;
  2335. const P: string[length(CIDEHelpDialog)] = CIDEHelpDialog;
  2336. begin
  2337. GetPalette:=@P;
  2338. end;
  2339. constructor TFPHelpWindow.Load(var S: TStream);
  2340. begin
  2341. Abstract;
  2342. end;
  2343. procedure TFPHelpWindow.Store(var S: TStream);
  2344. begin
  2345. Abstract;
  2346. end;
  2347. constructor TSourceWindow.Init(var Bounds: TRect; AFileName: string);
  2348. var HSB,VSB: PScrollBar;
  2349. R: TRect;
  2350. PA : Array[1..2] of pointer;
  2351. LoadFile: boolean;
  2352. begin
  2353. inherited Init(Bounds,AFileName,{SearchFreeWindowNo}0);
  2354. AutoNumber:=true;
  2355. Options:=Options or ofTileAble;
  2356. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=15;
  2357. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  2358. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  2359. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2360. GetExtent(R); R.A.X:=3; R.B.X:=15; R.A.Y:=R.B.Y-1;
  2361. New(Indicator, Init(R));
  2362. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2363. Insert(Indicator);
  2364. GetExtent(R); R.Grow(-1,-1);
  2365. LoadFile:=(AFileName<>'') and (AFileName<>'*');
  2366. if (AFileName='') then
  2367. begin
  2368. Inc(GlobalNoNameCount);
  2369. NoNameCount:=GlobalNoNameCount;
  2370. end
  2371. else
  2372. NoNameCount:=-1;
  2373. if AFileName='*' then
  2374. AFileName:='';
  2375. New(Editor, Init(R, HSB, VSB, Indicator,AFileName));
  2376. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2377. {load from file if there is no other window with the same file }
  2378. if Editor^.Core^.GetBindingCount = 1 then
  2379. if LoadFile then
  2380. begin
  2381. if Editor^.LoadFile=false then
  2382. ErrorBox(FormatStrStr(msg_errorreadingfile,AFileName),nil)
  2383. { warn if modified, but not if modified in another
  2384. already open window PM }
  2385. else if Editor^.GetModified and (Editor^.Core^.GetBindingCount=1) then
  2386. begin
  2387. PA[1]:=@AFileName;
  2388. Ptrint(PA[2]):={Editor^.ChangedLine}-1;
  2389. EditorDialog(edChangedOnloading,@PA);
  2390. end;
  2391. end;
  2392. Insert(Editor);
  2393. {$ifndef NODEBUG}
  2394. If assigned(BreakpointsCollection) then
  2395. BreakpointsCollection^.ShowBreakpoints(@Self);
  2396. {$endif NODEBUG}
  2397. UpdateTitle;
  2398. end;
  2399. procedure TSourceWindow.UpdateTitle;
  2400. var Name: string;
  2401. Count: sw_integer;
  2402. begin
  2403. if Editor^.FileName<>'' then
  2404. begin
  2405. Name:=SmartPath(Editor^.FileName);
  2406. Count:=Editor^.Core^.GetBindingCount;
  2407. if Count>1 then
  2408. begin
  2409. Name:=Name+':'+IntToStr(Editor^.Core^.GetBindingIndex(Editor)+1);
  2410. end;
  2411. SetTitle(Name);
  2412. end
  2413. else if NoNameCount>=0 then
  2414. begin
  2415. SetTitle('noname'+IntToStrZ(NonameCount,2)+'.pas');
  2416. end;
  2417. end;
  2418. function TSourceWindow.GetTitle(MaxSize: sw_Integer): TTitleStr;
  2419. begin
  2420. GetTitle:=OptimizePath(inherited GetTitle(255),MaxSize);
  2421. end;
  2422. procedure TSourceWindow.SetTitle(ATitle: string);
  2423. begin
  2424. if Title<>nil then DisposeStr(Title);
  2425. Title:=NewStr(ATitle);
  2426. Frame^.DrawView;
  2427. end;
  2428. procedure TSourceWindow.HandleEvent(var Event: TEvent);
  2429. var DontClear: boolean;
  2430. begin
  2431. case Event.What of
  2432. evBroadcast :
  2433. case Event.Command of
  2434. cmUpdate :
  2435. Update;
  2436. cmUpdateTitle :
  2437. UpdateTitle;
  2438. cmSearchWindow :
  2439. if @Self<>ClipboardWindow then
  2440. ClearEvent(Event);
  2441. end;
  2442. evCommand :
  2443. begin
  2444. DontClear:=false;
  2445. case Event.Command of
  2446. cmHide :
  2447. Hide;
  2448. cmSave :
  2449. if Editor^.IsClipboard=false then
  2450. if (Editor^.FileName='') then
  2451. Editor^.SaveAs
  2452. else
  2453. Editor^.Save;
  2454. cmSaveAs :
  2455. if Editor^.IsClipboard=false then
  2456. Editor^.SaveAs;
  2457. else DontClear:=true;
  2458. end;
  2459. if DontClear=false then ClearEvent(Event);
  2460. end;
  2461. end;
  2462. inherited HandleEvent(Event);
  2463. end;
  2464. procedure TSourceWindow.UpdateCommands;
  2465. var Active, Visible: boolean;
  2466. begin
  2467. Visible:=GetState(sfVisible);
  2468. Active:=GetState(sfActive) and Visible;
  2469. if Editor^.IsClipboard=false then
  2470. begin
  2471. SetCmdState(SourceCmds+CompileCmds,Active);
  2472. SetCmdState(EditorCmds,Active);
  2473. end;
  2474. SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmd+RedoCmd+[cmHide],Active);
  2475. SetCmdState([cmTile,cmCascade,cmTileVertical,cmStepped,cmSteppedReverse],Visible or IsThereAnyVisibleEditorWindow);
  2476. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  2477. end;
  2478. procedure TSourceWindow.Update;
  2479. begin
  2480. ReDraw;
  2481. end;
  2482. function TSourceWindow.GetPalette: PPalette;
  2483. const P: string[length(CSourceWindow)] = CSourceWindow;
  2484. begin
  2485. GetPalette:=@P;
  2486. end;
  2487. constructor TSourceWindow.Load(var S: TStream);
  2488. begin
  2489. Title:=S.ReadStr;
  2490. PushStatus(FormatStrStr(msg_loadingfile,GetStr(Title)));
  2491. inherited Load(S);
  2492. GetSubViewPtr(S,Indicator);
  2493. GetSubViewPtr(S,Editor);
  2494. {$ifndef NODEBUG}
  2495. If assigned(BreakpointsCollection) then
  2496. BreakpointsCollection^.ShowBreakpoints(@Self);
  2497. {$endif NODEBUG}
  2498. PopStatus;
  2499. end;
  2500. procedure TSourceWindow.Store(var S: TStream);
  2501. begin
  2502. S.WriteStr(Title);
  2503. PushStatus(FormatStrStr(msg_storingfile,GetStr(Title)));
  2504. inherited Store(S);
  2505. PutSubViewPtr(S,Indicator);
  2506. PutSubViewPtr(S,Editor);
  2507. PopStatus;
  2508. end;
  2509. destructor TSourceWindow.Done;
  2510. begin
  2511. PushStatus(FormatStrStr(msg_closingfile,GetStr(Title)));
  2512. if not IDEApp.IsClosing then
  2513. Message(Application,evBroadcast,cmSourceWndClosing,@Self);
  2514. inherited Done;
  2515. IDEApp.SourceWindowClosed;
  2516. { if not IDEApp.IsClosing then
  2517. Message(Application,evBroadcast,cmUpdate,@Self);}
  2518. PopStatus;
  2519. end;
  2520. {$ifndef NODEBUG}
  2521. function TGDBSourceEditor.Valid(Command: Word): Boolean;
  2522. var OK: boolean;
  2523. begin
  2524. OK:=TCodeEditor.Valid(Command);
  2525. { do NOT ask for save !!
  2526. if OK and ((Command=cmClose) or (Command=cmQuit)) then
  2527. if IsClipboard=false then
  2528. OK:=SaveAsk; }
  2529. Valid:=OK;
  2530. end;
  2531. procedure TGDBSourceEditor.AddLine(const S: sw_astring);
  2532. begin
  2533. if Silent or (IgnoreStringAtEnd and (S=LastCommand)) then exit;
  2534. inherited AddLine(S);
  2535. LimitsChanged;
  2536. end;
  2537. procedure TGDBSourceEditor.AddErrorLine(const S: string);
  2538. begin
  2539. if Silent then exit;
  2540. inherited AddLine(S);
  2541. { display like breakpoints in red }
  2542. SetLineFlagState(GetLineCount-1,lfBreakpoint,true);
  2543. LimitsChanged;
  2544. end;
  2545. const
  2546. GDBReservedCount = 6;
  2547. GDBReservedLongest = 3;
  2548. GDBReserved : array[1..GDBReservedCount] of String[GDBReservedLongest] =
  2549. ('gdb','b','n','s','f','bt');
  2550. function IsGDBReservedWord(const S : string) : boolean;
  2551. var
  2552. i : longint;
  2553. begin
  2554. for i:=1 to GDBReservedCount do
  2555. if (S=GDBReserved[i]) then
  2556. begin
  2557. IsGDBReservedWord:=true;
  2558. exit;
  2559. end;
  2560. IsGDBReservedWord:=false;
  2561. end;
  2562. function TGDBSourceEditor.IsReservedWord(const S: string): boolean;
  2563. begin
  2564. IsReservedWord:=IsGDBReservedWord(S);
  2565. end;
  2566. function TGDBSourceEditor.InsertNewLine: Sw_integer;
  2567. Var
  2568. S : string;
  2569. CommandCalled : boolean;
  2570. begin
  2571. if IsReadOnly then begin InsertNewLine:=-1; Exit; end;
  2572. if CurPos.Y<GetLineCount then S:=GetDisplayText(CurPos.Y) else S:='';
  2573. s:=Copy(S,1,CurPos.X);
  2574. CommandCalled:=false;
  2575. if Pos(GDBPrompt,S)=1 then
  2576. Delete(S,1,length(GDBPrompt));
  2577. {$ifndef NODEBUG}
  2578. if assigned(Debugger) then
  2579. if S<>'' then
  2580. begin
  2581. LastCommand:=S;
  2582. { should be true only if we are at the end ! }
  2583. IgnoreStringAtEnd:=(CurPos.Y=GetLineCount-1) and
  2584. (CurPos.X>=length(RTrim(GetDisplayText(GetLineCount-1))));
  2585. Debugger^.Command(S);
  2586. CommandCalled:=true;
  2587. IgnoreStringAtEnd:=false;
  2588. end
  2589. else if AutoRepeat and (CurPos.Y=GetLineCount-1) then
  2590. begin
  2591. Debugger^.Command(LastCommand);
  2592. CommandCalled:=true;
  2593. end;
  2594. {$endif NODEBUG}
  2595. InsertNewLine:=inherited InsertNewLine;
  2596. If CommandCalled then
  2597. InsertText(GDBPrompt);
  2598. end;
  2599. constructor TGDBWindow.Init(var Bounds: TRect);
  2600. var HSB,VSB: PScrollBar;
  2601. R: TRect;
  2602. begin
  2603. inherited Init(Bounds,dialog_gdbwindow,0);
  2604. Options:=Options or ofTileAble;
  2605. AutoNumber:=true;
  2606. HelpCtx:=hcGDBWindow;
  2607. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  2608. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  2609. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  2610. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2611. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  2612. New(Indicator, Init(R));
  2613. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2614. Insert(Indicator);
  2615. GetExtent(R); R.Grow(-1,-1);
  2616. New(Editor, Init(R, HSB, VSB, Indicator, GDBOutputFile));
  2617. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2618. Editor^.SetFlags(efInsertMode+efSyntaxHighlight+efNoIndent+efExpandAllTabs);
  2619. if ExistsFile(GDBOutputFile) then
  2620. begin
  2621. if Editor^.LoadFile=false then
  2622. ErrorBox(FormatStrStr(msg_errorreadingfile,GDBOutputFile),nil);
  2623. end
  2624. else
  2625. { Empty files are buggy !! }
  2626. Editor^.AddLine('');
  2627. Insert(Editor);
  2628. {$ifndef NODEBUG}
  2629. {$ifndef GDBMI}
  2630. if assigned(Debugger) then
  2631. Debugger^.SetCommand('width ' + IntToStr(Size.X-1));
  2632. {$endif GDBMI}
  2633. {$endif NODEBUG}
  2634. Editor^.silent:=false;
  2635. Editor^.AutoRepeat:=true;
  2636. Editor^.InsertText(GDBPrompt);
  2637. end;
  2638. procedure TGDBWindow.HandleEvent(var Event: TEvent);
  2639. var DontClear: boolean;
  2640. begin
  2641. case Event.What of
  2642. evCommand :
  2643. begin
  2644. DontClear:=false;
  2645. case Event.Command of
  2646. cmSaveAs :
  2647. Editor^.SaveAs;
  2648. else DontClear:=true;
  2649. end;
  2650. if DontClear=false then ClearEvent(Event);
  2651. end;
  2652. end;
  2653. inherited HandleEvent(Event);
  2654. end;
  2655. destructor TGDBWindow.Done;
  2656. begin
  2657. if @Self=GDBWindow then
  2658. GDBWindow:=nil;
  2659. inherited Done;
  2660. end;
  2661. constructor TGDBWindow.Load(var S: TStream);
  2662. begin
  2663. inherited Load(S);
  2664. GetSubViewPtr(S,Indicator);
  2665. GetSubViewPtr(S,Editor);
  2666. GDBWindow:=@self;
  2667. end;
  2668. procedure TGDBWindow.Store(var S: TStream);
  2669. begin
  2670. inherited Store(S);
  2671. PutSubViewPtr(S,Indicator);
  2672. PutSubViewPtr(S,Editor);
  2673. end;
  2674. function TGDBWindow.GetPalette: PPalette;
  2675. const P: string[length(CSourceWindow)] = CSourceWindow;
  2676. begin
  2677. GetPalette:=@P;
  2678. end;
  2679. procedure TGDBWindow.WriteOutputText(Buf : PAnsiChar);
  2680. begin
  2681. {selected normal color ?}
  2682. WriteText(Buf,false);
  2683. end;
  2684. procedure TGDBWindow.WriteErrorText(Buf : PAnsiChar);
  2685. begin
  2686. {selected normal color ?}
  2687. WriteText(Buf,true);
  2688. end;
  2689. procedure TGDBWindow.WriteString(Const S : string);
  2690. begin
  2691. Editor^.AddLine(S);
  2692. end;
  2693. procedure TGDBWindow.WriteErrorString(Const S : string);
  2694. begin
  2695. Editor^.AddErrorLine(S);
  2696. end;
  2697. procedure TGDBWindow.WriteText(Buf : PAnsiChar;IsError : boolean);
  2698. var p,pe : PAnsiChar;
  2699. s : string;
  2700. begin
  2701. p:=buf;
  2702. DeskTop^.Lock;
  2703. While assigned(p) and (p^<>#0) do
  2704. begin
  2705. pe:=strscan(p,#10);
  2706. { if pe-p is more than High(s), discard for this round }
  2707. if (pe<>nil) and (pe-p > high(s)) then
  2708. pe:=nil;
  2709. if (pe<>nil) then
  2710. pe^:=#0;
  2711. s:=strpas(p);
  2712. If IsError then
  2713. Editor^.AddErrorLine(S)
  2714. else
  2715. Editor^.AddLine(S);
  2716. { restore for dispose }
  2717. if pe<>nil then
  2718. pe^:=#10;
  2719. if pe=nil then
  2720. begin
  2721. if strlen(p)<High(s) then
  2722. p:=nil
  2723. else
  2724. p:=p+High(s);
  2725. end
  2726. else
  2727. begin
  2728. p:=pe;
  2729. inc(p);
  2730. end;
  2731. end;
  2732. DeskTop^.Unlock;
  2733. Editor^.Draw;
  2734. end;
  2735. procedure TGDBWindow.UpdateCommands;
  2736. var Active: boolean;
  2737. begin
  2738. Active:=GetState(sfActive);
  2739. SetCmdState([cmSaveAs,cmHide,cmRun],Active);
  2740. SetCmdState(EditorCmds,Active);
  2741. SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmd+RedoCmd,Active);
  2742. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  2743. end;
  2744. function TDisasLineCollection.At(Index: sw_Integer): PDisasLine;
  2745. begin
  2746. At := PDisasLine(Inherited At(Index));
  2747. end;
  2748. constructor TDisassemblyEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  2749. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  2750. begin
  2751. Inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,AFileName);
  2752. GrowMode:=gfGrowHiX+gfGrowHiY;
  2753. SetFlags(efInsertMode+efSyntaxHighlight+efNoIndent+efExpandAllTabs{+efHighlightRow});
  2754. New(DisasLines,Init(500,1000));
  2755. Core^.ChangeLinesTo(DisasLines);
  2756. { do not allow to write into that window }
  2757. ReadOnly:=true;
  2758. AddLine('');
  2759. MinAddress:=0;
  2760. MaxAddress:=0;
  2761. CurL:=nil;
  2762. OwnsSource:=false;
  2763. Source:=nil;
  2764. end;
  2765. destructor TDisassemblyEditor.Done;
  2766. begin
  2767. ReleaseSource;
  2768. Inherited Done;
  2769. end;
  2770. procedure TDisassemblyEditor.ReleaseSource;
  2771. begin
  2772. if OwnsSource and assigned(source) then
  2773. begin
  2774. Desktop^.Delete(Source);
  2775. Dispose(Source,Done);
  2776. end;
  2777. OwnsSource:=false;
  2778. Source:=nil;
  2779. CurrentSource:='';
  2780. end;
  2781. procedure TDisassemblyEditor.AddSourceLine(const AFileName: string;line : longint);
  2782. var
  2783. S : sw_astring;
  2784. begin
  2785. if AFileName<>CurrentSource then
  2786. begin
  2787. ReleaseSource;
  2788. Source:=SearchOnDesktop(FileName,false);
  2789. if not assigned(Source) then
  2790. begin
  2791. Source:=ITryToOpenFile(nil,AFileName,0,line,false,false,true);
  2792. OwnsSource:=true;
  2793. end
  2794. else
  2795. OwnsSource:=false;
  2796. CurrentSource:=AFileName;
  2797. end;
  2798. if Assigned(Source) and (line>0) then
  2799. S:=Trim(Source^.Editor^.GetLineText(line-1))
  2800. else
  2801. S:='<source not found>';
  2802. CurrentLine:=Line;
  2803. inherited AddLine(AFileName+':'+IntToStr(line)+' '+S);
  2804. { display differently }
  2805. SetLineFlagState(GetLineCount-1,lfSpecialRow,true);
  2806. LimitsChanged;
  2807. end;
  2808. procedure TDisassemblyEditor.AddAssemblyLine(const S: string;AAddress : CORE_ADDR);
  2809. var
  2810. PL : PDisasLine;
  2811. LI : PEditorLineInfo;
  2812. begin
  2813. if AAddress<>0 then
  2814. inherited AddLine('$'+hexstr(AAddress,sizeof(CORE_ADDR)*2)+S)
  2815. else
  2816. inherited AddLine(S);
  2817. PL:=DisasLines^.At(DisasLines^.count-1);
  2818. PL^.Address:=AAddress;
  2819. LI:=PL^.GetEditorInfo(@Self);
  2820. if AAddress<>0 then
  2821. LI^.BeginsWithAsm:=true;
  2822. LimitsChanged;
  2823. if ((AAddress<minaddress) or (minaddress=0)) and (AAddress<>0) then
  2824. MinAddress:=AAddress;
  2825. if (AAddress>maxaddress) or (maxaddress=0) then
  2826. MaxAddress:=AAddress;
  2827. end;
  2828. function TDisassemblyEditor.GetCurrentLine(address : CORE_ADDR) : PDisasLine;
  2829. function IsCorrectLine(PL : PDisasLine) : boolean;
  2830. begin
  2831. IsCorrectLine:=PL^.Address=Address;
  2832. end;
  2833. Var
  2834. PL : PDisasLine;
  2835. begin
  2836. PL:=DisasLines^.FirstThat(TCallbackFunBoolParam(@IsCorrectLine));
  2837. if Assigned(PL) then
  2838. begin
  2839. if assigned(CurL) then
  2840. CurL^.SetFlagState(lfDebuggerRow,false);
  2841. SetCurPtr(0,DisasLines^.IndexOf(PL));
  2842. PL^.SetFlags(lfDebuggerRow);
  2843. CurL:=PL;
  2844. TrackCursor(do_not_centre);
  2845. end;
  2846. GetCurrentLine:=PL;
  2847. end;
  2848. { PDisassemblyWindow = ^TDisassemblyWindow;
  2849. TDisassemblyWindow = object(TFPWindow)
  2850. Editor : PDisassemblyEditor;
  2851. Indicator : PIndicator; }
  2852. constructor TDisassemblyWindow.Init(var Bounds: TRect);
  2853. var HSB,VSB: PScrollBar;
  2854. R: TRect;
  2855. begin
  2856. inherited Init(Bounds,dialog_disaswindow,0);
  2857. Options:=Options or ofTileAble;
  2858. AutoNumber:=true;
  2859. HelpCtx:=hcDisassemblyWindow;
  2860. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  2861. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  2862. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  2863. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2864. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  2865. New(Indicator, Init(R));
  2866. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  2867. Insert(Indicator);
  2868. GetExtent(R); R.Grow(-1,-1);
  2869. New(Editor, Init(R, HSB, VSB, nil, GDBOutputFile));
  2870. Insert(Editor);
  2871. DisassemblyWindow:=@Self;
  2872. end;
  2873. procedure TDisassemblyWindow.LoadFunction(Const FuncName : string);
  2874. var
  2875. p : PAnsiChar;
  2876. begin
  2877. {$ifndef NODEBUG}
  2878. If not assigned(Debugger) then Exit;
  2879. Debugger^.SetCommand('print symbol on');
  2880. Debugger^.SetCommand('width 0');
  2881. Debugger^.Command('disas /m '+FuncName);
  2882. p:=StrNew(Debugger^.GetOutput);
  2883. ProcessPChar(p);
  2884. if (Debugger^.IsRunning) and (FuncName='') then
  2885. Editor^.GetCurrentLine(Debugger^.current_pc);
  2886. {$endif NODEBUG}
  2887. end;
  2888. procedure TDisassemblyWindow.LoadAddress(Addr : CORE_ADDR);
  2889. var
  2890. p : PAnsiChar;
  2891. begin
  2892. {$ifndef NODEBUG}
  2893. If not assigned(Debugger) then Exit;
  2894. Debugger^.SetCommand('print symbol on');
  2895. Debugger^.SetCommand('width 0');
  2896. Debugger^.Command('disas /m 0x'+HexStr(Addr,sizeof(Addr)*2));
  2897. p:=StrNew(Debugger^.GetOutput);
  2898. ProcessPChar(p);
  2899. if Debugger^.IsRunning and
  2900. (Debugger^.current_pc>=Editor^.MinAddress) and
  2901. (Debugger^.current_pc<=Editor^.MaxAddress) then
  2902. Editor^.GetCurrentLine(Debugger^.current_pc);
  2903. {$endif NODEBUG}
  2904. end;
  2905. function TDisassemblyWindow.ProcessPChar(p : PAnsiChar) : boolean;
  2906. var
  2907. p1: PAnsiChar;
  2908. pline : PAnsiChar;
  2909. pos1, pos2, CurLine, PrevLine : longint;
  2910. CurAddr : CORE_ADDR;
  2911. err : word;
  2912. curaddress, cursymofs, CurFile,
  2913. PrevFile, line : string;
  2914. begin
  2915. ProcessPChar:=true;
  2916. Lock;
  2917. Editor^.DisasLines^.FreeAll;
  2918. Editor^.SetFlags(Editor^.GetFlags or efSyntaxHighlight or efKeepLineAttr);
  2919. Editor^.MinAddress:=0;
  2920. Editor^.MaxAddress:=0;
  2921. Editor^.CurL:=nil;
  2922. p1:=p;
  2923. PrevFile:='';
  2924. PrevLine:=0;
  2925. while assigned(p) do
  2926. begin
  2927. pline:=strscan(p,#10);
  2928. if assigned(pline) then
  2929. pline^:=#0;
  2930. line:=trim(strpas(p));
  2931. CurAddr:=0;
  2932. if assigned(pline) then
  2933. begin
  2934. pline^:=#10;
  2935. p:=pline+1;
  2936. end
  2937. else
  2938. p:=nil;
  2939. { now process the line }
  2940. { Remove current position marker }
  2941. if copy(line,1,3)='=> ' then
  2942. begin
  2943. system.delete(line,1,3);
  2944. end;
  2945. { line is hexaddr <symbol+sym_offset at filename:line> assembly }
  2946. pos1:=pos('<',line);
  2947. if pos1>0 then
  2948. begin
  2949. curaddress:=trim(copy(line,1,pos1-1));
  2950. if copy(curaddress,1,2)='0x' then
  2951. curaddress:='$'+copy(curaddress,3,length(curaddress)-2);
  2952. val(curaddress,CurAddr,err);
  2953. if err>0 then
  2954. val(copy(curaddress,1,err-1),CurAddr,err);
  2955. system.delete(line,1,pos1);
  2956. end;
  2957. pos1:=pos(' at ',line);
  2958. pos2:=pos('>',line);
  2959. if (pos1>0) and (pos1 < pos2) then
  2960. begin
  2961. cursymofs:=copy(line,1,pos1-1);
  2962. CurFile:=copy(line,pos1+4,pos2-pos1-4);
  2963. pos1:=pos(':',CurFile);
  2964. if pos1>0 then
  2965. begin
  2966. val(copy(CurFile,pos1+1,high(CurFile)),CurLine,err);
  2967. system.delete(CurFile,pos1,high(CurFile));
  2968. end
  2969. else
  2970. CurLine:=0;
  2971. system.delete(line,1,pos2);
  2972. end
  2973. else { no ' at ' found before '>' }
  2974. begin
  2975. cursymofs:=copy(line,1,pos2-1);
  2976. CurFile:='';
  2977. system.delete(line,1,pos2);
  2978. end;
  2979. if (CurFile<>'') and ((CurFile<>PrevFile) or (CurLine<>PrevLine)) then
  2980. begin
  2981. WriteSourceString(CurFile,CurLine);
  2982. PrevLine:=CurLine;
  2983. PrevFile:=CurFile;
  2984. end;
  2985. WriteDisassemblyString(line,curaddr);
  2986. end;
  2987. StrDispose(p1);
  2988. Editor^.ReleaseSource;
  2989. Editor^.UpdateAttrs(0,attrForceFull);
  2990. If assigned(BreakpointsCollection) then
  2991. BreakpointsCollection^.ShowBreakpoints(@Self);
  2992. Unlock;
  2993. ReDraw;
  2994. end;
  2995. procedure TDisassemblyWindow.HandleEvent(var Event: TEvent);
  2996. begin
  2997. inherited HandleEvent(Event);
  2998. end;
  2999. procedure TDisassemblyWindow.WriteSourceString(Const S : string;line : longint);
  3000. begin
  3001. Editor^.AddSourceLine(S,line);
  3002. end;
  3003. procedure TDisassemblyWindow.WriteDisassemblyString(Const S : string;address : CORE_ADDR);
  3004. begin
  3005. Editor^.AddAssemblyLine(S,address);
  3006. end;
  3007. procedure TDisassemblyWindow.SetCurAddress(address : CORE_ADDR);
  3008. begin
  3009. if (address<Editor^.MinAddress) or (address>Editor^.MaxAddress) then
  3010. LoadAddress(address);
  3011. Editor^.GetCurrentLine(address);
  3012. end;
  3013. procedure TDisassemblyWindow.UpdateCommands;
  3014. var Active: boolean;
  3015. begin
  3016. Active:=GetState(sfActive);
  3017. SetCmdState(SourceCmds+CompileCmds,Active);
  3018. SetCmdState(EditorCmds,Active);
  3019. SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmd+RedoCmd,false);
  3020. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  3021. end;
  3022. function TDisassemblyWindow.GetPalette: PPalette;
  3023. const P: string[length(CSourceWindow)] = CSourceWindow;
  3024. begin
  3025. GetPalette:=@P;
  3026. end;
  3027. destructor TDisassemblyWindow.Done;
  3028. begin
  3029. if @Self=DisassemblyWindow then
  3030. DisassemblyWindow:=nil;
  3031. inherited Done;
  3032. end;
  3033. {$endif NODEBUG}
  3034. constructor TClipboardWindow.Init;
  3035. var R: TRect;
  3036. HSB,VSB: PScrollBar;
  3037. begin
  3038. Desktop^.GetExtent(R);
  3039. inherited Init(R, '*');
  3040. SetTitle(dialog_clipboard);
  3041. HelpCtx:=hcClipboardWindow;
  3042. Number:=wnNoNumber;
  3043. AutoNumber:=true;
  3044. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  3045. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  3046. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  3047. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  3048. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  3049. New(Indicator, Init(R));
  3050. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  3051. Insert(Indicator);
  3052. GetExtent(R); R.Grow(-1,-1);
  3053. New(Editor, Init(R, HSB, VSB, Indicator, ''));
  3054. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3055. Insert(Editor);
  3056. Editor^.SetFlags(Editor^.GetFlags or efUseTabCharacters);
  3057. Hide;
  3058. Clipboard:=Editor;
  3059. end;
  3060. procedure TClipboardWindow.Close;
  3061. begin
  3062. Hide;
  3063. end;
  3064. constructor TClipboardWindow.Load(var S: TStream);
  3065. begin
  3066. inherited Load(S);
  3067. Clipboard:=Editor;
  3068. end;
  3069. procedure TClipboardWindow.Store(var S: TStream);
  3070. begin
  3071. inherited Store(S);
  3072. end;
  3073. destructor TClipboardWindow.Done;
  3074. begin
  3075. inherited Done;
  3076. Clipboard:=nil;
  3077. ClipboardWindow:=nil;
  3078. end;
  3079. constructor TMessageListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  3080. begin
  3081. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  3082. GrowMode:=gfGrowHiX+gfGrowHiY;
  3083. New(ModuleNames, Init(50,100));
  3084. NoSelection:=true;
  3085. end;
  3086. function TMessageListBox.GetLocalMenu: PMenu;
  3087. var M: PMenu;
  3088. begin
  3089. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  3090. M:=NewMenu(
  3091. NewItem(menu_msglocal_clear,'',kbNoKey,cmMsgClear,hcMsgClear,
  3092. NewLine(
  3093. NewItem(menu_msglocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  3094. NewItem(menu_msglocal_tracksource,'',kbNoKey,cmMsgTrackSource,hcMsgTrackSource,
  3095. NewLine(
  3096. NewItem(menu_msglocal_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  3097. nil)))))));
  3098. GetLocalMenu:=M;
  3099. end;
  3100. procedure TMessageListBox.SetState(AState: Word; Enable: Boolean);
  3101. var OldState: word;
  3102. begin
  3103. OldState:=State;
  3104. inherited SetState(AState,Enable);
  3105. if ((AState and sfActive)<>0) and (((OldState xor State) and sfActive)<>0) then
  3106. SetCmdState([cmSaveAs],Enable);
  3107. end;
  3108. procedure TMessageListBox.HandleEvent(var Event: TEvent);
  3109. procedure ScrollTo (req : sw_integer);
  3110. begin
  3111. TopItem:=Max(0,Min(Range-1,req));
  3112. If (VScrollBar <> Nil) Then
  3113. VScrollBar^.SetValue(TopItem);
  3114. DrawView;
  3115. end;
  3116. var DontClear: boolean;
  3117. begin
  3118. case Event.What of
  3119. evMouseWheel: Begin { Mouse wheel event }
  3120. if (Event.Wheel=mwDown) then { Mouse scroll down }
  3121. begin
  3122. if Event.Double then ScrollTo(TopItem+7) else ScrollTo(TopItem+1);
  3123. ClearEvent(Event); { Event was handled }
  3124. end else
  3125. if (Event.Wheel=mwUp) then { Mouse scroll up }
  3126. begin
  3127. if Event.Double then ScrollTo(TopItem-7) else ScrollTo(TopItem-1);
  3128. ClearEvent(Event); { Event was handled }
  3129. end;
  3130. end;
  3131. evKeyDown :
  3132. begin
  3133. DontClear:=false;
  3134. case Event.KeyCode of
  3135. kbEnter :
  3136. begin
  3137. Message(@Self,evCommand,cmMsgGotoSource,nil);
  3138. ClearEvent(Event);
  3139. exit;
  3140. end;
  3141. else
  3142. DontClear:=true;
  3143. end;
  3144. if not DontClear then
  3145. ClearEvent(Event);
  3146. end;
  3147. evBroadcast :
  3148. case Event.Command of
  3149. cmListItemSelected :
  3150. if Event.InfoPtr=@Self then
  3151. Message(@Self,evCommand,cmMsgTrackSource,nil);
  3152. end;
  3153. evCommand :
  3154. begin
  3155. DontClear:=false;
  3156. case Event.Command of
  3157. cmMsgGotoSource :
  3158. if Range>0 then
  3159. begin
  3160. GotoSource;
  3161. ClearEvent(Event);
  3162. exit;
  3163. end;
  3164. cmMsgTrackSource :
  3165. if Range>0 then
  3166. TrackSource;
  3167. cmMsgClear :
  3168. Clear;
  3169. cmSaveAs :
  3170. SaveAs;
  3171. else
  3172. DontClear:=true;
  3173. end;
  3174. if not DontClear then
  3175. ClearEvent(Event);
  3176. end;
  3177. end;
  3178. inherited HandleEvent(Event);
  3179. end;
  3180. procedure TMessageListBox.AddItem(P: PMessageItem);
  3181. var W : integer;
  3182. begin
  3183. if List=nil then New(List, Init(500,500));
  3184. W:=length(P^.GetText(255));
  3185. if W>MaxWidth then
  3186. begin
  3187. MaxWidth:=W;
  3188. if HScrollBar<>nil then
  3189. HScrollBar^.SetRange(0,MaxWidth);
  3190. end;
  3191. List^.Insert(P);
  3192. SetRange(List^.Count);
  3193. if Focused=List^.Count-1-1 then
  3194. FocusItem(List^.Count-1);
  3195. DrawView;
  3196. end;
  3197. function TMessageListBox.AddModuleName(const Name: string): PString;
  3198. var P: PString;
  3199. begin
  3200. if ModuleNames<>nil then
  3201. P:=ModuleNames^.Add(Name)
  3202. else
  3203. P:=nil;
  3204. AddModuleName:=P;
  3205. end;
  3206. function TMessageListBox.GetText(Item,MaxLen: Sw_Integer): String;
  3207. var P: PMessageItem;
  3208. S: string;
  3209. begin
  3210. P:=List^.At(Item);
  3211. S:=P^.GetText(MaxLen);
  3212. GetText:=copy(S,1,MaxLen);
  3213. end;
  3214. procedure TMessageListBox.Clear;
  3215. begin
  3216. if assigned(List) then
  3217. Dispose(List, Done);
  3218. List:=nil;
  3219. MaxWidth:=0;
  3220. if assigned(ModuleNames) then
  3221. ModuleNames^.FreeAll;
  3222. SetRange(0); DrawView;
  3223. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  3224. end;
  3225. procedure TMessageListBox.TrackSource;
  3226. var W: PSourceWindow;
  3227. P: PMessageItem;
  3228. R: TRect;
  3229. Row,Col: sw_integer;
  3230. Found : boolean;
  3231. begin
  3232. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  3233. if Range=0 then Exit;
  3234. P:=List^.At(Focused);
  3235. if P^.Row=0 then Exit;
  3236. Desktop^.Lock;
  3237. GetNextEditorBounds(R);
  3238. R.B.Y:=Owner^.Origin.Y;
  3239. if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
  3240. if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
  3241. W:=EditorWindowFile(P^.GetModuleName);
  3242. if assigned(W) then
  3243. begin
  3244. W^.GetExtent(R);
  3245. R.B.Y:=Owner^.Origin.Y;
  3246. W^.ChangeBounds(R);
  3247. W^.Editor^.SetCurPtr(Col,Row);
  3248. end
  3249. else
  3250. W:=TryToOpenFile(@R,P^.GetModuleName,Col,Row,true);
  3251. { Try to find it by browsing }
  3252. if W=nil then
  3253. begin
  3254. Desktop^.UnLock;
  3255. Found:=IDEApp.OpenSearch(P^.GetModuleName+'*');
  3256. if found then
  3257. W:=TryToOpenFile(nil,P^.GetModuleName,Col,Row,true);
  3258. Desktop^.Lock;
  3259. end;
  3260. if W<>nil then
  3261. begin
  3262. W^.Select;
  3263. W^.Editor^.TrackCursor(do_centre);
  3264. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,Row);
  3265. end;
  3266. if Assigned(Owner) then
  3267. Owner^.Select;
  3268. Desktop^.UnLock;
  3269. end;
  3270. procedure TMessageListBox.GotoSource;
  3271. var W: PSourceWindow;
  3272. P: PMessageItem;
  3273. R:TRect;
  3274. Row,Col: sw_integer;
  3275. Found : boolean;
  3276. Event : TEvent;
  3277. begin
  3278. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  3279. if Range=0 then Exit;
  3280. P:=List^.At(Focused);
  3281. if P^.Row=0 then Exit;
  3282. Desktop^.Lock;
  3283. if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
  3284. if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
  3285. W:=EditorWindowFile(P^.GetModuleName);
  3286. if assigned(W) then
  3287. begin
  3288. W^.GetExtent(R);
  3289. if Owner^.Origin.Y>R.A.Y+4 then
  3290. R.B.Y:=Owner^.Origin.Y;
  3291. W^.ChangeBounds(R);
  3292. W^.Editor^.SetCurPtr(Col,Row);
  3293. end
  3294. else
  3295. W:=TryToOpenFile(nil,P^.GetModuleName,Col,Row,true);
  3296. { Try to find it by browsing }
  3297. if W=nil then
  3298. begin
  3299. Desktop^.UnLock;
  3300. Found:=IDEApp.OpenSearch(P^.GetModuleName+'*');
  3301. if found then
  3302. W:=TryToOpenFile(nil,P^.GetModuleName,Col,Row,true);
  3303. Desktop^.Lock;
  3304. end;
  3305. if assigned(W) then
  3306. begin
  3307. { Message(Owner,evCommand,cmClose,nil);
  3308. This calls close on StackWindow
  3309. rendering P invalid
  3310. so postpone it PM }
  3311. W^.GetExtent(R);
  3312. if (P^.TClass<>0) then
  3313. W^.Editor^.SetErrorMessage(P^.GetText(R.B.X-R.A.X));
  3314. W^.Select;
  3315. Owner^.Hide;
  3316. end;
  3317. Desktop^.UnLock;
  3318. if assigned(W) then
  3319. begin
  3320. Event.What:=evCommand;
  3321. Event.command:=cmClose;
  3322. Event.InfoPtr:=nil;
  3323. fpide.PutEvent(Owner,Event);
  3324. end;
  3325. end;
  3326. procedure TMessageListBox.Draw;
  3327. var
  3328. I, J, Item: Sw_Integer;
  3329. NormalColor, SelectedColor, FocusedColor, Color: Word;
  3330. ColWidth, CurCol, Indent: Integer;
  3331. B: TDrawBuffer;
  3332. Text: String;
  3333. SCOff: Byte;
  3334. TC: byte;
  3335. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  3336. begin
  3337. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  3338. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  3339. begin
  3340. NormalColor := GetColor(1);
  3341. FocusedColor := GetColor(3);
  3342. SelectedColor := GetColor(4);
  3343. end else
  3344. begin
  3345. NormalColor := GetColor(2);
  3346. SelectedColor := GetColor(4);
  3347. end;
  3348. if Transparent then
  3349. begin MT(NormalColor); MT(SelectedColor); end;
  3350. if NoSelection then
  3351. SelectedColor:=NormalColor;
  3352. if HScrollBar <> nil then Indent := HScrollBar^.Value
  3353. else Indent := 0;
  3354. ColWidth := Size.X div NumCols + 1;
  3355. for I := 0 to Size.Y - 1 do
  3356. begin
  3357. for J := 0 to NumCols-1 do
  3358. begin
  3359. Item := J*Size.Y + I + TopItem;
  3360. CurCol := J*ColWidth;
  3361. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  3362. (Focused = Item) and (Range > 0) then
  3363. begin
  3364. Color := FocusedColor;
  3365. SetCursor(CurCol+1,I);
  3366. SCOff := 0;
  3367. end
  3368. else if (Item < Range) and IsSelected(Item) then
  3369. begin
  3370. Color := SelectedColor;
  3371. SCOff := 2;
  3372. end
  3373. else
  3374. begin
  3375. Color := NormalColor;
  3376. SCOff := 4;
  3377. end;
  3378. MoveChar(B[CurCol], ' ', Color, ColWidth);
  3379. if Item < Range then
  3380. begin
  3381. Text := GetText(Item, ColWidth + Indent);
  3382. Text := Copy(Text,Indent,ColWidth);
  3383. MoveStr(B[CurCol+1], Text, Color);
  3384. if ShowMarkers then
  3385. begin
  3386. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  3387. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  3388. end;
  3389. end;
  3390. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  3391. end;
  3392. WriteLine(0, I, Size.X, 1, B);
  3393. end;
  3394. end;
  3395. constructor TMessageListBox.Load(var S: TStream);
  3396. begin
  3397. inherited Load(S);
  3398. New(ModuleNames, Init(50,100));
  3399. NoSelection:=true;
  3400. end;
  3401. procedure TMessageListBox.Store(var S: TStream);
  3402. var OL: PCollection;
  3403. ORV: sw_integer;
  3404. begin
  3405. OL:=List; ORV:=Range;
  3406. New(List, Init(1,1)); Range:=0;
  3407. inherited Store(S);
  3408. Dispose(List, Done);
  3409. List:=OL; Range:=ORV;
  3410. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  3411. collection? Pasting here a modified version of TListBox.Store+
  3412. TAdvancedListBox.Store isn't a better solution, since by eventually
  3413. changing the obj-hierarchy you'll always have to modify this, too - BG }
  3414. end;
  3415. destructor TMessageListBox.Done;
  3416. begin
  3417. inherited Done;
  3418. if List<>nil then Dispose(List, Done);
  3419. if ModuleNames<>nil then Dispose(ModuleNames, Done);
  3420. end;
  3421. constructor TMessageItem.Init(AClass: longint; const AText: string; AModule: PString; ARow, ACol: sw_integer);
  3422. begin
  3423. inherited Init;
  3424. TClass:=AClass;
  3425. Text:=NewStr(AText);
  3426. Module:=AModule;
  3427. Row:=ARow; Col:=ACol;
  3428. end;
  3429. function TMessageItem.GetText(MaxLen: Sw_integer): string;
  3430. var S: string;
  3431. begin
  3432. if Text=nil then S:='' else S:=Text^;
  3433. if (Module<>nil) then
  3434. S:=NameAndExtOf(Module^)+'('+IntToStr(Row)+') '+S;
  3435. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  3436. GetText:=S;
  3437. end;
  3438. procedure TMessageItem.Selected;
  3439. begin
  3440. end;
  3441. function TMessageItem.GetModuleName: string;
  3442. begin
  3443. GetModuleName:=GetStr(Module);
  3444. end;
  3445. destructor TMessageItem.Done;
  3446. begin
  3447. inherited Done;
  3448. if Text<>nil then DisposeStr(Text);
  3449. { if Module<>nil then DisposeStr(Module);}
  3450. end;
  3451. procedure TFPDlgWindow.HandleEvent(var Event: TEvent);
  3452. begin
  3453. case Event.What of
  3454. evBroadcast :
  3455. case Event.Command of
  3456. cmSearchWindow+1..cmSearchWindow+99 :
  3457. if (Event.Command-cmSearchWindow=Number) then
  3458. ClearEvent(Event);
  3459. end;
  3460. end;
  3461. inherited HandleEvent(Event);
  3462. end;
  3463. (*
  3464. constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
  3465. begin
  3466. inherited Init(Bounds);
  3467. Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
  3468. GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
  3469. TabDefs:=ATabDef;
  3470. ActiveDef:=-1;
  3471. SelectTab(0);
  3472. ReDraw;
  3473. end;
  3474. function TTab.TabCount: integer;
  3475. var i: integer;
  3476. P: PTabDef;
  3477. begin
  3478. I:=0; P:=TabDefs;
  3479. while (P<>nil) do
  3480. begin
  3481. Inc(I);
  3482. P:=P^.Next;
  3483. end;
  3484. TabCount:=I;
  3485. end;
  3486. function TTab.AtTab(Index: integer): PTabDef;
  3487. var i: integer;
  3488. P: PTabDef;
  3489. begin
  3490. i:=0; P:=TabDefs;
  3491. while (I<Index) do
  3492. begin
  3493. if P=nil then RunError($AA);
  3494. P:=P^.Next;
  3495. Inc(i);
  3496. end;
  3497. AtTab:=P;
  3498. end;
  3499. procedure TTab.SelectTab(Index: integer);
  3500. var P: PTabItem;
  3501. V: PView;
  3502. begin
  3503. if ActiveDef<>Index then
  3504. begin
  3505. if Owner<>nil then Owner^.Lock;
  3506. Lock;
  3507. { --- Update --- }
  3508. if TabDefs<>nil then
  3509. begin
  3510. DefCount:=1;
  3511. while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
  3512. end
  3513. else DefCount:=0;
  3514. if ActiveDef<>-1 then
  3515. begin
  3516. P:=AtTab(ActiveDef)^.Items;
  3517. while P<>nil do
  3518. begin
  3519. if P^.View<>nil then Delete(P^.View);
  3520. P:=P^.Next;
  3521. end;
  3522. end;
  3523. ActiveDef:=Index;
  3524. P:=AtTab(ActiveDef)^.Items;
  3525. while P<>nil do
  3526. begin
  3527. if P^.View<>nil then Insert(P^.View);
  3528. P:=P^.Next;
  3529. end;
  3530. V:=AtTab(ActiveDef)^.DefItem;
  3531. if V<>nil then V^.Select;
  3532. ReDraw;
  3533. { --- Update --- }
  3534. UnLock;
  3535. if Owner<>nil then Owner^.UnLock;
  3536. DrawView;
  3537. end;
  3538. end;
  3539. procedure TTab.ChangeBounds(var Bounds: TRect);
  3540. var D: TPoint;
  3541. procedure DoCalcChange(P: PView);
  3542. var
  3543. R: TRect;
  3544. begin
  3545. if P^.Owner=nil then Exit; { it think this is a bug in TV }
  3546. P^.CalcBounds(R, D);
  3547. P^.ChangeBounds(R);
  3548. end;
  3549. var
  3550. P: PTabItem;
  3551. I: integer;
  3552. begin
  3553. D.X := Bounds.B.X - Bounds.A.X - Size.X;
  3554. D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
  3555. inherited ChangeBounds(Bounds);
  3556. for I:=0 to TabCount-1 do
  3557. if I<>ActiveDef then
  3558. begin
  3559. P:=AtTab(I)^.Items;
  3560. while P<>nil do
  3561. begin
  3562. if P^.View<>nil then DoCalcChange(P^.View);
  3563. P:=P^.Next;
  3564. end;
  3565. end;
  3566. end;
  3567. procedure TTab.SelectNextTab(Forwards: boolean);
  3568. var Index: integer;
  3569. begin
  3570. Index:=ActiveDef;
  3571. if Index=-1 then Exit;
  3572. if Forwards then Inc(Index) else Dec(Index);
  3573. if Index<0 then Index:=DefCount-1 else
  3574. if Index>DefCount-1 then Index:=0;
  3575. SelectTab(Index);
  3576. end;
  3577. procedure TTab.HandleEvent(var Event: TEvent);
  3578. var Index : integer;
  3579. I : integer;
  3580. X : integer;
  3581. Len : byte;
  3582. P : TPoint;
  3583. V : PView;
  3584. CallOrig: boolean;
  3585. LastV : PView;
  3586. FirstV: PView;
  3587. function FirstSelectable: PView;
  3588. var
  3589. FV : PView;
  3590. begin
  3591. FV := First;
  3592. while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
  3593. FV:=FV^.Next;
  3594. if FV<>nil then
  3595. if (FV^.Options and ofSelectable)=0 then FV:=nil;
  3596. FirstSelectable:=FV;
  3597. end;
  3598. function LastSelectable: PView;
  3599. var
  3600. LV : PView;
  3601. begin
  3602. LV := Last;
  3603. while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
  3604. LV:=LV^.Prev;
  3605. if LV<>nil then
  3606. if (LV^.Options and ofSelectable)=0 then LV:=nil;
  3607. LastSelectable:=LV;
  3608. end;
  3609. begin
  3610. if (Event.What and evMouseDown)<>0 then
  3611. begin
  3612. MakeLocal(Event.Where,P);
  3613. if P.Y<3 then
  3614. begin
  3615. Index:=-1; X:=1;
  3616. for i:=0 to DefCount-1 do
  3617. begin
  3618. Len:=CStrLen(AtTab(i)^.Name^);
  3619. if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
  3620. X:=X+Len+3;
  3621. end;
  3622. if Index<>-1 then
  3623. SelectTab(Index);
  3624. end;
  3625. end;
  3626. if Event.What=evKeyDown then
  3627. begin
  3628. Index:=-1;
  3629. case Event.KeyCode of
  3630. kbCtrlTab :
  3631. begin
  3632. SelectNextTab((Event.KeyShift and kbShift)=0);
  3633. ClearEvent(Event);
  3634. end;
  3635. kbTab,kbShiftTab :
  3636. if GetState(sfSelected) then
  3637. begin
  3638. if Current<>nil then
  3639. begin
  3640. LastV:=LastSelectable; FirstV:=FirstSelectable;
  3641. if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
  3642. begin
  3643. if Owner<>nil then Owner^.SelectNext(true);
  3644. end else
  3645. if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
  3646. begin
  3647. Lock;
  3648. if Owner<>nil then Owner^.SelectNext(false);
  3649. UnLock;
  3650. end else
  3651. SelectNext(Event.KeyCode=kbShiftTab);
  3652. ClearEvent(Event);
  3653. end;
  3654. end;
  3655. else
  3656. for I:=0 to DefCount-1 do
  3657. begin
  3658. if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
  3659. then begin
  3660. Index:=I;
  3661. ClearEvent(Event);
  3662. Break;
  3663. end;
  3664. end;
  3665. end;
  3666. if Index<>-1 then
  3667. begin
  3668. Select;
  3669. SelectTab(Index);
  3670. V:=AtTab(ActiveDef)^.DefItem;
  3671. if V<>nil then V^.Focus;
  3672. end;
  3673. end;
  3674. CallOrig:=true;
  3675. if Event.What=evKeyDown then
  3676. begin
  3677. if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
  3678. then
  3679. else CallOrig:=false;
  3680. end;
  3681. if CallOrig then inherited HandleEvent(Event);
  3682. end;
  3683. function TTab.GetPalette: PPalette;
  3684. begin
  3685. GetPalette:=nil;
  3686. end;
  3687. procedure TTab.Draw;
  3688. var B : TDrawBuffer;
  3689. i : integer;
  3690. C1,C2,C3,C : word;
  3691. HeaderLen : integer;
  3692. X,X2 : integer;
  3693. Name : PString;
  3694. ActiveKPos : integer;
  3695. ActiveVPos : integer;
  3696. FC : AnsiChar;
  3697. ClipR : TRect;
  3698. procedure SWriteBuf(X,Y,W,H: integer; var Buf);
  3699. var i: integer;
  3700. begin
  3701. if Y+H>Size.Y then H:=Size.Y-Y;
  3702. if X+W>Size.X then W:=Size.X-X;
  3703. if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
  3704. else for i:=1 to H do
  3705. Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
  3706. end;
  3707. procedure ClearBuf;
  3708. begin
  3709. MoveChar(B,' ',C1,Size.X);
  3710. end;
  3711. begin
  3712. if InDraw then Exit;
  3713. InDraw:=true;
  3714. { - Start of TGroup.Draw - }
  3715. { if Buffer = nil then
  3716. begin
  3717. GetBuffer;
  3718. end; }
  3719. { - Start of TGroup.Draw - }
  3720. C1:=GetColor(1); C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256; C3:=GetColor(8)+GetColor({9}8)*256;
  3721. HeaderLen:=0; for i:=0 to DefCount-1 do HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3; Dec(HeaderLen);
  3722. if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
  3723. { --- 1. sor --- }
  3724. ClearBuf; MoveChar(B[0],''#$B3'',C1,1); MoveChar(B[HeaderLen+1],''#$B3'',C1,1);
  3725. X:=1;
  3726. for i:=0 to DefCount-1 do
  3727. begin
  3728. Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
  3729. if i=ActiveDef
  3730. then begin
  3731. ActiveKPos:=X-1;
  3732. ActiveVPos:=X+X2+2;
  3733. if GetState(sfFocused) then C:=C3 else C:=C2;
  3734. end
  3735. else C:=C2;
  3736. MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
  3737. MoveChar(B[X-1],''#$B3'',C1,1);
  3738. end;
  3739. SWriteBuf(0,1,Size.X,1,B);
  3740. { --- 0. sor --- }
  3741. ClearBuf; MoveChar(B[0],''#$DA'',C1,1);
  3742. X:=1;
  3743. for i:=0 to DefCount-1 do
  3744. begin
  3745. if I<ActiveDef then FC:=#$DA
  3746. else FC:=#$BF;
  3747. X2:=CStrLen(AtTab(i)^.Name^)+2;
  3748. MoveChar(B[X+X2],{''#$C2''}FC,C1,1);
  3749. if i=DefCount-1 then X2:=X2+1;
  3750. if X2>0 then
  3751. MoveChar(B[X],''#$C4'',C1,X2);
  3752. X:=X+X2+1;
  3753. end;
  3754. MoveChar(B[HeaderLen+1],#$BF,C1,1);
  3755. MoveChar(B[ActiveKPos],#$DA,C1,1); MoveChar(B[ActiveVPos],#$BF,C1,1);
  3756. SWriteBuf(0,0,Size.X,1,B);
  3757. { --- 2. sor --- }
  3758. MoveChar(B[1],#$C4,C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],#$C4,C1,Max(Size.X-HeaderLen-3,0));
  3759. MoveChar(B[Size.X-1],#$BF,C1,1);
  3760. MoveChar(B[ActiveKPos],#$D9,C1,1);
  3761. if ActiveDef=0 then MoveChar(B[0],#$B3,C1,1)
  3762. else MoveChar(B[0],{#$C3}#$DA,C1,1);
  3763. MoveChar(B[HeaderLen+1],#$C4{''#$C1''},C1,1); MoveChar(B[ActiveVPos],#$C0,C1,1);
  3764. MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
  3765. SWriteBuf(0,2,Size.X,1,B);
  3766. { --- marad#$82k sor --- }
  3767. ClearBuf; MoveChar(B[0],''#$B3'',C1,1); MoveChar(B[Size.X-1],''#$B3'',C1,1);
  3768. for i:=3 to Size.Y-1 do
  3769. SWriteBuf(0,i,Size.X,1,B);
  3770. { SWriteBuf(0,3,Size.X,Size.Y-4,B); this was wrong
  3771. because WriteBuf then expect a buffer of size size.x*(size.y-4)*2 PM }
  3772. { --- Size.X . sor --- }
  3773. MoveChar(B[0],''#$C0'',C1,1); MoveChar(B[1],''#$C4'',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],''#$D9'',C1,1);
  3774. SWriteBuf(0,Size.Y-1,Size.X,1,B);
  3775. { - End of TGroup.Draw - }
  3776. if Buffer <> nil then
  3777. begin
  3778. Lock;
  3779. Redraw;
  3780. UnLock;
  3781. end;
  3782. if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
  3783. begin
  3784. GetClipRect(ClipR);
  3785. Redraw;
  3786. GetExtent(ClipR);
  3787. end;
  3788. { - End of TGroup.Draw - }
  3789. InDraw:=false;
  3790. end;
  3791. function TTab.Valid(Command: Word): Boolean;
  3792. var PT : PTabDef;
  3793. PI : PTabItem;
  3794. OK : boolean;
  3795. begin
  3796. OK:=true;
  3797. PT:=TabDefs;
  3798. while (PT<>nil) and (OK=true) do
  3799. begin
  3800. PI:=PT^.Items;
  3801. while (PI<>nil) and (OK=true) do
  3802. begin
  3803. if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
  3804. PI:=PI^.Next;
  3805. end;
  3806. PT:=PT^.Next;
  3807. end;
  3808. Valid:=OK;
  3809. end;
  3810. procedure TTab.SetState(AState: Word; Enable: Boolean);
  3811. begin
  3812. inherited SetState(AState,Enable);
  3813. if (AState and sfFocused)<>0 then DrawView;
  3814. end;
  3815. destructor TTab.Done;
  3816. var P,X: PTabDef;
  3817. procedure DeleteViews(P: PView);
  3818. begin
  3819. if P<>nil then Delete(P);
  3820. end;
  3821. begin
  3822. ForEach(TCallbackProcParam(@DeleteViews));
  3823. inherited Done;
  3824. P:=TabDefs;
  3825. while P<>nil do
  3826. begin
  3827. X:=P^.Next;
  3828. DisposeTabDef(P);
  3829. P:=X;
  3830. end;
  3831. end;
  3832. *)
  3833. constructor TScreenView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  3834. AScreen: PScreen);
  3835. begin
  3836. inherited Init(Bounds,AHScrollBar,AVScrollBar);
  3837. Screen:=AScreen;
  3838. if Screen=nil then
  3839. Fail;
  3840. SetState(sfCursorVis,true);
  3841. Update;
  3842. end;
  3843. procedure TScreenView.Update;
  3844. begin
  3845. SetLimit(UserScreen^.GetWidth,UserScreen^.GetHeight);
  3846. DrawView;
  3847. end;
  3848. procedure TScreenView.HandleEvent(var Event: TEvent);
  3849. begin
  3850. case Event.What of
  3851. evBroadcast :
  3852. case Event.Command of
  3853. cmUpdate : Update;
  3854. end;
  3855. end;
  3856. inherited HandleEvent(Event);
  3857. end;
  3858. procedure TScreenView.Draw;
  3859. var B: TDrawBuffer;
  3860. X,Y: integer;
  3861. Text,Attr: string;
  3862. P: TPoint;
  3863. begin
  3864. Screen^.GetCursorPos(P);
  3865. for Y:=Delta.Y to Delta.Y+Size.Y-1 do
  3866. begin
  3867. if Y<Screen^.GetHeight then
  3868. Screen^.GetLine(Y,Text,Attr)
  3869. else
  3870. begin Text:=''; Attr:=''; end;
  3871. Text:=copy(Text,Delta.X+1,255); Attr:=copy(Attr,Delta.X+1,255);
  3872. MoveChar(B,' ',GetColor(1),Size.X);
  3873. for X:=1 to length(Text) do
  3874. MoveChar(B[X-1],Text[X],ord(Attr[X]),1);
  3875. WriteLine(0,Y-Delta.Y,Size.X,1,B);
  3876. end;
  3877. SetCursor(P.X-Delta.X,P.Y-Delta.Y);
  3878. end;
  3879. constructor TScreenWindow.Init(AScreen: PScreen; ANumber: integer);
  3880. var R: TRect;
  3881. VSB,HSB: PScrollBar;
  3882. begin
  3883. Desktop^.GetExtent(R);
  3884. inherited Init(R, dialog_userscreen, ANumber);
  3885. Options:=Options or ofTileAble;
  3886. GetExtent(R); R.Grow(-1,-1); R.Move(1,0); R.A.X:=R.B.X-1;
  3887. New(VSB, Init(R)); VSB^.Options:=VSB^.Options or ofPostProcess;
  3888. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  3889. GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.A.Y:=R.B.Y-1;
  3890. New(HSB, Init(R)); HSB^.Options:=HSB^.Options or ofPostProcess;
  3891. HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  3892. GetExtent(R); R.Grow(-1,-1);
  3893. New(ScreenView, Init(R, HSB, VSB, AScreen));
  3894. ScreenView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  3895. Insert(ScreenView);
  3896. UserScreenWindow:=@Self;
  3897. end;
  3898. destructor TScreenWindow.Done;
  3899. begin
  3900. inherited Done;
  3901. UserScreenWindow:=nil;
  3902. end;
  3903. const InTranslate : boolean = false;
  3904. procedure TranslateMouseClick(View: PView; var Event: TEvent);
  3905. procedure TranslateAction(Action: integer);
  3906. var E: TEvent;
  3907. begin
  3908. if Action<>acNone then
  3909. begin
  3910. E:=Event;
  3911. E.What:=evMouseDown; E.Buttons:=mbLeftButton;
  3912. View^.HandleEvent(E);
  3913. Event.What:=evCommand;
  3914. Event.Command:=ActionCommands[Action];
  3915. end;
  3916. end;
  3917. begin
  3918. if InTranslate then Exit;
  3919. InTranslate:=true;
  3920. case Event.What of
  3921. evMouseDown :
  3922. if (GetShiftState and kbAlt)<>0 then
  3923. TranslateAction(AltMouseAction) else
  3924. if (GetShiftState and kbCtrl)<>0 then
  3925. TranslateAction(CtrlMouseAction);
  3926. end;
  3927. InTranslate:=false;
  3928. end;
  3929. function GetNextEditorBounds(var Bounds: TRect): boolean;
  3930. var P: PView;
  3931. begin
  3932. P:=Desktop^.Current;
  3933. while P<>nil do
  3934. begin
  3935. if P^.HelpCtx=hcSourceWindow then Break;
  3936. P:=P^.NextView;
  3937. if P=Desktop^.Current then
  3938. begin
  3939. P:=nil;
  3940. break;
  3941. end;
  3942. end;
  3943. if P=nil then Desktop^.GetExtent(Bounds) else
  3944. begin
  3945. P^.GetBounds(Bounds);
  3946. Inc(Bounds.A.X); Inc(Bounds.A.Y);
  3947. end;
  3948. GetNextEditorBounds:=P<>nil;
  3949. end;
  3950. function IOpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer; ShowIt: boolean): PSourceWindow;
  3951. var R: TRect;
  3952. W: PSourceWindow;
  3953. begin
  3954. if Assigned(Bounds) then R.Copy(Bounds^) else
  3955. GetNextEditorBounds(R);
  3956. PushStatus(FormatStrStr(msg_openingsourcefile,SmartPath(FileName)));
  3957. New(W, Init(R, FileName));
  3958. if ShowIt=false then
  3959. W^.Hide;
  3960. if W<>nil then
  3961. begin
  3962. if (CurX<>0) or (CurY<>0) then
  3963. with W^.Editor^ do
  3964. begin
  3965. SetCurPtr(CurX,CurY);
  3966. TrackCursor(do_centre);
  3967. end;
  3968. W^.HelpCtx:=hcSourceWindow;
  3969. Desktop^.Insert(W);
  3970. { this makes loading a lot slower and is not needed as far as I can see (FK)
  3971. Message(Application,evBroadcast,cmUpdate,nil);
  3972. }
  3973. W^.SetCmdState([cmSaveAll],true);
  3974. end;
  3975. PopStatus;
  3976. IOpenEditorWindow:=W;
  3977. end;
  3978. function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
  3979. begin
  3980. OpenEditorWindow:=IOpenEditorWindow(Bounds,FileName,CurX,CurY,true);
  3981. end;
  3982. function LastSourceEditor : PSourceWindow;
  3983. function IsSearchedSource(P: PView) : boolean;
  3984. begin
  3985. if assigned(P) and
  3986. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  3987. IsSearchedSource:=true
  3988. else
  3989. IsSearchedSource:=false;
  3990. end;
  3991. begin
  3992. LastSourceEditor:=PSourceWindow(Desktop^.FirstThat(@IsSearchedSource));
  3993. end;
  3994. function SearchOnDesktop(FileName : string;tryexts:boolean) : PSourceWindow;
  3995. var
  3996. D,DS : DirStr;
  3997. N,NS : NameStr;
  3998. E,ES : ExtStr;
  3999. SName : string;
  4000. function IsSearchedFile(W : PSourceWindow) : boolean;
  4001. var Found: boolean;
  4002. begin
  4003. Found:=false;
  4004. if (W<>nil) and (W^.HelpCtx=hcSourceWindow) then
  4005. begin
  4006. if (D='') then
  4007. SName:=NameAndExtOf(PSourceWindow(W)^.Editor^.FileName)
  4008. else
  4009. SName:=PSourceWindow(W)^.Editor^.FileName;
  4010. FSplit(SName,DS,NS,ES);
  4011. SName:=UpcaseStr(NS+ES);
  4012. if (E<>'') or (not tryexts) then
  4013. begin
  4014. if D<>'' then
  4015. Found:=UpCaseStr(DS)+SName=UpcaseStr(D+N+E)
  4016. else
  4017. Found:=SName=UpcaseStr(N+E);
  4018. end
  4019. else
  4020. begin
  4021. Found:=SName=UpcaseStr(N+'.pp');
  4022. if Found=false then
  4023. Found:=SName=UpcaseStr(N+'.pas');
  4024. end;
  4025. end;
  4026. IsSearchedFile:=found;
  4027. end;
  4028. function IsSearchedSource(P: PView) : boolean;
  4029. begin
  4030. if assigned(P) and
  4031. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  4032. IsSearchedSource:=IsSearchedFile(PSourceWindow(P))
  4033. else
  4034. IsSearchedSource:=false;
  4035. end;
  4036. begin
  4037. FSplit(FileName,D,N,E);
  4038. SearchOnDesktop:=PSourceWindow(Desktop^.FirstThat(@IsSearchedSource));
  4039. end;
  4040. function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean): PSourceWindow;
  4041. begin
  4042. TryToOpenFile:=ITryToOpenFile(Bounds,FileName,CurX,CurY,tryexts,true,false);
  4043. end;
  4044. function TryToOpenFileMulti(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean): PSourceWindow;
  4045. var srec:SearchRec;
  4046. dir,name,ext : string;
  4047. begin
  4048. fsplit(filename,dir,name,ext);
  4049. dir:=completedir(dir);
  4050. FindFirst(filename,anyfile,Srec);
  4051. while (DosError=0) do
  4052. begin
  4053. ITryToOpenFile(Bounds,dir+srec.name,CurX,CurY,tryexts,true,false);
  4054. FindNext(srec);
  4055. end;
  4056. FindClose(srec);
  4057. end;
  4058. function LocateSingleSourceFile(const FileName: string; tryexts: boolean): string;
  4059. var D : DirStr;
  4060. N : NameStr;
  4061. E : ExtStr;
  4062. function CheckDir(NewDir: DirStr; NewName: NameStr; NewExt: ExtStr): boolean;
  4063. var OK: boolean;
  4064. begin
  4065. NewDir:=CompleteDir(NewDir);
  4066. OK:=ExistsFile(NewDir+NewName+NewExt);
  4067. if OK then begin D:=NewDir; N:=NewName; E:=NewExt; end;
  4068. CheckDir:=OK;
  4069. end;
  4070. function CheckExt(NewExt: ExtStr): boolean;
  4071. var OK: boolean;
  4072. begin
  4073. OK:=false;
  4074. if D<>'' then OK:=CheckDir(D,N,NewExt) else
  4075. if CheckDir('.'+DirSep,N,NewExt) then OK:=true;
  4076. CheckExt:=OK;
  4077. end;
  4078. function TryToLocateIn(const DD : dirstr): boolean;
  4079. var Found: boolean;
  4080. begin
  4081. D:=CompleteDir(DD);
  4082. Found:=true;
  4083. if (E<>'') or (not tryexts) then
  4084. Found:=CheckExt(E)
  4085. else
  4086. if CheckExt('.pp') then
  4087. Found:=true
  4088. else
  4089. if CheckExt('.pas') then
  4090. Found:=true
  4091. else
  4092. if CheckExt('.inc') then
  4093. Found:=true
  4094. { try also without extension if no other exist }
  4095. else
  4096. if CheckExt('') then
  4097. Found:=true
  4098. else
  4099. Found:=false;
  4100. TryToLocateIn:=Found;
  4101. end;
  4102. var Path,DrStr: string;
  4103. Found: boolean;
  4104. begin
  4105. FSplit(FileName,D,N,E);
  4106. Found:=CheckDir(D,N,E);
  4107. if not found then
  4108. Found:=TryToLocateIn('.');
  4109. DrStr:=GetSourceDirectories;
  4110. if not Found then
  4111. While pos(ListSeparator,DrStr)>0 do
  4112. Begin
  4113. Found:=TryToLocateIn(Copy(DrStr,1,pos(ListSeparator,DrStr)-1));
  4114. if Found then
  4115. break;
  4116. DrStr:=Copy(DrStr,pos(ListSeparator,DrStr)+1,High(DrStr));
  4117. End;
  4118. if Found then Path:=FExpand(D+N+E) else Path:='';
  4119. LocateSingleSourceFile:=Path;
  4120. end;
  4121. function LocateSourceFile(const FileName: string; tryexts: boolean): string;
  4122. var P: integer;
  4123. FN,S: string;
  4124. FFN: string;
  4125. begin
  4126. FN:=FileName;
  4127. repeat
  4128. P:=Pos(ListSeparator,FN); if P=0 then P:=length(FN)+1;
  4129. S:=copy(FN,1,P-1); Delete(FN,1,P);
  4130. FFN:=LocateSingleSourceFile(S,tryexts);
  4131. until (FFN<>'') or (FN='');
  4132. LocateSourceFile:=FFN;
  4133. end;
  4134. function ITryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean;
  4135. ShowIt,ForceNewWindow: boolean): PSourceWindow;
  4136. var
  4137. W : PSourceWindow;
  4138. DrStr: string;
  4139. begin
  4140. W:=nil;
  4141. if ForceNewWindow then
  4142. W:=nil
  4143. else
  4144. W:=SearchOnDesktop(FileName,tryexts);
  4145. if W<>nil then
  4146. begin
  4147. NewEditorOpened:=false;
  4148. { if assigned(Bounds) then
  4149. W^.ChangeBounds(Bounds^);}
  4150. W^.Editor^.SetCurPtr(CurX,CurY);
  4151. end
  4152. else
  4153. begin
  4154. DrStr:=LocateSourceFile(FileName,tryexts);
  4155. if DrStr<>'' then
  4156. W:=IOpenEditorWindow(Bounds,DrStr,CurX,CurY,ShowIt);
  4157. NewEditorOpened:=W<>nil;
  4158. if assigned(W) then
  4159. W^.Editor^.SetCurPtr(CurX,CurY);
  4160. end;
  4161. ITryToOpenFile:=W;
  4162. end;
  4163. function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
  4164. var OK: boolean;
  4165. E: PFileEditor;
  4166. R: TRect;
  4167. begin
  4168. R.Assign(0,0,0,0);
  4169. New(E, Init(R,nil,nil,nil,nil,FileName));
  4170. OK:=E<>nil;
  4171. if OK then
  4172. begin
  4173. PushStatus(FormatStrStr(msg_readingfileineditor,FileName));
  4174. OK:=E^.LoadFile;
  4175. PopStatus;
  4176. end;
  4177. if OK then
  4178. begin
  4179. Editor^.Lock;
  4180. E^.SelectAll(true);
  4181. Editor^.InsertFrom(E);
  4182. Editor^.SetCurPtr(0,0);
  4183. Editor^.SelectAll(false);
  4184. Editor^.UnLock;
  4185. Dispose(E, Done);
  4186. end;
  4187. StartEditor:=OK;
  4188. end;
  4189. constructor TTextScroller.Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
  4190. begin
  4191. inherited Init(Bounds,'');
  4192. EventMask:=EventMask or evIdle;
  4193. Speed:=ASpeed; Lines:=AText;
  4194. end;
  4195. function TTextScroller.GetLineCount: integer;
  4196. var Count: integer;
  4197. begin
  4198. if Lines=nil then Count:=0 else
  4199. Count:=Lines^.Count;
  4200. GetLineCount:=Count;
  4201. end;
  4202. function TTextScroller.GetLine(I: integer): string;
  4203. var S: string;
  4204. begin
  4205. if I<Lines^.Count then
  4206. S:=GetStr(Lines^.At(I))
  4207. else
  4208. S:='';
  4209. GetLine:=S;
  4210. end;
  4211. procedure TTextScroller.HandleEvent(var Event: TEvent);
  4212. begin
  4213. case Event.What of
  4214. evIdle :
  4215. Update;
  4216. end;
  4217. inherited HandleEvent(Event);
  4218. end;
  4219. procedure TTextScroller.Update;
  4220. begin
  4221. if abs(GetDosTicks-LastTT)<Speed then Exit;
  4222. Scroll;
  4223. LastTT:=GetDosTicks;
  4224. end;
  4225. procedure TTextScroller.Reset;
  4226. begin
  4227. TopLine:=0;
  4228. LastTT:=GetDosTicks;
  4229. DrawView;
  4230. end;
  4231. procedure TTextScroller.Scroll;
  4232. begin
  4233. Inc(TopLine);
  4234. if TopLine>=GetLineCount then
  4235. Reset;
  4236. DrawView;
  4237. end;
  4238. procedure TTextScroller.Draw;
  4239. var B: TDrawBuffer;
  4240. C: word;
  4241. Count,Y: integer;
  4242. S: string;
  4243. begin
  4244. C:=GetColor(1);
  4245. Count:=GetLineCount;
  4246. for Y:=0 to Size.Y-1 do
  4247. begin
  4248. if Count=0 then S:='' else
  4249. S:=GetLine((TopLine+Y) mod Count);
  4250. if copy(S,1,1)=^C then
  4251. S:=CharStr(' ',Max(0,(Size.X-(length(S)-1)) div 2))+copy(S,2,255);
  4252. MoveChar(B,' ',C,Size.X);
  4253. MoveStr(B,S,C);
  4254. WriteLine(0,Y,Size.X,1,B);
  4255. end;
  4256. end;
  4257. destructor TTextScroller.Done;
  4258. begin
  4259. inherited Done;
  4260. if Lines<>nil then Dispose(Lines, Done);
  4261. end;
  4262. constructor TFPChDirDialog.Init(AOptions: Word; HistoryId: Sw_Word);
  4263. var
  4264. R: TRect;
  4265. DInput : PEditorInputLine;
  4266. Control : PView;
  4267. History : PHistory;
  4268. S : String;
  4269. begin
  4270. inherited init(AOptions,HistoryId);
  4271. HelpCtx:=hcChangeDir;
  4272. {replace TInputLine with TEditorInputLine in order to be able to use Clipboard in it}
  4273. DirInput^.getData(S);
  4274. R.Assign(3, 3, 30, 4);
  4275. DInput := New(PEditorInputLine, Init(R, FileNameLen+4));
  4276. DInput^.GrowMode:=gfGrowHiX;
  4277. DInput^.SetData(S);
  4278. InsertBefore(DInput,DirInput); {insert before to preserv order as it was}
  4279. Delete(DirInput);
  4280. Dispose(DirInput,done);
  4281. DirInput:=DInput;
  4282. Control:=DirInput^.Next; {here we make assumption that THistory control will folow}
  4283. while (Control<> nil) do
  4284. begin
  4285. if TypeOf(Control^) = TypeOf(THistory) then
  4286. begin
  4287. History:=PHistory(Control);
  4288. History^.Link:=DirInput;
  4289. break;
  4290. end;
  4291. Control:=Control^.Next;
  4292. end;
  4293. {resize}
  4294. if Desktop^.Size.Y > 26 then
  4295. GrowTo(Size.X,Desktop^.Size.Y-6);
  4296. if Desktop^.Size.X > 80 then
  4297. GrowTo(Min(Desktop^.Size.X-(80-Size.X),102),Size.Y);
  4298. {set focus on the new input line}
  4299. DirInput^.Focus;
  4300. end;
  4301. constructor TFPAboutDialog.Init;
  4302. var R,R2: TRect;
  4303. C: PUnsortedStringCollection;
  4304. I,nblines: integer;
  4305. OSStr: string;
  4306. procedure AddLine(S: string);
  4307. begin
  4308. C^.Insert(NewStr(S));
  4309. end;
  4310. begin
  4311. R.Assign(0,0,58,14{$ifdef USE_GRAPH_SWITCH}+1{$endif});
  4312. inherited Init(R, dialog_about);
  4313. HelpCtx:=hcAbout;
  4314. GetExtent(R); R.Grow(-3,-2);
  4315. R2.Copy(R); R2.B.Y:=R2.A.Y+1;
  4316. Insert(New(PStaticText, Init(R2, ^C'Free Pascal IDE for '+source_info.name)));
  4317. R2.Move(0,1);
  4318. Insert(New(PStaticText, Init(R2, ^C'Target CPU: '+target_cpu_string)));
  4319. R2.Move(0,1);
  4320. Insert(New(PStaticText, Init(R2, ^C'Version '+VersionStr+' '+{$i %date%})));
  4321. R2.Move(0,1);
  4322. {$ifdef USE_GRAPH_SWITCH}
  4323. Insert(New(PStaticText, Init(R2, ^C'With Graphic Support')));
  4324. R2.Move(0,1);
  4325. {$endif USE_GRAPH_SWITCH}
  4326. Insert(New(PStaticText, Init(R2, FormatStrStr2(^C'(%s %s)',label_about_compilerversion,Full_Version_String))));
  4327. {$ifndef NODEBUG}
  4328. if pos('Fake',GDBVersion)=0 then
  4329. begin
  4330. R2.Move(0,1);
  4331. nblines:=1;
  4332. for i:=1 to length(GDBVersion) do
  4333. if GDBVersion[i]=#13 then
  4334. inc(nblines);
  4335. R2.B.Y:=R2.A.Y+nblines;
  4336. if nblines>1 then
  4337. GrowTo(Size.X,Size.Y+nblines-1);
  4338. {$ifdef GDBMI}
  4339. if GDBVersionOK then
  4340. Insert(New(PStaticText, Init(R2, FormatStrStr2(^C'(%s %s, using MI interface)',label_about_debugger,GDBVersion))))
  4341. else
  4342. Insert(New(PStaticText, Init(R2, FormatStrStr(^C'%s',GDBVersion))));
  4343. {$else}
  4344. Insert(New(PStaticText, Init(R2, FormatStrStr2(^C'(%s %s)',label_about_debugger,GDBVersion))));
  4345. {$endif}
  4346. R2.Move(0,nblines);
  4347. R2.B.Y:=R2.A.Y+1;
  4348. end
  4349. else
  4350. {$endif NODEBUG}
  4351. R2.Move(0,2);
  4352. Insert(New(PStaticText, Init(R2, ^C'Copyright (C) 1998-2020 by')));
  4353. R2.Move(0,2);
  4354. Insert(New(PStaticText, Init(R2, ^C'B'#$82'rczi G'#$A0'bor')));
  4355. R2.Move(0,1);
  4356. Insert(New(PStaticText, Init(R2, ^C'Pierre Muller')));
  4357. R2.Move(0,1);
  4358. Insert(New(PStaticText, Init(R2, ^C'and')));
  4359. R2.Move(0,1);
  4360. Insert(New(PStaticText, Init(R2, ^C'Peter Vreman')));
  4361. New(C, Init(50,10));
  4362. for I:=1 to 7 do
  4363. AddLine('');
  4364. AddLine(^C'< Original concept >');
  4365. AddLine(^C'Borland International, Inc.');
  4366. AddLine('');
  4367. AddLine(^C'< Compiler development >');
  4368. AddLine(^C'Carl-Eric Codere');
  4369. AddLine(^C'Daniel Mantione');
  4370. AddLine(^C'Florian Kl'#$84'mpfl');
  4371. AddLine(^C'Jonas Maebe');
  4372. AddLine(^C'Mich'#$84'el Van Canneyt');
  4373. AddLine(^C'Peter Vreman');
  4374. AddLine(^C'Pierre Muller');
  4375. AddLine('');
  4376. AddLine(^C'< IDE development >');
  4377. AddLine(^C'B'#$82'rczi G'#$A0'bor');
  4378. AddLine(^C'Peter Vreman');
  4379. AddLine(^C'Pierre Muller');
  4380. AddLine('');
  4381. AddLine(^C'< GDBMI development >');
  4382. AddLine(^C'Nikolay Nikolov');
  4383. AddLine('');
  4384. GetExtent(R);
  4385. R.Grow(-1,-1); Inc(R.A.Y,3);
  4386. New(Scroller, Init(R, 10, C));
  4387. Scroller^.Hide;
  4388. Insert(Scroller);
  4389. R.Move(0,-1); R.B.Y:=R.A.Y+1;
  4390. New(TitleST, Init(R, ^C'Team'));
  4391. TitleST^.Hide;
  4392. Insert(TitleST);
  4393. InsertOK(@Self);
  4394. end;
  4395. procedure TFPAboutDialog.ToggleInfo;
  4396. begin
  4397. if Scroller=nil then Exit;
  4398. if Scroller^.GetState(sfVisible) then
  4399. begin
  4400. Scroller^.Hide;
  4401. TitleST^.Hide;
  4402. end
  4403. else
  4404. begin
  4405. Scroller^.Reset;
  4406. Scroller^.Show;
  4407. TitleST^.Show;
  4408. end;
  4409. end;
  4410. procedure TFPAboutDialog.HandleEvent(var Event: TEvent);
  4411. begin
  4412. case Event.What of
  4413. evKeyDown :
  4414. case Event.KeyCode of
  4415. kbAltI : { just like in BP }
  4416. begin
  4417. ToggleInfo;
  4418. ClearEvent(Event);
  4419. end;
  4420. end;
  4421. end;
  4422. inherited HandleEvent(Event);
  4423. end;
  4424. constructor TFPASCIIChart.Init;
  4425. begin
  4426. inherited Init;
  4427. HelpCtx:=hcASCIITableWindow;
  4428. Number:=SearchFreeWindowNo;
  4429. ASCIIChart:=@Self;
  4430. end;
  4431. procedure TFPASCIIChart.Store(var S: TStream);
  4432. begin
  4433. inherited Store(S);
  4434. end;
  4435. constructor TFPASCIIChart.Load(var S: TStream);
  4436. begin
  4437. inherited Load(S);
  4438. end;
  4439. procedure TFPASCIIChart.HandleEvent(var Event: TEvent);
  4440. var W: PSourceWindow;
  4441. begin
  4442. {writeln(stderr,'all what=',event.what,' cmd=', event.command);}
  4443. case Event.What of
  4444. evKeyDown :
  4445. case Event.KeyCode of
  4446. kbEsc :
  4447. begin
  4448. Close;
  4449. ClearEvent(Event);
  4450. end;
  4451. end;
  4452. evCommand :
  4453. begin
  4454. {writeln(stderr,'fpascii what=',event.what, ' cmd=', event.command, ' ',cmtransfer,' ',cmsearchwindow);}
  4455. if Event.Command=(AsciiTableCommandBase+1) then // variable
  4456. begin
  4457. W:=FirstEditorWindow;
  4458. if Assigned(W) and Assigned(Report) then
  4459. Message(W,evCommand,cmAddChar,Event.InfoPtr);
  4460. ClearEvent(Event);
  4461. end
  4462. else
  4463. case Event.Command of
  4464. cmTransfer :
  4465. begin
  4466. W:=FirstEditorWindow;
  4467. if Assigned(W) and Assigned(Report) then
  4468. Message(W,evCommand,cmAddChar,pointer(ptrint(ord(Report^.AsciiChar))));
  4469. ClearEvent(Event);
  4470. end;
  4471. cmSearchWindow+1..cmSearchWindow+99 :
  4472. if (Event.Command-cmSearchWindow=Number) then
  4473. ClearEvent(Event);
  4474. end;
  4475. end;
  4476. end;
  4477. inherited HandleEvent(Event);
  4478. end;
  4479. destructor TFPASCIIChart.Done;
  4480. begin
  4481. ASCIIChart:=nil;
  4482. inherited Done;
  4483. end;
  4484. function TVideoModeListBox.GetText(Item: pointer; MaxLen: sw_integer): string;
  4485. var P: PVideoMode;
  4486. S: string;
  4487. begin
  4488. P:=Item;
  4489. S:=IntToStr(P^.Col)+'x'+IntToStr(P^.Row)+' ';
  4490. if P^.Color then
  4491. S:=S+'color'
  4492. else
  4493. S:=S+'mono';
  4494. GetText:=copy(S,1,MaxLen);
  4495. end;
  4496. constructor TFPDesktop.Init(var Bounds: TRect);
  4497. begin
  4498. inherited Init(Bounds);
  4499. end;
  4500. procedure TFPDesktop.InitBackground;
  4501. var AV: PANSIBackground;
  4502. FileName: string;
  4503. R: TRect;
  4504. begin
  4505. AV:=nil;
  4506. FileName:=LocateFile(BackgroundPath);
  4507. if FileName<>'' then
  4508. begin
  4509. GetExtent(R);
  4510. New(AV, Init(R));
  4511. AV^.GrowMode:=gfGrowHiX+gfGrowHiY;
  4512. if AV^.LoadFile(FileName)=false then
  4513. begin
  4514. Dispose(AV, Done); AV:=nil;
  4515. end;
  4516. if Assigned(AV) then
  4517. Insert(AV);
  4518. end;
  4519. Background:=AV;
  4520. if Assigned(Background)=false then
  4521. inherited InitBackground;
  4522. end;
  4523. constructor TFPDesktop.Load(var S: TStream);
  4524. begin
  4525. inherited Load(S);
  4526. end;
  4527. procedure TFPDesktop.Store(var S: TStream);
  4528. begin
  4529. inherited Store(S);
  4530. end;
  4531. constructor TFPToolTip.Init(var Bounds: TRect; const AText: string; AAlign: TAlign);
  4532. begin
  4533. inherited Init(Bounds);
  4534. SetAlign(AAlign);
  4535. SetText(AText);
  4536. end;
  4537. procedure TFPToolTip.Draw;
  4538. var C: word;
  4539. procedure DrawLine(Y: integer; S: string);
  4540. var B: TDrawBuffer;
  4541. begin
  4542. S:=copy(S,1,Size.X-2);
  4543. case Align of
  4544. alLeft : S:=' '+S;
  4545. alRight : S:=LExpand(' '+S,Size.X);
  4546. alCenter : S:=Center(S,Size.X);
  4547. end;
  4548. MoveChar(B,' ',C,Size.X);
  4549. MoveStr(B,S,C);
  4550. WriteLine(0,Y,Size.X,1,B);
  4551. end;
  4552. var S: string;
  4553. Y: integer;
  4554. begin
  4555. C:=GetColor(1);
  4556. S:=GetText;
  4557. for Y:=0 to Size.Y-1 do
  4558. DrawLine(Y,S);
  4559. end;
  4560. function TFPToolTip.GetText: string;
  4561. begin
  4562. GetText:=GetStr(Text);
  4563. end;
  4564. procedure TFPToolTip.SetText(const AText: string);
  4565. begin
  4566. if AText<>GetText then
  4567. begin
  4568. if Assigned(Text) then DisposeStr(Text);
  4569. Text:=NewStr(AText);
  4570. DrawView;
  4571. end;
  4572. end;
  4573. function TFPToolTip.GetAlign: TAlign;
  4574. begin
  4575. GetAlign:=Align;
  4576. end;
  4577. procedure TFPToolTip.SetAlign(AAlign: TAlign);
  4578. begin
  4579. if AAlign<>Align then
  4580. begin
  4581. Align:=AAlign;
  4582. DrawView;
  4583. end;
  4584. end;
  4585. destructor TFPToolTip.Done;
  4586. begin
  4587. if Assigned(Text) then DisposeStr(Text); Text:=nil;
  4588. inherited Done;
  4589. end;
  4590. function TFPToolTip.GetPalette: PPalette;
  4591. const S: string[length(CFPToolTip)] = CFPToolTip;
  4592. begin
  4593. GetPalette:=@S;
  4594. end;
  4595. constructor TFPMemo.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  4596. PScrollBar; AIndicator: PIndicator);
  4597. begin
  4598. inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,nil);
  4599. SetFlags(Flags and not (efPersistentBlocks) or efSyntaxHighlight);
  4600. end;
  4601. procedure TFPMemo.HandleEvent(var Event: TEvent);
  4602. var DontClear: boolean;
  4603. S: string;
  4604. LineCount,LinesScroll : Sw_Integer;
  4605. begin
  4606. case Event.What of
  4607. evKeyDown :
  4608. begin
  4609. DontClear:=false;
  4610. case Event.KeyCode of
  4611. kbEsc:
  4612. begin
  4613. Event.What:=evCommand;
  4614. Event.Command:=cmCancel;
  4615. PutEvent(Event);
  4616. end;
  4617. else DontClear:=true;
  4618. end;
  4619. if not DontClear then ClearEvent(Event);
  4620. end;
  4621. evMouseWheel:
  4622. if (Event.Wheel=mwDown) then { Mouse scroll down }
  4623. begin
  4624. LinesScroll:=1;
  4625. if Event.Double then LinesScroll:=LinesScroll+4;
  4626. LineCount:=Max(GetLineCount,1);
  4627. ScrollTo(Delta.X,Min(Max(0,LineCount-Size.Y),Delta.Y+LinesScroll));
  4628. ClearEvent(Event);
  4629. end else
  4630. if (Event.Wheel=mwUp) then { Mouse scroll up }
  4631. begin
  4632. LinesScroll:=-1;
  4633. if Event.Double then LinesScroll:=LinesScroll-4;
  4634. ScrollTo(Delta.X, Max(0,Delta.Y+LinesScroll));
  4635. ClearEvent(Event);
  4636. end;
  4637. end;
  4638. inherited HandleEvent(Event);
  4639. end;
  4640. function TFPMemo.GetPalette: PPalette;
  4641. const P: string[length(CFPMemo)] = CFPMemo;
  4642. begin
  4643. GetPalette:=@P;
  4644. end;
  4645. function TFPMemo.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  4646. begin
  4647. GetSpecSymbolCount:=0;
  4648. end;
  4649. function TFPMemo.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring;
  4650. begin
  4651. Abstract;
  4652. GetSpecSymbol:=nil;
  4653. end;
  4654. function TFPMemo.IsReservedWord(const S: string): boolean;
  4655. begin
  4656. IsReservedWord:=false;
  4657. end;
  4658. constructor TFPCodeMemo.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  4659. PScrollBar; AIndicator: PIndicator);
  4660. begin
  4661. inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator);
  4662. end;
  4663. function TFPCodeMemo.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  4664. begin
  4665. GetSpecSymbolCount:=FreePascalSpecSymbolCount[SpecClass];
  4666. end;
  4667. function TFPCodeMemo.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): pstring;
  4668. begin
  4669. GetSpecSymbol:=@FreePascalEmptyString;
  4670. case SpecClass of
  4671. ssCommentPrefix :
  4672. case Index of
  4673. 0 : GetSpecSymbol:=@FreePascalCommentPrefix1;
  4674. 1 : GetSpecSymbol:=@FreePascalCommentPrefix2;
  4675. 2 : GetSpecSymbol:=@FreePascalCommentPrefix3;
  4676. end;
  4677. ssCommentSingleLinePrefix :
  4678. case Index of
  4679. 0 : GetSpecSymbol:=@FreePascalCommentSingleLinePrefix;
  4680. end;
  4681. ssCommentSuffix :
  4682. case Index of
  4683. 0 : GetSpecSymbol:=@FreePascalCommentSuffix1;
  4684. 1 : GetSpecSymbol:=@FreePascalCommentSuffix2;
  4685. end;
  4686. ssStringPrefix :
  4687. GetSpecSymbol:=@FreePascalStringPrefix;
  4688. ssStringSuffix :
  4689. GetSpecSymbol:=@FreePascalStringSuffix;
  4690. { must be uppercased to avoid calling UpCaseStr in MatchesAnyAsmSymbol PM }
  4691. ssAsmPrefix :
  4692. GetSpecSymbol:=@FreePascalAsmPrefix;
  4693. ssAsmSuffix :
  4694. GetSpecSymbol:=@FreePascalAsmSuffix;
  4695. ssDirectivePrefix :
  4696. case Index of
  4697. 0 : GetSpecSymbol:=@FreePascalDirectivePrefix1;
  4698. 1 : GetSpecSymbol:=@FreePascalDirectivePrefix2;
  4699. end;
  4700. {ssDirectiveSuffix :
  4701. case Index of
  4702. 0 : GetSpecSymbol:=@FreePascalDirectiveSuffix1;
  4703. 1 : GetSpecSymbol:=@FreePascalDirectiveSuffix2;
  4704. end;}
  4705. end;
  4706. end;
  4707. function TFPCodeMemo.IsReservedWord(const S: string): boolean;
  4708. begin
  4709. IsReservedWord:=IsFPReservedWord(S);
  4710. end;
  4711. {$ifdef VESA}
  4712. function VESASetVideoModeProc(const VideoMode: TVideoMode; Params: Longint): Boolean;
  4713. begin
  4714. VESASetVideoModeProc:=VESASetMode(Params);
  4715. end;
  4716. procedure InitVESAScreenModes;
  4717. var ML: TVESAModeList;
  4718. MI: TVESAModeInfoBlock;
  4719. I: integer;
  4720. begin
  4721. if VESAInit=false then Exit;
  4722. if VESAGetModeList(ML)=false then Exit;
  4723. for I:=1 to ML.Count do
  4724. begin
  4725. if VESAGetModeInfo(ML.Modes[I],MI) then
  4726. with MI do
  4727. {$ifndef DEBUG}
  4728. if (Attributes and vesa_vma_GraphicsMode)=0 then
  4729. {$else DEBUG}
  4730. if ((Attributes and vesa_vma_GraphicsMode)=0) or
  4731. { only allow 4 bit i.e. 16 color modes }
  4732. (((Attributes and vesa_vma_CanBeSetInCurrentConfig)<>0) and
  4733. (BitsPerPixel=8)) then
  4734. {$endif DEBUG}
  4735. RegisterVesaVideoMode(ML.Modes[I]);
  4736. end;
  4737. end;
  4738. procedure DoneVESAScreenModes;
  4739. begin
  4740. FreeVesaModes;
  4741. end;
  4742. {$endif}
  4743. procedure NoDebugger;
  4744. begin
  4745. InformationBox(msg_nodebuggersupportavailable,nil);
  4746. end;
  4747. procedure RegisterFPViews;
  4748. begin
  4749. RegisterType(RSourceEditor);
  4750. RegisterType(RSourceWindow);
  4751. RegisterType(RFPHelpViewer);
  4752. RegisterType(RFPHelpWindow);
  4753. RegisterType(RClipboardWindow);
  4754. RegisterType(RMessageListBox);
  4755. RegisterType(RFPDesktop);
  4756. RegisterType(RFPASCIIChart);
  4757. RegisterType(RFPDlgWindow);
  4758. {$ifndef NODEBUG}
  4759. RegisterType(RGDBWindow);
  4760. RegisterType(RGDBSourceEditor);
  4761. {$endif NODEBUG}
  4762. end;
  4763. END.