fpviews.pas 122 KB

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