fpviews.pas 123 KB

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