fpviews.pas 123 KB

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