fpviews.pas 127 KB

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