fpviews.pas 129 KB

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