fpviews.pas 129 KB

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