fpviews.pas 122 KB

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