fpviews.pas 127 KB

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