fpviews.pas 133 KB

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