fpviews.pas 141 KB

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