fpviews.pas 126 KB

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