fpviews.pas 125 KB

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