fpviews.pas 127 KB

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