fpviews.pas 141 KB

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