fpviews.pas 140 KB

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